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-ice.xml b/cfgs/SHARED/field_def_nemo-ice.xml
index 6f444b4563f398c3b44021512551548252a10bf7..b04c13e1f704d0606406d8dd243cd73b986a8257 100644
--- a/cfgs/SHARED/field_def_nemo-ice.xml
+++ b/cfgs/SHARED/field_def_nemo-ice.xml
@@ -18,7 +18,7 @@
<field_group id="SBC" > <!-- time step automaticaly defined based on nn_fsbc -->
<!-- 2D variables -->
- <field_group id="SBC_2D" grid_ref="grid_T_2D" >
+ <field_group id="SBC_2D" grid_ref="grid_T_2D_inner" >
<!-- =================== -->
<!-- standard ice fields -->
@@ -311,7 +311,7 @@
</field_group> <!-- SBC_2D -->
<!-- categories -->
- <field_group id="SBC_3D" grid_ref="grid_T_ncatice" >
+ <field_group id="SBC_3D" grid_ref="grid_T_ncatice_inner" >
<!-- standard ice fields -->
<field id="iceconc_cat" long_name="Sea-ice concentration per category" unit="" />
@@ -386,7 +386,7 @@
-->
<!-- output variables for my configuration (example) -->
- <field_group id="myvarICE" grid_ref="grid_T_2D" >
+ <field_group id="myvarICE" >
<!-- ice mask -->
<field field_ref="icemask" name="simsk" />
<field field_ref="icemask05" name="simsk05" />
@@ -495,7 +495,7 @@
</field_group>
- <field_group id="myvarICE_cat" grid_ref="grid_T_ncatice" >
+ <field_group id="myvarICE_cat" >
<!-- categories -->
<field field_ref="icemask_cat" name="simskcat"/>
@@ -524,7 +524,7 @@
<field field_ref="ilbgvol_tot" name="ilbgvol_tot" />
</field_group>
- <field_group id="ICE_budget" grid_ref="grid_T_2D" >
+ <field_group id="ICE_budget" >
<!-- general -->
<field field_ref="icemask" name="simsk" />
<field field_ref="iceconc" name="siconc" />
@@ -579,7 +579,7 @@
</field_group>
<!-- SIMIP daily fields -->
- <field_group id="SIday_fields" grid_ref="grid_T_2D" >
+ <field_group id="SIday_fields" >
<field field_ref="icepres" name="sitimefrac" />
<field field_ref="iceconc_pct" name="siconc" />
<field field_ref="icethic_cmip" name="sithick" />
@@ -591,7 +591,7 @@
</field_group>
<!-- SIMIP monthly fields -->
- <field_group id="SImon_fields" grid_ref="grid_T_2D" >
+ <field_group id="SImon_fields" >
<!-- Sea-ice state variables -->
<field field_ref="icepres" name="sitimefrac" />
<field field_ref="iceconc_pct" name="siconc" />
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-oce.xml b/cfgs/SHARED/field_def_nemo-oce.xml
index 7b618ff67965e56b470d15decce18d951977bc48..bc6b20728008854584e71fd3a1c20a81ea5fbacf 100644
--- a/cfgs/SHARED/field_def_nemo-oce.xml
+++ b/cfgs/SHARED/field_def_nemo-oce.xml
@@ -109,62 +109,60 @@ that are available in the tidal-forcing implementation (see
<!-- T grid -->
<field_group id="grid_T" grid_ref="grid_T_2D" >
- <field id="e3t" long_name="T-cell thickness" standard_name="cell_thickness" unit="m" grid_ref="grid_T_3D" />
- <field id="e3ts" long_name="T-cell thickness" field_ref="e3t" standard_name="cell_thickness" unit="m" grid_ref="grid_T_SFC"/>
- <field id="e3t_0" long_name="Initial T-cell thickness" standard_name="ref_cell_thickness" unit="m" grid_ref="grid_T_3D" />
- <field id="e3tb" long_name="bottom T-cell thickness" standard_name="bottom_cell_thickness" unit="m" grid_ref="grid_T_2D"/>
- <field id="e3t_300" field_ref="e3t" grid_ref="grid_T_zoom_300" detect_missing_value="true" />
- <field id="e3t_vsum300" field_ref="e3t_300" grid_ref="grid_T_vsum" detect_missing_value="true" />
- <field id="masscello" long_name="Sea Water Mass per unit area" standard_name="sea_water_mass_per_unit_area" unit="kg/m2" grid_ref="grid_T_3D"/>
- <field id="volcello" long_name="Ocean Volume" standard_name="ocean_volume" unit="m3" grid_ref="grid_T_3D"/>
- <field id="toce" long_name="temperature" standard_name="sea_water_potential_temperature" unit="degC" grid_ref="grid_T_3D"/>
- <field id="toce_e3t" long_name="temperature (thickness weighted)" unit="degC" grid_ref="grid_T_3D" > toce * e3t </field >
- <field id="soce" long_name="salinity" standard_name="sea_water_practical_salinity" unit="1e-3" grid_ref="grid_T_3D"/>
- <field id="soce_e3t" long_name="salinity (thickness weighted)" unit="1e-3" grid_ref="grid_T_3D" > soce * e3t </field >
-
- <field id="toce_e3t_300" field_ref="toce_e3t" unit="degree_C" grid_ref="grid_T_zoom_300" detect_missing_value="true" />
- <field id="toce_e3t_vsum300" field_ref="toce_e3t_300" unit="degress_C*m" grid_ref="grid_T_vsum" detect_missing_value="true" />
- <field id="toce_vmean300" field_ref="toce_e3t_vsum300" unit="degree_C" grid_ref="grid_T_vsum" detect_missing_value="true" > toce_e3t_vsum300/e3t_vsum300 </field>
+ <field id="e3t" long_name="T-cell thickness" standard_name="cell_thickness" unit="m" grid_ref="grid_T_3D" />
+ <field id="e3ts" long_name="T-cell thickness" field_ref="e3t" standard_name="cell_thickness" unit="m" grid_ref="grid_T_SFC" />
+ <field id="e3t_0" long_name="Initial T-cell thickness" standard_name="ref_cell_thickness" unit="m" grid_ref="grid_T_3D" />
+ <field id="e3tb" long_name="bottom T-cell thickness" standard_name="bottom_cell_thickness" unit="m" grid_ref="grid_T_2D_inner" />
+ <field id="e3t_300" field_ref="e3t" grid_ref="grid_T_zoom_300" detect_missing_value="true" />
+ <field id="e3t_vsum300" field_ref="e3t_300" grid_ref="grid_T_vsum" detect_missing_value="true" />
+
+ <field id="masscello" long_name="Sea Water Mass per unit area" standard_name="sea_water_mass_per_unit_area" unit="kg/m2" grid_ref="grid_T_3D_inner"/>
+ <field id="volcello" long_name="Ocean Volume" standard_name="ocean_volume" unit="m3" grid_ref="grid_T_3D_inner"/>
+ <field id="toce" long_name="temperature" standard_name="sea_water_potential_temperature" unit="degC" grid_ref="grid_T_3D"/>
+ <field id="toce_e3t" long_name="temperature (thickness weighted)" unit="degC" grid_ref="grid_T_3D" > toce * e3t </field >
+ <field id="soce" long_name="salinity" standard_name="sea_water_practical_salinity" unit="1e-3" grid_ref="grid_T_3D"/>
+ <field id="soce_e3t" long_name="salinity (thickness weighted)" unit="1e-3" grid_ref="grid_T_3D" > soce * e3t </field >
+
+ <field id="toce_e3t_300" field_ref="toce_e3t" unit="degree_C" grid_ref="grid_T_zoom_300" detect_missing_value="true" />
+ <field id="toce_e3t_vsum300" field_ref="toce_e3t_300" unit="degress_C*m" grid_ref="grid_T_vsum" detect_missing_value="true" />
+ <field id="toce_vmean300" field_ref="toce_e3t_vsum300" unit="degree_C" grid_ref="grid_T_vsum" detect_missing_value="true" > toce_e3t_vsum300/e3t_vsum300 </field>
<!-- AGRIF sponge -->
<field id="agrif_spt" long_name=" AGRIF t-sponge coefficient" unit=" " />
<!-- additions to diawri.F90 -->
- <field id="sssgrad" long_name="module of surface salinity gradient" unit="1e-3/m" grid_ref="grid_T_2D_inner"/>
- <field id="sssgrad2" long_name="square of module of surface salinity gradient" unit="1e-6/m2" grid_ref="grid_T_2D_inner"/>
- <field id="ke" long_name="kinetic energy" standard_name="specific_kinetic_energy_of_sea_water" unit="m2/s2" grid_ref="grid_T_3D" />
- <field id="ke_int" long_name="vertical integration of kinetic energy" unit="m3/s2" grid_ref="grid_T_2D_inner" />
+ <field id="sssgrad" long_name="module of surface salinity gradient" unit="1e-3/m" grid_ref="grid_T_2D_inner" />
+ <field id="sssgrad2" long_name="square of module of surface salinity gradient" unit="1e-6/m2" grid_ref="grid_T_2D_inner" />
+ <field id="ke" long_name="kinetic energy" standard_name="specific_kinetic_energy_of_sea_water" unit="m2/s2" grid_ref="grid_T_3D_inner" />
+ <field id="ke_int" long_name="vertical integration of kinetic energy" unit="m3/s2" grid_ref="grid_T_2D_inner" />
+ <field id="taubot" long_name="bottom stress module" unit="N/m2" grid_ref="grid_T_2D_inner" />
<!-- t-eddy viscosity coefficients (ldfdyn) -->
<field id="ahmt_2d" long_name=" surface t-eddy viscosity coefficient" unit="m2/s or m4/s" />
<field id="ahmt_3d" long_name=" 3D t-eddy viscosity coefficient" unit="m2/s or m4/s" grid_ref="grid_T_3D"/>
<field id="sst" long_name="Bulk sea surface temperature" standard_name="bulk_sea_surface_temperature" unit="degC" />
- <field id="t_skin" long_name="Skin temperature aka SSST" standard_name="skin_temperature" unit="degC" />
+ <field id="sss" long_name="sea surface salinity" standard_name="sea_surface_salinity" unit="1e-3" />
<field id="sst2" long_name="square of sea surface temperature" standard_name="square_of_sea_surface_temperature" unit="degC2" > sst * sst </field >
+ <field id="sss2" long_name="square of sea surface salinity" unit="1e-6" > sss * sss </field >
<field id="sstmax" long_name="max of sea surface temperature" field_ref="sst" operation="maximum" />
+ <field id="sssmax" long_name="max of sea surface salinity" field_ref="sss" operation="maximum" />
<field id="sstmin" long_name="min of sea surface temperature" field_ref="sst" operation="minimum" />
+ <field id="sssmin" long_name="min of sea surface salinity" field_ref="sss" operation="minimum" />
<field id="sstgrad" long_name="module of sst gradient" unit="degC/m" grid_ref="grid_T_2D_inner" />
<field id="sstgrad2" long_name="square of module of sst gradient" unit="degC2/m2" grid_ref="grid_T_2D_inner" />
<field id="sbt" long_name="sea bottom temperature" unit="degC" grid_ref="grid_T_2D_inner" />
- <field id="tosmint" long_name="vertical integral of temperature times density" standard_name="integral_wrt_depth_of_product_of_density_and_potential_temperature" unit="(kg m2) degree_C" grid_ref="grid_T_2D_inner" />
- <field id="sst_wl" long_name="Delta SST of warm layer" unit="degC" />
- <field id="sst_cs" long_name="Delta SST of cool skin" unit="degC" />
- <field id="temp_3m" long_name="temperature at 3m" unit="degC" />
-
- <field id="sss" long_name="sea surface salinity" standard_name="sea_surface_salinity" unit="1e-3" />
- <field id="sss2" long_name="square of sea surface salinity" unit="1e-6" > sss * sss </field >
- <field id="sssmax" long_name="max of sea surface salinity" field_ref="sss" operation="maximum" />
- <field id="sssmin" long_name="min of sea surface salinity" field_ref="sss" operation="minimum" />
- <field id="sbs" long_name="sea bottom salinity" unit="0.001" grid_ref="grid_T_2D_inner" />
- <field id="somint" long_name="vertical integral of salinity times density" standard_name="integral_wrt_depth_of_product_of_density_and_salinity" unit="(kg m2) x (1e-3)" grid_ref="grid_T_2D_inner" />
+ <field id="sbs" long_name="sea bottom salinity" unit="0.001" grid_ref="grid_T_2D_inner" />
+ <field id="sst_wl" long_name="Delta SST of warm layer" unit="degC" grid_ref="grid_T_2D_inner" />
+ <field id="sst_cs" long_name="Delta SST of cool skin" unit="degC" grid_ref="grid_T_2D_inner" />
- <field id="taubot" long_name="bottom stress module" unit="N/m2" grid_ref="grid_T_2D_inner" />
+ <field id="tosmint" long_name="vertical integral of temperature times density" standard_name="integral_wrt_depth_of_product_of_density_and_potential_temperature" unit="(kg m2) degree_C" grid_ref="grid_T_2D_inner" />
+ <field id="somint" long_name="vertical integral of salinity times density" standard_name="integral_wrt_depth_of_product_of_density_and_salinity" unit="(kg m2) x (1e-3)" grid_ref="grid_T_2D_inner" />
<!-- Case EOS = TEOS-10 : output potential temperature -->
- <field id="toce_pot" long_name="Sea Water Potential Temperature" standard_name="sea_water_potential_temperature" unit="degC" grid_ref="grid_T_3D"/>
- <field id="sst_pot" long_name="potential sea surface temperature" standard_name="sea_surface_temperature" unit="degC" />
- <field id="tosmint_pot" long_name="vertical integral of potential temperature times density" standard_name="integral_wrt_depth_of_product_of_density_and_potential_temperature" unit="(kg m2) degree_C" />
+ <field id="toce_pot" long_name="Sea Water Potential Temperature" standard_name="sea_water_potential_temperature" unit="degC" grid_ref="grid_T_3D_inner"/>
+ <field id="sst_pot" long_name="potential sea surface temperature" standard_name="sea_surface_temperature" unit="degC" grid_ref="grid_T_2D_inner"/>
+ <field id="tosmint_pot" long_name="vertical integral of potential temperature times density" standard_name="integral_wrt_depth_of_product_of_density_and_potential_temperature" unit="(kg m2) degree_C" grid_ref="grid_T_2D_inner"/>
<field id="ht" long_name="water column height at T point" standard_name="water_column_height_T" unit="m" />
<field id="ssh" long_name="sea surface height" standard_name="sea_surface_height_above_geoid" unit="m" />
@@ -172,13 +170,13 @@ that are available in the tidal-forcing implementation (see
<field id="wetdep" long_name="wet depth" standard_name="wet_depth" unit="m" />
<field id="sshmax" long_name="max of sea surface height" field_ref="ssh" operation="maximum" />
- <field id="mldkz5" long_name="Turbocline depth (Kz = 5e-4)" standard_name="ocean_mixed_layer_thickness_defined_by_vertical_tracer_diffusivity" unit="m" />
- <field id="mldr10_1" long_name="Mixed Layer Depth (dsigma = 0.01 wrt 10m)" standard_name="ocean_mixed_layer_thickness_defined_by_sigma_theta" unit="m" />
- <field id="mldr10_1max" long_name="Max of Mixed Layer Depth (dsigma = 0.01 wrt 10m)" field_ref="mldr10_1" operation="maximum" />
- <field id="mldr10_1min" long_name="Min of Mixed Layer Depth (dsigma = 0.01 wrt 10m)" field_ref="mldr10_1" operation="minimum" />
- <field id="heatc" long_name="Heat content vertically integrated" standard_name="integral_of_sea_water_potential_temperature_wrt_depth_expressed_as_heat_content" unit="J/m2" grid_ref="grid_T_2D_inner" />
- <field id="saltc" long_name="Salt content vertically integrated" unit="PSU*kg/m2" grid_ref="grid_T_2D_inner" />
- <field id="salt2c" long_name="square of Salt content vertically integrated" unit="PSU2*kg/m2" grid_ref="grid_T_2D_inner" />
+ <field id="mldkz5" long_name="Turbocline depth (Kz = 5e-4)" standard_name="ocean_mixed_layer_thickness_defined_by_vertical_tracer_diffusivity" unit="m" grid_ref="grid_T_2D_inner" />
+ <field id="mldr10_1" long_name="Mixed Layer Depth (dsigma = 0.01 wrt 10m)" standard_name="ocean_mixed_layer_thickness_defined_by_sigma_theta" unit="m" grid_ref="grid_T_2D_inner" />
+ <field id="mldr10_1max" long_name="Max of Mixed Layer Depth (dsigma = 0.01 wrt 10m)" field_ref="mldr10_1" operation="maximum" grid_ref="grid_T_2D_inner" />
+ <field id="mldr10_1min" long_name="Min of Mixed Layer Depth (dsigma = 0.01 wrt 10m)" field_ref="mldr10_1" operation="minimum" grid_ref="grid_T_2D_inner" />
+ <field id="heatc" long_name="Heat content vertically integrated" standard_name="integral_of_sea_water_potential_temperature_wrt_depth_expressed_as_heat_content" unit="J/m2" grid_ref="grid_T_2D_inner" />
+ <field id="saltc" long_name="Salt content vertically integrated" unit="PSU*kg/m2" grid_ref="grid_T_2D_inner" />
+ <field id="salt2c" long_name="square of Salt content vertically integrated" unit="PSU2*kg/m2" grid_ref="grid_T_2D_inner" />
<!-- EOS -->
<field id="alpha" long_name="thermal expansion" unit="degC-1" grid_ref="grid_T_3D" />
@@ -217,28 +215,28 @@ that are available in the tidal-forcing implementation (see
<field id="hc2000" long_name="Heat content 0-2000m" standard_name="integral_of_sea_water_potential_temperature_wrt_depth_expressed_as_heat_content" unit="J/m2" grid_ref="grid_T_2D_inner" />
<!-- variables available with diaar5 -->
- <field id="botpres" long_name="Sea Water Pressure at Sea Floor" standard_name="sea_water_pressure_at_sea_floor" unit="dbar" />
+ <field id="botpres" long_name="Sea Water Pressure at Sea Floor" standard_name="sea_water_pressure_at_sea_floor" unit="dbar" grid_ref="grid_T_2D_inner" />
<field id="sshdyn" long_name="dynamic sea surface height" standard_name="dynamic_sea_surface_height_above_geoid" unit="m" />
<field id="sshdyn2" long_name="square of dynamic sea surface height" standard_name="dynamic_sea_surface_height_above_geoid_squared" unit="m2" > sshdyn * sshdyn </field>
- <field id="tnpeo" long_name="Tendency of ocean potential energy content" unit="W/m2" />
+ <field id="tnpeo" long_name="Tendency of ocean potential energy content" unit="W/m2" grid_ref="grid_T_2D_inner" />
<!-- variables available ln_linssh=.FALSE. -->
- <field id="tpt_dep" long_name="T-point depth" standard_name="depth_below_geoid" unit="m" grid_ref="grid_T_3D" />
+ <field id="tpt_dep" long_name="T-point depth" standard_name="depth_below_geoid" unit="m" grid_ref="grid_T_3D_inner" />
<field id="e3tdef" long_name="T-cell thickness deformation" unit="%" grid_ref="grid_T_3D" />
<!-- variables available with ln_diacfl=.true. -->
- <field id="cfl_cu" long_name="u-courant number" unit="#" />
- <field id="cfl_cv" long_name="v-courant number" unit="#" />
- <field id="cfl_cw" long_name="w-courant number" unit="#" />
+ <field id="cfl_cu" long_name="u-courant number" unit="#" grid_ref="grid_T_2D_inner" />
+ <field id="cfl_cv" long_name="v-courant number" unit="#" grid_ref="grid_T_2D_inner" />
+ <field id="cfl_cw" long_name="w-courant number" unit="#" grid_ref="grid_T_2D_inner" />
<!-- variables available with ln_zdfmfc=.true. -->
<field id="mf_Tp" long_name="plume_temperature" standard_name="plume_temperature" unit="degC" grid_ref="grid_T_3D" />
<field id="mf_Sp" long_name="plume_salinity" standard_name="plume_salinity" unit="1e-3" grid_ref="grid_T_3D" />
- <field id="mf_mf" long_name="mass flux" standard_name="mf_mass_flux" unit="m" grid_ref="grid_T_3D" />
+ <field id="mf_mf" long_name="mass flux" standard_name="mf_mass_flux" unit="m" grid_ref="grid_T_3D_inner" />
<!-- fluxes from damping -->
- <field id="sflx_dmp_cea" long_name="salt flux due to damping" standard_name="salt_flux_due_to_damping" unit="g/m2/s" />
- <field id="hflx_dmp_cea" long_name="heat flux due to damping" standard_name="heat_flux_due_to_damping" unit="W/m2" />
+ <field id="sflx_dmp_cea" long_name="salt flux due to damping" standard_name="salt_flux_due_to_damping" unit="g/m2/s" grid_ref="grid_T_2D_inner" />
+ <field id="hflx_dmp_cea" long_name="heat flux due to damping" standard_name="heat_flux_due_to_damping" unit="W/m2" grid_ref="grid_T_2D_inner" />
<!-- * variable related to ice shelf forcing * -->
@@ -410,7 +408,7 @@ that are available in the tidal-forcing implementation (see
<!-- SBC -->
<field_group id="SBC" > <!-- time step automaticaly defined based on nn_fsbc -->
- <field_group id="SBC_2D" grid_ref="grid_T_2D" >
+ <field_group id="SBC_2D" grid_ref="grid_T_2D_inner" >
<field id="empmr" long_name="Net Upward Water Flux" standard_name="water_flux_out_of_sea_ice_and_sea_water" unit="kg/m2/s" />
<field id="empbmr" long_name="Net Upward Water Flux at pre. tstep" standard_name="water_flux_out_of_sea_ice_and_sea_water" unit="kg/m2/s" />
@@ -423,50 +421,51 @@ that are available in the tidal-forcing implementation (see
<field id="precip" long_name="Total precipitation" standard_name="precipitation_flux" unit="kg/m2/s" />
<field id="wclosea" long_name="closed sea empmr correction" standard_name="closea_empmr" unit="kg/m2/s" />
- <field id="qt" long_name="Net Downward Heat Flux" standard_name="surface_downward_heat_flux_in_sea_water" unit="W/m2" />
- <field id="qns" long_name="non solar Downward Heat Flux" unit="W/m2" />
- <field id="qsr" long_name="Shortwave Radiation" standard_name="net_downward_shortwave_flux_at_sea_water_surface" unit="W/m2" />
- <field id="qsr3d" long_name="Shortwave Radiation 3D distribution" standard_name="downwelling_shortwave_flux_in_sea_water" unit="W/m2" grid_ref="grid_T_3D" />
- <field id="qrp" long_name="Surface Heat Flux: Damping" standard_name="heat_flux_into_sea_water_due_to_newtonian_relaxation" unit="W/m2" />
+ <field id="qt" long_name="Net Downward Heat Flux" standard_name="surface_downward_heat_flux_in_sea_water" unit="W/m2" />
+ <field id="qns" long_name="non solar Downward Heat Flux" unit="W/m2" />
+ <field id="qsr" long_name="Shortwave Radiation" standard_name="net_downward_shortwave_flux_at_sea_water_surface" unit="W/m2" />
+ <field id="qsr3d" long_name="Shortwave Radiation 3D distribution" standard_name="downwelling_shortwave_flux_in_sea_water" unit="W/m2" grid_ref="grid_T_3D" />
+ <field id="qrp" long_name="Surface Heat Flux: Damping" standard_name="heat_flux_into_sea_water_due_to_newtonian_relaxation" unit="W/m2" />
<field id="qclosea" long_name="closed sea heat content flux" standard_name="closea_heat_content_downward_flux" unit="W/m2" />
- <field id="erp" long_name="Surface Water Flux: Damping" standard_name="water_flux_out_of_sea_water_due_to_newtonian_relaxation" unit="kg/m2/s" />
- <field id="taum" long_name="wind stress module" standard_name="magnitude_of_surface_downward_stress" unit="N/m2" />
- <field id="wspd" long_name="wind speed module" standard_name="wind_speed" unit="m/s" />
- <field id="utau" long_name="Wind Stress along i-axis" standard_name="surface_downward_x_stress" unit="N/m2" />
- <field id="vtau" long_name="Wind Stress along j-axis" standard_name="surface_downward_y_stress" unit="N/m2" />
+ <field id="erp" long_name="Surface Water Flux: Damping" standard_name="water_flux_out_of_sea_water_due_to_newtonian_relaxation" unit="kg/m2/s" />
+ <field id="taum" long_name="wind stress module" standard_name="magnitude_of_surface_downward_stress" unit="N/m2" />
+ <field id="wspd" long_name="wind speed module" standard_name="wind_speed" unit="m/s" />
+ <field id="utau" long_name="Wind Stress along i-axis" standard_name="surface_downward_x_stress" unit="N/m2" />
+ <field id="vtau" long_name="Wind Stress along j-axis" standard_name="surface_downward_y_stress" unit="N/m2" />
<!-- * variable relative to atmospheric pressure forcing : available with ln_apr_dyn -->
- <field id="ssh_ib" long_name="Inverse barometer sea surface height" standard_name="sea_surface_height_correction_due_to_air_pressure_at_low_frequency" unit="m" />
+ <field id="ssh_ib" long_name="Inverse barometer sea surface height" standard_name="sea_surface_height_correction_due_to_air_pressure_at_low_frequency" unit="m" grid_ref="grid_T_2D" />
<!-- *_oce variables available with ln_blk_clio or ln_blk_core -->
- <field id="rho_air" long_name="Air density at 10m above sea surface" standard_name="rho_air_10m" unit="kg/m3" />
- <field id="dt_skin" long_name="SSST-SST temperature difference" standard_name="SSST-SST" unit="K" />
- <field id="qlw_oce" long_name="Longwave Downward Heat Flux over open ocean" standard_name="surface_net_downward_longwave_flux" unit="W/m2" />
- <field id="qsb_oce" long_name="Sensible Downward Heat Flux over open ocean" standard_name="surface_downward_sensible_heat_flux" unit="W/m2" />
- <field id="qla_oce" long_name="Latent Downward Heat Flux over open ocean" standard_name="surface_downward_latent_heat_flux" unit="W/m2" />
- <field id="evap_oce" long_name="Evaporation over open ocean" standard_name="evaporation" unit="kg/m2/s" />
- <field id="qt_oce" long_name="total flux at ocean surface" standard_name="surface_downward_heat_flux_in_sea_water" unit="W/m2" />
- <field id="qsr_oce" long_name="solar heat flux at ocean surface" standard_name="net_downward_shortwave_flux_at_sea_water_surface" unit="W/m2" />
- <field id="qns_oce" long_name="non-solar heat flux at ocean surface (including E-P)" unit="W/m2" />
- <field id="qemp_oce" long_name="Downward Heat Flux from E-P over open ocean" unit="W/m2" />
- <field id="taum_oce" long_name="wind stress module over open ocean" standard_name="magnitude_of_surface_downward_stress" unit="N/m2" />
+ <field id="rho_air" long_name="Air density at 10m above sea surface" standard_name="rho_air_10m" unit="kg/m3" />
+ <field id="t_skin" long_name="Skin temperature aka SSST" standard_name="skin_temperature" unit="degC" />
+ <field id="dt_skin" long_name="SSST-SST temperature difference" standard_name="SSST-SST" unit="K" />
+ <field id="qlw_oce" long_name="Longwave Downward Heat Flux over open ocean" standard_name="surface_net_downward_longwave_flux" unit="W/m2" />
+ <field id="qsb_oce" long_name="Sensible Downward Heat Flux over open ocean" standard_name="surface_downward_sensible_heat_flux" unit="W/m2" />
+ <field id="qla_oce" long_name="Latent Downward Heat Flux over open ocean" standard_name="surface_downward_latent_heat_flux" unit="W/m2" />
+ <field id="evap_oce" long_name="Evaporation over open ocean" standard_name="evaporation" unit="kg/m2/s"/>
+ <field id="qt_oce" long_name="total flux at ocean surface" standard_name="surface_downward_heat_flux_in_sea_water" unit="W/m2" />
+ <field id="qsr_oce" long_name="solar heat flux at ocean surface" standard_name="net_downward_shortwave_flux_at_sea_water_surface" unit="W/m2" />
+ <field id="qns_oce" long_name="non-solar heat flux at ocean surface (including E-P)" unit="W/m2" />
+ <field id="qemp_oce" long_name="Downward Heat Flux from E-P over open ocean" unit="W/m2" />
+ <field id="taum_oce" long_name="wind stress module over open ocean" standard_name="magnitude_of_surface_downward_stress" unit="N/m2" />
<field id="utau_oce" long_name="Wind Stress along i-axis over open ocean (T-points)" standard_name="surf_down_x_stress_open_oce_Tpoints" unit="N/m2" />
- <field id="vtau_oce" long_name="Wind Stress along j-axis over open ocean (T-points)" standard_name="surf_down_y_stress_open_oce_Tpoints" unit="N/m2" />
+ <field id="vtau_oce" long_name="Wind Stress along j-axis over open ocean (T-points)" standard_name="surf_down_y_stress_open_oce_Tpoints" unit="N/m2" />
<!-- variables computed by the bulk parameterization algorithms (ln_blk) -->
- <field id="Cd_oce" long_name="Drag coefficient over open ocean" standard_name="drag_coefficient_water" unit="" />
- <field id="Ce_oce" long_name="Evaporaion coefficient over open ocean" standard_name="evap_coefficient_water" unit="" />
- <field id="Ch_oce" long_name="Sensible heat coefficient over open ocean" standard_name="sensible_heat_coefficient_water" unit="" />
+ <field id="Cd_oce" long_name="Drag coefficient over open ocean" standard_name="drag_coefficient_water" unit="" />
+ <field id="Ce_oce" long_name="Evaporaion coefficient over open ocean" standard_name="evap_coefficient_water" unit="" />
+ <field id="Ch_oce" long_name="Sensible heat coefficient over open ocean" standard_name="sensible_heat_coefficient_water" unit="" />
<field id="theta_zt" long_name="Potential air temperature at z=zt" standard_name="potential_air_temperature_at_zt" unit="degC" />
- <field id="q_zt" long_name="Specific air humidity at z=zt" standard_name="specific_air_humidity_at_zt" unit="kg/kg" />
+ <field id="q_zt" long_name="Specific air humidity at z=zt" standard_name="specific_air_humidity_at_zt" unit="kg/kg"/>
<field id="theta_zu" long_name="Potential air temperature at z=zu" standard_name="potential_air_temperature_at_zu" unit="degC" />
- <field id="q_zu" long_name="Specific air humidity at z=zu" standard_name="specific_air_humidity_at_zu" unit="kg/kg" />
- <field id="ssq" long_name="Saturation specific humidity of air at z=0" standard_name="surface_air_saturation_spec_humidity" unit="kg/kg" />
- <field id="wspd_blk" long_name="Bulk wind speed at z=zu" standard_name="bulk_wind_speed_at_zu" unit="m/s" />
+ <field id="q_zu" long_name="Specific air humidity at z=zu" standard_name="specific_air_humidity_at_zu" unit="kg/kg"/>
+ <field id="ssq" long_name="Saturation specific humidity of air at z=0" standard_name="surface_air_saturation_spec_humidity" unit="kg/kg"/>
+ <field id="wspd_blk" long_name="Bulk wind speed at z=zu" standard_name="bulk_wind_speed_at_zu" unit="m/s" />
<!-- ln_blk + key_si3 -->
- <field id="Cd_ice" long_name="Drag coefficient over ice" standard_name="drag_coefficient_ice" unit="" />
- <field id="Ce_ice" long_name="Evaporaion coefficient over ice" standard_name="evap_coefficient_ice" unit="" />
- <field id="Ch_ice" long_name="Sensible heat coefficient over ice" standard_name="sensible_heat_coefficient_ice" unit="" />
+ <field id="Cd_ice" long_name="Drag coefficient over ice" standard_name="drag_coefficient_ice" unit="" />
+ <field id="Ce_ice" long_name="Evaporaion coefficient over ice" standard_name="evap_coefficient_ice" unit="" />
+ <field id="Ch_ice" long_name="Sensible heat coefficient over ice" standard_name="sensible_heat_coefficient_ice" unit="" />
<!-- available key_oasis3 -->
<field id="snow_ao_cea" long_name="Snow over ice-free ocean (cell average)" standard_name="snowfall_flux" unit="kg/m2/s" />
@@ -512,22 +511,22 @@ that are available in the tidal-forcing implementation (see
<field id="vflx_fwb_cea" long_name="volume flux due to fwb" standard_name="volume_flux_due_to_fwb" unit="kg/m2/s" />
<!-- ice field (nn_ice=1) -->
- <field id="ice_cover" long_name="Ice fraction" standard_name="sea_ice_area_fraction" unit="1" />
+ <field id="ice_cover" long_name="Ice fraction" standard_name="sea_ice_area_fraction" unit="1" grid_ref="grid_T_2D" />
<!-- dilution -->
- <field id="emp_x_sst" long_name="Concentration/Dilution term on SST" unit="kg*degC/m2/s" />
- <field id="emp_x_sss" long_name="Concentration/Dilution term on SSS" unit="kg*1e-3/m2/s" />
- <field id="rnf_x_sst" long_name="Runoff term on SST" unit="kg*degC/m2/s" />
- <field id="rnf_x_sss" long_name="Runoff term on SSS" unit="kg*1e-3/m2/s" />
+ <field id="emp_x_sst" long_name="Concentration/Dilution term on SST" unit="kg*degC/m2/s" grid_ref="grid_T_2D" />
+ <field id="emp_x_sss" long_name="Concentration/Dilution term on SSS" unit="kg*1e-3/m2/s" grid_ref="grid_T_2D" />
+ <field id="rnf_x_sst" long_name="Runoff term on SST" unit="kg*degC/m2/s" grid_ref="grid_T_2D" />
+ <field id="rnf_x_sss" long_name="Runoff term on SSS" unit="kg*1e-3/m2/s" grid_ref="grid_T_2D" />
<!-- sbcssm variables -->
- <field id="sst_m" unit="degC" />
- <field id="sss_m" unit="psu" />
- <field id="ssu_m" unit="m/s" />
- <field id="ssv_m" unit="m/s" />
- <field id="ssh_m" unit="m" />
- <field id="e3t_m" unit="m" />
- <field id="frq_m" unit="-" />
+ <field id="sst_m" unit="degC" grid_ref="grid_T_2D" />
+ <field id="sss_m" unit="psu" grid_ref="grid_T_2D" />
+ <field id="ssu_m" unit="m/s" grid_ref="grid_T_2D" />
+ <field id="ssv_m" unit="m/s" grid_ref="grid_T_2D" />
+ <field id="ssh_m" unit="m" grid_ref="grid_T_2D" />
+ <field id="e3t_m" unit="m" grid_ref="grid_T_2D" />
+ <field id="frq_m" unit="-" grid_ref="grid_T_2D" />
</field_group>
@@ -582,17 +581,17 @@ that are available in the tidal-forcing implementation (see
<field_group id="grid_U" grid_ref="grid_U_2D">
<field id="hu" long_name="water column height at U point" standard_name="water_column_height_U" unit="m" />
- <field id="e2u" long_name="U-cell width in meridional direction" standard_name="cell_width" unit="m" />
- <field id="e3u" long_name="U-cell thickness" standard_name="cell_thickness" unit="m" grid_ref="grid_U_3D" />
- <field id="e3u_0" long_name="Initial U-cell thickness" standard_name="ref_cell_thickness" unit="m" grid_ref="grid_U_3D"/>
- <field id="uoce" long_name="ocean current along i-axis" standard_name="sea_water_x_velocity" unit="m/s" grid_ref="grid_U_3D" />
- <field id="uoce_e3u" long_name="ocean current along i-axis (thickness weighted)" unit="m/s" grid_ref="grid_U_3D" > uoce * e3u </field>
- <field id="uoce_e3u_vsum" long_name="ocean current along i-axis * e3u summed on the vertical" field_ref="uoce_e3u" unit="m3/s" grid_ref="grid_U_vsum"/>
- <field id="uocetr_vsum" long_name="ocean transport along i-axis summed on the vertical" field_ref="e2u" unit="m3/s"> this * uoce_e3u_vsum </field>
-
- <field id="uocetr_vsum_op" long_name="ocean current along i-axis * e3u * e2u summed on the vertical" read_access="true" freq_op="1mo" field_ref="e2u" unit="m3/s"> @uocetr_vsum </field>
+ <field id="e2u" long_name="U-cell width in meridional direction" standard_name="cell_width" unit="m" />
+ <field id="e3u" long_name="U-cell thickness" standard_name="cell_thickness" unit="m" grid_ref="grid_U_3D" />
+ <field id="e3u_0" long_name="Initial U-cell thickness" standard_name="ref_cell_thickness" unit="m" grid_ref="grid_U_3D" />
+ <field id="uoce" long_name="ocean current along i-axis" standard_name="sea_water_x_velocity" unit="m/s" grid_ref="grid_U_3D" />
+ <field id="uoce_e3u" long_name="ocean current along i-axis (thickness weighted)" unit="m/s" grid_ref="grid_U_3D" > uoce * e3u </field>
+ <field id="uoce_e3u_vsum" long_name="ocean current along i-axis * e3u summed on the vertical" field_ref="uoce_e3u" unit="m3/s" grid_ref="grid_U_vsum" />
+ <field id="uocetr_vsum" long_name="ocean transport along i-axis summed on the vertical" field_ref="e2u" unit="m3/s" > this * uoce_e3u_vsum </field>
+
+ <field id="uocetr_vsum_op" long_name="ocean current along i-axis * e3u * e2u summed on the vertical" read_access="true" freq_op="1mo" field_ref="e2u" unit="m3/s" > @uocetr_vsum </field>
<field id="uocetr_vsum_cumul" long_name="ocean current along i-axis * e3u * e2u cumulated from southwest point" freq_offset="_reset_" operation="instant" freq_op="1mo" unit="m3/s" />
- <field id="msftbarot" long_name="ocean_barotropic_mass_streamfunction" unit="kg s-1" > uocetr_vsum_cumul * $rho0 </field>
+ <field id="msftbarot" long_name="ocean_barotropic_mass_streamfunction" unit="kg s-1" > uocetr_vsum_cumul * $rho0 </field>
<field id="ssu" long_name="ocean surface current along i-axis" unit="m/s" />
@@ -606,21 +605,21 @@ that are available in the tidal-forcing implementation (see
<field id="agrif_spu" long_name=" AGRIF u-sponge coefficient" unit=" " />
<!-- u-eddy diffusivity coefficients (available if ln_traldf_OFF=F) -->
<field id="ahtu_2d" long_name=" surface u-eddy diffusivity coefficient" unit="m2/s or m4/s" />
- <field id="ahtu_3d" long_name=" 3D u-EIV coefficient" unit="m2/s or m4/s" grid_ref="grid_U_3D"/>
+ <field id="ahtu_3d" long_name=" 3D u-EIV coefficient" unit="m2/s or m4/s" grid_ref="grid_U_3D" />
<!-- u-eiv diffusivity coefficients (available if ln_ldfeiv=F) -->
- <field id="aeiu_2d" long_name=" surface u-EIV coefficient" unit="m2/s" />
- <field id="aeiu_3d" long_name=" 3D u-EIV coefficient" unit="m2/s" grid_ref="grid_U_3D"/>
+ <field id="aeiu_2d" long_name=" surface u-EIV coefficient" unit="m2/s" />
+ <field id="aeiu_3d" long_name=" 3D u-EIV coefficient" unit="m2/s" grid_ref="grid_U_3D" />
<!-- variables available with MLE (ln_mle=T) -->
- <field id="psiu_mle" long_name="MLE streamfunction along i-axis" unit="m3/s" grid_ref="grid_U_3D" />
+ <field id="psiu_mle" long_name="MLE streamfunction along i-axis" unit="m3/s" grid_ref="grid_U_3D" />
<!-- uoce_eiv: available EIV (ln_ldfeiv=T and ln_ldfeiv_dia=T) -->
- <field id="uoce_eiv" long_name="EIV ocean current along i-axis" standard_name="bolus_sea_water_x_velocity" unit="m/s" grid_ref="grid_U_3D_inner" />
- <field id="ueiv_masstr" long_name="EIV Ocean Mass X Transport" standard_name="bolus_ocean_mass_x_transport" unit="kg/s" grid_ref="grid_U_3D_inner" />
- <field id="ueiv_heattr" long_name="ocean bolus heat transport along i-axis" standard_name="ocean_heat_x_transport_due_to_bolus_advection" unit="W" grid_ref="grid_U_2D_inner" />
- <field id="ueiv_salttr" long_name="ocean bolus salt transport along i-axis" standard_name="ocean_salt_x_transport_due_to_bolus_advection" unit="Kg" grid_ref="grid_U_2D_inner" />
- <field id="ueiv_heattr3d" long_name="ocean bolus heat transport along i-axis" standard_name="ocean_heat_x_transport_due_to_bolus_advection" unit="W" grid_ref="grid_U_3D_inner" />
- <field id="ueiv_salttr3d" long_name="ocean bolus salt transport along i-axis" standard_name="ocean_salt_x_transport_due_to_bolus_advection" unit="kg" grid_ref="grid_U_3D_inner" />
+ <field id="uoce_eiv" long_name="EIV ocean current along i-axis" standard_name="bolus_sea_water_x_velocity" unit="m/s" grid_ref="grid_U_3D_inner" />
+ <field id="ueiv_masstr" long_name="EIV Ocean Mass X Transport" standard_name="bolus_ocean_mass_x_transport" unit="kg/s" grid_ref="grid_U_3D_inner" />
+ <field id="ueiv_heattr" long_name="ocean bolus heat transport along i-axis" standard_name="ocean_heat_x_transport_due_to_bolus_advection" unit="W" grid_ref="grid_U_2D_inner" />
+ <field id="ueiv_salttr" long_name="ocean bolus salt transport along i-axis" standard_name="ocean_salt_x_transport_due_to_bolus_advection" unit="Kg" grid_ref="grid_U_2D_inner" />
+ <field id="ueiv_heattr3d" long_name="ocean bolus heat transport along i-axis" standard_name="ocean_heat_x_transport_due_to_bolus_advection" unit="W" grid_ref="grid_U_3D_inner" />
+ <field id="ueiv_salttr3d" long_name="ocean bolus salt transport along i-axis" standard_name="ocean_salt_x_transport_due_to_bolus_advection" unit="kg" grid_ref="grid_U_3D_inner" />
<!-- uoce_bbl: available with ln_trabbl=T and nn_bbl_adv=1 -->
<field id="uoce_bbl" long_name="BBL ocean current along i-axis" unit="m/s" />
@@ -635,20 +634,20 @@ that are available in the tidal-forcing implementation (see
<field id="utbl" long_name="zonal current in the Losh tbl" unit="m/s" />
<!-- variables available with diaar5 -->
- <field id="u_masstr" long_name="Ocean Mass X Transport" standard_name="ocean_mass_x_transport" unit="kg/s" grid_ref="grid_U_3D" />
- <field id="u_masstr_vint" long_name="vertical integral of ocean eulerian mass transport along i-axis" standard_name="vertical_integral_of_ocean_mass_x_transport" unit="kg/s" grid_ref="grid_U_2D_inner" />
- <field id="u_heattr" long_name="ocean eulerian heat transport along i-axis" standard_name="ocean_heat_x_transport" unit="W" grid_ref="grid_U_2D_inner" />
+ <field id="u_masstr" long_name="Ocean Mass X Transport" standard_name="ocean_mass_x_transport" unit="kg/s" grid_ref="grid_U_3D_inner" />
+ <field id="u_masstr_vint" long_name="vertical integral of ocean eulerian mass transport along i-axis" standard_name="vertical_integral_of_ocean_mass_x_transport" unit="kg/s" grid_ref="grid_U_2D_inner" />
+ <field id="u_heattr" long_name="ocean eulerian heat transport along i-axis" standard_name="ocean_heat_x_transport" unit="W" grid_ref="grid_U_2D_inner" />
<field id="u_salttr" long_name="ocean eulerian salt transport along i-axis" standard_name="ocean_salt_x_transport" unit="1e-3*kg/s" grid_ref="grid_U_2D_inner" />
- <field id="uadv_heattr" long_name="ocean advective heat transport along i-axis" standard_name="advectice_ocean_heat_x_transport" unit="W" />
- <field id="uadv_salttr" long_name="ocean advective salt transport along i-axis" standard_name="advectice_ocean_salt_x_transport" unit="1e-3*kg/s" />
- <field id="udiff_heattr" long_name="ocean diffusion heat transport along i-axis" standard_name="ocean_heat_x_transport_due_to_diffusion" unit="W" />
- <field id="udiff_salttr" long_name="ocean diffusion salt transport along i-axis" standard_name="ocean_salt_x_transport_due_to_diffusion" unit="1e-3*kg/s" />
+ <field id="uadv_heattr" long_name="ocean advective heat transport along i-axis" standard_name="advectice_ocean_heat_x_transport" unit="W" grid_ref="grid_U_2D_inner" />
+ <field id="uadv_salttr" long_name="ocean advective salt transport along i-axis" standard_name="advectice_ocean_salt_x_transport" unit="1e-3*kg/s" grid_ref="grid_U_2D_inner" />
+ <field id="udiff_heattr" long_name="ocean diffusion heat transport along i-axis" standard_name="ocean_heat_x_transport_due_to_diffusion" unit="W" grid_ref="grid_U_2D_inner" />
+ <field id="udiff_salttr" long_name="ocean diffusion salt transport along i-axis" standard_name="ocean_salt_x_transport_due_to_diffusion" unit="1e-3*kg/s" grid_ref="grid_U_2D_inner" />
</field_group>
<!-- V grid -->
<field_group id="grid_V" grid_ref="grid_V_2D">
- <field id="e1v" long_name="V-cell width in longitudinal direction" standard_name="cell_width" unit="m" />
+ <field id="e1v" long_name="V-cell width in longitudinal direction" standard_name="cell_width" unit="m" />
<field id="e3v" long_name="V-cell thickness" standard_name="cell_thickness" unit="m" grid_ref="grid_V_3D" />
<field id="e3v_0" long_name="Initial V-cell thickness" standard_name="ref_cell_thickness" unit="m" grid_ref="grid_V_3D" />
<field id="hv" long_name="water column height at V point" standard_name="water_column_height_V" unit="m" />
@@ -665,21 +664,21 @@ that are available in the tidal-forcing implementation (see
<field id="agrif_spv" long_name=" AGRIF v-sponge coefficient" unit=" " />
<!-- v-eddy diffusivity coefficients (available if ln_traldf_OFF=F) -->
<field id="ahtv_2d" long_name=" surface v-eddy diffusivity coefficient" unit="m2/s or (m4/s)^1/2" />
- <field id="ahtv_3d" long_name=" 3D v-eddy diffusivity coefficient" unit="m2/s or (m4/s)^1/2" grid_ref="grid_V_3D"/>
+ <field id="ahtv_3d" long_name=" 3D v-eddy diffusivity coefficient" unit="m2/s or (m4/s)^1/2" grid_ref="grid_V_3D" />
<!-- v-eiv diffusivity coefficients (available if ln_ldfeiv=F) -->
- <field id="aeiv_2d" long_name=" surface v-EIV coefficient" unit="m2/s" />
- <field id="aeiv_3d" long_name=" 3D v-EIV coefficient" unit="m2/s" grid_ref="grid_V_3D" />
+ <field id="aeiv_2d" long_name=" surface v-EIV coefficient" unit="m2/s" />
+ <field id="aeiv_3d" long_name=" 3D v-EIV coefficient" unit="m2/s" grid_ref="grid_V_3D" />
<!-- variables available with MLE (ln_mle=T) -->
- <field id="psiv_mle" long_name="MLE streamfunction along j-axis" unit="m3/s" grid_ref="grid_V_3D" />
+ <field id="psiv_mle" long_name="MLE streamfunction along j-axis" unit="m3/s" grid_ref="grid_V_3D" />
<!-- voce_eiv: available EIV (ln_ldfeiv=T and ln_ldfeiv_dia=T) -->
- <field id="voce_eiv" long_name="EIV ocean current along j-axis" standard_name="bolus_sea_water_y_velocity" unit="m/s" grid_ref="grid_V_3D_inner" />
- <field id="veiv_masstr" long_name="EIV Ocean Mass Y Transport" standard_name="bolus_ocean_mass_y_transport" unit="kg/s" grid_ref="grid_V_3D_inner" />
- <field id="veiv_heattr" long_name="ocean bolus heat transport along j-axis" standard_name="ocean_heat_y_transport_due_to_bolus_advection" unit="W" grid_ref="grid_V_2D_inner" />
- <field id="veiv_salttr" long_name="ocean bolus salt transport along j-axis" standard_name="ocean_salt_x_transport_due_to_bolus_advection" unit="Kg" grid_ref="grid_V_2D_inner" />
- <field id="veiv_heattr3d" long_name="ocean bolus heat transport along j-axis" standard_name="ocean_heat_y_transport_due_to_bolus_advection" unit="W" grid_ref="grid_V_3D_inner" />
- <field id="veiv_salttr3d" long_name="ocean bolus salt transport along j-axis" standard_name="ocean_salt_y_transport_due_to_bolus_advection" unit="kg" grid_ref="grid_V_3D_inner" />
+ <field id="voce_eiv" long_name="EIV ocean current along j-axis" standard_name="bolus_sea_water_y_velocity" unit="m/s" grid_ref="grid_V_3D_inner" />
+ <field id="veiv_masstr" long_name="EIV Ocean Mass Y Transport" standard_name="bolus_ocean_mass_y_transport" unit="kg/s" grid_ref="grid_V_3D_inner" />
+ <field id="veiv_heattr" long_name="ocean bolus heat transport along j-axis" standard_name="ocean_heat_y_transport_due_to_bolus_advection" unit="W" grid_ref="grid_V_2D_inner" />
+ <field id="veiv_salttr" long_name="ocean bolus salt transport along j-axis" standard_name="ocean_salt_x_transport_due_to_bolus_advection" unit="Kg" grid_ref="grid_V_2D_inner" />
+ <field id="veiv_heattr3d" long_name="ocean bolus heat transport along j-axis" standard_name="ocean_heat_y_transport_due_to_bolus_advection" unit="W" grid_ref="grid_V_3D_inner" />
+ <field id="veiv_salttr3d" long_name="ocean bolus salt transport along j-axis" standard_name="ocean_salt_y_transport_due_to_bolus_advection" unit="kg" grid_ref="grid_V_3D_inner" />
<!-- voce_bbl: available with ln_trabbl=T and nn_bbl_adv=1 -->
@@ -695,13 +694,13 @@ that are available in the tidal-forcing implementation (see
<field id="vtbl" long_name="meridional current in the Losh tbl" unit="m/s" />
<!-- variables available with diaar5 -->
- <field id="v_masstr" long_name="ocean eulerian mass transport along j-axis" standard_name="ocean_mass_y_transport" unit="kg/s" grid_ref="grid_V_3D" />
+ <field id="v_masstr" long_name="ocean eulerian mass transport along j-axis" standard_name="ocean_mass_y_transport" unit="kg/s" grid_ref="grid_V_3D_inner" />
<field id="v_heattr" long_name="ocean eulerian heat transport along j-axis" standard_name="ocean_heat_y_transport" unit="W" grid_ref="grid_V_2D_inner" />
<field id="v_salttr" long_name="ocean eulerian salt transport along i-axis" standard_name="ocean_salt_y_transport" unit="1e-3*kg/s" grid_ref="grid_V_2D_inner" />
- <field id="vadv_heattr" long_name="ocean advective heat transport along j-axis" standard_name="advectice_ocean_heat_y_transport" unit="W" />
- <field id="vadv_salttr" long_name="ocean advective salt transport along j-axis" standard_name="advectice_ocean_salt_y_transport" unit="1e-3*kg/s" />
- <field id="vdiff_heattr" long_name="ocean diffusion heat transport along j-axis" standard_name="ocean_heat_y_transport_due_to_diffusion" unit="W" />
- <field id="vdiff_salttr" long_name="ocean diffusion salt transport along j-axis" standard_name="ocean_salt_y_transport_due_to_diffusion" unit="1e-3*kg/s" />
+ <field id="vadv_heattr" long_name="ocean advective heat transport along j-axis" standard_name="advectice_ocean_heat_y_transport" unit="W" grid_ref="grid_V_2D_inner" />
+ <field id="vadv_salttr" long_name="ocean advective salt transport along j-axis" standard_name="advectice_ocean_salt_y_transport" unit="1e-3*kg/s" grid_ref="grid_V_2D_inner" />
+ <field id="vdiff_heattr" long_name="ocean diffusion heat transport along j-axis" standard_name="ocean_heat_y_transport_due_to_diffusion" unit="W" grid_ref="grid_V_2D_inner" />
+ <field id="vdiff_salttr" long_name="ocean diffusion salt transport along j-axis" standard_name="ocean_salt_y_transport_due_to_diffusion" unit="1e-3*kg/s" grid_ref="grid_V_2D_inner" />
</field_group>
<!-- W grid -->
@@ -712,70 +711,70 @@ that are available in the tidal-forcing implementation (see
<field id="woce_e3w" long_name="ocean vertical velocity * e3w" unit="m2/s" > woce * e3w </field>
<field id="wocetr_eff" long_name="effective ocean vertical transport" unit="m3/s" />
- <!-- woce_eiv: available with EIV (ln_ldfeiv=T and ln_ldfeiv_dia=T) -->
- <field id="woce_eiv" long_name="EIV ocean vertical velocity" standard_name="bolus_upward_sea_water_velocity" unit="m/s" grid_ref="grid_W_3D_inner" />
- <field id="weiv_masstr" long_name="EIV Upward Ocean Mass Transport" standard_name="bolus_upward_ocean_mass_transport" unit="kg/s" grid_ref="grid_W_3D_inner" />
- <field id="weiv_heattr3d" long_name="ocean bolus heat transport" standard_name="ocean_heat_z_transport_due_to_bolus_advection" unit="W" />
- <field id="weiv_salttr3d" long_name="ocean bolus salt transport" standard_name="ocean_salt_z_transport_due_to_bolus_advection" unit="kg" />
+ <!-- variables available with WAVE (ln_wave=T) -->
+ <field id="wstokes" long_name="Stokes Drift vertical velocity" standard_name="upward_StokesDrift_velocity" unit="m/s" />
- <field id="avt" long_name="vertical eddy diffusivity" standard_name="ocean_vertical_heat_diffusivity" unit="m2/s" />
- <field id="avt_e3w" long_name="vertical heat diffusivity * e3w" unit="m3/s" > avt * e3w </field>
- <field id="logavt" long_name="logarithm of vertical eddy diffusivity" standard_name="ocean_vertical_heat_diffusivity" unit="m2/s" />
- <field id="avm" long_name="vertical eddy viscosity" standard_name="ocean_vertical_momentum_diffusivity" unit="m2/s" />
- <field id="avm_e3w" long_name="vertical eddy viscosity * e3w" unit="m3/s" > avm * e3w </field>
+ <!-- woce_eiv: available with EIV (ln_ldfeiv=T and ln_ldfeiv_dia=T) -->
+ <field id="woce_eiv" long_name="EIV ocean vertical velocity" standard_name="bolus_upward_sea_water_velocity" unit="m/s" grid_ref="grid_W_3D_inner" />
+ <field id="weiv_masstr" long_name="EIV Upward Ocean Mass Transport" standard_name="bolus_upward_ocean_mass_transport" unit="kg/s" grid_ref="grid_W_3D_inner" />
+ <field id="weiv_heattr3d" long_name="ocean bolus heat transport" standard_name="ocean_heat_z_transport_due_to_bolus_advection" unit="W" grid_ref="grid_W_3D_inner" />
+ <field id="weiv_salttr3d" long_name="ocean bolus salt transport" standard_name="ocean_salt_z_transport_due_to_bolus_advection" unit="kg" grid_ref="grid_W_3D_inner" />
+
+ <!-- avt, avm -->
+ <field id="avt" long_name="vertical eddy diffusivity" standard_name="ocean_vertical_heat_diffusivity" unit="m2/s" grid_ref="grid_W_3D_inner" />
+ <field id="avt_e3w" long_name="vertical heat diffusivity * e3w" unit="m3/s" > avt * e3w </field>
+ <field id="logavt" long_name="logarithm of vertical eddy diffusivity" standard_name="ocean_vertical_heat_diffusivity" unit="m2/s" grid_ref="grid_W_3D_inner" />
+ <field id="avm" long_name="vertical eddy viscosity" standard_name="ocean_vertical_momentum_diffusivity" unit="m2/s" />
+ <field id="avm_e3w" long_name="vertical eddy viscosity * e3w" unit="m3/s" > avm * e3w </field>
<!-- avs: /= avt with ln_zdfddm=T -->
- <field id="avs" long_name="salt vertical eddy diffusivity" standard_name="ocean_vertical_salt_diffusivity" unit="m2/s" />
- <field id="avs_e3w" long_name="vertical salt diffusivity * e3w" unit="m3/s" > avs * e3w </field>
- <field id="logavs" long_name="logarithm of salt vertical eddy diffusivity" standard_name="ocean_vertical_heat_diffusivity" unit="m2/s" />
+ <field id="avs" long_name="salt vertical eddy diffusivity" standard_name="ocean_vertical_salt_diffusivity" unit="m2/s" grid_ref="grid_W_3D_inner" />
+ <field id="avs_e3w" long_name="vertical salt diffusivity * e3w" unit="m3/s" > avs * e3w </field>
+ <field id="logavs" long_name="logarithm of salt vertical eddy diffusivity" standard_name="ocean_vertical_heat_diffusivity" unit="m2/s" grid_ref="grid_W_3D_inner" />
<!-- avt_evd and avm_evd: available with ln_zdfevd -->
- <field id="avt_evd" long_name="convective enhancement of vertical diffusivity" standard_name="ocean_vertical_tracer_diffusivity_due_to_convection" unit="m2/s" />
- <field id="avt_evd_e3w" long_name="convective enhancement to vertical diffusivity * e3w " unit="m3/s" > avt_evd * e3w </field>
- <field id="avm_evd" long_name="convective enhancement of vertical viscosity" standard_name="ocean_vertical_momentum_diffusivity_due_to_convection" unit="m2/s" />
+ <field id="avt_evd" long_name="convective enhancement of vertical diffusivity" standard_name="ocean_vertical_tracer_diffusivity_due_to_convection" unit="m2/s" grid_ref="grid_W_3D_inner" />
+ <field id="avt_evd_e3w" long_name="convective enhancement to vertical diffusivity * e3w " unit="m3/s" > avt_evd * e3w </field>
+ <field id="avm_evd" long_name="convective enhancement of vertical viscosity" standard_name="ocean_vertical_momentum_diffusivity_due_to_convection" unit="m2/s" grid_ref="grid_W_3D_inner" />
<!-- mf_app and mf_wp: available with ln_zdfmfc -->
- <field id="mf_app" long_name="convective area" standard_name="mf_convective_area" unit="%" grid_ref="grid_W_3D" />
- <field id="mf_wp" long_name="convective velocity" standard_name="mf_convective_velo" unit="m/s" grid_ref="grid_W_3D" />
-
+ <field id="mf_app" long_name="convective area" standard_name="mf_convective_area" unit="%" grid_ref="grid_W_3D_inner" />
+ <field id="mf_wp" long_name="convective velocity" standard_name="mf_convective_velo" unit="m/s" grid_ref="grid_W_3D_inner" />
<!-- avt_tide: available with ln_zdfiwm=T -->
- <field id="av_ratio" long_name="S over T diffusivity ratio" standard_name="salinity_over_temperature_diffusivity_ratio" unit="1" />
- <field id="av_wave" long_name="internal wave-induced vertical diffusivity" standard_name="ocean_vertical_tracer_diffusivity_due_to_internal_waves" unit="m2/s" />
- <field id="bflx_iwm" long_name="internal wave-induced buoyancy flux" standard_name="buoyancy_flux_due_to_internal_waves" unit="W/kg" />
- <field id="pcmap_iwm" long_name="power consumed by wave-driven mixing" standard_name="vertically_integrated_power_consumption_by_wave_driven_mixing" unit="W/m2" grid_ref="grid_W_2D" />
- <field id="emix_iwm" long_name="power density available for mixing" standard_name="power_available_for_mixing_from_breaking_internal_waves" unit="W/kg" />
-
- <!-- variables available with WAVE (ln_wave=T) -->
- <field id="wstokes" long_name="Stokes Drift vertical velocity" standard_name="upward_StokesDrift_velocity" unit="m/s" />
+ <field id="av_ratio" long_name="S over T diffusivity ratio" standard_name="salinity_over_temperature_diffusivity_ratio" unit="1" grid_ref="grid_W_3D_inner" />
+ <field id="av_wave" long_name="internal wave-induced vertical diffusivity" standard_name="ocean_vertical_tracer_diffusivity_due_to_internal_waves" unit="m2/s" grid_ref="grid_W_3D_inner" />
+ <field id="bflx_iwm" long_name="internal wave-induced buoyancy flux" standard_name="buoyancy_flux_due_to_internal_waves" unit="W/kg" grid_ref="grid_W_3D_inner" />
+ <field id="pcmap_iwm" long_name="power consumed by wave-driven mixing" standard_name="vertically_integrated_power_consumption_by_wave_driven_mixing" unit="W/m2" grid_ref="grid_W_2D_inner" />
+ <field id="emix_iwm" long_name="power density available for mixing" standard_name="power_available_for_mixing_from_breaking_internal_waves" unit="W/kg" grid_ref="grid_W_3D_inner" />
<!-- variables available with diaar5 -->
- <field id="w_masstr" long_name="vertical mass transport" standard_name="upward_ocean_mass_transport" unit="kg/s" />
- <field id="w_masstr2" long_name="square of vertical mass transport" standard_name="square_of_upward_ocean_mass_transport" unit="kg2/s2" />
+ <field id="w_masstr" long_name="vertical mass transport" standard_name="upward_ocean_mass_transport" unit="kg/s" grid_ref="grid_W_3D_inner" />
+ <field id="w_masstr2" long_name="square of vertical mass transport" standard_name="square_of_upward_ocean_mass_transport" unit="kg2/s2" grid_ref="grid_W_3D_inner" />
<!-- EOS -->
<field id="bn2" long_name="squared Brunt-Vaisala frequency" unit="s-2" />
<!-- dissipation diagnostics (note: ediss_k is only available with tke scheme) -->
- <field id="avt_k" long_name="vertical eddy diffusivity from closure schemes" standard_name="ocean_vertical_eddy_diffusivity" unit="m2/s" />
<field id="avm_k" long_name="vertical eddy viscosity from closure schemes" standard_name="ocean_vertical_eddy_viscosity" unit="m2/s" />
- <field id="ediss_k" long_name="Kolmogorov energy dissipation (tke scheme)" standard_name="Kolmogorov_energy_dissipation" unit="W/kg" />
- <field id="eshear_k" long_name="energy source from vertical shear" standard_name="energy_source_from_shear" unit="W/kg" />
- <field id="estrat_k" long_name="energy sink from stratification" standard_name="energy_sink_from_stratification" unit="W/kg" />
+ <field id="avt_k" long_name="vertical eddy diffusivity from closure schemes" standard_name="ocean_vertical_eddy_diffusivity" unit="m2/s" grid_ref="grid_W_3D_inner" />
+ <field id="ediss_k" long_name="Kolmogorov energy dissipation (tke scheme)" standard_name="Kolmogorov_energy_dissipation" unit="W/kg" grid_ref="grid_W_3D_inner" />
+ <field id="eshear_k" long_name="energy source from vertical shear" standard_name="energy_source_from_shear" unit="W/kg" grid_ref="grid_W_3D_inner" />
+ <field id="estrat_k" long_name="energy sink from stratification" standard_name="energy_sink_from_stratification" unit="W/kg" grid_ref="grid_W_3D_inner" />
</field_group>
<!-- F grid -->
<field_group id="grid_F" grid_ref="grid_F_2D">
- <field id="e3f" long_name="F-cell thickness" standard_name="cell_thickness" unit="m" grid_ref="grid_F_3D" />
- <field id="e3f_0" long_name="F-cell thickness" standard_name="cell_thickness" unit="m" grid_ref="grid_F_3D" />
- <field id="hf" long_name="water column height at F point" standard_name="water_column_height_F" unit="m" />
- <field id="ssKEf" long_name="surface kinetic energy at F point" standard_name="specific_kinetic_energy_of_sea_water" unit="m2/s2" grid_ref="grid_F_2D_inner" />
- <field id="ssrelvor" long_name="surface relative vorticity" standard_name="relative_vorticity" unit="1/s" grid_ref="grid_F_2D_inner" />
- <field id="ssplavor" long_name="surface planetary vorticity" standard_name="planetary_vorticity" unit="1/s" />
- <field id="ssrelpotvor" long_name="surface relative potential vorticity" standard_name="relpot_vorticity" unit="1/m.s" grid_ref="grid_F_2D_inner" />
- <field id="ssabspotvor" long_name="surface absolute potential vorticity" standard_name="abspot_vorticity" unit="1/m.s" grid_ref="grid_F_2D_inner" />
- <field id="ssEns" long_name="surface enstrophy" standard_name="enstrophy" unit="1/m2.s2" grid_ref="grid_F_2D_inner" />
+ <field id="e3f" long_name="F-cell thickness" standard_name="cell_thickness" unit="m" grid_ref="grid_F_3D" />
+ <field id="e3f_0" long_name="F-cell thickness" standard_name="cell_thickness" unit="m" grid_ref="grid_F_3D" />
+ <field id="hf" long_name="water column height at F point" standard_name="water_column_height_F" unit="m" />
+ <field id="ssKEf" long_name="surface kinetic energy at F point" standard_name="specific_kinetic_energy_of_sea_water" unit="m2/s2" grid_ref="grid_F_2D_inner" />
+ <field id="ssrelvor" long_name="surface relative vorticity" standard_name="relative_vorticity" unit="1/s" grid_ref="grid_F_2D_inner" />
+ <field id="ssplavor" long_name="surface planetary vorticity" standard_name="planetary_vorticity" unit="1/s" grid_ref="grid_F_2D_inner" />
+ <field id="ssrelpotvor" long_name="surface relative potential vorticity" standard_name="relpot_vorticity" unit="1/m.s" grid_ref="grid_F_2D_inner" />
+ <field id="ssabspotvor" long_name="surface absolute potential vorticity" standard_name="abspot_vorticity" unit="1/m.s" grid_ref="grid_F_2D_inner" />
+ <field id="ssEns" long_name="surface enstrophy" standard_name="enstrophy" unit="1/m2.s2" grid_ref="grid_F_2D_inner" />
</field_group>
<!-- AGRIF sponge -->
@@ -816,16 +815,16 @@ that are available in the tidal-forcing implementation (see
<!-- transects -->
<field_group id="oce_straits">
- <field id="uoce_e3u_ave" long_name="Monthly average of u*e3u" field_ref="uoce_e3u" freq_op="1mo" freq_offset="_reset_" > @uoce_e3u </field>
- <field id="uoce_e3u_ave_vsum" long_name="Vertical sum of u*e3u" field_ref="uoce_e3u_ave" grid_ref="grid_U_vsum" />
+ <field id="uoce_e3u_ave" long_name="Monthly average of u*e3u" field_ref="uoce_e3u" freq_op="1mo" freq_offset="_reset_" > @uoce_e3u </field>
+ <field id="uoce_e3u_ave_vsum" long_name="Vertical sum of u*e3u" field_ref="uoce_e3u_ave" grid_ref="grid_U_vsum" />
<field id="uocetr_vsum_section" long_name="Total 2D transport in i-direction" field_ref="uoce_e3u_ave_vsum" grid_ref="grid_U_scalar" detect_missing_value="true"> this * e2u </field>
<field id="uocetr_strait" long_name="Total transport across lines in i-direction" field_ref="uocetr_vsum_section" grid_ref="grid_U_4strait" />
<field id="u_masstr_strait" long_name="Sea water transport across line in i-direction" field_ref="uocetr_strait" grid_ref="grid_U_4strait_hsum" unit="kg/s"> this * maskMFO_u * $rho0 </field>
- <field id="voce_e3v_ave" long_name="Monthly average of v*e3v" field_ref="voce_e3v" freq_op="1mo" freq_offset="_reset_" > @voce_e3v </field>
- <field id="voce_e3v_ave_vsum" long_name="Vertical sum of v*e3v" field_ref="voce_e3v_ave" grid_ref="grid_V_vsum" />
+ <field id="voce_e3v_ave" long_name="Monthly average of v*e3v" field_ref="voce_e3v" freq_op="1mo" freq_offset="_reset_" > @voce_e3v </field>
+ <field id="voce_e3v_ave_vsum" long_name="Vertical sum of v*e3v" field_ref="voce_e3v_ave" grid_ref="grid_V_vsum" />
<field id="vocetr_vsum_section" long_name="Total 2D transport of in j-direction" field_ref="voce_e3v_ave_vsum" grid_ref="grid_V_scalar" detect_missing_value="true"> this * e1v </field>
- <field id="vocetr_strait" long_name="Total transport across lines in j-direction" field_ref="vocetr_vsum_section" grid_ref="grid_V_4strait" />
+ <field id="vocetr_strait" long_name="Total transport across lines in j-direction" field_ref="vocetr_vsum_section" grid_ref="grid_V_4strait" />
<field id="v_masstr_strait" long_name="Sea water transport across line in j-direction" field_ref="vocetr_strait" grid_ref="grid_V_4strait_hsum" unit="kg/s"> this * maskMFO_v * $rho0 </field>
<field id="masstr_strait" long_name="Sea water transport across line" grid_ref="grid_4strait" > u_masstr_strait + v_masstr_strait </field>
@@ -1052,12 +1051,6 @@ that are available in the tidal-forcing implementation (see
<field id="ketrd_convP2K" long_name="ke-trend: conversion (potential to kinetic)" unit="W/s^3" />
<field id="KE" long_name="kinetic energy: u(n)*u(n+1)/2" unit="W/s^2" />
- <!-- variables available when explicit lateral mixing is used (ln_dynldf_OFF=F) -->
- <field id="dispkexyfo" long_name="KE-trend: lateral mixing induced dissipation" standard_name="ocean_kinetic_energy_dissipation_per_unit_area_due_to_xy_friction" unit="W/m^2" grid_ref="grid_T_2D" />
- <field id="dispkevfo" long_name="KE-trend: vertical mixing induced dissipation" standard_name="ocean_kinetic_energy_dissipation_per_unit_area_due_to_vertical_friction" unit="W/m^2" grid_ref="grid_T_2D" />
- <!-- variables available with ln_traadv_eiv=T and ln_diaeiv=T -->
- <field id="eketrd_eiv" long_name="EKE-trend due to parameterized eddy advection" standard_name="tendency_of_ocean_eddy_kinetic_energy_content_due_to_parameterized_eddy_advection" unit="W/m^2" grid_ref="grid_T_2D" />
-
<!-- variables available with ln_PE_trd -->
<field id="petrd_xad" long_name="pe-trend: i-advection" unit="W/m^3" />
<field id="petrd_yad" long_name="pe-trend: j-advection" unit="W/m^3" />
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/cfgs/SHARED/namelist_ref b/cfgs/SHARED/namelist_ref
index dc77ca9a56b679a9a8b7c1dd80edbac11191ea24..f146b16f520b78980d840f0ff104ac0b37d56a4a 100644
--- a/cfgs/SHARED/namelist_ref
+++ b/cfgs/SHARED/namelist_ref
@@ -883,6 +883,9 @@
!
! ! S-EOS coefficients (ln_seos=T):
! ! rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS
+ ! ! dT = T-rn_T0 ; dS = S-rn_S0
+ rn_T0 = 10. ! reference temperature
+ rn_S0 = 35. ! reference salinity
rn_a0 = 1.6550e-1 ! thermal expension coefficient
rn_b0 = 7.6554e-1 ! saline expension coefficient
rn_lambda1 = 5.9520e-2 ! cabbeling coeff in T^2 (=0 for linear eos)
diff --git a/sette/all_functions.sh b/sette/all_functions.sh
index 326b38d1fb7069d5e6d4062dc87625b878d83a3e..d9f87067d7baef11909247a459e203179bcc5348 100755
--- a/sette/all_functions.sh
+++ b/sette/all_functions.sh
@@ -172,7 +172,8 @@ clean_config() {
# define validation dir
set_valid_dir () {
if [ ${DETACHED_HEAD} == "no" ] ; then
- REVISION_NB=`git -C ${MAIN_DIR} rev-list --abbrev-commit origin | head -1l`
+ branchname=$( git branch --show-current )
+ REVISION_NB=$( git -C ${MAIN_DIR} rev-list --abbrev-commit origin/$branchname | head -1l )
else
REVISION_NB=${DETACHED_CMIT}
fi
diff --git a/sette/sette_eval.sh b/sette/sette_eval.sh
index cfe9fe00770d39232e13cf8cfcff6e0bc3976f7b..2d94e7cafc77e7cdf3ee258fd7bdd527cc3b4015 100755
--- a/sette/sette_eval.sh
+++ b/sette/sette_eval.sh
@@ -272,7 +272,7 @@ if [[ $? == 0 ]] ; then
branchname="Unknown"
fi
else
- revision=`git rev-list --abbrev-commit origin | head -1l`
+ revision=$( git rev-list --abbrev-commit origin/$branchname | head -1l )
fi
else
branchname="Unknown"
diff --git a/sette/sette_rpt.sh b/sette/sette_rpt.sh
index dfc9db7a3c350b7896c9704a232c219e28243e5f..1eae7889bf655d4c3caabea33ea437256f8e2f34 100755
--- a/sette/sette_rpt.sh
+++ b/sette/sette_rpt.sh
@@ -584,7 +584,7 @@ if [[ $? == 0 ]] ; then
branchname="Unknown"
fi
else
- revision=`git rev-list --abbrev-commit origin | head -1l`
+ revision=$( git rev-list --abbrev-commit origin/$branchname | head -1l )
fi
else
branchname="Unknown"
diff --git a/src/ABL/sbcabl.F90 b/src/ABL/sbcabl.F90
index c2c1d13c12941ac034f32e782f553b30bba719c2..cd771f978c5dc566915c866f214bbda24edda2d4 100644
--- a/src/ABL/sbcabl.F90
+++ b/src/ABL/sbcabl.F90
@@ -44,6 +44,8 @@ MODULE sbcabl
PUBLIC sbc_abl_init ! routine called in sbcmod module
PUBLIC sbc_abl ! routine called in sbcmod module
+ !! * Substitutions
+# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OPA 3.7 , NEMO-consortium (2014)
!! $Id: sbcabl.F90 6416 2016-04-01 12:22:17Z clem $
@@ -340,7 +342,7 @@ CONTAINS
CALL blk_oce_1( kt, u_abl(:,:,2,nt_n ), v_abl(:,:,2,nt_n ), & ! <<= in
& tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa), & ! <<= in
- & sf(jp_slp )%fnow(:,:,1) , sst_m, ssu_m, ssv_m , & ! <<= in
+ & sf(jp_slp )%fnow(:,:,1) , sst_m(A2D(0)), ssu_m(A2D(0)), ssv_m(A2D(0)), & ! <<= in
& sf(jp_uoatm)%fnow(:,:,1), sf(jp_voatm)%fnow(:,:,1), & ! <<= in
& sf(jp_qsr )%fnow(:,:,1) , sf(jp_qlw )%fnow(:,:,1) , & ! <<= in
& tsk_m, zssq, zcd_du, zsen, zlat, zevp ) ! =>> out
@@ -348,7 +350,7 @@ CONTAINS
#if defined key_si3
CALL blk_ice_1( u_abl(:,:,2,nt_n ), v_abl(:,:,2,nt_n ), & ! <<= in
& tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa), & ! <<= in
- & sf(jp_slp)%fnow(:,:,1) , u_ice, v_ice, tm_su , & ! <<= in
+ & sf(jp_slp)%fnow(:,:,1) , u_ice(A2D(0)), v_ice(A2D(0)), tm_su , & ! <<= in
& pseni=zseni, pevpi=zevpi, pssqi=zssqi, pcd_dui=zcd_dui ) ! <<= out
#endif
diff --git a/src/ICE/ice.F90 b/src/ICE/ice.F90
index 67bce2c4ae0e5ab22daceb6760abbceef7a2ef66..889e726d79dfcd8760d35dd56ca303cce4c1bd01 100644
--- a/src/ICE/ice.F90
+++ b/src/ICE/ice.F90
@@ -451,6 +451,8 @@ MODULE ice
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qcn_ice_bot !: Bottom conduction flux (W/m2)
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qcn_ice_top !: Surface conduction flux (W/m2)
!
+ !! * Substitutions
+# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/ICE 4.0 , NEMO Consortium (2018)
!! $Id: ice.F90 15388 2021-10-17 11:33:47Z clem $
@@ -464,71 +466,103 @@ CONTAINS
!!-----------------------------------------------------------------
INTEGER :: ice_alloc
!
- INTEGER :: ierr(16), ii
+ INTEGER :: ierr(21), ii
!!-----------------------------------------------------------------
ierr(:) = 0
+ ii = 0
+ ! ----------------- !
+ ! == FULL ARRAYS == !
+ ! ----------------- !
+
+ ! * Ice global state variables
+ ii = ii + 1
+ ALLOCATE( u_ice(jpi,jpj) , v_ice(jpi,jpj) , STAT=ierr(ii) )
- ii = 1
- ALLOCATE( u_oce (jpi,jpj) , v_oce (jpi,jpj) , ht_i_new (jpi,jpj) , fraz_frac (jpi,jpj) , &
- & strength (jpi,jpj) , stress1_i(jpi,jpj) , stress2_i(jpi,jpj) , stress12_i(jpi,jpj) , &
- & delta_i (jpi,jpj) , divu_i (jpi,jpj) , shear_i (jpi,jpj) , &
- & aniso_11 (jpi,jpj) , aniso_12 (jpi,jpj) , rdg_conv (jpi,jpj) , STAT=ierr(ii) )
+ ii = ii + 1
+ ALLOCATE( h_i (jpi,jpj,jpl) , a_i (jpi,jpj,jpl) , v_i (jpi,jpj,jpl) , &
+ & v_s (jpi,jpj,jpl) , h_s (jpi,jpj,jpl) , &
+ & s_i (jpi,jpj,jpl) , sv_i(jpi,jpj,jpl) , o_i (jpi,jpj,jpl) , oa_i (jpi,jpj,jpl) , &
+ & a_ip (jpi,jpj,jpl) , v_ip(jpi,jpj,jpl) , h_ip(jpi,jpj,jpl), &
+ & v_il (jpi,jpj,jpl) , h_il(jpi,jpj,jpl) , &
+ & t_su (jpi,jpj,jpl) , t_s (jpi,jpj,nlay_s,jpl) , t_i(jpi,jpj,nlay_i,jpl) , sz_i(jpi,jpj,nlay_i,jpl) , &
+ & ato_i(jpi,jpj) , STAT = ierr(ii) )
ii = ii + 1
- ALLOCATE( t_bo (jpi,jpj) , wfx_snw_sni(jpi,jpj) , &
- & wfx_snw (jpi,jpj) , wfx_snw_dyn(jpi,jpj) , wfx_snw_sum(jpi,jpj) , wfx_snw_sub(jpi,jpj) , &
- & wfx_ice (jpi,jpj) , wfx_sub (jpi,jpj) , wfx_ice_sub(jpi,jpj) , wfx_lam (jpi,jpj) , &
- & wfx_pnd (jpi,jpj) , &
- & wfx_bog (jpi,jpj) , wfx_dyn (jpi,jpj) , wfx_bom(jpi,jpj) , wfx_sum(jpi,jpj) , &
- & wfx_res (jpi,jpj) , wfx_sni (jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) , &
- & rn_amax_2d (jpi,jpj) , &
- & qsb_ice_bot(jpi,jpj) , qlead (jpi,jpj) , &
- & sfx_res (jpi,jpj) , sfx_bri (jpi,jpj) , sfx_dyn(jpi,jpj) , sfx_sub(jpi,jpj) , sfx_lam(jpi,jpj) , &
- & sfx_bog (jpi,jpj) , sfx_bom (jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) , &
- & hfx_res (jpi,jpj) , hfx_snw (jpi,jpj) , hfx_sub(jpi,jpj) , &
- & qt_atm_oi (jpi,jpj) , qt_oce_ai (jpi,jpj) , fhld (jpi,jpj) , &
- & hfx_sum (jpi,jpj) , hfx_bom (jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) , &
- & hfx_opw (jpi,jpj) , hfx_thd (jpi,jpj) , hfx_dyn(jpi,jpj) , hfx_spr(jpi,jpj) , &
- & hfx_err_dif(jpi,jpj) , wfx_err_sub(jpi,jpj) , STAT=ierr(ii) )
+ ALLOCATE( e_s(jpi,jpj,nlay_s,jpl) , e_i(jpi,jpj,nlay_i,jpl) , STAT=ierr(ii) )
- ! * Ice global state variables
+ ! * Before values of global variables
ii = ii + 1
- ALLOCATE( qtr_ice_bot(jpi,jpj,jpl) , cnd_ice(jpi,jpj,jpl) , t1_ice(jpi,jpj,jpl) , &
- & h_i (jpi,jpj,jpl) , a_i (jpi,jpj,jpl) , v_i (jpi,jpj,jpl) , &
- & v_s (jpi,jpj,jpl) , h_s (jpi,jpj,jpl) , t_su (jpi,jpj,jpl) , &
- & s_i (jpi,jpj,jpl) , sv_i (jpi,jpj,jpl) , o_i (jpi,jpj,jpl) , &
- & oa_i (jpi,jpj,jpl) , bv_i (jpi,jpj,jpl) , STAT=ierr(ii) )
+ ALLOCATE( u_ice_b(jpi,jpj) , v_ice_b(jpi,jpj) , STAT=ierr(ii) )
+ ! * fluxes
ii = ii + 1
- ALLOCATE( u_ice(jpi,jpj) , v_ice(jpi,jpj) , &
- & vt_i (jpi,jpj) , vt_s (jpi,jpj) , st_i(jpi,jpj) , at_i(jpi,jpj) , ato_i(jpi,jpj) , &
- & et_i (jpi,jpj) , et_s (jpi,jpj) , tm_i(jpi,jpj) , tm_s(jpi,jpj) , &
- & sm_i (jpi,jpj) , tm_su(jpi,jpj) , hm_i(jpi,jpj) , hm_s(jpi,jpj) , &
- & om_i (jpi,jpj) , bvm_i(jpi,jpj) , tau_icebfr(jpi,jpj), icb_mask(jpi,jpj), STAT=ierr(ii) )
+ ALLOCATE( wfx_res(jpi,jpj) , sfx_res(jpi,jpj) , hfx_res(jpi,jpj) , STAT=ierr(ii) ) ! full arrays since it is used in conjonction with global variables
+
+ ! * ice rheology
+ ii = ii+1
+ ALLOCATE( u_oce (jpi,jpj) , v_oce (jpi,jpj) , &
+ & strength (jpi,jpj) , stress1_i(jpi,jpj) , stress2_i(jpi,jpj) , stress12_i(jpi,jpj) , &
+ & aniso_11 (jpi,jpj) , aniso_12 (jpi,jpj) , rdg_conv (jpi,jpj) , &
+ & icb_mask (jpi,jpj) , STAT=ierr(ii) )
+ ! * mean and total
+ ii = ii + 1
+ ALLOCATE( vt_i (jpi,jpj) , vt_s (jpi,jpj) , at_i (jpi,jpj) , & ! full arrays since they are used in rheology
+ & vt_ip(jpi,jpj) , vt_il(jpi,jpj) , at_ip(jpi,jpj) , STAT=ierr(ii) )
+
+ ! * others
ii = ii + 1
- ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) , e_s(jpi,jpj,nlay_s,jpl) , STAT=ierr(ii) )
+ ALLOCATE( t_bo(jpi,jpj) , rn_amax_2d(jpi,jpj) , STAT=ierr(ii) )
+
+ ! -------------------- !
+ ! == REDUCED ARRAYS == !
+ ! -------------------- !
+ ! * Ice global state variables
ii = ii + 1
- ALLOCATE( t_i(jpi,jpj,nlay_i,jpl) , e_i(jpi,jpj,nlay_i,jpl) , sz_i(jpi,jpj,nlay_i,jpl) , STAT=ierr(ii) )
+ ALLOCATE( bv_i(A2D(0),jpl) , a_ip_frac(A2D(0),jpl) , a_ip_eff(A2D(0),jpl) , STAT=ierr(ii) )
+ ! * Before values of global variables
ii = ii + 1
- ALLOCATE( a_ip(jpi,jpj,jpl) , v_ip(jpi,jpj,jpl) , a_ip_frac(jpi,jpj,jpl) , h_ip(jpi,jpj,jpl), &
- & v_il(jpi,jpj,jpl) , h_il(jpi,jpj,jpl) , a_ip_eff (jpi,jpj,jpl) , &
- & dh_i_sum_2d(jpi,jpj,jpl) , dh_s_mlt_2d(jpi,jpj,jpl) , STAT = ierr(ii) )
+ ALLOCATE( at_i_b(A2D(0)) , h_i_b (A2D(0),jpl) , a_i_b(A2D(0),jpl) , v_i_b(A2D(0),jpl) , &
+ & v_s_b (A2D(0),jpl) , h_s_b (A2D(0),jpl) , &
+ & v_ip_b(A2D(0),jpl) , v_il_b(A2D(0),jpl) , &
+ & sv_i_b(A2D(0),jpl) , e_i_b (A2D(0),nlay_i,jpl) , e_s_b(A2D(0),nlay_s,jpl) , STAT=ierr(ii) )
+ ! * fluxes
ii = ii + 1
- ALLOCATE( at_ip(jpi,jpj) , hm_ip(jpi,jpj) , vt_ip(jpi,jpj) , hm_il(jpi,jpj) , vt_il(jpi,jpj) , STAT = ierr(ii) )
+ ALLOCATE( qsb_ice_bot(A2D(0)) , qlead (A2D(0)) , qt_atm_oi (A2D(0)) , qt_oce_ai (A2D(0)) , fhld (A2D(0)) , &
+ & wfx_snw_sni(A2D(0)) , wfx_snw (A2D(0)) , wfx_snw_dyn(A2D(0)) , wfx_snw_sum(A2D(0)) , wfx_snw_sub(A2D(0)) , &
+ & wfx_ice (A2D(0)) , wfx_sub (A2D(0)) , wfx_ice_sub(A2D(0)) , wfx_lam (A2D(0)) , &
+ & wfx_pnd (A2D(0)) , &
+ & wfx_bog (A2D(0)) , wfx_dyn (A2D(0)) , wfx_bom(A2D(0)) , wfx_sum(A2D(0)) , &
+ & wfx_sni (A2D(0)) , wfx_opw (A2D(0)) , wfx_spr(A2D(0)) , &
+ & &
+ & sfx_bri (A2D(0)) , sfx_dyn (A2D(0)) , sfx_sub(A2D(0)) , sfx_lam(A2D(0)) , &
+ & sfx_bog (A2D(0)) , sfx_bom (A2D(0)) , sfx_sum(A2D(0)) , sfx_sni(A2D(0)) , sfx_opw(A2D(0)) , &
+ & hfx_snw (A2D(0)) , hfx_sub (A2D(0)) , &
+ & hfx_sum (A2D(0)) , hfx_bom (A2D(0)) , hfx_bog(A2D(0)) , hfx_dif(A2D(0)) , &
+ & hfx_opw (A2D(0)) , hfx_thd (A2D(0)) , hfx_dyn(A2D(0)) , hfx_spr(A2D(0)) , &
+ & hfx_err_dif(A2D(0)) , wfx_err_sub(A2D(0)) , STAT=ierr(ii) )
+ ii = ii + 1
+ ALLOCATE( qtr_ice_bot(A2D(0),jpl) , cnd_ice(A2D(0),jpl) , t1_ice(A2D(0),jpl) , STAT=ierr(ii) )
+
+ ! * ice rheology
+ ii = ii+1
+ ALLOCATE( delta_i(A2D(0)) , divu_i(A2D(0)) , shear_i(A2D(0)) , STAT=ierr(ii) )
- ! * Old values of global variables
+ ! * mean and total
ii = ii + 1
- ALLOCATE( v_s_b (jpi,jpj,jpl) , v_i_b (jpi,jpj,jpl) , h_s_b(jpi,jpj,jpl) , h_i_b(jpi,jpj,jpl), &
- & v_ip_b(jpi,jpj,jpl) , v_il_b(jpi,jpj,jpl) , &
- & a_i_b (jpi,jpj,jpl) , sv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i,jpl) , e_s_b(jpi,jpj,nlay_s,jpl) , &
- & STAT=ierr(ii) )
+ ALLOCATE( st_i (A2D(0)) , et_i (A2D(0)) , et_s(A2D(0)) , hm_i (A2D(0)) , &
+ & hm_ip(A2D(0)) , hm_il(A2D(0)) , tm_i(A2D(0)) , tm_s (A2D(0)) , &
+ & sm_i (A2D(0)) , hm_s (A2D(0)) , om_i(A2D(0)) , bvm_i(A2D(0)) , &
+ & tm_su(A2D(0)) , STAT=ierr(ii) )
+ ! * others
ii = ii + 1
- ALLOCATE( u_ice_b(jpi,jpj) , v_ice_b(jpi,jpj) , at_i_b(jpi,jpj) , STAT=ierr(ii) )
+ ALLOCATE( tau_icebfr(A2D(0)) , dh_i_sum_2d(A2D(0),jpl) , dh_s_mlt_2d(A2D(0),jpl) , STAT=ierr(ii) )
+ ii = 1
+ ALLOCATE( ht_i_new (A2D(0)) , fraz_frac (A2D(0)) , STAT=ierr(ii) )
! * Ice thickness distribution variables
ii = ii + 1
@@ -536,19 +570,19 @@ CONTAINS
! * Ice diagnostics
ii = ii + 1
- ALLOCATE( diag_trp_vi(jpi,jpj) , diag_trp_vs (jpi,jpj) , diag_trp_ei(jpi,jpj), &
- & diag_trp_es(jpi,jpj) , diag_trp_sv (jpi,jpj) , diag_heat (jpi,jpj), &
- & diag_sice (jpi,jpj) , diag_vice (jpi,jpj) , diag_vsnw (jpi,jpj), diag_aice(jpi,jpj), diag_vpnd(jpi,jpj), &
- & diag_adv_mass(jpi,jpj), diag_adv_salt(jpi,jpj), diag_adv_heat(jpi,jpj), STAT=ierr(ii) )
+ ALLOCATE( diag_trp_vi (A2D(0)) , diag_trp_vs (A2D(0)) , diag_trp_ei (A2D(0)) , &
+ & diag_trp_es (A2D(0)) , diag_trp_sv (A2D(0)) , diag_heat (A2D(0)) , &
+ & diag_sice (A2D(0)) , diag_vice (A2D(0)) , diag_vsnw (A2D(0)) , diag_aice(A2D(0)) , diag_vpnd(A2D(0)), &
+ & diag_adv_mass(A2D(0)) , diag_adv_salt(A2D(0)) , diag_adv_heat(A2D(0)) , STAT=ierr(ii) )
! * Ice conservation
ii = ii + 1
- ALLOCATE( diag_v (jpi,jpj) , diag_s (jpi,jpj) , diag_t (jpi,jpj), &
- & diag_fv(jpi,jpj) , diag_fs(jpi,jpj) , diag_ft(jpi,jpj), STAT=ierr(ii) )
+ ALLOCATE( diag_v (A2D(0)) , diag_s (A2D(0)) , diag_t (A2D(0)), &
+ & diag_fv(A2D(0)) , diag_fs(A2D(0)) , diag_ft(A2D(0)), STAT=ierr(ii) )
! * SIMIP diagnostics
ii = ii + 1
- ALLOCATE( t_si(jpi,jpj,jpl) , tm_si(jpi,jpj) , qcn_ice_bot(jpi,jpj,jpl) , qcn_ice_top(jpi,jpj,jpl) , STAT = ierr(ii) )
+ ALLOCATE( t_si(A2D(0),jpl) , tm_si(A2D(0)) , qcn_ice_bot(A2D(0),jpl) , qcn_ice_top(A2D(0),jpl) , STAT = ierr(ii) )
ice_alloc = MAXVAL( ierr(:) )
IF( ice_alloc /= 0 ) CALL ctl_stop( 'STOP', 'ice_alloc: failed to allocate arrays.' )
diff --git a/src/ICE/icealb.F90 b/src/ICE/icealb.F90
index 7a7b3e42af1420de1b15357108daf681858dbdc3..af7e868657a385de80f4030979f09463adac5813 100644
--- a/src/ICE/icealb.F90
+++ b/src/ICE/icealb.F90
@@ -48,7 +48,7 @@ MODULE icealb
!!----------------------------------------------------------------------
CONTAINS
- SUBROUTINE ice_alb( pt_su, ph_ice, ph_snw, ld_pnd_alb, pafrac_pnd, ph_pnd, pcloud_fra, palb_ice )
+ SUBROUTINE ice_alb( ld_pnd_alb, pt_su, ph_ice, ph_snw, pafrac_pnd, ph_pnd, pcloud_fra, palb_ice )
!!----------------------------------------------------------------------
!! *** ROUTINE ice_alb ***
!!
@@ -94,16 +94,16 @@ CONTAINS
!! Brandt et al. 2005, J. Climate, vol 18
!! Grenfell & Perovich 2004, JGR, vol 109
!!----------------------------------------------------------------------
- REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: pt_su ! ice surface temperature (Kelvin)
- REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: ph_ice ! sea-ice thickness
- REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: ph_snw ! snow depth
- LOGICAL , INTENT(in ) :: ld_pnd_alb ! effect of melt ponds on albedo
- REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: pafrac_pnd ! melt pond relative fraction (per unit ice area)
- REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: ph_pnd ! melt pond depth
- REAL(wp), INTENT(in ), DIMENSION(:,:) :: pcloud_fra ! cloud fraction
- REAL(wp), INTENT( out), DIMENSION(:,:,:) :: palb_ice ! albedo of ice
+ LOGICAL , INTENT(in ) :: ld_pnd_alb ! effect of melt ponds on albedo
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0),jpl) :: pt_su ! ice surface temperature (Kelvin)
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0),jpl) :: ph_ice ! sea-ice thickness
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0),jpl) :: ph_snw ! snow depth
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0),jpl) :: pafrac_pnd ! melt pond relative fraction (per unit ice area)
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0),jpl) :: ph_pnd ! melt pond depth
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: pcloud_fra ! cloud fraction
+ REAL(wp), INTENT( out), DIMENSION(A2D(0),jpl) :: palb_ice ! albedo of ice
!
- REAL(wp), DIMENSION(jpi,jpj,jpl) :: za_s_fra ! ice fraction covered by snow
+ REAL(wp), DIMENSION(A2D(0),jpl) :: za_s_fra ! ice fraction covered by snow
INTEGER :: ji, jj, jl ! dummy loop indices
REAL(wp) :: z1_c1, z1_c2,z1_c3, z1_c4 ! local scalar
REAL(wp) :: z1_href_pnd ! inverse of the characteristic length scale (Lecomte et al. 2015)
@@ -121,10 +121,10 @@ CONTAINS
z1_c3 = 1._wp / 0.02_wp
z1_c4 = 1._wp / 0.03_wp
!
- CALL ice_var_snwfra( ph_snw, za_s_fra ) ! calculate ice fraction covered by snow
+ CALL ice_var_snwfra( ph_snw(:,:,:), za_s_fra(:,:,:) ) ! calculate ice fraction covered by snow
!
DO jl = 1, jpl
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! palb_ice used over the full domain in icesbc
+ DO_2D( 0, 0, 0, 0 ) ! palb_ice used over the full domain in icesbc
!
!---------------------------------------------!
!--- Specific snow, ice and pond fractions ---!
@@ -164,10 +164,10 @@ CONTAINS
zalb_pnd = rn_alb_dpnd - ( rn_alb_dpnd - zalb_ice ) * EXP( - ph_pnd(ji,jj,jl) * z1_href_pnd )
!
! !--- Surface albedo is weighted mean of snow, ponds and bare ice contributions
- zalb_os = ( zafrac_snw * zalb_snw + zafrac_pnd * zalb_pnd + zafrac_ice * zalb_ice ) * tmask(ji,jj,1)
+ zalb_os = ( zafrac_snw * zalb_snw + zafrac_pnd * zalb_pnd + zafrac_ice * zalb_ice ) * smask0(ji,jj)
!
zalb_cs = zalb_os - ( - 0.1010_wp * zalb_os * zalb_os &
- & + 0.1933_wp * zalb_os - 0.0148_wp ) * tmask(ji,jj,1)
+ & + 0.1933_wp * zalb_os - 0.0148_wp ) * smask0(ji,jj)
!
! albedo depends on cloud fraction because of non-linear spectral effects
palb_ice(ji,jj,jl) = ( 1._wp - pcloud_fra(ji,jj) ) * zalb_cs + pcloud_fra(ji,jj) * zalb_os
diff --git a/src/ICE/icectl.F90 b/src/ICE/icectl.F90
index 9593be4f8f0fd7c38b2cd4f486cf676435fff189..d2057625db3b42caa595134caaaa5dc68d355820 100644
--- a/src/ICE/icectl.F90
+++ b/src/ICE/icectl.F90
@@ -83,25 +83,33 @@ CONTAINS
CHARACTER(len=*), INTENT(in) :: cd_routine ! name of the routine
REAL(wp) , INTENT(inout) :: pdiag_v, pdiag_s, pdiag_t, pdiag_fv, pdiag_fs, pdiag_ft
!!
+ INTEGER :: ji, jj, jl ! dummy loop index
REAL(wp) :: zdiag_mass, zdiag_salt, zdiag_heat
- REAL(wp), DIMENSION(jpi,jpj,10) :: ztmp3
- REAL(wp), DIMENSION(jpi,jpj,jpl,8) :: ztmp4
- REAL(wp), DIMENSION(10) :: zchk3
- REAL(wp), DIMENSION(8) :: zchk4
+ REAL(wp), DIMENSION(A2D(0),10) :: ztmp3
+ REAL(wp), DIMENSION(A2D(0),jpl,8) :: ztmp4
+ REAL(wp), DIMENSION(10) :: zchk3
+ REAL(wp), DIMENSION(8) :: zchk4
!!-------------------------------------------------------------------
!
- ! -- quantities -- !
- ztmp3(:,:,1) = SUM( v_i * rhoi + v_s * rhos + ( v_ip + v_il ) * rhow, dim=3 ) * e1e2t ! volume
- ztmp3(:,:,2) = SUM( sv_i * rhoi, dim=3 ) * e1e2t ! salt
- ztmp3(:,:,3) = ( SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 ) ) * e1e2t ! heat
- !
- ! -- fluxes -- !
- ztmp3(:,:,4) = ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + wfx_lam + wfx_pnd & ! mass
- & + wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + wfx_ice_sub + wfx_spr ) * e1e2t
- ztmp3(:,:,5) = ( sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + sfx_opw & ! salt
- & + sfx_res + sfx_dyn + sfx_sub + sfx_lam ) * e1e2t
- ztmp3(:,:,6) = ( hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw & ! heat
- & - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr ) * e1e2t
+ DO_2D( 0, 0, 0, 0 )
+ ! -- quantities -- !
+ ztmp3(ji,jj,1) = SUM( v_i(ji,jj,:) * rhoi + v_s(ji,jj,:) * rhos + &
+ & ( v_ip(ji,jj,:) + v_il(ji,jj,:) ) * rhow ) * e1e2t(ji,jj) ! volume
+ ztmp3(ji,jj,2) = SUM( sv_i(ji,jj,:) * rhoi ) * e1e2t(ji,jj) ! salt
+ ztmp3(ji,jj,3) = ( SUM( SUM( e_i(ji,jj,:,:), dim=2 ) ) + & ! heat
+ & SUM( SUM( e_s(ji,jj,:,:), dim=2 ) ) ) * e1e2t(ji,jj)
+ !
+ ! -- fluxes -- !
+ ztmp3(ji,jj,4) = ( wfx_bog (ji,jj) + wfx_bom (ji,jj) + wfx_sum (ji,jj) + wfx_sni (ji,jj) & ! mass
+ & + wfx_opw (ji,jj) + wfx_res (ji,jj) + wfx_dyn (ji,jj) + wfx_lam (ji,jj) + wfx_pnd(ji,jj) &
+ & + wfx_snw_sni(ji,jj) + wfx_snw_sum(ji,jj) + wfx_snw_dyn(ji,jj) + wfx_snw_sub(ji,jj) &
+ & + wfx_ice_sub(ji,jj) + wfx_spr(ji,jj) ) * e1e2t(ji,jj)
+ ztmp3(ji,jj,5) = ( sfx_bri(ji,jj) + sfx_bog(ji,jj) + sfx_bom(ji,jj) + sfx_sum(ji,jj) + sfx_sni(ji,jj) + sfx_opw(ji,jj) & ! salt
+ & + sfx_res(ji,jj) + sfx_dyn(ji,jj) + sfx_sub(ji,jj) + sfx_lam(ji,jj) ) * e1e2t(ji,jj)
+ ztmp3(ji,jj,6) = ( hfx_sum(ji,jj) + hfx_bom(ji,jj) + hfx_bog(ji,jj) + hfx_dif(ji,jj) + hfx_opw(ji,jj) + hfx_snw(ji,jj) & ! heat
+ & - hfx_thd(ji,jj) - hfx_dyn(ji,jj) - hfx_res(ji,jj) - hfx_sub(ji,jj) - hfx_spr(ji,jj) ) * e1e2t(ji,jj)
+ !
+ END_2D
!
! -- global sum -- !
zchk3(1:6) = glob_sum_vec( 'icectl', ztmp3(:,:,1:6) )
@@ -123,25 +131,33 @@ CONTAINS
zdiag_heat = ( zchk3(3) - pdiag_t ) * r1_Dt_ice + ( zchk3(6) - pdiag_ft )
! -- max concentration diag -- !
- ztmp3(:,:,7) = SUM( a_i, dim=3 )
- zchk3(7) = glob_max( 'icectl', ztmp3(:,:,7) )
-
+ DO_2D( 0, 0, 0, 0 )
+ ztmp3(ji,jj,7) = SUM( a_i(ji,jj,:) )
+ END_2D
+ zchk3(7) = glob_max( 'icectl', ztmp3(:,:,7) )
+
! -- advection scheme is conservative? -- !
- ztmp3(:,:,8 ) = diag_adv_mass * e1e2t
- ztmp3(:,:,9 ) = diag_adv_heat * e1e2t
- ztmp3(:,:,10) = SUM( a_i + epsi10, dim=3 ) * e1e2t ! ice area (+epsi10 to set a threshold > 0 when there is no ice)
- zchk3(8:10) = glob_sum_vec( 'icectl', ztmp3(:,:,8:10) )
+ DO_2D( 0, 0, 0, 0 )
+ ztmp3(ji,jj,8 ) = diag_adv_mass(ji,jj) * e1e2t(ji,jj)
+ ztmp3(ji,jj,9 ) = diag_adv_heat(ji,jj) * e1e2t(ji,jj)
+ ztmp3(ji,jj,10) = SUM( a_i(ji,jj,:) + epsi10 ) * e1e2t(ji,jj) ! ice area (+epsi10 to set a threshold > 0 when there is no ice)
+ END_2D
+ zchk3(8:10) = glob_sum_vec( 'icectl', ztmp3(:,:,8:10) )
! -- min diags -- !
- ztmp4(:,:,:,1) = v_i
- ztmp4(:,:,:,2) = v_s
- ztmp4(:,:,:,3) = v_ip
- ztmp4(:,:,:,4) = v_il
- ztmp4(:,:,:,5) = a_i
- ztmp4(:,:,:,6) = sv_i
- ztmp4(:,:,:,7) = SUM( e_i, dim=3 )
- ztmp4(:,:,:,8) = SUM( e_s, dim=3 )
- zchk4(1:8) = glob_min_vec( 'icectl', ztmp4(:,:,:,1:8) )
+ DO jl = 1, jpl
+ DO_2D( 0, 0, 0, 0 )
+ ztmp4(ji,jj,jl,1) = v_i(ji,jj,jl)
+ ztmp4(ji,jj,jl,2) = v_s(ji,jj,jl)
+ ztmp4(ji,jj,jl,3) = v_ip(ji,jj,jl)
+ ztmp4(ji,jj,jl,4) = v_il(ji,jj,jl)
+ ztmp4(ji,jj,jl,5) = a_i(ji,jj,jl)
+ ztmp4(ji,jj,jl,6) = sv_i(ji,jj,jl)
+ ztmp4(ji,jj,jl,7) = SUM( e_i(ji,jj,:,jl) )
+ ztmp4(ji,jj,jl,8) = SUM( e_s(ji,jj,:,jl) )
+ END_2D
+ ENDDO
+ zchk4(1:8) = glob_min_vec( 'icectl', ztmp4(:,:,:,1:8) )
IF( lwp ) THEN
! check conservation issues
@@ -188,17 +204,21 @@ CONTAINS
!!-------------------------------------------------------------------
CHARACTER(len=*), INTENT(in) :: cd_routine ! name of the routine
!!
- REAL(wp), DIMENSION(jpi,jpj,4) :: ztmp
- REAL(wp), DIMENSION(4) :: zchk
+ INTEGER :: ji, jj ! dummy loop index
+ REAL(wp), DIMENSION(A2D(0),4) :: ztmp
+ REAL(wp), DIMENSION(4) :: zchk
!!-------------------------------------------------------------------
-
- ztmp(:,:,1) = ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + wfx_pnd + diag_vice + diag_vsnw + diag_vpnd - diag_adv_mass ) * e1e2t ! mass diag
- ztmp(:,:,2) = ( sfx + diag_sice - diag_adv_salt ) * e1e2t ! salt
- ztmp(:,:,3) = ( qt_oce_ai - qt_atm_oi + diag_heat - diag_adv_heat ) * e1e2t ! heat
- ! equivalent to this:
- !! ( -diag_heat + hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw &
- !! & - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr ) * e1e2t )
- ztmp(:,:,4) = SUM( a_i + epsi10, dim=3 ) * e1e2t ! ice area (+epsi10 to set a threshold > 0 when there is no ice)
+ DO_2D( 0, 0, 0, 0 )
+ !
+ ztmp(ji,jj,1) = ( wfx_ice (ji,jj) + wfx_snw (ji,jj) + wfx_pnd (ji,jj) + wfx_spr(ji,jj) + wfx_sub(ji,jj) &
+ & + diag_vice(ji,jj) + diag_vsnw(ji,jj) + diag_vpnd(ji,jj) - diag_adv_mass(ji,jj) ) * e1e2t(ji,jj) ! mass diag
+ ztmp(ji,jj,2) = ( sfx(ji,jj) + diag_sice(ji,jj) - diag_adv_salt(ji,jj) ) * e1e2t(ji,jj) ! salt
+ ztmp(ji,jj,3) = ( qt_oce_ai(ji,jj) - qt_atm_oi(ji,jj) + diag_heat(ji,jj) - diag_adv_heat(ji,jj) ) * e1e2t(ji,jj) ! heat
+ ! equivalent to this:
+ !! ( -diag_heat + hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw &
+ !! & - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr ) * e1e2t )
+ ztmp(ji,jj,4) = SUM( a_i(ji,jj,:) + epsi10 ) * e1e2t(ji,jj) ! ice area (+epsi10 to set a threshold > 0 when there is no ice)
+ END_2D
! global sums
zchk(1:4) = glob_sum_vec( 'icectl', ztmp(:,:,1:4) )
@@ -226,11 +246,11 @@ CONTAINS
!!-------------------------------------------------------------------
INTEGER , INTENT(in) :: icount ! called at: =0 the begining of the routine, =1 the end
CHARACTER(len=*), INTENT(in) :: cd_routine ! name of the routine
- REAL(wp) , DIMENSION(jpi,jpj), INTENT(inout) :: pdiag_v, pdiag_s, pdiag_t, pdiag_fv, pdiag_fs, pdiag_ft
+ REAL(wp) , DIMENSION(A2D(0)), INTENT(inout) :: pdiag_v, pdiag_s, pdiag_t, pdiag_fv, pdiag_fs, pdiag_ft
!!
- REAL(wp), DIMENSION(jpi,jpj) :: zdiag_mass, zdiag_salt, zdiag_heat, &
- & zdiag_amin, zdiag_vmin, zdiag_smin, zdiag_emin !!, zdiag_amax
- INTEGER :: jl, jk
+ REAL(wp), DIMENSION(A2D(0)) :: zdiag_mass, zdiag_salt, zdiag_heat, &
+ & zdiag_amin, zdiag_vmin, zdiag_smin, zdiag_emin !!, zdiag_amax
+ INTEGER :: ji, jj, jl, jk
LOGICAL :: ll_stop_m = .FALSE.
LOGICAL :: ll_stop_s = .FALSE.
LOGICAL :: ll_stop_t = .FALSE.
@@ -239,62 +259,79 @@ CONTAINS
!
IF( icount == 0 ) THEN
- pdiag_v = SUM( v_i * rhoi + v_s * rhos + ( v_ip + v_il ) * rhow, dim=3 )
- pdiag_s = SUM( sv_i * rhoi , dim=3 )
- pdiag_t = SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 )
+ DO_2D( 0, 0, 0, 0 )
+ pdiag_v(ji,jj) = SUM( v_i(ji,jj,:) * rhoi + v_s(ji,jj,:) * rhos + ( v_ip(ji,jj,:) + v_il(ji,jj,:) ) * rhow )
+ pdiag_s(ji,jj) = SUM( sv_i(ji,jj,:) * rhoi )
+ pdiag_t(ji,jj) = SUM( SUM( e_i(ji,jj,:,:), dim=2 ) ) + SUM( SUM( e_s(ji,jj,:,:), dim=2 ) )
! mass flux
- pdiag_fv = wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + wfx_lam + wfx_pnd + &
- & wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + wfx_ice_sub + wfx_spr
+ pdiag_fv(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj) &
+ & + wfx_opw(ji,jj) + wfx_res(ji,jj) + wfx_dyn(ji,jj) + wfx_lam(ji,jj) + wfx_pnd (ji,jj) &
+ & + wfx_snw_sni(ji,jj) + wfx_snw_sum(ji,jj) + wfx_snw_dyn(ji,jj) &
+ & + wfx_snw_sub(ji,jj) + wfx_ice_sub(ji,jj) + wfx_spr(ji,jj)
! salt flux
- pdiag_fs = sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam
+ pdiag_fs(ji,jj) = sfx_bri(ji,jj) + sfx_bog(ji,jj) + sfx_bom(ji,jj) + sfx_sum(ji,jj) + sfx_sni(ji,jj) &
+ & + sfx_opw(ji,jj) + sfx_res(ji,jj) + sfx_dyn(ji,jj) + sfx_sub(ji,jj) + sfx_lam(ji,jj)
! heat flux
- pdiag_ft = hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw &
- & - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr
+ pdiag_ft(ji,jj) = hfx_sum(ji,jj) + hfx_bom(ji,jj) + hfx_bog(ji,jj) + hfx_dif(ji,jj) + hfx_opw(ji,jj) + hfx_snw(ji,jj) &
+ & - hfx_thd(ji,jj) - hfx_dyn(ji,jj) - hfx_res(ji,jj) - hfx_sub(ji,jj) - hfx_spr(ji,jj)
+ END_2D
ELSEIF( icount == 1 ) THEN
-
+
! -- mass diag -- !
- zdiag_mass = ( SUM( v_i * rhoi + v_s * rhos + ( v_ip + v_il ) * rhow, dim=3 ) - pdiag_v ) * r1_Dt_ice &
- & + ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + wfx_lam + wfx_pnd + &
- & wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + wfx_ice_sub + wfx_spr ) &
- & - pdiag_fv
+ DO_2D( 0, 0, 0, 0 )
+ zdiag_mass(ji,jj) = ( SUM( v_i(ji,jj,:) * rhoi + v_s(ji,jj,:) * rhos &
+ & + ( v_ip(ji,jj,:) + v_il(ji,jj,:) ) * rhow ) - pdiag_v(ji,jj) ) * r1_Dt_ice &
+ & + ( wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj) + wfx_opw(ji,jj) &
+ & + wfx_res(ji,jj) + wfx_dyn(ji,jj) + wfx_lam(ji,jj) + wfx_pnd(ji,jj) &
+ & + wfx_snw_sni(ji,jj) + wfx_snw_sum(ji,jj) + wfx_snw_dyn(ji,jj) &
+ & + wfx_snw_sub(ji,jj) + wfx_ice_sub(ji,jj) + wfx_spr(ji,jj) ) &
+ & - pdiag_fv(ji,jj)
+ END_2D
IF( MAXVAL( ABS(zdiag_mass) ) > rchk_m * rn_icechk_cel ) ll_stop_m = .TRUE.
!
! -- salt diag -- !
- zdiag_salt = ( SUM( sv_i * rhoi , dim=3 ) - pdiag_s ) * r1_Dt_ice &
- & + ( sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam ) &
- & - pdiag_fs
+ DO_2D( 0, 0, 0, 0 )
+ zdiag_salt(ji,jj) = ( SUM( sv_i(ji,jj,:) * rhoi ) - pdiag_s(ji,jj) ) * r1_Dt_ice &
+ & + ( sfx_bri(ji,jj) + sfx_bog(ji,jj) + sfx_bom(ji,jj) + sfx_sum(ji,jj) + sfx_sni(ji,jj) &
+ & + sfx_opw(ji,jj) + sfx_res(ji,jj) + sfx_dyn(ji,jj) + sfx_sub(ji,jj) + sfx_lam(ji,jj) ) &
+ & - pdiag_fs(ji,jj)
+ END_2D
IF( MAXVAL( ABS(zdiag_salt) ) > rchk_s * rn_icechk_cel ) ll_stop_s = .TRUE.
!
! -- heat diag -- !
- zdiag_heat = ( SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 ) - pdiag_t ) * r1_Dt_ice &
- & + ( hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw &
- & - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr ) &
- & - pdiag_ft
+ DO_2D( 0, 0, 0, 0 )
+ zdiag_heat(ji,jj) = ( SUM( SUM( e_i(ji,jj,:,:), dim=2 ) ) &
+ & + SUM( SUM( e_s(ji,jj,:,:), dim=2 ) ) - pdiag_t(ji,jj) ) * r1_Dt_ice &
+ & + ( hfx_sum(ji,jj) + hfx_bom(ji,jj) + hfx_bog(ji,jj) &
+ & + hfx_dif(ji,jj) + hfx_opw(ji,jj) + hfx_snw(ji,jj) &
+ & - hfx_thd(ji,jj) - hfx_dyn(ji,jj) - hfx_res(ji,jj) - hfx_sub(ji,jj) - hfx_spr(ji,jj) ) &
+ & - pdiag_ft(ji,jj)
+ END_2D
IF( MAXVAL( ABS(zdiag_heat) ) > rchk_t * rn_icechk_cel ) ll_stop_t = .TRUE.
!
! -- other diags -- !
! a_i < 0
zdiag_amin(:,:) = 0._wp
DO jl = 1, jpl
- WHERE( a_i(:,:,jl) < 0._wp ) zdiag_amin(:,:) = 1._wp
+ WHERE( a_i(A2D(0),jl) < 0._wp ) zdiag_amin(:,:) = 1._wp
ENDDO
! v_i < 0
zdiag_vmin(:,:) = 0._wp
DO jl = 1, jpl
- WHERE( v_i(:,:,jl) < 0._wp ) zdiag_vmin(:,:) = 1._wp
+ WHERE( v_i(A2D(0),jl) < 0._wp ) zdiag_vmin(:,:) = 1._wp
ENDDO
! s_i < 0
zdiag_smin(:,:) = 0._wp
DO jl = 1, jpl
- WHERE( s_i(:,:,jl) < 0._wp ) zdiag_smin(:,:) = 1._wp
+ WHERE( s_i(A2D(0),jl) < 0._wp ) zdiag_smin(:,:) = 1._wp
ENDDO
! e_i < 0
zdiag_emin(:,:) = 0._wp
DO jl = 1, jpl
DO jk = 1, nlay_i
- WHERE( e_i(:,:,jk,jl) < 0._wp ) zdiag_emin(:,:) = 1._wp
+ WHERE( e_i(A2D(0),jk,jl) < 0._wp ) zdiag_emin(:,:) = 1._wp
ENDDO
ENDDO
! a_i > amax
@@ -528,8 +565,8 @@ CONTAINS
INTEGER :: jl, ji, jj
!!-------------------------------------------------------------------
- DO ji = mi0(ki), mi1(ki)
- DO jj = mj0(kj), mj1(kj)
+ DO ji = mi0(ki,nn_hls), mi1(ki,nn_hls)
+ DO jj = mj0(kj,nn_hls), mj1(kj,nn_hls)
WRITE(numout,*) ' time step ',kt,' ',cd1 ! print title
@@ -751,8 +788,9 @@ CONTAINS
!!-------------------------------------------------------------------
INTEGER, INTENT(in) :: kt ! ice time-step index
!
- REAL(wp), DIMENSION(jpi,jpj,6) :: ztmp
- REAL(wp), DIMENSION(6) :: zchk
+ INTEGER :: ji, jj ! dummy loop index
+ REAL(wp), DIMENSION(A2D(0),6) :: ztmp
+ REAL(wp), DIMENSION(6) :: zchk
!!-------------------------------------------------------------------
!
IF( kt == nit000 .AND. lwp ) THEN
@@ -762,25 +800,27 @@ CONTAINS
ENDIF
!
! -- 2D budgets (must be close to 0) -- !
- ztmp(:,:,1) = wfx_ice (:,:) + wfx_snw (:,:) + wfx_spr (:,:) + wfx_sub(:,:) + wfx_pnd(:,:) &
- & + diag_vice(:,:) + diag_vsnw(:,:) + diag_vpnd(:,:) - diag_adv_mass(:,:)
- ztmp(:,:,2) = sfx(:,:) + diag_sice(:,:) - diag_adv_salt(:,:)
- ztmp(:,:,3) = qt_oce_ai(:,:) - qt_atm_oi(:,:) + diag_heat(:,:) - diag_adv_heat(:,:)
-
+ DO_2D( 0, 0, 0, 0 )
+ ztmp(ji,jj,1) = wfx_ice (ji,jj) + wfx_snw (ji,jj) + wfx_spr (ji,jj) + wfx_sub(ji,jj) + wfx_pnd(ji,jj) &
+ & + diag_vice(ji,jj) + diag_vsnw(ji,jj) + diag_vpnd(ji,jj) - diag_adv_mass(ji,jj)
+ ztmp(ji,jj,2) = sfx(ji,jj) + diag_sice(ji,jj) - diag_adv_salt(ji,jj)
+ ztmp(ji,jj,3) = qt_oce_ai(ji,jj) - qt_atm_oi(ji,jj) + diag_heat(ji,jj) - diag_adv_heat(ji,jj)
+ END_2D
! write outputs
CALL iom_put( 'icedrift_mass', ztmp(:,:,1) )
CALL iom_put( 'icedrift_salt', ztmp(:,:,2) )
CALL iom_put( 'icedrift_heat', ztmp(:,:,3) )
! -- 1D budgets -- !
- ztmp(:,:,1) = ztmp(:,:,1) * e1e2t * rDt_ice ! mass
- ztmp(:,:,2) = ztmp(:,:,2) * e1e2t * rDt_ice * 1.e-3 ! salt
- ztmp(:,:,3) = ztmp(:,:,3) * e1e2t ! heat
-
- ztmp(:,:,4) = diag_adv_mass * e1e2t * rDt_ice
- ztmp(:,:,5) = diag_adv_salt * e1e2t * rDt_ice * 1.e-3
- ztmp(:,:,6) = diag_adv_heat * e1e2t
-
+ DO_2D( 0, 0, 0, 0 )
+ ztmp(ji,jj,1) = ztmp(ji,jj,1) * e1e2t(ji,jj) * rDt_ice ! mass
+ ztmp(ji,jj,2) = ztmp(ji,jj,2) * e1e2t(ji,jj) * rDt_ice * 1.e-3 ! salt
+ ztmp(ji,jj,3) = ztmp(ji,jj,3) * e1e2t(ji,jj) ! heat
+
+ ztmp(ji,jj,4) = diag_adv_mass(ji,jj) * e1e2t(ji,jj) * rDt_ice
+ ztmp(ji,jj,5) = diag_adv_salt(ji,jj) * e1e2t(ji,jj) * rDt_ice * 1.e-3
+ ztmp(ji,jj,6) = diag_adv_heat(ji,jj) * e1e2t(ji,jj)
+ END_2D
! global sums
zchk(1:6) = glob_sum_vec( 'icectl', ztmp(:,:,1:6) )
diff --git a/src/ICE/icedia.F90 b/src/ICE/icedia.F90
index 154d89de1e4311b194a31b1e645aa65cf523a6d9..197a6a6c7508052c03e988d712c1eab81d8d77cc 100644
--- a/src/ICE/icedia.F90
+++ b/src/ICE/icedia.F90
@@ -33,6 +33,9 @@ MODULE icedia
PUBLIC ice_dia ! called by icestp.F90
PUBLIC ice_dia_init ! called in icestp.F90
+ !! * Substitutions
+# include "do_loop_substitute.h90"
+
REAL(wp), SAVE :: r1_area ! inverse of the ocean area
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: vol_loc_ini, sal_loc_ini, tem_loc_ini ! initial volume, salt and heat contents
REAL(wp) :: frc_sal, frc_voltop, frc_volbot, frc_temtop, frc_tembot ! global forcing trends
@@ -48,7 +51,7 @@ CONTAINS
!!---------------------------------------------------------------------!
!! *** ROUTINE ice_dia_alloc ***
!!---------------------------------------------------------------------!
- ALLOCATE( vol_loc_ini(jpi,jpj), sal_loc_ini(jpi,jpj), tem_loc_ini(jpi,jpj), STAT=ice_dia_alloc )
+ ALLOCATE( vol_loc_ini(A2D(0)), sal_loc_ini(A2D(0)), tem_loc_ini(A2D(0)), STAT=ice_dia_alloc )
CALL mpp_sum ( 'icedia', ice_dia_alloc )
IF( ice_dia_alloc /= 0 ) CALL ctl_stop( 'STOP', 'ice_dia_alloc: failed to allocate arrays' )
@@ -64,8 +67,9 @@ CONTAINS
!!---------------------------------------------------------------------------
INTEGER, INTENT(in) :: kt ! ocean time step
!!
- REAL(wp), DIMENSION(jpi,jpj,16) :: ztmp
- REAL(wp), DIMENSION(16) :: zbg
+ INTEGER :: ji, jj ! dummy loop index
+ REAL(wp), DIMENSION(A2D(0),16) :: ztmp
+ REAL(wp), DIMENSION(16) :: zbg
!!---------------------------------------------------------------------------
IF( ln_timing ) CALL timing_start('ice_dia')
@@ -85,31 +89,32 @@ CONTAINS
! 1 - Trends due to forcing !
! ---------------------------!
! they must be kept outside an IF(iom_use) because of the call to dia_rst below
- ztmp(:,:,1) = - ( wfx_ice(:,:) + wfx_snw(:,:) + wfx_err_sub(:,:) ) * e1e2t(:,:) ! freshwater flux ice/snow-ocean
- ztmp(:,:,2) = - ( wfx_sub(:,:) + wfx_spr(:,:) ) * e1e2t(:,:) ! freshwater flux ice/snow-atm
- ztmp(:,:,3) = - sfx (:,:) * e1e2t(:,:) ! salt fluxes ice/snow-ocean
- ztmp(:,:,4) = qt_atm_oi(:,:) * e1e2t(:,:) ! heat on top of ice-ocean
- ztmp(:,:,5) = qt_oce_ai(:,:) * e1e2t(:,:) ! heat on top of ocean (and below ice)
-
+ DO_2D( 0, 0, 0, 0 )
+ ztmp(ji,jj,1) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) + wfx_err_sub(ji,jj) ) * e1e2t(ji,jj) ! freshwater flux ice/snow-ocean
+ ztmp(ji,jj,2) = - ( wfx_sub(ji,jj) + wfx_spr(ji,jj) ) * e1e2t(ji,jj) ! freshwater flux ice/snow-atm
+ ztmp(ji,jj,3) = - sfx (ji,jj) * e1e2t(ji,jj) ! salt fluxes ice/snow-ocean
+ ztmp(ji,jj,4) = qt_atm_oi(ji,jj) * e1e2t(ji,jj) ! heat on top of ice-ocean
+ ztmp(ji,jj,5) = qt_oce_ai(ji,jj) * e1e2t(ji,jj) ! heat on top of ocean (and below ice)
+ END_2D
! ----------------------- !
! 2 - Contents !
! ----------------------- !
- IF( iom_use('ibgvol_tot' ) ) ztmp(:,:,6 ) = vt_i (:,:) * e1e2t(:,:) ! ice volume
- IF( iom_use('sbgvol_tot' ) ) ztmp(:,:,7 ) = vt_s (:,:) * e1e2t(:,:) ! snow volume
- IF( iom_use('ibgarea_tot') ) ztmp(:,:,8 ) = at_i (:,:) * e1e2t(:,:) ! area
- IF( iom_use('ibgsalt_tot') ) ztmp(:,:,9 ) = st_i (:,:) * e1e2t(:,:) ! salt content
- IF( iom_use('ibgheat_tot') ) ztmp(:,:,10) = et_i (:,:) * e1e2t(:,:) ! heat content
- IF( iom_use('sbgheat_tot') ) ztmp(:,:,11) = et_s (:,:) * e1e2t(:,:) ! heat content
- IF( iom_use('ipbgvol_tot') ) ztmp(:,:,12) = vt_ip(:,:) * e1e2t(:,:) ! ice pond volume
- IF( iom_use('ilbgvol_tot') ) ztmp(:,:,13) = vt_il(:,:) * e1e2t(:,:) ! ice pond lid volume
+ IF( iom_use('ibgvol_tot' ) ) ztmp(:,:,6 ) = vt_i (A2D(0)) * e1e2t(A2D(0)) ! ice volume
+ IF( iom_use('sbgvol_tot' ) ) ztmp(:,:,7 ) = vt_s (A2D(0)) * e1e2t(A2D(0)) ! snow volume
+ IF( iom_use('ibgarea_tot') ) ztmp(:,:,8 ) = at_i (A2D(0)) * e1e2t(A2D(0)) ! area
+ IF( iom_use('ibgsalt_tot') ) ztmp(:,:,9 ) = st_i (:,:) * e1e2t(A2D(0)) ! salt content
+ IF( iom_use('ibgheat_tot') ) ztmp(:,:,10) = et_i (:,:) * e1e2t(A2D(0)) ! heat content
+ IF( iom_use('sbgheat_tot') ) ztmp(:,:,11) = et_s (:,:) * e1e2t(A2D(0)) ! heat content
+ IF( iom_use('ipbgvol_tot') ) ztmp(:,:,12) = vt_ip(A2D(0)) * e1e2t(A2D(0)) ! ice pond volume
+ IF( iom_use('ilbgvol_tot') ) ztmp(:,:,13) = vt_il(A2D(0)) * e1e2t(A2D(0)) ! ice pond lid volume
! ---------------------------------- !
! 3 - Content variations and drifts !
! ---------------------------------- !
- IF( iom_use('ibgvolume') ) ztmp(:,:,14) = ( rhoi*vt_i(:,:) + rhos*vt_s(:,:) - vol_loc_ini(:,:) ) * e1e2t(:,:) ! freshwater trend
- IF( iom_use('ibgsaltco') ) ztmp(:,:,15) = ( rhoi*st_i(:,:) - sal_loc_ini(:,:) ) * e1e2t(:,:) ! salt content trend
+ IF( iom_use('ibgvolume') ) ztmp(:,:,14) = ( rhoi*vt_i(A2D(0)) + rhos*vt_s(A2D(0)) - vol_loc_ini(:,:) ) * e1e2t(A2D(0)) ! freshwater trend
+ IF( iom_use('ibgsaltco') ) ztmp(:,:,15) = ( rhoi*st_i(:,:) - sal_loc_ini(:,:) ) * e1e2t(A2D(0)) ! salt content trend
IF( iom_use('ibgheatco') .OR. iom_use('ibgheatfx') ) &
- & ztmp(:,:,16) = ( et_i(:,:) + et_s(:,:) - tem_loc_ini(:,:) ) * e1e2t(:,:) ! heat content trend
+ & ztmp(:,:,16) = ( et_i(:,:) + et_s(:,:) - tem_loc_ini(:,:) ) * e1e2t(A2D(0)) ! heat content trend
! global sum
zbg(1:16) = glob_sum_vec( 'icedia', ztmp(:,:,1:16) )
@@ -261,9 +266,9 @@ CONTAINS
frc_tembot = 0._wp
frc_sal = 0._wp
! record initial ice volume, salt and temp
- vol_loc_ini(:,:) = rhoi * vt_i(:,:) + rhos * vt_s(:,:) ! ice/snow volume (kg/m2)
- tem_loc_ini(:,:) = et_i(:,:) + et_s(:,:) ! ice/snow heat content (J)
- sal_loc_ini(:,:) = rhoi * st_i(:,:) ! ice salt content (pss*kg/m2)
+ vol_loc_ini(:,:) = rhoi * vt_i(A2D(0)) + rhos * vt_s(A2D(0)) ! ice/snow volume (kg/m2)
+ tem_loc_ini(:,:) = et_i(:,:) + et_s(:,:) ! ice/snow heat content (J)
+ sal_loc_ini(:,:) = rhoi * st_i(:,:) ! ice salt content (pss*kg/m2)
ENDIF
!
ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN ! Create restart file
diff --git a/src/ICE/icedyn.F90 b/src/ICE/icedyn.F90
index dcbe3e77a3a7f6c9a6d9d37b2bc260c983736e6b..687cd916ed23110bcd9930e961649d6ab11dbe6a 100644
--- a/src/ICE/icedyn.F90
+++ b/src/ICE/icedyn.F90
@@ -93,8 +93,8 @@ CONTAINS
!
! retrieve thickness from volume for landfast param. and UMx advection scheme
WHERE( a_i(:,:,:) >= epsi20 )
- h_i(:,:,:) = v_i(:,:,:) / a_i_b(:,:,:)
- h_s(:,:,:) = v_s(:,:,:) / a_i_b(:,:,:)
+ h_i(:,:,:) = v_i(:,:,:) / a_i(:,:,:)
+ h_s(:,:,:) = v_s(:,:,:) / a_i(:,:,:)
ELSEWHERE
h_i(:,:,:) = 0._wp
h_s(:,:,:) = 0._wp
@@ -162,15 +162,12 @@ CONTAINS
CASE ( np_dynADV1D , np_dynADV2D )
- ALLOCATE( zdivu_i(jpi,jpj) )
+ ALLOCATE( zdivu_i(A2D(0)) )
DO_2D( 0, 0, 0, 0 )
zdivu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj) &
& + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) ) * r1_e1e2t(ji,jj)
END_2D
- CALL lbc_lnk( 'icedyn', zdivu_i, 'T', 1.0_wp )
- ! output
CALL iom_put( 'icediv' , zdivu_i )
-
DEALLOCATE( zdivu_i )
END SELECT
diff --git a/src/ICE/icedyn_adv.F90 b/src/ICE/icedyn_adv.F90
index e2beb79a2b6d1d5801210c269b716259a8ec7823..a6d2e957735e1c0663619f52f663e237f61c3215 100644
--- a/src/ICE/icedyn_adv.F90
+++ b/src/ICE/icedyn_adv.F90
@@ -41,6 +41,8 @@ MODULE icedyn_adv
! ** namelist (namdyn_adv) **
INTEGER :: nn_UMx ! order of the UMx advection scheme
!
+ !! * Substitutions
+# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/ICE 4.0 , NEMO Consortium (2018)
!! $Id: icedyn_adv.F90 13472 2020-09-16 13:05:19Z smasson $
@@ -92,11 +94,11 @@ CONTAINS
!------------
! diagnostics
!------------
- diag_trp_ei(:,:) = SUM(SUM( e_i (:,:,1:nlay_i,:) - e_i_b (:,:,1:nlay_i,:), dim=4 ), dim=3 ) * r1_Dt_ice
- diag_trp_es(:,:) = SUM(SUM( e_s (:,:,1:nlay_s,:) - e_s_b (:,:,1:nlay_s,:), dim=4 ), dim=3 ) * r1_Dt_ice
- diag_trp_sv(:,:) = SUM( sv_i(:,:,:) - sv_i_b(:,:,:) , dim=3 ) * r1_Dt_ice
- diag_trp_vi(:,:) = SUM( v_i (:,:,:) - v_i_b (:,:,:) , dim=3 ) * r1_Dt_ice
- diag_trp_vs(:,:) = SUM( v_s (:,:,:) - v_s_b (:,:,:) , dim=3 ) * r1_Dt_ice
+ diag_trp_ei(:,:) = SUM(SUM( e_i (A2D(0),1:nlay_i,:) - e_i_b (A2D(0),1:nlay_i,:), dim=4 ), dim=3 ) * r1_Dt_ice
+ diag_trp_es(:,:) = SUM(SUM( e_s (A2D(0),1:nlay_s,:) - e_s_b (A2D(0),1:nlay_s,:), dim=4 ), dim=3 ) * r1_Dt_ice
+ diag_trp_sv(:,:) = SUM( sv_i(A2D(0),:) - sv_i_b(A2D(0),:) , dim=3 ) * r1_Dt_ice
+ diag_trp_vi(:,:) = SUM( v_i (A2D(0),:) - v_i_b (A2D(0),:) , dim=3 ) * r1_Dt_ice
+ diag_trp_vs(:,:) = SUM( v_s (A2D(0),:) - v_s_b (A2D(0),:) , dim=3 ) * r1_Dt_ice
IF( iom_use('icemtrp') ) CALL iom_put( 'icemtrp' , diag_trp_vi * rhoi ) ! ice mass transport
IF( iom_use('snwmtrp') ) CALL iom_put( 'snwmtrp' , diag_trp_vs * rhos ) ! snw mass transport
IF( iom_use('salmtrp') ) CALL iom_put( 'salmtrp' , diag_trp_sv * rhoi * 1.e-03 ) ! salt mass transport (kg/m2/s)
diff --git a/src/ICE/icedyn_adv_pra.F90 b/src/ICE/icedyn_adv_pra.F90
index 28c12eb81037564fbadafa6a3f8ff8d1b217b875..54a90afdc79fcc2a8de05e609900434e5927a3b1 100644
--- a/src/ICE/icedyn_adv_pra.F90
+++ b/src/ICE/icedyn_adv_pra.F90
@@ -89,7 +89,7 @@ CONTAINS
INTEGER :: icycle ! number of sub-timestep for the advection
REAL(wp) :: zdt, z1_dt ! - -
REAL(wp), DIMENSION(1) :: zcflprv, zcflnow ! for global communication
- REAL(wp), DIMENSION(jpi,jpj) :: zati1, zati2
+ REAL(wp), DIMENSION(A2D(0)) :: zati1, zati2
REAL(wp), DIMENSION(jpi,jpj) :: zudy, zvdx
REAL(wp), DIMENSION(jpi,jpj,jpl) :: zhi_max, zhs_max, zhip_max, zs_i, zsi_max
REAL(wp), DIMENSION(jpi,jpj,nlay_i,jpl) :: ze_i, zei_max
@@ -100,7 +100,7 @@ CONTAINS
REAL(wp), DIMENSION(jpi,jpj,nlay_s,jpl) :: z0es
REAL(wp), DIMENSION(jpi,jpj,nlay_i,jpl) :: z0ei
!! diagnostics
- REAL(wp), DIMENSION(jpi,jpj) :: zdiag_adv_mass, zdiag_adv_salt, zdiag_adv_heat
+ REAL(wp), DIMENSION(A2D(0)) :: zdiag_adv_mass, zdiag_adv_salt, zdiag_adv_heat
!!----------------------------------------------------------------------
!
IF( kt == nit000 .AND. lwp ) WRITE(numout,*) '-- ice_dyn_adv_pra: Prather advection scheme'
@@ -129,8 +129,7 @@ CONTAINS
END DO
CALL icemax4D( ze_i , zei_max )
CALL icemax4D( ze_s , zes_max )
- CALL lbc_lnk( 'icedyn_adv_pra', zei_max, 'T', 1._wp )
- CALL lbc_lnk( 'icedyn_adv_pra', zes_max, 'T', 1._wp )
+ CALL lbc_lnk( 'icedyn_adv_pra', zei_max, 'T', 1._wp, zes_max, 'T', 1._wp )
!
!
! --- If ice drift is too fast, use subtime steps for advection (CFL test for stability) --- !
@@ -155,14 +154,14 @@ CONTAINS
DO jt = 1, icycle
! diagnostics
- zdiag_adv_mass(:,:) = SUM( pv_i (:,:,:) , dim=3 ) * rhoi + SUM( pv_s (:,:,:) , dim=3 ) * rhos &
- & + SUM( pv_ip(:,:,:) , dim=3 ) * rhow + SUM( pv_il(:,:,:) , dim=3 ) * rhow
- zdiag_adv_salt(:,:) = SUM( psv_i(:,:,:) , dim=3 ) * rhoi
- zdiag_adv_heat(:,:) = - SUM(SUM( pe_i(:,:,1:nlay_i,:) , dim=4 ), dim=3 ) &
- & - SUM(SUM( pe_s(:,:,1:nlay_s,:) , dim=4 ), dim=3 )
+ zdiag_adv_mass(:,:) = SUM( pv_i (A2D(0),:) , dim=3 ) * rhoi + SUM( pv_s (A2D(0),:) , dim=3 ) * rhos &
+ & + SUM( pv_ip(A2D(0),:) , dim=3 ) * rhow + SUM( pv_il(A2D(0),:) , dim=3 ) * rhow
+ zdiag_adv_salt(:,:) = SUM( psv_i(A2D(0),:) , dim=3 ) * rhoi
+ zdiag_adv_heat(:,:) = - SUM(SUM( pe_i(A2D(0),1:nlay_i,:) , dim=4 ), dim=3 ) &
+ & - SUM(SUM( pe_s(A2D(0),1:nlay_s,:) , dim=4 ), dim=3 )
! record at_i before advection (for open water)
- zati1(:,:) = SUM( pa_i(:,:,:), dim=3 )
+ zati1(:,:) = SUM( pa_i(A2D(0),:), dim=3 )
! --- transported fields --- !
DO jl = 1, jpl
@@ -275,8 +274,8 @@ CONTAINS
& , z0oi , 'T', 1._wp, sxage , 'T', -1._wp, syage , 'T', -1._wp & ! ice age
& , sxxage, 'T', 1._wp, syyage, 'T', 1._wp, sxyage, 'T', 1._wp )
CALL lbc_lnk( 'icedyn_adv_pra', z0es , 'T', 1._wp, sxc0 , 'T', -1._wp, syc0 , 'T', -1._wp & ! snw enthalpy
- & , sxxc0 , 'T', 1._wp, syyc0 , 'T', 1._wp, sxyc0 , 'T', 1._wp )
- CALL lbc_lnk( 'icedyn_adv_pra', z0ei , 'T', 1._wp, sxe , 'T', -1._wp, sye , 'T', -1._wp & ! ice enthalpy
+ & , sxxc0 , 'T', 1._wp, syyc0 , 'T', 1._wp, sxyc0 , 'T', 1._wp &
+ & , z0ei , 'T', 1._wp, sxe , 'T', -1._wp, sye , 'T', -1._wp & ! ice enthalpy
& , sxxe , 'T', 1._wp, syye , 'T', 1._wp, sxye , 'T', 1._wp )
IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN
IF( ln_pnd_lids ) THEN
@@ -317,7 +316,7 @@ CONTAINS
END DO
!
! derive open water from ice concentration
- zati2(:,:) = SUM( pa_i(:,:,:), dim=3 )
+ zati2(:,:) = SUM( pa_i(A2D(0),:), dim=3 )
DO_2D( 0, 0, 0, 0 )
pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) & !--- open water
& - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt
@@ -325,13 +324,13 @@ CONTAINS
CALL lbc_lnk( 'icedyn_adv_pra', pato_i, 'T', 1.0_wp )
!
! --- diagnostics --- !
- diag_adv_mass(:,:) = diag_adv_mass(:,:) + ( SUM( pv_i (:,:,:) , dim=3 ) * rhoi + SUM( pv_s (:,:,:) , dim=3 ) * rhos &
- & + SUM( pv_ip(:,:,:) , dim=3 ) * rhow + SUM( pv_il(:,:,:) , dim=3 ) * rhow &
+ diag_adv_mass(:,:) = diag_adv_mass(:,:) + ( SUM( pv_i (A2D(0),:) , dim=3 ) * rhoi + SUM( pv_s (A2D(0),:) , dim=3 ) * rhos &
+ & + SUM( pv_ip(A2D(0),:) , dim=3 ) * rhow + SUM( pv_il(A2D(0),:) , dim=3 ) * rhow &
& - zdiag_adv_mass(:,:) ) * z1_dt
- diag_adv_salt(:,:) = diag_adv_salt(:,:) + ( SUM( psv_i(:,:,:) , dim=3 ) * rhoi &
+ diag_adv_salt(:,:) = diag_adv_salt(:,:) + ( SUM( psv_i(A2D(0),:) , dim=3 ) * rhoi &
& - zdiag_adv_salt(:,:) ) * z1_dt
- diag_adv_heat(:,:) = diag_adv_heat(:,:) + ( - SUM(SUM( pe_i(:,:,1:nlay_i,:) , dim=4 ), dim=3 ) &
- & - SUM(SUM( pe_s(:,:,1:nlay_s,:) , dim=4 ), dim=3 ) &
+ diag_adv_heat(:,:) = diag_adv_heat(:,:) + ( - SUM(SUM( pe_i(A2D(0),1:nlay_i,:) , dim=4 ), dim=3 ) &
+ & - SUM(SUM( pe_s(A2D(0),1:nlay_s,:) , dim=4 ), dim=3 ) &
& - zdiag_adv_heat(:,:) ) * z1_dt
!
! --- Ensure non-negative fields --- !
diff --git a/src/ICE/icedyn_adv_umx.F90 b/src/ICE/icedyn_adv_umx.F90
index e5113ac90de67aa1d107f9c1aea3275f2c71f9a2..d46b056b8fb94c4e8dbaaa5530e81e4390d050d8 100644
--- a/src/ICE/icedyn_adv_umx.F90
+++ b/src/ICE/icedyn_adv_umx.F90
@@ -104,7 +104,7 @@ CONTAINS
!
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zuv_ho, zvv_ho, zuv_ups, zvv_ups, z1_vi, z1_vs
!! diagnostics
- REAL(wp), DIMENSION(jpi,jpj) :: zdiag_adv_mass, zdiag_adv_salt, zdiag_adv_heat
+ REAL(wp), DIMENSION(A2D(0)) :: zdiag_adv_mass, zdiag_adv_salt, zdiag_adv_heat
!!----------------------------------------------------------------------
!
IF( kt == nit000 .AND. lwp ) WRITE(numout,*) '-- ice_dyn_adv_umx: Ultimate-Macho advection scheme'
@@ -133,8 +133,7 @@ CONTAINS
END DO
CALL icemax4D( ze_i , zei_max )
CALL icemax4D( ze_s , zes_max )
- CALL lbc_lnk( 'icedyn_adv_umx', zei_max, 'T', 1._wp )
- CALL lbc_lnk( 'icedyn_adv_umx', zes_max, 'T', 1._wp )
+ CALL lbc_lnk( 'icedyn_adv_umx', zei_max, 'T', 1._wp, zes_max, 'T', 1._wp )
!
!
! --- If ice drift is too fast, use subtime steps for advection (CFL test for stability) --- !
@@ -182,11 +181,11 @@ CONTAINS
DO jt = 1, icycle
! diagnostics
- zdiag_adv_mass(:,:) = SUM( pv_i (:,:,:) , dim=3 ) * rhoi + SUM( pv_s (:,:,:) , dim=3 ) * rhos &
- & + SUM( pv_ip(:,:,:) , dim=3 ) * rhow + SUM( pv_il(:,:,:) , dim=3 ) * rhow
- zdiag_adv_salt(:,:) = SUM( psv_i(:,:,:) , dim=3 ) * rhoi
- zdiag_adv_heat(:,:) = - SUM(SUM( pe_i(:,:,1:nlay_i,:) , dim=4 ), dim=3 ) &
- & - SUM(SUM( pe_s(:,:,1:nlay_s,:) , dim=4 ), dim=3 )
+ zdiag_adv_mass(:,:) = SUM( pv_i (A2D(0),:) , dim=3 ) * rhoi + SUM( pv_s (A2D(0),:) , dim=3 ) * rhos &
+ & + SUM( pv_ip(A2D(0),:) , dim=3 ) * rhow + SUM( pv_il(A2D(0),:) , dim=3 ) * rhow
+ zdiag_adv_salt(:,:) = SUM( psv_i(A2D(0),:) , dim=3 ) * rhoi
+ zdiag_adv_heat(:,:) = - SUM(SUM( pe_i(A2D(0),1:nlay_i,:) , dim=4 ), dim=3 ) &
+ & - SUM(SUM( pe_s(A2D(0),1:nlay_s,:) , dim=4 ), dim=3 )
! record at_i before advection (for open water)
zati1(:,:) = SUM( pa_i(:,:,:), dim=3 )
@@ -370,8 +369,7 @@ CONTAINS
ELSE
CALL lbc_lnk( 'icedyn_adv_umx', pa_i,'T',1._wp, pv_i,'T',1._wp, pv_s,'T',1._wp, psv_i,'T',1._wp, poa_i,'T',1._wp )
ENDIF
- CALL lbc_lnk( 'icedyn_adv_umx', pe_i, 'T', 1._wp )
- CALL lbc_lnk( 'icedyn_adv_umx', pe_s, 'T', 1._wp )
+ CALL lbc_lnk( 'icedyn_adv_umx', pe_i, 'T', 1._wp, pe_s, 'T', 1._wp )
!
!== Open water area ==!
zati2(:,:) = SUM( pa_i(:,:,:), dim=3 )
@@ -382,13 +380,13 @@ CONTAINS
CALL lbc_lnk( 'icedyn_adv_umx', pato_i, 'T', 1._wp )
!
! --- diagnostics --- !
- diag_adv_mass(:,:) = diag_adv_mass(:,:) + ( SUM( pv_i (:,:,:) , dim=3 ) * rhoi + SUM( pv_s (:,:,:) , dim=3 ) * rhos &
- & + SUM( pv_ip(:,:,:) , dim=3 ) * rhow + SUM( pv_il(:,:,:) , dim=3 ) * rhow &
+ diag_adv_mass(:,:) = diag_adv_mass(:,:) + ( SUM( pv_i (A2D(0),:) , dim=3 ) * rhoi + SUM( pv_s (A2D(0),:) , dim=3 ) * rhos &
+ & + SUM( pv_ip(A2D(0),:) , dim=3 ) * rhow + SUM( pv_il(A2D(0),:) , dim=3 ) * rhow &
& - zdiag_adv_mass(:,:) ) * z1_dt
- diag_adv_salt(:,:) = diag_adv_salt(:,:) + ( SUM( psv_i(:,:,:) , dim=3 ) * rhoi &
+ diag_adv_salt(:,:) = diag_adv_salt(:,:) + ( SUM( psv_i(A2D(0),:) , dim=3 ) * rhoi &
& - zdiag_adv_salt(:,:) ) * z1_dt
- diag_adv_heat(:,:) = diag_adv_heat(:,:) + ( - SUM(SUM( pe_i(:,:,1:nlay_i,:) , dim=4 ), dim=3 ) &
- & - SUM(SUM( pe_s(:,:,1:nlay_s,:) , dim=4 ), dim=3 ) &
+ diag_adv_heat(:,:) = diag_adv_heat(:,:) + ( - SUM(SUM( pe_i(A2D(0),1:nlay_i,:) , dim=4 ), dim=3 ) &
+ & - SUM(SUM( pe_s(A2D(0),1:nlay_s,:) , dim=4 ), dim=3 ) &
& - zdiag_adv_heat(:,:) ) * z1_dt
!
! --- Ensure non-negative fields and in-bound thicknesses --- !
diff --git a/src/ICE/icedyn_rdgrft.F90 b/src/ICE/icedyn_rdgrft.F90
index 661748ea3b97e4f5e25f5780c8d29da6149ddc4d..0f6afe0fbdf3954de4abbd56af2ab44fd6f2e9cd 100644
--- a/src/ICE/icedyn_rdgrft.F90
+++ b/src/ICE/icedyn_rdgrft.F90
@@ -174,7 +174,7 @@ CONTAINS
!
npti = 0 ; nptidx(:) = 0
ipti = 0 ; iptidx(:) = 0
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
IF ( at_i(ji,jj) > epsi10 ) THEN
npti = npti + 1
nptidx( npti ) = (jj - 1) * jpi + ji
@@ -280,8 +280,15 @@ CONTAINS
CALL ice_dyn_1d2d( 2 ) ! --- Move to 2D arrays --- !
ENDIF
+ ! clem: the 3 lbc below could be avoided if calculations above were performed over the full domain
+ ! but we think it is more efficient this way => to check?
+ CALL lbc_lnk( 'icedyn_rdgrft', ato_i , 'T', 1._wp )
+ CALL lbc_lnk( 'icedyn_rdgrft', a_i , 'T', 1._wp, v_i , 'T', 1._wp, v_s , 'T', 1._wp, sv_i, 'T', 1._wp, oa_i, 'T', 1._wp, &
+ & a_ip , 'T', 1._wp, v_ip, 'T', 1._wp, v_il, 'T', 1._wp )
+ CALL lbc_lnk( 'icedyn_rdgrft', e_i , 'T', 1._wp, e_s , 'T', 1._wp )
- CALL ice_var_agg( 1 )
+ ! clem: I think we can comment this line but I am not sure it does not change results
+!!$ CALL ice_var_agg( 1 )
! controls
IF( sn_cfctl%l_prtctl ) CALL ice_prt3D('icedyn_rdgrft') ! prints
@@ -302,8 +309,9 @@ CONTAINS
!! ** Method : Compute the thickness distribution of the ice and open water
!! participating in ridging and of the resulting ridges.
!!-------------------------------------------------------------------
- REAL(wp), DIMENSION(:) , INTENT(in) :: pato_i, pclosing_net
- REAL(wp), DIMENSION(:,:), INTENT(in) :: pa_i, pv_i
+ REAL(wp), DIMENSION(:,:), INTENT(in) :: pa_i, pv_i
+ REAL(wp), DIMENSION(:) , INTENT(in) :: pato_i
+ REAL(wp), DIMENSION(:) , INTENT(in), OPTIONAL :: pclosing_net
!!
INTEGER :: ji, jl ! dummy loop indices
REAL(wp) :: z1_gstar, z1_astar, zhmean, zfac ! local scalar
@@ -504,39 +512,43 @@ CONTAINS
END DO
END DO
!
- ! 3) closing_gross
- !-----------------
- ! Based on the ITD of ridging and ridged ice, convert the net closing rate to a gross closing rate.
- ! NOTE: 0 < aksum <= 1
- WHERE( zaksum(1:npti) > epsi10 ) ; closing_gross(1:npti) = pclosing_net(1:npti) / zaksum(1:npti)
- ELSEWHERE ; closing_gross(1:npti) = 0._wp
- END WHERE
-
- ! correction to closing rate if excessive ice removal
- !----------------------------------------------------
- ! Reduce the closing rate if more than 100% of any ice category would be removed
- ! Reduce the opening rate in proportion
- DO jl = 1, jpl
+ IF( PRESENT( pclosing_net ) ) THEN
+ !
+ ! 3) closing_gross
+ !-----------------
+ ! Based on the ITD of ridging and ridged ice, convert the net closing rate to a gross closing rate.
+ ! NOTE: 0 < aksum <= 1
+ WHERE( zaksum(1:npti) > epsi10 ) ; closing_gross(1:npti) = pclosing_net(1:npti) / zaksum(1:npti)
+ ELSEWHERE ; closing_gross(1:npti) = 0._wp
+ END WHERE
+
+ ! correction to closing rate if excessive ice removal
+ !----------------------------------------------------
+ ! Reduce the closing rate if more than 100% of any ice category would be removed
+ ! Reduce the opening rate in proportion
+ DO jl = 1, jpl
+ DO ji = 1, npti
+ zfac = apartf(ji,jl) * closing_gross(ji) * rDt_ice
+ IF( zfac > pa_i(ji,jl) .AND. apartf(ji,jl) /= 0._wp ) THEN
+ closing_gross(ji) = pa_i(ji,jl) / apartf(ji,jl) * r1_Dt_ice
+ ENDIF
+ END DO
+ END DO
+
+ ! 4) correction to opening if excessive open water removal
+ !---------------------------------------------------------
+ ! Reduce the closing rate if more than 100% of the open water would be removed
+ ! Reduce the opening rate in proportion
DO ji = 1, npti
- zfac = apartf(ji,jl) * closing_gross(ji) * rDt_ice
- IF( zfac > pa_i(ji,jl) .AND. apartf(ji,jl) /= 0._wp ) THEN
- closing_gross(ji) = pa_i(ji,jl) / apartf(ji,jl) * r1_Dt_ice
+ zfac = pato_i(ji) + ( opning(ji) - apartf(ji,0) * closing_gross(ji) ) * rDt_ice
+ IF( zfac < 0._wp ) THEN ! would lead to negative ato_i
+ opning(ji) = apartf(ji,0) * closing_gross(ji) - pato_i(ji) * r1_Dt_ice
+ ELSEIF( zfac > zasum(ji) ) THEN ! would lead to ato_i > asum
+ opning(ji) = apartf(ji,0) * closing_gross(ji) + ( zasum(ji) - pato_i(ji) ) * r1_Dt_ice
ENDIF
END DO
- END DO
-
- ! 4) correction to opening if excessive open water removal
- !---------------------------------------------------------
- ! Reduce the closing rate if more than 100% of the open water would be removed
- ! Reduce the opening rate in proportion
- DO ji = 1, npti
- zfac = pato_i(ji) + ( opning(ji) - apartf(ji,0) * closing_gross(ji) ) * rDt_ice
- IF( zfac < 0._wp ) THEN ! would lead to negative ato_i
- opning(ji) = apartf(ji,0) * closing_gross(ji) - pato_i(ji) * r1_Dt_ice
- ELSEIF( zfac > zasum(ji) ) THEN ! would lead to ato_i > asum
- opning(ji) = apartf(ji,0) * closing_gross(ji) + ( zasum(ji) - pato_i(ji) ) * r1_Dt_ice
- ENDIF
- END DO
+ !
+ ENDIF
!
END SUBROUTINE rdgrft_prep
@@ -861,7 +873,8 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER :: ji, jj, jl ! dummy loop indices
REAL(wp) :: z1_3 ! local scalars
- REAL(wp), DIMENSION(jpi,jpj) :: zmsk, zworka ! temporary array used here
+ REAL(wp), DIMENSION(A2D(0)) :: zworka ! temporary array used here
+ REAL(wp), DIMENSION(jpi,jpj) :: zmsk ! temporary array used here
!!
LOGICAL :: ln_str_R75
REAL(wp) :: zhi, zcp
@@ -886,7 +899,7 @@ CONTAINS
!
! Identify grid cells with ice
npti = 0 ; nptidx(:) = 0
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
IF ( at_i(ji,jj) > epsi10 ) THEN
npti = npti + 1
nptidx( npti ) = (jj - 1) * jpi + ji
@@ -899,7 +912,7 @@ CONTAINS
CALL tab_2d_1d( npti, nptidx(1:npti), ato_i_1d(1:npti) , ato_i )
CALL tab_2d_1d( npti, nptidx(1:npti), zstrength(1:npti) , strength )
- CALL rdgrft_prep( a_i_2d, v_i_2d, ato_i_1d, closing_net )
+ CALL rdgrft_prep( a_i_2d, v_i_2d, ato_i_1d )
!
zaksum(1:npti) = apartf(1:npti,0) !clem: aksum should be defined in the header => local to module
DO jl = 1, jpl
@@ -956,12 +969,20 @@ CONTAINS
CALL tab_1d_2d( npti, nptidx(1:npti), zstrength(1:npti), strength )
!
ENDIF
+ CALL lbc_lnk( 'icedyn_rdgrft', strength, 'T', 1.0_wp ) ! this call could be removed if calculations were done on the full domain
+ ! ! but we decided it is more efficient this way
!
CASE ( np_strh79 ) !== Hibler(1979)'s method ==!
- strength(:,:) = rn_pstar * SUM( v_i(:,:,:), dim=3 ) * EXP( -rn_crhg * ( 1._wp - at_i(:,:) ) ) * zmsk(:,:)
+ !
+ DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ strength(ji,jj) = rn_pstar * SUM( v_i(ji,jj,:) ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) ) * zmsk(ji,jj)
+ END_2D
!
CASE ( np_strcst ) !== Constant strength ==!
- strength(:,:) = rn_str * zmsk(:,:)
+ !
+ DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ strength(ji,jj) = rn_str * zmsk(ji,jj)
+ END_2D
!
END SELECT
!
diff --git a/src/ICE/icedyn_rhg_eap.F90 b/src/ICE/icedyn_rhg_eap.F90
index 797ceba713de4241a41a013adc9add3387d9e756..59fb26ffddd9c8551fe710b7d88b1e59eed2f091 100644
--- a/src/ICE/icedyn_rhg_eap.F90
+++ b/src/ICE/icedyn_rhg_eap.F90
@@ -125,12 +125,12 @@ CONTAINS
!! Bouillon et al., Ocean Modelling 2013
!! Kimmritz et al., Ocean Modelling 2016 & 2017
!!-------------------------------------------------------------------
- INTEGER , INTENT(in ) :: kt ! time step
- INTEGER , INTENT(in ) :: Kmm ! ocean time level index
- REAL(wp), DIMENSION(:,:), INTENT(inout) :: pstress1_i, pstress2_i, pstress12_i !
- REAL(wp), DIMENSION(:,:), INTENT( out) :: pshear_i , pdivu_i , pdelta_i !
- REAL(wp), DIMENSION(:,:), INTENT(inout) :: paniso_11 , paniso_12 ! structure tensor components
- REAL(wp), DIMENSION(:,:), INTENT(inout) :: prdg_conv ! for ridging
+ INTEGER , INTENT(in ) :: kt ! time step
+ INTEGER , INTENT(in ) :: Kmm ! ocean time level index
+ REAL(wp), DIMENSION(:,:) , INTENT(inout) :: pstress1_i, pstress2_i, pstress12_i !
+ REAL(wp), DIMENSION(A2D(0)), INTENT( out) :: pshear_i , pdivu_i , pdelta_i !
+ REAL(wp), DIMENSION(:,:) , INTENT(inout) :: paniso_11 , paniso_12 ! structure tensor components
+ REAL(wp), DIMENSION(:,:) , INTENT(inout) :: prdg_conv ! for ridging
!!
INTEGER :: ji, jj ! dummy loop indices
INTEGER :: jter ! local integers
@@ -148,15 +148,15 @@ CONTAINS
!
REAL(wp) :: zintb, zintn ! dummy argument
REAL(wp) :: zfac_x, zfac_y
- REAL(wp) :: zshear, zdum1, zdum2
+ REAL(wp) :: zdum1, zdum2
REAL(wp) :: zstressptmp, zstressmtmp, zstress12tmpF ! anisotropic stress tensor components
REAL(wp) :: zalphar, zalphas ! for mechanical redistribution
REAL(wp) :: zmresult11, zmresult12, z1dtevpkth, zp5kth, z1_dtevp_A ! for structure tensor evolution
!
REAL(wp), DIMENSION(jpi,jpj) :: zstress12tmp ! anisotropic stress tensor component for regridding
- REAL(wp), DIMENSION(jpi,jpj) :: zyield11, zyield22, zyield12 ! yield surface tensor for history
+ REAL(wp), DIMENSION(A2D(0)) :: zyield11, zyield22, zyield12 ! yield surface tensor for history
REAL(wp), DIMENSION(jpi,jpj) :: zdelta, zp_delt ! delta and P/delta at T points
- REAL(wp), DIMENSION(jpi,jpj) :: zten_i ! tension
+ REAL(wp), DIMENSION(A2D(0)) :: zten_i, zshear ! tension, shear
REAL(wp), DIMENSION(jpi,jpj) :: zbeta ! beta coef from Kimmritz 2017
!
REAL(wp), DIMENSION(jpi,jpj) :: zdt_m ! (dt / ice-snow_mass) on T points
@@ -178,7 +178,6 @@ CONTAINS
REAL(wp), DIMENSION(jpi,jpj) :: ztaux_bi, ztauy_bi ! ice-OceanBottom stress at U-V points (landfast)
REAL(wp), DIMENSION(jpi,jpj) :: ztaux_base, ztauy_base ! ice-bottom stress at U-V points (landfast)
!
- REAL(wp), DIMENSION(jpi,jpj) :: zmsk00, zmsk15
REAL(wp), DIMENSION(jpi,jpj) :: zmsk01x, zmsk01y ! dummy arrays
REAL(wp), DIMENSION(jpi,jpj) :: zmsk00x, zmsk00y ! mask for ice presence
@@ -186,7 +185,8 @@ CONTAINS
REAL(wp), PARAMETER :: zmmin = 1._wp ! ice mass (kg/m2) below which ice velocity becomes very small
REAL(wp), PARAMETER :: zamin = 0.001_wp ! ice concentration below which ice velocity becomes very small
!! --- check convergence
- REAL(wp), DIMENSION(jpi,jpj) :: zu_ice, zv_ice
+ REAL(wp), DIMENSION(A2D(0)) :: zmsk00, zmsk15
+ REAL(wp), DIMENSION(A2D(0)) :: zu_ice, zv_ice
!! --- diags
REAL(wp) :: zsig1, zsig2, zsig12, zfac, z1_strength
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zsig_I, zsig_II, zsig1_p, zsig2_p
@@ -202,11 +202,11 @@ CONTAINS
IF( kt == nit000 .AND. lwp ) WRITE(numout,*) '-- ice_dyn_rhg_eap: EAP sea-ice rheology'
!
! for diagnostics and convergence tests
- DO_2D( 1, 1, 1, 1 )
+ DO_2D( 0, 0, 0, 0 )
zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice , 0 if no ice
END_2D
IF( nn_rhg_chkcvg > 0 ) THEN
- DO_2D( 1, 1, 1, 1 )
+ DO_2D( 0, 0, 0, 0 )
zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less
END_2D
ENDIF
@@ -283,7 +283,14 @@ CONTAINS
! non-embedded sea ice: use ocean surface for slope calculation
zsshdyn(:,:) = ice_var_sshdyn( ssh_m, snwice_mass, snwice_mass_b)
- DO_2D( 0, 0, 0, 0 )
+ DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ zm1 = ( rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj) ) ! Ice/snow mass at U-V points
+!!$ zm1 = ( rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj) + rhow * (vt_ip(ji,jj) + vt_il(ji,jj)) ) ! clem: this should replace the above
+ zmf (ji,jj) = zm1 * ff_t(ji,jj) ! Coriolis at T points (m*f)
+ zdt_m(ji,jj) = zdtevp / MAX( zm1, zmmin ) ! dt/m at T points (for alpha and beta coefficients)
+ END_2D
+
+ DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
! ice fraction at U-V points
zaU(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
@@ -291,8 +298,11 @@ CONTAINS
! Ice/snow mass at U-V points
zm1 = ( rhos * vt_s(ji ,jj ) + rhoi * vt_i(ji ,jj ) )
+!!$ zm1 = ( rhos * vt_s(ji ,jj ) + rhoi * vt_i(ji ,jj ) + rhow * (vt_ip(ji ,jj ) + vt_il(ji ,jj )) ) ! clem: this should replace the above
zm2 = ( rhos * vt_s(ji+1,jj ) + rhoi * vt_i(ji+1,jj ) )
+!!$ zm2 = ( rhos * vt_s(ji+1,jj ) + rhoi * vt_i(ji+1,jj ) + rhow * (vt_ip(ji+1,jj ) + vt_il(ji+1,jj )) ) ! clem: this should replace the above
zm3 = ( rhos * vt_s(ji ,jj+1) + rhoi * vt_i(ji ,jj+1) )
+!!$ zm3 = ( rhos * vt_s(ji ,jj+1) + rhoi * vt_i(ji ,jj+1) + rhow * (vt_ip(ji ,jj+1) + vt_il(ji ,jj+1)) ) ! clem: this should replace the above
zmassU = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm2 * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
zmassV = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm3 * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
@@ -300,12 +310,6 @@ CONTAINS
v_oceU(ji,jj) = 0.25_wp * ( v_oce(ji,jj) + v_oce(ji,jj-1) + v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * umask(ji,jj,1)
u_oceV(ji,jj) = 0.25_wp * ( u_oce(ji,jj) + u_oce(ji-1,jj) + u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * vmask(ji,jj,1)
- ! Coriolis at T points (m*f)
- zmf(ji,jj) = zm1 * ff_t(ji,jj)
-
- ! dt/m at T points (for alpha and beta coefficients)
- zdt_m(ji,jj) = zdtevp / MAX( zm1, zmmin )
-
! m/dt
zmU_t(ji,jj) = zmassU * z1_dtevp
zmV_t(ji,jj) = zmassV * z1_dtevp
@@ -333,12 +337,11 @@ CONTAINS
ELSE ; zmsk01y(ji,jj) = 1._wp ; ENDIF
END_2D
- CALL lbc_lnk( 'icedyn_rhg_eap', zmf, 'T', 1.0_wp, zdt_m, 'T', 1.0_wp )
!
! !== Landfast ice parameterization ==!
!
IF( ln_landfast_L16 ) THEN !-- Lemieux 2016
- DO_2D( 0, 0, 0, 0 )
+ DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
! ice thickness at U-V points
zvU = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
zvV = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
@@ -352,10 +355,9 @@ CONTAINS
zvCr = at_i(ji,jj) * rn_lf_depfra * ht(ji,jj) * ( 1._wp - icb_mask(ji,jj) ) ! if grounded icebergs are read: ocean depth = 0
tau_icebfr(ji,jj) = - rn_lf_bfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) )
END_2D
- CALL lbc_lnk( 'icedyn_rhg_eap', tau_icebfr(:,:), 'T', 1.0_wp )
!
ELSE !-- no landfast
- DO_2D( 0, 0, 0, 0 )
+ DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
ztaux_base(ji,jj) = 0._wp
ztauy_base(ji,jj) = 0._wp
END_2D
@@ -372,14 +374,14 @@ CONTAINS
!
! convergence test
IF( nn_rhg_chkcvg == 1 .OR. nn_rhg_chkcvg == 2 ) THEN
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zu_ice(ji,jj) = u_ice(ji,jj) * umask(ji,jj,1) ! velocity at previous time step
zv_ice(ji,jj) = v_ice(ji,jj) * vmask(ji,jj,1)
END_2D
ENDIF
! --- divergence, tension & shear (Appendix B of Hunke & Dukowicz, 2002) --- !
- DO_2D( 1, 0, 1, 0 )
+ DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
! shear at F points
zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) &
@@ -410,15 +412,13 @@ CONTAINS
! delta at T points
zdelta(ji,jj) = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 )
- END_2D
- CALL lbc_lnk( 'icedyn_rhg_eap', zdelta, 'T', 1.0_wp )
-
- ! P/delta at T points
- DO_2D( 1, 1, 1, 1 )
+ ! P/delta at T points
zp_delt(ji,jj) = strength(ji,jj) / ( zdelta(ji,jj) + rn_creepl )
+
END_2D
+ CALL lbc_lnk( 'icedyn_rhg_eap', zdelta, 'T', 1.0_wp, zp_delt, 'T', 1.0_wp )
- DO_2D( 0, 1, 0, 1 ) ! loop ends at jpi,jpj so that no lbc_lnk are needed for zs1 and zs2
+ DO_2D( 0, 0, 0, 0 )
! shear at T points
zdsT = ( zds(ji,jj ) * e1e2f(ji,jj ) + zds(ji-1,jj ) * e1e2f(ji-1,jj ) &
@@ -471,16 +471,17 @@ CONTAINS
zs1(ji,jj) = ( zs1(ji,jj) * zalph1 + zstressptmp ) * z1_alph1
zs2(ji,jj) = ( zs2(ji,jj) * zalph1 + zstressmtmp ) * z1_alph1
END_2D
- CALL lbc_lnk( 'icedyn_rhg_eap', zstress12tmp, 'T', 1.0_wp , paniso_11, 'T', 1.0_wp , paniso_12, 'T', 1.0_wp)
+ CALL lbc_lnk( 'icedyn_rhg_eap', zstress12tmp, 'T', 1.0_wp , paniso_11, 'T', 1.0_wp , paniso_12, 'T', 1.0_wp, &
+ & zs1, 'T', 1.0_wp, zs2, 'T', 1.0_wp )
! Save beta at T-points for further computations
IF( ln_aEVP ) THEN
- DO_2D( 1, 1, 1, 1 )
+ DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
zbeta(ji,jj) = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) )
END_2D
ENDIF
- DO_2D( 1, 0, 1, 0 )
+ DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
! stress12tmp at F points
zstress12tmpF = ( zstress12tmp(ji,jj+1) * e1e2t(ji,jj+1) + zstress12tmp(ji+1,jj+1) * e1e2t(ji+1,jj+1) &
& + zstress12tmp(ji,jj ) * e1e2t(ji,jj ) + zstress12tmp(ji+1,jj ) * e1e2t(ji+1,jj ) &
@@ -499,10 +500,9 @@ CONTAINS
zs12(ji,jj) = ( zs12(ji,jj) * zalph1 + zstress12tmpF ) * z1_alph1
END_2D
- CALL lbc_lnk( 'icedyn_rhg_eap', zs1, 'T', 1.0_wp, zs2, 'T', 1.0_wp, zs12, 'F', 1.0_wp )
! --- Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) --- !
- DO_2D( 0, 0, 0, 0 )
+ DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
! !--- U points
zfU(ji,jj) = 0.5_wp * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj) &
& + ( zs2(ji+1,jj) * e2t(ji+1,jj) * e2t(ji+1,jj) - zs2(ji,jj) * e2t(ji,jj) * e2t(ji,jj) &
@@ -530,7 +530,7 @@ CONTAINS
! Bouillon et al. 2009 (eq 34-35) => stable
IF( MOD(jter,2) == 0 ) THEN ! even iterations
!
- DO_2D( 0, 0, 0, 0 )
+ DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
! !--- tau_io/(v_oce - v_ice)
zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) ) &
& + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) )
@@ -574,13 +574,7 @@ CONTAINS
& ) * zmsk00y(ji,jj)
ENDIF
END_2D
- CALL lbc_lnk( 'icedyn_rhg_eap', v_ice, 'V', -1.0_wp )
- !
-#if defined key_agrif
-!! CALL agrif_interp_ice( 'V', jter, nn_nevp )
- CALL agrif_interp_ice( 'V' )
-#endif
- IF( ln_bdy ) CALL bdy_ice_dyn( 'V' )
+ IF( nn_hls == 1 ) CALL lbc_lnk( 'icedyn_rhg_eap', v_ice, 'V', -1.0_wp )
!
DO_2D( 0, 0, 0, 0 )
! !--- tau_io/(u_oce - u_ice)
@@ -626,17 +620,13 @@ CONTAINS
& ) * zmsk00x(ji,jj)
ENDIF
END_2D
- CALL lbc_lnk( 'icedyn_rhg_eap', u_ice, 'U', -1.0_wp )
- !
-#if defined key_agrif
-!! CALL agrif_interp_ice( 'U', jter, nn_nevp )
- CALL agrif_interp_ice( 'U' )
-#endif
- IF( ln_bdy ) CALL bdy_ice_dyn( 'U' )
+ IF( nn_hls == 1 ) THEN ; CALL lbc_lnk( 'icedyn_rhg_eap', u_ice, 'U', -1.0_wp )
+ ELSE ; CALL lbc_lnk( 'icedyn_rhg_eap', u_ice, 'U', -1.0_wp, v_ice, 'V', -1.0_wp )
+ ENDIF
!
ELSE ! odd iterations
!
- DO_2D( 0, 0, 0, 0 )
+ DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
! !--- tau_io/(u_oce - u_ice)
zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) ) &
& + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) )
@@ -680,13 +670,7 @@ CONTAINS
& ) * zmsk00x(ji,jj)
ENDIF
END_2D
- CALL lbc_lnk( 'icedyn_rhg_eap', u_ice, 'U', -1.0_wp )
- !
-#if defined key_agrif
-!! CALL agrif_interp_ice( 'U', jter, nn_nevp )
- CALL agrif_interp_ice( 'U' )
-#endif
- IF( ln_bdy ) CALL bdy_ice_dyn( 'U' )
+ IF( nn_hls == 1 ) CALL lbc_lnk( 'icedyn_rhg_eap', u_ice, 'U', -1.0_wp )
!
DO_2D( 0, 0, 0, 0 )
! !--- tau_io/(v_oce - v_ice)
@@ -732,15 +716,19 @@ CONTAINS
& ) * zmsk00y(ji,jj)
ENDIF
END_2D
- CALL lbc_lnk( 'icedyn_rhg_eap', v_ice, 'V', -1.0_wp )
+ IF( nn_hls == 1 ) THEN ; CALL lbc_lnk( 'icedyn_rhg_eap', v_ice, 'V', -1.0_wp )
+ ELSE ; CALL lbc_lnk( 'icedyn_rhg_eap', u_ice, 'U', -1.0_wp, v_ice, 'V', -1.0_wp )
+ ENDIF
!
+ ENDIF
#if defined key_agrif
-!! CALL agrif_interp_ice( 'V', jter, nn_nevp )
- CALL agrif_interp_ice( 'V' )
+!! CALL agrif_interp_ice( 'U', jter, nn_nevp )
+!! CALL agrif_interp_ice( 'V', jter, nn_nevp )
+ CALL agrif_interp_ice( 'U' )
+ CALL agrif_interp_ice( 'V' )
#endif
- IF( ln_bdy ) CALL bdy_ice_dyn( 'V' )
- !
- ENDIF
+ IF( ln_bdy ) CALL bdy_ice_dyn( 'U' )
+ IF( ln_bdy ) CALL bdy_ice_dyn( 'V' )
! convergence test
IF( nn_rhg_chkcvg == 2 ) CALL rhg_cvg_eap( kt, jter, nn_nevp, u_ice, v_ice, zu_ice, zv_ice, zmsk15 )
@@ -755,7 +743,7 @@ CONTAINS
!------------------------------------------------------------------------------!
! 4) Recompute delta, shear and div (inputs for mechanical redistribution)
!------------------------------------------------------------------------------!
- DO_2D( 1, 0, 1, 0 )
+ DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
! shear at F points
zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) &
@@ -779,22 +767,30 @@ CONTAINS
& + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1) &
& ) * 0.25_wp * r1_e1e2t(ji,jj)
- ! shear at T points
+ ! maximum shear rate at T points (includes tension, output only)
pshear_i(ji,jj) = SQRT( zdt2 + zds2 )
+ ! shear at T-points
+ zshear(ji,jj) = SQRT( zds2 )
+
! divergence at T points
pdivu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj) &
& + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) &
& ) * r1_e1e2t(ji,jj)
! delta at T points
- zfac = SQRT( pdivu_i(ji,jj) * pdivu_i(ji,jj) + ( zdt2 + zds2 ) * z1_ecc2 ) ! delta
- rswitch = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zfac ) ) ! 0 if delta=0
- pdelta_i(ji,jj) = zfac + rn_creepl * rswitch ! delta+creepl
+ zdelta(ji,jj) = SQRT( pdivu_i(ji,jj) * pdivu_i(ji,jj) + ( zdt2 + zds2 ) * z1_ecc2 ) ! delta
+
+ ! delta at T points
+ rswitch = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zdelta(ji,jj) ) ) ! 0 if delta=0
+ pdelta_i(ji,jj) = zdelta(ji,jj) + rn_creepl * rswitch
+ ! it seems that deformation used for advection and mech redistribution is delta*
+ ! MV in principle adding creep limit is a regularization for viscosity not for delta
+ ! delta_star should not (in my view) be used in a replacement for delta
END_2D
CALL lbc_lnk( 'icedyn_rhg_eap', pshear_i, 'T', 1.0_wp, pdivu_i, 'T', 1.0_wp, pdelta_i, 'T', 1.0_wp, &
- & zten_i, 'T', 1.0_wp, zs1 , 'T', 1.0_wp, zs2 , 'T', 1.0_wp, &
+ & zs1, 'T', 1.0_wp, zs2 , 'T', 1.0_wp, &
& zs12, 'F', 1.0_wp )
! --- Store the stress tensor for the next time step --- !
@@ -807,45 +803,38 @@ CONTAINS
! 5) diagnostics
!------------------------------------------------------------------------------!
! --- ice-ocean, ice-atm. & ice-oceanbottom(landfast) stresses --- !
- IF( iom_use('utau_oi') .OR. iom_use('vtau_oi') .OR. iom_use('utau_ai') .OR. iom_use('vtau_ai') .OR. &
- & iom_use('utau_bi') .OR. iom_use('vtau_bi') ) THEN
- !
- CALL lbc_lnk( 'icedyn_rhg_eap', ztaux_oi, 'U', -1.0_wp, ztauy_oi, 'V', -1.0_wp, ztaux_ai, 'U', -1.0_wp, &
- & ztauy_ai, 'V', -1.0_wp, ztaux_bi, 'U', -1.0_wp, ztauy_bi, 'V', -1.0_wp )
- !
- CALL iom_put( 'utau_oi' , ztaux_oi * zmsk00 )
- CALL iom_put( 'vtau_oi' , ztauy_oi * zmsk00 )
- CALL iom_put( 'utau_ai' , ztaux_ai * zmsk00 )
- CALL iom_put( 'vtau_ai' , ztauy_ai * zmsk00 )
- CALL iom_put( 'utau_bi' , ztaux_bi * zmsk00 )
- CALL iom_put( 'vtau_bi' , ztauy_bi * zmsk00 )
- ENDIF
+ IF( iom_use('utau_oi') ) CALL iom_put( 'utau_oi' , ztaux_oi(A2D(0)) * zmsk00 )
+ IF( iom_use('vtau_oi') ) CALL iom_put( 'vtau_oi' , ztauy_oi(A2D(0)) * zmsk00 )
+ IF( iom_use('utau_ai') ) CALL iom_put( 'utau_ai' , ztaux_ai(A2D(0)) * zmsk00 )
+ IF( iom_use('vtau_ai') ) CALL iom_put( 'vtau_ai' , ztauy_ai(A2D(0)) * zmsk00 )
+ IF( iom_use('utau_bi') ) CALL iom_put( 'utau_bi' , ztaux_bi(A2D(0)) * zmsk00 )
+ IF( iom_use('vtau_bi') ) CALL iom_put( 'vtau_bi' , ztauy_bi(A2D(0)) * zmsk00 )
! --- divergence, shear and strength --- !
- IF( iom_use('icediv') ) CALL iom_put( 'icediv' , pdivu_i * zmsk00 ) ! divergence
- IF( iom_use('iceshe') ) CALL iom_put( 'iceshe' , pshear_i * zmsk00 ) ! shear
- IF( iom_use('icedlt') ) CALL iom_put( 'icedlt' , pdelta_i * zmsk00 ) ! delta
- IF( iom_use('icestr') ) CALL iom_put( 'icestr' , strength * zmsk00 ) ! strength
+ IF( iom_use('icediv') ) CALL iom_put( 'icediv' , pdivu_i (A2D(0)) * zmsk00 ) ! divergence
+ IF( iom_use('iceshe') ) CALL iom_put( 'iceshe' , pshear_i(A2D(0)) * zmsk00 ) ! shear
+ IF( iom_use('icestr') ) CALL iom_put( 'icestr' , strength(A2D(0)) * zmsk00 ) ! strength
+ IF( iom_use('icedlt') ) CALL iom_put( 'icedlt' , zdelta (A2D(0)) * zmsk00 ) ! delta
! --- Stress tensor invariants (SIMIP diags) --- !
IF( iom_use('normstr') .OR. iom_use('sheastr') ) THEN
!
- ALLOCATE( zsig_I(jpi,jpj) , zsig_II(jpi,jpj) )
+ ALLOCATE( zsig_I(A2D(0)) , zsig_II(A2D(0)) )
!
- DO_2D( 1, 1, 1, 1 )
+ DO_2D( 0, 0, 0, 0 )
! Ice stresses
! sigma1, sigma2, sigma12 are some useful recombination of the stresses (Hunke and Dukowicz MWR 2002, Bouillon et al., OM2013)
! These are NOT stress tensor components, neither stress invariants, neither stress principal components
! I know, this can be confusing...
- zfac = strength(ji,jj) / ( pdelta_i(ji,jj) + rn_creepl )
- zsig1 = zfac * ( pdivu_i(ji,jj) - pdelta_i(ji,jj) )
+ zfac = strength(ji,jj) / ( zdelta(ji,jj) + rn_creepl ) ! viscosity
+ zsig1 = zfac * ( pdivu_i(ji,jj) - zdelta(ji,jj) )
zsig2 = zfac * z1_ecc2 * zten_i(ji,jj)
- zsig12 = zfac * z1_ecc2 * pshear_i(ji,jj)
+ zsig12 = zfac * z1_ecc2 * zshear(ji,jj) * 0.5_wp
! Stress invariants (sigma_I, sigma_II, Coon 1974, Feltham 2008)
- zsig_I (ji,jj) = zsig1 * 0.5_wp ! 1st stress invariant, aka average normal stress, aka negative pressure
- zsig_II(ji,jj) = SQRT ( zsig2 * zsig2 * 0.25_wp + zsig12 * zsig12 ) ! 2nd '' '' , aka maximum shear stress
+ zsig_I (ji,jj) = 0.5_wp * zsig1
+ zsig_II(ji,jj) = 0.5_wp * SQRT ( zsig2 * zsig2 + 4._wp * zsig12 * zsig12 )
END_2D
!
@@ -863,21 +852,20 @@ CONTAINS
! Recommendation 2 : need to use deformations at PREVIOUS iterate for viscosities
IF( iom_use('sig1_pnorm') .OR. iom_use('sig2_pnorm') ) THEN
!
- ALLOCATE( zsig1_p(jpi,jpj) , zsig2_p(jpi,jpj) , zsig_I(jpi,jpj) , zsig_II(jpi,jpj) )
+ ALLOCATE( zsig1_p(A2D(0)) , zsig2_p(A2D(0)) , zsig_I(A2D(0)) , zsig_II(A2D(0)) )
!
- DO_2D( 1, 1, 1, 1 )
+ DO_2D( 0, 0, 0, 0 )
- ! Ice stresses computed with **viscosities** (delta, p/delta) at **previous** iterates
- ! and **deformations** at current iterates
+ ! For EVP solvers, ice stresses at current iterates can be used
! following Lemieux & Dupont (2020)
- zfac = zp_delt(ji,jj)
- zsig1 = zfac * ( pdivu_i(ji,jj) - ( zdelta(ji,jj) + rn_creepl ) )
+ zfac = strength(ji,jj) / ( zdelta(ji,jj) + rn_creepl )
+ zsig1 = zfac * ( pdivu_i(ji,jj) - zdelta(ji,jj) )
zsig2 = zfac * z1_ecc2 * zten_i(ji,jj)
- zsig12 = zfac * z1_ecc2 * pshear_i(ji,jj)
+ zsig12 = zfac * z1_ecc2 * zshear(ji,jj) * 0.5_wp
! Stress invariants (sigma_I, sigma_II, Coon 1974, Feltham 2008), T-point
- zsig_I(ji,jj) = zsig1 * 0.5_wp ! 1st stress invariant, aka average normal stress, aka negative pressure
- zsig_II(ji,jj) = SQRT ( zsig2 * zsig2 * 0.25_wp + zsig12 * zsig12 ) ! 2nd '' '' , aka maximum shear stress
+ zsig_I(ji,jj) = 0.5_wp * zsig1 ! normal stress
+ zsig_II(ji,jj) = 0.5_wp * SQRT ( zsig2 * zsig2 + 4._wp * zsig12 * zsig12 ) ! max shear stress
! Normalized principal stresses (used to display the ellipse)
z1_strength = 1._wp / MAX( 1._wp, strength(ji,jj) )
@@ -885,8 +873,8 @@ CONTAINS
zsig2_p(ji,jj) = ( zsig_I(ji,jj) - zsig_II(ji,jj) ) * z1_strength
END_2D
!
- CALL iom_put( 'sig1_pnorm' , zsig1_p )
- CALL iom_put( 'sig2_pnorm' , zsig2_p )
+ CALL iom_put( 'sig1_pnorm' , zsig1_p(:,:) * zmsk00 )
+ CALL iom_put( 'sig2_pnorm' , zsig2_p(:,:) * zmsk00 )
DEALLOCATE( zsig1_p , zsig2_p , zsig_I, zsig_II )
@@ -894,9 +882,6 @@ CONTAINS
! --- yieldcurve --- !
IF( iom_use('yield11') .OR. iom_use('yield12') .OR. iom_use('yield22')) THEN
-
- CALL lbc_lnk( 'icedyn_rhg_eap', zyield11, 'T', 1.0_wp, zyield22, 'T', 1.0_wp, zyield12, 'T', 1.0_wp )
-
CALL iom_put( 'yield11', zyield11 * zmsk00 )
CALL iom_put( 'yield22', zyield22 * zmsk00 )
CALL iom_put( 'yield12', zyield12 * zmsk00 )
@@ -904,31 +889,22 @@ CONTAINS
! --- anisotropy tensor --- !
IF( iom_use('aniso') ) THEN
- CALL lbc_lnk( 'icedyn_rhg_eap', paniso_11, 'T', 1.0_wp )
CALL iom_put( 'aniso' , paniso_11 * zmsk00 )
ENDIF
! --- SIMIP --- !
- IF( iom_use('dssh_dx') .OR. iom_use('dssh_dy') .OR. &
- & iom_use('corstrx') .OR. iom_use('corstry') .OR. iom_use('intstrx') .OR. iom_use('intstry') ) THEN
- !
- CALL lbc_lnk( 'icedyn_rhg_eap', zspgU, 'U', -1.0_wp, zspgV, 'V', -1.0_wp, &
- & zCorU, 'U', -1.0_wp, zCorV, 'V', -1.0_wp, &
- & zfU, 'U', -1.0_wp, zfV, 'V', -1.0_wp )
-
- CALL iom_put( 'dssh_dx' , zspgU * zmsk00 ) ! Sea-surface tilt term in force balance (x)
- CALL iom_put( 'dssh_dy' , zspgV * zmsk00 ) ! Sea-surface tilt term in force balance (y)
- CALL iom_put( 'corstrx' , zCorU * zmsk00 ) ! Coriolis force term in force balance (x)
- CALL iom_put( 'corstry' , zCorV * zmsk00 ) ! Coriolis force term in force balance (y)
- CALL iom_put( 'intstrx' , zfU * zmsk00 ) ! Internal force term in force balance (x)
- CALL iom_put( 'intstry' , zfV * zmsk00 ) ! Internal force term in force balance (y)
- ENDIF
+ IF( iom_use('dssh_dx') ) CALL iom_put( 'dssh_dx' , zspgU(A2D(0)) * zmsk00 ) ! Sea-surface tilt term in force balance (x)
+ IF( iom_use('dssh_dy') ) CALL iom_put( 'dssh_dy' , zspgV(A2D(0)) * zmsk00 ) ! Sea-surface tilt term in force balance (y)
+ IF( iom_use('corstrx') ) CALL iom_put( 'corstrx' , zCorU(A2D(0)) * zmsk00 ) ! Coriolis force term in force balance (x)
+ IF( iom_use('corstry') ) CALL iom_put( 'corstry' , zCorV(A2D(0)) * zmsk00 ) ! Coriolis force term in force balance (y)
+ IF( iom_use('intstrx') ) CALL iom_put( 'intstrx' , zfU (A2D(0)) * zmsk00 ) ! Internal force term in force balance (x)
+ IF( iom_use('intstry') ) CALL iom_put( 'intstry' , zfV (A2D(0)) * zmsk00 ) ! Internal force term in force balance (y)
IF( iom_use('xmtrpice') .OR. iom_use('ymtrpice') .OR. &
& iom_use('xmtrpsnw') .OR. iom_use('ymtrpsnw') .OR. iom_use('xatrp') .OR. iom_use('yatrp') ) THEN
!
- ALLOCATE( zdiag_xmtrp_ice(jpi,jpj) , zdiag_ymtrp_ice(jpi,jpj) , &
- & zdiag_xmtrp_snw(jpi,jpj) , zdiag_ymtrp_snw(jpi,jpj) , zdiag_xatrp(jpi,jpj) , zdiag_yatrp(jpi,jpj) )
+ ALLOCATE( zdiag_xmtrp_ice(A2D(0)) , zdiag_ymtrp_ice(A2D(0)) , &
+ & zdiag_xmtrp_snw(A2D(0)) , zdiag_ymtrp_snw(A2D(0)) , zdiag_xatrp(A2D(0)) , zdiag_yatrp(A2D(0)) )
!
DO_2D( 0, 0, 0, 0 )
! 2D ice mass, snow mass, area transport arrays (X, Y)
@@ -946,10 +922,6 @@ CONTAINS
END_2D
- CALL lbc_lnk( 'icedyn_rhg_eap', zdiag_xmtrp_ice, 'U', -1.0_wp, zdiag_ymtrp_ice, 'V', -1.0_wp, &
- & zdiag_xmtrp_snw, 'U', -1.0_wp, zdiag_ymtrp_snw, 'V', -1.0_wp, &
- & zdiag_xatrp , 'U', -1.0_wp, zdiag_yatrp , 'V', -1.0_wp )
-
CALL iom_put( 'xmtrpice' , zdiag_xmtrp_ice ) ! X-component of sea-ice mass transport (kg/s)
CALL iom_put( 'ymtrpice' , zdiag_ymtrp_ice ) ! Y-component of sea-ice mass transport
CALL iom_put( 'xmtrpsnw' , zdiag_xmtrp_snw ) ! X-component of snow mass transport (kg/s)
@@ -966,11 +938,11 @@ CONTAINS
IF( nn_rhg_chkcvg == 1 .OR. nn_rhg_chkcvg == 2 ) THEN
IF( iom_use('uice_cvg') ) THEN
IF( ln_aEVP ) THEN ! output: beta * ( u(t=nn_nevp) - u(t=nn_nevp-1) )
- CALL iom_put( 'uice_cvg', MAX( ABS( u_ice(:,:) - zu_ice(:,:) ) * zbeta(:,:) * umask(:,:,1) , &
- & ABS( v_ice(:,:) - zv_ice(:,:) ) * zbeta(:,:) * vmask(:,:,1) ) * zmsk15(:,:) )
+ CALL iom_put( 'uice_cvg', MAX( ABS( u_ice(A2D(0)) - zu_ice(:,:) ) * zbeta(A2D(0)) * umask(A2D(0),1) , &
+ & ABS( v_ice(A2D(0)) - zv_ice(:,:) ) * zbeta(A2D(0)) * vmask(A2D(0),1) ) * zmsk15(:,:) )
ELSE ! output: nn_nevp * ( u(t=nn_nevp) - u(t=nn_nevp-1) )
- CALL iom_put( 'uice_cvg', REAL( nn_nevp ) * MAX( ABS( u_ice(:,:) - zu_ice(:,:) ) * umask(:,:,1) , &
- & ABS( v_ice(:,:) - zv_ice(:,:) ) * vmask(:,:,1) ) * zmsk15(:,:) )
+ CALL iom_put( 'uice_cvg', REAL( nn_nevp ) * MAX( ABS( u_ice(A2D(0)) - zu_ice(:,:) ) * umask(A2D(0),1) , &
+ & ABS( v_ice(A2D(0)) - zv_ice(:,:) ) * vmask(A2D(0),1) ) * zmsk15(:,:) )
ENDIF
ENDIF
ENDIF
@@ -991,22 +963,27 @@ CONTAINS
!!
!! ** Note : for the first sub-iteration, uice_cvg is set to 0 (too large otherwise)
!!----------------------------------------------------------------------
- INTEGER , INTENT(in) :: kt, kiter, kitermax ! ocean time-step index
- REAL(wp), DIMENSION(:,:), INTENT(in) :: pu, pv, pub, pvb ! now and before velocities
- REAL(wp), DIMENSION(:,:), INTENT(in) :: pmsk15
+ INTEGER , INTENT(in) :: kt, kiter, kitermax ! ocean time-step index
+ REAL(wp), DIMENSION(:,:) , INTENT(in) :: pu, pv ! now velocities
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pub, pvb ! before velocities
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pmsk15
!!
INTEGER :: it, idtime, istatus
INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zresm ! local real
CHARACTER(len=20) :: clname
+ LOGICAL :: ll_maxcvg
+ REAL(wp), DIMENSION(A2D(0),2) :: zres
+ REAL(wp), DIMENSION(2) :: ztmp
!!----------------------------------------------------------------------
-
+ ll_maxcvg = .FALSE.
+ !
! create file
IF( kt == nit000 .AND. kiter == 1 ) THEN
!
IF( lwp ) THEN
WRITE(numout,*)
- WRITE(numout,*) 'rhg_cvg_eap : ice rheology convergence control'
+ WRITE(numout,*) 'rhg_cvg : ice rheology convergence control'
WRITE(numout,*) '~~~~~~~'
ENDIF
!
@@ -1015,7 +992,7 @@ CONTAINS
IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname)
istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, ncvgid )
istatus = NF90_DEF_DIM( ncvgid, 'time' , NF90_UNLIMITED, idtime )
- istatus = NF90_DEF_VAR( ncvgid, 'uice_cvg', NF90_DOUBLE , (/ idtime /), nvarid )
+ istatus = NF90_DEF_VAR( ncvgid, 'uice_cvg', NF90_DOUBLE , (/ idtime /), nvarid )
istatus = NF90_ENDDEF(ncvgid)
ENDIF
!
@@ -1029,11 +1006,21 @@ CONTAINS
zresm = 0._wp
ELSE
zresm = 0._wp
- DO_2D( 0, 0, 0, 0 )
- zresm = MAX( zresm, MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), &
- & ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * pmsk15(ji,jj) )
- END_2D
- CALL mpp_max( 'icedyn_rhg_evp', zresm ) ! max over the global domain
+ IF( ll_maxcvg ) THEN ! error max over the domain
+ DO_2D( 0, 0, 0, 0 )
+ zresm = MAX( zresm, MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), &
+ & ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * pmsk15(ji,jj) )
+ END_2D
+ CALL mpp_max( 'icedyn_rhg_eap', zresm )
+ ELSE ! error averaged over the domain
+ DO_2D( 0, 0, 0, 0 )
+ zres(ji,jj,1) = MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), &
+ & ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * pmsk15(ji,jj)
+ zres(ji,jj,2) = pmsk15(ji,jj)
+ END_2D
+ ztmp(:) = glob_sum_vec( 'icedyn_rhg_eap', zres )
+ IF( ztmp(2) /= 0._wp ) zresm = ztmp(1) / ztmp(2)
+ ENDIF
ENDIF
IF( lwm ) THEN
diff --git a/src/ICE/icedyn_rhg_evp.F90 b/src/ICE/icedyn_rhg_evp.F90
index a260797a2a630a096e4e389072ab020f676c6a32..9e367e52a3888875f5d3df2171d46c000362f822 100644
--- a/src/ICE/icedyn_rhg_evp.F90
+++ b/src/ICE/icedyn_rhg_evp.F90
@@ -114,10 +114,10 @@ CONTAINS
!! Bouillon et al., Ocean Modelling 2013
!! Kimmritz et al., Ocean Modelling 2016 & 2017
!!-------------------------------------------------------------------
- INTEGER , INTENT(in ) :: kt ! time step
- INTEGER , INTENT(in ) :: Kmm ! ocean time level index
- REAL(wp), DIMENSION(:,:), INTENT(inout) :: pstress1_i, pstress2_i, pstress12_i !
- REAL(wp), DIMENSION(:,:), INTENT( out) :: pshear_i , pdivu_i , pdelta_i !
+ INTEGER , INTENT(in ) :: kt ! time step
+ INTEGER , INTENT(in ) :: Kmm ! ocean time level index
+ REAL(wp), DIMENSION(:,:) , INTENT(inout) :: pstress1_i, pstress2_i, pstress12_i !
+ REAL(wp), DIMENSION(A2D(0)), INTENT( out) :: pshear_i , pdivu_i , pdelta_i !
!!
INTEGER :: ji, jj ! dummy loop indices
INTEGER :: jter ! local integers
@@ -135,38 +135,39 @@ CONTAINS
!
REAL(wp) :: zfac_x, zfac_y
!
- REAL(wp), DIMENSION(jpi,jpj) :: zdelta, zp_delt ! delta and P/delta at T points
- REAL(wp), DIMENSION(jpi,jpj) :: zbeta ! beta coef from Kimmritz 2017
+ REAL(wp), DIMENSION(jpi,jpj) :: zdelta, zp_delt ! delta, P/delta at T points
+ REAL(wp), DIMENSION(jpi,jpj) :: zbeta ! beta coef from Kimmritz 2017
!
- REAL(wp), DIMENSION(jpi,jpj) :: zdt_m ! (dt / ice-snow_mass) on T points
- REAL(wp), DIMENSION(jpi,jpj) :: zaU , zaV ! ice fraction on U/V points
- REAL(wp), DIMENSION(jpi,jpj) :: zmU_t, zmV_t ! (ice-snow_mass / dt) on U/V points
- REAL(wp), DIMENSION(jpi,jpj) :: zmf ! coriolis parameter at T points
- REAL(wp), DIMENSION(jpi,jpj) :: v_oceU, u_oceV, v_iceU, u_iceV ! ocean/ice u/v component on V/U points
+ REAL(wp), DIMENSION(jpi,jpj) :: zdt_m ! (dt / ice-snow_mass) on T points
+ REAL(wp), DIMENSION(A2D(nn_hls-1)) :: zaU , zaV ! ice fraction on U/V points
+ REAL(wp), DIMENSION(A2D(nn_hls-1)) :: zmU_t, zmV_t ! (ice-snow_mass / dt) on U/V points
+ REAL(wp), DIMENSION(jpi,jpj) :: zmf ! coriolis parameter at T points
+ REAL(wp), DIMENSION(A2D(nn_hls-1)) :: v_oceU, u_oceV, v_iceU, u_iceV ! ocean/ice u/v component on V/U points
!
- REAL(wp), DIMENSION(jpi,jpj) :: zds ! shear
- REAL(wp), DIMENSION(jpi,jpj) :: zten_i, zshear ! tension, shear
- REAL(wp), DIMENSION(jpi,jpj) :: zs1, zs2, zs12 ! stress tensor components
- REAL(wp), DIMENSION(jpi,jpj) :: zsshdyn ! array used for the calculation of ice surface slope:
- ! ! ocean surface (ssh_m) if ice is not embedded
- ! ! ice bottom surface if ice is embedded
- REAL(wp), DIMENSION(jpi,jpj) :: zfU , zfV ! internal stresses
- REAL(wp), DIMENSION(jpi,jpj) :: zspgU, zspgV ! surface pressure gradient at U/V points
- REAL(wp), DIMENSION(jpi,jpj) :: zCorU, zCorV ! Coriolis stress array
- REAL(wp), DIMENSION(jpi,jpj) :: ztaux_ai, ztauy_ai ! ice-atm. stress at U-V points
- REAL(wp), DIMENSION(jpi,jpj) :: ztaux_oi, ztauy_oi ! ice-ocean stress at U-V points
- REAL(wp), DIMENSION(jpi,jpj) :: ztaux_bi, ztauy_bi ! ice-OceanBottom stress at U-V points (landfast)
- REAL(wp), DIMENSION(jpi,jpj) :: ztaux_base, ztauy_base ! ice-bottom stress at U-V points (landfast)
+ REAL(wp), DIMENSION(jpi,jpj) :: zds ! shear
+ REAL(wp), DIMENSION(A2D(0)) :: zten_i, zshear ! tension, shear
+ REAL(wp), DIMENSION(jpi,jpj) :: zs1, zs2, zs12 ! stress tensor components
+ REAL(wp), DIMENSION(jpi,jpj) :: zsshdyn ! array used for the calculation of ice surface slope:
+ ! ! ocean surface (ssh_m) if ice is not embedded
+ ! ! ice bottom surface if ice is embedded
+ REAL(wp), DIMENSION(A2D(nn_hls-1)) :: zfU , zfV ! internal stresses
+ REAL(wp), DIMENSION(A2D(nn_hls-1)) :: zspgU, zspgV ! surface pressure gradient at U/V points
+ REAL(wp), DIMENSION(A2D(nn_hls-1)) :: zCorU, zCorV ! Coriolis stress array
+ REAL(wp), DIMENSION(A2D(nn_hls-1)) :: ztaux_ai, ztauy_ai ! ice-atm. stress at U-V points
+ REAL(wp), DIMENSION(A2D(nn_hls-1)) :: ztaux_oi, ztauy_oi ! ice-ocean stress at U-V points
+ REAL(wp), DIMENSION(A2D(nn_hls-1)) :: ztaux_bi, ztauy_bi ! ice-OceanBottom stress at U-V points (landfast)
+ REAL(wp), DIMENSION(A2D(nn_hls-1)) :: ztaux_base, ztauy_base ! ice-bottom stress at U-V points (landfast)
!
- REAL(wp), DIMENSION(jpi,jpj) :: zmsk, zmsk00, zmsk15
- REAL(wp), DIMENSION(jpi,jpj) :: zmsk01x, zmsk01y ! dummy arrays
- REAL(wp), DIMENSION(jpi,jpj) :: zmsk00x, zmsk00y ! mask for ice presence
+ REAL(wp), DIMENSION(jpi,jpj) :: zmsk
+ REAL(wp), DIMENSION(A2D(nn_hls-1)) :: zmsk01x, zmsk01y ! dummy arrays
+ REAL(wp), DIMENSION(A2D(nn_hls-1)) :: zmsk00x, zmsk00y ! mask for ice presence
REAL(wp), PARAMETER :: zepsi = 1.0e-20_wp ! tolerance parameter
REAL(wp), PARAMETER :: zmmin = 1._wp ! ice mass (kg/m2) below which ice velocity becomes very small
REAL(wp), PARAMETER :: zamin = 0.001_wp ! ice concentration below which ice velocity becomes very small
!! --- check convergence
- REAL(wp), DIMENSION(jpi,jpj) :: zu_ice, zv_ice
+ REAL(wp), DIMENSION(A2D(0)) :: zmsk00, zmsk15
+ REAL(wp), DIMENSION(A2D(0)) :: zu_ice, zv_ice
!! --- diags
REAL(wp) :: zsig1, zsig2, zsig12, zfac, z1_strength
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zsig_I, zsig_II, zsig1_p, zsig2_p
@@ -186,13 +187,15 @@ CONTAINS
IF( kt == nit000 .AND. lwp ) WRITE(numout,*) '-- ice_dyn_rhg_evp: EVP sea-ice rheology'
!
- ! for diagnostics and convergence tests
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice , 0 if no ice
- zmsk (ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) ! 1 if ice , 0 if no ice
+ zmsk (ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) ! 1 if ice , 0 if no ice
+ END_2D
+ ! for diagnostics and convergence tests
+ DO_2D( 0, 0, 0, 0 )
+ zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice , 0 if no ice
END_2D
IF( nn_rhg_chkcvg > 0 ) THEN
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less
END_2D
ENDIF
@@ -265,6 +268,7 @@ CONTAINS
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
zm1 = ( rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj) ) ! Ice/snow mass at U-V points
+!!$ zm1 = ( rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj) + rhow * (vt_ip(ji,jj) + vt_il(ji,jj)) ) ! clem: this should replace the above
zmf (ji,jj) = zm1 * ff_t(ji,jj) ! Coriolis at T points (m*f)
zdt_m(ji,jj) = zdtevp / MAX( zm1, zmmin ) ! dt/m at T points (for alpha and beta coefficients)
END_2D
@@ -277,8 +281,11 @@ CONTAINS
! Ice/snow mass at U-V points
zm1 = ( rhos * vt_s(ji ,jj ) + rhoi * vt_i(ji ,jj ) )
+!!$ zm1 = ( rhos * vt_s(ji ,jj ) + rhoi * vt_i(ji ,jj ) + rhow * (vt_ip(ji ,jj ) + vt_il(ji ,jj )) ) ! clem: this should replace the above
zm2 = ( rhos * vt_s(ji+1,jj ) + rhoi * vt_i(ji+1,jj ) )
+!!$ zm2 = ( rhos * vt_s(ji+1,jj ) + rhoi * vt_i(ji+1,jj ) + rhow * (vt_ip(ji+1,jj ) + vt_il(ji+1,jj )) ) ! clem: this should replace the above
zm3 = ( rhos * vt_s(ji ,jj+1) + rhoi * vt_i(ji ,jj+1) )
+!!$ zm3 = ( rhos * vt_s(ji ,jj+1) + rhoi * vt_i(ji ,jj+1) + rhow * (vt_ip(ji ,jj+1) + vt_il(ji ,jj+1)) ) ! clem: this should replace the above
zmassU = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm2 * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
zmassV = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm3 * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1)
@@ -328,11 +335,12 @@ CONTAINS
! ice-bottom stress at V points
zvCr = zaV(ji,jj) * rn_lf_depfra * hv(ji,jj,Kmm) * ( 1._wp - icb_mask(ji,jj) ) ! if grounded icebergs are read: ocean depth = 0
ztauy_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) )
+ END_2D
+ DO_2D( 0, 0, 0, 0 )
! ice_bottom stress at T points
zvCr = at_i(ji,jj) * rn_lf_depfra * ht(ji,jj) * ( 1._wp - icb_mask(ji,jj) ) ! if grounded icebergs are read: ocean depth = 0
tau_icebfr(ji,jj) = - rn_lf_bfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) )
END_2D
- CALL lbc_lnk( 'icedyn_rhg_evp', tau_icebfr(:,:), 'T', 1.0_wp )
!
ELSE !-- no landfast
DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
@@ -352,7 +360,7 @@ CONTAINS
!
! convergence test
IF( nn_rhg_chkcvg == 1 .OR. nn_rhg_chkcvg == 2 ) THEN
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zu_ice(ji,jj) = u_ice(ji,jj) * umask(ji,jj,1) ! velocity at previous time step
zv_ice(ji,jj) = v_ice(ji,jj) * vmask(ji,jj,1)
END_2D
@@ -722,7 +730,7 @@ CONTAINS
! ! ==================== !
END DO ! end loop over jter !
! ! ==================== !
- IF( ln_aEVP ) CALL iom_put( 'beta_evp' , zbeta )
+ IF( ln_aEVP ) CALL iom_put( 'beta_evp' , zbeta(A2D(0)) )
!
IF( ll_advups .AND. ln_str_H79 ) CALL lbc_lnk( 'icedyn_rhg_evp', strength, 'T', 1.0_wp )
!
@@ -776,8 +784,7 @@ CONTAINS
END_2D
- CALL lbc_lnk( 'icedyn_rhg_evp', pshear_i, 'T', 1._wp, pdivu_i, 'T', 1._wp, pdelta_i, 'T', 1._wp, zten_i, 'T', 1._wp, &
- & zshear , 'T', 1._wp, zdelta , 'T', 1._wp, zs1 , 'T', 1._wp, zs2 , 'T', 1._wp, zs12, 'F', 1._wp )
+ CALL lbc_lnk( 'icedyn_rhg_evp', zs1 , 'T', 1._wp, zs2 , 'T', 1._wp, zs12 , 'F', 1._wp )
! --- Store the stress tensor for the next time step --- !
pstress1_i (:,:) = zs1 (:,:)
@@ -787,34 +794,25 @@ CONTAINS
! 5) diagnostics
!------------------------------------------------------------------------------!
! --- ice-ocean, ice-atm. & ice-oceanbottom(landfast) stresses --- !
- IF( iom_use('utau_oi') .OR. iom_use('vtau_oi') .OR. iom_use('utau_ai') .OR. iom_use('vtau_ai') .OR. &
- & iom_use('utau_bi') .OR. iom_use('vtau_bi') ) THEN
- !
- CALL lbc_lnk( 'icedyn_rhg_evp', ztaux_oi, 'U', -1.0_wp, ztauy_oi, 'V', -1.0_wp, &
- & ztaux_ai, 'U', -1.0_wp, ztauy_ai, 'V', -1.0_wp, &
- & ztaux_bi, 'U', -1.0_wp, ztauy_bi, 'V', -1.0_wp )
- !
- CALL iom_put( 'utau_oi' , ztaux_oi * zmsk00 )
- CALL iom_put( 'vtau_oi' , ztauy_oi * zmsk00 )
- CALL iom_put( 'utau_ai' , ztaux_ai * zmsk00 )
- CALL iom_put( 'vtau_ai' , ztauy_ai * zmsk00 )
- CALL iom_put( 'utau_bi' , ztaux_bi * zmsk00 )
- CALL iom_put( 'vtau_bi' , ztauy_bi * zmsk00 )
- ENDIF
+ IF( iom_use('utau_oi') ) CALL iom_put( 'utau_oi' , ztaux_oi(A2D(0)) * zmsk00 )
+ IF( iom_use('vtau_oi') ) CALL iom_put( 'vtau_oi' , ztauy_oi(A2D(0)) * zmsk00 )
+ IF( iom_use('utau_ai') ) CALL iom_put( 'utau_ai' , ztaux_ai(A2D(0)) * zmsk00 )
+ IF( iom_use('vtau_ai') ) CALL iom_put( 'vtau_ai' , ztauy_ai(A2D(0)) * zmsk00 )
+ IF( iom_use('utau_bi') ) CALL iom_put( 'utau_bi' , ztaux_bi(A2D(0)) * zmsk00 )
+ IF( iom_use('vtau_bi') ) CALL iom_put( 'vtau_bi' , ztauy_bi(A2D(0)) * zmsk00 )
! --- divergence, shear and strength --- !
- IF( iom_use('icediv') ) CALL iom_put( 'icediv' , pdivu_i * zmsk00 ) ! divergence
- IF( iom_use('iceshe') ) CALL iom_put( 'iceshe' , pshear_i * zmsk00 ) ! shear
- IF( iom_use('icestr') ) CALL iom_put( 'icestr' , strength * zmsk00 ) ! strength
- IF( iom_use('icedlt') ) CALL iom_put( 'icedlt' , zdelta * zmsk00 ) ! delta
+ IF( iom_use('icediv') ) CALL iom_put( 'icediv' , pdivu_i (A2D(0)) * zmsk00 ) ! divergence
+ IF( iom_use('iceshe') ) CALL iom_put( 'iceshe' , pshear_i(A2D(0)) * zmsk00 ) ! shear
+ IF( iom_use('icestr') ) CALL iom_put( 'icestr' , strength(A2D(0)) * zmsk00 ) ! strength
+ IF( iom_use('icedlt') ) CALL iom_put( 'icedlt' , zdelta (A2D(0)) * zmsk00 ) ! delta
! --- Stress tensor invariants (SIMIP diags) --- !
IF( iom_use('normstr') .OR. iom_use('sheastr') ) THEN
!
- ALLOCATE( zsig_I(jpi,jpj) , zsig_II(jpi,jpj) )
+ ALLOCATE( zsig_I(A2D(0)) , zsig_II(A2D(0)) )
!
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
-
+ DO_2D( 0, 0, 0, 0 )
! Ice stresses
! sigma1, sigma2, sigma12 are some recombination of the stresses (HD MWR002, Bouillon et al., OM2013)
! not to be confused with stress tensor components, stress invariants, or stress principal components
@@ -829,8 +827,8 @@ CONTAINS
END_2D
!
- IF( iom_use('normstr') ) CALL iom_put( 'normstr', zsig_I (:,:) * zmsk00(:,:) ) ! Normal stress
- IF( iom_use('sheastr') ) CALL iom_put( 'sheastr', zsig_II(:,:) * zmsk00(:,:) ) ! Maximum shear stress
+ IF( iom_use('normstr') ) CALL iom_put( 'normstr', zsig_I (:,:) * zmsk00 ) ! Normal stress
+ IF( iom_use('sheastr') ) CALL iom_put( 'sheastr', zsig_II(:,:) * zmsk00 ) ! Maximum shear stress
DEALLOCATE ( zsig_I, zsig_II )
@@ -842,9 +840,9 @@ CONTAINS
! Recommendation 2 : for EVP, no need to use viscosities at last iteration (stress is properly iterated)
IF( iom_use('sig1_pnorm') .OR. iom_use('sig2_pnorm') ) THEN
!
- ALLOCATE( zsig1_p(jpi,jpj) , zsig2_p(jpi,jpj) , zsig_I(jpi,jpj) , zsig_II(jpi,jpj) )
+ ALLOCATE( zsig1_p(A2D(0)) , zsig2_p(A2D(0)) , zsig_I(A2D(0)) , zsig_II(A2D(0)) )
!
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
! For EVP solvers, ice stresses at current iterates can be used
! following Lemieux & Dupont (2020)
@@ -863,33 +861,26 @@ CONTAINS
zsig2_p(ji,jj) = ( zsig_I(ji,jj) - zsig_II(ji,jj) ) * z1_strength
END_2D
!
- CALL iom_put( 'sig1_pnorm' , zsig1_p * zmsk00 )
- CALL iom_put( 'sig2_pnorm' , zsig2_p * zmsk00 )
+ CALL iom_put( 'sig1_pnorm' , zsig1_p(:,:) * zmsk00 )
+ CALL iom_put( 'sig2_pnorm' , zsig2_p(:,:) * zmsk00 )
DEALLOCATE( zsig1_p , zsig2_p , zsig_I, zsig_II )
ENDIF
! --- SIMIP --- !
- IF( iom_use('dssh_dx') .OR. iom_use('dssh_dy') .OR. &
- & iom_use('corstrx') .OR. iom_use('corstry') .OR. iom_use('intstrx') .OR. iom_use('intstry') ) THEN
- !
- CALL lbc_lnk( 'icedyn_rhg_evp', zspgU, 'U', -1.0_wp, zspgV, 'V', -1.0_wp, &
- & zCorU, 'U', -1.0_wp, zCorV, 'V', -1.0_wp, zfU, 'U', -1.0_wp, zfV, 'V', -1.0_wp )
-
- CALL iom_put( 'dssh_dx' , zspgU * zmsk00 ) ! Sea-surface tilt term in force balance (x)
- CALL iom_put( 'dssh_dy' , zspgV * zmsk00 ) ! Sea-surface tilt term in force balance (y)
- CALL iom_put( 'corstrx' , zCorU * zmsk00 ) ! Coriolis force term in force balance (x)
- CALL iom_put( 'corstry' , zCorV * zmsk00 ) ! Coriolis force term in force balance (y)
- CALL iom_put( 'intstrx' , zfU * zmsk00 ) ! Internal force term in force balance (x)
- CALL iom_put( 'intstry' , zfV * zmsk00 ) ! Internal force term in force balance (y)
- ENDIF
+ IF( iom_use('dssh_dx') ) CALL iom_put( 'dssh_dx' , zspgU(A2D(0)) * zmsk00 ) ! Sea-surface tilt term in force balance (x)
+ IF( iom_use('dssh_dy') ) CALL iom_put( 'dssh_dy' , zspgV(A2D(0)) * zmsk00 ) ! Sea-surface tilt term in force balance (y)
+ IF( iom_use('corstrx') ) CALL iom_put( 'corstrx' , zCorU(A2D(0)) * zmsk00 ) ! Coriolis force term in force balance (x)
+ IF( iom_use('corstry') ) CALL iom_put( 'corstry' , zCorV(A2D(0)) * zmsk00 ) ! Coriolis force term in force balance (y)
+ IF( iom_use('intstrx') ) CALL iom_put( 'intstrx' , zfU (A2D(0)) * zmsk00 ) ! Internal force term in force balance (x)
+ IF( iom_use('intstry') ) CALL iom_put( 'intstry' , zfV (A2D(0)) * zmsk00 ) ! Internal force term in force balance (y)
IF( iom_use('xmtrpice') .OR. iom_use('ymtrpice') .OR. &
& iom_use('xmtrpsnw') .OR. iom_use('ymtrpsnw') .OR. iom_use('xatrp') .OR. iom_use('yatrp') ) THEN
!
- ALLOCATE( zdiag_xmtrp_ice(jpi,jpj) , zdiag_ymtrp_ice(jpi,jpj) , &
- & zdiag_xmtrp_snw(jpi,jpj) , zdiag_ymtrp_snw(jpi,jpj) , zdiag_xatrp(jpi,jpj) , zdiag_yatrp(jpi,jpj) )
+ ALLOCATE( zdiag_xmtrp_ice(A2D(0)) , zdiag_ymtrp_ice(A2D(0)) , &
+ & zdiag_xmtrp_snw(A2D(0)) , zdiag_ymtrp_snw(A2D(0)) , zdiag_xatrp(A2D(0)) , zdiag_yatrp(A2D(0)) )
!
DO_2D( 0, 0, 0, 0 )
! 2D ice mass, snow mass, area transport arrays (X, Y)
@@ -907,10 +898,6 @@ CONTAINS
END_2D
- CALL lbc_lnk( 'icedyn_rhg_evp', zdiag_xmtrp_ice, 'U', -1.0_wp, zdiag_ymtrp_ice, 'V', -1.0_wp, &
- & zdiag_xmtrp_snw, 'U', -1.0_wp, zdiag_ymtrp_snw, 'V', -1.0_wp, &
- & zdiag_xatrp , 'U', -1.0_wp, zdiag_yatrp , 'V', -1.0_wp )
-
CALL iom_put( 'xmtrpice' , zdiag_xmtrp_ice ) ! X-component of sea-ice mass transport (kg/s)
CALL iom_put( 'ymtrpice' , zdiag_ymtrp_ice ) ! Y-component of sea-ice mass transport
CALL iom_put( 'xmtrpsnw' , zdiag_xmtrp_snw ) ! X-component of snow mass transport (kg/s)
@@ -927,11 +914,11 @@ CONTAINS
IF( nn_rhg_chkcvg == 1 .OR. nn_rhg_chkcvg == 2 ) THEN
IF( iom_use('uice_cvg') ) THEN
IF( ln_aEVP ) THEN ! output: beta * ( u(t=nn_nevp) - u(t=nn_nevp-1) )
- CALL iom_put( 'uice_cvg', MAX( ABS( u_ice(:,:) - zu_ice(:,:) ) * zbeta(:,:) * umask(:,:,1) , &
- & ABS( v_ice(:,:) - zv_ice(:,:) ) * zbeta(:,:) * vmask(:,:,1) ) * zmsk15(:,:) )
+ CALL iom_put( 'uice_cvg', MAX( ABS( u_ice(A2D(0)) - zu_ice(:,:) ) * zbeta(A2D(0)) * umask(A2D(0),1) , &
+ & ABS( v_ice(A2D(0)) - zv_ice(:,:) ) * zbeta(A2D(0)) * vmask(A2D(0),1) ) * zmsk15(:,:) )
ELSE ! output: nn_nevp * ( u(t=nn_nevp) - u(t=nn_nevp-1) )
- CALL iom_put( 'uice_cvg', REAL( nn_nevp ) * MAX( ABS( u_ice(:,:) - zu_ice(:,:) ) * umask(:,:,1) , &
- & ABS( v_ice(:,:) - zv_ice(:,:) ) * vmask(:,:,1) ) * zmsk15(:,:) )
+ CALL iom_put( 'uice_cvg', REAL( nn_nevp ) * MAX( ABS( u_ice(A2D(0)) - zu_ice(:,:) ) * umask(A2D(0),1) , &
+ & ABS( v_ice(A2D(0)) - zv_ice(:,:) ) * vmask(A2D(0),1) ) * zmsk15(:,:) )
ENDIF
ENDIF
ENDIF
@@ -952,17 +939,18 @@ CONTAINS
!!
!! ** Note : for the first sub-iteration, uice_cvg is set to 0 (too large otherwise)
!!----------------------------------------------------------------------
- INTEGER , INTENT(in) :: kt, kiter, kitermax ! ocean time-step index
- REAL(wp), DIMENSION(:,:), INTENT(in) :: pu, pv, pub, pvb ! now and before velocities
- REAL(wp), DIMENSION(:,:), INTENT(in) :: pmsk15
+ INTEGER , INTENT(in) :: kt, kiter, kitermax ! ocean time-step index
+ REAL(wp), DIMENSION(:,:) , INTENT(in) :: pu, pv ! now velocities
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pub, pvb ! before velocities
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pmsk15
!!
INTEGER :: it, idtime, istatus
INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zresm ! local real
CHARACTER(len=20) :: clname
LOGICAL :: ll_maxcvg
- REAL(wp), DIMENSION(jpi,jpj,2) :: zres
- REAL(wp), DIMENSION(2) :: ztmp
+ REAL(wp), DIMENSION(A2D(0),2) :: zres
+ REAL(wp), DIMENSION(2) :: ztmp
!!----------------------------------------------------------------------
ll_maxcvg = .FALSE.
!
diff --git a/src/ICE/iceistate.F90 b/src/ICE/iceistate.F90
index c1fb86e0910e438bb70a83d8b08f51447904edfe..283c6c34c7430fc6ea29a918314669178856db0f 100644
--- a/src/ICE/iceistate.F90
+++ b/src/ICE/iceistate.F90
@@ -37,6 +37,7 @@ MODULE iceistate
USE lib_mpp ! MPP library
USE lib_fortran ! fortran utilities (glob_sum + no signed zero)
USE fldread ! read input fields
+ USE lbclnk ! ocean lateral boundary conditions (or mpp link)
# if defined key_agrif
USE agrif_oce
@@ -113,11 +114,11 @@ CONTAINS
INTEGER :: ji, jj, jk, jl ! dummy loop indices
REAL(wp) :: ztmelts, zsshadj, area
INTEGER , DIMENSION(4) :: itest
- REAL(wp), DIMENSION(jpi,jpj) :: z2d
REAL(wp), DIMENSION(jpi,jpj) :: zswitch ! ice indicator
- REAL(wp), DIMENSION(jpi,jpj) :: zht_i_ini, zat_i_ini, ztm_s_ini !data from namelist or nc file
- REAL(wp), DIMENSION(jpi,jpj) :: zt_su_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file
- REAL(wp), DIMENSION(jpi,jpj) :: zapnd_ini, zhpnd_ini, zhlid_ini !data from namelist or nc file
+ REAL(wp), DIMENSION(A2D(0)) :: zmsk ! ice indicator
+ REAL(wp), DIMENSION(A2D(0)) :: zht_i_ini, zat_i_ini, ztm_s_ini !data from namelist or nc file
+ REAL(wp), DIMENSION(A2D(0)) :: zt_su_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file
+ REAL(wp), DIMENSION(A2D(0)) :: zapnd_ini, zhpnd_ini, zhlid_ini !data from namelist or nc file
REAL(wp), DIMENSION(jpi,jpj,jpl) :: zti_3d , zts_3d !temporary arrays
!!
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zhi_2d, zhs_2d, zai_2d, zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d, zhil_2d
@@ -135,53 +136,59 @@ CONTAINS
CALL eos_fzp( sss_m(:,:), t_bo(:,:) )
t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1)
!
- ! surface temperature and conductivity
DO jl = 1, jpl
- t_su (:,:,jl) = rt0 * tmask(:,:,1) ! temp at the surface
- cnd_ice(:,:,jl) = 0._wp ! initialisation of the effective conductivity at the top of ice/snow (ln_cndflx=T)
- END DO
- !
- ! ice and snw temperatures
- DO jl = 1, jpl
- DO jk = 1, nlay_i
- t_i(:,:,jk,jl) = rt0 * tmask(:,:,1)
- END DO
- DO jk = 1, nlay_s
- t_s(:,:,jk,jl) = rt0 * tmask(:,:,1)
- END DO
- END DO
- !
- ! specific temperatures for coupled runs
- tn_ice (:,:,:) = t_i (:,:,1,:)
- t1_ice (:,:,:) = t_i (:,:,1,:)
-
- ! heat contents
- e_i (:,:,:,:) = 0._wp
- e_s (:,:,:,:) = 0._wp
-
- ! general fields
- a_i (:,:,:) = 0._wp
- v_i (:,:,:) = 0._wp
- v_s (:,:,:) = 0._wp
- sv_i(:,:,:) = 0._wp
- oa_i(:,:,:) = 0._wp
- !
- h_i (:,:,:) = 0._wp
- h_s (:,:,:) = 0._wp
- s_i (:,:,:) = 0._wp
- o_i (:,:,:) = 0._wp
- !
- ! melt ponds
- a_ip (:,:,:) = 0._wp
- v_ip (:,:,:) = 0._wp
- v_il (:,:,:) = 0._wp
- a_ip_eff (:,:,:) = 0._wp
- h_ip (:,:,:) = 0._wp
- h_il (:,:,:) = 0._wp
+ ! == reduced arrays == !
+ DO_2D( 0, 0, 0, 0 )
+ !
+ cnd_ice(ji,jj,jl) = 0._wp ! conductivity at the ice top
+ !
+ tn_ice(ji,jj,jl) = t_i (ji,jj,1,jl) ! temp for coupled runs
+ t1_ice(ji,jj,jl) = t_i (ji,jj,1,jl) ! temp for coupled runs
+ !
+ a_ip_eff(ji,jj,jl) = 0._wp ! melt pond effective fraction
+ END_2D
+ !
+ ! == full arrays == !
+ DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ !
+ ! heat contents
+ DO jk = 1, nlay_i
+ e_i(ji,jj,jk,jl) = 0._wp
+ t_i(ji,jj,jk,jl) = rt0 * tmask(ji,jj,1) ! ice temp
+ ENDDO
+ DO jk = 1, nlay_s
+ e_s(ji,jj,jk,jl) = 0._wp
+ t_s(ji,jj,jk,jl) = rt0 * tmask(ji,jj,1) ! snw temp
+ ENDDO
+ !
+ ! general fields
+ a_i (ji,jj,jl) = 0._wp
+ v_i (ji,jj,jl) = 0._wp
+ v_s (ji,jj,jl) = 0._wp
+ sv_i(ji,jj,jl) = 0._wp
+ oa_i(ji,jj,jl) = 0._wp
+ h_i (ji,jj,jl) = 0._wp
+ h_s (ji,jj,jl) = 0._wp
+ s_i (ji,jj,jl) = 0._wp
+ o_i (ji,jj,jl) = 0._wp
+ t_su(ji,jj,jl) = rt0 * tmask(ji,jj,1)
+ !
+ ! melt ponds
+ a_ip(ji,jj,jl) = 0._wp
+ v_ip(ji,jj,jl) = 0._wp
+ v_il(ji,jj,jl) = 0._wp
+ h_ip(ji,jj,jl) = 0._wp
+ h_il(ji,jj,jl) = 0._wp
+ !
+ END_2D
+ !
+ ENDDO
!
! ice velocities
- u_ice (:,:) = 0._wp
- v_ice (:,:) = 0._wp
+ DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ u_ice(ji,jj) = 0._wp
+ v_ice(ji,jj) = 0._wp
+ END_2D
!
!------------------------------------------------------------------------
! 2) overwrite some of the fields with namelist parameters or netcdf file
@@ -194,30 +201,30 @@ CONTAINS
! !---------------!
IF( nn_iceini_file == 1 )THEN ! Read a file !
! !---------------!
- WHERE( ff_t(:,:) >= 0._wp ) ; zswitch(:,:) = 1._wp
- ELSEWHERE ; zswitch(:,:) = 0._wp
+ WHERE( ff_t(A2D(0)) >= 0._wp ) ; zmsk(:,:) = 1._wp
+ ELSEWHERE ; zmsk(:,:) = 0._wp
END WHERE
!
CALL fld_read( kt, 1, si ) ! input fields provided at the current time-step
!
! -- mandatory fields -- !
- zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) * tmask(:,:,1)
- zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1) * tmask(:,:,1)
- zat_i_ini(:,:) = si(jp_ati)%fnow(:,:,1) * tmask(:,:,1)
+ zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) * smask0(:,:)
+ zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1) * smask0(:,:)
+ zat_i_ini(:,:) = si(jp_ati)%fnow(:,:,1) * smask0(:,:)
! -- optional fields -- !
! if fields do not exist then set them to the values present in the namelist (except for temperatures)
!
! ice salinity
IF( TRIM(si(jp_smi)%clrootname) == 'NOT USED' ) &
- & si(jp_smi)%fnow(:,:,1) = ( rn_smi_ini_n * zswitch + rn_smi_ini_s * (1._wp - zswitch) ) * tmask(:,:,1)
+ & si(jp_smi)%fnow(:,:,1) = ( rn_smi_ini_n * zmsk + rn_smi_ini_s * (1._wp - zmsk) ) * smask0(:,:)
!
! temperatures
IF ( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. &
& TRIM(si(jp_tms)%clrootname) == 'NOT USED' ) THEN
- si(jp_tmi)%fnow(:,:,1) = ( rn_tmi_ini_n * zswitch + rn_tmi_ini_s * (1._wp - zswitch) ) * tmask(:,:,1)
- si(jp_tsu)%fnow(:,:,1) = ( rn_tsu_ini_n * zswitch + rn_tsu_ini_s * (1._wp - zswitch) ) * tmask(:,:,1)
- si(jp_tms)%fnow(:,:,1) = ( rn_tms_ini_n * zswitch + rn_tms_ini_s * (1._wp - zswitch) ) * tmask(:,:,1)
+ si(jp_tmi)%fnow(:,:,1) = ( rn_tmi_ini_n * zmsk + rn_tmi_ini_s * (1._wp - zmsk) ) * smask0(:,:)
+ si(jp_tsu)%fnow(:,:,1) = ( rn_tsu_ini_n * zmsk + rn_tsu_ini_s * (1._wp - zmsk) ) * smask0(:,:)
+ si(jp_tms)%fnow(:,:,1) = ( rn_tms_ini_n * zmsk + rn_tms_ini_s * (1._wp - zmsk) ) * smask0(:,:)
ENDIF
IF( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tms)%clrootname) /= 'NOT USED' ) & ! if T_s is read and not T_i, set T_i = (T_s + T_freeze)/2
& si(jp_tmi)%fnow(:,:,1) = 0.5_wp * ( si(jp_tms)%fnow(:,:,1) + 271.15 )
@@ -234,67 +241,60 @@ CONTAINS
!
! pond concentration
IF( TRIM(si(jp_apd)%clrootname) == 'NOT USED' ) &
- & si(jp_apd)%fnow(:,:,1) = ( rn_apd_ini_n * zswitch + rn_apd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) & ! rn_apd = pond fraction => rn_apnd * a_i = pond conc.
+ & si(jp_apd)%fnow(:,:,1) = ( rn_apd_ini_n * zmsk + rn_apd_ini_s * (1._wp - zmsk) ) * smask0(:,:) & ! rn_apd = pond fraction => rn_apnd * a_i = pond conc.
& * si(jp_ati)%fnow(:,:,1)
!
! pond depth
IF( TRIM(si(jp_hpd)%clrootname) == 'NOT USED' ) &
- & si(jp_hpd)%fnow(:,:,1) = ( rn_hpd_ini_n * zswitch + rn_hpd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1)
+ & si(jp_hpd)%fnow(:,:,1) = ( rn_hpd_ini_n * zmsk + rn_hpd_ini_s * (1._wp - zmsk) ) * smask0(:,:)
!
! pond lid depth
IF( TRIM(si(jp_hld)%clrootname) == 'NOT USED' ) &
- & si(jp_hld)%fnow(:,:,1) = ( rn_hld_ini_n * zswitch + rn_hld_ini_s * (1._wp - zswitch) ) * tmask(:,:,1)
+ & si(jp_hld)%fnow(:,:,1) = ( rn_hld_ini_n * zmsk + rn_hld_ini_s * (1._wp - zmsk) ) * smask0(:,:)
!
- zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) * tmask(:,:,1)
- ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1) * tmask(:,:,1)
- zt_su_ini(:,:) = si(jp_tsu)%fnow(:,:,1) * tmask(:,:,1)
- ztm_s_ini(:,:) = si(jp_tms)%fnow(:,:,1) * tmask(:,:,1)
- zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) * tmask(:,:,1)
- zhpnd_ini(:,:) = si(jp_hpd)%fnow(:,:,1) * tmask(:,:,1)
- zhlid_ini(:,:) = si(jp_hld)%fnow(:,:,1) * tmask(:,:,1)
+ zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) * smask0(:,:)
+ ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1) * smask0(:,:)
+ zt_su_ini(:,:) = si(jp_tsu)%fnow(:,:,1) * smask0(:,:)
+ ztm_s_ini(:,:) = si(jp_tms)%fnow(:,:,1) * smask0(:,:)
+ zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) * smask0(:,:)
+ zhpnd_ini(:,:) = si(jp_hpd)%fnow(:,:,1) * smask0(:,:)
+ zhlid_ini(:,:) = si(jp_hld)%fnow(:,:,1) * smask0(:,:)
!
- ! change the switch for the following
- WHERE( zat_i_ini(:,:) > 0._wp ) ; zswitch(:,:) = tmask(:,:,1)
- ELSEWHERE ; zswitch(:,:) = 0._wp
- END WHERE
-
! !---------------!
ELSE ! Read namelist !
! !---------------!
! no ice if (sst - Tfreez) >= thresold
- WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst ) ; zswitch(:,:) = 0._wp
- ELSEWHERE ; zswitch(:,:) = tmask(:,:,1)
+ WHERE( ( sst_m(A2D(0)) - (t_bo(A2D(0)) - rt0) ) * smask0(:,:) >= rn_thres_sst ) ; zmsk(:,:) = 0._wp
+ ELSEWHERE ; zmsk(:,:) = smask0(:,:)
END WHERE
!
! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array
- WHERE( ff_t(:,:) >= 0._wp )
- zht_i_ini(:,:) = rn_hti_ini_n * zswitch(:,:)
- zht_s_ini(:,:) = rn_hts_ini_n * zswitch(:,:)
- zat_i_ini(:,:) = rn_ati_ini_n * zswitch(:,:)
- zsm_i_ini(:,:) = rn_smi_ini_n * zswitch(:,:)
- ztm_i_ini(:,:) = rn_tmi_ini_n * zswitch(:,:)
- zt_su_ini(:,:) = rn_tsu_ini_n * zswitch(:,:)
- ztm_s_ini(:,:) = rn_tms_ini_n * zswitch(:,:)
- zapnd_ini(:,:) = rn_apd_ini_n * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc.
- zhpnd_ini(:,:) = rn_hpd_ini_n * zswitch(:,:)
- zhlid_ini(:,:) = rn_hld_ini_n * zswitch(:,:)
+ WHERE( ff_t(A2D(0)) >= 0._wp )
+ zht_i_ini(:,:) = rn_hti_ini_n * zmsk(:,:)
+ zht_s_ini(:,:) = rn_hts_ini_n * zmsk(:,:)
+ zat_i_ini(:,:) = rn_ati_ini_n * zmsk(:,:)
+ zsm_i_ini(:,:) = rn_smi_ini_n * zmsk(:,:)
+ ztm_i_ini(:,:) = rn_tmi_ini_n * zmsk(:,:)
+ zt_su_ini(:,:) = rn_tsu_ini_n * zmsk(:,:)
+ ztm_s_ini(:,:) = rn_tms_ini_n * zmsk(:,:)
+ zapnd_ini(:,:) = rn_apd_ini_n * zmsk(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc.
+ zhpnd_ini(:,:) = rn_hpd_ini_n * zmsk(:,:)
+ zhlid_ini(:,:) = rn_hld_ini_n * zmsk(:,:)
ELSEWHERE
- zht_i_ini(:,:) = rn_hti_ini_s * zswitch(:,:)
- zht_s_ini(:,:) = rn_hts_ini_s * zswitch(:,:)
- zat_i_ini(:,:) = rn_ati_ini_s * zswitch(:,:)
- zsm_i_ini(:,:) = rn_smi_ini_s * zswitch(:,:)
- ztm_i_ini(:,:) = rn_tmi_ini_s * zswitch(:,:)
- zt_su_ini(:,:) = rn_tsu_ini_s * zswitch(:,:)
- ztm_s_ini(:,:) = rn_tms_ini_s * zswitch(:,:)
- zapnd_ini(:,:) = rn_apd_ini_s * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc.
- zhpnd_ini(:,:) = rn_hpd_ini_s * zswitch(:,:)
- zhlid_ini(:,:) = rn_hld_ini_s * zswitch(:,:)
+ zht_i_ini(:,:) = rn_hti_ini_s * zmsk(:,:)
+ zht_s_ini(:,:) = rn_hts_ini_s * zmsk(:,:)
+ zat_i_ini(:,:) = rn_ati_ini_s * zmsk(:,:)
+ zsm_i_ini(:,:) = rn_smi_ini_s * zmsk(:,:)
+ ztm_i_ini(:,:) = rn_tmi_ini_s * zmsk(:,:)
+ zt_su_ini(:,:) = rn_tsu_ini_s * zmsk(:,:)
+ ztm_s_ini(:,:) = rn_tms_ini_s * zmsk(:,:)
+ zapnd_ini(:,:) = rn_apd_ini_s * zmsk(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc.
+ zhpnd_ini(:,:) = rn_hpd_ini_s * zmsk(:,:)
+ zhlid_ini(:,:) = rn_hld_ini_s * zmsk(:,:)
END WHERE
!
ENDIF
-
-
! make sure ponds = 0 if no ponds scheme
IF ( .NOT.ln_pnd ) THEN
zapnd_ini(:,:) = 0._wp
@@ -311,7 +311,7 @@ CONTAINS
!----------------!
! select ice covered grid points
npti = 0 ; nptidx(:) = 0
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
IF ( zht_i_ini(ji,jj) > 0._wp ) THEN
npti = npti + 1
nptidx(npti) = (jj - 1) * jpi + ji
@@ -363,6 +363,16 @@ CONTAINS
DEALLOCATE( zhi_2d, zhs_2d, zai_2d , &
& zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d, zhil_2d )
+ ! this call is needed because of the calculations above that are done only in the interior
+ CALL lbc_lnk( 'iceistate', a_i , 'T', 1._wp, h_i , 'T', 1._wp, h_s , 'T', 1._wp, &
+ & zti_3d, 'T', 1._wp, zts_3d, 'T', 1._wp, t_su, 'T', 1._wp, &
+ & s_i , 'T', 1._wp, a_ip , 'T', 1._wp, h_ip, 'T', 1._wp, h_il, 'T', 1._wp )
+
+ ! switch for the following
+ WHERE( SUM(a_i(:,:,:),dim=3) > 0._wp ) ; zswitch(:,:) = tmask(:,:,1)
+ ELSEWHERE ; zswitch(:,:) = 0._wp
+ END WHERE
+
! calculate extensive and intensive variables
CALL ice_var_salprof ! for sz_i
DO jl = 1, jpl
@@ -398,15 +408,17 @@ CONTAINS
ENDIF
#endif
! Melt ponds
- WHERE( a_i > epsi10 ) ; a_ip_eff(:,:,:) = a_ip(:,:,:) / a_i(:,:,:)
- ELSEWHERE ; a_ip_eff(:,:,:) = 0._wp
+ WHERE( a_i(A2D(0),:) > epsi10 ) ; a_ip_eff(:,:,:) = a_ip(A2D(0),:) / a_i(A2D(0),:)
+ ELSEWHERE ; a_ip_eff(:,:,:) = 0._wp
END WHERE
v_ip(:,:,:) = h_ip(:,:,:) * a_ip(:,:,:)
v_il(:,:,:) = h_il(:,:,:) * a_ip(:,:,:)
! specific temperatures for coupled runs
- tn_ice(:,:,:) = t_su(:,:,:)
- t1_ice(:,:,:) = t_i (:,:,1,:)
+ DO_2D( 0, 0, 0, 0 )
+ tn_ice(ji,jj,:) = t_su(ji,jj,:)
+ t1_ice(ji,jj,:) = t_i (ji,jj,1,:)
+ END_2D
!
! ice concentration should not exceed amax
at_i(:,:) = SUM( a_i, dim=3 )
@@ -436,11 +448,7 @@ CONTAINS
! Override ssh adjustment in nested domains by the root-domain ssh adjustment;
! store the adjustment value in a global module variable to make it retrievable in nested domains
IF( .NOT.Agrif_Root() ) THEN
- IF (.NOT.ln_init_chfrpar ) THEN ! child is not initialized from the parent
- zsshadj = Agrif_Parent(rsshadj)
- ELSE ! child is initialized from the parent
- zsshadj = 0._wp ! => 0 since ssh adjustement is already done
- ENDIF
+ zsshadj = Agrif_Parent(rsshadj)
ELSE
rsshadj = zsshadj
ENDIF
@@ -463,10 +471,10 @@ CONTAINS
#else
DO jk = 1, jpk
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls)
- IF( snwice_mass(ji,jj) /= 0._wp ) THEN
+! IF( snwice_mass(ji,jj) /= 0._wp ) THEN
e3t(ji,jj,jk,Kmm) = e3t_0(ji,jj,jk) * ( 1._wp + ssh(ji,jj,Kmm) * r1_ht_0(ji,jj) * tmask(ji,jj,jk) )
e3t(ji,jj,jk,Kbb) = e3t_0(ji,jj,jk) * ( 1._wp + ssh(ji,jj,Kbb) * r1_ht_0(ji,jj) * tmask(ji,jj,jk) )
- ENDIF
+! ENDIF
END_2D
END DO
!
@@ -550,8 +558,8 @@ CONTAINS
ENDIF
!
DO ifpr = 1, jpfldi
- ALLOCATE( si(ifpr)%fnow(jpi,jpj,1) )
- IF( slf_i(ifpr)%ln_tint ) ALLOCATE( si(ifpr)%fdta(jpi,jpj,1,2) )
+ ALLOCATE( si(ifpr)%fnow(A2D(0),1) )
+ IF( slf_i(ifpr)%ln_tint ) ALLOCATE( si(ifpr)%fdta(A2D(0),1,2) )
END DO
!
! fill si with slf_i and control print
diff --git a/src/ICE/iceitd.F90 b/src/ICE/iceitd.F90
index f3e662748ae988a2ee5388c3085fb297b05b9efa..caa37df09026e7834a49f7739de63c92f38b2c81 100644
--- a/src/ICE/iceitd.F90
+++ b/src/ICE/iceitd.F90
@@ -29,6 +29,7 @@ MODULE iceitd
USE lib_fortran ! fortran utilities (glob_sum + no signed zero)
USE prtctl ! Print control
USE timing ! Timing
+ USE lbclnk ! lateral boundary conditions (or mpp links)
IMPLICIT NONE
PRIVATE
@@ -100,7 +101,7 @@ CONTAINS
at_i(:,:) = SUM( a_i, dim=3 )
!
npti = 0 ; nptidx(:) = 0
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
IF ( at_i(ji,jj) > epsi10 ) THEN
npti = npti + 1
nptidx( npti ) = (jj - 1) * jpi + ji
@@ -327,6 +328,9 @@ CONTAINS
!
ENDIF
!
+ ! the following fields need to be updated in the halos (done afterwards):
+ ! a_i, v_i, v_s, sv_i, oa_i, h_i, a_ip, v_ip, v_il, t_su, e_i, e_s
+ !
IF( ln_icediachk ) CALL ice_cons_hsm(1, 'iceitd_rem', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft)
IF( ln_icediachk ) CALL ice_cons2D (1, 'iceitd_rem', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft)
IF( ln_timing ) CALL timing_stop ('iceitd_rem')
@@ -626,7 +630,7 @@ CONTAINS
DO jl = 1, jpl-1 ! identify thicknesses that are too big
! !---------------------------------------
npti = 0 ; nptidx(:) = 0
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
IF( a_i(ji,jj,jl) > 0._wp .AND. v_i(ji,jj,jl) > (a_i(ji,jj,jl) * hi_max(jl)) ) THEN
npti = npti + 1
nptidx( npti ) = (jj - 1) * jpi + ji
@@ -662,7 +666,7 @@ CONTAINS
DO jl = jpl-1, 1, -1 ! Identify thicknesses that are too small
! !-----------------------------------------
npti = 0 ; nptidx(:) = 0
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
IF( a_i(ji,jj,jl+1) > 0._wp .AND. v_i(ji,jj,jl+1) <= (a_i(ji,jj,jl+1) * hi_max(jl)) ) THEN
npti = npti + 1
nptidx( npti ) = (jj - 1) * jpi + ji
@@ -687,6 +691,14 @@ CONTAINS
!
END DO
!
+ ! clem: the 2 lbc below could be avoided if calculations above were performed over the full domain
+ ! => decide if it is more efficient this way or not?
+ ! note: ice_itd_reb is called in icedyn
+ ! and in icethd (but once the arrays are already updated on the boundaries)
+ CALL lbc_lnk( 'iceitd_reb', a_i, 'T', 1._wp, v_i , 'T', 1._wp, v_s , 'T', 1._wp, sv_i, 'T', 1._wp, oa_i, 'T', 1._wp, &
+ & h_i, 'T', 1._wp, a_ip, 'T', 1._wp, v_ip, 'T', 1._wp, v_il, 'T', 1._wp, t_su, 'T', 1._wp )
+ CALL lbc_lnk( 'iceitd_reb', e_i, 'T', 1._wp, e_s , 'T', 1._wp )
+ !
IF( ln_icediachk ) CALL ice_cons_hsm(1, 'iceitd_reb', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft)
IF( ln_icediachk ) CALL ice_cons2D (1, 'iceitd_reb', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft)
IF( ln_timing ) CALL timing_stop ('iceitd_reb')
diff --git a/src/ICE/icesbc.F90 b/src/ICE/icesbc.F90
index 553e449977ecb918dceb80d381e687c85a001c72..03d5b83a6a9991211da476ecdb378f4e55ccf70c 100644
--- a/src/ICE/icesbc.F90
+++ b/src/ICE/icesbc.F90
@@ -58,7 +58,7 @@ CONTAINS
REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: utau_ice, vtau_ice ! air-ice stress [N/m2]
!!
INTEGER :: ji, jj ! dummy loop index
- REAL(wp), DIMENSION(jpi,jpj) :: zutau_ice, zvtau_ice
+ REAL(wp), DIMENSION(A2D(0)) :: zutau_ice, zvtau_ice
!!-------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('icesbc')
@@ -70,25 +70,38 @@ CONTAINS
ENDIF
!
SELECT CASE( ksbc )
- CASE( jp_usr ) ; CALL usrdef_sbc_ice_tau( kt ) ! user defined formulation
- CASE( jp_blk )
- CALL blk_ice_1( sf(jp_wndi)%fnow(:,:,1), sf(jp_wndj)%fnow(:,:,1), &
- & theta_air_zt(:,:), q_air_zt(:,:), & ! #LB: known from "sbc_oce" module...
- & sf(jp_slp )%fnow(:,:,1), u_ice, v_ice, tm_su , & ! inputs
- & putaui = utau_ice, pvtaui = vtau_ice ) ! outputs
- ! CASE( jp_abl ) utau_ice & vtau_ice are computed in ablmod
- CASE( jp_purecpl ) ; CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) ! Coupled formulation
+ !
+ CASE( jp_usr ) !--- User defined formulation
+ !
+ CALL usrdef_sbc_ice_tau( kt )
+ !
+ CASE( jp_blk ) !--- Forced formulation
+ !
+ CALL blk_ice_1( sf(jp_wndi)%fnow(:,:,1), sf(jp_wndj)%fnow(:,:,1), theta_air_zt(:,:), q_air_zt(:,:), & ! <<== in
+ & sf(jp_slp )%fnow(:,:,1), u_ice(A2D(0)), v_ice(A2D(0)), tm_su(:,:), & ! <<== in
+ & putaui = utau_ice(A2D(0)), pvtaui = vtau_ice(A2D(0)) ) ! ==>> out
+ !
+ !CASE( jp_abl ) !--- ABL formulation (utau_ice & vtau_ice are computed in ablmod)
+ !
+ CASE( jp_purecpl ) !--- Coupled formulation
+ !
+ CALL sbc_cpl_ice_tau( utau_ice(A2D(0)) , vtau_ice(A2D(0)) )
+ !
END SELECT
!
- IF( ln_mixcpl) THEN ! Case of a mixed Bulk/Coupled formulation
- CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice )
+ IF( ln_mixcpl) THEN !--- Case of a mixed Bulk/Coupled formulation
+ !
+ CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice )
+ !
DO_2D( 0, 0, 0, 0 )
utau_ice(ji,jj) = utau_ice(ji,jj) * xcplmask(ji,jj,0) + zutau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) )
vtau_ice(ji,jj) = vtau_ice(ji,jj) * xcplmask(ji,jj,0) + zvtau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) )
END_2D
- CALL lbc_lnk( 'icesbc', utau_ice, 'U', -1.0_wp, vtau_ice, 'V', -1.0_wp )
+ !
ENDIF
!
+ CALL lbc_lnk( 'icesbc', utau_ice, 'U', -1.0_wp, vtau_ice, 'V', -1.0_wp )
+ !
IF( ln_timing ) CALL timing_stop('icesbc')
!
END SUBROUTINE ice_sbc_tau
@@ -129,25 +142,49 @@ CONTAINS
WRITE(numout,*)'~~~~~~~~~~~~~~~'
ENDIF
! !== ice albedo ==!
- CALL ice_alb( t_su, h_i, h_s, ln_pnd_alb, a_ip_eff, h_ip, cloud_fra, alb_ice )
+ CALL ice_alb( ln_pnd_alb, t_su(A2D(0),:), h_i(A2D(0),:), h_s(A2D(0),:), a_ip_eff(:,:,:), h_ip(A2D(0),:), cloud_fra(:,:), & ! <<== in
+ & alb_ice(:,:,:) ) ! ==>> out
!
SELECT CASE( ksbc ) !== fluxes over sea ice ==!
!
CASE( jp_usr ) !--- user defined formulation
+ !
CALL usrdef_sbc_ice_flx( kt, h_s, h_i )
+ !
CASE( jp_blk, jp_abl ) !--- bulk formulation & ABL formulation
- CALL blk_ice_2 ( t_su, h_s, h_i, alb_ice, &
- & theta_air_zt(:,:), q_air_zt(:,:), & ! #LB: known from "sbc_oce" module...
- & sf(jp_slp)%fnow(:,:,1), sf(jp_qlw)%fnow(:,:,1), &
- & sf(jp_prec)%fnow(:,:,1), sf(jp_snow)%fnow(:,:,1) )
- IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( kt, picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su, phs=h_s, phi=h_i )
- IF( nn_flxdist /= -1 ) CALL ice_flx_dist ( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_flxdist )
+ !
+ CALL blk_ice_2( t_su(A2D(0),:), h_s(A2D(0),:), h_i(A2D(0),:), & ! <<== in
+ & alb_ice(:,:,:), theta_air_zt(:,:), q_air_zt(:,:), & ! <<== in
+ & sf(jp_slp)%fnow(:,:,1), sf(jp_qlw)%fnow(:,:,1), & ! <<== in
+ & sf(jp_prec)%fnow(:,:,1), sf(jp_snow)%fnow(:,:,1) ) ! <<== in
+ !
+ IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( kt, picefr=at_i_b(:,:), palbi=alb_ice(:,:,:), &
+ & psst=sst_m(A2D(0)), pist=t_su(A2D(0),:), &
+ & phs=h_s(A2D(0),:), phi=h_i(A2D(0),:) )
+ CALL lbc_lnk( 'icesbc', t_su, 'T', 1.0_wp ) ! clem: t_su is needed for Met-Office only => necessary?
+ !
+ IF( nn_flxdist /= -1 ) CALL ice_flx_dist( nn_flxdist, at_i(A2D(0)), a_i(A2D(0),:), t_su(A2D(0),:), alb_ice(:,:,:), & ! <<== in
+ & qns_ice(:,:,:), qsr_ice(:,:,:), dqns_ice(:,:,:), & ! ==>> inout
+ & evap_ice(:,:,:), devap_ice(:,:,:) ) ! ==>> inout
+ !
! ! compute conduction flux and surface temperature (as in Jules surface module)
- IF( ln_cndflx .AND. .NOT.ln_cndemulate ) &
- & CALL blk_ice_qcn ( ln_virtual_itd, t_su, t_bo, h_s, h_i )
+ IF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN
+ CALL blk_ice_qcn( ln_virtual_itd, t_bo(A2D(0)), h_s(A2D(0),:), h_i(A2D(0),:), & ! <<== in
+ & qcn_ice(:,:,:), qml_ice(:,:,:), & ! ==>> out
+ & qns_ice(:,:,:), t_su(A2D(0),:) ) ! ==>> inout
+ CALL lbc_lnk( 'icesbc', t_su, 'T', 1.0_wp ) ! clem: t_su is updated in ice_qcn => necessary?
+ ENDIF
+ !
CASE ( jp_purecpl ) !--- coupled formulation
- CALL sbc_cpl_ice_flx( kt, picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su, phs=h_s, phi=h_i )
- IF( nn_flxdist /= -1 ) CALL ice_flx_dist ( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_flxdist )
+ !
+ CALL sbc_cpl_ice_flx( kt, picefr=at_i_b(:,:), palbi=alb_ice(:,:,:), psst=sst_m(A2D(0)), &
+ & pist=t_su(A2D(0),:), phs=h_s(A2D(0),:), phi=h_i(A2D(0),:) )
+ CALL lbc_lnk( 'icesbc', t_su, 'T', 1.0_wp ) ! clem: t_su is needed for Met-Office only => necessary?
+ !
+ IF( nn_flxdist /= -1 ) CALL ice_flx_dist( nn_flxdist, at_i(A2D(0)), a_i(A2D(0),:), t_su(A2D(0),:), alb_ice(:,:,:), & ! <<== in
+ & qns_ice(:,:,:), qsr_ice(:,:,:), dqns_ice(:,:,:), & ! ==>> inout
+ & evap_ice(:,:,:), devap_ice(:,:,:) ) ! ==>> inout
+ !
END SELECT
! !== some fluxes at the ice-ocean interface and in the leads
CALL ice_flx_other
@@ -157,7 +194,8 @@ CONTAINS
END SUBROUTINE ice_sbc_flx
- SUBROUTINE ice_flx_dist( ptn_ice, palb_ice, pqns_ice, pqsr_ice, pdqn_ice, pevap_ice, pdevap_ice, k_flxdist )
+ SUBROUTINE ice_flx_dist( k_flxdist, pat_i, pa_i, ptn_ice, palb_ice, &
+ & pqns_ice, pqsr_ice, pdqn_ice, pevap_ice, pdevap_ice )
!!-------------------------------------------------------------------
!! *** ROUTINE ice_flx_dist ***
!!
@@ -173,18 +211,20 @@ CONTAINS
!! using T-ice and albedo sensitivity
!! = 2 Redistribute a single flux over categories
!!-------------------------------------------------------------------
- INTEGER , INTENT(in ) :: k_flxdist ! redistributor
- REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: ptn_ice ! ice surface temperature
- REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: palb_ice ! ice albedo
- REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pqns_ice ! non solar flux
- REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pqsr_ice ! net solar flux
- REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pdqn_ice ! non solar flux sensitivity
- REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pevap_ice ! sublimation
- REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pdevap_ice ! sublimation sensitivity
+ INTEGER , INTENT(in ) :: k_flxdist ! redistributor
+ REAL(wp), DIMENSION(A2D(0)) , INTENT(in ) :: pat_i ! ice concentration
+ REAL(wp), DIMENSION(A2D(0),jpl), INTENT(in ) :: pa_i ! ice concentration
+ REAL(wp), DIMENSION(A2D(0),jpl), INTENT(in ) :: ptn_ice ! ice surface temperature
+ REAL(wp), DIMENSION(A2D(0),jpl), INTENT(in ) :: palb_ice ! ice albedo
+ REAL(wp), DIMENSION(A2D(0),jpl), INTENT(inout) :: pqns_ice ! non solar flux
+ REAL(wp), DIMENSION(A2D(0),jpl), INTENT(inout) :: pqsr_ice ! net solar flux
+ REAL(wp), DIMENSION(A2D(0),jpl), INTENT(inout) :: pdqn_ice ! non solar flux sensitivity
+ REAL(wp), DIMENSION(A2D(0),jpl), INTENT(inout) :: pevap_ice ! sublimation
+ REAL(wp), DIMENSION(A2D(0),jpl), INTENT(inout) :: pdevap_ice ! sublimation sensitivity
!
INTEGER :: jl ! dummy loop index
!
- REAL(wp), DIMENSION(jpi,jpj) :: z1_at_i ! inverse of concentration
+ REAL(wp), DIMENSION(A2D(0)) :: z1_at_i ! inverse of concentration
!
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_qsr_m ! Mean solar heat flux over all categories
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_qns_m ! Mean non solar heat flux over all categories
@@ -195,7 +235,7 @@ CONTAINS
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ztem_m ! Mean temperature over all categories
!!----------------------------------------------------------------------
!
- WHERE ( at_i (:,:) > 0._wp ) ; z1_at_i(:,:) = 1._wp / at_i (:,:)
+ WHERE ( pat_i(:,:) > 0._wp ) ; z1_at_i(:,:) = 1._wp / pat_i(:,:)
ELSEWHERE ; z1_at_i(:,:) = 0._wp
END WHERE
@@ -203,13 +243,13 @@ CONTAINS
!
CASE( 0 , 1 )
!
- ALLOCATE( z_qns_m(jpi,jpj), z_qsr_m(jpi,jpj), z_dqn_m(jpi,jpj), z_evap_m(jpi,jpj), z_devap_m(jpi,jpj) )
+ ALLOCATE( z_qns_m(A2D(0)), z_qsr_m(A2D(0)), z_dqn_m(A2D(0)), z_evap_m(A2D(0)), z_devap_m(A2D(0)) )
!
- z_qns_m (:,:) = SUM( a_i(:,:,:) * pqns_ice (:,:,:) , dim=3 ) * z1_at_i(:,:)
- z_qsr_m (:,:) = SUM( a_i(:,:,:) * pqsr_ice (:,:,:) , dim=3 ) * z1_at_i(:,:)
- z_dqn_m (:,:) = SUM( a_i(:,:,:) * pdqn_ice (:,:,:) , dim=3 ) * z1_at_i(:,:)
- z_evap_m (:,:) = SUM( a_i(:,:,:) * pevap_ice (:,:,:) , dim=3 ) * z1_at_i(:,:)
- z_devap_m(:,:) = SUM( a_i(:,:,:) * pdevap_ice(:,:,:) , dim=3 ) * z1_at_i(:,:)
+ z_qns_m (:,:) = SUM( pa_i(:,:,:) * pqns_ice (:,:,:) , dim=3 ) * z1_at_i(:,:)
+ z_qsr_m (:,:) = SUM( pa_i(:,:,:) * pqsr_ice (:,:,:) , dim=3 ) * z1_at_i(:,:)
+ z_dqn_m (:,:) = SUM( pa_i(:,:,:) * pdqn_ice (:,:,:) , dim=3 ) * z1_at_i(:,:)
+ z_evap_m (:,:) = SUM( pa_i(:,:,:) * pevap_ice (:,:,:) , dim=3 ) * z1_at_i(:,:)
+ z_devap_m(:,:) = SUM( pa_i(:,:,:) * pdevap_ice(:,:,:) , dim=3 ) * z1_at_i(:,:)
DO jl = 1, jpl
pqns_ice (:,:,jl) = z_qns_m (:,:)
pqsr_ice (:,:,jl) = z_qsr_m (:,:)
@@ -226,10 +266,10 @@ CONTAINS
!
CASE( 1 , 2 )
!
- ALLOCATE( zalb_m(jpi,jpj), ztem_m(jpi,jpj) )
+ ALLOCATE( zalb_m(A2D(0)), ztem_m(A2D(0)) )
!
- zalb_m(:,:) = SUM( a_i(:,:,:) * palb_ice(:,:,:) , dim=3 ) * z1_at_i(:,:)
- ztem_m(:,:) = SUM( a_i(:,:,:) * ptn_ice (:,:,:) , dim=3 ) * z1_at_i(:,:)
+ zalb_m(:,:) = SUM( pa_i(:,:,:) * palb_ice(:,:,:) , dim=3 ) * z1_at_i(:,:)
+ ztem_m(:,:) = SUM( pa_i(:,:,:) * ptn_ice (:,:,:) , dim=3 ) * z1_at_i(:,:)
DO jl = 1, jpl
pqns_ice (:,:,jl) = pqns_ice (:,:,jl) + pdqn_ice (:,:,jl) * ( ptn_ice(:,:,jl) - ztem_m(:,:) )
pevap_ice(:,:,jl) = pevap_ice(:,:,jl) + pdevap_ice(:,:,jl) * ( ptn_ice(:,:,jl) - ztem_m(:,:) )
@@ -257,7 +297,7 @@ CONTAINS
REAL(wp) :: zfric_u, zqld, zqfr, zqfr_neg, zqfr_pos, zu_io, zv_io, zu_iom1, zv_iom1
REAL(wp), PARAMETER :: zfric_umin = 0._wp ! lower bound for the friction velocity (cice value=5.e-04)
REAL(wp), PARAMETER :: zch = 0.0057_wp ! heat transfer coefficient
- REAL(wp), DIMENSION(jpi,jpj) :: zfric, zvel ! ice-ocean velocity (m/s) and frictional velocity (m2/s2)
+ REAL(wp), DIMENSION(A2D(0)) :: zfric, zvel ! ice-ocean velocity (m/s) and frictional velocity (m2/s2)
!!-----------------------------------------------------------------------
!
! computation of friction velocity at T points
@@ -268,14 +308,13 @@ CONTAINS
zv_io = v_ice(ji ,jj ) - ssv_m(ji ,jj )
zv_iom1 = v_ice(ji ,jj-1) - ssv_m(ji ,jj-1)
!
- zfric(ji,jj) = rn_cio * ( 0.5_wp * ( zu_io*zu_io + zu_iom1*zu_iom1 + zv_io*zv_io + zv_iom1*zv_iom1 ) ) * tmask(ji,jj,1)
+ zfric(ji,jj) = rn_cio * ( 0.5_wp * ( zu_io*zu_io + zu_iom1*zu_iom1 + zv_io*zv_io + zv_iom1*zv_iom1 ) ) * smask0(ji,jj)
zvel (ji,jj) = 0.5_wp * SQRT( ( u_ice(ji-1,jj ) + u_ice(ji,jj) ) * ( u_ice(ji-1,jj ) + u_ice(ji,jj) ) + &
& ( v_ice(ji ,jj-1) + v_ice(ji,jj) ) * ( v_ice(ji ,jj-1) + v_ice(ji,jj) ) )
END_2D
- CALL lbc_lnk( 'icesbc', zfric, 'T', 1.0_wp, zvel, 'T', 1.0_wp )
ELSE ! if no ice dynamics => transfer directly the atmospheric stress to the ocean
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- zfric(ji,jj) = r1_rho0 * SQRT( utau(ji,jj)*utau(ji,jj) + vtau(ji,jj)*vtau(ji,jj) ) * tmask(ji,jj,1)
+ DO_2D( 0, 0, 0, 0 )
+ zfric(ji,jj) = r1_rho0 * SQRT( utau(ji,jj)*utau(ji,jj) + vtau(ji,jj)*vtau(ji,jj) ) * smask0(ji,jj)
zvel (ji,jj) = 0._wp
END_2D
ENDIF
@@ -283,19 +322,19 @@ CONTAINS
!--------------------------------------------------------------------!
! Partial computation of forcing for the thermodynamic sea ice model
!--------------------------------------------------------------------!
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! needed for qlead
- rswitch = tmask(ji,jj,1) * MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) ! 0 if no ice
+ DO_2D( 0, 0, 0, 0 ) ! needed for qlead
+ rswitch = smask0(ji,jj) * MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) ! 0 if no ice
!
! --- Energy received in the lead from atm-oce exchanges, zqld is defined everywhere (J.m-2) --- !
- zqld = tmask(ji,jj,1) * rDt_ice * &
+ zqld = smask0(ji,jj) * rDt_ice * &
& ( ( 1._wp - at_i_b(ji,jj) ) * qsr_oce(ji,jj) * frq_m(ji,jj) + &
& ( 1._wp - at_i_b(ji,jj) ) * qns_oce(ji,jj) + qemp_oce(ji,jj) )
! --- Energy needed to bring ocean surface layer until its freezing, zqfr is defined everywhere (J.m-2) --- !
! (mostly<0 but >0 if supercooling)
- zqfr = rho0 * rcp * e3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) * tmask(ji,jj,1) ! both < 0 (t_bo < sst) and > 0 (t_bo > sst)
- zqfr_neg = MIN( zqfr , 0._wp ) ! only < 0
- zqfr_pos = MAX( zqfr , 0._wp ) ! only > 0
+ zqfr = rho0 * rcp * e3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) * smask0(ji,jj) ! both < 0 (t_bo < sst) and > 0 (t_bo > sst)
+ zqfr_neg = MIN( zqfr , 0._wp ) ! only < 0
+ zqfr_pos = MAX( zqfr , 0._wp ) ! only > 0
! --- Sensible ocean-to-ice heat flux (W/m2) --- !
! (mostly>0 but <0 if supercooling)
diff --git a/src/ICE/icestp.F90 b/src/ICE/icestp.F90
index 070052dbbaf5a88d32e277c1df600355deeffadd..61d65ff74a34cdec309c98456cc490bfa3d16f9e 100644
--- a/src/ICE/icestp.F90
+++ b/src/ICE/icestp.F90
@@ -77,6 +77,7 @@ MODULE icestp
USE lib_fortran ! fortran utilities (glob_sum + no signed zero)
USE timing ! Timing
USE prtctl ! Print control
+ USE lbclnk ! lateral boundary conditions (or mpp links)
IMPLICIT NONE
PRIVATE
@@ -109,7 +110,7 @@ CONTAINS
!! - save the outputs
!! - save the outputs for restart when necessary
!!
- !! ** Action : - time evolution of the LIM sea-ice model
+ !! ** Action : - time evolution of the SI3 sea-ice model
!! - update all sbc variables below sea-ice:
!! utau, vtau, taum, wndm, qns , qsr, emp , sfx
!!---------------------------------------------------------------------
@@ -117,7 +118,7 @@ CONTAINS
INTEGER, INTENT(in) :: Kbb, Kmm ! ocean time level indices
INTEGER, INTENT(in) :: ksbc ! flux formulation (user defined, bulk, or Pure Coupled)
!
- INTEGER :: jl ! dummy loop index
+ INTEGER :: ji, jj, jl ! dummy loop index
!!----------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('icestp')
@@ -128,9 +129,12 @@ CONTAINS
!
kt_ice = kt ! -- Ice model time step
!
- u_oce(:,:) = ssu_m(:,:) ! -- mean surface ocean current
- v_oce(:,:) = ssv_m(:,:)
+ DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! -- mean surface ocean current
+ u_oce(ji,jj) = ssu_m(ji,jj)
+ v_oce(ji,jj) = ssv_m(ji,jj)
+ END_2D
!
+ ! clem: I think t_bo needs to be defined everywhere but check
CALL eos_fzp( sss_m(:,:) , t_bo(:,:) ) ! -- freezing temperature [Kelvin] (set to rt0 over land)
t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) )
!
@@ -152,6 +156,7 @@ CONTAINS
! utau_ice, vtau_ice = surface ice stress [N/m2]
!------------------------------------------------!
CALL ice_sbc_tau( kt, ksbc, utau_ice, vtau_ice )
+ ! => clem: here utau_ice and vtau_ice are defined everywhere
!-------------------------------------!
! --- ice dynamics and advection --- !
!-------------------------------------!
@@ -161,6 +166,11 @@ CONTAINS
IF( ln_icedyn .AND. .NOT.ln_c1d ) &
& CALL ice_dyn( kt, Kmm ) ! -- Ice dynamics
!
+ ! ==> clem: here, all the global variables are correctly defined in the halos:
+ ! ato_i, a_i, v_i, v_s, sv_i, oa_i, a_ip, v_ip, v_il, e_i, e_s
+ ! as well as h_i and t_su for practical reasons
+ ! It may not be necessary. If it is not, then remove lbc_lnk in icedyn_rdgrft and iceitd_reb
+
CALL diag_trends( 1 ) ! record dyn trends
!
! !== lateral boundary conditions ==!
@@ -170,7 +180,8 @@ CONTAINS
CALL ice_var_glo2eqv ! h_i and h_s for ice albedo calculation
CALL ice_var_agg(1) ! at_i for coupling
CALL store_fields ! Store now ice values
- !
+ ! ==> clem: here, full arrays = vt_i, vt_s, vt_ip, vt_il, at_i, at_ip, ato_i
+ ! reduced arrays = st_i, et_i, et_s, tm_su
!------------------------------------------------------!
! --- Thermodynamical coupling with the atmosphere --- !
!------------------------------------------------------!
@@ -184,11 +195,15 @@ CONTAINS
! qemp_oce, qemp_ice, = sensible heat (associated with evap & precip) [W/m2]
! qprec_ice, qevap_ice
!------------------------------------------------------!
+ ! ==> clem: From here on, we only need to work on the interior domain
+ ! though it necessitates a large lbc at the end of the time step
CALL ice_sbc_flx( kt, ksbc )
!----------------------------!
! --- ice thermodynamics --- !
!----------------------------!
IF( ln_icethd ) CALL ice_thd( kt ) ! -- Ice thermodynamics
+ !
+ ! ==> clem: here, all the global variables are correctly defined in the halos
!
CALL diag_trends( 2 ) ! record thermo trends
CALL ice_var_glo2eqv ! necessary calls (at least for coupling)
@@ -288,7 +303,7 @@ CONTAINS
CALL ice_drift_init ! initialization for diags of conservation
!
fr_i (:,:) = at_i(:,:) ! initialisation of sea-ice fraction
- tn_ice(:,:,:) = t_su(:,:,:) ! initialisation of surface temp for coupled simu
+ tn_ice(:,:,:) = t_su(A2D(0),:) ! initialisation of surface temp for coupled simu
!
IF( ln_rstart ) THEN
CALL iom_close( numrir ) ! close input ice restart file
@@ -369,26 +384,33 @@ CONTAINS
INTEGER :: ji, jj, jl ! dummy loop index
!!----------------------------------------------------------------------
!
- a_i_b (:,:,:) = a_i (:,:,:) ! ice area
- v_i_b (:,:,:) = v_i (:,:,:) ! ice volume
- v_s_b (:,:,:) = v_s (:,:,:) ! snow volume
- v_ip_b(:,:,:) = v_ip(:,:,:) ! pond volume
- v_il_b(:,:,:) = v_il(:,:,:) ! pond lid volume
- sv_i_b(:,:,:) = sv_i(:,:,:) ! salt content
- e_s_b (:,:,:,:) = e_s (:,:,:,:) ! snow thermal energy
- e_i_b (:,:,:,:) = e_i (:,:,:,:) ! ice thermal energy
- WHERE( a_i_b(:,:,:) >= epsi20 )
- h_i_b(:,:,:) = v_i_b(:,:,:) / a_i_b(:,:,:) ! ice thickness
- h_s_b(:,:,:) = v_s_b(:,:,:) / a_i_b(:,:,:) ! snw thickness
- ELSEWHERE
- h_i_b(:,:,:) = 0._wp
- h_s_b(:,:,:) = 0._wp
- END WHERE
- !
- ! ice velocities & total concentration
+ DO jl = 1, jpl
+ DO_2D( 0, 0, 0, 0 )
+ a_i_b (ji,jj,jl) = a_i (ji,jj,jl) ! ice area
+ v_i_b (ji,jj,jl) = v_i (ji,jj,jl) ! ice volume
+ v_s_b (ji,jj,jl) = v_s (ji,jj,jl) ! snow volume
+ v_ip_b(ji,jj,jl) = v_ip(ji,jj,jl) ! pond volume
+ v_il_b(ji,jj,jl) = v_il(ji,jj,jl) ! pond lid volume
+ sv_i_b(ji,jj,jl) = sv_i(ji,jj,jl) ! salt content
+ IF( a_i_b(ji,jj,jl) >= epsi20 ) THEN
+ h_i_b(ji,jj,jl) = v_i_b(ji,jj,jl) / a_i_b(ji,jj,jl) ! ice thickness
+ h_s_b(ji,jj,jl) = v_s_b(ji,jj,jl) / a_i_b(ji,jj,jl) ! snw thickness
+ ELSE
+ h_i_b(ji,jj,jl) = 0._wp
+ h_s_b(ji,jj,jl) = 0._wp
+ ENDIF
+ e_s_b (ji,jj,:,jl) = e_s (ji,jj,:,jl) ! snow thermal energy
+ e_i_b (ji,jj,:,jl) = e_i (ji,jj,:,jl) ! ice thermal energy
+ END_2D
+ ENDDO
+ ! total concentration
at_i_b(:,:) = SUM( a_i_b(:,:,:), dim=3 )
- u_ice_b(:,:) = u_ice(:,:)
- v_ice_b(:,:) = v_ice(:,:)
+
+ ! ice velocity
+ DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ u_ice_b(ji,jj) = u_ice(ji,jj)
+ v_ice_b(ji,jj) = v_ice(ji,jj)
+ END_2D
!
END SUBROUTINE store_fields
@@ -402,20 +424,23 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER :: ji, jj, jl ! dummy loop index
!!----------------------------------------------------------------------
+ DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ sfx_res(ji,jj) = 0._wp ; wfx_res(ji,jj) = 0._wp ; hfx_res(ji,jj) = 0._wp
+ END_2D
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! needed for (at least) diag_adv_mass -> to be removed
+ DO_2D( 0, 0, 0, 0 )
sfx (ji,jj) = 0._wp ;
sfx_bri(ji,jj) = 0._wp ; sfx_lam(ji,jj) = 0._wp
sfx_sni(ji,jj) = 0._wp ; sfx_opw(ji,jj) = 0._wp
sfx_bog(ji,jj) = 0._wp ; sfx_dyn(ji,jj) = 0._wp
sfx_bom(ji,jj) = 0._wp ; sfx_sum(ji,jj) = 0._wp
- sfx_res(ji,jj) = 0._wp ; sfx_sub(ji,jj) = 0._wp
+ sfx_sub(ji,jj) = 0._wp
!
wfx_snw(ji,jj) = 0._wp ; wfx_ice(ji,jj) = 0._wp
wfx_sni(ji,jj) = 0._wp ; wfx_opw(ji,jj) = 0._wp
wfx_bog(ji,jj) = 0._wp ; wfx_dyn(ji,jj) = 0._wp
wfx_bom(ji,jj) = 0._wp ; wfx_sum(ji,jj) = 0._wp
- wfx_res(ji,jj) = 0._wp ; wfx_sub(ji,jj) = 0._wp
+ wfx_sub(ji,jj) = 0._wp
wfx_spr(ji,jj) = 0._wp ; wfx_lam(ji,jj) = 0._wp
wfx_snw_dyn(ji,jj) = 0._wp ; wfx_snw_sum(ji,jj) = 0._wp
wfx_snw_sub(ji,jj) = 0._wp ; wfx_ice_sub(ji,jj) = 0._wp
@@ -426,7 +451,7 @@ CONTAINS
hfx_snw(ji,jj) = 0._wp ; hfx_opw(ji,jj) = 0._wp
hfx_bog(ji,jj) = 0._wp ; hfx_dyn(ji,jj) = 0._wp
hfx_bom(ji,jj) = 0._wp ; hfx_sum(ji,jj) = 0._wp
- hfx_res(ji,jj) = 0._wp ; hfx_sub(ji,jj) = 0._wp
+ hfx_sub(ji,jj) = 0._wp
hfx_spr(ji,jj) = 0._wp ; hfx_dif(ji,jj) = 0._wp
hfx_err_dif(ji,jj) = 0._wp
wfx_err_sub(ji,jj) = 0._wp
@@ -451,7 +476,7 @@ CONTAINS
END_2D
DO jl = 1, jpl
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
! SIMIP diagnostics
t_si (ji,jj,jl) = rt0 ! temp at the ice-snow interface
qcn_ice_bot(ji,jj,jl) = 0._wp
@@ -477,22 +502,25 @@ CONTAINS
!! and outputs
!!----------------------------------------------------------------------
INTEGER, INTENT(in) :: kn ! 1 = after dyn ; 2 = after thermo
- !!----------------------------------------------------------------------
+ INTEGER :: ji, jj, jl ! dummy loop index
+ !!----------------------------------------------------------------------
!
! --- trends of heat, salt, mass (used for conservation controls)
IF( ln_icediachk .OR. iom_use('hfxdhc') ) THEN
!
- diag_heat(:,:) = diag_heat(:,:) &
- & - SUM(SUM( e_i (:,:,1:nlay_i,:) - e_i_b (:,:,1:nlay_i,:), dim=4 ), dim=3 ) * r1_Dt_ice &
- & - SUM(SUM( e_s (:,:,1:nlay_s,:) - e_s_b (:,:,1:nlay_s,:), dim=4 ), dim=3 ) * r1_Dt_ice
- diag_sice(:,:) = diag_sice(:,:) &
- & + SUM( sv_i(:,:,:) - sv_i_b(:,:,:) , dim=3 ) * r1_Dt_ice * rhoi
- diag_vice(:,:) = diag_vice(:,:) &
- & + SUM( v_i (:,:,:) - v_i_b (:,:,:) , dim=3 ) * r1_Dt_ice * rhoi
- diag_vsnw(:,:) = diag_vsnw(:,:) &
- & + SUM( v_s (:,:,:) - v_s_b (:,:,:) , dim=3 ) * r1_Dt_ice * rhos
- diag_vpnd(:,:) = diag_vpnd(:,:) &
- & + SUM( v_ip + v_il - v_ip_b - v_il_b , dim=3 ) * r1_Dt_ice * rhow
+ DO_2D( 0, 0, 0, 0 )
+ diag_heat(ji,jj) = diag_heat(ji,jj) &
+ & - SUM(SUM( e_i (ji,jj,1:nlay_i,:) - e_i_b (ji,jj,1:nlay_i,:), dim=2 ) ) * r1_Dt_ice &
+ & - SUM(SUM( e_s (ji,jj,1:nlay_s,:) - e_s_b (ji,jj,1:nlay_s,:), dim=2 ) ) * r1_Dt_ice
+ diag_sice(ji,jj) = diag_sice(ji,jj) &
+ & + SUM( sv_i(ji,jj,:) - sv_i_b(ji,jj,:) ) * r1_Dt_ice * rhoi
+ diag_vice(ji,jj) = diag_vice(ji,jj) &
+ & + SUM( v_i (ji,jj,:) - v_i_b (ji,jj,:) ) * r1_Dt_ice * rhoi
+ diag_vsnw(ji,jj) = diag_vsnw(ji,jj) &
+ & + SUM( v_s (ji,jj,:) - v_s_b (ji,jj,:) ) * r1_Dt_ice * rhos
+ diag_vpnd(ji,jj) = diag_vpnd(ji,jj) &
+ & + SUM( v_ip(ji,jj,:)+v_il(ji,jj,:) - v_ip_b(ji,jj,:)-v_il_b(ji,jj,:) ) * r1_Dt_ice * rhow
+ END_2D
!
IF( kn == 2 ) CALL iom_put ( 'hfxdhc' , diag_heat ) ! output of heat trend
!
@@ -501,10 +529,12 @@ CONTAINS
! --- trends of concentration (used for simip outputs)
IF( iom_use('afxdyn') .OR. iom_use('afxthd') .OR. iom_use('afxtot') ) THEN
!
- diag_aice(:,:) = diag_aice(:,:) + SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_Dt_ice
+ DO_2D( 0, 0, 0, 0 )
+ diag_aice(ji,jj) = diag_aice(ji,jj) + SUM( a_i(ji,jj,:) - a_i_b(ji,jj,:) ) * r1_Dt_ice
+ END_2D
!
IF( kn == 1 ) CALL iom_put( 'afxdyn' , diag_aice ) ! dyn trend
- IF( kn == 2 ) CALL iom_put( 'afxthd' , SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_Dt_ice ) ! thermo trend
+ IF( kn == 2 ) CALL iom_put( 'afxthd' , SUM( a_i(A2D(0),:) - a_i_b(A2D(0),:), dim=3 ) * r1_Dt_ice ) ! thermo trend
IF( kn == 2 ) CALL iom_put( 'afxtot' , diag_aice ) ! total trend
!
ENDIF
diff --git a/src/ICE/icetab.F90 b/src/ICE/icetab.F90
index 2b1b880f55bc92ee24f8c057ae6655fd4267ef43..02d3501ea1079cfa3d0c9b56aaf2ad8955b58a33 100644
--- a/src/ICE/icetab.F90
+++ b/src/ICE/icetab.F90
@@ -38,15 +38,24 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: ndim1d ! 1d size
INTEGER , DIMENSION(ndim1d) , INTENT(in ) :: tab_ind ! input index
- REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(in ) :: tab2d ! input 2D field
+ REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: tab2d ! input 2D field
REAL(wp), DIMENSION(ndim1d,jpl) , INTENT(inout) :: tab1d ! output 1D field
!
- INTEGER :: jl, jn, jid, jjd
+ INTEGER :: ipi, ipj, ji0, jj0, jl, jn, jid, jjd
!!----------------------------------------------------------------------
+ ipi = SIZE(tab2d,1) ! 1st dimension
+ ipj = SIZE(tab2d,2) ! 2nd dimension
+ !
+ IF( ipi == jpi .AND. ipj == jpj ) THEN ! full arrays then no need to change index jid and jjd
+ ji0 = 0 ; jj0 = 0
+ ELSE ! reduced arrays then need to shift index by nn_hls
+ ji0 = nn_hls ; jj0 = nn_hls ! since tab2d is shifted by nn_hls
+ ENDIF ! (i.e. from hls+1:jpi-hls to 1:jpi-2*hls)
+ !
DO jl = 1, jpl
DO jn = 1, ndim1d
- jid = MOD( tab_ind(jn) - 1 , jpi ) + 1
- jjd = ( tab_ind(jn) - 1 ) / jpi + 1
+ jid = MOD( tab_ind(jn) - 1 , jpi ) + 1 - ji0
+ jjd = ( tab_ind(jn) - 1 ) / jpi + 1 - jj0
tab1d(jn,jl) = tab2d(jid,jjd,jl)
END DO
END DO
@@ -59,14 +68,23 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: ndim1d ! 1d size
INTEGER , DIMENSION(ndim1d) , INTENT(in ) :: tab_ind ! input index
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: tab2d ! input 2D field
+ REAL(wp), DIMENSION(:,:) , INTENT(in ) :: tab2d ! input 2D field
REAL(wp), DIMENSION(ndim1d) , INTENT(inout) :: tab1d ! output 1D field
!
- INTEGER :: jn , jid, jjd
+ INTEGER :: ipi, ipj, ji0, jj0, jn, jid, jjd
!!----------------------------------------------------------------------
+ ipi = SIZE(tab2d,1) ! 1st dimension
+ ipj = SIZE(tab2d,2) ! 2nd dimension
+ !
+ IF( ipi == jpi .AND. ipj == jpj ) THEN ! full arrays then no need to change index jid and jjd
+ ji0 = 0 ; jj0 = 0
+ ELSE ! reduced arrays then need to shift index by nn_hls
+ ji0 = nn_hls ; jj0 = nn_hls ! since tab2d is shifted by nn_hls
+ ENDIF ! (i.e. from hls+1:jpi-hls to 1:jpi-2*hls)
+ !
DO jn = 1, ndim1d
- jid = MOD( tab_ind(jn) - 1 , jpi ) + 1
- jjd = ( tab_ind(jn) - 1 ) / jpi + 1
+ jid = MOD( tab_ind(jn) - 1 , jpi ) + 1 - ji0
+ jjd = ( tab_ind(jn) - 1 ) / jpi + 1 - jj0
tab1d( jn) = tab2d( jid, jjd)
END DO
END SUBROUTINE tab_2d_1d
@@ -79,14 +97,23 @@ CONTAINS
INTEGER , INTENT(in ) :: ndim1d ! 1D size
INTEGER , DIMENSION(ndim1d) , INTENT(in ) :: tab_ind ! input index
REAL(wp), DIMENSION(ndim1d,jpl) , INTENT(in ) :: tab1d ! input 1D field
- REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(inout) :: tab2d ! output 2D field
+ REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: tab2d ! output 2D field
!
- INTEGER :: jl, jn, jid, jjd
+ INTEGER :: ipi, ipj, ji0, jj0, jl, jn, jid, jjd
!!----------------------------------------------------------------------
+ ipi = SIZE(tab2d,1) ! 1st dimension
+ ipj = SIZE(tab2d,2) ! 2nd dimension
+ !
+ IF( ipi == jpi .AND. ipj == jpj ) THEN ! full arrays then no need to change index jid and jjd
+ ji0 = 0 ; jj0 = 0
+ ELSE ! reduced arrays then need to shift index by nn_hls
+ ji0 = nn_hls ; jj0 = nn_hls ! since tab2d is shifted by nn_hls
+ ENDIF ! (i.e. from hls+1:jpi-hls to 1:jpi-2*hls)
+ !
DO jl = 1, jpl
DO jn = 1, ndim1d
- jid = MOD( tab_ind(jn) - 1 , jpi ) + 1
- jjd = ( tab_ind(jn) - 1 ) / jpi + 1
+ jid = MOD( tab_ind(jn) - 1 , jpi ) + 1 - ji0
+ jjd = ( tab_ind(jn) - 1 ) / jpi + 1 - jj0
tab2d(jid,jjd,jl) = tab1d(jn,jl)
END DO
END DO
@@ -100,13 +127,22 @@ CONTAINS
INTEGER , INTENT(in ) :: ndim1d ! 1D size
INTEGER , DIMENSION(ndim1d) , INTENT(in ) :: tab_ind ! input index
REAL(wp), DIMENSION(ndim1d) , INTENT(in ) :: tab1d ! input 1D field
- REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: tab2d ! output 2D field
+ REAL(wp), DIMENSION(:,:) , INTENT(inout) :: tab2d ! output 2D field
!
- INTEGER :: jn , jid, jjd
+ INTEGER :: ipi, ipj, ji0, jj0, jn, jid, jjd
!!----------------------------------------------------------------------
+ ipi = SIZE(tab2d,1) ! 1st dimension
+ ipj = SIZE(tab2d,2) ! 2nd dimension
+ !
+ IF( ipi == jpi .AND. ipj == jpj ) THEN ! full arrays then no need to change index jid and jjd
+ ji0 = 0 ; jj0 = 0
+ ELSE ! reduced arrays then need to shift index by nn_hls
+ ji0 = nn_hls ; jj0 = nn_hls ! since tab2d is shifted by nn_hls
+ ENDIF ! (i.e. from hls+1:jpi-hls to 1:jpi-2*hls)
+ !
DO jn = 1, ndim1d
- jid = MOD( tab_ind(jn) - 1 , jpi ) + 1
- jjd = ( tab_ind(jn) - 1 ) / jpi + 1
+ jid = MOD( tab_ind(jn) - 1 , jpi ) + 1 - ji0
+ jjd = ( tab_ind(jn) - 1 ) / jpi + 1 - jj0
tab2d(jid, jjd) = tab1d( jn)
END DO
END SUBROUTINE tab_1d_2d
diff --git a/src/ICE/icethd.F90 b/src/ICE/icethd.F90
index 3971c4415240950ed6423023821b958247370d3f..e831a062efa01f03350c0ca995613350d1e2c73e 100644
--- a/src/ICE/icethd.F90
+++ b/src/ICE/icethd.F90
@@ -98,7 +98,7 @@ CONTAINS
! convergence tests
IF( ln_zdf_chkcvg ) THEN
- ALLOCATE( ztice_cvgerr(jpi,jpj,jpl) , ztice_cvgstp(jpi,jpj,jpl) )
+ ALLOCATE( ztice_cvgerr(A2D(0),jpl) , ztice_cvgstp(A2D(0),jpl) )
ztice_cvgerr = 0._wp ; ztice_cvgstp = 0._wp
ENDIF
!
@@ -111,7 +111,7 @@ CONTAINS
! select ice covered grid points
npti = 0 ; nptidx(:) = 0
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
IF ( a_i(ji,jj,jl) > epsi10 ) THEN
npti = npti + 1
nptidx(npti) = (jj - 1) * jpi + ji
@@ -158,6 +158,13 @@ CONTAINS
IF( jpl > 1 ) CALL ice_itd_rem( kt ) ! --- Transport ice between thickness categories --- !
!
IF( ln_icedO ) CALL ice_thd_do ! --- Frazil ice growth in leads --- !
+ !
+ ! ! --- LBC for the halos --- !
+ ! the 2 lbc below could be avoided if calculations above were performed over the full domain
+ ! but we think it is more efficient this way
+ CALL lbc_lnk( 'icethd', a_i , 'T', 1._wp, v_i , 'T', 1._wp, v_s , 'T', 1._wp, sv_i, 'T', 1._wp, oa_i, 'T', 1._wp, &
+ & a_ip, 'T', 1._wp, v_ip, 'T', 1._wp, v_il, 'T', 1._wp, t_su, 'T', 1._wp )
+ CALL lbc_lnk( 'icethd', e_i , 'T', 1._wp, e_s , 'T', 1._wp )
!
CALL ice_cor( kt , 2 ) ! --- Corrections --- !
!
diff --git a/src/ICE/icethd_do.F90 b/src/ICE/icethd_do.F90
index ace1000aa497d30ca52321d59e4a898dcff48e90..690af0e2129f7618ffca134804df7b8b1557ef9f 100644
--- a/src/ICE/icethd_do.F90
+++ b/src/ICE/icethd_do.F90
@@ -28,7 +28,6 @@ MODULE icethd_do
USE in_out_manager ! I/O manager
USE lib_mpp ! MPP library
USE lib_fortran ! fortran utilities (glob_sum + no signed zero)
- USE lbclnk ! lateral boundary conditions (or mpp links)
IMPLICIT NONE
PRIVATE
@@ -105,7 +104,7 @@ CONTAINS
IF( ln_icediachk ) CALL ice_cons_hsm( 0, 'icethd_do', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft )
IF( ln_icediachk ) CALL ice_cons2D ( 0, 'icethd_do', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft )
- at_i(:,:) = SUM( a_i, dim=3 )
+ at_i(A2D(0)) = SUM( a_i(A2D(0),:), dim=3 )
!------------------------------------------------------------------------------!
! 1) Compute thickness, salinity, enthalpy, age, area and volume of new ice
!------------------------------------------------------------------------------!
@@ -113,7 +112,7 @@ CONTAINS
! Identify grid points where new ice forms
npti = 0 ; nptidx(:) = 0
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
IF ( qlead(ji,jj) < 0._wp ) THEN
npti = npti + 1
nptidx( npti ) = (jj - 1) * jpi + ji
@@ -325,6 +324,8 @@ CONTAINS
!
ENDIF ! npti > 0
!
+ ! the following fields need to be updated on the halos (done in icethd): a_i, v_i, sv_i, e_i
+ !
IF( ln_icediachk ) CALL ice_cons_hsm(1, 'icethd_do', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft)
IF( ln_icediachk ) CALL ice_cons2D (1, 'icethd_do', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft)
!
@@ -372,8 +373,8 @@ CONTAINS
DO_2D( 0, 0, 0, 0 )
IF ( qlead(ji,jj) < 0._wp ) THEN ! cooling
! -- Wind stress -- !
- ztaux = utau_ice(ji,jj) * tmask(ji,jj,1)
- ztauy = vtau_ice(ji,jj) * tmask(ji,jj,1)
+ ztaux = utau_ice(ji,jj) * smask0(ji,jj)
+ ztauy = vtau_ice(ji,jj) * smask0(ji,jj)
! Square root of wind stress
ztenagm = SQRT( SQRT( ztaux * ztaux + ztauy * ztauy ) )
@@ -415,8 +416,6 @@ CONTAINS
!
END_2D
!
- CALL lbc_lnk( 'icethd_frazil', fraz_frac, 'T', 1.0_wp, ht_i_new, 'T', 1.0_wp )
-
ENDIF
END SUBROUTINE ice_thd_frazil
diff --git a/src/ICE/icethd_pnd.F90 b/src/ICE/icethd_pnd.F90
index f0949d8f0a60d34ca08079f06367b099b10f079b..8f5b63df6fafe2d57bee60219d80aa32321082f9 100644
--- a/src/ICE/icethd_pnd.F90
+++ b/src/ICE/icethd_pnd.F90
@@ -84,7 +84,7 @@ CONTAINS
INTEGER :: ji, jj, jl ! loop indices
!!-------------------------------------------------------------------
- ALLOCATE( diag_dvpn_mlt(jpi,jpj), diag_dvpn_lid(jpi,jpj), diag_dvpn_drn(jpi,jpj), diag_dvpn_rnf(jpi,jpj) )
+ ALLOCATE( diag_dvpn_mlt(A2D(0)) , diag_dvpn_lid(A2D(0)) , diag_dvpn_drn(A2D(0)) , diag_dvpn_rnf(A2D(0)) )
ALLOCATE( diag_dvpn_mlt_1d(jpij), diag_dvpn_lid_1d(jpij), diag_dvpn_drn_1d(jpij), diag_dvpn_rnf_1d(jpij) )
!
diag_dvpn_mlt (:,:) = 0._wp ; diag_dvpn_drn (:,:) = 0._wp
@@ -98,7 +98,7 @@ CONTAINS
at_i(:,:) = SUM( a_i, dim=3 )
!
DO jl = 1, jpl
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
IF( v_i(ji,jj,jl) < epsi10 .OR. at_i(ji,jj) < epsi10 ) THEN
wfx_pnd (ji,jj) = wfx_pnd(ji,jj) + ( v_ip(ji,jj,jl) + v_il(ji,jj,jl) ) * rhow * r1_Dt_ice
a_ip (ji,jj,jl) = 0._wp
@@ -115,7 +115,7 @@ CONTAINS
! Identify grid cells with ice
!------------------------------
npti = 0 ; nptidx(:) = 0
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
IF( at_i(ji,jj) >= epsi10 ) THEN
npti = npti + 1
nptidx( npti ) = (jj - 1) * jpi + ji
@@ -137,6 +137,8 @@ CONTAINS
END SELECT
ENDIF
+ ! the following fields need to be updated in the halos (done in icethd): a_ip, v_ip, v_il, h_ip, h_il
+
!------------------------------------
! Diagnostics
!------------------------------------
@@ -529,7 +531,7 @@ CONTAINS
zv_pnd , & ! volume of meltwater contributing to ponds
zv_mlt ! total amount of meltwater produced
- REAL(wp), DIMENSION(jpi,jpj) :: zvolp_ini , & !! total melt pond water available before redistribution and drainage
+ REAL(wp), DIMENSION(A2D(0)) :: zvolp_ini , & !! total melt pond water available before redistribution and drainage
zvolp , & !! total melt pond water volume
zvolp_res !! remaining melt pond water available after drainage
@@ -589,7 +591,7 @@ CONTAINS
zvolp(:,:) = 0._wp
DO jl = 1, jpl
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
IF ( a_i(ji,jj,jl) > epsi10 ) THEN
@@ -637,7 +639,7 @@ CONTAINS
IF( ln_pnd_lids ) THEN
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
IF ( at_i(ji,jj) > 0.01 .AND. hm_i(ji,jj) > rn_himin .AND. zvolp_ini(ji,jj) > zvp_min * at_i(ji,jj) ) THEN
@@ -764,7 +766,7 @@ CONTAINS
DO jl = 1, jpl
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
! ! zap lids on small ponds
! IF ( a_i(ji,jj,jl) > epsi10 .AND. v_ip(ji,jj,jl) < epsi10 &
@@ -826,7 +828,7 @@ CONTAINS
!!
!!------------------------------------------------------------------
- REAL (wp), DIMENSION(jpi,jpj), INTENT(INOUT) :: &
+ REAL (wp), DIMENSION(A2D(0)), INTENT(INOUT) :: &
zvolp, & ! total available pond water
zdvolp ! remaining meltwater after redistribution
@@ -865,10 +867,10 @@ CONTAINS
INTEGER :: ji, jj, jk, jl ! loop indices
- a_ip(:,:,:) = 0._wp
- h_ip(:,:,:) = 0._wp
+ a_ip(A2D(0),:) = 0._wp
+ h_ip(A2D(0),:) = 0._wp
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
IF ( at_i(ji,jj) > 0.01 .AND. hm_i(ji,jj) > rn_himin .AND. zvolp(ji,jj) > zvp_min * at_i(ji,jj) ) THEN
diff --git a/src/ICE/iceupdate.F90 b/src/ICE/iceupdate.F90
index f6d047adf7c6abfbef6897311e8161cce3caa5f5..aac48c07cdb3eab6d8f77af8674db3215083f107 100644
--- a/src/ICE/iceupdate.F90
+++ b/src/ICE/iceupdate.F90
@@ -55,7 +55,7 @@ CONTAINS
!!-------------------------------------------------------------------
!! *** ROUTINE ice_update_alloc ***
!!-------------------------------------------------------------------
- ALLOCATE( utau_oce(jpi,jpj), vtau_oce(jpi,jpj), tmod_io(jpi,jpj), STAT=ice_update_alloc )
+ ALLOCATE( utau_oce(A2D(0)), vtau_oce(A2D(0)), tmod_io(A2D(1)), STAT=ice_update_alloc )
!
CALL mpp_sum( 'iceupdate', ice_update_alloc )
IF( ice_update_alloc /= 0 ) CALL ctl_stop( 'STOP', 'ice_update_alloc: failed to allocate arrays' )
@@ -104,22 +104,29 @@ CONTAINS
! Net heat flux on top of the ice-ocean (W.m-2)
!----------------------------------------------
IF( ln_cndflx ) THEN ! ice-atm interface = conduction (and melting) fluxes
- qt_atm_oi(:,:) = ( 1._wp - at_i_b(:,:) ) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:) + &
- & SUM( a_i_b * ( qcn_ice + qml_ice + qtr_ice_top ), dim=3 ) + qemp_ice(:,:)
+ DO_2D( 0, 0, 0, 0 )
+ qt_atm_oi(ji,jj) = ( 1._wp - at_i_b(ji,jj) ) * ( qns_oce(ji,jj) + qsr_oce(ji,jj) ) + qemp_oce(ji,jj) &
+ & + SUM( a_i_b(ji,jj,:) * ( qcn_ice(ji,jj,:) + qml_ice(ji,jj,:) + qtr_ice_top(ji,jj,:) ) ) &
+ & + qemp_ice(ji,jj)
+ END_2D
ELSE ! ice-atm interface = solar and non-solar fluxes
- qt_atm_oi(:,:) = qns_tot(:,:) + qsr_tot(:,:)
+ DO_2D( 0, 0, 0, 0 )
+ qt_atm_oi(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj)
+ END_2D
ENDIF
! --- case we bypass ice thermodynamics --- !
IF( .NOT. ln_icethd ) THEN ! we suppose ice is impermeable => ocean is isolated from atmosphere
- qt_atm_oi (:,:) = ( 1._wp - at_i_b(:,:) ) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:)
- qt_oce_ai (:,:) = ( 1._wp - at_i_b(:,:) ) * qns_oce(:,:) + qemp_oce(:,:)
- emp_ice (:,:) = 0._wp
- qemp_ice (:,:) = 0._wp
- qevap_ice (:,:,:) = 0._wp
+ DO_2D( 0, 0, 0, 0 )
+ qt_atm_oi (ji,jj) = ( 1._wp - at_i_b(ji,jj) ) * ( qns_oce(ji,jj) + qsr_oce(ji,jj) ) + qemp_oce(ji,jj)
+ qt_oce_ai (ji,jj) = ( 1._wp - at_i_b(ji,jj) ) * qns_oce(ji,jj) + qemp_oce(ji,jj)
+ emp_ice (ji,jj) = 0._wp
+ qemp_ice (ji,jj) = 0._wp
+ qevap_ice (ji,jj,:) = 0._wp
+ END_2D
ENDIF
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
! Solar heat flux reaching the ocean (max) = zqsr (W.m-2)
!---------------------------------------------------
@@ -183,20 +190,22 @@ CONTAINS
snwice_mass_b(ji,jj) = snwice_mass(ji,jj) ! save mass from the previous ice time step
! ! new mass per unit area
snwice_mass (ji,jj) = tmask(ji,jj,1) * ( rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj) + rhow * (vt_ip(ji,jj) + vt_il(ji,jj)) )
- ! ! time evolution of snow+ice mass
- snwice_fmass (ji,jj) = ( snwice_mass(ji,jj) - snwice_mass_b(ji,jj) ) * r1_Dt_ice
END_2D
+ CALL lbc_lnk( 'iceupdate', snwice_mass, 'T', 1.0_wp, snwice_mass_b, 'T', 1.0_wp ) ! needed for sshwzv and dynspg_ts (lbc on emp is done in sbcmod)
+
+ ! time evolution of snow+ice mass
+ snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) * r1_Dt_ice
! Storing the transmitted variables
!----------------------------------
fr_i (:,:) = at_i(:,:) ! Sea-ice fraction
- tn_ice(:,:,:) = t_su(:,:,:) ! Ice surface temperature
+ tn_ice(:,:,:) = t_su(A2D(0),:) ! Ice surface temperature
! Snow/ice albedo (only if sent to coupler, useless in forced mode)
!------------------------------------------------------------------
- CALL ice_alb( t_su, h_i, h_s, ln_pnd_alb, a_ip_eff, h_ip, cloud_fra, alb_ice ) ! ice albedo
-
+ CALL ice_alb( ln_pnd_alb, t_su(A2D(0),:), h_i(A2D(0),:), h_s(A2D(0),:), a_ip_eff(:,:,:), h_ip(A2D(0),:), cloud_fra(:,:), & ! <<== in
+ & alb_ice(:,:,:) ) ! ==>> out
!
IF( lrst_ice ) THEN !* write snwice_mass fields in the restart file
CALL update_rst( 'WRITE', kt )
@@ -216,8 +225,8 @@ CONTAINS
IF( iom_use('sfxopw' ) ) CALL iom_put( 'sfxopw', sfx_opw * 1.e-03 ) ! salt flux from open water formation
IF( iom_use('sfxdyn' ) ) CALL iom_put( 'sfxdyn', sfx_dyn * 1.e-03 ) ! salt flux from ridging rafting
IF( iom_use('sfxbri' ) ) CALL iom_put( 'sfxbri', sfx_bri * 1.e-03 ) ! salt flux from brines
- IF( iom_use('sfxres' ) ) CALL iom_put( 'sfxres', sfx_res * 1.e-03 ) ! salt flux from undiagnosed processes
IF( iom_use('sfxsub' ) ) CALL iom_put( 'sfxsub', sfx_sub * 1.e-03 ) ! salt flux from sublimation
+ IF( iom_use('sfxres' ) ) CALL iom_put( 'sfxres', sfx_res(A2D(0)) * 1.e-03 ) ! salt flux from undiagnosed processes
! --- mass fluxes [kg/m2/s] --- !
CALL iom_put( 'emp_oce', emp_oce ) ! emp over ocean (taking into account the snow blown away from the ice)
@@ -232,13 +241,13 @@ CONTAINS
CALL iom_put( 'vfxsni' , wfx_sni ) ! mass flux from snow-ice formation
CALL iom_put( 'vfxopw' , wfx_opw ) ! mass flux from growth in open water
CALL iom_put( 'vfxdyn' , wfx_dyn ) ! mass flux from dynamics (ridging)
- CALL iom_put( 'vfxres' , wfx_res ) ! mass flux from undiagnosed processes
CALL iom_put( 'vfxpnd' , wfx_pnd ) ! mass flux from melt ponds
CALL iom_put( 'vfxsub' , wfx_ice_sub ) ! mass flux from ice sublimation (ice-atm.)
CALL iom_put( 'vfxsub_err', wfx_err_sub ) ! "excess" of sublimation sent to ocean
+ CALL iom_put( 'vfxres' , wfx_res(A2D(0)) ) ! mass flux from undiagnosed processes
IF ( iom_use( 'vfxthin' ) ) THEN ! mass flux from ice growth in open water + thin ice (<20cm) => comparable to observations
- ALLOCATE( z2d(jpi,jpj) )
+ ALLOCATE( z2d(A2D(0)) )
WHERE( hm_i(:,:) < 0.2 .AND. hm_i(:,:) > 0. ) ; z2d = wfx_bog
ELSEWHERE ; z2d = 0._wp
END WHERE
@@ -264,8 +273,8 @@ CONTAINS
IF( iom_use('qtr_ice_top') ) CALL iom_put( 'qtr_ice_top', SUM( qtr_ice_top * a_i_b, dim=3 ) ) ! solar flux transmitted thru ice surface
IF( iom_use('qt_oce' ) ) CALL iom_put( 'qt_oce' , ( qsr_oce + qns_oce ) * ( 1._wp - at_i_b ) + qemp_oce )
IF( iom_use('qt_ice' ) ) CALL iom_put( 'qt_ice' , SUM( ( qns_ice + qsr_ice ) * a_i_b, dim=3 ) + qemp_ice )
- IF( iom_use('qt_oce_ai' ) ) CALL iom_put( 'qt_oce_ai' , qt_oce_ai * tmask(:,:,1) ) ! total heat flux at the ocean surface: interface oce-(ice+atm)
- IF( iom_use('qt_atm_oi' ) ) CALL iom_put( 'qt_atm_oi' , qt_atm_oi * tmask(:,:,1) ) ! total heat flux at the oce-ice surface: interface atm-(ice+oce)
+ IF( iom_use('qt_oce_ai' ) ) CALL iom_put( 'qt_oce_ai' , qt_oce_ai * smask0 ) ! total heat flux at the ocean surface: interface oce-(ice+atm)
+ IF( iom_use('qt_atm_oi' ) ) CALL iom_put( 'qt_atm_oi' , qt_atm_oi * smask0 ) ! total heat flux at the oce-ice surface: interface atm-(ice+oce)
IF( iom_use('qemp_oce' ) ) CALL iom_put( 'qemp_oce' , qemp_oce ) ! Downward Heat Flux from E-P over ocean
IF( iom_use('qemp_ice' ) ) CALL iom_put( 'qemp_ice' , qemp_ice ) ! Downward Heat Flux from E-P over ice
@@ -282,9 +291,9 @@ CONTAINS
! heat fluxes associated with mass exchange (freeze/melt/precip...)
CALL iom_put ('hfxthd' , hfx_thd ) !
CALL iom_put ('hfxdyn' , hfx_dyn ) !
- CALL iom_put ('hfxres' , hfx_res ) !
CALL iom_put ('hfxsub' , hfx_sub ) !
CALL iom_put ('hfxspr' , hfx_spr ) ! Heat flux from snow precip heat content
+ CALL iom_put ('hfxres' , hfx_res(A2D(0)) ) !
! other heat fluxes
IF( iom_use('hfxsensib' ) ) CALL iom_put( 'hfxsensib' , qsb_ice_bot * at_i_b ) ! Sensible oceanic heat flux
@@ -350,27 +359,38 @@ CONTAINS
zrhoco = rho0 * rn_cio
!
IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN !== Ice time-step only ==! (i.e. surface module time-step)
- DO_2D( 0, 0, 0, 0 ) !* update the modulus of stress at ocean surface (T-point)
+ DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) !* rhoco * |U_ice-U_oce| at T-point
+ ! ! 2*(U_ice-U_oce) at T-point
+ zu_t = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj) ! u_oce = ssu_m
+ zv_t = v_ice(ji,jj) + v_ice(ji,jj-1) - v_oce(ji,jj) - v_oce(ji,jj-1) ! v_oce = ssv_m
+ ! ! |U_ice-U_oce|^2
+ zmodt = 0.25_wp * ( zu_t * zu_t + zv_t * zv_t )
+ !
+ tmod_io(ji,jj) = zrhoco * SQRT( zmodt )
+ END_2D
+ IF( nn_hls == 1 ) CALL lbc_lnk( 'iceupdate', tmod_io, 'T', 1._wp )
+ !
+ DO_2D( 0, 0, 0, 0 ) !* save the air-ocean stresses at ice time-step
! ! 2*(U_ice-U_oce) at T-point
zu_t = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj) ! u_oce = ssu_m
zv_t = v_ice(ji,jj) + v_ice(ji,jj-1) - v_oce(ji,jj) - v_oce(ji,jj-1) ! v_oce = ssv_m
- ! ! |U_ice-U_oce|^2
+ ! ! |U_ice-U_oce|^2
zmodt = 0.25_wp * ( zu_t * zu_t + zv_t * zv_t )
! ! update the ocean stress modulus
taum(ji,jj) = ( 1._wp - at_i(ji,jj) ) * taum(ji,jj) + at_i(ji,jj) * zrhoco * zmodt
- tmod_io(ji,jj) = zrhoco * SQRT( zmodt ) ! rhoco * |U_ice-U_oce| at T-point
+ !
+ utau_oce(ji,jj) = utau(ji,jj)
+ vtau_oce(ji,jj) = vtau(ji,jj)
END_2D
- CALL lbc_lnk( 'iceupdate', taum, 'T', 1.0_wp, tmod_io, 'T', 1.0_wp )
- !
- utau_oce(:,:) = utau(:,:) !* save the air-ocean stresses at ice time-step
- vtau_oce(:,:) = vtau(:,:)
!
ENDIF
!
! !== every ocean time-step ==!
IF ( ln_drgice_imp ) THEN
! Save drag with right sign to update top drag in the ocean implicit friction
- rCdU_ice(:,:) = -r1_rho0 * tmod_io(:,:) * at_i(:,:) * tmask(:,:,1)
+ DO_2D( 1, 1, 1, 1 )
+ rCdU_ice(ji,jj) = -r1_rho0 * tmod_io(ji,jj) * at_i(ji,jj) * tmask(ji,jj,1)
+ END_2D
zflagi = 0._wp
ELSE
zflagi = 1._wp
@@ -384,7 +404,6 @@ CONTAINS
utau(ji,jj) = ( 1._wp - at_i(ji,jj) ) * utau_oce(ji,jj) + at_i(ji,jj) * zutau_ice
vtau(ji,jj) = ( 1._wp - at_i(ji,jj) ) * vtau_oce(ji,jj) + at_i(ji,jj) * zvtau_ice
END_2D
- CALL lbc_lnk( 'iceupdate', utau, 'T', -1.0_wp, vtau, 'T', -1.0_wp ) ! lateral boundary condition
!
IF( ln_timing ) CALL timing_stop('iceupdate')
!
@@ -441,12 +460,12 @@ CONTAINS
CALL iom_get( numrir, jpdom_auto, 'snwice_mass_b', snwice_mass_b )
ELSE ! start from rest
IF(lwp) WRITE(numout,*) ' ==>> previous run without snow-ice mass output then set it'
- snwice_mass (:,:) = tmask(:,:,1) * ( rhos * vt_s(:,:) + rhoi * vt_i(:,:) )
+ snwice_mass (:,:) = tmask(:,:,1) * ( rhos * vt_s(:,:) + rhoi * vt_i(:,:) + rhow * (vt_ip(:,:) + vt_il(:,:)) )
snwice_mass_b(:,:) = snwice_mass(:,:)
ENDIF
ELSE !* Start from rest
IF(lwp) WRITE(numout,*) ' ==>> start from rest: set the snow-ice mass'
- snwice_mass (:,:) = tmask(:,:,1) * ( rhos * vt_s(:,:) + rhoi * vt_i(:,:) )
+ snwice_mass (:,:) = tmask(:,:,1) * ( rhos * vt_s(:,:) + rhoi * vt_i(:,:) + rhow * (vt_ip(:,:) + vt_il(:,:)) )
snwice_mass_b(:,:) = snwice_mass(:,:)
ENDIF
!
diff --git a/src/ICE/icevar.F90 b/src/ICE/icevar.F90
index 535c5eb62a320b1c987727d2aacd4882abba6591..a51496309c363aae3446b253f5ff6c7d6ab08af8 100644
--- a/src/ICE/icevar.F90
+++ b/src/ICE/icevar.F90
@@ -117,70 +117,88 @@ CONTAINS
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z1_at_i, z1_vt_i, z1_vt_s
!!-------------------------------------------------------------------
!
- ! ! integrated values
- vt_i(:,:) = SUM( v_i (:,:,:) , dim=3 )
- vt_s(:,:) = SUM( v_s (:,:,:) , dim=3 )
- st_i(:,:) = SUM( sv_i(:,:,:) , dim=3 )
- at_i(:,:) = SUM( a_i (:,:,:) , dim=3 )
- et_s(:,:) = SUM( SUM( e_s (:,:,:,:), dim=4 ), dim=3 )
- et_i(:,:) = SUM( SUM( e_i (:,:,:,:), dim=4 ), dim=3 )
+ ! full arrays: vt_i, vt_s, at_i, vt_ip, vt_il, at_ip
+ ! reduced arrays: the rest
!
- at_ip(:,:) = SUM( a_ip(:,:,:), dim=3 ) ! melt ponds
- vt_ip(:,:) = SUM( v_ip(:,:,:), dim=3 )
- vt_il(:,:) = SUM( v_il(:,:,:), dim=3 )
+ ! ! integrated values
+ DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ vt_i(ji,jj) = SUM( v_i (ji,jj,:) )
+ vt_s(ji,jj) = SUM( v_s (ji,jj,:) )
+ at_i(ji,jj) = SUM( a_i (ji,jj,:) )
+ !
+ at_ip(ji,jj) = SUM( a_ip(ji,jj,:) ) ! melt ponds
+ vt_ip(ji,jj) = SUM( v_ip(ji,jj,:) )
+ vt_il(ji,jj) = SUM( v_il(ji,jj,:) )
+ END_2D
+ DO_2D( 0, 0, 0, 0 )
+ st_i(ji,jj) = SUM( sv_i(ji,jj,:) )
+ et_s(ji,jj) = SUM( SUM( e_s (ji,jj,:,:), dim=2 ) )
+ et_i(ji,jj) = SUM( SUM( e_i (ji,jj,:,:), dim=2 ) )
+ END_2D
!
ato_i(:,:) = 1._wp - at_i(:,:) ! open water fraction
!
!!GS: tm_su always needed by ABL over sea-ice
- ALLOCATE( z1_at_i(jpi,jpj) )
- WHERE( at_i(:,:) > epsi20 ) ; z1_at_i(:,:) = 1._wp / at_i(:,:)
- ELSEWHERE ; z1_at_i(:,:) = 0._wp
+ ALLOCATE( z1_at_i(A2D(0)) )
+ WHERE( at_i(A2D(0)) > epsi20 ) ; z1_at_i(:,:) = 1._wp / at_i(A2D(0))
+ ELSEWHERE ; z1_at_i(:,:) = 0._wp
END WHERE
- tm_su(:,:) = SUM( t_su(:,:,:) * a_i(:,:,:) , dim=3 ) * z1_at_i(:,:)
- WHERE( at_i(:,:)<=epsi20 ) tm_su(:,:) = rt0
+ DO_2D( 0, 0, 0, 0 )
+ IF( at_i(ji,jj)<=epsi20 ) THEN
+ tm_su(ji,jj) = rt0
+ ELSE
+ tm_su(ji,jj) = SUM( t_su(ji,jj,:) * a_i(ji,jj,:) ) * z1_at_i(ji,jj)
+ ENDIF
+ END_2D
!
! The following fields are calculated for diagnostics and outputs only
! ==> Do not use them for other purposes
IF( kn > 1 ) THEN
!
- ALLOCATE( z1_vt_i(jpi,jpj) , z1_vt_s(jpi,jpj) )
- WHERE( vt_i(:,:) > epsi20 ) ; z1_vt_i(:,:) = 1._wp / vt_i(:,:)
- ELSEWHERE ; z1_vt_i(:,:) = 0._wp
+ ALLOCATE( z1_vt_i(A2D(0)) , z1_vt_s(A2D(0)) )
+ WHERE( vt_i(A2D(0)) > epsi20 ) ; z1_vt_i(:,:) = 1._wp / vt_i(A2D(0))
+ ELSEWHERE ; z1_vt_i(:,:) = 0._wp
END WHERE
- WHERE( vt_s(:,:) > epsi20 ) ; z1_vt_s(:,:) = 1._wp / vt_s(:,:)
- ELSEWHERE ; z1_vt_s(:,:) = 0._wp
+ WHERE( vt_s(A2D(0)) > epsi20 ) ; z1_vt_s(:,:) = 1._wp / vt_s(A2D(0))
+ ELSEWHERE ; z1_vt_s(:,:) = 0._wp
END WHERE
!
! ! mean ice/snow thickness
- hm_i(:,:) = vt_i(:,:) * z1_at_i(:,:)
- hm_s(:,:) = vt_s(:,:) * z1_at_i(:,:)
- !
- ! ! mean temperature (K), salinity and age
- tm_si(:,:) = SUM( t_si(:,:,:) * a_i(:,:,:) , dim=3 ) * z1_at_i(:,:)
- om_i (:,:) = SUM( oa_i(:,:,:) , dim=3 ) * z1_at_i(:,:)
- sm_i (:,:) = st_i(:,:) * z1_vt_i(:,:)
- !
- tm_i(:,:) = 0._wp
- tm_s(:,:) = 0._wp
- DO jl = 1, jpl
- DO jk = 1, nlay_i
- tm_i(:,:) = tm_i(:,:) + r1_nlay_i * t_i (:,:,jk,jl) * v_i(:,:,jl) * z1_vt_i(:,:)
- END DO
- DO jk = 1, nlay_s
- tm_s(:,:) = tm_s(:,:) + r1_nlay_s * t_s (:,:,jk,jl) * v_s(:,:,jl) * z1_vt_s(:,:)
+ DO_2D( 0, 0, 0, 0 )
+ hm_i(ji,jj) = vt_i(ji,jj) * z1_at_i(ji,jj)
+ hm_s(ji,jj) = vt_s(ji,jj) * z1_at_i(ji,jj)
+ !
+ ! ! mean temperature (K), salinity and age
+ tm_si(ji,jj) = SUM( t_si(ji,jj,:) * a_i(ji,jj,:) ) * z1_at_i(ji,jj)
+ om_i (ji,jj) = SUM( oa_i(ji,jj,:) ) * z1_at_i(ji,jj)
+ sm_i (ji,jj) = st_i(ji,jj) * z1_vt_i(ji,jj)
+ !
+ tm_i(ji,jj) = 0._wp
+ tm_s(ji,jj) = 0._wp
+ DO jl = 1, jpl
+ DO jk = 1, nlay_i
+ tm_i(ji,jj) = tm_i(ji,jj) + r1_nlay_i * t_i (ji,jj,jk,jl) * v_i(ji,jj,jl) * z1_vt_i(ji,jj)
+ END DO
+ DO jk = 1, nlay_s
+ tm_s(ji,jj) = tm_s(ji,jj) + r1_nlay_s * t_s (ji,jj,jk,jl) * v_s(ji,jj,jl) * z1_vt_s(ji,jj)
+ END DO
END DO
- END DO
- !
+ !
+ END_2D
! ! put rt0 where there is no ice
- WHERE( at_i(:,:)<=epsi20 )
+ WHERE( at_i(A2D(0)) <= epsi20 )
tm_si(:,:) = rt0
tm_i (:,:) = rt0
tm_s (:,:) = rt0
END WHERE
!
! ! mean melt pond depth
- WHERE( at_ip(:,:) > epsi20 ) ; hm_ip(:,:) = vt_ip(:,:) / at_ip(:,:) ; hm_il(:,:) = vt_il(:,:) / at_ip(:,:)
- ELSEWHERE ; hm_ip(:,:) = 0._wp ; hm_il(:,:) = 0._wp
+ WHERE( at_ip(A2D(0)) > epsi20 )
+ hm_ip(:,:) = vt_ip(A2D(0)) / at_ip(A2D(0))
+ hm_il(:,:) = vt_il(A2D(0)) / at_ip(A2D(0))
+ ELSEWHERE
+ hm_ip(:,:) = 0._wp
+ hm_il(:,:) = 0._wp
END WHERE
!
DEALLOCATE( z1_vt_i , z1_vt_s )
@@ -206,7 +224,8 @@ CONTAINS
REAL(wp) :: zlay_i, zlay_s ! - -
REAL(wp), PARAMETER :: zhl_max = 0.015_wp ! pond lid thickness above which the ponds disappear from the albedo calculation
REAL(wp), PARAMETER :: zhl_min = 0.005_wp ! pond lid thickness below which the full pond area is used in the albedo calculation
- REAL(wp), DIMENSION(jpi,jpj,jpl) :: z1_a_i, z1_v_i, z1_a_ip, za_s_fra
+ REAL(wp), DIMENSION(jpi,jpj,jpl) :: z1_a_i, z1_v_i, z1_a_ip
+ REAL(wp), DIMENSION(A2D(0),jpl) :: za_s_fra
!!-------------------------------------------------------------------
!!gm Question 2: It is possible to define existence of sea-ice in a common way between
@@ -247,15 +266,15 @@ CONTAINS
h_ip(:,:,:) = v_ip(:,:,:) * z1_a_ip(:,:,:)
h_il(:,:,:) = v_il(:,:,:) * z1_a_ip(:,:,:)
! !--- melt pond effective area (used for albedo)
- a_ip_frac(:,:,:) = a_ip(:,:,:) * z1_a_i(:,:,:)
- WHERE ( h_il(:,:,:) <= zhl_min ) ; a_ip_eff(:,:,:) = a_ip_frac(:,:,:) ! lid is very thin. Expose all the pond
- ELSEWHERE( h_il(:,:,:) >= zhl_max ) ; a_ip_eff(:,:,:) = 0._wp ! lid is very thick. Cover all the pond up with ice and snow
- ELSEWHERE ; a_ip_eff(:,:,:) = a_ip_frac(:,:,:) * & ! lid is in between. Expose part of the pond
- & ( zhl_max - h_il(:,:,:) ) / ( zhl_max - zhl_min )
+ a_ip_frac(:,:,:) = a_ip(A2D(0),:) * z1_a_i(A2D(0),:)
+ WHERE ( h_il(A2D(0),:) <= zhl_min ) ; a_ip_eff(:,:,:) = a_ip_frac(:,:,:) ! lid is very thin. Expose all the pond
+ ELSEWHERE( h_il(A2D(0),:) >= zhl_max ) ; a_ip_eff(:,:,:) = 0._wp ! lid is very thick. Cover all the pond up with ice and snow
+ ELSEWHERE ; a_ip_eff(:,:,:) = a_ip_frac(:,:,:) * & ! lid is in between. Expose part of the pond
+ & ( zhl_max - h_il(A2D(0),:) ) / ( zhl_max - zhl_min )
END WHERE
!
- CALL ice_var_snwfra( h_s, za_s_fra ) ! calculate ice fraction covered by snow
- a_ip_eff = MIN( a_ip_eff, 1._wp - za_s_fra ) ! make sure (a_ip_eff + a_s_fra) <= 1
+ CALL ice_var_snwfra( h_s(A2D(0),:), za_s_fra(:,:,:) ) ! calculate ice fraction covered by snow
+ a_ip_eff(:,:,:) = MIN( a_ip_eff(:,:,:), 1._wp - za_s_fra(:,:,:) ) ! make sure (a_ip_eff + a_s_fra) <= 1
!
! !--- salinity (with a minimum value imposed everywhere)
IF( nn_icesal == 2 ) THEN
@@ -300,9 +319,9 @@ CONTAINS
END DO
!
! integrated values
- vt_i (:,:) = SUM( v_i , dim=3 )
- vt_s (:,:) = SUM( v_s , dim=3 )
- at_i (:,:) = SUM( a_i , dim=3 )
+ vt_i (:,:) = SUM( v_i, dim=3 )
+ vt_s (:,:) = SUM( v_s, dim=3 )
+ at_i (:,:) = SUM( a_i, dim=3 )
!
END SUBROUTINE ice_var_glo2eqv
@@ -538,7 +557,7 @@ CONTAINS
sfx_res(ji,jj) = sfx_res(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * sv_i(ji,jj,jl) * rhoi * r1_Dt_ice
wfx_res(ji,jj) = wfx_res(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * v_i (ji,jj,jl) * rhoi * r1_Dt_ice
wfx_res(ji,jj) = wfx_res(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * v_s (ji,jj,jl) * rhos * r1_Dt_ice
- wfx_pnd(ji,jj) = wfx_pnd(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * ( v_ip(ji,jj,jl)+v_il(ji,jj,jl) ) * rhow * r1_Dt_ice
+ wfx_res(ji,jj) = wfx_res(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * ( v_ip(ji,jj,jl)+v_il(ji,jj,jl) ) * rhow * r1_Dt_ice
!
a_i (ji,jj,jl) = a_i (ji,jj,jl) * zswitch(ji,jj)
v_i (ji,jj,jl) = v_i (ji,jj,jl) * zswitch(ji,jj)
@@ -640,11 +659,11 @@ CONTAINS
psv_i (ji,jj,jl) = 0._wp
ENDIF
IF( pv_ip(ji,jj,jl) < 0._wp .OR. pv_il(ji,jj,jl) < 0._wp .OR. pa_ip(ji,jj,jl) <= 0._wp ) THEN
- wfx_pnd(ji,jj) = wfx_pnd(ji,jj) + pv_il(ji,jj,jl) * rhow * z1_dt
+ wfx_res(ji,jj) = wfx_res(ji,jj) + pv_il(ji,jj,jl) * rhow * z1_dt
pv_il (ji,jj,jl) = 0._wp
ENDIF
IF( pv_ip(ji,jj,jl) < 0._wp .OR. pa_ip(ji,jj,jl) <= 0._wp ) THEN
- wfx_pnd(ji,jj) = wfx_pnd(ji,jj) + pv_ip(ji,jj,jl) * rhow * z1_dt
+ wfx_res(ji,jj) = wfx_res(ji,jj) + pv_ip(ji,jj,jl) * rhow * z1_dt
pv_ip (ji,jj,jl) = 0._wp
ENDIF
END_2D
@@ -713,15 +732,19 @@ CONTAINS
!! instead of setting everything to zero as just below
bv_i (:,:,:) = 0._wp
DO jl = 1, jpl
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_i )
+ DO_3D( 0, 0, 0, 0, 1, nlay_i )
IF( t_i(ji,jj,jk,jl) < rt0 - epsi10 ) THEN
bv_i(ji,jj,jl) = bv_i(ji,jj,jl) - rTmlt * sz_i(ji,jj,jk,jl) * r1_nlay_i / ( t_i(ji,jj,jk,jl) - rt0 )
ENDIF
END_3D
END DO
- WHERE( vt_i(:,:) > epsi20 ) ; bvm_i(:,:) = SUM( bv_i(:,:,:) * v_i(:,:,:) , dim=3 ) / vt_i(:,:)
- ELSEWHERE ; bvm_i(:,:) = 0._wp
- END WHERE
+ DO_2D( 0, 0, 0, 0 )
+ IF( vt_i(ji,jj) > epsi20 ) THEN
+ bvm_i(ji,jj) = SUM( bv_i(ji,jj,:) * v_i(ji,jj,:) ) / vt_i(ji,jj)
+ ELSE
+ bvm_i(ji,jj) = 0._wp
+ ENDIF
+ END_2D
!
END SUBROUTINE ice_var_bv
@@ -1286,8 +1309,8 @@ CONTAINS
!!
!!-------------------------------------------------------------------
SUBROUTINE ice_var_snwfra_3d( ph_s, pa_s_fra )
- REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: ph_s ! snow thickness
- REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pa_s_fra ! ice fraction covered by snow
+ REAL(wp), DIMENSION(A2D(0),jpl), INTENT(in ) :: ph_s ! snow thickness
+ REAL(wp), DIMENSION(A2D(0),jpl), INTENT( out) :: pa_s_fra ! ice fraction covered by snow
IF ( nn_snwfra == 0 ) THEN ! basic 0 or 1 snow cover
WHERE( ph_s > 0._wp ) ; pa_s_fra = 1._wp
ELSEWHERE ; pa_s_fra = 0._wp
@@ -1344,8 +1367,8 @@ CONTAINS
!!--------------------------------------------------------------------------
!!gm I think it can be usefull to set this as a FUNCTION, not a SUBROUTINE....
SUBROUTINE ice_var_snwblow_2d( pin, pout )
- REAL(wp), DIMENSION(:,:), INTENT(in ) :: pin ! previous fraction lead ( 1. - a_i_b )
- REAL(wp), DIMENSION(:,:), INTENT(inout) :: pout
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in ) :: pin ! previous fraction lead ( 1. - a_i_b )
+ REAL(wp), DIMENSION(A2D(0)), INTENT(inout) :: pout
pout = ( 1._wp - ( pin )**rn_snwblow )
END SUBROUTINE ice_var_snwblow_2d
diff --git a/src/ICE/icewri.F90 b/src/ICE/icewri.F90
index 078e3b007baf4ff4ea136f0426dccfed9adbf189..6da84cd4ee44987f61851c4b676ee76bba24f62c 100644
--- a/src/ICE/icewri.F90
+++ b/src/ICE/icewri.F90
@@ -26,7 +26,6 @@ MODULE icewri
USE iom ! I/O manager library
USE lib_mpp ! MPP library
USE lib_fortran ! fortran utilities (glob_sum + no signed zero)
- USE lbclnk ! lateral boundary conditions (or mpp links)
USE timing ! Timing
IMPLICIT NONE
@@ -53,10 +52,10 @@ CONTAINS
INTEGER :: ji, jj, jk, jl ! dummy loop indices
REAL(wp) :: z2da, z2db, zrho1, zrho2
REAL(wp) :: zmiss_val ! missing value retrieved from xios
- REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace
- REAL(wp), DIMENSION(jpi,jpj) :: zmsk00, zmsk05, zmsk15, zmsksn ! O%, 5% and 15% concentration mask and snow mask
- REAL(wp), DIMENSION(jpi,jpj,jpl) :: zmsk00l, zmsksnl ! cat masks
- REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zfast, zalb, zmskalb ! 2D workspace
+ REAL(wp), DIMENSION(A2D(0)) :: z2d ! 2D workspace
+ REAL(wp), DIMENSION(A2D(0)) :: zmsk00, zmsk05, zmsk15, zmsksn ! O%, 5% and 15% concentration mask and snow mask
+ REAL(wp), DIMENSION(A2D(0),jpl) :: zmsk00l, zmsksnl ! cat masks
+ REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zfast, zalb, zmskalb ! 2D workspace
!
! Global ice diagnostics (SIMIP)
REAL(wp) :: zdiag_area_nh, zdiag_extt_nh, zdiag_volu_nh ! area, extent, volume
@@ -72,14 +71,14 @@ CONTAINS
CALL ice_var_bv
! tresholds for outputs
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice , 0 if no ice
zmsk05(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.05_wp ) ) ! 1 if 5% ice , 0 if less
zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less
zmsksn(ji,jj) = MAX( 0._wp , SIGN( 1._wp , vt_s(ji,jj) - epsi06 ) ) ! 1 if snow , 0 if no snow
END_2D
DO jl = 1, jpl
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zmsk00l(ji,jj,jl) = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) )
zmsksnl(ji,jj,jl) = MAX( 0._wp , SIGN( 1._wp , v_s(ji,jj,jl) - epsi06 ) )
END_2D
@@ -96,102 +95,111 @@ CONTAINS
CALL iom_put( 'icepres' , zmsk00 ) ! Ice presence (1 or 0)
!
! general fields
- IF( iom_use('icemass' ) ) CALL iom_put( 'icemass', vt_i * rhoi * zmsk00 ) ! Ice mass per cell area
- IF( iom_use('snwmass' ) ) CALL iom_put( 'snwmass', vt_s * rhos * zmsksn ) ! Snow mass per cell area
- IF( iom_use('iceconc' ) ) CALL iom_put( 'iceconc', at_i * zmsk00 ) ! ice concentration
- IF( iom_use('icevolu' ) ) CALL iom_put( 'icevolu', vt_i * zmsk00 ) ! ice volume = mean ice thickness over the cell
- IF( iom_use('icethic' ) ) CALL iom_put( 'icethic', hm_i * zmsk00 ) ! ice thickness
- IF( iom_use('snwthic' ) ) CALL iom_put( 'snwthic', hm_s * zmsk00 ) ! snw thickness
- IF( iom_use('icebrv' ) ) CALL iom_put( 'icebrv' , bvm_i* 100. * zmsk00 ) ! brine volume
- IF( iom_use('iceage' ) ) CALL iom_put( 'iceage' , om_i / rday * zmsk15 + zmiss_val * ( 1._wp - zmsk15 ) ) ! ice age
- IF( iom_use('icehnew' ) ) CALL iom_put( 'icehnew', ht_i_new ) ! new ice thickness formed in the leads
- IF( iom_use('snwvolu' ) ) CALL iom_put( 'snwvolu', vt_s * zmsksn ) ! snow volume
- IF( iom_use('icefrb' ) ) THEN ! Ice freeboard
- z2d(:,:) = ( zrho1 * hm_i(:,:) - zrho2 * hm_s(:,:) )
+ IF( iom_use('icemass' ) ) CALL iom_put( 'icemass', vt_i(A2D(0)) * rhoi * zmsk00 ) ! Ice mass per cell area
+ IF( iom_use('snwmass' ) ) CALL iom_put( 'snwmass', vt_s(A2D(0)) * rhos * zmsksn ) ! Snow mass per cell area
+ IF( iom_use('iceconc' ) ) CALL iom_put( 'iceconc', at_i(A2D(0)) * zmsk00 ) ! ice concentration
+ IF( iom_use('icevolu' ) ) CALL iom_put( 'icevolu', vt_i(A2D(0)) * zmsk00 ) ! ice volume = mean ice thickness over the cell
+ IF( iom_use('icethic' ) ) CALL iom_put( 'icethic', hm_i(:,:) * zmsk00 ) ! ice thickness
+ IF( iom_use('snwthic' ) ) CALL iom_put( 'snwthic', hm_s(:,:) * zmsk00 ) ! snw thickness
+ IF( iom_use('icebrv' ) ) CALL iom_put( 'icebrv' , bvm_i(:,:)* 100. * zmsk00 ) ! brine volume
+ IF( iom_use('iceage' ) ) CALL iom_put( 'iceage' , om_i(:,:) / rday * zmsk15 + zmiss_val * ( 1._wp - zmsk15 ) ) ! ice age
+ IF( iom_use('icehnew' ) ) CALL iom_put( 'icehnew', ht_i_new(:,:) ) ! new ice thickness formed in the leads
+ IF( iom_use('snwvolu' ) ) CALL iom_put( 'snwvolu', vt_s(A2D(0)) * zmsksn ) ! snow volume
+ IF( iom_use('icefrb' ) ) THEN ! Ice freeboard
+ z2d(:,:) = zrho1 * hm_i(:,:) - zrho2 * hm_s(:,:)
WHERE( z2d < 0._wp ) z2d = 0._wp
- CALL iom_put( 'icefrb' , z2d * zmsk00 )
+ CALL iom_put( 'icefrb' , z2d * zmsk00 )
ENDIF
! melt ponds
- IF( iom_use('iceapnd' ) ) CALL iom_put( 'iceapnd', at_ip * zmsk00 ) ! melt pond total fraction
- IF( iom_use('icehpnd' ) ) CALL iom_put( 'icehpnd', hm_ip * zmsk00 ) ! melt pond depth
- IF( iom_use('icevpnd' ) ) CALL iom_put( 'icevpnd', vt_ip * zmsk00 ) ! melt pond total volume per unit area
- IF( iom_use('icehlid' ) ) CALL iom_put( 'icehlid', hm_il * zmsk00 ) ! melt pond lid depth
- IF( iom_use('icevlid' ) ) CALL iom_put( 'icevlid', vt_il * zmsk00 ) ! melt pond lid total volume per unit area
+ IF( iom_use('iceapnd' ) ) CALL iom_put( 'iceapnd', at_ip(A2D(0)) * zmsk00 ) ! melt pond total fraction
+ IF( iom_use('icehpnd' ) ) CALL iom_put( 'icehpnd', hm_ip(:,:) * zmsk00 ) ! melt pond depth
+ IF( iom_use('icevpnd' ) ) CALL iom_put( 'icevpnd', vt_ip(A2D(0)) * zmsk00 ) ! melt pond total volume per unit area
+ IF( iom_use('icehlid' ) ) CALL iom_put( 'icehlid', hm_il(:,:) * zmsk00 ) ! melt pond lid depth
+ IF( iom_use('icevlid' ) ) CALL iom_put( 'icevlid', vt_il(A2D(0)) * zmsk00 ) ! melt pond lid total volume per unit area
! salt
- IF( iom_use('icesalt' ) ) CALL iom_put( 'icesalt', sm_i * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! mean ice salinity
- IF( iom_use('icesalm' ) ) CALL iom_put( 'icesalm', st_i * rhoi * 1.0e-3 * zmsk00 ) ! Mass of salt in sea ice per cell area
+ IF( iom_use('icesalt' ) ) CALL iom_put( 'icesalt', sm_i(:,:) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! mean ice salinity
+ IF( iom_use('icesalm' ) ) CALL iom_put( 'icesalm', st_i(:,:) * rhoi * 1.0e-3 * zmsk00 ) ! Mass of salt in sea ice per cell area
! heat
- IF( iom_use('icetemp' ) ) CALL iom_put( 'icetemp', ( tm_i - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! ice mean temperature
- IF( iom_use('snwtemp' ) ) CALL iom_put( 'snwtemp', ( tm_s - rt0 ) * zmsksn + zmiss_val * ( 1._wp - zmsksn ) ) ! snw mean temperature
- IF( iom_use('icettop' ) ) CALL iom_put( 'icettop', ( tm_su - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! temperature at the ice surface
- IF( iom_use('icetbot' ) ) CALL iom_put( 'icetbot', ( t_bo - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! temperature at the ice bottom
- IF( iom_use('icetsni' ) ) CALL iom_put( 'icetsni', ( tm_si - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! temperature at the snow-ice interface
- IF( iom_use('icehc' ) ) CALL iom_put( 'icehc' , -et_i * zmsk00 ) ! ice heat content
- IF( iom_use('snwhc' ) ) CALL iom_put( 'snwhc' , -et_s * zmsksn ) ! snow heat content
+ IF( iom_use('icetemp' ) ) CALL iom_put( 'icetemp', ( tm_i(:,:) - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! ice mean temperature
+ IF( iom_use('snwtemp' ) ) CALL iom_put( 'snwtemp', ( tm_s(:,:) - rt0 ) * zmsksn + zmiss_val * ( 1._wp - zmsksn ) ) ! snw mean temperature
+ IF( iom_use('icettop' ) ) CALL iom_put( 'icettop', ( tm_su(:,:) - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! temperature at the ice surface
+ IF( iom_use('icetbot' ) ) CALL iom_put( 'icetbot', ( t_bo(A2D(0)) - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! temperature at the ice bottom
+ IF( iom_use('icetsni' ) ) CALL iom_put( 'icetsni', ( tm_si(:,:) - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! temperature at the snow-ice interface
+ IF( iom_use('icehc' ) ) CALL iom_put( 'icehc' , -et_i(:,:) * zmsk00 ) ! ice heat content
+ IF( iom_use('snwhc' ) ) CALL iom_put( 'snwhc' , -et_s(:,:) * zmsksn ) ! snow heat content
! momentum
- IF( iom_use('uice' ) ) CALL iom_put( 'uice' , u_ice ) ! ice velocity u
- IF( iom_use('vice' ) ) CALL iom_put( 'vice' , v_ice ) ! ice velocity v
+ IF( iom_use('uice' ) ) CALL iom_put( 'uice' , u_ice(A2D(0)) ) ! ice velocity u
+ IF( iom_use('vice' ) ) CALL iom_put( 'vice' , v_ice(A2D(0)) ) ! ice velocity v
!
- IF( iom_use('icevel') .OR. iom_use('fasticepres') ) THEN ! module of ice velocity & fast ice
- ALLOCATE( zfast(jpi,jpj) )
+ IF( iom_use('icevel') .OR. iom_use('fasticepres') ) THEN ! module of ice velocity & fast ice
+ ALLOCATE( zfast(A2D(0)) )
DO_2D( 0, 0, 0, 0 )
z2da = u_ice(ji,jj) + u_ice(ji-1,jj)
z2db = v_ice(ji,jj) + v_ice(ji,jj-1)
z2d(ji,jj) = 0.5_wp * SQRT( z2da * z2da + z2db * z2db )
END_2D
- CALL lbc_lnk( 'icewri', z2d, 'T', 1.0_wp )
CALL iom_put( 'icevel', z2d )
- WHERE( z2d(:,:) < 5.e-04_wp .AND. zmsk15(:,:) == 1._wp ) ; zfast(:,:) = 1._wp ! record presence of fast ice
+ WHERE( z2d(:,:) < 5.e-04_wp .AND. zmsk15(:,:) == 1._wp ) ; zfast(:,:) = 1._wp ! record presence of fast ice
ELSEWHERE ; zfast(:,:) = 0._wp
END WHERE
CALL iom_put( 'fasticepres', zfast )
DEALLOCATE( zfast )
ENDIF
!
- IF( iom_use('icealb') .OR. iom_use('albedo') ) THEN ! ice albedo and surface albedo
- ALLOCATE( zalb(jpi,jpj), zmskalb(jpi,jpj) )
+ IF( iom_use('icealb') .OR. iom_use('albedo') ) THEN ! ice albedo and surface albedo
+ ALLOCATE( zalb(A2D(0)), zmskalb(A2D(0)) )
! ice albedo
- WHERE( at_i_b < 1.e-03 )
+ WHERE( at_i_b(:,:) < 1.e-03 )
zmskalb(:,:) = 0._wp
zalb (:,:) = rn_alb_oce
ELSEWHERE
zmskalb(:,:) = 1._wp
- zalb (:,:) = SUM( alb_ice * a_i_b, dim=3 ) / at_i_b
+ zalb (:,:) = SUM( alb_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) / at_i_b(:,:)
END WHERE
CALL iom_put( 'icealb' , zalb * zmskalb + zmiss_val * ( 1._wp - zmskalb ) )
! ice+ocean albedo
- zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + rn_alb_oce * ( 1._wp - at_i_b )
+ zalb(:,:) = SUM( alb_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) + rn_alb_oce * ( 1._wp - at_i_b(:,:) )
CALL iom_put( 'albedo' , zalb )
DEALLOCATE( zalb, zmskalb )
ENDIF
!
! --- category-dependent fields --- !
- IF( iom_use('icemask_cat' ) ) CALL iom_put( 'icemask_cat' , zmsk00l ) ! ice mask 0%
- IF( iom_use('iceconc_cat' ) ) CALL iom_put( 'iceconc_cat' , a_i * zmsk00l ) ! area for categories
- IF( iom_use('icethic_cat' ) ) CALL iom_put( 'icethic_cat' , h_i * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! thickness for categories
- IF( iom_use('snwthic_cat' ) ) CALL iom_put( 'snwthic_cat' , h_s * zmsksnl + zmiss_val * ( 1._wp - zmsksnl ) ) ! snow depth for categories
- IF( iom_use('icesalt_cat' ) ) CALL iom_put( 'icesalt_cat' , s_i * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! salinity for categories
- IF( iom_use('iceage_cat' ) ) CALL iom_put( 'iceage_cat' , o_i / rday * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! ice age
- IF( iom_use('icetemp_cat' ) ) CALL iom_put( 'icetemp_cat' , ( SUM( t_i, dim=3 ) * r1_nlay_i - rt0 ) &
- & * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! ice temperature
- IF( iom_use('snwtemp_cat' ) ) CALL iom_put( 'snwtemp_cat' , ( SUM( t_s, dim=3 ) * r1_nlay_s - rt0 ) &
- & * zmsksnl + zmiss_val * ( 1._wp - zmsksnl ) ) ! snow temperature
- IF( iom_use('icettop_cat' ) ) CALL iom_put( 'icettop_cat' , ( t_su - rt0 ) * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! surface temperature
- IF( iom_use('icebrv_cat' ) ) CALL iom_put( 'icebrv_cat' , bv_i * 100. * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! brine volume
- IF( iom_use('iceapnd_cat' ) ) CALL iom_put( 'iceapnd_cat' , a_ip * zmsk00l ) ! melt pond frac for categories
- IF( iom_use('icevpnd_cat' ) ) CALL iom_put( 'icevpnd_cat' , v_ip * zmsk00l ) ! melt pond volume for categories
- IF( iom_use('icehpnd_cat' ) ) CALL iom_put( 'icehpnd_cat' , h_ip * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! melt pond thickness for categories
- IF( iom_use('icehlid_cat' ) ) CALL iom_put( 'icehlid_cat' , h_il * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! melt pond lid thickness for categories
- IF( iom_use('iceafpnd_cat') ) CALL iom_put( 'iceafpnd_cat', a_ip_frac * zmsk00l ) ! melt pond frac per ice area for categories
- IF( iom_use('iceaepnd_cat') ) CALL iom_put( 'iceaepnd_cat', a_ip_eff * zmsk00l ) ! melt pond effective frac for categories
- IF( iom_use('icealb_cat' ) ) CALL iom_put( 'icealb_cat' , alb_ice * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! ice albedo for categories
+ IF( iom_use('icemask_cat' ) ) CALL iom_put( 'icemask_cat' , zmsk00l ) ! ice mask 0%
+ IF( iom_use('iceconc_cat' ) ) CALL iom_put( 'iceconc_cat' , a_i(A2D(0),:) * zmsk00l ) ! area for categories
+ IF( iom_use('icethic_cat' ) ) CALL iom_put( 'icethic_cat' , h_i(A2D(0),:) * zmsk00l + zmiss_val &
+ & * ( 1._wp - zmsk00l ) ) ! thickness for categories
+ IF( iom_use('snwthic_cat' ) ) CALL iom_put( 'snwthic_cat' , h_s(A2D(0),:) * zmsksnl + zmiss_val &
+ & * ( 1._wp - zmsksnl ) ) ! snow depth for categories
+ IF( iom_use('icesalt_cat' ) ) CALL iom_put( 'icesalt_cat' , s_i(A2D(0),:) * zmsk00l + zmiss_val &
+ & * ( 1._wp - zmsk00l ) ) ! salinity for categories
+ IF( iom_use('iceage_cat' ) ) CALL iom_put( 'iceage_cat' , o_i(A2D(0),:) / rday * zmsk00l + zmiss_val &
+ & * ( 1._wp - zmsk00l ) ) ! ice age
+ IF( iom_use('icetemp_cat' ) ) CALL iom_put( 'icetemp_cat' , ( SUM( t_i(A2D(0),:,:), dim=3 ) * r1_nlay_i - rt0 ) &
+ & * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! ice temperature
+ IF( iom_use('snwtemp_cat' ) ) CALL iom_put( 'snwtemp_cat' , ( SUM( t_s(A2D(0),:,:), dim=3 ) * r1_nlay_s - rt0 ) &
+ & * zmsksnl + zmiss_val * ( 1._wp - zmsksnl ) ) ! snow temperature
+ IF( iom_use('icettop_cat' ) ) CALL iom_put( 'icettop_cat' , ( t_su(A2D(0),:) - rt0 ) * zmsk00l + zmiss_val &
+ & * ( 1._wp - zmsk00l ) ) ! surface temperature
+ IF( iom_use('icebrv_cat' ) ) CALL iom_put( 'icebrv_cat' , bv_i(:,:,:) * 100. * zmsk00l + zmiss_val &
+ & * ( 1._wp - zmsk00l ) ) ! brine volume
+ IF( iom_use('iceapnd_cat' ) ) CALL iom_put( 'iceapnd_cat' , a_ip(A2D(0),:) * zmsk00l ) ! melt pond frac for categories
+ IF( iom_use('icevpnd_cat' ) ) CALL iom_put( 'icevpnd_cat' , v_ip(A2D(0),:) * zmsk00l ) ! melt pond volume for categories
+ IF( iom_use('icehpnd_cat' ) ) CALL iom_put( 'icehpnd_cat' , h_ip(A2D(0),:) * zmsk00l + zmiss_val &
+ & * ( 1._wp - zmsk00l ) ) ! melt pond thickness for categories
+ IF( iom_use('icehlid_cat' ) ) CALL iom_put( 'icehlid_cat' , h_il(A2D(0),:) * zmsk00l + zmiss_val &
+ & * ( 1._wp - zmsk00l ) ) ! melt pond lid thickness for categories
+ IF( iom_use('iceafpnd_cat') ) CALL iom_put( 'iceafpnd_cat', a_ip_frac(:,:,:) * zmsk00l ) ! melt pond frac per ice area for categories
+ IF( iom_use('iceaepnd_cat') ) CALL iom_put( 'iceaepnd_cat', a_ip_eff(:,:,:) * zmsk00l ) ! melt pond effective frac for categories
+ IF( iom_use('icealb_cat' ) ) CALL iom_put( 'icealb_cat' , alb_ice(:,:,:) * zmsk00l + zmiss_val &
+ & * ( 1._wp - zmsk00l ) ) ! ice albedo for categories
!------------------
! Add-ons for SIMIP
!------------------
! trends
- IF( iom_use('dmithd') ) CALL iom_put( 'dmithd', - wfx_bog - wfx_bom - wfx_sum - wfx_sni - wfx_opw - wfx_lam - wfx_res ) ! Sea-ice mass change from thermodynamics
+ IF( iom_use('dmithd') ) CALL iom_put( 'dmithd', - wfx_bog(:,:) - wfx_bom(:,:) - wfx_sum(:,:) - wfx_sni(:,:) &
+ & - wfx_opw(:,:) - wfx_lam(:,:) - wfx_res(A2D(0)) ) ! Sea-ice mass change from thermodynamics
IF( iom_use('dmidyn') ) CALL iom_put( 'dmidyn', - wfx_dyn + rhoi * diag_trp_vi ) ! Sea-ice mass change from dynamics(kg/m2/s)
IF( iom_use('dmiopw') ) CALL iom_put( 'dmiopw', - wfx_opw ) ! Sea-ice mass change through growth in open water
IF( iom_use('dmibog') ) CALL iom_put( 'dmibog', - wfx_bog ) ! Sea-ice mass change through basal growth
@@ -211,17 +219,23 @@ CONTAINS
IF( iom_use('NH_icearea') .OR. iom_use('NH_icevolu') .OR. iom_use('NH_iceextt') .OR. &
& iom_use('SH_icearea') .OR. iom_use('SH_icevolu') .OR. iom_use('SH_iceextt') ) THEN
!
- WHERE( ff_t(:,:) > 0._wp ) ; z2d(:,:) = 1._wp
- ELSEWHERE ; z2d(:,:) = 0.
+ WHERE( ff_t(A2D(0)) > 0._wp ) ; z2d(:,:) = 1._wp
+ ELSEWHERE ; z2d(:,:) = 0.
END WHERE
!
- IF( iom_use('NH_icearea') ) zdiag_area_nh = glob_sum( 'icewri', at_i * z2d * e1e2t * 1.e-12 )
- IF( iom_use('NH_icevolu') ) zdiag_volu_nh = glob_sum( 'icewri', vt_i * z2d * e1e2t * 1.e-12 )
- IF( iom_use('NH_iceextt') ) zdiag_extt_nh = glob_sum( 'icewri', z2d * e1e2t * 1.e-12 * zmsk15 )
+ IF( iom_use('NH_icearea') ) zdiag_area_nh = glob_sum( 'icewri', at_i(A2D(0)) * z2d * e1e2t(A2D(0)) &
+ & * 1.e-12 )
+ IF( iom_use('NH_icevolu') ) zdiag_volu_nh = glob_sum( 'icewri', vt_i(A2D(0)) * z2d * e1e2t(A2D(0)) &
+ & * 1.e-12 )
+ IF( iom_use('NH_iceextt') ) zdiag_extt_nh = glob_sum( 'icewri', z2d * e1e2t(A2D(0)) &
+ & * 1.e-12 * zmsk15 )
!
- IF( iom_use('SH_icearea') ) zdiag_area_sh = glob_sum( 'icewri', at_i * ( 1._wp - z2d ) * e1e2t * 1.e-12 )
- IF( iom_use('SH_icevolu') ) zdiag_volu_sh = glob_sum( 'icewri', vt_i * ( 1._wp - z2d ) * e1e2t * 1.e-12 )
- IF( iom_use('SH_iceextt') ) zdiag_extt_sh = glob_sum( 'icewri', ( 1._wp - z2d ) * e1e2t * 1.e-12 * zmsk15 )
+ IF( iom_use('SH_icearea') ) zdiag_area_sh = glob_sum( 'icewri', at_i(A2D(0)) * ( 1._wp - z2d ) * e1e2t(A2D(0)) &
+ & * 1.e-12 )
+ IF( iom_use('SH_icevolu') ) zdiag_volu_sh = glob_sum( 'icewri', vt_i(A2D(0)) * ( 1._wp - z2d ) * e1e2t(A2D(0)) &
+ & * 1.e-12 )
+ IF( iom_use('SH_iceextt') ) zdiag_extt_sh = glob_sum( 'icewri', ( 1._wp - z2d ) * e1e2t(A2D(0)) &
+ & * 1.e-12 * zmsk15 )
!
CALL iom_put( 'NH_icearea' , zdiag_area_nh )
CALL iom_put( 'NH_icevolu' , zdiag_volu_nh )
@@ -258,25 +272,25 @@ CONTAINS
!
!! The file is open in dia_wri_state (ocean routine)
- CALL iom_rstput( 0, 0, kid, 'sithic', hm_i ) ! Ice thickness
- CALL iom_rstput( 0, 0, kid, 'siconc', at_i ) ! Ice concentration
- CALL iom_rstput( 0, 0, kid, 'sitemp', tm_i - rt0 ) ! Ice temperature
- CALL iom_rstput( 0, 0, kid, 'sivelu', u_ice ) ! i-Ice speed
- CALL iom_rstput( 0, 0, kid, 'sivelv', v_ice ) ! j-Ice speed
- CALL iom_rstput( 0, 0, kid, 'sistru', utau_ice ) ! i-Wind stress over ice
- CALL iom_rstput( 0, 0, kid, 'sistrv', vtau_ice ) ! i-Wind stress over ice
- CALL iom_rstput( 0, 0, kid, 'sisflx', qsr ) ! Solar flx over ocean
- CALL iom_rstput( 0, 0, kid, 'sinflx', qns ) ! NonSolar flx over ocean
- CALL iom_rstput( 0, 0, kid, 'snwpre', sprecip ) ! Snow precipitation
- CALL iom_rstput( 0, 0, kid, 'sisali', sm_i ) ! Ice salinity
- CALL iom_rstput( 0, 0, kid, 'sivolu', vt_i ) ! Ice volume
- CALL iom_rstput( 0, 0, kid, 'sidive', divu_i*1.0e8 ) ! Ice divergence
- CALL iom_rstput( 0, 0, kid, 'si_amp', at_ip ) ! Melt pond fraction
- CALL iom_rstput( 0, 0, kid, 'si_vmp', vt_ip ) ! Melt pond volume
- CALL iom_rstput( 0, 0, kid, 'sithicat', h_i ) ! Ice thickness
- CALL iom_rstput( 0, 0, kid, 'siconcat', a_i ) ! Ice concentration
- CALL iom_rstput( 0, 0, kid, 'sisalcat', s_i ) ! Ice salinity
- CALL iom_rstput( 0, 0, kid, 'snthicat', h_s ) ! Snw thickness
+ CALL iom_rstput( 0, 0, kid, 'sithic', hm_i(A2D(0)) ) ! Ice thickness
+ CALL iom_rstput( 0, 0, kid, 'siconc', at_i(A2D(0)) ) ! Ice concentration
+ CALL iom_rstput( 0, 0, kid, 'sitemp', tm_i(A2D(0)) - rt0 ) ! Ice temperature
+ CALL iom_rstput( 0, 0, kid, 'sivelu', u_ice(A2D(0)) ) ! i-Ice speed
+ CALL iom_rstput( 0, 0, kid, 'sivelv', v_ice(A2D(0)) ) ! j-Ice speed
+ CALL iom_rstput( 0, 0, kid, 'sistru', utau_ice(A2D(0)) ) ! i-Wind stress over ice
+ CALL iom_rstput( 0, 0, kid, 'sistrv', vtau_ice(A2D(0)) ) ! i-Wind stress over ice
+ CALL iom_rstput( 0, 0, kid, 'sisflx', qsr(A2D(0)) ) ! Solar flx over ocean
+ CALL iom_rstput( 0, 0, kid, 'sinflx', qns(A2D(0)) ) ! NonSolar flx over ocean
+ CALL iom_rstput( 0, 0, kid, 'snwpre', sprecip(A2D(0)) ) ! Snow precipitation
+ CALL iom_rstput( 0, 0, kid, 'sisali', sm_i(A2D(0)) ) ! Ice salinity
+ CALL iom_rstput( 0, 0, kid, 'sivolu', vt_i(A2D(0)) ) ! Ice volume
+ CALL iom_rstput( 0, 0, kid, 'sidive', divu_i(A2D(0))*1.0e8 ) ! Ice divergence
+ CALL iom_rstput( 0, 0, kid, 'si_amp', at_ip(A2D(0)) ) ! Melt pond fraction
+ CALL iom_rstput( 0, 0, kid, 'si_vmp', vt_ip(A2D(0)) ) ! Melt pond volume
+ CALL iom_rstput( 0, 0, kid, 'sithicat', h_i(A2D(0),:) ) ! Ice thickness
+ CALL iom_rstput( 0, 0, kid, 'siconcat', a_i(A2D(0),:) ) ! Ice concentration
+ CALL iom_rstput( 0, 0, kid, 'sisalcat', s_i(A2D(0),:) ) ! Ice salinity
+ CALL iom_rstput( 0, 0, kid, 'snthicat', h_s(A2D(0),:) ) ! Snw thickness
END SUBROUTINE ice_wri_state
diff --git a/src/NST/agrif_all_update.F90 b/src/NST/agrif_all_update.F90
index 753bee7cd3ae087392792fe42a48addd6127ab73..bf320ca109426f26fb04a2dbac2b433690e9207a 100644
--- a/src/NST/agrif_all_update.F90
+++ b/src/NST/agrif_all_update.F90
@@ -112,12 +112,10 @@ CONTAINS
CALL dom_qco_zgr( Kbb_a, Kmm_a )
#endif
#if defined key_si3
- CALL lbc_lnk( 'finalize_lbc_for_agrif', a_i, 'T',1._wp, v_i,'T',1._wp, &
- & v_s, 'T',1._wp, sv_i,'T',1._wp, oa_i,'T',1._wp, &
- & a_ip,'T',1._wp, v_ip,'T',1._wp, v_il,'T',1._wp )
- CALL lbc_lnk( 'finalize_lbc_for_agrif', t_su,'T',1._wp )
- CALL lbc_lnk( 'finalize_lbc_for_agrif', e_s,'T',1._wp )
- CALL lbc_lnk( 'finalize_lbc_for_agrif', e_i,'T',1._wp )
+ CALL lbc_lnk( 'finalize_lbc_for_agrif', a_i, 'T',1._wp, v_i,'T',1._wp, &
+ & v_s, 'T',1._wp, sv_i,'T',1._wp, oa_i,'T',1._wp, &
+ & a_ip,'T',1._wp, v_ip,'T',1._wp, v_il,'T',1._wp, t_su,'T',1._wp )
+ CALL lbc_lnk( 'finalize_lbc_for_agrif', e_i,'T',1._wp, e_s,'T',1._wp )
CALL lbc_lnk( 'finalize_lbc_for_agrif', u_ice, 'U', -1._wp, v_ice, 'V', -1._wp )
#endif
#if defined key_top
diff --git a/src/NST/agrif_ice_interp.F90 b/src/NST/agrif_ice_interp.F90
index 13d056d042762efd993f9ea95e8193fd67ad0fff..e51c386844126ab8bf05acf41d9028d62d503124 100644
--- a/src/NST/agrif_ice_interp.F90
+++ b/src/NST/agrif_ice_interp.F90
@@ -59,12 +59,10 @@ CONTAINS
Agrif_UseSpecialValue = .TRUE.
CALL Agrif_init_variable(tra_iceini_id,procname=interp_tra_ice)
!
- CALL lbc_lnk( 'agrif_istate_ice', a_i,'T',1._wp, v_i,'T',1._wp, &
- & v_s,'T',1._wp, sv_i,'T',1._wp, oa_i,'T',1._wp, &
- & a_ip,'T',1._wp, v_ip,'T',1._wp, v_il,'T',1._wp )
- CALL lbc_lnk( 'agrif_istate_ice', t_su,'T',1._wp )
- CALL lbc_lnk( 'agrif_istate_ice', e_s,'T',1._wp )
- CALL lbc_lnk( 'agrif_istate_ice', e_i,'T',1._wp )
+ CALL lbc_lnk( 'agrif_istate_ice', a_i,'T',1._wp, v_i,'T',1._wp, &
+ & v_s,'T',1._wp, sv_i,'T',1._wp, oa_i,'T',1._wp, &
+ & a_ip,'T',1._wp, v_ip,'T',1._wp, v_il,'T',1._wp, t_su,'T',1._wp )
+ CALL lbc_lnk( 'agrif_istate_ice', e_i,'T',1._wp, e_s,'T',1._wp )
!
! Set u_ice, v_ice:
use_sign_north = .TRUE.
diff --git a/src/NST/agrif_oce_interp.F90 b/src/NST/agrif_oce_interp.F90
index 7d25ea55436f84ebe8c2b190d28aca05d0f0d259..6649f60b403db34975ffa60884974cbf69b2b8ca 100644
--- a/src/NST/agrif_oce_interp.F90
+++ b/src/NST/agrif_oce_interp.F90
@@ -34,7 +34,11 @@ MODULE agrif_oce_interp
USE lib_mpp
USE vremap
USE lbclnk
-
+#if defined key_si3
+ USE iceistate, ONLY: rsshadj, nn_iceini_file
+ USE sbc_oce , ONLY: ln_ice_embd
+ USE sbc_ice , ONLY: snwice_mass
+#endif
IMPLICIT NONE
PRIVATE
@@ -266,7 +270,7 @@ CONTAINS
ibdy2 = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells
!
IF( .NOT.ln_dynspg_ts ) THEN ! Store transport
- DO ji = mi0(ibdy1), mi1(ibdy2)
+ DO ji = mi0(ibdy1,nn_hls), mi1(ibdy2,nn_hls)
DO jj = 1, jpj
uu_b(ji,jj,Krhs_a) = ubdy(ji,jj) * r1_hu(ji,jj,Krhs_a)
vv_b(ji,jj,Krhs_a) = vbdy(ji,jj) * r1_hv(ji,jj,Krhs_a)
@@ -274,7 +278,7 @@ CONTAINS
END DO
ENDIF
!
- DO ji = mi0(ibdy1), mi1(ibdy2)
+ DO ji = mi0(ibdy1,nn_hls), mi1(ibdy2,nn_hls)
zub(ji,:) = 0._wp
zhub(ji,:) = 0._wp
DO jk = 1, jpkm1
@@ -296,7 +300,7 @@ CONTAINS
END DO
END DO
!
- DO ji = mi0(ibdy1), mi1(ibdy2)
+ DO ji = mi0(ibdy1,nn_hls), mi1(ibdy2,nn_hls)
zvb(ji,:) = 0._wp
zhvb(ji,:) = 0._wp
DO jk = 1, jpkm1
@@ -326,14 +330,14 @@ CONTAINS
ibdy2 = jpiglo - ( nn_hls + 2 )
!
IF( .NOT.ln_dynspg_ts ) THEN
- DO ji = mi0(ibdy1), mi1(ibdy2)
+ DO ji = mi0(ibdy1,nn_hls), mi1(ibdy2,nn_hls)
DO jj = 1, jpj
uu_b(ji,jj,Krhs_a) = ubdy(ji,jj) * r1_hu(ji,jj,Krhs_a)
END DO
END DO
ENDIF
!
- DO ji = mi0(ibdy1), mi1(ibdy2)
+ DO ji = mi0(ibdy1,nn_hls), mi1(ibdy2,nn_hls)
zub(ji,:) = 0._wp
zhub(ji,:) = 0._wp
DO jk = 1, jpkm1
@@ -359,14 +363,14 @@ CONTAINS
ibdy2 = jpiglo - ( nn_hls + 1 )
!
IF( .NOT.ln_dynspg_ts ) THEN
- DO ji = mi0(ibdy1), mi1(ibdy2)
+ DO ji = mi0(ibdy1,nn_hls), mi1(ibdy2,nn_hls)
DO jj = 1, jpj
vv_b(ji,jj,Krhs_a) = vbdy(ji,jj) * r1_hv(ji,jj,Krhs_a)
END DO
END DO
ENDIF
!
- DO ji = mi0(ibdy1), mi1(ibdy2)
+ DO ji = mi0(ibdy1,nn_hls), mi1(ibdy2,nn_hls)
zvb(ji,:) = 0._wp
zhvb(ji,:) = 0._wp
DO jk = 1, jpkm1
@@ -396,7 +400,7 @@ CONTAINS
jbdy2 = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhoy()
!
IF( .NOT.ln_dynspg_ts ) THEN
- DO jj = mj0(jbdy1), mj1(jbdy2)
+ DO jj = mj0(jbdy1,nn_hls), mj1(jbdy2,nn_hls)
DO ji = 1, jpi
uu_b(ji,jj,Krhs_a) = ubdy(ji,jj) * r1_hu(ji,jj,Krhs_a)
vv_b(ji,jj,Krhs_a) = vbdy(ji,jj) * r1_hv(ji,jj,Krhs_a)
@@ -404,7 +408,7 @@ CONTAINS
END DO
ENDIF
!
- DO jj = mj0(jbdy1), mj1(jbdy2)
+ DO jj = mj0(jbdy1,nn_hls), mj1(jbdy2,nn_hls)
zvb(:,jj) = 0._wp
zhvb(:,jj) = 0._wp
DO jk=1,jpkm1
@@ -426,7 +430,7 @@ CONTAINS
END DO
END DO
!
- DO jj = mj0(jbdy1), mj1(jbdy2)
+ DO jj = mj0(jbdy1,nn_hls), mj1(jbdy2,nn_hls)
zub(:,jj) = 0._wp
zhub(:,jj) = 0._wp
DO jk = 1, jpkm1
@@ -456,14 +460,14 @@ CONTAINS
jbdy2 = jpjglo - ( nn_hls + 2 )
!
IF( .NOT.ln_dynspg_ts ) THEN
- DO jj = mj0(jbdy1), mj1(jbdy2)
+ DO jj = mj0(jbdy1,nn_hls), mj1(jbdy2,nn_hls)
DO ji = 1, jpi
vv_b(ji,jj,Krhs_a) = vbdy(ji,jj) * r1_hv(ji,jj,Krhs_a)
END DO
END DO
ENDIF
!
- DO jj = mj0(jbdy1), mj1(jbdy2)
+ DO jj = mj0(jbdy1,nn_hls), mj1(jbdy2,nn_hls)
zvb(:,jj) = 0._wp
zhvb(:,jj) = 0._wp
DO jk=1,jpkm1
@@ -489,14 +493,14 @@ CONTAINS
jbdy2 = jpjglo - ( nn_hls + 1 )
!
IF( .NOT.ln_dynspg_ts ) THEN
- DO jj = mj0(jbdy1), mj1(jbdy2)
+ DO jj = mj0(jbdy1,nn_hls), mj1(jbdy2,nn_hls)
DO ji = 1, jpi
uu_b(ji,jj,Krhs_a) = ubdy(ji,jj) * r1_hu(ji,jj,Krhs_a)
END DO
END DO
ENDIF
!
- DO jj = mj0(jbdy1), mj1(jbdy2)
+ DO jj = mj0(jbdy1,nn_hls), mj1(jbdy2,nn_hls)
zub(:,jj) = 0._wp
zhub(:,jj) = 0._wp
DO jk = 1, jpkm1
@@ -549,7 +553,7 @@ CONTAINS
IF( lk_west ) THEN
istart = nn_hls + 2 ! halo + land + 1
iend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells
- DO ji = mi0(istart), mi1(iend)
+ DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
DO jj=1,jpj
va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj)
ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj)
@@ -561,7 +565,7 @@ CONTAINS
IF( lk_east ) THEN
istart = jpiglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhox()
iend = jpiglo - ( nn_hls + 1 )
- DO ji = mi0(istart), mi1(iend)
+ DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
DO jj=1,jpj
va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj)
@@ -569,7 +573,7 @@ CONTAINS
END DO
istart = jpiglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhox()
iend = jpiglo - ( nn_hls + 2 )
- DO ji = mi0(istart), mi1(iend)
+ DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
DO jj=1,jpj
ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj)
END DO
@@ -580,7 +584,7 @@ CONTAINS
IF( lk_south ) THEN
jstart = nn_hls + 2
jend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhoy()
- DO jj = mj0(jstart), mj1(jend)
+ DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
DO ji=1,jpi
ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj)
@@ -593,14 +597,14 @@ CONTAINS
IF( lk_north ) THEN
jstart = jpjglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhoy()
jend = jpjglo - ( nn_hls + 1 )
- DO jj = mj0(jstart), mj1(jend)
+ DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
DO ji=1,jpi
ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj)
END DO
END DO
jstart = jpjglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhoy()
jend = jpjglo - ( nn_hls + 2 )
- DO jj = mj0(jstart), mj1(jend)
+ DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
DO ji=1,jpi
va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj)
END DO
@@ -638,7 +642,7 @@ CONTAINS
IF( lk_west ) THEN
istart = nn_hls + 2
iend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhox()
- DO ji = mi0(istart), mi1(iend)
+ DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
DO jj=1,jpj
zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj)
zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj)
@@ -650,14 +654,14 @@ CONTAINS
IF( lk_east ) THEN
istart = jpiglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhox()
iend = jpiglo - ( nn_hls + 1 )
- DO ji = mi0(istart), mi1(iend)
+ DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
DO jj=1,jpj
zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj)
END DO
END DO
istart = jpiglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhox()
iend = jpiglo - ( nn_hls + 2 )
- DO ji = mi0(istart), mi1(iend)
+ DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
DO jj=1,jpj
zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj)
END DO
@@ -668,7 +672,7 @@ CONTAINS
IF( lk_south ) THEN
jstart = nn_hls + 2
jend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhoy()
- DO jj = mj0(jstart), mj1(jend)
+ DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
DO ji=1,jpi
zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj)
zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj)
@@ -680,14 +684,14 @@ CONTAINS
IF( lk_north ) THEN
jstart = jpjglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhoy()
jend = jpjglo - ( nn_hls + 1 )
- DO jj = mj0(jstart), mj1(jend)
+ DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
DO ji=1,jpi
zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj)
END DO
END DO
jstart = jpjglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhoy()
jend = jpjglo - ( nn_hls + 2 )
- DO jj = mj0(jstart), mj1(jend)
+ DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
DO ji=1,jpi
zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj)
END DO
@@ -797,7 +801,7 @@ CONTAINS
istart = nn_hls + 2 ! halo + land + 1
iend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells
IF (lk_div_cons) iend = istart
- DO ji = mi0(istart), mi1(iend)
+ DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
DO jj = 1, jpj
ssh(ji,jj,Krhs_a) = hbdy(ji,jj)
END DO
@@ -809,7 +813,7 @@ CONTAINS
istart = jpiglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells - 1
iend = jpiglo - ( nn_hls + 1 ) ! halo + land + 1 - 1
IF (lk_div_cons) istart = iend
- DO ji = mi0(istart), mi1(iend)
+ DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
DO jj = 1, jpj
ssh(ji,jj,Krhs_a) = hbdy(ji,jj)
END DO
@@ -821,7 +825,7 @@ CONTAINS
jstart = nn_hls + 2 ! halo + land + 1
jend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhoy() ! halo + land + nbghostcells
IF (lk_div_cons) jend = jstart
- DO jj = mj0(jstart), mj1(jend)
+ DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
DO ji = 1, jpi
ssh(ji,jj,Krhs_a) = hbdy(ji,jj)
END DO
@@ -833,7 +837,7 @@ CONTAINS
jstart = jpjglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhoy() ! halo + land + nbghostcells - 1
jend = jpjglo - ( nn_hls + 1 ) ! halo + land + 1 - 1
IF (lk_div_cons) jstart = jend
- DO jj = mj0(jstart), mj1(jend)
+ DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
DO ji = 1, jpi
ssh(ji,jj,Krhs_a) = hbdy(ji,jj)
END DO
@@ -866,7 +870,7 @@ CONTAINS
istart = nn_hls + 2 ! halo + land + 1
iend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells
IF (lk_div_cons) iend = istart
- DO ji = mi0(istart), mi1(iend)
+ DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
DO jj = 1, jpj
ssha_e(ji,jj) = hbdy(ji,jj)
END DO
@@ -878,7 +882,7 @@ CONTAINS
istart = jpiglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells - 1
iend = jpiglo - ( nn_hls + 1 ) ! halo + land + 1 - 1
IF (lk_div_cons) istart = iend
- DO ji = mi0(istart), mi1(iend)
+ DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
DO jj = 1, jpj
ssha_e(ji,jj) = hbdy(ji,jj)
END DO
@@ -890,7 +894,7 @@ CONTAINS
jstart = nn_hls + 2 ! halo + land + 1
jend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhoy() ! halo + land + nbghostcells
IF (lk_div_cons) jend = jstart
- DO jj = mj0(jstart), mj1(jend)
+ DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
DO ji = 1, jpi
ssha_e(ji,jj) = hbdy(ji,jj)
END DO
@@ -902,7 +906,7 @@ CONTAINS
jstart = jpjglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhoy() ! halo + land + nbghostcells - 1
jend = jpjglo - ( nn_hls + 1 ) ! halo + land + 1 - 1
IF (lk_div_cons) jstart = jend
- DO jj = mj0(jstart), mj1(jend)
+ DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
DO ji = 1, jpi
ssha_e(ji,jj) = hbdy(ji,jj)
END DO
@@ -1108,7 +1112,21 @@ CONTAINS
!!----------------------------------------------------------------------
!
IF( before) THEN
+#if defined key_si3
+ IF (l_ini_child.AND.(.NOT.(ln_rstart .OR. nn_iceini_file == 2))) THEN
+ IF( ln_ice_embd ) THEN
+ ptab(i1:i2,j1:j2) = ssh(i1:i2,j1:j2,Kmm_a) &
+ & + snwice_mass(i1:i2,j1:j2) * r1_rho0
+ ELSE
+ ptab(i1:i2,j1:j2) = ssh(i1:i2,j1:j2,Kmm_a) &
+ & + rsshadj * tmask(i1:i2,j1:j2,1)
+ ENDIF
+ ELSE
+ ptab(i1:i2,j1:j2) = ssh(i1:i2,j1:j2,Kmm_a)
+ ENDIF
+#else
ptab(i1:i2,j1:j2) = ssh(i1:i2,j1:j2,Kmm_a)
+#endif
ELSE
IF( l_ini_child ) THEN
ssh(i1:i2,j1:j2,Krhs_a) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1)
@@ -1533,7 +1551,7 @@ CONTAINS
DO ji=i1,i2
DO jj=j1,j2
IF (utint_stage(ji,jj)==0) THEN
- zx = 2._wp*MOD(ABS(mig0(ji)-nbghostcells_x_w), INT(Agrif_Rhox()))/zrhox - 1._wp
+ zx = 2._wp*MOD(ABS(mig(ji,0)-nbghostcells_x_w), INT(Agrif_Rhox()))/zrhox - 1._wp
ubdy(ji,jj) = ubdy(ji,jj) + 0.25_wp*(1._wp-zx*zx) * ptab(ji,jj) &
& / zrhoy *r1_e2u(ji,jj) * umask(ji,jj,1)
utint_stage(ji,jj) = 1
@@ -1653,7 +1671,7 @@ CONTAINS
DO ji=i1,i2
DO jj=j1,j2
IF (vtint_stage(ji,jj)==0) THEN
- zy = 2._wp*MOD(ABS(mjg0(jj)-nbghostcells_y_s), INT(Agrif_Rhoy()))/zrhoy - 1._wp
+ zy = 2._wp*MOD(ABS(mjg(jj,0)-nbghostcells_y_s), INT(Agrif_Rhoy()))/zrhoy - 1._wp
vbdy(ji,jj) = vbdy(ji,jj) + 0.25_wp*(1._wp-zy*zy) * ptab(ji,jj) &
& / zrhox * r1_e1v(ji,jj) * vmask(ji,jj,1)
vtint_stage(ji,jj) = 1
@@ -1737,7 +1755,7 @@ CONTAINS
DO jj = j1, j2
DO ji = i1, i2
IF( ABS( ptab(ji,jj) - glamt(ji,jj) ) > ztst ) THEN
- WRITE(numout,*) ' Agrif error for glamt: parent, child, i, j ', ptab(ji,jj), glamt(ji,jj), mig0(ji), mig0(jj)
+ WRITE(numout,*) ' Agrif error for glamt: parent, child, i, j ', ptab(ji,jj), glamt(ji,jj), mig(ji,0), mjg(jj,0)
! kindic_agr = kindic_agr + 1
ENDIF
END DO
@@ -1766,7 +1784,7 @@ CONTAINS
DO jj = j1, j2
DO ji = i1, i2
IF( ABS( ptab(ji,jj) - gphit(ji,jj) ) > ztst ) THEN
- WRITE(numout,*) ' Agrif error for gphit: parent, child, i, j ', ptab(ji,jj), gphit(ji,jj), mig0(ji), mig0(jj)
+ WRITE(numout,*) ' Agrif error for gphit: parent, child, i, j ', ptab(ji,jj), gphit(ji,jj), mig(ji,0), mjg(jj,0)
! kindic_agr = kindic_agr + 1
ENDIF
END DO
@@ -1981,8 +1999,8 @@ CONTAINS
iend = nn_hls + nbghostcells + ispon ! halo + land + nbghostcells + sponge
jstart = nn_hls + 2
jend = jpjglo - nn_hls - 1
- DO ji = mi0(istart), mi1(iend)
- DO jj = mj0(jstart), mj1(jend)
+ DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
+ DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
IF ( ABS(ht0_parent(ji,jj)-ht_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1
@@ -1990,7 +2008,7 @@ CONTAINS
END DO
ENDIF
END DO
- DO jj = mj0(jstart), mj1(jend-1)
+ DO jj = mj0(jstart,nn_hls), mj1(jend-1,nn_hls)
IF ( ABS(hv0_parent(ji,jj)-hv_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1
@@ -1999,8 +2017,8 @@ CONTAINS
ENDIF
END DO
END DO
- DO ji = mi0(istart), mi1(iend-1)
- DO jj = mj0(jstart), mj1(jend)
+ DO ji = mi0(istart,nn_hls), mi1(iend-1,nn_hls)
+ DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
IF ( ABS(hu0_parent(ji,jj)-hu_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1
@@ -2018,8 +2036,8 @@ CONTAINS
iend = jpiglo - nn_hls - 1 ! halo + land + 1 - 1
jstart = nn_hls + 2
jend = jpjglo - nn_hls - 1
- DO ji = mi0(istart), mi1(iend)
- DO jj = mj0(jstart), mj1(jend)
+ DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
+ DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
IF ( ABS(ht0_parent(ji,jj)-ht_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1
@@ -2027,7 +2045,7 @@ CONTAINS
END DO
ENDIF
END DO
- DO jj = mj0(jstart), mj1(jend-1)
+ DO jj = mj0(jstart,nn_hls), mj1(jend-1,nn_hls)
IF ( ABS(hv0_parent(ji,jj)-hv_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1
@@ -2036,8 +2054,8 @@ CONTAINS
ENDIF
END DO
END DO
- DO ji = mi0(istart), mi1(iend-1)
- DO jj = mj0(jstart), mj1(jend)
+ DO ji = mi0(istart,nn_hls), mi1(iend-1,nn_hls)
+ DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
IF ( ABS(hu0_parent(ji,jj)-hu_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1
@@ -2055,8 +2073,8 @@ CONTAINS
jend = nn_hls + nbghostcells + ispon ! halo + land + nbghostcells + sponge
istart = nn_hls + 2
iend = jpiglo - nn_hls - 1
- DO jj = mj0(jstart), mj1(jend)
- DO ji = mi0(istart), mi1(iend)
+ DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
+ DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
IF ( ABS(ht0_parent(ji,jj)-ht_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1
@@ -2064,7 +2082,7 @@ CONTAINS
END DO
ENDIF
END DO
- DO ji = mi0(istart), mi1(iend-1)
+ DO ji = mi0(istart,nn_hls), mi1(iend-1,nn_hls)
IF ( ABS(hu0_parent(ji,jj)-hu_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1
@@ -2073,8 +2091,8 @@ CONTAINS
ENDIF
END DO
END DO
- DO jj = mj0(jstart), mj1(jend-1)
- DO ji = mi0(istart), mi1(iend)
+ DO jj = mj0(jstart,nn_hls), mj1(jend-1,nn_hls)
+ DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
IF ( ABS(hv0_parent(ji,jj)-hv_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1
@@ -2092,8 +2110,8 @@ CONTAINS
jend = jpjglo - nn_hls - 1 ! halo + land + 1 - 1
istart = nn_hls + 2
iend = jpiglo - nn_hls - 1
- DO jj = mj0(jstart), mj1(jend)
- DO ji = mi0(istart), mi1(iend)
+ DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
+ DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
IF ( ABS(ht0_parent(ji,jj)-ht_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1
@@ -2101,7 +2119,7 @@ CONTAINS
END DO
ENDIF
END DO
- DO ji = mi0(istart), mi1(iend-1)
+ DO ji = mi0(istart,nn_hls), mi1(iend-1,nn_hls)
IF ( ABS(hu0_parent(ji,jj)-hu_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1
@@ -2110,8 +2128,8 @@ CONTAINS
ENDIF
END DO
END DO
- DO jj = mj0(jstart), mj1(jend-1)
- DO ji = mi0(istart), mi1(iend)
+ DO jj = mj0(jstart,nn_hls), mj1(jend-1,nn_hls)
+ DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
IF ( ABS(hv0_parent(ji,jj)-hv_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1
diff --git a/src/NST/agrif_oce_sponge.F90 b/src/NST/agrif_oce_sponge.F90
index d077f7b8846bc7bb5abb81fdf10b3790781c5814..7d9e58852fc14f1635a9a49b88111f68d50b9d9c 100644
--- a/src/NST/agrif_oce_sponge.F90
+++ b/src/NST/agrif_oce_sponge.F90
@@ -161,15 +161,15 @@ CONTAINS
IF( lk_west ) THEN ! --- West --- !
ind1 = nn_hls + nbghostcells ! halo + nbghostcells
ind2 = nn_hls + nbghostcells + ispongearea
- DO ji = mi0(ind1), mi1(ind2)
+ DO ji = mi0(ind1,nn_hls), mi1(ind2,nn_hls)
DO jj = 1, jpj
- ztabramp(ji,jj) = REAL(ind2 - mig(ji), wp) * z1_ispongearea
+ ztabramp(ji,jj) = REAL(ind2 - mig(ji,nn_hls), wp) * z1_ispongearea
END DO
END DO
! ghost cells:
ind1 = 1
ind2 = nn_hls + nbghostcells ! halo + nbghostcells
- DO ji = mi0(ind1), mi1(ind2)
+ DO ji = mi0(ind1,nn_hls), mi1(ind2,nn_hls)
DO jj = 1, jpj
ztabramp(ji,jj) = 1._wp
END DO
@@ -178,15 +178,15 @@ CONTAINS
IF( lk_east ) THEN ! --- East --- !
ind1 = jpiglo - ( nn_hls + nbghostcells -1 ) - ispongearea - 1
ind2 = jpiglo - ( nn_hls + nbghostcells -1 ) - 1 ! halo + land + nbghostcells - 1
- DO ji = mi0(ind1), mi1(ind2)
+ DO ji = mi0(ind1,nn_hls), mi1(ind2,nn_hls)
DO jj = 1, jpj
- ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mig(ji) - ind1, wp) * z1_ispongearea )
+ ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mig(ji,nn_hls) - ind1, wp) * z1_ispongearea )
END DO
END DO
! ghost cells:
ind1 = jpiglo - ( nn_hls + nbghostcells -1 ) - 1 ! halo + land + nbghostcells - 1
ind2 = jpiglo - 1
- DO ji = mi0(ind1), mi1(ind2)
+ DO ji = mi0(ind1,nn_hls), mi1(ind2,nn_hls)
DO jj = 1, jpj
ztabramp(ji,jj) = 1._wp
END DO
@@ -195,15 +195,15 @@ CONTAINS
IF( lk_south ) THEN ! --- South --- !
ind1 = nn_hls + nbghostcells ! halo + nbghostcells
ind2 = nn_hls + nbghostcells + jspongearea
- DO jj = mj0(ind1), mj1(ind2)
+ DO jj = mj0(ind1,nn_hls), mj1(ind2,nn_hls)
DO ji = 1, jpi
- ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(ind2 - mjg(jj), wp) * z1_jspongearea )
+ ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(ind2 - mjg(jj,nn_hls), wp) * z1_jspongearea )
END DO
END DO
! ghost cells:
ind1 = 1
ind2 = nn_hls + nbghostcells ! halo + nbghostcells
- DO jj = mj0(ind1), mj1(ind2)
+ DO jj = mj0(ind1,nn_hls), mj1(ind2,nn_hls)
DO ji = 1, jpi
ztabramp(ji,jj) = 1._wp
END DO
@@ -212,15 +212,15 @@ CONTAINS
IF( lk_north ) THEN ! --- North --- !
ind1 = jpjglo - ( nn_hls + nbghostcells -1 ) - jspongearea - 1
ind2 = jpjglo - ( nn_hls + nbghostcells -1 ) - 1 ! halo + nbghostcells - 1
- DO jj = mj0(ind1), mj1(ind2)
+ DO jj = mj0(ind1,nn_hls), mj1(ind2,nn_hls)
DO ji = 1, jpi
- ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mjg(jj) - ind1, wp) * z1_jspongearea )
+ ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mjg(jj,nn_hls) - ind1, wp) * z1_jspongearea )
END DO
END DO
! ghost cells:
ind1 = jpjglo - ( nn_hls + nbghostcells -1 ) ! halo + land + nbghostcells - 1
ind2 = jpjglo
- DO jj = mj0(ind1), mj1(ind2)
+ DO jj = mj0(ind1,nn_hls), mj1(ind2,nn_hls)
DO ji = 1, jpi
ztabramp(ji,jj) = 1._wp
END DO
@@ -294,15 +294,15 @@ CONTAINS
IF( lk_west ) THEN ! --- West --- !
ind1 = nn_hls + nbghostcells + ishift
ind2 = nn_hls + nbghostcells + ishift + ispongearea
- DO ji = mi0(ind1), mi1(ind2)
+ DO ji = mi0(ind1,nn_hls), mi1(ind2,nn_hls)
DO jj = 1, jpj
- ztabramp(ji,jj) = REAL(ind2 - mig(ji), wp) * z1_ispongearea
+ ztabramp(ji,jj) = REAL(ind2 - mig(ji,nn_hls), wp) * z1_ispongearea
END DO
END DO
! ghost cells:
ind1 = 1
ind2 = nn_hls + nbghostcells + ishift ! halo + nbghostcells
- DO ji = mi0(ind1), mi1(ind2)
+ DO ji = mi0(ind1,nn_hls), mi1(ind2,nn_hls)
DO jj = 1, jpj
ztabramp(ji,jj) = 1._wp
END DO
@@ -311,15 +311,15 @@ CONTAINS
IF( lk_east ) THEN ! --- East --- !
ind1 = jpiglo - ( nn_hls + nbghostcells -1 + ishift) - ispongearea - 1
ind2 = jpiglo - ( nn_hls + nbghostcells -1 + ishift) - 1 ! halo + nbghostcells - 1
- DO ji = mi0(ind1), mi1(ind2)
+ DO ji = mi0(ind1,nn_hls), mi1(ind2,nn_hls)
DO jj = 1, jpj
- ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mig(ji) - ind1, wp) * z1_ispongearea )
+ ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mig(ji,nn_hls) - ind1, wp) * z1_ispongearea )
END DO
END DO
! ghost cells:
ind1 = jpiglo - ( nn_hls + nbghostcells -1 + ishift) - 1 ! halo + nbghostcells - 1
ind2 = jpiglo - 1
- DO ji = mi0(ind1), mi1(ind2)
+ DO ji = mi0(ind1,nn_hls), mi1(ind2,nn_hls)
DO jj = 1, jpj
ztabramp(ji,jj) = 1._wp
END DO
@@ -328,15 +328,15 @@ CONTAINS
IF( lk_south ) THEN ! --- South --- !
ind1 = nn_hls + nbghostcells + jshift ! halo + nbghostcells
ind2 = nn_hls + nbghostcells + jshift + jspongearea
- DO jj = mj0(ind1), mj1(ind2)
+ DO jj = mj0(ind1,nn_hls), mj1(ind2,nn_hls)
DO ji = 1, jpi
- ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(ind2 - mjg(jj), wp) * z1_jspongearea )
+ ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(ind2 - mjg(jj,nn_hls), wp) * z1_jspongearea )
END DO
END DO
! ghost cells:
ind1 = 1
ind2 = nn_hls + nbghostcells + jshift ! halo + land + nbghostcells
- DO jj = mj0(ind1), mj1(ind2)
+ DO jj = mj0(ind1,nn_hls), mj1(ind2,nn_hls)
DO ji = 1, jpi
ztabramp(ji,jj) = 1._wp
END DO
@@ -345,15 +345,15 @@ CONTAINS
IF( lk_north ) THEN ! --- North --- !
ind1 = jpjglo - ( nn_hls + nbghostcells -1 + jshift) - jspongearea - 1
ind2 = jpjglo - ( nn_hls + nbghostcells -1 + jshift) - 1 ! halo + land + nbghostcells - 1
- DO jj = mj0(ind1), mj1(ind2)
+ DO jj = mj0(ind1,nn_hls), mj1(ind2,nn_hls)
DO ji = 1, jpi
- ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mjg(jj) - ind1, wp) * z1_jspongearea )
+ ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mjg(jj,nn_hls) - ind1, wp) * z1_jspongearea )
END DO
END DO
! ghost cells:
ind1 = jpjglo - ( nn_hls + nbghostcells -1 + jshift) ! halo + land + nbghostcells - 1
ind2 = jpjglo
- DO jj = mj0(ind1), mj1(ind2)
+ DO jj = mj0(ind1,nn_hls), mj1(ind2,nn_hls)
DO ji = 1, jpi
ztabramp(ji,jj) = 1._wp
END DO
@@ -730,7 +730,7 @@ CONTAINS
jmax = j2-1
ind1 = jpjglo - ( nn_hls + nbghostcells + 1 ) ! North
- DO jj = mj0(ind1), mj1(ind1)
+ DO jj = mj0(ind1,nn_hls), mj1(ind1,nn_hls)
jmax = MIN(jmax,jj)
END DO
@@ -858,7 +858,7 @@ CONTAINS
imax = i2 - 1
ind1 = jpiglo - ( nn_hls + nbghostcells + 1 ) ! East
- DO ji = mi0(ind1), mi1(ind1)
+ DO ji = mi0(ind1,nn_hls), mi1(ind1,nn_hls)
imax = MIN(imax,ji)
END DO
@@ -958,7 +958,7 @@ CONTAINS
jmax = j2-1
ind1 = jpjglo - ( nn_hls + nbghostcells + 1 ) ! North
- DO jj = mj0(ind1), mj1(ind1)
+ DO jj = mj0(ind1,nn_hls), mj1(ind1,nn_hls)
jmax = MIN(jmax,jj)
END DO
@@ -1025,7 +1025,7 @@ CONTAINS
imax = i2 - 1
ind1 = jpiglo - ( nn_hls + nbghostcells + 1 ) ! East
- DO ji = mi0(ind1), mi1(ind1)
+ DO ji = mi0(ind1,nn_hls), mi1(ind1,nn_hls)
imax = MIN(imax,ji)
END DO
diff --git a/src/NST/agrif_oce_update.F90 b/src/NST/agrif_oce_update.F90
index 72fb2eca14f143e5fdcbe8b22978ac1ece46c82a..fed58597538a34742cd4280955325fdfbe56ad54 100644
--- a/src/NST/agrif_oce_update.F90
+++ b/src/NST/agrif_oce_update.F90
@@ -1893,7 +1893,7 @@ CONTAINS
DO jk=k1,k2-1
IF (ABS((ptab(ji,jj,jk)-e3u_0(ji,jj,jk))*umask(ji,jj,jk)).GE.1.e-6) THEN
kindic_agr = kindic_agr + 1
- print *, 'erro u-pt', mig0(ji), mjg0(jj), jk, mbku(ji,jj), ikbot, ptab(ji,jj,jk), e3u_0(ji,jj,jk)
+ PRINT *, 'erro u-pt', mig(ji,0), mjg(jj,0), jk, mbku(ji,jj), ikbot, ptab(ji,jj,jk), e3u_0(ji,jj,jk)
ENDIF
END DO
ENDIF
@@ -1933,7 +1933,7 @@ CONTAINS
DO jk=k1,k2-1
IF (ABS((ptab(ji,jj,jk)-e3v_0(ji,jj,jk))*vmask(ji,jj,jk)).GE.1.e-6) THEN
kindic_agr = kindic_agr + 1
- print *, 'erro v-pt', mig0(ji), mjg0(jj), mbkv(ji,jj), ptab(ji,jj,jk), e3v_0(ji,jj,jk)
+ PRINT *, 'erro v-pt', mig(ji,0), mjg(jj,0), mbkv(ji,jj), ptab(ji,jj,jk), e3v_0(ji,jj,jk)
ENDIF
END DO
ENDIF
diff --git a/src/NST/agrif_user.F90 b/src/NST/agrif_user.F90
index 2bdc85c5dd683eb011b0ce1e7e0cba9272e7a8a1..76e583a4a344fe95db3551035b4deb15c4da14f7 100644
--- a/src/NST/agrif_user.F90
+++ b/src/NST/agrif_user.F90
@@ -1095,8 +1095,8 @@
!!----------------------------------------------------------------------
!
SELECT CASE( i )
- CASE(1) ; indglob = mig(indloc)
- CASE(2) ; indglob = mjg(indloc)
+ CASE(1) ; indglob = mig(indloc,nn_hls)
+ CASE(2) ; indglob = mjg(indloc,nn_hls)
CASE DEFAULT ; indglob = indloc
END SELECT
!
@@ -1115,10 +1115,10 @@
INTEGER, INTENT(out) :: jmin, jmax
!!----------------------------------------------------------------------
!
- imin = mig( 1 )
- jmin = mjg( 1 )
- imax = mig(jpi)
- jmax = mjg(jpj)
+ imin = mig( 1 ,nn_hls)
+ jmin = mjg( 1 ,nn_hls)
+ imax = mig(jpi,nn_hls)
+ jmax = mjg(jpj,nn_hls)
!
END SUBROUTINE Agrif_get_proc_info
diff --git a/src/OCE/BDY/bdyini.F90 b/src/OCE/BDY/bdyini.F90
index 3de3150bc35646f23e78a8d4b8cf85977f7ffb31..e0b1fe6d85d0fd968a65e778b9df0ee6ecf40a2a 100644
--- a/src/OCE/BDY/bdyini.F90
+++ b/src/OCE/BDY/bdyini.F90
@@ -491,10 +491,10 @@ CONTAINS
! Find lenght of boundaries and rim on local mpi domain
!------------------------------------------------------
!
- iwe = mig(1)
- ies = mig(jpi)
- iso = mjg(1)
- ino = mjg(jpj)
+ iwe = mig( 1,nn_hls)
+ ies = mig(jpi,nn_hls)
+ iso = mjg( 1,nn_hls)
+ ino = mjg(jpj,nn_hls)
!
DO ib_bdy = 1, nb_bdy
DO igrd = 1, jpbgrd
@@ -554,8 +554,8 @@ CONTAINS
& nbrdta(ib,igrd,ib_bdy) == ir ) THEN
!
icount = icount + 1
- idx_bdy(ib_bdy)%nbi(icount,igrd) = nbidta(ib,igrd,ib_bdy) - mig(1) + 1 ! global to local indexes
- idx_bdy(ib_bdy)%nbj(icount,igrd) = nbjdta(ib,igrd,ib_bdy) - mjg(1) + 1 ! global to local indexes
+ idx_bdy(ib_bdy)%nbi(icount,igrd) = nbidta(ib,igrd,ib_bdy) - mig(1,nn_hls) + 1 ! global to local indexes
+ idx_bdy(ib_bdy)%nbj(icount,igrd) = nbjdta(ib,igrd,ib_bdy) - mjg(1,nn_hls) + 1 ! global to local indexes
idx_bdy(ib_bdy)%nbr(icount,igrd) = nbrdta(ib,igrd,ib_bdy)
idx_bdy(ib_bdy)%nbmap(icount,igrd) = ib
ENDIF
@@ -1014,7 +1014,7 @@ CONTAINS
DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)
ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
- IF( mig0(ii) > 2 .AND. mig0(ii) < Ni0glo-2 .AND. mjg0(ij) > 2 .AND. mjg0(ij) < Nj0glo-2 ) THEN
+ IF( mig(ii,0) > 2 .AND. mig(ii,0) < Ni0glo-2 .AND. mjg(ij,0) > 2 .AND. mjg(ij,0) < Nj0glo-2 ) THEN
WRITE(ctmp1,*) ' Orlanski is not safe when the open boundaries are on the interior of the computational domain'
CALL ctl_stop( ctmp1 )
END IF
@@ -1090,7 +1090,7 @@ CONTAINS
! This error check only works if you are using the bdyXmask arrays (which are set to 0 on rims)
IF( i_offset == 1 .and. zefl + zwfl == 2._wp ) THEN
icount = icount + 1
- IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(ii),mjg(ij)
+ IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(ii,nn_hls),mjg(ij,nn_hls)
ELSE
ztmp(ii,ij) = -zwfl + zefl
ENDIF
@@ -1130,7 +1130,7 @@ CONTAINS
znfl = zmask(ii,ij+j_offset )
! This error check only works if you are using the bdyXmask arrays (which are set to 0 on rims)
IF( j_offset == 1 .and. znfl + zsfl == 2._wp ) THEN
- IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(ii),mjg(ij)
+ IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(ii,nn_hls),mjg(ij,nn_hls)
icount = icount + 1
ELSE
ztmp(ii,ij) = -zsfl + znfl
@@ -1594,8 +1594,8 @@ CONTAINS
ztestmask(1:2)=0.
DO ji = 1, jpi
DO jj = 1, jpj
- IF( mig0(ji) == jpiwob(ib) .AND. mjg0(jj) == jpjwdt(ib) ) ztestmask(1) = tmask(ji,jj,1)
- IF( mig0(ji) == jpiwob(ib) .AND. mjg0(jj) == jpjwft(ib) ) ztestmask(2) = tmask(ji,jj,1)
+ IF( mig(ji,0) == jpiwob(ib) .AND. mjg(jj,0) == jpjwdt(ib) ) ztestmask(1) = tmask(ji,jj,1)
+ IF( mig(ji,0) == jpiwob(ib) .AND. mjg(jj,0) == jpjwft(ib) ) ztestmask(2) = tmask(ji,jj,1)
END DO
END DO
CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain
@@ -1630,8 +1630,8 @@ CONTAINS
ztestmask(1:2)=0.
DO ji = 1, jpi
DO jj = 1, jpj
- IF( mig0(ji) == jpieob(ib)+1 .AND. mjg0(jj) == jpjedt(ib) ) ztestmask(1) = tmask(ji,jj,1)
- IF( mig0(ji) == jpieob(ib)+1 .AND. mjg0(jj) == jpjeft(ib) ) ztestmask(2) = tmask(ji,jj,1)
+ IF( mig(ji,0) == jpieob(ib)+1 .AND. mjg(jj,0) == jpjedt(ib) ) ztestmask(1) = tmask(ji,jj,1)
+ IF( mig(ji,0) == jpieob(ib)+1 .AND. mjg(jj,0) == jpjeft(ib) ) ztestmask(2) = tmask(ji,jj,1)
END DO
END DO
CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain
@@ -1666,8 +1666,8 @@ CONTAINS
ztestmask(1:2)=0.
DO ji = 1, jpi
DO jj = 1, jpj
- IF( mjg0(jj) == jpjsob(ib) .AND. mig0(ji) == jpisdt(ib) ) ztestmask(1) = tmask(ji,jj,1)
- IF( mjg0(jj) == jpjsob(ib) .AND. mig0(ji) == jpisft(ib) ) ztestmask(2) = tmask(ji,jj,1)
+ IF( mjg(jj,0) == jpjsob(ib) .AND. mig(ji,0) == jpisdt(ib) ) ztestmask(1) = tmask(ji,jj,1)
+ IF( mjg(jj,0) == jpjsob(ib) .AND. mig(ji,0) == jpisft(ib) ) ztestmask(2) = tmask(ji,jj,1)
END DO
END DO
CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain
@@ -1688,8 +1688,8 @@ CONTAINS
ztestmask(1:2)=0.
DO ji = 1, jpi
DO jj = 1, jpj
- IF( mjg0(jj) == jpjnob(ib)+1 .AND. mig0(ji) == jpindt(ib) ) ztestmask(1) = tmask(ji,jj,1)
- IF( mjg0(jj) == jpjnob(ib)+1 .AND. mig0(ji) == jpinft(ib) ) ztestmask(2) = tmask(ji,jj,1)
+ IF( mjg(jj,0) == jpjnob(ib)+1 .AND. mig(ji,0) == jpindt(ib) ) ztestmask(1) = tmask(ji,jj,1)
+ IF( mjg(jj,0) == jpjnob(ib)+1 .AND. mig(ji,0) == jpinft(ib) ) ztestmask(2) = tmask(ji,jj,1)
END DO
END DO
CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain
diff --git a/src/OCE/DIA/diaar5.F90 b/src/OCE/DIA/diaar5.F90
index c90cea702ea532aee148d302057cc161672bdf5a..a22ad16402f62f5ef9e66b1ac750b99ce1a07fa5 100644
--- a/src/OCE/DIA/diaar5.F90
+++ b/src/OCE/DIA/diaar5.F90
@@ -53,7 +53,7 @@ CONTAINS
INTEGER :: dia_ar5_alloc
!!----------------------------------------------------------------------
!
- ALLOCATE( thick0(jpi,jpj) , sn0(jpi,jpj,jpk), STAT=dia_ar5_alloc )
+ ALLOCATE( thick0(A2D(0)) , sn0(A2D(0),jpk), STAT=dia_ar5_alloc )
!
CALL mpp_sum ( 'diaar5', dia_ar5_alloc )
IF( dia_ar5_alloc /= 0 ) CALL ctl_stop( 'STOP', 'dia_ar5_alloc: failed to allocate arrays' )
@@ -75,9 +75,10 @@ CONTAINS
REAL(wp) :: zvolssh, zvol, zssh_steric, zztmp, zarho, ztemp, zsal, zmass, zsst
REAL(wp) :: zaw, zbw, zrw
!
- REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zarea_ssh , zbotpres ! 2D workspace
- REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z2d, zpe ! 2D workspace
- REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z3d, zrhd, ztpot, zgdept ! 3D workspace (zgdept: needed to use the substitute)
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zarea_ssh ! 2D workspace
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z2d ! 2D workspace
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z3d
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zrhd, zgdept ! 3D workspace (zgdept: needed to use the substitute)
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztsn ! 4D workspace
!!--------------------------------------------------------------------
IF( ln_timing ) CALL timing_start('dia_ar5')
@@ -85,10 +86,12 @@ CONTAINS
IF( kt == nit000 ) CALL dia_ar5_init
IF( l_ar5 ) THEN
- ALLOCATE( zarea_ssh(jpi,jpj), zbotpres(jpi,jpj), z2d(jpi,jpj) )
+ ALLOCATE( zarea_ssh(A2D(0)), z2d(A2D(0)), z3d(A2D(0),jpk) )
ALLOCATE( zrhd(jpi,jpj,jpk) )
ALLOCATE( ztsn(jpi,jpj,jpk,jpts) )
- zarea_ssh(:,:) = e1e2t(:,:) * ssh(:,:,Kmm)
+ zarea_ssh(:,:) = e1e2t(A2D(0)) * ssh(A2D(0),Kmm)
+ ztsn(:,:,:,:) = 0._wp
+ zrhd(:,:,:) = 0._wp
ENDIF
!
CALL iom_put( 'e2u' , e2u (:,:) )
@@ -96,19 +99,19 @@ CONTAINS
CALL iom_put( 'areacello', e1e2t(:,:) )
!
IF( iom_use( 'volcello' ) .OR. iom_use( 'masscello' ) ) THEN
- zrhd(:,:,jpk) = 0._wp ! ocean volume ; rhd is used as workspace
- DO jk = 1, jpkm1
- zrhd(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk)
- END DO
- DO jk = 1, jpk
- z3d(:,:,jk) = rho0 * e3t(:,:,jk,Kmm) * tmask(:,:,jk)
- END DO
- CALL iom_put( 'volcello' , zrhd(:,:,:) ) ! WARNING not consistent with CMIP DR where volcello is at ca. 2000
+ z3d(:,:,jpk) = 0._wp ! ocean volume ; rhd is used as workspace
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+ z3d(ji,jj,jk) = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk)
+ END_3D
+ CALL iom_put( 'volcello' , z3d(:,:,:) ) ! WARNING not consistent with CMIP DR where volcello is at ca. 2000
+ DO_3D( 0, 0, 0, 0, 1, jpk )
+ z3d(ji,jj,jk) = rho0 * e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk)
+ END_3D
CALL iom_put( 'masscello' , z3d (:,:,:) ) ! ocean mass
ENDIF
!
IF( iom_use( 'e3tb' ) ) THEN ! bottom layer thickness
- DO_2D( 1, 1, 1, 1 )
+ DO_2D( 0, 0, 0, 0 )
ikb = mbkt(ji,jj)
z2d(ji,jj) = e3t(ji,jj,ikb,Kmm)
END_2D
@@ -128,61 +131,63 @@ CONTAINS
IF( iom_use( 'botpres' ) .OR. iom_use( 'sshthster' ) .OR. iom_use( 'sshsteric' ) ) THEN
!
- ztsn(:,:,:,jp_tem) = ts(:,:,:,jp_tem,Kmm) ! thermosteric ssh
- ztsn(:,:,:,jp_sal) = sn0(:,:,:)
+ ztsn(A2D(0),:,jp_tem) = ts(A2D(0),:,jp_tem,Kmm) ! thermosteric ssh
+ ztsn(A2D(0),:,jp_sal) = sn0(:,:,:)
ALLOCATE( zgdept(jpi,jpj,jpk) )
- DO jk = 1, jpk
- zgdept(:,:,jk) = gdept(:,:,jk,Kmm)
- END DO
- CALL eos( ztsn, zrhd, zgdept) ! now in situ density using initial salinity
+ DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
+ zgdept(ji,jj,jk) = gdept(ji,jj,jk,Kmm)
+ END_3D
+ CALL eos( ztsn, zrhd, zgdept ) ! now in situ density using initial salinity
!
- zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice
- DO jk = 1, jpkm1
- zbotpres(:,:) = zbotpres(:,:) + e3t(:,:,jk,Kmm) * zrhd(:,:,jk)
- END DO
+ z2d(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+ z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * zrhd(ji,jj,jk)
+ END_3D
IF( ln_linssh ) THEN
IF( ln_isfcav ) THEN
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
iks = mikt(ji,jj)
- zbotpres(ji,jj) = zbotpres(ji,jj) + ssh(ji,jj,Kmm) * zrhd(ji,jj,iks) + riceload(ji,jj)
+ z2d(ji,jj) = z2d(ji,jj) + ssh(ji,jj,Kmm) * zrhd(ji,jj,iks) + riceload(ji,jj)
END_2D
ELSE
- zbotpres(:,:) = zbotpres(:,:) + ssh(:,:,Kmm) * zrhd(:,:,1)
+ DO_2D( 0, 0, 0, 0 )
+ z2d(ji,jj) = z2d(ji,jj) + ssh(ji,jj,Kmm) * zrhd(ji,jj,1)
+ END_2D
END IF
!!gm
!!gm riceload should be added in both ln_linssh=T or F, no?
!!gm
END IF
!
- zarho = glob_sum( 'diaar5', e1e2t(:,:) * zbotpres(:,:) )
+ zarho = glob_sum( 'diaar5', e1e2t(A2D(0)) * z2d(:,:) )
zssh_steric = - zarho / area_tot
CALL iom_put( 'sshthster', zssh_steric )
! ! steric sea surface height
- zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice
- DO jk = 1, jpkm1
- zbotpres(:,:) = zbotpres(:,:) + e3t(:,:,jk,Kmm) * rhd(:,:,jk)
- END DO
+ z2d(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+ z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * rhd(ji,jj,jk)
+ END_3D
IF( ln_linssh ) THEN
IF ( ln_isfcav ) THEN
- DO ji = 1,jpi
- DO jj = 1,jpj
- iks = mikt(ji,jj)
- zbotpres(ji,jj) = zbotpres(ji,jj) + ssh(ji,jj,Kmm) * rhd(ji,jj,iks) + riceload(ji,jj)
- END DO
- END DO
+ DO_2D( 0, 0, 0, 0 )
+ iks = mikt(ji,jj)
+ z2d(ji,jj) = z2d(ji,jj) + ssh(ji,jj,Kmm) * rhd(ji,jj,iks) + riceload(ji,jj)
+ END_2D
ELSE
- zbotpres(:,:) = zbotpres(:,:) + ssh(:,:,Kmm) * rhd(:,:,1)
+ DO_2D( 0, 0, 0, 0 )
+ z2d(ji,jj) = z2d(ji,jj) + ssh(ji,jj,Kmm) * rhd(ji,jj,1)
+ END_2D
END IF
END IF
!
- zarho = glob_sum( 'diaar5', e1e2t(:,:) * zbotpres(:,:) )
+ zarho = glob_sum( 'diaar5', e1e2t(A2D(0)) * z2d(:,:) )
zssh_steric = - zarho / area_tot
CALL iom_put( 'sshsteric', zssh_steric )
! ! ocean bottom pressure
zztmp = rho0 * grav * 1.e-4_wp ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa
- zbotpres(:,:) = zztmp * ( zbotpres(:,:) + ssh(:,:,Kmm) + thick0(:,:) )
- CALL iom_put( 'botpres', zbotpres )
+ z2d(:,:) = zztmp * ( z2d(:,:) + ssh(A2D(0),Kmm) + thick0(:,:) )
+ CALL iom_put( 'botpres', z2d )
!
DEALLOCATE( zgdept )
!
@@ -191,7 +196,7 @@ CONTAINS
IF( iom_use( 'masstot' ) .OR. iom_use( 'temptot' ) .OR. iom_use( 'saltot' ) ) THEN
! ! Mean density anomalie, temperature and salinity
ztsn(:,:,:,:) = 0._wp ! ztsn(:,:,1,jp_tem/sal) is used here as 2D Workspace for temperature & salinity
- DO_3D( 1, 1, 1, 1, 1, jpkm1 )
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
zztmp = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm)
ztsn(ji,jj,1,jp_tem) = ztsn(ji,jj,1,jp_tem) + zztmp * ts(ji,jj,jk,jp_tem,Kmm)
ztsn(ji,jj,1,jp_sal) = ztsn(ji,jj,1,jp_sal) + zztmp * ts(ji,jj,jk,jp_sal,Kmm)
@@ -199,16 +204,16 @@ CONTAINS
IF( ln_linssh ) THEN
IF( ln_isfcav ) THEN
- DO ji = 1, jpi
- DO jj = 1, jpj
- iks = mikt(ji,jj)
- ztsn(ji,jj,1,jp_tem) = ztsn(ji,jj,1,jp_tem) + zarea_ssh(ji,jj) * ts(ji,jj,iks,jp_tem,Kmm)
- ztsn(ji,jj,1,jp_sal) = ztsn(ji,jj,1,jp_sal) + zarea_ssh(ji,jj) * ts(ji,jj,iks,jp_sal,Kmm)
- END DO
- END DO
+ DO_2D( 0, 0, 0, 0 )
+ iks = mikt(ji,jj)
+ ztsn(ji,jj,1,jp_tem) = ztsn(ji,jj,1,jp_tem) + zarea_ssh(ji,jj) * ts(ji,jj,iks,jp_tem,Kmm)
+ ztsn(ji,jj,1,jp_sal) = ztsn(ji,jj,1,jp_sal) + zarea_ssh(ji,jj) * ts(ji,jj,iks,jp_sal,Kmm)
+ END_2D
ELSE
- ztsn(:,:,1,jp_tem) = ztsn(:,:,1,jp_tem) + zarea_ssh(:,:) * ts(:,:,1,jp_tem,Kmm)
- ztsn(:,:,1,jp_sal) = ztsn(:,:,1,jp_sal) + zarea_ssh(:,:) * ts(:,:,1,jp_sal,Kmm)
+ DO_2D( 0, 0, 0, 0 )
+ ztsn(ji,jj,1,jp_tem) = ztsn(ji,jj,1,jp_tem) + zarea_ssh(ji,jj) * ts(ji,jj,1,jp_tem,Kmm)
+ ztsn(ji,jj,1,jp_sal) = ztsn(ji,jj,1,jp_sal) + zarea_ssh(ji,jj) * ts(ji,jj,1,jp_sal,Kmm)
+ END_2D
END IF
ENDIF
!
@@ -226,37 +231,35 @@ CONTAINS
IF( iom_use( 'toce_pot') .OR. iom_use( 'temptot_pot' ) .OR. iom_use( 'sst_pot' ) &
.OR. iom_use( 'ssttot' ) .OR. iom_use( 'tosmint_pot' ) ) THEN
!
- ALLOCATE( ztpot(jpi,jpj,jpk) )
- ztpot(:,:,jpk) = 0._wp
+ z3d(:,:,jpk) = 0._wp
DO jk = 1, jpkm1
- ztpot(:,:,jk) = eos_pt_from_ct( ts(:,:,jk,jp_tem,Kmm), ts(:,:,jk,jp_sal,Kmm) )
+ z3d(:,:,jk) = eos_pt_from_ct( ts(A2D(0),jk,jp_tem,Kmm), ts(A2D(0),jk,jp_sal,Kmm) )
END DO
!
- CALL iom_put( 'toce_pot', ztpot(:,:,:) ) ! potential temperature (TEOS-10 case)
- CALL iom_put( 'sst_pot' , ztpot(:,:,1) ) ! surface temperature
+ CALL iom_put( 'toce_pot', z3d(:,:,:) ) ! potential temperature (TEOS-10 case)
+ CALL iom_put( 'sst_pot' , z3d(:,:,1) ) ! surface temperature
!
IF( iom_use( 'temptot_pot' ) ) THEN ! Output potential temperature in case we use TEOS-10
z2d(:,:) = 0._wp
- DO jk = 1, jpkm1
- z2d(:,:) = z2d(:,:) + e1e2t(:,:) * e3t(:,:,jk,Kmm) * ztpot(:,:,jk)
- END DO
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+ z2d(ji,jj) = z2d(ji,jj) + e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) * z3d(ji,jj,jk)
+ END_3D
ztemp = glob_sum( 'diaar5', z2d(:,:) )
CALL iom_put( 'temptot_pot', ztemp / zvol )
ENDIF
!
IF( iom_use( 'ssttot' ) ) THEN ! Output potential temperature in case we use TEOS-10
- zsst = glob_sum( 'diaar5', e1e2t(:,:) * ztpot(:,:,1) )
+ zsst = glob_sum( 'diaar5', e1e2t(A2D(0)) * z3d(:,:,1) )
CALL iom_put( 'ssttot', zsst / area_tot )
ENDIF
! Vertical integral of temperature
IF( iom_use( 'tosmint_pot') ) THEN
z2d(:,:) = 0._wp
- DO_3D( 1, 1, 1, 1, 1, jpkm1 )
- z2d(ji,jj) = z2d(ji,jj) + rho0 * e3t(ji,jj,jk,Kmm) * ztpot(ji,jj,jk)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+ z2d(ji,jj) = z2d(ji,jj) + rho0 * e3t(ji,jj,jk,Kmm) * z3d(ji,jj,jk)
END_3D
CALL iom_put( 'tosmint_pot', z2d )
ENDIF
- DEALLOCATE( ztpot )
ENDIF
ELSE
IF( iom_use('ssttot') ) THEN ! Output sst in case we use EOS-80
@@ -269,33 +272,31 @@ CONTAINS
! Work done against stratification by vertical mixing
! Exclude points where rn2 is negative as convection kicks in here and
! work is not being done against stratification
- ALLOCATE( zpe(jpi,jpj) )
- zpe(:,:) = 0._wp
+ z2d(:,:) = 0._wp
IF( ln_zdfddm ) THEN
- DO_3D( 1, 1, 1, 1, 2, jpk )
+ DO_3D( 0, 0, 0, 0, 2, jpk )
IF( rn2(ji,jj,jk) > 0._wp ) THEN
zrw = ( gdept(ji,jj,jk,Kmm) - gdepw(ji,jj,jk,Kmm) ) / e3w(ji,jj,jk,Kmm)
!
zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw
zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw
!
- zpe(ji, jj) = zpe(ji,jj) &
+ z2d(ji, jj) = z2d(ji,jj) &
& - grav * ( avt(ji,jj,jk) * zaw * (ts(ji,jj,jk-1,jp_tem,Kmm) - ts(ji,jj,jk,jp_tem,Kmm) ) &
& - avs(ji,jj,jk) * zbw * (ts(ji,jj,jk-1,jp_sal,Kmm) - ts(ji,jj,jk,jp_sal,Kmm) ) )
ENDIF
END_3D
ELSE
- DO_3D( 1, 1, 1, 1, 1, jpk )
- zpe(ji,jj) = zpe(ji,jj) + avt(ji,jj,jk) * MIN(0._wp,rn2(ji,jj,jk)) * rho0 * e3w(ji,jj,jk,Kmm)
+ DO_3D( 0, 0, 0, 0, 1, jpk )
+ z2d(ji,jj) = z2d(ji,jj) + avt(ji,jj,jk) * MIN(0._wp,rn2(ji,jj,jk)) * rho0 * e3w(ji,jj,jk,Kmm)
END_3D
ENDIF
- CALL iom_put( 'tnpeo', zpe )
- DEALLOCATE( zpe )
+ CALL iom_put( 'tnpeo', z2d )
ENDIF
IF( l_ar5 ) THEN
- DEALLOCATE( zarea_ssh , zbotpres, z2d )
- DEALLOCATE( ztsn )
+ DEALLOCATE( zarea_ssh , z2d, z3d )
+ DEALLOCATE( ztsn )
ENDIF
!
IF( ln_timing ) CALL timing_stop('dia_ar5')
@@ -316,33 +317,33 @@ CONTAINS
REAL(wp), DIMENSION(A2D(nn_hls),jpk) , INTENT(in) :: pvflx ! v-flux of advection/diffusion
!
INTEGER :: ji, jj, jk
- REAL(wp), DIMENSION(A2D(nn_hls)) :: z2d
+ REAL(wp), DIMENSION(A2D(0)) :: z2d
!!----------------------------------------------------------------------
- z2d(:,:) = puflx(:,:,1)
+ z2d(:,:) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
z2d(ji,jj) = z2d(ji,jj) + puflx(ji,jj,jk)
END_3D
IF( cptr == 'adv' ) THEN
- IF( ktra == jp_tem ) CALL iom_put( 'uadv_heattr' , rho0_rcp * z2d(:,:) ) ! advective heat transport in i-direction
- IF( ktra == jp_sal ) CALL iom_put( 'uadv_salttr' , rho0 * z2d(:,:) ) ! advective salt transport in i-direction
+ IF( ktra == jp_tem ) CALL iom_put( 'uadv_heattr' , rho0_rcp * z2d(:,:) ) ! advective heat transport in i-direction
+ IF( ktra == jp_sal ) CALL iom_put( 'uadv_salttr' , rho0 * z2d(:,:) ) ! advective salt transport in i-direction
ELSE IF( cptr == 'ldf' ) THEN
- IF( ktra == jp_tem ) CALL iom_put( 'udiff_heattr' , rho0_rcp * z2d(:,:) ) ! diffusive heat transport in i-direction
- IF( ktra == jp_sal ) CALL iom_put( 'udiff_salttr' , rho0 * z2d(:,:) ) ! diffusive salt transport in i-direction
+ IF( ktra == jp_tem ) CALL iom_put( 'udiff_heattr' , rho0_rcp * z2d(:,:) ) ! diffusive heat transport in i-direction
+ IF( ktra == jp_sal ) CALL iom_put( 'udiff_salttr' , rho0 * z2d(:,:) ) ! diffusive salt transport in i-direction
ENDIF
!
- z2d(:,:) = pvflx(:,:,1)
+ z2d(:,:) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
z2d(ji,jj) = z2d(ji,jj) + pvflx(ji,jj,jk)
END_3D
IF( cptr == 'adv' ) THEN
- IF( ktra == jp_tem ) CALL iom_put( 'vadv_heattr' , rho0_rcp * z2d(:,:) ) ! advective heat transport in j-direction
- IF( ktra == jp_sal ) CALL iom_put( 'vadv_salttr' , rho0 * z2d(:,:) ) ! advective salt transport in j-direction
+ IF( ktra == jp_tem ) CALL iom_put( 'vadv_heattr' , rho0_rcp * z2d(:,:) ) ! advective heat transport in j-direction
+ IF( ktra == jp_sal ) CALL iom_put( 'vadv_salttr' , rho0 * z2d(:,:) ) ! advective salt transport in j-direction
ELSE IF( cptr == 'ldf' ) THEN
- IF( ktra == jp_tem ) CALL iom_put( 'vdiff_heattr' , rho0_rcp * z2d(:,:) ) ! diffusive heat transport in j-direction
- IF( ktra == jp_sal ) CALL iom_put( 'vdiff_salttr' , rho0 * z2d(:,:) ) ! diffusive salt transport in j-direction
+ IF( ktra == jp_tem ) CALL iom_put( 'vdiff_heattr' , rho0_rcp * z2d(:,:) ) ! diffusive heat transport in j-direction
+ IF( ktra == jp_sal ) CALL iom_put( 'vdiff_salttr' , rho0 * z2d(:,:) ) ! diffusive salt transport in j-direction
ENDIF
END SUBROUTINE dia_ar5_hst
@@ -380,10 +381,10 @@ CONTAINS
area_tot = glob_sum( 'diaar5', e1e2t(:,:) )
- ALLOCATE( zvol0(jpi,jpj) )
+ ALLOCATE( zvol0(A2D(0)) )
zvol0 (:,:) = 0._wp
thick0(:,:) = 0._wp
- DO_3D( 1, 1, 1, 1, 1, jpkm1 ) ! interpolation of salinity at the last ocean level (i.e. the partial step)
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! interpolation of salinity at the last ocean level (i.e. the partial step)
zztmp = tmask(ji,jj,jk) * e3t_0(ji,jj,jk)
zvol0 (ji,jj) = zvol0 (ji,jj) + zztmp * e1e2t(ji,jj)
thick0(ji,jj) = thick0(ji,jj) + zztmp
@@ -392,16 +393,16 @@ CONTAINS
DEALLOCATE( zvol0 )
IF( iom_use( 'sshthster' ) ) THEN
- ALLOCATE( zsaldta(jpi,jpj,jpk,jpts) )
+ ALLOCATE( zsaldta(A2D(0),jpk,jpts) )
CALL iom_open ( 'sali_ref_clim_monthly', inum )
CALL iom_get ( inum, jpdom_global, 'vosaline' , zsaldta(:,:,:,1), 1 )
CALL iom_get ( inum, jpdom_global, 'vosaline' , zsaldta(:,:,:,2), 12 )
CALL iom_close( inum )
sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) )
- sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:)
+ sn0(:,:,:) = sn0(:,:,:) * tmask(A2D(0),:)
IF( ln_zps ) THEN ! z-coord. partial steps
- DO_2D( 1, 1, 1, 1 ) ! interpolation of salinity at the last ocean level (i.e. the partial step)
+ DO_2D( 0, 0, 0, 0 ) ! interpolation of salinity at the last ocean level (i.e. the partial step)
ik = mbkt(ji,jj)
IF( ik > 1 ) THEN
zztmp = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
diff --git a/src/OCE/DIA/diacfl.F90 b/src/OCE/DIA/diacfl.F90
index e35764b3b7894d41c45d1d7098dc640d0b5b97f8..7d0ee952d0c6ab91d768ac7700df60fce2f2f36a 100644
--- a/src/OCE/DIA/diacfl.F90
+++ b/src/OCE/DIA/diacfl.F90
@@ -51,19 +51,19 @@ CONTAINS
INTEGER, INTENT(in) :: kt ! ocean time-step index
INTEGER, INTENT(in) :: Kmm ! ocean time level index
!
- INTEGER :: ji, jj, jk ! dummy loop indices
- REAL(wp) :: zCu_max, zCv_max, zCw_max ! local scalars
- INTEGER , DIMENSION(3) :: iloc_u , iloc_v , iloc_w , iloc ! workspace
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: zCu_cfl, zCv_cfl, zCw_cfl ! workspace
- LOGICAL , DIMENSION(jpi,jpj,jpk) :: llmsk
+ INTEGER :: ji, jj, jk ! dummy loop indices
+ REAL(wp) :: zCu_max, zCv_max, zCw_max ! local scalars
+ INTEGER , DIMENSION(3) :: iloc_u , iloc_v , iloc_w , iloc ! workspace
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zCu_cfl, zCv_cfl, zCw_cfl ! workspace
+ LOGICAL , DIMENSION(A2D(0),jpk) :: llmsk
!!----------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('dia_cfl')
!
- llmsk( 1:nn_hls,:,:) = .FALSE. ! exclude halos from the checked region
- llmsk(Nie0+1: jpi,:,:) = .FALSE.
- llmsk(:, 1:nn_hls,:) = .FALSE.
- llmsk(:,Nje0+1: jpj,:) = .FALSE.
+ !llmsk( 1:nn_hls,:,:) = .FALSE. ! exclude halos from the checked region
+ !llmsk(Nie0+1: jpi,:,:) = .FALSE.
+ !llmsk(:, 1:nn_hls,:) = .FALSE.
+ !llmsk(:,Nje0+1: jpj,:) = .FALSE.
!
DO_3D( 0, 0, 0, 0, 1, jpk ) ! calculate Courant numbers
zCu_cfl(ji,jj,jk) = ABS( uu(ji,jj,jk,Kmm) ) * rDt / e1u (ji,jj) ! for i-direction
diff --git a/src/OCE/DIA/diadct.F90 b/src/OCE/DIA/diadct.F90
index 4fa5479f4bd09776fc96de18b9919e0a569515f7..ffc50f37089f05e2ca9c905a2389db91a5f3f7d4 100644
--- a/src/OCE/DIA/diadct.F90
+++ b/src/OCE/DIA/diadct.F90
@@ -414,9 +414,9 @@ CONTAINS
!verify if the point is on the local domain:(1,Nie0)*(1,Nje0)
IF( iiloc >= 1 .AND. iiloc <= Nie0 .AND. &
ijloc >= 1 .AND. ijloc <= Nje0 )THEN
- iptloc = iptloc + 1 ! count local points
- secs(jsec)%listPoint(iptloc) = POINT_SECTION(mi0(iiglo),mj0(ijglo)) ! store local coordinates
- secs(jsec)%direction(iptloc) = directemp(jpt) ! store local direction
+ iptloc = iptloc + 1 ! count local points
+ secs(jsec)%listPoint(iptloc) = POINT_SECTION(mi0(iiglo,nn_hls),mj0(ijglo,nn_hls)) ! store local coordinates
+ secs(jsec)%direction(iptloc) = directemp(jpt) ! store local direction
ENDIF
!
END DO
diff --git a/src/OCE/DIA/diahsb.F90 b/src/OCE/DIA/diahsb.F90
index 1039d5c3c98ec1e81b6fba5d45bd650eaf02177f..29e80ec7a4e1127a922f0866bf97a0d852d016f0 100644
--- a/src/OCE/DIA/diahsb.F90
+++ b/src/OCE/DIA/diahsb.F90
@@ -85,7 +85,7 @@ CONTAINS
REAL(wp) :: z_ssh_hc , z_ssh_sc ! - -
REAL(wp), DIMENSION(A2D(0),13) :: ztmp
REAL(wp), DIMENSION(A2D(0),jpkm1,4) :: ztmpk
- REAL(wp), DIMENSION(17) :: zbg
+ REAL(wp), DIMENSION(17) :: zbg
!!---------------------------------------------------------------------------
IF( ln_timing ) CALL timing_start('dia_hsb')
!
@@ -141,12 +141,10 @@ CONTAINS
!
IF( ln_linssh ) THEN ! Advection flux through fixed surface (z=0)
IF( ln_isfcav ) THEN
- DO ji=1,jpi
- DO jj=1,jpj
- ztmp(ji,jj,9 ) = - surf(ji,jj) * ww(ji,jj,mikt(ji,jj)) * ts(ji,jj,mikt(ji,jj),jp_tem,Kbb)
- ztmp(ji,jj,10) = - surf(ji,jj) * ww(ji,jj,mikt(ji,jj)) * ts(ji,jj,mikt(ji,jj),jp_sal,Kbb)
- END DO
- END DO
+ DO_2D( 0, 0, 0, 0 )
+ ztmp(ji,jj,9 ) = - surf(ji,jj) * ww(ji,jj,mikt(ji,jj)) * ts(ji,jj,mikt(ji,jj),jp_tem,Kbb)
+ ztmp(ji,jj,10) = - surf(ji,jj) * ww(ji,jj,mikt(ji,jj)) * ts(ji,jj,mikt(ji,jj),jp_sal,Kbb)
+ END_2D
ELSE
DO_2D( 0, 0, 0, 0 )
ztmp(ji,jj,9 ) = - surf(ji,jj) * ww(ji,jj,1) * ts(ji,jj,1,jp_tem,Kbb)
@@ -193,12 +191,10 @@ CONTAINS
! ! heat & salt content variation (associated with ssh)
IF( ln_linssh ) THEN ! linear free surface case
IF( ln_isfcav ) THEN ! ISF case
- DO ji = 1, jpi
- DO jj = 1, jpj
- ztmp(ji,jj,12) = surf(ji,jj) * ( ts(ji,jj,mikt(ji,jj),jp_tem,Kmm) * ssh(ji,jj,Kmm) - ssh_hc_loc_ini(ji,jj) )
- ztmp(ji,jj,13) = surf(ji,jj) * ( ts(ji,jj,mikt(ji,jj),jp_sal,Kmm) * ssh(ji,jj,Kmm) - ssh_sc_loc_ini(ji,jj) )
- END DO
- END DO
+ DO_2D( 0, 0, 0, 0 )
+ ztmp(ji,jj,12) = surf(ji,jj) * ( ts(ji,jj,mikt(ji,jj),jp_tem,Kmm) * ssh(ji,jj,Kmm) - ssh_hc_loc_ini(ji,jj) )
+ ztmp(ji,jj,13) = surf(ji,jj) * ( ts(ji,jj,mikt(ji,jj),jp_sal,Kmm) * ssh(ji,jj,Kmm) - ssh_sc_loc_ini(ji,jj) )
+ END_2D
ELSE ! no under ice-shelf seas
DO_2D( 0, 0, 0, 0 )
ztmp(ji,jj,12) = surf(ji,jj) * ( ts(ji,jj,1,jp_tem,Kmm) * ssh(ji,jj,Kmm) - ssh_hc_loc_ini(ji,jj) )
@@ -365,26 +361,22 @@ CONTAINS
surf_ini(ji,jj) = e1e2t(ji,jj) * tmask_i(ji,jj) ! initial ocean surface
ssh_ini(ji,jj) = ssh(ji,jj,Kmm) ! initial ssh
END_2D
- DO jk = 1, jpk
- ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance).
- DO_2D( 0, 0, 0, 0 )
- e3t_ini (ji,jj,jk) = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) ! initial vertical scale factors
- tmask_ini (ji,jj,jk) = tmask(ji,jj,jk) ! initial mask
- hc_loc_ini(ji,jj,jk) = ts(ji,jj,jk,jp_tem,Kmm) * e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) ! initial heat content
- sc_loc_ini(ji,jj,jk) = ts(ji,jj,jk,jp_sal,Kmm) * e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) ! initial salt content
- END_2D
- END DO
+ ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance).
+ DO_3D( 0, 0, 0, 0, 1, jpk )
+ e3t_ini (ji,jj,jk) = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) ! initial vertical scale factors
+ tmask_ini (ji,jj,jk) = tmask(ji,jj,jk) ! initial mask
+ hc_loc_ini(ji,jj,jk) = ts(ji,jj,jk,jp_tem,Kmm) * e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) ! initial heat content
+ sc_loc_ini(ji,jj,jk) = ts(ji,jj,jk,jp_sal,Kmm) * e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) ! initial salt content
+ END_3D
frc_v = 0._wp ! volume trend due to forcing
frc_t = 0._wp ! heat content - - - -
frc_s = 0._wp ! salt content - - - -
IF( ln_linssh ) THEN
IF( ln_isfcav ) THEN
- DO ji = 1, jpi
- DO jj = 1, jpj
- ssh_hc_loc_ini(ji,jj) = ts(ji,jj,mikt(ji,jj),jp_tem,Kmm) * ssh(ji,jj,Kmm) ! initial heat content in ssh
- ssh_sc_loc_ini(ji,jj) = ts(ji,jj,mikt(ji,jj),jp_sal,Kmm) * ssh(ji,jj,Kmm) ! initial salt content in ssh
- END DO
- END DO
+ DO_2D( 0, 0, 0, 0 )
+ ssh_hc_loc_ini(ji,jj) = ts(ji,jj,mikt(ji,jj),jp_tem,Kmm) * ssh(ji,jj,Kmm) ! initial heat content in ssh
+ ssh_sc_loc_ini(ji,jj) = ts(ji,jj,mikt(ji,jj),jp_sal,Kmm) * ssh(ji,jj,Kmm) ! initial salt content in ssh
+ END_2D
ELSE
DO_2D( 0, 0, 0, 0 )
ssh_hc_loc_ini(ji,jj) = ts(ji,jj,1,jp_tem,Kmm) * ssh(ji,jj,Kmm) ! initial heat content in ssh
@@ -466,13 +458,13 @@ CONTAINS
! ------------------- !
! 1 - Allocate memory !
! ------------------- !
- ALLOCATE( hc_loc_ini(jpi,jpj,jpk), sc_loc_ini(jpi,jpj,jpk), surf_ini(jpi,jpj), &
- & e3t_ini(jpi,jpj,jpk), surf(jpi,jpj), ssh_ini(jpi,jpj), tmask_ini(jpi,jpj,jpk),STAT=ierror )
+ ALLOCATE( hc_loc_ini(A2D(0),jpk), sc_loc_ini(A2D(0),jpk), surf_ini(A2D(0)), &
+ & e3t_ini(A2D(0),jpk), surf(A2D(0)), ssh_ini(A2D(0)), tmask_ini(A2D(0),jpk),STAT=ierror )
IF( ierror > 0 ) THEN
CALL ctl_stop( 'dia_hsb_init: unable to allocate hc_loc_ini' ) ; RETURN
ENDIF
- IF( ln_linssh ) ALLOCATE( ssh_hc_loc_ini(jpi,jpj), ssh_sc_loc_ini(jpi,jpj),STAT=ierror )
+ IF( ln_linssh ) ALLOCATE( ssh_hc_loc_ini(A2D(0)), ssh_sc_loc_ini(A2D(0)),STAT=ierror )
IF( ierror > 0 ) THEN
CALL ctl_stop( 'dia_hsb: unable to allocate ssh_hc_loc_ini' ) ; RETURN
ENDIF
@@ -482,7 +474,7 @@ CONTAINS
! ----------------------------------------------- !
DO_2D( 0, 0, 0, 0 )
- surf(ji,jj) = e1e2t(ji,jj) * tmask_i(ji,jj) ! masked surface grid cell area
+ surf(ji,jj) = e1e2t(ji,jj) * smask0_i(ji,jj) ! masked surface grid cell area
END_2D
surf_tot = glob_sum( 'diahsb', surf(:,:) ) ! total ocean surface area
diff --git a/src/OCE/DIA/diaptr.F90 b/src/OCE/DIA/diaptr.F90
index 6c4f48a3df847736f550d430f94e3c5beadca760..68fe7f3a640937b0c9623acdd56d3d4243e03f59 100644
--- a/src/OCE/DIA/diaptr.F90
+++ b/src/OCE/DIA/diaptr.F90
@@ -542,7 +542,7 @@ CONTAINS
INTEGER , INTENT(in) :: ktra ! tracer index
CHARACTER(len=3) , INTENT(in) :: cptr ! transport type 'adv'/'ldf'/'eiv'
! TODO: Can be A2D(0) once all dia_ptr_hst calls have arguments with consistent declarations
- REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(in) :: pvflx ! 3D input array of advection/diffusion
+ REAL(wp), DIMENSION(A2D(0),jpk) , INTENT(in) :: pvflx ! 3D input array of advection/diffusion
REAL(wp), DIMENSION(A1Dj(0),nbasin) :: zsj !
INTEGER :: jn !
@@ -684,8 +684,8 @@ CONTAINS
!! ** Action : - p_fval: i-k-mean poleward flux of pvflx
!!----------------------------------------------------------------------
! TODO: Can be A2D(0) once all dia_ptr_hst calls have arguments with consistent declarations
- REAL(wp), INTENT(in), DIMENSION(A2D(nn_hls),jpk) :: pvflx ! mask flux array at V-point
- REAL(wp), INTENT(in), DIMENSION(jpi,jpj ) :: pmsk ! Optional 2D basin mask
+ REAL(wp), INTENT(in), DIMENSION(A2D(0),jpk) :: pvflx ! mask flux array at V-point
+ REAL(wp), INTENT(in), DIMENSION(jpi,jpj ) :: pmsk ! Optional 2D basin mask
!
INTEGER :: ji, jj, jk ! dummy loop arguments
REAL(wp), DIMENSION(A1Dj(0)) :: p_fval ! function value
@@ -710,8 +710,8 @@ CONTAINS
!! ** Action : - p_fval: i-k-mean poleward flux of pvflx
!!----------------------------------------------------------------------
! TODO: Can be A2D(0) once all dia_ptr_hst calls have arguments with consistent declarations
- REAL(wp) , INTENT(in), DIMENSION(A2D(nn_hls)) :: pvflx ! mask flux array at V-point
- REAL(wp) , INTENT(in), DIMENSION(jpi,jpj ) :: pmsk ! Optional 2D basin mask
+ REAL(wp) , INTENT(in), DIMENSION(A2D(0) ) :: pvflx ! mask flux array at V-point
+ REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pmsk ! Optional 2D basin mask
!
INTEGER :: ji, jj ! dummy loop arguments
REAL(wp), DIMENSION(A1Dj(0)) :: p_fval ! function value
diff --git a/src/OCE/DIA/diawri.F90 b/src/OCE/DIA/diawri.F90
index b6dd96cda19a4e732d5ebd42b19f7a03420a1324..cf3c014ad3f5cffd0a38eaae84452edafcd8ee52 100644
--- a/src/OCE/DIA/diawri.F90
+++ b/src/OCE/DIA/diawri.F90
@@ -122,8 +122,9 @@ CONTAINS
REAL(wp):: zztmp , zztmpx ! local scalar
REAL(wp):: zztmp2, zztmpy ! - -
REAL(wp):: ze3
- REAL(wp), DIMENSION(A2D( 0)) :: z2d ! 2D workspace
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: z3d ! 3D workspace
+ REAL(wp), DIMENSION(A2D(0)) :: z2d0 ! 2D workspace
+ REAL(wp), DIMENSION(A2D(0) ,jpk) :: z3d0 ! 3D workspace
+ REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: z3d ! 3D workspace
!!----------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('dia_wri')
@@ -135,8 +136,9 @@ CONTAINS
ENDIF
! initialize arrays
- z2d(A2D(0)) = 0._wp
- z3d(A2D(0),:) = 0._wp
+ z2d0(:,:) = 0._wp
+ z3d0(:,:,:) = 0._wp
+ z3d (:,:,:) = 0._wp
! Output of initial vertical scale factor
CALL iom_put("e3t_0", e3t_0(:,:,:) )
@@ -146,44 +148,44 @@ CONTAINS
!
IF ( iom_use("tpt_dep") ) THEN
DO_3D( 0, 0, 0, 0, 1, jpk )
- z3d(ji,jj,jk) = gdept(ji,jj,jk,Kmm)
+ z3d0(ji,jj,jk) = gdept(ji,jj,jk,Kmm)
END_3D
- CALL iom_put( "tpt_dep", z3d )
+ CALL iom_put( "tpt_dep", z3d0 )
ENDIF
! --- vertical scale factors --- !
IF ( iom_use("e3t") .OR. iom_use("e3tdef") ) THEN ! time-varying e3t
- DO_3D( 0, 0, 0, 0, 1, jpk )
+ DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
z3d(ji,jj,jk) = e3t(ji,jj,jk,Kmm)
END_3D
CALL iom_put( "e3t", z3d )
IF ( iom_use("e3tdef") ) THEN
- DO_3D( 0, 0, 0, 0, 1, jpk )
+ DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
z3d(ji,jj,jk) = ( ( z3d(ji,jj,jk) - e3t_0(ji,jj,jk) ) / e3t_0(ji,jj,jk) * 100._wp * tmask(ji,jj,jk) ) ** 2
END_3D
CALL iom_put( "e3tdef", z3d )
ENDIF
ENDIF
IF ( iom_use("e3u") ) THEN ! time-varying e3u
- DO_3D( 0, 0, 0, 0, 1, jpk )
+ DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 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_3D( 0, 0, 0, 0, 1, jpk )
+ DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
z3d(ji,jj,jk) = e3v(ji,jj,jk,Kmm)
END_3D
CALL iom_put( "e3v" , z3d )
ENDIF
IF ( iom_use("e3w") ) THEN ! time-varying e3w
- DO_3D( 0, 0, 0, 0, 1, jpk )
+ DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
z3d(ji,jj,jk) = e3w(ji,jj,jk,Kmm)
END_3D
CALL iom_put( "e3w" , z3d )
ENDIF
IF ( iom_use("e3f") ) THEN ! time-varying e3f caution here at Kaa
- DO_3D( 0, 0, 0, 0, 1, jpk )
+ DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
z3d(ji,jj,jk) = e3f(ji,jj,jk)
END_3D
CALL iom_put( "e3f" , z3d )
@@ -213,9 +215,9 @@ CONTAINS
IF ( iom_use("sbt") ) THEN
DO_2D( 0, 0, 0, 0 )
ikbot = mbkt(ji,jj)
- z2d(ji,jj) = ts(ji,jj,ikbot,jp_tem,Kmm)
+ z2d0(ji,jj) = ts(ji,jj,ikbot,jp_tem,Kmm)
END_2D
- CALL iom_put( "sbt", z2d ) ! bottom temperature
+ CALL iom_put( "sbt", z2d0 ) ! bottom temperature
ENDIF
CALL iom_put( "soce", ts(:,:,:,jp_sal,Kmm) ) ! 3D salinity
@@ -223,9 +225,9 @@ CONTAINS
IF ( iom_use("sbs") ) THEN
DO_2D( 0, 0, 0, 0 )
ikbot = mbkt(ji,jj)
- z2d(ji,jj) = ts(ji,jj,ikbot,jp_sal,Kmm)
+ z2d0(ji,jj) = ts(ji,jj,ikbot,jp_sal,Kmm)
END_2D
- CALL iom_put( "sbs", z2d ) ! bottom salinity
+ CALL iom_put( "sbs", z2d0 ) ! bottom salinity
ENDIF
IF( .NOT.lk_SWE ) CALL iom_put( "rhop", rhop(:,:,:) ) ! 3D potential density (sigma0)
@@ -233,16 +235,16 @@ CONTAINS
! --- momentum --- !
IF ( iom_use("taubot") ) THEN ! bottom stress
zztmp = rho0 * 0.25_wp
- z2d(:,:) = 0._wp
+ z2d0(:,:) = 0._wp
DO_2D( 0, 0, 0, 0 )
zztmp2 = ( ( rCdU_bot(ji+1,jj)+rCdU_bot(ji ,jj) ) * uu(ji ,jj,mbku(ji ,jj),Kmm) )**2 &
& + ( ( rCdU_bot(ji ,jj)+rCdU_bot(ji-1,jj) ) * uu(ji-1,jj,mbku(ji-1,jj),Kmm) )**2 &
& + ( ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj ) ) * vv(ji,jj ,mbkv(ji,jj ),Kmm) )**2 &
& + ( ( rCdU_bot(ji,jj )+rCdU_bot(ji,jj-1) ) * vv(ji,jj-1,mbkv(ji,jj-1),Kmm) )**2
- z2d(ji,jj) = zztmp * SQRT( zztmp2 ) * tmask(ji,jj,1)
+ z2d0(ji,jj) = zztmp * SQRT( zztmp2 ) * tmask(ji,jj,1)
!
END_2D
- CALL iom_put( "taubot", z2d )
+ CALL iom_put( "taubot", z2d0 )
ENDIF
CALL iom_put( "uoce", uu(:,:,:,Kmm) ) ! 3D i-current
@@ -250,9 +252,9 @@ CONTAINS
IF ( iom_use("sbu") ) THEN
DO_2D( 0, 0, 0, 0 )
ikbot = mbku(ji,jj)
- z2d(ji,jj) = uu(ji,jj,ikbot,Kmm)
+ z2d0(ji,jj) = uu(ji,jj,ikbot,Kmm)
END_2D
- CALL iom_put( "sbu", z2d ) ! bottom i-current
+ CALL iom_put( "sbu", z2d0 ) ! bottom i-current
ENDIF
CALL iom_put( "voce", vv(:,:,:,Kmm) ) ! 3D j-current
@@ -260,18 +262,15 @@ CONTAINS
IF ( iom_use("sbv") ) THEN
DO_2D( 0, 0, 0, 0 )
ikbot = mbkv(ji,jj)
- z2d(ji,jj) = vv(ji,jj,ikbot,Kmm)
+ z2d0(ji,jj) = vv(ji,jj,ikbot,Kmm)
END_2D
- CALL iom_put( "sbv", z2d ) ! bottom j-current
+ CALL iom_put( "sbv", z2d0 ) ! bottom j-current
ENDIF
! ! vertical velocity
IF( ln_zad_Aimp ) THEN
IF( iom_use('woce') ) THEN
- DO_3D( 0, 0, 0, 0, 1, jpk )
- z3d(ji,jj,jk) = ww(ji,jj,jk) + wi(ji,jj,jk)
- END_3D
- CALL iom_put( "woce", z3d ) ! explicit plus implicit parts
+ CALL iom_put( "woce", ww+wi ) ! explicit plus implicit parts
ENDIF
ELSE
CALL iom_put( "woce", ww )
@@ -281,15 +280,15 @@ CONTAINS
! ! Caution: in the VVL case, it only correponds to the baroclinic mass transport.
IF( ln_zad_Aimp ) THEN
DO_3D( 0, 0, 0, 0, 1, jpk )
- z3d(ji,jj,jk) = rho0 * e1e2t(ji,jj) * ( ww(ji,jj,jk) + wi(ji,jj,jk) )
+ z3d0(ji,jj,jk) = rho0 * e1e2t(ji,jj) * ( ww(ji,jj,jk) + wi(ji,jj,jk) )
END_3D
ELSE
DO_3D( 0, 0, 0, 0, 1, jpk )
- z3d(ji,jj,jk) = rho0 * e1e2t(ji,jj) * ww(ji,jj,jk)
+ z3d0(ji,jj,jk) = rho0 * e1e2t(ji,jj) * ww(ji,jj,jk)
END_3D
ENDIF
- CALL iom_put( "w_masstr" , z3d )
- IF( iom_use('w_masstr2') ) CALL iom_put( "w_masstr2", z3d * z3d )
+ CALL iom_put( "w_masstr" , z3d0 )
+ IF( iom_use('w_masstr2') ) CALL iom_put( "w_masstr2", z3d0 * z3d0 )
ENDIF
CALL iom_put( "avt" , avt ) ! T vert. eddy diff. coef.
@@ -304,15 +303,15 @@ CONTAINS
zztmp = ts(ji,jj,1,jp_sal,Kmm)
zztmpx = (ts(ji+1,jj,1,jp_sal,Kmm) - zztmp) * r1_e1u(ji,jj) + (zztmp - ts(ji-1,jj ,1,jp_sal,Kmm)) * r1_e1u(ji-1,jj)
zztmpy = (ts(ji,jj+1,1,jp_sal,Kmm) - zztmp) * r1_e2v(ji,jj) + (zztmp - ts(ji ,jj-1,1,jp_sal,Kmm)) * r1_e2v(ji,jj-1)
- z2d(ji,jj) = 0.25_wp * ( zztmpx * zztmpx + zztmpy * zztmpy ) &
+ z2d0(ji,jj) = 0.25_wp * ( zztmpx * zztmpx + zztmpy * zztmpy ) &
& * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * vmask(ji,jj-1,1)
END_2D
- CALL iom_put( "sssgrad2", z2d ) ! square of module of sss gradient
+ CALL iom_put( "sssgrad2", z2d0 ) ! square of module of sss gradient
IF ( iom_use("sssgrad") ) THEN
DO_2D( 0, 0, 0, 0 )
- z2d(ji,jj) = SQRT( z2d(ji,jj) )
+ z2d0(ji,jj) = SQRT( z2d0(ji,jj) )
END_2D
- CALL iom_put( "sssgrad", z2d ) ! module of sss gradient
+ CALL iom_put( "sssgrad", z2d0 ) ! module of sss gradient
ENDIF
ENDIF
@@ -321,80 +320,80 @@ CONTAINS
zztmp = ts(ji,jj,1,jp_tem,Kmm)
zztmpx = ( ts(ji+1,jj,1,jp_tem,Kmm) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - ts(ji-1,jj ,1,jp_tem,Kmm) ) * r1_e1u(ji-1,jj)
zztmpy = ( ts(ji,jj+1,1,jp_tem,Kmm) - zztmp ) * r1_e2v(ji,jj) + ( zztmp - ts(ji ,jj-1,1,jp_tem,Kmm) ) * r1_e2v(ji,jj-1)
- z2d(ji,jj) = 0.25_wp * ( zztmpx * zztmpx + zztmpy * zztmpy ) &
+ z2d0(ji,jj) = 0.25_wp * ( zztmpx * zztmpx + zztmpy * zztmpy ) &
& * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * vmask(ji,jj-1,1)
END_2D
- CALL iom_put( "sstgrad2", z2d ) ! square of module of sst gradient
+ CALL iom_put( "sstgrad2", z2d0 ) ! square of module of sst gradient
IF ( iom_use("sstgrad") ) THEN
DO_2D( 0, 0, 0, 0 )
- z2d(ji,jj) = SQRT( z2d(ji,jj) )
+ z2d0(ji,jj) = SQRT( z2d0(ji,jj) )
END_2D
- CALL iom_put( "sstgrad", z2d ) ! module of sst gradient
+ CALL iom_put( "sstgrad", z2d0 ) ! module of sst gradient
ENDIF
ENDIF
! heat and salt contents
IF( iom_use("heatc") ) THEN
- z2d(:,:) = 0._wp
+ z2d0(:,:) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
- z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm) * tmask(ji,jj,jk)
+ z2d0(ji,jj) = z2d0(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm) * tmask(ji,jj,jk)
END_3D
- CALL iom_put( "heatc", rho0_rcp * z2d ) ! vertically integrated heat content (J/m2)
+ CALL iom_put( "heatc", rho0_rcp * z2d0 ) ! vertically integrated heat content (J/m2)
ENDIF
IF( iom_use("saltc") ) THEN
- z2d(:,:) = 0._wp
+ z2d0(:,:) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
- z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * tmask(ji,jj,jk)
+ z2d0(ji,jj) = z2d0(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * tmask(ji,jj,jk)
END_3D
- CALL iom_put( "saltc", rho0 * z2d ) ! vertically integrated salt content (PSU*kg/m2)
+ CALL iom_put( "saltc", rho0 * z2d0 ) ! vertically integrated salt content (PSU*kg/m2)
ENDIF
!
IF( iom_use("salt2c") ) THEN
- z2d(:,:) = 0._wp
+ z2d0(:,:) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
- z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * tmask(ji,jj,jk)
+ z2d0(ji,jj) = z2d0(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * tmask(ji,jj,jk)
END_3D
- CALL iom_put( "salt2c", rho0 * z2d ) ! vertically integrated square of salt content (PSU2*kg/m2)
+ CALL iom_put( "salt2c", rho0 * z2d0 ) ! vertically integrated square of salt content (PSU2*kg/m2)
ENDIF
!
IF ( iom_use("ke") .OR. iom_use("ke_int") ) THEN
DO_3D( 0, 0, 0, 0, 1, jpk )
zztmpx = uu(ji-1,jj ,jk,Kmm) + uu(ji,jj,jk,Kmm)
zztmpy = vv(ji ,jj-1,jk,Kmm) + vv(ji,jj,jk,Kmm)
- z3d(ji,jj,jk) = 0.25_wp * ( zztmpx*zztmpx + zztmpy*zztmpy )
+ z3d0(ji,jj,jk) = 0.25_wp * ( zztmpx*zztmpx + zztmpy*zztmpy )
END_3D
- CALL iom_put( "ke", z3d ) ! kinetic energy
+ CALL iom_put( "ke", z3d0 ) ! kinetic energy
- z2d(:,:) = 0._wp
+ z2d0(:,:) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
- z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * z3d(ji,jj,jk) * e1e2t(ji,jj) * tmask(ji,jj,jk)
+ z2d0(ji,jj) = z2d0(ji,jj) + e3t(ji,jj,jk,Kmm) * z3d0(ji,jj,jk) * e1e2t(ji,jj) * tmask(ji,jj,jk)
END_3D
- CALL iom_put( "ke_int", z2d ) ! vertically integrated kinetic energy
+ CALL iom_put( "ke_int", z2d0 ) ! vertically integrated kinetic energy
ENDIF
!
IF ( iom_use("sKE") ) THEN ! surface kinetic energy at T point
- z2d(:,:) = 0._wp
+ z2d0(:,:) = 0._wp
DO_2D( 0, 0, 0, 0 )
- z2d(ji,jj) = 0.25_wp * ( uu(ji ,jj,1,Kmm) * uu(ji ,jj,1,Kmm) * e1e2u(ji ,jj) * e3u(ji ,jj,1,Kmm) &
+ z2d0(ji,jj) = 0.25_wp * ( uu(ji ,jj,1,Kmm) * uu(ji ,jj,1,Kmm) * e1e2u(ji ,jj) * e3u(ji ,jj,1,Kmm) &
& + uu(ji-1,jj,1,Kmm) * uu(ji-1,jj,1,Kmm) * e1e2u(ji-1,jj) * e3u(ji-1,jj,1,Kmm) &
& + vv(ji,jj ,1,Kmm) * vv(ji,jj ,1,Kmm) * e1e2v(ji,jj ) * e3v(ji,jj ,1,Kmm) &
& + vv(ji,jj-1,1,Kmm) * vv(ji,jj-1,1,Kmm) * e1e2v(ji,jj-1) * e3v(ji,jj-1,1,Kmm) ) &
& * r1_e1e2t(ji,jj) / e3t(ji,jj,1,Kmm) * ssmask(ji,jj)
END_2D
- IF ( iom_use("sKE" ) ) CALL iom_put( "sKE" , z2d )
+ IF ( iom_use("sKE" ) ) CALL iom_put( "sKE" , z2d0 )
ENDIF
!
IF ( iom_use("ssKEf") ) THEN ! surface kinetic energy at F point
- z2d(:,:) = 0._wp ! CAUTION : only valid in SWE, not with bathymetry
+ z2d0(:,:) = 0._wp ! CAUTION : only valid in SWE, not with bathymetry
DO_2D( 0, 0, 0, 0 )
- z2d(ji,jj) = 0.25_wp * ( uu(ji,jj ,1,Kmm) * uu(ji,jj ,1,Kmm) * e1e2u(ji,jj ) * e3u(ji,jj ,1,Kmm) &
+ z2d0(ji,jj) = 0.25_wp * ( uu(ji,jj ,1,Kmm) * uu(ji,jj ,1,Kmm) * e1e2u(ji,jj ) * e3u(ji,jj ,1,Kmm) &
& + uu(ji,jj+1,1,Kmm) * uu(ji,jj+1,1,Kmm) * e1e2u(ji,jj+1) * e3u(ji,jj+1,1,Kmm) &
& + vv(ji ,jj,1,Kmm) * vv(ji,jj ,1,Kmm) * e1e2v(ji ,jj) * e3v(ji ,jj,1,Kmm) &
& + vv(ji+1,jj,1,Kmm) * vv(ji+1,jj,1,Kmm) * e1e2v(ji+1,jj) * e3v(ji+1,jj,1,Kmm) ) &
& * r1_e1e2f(ji,jj) / e3f(ji,jj,1) * ssfmask(ji,jj)
END_2D
- CALL iom_put( "ssKEf", z2d )
+ CALL iom_put( "ssKEf", z2d0 )
ENDIF
!
CALL iom_put( "hdiv", hdiv ) ! Horizontal divergence
@@ -402,31 +401,31 @@ CONTAINS
IF( iom_use("u_masstr") .OR. iom_use("u_masstr_vint") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN
DO_3D( 0, 0, 0, 0, 1, jpk )
- z3d(ji,jj,jk) = rho0 * uu(ji,jj,jk,Kmm) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * umask(ji,jj,jk)
+ z3d0(ji,jj,jk) = rho0 * uu(ji,jj,jk,Kmm) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * umask(ji,jj,jk)
END_3D
- CALL iom_put( "u_masstr" , z3d ) ! mass transport in i-direction
+ CALL iom_put( "u_masstr" , z3d0 ) ! mass transport in i-direction
IF( iom_use("u_masstr_vint") ) THEN
- z2d(:,:) = 0._wp
+ z2d0(:,:) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
- z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk)
+ z2d0(ji,jj) = z2d0(ji,jj) + z3d0(ji,jj,jk)
END_3D
- CALL iom_put( "u_masstr_vint", z2d ) ! mass transport in i-direction vertical sum
+ CALL iom_put( "u_masstr_vint", z2d0 ) ! mass transport in i-direction vertical sum
ENDIF
IF( iom_use("u_heattr") ) THEN
- z2d(:,:) = 0._wp
+ z2d0(:,:) = 0._wp
zztmp = 0.5_wp * rcp
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
- z2d(ji,jj) = z2d(ji,jj) + zztmp * z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji+1,jj,jk,jp_tem,Kmm) )
+ z2d0(ji,jj) = z2d0(ji,jj) + zztmp * z3d0(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji+1,jj,jk,jp_tem,Kmm) )
END_3D
- CALL iom_put( "u_heattr", z2d ) ! heat transport in i-direction
+ CALL iom_put( "u_heattr", z2d0 ) ! heat transport in i-direction
ENDIF
IF( iom_use("u_salttr") ) THEN
- z2d(:,:) = 0._wp
+ z2d0(:,:) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
- z2d(ji,jj) = z2d(ji,jj) + 0.5 * z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji+1,jj,jk,jp_sal,Kmm) )
+ z2d0(ji,jj) = z2d0(ji,jj) + 0.5 * z3d0(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji+1,jj,jk,jp_sal,Kmm) )
END_3D
- CALL iom_put( "u_salttr", z2d ) ! heat transport in i-direction
+ CALL iom_put( "u_salttr", z2d0 ) ! heat transport in i-direction
ENDIF
ENDIF
@@ -434,41 +433,41 @@ CONTAINS
IF( iom_use("v_masstr") .OR. iom_use("v_heattr") .OR. iom_use("v_salttr") ) THEN
DO_3D( 0, 0, 0, 0, 1, jpk )
- z3d(ji,jj,jk) = rho0 * vv(ji,jj,jk,Kmm) * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * vmask(ji,jj,jk)
+ z3d0(ji,jj,jk) = rho0 * vv(ji,jj,jk,Kmm) * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * vmask(ji,jj,jk)
END_3D
- CALL iom_put( "v_masstr", z3d ) ! mass transport in j-direction
+ CALL iom_put( "v_masstr", z3d0 ) ! mass transport in j-direction
IF( iom_use("v_heattr") ) THEN
- z2d(:,:) = 0._wp
+ z2d0(:,:) = 0._wp
zztmp = 0.5_wp * rcp
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
- z2d(ji,jj) = z2d(ji,jj) + zztmp * z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji,jj+1,jk,jp_tem,Kmm) )
+ z2d0(ji,jj) = z2d0(ji,jj) + zztmp * z3d0(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji,jj+1,jk,jp_tem,Kmm) )
END_3D
- CALL iom_put( "v_heattr", z2d ) ! heat transport in j-direction
+ CALL iom_put( "v_heattr", z2d0 ) ! heat transport in j-direction
ENDIF
IF( iom_use("v_salttr") ) THEN
- z2d(:,:) = 0._wp
+ z2d0(:,:) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
- z2d(ji,jj) = z2d(ji,jj) + 0.5 * z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji,jj+1,jk,jp_sal,Kmm) )
+ z2d0(ji,jj) = z2d0(ji,jj) + 0.5 * z3d0(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji,jj+1,jk,jp_sal,Kmm) )
END_3D
- CALL iom_put( "v_salttr", z2d ) ! heat transport in j-direction
+ CALL iom_put( "v_salttr", z2d0 ) ! heat transport in j-direction
ENDIF
ENDIF
IF( iom_use("tosmint") ) THEN
- z2d(:,:) = 0._wp
+ z2d0(:,:) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
- z2d(ji,jj) = z2d(ji,jj) + rho0 * e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm)
+ z2d0(ji,jj) = z2d0(ji,jj) + rho0 * e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm)
END_3D
- CALL iom_put( "tosmint", z2d ) ! Vertical integral of temperature
+ CALL iom_put( "tosmint", z2d0 ) ! Vertical integral of temperature
ENDIF
IF( iom_use("somint") ) THEN
- z2d(:,:) = 0._wp
+ z2d0(:,:) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
- z2d(ji,jj) = z2d(ji,jj) + rho0 * e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm)
+ z2d0(ji,jj) = z2d0(ji,jj) + rho0 * e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm)
END_3D
- CALL iom_put( "somint", z2d ) ! Vertical integral of salinity
+ CALL iom_put( "somint", z2d0 ) ! Vertical integral of salinity
ENDIF
CALL iom_put( "bn2", rn2 ) ! Brunt-Vaisala buoyancy frequency (N^2)
@@ -477,45 +476,47 @@ CONTAINS
! Output of surface vorticity terms
!
- CALL iom_put( "ssplavor", ff_f ) ! planetary vorticity ( f )
- !
- IF ( iom_use("ssrelvor") .OR. iom_use("ssEns") .OR. &
+ IF ( iom_use("ssplavor") .OR. iom_use("ssrelvor") .OR. iom_use("ssEns") .OR. &
& iom_use("ssrelpotvor") .OR. iom_use("ssabspotvor") ) THEN
!
- z2d(:,:) = 0._wp
DO_2D( 0, 0, 0, 0 )
- z2d(ji,jj) = ( e2v(ji+1,jj ) * vv(ji+1,jj ,1,Kmm) - e2v(ji,jj) * vv(ji,jj,1,Kmm) &
+ z2d0(ji,jj) = ff_f(ji,jj)
+ END_2D
+ CALL iom_put( "ssplavor", z2d0 ) ! planetary vorticity ( f )
+
+ DO_2D( 0, 0, 0, 0 )
+ z2d0(ji,jj) = ( e2v(ji+1,jj ) * vv(ji+1,jj ,1,Kmm) - e2v(ji,jj) * vv(ji,jj,1,Kmm) &
& - e1u(ji ,jj+1) * uu(ji ,jj+1,1,Kmm) + e1u(ji,jj) * uu(ji,jj,1,Kmm) ) * r1_e1e2f(ji,jj)
END_2D
- CALL iom_put( "ssrelvor", z2d ) ! relative vorticity ( zeta )
+ CALL iom_put( "ssrelvor", z2d0 ) ! relative vorticity ( zeta )
!
IF ( iom_use("ssEns") .OR. iom_use("ssrelpotvor") .OR. iom_use("ssabspotvor") ) THEN
DO_2D( 0, 0, 0, 0 )
ze3 = ( e3t(ji,jj+1,1,Kmm) * e1e2t(ji,jj+1) + e3t(ji+1,jj+1,1,Kmm) * e1e2t(ji+1,jj+1) &
- & + e3t(ji,jj ,1,Kmm) * e1e2t(ji,jj ) + e3t(ji+1,jj ,1,Kmm) * e1e2t(ji+1,jj ) ) * r1_e1e2f(ji,jj)
+ & + e3t(ji,jj ,1,Kmm) * e1e2t(ji,jj ) + e3t(ji+1,jj ,1,Kmm) * e1e2t(ji+1,jj ) ) * r1_e1e2f(ji,jj)
IF( ze3 /= 0._wp ) THEN ; ze3 = 4._wp / ze3
ELSE ; ze3 = 0._wp
ENDIF
- z2d(ji,jj) = ze3 * z2d(ji,jj)
+ z2d0(ji,jj) = ze3 * z2d0(ji,jj)
END_2D
- CALL iom_put( "ssrelpotvor", z2d ) ! relative potential vorticity (zeta/h)
+ CALL iom_put( "ssrelpotvor", z2d0 ) ! relative potential vorticity (zeta/h)
!
IF ( iom_use("ssEns") .OR. iom_use("ssabspotvor") ) THEN
DO_2D( 0, 0, 0, 0 )
ze3 = ( e3t(ji,jj+1,1,Kmm) * e1e2t(ji,jj+1) + e3t(ji+1,jj+1,1,Kmm) * e1e2t(ji+1,jj+1) &
- & + e3t(ji,jj ,1,Kmm) * e1e2t(ji,jj ) + e3t(ji+1,jj ,1,Kmm) * e1e2t(ji+1,jj ) ) * r1_e1e2f(ji,jj)
+ & + e3t(ji,jj ,1,Kmm) * e1e2t(ji,jj ) + e3t(ji+1,jj ,1,Kmm) * e1e2t(ji+1,jj ) ) * r1_e1e2f(ji,jj)
IF( ze3 /= 0._wp ) THEN ; ze3 = 4._wp / ze3
ELSE ; ze3 = 0._wp
ENDIF
- z2d(ji,jj) = ze3 * ff_f(ji,jj) + z2d(ji,jj)
+ z2d0(ji,jj) = ze3 * ff_f(ji,jj) + z2d0(ji,jj)
END_2D
- CALL iom_put( "ssabspotvor", z2d ) ! absolute potential vorticity ( q )
+ CALL iom_put( "ssabspotvor", z2d0 ) ! absolute potential vorticity ( q )
!
IF ( iom_use("ssEns") ) THEN
DO_2D( 0, 0, 0, 0 )
- z2d(ji,jj) = 0.5_wp * z2d(ji,jj) * z2d(ji,jj)
+ z2d0(ji,jj) = 0.5_wp * z2d0(ji,jj) * z2d0(ji,jj)
END_2D
- CALL iom_put( "ssEns", z2d ) ! potential enstrophy ( 1/2*q2 )
+ CALL iom_put( "ssEns", z2d0 ) ! potential enstrophy ( 1/2*q2 )
ENDIF
ENDIF
ENDIF
@@ -582,8 +583,8 @@ CONTAINS
INTEGER :: jn, ierror ! local integers
REAL(wp) :: zsto, zout, zmax, zjulian ! local scalars
!
- REAL(wp), DIMENSION(jpi,jpj ) :: z2d ! 2D workspace
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d ! 3D workspace
+ REAL(wp), DIMENSION(jpi,jpj ) :: z2d0 ! 2D workspace
+ REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d0 ! 3D workspace
REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zw3d_abl ! ABL 3D workspace
!!----------------------------------------------------------------------
!
@@ -935,21 +936,21 @@ CONTAINS
IF( .NOT.ln_linssh ) THEN
DO_3D( 0, 0, 0, 0, 1, jpk )
- z3d(ji,jj,jk) = ts(ji,jj,jk,jp_tem,Kmm) * e3t(ji,jj,jk,Kmm)
+ z3d0(ji,jj,jk) = ts(ji,jj,jk,jp_tem,Kmm) * e3t(ji,jj,jk,Kmm)
END_3D
- CALL histwrite( nid_T, "votemper", it, z3d, ndim_T , ndex_T ) ! heat content
+ CALL histwrite( nid_T, "votemper", it, z3d0, ndim_T , ndex_T ) ! heat content
DO_3D( 0, 0, 0, 0, 1, jpk )
- z3d(ji,jj,jk) = ts(ji,jj,jk,jp_sal,Kmm) * e3t(ji,jj,jk,Kmm)
+ z3d0(ji,jj,jk) = ts(ji,jj,jk,jp_sal,Kmm) * e3t(ji,jj,jk,Kmm)
END_3D
- CALL histwrite( nid_T, "vosaline", it, z3d, ndim_T , ndex_T ) ! salt content
+ CALL histwrite( nid_T, "vosaline", it, z3d0, ndim_T , ndex_T ) ! salt content
DO_2D( 0, 0, 0, 0 )
- z2d(ji,jj ) = ts(ji,jj, 1,jp_tem,Kmm) * e3t(ji,jj, 1,Kmm)
+ z2d0(ji,jj ) = ts(ji,jj, 1,jp_tem,Kmm) * e3t(ji,jj, 1,Kmm)
END_2D
- CALL histwrite( nid_T, "sosstsst", it, z2d, ndim_hT, ndex_hT ) ! sea surface heat content
+ CALL histwrite( nid_T, "sosstsst", it, z2d0, ndim_hT, ndex_hT ) ! sea surface heat content
DO_2D( 0, 0, 0, 0 )
- z2d(ji,jj ) = ts(ji,jj, 1,jp_sal,Kmm) * e3t(ji,jj, 1,Kmm)
+ z2d0(ji,jj ) = ts(ji,jj, 1,jp_sal,Kmm) * e3t(ji,jj, 1,Kmm)
END_2D
- CALL histwrite( nid_T, "sosaline", it, z2d, ndim_hT, ndex_hT ) ! sea surface salinity content
+ CALL histwrite( nid_T, "sosaline", it, z2d0, ndim_hT, ndex_hT ) ! sea surface salinity content
ELSE
CALL histwrite( nid_T, "votemper", it, ts(:,:,:,jp_tem,Kmm) , ndim_T , ndex_T ) ! temperature
CALL histwrite( nid_T, "vosaline", it, ts(:,:,:,jp_sal,Kmm) , ndim_T , ndex_T ) ! salinity
@@ -958,41 +959,41 @@ CONTAINS
ENDIF
IF( .NOT.ln_linssh ) THEN
DO_3D( 0, 0, 0, 0, 1, jpk )
- z3d(ji,jj,jk) = e3t(ji,jj,jk,Kmm) ! 3D workspace for qco substitution
+ z3d0(ji,jj,jk) = e3t(ji,jj,jk,Kmm) ! 3D workspace for qco substitution
END_3D
- CALL histwrite( nid_T, "vovvle3t", it, z3d , ndim_T , ndex_T ) ! level thickness
+ CALL histwrite( nid_T, "vovvle3t", it, z3d0 , ndim_T , ndex_T ) ! level thickness
DO_3D( 0, 0, 0, 0, 1, jpk )
- z3d(ji,jj,jk) = gdept(ji,jj,jk,Kmm) ! 3D workspace for qco substitution
+ z3d0(ji,jj,jk) = gdept(ji,jj,jk,Kmm) ! 3D workspace for qco substitution
END_3D
- CALL histwrite( nid_T, "vovvldep", it, z3d , ndim_T , ndex_T ) ! t-point depth
+ CALL histwrite( nid_T, "vovvldep", it, z3d0 , ndim_T , ndex_T ) ! t-point depth
DO_3D( 0, 0, 0, 0, 1, jpk )
- z3d(ji,jj,jk) = ( ( e3t(ji,jj,jk,Kmm) - e3t_0(ji,jj,jk) ) / e3t_0(ji,jj,jk) * 100._wp * tmask(ji,jj,jk) ) ** 2
+ z3d0(ji,jj,jk) = ( ( e3t(ji,jj,jk,Kmm) - e3t_0(ji,jj,jk) ) / e3t_0(ji,jj,jk) * 100._wp * tmask(ji,jj,jk) ) ** 2
END_3D
- CALL histwrite( nid_T, "vovvldef", it, z3d , ndim_T , ndex_T ) ! level thickness deformation
+ CALL histwrite( nid_T, "vovvldef", it, z3d0 , ndim_T , ndex_T ) ! level thickness deformation
ENDIF
CALL histwrite( nid_T, "sossheig", it, ssh(:,:,Kmm) , ndim_hT, ndex_hT ) ! sea surface height
DO_2D( 0, 0, 0, 0 )
- z2d(ji,jj) = emp(ji,jj) - rnf(ji,jj)
+ z2d0(ji,jj) = emp(ji,jj) - rnf(ji,jj)
END_2D
- CALL histwrite( nid_T, "sowaflup", it, z2d , ndim_hT, ndex_hT ) ! upward water flux
+ CALL histwrite( nid_T, "sowaflup", it, z2d0 , ndim_hT, ndex_hT ) ! upward water flux
CALL histwrite( nid_T, "sorunoff", it, rnf , ndim_hT, ndex_hT ) ! river runoffs
CALL histwrite( nid_T, "sosfldow", it, sfx , ndim_hT, ndex_hT ) ! downward salt flux
! (includes virtual salt flux beneath ice
! in linear free surface case)
IF( ln_linssh ) THEN
DO_2D( 0, 0, 0, 0 )
- z2d(ji,jj) = emp (ji,jj) * ts(ji,jj,1,jp_tem,Kmm)
+ z2d0(ji,jj) = emp (ji,jj) * ts(ji,jj,1,jp_tem,Kmm)
END_2D
- CALL histwrite( nid_T, "sosst_cd", it, z2d, ndim_hT, ndex_hT ) ! c/d term on sst
+ CALL histwrite( nid_T, "sosst_cd", it, z2d0, ndim_hT, ndex_hT ) ! c/d term on sst
DO_2D( 0, 0, 0, 0 )
- z2d(ji,jj) = emp (ji,jj) * ts(ji,jj,1,jp_sal,Kmm)
+ z2d0(ji,jj) = emp (ji,jj) * ts(ji,jj,1,jp_sal,Kmm)
END_2D
- CALL histwrite( nid_T, "sosss_cd", it, z2d, ndim_hT, ndex_hT ) ! c/d term on sss
+ CALL histwrite( nid_T, "sosss_cd", it, z2d0, ndim_hT, ndex_hT ) ! c/d term on sss
ENDIF
DO_2D( 0, 0, 0, 0 )
- z2d(ji,jj) = qsr(ji,jj) + qns(ji,jj)
+ z2d0(ji,jj) = qsr(ji,jj) + qns(ji,jj)
END_2D
- CALL histwrite( nid_T, "sohefldo", it, z2d , ndim_hT, ndex_hT ) ! total heat flux
+ CALL histwrite( nid_T, "sohefldo", it, z2d0 , ndim_hT, ndex_hT ) ! total heat flux
CALL histwrite( nid_T, "soshfldo", it, qsr , ndim_hT, ndex_hT ) ! solar heat flux
IF( ALLOCATED(hmld) ) THEN ! zdf_mxl not called by SWE
CALL histwrite( nid_T, "somixhgt", it, hmld , ndim_hT, ndex_hT ) ! turbocline depth
@@ -1051,9 +1052,9 @@ CONTAINS
CALL histwrite( nid_T, "sohefldp", it, qrp , ndim_hT, ndex_hT ) ! heat flux damping
CALL histwrite( nid_T, "sowafldp", it, erp , ndim_hT, ndex_hT ) ! freshwater flux damping
DO_2D( 0, 0, 0, 0 )
- z2d(ji,jj) = erp(ji,jj) * ts(ji,jj,1,jp_sal,Kmm) * tmask(ji,jj,1)
+ z2d0(ji,jj) = erp(ji,jj) * ts(ji,jj,1,jp_sal,Kmm) * tmask(ji,jj,1)
END_2D
- CALL histwrite( nid_T, "sosafldp", it, z2d , ndim_hT, ndex_hT ) ! salt flux damping
+ CALL histwrite( nid_T, "sosafldp", it, z2d0 , ndim_hT, ndex_hT ) ! salt flux damping
ENDIF
! zw2d(:,:) = FLOAT( nmln(:,:) ) * tmask(:,:,1)
! CALL histwrite( nid_T, "sobowlin", it, zw2d , ndim_hT, ndex_hT ) ! ???
@@ -1073,9 +1074,9 @@ CONTAINS
IF( ln_zad_Aimp ) THEN
DO_3D( 0, 0, 0, 0, 1, jpk )
- z3d(ji,jj,jk) = ww(ji,jj,jk) + wi(ji,jj,jk)
+ z3d0(ji,jj,jk) = ww(ji,jj,jk) + wi(ji,jj,jk)
END_3D
- CALL histwrite( nid_W, "vovecrtz", it, z3d , ndim_T, ndex_T ) ! vert. current
+ CALL histwrite( nid_W, "vovecrtz", it, z3d0 , ndim_T, ndex_T ) ! vert. current
ELSE
CALL histwrite( nid_W, "vovecrtz", it, ww , ndim_T, ndex_T ) ! vert. current
ENDIF
@@ -1124,8 +1125,8 @@ CONTAINS
!!
INTEGER :: ji, jj, jk ! dummy loop indices
INTEGER :: inum
- REAL(wp), DIMENSION(jpi,jpj) :: z2d
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d
+ REAL(wp), DIMENSION(A2D(0)) :: z2d0
+ REAL(wp), DIMENSION(A2D(0),jpk) :: z3d0
!!----------------------------------------------------------------------
!
IF(lwp) THEN
@@ -1144,9 +1145,9 @@ CONTAINS
CALL iom_rstput( 0, 0, inum, 'vomecrty', vv(:,:,:,Kmm) ) ! now j-velocity
IF( ln_zad_Aimp ) THEN
DO_3D( 0, 0, 0, 0, 1, jpk )
- z3d(ji,jj,jk) = ww(ji,jj,jk) + wi(ji,jj,jk)
+ z3d0(ji,jj,jk) = ww(ji,jj,jk) + wi(ji,jj,jk)
END_3D
- CALL iom_rstput( 0, 0, inum, 'vovecrtz', z3d ) ! now k-velocity
+ CALL iom_rstput( 0, 0, inum, 'vovecrtz', z3d0 ) ! now k-velocity
ELSE
CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww ) ! now k-velocity
ENDIF
@@ -1182,26 +1183,26 @@ CONTAINS
CALL iom_rstput( 0, 0, inum, 'ahmf', ahmf ) ! ahmf at v-point
ENDIF
DO_2D( 0, 0, 0, 0 )
- z2d(ji,jj) = emp(ji,jj) - rnf(ji,jj)
+ z2d0(ji,jj) = emp(ji,jj) - rnf(ji,jj)
END_2D
- CALL iom_rstput( 0, 0, inum, 'sowaflup', z2d ) ! freshwater budget
+ CALL iom_rstput( 0, 0, inum, 'sowaflup', z2d0 ) ! freshwater budget
DO_2D( 0, 0, 0, 0 )
- z2d(ji,jj) = qsr(ji,jj) + qns(ji,jj)
+ z2d0(ji,jj) = qsr(ji,jj) + qns(ji,jj)
END_2D
- CALL iom_rstput( 0, 0, inum, 'sohefldo', z2d ) ! total heat flux
+ CALL iom_rstput( 0, 0, inum, 'sohefldo', z2d0 ) ! total heat flux
CALL iom_rstput( 0, 0, inum, 'soshfldo', qsr ) ! solar heat flux
CALL iom_rstput( 0, 0, inum, 'soicecov', fr_i ) ! ice fraction
CALL iom_rstput( 0, 0, inum, 'sozotaux', utau ) ! i-wind stress
CALL iom_rstput( 0, 0, inum, 'sometauy', vtau ) ! j-wind stress
IF( .NOT.ln_linssh ) THEN
DO_3D( 0, 0, 0, 0, 1, jpk )
- z3d(ji,jj,jk) = gdept(ji,jj,jk,Kmm) ! 3D workspace for qco substitution
+ z3d0(ji,jj,jk) = gdept(ji,jj,jk,Kmm) ! 3D workspace for qco substitution
END_3D
- CALL iom_rstput( 0, 0, inum, 'vovvldep', z3d ) ! T-cell depth
+ CALL iom_rstput( 0, 0, inum, 'vovvldep', z3d0 ) ! T-cell depth
DO_3D( 0, 0, 0, 0, 1, jpk )
- z3d(ji,jj,jk) = e3t(ji,jj,jk,Kmm) ! 3D workspace for qco substitution
+ z3d0(ji,jj,jk) = e3t(ji,jj,jk,Kmm) ! 3D workspace for qco substitution
END_3D
- CALL iom_rstput( 0, 0, inum, 'vovvle3t', z3d ) ! T-cell thickness
+ CALL iom_rstput( 0, 0, inum, 'vovvle3t', z3d0 ) ! T-cell thickness
END IF
IF( ln_wave .AND. ln_sdw ) THEN
CALL iom_rstput( 0, 0, inum, 'sdzocrtx', usd ) ! now StokesDrift i-velocity
diff --git a/src/OCE/DIU/diu_bulk.F90 b/src/OCE/DIU/diu_bulk.F90
index af1e5adfe07324c0879beae01aab78fab3d9ab9a..aa7e96004cf3ddcd59c296244a0079c798dacc37 100644
--- a/src/OCE/DIU/diu_bulk.F90
+++ b/src/OCE/DIU/diu_bulk.F90
@@ -64,7 +64,7 @@ CONTAINS
IF( ln_diurnal ) THEN
!
- ALLOCATE( x_dsst(jpi,jpj), x_solfrac(jpi,jpj) )
+ ALLOCATE( x_dsst(A2D(0)), x_solfrac(A2D(0)) )
!
x_solfrac = 0._wp ! Initialise the solar fraction
x_dsst = 0._wp
@@ -92,25 +92,25 @@ CONTAINS
!! ** Reference : Refinements to a prognostic scheme of skin sea surface
!! temperature, Takaya et al, JGR, 2010
!!----------------------------------------------------------------------
- INTEGER , INTENT(in) :: kt ! time step
- REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: psolflux ! solar flux (Watts)
- REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: pqflux ! heat (non-solar) flux (Watts)
- REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: ptauflux ! wind stress (kg/ m s^2)
- REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: prho ! water density (kg/m^3)
- REAL(wp) , INTENT(in) :: p_rdt ! time-step
- REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: pLa ! Langmuir number
- REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: pthick ! warm layer thickness (m)
- REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: pcoolthick ! cool skin thickness (m)
- REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: pmu ! mu parameter
- REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: p_hflux_bkginc ! increment to the heat flux
- REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: p_fvel_bkginc ! increment to the friction velocity
+ INTEGER , INTENT(in) :: kt ! time step
+ REAL(wp), DIMENSION(A2D(0)) , INTENT(in) :: psolflux ! solar flux (Watts)
+ REAL(wp), DIMENSION(A2D(0)) , INTENT(in) :: pqflux ! heat (non-solar) flux (Watts)
+ REAL(wp), DIMENSION(A2D(0)) , INTENT(in) :: ptauflux ! wind stress (kg/ m s^2)
+ REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: prho ! water density (kg/m^3)
+ REAL(wp) , INTENT(in) :: p_rdt ! time-step
+ REAL(wp), DIMENSION(A2D(0)), OPTIONAL, INTENT(in) :: pLa ! Langmuir number
+ REAL(wp), DIMENSION(A2D(0)), OPTIONAL, INTENT(in) :: pthick ! warm layer thickness (m)
+ REAL(wp), DIMENSION(A2D(0)), OPTIONAL, INTENT(in) :: pcoolthick ! cool skin thickness (m)
+ REAL(wp), DIMENSION(A2D(0)), OPTIONAL, INTENT(in) :: pmu ! mu parameter
+ REAL(wp), DIMENSION(A2D(0)), OPTIONAL, INTENT(in) :: p_hflux_bkginc ! increment to the heat flux
+ REAL(wp), DIMENSION(A2D(0)), OPTIONAL, INTENT(in) :: p_fvel_bkginc ! increment to the friction velocity
!
INTEGER :: ji,jj
LOGICAL :: ll_calcfrac
- REAL(wp), DIMENSION(jpi,jpj) :: z_fvel ! friction velocity
- REAL(wp), DIMENSION(jpi,jpj) :: zthick, zcoolthick, zmu, zla
- REAL(wp), DIMENSION(jpi,jpj) :: z_abflux ! absorbed flux
- REAL(wp), DIMENSION(jpi,jpj) :: z_fla ! Langmuir function value
+ REAL(wp), DIMENSION(A2D(0)) :: z_fvel ! friction velocity
+ REAL(wp), DIMENSION(A2D(0)) :: zthick, zcoolthick, zmu, zla
+ REAL(wp), DIMENSION(A2D(0)) :: z_abflux ! absorbed flux
+ REAL(wp), DIMENSION(A2D(0)) :: z_fla ! Langmuir function value
!!----------------------------------------------------------------------
! Set optional arguments to their defaults
@@ -129,14 +129,14 @@ CONTAINS
! If not done already, calculate the solar fraction
IF ( kt==nit000 ) THEN
- DO_2D( 1, 1, 1, 1 )
- IF( ( x_solfrac(ji,jj) == 0._wp ) .AND. ( tmask(ji,jj,1) == 1._wp ) ) &
+ DO_2D( 0, 0, 0, 0 )
+ IF( ( x_solfrac(ji,jj) == 0._wp ) .AND. ( smask0(ji,jj) == 1._wp ) ) &
& x_solfrac(ji,jj) = solfrac( zcoolthick(ji,jj),zthick(ji,jj) )
END_2D
ENDIF
! convert solar flux and heat flux to absorbed flux
- WHERE ( tmask(:,:,1) == 1._wp)
+ WHERE ( smask0(:,:) == 1._wp)
z_abflux(:,:) = ( x_solfrac(:,:) * psolflux (:,:)) + pqflux(:,:)
ELSEWHERE
z_abflux(:,:) = 0._wp
@@ -147,8 +147,8 @@ CONTAINS
ENDWHERE
! Calculate the friction velocity
- WHERE ( (ptauflux /= 0) .AND. ( tmask(:,:,1) == 1.) )
- z_fvel(:,:) = SQRT( ptauflux(:,:) / prho(:,:) )
+ WHERE ( (ptauflux(:,:) /= 0) .AND. ( smask0(:,:) == 1.) )
+ z_fvel(:,:) = SQRT( ptauflux(:,:) / prho(A2D(0)) )
ELSEWHERE
z_fvel(:,:) = 0._wp
ENDWHERE
@@ -157,7 +157,7 @@ CONTAINS
! Calculate the Langmuir function value
- WHERE ( tmask(:,:,1) == 1.)
+ WHERE ( smask0(:,:) == 1.)
z_fla(:,:) = MAX( 1._wp, zla(:,:)**( -2._wp / 3._wp ) )
ELSEWHERE
z_fla(:,:) = 0._wp
@@ -176,16 +176,16 @@ CONTAINS
IMPLICIT NONE
! Function definition
- REAL(wp), DIMENSION(jpi,jpj) :: t_imp
+ REAL(wp), DIMENSION(A2D(0)) :: t_imp
! Dummy variables
- REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_dsst ! Delta SST
- REAL(wp), INTENT(IN) :: p_rdt ! Time-step
- REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_abflux ! Heat forcing
- REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_fvel ! Friction velocity
- REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_fla ! Langmuir number
- REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: pmu ! Structure parameter
- REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: pthick ! Layer thickness
- REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: prho ! Water density
+ REAL(wp), DIMENSION(A2D(0)), INTENT(IN) :: p_dsst ! Delta SST
+ REAL(wp), INTENT(IN) :: p_rdt ! Time-step
+ REAL(wp), DIMENSION(A2D(0)), INTENT(IN) :: p_abflux ! Heat forcing
+ REAL(wp), DIMENSION(A2D(0)), INTENT(IN) :: p_fvel ! Friction velocity
+ REAL(wp), DIMENSION(A2D(0)), INTENT(IN) :: p_fla ! Langmuir number
+ REAL(wp), DIMENSION(A2D(0)), INTENT(IN) :: pmu ! Structure parameter
+ REAL(wp), DIMENSION(A2D(0)), INTENT(IN) :: pthick ! Layer thickness
+ REAL(wp), DIMENSION(jpi,jpj),INTENT(IN) :: prho ! Water density
! Local variables
REAL(wp) :: z_olength ! Obukhov length
@@ -198,10 +198,10 @@ CONTAINS
INTEGER :: ji,jj
- DO_2D( 1, 1, 1, 1 )
+ DO_2D( 0, 0, 0, 0 )
! Only calculate outside tmask
- IF ( tmask(ji,jj,1) /= 1._wp ) THEN
+ IF ( smask0(ji,jj) /= 1._wp ) THEN
t_imp(ji,jj) = 0._wp
CYCLE
END IF
diff --git a/src/OCE/DIU/diu_coolskin.F90 b/src/OCE/DIU/diu_coolskin.F90
index 594a8b13ade4ae1d7739574244cd3f5b547a1e73..92ec5e84b4ff2164b91511b62dc53710e279b7c8 100644
--- a/src/OCE/DIU/diu_coolskin.F90
+++ b/src/OCE/DIU/diu_coolskin.F90
@@ -59,7 +59,7 @@ MODULE diu_coolskin
!! ** Reference :
!!
!!----------------------------------------------------------------------
- ALLOCATE( x_csdsst(jpi,jpj), x_csthick(jpi,jpj) )
+ ALLOCATE( x_csdsst(A2D(0)), x_csthick(A2D(0)) )
x_csdsst = 0.
x_csthick = 0.
!
@@ -77,16 +77,16 @@ MODULE diu_coolskin
!! ** Reference :
!!----------------------------------------------------------------------
! Dummy variables
- REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: psqflux ! Heat (non-solar)(Watts)
- REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: pstauflux ! Wind stress (kg/ m s^2)
+ REAL(wp), INTENT(IN), DIMENSION(A2D(0)) :: psqflux ! Heat (non-solar)(Watts)
+ REAL(wp), INTENT(IN), DIMENSION(A2D(0)) :: pstauflux ! Wind stress (kg/ m s^2)
REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: psrho ! Water density (kg/m^3)
REAL(wp), INTENT(IN) :: pDt ! Time-step
! Local variables
- REAL(wp), DIMENSION(jpi,jpj) :: z_fv ! Friction velocity
- REAL(wp), DIMENSION(jpi,jpj) :: z_gamma ! Dimensionless function of wind speed
- REAL(wp), DIMENSION(jpi,jpj) :: z_lamda ! Sauders (dimensionless) proportionality constant
- REAL(wp), DIMENSION(jpi,jpj) :: z_wspd ! Wind speed (m/s)
+ REAL(wp), DIMENSION(A2D(0)) :: z_fv ! Friction velocity
+ REAL(wp), DIMENSION(A2D(0)) :: z_gamma ! Dimensionless function of wind speed
+ REAL(wp), DIMENSION(A2D(0)) :: z_lamda ! Sauders (dimensionless) proportionality constant
+ REAL(wp), DIMENSION(A2D(0)) :: z_wspd ! Wind speed (m/s)
REAL(wp) :: z_ztx ! Temporary u wind stress
REAL(wp) :: z_zty ! Temporary v wind stress
REAL(wp) :: z_zmod ! Temporary total wind stress
@@ -96,10 +96,10 @@ MODULE diu_coolskin
!
IF( .NOT. (ln_blk .OR. ln_abl) ) CALL ctl_stop("diu_coolskin.f90: diurnal flux processing only implemented for bulk forcing")
!
- DO_2D( 1, 1, 1, 1 )
+ DO_2D( 0, 0, 0, 0 )
!
! Calcualte wind speed from wind stress and friction velocity
- IF( tmask(ji,jj,1) == 1. .AND. pstauflux(ji,jj) /= 0 .AND. psrho(ji,jj) /=0 ) THEN
+ IF( smask0(ji,jj) == 1. .AND. pstauflux(ji,jj) /= 0 .AND. psrho(ji,jj) /=0 ) THEN
z_fv(ji,jj) = SQRT( pstauflux(ji,jj) / psrho(ji,jj) )
z_wspd(ji,jj) = SQRT( pstauflux(ji,jj) / ( pp_cda * pp_rhoa ) )
ELSE
@@ -108,28 +108,28 @@ MODULE diu_coolskin
ENDIF
!
! Calculate gamma function which is dependent upon wind speed
- IF( tmask(ji,jj,1) == 1. ) THEN
+ IF( smask0(ji,jj) == 1. ) THEN
IF( ( z_wspd(ji,jj) <= 7.5 ) ) z_gamma(ji,jj) = ( 0.2 * z_wspd(ji,jj) ) + 0.5
IF( ( z_wspd(ji,jj) > 7.5 ) .AND. ( z_wspd(ji,jj) < 10. ) ) z_gamma(ji,jj) = ( 1.6 * z_wspd(ji,jj) ) - 10.
IF( ( z_wspd(ji,jj) >= 10. ) ) z_gamma(ji,jj) = 6.
ENDIF
!
! Calculate lamda function
- IF( tmask(ji,jj,1) == 1. .AND. z_fv(ji,jj) /= 0 ) THEN
+ IF( smask0(ji,jj) == 1. .AND. z_fv(ji,jj) /= 0 ) THEN
z_lamda(ji,jj) = ( z_fv(ji,jj) * pp_k * pp_C ) / ( z_gamma(ji,jj) * psrho(ji,jj) * pp_cw * pp_h * pp_v )
ELSE
z_lamda(ji,jj) = 0.
ENDIF
!
! Calculate the cool skin thickness - only when heat flux is out of the ocean
- IF( tmask(ji,jj,1) == 1. .AND. z_fv(ji,jj) /= 0 .AND. psqflux(ji,jj) < 0 ) THEN
+ IF( smask0(ji,jj) == 1. .AND. z_fv(ji,jj) /= 0 .AND. psqflux(ji,jj) < 0 ) THEN
x_csthick(ji,jj) = ( z_lamda(ji,jj) * pp_v ) / z_fv(ji,jj)
ELSE
x_csthick(ji,jj) = 0.
ENDIF
!
! Calculate the cool skin correction - only when the heat flux is out of the ocean
- IF( tmask(ji,jj,1) == 1. .AND. x_csthick(ji,jj) /= 0. .AND. psqflux(ji,jj) < 0. ) THEN
+ IF( smask0(ji,jj) == 1. .AND. x_csthick(ji,jj) /= 0. .AND. psqflux(ji,jj) < 0. ) THEN
x_csdsst(ji,jj) = ( psqflux(ji,jj) * x_csthick(ji,jj) ) / pp_k
ELSE
x_csdsst(ji,jj) = 0.
diff --git a/src/OCE/DIU/step_diu.F90 b/src/OCE/DIU/step_diu.F90
index ed8baa71733d7265dd1576070314173223b30d8c..a4b44e38d72cfdd4d2e1f5f6b06c9e0eaf2e2bb8 100644
--- a/src/OCE/DIU/step_diu.F90
+++ b/src/OCE/DIU/step_diu.F90
@@ -46,8 +46,7 @@ MODULE step_diu
!!----------------------------------------------------------------------
INTEGER :: jk ! dummy loop indices
INTEGER :: indic ! error indicator if < 0
- REAL(wp), DIMENSION(jpi,jpj) :: z_fvel_bkginc, z_hflux_bkginc
- INTEGER :: Nbb, Nnn, Naa, Nrhs ! local definitions as placeholders for now
+ INTEGER :: Nbb, Nnn, Naa, Nrhs ! local definitions as placeholders for now
!! ---------------------------------------------------------------------
IF(ln_diurnal_only) THEN
diff --git a/src/OCE/DOM/dom_oce.F90 b/src/OCE/DOM/dom_oce.F90
index 71a085f23d4a78e64b7bfec6751b9f2a5c7c9e7d..313fc5eb1c2ab7377982170f862046fd255915d5 100644
--- a/src/OCE/DOM/dom_oce.F90
+++ b/src/OCE/DOM/dom_oce.F90
@@ -76,10 +76,10 @@ MODULE dom_oce
INTEGER :: nn_ltile_i, nn_ltile_j
! Domain tiling
- INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ntsi_a !: start of internal part of tile domain
- INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ntsj_a !
- INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ntei_a !: end of internal part of tile domain
- INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ntej_a !
+ INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:) :: ntsi_a !: start of internal part of tile domain
+ INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:) :: ntsj_a !
+ INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:) :: ntei_a !: end of internal part of tile domain
+ INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:) :: ntej_a !
LOGICAL, PUBLIC :: l_istiled ! whether tiling is currently active or not
! !: domain MPP decomposition parameters
@@ -87,32 +87,30 @@ MODULE dom_oce
INTEGER , PUBLIC :: narea !: number for local area (starting at 1) = MPI rank + 1
INTEGER, PUBLIC :: nidom !: IOIPSL things...
- INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mig !: local ==> global domain, including halos (jpiglo), i-index
- INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mjg !: local ==> global domain, including halos (jpjglo), j-index
- INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mig0 !: local ==> global domain, excluding halos (Ni0glo), i-index
- INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mjg0 !: local ==> global domain, excluding halos (Nj0glo), j-index
- INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mi0, mi1 !: global, including halos (jpiglo) ==> local domain i-index
+ INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: mig !: local ==> global domain, i-index
+ INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: mjg !: local ==> global domain, j-index
+ INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: mi0, mi1 !: global ==> local domain, i-index
! !: (mi0=1 and mi1=0 if global index not in local domain)
- INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mj0, mj1 !: global, including halos (jpjglo) ==> local domain j-index
+ INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: mj0, mj1 !: global ==> local domain, j-index
! !: (mj0=1 and mj1=0 if global index not in local domain)
- INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nfimpp, nfproc, nfjpi
+ INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:) :: nfimpp, nfproc, nfjpi, nfni_0
!!----------------------------------------------------------------------
!! horizontal curvilinear coordinate and scale factors
!! ---------------------------------------------------------------------
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: glamt , glamu, glamv , glamf !: longitude at t, u, v, f-points [degree]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: gphit , gphiu, gphiv , gphif !: latitude at t, u, v, f-points [degree]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1t , e2t , r1_e1t, r1_e2t !: t-point horizontal scale factors [m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1u , e2u , r1_e1u, r1_e2u !: horizontal scale factors at u-point [m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1v , e2v , r1_e1v, r1_e2v !: horizontal scale factors at v-point [m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1f , e2f , r1_e1f, r1_e2f !: horizontal scale factors at f-point [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: glamt , glamu, glamv , glamf !: longitude at t, u, v, f-points [degree]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: gphit , gphiu, gphiv , gphif !: latitude at t, u, v, f-points [degree]
+ REAL(wp), PUBLIC, ALLOCATABLE, TARGET, DIMENSION(:,:) :: e1t , e2t , r1_e1t, r1_e2t !: t-point horizontal scale factors [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, TARGET, DIMENSION(:,:) :: e1u , e2u , r1_e1u, r1_e2u !: horizontal scale factors at u-point [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, TARGET, DIMENSION(:,:) :: e1v , e2v , r1_e1v, r1_e2v !: horizontal scale factors at v-point [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, TARGET, DIMENSION(:,:) :: e1f , e2f , r1_e1f, r1_e2f !: horizontal scale factors at f-point [m]
!
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e1e2t , r1_e1e2t !: associated metrics at t-point
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e1e2u , r1_e1e2u , e2_e1u !: associated metrics at u-point
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e1e2v , r1_e1e2v , e1_e2v !: associated metrics at v-point
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e1e2f , r1_e1e2f !: associated metrics at f-point
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: e1e2t , r1_e1e2t !: associated metrics at t-point
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: e1e2u , r1_e1e2u , e2_e1u !: associated metrics at u-point
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: e1e2v , r1_e1e2v , e1_e2v !: associated metrics at v-point
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: e1e2f , r1_e1e2f !: associated metrics at f-point
!
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ff_f , ff_t !: Coriolis factor at f- & t-points [1/s]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: ff_f , ff_t !: Coriolis factor at f- & t-points [1/s]
!!----------------------------------------------------------------------
!! vertical coordinate and scale factors
@@ -132,76 +130,77 @@ MODULE dom_oce
LOGICAL, PUBLIC :: ln_sco !: s-coordinate or hybrid z-s coordinate
LOGICAL, PUBLIC :: ln_isfcav !: presence of ISF
! ! reference scale factors
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3t_0 !: t- vert. scale factor [m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3u_0 !: u- vert. scale factor [m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3v_0 !: v- vert. scale factor [m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3f_0 !: f- vert. scale factor [m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3w_0 !: w- vert. scale factor [m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3uw_0 !: uw-vert. scale factor [m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3vw_0 !: vw-vert. scale factor [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: e3t_0 !: t- vert. scale factor [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: e3u_0 !: u- vert. scale factor [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: e3v_0 !: v- vert. scale factor [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: e3f_0 !: f- vert. scale factor [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: e3w_0 !: w- vert. scale factor [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: e3uw_0 !: uw-vert. scale factor [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: e3vw_0 !: vw-vert. scale factor [m]
! ! time-dependent scale factors (domvvl)
#if defined key_qco || defined key_linssh
#else
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e3t, e3u, e3v, e3w, e3uw, e3vw !: vert. scale factor [m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3f !: F-point vert. scale factor [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:,:) :: e3t, e3u, e3v, e3w, e3uw, e3vw !: vert. scale factor [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: e3f !: F-point vert. scale factor [m]
#endif
! ! time-dependent ratio ssh / h_0 (domqco)
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: r3t, r3u, r3v !: time-dependent ratio at t-, u- and v-point [-]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: r3f !: mid-time-level ratio at f-point [-]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: r3t_f, r3u_f, r3v_f !: now time-filtered ratio at t-, u- and v-point [-]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: r3t, r3u, r3v !: time-dependent ratio at t-, u- and v-point [-]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: r3f !: mid-time-level ratio at f-point [-]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: r3t_f, r3u_f, r3v_f !: now time-filtered ratio at t-, u- and v-point [-]
! ! reference depths of cells
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdept_0 !: t- depth [m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdepw_0 !: w- depth [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: gdept_0 !: t- depth [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: gdepw_0 !: w- depth [m]
! ! time-dependent depths of cells (domvvl)
#if defined key_qco || defined key_linssh
#else
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gde3w_0, gde3w !: w- depth (sum of e3w) [m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: gdept, gdepw
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: gde3w_0, gde3w !: w- depth (sum of e3w) [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:,:) :: gdept, gdepw
#endif
! ! reference heights of ocean water column and its inverse
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht_0, r1_ht_0 !: t-depth [m] and [1/m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_0, r1_hu_0 !: u-depth [m] and [1/m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hv_0, r1_hv_0 !: v-depth [m] and [1/m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hf_0, r1_hf_0 !: f-depth [m] and [1/m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: ht_0, r1_ht_0 !: t-depth [m] and [1/m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: hu_0, r1_hu_0 !: u-depth [m] and [1/m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: hv_0, r1_hv_0 !: v-depth [m] and [1/m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: hf_0, r1_hf_0 !: f-depth [m] and [1/m]
! ! time-dependent heights of ocean water column (domvvl)
#if defined key_qco || defined key_linssh
#else
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht !: t-points [m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hu, r1_hu !: u-depth [m] and [1/m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hv, r1_hv !: v-depth [m] and [1/m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: ht !: t-points [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: hu, r1_hu !: u-depth [m] and [1/m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: hv, r1_hv !: v-depth [m] and [1/m]
#endif
INTEGER, PUBLIC :: nla10 !: deepest W level Above ~10m (nlb10 - 1)
INTEGER, PUBLIC :: nlb10 !: shallowest W level Bellow ~10m (nla10 + 1)
!! 1D reference vertical coordinate
!! =-----------------====------
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: gdept_1d, gdepw_1d !: reference depth of t- and w-points (m)
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: e3t_1d , e3w_1d !: reference vertical scale factors at T- and W-pts (m)
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) :: gdept_1d, gdepw_1d !: reference depth of t- and w-points (m)
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) :: e3t_1d , e3w_1d !: reference vertical scale factors at T- and W-pts (m)
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: risfdep, bathy
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: risfdep, bathy
!!----------------------------------------------------------------------
!! masks, top and bottom ocean point position
!! ---------------------------------------------------------------------
!!gm Proposition of new name for top/bottom vertical indices
-! INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mtk_t, mtk_u, mtk_v !: top first wet T-, U-, and V-level (ISF)
-! INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbk_t, mbk_u, mbk_v !: bottom last wet T-, U-, and V-level
+! INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: mtk_t, mtk_u, mtk_v !: top first wet T-, U-, and V-level (ISF)
+! INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: mbk_t, mbk_u, mbk_v !: bottom last wet T-, U-, and V-level
!!gm
- INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbkt, mbku, mbkv, mbkf !: bottom last wet T-, U-, V- and F-level
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmask_i !: interior (excluding halos+duplicated points) domain T-point mask
+ INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: mbkt, mbku, mbkv, mbkf !: bottom last wet T-, U-, V- and F-level
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: tmask_i !: interior (excluding halos+duplicated points) domain T-point mask
- INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mikt, miku, mikv, mikf !: top first wet T-, U-, V-, F-level (ISF)
+ INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: mikt, miku, mikv, mikf !: top first wet T-, U-, V-, F-level (ISF)
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: smask0 !: surface mask at T-pts on inner domain
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ssmask, ssumask, ssvmask, ssfmask !: surface mask at T-,U-, V- and F-pts
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, wmask, fmask !: land/ocean mask at T-, U-, V-, W- and F-pts
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wumask, wvmask !: land/ocean mask at WU- and WV-pts
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: fe3mask !: land/ocean mask at F-pts
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmask_upd, umask_upd, vmask_upd !: land/ocean mask at F-pts
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: smask0 !: surface mask at T-pts on inner domain
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: smask0_i !: equivalent of tmask_i for inner domain
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: ssmask, ssumask, ssvmask, ssfmask !: surface mask at T-,U-, V- and F-pts
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, wmask, fmask !: land/ocean mask at T-, U-, V-, W- and F-pts
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:), TARGET :: wumask, wvmask !: land/ocean mask at WU- and WV-pts
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:), TARGET :: fe3mask !: land/ocean mask at F-pts
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: tmask_upd, umask_upd, vmask_upd !: land/ocean mask at F-pts
!!----------------------------------------------------------------------
!! calendar variables
@@ -329,7 +328,7 @@ CONTAINS
ALLOCATE( risfdep(jpi,jpj) , bathy(jpi,jpj) , STAT=ierr(ii) )
!
ii = ii+1
- ALLOCATE( tmask_i(jpi,jpj) , smask0(A2D(0)) , &
+ ALLOCATE( tmask_i(jpi,jpj) , smask0(Nis0-(0):Nie0+(0),Njs0-(0):Nje0+(0)) , smask0_i(Nis0-(0):Nie0+(0),Njs0-(0):Nje0+(0)) , &
& ssmask (jpi,jpj) , ssumask(jpi,jpj) , ssvmask(jpi,jpj) , ssfmask(jpi,jpj) , &
& mbkt (jpi,jpj) , mbku (jpi,jpj) , mbkv (jpi,jpj) , mbkf(jpi,jpj) , STAT=ierr(ii) )
!
diff --git a/src/OCE/DOM/dommsk.F90 b/src/OCE/DOM/dommsk.F90
index ce234ad277642515bb38c2f21d023e45a9f137fc..dcf95510baedaca121cd5c3ce51e94b62a7528fe 100644
--- a/src/OCE/DOM/dommsk.F90
+++ b/src/OCE/DOM/dommsk.F90
@@ -144,7 +144,7 @@ CONTAINS
tmask(ji,jj,jk) = tmask(ji,jj,jk) * bdytmask(ji,jj)
END_3D
ENDIF
- smask0(A2D(0)) = tmask(A2D(0),1)
+ smask0(:,:) = tmask(A2D(0),1)
! Ocean/land mask at u-, v-, and f-points (computed from tmask)
! ----------------------------------------
@@ -195,7 +195,8 @@ CONTAINS
! --------------------
!
CALL dom_uniq( tmask_i, 'T' )
- tmask_i(:,:) = ssmask(:,:) * tmask_i(:,:)
+ tmask_i (:,:) = ssmask(:,:) * tmask_i(:,:)
+ smask0_i(:,:) = tmask_i(A2D(0))
! Lateral boundary conditions on velocity (modify fmask)
! ---------------------------------------
diff --git a/src/OCE/DOM/domvvl.F90 b/src/OCE/DOM/domvvl.F90
index 94bf1ce8bcdd4c34669d864d3dae504db32807a8..2de0762a7223f14face860df5c22b6729158807d 100644
--- a/src/OCE/DOM/domvvl.F90
+++ b/src/OCE/DOM/domvvl.F90
@@ -282,8 +282,8 @@ CONTAINS
IF( nn_cfg == 3 ) THEN ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2
ii0 = 103 + nn_hls - 1 ; ii1 = 111 + nn_hls - 1
ij0 = 128 + nn_hls ; ij1 = 135 + nn_hls
- frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.0_wp
- frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0_wp / rn_Dt
+ frq_rst_e3t( mi0(ii0,nn_hls):mi1(ii1,nn_hls) , mj0(ij0,nn_hls):mj1(ij1,nn_hls) ) = 0.0_wp
+ frq_rst_hdv( mi0(ii0,nn_hls):mi1(ii1,nn_hls) , mj0(ij0,nn_hls):mj1(ij1,nn_hls) ) = 1.e0_wp / rn_Dt
ENDIF
ENDIF
ENDIF
diff --git a/src/OCE/DOM/domzgr.F90 b/src/OCE/DOM/domzgr.F90
index 85f89ed2c9b67d30da99d6ad550cf09c8d31cfdb..e6bfeaf3346373dde6baaf150bdf1d71bc1b8338 100644
--- a/src/OCE/DOM/domzgr.F90
+++ b/src/OCE/DOM/domzgr.F90
@@ -130,14 +130,14 @@ CONTAINS
!
zmsk(:,:) = 1._wp ! default: no closed boundaries
IF( .NOT. l_Iperio ) THEN ! E-W closed:
- zmsk( mi0( 1+nn_hls):mi1( 1+nn_hls),:) = 0._wp ! first column of inner global domain at 0
- zmsk( mi0(jpiglo-nn_hls):mi1(jpiglo-nn_hls),:) = 0._wp ! last column of inner global domain at 0
+ zmsk( mi0( 1+nn_hls,nn_hls):mi1( 1+nn_hls,nn_hls),:) = 0._wp ! first column of inner global domain at 0
+ zmsk( mi0(jpiglo-nn_hls,nn_hls):mi1(jpiglo-nn_hls,nn_hls),:) = 0._wp ! last column of inner global domain at 0
ENDIF
IF( .NOT. l_Jperio ) THEN ! S closed:
- zmsk(:,mj0( 1+nn_hls):mj1( 1+nn_hls) ) = 0._wp ! first line of inner global domain at 0
+ zmsk(:,mj0( 1+nn_hls,nn_hls):mj1( 1+nn_hls,nn_hls) ) = 0._wp ! first line of inner global domain at 0
ENDIF
IF( .NOT. ( l_Jperio .OR. l_NFold ) ) THEN ! N closed:
- zmsk(:,mj0(jpjglo-nn_hls):mj1(jpjglo-nn_hls) ) = 0._wp ! last line of inner global domain at 0
+ zmsk(:,mj0(jpjglo-nn_hls,nn_hls):mj1(jpjglo-nn_hls,nn_hls) ) = 0._wp ! last line of inner global domain at 0
ENDIF
CALL lbc_lnk( 'usrdef_zgr', zmsk, 'T', 1. ) ! set halos
k_top(:,:) = k_top(:,:) * NINT( zmsk(:,:) )
diff --git a/src/OCE/DOM/dtatsd.F90 b/src/OCE/DOM/dtatsd.F90
index 5863789cc4d8e4c1f09657a00610197ef9c7c599..cf634bedab1be9cd13df869ca9a3d778a3fe3c77 100644
--- a/src/OCE/DOM/dtatsd.F90
+++ b/src/OCE/DOM/dtatsd.F90
@@ -161,8 +161,8 @@ CONTAINS
ij0 = 101 + nn_hls ; ij1 = 109 + nn_hls ! Reduced T & S in the Alboran Sea
ii0 = 141 + nn_hls - 1 ; ii1 = 155 + nn_hls - 1
IF( sf_tsd(jp_tem)%ln_tint .OR. irec_n(jp_tem) /= irec_b(jp_tem) ) THEN
- DO jj = mj0(ij0), mj1(ij1)
- DO ji = mi0(ii0), mi1(ii1)
+ DO jj = mj0(ij0,nn_hls), mj1(ij1,nn_hls)
+ DO ji = mi0(ii0,nn_hls), mi1(ii1,nn_hls)
sf_tsd(jp_tem)%fnow(ji,jj,13:13) = sf_tsd(jp_tem)%fnow(ji,jj,13:13) - 0.20_wp
sf_tsd(jp_tem)%fnow(ji,jj,14:15) = sf_tsd(jp_tem)%fnow(ji,jj,14:15) - 0.35_wp
sf_tsd(jp_tem)%fnow(ji,jj,16:25) = sf_tsd(jp_tem)%fnow(ji,jj,16:25) - 0.40_wp
@@ -172,8 +172,8 @@ CONTAINS
ENDIF
!
IF( sf_tsd(jp_sal)%ln_tint .OR. irec_n(jp_sal) /= irec_b(jp_sal) ) THEN
- DO jj = mj0(ij0), mj1(ij1)
- DO ji = mi0(ii0), mi1(ii1)
+ DO jj = mj0(ij0,nn_hls), mj1(ij1,nn_hls)
+ DO ji = mi0(ii0,nn_hls), mi1(ii1,nn_hls)
sf_tsd(jp_sal)%fnow(ji,jj,13:13) = sf_tsd(jp_sal)%fnow(ji,jj,13:13) - 0.15_wp
sf_tsd(jp_sal)%fnow(ji,jj,14:15) = sf_tsd(jp_sal)%fnow(ji,jj,14:15) - 0.25_wp
sf_tsd(jp_sal)%fnow(ji,jj,16:17) = sf_tsd(jp_sal)%fnow(ji,jj,16:17) - 0.30_wp
@@ -185,9 +185,9 @@ CONTAINS
!
ij0 = 87 + nn_hls ; ij1 = 96 + nn_hls ! Reduced temperature in Red Sea
ii0 = 148 + nn_hls - 1 ; ii1 = 160 + nn_hls - 1
- sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 ) = 7.0_wp
- sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5_wp
- sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0_wp
+ sf_tsd(jp_tem)%fnow( mi0(ii0,nn_hls):mi1(ii1,nn_hls) , mj0(ij0,nn_hls):mj1(ij1,nn_hls) , 4:10 ) = 7.0_wp
+ sf_tsd(jp_tem)%fnow( mi0(ii0,nn_hls):mi1(ii1,nn_hls) , mj0(ij0,nn_hls):mj1(ij1,nn_hls) , 11:13 ) = 6.5_wp
+ sf_tsd(jp_tem)%fnow( mi0(ii0,nn_hls):mi1(ii1,nn_hls) , mj0(ij0,nn_hls):mj1(ij1,nn_hls) , 14:20 ) = 6.0_wp
ENDIF
ENDIF
!!gm end
diff --git a/src/OCE/DYN/dynadv.F90 b/src/OCE/DYN/dynadv.F90
index bda2c3a4f806cd4fab1bcc5a6b3bc1ff89f77dd1..6d59583ffb868f71fdaf9900ca231e9419030b8d 100644
--- a/src/OCE/DYN/dynadv.F90
+++ b/src/OCE/DYN/dynadv.F90
@@ -7,6 +7,7 @@ MODULE dynadv
!! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase
!! 3.6 ! 2015-05 (N. Ducousso, G. Madec) add Hollingsworth scheme as an option
!! 4.0 ! 2017-07 (G. Madec) add a linear dynamics option
+ !! 4.5 ! 2022-06 (S. Techene, G, Madec) refactorization to reduce local memory usage
!!----------------------------------------------------------------------
!!----------------------------------------------------------------------
@@ -50,7 +51,7 @@ MODULE dynadv
!!----------------------------------------------------------------------
CONTAINS
- SUBROUTINE dyn_adv( kt, Kbb, Kmm, puu, pvv, Krhs, pau, pav, paw, no_zad )
+ SUBROUTINE dyn_adv( kt, Kbb, Kmm, puu, pvv, Krhs, pau, pav, paw )
!!---------------------------------------------------------------------
!! *** ROUTINE dyn_adv ***
!!
@@ -64,7 +65,6 @@ CONTAINS
!! (see dynvor module).
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: kt , Kbb, Kmm, Krhs ! ocean time step and level indices
- INTEGER , OPTIONAL , INTENT(in ) :: no_zad ! no vertical advection compotation
REAL(wp), DIMENSION(:,:,:), OPTIONAL, TARGET, INTENT(in ) :: pau, pav, paw ! advective velocity
REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), TARGET, INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum Eq.
!!----------------------------------------------------------------------
@@ -73,12 +73,23 @@ CONTAINS
!
SELECT CASE( n_dynadv ) !== compute advection trend and add it to general trend ==!
CASE( np_VEC_c2 ) != vector form =!
- CALL dyn_keg ( kt, nn_dynkeg , Kmm, puu, pvv, Krhs ) ! horizontal gradient of kinetic energy
- CALL dyn_zad ( kt , Kmm, puu, pvv, Krhs ) ! vertical advection
+ ! !* horizontal gradient of kinetic energy
+ IF (nn_hls==1) THEN ! halo 1 case
+ CALL dyn_keg_hls1( kt, nn_dynkeg , Kmm, puu, pvv, Krhs ) ! lbc needed with Hollingsworth scheme
+ ELSE ! halo 2 case
+ CALL dyn_keg ( kt, nn_dynkeg , Kmm, puu, pvv, Krhs )
+ ENDIF
+ CALL dyn_zad ( kt , Kmm, puu, pvv, Krhs ) !* vertical advection
+ !
CASE( np_FLX_c2 ) != flux form =!
- CALL dyn_adv_cen2( kt , Kmm, puu, pvv, Krhs, pau, pav, paw, no_zad ) ! 2nd order centered scheme
- CASE( np_FLX_ubs )
- CALL dyn_adv_ubs ( kt , Kbb, Kmm, puu, pvv, Krhs, pau, pav, paw, no_zad ) ! 3rd order UBS scheme (UP3)
+ CALL dyn_adv_cen2( kt , Kmm, puu, pvv, Krhs, pau, pav, paw ) !* 2nd order centered scheme
+ !
+ CASE( np_FLX_ubs ) !* 3rd order UBS scheme (UP3)
+ IF (nn_hls==1) THEN ! halo 1 case
+ CALL dyn_adv_ubs_hls1( kt , Kbb, Kmm, puu, pvv, Krhs, pau, pav, paw )
+ ELSE ! halo 2 case
+ CALL dyn_adv_ubs ( kt , Kbb, Kmm, puu, pvv, Krhs, pau, pav, paw )
+ ENDIF
END SELECT
!
IF( ln_timing ) CALL timing_stop( 'dyn_adv' )
diff --git a/src/OCE/DYN/dynadv_cen2.F90 b/src/OCE/DYN/dynadv_cen2.F90
index 7fd7f65f5c19ca959bd2437cb7352cf5bb1fd1b6..07dd931129ed0b4474092915e3b6c83abcaf2ff5 100644
--- a/src/OCE/DYN/dynadv_cen2.F90
+++ b/src/OCE/DYN/dynadv_cen2.F90
@@ -6,6 +6,7 @@ MODULE dynadv_cen2
!!======================================================================
!! History : 2.0 ! 2006-08 (G. Madec, S. Theetten) Original code
!! 3.2 ! 2009-07 (R. Benshila) Suppression of rigid-lid option
+ !! 4.5 ! 2022-06 (S. Techene, G, Madec) refactorization to reduce local memory usage
!!----------------------------------------------------------------------
!!----------------------------------------------------------------------
@@ -35,7 +36,7 @@ MODULE dynadv_cen2
!!----------------------------------------------------------------------
CONTAINS
- SUBROUTINE dyn_adv_cen2( kt, Kmm, puu, pvv, Krhs, pau, pav, paw, no_zad )
+ SUBROUTINE dyn_adv_cen2( kt, Kmm, puu, pvv, Krhs, pau, pav, paw )
!!----------------------------------------------------------------------
!! *** ROUTINE dyn_adv_cen2 ***
!!
@@ -51,15 +52,17 @@ CONTAINS
!! ** Action : (puu,pvv)(:,:,:,Krhs) updated with the advective trend
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: kt , Kmm, Krhs ! ocean time-step and level indices
- INTEGER , OPTIONAL , INTENT(in ) :: no_zad ! no vertical advection computation
REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), TARGET, INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
REAL(wp), DIMENSION(:,:,:), OPTIONAL, TARGET, INTENT(in ) :: pau, pav, paw ! advective velocity
!
INTEGER :: ji, jj, jk ! dummy loop indices
- REAL(wp) :: zzu, zzv ! local scalars
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zfu_t, zfu_f, zfu_uw, zfu
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zfv_t, zfv_f, zfv_vw, zfv, zfw
+ REAL(wp) :: zzu, zzfu_kp1 ! local scalars
+ REAL(wp) :: zzv, zzfv_kp1 ! - -
+ REAL(wp), DIMENSION(A2D(1)) :: zfu_t, zfu_f, zfu
+ REAL(wp), DIMENSION(A2D(1)) :: zfv_t, zfv_f, zfv
+ REAL(wp), DIMENSION(A2D(1)) :: zfu_uw, zfv_vw, zfw
REAL(wp), DIMENSION(:,:,:) , POINTER :: zpt_u, zpt_v, zpt_w
+ REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: zu_trd, zv_trd
!!----------------------------------------------------------------------
!
IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile
@@ -71,8 +74,9 @@ CONTAINS
ENDIF
!
IF( l_trddyn ) THEN ! trends: store the input trends
- zfu_uw(:,:,:) = puu(:,:,:,Krhs)
- zfv_vw(:,:,:) = pvv(:,:,:,Krhs)
+ ALLOCATE( zu_trd(A2D(0),jpkm1), zv_trd(A2D(0),jpkm1) )
+ zu_trd(A2D(0),:) = puu(A2D(0),:,Krhs)
+ zv_trd(A2D(0),:) = pvv(A2D(0),:,Krhs)
ENDIF
!
IF( PRESENT( pau ) ) THEN ! RK3: advective velocity (pau,pav,paw) /= advected velocity (puu,pvv,ww)
@@ -89,84 +93,86 @@ CONTAINS
!
DO jk = 1, jpkm1 ! horizontal transport
DO_2D( 1, 1, 1, 1 )
- zfu(ji,jj,jk) = 0.25_wp * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * zpt_u(ji,jj,jk)
- zfv(ji,jj,jk) = 0.25_wp * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * zpt_v(ji,jj,jk)
+ zfu(ji,jj) = 0.25_wp * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * zpt_u(ji,jj,jk)
+ zfv(ji,jj) = 0.25_wp * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * zpt_v(ji,jj,jk)
END_2D
DO_2D( 1, 0, 1, 0 ) ! horizontal momentum fluxes (at T- and F-point)
- zfu_t(ji+1,jj ,jk) = ( zfu(ji,jj,jk) + zfu(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji+1,jj ,jk,Kmm) )
- zfv_f(ji ,jj ,jk) = ( zfv(ji,jj,jk) + zfv(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji ,jj+1,jk,Kmm) )
- zfu_f(ji ,jj ,jk) = ( zfu(ji,jj,jk) + zfu(ji,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji+1,jj ,jk,Kmm) )
- zfv_t(ji ,jj+1,jk) = ( zfv(ji,jj,jk) + zfv(ji,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji ,jj+1,jk,Kmm) )
+ zfu_t(ji+1,jj ) = ( zfu(ji,jj) + zfu(ji+1,jj) ) * ( puu(ji,jj,jk,Kmm) + puu(ji+1,jj ,jk,Kmm) )
+ zfv_f(ji ,jj ) = ( zfv(ji,jj) + zfv(ji+1,jj) ) * ( puu(ji,jj,jk,Kmm) + puu(ji ,jj+1,jk,Kmm) )
+ zfu_f(ji ,jj ) = ( zfu(ji,jj) + zfu(ji,jj+1) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji+1,jj ,jk,Kmm) )
+ zfv_t(ji ,jj+1) = ( zfv(ji,jj) + zfv(ji,jj+1) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji ,jj+1,jk,Kmm) )
END_2D
DO_2D( 0, 0, 0, 0 ) ! divergence of horizontal momentum fluxes
- puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_t(ji+1,jj,jk) - zfu_t(ji,jj ,jk) &
- & + zfv_f(ji ,jj,jk) - zfv_f(ji,jj-1,jk) ) * r1_e1e2u(ji,jj) &
+ puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_t(ji+1,jj) - zfu_t(ji,jj ) &
+ & + zfv_f(ji ,jj) - zfv_f(ji,jj-1) ) * r1_e1e2u(ji,jj) &
& / e3u(ji,jj,jk,Kmm)
- pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zfu_f(ji,jj ,jk) - zfu_f(ji-1,jj,jk) &
- & + zfv_t(ji,jj+1,jk) - zfv_t(ji ,jj,jk) ) * r1_e1e2v(ji,jj) &
+ pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zfu_f(ji,jj ) - zfu_f(ji-1,jj) &
+ & + zfv_t(ji,jj+1) - zfv_t(ji ,jj) ) * r1_e1e2v(ji,jj) &
& / e3v(ji,jj,jk,Kmm)
END_2D
END DO
!
IF( l_trddyn ) THEN ! trends: send trend to trddyn for diagnostic
- zfu_uw(:,:,:) = puu(:,:,:,Krhs) - zfu_uw(:,:,:)
- zfv_vw(:,:,:) = pvv(:,:,:,Krhs) - zfv_vw(:,:,:)
- CALL trd_dyn( zfu_uw, zfv_vw, jpdyn_keg, kt, Kmm )
- zfu_t(:,:,:) = puu(:,:,:,Krhs)
- zfv_t(:,:,:) = pvv(:,:,:,Krhs)
+ zu_trd(A2D(0),:) = puu(A2D(0),:,Krhs) - zu_trd(A2D(0),:)
+ zv_trd(A2D(0),:) = pvv(A2D(0),:,Krhs) - zv_trd(A2D(0),:)
+ CALL trd_dyn( zu_trd, zv_trd, jpdyn_keg, kt, Kmm )
+ zu_trd(A2D(0),:) = puu(A2D(0),:,Krhs)
+ zv_trd(A2D(0),:) = pvv(A2D(0),:,Krhs)
ENDIF
!
- IF( PRESENT( no_zad ) ) THEN !== No vertical advection ==! (except if linear free surface)
- ! ==
- IF( ln_linssh ) THEN ! linear free surface: advection through the surface z=0
- DO_2D( 0, 0, 0, 0 )
- zzu = 0.5_wp * ( e1e2t(ji,jj) * zpt_w(ji,jj,1) + e1e2t(ji+1,jj) * zpt_w(ji+1,jj,1) ) * puu(ji,jj,1,Kmm)
- zzv = 0.5_wp * ( e1e2t(ji,jj) * zpt_w(ji,jj,1) + e1e2t(ji,jj+1) * zpt_w(ji,jj+1,1) ) * pvv(ji,jj,1,Kmm)
- puu(ji,jj,1,Krhs) = puu(ji,jj,1,Krhs) - zzu * r1_e1e2u(ji,jj) &
- & / e3u(ji,jj,1,Kmm)
- pvv(ji,jj,1,Krhs) = pvv(ji,jj,1,Krhs) - zzv * r1_e1e2v(ji,jj) &
- & / e3v(ji,jj,1,Kmm)
- END_2D
- ENDIF
- !
- ELSE !== Vertical advection ==!
+ ! !== Vertical advection ==!
+ !
+ ! ! surface vertical fluxes
+ !
+ IF( ln_linssh ) THEN ! linear free surface: advection through the surface z=0
+ DO_2D( 0, 0, 0, 0 )
+ zfu_uw(ji,jj) = 0.5_wp * ( e1e2t(ji,jj) * zpt_w(ji,jj,1) + e1e2t(ji+1,jj) * zpt_w(ji+1,jj,1) ) * puu(ji,jj,1,Kmm)
+ zfv_vw(ji,jj) = 0.5_wp * ( e1e2t(ji,jj) * zpt_w(ji,jj,1) + e1e2t(ji,jj+1) * zpt_w(ji,jj+1,1) ) * pvv(ji,jj,1,Kmm)
+ END_2D
+ ELSE ! non linear free: surface advective fluxes set to zero
+ DO_2D( 0, 0, 0, 0 )
+ zfu_uw(ji,jj) = 0._wp
+ zfv_vw(ji,jj) = 0._wp
+ END_2D
+ ENDIF
+ !
+ DO jk = 1, jpk-2 ! divergence of advective fluxes
!
- DO_2D( 0, 0, 0, 0 ) ! surface/bottom advective fluxes set to zero
- zfu_uw(ji,jj,jpk) = 0._wp ; zfv_vw(ji,jj,jpk) = 0._wp
- zfu_uw(ji,jj, 1 ) = 0._wp ; zfv_vw(ji,jj, 1 ) = 0._wp
+ DO_2D( 0, 1, 0, 1 ) ! 1/4 * Vertical transport at level k+1
+ zfw(ji,jj) = 0.25_wp * e1e2t(ji,jj) * zpt_w(ji,jj,jk+1)
END_2D
- IF( ln_linssh ) THEN ! linear free surface: advection through the surface z=0
- DO_2D( 0, 0, 0, 0 )
- zfu_uw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * zpt_w(ji,jj,1) + e1e2t(ji+1,jj) * zpt_w(ji+1,jj,1) ) * puu(ji,jj,1,Kmm)
- zfv_vw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * zpt_w(ji,jj,1) + e1e2t(ji,jj+1) * zpt_w(ji,jj+1,1) ) * pvv(ji,jj,1,Kmm)
- END_2D
- ENDIF
- DO jk = 2, jpkm1 ! interior advective fluxes
- DO_2D( 0, 1, 0, 1 ) ! 1/4 * Vertical transport
- zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * zpt_w(ji,jj,jk)
- END_2D
- DO_2D( 0, 0, 0, 0 )
- zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk) + zfw(ji+1,jj ,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji,jj,jk-1,Kmm) )
- zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk) + zfw(ji ,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk-1,Kmm) )
- END_2D
- END DO
- DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! divergence of vertical momentum flux divergence
- puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) &
+ DO_2D( 0, 0, 0, 0 )
+ ! ! vertical flux at level k+1
+ zzfu_kp1 = ( zfw(ji,jj) + zfw(ji+1,jj ) ) * ( puu(ji,jj,jk+1,Kmm) + puu(ji,jj,jk,Kmm) )
+ zzfv_kp1 = ( zfw(ji,jj) + zfw(ji ,jj+1) ) * ( pvv(ji,jj,jk+1,Kmm) + pvv(ji,jj,jk,Kmm) )
+ ! ! divergence of vertical momentum flux
+ puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj) - zzfu_kp1 ) * r1_e1e2u(ji,jj) &
& / e3u(ji,jj,jk,Kmm)
- pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) &
- & / e3v(ji,jj,jk,Kmm)
- END_3D
- !
- IF( l_trddyn ) THEN ! trends: send trend to trddyn for diagnostic
- zfu_t(:,:,:) = puu(:,:,:,Krhs) - zfu_t(:,:,:)
- zfv_t(:,:,:) = pvv(:,:,:,Krhs) - zfv_t(:,:,:)
- CALL trd_dyn( zfu_t, zfv_t, jpdyn_zad, kt, Kmm )
- ENDIF
- ! ! Control print
- IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' cen2 adv - Ua: ', mask1=umask, &
- & tab3d_2=pvv(:,:,:,Krhs), clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )
- !
+ pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zfv_vw(ji,jj) - zzfv_kp1 ) * r1_e1e2v(ji,jj) &
+ & / e3v(ji,jj,jk,Kmm)
+ ! ! store vertical flux for next level calculation
+ zfu_uw(ji,jj) = zzfu_kp1
+ zfv_vw(ji,jj) = zzfv_kp1
+ END_2D
+ END DO
+ !
+ jk = jpkm1
+ DO_2D( 0, 0, 0, 0 )
+ puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - zfu_uw(ji,jj) * r1_e1e2u(ji,jj) &
+ & / e3u(ji,jj,jk,Kmm)
+ pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - zfv_vw(ji,jj) * r1_e1e2v(ji,jj) &
+ & / e3v(ji,jj,jk,Kmm)
+ END_2D
+ !
+ IF( l_trddyn ) THEN ! trends: send trend to trddyn for diagnostic
+ zu_trd(A2D(0),:) = puu(A2D(0),:,Krhs) - zu_trd(A2D(0),:)
+ zv_trd(A2D(0),:) = pvv(A2D(0),:,Krhs) - zv_trd(A2D(0),:)
+ CALL trd_dyn( zu_trd, zv_trd, jpdyn_zad, kt, Kmm )
+ DEALLOCATE( zu_trd, zv_trd )
ENDIF
+ ! ! Control print
+ IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' cen2 adv - Ua: ', mask1=umask, &
+ & tab3d_2=pvv(:,:,:,Krhs), clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )
!
END SUBROUTINE dyn_adv_cen2
diff --git a/src/OCE/DYN/dynadv_ubs.F90 b/src/OCE/DYN/dynadv_ubs.F90
index 645f6fa800606d41375281e38c4bc077f1a848e8..8ab908124d5b85beb120d5726d2d6ec12b8d28f7 100644
--- a/src/OCE/DYN/dynadv_ubs.F90
+++ b/src/OCE/DYN/dynadv_ubs.F90
@@ -6,6 +6,7 @@ MODULE dynadv_ubs
!!======================================================================
!! History : 2.0 ! 2006-08 (R. Benshila, L. Debreu) Original code
!! 3.2 ! 2009-07 (R. Benshila) Suppression of rigid-lid option
+ !! 4.5 ! 2022-06 (S. Techene, G, Madec) refactorization to reduce local memory usage
!!----------------------------------------------------------------------
!!----------------------------------------------------------------------
@@ -29,7 +30,8 @@ MODULE dynadv_ubs
REAL(wp), PARAMETER :: gamma1 = 1._wp/3._wp ! =1/4 quick ; =1/3 3rd order UBS
REAL(wp), PARAMETER :: gamma2 = 1._wp/32._wp ! =0 2nd order ; =1/32 4th order centred
- PUBLIC dyn_adv_ubs ! routine called by step.F90
+ PUBLIC dyn_adv_ubs ! routine called by dynadv.F90
+ PUBLIC dyn_adv_ubs_hls1 ! routine called by dynadv.F90
!! * Substitutions
# include "do_loop_substitute.h90"
@@ -41,7 +43,243 @@ MODULE dynadv_ubs
!!----------------------------------------------------------------------
CONTAINS
- SUBROUTINE dyn_adv_ubs( kt, Kbb, Kmm, puu, pvv, Krhs, pau, pav, paw, no_zad )
+ SUBROUTINE dyn_adv_ubs( kt, Kbb, Kmm, puu, pvv, Krhs, pau, pav, paw )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE dyn_adv_ubs ***
+ !!
+ !! ** Purpose : Compute the now momentum advection trend in flux form
+ !! and the general trend of the momentum equation.
+ !!
+ !! ** Method : The scheme is the one implemeted in ROMS. It depends
+ !! on two parameter gamma1 and gamma2. The former control the
+ !! upstream baised part of the scheme and the later the centred
+ !! part: gamma1 = 0 pure centered (no diffusive part)
+ !! = 1/4 Quick scheme
+ !! = 1/3 3rd order Upstream biased scheme
+ !! gamma2 = 0 2nd order finite differencing
+ !! = 1/32 4th order finite differencing
+ !! For stability reasons, the first term of the fluxes which cor-
+ !! responds to a second order centered scheme is evaluated using
+ !! the now velocity (centered in time) while the second term which
+ !! is the diffusive part of the scheme, is evaluated using the
+ !! before velocity (forward in time).
+ !! Default value (hard coded in the begining of the module) are
+ !! gamma1=1/3 and gamma2=1/32.
+ !!
+ !! In RK3 time stepping case, the optional arguments
+ !! (pau,pav,paw) are present. They are used as advective velocity
+ !! while the advected velocity remains (puu,pvv).
+ !!
+ !! ** Action : (puu,pvv)(:,:,:,Krhs) updated with the advective trend
+ !!
+ !! Reference : Shchepetkin & McWilliams, 2005, Ocean Modelling.
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: kt , Kbb, Kmm, Krhs ! ocean time-step and level indices
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), TARGET, INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
+ REAL(wp), DIMENSION(:,:,:), OPTIONAL, TARGET, INTENT(in ) :: pau, pav, paw ! advective velocity
+ !
+ INTEGER :: ji, jj, jk ! dummy loop indices
+ REAL(wp) :: zzu, zui, zfuj, zl_u, zzfu_kp1 ! local scalars
+ REAL(wp) :: zzv, zvj, zfvi, zl_v, zzfv_kp1 ! - -
+ REAL(wp), DIMENSION(A2D(2)) :: zfu_t, zfu_f, zfu
+ REAL(wp), DIMENSION(A2D(2)) :: zfv_t, zfv_f, zfv
+ REAL(wp), DIMENSION(A2D(2),2) :: zlu_uu, zlu_uv
+ REAL(wp), DIMENSION(A2D(2),2) :: zlv_vv, zlv_vu
+ REAL(wp), DIMENSION(:,:,:) , POINTER :: zpt_u, zpt_v, zpt_w
+ REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: zu_trd, zv_trd
+ !!----------------------------------------------------------------------
+ !
+ IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile
+ IF( kt == nit000 ) THEN
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) 'dyn_adv_ubs : UBS flux form momentum advection'
+ IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+ ENDIF
+ ENDIF
+ !
+ IF( l_trddyn ) THEN ! trends: send trend to trddyn for diagnostic
+ ALLOCATE( zu_trd(A2D(0),jpkm1), zv_trd(A2D(0),jpkm1) )
+ zu_trd(A2D(0),:) = puu(A2D(0),:,Krhs)
+ zv_trd(A2D(0),:) = pvv(A2D(0),:,Krhs)
+ ENDIF
+ !
+ IF( PRESENT( pau ) ) THEN ! RK3: advective velocity (pau,pav,paw) /= advected velocity (puu,pvv,ww)
+ zpt_u => pau(:,:,:)
+ zpt_v => pav(:,:,:)
+ zpt_w => paw(:,:,:)
+ ELSE ! MLF: advective velocity = (puu,pvv,ww)
+ zpt_u => puu(:,:,:,Kmm)
+ zpt_v => pvv(:,:,:,Kmm)
+ zpt_w => ww (:,:,: )
+ ENDIF
+ !
+ ! ! =========================== !
+ DO jk = 1, jpkm1 ! Laplacian of the velocity !
+ ! ! =========================== !
+ ! ! horizontal volume fluxes
+ DO_2D( 2, 2, 2, 2 )
+ zfu(ji,jj) = e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * zpt_u(ji,jj,jk)
+ zfv(ji,jj) = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * zpt_v(ji,jj,jk)
+ END_2D
+ !
+ DO_2D( 1, 1, 1, 1 ) ! laplacian
+ ! round brackets added to fix the order of floating point operations
+ ! needed to ensure halo 1 - halo 2 compatibility (north fold)
+!! zlu_uu(ji,jj,1) = ( ( puu(ji+1,jj ,jk,Kbb) + puu(ji-1,jj ,jk,Kbb) ) - 2._wp * puu(ji,jj,jk,Kbb) ) * umask(ji,jj,jk)
+!! zlv_vv(ji,jj,1) = ( ( pvv(ji ,jj+1,jk,Kbb) + pvv(ji ,jj-1,jk,Kbb) ) - 2._wp * pvv(ji,jj,jk,Kbb) ) * vmask(ji,jj,jk)
+ zlu_uu(ji,jj,1) = ( ( puu (ji+1,jj ,jk,Kbb) - puu (ji ,jj ,jk,Kbb) &
+ & ) & ! bracket for halo 1 - halo 2 compatibility
+ & + ( puu (ji-1,jj ,jk,Kbb) - puu (ji ,jj ,jk,Kbb) &
+ & ) ) * umask(ji ,jj ,jk)
+ zlv_vv(ji,jj,1) = ( ( pvv (ji ,jj+1,jk,Kbb) - pvv (ji ,jj ,jk,Kbb) &
+ & ) & ! bracket for halo 1 - halo 2 compatibility
+ & + ( pvv (ji ,jj-1,jk,Kbb) - pvv (ji ,jj ,jk,Kbb) &
+ & ) ) * vmask(ji ,jj ,jk)
+ zlu_uv(ji,jj,1) = ( puu(ji ,jj+1,jk,Kbb) - puu(ji ,jj ,jk,Kbb) ) * fmask(ji ,jj ,jk) &
+ & - ( puu(ji ,jj ,jk,Kbb) - puu(ji ,jj-1,jk,Kbb) ) * fmask(ji ,jj-1,jk)
+ zlv_vu(ji,jj,1) = ( pvv(ji+1,jj ,jk,Kbb) - pvv(ji ,jj ,jk,Kbb) ) * fmask(ji ,jj ,jk) &
+ & - ( pvv(ji ,jj ,jk,Kbb) - pvv(ji-1,jj ,jk,Kbb) ) * fmask(ji-1,jj ,jk)
+ !
+!! zlu_uu(ji,jj,2) = ( ( zfu(ji+1,jj ) + zfu(ji-1,jj ) ) - 2._wp * zfu(ji,jj) ) * umask(ji ,jj ,jk)
+!! zlv_vv(ji,jj,2) = ( ( zfv(ji ,jj+1) + zfv(ji ,jj-1) ) - 2._wp * zfv(ji,jj) ) * vmask(ji ,jj ,jk)
+ zlu_uu(ji,jj,2) = ( ( zfu(ji+1,jj ) - zfu(ji ,jj ) &
+ & ) & ! bracket for halo 1 - halo 2 compatibility
+ & + ( zfu(ji-1,jj ) - zfu(ji ,jj ) &
+ & ) ) * umask(ji ,jj ,jk)
+ zlv_vv(ji,jj,2) = ( ( zfv(ji ,jj+1) - zfv(ji ,jj ) &
+ & ) & ! bracket for halo 1 - halo 2 compatibility
+ & + ( zfv(ji ,jj-1) - zfv(ji ,jj ) &
+ & ) ) * vmask(ji ,jj ,jk)
+ zlu_uv(ji,jj,2) = ( zfu(ji ,jj+1) - zfu(ji ,jj ) ) * fmask(ji ,jj ,jk) &
+ & - ( zfu(ji ,jj ) - zfu(ji ,jj-1) ) * fmask(ji ,jj-1,jk)
+ zlv_vu(ji,jj,2) = ( zfv(ji+1,jj ) - zfv(ji ,jj ) ) * fmask(ji ,jj ,jk) &
+ & - ( zfv(ji ,jj ) - zfv(ji-1,jj ) ) * fmask(ji-1,jj ,jk)
+ END_2D
+ !
+ ! ! ====================== !
+ ! ! Horizontal advection !
+ ! ! ====================== !
+ ! ! horizontal volume fluxes
+ DO_2D( 1, 1, 1, 1 )
+ zfu(ji,jj) = 0.25_wp * zfu(ji,jj)
+ zfv(ji,jj) = 0.25_wp * zfv(ji,jj)
+ END_2D
+ !
+ DO_2D( 1, 0, 1, 0 ) ! horizontal momentum fluxes at T- and F-point
+ zui = ( puu(ji,jj,jk,Kmm) + puu(ji+1,jj ,jk,Kmm) )
+ zvj = ( pvv(ji,jj,jk,Kmm) + pvv(ji ,jj+1,jk,Kmm) )
+ !
+ IF( zui > 0 ) THEN ; zl_u = zlu_uu(ji ,jj,1)
+ ELSE ; zl_u = zlu_uu(ji+1,jj,1)
+ ENDIF
+ IF( zvj > 0 ) THEN ; zl_v = zlv_vv(ji,jj ,1)
+ ELSE ; zl_v = zlv_vv(ji,jj+1,1)
+ ENDIF
+ !
+ zfu_t(ji+1,jj ) = ( zfu(ji,jj) + zfu(ji+1,jj ) - gamma2 * ( zlu_uu(ji,jj,2) + zlu_uu(ji+1,jj ,2) ) ) &
+ & * ( zui - gamma1 * zl_u )
+ zfv_t(ji ,jj+1) = ( zfv(ji,jj) + zfv(ji ,jj+1) - gamma2 * ( zlv_vv(ji,jj,2) + zlv_vv(ji ,jj+1,2) ) ) &
+ & * ( zvj - gamma1 * zl_v )
+ !
+ zfuj = ( zfu(ji,jj) + zfu(ji ,jj+1) )
+ zfvi = ( zfv(ji,jj) + zfv(ji+1,jj ) )
+ IF( zfuj > 0 ) THEN ; zl_v = zlv_vu(ji ,jj,1)
+ ELSE ; zl_v = zlv_vu(ji+1,jj,1)
+ ENDIF
+ IF( zfvi > 0 ) THEN ; zl_u = zlu_uv(ji,jj ,1)
+ ELSE ; zl_u = zlu_uv(ji,jj+1,1)
+ ENDIF
+ !
+ zfv_f(ji ,jj ) = ( zfvi - gamma2 * ( zlv_vu(ji,jj,2) + zlv_vu(ji+1,jj ,2) ) ) &
+ & * ( puu(ji,jj,jk,Kmm) + puu(ji ,jj+1,jk,Kmm) - gamma1 * zl_u )
+ zfu_f(ji ,jj ) = ( zfuj - gamma2 * ( zlu_uv(ji,jj,2) + zlu_uv(ji ,jj+1,2) ) ) &
+ & * ( pvv(ji,jj,jk,Kmm) + pvv(ji+1,jj ,jk,Kmm) - gamma1 * zl_v )
+ END_2D
+ DO_2D( 0, 0, 0, 0 ) ! divergence of horizontal momentum fluxes
+ puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_t(ji+1,jj) - zfu_t(ji,jj ) &
+ & + zfv_f(ji ,jj) - zfv_f(ji,jj-1) ) * r1_e1e2u(ji,jj) &
+ & / e3u(ji,jj,jk,Kmm)
+ pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zfu_f(ji,jj ) - zfu_f(ji-1,jj) &
+ & + zfv_t(ji,jj+1) - zfv_t(ji ,jj) ) * r1_e1e2v(ji,jj) &
+ & / e3v(ji,jj,jk,Kmm)
+ END_2D
+ END DO
+ !
+ IF( l_trddyn ) THEN ! trends: send trend to trddyn for diagnostic
+ zu_trd(A2D(0),:) = puu(A2D(0),:,Krhs) - zu_trd(A2D(0),:)
+ zv_trd(A2D(0),:) = pvv(A2D(0),:,Krhs) - zv_trd(A2D(0),:)
+ CALL trd_dyn( zu_trd, zv_trd, jpdyn_keg, kt, Kmm )
+ zu_trd(A2D(0),:) = puu(A2D(0),:,Krhs)
+ zv_trd(A2D(0),:) = pvv(A2D(0),:,Krhs)
+ ENDIF
+ ! ! ==================== !
+ ! ! Vertical advection !
+ ! ! ==================== !
+ !
+#define zfu_uw zfu_t
+#define zfv_vw zfv_t
+#define zfw zfu
+ !
+ ! ! surface vertical fluxes
+ !
+ IF( ln_linssh ) THEN ! linear free surface: advection through the surface z=0
+ DO_2D( 0, 0, 0, 0 )
+ zfu_uw(ji,jj) = 0.5_wp * ( e1e2t(ji,jj) * zpt_w(ji,jj,1) + e1e2t(ji+1,jj) * zpt_w(ji+1,jj,1) ) * puu(ji,jj,1,Kmm)
+ zfv_vw(ji,jj) = 0.5_wp * ( e1e2t(ji,jj) * zpt_w(ji,jj,1) + e1e2t(ji,jj+1) * zpt_w(ji,jj+1,1) ) * pvv(ji,jj,1,Kmm)
+ END_2D
+ ELSE ! non linear free: surface advective fluxes set to zero
+ DO_2D( 0, 0, 0, 0 )
+ zfu_uw(ji,jj) = 0._wp
+ zfv_vw(ji,jj) = 0._wp
+ END_2D
+ ENDIF
+ !
+ DO jk = 1, jpk-2 ! divergence of advective fluxes
+ !
+ DO_2D( 0, 1, 0, 1 ) ! 1/4 * Vertical transport at level k+1
+ zfw(ji,jj) = 0.25_wp * e1e2t(ji,jj) * zpt_w(ji,jj,jk+1)
+ END_2D
+ DO_2D( 0, 0, 0, 0 )
+ ! ! vertical flux at level k+1
+ zzfu_kp1 = ( zfw(ji,jj) + zfw(ji+1,jj ) ) * ( puu(ji,jj,jk+1,Kmm) + puu(ji,jj,jk,Kmm) )
+ zzfv_kp1 = ( zfw(ji,jj) + zfw(ji ,jj+1) ) * ( pvv(ji,jj,jk+1,Kmm) + pvv(ji,jj,jk,Kmm) )
+ ! ! divergence of vertical momentum flux
+ puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj) - zzfu_kp1 ) * r1_e1e2u(ji,jj) &
+ & / e3u(ji,jj,jk,Kmm)
+ pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zfv_vw(ji,jj) - zzfv_kp1 ) * r1_e1e2v(ji,jj) &
+ & / e3v(ji,jj,jk,Kmm)
+ ! ! store vertical flux for next level calculation
+ zfu_uw(ji,jj) = zzfu_kp1
+ zfv_vw(ji,jj) = zzfv_kp1
+ END_2D
+ END DO
+ !
+ jk = jpkm1 ! compute last level (zzfu_kp1 = 0)
+ DO_2D( 0, 0, 0, 0 )
+ puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - zfu_uw(ji,jj) * r1_e1e2u(ji,jj) &
+ & / e3u(ji,jj,jk,Kmm)
+ pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - zfv_vw(ji,jj) * r1_e1e2v(ji,jj) &
+ & / e3v(ji,jj,jk,Kmm)
+ END_2D
+ !
+ IF( l_trddyn ) THEN ! trends: send trend to trddyn for diagnostic
+ zu_trd(A2D(0),:) = puu(A2D(0),:,Krhs) - zu_trd(A2D(0),:)
+ zv_trd(A2D(0),:) = pvv(A2D(0),:,Krhs) - zv_trd(A2D(0),:)
+ CALL trd_dyn( zu_trd, zv_trd, jpdyn_zad, kt, Kmm )
+ DEALLOCATE( zu_trd, zv_trd )
+ ENDIF
+ !
+#undef zfu_uw
+#undef zfv_vw
+#undef zfw
+ ! ! Control print
+ IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' ubs2 adv - Ua: ', mask1=umask, &
+ & tab3d_2=pvv(:,:,:,Krhs), clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )
+ !
+ END SUBROUTINE dyn_adv_ubs
+
+
+ SUBROUTINE dyn_adv_ubs_hls1( kt, Kbb, Kmm, puu, pvv, Krhs, pau, pav, paw )
!!----------------------------------------------------------------------
!! *** ROUTINE dyn_adv_ubs ***
!!
@@ -73,7 +311,6 @@ CONTAINS
!! Reference : Shchepetkin & McWilliams, 2005, Ocean Modelling.
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: kt , Kbb, Kmm, Krhs ! ocean time-step and level indices
- INTEGER , OPTIONAL , INTENT(in ) :: no_zad ! no vertical advection compotation
REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), TARGET, INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
REAL(wp), DIMENSION(:,:,:), OPTIONAL, TARGET, INTENT(in ) :: pau, pav, paw ! advective velocity
!
@@ -89,7 +326,7 @@ CONTAINS
IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile
IF( kt == nit000 ) THEN
IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*) 'dyn_adv_ubs : UBS flux form momentum advection'
+ IF(lwp) WRITE(numout,*) 'dyn_adv_ubs_hls1 : UBS flux form momentum advection'
IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
ENDIF
ENDIF
@@ -230,63 +467,44 @@ CONTAINS
! ! Vertical advection !
! ! ==================== !
!
- ! ! ======================== !
- IF( PRESENT( no_zad ) ) THEN ! No vertical advection ! (except if linear free surface)
- ! ! ======================== ! ------
- !
- IF( ln_linssh ) THEN ! linear free surface: advection through the surface z=0
- DO_2D( 0, 0, 0, 0 )
- zzu = 0.5_wp * ( e1e2t(ji,jj) * zpt_w(ji,jj,1) + e1e2t(ji+1,jj) * zpt_w(ji+1,jj,1) ) * puu(ji,jj,1,Kmm)
- zzv = 0.5_wp * ( e1e2t(ji,jj) * zpt_w(ji,jj,1) + e1e2t(ji,jj+1) * zpt_w(ji,jj+1,1) ) * pvv(ji,jj,1,Kmm)
- puu(ji,jj,1,Krhs) = puu(ji,jj,1,Krhs) - zzu * r1_e1e2u(ji,jj) &
- & / e3u(ji,jj,1,Kmm)
- pvv(ji,jj,1,Krhs) = pvv(ji,jj,1,Krhs) - zzv * r1_e1e2v(ji,jj) &
- & / e3v(ji,jj,1,Kmm)
- END_2D
- ENDIF
- ! ! =================== !
- ELSE ! Vertical advection !
- ! ! =================== !
- DO_2D( 0, 0, 0, 0 ) ! surface/bottom advective fluxes set to zero
- zfu_uw(ji,jj,jpk) = 0._wp
- zfv_vw(ji,jj,jpk) = 0._wp
- zfu_uw(ji,jj, 1 ) = 0._wp
- zfv_vw(ji,jj, 1 ) = 0._wp
+ DO_2D( 0, 0, 0, 0 ) ! surface/bottom advective fluxes set to zero
+ zfu_uw(ji,jj,jpk) = 0._wp
+ zfv_vw(ji,jj,jpk) = 0._wp
+ zfu_uw(ji,jj, 1 ) = 0._wp
+ zfv_vw(ji,jj, 1 ) = 0._wp
+ END_2D
+ IF( ln_linssh ) THEN ! constant volume : advection through the surface
+ DO_2D( 0, 0, 0, 0 )
+ zfu_uw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * zpt_w(ji,jj,1) + e1e2t(ji+1,jj) * zpt_w(ji+1,jj,1) ) * puu(ji,jj,1,Kmm)
+ zfv_vw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * zpt_w(ji,jj,1) + e1e2t(ji,jj+1) * zpt_w(ji,jj+1,1) ) * pvv(ji,jj,1,Kmm)
END_2D
- IF( ln_linssh ) THEN ! constant volume : advection through the surface
- DO_2D( 0, 0, 0, 0 )
- zfu_uw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * zpt_w(ji,jj,1) + e1e2t(ji+1,jj) * zpt_w(ji+1,jj,1) ) * puu(ji,jj,1,Kmm)
- zfv_vw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * zpt_w(ji,jj,1) + e1e2t(ji,jj+1) * zpt_w(ji,jj+1,1) ) * pvv(ji,jj,1,Kmm)
- END_2D
- ENDIF
- DO jk = 2, jpkm1 ! interior fluxes
- DO_2D( 0, 1, 0, 1 )
- zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * zpt_w(ji,jj,jk)
- END_2D
- DO_2D( 0, 0, 0, 0 )
- zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji,jj,jk-1,Kmm) )
- zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk-1,Kmm) )
- END_2D
- END DO
- DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! divergence of vertical momentum flux divergence
- puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) &
- & / e3u(ji,jj,jk,Kmm)
- pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) &
- & / e3v(ji,jj,jk,Kmm)
- END_3D
- !
- IF( l_trddyn ) THEN ! save the vertical advection trend for diagnostic
- zfu_t(:,:,:) = puu(:,:,:,Krhs) - zfu_t(:,:,:)
- zfv_t(:,:,:) = pvv(:,:,:,Krhs) - zfv_t(:,:,:)
- CALL trd_dyn( zfu_t, zfv_t, jpdyn_zad, kt, Kmm )
- ENDIF
- ! ! Control print
- IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' ubs2 adv - Ua: ', mask1=umask, &
- & tab3d_2=pvv(:,:,:,Krhs), clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )
- !
ENDIF
+ DO jk = 2, jpkm1 ! interior fluxes
+ DO_2D( 0, 1, 0, 1 )
+ zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * zpt_w(ji,jj,jk)
+ END_2D
+ DO_2D( 0, 0, 0, 0 )
+ zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji,jj,jk-1,Kmm) )
+ zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk-1,Kmm) )
+ END_2D
+ END DO
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! divergence of vertical momentum flux divergence
+ puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) &
+ & / e3u(ji,jj,jk,Kmm)
+ pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) &
+ & / e3v(ji,jj,jk,Kmm)
+ END_3D
!
- END SUBROUTINE dyn_adv_ubs
+ IF( l_trddyn ) THEN ! save the vertical advection trend for diagnostic
+ zfu_t(:,:,:) = puu(:,:,:,Krhs) - zfu_t(:,:,:)
+ zfv_t(:,:,:) = pvv(:,:,:,Krhs) - zfv_t(:,:,:)
+ CALL trd_dyn( zfu_t, zfv_t, jpdyn_zad, kt, Kmm )
+ ENDIF
+ ! ! Control print
+ IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' ubs2 adv - Ua: ', mask1=umask, &
+ & tab3d_2=pvv(:,:,:,Krhs), clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )
+ !
+ END SUBROUTINE dyn_adv_ubs_hls1
!!==============================================================================
END MODULE dynadv_ubs
diff --git a/src/OCE/DYN/dynatf.F90 b/src/OCE/DYN/dynatf.F90
index 1a5df99676dabf0493e33335dc2564cc3ce6a8fb..86439f5870953748f9e5c1be814e12cc5be4acbe 100644
--- a/src/OCE/DYN/dynatf.F90
+++ b/src/OCE/DYN/dynatf.F90
@@ -328,7 +328,7 @@ CONTAINS
!
IF ( iom_use("utau") ) THEN
IF ( ln_drgice_imp.OR.ln_isfcav ) THEN
- ALLOCATE(zutau(jpi,jpj))
+ ALLOCATE(zutau(A2D(0)))
DO_2D( 0, 0, 0, 0 )
jk = miku(ji,jj)
zutau(ji,jj) = utau(ji,jj) + 0.5_wp * rho0 * rCdU_top(ji,jj) * ( puu(ji-1,jj,jk,Kaa) + puu(ji,jj,jk,Kaa) )
@@ -336,13 +336,13 @@ CONTAINS
CALL iom_put( "utau", zutau(:,:) )
DEALLOCATE(zutau)
ELSE
- CALL iom_put( "utau", utau(:,:) )
+ CALL iom_put( "utau", utau(A2D(0)) )
ENDIF
ENDIF
!
IF ( iom_use("vtau") ) THEN
IF ( ln_drgice_imp.OR.ln_isfcav ) THEN
- ALLOCATE(zvtau(jpi,jpj))
+ ALLOCATE(zvtau(A2D(0)))
DO_2D( 0, 0, 0, 0 )
jk = mikv(ji,jj)
zvtau(ji,jj) = vtau(ji,jj) + 0.5_wp * rho0 * rCdU_top(ji,jj) * ( pvv(ji,jj-1,jk,Kaa) + pvv(ji,jj,jk,Kaa) )
@@ -350,7 +350,7 @@ CONTAINS
CALL iom_put( "vtau", zvtau(:,:) )
DEALLOCATE(zvtau)
ELSE
- CALL iom_put( "vtau", vtau(:,:) )
+ CALL iom_put( "vtau", vtau(A2D(0)) )
ENDIF
ENDIF
!
diff --git a/src/OCE/DYN/dynatf_qco.F90 b/src/OCE/DYN/dynatf_qco.F90
index 3dd46032e952fc59270a5047155ac46c1570516a..7ec004fb3026de24f4dfde21976263fd6c4c9908 100644
--- a/src/OCE/DYN/dynatf_qco.F90
+++ b/src/OCE/DYN/dynatf_qco.F90
@@ -245,7 +245,7 @@ CONTAINS
!
IF ( iom_use("utau") ) THEN
IF ( ln_drgice_imp.OR.ln_isfcav ) THEN
- ALLOCATE(zutau(jpi,jpj))
+ ALLOCATE(zutau(A2D(0)))
DO_2D( 0, 0, 0, 0 )
jk = miku(ji,jj)
zutau(ji,jj) = utau(ji,jj) + 0.5_wp * rho0 * rCdU_top(ji,jj) * ( puu(ji-1,jj,jk,Kaa) + puu(ji,jj,jk,Kaa) )
@@ -253,13 +253,13 @@ CONTAINS
CALL iom_put( "utau", zutau(:,:) )
DEALLOCATE(zutau)
ELSE
- CALL iom_put( "utau", utau(:,:) )
+ CALL iom_put( "utau", utau(A2D(0)) )
ENDIF
ENDIF
!
IF ( iom_use("vtau") ) THEN
IF ( ln_drgice_imp.OR.ln_isfcav ) THEN
- ALLOCATE(zvtau(jpi,jpj))
+ ALLOCATE(zvtau(A2D(0)))
DO_2D( 0, 0, 0, 0 )
jk = mikv(ji,jj)
zvtau(ji,jj) = vtau(ji,jj) + 0.5_wp * rho0 * rCdU_top(ji,jj) * ( pvv(ji,jj-1,jk,Kaa) + pvv(ji,jj,jk,Kaa) )
@@ -267,7 +267,7 @@ CONTAINS
CALL iom_put( "vtau", zvtau(:,:) )
DEALLOCATE(zvtau)
ELSE
- CALL iom_put( "vtau", vtau(:,:) )
+ CALL iom_put( "vtau", vtau(A2D(0)) )
ENDIF
ENDIF
!
diff --git a/src/OCE/DYN/dynkeg.F90 b/src/OCE/DYN/dynkeg.F90
index d751899d0de9266477ed7f9ecc26941906cba84d..10e4134b8a2d1efd9ab751ce09b5b8b82c23a6f2 100644
--- a/src/OCE/DYN/dynkeg.F90
+++ b/src/OCE/DYN/dynkeg.F90
@@ -6,7 +6,8 @@ MODULE dynkeg
!! History : 1.0 ! 1987-09 (P. Andrich, M.-A. Foujols) Original code
!! 7.0 ! 1997-05 (G. Madec) Split dynber into dynkeg and dynhpg
!! NEMO 1.0 ! 2002-07 (G. Madec) F90: Free form and module
- !! 3.6 ! 2015-05 (N. Ducousso, G. Madec) add Hollingsworth scheme as an option
+ !! 3.6 ! 2015-05 (N. Ducousso, G. Madec) add Hollingsworth scheme as an option
+ !! 4.5 ! 2022-06 (S. Techene, G, Madec) refactorization to reduce local memory usage
!!----------------------------------------------------------------------
!!----------------------------------------------------------------------
@@ -27,7 +28,8 @@ MODULE dynkeg
IMPLICIT NONE
PRIVATE
- PUBLIC dyn_keg ! routine called by step module
+ PUBLIC dyn_keg ! routine called by step module
+ PUBLIC dyn_keg_hls1 ! routine called by step module
INTEGER, PARAMETER, PUBLIC :: nkeg_C2 = 0 !: 2nd order centered scheme (standard scheme)
INTEGER, PARAMETER, PUBLIC :: nkeg_HW = 1 !: Hollingsworth et al., QJRMS, 1983
@@ -44,6 +46,123 @@ MODULE dynkeg
CONTAINS
SUBROUTINE dyn_keg( kt, kscheme, Kmm, puu, pvv, Krhs )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE dyn_keg ***
+ !!
+ !! ** Purpose : Compute the now momentum trend due to the horizontal
+ !! gradient of the horizontal kinetic energy and add it to the
+ !! general momentum trend.
+ !!
+ !! ** Method : * kscheme = nkeg_C2 : 2nd order centered scheme that
+ !! conserve kinetic energy. Compute the now horizontal kinetic energy
+ !! zhke = 1/2 [ mi-1( un^2 ) + mj-1( vn^2 ) ]
+ !! * kscheme = nkeg_HW : Hollingsworth correction following
+ !! Arakawa (2001). The now horizontal kinetic energy is given by:
+ !! zhke = 1/6 [ mi-1( 2 * un^2 + ((u(j+1)+u(j-1))/2)^2 )
+ !! + mj-1( 2 * vn^2 + ((v(i+1)+v(i-1))/2)^2 ) ]
+ !!
+ !! Take its horizontal gradient and add it to the general momentum
+ !! trend.
+ !! u(rhs) = u(rhs) - 1/e1u di[ zhke ]
+ !! v(rhs) = v(rhs) - 1/e2v dj[ zhke ]
+ !!
+ !! ** Action : - Update the (puu(:,:,:,Krhs), pvv(:,:,:,Krhs)) with the hor. ke gradient trend
+ !! - send this trends to trd_dyn (l_trddyn=T) for post-processing
+ !!
+ !! ** References : Arakawa, A., International Geophysics 2001.
+ !! Hollingsworth et al., Quart. J. Roy. Meteor. Soc., 1983.
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: kt ! ocean time-step index
+ INTEGER , INTENT(in ) :: kscheme ! =0/1 type of KEG scheme
+ INTEGER , INTENT(in ) :: Kmm, Krhs ! ocean time level indices
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
+ !
+ INTEGER :: ji, jj, jk ! dummy loop indices
+ REAL(wp) :: zu, zv ! local scalars
+ REAL(wp), DIMENSION(:,: ) , ALLOCATABLE :: zhke
+ REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: zu_trd, zv_trd
+ !!----------------------------------------------------------------------
+ !
+ IF( ln_timing ) CALL timing_start('dyn_keg')
+ !
+ IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile
+ IF( kt == nit000 ) THEN
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) 'dyn_keg : kinetic energy gradient trend, scheme number=', kscheme
+ IF(lwp) WRITE(numout,*) '~~~~~~~'
+ ENDIF
+ ENDIF
+ !
+ IF( l_trddyn ) THEN ! Save the input trends
+ ALLOCATE( zu_trd(A2D(0),jpk), zv_trd(A2D(0),jpk) )
+ zu_trd(A2D(0),:) = puu(A2D(0),:,Krhs)
+ zv_trd(A2D(0),:) = pvv(A2D(0),:,Krhs)
+ ENDIF
+ !
+ SELECT CASE ( kscheme )
+ !
+ CASE ( nkeg_C2 ) !== Standard scheme ==!
+ ALLOCATE( zhke(A2D(1)) )
+ DO jk = 1, jpkm1
+ DO_2D( 0, 1, 0, 1 ) !* Horizontal kinetic energy at T-point
+ zu = puu(ji-1,jj ,jk,Kmm) * puu(ji-1,jj ,jk,Kmm) &
+ & + puu(ji ,jj ,jk,Kmm) * puu(ji ,jj ,jk,Kmm)
+ zv = pvv(ji ,jj-1,jk,Kmm) * pvv(ji ,jj-1,jk,Kmm) &
+ & + pvv(ji ,jj ,jk,Kmm) * pvv(ji ,jj ,jk,Kmm)
+ zhke(ji,jj) = 0.25_wp * ( zv + zu )
+ END_2D
+ !
+ DO_2D( 0, 0, 0, 0 ) !* grad( KE ) added to the general momentum trends
+ puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zhke(ji+1,jj ) - zhke(ji,jj) ) * r1_e1u(ji,jj)
+ pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zhke(ji ,jj+1) - zhke(ji,jj) ) * r1_e2v(ji,jj)
+ END_2D
+ END DO
+ DEALLOCATE( zhke )
+ !
+ CASE ( nkeg_HW ) !* Hollingsworth scheme
+ ALLOCATE( zhke(A2D(1)) )
+ DO jk = 1, jpkm1
+ DO_2D( 0, 1, 0, 1 )
+ ! round brackets added to fix the order of floating point operations
+ ! needed to ensure halo 1 - halo 2 compatibility
+ zu = ( puu(ji-1,jj ,jk,Kmm) * puu(ji-1,jj ,jk,Kmm) &
+ & + puu(ji ,jj ,jk,Kmm) * puu(ji ,jj ,jk,Kmm) ) * 8._wp &
+ & + ( ( puu(ji-1,jj-1,jk,Kmm) + puu(ji-1,jj+1,jk,Kmm) ) * ( puu(ji-1,jj-1,jk,Kmm) + puu(ji-1,jj+1,jk,Kmm) ) &
+ & + ( puu(ji ,jj-1,jk,Kmm) + puu(ji ,jj+1,jk,Kmm) ) * ( puu(ji ,jj-1,jk,Kmm) + puu(ji ,jj+1,jk,Kmm) ) &
+ & ) ! bracket for halo 1 - halo 2 compatibility
+ zv = ( pvv(ji ,jj-1,jk,Kmm) * pvv(ji ,jj-1,jk,Kmm) &
+ & + pvv(ji ,jj ,jk,Kmm) * pvv(ji ,jj ,jk,Kmm) ) * 8._wp &
+ & + ( ( pvv(ji-1,jj-1,jk,Kmm) + pvv(ji+1,jj-1,jk,Kmm) ) * ( pvv(ji-1,jj-1,jk,Kmm) + pvv(ji+1,jj-1,jk,Kmm) ) &
+ & + ( pvv(ji-1,jj ,jk,Kmm) + pvv(ji+1,jj ,jk,Kmm) ) * ( pvv(ji-1,jj ,jk,Kmm) + pvv(ji+1,jj ,jk,Kmm) ) &
+ & ) ! bracket for halo 1 - halo 2 compatibility
+ zhke(ji,jj) = r1_48 * ( zv + zu )
+ END_2D
+ !
+ DO_2D( 0, 0, 0, 0 ) !* grad( KE ) added to the general momentum trends
+ puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zhke(ji+1,jj ) - zhke(ji,jj) ) * r1_e1u(ji,jj)
+ pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zhke(ji ,jj+1) - zhke(ji,jj) ) * r1_e2v(ji,jj)
+ END_2D
+ END DO
+ DEALLOCATE( zhke )
+ !
+ END SELECT
+ !
+ IF( l_trddyn ) THEN ! save the Kinetic Energy trends for diagnostic
+ zu_trd(A2D(0),:) = puu(A2D(0),:,Krhs) - zu_trd(A2D(0),:)
+ zv_trd(A2D(0),:) = pvv(A2D(0),:,Krhs) - zv_trd(A2D(0),:)
+ CALL trd_dyn( zu_trd, zv_trd, jpdyn_keg, kt, Kmm )
+ DEALLOCATE( zu_trd, zv_trd )
+ ENDIF
+ !
+ IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' keg - Ua: ', mask1=umask, &
+ & tab3d_2=pvv(:,:,:,Krhs), clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )
+ !
+ IF( ln_timing ) CALL timing_stop('dyn_keg')
+ !
+ END SUBROUTINE dyn_keg
+
+
+ SUBROUTINE dyn_keg_hls1( kt, kscheme, Kmm, puu, pvv, Krhs )
!!----------------------------------------------------------------------
!! *** ROUTINE dyn_keg ***
!!
@@ -86,7 +205,7 @@ CONTAINS
IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile
IF( kt == nit000 ) THEN
IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*) 'dyn_keg : kinetic energy gradient trend, scheme number=', kscheme
+ IF(lwp) WRITE(numout,*) 'dyn_keg_hls1 : kinetic energy gradient trend, scheme number=', kscheme
IF(lwp) WRITE(numout,*) '~~~~~~~'
ENDIF
ENDIF
@@ -147,7 +266,7 @@ CONTAINS
!
IF( ln_timing ) CALL timing_stop('dyn_keg')
!
- END SUBROUTINE dyn_keg
+ END SUBROUTINE dyn_keg_hls1
!!======================================================================
END MODULE dynkeg
diff --git a/src/OCE/DYN/dynvor.F90 b/src/OCE/DYN/dynvor.F90
index 03dda78ceb4f6ce993419062208a9240e3ae7d75..b7a84124a27df69f6ea82b1622683c7a2be8470b 100644
--- a/src/OCE/DYN/dynvor.F90
+++ b/src/OCE/DYN/dynvor.F90
@@ -22,6 +22,7 @@ MODULE dynvor
!! - ! 2018-04 (G. Madec) add pre-computed gradient for metric term calculation
!! 4.x ! 2020-03 (G. Madec, A. Nasser) make ln_dynvor_msk truly efficient on relative vorticity
!! 4.2 ! 2020-12 (G. Madec, E. Clementi) add vortex force trends (ln_vortex_force=T)
+ !! 4.5 ! 2022-06 (S. Techene, G, Madec) refactorization to reduce local memory usage
!!----------------------------------------------------------------------
!!----------------------------------------------------------------------
@@ -172,11 +173,20 @@ CONTAINS
CALL vor_enT( kt, Kmm, ntot, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend and vortex force
ENDIF
CASE( np_EET ) !* energy conserving scheme (een scheme using e3t)
+ IF( nn_hls == 1 ) THEN
+ CALL vor_eeT_hls1( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! total vorticity trend
+ IF( ln_stcor .AND. .NOT. ln_vortex_force ) THEN
+ CALL vor_eeT_hls1( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend
+ ELSE IF( ln_stcor .AND. ln_vortex_force ) THEN
+ CALL vor_eeT_hls1( kt, Kmm, ntot, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend and vortex force
+ ENDIF
+ ELSE
CALL vor_eeT( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! total vorticity trend
- IF( ln_stcor .AND. .NOT. ln_vortex_force ) THEN
+ IF( ln_stcor .AND. .NOT. ln_vortex_force ) THEN
CALL vor_eeT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend
- ELSE IF( ln_stcor .AND. ln_vortex_force ) THEN
+ ELSE IF( ln_stcor .AND. ln_vortex_force ) THEN
CALL vor_eeT( kt, Kmm, ntot, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend and vortex force
+ ENDIF
ENDIF
CASE( np_ENE ) !* energy conserving scheme
CALL vor_ene( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! total vorticity trend
@@ -199,11 +209,20 @@ CONTAINS
IF( ln_stcor ) CALL vor_ene( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend
IF( ln_vortex_force ) CALL vor_ens( kt, Kmm, nrvm, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add vortex force
CASE( np_EEN ) !* energy and enstrophy conserving scheme
+ IF( nn_hls == 1 ) THEN
+ CALL vor_een_hls1( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! total vorticity trend
+ IF( ln_stcor .AND. .NOT. ln_vortex_force ) THEN
+ CALL vor_een_hls1( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend
+ ELSE IF( ln_stcor .AND. ln_vortex_force ) THEN
+ CALL vor_een_hls1( kt, Kmm, ntot, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend and vortex force
+ ENDIF
+ ELSE
CALL vor_een( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! total vorticity trend
- IF( ln_stcor .AND. .NOT. ln_vortex_force ) THEN
+ IF( ln_stcor .AND. .NOT. ln_vortex_force ) THEN
CALL vor_een( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend
- ELSE IF( ln_stcor .AND. ln_vortex_force ) THEN
+ ELSE IF( ln_stcor .AND. ln_vortex_force ) THEN
CALL vor_een( kt, Kmm, ntot, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend and vortex force
+ ENDIF
ENDIF
END SELECT
!
@@ -320,7 +339,122 @@ CONTAINS
!
INTEGER :: ji, jj, jk ! dummy loop indices
REAL(wp) :: zx1, zy1, zx2, zy2 ! local scalars
- REAL(wp), DIMENSION(A2D(nn_hls)) :: zwx, zwy, zwt ! 2D workspace
+ REAL(wp), DIMENSION(A2D(1)) :: zwx, zwy, zwt ! 2D workspace
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zwz ! 3D workspace, jpkm1 -> avoid lbc_lnk on jpk that is not defined
+ !!----------------------------------------------------------------------
+ !
+ IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile
+ IF( kt == nit000 ) THEN
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) 'dyn:vor_enT : vorticity term: t-point energy conserving scheme'
+ IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+ ENDIF
+ ENDIF
+ !
+ !
+ ! ! ===============
+ DO jk = 1, jpkm1 ! Horizontal slab
+ ! ! ===============
+ !
+ SELECT CASE( kvor ) !== relative vorticity considered ==!
+ !
+ CASE ( np_RVO , np_CRV ) !* relative vorticity at f-point is used
+ ALLOCATE( zwz(A2D(1)) )
+ DO_2D( 1, 1, 1, 1 )
+ zwz(ji,jj) = ( e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk) &
+ & - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj)
+ END_2D
+ IF( ln_dynvor_msk ) THEN ! mask relative vorticity
+ DO_2D( 1, 1, 1, 1 )
+ zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk)
+ END_2D
+ ENDIF
+ !
+ END SELECT
+ !
+ SELECT CASE( kvor ) !== volume weighted vorticity considered ==!
+ !
+ CASE ( np_COR ) !* Coriolis (planetary vorticity)
+ DO_2D( 0, 1, 0, 1 )
+ zwt(ji,jj) = ff_t(ji,jj) * e1e2t(ji,jj)*e3t(ji,jj,jk,Kmm)
+ END_2D
+ CASE ( np_RVO ) !* relative vorticity
+ DO_2D( 0, 1, 0, 1 )
+ zwt(ji,jj) = r1_4 * ( zwz(ji-1,jj ) + zwz(ji,jj ) &
+ & + zwz(ji-1,jj-1) + zwz(ji,jj-1) ) &
+ & * e1e2t(ji,jj)*e3t(ji,jj,jk,Kmm)
+ END_2D
+ CASE ( np_MET ) !* metric term
+ DO_2D( 0, 1, 0, 1 )
+ zwt(ji,jj) = ( ( pv(ji,jj,jk) + pv(ji,jj-1,jk) ) * di_e2u_2(ji,jj) &
+ & - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj) ) &
+ & * e3t(ji,jj,jk,Kmm)
+ END_2D
+ CASE ( np_CRV ) !* Coriolis + relative vorticity
+ DO_2D( 0, 1, 0, 1 )
+ zwt(ji,jj) = ( ff_t(ji,jj) + r1_4 * ( zwz(ji-1,jj ) + zwz(ji,jj ) &
+ & + zwz(ji-1,jj-1) + zwz(ji,jj-1) ) ) &
+ & * e1e2t(ji,jj)*e3t(ji,jj,jk,Kmm)
+ END_2D
+ CASE ( np_CME ) !* Coriolis + metric
+ DO_2D( 0, 1, 0, 1 )
+ zwt(ji,jj) = ( ff_t(ji,jj) * e1e2t(ji,jj) &
+ & + ( pv(ji,jj,jk) + pv(ji,jj-1,jk) ) * di_e2u_2(ji,jj) &
+ & - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj) ) &
+ & * e3t(ji,jj,jk,Kmm)
+ END_2D
+ CASE DEFAULT ! error
+ CALL ctl_stop('STOP','dyn_vor: wrong value for kvor')
+ END SELECT
+ !
+ ! !== compute and add the vorticity term trend =!
+ DO_2D( 0, 0, 0, 0 )
+ pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + r1_4 * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) &
+ & * ( zwt(ji+1,jj) * ( pv(ji+1,jj,jk) + pv(ji+1,jj-1,jk) ) &
+ & + zwt(ji ,jj) * ( pv(ji ,jj,jk) + pv(ji ,jj-1,jk) ) )
+ !
+ pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) - r1_4 * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm) &
+ & * ( zwt(ji,jj+1) * ( pu(ji,jj+1,jk) + pu(ji-1,jj+1,jk) ) &
+ & + zwt(ji,jj ) * ( pu(ji,jj ,jk) + pu(ji-1,jj ,jk) ) )
+ END_2D
+ ! ! ===============
+ END DO ! End of slab
+ ! ! ===============
+ !
+ SELECT CASE( kvor ) ! deallocate zwz if necessary
+ CASE ( np_RVO , np_CRV ) ; DEALLOCATE( zwz )
+ END SELECT
+ !
+ END SUBROUTINE vor_enT
+
+
+ SUBROUTINE vor_enT_hls1( kt, Kmm, kvor, pu, pv, pu_rhs, pv_rhs )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE vor_enT ***
+ !!
+ !! ** Purpose : Compute the now total vorticity trend and add it to
+ !! the general trend of the momentum equation.
+ !!
+ !! ** Method : Trend evaluated using now fields (centered in time)
+ !! and t-point evaluation of vorticity (planetary and relative).
+ !! conserves the horizontal kinetic energy.
+ !! The general trend of momentum is increased due to the vorticity
+ !! term which is given by:
+ !! voru = 1/bu mj[ ( mi(mj(bf*rvor))+bt*f_t)/e3t mj[vn] ]
+ !! vorv = 1/bv mi[ ( mi(mj(bf*rvor))+bt*f_t)/e3f mj[un] ]
+ !! where rvor is the relative vorticity at f-point
+ !!
+ !! ** Action : - Update (pu_rhs,pv_rhs) with the now vorticity term trend
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: kt ! ocean time-step index
+ INTEGER , INTENT(in ) :: Kmm ! ocean time level index
+ INTEGER , INTENT(in ) :: kvor ! total, planetary, relative, or metric
+ REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu, pv ! now velocities
+ REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu_rhs, pv_rhs ! total v-trend
+ !
+ INTEGER :: ji, jj, jk ! dummy loop indices
+ REAL(wp) :: zx1, zy1, zx2, zy2 ! local scalars
+ REAL(wp), DIMENSION(A2D(1)) :: zwx, zwy, zwt ! 2D workspace
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zwz ! 3D workspace, jpkm1 -> avoid lbc_lnk on jpk that is not defined
!!----------------------------------------------------------------------
!
@@ -336,7 +470,7 @@ CONTAINS
SELECT CASE( kvor ) !== relative vorticity considered ==!
!
CASE ( np_RVO , np_CRV ) !* relative vorticity at f-point is used
- ALLOCATE( zwz(A2D(nn_hls),jpk) )
+ ALLOCATE( zwz(A2D(1),jpk) )
DO jk = 1, jpkm1 ! Horizontal slab
DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
zwz(ji,jj,jk) = ( e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk) &
@@ -409,7 +543,7 @@ CONTAINS
CASE ( np_RVO , np_CRV ) ; DEALLOCATE( zwz )
END SELECT
!
- END SUBROUTINE vor_enT
+ END SUBROUTINE vor_enT_hls1
SUBROUTINE vor_ene( kt, Kmm, kvor, pu, pv, pu_rhs, pv_rhs )
@@ -440,7 +574,7 @@ CONTAINS
!
INTEGER :: ji, jj, jk ! dummy loop indices
REAL(wp) :: zx1, zy1, zx2, zy2, ze3f, zmsk ! local scalars
- REAL(wp), DIMENSION(A2D(nn_hls)) :: zwx, zwy, zwz ! 2D workspace
+ REAL(wp), DIMENSION(A2D(1)) :: zwx, zwy, zwz ! 2D workspace
!!----------------------------------------------------------------------
!
IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile
@@ -573,7 +707,7 @@ CONTAINS
!
INTEGER :: ji, jj, jk ! dummy loop indices
REAL(wp) :: zuav, zvau, ze3f, zmsk ! local scalars
- REAL(wp), DIMENSION(A2D(nn_hls)) :: zwx, zwy, zwz ! 2D workspace
+ REAL(wp), DIMENSION(A2D(1)) :: zwx, zwy, zwz ! 2D workspace
!!----------------------------------------------------------------------
!
IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile
@@ -705,16 +839,176 @@ CONTAINS
INTEGER :: ierr ! local integer
REAL(wp) :: zua, zva ! local scalars
REAL(wp) :: zmsk, ze3f ! local scalars
- REAL(wp), DIMENSION(A2D(nn_hls)) :: z1_e3f
+ REAL(wp), DIMENSION(A2D(1)) :: z1_e3f
#if defined key_loop_fusion
REAL(wp) :: ztne, ztnw, ztnw_ip1, ztse, ztse_jp1, ztsw_jp1, ztsw_ip1
REAL(wp) :: zwx, zwx_im1, zwx_jp1, zwx_im1_jp1
REAL(wp) :: zwy, zwy_ip1, zwy_jm1, zwy_ip1_jm1
#else
- REAL(wp), DIMENSION(A2D(nn_hls)) :: zwx , zwy
- REAL(wp), DIMENSION(A2D(nn_hls)) :: ztnw, ztne, ztsw, ztse
+ REAL(wp), DIMENSION(A2D(1)) :: zwx , zwy
+ REAL(wp), DIMENSION(A2D(1)) :: ztnw, ztne, ztsw, ztse
#endif
- REAL(wp), DIMENSION(A2D(nn_hls),jpkm1) :: zwz ! 3D workspace, jpkm1 -> jpkm1 -> avoid lbc_lnk on jpk that is not defined
+ REAL(wp), DIMENSION(A2D(1)) :: zwz ! 3D workspace, jpkm1 -> jpkm1 -> avoid lbc_lnk on jpk that is not defined
+ !!----------------------------------------------------------------------
+ !
+ IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile
+ IF( kt == nit000 ) THEN
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) 'dyn:vor_een : vorticity term: energy and enstrophy conserving scheme'
+ IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+ ENDIF
+ ENDIF
+ !
+ ! ! ===============
+ DO jk = 1, jpkm1 ! Horizontal slab
+ ! ! ===============
+ !
+#if defined key_qco || defined key_linssh
+ DO_2D( 1, 1, 1, 1 ) ! == reciprocal of e3 at F-point (key_qco)
+ z1_e3f(ji,jj) = 1._wp / e3f_vor(ji,jj,jk)
+ END_2D
+#else
+ SELECT CASE( nn_e3f_typ ) ! == reciprocal of e3 at F-point
+ CASE ( 0 ) ! original formulation (masked averaging of e3t divided by 4)
+ DO_2D( 1, 1, 1, 1 )
+ ! round brackets added to fix the order of floating point operations
+ ! needed to ensure halo 1 - halo 2 compatibility
+ ze3f = ( (e3t(ji ,jj+1,jk,Kmm)*tmask(ji ,jj+1,jk) &
+ & + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk)) &
+ & + (e3t(ji ,jj ,jk,Kmm)*tmask(ji ,jj ,jk) &
+ & + e3t(ji+1,jj ,jk,Kmm)*tmask(ji+1,jj ,jk)) )
+ IF( ze3f /= 0._wp ) THEN ; z1_e3f(ji,jj) = 4._wp / ze3f
+ ELSE ; z1_e3f(ji,jj) = 0._wp
+ ENDIF
+ END_2D
+ CASE ( 1 ) ! new formulation (masked averaging of e3t divided by the sum of mask)
+ DO_2D( 1, 1, 1, 1 )
+ ! round brackets added to fix the order of floating point operations
+ ! needed to ensure halo 1 - halo 2 compatibility
+ ze3f = ( (e3t(ji ,jj+1,jk,Kmm)*tmask(ji ,jj+1,jk) &
+ & + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk)) &
+ & + (e3t(ji ,jj ,jk,Kmm)*tmask(ji ,jj ,jk) &
+ & + e3t(ji+1,jj ,jk,Kmm)*tmask(ji+1,jj ,jk)) )
+ zmsk = ( tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk) &
+ & + tmask(ji,jj ,jk) + tmask(ji+1,jj ,jk) )
+ IF( ze3f /= 0._wp ) THEN ; z1_e3f(ji,jj) = zmsk / ze3f
+ ELSE ; z1_e3f(ji,jj) = 0._wp
+ ENDIF
+ END_2D
+ END SELECT
+#endif
+ !
+ SELECT CASE( kvor ) !== vorticity considered ==!
+ !
+ CASE ( np_COR ) !* Coriolis (planetary vorticity)
+ DO_2D( 1, 1, 1, 1 )
+ zwz(ji,jj) = ff_f(ji,jj) * z1_e3f(ji,jj)
+ END_2D
+ CASE ( np_RVO ) !* relative vorticity
+ DO_2D( 1, 1, 1, 1 )
+ zwz(ji,jj) = ( e2v(ji+1,jj ) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk) &
+ & - e1u(ji ,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj)*z1_e3f(ji,jj)
+ END_2D
+ IF( ln_dynvor_msk ) THEN ! mask the relative vorticity
+ DO_2D( 1, 1, 1, 1 )
+ zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk)
+ END_2D
+ ENDIF
+ CASE ( np_MET ) !* metric term
+ DO_2D( 1, 1, 1, 1 )
+ zwz(ji,jj) = ( ( pv(ji+1,jj,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) &
+ & - ( pu(ji,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) ) * z1_e3f(ji,jj)
+ END_2D
+ CASE ( np_CRV ) !* Coriolis + relative vorticity
+ DO_2D( 1, 1, 1, 1 )
+ ! round brackets added to fix the order of floating point operations
+ ! needed to ensure halo 1 - halo 2 compatibility
+ zwz(ji,jj) = ( ff_f(ji,jj) + ( ( e2v(ji+1,jj ) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk) &
+ & ) & ! bracket for halo 1 - halo 2 compatibility
+ & - ( e1u(ji ,jj+1) * pu(ji,jj+1,jk) - e1u(ji,jj) * pu(ji,jj,jk) &
+ & ) & ! bracket for halo 1 - halo 2 compatibility
+ & ) * r1_e1e2f(ji,jj) ) * z1_e3f(ji,jj)
+ END_2D
+ IF( ln_dynvor_msk ) THEN ! mask the relative vorticity
+ DO_2D( 1, 1, 1, 1 )
+ zwz(ji,jj) = ( zwz(ji,jj) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj)
+ END_2D
+ ENDIF
+ CASE ( np_CME ) !* Coriolis + metric
+ DO_2D( 1, 1, 1, 1 )
+ zwz(ji,jj) = ( ff_f(ji,jj) + ( pv(ji+1,jj ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) &
+ & - ( pu(ji ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) ) * z1_e3f(ji,jj)
+ END_2D
+ CASE DEFAULT ! error
+ CALL ctl_stop('STOP','dyn_vor: wrong value for kvor' )
+ END SELECT
+ !
+ ! !== horizontal fluxes ==!
+ DO_2D( 1, 1, 1, 1 )
+ zwx(ji,jj) = e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * pu(ji,jj,jk)
+ zwy(ji,jj) = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * pv(ji,jj,jk)
+ END_2D
+ !
+ ! !== compute and add the vorticity term trend =!
+ DO_2D( 0, 1, 0, 1 )
+ ztne(ji,jj) = zwz(ji-1,jj ) + zwz(ji ,jj ) + zwz(ji ,jj-1)
+ ztnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj ) + zwz(ji ,jj )
+ ztse(ji,jj) = zwz(ji ,jj ) + zwz(ji ,jj-1) + zwz(ji-1,jj-1)
+ ztsw(ji,jj) = zwz(ji ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj )
+ END_2D
+ !
+ DO_2D( 0, 0, 0, 0 )
+ zua = + r1_12 * r1_e1u(ji,jj) * ( ztne(ji,jj ) * zwy(ji ,jj ) + ztnw(ji+1,jj) * zwy(ji+1,jj ) &
+ & + ztse(ji,jj ) * zwy(ji ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) )
+ zva = - r1_12 * r1_e2v(ji,jj) * ( ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji ,jj+1) &
+ & + ztnw(ji,jj ) * zwx(ji-1,jj ) + ztne(ji,jj ) * zwx(ji ,jj ) )
+ pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zua
+ pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zva
+ END_2D
+ END DO
+ ! ! ===============
+ ! ! End of slab
+ ! ! ===============
+ END SUBROUTINE vor_een
+
+
+ SUBROUTINE vor_een_hls1( kt, Kmm, kvor, pu, pv, pu_rhs, pv_rhs )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE vor_een ***
+ !!
+ !! ** Purpose : Compute the now total vorticity trend and add it to
+ !! the general trend of the momentum equation.
+ !!
+ !! ** Method : Trend evaluated using now fields (centered in time)
+ !! and the Arakawa and Lamb (1980) flux form formulation : conserves
+ !! both the horizontal kinetic energy and the potential enstrophy
+ !! when horizontal divergence is zero (see the NEMO documentation)
+ !! Add this trend to the general momentum trend (pu_rhs,pv_rhs).
+ !!
+ !! ** Action : - Update (pu_rhs,pv_rhs) with the now vorticity term trend
+ !!
+ !! References : Arakawa and Lamb 1980, Mon. Wea. Rev., 109, 18-36
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: kt ! ocean time-step index
+ INTEGER , INTENT(in ) :: Kmm ! ocean time level index
+ INTEGER , INTENT(in ) :: kvor ! total, planetary, relative, or metric
+ REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu, pv ! now velocities
+ REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu_rhs, pv_rhs ! total v-trend
+ !
+ INTEGER :: ji, jj, jk ! dummy loop indices
+ INTEGER :: ierr ! local integer
+ REAL(wp) :: zua, zva ! local scalars
+ REAL(wp) :: zmsk, ze3f ! local scalars
+ REAL(wp), DIMENSION(A2D(1)) :: z1_e3f
+#if defined key_loop_fusion
+ REAL(wp) :: ztne, ztnw, ztnw_ip1, ztse, ztse_jp1, ztsw_jp1, ztsw_ip1
+ REAL(wp) :: zwx, zwx_im1, zwx_jp1, zwx_im1_jp1
+ REAL(wp) :: zwy, zwy_ip1, zwy_jm1, zwy_ip1_jm1
+#else
+ REAL(wp), DIMENSION(A2D(1)) :: zwx , zwy
+ REAL(wp), DIMENSION(A2D(1)) :: ztnw, ztne, ztsw, ztse
+#endif
+ REAL(wp), DIMENSION(A2D(1),jpkm1) :: zwz ! 3D workspace, jpkm1 -> jpkm1 -> avoid lbc_lnk on jpk that is not defined
!!----------------------------------------------------------------------
!
IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile
@@ -874,7 +1168,7 @@ CONTAINS
! ! ===============
! ! End of slab
! ! ===============
- END SUBROUTINE vor_een
+ END SUBROUTINE vor_een_hls1
SUBROUTINE vor_eeT( kt, Kmm, kvor, pu, pv, pu_rhs, pv_rhs )
@@ -904,9 +1198,129 @@ CONTAINS
INTEGER :: ierr ! local integer
REAL(wp) :: zua, zva ! local scalars
REAL(wp) :: zmsk, z1_e3t ! local scalars
- REAL(wp), DIMENSION(A2D(nn_hls)) :: zwx , zwy
- REAL(wp), DIMENSION(A2D(nn_hls)) :: ztnw, ztne, ztsw, ztse
- REAL(wp), DIMENSION(A2D(nn_hls),jpkm1) :: zwz ! 3D workspace, avoid lbc_lnk on jpk that is not defined
+ REAL(wp), DIMENSION(A2D(1)) :: zwx , zwy
+ REAL(wp), DIMENSION(A2D(1)) :: ztnw, ztne, ztsw, ztse
+ REAL(wp), DIMENSION(A2D(1)) :: zwz ! 3D workspace, avoid lbc_lnk on jpk that is not defined
+ !!----------------------------------------------------------------------
+ !
+ IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile
+ IF( kt == nit000 ) THEN
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) 'dyn:vor_eeT : vorticity term: energy and enstrophy conserving scheme'
+ IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+ ENDIF
+ ENDIF
+ !
+ ! ! ===============
+ DO jk = 1, jpkm1 ! Horizontal slab
+ ! ! ===============
+ !
+ !
+ SELECT CASE( kvor ) !== vorticity considered ==!
+ CASE ( np_COR ) !* Coriolis (planetary vorticity)
+ DO_2D( 1, 1, 1, 1 )
+ zwz(ji,jj) = ff_f(ji,jj)
+ END_2D
+ CASE ( np_RVO ) !* relative vorticity
+ DO_2D( 1, 1, 1, 1 )
+ ! round brackets added to fix the order of floating point operations
+ ! needed to ensure halo 1 - halo 2 compatibility
+ zwz(ji,jj) = ( (e2v(ji+1,jj ) * pv(ji+1,jj ,jk) - e2v(ji,jj) * pv(ji,jj,jk)) &
+ & - (e1u(ji ,jj+1) * pu(ji ,jj+1,jk) - e1u(ji,jj) * pu(ji,jj,jk)) ) &
+ & * r1_e1e2f(ji,jj)
+ END_2D
+ IF( ln_dynvor_msk ) THEN ! mask the relative vorticity
+ DO_2D( 1, 1, 1, 1 )
+ zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk)
+ END_2D
+ ENDIF
+ CASE ( np_MET ) !* metric term
+ DO_2D( 1, 1, 1, 1 )
+ zwz(ji,jj) = ( pv(ji+1,jj ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) &
+ & - ( pu(ji ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)
+ END_2D
+ CASE ( np_CRV ) !* Coriolis + relative vorticity
+ DO_2D( 1, 1, 1, 1 )
+ ! round brackets added to fix the order of floating point operations
+ ! needed to ensure halo 1 - halo 2 compatibility
+ zwz(ji,jj) = ( ff_f(ji,jj) + ( (e2v(ji+1,jj ) * pv(ji+1,jj ,jk) - e2v(ji,jj) * pv(ji,jj,jk)) &
+ & - (e1u(ji ,jj+1) * pu(ji ,jj+1,jk) - e1u(ji,jj) * pu(ji,jj,jk)) ) &
+ & * r1_e1e2f(ji,jj) )
+ END_2D
+ IF( ln_dynvor_msk ) THEN ! mask the relative vorticity
+ DO_2D( 1, 1, 1, 1 )
+ zwz(ji,jj) = ( zwz(ji,jj) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj)
+ END_2D
+ ENDIF
+ CASE ( np_CME ) !* Coriolis + metric
+ DO_2D( 1, 1, 1, 1 )
+ zwz(ji,jj) = ff_f(ji,jj) + ( pv(ji+1,jj ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) &
+ & - ( pu(ji ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)
+ END_2D
+ CASE DEFAULT ! error
+ CALL ctl_stop('STOP','dyn_vor: wrong value for kvor' )
+ END SELECT
+ !
+ !
+ ! !== horizontal fluxes ==!
+ DO_2D( 1, 1, 1, 1 )
+ zwx(ji,jj) = e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * pu(ji,jj,jk)
+ zwy(ji,jj) = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * pv(ji,jj,jk)
+ END_2D
+ !
+ ! !== compute and add the vorticity term trend =!
+ DO_2D( 0, 1, 0, 1 )
+ z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm)
+ ztne(ji,jj) = ( zwz(ji-1,jj ) + zwz(ji ,jj ) + zwz(ji ,jj-1) ) * z1_e3t
+ ztnw(ji,jj) = ( zwz(ji-1,jj-1) + zwz(ji-1,jj ) + zwz(ji ,jj ) ) * z1_e3t
+ ztse(ji,jj) = ( zwz(ji ,jj ) + zwz(ji ,jj-1) + zwz(ji-1,jj-1) ) * z1_e3t
+ ztsw(ji,jj) = ( zwz(ji ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj ) ) * z1_e3t
+ END_2D
+ !
+ DO_2D( 0, 0, 0, 0 )
+ zua = + r1_12 * r1_e1u(ji,jj) * ( ztne(ji,jj ) * zwy(ji ,jj ) + ztnw(ji+1,jj) * zwy(ji+1,jj ) &
+ & + ztse(ji,jj ) * zwy(ji ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) )
+ zva = - r1_12 * r1_e2v(ji,jj) * ( ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji ,jj+1) &
+ & + ztnw(ji,jj ) * zwx(ji-1,jj ) + ztne(ji,jj ) * zwx(ji ,jj ) )
+ pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zua
+ pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zva
+ END_2D
+ ! ! ===============
+ END DO ! End of slab
+ ! ! ===============
+ END SUBROUTINE vor_eeT
+
+
+ SUBROUTINE vor_eeT_hls1( kt, Kmm, kvor, pu, pv, pu_rhs, pv_rhs )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE vor_eeT ***
+ !!
+ !! ** Purpose : Compute the now total vorticity trend and add it to
+ !! the general trend of the momentum equation.
+ !!
+ !! ** Method : Trend evaluated using now fields (centered in time)
+ !! and the Arakawa and Lamb (1980) vector form formulation using
+ !! a modified version of Arakawa and Lamb (1980) scheme (see vor_een).
+ !! The change consists in
+ !! Add this trend to the general momentum trend (pu_rhs,pv_rhs).
+ !!
+ !! ** Action : - Update (pu_rhs,pv_rhs) with the now vorticity term trend
+ !!
+ !! References : Arakawa and Lamb 1980, Mon. Wea. Rev., 109, 18-36
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: kt ! ocean time-step index
+ INTEGER , INTENT(in ) :: Kmm ! ocean time level index
+ INTEGER , INTENT(in ) :: kvor ! total, planetary, relative, or metric
+ REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu, pv ! now velocities
+ REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu_rhs, pv_rhs ! total v-trend
+ !
+ INTEGER :: ji, jj, jk ! dummy loop indices
+ INTEGER :: ierr ! local integer
+ REAL(wp) :: zua, zva ! local scalars
+ REAL(wp) :: zmsk, z1_e3t ! local scalars
+ REAL(wp), DIMENSION(A2D(1)) :: zwx , zwy
+ REAL(wp), DIMENSION(A2D(1)) :: ztnw, ztne, ztsw, ztse
+ REAL(wp), DIMENSION(A2D(1),jpkm1) :: zwz ! 3D workspace, avoid lbc_lnk on jpk that is not defined
!!----------------------------------------------------------------------
!
IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile
@@ -1003,7 +1417,7 @@ CONTAINS
! ! ===============
END DO ! End of slab
! ! ===============
- END SUBROUTINE vor_eeT
+ END SUBROUTINE vor_eeT_hls1
SUBROUTINE dyn_vor_init
diff --git a/src/OCE/DYN/dynzdf.F90 b/src/OCE/DYN/dynzdf.F90
index 98c65e4604e951f0119fbd4767381487ec3596a0..fed10f23182fea2131de19cd81d668d71ed3aec5 100644
--- a/src/OCE/DYN/dynzdf.F90
+++ b/src/OCE/DYN/dynzdf.F90
@@ -6,6 +6,7 @@ MODULE dynzdf
!! History : 1.0 ! 2005-11 (G. Madec) Original code
!! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase
!! 4.0 ! 2017-06 (G. Madec) remove the explicit time-stepping option + avm at t-point
+ !! 4.5 ! 2022-06 (S. Techene, G, Madec) refactorization to reduce local memory usage
!!----------------------------------------------------------------------
!!----------------------------------------------------------------------
@@ -79,7 +80,7 @@ CONTAINS
REAL(wp) :: zWu , zWv ! - -
REAL(wp) :: zWui, zWvi ! - -
REAL(wp) :: zWus, zWvs ! - -
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zwi, zwd, zws ! 3D workspace
+ REAL(wp), DIMENSION(A1Di(0),jpk) :: zwi, zwd, zws ! 2D workspace
REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdu, ztrdv ! - -
!!---------------------------------------------------------------------
!
@@ -105,315 +106,329 @@ CONTAINS
ztrdv(:,:,:) = pvv(:,:,:,Krhs)
ENDIF
!
- ! !== RHS: Leap-Frog time stepping on all trends but the vertical mixing ==! (put in puu(:,:,:,Kaa),pvv(:,:,:,Kaa))
- !
- ! ! time stepping except vertical diffusion
- IF( ln_dynadv_vec .OR. ln_linssh ) THEN ! applied on velocity
- DO_3D( 0, 0, 0, 0, 1, jpkm1 )
- puu(ji,jj,jk,Kaa) = ( puu(ji,jj,jk,Kbb) + rDt * puu(ji,jj,jk,Krhs) ) * umask(ji,jj,jk)
- pvv(ji,jj,jk,Kaa) = ( pvv(ji,jj,jk,Kbb) + rDt * pvv(ji,jj,jk,Krhs) ) * vmask(ji,jj,jk)
- END_3D
- ELSE ! applied on thickness weighted velocity
- DO_3D( 0, 0, 0, 0, 1, jpkm1 )
- puu(ji,jj,jk,Kaa) = ( e3u(ji,jj,jk,Kbb) * puu(ji,jj,jk,Kbb ) &
- & + rDt * e3u(ji,jj,jk,Kmm) * puu(ji,jj,jk,Krhs) ) &
- & / e3u(ji,jj,jk,Kaa) * umask(ji,jj,jk)
- pvv(ji,jj,jk,Kaa) = ( e3v(ji,jj,jk,Kbb) * pvv(ji,jj,jk,Kbb ) &
- & + rDt * e3v(ji,jj,jk,Kmm) * pvv(ji,jj,jk,Krhs) ) &
- & / e3v(ji,jj,jk,Kaa) * vmask(ji,jj,jk)
- END_3D
- ENDIF
- ! ! add top/bottom friction
- ! With split-explicit free surface, barotropic stress is treated explicitly Update velocities at the bottom.
- ! J. Chanut: The bottom stress is computed considering after barotropic velocities, which does
- ! not lead to the effective stress seen over the whole barotropic loop.
- ! G. Madec : in linear free surface, e3u(:,:,:,Kaa) = e3u(:,:,:,Kmm) = e3u_0, so systematic use of e3u(:,:,:,Kaa)
- IF( ln_drgimp .AND. ln_dynspg_ts ) THEN
- DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! remove barotropic velocities
- puu(ji,jj,jk,Kaa) = ( puu(ji,jj,jk,Kaa) - uu_b(ji,jj,Kaa) ) * umask(ji,jj,jk)
- pvv(ji,jj,jk,Kaa) = ( pvv(ji,jj,jk,Kaa) - vv_b(ji,jj,Kaa) ) * vmask(ji,jj,jk)
- END_3D
- DO_2D( 0, 0, 0, 0 ) ! Add bottom/top stress due to barotropic component only
- iku = mbku(ji,jj) ! ocean bottom level at u- and v-points
- ikv = mbkv(ji,jj) ! (deepest ocean u- and v-points)
- puu(ji,jj,iku,Kaa) = puu(ji,jj,iku,Kaa) + zDt_2 *( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * uu_b(ji,jj,Kaa) &
- & / e3u(ji,jj,iku,Kaa)
- pvv(ji,jj,ikv,Kaa) = pvv(ji,jj,ikv,Kaa) + zDt_2 *( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * vv_b(ji,jj,Kaa) &
- & / e3v(ji,jj,ikv,Kaa)
- END_2D
- IF( ln_isfcav.OR.ln_drgice_imp ) THEN ! Ocean cavities (ISF)
- DO_2D( 0, 0, 0, 0 )
- iku = miku(ji,jj) ! top ocean level at u- and v-points
- ikv = mikv(ji,jj) ! (first wet ocean u- and v-points)
- puu(ji,jj,iku,Kaa) = puu(ji,jj,iku,Kaa) + zDt_2 *( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * uu_b(ji,jj,Kaa) &
+ ! ! ================= !
+ DO_1Dj( 0, 0 ) ! i-k slices loop !
+ ! ! ================= !
+ !
+ ! !== RHS: Leap-Frog time stepping on all trends but the vertical mixing ==! (put in puu(:,:,:,Kaa),pvv(:,:,:,Kaa))
+ !
+ ! ! time stepping except vertical diffusion
+ IF( ln_dynadv_vec .OR. ln_linssh ) THEN ! applied on velocity
+ DO_2Dik( 0, 0, 1, jpkm1, 1 )
+ puu(ji,jj,jk,Kaa) = ( puu(ji,jj,jk,Kbb) + rDt * puu(ji,jj,jk,Krhs) ) * umask(ji,jj,jk)
+ pvv(ji,jj,jk,Kaa) = ( pvv(ji,jj,jk,Kbb) + rDt * pvv(ji,jj,jk,Krhs) ) * vmask(ji,jj,jk)
+ END_2D
+ ELSE ! applied on thickness weighted velocity
+ DO_2Dik( 0, 0, 1, jpkm1, 1 )
+ puu(ji,jj,jk,Kaa) = ( e3u(ji,jj,jk,Kbb) * puu(ji,jj,jk,Kbb ) &
+ & + rDt * e3u(ji,jj,jk,Kmm) * puu(ji,jj,jk,Krhs) ) &
+ & / e3u(ji,jj,jk,Kaa) * umask(ji,jj,jk)
+ pvv(ji,jj,jk,Kaa) = ( e3v(ji,jj,jk,Kbb) * pvv(ji,jj,jk,Kbb ) &
+ & + rDt * e3v(ji,jj,jk,Kmm) * pvv(ji,jj,jk,Krhs) ) &
+ & / e3v(ji,jj,jk,Kaa) * vmask(ji,jj,jk)
+ END_2D
+ ENDIF
+ ! ! add top/bottom friction
+ ! With split-explicit free surface, barotropic stress is treated explicitly Update velocities at the bottom.
+ ! J. Chanut: The bottom stress is computed considering after barotropic velocities, which does
+ ! not lead to the effective stress seen over the whole barotropic loop.
+ ! G. Madec : in linear free surface, e3u(:,:,:,Kaa) = e3u(:,:,:,Kmm) = e3u_0, so systematic use of e3u(:,:,:,Kaa)
+ IF( ln_drgimp .AND. ln_dynspg_ts ) THEN
+ DO_2Dik( 0, 0, 1, jpkm1, 1 ) ! remove barotropic velocities
+ puu(ji,jj,jk,Kaa) = ( puu(ji,jj,jk,Kaa) - uu_b(ji,jj,Kaa) ) * umask(ji,jj,jk)
+ pvv(ji,jj,jk,Kaa) = ( pvv(ji,jj,jk,Kaa) - vv_b(ji,jj,Kaa) ) * vmask(ji,jj,jk)
+ END_2D
+ DO_1Di( 0, 0 ) ! Add bottom/top stress due to barotropic component only
+ iku = mbku(ji,jj) ! ocean bottom level at u- and v-points
+ ikv = mbkv(ji,jj) ! (deepest ocean u- and v-points)
+ puu(ji,jj,iku,Kaa) = puu(ji,jj,iku,Kaa) + zDt_2 *( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * uu_b(ji,jj,Kaa) &
& / e3u(ji,jj,iku,Kaa)
- pvv(ji,jj,ikv,Kaa) = pvv(ji,jj,ikv,Kaa) + zDt_2 *( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * vv_b(ji,jj,Kaa) &
+ pvv(ji,jj,ikv,Kaa) = pvv(ji,jj,ikv,Kaa) + zDt_2 *( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * vv_b(ji,jj,Kaa) &
& / e3v(ji,jj,ikv,Kaa)
- END_2D
- END IF
- ENDIF
- !
- ! !== Vertical diffusion on u ==!
- !
- ! !* Matrix construction
- IF( ln_zad_Aimp ) THEN !!
- SELECT CASE( nldf_dyn )
- CASE( np_lap_i ) ! rotated lateral mixing: add its vertical mixing (akzu)
- DO_3D( 0, 0, 0, 0, 1, jpkm1 )
- z1_e3ua = 1._wp / e3u(ji,jj,jk,Kaa) ! after scale factor at U-point
- zzwi = - zDt_2 * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) + akzu(ji,jj,jk ) ) &
- & / e3uw(ji,jj,jk ,Kmm) * z1_e3ua * wumask(ji,jj,jk )
- zzws = - zDt_2 * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) + akzu(ji,jj,jk+1) ) &
- & / e3uw(ji,jj,jk+1,Kmm) * z1_e3ua * wumask(ji,jj,jk+1)
- zWui = ( wi(ji,jj,jk ) + wi(ji+1,jj,jk ) ) * z1_e3ua
- zWus = ( wi(ji,jj,jk+1) + wi(ji+1,jj,jk+1) ) * z1_e3ua
- zwi(ji,jj,jk) = zzwi + zDt_2 * MIN( zWui, 0._wp )
- zws(ji,jj,jk) = zzws - zDt_2 * MAX( zWus, 0._wp )
- zwd(ji,jj,jk) = 1._wp - zzwi - zzws + zDt_2 * ( MAX( zWui, 0._wp ) - MIN( zWus, 0._wp ) )
- END_3D
- CASE DEFAULT ! iso-level lateral mixing
- DO_3D( 0, 0, 0, 0, 1, jpkm1 )
- z1_e3ua = 1._wp / e3u(ji,jj,jk,Kaa) ! after scale factor at U-point
- zzwi = - zDt_2 * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) ) &
- & / e3uw(ji,jj,jk ,Kmm) * z1_e3ua * wumask(ji,jj,jk )
- zzws = - zDt_2 * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) &
- & / e3uw(ji,jj,jk+1,Kmm) * z1_e3ua * wumask(ji,jj,jk+1)
- zWui = ( wi(ji,jj,jk ) + wi(ji+1,jj,jk ) ) * z1_e3ua
- zWus = ( wi(ji,jj,jk+1) + wi(ji+1,jj,jk+1) ) * z1_e3ua
- zwi(ji,jj,jk) = zzwi + zDt_2 * MIN( zWui, 0._wp )
- zws(ji,jj,jk) = zzws - zDt_2 * MAX( zWus, 0._wp )
- zwd(ji,jj,jk) = 1._wp - zzwi - zzws + zDt_2 * ( MAX( zWui, 0._wp ) - MIN( zWus, 0._wp ) )
- END_3D
- END SELECT
- DO_2D( 0, 0, 0, 0 ) !* Surface boundary conditions
- zwi(ji,jj,1) = 0._wp
- zzws = - zDt_2 * ( avm(ji+1,jj,2) + avm(ji ,jj,2) ) &
- & / ( e3u(ji,jj,1,Kaa) * e3uw(ji,jj,2,Kmm) ) * wumask(ji,jj,2)
- zWus = ( wi(ji ,jj,2) + wi(ji+1,jj,2) ) / e3u(ji,jj,1,Kaa)
- zws(ji,jj,1 ) = zzws - zDt_2 * MAX( zWus, 0._wp )
- zwd(ji,jj,1 ) = 1._wp - zzws - zDt_2 * ( MIN( zWus, 0._wp ) )
- END_2D
- ELSE
- SELECT CASE( nldf_dyn )
- CASE( np_lap_i ) ! rotated lateral mixing: add its vertical mixing (akzu)
- DO_3D( 0, 0, 0, 0, 1, jpkm1 )
- zzwi = - zDt_2 * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) + akzu(ji,jj,jk ) ) &
- & / ( e3u(ji,jj,jk,Kaa) * e3uw(ji,jj,jk ,Kmm) ) * wumask(ji,jj,jk )
- zzws = - zDt_2 * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) + akzu(ji,jj,jk+1) ) &
- & / ( e3u(ji,jj,jk,Kaa) * e3uw(ji,jj,jk+1,Kmm) ) * wumask(ji,jj,jk+1)
- zwi(ji,jj,jk) = zzwi
- zws(ji,jj,jk) = zzws
- zwd(ji,jj,jk) = 1._wp - zzwi - zzws
- END_3D
- CASE DEFAULT ! iso-level lateral mixing
- DO_3D( 0, 0, 0, 0, 1, jpkm1 )
- zzwi = - zDt_2 * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) ) &
- & / ( e3u(ji,jj,jk,Kaa) * e3uw(ji,jj,jk ,Kmm) ) * wumask(ji,jj,jk )
- zzws = - zDt_2 * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) &
- & / ( e3u(ji,jj,jk,Kaa) * e3uw(ji,jj,jk+1,Kmm) ) * wumask(ji,jj,jk+1)
- zwi(ji,jj,jk) = zzwi
- zws(ji,jj,jk) = zzws
- zwd(ji,jj,jk) = 1._wp - zzwi - zzws
- END_3D
- END SELECT
- DO_2D( 0, 0, 0, 0 ) !* Surface boundary conditions
- zwi(ji,jj,1) = 0._wp
- zwd(ji,jj,1) = 1._wp - zws(ji,jj,1)
- END_2D
- ENDIF
- !
- !
- ! !== Apply semi-implicit bottom friction ==!
- !
- ! Only needed for semi-implicit bottom friction setup. The explicit
- ! bottom friction has been included in "u(v)a" which act as the R.H.S
- ! column vector of the tri-diagonal matrix equation
- !
- IF ( ln_drgimp ) THEN ! implicit bottom friction
- DO_2D( 0, 0, 0, 0 )
- iku = mbku(ji,jj) ! ocean bottom level at u- and v-points
- zwd(ji,jj,iku) = zwd(ji,jj,iku) - zDt_2 *( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) &
- & / e3u(ji,jj,iku,Kaa)
- END_2D
- IF ( ln_isfcav.OR.ln_drgice_imp ) THEN ! top friction (always implicit)
- DO_2D( 0, 0, 0, 0 )
- !!gm top Cd is masked (=0 outside cavities) no need of test on mik>=2 ==>> it has been suppressed
- iku = miku(ji,jj) ! ocean top level at u- and v-points
- zwd(ji,jj,iku) = zwd(ji,jj,iku) - zDt_2 *( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) &
+ END_1D
+ IF( ln_isfcav.OR.ln_drgice_imp ) THEN ! Ocean cavities (ISF)
+ DO_1Di( 0, 0 )
+ iku = miku(ji,jj) ! top ocean level at u- and v-points
+ ikv = mikv(ji,jj) ! (first wet ocean u- and v-points)
+ puu(ji,jj,iku,Kaa) = puu(ji,jj,iku,Kaa) + zDt_2 *( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * uu_b(ji,jj,Kaa) &
+ & / e3u(ji,jj,iku,Kaa)
+ pvv(ji,jj,ikv,Kaa) = pvv(ji,jj,ikv,Kaa) + zDt_2 *( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * vv_b(ji,jj,Kaa) &
+ & / e3v(ji,jj,ikv,Kaa)
+ END_1D
+ END IF
+ ENDIF
+ !
+ ! !== Vertical diffusion on u ==!
+ !
+ !
+ ! !* Matrix construction
+ IF( ln_zad_Aimp ) THEN !- including terms associated with partly implicit vertical advection
+ SELECT CASE( nldf_dyn )
+ CASE( np_lap_i ) ! rotated lateral mixing: add its vertical mixing (akzu)
+ DO_2Dik( 0, 0, 1, jpkm1, 1 )
+ z1_e3ua = 1._wp / e3u(ji,jj,jk,Kaa) ! after scale factor at U-point
+ zzwi = - zDt_2 * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) + akzu(ji,jj,jk ) ) &
+ & / e3uw(ji,jj,jk ,Kmm) * z1_e3ua * wumask(ji,jj,jk )
+ zzws = - zDt_2 * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) + akzu(ji,jj,jk+1) ) &
+ & / e3uw(ji,jj,jk+1,Kmm) * z1_e3ua * wumask(ji,jj,jk+1)
+ zWui = ( wi(ji,jj,jk ) + wi(ji+1,jj,jk ) ) * z1_e3ua
+ zWus = ( wi(ji,jj,jk+1) + wi(ji+1,jj,jk+1) ) * z1_e3ua
+ zwi(ji,jk) = zzwi + zDt_2 * MIN( zWui, 0._wp )
+ zws(ji,jk) = zzws - zDt_2 * MAX( zWus, 0._wp )
+ zwd(ji,jk) = 1._wp - zzwi - zzws + zDt_2 * ( MAX( zWui, 0._wp ) - MIN( zWus, 0._wp ) )
+ END_2D
+ CASE DEFAULT ! iso-level lateral mixing
+ DO_2Dik( 0, 0, 1, jpkm1, 1 )
+ z1_e3ua = 1._wp / e3u(ji,jj,jk,Kaa) ! after scale factor at U-point
+ zzwi = - zDt_2 * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) ) &
+ & / e3uw(ji,jj,jk ,Kmm) * z1_e3ua * wumask(ji,jj,jk )
+ zzws = - zDt_2 * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) &
+ & / e3uw(ji,jj,jk+1,Kmm) * z1_e3ua * wumask(ji,jj,jk+1)
+ zWui = ( wi(ji,jj,jk ) + wi(ji+1,jj,jk ) ) * z1_e3ua
+ zWus = ( wi(ji,jj,jk+1) + wi(ji+1,jj,jk+1) ) * z1_e3ua
+ zwi(ji,jk) = zzwi + zDt_2 * MIN( zWui, 0._wp )
+ zws(ji,jk) = zzws - zDt_2 * MAX( zWus, 0._wp )
+ zwd(ji,jk) = 1._wp - zzwi - zzws + zDt_2 * ( MAX( zWui, 0._wp ) - MIN( zWus, 0._wp ) )
+ END_2D
+ END SELECT
+ !
+ zwi(:,1) = 0._wp
+ DO_1Di( 0, 0 ) !* Surface boundary conditions
+ zwi(ji,1) = 0._wp
+ zzws = - zDt_2 * ( avm(ji+1,jj,2) + avm(ji ,jj,2) ) &
+ & / ( e3u(ji,jj,1,Kaa) * e3uw(ji,jj,2,Kmm) ) * wumask(ji,jj,2)
+ zWus = ( wi(ji ,jj,2) + wi(ji+1,jj,2) ) / e3u(ji,jj,1,Kaa)
+ zws(ji,1) = zzws - zDt_2 * MAX( zWus, 0._wp )
+ zwd(ji,1) = 1._wp - zzws - zDt_2 * ( MIN( zWus, 0._wp ) )
+ END_1D
+ ELSE !- only vertical diffusive terms
+ SELECT CASE( nldf_dyn )
+ CASE( np_lap_i ) ! rotated lateral mixing: add its vertical mixing (akzu)
+ DO_2Dik( 0, 0, 1, jpkm1, 1 )
+ zzwi = - zDt_2 * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) + akzu(ji,jj,jk ) ) &
+ & / ( e3u(ji,jj,jk,Kaa) * e3uw(ji,jj,jk ,Kmm) ) * wumask(ji,jj,jk )
+ zzws = - zDt_2 * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) + akzu(ji,jj,jk+1) ) &
+ & / ( e3u(ji,jj,jk,Kaa) * e3uw(ji,jj,jk+1,Kmm) ) * wumask(ji,jj,jk+1)
+ zwi(ji,jk) = zzwi
+ zws(ji,jk) = zzws
+ zwd(ji,jk) = 1._wp - zzwi - zzws
+ END_2D
+ CASE DEFAULT ! iso-level lateral mixing
+ DO_2Dik( 0, 0, 1, jpkm1, 1 )
+ zzwi = - zDt_2 * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) ) &
+ & / ( e3u(ji,jj,jk,Kaa) * e3uw(ji,jj,jk ,Kmm) ) * wumask(ji,jj,jk )
+ zzws = - zDt_2 * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) &
+ & / ( e3u(ji,jj,jk,Kaa) * e3uw(ji,jj,jk+1,Kmm) ) * wumask(ji,jj,jk+1)
+ zwi(ji,jk) = zzwi
+ zws(ji,jk) = zzws
+ zwd(ji,jk) = 1._wp - zzwi - zzws
+ END_2D
+ END SELECT
+ !
+ zwi(:,1) = 0._wp
+ DO_1Di( 0, 0 ) !* Surface boundary conditions
+ zwd(ji,1) = 1._wp - zws(ji,1)
+ END_1D
+ ENDIF
+ !
+ !
+ ! !== Apply semi-implicit bottom friction ==!
+ !
+ ! Only needed for semi-implicit bottom friction setup. The explicit
+ ! bottom friction has been included in "u(v)a" which act as the R.H.S
+ ! column vector of the tri-diagonal matrix equation
+ !
+ IF ( ln_drgimp ) THEN ! implicit bottom friction
+ DO_1Di( 0, 0 )
+ iku = mbku(ji,jj) ! ocean bottom level at u- and v-points
+ zwd(ji,iku) = zwd(ji,iku) - zDt_2 *( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) &
& / e3u(ji,jj,iku,Kaa)
- END_2D
- END IF
- ENDIF
- !
- ! Matrix inversion starting from the first level
- !-----------------------------------------------------------------------
- ! solve m.x = y where m is a tri diagonal matrix ( jpk*jpk )
- !
- ! ( zwd1 zws1 0 0 0 )( zwx1 ) ( zwy1 )
- ! ( zwi2 zwd2 zws2 0 0 )( zwx2 ) ( zwy2 )
- ! ( 0 zwi3 zwd3 zws3 0 )( zwx3 )=( zwy3 )
- ! ( ... )( ... ) ( ... )
- ! ( 0 0 0 zwik zwdk )( zwxk ) ( zwyk )
- !
- ! m is decomposed in the product of an upper and a lower triangular matrix
- ! The 3 diagonal terms are in 2d arrays: zwd, zws, zwi
- ! The solution (the after velocity) is in puu(:,:,:,Kaa)
- !-----------------------------------------------------------------------
- !
- DO_3D( 0, 0, 0, 0, 2, jpkm1 ) !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) ==
- zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1)
- END_3D
- !
- DO_2D( 0, 0, 0, 0 ) !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 ==!
+ END_1D
+ IF ( ln_isfcav.OR.ln_drgice_imp ) THEN ! top friction (always implicit)
+ DO_1Di( 0, 0 )
+ !!gm top Cd is masked (=0 outside cavities) no need of test on mik>=2 ==>> it has been suppressed
+ iku = miku(ji,jj) ! ocean top level at u- and v-points
+ zwd(ji,iku) = zwd(ji,iku) - zDt_2 *( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) &
+ & / e3u(ji,jj,iku,Kaa)
+ END_1D
+ ENDIF
+ ENDIF
+ !
+ ! Matrix inversion starting from the first level
+ !-----------------------------------------------------------------------
+ ! solve m.x = y where m is a tri diagonal matrix ( jpk*jpk )
+ !
+ ! ( zwd1 zws1 0 0 0 )( zwx1 ) ( zwy1 )
+ ! ( zwi2 zwd2 zws2 0 0 )( zwx2 ) ( zwy2 )
+ ! ( 0 zwi3 zwd3 zws3 0 )( zwx3 )=( zwy3 )
+ ! ( ... )( ... ) ( ... )
+ ! ( 0 0 0 zwik zwdk )( zwxk ) ( zwyk )
+ !
+ ! m is decomposed in the product of an upper and a lower triangular matrix
+ ! The 3 diagonal terms are in 2d arrays: zwd, zws, zwi
+ ! The solution (the after velocity) is in puu(:,:,:,Kaa)
+ !-----------------------------------------------------------------------
+ !
+ DO_2Dik( 0, 0, 2, jpkm1, 1 ) !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) ==
+ zwd(ji,jk) = zwd(ji,jk) - zwi(ji,jk) * zws(ji,jk-1) / zwd(ji,jk-1)
+ END_2D
+ !
+ DO_1Di( 0, 0 ) !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 ==!
#if defined key_RK3
- ! ! RK3: use only utau (not utau_b)
- puu(ji,jj,1,Kaa) = puu(ji,jj,1,Kaa) + rDt * utauU(ji,jj) &
- & / ( e3u(ji,jj,1,Kaa) * rho0 ) * umask(ji,jj,1)
+ ! ! RK3: use only utau (not utau_b)
+ puu(ji,jj,1,Kaa) = puu(ji,jj,1,Kaa) + rDt * utauU(ji,jj) &
+ & / ( e3u(ji,jj,1,Kaa) * rho0 ) * umask(ji,jj,1)
#else
- puu(ji,jj,1,Kaa) = puu(ji,jj,1,Kaa) + zDt_2 * ( utau_b(ji,jj) + utauU(ji,jj) ) &
- & / ( e3u(ji,jj,1,Kaa) * rho0 ) * umask(ji,jj,1)
+ ! ! MLF: average of utau and utau_b
+ puu(ji,jj,1,Kaa) = puu(ji,jj,1,Kaa) + zDt_2 * ( utau_b(ji,jj) + utauU(ji,jj) ) &
+ & / ( e3u(ji,jj,1,Kaa) * rho0 ) * umask(ji,jj,1)
#endif
- END_2D
- DO_3D( 0, 0, 0, 0, 2, jpkm1 )
- puu(ji,jj,jk,Kaa) = puu(ji,jj,jk,Kaa) - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * puu(ji,jj,jk-1,Kaa)
- END_3D
- !
- DO_2D( 0, 0, 0, 0 ) !== thrid recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk ==!
- puu(ji,jj,jpkm1,Kaa) = puu(ji,jj,jpkm1,Kaa) / zwd(ji,jj,jpkm1)
- END_2D
- DO_3DS( 0, 0, 0, 0, jpk-2, 1, -1 )
- puu(ji,jj,jk,Kaa) = ( puu(ji,jj,jk,Kaa) - zws(ji,jj,jk) * puu(ji,jj,jk+1,Kaa) ) / zwd(ji,jj,jk)
- END_3D
- !
- ! !== Vertical diffusion on v ==!
- !
- ! !* Matrix construction
- IF( ln_zad_Aimp ) THEN !!
- SELECT CASE( nldf_dyn )
- CASE( np_lap_i ) ! rotated lateral mixing: add its vertical mixing (akzv)
- DO_3D( 0, 0, 0, 0, 1, jpkm1 )
- z1_e3va = 1._wp / e3v(ji,jj,jk,Kaa) ! after scale factor at V-point
- zzwi = - zDt_2 * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) + akzv(ji,jj,jk ) ) &
- & / e3vw(ji,jj,jk ,Kmm) * z1_e3va * wvmask(ji,jj,jk )
- zzws = - zDt_2 * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) + akzv(ji,jj,jk+1) ) &
- & / e3vw(ji,jj,jk+1,Kmm) * z1_e3va * wvmask(ji,jj,jk+1)
- zWvi = ( wi(ji,jj,jk ) + wi(ji,jj+1,jk ) ) * z1_e3va
- zWvs = ( wi(ji,jj,jk+1) + wi(ji,jj+1,jk+1) ) * z1_e3va
- zwi(ji,jj,jk) = zzwi + zDt_2 * MIN( zWvi, 0._wp )
- zws(ji,jj,jk) = zzws - zDt_2 * MAX( zWvs, 0._wp )
- zwd(ji,jj,jk) = 1._wp - zzwi - zzws - zDt_2 * ( - MAX( zWvi, 0._wp ) + MIN( zWvs, 0._wp ) )
- END_3D
- CASE DEFAULT ! iso-level lateral mixing
- DO_3D( 0, 0, 0, 0, 1, jpkm1 )
- z1_e3va = 1._wp / e3v(ji,jj,jk,Kaa) ! after scale factor at V-point
- zzwi = - zDt_2 * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) ) &
- & / e3vw(ji,jj,jk ,Kmm) * z1_e3va * wvmask(ji,jj,jk )
- zzws = - zDt_2 * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) &
- & / e3vw(ji,jj,jk+1,Kmm) * z1_e3va * wvmask(ji,jj,jk+1)
- zWvi = ( wi(ji,jj,jk ) + wi(ji,jj+1,jk ) ) * z1_e3va
- zWvs = ( wi(ji,jj,jk+1) + wi(ji,jj+1,jk+1) ) * z1_e3va
- zwi(ji,jj,jk) = zzwi + zDt_2 * MIN( zWvi, 0._wp )
- zws(ji,jj,jk) = zzws - zDt_2 * MAX( zWvs, 0._wp )
- zwd(ji,jj,jk) = 1._wp - zzwi - zzws - zDt_2 * ( - MAX( zWvi, 0._wp ) + MIN( zWvs, 0._wp ) )
- END_3D
- END SELECT
- DO_2D( 0, 0, 0, 0 ) !* Surface boundary conditions
- zwi(ji,jj,1) = 0._wp
- zzws = - zDt_2 * ( avm(ji,jj+1,2) + avm(ji,jj,2) ) &
- & / ( e3v(ji,jj,1,Kaa) * e3vw(ji,jj,2,Kmm) ) * wvmask(ji,jj,2)
- zWvs = ( wi(ji,jj ,2) + wi(ji,jj+1,2) ) / e3v(ji,jj,1,Kaa)
- zws(ji,jj,1 ) = zzws - zDt_2 * MAX( zWvs, 0._wp )
- zwd(ji,jj,1 ) = 1._wp - zzws - zDt_2 * ( MIN( zWvs, 0._wp ) )
- END_2D
- ELSE
- SELECT CASE( nldf_dyn )
- CASE( np_lap_i ) ! rotated lateral mixing: add its vertical mixing (akzu)
- DO_3D( 0, 0, 0, 0, 1, jpkm1 )
- zzwi = - zDt_2 * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) + akzv(ji,jj,jk ) ) &
- & / ( e3v(ji,jj,jk,Kaa) * e3vw(ji,jj,jk ,Kmm) ) * wvmask(ji,jj,jk )
- zzws = - zDt_2 * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) + akzv(ji,jj,jk+1) ) &
- & / ( e3v(ji,jj,jk,Kaa) * e3vw(ji,jj,jk+1,Kmm) ) * wvmask(ji,jj,jk+1)
- zwi(ji,jj,jk) = zzwi
- zws(ji,jj,jk) = zzws
- zwd(ji,jj,jk) = 1._wp - zzwi - zzws
- END_3D
- CASE DEFAULT ! iso-level lateral mixing
- DO_3D( 0, 0, 0, 0, 1, jpkm1 )
- zzwi = - zDt_2 * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) ) &
- & / ( e3v(ji,jj,jk,Kaa) * e3vw(ji,jj,jk ,Kmm) ) * wvmask(ji,jj,jk )
- zzws = - zDt_2 * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) &
- & / ( e3v(ji,jj,jk,Kaa) * e3vw(ji,jj,jk+1,Kmm) ) * wvmask(ji,jj,jk+1)
- zwi(ji,jj,jk) = zzwi
- zws(ji,jj,jk) = zzws
- zwd(ji,jj,jk) = 1._wp - zzwi - zzws
- END_3D
- END SELECT
- DO_2D( 0, 0, 0, 0 ) !* Surface boundary conditions
- zwi(ji,jj,1) = 0._wp
- zwd(ji,jj,1) = 1._wp - zws(ji,jj,1)
+ END_1D
+ DO_2Dik( 0, 0, 2, jpkm1, 1 )
+ puu(ji,jj,jk,Kaa) = puu(ji,jj,jk,Kaa) - zwi(ji,jk) / zwd(ji,jk-1) * puu(ji,jj,jk-1,Kaa)
END_2D
- ENDIF
- !
- ! !== Apply semi-implicit top/bottom friction ==!
- !
- ! Only needed for semi-implicit bottom friction setup. The explicit
- ! bottom friction has been included in "u(v)a" which act as the R.H.S
- ! column vector of the tri-diagonal matrix equation
- !
- IF( ln_drgimp ) THEN
- DO_2D( 0, 0, 0, 0 )
- ikv = mbkv(ji,jj) ! (deepest ocean u- and v-points)
- zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - zDt_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) &
- & / e3v(ji,jj,ikv,Kaa)
+ !
+ DO_1Di( 0, 0 ) !== thrid recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk ==!
+ puu(ji,jj,jpkm1,Kaa) = puu(ji,jj,jpkm1,Kaa) / zwd(ji,jpkm1)
+ END_1D
+ DO_2Dik( 0, 0, jpk-2, 1, -1 )
+ puu(ji,jj,jk,Kaa) = ( puu(ji,jj,jk,Kaa) - zws(ji,jk) * puu(ji,jj,jk+1,Kaa) ) / zwd(ji,jk)
END_2D
- IF ( ln_isfcav.OR.ln_drgice_imp ) THEN
- DO_2D( 0, 0, 0, 0 )
- ikv = mikv(ji,jj) ! (first wet ocean u- and v-points)
- zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - zDt_2*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) &
+ !
+ !
+ ! !== Vertical diffusion on v ==!
+ !
+ ! !* Matrix construction
+ IF( ln_zad_Aimp ) THEN !!
+ SELECT CASE( nldf_dyn )
+ CASE( np_lap_i ) ! rotated lateral mixing: add its vertical mixing (akzv)
+ DO_2Dik( 0, 0, 1, jpkm1, 1 )
+ z1_e3va = 1._wp / e3v(ji,jj,jk,Kaa) ! after scale factor at V-point
+ zzwi = - zDt_2 * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) + akzv(ji,jj,jk ) ) &
+ & / e3vw(ji,jj,jk ,Kmm) * z1_e3va * wvmask(ji,jj,jk )
+ zzws = - zDt_2 * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) + akzv(ji,jj,jk+1) ) &
+ & / e3vw(ji,jj,jk+1,Kmm) * z1_e3va * wvmask(ji,jj,jk+1)
+ zWvi = ( wi(ji,jj,jk ) + wi(ji,jj+1,jk ) ) * z1_e3va
+ zWvs = ( wi(ji,jj,jk+1) + wi(ji,jj+1,jk+1) ) * z1_e3va
+ zwi(ji,jk) = zzwi + zDt_2 * MIN( zWvi, 0._wp )
+ zws(ji,jk) = zzws - zDt_2 * MAX( zWvs, 0._wp )
+ zwd(ji,jk) = 1._wp - zzwi - zzws - zDt_2 * ( - MAX( zWvi, 0._wp ) + MIN( zWvs, 0._wp ) )
+ END_2D
+ CASE DEFAULT ! iso-level lateral mixing
+ DO_2Dik( 0, 0, 1, jpkm1, 1 )
+ z1_e3va = 1._wp / e3v(ji,jj,jk,Kaa) ! after scale factor at V-point
+ zzwi = - zDt_2 * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) ) &
+ & / e3vw(ji,jj,jk ,Kmm) * z1_e3va * wvmask(ji,jj,jk )
+ zzws = - zDt_2 * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) &
+ & / e3vw(ji,jj,jk+1,Kmm) * z1_e3va * wvmask(ji,jj,jk+1)
+ zWvi = ( wi(ji,jj,jk ) + wi(ji,jj+1,jk ) ) * z1_e3va
+ zWvs = ( wi(ji,jj,jk+1) + wi(ji,jj+1,jk+1) ) * z1_e3va
+ zwi(ji,jk) = zzwi + zDt_2 * MIN( zWvi, 0._wp )
+ zws(ji,jk) = zzws - zDt_2 * MAX( zWvs, 0._wp )
+ zwd(ji,jk) = 1._wp - zzwi - zzws - zDt_2 * ( - MAX( zWvi, 0._wp ) + MIN( zWvs, 0._wp ) )
+ END_2D
+ END SELECT
+ DO_1Di( 0, 0 ) !* Surface boundary conditions
+ zwi(ji,1) = 0._wp
+ zzws = - zDt_2 * ( avm(ji,jj+1,2) + avm(ji,jj,2) ) &
+ & / ( e3v(ji,jj,1,Kaa) * e3vw(ji,jj,2,Kmm) ) * wvmask(ji,jj,2)
+ zWvs = ( wi(ji,jj ,2) + wi(ji,jj+1,2) ) / e3v(ji,jj,1,Kaa)
+ zws(ji,1 ) = zzws - zDt_2 * MAX( zWvs, 0._wp )
+ zwd(ji,1 ) = 1._wp - zzws - zDt_2 * ( MIN( zWvs, 0._wp ) )
+ END_1D
+ ELSE
+ SELECT CASE( nldf_dyn )
+ CASE( np_lap_i ) ! rotated lateral mixing: add its vertical mixing (akzu)
+ DO_2Dik( 0, 0, 1, jpkm1, 1 )
+ zzwi = - zDt_2 * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) + akzv(ji,jj,jk ) ) &
+ & / ( e3v(ji,jj,jk,Kaa) * e3vw(ji,jj,jk ,Kmm) ) * wvmask(ji,jj,jk )
+ zzws = - zDt_2 * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) + akzv(ji,jj,jk+1) ) &
+ & / ( e3v(ji,jj,jk,Kaa) * e3vw(ji,jj,jk+1,Kmm) ) * wvmask(ji,jj,jk+1)
+ zwi(ji,jk) = zzwi
+ zws(ji,jk) = zzws
+ zwd(ji,jk) = 1._wp - zzwi - zzws
+ END_2D
+ CASE DEFAULT ! iso-level lateral mixing
+ DO_2Dik( 0, 0, 1, jpkm1, 1 )
+ zzwi = - zDt_2 * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) ) &
+ & / ( e3v(ji,jj,jk,Kaa) * e3vw(ji,jj,jk ,Kmm) ) * wvmask(ji,jj,jk )
+ zzws = - zDt_2 * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) &
+ & / ( e3v(ji,jj,jk,Kaa) * e3vw(ji,jj,jk+1,Kmm) ) * wvmask(ji,jj,jk+1)
+ zwi(ji,jk) = zzwi
+ zws(ji,jk) = zzws
+ zwd(ji,jk) = 1._wp - zzwi - zzws
+ END_2D
+ END SELECT
+ DO_1Di( 0, 0 ) !* Surface boundary conditions
+ zwi(ji,1) = 0._wp
+ zwd(ji,1) = 1._wp - zws(ji,1)
+ END_1D
+ ENDIF
+ !
+ ! !== Apply semi-implicit top/bottom friction ==!
+ !
+ ! Only needed for semi-implicit bottom friction setup. The explicit
+ ! bottom friction has been included in "u(v)a" which act as the R.H.S
+ ! column vector of the tri-diagonal matrix equation
+ !
+ IF( ln_drgimp ) THEN
+ DO_1Di( 0, 0 )
+ ikv = mbkv(ji,jj) ! (deepest ocean u- and v-points)
+ zwd(ji,ikv) = zwd(ji,ikv) - zDt_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) &
& / e3v(ji,jj,ikv,Kaa)
- END_2D
+ END_1D
+ IF ( ln_isfcav.OR.ln_drgice_imp ) THEN
+ DO_1Di( 0, 0 )
+ ikv = mikv(ji,jj) ! (first wet ocean u- and v-points)
+ zwd(ji,ikv) = zwd(ji,ikv) - zDt_2*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) &
+ & / e3v(ji,jj,ikv,Kaa)
+ END_1D
+ ENDIF
ENDIF
- ENDIF
-
- ! Matrix inversion
- !-----------------------------------------------------------------------
- ! solve m.x = y where m is a tri diagonal matrix ( jpk*jpk )
- !
- ! ( zwd1 zws1 0 0 0 )( zwx1 ) ( zwy1 )
- ! ( zwi2 zwd2 zws2 0 0 )( zwx2 ) ( zwy2 )
- ! ( 0 zwi3 zwd3 zws3 0 )( zwx3 )=( zwy3 )
- ! ( ... )( ... ) ( ... )
- ! ( 0 0 0 zwik zwdk )( zwxk ) ( zwyk )
- !
- ! m is decomposed in the product of an upper and lower triangular matrix
- ! The 3 diagonal terms are in 2d arrays: zwd, zws, zwi
- ! The solution (after velocity) is in 2d array va
- !-----------------------------------------------------------------------
- !
- DO_3D( 0, 0, 0, 0, 2, jpkm1 ) !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) ==
- zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1)
- END_3D
- !
- DO_2D( 0, 0, 0, 0 ) !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 ==!
+
+ ! Matrix inversion
+ !-----------------------------------------------------------------------
+ ! solve m.x = y where m is a tri diagonal matrix ( jpk*jpk )
+ !
+ ! ( zwd1 zws1 0 0 0 )( zwx1 ) ( zwy1 )
+ ! ( zwi2 zwd2 zws2 0 0 )( zwx2 ) ( zwy2 )
+ ! ( 0 zwi3 zwd3 zws3 0 )( zwx3 )=( zwy3 )
+ ! ( ... )( ... ) ( ... )
+ ! ( 0 0 0 zwik zwdk )( zwxk ) ( zwyk )
+ !
+ ! m is decomposed in the product of an upper and lower triangular matrix
+ ! The 3 diagonal terms are in 2d arrays: zwd, zws, zwi
+ ! The solution (after velocity) is in 2d array va
+ !-----------------------------------------------------------------------
+ !
+ DO_2Dik( 0, 0, 2, jpkm1, 1 ) !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) ==
+ zwd(ji,jk) = zwd(ji,jk) - zwi(ji,jk) * zws(ji,jk-1) / zwd(ji,jk-1)
+ END_2D
+ !
+ DO_1Di( 0, 0 ) !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 ==!
#if defined key_RK3
- ! ! RK3: use only vtau (not vtau_b)
- pvv(ji,jj,1,Kaa) = pvv(ji,jj,1,Kaa) + rDt * vtauV(ji,jj) &
- & / ( e3v(ji,jj,1,Kaa) * rho0 ) * vmask(ji,jj,1)
+ ! ! RK3: use only vtau (not vtau_b)
+ pvv(ji,jj,1,Kaa) = pvv(ji,jj,1,Kaa) + rDt * vtauV(ji,jj) &
+ & / ( e3v(ji,jj,1,Kaa) * rho0 ) * vmask(ji,jj,1)
#else
- pvv(ji,jj,1,Kaa) = pvv(ji,jj,1,Kaa) + zDt_2 * ( vtau_b(ji,jj) + vtauV(ji,jj) ) &
- & / ( e3v(ji,jj,1,Kaa) * rho0 ) * vmask(ji,jj,1)
+ ! ! MLF: average of vtau and vtau_b
+ pvv(ji,jj,1,Kaa) = pvv(ji,jj,1,Kaa) + zDt_2*( vtau_b(ji,jj) + vtauV(ji,jj) ) &
+ & / ( e3v(ji,jj,1,Kaa) * rho0 ) * vmask(ji,jj,1)
#endif
- END_2D
- DO_3D( 0, 0, 0, 0, 2, jpkm1 )
- pvv(ji,jj,jk,Kaa) = pvv(ji,jj,jk,Kaa) - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * pvv(ji,jj,jk-1,Kaa)
- END_3D
- !
- DO_2D( 0, 0, 0, 0 ) !== third recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk ==!
- pvv(ji,jj,jpkm1,Kaa) = pvv(ji,jj,jpkm1,Kaa) / zwd(ji,jj,jpkm1)
- END_2D
- DO_3DS( 0, 0, 0, 0, jpk-2, 1, -1 )
- pvv(ji,jj,jk,Kaa) = ( pvv(ji,jj,jk,Kaa) - zws(ji,jj,jk) * pvv(ji,jj,jk+1,Kaa) ) / zwd(ji,jj,jk)
- END_3D
+ END_1D
+ DO_2Dik( 0, 0, 2, jpkm1, 1 )
+ pvv(ji,jj,jk,Kaa) = pvv(ji,jj,jk,Kaa) - zwi(ji,jk) / zwd(ji,jk-1) * pvv(ji,jj,jk-1,Kaa)
+ END_2D
+ !
+ DO_1Di( 0, 0 ) !== third recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk ==!
+ pvv(ji,jj,jpkm1,Kaa) = pvv(ji,jj,jpkm1,Kaa) / zwd(ji,jpkm1)
+ END_1D
+ DO_2Dik( 0, 0, jpk-2, 1, -1 )
+ pvv(ji,jj,jk,Kaa) = ( pvv(ji,jj,jk,Kaa) - zws(ji,jk) * pvv(ji,jj,jk+1,Kaa) ) / zwd(ji,jk)
+ END_2D
+ ! ! ================= !
+ END_1D ! i-k slices loop !
+ ! ! ================= !
!
IF( l_trddyn ) THEN ! save the vertical diffusive trends for further diagnostics
ztrdu(:,:,:) = ( puu(:,:,:,Kaa) - puu(:,:,:,Kbb) )*r1_Dt - ztrdu(:,:,:)
diff --git a/src/OCE/DYN/sshwzv.F90 b/src/OCE/DYN/sshwzv.F90
index 0e2569708b8b4419148cddcaa94827a9fa65c3e7..aed60c9867a0bf15de6a512fc0a05d86e5e091b5 100644
--- a/src/OCE/DYN/sshwzv.F90
+++ b/src/OCE/DYN/sshwzv.F90
@@ -175,7 +175,8 @@ CONTAINS
IF(lwp) WRITE(numout,*) 'wzv_MLF : now vertical velocity '
IF(lwp) WRITE(numout,*) '~~~~~~~'
!
- pww(:,:,jpk) = 0._wp ! bottom boundary condition: w=0 (set once for all)
+ pww(:,:,:) = 0._wp ! bottom boundary condition: w=0 (set once for all)
+ ! ! needed over the halos for the output (ww+wi) in diawri.F90
ENDIF
! !------------------------------!
! ! Now Vertical Velocity !
@@ -244,28 +245,28 @@ CONTAINS
! inside computational domain (cosmetic)
DO jk = 1, jpkm1
IF( lk_west ) THEN ! --- West --- !
- DO ji = mi0(2+nn_hls), mi1(2+nn_hls)
+ DO ji = mi0(2+nn_hls,nn_hls), mi1(2+nn_hls,nn_hls)
DO jj = 1, jpj
pww(ji,jj,jk) = 0._wp
END DO
END DO
ENDIF
IF( lk_east ) THEN ! --- East --- !
- DO ji = mi0(jpiglo-1-nn_hls), mi1(jpiglo-1-nn_hls)
+ DO ji = mi0(jpiglo-1-nn_hls,nn_hls), mi1(jpiglo-1-nn_hls,nn_hls)
DO jj = 1, jpj
pww(ji,jj,jk) = 0._wp
END DO
END DO
ENDIF
IF( lk_south ) THEN ! --- South --- !
- DO jj = mj0(2+nn_hls), mj1(2+nn_hls)
+ DO jj = mj0(2+nn_hls,nn_hls), mj1(2+nn_hls,nn_hls)
DO ji = 1, jpi
pww(ji,jj,jk) = 0._wp
END DO
END DO
ENDIF
IF( lk_north ) THEN ! --- North --- !
- DO jj = mj0(jpjglo-1-nn_hls), mj1(jpjglo-1-nn_hls)
+ DO jj = mj0(jpjglo-1-nn_hls,nn_hls), mj1(jpjglo-1-nn_hls,nn_hls)
DO ji = 1, jpi
pww(ji,jj,jk) = 0._wp
END DO
@@ -375,28 +376,28 @@ CONTAINS
! inside computational domain (cosmetic)
DO jk = 1, jpkm1
IF( lk_west ) THEN ! --- West --- !
- DO ji = mi0(2+nn_hls), mi1(2+nn_hls)
+ DO ji = mi0(2+nn_hls,nn_hls), mi1(2+nn_hls,nn_hls)
DO jj = 1, jpj
pww(ji,jj,jk) = 0._wp
END DO
END DO
ENDIF
IF( lk_east ) THEN ! --- East --- !
- DO ji = mi0(jpiglo-1-nn_hls), mi1(jpiglo-1-nn_hls)
+ DO ji = mi0(jpiglo-1-nn_hls,nn_hls), mi1(jpiglo-1-nn_hls,nn_hls)
DO jj = 1, jpj
pww(ji,jj,jk) = 0._wp
END DO
END DO
ENDIF
IF( lk_south ) THEN ! --- South --- !
- DO jj = mj0(2+nn_hls), mj1(2+nn_hls)
+ DO jj = mj0(2+nn_hls,nn_hls), mj1(2+nn_hls,nn_hls)
DO ji = 1, jpi
pww(ji,jj,jk) = 0._wp
END DO
END DO
ENDIF
IF( lk_north ) THEN ! --- North --- !
- DO jj = mj0(jpjglo-1-nn_hls), mj1(jpjglo-1-nn_hls)
+ DO jj = mj0(jpjglo-1-nn_hls,nn_hls), mj1(jpjglo-1-nn_hls,nn_hls)
DO ji = 1, jpi
pww(ji,jj,jk) = 0._wp
END DO
diff --git a/src/OCE/FLO/floblk.F90 b/src/OCE/FLO/floblk.F90
index 4d7450719ab228425db24064880ac5da1d0ec18a..95b0682aa7b545475ac0cdee78bdebddf2bf6b45 100644
--- a/src/OCE/FLO/floblk.F90
+++ b/src/OCE/FLO/floblk.F90
@@ -105,10 +105,10 @@ CONTAINS
iloop = 0
222 DO jfl = 1, jpnfl
# if ! defined key_mpi_off
- IF( iil(jfl) >= mig(Nis0) .AND. iil(jfl) <= mig(Nie0) .AND. &
- ijl(jfl) >= mjg(Njs0) .AND. ijl(jfl) <= mjg(Nje0) ) THEN
- iiloc(jfl) = iil(jfl) - mig(1) + 1
- ijloc(jfl) = ijl(jfl) - mjg(1) + 1
+ IF( iil(jfl) >= mig(Nis0,nn_hls) .AND. iil(jfl) <= mig(Nie0,nn_hls) .AND. &
+ ijl(jfl) >= mjg(Njs0,nn_hls) .AND. ijl(jfl) <= mjg(Nje0,nn_hls) ) THEN
+ iiloc(jfl) = iil(jfl) - mig(1,nn_hls) + 1
+ ijloc(jfl) = ijl(jfl) - mjg(1,nn_hls) + 1
# else
iiloc(jfl) = iil(jfl)
ijloc(jfl) = ijl(jfl)
diff --git a/src/OCE/FLO/flodom.F90 b/src/OCE/FLO/flodom.F90
index e6536bd9b32af679fe007c8740c59c85b26dab6b..2a0210d4ed8c917a7ccf0e5c3f62f224f961b0a0 100644
--- a/src/OCE/FLO/flodom.F90
+++ b/src/OCE/FLO/flodom.F90
@@ -234,8 +234,8 @@ CONTAINS
zdyad = flo_dstnce( flxx(jfl), flyy(jfl), flxx(jfl), gphif(iimfl(jfl)-1,ijmfl(jfl)-1) )
! Translation of this distances (in meter) in indexes
- zgifl(jfl)= (iimfl(jfl)-0.5) + zdxab/e1u(iimfl(jfl)-1,ijmfl(jfl)) + (mig(1)-1)
- zgjfl(jfl)= (ijmfl(jfl)-0.5) + zdyad/e2v(iimfl(jfl),ijmfl(jfl)-1) + (mjg(1)-1)
+ zgifl(jfl)= (iimfl(jfl)-0.5) + zdxab/e1u(iimfl(jfl)-1,ijmfl(jfl)) + (mig(1,nn_hls)-1)
+ zgjfl(jfl)= (ijmfl(jfl)-0.5) + zdyad/e2v(iimfl(jfl),ijmfl(jfl)-1) + (mjg(1,nn_hls)-1)
zgkfl(jfl) = (( gdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1,Kmm) - flzz(jfl) )* ikmfl(jfl)) &
& / ( gdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1,Kmm) &
& - gdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl) ,Kmm) ) &
diff --git a/src/OCE/FLO/florst.F90 b/src/OCE/FLO/florst.F90
index 59817e085a9eca184af23a95388d14249c2b1117..c855b1b7a4fa4c5cbf5a727ed6a6bcafccde67f8 100644
--- a/src/OCE/FLO/florst.F90
+++ b/src/OCE/FLO/florst.F90
@@ -97,10 +97,10 @@ CONTAINS
!
IF( lk_mpp ) THEN
DO jfl = 1, jpnfl
- IF( (INT(tpifl(jfl)) >= mig(Nis0)) .AND. &
- &(INT(tpifl(jfl)) <= mig(Nie0)) .AND. &
- &(INT(tpjfl(jfl)) >= mjg(Njs0)) .AND. &
- &(INT(tpjfl(jfl)) <= mjg(Nje0)) ) THEN
+ IF( (INT(tpifl(jfl)) >= mig(Nis0,nn_hls)) .AND. &
+ &(INT(tpifl(jfl)) <= mig(Nie0,nn_hls)) .AND. &
+ &(INT(tpjfl(jfl)) >= mjg(Njs0,nn_hls)) .AND. &
+ &(INT(tpjfl(jfl)) <= mjg(Nje0,nn_hls)) ) THEN
iperproc(narea) = iperproc(narea)+1
ENDIF
END DO
diff --git a/src/OCE/FLO/flowri.F90 b/src/OCE/FLO/flowri.F90
index 7451c1be5466f3c065006ca7d7901f8762667c41..9c3473ffb68b03c78e8e7f84b843b78a64e435e2 100644
--- a/src/OCE/FLO/flowri.F90
+++ b/src/OCE/FLO/flowri.F90
@@ -103,8 +103,8 @@ CONTAINS
IF( lk_mpp ) THEN
- iafloc = mi1( iafl )
- ibfloc = mj1( ibfl )
+ iafloc = mi1( iafl, nn_hls )
+ ibfloc = mj1( ibfl, nn_hls )
IF( Nis0 <= iafloc .AND. iafloc <= Nie0 .AND. &
& Njs0 <= ibfloc .AND. ibfloc <= Nje0 ) THEN
diff --git a/src/OCE/ICB/icbclv.F90 b/src/OCE/ICB/icbclv.F90
index 0121cbb85729a5a193a633326addb5cf8f062f32..bb26759d023ea239f988e5075b39e7e4e460c876 100644
--- a/src/OCE/ICB/icbclv.F90
+++ b/src/OCE/ICB/icbclv.F90
@@ -132,8 +132,8 @@ CONTAINS
!
newpt%lon = glamt(ji,jj) ! at t-point (centre of the cell)
newpt%lat = gphit(ji,jj)
- newpt%xi = REAL( mig(ji), wp ) - ( nn_hls - 1 )
- newpt%yj = REAL( mjg(jj), wp ) - ( nn_hls - 1 )
+ newpt%xi = REAL( mig(ji,nn_hls), wp ) - ( nn_hls - 1 )
+ newpt%yj = REAL( mjg(jj,nn_hls), wp ) - ( nn_hls - 1 )
!
newpt%uvel = 0._wp ! initially at rest
newpt%vvel = 0._wp
diff --git a/src/OCE/ICB/icbdyn.F90 b/src/OCE/ICB/icbdyn.F90
index 323758f4fec5b553339ddd001baf4bd5b7936dca..0de3d453ccf241f9fde7bc1731f9646b127e4fc9 100644
--- a/src/OCE/ICB/icbdyn.F90
+++ b/src/OCE/ICB/icbdyn.F90
@@ -197,10 +197,10 @@ CONTAINS
IF( ii == ii0 .AND. ij == ij0 ) RETURN ! berg remains in the same cell
!
! map into current processor
- ii0 = mi1( ii0 )
- ij0 = mj1( ij0 )
- ii = mi1( ii )
- ij = mj1( ij )
+ ii0 = mi1( ii0, nn_hls )
+ ij0 = mj1( ij0, nn_hls )
+ ii = mi1( ii , nn_hls )
+ ij = mj1( ij , nn_hls )
!
! assume icb is grounded if tmask(ii,ij,1) or tmask(ii,ij,ikb), depending of the option is not 0
IF ( ln_M2016 .AND. ln_icb_grd ) THEN
diff --git a/src/OCE/ICB/icbini.F90 b/src/OCE/ICB/icbini.F90
index d7bd2624c38eab5be0807f39bb84ee1dd42bd486..0fd183888b268417514f67040252ae8ab9e29d60 100644
--- a/src/OCE/ICB/icbini.F90
+++ b/src/OCE/ICB/icbini.F90
@@ -140,7 +140,7 @@ CONTAINS
DO_2D( 1, 1, 1, 1 )
src_calving_hflx(ji,jj) = narea
- src_calving (ji,jj) = nicbpack * mjg(jj) + mig(ji)
+ src_calving (ji,jj) = nicbpack * mjg(jj,nn_hls) + mig(ji,nn_hls)
END_2D
CALL lbc_lnk( 'icbini', src_calving_hflx, 'T', 1._wp )
CALL lbc_lnk( 'icbini', src_calving , 'T', 1._wp )
@@ -156,7 +156,7 @@ CONTAINS
i2 = INT( i3/nicbpack )
i1 = i3 - i2*nicbpack
i3 = INT( src_calving_hflx(ji,jj) )
- IF( i1 == mig(ji) .AND. i3 == narea ) THEN
+ IF( i1 == mig(ji,nn_hls) .AND. i3 == narea ) THEN
IF( nicbdi < 0 ) THEN ; nicbdi = ji
ELSE ; nicbei = ji
ENDIF
@@ -172,7 +172,7 @@ CONTAINS
i2 = INT( i3/nicbpack )
i1 = i3 - i2*nicbpack
i3 = INT( src_calving_hflx(ji,jj) )
- IF( i2 == mjg(jj) .AND. i3 == narea ) THEN
+ IF( i2 == mjg(jj,nn_hls) .AND. i3 == narea ) THEN
IF( nicbdj < 0 ) THEN ; nicbdj = jj
ELSE ; nicbej = jj
ENDIF
@@ -361,8 +361,8 @@ CONTAINS
rn_test_box(1) < glamt(ji,jj) .AND. glamt(ji,jj) < rn_test_box(2) .AND. &
rn_test_box(3) < gphit(ji,jj) .AND. gphit(ji,jj) < rn_test_box(4) ) THEN
localberg%mass_scaling = rn_mass_scaling(iberg)
- localpt%xi = REAL( mig(ji) - (nn_hls-1), wp )
- localpt%yj = REAL( mjg(jj) - (nn_hls-1), wp )
+ localpt%xi = REAL( mig(ji,nn_hls) - (nn_hls-1), wp )
+ localpt%yj = REAL( mjg(jj,nn_hls) - (nn_hls-1), wp )
CALL icb_utl_interp( localpt%xi, localpt%yj, plat=localpt%lat, plon=localpt%lon )
localpt%mass = rn_initial_mass (iberg)
localpt%thickness = rn_initial_thickness(iberg)
diff --git a/src/OCE/ICB/icblbc.F90 b/src/OCE/ICB/icblbc.F90
index fa901486ad787a06b6d74fe792c714972c3e2b8c..6a8823f1a773a6b1f152df6b2f0602c21904989b 100644
--- a/src/OCE/ICB/icblbc.F90
+++ b/src/OCE/ICB/icblbc.F90
@@ -90,9 +90,9 @@ CONTAINS
this => first_berg
DO WHILE( ASSOCIATED(this) )
pt => this%current_point
- IF( pt%xi > REAL(mig(nicbei),wp) + 0.5_wp ) THEN
+ IF( pt%xi > REAL(mig(nicbei,nn_hls),wp) + 0.5_wp ) THEN
pt%xi = ricb_right + MOD(pt%xi, 1._wp ) - 1._wp
- ELSE IF( pt%xi < REAL(mig(nicbdi),wp) - 0.5_wp ) THEN
+ ELSE IF( pt%xi < REAL(mig(nicbdi,nn_hls),wp) - 0.5_wp ) THEN
pt%xi = ricb_left + MOD(pt%xi, 1._wp )
ENDIF
this => this%next
@@ -125,10 +125,10 @@ CONTAINS
DO WHILE( ASSOCIATED(this) )
pt => this%current_point
ijne = INT( pt%yj + 0.5 )
- IF( pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp ) THEN
+ IF( pt%yj > REAL(mjg(nicbej,nn_hls),wp) + 0.5_wp ) THEN
!
iine = INT( pt%xi + 0.5 )
- ipts = nicbfldpts (mi1(iine))
+ ipts = nicbfldpts (mi1(iine,nn_hls))
!
! moving across the cut line means both position and
! velocity must change
@@ -228,7 +228,7 @@ CONTAINS
this => first_berg
DO WHILE (ASSOCIATED(this))
pt => this%current_point
- IF( ipe_E >= 0 .AND. pt%xi > REAL(mig(nicbei),wp) + 0.5_wp - (nn_hls-1) ) THEN
+ IF( ipe_E >= 0 .AND. pt%xi > REAL(mig(nicbei,nn_hls),wp) + 0.5_wp - (nn_hls-1) ) THEN
tmpberg => this
this => this%next
ibergs_to_send_e = ibergs_to_send_e + 1
@@ -241,7 +241,7 @@ CONTAINS
! now pack it into buffer and delete from list
CALL icb_pack_into_buffer( tmpberg, obuffer_e, ibergs_to_send_e)
CALL icb_utl_delete(first_berg, tmpberg)
- ELSE IF( ipe_W >= 0 .AND. pt%xi < REAL(mig(nicbdi),wp) - 0.5_wp - (nn_hls-1) ) THEN
+ ELSE IF( ipe_W >= 0 .AND. pt%xi < REAL(mig(nicbdi,nn_hls),wp) - 0.5_wp - (nn_hls-1) ) THEN
tmpberg => this
this => this%next
ibergs_to_send_w = ibergs_to_send_w + 1
@@ -320,7 +320,7 @@ CONTAINS
this => first_berg
DO WHILE (ASSOCIATED(this))
pt => this%current_point
- IF( ipe_N >= 0 .AND. pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp - (nn_hls-1) ) THEN
+ IF( ipe_N >= 0 .AND. pt%yj > REAL(mjg(nicbej,nn_hls),wp) + 0.5_wp - (nn_hls-1) ) THEN
tmpberg => this
this => this%next
ibergs_to_send_n = ibergs_to_send_n + 1
@@ -330,7 +330,7 @@ CONTAINS
ENDIF
CALL icb_pack_into_buffer( tmpberg, obuffer_n, ibergs_to_send_n)
CALL icb_utl_delete(first_berg, tmpberg)
- ELSE IF( ipe_S >= 0 .AND. pt%yj < REAL(mjg(nicbdj),wp) - 0.5_wp - (nn_hls-1) ) THEN
+ ELSE IF( ipe_S >= 0 .AND. pt%yj < REAL(mjg(nicbdj,nn_hls),wp) - 0.5_wp - (nn_hls-1) ) THEN
tmpberg => this
this => this%next
ibergs_to_send_s = ibergs_to_send_s + 1
@@ -441,10 +441,10 @@ CONTAINS
this => first_berg
DO WHILE (ASSOCIATED(this))
pt => this%current_point
- IF( pt%xi < REAL(mig(nicbdi),wp) - 0.5_wp - (nn_hls-1) .OR. &
- pt%xi > REAL(mig(nicbei),wp) + 0.5_wp - (nn_hls-1) .OR. &
- pt%yj < REAL(mjg(nicbdj),wp) - 0.5_wp - (nn_hls-1) .OR. &
- pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp - (nn_hls-1) ) THEN
+ IF( pt%xi < REAL(mig(nicbdi,nn_hls),wp) - 0.5_wp - (nn_hls-1) .OR. &
+ pt%xi > REAL(mig(nicbei,nn_hls),wp) + 0.5_wp - (nn_hls-1) .OR. &
+ pt%yj < REAL(mjg(nicbdj,nn_hls),wp) - 0.5_wp - (nn_hls-1) .OR. &
+ pt%yj > REAL(mjg(nicbej,nn_hls),wp) + 0.5_wp - (nn_hls-1) ) THEN
i = i + 1
WRITE(numicb,*) 'berg lost in halo: ', this%number(:)
WRITE(numicb,*) ' ', nimpp, njmpp
@@ -514,8 +514,8 @@ CONTAINS
DO WHILE (ASSOCIATED(this))
pt => this%current_point
iine = INT( pt%xi + 0.5 ) + (nn_hls-1)
- iproc = nicbflddest(mi1(iine))
- IF( pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp - (nn_hls-1) ) THEN
+ iproc = nicbflddest(mi1(iine,nn_hls))
+ IF( pt%yj > REAL(mjg(nicbej,nn_hls),wp) + 0.5_wp - (nn_hls-1) ) THEN
IF( iproc == ifldproc ) THEN
!
IF( iproc /= narea ) THEN
@@ -593,9 +593,9 @@ CONTAINS
pt => this%current_point
iine = INT( pt%xi + 0.5 ) + (nn_hls-1)
ijne = INT( pt%yj + 0.5 ) + (nn_hls-1)
- ipts = nicbfldpts (mi1(iine))
- iproc = nicbflddest(mi1(iine))
- IF( pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp - (nn_hls-1) ) THEN
+ ipts = nicbfldpts (mi1(iine,nn_hls))
+ iproc = nicbflddest(mi1(iine,nn_hls))
+ IF( pt%yj > REAL(mjg(nicbej,nn_hls),wp) + 0.5_wp - (nn_hls-1) ) THEN
IF( iproc == ifldproc ) THEN
!
! moving across the cut line means both position and
diff --git a/src/OCE/ICB/icbrst.F90 b/src/OCE/ICB/icbrst.F90
index 092b56e5860f47825f7bb949b252f319f7108633..9e7560197effae6afbeb7d27427d16c7aa752ee1 100644
--- a/src/OCE/ICB/icbrst.F90
+++ b/src/OCE/ICB/icbrst.F90
@@ -90,8 +90,8 @@ CONTAINS
ii = INT( localpt%xi + 0.5 ) + ( nn_hls-1 )
ij = INT( localpt%yj + 0.5 ) + ( nn_hls-1 )
! Only proceed if this iceberg is on the local processor (excluding halos).
- IF ( ii >= mig(Nis0) .AND. ii <= mig(Nie0) .AND. &
- & ij >= mjg(Njs0) .AND. ij <= mjg(Nje0) ) THEN
+ IF ( ii >= mig(Nis0,nn_hls) .AND. ii <= mig(Nie0,nn_hls) .AND. &
+ & ij >= mjg(Njs0,nn_hls) .AND. ij <= mjg(Nje0,nn_hls) ) THEN
CALL iom_get( ncid, jpdom_unknown, 'number', zdata(:) , ktime=jn, kstart=(/1/), kcount=(/nkounts/) )
localberg%number(:) = INT(zdata(:))
@@ -244,16 +244,16 @@ CONTAINS
! global attributes
IF( lk_mpp ) THEN
! Set domain parameters (assume jpdom_local_full)
- nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_number_total' , jpnij )
- nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_number' , narea-1 )
- nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_dimensions_ids' , (/ 1 , 2 /) )
- nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_size_global' , (/ Ni0glo , Nj0glo /) )
- nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_size_local' , (/ Ni_0 , Nj_0 /) )
- nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_position_first' , (/ mig0(Nis0), mjg0(Njs0) /) )
- nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_position_last' , (/ mig0(Nie0), mjg0(Nje0) /) )
- nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_halo_size_start', (/ 0 , 0 /) )
- nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_halo_size_end' , (/ 0 , 0 /) )
- nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_type' , 'BOX' )
+ nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_number_total' , jpnij )
+ nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_number' , narea-1 )
+ nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_dimensions_ids' , (/ 1 , 2 /) )
+ nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_size_global' , (/ Ni0glo , Nj0glo /) )
+ nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_size_local' , (/ Ni_0 , Nj_0 /) )
+ nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_position_first' , (/ mig(Nis0,0), mjg(Njs0,0) /) )
+ nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_position_last' , (/ mig(Nie0,0), mjg(Nje0,0) /) )
+ nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_halo_size_start', (/ 0 , 0 /) )
+ nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_halo_size_end' , (/ 0 , 0 /) )
+ nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_type' , 'BOX' )
ENDIF
IF (associated(first_berg)) then
diff --git a/src/OCE/ICB/icbthm.F90 b/src/OCE/ICB/icbthm.F90
index c39500dbed34d641ae5accd5ccd17a69c01e0e83..cff42aead28e9769ec17e76bbd7cd5122fc480ce 100644
--- a/src/OCE/ICB/icbthm.F90
+++ b/src/OCE/ICB/icbthm.F90
@@ -31,6 +31,8 @@ MODULE icbthm
PUBLIC icb_thm ! routine called in icbstp.F90 module
+ !! * Substitutions
+# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
!! $Id: icbthm.F90 15088 2021-07-06 13:03:34Z acc $
@@ -112,9 +114,9 @@ CONTAINS
zxi = pt%xi ! position in (i,j) referential
zyj = pt%yj
ii = INT( zxi + 0.5 ) ! T-cell of the berg
- ii = mi1( ii + (nn_hls-1) )
+ ii = mi1( ii + (nn_hls-1), nn_hls )
ij = INT( zyj + 0.5 )
- ij = mj1( ij + (nn_hls-1) )
+ ij = mj1( ij + (nn_hls-1), nn_hls )
zVol = zT * zW * zL
! Environment
@@ -287,8 +289,8 @@ CONTAINS
! now use melt and associated heat flux in ocean (or not)
!
IF(.NOT. ln_passive_mode ) THEN
- emp (:,:) = emp (:,:) - berg_grid%floating_melt(:,:)
- qns (:,:) = qns (:,:) + berg_grid%calving_hflx (:,:)
+ emp (A2D(0)) = emp (A2D(0)) - berg_grid%floating_melt(A2D(0))
+ qns (:,:) = qns (:,:) + berg_grid%calving_hflx (A2D(0))
ENDIF
!
END SUBROUTINE icb_thm
diff --git a/src/OCE/ICB/icbutl.F90 b/src/OCE/ICB/icbutl.F90
index 873245fcd6b19d8f83119228191153f9cf2b3198..11634f30299559500dc4bc2b70108683ff625427 100644
--- a/src/OCE/ICB/icbutl.F90
+++ b/src/OCE/ICB/icbutl.F90
@@ -57,6 +57,7 @@ MODULE icbutl
PUBLIC icb_utl_heat ! routine called in icbdia module
!! * Substitutions
+# include "do_loop_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -101,7 +102,7 @@ CONTAINS
CALL lbc_lnk_icb( 'icbutl', ua_e , 'U', -1._wp, 1, 1 )
CALL lbc_lnk_icb( 'icbutl', va_e , 'V', -1._wp, 1, 1 )
#if defined key_si3
- hi_e(1:jpi, 1:jpj) = hm_i (:,:)
+ hi_e(A2D(0)) = hm_i (:,:) ! clem: something is wrong here (hm_i defined in the interior only) but I do not what to do
ui_e(1:jpi, 1:jpj) = u_ice(:,:)
vi_e(1:jpi, 1:jpj) = v_ice(:,:)
!
@@ -312,18 +313,18 @@ CONTAINS
!
IF (TRIM(cd_type) == 'T' ) THEN
ierr = 0
- IF ( kii < mig( 1 ) ) THEN ; ierr = ierr + 1
- ELSEIF( kii >= mig(jpi) ) THEN ; ierr = ierr + 1
+ IF ( kii < mig( 1 ,nn_hls) ) THEN ; ierr = ierr + 1
+ ELSEIF( kii >= mig(jpi,nn_hls) ) THEN ; ierr = ierr + 1
ENDIF
!
- IF ( kij < mjg( 1 ) ) THEN ; ierr = ierr + 1
- ELSEIF( kij >= mjg(jpj) ) THEN ; ierr = ierr + 1
+ IF ( kij < mjg( 1 ,nn_hls) ) THEN ; ierr = ierr + 1
+ ELSEIF( kij >= mjg(jpj,nn_hls) ) THEN ; ierr = ierr + 1
ENDIF
!
IF ( ierr > 0 ) THEN
WRITE(numicb,*) 'bottom left corner T point out of bound'
- WRITE(numicb,*) pi, kii, mig( 1 ), mig(jpi)
- WRITE(numicb,*) pj, kij, mjg( 1 ), mjg(jpj)
+ WRITE(numicb,*) pi, kii, mig( 1,nn_hls ), mig(jpi,nn_hls)
+ WRITE(numicb,*) pj, kij, mjg( 1,nn_hls ), mjg(jpj,nn_hls)
WRITE(numicb,*) pmsk
CALL FLUSH(numicb)
CALL ctl_stop('STOP','icb_utl_bilin_e: an icebergs coordinates is out of valid range (out of bound error).' , &
@@ -335,13 +336,13 @@ CONTAINS
! find position in this processor. Prevent near edge problems (see #1389)
! (PM) will be useless if extra halo is used in NEMO
!
- IF ( kii <= mig(1)-1 ) THEN ; kii = 0
- ELSEIF( kii > mig(jpi) ) THEN ; kii = jpi
- ELSE ; kii = mi1(kii)
+ IF ( kii <= mig(1,nn_hls)-1 ) THEN ; kii = 0
+ ELSEIF( kii > mig(jpi,nn_hls) ) THEN ; kii = jpi
+ ELSE ; kii = mi1(kii,nn_hls)
ENDIF
- IF ( kij <= mjg(1)-1 ) THEN ; kij = 0
- ELSEIF( kij > mjg(jpj) ) THEN ; kij = jpj
- ELSE ; kij = mj1(kij)
+ IF ( kij <= mjg(1,nn_hls)-1 ) THEN ; kij = 0
+ ELSEIF( kij > mjg(jpj,nn_hls) ) THEN ; kij = jpj
+ ELSE ; kij = mj1(kij,nn_hls)
ENDIF
!
! define mask array
@@ -462,8 +463,8 @@ CONTAINS
zj = pj - REAL(ij,wp)
! conversion to local domain (no need to do a sanity check already done in icbpos)
- ii = mi1(ii) + (nn_hls-1)
- ij = mj1(ij) + (nn_hls-1)
+ ii = mi1(ii,nn_hls) + (nn_hls-1)
+ ij = mj1(ij,nn_hls) + (nn_hls-1)
!
IF( 0.0_wp <= zi .AND. zi < 0.5_wp ) THEN
IF( 0.0_wp <= zj .AND. zj < 0.5_wp ) THEN ! NE quadrant
diff --git a/src/OCE/IOM/iom.F90 b/src/OCE/IOM/iom.F90
index 9a1f1c859c0b50a4e3fbe0b9e04d5a069e0d7e27..49433e40e524b91b51945c9ccf365502c1e1a0d9 100644
--- a/src/OCE/IOM/iom.F90
+++ b/src/OCE/IOM/iom.F90
@@ -1299,7 +1299,7 @@ CONTAINS
ENDIF
ELSE ! not a 1D array as pv_r1d requires jpdom_unknown
! we do not read the overlap and the extra-halos -> from Nis0 to Nie0 and from Njs0 to Nje0
- IF( idom == jpdom_global ) istart(1:2) = (/ mig0(Nis0), mjg0(Njs0) /)
+ IF( idom == jpdom_global ) istart(1:2) = (/ mig(Nis0,0), mjg(Njs0,0) /)
icnt(1:2) = (/ Ni_0, Nj_0 /)
IF( PRESENT(pv_r3d) ) THEN
IF( idom == jpdom_auto_xy ) THEN
@@ -1334,15 +1334,12 @@ CONTAINS
IF( irankpv == 2 ) ishape(1:2) = SHAPE(pv_r2d)
IF( irankpv == 3 ) ishape(1:3) = SHAPE(pv_r3d)
IF( ishape(1) == Ni_0 .AND. ishape(2) == Nj_0 ) THEN ! array with 0 halo
- ihls = 0
ix1 = 1 ; ix2 = Ni_0 ; iy1 = 1 ; iy2 = Nj_0 ! index of the array to be read
ctmp1 = 'd(:,:'
ELSEIF( ishape(1) == jpi .AND. ishape(2) == jpj ) THEN ! array with nn_hls halos
- ihls = nn_hls
ix1 = Nis0 ; ix2 = Nie0 ; iy1 = Njs0 ; iy2 = Nje0 ! index of the array to be read
ctmp1 = 'd(Nis0:Nie0,Njs0:Nje0'
- ELSEIF( ishape(1) == Ni_0+1 .AND. ishape(2) == Nj_0+1 ) THEN ! nn_hls = 2 and array with 1 halo
- ihls = 1
+ ELSEIF( ishape(1) == Ni_0+2 .AND. ishape(2) == Nj_0+2 ) THEN ! nn_hls = 2 and array with 1 halo
ix1 = 2 ; ix2 = Ni_0+1 ; iy1 = 2 ; iy2 = Nj_0+1 ! index of the array to be read
ctmp1 = 'd(2:Ni_0+1,2:Ni_0+1'
ELSE
@@ -1368,16 +1365,16 @@ CONTAINS
IF( istop == nstop ) THEN ! no additional errors until this point...
IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name)
+ cl_type = 'T'
+ IF( PRESENT(cd_type) ) cl_type = cd_type
!--- halos and NP folding (NP folding to be done even if no halos)
IF( idom /= jpdom_unknown .AND. cl_type /= 'Z' .AND. ( PRESENT(pv_r2d) .OR. PRESENT(pv_r3d) ) ) THEN
- cl_type = 'T'
- IF( PRESENT(cd_type) ) cl_type = cd_type
zsgn = 1._wp
IF( PRESENT(psgn ) ) zsgn = psgn
- IF( PRESENT(pv_r2d) .AND. llok ) THEN
- CALL lbc_lnk( 'iom', pv_r2d, cl_type, zsgn, kfillmode = kfill, khls = ihls )
- ELSEIF( PRESENT(pv_r3d) .AND. llok ) THEN
- CALL lbc_lnk( 'iom', pv_r3d, cl_type, zsgn, kfillmode = kfill, khls = ihls )
+ IF( PRESENT(pv_r2d) ) THEN
+ CALL lbc_lnk( 'iom', pv_r2d, cl_type, zsgn, kfillmode = kfill )
+ ELSEIF( PRESENT(pv_r3d) ) THEN
+ CALL lbc_lnk( 'iom', pv_r3d, cl_type, zsgn, kfillmode = kfill )
ENDIF
ENDIF
!
@@ -2335,11 +2332,11 @@ CONTAINS
LOGICAL, INTENT(IN) :: ldxios, ldrxios
!!----------------------------------------------------------------------
!
- CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=Ni0glo,nj_glo=Nj0glo,ibegin=mig0(Nis0)-1,jbegin=mjg0(Njs0)-1,ni=Ni_0,nj=Nj_0)
+ CALL iom_set_domain_attr("grid_"//cdgrd,ni_glo=Ni0glo,nj_glo=Nj0glo,ibegin=mig(Nis0,0)-1,jbegin=mjg(Njs0,0)-1,ni=Ni_0,nj=Nj_0)
CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = -nn_hls, data_ni=jpi, data_jbegin = -nn_hls, data_nj=jpj)
CALL iom_set_domain_attr("grid_"//cdgrd//"_inner", ni_glo = Ni0glo, nj_glo = Nj0glo, &
- & ibegin = mig0(Nis0) - 1, jbegin = mjg0(Njs0) - 1, ni = Ni_0, nj = Nj_0)
+ & ibegin = mig(Nis0,0) - 1, jbegin = mjg(Njs0,0) - 1, ni = Ni_0, nj = Nj_0)
CALL iom_set_domain_attr("grid_"//cdgrd//"_inner", data_dim=2, data_ibegin = 0, data_ni=Ni_0, data_jbegin = 0, data_nj=Nj_0)
IF( ln_tile ) THEN
@@ -2465,7 +2462,7 @@ CONTAINS
!
! CALL dom_ngb( -168.53_wp, 65.03_wp, ix, iy, 'T' ) ! i-line that passes through Bering Strait: Reference latitude (used in plots)
CALL dom_ngb( 180.0_wp, 90.0_wp, ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots)
- CALL iom_set_domain_attr("gznl", ni_glo=Ni0glo, nj_glo=Nj0glo, ibegin=mig0(Nis0)-1, jbegin=mjg0(Njs0)-1, ni=Ni_0, nj=Nj_0)
+ CALL iom_set_domain_attr("gznl", ni_glo=Ni0glo, nj_glo=Nj0glo, ibegin=mig(Nis0,0)-1, jbegin=mjg(Njs0,0)-1, ni=Ni_0, nj=Nj_0)
CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin=0, data_ni=Ni_0, data_jbegin=0, data_nj=Nj_0)
CALL iom_set_domain_attr("gznl", lonvalue = real(zlon, dp), &
& latvalue = real(RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp))
diff --git a/src/OCE/IOM/iom_nf90.F90 b/src/OCE/IOM/iom_nf90.F90
index 171ef53bf0bb10ec16e9971bdb866a0eb75d0347..7e6c24fe82a7d4bd40d5bb0849385371ad0ceff3 100644
--- a/src/OCE/IOM/iom_nf90.F90
+++ b/src/OCE/IOM/iom_nf90.F90
@@ -146,16 +146,16 @@ CONTAINS
END SELECT
CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo)
! global attributes
- CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number_total' , jpnij ), clinfo)
- CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number' , narea-1 ), clinfo)
- CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_dimensions_ids' , (/ 1 , 2 /) ), clinfo)
- CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_global' , (/ Ni0glo , Nj0glo /) ), clinfo)
- CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_local' , (/ Ni_0 , Nj_0 /) ), clinfo)
- CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_first' , (/ mig0(Nis0), mjg0(Njs0) /) ), clinfo)
- CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_last' , (/ mig0(Nie0), mjg0(Nje0) /) ), clinfo)
- CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_start', (/ 0 , 0 /) ), clinfo)
- CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_end' , (/ 0 , 0 /) ), clinfo)
- CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_type' , 'BOX' ), clinfo)
+ CALL iom_nf90_check(NF90_PUT_ATT(if90id,NF90_GLOBAL, 'DOMAIN_number_total' , jpnij ), clinfo)
+ CALL iom_nf90_check(NF90_PUT_ATT(if90id,NF90_GLOBAL, 'DOMAIN_number' , narea-1 ), clinfo)
+ CALL iom_nf90_check(NF90_PUT_ATT(if90id,NF90_GLOBAL, 'DOMAIN_dimensions_ids' , (/ 1 , 2 /) ), clinfo)
+ CALL iom_nf90_check(NF90_PUT_ATT(if90id,NF90_GLOBAL, 'DOMAIN_size_global' , (/ Ni0glo , Nj0glo /) ), clinfo)
+ CALL iom_nf90_check(NF90_PUT_ATT(if90id,NF90_GLOBAL, 'DOMAIN_size_local' , (/ Ni_0 , Nj_0 /) ), clinfo)
+ CALL iom_nf90_check(NF90_PUT_ATT(if90id,NF90_GLOBAL, 'DOMAIN_position_first' , (/ mig(Nis0,0), mjg(Njs0,0) /) ), clinfo)
+ CALL iom_nf90_check(NF90_PUT_ATT(if90id,NF90_GLOBAL, 'DOMAIN_position_last' , (/ mig(Nie0,0), mjg(Nje0,0) /) ), clinfo)
+ CALL iom_nf90_check(NF90_PUT_ATT(if90id,NF90_GLOBAL, 'DOMAIN_halo_size_start', (/ 0 , 0 /) ), clinfo)
+ CALL iom_nf90_check(NF90_PUT_ATT(if90id,NF90_GLOBAL, 'DOMAIN_halo_size_end' , (/ 0 , 0 /) ), clinfo)
+ CALL iom_nf90_check(NF90_PUT_ATT(if90id,NF90_GLOBAL, 'DOMAIN_type' , 'BOX' ), clinfo)
ELSE !* the file should be open for read mode so it must exist...
CALL ctl_stop( TRIM(clinfo), ' should be impossible case...' )
ENDIF
@@ -701,7 +701,7 @@ CONTAINS
ix1 = 1 ; ix2 = Ni_0 ; iy1 = 1 ; iy2 = Nj_0
ELSEIF( ishape(1) == jpi .AND. ishape(2) == jpj ) THEN ! array with nn_hls halos
ix1 = Nis0 ; ix2 = Nie0 ; iy1 = Njs0 ; iy2 = Nje0
- ELSEIF( ishape(1) == Ni_0+1 .AND. ishape(2) == Nj_0+1 ) THEN ! nn_hls = 2 and array with 1 halo
+ ELSEIF( ishape(1) == Ni_0+2 .AND. ishape(2) == Nj_0+2 ) THEN ! nn_hls = 2 and array with 1 halo
ix1 = 2 ; ix2 = Ni_0+1 ; iy1 = 2 ; iy2 = Nj_0+1
ELSE
CALL ctl_stop( 'iom_nf90_rp0123d: should have been an impossible case...' )
diff --git a/src/OCE/IOM/prtctl.F90 b/src/OCE/IOM/prtctl.F90
index 6fcca35f92a43845067e70854ec35b572f70af10..75103afdd6ab8138c3df99bb38af84622f9f95da 100644
--- a/src/OCE/IOM/prtctl.F90
+++ b/src/OCE/IOM/prtctl.F90
@@ -119,11 +119,11 @@ CONTAINS
!! clinfo3 : additional information
!!----------------------------------------------------------------------
INTEGER , INTENT(in) :: ktab2d_1, ktab3d_1, ktab4d_1, ktab2d_2, ktab3d_2
- REAL(2*wp), DIMENSION(A2D_T(ktab2d_1)) , INTENT(in), OPTIONAL :: tab2d_1
- REAL(2*wp), DIMENSION(A2D_T(ktab3d_1),:) , INTENT(in), OPTIONAL :: tab3d_1
- REAL(2*wp), DIMENSION(A2D_T(ktab4d_1),:,:), INTENT(in), OPTIONAL :: tab4d_1
- REAL(2*wp), DIMENSION(A2D_T(ktab2d_2)) , INTENT(in), OPTIONAL :: tab2d_2
- REAL(2*wp), DIMENSION(A2D_T(ktab3d_2),:) , INTENT(in), OPTIONAL :: tab3d_2
+ REAL(2*wp), DIMENSION(:,:) , INTENT(in), OPTIONAL :: tab2d_1
+ REAL(2*wp), DIMENSION(:,:,:) , INTENT(in), OPTIONAL :: tab3d_1
+ REAL(2*wp), DIMENSION(:,:,:,:), INTENT(in), OPTIONAL :: tab4d_1
+ REAL(2*wp), DIMENSION(:,:) , INTENT(in), OPTIONAL :: tab2d_2
+ REAL(2*wp), DIMENSION(:,:,:) , INTENT(in), OPTIONAL :: tab3d_2
REAL(wp), DIMENSION(:,:,:) , INTENT(in), OPTIONAL :: mask1
REAL(wp), DIMENSION(:,:,:) , INTENT(in), OPTIONAL :: mask2
CHARACTER(len=*), DIMENSION(:) , INTENT(in), OPTIONAL :: clinfo ! information about the tab3d array
@@ -135,14 +135,18 @@ CONTAINS
CHARACTER(len=30) :: cl1, cl2
CHARACTER(len=6) :: clfmt
INTEGER :: jn, jl, kdir
- INTEGER :: iis, iie, jjs, jje
+ INTEGER :: ipi1, ipi2, ipim1, ipim2
+ INTEGER :: isht1, isht2, ishtm1, ishtm2
+ INTEGER :: ii1s, ii1e, jj1s, jj1e
+ INTEGER :: ii2s, ii2e, jj2s, jj2e
+ INTEGER :: iim1s, iim1e, jjm1s, jjm1e
+ INTEGER :: iim2s, iim2e, jjm2s, jjm2e
INTEGER :: itra, inum
- INTEGER, DIMENSION(4) :: ishape
REAL(2*wp) :: zsum1, zsum2, zvctl1, zvctl2
!!----------------------------------------------------------------------
!
IF( ( ktab2d_1 * ktab3d_1 * ktab4d_1 * ktab2d_2 * ktab3d_2 ) /= 0 ) THEN
- CALL ctl_stop( 'prt_ctl is not working with tiles' )
+ CALL ctl_stop( 'prt_ctl is a debugging toll that should not be used with tiles' )
ENDIF
! Arrays, scalars initialization
@@ -159,29 +163,55 @@ CONTAINS
IF( wp == sp ) clfmt = 'D23.16' ! 16 significant numbers
IF( wp == dp ) clfmt = 'D41.34' ! 34 significant numbers
+
+ IF( PRESENT(tab2d_1) ) ipi1 = SIZE(tab2d_1,1)
+ IF( PRESENT(tab3d_1) ) ipi1 = SIZE(tab3d_1,1)
+ IF( PRESENT(tab4d_1) ) ipi1 = SIZE(tab4d_1,1)
+ isht1 = ( jpi - ipi1 ) / 2
+
+ ipi2 = -1 ! default definition
+ IF( PRESENT(tab2d_2) ) ipi2 = SIZE(tab2d_2,1)
+ IF( PRESENT(tab3d_2) ) ipi2 = SIZE(tab3d_2,1)
+ isht2 = ( jpi - ipi2 ) / 2
+
+ ipim1 = -1 ! default definition
+ IF( PRESENT(mask1) ) ipim1 = SIZE(mask1,1)
+ ishtm1 = ( jpi - ipim1 ) / 2
+
+ ipim2 = -1 ! default definition
+ IF( PRESENT(mask2) ) ipim2 = SIZE(mask2,1)
+ ishtm2 = ( jpi - ipim2 ) / 2
! Loop over each sub-domain, i.e. the total number of processors ijsplt
DO jl = 1, SIZE(nall_ictls)
- IF( PRESENT(tab2d_1) ) ishape(1:2) = SHAPE(tab2d_1)
- IF( PRESENT(tab3d_1) ) ishape(1:3) = SHAPE(tab3d_1)
- IF( PRESENT(tab4d_1) ) ishape(1:4) = SHAPE(tab4d_1)
- IF( ishape(1) == jpi .AND. ishape(2) == jpj ) THEN
- iis = Nis0 ; iie = Nie0 ; jjs = Njs0 ; jje = Nje0
- ELSE
- iis = 1 ; iie = ishape(1) ; jjs = 1 ; jje = ishape(2)
- ENDIF
- iis = MAX( nall_ictls(jl), iis )
- iie = MIN( nall_ictle(jl), iie )
- jjs = MAX( nall_jctls(jl), jjs )
- jje = MIN( nall_jctle(jl), jje )
+
+ ii1s = MAX( nall_ictls(jl), Nis0 ) - isht1
+ ii1e = MIN( nall_ictle(jl), Nie0 ) - isht1
+ jj1s = MAX( nall_jctls(jl), Njs0 ) - isht1
+ jj1e = MIN( nall_jctle(jl), Nje0 ) - isht1
+
+ ii2s = MAX( nall_ictls(jl), Nis0 ) - isht2
+ ii2e = MIN( nall_ictle(jl), Nie0 ) - isht2
+ jj2s = MAX( nall_jctls(jl), Njs0 ) - isht2
+ jj2e = MIN( nall_jctle(jl), Nje0 ) - isht2
+
+ iim1s = MAX( nall_ictls(jl), Nis0 ) - ishtm1
+ iim1e = MIN( nall_ictle(jl), Nie0 ) - ishtm1
+ jjm1s = MAX( nall_jctls(jl), Njs0 ) - ishtm1
+ jjm1e = MIN( nall_jctle(jl), Nje0 ) - ishtm1
+
+ iim2s = MAX( nall_ictls(jl), Nis0 ) - ishtm2
+ iim2e = MIN( nall_ictle(jl), Nie0 ) - ishtm2
+ jjm2s = MAX( nall_jctls(jl), Njs0 ) - ishtm2
+ jjm2e = MIN( nall_jctle(jl), Nje0 ) - ishtm2
IF( PRESENT(clinfo) ) THEN ; inum = numprt_top(jl)
ELSE ; inum = numprt_oce(jl)
ENDIF
! Compute the sum control only where the tile domain and control print area overlap
- IF( iie >= iis .AND. jje >= jjs ) THEN
+ IF( ii1e >= ii1s .AND. jj1e >= jj1s ) THEN
DO jn = 1, itra
IF( PRESENT(clinfo3) ) THEN
@@ -200,32 +230,42 @@ CONTAINS
! 2D arrays
IF( PRESENT(tab2d_1) ) THEN
- IF( PRESENT(mask1) ) THEN ; zsum1 = SUM( tab2d_1(iis:iie,jjs:jje) * mask1(A2D(0),1) )
- ELSE ; zsum1 = SUM( tab2d_1(iis:iie,jjs:jje) )
+ IF( PRESENT(mask1) ) THEN
+ zsum1 = SUM( tab2d_1(ii1s:ii1e,jj1s:jj1e) * mask1(iim1s:iim1e,jjm1s:jjm1e,1) )
+ ELSE
+ zsum1 = SUM( tab2d_1(ii1s:ii1e,jj1s:jj1e) )
ENDIF
ENDIF
IF( PRESENT(tab2d_2) ) THEN
- IF( PRESENT(mask2) ) THEN ; zsum2 = SUM( tab2d_2(iis:iie,jjs:jje) * mask2(A2D(0),1) )
- ELSE ; zsum2 = SUM( tab2d_2(iis:iie,jjs:jje) )
+ IF( PRESENT(mask2) ) THEN
+ zsum2 = SUM( tab2d_2(ii2s:ii2e,jj2s:jj2e) * mask2(iim2s:iim2e,jjm2s:jjm2e,1) )
+ ELSE
+ zsum2 = SUM( tab2d_2(ii2s:ii2e,jj2s:jj2e) )
ENDIF
ENDIF
! 3D arrays
IF( PRESENT(tab3d_1) ) THEN
- IF( PRESENT(mask1) ) THEN ; zsum1 = SUM( tab3d_1(iis:iie,jjs:jje,1:kdir) * mask1(A2D(0),1:kdir) )
- ELSE ; zsum1 = SUM( tab3d_1(iis:iie,jjs:jje,1:kdir) )
+ IF( PRESENT(mask1) ) THEN
+ zsum1 = SUM( tab3d_1(ii1s:ii1e,jj1s:jj1e,1:kdir) * mask1(iim1s:iim1e,jjm1s:jjm1e,1:kdir) )
+ ELSE
+ zsum1 = SUM( tab3d_1(ii1s:ii1e,jj1s:jj1e,1:kdir) )
ENDIF
ENDIF
IF( PRESENT(tab3d_2) ) THEN
- IF( PRESENT(mask2) ) THEN ; zsum2 = SUM( tab3d_2(iis:iie,jjs:jje,1:kdir) * mask2(A2D(0),1:kdir) )
- ELSE ; zsum2 = SUM( tab3d_2(iis:iie,jjs:jje,1:kdir) )
+ IF( PRESENT(mask2) ) THEN
+ zsum2 = SUM( tab3d_2(ii2s:ii2e,jj2s:jj2e,1:kdir) * mask2(iim2s:iim2e,jjm2s:jjm2e,1:kdir) )
+ ELSE
+ zsum2 = SUM( tab3d_2(ii2s:ii2e,jj2s:jj2e,1:kdir) )
ENDIF
ENDIF
! 4D arrays
IF( PRESENT(tab4d_1) ) THEN
- IF( PRESENT(mask1) ) THEN ; zsum1 = SUM( tab4d_1(iis:iie,jjs:jje,1:kdir,jn) * mask1(A2D(0),1:kdir) )
- ELSE ; zsum1 = SUM( tab4d_1(iis:iie,jjs:jje,1:kdir,jn) )
+ IF( PRESENT(mask1) ) THEN
+ zsum1 = SUM( tab4d_1(ii1s:ii1e,jj1s:jj1e,1:kdir,jn) * mask1(iim1s:iim1e,jjm1s:jjm1e,1:kdir) )
+ ELSE
+ zsum1 = SUM( tab4d_1(ii1s:ii1e,jj1s:jj1e,1:kdir,jn) )
ENDIF
ENDIF
@@ -472,22 +512,22 @@ CONTAINS
!
idg = MAXVAL( (/ nall_ictls(jl), nall_ictle(jl), nall_jctls(jl), nall_jctle(jl) /) ) ! temporary use of idg
idg = INT(LOG10(REAL(idg,wp))) + 1 ! how many digits do we use?
- idg2 = MAXVAL( (/ mig0(nall_ictls(jl)), mig0(nall_ictle(jl)), mjg0(nall_jctls(jl)), mjg0(nall_jctle(jl)) /) )
+ idg2 = MAXVAL( (/ mig(nall_ictls(jl),0), mig(nall_ictle(jl),0), mjg(nall_jctls(jl),0), mjg(nall_jctle(jl),0) /) )
idg2 = INT(LOG10(REAL(idg2,wp))) + 1 ! how many digits do we use?
WRITE(clfmt2, "('(18x, 13a1, a9, i', i1, ', a2, i',i1,', a2, 13a1)')") idg, idg2
WRITE(clfmt3, "('(18x, a1, ', i2,'x, a1)')") 13+9+idg+2+idg2+2+13 - 2
WRITE(clfmt4, "('(', i2,'x, a9, i', i1,', a2, i', i1,', a2, ', i2,'x, a9, i', i1,', a2, i', i1,', a2)')") &
& 18-7, idg, idg2, 13+9+idg+2+idg2+2+13 - (2+idg+2+idg2+2+8), idg, idg2
- WRITE(inum,clfmt2) ('-', ji=1,13), ' jctle = ', nall_jctle(jl), ' (', mjg0(nall_jctle(jl)), ') ', ('-', ji=1,13)
+ WRITE(inum,clfmt2) ('-', ji=1,13), ' jctle = ', nall_jctle(jl), ' (', mjg(nall_jctle(jl),0), ') ', ('-', ji=1,13)
WRITE(inum,clfmt3) '|', '|'
WRITE(inum,clfmt3) '|', '|'
WRITE(inum,clfmt3) '|', '|'
- WRITE(inum,clfmt4) ' ictls = ', nall_ictls(jl), ' (', mig0(nall_ictls(jl)), ') ', &
- & ' ictle = ', nall_ictle(jl), ' (', mig0(nall_ictle(jl)), ') '
+ WRITE(inum,clfmt4) ' ictls = ', nall_ictls(jl), ' (', mig(nall_ictls(jl),0), ') ', &
+ & ' ictle = ', nall_ictle(jl), ' (', mig(nall_ictle(jl),0), ') '
WRITE(inum,clfmt3) '|', '|'
WRITE(inum,clfmt3) '|', '|'
WRITE(inum,clfmt3) '|', '|'
- WRITE(inum,clfmt2) ('-', ji=1,13), ' jctls = ', nall_jctls(jl), ' (', mjg0(nall_jctls(jl)), ') ', ('-', ji=1,13)
+ WRITE(inum,clfmt2) ('-', ji=1,13), ' jctls = ', nall_jctls(jl), ' (', mjg(nall_jctls(jl),0), ') ', ('-', ji=1,13)
WRITE(inum,*)
WRITE(inum,*)
!
diff --git a/src/OCE/ISF/isfcpl.F90 b/src/OCE/ISF/isfcpl.F90
index b035cd5e6095a4206dedf0ccd81f612125a55e3c..4989dc8509c7e5be867c62c8aacfa4bfb2ffb130 100644
--- a/src/OCE/ISF/isfcpl.F90
+++ b/src/OCE/ISF/isfcpl.F90
@@ -736,7 +736,8 @@ CONTAINS
END IF
!
! update isfpts structure
- sisfpts(kpts) = isfcons(mig(ki), mjg(kj), kk, pratio * pdvol, pratio * pdsal, pratio * pdtem, glamt(ki,kj), gphit(ki,kj), ifind )
+ sisfpts(kpts) = isfcons(mig(ki,nn_hls), mjg(kj,nn_hls), kk, pratio * pdvol, pratio * pdsal, pratio * pdtem, &
+ & glamt(ki,kj), gphit(ki,kj), ifind )
!
END SUBROUTINE update_isfpts
!
@@ -761,8 +762,8 @@ CONTAINS
IF ( kfind == 1 ) CALL dom_ngb( plon, plat, iig, ijg,'T', kk)
!
! fill the correction array
- DO jj = mj0(ijg),mj1(ijg)
- DO ji = mi0(iig),mi1(iig)
+ DO jj = mj0(ijg,nn_hls),mj1(ijg,nn_hls)
+ DO ji = mi0(iig,nn_hls),mi1(iig,nn_hls)
! correct the vol_flx and corresponding heat/salt flx in the closest cell
risfcpl_cons_vol(ji,jj,kk) = risfcpl_cons_vol(ji,jj,kk ) + pvolinc
risfcpl_cons_tsc(ji,jj,kk,jp_sal) = risfcpl_cons_tsc(ji,jj,kk,jp_sal) + psalinc
diff --git a/src/OCE/LBC/lbc_lnk_call_generic.h90 b/src/OCE/LBC/lbc_lnk_call_generic.h90
index 0d2e2514b826a44537cf2fd8f0cf45c8a3e36a26..f735ac909d1380aac3eb38883cc77c4c5f815667 100644
--- a/src/OCE/LBC/lbc_lnk_call_generic.h90
+++ b/src/OCE/LBC/lbc_lnk_call_generic.h90
@@ -27,7 +27,7 @@
& , pt21, cdna21, psgn21, pt22, cdna22, psgn22, pt23, cdna23, psgn23, pt24, cdna24, psgn24 &
& , pt25, cdna25, psgn25, pt26, cdna26, psgn26, pt27, cdna27, psgn27, pt28, cdna28, psgn28 &
& , pt29, cdna29, psgn29, pt30, cdna30, psgn30 &
- & , kfillmode, pfillval, khls, lsend, lrecv, ld4only )
+ & , kfillmode, pfillval, lsend, lrecv, ld4only )
!!---------------------------------------------------------------------
CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine
REAL(PRECISION), DIMENSION(DIMS) , TARGET, CONTIGUOUS, INTENT(inout) :: pt1 ! arrays on which the lbc is applied
@@ -50,7 +50,6 @@
& psgn30
INTEGER , OPTIONAL , INTENT(in ) :: kfillmode ! filling method for halo over land (default = constant)
REAL(PRECISION) , OPTIONAL , INTENT(in ) :: pfillval ! background value (used at closed boundaries)
- INTEGER , OPTIONAL , INTENT(in ) :: khls ! halo size, default = nn_hls
LOGICAL, DIMENSION(8), OPTIONAL , INTENT(in ) :: lsend, lrecv ! indicate how communications are to be carried out
LOGICAL , OPTIONAL , INTENT(in ) :: ld4only ! if .T., do only 4-neighbour comm (ignore corners)
!!
@@ -96,15 +95,11 @@
IF( PRESENT(psgn29) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt29, cdna29, psgn29, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
IF( PRESENT(psgn30) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt30, cdna30, psgn30, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
!
-#if ! defined key_mpi2
IF( nn_comm == 1 ) THEN
- CALL lbc_lnk_pt2pt( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only )
+ CALL lbc_lnk_pt2pt( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv, ld4only )
ELSE
- CALL lbc_lnk_neicoll( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only )
+ CALL lbc_lnk_neicoll( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv, ld4only )
ENDIF
-#else
- CALL lbc_lnk_pt2pt( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only )
-#endif
!
END SUBROUTINE lbc_lnk_call_/**/XD/**/_/**/PRECISION
diff --git a/src/OCE/LBC/lbc_lnk_neicoll_generic.h90 b/src/OCE/LBC/lbc_lnk_neicoll_generic.h90
index 3ce416fe1fbf4ed39abd342c0ec78d204abc82d7..d6bd3038066f876fd55231c89843f106bd7ceeac 100644
--- a/src/OCE/LBC/lbc_lnk_neicoll_generic.h90
+++ b/src/OCE/LBC/lbc_lnk_neicoll_generic.h90
@@ -1,5 +1,5 @@
- SUBROUTINE lbc_lnk_neicoll_/**/PRECISION( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only )
+ SUBROUTINE lbc_lnk_neicoll_/**/PRECISION( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, lsend, lrecv, ld4only )
CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine
TYPE(PTR_4d_/**/PRECISION), DIMENSION(:), INTENT(inout) :: ptab ! pointer of arrays on which apply the b.c.
CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: cd_nat ! nature of array grid-points
@@ -7,265 +7,311 @@
INTEGER , INTENT(in ) :: kfld ! number of pt3d arrays
INTEGER , OPTIONAL, INTENT(in ) :: kfillmode ! filling method for halo over land (default = constant)
REAL(PRECISION), OPTIONAL, INTENT(in ) :: pfillval ! background value (used at closed boundaries)
- INTEGER , OPTIONAL, INTENT(in ) :: khls ! halo size, default = nn_hls
LOGICAL, DIMENSION(8),OPTIONAL, INTENT(in ) :: lsend, lrecv ! communication with other 4 proc
LOGICAL, OPTIONAL, INTENT(in ) :: ld4only ! if .T., do only 4-neighbour comm (ignore corners)
!
INTEGER :: ji, jj, jk , jl, jf, jn ! dummy loop indices
- INTEGER :: ipi, ipj, ipk, ipl, ipf ! dimension of the input array
INTEGER :: ip0i, ip1i, im0i, im1i
INTEGER :: ip0j, ip1j, im0j, im1j
INTEGER :: ishti, ishtj, ishti2, ishtj2
- INTEGER :: iszS, iszR
+ INTEGER :: inbS, inbR, iszS, iszR
INTEGER :: ierr
- INTEGER :: ihls, idx
+ INTEGER :: ihls, ihlsmax, idx
INTEGER :: impi_nc
INTEGER :: ifill_nfd
INTEGER, DIMENSION(4) :: iwewe, issnn
- INTEGER, DIMENSION(8) :: isizei, ishtSi, ishtRi, ishtPi
- INTEGER, DIMENSION(8) :: isizej, ishtSj, ishtRj, ishtPj
- INTEGER, DIMENSION(8) :: ifill, iszall
- INTEGER, DIMENSION(8) :: jnf
+ INTEGER, DIMENSION( kfld) :: ipi, ipj, ipk, ipl ! dimension of the input array
+ INTEGER, DIMENSION(8,kfld) :: ifill
+ INTEGER, DIMENSION(8,kfld) :: isizei, ishtSi, ishtRi, ishtPi
+ INTEGER, DIMENSION(8,kfld) :: isizej, ishtSj, ishtRj, ishtPj
INTEGER, DIMENSION(:), ALLOCATABLE :: iScnt, iRcnt ! number of elements to be sent/received
INTEGER, DIMENSION(:), ALLOCATABLE :: iSdpl, iRdpl ! displacement in halos arrays
- LOGICAL, DIMENSION(8) :: llsend, llrecv
- REAL(PRECISION) :: zland
+ LOGICAL, DIMENSION(8,kfld) :: llsend, llrecv
LOGICAL :: ll4only ! default: 8 neighbourgs
+ REAL(PRECISION) :: zland
!!----------------------------------------------------------------------
!
! ----------------------------------------- !
! 1. local variables initialization !
! ----------------------------------------- !
!
- ipi = SIZE(ptab(1)%pt4d,1)
- ipj = SIZE(ptab(1)%pt4d,2)
- ipk = SIZE(ptab(1)%pt4d,3)
- ipl = SIZE(ptab(1)%pt4d,4)
- ipf = kfld
- !
- IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ipk, ipl, ipf, ld_lbc = .TRUE. )
- !
! take care of optional parameters
!
- ihls = nn_hls ! default definition
- IF( PRESENT( khls ) ) ihls = khls
- IF( ihls > n_hlsmax ) THEN
- WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with khls > n_hlsmax : ', khls, '>', n_hlsmax
- CALL ctl_stop( 'STOP', ctmp1 )
- ENDIF
- IF( ipi /= Ni_0+2*ihls ) THEN
- WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with an input array which does not match ihls along i: ', ipi, ihls, Ni_0
- CALL ctl_stop( 'STOP', ctmp1 )
- ENDIF
- IF( ipj /= Nj_0+2*ihls ) THEN
- WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with an input array which does not match ihls along j:', ipj, ihls , Nj_0
- CALL ctl_stop( 'STOP', ctmp1 )
- ENDIF
- !
ll4only = .FALSE. ! default definition
IF( PRESENT(ld4only) ) ll4only = ld4only
!
- impi_nc = mpi_nc_com8(ihls) ! default
- IF( ll4only ) impi_nc = mpi_nc_com4(ihls)
- !
zland = 0._wp ! land filling value: zero by default
IF( PRESENT( pfillval ) ) zland = pfillval ! set land value
!
- ! define llsend and llrecv: logicals which say if mpi-neibourgs for send or receive exist or not.
- IF ( PRESENT(lsend) .AND. PRESENT(lrecv) ) THEN ! localy defined neighbourgs
- CALL ctl_stop( 'STOP', 'mpp_nc_generic+lsend and lrecv not yet implemented')
- ELSE IF( PRESENT(lsend) .OR. PRESENT(lrecv) ) THEN
- WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with only one of the two arguments lsend or lrecv'
- CALL ctl_stop( 'STOP', ctmp1 )
- ELSE ! default neighbours
- llsend(:) = mpiSnei(ihls,:) >= 0
- IF( ll4only ) llsend(5:8) = .FALSE. ! exclude corners
- llrecv(:) = mpiRnei(ihls,:) >= 0
- IF( ll4only ) llrecv(5:8) = .FALSE. ! exclude corners
- ENDIF
+ ifill_nfd = jpfillcst ! default definition
+ IF( PRESENT(kfillmode) ) ifill_nfd = kfillmode
!
- ! define ifill: which method should be used to fill each parts (sides+corners) of the halos
- ! default definition
- DO jn = 1, 8
- IF( llrecv(jn) ) THEN ; ifill(jn) = jpfillmpi ! with an mpi communication
- ELSEIF( l_SelfPerio(jn) ) THEN ; ifill(jn) = jpfillperio ! with self-periodicity
- ELSEIF( PRESENT(kfillmode) ) THEN ; ifill(jn) = kfillmode ! localy defined
- ELSE ; ifill(jn) = jpfillcst ! constant value (zland)
- ENDIF
- END DO
- ! take care of "indirect self-periodicity" for the corners
- DO jn = 5, 8
- IF(.NOT.l_SelfPerio(jn) .AND. l_SelfPerio(jpwe)) ifill(jn) = jpfillnothing ! no bi-perio but ew-perio: do corners later
- IF(.NOT.l_SelfPerio(jn) .AND. l_SelfPerio(jpso)) ifill(jn) = jpfillnothing ! no bi-perio but ns-perio: do corners later
- END DO
- ! north fold treatment
- IF( l_IdoNFold ) THEN
- ifill_nfd = ifill(jpno) ! if we are here, this means llrecv(jpno) = .false. and l_SelfPerio(jpno) = .false.
- ifill( (/jpno/) ) = jpfillnothing ! we do north fold -> do nothing for northern halo
- ENDIF
-
- ! We first define the localization and size of the parts of the array that will be sent (s), received (r)
- ! or used for periodocity (p). The localization is defined as "the bottom left corner - 1" in i and j directions.
- ! This is a shift that will be applied later in the do loops to pick-up the appropriate part of the array
+ ihlsmax = 0
!
- ! all definitions bellow do not refer to N[ij][se]0 so we can use it with any local value of ihls
- ! ! ________________________
- ip0i = 0 ! im0j = inner |__|________________|__|
- ip1i = ihls ! im1j = inner - halo | |__|__________|__| |
- im1i = ipi-2*ihls ! | | | | | |
- im0i = ipi - ihls ! | | | | | |
- ip0j = 0 ! | | | | | |
- ip1j = ihls ! | |__|__________|__| |
- im1j = ipj-2*ihls ! ip1j = halo |__|__|__________|__|__|
- im0j = ipj - ihls ! ip0j = 0 |__|________________|__|
- ! ! ip0i ip1i im1i im0i
+ DO jf = 1, kfld
+ !
+ ipi(jf) = SIZE(ptab(jf)%pt4d,1)
+ ipj(jf) = SIZE(ptab(jf)%pt4d,2)
+ ipk(jf) = SIZE(ptab(jf)%pt4d,3)
+ ipl(jf) = SIZE(ptab(jf)%pt4d,4)
+ ihls = ( ipi(jf) - Ni_0 ) / 2
+ ihlsmax = MAX(ihls, ihlsmax)
+ !
+ IF( numcom == -1 ) THEN ! test input array shape. Use numcom to do these tests only at the beginning of the run
+ IF( MOD( ipi(jf) - Ni_0, 2 ) /= 0 ) THEN
+ WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk but the ', jf,'th input array has wong i-size: ', ipi(jf), Ni_0
+ CALL ctl_stop( 'STOP', ctmp1 )
+ ENDIF
+ IF( MOD( ipj(jf) - Nj_0, 2 ) /= 0 ) THEN
+ WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk but the ', jf,'th input array has wong j-size: ', ipj(jf), Nj_0
+ CALL ctl_stop( 'STOP', ctmp1 )
+ ENDIF
+ IF( ( ipj(jf) - Nj_0 ) / 2 /= ihls ) THEN
+ WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk but the ', jf,'th input array as wong i and j-size: ', &
+ & ipi(jf), Ni_0, ipj(jf), Nj_0
+ CALL ctl_stop( 'STOP', ctmp1 )
+ ENDIF
+ IF( ihls > n_hlsmax ) THEN
+ WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk but for the ', jf,'th input array, ', ihls, ' > n_hlsmax = ', &
+ & n_hlsmax
+ CALL ctl_stop( 'STOP', ctmp1 )
+ ENDIF
+ ENDIF
+ !
+ ! define llsend and llrecv: logicals which say if mpi-neibourgs for send or receive exist or not.
+ IF ( PRESENT(lsend) .AND. PRESENT(lrecv) ) THEN ! localy defined neighbourgs
+ CALL ctl_stop( 'STOP', 'mpp_nc_generic+lsend and lrecv not yet implemented')
+ ELSE IF( PRESENT(lsend) .OR. PRESENT(lrecv) ) THEN
+ WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with only one of the two arguments lsend or lrecv'
+ CALL ctl_stop( 'STOP', ctmp1 )
+ ELSE ! default neighbours
+ llsend(:,jf) = mpiSnei(ihls,:) >= 0
+ IF( ll4only ) llsend(5:8,jf) = .FALSE. ! exclude corners
+ llrecv(:,jf) = mpiRnei(ihls,:) >= 0
+ IF( ll4only ) llrecv(5:8,jf) = .FALSE. ! exclude corners
+ ENDIF
+ !
+ ! define ifill: which method should be used to fill each parts (sides+corners) of the halos
+ ! default definition
+ DO jn = 1, 8
+ IF( llrecv(jn,jf) ) THEN ; ifill(jn,jf) = jpfillmpi ! with an mpi communication
+ ELSEIF( l_SelfPerio(jn) ) THEN ; ifill(jn,jf) = jpfillperio ! with self-periodicity
+ ELSEIF( PRESENT(kfillmode) ) THEN ; ifill(jn,jf) = kfillmode ! localy defined
+ ELSEIF( ihls == 0 ) THEN ; ifill(jn,jf) = jpfillnothing ! do nothing
+ ELSE ; ifill(jn,jf) = jpfillcst ! constant value (zland)
+ ENDIF
+ END DO
+ ! take care of "indirect self-periodicity" for the corners
+ DO jn = 5, 8
+ IF(.NOT.l_SelfPerio(jn) .AND. l_SelfPerio(jpwe)) ifill(jn,jf) = jpfillnothing ! no bi-perio but ew-perio: do corners later
+ IF(.NOT.l_SelfPerio(jn) .AND. l_SelfPerio(jpso)) ifill(jn,jf) = jpfillnothing ! no bi-perio but ns-perio: do corners later
+ END DO
+ ! north fold treatment
+ IF( l_IdoNFold ) ifill(jpno,jf) = jpfillnothing ! we do north fold -> do nothing for northern halo
+
+ ! We first define the localization and size of the parts of the array that will be sent (s), received (r)
+ ! or used for periodocity (p). The localization is defined as "the bottom left corner - 1" in i and j directions.
+ ! This is a shift that will be applied later in the do loops to pick-up the appropriate part of the array
+ !
+ ! all definitions bellow do not refer to N[ij][se]0 so we can use it with any local value of ihls
+ ! ! ________________________
+ ip0i = 0 ! im0j = inner |__|________________|__|
+ ip1i = ihls ! im1j = inner - halo | |__|__________|__| |
+ im1i = ipi(jf)-2*ihls ! | | | | | |
+ im0i = ipi(jf) - ihls ! | | | | | |
+ ip0j = 0 ! | | | | | |
+ ip1j = ihls ! | |__|__________|__| |
+ im1j = ipj(jf)-2*ihls ! ip1j = halo |__|__|__________|__|__|
+ im0j = ipj(jf) - ihls ! ip0j = 0 |__|________________|__|
+ ! ! ip0i ip1i im1i im0i
+ !
+ iwewe(:) = (/ jpwe,jpea,jpwe,jpea /) ; issnn(:) = (/ jpso,jpso,jpno,jpno /)
+ ! sides: west east south north ; corners: so-we, so-ea, no-we, no-ea
+ isizei(1:4,jf) = (/ ihls, ihls, Ni_0, Ni_0 /) ; isizei(5:8,jf) = ihls ! i- count
+ isizej(1:4,jf) = (/ Nj_0, Nj_0, ihls, ihls /) ; isizej(5:8,jf) = ihls ! j- count
+ ishtSi(1:4,jf) = (/ ip1i, im1i, ip1i, ip1i /) ; ishtSi(5:8,jf) = ishtSi( iwewe,jf ) ! i- shift send data
+ ishtSj(1:4,jf) = (/ ip1j, ip1j, ip1j, im1j /) ; ishtSj(5:8,jf) = ishtSj( issnn,jf ) ! j- shift send data
+ ishtRi(1:4,jf) = (/ ip0i, im0i, ip1i, ip1i /) ; ishtRi(5:8,jf) = ishtRi( iwewe,jf ) ! i- shift recv data
+ ishtRj(1:4,jf) = (/ ip1j, ip1j, ip0j, im0j /) ; ishtRj(5:8,jf) = ishtRj( issnn,jf ) ! j- shift recv data
+ ishtPi(1:4,jf) = (/ im1i, ip1i, ip1i, ip1i /) ; ishtPi(5:8,jf) = ishtPi( iwewe,jf ) ! i- shift perio data
+ ishtPj(1:4,jf) = (/ ip1j, ip1j, im1j, ip1j /) ; ishtPj(5:8,jf) = ishtPj( issnn,jf ) ! j- shift perio data
+ !
+ END DO ! jf
!
- iwewe(:) = (/ jpwe,jpea,jpwe,jpea /) ; issnn(:) = (/ jpso,jpso,jpno,jpno /)
- ! sides: west east south north ; corners: so-we, so-ea, no-we, no-ea
- isizei(1:4) = (/ ihls, ihls, Ni_0, Ni_0 /) ; isizei(5:8) = ihls ! i- count
- isizej(1:4) = (/ Nj_0, Nj_0, ihls, ihls /) ; isizej(5:8) = ihls ! j- count
- ishtSi(1:4) = (/ ip1i, im1i, ip1i, ip1i /) ; ishtSi(5:8) = ishtSi( iwewe ) ! i- shift send data
- ishtSj(1:4) = (/ ip1j, ip1j, ip1j, im1j /) ; ishtSj(5:8) = ishtSj( issnn ) ! j- shift send data
- ishtRi(1:4) = (/ ip0i, im0i, ip1i, ip1i /) ; ishtRi(5:8) = ishtRi( iwewe ) ! i- shift received data location
- ishtRj(1:4) = (/ ip1j, ip1j, ip0j, im0j /) ; ishtRj(5:8) = ishtRj( issnn ) ! j- shift received data location
- ishtPi(1:4) = (/ im1i, ip1i, ip1i, ip1i /) ; ishtPi(5:8) = ishtPi( iwewe ) ! i- shift data used for periodicity
- ishtPj(1:4) = (/ ip1j, ip1j, im1j, ip1j /) ; ishtPj(5:8) = ishtPj( issnn ) ! j- shift data used for periodicity
+ IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, SUM(ipk(:))/kfld, SUM(ipl(:))/kfld, kfld, ld_lbc = .TRUE. )
!
! -------------------------------- !
! 2. Prepare MPI exchanges !
! -------------------------------- !
!
! Allocate local temporary arrays to be sent/received.
- iszS = COUNT( llsend )
- iszR = COUNT( llrecv )
- ALLOCATE( iScnt(iszS), iRcnt(iszR), iSdpl(iszS), iRdpl(iszR) ) ! ok if iszS = 0 or iszR = 0
- iszall(:) = isizei(:) * isizej(:) * ipk * ipl * ipf
- iScnt(:) = PACK( iszall, mask = llsend ) ! ok if mask = .false.
- iRcnt(:) = PACK( iszall, mask = llrecv )
- IF( iszS > 0 ) iSdpl(1) = 0
- DO jn = 2,iszS
+ inbS = COUNT( ANY(llsend,dim=2) ) ! number of snd neighbourgs
+ inbR = COUNT( ANY(llrecv,dim=2) ) ! number of rcv neighbourgs
+ ALLOCATE( iScnt(inbS), iRcnt(inbR), iSdpl(inbS), iRdpl(inbR) ) ! ok if iszS = 0 or iszR = 0
+
+ iScnt(:) = 0 ; idx = 0
+ DO jn = 1, 8
+ IF( COUNT( llsend(jn,:) ) > 0 ) THEN ! we send something to neighbourg jn
+ idx = idx + 1
+ DO jf = 1, kfld
+ IF( llsend(jn,jf) ) iScnt(idx) = iScnt(idx) + isizei(jn,jf) * isizej(jn,jf) * ipk(jf) * ipl(jf)
+ END DO
+ ENDIF
+ END DO
+ IF( inbS > 0 ) iSdpl(1) = 0
+ DO jn = 2,inbS
iSdpl(jn) = iSdpl(jn-1) + iScnt(jn-1) ! with _alltoallv: in units of sendtype
END DO
- IF( iszR > 0 ) iRdpl(1) = 0
- DO jn = 2,iszR
+
+ iRcnt(:) = 0 ; idx = 0
+ DO jn = 1, 8
+ IF( COUNT( llrecv(jn,:) ) > 0 ) THEN ! we get something from neighbourg jn
+ idx = idx + 1
+ DO jf = 1, kfld
+ IF( llrecv(jn,jf) ) iRcnt(idx) = iRcnt(idx) + isizei(jn,jf) * isizej(jn,jf) * ipk(jf) * ipl(jf)
+ END DO
+ ENDIF
+ END DO
+ IF( inbR > 0 ) iRdpl(1) = 0
+ DO jn = 2,inbR
iRdpl(jn) = iRdpl(jn-1) + iRcnt(jn-1) ! with _alltoallv: in units of sendtype
END DO
-
+ !
! Allocate buffer arrays to be sent/received if needed
- iszS = SUM(iszall, mask = llsend) ! send buffer size
+ iszS = SUM(iScnt) ! send buffer size
IF( ALLOCATED(BUFFSND) ) THEN
+ CALL mpi_waitall(8, nreq_p2p, MPI_STATUSES_IGNORE, ierr) ! needed only if PREVIOUS call was using nn_comm = 1 (for tests)
IF( SIZE(BUFFSND) < iszS ) DEALLOCATE(BUFFSND) ! send buffer is too small
ENDIF
IF( .NOT. ALLOCATED(BUFFSND) ) ALLOCATE( BUFFSND(iszS) )
- iszR = SUM(iszall, mask = llrecv) ! recv buffer size
+ iszR = SUM(iRcnt) ! recv buffer size
IF( ALLOCATED(BUFFRCV) ) THEN
IF( SIZE(BUFFRCV) < iszR ) DEALLOCATE(BUFFRCV) ! recv buffer is too small
ENDIF
IF( .NOT. ALLOCATED(BUFFRCV) ) ALLOCATE( BUFFRCV(iszR) )
-
+ !
! fill sending buffer with ptab(jf)%pt4d
- idx = 1
+ idx = 0
DO jn = 1, 8
- IF( llsend(jn) ) THEN
- ishti = ishtSi(jn)
- ishtj = ishtSj(jn)
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn) ; DO ji = 1,isizei(jn)
- BUFFSND(idx) = ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl)
- idx = idx + 1
- END DO ; END DO ; END DO ; END DO ; END DO
- ENDIF
+ DO jf = 1, kfld
+ IF( llsend(jn,jf) ) THEN
+ ishti = ishtSi(jn,jf)
+ ishtj = ishtSj(jn,jf)
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf) ; DO jj = 1,isizej(jn,jf) ; DO ji = 1,isizei(jn,jf)
+ idx = idx + 1
+ BUFFSND(idx) = ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl)
+ END DO ; END DO ; END DO ; END DO
+ ENDIF
+ END DO
END DO
!
! ------------------------------------------------ !
! 3. Do all MPI exchanges in 1 unique call !
! ------------------------------------------------ !
!
- IF( ln_timing ) CALL tic_tac(.TRUE.)
- CALL mpi_neighbor_alltoallv (BUFFSND, iScnt, iSdpl, MPI_TYPE, BUFFRCV, iRcnt, iRdpl, MPI_TYPE, impi_nc, ierr)
- IF( ln_timing ) CALL tic_tac(.FALSE.)
+ IF( ihlsmax > 0 ) THEN
+ impi_nc = mpi_nc_com8( ihlsmax )
+ IF( ll4only ) impi_nc = mpi_nc_com4( ihlsmax )
+#if ! defined key_mpi2
+ IF( ln_timing ) CALL tic_tac( .TRUE.)
+ CALL mpi_Ineighbor_alltoallv(BUFFSND, iScnt, iSdpl, MPI_TYPE, BUFFRCV, iRcnt, iRdpl, MPI_TYPE, impi_nc, nreq_nei, ierr)
+ IF( ln_timing ) CALL tic_tac(.FALSE.)
+#endif
+ ENDIF
+ nreq_p2p = MPI_REQUEST_NULL ! needed only if we switch between nn_comm = 1 and 2 (for tests)
!
- ! ------------------------- !
- ! 4. Fill all halos !
- ! ------------------------- !
+ ! --------------------------------- !
+ ! 4. Fill all Non-MPI halos !
+ ! --------------------------------- !
!
- idx = 1
- ! MPI3 bug fix when domain decomposition has 2 columns/rows
- IF (jpni .eq. 2) THEN
- IF (jpnj .eq. 2) THEN
- jnf(1:8) = (/ 2, 1, 4, 3, 8, 7, 6, 5 /)
- ELSE
- jnf(1:8) = (/ 2, 1, 3, 4, 6, 5, 8, 7 /)
- ENDIF
- ELSE
- IF (jpnj .eq. 2) THEN
- jnf(1:8) = (/ 1, 2, 4, 3, 7, 8, 5, 6 /)
- ELSE
- jnf(1:8) = (/ 1, 2, 3, 4, 5, 6, 7, 8 /)
- ENDIF
- ENDIF
-
+ ! do it first to give (potentially) more time for the communications
DO jn = 1, 8
- ishti = ishtRi(jnf(jn))
- ishtj = ishtRj(jnf(jn))
- SELECT CASE ( ifill(jnf(jn)) )
- CASE ( jpfillnothing ) ! no filling
- CASE ( jpfillmpi ) ! fill with data received by MPI
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jnf(jn)) ; DO ji = 1,isizei(jnf(jn))
- ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = BUFFRCV(idx)
- idx = idx + 1
- END DO ; END DO ; END DO ; END DO ; END DO
- CASE ( jpfillperio ) ! use periodicity
- ishti2 = ishtPi(jnf(jn))
- ishtj2 = ishtPj(jnf(jn))
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jnf(jn)) ; DO ji = 1,isizei(jnf(jn))
- ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl)
- END DO ; END DO ; END DO ; END DO ; END DO
- CASE ( jpfillcopy ) ! filling with inner domain values
- ishti2 = ishtSi(jnf(jn))
- ishtj2 = ishtSj(jnf(jn))
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jnf(jn)) ; DO ji = 1,isizei(jnf(jn))
- ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl)
- END DO ; END DO ; END DO ; END DO ; END DO
- CASE ( jpfillcst ) ! filling with constant value
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jnf(jn)) ; DO ji = 1,isizei(jnf(jn))
- ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = zland
- END DO ; END DO ; END DO ; END DO ; END DO
- END SELECT
+ DO jf = 1, kfld
+ ishti = ishtRi(jn,jf)
+ ishtj = ishtRj(jn,jf)
+ SELECT CASE ( ifill(jn,jf) )
+ CASE ( jpfillnothing ) ! no filling
+ CASE ( jpfillmpi ) ! no it later
+ CASE ( jpfillperio ) ! use periodicity
+ ishti2 = ishtPi(jn,jf)
+ ishtj2 = ishtPj(jn,jf)
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf) ; DO jj = 1,isizej(jn,jf) ; DO ji = 1,isizei(jn,jf)
+ ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl)
+ END DO ; END DO ; END DO ; END DO
+ CASE ( jpfillcopy ) ! filling with inner domain values
+ ishti2 = ishtSi(jn,jf)
+ ishtj2 = ishtSj(jn,jf)
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf) ; DO jj = 1,isizej(jn,jf) ; DO ji = 1,isizei(jn,jf)
+ ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl)
+ END DO ; END DO ; END DO ; END DO
+ CASE ( jpfillcst ) ! filling with constant value
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf) ; DO jj = 1,isizej(jn,jf) ; DO ji = 1,isizei(jn,jf)
+ ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = zland
+ END DO ; END DO ; END DO ; END DO
+ END SELECT
+ END DO
+ END DO
+ !
+ ! ----------------------------- !
+ ! 5. Fill all MPI halos !
+ ! ----------------------------- !
+ !
+ CALL mpi_wait( nreq_nei, MPI_STATUS_IGNORE, ierr )
+ !
+ idx = 0
+ DO jn = 1, 8
+ DO jf = 1, kfld
+ IF( ifill(jn,jf) == jpfillmpi ) THEN ! fill with data received by MPI
+ ishti = ishtRi(jn,jf)
+ ishtj = ishtRj(jn,jf)
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf) ; DO jj = 1,isizej(jn,jf) ; DO ji = 1,isizei(jn,jf)
+ idx = idx + 1
+ ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = BUFFRCV(idx)
+ END DO; END DO ; END DO ; END DO
+ ENDIF
+ END DO
END DO
DEALLOCATE( iScnt, iRcnt, iSdpl, iRdpl )
IF( iszS > jpi*jpj ) DEALLOCATE(BUFFSND) ! blocking Send -> can directly deallocate
IF( iszR > jpi*jpj ) DEALLOCATE(BUFFRCV) ! blocking Recv -> can directly deallocate
-
- ! potential "indirect self-periodicity" for the corners
+ !
+ ! ---------------------------------------------------------------- !
+ ! 6. Potential "indirect self-periodicity" for the corners !
+ ! ---------------------------------------------------------------- !
+ !
DO jn = 5, 8
IF( .NOT. l_SelfPerio(jn) .AND. l_SelfPerio(jpwe) ) THEN ! no bi-perio but ew-perio: corners indirect definition
- ishti = ishtRi(jn)
- ishtj = ishtRj(jn)
- ishti2 = ishtPi(jn) ! use i- shift periodicity
- ishtj2 = ishtRj(jn) ! use j- shift recv location: use ew-perio -> ok as filling of the south and north halos now done
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn) ; DO ji = 1,isizei(jn)
- ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl)
- END DO ; END DO ; END DO ; END DO ; END DO
+ DO jf = 1, kfld
+ ishti = ishtRi(jn,jf)
+ ishtj = ishtRj(jn,jf)
+ ishti2 = ishtPi(jn,jf) ! use i- shift periodicity
+ ishtj2 = ishtRj(jn,jf) ! use j- shift recv location: use ew-perio -> ok as filling of the so and no halos now done
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf) ; DO jj = 1,isizej(jn,jf) ; DO ji = 1,isizei(jn,jf)
+ ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl)
+ END DO ; END DO ; END DO ; END DO
+ END DO
ENDIF
IF( .NOT. l_SelfPerio(jn) .AND. l_SelfPerio(jpso) ) THEN ! no bi-perio but ns-perio: corners indirect definition
- ishti = ishtRi(jn)
- ishtj = ishtRj(jn)
- ishti2 = ishtRi(jn) ! use i- shift recv location: use ns-perio -> ok as filling of the west and east halos now done
- ishtj2 = ishtPj(jn) ! use j- shift periodicity
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn) ; DO ji = 1,isizei(jn)
- ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl)
- END DO ; END DO ; END DO ; END DO ; END DO
+ DO jf = 1, kfld
+ ishti = ishtRi(jn,jf)
+ ishtj = ishtRj(jn,jf)
+ ishti2 = ishtRi(jn,jf) ! use i- shift recv location: use ns-perio -> ok as filling of the we and ea halos now done
+ ishtj2 = ishtPj(jn,jf) ! use j- shift periodicity
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf) ; DO jj = 1,isizej(jn,jf) ; DO ji = 1,isizei(jn,jf)
+ ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl)
+ END DO ; END DO ; END DO ; END DO
+ END DO
ENDIF
END DO
!
! ------------------------------- !
- ! 5. north fold treatment !
+ ! 7. north fold treatment !
! ------------------------------- !
!
IF( l_IdoNFold ) THEN
- IF( jpni == 1 ) THEN ; CALL lbc_nfd( ptab, cd_nat, psgn , ihls, ipf ) ! self NFold
- ELSE ; CALL mpp_nfd( ptab, cd_nat, psgn, ifill_nfd, zland, ihls, ipf ) ! mpi NFold
+ IF( jpni == 1 ) THEN ; CALL lbc_nfd( ptab, cd_nat, psgn , kfld ) ! self NFold
+ ELSE ; CALL mpp_nfd( ptab, cd_nat, psgn, ifill_nfd, zland, kfld ) ! mpi NFold
ENDIF
ENDIF
!
diff --git a/src/OCE/LBC/lbc_lnk_pt2pt_generic.h90 b/src/OCE/LBC/lbc_lnk_pt2pt_generic.h90
index 395a3e93c037cf53ac82eb911726c24926168d3b..777c9913d19264ec77a32311bfdd74477f00714b 100644
--- a/src/OCE/LBC/lbc_lnk_pt2pt_generic.h90
+++ b/src/OCE/LBC/lbc_lnk_pt2pt_generic.h90
@@ -1,6 +1,6 @@
-#if ! defined BLOCK_ISEND && ! defined BLOCK_FILL
- SUBROUTINE lbc_lnk_pt2pt_/**/PRECISION( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only )
+#if ! defined BLOCK_ISEND && ! defined BLOCK_FILL_nonMPI && ! defined BLOCK_FILL_MPI_RECV
+ SUBROUTINE lbc_lnk_pt2pt_/**/PRECISION( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, lsend, lrecv, ld4only )
CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine
TYPE(PTR_4d_/**/PRECISION), DIMENSION(:), INTENT(inout) :: ptab ! pointer of arrays on which apply the b.c.
CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: cd_nat ! nature of array grid-points
@@ -8,161 +8,185 @@
INTEGER , INTENT(in ) :: kfld ! number of pt3d arrays
INTEGER , OPTIONAL, INTENT(in ) :: kfillmode ! filling method for halo over land (default = constant)
REAL(PRECISION), OPTIONAL, INTENT(in ) :: pfillval ! background value (used at closed boundaries)
- INTEGER , OPTIONAL, INTENT(in ) :: khls ! halo size, default = nn_hls
LOGICAL, DIMENSION(8),OPTIONAL, INTENT(in ) :: lsend, lrecv ! communication with other 4 proc
LOGICAL, OPTIONAL, INTENT(in ) :: ld4only ! if .T., do only 4-neighbour comm (ignore corners)
!
INTEGER :: ji, jj, jk, jl, jf, jn ! dummy loop indices
- INTEGER :: ipi, ipj, ipk, ipl, ipf ! dimension of the input array
INTEGER :: ip0i, ip1i, im0i, im1i
INTEGER :: ip0j, ip1j, im0j, im1j
INTEGER :: ishti, ishtj, ishti2, ishtj2
INTEGER :: ifill_nfd, icomm, ierr
- INTEGER :: ihls, idxs, idxr, iszS, iszR
+ INTEGER :: ihls, iisz
+ INTEGER :: idxs, idxr, iszS, iszR
INTEGER, DIMENSION(4) :: iwewe, issnn
- INTEGER, DIMENSION(8) :: isizei, ishtSi, ishtRi, ishtPi
- INTEGER, DIMENSION(8) :: isizej, ishtSj, ishtRj, ishtPj
- INTEGER, DIMENSION(8) :: ifill, iszall, ishtS, ishtR
- INTEGER, DIMENSION(8) :: ireq ! mpi_request id
+ INTEGER, DIMENSION(8) :: ibufszS, ibufszR, ishtS, ishtR
INTEGER, DIMENSION(8) :: iStag, iRtag ! Send and Recv mpi_tag id
- REAL(PRECISION) :: zland
- LOGICAL, DIMENSION(8) :: llsend, llrecv
+ INTEGER, DIMENSION( kfld) :: ipi, ipj, ipk, ipl ! dimension of the input array
+ INTEGER, DIMENSION(8,kfld) :: ifill
+ INTEGER, DIMENSION(8,kfld) :: isizei, ishtSi, ishtRi, ishtPi
+ INTEGER, DIMENSION(8,kfld) :: isizej, ishtSj, ishtRj, ishtPj
+ LOGICAL, DIMENSION(8,kfld) :: llsend, llrecv
LOGICAL :: ll4only ! default: 8 neighbourgs
+ REAL(PRECISION) :: zland
!!----------------------------------------------------------------------
!
! ----------------------------------------- !
! 1. local variables initialization !
! ----------------------------------------- !
!
- ipi = SIZE(ptab(1)%pt4d,1)
- ipj = SIZE(ptab(1)%pt4d,2)
- ipk = SIZE(ptab(1)%pt4d,3)
- ipl = SIZE(ptab(1)%pt4d,4)
- ipf = kfld
- !
- IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ipk, ipl, ipf, ld_lbc = .TRUE. )
- !
idxs = 1 ! initalize index for send buffer
idxr = 1 ! initalize index for recv buffer
icomm = mpi_comm_oce ! shorter name
!
! take care of optional parameters
!
- ihls = nn_hls ! default definition
- IF( PRESENT( khls ) ) ihls = khls
- IF( ihls > n_hlsmax ) THEN
- WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with khls > n_hlsmax : ', khls, '>', n_hlsmax
- CALL ctl_stop( 'STOP', ctmp1 )
- ENDIF
- IF( ipi /= Ni_0+2*ihls ) THEN
- WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with an input array which does not match ihls along i: ', ipi, ihls, Ni_0
- CALL ctl_stop( 'STOP', ctmp1 )
- ENDIF
- IF( ipj /= Nj_0+2*ihls ) THEN
- WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with an input array which does not match ihls along j:', ipj, ihls , Nj_0
- CALL ctl_stop( 'STOP', ctmp1 )
- ENDIF
- !
- ll4only = .FALSE. ! default definition
- IF( PRESENT(ld4only) ) ll4only = ld4only
+ ll4only = .FALSE. ! default definition
+ IF( PRESENT( ld4only ) ) ll4only = ld4only
!
zland = 0._wp ! land filling value: zero by default
- IF( PRESENT( pfillval ) ) zland = pfillval ! set land value
+ IF( PRESENT( pfillval) ) zland = pfillval ! set land value
!
- ! define llsend and llrecv: logicals which say if mpi-neibourgs for send or receive exist or not.
- IF ( PRESENT(lsend) .AND. PRESENT(lrecv) ) THEN ! localy defined neighbourgs
- llsend(:) = lsend(:) ; llrecv(:) = lrecv(:)
- ELSE IF( PRESENT(lsend) .OR. PRESENT(lrecv) ) THEN
- WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with only one of the two arguments lsend or lrecv'
- CALL ctl_stop( 'STOP', ctmp1 )
- ELSE ! default neighbours
- llsend(:) = mpiSnei(ihls,:) >= 0
- IF( ll4only ) llsend(5:8) = .FALSE. ! exclude corners
- llrecv(:) = mpiRnei(ihls,:) >= 0
- IF( ll4only ) llrecv(5:8) = .FALSE. ! exclude corners
- ENDIF
+ ifill_nfd = jpfillcst ! default definition
+ IF( PRESENT(kfillmode) ) ifill_nfd = kfillmode
!
- ! define ifill: which method should be used to fill each parts (sides+corners) of the halos
- ! default definition
- DO jn = 1, 4
- IF( llrecv(jn) ) THEN ; ifill(jn) = jpfillmpi ! with an mpi communication
- ELSEIF( l_SelfPerio(jn) ) THEN ; ifill(jn) = jpfillperio ! with self-periodicity
- ELSEIF( PRESENT(kfillmode) ) THEN ; ifill(jn) = kfillmode ! localy defined
- ELSE ; ifill(jn) = jpfillcst ! constant value (zland)
+ DO jf = 1, kfld
+ !
+ ipi(jf) = SIZE(ptab(jf)%pt4d,1)
+ ipj(jf) = SIZE(ptab(jf)%pt4d,2)
+ ipk(jf) = SIZE(ptab(jf)%pt4d,3)
+ ipl(jf) = SIZE(ptab(jf)%pt4d,4)
+ ihls = ( ipi(jf) - Ni_0 ) / 2
+ !
+ IF( numcom == -1 ) THEN ! test input array shape. Use numcom to do these tests only at the beginning of the run
+ IF( MOD( ipi(jf) - Ni_0, 2 ) /= 0 ) THEN
+ WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk but the ', jf,'th input array has wong i-size: ', ipi(jf), Ni_0
+ CALL ctl_stop( 'STOP', ctmp1 )
+ ENDIF
+ IF( MOD( ipj(jf) - Nj_0, 2 ) /= 0 ) THEN
+ WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk but the ', jf,'th input array has wong j-size: ', ipj(jf), Nj_0
+ CALL ctl_stop( 'STOP', ctmp1 )
+ ENDIF
+ IF( ( ipj(jf) - Nj_0 ) / 2 /= ihls ) THEN
+ WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk but the ', jf,'th input array as wong i and j-size: ', &
+ & ipi(jf), Ni_0, ipj(jf), Nj_0
+ CALL ctl_stop( 'STOP', ctmp1 )
+ ENDIF
+ IF( ihls > n_hlsmax ) THEN
+ WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk but for the ', jf,'th input array, ', ihls, ' > n_hlsmax = ', &
+ & n_hlsmax
+ CALL ctl_stop( 'STOP', ctmp1 )
+ ENDIF
ENDIF
- END DO
- DO jn = 5, 8
- IF( llrecv(jn) ) THEN ; ifill(jn) = jpfillmpi ! with an mpi communication
- ELSE ; ifill(jn) = jpfillnothing! do nothing
+ !
+ ! define llsend and llrecv: logicals which say if mpi-neibourgs for send or receive exist or not.
+ IF ( PRESENT(lsend) .AND. PRESENT(lrecv) ) THEN ! localy defined neighbourgs
+ llsend(:,jf) = lsend(:) ; llrecv(:,jf) = lrecv(:)
+ ELSE IF( PRESENT(lsend) .OR. PRESENT(lrecv) ) THEN
+ WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with only one of the two arguments lsend or lrecv'
+ CALL ctl_stop( 'STOP', ctmp1 )
+ ELSE ! default neighbours
+ llsend(:,jf) = mpiSnei(ihls,:) >= 0
+ IF( ll4only ) llsend(5:8,jf) = .FALSE. ! exclude corners
+ llrecv(:,jf) = mpiRnei(ihls,:) >= 0
+ IF( ll4only ) llrecv(5:8,jf) = .FALSE. ! exclude corners
ENDIF
- END DO
!
- ! north fold treatment
- IF( l_IdoNFold ) THEN
- ifill_nfd = ifill(jpno) ! if we are here, this means llrecv(jpno) = .false. and l_SelfPerio(jpno) = .false.
- ifill( (/jpno/) ) = jpfillnothing ! we do north fold -> do nothing for northern halo
- ENDIF
-
- ! We first define the localization and size of the parts of the array that will be sent (s), received (r)
- ! or used for periodocity (p). The localization is defined as "the bottom left corner - 1" in i and j directions.
- ! This is a shift that will be applied later in the do loops to pick-up the appropriate part of the array
- !
- ! all definitions bellow do not refer to N[ij][se]0 so we can use it with any local value of ihls
- ! ! ________________________
- ip0i = 0 ! im0j = inner |__|__|__________|__|__|
- ip1i = ihls ! im1j = inner - halo |__|__|__________|__|__|
- im1i = ipi-2*ihls ! | | | | | |
- im0i = ipi - ihls ! | | | | | |
- ip0j = 0 ! | | | | | |
- ip1j = ihls ! |__|__|__________|__|__|
- im1j = ipj-2*ihls ! ip1j = halo |__|__|__________|__|__|
- im0j = ipj - ihls ! ip0j = 0 |__|__|__________|__|__|
- ! ! ip0i ip1i im1i im0i
+ ! define ifill: which method should be used to fill each parts (sides+corners) of the halos
+ ! default definition
+ DO jn = 1, 4 ! 4 sides
+ IF( llrecv(jn,jf) ) THEN ; ifill(jn,jf) = jpfillmpi ! with an mpi communication
+ ELSEIF( l_SelfPerio(jn) ) THEN ; ifill(jn,jf) = jpfillperio ! with self-periodicity
+ ELSEIF( PRESENT(kfillmode) ) THEN ; ifill(jn,jf) = kfillmode ! localy defined
+ ELSEIF( ihls == 0 ) THEN ; ifill(jn,jf) = jpfillnothing ! do nothing
+ ELSE ; ifill(jn,jf) = jpfillcst ! constant value (zland)
+ ENDIF
+ END DO
+ DO jn = 5, 8 ! 4 corners
+ IF( llrecv(jn,jf) ) THEN ; ifill(jn,jf) = jpfillmpi ! with an mpi communication
+ ELSE ; ifill(jn,jf) = jpfillnothing ! do nothing
+ ENDIF
+ END DO
+ !
+ ! north fold treatment
+ IF( l_IdoNFold ) ifill(jpno,jf) = jpfillnothing ! we do north fold -> do nothing for northern halo
+
+ ! We first define the localization and size of the parts of the array that will be sent (s), received (r)
+ ! or used for periodocity (p). The localization is defined as "the bottom left corner - 1" in i and j directions.
+ ! This is a shift that will be applied later in the do loops to pick-up the appropriate part of the array
+ !
+ ! all definitions bellow do not refer to N[ij][se]0 so we can use it with any local value of ihls
+ !
+ ! ! ________________________
+ ip0i = 0 ! im0j = inner |__|__|__________|__|__|
+ ip1i = ihls ! im1j = inner - halo |__|__|__________|__|__|
+ im1i = ipi(jf)-2*ihls ! | | | | | |
+ im0i = ipi(jf) - ihls ! | | | | | |
+ ip0j = 0 ! | | | | | |
+ ip1j = ihls ! |__|__|__________|__|__|
+ im1j = ipj(jf)-2*ihls ! ip1j = halo |__|__|__________|__|__|
+ im0j = ipj(jf) - ihls ! ip0j = 0 |__|__|__________|__|__|
+ ! ! ip0i ip1i im1i im0i
+ !
+ ! define shorter names...
+ iwewe(:) = (/ jpwe,jpea,jpwe,jpea /) ; issnn(:) = (/ jpso,jpso,jpno,jpno /)
+ iisz = ipi(jf)
+ ! sides: west east south north ; corners: so-we, so-ea, no-we, no-ea
+ isizei(1:4,jf) = (/ ihls, ihls, iisz, iisz /) ; isizei(5:8,jf) = ihls ! i- count
+ isizej(1:4,jf) = (/ Nj_0, Nj_0, ihls, ihls /) ; isizej(5:8,jf) = ihls ! j- count
+ ishtSi(1:4,jf) = (/ ip1i, im1i, ip0i, ip0i /) ; ishtSi(5:8,jf) = ishtSi( iwewe,jf ) ! i- shift send data
+ ishtSj(1:4,jf) = (/ ip1j, ip1j, ip1j, im1j /) ; ishtSj(5:8,jf) = ishtSj( issnn,jf ) ! j- shift send data
+ ishtRi(1:4,jf) = (/ ip0i, im0i, ip0i, ip0i /) ; ishtRi(5:8,jf) = ishtRi( iwewe,jf ) ! i- shift recv data
+ ishtRj(1:4,jf) = (/ ip1j, ip1j, ip0j, im0j /) ; ishtRj(5:8,jf) = ishtRj( issnn,jf ) ! j- shift recv data
+ ishtPi(1:4,jf) = (/ im1i, ip1i, ip0i, ip0i /) ; ishtPi(5:8,jf) = ishtPi( iwewe,jf ) ! i- shift perio data
+ ishtPj(1:4,jf) = (/ ip1j, ip1j, im1j, ip1j /) ; ishtPj(5:8,jf) = ishtPj( issnn,jf ) ! j- shift perio data
+ !
+ END DO ! jf
!
- iwewe(:) = (/ jpwe,jpea,jpwe,jpea /) ; issnn(:) = (/ jpso,jpso,jpno,jpno /)
- ! sides: west east south north ; corners: so-we, so-ea, no-we, no-ea
- isizei(1:4) = (/ ihls, ihls, ipi, ipi /) ; isizei(5:8) = ihls ! i- count
- isizej(1:4) = (/ Nj_0, Nj_0, ihls, ihls /) ; isizej(5:8) = ihls ! j- count
- ishtSi(1:4) = (/ ip1i, im1i, ip0i, ip0i /) ; ishtSi(5:8) = ishtSi( iwewe ) ! i- shift send data
- ishtSj(1:4) = (/ ip1j, ip1j, ip1j, im1j /) ; ishtSj(5:8) = ishtSj( issnn ) ! j- shift send data
- ishtRi(1:4) = (/ ip0i, im0i, ip0i, ip0i /) ; ishtRi(5:8) = ishtRi( iwewe ) ! i- shift received data location
- ishtRj(1:4) = (/ ip1j, ip1j, ip0j, im0j /) ; ishtRj(5:8) = ishtRj( issnn ) ! j- shift received data location
- ishtPi(1:4) = (/ im1i, ip1i, ip0i, ip0i /) ; ishtPi(5:8) = ishtPi( iwewe ) ! i- shift data used for periodicity
- ishtPj(1:4) = (/ ip1j, ip1j, im1j, ip1j /) ; ishtPj(5:8) = ishtPj( issnn ) ! j- shift data used for periodicity
+ IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, SUM(ipk(:))/kfld, SUM(ipl(:))/kfld, kfld, ld_lbc = .TRUE. )
!
! -------------------------------- !
! 2. Prepare MPI exchanges !
! -------------------------------- !
!
- iStag = (/ 1, 2, 3, 4, 5, 6, 7, 8 /) ! any value but each one must be different
+ iStag = (/ 1, 2, 3, 4, 5, 6, 7, 8 /) ! can be any value but each value must be unique
! define iRtag with the corresponding iStag, e.g. data received at west where sent at east.
iRtag(jpwe) = iStag(jpea) ; iRtag(jpea) = iStag(jpwe) ; iRtag(jpso) = iStag(jpno) ; iRtag(jpno) = iStag(jpso)
iRtag(jpsw) = iStag(jpne) ; iRtag(jpse) = iStag(jpnw) ; iRtag(jpnw) = iStag(jpse) ; iRtag(jpne) = iStag(jpsw)
!
- iszall(:) = isizei(:) * isizej(:) * ipk * ipl * ipf
+ ! size of the buffer to be sent/recv in each direction
+ ibufszS(:) = 0 ! defaut definition
+ ibufszR(:) = 0
+ DO jf = 1, kfld
+ DO jn = 1, 8
+ IF( llsend(jn,jf) ) ibufszS(jn) = ibufszS(jn) + isizei(jn,jf) * isizej(jn,jf) * ipk(jf) * ipl(jf)
+ IF( llrecv(jn,jf) ) ibufszR(jn) = ibufszR(jn) + isizei(jn,jf) * isizej(jn,jf) * ipk(jf) * ipl(jf)
+ END DO
+ END DO
+ !
+ ! offset to apply to find the position of the sent/recv data within the buffer
ishtS(1) = 0
DO jn = 2, 8
- ishtS(jn) = ishtS(jn-1) + iszall(jn-1) * COUNT( (/llsend(jn-1)/) )
+ ishtS(jn) = ishtS(jn-1) + ibufszS(jn-1)
END DO
ishtR(1) = 0
DO jn = 2, 8
- ishtR(jn) = ishtR(jn-1) + iszall(jn-1) * COUNT( (/llrecv(jn-1)/) )
+ ishtR(jn) = ishtR(jn-1) + ibufszR(jn-1)
END DO
-
+ !
! Allocate buffer arrays to be sent/received if needed
- iszS = SUM(iszall, mask = llsend) ! send buffer size
+ iszS = SUM(ibufszS) ! send buffer size
IF( ALLOCATED(BUFFSND) ) THEN
CALL mpi_waitall(8, nreq_p2p, MPI_STATUSES_IGNORE, ierr) ! wait for Isend from the PREVIOUS call
IF( SIZE(BUFFSND) < iszS ) DEALLOCATE(BUFFSND) ! send buffer is too small
ENDIF
IF( .NOT. ALLOCATED(BUFFSND) ) ALLOCATE( BUFFSND(iszS) )
- iszR = SUM(iszall, mask = llrecv) ! recv buffer size
+ iszR = SUM(ibufszR) ! recv buffer size
IF( ALLOCATED(BUFFRCV) ) THEN
IF( SIZE(BUFFRCV) < iszR ) DEALLOCATE(BUFFRCV) ! recv buffer is too small
ENDIF
IF( .NOT. ALLOCATED(BUFFRCV) ) ALLOCATE( BUFFRCV(iszR) )
!
- ! default definition when no communication is done. understood by mpi_waitall
+ ! Default definition when no communication is done. Understood by mpi_waitall
nreq_p2p(:) = MPI_REQUEST_NULL ! WARNING: Must be done after the call to mpi_waitall just above
!
! ----------------------------------------------- !
@@ -177,19 +201,28 @@
!
! ----------------------------------- !
! 4. Fill east and west halos !
+ ! Must be done before sending data !
+ ! data to south/north/corners !
! ----------------------------------- !
!
- DO jn = 1, 2
-#define BLOCK_FILL
+ DO jn = 1, 2 ! first: do all the non-MPI filling to give more time to MPI_RECV
+#define BLOCK_FILL_nonMPI
+# include "lbc_lnk_pt2pt_generic.h90"
+#undef BLOCK_FILL_nonMPI
+ END DO
+ DO jn = 1, 2 ! next: do the MPI_RECV part
+#define BLOCK_FILL_MPI_RECV
# include "lbc_lnk_pt2pt_generic.h90"
-#undef BLOCK_FILL
+#undef BLOCK_FILL_MPI_RECV
END DO
!
! ------------------------------------------------- !
! 5. Do north and south MPI_Isend if needed !
+ ! and Specific problem in corner treatment !
+ ! ( very rate case... ) !
! ------------------------------------------------- !
!
- DO jn = 3, 4
+ DO jn = 3, 8
#define BLOCK_ISEND
# include "lbc_lnk_pt2pt_generic.h90"
#undef BLOCK_ISEND
@@ -199,44 +232,34 @@
! 6. north fold treatment !
! ------------------------------- !
!
- ! Must be done after receiving data from East/West neighbourgs (as it is coded in mpp_nfd, to be changed one day...)
- ! Do it after MPI_iSend to south/north neighbourgs so they won't wait (too much) to receive their data
- ! Do if before MPI_Recv from south/north neighbourgs so we have more time to receive data
+ ! Do it after MPI_iSend to south/north/corners neighbourgs so they won't wait (too much) to receive their data
+ ! Do if before MPI_Recv from south/north/corners neighbourgs so we will have more time to receive data
!
IF( l_IdoNFold ) THEN
- IF( jpni == 1 ) THEN ; CALL lbc_nfd( ptab, cd_nat, psgn , ihls, ipf ) ! self NFold
- ELSE ; CALL mpp_nfd( ptab, cd_nat, psgn, ifill_nfd, zland, ihls, ipf ) ! mpi NFold
+ IF( jpni == 1 ) THEN ; CALL lbc_nfd( ptab, cd_nat, psgn , kfld ) ! self NFold
+ ELSE ; CALL mpp_nfd( ptab, cd_nat, psgn, ifill_nfd, zland, kfld ) ! mpi NFold
ENDIF
ENDIF
!
- ! ------------------------------------- !
- ! 7. Fill south and north halos !
- ! ------------------------------------- !
+ ! ------------------------------------------------ !
+ ! 7. Fill south and north halos !
+ ! and specific problem in corner treatment !
+ ! ( very rate case... ) !
+ ! ------------------------------------------------ !
!
- DO jn = 3, 4
-#define BLOCK_FILL
+ DO jn = 3, 8 ! first: do all the non-MPI filling to give more time to MPI_RECV
+#define BLOCK_FILL_nonMPI
# include "lbc_lnk_pt2pt_generic.h90"
-#undef BLOCK_FILL
+#undef BLOCK_FILL_nonMPI
END DO
- !
- ! ----------------------------------------------- !
- ! 8. Specific problem in corner treatment !
- ! ( very rate case... ) !
- ! ----------------------------------------------- !
- !
- DO jn = 5, 8
-#define BLOCK_ISEND
+ DO jn = 3, 8 ! next: do the MPI_RECV part
+#define BLOCK_FILL_MPI_RECV
# include "lbc_lnk_pt2pt_generic.h90"
-#undef BLOCK_ISEND
- END DO
- DO jn = 5, 8
-#define BLOCK_FILL
-# include "lbc_lnk_pt2pt_generic.h90"
-#undef BLOCK_FILL
+#undef BLOCK_FILL_MPI_RECV
END DO
!
! -------------------------------------------- !
- ! 9. deallocate local temporary arrays !
+ ! 8. deallocate local temporary arrays !
! if they areg larger than jpi*jpj ! <- arbitrary max size...
! -------------------------------------------- !
!
@@ -250,53 +273,72 @@
#endif
#if defined BLOCK_ISEND
- IF( llsend(jn) ) THEN
- ishti = ishtSi(jn)
- ishtj = ishtSj(jn)
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn) ; DO ji = 1,isizei(jn)
- BUFFSND(idxs) = ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl)
- idxs = idxs + 1
- END DO ; END DO ; END DO ; END DO ; END DO
+ IF( ibufszS(jn) > 0 ) THEN ! we must send some data
+ DO jf = 1, kfld ! first: fill the buffer to be sent
+ IF( llsend(jn,jf) ) THEN
+ ishti = ishtSi(jn,jf)
+ ishtj = ishtSj(jn,jf)
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf) ; DO jj = 1,isizej(jn,jf) ; DO ji = 1,isizei(jn,jf)
+ BUFFSND(idxs) = ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl)
+ idxs = idxs + 1
+ END DO ; END DO ; END DO ; END DO
+ ENDIF
+ END DO
#if ! defined key_mpi_off
IF( ln_timing ) CALL tic_tac(.TRUE.)
- ! non-blocking send of the west/east side using local buffer
- CALL MPI_ISEND( BUFFSND(ishtS(jn)+1), iszall(jn), MPI_TYPE, mpiSnei(ihls,jn), iStag(jn), icomm, nreq_p2p(jn), ierr )
+ ! next: non-blocking send using local buffer. use mpiSnei(n_hlsmax,jn), see mppini
+ CALL MPI_ISEND( BUFFSND(ishtS(jn)+1), ibufszS(jn), MPI_TYPE, mpiSnei(n_hlsmax,jn), iStag(jn), icomm, nreq_p2p(jn), ierr )
IF( ln_timing ) CALL tic_tac(.FALSE.)
#endif
ENDIF
+
#endif
-#if defined BLOCK_FILL
- ishti = ishtRi(jn)
- ishtj = ishtRj(jn)
- SELECT CASE ( ifill(jn) )
- CASE ( jpfillnothing ) ! no filling
- CASE ( jpfillmpi ) ! fill with data received by MPI
+#if defined BLOCK_FILL_nonMPI
+ DO jf = 1, kfld
+ IF( ifill(jn,jf) /= jpfillmpi ) THEN ! treat first all non-MPI cases
+ ishti = ishtRi(jn,jf)
+ ishtj = ishtRj(jn,jf)
+ SELECT CASE ( ifill(jn,jf) )
+ CASE ( jpfillnothing ) ! no filling
+ CASE ( jpfillperio ) ! we will do it later
+ ishti2 = ishtPi(jn,jf)
+ ishtj2 = ishtPj(jn,jf)
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf) ; DO jj = 1,isizej(jn,jf) ; DO ji = 1,isizei(jn,jf)
+ ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl)
+ END DO ; END DO ; END DO ; END DO
+ CASE ( jpfillcopy ) ! filling with inner domain values
+ ishti2 = ishtSi(jn,jf)
+ ishtj2 = ishtSj(jn,jf)
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf) ; DO jj = 1,isizej(jn,jf) ; DO ji = 1,isizei(jn,jf)
+ ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl)
+ END DO ; END DO ; END DO ; END DO
+ CASE ( jpfillcst ) ! filling with constant value
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf) ; DO jj = 1,isizej(jn,jf) ; DO ji = 1,isizei(jn,jf)
+ ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = zland
+ END DO ; END DO ; END DO ; END DO
+ END SELECT
+ ENDIF
+ END DO
+#endif
+
+#if defined BLOCK_FILL_MPI_RECV
+ IF( ibufszR(jn) > 0 ) THEN ! we must receive some data
#if ! defined key_mpi_off
IF( ln_timing ) CALL tic_tac(.TRUE.)
- ! ! blocking receive of the west/east halo in local temporary arrays
- CALL MPI_RECV( BUFFRCV(ishtR(jn)+1), iszall(jn), MPI_TYPE, mpiRnei(ihls,jn), iRtag(jn), icomm, MPI_STATUS_IGNORE, ierr )
+ ! blocking receive in local buffer. use mpiRnei(n_hlsmax,jn), see mppini
+ CALL MPI_RECV( BUFFRCV(ishtR(jn)+1), ibufszR(jn), MPI_TYPE, mpiRnei(n_hlsmax,jn), iRtag(jn), icomm, MPI_STATUS_IGNORE, ierr )
IF( ln_timing ) CALL tic_tac(.FALSE.)
#endif
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn) ; DO ji = 1,isizei(jn)
- ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = BUFFRCV(idxr)
- idxr = idxr + 1
- END DO ; END DO ; END DO ; END DO ; END DO
- CASE ( jpfillperio ) ! use periodicity
- ishti2 = ishtPi(jn)
- ishtj2 = ishtPj(jn)
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn) ; DO ji = 1,isizei(jn)
- ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl)
- END DO ; END DO ; END DO ; END DO ; END DO
- CASE ( jpfillcopy ) ! filling with inner domain values
- ishti2 = ishtSi(jn)
- ishtj2 = ishtSj(jn)
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn) ; DO ji = 1,isizei(jn)
- ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl)
- END DO ; END DO ; END DO ; END DO ; END DO
- CASE ( jpfillcst ) ! filling with constant value
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn) ; DO ji = 1,isizei(jn)
- ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = zland
- END DO ; END DO ; END DO ; END DO ; END DO
- END SELECT
+ DO jf = 1, kfld
+ IF( ifill(jn,jf) == jpfillmpi ) THEN ! Use MPI-received data
+ ishti = ishtRi(jn,jf)
+ ishtj = ishtRj(jn,jf)
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf) ; DO jj = 1,isizej(jn,jf) ; DO ji = 1,isizei(jn,jf)
+ ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = BUFFRCV(idxr)
+ idxr = idxr + 1
+ END DO ; END DO ; END DO ; END DO
+ ENDIF
+ END DO
+ ENDIF
#endif
diff --git a/src/OCE/LBC/lbc_nfd_generic.h90 b/src/OCE/LBC/lbc_nfd_generic.h90
index 18ae89738204699f95b59a2dd15ad27419865f7b..fdfa8b62b54ade95f72f7bf33e49fe91adc0657e 100644
--- a/src/OCE/LBC/lbc_nfd_generic.h90
+++ b/src/OCE/LBC/lbc_nfd_generic.h90
@@ -1,28 +1,23 @@
- SUBROUTINE lbc_nfd_/**/PRECISION( ptab, cd_nat, psgn, khls, kfld )
+ SUBROUTINE lbc_nfd_/**/PRECISION( ptab, cd_nat, psgn, kfld )
TYPE(PTR_4d_/**/PRECISION), DIMENSION(:), INTENT(inout) :: ptab ! pointer of arrays on which apply the b.c.
CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: cd_nat ! nature of array grid-points
REAL(PRECISION), DIMENSION(:), INTENT(in ) :: psgn ! sign used across the north fold boundary
- INTEGER , INTENT(in ) :: khls ! halo size, default = nn_hls
INTEGER , INTENT(in ) :: kfld ! number of pt3d arrays
!
INTEGER :: ji, jj, jk, jl, jf ! dummy loop indices
- INTEGER :: ipi, ipj, ipk, ipl, ipf ! dimension of the input array
+ INTEGER :: ipi, ipj, ipk, ipl, ihls ! dimension of the input array
INTEGER :: ii1, ii2, ij1, ij2
!!----------------------------------------------------------------------
!
- ipi = SIZE(ptab(1)%pt4d,1)
- ipj = SIZE(ptab(1)%pt4d,2)
- ipk = SIZE(ptab(1)%pt4d,3)
- ipl = SIZE(ptab(1)%pt4d,4)
- ipf = kfld
+ DO jf = 1, kfld ! Loop on the number of arrays to be treated
!
- IF( ipi /= Ni0glo+2*khls ) THEN
- WRITE(ctmp1,*) 'lbc_nfd input array does not match khls', ipi, khls, Ni0glo
- CALL ctl_stop( 'STOP', ctmp1 )
- ENDIF
- !
- DO jf = 1, ipf ! Loop on the number of arrays to be treated
+ ipi = SIZE(ptab(jf)%pt4d,1)
+ ipj = SIZE(ptab(jf)%pt4d,2)
+ ipk = SIZE(ptab(jf)%pt4d,3)
+ ipl = SIZE(ptab(jf)%pt4d,4)
+ !
+ ihls = ( ipi - Ni0glo ) / 2
!
IF( c_NFtype == 'T' ) THEN ! * North fold T-point pivot
!
@@ -30,160 +25,162 @@
CASE ( 'T' , 'W' ) ! T-, W-point
DO jl = 1, ipl ; DO jk = 1, ipk
!
- ! last khls lines (from ipj to ipj-khls+1) : full
- DO jj = 1, khls
- ij1 = ipj - jj + 1 ! ends at: ipj - khls + 1
- ij2 = ipj - 2*khls + jj - 1 ! ends at: ipj - 2*khls + khls - 1 = ipj - khls - 1
+ ! last ihls lines (from ipj to ipj-ihls+1) : full
+ DO jj = 1, ihls
+ ij1 = ipj - jj + 1 ! ends at: ipj - ihls + 1
+ ij2 = ipj - 2*ihls + jj - 1 ! ends at: ipj - 2*ihls + ihls - 1 = ipj - ihls - 1
!
- DO ji = 1, khls ! first khls points
- ii1 = ji ! ends at: khls
- ii2 = 2*khls + 2 - ji ! ends at: 2*khls + 2 - khls = khls + 2
+ DO ji = 1, ihls ! first ihls points
+ ii1 = ji ! ends at: ihls
+ ii2 = 2*ihls + 2 - ji ! ends at: 2*ihls + 2 - ihls = ihls + 2
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, 1 ! point khls+1
- ii1 = khls + ji
+ DO ji = 1, 1 ! point ihls+1
+ ii1 = ihls + ji
ii2 = ii1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, Ni0glo - 1 ! points from khls+2 to ipi - khls (note: Ni0glo = ipi - 2*khls)
- ii1 = 2 + khls + ji - 1 ! ends at: 2 + khls + ipi - 2*khls - 1 - 1 = ipi - khls
- ii2 = ipi - khls - ji + 1 ! ends at: ipi - khls - ( ipi - 2*khls - 1 ) + 1 = khls + 2
+ DO ji = 1, Ni0glo - 1 ! points from ihls+2 to ipi - ihls (note: Ni0glo = ipi - 2*ihls)
+ ii1 = 2 + ihls + ji - 1 ! ends at: 2 + ihls + ipi - 2*ihls - 1 - 1 = ipi - ihls
+ ii2 = ipi - ihls - ji + 1 ! ends at: ipi - ihls - ( ipi - 2*ihls - 1 ) + 1 = ihls + 2
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, 1 ! point ipi - khls + 1
- ii1 = ipi - khls + ji
- ii2 = khls + ji
+ DO ji = 1, COUNT( (/ihls > 0/) ) ! point ipi - ihls + 1
+ ii1 = ipi - ihls + ji
+ ii2 = ihls + ji
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, khls-1 ! last khls-1 points
- ii1 = ipi - khls + 1 + ji ! ends at: ipi - khls + 1 + khls - 1 = ipi
- ii2 = ipi - khls + 1 - ji ! ends at: ipi - khls + 1 - khls + 1 = ipi - 2*khls + 2
+ DO ji = 1, ihls-1 ! last ihls-1 points
+ ii1 = ipi - ihls + 1 + ji ! ends at: ipi - ihls + 1 + ihls - 1 = ipi
+ ii2 = ipi - ihls + 1 - ji ! ends at: ipi - ihls + 1 - ihls + 1 = ipi - 2*ihls + 2
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
END DO
!
- ! line number ipj-khls : right half
+ ! line number ipj-ihls : right half
DO jj = 1, 1
- ij1 = ipj - khls
+ ij1 = ipj - ihls
ij2 = ij1 ! same line
!
- DO ji = 1, Ni0glo/2-1 ! points from ipi/2+2 to ipi - khls (note: Ni0glo = ipi - 2*khls)
- ii1 = ipi/2 + ji + 1 ! ends at: ipi/2 + (ipi/2 - khls - 1) + 1 = ipi - khls
- ii2 = ipi/2 - ji + 1 ! ends at: ipi/2 - (ipi/2 - khls - 1) + 1 = khls + 2
+ DO ji = 1, Ni0glo/2-1 ! points from ipi/2+2 to ipi - ihls (note: Ni0glo = ipi - 2*ihls)
+ ii1 = ipi/2 + ji + 1 ! ends at: ipi/2 + (ipi/2 - ihls - 1) + 1 = ipi - ihls
+ ii2 = ipi/2 - ji + 1 ! ends at: ipi/2 - (ipi/2 - ihls - 1) + 1 = ihls + 2
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, khls ! first khls points: redo them just in case (if e-w periodocity already done)
- ! ! as we just changed points ipi-2khls+1 to ipi-khls
- ii1 = ji ! ends at: khls
- ii2 = 2*khls + 2 - ji ! ends at: 2*khls + 2 - khls = khls + 2
+ DO ji = 1, ihls ! first ihls points: redo them just in case (if e-w periodocity already done)
+ ! ! as we just changed points ipi-2ihls+1 to ipi-ihls
+ ii1 = ji ! ends at: ihls
+ ii2 = 2*ihls + 2 - ji ! ends at: 2*ihls + 2 - ihls = ihls + 2
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- ! ! last khls-1 points: have been / will done by e-w periodicity
+ ! ! last ihls-1 points: have been or will be done by e-w periodicity
END DO
!
- END DO; END DO
+ END DO ; END DO
CASE ( 'U' ) ! U-point
DO jl = 1, ipl ; DO jk = 1, ipk
!
- ! last khls lines (from ipj to ipj-khls+1) : full
- DO jj = 1, khls
- ij1 = ipj - jj + 1 ! ends at: ipj - khls + 1
- ij2 = ipj - 2*khls + jj - 1 ! ends at: ipj - 2*khls + khls - 1 = ipj - khls - 1
+ ! last ihls lines (from ipj to ipj-ihls+1) : full
+ DO jj = 1, ihls
+ ij1 = ipj - jj + 1 ! ends at: ipj - ihls + 1
+ ij2 = ipj - 2*ihls + jj - 1 ! ends at: ipj - 2*ihls + ihls - 1 = ipj - ihls - 1
!
- DO ji = 1, khls ! first khls points
- ii1 = ji ! ends at: khls
- ii2 = 2*khls + 1 - ji ! ends at: 2*khls + 1 - khls = khls + 1
+ DO ji = 1, ihls ! first ihls points
+ ii1 = ji ! ends at: ihls
+ ii2 = 2*ihls + 1 - ji ! ends at: 2*ihls + 1 - ihls = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, Ni0glo ! points from khls to ipi - khls (note: Ni0glo = ipi - 2*khls)
- ii1 = khls + ji ! ends at: khls + ipi - 2*khls = ipi - khls
- ii2 = ipi - khls - ji + 1 ! ends at: ipi - khls - ( ipi - 2*khls ) + 1 = khls + 1
+ DO ji = 1, Ni0glo ! points from ihls to ipi - ihls (note: Ni0glo = ipi - 2*ihls)
+ ii1 = ihls + ji ! ends at: ihls + ipi - 2*ihls = ipi - ihls
+ ii2 = ipi - ihls - ji + 1 ! ends at: ipi - ihls - ( ipi - 2*ihls ) + 1 = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, khls ! last khls points
- ii1 = ipi - khls + ji ! ends at: ipi - khls + khls = ipi
- ii2 = ipi - khls - ji + 1 ! ends at: ipi - khls + 1 - khls = ipi - 2*khls + 1
+ DO ji = 1, ihls ! last ihls points
+ ii1 = ipi - ihls + ji ! ends at: ipi - ihls + ihls = ipi
+ ii2 = ipi - ihls - ji + 1 ! ends at: ipi - ihls + 1 - ihls = ipi - 2*ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
END DO
!
- ! line number ipj-khls : right half
+ ! line number ipj-ihls : right half
DO jj = 1, 1
- ij1 = ipj - khls
+ ij1 = ipj - ihls
ij2 = ij1 ! same line
!
- DO ji = 1, Ni0glo/2 ! points from ipi/2+1 to ipi - khls (note: Ni0glo = ipi - 2*khls)
- ii1 = ipi/2 + ji ! ends at: ipi/2 + (ipi/2 - khls) = ipi - khls
- ii2 = ipi/2 - ji + 1 ! ends at: ipi/2 - (ipi/2 - khls) + 1 = khls + 1
+ DO ji = 1, Ni0glo/2 ! points from ipi/2+1 to ipi - ihls (note: Ni0glo = ipi - 2*ihls)
+ ii1 = ipi/2 + ji ! ends at: ipi/2 + (ipi/2 - ihls) = ipi - ihls
+ ii2 = ipi/2 - ji + 1 ! ends at: ipi/2 - (ipi/2 - ihls) + 1 = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, khls ! first khls points: redo them just in case (if e-w periodocity already done)
- ! ! as we just changed points ipi-2khls+1 to ipi-khls
- ii1 = ji ! ends at: khls
- ii2 = 2*khls + 1 - ji ! ends at: 2*khls + 1 - khls = khls + 1
+ DO ji = 1, ihls ! first ihls points: redo them just in case (if e-w periodocity already done)
+ ! ! as we just changed points ipi-2ihls+1 to ipi-ihls
+ ii1 = ji ! ends at: ihls
+ ii2 = 2*ihls + 1 - ji ! ends at: 2*ihls + 1 - ihls = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- ! ! last khls-1 points: have been / will done by e-w periodicity
+ ! ! last ihls-1 points: have been or will be done by e-w periodicity
END DO
!
- END DO; END DO
+ END DO ; END DO
CASE ( 'V' ) ! V-point
DO jl = 1, ipl ; DO jk = 1, ipk
!
- ! last khls+1 lines (from ipj to ipj-khls) : full
- DO jj = 1, khls+1
- ij1 = ipj - jj + 1 ! ends at: ipj - ( khls + 1 ) + 1 = ipj - khls
- ij2 = ipj - 2*khls + jj - 2 ! ends at: ipj - 2*khls + khls + 1 - 2 = ipj - khls - 1
+ ! last ihls+1 lines (from ipj to ipj-ihls) : full
+ DO jj = 1, ihls+1
+ ij1 = ipj - jj + 1 ! ends at: ipj - ( ihls + 1 ) + 1 = ipj - ihls
+ ij2 = ipj - 2*ihls + jj - 2 ! ends at: ipj - 2*ihls + ihls + 1 - 2 = ipj - ihls - 1
!
- DO ji = 1, khls ! first khls points
- ii1 = ji ! ends at: khls
- ii2 = 2*khls + 2 - ji ! ends at: 2*khls + 2 - khls = khls + 2
+ DO ji = 1, ihls ! first ihls points
+ ii1 = ji ! ends at: ihls
+ ii2 = 2*ihls + 2 - ji ! ends at: 2*ihls + 2 - ihls = ihls + 2
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, 1 ! point khls+1
- ii1 = khls + ji
+ DO ji = 1, 1 ! point ihls+1
+ ii1 = ihls + ji
ii2 = ii1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, Ni0glo - 1 ! points from khls+2 to ipi - khls (note: Ni0glo = ipi - 2*khls)
- ii1 = 2 + khls + ji - 1 ! ends at: 2 + khls + ipi - 2*khls - 1 - 1 = ipi - khls
- ii2 = ipi - khls - ji + 1 ! ends at: ipi - khls - ( ipi - 2*khls - 1 ) + 1 = khls + 2
+ DO ji = 1, Ni0glo - 1 ! points from ihls+2 to ipi - ihls (note: Ni0glo = ipi - 2*ihls)
+ ii1 = 2 + ihls + ji - 1 ! ends at: 2 + ihls + ipi - 2*ihls - 1 - 1 = ipi - ihls
+ ii2 = ipi - ihls - ji + 1 ! ends at: ipi - ihls - ( ipi - 2*ihls - 1 ) + 1 = ihls + 2
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, 1 ! point ipi - khls + 1
- ii1 = ipi - khls + ji
- ii2 = khls + ji
+ IF( ihls > 0 ) THEN
+ DO ji = 1, COUNT( (/ihls > 0/) ) ! point ipi - ihls + 1
+ ii1 = ipi - ihls + ji
+ ii2 = ihls + ji
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, khls-1 ! last khls-1 points
- ii1 = ipi - khls + 1 + ji ! ends at: ipi - khls + 1 + khls - 1 = ipi
- ii2 = ipi - khls + 1 - ji ! ends at: ipi - khls + 1 - khls + 1 = ipi - 2*khls + 2
+ ENDIF
+ DO ji = 1, ihls-1 ! last ihls-1 points
+ ii1 = ipi - ihls + 1 + ji ! ends at: ipi - ihls + 1 + ihls - 1 = ipi
+ ii2 = ipi - ihls + 1 - ji ! ends at: ipi - ihls + 1 - ihls + 1 = ipi - 2*ihls + 2
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
END DO
!
- END DO; END DO
+ END DO ; END DO
CASE ( 'F' ) ! F-point
DO jl = 1, ipl ; DO jk = 1, ipk
!
- ! last khls+1 lines (from ipj to ipj-khls) : full
- DO jj = 1, khls+1
- ij1 = ipj - jj + 1 ! ends at: ipj - ( khls + 1 ) + 1 = ipj - khls
- ij2 = ipj - 2*khls + jj - 2 ! ends at: ipj - 2*khls + khls + 1 - 2 = ipj - khls - 1
+ ! last ihls+1 lines (from ipj to ipj-ihls) : full
+ DO jj = 1, ihls+1
+ ij1 = ipj - jj + 1 ! ends at: ipj - ( ihls + 1 ) + 1 = ipj - ihls
+ ij2 = ipj - 2*ihls + jj - 2 ! ends at: ipj - 2*ihls + ihls + 1 - 2 = ipj - ihls - 1
!
- DO ji = 1, khls ! first khls points
- ii1 = ji ! ends at: khls
- ii2 = 2*khls + 1 - ji ! ends at: 2*khls + 1 - khls = khls + 1
+ DO ji = 1, ihls ! first ihls points
+ ii1 = ji ! ends at: ihls
+ ii2 = 2*ihls + 1 - ji ! ends at: 2*ihls + 1 - ihls = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, Ni0glo ! points from khls to ipi - khls (note: Ni0glo = ipi - 2*khls)
- ii1 = khls + ji ! ends at: khls + ipi - 2*khls = ipi - khls
- ii2 = ipi - khls - ji + 1 ! ends at: ipi - khls - ( ipi - 2*khls ) + 1 = khls + 1
+ DO ji = 1, Ni0glo ! points from ihls to ipi - ihls (note: Ni0glo = ipi - 2*ihls)
+ ii1 = ihls + ji ! ends at: ihls + ipi - 2*ihls = ipi - ihls
+ ii2 = ipi - ihls - ji + 1 ! ends at: ipi - ihls - ( ipi - 2*ihls ) + 1 = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, khls ! last khls points
- ii1 = ipi - khls + ji ! ends at: ipi - khls + khls = ipi
- ii2 = ipi - khls - ji + 1 ! ends at: ipi - khls + 1 - khls = ipi - 2*khls + 1
+ DO ji = 1, ihls ! last ihls points
+ ii1 = ipi - ihls + ji ! ends at: ipi - ihls + ihls = ipi
+ ii2 = ipi - ihls - ji + 1 ! ends at: ipi - ihls + 1 - ihls = ipi - 2*ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
END DO
@@ -199,9 +196,9 @@
CASE ( 'T' , 'W' ) ! T-, W-point
DO jl = 1, ipl ; DO jk = 1, ipk
!
- ! first: line number ipj-khls : 3 points
+ ! first: line number ipj-ihls : 3 points
DO jj = 1, 1
- ij1 = ipj - khls
+ ij1 = ipj - ihls
ij2 = ij1 ! same line
!
DO ji = 1, 1 ! points from ipi/2+1
@@ -209,37 +206,37 @@
ii2 = ipi/2 - ji + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = ptab(jf)%pt4d(ii2,ij2,jk,jl) ! Warning: pb with sign...
END DO
- DO ji = 1, 1 ! points ipi - khls
- ii1 = ipi - khls + ji - 1
- ii2 = khls + ji
+ DO ji = 1, 1 ! points ipi - ihls
+ ii1 = ipi - ihls + ji - 1
+ ii2 = ihls + ji
ptab(jf)%pt4d(ii1,ij1,jk,jl) = ptab(jf)%pt4d(ii2,ij2,jk,jl) ! Warning: pb with sign...
END DO
- DO ji = 1, 1 ! point khls: redo it just in case (if e-w periodocity already done)
- ! ! as we just changed point ipi - khls
- ii1 = khls + ji - 1
- ii2 = khls + ji
+ DO ji = 1, COUNT( (/ihls > 0/) ) ! point ihls: redo it just in case (if e-w periodocity already done)
+ ! ! as we just changed point ipi - ihls
+ ii1 = ihls + ji - 1
+ ii2 = ihls + ji
ptab(jf)%pt4d(ii1,ij1,jk,jl) = ptab(jf)%pt4d(ii2,ij2,jk,jl) ! Warning: pb with sign...
END DO
END DO
!
- ! Second: last khls lines (from ipj to ipj-khls+1) : full
- DO jj = 1, khls
- ij1 = ipj + 1 - jj ! ends at: ipj + 1 - khls
- ij2 = ipj - 2*khls + jj ! ends at: ipj - 2*khls + khls = ipj - khls
+ ! Second: last ihls lines (from ipj to ipj-ihls+1) : full
+ DO jj = 1, ihls
+ ij1 = ipj + 1 - jj ! ends at: ipj + 1 - ihls
+ ij2 = ipj - 2*ihls + jj ! ends at: ipj - 2*ihls + ihls = ipj - ihls
!
- DO ji = 1, khls ! first khls points
- ii1 = ji ! ends at: khls
- ii2 = 2*khls + 1 - ji ! ends at: 2*khls + 1 - khls = khls + 1
+ DO ji = 1, ihls ! first ihls points
+ ii1 = ji ! ends at: ihls
+ ii2 = 2*ihls + 1 - ji ! ends at: 2*ihls + 1 - ihls = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, Ni0glo ! points from khls to ipi - khls (note: Ni0glo = ipi - 2*khls)
- ii1 = khls + ji ! ends at: khls + ipi - 2*khls = ipi - khls
- ii2 = ipi - khls - ji + 1 ! ends at: ipi - khls - ( ipi - 2*khls ) + 1 = khls + 1
+ DO ji = 1, Ni0glo ! points from ihls to ipi - ihls (note: Ni0glo = ipi - 2*ihls)
+ ii1 = ihls + ji ! ends at: ihls + ipi - 2*ihls = ipi - ihls
+ ii2 = ipi - ihls - ji + 1 ! ends at: ipi - ihls - ( ipi - 2*ihls ) + 1 = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, khls ! last khls points
- ii1 = ipi - khls + ji ! ends at: ipi - khls + khls = ipi
- ii2 = ipi - khls - ji + 1 ! ends at: ipi - khls + 1 - khls = ipi - 2*khls + 1
+ DO ji = 1, ihls ! last ihls points
+ ii1 = ipi - ihls + ji ! ends at: ipi - ihls + ihls = ipi
+ ii2 = ipi - ihls - ji + 1 ! ends at: ipi - ihls + 1 - ihls = ipi - 2*ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
END DO
@@ -248,34 +245,34 @@
CASE ( 'U' ) ! U-point
DO jl = 1, ipl ; DO jk = 1, ipk
!
- ! last khls lines (from ipj to ipj-khls+1) : full
- DO jj = 1, khls
- ij1 = ipj + 1 - jj ! ends at: ipj + 1 - khls
- ij2 = ipj - 2*khls + jj ! ends at: ipj - 2*khls + khls = ipj - khls
+ ! last ihls lines (from ipj to ipj-ihls+1) : full
+ DO jj = 1, ihls
+ ij1 = ipj + 1 - jj ! ends at: ipj + 1 - ihls
+ ij2 = ipj - 2*ihls + jj ! ends at: ipj - 2*ihls + ihls = ipj - ihls
!
- DO ji = 1, khls-1 ! first khls-1 points
- ii1 = ji ! ends at: khls-1
- ii2 = 2*khls - ji ! ends at: 2*khls - ( khls - 1 ) = khls + 1
+ DO ji = 1, ihls-1 ! first ihls-1 points
+ ii1 = ji ! ends at: ihls-1
+ ii2 = 2*ihls - ji ! ends at: 2*ihls - ( ihls - 1 ) = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, 1 ! point khls
- ii1 = khls + ji - 1
+ DO ji = 1, 1 ! point ihls (here ihls > 0 so it is ok)
+ ii1 = ihls + ji - 1
ii2 = ipi - ii1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, Ni0glo - 1 ! points from khls+1 to ipi - khls - 1 (note: Ni0glo = ipi - 2*khls)
- ii1 = khls + ji ! ends at: khls + ( ipi - 2*khls - 1 ) = ipi - khls - 1
- ii2 = ipi - khls - ji ! ends at: ipi - khls - ( ipi - 2*khls - 1 ) = khls + 1
+ DO ji = 1, Ni0glo - 1 ! points from ihls+1 to ipi - ihls - 1 (note: Ni0glo = ipi - 2*ihls)
+ ii1 = ihls + ji ! ends at: ihls + ( ipi - 2*ihls - 1 ) = ipi - ihls - 1
+ ii2 = ipi - ihls - ji ! ends at: ipi - ihls - ( ipi - 2*ihls - 1 ) = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, 1 ! point ipi - khls
- ii1 = ipi - khls + ji - 1
+ DO ji = 1, 1 ! point ipi - ihls
+ ii1 = ipi - ihls + ji - 1
ii2 = ii1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, khls ! last khls points
- ii1 = ipi - khls + ji ! ends at: ipi - khls + khls = ipi
- ii2 = ipi - khls - ji ! ends at: ipi - khls - khls = ipi - 2*khls
+ DO ji = 1, ihls ! last ihls points
+ ii1 = ipi - ihls + ji ! ends at: ipi - ihls + ihls = ipi
+ ii2 = ipi - ihls - ji ! ends at: ipi - ihls - ihls = ipi - 2*ihls
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
END DO
@@ -284,100 +281,100 @@
CASE ( 'V' ) ! V-point
DO jl = 1, ipl ; DO jk = 1, ipk
!
- ! last khls lines (from ipj to ipj-khls+1) : full
- DO jj = 1, khls
- ij1 = ipj - jj + 1 ! ends at: ipj - khls + 1
- ij2 = ipj - 2*khls + jj - 1 ! ends at: ipj - 2*khls + khls - 1 = ipj - khls - 1
+ ! last ihls lines (from ipj to ipj-ihls+1) : full
+ DO jj = 1, ihls
+ ij1 = ipj - jj + 1 ! ends at: ipj - ihls + 1
+ ij2 = ipj - 2*ihls + jj - 1 ! ends at: ipj - 2*ihls + ihls - 1 = ipj - ihls - 1
!
- DO ji = 1, khls ! first khls points
- ii1 = ji ! ends at: khls
- ii2 = 2*khls + 1 - ji ! ends at: 2*khls + 1 - khls = khls + 1
+ DO ji = 1, ihls ! first ihls points
+ ii1 = ji ! ends at: ihls
+ ii2 = 2*ihls + 1 - ji ! ends at: 2*ihls + 1 - ihls = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, Ni0glo ! points from khls to ipi - khls (note: Ni0glo = ipi - 2*khls)
- ii1 = khls + ji ! ends at: khls + ipi - 2*khls = ipi - khls
- ii2 = ipi - khls - ji + 1 ! ends at: ipi - khls - ( ipi - 2*khls ) + 1 = khls + 1
+ DO ji = 1, Ni0glo ! points from ihls to ipi - ihls (note: Ni0glo = ipi - 2*ihls)
+ ii1 = ihls + ji ! ends at: ihls + ipi - 2*ihls = ipi - ihls
+ ii2 = ipi - ihls - ji + 1 ! ends at: ipi - ihls - ( ipi - 2*ihls ) + 1 = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, khls ! last khls points
- ii1 = ipi - khls + ji ! ends at: ipi - khls + khls = ipi
- ii2 = ipi - khls - ji + 1 ! ends at: ipi - khls + 1 - khls = ipi - 2*khls + 1
+ DO ji = 1, ihls ! last ihls points
+ ii1 = ipi - ihls + ji ! ends at: ipi - ihls + ihls = ipi
+ ii2 = ipi - ihls - ji + 1 ! ends at: ipi - ihls + 1 - ihls = ipi - 2*ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
END DO
!
- ! line number ipj-khls : right half
+ ! line number ipj-ihls : right half
DO jj = 1, 1
- ij1 = ipj - khls
+ ij1 = ipj - ihls
ij2 = ij1 ! same line
!
- DO ji = 1, Ni0glo/2 ! points from ipi/2+1 to ipi - khls (note: Ni0glo = ipi - 2*khls)
- ii1 = ipi/2 + ji ! ends at: ipi/2 + (ipi/2 - khls) = ipi - khls
- ii2 = ipi/2 - ji + 1 ! ends at: ipi/2 - (ipi/2 - khls) + 1 = khls + 1
+ DO ji = 1, Ni0glo/2 ! points from ipi/2+1 to ipi - ihls (note: Ni0glo = ipi - 2*ihls)
+ ii1 = ipi/2 + ji ! ends at: ipi/2 + (ipi/2 - ihls) = ipi - ihls
+ ii2 = ipi/2 - ji + 1 ! ends at: ipi/2 - (ipi/2 - ihls) + 1 = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, khls ! first khls points: redo them just in case (if e-w periodocity already done)
- ! ! as we just changed points ipi-2khls+1 to ipi-khls
- ii1 = ji ! ends at: khls
- ii2 = 2*khls + 1 - ji ! ends at: 2*khls + 1 - khls = khls + 1
+ DO ji = 1, ihls ! first ihls points: redo them just in case (if e-w periodocity already done)
+ ! ! as we just changed points ipi-2ihls+1 to ipi-ihls
+ ii1 = ji ! ends at: ihls
+ ii2 = 2*ihls + 1 - ji ! ends at: 2*ihls + 1 - ihls = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- ! ! last khls points: have been / will done by e-w periodicity
+ ! ! last ihls points: have been or will be done by e-w periodicity
END DO
!
END DO; END DO
CASE ( 'F' ) ! F-point
DO jl = 1, ipl ; DO jk = 1, ipk
!
- ! last khls lines (from ipj to ipj-khls+1) : full
- DO jj = 1, khls
- ij1 = ipj - jj + 1 ! ends at: ipj - khls + 1
- ij2 = ipj - 2*khls + jj - 1 ! ends at: ipj - 2*khls + khls - 1 = ipj - khls - 1
+ ! last ihls lines (from ipj to ipj-ihls+1) : full
+ DO jj = 1, ihls
+ ij1 = ipj - jj + 1 ! ends at: ipj - ihls + 1
+ ij2 = ipj - 2*ihls + jj - 1 ! ends at: ipj - 2*ihls + ihls - 1 = ipj - ihls - 1
!
- DO ji = 1, khls-1 ! first khls-1 points
- ii1 = ji ! ends at: khls-1
- ii2 = 2*khls - ji ! ends at: 2*khls - ( khls - 1 ) = khls + 1
+ DO ji = 1, ihls-1 ! first ihls-1 points
+ ii1 = ji ! ends at: ihls-1
+ ii2 = 2*ihls - ji ! ends at: 2*ihls - ( ihls - 1 ) = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, 1 ! point khls
- ii1 = khls + ji - 1
+ DO ji = 1, 1 ! point ihls (here ihls > 0 so it is ok)
+ ii1 = ihls + ji - 1
ii2 = ipi - ii1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, Ni0glo - 1 ! points from khls+1 to ipi - khls - 1 (note: Ni0glo = ipi - 2*khls)
- ii1 = khls + ji ! ends at: khls + ( ipi - 2*khls - 1 ) = ipi - khls - 1
- ii2 = ipi - khls - ji ! ends at: ipi - khls - ( ipi - 2*khls - 1 ) = khls + 1
+ DO ji = 1, Ni0glo - 1 ! points from ihls+1 to ipi - ihls - 1 (note: Ni0glo = ipi - 2*ihls)
+ ii1 = ihls + ji ! ends at: ihls + ( ipi - 2*ihls - 1 ) = ipi - ihls - 1
+ ii2 = ipi - ihls - ji ! ends at: ipi - ihls - ( ipi - 2*ihls - 1 ) = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, 1 ! point ipi - khls
- ii1 = ipi - khls + ji - 1
+ DO ji = 1, 1 ! point ipi - ihls
+ ii1 = ipi - ihls + ji - 1
ii2 = ii1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, khls ! last khls points
- ii1 = ipi - khls + ji ! ends at: ipi - khls + khls = ipi
- ii2 = ipi - khls - ji ! ends at: ipi - khls - khls = ipi - 2*khls
+ DO ji = 1, ihls ! last ihls points
+ ii1 = ipi - ihls + ji ! ends at: ipi - ihls + ihls = ipi
+ ii2 = ipi - ihls - ji ! ends at: ipi - ihls - ihls = ipi - 2*ihls
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
END DO
!
- ! line number ipj-khls : right half
+ ! line number ipj-ihls : right half
DO jj = 1, 1
- ij1 = ipj - khls
+ ij1 = ipj - ihls
ij2 = ij1 ! same line
!
- DO ji = 1, Ni0glo/2-1 ! points from ipi/2+1 to ipi - khls-1 (note: Ni0glo = ipi - 2*khls)
- ii1 = ipi/2 + ji ! ends at: ipi/2 + (ipi/2 - khls) = ipi - khls
- ii2 = ipi/2 - ji ! ends at: ipi/2 - (ipi/2 - khls - 1 ) = khls + 1
+ DO ji = 1, Ni0glo/2-1 ! points from ipi/2+1 to ipi - ihls-1 (note: Ni0glo = ipi - 2*ihls)
+ ii1 = ipi/2 + ji ! ends at: ipi/2 + (ipi/2 - ihls) = ipi - ihls
+ ii2 = ipi/2 - ji ! ends at: ipi/2 - (ipi/2 - ihls - 1 ) = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, khls-1 ! first khls-1 points: redo them just in case (if e-w periodocity already done)
- ! ! as we just changed points ipi-2khls+1 to ipi-nn_hl-1
- ii1 = ji ! ends at: khls
- ii2 = 2*khls - ji ! ends at: 2*khls - ( khls - 1 ) = khls + 1
+ DO ji = 1, ihls-1 ! first ihls-1 points: redo them just in case (if e-w periodocity already done)
+ ! ! as we just changed points ipi-2ihls+1 to ipi-nn_hl-1
+ ii1 = ji ! ends at: ihls
+ ii2 = 2*ihls - ji ! ends at: 2*ihls - ( ihls - 1 ) = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- ! ! last khls points: have been / will done by e-w periodicity
+ ! ! last ihls points: have been or will be done by e-w periodicity
END DO
!
END DO; END DO
@@ -385,7 +382,7 @@
!
ENDIF ! c_NFtype == 'F'
!
- END DO ! ipf
+ END DO ! kfld
!
END SUBROUTINE lbc_nfd_/**/PRECISION
diff --git a/src/OCE/LBC/lbclnk.F90 b/src/OCE/LBC/lbclnk.F90
index be65cdc13349f614798522689f68b9c2ea63ecf1..3776b59538df9b08daf415881be2757b3f4b2919 100644
--- a/src/OCE/LBC/lbclnk.F90
+++ b/src/OCE/LBC/lbclnk.F90
@@ -38,11 +38,9 @@ MODULE lbclnk
MODULE PROCEDURE lbc_lnk_pt2pt_sp, lbc_lnk_pt2pt_dp
END INTERFACE
-#if ! defined key_mpi2
INTERFACE lbc_lnk_neicoll
MODULE PROCEDURE lbc_lnk_neicoll_sp ,lbc_lnk_neicoll_dp
END INTERFACE
-#endif
!
INTERFACE lbc_lnk_icb
MODULE PROCEDURE mpp_lnk_2d_icb_dp, mpp_lnk_2d_icb_sp
@@ -51,10 +49,10 @@ MODULE lbclnk
PUBLIC lbc_lnk ! ocean/ice lateral boundary conditions
PUBLIC lbc_lnk_icb ! iceberg lateral boundary conditions
- REAL(dp), DIMENSION(:), ALLOCATABLE :: buffsnd_dp, buffrcv_dp ! MPI send/recv buffers
- REAL(sp), DIMENSION(:), ALLOCATABLE :: buffsnd_sp, buffrcv_sp !
- INTEGER, DIMENSION(8) :: nreq_p2p ! request id for MPI_Isend in point-2-point communication
-
+ REAL(dp), DIMENSION(:), ALLOCATABLE :: buffsnd_dp, buffrcv_dp ! MPI send/recv buffers
+ REAL(sp), DIMENSION(:), ALLOCATABLE :: buffsnd_sp, buffrcv_sp !
+ INTEGER, DIMENSION(8) :: nreq_p2p = MPI_REQUEST_NULL ! request id for MPI_Isend in point-2-point communication
+ INTEGER :: nreq_nei = MPI_REQUEST_NULL ! request id for mpi_neighbor_ialltoallv
!! * Substitutions
!!# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
@@ -134,9 +132,7 @@ CONTAINS
# define BUFFSND buffsnd_sp
# define BUFFRCV buffrcv_sp
# include "lbc_lnk_pt2pt_generic.h90"
-#if ! defined key_mpi2
# include "lbc_lnk_neicoll_generic.h90"
-#endif
# undef MPI_TYPE
# undef BUFFSND
# undef BUFFRCV
@@ -149,9 +145,7 @@ CONTAINS
# define BUFFSND buffsnd_dp
# define BUFFRCV buffrcv_dp
# include "lbc_lnk_pt2pt_generic.h90"
-#if ! defined key_mpi2
# include "lbc_lnk_neicoll_generic.h90"
-#endif
# undef MPI_TYPE
# undef BUFFSND
# undef BUFFRCV
diff --git a/src/OCE/LBC/lbcnfd.F90 b/src/OCE/LBC/lbcnfd.F90
index dc784b868f7c4316feb95af709f6d68afe437d82..c6be460c98335017113ac2028edb02b098ca20cd 100644
--- a/src/OCE/LBC/lbcnfd.F90
+++ b/src/OCE/LBC/lbcnfd.F90
@@ -23,8 +23,11 @@ MODULE lbcnfd
PRIVATE
INTERFACE lbc_nfd ! called by mpp_nfd, lbc_lnk_pt2pt or lbc_lnk_neicoll
- MODULE PROCEDURE lbc_nfd_sp, lbc_nfd_ext_sp
- MODULE PROCEDURE lbc_nfd_dp, lbc_nfd_ext_dp
+ MODULE PROCEDURE lbc_nfd_sp, lbc_nfd_dp
+ END INTERFACE
+
+ INTERFACE lbc_nfd_ext ! called by mpp_lnk_2d_icb
+ MODULE PROCEDURE lbc_nfd_ext_sp, lbc_nfd_ext_dp
END INTERFACE
INTERFACE mpp_nfd ! called by lbc_lnk_pt2pt or lbc_lnk_neicoll
@@ -33,11 +36,13 @@ MODULE lbcnfd
PUBLIC mpp_nfd ! mpi north fold conditions
PUBLIC lbc_nfd ! north fold conditions
+ PUBLIC lbc_nfd_ext ! north fold conditions, called by mpp_lnk_2d_icb
- INTEGER, PUBLIC :: nfd_nbnei
- INTEGER, PUBLIC, ALLOCATABLE, DIMENSION (: ) :: nfd_rknei
- INTEGER, PUBLIC, ALLOCATABLE, DIMENSION (:,:) :: nfd_rksnd
- INTEGER, PUBLIC, ALLOCATABLE, DIMENSION (:,:) :: nfd_jisnd
+ INTEGER, PUBLIC :: nfd_nbnei
+ INTEGER, PUBLIC, ALLOCATABLE, DIMENSION (: ) :: nfd_rknei
+ INTEGER, PUBLIC, ALLOCATABLE, DIMENSION (:,:,:) :: nfd_rksnd
+ INTEGER, PUBLIC, ALLOCATABLE, DIMENSION (:,:,:) :: nfd_jisnd
+ LOGICAL, PUBLIC, ALLOCATABLE, DIMENSION (:,: ) :: lnfd_same
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
diff --git a/src/OCE/LBC/lib_mpp.F90 b/src/OCE/LBC/lib_mpp.F90
index 9854cb04bfb0ec3f99ce4a44bce63274dbfdac15..3c4c955f9a253b8b902910eb75b907ea0c32b01f 100644
--- a/src/OCE/LBC/lib_mpp.F90
+++ b/src/OCE/LBC/lib_mpp.F90
@@ -142,7 +142,7 @@ MODULE lib_mpp
INTEGER :: MPI_SUMDD
! Neighbourgs informations
- INTEGER, PARAMETER, PUBLIC :: n_hlsmax = 3
+ INTEGER, PARAMETER, PUBLIC :: n_hlsmax = 2
INTEGER, DIMENSION( 8), PUBLIC :: mpinei !: 8-neighbourg MPI indexes (starting at 0, -1 if no neighbourg)
INTEGER, DIMENSION(0:n_hlsmax,8), PUBLIC :: mpiSnei !: 8-neighbourg Send MPI indexes (starting at 0, -1 if no neighbourg)
INTEGER, DIMENSION(0:n_hlsmax,8), PUBLIC :: mpiRnei !: 8-neighbourg Recv MPI indexes (starting at 0, -1 if no neighbourg)
@@ -1127,7 +1127,7 @@ CONTAINS
INTEGER :: ierr
LOGICAL, PARAMETER :: ireord = .FALSE.
!!----------------------------------------------------------------------
-#if ! defined key_mpi_off && ! defined key_mpi2
+#if ! defined key_mpi_off
iScnt4 = COUNT( mpiSnei(khls,1:4) >= 0 )
iRcnt4 = COUNT( mpiRnei(khls,1:4) >= 0 )
@@ -1141,10 +1141,19 @@ CONTAINS
iSnei8 = PACK( mpiSnei(khls,1:8), mask = mpiSnei(khls,1:8) >= 0 )
iRnei8 = PACK( mpiRnei(khls,1:8), mask = mpiRnei(khls,1:8) >= 0 )
+ ! Isolated processes (i.e., processes WITH no outgoing or incoming edges, that is, processes that have specied
+ ! indegree and outdegree as zero and thus DO not occur as source or destination rank in the graph specication)
+ ! are allowed.
+
+# if ! defined key_mpi2
CALL MPI_Dist_graph_create_adjacent( mpi_comm_oce, iScnt4, iSnei4, MPI_UNWEIGHTED, iRcnt4, iRnei4, MPI_UNWEIGHTED, &
& MPI_INFO_NULL, ireord, mpi_nc_com4(khls), ierr )
CALL MPI_Dist_graph_create_adjacent( mpi_comm_oce, iScnt8, iSnei8, MPI_UNWEIGHTED, iRcnt8, iRnei8, MPI_UNWEIGHTED, &
& MPI_INFO_NULL, ireord, mpi_nc_com8(khls), ierr)
+# else
+ mpi_nc_com4(khls) = -1
+ mpi_nc_com8(khls) = -1
+# endif
DEALLOCATE( iSnei4, iRnei4, iSnei8, iRnei8 )
#endif
@@ -1307,7 +1316,7 @@ CONTAINS
IF ( ncomm_sequence(ji,1) .GT. 1 .AND. ncomm_sequence(ji,2) .GT. 1 ) jj = jj + 1
jh = MAX (jh, ncomm_sequence(ji,1)*ncomm_sequence(ji,2))
END DO
- WRITE(numcom,'(A,I3)') ' 3D Exchanged halos : ', jk
+ WRITE(numcom,'(A,I3)') ' 3D or 4D Exchanged halos : ', jk
WRITE(numcom,'(A,I3)') ' Multi arrays exchanged halos : ', jf
WRITE(numcom,'(A,I3)') ' from which 3D : ', jj
WRITE(numcom,'(A,I10)') ' Array max size : ', jh*jpi*jpj
diff --git a/src/OCE/LBC/mpp_lbc_north_icb_generic.h90 b/src/OCE/LBC/mpp_lbc_north_icb_generic.h90
index 3c8382eacadfb023929f88836e36813d7c40fd69..63cef9abf5ac54ddbe6c93833406f944896dd141 100644
--- a/src/OCE/LBC/mpp_lbc_north_icb_generic.h90
+++ b/src/OCE/LBC/mpp_lbc_north_icb_generic.h90
@@ -92,7 +92,7 @@
! 2. North-Fold boundary conditions
! ----------------------------------
- CALL lbc_nfd( ztab_e(:,1-kextj:ipj+kextj), cd_type, psgn, kextj )
+ CALL lbc_nfd_ext( ztab_e(:,1-kextj:ipj+kextj), cd_type, psgn, kextj )
ij = 1 - kextj
!! Scatter back to pt2d
diff --git a/src/OCE/LBC/mpp_lnk_icb_generic.h90 b/src/OCE/LBC/mpp_lnk_icb_generic.h90
index 8798f3e0c3e71217ced192fbb3c1f1879c0640fd..b0cb70d46cbcc3e5876ccca62d48b1a3b90ea222 100644
--- a/src/OCE/LBC/mpp_lnk_icb_generic.h90
+++ b/src/OCE/LBC/mpp_lnk_icb_generic.h90
@@ -87,7 +87,7 @@
IF( l_IdoNFold ) THEN
!
SELECT CASE ( jpni )
- CASE ( 1 ) ; CALL lbc_nfd ( pt2d(1:jpi,1:jpj+kextj), cd_type, psgn, kextj )
+ CASE ( 1 ) ; CALL lbc_nfd_ext ( pt2d(1:jpi,1:jpj+kextj), cd_type, psgn, kextj )
CASE DEFAULT ; CALL LBCNORTH ( pt2d(1:jpi,1:jpj+kextj), cd_type, psgn, kextj )
END SELECT
!
diff --git a/src/OCE/LBC/mpp_loc_generic.h90 b/src/OCE/LBC/mpp_loc_generic.h90
index 1bce8df2d3c2fb7e677f68185a5309346e764450..fe5697630506ef9afaeea3461ded79ec048db8c1 100644
--- a/src/OCE/LBC/mpp_loc_generic.h90
+++ b/src/OCE/LBC/mpp_loc_generic.h90
@@ -47,6 +47,7 @@
!
INTEGER :: ierror, ii, idim
INTEGER :: index0
+ INTEGER :: ihls, ipiglo, ipjglo
INTEGER , DIMENSION(:), ALLOCATABLE :: ilocs
REAL(PRECISION) :: zmin ! local minimum
REAL(PRECISION), DIMENSION(2,1) :: zain, zaout
@@ -60,6 +61,9 @@
ENDIF
!
idim = SIZE(kindex)
+ ihls = ( SIZE(ARRAY_IN(:,:,:), 1) - Ni_0 ) / 2
+ ipiglo = Ni0glo + 2*ihls
+ ipjglo = Nj0glo + 2*ihls
!
IF ( ANY( MASK_IN(:,:,:) ) ) THEN ! there is at least 1 valid point...
!
@@ -68,9 +72,9 @@
ilocs = LOC_OPERATION( ARRAY_IN(:,:,:) , mask= MASK_IN(:,:,:) )
zmin = ARRAY_IN(ilocs(1),ilocs(2),ilocs(3))
!
- kindex(1) = mig( ilocs(1) )
+ kindex(1) = mig( ilocs(1), ihls )
#if defined DIM_2d || defined DIM_3d /* avoid warning when kindex has 1 element */
- kindex(2) = mjg( ilocs(2) )
+ kindex(2) = mjg( ilocs(2), ihls )
#endif
#if defined DIM_3d /* avoid warning when kindex has 2 elements */
kindex(3) = ilocs(3)
@@ -80,10 +84,10 @@
!
index0 = kindex(1)-1 ! 1d index starting at 0
#if defined DIM_2d || defined DIM_3d /* avoid warning when kindex has 1 element */
- index0 = index0 + jpiglo * (kindex(2)-1)
+ index0 = index0 + ipiglo * (kindex(2)-1)
#endif
#if defined DIM_3d /* avoid warning when kindex has 2 elements */
- index0 = index0 + jpiglo * jpjglo * (kindex(3)-1)
+ index0 = index0 + ipiglo * ipjglo * (kindex(3)-1)
#endif
ELSE
! special case for land processors
@@ -105,20 +109,20 @@
pmin = zaout(1,1)
index0 = NINT( zaout(2,1) )
#if defined DIM_3d /* avoid warning when kindex has 2 elements */
- kindex(3) = index0 / (jpiglo*jpjglo)
- index0 = index0 - kindex(3) * (jpiglo*jpjglo)
+ kindex(3) = index0 / (ipiglo*ipjglo)
+ index0 = index0 - kindex(3) * (ipiglo*ipjglo)
#endif
#if defined DIM_2d || defined DIM_3d /* avoid warning when kindex has 1 element */
- kindex(2) = index0 / jpiglo
- index0 = index0 - kindex(2) * jpiglo
+ kindex(2) = index0 / ipiglo
+ index0 = index0 - kindex(2) * ipiglo
#endif
kindex(1) = index0
kindex(:) = kindex(:) + 1 ! start indices at 1
IF( .NOT. llhalo ) THEN
- kindex(1) = kindex(1) - nn_hls
+ kindex(1) = kindex(1) - ihls
#if defined DIM_2d || defined DIM_3d /* avoid warning when kindex has 1 element */
- kindex(2) = kindex(2) - nn_hls
+ kindex(2) = kindex(2) - ihls
#endif
ENDIF
diff --git a/src/OCE/LBC/mpp_nfd_generic.h90 b/src/OCE/LBC/mpp_nfd_generic.h90
index fd45035fe4f651ae275d26a3c83f08f2bd192911..237f9b311857c032259e3ae1ab28d68d68914d35 100644
--- a/src/OCE/LBC/mpp_nfd_generic.h90
+++ b/src/OCE/LBC/mpp_nfd_generic.h90
@@ -1,38 +1,39 @@
- SUBROUTINE mpp_nfd_/**/PRECISION( ptab, cd_nat, psgn, kfillmode, pfillval, khls, kfld )
+ SUBROUTINE mpp_nfd_/**/PRECISION( ptab, cd_nat, psgn, kfillmode, pfillval, kfld )
TYPE(PTR_4d_/**/PRECISION), DIMENSION(:), INTENT(inout) :: ptab ! pointer of arrays on which apply the b.c.
- CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: cd_nat ! nature of array grid-points
- REAL(PRECISION), DIMENSION(:), INTENT(in ) :: psgn ! sign used across the north fold boundary
- INTEGER , INTENT(in ) :: kfillmode ! filling method for halo over land
- REAL(PRECISION) , INTENT(in ) :: pfillval ! background value (used at closed boundaries)
- INTEGER , INTENT(in ) :: khls ! halo size, default = nn_hls
- INTEGER , INTENT(in ) :: kfld ! number of pt3d arrays
+ CHARACTER(len=1), DIMENSION(kfld), INTENT(in ) :: cd_nat ! nature of array grid-points
+ REAL(PRECISION), DIMENSION(kfld), INTENT(in ) :: psgn ! sign used across the north fold boundary
+ INTEGER , INTENT(in ) :: kfillmode ! filling method for halo over land
+ REAL(PRECISION) , INTENT(in ) :: pfillval ! background value (used at closed boundaries)
+ INTEGER , INTENT(in ) :: kfld ! number of pt3d arrays
!
LOGICAL :: ll_add_line
INTEGER :: ji, jj, jk, jl, jf, jr, jg, jn ! dummy loop indices
- INTEGER :: ipi, ipj, ipj2, ipk, ipl, ipf ! dimension of the input array
- INTEGER :: ierr, ibuffsize, iis0, iie0, impp
- INTEGER :: ii1, ii2, ij1, ij2, iis, iie, iib, iig, iin
- INTEGER :: i0max
- INTEGER :: ij, iproc, ipni, ijnr
- INTEGER, DIMENSION (:), ALLOCATABLE :: ireq_s, ireq_r ! for mpi_isend when avoiding mpi_allgather
- INTEGER :: ipjtot ! sum of lines for all multi fields
- INTEGER :: i012 ! 0, 1 or 2
- INTEGER , DIMENSION(:,:) , ALLOCATABLE :: ijsnd ! j-position of sent lines for each field
- INTEGER , DIMENSION(:,:) , ALLOCATABLE :: ijbuf ! j-position of send buffer lines for each field
- INTEGER , DIMENSION(:,:) , ALLOCATABLE :: ijrcv ! j-position of recv buffer lines for each field
- INTEGER , DIMENSION(:,:) , ALLOCATABLE :: ii1st, iiend
- INTEGER , DIMENSION(:) , ALLOCATABLE :: ipjfld ! number of sent lines for each field
- REAL(PRECISION), DIMENSION(:,:,:,:) , ALLOCATABLE :: zbufs ! buffer, receive and work arrays
- REAL(PRECISION), DIMENSION(:,:,:,:,:) , ALLOCATABLE :: zbufr ! buffer, receive and work arrays
- REAL(PRECISION), DIMENSION(:,:,:,:,:) , ALLOCATABLE :: znorthloc
- REAL(PRECISION), DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: znorthglo
- TYPE(PTR_4D_/**/PRECISION), DIMENSION(:), ALLOCATABLE :: ztabglo ! array or pointer of arrays on which apply the b.c.
+ INTEGER :: ierr, ibuffsize, impp, ipi0
+ INTEGER :: ii1, ii2, ij1, ij2, ij3, iig, inei
+ INTEGER :: i0max, ilntot, iisht, ijsht, ihsz
+ INTEGER :: iproc, ijnr, ipjtot, iFT, iFU, i012
+ INTEGER, DIMENSION(kfld) :: ipi, ipj, ipj1, ipj2, ipk, ipl ! dimension of the input array
+ INTEGER, DIMENSION(kfld) :: ihls ! halo size
+ INTEGER, DIMENSION(:) , ALLOCATABLE :: ireq_s, ireq_r ! for mpi_isend when avoiding mpi_allgather
+ INTEGER, DIMENSION(:) , ALLOCATABLE :: ipjfld ! number of sent lines for each field
+ REAL(PRECISION) :: zhuge, zztmp
+ REAL(PRECISION), DIMENSION(:,:) , ALLOCATABLE :: zbufs ! buffer, receive and work arrays
+ REAL(PRECISION), DIMENSION(:,:,:), ALLOCATABLE :: zbufr ! buffer, receive and work arrays
+ REAL(PRECISION), DIMENSION(:,:) , ALLOCATABLE :: znorthloc
+ REAL(PRECISION), DIMENSION(:,:,:), ALLOCATABLE :: znorthall
+ TYPE(PTR_4D_/**/PRECISION), DIMENSION(1) :: ztabglo ! array or pointer of arrays on which apply the b.c.
!!----------------------------------------------------------------------
!
- ipk = SIZE(ptab(1)%pt4d,3)
- ipl = SIZE(ptab(1)%pt4d,4)
- ipf = kfld
+ zhuge = HUGE(0._/**/PRECISION) ! avoid to call the huge function inside do loops
+ !
+ DO jf = 1, kfld
+ ipi(jf) = SIZE(ptab(jf)%pt4d,1)
+ ipj(jf) = SIZE(ptab(jf)%pt4d,2)
+ ipk(jf) = SIZE(ptab(jf)%pt4d,3)
+ ipl(jf) = SIZE(ptab(jf)%pt4d,4)
+ ihls(jf) = ( ipi(jf) - Ni_0 ) / 2
+ END DO
!
IF( ln_nnogather ) THEN !== no allgather exchanges ==!
@@ -61,74 +62,43 @@
! also force it if not restart during the first 2 steps (leap frog?)
ll_add_line = l_full_nf_update .OR. ( ncom_stp <= nit000+1 .AND. .NOT. ln_rstart )
- ALLOCATE(ipjfld(ipf)) ! how many lines do we exchange for each field?
+ ALLOCATE(ipjfld(kfld)) ! how many lines do we send for each field?
IF( ll_add_line ) THEN
- DO jf = 1, ipf ! Loop over the number of arrays to be processed
- ipjfld(jf) = khls + COUNT( (/ c_NFtype == 'T' .OR. cd_nat(jf) == 'V' .OR. cd_nat(jf) == 'F' /) )
+ DO jf = 1, kfld ! Loop over the number of arrays to be processed
+ ipjfld(jf) = ihls(jf) + COUNT( (/ c_NFtype == 'T' .OR. cd_nat(jf) == 'V' .OR. cd_nat(jf) == 'F' /) ) &
+ & + COUNT( (/ c_NFtype == 'F' .AND. cd_nat(jf) == 'T' .AND. ihls(jf) == 0 /) )
END DO
ELSE
- ipjfld(:) = khls
+ ipjfld(:) = ihls(:)
ENDIF
-
- ipj = MAXVAL(ipjfld(:)) ! Max 2nd dimension of message transfers
- ipjtot = SUM( ipjfld(:)) ! Total number of lines to be exchanged
-
- ! Index of modifying lines in input
- ALLOCATE( ijsnd(ipj, ipf), ijbuf(ipj, ipf), ijrcv(ipj, ipf), ii1st(ipj, ipf), iiend(ipj, ipf) )
-
- ij1 = 0
- DO jf = 1, ipf ! Loop over the number of arrays to be processed
- !
- DO jj = 1, khls ! first khls lines (starting from top) must be fully defined
- ii1st(jj, jf) = 1
- iiend(jj, jf) = jpi
- END DO
- !
- ! what do we do with line khls+1 (starting from top)
- IF( c_NFtype == 'T' ) THEN ! * North fold T-point pivot
- SELECT CASE ( cd_nat(jf) )
- CASE ('T','W') ; i012 = 1 ; ii1st(khls+1, jf) = mi0(jpiglo/2+2) ; iiend(khls+1, jf) = mi1(jpiglo-khls)
- CASE ('U' ) ; i012 = 1 ; ii1st(khls+1, jf) = mi0(jpiglo/2+1) ; iiend(khls+1, jf) = mi1(jpiglo-khls)
- CASE ('V' ) ; i012 = 2 ; ii1st(khls+1, jf) = 1 ; iiend(khls+1, jf) = jpi
- CASE ('F' ) ; i012 = 2 ; ii1st(khls+1, jf) = 1 ; iiend(khls+1, jf) = jpi
- END SELECT
- ENDIF
- IF( c_NFtype == 'F' ) THEN ! * North fold F-point pivot
- SELECT CASE ( cd_nat(jf) )
- CASE ('T','W') ; i012 = 0 ! we don't touch line khls+1
- CASE ('U' ) ; i012 = 0 ! we don't touch line khls+1
- CASE ('V' ) ; i012 = 1 ; ii1st(khls+1, jf) = mi0(jpiglo/2+1) ; iiend(khls+1, jf) = mi1(jpiglo-khls )
- CASE ('F' ) ; i012 = 1 ; ii1st(khls+1, jf) = mi0(jpiglo/2+1) ; iiend(khls+1, jf) = mi1(jpiglo-khls-1)
- END SELECT
- ENDIF
- !
- DO jj = 1, ipjfld(jf)
- ij1 = ij1 + 1
- ijsnd(jj,jf) = jpj - 2*khls + jj - i012 ! sent lines (from bottom of sent lines)
- ijbuf(jj,jf) = ij1 ! gather all lines in the snd/rcv buffers
- ijrcv(jj,jf) = jpj - jj + 1 ! recv lines (from the top -> reverse order for jj)
- END DO
- !
- END DO
!
- i0max = jpimax - 2 * khls ! we are not sending the halos
- ALLOCATE( zbufs(i0max,ipjtot,ipk,ipl), ireq_s(nfd_nbnei) ) ! store all the data to be sent in a buffer array
- ibuffsize = i0max * ipjtot * ipk * ipl
+ i0max = MAXVAL( nfni_0, mask = nfproc /= -1 ) ! largest value of Ni_0 among processors (we are not sending halos)
+ ilntot = SUM( ipjfld(:) * ipk(:) * ipl(:) )
+ ALLOCATE( zbufs(i0max,ilntot), ireq_s(nfd_nbnei) ) ! store all the data to be sent in a buffer array
+ ibuffsize = i0max * ilntot ! must be the same for all processors -> use i0max
!
! fill the send buffer with all the lines
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk
- DO jj = 1, ipjfld(jf)
- ij1 = ijbuf(jj,jf)
- ij2 = ijsnd(jj,jf)
- DO ji = Nis0, Nie0 ! should not use any other value
- iib = ji - Nis0 + 1
- zbufs(iib,ij1,jk,jl) = ptab(jf)%pt4d(ji,ij2,jk,jl)
- END DO
- DO ji = Ni_0+1, i0max ! avoid sending uninitialized values (make sure we don't use it)
- zbufs(ji,ij1,jk,jl) = HUGE(0._/**/PRECISION) ! make sure we don't use it...
+ ij1 = 0
+ DO jf = 1, kfld
+ !
+ i012 = COUNT( (/ c_NFtype == 'T' /) ) + COUNT( (/ cd_nat(jf) == 'V' .OR. cd_nat(jf) == 'F' /) ) &
+ & + COUNT( (/ ihls(jf) == 0 .AND. cd_nat(jf) == 'T' .AND. c_NFtype == 'F' /) ) ! 0, 1 OR 2
+ ijsht = ipj(jf) - 2*ihls(jf) - i012 ! j-position of the sent lines (from bottom of sent lines)
+ !
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf)
+ DO jj = 1, ipjfld(jf)
+ ij1 = ij1 + 1
+ ij2 = jj + ijsht
+ DO ji = 1, Ni_0 ! use only inner domain
+ ii2 = ji + ihls(jf)
+ zbufs(ji,ij1) = ptab(jf)%pt4d(ii2,ij2,jk,jl)
+ END DO
+ DO ji = Ni_0+1, i0max ! avoid sending uninitialized values and make sure we don't use it
+ zbufs(ji,ij1) = zhuge
+ END DO
END DO
- END DO
- END DO ; END DO ; END DO
+ END DO ; END DO
+ END DO ! jf
!
! start waiting time measurement
IF( ln_timing ) CALL tic_tac(.TRUE.)
@@ -136,68 +106,62 @@
! send the same buffer data to all neighbourgs as soon as possible
DO jn = 1, nfd_nbnei
iproc = nfd_rknei(jn)
- IF( iproc /= narea-1 .AND. iproc /= -1 ) THEN
+ IF( iproc /= narea-1 .AND. iproc /= -1 ) THEN ! it is neither me nor a land-only neighbourg
#if ! defined key_mpi_off
CALL MPI_Isend( zbufs, ibuffsize, MPI_TYPE, iproc, 5, mpi_comm_oce, ireq_s(jn), ierr )
#endif
ELSE
- ireq_s(jn) = MPI_REQUEST_NULL
+ ireq_s(jn) = MPI_REQUEST_NULL ! must be defined for mpi_waitall
ENDIF
END DO
!
- ALLOCATE( zbufr(i0max,ipjtot,ipk,ipl,nfd_nbnei), ireq_r(nfd_nbnei) )
+ ALLOCATE( zbufr(i0max,ilntot,nfd_nbnei), ireq_r(nfd_nbnei) )
!
- DO jn = 1, nfd_nbnei
- !
+ DO jn = 1, nfd_nbnei ! 1st loop: first get data which does not need any communication
+ ! ! -> this gives more time to receive the communications
iproc = nfd_rknei(jn)
!
- IF( iproc == -1 ) THEN ! No neighbour (land proc that was suppressed)
+ IF( iproc == -1 ) THEN ! No neighbour (land-only neighbourg that was suppressed)
!
- ireq_r(jn) = MPI_REQUEST_NULL ! no message to be received
- zbufr(:,:,:,:,jn) = HUGE(0._/**/PRECISION) ! default: define it and make sure we don't use it...
+ ireq_r(jn) = MPI_REQUEST_NULL ! no message to be received, must be defined for mpi_waitall
SELECT CASE ( kfillmode )
CASE ( jpfillnothing ) ! no filling
- CASE ( jpfillcopy ) ! filling with inner domain values
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk
- DO jj = 1, ipjfld(jf)
- ij1 = ijbuf(jj,jf)
- ij2 = ijsnd(jj,jf) ! we will use only the first value, see init_nfdcom
- zbufr(1,ij1,jk,jl,jn) = ptab(jf)%pt4d(Nis0,ij2,jk,jl) ! chose to take the 1st inner domain point
- END DO
- END DO ; END DO ; END DO
+ CASE ( jpfillcopy ) ! filling with my inner domain values
+ ! ! trick: we use only the 1st value, see init_nfdcom
+ zbufr(1,:,jn) = zbufs(1,:) ! chose to take the 1st inner domain point
CASE ( jpfillcst ) ! filling with constant value
- zbufr(1,:,:,:,jn) = pfillval ! we will use only the first value, see init_nfdcom
+ zbufr(1,:,jn) = pfillval ! trick: we use only the 1st value, see init_nfdcom
END SELECT
!
- ELSE IF( iproc == narea-1 ) THEN ! get data from myself!
+ ELSE IF( iproc == narea-1 ) THEN ! I get data from myself!
!
- ireq_r(jn) = MPI_REQUEST_NULL ! no message to be received
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk
- DO jj = 1, ipjfld(jf)
- ij1 = ijbuf(jj,jf)
- ij2 = ijsnd(jj,jf)
- DO ji = Nis0, Nie0 ! should not use any other value
- iib = ji - Nis0 + 1
- zbufr(iib,ij1,jk,jl,jn) = ptab(jf)%pt4d(ji,ij2,jk,jl)
- END DO
- END DO
- END DO ; END DO ; END DO
+ ireq_r(jn) = MPI_REQUEST_NULL ! no message to be received, must be defined for mpi_waitall
+ zbufr(:,:,jn) = zbufs(:,:) ! we can directly do: received buffer = sent buffer!
!
- ELSE ! get data from a neighbour trough communication
+ ENDIF
+ !
+ END DO ! nfd_nbnei
+ !
+ DO jn = 1, nfd_nbnei ! 2nd loop: now get data from a neighbour trough communication
+ !
+ iproc = nfd_rknei(jn)
+ IF( iproc /= narea-1 .AND. iproc /= -1 ) THEN ! it is neither me nor a land-only neighbourg
#if ! defined key_mpi_off
- CALL MPI_Irecv( zbufr(:,:,:,:,jn), ibuffsize, MPI_TYPE, iproc, 5, mpi_comm_oce, ireq_r(jn), ierr )
+ CALL MPI_Irecv( zbufr(:,:,jn), ibuffsize, MPI_TYPE, iproc, 5, mpi_comm_oce, ireq_r(jn), ierr )
#endif
ENDIF
- !
END DO ! nfd_nbnei
!
+#if ! defined key_mpi_off
CALL mpi_waitall(nfd_nbnei, ireq_r, MPI_STATUSES_IGNORE, ierr) ! wait for all Irecv
+#endif
!
IF( ln_timing ) CALL tic_tac(.FALSE.)
!
- ! North fold boundary condition
+ ! Apply the North pole folding
!
- DO jf = 1, ipf
+ ij2 = 0
+ DO jf = 1, kfld
!
SELECT CASE ( cd_nat(jf) ) ! which grid number?
CASE ('T','W') ; iig = 1 ! T-, W-point
@@ -206,76 +170,43 @@
CASE ('F') ; iig = 4 ! F-point
END SELECT
!
- DO jl = 1, ipl ; DO jk = 1, ipk
- !
- ! if T point with F-point pivot : must be done first
- ! --> specific correction of 3 points near the 2 pivots (to be clean, usually masked -> so useless)
- IF( c_NFtype == 'F' .AND. iig == 1 ) THEN
- ij1 = jpj - khls ! j-index in the receiving array
- ij2 = 1 ! only 1 line in the buffer
- DO ji = mi0(khls), mi1(khls) ! change because of EW periodicity as we also change jpiglo-khls
- iib = nfd_jisnd(mi0( khls),iig) ! i-index in the buffer
- iin = nfd_rksnd(mi0( khls),iig) ! neigbhour-index in the buffer
- IF( nfd_rknei(iin) == -1 .AND. kfillmode == jpfillnothing ) CYCLE
- ptab(jf)%pt4d(ji,ij1,jk,jl) = zbufr(iib,ij2,jk,jl,iin) ! no psgn(jf)
- END DO
- DO ji = mi0(jpiglo/2+1), mi1(jpiglo/2+1)
- iib = nfd_jisnd(mi0( jpiglo/2+1),iig) ! i-index in the buffer
- iin = nfd_rksnd(mi0( jpiglo/2+1),iig) ! neigbhour-index in the buffer
- IF( nfd_rknei(iin) == -1 .AND. kfillmode == jpfillnothing ) CYCLE
- ptab(jf)%pt4d(ji,ij1,jk,jl) = zbufr(iib,ij2,jk,jl,iin) ! no psgn(jf)
- END DO
- DO ji = mi0(jpiglo-khls), mi1(jpiglo-khls)
- iib = nfd_jisnd(mi0(jpiglo-khls),iig) ! i-index in the buffer
- iin = nfd_rksnd(mi0(jpiglo-khls),iig) ! neigbhour-index in the buffer
- IF( nfd_rknei(iin) == -1 .AND. kfillmode == jpfillnothing ) CYCLE
- ptab(jf)%pt4d(ji,ij1,jk,jl) = zbufr(iib,ij2,jk,jl,iin) ! no psgn(jf)
- END DO
- ENDIF
+ ihsz = ihls(jf) ! shorter name
+ iisht = nn_hls - ihsz
+ iFT = COUNT( (/ ihsz > 0 .AND. c_NFtype == 'F' .AND. cd_nat(jf) == 'T' /) ) ! F-folding and T grid
+ !
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf)
!
- ! Apply the North pole folding.
- DO jj = 1, ipjfld(jf) ! for all lines to be exchanged for this field
- ij1 = ijrcv(jj,jf) ! j-index in the receiving array
- ij2 = ijbuf(jj,jf) ! j-index in the buffer
- iis = ii1st(jj,jf) ! stating i-index in the receiving array
- iie = iiend(jj,jf) ! ending i-index in the receiving array
- DO ji = iis, iie
- iib = nfd_jisnd(ji,iig) ! i-index in the buffer
- iin = nfd_rksnd(ji,iig) ! neigbhour-index in the buffer
- IF( nfd_rknei(iin) == -1 .AND. kfillmode == jpfillnothing ) CYCLE
- ptab(jf)%pt4d(ji,ij1,jk,jl) = psgn(jf) * zbufr(iib,ij2,jk,jl,iin)
+ DO jj = 1,ihsz ! NP folding for the last ihls(jf) lines of this field
+ ij1 = ipj(jf) - jj + 1 ! j-index in the receiving array (from the top -> reverse order for jj)
+ ij2 = ij2 + 1
+ ij3 = ihsz+1 - jj + 1
+ DO ji = 1, ipi(jf)
+ ii1 = ji + iisht
+ inei = nfd_rksnd(ii1,ij3,iig) ! neigbhour-index in the buffer
+ IF( nfd_rknei(inei) == -1 .AND. kfillmode == jpfillnothing ) CYCLE ! no neighbourg and do nothing to fill
+ ii2 = nfd_jisnd(ii1,ij3,iig) ! i-index in the buffer, starts at 1 in the inner domain
+ ptab(jf)%pt4d(ji,ij1,jk,jl) = psgn(jf) * zbufr(ii2,ij2,inei)
END DO
END DO
- !
- ! re-apply periodocity when we modified the eastern side of the inner domain (and not the full line)
- IF( c_NFtype == 'T' ) THEN ! * North fold T-point pivot
- IF( iig <= 2 ) THEN ; iis = mi0(1) ; iie = mi1(khls) ! 'T','W','U': update west halo
- ELSE ; iis = 1 ; iie = 0 ! 'V','F' : full line already exchanged
- ENDIF
- ENDIF
- IF( c_NFtype == 'F' ) THEN ! * North fold F-point pivot
- IF( iig <= 2 ) THEN ; iis = 1 ; iie = 0 ! 'T','W','U': nothing to do
- ELSEIF( iig == 3 ) THEN ; iis = mi0(1) ; iie = mi1(khls) ! 'V' : update west halo
- ELSEIF( khls > 1 ) THEN ; iis = mi0(1) ; iie = mi1(khls-1) ! 'F' and khls > 1
- ELSE ; iis = 1 ; iie = 0 ! 'F' and khls == 1 : nothing to do
- ENDIF
- ENDIF
- jj = ipjfld(jf) ! only for the last line of this field
- ij1 = ijrcv(jj,jf) ! j-index in the receiving array
- ij2 = ijbuf(jj,jf) ! j-index in the buffer
- DO ji = iis, iie
- iib = nfd_jisnd(ji,iig) ! i-index in the buffer
- iin = nfd_rksnd(ji,iig) ! neigbhour-index in the buffer
- IF( nfd_rknei(iin) == -1 .AND. kfillmode == jpfillnothing ) CYCLE
- ptab(jf)%pt4d(ji,ij1,jk,jl) = psgn(jf) * zbufr(iib,ij2,jk,jl,iin)
+ DO jj = ihsz+1, ipjfld(jf)+iFT ! NP folding for line ipj-ihsz that can be partially modified
+ ij1 = ipj(jf) - jj + 1 ! j-index in the receiving array (from the top -> reverse order for jj)
+ ij2 = ij2 + 1 - iFT
+ ij3 = 1
+ DO ji = 1, ipi(jf)
+ ii1 = ji + iisht
+ IF( lnfd_same(ii1,iig) ) CYCLE ! do nothing if should not be modified
+ inei = nfd_rksnd(ii1,ij3,iig) ! neigbhour-index in the buffer
+ IF( nfd_rknei(inei) == -1 .AND. kfillmode == jpfillnothing ) CYCLE ! no neighbourg and do nothing to fill
+ ii2 = nfd_jisnd(ii1,ij3,iig) ! i-index in the buffer, starts at 1 in the inner domain
+ ptab(jf)%pt4d(ji,ij1,jk,jl) = psgn(jf) * zbufr(ii2,ij2,inei)
+ END DO
END DO
!
- END DO ; END DO ! ipl ; ipk
+ END DO ; END DO ! jk ; jl
!
- END DO ! ipf
-
+ END DO ! jf
!
- DEALLOCATE( zbufr, ireq_r, ijsnd, ijbuf, ijrcv, ii1st, iiend, ipjfld )
+ DEALLOCATE( zbufr, ireq_r, ipjfld )
!
CALL mpi_waitall(nfd_nbnei, ireq_s, MPI_STATUSES_IGNORE, ierr) ! wait for all Isend
!
@@ -283,114 +214,128 @@
!
ELSE !== allgather exchanges ==!
!
- ! how many lines do we exchange at max? -> ipj (no further optimizations in this case...)
- ipj = khls + 2
- ! how many lines do we need at max? -> ipj2 (no further optimizations in this case...)
- ipj2 = 2 * khls + 2
+ DO jf = 1, kfld
+ ! how many lines do we send for each field?
+ ipj1(jf) = ihls(jf) + COUNT( (/ c_NFtype == 'T' .OR. cd_nat(jf) == 'V' .OR. cd_nat(jf) == 'F' /) ) &
+ & + COUNT( (/ c_NFtype == 'F' .AND. cd_nat(jf) == 'T' .AND. ihls(jf) == 0 /) )
+ ! how many lines do we need for each field?
+ ipj2(jf) = 2 * ihls(jf) + COUNT( (/ c_NFtype == 'T' /) ) + COUNT( (/ cd_nat(jf) == 'V' .OR. cd_nat(jf) == 'F' /) ) &
+ & + COUNT( (/ c_NFtype == 'F' .AND. cd_nat(jf) == 'T' .AND. ihls(jf) == 0 /) )
+ END DO
!
- i0max = jpimax - 2 * khls
- ibuffsize = i0max * ipj * ipk * ipl * ipf
- ALLOCATE( znorthloc(i0max,ipj,ipk,ipl,ipf), znorthglo(i0max,ipj,ipk,ipl,ipf,ndim_rank_north) )
+ i0max = MAXVAL( nfni_0, mask = nfproc /= -1 ) ! largest value of Ni_0 among processors (we are not sending halos)
+ ibuffsize = i0max * SUM( ipj1(:) * ipk(:) * ipl(:) ) ! use i0max because each proc must have the same buffer size
+ ALLOCATE( znorthloc(i0max, ibuffsize/i0max), znorthall(i0max, ibuffsize/i0max, ndim_rank_north) )
!
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ! put in znorthloc ipj j-lines of ptab
- DO jj = 1, ipj
- ij2 = jpj - ipj2 + jj ! the first ipj lines of the last ipj2 lines
+ ij1 = 0 ! initalize line index
+ DO jf = 1, kfld ; DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf)
+ DO jj = 1, ipj1(jf) ! put in znorthloc ipj1(jf) j-lines of ptab
+ ij2 = ipj(jf) - ipj2(jf) + jj ! the first ipj1 lines of the last ipj2 lines
+ ij1 = ij1 + 1
DO ji = 1, Ni_0
- ii2 = Nis0 - 1 + ji ! inner domain: Nis0 to Nie0
- znorthloc(ji,jj,jk,jl,jf) = ptab(jf)%pt4d(ii2,ij2,jk,jl)
+ ii2 = ihls(jf) + ji ! copy only the inner domain
+ znorthloc(ji,ij1) = ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = Ni_0+1, i0max
- znorthloc(ji,jj,jk,jl,jf) = HUGE(0._/**/PRECISION) ! avoid sending uninitialized values (make sure we don't use it)
+ DO ji = Ni_0+1, i0max ! avoid to send uninitialized values
+ znorthloc(ji,ij1) = zhuge ! and make sure we don't use it
END DO
END DO
END DO ; END DO ; END DO
!
! start waiting time measurement
- IF( ln_timing ) CALL tic_tac(.TRUE.)
#if ! defined key_mpi_off
- CALL MPI_ALLGATHER( znorthloc, ibuffsize, MPI_TYPE, znorthglo, ibuffsize, MPI_TYPE, ncomm_north, ierr )
+ IF( ln_timing ) CALL tic_tac( .TRUE.) ! start waiting time measurement
+ ! fill znorthall with the znorthloc of each northern process
+ CALL MPI_ALLGATHER( znorthloc, ibuffsize, MPI_TYPE, znorthall, ibuffsize, MPI_TYPE, ncomm_north, ierr )
+ IF( ln_timing ) CALL tic_tac(.FALSE.) ! stop waiting time measurement
#endif
- ! stop waiting time measurement
- IF( ln_timing ) CALL tic_tac(.FALSE.)
- DEALLOCATE( znorthloc )
- ALLOCATE( ztabglo(ipf) )
- DO jf = 1, ipf
- ALLOCATE( ztabglo(jf)%pt4d(jpiglo,ipj2,ipk,ipl) )
- END DO
+ DEALLOCATE( znorthloc ) ! no more need of znorthloc
!
- ! need to fill only the first ipj lines of ztabglo as lbc_nfd don't use the last khls lines
- ijnr = 0
- DO jr = 1, jpni ! recover the global north array
- iproc = nfproc(jr)
- impp = nfimpp(jr)
- ipi = nfjpi( jr) - 2 * khls ! corresponds to Ni_0 but for subdomain iproc
- IF( iproc == -1 ) THEN ! No neighbour (land proc that was suppressed)
- !
- SELECT CASE ( kfillmode )
- CASE ( jpfillnothing ) ! no filling
- CALL ctl_stop( 'STOP', 'mpp_nfd_generic : cannot use jpfillnothing with ln_nnogather = F')
- CASE ( jpfillcopy ) ! filling with inner domain values
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk
- DO jj = 1, ipj
- ij2 = jpj - ipj2 + jj ! the first ipj lines of the last ipj2 lines
- DO ji = 1, ipi
- ii1 = impp + khls + ji - 1 ! corresponds to mig(khls + ji) but for subdomain iproc
- ztabglo(jf)%pt4d(ii1,jj,jk,jl) = ptab(jf)%pt4d(Nis0,ij2,jk,jl) ! chose to take the 1st inner domain point
+ DO jf = 1, kfld
+ !
+ ihsz = ihls(jf) ! shorter name
+ iisht = nn_hls - ihsz
+ ALLOCATE( ztabglo(1)%pt4d(Ni0glo+2*ihsz,ipj2(jf),ipk(jf),ipl(jf)) )
+ !
+ iFU = COUNT( (/ c_NFtype == 'F' .AND. cd_nat(jf) == 'U' /) ) ! F-folding and U grid
+ IF( iFU == 0 ) ztabglo(1)%pt4d(:,ipj2(jf)-ihsz,:,:) = zhuge ! flag off the line that is not fully modified
+ !
+ ! need to fill only the first ipj1(j) lines of ztabglo as lbc_nfd don't use the last ihsz lines
+ ijnr = 0
+ DO jr = 1, jpni ! recover the global north array using each northern process
+ iproc = nfproc(jr) ! process number
+ impp = nfimpp(jr) + ihsz ! ( = +nn_hls-iisht) ! inner domain position (without halos) of subdomain iproc
+ ipi0 = nfni_0(jr) ! Ni_0 but for subdomain iproc
+ !
+ IF( iproc == -1 ) THEN ! No neighbour (land proc that was suppressed)
+ !
+ SELECT CASE ( kfillmode )
+ CASE ( jpfillnothing ) ! no filling
+ CALL ctl_stop( 'STOP', 'mpp_nfd_generic : cannot use jpfillnothing with ln_nnogather = F')
+ CASE ( jpfillcopy ) ! filling with inner domain values
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf)
+ DO jj = 1, ipj1(jf)
+ ij2 = ipj(jf) - ipj2(jf) + jj ! the first ipj1(jf) lines of the last ipj2(jf) lines
+ DO ji = 1, ipi0
+ ii1 = impp + ji - 1 ! inner iproc-subdomain in the global domain with ihsz halos
+ ztabglo(1)%pt4d(ii1,jj,jk,jl) = ptab(jf)%pt4d(ihsz+1,ij2,jk,jl) ! take the 1st inner domain point
+ END DO
END DO
- END DO
- END DO ; END DO ; END DO
- CASE ( jpfillcst ) ! filling with constant value
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk
- DO jj = 1, ipj
- DO ji = 1, ipi
- ii1 = impp + khls + ji - 1 ! corresponds to mig(khls + ji) but for subdomain iproc
- ztabglo(jf)%pt4d(ii1,jj,jk,jl) = pfillval
+ END DO ; END DO
+ CASE ( jpfillcst ) ! filling with constant value
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf)
+ DO jj = 1, ipj1(jf)
+ DO ji = 1, ipi0
+ ii1 = impp + ji - 1 ! inner iproc-subdomain in the global domain with ihsz halos
+ ztabglo(1)%pt4d(ii1,jj,jk,jl) = pfillval
+ END DO
+ END DO
+ END DO ; END DO
+ END SELECT
+ !
+ ELSE ! use neighbour values
+ ijnr = ijnr + 1
+ ij1 = SUM( ipj1(1:jf-1) * ipk(1:jf-1) * ipl(1:jf-1) ) ! reset line offset, return 0 if jf = 1
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf)
+ DO jj = 1, ipj1(jf)
+ ij1 = ij1 + 1
+ DO ji = 1, ipi0
+ ii1 = impp + ji - 1 ! inner iproc-subdomain in the global domain with ihsz halos
+ ztabglo(1)%pt4d(ii1,jj,jk,jl) = znorthall(ji, ij1, ijnr)
END DO
END DO
- END DO ; END DO ; END DO
- END SELECT
+ END DO ; END DO
+ ENDIF
!
- ELSE
- ijnr = ijnr + 1
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk
- DO jj = 1, ipj
- DO ji = 1, ipi
- ii1 = impp + khls + ji - 1 ! corresponds to mig(khls + ji) but for subdomain iproc
- ztabglo(jf)%pt4d(ii1,jj,jk,jl) = znorthglo(ji,jj,jk,jl,jf,ijnr)
- END DO
- END DO
- END DO ; END DO ; END DO
- ENDIF
+ END DO ! jpni
!
- END DO ! jpni
- DEALLOCATE( znorthglo )
- !
- DO jf = 1, ipf
- CALL lbc_nfd( ztabglo(jf:jf), cd_nat(jf:jf), psgn(jf:jf), khls, 1 ) ! North fold boundary condition
- DO jl = 1, ipl ; DO jk = 1, ipk ! e-w periodicity
- DO jj = 1, khls + 1
- ij1 = ipj2 - (khls + 1) + jj ! need only the last khls + 1 lines until ipj2
- ztabglo(jf)%pt4d( 1: khls,ij1,jk,jl) = ztabglo(jf)%pt4d(jpiglo-2*khls+1:jpiglo-khls,ij1,jk,jl)
- ztabglo(jf)%pt4d(jpiglo-khls+1:jpiglo,ij1,jk,jl) = ztabglo(jf)%pt4d( khls+1: 2*khls,ij1,jk,jl)
+ CALL lbc_nfd( ztabglo, cd_nat(jf:jf), psgn(jf:jf), 1 ) ! North fold boundary condition
+ !
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf) ! Scatter back to ARRAY_IN
+ DO jj = 0, ihsz-1
+ ij1 = ipj( jf) - jj ! last ihsz lines
+ ij2 = ipj2(jf) - jj ! last ihsz lines
+ DO ji= 1, ipi(jf)
+ ii2 = mig(ji+iisht,ihsz) ! warning, mig is expecting local domain indices related to nn_hls
+ ptab(jf)%pt4d(ji,ij1,jk,jl) = ztabglo(1)%pt4d(ii2,ij2,jk,jl)
+ END DO
END DO
- END DO ; END DO
- END DO
- !
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ! Scatter back to ARRAY_IN
- DO jj = 1, khls + 1
- ij1 = jpj - (khls + 1) + jj ! last khls + 1 lines until jpj
- ij2 = ipj2 - (khls + 1) + jj ! last khls + 1 lines until ipj2
- DO ji= 1, jpi
- ii2 = mig(ji)
- ptab(jf)%pt4d(ji,ij1,jk,jl) = ztabglo(jf)%pt4d(ii2,ij2,jk,jl)
+ DO jj = ihsz, ihsz - iFU
+ ij1 = ipj( jf) - jj ! last ihsz+1 line
+ ij2 = ipj2(jf) - jj ! last ihsz+1 line
+ DO ji= 1, ipi(jf)
+ ii2 = mig(ji+iisht,ihsz) ! warning, mig is expecting local domain indices related to nn_hls
+ zztmp = ztabglo(1)%pt4d(ii2,ij2,jk,jl)
+ IF( zztmp /= zhuge ) ptab(jf)%pt4d(ji,ij1,jk,jl) = zztmp ! apply it only if it was modified by lbc_nfd
+ END DO
END DO
- END DO
- END DO ; END DO ; END DO
+ END DO ; END DO
+ !
+ DEALLOCATE( ztabglo(1)%pt4d )
+ !
+ END DO ! jf
!
- DO jf = 1, ipf
- DEALLOCATE( ztabglo(jf)%pt4d )
- END DO
- DEALLOCATE( ztabglo )
+ DEALLOCATE( znorthall )
!
ENDIF ! ln_nnogather
!
diff --git a/src/OCE/LBC/mppini.F90 b/src/OCE/LBC/mppini.F90
index b59af288e1545ea837104ce5a061db1ccdbba424..a3d3de962d9439f100f323995546d9a82cc6052c 100644
--- a/src/OCE/LBC/mppini.F90
+++ b/src/OCE/LBC/mppini.F90
@@ -70,7 +70,8 @@ CONTAINS
jpi = jpiglo
jpj = jpjglo
jpk = MAX( 2, jpkglo )
- jpij = jpi*jpj
+ !jpij = jpi*jpj
+ jpij = Ni0glo*Nj0glo
jpni = 1
jpnj = 1
jpnij = jpni*jpnj
@@ -165,6 +166,10 @@ CONTAINS
902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nammpp in configuration namelist' )
!
nn_hls = MAX(1, nn_hls) ! nn_hls must be > 0
+# if defined key_mpi2
+ WRITE(numout,*) ' use key_mpi2, we force nn_comm = 1'
+ nn_comm = 1
+# endif
IF(lwp) THEN
WRITE(numout,*) ' Namelist nammpp'
IF( jpni < 1 .OR. jpnj < 1 ) THEN
@@ -303,7 +308,7 @@ CONTAINS
9002 FORMAT (a, i4, a)
9003 FORMAT (a, i5)
- ALLOCATE( nfimpp(jpni), nfproc(jpni), nfjpi(jpni), &
+ ALLOCATE( nfimpp(jpni), nfproc(jpni), nfjpi(jpni), nfni_0(jpni), &
& iin(jpnij), ijn(jpnij), &
& iimppt(jpni,jpnj), ijmppt(jpni,jpnj), ijpi(jpni,jpnj), ijpj(jpni,jpnj), ipproc(jpni,jpnj), &
& inei(8,jpni,jpnj), llnei(8,jpni,jpnj), &
@@ -327,7 +332,8 @@ CONTAINS
jpi = ijpi(ii,ij)
jpj = ijpj(ii,ij)
jpk = MAX( 2, jpkglo )
- jpij = jpi*jpj
+ !jpij = jpi*jpj
+ jpij = (jpi-2*nn_hls)*(jpj-2*nn_hls)
nimpp = iimppt(ii,ij)
njmpp = ijmppt(ii,ij)
!
@@ -375,7 +381,8 @@ CONTAINS
! Store informations for the north pole folding communications
nfproc(:) = ipproc(:,jpnj)
nfimpp(:) = iimppt(:,jpnj)
- nfjpi (:) = ijpi(:,jpnj)
+ nfjpi (:) = ijpi(:,jpnj) ! needed only for mpp_lbc_north_icb_generic.h90
+ nfni_0(:) = ijpi(:,jpnj) - 2 * nn_hls
!
! 3. Define Western, Eastern, Southern and Northern neighbors + corners in the subdomain grid reference
! ------------------------------------------------------------------------------------------------------
@@ -490,7 +497,7 @@ CONTAINS
!
! set default neighbours
mpinei(:) = impi(:,narea) ! should be just local but is still used in icblbc and mpp_lnk_icb_generic.h90...
- mpiSnei(0,:) = -1 ! no comm if no halo (but need it for NP Folding
+ mpiSnei(0,:) = -1 ! no comm if no halo (but still need to call the NP Folding that may modify the last line)
mpiRnei(0,:) = -1
DO jh = 1, n_hlsmax
mpiSnei(jh,:) = impi(:,narea) ! default definition
@@ -518,6 +525,7 @@ CONTAINS
!
! ! Prepare mpp north fold
!
+ l_NFold = l_NFold .AND. ANY( nfproc /= -1 ) ! make sure that we kept at least 1 proc along the last line
llmpiNFold = jpni > 1 .AND. l_NFold ! is the North fold done with an MPI communication?
l_IdoNFold = ijn(narea) == jpnj .AND. l_NFold ! is this process doing North fold?
!
@@ -1181,7 +1189,7 @@ CONTAINS
!
ALLOCATE( zmsk0(ipi,ipj), zmsk(ipi,ipj) )
zmsk0(jh+1:jh+Ni_0,jh+1:jh+Nj_0) = REAL(COUNT(lloce, dim = 3), wp) ! define inner domain -> need REAL to use lbclnk
- CALL lbc_lnk('mppini', zmsk0, 'T', 1._wp, khls = jh) ! fill halos
+ CALL lbc_lnk( ' mppini', zmsk0, 'T', 1._wp ) ! fill halos
! Beware about the mask we must use here :
DO jj = jh+1, jh+Nj_0
DO ji = jh+1, jh+Ni_0
@@ -1194,7 +1202,7 @@ CONTAINS
& + zmsk0(ji+1,jj) + zmsk0(ji,jj+1) + zmsk0(ji+1,jj+1)
END DO
END DO
- CALL lbc_lnk('mppini', zmsk, 'T', 1._wp, khls = jh) ! fill halos again!
+ CALL lbc_lnk( 'mppini', zmsk, 'T', 1._wp ) ! fill halos again!
!
iiwe = jh ; iiea = Ni_0 ! bottom-left corner - 1 of the sent data
ijso = jh ; ijno = Nj_0
@@ -1267,7 +1275,7 @@ ENDIF
! used in IOM. This works even if jpnij .ne. jpni*jpnj.
iglo( :) = (/ Ni0glo, Nj0glo /)
iloc( :) = (/ Ni_0 , Nj_0 /)
- iabsf(:) = (/ Nis0 , Njs0 /) + (/ nimpp, njmpp /) - 1 - nn_hls ! corresponds to mig0(Nis0) but mig0 is not yet defined!
+ iabsf(:) = (/ Nis0 , Njs0 /) + (/ nimpp, njmpp /) - 1 - nn_hls ! corresponds to mig(Nis0,0) but mig is not yet defined!
iabsl(:) = iabsf(:) + iloc(:) - 1
ihals(:) = (/ 0 , 0 /)
ihale(:) = (/ 0 , 0 /)
@@ -1302,10 +1310,10 @@ ENDIF
INTEGER, INTENT(in ) :: knum ! layout.dat unit
!
REAL(wp), DIMENSION(jpi,jpj,2,4) :: zinfo
- INTEGER , DIMENSION(10) :: irknei ! too many elements but safe...
+ INTEGER , DIMENSION(0:10) :: irknei ! too many elements but safe...
INTEGER :: ji, jj, jg, jn ! dummy loop indices
INTEGER :: iitmp
- LOGICAL :: lnew
+ LOGICAL :: llnew
!!----------------------------------------------------------------------
!
IF (lwp) THEN
@@ -1319,29 +1327,28 @@ ENDIF
WRITE(knum,*)
WRITE(knum,*)
WRITE(knum,*) 'Number of subdomains located along the north fold : ', ndim_rank_north
- WRITE(knum,*) 'Rank of the subdomains located along the north fold : ', ndim_rank_north
+ WRITE(knum,*) 'Rank of the subdomains located along the north fold : '
DO jn = 1, ndim_rank_north, 5
WRITE(knum,*) nrank_north( jn:MINVAL( (/jn+4,ndim_rank_north/) ) )
END DO
ENDIF
- nfd_nbnei = 0 ! defaul def (useless?)
+ nfd_nbnei = 0 ! default def (useless?)
IF( ln_nnogather ) THEN
!
! Use the "gather nfd" to know how to do the nfd: for ji point, which process send data from which of its ji-index?
! Note that nfd is perfectly symetric: I receive data from X <=> I send data to X (-> no deadlock)
!
- zinfo(:,:,:,:) = HUGE(0._wp) ! default def to make sure we don't use the halos
- DO jg = 1, 4 ! grid type: T, U, V, F
+ DO jg = 1, 4 ! grid type: T, U, V, F
DO jj = nn_hls+1, jpj-nn_hls ! inner domain (warning do_loop_substitute not yet defined)
DO ji = nn_hls+1, jpi-nn_hls ! inner domain (warning do_loop_substitute not yet defined)
- zinfo(ji,jj,1,jg) = REAL(narea, wp) ! mpi_rank + 1 (as default lbc_lnk fill is 0
+ zinfo(ji,jj,1,jg) = REAL(narea, wp) ! mpi_rank + 1 (note: lbc_lnk will put 0 if no neighbour)
zinfo(ji,jj,2,jg) = REAL(ji, wp) ! ji of this proc
END DO
END DO
END DO
!
- ln_nnogather = .FALSE. ! force "classical" North pole folding to fill all halos -> should be no more HUGE values...
+ ln_nnogather = .FALSE. ! force "classical" North pole folding to fill all halos
CALL lbc_lnk( 'mppini', zinfo(:,:,:,1), 'T', 1._wp ) ! Do 4 calls instead of 1 to save memory as the nogather version
CALL lbc_lnk( 'mppini', zinfo(:,:,:,2), 'U', 1._wp ) ! creates buffer arrays with jpiglo as the first dimension
CALL lbc_lnk( 'mppini', zinfo(:,:,:,3), 'V', 1._wp ) !
@@ -1350,24 +1357,52 @@ ENDIF
IF( l_IdoNFold ) THEN ! only the procs involed in the NFD must take care of this
- ALLOCATE( nfd_rksnd(jpi,4), nfd_jisnd(jpi,4) ) ! neighbour rand and remote ji-index for each grid (T, U, V, F)
- nfd_rksnd(:,:) = NINT( zinfo(:, jpj, 1, :) ) - 1 ! neighbour MPI rank
- nfd_jisnd(:,:) = NINT( zinfo(:, jpj, 2, :) ) - nn_hls ! neighbour ji index (shifted as we don't send the halos)
- WHERE( nfd_rksnd == -1 ) nfd_jisnd = 1 ! use ji=1 if no neighbour, see mpp_nfd_generic.h90
-
- nfd_nbnei = 1 ! Number of neighbour sending data for the nfd. We have at least 1 neighbour!
- irknei(1) = nfd_rksnd(1,1) ! which is the 1st one (I can be neighbour of myself, exclude land-proc are also ok)
+ ALLOCATE( nfd_rksnd(jpi,nn_hls+1,4), nfd_jisnd(jpi,nn_hls+1,4), lnfd_same(jpi,4) )
+ nfd_rksnd(:,:,:) = NINT( zinfo(:,jpj-nn_hls:jpj,1,:) ) - 1 ! neighbour MPI rank (-1 means no neighbour)
+ ! Use some tricks for mpp_nfd_generic.h90:
+ ! 1) neighbour ji index (shifted as we don't send the halos)
+ nfd_jisnd(:,:,:) = NINT( zinfo(:,jpj-nn_hls:jpj,2,:) ) - nn_hls
+ ! 2) use ji=1 if no neighbour
+ WHERE( nfd_rksnd == -1 ) nfd_jisnd = 1
+ ! 3) control which points must be modified by the NP folding on line jpjglo-nn_hls
+ lnfd_same(:,:) = .TRUE.
+ IF( c_NFtype == 'T' ) THEN
+ lnfd_same(mi0(jpiglo/2+2,nn_hls):mi1(jpiglo-nn_hls,nn_hls), 1) = .FALSE.
+ lnfd_same(mi0(jpiglo/2+1,nn_hls):mi1(jpiglo-nn_hls,nn_hls), 2) = .FALSE.
+ lnfd_same(mi0( nn_hls+1,nn_hls):mi1(jpiglo-nn_hls,nn_hls),3:4) = .FALSE.
+ IF( l_Iperio ) THEN ! in case the ew-periodicity was done before calling the NP folding
+ lnfd_same(mi0( 1,nn_hls):mi1(nn_hls,nn_hls),1:4) = .FALSE.
+ lnfd_same(mi0(jpiglo-nn_hls+1,nn_hls):mi1(jpiglo,nn_hls),3:4) = .FALSE.
+ ENDIF
+ ELSEIF( c_NFtype == 'F' ) THEN
+ lnfd_same(mi0(jpiglo/2+1 ,nn_hls):mi1(jpiglo/2+1 ,nn_hls),1) = .FALSE.
+ lnfd_same(mi0(jpiglo-nn_hls,nn_hls):mi1(jpiglo-nn_hls ,nn_hls),1) = .FALSE.
+ lnfd_same(mi0(jpiglo/2+1 ,nn_hls):mi1(jpiglo-nn_hls ,nn_hls),3) = .FALSE.
+ lnfd_same(mi0(jpiglo/2+1 ,nn_hls):mi1(jpiglo-nn_hls-1,nn_hls),4) = .FALSE.
+ IF( l_Iperio ) THEN ! in case the ew-periodicity was done before calling the NP folding
+ lnfd_same(mi0(nn_hls,nn_hls):mi1(nn_hls ,nn_hls),1) = .FALSE.
+ lnfd_same(mi0( 1,nn_hls):mi1(nn_hls ,nn_hls),3) = .FALSE.
+ IF( nn_hls > 1 ) lnfd_same(mi0( 1,nn_hls):mi1(nn_hls-1,nn_hls),4) = .FALSE.
+ ENDIF
+ ENDIF
+ WHERE( lnfd_same ) nfd_jisnd(:,1,:) = HUGE(0) ! make sure we dont use it
+
+ nfd_nbnei = 0
+ irknei(0) = HUGE(0)
DO jg = 1, 4
- DO ji = 1, jpi ! we must be able to fill the full line including halos
- lnew = .TRUE. ! new neighbour?
- DO jn = 1, nfd_nbnei
- IF( irknei(jn) == nfd_rksnd(ji,jg) ) lnew = .FALSE. ! already found
+ DO jj = 1, nn_hls+1
+ DO ji = 1, jpi ! we must be able to fill the full line including halos
+ IF( jj == 1 .AND. lnfd_same(ji,jg) ) CYCLE
+ llnew = .TRUE. ! new neighbour?
+ DO jn = 0, nfd_nbnei
+ IF( irknei(jn) == nfd_rksnd(ji,jj,jg) ) llnew = .FALSE. ! already found
+ END DO
+ IF( llnew ) THEN
+ jn = nfd_nbnei + 1
+ nfd_nbnei = jn
+ irknei(jn) = nfd_rksnd(ji,jj,jg)
+ ENDIF
END DO
- IF( lnew ) THEN
- jn = nfd_nbnei + 1
- nfd_nbnei = jn
- irknei(jn) = nfd_rksnd(ji,jg)
- ENDIF
END DO
END DO
@@ -1375,14 +1410,20 @@ ENDIF
nfd_rknei(:) = irknei(1:nfd_nbnei)
! re-number nfd_rksnd according to the indexes of nfd_rknei
DO jg = 1, 4
- DO ji = 1, jpi
- iitmp = nfd_rksnd(ji,jg) ! must store a copy of nfd_rksnd(ji,jg) to make sure we don't change it twice
- DO jn = 1, nfd_nbnei
- IF( iitmp == nfd_rknei(jn) ) nfd_rksnd(ji,jg) = jn
+ DO jj = 1, nn_hls+1
+ DO ji = 1, jpi
+ IF( jj == 1 .AND. lnfd_same(ji,jg) ) THEN
+ nfd_rksnd(ji,jj,jg) = HUGE(0) ! make sure we don't use it
+ ELSE
+ iitmp = nfd_rksnd(ji,jj,jg) ! must store a copy of nfd_rksnd(ji,jj,jg) so we don't change it twice
+ DO jn = 1, nfd_nbnei
+ IF( iitmp == nfd_rknei(jn) ) nfd_rksnd(ji,jj,jg) = jn
+ END DO
+ ENDIF
END DO
END DO
END DO
-
+
IF( ldwrtlay ) THEN
WRITE(knum,*)
WRITE(knum,*) 'north fold exchanges with explicit point-to-point messaging :'
@@ -1437,38 +1478,74 @@ ENDIF
!!
!! ** Method :
!!
- !! ** Action : - mig , mjg : local domain indices ==> global domain, including halos, indices
- !! - mig0, mjg0: local domain indices ==> global domain, excluding halos, indices
+ !! Local domain indices: Same values for the same point, different upper/lower bounds
+ !! e.g. with nn_hls = 2
+ !! jh = 0 x,x,3,...,jpi-2, x, x
+ !! jh = 1 x,2,3,...,jpi-2,jpi-1, x
+ !! jh = 2 1,2,3,...,jpi-2,jpi-1,jpi
+ !!
+ !! or jh = 0 x,x,3,...,Ni_0+2, x, x
+ !! jh = 1 x,2,3,...,Ni_0+2,Ni_0+3, x
+ !! jh = 2 1,2,3,...,Ni_0+2,Ni_0+3,Ni_0+4
+ !!
+ !! Global domain indices: different values for the same point, all starts at 1
+ !! e.g. with nn_hls = 2
+ !! jh = 0 1,2,3, ...,jpiglo-4, x, x,x,x
+ !! jh = 1 1,2,3, ...,jpiglo-4,jpiglo-3,jpiglo-2, x,x
+ !! jh = 2 1,2,3,...,jpiglo-4,jpiglo-3,jpiglo-2,jpiglo-1,jpiglo
+ !!
+ !! or jh = 0 1,2,3, ...,Ni0glo , x, x,x,x
+ !! jh = 1 1,2,3, ...,Ni0glo ,Ni0glo+1,Ni0glo+2, x,x
+ !! jh = 2 1,2,3,...,Ni0glo,Ni0glo+1,Ni0glo+2,Ni0glo+3,Ni0glo+4
+ !! ^
+ !! |
+ !! |
+ !! iimpp
+ !!
+ !! ** Action : - mig , mjg : local domain indices ==> global domain indices
!! - mi0 , mi1 : global domain indices ==> local domain indices
!! - mj0 , mj1 (if global point not in the local domain ==> mi0>mi1 and/or mj0>mj1)
!!----------------------------------------------------------------------
- INTEGER :: ji, jj ! dummy loop argument
+ INTEGER :: ji, jj, jh ! dummy loop argument
+ INTEGER :: ipi, ipj, ipiglo, ipjglo, iimpp, ijmpp, ishft
!!----------------------------------------------------------------------
!
- ALLOCATE( mig(jpi), mjg(jpj), mig0(jpi), mjg0(jpj) )
- ALLOCATE( mi0(jpiglo), mi1(jpiglo), mj0(jpjglo), mj1(jpjglo) )
+ ALLOCATE( mig(jpi , 0:nn_hls), mjg(jpj , 0:nn_hls) )
+ ALLOCATE( mi0(jpiglo, 0:nn_hls), mi1(jpiglo, 0:nn_hls), mj0(jpjglo, 0:nn_hls), mj1(jpjglo, 0:nn_hls) )
!
- DO ji = 1, jpi ! local domain indices ==> global domain indices, including halos
- mig(ji) = ji + nimpp - 1
- END DO
- DO jj = 1, jpj
- mjg(jj) = jj + njmpp - 1
- END DO
- ! ! local domain indices ==> global domain indices, excluding halos
- !
- mig0(:) = mig(:) - nn_hls
- mjg0(:) = mjg(:) - nn_hls
- ! ! global domain, including halos, indices ==> local domain indices
- ! ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the
- ! ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.
- DO ji = 1, jpiglo
- mi0(ji) = MAX( 1 , MIN( ji - nimpp + 1, jpi+1 ) )
- mi1(ji) = MAX( 0 , MIN( ji - nimpp + 1, jpi ) )
- END DO
- DO jj = 1, jpjglo
- mj0(jj) = MAX( 1 , MIN( jj - njmpp + 1, jpj+1 ) )
- mj1(jj) = MAX( 0 , MIN( jj - njmpp + 1, jpj ) )
- END DO
+ DO jh = 0, nn_hls
+ !
+ ishft = nn_hls - jh
+ !
+ ipi = Ni_0 + 2*jh ; ipj = Nj_0 + 2*jh
+ ipiglo = Ni0glo + 2*jh ; ipjglo = Nj0glo + 2*jh
+ iimpp = nimpp - ishft ; ijmpp = njmpp - ishft
+ !
+ ! local domain indices ==> global domain indices, including jh halos
+ !
+ DO ji = ishft + 1, ishft + ipi
+ mig(ji,jh) = ji + iimpp - 1
+ END DO
+ !
+ DO jj = ishft + 1, ishft + ipj
+ mjg(jj,jh) = jj + ijmpp - 1
+ END DO
+ !
+ ! global domain, including jh halos, indices ==> local domain indices
+ ! return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the
+ ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.
+ !
+ DO ji = 1, ipiglo
+ mi0(ji,jh) = MAX( 1 , MIN( ji - iimpp + 1, ipi+ishft+1 ) )
+ mi1(ji,jh) = MAX( 0 , MIN( ji - iimpp + 1, ipi+ishft ) )
+ END DO
+ !
+ DO jj = 1, ipjglo
+ mj0(jj,jh) = MAX( 1 , MIN( jj - ijmpp + 1, ipj+ishft+1 ) )
+ mj1(jj,jh) = MAX( 0 , MIN( jj - ijmpp + 1, ipj+ishft ) )
+ END DO
+ !
+ END DO ! jh
!
END SUBROUTINE init_locglo
diff --git a/src/OCE/LDF/ldftra.F90 b/src/OCE/LDF/ldftra.F90
index dea21729609f0d6bd405cbbcc9e8014202f7f362..22393cb006902429743325c755471b3bd3a130ff 100644
--- a/src/OCE/LDF/ldftra.F90
+++ b/src/OCE/LDF/ldftra.F90
@@ -806,98 +806,107 @@ CONTAINS
!
! !== eiv velocities: calculate and output ==!
!
- zw3d(:,:,jpk) = 0._wp ! bottom value always 0
+ zw3d(:,:,jpk) = 0._wp ! bottom value always 0
!
- DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! e2u e3u u_eiv = -dk[psi_uw]
- zw3d(ji,jj,jk) = ( psi_uw(ji,jj,jk+1) - psi_uw(ji,jj,jk) ) / ( e2u(ji,jj) * e3u(ji,jj,jk,Kmm) )
- END_3D
- CALL iom_put( "uoce_eiv", zw3d )
- !
- DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! e1v e3v v_eiv = -dk[psi_vw]
- zw3d(ji,jj,jk) = ( psi_vw(ji,jj,jk+1) - psi_vw(ji,jj,jk) ) / ( e1v(ji,jj) * e3v(ji,jj,jk,Kmm) )
- END_3D
- CALL iom_put( "voce_eiv", zw3d )
- !
- DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! e1 e2 w_eiv = dk[psix] + dk[psix]
- zw3d(ji,jj,jk) = ( psi_vw(ji,jj,jk) - psi_vw(ji ,jj-1,jk) &
- & + psi_uw(ji,jj,jk) - psi_uw(ji-1,jj ,jk) ) / e1e2t(ji,jj)
- END_3D
- CALL iom_put( "woce_eiv", zw3d )
- !
- IF( iom_use('weiv_masstr') ) THEN ! vertical mass transport & its square value
- DO_2D( 0, 0, 0, 0 )
- zw2d(ji,jj) = rho0 * e1e2t(ji,jj)
- END_2D
- DO_3D( 0, 0, 0, 0, 1, jpk )
- zw3d(ji,jj,jk) = zw3d(ji,jj,jk) * zw2d(ji,jj)
+ IF( iom_use('uoce_eiv') ) THEN
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! e2u e3u u_eiv = -dk[psi_uw]
+ zw3d(ji,jj,jk) = ( psi_uw(ji,jj,jk+1) - psi_uw(ji,jj,jk) ) / ( e2u(ji,jj) * e3u(ji,jj,jk,Kmm) )
END_3D
- CALL iom_put( "weiv_masstr" , zw3d )
+ CALL iom_put( "uoce_eiv", zw3d )
ENDIF
!
IF( iom_use('ueiv_masstr') ) THEN
- zw3d(:,:,jpk) = 0.e0
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
zw3d(ji,jj,jk) = rho0 * ( psi_uw(ji,jj,jk+1) - psi_uw(ji,jj,jk) )
END_3D
CALL iom_put( "ueiv_masstr", zw3d ) ! mass transport in i-direction
ENDIF
!
+ IF( iom_use('voce_eiv') ) THEN
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! e1v e3v v_eiv = -dk[psi_vw]
+ zw3d(ji,jj,jk) = ( psi_vw(ji,jj,jk+1) - psi_vw(ji,jj,jk) ) / ( e1v(ji,jj) * e3v(ji,jj,jk,Kmm) )
+ END_3D
+ CALL iom_put( "voce_eiv", zw3d )
+ ENDIF
+ !
+ IF( iom_use('veiv_masstr') ) THEN
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+ zw3d(ji,jj,jk) = rho0 * ( psi_vw(ji,jj,jk+1) - psi_vw(ji,jj,jk) )
+ END_3D
+ CALL iom_put( "veiv_masstr", zw3d ) ! mass transport in j-direction
+ ENDIF
+ !
+ IF( iom_use('woce_eiv') ) THEN
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! e1 e2 w_eiv = dk[psix] + dk[psix]
+ zw3d(ji,jj,jk) = ( psi_vw(ji,jj,jk) - psi_vw(ji ,jj-1,jk) &
+ & + psi_uw(ji,jj,jk) - psi_uw(ji-1,jj ,jk) ) / e1e2t(ji,jj)
+ END_3D
+ CALL iom_put( "woce_eiv", zw3d )
+ ENDIF
+ !
+ IF( iom_use('weiv_masstr') ) THEN
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+ zw3d(ji,jj,jk) = rho0 * ( psi_vw(ji,jj,jk) - psi_vw(ji ,jj-1,jk) &
+ & + psi_uw(ji,jj,jk) - psi_uw(ji-1,jj ,jk) )
+ END_3D
+ CALL iom_put( "weiv_masstr" , zw3d ) ! mass transport in z-direction
+ ENDIF
+ !
+ !
zztmp = 0.5_wp * rho0 * rcp
IF( iom_use('ueiv_heattr') .OR. iom_use('ueiv_heattr3d') ) THEN
zw2d(:,:) = 0._wp
- zw3d(:,:,jpk) = 0._wp
+ zw3d(:,:,:) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
- zw3d(ji,jj,jk) = ( psi_uw(ji,jj,jk+1) - psi_uw(ji ,jj,jk) ) &
- & * ( ts (ji,jj,jk,jp_tem,Kmm) + ts (ji+1,jj,jk,jp_tem,Kmm) )
+ zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_uw(ji,jj,jk+1) - psi_uw(ji ,jj,jk) ) &
+ & * ( ts (ji,jj,jk,jp_tem,Kmm) + ts (ji+1,jj,jk,jp_tem,Kmm) )
zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk)
END_3D
CALL iom_put( "ueiv_heattr" , zztmp * zw2d ) ! heat transport in i-direction
CALL iom_put( "ueiv_heattr3d", zztmp * zw3d ) ! heat transport in i-direction
ENDIF
!
- IF( iom_use('veiv_masstr') ) THEN
- zw3d(:,:,jpk) = 0.e0
+ IF( iom_use('veiv_heattr') .OR. iom_use('veiv_heattr3d') .OR. iom_use('sophteiv') ) THEN
+ zw2d(:,:) = 0._wp
+ zw3d(:,:,:) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
- zw3d(ji,jj,jk) = rho0 * ( psi_vw(ji,jj,jk+1) - psi_vw(ji,jj,jk) )
+ zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_vw(ji,jj,jk+1) - psi_vw(ji,jj ,jk) ) &
+ & * ( ts (ji,jj,jk,jp_tem,Kmm) + ts (ji,jj+1,jk,jp_tem,Kmm) )
+ zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk)
END_3D
- CALL iom_put( "veiv_masstr", zw3d ) ! mass transport in i-direction
+ CALL iom_put( "veiv_heattr" , zztmp * zw2d ) ! heat transport in j-direction
+ CALL iom_put( "veiv_heattr3d", zztmp * zw3d ) ! heat transport in j-direction
+ !
+ IF( iom_use( 'sophteiv' ) .AND. l_diaptr ) CALL dia_ptr_hst( jp_tem, 'eiv', 0.5 * zw3d )
ENDIF
!
- zw2d(:,:) = 0._wp
- zw3d(:,:,jpk) = 0._wp
- DO_3D( 0, 0, 0, 0, 1, jpkm1 )
- zw3d(ji,jj,jk) = ( psi_vw(ji,jj,jk+1) - psi_vw(ji,jj ,jk) ) &
- & * ( ts (ji,jj,jk,jp_tem,Kmm) + ts (ji,jj+1,jk,jp_tem,Kmm) )
- zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk)
- END_3D
- CALL iom_put( "veiv_heattr" , zztmp * zw2d ) ! heat transport in j-direction
- CALL iom_put( "veiv_heattr3d", zztmp * zw3d ) ! heat transport in j-direction
- !
- IF( iom_use( 'sophteiv' ) .AND. l_diaptr ) CALL dia_ptr_hst( jp_tem, 'eiv', 0.5 * zw3d )
!
zztmp = 0.5_wp * 0.5
- IF( iom_use('ueiv_salttr') .OR. iom_use('ueiv_salttr3d')) THEN
- zw2d(:,:) = 0._wp
- zw3d(:,:,jpk) = 0._wp
- DO_3D( 0, 0, 0, 0, 1, jpkm1 )
- zw3d(ji,jj,jk) = ( psi_uw(ji,jj,jk+1) - psi_uw(ji ,jj,jk) ) &
- & * ( ts (ji,jj,jk,jp_sal,Kmm) + ts (ji+1,jj,jk,jp_sal,Kmm) )
- zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk)
- END_3D
- CALL iom_put( "ueiv_salttr", zztmp * zw2d ) ! salt transport in i-direction
- CALL iom_put( "ueiv_salttr3d", zztmp * zw3d ) ! salt transport in i-direction
+ IF( iom_use('ueiv_salttr') .OR. iom_use('ueiv_salttr3d') ) THEN
+ zw2d(:,:) = 0._wp
+ zw3d(:,:,:) = 0._wp
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+ zw3d(ji,jj,jk) = zw3d(ji,jj,jk) * ( psi_uw(ji,jj,jk+1) - psi_uw(ji ,jj,jk) ) &
+ & * ( ts (ji,jj,jk,jp_sal,Kmm) + ts (ji+1,jj,jk,jp_sal,Kmm) )
+ zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk)
+ END_3D
+ CALL iom_put( "ueiv_salttr", zztmp * zw2d ) ! salt transport in i-direction
+ CALL iom_put( "ueiv_salttr3d", zztmp * zw3d ) ! salt transport in i-direction
ENDIF
- zw2d(:,:) = 0._wp
- zw3d(:,:,jpk) = 0._wp
- DO_3D( 0, 0, 0, 0, 1, jpkm1 )
- zw3d(ji,jj,jk) = ( psi_vw(ji,jj,jk+1) - psi_vw(ji,jj ,jk) ) &
- & * ( ts (ji,jj,jk,jp_sal,Kmm) + ts (ji,jj+1,jk,jp_sal,Kmm) )
- zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk)
- END_3D
- CALL iom_put( "veiv_salttr" , zztmp * zw2d ) ! salt transport in j-direction
- CALL iom_put( "veiv_salttr3d", zztmp * zw3d ) ! salt transport in j-direction
!
- IF( iom_use( 'sopsteiv' ) .AND. l_diaptr ) CALL dia_ptr_hst( jp_sal, 'eiv', 0.5 * zw3d )
+ IF( iom_use('veiv_salttr') .OR. iom_use('veiv_salttr3d') .OR. iom_use('sopsteiv') ) THEN
+ zw2d(:,:) = 0._wp
+ zw3d(:,:,:) = 0._wp
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+ zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_vw(ji,jj,jk+1) - psi_vw(ji,jj ,jk) ) &
+ & * ( ts (ji,jj,jk,jp_sal,Kmm) + ts (ji,jj+1,jk,jp_sal,Kmm) )
+ zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk)
+ END_3D
+ CALL iom_put( "veiv_salttr" , zztmp * zw2d ) ! salt transport in j-direction
+ CALL iom_put( "veiv_salttr3d", zztmp * zw3d ) ! salt transport in j-direction
+ !
+ IF( iom_use( 'sopsteiv' ) .AND. l_diaptr ) CALL dia_ptr_hst( jp_sal, 'eiv', 0.5 * zw3d )
+ ENDIF
!
!
END SUBROUTINE ldf_eiv_dia
diff --git a/src/OCE/OBS/mpp_map.F90 b/src/OCE/OBS/mpp_map.F90
index 5a4007df1a3718f1affda3f4152baad7beaa11ad..553a36446ad51a5153b540de49820ef2b473705d 100644
--- a/src/OCE/OBS/mpp_map.F90
+++ b/src/OCE/OBS/mpp_map.F90
@@ -10,8 +10,8 @@ MODULE mpp_map
!! mppmap_init : Initialize mppmap.
!!----------------------------------------------------------------------
USE par_kind, ONLY : wp ! Precision variables
- USE par_oce , ONLY : jpi, jpj, Nis0, Nie0, Njs0, Nje0 ! Ocean parameters
- USE dom_oce , ONLY : mig, mjg, narea ! Ocean space and time domain variables
+ USE par_oce , ONLY : jpi, jpj, Nis0, Nie0, Njs0, Nje0, nn_hls ! Ocean parameters
+ USE dom_oce , ONLY : mig, mjg, narea ! Ocean space and time domain variables
#if ! defined key_mpi_off
USE lib_mpp , ONLY : mpi_comm_oce ! MPP library
#endif
@@ -64,7 +64,7 @@ INCLUDE 'mpif.h'
imppmap(:,:) = 0
! ! Setup local grid points
- imppmap(mig(1):mig(jpi),mjg(1):mjg(jpj)) = narea
+ imppmap(mig(1,nn_hls):mig(jpi,nn_hls),mjg(1,nn_hls):mjg(jpj,nn_hls)) = narea
! Get global data
diff --git a/src/OCE/OBS/obs_grd_bruteforce.h90 b/src/OCE/OBS/obs_grd_bruteforce.h90
index 5a41fa312c864dc2245e8f3a519f6a6de84fa55e..5df8b26c7d1cee1ec27c9cc33fc8cbc8e556519c 100644
--- a/src/OCE/OBS/obs_grd_bruteforce.h90
+++ b/src/OCE/OBS/obs_grd_bruteforce.h90
@@ -111,9 +111,9 @@
zmskg(:,:) = -1.e+10
DO jj = kldj, klej
DO ji = kldi, klei
- zlamg(mig(ji),mjg(jj)) = pglam(ji,jj)
- zphig(mig(ji),mjg(jj)) = pgphi(ji,jj)
- zmskg(mig(ji),mjg(jj)) = pmask(ji,jj)
+ zlamg(mig(ji,nn_hls),mjg(jj,nn_hls)) = pglam(ji,jj)
+ zphig(mig(ji,nn_hls),mjg(jj,nn_hls)) = pgphi(ji,jj)
+ zmskg(mig(ji,nn_hls),mjg(jj,nn_hls)) = pmask(ji,jj)
END DO
END DO
CALL mpp_global_max( zlamg )
diff --git a/src/OCE/OBS/obs_grid.F90 b/src/OCE/OBS/obs_grid.F90
index 7157416234e257342c5fd610b1c5a0023fc4a57b..b9c7554c4691682bab3bde84fe0cd24351c60187 100644
--- a/src/OCE/OBS/obs_grid.F90
+++ b/src/OCE/OBS/obs_grid.F90
@@ -280,9 +280,9 @@ CONTAINS
! Add various grids here.
DO jj = 1, jpj
DO ji = 1, jpi
- zlamg(mig(ji),mjg(jj)) = glamt(ji,jj)
- zphig(mig(ji),mjg(jj)) = gphit(ji,jj)
- zmskg(mig(ji),mjg(jj)) = tmask(ji,jj,1)
+ zlamg(mig(ji,nn_hls),mjg(jj,nn_hls)) = glamt(ji,jj)
+ zphig(mig(ji,nn_hls),mjg(jj,nn_hls)) = gphit(ji,jj)
+ zmskg(mig(ji,nn_hls),mjg(jj,nn_hls)) = tmask(ji,jj,1)
END DO
END DO
CALL mpp_global_max( zlamg )
diff --git a/src/OCE/OBS/obs_inter_sup.F90 b/src/OCE/OBS/obs_inter_sup.F90
index d8116276d3a5bcbf7cb2b5ebb187e1b2a427a575..084830e1d1aad62a3db3dde36d22a067cb71c330 100644
--- a/src/OCE/OBS/obs_inter_sup.F90
+++ b/src/OCE/OBS/obs_inter_sup.F90
@@ -279,8 +279,8 @@ CONTAINS
! Pack interpolation data to be sent
DO ji = 1, itot
- ii = mi1(igrdij_recv(2*ji-1))
- ij = mj1(igrdij_recv(2*ji))
+ ii = mi1(igrdij_recv(2*ji-1),nn_hls)
+ ij = mj1(igrdij_recv(2*ji ),nn_hls)
DO jk = 1, kpk
zsend(jk,ji) = pval(ii,ij,jk)
END DO
diff --git a/src/OCE/OBS/obs_write.F90 b/src/OCE/OBS/obs_write.F90
index 1b44338d0b4ce03546ae8d9676b40a10bcb79b39..d0c0eda8c673fd7950817519ed1065a2d2dfc8eb 100644
--- a/src/OCE/OBS/obs_write.F90
+++ b/src/OCE/OBS/obs_write.F90
@@ -245,8 +245,8 @@ CONTAINS
fbdata%iobsi(jo,jvar) = profdata%mi(jo,jvar)
fbdata%iobsj(jo,jvar) = profdata%mj(jo,jvar)
ELSE
- fbdata%iobsi(jo,jvar) = mig(profdata%mi(jo,jvar))
- fbdata%iobsj(jo,jvar) = mjg(profdata%mj(jo,jvar))
+ fbdata%iobsi(jo,jvar) = mig(profdata%mi(jo,jvar),nn_hls)
+ fbdata%iobsj(jo,jvar) = mjg(profdata%mj(jo,jvar),nn_hls)
ENDIF
END DO
CALL greg2jul( 0, &
@@ -511,8 +511,8 @@ CONTAINS
fbdata%iobsi(jo,1) = surfdata%mi(jo)
fbdata%iobsj(jo,1) = surfdata%mj(jo)
ELSE
- fbdata%iobsi(jo,1) = mig(surfdata%mi(jo))
- fbdata%iobsj(jo,1) = mjg(surfdata%mj(jo))
+ fbdata%iobsi(jo,1) = mig(surfdata%mi(jo),nn_hls)
+ fbdata%iobsj(jo,1) = mjg(surfdata%mj(jo),nn_hls)
ENDIF
CALL greg2jul( 0, &
& surfdata%nmin(jo), &
diff --git a/src/OCE/SBC/cpl_oasis3.F90 b/src/OCE/SBC/cpl_oasis3.F90
index 091ce68733631adda99b5faf9e27f8724200b421..b86deba5449834d308288480d3ab7b23ed8ff5c0 100644
--- a/src/OCE/SBC/cpl_oasis3.F90
+++ b/src/OCE/SBC/cpl_oasis3.F90
@@ -171,11 +171,11 @@ CONTAINS
! ... Define the partition, excluding halos as we don't want them to be "seen" by oasis
! -----------------------------------------------------------------
- paral(1) = 2 ! box partitioning
- paral(2) = Ni0glo * mjg0(nn_hls) + mig0(nn_hls) ! NEMO lower left corner global offset, without halos
- paral(3) = Ni_0 ! local extent in i, excluding halos
- paral(4) = Nj_0 ! local extent in j, excluding halos
- paral(5) = Ni0glo ! global extent in x, excluding halos
+ paral(1) = 2 ! box partitioning
+ paral(2) = Ni0glo * mjg(nn_hls,0) + mig(nn_hls,0) ! NEMO lower left corner global offset, without halos
+ paral(3) = Ni_0 ! local extent in i, excluding halos
+ paral(4) = Nj_0 ! local extent in j, excluding halos
+ paral(5) = Ni0glo ! global extent in x, excluding halos
IF( sn_cfctl%l_oasout ) THEN
WRITE(numout,*) ' multiexchg: paral (1:5)', paral
diff --git a/src/OCE/SBC/cyclone.F90 b/src/OCE/SBC/cyclone.F90
index 6a66bb02e39f0a709c6e15493114da229b3adb39..175a36633aa4cf80f5b06de59d696619e46a9e4d 100644
--- a/src/OCE/SBC/cyclone.F90
+++ b/src/OCE/SBC/cyclone.F90
@@ -54,9 +54,9 @@ CONTAINS
!! ** Action : - open TC data, find TCs for the current timestep
!! - for each potential TC, add the winds on the grid
!!----------------------------------------------------------------------
- INTEGER , INTENT(in) :: kt ! time step index
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: pwnd_i ! wind speed i-components at T-point ORCA direction
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: pwnd_j ! wind speed j-components at T-point ORCA direction
+ INTEGER , INTENT(in) :: kt ! time step index
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)) :: pwnd_i ! wind speed i-components at T-point ORCA direction
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)) :: pwnd_j ! wind speed j-components at T-point ORCA direction
!
!!
INTEGER :: ji, jj , jtc ! loop arguments
@@ -79,7 +79,7 @@ CONTAINS
REAL(wp) :: zwnd_r, zwnd_t ! radial and tangential components of the wind
REAL(wp) :: zvmax ! timestep interpolated vmax
REAL(wp) :: zrlon, zrlat ! temporary
- REAL(wp), DIMENSION(jpi,jpj) :: zwnd_x, zwnd_y ! zonal and meridional components of the wind
+ REAL(wp), DIMENSION(A2D(0)) :: zwnd_x, zwnd_y ! zonal and meridional components of the wind
REAL(wp), DIMENSION(14,5) :: ztct ! tropical cyclone track data at kt
!
CHARACTER(len=100) :: cn_dir ! Root directory for location of files
@@ -146,7 +146,7 @@ CONTAINS
! fitted B parameter (Willoughby 2004)
zb = 2.
- DO_2D( 1, 1, 1, 1 )
+ DO_2D( 0, 0, 0, 0 )
! calc distance between TC center and any point following great circle
! source : http://www.movable-type.co.uk/scripts/latlong.html
@@ -207,7 +207,7 @@ CONTAINS
zA=0
ENDIF
- DO_2D( 1, 1, 1, 1 )
+ DO_2D( 0, 0, 0, 0 )
zzrglam = rad * glamt(ji,jj) - zrlon
zzrgphi = rad * gphit(ji,jj)
diff --git a/src/OCE/SBC/fldread.F90 b/src/OCE/SBC/fldread.F90
index f7a6d90fa6949a2144e762b1a8634f939fcaf8a3..8b84b0c3cee99cdc3bf83c19f79c2031d0edd1c7 100644
--- a/src/OCE/SBC/fldread.F90
+++ b/src/OCE/SBC/fldread.F90
@@ -699,9 +699,10 @@ CONTAINS
INTEGER :: imf ! size of the structure sd
INTEGER :: ill ! character length
INTEGER :: iv ! indice of V component
+ INTEGER :: ipi, ipj
CHARACTER (LEN=100) :: clcomp ! dummy weight name
- REAL(wp), DIMENSION(jpi,jpj) :: utmp, vtmp ! temporary arrays for vector rotation
- REAL(wp), DIMENSION(:,:,:), POINTER :: dta_u, dta_v ! short cut
+ REAL(wp), DIMENSION(:,:), ALLOCATABLE :: utmp, vtmp ! temporary arrays for vector rotation
+ REAL(wp), DIMENSION(:,:,:), POINTER :: dta_u, dta_v ! short cut
!!---------------------------------------------------------------------
!
!! (sga: following code should be modified so that pairs arent searched for each time
@@ -724,11 +725,14 @@ CONTAINS
IF( sd(ju)%ln_tint ) THEN ; dta_u => sd(ju)%fdta(:,:,:,jn) ; dta_v => sd(iv)%fdta(:,:,:,jn)
ELSE ; dta_u => sd(ju)%fnow(:,:,: ) ; dta_v => sd(iv)%fnow(:,:,: )
ENDIF
+ ipi = SIZE(dta_u,1) ; ipj = SIZE(dta_u,2)
+ ALLOCATE( utmp(ipi,ipj), vtmp(ipi,ipj) )
DO jk = 1, SIZE( sd(ju)%fnow, 3 )
CALL rot_rep( dta_u(:,:,jk), dta_v(:,:,jk), 'T', 'en->i', utmp(:,:) )
CALL rot_rep( dta_u(:,:,jk), dta_v(:,:,jk), 'T', 'en->j', vtmp(:,:) )
dta_u(:,:,jk) = utmp(:,:) ; dta_v(:,:,jk) = vtmp(:,:)
END DO
+ DEALLOCATE( utmp, vtmp )
sd(ju)%rotn(jn) = .TRUE. ! vector was rotated
IF( lwp .AND. kt == nit000 ) WRITE(numout,*) &
& 'fld_read: vector pair ('//TRIM(sd(ju)%clvar)//', '//TRIM(sd(iv)%clvar)//') rotated on to model grid'
@@ -1100,7 +1104,7 @@ CONTAINS
CHARACTER (len=5) :: clname !
INTEGER , DIMENSION(4) :: ddims
INTEGER :: isrc
- REAL(wp), DIMENSION(jpi,jpj) :: data_tmp
+ REAL(wp), DIMENSION(A2D(0)) :: data_tmp
!!----------------------------------------------------------------------
!
IF( nxt_wgt > tot_wgts ) THEN
@@ -1155,9 +1159,9 @@ CONTAINS
ELSE ; ref_wgts(nxt_wgt)%numwgt = 16
ENDIF
- ALLOCATE( ref_wgts(nxt_wgt)%data_jpi(Nis0:Nie0,Njs0:Nje0,4) )
- ALLOCATE( ref_wgts(nxt_wgt)%data_jpj(Nis0:Nie0,Njs0:Nje0,4) )
- ALLOCATE( ref_wgts(nxt_wgt)%data_wgt(Nis0:Nie0,Njs0:Nje0,ref_wgts(nxt_wgt)%numwgt) )
+ ALLOCATE( ref_wgts(nxt_wgt)%data_jpi(A2D(0),4) )
+ ALLOCATE( ref_wgts(nxt_wgt)%data_jpj(A2D(0),4) )
+ ALLOCATE( ref_wgts(nxt_wgt)%data_wgt(A2D(0),ref_wgts(nxt_wgt)%numwgt) )
DO jn = 1,4
WRITE(clname,'(a3,i2.2)') 'src',jn
@@ -1332,7 +1336,9 @@ CONTAINS
INTEGER, DIMENSION(3) :: rec1_lsm, recn_lsm ! temporary arrays for start and length in case of seaoverland
INTEGER :: ii_lsm1,ii_lsm2,ij_lsm1,ij_lsm2 ! temporary indices
INTEGER :: ji, jj, jk, jn, jir, jjr ! loop counters
- INTEGER :: ipk
+ INTEGER :: ipi, ipj, ipk
+ INTEGER :: iisht, ijsht
+ INTEGER :: ii, ij
INTEGER :: ni, nj ! lengths
INTEGER :: jpimin,jpiwid ! temporary indices
INTEGER :: jpimin_lsm,jpiwid_lsm ! temporary indices
@@ -1343,7 +1349,11 @@ CONTAINS
INTEGER :: itmpi,itmpj,itmpz ! lengths
REAL(wp),DIMENSION(:,:,:), ALLOCATABLE :: ztmp_fly_dta ! local array of values on input grid
!!----------------------------------------------------------------------
+ ipi = SIZE(dta, 1)
+ ipj = SIZE(dta, 2)
ipk = SIZE(dta, 3)
+ iisht = ( jpi - ipi ) / 2
+ ijsht = ( jpj - ipj ) / 2
!
!! for weighted interpolation we have weights at four corners of a box surrounding
!! a model grid point, each weight is multiplied by a grid value (bilinear case)
@@ -1438,7 +1448,9 @@ CONTAINS
DO_3D( 0, 0, 0, 0, 1,ipk )
ni = ref_wgts(kw)%data_jpi(ji,jj,jn) + 1
nj = ref_wgts(kw)%data_jpj(ji,jj,jn) + 1
- dta(ji,jj,jk) = dta(ji,jj,jk) + ref_wgts(kw)%data_wgt(ji,jj,jn) * ref_wgts(kw)%fly_dta(ni,nj,jk)
+ ii = ji - iisht
+ ij = jj - ijsht
+ dta(ii,ij,jk) = dta(ii,ij,jk) + ref_wgts(kw)%data_wgt(ji,jj,jn) * ref_wgts(kw)%fly_dta(ni,nj,jk)
END_3D
END DO
@@ -1482,7 +1494,9 @@ CONTAINS
!!$ DO_3D( 0, 0, 0, 0, 1,ipk )
!!$ ni = ref_wgts(kw)%data_jpi(ji,jj,jn) + 1
!!$ nj = ref_wgts(kw)%data_jpj(ji,jj,jn) + 1
-!!$ dta(ji,jj,jk) = dta(ji,jj,jk) &
+!!$ ii = ji - iisht
+!!$ ij = jj - ijsht
+!!$ dta(ii,ij,jk) = dta(ii,ij,jk) &
!!$ ! gradient in the i direction
!!$ & + ref_wgts(kw)%data_wgt(ji,jj,jn+4) * 0.5_wp * &
!!$ & (ref_wgts(kw)%fly_dta(ni+1,nj ,jk) - ref_wgts(kw)%fly_dta(ni-1,nj ,jk)) &
@@ -1500,8 +1514,10 @@ CONTAINS
DO_3D( 0, 0, 0, 0, 1,ipk )
ni = ref_wgts(kw)%data_jpi(ji,jj,jn)
nj = ref_wgts(kw)%data_jpj(ji,jj,jn)
+ ii = ji - iisht
+ ij = jj - ijsht
! gradient in the i direction
- dta(ji,jj,jk) = dta(ji,jj,jk) + ref_wgts(kw)%data_wgt(ji,jj,jn+4) * 0.5_wp * &
+ dta(ii,ij,jk) = dta(ii,ij,jk) + ref_wgts(kw)%data_wgt(ji,jj,jn+4) * 0.5_wp * &
& (ref_wgts(kw)%fly_dta(ni+2,nj+1,jk) - ref_wgts(kw)%fly_dta(ni ,nj+1,jk))
END_3D
END DO
@@ -1509,8 +1525,10 @@ CONTAINS
DO_3D( 0, 0, 0, 0, 1,ipk )
ni = ref_wgts(kw)%data_jpi(ji,jj,jn)
nj = ref_wgts(kw)%data_jpj(ji,jj,jn)
+ ii = ji - iisht
+ ij = jj - ijsht
! gradient in the j direction
- dta(ji,jj,jk) = dta(ji,jj,jk) + ref_wgts(kw)%data_wgt(ji,jj,jn+8) * 0.5_wp * &
+ dta(ii,ij,jk) = dta(ii,ij,jk) + ref_wgts(kw)%data_wgt(ji,jj,jn+8) * 0.5_wp * &
& (ref_wgts(kw)%fly_dta(ni+1,nj+2,jk) - ref_wgts(kw)%fly_dta(ni+1,nj ,jk))
END_3D
END DO
@@ -1518,8 +1536,10 @@ CONTAINS
DO_3D( 0, 0, 0, 0, 1,ipk )
ni = ref_wgts(kw)%data_jpi(ji,jj,jn)
nj = ref_wgts(kw)%data_jpj(ji,jj,jn)
+ ii = ji - iisht
+ ij = jj - ijsht
! gradient in the ij direction
- dta(ji,jj,jk) = dta(ji,jj,jk) + ref_wgts(kw)%data_wgt(ji,jj,jn+12) * 0.25_wp * ( &
+ dta(ii,ij,jk) = dta(ii,ij,jk) + ref_wgts(kw)%data_wgt(ji,jj,jn+12) * 0.25_wp * ( &
& (ref_wgts(kw)%fly_dta(ni+2,nj+2,jk) - ref_wgts(kw)%fly_dta(ni ,nj+2,jk)) - &
& (ref_wgts(kw)%fly_dta(ni+2,nj ,jk) - ref_wgts(kw)%fly_dta(ni ,nj ,jk)))
END_3D
diff --git a/src/OCE/SBC/geo2ocean.F90 b/src/OCE/SBC/geo2ocean.F90
index 182e5e03073cc458a418e34b745b0fef8f355368..734ce4ef961dcfc0b8041111924a29765de48796 100644
--- a/src/OCE/SBC/geo2ocean.F90
+++ b/src/OCE/SBC/geo2ocean.F90
@@ -57,15 +57,23 @@ CONTAINS
!! ** Purpose : Rotate the Repere: Change vector componantes between
!! geographic grid <--> stretched coordinates grid.
!!----------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pxin, pyin ! vector componantes
- CHARACTER(len=1), INTENT(in ) :: cd_type ! define the nature of pt2d array grid-points
- CHARACTER(len=5), INTENT(in ) :: cdtodo ! type of transpormation:
- ! ! 'en->i' = east-north to i-component
- ! ! 'en->j' = east-north to j-component
- ! ! 'ij->e' = (i,j) components to east
- ! ! 'ij->n' = (i,j) components to north
- REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: prot
+ REAL(wp), DIMENSION(:,:), INTENT(in ) :: pxin, pyin ! vector componantes
+ CHARACTER(len=1), INTENT(in ) :: cd_type ! define the nature of pt2d array grid-points
+ CHARACTER(len=5), INTENT(in ) :: cdtodo ! type of transpormation:
+ ! ! 'en->i' = east-north to i-component
+ ! ! 'en->j' = east-north to j-component
+ ! ! 'ij->e' = (i,j) components to east
+ ! ! 'ij->n' = (i,j) components to north
+ REAL(wp), DIMENSION(:,:), INTENT( out) :: prot
+ !
+ INTEGER :: ipi, ipj, iipi, ijpj
+ INTEGER :: iisht, ijsht
+ INTEGER :: ii, ij, ii1, ij1
!!----------------------------------------------------------------------
+ ipi = SIZE(pxin, 1) ; ipj = SIZE(pxin, 2)
+ iisht = ( jpi - ipi ) / 2 ; ijsht = ( jpj - ipj ) / 2
+ ii1 = 1 + iisht ; ij1 = 1 + iisht
+ iipi = ipi + iisht ; ijpj = ipj + ijsht
!
IF( lmust_init ) THEN ! at 1st call only: set gsin. & gcos.
IF(lwp) WRITE(numout,*)
@@ -80,34 +88,50 @@ CONTAINS
!
CASE( 'en->i' ) ! east-north to i-component
SELECT CASE (cd_type)
- CASE ('T') ; prot(:,:) = pxin(:,:) * gcost(:,:) + pyin(:,:) * gsint(:,:)
- CASE ('U') ; prot(:,:) = pxin(:,:) * gcosu(:,:) + pyin(:,:) * gsinu(:,:)
- CASE ('V') ; prot(:,:) = pxin(:,:) * gcosv(:,:) + pyin(:,:) * gsinv(:,:)
- CASE ('F') ; prot(:,:) = pxin(:,:) * gcosf(:,:) + pyin(:,:) * gsinf(:,:)
+ CASE ('T') ; prot(1:ipi,1:ipj) = pxin(1:ipi,1:ipj) * gcost(ii1:iipi,ij1:ijpj) &
+ & + pyin(1:ipi,1:ipj) * gsint(ii1:iipi,ij1:ijpj)
+ CASE ('U') ; prot(1:ipi,1:ipj) = pxin(1:ipi,1:ipj) * gcosu(ii1:iipi,ij1:ijpj) &
+ & + pyin(1:ipi,1:ipj) * gsinu(ii1:iipi,ij1:ijpj)
+ CASE ('V') ; prot(1:ipi,1:ipj) = pxin(1:ipi,1:ipj) * gcosv(ii1:iipi,ij1:ijpj) &
+ & + pyin(1:ipi,1:ipj) * gsinv(ii1:iipi,ij1:ijpj)
+ CASE ('F') ; prot(1:ipi,1:ipj) = pxin(1:ipi,1:ipj) * gcosf(ii1:iipi,ij1:ijpj) &
+ & + pyin(1:ipi,1:ipj) * gsinf(ii1:iipi,ij1:ijpj)
CASE DEFAULT ; CALL ctl_stop( 'Only T, U, V and F grid points are coded' )
END SELECT
CASE ('en->j') ! east-north to j-component
SELECT CASE (cd_type)
- CASE ('T') ; prot(:,:) = pyin(:,:) * gcost(:,:) - pxin(:,:) * gsint(:,:)
- CASE ('U') ; prot(:,:) = pyin(:,:) * gcosu(:,:) - pxin(:,:) * gsinu(:,:)
- CASE ('V') ; prot(:,:) = pyin(:,:) * gcosv(:,:) - pxin(:,:) * gsinv(:,:)
- CASE ('F') ; prot(:,:) = pyin(:,:) * gcosf(:,:) - pxin(:,:) * gsinf(:,:)
+ CASE ('T') ; prot(1:ipi,1:ipj) = pyin(1:ipi,1:ipj) * gcost(ii1:iipi,ij1:ijpj) &
+ & - pxin(1:ipi,1:ipj) * gsint(ii1:iipi,ij1:ijpj)
+ CASE ('U') ; prot(1:ipi,1:ipj) = pyin(1:ipi,1:ipj) * gcosu(ii1:iipi,ij1:ijpj) &
+ & - pxin(1:ipi,1:ipj) * gsinu(ii1:iipi,ij1:ijpj)
+ CASE ('V') ; prot(1:ipi,1:ipj) = pyin(1:ipi,1:ipj) * gcosv(ii1:iipi,ij1:ijpj) &
+ & - pxin(1:ipi,1:ipj) * gsinv(ii1:iipi,ij1:ijpj)
+ CASE ('F') ; prot(1:ipi,1:ipj) = pyin(1:ipi,1:ipj) * gcosf(ii1:iipi,ij1:ijpj) &
+ & - pxin(1:ipi,1:ipj) * gsinf(ii1:iipi,ij1:ijpj)
CASE DEFAULT ; CALL ctl_stop( 'Only T, U, V and F grid points are coded' )
END SELECT
CASE ('ij->e') ! (i,j)-components to east
SELECT CASE (cd_type)
- CASE ('T') ; prot(:,:) = pxin(:,:) * gcost(:,:) - pyin(:,:) * gsint(:,:)
- CASE ('U') ; prot(:,:) = pxin(:,:) * gcosu(:,:) - pyin(:,:) * gsinu(:,:)
- CASE ('V') ; prot(:,:) = pxin(:,:) * gcosv(:,:) - pyin(:,:) * gsinv(:,:)
- CASE ('F') ; prot(:,:) = pxin(:,:) * gcosf(:,:) - pyin(:,:) * gsinf(:,:)
+ CASE ('T') ; prot(1:ipi,1:ipj) = pxin(1:ipi,1:ipj) * gcost(ii1:iipi,ij1:ijpj) &
+ & - pyin(1:ipi,1:ipj) * gsint(ii1:iipi,ij1:ijpj)
+ CASE ('U') ; prot(1:ipi,1:ipj) = pxin(1:ipi,1:ipj) * gcosu(ii1:iipi,ij1:ijpj) &
+ & - pyin(1:ipi,1:ipj) * gsinu(ii1:iipi,ij1:ijpj)
+ CASE ('V') ; prot(1:ipi,1:ipj) = pxin(1:ipi,1:ipj) * gcosv(ii1:iipi,ij1:ijpj) &
+ & - pyin(1:ipi,1:ipj) * gsinv(ii1:iipi,ij1:ijpj)
+ CASE ('F') ; prot(1:ipi,1:ipj) = pxin(1:ipi,1:ipj) * gcosf(ii1:iipi,ij1:ijpj) &
+ & - pyin(1:ipi,1:ipj) * gsinf(ii1:iipi,ij1:ijpj)
CASE DEFAULT ; CALL ctl_stop( 'Only T, U, V and F grid points are coded' )
END SELECT
CASE ('ij->n') ! (i,j)-components to north
SELECT CASE (cd_type)
- CASE ('T') ; prot(:,:) = pyin(:,:) * gcost(:,:) + pxin(:,:) * gsint(:,:)
- CASE ('U') ; prot(:,:) = pyin(:,:) * gcosu(:,:) + pxin(:,:) * gsinu(:,:)
- CASE ('V') ; prot(:,:) = pyin(:,:) * gcosv(:,:) + pxin(:,:) * gsinv(:,:)
- CASE ('F') ; prot(:,:) = pyin(:,:) * gcosf(:,:) + pxin(:,:) * gsinf(:,:)
+ CASE ('T') ; prot(1:ipi,1:ipj) = pyin(1:ipi,1:ipj) * gcost(ii1:iipi,ij1:ijpj) &
+ & + pxin(1:ipi,1:ipj) * gsint(ii1:iipi,ij1:ijpj)
+ CASE ('U') ; prot(1:ipi,1:ipj) = pyin(1:ipi,1:ipj) * gcosu(ii1:iipi,ij1:ijpj) &
+ & + pxin(1:ipi,1:ipj) * gsinu(ii1:iipi,ij1:ijpj)
+ CASE ('V') ; prot(1:ipi,1:ipj) = pyin(1:ipi,1:ipj) * gcosv(ii1:iipi,ij1:ijpj) &
+ & + pxin(1:ipi,1:ipj) * gsinv(ii1:iipi,ij1:ijpj)
+ CASE ('F') ; prot(1:ipi,1:ipj) = pyin(1:ipi,1:ipj) * gcosf(ii1:iipi,ij1:ijpj) &
+ & + pxin(1:ipi,1:ipj) * gsinf(ii1:iipi,ij1:ijpj)
CASE DEFAULT ; CALL ctl_stop( 'Only T, U, V and F grid points are coded' )
END SELECT
CASE DEFAULT ; CALL ctl_stop( 'rot_rep: Syntax Error in the definition of cdtodo' )
@@ -286,14 +310,17 @@ CONTAINS
!! ** Method : Change a vector from geocentric to east/north
!!
!!----------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pxx, pyy, pzz
- CHARACTER(len=1) , INTENT(in ) :: cgrid
- REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: pte, ptn
+ REAL(wp), DIMENSION(:,:), INTENT(in ) :: pxx, pyy, pzz
+ CHARACTER(len=1) , INTENT(in ) :: cgrid
+ REAL(wp), DIMENSION(:,:), INTENT( out) :: pte, ptn
!
REAL(wp), PARAMETER :: rpi = 3.141592653e0
REAL(wp), PARAMETER :: rad = rpi / 180.e0
INTEGER :: ig !
INTEGER :: ierr ! local integer
+ INTEGER :: ipi, ipj, iipi, ijpj
+ INTEGER :: iisht, ijsht
+ INTEGER :: ii, ij, ii1, ij1
!!----------------------------------------------------------------------
!
IF( .NOT. ALLOCATED( gsinlon ) ) THEN
@@ -345,10 +372,16 @@ CONTAINS
CALL ctl_stop( ctmp1 )
END SELECT
!
- pte = - gsinlon(:,:,ig) * pxx + gcoslon(:,:,ig) * pyy
- ptn = - gcoslon(:,:,ig) * gsinlat(:,:,ig) * pxx &
- & - gsinlon(:,:,ig) * gsinlat(:,:,ig) * pyy &
- & + gcoslat(:,:,ig) * pzz
+ ipi = SIZE(pxx, 1) ; ipj = SIZE(pxx, 2)
+ iisht = ( jpi - ipi ) / 2 ; ijsht = ( jpj - ipj ) / 2
+ ii1 = 1 + iisht ; ij1 = 1 + iisht
+ iipi = ipi + iisht ; ijpj = ipj + ijsht
+ !
+ pte(1:ipi,1:ipj) = - gsinlon(ii1:iipi,ij1:ijpj,ig) * pxx(1:ipi,1:ipj) &
+ & + gcoslon(ii1:iipi,ij1:ijpj,ig) * pyy(1:ipi,1:ipj)
+ ptn(1:ipi,1:ipj) = - gcoslon(ii1:iipi,ij1:ijpj,ig) * gsinlat(ii1:iipi,ij1:ijpj,ig) * pxx(1:ipi,1:ipj) &
+ & - gsinlon(ii1:iipi,ij1:ijpj,ig) * gsinlat(ii1:iipi,ij1:ijpj,ig) * pyy(1:ipi,1:ipj) &
+ & + gcoslat(ii1:iipi,ij1:ijpj,ig) * pzz(1:ipi,1:ipj)
!
END SUBROUTINE geo2oce
@@ -371,6 +404,9 @@ CONTAINS
REAL(wp), PARAMETER :: rad = rpi / 180.e0_wp
INTEGER :: ig !
INTEGER :: ierr ! local integer
+ INTEGER :: ipi, ipj, iipi, ijpj
+ INTEGER :: iisht, ijsht
+ INTEGER :: ii, ij, ii1, ij1
!!----------------------------------------------------------------------
IF( .NOT. ALLOCATED( gsinlon ) ) THEN
@@ -422,9 +458,16 @@ CONTAINS
CALL ctl_stop( ctmp1 )
END SELECT
!
- pxx = - gsinlon(:,:,ig) * pte - gcoslon(:,:,ig) * gsinlat(:,:,ig) * ptn
- pyy = gcoslon(:,:,ig) * pte - gsinlon(:,:,ig) * gsinlat(:,:,ig) * ptn
- pzz = gcoslat(:,:,ig) * ptn
+ ipi = SIZE(pte, 1) ; ipj = SIZE(pte, 2)
+ iisht = ( jpi - ipi ) / 2 ; ijsht = ( jpj - ipj ) / 2
+ ii1 = 1 + iisht ; ij1 = 1 + iisht
+ iipi = ipi + iisht ; ijpj = ipj + ijsht
+ !
+ pxx(1:ipi,1:ipj) = - gsinlon(ii1:iipi,ij1:ijpj,ig) * pte(1:ipi,1:ipj) &
+ & - gcoslon(ii1:iipi,ij1:ijpj,ig) * gsinlat(ii1:iipi,ij1:ijpj,ig) * ptn(1:ipi,1:ipj)
+ pyy(1:ipi,1:ipj) = gcoslon(ii1:iipi,ij1:ijpj,ig) * pte(1:ipi,1:ipj) &
+ & - gsinlon(ii1:iipi,ij1:ijpj,ig) * gsinlat(ii1:iipi,ij1:ijpj,ig) * ptn(1:ipi,1:ipj)
+ pzz(1:ipi,1:ipj) = gcoslat(ii1:iipi,ij1:ijpj,ig) * ptn(1:ipi,1:ipj)
!
END SUBROUTINE oce2geo
diff --git a/src/OCE/SBC/ocealb.F90 b/src/OCE/SBC/ocealb.F90
index e40f6f20144ed9754fd2e3a61eb01c28fc6e2367..6ea068681eea63ff75e3e8eece2284e94b676c9e 100644
--- a/src/OCE/SBC/ocealb.F90
+++ b/src/OCE/SBC/ocealb.F90
@@ -17,7 +17,9 @@ MODULE ocealb
PRIVATE
PUBLIC oce_alb ! routine called by sbccpl
-
+
+ !! Substitution
+# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
!! $Id: ocealb.F90 10069 2018-08-28 14:12:24Z nicolasmartin $
@@ -31,8 +33,8 @@ CONTAINS
!!
!! ** Purpose : Computation of the albedo of the ocean
!!----------------------------------------------------------------------
- REAL(wp), DIMENSION(:,:), INTENT(out) :: palb_os ! albedo of ocean under overcast sky
- REAL(wp), DIMENSION(:,:), INTENT(out) :: palb_cs ! albedo of ocean under clear sky
+ REAL(wp), DIMENSION(A2D(0)), INTENT(out) :: palb_os ! albedo of ocean under overcast sky
+ REAL(wp), DIMENSION(A2D(0)), INTENT(out) :: palb_cs ! albedo of ocean under clear sky
!!
REAL(wp) :: zcoef
REAL(wp) :: rmue = 0.40 ! cosine of local solar altitude
diff --git a/src/OCE/SBC/sbc_ice.F90 b/src/OCE/SBC/sbc_ice.F90
index cac087f79246701a2fb0197b1b7e3bf934d87a30..7cde0d4cbfa8195835e2ec1ce1d8b5b3e544ca41 100644
--- a/src/OCE/SBC/sbc_ice.F90
+++ b/src/OCE/SBC/sbc_ice.F90
@@ -103,6 +103,8 @@ MODULE sbc_ice
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: snwice_mass_b !: mass of snow and ice at previous ice time step [Kg/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: snwice_fmass !: time evolution of mass of snow+ice [Kg/m2/s]
+ !! * Substitutions
+# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
!! $Id: sbc_ice.F90 14072 2020-12-04 07:48:38Z laurent $
@@ -114,36 +116,49 @@ CONTAINS
!!----------------------------------------------------------------------
!! *** FUNCTION sbc_ice_alloc ***
!!----------------------------------------------------------------------
- INTEGER :: ierr(4)
+ INTEGER :: ierr(5), ii
!!----------------------------------------------------------------------
ierr(:) = 0
+ ii = 0
- ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), snwice_fmass(jpi,jpj) , STAT=ierr(1) )
+ ii = ii + 1
+ ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), snwice_fmass(jpi,jpj) , STAT=ierr(ii) )
#if defined key_si3
- ALLOCATE( qns_ice (jpi,jpj,jpl) , qsr_ice (jpi,jpj,jpl) , &
- & qla_ice (jpi,jpj,jpl) , dqla_ice (jpi,jpj,jpl) , &
- & dqns_ice(jpi,jpj,jpl) , tn_ice (jpi,jpj,jpl) , alb_ice (jpi,jpj,jpl) , &
- & qml_ice (jpi,jpj,jpl) , qcn_ice (jpi,jpj,jpl) , qtr_ice_top(jpi,jpj,jpl) , &
- & utau_ice(jpi,jpj) , vtau_ice (jpi,jpj) , wndm_ice (jpi,jpj) , &
- & evap_ice(jpi,jpj,jpl) , devap_ice(jpi,jpj,jpl) , qprec_ice (jpi,jpj) , &
- & qemp_ice(jpi,jpj) , qevap_ice(jpi,jpj,jpl) , qemp_oce (jpi,jpj) , &
- & qns_oce (jpi,jpj) , qsr_oce (jpi,jpj) , emp_oce (jpi,jpj) , &
- & emp_ice (jpi,jpj) , sstfrz (jpi,jpj) , rCdU_ice (jpi,jpj) , STAT= ierr(2) )
+ ! ----------------- !
+ ! == FULL ARRAYS == !
+ ! ----------------- !
+ ii = ii + 1
+ ALLOCATE( utau_ice(jpi,jpj) , vtau_ice(jpi,jpj) , &
+ & rCdU_ice(A2D(1)) , STAT= ierr(ii) )
+ ! -------------------- !
+ ! == REDUCED ARRAYS == !
+ ! -------------------- !
+ ii = ii + 1
+ ALLOCATE( wndm_ice(A2D(0)) , &
+ & qns_ice (A2D(0),jpl) , qsr_ice (A2D(0),jpl) , &
+ & qla_ice (A2D(0),jpl) , dqla_ice (A2D(0),jpl) , &
+ & dqns_ice(A2D(0),jpl) , tn_ice (A2D(0),jpl) , alb_ice (A2D(0),jpl) , &
+ & qml_ice (A2D(0),jpl) , qcn_ice (A2D(0),jpl) , qtr_ice_top(A2D(0),jpl) , &
+ & evap_ice(A2D(0),jpl) , devap_ice(A2D(0),jpl) , qprec_ice (A2D(0)) , &
+ & qemp_ice(A2D(0)) , qevap_ice(A2D(0),jpl) , qemp_oce (A2D(0)) , &
+ & qns_oce (A2D(0)) , qsr_oce (A2D(0)) , emp_oce (A2D(0)) , &
+ & emp_ice (A2D(0)) , sstfrz (A2D(0)) , STAT= ierr(ii) )
#endif
#if defined key_cice
+ ii = ii + 1
ALLOCATE( qla_ice(jpi,jpj,1) , qlw_ice(jpi,jpj,1) , qsr_ice(jpi,jpj,1) , &
wndi_ice(jpi,jpj) , tatm_ice(jpi,jpj) , qatm_ice(jpi,jpj) , &
wndj_ice(jpi,jpj) , nfrzmlt(jpi,jpj) , ss_iou(jpi,jpj) , &
ss_iov(jpi,jpj) , fr_iu(jpi,jpj) , fr_iv(jpi,jpj) , &
a_i(jpi,jpj,ncat) , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat) , &
- STAT= ierr(2) )
+ STAT= ierr(ii) )
+ ii = ii + 1
IF( ln_cpl ) ALLOCATE( u_ice(jpi,jpj) , tn_ice (jpi,jpj,1) , &
& v_ice(jpi,jpj) , alb_ice(jpi,jpj,1) , &
& emp_ice(jpi,jpj) , qns_ice(jpi,jpj,1) , dqns_ice(jpi,jpj,1) , &
- & STAT= ierr(3) )
- IF( ln_cpl ) ALLOCATE( h_i(jpi,jpj,jpl) , h_s(jpi,jpj,jpl) , STAT=ierr(4) )
+ & h_i(jpi,jpj,jpl) , h_s(jpi,jpj,jpl) ,STAT= ierr(ii) )
#endif
sbc_ice_alloc = MAXVAL( ierr )
diff --git a/src/OCE/SBC/sbc_oce.F90 b/src/OCE/SBC/sbc_oce.F90
index f4cd6c97ee11a04d1aa9af9db8dba2b9242fd774..56117e4fd0cca1eed364c22017b3ad138b43e2af 100644
--- a/src/OCE/SBC/sbc_oce.F90
+++ b/src/OCE/SBC/sbc_oce.F90
@@ -121,7 +121,7 @@ MODULE sbc_oce
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_tot !: total E-P over ocean and ice [Kg/m2/s]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fmmflx !: freshwater budget: freezing/melting [Kg/m2/s]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rnf , rnf_b !: river runoff [Kg/m2/s]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fwficb , fwficb_b !: iceberg melting [Kg/m2/s]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fwficb !: iceberg melting [Kg/m2/s]
!!
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sbc_tsc, sbc_tsc_b !: sbc content trend [K.m/s] jpi,jpj,jpts
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_hc , qsr_hc_b !: heat content trend due to qsr flux [K.m/s] jpi,jpj,jpk
@@ -175,30 +175,41 @@ CONTAINS
!!---------------------------------------------------------------------
!! *** FUNCTION sbc_oce_alloc ***
!!---------------------------------------------------------------------
- INTEGER :: ierr(6)
+ INTEGER :: ierr(8)
!!---------------------------------------------------------------------
ierr(:) = 0
!
- ALLOCATE( utau(jpi,jpj) , utau_b(jpi,jpj) , utauU(jpi,jpj) , taum(jpi,jpj) , &
- & vtau(jpi,jpj) , vtau_b(jpi,jpj) , vtauV(jpi,jpj) , wndm(jpi,jpj) , rhoa(jpi,jpj) , STAT=ierr(1) )
+ ! ----------------- !
+ ! == FULL ARRAYS == !
+ ! ----------------- !
+ ALLOCATE( utau(jpi,jpj) , utau_b(jpi,jpj) , utauU(jpi,jpj) , &
+ & vtau(jpi,jpj) , vtau_b(jpi,jpj) , vtauV(jpi,jpj) , STAT=ierr(1) )
!
- ALLOCATE( qns_tot(jpi,jpj) , qns (jpi,jpj) , qns_b(jpi,jpj), &
- & qsr_tot(jpi,jpj) , qsr (jpi,jpj) , &
- & emp (jpi,jpj) , emp_b(jpi,jpj) , &
- & sfx (jpi,jpj) , sfx_b(jpi,jpj) , emp_tot(jpi,jpj), fmmflx(jpi,jpj), STAT=ierr(2) )
+ ALLOCATE( emp(jpi,jpj) , emp_b(jpi,jpj) , &
+ & STAT=ierr(2) )
!
- ALLOCATE( rnf (jpi,jpj) , sbc_tsc (jpi,jpj,jpts) , qsr_hc (jpi,jpj,jpk) , &
- & rnf_b(jpi,jpj) , sbc_tsc_b(jpi,jpj,jpts) , qsr_hc_b(jpi,jpj,jpk) , &
- & fwficb (jpi,jpj), fwficb_b(jpi,jpj), STAT=ierr(3) )
+ ALLOCATE( rnf (jpi,jpj) , rnf_b (jpi,jpj) , &
+ & fwficb (jpi,jpj) , STAT=ierr(3) )
!
- ALLOCATE( tprecip(jpi,jpj) , sprecip(jpi,jpj) , fr_i(jpi,jpj) , &
- & atm_co2(jpi,jpj) , tsk_m(jpi,jpj) , cloud_fra(jpi,jpj), &
+ ALLOCATE( fr_i(jpi,jpj) , &
& ssu_m (jpi,jpj) , sst_m(jpi,jpj) , frq_m(jpi,jpj) , &
- & ssv_m (jpi,jpj) , sss_m(jpi,jpj) , ssh_m(jpi,jpj) , STAT=ierr(4) )
+ & ssv_m (jpi,jpj) , sss_m(jpi,jpj) , ssh_m(jpi,jpj) , e3t_m(jpi,jpj) , STAT=ierr(4) )
!
- ALLOCATE( e3t_m(jpi,jpj) , STAT=ierr(5) )
+ ! -------------------- !
+ ! == REDUCED ARRAYS == !
+ ! -------------------- !
+ ALLOCATE( qns (A2D(0)) , qns_b (A2D(0)) , qsr (A2D(0)) , &
+ & qns_tot(A2D(0)) , qsr_tot(A2D(0)) , qsr_hc(A2D(0),jpk) , qsr_hc_b(A2D(0),jpk) , STAT=ierr(5) )
+ !
+ ALLOCATE( sbc_tsc(A2D(0),jpts) , sbc_tsc_b(A2D(0),jpts) , &
+ & sfx (A2D(0)) , sfx_b(A2D(0)) , emp_tot(A2D(0)), fmmflx(A2D(0)) ,&
+ & wndm(A2D(0)) , taum (A2D(0)) , STAT=ierr(6) )
+ !
+ ALLOCATE( tprecip(A2D(0)) , sprecip(A2D(0)) , &
+ & atm_co2(A2D(0)) , tsk_m (A2D(0)) , cloud_fra(A2D(0)), STAT=ierr(7) )
+
+ ALLOCATE( rhoa(A2D(0)) , q_air_zt(A2D(0)) , theta_air_zt(A2D(0)) , STAT=ierr(8) )
!
- ALLOCATE( q_air_zt(jpi,jpj) , theta_air_zt(jpi,jpj) , STAT=ierr(6) ) !#LB
!
sbc_oce_alloc = MAXVAL( ierr )
CALL mpp_sum ( 'sbc_oce', sbc_oce_alloc )
@@ -224,9 +235,9 @@ CONTAINS
INTEGER :: ji, jj ! dummy indices
!!---------------------------------------------------------------------
zcoef = 0.5 / ( zrhoa * zcdrag )
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
ztau = SQRT( utau(ji,jj)*utau(ji,jj) + vtau(ji,jj)*vtau(ji,jj) )
- wndm(ji,jj) = SQRT ( ztau * zcoef ) * tmask(ji,jj,1)
+ wndm(ji,jj) = SQRT ( ztau * zcoef ) * smask0(ji,jj)
END_2D
!
END SUBROUTINE sbc_tau2wnd
diff --git a/src/OCE/SBC/sbc_phy.F90 b/src/OCE/SBC/sbc_phy.F90
index cabec70fcfda4a096d045c62979b86cb029f02a8..2a845e3a54f0850b3457f4ddee4e039fd1ac4d27 100644
--- a/src/OCE/SBC/sbc_phy.F90
+++ b/src/OCE/SBC/sbc_phy.F90
@@ -223,9 +223,9 @@ CONTAINS
FUNCTION virt_temp_vctr( pta, pqa )
- REAL(wp), DIMENSION(jpi,jpj) :: virt_temp_vctr !: virtual temperature [K]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pta !: absolute or potential air temperature [K]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqa !: specific humidity of air [kg/kg]
+ REAL(wp), DIMENSION(A2D(0)) :: virt_temp_vctr !: virtual temperature [K]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pta !: absolute or potential air temperature [K]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pqa !: specific humidity of air [kg/kg]
virt_temp_vctr(:,:) = pta(:,:) * (1._wp + rctv0*pqa(:,:))
@@ -290,25 +290,25 @@ CONTAINS
!! ** Author: G. Samson, Feb 2021
!!-------------------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: pres_temp_vctr ! air pressure [Pa]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pqspe ! air specific humidity [kg/kg]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pslp ! sea-level pressure [Pa]
- REAL(wp), INTENT(in ) :: pz ! height above surface [m]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) , OPTIONAL :: ptpot ! air potential temperature [K]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(inout), OPTIONAL :: pta ! air absolute temperature [K]
- INTEGER :: ji, jj ! loop indices
- LOGICAL , INTENT(in) , OPTIONAL :: l_ice ! sea-ice presence
- LOGICAL :: lice ! sea-ice presence
+ REAL(wp), DIMENSION(A2D(0)) :: pres_temp_vctr ! air pressure [Pa]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in ) :: pqspe ! air specific humidity [kg/kg]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in ) :: pslp ! sea-level pressure [Pa]
+ REAL(wp), INTENT(in ) :: pz ! height above surface [m]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in ) , OPTIONAL :: ptpot ! air potential temperature [K]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(inout), OPTIONAL :: pta ! air absolute temperature [K]
+ INTEGER :: ji, jj ! loop indices
+ LOGICAL , INTENT(in) , OPTIONAL :: l_ice ! sea-ice presence
+ LOGICAL :: lice ! sea-ice presence
lice = .FALSE.
IF( PRESENT(l_ice) ) lice = l_ice
IF( PRESENT(ptpot) ) THEN
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
pres_temp_vctr(ji,jj) = pres_temp_sclr( pqspe(ji,jj), pslp(ji,jj), pz, ptpot=ptpot(ji,jj), pta=pta(ji,jj), l_ice=lice )
END_2D
ELSE
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
pres_temp_vctr(ji,jj) = pres_temp_sclr( pqspe(ji,jj), pslp(ji,jj), pz, pta=pta(ji,jj), l_ice=lice )
END_2D
ENDIF
@@ -344,12 +344,12 @@ CONTAINS
!! ** Author: G. Samson, Feb 2021
!!-------------------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: theta_exner_vctr ! air/surface potential temperature [K]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pta ! air/surface absolute temperature [K]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ppa ! air/surface pressure [Pa]
- INTEGER :: ji, jj ! loop indices
+ REAL(wp), DIMENSION(A2D(0)) :: theta_exner_vctr ! air/surface potential temperature [K]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pta ! air/surface absolute temperature [K]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ppa ! air/surface pressure [Pa]
+ INTEGER :: ji, jj ! loop indices
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
theta_exner_vctr(ji,jj) = theta_exner_sclr( pta(ji,jj), ppa(ji,jj) )
END_2D
@@ -364,10 +364,10 @@ CONTAINS
!!
!! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!-------------------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptak ! air temperature [K]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqa ! air specific humidity [kg/kg]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ppa ! pressure in [Pa]
- REAL(wp), DIMENSION(jpi,jpj) :: rho_air_vctr ! density of moist air [kg/m^3]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ptak ! air temperature [K]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pqa ! air specific humidity [kg/kg]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ppa ! pressure in [Pa]
+ REAL(wp), DIMENSION(A2D(0)) :: rho_air_vctr ! density of moist air [kg/m^3]
!!-------------------------------------------------------------------------------
rho_air_vctr = MAX( ppa / (R_dry*ptak * ( 1._wp + rctv0*pqa )) , 0.8_wp )
@@ -412,11 +412,11 @@ CONTAINS
FUNCTION visc_air_vctr(ptak)
- REAL(wp), DIMENSION(jpi,jpj) :: visc_air_vctr ! kinetic viscosity (m^2/s)
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptak ! air temperature in (K)
+ REAL(wp), DIMENSION(A2D(0)) :: visc_air_vctr ! kinetic viscosity (m^2/s)
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ptak ! air temperature in (K)
INTEGER :: ji, jj ! dummy loop indices
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
visc_air_vctr(ji,jj) = visc_air_sclr( ptak(ji,jj) )
END_2D
@@ -431,8 +431,8 @@ CONTAINS
!!
!! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!----------------------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: L_vap_vctr ! latent heat of vaporization [J/kg]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: psst ! water temperature [K]
+ REAL(wp), DIMENSION(A2D(0)) :: L_vap_vctr ! latent heat of vaporization [J/kg]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: psst ! water temperature [K]
!!----------------------------------------------------------------------------------
!
L_vap_vctr = ( 2.501_wp - 0.00237_wp * ( psst(:,:) - rt0) ) * 1.e6_wp
@@ -464,8 +464,8 @@ CONTAINS
!!
!! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!-------------------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqa ! air specific humidity [kg/kg]
- REAL(wp), DIMENSION(jpi,jpj) :: cp_air_vctr ! specific heat of moist air [J/K/kg]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pqa ! air specific humidity [kg/kg]
+ REAL(wp), DIMENSION(A2D(0)) :: cp_air_vctr ! specific heat of moist air [J/K/kg]
!!-------------------------------------------------------------------------------
cp_air_vctr = rCp_dry + rCp_vap * pqa
@@ -516,12 +516,12 @@ CONTAINS
FUNCTION gamma_moist_vctr( ptak, pqa )
- REAL(wp), DIMENSION(jpi,jpj) :: gamma_moist_vctr
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptak
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqa
+ REAL(wp), DIMENSION(A2D(0)) :: gamma_moist_vctr
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ptak
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pqa
INTEGER :: ji, jj
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
gamma_moist_vctr(ji,jj) = gamma_moist_sclr( ptak(ji,jj), pqa(ji,jj) )
END_2D
@@ -537,17 +537,17 @@ CONTAINS
!! Author: L. Brodeau, June 2019 / AeroBulk
!! (https://github.com/brodeau/aerobulk/)
!!------------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: One_on_L !: 1./(Obukhov length) [m^-1]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptha !: reference potential temperature of air [K]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqa !: reference specific humidity of air [kg/kg]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pus !: u*: friction velocity [m/s]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pts, pqs !: \theta* and q* friction aka turb. scales for temp. and spec. hum.
+ REAL(wp), DIMENSION(A2D(0)) :: One_on_L !: 1./(Obukhov length) [m^-1]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ptha !: reference potential temperature of air [K]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pqa !: reference specific humidity of air [kg/kg]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pus !: u*: friction velocity [m/s]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pts, pqs !: \theta* and q* friction aka turb. scales for temp. and spec. hum.
!
INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zqa ! local scalar
!!-------------------------------------------------------------------
!
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zqa = (1._wp + rctv0*pqa(ji,jj))
!
! The main concern is to know whether, the vertical turbulent flux of virtual temperature, < u' theta_v' > is estimated with:
@@ -598,27 +598,27 @@ CONTAINS
FUNCTION Ri_bulk_vctr( pz, psst, ptha, pssq, pqa, pub, pta_layer, pqa_layer )
- REAL(wp), DIMENSION(jpi,jpj) :: Ri_bulk_vctr
- REAL(wp) , INTENT(in) :: pz ! height above the sea (aka "delta z") [m]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: psst ! SST [K]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptha ! pot. air temp. at height "pz" [K]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pssq ! 0.98*q_sat(SST) [kg/kg]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqa ! air spec. hum. at height "pz" [kg/kg]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pub ! bulk wind speed [m/s]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: pta_layer ! when possible, a better guess of absolute temperature WITHIN the layer [K]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: pqa_layer ! when possible, a better guess of specific humidity WITHIN the layer [kg/kg]
+ REAL(wp), DIMENSION(A2D(0)) :: Ri_bulk_vctr
+ REAL(wp) , INTENT(in) :: pz ! height above the sea (aka "delta z") [m]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: psst ! SST [K]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ptha ! pot. air temp. at height "pz" [K]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pssq ! 0.98*q_sat(SST) [kg/kg]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pqa ! air spec. hum. at height "pz" [kg/kg]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pub ! bulk wind speed [m/s]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in), OPTIONAL :: pta_layer ! when possible, a better guess of absolute temperature WITHIN the layer [K]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in), OPTIONAL :: pqa_layer ! when possible, a better guess of specific humidity WITHIN the layer [kg/kg]
!!
LOGICAL :: l_ptqa_l_prvd = .FALSE.
INTEGER :: ji, jj
IF( PRESENT(pta_layer) .AND. PRESENT(pqa_layer) ) l_ptqa_l_prvd = .TRUE.
IF( l_ptqa_l_prvd ) THEN
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
Ri_bulk_vctr(ji,jj) = Ri_bulk_sclr( pz, psst(ji,jj), ptha(ji,jj), pssq(ji,jj), pqa(ji,jj), pub(ji,jj), &
& pta_layer=pta_layer(ji,jj ), pqa_layer=pqa_layer(ji,jj ) )
END_2D
ELSE
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
Ri_bulk_vctr(ji,jj) = Ri_bulk_sclr( pz, psst(ji,jj), ptha(ji,jj), pssq(ji,jj), pqa(ji,jj), pub(ji,jj) )
END_2D
END IF
@@ -652,10 +652,10 @@ CONTAINS
END FUNCTION e_sat_sclr
FUNCTION e_sat_vctr(ptak)
- REAL(wp), DIMENSION(jpi,jpj) :: e_sat_vctr !: vapour pressure at saturation [Pa]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptak !: temperature (K)
+ REAL(wp), DIMENSION(A2D(0)) :: e_sat_vctr !: vapour pressure at saturation [Pa]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ptak !: temperature (K)
INTEGER :: ji, jj ! dummy loop indices
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
e_sat_vctr(ji,jj) = e_sat_sclr(ptak(ji,jj))
END_2D
END FUNCTION e_sat_vctr
@@ -681,11 +681,11 @@ CONTAINS
FUNCTION e_sat_ice_vctr(ptak)
!! Same as "e_sat" but over ice rather than water!
- REAL(wp), DIMENSION(jpi,jpj) :: e_sat_ice_vctr !: vapour pressure at saturation in presence of ice [Pa]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptak
+ REAL(wp), DIMENSION(A2D(0)) :: e_sat_ice_vctr !: vapour pressure at saturation in presence of ice [Pa]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ptak
INTEGER :: ji, jj
!!----------------------------------------------------------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
e_sat_ice_vctr(ji,jj) = e_sat_ice_sclr( ptak(ji,jj) )
END_2D
@@ -712,11 +712,11 @@ CONTAINS
FUNCTION de_sat_dt_ice_vctr(ptak)
!! Same as "e_sat" but over ice rather than water!
- REAL(wp), DIMENSION(jpi,jpj) :: de_sat_dt_ice_vctr !: vapour pressure at saturation in presence of ice [Pa]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptak
+ REAL(wp), DIMENSION(A2D(0)) :: de_sat_dt_ice_vctr !: vapour pressure at saturation in presence of ice [Pa]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ptak
INTEGER :: ji, jj
!!----------------------------------------------------------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
de_sat_dt_ice_vctr(ji,jj) = de_sat_dt_ice_sclr( ptak(ji,jj) )
END_2D
@@ -751,16 +751,16 @@ CONTAINS
FUNCTION q_sat_vctr( pta, ppa, l_ice )
- REAL(wp), DIMENSION(jpi,jpj) :: q_sat_vctr
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pta !: absolute temperature of air [K]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ppa !: atmospheric pressure [Pa]
+ REAL(wp), DIMENSION(A2D(0)) :: q_sat_vctr
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pta !: absolute temperature of air [K]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ppa !: atmospheric pressure [Pa]
LOGICAL, INTENT(in), OPTIONAL :: l_ice !: we are above ice
LOGICAL :: lice
INTEGER :: ji, jj
!!----------------------------------------------------------------------------------
lice = .FALSE.
IF( PRESENT(l_ice) ) lice = l_ice
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
q_sat_vctr(ji,jj) = q_sat_sclr( pta(ji,jj) , ppa(ji,jj), l_ice=lice )
END_2D
@@ -790,12 +790,12 @@ CONTAINS
FUNCTION dq_sat_dt_ice_vctr( pta, ppa )
- REAL(wp), DIMENSION(jpi,jpj) :: dq_sat_dt_ice_vctr
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pta !: absolute temperature of air [K]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ppa !: atmospheric pressure [Pa]
+ REAL(wp), DIMENSION(A2D(0)) :: dq_sat_dt_ice_vctr
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pta !: absolute temperature of air [K]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ppa !: atmospheric pressure [Pa]
INTEGER :: ji, jj
!!----------------------------------------------------------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
dq_sat_dt_ice_vctr(ji,jj) = dq_sat_dt_ice_sclr( pta(ji,jj) , ppa(ji,jj) )
END_2D
@@ -808,16 +808,16 @@ CONTAINS
!!
!! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!----------------------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: q_air_rh
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: prha !: relative humidity [fraction, not %!!!]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptak !: air temperature [K]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ppa !: atmospheric pressure [Pa]
+ REAL(wp), DIMENSION(A2D(0)) :: q_air_rh
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: prha !: relative humidity [fraction, not %!!!]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ptak !: air temperature [K]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ppa !: atmospheric pressure [Pa]
!
INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: ze ! local scalar
!!----------------------------------------------------------------------------------
!
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
ze = prha(ji,jj)*e_sat_sclr(ptak(ji,jj))
q_air_rh(ji,jj) = ze*reps0/(ppa(ji,jj) - (1. - reps0)*ze)
END_2D
@@ -833,29 +833,29 @@ CONTAINS
!! and the module of the wind stress => pTau = Tau
!! ** Author: L. Brodeau, Sept. 2019 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!----------------------------------------------------------------------------------
- REAL(wp), INTENT(in) :: pzu ! height above the sea-level where all this takes place (normally 10m)
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pTs ! water temperature at the air-sea interface [K]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqs ! satur. spec. hum. at T=pTs [kg/kg]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pTa ! potential air temperature at z=pzu [K]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqa ! specific humidity at z=pzu [kg/kg]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pust ! u*
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptst ! t*
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqst ! q*
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pwnd ! wind speed module at z=pzu [m/s]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pUb ! bulk wind speed at z=pzu (inc. pot. effect of gustiness etc) [m/s]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ppa ! sea-level atmospheric pressure [Pa]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: prlw ! downwelling longwave radiative flux [W/m^2]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: prhoa ! air density [kg/m3]
+ REAL(wp), INTENT(in) :: pzu ! height above the sea-level where all this takes place (normally 10m)
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pTs ! water temperature at the air-sea interface [K]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pqs ! satur. spec. hum. at T=pTs [kg/kg]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pTa ! potential air temperature at z=pzu [K]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pqa ! specific humidity at z=pzu [kg/kg]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pust ! u*
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ptst ! t*
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pqst ! q*
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pwnd ! wind speed module at z=pzu [m/s]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pUb ! bulk wind speed at z=pzu (inc. pot. effect of gustiness etc) [m/s]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ppa ! sea-level atmospheric pressure [Pa]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: prlw ! downwelling longwave radiative flux [W/m^2]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: prhoa ! air density [kg/m3]
!
- REAL(wp), DIMENSION(jpi,jpj), INTENT(out) :: pQns ! non-solar heat flux to the ocean aka "Qlat + Qsen + Qlw" [W/m^2]]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(out) :: pTau ! module of the wind stress [N/m^2]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(out) :: pQns ! non-solar heat flux to the ocean aka "Qlat + Qsen + Qlw" [W/m^2]]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(out) :: pTau ! module of the wind stress [N/m^2]
!
- REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(out) :: Qlat
+ REAL(wp), DIMENSION(A2D(0)), OPTIONAL, INTENT(out) :: Qlat
!
REAL(wp) :: zdt, zdq, zCd, zCh, zCe, zz0, zQlat, zQsen, zQlw
INTEGER :: ji, jj ! dummy loop indices
!!----------------------------------------------------------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zdt = pTa(ji,jj) - pTs(ji,jj) ; zdt = SIGN( MAX(ABS(zdt),1.E-6_wp), zdt )
zdq = pqa(ji,jj) - pqs(ji,jj) ; zdq = SIGN( MAX(ABS(zdq),1.E-9_wp), zdq )
@@ -929,25 +929,25 @@ CONTAINS
& pTau, pQsen, pQlat, &
& pEvap, pfact_evap )
!!----------------------------------------------------------------------------------
- REAL(wp), INTENT(in) :: pzu ! height above the sea-level where all this takes place (normally 10m)
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pTs ! water temperature at the air-sea interface [K]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqs ! satur. spec. hum. at T=pTs [kg/kg]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pTa ! potential air temperature at z=pzu [K]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqa ! specific humidity at z=pzu [kg/kg]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pCd
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pCh
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pCe
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pwnd ! wind speed module at z=pzu [m/s]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pUb ! bulk wind speed at z=pzu (inc. pot. effect of gustiness etc) [m/s]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ppa ! sea-level atmospheric pressure [Pa]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: prhoa ! Air density at z=pzu [kg/m^3]
+ REAL(wp), INTENT(in) :: pzu ! height above the sea-level where all this takes place (normally 10m)
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pTs ! water temperature at the air-sea interface [K]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pqs ! satur. spec. hum. at T=pTs [kg/kg]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pTa ! potential air temperature at z=pzu [K]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pqa ! specific humidity at z=pzu [kg/kg]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pCd
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pCh
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pCe
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pwnd ! wind speed module at z=pzu [m/s]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pUb ! bulk wind speed at z=pzu (inc. pot. effect of gustiness etc) [m/s]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ppa ! sea-level atmospheric pressure [Pa]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: prhoa ! Air density at z=pzu [kg/m^3]
!!
- REAL(wp), DIMENSION(jpi,jpj), INTENT(out) :: pTau ! module of the wind stress [N/m^2]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(out) :: pQsen ! [W/m^2]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(out) :: pQlat ! [W/m^2]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(out) :: pTau ! module of the wind stress [N/m^2]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(out) :: pQsen ! [W/m^2]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(out) :: pQlat ! [W/m^2]
!!
- REAL(wp), DIMENSION(jpi,jpj), INTENT(out), OPTIONAL :: pEvap ! Evaporation [kg/m^2/s]
- REAL(wp), INTENT(in) , OPTIONAL :: pfact_evap ! ABOMINATION: corrective factor for evaporation (doing this against my will! /laurent)
+ REAL(wp), DIMENSION(A2D(0)), INTENT(out), OPTIONAL :: pEvap ! Evaporation [kg/m^2/s]
+ REAL(wp), INTENT(in) , OPTIONAL :: pfact_evap ! ABOMINATION: corrective factor for evaporation (doing this against my will! /laurent)
!!
REAL(wp) :: ztaa, zgamma, zrho, zUrho, zevap, zfact_evap
INTEGER :: ji, jj
@@ -955,7 +955,7 @@ CONTAINS
zfact_evap = 1._wp
IF( PRESENT(pfact_evap) ) zfact_evap = pfact_evap
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
CALL BULK_FORMULA_SCLR( pzu, pTs(ji,jj), pqs(ji,jj), pTa(ji,jj), pqa(ji,jj), &
& pCd(ji,jj), pCh(ji,jj), pCe(ji,jj), &
@@ -977,8 +977,8 @@ CONTAINS
!!
!! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!----------------------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: alpha_sw_vctr ! thermal expansion coefficient of sea-water [1/K]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: psst ! water temperature [K]
+ REAL(wp), DIMENSION(A2D(0)) :: alpha_sw_vctr ! thermal expansion coefficient of sea-water [1/K]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: psst ! water temperature [K]
!!----------------------------------------------------------------------------------
alpha_sw_vctr = 2.1e-5_wp * MAX(psst(:,:)-rt0 + 3.2_wp, 0._wp)**0.79
@@ -1027,16 +1027,16 @@ CONTAINS
FUNCTION qlw_net_vctr( pdwlw, pts, l_ice )
- REAL(wp), DIMENSION(jpi,jpj) :: qlw_net_vctr
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pdwlw !: downwelling longwave (aka infrared, aka thermal) radiation [W/m^2]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pts !: surface temperature [K]
+ REAL(wp), DIMENSION(A2D(0)) :: qlw_net_vctr
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pdwlw !: downwelling longwave (aka infrared, aka thermal) radiation [W/m^2]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pts !: surface temperature [K]
LOGICAL, INTENT(in), OPTIONAL :: l_ice !: we are above ice
LOGICAL :: lice
INTEGER :: ji, jj
!!----------------------------------------------------------------------------------
lice = .FALSE.
IF( PRESENT(l_ice) ) lice = l_ice
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
qlw_net_vctr(ji,jj) = qlw_net_sclr( pdwlw(ji,jj) , pts(ji,jj), l_ice=lice )
END_2D
@@ -1045,10 +1045,10 @@ CONTAINS
FUNCTION z0_from_Cd( pzu, pCd, ppsi )
- REAL(wp), DIMENSION(jpi,jpj) :: z0_from_Cd !: roughness length [m]
- REAL(wp) , INTENT(in) :: pzu !: reference height zu [m]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pCd !: (neutral or non-neutral) drag coefficient []
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: ppsi !: "Psi_m(pzu/L)" stability correction profile for momentum []
+ REAL(wp), DIMENSION(A2D(0)) :: z0_from_Cd !: roughness length [m]
+ REAL(wp) , INTENT(in) :: pzu !: reference height zu [m]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pCd !: (neutral or non-neutral) drag coefficient []
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in), OPTIONAL :: ppsi !: "Psi_m(pzu/L)" stability correction profile for momentum []
!!
!! If pCd is the NEUTRAL-STABILITY drag coefficient then ppsi must be 0 or not given
!! If pCd is the drag coefficient (in stable or unstable conditions) then pssi must be provided
@@ -1066,10 +1066,10 @@ CONTAINS
FUNCTION Cd_from_z0( pzu, pz0, ppsi )
- REAL(wp), DIMENSION(jpi,jpj) :: Cd_from_z0 !: (neutral or non-neutral) drag coefficient []
- REAL(wp) , INTENT(in) :: pzu !: reference height zu [m]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pz0 !: roughness length [m]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: ppsi !: "Psi_m(pzu/L)" stability correction profile for momentum []
+ REAL(wp), DIMENSION(A2D(0)) :: Cd_from_z0 !: (neutral or non-neutral) drag coefficient []
+ REAL(wp) , INTENT(in) :: pzu !: reference height zu [m]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pz0 !: roughness length [m]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in), OPTIONAL :: ppsi !: "Psi_m(pzu/L)" stability correction profile for momentum []
!!
!! If we want to return the NEUTRAL-STABILITY drag coefficient then ppsi must be 0 or not given
!! If we want to return the stability-corrected Cd (i.e. in stable or unstable conditions) then pssi must be provided
@@ -1111,14 +1111,14 @@ CONTAINS
FUNCTION f_m_louis_vctr( pzu, pRib, pCdn, pz0 )
- REAL(wp), DIMENSION(jpi,jpj) :: f_m_louis_vctr
- REAL(wp), INTENT(in) :: pzu
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pRib
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pCdn
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pz0
+ REAL(wp), DIMENSION(A2D(0)) :: f_m_louis_vctr
+ REAL(wp), INTENT(in) :: pzu
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pRib
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pCdn
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pz0
INTEGER :: ji, jj
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
f_m_louis_vctr(ji,jj) = f_m_louis_sclr( pzu, pRib(ji,jj), pCdn(ji,jj), pz0(ji,jj) )
END_2D
@@ -1150,14 +1150,14 @@ CONTAINS
FUNCTION f_h_louis_vctr( pzu, pRib, pChn, pz0 )
- REAL(wp), DIMENSION(jpi,jpj) :: f_h_louis_vctr
- REAL(wp), INTENT(in) :: pzu
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pRib
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pChn
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pz0
+ REAL(wp), DIMENSION(A2D(0)) :: f_h_louis_vctr
+ REAL(wp), INTENT(in) :: pzu
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pRib
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pChn
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pz0
INTEGER :: ji, jj
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
f_h_louis_vctr(ji,jj) = f_h_louis_sclr( pzu, pRib(ji,jj), pChn(ji,jj), pz0(ji,jj) )
END_2D
@@ -1168,11 +1168,11 @@ CONTAINS
!!----------------------------------------------------------------------------------
!! Provides the neutral-stability wind speed at 10 m
!!----------------------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: UN10_from_ustar !: neutral stability wind speed at 10m [m/s]
- REAL(wp), INTENT(in) :: pzu !: measurement heigh of wind speed [m]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pUzu !: bulk wind speed at height pzu m [m/s]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pus !: friction velocity [m/s]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ppsi !: "Psi_m(pzu/L)" stability correction profile for momentum []
+ REAL(wp), DIMENSION(A2D(0)) :: UN10_from_ustar !: neutral stability wind speed at 10m [m/s]
+ REAL(wp), INTENT(in) :: pzu !: measurement heigh of wind speed [m]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pUzu !: bulk wind speed at height pzu m [m/s]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pus !: friction velocity [m/s]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ppsi !: "Psi_m(pzu/L)" stability correction profile for momentum []
!!----------------------------------------------------------------------------------
UN10_from_ustar(:,:) = pUzu(:,:) - pus(:,:)/vkarmn * ( LOG(pzu/10._wp) - ppsi(:,:) )
!!
@@ -1183,11 +1183,11 @@ CONTAINS
!!----------------------------------------------------------------------------------
!! Provides the neutral-stability wind speed at 10 m
!!----------------------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: UN10_from_CD !: [m/s]
- REAL(wp), INTENT(in) :: pzu !: measurement heigh of bulk wind speed
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pUb !: bulk wind speed at height pzu m [m/s]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pCd !: drag coefficient
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ppsi !: "Psi_m(pzu/L)" stability correction profile for momentum []
+ REAL(wp), DIMENSION(A2D(0)) :: UN10_from_CD !: [m/s]
+ REAL(wp), INTENT(in) :: pzu !: measurement heigh of bulk wind speed
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pUb !: bulk wind speed at height pzu m [m/s]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pCd !: drag coefficient
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: ppsi !: "Psi_m(pzu/L)" stability correction profile for momentum []
!!----------------------------------------------------------------------------------
!! Reminder: UN10 = u*/vkarmn * log(10/z0)
!! and: u* = sqrt(Cd) * Ub
@@ -1214,10 +1214,10 @@ CONTAINS
!!
!! ** Author: L. Brodeau, April 2020 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!----------------------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: z0tq_LKB
- INTEGER, INTENT(in) :: iflag !: 1 => dealing with temperature; 2 => dealing with humidity
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pRer !: roughness Reynolds number [z_0 u*]/Nu_{air}
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pz0 !: roughness length (for momentum) [m]
+ REAL(wp), DIMENSION(A2D(0)) :: z0tq_LKB
+ INTEGER, INTENT(in) :: iflag !: 1 => dealing with temperature; 2 => dealing with humidity
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pRer !: roughness Reynolds number [z_0 u*]/Nu_{air}
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pz0 !: roughness length (for momentum) [m]
!-------------------------------------------------------------------
! Scalar Re_r relation from Liu et al.
REAL(wp), DIMENSION(8,2), PARAMETER :: &
@@ -1250,7 +1250,7 @@ CONTAINS
z0tq_LKB(:,:) = -999._wp
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zrr = pRer(ji,jj)
lfound = .FALSE.
diff --git a/src/OCE/SBC/sbcblk.F90 b/src/OCE/SBC/sbcblk.F90
index 397155a58091501fd54d1da3fedcb6bf39d23797..ba5255c909b32dffe6939c279d6c29c49abae526 100644
--- a/src/OCE/SBC/sbcblk.F90
+++ b/src/OCE/SBC/sbcblk.F90
@@ -124,7 +124,7 @@ MODULE sbcblk
!
INTEGER :: nn_iter_algo ! Number of iterations in bulk param. algo ("stable ABL + weak wind" requires more)
- REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: theta_zu, q_zu ! air temp. and spec. hum. at wind speed height (L15 bulk scheme)
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: theta_zu, q_zu ! air temp. and spec. hum. at wind speed height (L15 bulk scheme)
#if defined key_si3
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: Cd_ice , Ch_ice , Ce_ice !#LB transfert coefficients over ice
@@ -180,7 +180,7 @@ CONTAINS
!!-------------------------------------------------------------------
!! *** ROUTINE sbc_blk_alloc ***
!!-------------------------------------------------------------------
- ALLOCATE( theta_zu(jpi,jpj), q_zu(jpi,jpj), STAT=sbc_blk_alloc )
+ ALLOCATE( theta_zu(A2D(0)), q_zu(A2D(0)), STAT=sbc_blk_alloc )
CALL mpp_sum ( 'sbcblk', sbc_blk_alloc )
IF( sbc_blk_alloc /= 0 ) CALL ctl_stop( 'STOP', 'sbc_blk_alloc: failed to allocate arrays' )
END FUNCTION sbc_blk_alloc
@@ -190,8 +190,7 @@ CONTAINS
!!-------------------------------------------------------------------
!! *** ROUTINE sbc_blk_ice_alloc ***
!!-------------------------------------------------------------------
- ALLOCATE( Cd_ice (jpi,jpj), Ch_ice (jpi,jpj), Ce_ice (jpi,jpj), &
- & theta_zu_i(jpi,jpj), q_zu_i(jpi,jpj), STAT=sbc_blk_ice_alloc )
+ ALLOCATE( Cd_ice(A2D(0)), Ch_ice(A2D(0)), Ce_ice(A2D(0)), theta_zu_i(A2D(0)), q_zu_i(A2D(0)), STAT=sbc_blk_ice_alloc )
CALL mpp_sum ( 'sbcblk', sbc_blk_ice_alloc )
IF( sbc_blk_ice_alloc /= 0 ) CALL ctl_stop( 'STOP', 'sbc_blk_ice_alloc: failed to allocate arrays' )
END FUNCTION sbc_blk_ice_alloc
@@ -362,7 +361,7 @@ CONTAINS
ipka = 1
ENDIF
!
- ALLOCATE( sf(jfpr)%fnow(jpi,jpj,ipka) )
+ ALLOCATE( sf(jfpr)%fnow(A2D(0),ipka) )
!
IF( TRIM(sf(jfpr)%clrootname) == 'NOT USED' ) THEN !-- not used field --! (only now allocated and set to default)
IF( jfpr == jp_slp ) THEN
@@ -384,7 +383,7 @@ CONTAINS
CALL ctl_stop( ctmp1 )
ENDIF
ELSE !-- used field --!
- IF( sf(jfpr)%ln_tint ) ALLOCATE( sf(jfpr)%fdta(jpi,jpj,ipka,2) ) ! allocate array for temporal interpolation
+ IF( sf(jfpr)%ln_tint ) ALLOCATE( sf(jfpr)%fdta(A2D(0),ipka,2) ) ! allocate array for temporal interpolation
!
IF( sf(jfpr)%freqh > 0. .AND. MOD( NINT(3600. * sf(jfpr)%freqh), nn_fsbc * NINT(rn_Dt) ) /= 0 ) &
& CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rn_Dt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.', &
@@ -505,9 +504,10 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER, INTENT(in) :: kt ! ocean time step
!!----------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: zssq, zcd_du, zsen, zlat, zevp, zpre, ztheta
+ REAL(wp), DIMENSION(A2D(0)) :: zssq, zcd_du, zsen, zlat, zevp, zpre, ztheta
REAL(wp) :: ztst
LOGICAL :: llerr
+ INTEGER :: ji, jj
!!----------------------------------------------------------------------
!
CALL fld_read( kt, nn_fsbc, sf ) ! input fields provided at the current time-step
@@ -515,7 +515,8 @@ CONTAINS
! Sanity/consistence test on humidity at first time step to detect potential screw-up:
IF( kt == nit000 ) THEN
! mean humidity over ocean on proc
- ztst = glob_sum( 'sbcblk', sf(jp_humi)%fnow(:,:,1) * e1e2t(:,:) * tmask(:,:,1) ) / glob_sum( 'sbcblk', e1e2t(:,:) * tmask(:,:,1) )
+ ztst = glob_sum( 'sbcblk', sf(jp_humi)%fnow(:,:,1) * e1e2t(A2D(0)) * smask0(:,:) ) &
+ & / glob_sum( 'sbcblk', e1e2t(A2D(0)) * smask0(:,:) )
llerr = .FALSE.
SELECT CASE( nhumi )
CASE( np_humi_sph ) ! specific humidity => expect: 0. <= something < 0.065 [kg/kg] (0.061 is saturation at 45degC !!!)
@@ -568,7 +569,7 @@ CONTAINS
!
CALL blk_oce_1( kt, sf(jp_wndi )%fnow(:,:,1), sf(jp_wndj )%fnow(:,:,1), & ! <<= in
& theta_air_zt(:,:), q_air_zt(:,:), & ! <<= in
- & sf(jp_slp )%fnow(:,:,1), sst_m, ssu_m, ssv_m, & ! <<= in
+ & sf(jp_slp )%fnow(:,:,1), sst_m(A2D(0)), ssu_m(A2D(0)), ssv_m(A2D(0)), & ! <<= in
& sf(jp_uoatm)%fnow(:,:,1), sf(jp_voatm)%fnow(:,:,1), & ! <<= in
& sf(jp_qsr )%fnow(:,:,1), sf(jp_qlw )%fnow(:,:,1), & ! <<= in (wl/cs)
& tsk_m, zssq, zcd_du, zsen, zlat, zevp ) ! =>> out
@@ -600,7 +601,9 @@ CONTAINS
IF( ln_trcdc2dm ) THEN ! diurnal cycle in TOP
IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN
IF( ln_dm2dc ) THEN
- qsr_mean(:,:) = ( 1. - albo ) * sf(jp_qsr)%fnow(:,:,1) * tmask(:,:,1)
+ DO_2D( 0, 0, 0, 0 )
+ qsr_mean(ji,jj) = ( 1. - albo ) * sf(jp_qsr)%fnow(ji,jj,1) * smask0(ji,jj)
+ END_2D
ELSE
ncpl_qsr_freq = sf(jp_qsr)%freqh * 3600 ! qsr_mean will be computed in TOP
ENDIF
@@ -631,39 +634,39 @@ CONTAINS
!! - plat : latent heat flux (W/m^2)
!! - pevp : evaporation (mm/s) #lolo
!!---------------------------------------------------------------------
- INTEGER , INTENT(in ) :: kt ! time step index
- REAL(wp), INTENT(in ), DIMENSION(:,:) :: pwndi ! atmospheric wind at T-point [m/s]
- REAL(wp), INTENT(in ), DIMENSION(:,:) :: pwndj ! atmospheric wind at T-point [m/s]
- REAL(wp), INTENT(in ), DIMENSION(:,:) :: pqair ! specific humidity at T-points [kg/kg]
- REAL(wp), INTENT(in ), DIMENSION(:,:) :: ptair ! potential temperature at T-points [Kelvin]
- REAL(wp), INTENT(in ), DIMENSION(:,:) :: pslp ! sea-level pressure [Pa]
- REAL(wp), INTENT(in ), DIMENSION(:,:) :: pst ! surface temperature [Celsius]
- REAL(wp), INTENT(in ), DIMENSION(:,:) :: pu ! surface current at U-point (i-component) [m/s]
- REAL(wp), INTENT(in ), DIMENSION(:,:) :: pv ! surface current at V-point (j-component) [m/s]
- REAL(wp), INTENT(in ), DIMENSION(:,:) :: puatm ! surface current seen by the atm at T-point (i-component) [m/s]
- REAL(wp), INTENT(in ), DIMENSION(:,:) :: pvatm ! surface current seen by the atm at T-point (j-component) [m/s]
- REAL(wp), INTENT(in ), DIMENSION(:,:) :: pdqsr ! downwelling solar (shortwave) radiation at surface [W/m^2]
- REAL(wp), INTENT(in ), DIMENSION(:,:) :: pdqlw ! downwelling longwave radiation at surface [W/m^2]
- REAL(wp), INTENT( out), DIMENSION(:,:) :: ptsk ! skin temp. (or SST if CS & WL not used) [Celsius]
- REAL(wp), INTENT( out), DIMENSION(:,:) :: pssq ! specific humidity at pst [kg/kg]
- REAL(wp), INTENT( out), DIMENSION(:,:) :: pcd_du
- REAL(wp), INTENT( out), DIMENSION(:,:) :: psen
- REAL(wp), INTENT( out), DIMENSION(:,:) :: plat
- REAL(wp), INTENT( out), DIMENSION(:,:) :: pevp
+ INTEGER , INTENT(in ) :: kt ! time step index
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: pwndi ! atmospheric wind at T-point [m/s]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: pwndj ! atmospheric wind at T-point [m/s]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: pqair ! specific humidity at T-points [kg/kg]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: ptair ! potential temperature at T-points [Kelvin]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: pslp ! sea-level pressure [Pa]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: pst ! surface temperature [Celsius]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: pu ! surface current at U-point (i-component) [m/s]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: pv ! surface current at V-point (j-component) [m/s]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: puatm ! surface current seen by the atm at T-point (i-component) [m/s]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: pvatm ! surface current seen by the atm at T-point (j-component) [m/s]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: pdqsr ! downwelling solar (shortwave) radiation at surface [W/m^2]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: pdqlw ! downwelling longwave radiation at surface [W/m^2]
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: ptsk ! skin temp. (or SST if CS & WL not used) [Celsius]
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: pssq ! specific humidity at pst [kg/kg]
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: pcd_du
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: psen
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: plat
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: pevp
!
INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zztmp ! local variable
REAL(wp) :: zstmax, zstau
#if defined key_cyclone
- REAL(wp), DIMENSION(jpi,jpj) :: zwnd_i, zwnd_j ! wind speed components at T-point
+ REAL(wp), DIMENSION(A2D(0)) :: zwnd_i, zwnd_j ! wind speed components at T-point
#endif
- REAL(wp), DIMENSION(jpi,jpj) :: zU_zu ! bulk wind speed at height zu [m/s]
- REAL(wp), DIMENSION(jpi,jpj) :: zcd_oce ! momentum transfert coefficient over ocean
- REAL(wp), DIMENSION(jpi,jpj) :: zch_oce ! sensible heat transfert coefficient over ocean
- REAL(wp), DIMENSION(jpi,jpj) :: zce_oce ! latent heat transfert coefficient over ocean
- REAL(wp), DIMENSION(jpi,jpj) :: zsspt ! potential sea-surface temperature [K]
- REAL(wp), DIMENSION(jpi,jpj) :: zpre, ztabs ! air pressure [Pa] & absolute temperature [K]
- REAL(wp), DIMENSION(jpi,jpj) :: zztmp1, zztmp2
+ REAL(wp), DIMENSION(A2D(0)) :: zU_zu ! bulk wind speed at height zu [m/s]
+ REAL(wp), DIMENSION(A2D(0)) :: zcd_oce ! momentum transfert coefficient over ocean
+ REAL(wp), DIMENSION(A2D(0)) :: zch_oce ! sensible heat transfert coefficient over ocean
+ REAL(wp), DIMENSION(A2D(0)) :: zce_oce ! latent heat transfert coefficient over ocean
+ REAL(wp), DIMENSION(A2D(0)) :: zsspt ! potential sea-surface temperature [K]
+ REAL(wp), DIMENSION(A2D(0)) :: zpre, ztabs ! air pressure [Pa] & absolute temperature [K]
+ REAL(wp), DIMENSION(A2D(0)) :: zztmp1, zztmp2
!!---------------------------------------------------------------------
!
! local scalars ( place there for vector optimisation purposes)
@@ -685,7 +688,7 @@ CONTAINS
zwnd_i(:,:) = 0._wp
zwnd_j(:,:) = 0._wp
CALL wnd_cyc( kt, zwnd_i, zwnd_j ) ! add analytical tropical cyclone (Vincent et al. JGR 2012)
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zwnd_i(ji,jj) = pwndi(ji,jj) + zwnd_i(ji,jj)
zwnd_j(ji,jj) = pwndj(ji,jj) + zwnd_j(ji,jj)
! ... scalar wind at T-point (not masked)
@@ -693,7 +696,7 @@ CONTAINS
END_2D
#else
! ... scalar wind module at T-point (not masked)
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
wndm(ji,jj) = SQRT( pwndi(ji,jj) * pwndi(ji,jj) + pwndj(ji,jj) * pwndj(ji,jj) )
END_2D
#endif
@@ -703,9 +706,9 @@ CONTAINS
! ocean albedo assumed to be constant + modify now Qsr to include the diurnal cycle
IF( ln_dm2dc ) THEN
- qsr(:,:) = ( 1._wp - albo ) * sbc_dcy( pdqsr(:,:) ) * tmask(:,:,1)
+ qsr(:,:) = ( 1._wp - albo ) * sbc_dcy( pdqsr(:,:) ) * smask0(:,:)
ELSE
- qsr(:,:) = ( 1._wp - albo ) * pdqsr(:,:) * tmask(:,:,1)
+ qsr(:,:) = ( 1._wp - albo ) * pdqsr(:,:) * smask0(:,:)
ENDIF
! ----------------------------------------------------------------------------- !
@@ -755,20 +758,20 @@ CONTAINS
END SELECT
! outputs
- IF( iom_use('Cd_oce') ) CALL iom_put( "Cd_oce", zcd_oce * tmask(:,:,1) )
- IF( iom_use('Ce_oce') ) CALL iom_put( "Ce_oce", zce_oce * tmask(:,:,1) )
- IF( iom_use('Ch_oce') ) CALL iom_put( "Ch_oce", zch_oce * tmask(:,:,1) )
+ IF( iom_use('Cd_oce') ) CALL iom_put( "Cd_oce", zcd_oce * smask0(:,:) )
+ IF( iom_use('Ce_oce') ) CALL iom_put( "Ce_oce", zce_oce * smask0(:,:) )
+ IF( iom_use('Ch_oce') ) CALL iom_put( "Ch_oce", zch_oce * smask0(:,:) )
!! LB: mainly here for debugging purpose:
- IF( iom_use('theta_zt') ) CALL iom_put( "theta_zt", (ptair-rt0) * tmask(:,:,1) ) ! potential temperature at z=zt
- IF( iom_use('q_zt') ) CALL iom_put( "q_zt", pqair * tmask(:,:,1) ) ! specific humidity "
- IF( iom_use('theta_zu') ) CALL iom_put( "theta_zu", (theta_zu -rt0) * tmask(:,:,1) ) ! potential temperature at z=zu
- IF( iom_use('q_zu') ) CALL iom_put( "q_zu", q_zu * tmask(:,:,1) ) ! specific humidity "
- IF( iom_use('ssq') ) CALL iom_put( "ssq", pssq * tmask(:,:,1) ) ! saturation specific humidity at z=0
- IF( iom_use('wspd_blk') ) CALL iom_put( "wspd_blk", zU_zu * tmask(:,:,1) ) ! bulk wind speed at z=zu
+ IF( iom_use('theta_zt') ) CALL iom_put( "theta_zt", (ptair-rt0) * smask0(:,:) ) ! potential temperature at z=zt
+ IF( iom_use('q_zt') ) CALL iom_put( "q_zt", pqair * smask0(:,:) ) ! specific humidity "
+ IF( iom_use('theta_zu') ) CALL iom_put( "theta_zu", (theta_zu -rt0) * smask0(:,:) ) ! potential temperature at z=zu
+ IF( iom_use('q_zu') ) CALL iom_put( "q_zu", q_zu * smask0(:,:) ) ! specific humidity "
+ IF( iom_use('ssq') ) CALL iom_put( "ssq", pssq * smask0(:,:) ) ! saturation specific humidity at z=0
+ IF( iom_use('wspd_blk') ) CALL iom_put( "wspd_blk", zU_zu * smask0(:,:) ) ! bulk wind speed at z=zu
! In the presence of sea-ice we do not use the cool-skin/warm-layer update of zsspt, pssq & ptsk from turb_*()
IF( ln_skin_cs .OR. ln_skin_wl ) THEN
- WHERE ( fr_i(:,:) > 0.001_wp )
+ WHERE ( fr_i(A2D(0)) > 0.001_wp )
zsspt(:,:) = zztmp1(:,:)
pssq (:,:) = zztmp2(:,:)
END WHERE
@@ -781,7 +784,7 @@ CONTAINS
IF( ln_abl ) THEN !== ABL formulation ==! multiplication by rho_air and turbulent fluxes computation done in ablstp
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zztmp = zU_zu(ji,jj)
wndm(ji,jj) = zztmp ! Store zU_zu in wndm to compute ustar2 in ablmod
pcd_du(ji,jj) = zztmp * zcd_oce(ji,jj)
@@ -793,7 +796,7 @@ CONTAINS
ELSE !== BLK formulation ==! turbulent fluxes computation
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zpre(ji,jj) = pres_temp( q_zu(ji,jj), pslp(ji,jj), rn_zu, ptpot=theta_zu(ji,jj), pta=ztabs(ji,jj) )
rhoa(ji,jj) = rho_air( ztabs(ji,jj), q_zu(ji,jj), zpre(ji,jj) )
END_2D
@@ -804,12 +807,12 @@ CONTAINS
& taum(:,:), psen(:,:), plat(:,:), &
& pEvap=pevp(:,:), pfact_evap=rn_efac )
- psen(:,:) = psen(:,:) * tmask(:,:,1)
- plat(:,:) = plat(:,:) * tmask(:,:,1)
- taum(:,:) = taum(:,:) * tmask(:,:,1)
- pevp(:,:) = pevp(:,:) * tmask(:,:,1)
+ psen(:,:) = psen(:,:) * smask0(:,:)
+ plat(:,:) = plat(:,:) * smask0(:,:)
+ taum(:,:) = taum(:,:) * smask0(:,:)
+ pevp(:,:) = pevp(:,:) * smask0(:,:)
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
IF( wndm(ji,jj) > 0._wp ) THEN
zztmp = taum(ji,jj) / wndm(ji,jj)
#if defined key_cyclone
@@ -828,19 +831,19 @@ CONTAINS
IF( ln_crt_fbk ) THEN ! aply eq. 10 and 11 of Renault et al. 2020 (doi: 10.1029/2019MS001715)
zstmax = MIN( rn_stau_a * 3._wp + rn_stau_b, 0._wp ) ! set the max value of Stau corresponding to a wind of 3 m/s (<0)
DO_2D( 0, 0, 0, 0 )
- zstau = MIN( rn_stau_a * wndm(ji,jj) + rn_stau_b, zstmax ) * tmask(ji,jj,1) ! stau (<0) must be smaller than zstmax
+ zstau = MIN( rn_stau_a * wndm(ji,jj) + rn_stau_b, zstmax ) * smask0(ji,jj) ! stau (<0) must be smaller than zstmax
utau(ji,jj) = utau(ji,jj) + zstau * ( 0.5_wp * ( pu(ji-1,jj ) + pu(ji,jj) ) - puatm(ji,jj) )
vtau(ji,jj) = vtau(ji,jj) + zstau * ( 0.5_wp * ( pv(ji ,jj-1) + pv(ji,jj) ) - pvatm(ji,jj) )
taum(ji,jj) = SQRT( utau(ji,jj) * utau(ji,jj) + vtau(ji,jj) * vtau(ji,jj) )
END_2D
- CALL lbc_lnk( 'sbcblk', utau, 'T', -1._wp, vtau, 'T', -1._wp, taum, 'T', 1._wp )
+ CALL lbc_lnk( 'sbcblk', utau, 'T', -1._wp, vtau, 'T', -1._wp )
ENDIF
! Saving open-ocean wind-stress (module and components)
CALL iom_put( "taum_oce", taum(:,:) ) ! wind stress module
! ! LB: These 2 lines below mostly here for 'STATION_ASF' test-case
- CALL iom_put( "utau_oce", utau(:,:) ) ! utau
- CALL iom_put( "vtau_oce", vtau(:,:) ) ! vtau
+ CALL iom_put( "utau_oce", utau(A2D(0)) ) ! utau
+ CALL iom_put( "vtau_oce", vtau(A2D(0)) ) ! vtau
IF(sn_cfctl%l_prtctl) THEN
CALL prt_ctl( tab2d_1=pssq , clinfo1=' blk_oce_1: pssq : ', mask1=tmask )
@@ -852,7 +855,7 @@ CONTAINS
!
ENDIF ! ln_blk / ln_abl
- ptsk(:,:) = ( ptsk(:,:) - rt0 ) * tmask(:,:,1) ! Back to Celsius
+ ptsk(:,:) = ( ptsk(:,:) - rt0 ) * smask0(:,:) ! Back to Celsius
IF( ln_skin_cs .OR. ln_skin_wl ) THEN
CALL iom_put( "t_skin" , ptsk ) ! T_skin in Celsius
@@ -879,60 +882,66 @@ CONTAINS
!! - qns : Non Solar heat flux over the ocean (W/m2)
!! - emp : evaporation minus precipitation (kg/m2/s)
!!---------------------------------------------------------------------
- REAL(wp), INTENT(in), DIMENSION(:,:) :: ptair ! potential temperature of air #LB: confirm!
- REAL(wp), INTENT(in), DIMENSION(:,:) :: pdqlw ! downwelling longwave radiation at surface [W/m^2]
- REAL(wp), INTENT(in), DIMENSION(:,:) :: pprec
- REAL(wp), INTENT(in), DIMENSION(:,:) :: psnow
- REAL(wp), INTENT(in), DIMENSION(:,:) :: ptsk ! SKIN surface temperature [Celsius]
- REAL(wp), INTENT(in), DIMENSION(:,:) :: psen
- REAL(wp), INTENT(in), DIMENSION(:,:) :: plat
- REAL(wp), INTENT(in), DIMENSION(:,:) :: pevp
+ REAL(wp), INTENT(in), DIMENSION(A2D(0)) :: ptair ! potential temperature of air #LB: confirm!
+ REAL(wp), INTENT(in), DIMENSION(A2D(0)) :: pdqlw ! downwelling longwave radiation at surface [W/m^2]
+ REAL(wp), INTENT(in), DIMENSION(A2D(0)) :: pprec
+ REAL(wp), INTENT(in), DIMENSION(A2D(0)) :: psnow
+ REAL(wp), INTENT(in), DIMENSION(A2D(0)) :: ptsk ! SKIN surface temperature [Celsius]
+ REAL(wp), INTENT(in), DIMENSION(A2D(0)) :: psen
+ REAL(wp), INTENT(in), DIMENSION(A2D(0)) :: plat
+ REAL(wp), INTENT(in), DIMENSION(A2D(0)) :: pevp
!
INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zztmp,zz1,zz2,zz3 ! local variable
- REAL(wp), DIMENSION(jpi,jpj) :: zqlw ! net long wave radiative heat flux
- REAL(wp), DIMENSION(jpi,jpj) :: zcptrain, zcptsnw, zcptn ! Heat content per unit mass (J/kg)
+ REAL(wp), DIMENSION(A2D(0)) :: zqlw ! net long wave radiative heat flux
+ REAL(wp), DIMENSION(A2D(0)) :: zcptrain, zcptsnw, zcptn ! Heat content per unit mass (J/kg)
!!---------------------------------------------------------------------
!
- ! Heat content per unit mass (J/kg)
- zcptrain(:,:) = ( ptair - rt0 ) * rcp * tmask(:,:,1)
- zcptsnw (:,:) = ( MIN( ptair, rt0 ) - rt0 ) * rcpi * tmask(:,:,1)
- zcptn (:,:) = ptsk * rcp * tmask(:,:,1)
- !
+ DO_2D( 0, 0, 0, 0 )
+ ! Heat content per unit mass (J/kg)
+ zcptrain(ji,jj) = ( ptair(ji,jj) - rt0 ) * rcp * smask0(ji,jj)
+ zcptsnw (ji,jj) = ( MIN( ptair(ji,jj), rt0 ) - rt0 ) * rcpi * smask0(ji,jj)
+ zcptn (ji,jj) = ptsk (ji,jj) * rcp * smask0(ji,jj)
+ !
+ END_2D
! ----------------------------------------------------------------------------- !
! III Net longwave radiative FLUX !
! ----------------------------------------------------------------------------- !
!! #LB: now moved after Turbulent fluxes because must use the skin temperature rather than bulk SST
!! (ptsk is skin temperature if ln_skin_cs==.TRUE. .OR. ln_skin_wl==.TRUE.)
zqlw(:,:) = qlw_net( pdqlw(:,:), ptsk(:,:)+rt0 )
-
+
! ----------------------------------------------------------------------------- !
! IV Total FLUXES !
! ----------------------------------------------------------------------------- !
!
- emp (:,:) = ( pevp(:,:) - pprec(:,:) * rn_pfac ) * tmask(:,:,1) ! mass flux (evap. - precip.)
- !
- qns(:,:) = zqlw(:,:) + psen(:,:) + plat(:,:) & ! Downward Non Solar
- & - psnow(:,:) * rn_pfac * rLfus & ! remove latent melting heat for solid precip
- & - pevp(:,:) * zcptn(:,:) & ! remove evap heat content at SST
- & + ( pprec(:,:) - psnow(:,:) ) * rn_pfac * zcptrain(:,:) & ! add liquid precip heat content at Tair
- & + psnow(:,:) * rn_pfac * zcptsnw(:,:) ! add solid precip heat content at min(Tair,Tsnow)
- qns(:,:) = qns(:,:) * tmask(:,:,1)
+ DO_2D( 0, 0, 0, 0 )
+ emp (ji,jj) = ( pevp(ji,jj) - pprec(ji,jj) * rn_pfac ) * smask0(ji,jj) ! mass flux (evap. - precip.)
+ !
+ qns(ji,jj) = zqlw(ji,jj) + psen(ji,jj) + plat(ji,jj) & ! Downward Non Solar
+ & - psnow(ji,jj) * rn_pfac * rLfus & ! remove latent melting heat for solid precip
+ & - pevp(ji,jj) * zcptn(ji,jj) & ! remove evap heat content at SST
+ & + ( pprec(ji,jj) - psnow(ji,jj) ) * rn_pfac * zcptrain(ji,jj) & ! add liquid precip heat content at Tair
+ & + psnow(ji,jj) * rn_pfac * zcptsnw(ji,jj) ! add solid precip heat content at min(Tair,Tsnow)
+ qns(ji,jj) = qns(ji,jj) * smask0(ji,jj)
+ END_2D
!
#if defined key_si3
IF ( nn_ice == 2 ) THEN
- qns_oce(:,:) = zqlw(:,:) + psen(:,:) + plat(:,:) ! non solar without emp (only needed by SI3)
- qsr_oce(:,:) = qsr(:,:)
+ DO_2D( 0, 0, 0, 0 )
+ qns_oce(ji,jj) = zqlw(ji,jj) + psen(ji,jj) + plat(ji,jj) ! non solar without emp (only needed by SI3)
+ qsr_oce(ji,jj) = qsr(ji,jj)
+ END_2D
ENDIF
#endif
!
- CALL iom_put( "rho_air" , rhoa*tmask(:,:,1) ) ! output air density [kg/m^3]
+ CALL iom_put( "rho_air" , rhoa*smask0(:,:) ) ! output air density [kg/m^3]
CALL iom_put( "evap_oce" , pevp ) ! evaporation
CALL iom_put( "qlw_oce" , zqlw ) ! output downward longwave heat over the ocean
CALL iom_put( "qsb_oce" , psen ) ! output downward sensible heat over the ocean
CALL iom_put( "qla_oce" , plat ) ! output downward latent heat over the ocean
- tprecip(:,:) = pprec(:,:) * rn_pfac * tmask(:,:,1) ! output total precipitation [kg/m2/s]
- sprecip(:,:) = psnow(:,:) * rn_pfac * tmask(:,:,1) ! output solid precipitation [kg/m2/s]
+ tprecip(:,:) = pprec(:,:) * rn_pfac * smask0(:,:) ! output total precipitation [kg/m2/s]
+ sprecip(:,:) = psnow(:,:) * rn_pfac * smask0(:,:) ! output solid precipitation [kg/m2/s]
CALL iom_put( 'snowpre', sprecip ) ! Snow
CALL iom_put( 'precip' , tprecip ) ! Total precipitation
!
@@ -974,29 +983,29 @@ CONTAINS
!! formulea, ice variables and read atmospheric fields.
!! NB: ice drag coefficient is assumed to be a constant
!!---------------------------------------------------------------------
- REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: pslp ! sea-level pressure [Pa]
- REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: pwndi ! atmospheric wind at T-point [m/s]
- REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: pwndj ! atmospheric wind at T-point [m/s]
- REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: ptair ! atmospheric potential temperature at T-point [K]
- REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: pqair ! atmospheric specific humidity at T-point [kg/kg]
- REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: puice ! sea-ice velocity on I or C grid [m/s]
- REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: pvice ! "
- REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: ptsui ! sea-ice surface temperature [K]
- REAL(wp) , INTENT( out), DIMENSION(:,: ), OPTIONAL :: putaui ! if ln_blk
- REAL(wp) , INTENT( out), DIMENSION(:,: ), OPTIONAL :: pvtaui ! if ln_blk
- REAL(wp) , INTENT( out), DIMENSION(:,: ), OPTIONAL :: pseni ! if ln_abl
- REAL(wp) , INTENT( out), DIMENSION(:,: ), OPTIONAL :: pevpi ! if ln_abl
- REAL(wp) , INTENT( out), DIMENSION(:,: ), OPTIONAL :: pssqi ! if ln_abl
- REAL(wp) , INTENT( out), DIMENSION(:,: ), OPTIONAL :: pcd_dui ! if ln_abl
+ REAL(wp) , INTENT(in ), DIMENSION(A2D(0) ) :: pslp ! sea-level pressure [Pa]
+ REAL(wp) , INTENT(in ), DIMENSION(A2D(0) ) :: pwndi ! atmospheric wind at T-point [m/s]
+ REAL(wp) , INTENT(in ), DIMENSION(A2D(0) ) :: pwndj ! atmospheric wind at T-point [m/s]
+ REAL(wp) , INTENT(in ), DIMENSION(A2D(0) ) :: ptair ! atmospheric potential temperature at T-point [K]
+ REAL(wp) , INTENT(in ), DIMENSION(A2D(0) ) :: pqair ! atmospheric specific humidity at T-point [kg/kg]
+ REAL(wp) , INTENT(in ), DIMENSION(A2D(0) ) :: puice ! sea-ice velocity on I or C grid [m/s]
+ REAL(wp) , INTENT(in ), DIMENSION(A2D(0) ) :: pvice ! "
+ REAL(wp) , INTENT(in ), DIMENSION(A2D(0) ) :: ptsui ! sea-ice surface temperature [K]
+ REAL(wp) , INTENT( out), DIMENSION(A2D(0) ), OPTIONAL :: putaui ! if ln_blk
+ REAL(wp) , INTENT( out), DIMENSION(A2D(0) ), OPTIONAL :: pvtaui ! if ln_blk
+ REAL(wp) , INTENT( out), DIMENSION(A2D(0) ), OPTIONAL :: pseni ! if ln_abl
+ REAL(wp) , INTENT( out), DIMENSION(A2D(0) ), OPTIONAL :: pevpi ! if ln_abl
+ REAL(wp) , INTENT( out), DIMENSION(A2D(0) ), OPTIONAL :: pssqi ! if ln_abl
+ REAL(wp) , INTENT( out), DIMENSION(A2D(0) ), OPTIONAL :: pcd_dui ! if ln_abl
!
INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zztmp ! temporary scalars
- REAL(wp), DIMENSION(jpi,jpj) :: ztmp, zsipt ! temporary array
- REAL(wp), DIMENSION(jpi,jpj) :: zmsk00 ! O% concentration ice mask
+ REAL(wp), DIMENSION(A2D(0)) :: ztmp, zsipt ! temporary array
+ REAL(wp), DIMENSION(A2D(0)) :: zmsk00 ! O% concentration ice mask
!!---------------------------------------------------------------------
!
! treshold for outputs
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , fr_i(ji,jj) - 1.e-6_wp ) ) ! 1 if ice, 0 if no ice
END_2D
@@ -1004,7 +1013,7 @@ CONTAINS
! Wind module relative to the moving ice ( U10m - U_ice ) !
! ------------------------------------------------------------ !
! C-grid ice dynamics : U & V-points (same as ocean)
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
wndm_ice(ji,jj) = SQRT( pwndi(ji,jj) * pwndi(ji,jj) + pwndj(ji,jj) * pwndj(ji,jj) )
END_2D
!
@@ -1030,12 +1039,12 @@ CONTAINS
!
CASE( np_ice_lu12 ) ! from Lupkes(2012) equations
ztmp(:,:) = q_sat( ptsui(:,:), pslp(:,:), l_ice=.TRUE. ) ! temporary array for SSQ
- CALL turb_ice_lu12( rn_zqt, rn_zu, zsipt, ptair, ztmp, pqair, wndm_ice, fr_i, &
+ CALL turb_ice_lu12( rn_zqt, rn_zu, zsipt, ptair, ztmp, pqair, wndm_ice, fr_i(A2D(0)), &
& Cd_ice, Ch_ice, Ce_ice, theta_zu_i, q_zu_i )
!
CASE( np_ice_lg15 ) ! from Lupkes and Gryanik (2015) equations
ztmp(:,:) = q_sat( ptsui(:,:), pslp(:,:), l_ice=.TRUE. ) ! temporary array for SSQ
- CALL turb_ice_lg15( rn_zqt, rn_zu, zsipt, ptair, ztmp, pqair, wndm_ice, fr_i, &
+ CALL turb_ice_lg15( rn_zqt, rn_zu, zsipt, ptair, ztmp, pqair, wndm_ice, fr_i(A2D(0)), &
& Cd_ice, Ch_ice, Ce_ice, theta_zu_i, q_zu_i )
!
END SELECT
@@ -1046,7 +1055,7 @@ CONTAINS
! Wind stress relative to nonmoving ice ( U10m ) !
! ---------------------------------------------------- !
! supress moving ice in wind stress computation as we don't know how to do it properly...
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zztmp = rhoa(ji,jj) * Cd_ice(ji,jj) * wndm_ice(ji,jj)
putaui(ji,jj) = zztmp * pwndi(ji,jj)
pvtaui(ji,jj) = zztmp * pwndj(ji,jj)
@@ -1063,7 +1072,7 @@ CONTAINS
& , tab2d_2=pvtaui , clinfo2=' pvtaui : ', mask2=tmask )
ELSE ! ln_abl
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
pcd_dui(ji,jj) = wndm_ice(ji,jj) * Cd_ice(ji,jj)
pseni (ji,jj) = wndm_ice(ji,jj) * Ch_ice(ji,jj)
pevpi (ji,jj) = wndm_ice(ji,jj) * Ce_ice(ji,jj)
@@ -1094,30 +1103,30 @@ CONTAINS
!!
!! caution : the net upward water flux has with mm/day unit
!!---------------------------------------------------------------------
- REAL(wp), DIMENSION(:,:,:), INTENT(in) :: ptsu ! sea ice surface temperature [K]
- REAL(wp), DIMENSION(:,:,:), INTENT(in) :: phs ! snow thickness
- REAL(wp), DIMENSION(:,:,:), INTENT(in) :: phi ! ice thickness
- REAL(wp), DIMENSION(:,:,:), INTENT(in) :: palb ! ice albedo (all skies)
- REAL(wp), DIMENSION(:,: ), INTENT(in) :: ptair ! potential temperature of air #LB: okay ???
- REAL(wp), DIMENSION(:,: ), INTENT(in) :: pqair ! specific humidity of air
- REAL(wp), DIMENSION(:,: ), INTENT(in) :: pslp
- REAL(wp), DIMENSION(:,: ), INTENT(in) :: pdqlw
- REAL(wp), DIMENSION(:,: ), INTENT(in) :: pprec
- REAL(wp), DIMENSION(:,: ), INTENT(in) :: psnow
+ REAL(wp), DIMENSION(A2D(0),jpl), INTENT(in) :: ptsu ! sea ice surface temperature [K]
+ REAL(wp), DIMENSION(A2D(0),jpl), INTENT(in) :: phs ! snow thickness
+ REAL(wp), DIMENSION(A2D(0),jpl), INTENT(in) :: phi ! ice thickness
+ REAL(wp), DIMENSION(A2D(0),jpl), INTENT(in) :: palb ! ice albedo (all skies)
+ REAL(wp), DIMENSION(A2D(0) ), INTENT(in) :: ptair ! potential temperature of air #LB: okay ???
+ REAL(wp), DIMENSION(A2D(0) ), INTENT(in) :: pqair ! specific humidity of air
+ REAL(wp), DIMENSION(A2D(0) ), INTENT(in) :: pslp
+ REAL(wp), DIMENSION(A2D(0) ), INTENT(in) :: pdqlw
+ REAL(wp), DIMENSION(A2D(0) ), INTENT(in) :: pprec
+ REAL(wp), DIMENSION(A2D(0) ), INTENT(in) :: psnow
!!
INTEGER :: ji, jj, jl ! dummy loop indices
REAL(wp) :: zst, zst3, zsq, zsipt ! local variable
REAL(wp) :: zcoef_dqlw, zcoef_dqla ! - -
REAL(wp) :: zztmp, zzblk, zztmp1, z1_rLsub ! - -
REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zmsk ! temporary mask for prt_ctl
- REAL(wp), DIMENSION(jpi,jpj,jpl) :: z_qlw ! long wave heat flux over ice
- REAL(wp), DIMENSION(jpi,jpj,jpl) :: z_qsb ! sensible heat flux over ice
- REAL(wp), DIMENSION(jpi,jpj,jpl) :: z_dqlw ! long wave heat sensitivity over ice
- REAL(wp), DIMENSION(jpi,jpj,jpl) :: z_dqsb ! sensible heat sensitivity over ice
- REAL(wp), DIMENSION(jpi,jpj) :: zevap, zsnw ! evaporation and snw distribution after wind blowing (SI3)
- REAL(wp), DIMENSION(jpi,jpj) :: ztmp, ztmp2
- REAL(wp), DIMENSION(jpi,jpj) :: ztri
- REAL(wp), DIMENSION(jpi,jpj) :: zcptrain, zcptsnw, zcptn ! Heat content per unit mass (J/kg)
+ REAL(wp), DIMENSION(A2D(0),jpl) :: z_qlw ! long wave heat flux over ice
+ REAL(wp), DIMENSION(A2D(0),jpl) :: z_qsb ! sensible heat flux over ice
+ REAL(wp), DIMENSION(A2D(0),jpl) :: z_dqlw ! long wave heat sensitivity over ice
+ REAL(wp), DIMENSION(A2D(0),jpl) :: z_dqsb ! sensible heat sensitivity over ice
+ REAL(wp), DIMENSION(A2D(0)) :: zevap, zsnw ! evaporation and snw distribution after wind blowing (SI3)
+ REAL(wp), DIMENSION(A2D(0)) :: ztmp, ztmp2
+ REAL(wp), DIMENSION(A2D(0)) :: ztri
+ REAL(wp), DIMENSION(A2D(0)) :: zcptrain, zcptsnw, zcptn ! Heat content per unit mass (J/kg)
!!---------------------------------------------------------------------
!
zcoef_dqlw = 4._wp * emiss_i * stefan ! local scalars
@@ -1125,14 +1134,14 @@ CONTAINS
dqla_ice(:,:,:) = 0._wp
! Heat content per unit mass (J/kg)
- zcptrain(:,:) = ( ptair - rt0 ) * rcp * tmask(:,:,1)
- zcptsnw (:,:) = ( MIN( ptair, rt0 ) - rt0 ) * rcpi * tmask(:,:,1)
- zcptn (:,:) = sst_m * rcp * tmask(:,:,1)
+ zcptrain(:,:) = ( ptair(:,:) - rt0 ) * rcp * smask0(:,:)
+ zcptsnw (:,:) = ( MIN( ptair(:,:), rt0 ) - rt0 ) * rcpi * smask0(:,:)
+ zcptn (:,:) = sst_m(A2D(0)) * rcp * smask0(:,:)
!
! ! ========================== !
DO jl = 1, jpl ! Loop over ice categories !
! ! ========================== !
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zst = ptsu(ji,jj,jl) ! surface temperature of sea-ice [K]
zsq = q_sat( zst, pslp(ji,jj), l_ice=.TRUE. ) ! surface saturation specific humidity when ice present
@@ -1146,7 +1155,7 @@ CONTAINS
! Long Wave (lw)
zst3 = zst * zst * zst
- z_qlw(ji,jj,jl) = emiss_i * ( pdqlw(ji,jj) - stefan * zst * zst3 ) * tmask(ji,jj,1)
+ z_qlw(ji,jj,jl) = emiss_i * ( pdqlw(ji,jj) - stefan * zst * zst3 ) * smask0(ji,jj)
! lw sensitivity
z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3
@@ -1173,7 +1182,6 @@ CONTAINS
!qla_ice( ji,jj,jl) = zztmp1 * (zsq - q_zu_i(ji,jj))
!dqla_ice(ji,jj,jl) = zztmp1 * dq_sat_dt_ice(zst, pslp(ji,jj)) ! ==> Qlat sensitivity (dQlat/dT)
-
! ----------------------------!
! III Total FLUXES !
! ----------------------------!
@@ -1186,43 +1194,48 @@ CONTAINS
!
END DO
!
- tprecip(:,:) = pprec(:,:) * rn_pfac * tmask(:,:,1) ! total precipitation [kg/m2/s]
- sprecip(:,:) = psnow(:,:) * rn_pfac * tmask(:,:,1) ! solid precipitation [kg/m2/s]
- CALL iom_put( 'snowpre', sprecip ) ! Snow precipitation
- CALL iom_put( 'precip' , tprecip ) ! Total precipitation
-
- ! --- evaporation --- !
z1_rLsub = 1._wp / rLsub
- evap_ice (:,:,:) = rn_efac * qla_ice (:,:,:) * z1_rLsub ! sublimation
- devap_ice(:,:,:) = rn_efac * dqla_ice(:,:,:) * z1_rLsub ! d(sublimation)/dT
- zevap (:,:) = emp(:,:) + tprecip(:,:) ! evaporation over ocean !LB: removed rn_efac here, correct???
+ DO_2D( 0, 0, 0, 0 )
+ ! --- precipitation --- !
+ tprecip(ji,jj) = pprec(ji,jj) * rn_pfac * smask0(ji,jj) ! total precipitation [kg/m2/s]
+ sprecip(ji,jj) = psnow(ji,jj) * rn_pfac * smask0(ji,jj) ! solid precipitation [kg/m2/s]
+
+ ! --- evaporation --- !
+ zevap(ji,jj) = emp(ji,jj) + tprecip(ji,jj) ! evaporation over ocean !LB: removed rn_efac here, correct???
+ DO jl = 1, jpl
+ evap_ice (ji,jj,jl) = rn_efac * qla_ice (ji,jj,jl) * z1_rLsub ! sublimation
+ devap_ice(ji,jj,jl) = rn_efac * dqla_ice(ji,jj,jl) * z1_rLsub ! d(sublimation)/dT
+ ENDDO
+ END_2D
- ! --- evaporation minus precipitation --- !
zsnw(:,:) = 0._wp
- CALL ice_var_snwblow( (1.-at_i_b(:,:)), zsnw ) ! snow distribution over ice after wind blowing
- emp_oce(:,:) = ( 1._wp - at_i_b(:,:) ) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * (1._wp - zsnw )
- emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw
- emp_tot(:,:) = emp_oce(:,:) + emp_ice(:,:)
-
- ! --- heat flux associated with emp --- !
- qemp_oce(:,:) = - ( 1._wp - at_i_b(:,:) ) * zevap(:,:) * zcptn(:,:) & ! evap at sst
- & + ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) & ! liquid precip at Tair
- & + sprecip(:,:) * ( 1._wp - zsnw ) * ( zcptsnw (:,:) - rLfus ) ! solid precip at min(Tair,Tsnow)
- qemp_ice(:,:) = sprecip(:,:) * zsnw * ( zcptsnw (:,:) - rLfus ) ! solid precip (only)
-
- ! --- total solar and non solar fluxes --- !
- qns_tot(:,:) = ( 1._wp - at_i_b(:,:) ) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) &
- & + qemp_ice(:,:) + qemp_oce(:,:)
- qsr_tot(:,:) = ( 1._wp - at_i_b(:,:) ) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 )
-
- ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- !
- qprec_ice(:,:) = rhos * ( zcptsnw(:,:) - rLfus )
-
- ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) ---
- DO jl = 1, jpl
- qevap_ice(:,:,jl) = 0._wp ! should be -evap_ice(:,:,jl)*( ( Tice - rt0 ) * rcpi * tmask(:,:,1) )
- ! ! But we do not have Tice => consider it at 0degC => evap=0
- END DO
+ CALL ice_var_snwblow( (1.-at_i_b(:,:)), zsnw(:,:) ) ! snow distribution over ice after wind blowing
+ DO_2D( 0, 0, 0, 0 )
+ ! --- evaporation minus precipitation --- !
+ emp_oce(ji,jj) = ( 1._wp - at_i_b(ji,jj) ) * zevap(ji,jj) - ( tprecip(ji,jj) - sprecip(ji,jj) ) - sprecip(ji,jj) * (1._wp - zsnw(ji,jj) )
+ emp_ice(ji,jj) = SUM( a_i_b(ji,jj,:) * evap_ice(ji,jj,:) ) - sprecip(ji,jj) * zsnw(ji,jj)
+ emp_tot(ji,jj) = emp_oce(ji,jj) + emp_ice(ji,jj)
+
+ ! --- heat flux associated with emp --- !
+ qemp_oce(ji,jj) = - ( 1._wp - at_i_b(ji,jj) ) * zevap(ji,jj) * zcptn(ji,jj) & ! evap at sst
+ & + ( tprecip(ji,jj) - sprecip(ji,jj) ) * zcptrain(ji,jj) & ! liquid precip at Tair
+ & + sprecip(ji,jj) * ( 1._wp - zsnw(ji,jj) ) * ( zcptsnw (ji,jj) - rLfus ) ! solid precip at min(Tair,Tsnow)
+ qemp_ice(ji,jj) = sprecip(ji,jj) * zsnw(ji,jj) * ( zcptsnw (ji,jj) - rLfus ) ! solid precip (only)
+
+ ! --- total solar and non solar fluxes --- !
+ qns_tot(ji,jj) = ( 1._wp - at_i_b(ji,jj) ) * qns_oce(ji,jj) + SUM( a_i_b(ji,jj,:) * qns_ice(ji,jj,:) ) &
+ & + qemp_ice(ji,jj) + qemp_oce(ji,jj)
+ qsr_tot(ji,jj) = ( 1._wp - at_i_b(ji,jj) ) * qsr_oce(ji,jj) + SUM( a_i_b(ji,jj,:) * qsr_ice(ji,jj,:) )
+
+ ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- !
+ qprec_ice(ji,jj) = rhos * ( zcptsnw(ji,jj) - rLfus )
+
+ ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) ---
+ DO jl = 1, jpl
+ qevap_ice(ji,jj,jl) = 0._wp ! should be -evap_ice(ji,jj,jl)*( ( Tice - rt0 ) * rcpi * smask0(ji,jj) )
+ ! ! But we do not have Tice => consider it at 0degC => evap=0
+ ENDDO
+ END_2D
! --- shortwave radiation transmitted thru the surface scattering layer (W/m2) --- !
IF( nn_qtrice == 0 ) THEN
@@ -1247,9 +1260,11 @@ CONTAINS
qtr_ice_top(:,:,:) = 0.3_wp * qsr_ice(:,:,:)
ENDIF
!
+ CALL iom_put( 'snowpre', sprecip ) ! Snow precipitation
+ CALL iom_put( 'precip' , tprecip ) ! Total precipitation
IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') ) THEN
- CALL iom_put( 'evap_ao_cea' , zevap(:,:) * ( 1._wp - at_i_b(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average)
- CALL iom_put( 'hflx_evap_cea', zevap(:,:) * ( 1._wp - at_i_b(:,:) ) * tmask(:,:,1) * zcptn(:,:) ) ! heat flux from evap (cell average)
+ CALL iom_put( 'evap_ao_cea' , zevap(:,:) * ( 1._wp - at_i_b(:,:) ) * smask0(:,:) ) ! ice-free oce evap (cell average)
+ CALL iom_put( 'hflx_evap_cea', zevap(:,:) * ( 1._wp - at_i_b(:,:) ) * smask0(:,:) * zcptn(:,:) ) ! heat flux from evap (cell average)
ENDIF
IF( iom_use('rain') .OR. iom_use('rain_ao_cea') .OR. iom_use('hflx_rain_cea') ) THEN
CALL iom_put( 'rain' , tprecip(:,:) - sprecip(:,:) ) ! liquid precipitation
@@ -1269,14 +1284,14 @@ CONTAINS
& + ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) )
ENDIF
IF( iom_use('subl_ai_cea') .OR. iom_use('hflx_subl_cea') ) THEN
- CALL iom_put( 'subl_ai_cea' , SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) * tmask(:,:,1) ) ! Sublimation over sea-ice (cell average)
- CALL iom_put( 'hflx_subl_cea', SUM( a_i_b(:,:,:) * qevap_ice(:,:,:), dim=3 ) * tmask(:,:,1) ) ! Heat flux from sublimation (cell average)
+ CALL iom_put( 'subl_ai_cea' , SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) * smask0(:,:) ) ! Sublimation over sea-ice (cell average)
+ CALL iom_put( 'hflx_subl_cea', SUM( a_i_b(:,:,:) * qevap_ice(:,:,:), dim=3 ) * smask0(:,:) ) ! Heat flux from sublimation (cell average)
ENDIF
!
IF(sn_cfctl%l_prtctl) THEN
- ALLOCATE(zmsk(jpi,jpj,jpl))
+ ALLOCATE(zmsk(A2D(0),jpl))
DO jl = 1, jpl
- zmsk(:,:,jl) = tmask(:,:,1)
+ zmsk(:,:,jl) = smask0(:,:)
END DO
CALL prt_ctl(tab3d_1=qla_ice , clinfo1=' blk_ice: qla_ice : ', mask1=zmsk, &
& tab3d_2=z_qsb , clinfo2=' z_qsb : ' , mask2=zmsk, kdim=jpl)
@@ -1289,7 +1304,7 @@ CONTAINS
CALL prt_ctl(tab3d_1=ptsu , clinfo1=' blk_ice: ptsu : ', mask1=zmsk, &
& tab3d_2=qns_ice , clinfo2=' qns_ice : ' , mask2=zmsk, kdim=jpl)
CALL prt_ctl(tab2d_1=tprecip , clinfo1=' blk_ice: tprecip : ', mask1=tmask, &
- & tab2d_2=sprecip , clinfo2=' sprecip : ' , mask2=tmask )
+ & tab2d_2=sprecip , clinfo2=' sprecip : ' , mask2=tmask )
DEALLOCATE(zmsk)
ENDIF
@@ -1303,7 +1318,9 @@ CONTAINS
END SUBROUTINE blk_ice_2
- SUBROUTINE blk_ice_qcn( ld_virtual_itd, ptsu, ptb, phs, phi )
+ SUBROUTINE blk_ice_qcn( ld_virtual_itd, ptb, phs, phi, & ! <<== in
+ & pqcn_ice, pqml_ice, & ! ==>> out
+ & pqns_ice, ptsu ) ! ==>> inout
!!---------------------------------------------------------------------
!! *** ROUTINE blk_ice_qcn ***
!!
@@ -1318,12 +1335,15 @@ CONTAINS
!! - qcn_ice : surface inner conduction flux (W/m2)
!!
!!---------------------------------------------------------------------
- LOGICAL , INTENT(in ) :: ld_virtual_itd ! single-category option
- REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ptsu ! sea ice / snow surface temperature
- REAL(wp), DIMENSION(:,:) , INTENT(in ) :: ptb ! sea ice base temperature
- REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: phs ! snow thickness
- REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: phi ! sea ice thickness
- !
+ LOGICAL , INTENT(in ) :: ld_virtual_itd ! single-category option
+ REAL(wp), DIMENSION(A2D(0)) , INTENT(in ) :: ptb ! sea ice base temperature
+ REAL(wp), DIMENSION(A2D(0),jpl), INTENT(in ) :: phs ! snow thickness
+ REAL(wp), DIMENSION(A2D(0),jpl), INTENT(in ) :: phi ! sea ice thickness
+ REAL(wp), DIMENSION(A2D(0),jpl), INTENT( out) :: pqcn_ice
+ REAL(wp), DIMENSION(A2D(0),jpl), INTENT( out) :: pqml_ice
+ REAL(wp), DIMENSION(A2D(0),jpl), INTENT(inout) :: pqns_ice
+ REAL(wp), DIMENSION(A2D(0),jpl), INTENT(inout) :: ptsu ! sea ice / snow surface temperature
+ !
INTEGER , PARAMETER :: nit = 10 ! number of iterations
REAL(wp), PARAMETER :: zepsilon = 0.1_wp ! characteristic thickness for enhanced conduction
!
@@ -1333,7 +1353,7 @@ CONTAINS
REAL(wp) :: zkeff_h, ztsu, ztsu0 !
REAL(wp) :: zqc, zqnet !
REAL(wp) :: zhe, zqa0 !
- REAL(wp), DIMENSION(jpi,jpj,jpl) :: zgfac ! enhanced conduction factor
+ REAL(wp), DIMENSION(A2D(0),jpl) :: zgfac ! enhanced conduction factor
!!---------------------------------------------------------------------
! -------------------------------------!
@@ -1351,7 +1371,7 @@ CONTAINS
zfac3 = 2._wp / zepsilon
!
DO jl = 1, jpl
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zhe = ( rn_cnd_s * phi(ji,jj,jl) + rcnd_i * phs(ji,jj,jl) ) * zfac ! Effective thickness
IF( zhe >= zfac2 ) zgfac(ji,jj,jl) = MIN( 2._wp, 0.5_wp * ( 1._wp + LOG( zhe * zfac3 ) ) ) ! Enhanced conduction factor
END_2D
@@ -1366,13 +1386,13 @@ CONTAINS
zfac = rcnd_i * rn_cnd_s
!
DO jl = 1, jpl
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
!
zkeff_h = zfac * zgfac(ji,jj,jl) / & ! Effective conductivity of the snow-ice system divided by thickness
& ( rcnd_i * phs(ji,jj,jl) + rn_cnd_s * MAX( 0.01, phi(ji,jj,jl) ) )
ztsu = ptsu(ji,jj,jl) ! Store current iteration temperature
ztsu0 = ptsu(ji,jj,jl) ! Store initial surface temperature
- zqa0 = qsr_ice(ji,jj,jl) - qtr_ice_top(ji,jj,jl) + qns_ice(ji,jj,jl) ! Net initial atmospheric heat flux
+ zqa0 = qsr_ice(ji,jj,jl) - qtr_ice_top(ji,jj,jl) + pqns_ice(ji,jj,jl) ! Net initial atmospheric heat flux
!
DO iter = 1, nit ! --- Iterative loop
zqc = zkeff_h * ( ztsu - ptb(ji,jj) ) ! Conduction heat flux through snow-ice system (>0 downwards)
@@ -1380,10 +1400,10 @@ CONTAINS
ztsu = ztsu - zqnet / ( dqns_ice(ji,jj,jl) - zkeff_h ) ! Temperature update
END DO
!
- ptsu (ji,jj,jl) = MIN( rt0, ztsu )
- qcn_ice(ji,jj,jl) = zkeff_h * ( ptsu(ji,jj,jl) - ptb(ji,jj) )
- qns_ice(ji,jj,jl) = qns_ice(ji,jj,jl) + dqns_ice(ji,jj,jl) * ( ptsu(ji,jj,jl) - ztsu0 )
- qml_ice(ji,jj,jl) = ( qsr_ice(ji,jj,jl) - qtr_ice_top(ji,jj,jl) + qns_ice(ji,jj,jl) - qcn_ice(ji,jj,jl) ) &
+ ptsu (ji,jj,jl) = MIN( rt0, ztsu )
+ pqcn_ice(ji,jj,jl) = zkeff_h * ( ptsu(ji,jj,jl) - ptb(ji,jj) )
+ pqns_ice(ji,jj,jl) = pqns_ice(ji,jj,jl) + dqns_ice(ji,jj,jl) * ( ptsu(ji,jj,jl) - ztsu0 )
+ pqml_ice(ji,jj,jl) = ( qsr_ice(ji,jj,jl) - qtr_ice_top(ji,jj,jl) + pqns_ice(ji,jj,jl) - pqcn_ice(ji,jj,jl) ) &
& * MAX( 0._wp , SIGN( 1._wp, ptsu(ji,jj,jl) - rt0 ) )
! --- Diagnose the heat loss due to changing non-solar flux (as in icethd_zdf_bl99) --- !
diff --git a/src/OCE/SBC/sbcblk_algo_andreas.F90 b/src/OCE/SBC/sbcblk_algo_andreas.F90
index 5a2eb4113595c75c929953fceb95da6314a69ff3..7145a156fe42b3e658dcbea788db44783a43a7c3 100644
--- a/src/OCE/SBC/sbcblk_algo_andreas.F90
+++ b/src/OCE/SBC/sbcblk_algo_andreas.F90
@@ -85,34 +85,34 @@ CONTAINS
!!
!! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!----------------------------------------------------------------------------------
- REAL(wp), INTENT(in ) :: zt ! height for t_zt and q_zt [m]
- REAL(wp), INTENT(in ) :: zu ! height for U_zu [m]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: sst ! sea surface temperature [Kelvin]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: t_zt ! potential air temperature [Kelvin]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: ssq ! sea surface specific humidity [kg/kg]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: q_zt ! specific air humidity at zt [kg/kg]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: U_zu ! relative wind module at zu [m/s]
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Cd ! transfer coefficient for momentum (tau)
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Ch ! transfer coefficient for sensible heat (Q_sens)
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Ce ! transfert coefficient for evaporation (Q_lat)
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: t_zu ! pot. air temp. adjusted at zu [K]
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: q_zu ! spec. humidity adjusted at zu [kg/kg]
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Ubzu ! bulk wind speed at zu [m/s]
+ REAL(wp), INTENT(in ) :: zt ! height for t_zt and q_zt [m]
+ REAL(wp), INTENT(in ) :: zu ! height for U_zu [m]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: sst ! sea surface temperature [Kelvin]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: t_zt ! potential air temperature [Kelvin]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: ssq ! sea surface specific humidity [kg/kg]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: q_zt ! specific air humidity at zt [kg/kg]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: U_zu ! relative wind module at zu [m/s]
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Cd ! transfer coefficient for momentum (tau)
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Ch ! transfer coefficient for sensible heat (Q_sens)
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Ce ! transfert coefficient for evaporation (Q_lat)
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: t_zu ! pot. air temp. adjusted at zu [K]
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: q_zu ! spec. humidity adjusted at zu [kg/kg]
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Ubzu ! bulk wind speed at zu [m/s]
!
INTEGER , INTENT(in ), OPTIONAL :: nb_iter ! number of iterations
- REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: CdN
- REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: ChN
- REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: CeN
+ REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: CdN
+ REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: ChN
+ REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: CeN
!
INTEGER :: nbit, jit ! iterations...
LOGICAL :: l_zt_equal_zu = .FALSE. ! if q and t are given at same height as U
!!
- REAL(wp), DIMENSION(jpi,jpj) :: u_star, t_star, q_star
- REAL(wp), DIMENSION(jpi,jpj) :: z0 ! roughness length (momentum) [m]
- REAL(wp), DIMENSION(jpi,jpj) :: UN10 ! Neutral wind speed at zu [m/s]
- REAL(wp), DIMENSION(jpi,jpj) :: zeta_u ! stability parameter at height zu
- REAL(wp), DIMENSION(jpi,jpj) :: ztmp0, ztmp1, ztmp2
- REAL(wp), DIMENSION(jpi,jpj) :: RiB ! square root of Cd
+ REAL(wp), DIMENSION(A2D(0)) :: u_star, t_star, q_star
+ REAL(wp), DIMENSION(A2D(0)) :: z0 ! roughness length (momentum) [m]
+ REAL(wp), DIMENSION(A2D(0)) :: UN10 ! Neutral wind speed at zu [m/s]
+ REAL(wp), DIMENSION(A2D(0)) :: zeta_u ! stability parameter at height zu
+ REAL(wp), DIMENSION(A2D(0)) :: ztmp0, ztmp1, ztmp2
+ REAL(wp), DIMENSION(A2D(0)) :: RiB ! square root of Cd
!!
!!----------------------------------------------------------------------------------
nbit = nb_iter0
@@ -217,13 +217,13 @@ CONTAINS
!!
!! ** Author: L. Brodeau, April 2020 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!----------------------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pun10 !: neutral-stability scalar wind speed at 10m (m/s)
- REAL(wp), DIMENSION(jpi,jpj) :: u_star_andreas !: friction velocity [m/s]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pun10 !: neutral-stability scalar wind speed at 10m (m/s)
+ REAL(wp), DIMENSION(A2D(0)) :: u_star_andreas !: friction velocity [m/s]
!
INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: za, zt, zw ! local scalars
!!----------------------------------------------------------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zw = pun10(ji,jj)
za = zw - 8.271_wp
zt = za + SQRT( 0.12_wp*za*za + 0.181_wp )
@@ -243,8 +243,8 @@ CONTAINS
!!
!! ** Author: L. Brodeau, April 2020 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!----------------------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: psi_m_andreas
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta
+ REAL(wp), DIMENSION(A2D(0)) :: psi_m_andreas
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pzeta
!
REAL(wp), PARAMETER :: zam = 5._wp ! a_m (just below Eq.(9b)
REAL(wp), PARAMETER :: zbm = zam/6.5_wp ! b_m (just below Eq.(9b)
@@ -255,7 +255,7 @@ CONTAINS
INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zta, zx2, zx, zpsi_unst, zbbm, zpsi_stab, zstab ! local scalars
!!----------------------------------------------------------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
!
zta = MIN( pzeta(ji,jj) , 15._wp ) !! Very stable conditions (L positif and big!)
!
@@ -298,8 +298,8 @@ CONTAINS
!!
!! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!----------------------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: psi_h_andreas
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta
+ REAL(wp), DIMENSION(A2D(0)) :: psi_h_andreas
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pzeta
!
REAL(wp), PARAMETER :: zah = 5._wp ! a_h (just below Eq.(9b)
REAL(wp), PARAMETER :: zbh = 5._wp ! b_h (just below Eq.(9b)
@@ -309,7 +309,7 @@ CONTAINS
INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zta, zz, zx2, zpsi_unst, zpsi_stab, zstab ! local scalars
!!----------------------------------------------------------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
!
zta = MIN( pzeta(ji,jj) , 15._wp ) !! Very stable conditions (L positif and large!)
!
diff --git a/src/OCE/SBC/sbcblk_algo_coare3p0.F90 b/src/OCE/SBC/sbcblk_algo_coare3p0.F90
index 2ad244fcb4d788a921e25c502cfd966d479db70f..cd3da3ebd6b5853f812570fb9d666c583ed28080 100644
--- a/src/OCE/SBC/sbcblk_algo_coare3p0.F90
+++ b/src/OCE/SBC/sbcblk_algo_coare3p0.F90
@@ -71,7 +71,7 @@ CONTAINS
!!---------------------------------------------------------------------
IF( l_use_wl ) THEN
ierr = 0
- ALLOCATE ( Tau_ac(jpi,jpj) , Qnt_ac(jpi,jpj), dT_wl(jpi,jpj), Hz_wl(jpi,jpj), STAT=ierr )
+ ALLOCATE ( Tau_ac(A2D(0)) , Qnt_ac(A2D(0)), dT_wl(A2D(0)), Hz_wl(A2D(0)), STAT=ierr )
IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_COARE3P0_INIT => allocation of Tau_ac, Qnt_ac, dT_wl & Hz_wl failed!' )
Tau_ac(:,:) = 0._wp
Qnt_ac(:,:) = 0._wp
@@ -80,7 +80,7 @@ CONTAINS
ENDIF
IF( l_use_cs ) THEN
ierr = 0
- ALLOCATE ( dT_cs(jpi,jpj), STAT=ierr )
+ ALLOCATE ( dT_cs(A2D(0)), STAT=ierr )
IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_COARE3P0_INIT => allocation of dT_cs failed!' )
dT_cs(:,:) = -0.25_wp ! First guess of skin correction
ENDIF
@@ -151,44 +151,44 @@ CONTAINS
!!
!! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!----------------------------------------------------------------------------------
- INTEGER, INTENT(in ) :: kt ! current time step
- REAL(wp), INTENT(in ) :: zt ! height for t_zt and q_zt [m]
- REAL(wp), INTENT(in ) :: zu ! height for U_zu [m]
- REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: T_s ! sea surface temperature [Kelvin]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: t_zt ! potential air temperature [Kelvin]
- REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: q_s ! sea surface specific humidity [kg/kg]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: q_zt ! specific air humidity at zt [kg/kg]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: U_zu ! relative wind module at zu [m/s]
- LOGICAL , INTENT(in ) :: l_use_cs ! use the cool-skin parameterization
- LOGICAL , INTENT(in ) :: l_use_wl ! use the warm-layer parameterization
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Cd ! transfer coefficient for momentum (tau)
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Ch ! transfer coefficient for sensible heat (Q_sens)
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Ce ! transfert coefficient for evaporation (Q_lat)
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: t_zu ! pot. air temp. adjusted at zu [K]
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: q_zu ! spec. humidity adjusted at zu [kg/kg]
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Ubzu ! bulk wind speed at zu [m/s]
+ INTEGER, INTENT(in ) :: kt ! current time step
+ REAL(wp), INTENT(in ) :: zt ! height for t_zt and q_zt [m]
+ REAL(wp), INTENT(in ) :: zu ! height for U_zu [m]
+ REAL(wp), INTENT(inout), DIMENSION(A2D(0)) :: T_s ! sea surface temperature [Kelvin]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: t_zt ! potential air temperature [Kelvin]
+ REAL(wp), INTENT(inout), DIMENSION(A2D(0)) :: q_s ! sea surface specific humidity [kg/kg]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: q_zt ! specific air humidity at zt [kg/kg]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: U_zu ! relative wind module at zu [m/s]
+ LOGICAL , INTENT(in ) :: l_use_cs ! use the cool-skin parameterization
+ LOGICAL , INTENT(in ) :: l_use_wl ! use the warm-layer parameterization
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Cd ! transfer coefficient for momentum (tau)
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Ch ! transfer coefficient for sensible heat (Q_sens)
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Ce ! transfert coefficient for evaporation (Q_lat)
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: t_zu ! pot. air temp. adjusted at zu [K]
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: q_zu ! spec. humidity adjusted at zu [kg/kg]
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Ubzu ! bulk wind speed at zu [m/s]
!
- INTEGER , INTENT(in ), OPTIONAL :: nb_iter ! number of iterations
- REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: CdN
- REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: ChN
- REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: CeN
- REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(jpi,jpj) :: Qsw ! [W/m^2]
- REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(jpi,jpj) :: rad_lw ! [W/m^2]
- REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(jpi,jpj) :: slp ! [Pa]
- REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: pdT_cs
- REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: pdT_wl ! [K]
- REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: pHz_wl ! [m]
+ INTEGER , INTENT(in ), OPTIONAL :: nb_iter ! number of iterations
+ REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: CdN
+ REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: ChN
+ REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: CeN
+ REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(A2D(0)) :: Qsw ! [W/m^2]
+ REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(A2D(0)) :: rad_lw ! [W/m^2]
+ REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(A2D(0)) :: slp ! [Pa]
+ REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: pdT_cs
+ REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: pdT_wl ! [K]
+ REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: pHz_wl ! [m]
!
INTEGER :: nbit, jit
LOGICAL :: l_zt_equal_zu = .FALSE. ! if q and t are given at same height as U
!
- REAL(wp), DIMENSION(jpi,jpj) :: u_star, t_star, q_star
- REAL(wp), DIMENSION(jpi,jpj) :: dt_zu, dq_zu
- REAL(wp), DIMENSION(jpi,jpj) :: znu_a !: Nu_air, Viscosity of air
- REAL(wp), DIMENSION(jpi,jpj) :: z0, z0t
- REAL(wp), DIMENSION(jpi,jpj) :: zeta_u ! stability parameter at height zu
- REAL(wp), DIMENSION(jpi,jpj) :: ztmp0, ztmp1, ztmp2
- REAL(wp), DIMENSION(jpi,jpj) :: zpre, zrhoa, zta ! air pressure [Pa], density [kg/m3] & absolute temperature [k]
+ REAL(wp), DIMENSION(A2D(0)) :: u_star, t_star, q_star
+ REAL(wp), DIMENSION(A2D(0)) :: dt_zu, dq_zu
+ REAL(wp), DIMENSION(A2D(0)) :: znu_a !: Nu_air, Viscosity of air
+ REAL(wp), DIMENSION(A2D(0)) :: z0, z0t
+ REAL(wp), DIMENSION(A2D(0)) :: zeta_u ! stability parameter at height zu
+ REAL(wp), DIMENSION(A2D(0)) :: ztmp0, ztmp1, ztmp2
+ REAL(wp), DIMENSION(A2D(0)) :: zpre, zrhoa, zta ! air pressure [Pa], density [kg/m3] & absolute temperature [k]
!
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zeta_t ! stability parameter at height zt
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zsst ! to back up the initial bulk SST
@@ -201,7 +201,7 @@ CONTAINS
IF( PRESENT(nb_iter) ) nbit = nb_iter
l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) ! testing "zu == zt" is risky with double precision
- IF( .NOT. l_zt_equal_zu ) ALLOCATE( zeta_t(jpi,jpj) )
+ IF( .NOT. l_zt_equal_zu ) ALLOCATE( zeta_t(A2D(0)) )
!! Initializations for cool skin and warm layer:
IF( l_use_cs .AND. (.NOT.(PRESENT(Qsw) .AND. PRESENT(rad_lw) .AND. PRESENT(slp))) ) &
@@ -211,7 +211,7 @@ CONTAINS
& CALL ctl_stop( '['//TRIM(crtnm)//'] => ' , 'you need to provide Qsw, rad_lw & slp to use warm-layer param!' )
IF( l_use_cs .OR. l_use_wl ) THEN
- ALLOCATE ( zsst(jpi,jpj) )
+ ALLOCATE ( zsst(A2D(0)) )
zsst = T_s ! backing up the bulk SST
IF( l_use_cs ) T_s = T_s - 0.25_wp ! First guess of correction
q_s = rdct_qsat_salt*q_sat(MAX(T_s, 200._wp), slp) ! First guess of q_s
@@ -334,8 +334,8 @@ CONTAINS
CALL CS_COARE( Qsw, ztmp1, u_star, zsst, ztmp2 ) ! ! Qnsol -> ztmp1 / Qlat -> ztmp2
- T_s(:,:) = zsst(:,:) + dT_cs(:,:)*tmask(:,:,1)
- IF( l_use_wl ) T_s(:,:) = T_s(:,:) + dT_wl(:,:)*tmask(:,:,1)
+ T_s(:,:) = zsst(:,:) + dT_cs(:,:)*smask0(:,:)
+ IF( l_use_wl ) T_s(:,:) = T_s(:,:) + dT_wl(:,:)*smask0(:,:)
q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:))
ENDIF
@@ -347,8 +347,8 @@ CONTAINS
CALL WL_COARE( Qsw, ztmp1, zeta_u, zsst, MOD(nbit,jit) )
!! Updating T_s and q_s !!!
- T_s(:,:) = zsst(:,:) + dT_wl(:,:)*tmask(:,:,1)
- IF( l_use_cs ) T_s(:,:) = T_s(:,:) + dT_cs(:,:)*tmask(:,:,1)
+ T_s(:,:) = zsst(:,:) + dT_wl(:,:)*smask0(:,:)
+ IF( l_use_cs ) T_s(:,:) = T_s(:,:) + dT_cs(:,:)*smask0(:,:)
q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:))
ENDIF
@@ -392,13 +392,13 @@ CONTAINS
!!
!! Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!-------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: charn_coare3p0
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pwnd ! wind speed
+ REAL(wp), DIMENSION(A2D(0)) :: charn_coare3p0
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pwnd ! wind speed
!
INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zw, zgt10, zgt18
!!-------------------------------------------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
!
zw = pwnd(ji,jj) ! wind speed
!
@@ -426,13 +426,13 @@ CONTAINS
!!
!! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!----------------------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: psi_m_coare
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta
+ REAL(wp), DIMENSION(A2D(0)) :: psi_m_coare
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pzeta
!
INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zta, zphi_m, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab
!!----------------------------------------------------------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
!
zta = pzeta(ji,jj)
!
@@ -474,13 +474,13 @@ CONTAINS
!! Author: L. Brodeau, June 2016 / AeroBulk
!! (https://github.com/brodeau/aerobulk/)
!!----------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: psi_h_coare
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta
+ REAL(wp), DIMENSION(A2D(0)) :: psi_h_coare
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pzeta
!
INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zta, zphi_h, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab
!!----------------------------------------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
!
zta = pzeta(ji,jj)
!
diff --git a/src/OCE/SBC/sbcblk_algo_coare3p6.F90 b/src/OCE/SBC/sbcblk_algo_coare3p6.F90
index cb7fff12b99999e0c740d5d8a23393f8dcfec3e7..50f6800a0cd9b34f82ff23ae01ecbf999d654f39 100644
--- a/src/OCE/SBC/sbcblk_algo_coare3p6.F90
+++ b/src/OCE/SBC/sbcblk_algo_coare3p6.F90
@@ -61,7 +61,7 @@ CONTAINS
!!---------------------------------------------------------------------
IF( l_use_wl ) THEN
ierr = 0
- ALLOCATE ( Tau_ac(jpi,jpj) , Qnt_ac(jpi,jpj), dT_wl(jpi,jpj), Hz_wl(jpi,jpj), STAT=ierr )
+ ALLOCATE ( Tau_ac(A2D(0)) , Qnt_ac(A2D(0)), dT_wl(A2D(0)), Hz_wl(A2D(0)), STAT=ierr )
IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_COARE3P6_INIT => allocation of Tau_ac, Qnt_ac, dT_wl & Hz_wl failed!' )
Tau_ac(:,:) = 0._wp
Qnt_ac(:,:) = 0._wp
@@ -70,7 +70,7 @@ CONTAINS
ENDIF
IF( l_use_cs ) THEN
ierr = 0
- ALLOCATE ( dT_cs(jpi,jpj), STAT=ierr )
+ ALLOCATE ( dT_cs(A2D(0)), STAT=ierr )
IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_COARE3P6_INIT => allocation of dT_cs failed!' )
dT_cs(:,:) = -0.25_wp ! First guess of skin correction
ENDIF
@@ -141,44 +141,44 @@ CONTAINS
!!
!! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!----------------------------------------------------------------------------------
- INTEGER, INTENT(in ) :: kt ! current time step
- REAL(wp), INTENT(in ) :: zt ! height for t_zt and q_zt [m]
- REAL(wp), INTENT(in ) :: zu ! height for U_zu [m]
- REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: T_s ! sea surface temperature [Kelvin]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: t_zt ! potential air temperature [Kelvin]
- REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: q_s ! sea surface specific humidity [kg/kg]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: q_zt ! specific air humidity at zt [kg/kg]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: U_zu ! relative wind module at zu [m/s]
- LOGICAL , INTENT(in ) :: l_use_cs ! use the cool-skin parameterization
- LOGICAL , INTENT(in ) :: l_use_wl ! use the warm-layer parameterization
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Cd ! transfer coefficient for momentum (tau)
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Ch ! transfer coefficient for sensible heat (Q_sens)
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Ce ! transfert coefficient for evaporation (Q_lat)
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: t_zu ! pot. air temp. adjusted at zu [K]
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: q_zu ! spec. humidity adjusted at zu [kg/kg]
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Ubzu ! bulk wind speed at zu [m/s]
+ INTEGER, INTENT(in ) :: kt ! current time step
+ REAL(wp), INTENT(in ) :: zt ! height for t_zt and q_zt [m]
+ REAL(wp), INTENT(in ) :: zu ! height for U_zu [m]
+ REAL(wp), INTENT(inout), DIMENSION(A2D(0)) :: T_s ! sea surface temperature [Kelvin]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: t_zt ! potential air temperature [Kelvin]
+ REAL(wp), INTENT(inout), DIMENSION(A2D(0)) :: q_s ! sea surface specific humidity [kg/kg]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: q_zt ! specific air humidity at zt [kg/kg]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: U_zu ! relative wind module at zu [m/s]
+ LOGICAL , INTENT(in ) :: l_use_cs ! use the cool-skin parameterization
+ LOGICAL , INTENT(in ) :: l_use_wl ! use the warm-layer parameterization
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Cd ! transfer coefficient for momentum (tau)
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Ch ! transfer coefficient for sensible heat (Q_sens)
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Ce ! transfert coefficient for evaporation (Q_lat)
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: t_zu ! pot. air temp. adjusted at zu [K]
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: q_zu ! spec. humidity adjusted at zu [kg/kg]
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Ubzu ! bulk wind speed at zu [m/s]
!
- INTEGER , INTENT(in ), OPTIONAL :: nb_iter ! number of iterations
- REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: CdN
- REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: ChN
- REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: CeN
- REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(jpi,jpj) :: Qsw ! [W/m^2]
- REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(jpi,jpj) :: rad_lw ! [W/m^2]
- REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(jpi,jpj) :: slp ! [Pa]
- REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: pdT_cs
- REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: pdT_wl ! [K]
- REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: pHz_wl ! [m]
+ INTEGER , INTENT(in ), OPTIONAL :: nb_iter ! number of iterations
+ REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: CdN
+ REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: ChN
+ REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: CeN
+ REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(A2D(0)) :: Qsw ! [W/m^2]
+ REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(A2D(0)) :: rad_lw ! [W/m^2]
+ REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(A2D(0)) :: slp ! [Pa]
+ REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: pdT_cs
+ REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: pdT_wl ! [K]
+ REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: pHz_wl ! [m]
!
INTEGER :: nbit, jit
LOGICAL :: l_zt_equal_zu = .FALSE. ! if q and t are given at same height as U
!
- REAL(wp), DIMENSION(jpi,jpj) :: u_star, t_star, q_star
- REAL(wp), DIMENSION(jpi,jpj) :: dt_zu, dq_zu
- REAL(wp), DIMENSION(jpi,jpj) :: znu_a !: Nu_air, Viscosity of air
- REAL(wp), DIMENSION(jpi,jpj) :: z0, z0t
- REAL(wp), DIMENSION(jpi,jpj) :: zeta_u ! stability parameter at height zu
- REAL(wp), DIMENSION(jpi,jpj) :: ztmp0, ztmp1, ztmp2
- REAL(wp), DIMENSION(jpi,jpj) :: zpre, zrhoa, zta ! air pressure [Pa], density [kg/m3] & absolute temperature [k]
+ REAL(wp), DIMENSION(A2D(0)) :: u_star, t_star, q_star
+ REAL(wp), DIMENSION(A2D(0)) :: dt_zu, dq_zu
+ REAL(wp), DIMENSION(A2D(0)) :: znu_a !: Nu_air, Viscosity of air
+ REAL(wp), DIMENSION(A2D(0)) :: z0, z0t
+ REAL(wp), DIMENSION(A2D(0)) :: zeta_u ! stability parameter at height zu
+ REAL(wp), DIMENSION(A2D(0)) :: ztmp0, ztmp1, ztmp2
+ REAL(wp), DIMENSION(A2D(0)) :: zpre, zrhoa, zta ! air pressure [Pa], density [kg/m3] & absolute temperature [k]
!
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zeta_t ! stability parameter at height zt
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zsst ! to back up the initial bulk SST
@@ -191,7 +191,7 @@ CONTAINS
IF( PRESENT(nb_iter) ) nbit = nb_iter
l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) ! testing "zu == zt" is risky with double precision
- IF( .NOT. l_zt_equal_zu ) ALLOCATE( zeta_t(jpi,jpj) )
+ IF( .NOT. l_zt_equal_zu ) ALLOCATE( zeta_t(A2D(0)) )
!! Initializations for cool skin and warm layer:
IF( l_use_cs .AND. (.NOT.(PRESENT(Qsw) .AND. PRESENT(rad_lw) .AND. PRESENT(slp))) ) &
@@ -201,7 +201,7 @@ CONTAINS
& CALL ctl_stop( '['//TRIM(crtnm)//'] => ' , 'you need to provide Qsw, rad_lw & slp to use warm-layer param!' )
IF( l_use_cs .OR. l_use_wl ) THEN
- ALLOCATE ( zsst(jpi,jpj) )
+ ALLOCATE ( zsst(A2D(0)) )
zsst = T_s ! backing up the bulk SST
IF( l_use_cs ) T_s = T_s - 0.25_wp ! First guess of correction
q_s = rdct_qsat_salt*q_sat(MAX(T_s, 200._wp), slp) ! First guess of q_s
@@ -324,8 +324,8 @@ CONTAINS
CALL CS_COARE( Qsw, ztmp1, u_star, zsst, ztmp2 ) ! ! Qnsol -> ztmp1 / Qlat -> ztmp2
- T_s(:,:) = zsst(:,:) + dT_cs(:,:)*tmask(:,:,1)
- IF( l_use_wl ) T_s(:,:) = T_s(:,:) + dT_wl(:,:)*tmask(:,:,1)
+ T_s(:,:) = zsst(:,:) + dT_cs(:,:)*smask0(:,:)
+ IF( l_use_wl ) T_s(:,:) = T_s(:,:) + dT_wl(:,:)*smask0(:,:)
q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:))
ENDIF
@@ -337,8 +337,8 @@ CONTAINS
CALL WL_COARE( Qsw, ztmp1, zeta_u, zsst, MOD(nbit,jit) )
!! Updating T_s and q_s !!!
- T_s(:,:) = zsst(:,:) + dT_wl(:,:)*tmask(:,:,1)
- IF( l_use_cs ) T_s(:,:) = T_s(:,:) + dT_cs(:,:)*tmask(:,:,1)
+ T_s(:,:) = zsst(:,:) + dT_wl(:,:)*smask0(:,:)
+ IF( l_use_cs ) T_s(:,:) = T_s(:,:) + dT_cs(:,:)*smask0(:,:)
q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:))
ENDIF
@@ -378,8 +378,8 @@ CONTAINS
!!
!! Author: L. Brodeau, July 2019 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!-------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: charn_coare3p6
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pwnd ! neutral wind speed at 10m
+ REAL(wp), DIMENSION(A2D(0)) :: charn_coare3p6
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pwnd ! neutral wind speed at 10m
!
REAL(wp), PARAMETER :: charn0_max = 0.028 !: value above which the Charnock parameter levels off for winds > 18 m/s
!!-------------------------------------------------------------------
@@ -395,10 +395,10 @@ CONTAINS
!!
!! Author: L. Brodeau, October 2019 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!-------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: charn_coare3p6_wave
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pus ! friction velocity [m/s]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pwsh ! significant wave height [m]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pwps ! phase speed of dominant waves [m/s]
+ REAL(wp), DIMENSION(A2D(0)) :: charn_coare3p6_wave
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pus ! friction velocity [m/s]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pwsh ! significant wave height [m]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pwps ! phase speed of dominant waves [m/s]
!!-------------------------------------------------------------------
charn_coare3p6_wave = ( pwsh*0.2_wp*(pus/pwps)**2.2_wp ) * grav/(pus*pus)
!!
@@ -418,13 +418,13 @@ CONTAINS
!!
!! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!----------------------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: psi_m_coare
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta
+ REAL(wp), DIMENSION(A2D(0)) :: psi_m_coare
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pzeta
!
INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zta, zphi_m, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab
!!----------------------------------------------------------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
!
zta = pzeta(ji,jj)
!
@@ -466,13 +466,13 @@ CONTAINS
!! Author: L. Brodeau, June 2016 / AeroBulk
!! (https://github.com/brodeau/aerobulk/)
!!----------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: psi_h_coare
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta
+ REAL(wp), DIMENSION(A2D(0)) :: psi_h_coare
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pzeta
!
INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zta, zphi_h, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab
!!----------------------------------------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
!
zta = pzeta(ji,jj)
!
diff --git a/src/OCE/SBC/sbcblk_algo_ecmwf.F90 b/src/OCE/SBC/sbcblk_algo_ecmwf.F90
index d86c997565a355c17a2eee34b0f6b1ab72c06b92..eb316c81a35d78dbbe837788e3d03a477cad8f03 100644
--- a/src/OCE/SBC/sbcblk_algo_ecmwf.F90
+++ b/src/OCE/SBC/sbcblk_algo_ecmwf.F90
@@ -69,14 +69,14 @@ CONTAINS
!!---------------------------------------------------------------------
IF( l_use_wl ) THEN
ierr = 0
- ALLOCATE ( dT_wl(jpi,jpj), Hz_wl(jpi,jpj), STAT=ierr )
+ ALLOCATE ( dT_wl(A2D(0)), Hz_wl(A2D(0)), STAT=ierr )
IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_ECMWF_INIT => allocation of dT_wl & Hz_wl failed!' )
dT_wl(:,:) = 0._wp
Hz_wl(:,:) = rd0 ! (rd0, constant, = 3m is default for Zeng & Beljaars)
ENDIF
IF( l_use_cs ) THEN
ierr = 0
- ALLOCATE ( dT_cs(jpi,jpj), STAT=ierr )
+ ALLOCATE ( dT_cs(A2D(0)), STAT=ierr )
IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_ECMWF_INIT => allocation of dT_cs failed!' )
dT_cs(:,:) = -0.25_wp ! First guess of skin correction
ENDIF
@@ -147,48 +147,48 @@ CONTAINS
!!
!! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!----------------------------------------------------------------------------------
- INTEGER, INTENT(in ) :: kt ! current time step
- REAL(wp), INTENT(in ) :: zt ! height for t_zt and q_zt [m]
- REAL(wp), INTENT(in ) :: zu ! height for U_zu [m]
- REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: T_s ! sea surface temperature [Kelvin]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: t_zt ! potential air temperature [Kelvin]
- REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: q_s ! sea surface specific humidity [kg/kg]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: q_zt ! specific air humidity at zt [kg/kg]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: U_zu ! relative wind module at zu [m/s]
- LOGICAL , INTENT(in ) :: l_use_cs ! use the cool-skin parameterization
- LOGICAL , INTENT(in ) :: l_use_wl ! use the warm-layer parameterization
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Cd ! transfer coefficient for momentum (tau)
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Ch ! transfer coefficient for sensible heat (Q_sens)
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Ce ! transfert coefficient for evaporation (Q_lat)
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: t_zu ! pot. air temp. adjusted at zu [K]
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: q_zu ! spec. humidity adjusted at zu [kg/kg]
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Ubzu ! bulk wind speed at zu [m/s]
+ INTEGER, INTENT(in ) :: kt ! current time step
+ REAL(wp), INTENT(in ) :: zt ! height for t_zt and q_zt [m]
+ REAL(wp), INTENT(in ) :: zu ! height for U_zu [m]
+ REAL(wp), INTENT(inout), DIMENSION(A2D(0)) :: T_s ! sea surface temperature [Kelvin]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: t_zt ! potential air temperature [Kelvin]
+ REAL(wp), INTENT(inout), DIMENSION(A2D(0)) :: q_s ! sea surface specific humidity [kg/kg]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: q_zt ! specific air humidity at zt [kg/kg]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: U_zu ! relative wind module at zu [m/s]
+ LOGICAL , INTENT(in ) :: l_use_cs ! use the cool-skin parameterization
+ LOGICAL , INTENT(in ) :: l_use_wl ! use the warm-layer parameterization
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Cd ! transfer coefficient for momentum (tau)
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Ch ! transfer coefficient for sensible heat (Q_sens)
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Ce ! transfert coefficient for evaporation (Q_lat)
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: t_zu ! pot. air temp. adjusted at zu [K]
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: q_zu ! spec. humidity adjusted at zu [kg/kg]
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Ubzu ! bulk wind speed at zu [m/s]
!
- INTEGER , INTENT(in ), OPTIONAL :: nb_iter ! number of iterations
- REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: CdN
- REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: ChN
- REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: CeN
- REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(jpi,jpj) :: Qsw ! [W/m^2]
- REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(jpi,jpj) :: rad_lw ! [W/m^2]
- REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(jpi,jpj) :: slp ! [Pa]
- REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: pdT_cs
- REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: pdT_wl ! [K]
- REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: pHz_wl ! [m]
+ INTEGER , INTENT(in ), OPTIONAL :: nb_iter ! number of iterations
+ REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: CdN
+ REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: ChN
+ REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: CeN
+ REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(A2D(0)) :: Qsw ! [W/m^2]
+ REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(A2D(0)) :: rad_lw ! [W/m^2]
+ REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(A2D(0)) :: slp ! [Pa]
+ REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: pdT_cs
+ REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: pdT_wl ! [K]
+ REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: pHz_wl ! [m]
!
INTEGER :: nbit, jit
LOGICAL :: l_zt_equal_zu = .FALSE. ! if q and t are given at same height as U
!
- REAL(wp), DIMENSION(jpi,jpj) :: u_star, t_star, q_star
- REAL(wp), DIMENSION(jpi,jpj) :: dt_zu, dq_zu
- REAL(wp), DIMENSION(jpi,jpj) :: znu_a !: Nu_air, Viscosity of air
- REAL(wp), DIMENSION(jpi,jpj) :: Linv !: 1/L (inverse of Monin Obukhov length...
- REAL(wp), DIMENSION(jpi,jpj) :: z0, z0t, z0q
- REAL(wp), DIMENSION(jpi,jpj) :: zrhoa, zpre, zta ! air pressure [Pa], density [kg/m3] & absolute temperature [k]
+ REAL(wp), DIMENSION(A2D(0)) :: u_star, t_star, q_star
+ REAL(wp), DIMENSION(A2D(0)) :: dt_zu, dq_zu
+ REAL(wp), DIMENSION(A2D(0)) :: znu_a !: Nu_air, Viscosity of air
+ REAL(wp), DIMENSION(A2D(0)) :: Linv !: 1/L (inverse of Monin Obukhov length...
+ REAL(wp), DIMENSION(A2D(0)) :: z0, z0t, z0q
+ REAL(wp), DIMENSION(A2D(0)) :: zrhoa, zpre, zta ! air pressure [Pa], density [kg/m3] & absolute temperature [k]
!
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zsst ! to back up the initial bulk SST
!
- REAL(wp), DIMENSION(jpi,jpj) :: func_m, func_h
- REAL(wp), DIMENSION(jpi,jpj) :: ztmp0, ztmp1, ztmp2
+ REAL(wp), DIMENSION(A2D(0)) :: func_m, func_h
+ REAL(wp), DIMENSION(A2D(0)) :: ztmp0, ztmp1, ztmp2
CHARACTER(len=40), PARAMETER :: crtnm = 'turb_ecmwf@sbcblk_algo_ecmwf.F90'
!!----------------------------------------------------------------------------------
IF( kt == nit000 ) CALL SBCBLK_ALGO_ECMWF_INIT(l_use_cs, l_use_wl)
@@ -206,7 +206,7 @@ CONTAINS
& CALL ctl_stop( '['//TRIM(crtnm)//'] => ' , 'you need to provide Qsw, rad_lw & slp to use warm-layer param!' )
IF( l_use_cs .OR. l_use_wl ) THEN
- ALLOCATE ( zsst(jpi,jpj) )
+ ALLOCATE ( zsst(A2D(0)) )
zsst = T_s ! backing up the bulk SST
IF( l_use_cs ) T_s = T_s - 0.25_wp ! First guess of correction
q_s = rdct_qsat_salt*q_sat(MAX(T_s, 200._wp), slp) ! First guess of q_s
@@ -360,8 +360,8 @@ CONTAINS
CALL CS_ECMWF( Qsw, ztmp1, u_star, zsst ) ! Qnsol -> ztmp1
- T_s(:,:) = zsst(:,:) + dT_cs(:,:)*tmask(:,:,1)
- IF( l_use_wl ) T_s(:,:) = T_s(:,:) + dT_wl(:,:)*tmask(:,:,1)
+ T_s(:,:) = zsst(:,:) + dT_cs(:,:)*smask0(:,:)
+ IF( l_use_wl ) T_s(:,:) = T_s(:,:) + dT_wl(:,:)*smask0(:,:)
q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:))
ENDIF
@@ -372,8 +372,8 @@ CONTAINS
& ztmp1, ztmp2) ! Qnsol -> ztmp1 / Tau -> ztmp2
CALL WL_ECMWF( Qsw, ztmp1, u_star, zsst )
!! Updating T_s and q_s !!!
- T_s(:,:) = zsst(:,:) + dT_wl(:,:)*tmask(:,:,1) !
- IF( l_use_cs ) T_s(:,:) = T_s(:,:) + dT_cs(:,:)*tmask(:,:,1)
+ T_s(:,:) = zsst(:,:) + dT_wl(:,:)*smask0(:,:) !
+ IF( l_use_cs ) T_s(:,:) = T_s(:,:) + dT_cs(:,:)*smask0(:,:)
q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:))
ENDIF
@@ -413,14 +413,14 @@ CONTAINS
!!
!! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!----------------------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: psi_m_ecmwf
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta
+ REAL(wp), DIMENSION(A2D(0)) :: psi_m_ecmwf
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pzeta
!
INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zta, zx2, zx, ztmp, zpsi_unst, zpsi_stab, zstab, zc
!!----------------------------------------------------------------------------------
zc = 5._wp/0.35_wp
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
!
zta = MIN( pzeta(ji,jj) , 5._wp ) !! Very stable conditions (L positif and big!):
@@ -454,15 +454,15 @@ CONTAINS
!!
!! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!----------------------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: psi_h_ecmwf
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta
+ REAL(wp), DIMENSION(A2D(0)) :: psi_h_ecmwf
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pzeta
!
INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zta, zx2, zpsi_unst, zpsi_stab, zstab, zc
!!----------------------------------------------------------------------------------
zc = 5._wp/0.35_wp
!
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
!
zta = MIN(pzeta(ji,jj) , 5._wp) ! Very stable conditions (L positif and big!):
!
diff --git a/src/OCE/SBC/sbcblk_algo_ice_an05.F90 b/src/OCE/SBC/sbcblk_algo_ice_an05.F90
index 50ea20f6682af81c64258f1f549ac47700222717..36ed050eabd179a12ab59a318eefeccb6979fe21 100644
--- a/src/OCE/SBC/sbcblk_algo_ice_an05.F90
+++ b/src/OCE/SBC/sbcblk_algo_ice_an05.F90
@@ -79,26 +79,26 @@ CONTAINS
!!
!! ** Author: L. Brodeau, January 2020 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!----------------------------------------------------------------------------------
- REAL(wp), INTENT(in ) :: zt ! height for t_zt and q_zt [m]
- REAL(wp), INTENT(in ) :: zu ! height for U_zu [m]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: Ts_i ! ice surface temperature [Kelvin]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: t_zt ! potential air temperature [Kelvin]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: qs_i ! sat. spec. hum. at ice/air interface [kg/kg]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: q_zt ! spec. air humidity at zt [kg/kg]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: U_zu ! relative wind module at zu [m/s]
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: Cd_i ! drag coefficient over sea-ice
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: Ch_i ! transfert coefficient for heat over ice
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: Ce_i ! transfert coefficient for sublimation over ice
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: t_zu_i ! pot. air temp. adjusted at zu [K]
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: q_zu_i ! spec. humidity adjusted at zu [kg/kg]
+ REAL(wp), INTENT(in ) :: zt ! height for t_zt and q_zt [m]
+ REAL(wp), INTENT(in ) :: zu ! height for U_zu [m]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: Ts_i ! ice surface temperature [Kelvin]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: t_zt ! potential air temperature [Kelvin]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: qs_i ! sat. spec. hum. at ice/air interface [kg/kg]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: q_zt ! spec. air humidity at zt [kg/kg]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: U_zu ! relative wind module at zu [m/s]
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)) :: Cd_i ! drag coefficient over sea-ice
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)) :: Ch_i ! transfert coefficient for heat over ice
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)) :: Ce_i ! transfert coefficient for sublimation over ice
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)) :: t_zu_i ! pot. air temp. adjusted at zu [K]
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)) :: q_zu_i ! spec. humidity adjusted at zu [kg/kg]
!!----------------------------------------------------------------------------------
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: CdN
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: ChN
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: CeN
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: xz0 ! Aerodynamic roughness length [m]
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: xu_star ! u*, friction velocity
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: xL ! zeta (zu/L)
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: xUN10 ! Neutral wind at zu
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: CdN
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: ChN
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: CeN
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: xz0 ! Aerodynamic roughness length [m]
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: xu_star ! u*, friction velocity
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: xL ! zeta (zu/L)
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: xUN10 ! Neutral wind at zu
!!----------------------------------------------------------------------------------
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: Ubzu
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ztmp0, ztmp1, ztmp2 ! temporary stuff
@@ -116,10 +116,10 @@ CONTAINS
!!
CHARACTER(len=40), PARAMETER :: crtnm = 'turb_ice_an05@sbcblk_algo_ice_an05.f90'
!!----------------------------------------------------------------------------------
- ALLOCATE ( Ubzu(jpi,jpj), u_star(jpi,jpj), t_star(jpi,jpj), q_star(jpi,jpj), &
- & zeta_u(jpi,jpj), dt_zu(jpi,jpj), dq_zu(jpi,jpj), &
- & znu_a(jpi,jpj), ztmp1(jpi,jpj), ztmp2(jpi,jpj), &
- & z0(jpi,jpj), z0tq(jpi,jpj,2), ztmp0(jpi,jpj) )
+ ALLOCATE ( Ubzu(A2D(0)), u_star(A2D(0)), t_star(A2D(0)), q_star(A2D(0)), &
+ & zeta_u(A2D(0)), dt_zu(A2D(0)), dq_zu(A2D(0)), &
+ & znu_a(A2D(0)), ztmp1(A2D(0)), ztmp2(A2D(0)), &
+ & z0(A2D(0)), z0tq(A2D(0),2), ztmp0(A2D(0)) )
lreturn_cdn = PRESENT(CdN)
lreturn_chn = PRESENT(ChN)
@@ -130,7 +130,7 @@ CONTAINS
lreturn_UN10 = PRESENT(xUN10)
l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp )
- IF( .NOT. l_zt_equal_zu ) ALLOCATE( zeta_t(jpi,jpj) )
+ IF( .NOT. l_zt_equal_zu ) ALLOCATE( zeta_t(A2D(0)) )
!! Scalar wind speed cannot be below 0.2 m/s
Ubzu = MAX( U_zu, wspd_thrshld_ice )
@@ -227,14 +227,14 @@ CONTAINS
!!
!! Author: L. Brodeau, January 2020 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!----------------------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: rough_leng_m ! roughness length over sea-ice [m]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pus ! u* = friction velocity [m/s]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pnua ! kinematic viscosity of air [m^2/s]
+ REAL(wp), DIMENSION(A2D(0)) :: rough_leng_m ! roughness length over sea-ice [m]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pus ! u* = friction velocity [m/s]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pnua ! kinematic viscosity of air [m^2/s]
!!
INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zus, zz
!!----------------------------------------------------------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zus = MAX( pus(ji,jj) , 1.E-9_wp )
zz = (zus - 0.18_wp) / 0.1_wp
@@ -251,16 +251,16 @@ CONTAINS
!!
!! Author: L. Brodeau, January 2020 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!----------------------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj,2) :: rough_leng_tq ! temp.,hum. roughness lengthes over sea-ice [m]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pz0 ! roughness length [m]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pus ! u* = friction velocity [m/s]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pnua ! kinematic viscosity of air [m^2/s]
+ REAL(wp), DIMENSION(A2D(0),2) :: rough_leng_tq ! temp.,hum. roughness lengthes over sea-ice [m]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pz0 ! roughness length [m]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pus ! u* = friction velocity [m/s]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pnua ! kinematic viscosity of air [m^2/s]
!!
INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zz0, zus, zre, zsmoot, ztrans, zrough
REAL(wp) :: zb0, zb1, zb2, zlog, zlog2, zlog_z0s_on_z0
!!----------------------------------------------------------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zz0 = pz0(ji,jj)
zus = MAX( pus(ji,jj) , 1.E-9_wp )
zre = MAX( zus*zz0/pnua(ji,jj) , 0._wp ) ! Roughness Reynolds number
@@ -315,13 +315,13 @@ CONTAINS
!!
!! ** Author: L. Brodeau, 2020 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!----------------------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: psi_m_ice
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta
+ REAL(wp), DIMENSION(A2D(0)) :: psi_m_ice
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pzeta
!
INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zta, zx, zpsi_u, zpsi_s, zstab
!!----------------------------------------------------------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) !
+ DO_2D( 0, 0, 0, 0 ) !
zta = pzeta(ji,jj)
!
! Unstable stratification:
@@ -360,13 +360,13 @@ CONTAINS
!!
!! ** Author: L. Brodeau, 2020 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!----------------------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: psi_h_ice
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta
+ REAL(wp), DIMENSION(A2D(0)) :: psi_h_ice
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pzeta
!
INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zta, zx, zpsi_u, zpsi_s, zstab
!!----------------------------------------------------------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) !
+ DO_2D( 0, 0, 0, 0 ) !
zta = pzeta(ji,jj)
!
! Unstable stratification:
diff --git a/src/OCE/SBC/sbcblk_algo_ice_cdn.F90 b/src/OCE/SBC/sbcblk_algo_ice_cdn.F90
index 87932e3966985a6ae8c676671104989e099c246f..0a9103f8a706baf1627109dde6d612425b193788 100644
--- a/src/OCE/SBC/sbcblk_algo_ice_cdn.F90
+++ b/src/OCE/SBC/sbcblk_algo_ice_cdn.F90
@@ -59,12 +59,12 @@ CONTAINS
!! ** References : Lupkes et al. JGR 2012 (theory)
!!
!!----------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: CdN10_f_LU12 ! neutral FORM drag coefficient contribution over sea-ice
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pfrice ! ice concentration [fraction] => at_i_b ! NOT USED if pSc2, phf and pDi all provided...
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pz0w ! roughness length over water [m]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: pSc2 ! squared shletering function [0-1] (Sc->1 for large distance between floes, ->0 for small distances)
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: phf ! mean freeboard of floes [m]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: pDi ! cross wind dimension of the floe (aka effective edge length for form drag) [m]
+ REAL(wp), DIMENSION(A2D(0)) :: CdN10_f_LU12 ! neutral FORM drag coefficient contribution over sea-ice
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pfrice ! ice concentration [fraction] => at_i_b ! NOT USED if pSc2, phf and pDi all provided...
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pz0w ! roughness length over water [m]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in), OPTIONAL :: pSc2 ! squared shletering function [0-1] (Sc->1 for large distance between floes, ->0 for small distances)
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in), OPTIONAL :: phf ! mean freeboard of floes [m]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in), OPTIONAL :: pDi ! cross wind dimension of the floe (aka effective edge length for form drag) [m]
!!----------------------------------------------------------------------
LOGICAL :: l_known_Sc2=.FALSE., l_known_hf=.FALSE., l_known_Di=.FALSE.
REAL(wp) :: ztmp, zrlog, zfri, zfrw, zSc2, zhf, zDi
@@ -74,7 +74,7 @@ CONTAINS
l_known_hf = PRESENT(phf)
l_known_Di = PRESENT(pDi)
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zfri = pfrice(ji,jj)
zfrw = (1._wp - zfri)
@@ -113,9 +113,9 @@ CONTAINS
FUNCTION CdN_f_LU12_eq36( pzu, pfrice )
!!----------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: CdN_f_LU12_eq36 ! neutral FORM drag coefficient contribution over sea-ice
- REAL(wp), INTENT(in) :: pzu ! reference height [m]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pfrice ! ice concentration [fraction] => at_i_b ! NOT USED if pSc2, phf and pDi all provided...
+ REAL(wp), DIMENSION(A2D(0)) :: CdN_f_LU12_eq36 ! neutral FORM drag coefficient contribution over sea-ice
+ REAL(wp), INTENT(in) :: pzu ! reference height [m]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pfrice ! ice concentration [fraction] => at_i_b ! NOT USED if pSc2, phf and pDi all provided...
!!----------------------------------------------------------------------
REAL(wp) :: ztmp, zrlog, zfri, zhf, zDi
INTEGER :: ji, jj
@@ -127,7 +127,7 @@ CONTAINS
ztmp = 1._wp/rz0_w_0
zrlog = LOG(zhf*ztmp) / LOG(pzu*ztmp)
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zfri = pfrice(ji,jj)
CdN_f_LU12_eq36(ji,jj) = 0.5_wp* 0.3_wp * zrlog*zrlog * zhf/zDi * (1._wp - zfri)**rBeta_0 ! Eq.(35) & (36)
!! 1/2 Ce
@@ -167,8 +167,8 @@ CONTAINS
!! Lupkes et al. GRL 2013 (application to GCM)
!!
!!----------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: CdN10_f_LU13 ! neutral FORM drag coefficient contribution over sea-ice
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pfrice ! ice concentration [fraction] => at_i_b
+ REAL(wp), DIMENSION(A2D(0)) :: CdN10_f_LU13 ! neutral FORM drag coefficient contribution over sea-ice
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pfrice ! ice concentration [fraction] => at_i_b
!!----------------------------------------------------------------------
INTEGER :: ji, jj
REAL(wp) :: zcoef
@@ -178,7 +178,7 @@ CONTAINS
!! We are not an AGCM, we are an OGCM!!! => we drop term "(1 - A)*Cd_w"
!! => so we keep only the last rhs terms of Eq.(1) of Lupkes et al, 2013 that we divide by "A":
!! (we multiply Cd_i_s and Cd_i_f by A later, when applying ocean-ice partitioning...
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
CdN10_f_LU13(ji,jj) = rCe_0 * pfrice(ji,jj)**(rMu_0 - 1._wp) * (1._wp - pfrice(ji,jj))**zcoef
END_2D
!! => seems okay for winter 100% sea-ice as second rhs term vanishes as pfrice == 1....
@@ -203,13 +203,13 @@ CONTAINS
!! ** References : Lupkes & Gryanik (2015)
!!
!!----------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: CdN_f_LG15 ! neutral FORM drag coefficient contribution over sea-ice
- REAL(wp), INTENT(in ) :: pzu ! reference height [m]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pfrice ! ice concentration [fraction] => at_i_b ! NOT USED if pSc2, phf and pDi all provided...
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pz0i ! roughness length over ICE [m] (in LU12, it's over water ???)
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: pSc2 ! squared shletering function [0-1] (Sc->1 for large distance between floes, ->0 for small distances)
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: phf ! mean freeboard of floes [m]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: pDi ! cross wind dimension of the floe (aka effective edge length for form drag) [m]
+ REAL(wp), DIMENSION(A2D(0)) :: CdN_f_LG15 ! neutral FORM drag coefficient contribution over sea-ice
+ REAL(wp), INTENT(in ) :: pzu ! reference height [m]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pfrice ! ice concentration [fraction] => at_i_b ! NOT USED if pSc2, phf and pDi all provided...
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pz0i ! roughness length over ICE [m] (in LU12, it's over water ???)
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in), OPTIONAL :: pSc2 ! squared shletering function [0-1] (Sc->1 for large distance between floes, ->0 for small distances)
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in), OPTIONAL :: phf ! mean freeboard of floes [m]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in), OPTIONAL :: pDi ! cross wind dimension of the floe (aka effective edge length for form drag) [m]
!!----------------------------------------------------------------------
LOGICAL :: l_known_Sc2=.FALSE., l_known_hf=.FALSE., l_known_Di=.FALSE.
REAL(wp) :: ztmp, zrlog, zfri, zfrw, zSc2, zhf, zDi
@@ -219,7 +219,7 @@ CONTAINS
l_known_hf = PRESENT(phf)
l_known_Di = PRESENT(pDi)
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zfri = pfrice(ji,jj)
zfrw = (1._wp - zfri)
@@ -270,15 +270,15 @@ CONTAINS
!! ** References : Lupkes & Gryanik (2015)
!!
!!----------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: CdN_f_LG15_light ! neutral FORM drag coefficient contribution over sea-ice
- REAL(wp), INTENT(in) :: pzu ! reference height [m]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pfrice ! ice concentration [fraction] => at_i_b
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pz0w ! roughness length over water [m]
+ REAL(wp), DIMENSION(A2D(0)) :: CdN_f_LG15_light ! neutral FORM drag coefficient contribution over sea-ice
+ REAL(wp), INTENT(in) :: pzu ! reference height [m]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pfrice ! ice concentration [fraction] => at_i_b
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pz0w ! roughness length over water [m]
!!----------------------------------------------------------------------
REAL(wp) :: ztmp, zrlog, zfri
INTEGER :: ji, jj
!!----------------------------------------------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zfri = pfrice(ji,jj)
diff --git a/src/OCE/SBC/sbcblk_algo_ice_lg15.F90 b/src/OCE/SBC/sbcblk_algo_ice_lg15.F90
index 62ec01b8236d2735d600b354ea7bcd64d2025ac1..9c9302faa60317317f071f6b7238cb7b60457f5d 100644
--- a/src/OCE/SBC/sbcblk_algo_ice_lg15.F90
+++ b/src/OCE/SBC/sbcblk_algo_ice_lg15.F90
@@ -42,6 +42,8 @@ MODULE sbcblk_algo_ice_lg15
INTEGER , PARAMETER :: nbit = 8 ! number of itterations
+ !! * Substitutions
+# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
CONTAINS
@@ -92,27 +94,27 @@ CONTAINS
!!
!! ** Author: L. Brodeau, January 2020 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!----------------------------------------------------------------------------------
- REAL(wp), INTENT(in ) :: zt ! height for t_zt and q_zt [m]
- REAL(wp), INTENT(in ) :: zu ! height for U_zu [m]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: Ts_i ! ice surface temperature [Kelvin]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: t_zt ! potential air temperature [Kelvin]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: qs_i ! sat. spec. hum. at ice/air interface [kg/kg]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: q_zt ! spec. air humidity at zt [kg/kg]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: U_zu ! relative wind module at zu [m/s]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: frice ! sea-ice concentration (fraction)
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: Cd_i ! drag coefficient over sea-ice
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: Ch_i ! transfert coefficient for heat over ice
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: Ce_i ! transfert coefficient for sublimation over ice
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: t_zu_i ! pot. air temp. adjusted at zu [K]
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: q_zu_i ! spec. humidity adjusted at zu [kg/kg]
+ REAL(wp), INTENT(in ) :: zt ! height for t_zt and q_zt [m]
+ REAL(wp), INTENT(in ) :: zu ! height for U_zu [m]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: Ts_i ! ice surface temperature [Kelvin]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: t_zt ! potential air temperature [Kelvin]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: qs_i ! sat. spec. hum. at ice/air interface [kg/kg]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: q_zt ! spec. air humidity at zt [kg/kg]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: U_zu ! relative wind module at zu [m/s]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: frice ! sea-ice concentration (fraction)
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)) :: Cd_i ! drag coefficient over sea-ice
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)) :: Ch_i ! transfert coefficient for heat over ice
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)) :: Ce_i ! transfert coefficient for sublimation over ice
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)) :: t_zu_i ! pot. air temp. adjusted at zu [K]
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)) :: q_zu_i ! spec. humidity adjusted at zu [kg/kg]
!!----------------------------------------------------------------------------------
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: CdN
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: ChN
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: CeN
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: xz0 ! Aerodynamic roughness length [m]
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: xu_star ! u*, friction velocity
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: xL ! zeta (zu/L)
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: xUN10 ! Neutral wind at zu
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: CdN
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: ChN
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: CeN
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: xz0 ! Aerodynamic roughness length [m]
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: xu_star ! u*, friction velocity
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: xL ! zeta (zu/L)
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: xUN10 ! Neutral wind at zu
!!----------------------------------------------------------------------------------
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: Ubzu
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ztmp1, ztmp2 ! temporary stuff
@@ -128,11 +130,11 @@ CONTAINS
!!
CHARACTER(len=40), PARAMETER :: crtnm = 'turb_ice_lg15@sbcblk_algo_ice_lg15.f90'
!!----------------------------------------------------------------------------------
- ALLOCATE ( Ubzu(jpi,jpj) )
- ALLOCATE ( ztmp1(jpi,jpj), ztmp2(jpi,jpj) )
- ALLOCATE ( dt_zu(jpi,jpj), dq_zu(jpi,jpj) )
- ALLOCATE ( zz0_s(jpi,jpj), zz0_f(jpi,jpj), RiB(jpi,jpj), &
- & zCdN_s(jpi,jpj), zChN_s(jpi,jpj), zCdN_f(jpi,jpj), zChN_f(jpi,jpj) )
+ ALLOCATE ( Ubzu(A2D(0)) )
+ ALLOCATE ( ztmp1(A2D(0)), ztmp2(A2D(0)) )
+ ALLOCATE ( dt_zu(A2D(0)), dq_zu(A2D(0)) )
+ ALLOCATE ( zz0_s(A2D(0)), zz0_f(A2D(0)), RiB(A2D(0)), &
+ & zCdN_s(A2D(0)), zChN_s(A2D(0)), zCdN_f(A2D(0)), zChN_f(A2D(0)) )
lreturn_cdn = PRESENT(CdN)
lreturn_chn = PRESENT(ChN)
diff --git a/src/OCE/SBC/sbcblk_algo_ice_lu12.F90 b/src/OCE/SBC/sbcblk_algo_ice_lu12.F90
index d46534a362b0ad9a7486ee86d45a5e8cec34bf0f..10a4dbf60ff50a4931b0d7c0ae915330f17330ef 100644
--- a/src/OCE/SBC/sbcblk_algo_ice_lu12.F90
+++ b/src/OCE/SBC/sbcblk_algo_ice_lu12.F90
@@ -32,6 +32,8 @@ MODULE sbcblk_algo_ice_lu12
REAL(wp), PARAMETER :: rz0_i_s_0 = 0.69e-3_wp ! Eq.(43) of Lupkes & Gryanik (2015) [m] => to estimate CdN10 for skin drag!
REAL(wp), PARAMETER :: rz0_i_f_0 = 4.54e-4_wp ! bottom p.562 MIZ [m] (LG15)
+ !! * Substitutions
+# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
CONTAINS
@@ -79,27 +81,27 @@ CONTAINS
!!
!! ** Author: L. Brodeau, January 2020 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!----------------------------------------------------------------------------------
- REAL(wp), INTENT(in ) :: zt ! height for t_zt and q_zt [m]
- REAL(wp), INTENT(in ) :: zu ! height for U_zu [m]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: Ts_i ! ice surface temperature [Kelvin]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: t_zt ! potential air temperature [Kelvin]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: qs_i ! sat. spec. hum. at ice/air interface [kg/kg]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: q_zt ! spec. air humidity at zt [kg/kg]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: U_zu ! relative wind module at zu [m/s]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: frice ! sea-ice concentration (fraction)
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: Cd_i ! drag coefficient over sea-ice
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: Ch_i ! transfert coefficient for heat over ice
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: Ce_i ! transfert coefficient for sublimation over ice
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: t_zu_i ! pot. air temp. adjusted at zu [K]
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: q_zu_i ! spec. humidity adjusted at zu [kg/kg]
+ REAL(wp), INTENT(in ) :: zt ! height for t_zt and q_zt [m]
+ REAL(wp), INTENT(in ) :: zu ! height for U_zu [m]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: Ts_i ! ice surface temperature [Kelvin]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: t_zt ! potential air temperature [Kelvin]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: qs_i ! sat. spec. hum. at ice/air interface [kg/kg]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: q_zt ! spec. air humidity at zt [kg/kg]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: U_zu ! relative wind module at zu [m/s]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: frice ! sea-ice concentration (fraction)
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)) :: Cd_i ! drag coefficient over sea-ice
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)) :: Ch_i ! transfert coefficient for heat over ice
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)) :: Ce_i ! transfert coefficient for sublimation over ice
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)) :: t_zu_i ! pot. air temp. adjusted at zu [K]
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)) :: q_zu_i ! spec. humidity adjusted at zu [kg/kg]
!!----------------------------------------------------------------------------------
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: CdN
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: ChN
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: CeN
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: xz0 ! Aerodynamic roughness length [m]
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: xu_star ! u*, friction velocity
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: xL ! zeta (zu/L)
- REAL(wp), INTENT(out), DIMENSION(jpi,jpj), OPTIONAL :: xUN10 ! Neutral wind at zu
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: CdN
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: ChN
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: CeN
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: xz0 ! Aerodynamic roughness length [m]
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: xu_star ! u*, friction velocity
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: xL ! zeta (zu/L)
+ REAL(wp), INTENT(out), DIMENSION(A2D(0)), OPTIONAL :: xUN10 ! Neutral wind at zu
!!----------------------------------------------------------------------------------
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: dt_zu, dq_zu, z0
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: Ubzu
@@ -109,8 +111,8 @@ CONTAINS
!!
CHARACTER(len=40), PARAMETER :: crtnm = 'turb_ice_lu12@sbcblk_algo_ice_lu12.f90'
!!----------------------------------------------------------------------------------
- ALLOCATE ( Ubzu(jpi,jpj) )
- ALLOCATE ( dt_zu(jpi,jpj), dq_zu(jpi,jpj), z0(jpi,jpj) )
+ ALLOCATE ( Ubzu(A2D(0)) )
+ ALLOCATE ( dt_zu(A2D(0)), dq_zu(A2D(0)), z0(A2D(0)) )
lreturn_cdn = PRESENT(CdN)
lreturn_chn = PRESENT(ChN)
diff --git a/src/OCE/SBC/sbcblk_algo_ncar.F90 b/src/OCE/SBC/sbcblk_algo_ncar.F90
index bb520dbf07993c584ac4e9f50c3187e18a711a05..4e218454e57d5c49520cfacc72269b82f82947f3 100644
--- a/src/OCE/SBC/sbcblk_algo_ncar.F90
+++ b/src/OCE/SBC/sbcblk_algo_ncar.F90
@@ -79,32 +79,32 @@ CONTAINS
!!
!! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!----------------------------------------------------------------------------------
- REAL(wp), INTENT(in ) :: zt ! height for t_zt and q_zt [m]
- REAL(wp), INTENT(in ) :: zu ! height for U_zu [m]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: sst ! sea surface temperature [Kelvin]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: t_zt ! potential air temperature [Kelvin]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: ssq ! sea surface specific humidity [kg/kg]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: q_zt ! specific air humidity at zt [kg/kg]
- REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: U_zu ! relative wind module at zu [m/s]
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Cd ! transfer coefficient for momentum (tau)
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Ch ! transfer coefficient for sensible heat (Q_sens)
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Ce ! transfert coefficient for evaporation (Q_lat)
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: t_zu ! pot. air temp. adjusted at zu [K]
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: q_zu ! spec. humidity adjusted at zu [kg/kg]
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Ubzu ! bulk wind speed at zu [m/s]
+ REAL(wp), INTENT(in ) :: zt ! height for t_zt and q_zt [m]
+ REAL(wp), INTENT(in ) :: zu ! height for U_zu [m]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: sst ! sea surface temperature [Kelvin]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: t_zt ! potential air temperature [Kelvin]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: ssq ! sea surface specific humidity [kg/kg]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: q_zt ! specific air humidity at zt [kg/kg]
+ REAL(wp), INTENT(in ), DIMENSION(A2D(0)) :: U_zu ! relative wind module at zu [m/s]
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Cd ! transfer coefficient for momentum (tau)
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Ch ! transfer coefficient for sensible heat (Q_sens)
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Ce ! transfert coefficient for evaporation (Q_lat)
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: t_zu ! pot. air temp. adjusted at zu [K]
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: q_zu ! spec. humidity adjusted at zu [kg/kg]
+ REAL(wp), INTENT( out), DIMENSION(A2D(0)) :: Ubzu ! bulk wind speed at zu [m/s]
!
- INTEGER , INTENT(in ), OPTIONAL :: nb_iter ! number of iterations
- REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: CdN
- REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: ChN
- REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: CeN
+ INTEGER , INTENT(in ), OPTIONAL :: nb_iter ! number of iterations
+ REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: CdN
+ REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: ChN
+ REAL(wp), INTENT( out), OPTIONAL, DIMENSION(A2D(0)) :: CeN
!
INTEGER :: nbit, jit ! iterations...
LOGICAL :: l_zt_equal_zu = .FALSE. ! if q and t are given at same height as U
!
- REAL(wp), DIMENSION(jpi,jpj) :: zCdN, zCeN, zChN ! 10m neutral latent/sensible coefficient
- REAL(wp), DIMENSION(jpi,jpj) :: zsqrt_Cd, zsqrt_CdN ! root square of Cd and Cd_neutral
- REAL(wp), DIMENSION(jpi,jpj) :: zeta_u ! stability parameter at height zu
- REAL(wp), DIMENSION(jpi,jpj) :: ztmp0, ztmp1, ztmp2
+ REAL(wp), DIMENSION(A2D(0)) :: zCdN, zCeN, zChN ! 10m neutral latent/sensible coefficient
+ REAL(wp), DIMENSION(A2D(0)) :: zsqrt_Cd, zsqrt_CdN ! root square of Cd and Cd_neutral
+ REAL(wp), DIMENSION(A2D(0)) :: zeta_u ! stability parameter at height zu
+ REAL(wp), DIMENSION(A2D(0)) :: ztmp0, ztmp1, ztmp2
!!----------------------------------------------------------------------------------
nbit = nb_iter0
IF( PRESENT(nb_iter) ) nbit = nb_iter
@@ -119,7 +119,7 @@ CONTAINS
!! Neutral coefficients at 10m:
IF( ln_cdgw ) THEN ! wave drag case
- cdn_wave(:,:) = cdn_wave(:,:) + rsmall * ( 1._wp - tmask(:,:,1) )
+ cdn_wave(:,:) = cdn_wave(:,:) + rsmall * ( 1._wp - smask0(:,:) )
zCdN (:,:) = cdn_wave(:,:)
ELSE
zCdN = cd_n10_ncar( Ubzu )
@@ -231,14 +231,14 @@ CONTAINS
!!
!! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!----------------------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pw10 ! scalar wind speed at 10m (m/s)
- REAL(wp), DIMENSION(jpi,jpj) :: cd_n10_ncar
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pw10 ! scalar wind speed at 10m (m/s)
+ REAL(wp), DIMENSION(A2D(0)) :: cd_n10_ncar
!
INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zgt33, zw, zw6 ! local scalars
!!----------------------------------------------------------------------------------
!
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
!
zw = pw10(ji,jj)
zw6 = zw*zw*zw
@@ -264,9 +264,9 @@ CONTAINS
!! Origin: Large & Yeager 2008, Eq. (9) and (12)
!!----------------------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: ch_n10_ncar
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: psqrtcdn10 ! sqrt( CdN10 )
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pstab ! stable ABL => 1 / unstable ABL => 0
+ REAL(wp), DIMENSION(A2D(0)) :: ch_n10_ncar
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: psqrtcdn10 ! sqrt( CdN10 )
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pstab ! stable ABL => 1 / unstable ABL => 0
!!----------------------------------------------------------------------------------
IF( ANY(pstab < -0.00001) .OR. ANY(pstab > 1.00001) ) THEN
PRINT *, 'ERROR: ch_n10_ncar@mod_blk_ncar.f90: pstab ='
@@ -283,8 +283,8 @@ CONTAINS
!! Estimate of the neutral heat transfer coefficient at 10m !!
!! Origin: Large & Yeager 2008, Eq. (9) and (13)
!!----------------------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: ce_n10_ncar
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: psqrtcdn10 ! sqrt( CdN10 )
+ REAL(wp), DIMENSION(A2D(0)) :: ce_n10_ncar
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: psqrtcdn10 ! sqrt( CdN10 )
!!----------------------------------------------------------------------------------
ce_n10_ncar = MAX( 1.e-3_wp * ( 34.6_wp * psqrtcdn10 ) , Cx_min )
!
@@ -301,13 +301,13 @@ CONTAINS
!!
!! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!----------------------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: psi_m_ncar
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta
+ REAL(wp), DIMENSION(A2D(0)) :: psi_m_ncar
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pzeta
!
INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zta, zx2, zx, zpsi_unst, zpsi_stab, zstab ! local scalars
!!----------------------------------------------------------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zta = pzeta(ji,jj)
!
zx2 = SQRT( ABS(1._wp - 16._wp*zta) ) ! (1 - 16z)^0.5
@@ -339,14 +339,14 @@ CONTAINS
!!
!! ** Author: L. Brodeau, June 2016 / AeroBulk (https://github.com/brodeau/aerobulk/)
!!----------------------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: psi_h_ncar
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pzeta
+ REAL(wp), DIMENSION(A2D(0)) :: psi_h_ncar
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pzeta
!
INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zta, zx2, zpsi_unst, zpsi_stab, zstab ! local scalars
!!----------------------------------------------------------------------------------
!
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
!
zta = pzeta(ji,jj)
!
diff --git a/src/OCE/SBC/sbcblk_skin_coare.F90 b/src/OCE/SBC/sbcblk_skin_coare.F90
index 42720bd939e3dfb1dd45ed1545495120efe50732..ddd6af7f2d0f7ad4f70a3679e7ed8e455bd6cb2e 100644
--- a/src/OCE/SBC/sbcblk_skin_coare.F90
+++ b/src/OCE/SBC/sbcblk_skin_coare.F90
@@ -79,16 +79,16 @@ CONTAINS
!! *pSST* bulk SST (taken at depth gdept_1d(1)) [K]
!! *pQlat* surface latent heat flux [K]
!!------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pQsw ! net solar a.k.a shortwave radiation into the ocean (after albedo) [W/m^2]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pQnsol ! non-solar heat flux to the ocean [W/m^2]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pustar ! friction velocity, temperature and humidity (u*,t*,q*)
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pSST ! bulk SST [K]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pQlat ! latent heat flux [W/m^2]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pQsw ! net solar a.k.a shortwave radiation into the ocean (after albedo) [W/m^2]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pQnsol ! non-solar heat flux to the ocean [W/m^2]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pustar ! friction velocity, temperature and humidity (u*,t*,q*)
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pSST ! bulk SST [K]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pQlat ! latent heat flux [W/m^2]
!!---------------------------------------------------------------------
INTEGER :: ji, jj, jc
REAL(wp) :: zQabs, zdlt, zfr, zalfa, zqlat, zus
!!---------------------------------------------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zQabs = pQnsol(ji,jj) ! first guess of heat flux absorbed within the viscous sublayer of thicknes delta,
! ! => we DO not miss a lot assuming 0 solar flux absorbed in the tiny layer of thicknes zdlt...
@@ -129,11 +129,11 @@ CONTAINS
!! *pSST* bulk SST (taken at depth gdept_1d(1)) [K]
!! *iwait* if /= 0 then wait before updating accumulated fluxes, we are within a converging itteration loop...
!!---------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pQsw ! surface net solar radiation into the ocean [W/m^2] => >= 0 !
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pQnsol ! surface net non-solar heat flux into the ocean [W/m^2] => normally < 0 !
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pTau ! wind stress [N/m^2]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pSST ! bulk SST at depth gdept_1d(1) [K]
- INTEGER , INTENT(in) :: iwait ! if /= 0 then wait before updating accumulated fluxes
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pQsw ! surface net solar radiation into the ocean [W/m^2] => >= 0 !
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pQnsol ! surface net non-solar heat flux into the ocean [W/m^2] => normally < 0 !
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pTau ! wind stress [N/m^2]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pSST ! bulk SST at depth gdept_1d(1) [K]
+ INTEGER , INTENT(in) :: iwait ! if /= 0 then wait before updating accumulated fluxes
!!
INTEGER :: ji,jj
!
@@ -155,7 +155,7 @@ CONTAINS
ztime = REAL(nsec_day,wp)/(24._wp*3600._wp) ! time of current time step since 00:00 for current day (UTC) -> ztime = 0 -> 00:00 / ztime = 0.5 -> 12:00 ...
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
l_exit = .FALSE.
l_destroy_wl = .FALSE.
diff --git a/src/OCE/SBC/sbcblk_skin_ecmwf.F90 b/src/OCE/SBC/sbcblk_skin_ecmwf.F90
index 0f4cf8d5d37f7fa8cfa6bbefed0b68e822c7382f..e38437168acc696a864ce3c681c677ae731cd891 100644
--- a/src/OCE/SBC/sbcblk_skin_ecmwf.F90
+++ b/src/OCE/SBC/sbcblk_skin_ecmwf.F90
@@ -87,15 +87,15 @@ CONTAINS
!! *pustar* friction velocity u* [m/s]
!! *pSST* bulk SST (taken at depth gdept_1d(1)) [K]
!!------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pQsw ! net solar a.k.a shortwave radiation into the ocean (after albedo) [W/m^2]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pQnsol ! non-solar heat flux to the ocean [W/m^2]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pustar ! friction velocity, temperature and humidity (u*,t*,q*)
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pSST ! bulk SST [K]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pQsw ! net solar a.k.a shortwave radiation into the ocean (after albedo) [W/m^2]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pQnsol ! non-solar heat flux to the ocean [W/m^2]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pustar ! friction velocity, temperature and humidity (u*,t*,q*)
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pSST ! bulk SST [K]
!!---------------------------------------------------------------------
INTEGER :: ji, jj, jc
REAL(wp) :: zQabs, zdlt, zfr, zalfa, zus
!!---------------------------------------------------------------------
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zQabs = pQnsol(ji,jj) ! first guess of heat flux absorbed within the viscous sublayer of thicknes delta,
! ! => we DO not miss a lot assuming 0 solar flux absorbed in the tiny layer of thicknes zdlt...
@@ -147,12 +147,12 @@ CONTAINS
!! *pustar* friction velocity u* [m/s]
!! *pSST* bulk SST (taken at depth gdept_1d(1)) [K]
!!------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pQsw ! surface net solar radiation into the ocean [W/m^2] => >= 0 !
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pQnsol ! surface net non-solar heat flux into the ocean [W/m^2] => normally < 0 !
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pustar ! friction velocity [m/s]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pSST ! bulk SST at depth gdept_1d(1) [K]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pQsw ! surface net solar radiation into the ocean [W/m^2] => >= 0 !
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pQnsol ! surface net non-solar heat flux into the ocean [W/m^2] => normally < 0 !
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pustar ! friction velocity [m/s]
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pSST ! bulk SST at depth gdept_1d(1) [K]
!!
- REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: pustk ! surface Stokes velocity [m/s]
+ REAL(wp), DIMENSION(A2D(0)), OPTIONAL, INTENT(in) :: pustk ! surface Stokes velocity [m/s]
!
INTEGER :: ji, jj, jc
!
@@ -173,7 +173,7 @@ CONTAINS
l_pustk_known = .FALSE.
IF( PRESENT(pustk) ) l_pustk_known = .TRUE.
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zHwl = Hz_wl(ji,jj) ! first guess for warm-layer depth (and unique..., less advanced than COARE3p6 !)
! it is = rd0 (3m) in default Zeng & Beljaars case...
diff --git a/src/OCE/SBC/sbcclo.F90 b/src/OCE/SBC/sbcclo.F90
index ba956f5e32dfa77dfea9106ee2855e2b2659d716..1f48db25bb7ce34f03f2a7f901daeb8c1faf7db2 100644
--- a/src/OCE/SBC/sbcclo.F90
+++ b/src/OCE/SBC/sbcclo.F90
@@ -44,6 +44,8 @@ MODULE sbcclo
!
INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: mcsgrpg, mcsgrpr, mcsgrpe !: closed sea group for glo, rnf and emp
!
+ !! * Substitutions
+# include "do_loop_substitute.h90"
CONTAINS
!
!!----------------------------------------------------------------------
@@ -120,8 +122,8 @@ MODULE sbcclo
CALL iom_put('qclosea',zqcs)
!
! 3. update emp and qns
- emp(:,:) = emp(:,:) + zwcs(:,:)
- qns(:,:) = qns(:,:) + zqcs(:,:)
+ emp(A2D(0)) = emp(A2D(0)) + zwcs(A2D(0))
+ qns(:,:) = qns(:,:) + zqcs(A2D(0))
!
END SUBROUTINE sbc_clo
!
@@ -289,7 +291,7 @@ MODULE sbcclo
!! 1. Work out net freshwater over the closed sea from EMP - RNF.
!! Work out net heat associated with the correction (needed for conservation)
!! (PM: should we consider used delayed glob sum ?)
- zcsfw = glob_sum( 'closea', e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * imsk_src(:,:) )
+ zcsfw = glob_sum( 'closea', e1e2t(A2D(0)) * ( emp(A2D(0))-rnf(A2D(0)) ) * imsk_src(A2D(0)) )
!
!! 2. Deal with runoff special case (net evaporation spread globally)
!! and compute trg mask
diff --git a/src/OCE/SBC/sbccpl.F90 b/src/OCE/SBC/sbccpl.F90
index dc41fe2a8aa8d637d07776ed36f606e7b6c4b14a..f681b98be34586f909333d4f30ce093b26eda52a 100644
--- a/src/OCE/SBC/sbccpl.F90
+++ b/src/OCE/SBC/sbccpl.F90
@@ -65,6 +65,7 @@ MODULE sbccpl
PUBLIC sbc_cpl_ice_flx ! routine called by icestp.F90
PUBLIC sbc_cpl_alloc ! routine called in sbcice_cice.F90
+ !! received fields are only in the interior (without halos)
INTEGER, PARAMETER :: jpr_otx1 = 1 ! 3 atmosphere-ocean stress components on grid 1
INTEGER, PARAMETER :: jpr_oty1 = 2 !
INTEGER, PARAMETER :: jpr_otz1 = 3 !
@@ -131,7 +132,8 @@ MODULE sbccpl
INTEGER, PARAMETER :: jpr_qtrice = 63 ! Transmitted solar thru sea-ice
INTEGER, PARAMETER :: jprcv = 63 ! total number of fields received
-
+
+ !! sent fields are only in the interior (without halos)
INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere
INTEGER, PARAMETER :: jps_toce = 2 ! ocean temperature
INTEGER, PARAMETER :: jps_tice = 3 ! ice temperature
@@ -238,12 +240,12 @@ CONTAINS
!!----------------------------------------------------------------------
ierr(:) = 0
!
- ALLOCATE( alb_oce_mix(jpi,jpj), nrcvinfo(jprcv), STAT=ierr(1) )
+ ALLOCATE( alb_oce_mix(A2D(0)), nrcvinfo(jprcv), STAT=ierr(1) )
#if ! defined key_si3 && ! defined key_cice
ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) ) ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init)
#endif
- ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) )
+ ALLOCATE( xcplmask(A2D(0),0:nn_cplmodel) , STAT=ierr(3) )
!
IF( .NOT. ln_apr_dyn ) ALLOCATE( ssh_ib(jpi,jpj), ssh_ibb(jpi,jpj), apr(jpi, jpj), STAT=ierr(4) )
@@ -270,7 +272,7 @@ CONTAINS
!
INTEGER :: jn ! dummy loop index
INTEGER :: ios, inum ! Local integer
- REAL(wp), DIMENSION(jpi,jpj) :: zacs, zaos
+ REAL(wp), DIMENSION(A2D(0)) :: zacs, zaos
!!
NAMELIST/namsbc_cpl/ nn_cplmodel , ln_usecplmask, nn_cats_cpl , ln_scale_ice_flux, &
& sn_snd_temp , sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2 , &
@@ -739,19 +741,19 @@ CONTAINS
! Allocate all parts of frcv used for received fields !
! =================================================== !
DO jn = 1, jprcv
- IF( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) )
+ IF( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(A2D(0),srcv(jn)%nct) )
END DO
! Allocate taum part of frcv which is used even when not received as coupling field
- IF( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) )
+ IF( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(A2D(0),srcv(jpr_taum)%nct) )
! Allocate w10m part of frcv which is used even when not received as coupling field
- IF( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) )
+ IF( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(A2D(0),srcv(jpr_w10m)%nct) )
! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field
- IF( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) )
- IF( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) )
+ IF( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(A2D(0),srcv(jpr_otx1)%nct) )
+ IF( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(A2D(0),srcv(jpr_oty1)%nct) )
! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE.
IF( k_ice /= 0 ) THEN
- IF( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) )
- IF( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) )
+ IF( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(A2D(0),srcv(jpr_itx1)%nct) )
+ IF( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(A2D(0),srcv(jpr_ity1)%nct) )
ENDIF
! ================================ !
@@ -1051,15 +1053,14 @@ CONTAINS
IF(ln_usecplmask) THEN
xcplmask(:,:,:) = 0.
CALL iom_open( 'cplmask', inum )
- CALL iom_get( inum, jpdom_unknown, 'cplmask', xcplmask(1:jpi,1:jpj,1:nn_cplmodel), &
- & kstart = (/ mig(1),mjg(1),1 /), kcount = (/ jpi,jpj,nn_cplmodel /) )
+ CALL iom_get( inum, jpdom_unknown, 'cplmask', xcplmask(:,:,1:nn_cplmodel), &
+ & kstart = (/ mig(Nis0,0),mjg(Njs0,0),1 /), kcount = (/ Ni_0,Nj_0,nn_cplmodel /) )
CALL iom_close( inum )
ELSE
xcplmask(:,:,:) = 1.
ENDIF
xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 )
!
- !
END SUBROUTINE sbc_cpl_init
@@ -1124,7 +1125,8 @@ CONTAINS
REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient
REAL(wp) :: zzx, zzy ! temporary variables
REAL(wp) :: r1_grau ! = 1.e0 / (grav * rho0)
- REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty, zmsk, zemp, zqns, zqsr, zcloud_fra
+ REAL(wp), DIMENSION(A2D(0)) :: ztx, zty, zmsk, zemp
+ REAL(wp), DIMENSION(A2D(0)) :: zqns, zqsr, zcloud_fra
!!----------------------------------------------------------------------
!
IF( kt == nit000 ) THEN
@@ -1139,7 +1141,7 @@ CONTAINS
ENDIF
ENDIF
!
- IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0)
+ IF( ln_mixcpl ) zmsk (:,:) = 1. - xcplmask (:,:,0)
!
! ! ======================================================= !
! ! Receive all the atmos. fields (including ice information)
@@ -1191,9 +1193,11 @@ CONTAINS
IF( .NOT. srcv(jpr_taum)%laction ) THEN ! compute wind stress module from its components if not received
! => need to be done only when otx1 was changed
IF( llnewtx ) THEN
- zzx = frcv(jpr_otx1)%z3(ji,jj,1)
- zzy = frcv(jpr_oty1)%z3(ji,jj,1)
- frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy )
+ DO_2D( 0, 0, 0, 0 )
+ zzx = frcv(jpr_otx1)%z3(ji,jj,1)
+ zzy = frcv(jpr_oty1)%z3(ji,jj,1)
+ frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy )
+ END_2D
llnewtau = .TRUE.
ELSE
llnewtau = .FALSE.
@@ -1202,7 +1206,7 @@ CONTAINS
llnewtau = nrcvinfo(jpr_taum) == OASIS_Rcv
! Stress module can be negative when received (interpolation problem)
IF( llnewtau ) THEN
- frcv(jpr_taum)%z3(:,:,1) = MAX( 0._wp, frcv(jpr_taum)%z3(:,:,1) )
+ frcv(jpr_taum)%z3(A2D(0),1) = MAX( 0._wp, frcv(jpr_taum)%z3(A2D(0),1) )
ENDIF
ENDIF
!
@@ -1213,7 +1217,7 @@ CONTAINS
! => need to be done only when taumod was changed
IF( llnewtau ) THEN
zcoef = 1. / ( zrhoa * zcdrag )
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )
END_2D
ENDIF
@@ -1221,7 +1225,7 @@ CONTAINS
!!$ ! ! ========================= !
!!$ SELECT CASE( TRIM( sn_rcv_clouds%cldes ) ) ! cloud fraction !
!!$ ! ! ========================= !
-!!$ cloud_fra(:,:) = frcv(jpr_clfra)*z3(:,:,1)
+!!$ cloud_fra(:,:) = frcv(jpr_clfra)*z3(A2D(0),1)
!!$ END SELECT
!!$
zcloud_fra(:,:) = pp_cldf ! should be real cloud fraction instead (as in the bulk) but needs to be read from atm.
@@ -1259,13 +1263,14 @@ CONTAINS
! ! Mean Sea Level Pressure ! (taum)
! ! ========================= !
IF( srcv(jpr_mslp)%laction ) THEN ! UKMO SHELF effect of atmospheric pressure on SSH
- IF( kt /= nit000 ) ssh_ibb(:,:) = ssh_ib(:,:) !* Swap of ssh_ib fields
+ IF( kt /= nit000 ) ssh_ibb(A2D(0)) = ssh_ib(A2D(0)) !* Swap of ssh_ib fields
r1_grau = 1.e0 / (grav * rho0) !* constant for optimization
- ssh_ib(:,:) = - ( frcv(jpr_mslp)%z3(:,:,1) - rpref ) * r1_grau ! equivalent ssh (inverse barometer)
- apr (:,:) = frcv(jpr_mslp)%z3(:,:,1) !atmospheric pressure
+ ssh_ib(A2D(0)) = - ( frcv(jpr_mslp)%z3(:,:,1) - rpref ) * r1_grau ! equivalent ssh (inverse barometer)
+ apr (A2D(0)) = frcv(jpr_mslp)%z3(:,:,1) !atmospheric pressure
- IF( kt == nit000 ) ssh_ibb(:,:) = ssh_ib(:,:) ! correct this later (read from restart if possible)
+ IF( kt == nit000 ) ssh_ibb(A2D(0)) = ssh_ib(A2D(0)) ! correct this later (read from restart if possible)
+ CALL lbc_lnk( 'sbccpl', ssh_ib, 'T', 1.0_wp, ssh_ibb, 'T', 1.0_wp )
ENDIF
!
IF( ln_sdw ) THEN ! Stokes Drift correction activated
@@ -1361,30 +1366,33 @@ CONTAINS
! ! SST !
! ! ================== !
IF( srcv(jpr_toce)%laction ) THEN ! received by sas in case of opa <-> sas coupling
- sst_m(:,:) = frcv(jpr_toce)%z3(:,:,1)
+ sst_m(A2D(0)) = frcv(jpr_toce)%z3(:,:,1)
IF( srcv(jpr_soce)%laction .AND. l_useCT ) THEN ! make sure that sst_m is the potential temperature
- sst_m(:,:) = eos_pt_from_ct( sst_m(:,:), sss_m(:,:) )
+ sst_m(A2D(0)) = eos_pt_from_ct( sst_m(A2D(0)), sss_m(A2D(0)) )
ENDIF
+ CALL iom_put( 'sst_m', sst_m )
ENDIF
! ! ================== !
! ! SSH !
! ! ================== !
IF( srcv(jpr_ssh )%laction ) THEN ! received by sas in case of opa <-> sas coupling
- ssh_m(:,:) = frcv(jpr_ssh )%z3(:,:,1)
+ ssh_m(A2D(0)) = frcv(jpr_ssh )%z3(:,:,1)
CALL iom_put( 'ssh_m', ssh_m )
ENDIF
! ! ================== !
! ! surface currents !
! ! ================== !
IF( srcv(jpr_ocx1)%laction ) THEN ! received by sas in case of opa <-> sas coupling
- ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1)
- uu(:,:,1,Kbb) = ssu_m(:,:) ! will be used in icestp in the call of ice_forcing_tau
+ ssu_m(A2D(0)) = frcv(jpr_ocx1)%z3(:,:,1)
+ CALL lbc_lnk( 'sbccpl', ssu_m, 'U', -1.0_wp )
+ uu(:,:,1,Kbb) = ssu_m(:,:) ! will be used in icestp in the call of ice_update_tau
uu(:,:,1,Kmm) = ssu_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling
CALL iom_put( 'ssu_m', ssu_m )
ENDIF
IF( srcv(jpr_ocy1)%laction ) THEN
- ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1)
- vv(:,:,1,Kbb) = ssv_m(:,:) ! will be used in icestp in the call of ice_forcing_tau
+ ssv_m(A2D(0)) = frcv(jpr_ocy1)%z3(:,:,1)
+ CALL lbc_lnk( 'sbccpl', ssv_m, 'V', -1.0_wp )
+ vv(:,:,1,Kbb) = ssv_m(:,:) ! will be used in icestp in the call of ice_update_tau
vv(:,:,1,Kmm) = ssv_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling
CALL iom_put( 'ssv_m', ssv_m )
ENDIF
@@ -1392,14 +1400,14 @@ CONTAINS
! ! first T level thickness !
! ! ======================== !
IF( srcv(jpr_e3t1st )%laction ) THEN ! received by sas in case of opa <-> sas coupling
- e3t_m(:,:) = frcv(jpr_e3t1st )%z3(:,:,1)
- CALL iom_put( 'e3t_m', e3t_m(:,:) )
+ e3t_m(A2D(0)) = frcv(jpr_e3t1st )%z3(:,:,1)
+ CALL iom_put( 'e3t_m', e3t_m )
ENDIF
! ! ================================ !
! ! fraction of solar net radiation !
! ! ================================ !
IF( srcv(jpr_fraqsr)%laction ) THEN ! received by sas in case of opa <-> sas coupling
- frq_m(:,:) = frcv(jpr_fraqsr)%z3(:,:,1)
+ frq_m(A2D(0)) = frcv(jpr_fraqsr)%z3(:,:,1)
CALL iom_put( 'frq_m', frq_m )
ENDIF
@@ -1422,21 +1430,21 @@ CONTAINS
ENDIF
!
! ! runoffs and calving (added in emp)
- IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
+ IF( srcv(jpr_rnf)%laction ) rnf(A2D(0)) = frcv(jpr_rnf)%z3(:,:,1)
IF( srcv(jpr_cal)%laction ) zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1)
IF( srcv(jpr_icb)%laction ) THEN
- fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1)
- rnf(:,:) = rnf(:,:) + fwficb(:,:) ! iceberg added to runfofs
+ fwficb(A2D(0)) = frcv(jpr_icb)%z3(:,:,1)
+ rnf (A2D(0)) = rnf(A2D(0)) + fwficb(A2D(0)) ! iceberg added to runfofs
ENDIF
!
! ice shelf fwf
IF( srcv(jpr_isf)%laction ) THEN
- fwfisf_oasis(:,:) = frcv(jpr_isf)%z3(:,:,1) ! fresh water flux from the isf to the ocean ( > 0 = melting )
+ fwfisf_oasis(A2D(0)) = frcv(jpr_isf)%z3(:,:,1) ! fresh water flux from the isf to the ocean ( > 0 = melting )
END IF
- IF( ln_mixcpl ) THEN ; emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:)
- ELSE ; emp(:,:) = zemp(:,:)
+ IF( ln_mixcpl ) THEN ; emp(A2D(0)) = emp(A2D(0)) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:)
+ ELSE ; emp(A2D(0)) = zemp(:,:)
ENDIF
!
! ! non solar heat flux over the ocean (qns)
@@ -1446,7 +1454,7 @@ CONTAINS
ENDIF
! update qns over the free ocean with:
IF( nn_components /= jp_iam_oce ) THEN
- zqns(:,:) = zqns(:,:) - zemp(:,:) * sst_m(:,:) * rcp ! remove heat content due to mass flux (assumed to be at SST)
+ zqns(:,:) = zqns(:,:) - zemp(:,:) * sst_m(A2D(0)) * rcp ! remove heat content due to mass flux (assumed to be at SST)
IF( srcv(jpr_snow )%laction ) THEN
zqns(:,:) = zqns(:,:) - frcv(jpr_snow)%z3(:,:,1) * rLfus ! energy for melting solid precipitation over the free ocean
ENDIF
@@ -1509,13 +1517,13 @@ CONTAINS
!!
!! ** Action : return ptau_i, ptau_j, the stress over the ice
!!----------------------------------------------------------------------
- REAL(wp), INTENT(inout), DIMENSION(:,:) :: p_taui ! i- & j-components of atmos-ice stress [N/m2]
- REAL(wp), INTENT(inout), DIMENSION(:,:) :: p_tauj ! at T-point
+ REAL(wp), INTENT(inout), DIMENSION(A2D(0)) :: p_taui ! i- & j-components of atmos-ice stress [N/m2]
+ REAL(wp), INTENT(inout), DIMENSION(A2D(0)) :: p_tauj ! at T-point
!!
INTEGER :: ji, jj ! dummy loop indices
INTEGER :: itx ! index of taux over ice
- REAL(wp) :: zztmp1, zztmp2
- REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty
+ REAL(wp) :: zztmp1, zztmp2
+ REAL(wp), DIMENSION(A2D(0)) :: ztx, zty
!!----------------------------------------------------------------------
!
#if defined key_si3 || defined key_cice
@@ -1622,22 +1630,23 @@ CONTAINS
!! dqns_ice d(non-solar heat flux)/d(Temperature) over the ice
!! sprecip solid precipitation over the ocean
!!----------------------------------------------------------------------
- INTEGER, INTENT(in) :: kt ! ocean model time step index (only for a_i_last_couple)
- REAL(wp), INTENT(in) , DIMENSION(:,:) :: picefr ! ice fraction [0 to 1]
- ! !! ! optional arguments, used only in 'mixed oce-ice' case or for Met-Office coupling
- REAL(wp), INTENT(in) , DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo
- REAL(wp), INTENT(in) , DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius]
- REAL(wp), INTENT(inout), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] => inout for Met-Office
- REAL(wp), INTENT(in) , DIMENSION(:,:,:), OPTIONAL :: phs ! snow depth [m]
- REAL(wp), INTENT(in) , DIMENSION(:,:,:), OPTIONAL :: phi ! ice thickness [m]
+ INTEGER, INTENT(in) :: kt ! ocean model time step index (only for a_i_last_couple)
+ REAL(wp), INTENT(in) , DIMENSION(A2D(0)) :: picefr ! ice fraction [0 to 1]
+ ! !! optional arguments, used only in 'mixed oce-ice' case or for Met-Office coupling
+ REAL(wp), INTENT(in) , DIMENSION(A2D(0),jpl), OPTIONAL :: palbi ! all skies ice albedo
+ REAL(wp), INTENT(in) , DIMENSION(A2D(0) ), OPTIONAL :: psst ! sea surface temperature [Celsius]
+ REAL(wp), INTENT(inout), DIMENSION(A2D(0),jpl), OPTIONAL :: pist ! ice surface temperature [Kelvin] => inout for Met-Office
+ REAL(wp), INTENT(in) , DIMENSION(A2D(0),jpl), OPTIONAL :: phs ! snow depth [m]
+ REAL(wp), INTENT(in) , DIMENSION(A2D(0),jpl), OPTIONAL :: phi ! ice thickness [m]
!
INTEGER :: ji, jj, jl ! dummy loop index
- REAL(wp), DIMENSION(jpi,jpj) :: zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw
- REAL(wp), DIMENSION(jpi,jpj) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip , zevap_oce, zdevap_ice
- REAL(wp), DIMENSION(jpi,jpj) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice
- REAL(wp), DIMENSION(jpi,jpj) :: zevap_ice_total
- REAL(wp), DIMENSION(jpi,jpj,jpl) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice, zqtr_ice_top, ztsu
- REAL(wp), DIMENSION(jpi,jpj) :: ztri
+ REAL(wp), DIMENSION(A2D(0)) :: zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw
+ REAL(wp), DIMENSION(A2D(0)) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip , zevap_oce, zdevap_ice
+ REAL(wp), DIMENSION(A2D(0)) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice
+ REAL(wp), DIMENSION(A2D(0)) :: zevap_ice_total
+ REAL(wp), DIMENSION(A2D(0)) :: ztri
+ REAL(wp), DIMENSION(A2D(0),jpl) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice, zqtr_ice_top
+ REAL(wp), DIMENSION(A2D(0),jpl) :: ztsu
!!----------------------------------------------------------------------
!
#if defined key_si3 || defined key_cice
@@ -1651,7 +1660,7 @@ CONTAINS
!
IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0)
ziceld(:,:) = 1._wp - picefr(:,:)
- zcptn (:,:) = rcp * sst_m(:,:)
+ zcptn (:,:) = rcp * sst_m(A2D(0))
!
! ! ========================= !
! ! freshwater budget ! (emp_tot)
@@ -1663,9 +1672,9 @@ CONTAINS
! ! sublimation - solid precipitation (cell average) (emp_ice)
SELECT CASE( TRIM( sn_rcv_emp%cldes ) )
CASE( 'conservative' ) ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp
- zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here
- ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here
- zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:)
+ zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here
+ ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here
+ zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:)
CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp
zemp_tot(:,:) = ziceld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + picefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1)
zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * picefr(:,:)
@@ -1679,15 +1688,17 @@ CONTAINS
! --- evaporation over ice (kg/m2/s) --- !
IF( ln_scale_ice_flux ) THEN ! typically met-office requirements
IF( sn_rcv_emp%clcat == 'yes' ) THEN
- WHERE( a_i(:,:,:) > 1.e-10 ) ; zevap_ice(:,:,:) = frcv(jpr_ievp)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:)
- ELSEWHERE ; zevap_ice(:,:,:) = 0._wp
+ WHERE( a_i(A2D(0),:) > 1.e-10 ) ; zevap_ice(:,:,:) = frcv(jpr_ievp)%z3(:,:,:) * &
+ & a_i_last_couple(A2D(0),:) / a_i(A2D(0),:)
+ ELSEWHERE ; zevap_ice(:,:,:) = 0._wp
END WHERE
- WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) / picefr(:,:)
- ELSEWHERE ; zevap_ice_total(:,:) = 0._wp
+ WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:) * a_i(A2D(0),:), dim=3 ) / picefr(:,:)
+ ELSEWHERE ; zevap_ice_total(:,:) = 0._wp
END WHERE
ELSE
- WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1) * SUM( a_i_last_couple, dim=3 ) / picefr(:,:)
- ELSEWHERE ; zevap_ice(:,:,1) = 0._wp
+ WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1) * &
+ & SUM( a_i_last_couple(A2D(0),:), dim=3 ) / picefr(:,:)
+ ELSEWHERE ; zevap_ice(:,:,1) = 0._wp
END WHERE
zevap_ice_total(:,:) = zevap_ice(:,:,1)
DO jl = 2, jpl
@@ -1697,7 +1708,7 @@ CONTAINS
ELSE
IF( sn_rcv_emp%clcat == 'yes' ) THEN
zevap_ice(:,:,1:jpl) = frcv(jpr_ievp)%z3(:,:,1:jpl)
- WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) / picefr(:,:)
+ WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:) * a_i(A2D(0),:), dim=3 ) / picefr(:,:)
ELSEWHERE ; zevap_ice_total(:,:) = 0._wp
END WHERE
ELSE
@@ -1730,18 +1741,18 @@ CONTAINS
! --- Continental fluxes --- !
IF( srcv(jpr_rnf)%laction ) THEN ! runoffs (included in emp later on)
- rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
+ rnf(A2D(0)) = frcv(jpr_rnf)%z3(:,:,1)
ENDIF
IF( srcv(jpr_cal)%laction ) THEN ! calving (put in emp_tot and emp_oce)
zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)
zemp_oce(:,:) = zemp_oce(:,:) - frcv(jpr_cal)%z3(:,:,1)
ENDIF
IF( srcv(jpr_icb)%laction ) THEN ! iceberg added to runoffs
- fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1)
- rnf(:,:) = rnf(:,:) + fwficb(:,:)
+ fwficb(A2D(0)) = frcv(jpr_icb)%z3(:,:,1)
+ rnf (A2D(0)) = rnf(A2D(0)) + fwficb(A2D(0))
ENDIF
IF( srcv(jpr_isf)%laction ) THEN ! iceshelf (fwfisf > 0 mean melting)
- fwfisf_oasis(:,:) = frcv(jpr_isf)%z3(:,:,1)
+ fwfisf_oasis(A2D(0)) = frcv(jpr_isf)%z3(:,:,1)
ENDIF
IF( ln_mixcpl ) THEN
@@ -1796,29 +1807,29 @@ CONTAINS
!!$ ENDIF
!
! outputs
- IF( srcv(jpr_cal)%laction ) CALL iom_put( 'calving_cea' , frcv(jpr_cal)%z3(:,:,1) * tmask(:,:,1) ) ! calving
- IF( srcv(jpr_icb)%laction ) CALL iom_put( 'iceberg_cea' , frcv(jpr_icb)%z3(:,:,1) * tmask(:,:,1) ) ! icebergs
+ IF( srcv(jpr_cal)%laction ) CALL iom_put( 'calving_cea' , frcv(jpr_cal)%z3(:,:,1) * tmask(A2D(0),1) ) ! calving
+ IF( srcv(jpr_icb)%laction ) CALL iom_put( 'iceberg_cea' , frcv(jpr_icb)%z3(:,:,1) * tmask(A2D(0),1) ) ! icebergs
IF( iom_use('snowpre') ) CALL iom_put( 'snowpre' , sprecip(:,:) ) ! Snow
IF( iom_use('precip') ) CALL iom_put( 'precip' , tprecip(:,:) ) ! total precipitation
IF( iom_use('rain') ) CALL iom_put( 'rain' , tprecip(:,:) - sprecip(:,:) ) ! liquid precipitation
IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average)
IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea' , sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average)
IF( iom_use('rain_ao_cea') ) CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * ziceld(:,:) ) ! liquid precipitation over ocean (cell average)
- IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea' , zevap_ice_total(:,:) * picefr(:,:) * tmask(:,:,1) ) ! Sublimation over sea-ice (cell average)
+ IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea' , zevap_ice_total(:,:) * picefr(:,:) * smask0(:,:) ) ! Sublimation over sea-ice (cell average)
IF( iom_use('evap_ao_cea') ) CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1) &
- & - zevap_ice_total(:,:) * picefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average)
+ & - zevap_ice_total(:,:) * picefr(:,:) ) * smask0(:,:) ) ! ice-free oce evap (cell average)
! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf
!! IF( srcv(jpr_rnf)%laction ) CALL iom_put( 'runoffs' , rnf(:,:) * tmask(:,:,1) ) ! runoff
-!! IF( srcv(jpr_isf)%laction ) CALL iom_put( 'iceshelf_cea', fwfisf(:,:) * tmask(:,:,1) ) ! iceshelf
+ IF( srcv(jpr_isf)%laction ) CALL iom_put( 'iceshelf_cea', frcv(jpr_isf)%z3(:,:,1) * smask0(:,:) ) ! iceshelf
!
! ! ========================= !
SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! ice topmelt and botmelt !
! ! ========================= !
CASE( 'coupled' )
IF( ln_scale_ice_flux ) THEN
- WHERE( a_i(:,:,:) > 1.e-10_wp )
- qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:)
- qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:)
+ WHERE( a_i(A2D(0),:) > 1.e-10_wp )
+ qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i_last_couple(A2D(0),:) / a_i(A2D(0),:)
+ qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i_last_couple(A2D(0),:) / a_i(A2D(0),:)
ELSEWHERE
qml_ice(:,:,:) = 0.0_wp
qcn_ice(:,:,:) = 0.0_wp
@@ -1841,7 +1852,7 @@ CONTAINS
ENDIF
! Calculate the total non solar heat flux. The ocean only non solar heat flux (zqns_oce) will be recalculated after this CASE
! statement to be consistent with other coupling methods even though .zqns_oce = frcv(jpr_qnsoce)%z3(:,:,1)
- zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) + SUM( zqns_ice(:,:,:) * a_i(:,:,:), dim=3 )
+ zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) + SUM( zqns_ice(:,:,:) * a_i(A2D(0),:), dim=3 )
CASE( 'conservative' ) ! the required fields are directly provided
zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
IF( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
@@ -1855,7 +1866,7 @@ CONTAINS
zqns_tot(:,:) = ziceld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)
IF( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
DO jl=1,jpl
- zqns_tot(:,: ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)
+ zqns_tot(:,: ) = zqns_tot(:,:) + a_i(A2D(0),jl) * frcv(jpr_qnsice)%z3(:,:,jl)
zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl)
ENDDO
ELSE
@@ -1884,21 +1895,22 @@ CONTAINS
!
! --- calving (removed from qns_tot) --- !
IF( srcv(jpr_cal)%laction ) zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) * rLfus ! remove latent heat of calving
- ! we suppose it melts at 0deg, though it should be temp. of surrounding ocean
+ ! we suppose it melts at 0deg, though it should be temp. of surrounding ocean
! --- iceberg (removed from qns_tot) --- !
IF( srcv(jpr_icb)%laction ) zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_icb)%z3(:,:,1) * rLfus ! remove latent heat of iceberg melting
! --- non solar flux over ocean --- !
! note: ziceld cannot be = 0 since we limit the ice concentration to amax
zqns_oce = 0._wp
- WHERE( ziceld /= 0._wp ) zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / ziceld(:,:)
+ WHERE( ziceld /= 0._wp ) zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i(A2D(0),:) * zqns_ice(:,:,:), dim=3 ) ) / ziceld(:,:)
! Heat content per unit mass of snow (J/kg)
- WHERE( SUM( a_i, dim=3 ) > 1.e-10 ) ; zcptsnw(:,:) = rcpi * SUM( (tn_ice - rt0) * a_i, dim=3 ) / SUM( a_i, dim=3 )
- ELSEWHERE ; zcptsnw(:,:) = zcptn(:,:)
+ WHERE( SUM( a_i(A2D(0),:), dim=3 ) > 1.e-10 ) ; zcptsnw(:,:) = rcpi * SUM( (tn_ice(:,:,:) - rt0) * a_i(A2D(0),:), dim=3 ) &
+ & / SUM( a_i(A2D(0),:), dim=3 )
+ ELSEWHERE ; zcptsnw(:,:) = zcptn(:,:)
ENDWHERE
! Heat content per unit mass of rain (J/kg)
- zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * ziceld(:,:) )
+ zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(A2D(0),:), dim=3 ) + sst_m(A2D(0)) * ziceld(:,:) )
! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- !
zqprec_ice(:,:) = rhos * ( zcptsnw(:,:) - rLfus )
@@ -1969,7 +1981,7 @@ CONTAINS
& CALL iom_put('hflx_rain_cea' , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) )
IF ( iom_use('hflx_evap_cea') ) & ! heat flux from evap (cell average)
& CALL iom_put('hflx_evap_cea' , ( frcv(jpr_tevp)%z3(:,:,1) - zevap_ice_total(:,:) * picefr(:,:) ) &
- & * zcptn(:,:) * tmask(:,:,1) )
+ & * zcptn(:,:) * smask0(:,:) )
IF ( iom_use('hflx_prec_cea') ) & ! heat flux from all precip (cell avg)
& CALL iom_put('hflx_prec_cea' , sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) &
& + ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) )
@@ -1980,7 +1992,7 @@ CONTAINS
IF ( iom_use('hflx_snow_ai_cea') ) & ! heat flux from snow (over ice)
& CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) * zsnw(:,:) )
IF( iom_use('hflx_subl_cea') ) & ! heat flux from sublimation
- & CALL iom_put('hflx_subl_cea' , SUM( qevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) * tmask(:,:,1) )
+ & CALL iom_put('hflx_subl_cea' , SUM( qevap_ice(:,:,:) * a_i(A2D(0),:), dim=3 ) * smask0(:,:) )
! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp.
!
! ! ========================= !
@@ -2028,7 +2040,7 @@ CONTAINS
zqsr_tot(:,: ) = ziceld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)
IF( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
DO jl = 1, jpl
- zqsr_tot(:,: ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)
+ zqsr_tot(:,: ) = zqsr_tot(:,:) + a_i(A2D(0),jl) * frcv(jpr_qsrice)%z3(:,:,jl)
zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl)
END DO
ELSE
@@ -2045,14 +2057,14 @@ CONTAINS
IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
DO jl = 1, jpl
zqsr_ice(:,:,jl) = frcv(jpr_qsrmix)%z3(:,:,jl) * ( 1.- palbi(:,:,jl) ) &
- & / ( 1.- ( alb_oce_mix(:,: ) * ziceld(:,:) &
- & + palbi (:,:,jl) * picefr(:,:) ) )
+ & / ( 1.- ( alb_oce_mix(:,: ) * ziceld(:,:) &
+ & + palbi (:,:,jl) * picefr(:,:) ) )
END DO
ELSE
DO jl = 1, jpl
zqsr_ice(:,:,jl) = frcv(jpr_qsrmix)%z3(:,:, 1) * ( 1.- palbi(:,:,jl) ) &
- & / ( 1.- ( alb_oce_mix(:,: ) * ziceld(:,:) &
- & + palbi (:,:,jl) * picefr(:,:) ) )
+ & / ( 1.- ( alb_oce_mix(:,: ) * ziceld(:,:) &
+ & + palbi (:,:,jl) * picefr(:,:) ) )
END DO
ENDIF
CASE( 'none' ) ! Not available as for now: needs additional coding
@@ -2060,7 +2072,7 @@ CONTAINS
CALL ctl_stop('STOP', 'sbccpl/sbc_cpl_ice_flx: some fields are not defined. Change sn_rcv_qsr value in namelist namsbc_cpl')
END SELECT
IF( ln_dm2dc .AND. ln_cpl ) THEN ! modify qsr to include the diurnal cycle
- zqsr_tot(:,: ) = sbc_dcy( zqsr_tot(:,: ) )
+ zqsr_tot(:,:) = sbc_dcy( zqsr_tot(:,:) )
DO jl = 1, jpl
zqsr_ice(:,:,jl) = sbc_dcy( zqsr_ice(:,:,jl) )
END DO
@@ -2102,8 +2114,8 @@ CONTAINS
! ! ===> here we receive the qtr_ice_top array from the coupler
CASE ('coupled')
IF (ln_scale_ice_flux) THEN
- WHERE( a_i(:,:,:) > 1.e-10_wp )
- zqtr_ice_top(:,:,:) = frcv(jpr_qtrice)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:)
+ WHERE( a_i(A2D(0),:) > 1.e-10_wp )
+ zqtr_ice_top(:,:,:) = frcv(jpr_qtrice)%z3(:,:,:) * a_i_last_couple(A2D(0),:) / a_i(A2D(0),:)
ELSEWHERE
zqtr_ice_top(:,:,:) = 0.0_wp
ENDWHERE
@@ -2113,7 +2125,7 @@ CONTAINS
! Add retrieved transmitted solar radiation onto the ice and total solar radiation
zqsr_ice(:,:,:) = zqsr_ice(:,:,:) + zqtr_ice_top(:,:,:)
- zqsr_tot(:,:) = zqsr_tot(:,:) + SUM( zqtr_ice_top(:,:,:) * a_i(:,:,:), dim=3 )
+ zqsr_tot(:,:) = zqsr_tot(:,:) + SUM( zqtr_ice_top(:,:,:) * a_i(A2D(0),:), dim=3 )
! if we are not getting this data from the coupler then assume zero (fully opaque ice)
CASE ('none')
@@ -2123,7 +2135,7 @@ CONTAINS
ENDIF
IF( ln_mixcpl ) THEN
- qsr_tot(:,:) = qsr(:,:) * ziceld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk
+ qsr_tot(:,:) = qsr(:,:) * ziceld(:,:) + SUM( qsr_ice(:,:,:) * a_i(A2D(0),:), dim=3 ) ! total flux from blk
qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) + zqsr_tot(:,:) * zmsk(:,:)
DO jl = 1, jpl
qsr_ice (:,:,jl) = qsr_ice (:,:,jl) * xcplmask(:,:,0) + zqsr_ice (:,:,jl) * zmsk(:,:)
@@ -2138,7 +2150,7 @@ CONTAINS
! --- solar flux over ocean --- !
! note: ziceld cannot be = 0 since we limit the ice concentration to amax
zqsr_oce = 0._wp
- WHERE( ziceld /= 0._wp ) zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / ziceld(:,:)
+ WHERE( ziceld /= 0._wp ) zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i(A2D(0),:) * zqsr_ice(:,:,:), dim=3 ) ) / ziceld(:,:)
IF( ln_mixcpl ) THEN ; qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) + zqsr_oce(:,:)* zmsk(:,:)
ELSE ; qsr_oce(:,:) = zqsr_oce(:,:) ; ENDIF
@@ -2183,25 +2195,26 @@ CONTAINS
INTEGER :: ji, jj, jl ! dummy loop indices
INTEGER :: isec, info ! local integer
REAL(wp) :: zumax, zvmax
- REAL(wp), DIMENSION(jpi,jpj) :: zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1
- REAL(wp), DIMENSION(jpi,jpj,jpl) :: ztmp3, ztmp4
+ REAL(wp), DIMENSION(A2D(0)) :: zat_i, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1
+ REAL(wp), DIMENSION(A2D(0),jpl) :: ztmp3, ztmp4
!!----------------------------------------------------------------------
!
isec = ( kt - nit000 ) * NINT( rn_Dt ) ! date of exchanges
info = OASIS_idle
- zfr_l(:,:) = 1.- fr_i(:,:)
+ zfr_l(:,:) = 1.- fr_i(A2D(0))
+ zat_i(:,:) = SUM( a_i(A2D(0),:), dim=3 )
! ! ------------------------- !
! ! Surface temperature ! in Kelvin
! ! ------------------------- !
IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN
IF( nn_components == jp_iam_oce ) THEN
- ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm) ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part
+ ztmp1(:,:) = ts(A2D(0),1,jp_tem,Kmm) ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part
ELSE
! we must send the surface potential temperature
- IF( l_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( ts(:,:,1,jp_tem,Kmm), ts(:,:,1,jp_sal,Kmm) )
- ELSE ; ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm)
+ IF( l_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( ts(A2D(0),1,jp_tem,Kmm), ts(A2D(0),1,jp_sal,Kmm) )
+ ELSE ; ztmp1(:,:) = ts(A2D(0),1,jp_tem,Kmm)
ENDIF
!
SELECT CASE( sn_snd_temp%cldes)
@@ -2211,8 +2224,8 @@ CONTAINS
CASE( 'yes' )
ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl)
CASE( 'no' )
- WHERE( SUM( a_i, dim=3 ) /= 0. )
- ztmp3(:,:,1) = SUM( tn_ice * a_i, dim=3 ) / SUM( a_i, dim=3 )
+ WHERE( zat_i(:,:) /= 0. )
+ ztmp3(:,:,1) = SUM( tn_ice(:,:,:) * a_i(A2D(0),:), dim=3 ) / zat_i(:,:)
ELSEWHERE
ztmp3(:,:,1) = rt0
END WHERE
@@ -2221,36 +2234,36 @@ CONTAINS
CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)
SELECT CASE( sn_snd_temp%clcat )
CASE( 'yes' )
- ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
+ ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(A2D(0),1:jpl)
CASE( 'no' )
ztmp3(:,:,:) = 0.0
DO jl=1,jpl
- ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl)
+ ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(A2D(0),jl)
ENDDO
CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
END SELECT
- CASE( 'oce and weighted ice') ; ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm) + rt0
+ CASE( 'oce and weighted ice') ; ztmp1(:,:) = ts(A2D(0),1,jp_tem,Kmm) + rt0
SELECT CASE( sn_snd_temp%clcat )
CASE( 'yes' )
- ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
+ ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(A2D(0),1:jpl)
CASE( 'no' )
ztmp3(:,:,:) = 0.0
DO jl=1,jpl
- ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl)
+ ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(A2D(0),jl)
ENDDO
CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
END SELECT
CASE( 'mixed oce-ice' )
ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)
DO jl=1,jpl
- ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl)
+ ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(A2D(0),jl)
ENDDO
CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' )
END SELECT
ENDIF
- IF( ssnd(jps_toce)%laction ) CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
+ IF( ssnd(jps_toce)%laction ) CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/Ni_0,Nj_0,1/) ), info )
IF( ssnd(jps_tice)%laction ) CALL cpl_snd( jps_tice, isec, ztmp3, info )
- IF( ssnd(jps_tmix)%laction ) CALL cpl_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
+ IF( ssnd(jps_tmix)%laction ) CALL cpl_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/Ni_0,Nj_0,1/) ), info )
ENDIF
!
! ! ------------------------- !
@@ -2261,7 +2274,7 @@ CONTAINS
IF( ssnd(jps_ttilyr)%laction) THEN
SELECT CASE( sn_snd_ttilyr%cldes)
CASE ('weighted ice')
- ztmp3(:,:,1:jpl) = t1_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
+ ztmp3(:,:,1:jpl) = t1_ice(:,:,1:jpl) * a_i(A2D(0),1:jpl)
CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_ttilyr%cldes' )
END SELECT
IF( ssnd(jps_ttilyr)%laction ) CALL cpl_snd( jps_ttilyr, isec, ztmp3, info )
@@ -2277,8 +2290,8 @@ CONTAINS
CASE( 'yes' )
ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl)
CASE( 'no' )
- WHERE( SUM( a_i, dim=3 ) /= 0. )
- ztmp1(:,:) = SUM( alb_ice (:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 ) / SUM( a_i(:,:,1:jpl), dim=3 )
+ WHERE( zat_i(:,:) /= 0. )
+ ztmp1(:,:) = SUM( alb_ice (:,:,1:jpl) * a_i(A2D(0),1:jpl), dim=3 ) / zat_i(:,:)
ELSEWHERE
ztmp1(:,:) = alb_oce_mix(:,:)
END WHERE
@@ -2287,10 +2300,10 @@ CONTAINS
CASE( 'weighted ice' ) ;
SELECT CASE( sn_snd_alb%clcat )
CASE( 'yes' )
- ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
+ ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(A2D(0),1:jpl)
CASE( 'no' )
- WHERE( fr_i (:,:) > 0. )
- ztmp1(:,:) = SUM ( alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 )
+ WHERE( fr_i (A2D(0)) > 0. )
+ ztmp1(:,:) = SUM ( alb_ice(:,:,1:jpl) * a_i(A2D(0),1:jpl), dim=3 )
ELSEWHERE
ztmp1(:,:) = 0.
END WHERE
@@ -2303,16 +2316,16 @@ CONTAINS
CASE( 'yes' )
CALL cpl_snd( jps_albice, isec, ztmp3, info ) !-> MV this has never been checked in coupled mode
CASE( 'no' )
- CALL cpl_snd( jps_albice, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
+ CALL cpl_snd( jps_albice, isec, RESHAPE ( ztmp1, (/Ni_0,Nj_0,1/) ), info )
END SELECT
ENDIF
IF( ssnd(jps_albmix)%laction ) THEN ! mixed ice-ocean
ztmp1(:,:) = alb_oce_mix(:,:) * zfr_l(:,:)
DO jl = 1, jpl
- ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl)
+ ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(A2D(0),jl)
END DO
- CALL cpl_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
+ CALL cpl_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/Ni_0,Nj_0,1/) ), info )
ENDIF
! ! ------------------------- !
! ! Ice fraction & Thickness !
@@ -2320,8 +2333,8 @@ CONTAINS
! Send ice fraction field to atmosphere
IF( ssnd(jps_fice)%laction ) THEN
SELECT CASE( sn_snd_thick%clcat )
- CASE( 'yes' ) ; ztmp3(:,:,1:jpl) = a_i(:,:,1:jpl)
- CASE( 'no' ) ; ztmp3(:,:,1 ) = fr_i(:,: )
+ CASE( 'yes' ) ; ztmp3(:,:,1:jpl) = a_i(A2D(0),1:jpl)
+ CASE( 'no' ) ; ztmp3(:,:,1 ) = fr_i(A2D(0) )
CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
END SELECT
CALL cpl_snd( jps_fice, isec, ztmp3, info )
@@ -2341,8 +2354,8 @@ CONTAINS
IF( ssnd(jps_fice1)%laction ) THEN
SELECT CASE( sn_snd_thick1%clcat )
- CASE( 'yes' ) ; ztmp3(:,:,1:jpl) = a_i(:,:,1:jpl)
- CASE( 'no' ) ; ztmp3(:,:,1 ) = fr_i(:,: )
+ CASE( 'yes' ) ; ztmp3(:,:,1:jpl) = a_i(A2D(0),1:jpl)
+ CASE( 'no' ) ; ztmp3(:,:,1 ) = fr_i(A2D(0) )
CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick1%clcat' )
END SELECT
CALL cpl_snd( jps_fice1, isec, ztmp3, info )
@@ -2350,7 +2363,7 @@ CONTAINS
! Send ice fraction field to OCE (sent by SAS in SAS-OCE coupling)
IF( ssnd(jps_fice2)%laction ) THEN
- ztmp3(:,:,1) = fr_i(:,:)
+ ztmp3(:,:,1) = fr_i(A2D(0))
IF( ssnd(jps_fice2)%laction ) CALL cpl_snd( jps_fice2, isec, ztmp3, info )
ENDIF
@@ -2361,25 +2374,25 @@ CONTAINS
CASE( 'weighted ice and snow' )
SELECT CASE( sn_snd_thick%clcat )
CASE( 'yes' )
- ztmp3(:,:,1:jpl) = h_i(:,:,1:jpl) * a_i(:,:,1:jpl)
- ztmp4(:,:,1:jpl) = h_s(:,:,1:jpl) * a_i(:,:,1:jpl)
+ ztmp3(:,:,1:jpl) = h_i(A2D(0),1:jpl) * a_i(A2D(0),1:jpl)
+ ztmp4(:,:,1:jpl) = h_s(A2D(0),1:jpl) * a_i(A2D(0),1:jpl)
CASE( 'no' )
ztmp3(:,:,:) = 0.0 ; ztmp4(:,:,:) = 0.0
DO jl=1,jpl
- ztmp3(:,:,1) = ztmp3(:,:,1) + h_i(:,:,jl) * a_i(:,:,jl)
- ztmp4(:,:,1) = ztmp4(:,:,1) + h_s(:,:,jl) * a_i(:,:,jl)
+ ztmp3(:,:,1) = ztmp3(:,:,1) + h_i(A2D(0),jl) * a_i(A2D(0),jl)
+ ztmp4(:,:,1) = ztmp4(:,:,1) + h_s(A2D(0),jl) * a_i(A2D(0),jl)
ENDDO
CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
END SELECT
CASE( 'ice and snow' )
SELECT CASE( sn_snd_thick%clcat )
CASE( 'yes' )
- ztmp3(:,:,1:jpl) = h_i(:,:,1:jpl)
- ztmp4(:,:,1:jpl) = h_s(:,:,1:jpl)
+ ztmp3(:,:,1:jpl) = h_i(A2D(0),1:jpl)
+ ztmp4(:,:,1:jpl) = h_s(A2D(0),1:jpl)
CASE( 'no' )
WHERE( SUM( a_i, dim=3 ) /= 0. )
- ztmp3(:,:,1) = SUM( h_i * a_i, dim=3 ) / SUM( a_i, dim=3 )
- ztmp4(:,:,1) = SUM( h_s * a_i, dim=3 ) / SUM( a_i, dim=3 )
+ ztmp3(:,:,1) = SUM( h_i(A2D(0),:) * a_i(A2D(0),:), dim=3 ) / zat_i(:,:)
+ ztmp4(:,:,1) = SUM( h_s(A2D(0),:) * a_i(A2D(0),:), dim=3 ) / zat_i(:,:)
ELSEWHERE
ztmp3(:,:,1) = 0.
ztmp4(:,:,1) = 0.
@@ -2403,13 +2416,13 @@ CONTAINS
SELECT CASE( sn_snd_mpnd%clcat )
CASE( 'yes' )
ztmp3(:,:,1:jpl) = a_ip_eff(:,:,1:jpl)
- ztmp4(:,:,1:jpl) = h_ip(:,:,1:jpl)
+ ztmp4(:,:,1:jpl) = h_ip(A2D(0),1:jpl)
CASE( 'no' )
ztmp3(:,:,:) = 0.0
ztmp4(:,:,:) = 0.0
DO jl=1,jpl
ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip_frac(:,:,jpl)
- ztmp4(:,:,1) = ztmp4(:,:,1) + h_ip(:,:,jpl)
+ ztmp4(:,:,1) = ztmp4(:,:,1) + h_ip(A2D(0),jpl)
ENDDO
CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%clcat' )
END SELECT
@@ -2428,11 +2441,11 @@ CONTAINS
CASE( 'weighted ice' )
SELECT CASE( sn_snd_cond%clcat )
CASE( 'yes' )
- ztmp3(:,:,1:jpl) = cnd_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
+ ztmp3(:,:,1:jpl) = cnd_ice(:,:,1:jpl) * a_i(A2D(0),1:jpl)
CASE( 'no' )
ztmp3(:,:,:) = 0.0
DO jl=1,jpl
- ztmp3(:,:,1) = ztmp3(:,:,1) + cnd_ice(:,:,jl) * a_i(:,:,jl)
+ ztmp3(:,:,1) = ztmp3(:,:,1) + cnd_ice(:,:,jl) * a_i(A2D(0),jl)
ENDDO
CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%clcat' )
END SELECT
@@ -2448,8 +2461,8 @@ CONTAINS
! ! CO2 flux from PISCES !
! ! ------------------------- !
IF( ssnd(jps_co2)%laction .AND. l_co2cpl ) THEN
- ztmp1(:,:) = oce_co2(:,:) * 1000. ! conversion in molC/m2/s
- CALL cpl_snd( jps_co2, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ) , info )
+ ztmp1(:,:) = oce_co2(A2D(0)) * 1000. ! conversion in molC/m2/s
+ CALL cpl_snd( jps_co2, isec, RESHAPE ( ztmp1, (/Ni_0,Nj_0,1/) ) , info )
ENDIF
!
! ! ------------------------- !
@@ -2465,8 +2478,8 @@ CONTAINS
! i-1 i i
!!clem: make a new variable at T-point to replace uu and vv => uuT and vvT for instance
IF( nn_components == jp_iam_oce ) THEN
- zotx1(:,:) = uu(:,:,1,Kmm)
- zoty1(:,:) = vv(:,:,1,Kmm)
+ zotx1(:,:) = uu(A2D(0),1,Kmm)
+ zoty1(:,:) = vv(A2D(0),1,Kmm)
!!clem : should be demi sum, no? Or uuT and vvT
ELSE
SELECT CASE( TRIM( sn_snd_crt%cldes ) )
@@ -2482,7 +2495,7 @@ CONTAINS
zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj)
zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj)
END_2D
- CALL lbc_lnk( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp )
+!!$ CALL lbc_lnk( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp )
CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T
DO_2D( 0, 0, 0, 0 )
zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) &
@@ -2491,7 +2504,7 @@ CONTAINS
& + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj)
END_2D
END SELECT
- CALL lbc_lnk( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocy1)%clgrid, -1.0_wp )
+!!$ CALL lbc_lnk( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocy1)%clgrid, -1.0_wp )
!
ENDIF
!
@@ -2523,13 +2536,13 @@ CONTAINS
ENDIF
ENDIF
!
- IF( ssnd(jps_ocx1)%laction ) CALL cpl_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info ) ! ocean x current 1st grid
- IF( ssnd(jps_ocy1)%laction ) CALL cpl_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info ) ! ocean y current 1st grid
- IF( ssnd(jps_ocz1)%laction ) CALL cpl_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info ) ! ocean z current 1st grid
+ IF( ssnd(jps_ocx1)%laction ) CALL cpl_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/Ni_0,Nj_0,1/) ), info ) ! ocean x current 1st grid
+ IF( ssnd(jps_ocy1)%laction ) CALL cpl_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/Ni_0,Nj_0,1/) ), info ) ! ocean y current 1st grid
+ IF( ssnd(jps_ocz1)%laction ) CALL cpl_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/Ni_0,Nj_0,1/) ), info ) ! ocean z current 1st grid
!
- IF( ssnd(jps_ivx1)%laction ) CALL cpl_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info ) ! ice x current 1st grid
- IF( ssnd(jps_ivy1)%laction ) CALL cpl_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info ) ! ice y current 1st grid
- IF( ssnd(jps_ivz1)%laction ) CALL cpl_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info ) ! ice z current 1st grid
+ IF( ssnd(jps_ivx1)%laction ) CALL cpl_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/Ni_0,Nj_0,1/) ), info ) ! ice x current 1st grid
+ IF( ssnd(jps_ivy1)%laction ) CALL cpl_snd( jps_ivy1, isec, RESHAPE ( zity1, (/Ni_0,Nj_0,1/) ), info ) ! ice y current 1st grid
+ IF( ssnd(jps_ivz1)%laction ) CALL cpl_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/Ni_0,Nj_0,1/) ), info ) ! ice z current 1st grid
!
ENDIF
!
@@ -2559,7 +2572,7 @@ CONTAINS
zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj)
zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj)
END_2D
- CALL lbc_lnk( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp )
+!!$ CALL lbc_lnk( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp )
CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T
DO_2D( 0, 0, 0, 0 )
zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) &
@@ -2568,7 +2581,7 @@ CONTAINS
& + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj)
END_2D
END SELECT
- CALL lbc_lnk( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocyw)%clgrid, -1.0_wp )
+!!$ CALL lbc_lnk( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocyw)%clgrid, -1.0_wp )
!
!
IF( TRIM( sn_snd_crtw%clvor ) == 'eastward-northward' ) THEN ! Rotation of the components
@@ -2598,13 +2611,13 @@ CONTAINS
! ENDIF
! ENDIF
!
- IF( ssnd(jps_ocxw)%laction ) CALL cpl_snd( jps_ocxw, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info ) ! ocean x current 1st grid
- IF( ssnd(jps_ocyw)%laction ) CALL cpl_snd( jps_ocyw, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info ) ! ocean y current 1st grid
+ IF( ssnd(jps_ocxw)%laction ) CALL cpl_snd( jps_ocxw, isec, RESHAPE ( zotx1, (/Ni_0,Nj_0,1/) ), info ) ! ocean x current 1st grid
+ IF( ssnd(jps_ocyw)%laction ) CALL cpl_snd( jps_ocyw, isec, RESHAPE ( zoty1, (/Ni_0,Nj_0,1/) ), info ) ! ocean y current 1st grid
!
ENDIF
!
IF( ssnd(jps_ficet)%laction ) THEN
- CALL cpl_snd( jps_ficet, isec, RESHAPE ( fr_i, (/jpi,jpj,1/) ), info )
+ CALL cpl_snd( jps_ficet, isec, RESHAPE ( fr_i(A2D(0)), (/Ni_0,Nj_0,1/) ), info )
ENDIF
! ! ------------------------- !
! ! Water levels to waves !
@@ -2612,14 +2625,14 @@ CONTAINS
IF( ssnd(jps_wlev)%laction ) THEN
IF( ln_apr_dyn ) THEN
IF( kt /= nit000 ) THEN
- ztmp1(:,:) = ssh(:,:,Kbb) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
+ ztmp1(:,:) = ssh(A2D(0),Kbb) - 0.5 * ( ssh_ib(A2D(0)) + ssh_ibb(A2D(0)) )
ELSE
- ztmp1(:,:) = ssh(:,:,Kbb)
+ ztmp1(:,:) = ssh(A2D(0),Kbb)
ENDIF
ELSE
- ztmp1(:,:) = ssh(:,:,Kmm)
+ ztmp1(:,:) = ssh(A2D(0),Kmm)
ENDIF
- CALL cpl_snd( jps_wlev , isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
+ CALL cpl_snd( jps_wlev , isec, RESHAPE ( ztmp1, (/Ni_0,Nj_0,1/) ), info )
ENDIF
!
! Fields sent by OCE to SAS when doing OCE<->SAS coupling
@@ -2627,44 +2640,44 @@ CONTAINS
IF( ssnd(jps_ssh )%laction ) THEN
! ! removed inverse barometer ssh when Patm
! forcing is used (for sea-ice dynamics)
- IF( ln_apr_dyn ) THEN ; ztmp1(:,:) = ssh(:,:,Kbb) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
- ELSE ; ztmp1(:,:) = ssh(:,:,Kmm)
+ IF( ln_apr_dyn ) THEN ; ztmp1(:,:) = ssh(A2D(0),Kbb) - 0.5 * ( ssh_ib(A2D(0)) + ssh_ibb(A2D(0)) )
+ ELSE ; ztmp1(:,:) = ssh(A2D(0),Kmm)
ENDIF
- CALL cpl_snd( jps_ssh , isec, RESHAPE ( ztmp1 , (/jpi,jpj,1/) ), info )
+ CALL cpl_snd( jps_ssh , isec, RESHAPE ( ztmp1 , (/Ni_0,Nj_0,1/) ), info )
ENDIF
! ! SSS
IF( ssnd(jps_soce )%laction ) THEN
- CALL cpl_snd( jps_soce , isec, RESHAPE ( ts(:,:,1,jp_sal,Kmm), (/jpi,jpj,1/) ), info )
+ CALL cpl_snd( jps_soce , isec, RESHAPE ( ts(A2D(0),1,jp_sal,Kmm), (/Ni_0,Nj_0,1/) ), info )
ENDIF
! ! first T level thickness
IF( ssnd(jps_e3t1st )%laction ) THEN
- CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( e3t(:,:,1,Kmm) , (/jpi,jpj,1/) ), info )
+ CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( e3t(Nis0:Nie0,Njs0:Nje0,1,Kmm) , (/Ni_0,Nj_0,1/) ), info )
ENDIF
! ! Qsr fraction
IF( ssnd(jps_fraqsr)%laction ) THEN
- CALL cpl_snd( jps_fraqsr, isec, RESHAPE ( fraqsr_1lev(:,:) , (/jpi,jpj,1/) ), info )
+ CALL cpl_snd( jps_fraqsr, isec, RESHAPE ( fraqsr_1lev(A2D(0)) , (/Ni_0,Nj_0,1/) ), info )
ENDIF
!
! Fields sent by SAS to OCE when OASIS coupling
! ! Solar heat flux
- IF( ssnd(jps_qsroce)%laction ) CALL cpl_snd( jps_qsroce, isec, RESHAPE ( qsr , (/jpi,jpj,1/) ), info )
- IF( ssnd(jps_qnsoce)%laction ) CALL cpl_snd( jps_qnsoce, isec, RESHAPE ( qns , (/jpi,jpj,1/) ), info )
- IF( ssnd(jps_oemp )%laction ) CALL cpl_snd( jps_oemp , isec, RESHAPE ( emp , (/jpi,jpj,1/) ), info )
- IF( ssnd(jps_sflx )%laction ) CALL cpl_snd( jps_sflx , isec, RESHAPE ( sfx , (/jpi,jpj,1/) ), info )
- IF( ssnd(jps_otx1 )%laction ) CALL cpl_snd( jps_otx1 , isec, RESHAPE ( utau, (/jpi,jpj,1/) ), info )
- IF( ssnd(jps_oty1 )%laction ) CALL cpl_snd( jps_oty1 , isec, RESHAPE ( vtau, (/jpi,jpj,1/) ), info )
- IF( ssnd(jps_rnf )%laction ) CALL cpl_snd( jps_rnf , isec, RESHAPE ( rnf , (/jpi,jpj,1/) ), info )
- IF( ssnd(jps_taum )%laction ) CALL cpl_snd( jps_taum , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info )
+ IF( ssnd(jps_qsroce)%laction ) CALL cpl_snd( jps_qsroce, isec, RESHAPE ( qsr (:,:) , (/Ni_0,Nj_0,1/) ), info )
+ IF( ssnd(jps_qnsoce)%laction ) CALL cpl_snd( jps_qnsoce, isec, RESHAPE ( qns (:,:) , (/Ni_0,Nj_0,1/) ), info )
+ IF( ssnd(jps_oemp )%laction ) CALL cpl_snd( jps_oemp , isec, RESHAPE ( emp (A2D(0)), (/Ni_0,Nj_0,1/) ), info )
+ IF( ssnd(jps_sflx )%laction ) CALL cpl_snd( jps_sflx , isec, RESHAPE ( sfx (:,:) , (/Ni_0,Nj_0,1/) ), info )
+ IF( ssnd(jps_otx1 )%laction ) CALL cpl_snd( jps_otx1 , isec, RESHAPE ( utau(A2D(0)), (/Ni_0,Nj_0,1/) ), info )
+ IF( ssnd(jps_oty1 )%laction ) CALL cpl_snd( jps_oty1 , isec, RESHAPE ( vtau(A2D(0)), (/Ni_0,Nj_0,1/) ), info )
+ IF( ssnd(jps_rnf )%laction ) CALL cpl_snd( jps_rnf , isec, RESHAPE ( rnf (A2D(0)), (/Ni_0,Nj_0,1/) ), info )
+ IF( ssnd(jps_taum )%laction ) CALL cpl_snd( jps_taum , isec, RESHAPE ( taum(:,:) , (/Ni_0,Nj_0,1/) ), info )
#if defined key_si3
! ! ------------------------- !
! ! Sea surface freezing temp !
! ! ------------------------- !
! needed by Met Office
- CALL eos_fzp(ts(:,:,1,jp_sal,Kmm), sstfrz)
+ CALL eos_fzp(ts(A2D(0),1,jp_sal,Kmm), sstfrz)
ztmp1(:,:) = sstfrz(:,:) + rt0
- IF( ssnd(jps_sstfrz)%laction ) CALL cpl_snd( jps_sstfrz, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info)
+ IF( ssnd(jps_sstfrz)%laction ) CALL cpl_snd( jps_sstfrz, isec, RESHAPE ( ztmp1, (/Ni_0,Nj_0,1/) ), info)
#endif
!
END SUBROUTINE sbc_cpl_snd
diff --git a/src/OCE/SBC/sbcdcy.F90 b/src/OCE/SBC/sbcdcy.F90
index 26c44de74c6a109bcb2c20449585985468ab6433..5ccd7ec71b85dc87adbc38976692badd07c73b6e 100644
--- a/src/OCE/SBC/sbcdcy.F90
+++ b/src/OCE/SBC/sbcdcy.F90
@@ -49,8 +49,8 @@ CONTAINS
!!----------------------------------------------------------------------
!! *** FUNCTION sbc_dcy_alloc ***
!!----------------------------------------------------------------------
- ALLOCATE( raa (jpi,jpj) , rbb (jpi,jpj) , rcc (jpi,jpj) , rab (jpi,jpj) , &
- & rtmd(jpi,jpj) , rdawn_dcy(jpi,jpj) , rdusk_dcy(jpi,jpj) , rscal(jpi,jpj) , STAT=sbc_dcy_alloc )
+ ALLOCATE( raa (A2D(0)) , rbb (A2D(0)) , rcc (A2D(0)) , rab (A2D(0)) , &
+ & rtmd(A2D(0)) , rdawn_dcy(A2D(0)) , rdusk_dcy(A2D(0)) , rscal(A2D(0)) , STAT=sbc_dcy_alloc )
!
CALL mpp_sum ( 'sbcdcy', sbc_dcy_alloc )
IF( sbc_dcy_alloc /= 0 ) CALL ctl_stop( 'STOP', 'sbc_dcy_alloc: failed to allocate arrays' )
@@ -71,12 +71,12 @@ CONTAINS
!! Impact of resolving the diurnal cycle in an ocean--atmosphere GCM.
!! Part 1: a diurnally forced OGCM. Climate Dynamics 29:6, 575-590.
!!----------------------------------------------------------------------
- LOGICAL , OPTIONAL , INTENT(in) :: l_mask ! use the routine for night mask computation
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqsrin ! input daily QSR flux
- REAL(wp), DIMENSION(jpi,jpj) :: zqsrout ! output QSR flux with diurnal cycle
+ LOGICAL , OPTIONAL , INTENT(in) :: l_mask ! use the routine for night mask computation
+ REAL(wp), DIMENSION(A2D(0)), INTENT(in) :: pqsrin ! input daily QSR flux
+ REAL(wp), DIMENSION(A2D(0)) :: zqsrout ! output QSR flux with diurnal cycle
!!
INTEGER :: ji, jj ! dummy loop indices
- INTEGER, DIMENSION(jpi,jpj) :: imask_night ! night mask
+ INTEGER, DIMENSION(A2D(0)) :: imask_night ! night mask
REAL(wp) :: zlo, zup, zlousd, zupusd
REAL(wp) :: ztmp, ztmp1, ztmp2
REAL(wp) :: ztmpm, ztmpm1, ztmpm2
@@ -100,16 +100,16 @@ CONTAINS
! Setting parameters for each new day:
CALL sbc_dcy_param()
- !CALL iom_put( "rdusk_dcy", rdusk_dcy(:,:)*tmask(:,:,1) ) !LB
- !CALL iom_put( "rdawn_dcy", rdawn_dcy(:,:)*tmask(:,:,1) ) !LB
- !CALL iom_put( "rscal_dcy", rscal(:,:)*tmask(:,:,1) ) !LB
+ !CALL iom_put( "rdusk_dcy", rdusk_dcy(:,:)*smask0(:,:) ) !LB
+ !CALL iom_put( "rdawn_dcy", rdawn_dcy(:,:)*smask0(:,:) ) !LB
+ !CALL iom_put( "rscal_dcy", rscal(:,:)*smask0(:,:) ) !LB
! 3. update qsr with the diurnal cycle
! ------------------------------------
imask_night(:,:) = 0
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
ztmpm = 0._wp
IF( ABS(rab(ji,jj)) < 1. ) THEN ! day duration is less than 24h
!
@@ -151,8 +151,8 @@ CONTAINS
ENDIF
END_2D
!
- IF( PRESENT(l_mask) .AND. l_mask ) THEN
- zqsrout(:,:) = float(imask_night(:,:))
+ IF( PRESENT(l_mask) ) THEN
+ IF ( l_mask ) zqsrout(:,:) = float(imask_night(:,:))
ENDIF
!
END FUNCTION sbc_dcy
@@ -161,7 +161,7 @@ CONTAINS
SUBROUTINE sbc_dcy_param( )
!!
INTEGER :: ji, jj ! dummy loop indices
- !INTEGER, DIMENSION(jpi,jpj) :: imask_night ! night mask
+ !INTEGER, DIMENSION(A2D(0)) :: imask_night ! night mask
REAL(wp) :: zdsws, zdecrad, ztx, zsin, zcos
REAL(wp) :: ztmp, ztest
!---------------------------statement functions------------------------
@@ -192,7 +192,7 @@ CONTAINS
! Compute A and B needed to compute the time integral of the diurnal cycle
zsin = SIN( zdecrad ) ; zcos = COS( zdecrad )
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
ztmp = rad * gphit(ji,jj)
raa(ji,jj) = SIN( ztmp ) * zsin
rbb(ji,jj) = COS( ztmp ) * zcos
@@ -201,7 +201,7 @@ CONTAINS
! rab to test if the day time is equal to 0, less than 24h of full day
rab(:,:) = -raa(:,:) / rbb(:,:)
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
IF( ABS(rab(ji,jj)) < 1._wp ) THEN ! day duration is less than 24h
! When is it night?
ztx = 1._wp/(2._wp*rpi) * (ACOS(rab(ji,jj)) - rcc(ji,jj))
@@ -225,7 +225,7 @@ CONTAINS
! S* = the inverse of the time integral of the diurnal cycle from dawn to dusk
! Avoid possible infinite scaling factor, associated with very short daylight
! periods, by ignoring periods less than 1/1000th of a day (ticket #1040)
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
IF( ABS(rab(ji,jj)) < 1._wp ) THEN ! day duration is less than 24h
rscal(ji,jj) = 0.0_wp
IF( rdawn_dcy(ji,jj) < rdusk_dcy(ji,jj) ) THEN ! day time in one part
diff --git a/src/OCE/SBC/sbcflx.F90 b/src/OCE/SBC/sbcflx.F90
index 7607f8e24a2e6fd59993d8765a4e53b1dd1c4fe8..ac04e77f80b855e33844d3290d84849615f703aa 100644
--- a/src/OCE/SBC/sbcflx.F90
+++ b/src/OCE/SBC/sbcflx.F90
@@ -114,8 +114,8 @@ CONTAINS
CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' ) ; RETURN
ENDIF
DO ji= 1, jpfld
- ALLOCATE( sf(ji)%fnow(jpi,jpj,1) )
- IF( slf_i(ji)%ln_tint ) ALLOCATE( sf(ji)%fdta(jpi,jpj,1,2) )
+ ALLOCATE( sf(ji)%fnow(A2D(0),1) )
+ IF( slf_i(ji)%ln_tint ) ALLOCATE( sf(ji)%fdta(A2D(0),1,2) )
END DO
! ! fill sf with slf_i and control print
CALL fld_fill( sf, slf_i, cn_dir, 'sbc_flx', 'flux formulation for ocean surface boundary condition', 'namsbc_flx' )
@@ -129,29 +129,27 @@ CONTAINS
IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! update ocean fluxes at each SBC frequency
IF( ln_dm2dc ) THEN ! modify now Qsr to include the diurnal cycle
- qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(:,:,1)
+ qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * smask0(:,:)
ELSE
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- qsr(ji,jj) = sf(jp_qsr)%fnow(ji,jj,1) * tmask(ji,jj,1)
- END_2D
+ qsr(:,:) = sf(jp_qsr)%fnow(:,:,1) * smask0(:,:)
ENDIF
#if defined key_top
IF( ln_trcdc2dm ) THEN ! diurnal cycle in TOP
IF( ln_dm2dc ) THEN
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- qsr_mean(ji,jj) = sf(jp_qsr)%fnow(ji,jj,1) * tmask(ji,jj,1)
+ DO_2D( 0, 0, 0, 0 ) ! set the ocean fluxes from read fields
+ qsr_mean(ji,jj) = sf(jp_qsr)%fnow(ji,jj,1) * smask0(ji,jj)
END_2D
ELSE
ncpl_qsr_freq = sf(jp_qsr)%freqh * 3600 ! qsr_mean will be computed in TOP
ENDIF
ENDIF
#endif
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! set the ocean fluxes from read fields
- utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) * tmask(ji,jj,1)
- vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) * tmask(ji,jj,1)
- qns (ji,jj) = ( sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) ) * tmask(ji,jj,1)
- emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) * tmask(ji,jj,1)
- !!sfx (ji,jj) = sf(jp_sfx )%fnow(ji,jj,1) * tmask(ji,jj,1)
+ DO_2D( 0, 0, 0, 0 ) ! set the ocean fluxes from read fields
+ utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) * smask0(ji,jj)
+ vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) * smask0(ji,jj)
+ qns (ji,jj) = ( sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) ) * smask0(ji,jj)
+ emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) * smask0(ji,jj)
+ !!sfx (ji,jj) = sf(jp_sfx )%fnow(ji,jj,1) * smask0(ji,jj)
END_2D
! ! add to qns the heat due to e-p
!!clem: I do not think it is needed
@@ -173,8 +171,8 @@ CONTAINS
!
! module of wind stress and wind speed at T-point
zcoef = 1. / ( zrhoa * zcdrag )
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- zmod = SQRT( utau(ji,jj) * utau(ji,jj) + vtau(ji,jj) * vtau(ji,jj) ) * tmask(ji,jj,1)
+ DO_2D( 0, 0, 0, 0 )
+ zmod = SQRT( utau(ji,jj) * utau(ji,jj) + vtau(ji,jj) * vtau(ji,jj) ) * smask0(ji,jj)
taum(ji,jj) = zmod
wndm(ji,jj) = SQRT( zmod * zcoef ) !!clem: not used?
END_2D
diff --git a/src/OCE/SBC/sbcfwb.F90 b/src/OCE/SBC/sbcfwb.F90
index 58a17f028f4a7cc404859b8c7c4a66f98cd04406..7f9126cac1a1151ab8e3030c1387eb4e155f0b9d 100644
--- a/src/OCE/SBC/sbcfwb.F90
+++ b/src/OCE/SBC/sbcfwb.F90
@@ -16,7 +16,7 @@ MODULE sbcfwb
USE oce ! ocean dynamics and tracers
USE dom_oce ! ocean space and time domain
USE sbc_oce ! surface ocean boundary condition
- USE isf_oce , ONLY : fwfisf_cav, fwfisf_par ! ice shelf melting contribution
+ USE isf_oce , ONLY : fwfisf_cav, fwfisf_par, ln_isfcpl, ln_isfcpl_cons, risfcpl_cons_ssh ! ice shelf melting contribution
USE sbc_ice , ONLY : snwice_mass, snwice_mass_b, snwice_fmass
USE phycst ! physical constants
USE sbcrnf ! ocean runoffs
@@ -40,6 +40,8 @@ MODULE sbcfwb
REAL(wp) :: a_fwb_ini ! initial domain averaged freshwater budget
REAL(wp) :: area ! global mean ocean surface (interior domain)
+ !! * Substitutions
+# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
!! $Id: sbcfwb.F90 15439 2021-10-22 17:53:09Z clem $
@@ -100,7 +102,7 @@ CONTAINS
IF( kn_fwb == 3 .AND. nn_sssr /= 2 ) CALL ctl_stop( 'sbc_fwb: nn_fwb = 3 requires nn_sssr = 2, we stop ' )
IF( kn_fwb == 3 .AND. ln_isfcav ) CALL ctl_stop( 'sbc_fwb: nn_fwb = 3 with ln_isfcav = .TRUE. not working, we stop ' )
!
- area = glob_sum( 'sbcfwb', e1e2t(:,:) * tmask(:,:,1)) ! interior global domain surface
+ area = glob_sum( 'sbcfwb', e1e2t(A2D(0)) * smask0(:,:) ) ! interior global domain surface
! isf cavities are excluded because it can feedback to the melting with generation of inhibition of plumes
! and in case of no melt, it can generate HSSW.
!
@@ -117,15 +119,15 @@ CONTAINS
CASE ( 1 ) !== global mean fwf set to zero ==!
!
IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN
- y_fwfnow(1) = local_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) - fwfisf_cav(:,:) - fwfisf_par(:,:) - snwice_fmass(:,:) ) )
+ y_fwfnow(1) = local_sum( e1e2t(A2D(0)) * ( emp(A2D(0)) - rnf(A2D(0)) - fwfisf_cav(A2D(0)) - fwfisf_par(A2D(0)) &
+ & - snwice_fmass(A2D(0)) ) )
CALL mpp_delay_sum( 'sbcfwb', 'fwb', y_fwfnow(:), z_fwfprv(:), kt == nitend - nn_fsbc + 1 )
- z_fwfprv(1) = z_fwfprv(1) / area
- zcoef = z_fwfprv(1) * rcp
- emp(:,:) = emp(:,:) - z_fwfprv(1) * tmask(:,:,1)
- qns(:,:) = qns(:,:) + zcoef * sst_m(:,:) * tmask(:,:,1) ! account for change to the heat budget due to fw correction
+ zcoef = z_fwfprv(1) / area
+ emp(A2D(0)) = emp(A2D(0)) - zcoef * smask0(:,:)
+ qns(:,:) = qns(:,:) + zcoef * rcp * sst_m(A2D(0)) * smask0(:,:) ! account for change to the heat budget due to fw correction
! outputs
- IF( iom_use('hflx_fwb_cea') ) CALL iom_put( 'hflx_fwb_cea', zcoef * sst_m(:,:) * tmask(:,:,1) )
- IF( iom_use('vflx_fwb_cea') ) CALL iom_put( 'vflx_fwb_cea', z_fwfprv(1) * tmask(:,:,1) )
+ IF( iom_use('hflx_fwb_cea') ) CALL iom_put( 'hflx_fwb_cea', zcoef * rcp * sst_m(A2D(0)) * smask0(:,:) )
+ IF( iom_use('vflx_fwb_cea') ) CALL iom_put( 'vflx_fwb_cea', zcoef * smask0(:,:) )
ENDIF
!
CASE ( 2 ) !== fw adjustment based on fw budget at the end of the previous year ==!
@@ -136,7 +138,7 @@ CONTAINS
& .AND. iom_varid( numror, 'a_fwb', ldstop = .FALSE. ) > 0 ) THEN
IF(lwp) WRITE(numout,*) 'sbc_fwb : reading freshwater-budget from restart file'
CALL iom_get( numror, 'a_fwb_b', a_fwb_b )
- CALL iom_get( numror, 'a_fwb' , a_fwb )
+ CALL iom_get( numror, 'a_fwb' , a_fwb )
!
a_fwb_ini = a_fwb_b
ELSE ! as specified in namelist
@@ -168,11 +170,11 @@ CONTAINS
!
IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN ! correct the freshwater fluxes using previous year budget minus initial state
zcoef = ( a_fwb - a_fwb_b )
- emp(:,:) = emp(:,:) + zcoef * tmask(:,:,1)
- qns(:,:) = qns(:,:) - zcoef * rcp * sst_m(:,:) * tmask(:,:,1) ! account for change to the heat budget due to fw correction
+ emp(A2D(0)) = emp(A2D(0)) + zcoef * smask0(:,:)
+ qns(:,:) = qns(:,:) - zcoef * rcp * sst_m(A2D(0)) * smask0(:,:) ! account for change to the heat budget due to fw correction
! outputs
- IF( iom_use('hflx_fwb_cea') ) CALL iom_put( 'hflx_fwb_cea', -zcoef * rcp * sst_m(:,:) * tmask(:,:,1) )
- IF( iom_use('vflx_fwb_cea') ) CALL iom_put( 'vflx_fwb_cea', -zcoef * tmask(:,:,1) )
+ IF( iom_use('hflx_fwb_cea') ) CALL iom_put( 'hflx_fwb_cea', -zcoef * rcp * sst_m(A2D(0)) * smask0(:,:) )
+ IF( iom_use('vflx_fwb_cea') ) CALL iom_put( 'vflx_fwb_cea', -zcoef * smask0(:,:) )
ENDIF
! Output restart information
IF( lrst_oce ) THEN
@@ -190,53 +192,51 @@ CONTAINS
!
CASE ( 3 ) !== global fwf set to zero and spread out over erp area ==!
!
- ALLOCATE( ztmsk_neg(jpi,jpj) , ztmsk_pos(jpi,jpj) , ztmsk_tospread(jpi,jpj) , z_wgt(jpi,jpj) , zerp_cor(jpi,jpj) )
+ ALLOCATE( ztmsk_neg(A2D(0)) , ztmsk_pos(A2D(0)) , ztmsk_tospread(A2D(0)) , z_wgt(A2D(0)) , zerp_cor(A2D(0)) )
!
IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN
- ztmsk_pos(:,:) = tmask_i(:,:) ! Select <0 and >0 area of erp
+ ztmsk_pos(:,:) = smask0_i(:,:) ! Select <0 and >0 area of erp
WHERE( erp < 0._wp ) ztmsk_pos = 0._wp
- ztmsk_neg(:,:) = tmask_i(:,:) - ztmsk_pos(:,:)
+ ztmsk_neg(:,:) = smask0_i(:,:) - ztmsk_pos(:,:)
! ! fwf global mean (excluding ocean to ice/snow exchanges)
- z_fwf = glob_sum( 'sbcfwb', e1e2t(:,:) * ( emp(:,:) - rnf(:,:) - fwfisf_cav(:,:) - fwfisf_par(:,:) - snwice_fmass(:,:) ) ) / area
+ z_fwf = glob_sum( 'sbcfwb', e1e2t(A2D(0)) * ( emp(A2D(0)) - rnf(A2D(0)) - fwfisf_cav(A2D(0)) - fwfisf_par(A2D(0)) &
+ & - snwice_fmass(A2D(0)) ) ) / area
!
IF( z_fwf < 0._wp ) THEN ! spread out over >0 erp area to increase evaporation
- zsurf_pos = glob_sum( 'sbcfwb', e1e2t(:,:)*ztmsk_pos(:,:) )
+ zsurf_pos = glob_sum( 'sbcfwb', e1e2t(A2D(0))*ztmsk_pos(:,:) )
zsurf_tospread = zsurf_pos
ztmsk_tospread(:,:) = ztmsk_pos(:,:)
ELSE ! spread out over <0 erp area to increase precipitation
- zsurf_neg = glob_sum( 'sbcfwb', e1e2t(:,:)*ztmsk_neg(:,:) ) ! Area filled by <0 and >0 erp
+ zsurf_neg = glob_sum( 'sbcfwb', e1e2t(A2D(0))*ztmsk_neg(:,:) ) ! Area filled by <0 and >0 erp
zsurf_tospread = zsurf_neg
ztmsk_tospread(:,:) = ztmsk_neg(:,:)
ENDIF
!
- zsum_fwf = glob_sum( 'sbcfwb', e1e2t(:,:) * z_fwf ) ! fwf global mean over <0 or >0 erp area
+ zsum_fwf = glob_sum( 'sbcfwb', e1e2t(A2D(0)) * z_fwf ) ! fwf global mean over <0 or >0 erp area
!!gm : zsum_fwf = z_fwf * area ??? it is right? I think so....
z_fwf_nsrf = zsum_fwf / ( zsurf_tospread + rsmall )
! ! weight to respect erp field 2D structure
- zsum_erp = glob_sum( 'sbcfwb', ztmsk_tospread(:,:) * erp(:,:) * e1e2t(:,:) )
+ zsum_erp = glob_sum( 'sbcfwb', ztmsk_tospread(:,:) * erp(:,:) * e1e2t(A2D(0)) )
z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( zsum_erp + rsmall )
! ! final correction term to apply
zerp_cor(:,:) = -1. * z_fwf_nsrf * zsurf_tospread * z_wgt(:,:)
!
-!!gm ===>>>> lbc_lnk should be useless as all the computation is done over the whole domain !
- CALL lbc_lnk( 'sbcfwb', zerp_cor, 'T', 1.0_wp )
- !
- emp(:,:) = emp(:,:) + zerp_cor(:,:)
- qns(:,:) = qns(:,:) - zerp_cor(:,:) * rcp * sst_m(:,:) ! account for change to the heat budget due to fw correction
- erp(:,:) = erp(:,:) + zerp_cor(:,:)
+ emp(A2D(0)) = emp(A2D(0)) + zerp_cor(:,:)
+ qns(:,:) = qns(:,:) - zerp_cor(:,:) * rcp * sst_m(A2D(0)) ! account for change to the heat budget due to fw correction
+ erp(:,:) = erp(:,:) + zerp_cor(:,:)
! outputs
- IF( iom_use('hflx_fwb_cea') ) CALL iom_put( 'hflx_fwb_cea', -zerp_cor(:,:) * rcp * sst_m(:,:) )
+ IF( iom_use('hflx_fwb_cea') ) CALL iom_put( 'hflx_fwb_cea', -zerp_cor(:,:) * rcp * sst_m(A2D(0)) )
IF( iom_use('vflx_fwb_cea') ) CALL iom_put( 'vflx_fwb_cea', -zerp_cor(:,:) )
!
IF( lwp ) THEN ! control print
IF( z_fwf < 0._wp ) THEN
WRITE(numout,*)' z_fwf < 0'
- WRITE(numout,*)' SUM(erp+) = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv'
+ WRITE(numout,*)' SUM(erp+) = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(A2D(0)) )*1.e-9,' Sv'
ELSE
WRITE(numout,*)' z_fwf >= 0'
- WRITE(numout,*)' SUM(erp-) = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv'
+ WRITE(numout,*)' SUM(erp-) = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(A2D(0)) )*1.e-9,' Sv'
ENDIF
- WRITE(numout,*)' SUM(empG) = ', SUM( z_fwf*e1e2t(:,:) )*1.e-9,' Sv'
+ WRITE(numout,*)' SUM(empG) = ', SUM( z_fwf*e1e2t(A2D(0)) )*1.e-9,' Sv'
WRITE(numout,*)' z_fwf = ', z_fwf ,' Kg/m2/s'
WRITE(numout,*)' z_fwf_nsrf = ', z_fwf_nsrf ,' Kg/m2/s'
WRITE(numout,*)' MIN(zerp_cor) = ', MINVAL(zerp_cor)
@@ -245,6 +245,31 @@ CONTAINS
ENDIF
DEALLOCATE( ztmsk_neg , ztmsk_pos , ztmsk_tospread , z_wgt , zerp_cor )
!
+ CASE ( 4 ) !== global mean fwf set to zero (ISOMIP case) ==!
+ !
+ IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN
+ ! ! fwf global mean (excluding ocean to ice/snow exchanges)
+ zcoef = glob_sum( 'sbcfwb', e1e2t(A2D(0)) * ( emp(A2D(0)) - rnf(A2D(0)) - fwfisf_cav(A2D(0)) - fwfisf_par(A2D(0)) &
+ & - snwice_fmass(A2D(0)) ) ) / area
+ ! clem: use y_fwfnow instead to improve performance?
+ !y_fwfnow(1) = local_sum( e1e2t(A2D(0)) * ( emp(A2D(0)) - rnf(A2D(0)) - fwfisf_cav(A2D(0)) - fwfisf_par(A2D(0)) &
+ ! & - snwice_fmass(A2D(0)) ) )
+ ! correction for ice sheet coupling testing (ie remove the excess through the surface)
+ ! test impact on the melt as conservation correction made in depth
+ ! test conservation level as sbcfwb is conserving
+ ! avoid the model to blow up for large ssh drop (isomip OCEAN3 with melt switch off and uniform T/S)
+ IF (ln_isfcpl .AND. ln_isfcpl_cons) THEN
+ zcoef = zcoef + glob_sum( 'sbcfwb', e1e2t(A2D(0)) * risfcpl_cons_ssh(A2D(0)) * rho0 ) / area
+ ! y_fwfnow(1) = y_fwfnow(1) + local_sum( e1e2t(A2D(0)) * risfcpl_cons_ssh(A2D(0)) * rho0 )
+ END IF
+ !CALL mpp_delay_sum( 'sbcfwb', 'fwb', y_fwfnow(:), z_fwfprv(:), kt == nitend - nn_fsbc + 1 )
+ !zcoef = z_fwfprv(1) / area
+ !
+ emp(A2D(0)) = emp(A2D(0)) - zcoef * smask0(:,:) ! (Eq. 34 AD2015)
+ qns(:,:) = qns(:,:) + zcoef * rcp * sst_m(A2D(0)) * smask0(:,:) ! (Eq. 35 AD2015) ! use sst_m to avoid generation of any bouyancy fluxes
+ sfx(:,:) = sfx(:,:) + zcoef * sss_m(A2D(0)) * smask0(:,:) ! (Eq. 36 AD2015) ! use sss_m to avoid generation of any bouyancy fluxes
+ ENDIF
+ !
CASE DEFAULT !== you should never be there ==!
CALL ctl_stop( 'sbc_fwb : wrong nn_fwb value for the FreshWater Budget correction, choose either 1, 2 or 3' )
!
diff --git a/src/OCE/SBC/sbcice_if.F90 b/src/OCE/SBC/sbcice_if.F90
index d5acb2918258945b4f211692d26a6fe6aab713ea..c406c7408c2a598b4241057d699e292b002ff454 100644
--- a/src/OCE/SBC/sbcice_if.F90
+++ b/src/OCE/SBC/sbcice_if.F90
@@ -85,8 +85,8 @@ CONTAINS
ALLOCATE( sf_ice(1), STAT=ierror )
IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ice_if: unable to allocate sf_ice structure' )
- ALLOCATE( sf_ice(1)%fnow(jpi,jpj,1) )
- IF( sn_ice%ln_tint ) ALLOCATE( sf_ice(1)%fdta(jpi,jpj,1,2) )
+ ALLOCATE( sf_ice(1)%fnow(A2D(0),1) )
+ IF( sn_ice%ln_tint ) ALLOCATE( sf_ice(1)%fdta(A2D(0),1,2) )
! fill sf_ice with sn_ice and control print
CALL fld_fill( sf_ice, (/ sn_ice /), cn_dir, 'sbc_ice_if', 'ice-if sea-ice model', 'namsbc_iif' )
@@ -108,8 +108,12 @@ CONTAINS
IF( ln_cpl ) a_i(:,:,1) = fr_i(:,:)
! Flux and ice fraction computation
- DO_2D( 1, 1, 1, 1 )
- !
+ DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ zt_fzp = fr_i(ji,jj) ! freezing point temperature
+ ts(ji,jj,1,jp_tem,Kmm) = MAX( ts(ji,jj,1,jp_tem,Kmm), zt_fzp ) ! avoid over-freezing point temperature
+ END_2D
+
+ DO_2D( 0, 0, 0, 0 )
zt_fzp = fr_i(ji,jj) ! freezing point temperature
zfr_obs = sf_ice(1)%fnow(ji,jj,1) ! observed ice cover
! ! ocean ice fraction (0/1) from the freezing point temperature
@@ -117,8 +121,6 @@ CONTAINS
ELSE ; fr_i(ji,jj) = 0.e0
ENDIF
- ts(ji,jj,1,jp_tem,Kmm) = MAX( ts(ji,jj,1,jp_tem,Kmm), zt_fzp ) ! avoid over-freezing point temperature
-
qsr(ji,jj) = ( 1. - zfr_obs ) * qsr(ji,jj) ! solar heat flux : zero below observed ice cover
! ! non solar heat flux : add a damping term
@@ -127,7 +129,7 @@ CONTAINS
zqri = ztrp * ( ts(ji,jj,1,jp_tem,Kbb) - ( zt_fzp - 1.) )
zqrj = ztrp * MIN( 0., ts(ji,jj,1,jp_tem,Kbb) - zt_fzp )
zqrp = ( zfr_obs * ( (1. - fr_i(ji,jj) ) * zqri &
- & + fr_i(ji,jj) * zqrj ) ) * tmask(ji,jj,1)
+ & + fr_i(ji,jj) * zqrj ) ) * smask0(ji,jj)
! ! non-solar heat flux
! # qns unchanged if no climatological ice (zfr_obs=0)
@@ -136,7 +138,7 @@ CONTAINS
! (-2=arctic, -4=antarctic)
zqi = -3. + SIGN( 1._wp, ff_f(ji,jj) )
qns(ji,jj) = ( ( 1.- zfr_obs ) * qns(ji,jj) &
- & + zfr_obs * fr_i(ji,jj) * zqi ) * tmask(ji,jj,1) &
+ & + zfr_obs * fr_i(ji,jj) * zqi ) * smask0(ji,jj) &
& + zqrp
END_2D
!
diff --git a/src/OCE/SBC/sbcmod.F90 b/src/OCE/SBC/sbcmod.F90
index 81f018a49b41a78742f19cd35af95216d31e43a4..78e2e3aeaaae7265949b30ced2b8bc29b0d0b2c9 100644
--- a/src/OCE/SBC/sbcmod.F90
+++ b/src/OCE/SBC/sbcmod.F90
@@ -51,6 +51,7 @@ MODULE sbcmod
USE sbcfwb ! surface boundary condition: freshwater budget
USE icbstp ! Icebergs
USE icb_oce , ONLY : ln_passive_mode ! iceberg interaction mode
+ USE isf_oce , ONLY : ln_isf, l_isfoasis, fwfisf_oasis
USE traqsr ! active tracers: light penetration
USE sbcwave ! Wave module
USE bdy_oce , ONLY: ln_bdy
@@ -374,7 +375,7 @@ CONTAINS
!!
!! ** Action : - set the ocean surface boundary condition at before and now
!! time step, i.e.
- !! utau_b, vtau_b, qns_b, qsr_b, emp_n, sfx_b, qrp_b, erp_b
+ !! utau_b, vtau_b, qns_b, qsr_b, emp_b, sfx_b
!! utau , vtau , qns , qsr , emp , sfx , qrp , erp
!! - updte the ice fraction : fr_i
!!----------------------------------------------------------------------
@@ -382,12 +383,10 @@ CONTAINS
INTEGER, INTENT(in) :: Kbb, Kmm ! ocean time level indices
INTEGER :: jj, ji ! dummy loop argument
!
- LOGICAL :: ll_sas, ll_opa ! local logical
+ LOGICAL :: ll_sas, ll_opa ! local logical
!
- REAL(wp) :: zthscl ! wd tanh scale
- REAL(wp), DIMENSION(jpi,jpj) :: zwdht, zwght ! wd dep over wd limit, wgt
- REAL(wp), DIMENSION(jpi,jpj) :: z2d ! temporary array used for iom_put
-
+ REAL(wp) :: zthscl ! wd tanh scale
+ REAL(wp) :: zwdht, zwght ! wd dep over wd limit, wgt
!!---------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('sbc')
@@ -409,6 +408,8 @@ CONTAINS
! ! ---------------------------------------- !
! ! forcing field computation !
! ! ---------------------------------------- !
+ ! most of the following routines update fields only in the interior
+ ! with the exception of sbcssm, sbcrnf and sbcwave modules
!
ll_sas = nn_components == jp_iam_sas ! component flags
ll_opa = nn_components == jp_iam_oce
@@ -417,7 +418,6 @@ CONTAINS
!
! !== sbc formulation ==!
!
- !
SELECT CASE( nsbc ) ! Compute ocean surface boundary condition
! ! (i.e. utau,vtau, qns, qsr, emp, sfx)
CASE( jp_usr ) ; CALL usrdef_sbc_oce( kt, Kbb ) ! user defined formulation
@@ -427,7 +427,7 @@ CONTAINS
!!!!!!!!!!! ATTENTION:ln_wave is not only used for oasis coupling !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
IF( ln_wave ) THEN
IF ( lk_oasis ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! OCE-wave coupling
- CALL sbc_wave ( kt, Kmm )
+ CALL sbc_wave ( kt, Kmm )
ENDIF
CALL sbc_blk ( kt ) ! bulk formulation for the ocean
!
@@ -444,7 +444,7 @@ CONTAINS
!
IF( ln_wave .AND. ln_tauoc ) THEN ! Wave stress reduction
!
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
utau(ji,jj) = utau(ji,jj) * tauoc_wave(ji,jj)
vtau(ji,jj) = vtau(ji,jj) * tauoc_wave(ji,jj)
taum(ji,jj) = taum(ji,jj) * tauoc_wave(ji,jj)
@@ -453,8 +453,8 @@ CONTAINS
IF( kt == nit000 ) CALL ctl_warn( 'sbc: You are subtracting the wave stress to the ocean.', &
& 'If not requested select ln_tauoc=.false.' )
!
- ELSEIF( ln_wave .AND. ln_taw ) THEN ! Wave stress reduction
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ ELSEIF( ln_wave .AND. ln_taw ) THEN ! Wave stress reduction
+ DO_2D( 0, 0, 0, 0 )
utau(ji,jj) = utau(ji,jj) - tawx(ji,jj) + twox(ji,jj)
vtau(ji,jj) = vtau(ji,jj) - tawy(ji,jj) + twoy(ji,jj)
taum(ji,jj) = SQRT( utau(ji,jj)*utau(ji,jj) + vtau(ji,jj)*vtau(ji,jj) )
@@ -465,10 +465,17 @@ CONTAINS
!
ENDIF
!
+ !clem: these calls are needed for sbccpl only => only for SAS I think?
+ IF( ll_sas .OR. ll_opa ) CALL lbc_lnk( 'sbcmod', sst_m, 'T', 1.0_wp, sss_m, 'T', 1.0_wp, ssh_m, 'T', 1.0_wp, &
+ & frq_m, 'T', 1.0_wp, e3t_m, 'T', 1.0_wp, fr_i , 'T', 1.0_wp )
+ !clem : these calls are needed for sbccpl => it needs an IF statement but it's complicated
+ IF( ln_isf .AND. l_isfoasis ) CALL lbc_lnk( 'sbcmod', fwfisf_oasis, 'T', 1.0_wp )
+ IF( ln_rnf .AND. l_rnfcpl ) CALL lbc_lnk( 'sbcmod', rnf, 'T', 1.0_wp, fwficb , 'T', 1.0_wp )
!
IF( ln_icebergs ) THEN ! save pure stresses (with no ice-ocean stress) for use by icebergs
! Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines
! and the use of MAX(tmask(i,j),tmask(i+1,j) is to mask tau over ice shelves
+ CALL lbc_lnk( 'sbcmod', utau, 'T', -1.0_wp, vtau, 'T', -1.0_wp )
DO_2D( 0, 0, 0, 0 )
utau_icb(ji,jj) = 0.5_wp * ( utau(ji,jj) + utau(ji+1,jj) ) * &
& ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1), tmask(ji+1,jj,1) )
@@ -480,26 +487,26 @@ CONTAINS
!
! !== Misc. Options ==!
!
- SELECT CASE( nn_ice ) ! Update heat and freshwater fluxes over sea-ice areas
- CASE( 1 ) ; CALL sbc_ice_if ( kt, Kbb, Kmm ) ! Ice-cover climatology ("Ice-if" model)
+ SELECT CASE( nn_ice ) ! Update heat and freshwater fluxes over sea-ice areas
+ CASE( 1 ) ; CALL sbc_ice_if ( kt, Kbb, Kmm ) ! Ice-cover climatology ("Ice-if" model)
#if defined key_si3
- CASE( 2 ) ; CALL ice_stp ( kt, Kbb, Kmm, nsbc ) ! SI3 ice model
+ CASE( 2 ) ; CALL ice_stp ( kt, Kbb, Kmm, nsbc ) ! SI3 ice model
#endif
- CASE( 3 ) ; CALL sbc_ice_cice ( kt, nsbc ) ! CICE ice model
+ CASE( 3 ) ; CALL sbc_ice_cice ( kt, nsbc ) ! CICE ice model
END SELECT
-
- IF( ln_icebergs ) CALL icb_stp( kt, Kmm ) ! compute icebergs
+ !==> clem: from here on, the following fields are ok on the halos: snwice_mass, snwice_mass_b, snwice_fmass
+ ! but not utau, vtau, emp (must be done later on)
+
+ IF( ln_icebergs ) CALL icb_stp( kt, Kmm ) ! compute icebergs
! Icebergs do not melt over the haloes.
! So emp values over the haloes are no more consistent with the inner domain values.
! A lbc_lnk is therefore needed to ensure reproducibility and restartability.
! see ticket #2113 for discussion about this lbc_lnk.
- ! The lbc_lnk is also needed for SI3 with nn_hls > 1 as emp is not yet defined for these points in iceupdate.F90
- IF( (ln_icebergs .AND. .NOT. ln_passive_mode) .OR. (nn_ice == 2 .AND. nn_hls == 2) ) THEN
- CALL lbc_lnk( 'sbcmod', emp, 'T', 1.0_wp )
- ENDIF
-
- IF( ln_rnf ) CALL sbc_rnf( kt ) ! add runoffs to fresh water fluxes
+!!$ IF( ln_icebergs .AND. .NOT. ln_passive_mode ) CALL lbc_lnk( 'sbcmod', emp, 'T', 1.0_wp )
+ !clem: not needed anymore since lbc is done afterwards
+
+ IF( ln_rnf ) CALL sbc_rnf( kt ) ! add runoffs to fresh water fluxes
IF( ln_ssr ) CALL sbc_ssr( kt ) ! add SST/SSS damping term
@@ -511,27 +518,36 @@ CONTAINS
IF( ll_wd ) THEN ! If near WAD point limit the flux for now
zthscl = atanh(rn_wd_sbcfra) ! taper frac default is .999
- zwdht(:,:) = ssh(:,:,Kmm) + ht_0(:,:) - rn_wdmin1 ! do this calc of water
- ! depth above wd limit once
- WHERE( zwdht(:,:) <= 0.0 )
- taum(:,:) = 0.0
- utau(:,:) = 0.0
- vtau(:,:) = 0.0
- qns (:,:) = 0.0
- qsr (:,:) = 0.0
- emp (:,:) = min(emp(:,:),0.0) !can allow puddles to grow but not shrink
- sfx (:,:) = 0.0
- END WHERE
- zwght(:,:) = tanh(zthscl*zwdht(:,:))
- WHERE( zwdht(:,:) > 0.0 .and. zwdht(:,:) < rn_wd_sbcdep ) ! 5 m hard limit here is arbitrary
- qsr (:,:) = qsr(:,:) * zwght(:,:)
- qns (:,:) = qns(:,:) * zwght(:,:)
- taum (:,:) = taum(:,:) * zwght(:,:)
- utau (:,:) = utau(:,:) * zwght(:,:)
- vtau (:,:) = vtau(:,:) * zwght(:,:)
- sfx (:,:) = sfx(:,:) * zwght(:,:)
- emp (:,:) = emp(:,:) * zwght(:,:)
- END WHERE
+ DO_2D( 0, 0, 0, 0 )
+ zwdht = ssh(ji,jj,Kmm) + ht_0(ji,jj) - rn_wdmin1 ! do this calc of water depth above wd limit once
+ zwght = TANH(zthscl*zwdht)
+ IF( zwdht <= 0.0 ) THEN
+ taum(ji,jj) = 0.0
+ utau(ji,jj) = 0.0
+ vtau(ji,jj) = 0.0
+ qns (ji,jj) = 0.0
+ qsr (ji,jj) = 0.0
+ emp (ji,jj) = MIN(emp(ji,jj),0.0) !can allow puddles to grow but not shrink
+ sfx (ji,jj) = 0.0
+ ELSEIF( zwdht > 0.0 .AND. zwdht < rn_wd_sbcdep ) THEN ! 5 m hard limit here is arbitrary
+ qsr (ji,jj) = qsr(ji,jj) * zwght
+ qns (ji,jj) = qns(ji,jj) * zwght
+ taum (ji,jj) = taum(ji,jj) * zwght
+ utau (ji,jj) = utau(ji,jj) * zwght
+ vtau (ji,jj) = vtau(ji,jj) * zwght
+ sfx (ji,jj) = sfx(ji,jj) * zwght
+ emp (ji,jj) = emp(ji,jj) * zwght
+ ENDIF
+ END_2D
+ ENDIF
+
+ ! clem: these should be the only fields that are needed over the entire domain
+ ! (in addition to snwice_mass)
+ IF( ln_rnf ) THEN
+ CALL lbc_lnk( 'sbcmod', utau, 'T', -1.0_wp, vtau , 'T', -1.0_wp, emp, 'T', 1.0_wp, &
+ & rnf , 'T', 1.0_wp, fwficb, 'T', 1.0_wp ) ! fwficb is used on the halos in pisces (only)
+ ELSE
+ CALL lbc_lnk( 'sbcmod', utau, 'T', -1.0_wp, vtau , 'T', -1.0_wp, emp, 'T', 1.0_wp )
ENDIF
! --- calculate utau and vtau on U,V-points --- !
! Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines
@@ -600,29 +616,14 @@ CONTAINS
! ! Outputs and control print !
! ! ---------------------------------------- !
IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN
- IF( iom_use("empmr") ) THEN
- DO_2D( 0, 0, 0, 0 )
- z2d(ji,jj) = emp(ji,jj) - rnf(ji,jj)
- END_2D
- CALL iom_put( "empmr" , z2d ) ! upward water flux
- ENDIF
- IF( iom_use("empbmr") ) THEN
- DO_2D( 0, 0, 0, 0 )
- z2d(ji,jj) = emp_b(ji,jj) - rnf(ji,jj)
- END_2D
- CALL iom_put( "empbmr" , z2d ) ! before upward water flux ( needed to recalculate the time evolution of ssh in offline )
- ENDIF
- CALL iom_put( "saltflx", sfx ) ! downward salt flux (includes virtual salt flux beneath ice in linear free surface case)
+ CALL iom_put( "empmr" , emp(A2D(0))-rnf(A2D(0)) ) ! upward water flux
+ CALL iom_put( "empbmr" , emp_b(A2D(0))-rnf(A2D(0)) ) ! before upward water flux (for ssh in offline )
+ CALL iom_put( "saltflx", sfx ) ! downward salt flux
CALL iom_put( "fmmflx" , fmmflx ) ! Freezing-melting water flux
- IF( iom_use("qt") ) THEN
- DO_2D( 0, 0, 0, 0 )
- z2d(ji,jj) = qns(ji,jj) + qsr(ji,jj)
- END_2D
- CALL iom_put( "qt" , z2d ) ! total heat flux
- ENDIF
+ CALL iom_put( "qt" , qns+qsr ) ! total heat flux
CALL iom_put( "qns" , qns ) ! solar heat flux
CALL iom_put( "qsr" , qsr ) ! solar heat flux
- IF( nn_ice > 0 .OR. ll_opa ) CALL iom_put( "ice_cover", fr_i ) ! ice fraction
+ IF( nn_ice > 0 .OR. ll_opa ) CALL iom_put( "ice_cover", fr_i(:,:) ) ! ice fraction
CALL iom_put( "taum" , taum ) ! wind stress module
CALL iom_put( "wspd" , wndm ) ! wind speed module over free ocean or leads in presence of sea-ice
CALL iom_put( "qrp" , qrp ) ! heat flux damping
@@ -632,12 +633,12 @@ CONTAINS
IF(sn_cfctl%l_prtctl) THEN ! print mean trends (used for debugging)
CALL prt_ctl(tab2d_1=fr_i , clinfo1=' fr_i - : ', mask1=tmask )
CALL prt_ctl(tab2d_1=(emp-rnf) , clinfo1=' emp-rnf - : ', mask1=tmask )
- CALL prt_ctl(tab2d_1=(sfx-rnf) , clinfo1=' sfx-rnf - : ', mask1=tmask )
+ CALL prt_ctl(tab2d_1=(sfx-rnf(A2D(0))) , clinfo1=' sfx-rnf - : ', mask1=tmask )
CALL prt_ctl(tab2d_1=qns , clinfo1=' qns - : ', mask1=tmask )
CALL prt_ctl(tab2d_1=qsr , clinfo1=' qsr - : ', mask1=tmask )
CALL prt_ctl(tab3d_1=tmask , clinfo1=' tmask - : ', mask1=tmask, kdim=jpk )
- CALL prt_ctl(tab3d_1=ts(:,:,:,jp_tem,Kmm), clinfo1=' sst - : ', mask1=tmask, kdim=1 )
- CALL prt_ctl(tab3d_1=ts(:,:,:,jp_sal,Kmm), clinfo1=' sss - : ', mask1=tmask, kdim=1 )
+ CALL prt_ctl(tab2d_1=sst_m , clinfo1=' sst - : ', mask1=tmask )
+ CALL prt_ctl(tab2d_1=sss_m , clinfo1=' sss - : ', mask1=tmask )
CALL prt_ctl(tab2d_1=utau , clinfo1=' utau - : ', mask1=tmask, &
& tab2d_2=vtau , clinfo2=' vtau - : ', mask2=tmask )
ENDIF
diff --git a/src/OCE/SBC/sbcrnf.F90 b/src/OCE/SBC/sbcrnf.F90
index 758d4f4ba0c3038309ca5c2a251381b8e3ff438a..367e3c7cf4f7a077be154f874d2145f3b69c3c64 100644
--- a/src/OCE/SBC/sbcrnf.F90
+++ b/src/OCE/SBC/sbcrnf.F90
@@ -83,9 +83,9 @@ CONTAINS
!!----------------------------------------------------------------------
!! *** ROUTINE sbc_rnf_alloc ***
!!----------------------------------------------------------------------
- ALLOCATE( rnfmsk(jpi,jpj) , rnfmsk_z(jpk) , &
- & h_rnf (jpi,jpj) , nk_rnf (jpi,jpj) , &
- & rnf_tsc_b(jpi,jpj,jpts) , rnf_tsc (jpi,jpj,jpts) , STAT=sbc_rnf_alloc )
+ ALLOCATE( rnfmsk(jpi,jpj) , rnfmsk_z(jpk) , &
+ & h_rnf (jpi,jpj) , nk_rnf (jpi,jpj) , &
+ & rnf_tsc_b(A2D(0),jpts) , rnf_tsc (A2D(0),jpts) , STAT=sbc_rnf_alloc )
!
CALL mpp_sum ( 'sbcrnf', sbc_rnf_alloc )
IF( sbc_rnf_alloc > 0 ) CALL ctl_warn('sbc_rnf_alloc: allocation of arrays failed')
@@ -109,8 +109,6 @@ CONTAINS
INTEGER :: ji, jj ! dummy loop indices
INTEGER :: z_err = 0 ! dummy integer for error handling
!!----------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: ztfrz ! freezing point used for temperature correction
- !
!
! !-------------------!
! ! Update runoff !
@@ -118,8 +116,8 @@ CONTAINS
!
!
IF( .NOT. l_rnfcpl ) THEN
- CALL fld_read ( kt, nn_fsbc, sf_rnf ) ! Read Runoffs data and provide it at kt ( runoffs + iceberg )
- IF( ln_rnf_icb ) CALL fld_read ( kt, nn_fsbc, sf_i_rnf ) ! idem for iceberg flux if required
+ CALL fld_read ( kt, nn_fsbc, sf_rnf ) ! Read Runoffs data and provide it at kt ( runoffs + iceberg )
+ IF( ln_rnf_icb ) CALL fld_read ( kt, nn_fsbc, sf_i_rnf ) ! idem for iceberg flux if required
ENDIF
IF( ln_rnf_tem ) CALL fld_read ( kt, nn_fsbc, sf_t_rnf ) ! idem for runoffs temperature if required
IF( ln_rnf_sal ) CALL fld_read ( kt, nn_fsbc, sf_s_rnf ) ! idem for runoffs salinity if required
@@ -127,33 +125,32 @@ CONTAINS
IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN
!
IF( .NOT. l_rnfcpl ) THEN
- rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) ) * tmask(:,:,1) ! updated runoff value at time step kt
+ rnf(A2D(0)) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) ) * smask0(:,:) ! updated runoff value at time step kt
IF( ln_rnf_icb ) THEN
- fwficb(:,:) = rn_rfact * ( sf_i_rnf(1)%fnow(:,:,1) ) * tmask(:,:,1) ! updated runoff value at time step kt
- rnf(:,:) = rnf(:,:) + fwficb(:,:)
- qns(:,:) = qns(:,:) - fwficb(:,:) * rLfus
+ fwficb(A2D(0)) = rn_rfact * ( sf_i_rnf(1)%fnow(:,:,1) ) * smask0(:,:) ! updated runoff value at time step kt
+ rnf(A2D(0)) = rnf(A2D(0)) + fwficb(A2D(0))
+ qns(:,:) = qns(:,:) - fwficb(A2D(0)) * rLfus
!!qns_tot(:,:) = qns_tot(:,:) - fwficb(:,:) * rLfus
!!qns_oce(:,:) = qns_oce(:,:) - fwficb(:,:) * rLfus
- CALL iom_put( 'iceberg_cea' , fwficb(:,:) ) ! output iceberg flux
- CALL iom_put( 'hflx_icb_cea' , -fwficb(:,:) * rLfus ) ! output Heat Flux into Sea Water due to Iceberg Thermodynamics -->
+ CALL iom_put( 'iceberg_cea' , fwficb(A2D(0)) ) ! output iceberg flux
+ CALL iom_put( 'hflx_icb_cea' , -fwficb(A2D(0)) * rLfus ) ! output Heat Flux into Sea Water due to Iceberg Thermodynamics -->
ENDIF
ENDIF
!
! ! set temperature & salinity content of runoffs
IF( ln_rnf_tem ) THEN ! use runoffs temperature data
- rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rho0
- CALL eos_fzp( sss_m(:,:), ztfrz(:,:) )
+ rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(A2D(0)) * r1_rho0
WHERE( sf_t_rnf(1)%fnow(:,:,1) == -999._wp ) ! if missing data value use SST as runoffs temperature
- rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rho0
+ rnf_tsc(:,:,jp_tem) = sst_m(A2D(0)) * rnf(A2D(0)) * r1_rho0
END WHERE
ELSE ! use SST as runoffs temperature
!CEOD River is fresh water so must at least be 0 unless we consider ice
- rnf_tsc(:,:,jp_tem) = MAX( sst_m(:,:), 0.0_wp ) * rnf(:,:) * r1_rho0
+ rnf_tsc(:,:,jp_tem) = MAX( sst_m(A2D(0)), 0.0_wp ) * rnf(A2D(0)) * r1_rho0
ENDIF
! ! use runoffs salinity data
- IF( ln_rnf_sal ) rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rho0
+ IF( ln_rnf_sal ) rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(A2D(0)) * r1_rho0
! ! else use S=0 for runoffs (done one for all in the init)
- CALL iom_put( 'runoffs' , rnf(:,:) ) ! output runoff mass flux
+ CALL iom_put( 'runoffs' , rnf(A2D(0)) ) ! output runoff mass flux
IF( iom_use('hflx_rnf_cea') ) CALL iom_put( 'hflx_rnf_cea', rnf_tsc(:,:,jp_tem) * rho0 * rcp ) ! output runoff sensible heat (W/m2)
IF( iom_use('sflx_rnf_cea') ) CALL iom_put( 'sflx_rnf_cea', rnf_tsc(:,:,jp_sal) * rho0 ) ! output runoff salt flux (g/m2/s)
ENDIF
@@ -168,13 +165,15 @@ CONTAINS
CALL iom_get( numror, jpdom_auto, 'rnf_sc_b', rnf_tsc_b(:,:,jp_sal) ) ! before salinity content of runoff
ELSE !* no restart: set from nit000 values
IF(lwp) WRITE(numout,*) ' nit000-1 runoff forcing fields set to nit000'
- rnf_b (:,: ) = rnf (:,: )
- rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:)
+ CALL lbc_lnk( 'sbcrnf', rnf, 'T', 1.0_wp )
+ rnf_b (:,:) = rnf (:,:)
+ rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:)
ENDIF
ENDIF
! ! ---------------------------------------- !
IF( lrst_oce ) THEN ! Write in the ocean restart file !
! ! ---------------------------------------- !
+ !
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) 'sbcrnf : runoff forcing fields written in ocean restart file ', &
& 'at it= ', kt,' date= ', ndastp
@@ -323,8 +322,8 @@ CONTAINS
IF( ierror > 0 ) THEN
CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_rnf structure' ) ; RETURN
ENDIF
- ALLOCATE( sf_rnf(1)%fnow(jpi,jpj,1) )
- IF( sn_rnf%ln_tint ) ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,1,2) )
+ ALLOCATE( sf_rnf(1)%fnow(A2D(0),1) )
+ IF( sn_rnf%ln_tint ) ALLOCATE( sf_rnf(1)%fdta(A2D(0),1,2) )
CALL fld_fill( sf_rnf, (/ sn_rnf /), cn_dir, 'sbc_rnf_init', 'read runoffs data', 'namsbc_rnf', no_print )
!
IF( ln_rnf_icb ) THEN ! Create (if required) sf_i_rnf structure
@@ -334,11 +333,13 @@ CONTAINS
IF( ierror > 0 ) THEN
CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_i_rnf structure' ) ; RETURN
ENDIF
- ALLOCATE( sf_i_rnf(1)%fnow(jpi,jpj,1) )
- IF( sn_i_rnf%ln_tint ) ALLOCATE( sf_i_rnf(1)%fdta(jpi,jpj,1,2) )
+ ALLOCATE( sf_i_rnf(1)%fnow(A2D(0),1) )
+ IF( sn_i_rnf%ln_tint ) ALLOCATE( sf_i_rnf(1)%fdta(A2D(0),1,2) )
CALL fld_fill (sf_i_rnf, (/ sn_i_rnf /), cn_dir, 'sbc_rnf_init', 'read iceberg flux data', 'namsbc_rnf' )
ELSE
- fwficb(:,:) = 0._wp
+ DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ fwficb(ji,jj) = 0._wp
+ END_2D
ENDIF
ENDIF
@@ -350,8 +351,8 @@ CONTAINS
IF( ierror > 0 ) THEN
CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_t_rnf structure' ) ; RETURN
ENDIF
- ALLOCATE( sf_t_rnf(1)%fnow(jpi,jpj,1) )
- IF( sn_t_rnf%ln_tint ) ALLOCATE( sf_t_rnf(1)%fdta(jpi,jpj,1,2) )
+ ALLOCATE( sf_t_rnf(1)%fnow(A2D(0),1) )
+ IF( sn_t_rnf%ln_tint ) ALLOCATE( sf_t_rnf(1)%fdta(A2D(0),1,2) )
CALL fld_fill (sf_t_rnf, (/ sn_t_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff temperature data', 'namsbc_rnf', no_print )
ENDIF
!
@@ -362,8 +363,8 @@ CONTAINS
IF( ierror > 0 ) THEN
CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_s_rnf structure' ) ; RETURN
ENDIF
- ALLOCATE( sf_s_rnf(1)%fnow(jpi,jpj,1) )
- IF( sn_s_rnf%ln_tint ) ALLOCATE( sf_s_rnf(1)%fdta(jpi,jpj,1,2) )
+ ALLOCATE( sf_s_rnf(1)%fnow(A2D(0),1) )
+ IF( sn_s_rnf%ln_tint ) ALLOCATE( sf_s_rnf(1)%fdta(A2D(0),1,2) )
CALL fld_fill (sf_s_rnf, (/ sn_s_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff salinity data', 'namsbc_rnf', no_print )
ENDIF
!
@@ -378,8 +379,7 @@ CONTAINS
CALL iom_get ( inum, jpdom_global, sn_dep_rnf%clvar, h_rnf, kfill = jpfillcopy ) ! read the river mouth. no 0 on halos!
CALL iom_close( inum ) ! close file
!
- nk_rnf(:,:) = 0 ! set the number of level over which river runoffs are applied
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! set the number of level over which river runoffs are applied
IF( h_rnf(ji,jj) > 0._wp ) THEN
jk = 2
DO WHILE ( jk < mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ; jk = jk + 1
@@ -392,7 +392,8 @@ CONTAINS
WRITE(999,*) 'ji, jj, h_rnf(ji,jj) :', ji, jj, h_rnf(ji,jj)
ENDIF
END_2D
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! set the associated depth
+ !
+ DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! set the associated depth
h_rnf(ji,jj) = 0._wp
DO jk = 1, nk_rnf(ji,jj)
h_rnf(ji,jj) = h_rnf(ji,jj) + e3t(ji,jj,jk,Kmm)
@@ -407,7 +408,7 @@ CONTAINS
IF(lwp) WRITE(numout,*) ' depth over which runoffs is spread rn_dep_max = ', rn_dep_max
IF(lwp) WRITE(numout,*) ' create (=1) a runoff depth file or not (=0) nn_rnf_depth_file = ', nn_rnf_depth_file
- CALL iom_open( TRIM( sn_rnf%clname ), inum ) ! open runoff file
+ CALL iom_open( TRIM( sn_rnf%clname ), inum ) ! open runoff file
nbrec = iom_getszuld( inum )
zrnfcl(:,:,1) = 0._wp ! init the max to 0. in 1
DO jm = 1, nbrec
@@ -416,21 +417,20 @@ CONTAINS
END DO
CALL iom_close( inum )
!
- h_rnf(:,:) = 1.
- !
- zacoef = rn_dep_max / rn_rnf_max ! coef of linear relation between runoff and its depth (150m for max of runoff)
+ zacoef = rn_dep_max / rn_rnf_max ! coef of linear relation between runoff and its depth (150m for max of runoff)
!
- WHERE( zrnfcl(:,:,1) > 0._wp ) h_rnf(:,:) = zacoef * zrnfcl(:,:,1) ! compute depth for all runoffs
+ WHERE( zrnfcl(:,:,1) > 0._wp ) ; h_rnf(:,:) = zacoef * zrnfcl(:,:,1) ! compute depth for all runoffs
+ ELSEWHERE ; h_rnf(:,:) = 1._wp
+ ENDWHERE
!
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! take in account min depth of ocean rn_hmin
+ DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! take in account min depth of ocean rn_hmin
IF( zrnfcl(ji,jj,1) > 0._wp ) THEN
jk = mbkt(ji,jj)
h_rnf(ji,jj) = MIN( h_rnf(ji,jj), gdept_0(ji,jj,jk ) )
ENDIF
END_2D
!
- nk_rnf(:,:) = 0 ! number of levels on which runoffs are distributed
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! number of levels on which runoffs are distributed
IF( zrnfcl(ji,jj,1) > 0._wp ) THEN
jk = 2
DO WHILE ( jk < mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ; jk = jk + 1
@@ -441,27 +441,33 @@ CONTAINS
ENDIF
END_2D
!
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! set the associated depth
+ DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! set the associated depth
h_rnf(ji,jj) = 0._wp
DO jk = 1, nk_rnf(ji,jj)
h_rnf(ji,jj) = h_rnf(ji,jj) + e3t(ji,jj,jk,Kmm)
END DO
END_2D
!
- IF( nn_rnf_depth_file == 1 ) THEN ! save output nb levels for runoff
+ IF( nn_rnf_depth_file == 1 ) THEN ! save output nb levels for runoff
IF(lwp) WRITE(numout,*) ' ==>>> create runoff depht file'
CALL iom_open ( TRIM( sn_dep_rnf%clname ), inum, ldwrt = .TRUE. )
CALL iom_rstput( 0, 0, inum, 'rodepth', h_rnf )
CALL iom_close ( inum )
ENDIF
- ELSE ! runoffs applied at the surface
- nk_rnf(:,:) = 1
- h_rnf (:,:) = e3t(:,:,1,Kmm)
+ ELSE ! runoffs applied at the surface
+ DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ nk_rnf(ji,jj) = 1
+ h_rnf (ji,jj) = e3t(ji,jj,1,Kmm)
+ END_2D
ENDIF
!
- rnf(:,:) = 0._wp ! runoff initialisation
- rnf_tsc(:,:,:) = 0._wp ! runoffs temperature & salinty contents initilisation
- !
+ DO_2D( 0, 0, 0, 0 )
+ rnf(ji,jj) = 0._wp ! runoff initialisation
+ END_2D
+ DO_3D( 0, 0, 0, 0, 1, jpts )
+ rnf_tsc(ji,jj,jk) = 0._wp ! runoffs temperature & salinty contents initilisation
+ END_3D
+ !
! ! ========================
! ! River mouth vicinity
! ! ========================
@@ -493,11 +499,13 @@ CONTAINS
ELSE ! No treatment at river mouths
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' ==>>> No specific treatment at river mouths'
- rnfmsk (:,:) = 0._wp
+ DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ rnfmsk(ji,jj) = 0._wp
+ END_2D
rnfmsk_z(:) = 0._wp
nkrnf = 0
ENDIF
- !
+ !
END SUBROUTINE sbc_rnf_init
diff --git a/src/OCE/SBC/sbcssr.F90 b/src/OCE/SBC/sbcssr.F90
index 09088c45c0e777ab2ef5e70f86db178cfa2a2470..2b607dbb95b6257935b108d45edcc1733e6b06b3 100644
--- a/src/OCE/SBC/sbcssr.F90
+++ b/src/OCE/SBC/sbcssr.F90
@@ -97,8 +97,8 @@ CONTAINS
erp(:,:) = 0._wp
!
IF( nn_sstr == 1 ) THEN !* Temperature restoring term
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) * tmask(ji,jj,1)
+ DO_2D( 0, 0, 0, 0 )
+ zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) * smask0(ji,jj)
qns(ji,jj) = qns(ji,jj) + zqrp
qrp(ji,jj) = zqrp
END_2D
@@ -107,7 +107,7 @@ CONTAINS
IF( nn_sssr /= 0 .AND. nn_sssr_ice /= 1 ) THEN
! use fraction of ice ( fr_i ) to adjust relaxation under ice if nn_sssr_ice .ne. 1
! n.b. coefice is initialised and fixed to 1._wp if nn_sssr_ice = 1
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
SELECT CASE ( nn_sssr_ice )
CASE ( 0 ) ; coefice(ji,jj) = 1._wp - fr_i(ji,jj) ! no/reduced damping under ice
CASE DEFAULT ; coefice(ji,jj) = 1._wp + ( nn_sssr_ice - 1 ) * fr_i(ji,jj) ! reinforced damping (x nn_sssr_ice) under ice )
@@ -117,10 +117,10 @@ CONTAINS
!
IF( nn_sssr == 1 ) THEN !* Salinity damping term (salt flux only (sfx))
zsrp = rn_deds / rday ! from [mm/day] to [kg/m2/s]
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) ) & ! No damping in vicinity of river mouths
& * coefice(ji,jj) & ! Optional control of damping under sea-ice
- & * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) * tmask(ji,jj,1)
+ & * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) * smask0(ji,jj)
sfx(ji,jj) = sfx(ji,jj) + zerp ! salt flux
erp(ji,jj) = zerp / MAX( sss_m(ji,jj), 1.e-20 ) ! converted into an equivalent volume flux (diagnostic only)
END_2D
@@ -128,21 +128,21 @@ CONTAINS
ELSEIF( nn_sssr == 2 ) THEN !* Salinity damping term (volume flux (emp) and associated heat flux (qns)
zsrp = rn_deds / rday ! from [mm/day] to [kg/m2/s]
zerp_bnd = rn_sssr_bnd / rday ! - -
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) ) & ! No damping in vicinity of river mouths
& * coefice(ji,jj) & ! Optional control of damping under sea-ice
& * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) &
- & / MAX( sss_m(ji,jj), 1.e-20 ) * tmask(ji,jj,1)
+ & / MAX( sss_m(ji,jj), 1.e-20 ) * smask0(ji,jj)
IF( ln_sssr_bnd ) zerp = SIGN( 1.0_wp, zerp ) * MIN( zerp_bnd, ABS(zerp) )
- emp(ji,jj) = emp (ji,jj) + zerp
- qns(ji,jj) = qns(ji,jj) - zerp * rcp * sst_m(ji,jj)
erp(ji,jj) = zerp
- qrp(ji,jj) = qrp(ji,jj) - zerp * rcp * sst_m(ji,jj)
+ emp(ji,jj) = emp(ji,jj) + erp(ji,jj)
+ qns(ji,jj) = qns(ji,jj) - erp(ji,jj) * rcp * sst_m(ji,jj)
+ qrp(ji,jj) = qrp(ji,jj) - erp(ji,jj) * rcp * sst_m(ji,jj)
END_2D
ENDIF
! outputs
CALL iom_put( 'hflx_ssr_cea', qrp(:,:) )
- IF( nn_sssr == 1 ) CALL iom_put( 'sflx_ssr_cea', erp(:,:) * sss_m(:,:) )
+ IF( nn_sssr == 1 ) CALL iom_put( 'sflx_ssr_cea', erp(:,:) * sss_m(A2D(0)) )
IF( nn_sssr == 2 ) CALL iom_put( 'vflx_ssr_cea', -erp(:,:) )
!
ENDIF
@@ -207,12 +207,12 @@ CONTAINS
!
ALLOCATE( sf_sst(1), STAT=ierror )
IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst structure' )
- ALLOCATE( sf_sst(1)%fnow(jpi,jpj,1), STAT=ierror )
+ ALLOCATE( sf_sst(1)%fnow(A2D(0),1), STAT=ierror )
IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst now array' )
!
! fill sf_sst with sn_sst and control print
CALL fld_fill( sf_sst, (/ sn_sst /), cn_dir, 'sbc_ssr', 'SST restoring term toward SST data', 'namsbc_ssr', no_print )
- IF( sf_sst(1)%ln_tint ) ALLOCATE( sf_sst(1)%fdta(jpi,jpj,1,2), STAT=ierror )
+ IF( sf_sst(1)%ln_tint ) ALLOCATE( sf_sst(1)%fdta(A2D(0),1,2), STAT=ierror )
IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst data array' )
!
ENDIF
@@ -221,12 +221,12 @@ CONTAINS
!
ALLOCATE( sf_sss(1), STAT=ierror )
IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss structure' )
- ALLOCATE( sf_sss(1)%fnow(jpi,jpj,1), STAT=ierror )
+ ALLOCATE( sf_sss(1)%fnow(A2D(0),1), STAT=ierror )
IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss now array' )
!
! fill sf_sss with sn_sss and control print
CALL fld_fill( sf_sss, (/ sn_sss /), cn_dir, 'sbc_ssr', 'SSS restoring term toward SSS data', 'namsbc_ssr', no_print )
- IF( sf_sss(1)%ln_tint ) ALLOCATE( sf_sss(1)%fdta(jpi,jpj,1,2), STAT=ierror )
+ IF( sf_sss(1)%ln_tint ) ALLOCATE( sf_sss(1)%fdta(A2D(0),1,2), STAT=ierror )
IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss data array' )
!
ENDIF
@@ -244,7 +244,7 @@ CONTAINS
!!----------------------------------------------------------------------
sbc_ssr_alloc = 0 ! set to zero if no array to be allocated
IF( .NOT. ALLOCATED( erp ) ) THEN
- ALLOCATE( qrp(jpi,jpj), erp(jpi,jpj), coefice(jpi,jpj), STAT= sbc_ssr_alloc )
+ ALLOCATE( qrp(A2D(0)), erp(A2D(0)), coefice(A2D(0)), STAT= sbc_ssr_alloc )
!
IF( lk_mpp ) CALL mpp_sum ( 'sbcssr', sbc_ssr_alloc )
IF( sbc_ssr_alloc /= 0 ) CALL ctl_warn('sbc_ssr_alloc: failed to allocate arrays.')
diff --git a/src/OCE/SBC/sbcwave.F90 b/src/OCE/SBC/sbcwave.F90
index 2264938d72a9f274537fd9378d55ba6e458c38c4..cb0b219ef973ccb16666824974e2887977e6908f 100644
--- a/src/OCE/SBC/sbcwave.F90
+++ b/src/OCE/SBC/sbcwave.F90
@@ -115,14 +115,13 @@ CONTAINS
INTEGER :: jj, ji, jk ! dummy loop argument
INTEGER :: ik ! local integer
REAL(wp) :: ztransp, zfac, ztemp, zsp0, zsqrt, zbreiv16_w
- REAL(wp) :: zdep_u, zdep_v, zkh_u, zkh_v, zda_u, zda_v, sdtrp
+ REAL(wp) :: zdep_u, zdep_v, zkh_u, zkh_v, zda_u, zda_v, sdtrp, zInt_w0, zInt_w1
REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: zk_t, zk_u, zk_v, zu0_sd, zv0_sd ! 2D workspace
- REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ze3divh, zInt_w ! 3D workspace
+ REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ze3divh ! 3D workspace
!!---------------------------------------------------------------------
!
ALLOCATE( ze3divh(jpi,jpj,jpkm1) ) ! jpkm1 -> avoid lbc_lnk on jpk that is not defined
- ALLOCATE( zInt_w(jpi,jpj,jpk) )
- ALLOCATE( zk_t(jpi,jpj), zk_u(jpi,jpj), zk_v(jpi,jpj), zu0_sd(jpi,jpj), zv0_sd(jpi,jpj) )
+ ALLOCATE( zk_t(A2D(1)), zk_u(A2D(0)), zk_v(A2D(0)), zu0_sd(A2D(1)), zv0_sd(A2D(1)) )
zk_t (:,:) = 0._wp
zk_u (:,:) = 0._wp
zk_v (:,:) = 0._wp
@@ -138,7 +137,7 @@ CONTAINS
! sdtrp is the norm of Stokes transport
!
zfac = 0.166666666667_wp
- DO_2D( 1, 1, 1, 1 ) ! In the deep-water limit we have ke = ||ust0||/( 6 * ||transport|| )
+ DO_2D( 0, 1, 0, 1 ) ! In the deep-water limit we have ke = ||ust0||/( 6 * ||transport|| )
zsp0 = SQRT( ut0sd(ji,jj)*ut0sd(ji,jj) + vt0sd(ji,jj)*vt0sd(ji,jj) ) !<-- norm of Surface Stokes drift
tsd2d(ji,jj) = zsp0
IF( cpl_tusd .AND. cpl_tvsd ) THEN !stokes transport is provided in coupled mode
@@ -150,35 +149,40 @@ CONTAINS
ENDIF
zk_t (ji,jj) = zfac * zsp0 / MAX ( sdtrp, 0.0000001_wp ) !<-- ke = ||ust0||/( 6 * ||transport|| )
END_2D
- !# define zInt_w ze3divh
- DO_3D( 1, 1, 1, 1, 1, jpk ) ! Compute the primitive of Breivik 2016 function at W-points
- zfac = - 2._wp * zk_t (ji,jj) * gdepw(ji,jj,jk,Kmm) !<-- zfac should be negative definite
- ztemp = EXP ( zfac )
- zsqrt = SQRT( -zfac )
- zbreiv16_w = ztemp - SQRT(rpi)*zsqrt*ERFC(zsqrt) !Eq. 16 Breivik 2016
- zInt_w(ji,jj,jk) = ztemp - 4._wp * zk_t (ji,jj) * gdepw(ji,jj,jk,Kmm) * zbreiv16_w
- END_3D
-!
+ !
DO jk = 1, jpkm1
zfac = 0.166666666667_wp
- DO_2D( 1, 1, 1, 1 ) !++ Compute the FV Breivik 2016 function at T-points
+ DO_2D( 0, 1, 0, 1 ) !++ Compute the FV Breivik 2016 function at T-points
+ ! zInt at jk
+ zfac = - 2._wp * zk_t (ji,jj) * gdepw(ji,jj,jk,Kmm) !<-- zfac should be negative definite
+ ztemp = EXP ( zfac )
+ zsqrt = SQRT( -zfac )
+ zbreiv16_w = ztemp - SQRT(rpi)*zsqrt*ERFC(zsqrt) !Eq. 16 Breivik 2016
+ zInt_w0 = ztemp - 4._wp * zk_t (ji,jj) * gdepw(ji,jj,jk,Kmm) * zbreiv16_w
+ ! zInt at jk+1
+ zfac = - 2._wp * zk_t (ji,jj) * gdepw(ji,jj,jk+1,Kmm) !<-- zfac should be negative definite
+ ztemp = EXP ( zfac )
+ zsqrt = SQRT( -zfac )
+ zbreiv16_w = ztemp - SQRT(rpi)*zsqrt*ERFC(zsqrt) !Eq. 16 Breivik 2016
+ zInt_w1 = ztemp - 4._wp * zk_t (ji,jj) * gdepw(ji,jj,jk+1,Kmm) * zbreiv16_w
+ !
+ !
zsp0 = zfac / MAX(zk_t (ji,jj),0.0000001_wp)
- ztemp = zInt_w(ji,jj,jk) - zInt_w(ji,jj,jk+1)
+ ztemp = zInt_w0 - zInt_w1
zu0_sd(ji,jj) = ut0sd(ji,jj) * zsp0 * ztemp * tmask(ji,jj,jk)
zv0_sd(ji,jj) = vt0sd(ji,jj) * zsp0 * ztemp * tmask(ji,jj,jk)
END_2D
- DO_2D( 1, 0, 1, 0 ) ! ++ Interpolate at U/V points
+ DO_2D( 0, 0, 0, 0 ) ! ++ Interpolate at U/V points
zfac = 1.0_wp / e3u(ji ,jj,jk,Kmm)
usd(ji,jj,jk) = 0.5_wp * zfac * ( zu0_sd(ji,jj)+zu0_sd(ji+1,jj) ) * umask(ji,jj,jk)
zfac = 1.0_wp / e3v(ji ,jj,jk,Kmm)
vsd(ji,jj,jk) = 0.5_wp * zfac * ( zv0_sd(ji,jj)+zv0_sd(ji,jj+1) ) * vmask(ji,jj,jk)
END_2D
ENDDO
- !# undef zInt_w
- !
+ !
ELSE
zfac = 2.0_wp * rpi / 16.0_wp
- DO_2D( 1, 1, 1, 1 )
+ DO_2D( 0, 1, 0, 1 )
! Stokes drift velocity estimated from Hs and Tmean
ztransp = zfac * hsw(ji,jj)*hsw(ji,jj) / MAX( wmp(ji,jj), 0.0000001_wp )
! Stokes surface speed
@@ -186,7 +190,7 @@ CONTAINS
! Wavenumber scale
zk_t(ji,jj) = ABS( tsd2d(ji,jj) ) / MAX( ABS( 5.97_wp*ztransp ), 0.0000001_wp )
END_2D
- DO_2D( 1, 0, 1, 0 ) ! exp. wave number & Stokes drift velocity at u- & v-points
+ DO_2D( 0, 0, 0, 0 ) ! exp. wave number & Stokes drift velocity at u- & v-points
zk_u(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji+1,jj) )
zk_v(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji,jj+1) )
!
@@ -248,7 +252,7 @@ CONTAINS
CALL iom_put( "vstokes", vsd )
CALL iom_put( "wstokes", wsd )
! !
- DEALLOCATE( ze3divh, zInt_w )
+ DEALLOCATE( ze3divh )
DEALLOCATE( zk_t, zk_u, zk_v, zu0_sd, zv0_sd )
!
END SUBROUTINE sbc_stokes
@@ -274,12 +278,12 @@ CONTAINS
!
IF( ln_cdgw .AND. .NOT. cpl_wdrag ) THEN !== Neutral drag coefficient ==!
CALL fld_read( kt, nn_fsbc, sf_cd ) ! read from external forcing
- cdn_wave(:,:) = sf_cd(1)%fnow(:,:,1) * tmask(:,:,1)
+ cdn_wave(:,:) = sf_cd(1)%fnow(:,:,1) * smask0(:,:)
ENDIF
IF( ln_tauoc .AND. .NOT. cpl_wstrf ) THEN !== Wave induced stress ==!
CALL fld_read( kt, nn_fsbc, sf_tauoc ) ! read stress reduction factor due to wave from external forcing
- tauoc_wave(:,:) = sf_tauoc(1)%fnow(:,:,1) * tmask(:,:,1)
+ tauoc_wave(:,:) = sf_tauoc(1)%fnow(:,:,1) * smask0(:,:)
ELSEIF ( ln_taw .AND. cpl_taw ) THEN
IF (kt < 1) THEN ! The first fields gave by OASIS have very high erroneous values ....
twox(:,:)=0._wp
@@ -315,7 +319,7 @@ CONTAINS
! coupling routines
IF( ln_zdfswm .AND. .NOT. cpl_wnum ) THEN !==wavenumber==!
CALL fld_read( kt, nn_fsbc, sf_wn ) ! read wave parameters from external forcing
- wnum(:,:) = sf_wn(1)%fnow(:,:,1) * tmask(:,:,1)
+ wnum(:,:) = sf_wn(1)%fnow(:,:,1) * smask0(:,:)
ENDIF
!
@@ -391,10 +395,10 @@ CONTAINS
! !== Allocate wave arrays ==!
ALLOCATE( ut0sd (jpi,jpj) , vt0sd (jpi,jpj) )
ALLOCATE( hsw (jpi,jpj) , wmp (jpi,jpj) )
- ALLOCATE( wnum (jpi,jpj) )
ALLOCATE( tsd2d (jpi,jpj) , div_sd(jpi,jpj) , bhd_wave(jpi,jpj) )
ALLOCATE( usd (jpi,jpj,jpk), vsd (jpi,jpj,jpk), wsd (jpi,jpj,jpk) )
- ALLOCATE( tusd (jpi,jpj) , tvsd (jpi,jpj) , ZMX (jpi,jpj,jpk) )
+ ALLOCATE( tusd (jpi,jpj) , tvsd (jpi,jpj) )
+ ALLOCATE( wnum (A2D(0)) , ZMX (A2D(0),jpk) )
usd (:,:,:) = 0._wp
vsd (:,:,:) = 0._wp
wsd (:,:,:) = 0._wp
@@ -422,30 +426,30 @@ CONTAINS
ALLOCATE( sf_cd(1), STAT=ierror ) !* allocate and fill sf_wave with sn_cdg
IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_wave structure' )
!
- ALLOCATE( sf_cd(1)%fnow(jpi,jpj,1) )
- IF( sn_cdg%ln_tint ) ALLOCATE( sf_cd(1)%fdta(jpi,jpj,1,2) )
+ ALLOCATE( sf_cd(1)%fnow(A2D(0),1) )
+ IF( sn_cdg%ln_tint ) ALLOCATE( sf_cd(1)%fdta(A2D(0),1,2) )
CALL fld_fill( sf_cd, (/ sn_cdg /), cn_dir, 'sbc_wave_init', 'Wave module ', 'namsbc_wave' )
ENDIF
- ALLOCATE( cdn_wave(jpi,jpj) )
+ ALLOCATE( cdn_wave(A2D(0)) )
cdn_wave(:,:) = 0._wp
ENDIF
IF( ln_charn ) THEN ! wave drag
IF( .NOT. cpl_charn ) THEN
CALL ctl_stop( 'STOP', 'Charnock based wind stress can be used in coupled mode only' )
ENDIF
- ALLOCATE( charn(jpi,jpj) )
+ ALLOCATE( charn(A2D(0)) )
charn(:,:) = 0._wp
ENDIF
IF( ln_taw ) THEN ! wind stress
IF( .NOT. cpl_taw ) THEN
CALL ctl_stop( 'STOP', 'wind stress from wave model can be used in coupled mode only, use ln_cdgw instead' )
ENDIF
- ALLOCATE( tawx(jpi,jpj) )
- ALLOCATE( tawy(jpi,jpj) )
- ALLOCATE( twox(jpi,jpj) )
- ALLOCATE( twoy(jpi,jpj) )
- ALLOCATE( tauoc_wavex(jpi,jpj) )
- ALLOCATE( tauoc_wavey(jpi,jpj) )
+ ALLOCATE( tawx(A2D(0)) )
+ ALLOCATE( tawy(A2D(0)) )
+ ALLOCATE( twox(A2D(0)) )
+ ALLOCATE( twoy(A2D(0)) )
+ ALLOCATE( tauoc_wavex(A2D(0)) )
+ ALLOCATE( tauoc_wavey(A2D(0)) )
tawx(:,:) = 0._wp
tawy(:,:) = 0._wp
twox(:,:) = 0._wp
@@ -458,7 +462,7 @@ CONTAINS
IF( .NOT. cpl_phioc ) THEN
CALL ctl_stop( 'STOP', 'phioc can be used in coupled mode only' )
ENDIF
- ALLOCATE( phioc(jpi,jpj) )
+ ALLOCATE( phioc(A2D(0)) )
phioc(:,:) = 0._wp
ENDIF
@@ -467,11 +471,11 @@ CONTAINS
ALLOCATE( sf_tauoc(1), STAT=ierror ) !* allocate and fill sf_wave with sn_tauoc
IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_tauoc structure' )
!
- ALLOCATE( sf_tauoc(1)%fnow(jpi,jpj,1) )
- IF( sn_tauoc%ln_tint ) ALLOCATE( sf_tauoc(1)%fdta(jpi,jpj,1,2) )
+ ALLOCATE( sf_tauoc(1)%fnow(A2D(0),1) )
+ IF( sn_tauoc%ln_tint ) ALLOCATE( sf_tauoc(1)%fdta(A2D(0),1,2) )
CALL fld_fill( sf_tauoc, (/ sn_tauoc /), cn_dir, 'sbc_wave_init', 'Wave module', 'namsbc_wave' )
ENDIF
- ALLOCATE( tauoc_wave(jpi,jpj) )
+ ALLOCATE( tauoc_wave(A2D(0)) )
tauoc_wave(:,:) = 0._wp
ENDIF
@@ -518,8 +522,8 @@ CONTAINS
IF( .NOT. cpl_wnum ) THEN
ALLOCATE( sf_wn(1), STAT=ierror ) !* allocate and fill sf_wave with sn_wnum
IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_wn structure' )
- ALLOCATE( sf_wn(1)%fnow(jpi,jpj,1) )
- IF( sn_wnum%ln_tint ) ALLOCATE( sf_wn(1)%fdta(jpi,jpj,1,2) )
+ ALLOCATE( sf_wn(1)%fnow(A2D(0),1) )
+ IF( sn_wnum%ln_tint ) ALLOCATE( sf_wn(1)%fdta(A2D(0),1,2) )
CALL fld_fill( sf_wn, (/ sn_wnum /), cn_dir, 'sbc_wave', 'Wave module', 'namsbc_wave' )
ENDIF
!
diff --git a/src/OCE/TRA/eosbn2.F90 b/src/OCE/TRA/eosbn2.F90
index 1f808dfb94818f4a74df93d894748d087f296f98..5a04a3ca0b8454f1690306ccdd8d421d9973b8e3 100644
--- a/src/OCE/TRA/eosbn2.F90
+++ b/src/OCE/TRA/eosbn2.F90
@@ -83,9 +83,11 @@ MODULE eosbn2
INTEGER , PARAMETER :: np_teos10 = -1 ! parameter for using TEOS10
INTEGER , PARAMETER :: np_eos80 = 0 ! parameter for using EOS80
- INTEGER , PARAMETER :: np_seos = 1 ! parameter for using Simplified Equation of state
+ INTEGER , PARAMETER :: np_seos = 1 ! parameter for using Simplified Equation of state
! !!! simplified eos coefficients (default value: Vallis 2006)
+ REAL(wp), PUBLIC :: rn_T0 = 10._wp ! reference temperature
+ REAL(wp), PUBLIC :: rn_S0 = 35._wp ! reference salinity
REAL(wp), PUBLIC :: rn_a0 = 1.6550e-1_wp ! thermal expansion coeff.
REAL(wp), PUBLIC :: rn_b0 = 7.6554e-1_wp ! saline expansion coeff.
REAL(wp) :: rn_lambda1 = 5.9520e-2_wp ! cabbeling coeff. in T^2
@@ -272,8 +274,8 @@ CONTAINS
CASE( np_seos ) !== simplified EOS ==!
!
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
- zt = pts (ji,jj,jk,jp_tem,Knn) - 10._wp
- zs = pts (ji,jj,jk,jp_sal,Knn) - 35._wp
+ zt = pts (ji,jj,jk,jp_tem,Knn) - rn_T0
+ zs = pts (ji,jj,jk,jp_sal,Knn) - rn_S0
zh = gdept(ji,jj,jk,Knn)
ztm = tmask(ji,jj,jk)
!
@@ -391,8 +393,8 @@ CONTAINS
CASE( np_seos ) !== simplified EOS ==!
!
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
- zt = pts (ji,jj,jk,jp_tem) - 10._wp
- zs = pts (ji,jj,jk,jp_sal) - 35._wp
+ zt = pts (ji,jj,jk,jp_tem) - rn_T0
+ zs = pts (ji,jj,jk,jp_sal) - rn_S0
zh = pdep (ji,jj,jk)
ztm = tmask(ji,jj,jk)
!
@@ -556,8 +558,8 @@ CONTAINS
CASE( np_seos ) !== simplified EOS ==!
!
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
- zt = pts (ji,jj,jk,jp_tem) - 10._wp
- zs = pts (ji,jj,jk,jp_sal) - 35._wp
+ zt = pts (ji,jj,jk,jp_tem) - rn_T0
+ zs = pts (ji,jj,jk,jp_sal) - rn_S0
zh = pdep (ji,jj,jk)
ztm = tmask(ji,jj,jk)
! ! potential density referenced at the surface
@@ -658,8 +660,8 @@ CONTAINS
!
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
!
- zt = pts (ji,jj,jp_tem) - 10._wp
- zs = pts (ji,jj,jp_sal) - 35._wp
+ zt = pts (ji,jj,jp_tem) - rn_T0
+ zs = pts (ji,jj,jp_sal) - rn_S0
zh = pdep (ji,jj) ! depth at the partial step level
!
zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt &
@@ -742,8 +744,8 @@ CONTAINS
CASE( np_seos ) !== simplified EOS ==!
!
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- zt = pts (ji,jj,jp_tem) - 10._wp
- zs = pts (ji,jj,jp_sal) - 35._wp
+ zt = pts (ji,jj,jp_tem) - rn_T0
+ zs = pts (ji,jj,jp_sal) - rn_S0
ztm = tmask(ji,jj,1)
! ! potential density referenced at the surface
zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt &
@@ -853,9 +855,9 @@ CONTAINS
CASE( np_seos ) !== simplified EOS ==!
!
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
- zt = pts (ji,jj,jk,jp_tem) - 10._wp ! pot. temperature anomaly (t-T0)
- zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0)
- zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point
+ zt = pts (ji,jj,jk,jp_tem) - rn_T0 ! pot. temperature anomaly (t-T0)
+ zs = pts (ji,jj,jk,jp_sal) - rn_S0 ! abs. salinity anomaly (s-S0)
+ zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point
ztm = tmask(ji,jj,jk) ! land/sea bottom mask = surf. mask
!
zn = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs
@@ -973,9 +975,9 @@ CONTAINS
!
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
!
- zt = pts (ji,jj,jp_tem) - 10._wp ! pot. temperature anomaly (t-T0)
- zs = pts (ji,jj,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0)
- zh = pdep (ji,jj) ! depth at the partial step level
+ zt = pts (ji,jj,jp_tem) - rn_T0 ! pot. temperature anomaly (t-T0)
+ zs = pts (ji,jj,jp_sal) - rn_S0 ! abs. salinity anomaly (s-S0)
+ zh = pdep (ji,jj) ! depth at the partial step level
!
zn = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs
pab(ji,jj,jp_tem) = zn * r1_rho0 ! alpha
@@ -1075,9 +1077,9 @@ CONTAINS
!
CASE( np_seos ) !== simplified EOS ==!
!
- zt = pts(jp_tem) - 10._wp ! pot. temperature anomaly (t-T0)
- zs = pts(jp_sal) - 35._wp ! abs. salinity anomaly (s-S0)
- zh = pdep ! depth at the partial step level
+ zt = pts(jp_tem) - rn_T0 ! pot. temperature anomaly (t-T0)
+ zs = pts(jp_sal) - rn_S0 ! abs. salinity anomaly (s-S0)
+ zh = pdep ! depth at the partial step level
!
zn = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs
pab(jp_tem) = zn * r1_rho0 ! alpha
@@ -1164,28 +1166,37 @@ CONTAINS
!! Reference : TEOS-10, UNESCO
!! Rational approximation to TEOS10 algorithm (rms error on WOA13 values: 4.0e-5 degC)
!!----------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: ctmp ! Cons. Temp [Celsius]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu]
+ REAL(wp), DIMENSION(:,:), INTENT(in ) :: ctmp ! Cons. Temp [Celsius]
+ REAL(wp), DIMENSION(:,:), INTENT(in ) :: psal ! salinity [psu]
! Leave result array automatic rather than making explicitly allocated
- REAL(wp), DIMENSION(jpi,jpj) :: ptmp ! potential temperature [Celsius]
+ REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ptmp ! potential temperature [Celsius]
!
INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zt , zs , ztm ! local scalars
REAL(wp) :: zn , zd ! local scalars
REAL(wp) :: zdeltaS , z1_S0 , z1_T0
+ INTEGER :: ipi, ipj, iisht, ijsht ! dimensions and shift indices
!!----------------------------------------------------------------------
!
+ ipi = SIZE(psal,1) ! 1st dimension
+ ipj = SIZE(psal,2) ! 2nd dimension
+ !
+ iisht = ( jpi - ipi ) / 2
+ ijsht = ( jpj - ipj ) / 2 ! should be the same as iisht...
+ !
+ IF( .NOT.ALLOCATED(ptmp) ) ALLOCATE( ptmp(ipi,ipj) )
+ !
IF( ln_timing ) CALL timing_start('eos_pt_from_ct')
!
zdeltaS = 5._wp
z1_S0 = 0.875_wp/35.16504_wp
z1_T0 = 1._wp/40._wp
!
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( nn_hls-iisht, nn_hls-iisht, nn_hls-ijsht, nn_hls-ijsht )
!
- zt = ctmp (ji,jj) * z1_T0
- zs = SQRT( ABS( psal(ji,jj) + zdeltaS ) * z1_S0 )
- ztm = tmask(ji,jj,1)
+ zt = ctmp (ji-iisht,jj-ijsht) * z1_T0
+ zs = SQRT( ABS( psal(ji-iisht,jj-ijsht) + zdeltaS ) * z1_S0 )
+ ztm = tmask(ji-iisht,jj-ijsht,1)
!
zn = ((((-2.1385727895e-01_wp*zt &
& - 2.7674419971e-01_wp*zs+1.0728094330_wp)*zt &
@@ -1200,7 +1211,7 @@ CONTAINS
& -3.4570358592e-01_wp*zs+5.6471810638_wp)*zt &
& + (1.5393993508_wp*zs-6.9394762624_wp)*zs+1.2750522650e+01_wp
!
- ptmp(ji,jj) = ( zt / z1_T0 + zn / zd ) * ztm
+ ptmp(ji-iisht,jj-ijsht) = ( zt / z1_T0 + zn / zd ) * ztm
!
END_2D
!
@@ -1211,9 +1222,9 @@ CONTAINS
SUBROUTINE eos_fzp_2d( psal, ptf, pdep )
!!
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in ), OPTIONAL :: pdep ! depth [m]
- REAL(wp), DIMENSION(:,:) , INTENT(out ) :: ptf ! freezing temperature [Celsius]
+ REAL(wp), DIMENSION(:,:), INTENT(in ) :: psal ! salinity [psu]
+ REAL(wp), DIMENSION(:,:), INTENT(in ), OPTIONAL :: pdep ! depth [m]
+ REAL(wp), DIMENSION(:,:), INTENT(out ) :: ptf ! freezing temperature [Celsius]
!!
CALL eos_fzp_2d_t( psal, ptf, is_tile(ptf), pdep )
END SUBROUTINE eos_fzp_2d
@@ -1231,35 +1242,52 @@ CONTAINS
!!
!! Reference : UNESCO tech. papers in the marine science no. 28. 1978
!!----------------------------------------------------------------------
- INTEGER , INTENT(in ) :: kttf
- REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: psal ! salinity [psu]
- REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ), OPTIONAL :: pdep ! depth [m]
- REAL(wp), DIMENSION(A2D_T(kttf)), INTENT(out ) :: ptf ! freezing temperature [Celsius]
+ INTEGER , INTENT(in ) :: kttf
+ REAL(wp), DIMENSION(:,:), INTENT(in ) :: psal ! salinity [psu]
+ REAL(wp), DIMENSION(:,:), INTENT(in ), OPTIONAL :: pdep ! depth [m]
+ REAL(wp), DIMENSION(:,:), INTENT(out ) :: ptf ! freezing temperature [Celsius]
!
INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zt, zs, z1_S0 ! local scalars
+ INTEGER :: ipi, ipj, iisht, ijsht ! dimensions and shift indices
!!----------------------------------------------------------------------
!
+ ipi = SIZE(psal,1) ! 1st dimension
+ ipj = SIZE(psal,2) ! 2nd dimension
+ !
+ iisht = ( jpi - ipi ) / 2
+ ijsht = ( jpj - ipj ) / 2 ! should be the same as iisht...
+ !
SELECT CASE ( neos )
!
CASE ( np_teos10, np_seos ) !== CT,SA (TEOS-10 and S-EOS formulations) ==!
!
z1_S0 = 1._wp / 35.16504_wp
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- zs= SQRT( ABS( psal(ji,jj) ) * z1_S0 ) ! square root salinity
- ptf(ji,jj) = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs &
- & - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp
+ DO_2D( nn_hls-iisht, nn_hls-iisht, nn_hls-ijsht, nn_hls-ijsht )
+ zs= SQRT( ABS( psal(ji-iisht,jj-ijsht) ) * z1_S0 ) ! square root salinity
+ ptf(ji-iisht,jj-ijsht) = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs &
+ & - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp
+ ptf(ji-iisht,jj-ijsht) = ptf(ji-iisht,jj-ijsht) * psal(ji-iisht,jj-ijsht)
END_2D
- ptf(:,:) = ptf(:,:) * psal(:,:)
!
- IF( PRESENT( pdep ) ) ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:)
+ IF( PRESENT( pdep ) ) THEN
+ DO_2D( nn_hls-iisht, nn_hls-iisht, nn_hls-ijsht, nn_hls-ijsht )
+ ptf(ji-iisht,jj-ijsht) = ptf(ji-iisht,jj-ijsht) - 7.53e-4 * pdep(ji-iisht,jj-ijsht)
+ END_2D
+ ENDIF
!
CASE ( np_eos80 ) !== PT,SP (UNESCO formulation) ==!
!
- ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) ) &
- & - 2.154996e-4_wp * psal(:,:) ) * psal(:,:)
- !
- IF( PRESENT( pdep ) ) ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:)
+ DO_2D( nn_hls-iisht, nn_hls-iisht, nn_hls-ijsht, nn_hls-ijsht )
+ ptf(ji-iisht,jj-ijsht) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(ji-iisht,jj-ijsht) ) &
+ & - 2.154996e-4_wp * psal(ji-iisht,jj-ijsht) ) * psal(ji-iisht,jj-ijsht)
+ END_2D
+ !
+ IF( PRESENT( pdep ) ) THEN
+ DO_2D( nn_hls-iisht, nn_hls-iisht, nn_hls-ijsht, nn_hls-ijsht )
+ ptf(ji-iisht,jj-ijsht) = ptf(ji-iisht,jj-ijsht) - 7.53e-4 * pdep(ji-iisht,jj-ijsht)
+ END_2D
+ ENDIF
!
CASE DEFAULT
WRITE(ctmp1,*) ' bad flag value for neos = ', neos
@@ -1412,10 +1440,10 @@ CONTAINS
CASE( np_seos ) !== Vallis (2006) simplified EOS ==!
!
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
- zt = pts(ji,jj,jk,jp_tem) - 10._wp ! temperature anomaly (t-T0)
- zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0)
- zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point
- ztm = tmask(ji,jj,jk) ! tmask
+ zt = pts (ji,jj,jk,jp_tem) - rn_T0 ! temperature anomaly (t-T0)
+ zs = pts (ji,jj,jk,jp_sal) - rn_S0 ! abs. salinity anomaly (s-S0)
+ zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point
+ ztm = tmask(ji,jj,jk) ! tmask
zn = 0.5_wp * zh * r1_rho0 * ztm
! ! Potential Energy
ppen(ji,jj,jk) = ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zn
@@ -1447,8 +1475,8 @@ CONTAINS
INTEGER :: ios ! local integer
INTEGER :: ioptio ! local integer
!!
- NAMELIST/nameos/ ln_TEOS10, ln_EOS80, ln_SEOS, rn_a0, rn_b0, rn_lambda1, rn_mu1, &
- & rn_lambda2, rn_mu2, rn_nu
+ NAMELIST/nameos/ ln_TEOS10, ln_EOS80, ln_SEOS, rn_T0, rn_S0, rn_a0, rn_b0, rn_lambda1, rn_mu1, &
+ & rn_lambda2, rn_mu2, rn_nu
!!----------------------------------------------------------------------
!
READ ( numnam_ref, nameos, IOSTAT = ios, ERR = 901 )
@@ -1869,9 +1897,11 @@ CONTAINS
IF(lwp) THEN
WRITE(numout,*)
WRITE(numout,*) ' ==>>> use of simplified eos: '
- WRITE(numout,*) ' rhd(dT=T-10,dS=S-35,Z) = [-a0*(1+lambda1/2*dT+mu1*Z)*dT '
- WRITE(numout,*) ' + b0*(1+lambda2/2*dT+mu2*Z)*dS - nu*dT*dS] / rho0'
+ WRITE(numout,*) ' rhd(dT=T-rn_T0,dS=S-rn_S0,Z) = [-a0*(1+lambda1/2*dT+mu1*Z)*dT '
+ WRITE(numout,*) ' + b0*(1+lambda2/2*dT+mu2*Z)*dS - nu*dT*dS] / rho0'
WRITE(numout,*) ' with the following coefficients :'
+ WRITE(numout,*) ' reference temperature rn_T0 = ', rn_T0
+ WRITE(numout,*) ' reference salinity rn_S0 = ', rn_S0
WRITE(numout,*) ' thermal exp. coef. rn_a0 = ', rn_a0
WRITE(numout,*) ' saline cont. coef. rn_b0 = ', rn_b0
WRITE(numout,*) ' cabbeling coef. rn_lambda1 = ', rn_lambda1
diff --git a/src/OCE/TRA/traadv.F90 b/src/OCE/TRA/traadv.F90
index 190a6a7ad3cc55d62bed5e3023620e3177faf32e..5fa0929cbcb425ee0125aaea857ed4870f558d90 100644
--- a/src/OCE/TRA/traadv.F90
+++ b/src/OCE/TRA/traadv.F90
@@ -10,6 +10,7 @@ MODULE traadv
!! - ! 2014-12 (G. Madec) suppression of cross land advection option
!! 3.6 ! 2015-06 (E. Clementi) Addition of Stokes drift in case of wave coupling
!! 4.5 ! 2021-04 (G. Madec, S. Techene) add advective velocities as optional arguments
+ !! 4.5 ! 2022-06 (S. Techene, G, Madec) refactorization to reduce local memory usage
!!----------------------------------------------------------------------
!!----------------------------------------------------------------------
@@ -191,11 +192,19 @@ CONTAINS
SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==!
!
CASE ( np_CEN ) ! Centered scheme : 2nd / 4th order
- CALL tra_adv_cen ( kt, nit000, 'TRA', zuu, zvv, zww, Kmm, pts, jpts, Krhs, nn_cen_h, nn_cen_v )
+ IF( nn_hls == 1 ) THEN
+ CALL tra_adv_cen_hls1( kt, nit000, 'TRA', zuu, zvv, zww, Kmm, pts, jpts, Krhs, nn_cen_h, nn_cen_v )
+ ELSE
+ CALL tra_adv_cen ( kt, nit000, 'TRA', zuu, zvv, zww, Kmm, pts, jpts, Krhs, nn_cen_h, nn_cen_v )
+ ENDIF
CASE ( np_FCT ) ! FCT scheme : 2nd / 4th order
CALL tra_adv_fct ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v )
CASE ( np_MUS ) ! MUSCL
+ IF( nn_hls == 1 ) THEN
+ CALL tra_adv_mus_hls1( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups )
+ ELSE
CALL tra_adv_mus( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups )
+ END IF
CASE ( np_UBS ) ! UBS
CALL tra_adv_ubs ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_ubs_v )
CASE ( np_QCK ) ! QUICKEST
diff --git a/src/OCE/TRA/traadv_cen.F90 b/src/OCE/TRA/traadv_cen.F90
index 3351e1935a5503648b2e9e0ca590bb5a7813c037..72761ac41ca8ec84f7c2008678e61d167a36b4d6 100644
--- a/src/OCE/TRA/traadv_cen.F90
+++ b/src/OCE/TRA/traadv_cen.F90
@@ -4,6 +4,7 @@ MODULE traadv_cen
!! Ocean tracers: advective trend (2nd/4th order centered)
!!======================================================================
!! History : 3.7 ! 2014-05 (G. Madec) original code
+ !! 4.5 ! 2022-06 (S. Techene, G, Madec) refactorization to reduce local memory usage
!!----------------------------------------------------------------------
!!----------------------------------------------------------------------
@@ -29,7 +30,8 @@ MODULE traadv_cen
IMPLICIT NONE
PRIVATE
- PUBLIC tra_adv_cen ! called by traadv.F90
+ PUBLIC tra_adv_cen ! called by traadv.F90
+ PUBLIC tra_adv_cen_hls1 ! called by traadv.F90
REAL(wp) :: r1_6 = 1._wp / 6._wp ! =1/6
@@ -47,7 +49,321 @@ MODULE traadv_cen
!!----------------------------------------------------------------------
CONTAINS
+ SUBROUTINE tra_adv_cen_test( kt, kit000, cdtype, pU, pV, pW, &
+ & Kmm, pt, kjpt, Krhs, kn_cen_h, kn_cen_v )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE tra_adv_cen ***
+ !!
+ !! ** Purpose : Compute the now trend due to the advection of tracers
+ !! and add it to the general trend of passive tracer equations.
+ !!
+ !! ** Method : The advection is evaluated by a 2nd or 4th order scheme
+ !! using now fields (leap-frog scheme).
+ !! kn_cen_h = 2 ==>> 2nd order centered scheme on the horizontal
+ !! = 4 ==>> 4th order - - - -
+ !! kn_cen_v = 2 ==>> 2nd order centered scheme on the vertical
+ !! = 4 ==>> 4th order COMPACT scheme - -
+ !!
+ !! ** Action : - update pt(:,:,:,:,Krhs) with the now advective tracer trends
+ !! - send trends to trdtra module for further diagnostcs (l_trdtra=T)
+ !! - poleward advective heat and salt transport (l_diaptr=T)
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: kt ! ocean time-step index
+ INTEGER , INTENT(in ) :: Kmm, Krhs ! ocean time level indices
+ INTEGER , INTENT(in ) :: kit000 ! first time step index
+ CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)
+ INTEGER , INTENT(in ) :: kjpt ! number of tracers
+ INTEGER , INTENT(in ) :: kn_cen_h ! =2/4 (2nd or 4th order scheme)
+ INTEGER , INTENT(in ) :: kn_cen_v ! =2/4 (2nd or 4th order scheme)
+ ! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
+ REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume flux components
+ REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation
+ !
+ INTEGER :: ji, jj, jk, jn ! dummy loop indices
+ INTEGER :: ierr ! local integer
+ REAL(wp) :: zC2t_u, zC4t_u ! local scalars
+ REAL(wp) :: zC2t_v, zC4t_v ! - -
+ REAL(wp) :: zftw_kp1
+ REAL(wp), DIMENSION(A2D(1)) :: zft_u, zft_v !, zft_w
+ REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: zdt_u, zdt_v
+ REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: ztw
+ !!----------------------------------------------------------------------
+ !
+#if defined key_loop_fusion
+ CALL tra_adv_cen_lf ( kt, nit000, cdtype, pU, pV, pW, Kmm, pt, kjpt, Krhs, kn_cen_h, kn_cen_v )
+#else
+ IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile
+ IF( kt == kit000 ) THEN
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) 'tra_adv_cen : centered advection scheme on ', cdtype, ' order h/v =', kn_cen_h,'/', kn_cen_v
+ IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~ '
+ ENDIF
+ ! ! set local switches
+ l_trd = .FALSE.
+ l_hst = .FALSE.
+ l_ptr = .FALSE.
+ IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
+ IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE.
+ IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &
+ & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE.
+ ENDIF
+ !
+ ! !* 2nd order centered
+ DO jn = 1, kjpt !== loop over the tracers ==!
+ !
+ DO jk = 1, jpkm1
+ !
+ DO_2D( 1, 0, 1, 0 ) ! Horizontal fluxes at layer jk
+ zft_u(ji,jj) = 0.5_wp * pU(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj ,jk,jn,Kmm) )
+ zft_v(ji,jj) = 0.5_wp * pV(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji ,jj+1,jk,jn,Kmm) )
+ END_2D
+ !
+ DO_2D( 0, 0, 0, 0 ) ! Horizontal divergence of advective fluxes
+ pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( zft_u(ji,jj) - zft_u(ji-1,jj ) &
+ & + zft_v(ji,jj) - zft_v(ji ,jj-1) ) * r1_e1e2t(ji,jj) &
+ & / e3t(ji,jj,jk,Kmm)
+ END_2D
+ END DO
+ !
+#define zft_w zft_u
+ IF( ln_linssh ) THEN !* top value (linear free surf. only as zwz is multiplied by wmask)
+ DO_2D( 0, 0, 0, 0 )
+ zft_w(ji,jj) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kmm)
+ END_2D
+ ELSE
+ DO_2D( 0, 0, 0, 0 )
+ zft_w(ji,jj) = 0._wp
+ END_2D
+ ENDIF
+ DO jk = 1, jpk-2
+ DO_2D( 0, 0, 0, 0 ) ! Vertical fluxes
+ zftw_kp1 = 0.5 * pW(ji,jj,jk+1) * ( pt(ji,jj,jk+1,jn,Kmm) + pt(ji,jj,jk,jn,Kmm) ) * wmask(ji,jj,jk+1)
+ !
+ pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( zft_w(ji,jj) - zftw_kp1 ) * r1_e1e2t(ji,jj) &
+ & / e3t(ji,jj,jk,Kmm)
+ zft_w(ji,jj) = zftw_kp1
+ END_2D
+ END DO
+ jk = jpkm1 ! bottom vertical flux set to zero for all tracers
+ DO_2D( 0, 0, 0, 0 )
+ pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - zft_w(ji,jj) * r1_e1e2t(ji,jj) &
+ & / e3t(ji,jj,jk,Kmm)
+ END_2D
+ !
+ END DO
+ !
+
+ !
+#undef zft_w
+ ! ! trend diagnostics
+!!gm + !!st to be done with the whole rewritting of trd
+!! trd routine arguments MUST be changed adding jk and zwx, zwy in 2D
+!! IF( l_trd ) THEN
+!! CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, zwx, pU, pt(:,:,:,jn,Kmm) )
+!! CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, zwy, pV, pt(:,:,:,jn,Kmm) )
+!! CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zwz, pW, pt(:,:,:,jn,Kmm) )
+!! ENDIF
+!! ! ! "Poleward" heat and salt transports
+!! IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) )
+!! ! ! heat and salt transport
+!! IF( l_hst ) CALL dia_ar5_hst( jn, 'adv', zwx(:,:,:), zwy(:,:,:) )
+ !
+ !
+ !
+#endif
+ END SUBROUTINE tra_adv_cen_test
+
+
SUBROUTINE tra_adv_cen( kt, kit000, cdtype, pU, pV, pW, &
+ & Kmm, pt, kjpt, Krhs, kn_cen_h, kn_cen_v )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE tra_adv_cen ***
+ !!
+ !! ** Purpose : Compute the now trend due to the advection of tracers
+ !! and add it to the general trend of passive tracer equations.
+ !!
+ !! ** Method : The advection is evaluated by a 2nd or 4th order scheme
+ !! using now fields (leap-frog scheme).
+ !! kn_cen_h = 2 ==>> 2nd order centered scheme on the horizontal
+ !! = 4 ==>> 4th order - - - -
+ !! kn_cen_v = 2 ==>> 2nd order centered scheme on the vertical
+ !! = 4 ==>> 4th order COMPACT scheme - -
+ !!
+ !! ** Action : - update pt(:,:,:,:,Krhs) with the now advective tracer trends
+ !! - send trends to trdtra module for further diagnostcs (l_trdtra=T)
+ !! - poleward advective heat and salt transport (l_diaptr=T)
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: kt ! ocean time-step index
+ INTEGER , INTENT(in ) :: Kmm, Krhs ! ocean time level indices
+ INTEGER , INTENT(in ) :: kit000 ! first time step index
+ CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)
+ INTEGER , INTENT(in ) :: kjpt ! number of tracers
+ INTEGER , INTENT(in ) :: kn_cen_h ! =2/4 (2nd or 4th order scheme)
+ INTEGER , INTENT(in ) :: kn_cen_v ! =2/4 (2nd or 4th order scheme)
+ ! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
+ REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume flux components
+ REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation
+ !
+ INTEGER :: ji, jj, jk, jn ! dummy loop indices
+ INTEGER :: ierr ! local integer
+ REAL(wp) :: zC2t_u, zC4t_u ! local scalars
+ REAL(wp) :: zC2t_v, zC4t_v ! - -
+ REAL(wp) :: zftw_kp1
+ REAL(wp), DIMENSION(A2D(1)) :: zft_u, zft_v
+ REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: zdt_u, zdt_v
+ REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: ztw
+ !!----------------------------------------------------------------------
+ !
+#if defined key_loop_fusion
+ CALL tra_adv_cen_lf ( kt, nit000, cdtype, pU, pV, pW, Kmm, pt, kjpt, Krhs, kn_cen_h, kn_cen_v )
+#else
+ IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile
+ IF( kt == kit000 ) THEN
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) 'tra_adv_cen : centered advection scheme on ', cdtype, ' order h/v =', kn_cen_h,'/', kn_cen_v
+ IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~ '
+ ENDIF
+ ! ! set local switches
+ l_trd = .FALSE.
+ l_hst = .FALSE.
+ l_ptr = .FALSE.
+ IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
+ IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE.
+ IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &
+ & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE.
+ ENDIF
+ !
+ IF( kn_cen_h == 4 ) ALLOCATE( zdt_u(A2D(2)) , zdt_v(A2D(2)) ) ! horizontal 4th order only
+ IF( kn_cen_v == 4 ) ALLOCATE( ztw(A2D(nn_hls),jpk) ) ! vertical 4th order only
+ !
+ DO jn = 1, kjpt !== loop over the tracers ==!
+ !
+ SELECT CASE( kn_cen_h ) !-- Horizontal divergence of advective fluxes --!
+ !
+!!st limitation : does not take into acccount iceshelf specificity
+!! in case of linssh
+ CASE( 2 ) !* 2nd order centered
+ DO jk = 1, jpkm1
+ !
+ DO_2D( 1, 0, 1, 0 ) ! Horizontal fluxes at layer jk
+ zft_u(ji,jj) = 0.5_wp * pU(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj ,jk,jn,Kmm) )
+ zft_v(ji,jj) = 0.5_wp * pV(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji ,jj+1,jk,jn,Kmm) )
+ END_2D
+ !
+ DO_2D( 0, 0, 0, 0 ) ! Horizontal divergence of advective fluxes
+ pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( zft_u(ji,jj) - zft_u(ji-1,jj ) &
+ & + zft_v(ji,jj) - zft_v(ji ,jj-1) ) * r1_e1e2t(ji,jj) &
+ & / e3t(ji,jj,jk,Kmm)
+ END_2D
+ END DO
+ !
+ CASE( 4 ) !* 4th order centered
+ DO jk = 1, jpkm1
+ DO_2D( 2, 1, 2, 1 ) ! masked gradient
+ zdt_u(ji,jj) = ( pt(ji+1,jj ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk)
+ zdt_v(ji,jj) = ( pt(ji ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk)
+ END_2D
+ !
+ DO_2D( 1, 0, 1, 0 ) ! Horizontal advective fluxes
+ zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj ,jk,jn,Kmm) ! C2 interpolation of T at u- & v-points (x2)
+ zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji ,jj+1,jk,jn,Kmm)
+ ! ! C4 interpolation of T at u- & v-points (x2)
+ zC4t_u = zC2t_u + r1_6 * ( zdt_u(ji-1,jj ) - zdt_u(ji+1,jj ) )
+ zC4t_v = zC2t_v + r1_6 * ( zdt_v(ji ,jj-1) - zdt_v(ji ,jj+1) )
+ ! ! C4 fluxes
+ zft_u(ji,jj) = 0.5_wp * pU(ji,jj,jk) * zC4t_u
+ zft_v(ji,jj) = 0.5_wp * pV(ji,jj,jk) * zC4t_v
+ END_2D
+ !
+ DO_2D( 0, 0, 0, 0 ) ! Horizontal divergence of advective fluxes
+ pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( zft_u(ji,jj) - zft_u(ji-1,jj ) &
+ & + zft_v(ji,jj) - zft_v(ji ,jj-1) ) * r1_e1e2t(ji,jj) &
+ & / e3t(ji,jj,jk,Kmm)
+ END_2D
+ END DO
+ !
+ CASE DEFAULT
+ CALL ctl_stop( 'traadv_cen: wrong value for nn_cen' )
+ END SELECT
+ !
+#define zft_w zft_u
+ !
+ IF( ln_linssh ) THEN !* top value (linear free surf. only as zwz is multiplied by wmask)
+ DO_2D( 0, 0, 0, 0 )
+ zft_w(ji,jj) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kmm)
+ END_2D
+ ELSE
+ DO_2D( 0, 0, 0, 0 )
+ zft_w(ji,jj) = 0._wp
+ END_2D
+ ENDIF
+ !
+ SELECT CASE( kn_cen_v ) !-- Vertical divergence of advective fluxes --! (interior)
+ !
+ CASE( 2 ) !* 2nd order centered
+ DO jk = 1, jpk-2
+ DO_2D( 0, 0, 0, 0 ) ! Vertical fluxes
+ zftw_kp1 = 0.5 * pW(ji,jj,jk+1) * ( pt(ji,jj,jk+1,jn,Kmm) + pt(ji,jj,jk,jn,Kmm) ) * wmask(ji,jj,jk+1)
+ !
+ pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( zft_w(ji,jj) - zftw_kp1 ) * r1_e1e2t(ji,jj) &
+ & / e3t(ji,jj,jk,Kmm)
+ zft_w(ji,jj) = zftw_kp1
+ END_2D
+ END DO
+ jk = jpkm1 ! bottom vertical flux set to zero for all tracers
+ DO_2D( 0, 0, 0, 0 )
+ pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - zft_w(ji,jj) * r1_e1e2t(ji,jj) &
+ & / e3t(ji,jj,jk,Kmm)
+ END_2D
+ !
+ CASE( 4 ) !* 4th order compact
+ CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw ) ! ztw = interpolated value of T at w-point
+ !
+ DO jk = 1, jpk-2
+ !
+ DO_2D( 0, 0, 0, 0 )
+ zftw_kp1 = pW(ji,jj,jk+1) * ztw(ji,jj,jk+1) * wmask(ji,jj,jk+1)
+ ! ! Divergence of advective fluxes
+ pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( zft_w(ji,jj) - zftw_kp1 ) * r1_e1e2t(ji,jj) &
+ & / e3t(ji,jj,jk,Kmm)
+ ! ! update
+ zft_w(ji,jj) = zftw_kp1
+ END_2D
+ !
+ END DO
+ !
+ jk = jpkm1 ! bottom vertical flux set to zero for all tracers
+ DO_2D( 0, 0, 0, 0 )
+ pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - zft_w(ji,jj) * r1_e1e2t(ji,jj) &
+ & / e3t(ji,jj,jk,Kmm)
+ END_2D
+ !
+ END SELECT
+ !
+#undef zft_w
+ ! ! trend diagnostics
+!!gm + !!st to be done with the whole rewritting of trd
+!! trd routine arguments MUST be changed adding jk and zwx, zwy in 2D
+!! IF( l_trd ) THEN
+!! CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, zwx, pU, pt(:,:,:,jn,Kmm) )
+!! CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, zwy, pV, pt(:,:,:,jn,Kmm) )
+!! CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zwz, pW, pt(:,:,:,jn,Kmm) )
+!! ENDIF
+!! ! ! "Poleward" heat and salt transports
+!! IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) )
+!! ! ! heat and salt transport
+!! IF( l_hst ) CALL dia_ar5_hst( jn, 'adv', zwx(:,:,:), zwy(:,:,:) )
+ !
+ END DO
+ !
+ IF( kn_cen_h == 4 ) DEALLOCATE( zdt_u , zdt_v ) ! horizontal 4th order only
+ IF( kn_cen_v == 4 ) DEALLOCATE( ztw ) ! vertical 4th order only
+ !
+#endif
+ END SUBROUTINE tra_adv_cen
+
+
+ SUBROUTINE tra_adv_cen_hls1( kt, kit000, cdtype, pU, pV, pW, &
& Kmm, pt, kjpt, Krhs, kn_cen_h, kn_cen_v )
!!----------------------------------------------------------------------
!! *** ROUTINE tra_adv_cen ***
@@ -141,6 +457,12 @@ CONTAINS
CASE DEFAULT
CALL ctl_stop( 'traadv_cen: wrong value for nn_cen' )
END SELECT
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !-- Divergence of advective fluxes --!
+ pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) &
+ & - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) &
+ & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) ) &
+ & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+ END_3D
!
SELECT CASE( kn_cen_v ) !-- Vertical fluxes --! (interior)
!
@@ -171,11 +493,17 @@ CONTAINS
!
DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !-- Divergence of advective fluxes --!
pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) &
- & - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) &
- & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) &
- & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) &
+ & - ( zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) &
& * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
END_3D
+!
+!!st DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !-- Divergence of advective fluxes --!
+!!st pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) &
+!!st & - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) &
+!!st & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) &
+!!st & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) &
+!!st & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+!!st END_3D
! ! trend diagnostics
IF( l_trd ) THEN
CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, zwx, pU, pt(:,:,:,jn,Kmm) )
@@ -183,14 +511,14 @@ CONTAINS
CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zwz, pW, pt(:,:,:,jn,Kmm) )
ENDIF
! ! "Poleward" heat and salt transports
- IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) )
+ IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', zwy(A2D(0),:) )
! ! heat and salt transport
IF( l_hst ) CALL dia_ar5_hst( jn, 'adv', zwx(:,:,:), zwy(:,:,:) )
!
END DO
!
#endif
- END SUBROUTINE tra_adv_cen
+ END SUBROUTINE tra_adv_cen_hls1
!!======================================================================
END MODULE traadv_cen
diff --git a/src/OCE/TRA/traadv_cen_lf.F90 b/src/OCE/TRA/traadv_cen_lf.F90
index 6d1f08fb9aaafc6fbc9f7f6c7077d1328c9b958f..0c8e2bf76df7b7f34ac597d189b31ee10c6b29af 100644
--- a/src/OCE/TRA/traadv_cen_lf.F90
+++ b/src/OCE/TRA/traadv_cen_lf.F90
@@ -175,7 +175,7 @@ CONTAINS
CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zwz, pW, pt(:,:,:,jn,Kmm) )
ENDIF
! ! "Poleward" heat and salt transports
- IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) )
+ IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', zwy(A2D(0),:) )
! ! heat and salt transport
IF( l_hst ) CALL dia_ar5_hst( jn, 'adv', zwx(:,:,:), zwy(:,:,:) )
!
diff --git a/src/OCE/TRA/traadv_fct.F90 b/src/OCE/TRA/traadv_fct.F90
index e66936ade3de2bb915f4db9b746d07f23b31c5b8..7ab4ae15ef13c62a98290149174b68eccbfaaac1 100644
--- a/src/OCE/TRA/traadv_fct.F90
+++ b/src/OCE/TRA/traadv_fct.F90
@@ -130,7 +130,7 @@ CONTAINS
ENDIF
!
IF( l_ptr ) THEN
- ALLOCATE( zptry(A2D(nn_hls),jpk) )
+ ALLOCATE( zptry(A2D(0),jpk) )
zptry(:,:,:) = 0._wp
ENDIF
!
@@ -213,7 +213,7 @@ CONTAINS
ztrdx(:,:,:) = zwx(:,:,:) ; ztrdy(:,:,:) = zwy(:,:,:) ; ztrdz(:,:,:) = zwz(:,:,:)
END IF
! ! "Poleward" heat and salt transports (contribution of upstream fluxes)
- IF( l_ptr ) zptry(:,:,:) = zwy(:,:,:)
+ IF( l_ptr ) zptry(:,:,:) = zwy(A2D(0),:)
!
! !== anti-diffusive flux : high order minus low order ==!
!
@@ -364,7 +364,7 @@ CONTAINS
!
ENDIF
IF( l_ptr ) THEN ! "Poleward" transports
- zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:) ! <<< add anti-diffusive fluxes
+ zptry(:,:,:) = zptry(:,:,:) + zwy(A2D(0),:) ! <<< add anti-diffusive fluxes
CALL dia_ptr_hst( jn, 'adv', zptry(:,:,:) )
ENDIF
!
@@ -753,7 +753,7 @@ CONTAINS
ENDIF
!
IF( l_ptr ) THEN
- ALLOCATE( zptry(jpi,jpj,jpk) )
+ ALLOCATE( zptry(A2D(0),jpk) )
zptry(:,:,:) = 0._wp
ENDIF
!
@@ -838,7 +838,7 @@ CONTAINS
ztrdx(:,:,:) = zwx_3d(:,:,:) ; ztrdy(:,:,:) = zwy_3d(:,:,:) ; ztrdz(:,:,:) = zwz(:,:,:)
END IF
! ! "Poleward" heat and salt transports (contribution of upstream fluxes)
- IF( l_ptr ) zptry(:,:,:) = zwy_3d(:,:,:)
+ IF( l_ptr ) zptry(:,:,:) = zwy_3d(A2D(0),:)
!
! !== anti-diffusive flux : high order minus low order ==!
!
@@ -986,7 +986,7 @@ CONTAINS
ENDIF
! NOT TESTED - NEED l_ptr TRUE
IF( l_ptr ) THEN ! "Poleward" transports
- zptry(:,:,:) = zptry(:,:,:) + zwy_3d(:,:,:) ! <<< add anti-diffusive fluxes
+ zptry(:,:,:) = zptry(:,:,:) + zwy_3d(A2D(0),:) ! <<< add anti-diffusive fluxes
CALL dia_ptr_hst( jn, 'adv', zptry(:,:,:) )
ENDIF
!
diff --git a/src/OCE/TRA/traadv_mus.F90 b/src/OCE/TRA/traadv_mus.F90
index 4c4b0437ca01cb250cf6f560527e8b0b5a632803..314f4c992cdbfc742af4555212159e4c3a058354 100644
--- a/src/OCE/TRA/traadv_mus.F90
+++ b/src/OCE/TRA/traadv_mus.F90
@@ -9,6 +9,7 @@ MODULE traadv_mus
!! 3.2 ! 2010-05 (C. Ethe, G. Madec) merge TRC-TRA + switch from velocity to transport
!! 3.4 ! 2012-06 (P. Oddo, M. Vichi) include the upstream where needed
!! 3.7 ! 2015-09 (G. Madec) add the ice-shelf cavities boundary condition
+ !! 4.5 ! 2022-06 (S. Techene, G, Madec) refactorization to reduce local memory usage
!!----------------------------------------------------------------------
!!----------------------------------------------------------------------
@@ -34,7 +35,9 @@ MODULE traadv_mus
IMPLICIT NONE
PRIVATE
- PUBLIC tra_adv_mus ! routine called by traadv.F90
+ PUBLIC tra_adv_mus ! routine called by traadv.F90
+ PUBLIC tra_adv_mus_hls1 ! routine called by traadv.F90
+
REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: upsmsk !: mixed upstream/centered scheme near some straits
! ! and in closed seas (orca 2 and 1 configurations)
@@ -55,6 +58,217 @@ MODULE traadv_mus
CONTAINS
SUBROUTINE tra_adv_mus( kt, kit000, cdtype, p2dt, pU, pV, pW, &
+ & Kbb, Kmm, pt, kjpt, Krhs, ld_msc_ups )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE tra_adv_mus ***
+ !!
+ !! ** Purpose : Compute the now trend due to total advection of tracers
+ !! using a MUSCL scheme (Monotone Upstream-centered Scheme for
+ !! Conservation Laws) and add it to the general tracer trend.
+ !!
+ !! ** Method : MUSCL scheme plus centered scheme at ocean boundaries
+ !! ld_msc_ups=T :
+ !!
+ !! ** Action : - update pt(:,:,:,:,Krhs) with the now advective tracer trends
+ !! - send trends to trdtra module for further diagnostcs (l_trdtra=T)
+ !! - poleward advective heat and salt transport (ln_diaptr=T)
+ !!
+ !! References : Estubier, A., and M. Levy, Notes Techn. Pole de Modelisation
+ !! IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa)
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: kt ! ocean time-step index
+ INTEGER , INTENT(in ) :: Kbb, Kmm, Krhs ! ocean time level indices
+ INTEGER , INTENT(in ) :: kit000 ! first time step index
+ CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)
+ INTEGER , INTENT(in ) :: kjpt ! number of tracers
+ LOGICAL , INTENT(in ) :: ld_msc_ups ! use upstream scheme within muscl
+ REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step
+ ! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
+ REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume flux components
+ REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation
+ !
+ INTEGER :: ji, jj, jk, jn ! dummy loop indices
+ INTEGER :: ierr ! local integer
+ INTEGER :: ik
+ REAL(wp) :: zu, z0u, zzslpx, zzwx, zw , zalpha ! local scalars
+ REAL(wp) :: zv, z0v, zzslpy, zzwy, z0w ! - -
+ REAL(wp) :: zdzt_kp2, zslpz_kp1, zfW_kp1
+ REAL(wp), DIMENSION(A2D(2)) :: zdxt, zslpx, zwx ! 2D workspace
+ REAL(wp), DIMENSION(A2D(2)) :: zdyt, zslpy, zwy ! - -
+ !!----------------------------------------------------------------------
+ !
+ IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile
+ IF( kt == kit000 ) THEN
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) 'tra_adv : MUSCL advection scheme on ', cdtype
+ IF(lwp) WRITE(numout,*) ' : mixed up-stream ', ld_msc_ups
+ IF(lwp) WRITE(numout,*) '~~~~~~~'
+ IF(lwp) WRITE(numout,*)
+ !
+ ! Upstream / MUSCL scheme indicator
+ !
+ ALLOCATE( xind(jpi,jpj,jpk), STAT=ierr )
+ xind(:,:,:) = 1._wp ! set equal to 1 where up-stream is not needed
+ IF( ld_msc_ups ) THEN ! define the upstream indicator (if asked)
+ DO jk = 1, jpkm1
+ xind(:,:,jk) = 1._wp & ! =>1 where up-stream is not needed
+ & - rnfmsk(:,:) * rnfmsk_z(jk) * tmask(:,:,jk) ! =>0 near runoff mouths (& closed sea outflows)
+ END DO
+ ENDIF
+ !
+ ENDIF
+ !
+ l_trd = .FALSE.
+ l_hst = .FALSE.
+ l_ptr = .FALSE.
+ IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
+ IF( l_diaptr .AND. cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE.
+ IF( l_iom .AND. cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &
+ & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE.
+ ENDIF
+ !
+ !
+ DO jn = 1, kjpt !== loop over the tracers ==!
+ !
+ DO jk = 1, jpkm1
+ ! !* Horizontal advective fluxes
+ !
+ ! !-- first guess of the slopes
+ DO_2D( 2, 1, 2, 1 )
+ zdxt(ji,jj) = ( pt(ji+1,jj ,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) * umask(ji,jj,jk)
+ zdyt(ji,jj) = ( pt(ji ,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) * vmask(ji,jj,jk)
+ END_2D
+ ! !-- Slopes of tracer
+ DO_2D( 1, 1, 1, 1 )
+ ! ! 1/2 Slopes at T-point (set to 0 if adjectent slopes are of opposite sign)
+ zzslpx = ( zdxt(ji,jj) + zdxt(ji-1,jj ) ) &
+ & * ( 0.25_wp + SIGN( 0.25_wp, zdxt(ji,jj) * zdxt(ji-1,jj ) ) )
+ zzslpy = ( zdyt(ji,jj) + zdyt(ji ,jj-1) ) &
+ & * ( 0.25_wp + SIGN( 0.25_wp, zdyt(ji,jj) * zdyt(ji ,jj-1) ) )
+ ! ! Slopes limitation
+ zslpx(ji,jj) = SIGN( 1.0_wp, zzslpx ) * MIN( ABS( zzslpx ), &
+ & 2._wp*ABS( zdxt (ji-1,jj) ), &
+ & 2._wp*ABS( zdxt (ji ,jj) ) )
+ zslpy(ji,jj) = SIGN( 1.0_wp, zzslpy ) * MIN( ABS( zzslpy ), &
+ & 2._wp*ABS( zdyt (ji,jj-1) ), &
+ & 2._wp*ABS( zdyt (ji,jj ) ) )
+ END_2D
+!!gm + !!st ticket ? comparaison pommes et carrottes ABS(zzslpx) et 2._wp*ABS( zdxt (ji-1,jj) )
+ !
+ DO_2D( 1, 0, 1, 0 ) !-- MUSCL horizontal advective fluxes
+ z0u = SIGN( 0.5_wp, pU(ji,jj,jk) )
+ zalpha = 0.5_wp - z0u
+ zu = z0u - 0.5_wp * pU(ji,jj,jk) * p2dt * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm)
+ zzwx = pt(ji+1,jj,jk,jn,Kbb) + xind(ji,jj,jk) * zu * zslpx(ji+1,jj)
+ zzwy = pt(ji ,jj,jk,jn,Kbb) + xind(ji,jj,jk) * zu * zslpx(ji ,jj)
+ zwx(ji,jj) = pU(ji,jj,jk) * ( zalpha * zzwx + (1._wp-zalpha) * zzwy )
+ !
+ z0v = SIGN( 0.5_wp, pV(ji,jj,jk) )
+ zalpha = 0.5_wp - z0v
+ zv = z0v - 0.5_wp * pV(ji,jj,jk) * p2dt * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm)
+ zzwx = pt(ji,jj+1,jk,jn,Kbb) + xind(ji,jj,jk) * zv * zslpy(ji,jj+1)
+ zzwy = pt(ji,jj ,jk,jn,Kbb) + xind(ji,jj,jk) * zv * zslpy(ji,jj )
+ zwy(ji,jj) = pV(ji,jj,jk) * ( zalpha * zzwx + (1._wp-zalpha) * zzwy )
+ END_2D
+ !
+ DO_2D( 0, 0, 0, 0 ) !-- Tracer advective trend
+ pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( zwx(ji,jj) - zwx(ji-1,jj ) &
+ & + zwy(ji,jj) - zwy(ji ,jj-1) ) &
+ & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+ END_2D
+ END DO
+!!gm + !!st to be done with the whole rewritting of trd
+!! trd routine arguments MUST be changed adding jk and zwx, zwy in 2D
+!!
+!! ! ! trend diagnostics
+!! IF( l_trd ) THEN
+!! CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jk, jptra_xad, zwx(:,:), pU, pt(:,:,:,jn,Kbb) )
+!! CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jk, jptra_yad, zwy(:,:), pV, pt(:,:,:,jn,Kbb) )
+!! END IF
+!! ! ! "Poleward" heat and salt transports
+!! IF( l_ptr ) CALL dia_ptr_hst( jn, jk, 'adv', zwy(:,:) )
+!! ! ! heat transport
+!! IF( l_hst ) CALL dia_ar5_hst( jn, jk, 'adv', zwx(:,:), zwy(:,:) )
+ !
+ ! !* Vertical advective fluxes
+ !
+#define zdzt_kp1 zdxt
+#define zslpz zslpx
+#define zfW zwx
+
+ zfW (A2D(0)) = 0._wp ! anciennement zwx at jk = 1
+ ! ! anciennement zwx at jk = 2
+ DO_2D( 0, 0, 0, 0 )
+ zdzt_kp1(ji,jj) = tmask(ji,jj,2) * ( pt(ji,jj,1,jn,Kbb) - pt(ji,jj,2,jn,Kbb) )
+ END_2D
+ zslpz (A2D(0)) = 0._wp ! anciennement zslpx at jk = 1
+ !
+ IF( ln_linssh ) THEN !-- linear ssh : non zero top values
+ DO_2D( 0, 0, 0, 0 ) ! at the ocean surface
+ zfW(ji,jj) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kbb) ! surface flux
+ END_2D
+ IF( ln_isfcav ) THEN ! ice-shelf cavities (top of the ocean)
+ DO_2D( 0, 0, 0, 0 ) ! update pt(Krhs) under the ice-shelf
+ ik = mikt(ji,jj) ! the flux at ik-1 is zero ( inside ice-shelf )
+ IF( ik > 1 ) THEN
+ pt(ji,jj,ik,jn,Krhs) = pt(ji,jj,ik,jn,Krhs) - pW(ji,jj,ik) * pt(ji,jj,ik,jn,Kbb) &
+ & * r1_e1e2t(ji,jj) / e3t(ji,jj,ik,Kmm)
+ ENDIF
+ END_2D
+ ENDIF
+ ENDIF
+ !
+ ! wmask usage for computing zw and zwk is needed in isf case and linear ssh
+ !
+ !
+ DO jk = 1, jpkm1
+ IF( jk < jpkm1 ) THEN
+ DO_2D( 0, 0, 0, 0 )
+ ! !-- Slopes of tracer
+ ! ! masked vertical gradient at jk+2
+ zdzt_kp2 = ( pt(ji,jj,jk+1,jn,Kbb) - pt(ji,jj,jk+2,jn,Kbb) ) * tmask(ji,jj,jk+2) !!st wmask(ji,jj,jk+2)
+ ! ! vertical slope at jk+1
+ zslpz_kp1 = ( zdzt_kp1(ji,jj) + zdzt_kp2 ) &
+ & * ( 0.25_wp + SIGN( 0.25_wp, zdzt_kp1(ji,jj) * zdzt_kp2 ) )
+ ! ! slope limitation
+ zslpz_kp1 = SIGN( 1.0_wp, zslpz_kp1 ) * MIN( ABS( zslpz_kp1 ), &
+ & 2.*ABS( zdzt_kp2 ), &
+ & 2.*ABS( zdzt_kp1(ji,jj) ) )
+ ! !-- vertical advective flux at jk+1
+ ! ! caution: zfW_kp1 is masked for ice-shelf cavities
+ ! ! since top fluxes already added to pt(Krhs) before the vertical loop
+ z0w = SIGN( 0.5_wp, pW(ji,jj,jk+1) )
+ zalpha = 0.5_wp + z0w
+ zw = z0w - 0.5_wp * pW(ji,jj,jk+1) * p2dt * r1_e1e2t(ji,jj) / e3w(ji,jj,jk+1,Kmm)
+ zzwx = pt(ji,jj,jk+1,jn,Kbb) + xind(ji,jj,jk) * zw * zslpz_kp1
+ zzwy = pt(ji,jj,jk ,jn,Kbb) + xind(ji,jj,jk) * zw * zslpz(ji,jj)
+ zfW_kp1 = pW(ji,jj,jk+1) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) * wmask(ji,jj,jk)!!st * wmask(ji,jj,jk+1)
+ ! !-- vertical advective trend at jk
+ pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( zfW(ji,jj) - zfW_kp1 ) &
+ & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+ ! ! updates for next level
+ zdzt_kp1(ji,jj) = zdzt_kp2
+ zslpz (ji,jj) = zslpz_kp1
+ zfW (ji,jj) = zfW_kp1
+ END_2D
+ ELSE
+ DO_2D( 0, 0, 0, 0 ) !-- vertical advective trend at jpkm1
+ pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - zfW(ji,jj) &
+ & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+ END_2D
+ ENDIF
+ END DO ! end of jk loop
+ !
+!!gm + !!st idem see above
+!! ! ! send trends for diagnostic
+!! IF( l_trd ) CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zwx, pW, pt(:,:,:,jn,Kbb) )
+ !
+ END DO ! end of tracer loop
+ !
+ END SUBROUTINE tra_adv_mus
+
+
+ SUBROUTINE tra_adv_mus_hls1( kt, kit000, cdtype, p2dt, pU, pV, pW, &
& Kbb, Kmm, pt, kjpt, Krhs, ld_msc_ups )
!!----------------------------------------------------------------------
!! *** ROUTINE tra_adv_mus ***
@@ -178,7 +392,7 @@ CONTAINS
!
DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !-- Tracer advective trend
pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) &
- & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) ) &
+ & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) ) &
& * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
END_3D
! ! trend diagnostics
@@ -187,7 +401,7 @@ CONTAINS
CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, zwy, pV, pt(:,:,:,jn,Kbb) )
END IF
! ! "Poleward" heat and salt transports
- IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) )
+ IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', zwy(A2D(0),:) )
! ! heat transport
IF( l_hst ) CALL dia_ar5_hst( jn, 'adv', zwx(:,:,:), zwy(:,:,:) )
!
@@ -239,7 +453,7 @@ CONTAINS
!
END DO ! end of tracer loop
!
- END SUBROUTINE tra_adv_mus
+ END SUBROUTINE tra_adv_mus_hls1
!!======================================================================
END MODULE traadv_mus
diff --git a/src/OCE/TRA/traadv_qck.F90 b/src/OCE/TRA/traadv_qck.F90
index cdb96902b43fea6bb976a8b0f55b4b4cad5bb74a..f3976bbd03597fa9af2b8fb9abcd494dd2ae7677 100644
--- a/src/OCE/TRA/traadv_qck.F90
+++ b/src/OCE/TRA/traadv_qck.F90
@@ -301,7 +301,7 @@ CONTAINS
! ! trend diagnostics
IF( l_trd ) CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, zwy, pV, pt(:,:,:,jn,Kmm) )
! ! "Poleward" heat and salt transports (contribution of upstream fluxes)
- IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) )
+ IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', zwy(A2D(0),:) )
!
END DO
!
diff --git a/src/OCE/TRA/traadv_qck_lf.F90 b/src/OCE/TRA/traadv_qck_lf.F90
index e866bd80944f4aef98bc4cafd829acda452d085e..e3746d601639dca88b5a929cad7e212456ff9643 100644
--- a/src/OCE/TRA/traadv_qck_lf.F90
+++ b/src/OCE/TRA/traadv_qck_lf.F90
@@ -268,7 +268,7 @@ CONTAINS
! ! trend diagnostics
IF( l_trd ) CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, zwy, pV, pt(:,:,:,jn,Kmm) )
! ! "Poleward" heat and salt transports (contribution of upstream fluxes)
- IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) )
+ IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', zwy(A2D(0),:) )
!
END DO
!
diff --git a/src/OCE/TRA/traadv_ubs.F90 b/src/OCE/TRA/traadv_ubs.F90
index 6d65af219fcdad959749963efcf98ad20d3c42e1..94d7833301bd11b37ea18017eac8f3a15aaf2197 100644
--- a/src/OCE/TRA/traadv_ubs.F90
+++ b/src/OCE/TRA/traadv_ubs.F90
@@ -184,7 +184,7 @@ CONTAINS
END IF
!
! ! "Poleward" heat and salt transports (contribution of upstream fluxes)
- IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', ztv(:,:,:) )
+ IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', ztv(A2D(0),:) )
! ! heati/salt transport
IF( l_hst ) CALL dia_ar5_hst( jn, 'adv', ztu(:,:,:), ztv(:,:,:) )
!
diff --git a/src/OCE/TRA/traadv_ubs_lf.F90 b/src/OCE/TRA/traadv_ubs_lf.F90
index ee8acfe2922ef27a36be5c6a0372ae0ea083b20a..07b3d5e343e4f0bf96f542ffc120d3cffa60e3d1 100644
--- a/src/OCE/TRA/traadv_ubs_lf.F90
+++ b/src/OCE/TRA/traadv_ubs_lf.F90
@@ -190,7 +190,7 @@ CONTAINS
END IF
!
! ! "Poleward" heat and salt transports (contribution of upstream fluxes)
- IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', ztv(:,:,:) )
+ IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', ztv(A2D(0),:) )
! ! heati/salt transport
IF( l_hst ) CALL dia_ar5_hst( jn, 'adv', ztu(:,:,:), ztv(:,:,:) )
!
diff --git a/src/OCE/TRA/traatf.F90 b/src/OCE/TRA/traatf.F90
index 57a9ca0a47851146bcfd09c7a769c70ad6a69663..ec745d779916e30f0ebbeeb51714683d427d662a 100644
--- a/src/OCE/TRA/traatf.F90
+++ b/src/OCE/TRA/traatf.F90
@@ -207,7 +207,7 @@ CONTAINS
!
DO jn = 1, kjpt
!
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
ztn = pt(ji,jj,jk,jn,Kmm)
ztd = pt(ji,jj,jk,jn,Kaa) - 2._wp * ztn + pt(ji,jj,jk,jn,Kbb) ! time laplacian on tracers
!
@@ -238,8 +238,8 @@ CONTAINS
CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)
INTEGER , INTENT(in ) :: kjpt ! number of tracers
REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracer fields
- REAL(wp), DIMENSION(jpi,jpj ,kjpt) , INTENT(in ) :: psbc_tc ! surface tracer content
- REAL(wp), DIMENSION(jpi,jpj ,kjpt) , INTENT(in ) :: psbc_tc_b ! before surface tracer content
+ REAL(wp), DIMENSION(A2D(0) ,kjpt) , INTENT(in ) :: psbc_tc ! surface tracer content
+ REAL(wp), DIMENSION(A2D(0) ,kjpt) , INTENT(in ) :: psbc_tc_b ! before surface tracer content
!
LOGICAL :: ll_traqsr, ll_rnf, ll_isf ! local logical
INTEGER :: ji, jj, jk, jn ! dummy loop indices
@@ -269,14 +269,11 @@ CONTAINS
ztrd_atf(:,:,:,:) = 0.0_wp
ENDIF
!
-!!st variables only computed in the interior by traqsr
- IF( ll_traqsr ) CALL lbc_lnk( 'traatf', qsr_hc_b(:,:,:) , 'T', 1.0_wp, qsr_hc(:,:,:) , 'T', 1.0_wp )
- !
zfact = 1._wp / p2dt
zfact1 = rn_atfp * p2dt
zfact2 = zfact1 * r1_rho0
DO jn = 1, kjpt
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
ze3t_b = e3t(ji,jj,jk,Kbb)
ze3t_n = e3t(ji,jj,jk,Kmm)
ze3t_a = e3t(ji,jj,jk,Kaa)
diff --git a/src/OCE/TRA/traatf_qco.F90 b/src/OCE/TRA/traatf_qco.F90
index 57034bd06088f54863e35898473f9a6c64f2323a..5563febbee37c5a28cd2212924c9d5cab64d8d4a 100644
--- a/src/OCE/TRA/traatf_qco.F90
+++ b/src/OCE/TRA/traatf_qco.F90
@@ -150,7 +150,7 @@ CONTAINS
ELSE ; CALL tra_atf_qco_lf( kt, Kbb, Kmm, Kaa, nit000, rn_Dt, 'TRA', pts, sbc_tsc, sbc_tsc_b, jpts ) ! non-linear free surface
ENDIF
!
- CALL lbc_lnk( 'traatfqco', pts(:,:,:,jp_tem,Kmm) , 'T', 1._wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1._wp )
+ CALL lbc_lnk( 'traatf_qco', pts(:,:,:,jp_tem,Kmm) , 'T', 1._wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1._wp )
!
ENDIF
!
@@ -203,7 +203,6 @@ CONTAINS
DO jn = 1, kjpt
!
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
-!!st DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
ztn = pt(ji,jj,jk,jn,Kmm)
ztd = pt(ji,jj,jk,jn,Kaa) - 2._wp * ztn + pt(ji,jj,jk,jn,Kbb) ! time laplacian on tracers
!
@@ -234,8 +233,8 @@ CONTAINS
CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)
INTEGER , INTENT(in ) :: kjpt ! number of tracers
REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracer fields
- REAL(wp), DIMENSION(jpi,jpj ,kjpt) , INTENT(in ) :: psbc_tc ! surface tracer content
- REAL(wp), DIMENSION(jpi,jpj ,kjpt) , INTENT(in ) :: psbc_tc_b ! before surface tracer content
+ REAL(wp), DIMENSION(A2D(0) ,kjpt) , INTENT(in ) :: psbc_tc ! surface tracer content
+ REAL(wp), DIMENSION(A2D(0) ,kjpt) , INTENT(in ) :: psbc_tc_b ! before surface tracer content
!
LOGICAL :: ll_traqsr, ll_rnf, ll_isf ! local logical
INTEGER :: ji, jj, jk, jn ! dummy loop indices
@@ -264,12 +263,12 @@ CONTAINS
ALLOCATE( ztrd_atf(jpi,jpj,jpk,kjpt) )
ztrd_atf(:,:,:,:) = 0._wp
ENDIF
+ !
zfact = 1._wp / p2dt
zfact1 = rn_atfp * p2dt
zfact2 = zfact1 * r1_rho0
DO jn = 1, kjpt
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
-!!st DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
ze3t_b = e3t(ji,jj,jk,Kbb)
ze3t_n = e3t(ji,jj,jk,Kmm)
ze3t_a = e3t(ji,jj,jk,Kaa)
diff --git a/src/OCE/TRA/tradmp.F90 b/src/OCE/TRA/tradmp.F90
index 16cab127eece4aed8c9dd7378ce67a2090acccc2..16420352883c63b529d1cca3852b61758946f1c1 100644
--- a/src/OCE/TRA/tradmp.F90
+++ b/src/OCE/TRA/tradmp.F90
@@ -94,7 +94,7 @@ CONTAINS
REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation
!
INTEGER :: ji, jj, jk, jn ! dummy loop indices
- REAL(wp), DIMENSION(A2D(nn_hls),jpk,jpts) :: zts_dta
+ REAL(wp), DIMENSION(A2D(nn_hls),jpk,jpts) :: zts_dta
REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: zwrk
REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: ztrdts
!!----------------------------------------------------------------------
@@ -146,7 +146,7 @@ CONTAINS
!
! outputs (clem trunk)
IF( iom_use('hflx_dmp_cea') .OR. iom_use('sflx_dmp_cea') ) THEN
- ALLOCATE( zwrk(A2D(nn_hls),jpk) ) ! Needed to handle expressions containing e3t when using key_qco or key_linssh
+ ALLOCATE( zwrk(A2D(0),jpk) ) ! Needed to handle expressions containing e3t when using key_qco or key_linssh
zwrk(:,:,:) = 0._wp
IF( iom_use('hflx_dmp_cea') ) THEN
diff --git a/src/OCE/TRA/traldf_iso.F90 b/src/OCE/TRA/traldf_iso.F90
index 8d84e76891bb958dec0bd0c1b561d7e8cb894f66..d814e0584aeb6aa94991302f7fb1d57bc75258df 100644
--- a/src/OCE/TRA/traldf_iso.F90
+++ b/src/OCE/TRA/traldf_iso.F90
@@ -388,7 +388,7 @@ CONTAINS
!
! ! "Poleward" diffusive heat or salt transports (T-S case only)
! note sign is reversed to give down-gradient diffusive transports )
- IF( l_ptr ) CALL dia_ptr_hst( jn, 'ldf', -zftv(:,:,:) )
+ IF( l_ptr ) CALL dia_ptr_hst( jn, 'ldf', -zftv(A2D(0),:) )
! ! Diffusive heat transports
IF( l_hst ) CALL dia_ar5_hst( jn, 'ldf', -zftu(:,:,:), -zftv(:,:,:) )
!
diff --git a/src/OCE/TRA/traldf_lap_blp.F90 b/src/OCE/TRA/traldf_lap_blp.F90
index 16e5df16cdfb7ca8c542f8fc40d6061a84979c13..1bb51569d3928f70f96f5377a0cd637843a15f03 100644
--- a/src/OCE/TRA/traldf_lap_blp.F90
+++ b/src/OCE/TRA/traldf_lap_blp.F90
@@ -171,7 +171,7 @@ CONTAINS
IF( ( kpass == 1 .AND. .NOT.ln_traldf_blp ) .OR. & !== first pass only ( laplacian) ==!
( kpass == 2 .AND. ln_traldf_blp ) ) THEN !== 2nd pass only (bilaplacian) ==!
- IF( l_ptr ) CALL dia_ptr_hst( jn, 'ldf', -ztv(:,:,:) )
+ IF( l_ptr ) CALL dia_ptr_hst( jn, 'ldf', -ztv(A2D(0),:) )
IF( l_hst ) CALL dia_ar5_hst( jn, 'ldf', -ztu(:,:,:), -ztv(:,:,:) )
ENDIF
! ! ==================
diff --git a/src/OCE/TRA/traldf_triad.F90 b/src/OCE/TRA/traldf_triad.F90
index 19039b88c12d763f483faede1d5fa33ec2c9a10e..0b341db589874d92f39a7bf38cdde84856d575aa 100644
--- a/src/OCE/TRA/traldf_triad.F90
+++ b/src/OCE/TRA/traldf_triad.F90
@@ -485,7 +485,7 @@ CONTAINS
( kpass == 2 .AND. ln_traldf_blp ) ) THEN !== 2nd pass (bilaplacian) ==!
!
! ! "Poleward" diffusive heat or salt transports (T-S case only)
- IF( l_ptr ) CALL dia_ptr_hst( jn, 'ldf', zftv(:,:,:) )
+ IF( l_ptr ) CALL dia_ptr_hst( jn, 'ldf', zftv(A2D(0),:) )
! ! Diffusive heat transports
IF( l_hst ) CALL dia_ar5_hst( jn, 'ldf', zftu(:,:,:), zftv(:,:,:) )
!
diff --git a/src/OCE/TRA/trasbc.F90 b/src/OCE/TRA/trasbc.F90
index 0f8472a324a1753f8c1f128f1bd28e339a297643..b0cc6580bf3bd35a6f1a961bcaff4207fdc89f51 100644
--- a/src/OCE/TRA/trasbc.F90
+++ b/src/OCE/TRA/trasbc.F90
@@ -100,7 +100,7 @@ CONTAINS
!
!!gm This should be moved into sbcmod.F90 module ? (especially now that ln_traqsr is read in namsbc namelist)
IF( .NOT.ln_traqsr ) THEN ! no solar radiation penetration
- DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D_OVR( 0, 0, 0, 0 )
qns(ji,jj) = qns(ji,jj) + qsr(ji,jj) ! total heat flux in qns
qsr(ji,jj) = 0._wp ! qsr set to zero
END_2D
@@ -121,24 +121,24 @@ CONTAINS
ENDIF
ELSE ! No restart or restart not found: Euler forward time stepping
zfact = 1._wp
- DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D_OVR( 0, 0, 0, 0 )
sbc_tsc(ji,jj,:) = 0._wp
sbc_tsc_b(ji,jj,:) = 0._wp
END_2D
ENDIF
ELSE !* other time-steps: swap of forcing fields
zfact = 0.5_wp
- DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D_OVR( 0, 0, 0, 0 )
sbc_tsc_b(ji,jj,:) = sbc_tsc(ji,jj,:)
END_2D
ENDIF
! !== Now sbc tracer content fields ==!
- DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D_OVR( 0, 0, 0, 0 )
sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj) ! non solar heat flux
sbc_tsc(ji,jj,jp_sal) = r1_rho0 * sfx(ji,jj) ! salt flux due to freezing/melting
END_2D
IF( ln_linssh ) THEN !* linear free surface
- DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) !==>> add concentration/dilution effect due to constant volume cell
+ DO_2D_OVR( 0, 0, 0, 0 ) !==>> add concentration/dilution effect due to constant volume cell
sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_tem,Kmm)
sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_sal,Kmm)
END_2D !==>> output c./d. term
@@ -275,7 +275,7 @@ CONTAINS
!!gm This should be moved into sbcmod.F90 module ? (especially now that ln_traqsr is read in namsbc namelist)
IF( .NOT.ln_traqsr .AND. kstg == 1) THEN ! no solar radiation penetration
- DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D_OVR( 0, 0, 0, 0 )
qns(ji,jj) = qns(ji,jj) + qsr(ji,jj) ! total heat flux in qns
qsr(ji,jj) = 0._wp ! qsr set to zero
END_2D
diff --git a/src/OCE/TRA/trazdf.F90 b/src/OCE/TRA/trazdf.F90
index 8280d3181b6b2731e8616a0a24a938bd15b4d759..7123aeba37c7fe1419e207dd89407a28d569e25e 100644
--- a/src/OCE/TRA/trazdf.F90
+++ b/src/OCE/TRA/trazdf.F90
@@ -6,6 +6,7 @@ MODULE trazdf
!! History : 1.0 ! 2005-11 (G. Madec) Original code
!! 3.0 ! 2008-01 (C. Ethe, G. Madec) merge TRC-TRA
!! 4.0 ! 2017-06 (G. Madec) remove explict time-stepping option
+ !! 4.5 ! 2022-06 (G. Madec) refactoring to reduce memory usage (j-k-i loops)
!!----------------------------------------------------------------------
!!----------------------------------------------------------------------
@@ -22,7 +23,7 @@ MODULE trazdf
USE ldfslp ! lateral diffusion: iso-neutral slope
USE trd_oce ! trends: ocean variables
USE trdtra ! trends: tracer trend manager
- USE eosbn2, ONLY: ln_SEOS, rn_b0
+ USE eosbn2 , ONLY: ln_SEOS, rn_b0
!
USE in_out_manager ! I/O manager
USE prtctl ! Print control
@@ -77,7 +78,7 @@ CONTAINS
ENDIF
!
! !* compute lateral mixing trend and add it to the general trend
- CALL tra_zdf_imp( kt, nit000, 'TRA', rDt, Kbb, Kmm, Krhs, pts, Kaa, jpts )
+ CALL tra_zdf_imp( 'TRA', Kbb, Kmm, Krhs, pts, Kaa, jpts )
!!gm WHY here ! and I don't like that !
! DRAKKAR SSS control {
@@ -116,7 +117,7 @@ CONTAINS
END SUBROUTINE tra_zdf
- SUBROUTINE tra_zdf_imp( kt, kit000, cdtype, p2dt, Kbb, Kmm, Krhs, pt, Kaa, kjpt )
+ SUBROUTINE tra_zdf_imp( cdtype, Kbb, Kmm, Krhs, pt, Kaa, kjpt )
!!----------------------------------------------------------------------
!! *** ROUTINE tra_zdf_imp ***
!!
@@ -136,128 +137,177 @@ CONTAINS
!!
!! ** Action : - pt(:,:,:,:,Kaa) becomes the after tracer
!!---------------------------------------------------------------------
- INTEGER , INTENT(in ) :: kt ! ocean time-step index
INTEGER , INTENT(in ) :: Kbb, Kmm, Krhs, Kaa ! ocean time level indices
- INTEGER , INTENT(in ) :: kit000 ! first time step index
CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)
INTEGER , INTENT(in ) :: kjpt ! number of tracers
- REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step
REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation
!
INTEGER :: ji, jj, jk, jn ! dummy loop indices
REAL(wp) :: zrhs, zzwi, zzws ! local scalars
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zwi, zwt, zwd, zws
+ REAL(wp), DIMENSION(A1Di(0),jpk) :: zwi, zwt, zwd, zws
!!---------------------------------------------------------------------
!
- ! ! ============= !
- DO jn = 1, kjpt ! tracer loop !
- ! ! ============= !
- ! Matrix construction
- ! --------------------
- ! Build matrix if temperature or salinity (only in double diffusion case) or first passive tracer
- !
- IF( ( cdtype == 'TRA' .AND. ( jn == jp_tem .OR. ( jn == jp_sal .AND. ln_zdfddm ) ) ) .OR. &
- & ( cdtype == 'TRC' .AND. jn == 1 ) ) THEN
+ ! ! ================= !
+ DO_1Dj( 0, 0 ) ! i-k slices loop !
+ ! ! ================= !
+ DO jn = 1, kjpt ! tracer loop !
+ ! ! ================= !
!
- ! vertical mixing coef.: avt for temperature, avs for salinity and passive tracers
- IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN
- DO_3D( 1, 1, 1, 1, 2, jpk )
- zwt(ji,jj,jk) = avt(ji,jj,jk)
- END_3D
- ELSE
- DO_3D( 1, 1, 1, 1, 2, jpk )
- zwt(ji,jj,jk) = avs(ji,jj,jk)
- END_3D
- ENDIF
- zwt(:,:,1) = 0._wp
+ ! Matrix construction
+ ! --------------------
+ ! Build matrix if temperature or salinity (only in double diffusion case) or first passive tracer
!
- IF( l_ldfslp ) THEN ! isoneutral diffusion: add the contribution
- IF( ln_traldf_msc ) THEN ! MSC iso-neutral operator
- DO_3D( 0, 0, 0, 0, 2, jpkm1 )
- zwt(ji,jj,jk) = zwt(ji,jj,jk) + akz(ji,jj,jk)
- END_3D
- ELSE ! standard or triad iso-neutral operator
- DO_3D( 0, 0, 0, 0, 2, jpkm1 )
- zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk)
- END_3D
+ IF( ( cdtype == 'TRA' .AND. ( jn == jp_tem .OR. ( jn == jp_sal .AND. ln_zdfddm ) ) ) .OR. &
+ & ( cdtype == 'TRC' .AND. jn == 1 ) ) THEN
+ !
+ ! vertical mixing coef.: avt for temperature, avs for salinity and passive tracers
+ !
+ IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN ! use avt for temperature
+ !
+ IF( l_ldfslp ) THEN ! use avt + isoneutral diffusion contribution
+ IF( ln_traldf_msc ) THEN ! MSC iso-neutral operator
+ DO_2Dik( 0, 0, 2, jpk, 1 )
+ zwt(ji,jk) = avt(ji,jj,jk) + akz(ji,jj,jk)
+ END_2D
+ ELSE ! standard or triad iso-neutral operator
+ DO_2Dik( 0, 0, 2, jpk, 1 )
+ zwt(ji,jk) = avt(ji,jj,jk) + ah_wslp2(ji,jj,jk)
+ END_2D
+ ENDIF
+ ELSE ! use avt only
+ DO_2Dik( 0, 0, 2, jpk, 1 )
+ zwt(ji,jk) = avt(ji,jj,jk)
+ END_2D
+ ENDIF
+ !
+ ELSE ! use avs for salinty or passive tracers
+ !
+ IF( l_ldfslp ) THEN ! use avs + isoneutral diffusion contribution
+ IF( ln_traldf_msc ) THEN ! MSC iso-neutral operator
+ DO_2Dik( 0, 0, 2, jpk, 1 )
+ zwt(ji,jk) = avs(ji,jj,jk) + akz(ji,jj,jk)
+ END_2D
+ ELSE ! standard or triad iso-neutral operator
+ DO_2Dik( 0, 0, 2, jpk, 1 )
+ zwt(ji,jk) = avs(ji,jj,jk) + ah_wslp2(ji,jj,jk)
+ END_2D
+ ENDIF
+ ELSE !
+ DO_2Dik( 0, 0, 2, jpk, 1 )
+ zwt(ji,jk) = avs(ji,jj,jk)
+ END_2D
+ ENDIF
ENDIF
+ zwt(:,1) = 0._wp
+ !
+ ! Diagonal, lower (i), upper (s) (including the bottom boundary condition since avt is masked)
+ IF( ln_zad_Aimp ) THEN ! Adaptive implicit vertical advection
+ DO_2Dik( 0, 0, 1, jpkm1, 1 )
+ zzwi = - rDt * zwt(ji,jk ) / e3w(ji,jj,jk ,Kmm)
+ zzws = - rDt * zwt(ji,jk+1) / e3w(ji,jj,jk+1,Kmm)
+ zwd(ji,jk) = e3t(ji,jj,jk,Kaa) - zzwi - zzws &
+ & + rDt * ( MAX( wi(ji,jj,jk ) , 0._wp ) &
+ & - MIN( wi(ji,jj,jk+1) , 0._wp ) )
+ zwi(ji,jk) = zzwi + rDt * MIN( wi(ji,jj,jk ) , 0._wp )
+ zws(ji,jk) = zzws - rDt * MAX( wi(ji,jj,jk+1) , 0._wp )
+ END_2D
+ ELSE
+ DO_2Dik( 0, 0, 1, jpkm1, 1 )
+ zwi(ji,jk) = - rDt * zwt(ji,jk ) / e3w(ji,jj,jk,Kmm)
+ zws(ji,jk) = - rDt * zwt(ji,jk+1) / e3w(ji,jj,jk+1,Kmm)
+ zwd(ji,jk) = e3t(ji,jj,jk,Kaa) - zwi(ji,jk) - zws(ji,jk)
+ END_2D
+ ENDIF
+ !
+!!gm BUG?? : if edmfm is equivalent to a w ==>>> just add +/- rDt * edmfm(ji,jj,jk+1/jk )
+!! but edmfm is at t-point !!!! crazy??? why not keep it at w-point????
+ !
+ IF( ln_zdfmfc ) THEN ! add upward Mass Flux in the matrix
+ DO_2Dik( 0, 0, 1, jpkm1, 1 )
+ zws(ji,jk) = zws(ji,jk) + e3t(ji,jj,jk,Kaa) * rDt * edmfm(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm)
+ zwd(ji,jk) = zwd(ji,jk) - e3t(ji,jj,jk,Kaa) * rDt * edmfm(ji,jj,jk ) / e3w(ji,jj,jk+1,Kmm)
+ END_2D
+ ENDIF
+! DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+! edmfa(ji,jj,jk) = 0._wp
+! edmfb(ji,jj,jk) = -edmfm(ji,jj,jk ) / e3w(ji,jj,jk+1,Kmm)
+! edmfc(ji,jj,jk) = edmfm(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm)
+! END_3D
+!!gm BUG : level jpk never used in the inversion
+! DO_2D( 0, 0, 0, 0 )
+! edmfa(ji,jj,jpk) = -edmfm(ji,jj,jpk-1) / e3w(ji,jj,jpk,Kmm)
+! edmfb(ji,jj,jpk) = edmfm(ji,jj,jpk ) / e3w(ji,jj,jpk,Kmm)
+! edmfc(ji,jj,jpk) = 0._wp
+! END_2D
+!!
+!!gm BUG ??? below e3t_Kmm should be used ?
+!! or even no multiplication by e3t unless there is a bug in wi calculation
+!!
+! DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+!!gm edmfa = 0._wp except at jpk which is not used ==>> zdiagi update is useless !
+! zdiagi(ji,jj,jk) = zdiagi(ji,jj,jk) + e3t(ji,jj,jk,Kaa) * p2dt *edmfa(ji,jj,jk)
+! zdiags(ji,jj,jk) = zdiags(ji,jj,jk) + e3t(ji,jj,jk,Kaa) * p2dt *edmfc(ji,jj,jk)
+! zdiagd(ji,jj,jk) = zdiagd(ji,jj,jk) + e3t(ji,jj,jk,Kaa) * p2dt *edmfb(ji,jj,jk)
+! END_3D
+!!gm CALL diag_mfc( zwi, zwd, zws, rDt, Kaa )
+!!gm SUBROUTINE diag_mfc( zdiagi, zdiagd, zdiags, p2dt, Kaa )
+ !
+ !! Matrix inversion from the first level
+ !!----------------------------------------------------------------------
+ ! solve m.x = y where m is a tri diagonal matrix ( jpk*jpk )
+ !
+ ! ( zwd1 zws1 0 0 0 )( zwx1 ) ( zwy1 )
+ ! ( zwi2 zwd2 zws2 0 0 )( zwx2 ) ( zwy2 )
+ ! ( 0 zwi3 zwd3 zws3 0 )( zwx3 )=( zwy3 )
+ ! ( ... )( ... ) ( ... )
+ ! ( 0 0 0 zwik zwdk )( zwxk ) ( zwyk )
+ !
+ ! m is decomposed in the product of an upper and lower triangular matrix.
+ ! The 3 diagonal terms are in 3d arrays: zwd, zws, zwi.
+ ! Suffices i,s and d indicate "inferior" (below diagonal), diagonal
+ ! and "superior" (above diagonal) components of the tridiagonal system.
+ ! The solution will be in the 4d array pta.
+ ! The 3d array zwt is used as a work space array.
+ ! En route to the solution pt(:,:,:,:,Kaa) is used a to evaluate the rhs and then
+ ! used as a work space array: its value is modified.
+ !
+ DO_1Di( 0, 0 ) !* 1st recurrence: Tk = Dk - Ik Sk-1 / Tk-1 (increasing k) ! done one for all passive tracers (so included in the IF instruction)
+ zwt(ji,1) = zwd(ji,1)
+ END_1D
+ DO_2Dik( 0, 0, 2, jpkm1, 1 )
+ zwt(ji,jk) = zwd(ji,jk) - zwi(ji,jk) * zws(ji,jk-1) / zwt(ji,jk-1)
+ END_2D
+ !
ENDIF
!
- ! Diagonal, lower (i), upper (s) (including the bottom boundary condition since avt is masked)
- IF( ln_zad_Aimp ) THEN ! Adaptive implicit vertical advection
- DO_3D( 0, 0, 0, 0, 1, jpkm1 )
- zzwi = - p2dt * zwt(ji,jj,jk ) / e3w(ji,jj,jk ,Kmm)
- zzws = - p2dt * zwt(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm)
- zwd(ji,jj,jk) = e3t(ji,jj,jk,Kaa) - zzwi - zzws &
- & + p2dt * ( MAX( wi(ji,jj,jk ) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) )
- zwi(ji,jj,jk) = zzwi + p2dt * MIN( wi(ji,jj,jk ) , 0._wp )
- zws(ji,jj,jk) = zzws - p2dt * MAX( wi(ji,jj,jk+1) , 0._wp )
- END_3D
- ELSE
- DO_3D( 0, 0, 0, 0, 1, jpkm1 )
- zwi(ji,jj,jk) = - p2dt * zwt(ji,jj,jk ) / e3w(ji,jj,jk,Kmm)
- zws(ji,jj,jk) = - p2dt * zwt(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm)
- zwd(ji,jj,jk) = e3t(ji,jj,jk,Kaa) - zwi(ji,jj,jk) - zws(ji,jj,jk)
- END_3D
+ IF( ln_zdfmfc ) THEN ! add Mass Flux to the RHS
+ DO_2Dik( 0, 0, 1, jpkm1, 1 )
+ pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) + edmftra(ji,jj,jk,jn)
+ END_2D
+!!gm CALL rhs_mfc( pt(:,:,:,jn,Krhs), jn )
ENDIF
!
- ! Modification of diagonal to add MF scheme
- IF ( ln_zdfmfc ) THEN
- CALL diag_mfc( zwi, zwd, zws, p2dt, Kaa )
- END IF
- !
- !! Matrix inversion from the first level
- !!----------------------------------------------------------------------
- ! solve m.x = y where m is a tri diagonal matrix ( jpk*jpk )
- !
- ! ( zwd1 zws1 0 0 0 )( zwx1 ) ( zwy1 )
- ! ( zwi2 zwd2 zws2 0 0 )( zwx2 ) ( zwy2 )
- ! ( 0 zwi3 zwd3 zws3 0 )( zwx3 )=( zwy3 )
- ! ( ... )( ... ) ( ... )
- ! ( 0 0 0 zwik zwdk )( zwxk ) ( zwyk )
- !
- ! m is decomposed in the product of an upper and lower triangular matrix.
- ! The 3 diagonal terms are in 3d arrays: zwd, zws, zwi.
- ! Suffices i,s and d indicate "inferior" (below diagonal), diagonal
- ! and "superior" (above diagonal) components of the tridiagonal system.
- ! The solution will be in the 4d array pta.
- ! The 3d array zwt is used as a work space array.
- ! En route to the solution pt(:,:,:,:,Kaa) is used a to evaluate the rhs and then
- ! used as a work space array: its value is modified.
- !
- DO_2D( 0, 0, 0, 0 ) !* 1st recurrence: Tk = Dk - Ik Sk-1 / Tk-1 (increasing k) ! done one for all passive tracers (so included in the IF instruction)
- zwt(ji,jj,1) = zwd(ji,jj,1)
+ DO_1Di( 0, 0 ) !* 2nd recurrence: Zk = Yk - Ik / Tk-1 Zk-1
+ pt(ji,jj,1,jn,Kaa) = e3t(ji,jj,1,Kbb) * pt(ji,jj,1,jn,Kbb ) &
+ & + rDt * e3t(ji,jj,1,Kmm) * pt(ji,jj,1,jn,Krhs)
+ END_1D
+ DO_2Dik( 0, 0, 2, jpkm1, 1 )
+ zrhs = e3t(ji,jj,jk,Kbb) * pt(ji,jj,jk,jn,Kbb ) &
+ & + rDt * e3t(ji,jj,jk,Kmm) * pt(ji,jj,jk,jn,Krhs) ! zrhs=right hand side
+ pt(ji,jj,jk,jn,Kaa) = zrhs - zwi(ji,jk) / zwt(ji,jk-1) * pt(ji,jj,jk-1,jn,Kaa)
END_2D
- DO_3D( 0, 0, 0, 0, 2, jpkm1 )
- zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwt(ji,jj,jk-1)
- END_3D
!
- ENDIF
- !
- ! Modification of rhs to add MF scheme
- IF ( ln_zdfmfc ) THEN
- CALL rhs_mfc( pt(:,:,:,jn,Krhs), jn )
- END IF
- !
- DO_2D( 0, 0, 0, 0 ) !* 2nd recurrence: Zk = Yk - Ik / Tk-1 Zk-1
- pt(ji,jj,1,jn,Kaa) = e3t(ji,jj,1,Kbb) * pt(ji,jj,1,jn,Kbb) &
- & + p2dt * e3t(ji,jj,1,Kmm) * pt(ji,jj,1,jn,Krhs)
- END_2D
- DO_3D( 0, 0, 0, 0, 2, jpkm1 )
- zrhs = e3t(ji,jj,jk,Kbb) * pt(ji,jj,jk,jn,Kbb) &
- & + p2dt * e3t(ji,jj,jk,Kmm) * pt(ji,jj,jk,jn,Krhs) ! zrhs=right hand side
- pt(ji,jj,jk,jn,Kaa) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * pt(ji,jj,jk-1,jn,Kaa)
- END_3D
- !
- DO_2D( 0, 0, 0, 0 ) !* 3d recurrence: Xk = (Zk - Sk Xk+1 ) / Tk (result is the after tracer)
- pt(ji,jj,jpkm1,jn,Kaa) = pt(ji,jj,jpkm1,jn,Kaa) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1)
- END_2D
- DO_3DS( 0, 0, 0, 0, jpk-2, 1, -1 )
- pt(ji,jj,jk,jn,Kaa) = ( pt(ji,jj,jk,jn,Kaa) - zws(ji,jj,jk) * pt(ji,jj,jk+1,jn,Kaa) ) &
- & / zwt(ji,jj,jk) * tmask(ji,jj,jk)
- END_3D
+ DO_1Di( 0, 0 ) !* 3d recurrence: Xk = (Zk - Sk Xk+1 ) / Tk (result is the after tracer)
+ pt(ji,jj,jpkm1,jn,Kaa) = pt(ji,jj,jpkm1,jn,Kaa) / zwt(ji,jpkm1) * tmask(ji,jj,jpkm1)
+ END_1D
+ DO_2Dik( 0, 0, jpk-2, 1, -1 )
+ pt(ji,jj,jk,jn,Kaa) = ( pt(ji,jj,jk,jn,Kaa) - zws(ji,jk) * pt(ji,jj,jk+1,jn,Kaa) ) &
+ & / zwt(ji,jk) * tmask(ji,jj,jk)
+ END_2D
+ ! ! ================= !
+ END DO ! tracer loop !
! ! ================= !
- END DO ! end tracer loop !
+ END_1D ! i-k slices loop !
! ! ================= !
END SUBROUTINE tra_zdf_imp
diff --git a/src/OCE/TRA/zpshde.F90 b/src/OCE/TRA/zpshde.F90
index 2b786d65e30aee97c385ab35e5f84951a51eb130..0591067f9e804265264b6aae3adb49d98dbfa6eb 100644
--- a/src/OCE/TRA/zpshde.F90
+++ b/src/OCE/TRA/zpshde.F90
@@ -164,7 +164,7 @@ CONTAINS
END_2D
END DO
!
- IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond.
+ IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgtu, 'U', -1.0_wp , pgtv, 'V', -1.0_wp ) ! Lateral boundary cond.
!
IF( PRESENT( prd ) ) THEN !== horizontal derivative of density anomalies (rd) ==! (optional part)
pgru(:,:) = 0._wp
@@ -343,7 +343,7 @@ CONTAINS
END_2D
END DO
!
- IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond.
+ IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgtu, 'U', -1.0_wp , pgtv, 'V', -1.0_wp ) ! Lateral boundary cond.
! horizontal derivative of density anomalies (rd)
IF( PRESENT( prd ) ) THEN ! depth of the partial step level
@@ -436,7 +436,7 @@ CONTAINS
END_2D
!
END DO
- IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgtui(:,:,:), 'U', -1.0_wp , pgtvi(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond.
+ IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgtui, 'U', -1.0_wp , pgtvi, 'V', -1.0_wp ) ! Lateral boundary cond.
IF( PRESENT( prd ) ) THEN !== horizontal derivative of density anomalies (rd) ==! (optional part)
!
diff --git a/src/OCE/USR/usrdef_fmask.F90 b/src/OCE/USR/usrdef_fmask.F90
index bc97a2edf925254ca4604227ffe31eae3f3d723e..d1e0d482524aeafae8f7c958562297327f9b81fe 100644
--- a/src/OCE/USR/usrdef_fmask.F90
+++ b/src/OCE/USR/usrdef_fmask.F90
@@ -69,25 +69,25 @@ CONTAINS
IF(lwp) WRITE(numout,*) ' Gibraltar '
ij0 = 101 + nn_hls ; ij1 = 101 + nn_hls ! Gibraltar strait : partial slip (pfmsk=0.5)
ii0 = 139 + nn_hls - 1 ; ii1 = 140 + nn_hls - 1
- pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 0.5_wp
+ pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls) , mj0(ij0,nn_hls):mj1(ij1,nn_hls) , 1:jpk ) = 0.5_wp
ij0 = 102 + nn_hls ; ij1 = 102 + nn_hls
ii0 = 139 + nn_hls - 1 ; ii1 = 140 + nn_hls - 1
- pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 0.5_wp
+ pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls) , mj0(ij0,nn_hls):mj1(ij1,nn_hls) , 1:jpk ) = 0.5_wp
!
IF(lwp) WRITE(numout,*) ' Bab el Mandeb '
ij0 = 87 + nn_hls ; ij1 = 88 + nn_hls ! Bab el Mandeb : partial slip (pfmsk=1)
ii0 = 160 + nn_hls - 1 ; ii1 = 160 + nn_hls - 1
- pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 1._wp
+ pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls) , mj0(ij0,nn_hls):mj1(ij1,nn_hls) , 1:jpk ) = 1._wp
ij0 = 88 + nn_hls ; ij1 = 88 + nn_hls
ii0 = 159 + nn_hls - 1 ; ii1 = 159 + nn_hls - 1
- pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 1._wp
+ pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls) , mj0(ij0,nn_hls):mj1(ij1,nn_hls) , 1:jpk ) = 1._wp
!
! We keep this as an example but it is instable in this case
!IF(lwp) WRITE(numout,*) ' Danish straits '
! ij0 = 115 ; ij1 = 115 ! Danish straits : strong slip (pfmsk > 2)
- ! ii0 = 145 ; ii1 = 146 ; pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp
+ ! ii0 = 145 ; ii1 = 146 ; pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls) , mj0(ij0,nn_hls):mj1(ij1,nn_hls) , 1:jpk ) = 4._wp
! ij0 = 116 ; ij1 = 116
- ! ii0 = 145 ; ii1 = 146 ; pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp
+ ! ii0 = 145 ; ii1 = 146 ; pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls) , mj0(ij0,nn_hls):mj1(ij1,nn_hls) , 1:jpk ) = 4._wp
!
CASE( 1 ) ! R1 case
IF(lwp) WRITE(numout,*)
@@ -104,42 +104,42 @@ CONTAINS
IF(lwp) WRITE(numout,*) ' Gibraltar '
ii0 = 282 + nn_hls - 1 ; ii1 = 283 + nn_hls - 1 ! Gibraltar Strait
ij0 = 241 + nn_hls - isrow ; ij1 = 241 + nn_hls - isrow
- pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp
+ pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls),mj0(ij0,nn_hls):mj1(ij1,nn_hls),1:jpk ) = 2._wp
!
IF(lwp) WRITE(numout,*) ' Bhosporus '
ii0 = 314 + nn_hls - 1 ; ii1 = 315 + nn_hls - 1 ! Bhosporus Strait
ij0 = 248 + nn_hls - isrow ; ij1 = 248 + nn_hls - isrow
- pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp
+ pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls),mj0(ij0,nn_hls):mj1(ij1,nn_hls),1:jpk ) = 2._wp
!
IF(lwp) WRITE(numout,*) ' Makassar (Top) '
ii0 = 48 + nn_hls - 1 ; ii1 = 48 + nn_hls - 1 ! Makassar Strait (Top)
ij0 = 189 + nn_hls - isrow ; ij1 = 190 + nn_hls - isrow
- pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp
+ pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls),mj0(ij0,nn_hls):mj1(ij1,nn_hls),1:jpk ) = 3._wp
!
IF(lwp) WRITE(numout,*) ' Lombok '
ii0 = 44 + nn_hls - 1 ; ii1 = 44 + nn_hls - 1 ! Lombok Strait
ij0 = 164 + nn_hls - isrow ; ij1 = 165 + nn_hls - isrow
- pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp
+ pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls),mj0(ij0,nn_hls):mj1(ij1,nn_hls),1:jpk ) = 2._wp
!
IF(lwp) WRITE(numout,*) ' Ombai '
ii0 = 53 + nn_hls - 1 ; ii1 = 53 + nn_hls - 1 ! Ombai Strait
ij0 = 164 + nn_hls - isrow ; ij1 = 165 + nn_hls - isrow
- pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp
+ pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls),mj0(ij0,nn_hls):mj1(ij1,nn_hls),1:jpk ) = 2._wp
!
IF(lwp) WRITE(numout,*) ' Timor Passage '
ii0 = 56 + nn_hls - 1 ; ii1 = 56 + nn_hls - 1 ! Timor Passage
ij0 = 164 + nn_hls - isrow ; ij1 = 165 + nn_hls - isrow
- pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp
+ pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls),mj0(ij0,nn_hls):mj1(ij1,nn_hls),1:jpk ) = 2._wp
!
IF(lwp) WRITE(numout,*) ' West Halmahera '
ii0 = 58 + nn_hls - 1 ; ii1 = 58 + nn_hls - 1 ! West Halmahera Strait
ij0 = 181 + nn_hls - isrow ; ij1 = 182 + nn_hls - isrow
- pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp
+ pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls),mj0(ij0,nn_hls):mj1(ij1,nn_hls),1:jpk ) = 3._wp
!
IF(lwp) WRITE(numout,*) ' East Halmahera '
ii0 = 55 + nn_hls - 1 ; ii1 = 55 + nn_hls - 1 ! East Halmahera Strait
ij0 = 181 + nn_hls - isrow ; ij1 = 182 + nn_hls - isrow
- pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp
+ pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls),mj0(ij0,nn_hls):mj1(ij1,nn_hls),1:jpk ) = 3._wp
!
CASE DEFAULT
IF(lwp) WRITE(numout,*)
diff --git a/src/OCE/USR/usrdef_hgr.F90 b/src/OCE/USR/usrdef_hgr.F90
index 2f617b552235a7b19c9cad93e777a785bcca0884..cbcb3ff8e94f3db7cb6d7d78b44aad78e1f683c6 100644
--- a/src/OCE/USR/usrdef_hgr.F90
+++ b/src/OCE/USR/usrdef_hgr.F90
@@ -115,8 +115,8 @@ CONTAINS
ENDIF
!
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- zim1 = REAL( mig0(ji), wp ) - 1. ; zim05 = REAL( mig0(ji), wp ) - 1.5
- zjm1 = REAL( mjg0(jj), wp ) - 1. ; zjm05 = REAL( mjg0(jj), wp ) - 1.5
+ zim1 = REAL( mig(ji,0), wp ) - 1. ; zim05 = REAL( mig(ji,0), wp ) - 1.5
+ zjm1 = REAL( mjg(jj,0), wp ) - 1. ; zjm05 = REAL( mjg(jj,0), wp ) - 1.5
!
!glamt(i,j) longitude at T-point
!gphit(i,j) latitude at T-point
diff --git a/src/OCE/USR/usrdef_sbc.F90 b/src/OCE/USR/usrdef_sbc.F90
index 2af3f30d2789fe3cfafadda55d4141c9c38c95b8..0be3bd7e98fc014cf9ae38301933a870dcb89998 100644
--- a/src/OCE/USR/usrdef_sbc.F90
+++ b/src/OCE/USR/usrdef_sbc.F90
@@ -109,7 +109,7 @@ CONTAINS
ztrp= - 40.e0 ! retroaction term on heat fluxes (W/m2/K)
zconv = 3.16e-5 ! convertion factor: 1 m/yr => 3.16e-5 mm/s
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! emp and rnf used in sshwzv over the whole domain
+ DO_2D( 0, 0, 0, 0 )
! domain from 15 deg to 50 deg between 27 and 28 degC at 15N, -3
! and 13 degC at 50N 53.5 + or - 11 = 1/4 period :
! 64.5 in summer, 42.5 in winter
@@ -119,6 +119,8 @@ CONTAINS
! 23.5 deg : tropics
qsr (ji,jj) = 230 * COS( 3.1415 * ( gphit(ji,jj) - 23.5 * zcos_sais1 ) / ( 0.9 * 180 ) )
qns (ji,jj) = ztrp * ( ts(ji,jj,1,jp_tem,Kbb) - t_star ) - qsr(ji,jj)
+ END_2D
+ DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! emp and rnf used in sshwzv over the whole domain
IF( gphit(ji,jj) >= 14.845 .AND. 37.2 >= gphit(ji,jj) ) THEN ! zero at 37.8 deg, max at 24.6 deg
emp (ji,jj) = zemp_S * zconv &
& * SIN( rpi / 2 * (gphit(ji,jj) - 37.2) / (24.6 - 37.2) ) &
@@ -137,6 +139,8 @@ CONTAINS
! freshwater (mass flux) and update of qns with heat content of emp
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! emp used in sshwzv over the whole domain
emp (ji,jj) = emp(ji,jj) - zsumemp * tmask(ji,jj,1) ! freshwater flux (=0 in domain average)
+ END_2D
+ DO_2D( 0, 0, 0, 0 )
sfx (ji,jj) = 0.0_wp ! no salt flux
qns (ji,jj) = qns(ji,jj) - emp(ji,jj) * sst_m(ji,jj) * rcp ! evap and precip are at SST
END_2D
@@ -175,7 +179,7 @@ CONTAINS
! module of wind stress and wind speed at T-point
zcoef = 1. / ( zrhoa * zcdrag )
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zmod = SQRT( utau(ji,jj) * utau(ji,jj) + vtau(ji,jj) * vtau(ji,jj) )
taum(ji,jj) = zmod
wndm(ji,jj) = SQRT( zmod * zcoef )
diff --git a/src/OCE/ZDF/zdf_oce.F90 b/src/OCE/ZDF/zdf_oce.F90
index 40bcb56ce9b07a1c3ac51ffd51d45f310e0c64fa..bb470370d8c0ad72b2ae89d8a11e3a499cdb274b 100644
--- a/src/OCE/ZDF/zdf_oce.F90
+++ b/src/OCE/ZDF/zdf_oce.F90
@@ -53,6 +53,8 @@ MODULE zdf_oce
REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) :: avmb , avtb !: background profile of avm and avt [m2/s]
REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: avtb_2d !: horizontal shape of background Kz profile [-]
+ !! * Substitutions
+# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
!! $Id: zdf_oce.F90 14072 2020-12-04 07:48:38Z laurent $
@@ -65,9 +67,9 @@ CONTAINS
!! *** FUNCTION zdf_oce_alloc ***
!!----------------------------------------------------------------------
!
- ALLOCATE( avm (jpi,jpj,jpk) , avm_k(jpi,jpj,jpk) , avs(jpi,jpj,jpk) , &
- & avt (jpi,jpj,jpk) , avt_k(jpi,jpj,jpk) , en (jpi,jpj,jpk) , &
- & avmb(jpk) , avtb(jpk) , avtb_2d(jpi,jpj) , STAT = zdf_oce_alloc )
+ ALLOCATE( avm (jpi,jpj,jpk) , avm_k(jpi,jpj,jpk) , avs(A2D(0),jpk) , &
+ & avt (A2D(0) ,jpk) , avt_k(A2D(0) ,jpk) , en (A2D(0),jpk) , &
+ & avmb(jpk) , avtb(jpk) , avtb_2d(A2D(0)) , STAT = zdf_oce_alloc )
!
IF( zdf_oce_alloc /= 0 ) CALL ctl_stop( 'STOP', 'zdf_oce_alloc: failed to allocate arrays' )
!
diff --git a/src/OCE/ZDF/zdfddm.F90 b/src/OCE/ZDF/zdfddm.F90
index a08cf3439b254cff6f6864f7eee3f7052aed3ae6..3004091bbada80c8b929f2f56567384f61c5350a 100644
--- a/src/OCE/ZDF/zdfddm.F90
+++ b/src/OCE/ZDF/zdfddm.F90
@@ -70,9 +70,9 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER, INTENT(in ) :: kt ! ocean time-step index
INTEGER, INTENT(in ) :: Kmm ! ocean time level index
- REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: p_avm ! Kz on momentum (w-points)
- REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: p_avt ! Kz on temperature (w-points)
- REAL(wp), DIMENSION(:,:,:), INTENT( out) :: p_avs ! Kz on salinity (w-points)
+ REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: p_avm ! Kz on momentum (w-points)
+ REAL(wp), DIMENSION(A2D(0),jpk), INTENT(inout) :: p_avt ! Kz on temperature (w-points)
+ REAL(wp), DIMENSION(A2D(0),jpk), INTENT( out) :: p_avs ! Kz on salinity (w-points)
!
INTEGER :: ji, jj , jk ! dummy loop indices
REAL(wp) :: zaw, zbw, zrw ! local scalars
@@ -82,7 +82,7 @@ CONTAINS
REAL(wp) :: zavft ! - -
REAL(dp) :: zavfs ! - -
REAL(wp) :: zavdt, zavds ! - -
- REAL(wp), DIMENSION(A2D(nn_hls)) :: zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3
+ REAL(wp), DIMENSION(A2D(0)) :: zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3
!!----------------------------------------------------------------------
!
! ! ===============
@@ -94,7 +94,7 @@ CONTAINS
!!gm ==>>> test in the loop instead of use of mask arrays
!!gm and many acces in memory
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) !== R=zrau = (alpha / beta) (dk[t] / dk[s]) ==!
+ DO_2D( 0, 0, 0, 0 ) !== R=zrau = (alpha / beta) (dk[t] / dk[s]) ==!
zrw = ( gdepw(ji,jj,jk ,Kmm) - gdept(ji,jj,jk,Kmm) ) &
!!gm please, use e3w at Kmm below
& / ( gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm) )
@@ -110,7 +110,7 @@ CONTAINS
zrau(ji,jj) = MAX( 1.e-20, zdt / zds ) ! only retains positive value of zrau
END_2D
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) !== indicators ==!
+ DO_2D( 0, 0, 0, 0 ) !== indicators ==!
! stability indicator: msks=1 if rn2>0; 0 elsewhere
IF( rn2(ji,jj,jk) + 1.e-12 <= 0. ) THEN ; zmsks(ji,jj) = 0._wp
ELSE ; zmsks(ji,jj) = 1._wp * wmask(ji,jj,jk) ! mask so avt and avs masked
@@ -137,7 +137,7 @@ CONTAINS
! Update avt and avs
! ------------------
! Constant eddy coefficient: reset to the background value
- DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D_OVR( 0, 0, 0, 0 )
zinr = 1._wp / zrau(ji,jj)
! salt fingering
zrr = zrau(ji,jj) / rn_hsbfr
diff --git a/src/OCE/ZDF/zdfevd.F90 b/src/OCE/ZDF/zdfevd.F90
index df8bfeaa5b701b30b19d265031f0b0732d803bac..6d821700029b0048aefb6f55417cde387797dd0b 100644
--- a/src/OCE/ZDF/zdfevd.F90
+++ b/src/OCE/ZDF/zdfevd.F90
@@ -56,9 +56,10 @@ CONTAINS
!!
!! ** Action : avt, avm enhanced where static instability occurs
!!----------------------------------------------------------------------
- INTEGER , INTENT(in ) :: kt ! ocean time-step indexocean time step
- INTEGER , INTENT(in ) :: Kmm, Krhs ! time level indices
- REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: p_avm, p_avt ! momentum and tracer Kz (w-points)
+ INTEGER , INTENT(in ) :: kt ! ocean time-step indexocean time step
+ INTEGER , INTENT(in ) :: Kmm, Krhs ! time level indices
+ REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: p_avm ! momentum Kz (w-points)
+ REAL(wp), DIMENSION(A2D(0),jpk), INTENT(inout) :: p_avt ! tracer Kz (w-points)
!
INTEGER :: ji, jj, jk ! dummy loop indices
! NOTE: [tiling] use a SAVE array to store diagnostics, then send after all tiles are finished. This is necessary because p_avt/p_avm are modified on adjacent tiles when using nn_hls > 1. zavt_evd/zavm_evd are then zero on some points when subsequently calculated for these tiles.
@@ -73,12 +74,12 @@ CONTAINS
IF(lwp) WRITE(numout,*)
ENDIF
- ALLOCATE( zavt_evd(jpi,jpj,jpk) )
- IF( nn_evdm == 1 ) ALLOCATE( zavm_evd(jpi,jpj,jpk) )
+ ALLOCATE( zavt_evd(A2D(0),jpk) )
+ IF( nn_evdm == 1 ) ALLOCATE( zavm_evd(A2D(0),jpk) )
ENDIF
!
!
- DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )
+ DO_3D_OVR( 0, 0, 0, 0, 1, jpk )
zavt_evd(ji,jj,jk) = p_avt(ji,jj,jk) ! set avt prior to evd application
END_3D
!
@@ -86,7 +87,7 @@ CONTAINS
!
CASE ( 1 ) !== enhance tracer & momentum Kz ==! (if rn2<-1.e-12)
!
- DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )
+ DO_3D_OVR( 0, 0, 0, 0, 1, jpk )
zavm_evd(ji,jj,jk) = p_avm(ji,jj,jk) ! set avm prior to evd application
END_3D
!
@@ -96,14 +97,14 @@ CONTAINS
! p_avm(2:jpi,2:jpj,2:jpkm1) = rn_evd * wmask(2:jpi,2:jpj,2:jpkm1)
! END WHERE
!
- DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
+ DO_3D_OVR( 0, 0, 0, 0, 1, jpkm1 )
IF( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) THEN
p_avt(ji,jj,jk) = rn_evd * wmask(ji,jj,jk)
p_avm(ji,jj,jk) = rn_evd * wmask(ji,jj,jk)
ENDIF
END_3D
!
- DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )
+ DO_3D_OVR( 0, 0, 0, 0, 1, jpk )
zavm_evd(ji,jj,jk) = p_avm(ji,jj,jk) - zavm_evd(ji,jj,jk) ! change in avm due to evd
END_3D
IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN ! Do only on the last tile
@@ -117,14 +118,14 @@ CONTAINS
! p_avt(2:jpi,2:jpj,2:jpkm1) = rn_evd * wmask(2:jpi,2:jpj,2:jpkm1)
! END WHERE
- DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
+ DO_3D_OVR( 0, 0, 0, 0, 1, jpkm1 )
IF( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) &
p_avt(ji,jj,jk) = rn_evd * wmask(ji,jj,jk)
END_3D
!
END SELECT
!
- DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )
+ DO_3D_OVR( 0, 0, 0, 0, 1, jpk )
zavt_evd(ji,jj,jk) = p_avt(ji,jj,jk) - zavt_evd(ji,jj,jk) ! change in avt due to evd
END_3D
!
diff --git a/src/OCE/ZDF/zdfgls.F90 b/src/OCE/ZDF/zdfgls.F90
index b25670799dae097c9853dfdda687a3743aeea10a..f44ccc814faf6b6e84f425af23e6f0dfbb449c5c 100644
--- a/src/OCE/ZDF/zdfgls.F90
+++ b/src/OCE/ZDF/zdfgls.F90
@@ -126,8 +126,8 @@ CONTAINS
!!----------------------------------------------------------------------
!! *** FUNCTION zdf_gls_alloc ***
!!----------------------------------------------------------------------
- ALLOCATE( hmxl_n(jpi,jpj,jpk) , ustar2_surf(jpi,jpj) , &
- & zwall (jpi,jpj,jpk) , ustar2_top (jpi,jpj) , ustar2_bot(jpi,jpj) , STAT= zdf_gls_alloc )
+ ALLOCATE( hmxl_n(A2D(0),jpk) , ustar2_surf(A2D(0)) , &
+ & zwall (A2D(0),jpk) , ustar2_top (A2D(0)) , ustar2_bot(A2D(0)) , STAT= zdf_gls_alloc )
!
CALL mpp_sum ( 'zdfgls', zdf_gls_alloc )
IF( zdf_gls_alloc /= 0 ) CALL ctl_stop( 'STOP', 'zdf_gls_alloc: failed to allocate arrays' )
@@ -143,10 +143,11 @@ CONTAINS
!!----------------------------------------------------------------------
USE zdf_oce , ONLY : en, avtb, avmb ! ocean vertical physics
!!
- INTEGER , INTENT(in ) :: kt ! ocean time step
- INTEGER , INTENT(in ) :: Kbb, Kmm ! ocean time level indices
- REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(in ) :: p_sh2 ! shear production term
- REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: p_avm, p_avt ! momentum and tracer Kz (w-points)
+ INTEGER , INTENT(in ) :: kt ! ocean time step
+ INTEGER , INTENT(in ) :: Kbb, Kmm ! ocean time level indices
+ REAL(wp), DIMENSION(A2D(0),jpk), INTENT(in ) :: p_sh2 ! shear production term
+ REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: p_avm ! momentum Kz (w-points)
+ REAL(wp), DIMENSION(A2D(0),jpk), INTENT(inout) :: p_avt ! tracer Kz (w-points)
!
INTEGER :: ji, jj, jk ! dummy loop arguments
INTEGER :: ibot, ibotm1 ! local integers
@@ -157,51 +158,51 @@ CONTAINS
REAL(wp) :: prod, buoy, diss, zdiss, sm ! - -
REAL(wp) :: gh, gm, shr, dif, zsqen, zavt, zavm ! - -
REAL(wp) :: zmsku, zmskv ! - -
- REAL(wp), DIMENSION(A2D(nn_hls)) :: zdep
- REAL(wp), DIMENSION(A2D(nn_hls)) :: zkar
- REAL(wp), DIMENSION(A2D(nn_hls)) :: zflxs ! Turbulence fluxed induced by internal waves
- REAL(wp), DIMENSION(A2D(nn_hls)) :: zhsro ! Surface roughness (surface waves)
- REAL(wp), DIMENSION(A2D(nn_hls)) :: zice_fra ! Tapering of wave breaking under sea ice
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: eb ! tke at time before
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: hmxl_b ! mixing length at time before
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: eps ! dissipation rate
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zwall_psi ! Wall function use in the wb case (ln_sigpsi)
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: psi ! psi at time now
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zd_lw, zd_up, zdiag ! lower, upper and diagonal of the matrix
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zstt, zstm ! stability function on tracer and momentum
+ REAL(wp), DIMENSION(A2D(0)) :: zdep
+ REAL(wp), DIMENSION(A2D(0)) :: zkar
+ REAL(wp), DIMENSION(A2D(0)) :: zflxs ! Turbulence fluxed induced by internal waves
+ REAL(wp), DIMENSION(A2D(0)) :: zhsro ! Surface roughness (surface waves)
+ REAL(wp), DIMENSION(A2D(0)) :: zice_fra ! Tapering of wave breaking under sea ice
+ REAL(wp), DIMENSION(A2D(0),jpk) :: eb ! tke at time before
+ REAL(wp), DIMENSION(A2D(0),jpk) :: hmxl_b ! mixing length at time before
+ REAL(wp), DIMENSION(A2D(0),jpk) :: eps ! dissipation rate
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zwall_psi ! Wall function use in the wb case (ln_sigpsi)
+ REAL(wp), DIMENSION(A2D(0),jpk) :: psi ! psi at time now
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zd_lw, zd_up, zdiag ! lower, upper and diagonal of the matrix
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zstt, zstm ! stability function on tracer and momentum
!!--------------------------------------------------------------------
!
! Preliminary computing
- DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D_OVR( 0, 0, 0, 0 )
ustar2_surf(ji,jj) = 0._wp ; ustar2_top(ji,jj) = 0._wp ; ustar2_bot(ji,jj) = 0._wp
END_2D
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )
+ DO_3D( 0, 0, 0, 0, 1, jpk )
psi(ji,jj,jk) = 0._wp ; zwall_psi(ji,jj,jk) = 0._wp
END_3D
SELECT CASE ( nn_z0_ice )
CASE( 0 ) ; zice_fra(:,:) = 0._wp
- CASE( 1 ) ; zice_fra(:,:) = TANH( fr_i(A2D(nn_hls)) * 10._wp )
- CASE( 2 ) ; zice_fra(:,:) = fr_i(A2D(nn_hls))
- CASE( 3 ) ; zice_fra(:,:) = MIN( 4._wp * fr_i(A2D(nn_hls)) , 1._wp )
+ CASE( 1 ) ; zice_fra(:,:) = TANH( fr_i(A2D(0)) * 10._wp )
+ CASE( 2 ) ; zice_fra(:,:) = fr_i(A2D(0))
+ CASE( 3 ) ; zice_fra(:,:) = MIN( 4._wp * fr_i(A2D(0)) , 1._wp )
END SELECT
! Compute surface, top and bottom friction at T-points
- DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) !== surface ocean friction
+ DO_2D_OVR( 0, 0, 0, 0 ) !== surface ocean friction
ustar2_surf(ji,jj) = r1_rho0 * taum(ji,jj) * tmask(ji,jj,1) ! surface friction
END_2D
!
!!gm Rq we may add here r_ke0(_top/_bot) ? ==>> think about that...
!
IF( .NOT.ln_drg_OFF ) THEN !== top/bottom friction (explicit before friction)
- DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! bottom friction (explicit before friction)
+ DO_2D_OVR( 0, 0, 0, 0 ) ! bottom friction (explicit before friction)
zmsku = 0.5_wp * ( 2._wp - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) )
zmskv = 0.5_wp * ( 2._wp - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) ) ! (CAUTION: CdU<0)
ustar2_bot(ji,jj) = - rCdU_bot(ji,jj) * SQRT( ( zmsku*( uu(ji,jj,mbkt(ji,jj),Kbb)+uu(ji-1,jj,mbkt(ji,jj),Kbb) ) )**2 &
& + ( zmskv*( vv(ji,jj,mbkt(ji,jj),Kbb)+vv(ji,jj-1,mbkt(ji,jj),Kbb) ) )**2 )
END_2D
IF( ln_isfcav ) THEN
- DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! top friction
+ DO_2D_OVR( 0, 0, 0, 0 ) ! top friction
zmsku = 0.5_wp * ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) )
zmskv = 0.5_wp * ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) ) ! (CAUTION: CdU<0)
ustar2_top(ji,jj) = - rCdU_top(ji,jj) * SQRT( ( zmsku*( uu(ji,jj,mikt(ji,jj),Kbb)+uu(ji-1,jj,mikt(ji,jj),Kbb) ) )**2 &
@@ -214,57 +215,59 @@ CONTAINS
CASE ( 0 ) ! Constant roughness
zhsro(:,:) = rn_hsro
CASE ( 1 ) ! Standard Charnock formula
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D( 0, 0, 0, 0 )
zhsro(ji,jj) = MAX( rsbc_zs1 * ustar2_surf(ji,jj) , rn_hsro )
END_2D
CASE ( 2 ) ! Roughness formulae according to Rascle et al., Ocean Modelling (2008)
!!gm faster coding : the 2 comment lines should be used
!!gm zcof = 2._wp * 0.6_wp / 28._wp
!!gm zdep(:,:) = 30._wp * TANH( zcof/ SQRT( MAX(ustar2_surf(:,:),rsmall) ) ) ! Wave age (eq. 10)
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D( 0, 0, 0, 0 )
zcof = 30.*TANH( 2.*0.3/(28.*SQRT(MAX(ustar2_surf(ji,jj),rsmall))) ) ! Wave age (eq. 10)
zhsro(ji,jj) = MAX(rsbc_zs2 * ustar2_surf(ji,jj) * zcof**1.5, rn_hsro) ! zhsro = rn_frac_hs * Hsw (eq. 11)
END_2D
CASE ( 3 ) ! Roughness given by the wave model (coupled or read in file)
- zhsro(:,:) = MAX(rn_frac_hs * hsw(A2D(nn_hls)), rn_hsro) ! (rn_frac_hs=1.6 see Eq. (5) of Rascle et al. 2008 )
+ DO_2D( 0, 0, 0, 0 )
+ zhsro(ji,jj) = MAX(rn_frac_hs * hsw(ji,jj), rn_hsro) ! (rn_frac_hs=1.6 see Eq. (5) of Rascle et al. 2008 )
+ END_2D
END SELECT
!
! adapt roughness where there is sea ice
SELECT CASE( nn_mxlice ) ! Type of scaling under sea-ice
!
CASE( 1 ) ! scaling with constant sea-ice roughness
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D( 0, 0, 0, 0 )
zhsro(ji,jj) = ( (1._wp-zice_fra(ji,jj)) * zhsro(ji,jj) + zice_fra(ji,jj) * rn_hsri )*tmask(ji,jj,1) + (1._wp - tmask(ji,jj,1))*rn_hsro
END_2D
!
CASE( 2 ) ! scaling with mean sea-ice thickness
#if defined key_si3
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D( 0, 0, 0, 0 )
zhsro(ji,jj) = ( (1._wp-zice_fra(ji,jj)) * zhsro(ji,jj) + zice_fra(ji,jj) * hm_i(ji,jj) )*tmask(ji,jj,1) + (1._wp - tmask(ji,jj,1))*rn_hsro
END_2D
#endif
!
CASE( 3 ) ! scaling with max sea-ice thickness
#if defined key_si3 || defined key_cice
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D( 0, 0, 0, 0 )
zhsro(ji,jj) = ( (1._wp-zice_fra(ji,jj)) * zhsro(ji,jj) + zice_fra(ji,jj) * MAXVAL(h_i(ji,jj,:)) )*tmask(ji,jj,1) + (1._wp - tmask(ji,jj,1))*rn_hsro
END_2D
#endif
!
END SELECT
!
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) !== Compute dissipation rate ==!
+ DO_3D( 0, 0, 0, 0, 2, jpkm1 ) !== Compute dissipation rate ==!
eps(ji,jj,jk) = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / hmxl_n(ji,jj,jk)
END_3D
! Save tke at before time step
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )
+ DO_3D( 0, 0, 0, 0, 1, jpk )
eb (ji,jj,jk) = en (ji,jj,jk)
hmxl_b(ji,jj,jk) = hmxl_n(ji,jj,jk)
END_3D
IF( nn_clos == 0 ) THEN ! Mellor-Yamada
- DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+ DO_3D_OVR( 0, 0, 0, 0, 2, jpkm1 )
zup = hmxl_n(ji,jj,jk) * gdepw(ji,jj,mbkt(ji,jj)+1,Kmm)
zdown = vkarmn * gdepw(ji,jj,jk,Kmm) * ( -gdepw(ji,jj,jk,Kmm) + gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) )
zcoef = ( zup / MAX( zdown, rsmall ) )
@@ -285,7 +288,7 @@ CONTAINS
! zdiag : diagonal zd_up : upper diagonal zd_lw : lower diagonal
! Warning : after this step, en : right hand side of the matrix
- DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+ DO_3D_OVR( 0, 0, 0, 0, 2, jpkm1 )
!
buoy = - p_avt(ji,jj,jk) * rn2(ji,jj,jk) ! stratif. destruction
!
@@ -326,7 +329,7 @@ CONTAINS
en(ji,jj,jk) = en(ji,jj,jk) + rn_Dt * zesh2 * wmask(ji,jj,jk)
END_3D
!
- DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D_OVR( 0, 0, 0, 0 )
zdiag(ji,jj,jpk) = 1._wp
!
! Set surface condition on zwall_psi (1 at the bottom)
@@ -340,7 +343,7 @@ CONTAINS
SELECT CASE ( nn_bc_surf )
!
CASE ( 0 ) ! Dirichlet boundary condition (set e at k=1 & 2)
- DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D_OVR( 0, 0, 0, 0 )
! First level
en (ji,jj,1) = MAX( rn_emin , rc02r * ustar2_surf(ji,jj) * (1._wp + (1._wp-zice_fra(ji,jj))*rsbc_tke1)**r2_3 )
zd_lw(ji,jj,1) = en(ji,jj,1)
@@ -356,7 +359,7 @@ CONTAINS
END_2D
!
IF( ln_isfcav) THEN ! top boundary (ocean cavity)
- DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D_OVR( 0, 0, 0, 0 )
IF( mikt(ji,jj) > 1 )THEN
itop = mikt(ji,jj) ! k top w-point
itopp1 = mikt(ji,jj) + 1 ! k+1 1st w-point below the top one
@@ -377,7 +380,7 @@ CONTAINS
!
CASE ( 1 ) ! Neumann boundary condition (set d(e)/dz)
!
- DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D_OVR( 0, 0, 0, 0 )
! Dirichlet conditions at k=1
en (ji,jj,1) = MAX( rn_emin , rc02r * ustar2_surf(ji,jj) * (1._wp + (1._wp-zice_fra(ji,jj))*rsbc_tke1)**r2_3 )
zd_lw(ji,jj,1) = en(ji,jj,1)
@@ -398,7 +401,7 @@ CONTAINS
END_2D
!
IF( ln_isfcav) THEN ! top boundary (ocean cavity)
- DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D_OVR( 0, 0, 0, 0 )
IF( mikt(ji,jj) > 1 )THEN
itop = mikt(ji,jj) ! k top w-point
itopp1 = mikt(ji,jj) + 1 ! k+1 1st w-point below the top one
@@ -428,7 +431,7 @@ CONTAINS
CASE ( 0 ) ! Dirichlet
! ! en(ibot) = u*^2 / Co2 and hmxl_n(ibot) = rn_lmin
! ! Balance between the production and the dissipation terms
- DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D_OVR( 0, 0, 0, 0 )
!!gm This means that bottom and ocean w-level above have a specified "en" value. Sure ????
!! With thick deep ocean level thickness, this may be quite large, no ???
!! in particular in ocean cavities where top stratification can be large...
@@ -447,7 +450,7 @@ CONTAINS
!
! NOTE: ctl_stop with ln_isfcav when using GLS
IF( ln_isfcav) THEN ! top boundary (ocean cavity)
- DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D_OVR( 0, 0, 0, 0 )
itop = mikt(ji,jj) ! k top w-point
itopp1 = mikt(ji,jj) + 1 ! k+1 1st w-point below the top one
! ! mask at the ocean surface points
@@ -465,7 +468,7 @@ CONTAINS
!
CASE ( 1 ) ! Neumman boundary condition
!
- DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D_OVR( 0, 0, 0, 0 )
ibot = mbkt(ji,jj) + 1 ! k bottom level of w-point
ibotm1 = mbkt(ji,jj) ! k-1 bottom level of w-point but >=1
!
@@ -481,7 +484,7 @@ CONTAINS
END_2D
! NOTE: ctl_stop with ln_isfcav when using GLS
IF( ln_isfcav) THEN ! top boundary (ocean cavity)
- DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D_OVR( 0, 0, 0, 0 )
itop = mikt(ji,jj) ! k top w-point
itopp1 = mikt(ji,jj) + 1 ! k+1 1st w-point below the top one
! ! mask at the ocean surface points
@@ -502,17 +505,17 @@ CONTAINS
! Matrix inversion (en prescribed at surface and the bottom)
! ----------------------------------------------------------
!
- DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
+ DO_3D_OVR( 0, 0, 0, 0, 2, jpkm1 ) ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1)
END_3D
- DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
+ DO_3D_OVR( 0, 0, 0, 0, 2, jpkm1 ) ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) * zd_lw(ji,jj,jk-1)
END_3D
- DO_3DS_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpkm1, 2, -1 ) ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
+ DO_3DS_OVR( 0, 0, 0, 0, jpkm1, 2, -1 ) ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk)
END_3D
! ! set the minimum value of tke
- DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )
+ DO_3D_OVR( 0, 0, 0, 0, 1, jpk )
en(ji,jj,jk) = MAX( en(ji,jj,jk), rn_emin )
END_3D
@@ -525,22 +528,22 @@ CONTAINS
SELECT CASE ( nn_clos )
!
CASE( 0 ) ! k-kl (Mellor-Yamada)
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+ DO_3D( 0, 0, 0, 0, 2, jpkm1 )
psi(ji,jj,jk) = eb(ji,jj,jk) * hmxl_b(ji,jj,jk)
END_3D
!
CASE( 1 ) ! k-eps
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+ DO_3D( 0, 0, 0, 0, 2, jpkm1 )
psi(ji,jj,jk) = eps(ji,jj,jk)
END_3D
!
CASE( 2 ) ! k-w
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+ DO_3D( 0, 0, 0, 0, 2, jpkm1 )
psi(ji,jj,jk) = SQRT( eb(ji,jj,jk) ) / ( rc0 * hmxl_b(ji,jj,jk) )
END_3D
!
CASE( 3 ) ! generic
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+ DO_3D( 0, 0, 0, 0, 2, jpkm1 )
psi(ji,jj,jk) = rc02 * eb(ji,jj,jk) * hmxl_b(ji,jj,jk)**rnn
END_3D
!
@@ -553,7 +556,7 @@ CONTAINS
! zdiag : diagonal zd_up : upper diagonal zd_lw : lower diagonal
! Warning : after this step, en : right hand side of the matrix
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+ DO_3D( 0, 0, 0, 0, 2, jpkm1 )
!
! psi / k
zratio = psi(ji,jj,jk) / eb(ji,jj,jk)
@@ -591,7 +594,7 @@ CONTAINS
psi(ji,jj,jk) = psi(ji,jj,jk) + rn_Dt * zesh2 * wmask(ji,jj,jk)
END_3D
!
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D( 0, 0, 0, 0 )
zdiag(ji,jj,jpk) = 1._wp
END_2D
@@ -602,7 +605,7 @@ CONTAINS
!
CASE ( 0 ) ! Dirichlet boundary conditions
!
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D( 0, 0, 0, 0 )
! Surface value
zdep (ji,jj) = zhsro(ji,jj) * rl_sf ! Cosmetic
psi (ji,jj,1) = rc0**rpp * en(ji,jj,1)**rmm * zdep(ji,jj)**rnn * tmask(ji,jj,1)
@@ -621,7 +624,7 @@ CONTAINS
!
CASE ( 1 ) ! Neumann boundary condition on d(psi)/dz
!
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D( 0, 0, 0, 0 )
! Surface value: Dirichlet
zdep (ji,jj) = zhsro(ji,jj) * rl_sf
psi (ji,jj,1) = rc0**rpp * en(ji,jj,1)**rmm * zdep(ji,jj)**rnn * tmask(ji,jj,1)
@@ -657,7 +660,7 @@ CONTAINS
CASE ( 0 ) ! Dirichlet
! ! en(ibot) = u*^2 / Co2 and hmxl_n(ibot) = vkarmn * r_z0_bot
! ! Balance between the production and the dissipation terms
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D( 0, 0, 0, 0 )
ibot = mbkt(ji,jj) + 1 ! k bottom level of w-point
ibotm1 = mbkt(ji,jj) ! k-1 bottom level of w-point but >=1
zdep(ji,jj) = vkarmn * r_z0_bot
@@ -675,7 +678,7 @@ CONTAINS
END_2D
!
IF( ln_isfcav) THEN ! top boundary (ocean cavity)
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D( 0, 0, 0, 0 )
IF ( mikt(ji,jj) > 1 ) THEN
itop = mikt(ji,jj) ! k top w-point
itopp1 = mikt(ji,jj) + 1 ! k+1 1st w-point below the top one
@@ -698,7 +701,7 @@ CONTAINS
!
CASE ( 1 ) ! Neumman boundary condition
!
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D( 0, 0, 0, 0 )
ibot = mbkt(ji,jj) + 1 ! k bottom level of w-point
ibotm1 = mbkt(ji,jj) ! k-1 bottom level of w-point but >=1
!
@@ -722,7 +725,7 @@ CONTAINS
END_2D
!
IF( ln_isfcav) THEN ! top boundary (ocean cavity)
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D( 0, 0, 0, 0 )
IF ( mikt(ji,jj) > 1 ) THEN
itop = mikt(ji,jj) ! k top w-point
itopp1 = mikt(ji,jj) + 1 ! k+1 1st w-point below the top one
@@ -755,13 +758,13 @@ CONTAINS
! Matrix inversion
! ----------------
!
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
+ DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1)
END_3D
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
+ DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
zd_lw(ji,jj,jk) = psi(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) * zd_lw(ji,jj,jk-1)
END_3D
- DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpkm1, 2, -1 ) ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
+ DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 ) ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
psi(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * psi(ji,jj,jk+1) ) / zdiag(ji,jj,jk)
END_3D
@@ -771,17 +774,17 @@ CONTAINS
SELECT CASE ( nn_clos )
!
CASE( 0 ) ! k-kl (Mellor-Yamada)
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
eps(ji,jj,jk) = rc03 * en(ji,jj,jk) * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / MAX( psi(ji,jj,jk), rn_epsmin)
END_3D
!
CASE( 1 ) ! k-eps
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
eps(ji,jj,jk) = psi(ji,jj,jk)
END_3D
!
CASE( 2 ) ! k-w
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
eps(ji,jj,jk) = rc04 * en(ji,jj,jk) * psi(ji,jj,jk)
END_3D
!
@@ -789,7 +792,7 @@ CONTAINS
zcoef = rc0**( 3._wp + rpp/rnn )
zex1 = ( 1.5_wp + rmm/rnn )
zex2 = -1._wp / rnn
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
eps(ji,jj,jk) = zcoef * en(ji,jj,jk)**zex1 * psi(ji,jj,jk)**zex2
END_3D
!
@@ -797,13 +800,13 @@ CONTAINS
! Limit dissipation rate under stable stratification
! --------------------------------------------------
- DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) ! Note that this set boundary conditions on hmxl_n at the same time
+ DO_3D_OVR( 0, 0, 0, 0, 1, jpkm1 ) ! Note that this set boundary conditions on hmxl_n at the same time
! limitation
eps (ji,jj,jk) = MAX( eps(ji,jj,jk), rn_epsmin )
hmxl_n(ji,jj,jk) = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / eps(ji,jj,jk)
END_3D
IF( ln_length_lim ) THEN ! Galperin criterium (NOTE : Not required if the proper value of C3 in stable cases is calculated)
- DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
+ DO_3D_OVR( 0, 0, 0, 0, 1, jpkm1 )
zrn2 = MAX( rn2(ji,jj,jk), rsmall )
hmxl_n(ji,jj,jk) = MIN( rn_clim_galp * SQRT( 2._wp * en(ji,jj,jk) / zrn2 ), hmxl_n(ji,jj,jk) )
END_3D
@@ -816,7 +819,7 @@ CONTAINS
SELECT CASE ( nn_stab_func )
!
CASE ( 0 , 1 ) ! Galperin or Kantha-Clayson stability functions
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+ DO_3D( 0, 0, 0, 0, 2, jpkm1 )
! zcof = l²/q²
zcof = hmxl_b(ji,jj,jk) * hmxl_b(ji,jj,jk) / ( 2._wp*eb(ji,jj,jk) )
! Gh = -N²l²/q²
@@ -833,7 +836,7 @@ CONTAINS
END_3D
!
CASE ( 2, 3 ) ! Canuto stability functions
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+ DO_3D( 0, 0, 0, 0, 2, jpkm1 )
! zcof = l²/q²
zcof = hmxl_b(ji,jj,jk)*hmxl_b(ji,jj,jk) / ( 2._wp * eb(ji,jj,jk) )
! Gh = -N²l²/q²
@@ -861,17 +864,17 @@ CONTAINS
! Boundary conditions on stability functions for momentum (Neumann):
! Lines below are useless if GOTM style Dirichlet conditions are used
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D( 0, 0, 0, 0 )
zstm(ji,jj,1) = zstm(ji,jj,2)
zstm(ji,jj,jpk) = 0. ! default value, in case jpk > mbkt(ji,jj)+1
! ! Not needed but avoid a bug when looking for undefined values (-fpe0)
END_2D
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! update bottom with good values
+ DO_2D( 0, 0, 0, 0 ) ! update bottom with good values
zstm(ji,jj,mbkt(ji,jj)+1) = zstm(ji,jj,mbkt(ji,jj))
END_2D
- zstt(:,:, 1) = wmask(A2D(nn_hls), 1) ! default value not needed but avoid a bug when looking for undefined values (-fpe0)
- zstt(:,:,jpk) = wmask(A2D(nn_hls),jpk) ! default value not needed but avoid a bug when looking for undefined values (-fpe0)
+ zstt(:,:, 1) = wmask(A2D(0), 1) ! default value not needed but avoid a bug when looking for undefined values (-fpe0)
+ zstt(:,:,jpk) = wmask(A2D(0),jpk) ! default value not needed but avoid a bug when looking for undefined values (-fpe0)
!!gm should be done for ISF (top boundary cond.)
!!gm so, totally new staff needed!!gm
@@ -881,14 +884,14 @@ CONTAINS
! -> yes BUT p_avm(:,:1) and p_avm(:,:jpk) are used when we compute zd_lw(:,:2) and zd_up(:,:jpkm1). These values are
! later overwritten by surface/bottom boundaries conditions, so we don't really care of p_avm(:,:1) and p_avm(:,:jpk)
! for zd_lw and zd_up but they have to be defined to avoid a bug when looking for undefined values (-fpe0)
- DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )
+ DO_3D_OVR( 0, 0, 0, 0, 1, jpk )
zsqen = SQRT( 2._wp * en(ji,jj,jk) ) * hmxl_n(ji,jj,jk)
zavt = zsqen * zstt(ji,jj,jk)
zavm = zsqen * zstm(ji,jj,jk)
p_avt(ji,jj,jk) = MAX( zavt, avtb(jk) ) * wmask(ji,jj,jk) ! apply mask for zdfmxl routine
p_avm(ji,jj,jk) = MAX( zavm, avmb(jk) ) ! Note that avm is not masked at the surface and the bottom
END_3D
- p_avt(A2D(nn_hls),1) = 0._wp
+ p_avt(:,:,1) = 0._wp
!
IF(sn_cfctl%l_prtctl) THEN
CALL prt_ctl( tab3d_1=en , clinfo1=' gls - e: ', tab3d_2=p_avt, clinfo2=' t: ' )
@@ -1212,7 +1215,7 @@ CONTAINS
!
! !* Wall proximity function
!!gm tmask or wmask ????
- zwall(:,:,:) = 1._wp * tmask(:,:,:)
+ zwall(:,:,:) = 1._wp * tmask(A2D(0),:)
! !* read or initialize all required files
CALL gls_rst( nit000, 'READ' ) ! (en, avt_k, avm_k, hmxl_n)
diff --git a/src/OCE/ZDF/zdfiwm.F90 b/src/OCE/ZDF/zdfiwm.F90
index d0a9540eaa619d70c6eff3ba70b4c417f26f84d1..31c3387da570276df9a31bf412550c7fdcccce61 100644
--- a/src/OCE/ZDF/zdfiwm.F90
+++ b/src/OCE/ZDF/zdfiwm.F90
@@ -65,8 +65,8 @@ CONTAINS
!!----------------------------------------------------------------------
!! *** FUNCTION zdf_iwm_alloc ***
!!----------------------------------------------------------------------
- ALLOCATE( ebot_iwm(jpi,jpj), ecri_iwm(jpi,jpj), ensq_iwm(jpi,jpj) , &
- & esho_iwm(jpi,jpj), hbot_iwm(jpi,jpj), hcri_iwm(jpi,jpj) , STAT=zdf_iwm_alloc )
+ ALLOCATE( ebot_iwm(A2D(0)), ecri_iwm(A2D(0)), ensq_iwm(A2D(0)) , &
+ & esho_iwm(A2D(0)), hbot_iwm(A2D(0)), hcri_iwm(A2D(0)) , STAT=zdf_iwm_alloc )
!
CALL mpp_sum ( 'zdfiwm', zdf_iwm_alloc )
IF( zdf_iwm_alloc /= 0 ) CALL ctl_stop( 'STOP', 'zdf_iwm_alloc: failed to allocate arrays' )
@@ -127,25 +127,25 @@ CONTAINS
!! References : de Lavergne et al. JAMES 2020, https://doi.org/10.1029/2020MS002065
!! de Lavergne et al. JPO 2016, https://doi.org/10.1175/JPO-D-14-0259.1
!!----------------------------------------------------------------------
- INTEGER , INTENT(in ) :: kt ! ocean time step
- INTEGER , INTENT(in ) :: Kmm ! time level index
- REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: p_avm ! momentum Kz (w-points)
- REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: p_avt, p_avs ! tracer Kz (w-points)
+ INTEGER , INTENT(in ) :: kt ! ocean time step
+ INTEGER , INTENT(in ) :: Kmm ! time level index
+ REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: p_avm ! momentum Kz (w-points)
+ REAL(wp), DIMENSION( A2D(0),jpk), INTENT(inout) :: p_avt, p_avs ! tracer Kz (w-points)
!
INTEGER :: ji, jj, jk ! dummy loop indices
REAL(wp), SAVE :: zztmp
!
- REAL(wp), DIMENSION(A2D(nn_hls)) :: zfact ! Used for vertical structure
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zReb ! Turbulence intensity parameter
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zemx_iwm ! local energy density available for mixing (W/kg)
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zav_ratio ! S/T diffusivity ratio (only for ln_tsdiff=T)
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zav_wave ! Internal wave-induced diffusivity
+ REAL(wp), DIMENSION(A2D(0)) :: zfact ! Used for vertical structure
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zReb ! Turbulence intensity parameter
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zemx_iwm ! local energy density available for mixing (W/kg)
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zav_ratio ! S/T diffusivity ratio (only for ln_tsdiff=T)
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zav_wave ! Internal wave-induced diffusivity
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z3d ! 3D workspace used for iom_put
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z2d ! 2D - - - -
!!----------------------------------------------------------------------
!
! !* Initialize appropriately certain variables
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )
+ DO_3D( 0, 0, 0, 0, 1, jpk )
zav_ratio(ji,jj,jk) = 1._wp * wmask(ji,jj,jk) ! important to set it to 1 here
END_3D
IF( iom_use("emix_iwm") ) zemx_iwm (:,:,:) = 0._wp
@@ -157,13 +157,13 @@ CONTAINS
!
! !* 'cri' component: distribute energy over the time-varying
! !* ocean depth using an exponential decay from the seafloor.
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! part independent of the level
+ DO_2D( 0, 0, 0, 0 ) ! part independent of the level
IF( ht(ji,jj) /= 0._wp ) THEN ; zfact(ji,jj) = ecri_iwm(ji,jj) * r1_rho0 / ( 1._wp - EXP( -ht(ji,jj) * hcri_iwm(ji,jj) ) )
ELSE ; zfact(ji,jj) = 0._wp
ENDIF
END_2D
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! complete with the level-dependent part
+ DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! complete with the level-dependent part
zemx_iwm(ji,jj,jk) = zfact(ji,jj) * ( EXP( ( gdept(ji,jj,jk ,Kmm) - ht(ji,jj) ) * hcri_iwm(ji,jj) ) &
& - EXP( ( gdept(ji,jj,jk-1,Kmm) - ht(ji,jj) ) * hcri_iwm(ji,jj) ) &
& ) * wmask(ji,jj,jk) / e3w(ji,jj,jk,Kmm)
@@ -171,13 +171,13 @@ CONTAINS
!* 'bot' component: distribute energy over the time-varying
!* ocean depth using an algebraic decay above the seafloor.
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! part independent of the level
+ DO_2D( 0, 0, 0, 0 ) ! part independent of the level
IF( ht(ji,jj) /= 0._wp ) THEN ; zfact(ji,jj) = ebot_iwm(ji,jj) * ( 1._wp + hbot_iwm(ji,jj) / ht(ji,jj) ) * r1_rho0
ELSE ; zfact(ji,jj) = 0._wp
ENDIF
END_2D
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! complete with the level-dependent part
+ DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! complete with the level-dependent part
zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + &
& zfact(ji,jj) * ( 1._wp / ( 1._wp + ( ht(ji,jj) - gdept(ji,jj,jk ,Kmm) ) / hbot_iwm(ji,jj) ) &
& - 1._wp / ( 1._wp + ( ht(ji,jj) - gdept(ji,jj,jk-1,Kmm) ) / hbot_iwm(ji,jj) ) &
@@ -186,50 +186,50 @@ CONTAINS
!* 'nsq' component: distribute energy over the time-varying
!* ocean depth as proportional to rn2
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D( 0, 0, 0, 0 )
zfact(ji,jj) = 0._wp
END_2D
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! part independent of the level
+ DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! part independent of the level
zfact(ji,jj) = zfact(ji,jj) + e3w(ji,jj,jk,Kmm) * MAX( 0._wp, rn2(ji,jj,jk) )
END_3D
!
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D( 0, 0, 0, 0 )
IF( zfact(ji,jj) /= 0._wp ) zfact(ji,jj) = ensq_iwm(ji,jj) * r1_rho0 / zfact(ji,jj)
END_2D
!
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! complete with the level-dependent part
+ DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! complete with the level-dependent part
zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zfact(ji,jj) * MAX( 0._wp, rn2(ji,jj,jk) )
END_3D
!* 'sho' component: distribute energy over the time-varying
!* ocean depth as proportional to sqrt(rn2)
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D( 0, 0, 0, 0 )
zfact(ji,jj) = 0._wp
END_2D
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! part independent of the level
+ DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! part independent of the level
zfact(ji,jj) = zfact(ji,jj) + e3w(ji,jj,jk,Kmm) * SQRT( MAX( 0._wp, rn2(ji,jj,jk) ) )
END_3D
!
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D( 0, 0, 0, 0 )
IF( zfact(ji,jj) /= 0._wp ) zfact(ji,jj) = esho_iwm(ji,jj) * r1_rho0 / zfact(ji,jj)
END_2D
!
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! complete with the level-dependent part
+ DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! complete with the level-dependent part
zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zfact(ji,jj) * SQRT( MAX( 0._wp, rn2(ji,jj,jk) ) )
END_3D
! Calculate turbulence intensity parameter Reb
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+ DO_3D( 0, 0, 0, 0, 2, jpkm1 )
zReb(ji,jj,jk) = zemx_iwm(ji,jj,jk) / MAX( 1.e-20_wp, rnu * rn2(ji,jj,jk) )
END_3D
!
! Define internal wave-induced diffusivity
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+ DO_3D( 0, 0, 0, 0, 2, jpkm1 )
zav_wave(ji,jj,jk) = zReb(ji,jj,jk) * r1_6 * rnu ! This corresponds to a constant mixing efficiency of 1/6
END_3D
!
IF( ln_mevar ) THEN ! Variable mixing efficiency case : modify zav_wave in the
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! energetic (Reb > 480) and buoyancy-controlled (Reb <10.224) regimes
+ DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! energetic (Reb > 480) and buoyancy-controlled (Reb <10.224) regimes
IF( zReb(ji,jj,jk) > 480.00_wp ) THEN
zav_wave(ji,jj,jk) = 3.6515_wp * rnu * SQRT( zReb(ji,jj,jk) )
ELSEIF( zReb(ji,jj,jk) < 10.224_wp ) THEN
@@ -238,7 +238,7 @@ CONTAINS
END_3D
ENDIF
!
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! Bound diffusivity by molecular value and 100 cm2/s
+ DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! Bound diffusivity by molecular value and 100 cm2/s
zav_wave(ji,jj,jk) = MIN( MAX( 1.4e-7_wp, zav_wave(ji,jj,jk) ), 1.e-2_wp ) * wmask(ji,jj,jk)
END_3D
!
@@ -247,7 +247,7 @@ CONTAINS
! ! ----------------------- !
!
IF( ln_tsdiff ) THEN !* Option for differential mixing of salinity and temperature
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! Calculate S/T diffusivity ratio as a function of Reb (else it is set to 1)
+ DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! Calculate S/T diffusivity ratio as a function of Reb (else it is set to 1)
zav_ratio(ji,jj,jk) = ( 0.505_wp + &
& 0.495_wp * TANH( 0.92_wp * ( LOG10( MAX( 1.e-20, zReb(ji,jj,jk) * 5._wp * r1_6 ) ) - 0.60_wp ) ) &
& ) * wmask(ji,jj,jk)
@@ -255,7 +255,7 @@ CONTAINS
ENDIF
CALL iom_put( "av_ratio", zav_ratio )
!
- DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) !* update momentum & tracer diffusivity with wave-driven mixing
+ DO_3D_OVR( 0, 0, 0, 0, 2, jpkm1 ) !* update momentum & tracer diffusivity with wave-driven mixing
p_avs(ji,jj,jk) = p_avs(ji,jj,jk) + zav_wave(ji,jj,jk) * zav_ratio(ji,jj,jk)
p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zav_wave(ji,jj,jk)
p_avm(ji,jj,jk) = p_avm(ji,jj,jk) + zav_wave(ji,jj,jk)
@@ -265,7 +265,7 @@ CONTAINS
!* output useful diagnostics: Kz*N^2 ,
! vertical integral of rho0 * Kz * N^2 , energy density (zemx_iwm)
IF( iom_use("bflx_iwm") .OR. iom_use("pcmap_iwm") ) THEN
- ALLOCATE( z2d(A2D(nn_hls)) , z3d(A2D(nn_hls),jpk) )
+ ALLOCATE( z2d(A2D(0)) , z3d(A2D(0),jpk) )
z2d(:,:) = 0._wp ; z3d(:,:,:) = 0._wp ! Initialisation for iom_put
DO_3D( 0, 0, 0, 0, 2, jpkm1 )
z3d(ji,jj,jk) = MAX( 0._wp, rn2(ji,jj,jk) ) * zav_wave(ji,jj,jk)
@@ -282,7 +282,7 @@ CONTAINS
IF( .NOT. l_istiled .OR. ntile == 1 ) zztmp = 0._wp ! Do only on the first tile
DO_3D( 0, 0, 0, 0, 2, jpkm1 )
zztmp = zztmp + e3w(ji,jj,jk,Kmm) * e1e2t(ji,jj) &
- & * MAX( 0._wp, rn2(ji,jj,jk) ) * zav_wave(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj)
+ & * MAX( 0._wp, rn2(ji,jj,jk) ) * zav_wave(ji,jj,jk) * wmask(ji,jj,jk) * smask0_i(ji,jj)
END_3D
IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN ! Do only on the last tile
@@ -299,7 +299,7 @@ CONTAINS
ENDIF
ENDIF
- IF(sn_cfctl%l_prtctl) CALL prt_ctl(tab3d_1=zav_wave , clinfo1=' iwm - av_wave: ', tab3d_2=avt, clinfo2=' avt: ')
+ IF(sn_cfctl%l_prtctl) CALL prt_ctl(tab3d_1=zav_wave , clinfo1=' iwm - av_wave: ', tab3d_2=p_avt, clinfo2=' avt: ')
!
END SUBROUTINE zdf_iwm
@@ -341,14 +341,16 @@ CONTAINS
INTEGER, PARAMETER :: jp_mps = 4
INTEGER, PARAMETER :: jp_dsb = 5
INTEGER, PARAMETER :: jp_dsc = 6
+ INTEGER :: ji, jj
!
TYPE(FLD_N), DIMENSION(jpiwm) :: slf_iwm ! array of namelist informations
TYPE(FLD_N) :: sn_mpb, sn_mpc, sn_mpn, sn_mps ! information about Mixing Power field to be read
TYPE(FLD_N) :: sn_dsb, sn_dsc ! information about Decay Scale field to be read
TYPE(FLD ), DIMENSION(jpiwm) :: sf_iwm ! structure of input fields (file informations, fields read)
!
- REAL(wp), DIMENSION(jpi,jpj,4) :: ztmp
- REAL(wp), DIMENSION(4) :: zdia
+ REAL(wp), DIMENSION(A2D(0),4) :: ztmp
+ REAL(wp), DIMENSION(4) :: zdia
+ REAL(wp) :: zcte
!
NAMELIST/namzdf_iwm/ ln_mevar, ln_tsdiff, &
& cn_dir, sn_mpb, sn_mpc, sn_mpn, sn_mps, sn_dsb, sn_dsc
@@ -373,10 +375,12 @@ CONTAINS
! This internal-wave-driven mixing parameterization elevates avt and avm in the interior, and
! ensures that avt remains larger than its molecular value (=1.4e-7). Therefore, avtb should
! be set here to a very small value, and avmb to its (uniform) molecular value (=1.4e-6).
- avmb(:) = rnu ! molecular value
- avtb(:) = 1.e-10_wp ! very small diffusive minimum (background avt is specified in zdf_iwm)
- avtb_2d(:,:) = 1._wp ! uniform
- IF(lwp) THEN ! Control print
+ avmb(:) = rnu ! molecular value
+ avtb(:) = 1.e-10_wp ! very small diffusive minimum (background avt is specified in zdf_iwm)
+ DO_2D( 0, 0, 0, 0 )
+ avtb_2d(ji,jj) = 1._wp ! uniform
+ END_2D
+ IF(lwp) THEN ! Control print
WRITE(numout,*)
WRITE(numout,*) ' Force the background value applied to avm & avt in TKE to be everywhere ', &
& 'the viscous molecular value & a very small diffusive value, resp.'
@@ -390,40 +394,46 @@ CONTAINS
slf_iwm(jp_dsb) = sn_dsb ; slf_iwm(jp_dsc) = sn_dsc
!
DO ifpr= 1, jpiwm
- ALLOCATE( sf_iwm(ifpr)%fnow(jpi,jpj,1) )
- IF( slf_iwm(ifpr)%ln_tint ) ALLOCATE( sf_iwm(ifpr)%fdta(jpi,jpj,1,2) )
+ ALLOCATE( sf_iwm(ifpr)%fnow(A2D(0),1) )
+ IF( slf_iwm(ifpr)%ln_tint ) ALLOCATE( sf_iwm(ifpr)%fdta(A2D(0),1,2) )
END DO
! fill sf_iwm with sf_iwm and control print
CALL fld_fill( sf_iwm, slf_iwm , cn_dir, 'zdfiwm_init', 'iwm input file', 'namiwm' )
! ! hard-coded default values
- sf_iwm(jp_mpb)%fnow(:,:,1) = 1.e-10_wp
- sf_iwm(jp_mpc)%fnow(:,:,1) = 1.e-10_wp
- sf_iwm(jp_mpn)%fnow(:,:,1) = 1.e-5_wp
- sf_iwm(jp_mps)%fnow(:,:,1) = 1.e-10_wp
- sf_iwm(jp_dsb)%fnow(:,:,1) = 100._wp
- sf_iwm(jp_dsc)%fnow(:,:,1) = 100._wp
-
+ DO_2D( 0, 0, 0, 0 )
+ sf_iwm(jp_mpb)%fnow(ji,jj,1) = 1.e-10_wp
+ sf_iwm(jp_mpc)%fnow(ji,jj,1) = 1.e-10_wp
+ sf_iwm(jp_mpn)%fnow(ji,jj,1) = 1.e-5_wp
+ sf_iwm(jp_mps)%fnow(ji,jj,1) = 1.e-10_wp
+ sf_iwm(jp_dsb)%fnow(ji,jj,1) = 100._wp
+ sf_iwm(jp_dsc)%fnow(ji,jj,1) = 100._wp
+ END_2D
+
! ! read necessary fields
CALL fld_read( nit000, 1, sf_iwm )
-
- ebot_iwm(:,:) = sf_iwm(1)%fnow(:,:,1) * ssmask(:,:) ! energy flux for dissipation above abyssal hills [W/m2]
- ecri_iwm(:,:) = sf_iwm(2)%fnow(:,:,1) * ssmask(:,:) ! energy flux for dissipation at topographic slopes [W/m2]
- ensq_iwm(:,:) = sf_iwm(3)%fnow(:,:,1) * ssmask(:,:) ! energy flux for dissipation scaling with N^2 [W/m2]
- esho_iwm(:,:) = sf_iwm(4)%fnow(:,:,1) * ssmask(:,:) ! energy flux for dissipation due to shoaling [W/m2]
- hbot_iwm(:,:) = sf_iwm(5)%fnow(:,:,1) ! spatially variable decay scale for abyssal hill dissipation [m]
- hcri_iwm(:,:) = sf_iwm(6)%fnow(:,:,1) ! spatially variable decay scale for topographic-slope [m]
-
- hcri_iwm(:,:) = 1._wp / hcri_iwm(:,:) ! only the inverse height is used, hence calculated here once for all
+
+ DO_2D( 0, 0, 0, 0 )
+ zcte = smask0(ji,jj)
+ ebot_iwm(ji,jj) = sf_iwm(1)%fnow(ji,jj,1) * zcte ! energy flux for dissipation above abyssal hills [W/m2]
+ ecri_iwm(ji,jj) = sf_iwm(2)%fnow(ji,jj,1) * zcte ! energy flux for dissipation at topographic slopes [W/m2]
+ ensq_iwm(ji,jj) = sf_iwm(3)%fnow(ji,jj,1) * zcte ! energy flux for dissipation scaling with N^2 [W/m2]
+ esho_iwm(ji,jj) = sf_iwm(4)%fnow(ji,jj,1) * zcte ! energy flux for dissipation due to shoaling [W/m2]
+ hbot_iwm(ji,jj) = sf_iwm(5)%fnow(ji,jj,1) ! spatially variable decay scale for abyssal hill dissipation [m]
+ hcri_iwm(ji,jj) = 1._wp / sf_iwm(6)%fnow(ji,jj,1) ! inverse decay scale for topographic slope dissipation [m-1]
+ END_2D
! diags
- ztmp(:,:,1) = e1e2t(:,:) * ebot_iwm(:,:)
- ztmp(:,:,2) = e1e2t(:,:) * ecri_iwm(:,:)
- ztmp(:,:,3) = e1e2t(:,:) * ensq_iwm(:,:)
- ztmp(:,:,4) = e1e2t(:,:) * esho_iwm(:,:)
+ DO_2D( 0, 0, 0, 0 )
+ zcte = e1e2t(ji,jj)
+ ztmp(ji,jj,1) = zcte * ebot_iwm(ji,jj)
+ ztmp(ji,jj,2) = zcte * ecri_iwm(ji,jj)
+ ztmp(ji,jj,3) = zcte * ensq_iwm(ji,jj)
+ ztmp(ji,jj,4) = zcte * esho_iwm(ji,jj)
+ END_2D
- zdia(1:4) = glob_sum_vec( 'zdfiwm', ztmp(:,:,1:4) )
+ zdia(1:4) = glob_sum_vec( 'zdfiwm', ztmp )
IF(lwp) THEN
WRITE(numout,*) ' Dissipation above abyssal hills: ', zdia(1) * 1.e-12_wp, 'TW'
diff --git a/src/OCE/ZDF/zdfmfc.F90 b/src/OCE/ZDF/zdfmfc.F90
index f984b2bfa425f1ceb62b6c249dff7a5a3fca0a98..d83c10182986fd536c22af89210609dd1296a418 100644
--- a/src/OCE/ZDF/zdfmfc.F90
+++ b/src/OCE/ZDF/zdfmfc.F90
@@ -69,8 +69,8 @@ CONTAINS
!!----------------------------------------------------------------------
!! *** FUNCTION zdf_edmf_alloc ***
!!----------------------------------------------------------------------
- ALLOCATE( edmfa(jpi,jpj,jpk) , edmfb(jpi,jpj,jpk) , edmfc(jpi,jpj,jpk) &
- & , edmftra(jpi,jpj,jpk,2), edmfm(jpi,jpj,jpk) , STAT= zdf_mfc_alloc )
+ ALLOCATE( edmfa(A2D(0),jpk) , edmfb(A2D(0),jpk) , edmfc(A2D(0),jpk), &
+ & edmftra(A2D(0),jpk,2), edmfm(A2D(0),jpk) , STAT= zdf_mfc_alloc )
!
IF( lk_mpp ) CALL mpp_sum ( 'zdfmfc', zdf_mfc_alloc )
IF( zdf_mfc_alloc /= 0 ) CALL ctl_warn('zdf_mfc_alloc: failed to allocate arrays')
@@ -97,24 +97,25 @@ CONTAINS
REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation
REAL(wp), DIMENSION(A2D(nn_hls),jpk,2) :: ztsp ! T/S of the plume
REAL(wp), DIMENSION(A2D(nn_hls),jpk,2) :: ztse ! T/S at W point
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zrwp !
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zrwp2 !
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zapp !
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zedmf !
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zepsT, zepsW !
+ REAL(wp), DIMENSION(A2D(nn_hls)) :: zrautb, zraupl
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zrwp !
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zrwp2 !
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zapp !
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zedmf !
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zepsT, zepsW !
!
- REAL(wp), DIMENSION(A2D(nn_hls)) :: zustar, zustar2 !
- REAL(wp), DIMENSION(A2D(nn_hls)) :: zuws, zvws, zsws, zfnet !
- REAL(wp), DIMENSION(A2D(nn_hls)) :: zfbuo, zrautbm1, zrautb, zraupl
- REAL(wp), DIMENSION(A2D(nn_hls)) :: zwpsurf !
- REAL(wp), DIMENSION(A2D(nn_hls)) :: zop0 , zsp0 !
- REAL(wp), DIMENSION(A2D(nn_hls)) :: zrwp_0, zrwp2_0 !
- REAL(wp), DIMENSION(A2D(nn_hls)) :: zapp0 !
- REAL(wp), DIMENSION(A2D(nn_hls)) :: zphp, zph, zphpm1, zphm1, zNHydro
- REAL(wp), DIMENSION(A2D(nn_hls)) :: zhcmo !
+ REAL(wp), DIMENSION(A2D(0)) :: zustar, zustar2 !
+ REAL(wp), DIMENSION(A2D(0)) :: zuws, zvws, zsws, zfnet !
+ REAL(wp), DIMENSION(A2D(0)) :: zfbuo, zrautbm1
+ REAL(wp), DIMENSION(A2D(0)) :: zwpsurf !
+ REAL(wp), DIMENSION(A2D(0)) :: zop0 , zsp0 !
+ REAL(wp), DIMENSION(A2D(0)) :: zrwp_0, zrwp2_0 !
+ REAL(wp), DIMENSION(A2D(0)) :: zapp0 !
+ REAL(wp), DIMENSION(A2D(0)) :: zphp, zph, zphpm1, zphm1, zNHydro
+ REAL(wp), DIMENSION(A2D(0)) :: zhcmo !
!
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zn2 ! N^2
- REAL(wp), DIMENSION(A2D(nn_hls),2 ) :: zab, zabm1, zabp ! alpha and beta
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zn2 ! N^2
+ REAL(wp), DIMENSION(A2D(0),2 ) :: zab, zabm1, zabp ! alpha and beta
REAL(wp), PARAMETER :: zepsilon = 1.e-30 ! local small value
@@ -135,7 +136,7 @@ CONTAINS
zcb = 1._wp
zcd = 1._wp
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
!------------------------------------------------------------------
! Surface boundary condition
!------------------------------------------------------------------
@@ -160,8 +161,11 @@ CONTAINS
!-------------------------------------------
zrwp (ji,jj,:) = 0._wp ; zrwp2(ji,jj,:) = 0._wp ; zedmf(ji,jj,:) = 0._wp
zph (ji,jj) = 0._wp ; zphm1(ji,jj) = 0._wp ; zphpm1(ji,jj) = 0._wp
- ztsp(ji,jj,:,:)= 0._wp
+ END_2D
+ !clem: we should be able to do all calculations in the interior if eos is changed to allow A2D(0) arrays
+ DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ ztsp(ji,jj,:,:) = 0._wp ; ztse(ji,jj,:,:) = 0._wp
! Tracers inside plume (ztsp) and environment (ztse)
ztsp(ji,jj,1,jp_tem) = pts(ji,jj,1,jp_tem,Kmm) * tmask(ji,jj,1)
ztsp(ji,jj,1,jp_sal) = pts(ji,jj,1,jp_sal,Kmm) * tmask(ji,jj,1)
@@ -175,12 +179,12 @@ CONTAINS
!-------------------------------------------
! Boundary Condition of Mass Flux (plume velo.; convective area, entrain/detrain)
!-------------------------------------------
- zhcmo(:,:) = e3t(A1Di(nn_hls),A1Dj(nn_hls),1,Kmm)
+ zhcmo(:,:) = e3t(A1Di(0),A1Dj(0),1,Kmm)
zfbuo(:,:) = 0._wp
- WHERE ( ABS(zrautb(:,:)) > 1.e-20 ) zfbuo(:,:) = &
+ WHERE ( ABS(zrautb(A2D(0))) > 1.e-20 ) zfbuo(:,:) = &
& grav * ( 2.e-4_wp *zfnet(:,:) &
- & - 7.6E-4_wp*pts(A2D(nn_hls),1,jp_sal,Kmm) &
- & * zsws(:,:)/zrautb(:,:)) * zhcmo(:,:)
+ & - 7.6E-4_wp*pts(A2D(0),1,jp_sal,Kmm) &
+ & * zsws(:,:)/zrautb(A2D(0))) * zhcmo(:,:)
zedmf(:,:,1) = -0.065_wp*(ABS(zfbuo(:,:)))**(1._wp/3._wp)*SIGN(1.,zfbuo(:,:))
zedmf(:,:,1) = MAX(0., zedmf(:,:,1))
@@ -210,7 +214,7 @@ CONTAINS
DO jk= 2, jpk
! Compute the buoyancy acceleration on T-points at jk-1
- zrautbm1(:,:) = zrautb(:,:)
+ zrautbm1(:,:) = zrautb(A2D(0))
CALL eos( pts (:,:,jk ,:,Kmm) , zrautb(:,:) )
CALL eos( ztsp(:,:,jk-1,: ) , zraupl(:,:) )
@@ -221,7 +225,7 @@ CONTAINS
zph(ji,jj) = MAX( zph(ji,jj), zepsilon)
END_2D
- WHERE(zrautbm1 .NE. 0.) zfbuo(:,:) = grav * (zraupl(:,:) - zrautbm1(:,:)) / zrautbm1(:,:)
+ WHERE(zrautbm1 .NE. 0.) zfbuo(:,:) = grav * (zraupl(A2D(0)) - zrautbm1(:,:)) / zrautbm1(:,:)
DO_2D( 0, 0, 0, 0 )
@@ -395,9 +399,9 @@ CONTAINS
SUBROUTINE diag_mfc( zdiagi, zdiagd, zdiags, p2dt, Kaa )
- REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) :: zdiagi, zdiagd, zdiags ! inout: tridaig. terms
- REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step
- INTEGER , INTENT(in ) :: Kaa ! ocean time level indices
+ REAL(wp), DIMENSION(A2D(0),jpk), INTENT(inout) :: zdiagi, zdiagd, zdiags ! inout: tridaig. terms
+ REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step
+ INTEGER , INTENT(in ) :: Kaa ! ocean time level indices
INTEGER :: ji, jj, jk ! dummy loop arguments
diff --git a/src/OCE/ZDF/zdfmxl.F90 b/src/OCE/ZDF/zdfmxl.F90
index c387bdb14eb18cced95ea452b9f8f7c4906ce06a..e298785aaa146a0ee76d6d8c32b3e997ef2eeb72 100644
--- a/src/OCE/ZDF/zdfmxl.F90
+++ b/src/OCE/ZDF/zdfmxl.F90
@@ -51,7 +51,7 @@ CONTAINS
!!----------------------------------------------------------------------
zdf_mxl_alloc = 0 ! set to zero if no array to be allocated
IF( .NOT. ALLOCATED( nmln ) ) THEN
- ALLOCATE( nmln(jpi,jpj), hmld(jpi,jpj), hmlp(jpi,jpj), hmlpt(jpi,jpj), STAT= zdf_mxl_alloc )
+ ALLOCATE( hmld(A2D(0)), nmln(jpi,jpj), hmlp(jpi,jpj), hmlpt(jpi,jpj), STAT= zdf_mxl_alloc )
!
CALL mpp_sum ( 'zdfmxl', zdf_mxl_alloc )
IF( zdf_mxl_alloc /= 0 ) CALL ctl_stop( 'STOP', 'zdf_mxl_alloc: failed to allocate arrays.' )
@@ -109,8 +109,8 @@ CONTAINS
!
IF( .NOT.l_offline .AND. iom_use("mldr10_1") ) THEN
IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN ! Do only on the last tile
- IF( ln_isfcav ) THEN ; CALL iom_put( "mldr10_1", hmlp - risfdep) ! mixed layer thickness
- ELSE ; CALL iom_put( "mldr10_1", hmlp ) ! mixed layer depth
+ IF( ln_isfcav ) THEN ; CALL iom_put( "mldr10_1", hmlp(A2D(0)) - risfdep(A2D(0))) ! mixed layer thickness
+ ELSE ; CALL iom_put( "mldr10_1", hmlp(A2D(0)) ) ! mixed layer depth
END IF
ENDIF
ENDIF
@@ -138,24 +138,24 @@ CONTAINS
!
INTEGER :: ji, jj, jk ! dummy loop indices
INTEGER :: iik ! local integer
- INTEGER, DIMENSION(A2D(nn_hls)) :: imld ! 2D workspace
+ INTEGER, DIMENSION(A2D(0)) :: imld ! 2D workspace
!!----------------------------------------------------------------------
!
! w-level of the turbocline and mixing layer (iom_use)
- imld(:,:) = mbkt(A2D(nn_hls)) + 1 ! Initialization to the number of w ocean point
- DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 ) ! from the bottom to nlb10
+ imld(:,:) = mbkt(A2D(0)) + 1 ! Initialization to the number of w ocean point
+ DO_3DS( 0, 0, 0, 0, jpkm1, nlb10, -1 ) ! from the bottom to nlb10
IF( avt (ji,jj,jk) < avt_c * wmask(ji,jj,jk) ) imld(ji,jj) = jk ! Turbocline
END_3D
! depth of the mixing layer
- DO_2D_OVR( 1, 1, 1, 1 )
+ DO_2D_OVR( 0, 0, 0, 0 )
iik = imld(ji,jj)
hmld (ji,jj) = gdepw(ji,jj,iik ,Kmm) * ssmask(ji,jj) ! Turbocline depth
END_2D
!
IF( .NOT.l_offline .AND. iom_use("mldkz5") ) THEN
IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN ! Do only on the last tile
- IF( ln_isfcav ) THEN ; CALL iom_put( "mldkz5" , hmld - risfdep ) ! turbocline thickness
- ELSE ; CALL iom_put( "mldkz5" , hmld ) ! turbocline depth
+ IF( ln_isfcav ) THEN ; CALL iom_put( "mldkz5" , hmld - risfdep(A2D(0)) ) ! turbocline thickness
+ ELSE ; CALL iom_put( "mldkz5" , hmld ) ! turbocline depth
END IF
ENDIF
ENDIF
diff --git a/src/OCE/ZDF/zdfphy.F90 b/src/OCE/ZDF/zdfphy.F90
index 5fbf2322015ec8b3097169ea4ac576cab62a9986..ed3c93b47840081fdf2af89725329c50900f5841 100644
--- a/src/OCE/ZDF/zdfphy.F90
+++ b/src/OCE/ZDF/zdfphy.F90
@@ -79,7 +79,7 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER, INTENT(in) :: Kmm ! time level index (middle)
!
- INTEGER :: jk ! dummy loop indices
+ INTEGER :: ji, jj, jk ! dummy loop indices
INTEGER :: ioptio, ios ! local integers
!!
NAMELIST/namzdf/ ln_zdfcst, ln_zdfric, ln_zdftke, ln_zdfgls, & ! type of closure scheme
@@ -164,13 +164,13 @@ CONTAINS
! ! -15S -5S : linear decrease from avt0 to avt0/10.
! ! -5S +5N : cst value avt0/10.
! ! 5N 15N : linear increase from avt0/10, to avt0
- WHERE(-15. <= gphit .AND. gphit < -5 ) avtb_2d = (1. - 0.09 * (gphit + 15.))
- WHERE( -5. <= gphit .AND. gphit < 5 ) avtb_2d = 0.1
- WHERE( 5. <= gphit .AND. gphit < 15 ) avtb_2d = (0.1 + 0.09 * (gphit - 5.))
+ WHERE(-15. <= gphit(A2D(0)) .AND. gphit(A2D(0)) < -5 ) avtb_2d = (1. - 0.09 * (gphit(A2D(0)) + 15.))
+ WHERE( -5. <= gphit(A2D(0)) .AND. gphit(A2D(0)) < 5 ) avtb_2d = 0.1
+ WHERE( 5. <= gphit(A2D(0)) .AND. gphit(A2D(0)) < 15 ) avtb_2d = (0.1 + 0.09 * (gphit(A2D(0)) - 5.))
ENDIF
!
DO jk = 1, jpk ! set turbulent closure Kz to the background value (avt_k, avm_k)
- avt_k(:,:,jk) = avtb_2d(:,:) * avtb(jk) * wmask (:,:,jk)
+ avt_k(:,:,jk) = avtb_2d(:,:) * avtb(jk) * wmask (A2D(0),jk)
avm_k(:,:,jk) = avmb(jk) * wmask (:,:,jk)
END DO
!!gm to be tested only the 1st & last levels
@@ -178,7 +178,7 @@ CONTAINS
! avt (:,:,jpk) = 0._wp ; avs(:,:,jpk) = 0._wp ; avm (:,:,jpk) = 0._wp
!!gm
avt (:,:,:) = 0._wp ; avs(:,:,:) = 0._wp ; avm (:,:,:) = 0._wp
-
+
! !== Convection ==!
!
IF( ln_zdfnpc .AND. ln_zdfevd ) CALL ctl_stop( 'zdf_phy_init: chose between ln_zdfnpc and ln_zdfevd' )
@@ -255,7 +255,7 @@ CONTAINS
INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! ocean time level indices
!
INTEGER :: ji, jj, jk ! dummy loop indice
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zsh2 ! shear production
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zsh2 ! shear production
!! ---------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('zdf_phy')
@@ -308,6 +308,9 @@ CONTAINS
CASE( np_TKE ) ; CALL zdf_tke( kt, Kbb, Kmm, zsh2, avm_k, avt_k ) ! TKE closure scheme for Kz
CASE( np_GLS ) ; CALL zdf_gls( kt, Kbb, Kmm, zsh2, avm_k, avt_k ) ! GLS closure scheme for Kz
CASE( np_OSM ) ; CALL zdf_osm( kt, Kbb, Kmm, Krhs, avm_k, avt_k ) ! OSMOSIS closure scheme for Kz
+ ! ! clem: osmosis currently cannot work because
+ ! it uses qns and qsr that are only defined in the interior (A2D(0))
+ ! we should do calculations in the interior and put a lbc_lnk at the end
! CASE( np_CST ) ! Constant Kz (reset avt, avm to the background value)
! ! avt_k and avm_k set one for all at initialisation phase
!!gm avt(2:jpim1,2:jpjm1,1:jpkm1) = rn_avt0 * wmask(2:jpim1,2:jpjm1,1:jpkm1)
@@ -323,13 +326,13 @@ CONTAINS
#endif
!
! !* start from turbulent closure values
- DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+ DO_3D_OVR( 0, 0, 0, 0, 2, jpkm1 )
avt(ji,jj,jk) = avt_k(ji,jj,jk)
avm(ji,jj,jk) = avm_k(ji,jj,jk)
END_3D
!
IF( ln_rnf_mouth ) THEN !* increase diffusivity at rivers mouths
- DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, nkrnf )
+ DO_3D_OVR( 0, 0, 0, 0, 2, nkrnf )
avt(ji,jj,jk) = avt(ji,jj,jk) + 2._wp * rn_avt_rnf * rnfmsk(ji,jj) * wmask(ji,jj,jk)
END_3D
ENDIF
@@ -340,7 +343,7 @@ CONTAINS
IF( ln_zdfddm ) THEN ! update avt and compute avs
CALL zdf_ddm( kt, Kmm, avm, avt, avs )
ELSE ! same mixing on all tracers
- DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
+ DO_3D_OVR( 0, 0, 0, 0, 1, jpkm1 )
avs(ji,jj,jk) = avt(ji,jj,jk)
END_3D
ENDIF
@@ -350,14 +353,18 @@ CONTAINS
IF( ln_zdfiwm ) CALL zdf_iwm( kt, Kmm, avm, avt, avs ) ! internal wave (de Lavergne et al 2017)
! !* Lateral boundary conditions (sign unchanged)
- IF(nn_hls==1) THEN ! if nn_hls==2 lbc_lnk done in stp routines
- IF( l_zdfsh2 ) THEN
- CALL lbc_lnk( 'zdfphy', avm_k, 'W', 1.0_wp , avt_k, 'W', 1.0_wp, &
- & avm , 'W', 1.0_wp , avt , 'W', 1.0_wp , avs , 'W', 1.0_wp )
- ELSE
- CALL lbc_lnk( 'zdfphy', avm , 'W', 1.0_wp , avt , 'W', 1.0_wp , avs , 'W', 1.0_wp )
- ENDIF
+ !clem: this is probably not compatible with tiling
+ !clem: calculating avm, avt and avt in the interior only allows to have most of SBC arrays only defined in the interior
+ ! but then one needs a lbc_lnk. If this lbc is critical, then one should get back to calculations on (nn_hls-1)
+!!$ IF(nn_hls==1) THEN ! if nn_hls==2 lbc_lnk done in stp routines
+ IF( l_zdfsh2 ) THEN
+ CALL lbc_lnk( 'zdfphy', avm, 'W', 1.0_wp, avm_k, 'W', 1.0_wp )
+ ELSE
+ CALL lbc_lnk( 'zdfphy', avm, 'W', 1.0_wp )
+ ENDIF
!
+!!$ ENDIF
+ IF(nn_hls==1) THEN
IF( l_zdfdrg ) THEN ! drag have been updated (non-linear cases)
IF( ln_isfcav ) THEN ; CALL lbc_lnk( 'zdfphy', rCdU_top, 'T', 1.0_wp , rCdU_bot, 'T', 1.0_wp ) ! top & bot drag
ELSE ; CALL lbc_lnk( 'zdfphy', rCdU_bot, 'T', 1.0_wp ) ! bottom drag only
@@ -379,10 +386,10 @@ CONTAINS
! diagnostics of energy dissipation
IF( iom_use('avt_k') .OR. iom_use('avm_k') .OR. iom_use('eshear_k') .OR. iom_use('estrat_k') ) THEN
IF( l_zdfsh2 ) THEN
- CALL iom_put( 'avt_k' , avt_k * wmask )
- CALL iom_put( 'avm_k' , avm_k * wmask )
- CALL iom_put( 'eshear_k', zsh2 * wmask )
- CALL iom_put( 'estrat_k', - avt_k * rn2 * wmask )
+ CALL iom_put( 'avt_k' , avt_k * wmask(A2D(0),:) )
+ CALL iom_put( 'avm_k' , avm_k * wmask(:,:,:) )
+ CALL iom_put( 'eshear_k', zsh2 * wmask(A2D(0),:) )
+ CALL iom_put( 'estrat_k', - avt_k * rn2 * wmask(A2D(0),:) )
ENDIF
ENDIF
!
diff --git a/src/OCE/ZDF/zdfric.F90 b/src/OCE/ZDF/zdfric.F90
index 655cf49cd9aa011a59cae2dba1d7a0e922caac5e..44a635a15f5520297e09cd7b2857ae34c1793d9d 100644
--- a/src/OCE/ZDF/zdfric.F90
+++ b/src/OCE/ZDF/zdfric.F90
@@ -145,18 +145,19 @@ CONTAINS
!! References : Pacanowski & Philander 1981, JPO, 1441-1451.
!! PFJ Lermusiaux 2001.
!!----------------------------------------------------------------------
- INTEGER , INTENT(in ) :: kt ! ocean time-step
- INTEGER , INTENT(in ) :: Kmm ! ocean time level index
- REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(in ) :: p_sh2 ! shear production term
- REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: p_avm, p_avt ! momentum and tracer Kz (w-points)
+ INTEGER , INTENT(in ) :: kt ! ocean time-step
+ INTEGER , INTENT(in ) :: Kmm ! ocean time level index
+ REAL(wp), DIMENSION(A2D(0),jpk), INTENT(in ) :: p_sh2 ! shear production term
+ REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: p_avm ! momentum Kz (w-points)
+ REAL(wp), DIMENSION(A2D(0),jpk), INTENT(inout) :: p_avt ! tracer Kz (w-points)
!!
INTEGER :: ji, jj, jk ! dummy loop indices
REAL(wp) :: zcfRi, zav, zustar, zhek ! local scalars
- REAL(wp), DIMENSION(A2D(nn_hls)) :: zh_ekm ! 2D workspace
+ REAL(wp), DIMENSION(A2D(0)) :: zh_ekm ! 2D workspace
!!----------------------------------------------------------------------
!
! !== avm and avt = F(Richardson number) ==!
- DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! coefficient = F(richardson number) (avm-weighted Ri)
+ DO_3D_OVR( 0, 0, 0, 0, 2, jpkm1 ) ! coefficient = F(richardson number) (avm-weighted Ri)
zcfRi = 1._wp / ( 1._wp + rn_alp * MAX( 0._wp , avm(ji,jj,jk) * rn2(ji,jj,jk) / ( p_sh2(ji,jj,jk) + 1.e-20 ) ) )
zav = rn_avmri * zcfRi**nn_ric
! ! avm and avt coefficients
@@ -169,12 +170,12 @@ CONTAINS
!
IF( ln_mldw ) THEN !== set a minimum value in the Ekman layer ==!
!
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D( 0, 0, 0, 0 )
zustar = SQRT( taum(ji,jj) * r1_rho0 )
zhek = rn_ekmfc * zustar / ( ABS( ff_t(ji,jj) ) + rsmall ) ! Ekman depth
zh_ekm(ji,jj) = MAX( rn_mldmin , MIN( zhek , rn_mldmax ) ) ! set allowed range
END_2D
- DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) !* minimum mixing coeff. within the Ekman layer
+ DO_3D_OVR( 0, 0, 0, 0, 2, jpkm1 ) !* minimum mixing coeff. within the Ekman layer
IF( gdept(ji,jj,jk,Kmm) < zh_ekm(ji,jj) ) THEN
p_avm(ji,jj,jk) = MAX( p_avm(ji,jj,jk), rn_wvmix ) * wmask(ji,jj,jk)
p_avt(ji,jj,jk) = MAX( p_avt(ji,jj,jk), rn_wtmix ) * wmask(ji,jj,jk)
diff --git a/src/OCE/ZDF/zdfsh2.F90 b/src/OCE/ZDF/zdfsh2.F90
index 1654a2e108794755cdf998476e0c3b505e01e364..8aa5a73402da70ef303cf23e959b8c22360dea7b 100644
--- a/src/OCE/ZDF/zdfsh2.F90
+++ b/src/OCE/ZDF/zdfsh2.F90
@@ -54,17 +54,17 @@ CONTAINS
!! *****
!! References : Bruchard, OM 2002
!! ---------------------------------------------------------------------
- INTEGER , INTENT(in ) :: Kbb, Kmm ! ocean time level indices
- REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: p_avm ! vertical eddy viscosity (w-points)
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) , INTENT( out) :: p_sh2 ! shear production of TKE (w-points)
+ INTEGER , INTENT(in ) :: Kbb, Kmm ! ocean time level indices
+ REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: p_avm ! vertical eddy viscosity (w-points)
+ REAL(wp), DIMENSION(A2D(0),jpk) , INTENT( out) :: p_sh2 ! shear production of TKE (w-points)
!
INTEGER :: ji, jj, jk ! dummy loop arguments
- REAL(wp), DIMENSION(A2D(nn_hls)) :: zsh2u, zsh2v ! 2D workspace
+ REAL(wp), DIMENSION(A2D(1)) :: zsh2u, zsh2v ! 2D workspace
!!--------------------------------------------------------------------
!
DO jk = 2, jpkm1 !* Shear production at uw- and vw-points (energy conserving form)
IF ( cpl_sdrftx .AND. ln_stshear ) THEN ! Surface Stokes Drift available ===>>> shear + stokes drift contibution
- DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
+ DO_2D( 1, 0, 1, 0 )
zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) ) &
& * ( uu (ji,jj,jk-1,Kmm) - uu (ji,jj,jk,Kmm) &
& + usd(ji,jj,jk-1) - usd(ji,jj,jk) ) &
@@ -77,7 +77,7 @@ CONTAINS
&/ ( e3vw(ji,jj,jk,Kmm) * e3vw(ji,jj,jk,Kbb) ) * wvmask(ji,jj,jk)
END_2D
ELSE
- DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) !* 2 x shear production at uw- and vw-points (energy conserving form)
+ DO_2D( 1, 0, 1, 0 ) !* 2 x shear production at uw- and vw-points (energy conserving form)
zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) ) &
& * ( uu(ji,jj,jk-1,Kmm) - uu(ji,jj,jk,Kmm) ) &
& * ( uu(ji,jj,jk-1,Kbb) - uu(ji,jj,jk,Kbb) ) &
@@ -90,12 +90,12 @@ CONTAINS
& * wvmask(ji,jj,jk)
END_2D
ENDIF
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) !* shear production at w-point ! coast mask: =2 at the coast ; =1 otherwise (NB: wmask useless as zsh2 are masked)
+ DO_2D( 0, 0, 0, 0 ) !* shear production at w-point ! coast mask: =2 at the coast ; =1 otherwise (NB: wmask useless as zsh2 are masked)
p_sh2(ji,jj,jk) = 0.25 * ( ( zsh2u(ji-1,jj) + zsh2u(ji,jj) ) * ( 2. - umask(ji-1,jj,jk) * umask(ji,jj,jk) ) &
& + ( zsh2v(ji,jj-1) + zsh2v(ji,jj) ) * ( 2. - vmask(ji,jj-1,jk) * vmask(ji,jj,jk) ) )
END_2D
END DO
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! set p_sh2 to 0 at the surface and bottom for output purpose
+ DO_2D( 0, 0, 0, 0 ) ! set p_sh2 to 0 at the surface and bottom for output purpose
p_sh2(ji,jj,1) = 0._wp
p_sh2(ji,jj,jpk) = 0._wp
END_2D
diff --git a/src/OCE/ZDF/zdfswm.F90 b/src/OCE/ZDF/zdfswm.F90
index 7c6f94d880a51483d01c0a01febba8e4f59b60cb..9a3b20585c3bbd4096f7b4ac3418085c805a845e 100644
--- a/src/OCE/ZDF/zdfswm.F90
+++ b/src/OCE/ZDF/zdfswm.F90
@@ -53,17 +53,17 @@ CONTAINS
!!
!! reference : Qiao et al. GRL, 2004
!!---------------------------------------------------------------------
- INTEGER , INTENT(in ) :: kt ! ocean time step
- INTEGER , INTENT(in ) :: Kmm ! time level index
- REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: p_avm ! momentum Kz (w-points)
- REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: p_avt, p_avs ! tracer Kz (w-points)
+ INTEGER , INTENT(in ) :: kt ! ocean time step
+ INTEGER , INTENT(in ) :: Kmm ! time level index
+ REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: p_avm ! momentum Kz (w-points)
+ REAL(wp), DIMENSION(A2D(0),jpk) , INTENT(inout) :: p_avt, p_avs ! tracer Kz (w-points)
!
INTEGER :: ji, jj, jk ! dummy loop indices
REAL(wp):: zcoef, zqb ! local scalar
!!---------------------------------------------------------------------
!
zcoef = 1._wp * 0.353553_wp
- DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+ DO_3D_OVR( 0, 0, 0, 0, 2, jpkm1 )
zqb = zcoef * hsw(ji,jj) * tsd2d(ji,jj) * EXP( -3. * wnum(ji,jj) * gdepw(ji,jj,jk,Kmm) ) * wmask(ji,jj,jk)
!
p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zqb
diff --git a/src/OCE/ZDF/zdftke.F90 b/src/OCE/ZDF/zdftke.F90
index 4d3adbd3e83c02c0f3c65f59097220966c61052a..60371fbcd60ecb0cfba7b84e8af95601aaa84334 100644
--- a/src/OCE/ZDF/zdftke.F90
+++ b/src/OCE/ZDF/zdftke.F90
@@ -56,9 +56,7 @@ MODULE zdftke
USE in_out_manager ! I/O manager
USE iom ! I/O manager library
USE lib_mpp ! MPP library
- USE lbclnk ! ocean lateral boundary conditions (or mpp link)
USE prtctl ! Print control
- USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
USE sbcwave ! Surface boundary waves
IMPLICIT NONE
@@ -114,7 +112,7 @@ CONTAINS
!!----------------------------------------------------------------------
!! *** FUNCTION zdf_tke_alloc ***
!!----------------------------------------------------------------------
- ALLOCATE( htau(jpi,jpj) , dissl(jpi,jpj,jpk) , apdlr(jpi,jpj,jpk) , STAT= zdf_tke_alloc )
+ ALLOCATE( htau(A2D(0)) , dissl(A2D(0),jpk) , apdlr(A2D(0),jpk) , STAT= zdf_tke_alloc )
!
CALL mpp_sum ( 'zdftke', zdf_tke_alloc )
IF( zdf_tke_alloc /= 0 ) CALL ctl_stop( 'STOP', 'zdf_tke_alloc: failed to allocate arrays' )
@@ -167,10 +165,11 @@ CONTAINS
!! Axell, JGR, 2002
!! Bruchard OM 2002
!!----------------------------------------------------------------------
- INTEGER , INTENT(in ) :: kt ! ocean time step
- INTEGER , INTENT(in ) :: Kbb, Kmm ! ocean time level indices
- REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(in ) :: p_sh2 ! shear production term
- REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: p_avm, p_avt ! momentum and tracer Kz (w-points)
+ INTEGER , INTENT(in ) :: kt ! ocean time step
+ INTEGER , INTENT(in ) :: Kbb, Kmm ! ocean time level indices
+ REAL(wp), DIMENSION(A2D(0),jpk), INTENT(in ) :: p_sh2 ! shear production term
+ REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: p_avm ! momentum Kz (w-points)
+ REAL(wp), DIMENSION(A2D(0),jpk), INTENT(inout) :: p_avt ! tracer Kz (w-points)
!!----------------------------------------------------------------------
!
CALL tke_tke( Kbb, Kmm, p_sh2, p_avm, p_avt ) ! now tke (en)
@@ -200,9 +199,10 @@ CONTAINS
!! ---------------------------------------------------------------------
USE zdf_oce , ONLY : en ! ocean vertical physics
!!
- INTEGER , INTENT(in ) :: Kbb, Kmm ! ocean time level indices
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) , INTENT(in ) :: p_sh2 ! shear production term
- REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: p_avm, p_avt ! vertical eddy viscosity & diffusivity (w-points)
+ INTEGER , INTENT(in ) :: Kbb, Kmm ! ocean time level indices
+ REAL(wp), DIMENSION(A2D(0),jpk) , INTENT(in ) :: p_sh2 ! shear production term
+ REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: p_avm ! momentum Kz (w-points)
+ REAL(wp), DIMENSION(A2D(0),jpk) , INTENT(in ) :: p_avt ! tracer Kz (w-points)
!
INTEGER :: ji, jj, jk ! dummy loop arguments
REAL(wp) :: zetop, zebot, zmsku, zmskv ! local scalars
@@ -215,9 +215,9 @@ CONTAINS
REAL(wp) :: zus , zwlc , zind ! - -
REAL(wp) :: zzd_up, zzd_lw ! - -
REAL(wp) :: ztaui, ztauj, z1_norm
- INTEGER , DIMENSION(A2D(nn_hls)) :: imlc
- REAL(wp), DIMENSION(A2D(nn_hls)) :: zice_fra, zhlc, zus3, zWlc2
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zpelc, zdiag, zd_up, zd_lw
+ INTEGER , DIMENSION(A2D(0)) :: imlc
+ REAL(wp), DIMENSION(A2D(0)) :: zice_fra, zhlc, zus3, zWlc2
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zpelc, zdiag, zd_up, zd_lw
REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztmp ! for diags
!!--------------------------------------------------------------------
!
@@ -232,16 +232,16 @@ CONTAINS
! ice fraction considered for attenuation of langmuir & wave breaking
SELECT CASE ( nn_eice )
CASE( 0 ) ; zice_fra(:,:) = 0._wp
- CASE( 1 ) ; zice_fra(:,:) = TANH( fr_i(A2D(nn_hls)) * 10._wp )
- CASE( 2 ) ; zice_fra(:,:) = fr_i(A2D(nn_hls))
- CASE( 3 ) ; zice_fra(:,:) = MIN( 4._wp * fr_i(A2D(nn_hls)) , 1._wp )
+ CASE( 1 ) ; zice_fra(:,:) = TANH( fr_i(A2D(0)) * 10._wp )
+ CASE( 2 ) ; zice_fra(:,:) = fr_i(A2D(0))
+ CASE( 3 ) ; zice_fra(:,:) = MIN( 4._wp * fr_i(A2D(0)) , 1._wp )
END SELECT
!
! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
! ! Surface/top/bottom boundary condition on tke
! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
!
- DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D_OVR( 0, 0, 0, 0 )
en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) )
zdiag(ji,jj,1) = 1._wp/en(ji,jj,1)
zd_lw(ji,jj,1) = 1._wp
@@ -258,7 +258,7 @@ CONTAINS
!
IF( .NOT.ln_drg_OFF ) THEN !== friction used as top/bottom boundary condition on TKE
!
- DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! bottom friction
+ DO_2D_OVR( 0, 0, 0, 0 ) ! bottom friction
zmsku = ( 2. - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) )
zmskv = ( 2. - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) )
! ! where 0.001875 = (rn_ebb0/rho0) * 0.5 = 3.75*0.5/1000. (CAUTION CdU<0)
@@ -267,7 +267,7 @@ CONTAINS
en(ji,jj,mbkt(ji,jj)+1) = MAX( zebot, rn_emin ) * ssmask(ji,jj)
END_2D
IF( ln_isfcav ) THEN
- DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! top friction
+ DO_2D_OVR( 0, 0, 0, 0 ) ! top friction
zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) )
zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) )
! ! where 0.001875 = (rn_ebb0/rho0) * 0.5 = 3.75*0.5/1000. (CAUTION CdU<0)
@@ -294,14 +294,14 @@ CONTAINS
! ! 1/2 (W_lc)^2 = MAX( u* u_s + v* v_s , 0 ) only the positive part
!!gm ! PS: currently we don't have neither the 2 stress components at t-point !nor the angle between u* and u_s
!!gm ! so we will overestimate the LC velocity.... !!gm I will do the work if !LC have an effect !
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D( 0, 0, 0, 0 )
!!XC zWlc2(ji,jj) = 0.5_wp * SQRT( taum(ji,jj) * r1_rho0 * ( ut0sd(ji,jj)**2 +vt0sd(ji,jj)**2 ) )
zWlc2(ji,jj) = 0.5_wp * ( ut0sd(ji,jj)**2 +vt0sd(ji,jj)**2 )
END_2D
!
! Projection of Stokes drift in the wind stress direction
!
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D( 0, 0, 0, 0 )
ztaui = utau(ji,jj)
ztauj = vtau(ji,jj)
z1_norm = 1._wp / MAX( SQRT(ztaui*ztaui+ztauj*ztauj), 1.e-12 ) * tmask(ji,jj,1)
@@ -313,7 +313,7 @@ CONTAINS
! ! Wlc = 0.016 * [|tau|/(rho_air Cdrag) ]^1/2 and thus:
! ! 1/2 Wlc^2 = 0.5 * 0.016 * 0.016 |tau| /( rho_air Cdrag )
zcof = 0.5 * 0.016 * 0.016 / ( zrhoa * zcdrag ) ! to convert stress in 10m wind using a constant drag
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D( 0, 0, 0, 0 )
zWlc2(ji,jj) = zcof * taum(ji,jj)
END_2D
!
@@ -321,30 +321,30 @@ CONTAINS
!
! !* Depth of the LC circulation (Axell 2002, Eq.47)
! !- LHS of Eq.47
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D( 0, 0, 0, 0 )
zpelc(ji,jj,1) = MAX( rn2b(ji,jj,1), 0._wp ) * gdepw(ji,jj,1,Kmm) * e3w(ji,jj,1,Kmm)
END_2D
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpk )
+ DO_3D( 0, 0, 0, 0, 2, jpk )
zpelc(ji,jj,jk) = zpelc(ji,jj,jk-1) + &
& MAX( rn2b(ji,jj,jk), 0._wp ) * gdepw(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm)
END_3D
!
! !- compare LHS to RHS of Eq.47
- imlc(:,:) = mbkt(A2D(nn_hls)) + 1 ! Initialization to the number of w ocean point (=2 over land)
- DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpkm1, 2, -1 )
+ imlc(:,:) = mbkt(A2D(0)) + 1 ! Initialization to the number of w ocean point (=2 over land)
+ DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 )
IF( zpelc(ji,jj,jk) > zWlc2(ji,jj) ) imlc(ji,jj) = jk
END_3D
! ! finite LC depth
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D( 0, 0, 0, 0 )
zhlc(ji,jj) = gdepw(ji,jj,imlc(ji,jj),Kmm)
END_2D
!
zcof = 0.016 / SQRT( zrhoa * zcdrag )
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D( 0, 0, 0, 0 )
zus = SQRT( 2. * zWlc2(ji,jj) ) ! Stokes drift
zus3(ji,jj) = MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * zus * zus * zus * tmask(ji,jj,1) ! zus > 0. ok
END_2D
- DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) !* TKE Langmuir circulation source term added to en
+ DO_3D_OVR( 0, 0, 0, 0, 2, jpkm1 ) !* TKE Langmuir circulation source term added to en
IF ( zus3(ji,jj) /= 0._wp ) THEN
IF ( gdepw(ji,jj,jk,Kmm) - zhlc(ji,jj) < 0 .AND. wmask(ji,jj,jk) /= 0. ) THEN
! ! vertical velocity due to LC
@@ -365,7 +365,7 @@ CONTAINS
! ! zdiag : diagonal zd_up : upper diagonal zd_lw : lower diagonal
!
IF( nn_pdl == 1 ) THEN !* Prandtl number = F( Ri )
- DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+ DO_3D_OVR( 0, 0, 0, 0, 2, jpkm1 )
! ! local Richardson number
IF (rn2b(ji,jj,jk) <= 0.0_wp) then
zri = 0.0_wp
@@ -377,7 +377,7 @@ CONTAINS
END_3D
ENDIF
!
- DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) !* Matrix and right hand side in en
+ DO_3D_OVR( 0, 0, 0, 0, 2, jpkm1 ) !* Matrix and right hand side in en
zcof = zfact1 * tmask(ji,jj,jk)
! ! A minimum of 2.e-5 m2/s is imposed on TKE vertical
! ! eddy coefficient (ensure numerical stability)
@@ -406,14 +406,14 @@ CONTAINS
SELECT CASE (nn_bc_surf) ! Boundary Condition using surface TKE flux from waves
CASE ( 0 ) ! Dirichlet BC
- DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! en(1) = rn_ebb taum / rho0 (min value rn_emin0)
+ DO_2D_OVR( 0, 0, 0, 0 ) ! en(1) = rn_ebb taum / rho0 (min value rn_emin0)
IF ( phioc(ji,jj) < 0 ) phioc(ji,jj) = 0._wp
en(ji,jj,1) = MAX( rn_emin0, .5 * ( 15.8 * phioc(ji,jj) / rho0 )**(2./3.) ) * tmask(ji,jj,1)
zdiag(ji,jj,1) = 1._wp/en(ji,jj,1) ! choose to keep coherence with former estimation of
END_2D
CASE ( 1 ) ! Neumann BC
- DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D_OVR( 0, 0, 0, 0 )
IF ( phioc(ji,jj) < 0 ) phioc(ji,jj) = 0._wp
en(ji,jj,2) = en(ji,jj,2) + ( rn_Dt * phioc(ji,jj) / rho0 ) /e3w(ji,jj,2,Kmm)
en(ji,jj,1) = en(ji,jj,2) + (2 * e3t(ji,jj,1,Kmm) * phioc(ji,jj)/rho0) / ( p_avm(ji,jj,1) + p_avm(ji,jj,2) )
@@ -427,23 +427,23 @@ CONTAINS
ENDIF
!
! !* Matrix inversion from level 2 (tke prescribed at level 1)
- DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
+ DO_3D_OVR( 0, 0, 0, 0, 2, jpkm1 ) ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1)
END_3D
!XC : commented to allow for neumann boundary condition
! DO_2D( 0, 0, 0, 0 )
! zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1) ! Surface boudary conditions on tke
! END_2D
- DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+ DO_3D_OVR( 0, 0, 0, 0, 2, jpkm1 )
zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) *zd_lw(ji,jj,jk-1)
END_3D
- DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
+ DO_2D_OVR( 0, 0, 0, 0 ) ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
en(ji,jj,jpkm1) = zd_lw(ji,jj,jpkm1) / zdiag(ji,jj,jpkm1)
END_2D
- DO_3DS_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpk-2, 2, -1 )
+ DO_3DS_OVR( 0, 0, 0, 0, jpk-2, 2, -1 )
en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk)
END_3D
- DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! set the minimum value of tke
+ DO_3D_OVR( 0, 0, 0, 0, 2, jpkm1 ) ! set the minimum value of tke
en(ji,jj,jk) = MAX( en(ji,jj,jk), rn_emin ) * wmask(ji,jj,jk)
END_3D
!
@@ -451,11 +451,11 @@ CONTAINS
! ediss = Ce*sqrt(en)/L*en
! dissl = sqrt(en)/L
IF( iom_use('ediss_k') ) THEN
- ALLOCATE( ztmp(A2D(nn_hls),jpk) )
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
+ ALLOCATE( ztmp(A2D(0),jpk) )
+ DO_3D( 0, 0, 0, 0, 1, jpkm1 )
ztmp(ji,jj,jk) = zfact3 * dissl(ji,jj,jk) * en(ji,jj,jk) * wmask(ji,jj,jk)
END_3D
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D( 0, 0, 0, 0 )
ztmp(ji,jj,jpk) = 0._wp
END_2D
CALL iom_put( 'ediss_k', ztmp )
@@ -471,18 +471,18 @@ CONTAINS
! penetration is partly switched off below sea-ice if nn_eice/=0
!
IF( nn_etau == 1 ) THEN !* penetration below the mixed layer (rn_efr fraction)
- DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+ DO_3D_OVR( 0, 0, 0, 0, 2, jpkm1 )
en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) ) &
& * MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1)
END_3D
ELSEIF( nn_etau == 2 ) THEN !* act only at the base of the mixed layer (jk=nmln) (rn_efr fraction)
- DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D_OVR( 0, 0, 0, 0 )
jk = nmln(ji,jj)
en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) ) &
& * MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1)
END_2D
ELSEIF( nn_etau == 3 ) THEN !* penetration belox the mixed layer (HF variability)
- DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+ DO_3D_OVR( 0, 0, 0, 0, 2, jpkm1 )
ztau = SQRT( utau(ji,jj)*utau(ji,jj) + vtau(ji,jj)*vtau(ji,jj) ) * tmask(ji,jj,1) ! module of the mean stress
zdif = taum(ji,jj) - ztau ! mean of modulus - modulus of the mean
zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add ) ! apply some modifications...
@@ -530,14 +530,15 @@ CONTAINS
!!----------------------------------------------------------------------
USE zdf_oce , ONLY : en, avtb, avmb, avtb_2d ! ocean vertical physics
!!
- INTEGER , INTENT(in ) :: Kbb, Kmm ! ocean time level indices
- REAL(wp), DIMENSION(:,:,:), INTENT( out) :: p_avm, p_avt ! vertical eddy viscosity & diffusivity (w-points)
+ INTEGER , INTENT(in ) :: Kbb, Kmm ! ocean time level indices
+ REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: p_avm ! momentum Kz (w-points)
+ REAL(wp), DIMENSION(A2D(0),jpk), INTENT( out) :: p_avt ! tracer Kz (w-points)
!
INTEGER :: ji, jj, jk ! dummy loop indices
REAL(wp) :: zrn2, zraug, zcoef, zav ! local scalars
REAL(wp) :: zdku, zdkv, zsqen ! - -
REAL(wp) :: zemxl, zemlm, zemlp, zmaxice ! - -
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zmxlm, zmxld ! 3D workspace
+ REAL(wp), DIMENSION(A2D(0),jpk) :: zmxlm, zmxld ! 3D workspace
!!--------------------------------------------------------------------
!
! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
@@ -561,25 +562,25 @@ CONTAINS
!
zraug = vkarmn * 2.e5_wp / ( rho0 * grav )
#if ! defined key_si3 && ! defined key_cice
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! No sea-ice
+ DO_2D( 0, 0, 0, 0 ) ! No sea-ice
zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1)
END_2D
#else
SELECT CASE( nn_mxlice ) ! Type of scaling under sea-ice
!
CASE( 0 ) ! No scaling under sea-ice
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D( 0, 0, 0, 0 )
zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1)
END_2D
!
CASE( 1 ) ! scaling with constant sea-ice thickness
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D( 0, 0, 0, 0 )
zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + &
& fr_i(ji,jj) * rn_mxlice ) * tmask(ji,jj,1)
END_2D
!
CASE( 2 ) ! scaling with mean sea-ice thickness
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D( 0, 0, 0, 0 )
#if defined key_si3
zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + &
& fr_i(ji,jj) * hm_i(ji,jj) * 2._wp ) * tmask(ji,jj,1)
@@ -591,7 +592,7 @@ CONTAINS
END_2D
!
CASE( 3 ) ! scaling with max sea-ice thickness
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D( 0, 0, 0, 0 )
zmaxice = MAXVAL( h_i(ji,jj,:) )
zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + &
& fr_i(ji,jj) * zmaxice ) * tmask(ji,jj,1)
@@ -600,7 +601,7 @@ CONTAINS
END SELECT
#endif
!
- DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+ DO_2D( 0, 0, 0, 0 )
zmxlm(ji,jj,1) = MAX( rn_mxl0, zmxlm(ji,jj,1) )
END_2D
!
@@ -609,7 +610,7 @@ CONTAINS
ENDIF
ENDIF
!
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+ DO_3D( 0, 0, 0, 0, 2, jpkm1 )
zrn2 = MAX( rn2(ji,jj,jk), rsmall )
zmxlm(ji,jj,jk) = MAX( rmxl_min, SQRT( 2._wp * en(ji,jj,jk) / zrn2 ) )
END_3D
@@ -624,7 +625,7 @@ CONTAINS
!!gm Not sure of that coding for ISF....
! where wmask = 0 set zmxlm == e3w(:,:,:,Kmm)
CASE ( 0 ) ! bounded by the distance to surface and bottom
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+ DO_3D( 0, 0, 0, 0, 2, jpkm1 )
zemxl = MIN( gdepw(ji,jj,jk,Kmm) - gdepw(ji,jj,mikt(ji,jj),Kmm), zmxlm(ji,jj,jk), &
& gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) - gdepw(ji,jj,jk,Kmm) )
! wmask prevent zmxlm = 0 if jk = mikt(ji,jj)
@@ -635,33 +636,33 @@ CONTAINS
END_3D
!
CASE ( 1 ) ! bounded by the vertical scale factor
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+ DO_3D( 0, 0, 0, 0, 2, jpkm1 )
zemxl = MIN( e3w(ji,jj,jk,Kmm), zmxlm(ji,jj,jk) )
zmxlm(ji,jj,jk) = zemxl
zmxld(ji,jj,jk) = zemxl
END_3D
!
CASE ( 2 ) ! |dk[xml]| bounded by e3t :
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! from the surface to the bottom :
+ DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! from the surface to the bottom :
zmxlm(ji,jj,jk) = &
& MIN( zmxlm(ji,jj,jk-1) + e3t(ji,jj,jk-1,Kmm), zmxlm(ji,jj,jk) )
END_3D
- DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpkm1, 2, -1 ) ! from the bottom to the surface :
+ DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 ) ! from the bottom to the surface :
zemxl = MIN( zmxlm(ji,jj,jk+1) + e3t(ji,jj,jk+1,Kmm), zmxlm(ji,jj,jk) )
zmxlm(ji,jj,jk) = zemxl
zmxld(ji,jj,jk) = zemxl
END_3D
!
CASE ( 3 ) ! lup and ldown, |dk[xml]| bounded by e3t :
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! from the surface to the bottom : lup
+ DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! from the surface to the bottom : lup
zmxld(ji,jj,jk) = &
& MIN( zmxld(ji,jj,jk-1) + e3t(ji,jj,jk-1,Kmm), zmxlm(ji,jj,jk) )
END_3D
- DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpkm1, 2, -1 ) ! from the bottom to the surface : ldown
+ DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 ) ! from the bottom to the surface : ldown
zmxlm(ji,jj,jk) = &
& MIN( zmxlm(ji,jj,jk+1) + e3t(ji,jj,jk+1,Kmm), zmxlm(ji,jj,jk) )
END_3D
- DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+ DO_3D( 0, 0, 0, 0, 2, jpkm1 )
zemlm = MIN ( zmxld(ji,jj,jk), zmxlm(ji,jj,jk) )
zemlp = SQRT( zmxld(ji,jj,jk) * zmxlm(ji,jj,jk) )
zmxlm(ji,jj,jk) = zemlm
@@ -673,7 +674,7 @@ CONTAINS
! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
! ! Vertical eddy viscosity and diffusivity (avm and avt)
! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
- DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) !* vertical eddy viscosity & diffivity at w-points
+ DO_3D_OVR( 0, 0, 0, 0, 1, jpkm1 ) !* vertical eddy viscosity & diffivity at w-points
zsqen = SQRT( en(ji,jj,jk) )
zav = rn_ediff * zmxlm(ji,jj,jk) * zsqen
p_avm(ji,jj,jk) = MAX( zav, avmb(jk) ) * wmask(ji,jj,jk)
@@ -683,7 +684,7 @@ CONTAINS
!
!
IF( nn_pdl == 1 ) THEN !* Prandtl number case: update avt
- DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+ DO_3D_OVR( 0, 0, 0, 0, 2, jpkm1 )
p_avt(ji,jj,jk) = MAX( apdlr(ji,jj,jk) * p_avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk)
END_3D
ENDIF
@@ -817,9 +818,9 @@ CONTAINS
IF( nn_etau /= 0 ) THEN
SELECT CASE( nn_htau ) ! Choice of the depth of penetration
CASE( 0 ) ! constant depth penetration (here 10 meters)
- htau(:,:) = 10._wp
+ htau(A2D(0)) = 10._wp
CASE( 1 ) ! F(latitude) : 0.5m to 30m poleward of 40 degrees
- htau(:,:) = MAX( 0.5_wp, MIN( 30._wp, 45._wp* ABS( SIN( rpi/180._wp * gphit(:,:) ) ) ) )
+ htau(A2D(0)) = MAX( 0.5_wp, MIN( 30._wp, 45._wp* ABS( SIN( rpi/180._wp * gphit(A2D(0)) ) ) ) )
END SELECT
ENDIF
! !* read or initialize all required files
@@ -863,14 +864,14 @@ CONTAINS
ELSE ! start TKE from rest
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' ==>>> previous run without TKE scheme, set en to background values'
- en (:,:,:) = rn_emin * wmask(:,:,:)
+ en (:,:,:) = rn_emin * wmask(A2D(0),:)
dissl(:,:,:) = 1.e-12_wp
! avt_k, avm_k already set to the background value in zdf_phy_init
ENDIF
ELSE !* Start from rest
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' ==>>> start from rest: set en to the background value'
- en (:,:,:) = rn_emin * wmask(:,:,:)
+ en (:,:,:) = rn_emin * wmask(A2D(0),:)
dissl(:,:,:) = 1.e-12_wp
! avt_k, avm_k already set to the background value in zdf_phy_init
ENDIF
diff --git a/src/OCE/do_loop_substitute.h90 b/src/OCE/do_loop_substitute.h90
index f957d0741b54399e90fba13f4876ae152b2ea041..c6db00d51aef101b5ca421abf373c001deeffedc 100644
--- a/src/OCE/do_loop_substitute.h90
+++ b/src/OCE/do_loop_substitute.h90
@@ -58,7 +58,10 @@
!
#endif
-#define DO_2D(L, R, B, T) DO jj = ntsj-(B), ntej+(T) ; DO ji = ntsi-(L), ntei+(R)
+#define DO_1Di(L, R) DO ji = ntsi-(L), ntei+(R)
+#define DO_1Dj(B, T) DO jj = ntsj-(B), ntej+(T)
+#define DO_2Dik(L, R, ks, ke, ki) DO jk = ks, ke, ki ; DO_1Di(L, R)
+#define DO_2D(L, R, B, T) DO_1Dj(B, T) ; DO_1Di(L, R)
#define DO_2D_OVR(L, R, B, T) DO_2D(L-(L+R)*nthl, R-(R+L)*nthr, B-(B+T)*nthb, T-(T+B)*ntht)
#define A1Di(H) ntsi-(H):ntei+(H)
#define A1Dj(H) ntsj-(H):ntej+(H)
@@ -76,5 +79,6 @@
#define DO_3DS(L, R, B, T, ks, ke, ki) DO jk = ks, ke, ki ; DO_2D(L, R, B, T)
#define DO_3DS_OVR(L, R, B, T, ks, ke, ki) DO jk = ks, ke, ki ; DO_2D_OVR(L, R, B, T)
+#define END_1D END DO
#define END_2D END DO ; END DO
-#define END_3D END DO ; END DO ; END DO
+#define END_3D END DO ; END DO ; END DO
\ No newline at end of file
diff --git a/src/OCE/lib_fortran.F90 b/src/OCE/lib_fortran.F90
index b621373e6eb7b7356db171bbc204f30793c73063..ded29e259a8577fe61084798a745f9299e5e0bd6 100644
--- a/src/OCE/lib_fortran.F90
+++ b/src/OCE/lib_fortran.F90
@@ -88,6 +88,22 @@ CONTAINS
# define DIM_3d
# include "lib_fortran_generic.h90"
# undef DIM_3d
+# define LOCALONLY
+# define DIM_2d
+# include "lib_fortran_generic.h90"
+# undef DIM_2d
+# define DIM_3d
+# include "lib_fortran_generic.h90"
+# undef DIM_3d
+# undef LOCALONLY
+# define VEC
+# define DIM_3d
+# include "lib_fortran_generic.h90"
+# undef DIM_3d
+# define DIM_4d
+# include "lib_fortran_generic.h90"
+# undef DIM_4d
+# undef VEC
# undef GLOBSUM_CODE
# define GLOBMINMAX_CODE
@@ -107,71 +123,26 @@ CONTAINS
# include "lib_fortran_generic.h90"
# undef OPERATION_GLOBMAX
# undef DIM_3
+# define VEC
+# define DIM_3d
+# define OPERATION_GLOBMIN
+# include "lib_fortran_generic.h90"
+# undef OPERATION_GLOBMIN
+# define OPERATION_GLOBMAX
+# include "lib_fortran_generic.h90"
+# undef OPERATION_GLOBMAX
+# undef DIM_3d
+# define DIM_4d
+# define OPERATION_GLOBMIN
+# include "lib_fortran_generic.h90"
+# undef OPERATION_GLOBMIN
+# define OPERATION_GLOBMAX
+# include "lib_fortran_generic.h90"
+# undef OPERATION_GLOBMAX
+# undef DIM_4d
+# undef VEC
# undef GLOBMINMAX_CODE
-! ! FUNCTION local_sum !
-
- FUNCTION local_sum_2d( ptab )
- !!----------------------------------------------------------------------
- REAL(wp), INTENT(in ) :: ptab(:,:) ! array on which operation is applied
- COMPLEX(dp) :: local_sum_2d
- !
- !!-----------------------------------------------------------------------
- !
- COMPLEX(dp):: ctmp
- REAL(wp) :: ztmp
- INTEGER :: ji, jj ! dummy loop indices
- INTEGER :: ipi, ipj ! dimensions
- !!-----------------------------------------------------------------------
- !
- ipi = SIZE(ptab,1) ! 1st dimension
- ipj = SIZE(ptab,2) ! 2nd dimension
- !
- ctmp = CMPLX( 0.e0, 0.e0, wp ) ! warning ctmp is cumulated
-
- DO jj = 1, ipj
- DO ji = 1, ipi
- ztmp = ptab(ji,jj) * tmask_i(ji,jj)
- CALL DDPDD( CMPLX( ztmp, 0.e0, dp ), ctmp )
- END DO
- END DO
- !
- local_sum_2d = ctmp
-
- END FUNCTION local_sum_2d
-
- FUNCTION local_sum_3d( ptab )
- !!----------------------------------------------------------------------
- REAL(wp), INTENT(in ) :: ptab(:,:,:) ! array on which operation is applied
- COMPLEX(dp) :: local_sum_3d
- !
- !!-----------------------------------------------------------------------
- !
- COMPLEX(dp):: ctmp
- REAL(wp) :: ztmp
- INTEGER :: ji, jj, jk ! dummy loop indices
- INTEGER :: ipi, ipj, ipk ! dimensions
- !!-----------------------------------------------------------------------
- !
- ipi = SIZE(ptab,1) ! 1st dimension
- ipj = SIZE(ptab,2) ! 2nd dimension
- ipk = SIZE(ptab,3) ! 3rd dimension
- !
- ctmp = CMPLX( 0.e0, 0.e0, wp ) ! warning ctmp is cumulated
-
- DO jk = 1, ipk
- DO jj = 1, ipj
- DO ji = 1, ipi
- ztmp = ptab(ji,jj,jk) * tmask_i(ji,jj)
- CALL DDPDD( CMPLX( ztmp, 0.e0, dp ), ctmp )
- END DO
- END DO
- END DO
- !
- local_sum_3d = ctmp
-
- END FUNCTION local_sum_3d
-
! ! FUNCTION sum3x3 !
SUBROUTINE sum3x3_2d( p2d )
@@ -191,11 +162,11 @@ CONTAINS
! work over the whole domain (guarantees all internal cells are set when nn_hls=2)
!
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- IF( MOD(mig(ji), 3) == MOD(nn_hls, 3) .AND. & ! 1st bottom left corner always at (Nis0-1, Njs0-1)
- & MOD(mjg(jj), 3) == MOD(nn_hls, 3) ) THEN ! bottom left corner of a 3x3 box
- ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1 ! right position of the box
- jj2 = MIN(mjg(jj)+2, jpjglo) - njmpp + 1 ! upper position of the box
- IF( ji2 <= jpi .AND. jj2 <= jpj ) THEN ! the box is fully included in the local mpi domain
+ IF( MOD(mig(ji,nn_hls), 3) == MOD(nn_hls, 3) .AND. & ! 1st bottom left corner always at (Nis0-1, Njs0-1)
+ & MOD(mjg(jj,nn_hls), 3) == MOD(nn_hls, 3) ) THEN ! bottom left corner of a 3x3 box
+ ji2 = MIN(mig(ji,nn_hls)+2, jpiglo) - nimpp + 1 ! right position of the box
+ jj2 = MIN(mjg(jj,nn_hls)+2, jpjglo) - njmpp + 1 ! upper position of the box
+ IF( ji2 <= jpi .AND. jj2 <= jpj ) THEN ! the box is fully included in the local mpi domain
p2d(ji:ji2,jj:jj2) = SUM(p2d(ji:ji2,jj:jj2))
ENDIF
ENDIF
@@ -203,23 +174,23 @@ CONTAINS
CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1.0_wp )
! no need for 2nd exchange when nn_hls > 1
IF( nn_hls == 1 ) THEN
- IF( mpiRnei(nn_hls,jpwe) > -1 ) THEN ! 1st column was changed during the previous call to lbc_lnk
- IF( MOD(mig( 1), 3) == 1 ) & ! 1st box start at i=1 -> column 1 to 3 correctly computed locally
- p2d( 1,:) = p2d( 2,:) ! previous lbc_lnk corrupted column 1 -> put it back using column 2
- IF( MOD(mig( 1), 3) == 2 ) & ! 1st box start at i=3 -> column 1 and 2 correctly computed on west neighbourh
- p2d( 2,:) = p2d( 1,:) ! previous lbc_lnk fix column 1 -> copy it to column 2
+ IF( mpiRnei(nn_hls,jpwe) > -1 ) THEN ! 1st column was changed during the previous call to lbc_lnk
+ IF( MOD(mig( 1,nn_hls), 3) == 1 ) & ! 1st box start at i=1 -> column 1 to 3 correctly computed locally
+ p2d( 1,:) = p2d( 2,:) ! previous lbc_lnk corrupted column 1 -> put it back using column 2
+ IF( MOD(mig( 1,nn_hls), 3) == 2 ) & ! 1st box start at i=3 -> column 1 and 2 correctly computed on w-neighbourh
+ p2d( 2,:) = p2d( 1,:) ! previous lbc_lnk fix column 1 -> copy it to column 2
ENDIF
IF( mpiRnei(nn_hls,jpea) > -1 ) THEN
- IF( MOD(mig(jpi-2), 3) == 1 ) p2d( jpi,:) = p2d(jpi-1,:)
- IF( MOD(mig(jpi-2), 3) == 0 ) p2d(jpi-1,:) = p2d( jpi,:)
+ IF( MOD(mig(jpi-2,nn_hls), 3) == 1 ) p2d( jpi,:) = p2d(jpi-1,:)
+ IF( MOD(mig(jpi-2,nn_hls), 3) == 0 ) p2d(jpi-1,:) = p2d( jpi,:)
ENDIF
IF( mpiRnei(nn_hls,jpso) > -1 ) THEN
- IF( MOD(mjg( 1), 3) == 1 ) p2d(:, 1) = p2d(:, 2)
- IF( MOD(mjg( 1), 3) == 2 ) p2d(:, 2) = p2d(:, 1)
+ IF( MOD(mjg( 1,nn_hls), 3) == 1 ) p2d(:, 1) = p2d(:, 2)
+ IF( MOD(mjg( 1,nn_hls), 3) == 2 ) p2d(:, 2) = p2d(:, 1)
ENDIF
IF( mpiRnei(nn_hls,jpno) > -1 ) THEN
- IF( MOD(mjg(jpj-2), 3) == 1 ) p2d(:, jpj) = p2d(:,jpj-1)
- IF( MOD(mjg(jpj-2), 3) == 0 ) p2d(:,jpj-1) = p2d(:, jpj)
+ IF( MOD(mjg(jpj-2,nn_hls), 3) == 1 ) p2d(:, jpj) = p2d(:,jpj-1)
+ IF( MOD(mjg(jpj-2,nn_hls), 3) == 0 ) p2d(:,jpj-1) = p2d(:, jpj)
ENDIF
CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1.0_wp )
ENDIF
@@ -247,11 +218,11 @@ CONTAINS
! work over the whole domain (guarantees all internal cells are set when nn_hls=2)
!
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- IF( MOD(mig(ji), 3) == MOD(nn_hls, 3) .AND. & ! 1st bottom left corner always at (Nis0-1, Njs0-1)
- & MOD(mjg(jj), 3) == MOD(nn_hls, 3) ) THEN ! bottom left corner of a 3x3 box
- ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1 ! right position of the box
- jj2 = MIN(mjg(jj)+2, jpjglo) - njmpp + 1 ! upper position of the box
- IF( ji2 <= jpi .AND. jj2 <= jpj ) THEN ! the box is fully included in the local mpi domain
+ IF( MOD(mig(ji,nn_hls), 3) == MOD(nn_hls, 3) .AND. & ! 1st bottom left corner always at (Nis0-1, Njs0-1)
+ & MOD(mjg(jj,nn_hls), 3) == MOD(nn_hls, 3) ) THEN ! bottom left corner of a 3x3 box
+ ji2 = MIN(mig(ji,nn_hls)+2, jpiglo) - nimpp + 1 ! right position of the box
+ jj2 = MIN(mjg(jj,nn_hls)+2, jpjglo) - njmpp + 1 ! upper position of the box
+ IF( ji2 <= jpi .AND. jj2 <= jpj ) THEN ! the box is fully included in the local mpi domain
p3d(ji:ji2,jj:jj2,jn) = SUM(p3d(ji:ji2,jj:jj2,jn))
ENDIF
ENDIF
@@ -260,204 +231,29 @@ CONTAINS
CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1.0_wp )
! no need for 2nd exchange when nn_hls > 1
IF( nn_hls == 1 ) THEN
- IF( mpiRnei(nn_hls,jpwe) > -1 ) THEN ! 1st column was changed during the previous call to lbc_lnk
- IF( MOD(mig( 1), 3) == 1 ) & ! 1st box start at i=1 -> column 1 to 3 correctly computed locally
- p3d( 1,:,:) = p3d( 2,:,:) ! previous lbc_lnk corrupted column 1 -> put it back using column 2
- IF( MOD(mig( 1), 3) == 2 ) & ! 1st box start at i=3 -> column 1 and 2 correctly computed on west neighbourh
- p3d( 2,:,:) = p3d( 1,:,:) ! previous lbc_lnk fix column 1 -> copy it to column 2
+ IF( mpiRnei(nn_hls,jpwe) > -1 ) THEN ! 1st column was changed during the previous call to lbc_lnk
+ IF( MOD(mig( 1,nn_hls), 3) == 1 ) & ! 1st box start at i=1 -> column 1 to 3 correctly computed locally
+ p3d( 1,:,:) = p3d( 2,:,:) ! previous lbc_lnk corrupted column 1 -> put it back using column 2
+ IF( MOD(mig( 1,nn_hls), 3) == 2 ) & ! 1st box start at i=3 -> column 1 and 2 correctly computed on w-neighbourh
+ p3d( 2,:,:) = p3d( 1,:,:) ! previous lbc_lnk fix column 1 -> copy it to column 2
ENDIF
IF( mpiRnei(nn_hls,jpea) > -1 ) THEN
- IF( MOD(mig(jpi-2), 3) == 1 ) p3d( jpi,:,:) = p3d(jpi-1,:,:)
- IF( MOD(mig(jpi-2), 3) == 0 ) p3d(jpi-1,:,:) = p3d( jpi,:,:)
+ IF( MOD(mig(jpi-2,nn_hls), 3) == 1 ) p3d( jpi,:,:) = p3d(jpi-1,:,:)
+ IF( MOD(mig(jpi-2,nn_hls), 3) == 0 ) p3d(jpi-1,:,:) = p3d( jpi,:,:)
ENDIF
IF( mpiRnei(nn_hls,jpso) > -1 ) THEN
- IF( MOD(mjg( 1), 3) == 1 ) p3d(:, 1,:) = p3d(:, 2,:)
- IF( MOD(mjg( 1), 3) == 2 ) p3d(:, 2,:) = p3d(:, 1,:)
+ IF( MOD(mjg( 1,nn_hls), 3) == 1 ) p3d(:, 1,:) = p3d(:, 2,:)
+ IF( MOD(mjg( 1,nn_hls), 3) == 2 ) p3d(:, 2,:) = p3d(:, 1,:)
ENDIF
IF( mpiRnei(nn_hls,jpno) > -1 ) THEN
- IF( MOD(mjg(jpj-2), 3) == 1 ) p3d(:, jpj,:) = p3d(:,jpj-1,:)
- IF( MOD(mjg(jpj-2), 3) == 0 ) p3d(:,jpj-1,:) = p3d(:, jpj,:)
+ IF( MOD(mjg(jpj-2,nn_hls), 3) == 1 ) p3d(:, jpj,:) = p3d(:,jpj-1,:)
+ IF( MOD(mjg(jpj-2,nn_hls), 3) == 0 ) p3d(:,jpj-1,:) = p3d(:, jpj,:)
ENDIF
CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1.0_wp )
ENDIF
END SUBROUTINE sum3x3_3d
-
- FUNCTION glob_sum_vec_3d( cdname, ptab ) RESULT( ptmp )
- !!----------------------------------------------------------------------
- CHARACTER(len=*), INTENT(in) :: cdname ! name of the calling subroutine
- REAL(wp), INTENT(in) :: ptab(:,:,:) ! array on which operation is applied
- REAL(wp), DIMENSION(SIZE(ptab,3)) :: ptmp
- !
- COMPLEX(dp), DIMENSION(:), ALLOCATABLE :: ctmp
- REAL(wp) :: ztmp
- INTEGER :: ji , jj , jk ! dummy loop indices
- INTEGER :: ipi, ipj, ipk ! dimensions
- INTEGER :: iis, iie, ijs, ije ! loop start and end
- !!-----------------------------------------------------------------------
- !
- ipi = SIZE(ptab,1) ! 1st dimension
- ipj = SIZE(ptab,2) ! 2nd dimension
- ipk = SIZE(ptab,3) ! 3rd dimension
- !
- IF( ipi == jpi .AND. ipj == jpj ) THEN ! do 2D loop only over the inner domain (-> avoid to use undefined values)
- iis = Nis0 ; iie = Nie0
- ijs = Njs0 ; ije = Nje0
- ELSE ! I think we are never in this case...
- iis = 1 ; iie = jpi
- ijs = 1 ; ije = jpj
- ENDIF
- !
- ALLOCATE( ctmp(ipk) )
- !
- DO jk = 1, ipk
- ctmp(jk) = CMPLX( 0.e0, 0.e0, dp ) ! warning ctmp is cumulated
- DO jj = ijs, ije
- DO ji = iis, iie
- ztmp = ptab(ji,jj,jk) * tmask_i(ji,jj)
- CALL DDPDD( CMPLX( ztmp, 0.e0, dp ), ctmp(jk) )
- END DO
- END DO
- END DO
- CALL mpp_sum( cdname, ctmp(:) ) ! sum over the global domain
- !
- ptmp = REAL( ctmp(:), wp )
- !
- DEALLOCATE( ctmp )
- !
- END FUNCTION glob_sum_vec_3d
-
- FUNCTION glob_sum_vec_4d( cdname, ptab ) RESULT( ptmp )
- !!----------------------------------------------------------------------
- CHARACTER(len=*), INTENT(in) :: cdname ! name of the calling subroutine
- REAL(wp), INTENT(in) :: ptab(:,:,:,:) ! array on which operation is applied
- REAL(wp), DIMENSION(SIZE(ptab,4)) :: ptmp
- !
- COMPLEX(dp), DIMENSION(:), ALLOCATABLE :: ctmp
- REAL(wp) :: ztmp
- INTEGER :: ji , jj , jk , jl ! dummy loop indices
- INTEGER :: ipi, ipj, ipk, ipl ! dimensions
- INTEGER :: iis, iie, ijs, ije ! loop start and end
- !!-----------------------------------------------------------------------
- !
- ipi = SIZE(ptab,1) ! 1st dimension
- ipj = SIZE(ptab,2) ! 2nd dimension
- ipk = SIZE(ptab,3) ! 3rd dimension
- ipl = SIZE(ptab,4) ! 4th dimension
- !
- IF( ipi == jpi .AND. ipj == jpj ) THEN ! do 2D loop only over the inner domain (-> avoid to use undefined values)
- iis = Nis0 ; iie = Nie0
- ijs = Njs0 ; ije = Nje0
- ELSE ! I think we are never in this case...
- iis = 1 ; iie = jpi
- ijs = 1 ; ije = jpj
- ENDIF
- !
- ALLOCATE( ctmp(ipl) )
- !
- DO jl = 1, ipl
- ctmp(jl) = CMPLX( 0.e0, 0.e0, dp ) ! warning ctmp is cumulated
- DO jk = 1, ipk
- DO jj = ijs, ije
- DO ji = iis, iie
- ztmp = ptab(ji,jj,jk,jl) * tmask_i(ji,jj)
- CALL DDPDD( CMPLX( ztmp, 0.e0, dp ), ctmp(jl) )
- END DO
- END DO
- END DO
- END DO
- CALL mpp_sum( cdname, ctmp(:) ) ! sum over the global domain
- !
- ptmp = REAL( ctmp(:), wp )
- !
- DEALLOCATE( ctmp )
- !
- END FUNCTION glob_sum_vec_4d
-
- FUNCTION glob_min_vec_3d( cdname, ptab ) RESULT( ptmp )
- !!----------------------------------------------------------------------
- CHARACTER(len=*), INTENT(in) :: cdname ! name of the calling subroutine
- REAL(wp), INTENT(in) :: ptab(:,:,:) ! array on which operation is applied
- REAL(wp), DIMENSION(SIZE(ptab,3)) :: ptmp
- !
- INTEGER :: jk ! dummy loop indice & dimension
- INTEGER :: ipk ! dimension
- !!-----------------------------------------------------------------------
- !
- ipk = SIZE(ptab,3)
- DO jk = 1, ipk
- ptmp(jk) = MINVAL( ptab(:,:,jk) * tmask_i(:,:) )
- ENDDO
- !
- CALL mpp_min( cdname, ptmp (:) )
- !
- END FUNCTION glob_min_vec_3d
-
- FUNCTION glob_min_vec_4d( cdname, ptab ) RESULT( ptmp )
- !!----------------------------------------------------------------------
- CHARACTER(len=*), INTENT(in) :: cdname ! name of the calling subroutine
- REAL(wp), INTENT(in) :: ptab(:,:,:,:) ! array on which operation is applied
- REAL(wp), DIMENSION(SIZE(ptab,4)) :: ptmp
- !
- INTEGER :: jk , jl ! dummy loop indice & dimension
- INTEGER :: ipk, ipl ! dimension
- !!-----------------------------------------------------------------------
- !
- ipk = SIZE(ptab,3)
- ipl = SIZE(ptab,4)
- DO jl = 1, ipl
- ptmp(jl) = MINVAL( ptab(:,:,1,jl) * tmask_i(:,:) )
- DO jk = 2, ipk
- ptmp(jl) = MIN( ptmp(jl), MINVAL( ptab(:,:,jk,jl) * tmask_i(:,:) ) )
- ENDDO
- ENDDO
- !
- CALL mpp_min( cdname, ptmp (:) )
- !
- END FUNCTION glob_min_vec_4d
-
- FUNCTION glob_max_vec_3d( cdname, ptab ) RESULT( ptmp )
- !!----------------------------------------------------------------------
- CHARACTER(len=*), INTENT(in) :: cdname ! name of the calling subroutine
- REAL(wp), INTENT(in) :: ptab(:,:,:) ! array on which operation is applied
- REAL(wp), DIMENSION(SIZE(ptab,3)) :: ptmp
- !
- INTEGER :: jk ! dummy loop indice & dimension
- INTEGER :: ipk ! dimension
- !!-----------------------------------------------------------------------
- !
- ipk = SIZE(ptab,3)
- DO jk = 1, ipk
- ptmp(jk) = MAXVAL( ptab(:,:,jk) * tmask_i(:,:) )
- ENDDO
- !
- CALL mpp_max( cdname, ptmp (:) )
- !
- END FUNCTION glob_max_vec_3d
-
- FUNCTION glob_max_vec_4d( cdname, ptab ) RESULT( ptmp )
- !!----------------------------------------------------------------------
- CHARACTER(len=*), INTENT(in) :: cdname ! name of the calling subroutine
- REAL(wp), INTENT(in) :: ptab(:,:,:,:) ! array on which operation is applied
- REAL(wp), DIMENSION(SIZE(ptab,4)) :: ptmp
- !
- INTEGER :: jk , jl ! dummy loop indice & dimension
- INTEGER :: ipk, ipl ! dimension
- !!-----------------------------------------------------------------------
- !
- ipk = SIZE(ptab,3)
- ipl = SIZE(ptab,4)
- DO jl = 1, ipl
- ptmp(jl) = MAXVAL( ptab(:,:,1,jl) * tmask_i(:,:) )
- DO jk = 2, ipk
- ptmp(jl) = MAX( ptmp(jl), MAXVAL( ptab(:,:,jk,jl) * tmask_i(:,:) ) )
- ENDDO
- ENDDO
- !
- CALL mpp_max( cdname, ptmp (:) )
- !
- END FUNCTION glob_max_vec_4d
SUBROUTINE DDPDD( ydda, yddb )
!!----------------------------------------------------------------------
diff --git a/src/OCE/lib_fortran_generic.h90 b/src/OCE/lib_fortran_generic.h90
index d09c2cd02c0b8017ee22418376955dc8043e7265..2b84ed31aa187d201ea01f5b4619f2bbc6f8b005 100644
--- a/src/OCE/lib_fortran_generic.h90
+++ b/src/OCE/lib_fortran_generic.h90
@@ -1,139 +1,205 @@
-#if defined GLOBSUM_CODE
-! ! FUNCTION FUNCTION_GLOBSUM !
+/**/
+/*-----------------------------*/
+/* DEFINE COMMON VARIABLES */
+/*-----------------------------*/
+/**/
# if defined DIM_1d
-# define XD 1d
-# define ARRAY_TYPE(i,j,k) REAL(wp) , INTENT(in ) :: ARRAY_IN(i,j,k)
-# define ARRAY_IN(i,j,k) ptab(i)
-# define ARRAY2_IN(i,j,k) ptab2(i)
-# define J_SIZE(ptab) 1
-# define K_SIZE(ptab) 1
-# define MASK_ARRAY(i,j) 1.
+# define XD 1d
+# define ARRAY_IN(i,j,k,l) ptab(i)
# endif
# if defined DIM_2d
-# define XD 2d
-# define ARRAY_TYPE(i,j,k) REAL(wp) , INTENT(in ) :: ARRAY_IN(i,j,k)
-# define ARRAY_IN(i,j,k) ptab(i,j)
-# define ARRAY2_IN(i,j,k) ptab2(i,j)
-# define J_SIZE(ptab) SIZE(ptab,2)
-# define K_SIZE(ptab) 1
-# define MASK_ARRAY(i,j) tmask_i(i,j)
+# define XD 2d
+# define ARRAY_IN(i,j,k,l) ptab(i,j)
+# define K_SIZE(ptab) 1
+# define L_SIZE(ptab) 1
+# define LAST_SIZE -1
# endif
# if defined DIM_3d
-# define XD 3d
-# define ARRAY_TYPE(i,j,k) REAL(wp) , INTENT(in ) :: ARRAY_IN(i,j,k)
-# define ARRAY_IN(i,j,k) ptab(i,j,k)
-# define ARRAY2_IN(i,j,k) ptab2(i,j,k)
-# define J_SIZE(ptab) SIZE(ptab,2)
-# define K_SIZE(ptab) SIZE(ptab,3)
-# define MASK_ARRAY(i,j) tmask_i(i,j)
-# endif
-
- FUNCTION glob_sum_/**/XD/**/( cdname, ptab )
+# define XD 3d
+# define ARRAY_IN(i,j,k,l) ptab(i,j,k)
+# define K_SIZE(ptab) SIZE(ptab,3)
+# define L_SIZE(ptab) 1
+# define LAST_SIZE SIZE(ptab,3)
+# endif
+# if defined DIM_4d
+# define XD 4d
+# define ARRAY_IN(i,j,k,l) ptab(i,j,k,l)
+# define K_SIZE(ptab) SIZE(ptab,3)
+# define L_SIZE(ptab) SIZE(ptab,4)
+# define LAST_SIZE SIZE(ptab,4)
+# endif
+# if defined VEC
+# define ISVEC _vec
+# else
+# define ISVEC
+# endif
+# if defined LOCALONLY
+# define TYPENAME local
+# else
+# define TYPENAME glob
+# endif
+/**/
+/*-------------------------------*/
+/* FUNCTION FUNCTION_GLOBSUM */
+/*-------------------------------*/
+/**/
+#if defined GLOBSUM_CODE
+/**/
+/* DEFINE LOCAL VARIABLES */
+/**/
+!
+# if defined LOCALONLY
+FUNCTION TYPENAME/**/_sum/**/ISVEC/**/_/**/XD/**/( ptab ) RESULT( ptmp )
!!----------------------------------------------------------------------
- CHARACTER(len=*), INTENT(in ) :: cdname ! name of the calling subroutine
- ARRAY_TYPE(:,:,:) ! array on which operation is applied
- REAL(wp) :: glob_sum_/**/XD
- !
- !!-----------------------------------------------------------------------
+# else
+FUNCTION TYPENAME/**/_sum/**/ISVEC/**/_/**/XD/**/( cdname, ptab ) RESULT( ptmp )
+ !!----------------------------------------------------------------------
+ CHARACTER(len=*), INTENT(in ) :: cdname ! name of the calling subroutine
+# endif
+ REAL(wp) , INTENT(in ) :: ARRAY_IN(:,:,:,:) ! array on which operation is applied
!
+# if defined VEC
+ REAL(wp) , DIMENSION(LAST_SIZE) :: ptmp
+ COMPLEX(dp), DIMENSION(LAST_SIZE) :: ctmp
+# else
+ REAL(wp) :: ptmp
COMPLEX(dp):: ctmp
- REAL(wp) :: ztmp
- INTEGER :: ji, jj, jk ! dummy loop indices
- INTEGER :: ipi,ipj, ipk ! dimensions
- INTEGER :: iis, iie, ijs, ije ! loop start and end
+# endif
+ INTEGER :: ji, jj, jk, jl ! dummy loop indices
+ INTEGER :: ipi, ipj, ipk, ipl ! dimensions
+ INTEGER :: iisht, ijsht
!!-----------------------------------------------------------------------
!
+# if defined DIM_1d
+ ctmp = CMPLX( 0.e0, 0.e0, dp ) ! warning ctmp is cumulated
+ DO ji = 1, SIZE(ptab,1)
+ CALL DDPDD( CMPLX( ptab(ji), 0.e0, dp ), ctmp )
+ END DO
+ !
+# else
ipi = SIZE(ptab,1) ! 1st dimension
- ipj = J_SIZE(ptab) ! 2nd dimension
+ ipj = SIZE(ptab,2) ! 2nd dimension
ipk = K_SIZE(ptab) ! 3rd dimension
+ ipl = L_SIZE(ptab) ! 4th dimension
!
- IF( ipi == jpi .AND. ipj == jpj ) THEN ! do 2D loop only over the inner domain (-> avoid to use undefined values)
- iis = Nis0 ; iie = Nie0
- ijs = Njs0 ; ije = Nje0
- ELSE
- iis = 1 ; iie = ipi
- ijs = 1 ; ije = ipj
- ENDIF
+ iisht = ( jpi - ipi ) / 2
+ ijsht = ( jpj - ipj ) / 2 ! should be the same as iisht...
!
ctmp = CMPLX( 0.e0, 0.e0, dp ) ! warning ctmp is cumulated
- DO jk = 1, ipk
- DO jj = ijs, ije
- DO ji = iis, iie
- ztmp = ARRAY_IN(ji,jj,jk) * MASK_ARRAY(ji,jj)
- CALL DDPDD( CMPLX( ztmp, 0.e0, dp ), ctmp )
- END DO
- END DO
+ !
+ DO jl = 1, ipl
+ DO jk = 1, ipk
+ DO_2D( 0, 0, 0, 0 )
+ ! warning tmask_i is defined over the full MPI domain but maybe not ptab
+# define ARRAY_LOOP ARRAY_IN(ji-iisht,jj-ijsht,jk,jl) * tmask_i(ji,jj)
+# if defined VEC && defined DIM_3d
+ CALL DDPDD( CMPLX( ARRAY_LOOP, 0.e0, dp ), ctmp(jk) )
+# endif
+# if defined VEC && defined DIM_4d
+ CALL DDPDD( CMPLX( ARRAY_LOOP, 0.e0, dp ), ctmp(jl) )
+# endif
+# if ! defined VEC
+ CALL DDPDD( CMPLX( ARRAY_LOOP, 0.e0, dp ), ctmp )
+# endif
+ END_2D
+ END DO
END DO
+ !
+# endif
+# if defined LOCALONLY
+ ptmp = ctmp
+# else
CALL mpp_sum( cdname, ctmp ) ! sum over the global domain
- glob_sum_/**/XD = REAL(ctmp,wp)
-
- END FUNCTION glob_sum_/**/XD
-
-#undef XD
-#undef ARRAY_TYPE
-#undef ARRAY2_TYPE
-#undef ARRAY_IN
-#undef ARRAY2_IN
-#undef J_SIZE
-#undef K_SIZE
-#undef MASK_ARRAY
+ ptmp = REAL(ctmp, wp)
+# endif
+ !
+ END FUNCTION TYPENAME/**/_sum/**/ISVEC/**/_/**/XD
!
# endif
+/**/
+/*----------------------------------*/
+/* FUNCTION FUNCTION_GLOBMINMAX */
+/*----------------------------------*/
+/**/
#if defined GLOBMINMAX_CODE
-! ! FUNCTION FUNCTION_GLOBMINMAX !
-# if defined DIM_2d
-# define XD 2d
-# define ARRAY_TYPE(i,j,k) REAL(wp) , INTENT(in ) :: ARRAY_IN(i,j,k)
-# define ARRAY_IN(i,j,k) ptab(i,j)
-# define ARRAY2_IN(i,j,k) ptab2(i,j)
-# define K_SIZE(ptab) 1
-# endif
-# if defined DIM_3d
-# define XD 3d
-# define ARRAY_TYPE(i,j,k) REAL(wp) , INTENT(in ) :: ARRAY_IN(i,j,k)
-# define ARRAY_IN(i,j,k) ptab(i,j,k)
-# define ARRAY2_IN(i,j,k) ptab2(i,j,k)
-# define K_SIZE(ptab) SIZE(ptab,3)
-# endif
+/**/
+/* DEFINE LOCAL VARIABLES */
+/**/
# if defined OPERATION_GLOBMIN
-# define OPER min
+# define OPER min
+# define DEFAULT HUGE(1._wp)
# endif
# if defined OPERATION_GLOBMAX
-# define OPER max
+# define OPER max
+# define DEFAULT -HUGE(1._wp)
# endif
-
- FUNCTION glob_/**/OPER/**/_/**/XD/**/( cdname, ptab )
+!
+# if defined LOCALONLY
+ FUNCTION TYPENAME/**/_/**/OPER/**//**/ISVEC/**/_/**/XD/**/( ptab ) RESULT( ptmp )
!!----------------------------------------------------------------------
- CHARACTER(len=*), INTENT(in ) :: cdname ! name of the calling subroutine
- ARRAY_TYPE(:,:,:) ! array on which operation is applied
- REAL(wp) :: glob_/**/OPER/**/_/**/XD
- !
- !!-----------------------------------------------------------------------
+# else
+ FUNCTION TYPENAME/**/_/**/OPER/**//**/ISVEC/**/_/**/XD/**/( cdname, ptab ) RESULT( ptmp )
+ !!----------------------------------------------------------------------
+ CHARACTER(len=*), INTENT(in ) :: cdname ! name of the calling subroutine
+# endif
+ REAL(wp) , INTENT(in ) :: ARRAY_IN(:,:,:,:) ! array on which operation is applied
!
- COMPLEX(dp):: ctmp
- REAL(wp) :: ztmp
- INTEGER :: jk ! dummy loop indices
- INTEGER :: ipk ! dimensions
+# if defined VEC
+ REAL(wp), DIMENSION(LAST_SIZE) :: ptmp
+# else
+ REAL(wp) :: ptmp
+# endif
+ INTEGER :: ji, jj, jk, jl ! dummy loop indices
+ INTEGER :: ipi, ipj, ipk, ipl ! dimensions
+ INTEGER :: iisht, ijsht
!!-----------------------------------------------------------------------
!
+ ipi = SIZE(ptab,1) ! 1st dimension
+ ipj = SIZE(ptab,2) ! 2nd dimension
ipk = K_SIZE(ptab) ! 3rd dimension
+ ipl = L_SIZE(ptab) ! 4th dimension
+ !
+ iisht = ( jpi - ipi ) / 2
+ ijsht = ( jpj - ipj ) / 2 ! should be the same as iisht...
!
- ztmp = OPER/**/val( ARRAY_IN(:,:,1)*tmask_i(:,:) )
- DO jk = 2, ipk
- ztmp = OPER/**/(ztmp, OPER/**/val( ARRAY_IN(:,:,jk)*tmask_i(:,:) ))
- ENDDO
-
- CALL mpp_/**/OPER/**/( cdname, ztmp)
-
- glob_/**/OPER/**/_/**/XD = ztmp
-
- END FUNCTION glob_/**/OPER/**/_/**/XD
-
+ ptmp = DEFAULT
+ !
+ DO jl = 1, ipl
+ DO jk = 1, ipk
+# define ARRAY_LOOP ARRAY_IN(Nis0-iisht:Nie0-iisht,Njs0-ijsht:Nje0-ijsht,jk,jl)*tmask_i(Nis0:Nie0,Njs0:Nje0)
+# if defined VEC && defined DIM_3d
+ ptmp(jk) = OPER/**/( ptmp(jk), OPER/**/val( ARRAY_LOOP ) )
+# endif
+# if defined VEC && defined DIM_4d
+ ptmp(jl) = OPER/**/( ptmp(jl), OPER/**/val( ARRAY_LOOP ) )
+# endif
+# if ! defined VEC
+ ptmp = OPER/**/( ptmp , OPER/**/val( ARRAY_LOOP ) )
+# endif
+ END DO
+ END DO
+ !
+# if ! defined LOCAL
+ CALL mpp_/**/OPER/**/( cdname, ptmp )
+# endif
+ !
+ END FUNCTION TYPENAME/**/_/**/OPER/**//**/ISVEC/**/_/**/XD
+!
+# undef DEFAULT
+# undef OPER
+# endif
+/**/
+/* */
+/* UNDEFINE COMMON VARIABLES */
+/* */
+/**/
#undef XD
-#undef ARRAY_TYPE
-#undef ARRAY2_TYPE
#undef ARRAY_IN
-#undef ARRAY2_IN
+# if ! defined DIM_1d
#undef K_SIZE
-#undef OPER
-# endif
+#undef L_SIZE
+#undef LAST_SIZE
+# endif
+#undef ISVEC
+#undef TYPENAME
+#undef ARRAY_LOOP
diff --git a/src/OCE/par_oce.F90 b/src/OCE/par_oce.F90
index f72dce4489875d625f007354ea52d9c622c951af..f6ef02fe90aa0aa82453f3a9feb8d01d526e8139 100644
--- a/src/OCE/par_oce.F90
+++ b/src/OCE/par_oce.F90
@@ -59,7 +59,8 @@ MODULE par_oce
INTEGER, PUBLIC :: jpj ! !: second dimension
INTEGER, PUBLIC :: jpk ! = jpkglo !: third dimension
INTEGER, PUBLIC :: jpkm1 ! = jpk-1 !: - - -
- INTEGER, PUBLIC :: jpij ! = jpi*jpj !: jpi x jpj
+ !INTEGER, PUBLIC :: jpij ! = jpi*jpj !: jpi x jpj
+ INTEGER, PUBLIC :: jpij ! = (jpi-2*nn_hls)*(jpj-2*nn_hls) !: jpi x jpj but without the halos
INTEGER, PUBLIC :: jpimax! = ( Ni0glo + jpni-1 ) / jpni + 2*nn_hls !: maximum jpi
INTEGER, PUBLIC :: jpjmax! = ( Nj0glo + jpnj-1 ) / jpnj + 2*nn_hls !: maximum jpj
diff --git a/src/OCE/step.F90 b/src/OCE/step.F90
index ff2759f8c9abfc5bd28d1eb1b36d3e3a00d526f1..d7036efb32e5173bfb9e8495dac631af18c45301 100644
--- a/src/OCE/step.F90
+++ b/src/OCE/step.F90
@@ -174,7 +174,7 @@ CONTAINS
! VERTICAL PHYSICS
! lbc_lnk needed for zdf_sh2 when using nn_hls = 2, moved here to allow tiling in zdf_phy
- IF( nn_hls == 2 .AND. l_zdfsh2 ) CALL lbc_lnk( 'stp', avm_k, 'W', 1.0_wp )
+!!$ IF( nn_hls == 2 .AND. l_zdfsh2 ) CALL lbc_lnk( 'stp', avm_k, 'W', 1.0_wp )
IF( ln_tile ) CALL dom_tile_start ! [tiling] ZDF tiling loop
DO jtile = 1, nijtile
diff --git a/src/OCE/stpctl.F90 b/src/OCE/stpctl.F90
index 96358bf94048c1bae16bd72d84b1f7cfb50e748d..b8cc8aaa185c33d60b3c496adf771dc85f7d5ecf 100644
--- a/src/OCE/stpctl.F90
+++ b/src/OCE/stpctl.F90
@@ -231,7 +231,7 @@ CONTAINS
iloc(1:3,3) = MINLOC( ts(:,:,:,jp_sal,Kmm) , mask = llmsk(:,:,:) )
iloc(1:3,4) = MAXLOC( ts(:,:,:,jp_sal,Kmm) , mask = llmsk(:,:,:) )
DO ji = 1, jptst ! local domain indices ==> global domain indices, excluding halos
- iloc(1:2,ji) = (/ mig0(iloc(1,ji)), mjg0(iloc(2,ji)) /)
+ iloc(1:2,ji) = (/ mig(iloc(1,ji),0), mjg(iloc(2,ji),0) /)
END DO
iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information
ENDIF
diff --git a/src/OCE/stpmlf.F90 b/src/OCE/stpmlf.F90
index bae696704a881cbd31d2ec554ec1d9d6d2fe869c..2afa912fc64cc016f25a1d32619eed38a9ad42d2 100644
--- a/src/OCE/stpmlf.F90
+++ b/src/OCE/stpmlf.F90
@@ -555,7 +555,7 @@ CONTAINS
& , pts(:,:,:,jp_tem,Kaa), 'T', 1., pts(:,:,:,jp_sal,Kaa), 'T', 1. )
!
! lbc_lnk needed for zdf_sh2 when using nn_hls = 2, moved here to allow tiling in zdf_phy
- IF( nn_hls == 2 .AND. l_zdfsh2 ) CALL lbc_lnk( 'stp', avm_k, 'W', 1.0_wp )
+!!$ IF( nn_hls == 2 .AND. l_zdfsh2 ) CALL lbc_lnk( 'stp', avm_k, 'W', 1.0_wp )
! dom_qco_r3c defines over [nn_hls, nn_hls-1, nn_hls, nn_hls-1]
IF( nn_hls == 2 .AND. .NOT. lk_linssh ) THEN
diff --git a/src/OCE/trc_oce.F90 b/src/OCE/trc_oce.F90
index f7b8309ee1cf970be0bbca6954d5c308ee667b70..9f1bb10e85c338f584f512cd26875cbcaa8f5b3f 100644
--- a/src/OCE/trc_oce.F90
+++ b/src/OCE/trc_oce.F90
@@ -43,6 +43,9 @@ MODULE trc_oce
!!----------------------------------------------------------------------
LOGICAL, PUBLIC, PARAMETER :: lk_top = .FALSE. !: TOP model
#endif
+
+ !! * Substitutions
+# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
!! $Id: trc_oce.F90 13286 2020-07-09 15:48:29Z smasson $
@@ -54,7 +57,7 @@ CONTAINS
!!----------------------------------------------------------------------
!! *** trc_oce_alloc ***
!!----------------------------------------------------------------------
- ALLOCATE( etot3(jpi,jpj,jpk), oce_co2(jpi,jpj), qsr_mean(jpi,jpj), STAT=trc_oce_alloc )
+ ALLOCATE( etot3(A2D(0),jpk), oce_co2(A2D(0)), qsr_mean(A2D(0)), STAT=trc_oce_alloc )
IF( trc_oce_alloc /= 0 ) CALL ctl_warn('trc_oce_alloc: failed to allocate etot3 array')
!
diff --git a/src/SAS/nemogcm.F90 b/src/SAS/nemogcm.F90
index ce1716e487cbe17cf518fa366ac65b8a90e36812..8e07126365d8773cbedae282431f64f3d001e0b3 100644
--- a/src/SAS/nemogcm.F90
+++ b/src/SAS/nemogcm.F90
@@ -217,7 +217,6 @@ CONTAINS
IF( lk_oasis ) THEN ; cxios_context = 'sas' ! when coupling SAS to OCE
ELSE ; cxios_context = 'nemo' !
ENDIF
- nn_hls = 1
!
l_SAS = .TRUE. ! used in domain:dom_nam
!
@@ -390,6 +389,7 @@ CONTAINS
#if defined key_agrif
uu(:,:,:,:) = 0.0_wp ; vv(:,:,:,:) = 0.0_wp ; ts(:,:,:,:,:) = 0.0_wp ! needed for interp done at initialization phase
+ uu_b(:,:,:) = 0.0_wp ; vv_b(:,:,:) = 0.0_wp
#endif
! ! external forcing
CALL sbc_init( Nbb, Nnn, Naa ) ! Forcings : surface module
diff --git a/src/SAS/stpctl.F90 b/src/SAS/stpctl.F90
index 6de0e1dbf128f3d44694577e6813bd3f10e7ca15..9ecbe24ba84f9d4e818ea34c96d9450c1cb45b40 100644
--- a/src/SAS/stpctl.F90
+++ b/src/SAS/stpctl.F90
@@ -36,6 +36,9 @@ MODULE stpctl
INTEGER, PARAMETER :: jpvar = 3
INTEGER :: nrunid ! netcdf file id
INTEGER, DIMENSION(jpvar) :: nvarid ! netcdf variable id
+
+ !! * Substitutions
+# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/SAS 4.0 , NEMO Consortium (2018)
!! $Id: stpctl.F90 14433 2021-02-11 08:06:49Z smasson $
@@ -77,8 +80,8 @@ CONTAINS
IF( nstop > 0 .AND. ngrdstop > -1 ) RETURN ! stpctl was already called by a child grid
!
ll_wrtstp = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend )
- ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1
- ll_wrtruns = ( ll_colruns .OR. jpnij == 1 ) .AND. lwm
+ ll_colruns = sn_cfctl%l_runstat .AND. ll_wrtstp .AND. jpnij > 1
+ ll_wrtruns = sn_cfctl%l_runstat .AND. ll_wrtstp .AND. lwm
!
IF( kt == nit000 ) THEN
!
@@ -132,7 +135,7 @@ CONTAINS
!
zmax(1) = MAXVAL( vt_i (:,:) , mask = llmsk ) ! max ice thickness
zmax(2) = MAXVAL( ABS( u_ice(:,:) ) , mask = llmsk ) ! max ice velocity (zonal only)
- zmax(3) = MAXVAL( -tm_i (:,:) + rt0, mask = llmsk ) ! min ice temperature (in degC)
+ zmax(3) = MAXVAL( -tm_i (:,:) + rt0, mask = llmsk(A2D(0)) ) ! min ice temperature (in degC)
zmax(jpvar+1) = REAL( nstop, wp ) ! stop indicator
!
! !== get global extrema ==!
@@ -172,9 +175,9 @@ CONTAINS
! first: close the netcdf file, so we can read it
IF( lwm .AND. kt /= nitend ) istatus = NF90_CLOSE(nrunid)
! get global loc on the min/max
- CALL mpp_maxloc( 'stpctl', vt_i(:,:) , llmsk, zzz, iloc(1:2,1) ) ! mpp_maxloc ok if mask = F
- CALL mpp_maxloc( 'stpctl',ABS( u_ice(:,:) ) , llmsk, zzz, iloc(1:2,2) )
- CALL mpp_minloc( 'stpctl', tm_i(:,:) - rt0, llmsk, zzz, iloc(1:2,3) )
+ CALL mpp_maxloc( 'stpctl', vt_i(:,:) , llmsk , zzz, iloc(1:2,1) ) ! mpp_maxloc ok if mask = F
+ CALL mpp_maxloc( 'stpctl',ABS( u_ice(:,:) ) , llmsk , zzz, iloc(1:2,2) )
+ CALL mpp_minloc( 'stpctl', tm_i(:,:) - rt0, llmsk(A2D(0)), zzz, iloc(1:2,3) )
! find which subdomain has the max.
iareamin(:) = jpnij+1 ; iareamax(:) = 0 ; iareasum(:) = 0
DO ji = 1, jptst
@@ -187,11 +190,11 @@ CONTAINS
CALL mpp_sum( "stpctl", iareasum ) ! sum over the global domain
ELSE ! find local min and max locations:
! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc
- iloc(1:2,1) = MAXLOC( vt_i(:,:) , mask = llmsk )
- iloc(1:2,2) = MAXLOC( ABS( u_ice(:,:) ) , mask = llmsk )
- iloc(1:2,3) = MINLOC( tm_i(:,:) - rt0, mask = llmsk )
+ iloc(1:2,1) = MAXLOC( vt_i(:,:) , mask = llmsk )
+ iloc(1:2,2) = MAXLOC( ABS( u_ice(:,:) ) , mask = llmsk )
+ iloc(1:2,3) = MINLOC( tm_i(:,:) - rt0, mask = llmsk(A2D(0)) )
DO ji = 1, jptst ! local domain indices ==> global domain indices, excluding halos
- iloc(1:2,ji) = (/ mig0(iloc(1,ji)), mjg0(iloc(2,ji)) /)
+ iloc(1:2,ji) = (/ mig(iloc(1,ji),0), mjg(iloc(2,ji),0) /)
END DO
iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information
ENDIF
diff --git a/src/SWE/stpctl.F90 b/src/SWE/stpctl.F90
index 74def0eef9b1afa208f1f481d91e82f2946c1625..f69bb259797631750e9c09e5ffd3aeed474fb94c 100644
--- a/src/SWE/stpctl.F90
+++ b/src/SWE/stpctl.F90
@@ -75,8 +75,8 @@ CONTAINS
IF( nstop > 0 .AND. ngrdstop > -1 ) RETURN ! stpctl was already called by a child grid
!
ll_wrtstp = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend )
- ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1
- ll_wrtruns = ( ll_colruns .OR. jpnij == 1 ) .AND. lwm
+ ll_colruns = sn_cfctl%l_runstat .AND. ll_wrtstp .AND. jpnij > 1
+ ll_wrtruns = sn_cfctl%l_runstat .AND. ll_wrtstp .AND. lwm
!
IF( kt == nit000 ) THEN
!
@@ -185,7 +185,7 @@ CONTAINS
llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain
iloc(1:3,2) = MAXLOC( ABS( uu(:,:,:, Kmm)), mask = llmsk(:,:,:) )
DO ji = 1, jptst ! local domain indices ==> global domain indices, excluding halos
- iloc(1:2,ji) = (/ mig0(iloc(1,ji)), mjg0(iloc(2,ji)) /)
+ iloc(1:2,ji) = (/ mig(iloc(1,ji),0), mjg(iloc(2,ji),0) /)
END DO
iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information
ENDIF
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..4100534f899bafbc79999a5531bc38bcd0f3594b 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) ) ; zw2d(:,:,:) = 0._wp
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)
@@ -370,8 +366,6 @@ CONTAINS
CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm)
ENDIF
!
- IF( lk_iomput ) DEALLOCATE( zw2d, zw3d )
- !
IF( ln_timing ) CALL timing_stop('p2z_bio')
!
END SUBROUTINE p2z_bio
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..823d416a856829fef852d7616d780b6d50aeaf6c 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, 2, 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..fd1b0aeaac3911aee54cb4ec5cd942eaca372cc1 100644
--- a/src/TOP/TRP/trcadv.F90
+++ b/src/TOP/TRP/trcadv.F90
@@ -8,6 +8,7 @@ MODULE trcadv
!! 3.7 ! 2014-05 (G. Madec, C. Ethe) Add 2nd/4th order cases for CEN and FCT schemes
!! 4.0 ! 2017-09 (G. Madec) remove vertical time-splitting option
!! 4.5 ! 2021-08 (G. Madec, S. Techene) add advective velocities as optional arguments
+ !! - ! 2022-06 (S. Techene, G, Madec) refactorization to reduce local memory usage
!!----------------------------------------------------------------------
#if defined key_top
!!----------------------------------------------------------------------
@@ -123,19 +124,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
!
@@ -156,11 +157,19 @@ CONTAINS
SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==!
!
CASE ( np_CEN ) ! Centered : 2nd / 4th order
- CALL tra_adv_cen ( kt, nittrc000,'TRC', zuu, zvv, zww, Kmm, ptr, jptra, Krhs, nn_cen_h, nn_cen_v )
+ IF( nn_hls == 1 ) THEN
+ CALL tra_adv_cen_hls1( kt, nittrc000,'TRC', zuu, zvv, zww, Kmm, ptr, jptra, Krhs, nn_cen_h, nn_cen_v )
+ ELSE
+ CALL tra_adv_cen ( kt, nittrc000,'TRC', zuu, zvv, zww, Kmm, ptr, jptra, Krhs, nn_cen_h, nn_cen_v )
+ ENDIF
CASE ( np_FCT ) ! FCT : 2nd / 4th order
CALL tra_adv_fct( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v )
CASE ( np_MUS ) ! MUSCL
+ IF( nn_hls == 1 ) THEN
+ CALL tra_adv_mus_hls1( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups )
+ ELSE
CALL tra_adv_mus( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups )
+ ENDIF
CASE ( np_UBS ) ! UBS
CALL tra_adv_ubs ( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_ubs_v )
CASE ( np_QCK ) ! QUICKEST
diff --git a/src/TOP/TRP/trcdmp.F90 b/src/TOP/TRP/trcdmp.F90
index 8b2be2d95e3d0f78ff0435d8868636662bf465f0..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')
!
@@ -329,11 +329,11 @@ CONTAINS
! convert the position in local domain indices
! --------------------------------------------
DO jc = 1, npncts
- nctsi1(jc) = mi0( nctsi1(jc) )
- nctsj1(jc) = mj0( nctsj1(jc) )
+ nctsi1(jc) = mi0( nctsi1(jc), nn_hls )
+ nctsj1(jc) = mj0( nctsj1(jc), nn_hls )
!
- nctsi2(jc) = mi1( nctsi2(jc) )
- nctsj2(jc) = mj1( nctsj2(jc) )
+ nctsi2(jc) = mi1( nctsi2(jc), nn_hls )
+ nctsj2(jc) = mj1( nctsj2(jc), nn_hls )
END DO
!
ENDIF
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/TRP/trczdf.F90 b/src/TOP/TRP/trczdf.F90
index 2f0b5a8f2dbebb0ba09b1467a6b1b7831777b741..b5a9dd4ccd34296c7f3ba759cc8830496b836d95 100644
--- a/src/TOP/TRP/trczdf.F90
+++ b/src/TOP/TRP/trczdf.F90
@@ -53,7 +53,7 @@ CONTAINS
!
IF( l_trdtrc ) ztrtrd(:,:,:,:) = ptr(:,:,:,:,Krhs)
!
- CALL tra_zdf_imp( kt, nittrc000, 'TRC', rDt_trc, Kbb, Kmm, Krhs, ptr, Kaa, jptra ) ! implicit scheme
+ CALL tra_zdf_imp( 'TRC', Kbb, Kmm, Krhs, ptr, Kaa, jptra ) ! implicit scheme
!
IF( l_trdtrc ) THEN ! save the vertical diffusive trends for further diagnostics
DO jn = 1, jptra
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..4200f3e9a5986ad44b990f22f1885083c135e491 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 ***
@@ -169,7 +153,7 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER, INTENT( in ) :: kt ! ocean time-step index
!
- INTEGER :: jn ! dummy loop indices
+ INTEGER :: ji,jj,jn ! dummy loop indices
REAL(wp) :: zkt, zrec ! local scalars
CHARACTER(len=1) :: cl1 ! 1 character
CHARACTER(len=2) :: cl2 ! 2 characters
@@ -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 &
@@ -219,7 +203,9 @@ CONTAINS
IF(lwp) WRITE(numout,*) 'trc_qsr_mean: qsr_mean set to nit000 values'
rsecfst = kt * rn_Dt
!
- qsr_mean(:,:) = qsr(:,:)
+ DO_2D( 0, 0, 0, 0 )
+ qsr_mean(ji,jj) = qsr(ji,jj)
+ END_2D
DO jn = 1, nb_rec_per_day
qsr_arr(:,:,jn) = qsr_mean(:,:)
END DO
@@ -239,7 +225,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..e42148d86257807a3b0265df257876a76315648f 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 ***
@@ -176,7 +161,7 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER, INTENT( in ) :: kt ! ocean time-step index
!
- INTEGER :: jn ! dummy loop indices
+ INTEGER :: ji,jj,jn ! dummy loop indices
REAL(wp) :: zkt, zrec ! local scalars
CHARACTER(len=1) :: cl1 ! 1 character
CHARACTER(len=2) :: cl2 ! 2 characters
@@ -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 &
@@ -230,7 +211,9 @@ CONTAINS
IF(lwp) WRITE(numout,*) 'trc_qsr_mean: qsr_mean set to nit000 values'
rsecfst = kt * rn_Dt
!
- qsr_mean(:,:) = qsr(:,:)
+ DO_2D( 0, 0, 0, 0 )
+ qsr_mean(ji,jj) = qsr(ji,jj)
+ END_2D
DO jn = 1, nb_rec_per_day
qsr_arr(:,:,jn) = qsr_mean(:,:)
END DO
@@ -250,7 +233,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
diff --git a/tests/ADIAB_WAVE/MY_SRC/usrdef_hgr.F90 b/tests/ADIAB_WAVE/MY_SRC/usrdef_hgr.F90
index 12f778f5cac9148c6245b17c272b77ba0488d440..ac53839aaac33728fe5dbe9fee5b3f8b2a4399bb 100644
--- a/tests/ADIAB_WAVE/MY_SRC/usrdef_hgr.F90
+++ b/tests/ADIAB_WAVE/MY_SRC/usrdef_hgr.F90
@@ -80,14 +80,14 @@ CONTAINS
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
! DO_2D( 1, 1, 1, 1 )
! ! longitude
- plamt(ji,jj) = zfact * ( REAL( mig0(ji)-1 , wp ) )
- plamu(ji,jj) = zfact * ( 0.5 + REAL( mig0(ji)-1 , wp ) )
+ plamt(ji,jj) = zfact * ( REAL( mig(ji,0)-1 , wp ) )
+ plamu(ji,jj) = zfact * ( 0.5 + REAL( mig(ji,0)-1 , wp ) )
plamv(ji,jj) = plamt(ji,jj)
plamf(ji,jj) = plamu(ji,jj)
! ! latitude
- pphit(ji,jj) = zfact2 * ( REAL( mjg0(jj)-1 , wp ) )
+ pphit(ji,jj) = zfact2 * ( REAL( mjg(jj,0)-1 , wp ) )
pphiu(ji,jj) = pphit(ji,jj)
- pphiv(ji,jj) = zfact2 * ( 0.5 + REAL( mjg0(jj)-1 , wp ) )
+ pphiv(ji,jj) = zfact2 * ( 0.5 + REAL( mjg(jj,0)-1 , wp ) )
pphif(ji,jj) = pphiv(ji,jj)
END_2D
!
diff --git a/tests/ADIAB_WAVE/MY_SRC/usrdef_zgr.F90 b/tests/ADIAB_WAVE/MY_SRC/usrdef_zgr.F90
index 5c7fac8382fe52b9c044774838d5f5641b28c06a..ed83f79c1c1020b8f309e0a2631672caf02665d1 100644
--- a/tests/ADIAB_WAVE/MY_SRC/usrdef_zgr.F90
+++ b/tests/ADIAB_WAVE/MY_SRC/usrdef_zgr.F90
@@ -14,8 +14,7 @@ MODULE usrdef_zgr
!! zgr_z1d : reference 1D z-coordinate
!!---------------------------------------------------------------------
USE oce ! ocean variables
- USE dom_oce , ONLY: mi0, mi1 ! ocean space and time domain
- USE dom_oce , ONLY: glamt ! ocean space and time domain
+ USE dom_oce ! ocean space and time domain
USE usrdef_nam ! User defined : namelist variables
!
USE in_out_manager ! I/O manager
@@ -105,10 +104,10 @@ CONTAINS
END_2D
CALL lbc_lnk( 'usrdef_zgr', zhu, 'U', 1. ) ! boundary condition: this mask the surrouding grid-points
! ! ==>>> set by hand non-zero value on first/last columns & rows
- DO ji = mi0(1), mi1(1) ! first row of global domain only
+ DO ji = mi0(1,nn_hls), mi1(1,nn_hls) ! first row of global domain only
zhu(ji,2) = zht(ji,2)
END DO
- DO ji = mi0(jpiglo), mi1(jpiglo) ! last row of global domain only
+ DO ji = mi0(jpiglo,nn_hls), mi1(jpiglo,nn_hls) ! last row of global domain only
zhu(ji,2) = zht(ji,2)
END DO
zhu(:,1) = zhu(:,2)
diff --git a/tests/BENCH/MY_SRC/usrdef_hgr.F90 b/tests/BENCH/MY_SRC/usrdef_hgr.F90
index bc6b282ce81d4af6d1e7f0934780ffc7a91fd758..ec715f295a75705b5965706dd715e121b075e307 100644
--- a/tests/BENCH/MY_SRC/usrdef_hgr.F90
+++ b/tests/BENCH/MY_SRC/usrdef_hgr.F90
@@ -75,15 +75,15 @@ CONTAINS
! define unique value on each point of the inner global domain. z2d ranging from 0.05 to -0.05
!
DO_2D( 0, 0, 0, 0 ) ! +/- 0.5
- z2d(ji,jj) = 0.5 - REAL( mig0(ji) + (mjg0(jj)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp )
+ z2d(ji,jj) = 0.5 - REAL( mig(ji,0) + (mjg(jj,0)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp )
END_2D
!
! Position coordinates (in grid points)
! ==========
DO_2D( 0, 0, 0, 0 )
- zti = REAL( mig0(ji), wp ) - 0.5_wp ! start at i=0.5 in the global grid without halos
- ztj = REAL( mjg0(jj), wp ) - 0.5_wp ! start at j=0.5 in the global grid without halos
+ zti = REAL( mig(ji,0), wp ) - 0.5_wp ! start at i=0.5 in the global grid without halos
+ ztj = REAL( mjg(jj,0), wp ) - 0.5_wp ! start at j=0.5 in the global grid without halos
plamt(ji,jj) = zti * (1. + 1.0e-5 * z2d(ji,jj) )
plamu(ji,jj) = ( zti + 0.5_wp ) * (1. + 2.0e-5 * z2d(ji,jj) )
diff --git a/tests/BENCH/MY_SRC/usrdef_istate.F90 b/tests/BENCH/MY_SRC/usrdef_istate.F90
index 69da90f1b8425eec665b26e6d8b8c2fc29628abe..bb35d7849422e2cc9f34673f677d4a8d5cc22af5 100644
--- a/tests/BENCH/MY_SRC/usrdef_istate.F90
+++ b/tests/BENCH/MY_SRC/usrdef_istate.F90
@@ -65,7 +65,7 @@ CONTAINS
! define unique value on each point of the inner global domain. z2d ranging from 0.05 to -0.05
!
DO_2D( 0, 0, 0, 0 ) ! +/- 0.05
- z2d(ji,jj) = 0.1 * ( 0.5 - REAL( mig0(ji) + (mjg0(jj)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp ) )
+ z2d(ji,jj) = 0.1 * ( 0.5 - REAL( mig(ji,0) + (mjg(jj,0)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp ) )
END_2D
!
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
@@ -108,7 +108,7 @@ CONTAINS
IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : BENCH configuration, analytical definition of initial ssh'
!
DO_2D( 0, 0, 0, 0 ) ! sea level: +/- 0.05 m
- pssh(ji,jj) = 0.1 * ( 0.5 - REAL( mig0(ji) + (mjg0(jj)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp ) )
+ pssh(ji,jj) = 0.1 * ( 0.5 - REAL( mig(ji,0) + (mjg(jj,0)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp ) )
END_2D
!
CALL lbc_lnk('usrdef_istate', pssh, 'T', 1. ) ! apply boundary conditions
diff --git a/tests/BENCH/MY_SRC/usrdef_sbc.F90 b/tests/BENCH/MY_SRC/usrdef_sbc.F90
index 4bd1292280807e173740a890e4ed19048225b51f..7ad3b70643f185c46892c8c3e62112c8953081d0 100644
--- a/tests/BENCH/MY_SRC/usrdef_sbc.F90
+++ b/tests/BENCH/MY_SRC/usrdef_sbc.F90
@@ -104,7 +104,7 @@ CONTAINS
! define unique value on each point. z2d ranging from 0.05 to -0.05
!
DO_2D( 0, 0, 0, 0 )
- zztmp = 0.1 * ( 0.5 - REAL( mig0(ji) + (mjg0(jj)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp ) )
+ zztmp = 0.1 * ( 0.5 - REAL( mig(ji,0) + (mjg(jj,0)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp ) )
utau_ice(ji,jj) = 0.1_wp + zztmp
vtau_ice(ji,jj) = 0.1_wp + zztmp
END_2D
@@ -125,7 +125,7 @@ CONTAINS
REAL(wp), DIMENSION(:,:,:), INTENT(in) :: phs ! snow thickness
REAL(wp), DIMENSION(:,:,:), INTENT(in) :: phi ! ice thickness
!!
- REAL(wp), DIMENSION(jpi,jpj) :: zsnw ! snw distribution after wind blowing
+ REAL(wp), DIMENSION(A2D(0)) :: zsnw ! snw distribution after wind blowing
!!---------------------------------------------------------------------
#if defined key_si3
!
@@ -150,9 +150,9 @@ CONTAINS
emp_ice (:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw(:,:)
emp_oce (:,:) = emp_oce(:,:) - sprecip(:,:) * (1._wp - zsnw(:,:) )
qevap_ice(:,:,:) = 0._wp
- qprec_ice(:,:) = rhos * ( sst_m(:,:) * rcpi - rLfus ) * tmask(:,:,1) ! in J/m3
- qemp_oce (:,:) = - emp_oce(:,:) * sst_m(:,:) * rcp
- qemp_ice (:,:) = sprecip(:,:) * zsnw * ( sst_m(:,:) * rcpi - rLfus ) * tmask(:,:,1) ! solid precip (only)
+ qprec_ice(:,:) = rhos * ( sst_m(A2D(0)) * rcpi - rLfus ) * smask0(:,:) ! in J/m3
+ qemp_oce (:,:) = - emp_oce(:,:) * sst_m(A2D(0)) * rcp
+ qemp_ice (:,:) = sprecip(:,:) * zsnw * ( sst_m(A2D(0)) * rcpi - rLfus ) * smask0(:,:) ! solid precip (only)
! total fluxes
emp_tot (:,:) = emp_ice + emp_oce
diff --git a/tests/BENCH/MY_SRC/usrdef_zgr.F90 b/tests/BENCH/MY_SRC/usrdef_zgr.F90
index b547480010867bebbfec44f979d95ebe0c66470c..fe5d7de8004ef26c20bff9bfeb13e5555249cfdd 100644
--- a/tests/BENCH/MY_SRC/usrdef_zgr.F90
+++ b/tests/BENCH/MY_SRC/usrdef_zgr.F90
@@ -197,14 +197,14 @@ CONTAINS
!
!!$ IF( c_NFtype == 'T' ) THEN ! add a small island in the upper corners to avoid model instabilities...
-!!$ z2d(mi0( nn_hls):mi1( nn_hls+2 ),mj0(jpjglo-nn_hls-1):mj1(jpjglo-nn_hls+1)) = 0._wp
-!!$ z2d(mi0(jpiglo-nn_hls):mi1(MIN(jpiglo,jpiglo-nn_hls+2)),mj0(jpjglo-nn_hls-1):mj1(jpjglo-nn_hls+1)) = 0._wp
-!!$ z2d(mi0(jpiglo/2 ):mi1( jpiglo/2 +2 ),mj0(jpjglo-nn_hls-1):mj1(jpjglo-nn_hls+1)) = 0._wp
+!!$ z2d(mi0( nn_hls,nn_hls):mi1( nn_hls+2 ,nn_hls),mj0(jpjglo-nn_hls-1,nn_hls):mj1(jpjglo-nn_hls+1,nn_hls)) = 0._wp
+!!$ z2d(mi0(jpiglo-nn_hls,nn_hls):mi1(MIN(jpiglo,jpiglo-nn_hls+2),nn_hls),mj0(jpjglo-nn_hls-1,nn_hls):mj1(jpjglo-nn_hls+1,nn_hls)) = 0._wp
+!!$ z2d(mi0(jpiglo/2 ,nn_hls):mi1( jpiglo/2 +2 ,nn_hls),mj0(jpjglo-nn_hls-1,nn_hls):mj1(jpjglo-nn_hls+1,nn_hls)) = 0._wp
!!$ ENDIF
!!$ !
IF( c_NFtype == 'F' ) THEN ! Must mask the 2 pivot-points
- z2d(mi0(nn_hls+1):mi1(nn_hls+1),mj0(jpjglo-nn_hls):mj1(jpjglo-nn_hls)) = 0._wp
- z2d(mi0(jpiglo/2):mi1(jpiglo/2),mj0(jpjglo-nn_hls):mj1(jpjglo-nn_hls)) = 0._wp
+ z2d(mi0(nn_hls+1,nn_hls):mi1(nn_hls+1,nn_hls),mj0(jpjglo-nn_hls,nn_hls):mj1(jpjglo-nn_hls,nn_hls)) = 0._wp
+ z2d(mi0(jpiglo/2,nn_hls):mi1(jpiglo/2,nn_hls),mj0(jpjglo-nn_hls,nn_hls):mj1(jpjglo-nn_hls,nn_hls)) = 0._wp
ENDIF
!
CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1._wp ) ! set surrounding land to zero (closed boundaries)
diff --git a/tests/C1D_ASICS/MY_SRC/usrdef_nam.F90 b/tests/C1D_ASICS/MY_SRC/usrdef_nam.F90
index 538d753ce1ee95a7c140b11ece2e8e2abe58822c..c1d0b976524ec0e85b9bc2ea9354feff39231098 100644
--- a/tests/C1D_ASICS/MY_SRC/usrdef_nam.F90
+++ b/tests/C1D_ASICS/MY_SRC/usrdef_nam.F90
@@ -13,7 +13,6 @@ MODULE usrdef_nam
!! usr_def_nam : read user defined namelist and set global domain size
!! usr_def_hgr : initialize the horizontal mesh
!!----------------------------------------------------------------------
- USE dom_oce , ONLY: nimpp, njmpp ! ocean space and time domain
USE dom_oce , ONLY: ln_zco, ln_zps, ln_sco ! flag of type of coordinate
USE par_oce ! ocean space and time domain
USE phycst ! physical constants
diff --git a/tests/CANAL/MY_SRC/usrdef_hgr.F90 b/tests/CANAL/MY_SRC/usrdef_hgr.F90
index 8cb9d5bdd63f60707f5eb141312df90075034e2d..c7b469cf89c039d7887ae1c14dc6e149d082dc02 100644
--- a/tests/CANAL/MY_SRC/usrdef_hgr.F90
+++ b/tests/CANAL/MY_SRC/usrdef_hgr.F90
@@ -88,8 +88,8 @@ CONTAINS
#endif
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- zti = REAL( mig0(ji)-ii0, wp ) ! =0 at i=ii0 in the global grid without halos
- ztj = REAL( mjg0(jj)-ij0, wp ) ! =0 at i=ij0 in the global grid without halos
+ zti = REAL( mig(ji,0)-ii0, wp ) ! =0 at i=ii0 in the global grid without halos
+ ztj = REAL( mjg(jj,0)-ij0, wp ) ! =0 at i=ij0 in the global grid without halos
plamt(ji,jj) = rn_dx * zti
plamu(ji,jj) = rn_dx * ( zti + 0.5_wp )
diff --git a/tests/CPL_OASIS/EXPREF/gen_report.sh b/tests/CPL_OASIS/EXPREF/gen_report.sh
index 3a5a91a2563542e0b30113651f2f2f7e980f825f..09b368e825e804731e747f68f58f34e46007a0f9 100755
--- a/tests/CPL_OASIS/EXPREF/gen_report.sh
+++ b/tests/CPL_OASIS/EXPREF/gen_report.sh
@@ -15,7 +15,7 @@ function ncmdn { ncap2 -O -C -v -s "foo=gsl_stats_median_from_sorted_data(${1}.s
## Variables which may need to be adapted to your experiment:
##
# RUNDIR = directory where the test case is executed: contains all outputs
-RUNDIR=/gpfswork/rech/omr/romr001/OUT/CPLTESTCASE/2020-03-31120816
+RUNDIR=`pwd`
# NB_NEMO_IT = expected total number of NEMO iterations
NB_NEMO_IT=160
# NB_OASIS_OUTFILES = number of debug.root.0* OASIS output files
diff --git a/tests/CPL_OASIS/EXPREF/iodef.xml b/tests/CPL_OASIS/EXPREF/iodef.xml
index 2cc7d572d000becba89d22a5ffc16d290c6063f4..dda919bd7ac24d1d0e892e5bd6e3cb17ca357be4 100644
--- a/tests/CPL_OASIS/EXPREF/iodef.xml
+++ b/tests/CPL_OASIS/EXPREF/iodef.xml
@@ -10,9 +10,10 @@
<variable_definition>
<variable id="info_level" type="int">10</variable>
- <variable id="using_server" type="bool">false</variable>
+ <variable id="using_server" type="bool">true</variable>
<variable id="using_oasis" type="bool">true</variable>
<variable id="oasis_codes_id" type="string" >oceanx</variable>
+ <variable id="call_oasis_enddef" type="bool">false</variable>
</variable_definition>
</context>
diff --git a/tests/CPL_OASIS/job_run_CPL_TESTCASE b/tests/CPL_OASIS/EXPREF/job_run_CPL_TESTCASE
similarity index 92%
rename from tests/CPL_OASIS/job_run_CPL_TESTCASE
rename to tests/CPL_OASIS/EXPREF/job_run_CPL_TESTCASE
index e2028a57071e458d1c09f3d5347503f94e1dd3a9..fa14f1def0c0fbb57892b6757ae3a3a8a90aa9bc 100644
--- a/tests/CPL_OASIS/job_run_CPL_TESTCASE
+++ b/tests/CPL_OASIS/EXPREF/job_run_CPL_TESTCASE
@@ -1,4 +1,5 @@
-#!/bin/bash
+#!/usr/bin/env bash
+
###################################
## Definitions for batch system
#SBATCH -A omr@cpu # Accounting information
@@ -11,10 +12,12 @@
#SBATCH --output=cpltestcase_%j # Name of output listing file
#SBATCH --error=cpltestcase_%j # Name of error listing file (the same)
###################################
+set -x
+ulimit -s unlimited
##
## CONFIG_DIR is submission directory
##
-CONFIG_DIR=${SLURM_SUBMIT_DIR}
+CONFIG_DIR=${SLURM_SUBMIT_DIR:-$(pwd)}
#
cd ${CONFIG_DIR}
pwd
@@ -52,6 +55,7 @@ done
##
cp $CONFIG_DIR/nemo nemo.exe || exit 5
cp $TOYATM_DIR/toyatm.exe . || exit 5
+cp $XIOS_DIR/bin/xios_server.exe . || exit 5
##
## Get script generating summary report
cp $CONFIG_DIR/gen_report.sh .
@@ -62,12 +66,13 @@ echo '(3) Prepare launch of the run'
echo '----------------'
export MPIRUN="srun --mpi=pmi2 --cpu-bind=cores -K1"
NB_PROCS_NEMO=28
-NB_PROCS_OASIS=1
NB_PROCS_TOYATM=1
+NB_PROCS_XIOS=1
date
touch ./run_file
echo 0-27 ./nemo.exe >>./run_file
echo 28 ./toyatm.exe >>./run_file
+echo 29 ./xios_server.exe >>./run_file
echo run_file
cat ./run_file
##
diff --git a/tests/CPL_OASIS/EXPREF/namelist_cfg b/tests/CPL_OASIS/EXPREF/namelist_cfg
index 289c3e99f405f3a8845bffe2759c110db0cd93d4..f2402b69b151b460956c9635003d661bffb65f78 100644
--- a/tests/CPL_OASIS/EXPREF/namelist_cfg
+++ b/tests/CPL_OASIS/EXPREF/namelist_cfg
@@ -83,8 +83,9 @@
! Type of air-sea fluxes
ln_cpl = .true. ! atmosphere coupled formulation ( requires key_oasis3 )
! Sea-ice :
- nn_ice = 2 ! =2 or 3 automatically for SI3 or CICE ("key_si3" or "key_cice")
- ! except in AGRIF zoom where it has to be specified
+ nn_ice = 2 ! =0 no ice boundary condition
+ ! ! =1 use observed ice-cover ( => fill namsbc_iif )
+ ! ! =2 or 3 for SI3 and CICE, respectively
! Misc. options of sbc :
ln_traqsr = .true. ! Light penetration in the ocean (T => fill namtra_qsr)
ln_ssr = .true. ! Sea Surface Restoring on T and/or S (T => fill namsbc_ssr)
@@ -92,15 +93,6 @@
nn_fwb = 2 ! FreshWater Budget:
! ! =2 annual global mean of e-p-r set to zero
ln_wave = .false. ! Activate coupling with wave (T => fill namsbc_wave)
- ln_cdgw = .false. ! Neutral drag coefficient read from wave model (T => ln_wave=.true. & fill namsbc_wave)
- ln_sdw = .false. ! Read 2D Surf Stokes Drift & Computation of 3D stokes drift (T => ln_wave=.true. & fill namsbc_wave)
- nn_sdrift = 0 ! Parameterization for the calculation of 3D-Stokes drift from the surface Stokes drift
- ! ! = 0 Breivik 2015 parameterization: v_z=v_0*[exp(2*k*z)/(1-8*k*z)]
- ! ! = 1 Phillips: v_z=v_o*[exp(2*k*z)-beta*sqrt(-2*k*pi*z)*erfc(sqrt(-2*k*z))]
- ! ! = 2 Phillips as (1) but using the wave frequency from a wave model
- ln_tauwoc = .false. ! Activate ocean stress modified by external wave induced stress (T => ln_wave=.true. & fill namsbc_wave)
- ln_tauw = .false. ! Activate ocean stress components from wave model
- ln_stcor = .false. ! Activate Stokes Coriolis term (T => ln_wave=.true. & ln_sdw=.true. & fill namsbc_wave)
/
!-----------------------------------------------------------------------
&namsbc_blk ! namsbc_blk generic Bulk formula (ln_blk =T)
@@ -112,41 +104,41 @@
!___________!_________________________!___________________!___________!_____________!________!___________!______________________________________!__________!_______________!
! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask !
! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! ! pairing ! filename !
- sn_wndi = 'u_10.15JUNE2009_fill' , 6. , 'U_10_MOD', .false. , .true. , 'yearly' , 'weights_core_orca2_bicubic_noc.nc' , 'Uwnd' , ''
- sn_wndj = 'v_10.15JUNE2009_fill' , 6. , 'V_10_MOD', .false. , .true. , 'yearly' , 'weights_core_orca2_bicubic_noc.nc' , 'Vwnd' , ''
- sn_qsr = 'ncar_rad.15JUNE2009_fill' , 24. , 'SWDN_MOD', .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , ''
- sn_qlw = 'ncar_rad.15JUNE2009_fill' , 24. , 'LWDN_MOD', .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , ''
- sn_tair = 't_10.15JUNE2009_fill' , 6. , 'T_10_MOD', .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , ''
- sn_humi = 'q_10.15JUNE2009_fill' , 6. , 'Q_10_MOD', .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , ''
- sn_prec = 'ncar_precip.15JUNE2009_fill', -1. , 'PRC_MOD1', .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , ''
- sn_snow = 'ncar_precip.15JUNE2009_fill', -1. , 'SNOW' , .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , ''
- sn_slp = 'slp.15JUNE2009_fill' , 6. , 'SLP' , .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , ''
+ sn_wndi = 'u_10.15JUNE2009_fill' , 6. , 'U_10_MOD', .false. , .true. , 'yearly' , 'weights_core2_orca2_bicub' , 'Uwnd' , ''
+ sn_wndj = 'v_10.15JUNE2009_fill' , 6. , 'V_10_MOD', .false. , .true. , 'yearly' , 'weights_core2_orca2_bicub' , 'Vwnd' , ''
+ sn_qsr = 'ncar_rad.15JUNE2009_fill' , 24. , 'SWDN_MOD', .false. , .true. , 'yearly' , 'weights_core2_orca2_bilin' , '' , ''
+ sn_qlw = 'ncar_rad.15JUNE2009_fill' , 24. , 'LWDN_MOD', .false. , .true. , 'yearly' , 'weights_core2_orca2_bilin' , '' , ''
+ sn_tair = 't_10.15JUNE2009_fill' , 6. , 'T_10_MOD', .false. , .true. , 'yearly' , 'weights_core2_orca2_bilin' , '' , ''
+ sn_humi = 'q_10.15JUNE2009_fill' , 6. , 'Q_10_MOD', .false. , .true. , 'yearly' , 'weights_core2_orca2_bilin' , '' , ''
+ sn_prec = 'ncar_precip.15JUNE2009_fill', -1. , 'PRC_MOD1', .false. , .true. , 'yearly' , 'weights_core2_orca2_bilin' , '' , ''
+ sn_snow = 'ncar_precip.15JUNE2009_fill', -1. , 'SNOW' , .false. , .true. , 'yearly' , 'weights_core2_orca2_bilin' , '' , ''
+ sn_slp = 'slp.15JUNE2009_fill' , 6. , 'SLP' , .false. , .true. , 'yearly' , 'weights_core2_orca2_bilin' , '' , ''
/
+!-----------------------------------------------------------------------
&namsbc_cpl ! coupled ocean/atmosphere model ("key_oasis3")
!-----------------------------------------------------------------------
- nn_cplmodel = 1 ! Maximum number of models to/from which NEMO is potentially sending/receiving data
- ln_usecplmask = .false. ! use a coupling mask file to merge data received from several models
- ! ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel)
- nn_cats_cpl = 5 ! Number of sea ice categories over which coupling is to be carried out (if not 1)
-
+ nn_cplmodel = 1 ! Maximum number of models to/from which NEMO is potentially sending/receiving data
+ ln_usecplmask = .false. ! use a coupling mask file to merge data received from several models
+ ! ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel)
+ ln_scale_ice_flux = .false. ! use ice fluxes that are already "ice weighted" ( i.e. multiplied ice concentration)
+ nn_cats_cpl = 5 ! Number of sea ice categories over which coupling is to be carried out (if not 1)
!_____________!__________________________!____________!_____________!______________________!________!
! ! description ! multiple ! vector ! vector ! vector !
! ! ! categories ! reference ! orientation ! grids !
!*** send ***
-!! sn_snd_temp = 'weighted oce and ice' , 'no' , '' , '' , ''
sn_snd_temp = 'mixed oce-ice' , 'no' , '' , '' , ''
- sn_snd_ttilyr = 'none' , 'no' , '' , '' , ''
sn_snd_alb = 'none' , 'no' , '' , '' , ''
sn_snd_thick = 'none' , 'no' , '' , '' , ''
- sn_snd_ifrac = 'none' , 'no' , '' , '' , ''
sn_snd_crt = 'none' , 'no' , 'spherical' , 'eastward-northward' , 'T'
sn_snd_co2 = 'none' , 'no' , '' , '' , ''
- sn_snd_cond = 'none' , 'no' , '' , '' , ''
- sn_snd_mpnd = 'none' , 'no' , '' , '' , ''
- sn_snd_sstfrz = 'none' , 'no' , '' , '' , ''
sn_snd_crtw = 'none' , 'no' , '' , '' , 'U,V'
+ sn_snd_ifrac = 'none' , 'no' , '' , '' , ''
sn_snd_wlev = 'none' , 'no' , '' , '' , ''
+ sn_snd_cond = 'none' , 'no' , '' , '' , ''
sn_snd_thick1 = 'none' , 'no' , '' , '' , ''
+ sn_snd_mpnd = 'none' , 'no' , '' , '' , ''
+ sn_snd_sstfrz = 'none' , 'no' , '' , '' , ''
+ sn_snd_ttilyr = 'none' , 'no' , '' , '' , ''
!*** receive ***
sn_rcv_w10m = 'none' , 'no' , '' , '' , ''
sn_rcv_taumod = 'none' , 'no' , '' , '' , ''
@@ -157,22 +149,25 @@
sn_rcv_emp = 'conservative' , 'no' , '' , '' , ''
sn_rcv_rnf = 'none' , 'no' , '' , '' , ''
sn_rcv_cal = 'none' , 'no' , '' , '' , ''
- sn_rcv_icb = 'none' , 'no' , '' , '' , ''
- sn_rcv_isf = 'none' , 'no' , '' , '' , ''
- sn_rcv_iceflx = 'none' , 'no' , '' , '' , ''
sn_rcv_co2 = 'none' , 'no' , '' , '' , ''
- sn_rcv_hsig = 'none' , 'no' , '' , '' , ''
- sn_rcv_phioc = 'none' , 'no' , '' , '' , ''
- sn_rcv_sdrfx = 'none' , 'no' , '' , '' , ''
- sn_rcv_sdrfy = 'none' , 'no' , '' , '' , ''
- sn_rcv_wper = 'none' , 'no' , '' , '' , ''
- sn_rcv_wnum = 'none' , 'no' , '' , '' , ''
- sn_rcv_wfreq = 'none' , 'no' , '' , '' , ''
- sn_rcv_tauwoc = 'none' , 'no' , '' , '' , ''
- sn_rcv_tauw = 'none' , 'no' , '' , '' , ''
- sn_rcv_wdrag = 'none' , 'no' , '' , '' , ''
- sn_rcv_ts_ice = 'none' , 'no' , '' , '' , ''
+ sn_rcv_iceflx = 'none' , 'no' , '' , '' , ''
sn_rcv_mslp = 'none' , 'no' , '' , '' , ''
+ sn_rcv_ts_ice = 'none' , 'no' , '' , '' , ''
+ sn_rcv_isf = 'none' , 'no' , '' , '' , ''
+ sn_rcv_icb = 'none' , 'no' , '' , '' , ''
+ sn_rcv_hsig = 'none' , 'no' , '' , '' , 'T'
+ sn_rcv_phioc = 'none' , 'no' , '' , '' , 'T'
+ sn_rcv_sdrfx = 'none' , 'no' , '' , '' , 'T'
+ sn_rcv_sdrfy = 'none' , 'no' , '' , '' , 'T'
+ sn_rcv_wper = 'none' , 'no' , '' , '' , 'T'
+ sn_rcv_wnum = 'none' , 'no' , '' , '' , 'T'
+ sn_rcv_wstrf = 'none' , 'no' , '' , '' , 'T'
+ sn_rcv_wdrag = 'none' , 'no' , '' , '' , 'T'
+ sn_rcv_charn = 'none' , 'no' , '' , '' , 'T'
+ sn_rcv_taw = 'none' , 'no' , '' , '' , 'U,V'
+ sn_rcv_bhd = 'none' , 'no' , '' , '' , 'T'
+ sn_rcv_tusd = 'none' , 'no' , '' , '' , 'T'
+ sn_rcv_tvsd = 'none' , 'no' , '' , '' , 'T'
/
!-----------------------------------------------------------------------
&namtra_qsr ! penetrative solar radiation (ln_traqsr =T)
@@ -365,6 +360,7 @@
!-----------------------------------------------------------------------
ln_dynadv_vec = .true. ! vector form - 2nd centered scheme
nn_dynkeg = 0 ! grad(KE) scheme: =0 C2 ; =1 Hollingsworth correction
+ ln_dynadv_cen2 = .false. ! flux form - 2nd order centered scheme
/
!-----------------------------------------------------------------------
&namdyn_vor ! Vorticity / Coriolis scheme (default: NO selection)
@@ -424,27 +420,27 @@
! ! = 2 first vertical derivative of mixing length bounded by 1
! ! = 3 as =2 with distinct dissipative an mixing length scale
nn_etau = 1 ! penetration of tke below the mixed layer (ML) due to NIWs
- ! = 0 none ; = 1 add a tke source below the ML
- ! = 2 add a tke source just at the base of the ML
- ! = 3 as = 1 applied on HF part of the stress (ln_cpl=T)
- rn_eice = 0 ! below sea ice: =0 ON ; =4 OFF when ice fraction > 1/4
+ ! ! = 0 none ; = 1 add a tke source below the ML
+ ! ! = 2 add a tke source just at the base of the ML
+ ! ! = 3 as = 1 applied on HF part of the stress (ln_cpl=T)
+ ln_mxhsw = .false. ! surface mixing length scale = F(wave height)
/
!-----------------------------------------------------------------------
&namzdf_iwm ! internal wave-driven mixing parameterization (ln_zdfiwm =T)
!-----------------------------------------------------------------------
- nn_zpyc = 2 ! pycnocline-intensified dissipation scales as N (=1) or N^2 (=2)
ln_mevar = .true. ! variable (T) or constant (F) mixing efficiency
ln_tsdiff = .true. ! account for differential T/S mixing (T) or not (F)
- cn_dir = './' ! root directory for the iwm data location
- !___________!_________________________!___________________!___________!_____________!________!___________!__________________!__________!_______________!
- ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask !
- ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! ! pairing ! filename !
- sn_mpb = 'mixing_power_bot' , -12 , 'field' , .false. , .true. , 'yearly' , '' , '' , ''
- sn_mpp = 'mixing_power_pyc' , -12 , 'field' , .false. , .true. , 'yearly' , '' , '' , ''
- sn_mpc = 'mixing_power_cri' , -12 , 'field' , .false. , .true. , 'yearly' , '' , '' , ''
- sn_dsb = 'decay_scale_bot' , -12 , 'field' , .false. , .true. , 'yearly' , '' , '' , ''
- sn_dsc = 'decay_scale_cri' , -12 , 'field' , .false. , .true. , 'yearly' , '' , '' , ''
+ cn_dir = './' ! root directory for the iwm data location
+ !___________!_________________________!___________________!_____________!_____________!________!___________!__________________!__________!_______________!
+ ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask !
+ ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! ! pairing ! filename !
+ sn_mpb = 'zdfiwm_forcing_orca2' , -12. , 'power_bot' , .false. , .true. , 'yearly' , '' , '' , ''
+ sn_mpc = 'zdfiwm_forcing_orca2' , -12. , 'power_cri' , .false. , .true. , 'yearly' , '' , '' , ''
+ sn_mpn = 'zdfiwm_forcing_orca2' , -12. , 'power_nsq' , .false. , .true. , 'yearly' , '' , '' , ''
+ sn_mps = 'zdfiwm_forcing_orca2' , -12. , 'power_sho' , .false. , .true. , 'yearly' , '' , '' , ''
+ sn_dsb = 'zdfiwm_forcing_orca2' , -12. , 'scale_bot' , .false. , .true. , 'yearly' , '' , '' , ''
+ sn_dsc = 'zdfiwm_forcing_orca2' , -12. , 'scale_cri' , .false. , .true. , 'yearly' , '' , '' , ''
/
!!======================================================================
!! *** Diagnostics namelists *** !!
diff --git a/tests/CPL_OASIS/EXPREF/namelist_top_cfg b/tests/CPL_OASIS/EXPREF/namelist_top_cfg
index 801200ab07a7f2d8440e3eb3fe86bff89fbf60a0..8befa2d2cfa7411d6176cb8513e706d830e16f73 100644
--- a/tests/CPL_OASIS/EXPREF/namelist_top_cfg
+++ b/tests/CPL_OASIS/EXPREF/namelist_top_cfg
@@ -21,31 +21,31 @@
ln_trcdta = .true. ! Initialisation from data input file (T) or not (F)
ln_trcbc = .false. ! Enables Boundary conditions
! ! ! ! ! !
-! ! name ! title of the field ! units ! init ! sbc ! cbc ! obc !
- sn_tracer(1) = 'DIC ' , 'Dissolved inorganic Concentration ', 'mol-C/L' , .true. , .false., .true. , .false.
- sn_tracer(2) = 'Alkalini' , 'Total Alkalinity Concentration ', 'eq/L ' , .true. , .false., .true. , .false.
- sn_tracer(3) = 'O2 ' , 'Dissolved Oxygen Concentration ', 'mol-C/L' , .true. , .false., .false., .false.
- sn_tracer(4) = 'CaCO3 ' , 'Calcite Concentration ', 'mol-C/L' , .false. , .false., .false., .false.
- sn_tracer(5) = 'PO4 ' , 'Phosphate Concentration ', 'mol-C/L' , .true. , .true. , .true. , .false.
- sn_tracer(6) = 'POC ' , 'Small organic carbon Concentration ', 'mol-C/L' , .false. , .false., .false., .false.
- sn_tracer(7) = 'Si ' , 'Silicate Concentration ', 'mol-C/L' , .true. , .true. , .true. , .false.
- sn_tracer(8) = 'PHY ' , 'Nanophytoplankton Concentration ', 'mol-C/L' , .false. , .false., .false., .false.
- sn_tracer(9) = 'ZOO ' , 'Microzooplankton Concentration ', 'mol-C/L' , .false. , .false., .false., .false.
- sn_tracer(10) = 'DOC ' , 'Dissolved organic Concentration ', 'mol-C/L' , .true. , .false., .true. , .false.
- sn_tracer(11) = 'PHY2 ' , 'Diatoms Concentration ', 'mol-C/L' , .false. , .false., .false., .false.
- sn_tracer(12) = 'ZOO2 ' , 'Mesozooplankton Concentration ', 'mol-C/L' , .false. , .false., .false., .false.
- sn_tracer(13) = 'DSi ' , 'Diatoms Silicate Concentration ', 'mol-C/L' , .false. , .false., .false., .false.
- sn_tracer(14) = 'Fer ' , 'Dissolved Iron Concentration ', 'mol-C/L' , .true. , .true. , .true. , .false.
- sn_tracer(15) = 'BFe ' , 'Big iron particles Concentration ', 'mol-C/L' , .false. , .false., .false., .false.
- sn_tracer(16) = 'GOC ' , 'Big organic carbon Concentration ', 'mol-C/L' , .false. , .false., .false., .false.
- sn_tracer(17) = 'SFe ' , 'Small iron particles Concentration ', 'mol-C/L' , .false. , .false., .false., .false.
- sn_tracer(18) = 'DFe ' , 'Diatoms iron Concentration ', 'mol-C/L' , .false. , .false., .false., .false.
- sn_tracer(19) = 'GSi ' , 'Sinking biogenic Silicate Concentration', 'mol-C/L' , .false. , .false., .false., .false.
- sn_tracer(20) = 'NFe ' , 'Nano iron Concentration ', 'mol-C/L' , .false. , .false., .false., .false.
- sn_tracer(21) = 'NCHL ' , 'Nano chlorophyl Concentration ', 'mol-C/L' , .false. , .false., .false., .false.
- sn_tracer(22) = 'DCHL ' , 'Diatoms chlorophyl Concentration ', 'mol-C/L' , .false. , .false., .false., .false.
- sn_tracer(23) = 'NO3 ' , 'Nitrates Concentration ', 'mol-C/L' , .true. , .true. , .true. , .false.
- sn_tracer(24) = 'NH4 ' , 'Ammonium Concentration ', 'mol-C/L' , .false. , .false., .false., .false.
+! ! name ! title of the field ! units ! init ! sbc ! cbc ! obc ! ais
+ sn_tracer(1) = 'DIC ' , 'Dissolved inorganic Concentration ', 'mol-C/L' , .true. , .false., .true. , .false. , .false.
+ sn_tracer(2) = 'Alkalini' , 'Total Alkalinity Concentration ', 'eq/L ' , .true. , .false., .true. , .false. , .false.
+ sn_tracer(3) = 'O2 ' , 'Dissolved Oxygen Concentration ', 'mol-C/L' , .true. , .false., .false., .false. , .false.
+ sn_tracer(4) = 'CaCO3 ' , 'Calcite Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false.
+ sn_tracer(5) = 'PO4 ' , 'Phosphate Concentration ', 'mol-C/L' , .true. , .true. , .true. , .false. , .false.
+ sn_tracer(6) = 'POC ' , 'Small organic carbon Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false.
+ sn_tracer(7) = 'Si ' , 'Silicate Concentration ', 'mol-C/L' , .true. , .true. , .true. , .false. , .false.
+ sn_tracer(8) = 'PHY ' , 'Nanophytoplankton Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false.
+ sn_tracer(9) = 'ZOO ' , 'Microzooplankton Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false.
+ sn_tracer(10) = 'DOC ' , 'Dissolved organic Concentration ', 'mol-C/L' , .true. , .false., .true. , .false. , .false.
+ sn_tracer(11) = 'PHY2 ' , 'Diatoms Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false.
+ sn_tracer(12) = 'ZOO2 ' , 'Mesozooplankton Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false.
+ sn_tracer(13) = 'DSi ' , 'Diatoms Silicate Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false.
+ sn_tracer(14) = 'Fer ' , 'Dissolved Iron Concentration ', 'mol-C/L' , .true. , .true. , .true. , .false. , .true.
+ sn_tracer(15) = 'BFe ' , 'Big iron particles Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false.
+ sn_tracer(16) = 'GOC ' , 'Big organic carbon Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false.
+ sn_tracer(17) = 'SFe ' , 'Small iron particles Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false.
+ sn_tracer(18) = 'DFe ' , 'Diatoms iron Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false.
+ sn_tracer(19) = 'GSi ' , 'Sinking biogenic Silicate Concentration', 'mol-C/L' , .false. , .false., .false., .false. , .false.
+ sn_tracer(20) = 'NFe ' , 'Nano iron Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false.
+ sn_tracer(21) = 'NCHL ' , 'Nano chlorophyl Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false.
+ sn_tracer(22) = 'DCHL ' , 'Diatoms chlorophyl Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false.
+ sn_tracer(23) = 'NO3 ' , 'Nitrates Concentration ', 'mol-C/L' , .true. , .true. , .true. , .false. , .false.
+ sn_tracer(24) = 'NH4 ' , 'Ammonium Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false.
/
!-----------------------------------------------------------------------
&namage ! AGE
@@ -56,22 +56,22 @@
!-----------------------------------------------------------------------
! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask !
! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename !
- sn_trcdta(1) = 'data_DIC_nomask' , -12. , 'DIC' , .false. , .true. , 'yearly' , '' , '' , ''
- sn_trcdta(2) = 'data_Alkalini_nomask' , -12. , 'Alkalini', .false. , .true. , 'yearly' , '' , '' , ''
- sn_trcdta(3) = 'data_O2_nomask' , -1. , 'O2' , .true. , .true. , 'yearly' , '' , '' , ''
- sn_trcdta(5) = 'data_PO4_nomask' , -1. , 'PO4' , .true. , .true. , 'yearly' , '' , '' , ''
- sn_trcdta(7) = 'data_Si_nomask' , -1. , 'Si' , .true. , .true. , 'yearly' , '' , '' , ''
- sn_trcdta(10) = 'data_DOC_nomask' , -12. , 'DOC' , .false. , .true. , 'yearly' , '' , '' , ''
- sn_trcdta(14) = 'data_Fer_nomask' , -12. , 'Fer' , .false. , .true. , 'yearly' , '' , '' , ''
- sn_trcdta(23) = 'data_NO3_nomask' , -1. , 'NO3' , .true. , .true. , 'yearly' , '' , '' , ''
- rn_trfac(1) = 1.0e-06 ! multiplicative factor
- rn_trfac(2) = 1.0e-06 ! - - - -
- rn_trfac(3) = 44.6e-06 ! - - - -
- rn_trfac(5) = 122.0e-06 ! - - - -
- rn_trfac(7) = 1.0e-06 ! - - - -
- rn_trfac(10) = 1.0 ! - - - -
- rn_trfac(14) = 1.0 ! - - - -
- rn_trfac(23) = 7.6e-06 ! - - - -
+ sn_trcdta(1) = 'data_DIC_nomask.nc', -12 , 'PiDIC' , .false. , .true. , 'yearly' , 'weights_3D_r360x180_bilin.nc' , '' , ''
+ sn_trcdta(2) = 'data_ALK_nomask.nc', -12 , 'TALK' , .false. , .true. , 'yearly' , 'weights_3D_r360x180_bilin.nc' , '' , ''
+ sn_trcdta(3) = 'data_OXY_nomask.nc', -1 , 'O2' , .true. , .true. , 'yearly' , 'weights_3D_r360x180_bilin.nc' , '' , ''
+ sn_trcdta(5) = 'data_PO4_nomask.nc', -1 , 'PO4' , .true. , .true. , 'yearly' , 'weights_3D_r360x180_bilin.nc' , '' , ''
+ sn_trcdta(7) = 'data_SIL_nomask.nc', -1 , 'Si' , .true. , .true. , 'yearly' , 'weights_3D_r360x180_bilin.nc' , '' , ''
+ sn_trcdta(10) = 'data_DOC_nomask.nc', -1 , 'DOC' , .true. , .true. , 'yearly' , 'weights_3D_r360x180_bilin.nc' , '' , ''
+ sn_trcdta(14) = 'data_FER_nomask.nc', -1 , 'Fer' , .true. , .true. , 'yearly' , 'weights_3D_r360x180_bilin.nc' , '' , ''
+ sn_trcdta(23) = 'data_NO3_nomask.nc', -1 , 'NO3' , .true. , .true. , 'yearly' , 'weights_3D_r360x180_bilin.nc' , '' , ''
+ rn_trfac(1) = 1.028e-06 ! multiplicative factor
+ rn_trfac(2) = 1.028e-06 ! - - - -
+ rn_trfac(3) = 44.6e-06 ! - - - -
+ rn_trfac(5) = 117.0e-06 ! - - - -
+ rn_trfac(7) = 1.0e-06 ! - - - -
+ rn_trfac(10) = 1.0e-06 ! - - - -
+ rn_trfac(14) = 1.0e-06 ! - - - -
+ rn_trfac(23) = 7.3125e-06 ! - - - -
/
!-----------------------------------------------------------------------
&namtrc_adv ! advection scheme for passive tracer (default: NO selection)
@@ -113,11 +113,11 @@
sn_trcsbc(7) = 'dust.orca.new' , -1 , 'dustsi' , .true. , .true. , 'yearly' , '' , '' , ''
sn_trcsbc(14) = 'dust.orca.new' , -1 , 'dustfer' , .true. , .true. , 'yearly' , '' , '' , ''
sn_trcsbc(23) = 'ndeposition.orca', -12 , 'ndep' , .false. , .true. , 'yearly' , '' , '' , ''
- rn_trsfac(5) = 8.264e-02 ! ( 0.021 / 31. * 122 )
- rn_trsfac(7) = 3.313e-01 ! ( 8.8 / 28.1 )
- rn_trsfac(14) = 6.266e-04 ! ( 0.035 / 55.85 )
- rn_trsfac(23) = 5.4464e-01 ! ( From kgN m-2 s-1 to molC l-1 ====> zfact = 7.625/14 )
- rn_sbc_time = 1. ! Time scaling factor for SBC and CBC data (seconds in a day)
+ rn_trsfac(5) = 7.9258065e-02 ! ( 0.021 / 31. * 117 )
+ rn_trsfac(7) = 3.1316726e-01 ! ( 8.8 / 28.1 )
+ rn_trsfac(14) = 6.2667860e-04 ! ( 0.035 / 55.85 )
+ rn_trsfac(23) = 5.2232143e-01 ! ( From kgN m-2 s-1 to molC l-1 ====> zfact = 7.3125/14 )
+ rn_sbc_time = 1. ! Time scaling factor for SBC and CBC data (seconds in a day)
!
sn_trccbc(1) = 'river.orca' , 120 , 'riverdic' , .true. , .true. , 'yearly' , '' , '' , ''
sn_trccbc(2) = 'river.orca' , 120 , 'riverdic' , .true. , .true. , 'yearly' , '' , '' , ''
@@ -126,16 +126,20 @@
sn_trccbc(10) = 'river.orca' , 120 , 'riverdoc' , .true. , .true. , 'yearly' , '' , '' , ''
sn_trccbc(14) = 'river.orca' , 120 , 'riverdic' , .true. , .true. , 'yearly' , '' , '' , ''
sn_trccbc(23) = 'river.orca' , 120 , 'riverdin' , .true. , .true. , 'yearly' , '' , '' , ''
- rn_trcfac(1) = 8.333e+01 ! ( data in Mg/m2/yr : 1e3/12/ryyss)
- rn_trcfac(2) = 8.333e+01 ! ( 1e3 /12 )
- rn_trcfac(5) = 3.935e+04 ! ( 1e3 / 31. * 122 )
- rn_trcfac(7) = 3.588e+01 ! ( 1e3 / 28.1 )
- rn_trcfac(10) = 8.333e+01 ! ( 1e3 / 12
- rn_trcfac(14) = 4.166e-03 ! ( 1e3 / 12 * 5e-5 )
- rn_trcfac(23) = 5.446e+02 ! ( 1e3 / 14 * 7.625 )
- rn_cbc_time = 3.1536e+7 ! Time scaling factor for CBC data (seconds in a year)
+ rn_trcfac(1) = 8.333333e+01 ! ( data in Mg/m2/yr : 1e3/12/ryyss)
+ rn_trcfac(2) = 8.333333e+01 ! ( 1e3 /12 )
+ rn_trcfac(5) = 3.774193e+03 ! ( 1e3 / 31. * 117 )
+ rn_trcfac(7) = 3.558719e+01 ! ( 1e3 / 28.1 )
+ rn_trcfac(10) = 8.333333e+01 ! ( 1e3 / 12
+ rn_trcfac(14) = 4.166667e-03 ! ( 1e3 / 12 * 5e-5 )
+ rn_trcfac(23) = 5.223214e+02 ! ( 1e3 / 14 * 7.3125 )
+ rn_cbc_time = 3.1536e+7 ! Time scaling factor for CBC data (seconds in a year)
/
!----------------------------------------------------------------------
&namtrc_bdy ! Setup of tracer boundary conditions
!-----------------------------------------------------------------------
/
+!-----------------------------------------------------------------------
+&namtrc_ais ! Representation of Antarctic Ice Sheet tracers supply
+!-----------------------------------------------------------------------
+/
diff --git a/tests/CPL_OASIS/gen_report.sh b/tests/CPL_OASIS/gen_report.sh
deleted file mode 100755
index 09b368e825e804731e747f68f58f34e46007a0f9..0000000000000000000000000000000000000000
--- a/tests/CPL_OASIS/gen_report.sh
+++ /dev/null
@@ -1,95 +0,0 @@
-#!/bin/bash
-#set -vx
-# ncmax $var_nm $fl_nm : What is maximum of variable?
-function ncmax { ncap2 -O -C -v -s "foo=${1}.max();print(foo)" ${2} ~/foo.nc | cut -f 3- -d ' ' ; }
-# ncmin $var_nm $fl_nm : What is minimum of variable?
-function ncmin { ncap2 -O -C -v -s "foo=${1}.min();print(foo)" ${2} ~/foo.nc | cut -f 3- -d ' ' ; }
-# ncmdn $var_nm $fl_nm : What is median of variable?
-function ncmdn { ncap2 -O -C -v -s "foo=gsl_stats_median_from_sorted_data(${1}.sort());print(foo)" ${2} ~/foo.nc | cut -f 3- -d ' ' ; }
-
-##
-## simple report generator for the test case
-##
-
-##
-## Variables which may need to be adapted to your experiment:
-##
-# RUNDIR = directory where the test case is executed: contains all outputs
-RUNDIR=`pwd`
-# NB_NEMO_IT = expected total number of NEMO iterations
-NB_NEMO_IT=160
-# NB_OASIS_OUTFILES = number of debug.root.0* OASIS output files
-NB_OASIS_OUTFILES=2
-##
-## END of variables to be checked - Nothing need to be changed below
-##
-# check if directory is here
- if [ ! -d $RUNDIR ]; then
- printf "%-27s %s %s\n" $RUNDIR "directory does not exist. Check RUNDIR variable in script. Stop"
- return
- fi
-
-cd $RUNDIR
-
-echo " "
-echo "Check results of test case in directory: " `pwd`
-echo " "
-##
-## Check if OASIS execution has been successful
-##
-echo " OASIS successful (true if OASIS outputs in debug.root.0? includes SUCCESSFUL RUN) : "
-count=0
-for file in debug.root.0*
-do
- echo $file ; grep "SUCCESSFUL RUN" $file
- count=`expr $count + 1`
-done
-echo "OASIS success checked on $count files"
-[ $count = $NB_OASIS_OUTFILES ] && echo true || echo false
-##
-## Check if NEMO execution has been sucessful
-##
-echo " "
-echo " NEMO execution is successful if the run.stat file contains one line for each of NB_NEMO_IT iterations, indicating they have indeed been computed"
- if [ ! -f ./run.stat ]; then
- echo " the run.stat file does not exist: NEMO did not end its first time step"
- echo " NEMO UNSUCESSFUL. Stop"
- return
- fi
-echo "From run.stat NEMO output file, NEMO has executed the 160 time steps:"
-nemo_iterations=`wc -l ./run.stat | awk {'print $1'} `; [ $nemo_iterations = $NB_NEMO_IT ] && echo true || echo false
-
-##
-## Check mean value of sst field seen by toyatm
-##
- if [ ! -f ./ATSSTSST_toyatm_01.nc ]; then
- echo " the ATSSTSST_toyatm_01.nc file does not exist: the test is not successful"
- echo " Test case UNSUCESSFUL. Stop"
- return
- fi
-echo " "
-echo "Examining ATSSTSST variable sea surface temperature as seen by toyatm, unit is degree Kelvin (min. should be around 271., max. around 302., median around 280.)"
-ASSTmin=`ncmin ATSSTSST ATSSTSST_toyatm_01.nc`
-ASSTmax=`ncmax ATSSTSST ATSSTSST_toyatm_01.nc`
-ASSTmed=`ncmdn ATSSTSST ATSSTSST_toyatm_01.nc`
-echo "Minimum value of ATSSTSST variable in ATSSTSST_toyatm_01.nc file = " $ASSTmin
-echo "Maximum value of ATSSTSST variable in ATSSTSST_toyatm_01.nc file = " $ASSTmax
-echo "Median value of ATSSTSST variable in ATSSTSST_toyatm_01.nc file = " $ASSTmed
-MINMAX=0
-if [ ${ASSTmin%%.*} -lt 270 -o ${ASSTmax%%.*} -gt 310 ]; then
-echo " Min. or max. values of ATSSTSST do not look reasonable. Check the test again "
-MINMAX=1
-fi
-##
-## Summary
-##
-echo " "
-if [ $count = $NB_OASIS_OUTFILES ] && [ $nemo_iterations = $NB_NEMO_IT ] && [ $MINMAX = 0 ]
-then
- echo " The run looks very succesful!"
- echo " Have a look to the ASTSSTSST.nc file (using ncview for example): sea surface temperatures as seen by the toyatm and compare it to the reference file (CPL/ref_ATSSTSST_last_time_step.jpg) "
- echo " Units are in degrees Kelvin and it will confirm the test is successful"
- echo " "
-else
- echo "The test case is unsuccessful. Check all inputs and outputs"
-fi
diff --git a/tests/DIA_GPU/MY_SRC/stpctl.F90 b/tests/DIA_GPU/MY_SRC/stpctl.F90
index acf186402f013f39829f4d01a3dd39a21d1b8879..cf7cd09c9e6fc5d66a50d7bdce3543d96060af0f 100644
--- a/tests/DIA_GPU/MY_SRC/stpctl.F90
+++ b/tests/DIA_GPU/MY_SRC/stpctl.F90
@@ -232,7 +232,7 @@ CONTAINS
iloc(1:3,3) = MINLOC( ts(:,:,:,jp_sal,Kmm) , mask = llmsk(:,:,:) )
iloc(1:3,4) = MAXLOC( ts(:,:,:,jp_sal,Kmm) , mask = llmsk(:,:,:) )
DO ji = 1, jptst ! local domain indices ==> global domain indices, excluding halos
- iloc(1:2,ji) = (/ mig0(iloc(1,ji)), mjg0(iloc(2,ji)) /)
+ iloc(1:2,ji) = (/ mig(iloc(1,ji),0), mjg(iloc(2,ji),0) /)
END DO
iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information
ENDIF
diff --git a/tests/DOME/MY_SRC/usrdef_hgr.F90 b/tests/DOME/MY_SRC/usrdef_hgr.F90
index e135d867ad01c3effe1b5eda4ffb79775321b596..3717ef1cc0e7b7cac05812f497c814c2bbe57a56 100644
--- a/tests/DOME/MY_SRC/usrdef_hgr.F90
+++ b/tests/DOME/MY_SRC/usrdef_hgr.F90
@@ -93,8 +93,8 @@ CONTAINS
#endif
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- zti = REAL( mig0(ji) - 1, wp ) ! start at i=0 in the global grid without halos
- ztj = REAL( mjg0(jj) - 1, wp ) ! start at j=0 in the global grid without halos
+ zti = REAL( mig(ji,0) - 1, wp ) ! start at i=0 in the global grid without halos
+ ztj = REAL( mjg(jj,0) - 1, wp ) ! start at j=0 in the global grid without halos
plamt(ji,jj) = roffsetx + rn_dx * 1.e-3 * ( zti - 0.5_wp )
plamu(ji,jj) = roffsetx + rn_dx * 1.e-3 * zti
diff --git a/tests/DOME/MY_SRC/usrdef_istate.F90 b/tests/DOME/MY_SRC/usrdef_istate.F90
index e41bad22dc51d56f3ad634693a06281e573014d1..782e164e35250f7a9bc3af7ed437ca9211632f7c 100644
--- a/tests/DOME/MY_SRC/usrdef_istate.F90
+++ b/tests/DOME/MY_SRC/usrdef_istate.F90
@@ -105,10 +105,10 @@ CONTAINS
! ztd = 15._wp*gdepw_0(ji,jj,jk+1)-0.5*rho0*zn2/(rn_a0*grav)*gdepw_0(ji,jj,jk+1)**2
! ztu = 15._wp*gdepw_0(ji,jj,jk )-0.5*rho0*zn2/(rn_a0*grav)*gdepw_0(ji,jj,jk )**2
! pts(ji,jj,jk,jp_tem) = (ztd - ztu)/e3t_0(ji,jj,jk) * ptmask(ji,jj,jk)
- IF (Agrif_root().AND.( mjg0(jj) == Nj0glo-2 ) ) THEN
+ IF (Agrif_root().AND.( mjg(jj,0) == Nj0glo-2 ) ) THEN
pv(ji,jj,jk) = -sqrt(zdb*zh0)*exp(-zxw/zro)*(1._wp-zf) * ptmask(ji,jj,jk)
ENDIF
- IF (Agrif_root().AND.( mjg0(jj) == Nj0glo-1 ) ) THEN
+ IF (Agrif_root().AND.( mjg(jj,0) == Nj0glo-1 ) ) THEN
pts(ji,jj,jk,jp_tem) = MIN(pts(ji,jj,jk,jp_tem), 15._wp - zdb*rho0/grav/rn_a0*(1._wp-zf)) * ptmask(ji,jj,jk)
pts(ji,jj,jk,jp_sal) = 1._wp * ptmask(ji,jj,jk)
ENDIF
diff --git a/tests/DOME/MY_SRC/usrdef_zgr.F90 b/tests/DOME/MY_SRC/usrdef_zgr.F90
index 797006a772fd6df5b35684cf7bc4f997fe1dc69c..0fb7ecd0cfb333f9ec198dfd3e0f833f8bab3350 100644
--- a/tests/DOME/MY_SRC/usrdef_zgr.F90
+++ b/tests/DOME/MY_SRC/usrdef_zgr.F90
@@ -14,8 +14,7 @@ MODULE usrdef_zgr
!! zgr_z1d : reference 1D z-coordinate
!!---------------------------------------------------------------------
USE oce ! ocean variables
- USE dom_oce , ONLY: mi0, mi1 ! ocean space and time domain
- USE dom_oce , ONLY: glamt, gphit ! ocean space and time domain
+ USE dom_oce ! ocean space and time domain
USE usrdef_nam ! User defined : namelist variables
!
USE in_out_manager ! I/O manager
diff --git a/tests/ICB/MY_SRC/usrdef_nam.F90 b/tests/ICB/MY_SRC/usrdef_nam.F90
index e850ce892fc8898e80374eedac0d0268a6b2f4fa..a9e5401091b47826a38c8c471a967d73fde11195 100644
--- a/tests/ICB/MY_SRC/usrdef_nam.F90
+++ b/tests/ICB/MY_SRC/usrdef_nam.F90
@@ -14,7 +14,6 @@ MODULE usrdef_nam
!! usr_def_nam : read user defined namelist and set global domain size
!! usr_def_hgr : initialize the horizontal mesh
!!----------------------------------------------------------------------
- USE dom_oce , ONLY: nimpp , njmpp ! i- & j-indices of the local domain
USE dom_oce , ONLY: ln_zco, ln_zps, ln_sco ! flag of type of coordinate
USE par_oce ! ocean space and time domain
USE phycst ! physical constants
diff --git a/tests/ICE_ADV1D/MY_SRC/usrdef_hgr.F90 b/tests/ICE_ADV1D/MY_SRC/usrdef_hgr.F90
index 507212b66c157e048e60fbd7e31b79faedc5a880..92abf49f0240c8c9b9f60eb547ad8dbb47fac0e8 100644
--- a/tests/ICE_ADV1D/MY_SRC/usrdef_hgr.F90
+++ b/tests/ICE_ADV1D/MY_SRC/usrdef_hgr.F90
@@ -78,8 +78,8 @@ CONTAINS
zphi0 = -REAL(Nj0glo, wp) * 0.5 * 1.e-3 * rn_dy
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- zti = REAL( mig0(ji), wp ) - 0.5_wp ! start at i=0.5 in the global grid without halos
- ztj = REAL( mjg0(jj), wp ) - 0.5_wp ! start at j=0.5 in the global grid without halos
+ zti = REAL( mig(ji,0), wp ) - 0.5_wp ! start at i=0.5 in the global grid without halos
+ ztj = REAL( mjg(jj,0), wp ) - 0.5_wp ! start at j=0.5 in the global grid without halos
plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti
plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * ( zti + 0.5_wp )
diff --git a/tests/ICE_ADV2D/MY_SRC/usrdef_hgr.F90 b/tests/ICE_ADV2D/MY_SRC/usrdef_hgr.F90
index b2b645b8bef5d3e4e6e5bb2dbee77bfe5e14ed3b..0c554f80d531e4db2cb8bf57b27b4dd6fd9dac49 100644
--- a/tests/ICE_ADV2D/MY_SRC/usrdef_hgr.F90
+++ b/tests/ICE_ADV2D/MY_SRC/usrdef_hgr.F90
@@ -90,8 +90,8 @@ CONTAINS
#endif
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- zti = REAL( mig0(ji), wp ) - 0.5_wp ! start at i=0.5 in the global grid without halos
- ztj = REAL( mjg0(jj), wp ) - 0.5_wp ! start at j=0.5 in the global grid without halos
+ zti = REAL( mig(ji,0), wp ) - 0.5_wp ! start at i=0.5 in the global grid without halos
+ ztj = REAL( mjg(jj,0), wp ) - 0.5_wp ! start at j=0.5 in the global grid without halos
plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti
plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * ( zti + 0.5_wp )
@@ -110,19 +110,19 @@ CONTAINS
!! clem: This can be used with a 1proc simulation but I think it breaks repro when >1procs are used
!! DO jj = 1, jpj
!! DO ji = 1, jpi
-!! !!pe1t(ji,jj) = rn_dx * EXP( -0.8/REAL(jpiglo**2) * (mi0(ji)-REAL(jpiglo+1)*0.5)**2 ) ! gaussian shape
-!! !!pe2t(ji,jj) = rn_dy * EXP( -0.8/REAL(jpjglo**2) * (mj0(jj)-REAL(jpjglo+1)*0.5)**2 ) ! gaussian shape
-!! pe1t(ji,jj) = rn_dx * ( 1. -0.1 * ABS(REAL(mi0(ji))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) ) ! linear shape
-!! pe2t(ji,jj) = rn_dy * ( 1. -0.1 * ABS(REAL(mj0(jj))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) ) ! linear shape
+!! !!pe1t(ji,jj) = rn_dx * EXP( -0.8/REAL(jpiglo**2) * (mi0(ji,nn_hls)-REAL(jpiglo+1)*0.5)**2 ) ! gaussian shape
+!! !!pe2t(ji,jj) = rn_dy * EXP( -0.8/REAL(jpjglo**2) * (mj0(jj,nn_hls)-REAL(jpjglo+1)*0.5)**2 ) ! gaussian shape
+!! pe1t(ji,jj) = rn_dx * ( 1. -0.1 * ABS(REAL(mi0(ji,nn_hls))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) ) ! linear shape
+!! pe2t(ji,jj) = rn_dy * ( 1. -0.1 * ABS(REAL(mj0(jj,nn_hls))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) ) ! linear shape
!! END DO
!! END DO
!!#if defined key_agrif
!! IF( .NOT. Agrif_Root() ) THEN ! only works if the zoom is positioned at the center of the parent grid
!! DO jj = 1, jpj
!! DO ji = 1, jpi
-!! pe1t(ji,jj) = rn_dx * ( 1. -0.1 * ABS(REAL(mi0(ji))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) &
+!! pe1t(ji,jj) = rn_dx * ( 1. -0.1 * ABS(REAL(mi0(ji,nn_hls))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) &
!! & * REAL(jpiglo) / REAL(Agrif_Parent(jpiglo) * Agrif_Rhox()) ) ! factor to match parent grid
-!! pe2t(ji,jj) = rn_dy * ( 1. -0.1 * ABS(REAL(mj0(jj))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) &
+!! pe2t(ji,jj) = rn_dy * ( 1. -0.1 * ABS(REAL(mj0(jj,nn_hls))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) &
!! & * REAL(jpjglo) / REAL(Agrif_Parent(jpjglo) * Agrif_Rhoy()) ) ! factor to match parent grid
!! END DO
!! END DO
diff --git a/tests/ICE_AGRIF/MY_SRC/usrdef_hgr.F90 b/tests/ICE_AGRIF/MY_SRC/usrdef_hgr.F90
index 9ac18267bd01a0fbc24a3469adb0eaf483d2cc95..c087ceeb08f4aa717bb5becfaee406ad0e5aee82 100644
--- a/tests/ICE_AGRIF/MY_SRC/usrdef_hgr.F90
+++ b/tests/ICE_AGRIF/MY_SRC/usrdef_hgr.F90
@@ -96,8 +96,8 @@ CONTAINS
ENDIF
#endif
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- zti = REAL( mig0(ji)-1, wp ) ! start at i=0 in the global grid without halos
- ztj = REAL( mjg0(jj)-1, wp ) ! start at j=0 in the global grid without halos
+ zti = REAL( mig(ji,0)-1, wp ) ! start at i=0 in the global grid without halos
+ ztj = REAL( mjg(jj,0)-1, wp ) ! start at j=0 in the global grid without halos
plamt(ji,jj) = roffsetx + rn_dx * 1.e-3 * ( zti - 0.5_wp )
plamu(ji,jj) = roffsetx + rn_dx * 1.e-3 * zti
@@ -116,19 +116,19 @@ CONTAINS
!! clem: This can be used with a 1proc simulation but I think it breaks repro when >1procs are used
!! DO jj = 1, jpj
!! DO ji = 1, jpi
-!! !!pe1t(ji,jj) = rn_dx * EXP( -0.8/REAL(jpiglo**2) * (mi0(ji)-REAL(jpiglo+1)*0.5)**2 ) ! gaussian shape
-!! !!pe2t(ji,jj) = rn_dy * EXP( -0.8/REAL(jpjglo**2) * (mj0(jj)-REAL(jpjglo+1)*0.5)**2 ) ! gaussian shape
-!! pe1t(ji,jj) = rn_dx * ( 1. -0.1 * ABS(REAL(mi0(ji))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) ) ! linear shape
-!! pe2t(ji,jj) = rn_dy * ( 1. -0.1 * ABS(REAL(mj0(jj))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) ) ! linear shape
+!! !!pe1t(ji,jj) = rn_dx * EXP( -0.8/REAL(jpiglo**2) * (mi0(ji,nn_hls)-REAL(jpiglo+1)*0.5)**2 ) ! gaussian shape
+!! !!pe2t(ji,jj) = rn_dy * EXP( -0.8/REAL(jpjglo**2) * (mj0(jj,nn_hls)-REAL(jpjglo+1)*0.5)**2 ) ! gaussian shape
+!! pe1t(ji,jj) = rn_dx * ( 1. -0.1 * ABS(REAL(mi0(ji,nn_hls))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) ) ! linear shape
+!! pe2t(ji,jj) = rn_dy * ( 1. -0.1 * ABS(REAL(mj0(jj,nn_hls))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) ) ! linear shape
!! END DO
!! END DO
!!#if defined key_agrif
!! IF( .NOT. Agrif_Root() ) THEN ! only works if the zoom is positioned at the center of the parent grid
!! DO jj = 1, jpj
!! DO ji = 1, jpi
-!! pe1t(ji,jj) = rn_dx * ( 1. -0.1 * ABS(REAL(mi0(ji))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) &
+!! pe1t(ji,jj) = rn_dx * ( 1. -0.1 * ABS(REAL(mi0(ji,nn_hls))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) &
!! & * REAL(jpiglo) / REAL(Agrif_Parent(jpiglo) * Agrif_Rhox()) ) ! factor to match parent grid
-!! pe2t(ji,jj) = rn_dy * ( 1. -0.1 * ABS(REAL(mj0(jj))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) &
+!! pe2t(ji,jj) = rn_dy * ( 1. -0.1 * ABS(REAL(mj0(jj,nn_hls))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) &
!! & * REAL(jpjglo) / REAL(Agrif_Parent(jpjglo) * Agrif_Rhoy()) ) ! factor to match parent grid
!! END DO
!! END DO
diff --git a/tests/ICE_AGRIF/MY_SRC/usrdef_sbc.F90 b/tests/ICE_AGRIF/MY_SRC/usrdef_sbc.F90
index 6e7c527bf6b2f0361b64717e4c46ca4acd491f2a..5ba2758fdf833f73adb137067238e6437b98bc15 100644
--- a/tests/ICE_AGRIF/MY_SRC/usrdef_sbc.F90
+++ b/tests/ICE_AGRIF/MY_SRC/usrdef_sbc.F90
@@ -18,7 +18,7 @@ MODULE usrdef_sbc
USE sbc_ice ! Surface boundary condition: ice fields
USE phycst ! physical constants
USE ice, ONLY : at_i_b, a_i_b
- USE icethd_dh ! for CALL ice_thd_snwblow
+!! USE icethd_dh ! for CALL ice_thd_snwblow
USE sbc_phy, ONLY : pp_cldf
!
USE in_out_manager ! I/O manager
@@ -33,6 +33,8 @@ MODULE usrdef_sbc
PUBLIC usrdef_sbc_ice_tau ! routine called by icestp.F90 for ice dynamics
PUBLIC usrdef_sbc_ice_flx ! routine called by icestp.F90 for ice thermo
+ !! * Substitutions
+# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
!! $Id: usrdef_sbc.F90 14273 2021-01-06 10:57:45Z smasson $
@@ -109,8 +111,8 @@ CONTAINS
!!
INTEGER :: jl
REAL(wp) :: zfr1, zfr2 ! local variables
- REAL(wp), DIMENSION(jpi,jpj) :: zsnw ! snw distribution after wind blowing
- REAL(wp), DIMENSION(jpi,jpj) :: ztri
+ REAL(wp), DIMENSION(A2D(0)) :: zsnw ! snw distribution after wind blowing
+ REAL(wp), DIMENSION(A2D(0)) :: ztri
!!---------------------------------------------------------------------
!
IF( kt==nit000 .AND. lwp) WRITE(numout,*)' usrdef_sbc_ice : ICE_AGRIF case: NO flux forcing'
@@ -134,9 +136,9 @@ CONTAINS
emp_ice (:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw(:,:)
emp_oce (:,:) = emp_oce(:,:) - sprecip(:,:) * (1._wp - zsnw(:,:) )
qevap_ice(:,:,:) = 0._wp
- qprec_ice(:,:) = rhos * ( sst_m(:,:) * rcpi - rLfus ) * tmask(:,:,1) ! in J/m3
- qemp_oce (:,:) = - emp_oce(:,:) * sst_m(:,:) * rcp
- qemp_ice (:,:) = sprecip(:,:) * zsnw * ( sst_m(:,:) * rcpi - rLfus ) * tmask(:,:,1) ! solid precip (only)
+ qprec_ice(:,:) = rhos * ( sst_m(A2D(0)) * rcpi - rLfus ) * smask0(:,:) ! in J/m3
+ qemp_oce (:,:) = - emp_oce(:,:) * sst_m(A2D(0)) * rcp
+ qemp_ice (:,:) = sprecip(:,:) * zsnw * ( sst_m(A2D(0)) * rcpi - rLfus ) * smask0(:,:) ! solid precip (only)
! total fluxes
emp_tot (:,:) = emp_ice + emp_oce
@@ -148,11 +150,11 @@ CONTAINS
ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:) ! surface transmission when hi>10cm
!
DO jl = 1, jpl
- WHERE ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) < 0.1_wp ) ! linear decrease from hi=0 to 10cm
- qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) )
- ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp ) ! constant (ztri) when hi>10cm
+ WHERE ( phs(A2D(0),jl) <= 0._wp .AND. phi(A2D(0),jl) < 0.1_wp ) ! linear decrease from hi=0 to 10cm
+ qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(A2D(0),jl) * 10._wp ) )
+ ELSEWHERE( phs(A2D(0),jl) <= 0._wp .AND. phi(A2D(0),jl) >= 0.1_wp ) ! constant (ztri) when hi>10cm
qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ztri(:,:)
- ELSEWHERE ! zero when hs>0
+ ELSEWHERE ! zero when hs>0
qtr_ice_top(:,:,jl) = 0._wp
END WHERE
ENDDO
diff --git a/tests/ICE_RHEO/MY_SRC/icedyn_rhg_eap.F90 b/tests/ICE_RHEO/MY_SRC/icedyn_rhg_eap.F90
index 2c5e43487d05e15c63bc35b4cd3ceecd7629d9c6..6db0b1114dfb9565eaf1f47c2a1139f591b99f71 100644
--- a/tests/ICE_RHEO/MY_SRC/icedyn_rhg_eap.F90
+++ b/tests/ICE_RHEO/MY_SRC/icedyn_rhg_eap.F90
@@ -573,7 +573,7 @@ CONTAINS
& ) * zmsk00y(ji,jj)
ENDIF
!extra code for test case boundary conditions
- IF (mjg(jj)<25 .or. mjg(jj)>975 .or. mig(ji)<25 .or. mig(ji)>975) THEN
+ IF (mjg(jj,nn_hls)<25 .or. mjg(jj,nn_hls)>975 .or. mig(ji,nn_hls)<25 .or. mig(ji,nn_hls)>975) THEN
v_ice(ji,jj) = zinvw*(ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj))
END IF
@@ -630,7 +630,7 @@ CONTAINS
& ) * zmsk00x(ji,jj)
ENDIF
!extra code for test case boundary conditions
- IF (mjg(jj)<25 .or. mjg(jj)>975 .or. mig(ji)<25 .or. mig(ji)>975) THEN
+ IF (mjg(jj,nn_hls)<25 .or. mjg(jj,nn_hls)>975 .or. mig(ji,nn_hls)<25 .or. mig(ji,nn_hls)>975) THEN
u_ice(ji,jj) = zinvw*(ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj))
END IF
@@ -689,7 +689,7 @@ CONTAINS
& ) * zmsk00x(ji,jj)
ENDIF
!extra code for test case boundary conditions
- IF (mjg(jj)<25 .or. mjg(jj)>975 .or. mig(ji)<25 .or. mig(ji)>975) THEN
+ IF (mjg(jj,nn_hls)<25 .or. mjg(jj,nn_hls)>975 .or. mig(ji,nn_hls)<25 .or. mig(ji,nn_hls)>975) THEN
u_ice(ji,jj) = zinvw*(ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj))
END IF
END_2D
@@ -745,7 +745,7 @@ CONTAINS
& ) * zmsk00y(ji,jj)
ENDIF
!extra code for test case boundary conditions
- IF (mjg(jj)<25 .or. mjg(jj)>975 .or. mig(ji)<25 .or. mig(ji)>975) THEN
+ IF (mjg(jj,nn_hls)<25 .or. mjg(jj,nn_hls)>975 .or. mig(ji,nn_hls)<25 .or. mig(ji,nn_hls)>975) THEN
v_ice(ji,jj) = zinvw*(ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj))
END IF
END_2D
@@ -1048,7 +1048,7 @@ CONTAINS
zresm = 0._wp
DO_2D( 0, 0, 0, 0 )
! cut of the boundary of the box (forced velocities)
- IF (mjg0(jj)>30 .AND. mjg0(jj)<=970 .AND. mig0(ji)>30 .AND. mig0(ji)<=970) THEN
+ IF (mjg(jj,0)>30 .AND. mjg(jj,0)<=970 .AND. mig(ji,0)>30 .AND. mig(ji,0)<=970) THEN
zresm = MAX( zresm, MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), &
& ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * pmsk15(ji,jj) )
ENDIF
diff --git a/tests/ICE_RHEO/MY_SRC/icedyn_rhg_evp.F90 b/tests/ICE_RHEO/MY_SRC/icedyn_rhg_evp.F90
index e2df97c76b330d0d855e9d4521260c2dc3a93bdd..8f691d6ca3f18e403d45fd70a5d7655295c8ca10 100644
--- a/tests/ICE_RHEO/MY_SRC/icedyn_rhg_evp.F90
+++ b/tests/ICE_RHEO/MY_SRC/icedyn_rhg_evp.F90
@@ -525,7 +525,7 @@ CONTAINS
& ) * zmsk00y(ji,jj)
ENDIF
!extra code for test case boundary conditions
- IF (mjg(jj)<25 .or. mjg(jj)>975 .or. mig(ji)<25 .or. mig(ji)>975) THEN
+ IF (mjg(jj,nn_hls)<25 .or. mjg(jj,nn_hls)>975 .or. mig(ji,nn_hls)<25 .or. mig(ji,nn_hls)>975) THEN
v_ice(ji,jj) = zinvw*(ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj))
END IF
END_2D
@@ -581,7 +581,7 @@ CONTAINS
& ) * zmsk00x(ji,jj)
ENDIF
!extra code for test case boundary conditions
- IF (mjg(jj)<25 .or. mjg(jj)>975 .or. mig(ji)<25 .or. mig(ji)>975) THEN
+ IF (mjg(jj,nn_hls)<25 .or. mjg(jj,nn_hls)>975 .or. mig(ji,nn_hls)<25 .or. mig(ji,nn_hls)>975) THEN
u_ice(ji,jj) = zinvw*(ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj))
END IF
END_2D
@@ -639,7 +639,7 @@ CONTAINS
& ) * zmsk00x(ji,jj)
ENDIF
!extra code for test case boundary conditions
- IF (mjg(jj)<25 .or. mjg(jj)>975 .or. mig(ji)<25 .or. mig(ji)>975) THEN
+ IF (mjg(jj,nn_hls)<25 .or. mjg(jj,nn_hls)>975 .or. mig(ji,nn_hls)<25 .or. mig(ji,nn_hls)>975) THEN
u_ice(ji,jj) = zinvw*(ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj))
END IF
END_2D
@@ -695,7 +695,7 @@ CONTAINS
& ) * zmsk00y(ji,jj)
ENDIF
!extra code for test case boundary conditions
- IF (mjg(jj)<25 .or. mjg(jj)>975 .or. mig(ji)<25 .or. mig(ji)>975) THEN
+ IF (mjg(jj,nn_hls)<25 .or. mjg(jj,nn_hls)>975 .or. mig(ji,nn_hls)<25 .or. mig(ji,nn_hls)>975) THEN
v_ice(ji,jj) = zinvw*(ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj))
END IF
END_2D
@@ -978,7 +978,7 @@ CONTAINS
zresm = 0._wp
DO_2D( 0, 0, 0, 0 )
! cut of the boundary of the box (forced velocities)
- IF (mjg0(jj)>30 .AND. mjg0(jj)<=970 .AND. mig0(ji)>30 .AND. mig0(ji)<=970) THEN
+ IF (mjg(jj,0)>30 .AND. mjg(jj,0)<=970 .AND. mig(ji,0)>30 .AND. mig(ji,0)<=970) THEN
zresm = MAX( zresm, MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), &
& ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * pmsk15(ji,jj) )
ENDIF
diff --git a/tests/ICE_RHEO/MY_SRC/usrdef_hgr.F90 b/tests/ICE_RHEO/MY_SRC/usrdef_hgr.F90
index e585820e8d60519aa219f35a333b81a1669cf7b4..679c2153369de41d2e31b05ebed04b9c2a1dc1b0 100644
--- a/tests/ICE_RHEO/MY_SRC/usrdef_hgr.F90
+++ b/tests/ICE_RHEO/MY_SRC/usrdef_hgr.F90
@@ -98,17 +98,17 @@ CONTAINS
!! ==> EITHER 1) variable scale factors
!! clem: This can be used with a 1proc simulation but I think it breaks repro when >1procs are used
!! DO_2D( 1, 1, 1, 1 )
-!! !!pe1t(ji,jj) = rn_dx * EXP( -0.8/REAL(jpiglo**2) * (mi0(ji)-REAL(jpiglo+1)*0.5)**2 ) ! gaussian shape
-!! !!pe2t(ji,jj) = rn_dy * EXP( -0.8/REAL(jpjglo**2) * (mj0(jj)-REAL(jpjglo+1)*0.5)**2 ) ! gaussian shape
-!! pe1t(ji,jj) = rn_dx * ( 1. -0.1 * ABS(REAL(mi0(ji))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) ) ! linear shape
-!! pe2t(ji,jj) = rn_dy * ( 1. -0.1 * ABS(REAL(mj0(jj))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) ) ! linear shape
+!! !!pe1t(ji,jj) = rn_dx * EXP( -0.8/REAL(jpiglo**2) * (mi0(ji,nn_hls)-REAL(jpiglo+1)*0.5)**2 ) ! gaussian shape
+!! !!pe2t(ji,jj) = rn_dy * EXP( -0.8/REAL(jpjglo**2) * (mj0(jj,nn_hls)-REAL(jpjglo+1)*0.5)**2 ) ! gaussian shape
+!! pe1t(ji,jj) = rn_dx * ( 1. -0.1 * ABS(REAL(mi0(ji,nn_hls))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) ) ! linear shape
+!! pe2t(ji,jj) = rn_dy * ( 1. -0.1 * ABS(REAL(mj0(jj,nn_hls))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) ) ! linear shape
!! END_2D
!!#if defined key_agrif
!! IF( .NOT. Agrif_Root() ) THEN ! only works if the zoom is positioned at the center of the parent grid
!! DO_2D( 1, 1, 1, 1 )
-!! pe1t(ji,jj) = rn_dx * ( 1. -0.1 * ABS(REAL(mi0(ji))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) &
+!! pe1t(ji,jj) = rn_dx * ( 1. -0.1 * ABS(REAL(mi0(ji,nn_hls))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) &
!! & * REAL(jpiglo) / REAL(Agrif_Parent(jpiglo) * Agrif_Rhox()) ) ! factor to match parent grid
-!! pe2t(ji,jj) = rn_dy * ( 1. -0.1 * ABS(REAL(mj0(jj))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) &
+!! pe2t(ji,jj) = rn_dy * ( 1. -0.1 * ABS(REAL(mj0(jj,nn_hls))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) &
!! & * REAL(jpjglo) / REAL(Agrif_Parent(jpjglo) * Agrif_Rhoy()) ) ! factor to match parent grid
!! END_2D
!! ENDIF
diff --git a/tests/ICE_RHEO/MY_SRC/usrdef_nam.F90 b/tests/ICE_RHEO/MY_SRC/usrdef_nam.F90
index 0f92fbee59790456df45d03d39da5357845781f8..df8898d9206e0f7401db9490c0c22554ca252fc7 100644
--- a/tests/ICE_RHEO/MY_SRC/usrdef_nam.F90
+++ b/tests/ICE_RHEO/MY_SRC/usrdef_nam.F90
@@ -13,7 +13,6 @@ MODULE usrdef_nam
!! usr_def_nam : read user defined namelist and set global domain size
!! usr_def_hgr : initialize the horizontal mesh
!!----------------------------------------------------------------------
- USE dom_oce , ONLY: nimpp , njmpp , Agrif_Root ! i- & j-indices of the local domain
USE par_oce ! ocean space and time domain
USE phycst ! physical constants
!
diff --git a/tests/ICE_RHEO/MY_SRC/usrdef_sbc.F90 b/tests/ICE_RHEO/MY_SRC/usrdef_sbc.F90
index 2a22cfc80c11be0f67c616b8aa3e31cb72242066..603cb78a3d34b5009d3e20302978fceae1b392d9 100644
--- a/tests/ICE_RHEO/MY_SRC/usrdef_sbc.F90
+++ b/tests/ICE_RHEO/MY_SRC/usrdef_sbc.F90
@@ -71,8 +71,8 @@ CONTAINS
!ij0 = 1 ; ij1 = 25 ! set boundary condition
!ii0 = 975 ; ii1 = 1000
- !DO jj = mj0(ij0), mj1(ij1)
- ! DO ji = mi0(ii0), mi1(ii1)
+ !DO jj = mj0(ij0,nn_hls), mj1(ij1,nn_hls)
+ ! DO ji = mi0(ii0,nn_hls), mi1(ii1,nn_hls)
! utau(ji,jj) = -utau_ice(ji,jj)
! vtau(ji,jj) = -vtau_ice(ji,jj)
! END DO
@@ -108,7 +108,7 @@ CONTAINS
REAL(wp) :: zwndi_f , zwndj_f, zwnorm_f ! relative wind module and components at F-point
REAL(wp) :: zwndi_t , zwndj_t ! relative wind components at T-point
- REAL(wp), DIMENSION(jpi,jpj) :: windu, windv ! wind components (idealised forcing)
+ REAL(wp), DIMENSION(A2D(0)) :: windu, windv ! wind components (idealised forcing)
REAL(wp), PARAMETER :: r_vfac = 1._wp ! relative velocity (make 0 for absolute velocity)
REAL(wp), PARAMETER :: Rwind = -0.8_wp ! ratio of wind components
REAL(wp), PARAMETER :: Umax = 15._wp ! maximum wind speed (m/s)
@@ -122,8 +122,10 @@ CONTAINS
DO_2D( 0, 0, 0, 0 )
! wind spins up over 6 hours, factor 1000 to balance the units
- windu(ji,jj) = Umax/sqrt(d*1000)*(d-2*mig(ji)*res)/((d-2*mig(ji)*res)**2+(d-2*mjg(jj)*res)**2*Rwind**2)**(1/4)*min(kt*30./21600,1.)
- windv(ji,jj) = Umax/sqrt(d*1000)*(d-2*mjg(jj)*res)/((d-2*mig(ji)*res)**2+(d-2*mjg(jj)*res)**2*Rwind**2)**(1/4)*Rwind*min(kt*30./21600,1.)
+ windu(ji,jj) = Umax/SQRT(d*1000)*(d-2*mig(ji,nn_hls)*res) / &
+ & ((d-2*mig(ji,nn_hls)*res)**2+(d-2*mjg(jj,nn_hls)*res)**2*Rwind**2)**(1/4)*MIN(kt*30./21600,1.)
+ windv(ji,jj) = Umax/SQRT(d*1000)*(d-2*mjg(jj,nn_hls)*res) / &
+ & ((d-2*mig(ji,nn_hls)*res)**2+(d-2*mjg(jj,nn_hls)*res)**2*Rwind**2)**(1/4)*Rwind*MIN(kt*30./21600,1.)
END_2D
! ------------------------------------------------------------ !
@@ -138,7 +140,7 @@ CONTAINS
utau_ice(ji,jj) = zrhoa * Cd_atm * wndm_ice(ji,jj) * zwndi_t
vtau_ice(ji,jj) = zrhoa * Cd_atm * wndm_ice(ji,jj) * zwndj_t
END_2D
- CALL lbc_lnk( 'usrdef_sbc', wndm_ice, 'T', 1., utau_ice, 'T', -1., vtau_ice, 'T', -1. )
+ CALL lbc_lnk( 'usrdef_sbc', utau_ice, 'T', -1., vtau_ice, 'T', -1. )
!
END SUBROUTINE usrdef_sbc_ice_tau
@@ -154,7 +156,7 @@ CONTAINS
REAL(wp), DIMENSION(:,:,:), INTENT(in) :: phi ! ice thickness
!!
REAL(wp) :: zfr1, zfr2 ! local variables
- REAL(wp), DIMENSION(jpi,jpj) :: zsnw ! snw distribution after wind blowing
+ REAL(wp), DIMENSION(A2D(0)) :: zsnw ! snw distribution after wind blowing
!!---------------------------------------------------------------------
!
IF( kt==nit000 .AND. lwp) WRITE(numout,*)' usrdef_sbc_ice : ICE_RHEO case: NO flux forcing'
@@ -178,9 +180,9 @@ CONTAINS
emp_ice (:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw(:,:)
emp_oce (:,:) = emp_oce(:,:) - sprecip(:,:) * (1._wp - zsnw(:,:) )
qevap_ice(:,:,:) = 0._wp
- qprec_ice(:,:) = rhos * ( sst_m(:,:) * rcpi - rLfus ) * tmask(:,:,1) ! in J/m3
- qemp_oce (:,:) = - emp_oce(:,:) * sst_m(:,:) * rcp
- qemp_ice (:,:) = sprecip(:,:) * zsnw * ( sst_m(:,:) * rcpi - rLfus ) * tmask(:,:,1) ! solid precip (only)
+ qprec_ice(:,:) = rhos * ( sst_m(A2D(0)) * rcpi - rLfus ) * smask0(:,:) ! in J/m3
+ qemp_oce (:,:) = - emp_oce(:,:) * sst_m(A2D(0)) * rcp
+ qemp_ice (:,:) = sprecip(:,:) * zsnw * ( sst_m(A2D(0)) * rcpi - rLfus ) * smask0(:,:) ! solid precip (only)
! total fluxes
emp_tot (:,:) = emp_ice + emp_oce
@@ -191,11 +193,11 @@ CONTAINS
zfr1 = ( 0.18 * ( 1.0 - pp_cldf ) + 0.35 * pp_cldf ) ! transmission when hi>10cm
zfr2 = ( 0.82 * ( 1.0 - pp_cldf ) + 0.65 * pp_cldf ) ! zfr2 such that zfr1 + zfr2 to equal 1
!
- WHERE ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) < 0.1_wp ) ! linear decrease from hi=0 to 10cm
- qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) )
- ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp ) ! constant (zfr1) when hi>10cm
+ WHERE ( phs(A2D(0),:) <= 0._wp .AND. phi(A2D(0),:) < 0.1_wp ) ! linear decrease from hi=0 to 10cm
+ qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(A2D(0),:) * 10._wp ) )
+ ELSEWHERE( phs(A2D(0),:) <= 0._wp .AND. phi(A2D(0),:) >= 0.1_wp ) ! constant (zfr1) when hi>10cm
qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1
- ELSEWHERE ! zero when hs>0
+ ELSEWHERE ! zero when hs>0
qtr_ice_top(:,:,:) = 0._wp
END WHERE
diff --git a/tests/ISOMIP+/EXPREF/namelist_cfg b/tests/ISOMIP+/EXPREF/namelist_cfg
index 0b8ae4c942cae45c37a6d6af06a6289e343a890b..4f520bed6b9bf846c87b0c5a80efbbaee91e7d37 100644
--- a/tests/ISOMIP+/EXPREF/namelist_cfg
+++ b/tests/ISOMIP+/EXPREF/namelist_cfg
@@ -310,14 +310,19 @@ rn_Dt = 720.
!-----------------------------------------------------------------------
&nameos ! ocean Equation Of Seawater (default: NO selection)
!-----------------------------------------------------------------------
- ln_leos = .true. ! = Use L-EOS (linear Eq.)
- !
+ ln_seos = .true. ! = Use S-EOS (simplified Eq.)
! ! S-EOS coefficients (ln_seos=T):
! ! rd(T,S,Z)*rho0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS
- ! ! L-EOS coefficients (ln_seos=T):
- ! ! rd(T,S,Z)*rho0 = rho0*(-a0*dT+b0*dS)
+ ! ! dT = T-rn_T0 ; dS = S-rn_S0
+ rn_T0 = -1. ! reference temperature
+ rn_S0 = 34.2 ! reference salinity
rn_a0 = 3.7330e-5 ! thermal expension coefficient
rn_b0 = 7.8430e-4 ! saline expension coefficient
+ rn_lambda1 = 0. ! cabbeling coeff in T^2 (=0 for linear eos)
+ rn_lambda2 = 0. ! cabbeling coeff in S^2 (=0 for linear eos)
+ rn_mu1 = 0. ! thermobaric coeff. in T (=0 for linear eos)
+ rn_mu2 = 0. ! thermobaric coeff. in S (=0 for linear eos)
+ rn_nu = 0. ! cabbeling coeff in T*S (=0 for linear eos)
/
!-----------------------------------------------------------------------
&namtra_adv ! advection scheme for tracer (default: NO selection)
diff --git a/tests/ISOMIP+/MY_SRC/dtatsd.F90 b/tests/ISOMIP+/MY_SRC/dtatsd.F90
index cdee4ac5f65296fbbcdeb83ba0235006dd208c4c..485fae65ce9b57cc1b4fddf6c946fdf92391e0cd 100644
--- a/tests/ISOMIP+/MY_SRC/dtatsd.F90
+++ b/tests/ISOMIP+/MY_SRC/dtatsd.F90
@@ -33,8 +33,8 @@ MODULE dtatsd
LOGICAL , PUBLIC :: ln_tsd_init !: T & S data flag
LOGICAL , PUBLIC :: ln_tsd_dmp !: internal damping toward input data flag
+ TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_tsd ! structure of input SST (file informations, fields read)
TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_tsdini ! structure of input SST (file informations, fields read)
- TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_tsddmp ! structure of input SST (file informations, fields read)
!! * Substitutions
# include "do_loop_substitute.h90"
@@ -121,16 +121,16 @@ CONTAINS
IF( ln_tsd_dmp ) THEN
!
- ALLOCATE( sf_tsddmp(jpts), STAT=ierr0 )
+ ALLOCATE( sf_tsd(jpts), STAT=ierr0 )
IF( ierr0 > 0 ) THEN
- CALL ctl_stop( 'dta_tsd_init: unable to allocate sf_tsddmp structure' ) ; RETURN
+ CALL ctl_stop( 'dta_tsd_init: unable to allocate sf_tsd structure' ) ; RETURN
ENDIF
!
! dmp file
- ALLOCATE( sf_tsddmp(jp_tem)%fnow(jpi,jpj,jpk) , STAT=ierr0 )
- IF( sn_dmpt%ln_tint ) ALLOCATE( sf_tsddmp(jp_tem)%fdta(jpi,jpj,jpk,2) , STAT=ierr1 )
- ALLOCATE( sf_tsddmp(jp_sal)%fnow(jpi,jpj,jpk) , STAT=ierr2 )
- IF( sn_dmps%ln_tint ) ALLOCATE( sf_tsddmp(jp_sal)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 )
+ ALLOCATE( sf_tsd(jp_tem)%fnow(jpi,jpj,jpk) , STAT=ierr0 )
+ IF( sn_dmpt%ln_tint ) ALLOCATE( sf_tsd(jp_tem)%fdta(jpi,jpj,jpk,2) , STAT=ierr1 )
+ ALLOCATE( sf_tsd(jp_sal)%fnow(jpi,jpj,jpk) , STAT=ierr2 )
+ IF( sn_dmps%ln_tint ) ALLOCATE( sf_tsd(jp_sal)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 )
!
IF( ierr0 + ierr1 + ierr2 + ierr3 > 0 ) THEN
CALL ctl_stop( 'dta_tsd : unable to allocate T & S dmp data arrays' ) ; RETURN
@@ -138,14 +138,14 @@ CONTAINS
!
! ! fill sf_tsd with sn_tem & sn_sal and control print
slf_i(jp_tem) = sn_dmpt ; slf_i(jp_sal) = sn_dmps
- CALL fld_fill( sf_tsddmp, slf_i, cn_dir, 'dta_tsd', 'Temperature & Salinity dmp data', 'namtsd', no_print )
+ CALL fld_fill( sf_tsd, slf_i, cn_dir, 'dta_tsd', 'Temperature & Salinity dmp data', 'namtsd', no_print )
!
ENDIF
!
END SUBROUTINE dta_tsd_init
- SUBROUTINE dta_tsd( kt, cddta, ptsd )
+ SUBROUTINE dta_tsd( kt, ptsd, cddta )
!!----------------------------------------------------------------------
!! *** ROUTINE dta_tsd ***
!!
@@ -159,45 +159,43 @@ CONTAINS
!!
!! ** Action : ptsd T-S data on medl mesh and interpolated at time-step kt
!!----------------------------------------------------------------------
- INTEGER , INTENT(in ) :: kt ! ocean time-step
- CHARACTER(LEN=3) , INTENT(in ) :: cddta ! dmp or ini
- REAL(wp), DIMENSION(A2D(nn_hls),jpk,jpts), INTENT( out) :: ptsd ! T & S data
+ INTEGER , INTENT(in ) :: kt ! ocean time-step
+ REAL(wp), DIMENSION(A2D(nn_hls),jpk,jpts), INTENT( out) :: ptsd ! T & S data
+ CHARACTER(len=*), OPTIONAL , INTENT(in ) :: cddta ! force the initialization when tradmp is used
!
INTEGER :: ji, jj, jk, jl, jkk ! dummy loop indicies
INTEGER :: ik, il0, il1, ii0, ii1, ij0, ij1 ! local integers
REAL(wp):: zl, zi ! local scalars
+ LOGICAL :: ll_tsdini
REAL(wp), DIMENSION(jpk) :: ztp, zsp ! 1D workspace
!!----------------------------------------------------------------------
!
+ ll_tsdini = .FALSE.
+ IF( PRESENT(cddta) ) ll_tsdini = .TRUE.
+
IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only for the full domain
IF( ln_tile ) CALL dom_tile_stop( ldhold=.TRUE. ) ! Use full domain
- SELECT CASE(cddta)
- CASE('ini')
+ IF( ll_tsdini ) THEN
CALL fld_read( kt, 1, sf_tsdini ) !== read T & S data at kt time step ==!
- CASE('dmp')
- CALL fld_read( kt, 1, sf_tsddmp ) !== read T & S data at kt time step ==!
- CASE DEFAULT
- CALL ctl_stop('STOP', 'dta_tsd: cddta case unknown')
- END SELECT
+ ELSE
+ CALL fld_read( kt, 1, sf_tsd ) !== read T & S data at kt time step ==!
+ ENDIF
IF( ln_tile ) CALL dom_tile_start( ldhold=.TRUE. ) ! Revert to tile domain
ENDIF
!
- SELECT CASE(cddta)
- CASE('ini')
+ IF( ll_tsdini ) THEN
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
ptsd(ji,jj,jk,jp_tem) = sf_tsdini(jp_tem)%fnow(ji,jj,jk) ! NO mask
ptsd(ji,jj,jk,jp_sal) = sf_tsdini(jp_sal)%fnow(ji,jj,jk)
END_3D
- CASE('dmp')
+ ELSE
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
- ptsd(ji,jj,jk,jp_tem) = sf_tsddmp(jp_tem)%fnow(ji,jj,jk) ! NO mask
- ptsd(ji,jj,jk,jp_sal) = sf_tsddmp(jp_sal)%fnow(ji,jj,jk)
+ ptsd(ji,jj,jk,jp_tem) = sf_tsd(jp_tem)%fnow(ji,jj,jk) ! NO mask
+ ptsd(ji,jj,jk,jp_sal) = sf_tsd(jp_sal)%fnow(ji,jj,jk)
END_3D
- CASE DEFAULT
- CALL ctl_stop('STOP', 'dta_tsd: cddta case unknown')
- END SELECT
+ ENDIF
!
IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==!
!
@@ -261,8 +259,7 @@ CONTAINS
!
ENDIF
!
- SELECT CASE(cddta)
- CASE('ini')
+ IF( ll_tsdini ) THEN
! !== deallocate T & S structure ==!
! (data used only for initialisation)
IF(lwp) WRITE(numout,*) 'dta_tsd: deallocte T & S arrays as they are only use to initialize the run'
@@ -272,7 +269,7 @@ CONTAINS
IF( sf_tsdini(jp_sal)%ln_tint ) DEALLOCATE( sf_tsdini(jp_sal)%fdta )
DEALLOCATE( sf_tsdini ) ! the structure itself
!
- END SELECT
+ ENDIF
!
END SUBROUTINE dta_tsd
diff --git a/tests/ISOMIP+/MY_SRC/eosbn2.F90 b/tests/ISOMIP+/MY_SRC/eosbn2.F90
deleted file mode 100644
index d2da8cfd5976e46e78df5a71aad6279ac86fe21b..0000000000000000000000000000000000000000
--- a/tests/ISOMIP+/MY_SRC/eosbn2.F90
+++ /dev/null
@@ -1,2078 +0,0 @@
-MODULE eosbn2
- !!==============================================================================
- !! *** MODULE eosbn2 ***
- !! Equation Of Seawater : in situ density - Brunt-Vaisala frequency
- !!==============================================================================
- !! History : OPA ! 1989-03 (O. Marti) Original code
- !! 6.0 ! 1994-07 (G. Madec, M. Imbard) add bn2
- !! 6.0 ! 1994-08 (G. Madec) Add Jackett & McDougall eos
- !! 7.0 ! 1996-01 (G. Madec) statement function for e3
- !! 8.1 ! 1997-07 (G. Madec) density instead of volumic mass
- !! - ! 1999-02 (G. Madec, N. Grima) semi-implicit pressure gradient
- !! 8.2 ! 2001-09 (M. Ben Jelloul) bugfix on linear eos
- !! NEMO 1.0 ! 2002-10 (G. Madec) add eos_init
- !! - ! 2002-11 (G. Madec, A. Bozec) partial step, eos_insitu_2d
- !! - ! 2003-08 (G. Madec) F90, free form
- !! 3.0 ! 2006-08 (G. Madec) add tfreez function (now eos_fzp function)
- !! 3.3 ! 2010-05 (C. Ethe, G. Madec) merge TRC-TRA
- !! - ! 2010-10 (G. Nurser, G. Madec) add alpha/beta used in ldfslp
- !! 3.7 ! 2012-03 (F. Roquet, G. Madec) add primitive of alpha and beta used in PE computation
- !! - ! 2012-05 (F. Roquet) add Vallis and original JM95 equation of state
- !! - ! 2013-04 (F. Roquet, G. Madec) add eos_rab, change bn2 computation and reorganize the module
- !! - ! 2014-09 (F. Roquet) add TEOS-10, S-EOS, and modify EOS-80
- !! - ! 2015-06 (P.A. Bouttier) eos_fzp functions changed to subroutines for AGRIF
- !!----------------------------------------------------------------------
-
- !!----------------------------------------------------------------------
- !! eos : generic interface of the equation of state
- !! eos_insitu : Compute the in situ density
- !! eos_insitu_pot: Compute the insitu and surface referenced potential volumic mass
- !! eos_insitu_2d : Compute the in situ density for 2d fields
- !! bn2 : compute the Brunt-Vaisala frequency
- !! eos_pt_from_ct: compute the potential temperature from the Conservative Temperature
- !! eos_rab : generic interface of in situ thermal/haline expansion ratio
- !! eos_rab_3d : compute in situ thermal/haline expansion ratio
- !! eos_rab_2d : compute in situ thermal/haline expansion ratio for 2d fields
- !! eos_fzp_2d : freezing temperature for 2d fields
- !! eos_fzp_0d : freezing temperature for scalar
- !! eos_init : set eos parameters (namelist)
- !!----------------------------------------------------------------------
- USE dom_oce ! ocean space and time domain
- USE domutl, ONLY : is_tile
- USE phycst ! physical constants
- USE stopar ! Stochastic T/S fluctuations
- USE stopts ! Stochastic T/S fluctuations
- !
- USE in_out_manager ! I/O manager
- USE lib_mpp ! MPP library
- USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
- USE prtctl ! Print control
- USE lbclnk ! ocean lateral boundary conditions
- USE timing ! Timing
-
- IMPLICIT NONE
- PRIVATE
-
- ! !! * Interface
- INTERFACE eos
- MODULE PROCEDURE eos_insitu_New, eos_insitu, eos_insitu_pot, eos_insitu_2d, eos_insitu_pot_2d
- END INTERFACE
- !
- INTERFACE eos_rab
- MODULE PROCEDURE rab_3d, rab_2d, rab_0d
- END INTERFACE
- !
- INTERFACE eos_fzp
- MODULE PROCEDURE eos_fzp_2d, eos_fzp_0d
- END INTERFACE
- !
- PUBLIC eos ! called by step, istate, tranpc and zpsgrd modules
- PUBLIC bn2 ! called by step module
- PUBLIC eos_rab ! called by ldfslp, zdfddm, trabbl
- PUBLIC eos_pt_from_ct ! called by sbcssm
- PUBLIC eos_fzp ! called by traadv_cen2 and sbcice_... modules
- PUBLIC eos_pen ! used for pe diagnostics in trdpen module
- PUBLIC eos_init ! called by istate module
-
- ! !!** Namelist nameos **
- LOGICAL , PUBLIC :: ln_TEOS10
- LOGICAL , PUBLIC :: ln_EOS80
- LOGICAL , PUBLIC :: ln_SEOS
- LOGICAL , PUBLIC :: ln_LEOS ! determine if linear eos is used
-
- ! Parameters
- LOGICAL , PUBLIC :: l_useCT ! =T in ln_TEOS10=T (i.e. use eos_pt_from_ct to compute sst_m), =F otherwise
- INTEGER , PUBLIC :: neos ! Identifier for equation of state used
-
- INTEGER , PARAMETER :: np_teos10 = -1 ! parameter for using TEOS10
- INTEGER , PARAMETER :: np_eos80 = 0 ! parameter for using EOS80
- INTEGER , PARAMETER :: np_seos = 1 ! parameter for using Simplified Equation of state
- INTEGER , PARAMETER :: np_leos = 2 ! parameter for using linear equation of state (ISOMIP+)
-
- ! !!! simplified eos coefficients (default value: Vallis 2006)
- REAL(wp), PUBLIC :: rn_a0 = 1.6550e-1_wp ! thermal expansion coeff.
- REAL(wp), PUBLIC :: rn_b0 = 7.6554e-1_wp ! saline expansion coeff.
- REAL(wp) :: rn_lambda1 = 5.9520e-2_wp ! cabbeling coeff. in T^2
- REAL(wp) :: rn_lambda2 = 5.4914e-4_wp ! cabbeling coeff. in S^2
- REAL(wp) :: rn_mu1 = 1.4970e-4_wp ! thermobaric coeff. in T
- REAL(wp) :: rn_mu2 = 1.1090e-5_wp ! thermobaric coeff. in S
- REAL(wp) :: rn_nu = 2.4341e-3_wp ! cabbeling coeff. in theta*salt
-
- ! TEOS10/EOS80 parameters
- REAL(wp) :: r1_S0, r1_T0, r1_Z0, rdeltaS
-
- ! EOS parameters
- REAL(wp) :: EOS000 , EOS100 , EOS200 , EOS300 , EOS400 , EOS500 , EOS600
- REAL(wp) :: EOS010 , EOS110 , EOS210 , EOS310 , EOS410 , EOS510
- REAL(wp) :: EOS020 , EOS120 , EOS220 , EOS320 , EOS420
- REAL(wp) :: EOS030 , EOS130 , EOS230 , EOS330
- REAL(wp) :: EOS040 , EOS140 , EOS240
- REAL(wp) :: EOS050 , EOS150
- REAL(wp) :: EOS060
- REAL(wp) :: EOS001 , EOS101 , EOS201 , EOS301 , EOS401
- REAL(wp) :: EOS011 , EOS111 , EOS211 , EOS311
- REAL(wp) :: EOS021 , EOS121 , EOS221
- REAL(wp) :: EOS031 , EOS131
- REAL(wp) :: EOS041
- REAL(wp) :: EOS002 , EOS102 , EOS202
- REAL(wp) :: EOS012 , EOS112
- REAL(wp) :: EOS022
- REAL(wp) :: EOS003 , EOS103
- REAL(wp) :: EOS013
-
- ! ALPHA parameters
- REAL(wp) :: ALP000 , ALP100 , ALP200 , ALP300 , ALP400 , ALP500
- REAL(wp) :: ALP010 , ALP110 , ALP210 , ALP310 , ALP410
- REAL(wp) :: ALP020 , ALP120 , ALP220 , ALP320
- REAL(wp) :: ALP030 , ALP130 , ALP230
- REAL(wp) :: ALP040 , ALP140
- REAL(wp) :: ALP050
- REAL(wp) :: ALP001 , ALP101 , ALP201 , ALP301
- REAL(wp) :: ALP011 , ALP111 , ALP211
- REAL(wp) :: ALP021 , ALP121
- REAL(wp) :: ALP031
- REAL(wp) :: ALP002 , ALP102
- REAL(wp) :: ALP012
- REAL(wp) :: ALP003
-
- ! BETA parameters
- REAL(wp) :: BET000 , BET100 , BET200 , BET300 , BET400 , BET500
- REAL(wp) :: BET010 , BET110 , BET210 , BET310 , BET410
- REAL(wp) :: BET020 , BET120 , BET220 , BET320
- REAL(wp) :: BET030 , BET130 , BET230
- REAL(wp) :: BET040 , BET140
- REAL(wp) :: BET050
- REAL(wp) :: BET001 , BET101 , BET201 , BET301
- REAL(wp) :: BET011 , BET111 , BET211
- REAL(wp) :: BET021 , BET121
- REAL(wp) :: BET031
- REAL(wp) :: BET002 , BET102
- REAL(wp) :: BET012
- REAL(wp) :: BET003
-
- ! PEN parameters
- REAL(wp) :: PEN000 , PEN100 , PEN200 , PEN300 , PEN400
- REAL(wp) :: PEN010 , PEN110 , PEN210 , PEN310
- REAL(wp) :: PEN020 , PEN120 , PEN220
- REAL(wp) :: PEN030 , PEN130
- REAL(wp) :: PEN040
- REAL(wp) :: PEN001 , PEN101 , PEN201
- REAL(wp) :: PEN011 , PEN111
- REAL(wp) :: PEN021
- REAL(wp) :: PEN002 , PEN102
- REAL(wp) :: PEN012
-
- ! ALPHA_PEN parameters
- REAL(wp) :: APE000 , APE100 , APE200 , APE300
- REAL(wp) :: APE010 , APE110 , APE210
- REAL(wp) :: APE020 , APE120
- REAL(wp) :: APE030
- REAL(wp) :: APE001 , APE101
- REAL(wp) :: APE011
- REAL(wp) :: APE002
-
- ! BETA_PEN parameters
- REAL(wp) :: BPE000 , BPE100 , BPE200 , BPE300
- REAL(wp) :: BPE010 , BPE110 , BPE210
- REAL(wp) :: BPE020 , BPE120
- REAL(wp) :: BPE030
- REAL(wp) :: BPE001 , BPE101
- REAL(wp) :: BPE011
- REAL(wp) :: BPE002
-
- !! * Substitutions
-# include "do_loop_substitute.h90"
-# include "domzgr_substitute.h90"
- !!----------------------------------------------------------------------
- !! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: eosbn2.F90 10425 2018-12-19 21:54:16Z smasson $
- !! Software governed by the CeCILL license (see ./LICENSE)
- !!----------------------------------------------------------------------
-CONTAINS
-
- SUBROUTINE eos_insitu_New( pts, Knn, prd )
- !!----------------------------------------------------------------------
- !! *** ROUTINE eos_insitu_New ***
- !!
- !! ** Purpose : Compute the in situ density (ratio rho/rho0) from
- !! potential temperature and salinity using an equation of state
- !! selected in the nameos namelist
- !!
- !! ** Method : prd(t,s,z) = ( rho(t,s,z) - rho0 ) / rho0
- !! with prd in situ density anomaly no units
- !! t TEOS10: CT or EOS80: PT Celsius
- !! s TEOS10: SA or EOS80: SP TEOS10: g/kg or EOS80: psu
- !! z depth meters
- !! rho in situ density kg/m^3
- !! rho0 reference density kg/m^3
- !!
- !! ln_teos10 : polynomial TEOS-10 equation of state is used for rho(t,s,z).
- !! Check value: rho = 1028.21993233072 kg/m^3 for z=3000 dbar, ct=3 Celsius, sa=35.5 g/kg
- !!
- !! ln_eos80 : polynomial EOS-80 equation of state is used for rho(t,s,z).
- !! Check value: rho = 1028.35011066567 kg/m^3 for z=3000 dbar, pt=3 Celsius, sp=35.5 psu
- !!
- !! ln_seos : simplified equation of state
- !! prd(t,s,z) = ( -a0*(1+lambda/2*(T-T0)+mu*z+nu*(S-S0))*(T-T0) + b0*(S-S0) ) / rho0
- !! linear case function of T only: rn_alpha<>0, other coefficients = 0
- !! linear eos function of T and S: rn_alpha and rn_beta<>0, other coefficients=0
- !! Vallis like equation: use default values of coefficients
- !!
- !! ln_leos : linear ISOMIP equation of state
- !! prd(t,s,z) = ( -a0*(T-T0) + b0*(S-S0) ) / rho0
- !! setup for ISOMIP linear eos
- !!
- !! ** Action : compute prd , the in situ density (no units)
- !!
- !! References : Roquet et al, Ocean Modelling, in preparation (2014)
- !! Vallis, Atmospheric and Oceanic Fluid Dynamics, 2006
- !! TEOS-10 Manual, 2010
- !!----------------------------------------------------------------------
- REAL(wp), DIMENSION(:,:,:,:,:), INTENT(in ) :: pts ! T-S
- INTEGER , INTENT(in ) :: Knn ! time-level
- REAL(wp), DIMENSION(:,:,: ), INTENT( out) :: prd ! in situ density
- !
- INTEGER :: ji, jj, jk ! dummy loop indices
- REAL(wp) :: zt , zh , zs , ztm ! local scalars
- REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - -
- !!----------------------------------------------------------------------
- !
- IF( ln_timing ) CALL timing_start('eos-insitu')
- !
- SELECT CASE( neos )
- !
- CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==!
- !
- DO_3D(nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
- !
- zh = gdept(ji,jj,jk,Knn) * r1_Z0 ! depth
- zt = pts (ji,jj,jk,jp_tem,Knn) * r1_T0 ! temperature
- zs = SQRT( ABS( pts(ji,jj,jk,jp_sal,Knn) + rdeltaS ) * r1_S0 ) ! square root salinity
- ztm = tmask(ji,jj,jk) ! tmask
- !
- zn3 = EOS013*zt &
- & + EOS103*zs+EOS003
- !
- zn2 = (EOS022*zt &
- & + EOS112*zs+EOS012)*zt &
- & + (EOS202*zs+EOS102)*zs+EOS002
- !
- zn1 = (((EOS041*zt &
- & + EOS131*zs+EOS031)*zt &
- & + (EOS221*zs+EOS121)*zs+EOS021)*zt &
- & + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt &
- & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001
- !
- zn0 = (((((EOS060*zt &
- & + EOS150*zs+EOS050)*zt &
- & + (EOS240*zs+EOS140)*zs+EOS040)*zt &
- & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt &
- & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt &
- & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt &
- & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000
- !
- zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
- !
- prd(ji,jj,jk) = ( zn * r1_rho0 - 1._wp ) * ztm ! density anomaly (masked)
- !
- END_3D
- !
- CASE( np_seos ) !== simplified EOS ==!
- !
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
- zt = pts (ji,jj,jk,jp_tem,Knn) - 10._wp
- zs = pts (ji,jj,jk,jp_sal,Knn) - 35._wp
- zh = gdept(ji,jj,jk,Knn)
- ztm = tmask(ji,jj,jk)
- !
- zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt &
- & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs &
- & - rn_nu * zt * zs
- !
- prd(ji,jj,jk) = zn * r1_rho0 * ztm ! density anomaly (masked)
- END_3D
- !
- CASE( np_leos ) !== linear ISOMIP EOS ==!
- !
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
- zt = pts (ji,jj,jk,jp_tem,Knn) - (-1._wp)
- zs = pts (ji,jj,jk,jp_sal,Knn) - 34.2_wp
- zh = gdept(ji,jj,jk, Knn)
- ztm = tmask(ji,jj,jk)
- !
- zn = rho0 * ( - rn_a0 * zt + rn_b0 * zs )
- !
- prd(ji,jj,jk) = zn * r1_rho0 * ztm ! density anomaly (masked)
- END_3D
- !
- END SELECT
- !
- IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-insitu : ', kdim=jpk )
- !
- IF( ln_timing ) CALL timing_stop('eos-insitu')
- !
- END SUBROUTINE eos_insitu_New
-
-
- SUBROUTINE eos_insitu( pts, prd, pdep )
- !!
- REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celsius]
- ! ! 2 : salinity [psu]
- REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: prd ! in situ density [-]
- REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pdep ! depth [m]
- !!
- CALL eos_insitu_t( pts, is_tile(pts), prd, is_tile(prd), pdep, is_tile(pdep) )
- END SUBROUTINE eos_insitu
-
- SUBROUTINE eos_insitu_t( pts, ktts, prd, ktrd, pdep, ktdep )
- !!----------------------------------------------------------------------
- !! *** ROUTINE eos_insitu ***
- !!
- !! ** Purpose : Compute the in situ density (ratio rho/rho0) from
- !! potential temperature and salinity using an equation of state
- !! selected in the nameos namelist
- !!
- !! ** Method : prd(t,s,z) = ( rho(t,s,z) - rho0 ) / rho0
- !! with prd in situ density anomaly no units
- !! t TEOS10: CT or EOS80: PT Celsius
- !! s TEOS10: SA or EOS80: SP TEOS10: g/kg or EOS80: psu
- !! z depth meters
- !! rho in situ density kg/m^3
- !! rho0 reference density kg/m^3
- !!
- !! ln_teos10 : polynomial TEOS-10 equation of state is used for rho(t,s,z).
- !! Check value: rho = 1028.21993233072 kg/m^3 for z=3000 dbar, ct=3 Celsius, sa=35.5 g/kg
- !!
- !! ln_eos80 : polynomial EOS-80 equation of state is used for rho(t,s,z).
- !! Check value: rho = 1028.35011066567 kg/m^3 for z=3000 dbar, pt=3 Celsius, sp=35.5 psu
- !!
- !! ln_seos : simplified equation of state
- !! prd(t,s,z) = ( -a0*(1+lambda/2*(T-T0)+mu*z+nu*(S-S0))*(T-T0) + b0*(S-S0) ) / rho0
- !! linear case function of T only: rn_alpha<>0, other coefficients = 0
- !! linear eos function of T and S: rn_alpha and rn_beta<>0, other coefficients=0
- !! Vallis like equation: use default values of coefficients
- !!
- !! ln_leos : linear ISOMIP equation of state
- !! prd(t,s,z) = ( -a0*(T-T0) + b0*(S-S0) ) / rho0
- !! setup for ISOMIP linear eos
- !!
- !! ** Action : compute prd , the in situ density (no units)
- !!
- !! References : Roquet et al, Ocean Modelling, in preparation (2014)
- !! Vallis, Atmospheric and Oceanic Fluid Dynamics, 2006
- !! TEOS-10 Manual, 2010
- !!----------------------------------------------------------------------
- INTEGER , INTENT(in ) :: ktts, ktrd, ktdep
- REAL(wp), DIMENSION(A2D_T(ktts) ,JPK,JPTS), INTENT(in ) :: pts ! 1 : potential temperature [Celsius]
- ! ! 2 : salinity [psu]
- REAL(wp), DIMENSION(A2D_T(ktrd) ,JPK ), INTENT( out) :: prd ! in situ density [-]
- REAL(wp), DIMENSION(A2D_T(ktdep),JPK ), INTENT(in ) :: pdep ! depth [m]
- !
- INTEGER :: ji, jj, jk ! dummy loop indices
- REAL(wp) :: zt , zh , zs , ztm ! local scalars
- REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - -
- !!----------------------------------------------------------------------
- !
- IF( ln_timing ) CALL timing_start('eos-insitu')
- !
- SELECT CASE( neos )
- !
- CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==!
- !
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
- !
- zh = pdep(ji,jj,jk) * r1_Z0 ! depth
- zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature
- zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity
- ztm = tmask(ji,jj,jk) ! tmask
- !
- zn3 = EOS013*zt &
- & + EOS103*zs+EOS003
- !
- zn2 = (EOS022*zt &
- & + EOS112*zs+EOS012)*zt &
- & + (EOS202*zs+EOS102)*zs+EOS002
- !
- zn1 = (((EOS041*zt &
- & + EOS131*zs+EOS031)*zt &
- & + (EOS221*zs+EOS121)*zs+EOS021)*zt &
- & + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt &
- & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001
- !
- zn0 = (((((EOS060*zt &
- & + EOS150*zs+EOS050)*zt &
- & + (EOS240*zs+EOS140)*zs+EOS040)*zt &
- & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt &
- & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt &
- & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt &
- & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000
- !
- zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
- !
- prd(ji,jj,jk) = ( zn * r1_rho0 - 1._wp ) * ztm ! density anomaly (masked)
- !
- END_3D
- !
- CASE( np_seos ) !== simplified EOS ==!
- !
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
- zt = pts (ji,jj,jk,jp_tem) - 10._wp
- zs = pts (ji,jj,jk,jp_sal) - 35._wp
- zh = pdep (ji,jj,jk)
- ztm = tmask(ji,jj,jk)
- !
- zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt &
- & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs &
- & - rn_nu * zt * zs
- !
- prd(ji,jj,jk) = zn * r1_rho0 * ztm ! density anomaly (masked)
- END_3D
- !
- CASE( np_leos ) !== linear ISOMIP EOS ==!
- !
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
- zt = pts (ji,jj,jk,jp_tem) - (-1._wp)
- zs = pts (ji,jj,jk,jp_sal) - 34.2_wp
- zh = pdep (ji,jj,jk)
- ztm = tmask(ji,jj,jk)
- !
- zn = rho0 * ( - rn_a0 * zt + rn_b0 * zs )
- !
- prd(ji,jj,jk) = zn * r1_rho0 * ztm ! density anomaly (masked)
- END_3D
- !
- END SELECT
- !
- IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-insitu : ', kdim=jpk )
- !
- IF( ln_timing ) CALL timing_stop('eos-insitu')
- !
- END SUBROUTINE eos_insitu_t
-
-
- SUBROUTINE eos_insitu_pot( pts, prd, prhop, pdep )
- !!
- REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celsius]
- ! ! 2 : salinity [psu]
- REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: prd ! in situ density [-]
- REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: prhop ! potential density (surface referenced)
- REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pdep ! depth [m]
- !!
- CALL eos_insitu_pot_t( pts, is_tile(pts), prd, is_tile(prd), prhop, is_tile(prhop), pdep, is_tile(pdep) )
- END SUBROUTINE eos_insitu_pot
-
-
- SUBROUTINE eos_insitu_pot_t( pts, ktts, prd, ktrd, prhop, ktrhop, pdep, ktdep )
- !!----------------------------------------------------------------------
- !! *** ROUTINE eos_insitu_pot ***
- !!
- !! ** Purpose : Compute the in situ density (ratio rho/rho0) and the
- !! potential volumic mass (Kg/m3) from potential temperature and
- !! salinity fields using an equation of state selected in the
- !! namelist.
- !!
- !! ** Action : - prd , the in situ density (no units)
- !! - prhop, the potential volumic mass (Kg/m3)
- !!
- !!----------------------------------------------------------------------
- INTEGER , INTENT(in ) :: ktts, ktrd, ktrhop, ktdep
- REAL(wp), DIMENSION(A2D_T(ktts) ,JPK,JPTS), INTENT(in ) :: pts ! 1 : potential temperature [Celsius]
- ! ! 2 : salinity [psu]
- REAL(wp), DIMENSION(A2D_T(ktrd) ,JPK ), INTENT( out) :: prd ! in situ density [-]
- REAL(wp), DIMENSION(A2D_T(ktrhop),JPK ), INTENT( out) :: prhop ! potential density (surface referenced)
- REAL(wp), DIMENSION(A2D_T(ktdep) ,JPK ), INTENT(in ) :: pdep ! depth [m]
- !
- INTEGER :: ji, jj, jk, jsmp ! dummy loop indices
- INTEGER :: jdof
- REAL(wp) :: zt , zh , zstemp, zs , ztm ! local scalars
- REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - -
- REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign ! local vectors
- !!----------------------------------------------------------------------
- !
- IF( ln_timing ) CALL timing_start('eos-pot')
- !
- SELECT CASE ( neos )
- !
- CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==!
- !
- ! Stochastic equation of state
- IF ( ln_sto_eos ) THEN
- ALLOCATE(zn0_sto(1:2*nn_sto_eos))
- ALLOCATE(zn_sto(1:2*nn_sto_eos))
- ALLOCATE(zsign(1:2*nn_sto_eos))
- DO jsmp = 1, 2*nn_sto_eos, 2
- zsign(jsmp) = 1._wp
- zsign(jsmp+1) = -1._wp
- END DO
- !
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
- !
- ! compute density (2*nn_sto_eos) times:
- ! (1) for t+dt, s+ds (with the random TS fluctutation computed in sto_pts)
- ! (2) for t-dt, s-ds (with the opposite fluctuation)
- DO jsmp = 1, nn_sto_eos*2
- jdof = (jsmp + 1) / 2
- zh = pdep(ji,jj,jk) * r1_Z0 ! depth
- zt = (pts (ji,jj,jk,jp_tem) + pts_ran(ji,jj,jk,jp_tem,jdof) * zsign(jsmp)) * r1_T0 ! temperature
- zstemp = pts (ji,jj,jk,jp_sal) + pts_ran(ji,jj,jk,jp_sal,jdof) * zsign(jsmp)
- zs = SQRT( ABS( zstemp + rdeltaS ) * r1_S0 ) ! square root salinity
- ztm = tmask(ji,jj,jk) ! tmask
- !
- zn3 = EOS013*zt &
- & + EOS103*zs+EOS003
- !
- zn2 = (EOS022*zt &
- & + EOS112*zs+EOS012)*zt &
- & + (EOS202*zs+EOS102)*zs+EOS002
- !
- zn1 = (((EOS041*zt &
- & + EOS131*zs+EOS031)*zt &
- & + (EOS221*zs+EOS121)*zs+EOS021)*zt &
- & + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt &
- & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001
- !
- zn0_sto(jsmp) = (((((EOS060*zt &
- & + EOS150*zs+EOS050)*zt &
- & + (EOS240*zs+EOS140)*zs+EOS040)*zt &
- & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt &
- & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt &
- & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt &
- & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000
- !
- zn_sto(jsmp) = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0_sto(jsmp)
- END DO
- !
- ! compute stochastic density as the mean of the (2*nn_sto_eos) densities
- prhop(ji,jj,jk) = 0._wp ; prd(ji,jj,jk) = 0._wp
- DO jsmp = 1, nn_sto_eos*2
- prhop(ji,jj,jk) = prhop(ji,jj,jk) + zn0_sto(jsmp) ! potential density referenced at the surface
- !
- prd(ji,jj,jk) = prd(ji,jj,jk) + ( zn_sto(jsmp) * r1_rho0 - 1._wp ) ! density anomaly (masked)
- END DO
- prhop(ji,jj,jk) = 0.5_wp * prhop(ji,jj,jk) * ztm / nn_sto_eos
- prd (ji,jj,jk) = 0.5_wp * prd (ji,jj,jk) * ztm / nn_sto_eos
- END_3D
- DEALLOCATE(zn0_sto,zn_sto,zsign)
- ! Non-stochastic equation of state
- ELSE
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
- !
- zh = pdep(ji,jj,jk) * r1_Z0 ! depth
- zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature
- zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity
- ztm = tmask(ji,jj,jk) ! tmask
- !
- zn3 = EOS013*zt &
- & + EOS103*zs+EOS003
- !
- zn2 = (EOS022*zt &
- & + EOS112*zs+EOS012)*zt &
- & + (EOS202*zs+EOS102)*zs+EOS002
- !
- zn1 = (((EOS041*zt &
- & + EOS131*zs+EOS031)*zt &
- & + (EOS221*zs+EOS121)*zs+EOS021)*zt &
- & + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt &
- & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001
- !
- zn0 = (((((EOS060*zt &
- & + EOS150*zs+EOS050)*zt &
- & + (EOS240*zs+EOS140)*zs+EOS040)*zt &
- & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt &
- & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt &
- & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt &
- & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000
- !
- zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
- !
- prhop(ji,jj,jk) = zn0 * ztm ! potential density referenced at the surface
- !
- prd(ji,jj,jk) = ( zn * r1_rho0 - 1._wp ) * ztm ! density anomaly (masked)
- END_3D
- ENDIF
-
- CASE( np_seos ) !== simplified EOS ==!
- !
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
- zt = pts (ji,jj,jk,jp_tem) - 10._wp
- zs = pts (ji,jj,jk,jp_sal) - 35._wp
- zh = pdep (ji,jj,jk)
- ztm = tmask(ji,jj,jk)
- ! ! potential density referenced at the surface
- zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt &
- & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs &
- & - rn_nu * zt * zs
- prhop(ji,jj,jk) = ( rho0 + zn ) * ztm
- ! ! density anomaly (masked)
- zn = zn - ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zh
- prd(ji,jj,jk) = zn * r1_rho0 * ztm
- !
- END_3D
- !
- CASE( np_leos ) !== linear ISOMIP EOS ==!
- !
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
- zt = pts (ji,jj,jk,jp_tem) - (-1._wp)
- zs = pts (ji,jj,jk,jp_sal) - 34.2_wp
- zh = pdep (ji,jj,jk)
- ztm = tmask(ji,jj,jk)
- ! ! potential density referenced at the surface
- zn = rho0 * ( - rn_a0 * zt + rn_b0 * zs )
- prhop(ji,jj,jk) = ( rho0 + zn ) * ztm
- ! ! density anomaly (masked)
- prd(ji,jj,jk) = zn * r1_rho0 * ztm
- !
- END_3D
- !
- END SELECT
- !
- IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', &
- & tab3d_2=prhop, clinfo2=' pot : ', kdim=jpk )
- !
- IF( ln_timing ) CALL timing_stop('eos-pot')
- !
- END SUBROUTINE eos_insitu_pot_t
-
-
- SUBROUTINE eos_insitu_2d( pts, pdep, prd )
- !!
- REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celsius]
- ! ! 2 : salinity [psu]
- REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pdep ! depth [m]
- REAL(wp), DIMENSION(:,:) , INTENT( out) :: prd ! in situ density
- !!
- CALL eos_insitu_2d_t( pts, is_tile(pts), pdep, is_tile(pdep), prd, is_tile(prd) )
- END SUBROUTINE eos_insitu_2d
-
-
- SUBROUTINE eos_insitu_2d_t( pts, ktts, pdep, ktdep, prd, ktrd )
- !!----------------------------------------------------------------------
- !! *** ROUTINE eos_insitu_2d ***
- !!
- !! ** Purpose : Compute the in situ density (ratio rho/rho0) from
- !! potential temperature and salinity using an equation of state
- !! selected in the nameos namelist. * 2D field case
- !!
- !! ** Action : - prd , the in situ density (no units) (unmasked)
- !!
- !!----------------------------------------------------------------------
- INTEGER , INTENT(in ) :: ktts, ktdep, ktrd
- REAL(wp), DIMENSION(A2D_T(ktts),JPTS), INTENT(in ) :: pts ! 1 : potential temperature [Celsius]
- ! ! 2 : salinity [psu]
- REAL(wp), DIMENSION(A2D_T(ktdep) ), INTENT(in ) :: pdep ! depth [m]
- REAL(wp), DIMENSION(A2D_T(ktrd) ), INTENT( out) :: prd ! in situ density
- !
- INTEGER :: ji, jj, jk ! dummy loop indices
- REAL(wp) :: zt , zh , zs ! local scalars
- REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - -
- !!----------------------------------------------------------------------
- !
- IF( ln_timing ) CALL timing_start('eos2d')
- !
- prd(:,:) = 0._wp
- !
- SELECT CASE( neos )
- !
- CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==!
- !
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- !
- zh = pdep(ji,jj) * r1_Z0 ! depth
- zt = pts (ji,jj,jp_tem) * r1_T0 ! temperature
- zs = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity
- !
- zn3 = EOS013*zt &
- & + EOS103*zs+EOS003
- !
- zn2 = (EOS022*zt &
- & + EOS112*zs+EOS012)*zt &
- & + (EOS202*zs+EOS102)*zs+EOS002
- !
- zn1 = (((EOS041*zt &
- & + EOS131*zs+EOS031)*zt &
- & + (EOS221*zs+EOS121)*zs+EOS021)*zt &
- & + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt &
- & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001
- !
- zn0 = (((((EOS060*zt &
- & + EOS150*zs+EOS050)*zt &
- & + (EOS240*zs+EOS140)*zs+EOS040)*zt &
- & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt &
- & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt &
- & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt &
- & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000
- !
- zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
- !
- prd(ji,jj) = zn * r1_rho0 - 1._wp ! unmasked in situ density anomaly
- !
- END_2D
- !
- CASE( np_seos ) !== simplified EOS ==!
- !
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- !
- zt = pts (ji,jj,jp_tem) - 10._wp
- zs = pts (ji,jj,jp_sal) - 35._wp
- zh = pdep (ji,jj) ! depth at the partial step level
- !
- zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt &
- & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs &
- & - rn_nu * zt * zs
- !
- prd(ji,jj) = zn * r1_rho0 ! unmasked in situ density anomaly
- !
- END_2D
- !
- CASE( np_leos ) !== ISOMIP EOS ==!
- !
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- !
- zt = pts (ji,jj,jp_tem) - (-1._wp)
- zs = pts (ji,jj,jp_sal) - 34.2_wp
- zh = pdep (ji,jj) ! depth at the partial step level
- !
- zn = rho0 * ( - rn_a0 * zt + rn_b0 * zs )
- !
- prd(ji,jj) = zn * r1_rho0 ! unmasked in situ density anomaly
- !
- END_2D
- !
- !
- END SELECT
- !
- IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' )
- !
- IF( ln_timing ) CALL timing_stop('eos2d')
- !
- END SUBROUTINE eos_insitu_2d_t
-
-
- SUBROUTINE eos_insitu_pot_2d( pts, prhop )
- !!
- REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celsius]
- ! ! 2 : salinity [psu]
- REAL(wp), DIMENSION(:,:) , INTENT( out) :: prhop ! potential density (surface referenced)
- !!
- CALL eos_insitu_pot_2d_t( pts, is_tile(pts), prhop, is_tile(prhop) )
- END SUBROUTINE eos_insitu_pot_2d
-
-
- SUBROUTINE eos_insitu_pot_2d_t( pts, ktts, prhop, ktrhop )
- !!----------------------------------------------------------------------
- !! *** ROUTINE eos_insitu_pot ***
- !!
- !! ** Purpose : Compute the in situ density (ratio rho/rho0) and the
- !! potential volumic mass (Kg/m3) from potential temperature and
- !! salinity fields using an equation of state selected in the
- !! namelist.
- !!
- !! ** Action :
- !! - prhop, the potential volumic mass (Kg/m3)
- !!
- !!----------------------------------------------------------------------
- INTEGER , INTENT(in ) :: ktts, ktrhop
- REAL(wp), DIMENSION(A2D_T(ktts),JPTS), INTENT(in ) :: pts ! 1 : potential temperature [Celsius]
- ! ! 2 : salinity [psu]
- REAL(wp), DIMENSION(A2D_T(ktrhop) ), INTENT( out) :: prhop ! potential density (surface referenced)
- !
- INTEGER :: ji, jj, jk, jsmp ! dummy loop indices
- INTEGER :: jdof
- REAL(wp) :: zt , zh , zstemp, zs , ztm ! local scalars
- REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - -
- REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign ! local vectors
- !!----------------------------------------------------------------------
- !
- IF( ln_timing ) CALL timing_start('eos-pot')
- !
- SELECT CASE ( neos )
- !
- CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==!
- !
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- !
- zt = pts (ji,jj,jp_tem) * r1_T0 ! temperature
- zs = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity
- ztm = tmask(ji,jj,1) ! tmask
- !
- zn0 = (((((EOS060*zt &
- & + EOS150*zs+EOS050)*zt &
- & + (EOS240*zs+EOS140)*zs+EOS040)*zt &
- & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt &
- & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt &
- & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt &
- & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000
- !
- !
- prhop(ji,jj) = zn0 * ztm ! potential density referenced at the surface
- !
- END_2D
-
- CASE( np_seos ) !== simplified EOS ==!
- !
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- zt = pts (ji,jj,jp_tem) - 10._wp
- zs = pts (ji,jj,jp_sal) - 35._wp
- ztm = tmask(ji,jj,1)
- ! ! potential density referenced at the surface
- zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt &
- & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs &
- & - rn_nu * zt * zs
- prhop(ji,jj) = ( rho0 + zn ) * ztm
- !
- END_2D
- !
- CASE( np_leos ) !== ISOMIP EOS ==!
- !
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- !
- zt = pts (ji,jj,jp_tem) - (-1._wp)
- zs = pts (ji,jj,jp_sal) - 34.2_wp
- !zh = pdep (ji,jj) ! depth at the partial step level
- !
- zn = rho0 * ( - rn_a0 * zt + rn_b0 * zs )
- !
- prhop(ji,jj) = zn * r1_rho0 ! unmasked in situ density anomaly
- !
- END_2D
- !
- END SELECT
- IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=prhop, clinfo1=' pot: ', kdim=1 )
- !
- IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=prhop, clinfo1=' eos-pot: ' )
- !
- IF( ln_timing ) CALL timing_stop('eos-pot')
- !
- END SUBROUTINE eos_insitu_pot_2d_t
-
-
- SUBROUTINE rab_3d( pts, pab, Kmm )
- !!
- INTEGER , INTENT(in ) :: Kmm ! time level index
- REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! pot. temperature & salinity
- REAL(wp), DIMENSION(:,:,:,:), INTENT( out) :: pab ! thermal/haline expansion ratio
- !!
- CALL rab_3d_t( pts, is_tile(pts), pab, is_tile(pab), Kmm )
- END SUBROUTINE rab_3d
-
-
- SUBROUTINE rab_3d_t( pts, ktts, pab, ktab, Kmm )
- !!----------------------------------------------------------------------
- !! *** ROUTINE rab_3d ***
- !!
- !! ** Purpose : Calculates thermal/haline expansion ratio at T-points
- !!
- !! ** Method : calculates alpha / beta at T-points
- !!
- !! ** Action : - pab : thermal/haline expansion ratio at T-points
- !!----------------------------------------------------------------------
- INTEGER , INTENT(in ) :: Kmm ! time level index
- INTEGER , INTENT(in ) :: ktts, ktab
- REAL(wp), DIMENSION(A2D_T(ktts),JPK,JPTS), INTENT(in ) :: pts ! pot. temperature & salinity
- REAL(wp), DIMENSION(A2D_T(ktab),JPK,JPTS), INTENT( out) :: pab ! thermal/haline expansion ratio
- !
- INTEGER :: ji, jj, jk ! dummy loop indices
- REAL(wp) :: zt , zh , zs , ztm ! local scalars
- REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - -
- !!----------------------------------------------------------------------
- !
- IF( ln_timing ) CALL timing_start('rab_3d')
- !
- SELECT CASE ( neos )
- !
- CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==!
- !
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
- !
- zh = gdept(ji,jj,jk,Kmm) * r1_Z0 ! depth
- zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature
- zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity
- ztm = tmask(ji,jj,jk) ! tmask
- !
- ! alpha
- zn3 = ALP003
- !
- zn2 = ALP012*zt + ALP102*zs+ALP002
- !
- zn1 = ((ALP031*zt &
- & + ALP121*zs+ALP021)*zt &
- & + (ALP211*zs+ALP111)*zs+ALP011)*zt &
- & + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001
- !
- zn0 = ((((ALP050*zt &
- & + ALP140*zs+ALP040)*zt &
- & + (ALP230*zs+ALP130)*zs+ALP030)*zt &
- & + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt &
- & + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt &
- & + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000
- !
- zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
- !
- pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm
- !
- ! beta
- zn3 = BET003
- !
- zn2 = BET012*zt + BET102*zs+BET002
- !
- zn1 = ((BET031*zt &
- & + BET121*zs+BET021)*zt &
- & + (BET211*zs+BET111)*zs+BET011)*zt &
- & + ((BET301*zs+BET201)*zs+BET101)*zs+BET001
- !
- zn0 = ((((BET050*zt &
- & + BET140*zs+BET040)*zt &
- & + (BET230*zs+BET130)*zs+BET030)*zt &
- & + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt &
- & + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt &
- & + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000
- !
- zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
- !
- pab(ji,jj,jk,jp_sal) = zn / zs * r1_rho0 * ztm
- !
- END_3D
- !
- CASE( np_seos ) !== simplified EOS ==!
- !
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
- zt = pts (ji,jj,jk,jp_tem) - 10._wp ! pot. temperature anomaly (t-T0)
- zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0)
- zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point
- ztm = tmask(ji,jj,jk) ! land/sea bottom mask = surf. mask
- !
- zn = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs
- pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm ! alpha
- !
- zn = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt
- pab(ji,jj,jk,jp_sal) = zn * r1_rho0 * ztm ! beta
- !
- END_3D
- !
- CASE( np_leos ) !== linear ISOMIP EOS ==!
- !
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
- zt = pts (ji,jj,jk,jp_tem) - (-1._wp)
- zs = pts (ji,jj,jk,jp_sal) - 34.2_wp ! abs. salinity anomaly (s-S0)
- zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point
- ztm = tmask(ji,jj,jk) ! land/sea bottom mask = surf. mask
- !
- zn = rn_a0 * rho0
- pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm ! alpha
- !
- zn = rn_b0 * rho0
- pab(ji,jj,jk,jp_sal) = zn * r1_rho0 * ztm ! beta
- !
- END_3D
- !
- CASE DEFAULT
- WRITE(ctmp1,*) ' bad flag value for neos = ', neos
- CALL ctl_stop( 'rab_3d:', ctmp1 )
- !
- END SELECT
- !
- IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pab(:,:,:,jp_tem), clinfo1=' rab_3d_t: ', &
- & tab3d_2=pab(:,:,:,jp_sal), clinfo2=' rab_3d_s : ', kdim=jpk )
- !
- IF( ln_timing ) CALL timing_stop('rab_3d')
- !
- END SUBROUTINE rab_3d_t
-
-
- SUBROUTINE rab_2d( pts, pdep, pab, Kmm )
- !!
- INTEGER , INTENT(in ) :: Kmm ! time level index
- REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pts ! pot. temperature & salinity
- REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pdep ! depth [m]
- REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pab ! thermal/haline expansion ratio
- !!
- CALL rab_2d_t(pts, is_tile(pts), pdep, is_tile(pdep), pab, is_tile(pab), Kmm)
- END SUBROUTINE rab_2d
-
-
- SUBROUTINE rab_2d_t( pts, ktts, pdep, ktdep, pab, ktab, Kmm )
- !!----------------------------------------------------------------------
- !! *** ROUTINE rab_2d ***
- !!
- !! ** Purpose : Calculates thermal/haline expansion ratio for a 2d field (unmasked)
- !!
- !! ** Action : - pab : thermal/haline expansion ratio at T-points
- !!----------------------------------------------------------------------
- INTEGER , INTENT(in ) :: Kmm ! time level index
- INTEGER , INTENT(in ) :: ktts, ktdep, ktab
- REAL(wp), DIMENSION(A2D_T(ktts),JPTS), INTENT(in ) :: pts ! pot. temperature & salinity
- REAL(wp), DIMENSION(A2D_T(ktdep) ), INTENT(in ) :: pdep ! depth [m]
- REAL(wp), DIMENSION(A2D_T(ktab),JPTS), INTENT( out) :: pab ! thermal/haline expansion ratio
- !
- INTEGER :: ji, jj, jk ! dummy loop indices
- REAL(wp) :: zt , zh , zs ! local scalars
- REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - -
- !!----------------------------------------------------------------------
- !
- IF( ln_timing ) CALL timing_start('rab_2d')
- !
- pab(:,:,:) = 0._wp
- !
- SELECT CASE ( neos )
- !
- CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==!
- !
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- !
- zh = pdep(ji,jj) * r1_Z0 ! depth
- zt = pts (ji,jj,jp_tem) * r1_T0 ! temperature
- zs = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity
- !
- ! alpha
- zn3 = ALP003
- !
- zn2 = ALP012*zt + ALP102*zs+ALP002
- !
- zn1 = ((ALP031*zt &
- & + ALP121*zs+ALP021)*zt &
- & + (ALP211*zs+ALP111)*zs+ALP011)*zt &
- & + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001
- !
- zn0 = ((((ALP050*zt &
- & + ALP140*zs+ALP040)*zt &
- & + (ALP230*zs+ALP130)*zs+ALP030)*zt &
- & + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt &
- & + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt &
- & + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000
- !
- zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
- !
- pab(ji,jj,jp_tem) = zn * r1_rho0
- !
- ! beta
- zn3 = BET003
- !
- zn2 = BET012*zt + BET102*zs+BET002
- !
- zn1 = ((BET031*zt &
- & + BET121*zs+BET021)*zt &
- & + (BET211*zs+BET111)*zs+BET011)*zt &
- & + ((BET301*zs+BET201)*zs+BET101)*zs+BET001
- !
- zn0 = ((((BET050*zt &
- & + BET140*zs+BET040)*zt &
- & + (BET230*zs+BET130)*zs+BET030)*zt &
- & + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt &
- & + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt &
- & + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000
- !
- zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
- !
- pab(ji,jj,jp_sal) = zn / zs * r1_rho0
- !
- !
- END_2D
- !
- CASE( np_seos ) !== simplified EOS ==!
- !
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- !
- zt = pts (ji,jj,jp_tem) - 10._wp ! pot. temperature anomaly (t-T0)
- zs = pts (ji,jj,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0)
- zh = pdep (ji,jj) ! depth at the partial step level
- !
- zn = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs
- pab(ji,jj,jp_tem) = zn * r1_rho0 ! alpha
- !
- zn = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt
- pab(ji,jj,jp_sal) = zn * r1_rho0 ! beta
- !
- END_2D
- !
- CASE( np_leos ) !== linear ISOMIP EOS ==!
- !
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- !
- zt = pts (ji,jj,jp_tem) - (-1._wp) ! pot. temperature anomaly (t-T0)
- zs = pts (ji,jj,jp_sal) - 34.2_wp ! abs. salinity anomaly (s-S0)
- zh = pdep (ji,jj) ! depth at the partial step level
- !
- zn = rn_a0 * rho0
- pab(ji,jj,jp_tem) = zn * r1_rho0 ! alpha
- !
- zn = rn_b0 * rho0
- pab(ji,jj,jp_sal) = zn * r1_rho0 ! beta
- !
- END_2D
- !
- CASE DEFAULT
- WRITE(ctmp1,*) ' bad flag value for neos = ', neos
- CALL ctl_stop( 'rab_2d:', ctmp1 )
- !
- END SELECT
- !
- IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=pab(:,:,jp_tem), clinfo1=' rab_2d_t: ', &
- & tab2d_2=pab(:,:,jp_sal), clinfo2=' rab_2d_s : ' )
- !
- IF( ln_timing ) CALL timing_stop('rab_2d')
- !
- END SUBROUTINE rab_2d_t
-
-
- SUBROUTINE rab_0d( pts, pdep, pab, Kmm )
- !!----------------------------------------------------------------------
- !! *** ROUTINE rab_0d ***
- !!
- !! ** Purpose : Calculates thermal/haline expansion ratio for a 2d field (unmasked)
- !!
- !! ** Action : - pab : thermal/haline expansion ratio at T-points
- !!----------------------------------------------------------------------
- INTEGER , INTENT(in ) :: Kmm ! time level index
- REAL(wp), DIMENSION(jpts) , INTENT(in ) :: pts ! pot. temperature & salinity
- REAL(wp), INTENT(in ) :: pdep ! depth [m]
- REAL(wp), DIMENSION(jpts) , INTENT( out) :: pab ! thermal/haline expansion ratio
- !
- REAL(wp) :: zt , zh , zs ! local scalars
- REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - -
- !!----------------------------------------------------------------------
- !
- IF( ln_timing ) CALL timing_start('rab_0d')
- !
- pab(:) = 0._wp
- !
- SELECT CASE ( neos )
- !
- CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==!
- !
- !
- zh = pdep * r1_Z0 ! depth
- zt = pts (jp_tem) * r1_T0 ! temperature
- zs = SQRT( ABS( pts(jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity
- !
- ! alpha
- zn3 = ALP003
- !
- zn2 = ALP012*zt + ALP102*zs+ALP002
- !
- zn1 = ((ALP031*zt &
- & + ALP121*zs+ALP021)*zt &
- & + (ALP211*zs+ALP111)*zs+ALP011)*zt &
- & + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001
- !
- zn0 = ((((ALP050*zt &
- & + ALP140*zs+ALP040)*zt &
- & + (ALP230*zs+ALP130)*zs+ALP030)*zt &
- & + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt &
- & + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt &
- & + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000
- !
- zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
- !
- pab(jp_tem) = zn * r1_rho0
- !
- ! beta
- zn3 = BET003
- !
- zn2 = BET012*zt + BET102*zs+BET002
- !
- zn1 = ((BET031*zt &
- & + BET121*zs+BET021)*zt &
- & + (BET211*zs+BET111)*zs+BET011)*zt &
- & + ((BET301*zs+BET201)*zs+BET101)*zs+BET001
- !
- zn0 = ((((BET050*zt &
- & + BET140*zs+BET040)*zt &
- & + (BET230*zs+BET130)*zs+BET030)*zt &
- & + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt &
- & + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt &
- & + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000
- !
- zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0
- !
- pab(jp_sal) = zn / zs * r1_rho0
- !
- !
- !
- CASE( np_seos ) !== simplified EOS ==!
- !
- zt = pts(jp_tem) - 10._wp ! pot. temperature anomaly (t-T0)
- zs = pts(jp_sal) - 35._wp ! abs. salinity anomaly (s-S0)
- zh = pdep ! depth at the partial step level
- !
- zn = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs
- pab(jp_tem) = zn * r1_rho0 ! alpha
- !
- zn = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt
- pab(jp_sal) = zn * r1_rho0 ! beta
- !
- CASE( np_leos ) !== linear ISOMIP EOS ==!
- !
- zt = pts(jp_tem) - (-1._wp) ! pot. temperature anomaly (t-T0)
- zs = pts(jp_sal) - 34.2_wp ! abs. salinity anomaly (s-S0)
- zh = pdep ! depth at the partial step level
- !
- zn = rn_a0 * rho0
- pab(jp_tem) = zn * r1_rho0 ! alpha
- !
- zn = rn_b0 * rho0
- pab(jp_sal) = zn * r1_rho0 ! beta
- !
- CASE DEFAULT
- WRITE(ctmp1,*) ' bad flag value for neos = ', neos
- CALL ctl_stop( 'rab_0d:', ctmp1 )
- !
- END SELECT
- !
- IF( ln_timing ) CALL timing_stop('rab_0d')
- !
- END SUBROUTINE rab_0d
-
-
- SUBROUTINE bn2( pts, pab, pn2, Kmm )
- !!
- INTEGER , INTENT(in ) :: Kmm ! time level index
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature and salinity [Celsius,psu]
- REAL(wp), DIMENSION(:,:,:,:) , INTENT(in ) :: pab ! thermal/haline expansion coef. [Celsius-1,psu-1]
- REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: pn2 ! Brunt-Vaisala frequency squared [1/s^2]
- !!
- CALL bn2_t( pts, pab, is_tile(pab), pn2, is_tile(pn2), Kmm )
- END SUBROUTINE bn2
-
-
- SUBROUTINE bn2_t( pts, pab, ktab, pn2, ktn2, Kmm )
- !!----------------------------------------------------------------------
- !! *** ROUTINE bn2 ***
- !!
- !! ** Purpose : Compute the local Brunt-Vaisala frequency at the
- !! time-step of the input arguments
- !!
- !! ** Method : pn2 = grav * (alpha dk[T] + beta dk[S] ) / e3w
- !! where alpha and beta are given in pab, and computed on T-points.
- !! N.B. N^2 is set one for all to zero at jk=1 in istate module.
- !!
- !! ** Action : pn2 : square of the brunt-vaisala frequency at w-point
- !!
- !!----------------------------------------------------------------------
- INTEGER , INTENT(in ) :: Kmm ! time level index
- INTEGER , INTENT(in ) :: ktab, ktn2
- REAL(wp), DIMENSION(jpi,jpj, jpk,jpts), INTENT(in ) :: pts ! pot. temperature and salinity [Celsius,psu]
- REAL(wp), DIMENSION(A2D_T(ktab),JPK,JPTS), INTENT(in ) :: pab ! thermal/haline expansion coef. [Celsius-1,psu-1]
- REAL(wp), DIMENSION(A2D_T(ktn2),JPK ), INTENT( out) :: pn2 ! Brunt-Vaisala frequency squared [1/s^2]
- !
- INTEGER :: ji, jj, jk ! dummy loop indices
- REAL(wp) :: zaw, zbw, zrw ! local scalars
- !!----------------------------------------------------------------------
- !
- IF( ln_timing ) CALL timing_start('bn2')
- !
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpkm1 ) ! interior points only (2=< jk =< jpkm1 ); surface and bottom value set to zero one for all in istate.F90
- zrw = ( gdepw(ji,jj,jk ,Kmm) - gdept(ji,jj,jk,Kmm) ) &
- & / ( gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm) )
- !
- zaw = pab(ji,jj,jk,jp_tem) * (1. - zrw) + pab(ji,jj,jk-1,jp_tem) * zrw
- zbw = pab(ji,jj,jk,jp_sal) * (1. - zrw) + pab(ji,jj,jk-1,jp_sal) * zrw
- !
- pn2(ji,jj,jk) = grav * ( zaw * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) &
- & - zbw * ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) ) &
- & / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk)
- END_3D
- !
- IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2 : ', kdim=jpk )
- !
- IF( ln_timing ) CALL timing_stop('bn2')
- !
- END SUBROUTINE bn2_t
-
-
- FUNCTION eos_pt_from_ct( ctmp, psal ) RESULT( ptmp )
- !!----------------------------------------------------------------------
- !! *** ROUTINE eos_pt_from_ct ***
- !!
- !! ** Purpose : Compute pot.temp. from cons. temp. [Celsius]
- !!
- !! ** Method : rational approximation (5/3th order) of TEOS-10 algorithm
- !! checkvalue: pt=20.02391895 Celsius for sa=35.7g/kg, ct=20degC
- !!
- !! Reference : TEOS-10, UNESCO
- !! Rational approximation to TEOS10 algorithm (rms error on WOA13 values: 4.0e-5 degC)
- !!----------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: ctmp ! Cons. Temp [Celsius]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu]
- ! Leave result array automatic rather than making explicitly allocated
- REAL(wp), DIMENSION(jpi,jpj) :: ptmp ! potential temperature [Celsius]
- !
- INTEGER :: ji, jj ! dummy loop indices
- REAL(wp) :: zt , zs , ztm ! local scalars
- REAL(wp) :: zn , zd ! local scalars
- REAL(wp) :: zdeltaS , z1_S0 , z1_T0
- !!----------------------------------------------------------------------
- !
- IF( ln_timing ) CALL timing_start('eos_pt_from_ct')
- !
- zdeltaS = 5._wp
- z1_S0 = 0.875_wp/35.16504_wp
- z1_T0 = 1._wp/40._wp
- !
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- !
- zt = ctmp (ji,jj) * z1_T0
- zs = SQRT( ABS( psal(ji,jj) + zdeltaS ) * z1_S0 )
- ztm = tmask(ji,jj,1)
- !
- zn = ((((-2.1385727895e-01_wp*zt &
- & - 2.7674419971e-01_wp*zs+1.0728094330_wp)*zt &
- & + (2.6366564313_wp*zs+3.3546960647_wp)*zs-7.8012209473_wp)*zt &
- & + ((1.8835586562_wp*zs+7.3949191679_wp)*zs-3.3937395875_wp)*zs-5.6414948432_wp)*zt &
- & + (((3.5737370589_wp*zs-1.5512427389e+01_wp)*zs+2.4625741105e+01_wp)*zs &
- & +1.9912291000e+01_wp)*zs-3.2191146312e+01_wp)*zt &
- & + ((((5.7153204649e-01_wp*zs-3.0943149543_wp)*zs+9.3052495181_wp)*zs &
- & -9.4528934807_wp)*zs+3.1066408996_wp)*zs-4.3504021262e-01_wp
- !
- zd = (2.0035003456_wp*zt &
- & -3.4570358592e-01_wp*zs+5.6471810638_wp)*zt &
- & + (1.5393993508_wp*zs-6.9394762624_wp)*zs+1.2750522650e+01_wp
- !
- ptmp(ji,jj) = ( zt / z1_T0 + zn / zd ) * ztm
- !
- END_2D
- !
- IF( ln_timing ) CALL timing_stop('eos_pt_from_ct')
- !
- END FUNCTION eos_pt_from_ct
-
-
- SUBROUTINE eos_fzp_2d( psal, ptf, pdep )
- !!
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu]
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in ), OPTIONAL :: pdep ! depth [m]
- REAL(wp), DIMENSION(:,:) , INTENT(out ) :: ptf ! freezing temperature [Celsius]
- !!
- CALL eos_fzp_2d_t( psal, ptf, is_tile(ptf), pdep )
- END SUBROUTINE eos_fzp_2d
-
-
- SUBROUTINE eos_fzp_2d_t( psal, ptf, kttf, pdep )
- !!----------------------------------------------------------------------
- !! *** ROUTINE eos_fzp ***
- !!
- !! ** Purpose : Compute the freezing point temperature [Celsius]
- !!
- !! ** Method : UNESCO freezing point (ptf) in Celsius is given by
- !! ptf(t,z) = (-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s - 7.53e-4*z
- !! checkvalue: tf=-2.588567 Celsius for s=40psu, z=500m
- !!
- !! Reference : UNESCO tech. papers in the marine science no. 28. 1978
- !!----------------------------------------------------------------------
- INTEGER , INTENT(in ) :: kttf
- REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: psal ! salinity [psu]
- REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ), OPTIONAL :: pdep ! depth [m]
- REAL(wp), DIMENSION(A2D_T(kttf)), INTENT(out ) :: ptf ! freezing temperature [Celsius]
- !
- INTEGER :: ji, jj ! dummy loop indices
- REAL(wp) :: zt, zs, z1_S0 ! local scalars
- !!----------------------------------------------------------------------
- !
- SELECT CASE ( neos )
- !
- CASE ( np_teos10, np_seos ) !== CT,SA (TEOS-10 and S-EOS formulations) ==!
- !
- z1_S0 = 1._wp / 35.16504_wp
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- zs= SQRT( ABS( psal(ji,jj) ) * z1_S0 ) ! square root salinity
- ptf(ji,jj) = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs &
- & - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp
- END_2D
- ptf(:,:) = ptf(:,:) * psal(:,:)
- !
- IF( PRESENT( pdep ) ) ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:)
- !
- CASE ( np_eos80 ) !== PT,SP (UNESCO formulation) ==!
- !
- ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) ) &
- & - 2.154996e-4_wp * psal(:,:) ) * psal(:,:)
- !
- IF( PRESENT( pdep ) ) ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:)
- !
- CASE DEFAULT
- WRITE(ctmp1,*) ' bad flag value for neos = ', neos
- CALL ctl_stop( 'eos_fzp_2d:', ctmp1 )
- !
- END SELECT
- !
- END SUBROUTINE eos_fzp_2d_t
-
-
- SUBROUTINE eos_fzp_0d( psal, ptf, pdep )
- !!----------------------------------------------------------------------
- !! *** ROUTINE eos_fzp ***
- !!
- !! ** Purpose : Compute the freezing point temperature [Celsius]
- !!
- !! ** Method : UNESCO freezing point (ptf) in Celsius is given by
- !! ptf(t,z) = (-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s - 7.53e-4*z
- !! checkvalue: tf=-2.588567 Celsius for s=40psu, z=500m
- !!
- !! Reference : UNESCO tech. papers in the marine science no. 28. 1978
- !!----------------------------------------------------------------------
- REAL(wp), INTENT(in ) :: psal ! salinity [psu]
- REAL(wp), INTENT(in ), OPTIONAL :: pdep ! depth [m]
- REAL(wp), INTENT(out) :: ptf ! freezing temperature [Celsius]
- !
- REAL(wp) :: zs ! local scalars
- !!----------------------------------------------------------------------
- !
- SELECT CASE ( neos )
- !
- CASE ( np_teos10, np_seos ) !== CT,SA (TEOS-10 and S-EOS formulations) ==!
- !
- zs = SQRT( ABS( psal ) / 35.16504_wp ) ! square root salinity
- ptf = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs &
- & - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp
- ptf = ptf * psal
- !
- IF( PRESENT( pdep ) ) ptf = ptf - 7.53e-4 * pdep
- !
- CASE ( np_eos80 ) !== PT,SP (UNESCO formulation) ==!
- !
- ptf = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal ) &
- & - 2.154996e-4_wp * psal ) * psal
- !
- IF( PRESENT( pdep ) ) ptf = ptf - 7.53e-4 * pdep
- !
- CASE DEFAULT
- WRITE(ctmp1,*) ' bad flag value for neos = ', neos
- CALL ctl_stop( 'eos_fzp_0d:', ctmp1 )
- !
- END SELECT
- !
- END SUBROUTINE eos_fzp_0d
-
-
- SUBROUTINE eos_pen( pts, pab_pe, ppen, Kmm )
- !!----------------------------------------------------------------------
- !! *** ROUTINE eos_pen ***
- !!
- !! ** Purpose : Calculates nonlinear anomalies of alpha_PE, beta_PE and PE at T-points
- !!
- !! ** Method : PE is defined analytically as the vertical
- !! primitive of EOS times -g integrated between 0 and z>0.
- !! pen is the nonlinear bsq-PE anomaly: pen = ( PE - rho0 gz ) / rho0 gz - rd
- !! = 1/z * /int_0^z rd dz - rd
- !! where rd is the density anomaly (see eos_rhd function)
- !! ab_pe are partial derivatives of PE anomaly with respect to T and S:
- !! ab_pe(1) = - 1/(rho0 gz) * dPE/dT + drd/dT = - d(pen)/dT
- !! ab_pe(2) = 1/(rho0 gz) * dPE/dS + drd/dS = d(pen)/dS
- !!
- !! ** Action : - pen : PE anomaly given at T-points
- !! : - pab_pe : given at T-points
- !! pab_pe(:,:,:,jp_tem) is alpha_pe
- !! pab_pe(:,:,:,jp_sal) is beta_pe
- !!----------------------------------------------------------------------
- INTEGER , INTENT(in ) :: Kmm ! time level index
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature & salinity
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT( out) :: pab_pe ! alpha_pe and beta_pe
- REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: ppen ! potential energy anomaly
- !
- INTEGER :: ji, jj, jk ! dummy loop indices
- REAL(wp) :: zt , zh , zs , ztm ! local scalars
- REAL(wp) :: zn , zn0, zn1, zn2 ! - -
- !!----------------------------------------------------------------------
- !
- IF( ln_timing ) CALL timing_start('eos_pen')
- !
- SELECT CASE ( neos )
- !
- CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==!
- !
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
- !
- zh = gdept(ji,jj,jk,Kmm) * r1_Z0 ! depth
- zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature
- zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity
- ztm = tmask(ji,jj,jk) ! tmask
- !
- ! potential energy non-linear anomaly
- zn2 = (PEN012)*zt &
- & + PEN102*zs+PEN002
- !
- zn1 = ((PEN021)*zt &
- & + PEN111*zs+PEN011)*zt &
- & + (PEN201*zs+PEN101)*zs+PEN001
- !
- zn0 = ((((PEN040)*zt &
- & + PEN130*zs+PEN030)*zt &
- & + (PEN220*zs+PEN120)*zs+PEN020)*zt &
- & + ((PEN310*zs+PEN210)*zs+PEN110)*zs+PEN010)*zt &
- & + (((PEN400*zs+PEN300)*zs+PEN200)*zs+PEN100)*zs+PEN000
- !
- zn = ( zn2 * zh + zn1 ) * zh + zn0
- !
- ppen(ji,jj,jk) = zn * zh * r1_rho0 * ztm
- !
- ! alphaPE non-linear anomaly
- zn2 = APE002
- !
- zn1 = (APE011)*zt &
- & + APE101*zs+APE001
- !
- zn0 = (((APE030)*zt &
- & + APE120*zs+APE020)*zt &
- & + (APE210*zs+APE110)*zs+APE010)*zt &
- & + ((APE300*zs+APE200)*zs+APE100)*zs+APE000
- !
- zn = ( zn2 * zh + zn1 ) * zh + zn0
- !
- pab_pe(ji,jj,jk,jp_tem) = zn * zh * r1_rho0 * ztm
- !
- ! betaPE non-linear anomaly
- zn2 = BPE002
- !
- zn1 = (BPE011)*zt &
- & + BPE101*zs+BPE001
- !
- zn0 = (((BPE030)*zt &
- & + BPE120*zs+BPE020)*zt &
- & + (BPE210*zs+BPE110)*zs+BPE010)*zt &
- & + ((BPE300*zs+BPE200)*zs+BPE100)*zs+BPE000
- !
- zn = ( zn2 * zh + zn1 ) * zh + zn0
- !
- pab_pe(ji,jj,jk,jp_sal) = zn / zs * zh * r1_rho0 * ztm
- !
- END_3D
- !
- CASE( np_seos ) !== Vallis (2006) simplified EOS ==!
- !
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
- zt = pts(ji,jj,jk,jp_tem) - 10._wp ! temperature anomaly (t-T0)
- zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0)
- zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point
- ztm = tmask(ji,jj,jk) ! tmask
- zn = 0.5_wp * zh * r1_rho0 * ztm
- ! ! Potential Energy
- ppen(ji,jj,jk) = ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zn
- ! ! alphaPE
- pab_pe(ji,jj,jk,jp_tem) = - rn_a0 * rn_mu1 * zn
- pab_pe(ji,jj,jk,jp_sal) = rn_b0 * rn_mu2 * zn
- !
- END_3D
- !
- CASE( np_leos ) !== linear ISOMIP EOS ==!
- !
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
- zt = pts(ji,jj,jk,jp_tem) - (-1._wp) ! temperature anomaly (t-T0)
- zs = pts (ji,jj,jk,jp_sal) - 34.2_wp ! abs. salinity anomaly (s-S0)
- zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point
- ztm = tmask(ji,jj,jk) ! tmask
- zn = 0.5_wp * zh * r1_rho0 * ztm
- ! ! Potential Energy
- ppen(ji,jj,jk) = 0.
- ! ! alphaPE
- pab_pe(ji,jj,jk,jp_tem) = 0.
- pab_pe(ji,jj,jk,jp_sal) = 0.
- !
- END_3D
- !
- CASE DEFAULT
- WRITE(ctmp1,*) ' bad flag value for neos = ', neos
- CALL ctl_stop( 'eos_pen:', ctmp1 )
- !
- END SELECT
- !
- IF( ln_timing ) CALL timing_stop('eos_pen')
- !
- END SUBROUTINE eos_pen
-
-
- SUBROUTINE eos_init
- !!----------------------------------------------------------------------
- !! *** ROUTINE eos_init ***
- !!
- !! ** Purpose : initializations for the equation of state
- !!
- !! ** Method : Read the namelist nameos and control the parameters
- !!----------------------------------------------------------------------
- INTEGER :: ios ! local integer
- INTEGER :: ioptio ! local integer
- !!
- NAMELIST/nameos/ ln_TEOS10, ln_EOS80, ln_SEOS, ln_LEOS, rn_a0, rn_b0, &
- & rn_lambda1, rn_mu1, rn_lambda2, rn_mu2, rn_nu
- !!----------------------------------------------------------------------
- !
- READ ( numnam_ref, nameos, IOSTAT = ios, ERR = 901 )
-901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nameos in reference namelist' )
- !
- READ ( numnam_cfg, nameos, IOSTAT = ios, ERR = 902 )
-902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nameos in configuration namelist' )
- IF(lwm) WRITE( numond, nameos )
- !
- rho0 = 1027.51_wp !: volumic mass of reference [kg/m3]
- rcp = 3974.00_wp !: heat capacity [J/K]
- !
- IF(lwp) THEN ! Control print
- WRITE(numout,*)
- WRITE(numout,*) 'eos_init : equation of state'
- WRITE(numout,*) '~~~~~~~~'
- WRITE(numout,*) ' Namelist nameos : Chosen the Equation Of Seawater (EOS)'
- WRITE(numout,*) ' TEOS-10 : rho=F(Conservative Temperature, Absolute Salinity, depth) ln_TEOS10 = ', ln_TEOS10
- WRITE(numout,*) ' EOS-80 : rho=F(Potential Temperature, Practical Salinity, depth) ln_EOS80 = ', ln_EOS80
- WRITE(numout,*) ' S-EOS : rho=F(Conservative Temperature, Absolute Salinity, depth) ln_SEOS = ', ln_SEOS
- WRITE(numout,*) ' L-EOS : rho=F(Potential Temperature, Practical Salinity, depth) ln_LEOS = ', ln_LEOS
- ENDIF
-
- ! Check options for equation of state & set neos based on logical flags
- ioptio = 0
- IF( ln_TEOS10 ) THEN ; ioptio = ioptio+1 ; neos = np_teos10 ; ENDIF
- IF( ln_EOS80 ) THEN ; ioptio = ioptio+1 ; neos = np_eos80 ; ENDIF
- IF( ln_SEOS ) THEN ; ioptio = ioptio+1 ; neos = np_seos ; ENDIF
- IF( ln_LEOS ) THEN ; ioptio = ioptio+1 ; neos = np_leos ; ENDIF
- IF( ioptio /= 1 ) CALL ctl_stop("Exactly one equation of state option must be selected")
- !
- SELECT CASE( neos ) ! check option
- !
- CASE( np_teos10 ) !== polynomial TEOS-10 ==!
- IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*) ' ==>>> use of TEOS-10 equation of state (cons. temp. and abs. salinity)'
- !
- l_useCT = .TRUE. ! model temperature is Conservative temperature
- !
- rdeltaS = 32._wp
- r1_S0 = 0.875_wp/35.16504_wp
- r1_T0 = 1._wp/40._wp
- r1_Z0 = 1.e-4_wp
- !
- EOS000 = 8.0189615746e+02_wp
- EOS100 = 8.6672408165e+02_wp
- EOS200 = -1.7864682637e+03_wp
- EOS300 = 2.0375295546e+03_wp
- EOS400 = -1.2849161071e+03_wp
- EOS500 = 4.3227585684e+02_wp
- EOS600 = -6.0579916612e+01_wp
- EOS010 = 2.6010145068e+01_wp
- EOS110 = -6.5281885265e+01_wp
- EOS210 = 8.1770425108e+01_wp
- EOS310 = -5.6888046321e+01_wp
- EOS410 = 1.7681814114e+01_wp
- EOS510 = -1.9193502195_wp
- EOS020 = -3.7074170417e+01_wp
- EOS120 = 6.1548258127e+01_wp
- EOS220 = -6.0362551501e+01_wp
- EOS320 = 2.9130021253e+01_wp
- EOS420 = -5.4723692739_wp
- EOS030 = 2.1661789529e+01_wp
- EOS130 = -3.3449108469e+01_wp
- EOS230 = 1.9717078466e+01_wp
- EOS330 = -3.1742946532_wp
- EOS040 = -8.3627885467_wp
- EOS140 = 1.1311538584e+01_wp
- EOS240 = -5.3563304045_wp
- EOS050 = 5.4048723791e-01_wp
- EOS150 = 4.8169980163e-01_wp
- EOS060 = -1.9083568888e-01_wp
- EOS001 = 1.9681925209e+01_wp
- EOS101 = -4.2549998214e+01_wp
- EOS201 = 5.0774768218e+01_wp
- EOS301 = -3.0938076334e+01_wp
- EOS401 = 6.6051753097_wp
- EOS011 = -1.3336301113e+01_wp
- EOS111 = -4.4870114575_wp
- EOS211 = 5.0042598061_wp
- EOS311 = -6.5399043664e-01_wp
- EOS021 = 6.7080479603_wp
- EOS121 = 3.5063081279_wp
- EOS221 = -1.8795372996_wp
- EOS031 = -2.4649669534_wp
- EOS131 = -5.5077101279e-01_wp
- EOS041 = 5.5927935970e-01_wp
- EOS002 = 2.0660924175_wp
- EOS102 = -4.9527603989_wp
- EOS202 = 2.5019633244_wp
- EOS012 = 2.0564311499_wp
- EOS112 = -2.1311365518e-01_wp
- EOS022 = -1.2419983026_wp
- EOS003 = -2.3342758797e-02_wp
- EOS103 = -1.8507636718e-02_wp
- EOS013 = 3.7969820455e-01_wp
- !
- ALP000 = -6.5025362670e-01_wp
- ALP100 = 1.6320471316_wp
- ALP200 = -2.0442606277_wp
- ALP300 = 1.4222011580_wp
- ALP400 = -4.4204535284e-01_wp
- ALP500 = 4.7983755487e-02_wp
- ALP010 = 1.8537085209_wp
- ALP110 = -3.0774129064_wp
- ALP210 = 3.0181275751_wp
- ALP310 = -1.4565010626_wp
- ALP410 = 2.7361846370e-01_wp
- ALP020 = -1.6246342147_wp
- ALP120 = 2.5086831352_wp
- ALP220 = -1.4787808849_wp
- ALP320 = 2.3807209899e-01_wp
- ALP030 = 8.3627885467e-01_wp
- ALP130 = -1.1311538584_wp
- ALP230 = 5.3563304045e-01_wp
- ALP040 = -6.7560904739e-02_wp
- ALP140 = -6.0212475204e-02_wp
- ALP050 = 2.8625353333e-02_wp
- ALP001 = 3.3340752782e-01_wp
- ALP101 = 1.1217528644e-01_wp
- ALP201 = -1.2510649515e-01_wp
- ALP301 = 1.6349760916e-02_wp
- ALP011 = -3.3540239802e-01_wp
- ALP111 = -1.7531540640e-01_wp
- ALP211 = 9.3976864981e-02_wp
- ALP021 = 1.8487252150e-01_wp
- ALP121 = 4.1307825959e-02_wp
- ALP031 = -5.5927935970e-02_wp
- ALP002 = -5.1410778748e-02_wp
- ALP102 = 5.3278413794e-03_wp
- ALP012 = 6.2099915132e-02_wp
- ALP003 = -9.4924551138e-03_wp
- !
- BET000 = 1.0783203594e+01_wp
- BET100 = -4.4452095908e+01_wp
- BET200 = 7.6048755820e+01_wp
- BET300 = -6.3944280668e+01_wp
- BET400 = 2.6890441098e+01_wp
- BET500 = -4.5221697773_wp
- BET010 = -8.1219372432e-01_wp
- BET110 = 2.0346663041_wp
- BET210 = -2.1232895170_wp
- BET310 = 8.7994140485e-01_wp
- BET410 = -1.1939638360e-01_wp
- BET020 = 7.6574242289e-01_wp
- BET120 = -1.5019813020_wp
- BET220 = 1.0872489522_wp
- BET320 = -2.7233429080e-01_wp
- BET030 = -4.1615152308e-01_wp
- BET130 = 4.9061350869e-01_wp
- BET230 = -1.1847737788e-01_wp
- BET040 = 1.4073062708e-01_wp
- BET140 = -1.3327978879e-01_wp
- BET050 = 5.9929880134e-03_wp
- BET001 = -5.2937873009e-01_wp
- BET101 = 1.2634116779_wp
- BET201 = -1.1547328025_wp
- BET301 = 3.2870876279e-01_wp
- BET011 = -5.5824407214e-02_wp
- BET111 = 1.2451933313e-01_wp
- BET211 = -2.4409539932e-02_wp
- BET021 = 4.3623149752e-02_wp
- BET121 = -4.6767901790e-02_wp
- BET031 = -6.8523260060e-03_wp
- BET002 = -6.1618945251e-02_wp
- BET102 = 6.2255521644e-02_wp
- BET012 = -2.6514181169e-03_wp
- BET003 = -2.3025968587e-04_wp
- !
- PEN000 = -9.8409626043_wp
- PEN100 = 2.1274999107e+01_wp
- PEN200 = -2.5387384109e+01_wp
- PEN300 = 1.5469038167e+01_wp
- PEN400 = -3.3025876549_wp
- PEN010 = 6.6681505563_wp
- PEN110 = 2.2435057288_wp
- PEN210 = -2.5021299030_wp
- PEN310 = 3.2699521832e-01_wp
- PEN020 = -3.3540239802_wp
- PEN120 = -1.7531540640_wp
- PEN220 = 9.3976864981e-01_wp
- PEN030 = 1.2324834767_wp
- PEN130 = 2.7538550639e-01_wp
- PEN040 = -2.7963967985e-01_wp
- PEN001 = -1.3773949450_wp
- PEN101 = 3.3018402659_wp
- PEN201 = -1.6679755496_wp
- PEN011 = -1.3709540999_wp
- PEN111 = 1.4207577012e-01_wp
- PEN021 = 8.2799886843e-01_wp
- PEN002 = 1.7507069098e-02_wp
- PEN102 = 1.3880727538e-02_wp
- PEN012 = -2.8477365341e-01_wp
- !
- APE000 = -1.6670376391e-01_wp
- APE100 = -5.6087643219e-02_wp
- APE200 = 6.2553247576e-02_wp
- APE300 = -8.1748804580e-03_wp
- APE010 = 1.6770119901e-01_wp
- APE110 = 8.7657703198e-02_wp
- APE210 = -4.6988432490e-02_wp
- APE020 = -9.2436260751e-02_wp
- APE120 = -2.0653912979e-02_wp
- APE030 = 2.7963967985e-02_wp
- APE001 = 3.4273852498e-02_wp
- APE101 = -3.5518942529e-03_wp
- APE011 = -4.1399943421e-02_wp
- APE002 = 7.1193413354e-03_wp
- !
- BPE000 = 2.6468936504e-01_wp
- BPE100 = -6.3170583896e-01_wp
- BPE200 = 5.7736640125e-01_wp
- BPE300 = -1.6435438140e-01_wp
- BPE010 = 2.7912203607e-02_wp
- BPE110 = -6.2259666565e-02_wp
- BPE210 = 1.2204769966e-02_wp
- BPE020 = -2.1811574876e-02_wp
- BPE120 = 2.3383950895e-02_wp
- BPE030 = 3.4261630030e-03_wp
- BPE001 = 4.1079296834e-02_wp
- BPE101 = -4.1503681096e-02_wp
- BPE011 = 1.7676120780e-03_wp
- BPE002 = 1.7269476440e-04_wp
- !
- CASE( np_eos80 ) !== polynomial EOS-80 formulation ==!
- !
- IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*) ' ==>>> use of EOS-80 equation of state (pot. temp. and pract. salinity)'
- !
- l_useCT = .FALSE. ! model temperature is Potential temperature
- rdeltaS = 20._wp
- r1_S0 = 1._wp/40._wp
- r1_T0 = 1._wp/40._wp
- r1_Z0 = 1.e-4_wp
- !
- EOS000 = 9.5356891948e+02_wp
- EOS100 = 1.7136499189e+02_wp
- EOS200 = -3.7501039454e+02_wp
- EOS300 = 5.1856810420e+02_wp
- EOS400 = -3.7264470465e+02_wp
- EOS500 = 1.4302533998e+02_wp
- EOS600 = -2.2856621162e+01_wp
- EOS010 = 1.0087518651e+01_wp
- EOS110 = -1.3647741861e+01_wp
- EOS210 = 8.8478359933_wp
- EOS310 = -7.2329388377_wp
- EOS410 = 1.4774410611_wp
- EOS510 = 2.0036720553e-01_wp
- EOS020 = -2.5579830599e+01_wp
- EOS120 = 2.4043512327e+01_wp
- EOS220 = -1.6807503990e+01_wp
- EOS320 = 8.3811577084_wp
- EOS420 = -1.9771060192_wp
- EOS030 = 1.6846451198e+01_wp
- EOS130 = -2.1482926901e+01_wp
- EOS230 = 1.0108954054e+01_wp
- EOS330 = -6.2675951440e-01_wp
- EOS040 = -8.0812310102_wp
- EOS140 = 1.0102374985e+01_wp
- EOS240 = -4.8340368631_wp
- EOS050 = 1.2079167803_wp
- EOS150 = 1.1515380987e-01_wp
- EOS060 = -2.4520288837e-01_wp
- EOS001 = 1.0748601068e+01_wp
- EOS101 = -1.7817043500e+01_wp
- EOS201 = 2.2181366768e+01_wp
- EOS301 = -1.6750916338e+01_wp
- EOS401 = 4.1202230403_wp
- EOS011 = -1.5852644587e+01_wp
- EOS111 = -7.6639383522e-01_wp
- EOS211 = 4.1144627302_wp
- EOS311 = -6.6955877448e-01_wp
- EOS021 = 9.9994861860_wp
- EOS121 = -1.9467067787e-01_wp
- EOS221 = -1.2177554330_wp
- EOS031 = -3.4866102017_wp
- EOS131 = 2.2229155620e-01_wp
- EOS041 = 5.9503008642e-01_wp
- EOS002 = 1.0375676547_wp
- EOS102 = -3.4249470629_wp
- EOS202 = 2.0542026429_wp
- EOS012 = 2.1836324814_wp
- EOS112 = -3.4453674320e-01_wp
- EOS022 = -1.2548163097_wp
- EOS003 = 1.8729078427e-02_wp
- EOS103 = -5.7238495240e-02_wp
- EOS013 = 3.8306136687e-01_wp
- !
- ALP000 = -2.5218796628e-01_wp
- ALP100 = 3.4119354654e-01_wp
- ALP200 = -2.2119589983e-01_wp
- ALP300 = 1.8082347094e-01_wp
- ALP400 = -3.6936026529e-02_wp
- ALP500 = -5.0091801383e-03_wp
- ALP010 = 1.2789915300_wp
- ALP110 = -1.2021756164_wp
- ALP210 = 8.4037519952e-01_wp
- ALP310 = -4.1905788542e-01_wp
- ALP410 = 9.8855300959e-02_wp
- ALP020 = -1.2634838399_wp
- ALP120 = 1.6112195176_wp
- ALP220 = -7.5817155402e-01_wp
- ALP320 = 4.7006963580e-02_wp
- ALP030 = 8.0812310102e-01_wp
- ALP130 = -1.0102374985_wp
- ALP230 = 4.8340368631e-01_wp
- ALP040 = -1.5098959754e-01_wp
- ALP140 = -1.4394226233e-02_wp
- ALP050 = 3.6780433255e-02_wp
- ALP001 = 3.9631611467e-01_wp
- ALP101 = 1.9159845880e-02_wp
- ALP201 = -1.0286156825e-01_wp
- ALP301 = 1.6738969362e-02_wp
- ALP011 = -4.9997430930e-01_wp
- ALP111 = 9.7335338937e-03_wp
- ALP211 = 6.0887771651e-02_wp
- ALP021 = 2.6149576513e-01_wp
- ALP121 = -1.6671866715e-02_wp
- ALP031 = -5.9503008642e-02_wp
- ALP002 = -5.4590812035e-02_wp
- ALP102 = 8.6134185799e-03_wp
- ALP012 = 6.2740815484e-02_wp
- ALP003 = -9.5765341718e-03_wp
- !
- BET000 = 2.1420623987_wp
- BET100 = -9.3752598635_wp
- BET200 = 1.9446303907e+01_wp
- BET300 = -1.8632235232e+01_wp
- BET400 = 8.9390837485_wp
- BET500 = -1.7142465871_wp
- BET010 = -1.7059677327e-01_wp
- BET110 = 2.2119589983e-01_wp
- BET210 = -2.7123520642e-01_wp
- BET310 = 7.3872053057e-02_wp
- BET410 = 1.2522950346e-02_wp
- BET020 = 3.0054390409e-01_wp
- BET120 = -4.2018759976e-01_wp
- BET220 = 3.1429341406e-01_wp
- BET320 = -9.8855300959e-02_wp
- BET030 = -2.6853658626e-01_wp
- BET130 = 2.5272385134e-01_wp
- BET230 = -2.3503481790e-02_wp
- BET040 = 1.2627968731e-01_wp
- BET140 = -1.2085092158e-01_wp
- BET050 = 1.4394226233e-03_wp
- BET001 = -2.2271304375e-01_wp
- BET101 = 5.5453416919e-01_wp
- BET201 = -6.2815936268e-01_wp
- BET301 = 2.0601115202e-01_wp
- BET011 = -9.5799229402e-03_wp
- BET111 = 1.0286156825e-01_wp
- BET211 = -2.5108454043e-02_wp
- BET021 = -2.4333834734e-03_wp
- BET121 = -3.0443885826e-02_wp
- BET031 = 2.7786444526e-03_wp
- BET002 = -4.2811838287e-02_wp
- BET102 = 5.1355066072e-02_wp
- BET012 = -4.3067092900e-03_wp
- BET003 = -7.1548119050e-04_wp
- !
- PEN000 = -5.3743005340_wp
- PEN100 = 8.9085217499_wp
- PEN200 = -1.1090683384e+01_wp
- PEN300 = 8.3754581690_wp
- PEN400 = -2.0601115202_wp
- PEN010 = 7.9263222935_wp
- PEN110 = 3.8319691761e-01_wp
- PEN210 = -2.0572313651_wp
- PEN310 = 3.3477938724e-01_wp
- PEN020 = -4.9997430930_wp
- PEN120 = 9.7335338937e-02_wp
- PEN220 = 6.0887771651e-01_wp
- PEN030 = 1.7433051009_wp
- PEN130 = -1.1114577810e-01_wp
- PEN040 = -2.9751504321e-01_wp
- PEN001 = -6.9171176978e-01_wp
- PEN101 = 2.2832980419_wp
- PEN201 = -1.3694684286_wp
- PEN011 = -1.4557549876_wp
- PEN111 = 2.2969116213e-01_wp
- PEN021 = 8.3654420645e-01_wp
- PEN002 = -1.4046808820e-02_wp
- PEN102 = 4.2928871430e-02_wp
- PEN012 = -2.8729602515e-01_wp
- !
- APE000 = -1.9815805734e-01_wp
- APE100 = -9.5799229402e-03_wp
- APE200 = 5.1430784127e-02_wp
- APE300 = -8.3694846809e-03_wp
- APE010 = 2.4998715465e-01_wp
- APE110 = -4.8667669469e-03_wp
- APE210 = -3.0443885826e-02_wp
- APE020 = -1.3074788257e-01_wp
- APE120 = 8.3359333577e-03_wp
- APE030 = 2.9751504321e-02_wp
- APE001 = 3.6393874690e-02_wp
- APE101 = -5.7422790533e-03_wp
- APE011 = -4.1827210323e-02_wp
- APE002 = 7.1824006288e-03_wp
- !
- BPE000 = 1.1135652187e-01_wp
- BPE100 = -2.7726708459e-01_wp
- BPE200 = 3.1407968134e-01_wp
- BPE300 = -1.0300557601e-01_wp
- BPE010 = 4.7899614701e-03_wp
- BPE110 = -5.1430784127e-02_wp
- BPE210 = 1.2554227021e-02_wp
- BPE020 = 1.2166917367e-03_wp
- BPE120 = 1.5221942913e-02_wp
- BPE030 = -1.3893222263e-03_wp
- BPE001 = 2.8541225524e-02_wp
- BPE101 = -3.4236710714e-02_wp
- BPE011 = 2.8711395266e-03_wp
- BPE002 = 5.3661089288e-04_wp
- !
- CASE( np_seos ) !== Simplified EOS ==!
-
- r1_S0 = 0.875_wp/35.16504_wp ! Used to convert CT in potential temperature when using bulk formulae (eos_pt_from_ct)
-
- IF(lwp) THEN
- WRITE(numout,*)
- WRITE(numout,*) ' ==>>> use of simplified eos: '
- WRITE(numout,*) ' rhd(dT=T-10,dS=S-35,Z) = [-a0*(1+lambda1/2*dT+mu1*Z)*dT '
- WRITE(numout,*) ' + b0*(1+lambda2/2*dT+mu2*Z)*dS - nu*dT*dS] / rho0'
- WRITE(numout,*) ' with the following coefficients :'
- WRITE(numout,*) ' thermal exp. coef. rn_a0 = ', rn_a0
- WRITE(numout,*) ' saline cont. coef. rn_b0 = ', rn_b0
- WRITE(numout,*) ' cabbeling coef. rn_lambda1 = ', rn_lambda1
- WRITE(numout,*) ' cabbeling coef. rn_lambda2 = ', rn_lambda2
- WRITE(numout,*) ' thermobar. coef. rn_mu1 = ', rn_mu1
- WRITE(numout,*) ' thermobar. coef. rn_mu2 = ', rn_mu2
- WRITE(numout,*) ' 2nd cabbel. coef. rn_nu = ', rn_nu
- WRITE(numout,*) ' Caution: rn_beta0=0 incompatible with ddm parameterization '
- ENDIF
- l_useCT = .TRUE. ! Use conservative temperature
- !
- CASE( np_leos ) !== Linear ISOMIP EOS ==!
-
- r1_S0 = 0.875_wp/35.16504_wp ! Used to convert CT in potential temperature when using bulk formulae (eos_pt_from_ct)
-
- IF(lwp) THEN
- WRITE(numout,*)
- WRITE(numout,*) ' use of linear ISOMIP eos: rhd(dT=T-(-1),dS=S-(34.2),Z) = '
- WRITE(numout,*) ' [ -a0*dT + b0*dS ]/rho0'
- WRITE(numout,*)
- WRITE(numout,*) ' thermal exp. coef. rn_a0 = ', rn_a0
- WRITE(numout,*) ' saline cont. coef. rn_b0 = ', rn_b0
- ENDIF
- l_useCT = .TRUE. ! Use conservative temperature
- !
- CASE DEFAULT !== ERROR in neos ==!
- WRITE(ctmp1,*) ' bad flag value for neos = ', neos, '. You should never see this error'
- CALL ctl_stop( ctmp1 )
- !
- END SELECT
- !
- rho0_rcp = rho0 * rcp
- r1_rho0 = 1._wp / rho0
- r1_rcp = 1._wp / rcp
- r1_rho0_rcp = 1._wp / rho0_rcp
- !
- IF(lwp) THEN
- IF( l_useCT ) THEN
- WRITE(numout,*)
- WRITE(numout,*) ' ==>>> model uses Conservative Temperature'
- WRITE(numout,*) ' Important: model must be initialized with CT and SA fields'
- ELSE
- WRITE(numout,*)
- WRITE(numout,*) ' ==>>> model does not use Conservative Temperature'
- ENDIF
- ENDIF
- !
- IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*) ' Associated physical constant'
- IF(lwp) WRITE(numout,*) ' volumic mass of reference rho0 = ', rho0 , ' kg/m^3'
- IF(lwp) WRITE(numout,*) ' 1. / rho0 r1_rho0 = ', r1_rho0, ' m^3/kg'
- IF(lwp) WRITE(numout,*) ' ocean specific heat rcp = ', rcp , ' J/Kelvin'
- IF(lwp) WRITE(numout,*) ' rho0 * rcp rho0_rcp = ', rho0_rcp
- IF(lwp) WRITE(numout,*) ' 1. / ( rho0 * rcp ) r1_rho0_rcp = ', r1_rho0_rcp
- !
- END SUBROUTINE eos_init
-
- !!======================================================================
-END MODULE eosbn2
diff --git a/tests/ISOMIP+/MY_SRC/isf_oce.F90 b/tests/ISOMIP+/MY_SRC/isf_oce.F90
index 3bf1b30da0cbf5af17e40e4d0de4d006dd4193d2..01aab242c9c1306e5e4bff649c9def654ddd9792 100644
--- a/tests/ISOMIP+/MY_SRC/isf_oce.F90
+++ b/tests/ISOMIP+/MY_SRC/isf_oce.F90
@@ -65,7 +65,7 @@ MODULE isf_oce
!
REAL(wp), PARAMETER, PUBLIC :: rLfusisf = 0.334e6_wp !: latent heat of fusion of ice shelf [J/kg]
REAL(wp), PARAMETER, PUBLIC :: rcpisf = 2000.0_wp !: specific heat of ice shelf [J/kg/K]
- REAL(wp), PARAMETER, PUBLIC :: rkappa = 0.0_wp !: ISOMIP+ no heat diffusivity through the ice-shelf [m2/s]
+ REAL(wp), PARAMETER, PUBLIC :: rkappa = 0._wp !: ISOMIP: no heat diffusivity [m2/s]
REAL(wp), PARAMETER, PUBLIC :: rhoisf = 920.0_wp !: volumic mass of ice shelf [kg/m3]
REAL(wp), PARAMETER, PUBLIC :: rtsurf = -20.0 !: surface temperature [C]
!
@@ -80,8 +80,8 @@ MODULE isf_oce
!
! 2.2 -------- ice shelf cavity melt namelist parameter -------------
INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mskisf_cav !:
- INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: misfkt_cav , misfkb_cav !:
- REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rhisf_tbl_cav, rfrac_tbl_cav !:
+ INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: misfkt_cav , misfkb_cav !: shallowest and deepest level of the ice shelf
+ REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rhisf_tbl_cav, rfrac_tbl_cav !: thickness and fraction of deepest cell affected by the ice shelf
REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fwfisf_cav , fwfisf_cav_b !: before and now net fwf from the ice shelf [kg/m2/s]
REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: risf_cav_tsc , risf_cav_tsc_b !: before and now T & S isf contents [K.m/s & PSU.m/s]
TYPE(FLD), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sf_isfcav_fwf !:
@@ -237,17 +237,28 @@ CONTAINS
!
ierr = 0 ! set to zero if no array to be allocated
!
- ALLOCATE( fwfisf_par (jpi,jpj) , fwfisf_par_b(jpi,jpj) , &
- & fwfisf_cav (jpi,jpj) , fwfisf_cav_b(jpi,jpj) , &
+ ALLOCATE( fwfisf_par (jpi,jpj) , fwfisf_cav (jpi,jpj) , &
& fwfisf_oasis(jpi,jpj) , STAT=ialloc )
ierr = ierr + ialloc
!
- ALLOCATE( risf_par_tsc(jpi,jpj,jpts) , risf_par_tsc_b(jpi,jpj,jpts) , STAT=ialloc )
+ ALLOCATE( risf_par_tsc(jpi,jpj,jpts) , STAT=ialloc )
ierr = ierr + ialloc
!
- ALLOCATE( risf_cav_tsc(jpi,jpj,jpts) , risf_cav_tsc_b(jpi,jpj,jpts) , STAT=ialloc )
+ ALLOCATE( risf_cav_tsc(jpi,jpj,jpts) , STAT=ialloc )
ierr = ierr + ialloc
!
+#if ! defined key_RK3
+ ! MLF : need to allocate before arrays
+ ALLOCATE( fwfisf_par_b(jpi,jpj) , fwfisf_cav_b(jpi,jpj) , STAT=ialloc )
+ ierr = ierr + ialloc
+ !
+ ALLOCATE( risf_par_tsc_b(jpi,jpj,jpts) , STAT=ialloc )
+ ierr = ierr + ialloc
+ !
+ ALLOCATE( risf_cav_tsc_b(jpi,jpj,jpts) , STAT=ialloc )
+ ierr = ierr + ialloc
+#endif
+ !
ALLOCATE( risfload(jpi,jpj) , STAT=ialloc )
ierr = ierr + ialloc
!
@@ -260,10 +271,17 @@ CONTAINS
! initalisation of fwf and tsc array to 0
risfload (:,:) = 0._wp
fwfisf_oasis(:,:) = 0._wp
+#if defined key_RK3
+ fwfisf_par (:,:) = 0._wp
+ fwfisf_cav (:,:) = 0._wp
+ risf_cav_tsc(:,:,:) = 0._wp
+ risf_par_tsc(:,:,:) = 0._wp
+#else
fwfisf_par (:,:) = 0._wp ; fwfisf_par_b (:,:) = 0._wp
fwfisf_cav (:,:) = 0._wp ; fwfisf_cav_b (:,:) = 0._wp
risf_cav_tsc(:,:,:) = 0._wp ; risf_cav_tsc_b(:,:,:) = 0._wp
risf_par_tsc(:,:,:) = 0._wp ; risf_par_tsc_b(:,:,:) = 0._wp
+#endif
!
END SUBROUTINE isf_alloc
diff --git a/tests/ISOMIP+/MY_SRC/isfcavgam.F90 b/tests/ISOMIP+/MY_SRC/isfcavgam.F90
deleted file mode 100644
index 6c0ac2a4d94db9b728d48603e65d1d2f31f548ef..0000000000000000000000000000000000000000
--- a/tests/ISOMIP+/MY_SRC/isfcavgam.F90
+++ /dev/null
@@ -1,253 +0,0 @@
-MODULE isfcavgam
- !!======================================================================
- !! *** MODULE isfgammats ***
- !! Ice shelf gamma module : compute exchange coeficient at the ice/ocean interface
- !!======================================================================
- !! History : 4.1 ! (P. Mathiot) original
- !!----------------------------------------------------------------------
-
- !!----------------------------------------------------------------------
- !! isfcav_gammats : compute exchange coeficient gamma
- !!----------------------------------------------------------------------
- USE isf_oce
- USE isfutils, ONLY: debug
- USE isftbl , ONLY: isf_tbl
-
- USE oce , ONLY: uu, vv ! ocean dynamics
- USE phycst , ONLY: grav, vkarmn ! physical constant
- USE eosbn2 , ONLY: eos_rab ! equation of state
- USE zdfdrg , ONLY: rCd0_top, r_ke0_top ! vertical physics: top/bottom drag coef.
- USE iom , ONLY: iom_put !
- USE lib_mpp , ONLY: ctl_stop
-
- USE dom_oce ! ocean space and time domain
- USE in_out_manager ! I/O manager
- !
- IMPLICIT NONE
- !
- PRIVATE
- !
- PUBLIC isfcav_gammats
-
- !! * Substitutions
-# include "do_loop_substitute.h90"
-# include "domzgr_substitute.h90"
- !!----------------------------------------------------------------------
- !! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: sbcisf.F90 10536 2019-01-16 19:21:09Z mathiot $
- !! Software governed by the CeCILL license (see ./LICENSE)
- !!----------------------------------------------------------------------
-CONTAINS
- !
- !!-----------------------------------------------------------------------------------------------------
- !! PUBLIC SUBROUTINES
- !!-----------------------------------------------------------------------------------------------------
- !
- SUBROUTINE isfcav_gammats( Kmm, pttbl, pstbl, pqoce, pqfwf, pRc, pgt, pgs )
- !!----------------------------------------------------------------------
- !! ** Purpose : compute the coefficient echange for heat and fwf flux
- !!
- !! ** Method : select the gamma formulation
- !! 3 method available (cst, vel and vel_stab)
- !!---------------------------------------------------------------------
- !!-------------------------- OUT -------------------------------------
- REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: pgt , pgs ! gamma t and gamma s
- !!-------------------------- IN -------------------------------------
- INTEGER :: Kmm ! ocean time level index
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pqoce, pqfwf ! isf heat and fwf
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pttbl, pstbl ! top boundary layer tracer
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pRc ! Richardson number
- !!---------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj) :: zutbl, zvtbl ! top boundary layer velocity
- !!---------------------------------------------------------------------
- !
- !==========================================
- ! 1.: compute velocity in the tbl if needed
- !==========================================
- !
- SELECT CASE ( cn_gammablk )
- CASE ( 'spe' )
- ! gamma is constant (specified in namelist)
- ! nothing to do
- CASE ('vel', 'vel_stab')
- ! compute velocity in tbl
- CALL isf_tbl(Kmm, uu(:,:,:,Kmm) ,zutbl(:,:),'U', miku, rhisf_tbl_cav)
- CALL isf_tbl(Kmm, vv(:,:,:,Kmm) ,zvtbl(:,:),'V', mikv, rhisf_tbl_cav)
- !
- ! mask velocity in tbl with ice shelf mask
- zutbl(:,:) = zutbl(:,:) * mskisf_cav(:,:)
- zvtbl(:,:) = zvtbl(:,:) * mskisf_cav(:,:)
- !
- ! output
- CALL iom_put('utbl',zutbl(:,:))
- CALL iom_put('vtbl',zvtbl(:,:))
- CASE DEFAULT
- CALL ctl_stop('STOP','method to compute gamma (cn_gammablk) is unknown (should not see this)')
- END SELECT
- !
- !==========================================
- ! 2.: compute gamma
- !==========================================
- !
- SELECT CASE ( cn_gammablk )
- CASE ( 'spe' ) ! gamma is constant (specified in namelist)
- pgt(:,:) = rn_gammat0
- pgs(:,:) = rn_gammas0
- CASE ( 'vel' ) ! gamma is proportional to u*
- CALL gammats_vel ( zutbl, zvtbl, rCd0_top, r_ke0_top, pgt, pgs )
- CASE ( 'vel_stab' ) ! gamma depends of stability of boundary layer and u*
- CALL gammats_vel_stab (Kmm, pttbl, pstbl, zutbl, zvtbl, rCd0_top, r_ke0_top, pqoce, pqfwf, pRc, pgt, pgs )
- CASE DEFAULT
- CALL ctl_stop('STOP','method to compute gamma (cn_gammablk) is unknown (should not see this)')
- END SELECT
- !
- !==========================================
- ! 3.: output and debug
- !==========================================
- !
- CALL iom_put('isfgammat', pgt(:,:))
- CALL iom_put('isfgammas', pgs(:,:))
- !
- IF (ln_isfdebug) THEN
- CALL debug( 'isfcav_gam pgt:', pgt(:,:) )
- CALL debug( 'isfcav_gam pgs:', pgs(:,:) )
- END IF
- !
- END SUBROUTINE isfcav_gammats
- !
- !!-----------------------------------------------------------------------------------------------------
- !! PRIVATE SUBROUTINES
- !!-----------------------------------------------------------------------------------------------------
- !
- SUBROUTINE gammats_vel( putbl, pvtbl, pCd, pke2, & ! <<== in
- & pgt, pgs ) ! ==>> out gammats [m/s]
- !!----------------------------------------------------------------------
- !! ** Purpose : compute the coefficient echange coefficient
- !!
- !! ** Method : gamma is velocity dependent ( gt= gt0 * Ustar )
- !!
- !! ** Reference : Asay-Davis et al., Geosci. Model Dev., 9, 2471-2497, 2016
- !!---------------------------------------------------------------------
- !!-------------------------- OUT -------------------------------------
- REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: pgt, pgs ! gammat and gammas [m/s]
- !!-------------------------- IN -------------------------------------
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: putbl, pvtbl ! velocity in the losch top boundary layer
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pCd ! drag coefficient
- REAL(wp), INTENT(in ) :: pke2 ! background velocity
- !!---------------------------------------------------------------------
- INTEGER :: ji, jj ! loop index
- REAL(wp), DIMENSION(jpi,jpj) :: zustar
- !!---------------------------------------------------------------------
- !
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- ! compute ustar (AD15 eq. 27)
- zustar(ji,jj) = SQRT( pCd(ji,jj) * ( putbl(ji,jj) * putbl(ji,jj) + pvtbl(ji,jj) * pvtbl(ji,jj) + pke2 ) ) * mskisf_cav(ji,jj)
- !
- ! Compute gammats
- pgt(ji,jj) = zustar(ji,jj) * rn_gammat0
- pgs(ji,jj) = zustar(ji,jj) * rn_gammas0
- END_2D
- !
- ! output ustar
- CALL iom_put('isfustar',zustar(:,:))
- !
- END SUBROUTINE gammats_vel
-
- SUBROUTINE gammats_vel_stab( Kmm, pttbl, pstbl, putbl, pvtbl, pCd, pke2, pqoce, pqfwf, pRc, & ! <<== in
- & pgt , pgs ) ! ==>> out gammats [m/s]
- !!----------------------------------------------------------------------
- !! ** Purpose : compute the coefficient echange coefficient
- !!
- !! ** Method : gamma is velocity dependent and stability dependent
- !!
- !! ** Reference : Holland and Jenkins, 1999, JPO, p1787-1800
- !!---------------------------------------------------------------------
- !!-------------------------- OUT -------------------------------------
- REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: pgt, pgs ! gammat and gammas
- !!-------------------------- IN -------------------------------------
- INTEGER :: Kmm ! ocean time level index
- REAL(wp), INTENT(in ) :: pke2 ! background velocity squared
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pqoce, pqfwf ! surface heat flux and fwf flux
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pCd ! drag coeficient
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: putbl, pvtbl ! velocity in the losch top boundary layer
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pttbl, pstbl ! tracer in the losch top boundary layer
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pRc ! Richardson number
- !!---------------------------------------------------------------------
- INTEGER :: ji, jj ! loop index
- INTEGER :: ikt ! local integer
- REAL(wp) :: zdku, zdkv ! U, V shear
- REAL(wp) :: zPr, zSc ! Prandtl and Scmidth number
- REAL(wp) :: zmob, zmols ! Monin Obukov length, coriolis factor at T point
- REAL(wp) :: zbuofdep, zhnu ! Bouyancy length scale, sublayer tickness
- REAL(wp) :: zhmax ! limitation of mol
- REAL(wp) :: zetastar ! stability parameter
- REAL(wp) :: zgmolet, zgmoles, zgturb ! contribution of modelecular sublayer and turbulence
- REAL(wp) :: zcoef ! temporary coef
- REAL(wp) :: zdep
- REAL(wp) :: zeps = 1.0e-20_wp
- REAL(wp), PARAMETER :: zxsiN = 0.052_wp ! dimensionless constant
- REAL(wp), PARAMETER :: znu = 1.95e-6_wp ! kinamatic viscosity of sea water (m2.s-1)
- REAL(wp), DIMENSION(2) :: zts, zab
- REAL(wp), DIMENSION(jpi,jpj) :: zustar ! friction velocity
- !!---------------------------------------------------------------------
- !
- ! compute Pr and Sc number (eq ??)
- zPr = 13.8_wp
- zSc = 2432.0_wp
- !
- ! compute gamma mole (eq ??)
- zgmolet = 12.5_wp * zPr ** (2.0/3.0) - 6.0_wp
- zgmoles = 12.5_wp * zSc ** (2.0/3.0) - 6.0_wp
- !
- ! compute gamma
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
-
- ikt = mikt(ji,jj)
-
- ! compute ustar
- zustar(ji,jj) = SQRT( pCd(ji,jj) * ( putbl(ji,jj) * putbl(ji,jj) + pvtbl(ji,jj) * pvtbl(ji,jj) + pke2 ) )
-
- IF( zustar(ji,jj) == 0._wp ) THEN ! only for kt = 1 I think
- pgt(ji,jj) = rn_gammat0
- pgs(ji,jj) = rn_gammas0
- ELSE
- ! compute bouyancy
- zts(jp_tem) = pttbl(ji,jj)
- zts(jp_sal) = pstbl(ji,jj)
- zdep = gdepw(ji,jj,ikt,Kmm)
- !
- CALL eos_rab( zts, zdep, zab, Kmm )
- !
- ! compute length scale (Eq ??)
- zbuofdep = grav * ( zab(jp_tem) * pqoce(ji,jj) - zab(jp_sal) * pqfwf(ji,jj) )
- !
- ! compute Monin Obukov Length
- ! Maximum boundary layer depth (Eq ??)
- zhmax = gdept(ji,jj,mbkt(ji,jj),Kmm) - gdepw(ji,jj,mikt(ji,jj),Kmm) -0.001_wp
- !
- ! Compute Monin obukhov length scale at the surface and Ekman depth: (Eq ??)
- zmob = zustar(ji,jj) ** 3 / (vkarmn * (zbuofdep + zeps))
- zmols = SIGN(1._wp, zmob) * MIN(ABS(zmob), zhmax) * tmask(ji,jj,ikt)
- !
- ! compute eta* (stability parameter) (Eq ??)
- zetastar = 1._wp / ( SQRT(1._wp + MAX( 0._wp, zxsiN * zustar(ji,jj) &
- & / MAX( 1.e-20, ABS(ff_t(ji,jj)) * zmols * pRc(ji,jj) ) )))
- !
- ! compute the sublayer thickness (Eq ??)
- zhnu = 5 * znu / MAX( 1.e-20, zustar(ji,jj) )
- !
- ! compute gamma turb (Eq ??)
- zgturb = 1._wp / vkarmn * LOG(zustar(ji,jj) * zxsiN * zetastar * zetastar / MAX( 1.e-10, ABS(ff_t(ji,jj)) * zhnu )) &
- & + 1._wp / ( 2 * zxsiN * zetastar ) - 1._wp / vkarmn
- !
- ! compute gammats
- pgt(ji,jj) = zustar(ji,jj) / (zgturb + zgmolet)
- pgs(ji,jj) = zustar(ji,jj) / (zgturb + zgmoles)
- END IF
- END_2D
- ! output ustar
- CALL iom_put('isfustar',zustar(:,:))
-
- END SUBROUTINE gammats_vel_stab
-
-END MODULE isfcavgam
diff --git a/tests/ISOMIP+/MY_SRC/isfstp.F90 b/tests/ISOMIP+/MY_SRC/isfstp.F90
deleted file mode 100644
index 2ab920844a3af8cf4afda88d68297208ce312358..0000000000000000000000000000000000000000
--- a/tests/ISOMIP+/MY_SRC/isfstp.F90
+++ /dev/null
@@ -1,322 +0,0 @@
-MODULE isfstp
- !!======================================================================
- !! *** MODULE isfstp ***
- !! Ice Shelves : compute iceshelf load, melt and heat flux
- !!======================================================================
- !! History : 3.2 ! 2011-02 (C.Harris ) Original code isf cav
- !! X.X ! 2006-02 (C. Wang ) Original code bg03
- !! 3.4 ! 2013-03 (P. Mathiot) Merging + parametrization
- !! 4.1 ! 2019-09 (P. Mathiot) Split param/explicit ice shelf and re-organisation
- !!----------------------------------------------------------------------
-
- !!----------------------------------------------------------------------
- !! isfstp : compute iceshelf melt and heat flux
- !!----------------------------------------------------------------------
- USE isf_oce ! isf variables
- USE isfload, ONLY: isf_load ! ice shelf load
- USE isftbl , ONLY: isf_tbl_lvl ! ice shelf boundary layer
- USE isfpar , ONLY: isf_par, isf_par_init ! ice shelf parametrisation
- USE isfcav , ONLY: isf_cav, isf_cav_init ! ice shelf cavity
- USE isfcpl , ONLY: isfcpl_rst_write, isfcpl_init ! isf variables
-
- USE dom_oce ! ocean space and time domain
- USE oce , ONLY: ssh ! sea surface height
- USE domvvl, ONLY: ln_vvl_zstar ! zstar logical
- USE zdfdrg, ONLY: r_Cdmin_top, r_ke0_top ! vertical physics: top/bottom drag coef.
- !
- USE lib_mpp, ONLY: ctl_stop, ctl_nam
- USE fldread, ONLY: FLD, FLD_N
- USE in_out_manager ! I/O manager
- USE timing
-
- IMPLICIT NONE
- PRIVATE
-
- PUBLIC isf_stp, isf_init, isf_nam ! routine called in sbcmod and divhor
-
- !! * Substitutions
-# include "domzgr_substitute.h90"
- !!----------------------------------------------------------------------
- !! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: isfstp.F90 15574 2021-12-03 19:32:50Z techene $
- !! Software governed by the CeCILL license (see ./LICENSE)
- !!----------------------------------------------------------------------
-CONTAINS
-
- SUBROUTINE isf_stp( kt, Kmm )
- !!---------------------------------------------------------------------
- !! *** ROUTINE isf_stp ***
- !!
- !! ** Purpose : compute total heat flux and total fwf due to ice shelf melt
- !!
- !! ** Method : For each case (parametrisation or explicity cavity) :
- !! - define the before fields
- !! - compute top boundary layer properties
- !! (in case of parametrisation, this is the
- !! depth range model array used to compute mean far fields properties)
- !! - compute fluxes
- !! - write restart variables
- !!----------------------------------------------------------------------
- INTEGER, INTENT(in) :: kt ! ocean time step
- INTEGER, INTENT(in) :: Kmm ! ocean time level index
- !
- INTEGER :: jk ! loop index
-#if defined key_qco
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t ! 3D workspace
-#endif
- !!---------------------------------------------------------------------
- !
- IF( ln_timing ) CALL timing_start('isf')
- !
- !=======================================================================
- ! 1.: compute melt and associated heat fluxes in the ice shelf cavities
- !=======================================================================
- !
- IF ( ln_isfcav_mlt ) THEN
- !
- ! 1.1: before time step
- IF ( kt /= nit000 ) THEN
- risf_cav_tsc_b (:,:,:) = risf_cav_tsc (:,:,:)
- fwfisf_cav_b(:,:) = fwfisf_cav(:,:)
- END IF
- !
- ! 1.2: compute misfkb, rhisf_tbl, rfrac (deepest level, thickness, fraction of deepest cell affected by tbl)
- rhisf_tbl_cav(:,:) = rn_htbl * mskisf_cav(:,:)
-#if defined key_qco
- DO jk = 1, jpk
- ze3t(:,:,jk) = e3t(:,:,jk,Kmm)
- END DO
- CALL isf_tbl_lvl( ht(:,:), ze3t , misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav )
-#else
- CALL isf_tbl_lvl( ht(:,:), e3t(:,:,:,Kmm), misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav )
-#endif
- !
- ! 1.3: compute ice shelf melt
- CALL isf_cav( kt, Kmm, risf_cav_tsc, fwfisf_cav )
- !
- END IF
- !
- !=================================================================================
- ! 2.: compute melt and associated heat fluxes for not resolved ice shelf cavities
- !=================================================================================
- !
- IF ( ln_isfpar_mlt ) THEN
- !
- ! 2.1: before time step
- IF ( kt /= nit000 ) THEN
- risf_par_tsc_b(:,:,:) = risf_par_tsc(:,:,:)
- fwfisf_par_b (:,:) = fwfisf_par (:,:)
- END IF
- !
- ! 2.2: compute misfkb, rhisf_tbl, rfrac (deepest level, thickness, fraction of deepest cell affected by tbl)
- ! by simplicity, we assume the top level where param applied do not change with time (done in init part)
- rhisf_tbl_par(:,:) = rhisf0_tbl_par(:,:)
-#if defined key_qco
- DO jk = 1, jpk
- ze3t(:,:,jk) = e3t(:,:,jk,Kmm)
- END DO
- CALL isf_tbl_lvl( ht(:,:), ze3t , misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par )
-#else
- CALL isf_tbl_lvl( ht(:,:), e3t(:,:,:,Kmm), misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par )
-#endif
- !
- ! 2.3: compute ice shelf melt
- CALL isf_par( kt, Kmm, risf_par_tsc, fwfisf_par )
- !
- END IF
- !
- !==================================================================================
- ! 3.: output specific restart variable in case of coupling with an ice sheet model
- !==================================================================================
- !
- IF ( ln_isfcpl .AND. lrst_oce ) CALL isfcpl_rst_write(kt, Kmm)
- !
- IF( ln_timing ) CALL timing_stop('isf')
- !
- END SUBROUTINE isf_stp
-
-
- SUBROUTINE isf_init( Kbb, Kmm, Kaa )
- !!---------------------------------------------------------------------
- !! *** ROUTINE isfstp_init ***
- !!
- !! ** Purpose : Initialisation of the ice shelf public variables
- !!
- !! ** Method : Read the namisf namelist, check option compatibility and set derived parameters
- !!
- !! ** Action : - read namisf parameters
- !! - allocate memory
- !! - output print
- !! - ckeck option compatibility
- !! - call cav/param/isfcpl init routine
- !!----------------------------------------------------------------------
- INTEGER, INTENT(in) :: Kbb, Kmm, Kaa ! ocean time level indices
- !!----------------------------------------------------------------------
- !
- ! constrain: l_isfoasis need to be known
- !
- CALL isf_nam() ! Read namelist
- !
- CALL isf_alloc() ! Allocate public array
- !
- CALL isf_ctl() ! check option compatibility
- !
- IF( ln_isfcav ) CALL isf_load( Kmm, risfload ) ! compute ice shelf load
- !
- ! terminate routine now if no ice shelf melt formulation specify
- IF( ln_isf ) THEN
- !
- IF( ln_isfcav_mlt ) CALL isf_cav_init() ! initialisation melt in the cavity
- !
- IF( ln_isfpar_mlt ) CALL isf_par_init() ! initialisation parametrised melt
- !
- IF( ln_isfcpl ) CALL isfcpl_init( Kbb, Kmm, Kaa ) ! initialisation ice sheet coupling
- !
- END IF
-
- END SUBROUTINE isf_init
-
-
- SUBROUTINE isf_ctl()
- !!---------------------------------------------------------------------
- !! *** ROUTINE isf_ctl ***
- !!
- !! ** Purpose : output print and option compatibility check
- !!
- !!----------------------------------------------------------------------
- IF (lwp) THEN
- WRITE(numout,*)
- WRITE(numout,*) 'isf_init : ice shelf initialisation'
- WRITE(numout,*) '~~~~~~~~~~~~'
- WRITE(numout,*) ' Namelist namisf :'
- !
- WRITE(numout,*) ' ice shelf cavity (open or parametrised) ln_isf = ', ln_isf
- WRITE(numout,*)
- !
- IF ( ln_isf ) THEN
-#if key_qco
-# if ! defined key_isf
- CALL ctl_stop( 'STOP', 'isf_ctl: ice shelf requires both ln_isf=T AND key_isf activated' )
-# endif
-#endif
- WRITE(numout,*) ' Add debug print in isf module ln_isfdebug = ', ln_isfdebug
- WRITE(numout,*)
- WRITE(numout,*) ' melt inside the cavity ln_isfcav_mlt = ', ln_isfcav_mlt
- IF ( ln_isfcav_mlt) THEN
- WRITE(numout,*) ' melt formulation cn_isfcav_mlt= ', TRIM(cn_isfcav_mlt)
- WRITE(numout,*) ' thickness of the top boundary layer rn_htbl = ', rn_htbl
- WRITE(numout,*) ' gamma formulation cn_gammablk = ', TRIM(cn_gammablk)
- IF ( TRIM(cn_gammablk) .NE. 'spe' ) THEN
- WRITE(numout,*) ' gammat coefficient rn_gammat0 = ', rn_gammat0
- WRITE(numout,*) ' gammas coefficient rn_gammas0 = ', rn_gammas0
- WRITE(numout,*) ' top background ke used (from namdrg_top) rn_ke0 = ', r_ke0_top
- WRITE(numout,*) ' top drag coef. used (from namdrg_top) rn_Cd0 = ', r_Cdmin_top
- END IF
- END IF
- WRITE(numout,*) ''
- !
- WRITE(numout,*) ' ice shelf melt parametrisation ln_isfpar_mlt = ', ln_isfpar_mlt
- IF ( ln_isfpar_mlt ) THEN
- WRITE(numout,*) ' isf parametrisation formulation cn_isfpar_mlt = ', TRIM(cn_isfpar_mlt)
- END IF
- WRITE(numout,*) ''
- !
- WRITE(numout,*) ' Coupling to an ice sheet model ln_isfcpl = ', ln_isfcpl
- IF ( ln_isfcpl ) THEN
- WRITE(numout,*) ' conservation activated ln_isfcpl_cons = ', ln_isfcpl_cons
- WRITE(numout,*) ' number of call of the extrapolation loop = ', nn_drown
- ENDIF
- WRITE(numout,*) ''
- !
- ELSE
- !
- IF ( ln_isfcav ) THEN
- WRITE(numout,*) ''
- WRITE(numout,*) ' W A R N I N G: ice shelf cavities are open BUT no melt will be computed or read from file !'
- WRITE(numout,*) ''
- END IF
- !
- END IF
-
- IF (ln_isfcav) THEN
- WRITE(numout,*) ' Ice shelf load method cn_isfload = ', TRIM(cn_isfload)
- WRITE(numout,*) ' Temperature used to compute the ice shelf load = ', rn_isfload_T
- WRITE(numout,*) ' Salinity used to compute the ice shelf load = ', rn_isfload_S
- END IF
- WRITE(numout,*) ''
- FLUSH(numout)
-
- END IF
- !
-
- !---------------------------------------------------------------------------------------------------------------------
- ! sanity check ! issue ln_isfcav not yet known as well as l_isfoasis => move this call in isf_stp ?
- ! melt in the cavity without cavity
- IF ( ln_isfcav_mlt .AND. (.NOT. ln_isfcav) ) &
- & CALL ctl_stop('ice shelf melt in the cavity activated (ln_isfcav_mlt) but no cavity detected in domcfg (ln_isfcav), STOP' )
- !
- ! ice sheet coupling without cavity
- IF ( ln_isfcpl .AND. (.NOT. ln_isfcav) ) &
- & CALL ctl_stop('coupling with an ice sheet model detected (ln_isfcpl) but no cavity detected in domcfg (ln_isfcav), STOP' )
- !
- IF ( ln_isfcpl .AND. ln_isfcpl_cons .AND. ln_linssh ) &
- & CALL ctl_stop( 'The coupling between NEMO and an ice sheet model with the conservation option does not work with the linssh option' )
- !
- IF ( l_isfoasis .AND. .NOT. ln_isf ) CALL ctl_stop( ' OASIS send ice shelf fluxes to NEMO but NEMO does not have the isf module activated' )
- !
- IF ( l_isfoasis .AND. ln_isf ) THEN
- !
- CALL ctl_stop( 'namelist combination ln_cpl and ln_isf not tested' )
- !
- ! NEMO coupled to ATMO model with isf cavity need oasis method for melt computation
- IF ( ln_isfcav_mlt .AND. TRIM(cn_isfcav_mlt) /= 'oasis' ) CALL ctl_stop( 'cn_isfcav_mlt = oasis is the only option availble if fwf send by oasis' )
- IF ( ln_isfpar_mlt .AND. TRIM(cn_isfpar_mlt) /= 'oasis' ) CALL ctl_stop( 'cn_isfpar_mlt = oasis is the only option availble if fwf send by oasis' )
- !
- ! oasis melt computation not tested (coded but not tested)
- IF ( ln_isfcav_mlt .OR. ln_isfpar_mlt ) THEN
- IF ( TRIM(cn_isfcav_mlt) == 'oasis' ) CALL ctl_stop( 'cn_isfcav_mlt = oasis not tested' )
- IF ( TRIM(cn_isfpar_mlt) == 'oasis' ) CALL ctl_stop( 'cn_isfpar_mlt = oasis not tested' )
- END IF
- !
- ! oasis melt computation with cavity open and cavity parametrised (not coded)
- IF ( ln_isfcav_mlt .AND. ln_isfpar_mlt ) THEN
- IF ( TRIM(cn_isfpar_mlt) == 'oasis' .AND. TRIM(cn_isfcav_mlt) == 'oasis' ) CALL ctl_stop( 'cn_isfpar_mlt = oasis and cn_isfcav_mlt = oasis not coded' )
- END IF
- !
- ! compatibility ice shelf and vvl
- IF( .NOT. ln_vvl_zstar .AND. ln_isf ) CALL ctl_stop( 'Only vvl_zstar has been tested with ice shelf cavity' )
- !
- END IF
- END SUBROUTINE isf_ctl
-
-
- SUBROUTINE isf_nam
- !!---------------------------------------------------------------------
- !! *** ROUTINE isf_nam ***
- !!
- !! ** Purpose : Read ice shelf namelist cfg and ref
- !!
- !!----------------------------------------------------------------------
- INTEGER :: ios ! Local integer output status for namelist read
- !!----------------------------------------------------------------------
- NAMELIST/namisf/ ln_isf , &
- & cn_gammablk , rn_gammat0 , rn_gammas0 , rn_htbl, sn_isfcav_fwf, &
- & ln_isfcav_mlt , cn_isfcav_mlt , sn_isfcav_fwf , &
- & ln_isfpar_mlt , cn_isfpar_mlt , sn_isfpar_fwf , &
- & sn_isfpar_zmin, sn_isfpar_zmax, sn_isfpar_Leff, &
- & ln_isfcpl , nn_drown , ln_isfcpl_cons, ln_isfdebug, &
- & cn_isfload , rn_isfload_T , rn_isfload_S , cn_isfdir , &
- & rn_isfpar_bg03_gt0
- !!----------------------------------------------------------------------
- !
- READ ( numnam_ref, namisf, IOSTAT = ios, ERR = 901)
-901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namisf in reference namelist' )
- !
- READ ( numnam_cfg, namisf, IOSTAT = ios, ERR = 902 )
-902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namisf in configuration namelist' )
- IF(lwm) WRITE ( numond, namisf )
-
- END SUBROUTINE isf_nam
- !!
- !!======================================================================
-END MODULE isfstp
diff --git a/tests/ISOMIP+/MY_SRC/istate.F90 b/tests/ISOMIP+/MY_SRC/istate.F90
index 0f32b25a96257355ffeb7d9dd22781306a3a860a..f8cdc262762b1924cd952399e213ad6faabb5a5a 100644
--- a/tests/ISOMIP+/MY_SRC/istate.F90
+++ b/tests/ISOMIP+/MY_SRC/istate.F90
@@ -50,7 +50,7 @@ MODULE istate
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: istate.F90 15581 2021-12-07 13:08:22Z techene $
+ !! $Id: istate.F90 14991 2021-06-14 19:52:31Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
@@ -79,10 +79,12 @@ CONTAINS
CALL dta_tsd_init ! Initialisation of T & S input data
IF( ln_c1d) CALL dta_uvd_init ! Initialisation of U & V input data (c1d only)
- rhd (:,:,: ) = 0._wp ; rhop (:,:,: ) = 0._wp ! set one for all to 0 at level jpk
- rn2b (:,:,: ) = 0._wp ; rn2 (:,:,: ) = 0._wp ! set one for all to 0 at levels 1 and jpk
- ts (:,:,:,:,Kaa) = 0._wp ! set one for all to 0 at level jpk
- rab_b(:,:,:,: ) = 0._wp ; rab_n(:,:,:,:) = 0._wp ! set one for all to 0 at level jpk
+ ts (:,:,:,:,Kaa) = 0._wp ; rn2 (:,:,: ) = 0._wp ! set one for all to 0 at levels 1 and jpk
+ IF ( ALLOCATED( rhd ) ) THEN ! SWE, for example, will not have allocated these
+ rhd (:,:,: ) = 0._wp ; rhop (:,:,: ) = 0._wp ! set one for all to 0 at level jpk
+ rn2b (:,:,: ) = 0._wp ! set one for all to 0 at level jpk
+ rab_b(:,:,:,: ) = 0._wp ; rab_n(:,:,:,:) = 0._wp ! set one for all to 0 at level jpk
+ ENDIF
#if defined key_agrif
uu (:,:,: ,Kaa) = 0._wp ! used in agrif_oce_sponge at initialization
vv (:,:,: ,Kaa) = 0._wp ! used in agrif_oce_sponge at initialization
@@ -113,7 +115,7 @@ CONTAINS
! ! Initialization of ocean to zero
!
IF( ln_tsd_init ) THEN
- CALL dta_tsd( nit000, 'ini', ts(:,:,:,:,Kbb) ) ! read 3D T and S data at nit000
+ CALL dta_tsd( nit000, ts(:,:,:,:,Kbb), 'ini' ) ! read 3D T and S data at nit000
ENDIF
!
IF( ln_uvd_init .AND. ln_c1d ) THEN
@@ -141,20 +143,6 @@ CONTAINS
ENDIF
#endif
!
- ! Initialize "now" barotropic velocities:
- ! Do it whatever the free surface method, these arrays being used eventually
- !
-!!gm the use of umask & vmask is not necessary below as uu(:,:,:,Kmm), vv(:,:,:,Kmm), uu(:,:,:,Kbb), vv(:,:,:,Kbb) are always masked
-#if ! defined key_RK3
- uu_b(:,:,Kmm) = 0._wp ; vv_b(:,:,Kmm) = 0._wp
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
- uu_b(ji,jj,Kmm) = uu_b(ji,jj,Kmm) + e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * umask(ji,jj,jk)
- vv_b(ji,jj,Kmm) = vv_b(ji,jj,Kmm) + e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * vmask(ji,jj,jk)
- END_3D
- uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * r1_hu(:,:,Kmm)
- vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * r1_hv(:,:,Kmm)
-#endif
- !
#if defined key_RK3
IF( .NOT. ln_rstart ) THEN
#endif
@@ -171,6 +159,25 @@ CONTAINS
!
#if defined key_RK3
ENDIF
+#endif
+ !
+ ! Initialize "now" barotropic velocities:
+ ! Do it whatever the free surface method, these arrays being used eventually
+ !
+#if defined key_RK3
+ IF( .NOT. ln_rstart ) THEN
+ uu_b(:,:,Kmm) = uu_b(:,:,Kbb) ! Kmm value set to Kbb for initialisation in Agrif_Regrid in namo_gcm
+ vv_b(:,:,Kmm) = vv_b(:,:,Kbb)
+ ENDIF
+#else
+!!gm the use of umask & vmask is not necessary below as uu(:,:,:,Kmm), vv(:,:,:,Kmm), uu(:,:,:,Kbb), vv(:,:,:,Kbb) are always masked
+ uu_b(:,:,Kmm) = 0._wp ; vv_b(:,:,Kmm) = 0._wp
+ DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
+ uu_b(ji,jj,Kmm) = uu_b(ji,jj,Kmm) + e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * umask(ji,jj,jk)
+ vv_b(ji,jj,Kmm) = vv_b(ji,jj,Kmm) + e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * vmask(ji,jj,jk)
+ END_3D
+ uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * r1_hu(:,:,Kmm)
+ vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * r1_hv(:,:,Kmm)
#endif
!
END SUBROUTINE istate_init
diff --git a/tests/ISOMIP+/MY_SRC/sbcfwb.F90 b/tests/ISOMIP+/MY_SRC/sbcfwb.F90
deleted file mode 100644
index 0102aa12740247e044537fa78f63c58149b73414..0000000000000000000000000000000000000000
--- a/tests/ISOMIP+/MY_SRC/sbcfwb.F90
+++ /dev/null
@@ -1,277 +0,0 @@
-MODULE sbcfwb
- !!======================================================================
- !! *** MODULE sbcfwb ***
- !! Ocean fluxes : domain averaged freshwater budget
- !!======================================================================
- !! History : OPA ! 2001-02 (E. Durand) Original code
- !! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module
- !! 3.0 ! 2006-08 (G. Madec) Surface module
- !! 3.2 ! 2009-07 (C. Talandier) emp mean s spread over erp area
- !! 3.6 ! 2014-11 (P. Mathiot ) add ice shelf melting
- !!----------------------------------------------------------------------
-
- !!----------------------------------------------------------------------
- !! sbc_fwb : freshwater budget for global ocean configurations (free surface & forced mode)
- !!----------------------------------------------------------------------
- USE oce ! ocean dynamics and tracers
- USE dom_oce ! ocean space and time domain
- USE sbc_oce ! surface ocean boundary condition
- USE isf_oce , ONLY : fwfisf_cav, fwfisf_par, ln_isfcpl, ln_isfcpl_cons, risfcpl_cons_ssh ! ice shelf melting contribution
- USE sbc_ice , ONLY : snwice_mass, snwice_mass_b, snwice_fmass
- USE phycst ! physical constants
- USE sbcrnf ! ocean runoffs
- USE sbcssr ! Sea-Surface damping terms
- !
- USE in_out_manager ! I/O manager
- USE iom ! IOM
- USE lib_mpp ! distribued memory computing library
- USE timing ! Timing
- USE lbclnk ! ocean lateral boundary conditions
- USE lib_fortran !
-
- IMPLICIT NONE
- PRIVATE
-
- PUBLIC sbc_fwb ! routine called by step
-
- REAL(wp) :: rn_fwb0 ! initial freshwater adjustment flux [kg/m2/s] (nn_fwb = 2 only)
- REAL(wp) :: a_fwb ! annual domain averaged freshwater budget from the previous year
- REAL(wp) :: a_fwb_b ! annual domain averaged freshwater budget from the year before or at initial state
- REAL(wp) :: a_fwb_ini ! initial domain averaged freshwater budget
- REAL(wp) :: area ! global mean ocean surface (interior domain)
-
- !!----------------------------------------------------------------------
- !! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: sbcfwb.F90 11395 2019-08-02 14:19:00Z mathiot $
- !! Software governed by the CeCILL license (see ./LICENSE)
- !!----------------------------------------------------------------------
-CONTAINS
-
- SUBROUTINE sbc_fwb( kt, kn_fwb, kn_fsbc, Kmm )
- !!---------------------------------------------------------------------
- !! *** ROUTINE sbc_fwb ***
- !!
- !! ** Purpose : Control the mean sea surface drift
- !!
- !! ** Method : several ways depending on kn_fwb
- !! =0 no control
- !! =1 global mean of emp set to zero at each nn_fsbc time step
- !! =2 annual global mean corrected from previous year
- !! =3 global mean of emp set to zero at each nn_fsbc time step
- !! & spread out over erp area depending its sign
- !! Note: if sea ice is embedded it is taken into account when computing the budget
- !!----------------------------------------------------------------------
- INTEGER, INTENT( in ) :: kt ! ocean time-step index
- INTEGER, INTENT( in ) :: kn_fsbc !
- INTEGER, INTENT( in ) :: kn_fwb ! ocean time-step index
- INTEGER, INTENT( in ) :: Kmm ! ocean time level index
- !
- INTEGER :: ios, inum, ikty ! local integers
- REAL(wp) :: z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp ! local scalars
- REAL(wp) :: zsurf_neg, zsurf_pos, zsurf_tospread, zcoef ! - -
- REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ztmsk_neg, ztmsk_pos, z_wgt ! 2D workspaces
- REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ztmsk_tospread, zerp_cor ! - -
- REAL(wp) ,DIMENSION(1) :: z_fwfprv
- COMPLEX(dp),DIMENSION(1) :: y_fwfnow
- !
- NAMELIST/namsbc_fwb/rn_fwb0
- !!----------------------------------------------------------------------
- !
- IF( kt == nit000 ) THEN
- READ( numnam_ref, namsbc_fwb, IOSTAT = ios, ERR = 901 )
-901 IF( ios /= 0 ) CALL ctl_nam( ios, 'namsbc_fwb in reference namelist' )
- READ( numnam_cfg, namsbc_fwb, IOSTAT = ios, ERR = 902 )
-902 IF( ios > 0 ) CALL ctl_nam( ios, 'namsbc_fwb in configuration namelist' )
- IF(lwm) WRITE( numond, namsbc_fwb )
- IF(lwp) THEN
- WRITE(numout,*)
- WRITE(numout,*) 'sbc_fwb : FreshWater Budget correction'
- WRITE(numout,*) '~~~~~~~'
- IF( kn_fwb == 1 ) WRITE(numout,*) ' instantaneously set to zero'
- IF( kn_fwb == 4 ) WRITE(numout,*) ' instantaneously set to zero with heat and salt flux correction (ISOMIP+)'
- IF( kn_fwb == 3 ) WRITE(numout,*) ' fwf set to zero and spread out over erp area'
- IF( kn_fwb == 2 ) THEN
- WRITE(numout,*) ' adjusted from previous year budget'
- WRITE(numout,*)
- WRITE(numout,*) ' Namelist namsbc_fwb'
- WRITE(numout,*) ' Initial freshwater adjustment flux [kg/m2/s] = ', rn_fwb0
- END IF
- ENDIF
- !
- IF( kn_fwb == 3 .AND. nn_sssr /= 2 ) CALL ctl_stop( 'sbc_fwb: nn_fwb = 3 requires nn_sssr = 2, we stop ' )
- IF( kn_fwb == 3 .AND. ln_isfcav ) CALL ctl_stop( 'sbc_fwb: nn_fwb = 3 with ln_isfcav = .TRUE. not working, we stop ' )
- !
- area = glob_sum( 'sbcfwb', e1e2t(:,:) * tmask(:,:,1)) ! interior global domain surface
- ! isf cavities are excluded because it can feedback to the melting with generation of inhibition of plumes
- ! and in case of no melt, it can generate HSSW.
- !
-#if ! defined key_si3 && ! defined key_cice
- snwice_mass_b(:,:) = 0.e0 ! no sea-ice model is being used : no snow+ice mass
- snwice_mass (:,:) = 0.e0
- snwice_fmass (:,:) = 0.e0
-#endif
- !
- ENDIF
-
- SELECT CASE ( kn_fwb )
- !
- CASE ( 1 ) !== global mean fwf set to zero ==!
- !
- IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN
- y_fwfnow(1) = local_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) - fwfisf_cav(:,:) - fwfisf_par(:,:) - snwice_fmass(:,:) ) )
- CALL mpp_delay_sum( 'sbcfwb', 'fwb', y_fwfnow(:), z_fwfprv(:), kt == nitend - nn_fsbc + 1 )
- z_fwfprv(1) = z_fwfprv(1) / area
- zcoef = z_fwfprv(1) * rcp
- emp(:,:) = emp(:,:) - z_fwfprv(1) * tmask(:,:,1)
- qns(:,:) = qns(:,:) + zcoef * sst_m(:,:) * tmask(:,:,1) ! account for change to the heat budget due to fw correction
- ! outputs
- IF( iom_use('hflx_fwb_cea') ) CALL iom_put( 'hflx_fwb_cea', zcoef * sst_m(:,:) * tmask(:,:,1) )
- IF( iom_use('vflx_fwb_cea') ) CALL iom_put( 'vflx_fwb_cea', z_fwfprv(1) * tmask(:,:,1) )
- ENDIF
- !
- CASE ( 2 ) !== fw adjustment based on fw budget at the end of the previous year ==!
- ! simulation is supposed to start 1st of January
- IF( kt == nit000 ) THEN ! initialisation
- ! ! set the fw adjustment (a_fwb)
- IF ( ln_rstart .AND. iom_varid( numror, 'a_fwb_b', ldstop = .FALSE. ) > 0 & ! as read from restart file
- & .AND. iom_varid( numror, 'a_fwb', ldstop = .FALSE. ) > 0 ) THEN
- IF(lwp) WRITE(numout,*) 'sbc_fwb : reading freshwater-budget from restart file'
- CALL iom_get( numror, 'a_fwb_b', a_fwb_b )
- CALL iom_get( numror, 'a_fwb' , a_fwb )
- !
- a_fwb_ini = a_fwb_b
- ELSE ! as specified in namelist
- IF(lwp) WRITE(numout,*) 'sbc_fwb : setting freshwater-budget from namelist rn_fwb0'
- a_fwb = rn_fwb0
- a_fwb_b = 0._wp ! used only the first year then it is replaced by a_fwb_ini
- !
- a_fwb_ini = glob_sum( 'sbcfwb', e1e2t(:,:) * ( ssh(:,:,Kmm) + snwice_mass(:,:) * r1_rho0 ) ) &
- & * rho0 / ( area * rday * REAL(nyear_len(1), wp) )
- END IF
- !
- IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*)'sbc_fwb : freshwater-budget at the end of previous year = ', a_fwb , 'kg/m2/s'
- IF(lwp) WRITE(numout,*)' freshwater-budget at initial state = ', a_fwb_ini, 'kg/m2/s'
- !
- ELSE
- ! at the end of year n:
- ikty = nyear_len(1) * 86400 / NINT(rn_Dt)
- IF( MOD( kt, ikty ) == 0 ) THEN ! Update a_fwb at the last time step of a year
- ! It should be the first time step of a year MOD(kt-1,ikty) but then the restart would be wrong
- ! Hence, we make a small error here but the code is restartable
- a_fwb_b = a_fwb_ini
- ! mean sea level taking into account ice+snow
- a_fwb = glob_sum( 'sbcfwb', e1e2t(:,:) * ( ssh(:,:,Kmm) + snwice_mass(:,:) * r1_rho0 ) )
- a_fwb = a_fwb * rho0 / ( area * rday * REAL(nyear_len(1), wp) ) ! convert in kg/m2/s
- ENDIF
- !
- ENDIF
- !
- IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN ! correct the freshwater fluxes using previous year budget minus initial state
- zcoef = ( a_fwb - a_fwb_b )
- emp(:,:) = emp(:,:) + zcoef * tmask(:,:,1)
- qns(:,:) = qns(:,:) - zcoef * rcp * sst_m(:,:) * tmask(:,:,1) ! account for change to the heat budget due to fw correction
- ! outputs
- IF( iom_use('hflx_fwb_cea') ) CALL iom_put( 'hflx_fwb_cea', -zcoef * rcp * sst_m(:,:) * tmask(:,:,1) )
- IF( iom_use('vflx_fwb_cea') ) CALL iom_put( 'vflx_fwb_cea', -zcoef * tmask(:,:,1) )
- ENDIF
- ! Output restart information
- IF( lrst_oce ) THEN
- IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*) 'sbc_fwb : writing FW-budget adjustment to ocean restart file at it = ', kt
- IF(lwp) WRITE(numout,*) '~~~~'
- CALL iom_rstput( kt, nitrst, numrow, 'a_fwb_b', a_fwb_b )
- CALL iom_rstput( kt, nitrst, numrow, 'a_fwb', a_fwb )
- END IF
- !
- IF( kt == nitend .AND. lwp ) THEN
- WRITE(numout,*) 'sbc_fwb : freshwater-budget at the end of simulation (year now) = ', a_fwb , 'kg/m2/s'
- WRITE(numout,*) ' freshwater-budget at initial state = ', a_fwb_b, 'kg/m2/s'
- ENDIF
- !
- CASE ( 3 ) !== global fwf set to zero and spread out over erp area ==!
- !
- ALLOCATE( ztmsk_neg(jpi,jpj) , ztmsk_pos(jpi,jpj) , ztmsk_tospread(jpi,jpj) , z_wgt(jpi,jpj) , zerp_cor(jpi,jpj) )
- !
- IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN
- ztmsk_pos(:,:) = tmask_i(:,:) ! Select <0 and >0 area of erp
- WHERE( erp < 0._wp ) ztmsk_pos = 0._wp
- ztmsk_neg(:,:) = tmask_i(:,:) - ztmsk_pos(:,:)
- ! ! fwf global mean (excluding ocean to ice/snow exchanges)
- z_fwf = glob_sum( 'sbcfwb', e1e2t(:,:) * ( emp(:,:) - rnf(:,:) - fwfisf_cav(:,:) - fwfisf_par(:,:) - snwice_fmass(:,:) ) ) / area
- !
- IF( z_fwf < 0._wp ) THEN ! spread out over >0 erp area to increase evaporation
- zsurf_pos = glob_sum( 'sbcfwb', e1e2t(:,:)*ztmsk_pos(:,:) )
- zsurf_tospread = zsurf_pos
- ztmsk_tospread(:,:) = ztmsk_pos(:,:)
- ELSE ! spread out over <0 erp area to increase precipitation
- zsurf_neg = glob_sum( 'sbcfwb', e1e2t(:,:)*ztmsk_neg(:,:) ) ! Area filled by <0 and >0 erp
- zsurf_tospread = zsurf_neg
- ztmsk_tospread(:,:) = ztmsk_neg(:,:)
- ENDIF
- !
- zsum_fwf = glob_sum( 'sbcfwb', e1e2t(:,:) * z_fwf ) ! fwf global mean over <0 or >0 erp area
-!!gm : zsum_fwf = z_fwf * area ??? it is right? I think so....
- z_fwf_nsrf = zsum_fwf / ( zsurf_tospread + rsmall )
- ! ! weight to respect erp field 2D structure
- zsum_erp = glob_sum( 'sbcfwb', ztmsk_tospread(:,:) * erp(:,:) * e1e2t(:,:) )
- z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( zsum_erp + rsmall )
- ! ! final correction term to apply
- zerp_cor(:,:) = -1. * z_fwf_nsrf * zsurf_tospread * z_wgt(:,:)
- !
-!!gm ===>>>> lbc_lnk should be useless as all the computation is done over the whole domain !
- CALL lbc_lnk( 'sbcfwb', zerp_cor, 'T', 1.0_wp )
- !
- emp(:,:) = emp(:,:) + zerp_cor(:,:)
- qns(:,:) = qns(:,:) - zerp_cor(:,:) * rcp * sst_m(:,:) ! account for change to the heat budget due to fw correction
- erp(:,:) = erp(:,:) + zerp_cor(:,:)
- ! outputs
- IF( iom_use('hflx_fwb_cea') ) CALL iom_put( 'hflx_fwb_cea', -zerp_cor(:,:) * rcp * sst_m(:,:) )
- IF( iom_use('vflx_fwb_cea') ) CALL iom_put( 'vflx_fwb_cea', -zerp_cor(:,:) )
- !
- IF( lwp ) THEN ! control print
- IF( z_fwf < 0._wp ) THEN
- WRITE(numout,*)' z_fwf < 0'
- WRITE(numout,*)' SUM(erp+) = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv'
- ELSE
- WRITE(numout,*)' z_fwf >= 0'
- WRITE(numout,*)' SUM(erp-) = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv'
- ENDIF
- WRITE(numout,*)' SUM(empG) = ', SUM( z_fwf*e1e2t(:,:) )*1.e-9,' Sv'
- WRITE(numout,*)' z_fwf = ', z_fwf ,' Kg/m2/s'
- WRITE(numout,*)' z_fwf_nsrf = ', z_fwf_nsrf ,' Kg/m2/s'
- WRITE(numout,*)' MIN(zerp_cor) = ', MINVAL(zerp_cor)
- WRITE(numout,*)' MAX(zerp_cor) = ', MAXVAL(zerp_cor)
- ENDIF
- ENDIF
- DEALLOCATE( ztmsk_neg , ztmsk_pos , ztmsk_tospread , z_wgt , zerp_cor )
- !
- CASE ( 4 ) !== global mean fwf set to zero (ISOMIP case) ==!
- !
- IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN
- z_fwf = glob_sum( 'sbcfwb', e1e2t(:,:) * ( emp(:,:) - rnf(:,:) - fwfisf_cav(:,:) - fwfisf_par(:,:) - snwice_fmass(:,:) ) )
- !
- ! correction for ice sheet coupling testing (ie remove the excess through the surface)
- ! test impact on the melt as conservation correction made in depth
- ! test conservation level as sbcfwb is conserving
- ! avoid the model to blow up for large ssh drop (isomip OCEAN3 with melt switch off and uniform T/S)
- IF (ln_isfcpl .AND. ln_isfcpl_cons) THEN
- z_fwf = z_fwf + glob_sum( 'sbcfwb', e1e2t(:,:) * risfcpl_cons_ssh(:,:) * rho0 )
- END IF
- !
- z_fwf = z_fwf / area
- zcoef = z_fwf * rcp
- emp(:,:) = emp(:,:) - z_fwf * tmask(:,:,1) ! (Eq. 34 AD2015)
- qns(:,:) = qns(:,:) + zcoef * sst_m(:,:) * tmask(:,:,1) ! (Eq. 35 AD2015) ! use sst_m to avoid generation of any bouyancy fluxes
- sfx(:,:) = sfx(:,:) + z_fwf * sss_m(:,:) * tmask(:,:,1) ! (Eq. 36 AD2015) ! use sss_m to avoid generation of any bouyancy fluxes
- ENDIF
- !
- CASE DEFAULT !== you should never be there ==!
- CALL ctl_stop( 'sbc_fwb : wrong nn_fwb value for the FreshWater Budget correction, choose either 1, 2 or 3' )
- !
- END SELECT
- !
- END SUBROUTINE sbc_fwb
-
- !!======================================================================
-END MODULE sbcfwb
diff --git a/tests/ISOMIP+/MY_SRC/tradmp.F90 b/tests/ISOMIP+/MY_SRC/tradmp.F90
deleted file mode 100644
index 05ed5b09aa1bbdcabb8968ffc18dfd51e11f2acb..0000000000000000000000000000000000000000
--- a/tests/ISOMIP+/MY_SRC/tradmp.F90
+++ /dev/null
@@ -1,243 +0,0 @@
-MODULE tradmp
- !!======================================================================
- !! *** MODULE tradmp ***
- !! Ocean physics: internal restoring trend on active tracers (T and S)
- !!======================================================================
- !! History : OPA ! 1991-03 (O. Marti, G. Madec) Original code
- !! ! 1992-06 (M. Imbard) doctor norme
- !! ! 1998-07 (M. Imbard, G. Madec) ORCA version
- !! 7.0 ! 2001-02 (M. Imbard) add distance to coast, Original code
- !! 8.1 ! 2001-02 (G. Madec, E. Durand) cleaning
- !! NEMO 1.0 ! 2002-08 (G. Madec, E. Durand) free form + modules
- !! 3.2 ! 2009-08 (G. Madec, C. Talandier) DOCTOR norm for namelist parameter
- !! 3.3 ! 2010-06 (C. Ethe, G. Madec) merge TRA-TRC
- !! 3.4 ! 2011-04 (G. Madec, C. Ethe) Merge of dtatem and dtasal + suppression of CPP keys
- !! 3.6 ! 2015-06 (T. Graham) read restoring coefficient in a file
- !! 3.7 ! 2015-10 (G. Madec) remove useless trends arrays
- !!----------------------------------------------------------------------
-
- !!----------------------------------------------------------------------
- !! tra_dmp_alloc : allocate tradmp arrays
- !! tra_dmp : update the tracer trend with the internal damping
- !! tra_dmp_init : initialization, namlist read, parameters control
- !!----------------------------------------------------------------------
- USE oce ! ocean: variables
- USE dom_oce ! ocean: domain variables
- USE trd_oce ! trends: ocean variables
- USE trdtra ! trends manager: tracers
- USE zdf_oce ! ocean: vertical physics
- USE phycst ! physical constants
- USE dtatsd ! data: temperature & salinity
- USE zdfmxl ! vertical physics: mixed layer depth
- !
- USE in_out_manager ! I/O manager
- USE iom ! XIOS
- USE lib_mpp ! MPP library
- USE prtctl ! Print control
- USE timing ! Timing
-
- IMPLICIT NONE
- PRIVATE
-
- PUBLIC tra_dmp ! called by step.F90
- PUBLIC tra_dmp_init ! called by nemogcm.F90
-
- ! !!* Namelist namtra_dmp : T & S newtonian damping *
- LOGICAL , PUBLIC :: ln_tradmp !: internal damping flag
- INTEGER , PUBLIC :: nn_zdmp !: = 0/1/2 flag for damping in the mixed layer
- CHARACTER(LEN=200) , PUBLIC :: cn_resto !: name of netcdf file containing restoration coefficient field
- !
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: resto !: restoring coeff. on T and S (s-1)
-
- !! * Substitutions
-# include "do_loop_substitute.h90"
-# include "domzgr_substitute.h90"
- !!----------------------------------------------------------------------
- !! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: tradmp.F90 15574 2021-12-03 19:32:50Z techene $
- !! Software governed by the CeCILL license (see ./LICENSE)
- !!----------------------------------------------------------------------
-CONTAINS
-
- INTEGER FUNCTION tra_dmp_alloc()
- !!----------------------------------------------------------------------
- !! *** FUNCTION tra_dmp_alloc ***
- !!----------------------------------------------------------------------
- ALLOCATE( resto(jpi,jpj,jpk), STAT= tra_dmp_alloc )
- !
- CALL mpp_sum ( 'tradmp', tra_dmp_alloc )
- IF( tra_dmp_alloc > 0 ) CALL ctl_warn('tra_dmp_alloc: allocation of arrays failed')
- !
- END FUNCTION tra_dmp_alloc
-
-
- SUBROUTINE tra_dmp( kt, Kbb, Kmm, pts, Krhs )
- !!----------------------------------------------------------------------
- !! *** ROUTINE tra_dmp ***
- !!
- !! ** Purpose : Compute the tracer trend due to a newtonian damping
- !! of the tracer field towards given data field and add it to the
- !! general tracer trends.
- !!
- !! ** Method : Newtonian damping towards t_dta and s_dta computed
- !! and add to the general tracer trends:
- !! ta = ta + resto * (t_dta - tb)
- !! sa = sa + resto * (s_dta - sb)
- !! The trend is computed either throughout the water column
- !! (nlmdmp=0) or in area of weak vertical mixing (nlmdmp=1) or
- !! below the well mixed layer (nlmdmp=2)
- !!
- !! ** Action : - tsa: tracer trends updated with the damping trend
- !!----------------------------------------------------------------------
- INTEGER, INTENT(in ) :: kt ! ocean time-step index
- INTEGER, INTENT(in ) :: Kbb, Kmm, Krhs ! time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation
- !
- INTEGER :: ji, jj, jk, jn ! dummy loop indices
- REAL(wp), DIMENSION(A2D(nn_hls),jpk,jpts) :: zts_dta
- REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: zwrk
- REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: ztrdts
- !!----------------------------------------------------------------------
- !
- IF( ln_timing ) CALL timing_start('tra_dmp')
- !
- IF( l_trdtra .OR. iom_use('hflx_dmp_cea') .OR. iom_use('sflx_dmp_cea') ) THEN !* Save ta and sa trends
- ALLOCATE( ztrdts(A2D(nn_hls),jpk,jpts) )
- DO jn = 1, jpts
- DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
- ztrdts(ji,jj,jk,jn) = pts(ji,jj,jk,jn,Krhs)
- END_3D
- END DO
- ENDIF
- ! !== input T-S data at kt ==!
- CALL dta_tsd( kt, 'dmp', zts_dta ) ! read and interpolates T-S data at kt
- !
- SELECT CASE ( nn_zdmp ) !== type of damping ==!
- !
- CASE( 0 ) !* newtonian damping throughout the water column *!
- DO jn = 1, jpts
- DO_3D( 0, 0, 0, 0, 1, jpkm1 )
- pts(ji,jj,jk,jn,Krhs) = pts(ji,jj,jk,jn,Krhs) &
- & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jn) - pts(ji,jj,jk,jn,Kbb) )
- END_3D
- END DO
- !
- CASE ( 1 ) !* no damping in the turbocline (avt > 5 cm2/s) *!
- DO_3D( 0, 0, 0, 0, 1, jpkm1 )
- IF( avt(ji,jj,jk) <= avt_c ) THEN
- pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) &
- & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - pts(ji,jj,jk,jp_tem,Kbb) )
- pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) &
- & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - pts(ji,jj,jk,jp_sal,Kbb) )
- ENDIF
- END_3D
- !
- CASE ( 2 ) !* no damping in the mixed layer *!
- DO_3D( 0, 0, 0, 0, 1, jpkm1 )
- IF( gdept(ji,jj,jk,Kmm) >= hmlp (ji,jj) ) THEN
- pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) &
- & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - pts(ji,jj,jk,jp_tem,Kbb) )
- pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) &
- & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - pts(ji,jj,jk,jp_sal,Kbb) )
- ENDIF
- END_3D
- !
- END SELECT
- !
- ! outputs (clem trunk)
- IF( iom_use('hflx_dmp_cea') .OR. iom_use('sflx_dmp_cea') ) THEN
- ALLOCATE( zwrk(A2D(nn_hls),jpk) ) ! Needed to handle expressions containing e3t when using key_qco or key_linssh
- zwrk(:,:,:) = 0._wp
-
- IF( iom_use('hflx_dmp_cea') ) THEN
- DO_3D( 0, 0, 0, 0, 1, jpk )
- zwrk(ji,jj,jk) = ( pts(ji,jj,jk,jp_tem,Krhs) - ztrdts(ji,jj,jk,jp_tem) ) * e3t(ji,jj,jk,Kmm)
- END_3D
- CALL iom_put('hflx_dmp_cea', SUM( zwrk(:,:,:), dim=3 ) * rcp * rho0 ) ! W/m2
- ENDIF
- IF( iom_use('sflx_dmp_cea') ) THEN
- DO_3D( 0, 0, 0, 0, 1, jpk )
- zwrk(ji,jj,jk) = ( pts(ji,jj,jk,jp_sal,Krhs) - ztrdts(ji,jj,jk,jp_sal) ) * e3t(ji,jj,jk,Kmm)
- END_3D
- CALL iom_put('sflx_dmp_cea', SUM( zwrk(:,:,:), dim=3 ) * rho0 ) ! g/m2/s
- ENDIF
-
- DEALLOCATE( zwrk )
- ENDIF
- !
- IF( l_trdtra ) THEN ! trend diagnostic
- ztrdts(:,:,:,:) = pts(:,:,:,:,Krhs) - ztrdts(:,:,:,:)
- CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_dmp, ztrdts(:,:,:,jp_tem) )
- CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_dmp, ztrdts(:,:,:,jp_sal) )
- DEALLOCATE( ztrdts )
- ENDIF
- ! ! Control print
- IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' dmp - Ta: ', mask1=tmask, &
- & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
- !
- IF( ln_timing ) CALL timing_stop('tra_dmp')
- !
- END SUBROUTINE tra_dmp
-
-
- SUBROUTINE tra_dmp_init
- !!----------------------------------------------------------------------
- !! *** ROUTINE tra_dmp_init ***
- !!
- !! ** Purpose : Initialization for the newtonian damping
- !!
- !! ** Method : read the namtra_dmp namelist and check the parameters
- !!----------------------------------------------------------------------
- INTEGER :: ios, imask ! local integers
- !
- NAMELIST/namtra_dmp/ ln_tradmp, nn_zdmp, cn_resto
- !!----------------------------------------------------------------------
- !
- READ ( numnam_ref, namtra_dmp, IOSTAT = ios, ERR = 901)
-901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in reference namelist' )
- !
- READ ( numnam_cfg, namtra_dmp, IOSTAT = ios, ERR = 902 )
-902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtra_dmp in configuration namelist' )
- IF(lwm) WRITE ( numond, namtra_dmp )
- !
- IF(lwp) THEN ! Namelist print
- WRITE(numout,*)
- WRITE(numout,*) 'tra_dmp_init : T and S newtonian relaxation'
- WRITE(numout,*) '~~~~~~~~~~~~'
- WRITE(numout,*) ' Namelist namtra_dmp : set relaxation parameters'
- WRITE(numout,*) ' Apply relaxation or not ln_tradmp = ', ln_tradmp
- WRITE(numout,*) ' mixed layer damping option nn_zdmp = ', nn_zdmp
- WRITE(numout,*) ' Damping file name cn_resto = ', cn_resto
- WRITE(numout,*)
- ENDIF
- !
- IF( ln_tradmp ) THEN
- ! ! Allocate arrays
- IF( tra_dmp_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'tra_dmp_init: unable to allocate arrays' )
- !
- SELECT CASE (nn_zdmp) ! Check values of nn_zdmp
- CASE ( 0 ) ; IF(lwp) WRITE(numout,*) ' tracer damping as specified by mask'
- CASE ( 1 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the mixing layer (kz > 5 cm2/s)'
- CASE ( 2 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the mixed layer'
- CASE DEFAULT
- CALL ctl_stop('tra_dmp_init : wrong value of nn_zdmp')
- END SELECT
- !
- !!TG: Initialisation of dtatsd - Would it be better to have dmpdta routine
- ! so can damp to something other than intitial conditions files?
- !!gm: In principle yes. Nevertheless, we can't anticipate demands that have never been formulated.
- IF( .NOT.ln_tsd_dmp ) THEN
- IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout, *) ' read T-S data not initialized, we force ln_tsd_dmp=T'
- CALL dta_tsd_init( ld_tradmp=ln_tradmp ) ! forces the initialisation of T-S data
- ENDIF
- ! ! Read in mask from file
- CALL iom_open ( cn_resto, imask)
- CALL iom_get ( imask, jpdom_auto, 'resto', resto )
- CALL iom_close( imask )
- ENDIF
- !
- END SUBROUTINE tra_dmp_init
-
- !!======================================================================
-END MODULE tradmp
diff --git a/tests/ISOMIP/EXPREF/ISOMIP_mlt.png b/tests/ISOMIP/EXPREF/ISOMIP_mlt.png
deleted file mode 100644
index 5435a75b3ce83568f9458cd51df0209e9b108b83..0000000000000000000000000000000000000000
Binary files a/tests/ISOMIP/EXPREF/ISOMIP_mlt.png and /dev/null differ
diff --git a/tests/ISOMIP/EXPREF/ISOMIP_moc.png b/tests/ISOMIP/EXPREF/ISOMIP_moc.png
deleted file mode 100644
index 5afdfbd5c5f22d809056dbdb913beef70447b0bd..0000000000000000000000000000000000000000
Binary files a/tests/ISOMIP/EXPREF/ISOMIP_moc.png and /dev/null differ
diff --git a/tests/ISOMIP/EXPREF/ISOMIP_psi.png b/tests/ISOMIP/EXPREF/ISOMIP_psi.png
deleted file mode 100644
index 5c46d728c3b6dc012e6ffb669f52687b2abb58cc..0000000000000000000000000000000000000000
Binary files a/tests/ISOMIP/EXPREF/ISOMIP_psi.png and /dev/null differ
diff --git a/tests/ISOMIP/EXPREF/README b/tests/ISOMIP/EXPREF/README
deleted file mode 100644
index 06dd530372dc213f637492d698ed8b044d1c6bc1..0000000000000000000000000000000000000000
--- a/tests/ISOMIP/EXPREF/README
+++ /dev/null
@@ -1,25 +0,0 @@
-# ISOMIP is a simple TEST_CASE to test the iceshelves in NEMO.
-# no input files are needed (all is prescribed in MY_SRC/usr_def routines
-# for a reference documentation on the ISOMIP test case, see experiement 1 on http://efdl.cims.nyu.edu/project_oisi/isomip/experiments/phase_I/idealized_numerical_models_5.pdf
-
-# default namelist is setup for a 30y run on 32 processors with the minimum output using XIOS in attached mode with single file output
-
-# How to build moc.nc and psi.nc
- - Download or clone the CDFTOOLS (see https://github.com/meom-group/CDFTOOLS)
- - Compile all the tools (or at least cdfpsi and cdfmoc) on your cluster (see https://github.com/meom-group/CDFTOOLS#using-cdftools)
- - if mesh_mask.nc is splitted, you need to rebuild them using the rebuild NEMO tools (see in NEMOGCM/TOOLS) or run 1 (or more) time step on a single processor (nn_itend variable in the namelist).
- - set the correct link: ln -s mesh_mask.nc mask.nc ; ln -s mesh_mask.nc mesh_hgr.nc ; ln -s mesh_mask.nc mesh_zgr.nc
- - run the cdftools :
- - cdfmoc ISOMIP_1m_00010101_00301231_grid_V.nc => moc.nc
- - cdfpsi ISOMIP_1m_00010101_00301231_grid_U.nc ISOMIP_1m_00010101_00301231_grid_V.nc => psi.nc
-
-# How to plt moc/psi and melt (python with netcdf and matplotlib library requiried):
- - psi.png => python2.7 plot_psi.py -f psi.nc -v sobarstf
- - moc.png => python2.7 plot_moc.py -f moc.nc -v zomsfglo
- - mlt.png => python2.7 plot_mlt.py -f ISOMIP_1m_00010101_00301231_grid_T.nc -v sowflisf
-by default the last time frame is plotted.
-
-# location the expected circulation and melt plot after 30y of run:
- - ISOMIP/EXP00/ISOMIP_psi.png
- - ISOMIP/EXP00/ISOMIP_moc.png
- - ISOMIP/EXP00/ISOMIP_mlt.png
diff --git a/tests/ISOMIP/EXPREF/axis_def_nemo.xml b/tests/ISOMIP/EXPREF/axis_def_nemo.xml
deleted file mode 120000
index 6117f35baf7f6be7afa129d96a3ec521cbbc06e6..0000000000000000000000000000000000000000
--- a/tests/ISOMIP/EXPREF/axis_def_nemo.xml
+++ /dev/null
@@ -1 +0,0 @@
-../../../cfgs/SHARED/axis_def_nemo.xml
\ No newline at end of file
diff --git a/tests/ISOMIP/EXPREF/context_nemo.xml b/tests/ISOMIP/EXPREF/context_nemo.xml
deleted file mode 100644
index c7598d4234111d516ea10527ec9e960f89f46bdd..0000000000000000000000000000000000000000
--- a/tests/ISOMIP/EXPREF/context_nemo.xml
+++ /dev/null
@@ -1,37 +0,0 @@
-<!--
- ==============================================================================================
- NEMO context
-==============================================================================================
--->
-<context id="nemo">
- <!-- $id$ -->
- <variable_definition>
- <!-- Year/Month/Day of time origin for NetCDF files; defaults to 1800-01-01 -->
- <variable id="ref_year" type="int"> 1900 </variable>
- <variable id="ref_month" type="int"> 01 </variable>
- <variable id="ref_day" type="int"> 01 </variable>
- <variable id="rho0" type="float" > 1026.0 </variable>
- <variable id="cpocean" type="float" > 3991.86795711963 </variable>
- <variable id="convSpsu" type="float" > 0.99530670233846 </variable>
- <variable id="rhoic" type="float" > 917.0 </variable>
- <variable id="rhosn" type="float" > 330.0 </variable>
- <variable id="missval" type="float" > 1.e20 </variable>
- </variable_definition>
-
-<!-- Fields definition -->
- <field_definition src="./field_def_nemo-oce.xml"/> <!-- NEMO ocean dynamics -->
-
-<!-- Files definition -->
- <file_definition src="./file_def_nemo-oce.xml"/> <!-- NEMO ocean dynamics -->
-
-<!-- Axis definition -->
- <axis_definition src="./axis_def_nemo.xml"/>
-
-<!-- Domain definition -->
- <domain_definition src="./domain_def_nemo.xml"/>
-
-<!-- Grids definition -->
- <grid_definition src="./grid_def_nemo.xml"/>
-
-
-</context>
diff --git a/tests/ISOMIP/EXPREF/domain_def_nemo.xml b/tests/ISOMIP/EXPREF/domain_def_nemo.xml
deleted file mode 120000
index f344125aff82ec6ef4f63f7516c3db1a6b3ea7e7..0000000000000000000000000000000000000000
--- a/tests/ISOMIP/EXPREF/domain_def_nemo.xml
+++ /dev/null
@@ -1 +0,0 @@
-../../../cfgs/SHARED/domain_def_nemo.xml
\ No newline at end of file
diff --git a/tests/ISOMIP/EXPREF/field_def_nemo-oce.xml b/tests/ISOMIP/EXPREF/field_def_nemo-oce.xml
deleted file mode 120000
index ff97068135ca98cec33e26d72ad41a072faf64b8..0000000000000000000000000000000000000000
--- a/tests/ISOMIP/EXPREF/field_def_nemo-oce.xml
+++ /dev/null
@@ -1 +0,0 @@
-../../../cfgs/SHARED/field_def_nemo-oce.xml
\ No newline at end of file
diff --git a/tests/ISOMIP/EXPREF/file_def_nemo-oce.xml b/tests/ISOMIP/EXPREF/file_def_nemo-oce.xml
deleted file mode 100644
index 77300b426d4928837c16150ea0c7c0f6c971adbc..0000000000000000000000000000000000000000
--- a/tests/ISOMIP/EXPREF/file_def_nemo-oce.xml
+++ /dev/null
@@ -1,50 +0,0 @@
-<?xml version="1.0"?>
- <!--
-============================================================================================================
-= output files definition =
-= Define your own files =
-= put the variables you want... =
-============================================================================================================
- -->
-
- <file_definition type="one_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="1d" min_digits="4">
-
- <file_group id="1ts" output_freq="1ts" output_level="10" enabled=".TRUE."/> <!-- 1 time step files -->
- <file_group id="1h" output_freq="1h" output_level="10" enabled=".TRUE."/> <!-- 1h files -->
- <file_group id="2h" output_freq="2h" output_level="10" enabled=".TRUE."/> <!-- 2h files -->
- <file_group id="3h" output_freq="3h" output_level="10" enabled=".TRUE."/> <!-- 3h files -->
- <file_group id="4h" output_freq="4h" output_level="10" enabled=".TRUE."/> <!-- 4h files -->
- <file_group id="6h" output_freq="6h" output_level="10" enabled=".TRUE."/> <!-- 6h files -->
-
- <file_group id="1d" output_freq="1d" output_level="10" enabled=".TRUE."/> <!-- 1d files -->
- <file_group id="3d" output_freq="3d" output_level="10" enabled=".TRUE."/> <!-- 3d files -->
- <file_group id="5d" output_freq="5d" output_level="10" enabled=".TRUE."> <!-- 5d files -->
-
- <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files -->
- <file id="file1" output_freq="1mo" name_suffix="_grid_T" description="ocean T grid variables" >
- <field field_ref="toce" name="votemper" />
- <field field_ref="soce" name="vosaline" />
- <field field_ref="ssh" name="sossheig" />
- <!-- variable for ice shelf -->
- <field field_ref="fwfisf_cav" name="sowflisf" />
- <field field_ref="isfgammat" name="sogammat" />
- <field field_ref="isfgammas" name="sogammas" />
- </file>
- <file id="file2" output_freq="1mo" name_suffix="_grid_U" description="ocean U grid variables" >
- <field field_ref="uoce" name="vozocrtx" />
- </file>
- <file id="file3" output_freq="1mo" name_suffix="_grid_V" description="ocean V grid variables" >
- <field field_ref="voce" name="vomecrty" />
- </file>
- </file_group>
- <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files -->
- <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files -->
- <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files -->
- <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files -->
- <file_group id="1y" output_freq="1y" output_level="10" enabled=".TRUE."/> <!-- real yearly files -->
- <file_group id="2y" output_freq="2y" output_level="10" enabled=".TRUE."/> <!-- real 2y files -->
- <file_group id="5y" output_freq="5y" output_level="10" enabled=".TRUE."/> <!-- real 5y files -->
- <file_group id="10y" output_freq="10y" output_level="10" enabled=".TRUE."/> <!-- real 10y files -->
-
- </file_definition>
-
diff --git a/tests/ISOMIP/EXPREF/grid_def_nemo.xml b/tests/ISOMIP/EXPREF/grid_def_nemo.xml
deleted file mode 120000
index 1be74edf6d85af6063315421809ef3994216004f..0000000000000000000000000000000000000000
--- a/tests/ISOMIP/EXPREF/grid_def_nemo.xml
+++ /dev/null
@@ -1 +0,0 @@
-../../../cfgs/SHARED/grid_def_nemo.xml
\ No newline at end of file
diff --git a/tests/ISOMIP/EXPREF/iodef.xml b/tests/ISOMIP/EXPREF/iodef.xml
deleted file mode 100644
index d4be5c1bd4104bfd3e1a69db33d6647804565cf9..0000000000000000000000000000000000000000
--- a/tests/ISOMIP/EXPREF/iodef.xml
+++ /dev/null
@@ -1,26 +0,0 @@
-<?xml version="1.0"?>
-<simulation>
-
-<!-- ============================================================================================ -->
-<!-- XIOS context -->
-<!-- ============================================================================================ -->
-
- <context id="xios" >
-
- <variable_definition>
-
- <variable id="info_level" type="int">10</variable>
- <variable id="using_server" type="bool">false</variable>
- <variable id="using_oasis" type="bool">false</variable>
- <variable id="oasis_codes_id" type="string" >oceanx</variable>
-
- </variable_definition>
- </context>
-
-<!-- ============================================================================================ -->
-<!-- NEMO CONTEXT add and suppress the components you need -->
-<!-- ============================================================================================ -->
-
- <context id="nemo" src="./context_nemo.xml"/> <!-- NEMO -->
-
-</simulation>
diff --git a/tests/ISOMIP/EXPREF/namelist_cfg b/tests/ISOMIP/EXPREF/namelist_cfg
deleted file mode 100644
index 2358fa203d75ff6a3ed552933d4a5972aa99273e..0000000000000000000000000000000000000000
--- a/tests/ISOMIP/EXPREF/namelist_cfg
+++ /dev/null
@@ -1,510 +0,0 @@
-!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-!! NEMO/OCE Configuration namelist : overwrite default values defined in SHARED/namelist_ref
-!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-!! ISOMIP configuration !!
-!!======================================================================
-!! *** Domain & Run management namelists *** !!
-!! !!
-!! namrun parameters of the run
-!! namdom space and time domain
-!! namcfg parameters of the configuration (default: user defined GYRE)
-!! namwad Wetting and drying (default: OFF)
-!! namtsd data: temperature & salinity (default: OFF)
-!! namcrs coarsened grid (for outputs and/or TOP) (ln_crs =T)
-!! namc1d 1D configuration options (ln_c1d =T)
-!! namc1d_dyndmp 1D newtonian damping applied on currents (ln_c1d =T)
-!! namc1d_uvd 1D data (currents) (ln_c1d =T)
-!!======================================================================
-!
-!-----------------------------------------------------------------------
-&namrun ! parameters of the run
-!-----------------------------------------------------------------------
- cn_exp = "ISOMIP" ! experience name
- nn_it000 = 1 ! first time step
- nn_itend = 525600 ! last time step
- nn_leapy = 0 ! Leap year calendar (1) or not (0)
- ln_clobber = .true. ! clobber (overwrite) an existing file
- nn_istate = 0 ! output the initial state (1) or not (0)
- nn_stock = 99999999 ! frequency of creation of a restart file (modulo referenced to 1)
- nn_write = 48 ! frequency of write in the output file (modulo referenced to nn_it000)
- nn_istate = 0 ! output the initial state (1) or not (0)
-/
-!-----------------------------------------------------------------------
-&namusr_def ! ISOMIP user defined namelist
-!-----------------------------------------------------------------------
- ln_zps = .true. ! z-partial-step coordinate
- ln_zco = .false. ! z-full-step coordinate
- ln_sco = .false. ! s-coordinate
- rn_e1deg = 0.3 ! zonal grid-spacing (degrees)
- rn_e2deg = 0.1 ! meridional grid-spacing (degrees)
- rn_e3 = 30. ! vertical resolution
-/
-!-----------------------------------------------------------------------
-&namdom ! time and space domain
-!-----------------------------------------------------------------------
- ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time
- rn_Dt = 1800. ! time step for the dynamics (and tracer if nn_acc=0)
-/
-!-----------------------------------------------------------------------
-&namcfg ! parameters of the configuration (default: use namusr_def in namelist_cfg)
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namtile ! parameters of the tiling
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namtsd ! Temperature & Salinity Data (init/dmp) (default: OFF)
-!-----------------------------------------------------------------------
-
-/
-!-----------------------------------------------------------------------
-&namwad ! Wetting and Drying (WaD) (default: OFF)
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namcrs ! coarsened grid (for outputs and/or TOP) (ln_crs =T)
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namc1d ! 1D configuration options (ln_c1d =T default: PAPA station)
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namc1d_dyndmp ! U & V newtonian damping (ln_c1d =T default: OFF)
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namc1d_uvd ! data: U & V currents (ln_c1d =T default: OFF)
-!-----------------------------------------------------------------------
-
-/
-
-!!======================================================================
-!! *** Surface Boundary Condition namelists *** !!
-!! !!
-!! namsbc surface boundary condition manager (default: NO selection)
-!! namsbc_flx flux formulation (ln_flx =T)
-!! namsbc_blk Bulk formulae formulation (ln_blk =T)
-!! namsbc_cpl CouPLed formulation ("key_oasis3" )
-!! namsbc_sas Stand-Alone Surface module (SAS_SRC only)
-!! namsbc_iif Ice-IF: use observed ice cover (nn_ice = 1 )
-!! namtra_qsr penetrative solar radiation (ln_traqsr =T)
-!! namsbc_ssr sea surface restoring term (for T and/or S) (ln_ssr =T)
-!! namsbc_rnf river runoffs (ln_rnf =T)
-!! namsbc_apr Atmospheric Pressure (ln_apr_dyn =T)
-!! namsbc_wave external fields from wave model (ln_wave =T)
-!! namberg iceberg floats (ln_icebergs=T)
-!!======================================================================
-!
-!-----------------------------------------------------------------------
-&namsbc ! Surface Boundary Condition manager (default: NO selection)
-!-----------------------------------------------------------------------
- nn_fsbc = 1 ! frequency of SBC module call
- ! ! (control sea-ice & iceberg model call)
- ln_usr = .true. ! user defined formulation (T => check usrdef_sbc)
-/
-!-----------------------------------------------------------------------
-&namsbc_flx ! surface boundary condition : flux formulation (ln_flx =T)
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namsbc_blk ! namsbc_blk generic Bulk formula (ln_blk =T)
-!-----------------------------------------------------------------------
-
-/
-!-----------------------------------------------------------------------
-&namsbc_cpl ! coupled ocean/atmosphere model ("key_oasis3")
-!-----------------------------------------------------------------------
-
-/
-!-----------------------------------------------------------------------
-&namsbc_sas ! Stand-Alone Surface module: ocean data (SAS_SRC only)
-!-----------------------------------------------------------------------
-
-/
-!-----------------------------------------------------------------------
-&namsbc_iif ! Ice-IF : use observed ice cover (nn_ice = 1)
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namtra_qsr ! penetrative solar radiation (ln_traqsr =T)
-!-----------------------------------------------------------------------
-
-/
-!-----------------------------------------------------------------------
-&namsbc_ssr ! surface boundary condition : sea surface restoring (ln_ssr =T)
-!-----------------------------------------------------------------------
-
-/
-!-----------------------------------------------------------------------
-&namsbc_rnf ! runoffs (ln_rnf =T)
-!-----------------------------------------------------------------------
-
-/
-!-----------------------------------------------------------------------
-&namsbc_apr ! Atmospheric pressure used as ocean forcing (ln_apr_dyn =T)
-!-----------------------------------------------------------------------
-
-/
-!-----------------------------------------------------------------------
-&namisf ! Top boundary layer (ISF) (default: OFF)
-!-----------------------------------------------------------------------
- !
- ! ---------------- ice shelf load -------------------------------
- !
- !
- ! ---------------- ice shelf melt formulation -------------------------------
- !
- ln_isf = .true. ! activate ice shelf module
- cn_isfdir = './' ! directory for all ice shelf input file
- !
- ! ---------------- cavities opened -------------------------------
- !
- ln_isfcav_mlt = .true. ! ice shelf melting into the cavity (need ln_isfcav = .true. in domain_cfg.nc)
- cn_isfcav_mlt = '2eq' ! ice shelf melting formulation (spe/2eq/3eq/oasis)
- ! ! spe = fwfisf is read from a forcing field
- ! ! 2eq = ISOMIP like: 2 equations formulation (Hunter et al., 2006)
- ! ! 3eq = ISOMIP+ like: 3 equations formulation (Asay-Davis et al., 2015)
- ! ! oasis = fwfisf is given by oasis and pattern by file sn_isfcav_fwf
- ! ! cn_isfcav_mlt = 2eq or 3eq cases:
- cn_gammablk = 'spe' ! scheme to compute gammat/s (spe,ad15,hj99)
- ! ! ad15 = velocity dependend Gamma (u* * gammat/s) (Jenkins et al. 2010)
- ! ! hj99 = velocity and stability dependent Gamma (Holland et al. 1999)
- rn_gammat0 = 1.e-4 ! gammat coefficient used in blk formula
- rn_gammas0 = 1.e-4 ! gammas coefficient used in blk formula
- !
- rn_htbl = 30. ! thickness of the top boundary layer (Losh et al. 2008)
- ! ! 0 => thickness of the tbl = thickness of the first wet cell
- !
-/
-!-----------------------------------------------------------------------
-&namsbc_wave ! External fields from wave model (ln_wave=T)
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namberg ! iceberg parameters (default: OFF)
-!-----------------------------------------------------------------------
-
-/
-
-!!======================================================================
-!! *** Lateral boundary condition *** !!
-!! !!
-!! namlbc lateral momentum boundary condition (default: NO selection)
-!! namagrif agrif nested grid (read by child model only) ("key_agrif")
-!! nam_tide Tidal forcing (default: OFF)
-!! nambdy Unstructured open boundaries (default: OFF)
-!! nambdy_dta Unstructured open boundaries - external data (see nambdy)
-!! nambdy_tide tidal forcing at open boundaries (default: OFF)
-!!======================================================================
-!
-!-----------------------------------------------------------------------
-&namlbc ! lateral momentum boundary condition (default: NO selection)
-!-----------------------------------------------------------------------
- rn_shlat = 0. ! free slip
-/
-!-----------------------------------------------------------------------
-&namagrif ! AGRIF zoom ("key_agrif")
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&nam_tide ! tide parameters (default: OFF)
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&nambdy ! unstructured open boundaries (default: OFF)
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&nambdy_dta ! open boundaries - external data (see nam_bdy)
-!-----------------------------------------------------------------------
-
-/
-!-----------------------------------------------------------------------
-&nambdy_tide ! tidal forcing at open boundaries (default: OFF)
-!-----------------------------------------------------------------------
-/
-
-!!======================================================================
-!! *** Top/Bottom boundary condition *** !!
-!! !!
-!! namdrg top/bottom drag coefficient (default: NO selection)
-!! namdrg_top top friction (ln_drg_OFF=F & ln_isfcav=T)
-!! namdrg_bot bottom friction (ln_drg_OFF=F)
-!! nambbc bottom temperature boundary condition (default: OFF)
-!! nambbl bottom boundary layer scheme (default: OFF)
-!!======================================================================
-!
-!-----------------------------------------------------------------------
-&namdrg ! top/bottom drag coefficient (default: NO selection)
-!-----------------------------------------------------------------------
- ln_drg_OFF = .false. ! free-slip : Cd = 0 (F => fill namdrg_bot
- ln_lin = .false. ! linear drag: Cd = Cd0 Uc0 & namdrg_top)
- ln_non_lin = .true. ! non-linear drag: Cd = Cd0 |U|
- ln_loglayer = .false. ! logarithmic drag: Cd = vkarmn/log(z/z0) |U|
- !
- ln_drgimp = .false. ! implicit top/bottom friction flag
-/
-!-----------------------------------------------------------------------
-&namdrg_top ! TOP friction (ln_drg_OFF =F & ln_isfcav=T)
-!-----------------------------------------------------------------------
- rn_Cd0 = 2.5e-3 ! drag coefficient [-]
- rn_Uc0 = 0.16 ! ref. velocity [m/s] (linear drag=Cd0*Uc0)
- rn_Cdmax = 0.1 ! drag value maximum [-] (logarithmic drag)
- rn_ke0 = 0.0e-0 ! background kinetic energy [m2/s2] (non-linear cases)
- rn_z0 = 3.0e-3 ! roughness [m] (ln_loglayer=T)
- ln_boost = .false. ! =T regional boost of Cd0 ; =F constant
- rn_boost = 50. ! local boost factor [-]
-/
-!-----------------------------------------------------------------------
-&namdrg_bot ! BOTTOM friction (ln_drg_OFF =F)
-!-----------------------------------------------------------------------
- rn_Cd0 = 1.e-3 ! drag coefficient [-]
- rn_Uc0 = 0.4 ! ref. velocity [m/s] (linear drag=Cd0*Uc0)
- rn_Cdmax = 0.1 ! drag value maximum [-] (logarithmic drag)
- rn_ke0 = 2.5e-3 ! background kinetic energy [m2/s2] (non-linear cases)
- rn_z0 = 3.e-3 ! roughness [m] (ln_loglayer=T)
- ln_boost = .false. ! =T regional boost of Cd0 ; =F constant
- rn_boost = 50. ! local boost factor [-]
-/
-!-----------------------------------------------------------------------
-&nambbc ! bottom temperature boundary condition (default: OFF)
-!-----------------------------------------------------------------------
-
-/
-!-----------------------------------------------------------------------
-&nambbl ! bottom boundary layer scheme (default: OFF)
-!-----------------------------------------------------------------------
-/
-
-!!======================================================================
-!! Tracer (T-S) namelists !!
-!! !!
-!! nameos equation of state (default: NO selection)
-!! namtra_adv advection scheme (default: NO selection)
-!! namtra_ldf lateral diffusion scheme (default: NO selection)
-!! namtra_mle mixed layer eddy param. (Fox-Kemper param.) (default: OFF)
-!! namtra_eiv eddy induced velocity param. (default: OFF)
-!! namtra_dmp T & S newtonian damping (default: OFF)
-!!======================================================================
-!
-!-----------------------------------------------------------------------
-&nameos ! ocean Equation Of Seawater (default: NO selection)
-!-----------------------------------------------------------------------
- ln_eos80 = .true. ! = Use EOS80 equation of state
-/
-!-----------------------------------------------------------------------
-&namtra_adv ! advection scheme for tracer (default: NO selection)
-!-----------------------------------------------------------------------
- ln_traadv_fct = .true. ! FCT scheme
- nn_fct_h = 2 ! =2/4, horizontal 2nd / 4th order
- nn_fct_v = 2 ! =2/4, vertical 2nd / COMPACT 4th order
-/
-!-----------------------------------------------------------------------
-&namtra_ldf ! lateral diffusion scheme for tracers (default: NO selection)
-!-----------------------------------------------------------------------
- ln_traldf_lap = .true. ! laplacian operator
- ln_traldf_hor = .true. ! horizontal (geopotential)
- ! ! Coefficients:
- nn_aht_ijk_t = 0 ! = 0 constant = 1/2 Ud*Ld (lap case)
- rn_Ud = 0.02 ! lateral diffusive velocity [m/s]
- rn_Ld = 10.e+3 ! lateral diffusive length [m]
-/
-!-----------------------------------------------------------------------
-&namtra_mle ! mixed layer eddy parametrisation (Fox-Kemper) (default: OFF)
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namtra_eiv ! eddy induced velocity param. (default: OFF)
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namtra_dmp ! tracer: T & S newtonian damping (default: OFF)
-!-----------------------------------------------------------------------
-/
-
-!!======================================================================
-!! *** Dynamics namelists *** !!
-!! !!
-!! nam_vvl vertical coordinate options (default: z-star)
-!! namdyn_adv formulation of the momentum advection (default: NO selection)
-!! namdyn_vor advection scheme (default: NO selection)
-!! namdyn_hpg hydrostatic pressure gradient (default: NO selection)
-!! namdyn_spg surface pressure gradient (default: NO selection)
-!! namdyn_ldf lateral diffusion scheme (default: NO selection)
-!! namdta_dyn offline TOP: dynamics read in files (OFF_SRC only)
-!!======================================================================
-!
-!-----------------------------------------------------------------------
-&nam_vvl ! vertical coordinate options (default: z-star)
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namdyn_adv ! formulation of the momentum advection (default: NO selection)
-!-----------------------------------------------------------------------
- ln_dynadv_vec = .true. ! vector form (T) or flux form (F)
- nn_dynkeg = 0 ! scheme for grad(KE): =0 C2 ; =1 Hollingsworth correction
-/
-!-----------------------------------------------------------------------
-&namdyn_vor ! Vorticity / Coriolis scheme (default: NO selection)
-!-----------------------------------------------------------------------
- ln_dynvor_ene = .true. ! energy conserving scheme
-/
-!-----------------------------------------------------------------------
-&namdyn_hpg ! Hydrostatic pressure gradient option (default: NO selection)
-!-----------------------------------------------------------------------
- ln_hpg_isf = .true. ! s-coordinate adapted for isf (standard jacobian formulation)
-/
-!-----------------------------------------------------------------------
-&namdyn_spg ! surface pressure gradient (default: NO selection)
-!-----------------------------------------------------------------------
- ln_dynspg_ts = .true. ! split-explicit free surface
-/
-!-----------------------------------------------------------------------
-&namdyn_ldf ! lateral diffusion on momentum (default: NO selection)
-!-----------------------------------------------------------------------
- ln_dynldf_lap = .true. ! laplacian operator
- ln_dynldf_lev = .true. ! iso-level
- nn_ahm_ijk_t = 0 ! = 0 constant = 1/2 Uv*Lv (lap case)
- rn_Uv = 0.12 ! lateral viscous velocity [m/s]
- rn_Lv = 10.e+3 ! lateral viscous length [m]
-/
-!-----------------------------------------------------------------------
-&namdta_dyn ! offline ocean input files (OFF_SRC only)
-!-----------------------------------------------------------------------
-
-/
-
-!!======================================================================
-!! vertical physics namelists !!
-!! !!
-!! namzdf vertical physics manager (default: NO selection)
-!! namzdf_ric richardson number vertical mixing (ln_zdfric=T)
-!! namzdf_tke TKE vertical mixing (ln_zdftke=T)
-!! namzdf_gls GLS vertical mixing (ln_zdfgls=T)
-!! namzdf_osm OSM vertical diffusion (ln_zdfosm=T)
-!! namzdf_iwm tidal mixing parameterization (ln_zdfiwm=T)
-!!======================================================================
-!
-!-----------------------------------------------------------------------
-&namzdf ! vertical physics manager (default: NO selection)
-!-----------------------------------------------------------------------
- ! ! type of vertical closure (required)
- ln_zdfcst = .true. ! constant mixing
- !
- ! ! convection
- ln_zdfevd = .true. ! enhanced vertical diffusion
- rn_evd = 0.1 ! mixing coefficient [m2/s]
- !
- ! ! coefficients
- rn_avm0 = 1.e-3 ! vertical eddy viscosity [m2/s] (background Kz if ln_zdfcst)
- rn_avt0 = 5.e-5 ! vertical eddy diffusivity [m2/s] (background Kz if ln_zdfcst)
-/
-!-----------------------------------------------------------------------
-&namzdf_ric ! richardson number dependent vertical diffusion (ln_zdfric =T)
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namzdf_tke ! turbulent eddy kinetic dependent vertical diffusion (ln_zdftke =T)
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namzdf_gls ! GLS vertical diffusion (ln_zdfgls =T)
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namzdf_osm ! OSM vertical diffusion (ln_zdfosm =T)
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namzdf_iwm ! internal wave-driven mixing parameterization (ln_zdfiwm =T)
-!-----------------------------------------------------------------------
-/
-
-!!======================================================================
-!! *** Diagnostics namelists *** !!
-!! !!
-!! namtrd dynamics and/or tracer trends (default: OFF)
-!! namhsb Heat and salt budgets (default: OFF)
-!! namdiu Cool skin and warm layer models (default: OFF)
-!! namdiu Cool skin and warm layer models (default: OFF)
-!! namflo float parameters (default: OFF)
-!! nam_diadct transports through some sections (default: OFF)
-!! nam_dia25h 25h Mean Output (default: OFF)
-!! namnc4 netcdf4 chunking and compression settings ("key_netcdf4")
-!!======================================================================
-!
-!-----------------------------------------------------------------------
-&namtrd ! trend diagnostics (default: OFF)
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namhsb ! Heat and salt budgets (default: OFF)
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namdiu ! Cool skin and warm layer models (default: OFF)
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namflo ! float parameters ("key_float")
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&nam_diaharm ! Harmonic analysis of tidal constituents ("key_diaharm")
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namdct ! transports through some sections ("key_diadct")
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&nam_diatmb ! Top Middle Bottom Output (default: OFF)
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&nam_dia25h ! 25h Mean Output (default: OFF)
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namnc4 ! netcdf4 chunking and compression settings ("key_netcdf4")
-!-----------------------------------------------------------------------
-/
-
-!!======================================================================
-!! *** Observation & Assimilation *** !!
-!! !!
-!! namobs observation and model comparison (default: OFF)
-!! nam_asminc assimilation increments ('key_asminc')
-!!======================================================================
-!
-!-----------------------------------------------------------------------
-&namobs ! observation usage switch (default: OFF)
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&nam_asminc ! assimilation increments ('key_asminc')
-!-----------------------------------------------------------------------
-/
-
-!!======================================================================
-!! *** Miscellaneous namelists *** !!
-!! !!
-!! nammpp Massively Parallel Processing
-!! namctl Control prints (default: OFF)
-!! namsto Stochastic parametrization of EOS (default: OFF)
-!!======================================================================
-!
-!-----------------------------------------------------------------------
-&nammpp ! Massively Parallel Processing
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namctl ! Control prints (default: OFF)
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namsto ! Stochastic parametrization of EOS (default: OFF)
-!-----------------------------------------------------------------------
-/
diff --git a/tests/ISOMIP/EXPREF/namelist_ref b/tests/ISOMIP/EXPREF/namelist_ref
deleted file mode 120000
index 97682863712c9d973a2d1aa35a12452a3e8b4f96..0000000000000000000000000000000000000000
--- a/tests/ISOMIP/EXPREF/namelist_ref
+++ /dev/null
@@ -1 +0,0 @@
-../../../cfgs/SHARED/namelist_ref
\ No newline at end of file
diff --git a/tests/ISOMIP/EXPREF/plot_mlt.py b/tests/ISOMIP/EXPREF/plot_mlt.py
deleted file mode 100644
index edb9e04afe6a73d309ca73ecf5922344e4c0c060..0000000000000000000000000000000000000000
--- a/tests/ISOMIP/EXPREF/plot_mlt.py
+++ /dev/null
@@ -1,47 +0,0 @@
-from netCDF4 import Dataset
-import numpy as np
-from numpy import ma
-import argparse
-import matplotlib.pyplot as plt
-import matplotlib
-
-parser = argparse.ArgumentParser()
-parser.add_argument("-f" , metavar='file_name' , help="names of input files" , type=str , nargs="+", required=True )
-parser.add_argument("-v" , metavar='var_name' , help="variable list" , type=str , nargs=1 , required=True )
-args = parser.parse_args()
-
-# read mesh_mask
-ncid = Dataset('mesh_mask.nc')
-lat2d = ncid.variables['gphit' ][ :,:].squeeze()
-lon2d = ncid.variables['glamt' ][ :,:].squeeze()
-msk = ncid.variables['tmaskutil'][0,:,:].squeeze()
-ncid.close()
-
-plt.figure(figsize=np.array([210,210]) / 25.4)
-
-# read psi.nc
-ncid = Dataset(args.f[0])
-var2d = ncid.variables[args.v[0]][-1,:,:].squeeze()
-var2dm = ma.masked_where(msk==0.0,var2d)
-# convert in m/y
-var2dm = var2dm * 86400 * 365 / 1e3
-ncid.close()
-
-# define colorbar
-vlevel=np.arange(-1.6,1.8,0.2)
-pcol = plt.contourf(lon2d,lat2d,var2dm,levels=vlevel,extend='both')
-vlevel=np.arange(-1.6,1.8,0.4)
-matplotlib.rcParams['contour.negative_linestyle'] = 'solid'
-plt.contour(lon2d,lat2d,var2dm,levels=vlevel,colors='k')
-plt.grid()
-plt.title('melt rate ISOMIP (m/y)')
-plt.ylabel('Latitude',fontsize=14)
-plt.xlabel('Longitude',fontsize=14)
-cbar = plt.colorbar(pcol, ticks=vlevel)
-cbar.ax.tick_params(labelsize=14)
-
-# save figure
-plt.savefig('mlt.png', format='png', dpi=300)
-
-plt.show()
-
diff --git a/tests/ISOMIP/EXPREF/plot_moc.py b/tests/ISOMIP/EXPREF/plot_moc.py
deleted file mode 100644
index f8fc48e811b92f6c2d44cb70942afe119d228242..0000000000000000000000000000000000000000
--- a/tests/ISOMIP/EXPREF/plot_moc.py
+++ /dev/null
@@ -1,60 +0,0 @@
-from netCDF4 import Dataset
-import numpy as np
-import argparse
-import matplotlib.pyplot as plt
-
-# read argument
-parser = argparse.ArgumentParser()
-parser.add_argument("-f" , metavar='file_name' , help="names of input files" , type=str , nargs=1 , required=True )
-parser.add_argument("-v" , metavar='var_name' , help="variable list" , type=str , nargs=1 , required=True )
-args = parser.parse_args()
-
-# read mesh mask
-ncid = Dataset('mesh_mask.nc')
-vx2d = ncid.variables['gphit' ][0,:,0].squeeze()
-vx2dv = ncid.variables['gphiv' ][0,:,0].squeeze()
-y2d = ncid.variables['gdepw_0'][0,:,:,1].squeeze()*-1
-y2dt = ncid.variables['gdept_0'][0,:,:,1].squeeze()*-1
-msk = ncid.variables['tmask' ][0,:,:,1].squeeze()
-ncid.close()
-
-# build x 2d array
-x2d=y2d*0.0
-x2dv=y2d*0.0
-for jk in range(0,y2d.shape[0]):
- x2d[jk,:]=vx2d[:]
- x2dv[jk,:]=vx2d[:]
-
-plt.figure(figsize=np.array([210,210]) / 25.4)
-
-# read data and mask it
-ncid = Dataset(args.f[0])
-var2d = ncid.variables[args.v[0]][-1,:,:,:].squeeze()
-var2dm = var2d[:,:]
-var2dm[msk==0] = -1
-ncid.close()
-
-# define colorbar
-vlevel=np.arange(0,0.13,0.01)
-pcol = plt.contourf(x2d,y2d,var2dm,levels=vlevel)
-plt.clf()
-
-# plot contour
-ax = plt.subplot(1, 1, 1)
-ax.contour(x2dv,y2dt,var2dm,levels=vlevel)
-ax.grid()
-ax.set_title('MOC ISOMIP (Sv)')
-ax.set_ylabel('Depth (m)',fontsize=14)
-ax.set_xlabel('Latitude',fontsize=14)
-
-# plot colorbar
-plt.subplots_adjust(left=0.1,right=0.89, bottom=0.1, top=0.89, wspace=0.1, hspace=0.1)
-cax = plt.axes([0.91, 0.1, 0.02, 0.79])
-cbar= plt.colorbar(pcol, ticks=vlevel, cax=cax)
-cbar.ax.tick_params(labelsize=14)
-
-# save figure
-plt.savefig('moc.png', format='png', dpi=300)
-
-plt.show()
-
diff --git a/tests/ISOMIP/EXPREF/plot_psi.py b/tests/ISOMIP/EXPREF/plot_psi.py
deleted file mode 100644
index 16b615fdad922cd8f0cd41591e937a7e9f5d909d..0000000000000000000000000000000000000000
--- a/tests/ISOMIP/EXPREF/plot_psi.py
+++ /dev/null
@@ -1,52 +0,0 @@
-from netCDF4 import Dataset
-import numpy as np
-from numpy import ma
-import argparse
-import matplotlib.pyplot as plt
-
-parser = argparse.ArgumentParser()
-parser.add_argument("-f" , metavar='file_name' , help="names of input files" , type=str , nargs="+", required=True )
-parser.add_argument("-v" , metavar='var_name' , help="variable list" , type=str , nargs=1 , required=True )
-args = parser.parse_args()
-
-# read mesh_mask
-ncid = Dataset('mesh_mask.nc')
-lat2d = ncid.variables['gphit' ][ :,:].squeeze()
-lon2d = ncid.variables['glamt' ][ :,:].squeeze()
-msk = ncid.variables['tmaskutil'][0,:,:].squeeze()
-ncid.close()
-
-plt.figure(figsize=np.array([210,210]) / 25.4)
-
-# read psi.nc
-ncid = Dataset(args.f[0])
-var2d = ncid.variables[args.v[0]][-1,:,:].squeeze()
-var2dm = ma.masked_where(msk==0.0,var2d)
-# convert in Sv
-var2dm = var2dm / 1e6
-ncid.close()
-
-# define colorbar
-vlevel=np.arange(0.00,0.36,0.02)
-pcol = plt.contourf(lon2d,lat2d,var2dm,levels=vlevel)
-plt.clf()
-
-# plot contour
-ax = plt.subplot(1, 1, 1)
-ax.contour(lon2d,lat2d,var2dm,levels=vlevel)
-ax.grid()
-ax.set_title('PSI ISOMIP (Sv)')
-ax.set_ylabel('Latitude',fontsize=14)
-ax.set_xlabel('Longitude',fontsize=14)
-
-# plot colorbar
-plt.subplots_adjust(left=0.1,right=0.89, bottom=0.1, top=0.89, wspace=0.1, hspace=0.1)
-cax = plt.axes([0.91, 0.1, 0.02, 0.79])
-cbar= plt.colorbar(pcol, ticks=vlevel, cax=cax)
-cbar.ax.tick_params(labelsize=14)
-
-# save figure
-plt.savefig('psi.png', format='png', dpi=300)
-
-plt.show()
-
diff --git a/tests/ISOMIP/MY_SRC/usrdef_hgr.F90 b/tests/ISOMIP/MY_SRC/usrdef_hgr.F90
deleted file mode 100644
index 95bdd75af7e866caf87798a50f9f8f13f258449a..0000000000000000000000000000000000000000
--- a/tests/ISOMIP/MY_SRC/usrdef_hgr.F90
+++ /dev/null
@@ -1,119 +0,0 @@
-MODULE usrdef_hgr
- !!======================================================================
- !! *** MODULE usrdef_hgr ***
- !!
- !! === LOCK_EXCHANGE configuration ===
- !!
- !! User defined : mesh and Coriolis parameter of a user configuration
- !!======================================================================
- !! History : NEMO ! 2016-08 (S. Flavoni, G. Madec) Original code
- !! ! 2017-02 (P. Mathiot, S. Flavoni) Adapt code to ISOMIP case
- !!----------------------------------------------------------------------
-
- !!----------------------------------------------------------------------
- !! usr_def_hgr : initialize the horizontal mesh for ISOMIP configuration
- !!----------------------------------------------------------------------
- USE dom_oce
- USE par_oce ! ocean space and time domain
- USE phycst ! physical constants
- USE usrdef_nam, ONLY: rn_e1deg, rn_e2deg ! horizontal resolution in meters
- !
- USE in_out_manager ! I/O manager
- USE lib_mpp ! MPP library
-
- IMPLICIT NONE
- PRIVATE
-
- PUBLIC usr_def_hgr ! called by domhgr.F90
-
- !! * Substitutions
-# include "do_loop_substitute.h90"
- !!----------------------------------------------------------------------
- !! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: usrdef_hgr.F90 14223 2020-12-19 10:22:45Z smasson $
- !! Software governed by the CeCILL license (see ./LICENSE)
- !!----------------------------------------------------------------------
-CONTAINS
-
- SUBROUTINE usr_def_hgr( plamt , plamu , plamv , plamf , & ! geographic position (required)
- & pphit , pphiu , pphiv , pphif , & !
- & kff , pff_f , pff_t , & ! Coriolis parameter (if domain not on the sphere)
- & pe1t , pe1u , pe1v , pe1f , & ! scale factors (required)
- & pe2t , pe2u , pe2v , pe2f , & !
- & ke1e2u_v , pe1e2u , pe1e2v ) ! u- & v-surfaces (if gridsize reduction is used in strait(s))
- !!----------------------------------------------------------------------
- !! *** ROUTINE usr_def_hgr ***
- !!
- !! ** Purpose : user defined mesh and Coriolis parameter
- !!
- !! ** Method : set all intent(out) argument to a proper value
- !! ISOMIP configuration
- !!
- !! ** Action : - define longitude & latitude of t-, u-, v- and f-points (in degrees)
- !! - define i- & j-scale factors at t-, u-, v- and f-points (in meters)
- !! - define u- & v-surfaces (in m2)
- !!----------------------------------------------------------------------
- REAL(wp), DIMENSION(:,:), INTENT(out) :: plamt, plamu, plamv, plamf ! longitude outputs [degrees]
- REAL(wp), DIMENSION(:,:), INTENT(out) :: pphit, pphiu, pphiv, pphif ! latitude outputs [degrees]
- INTEGER , INTENT(out) :: kff ! =1 Coriolis parameter computed here, =0 otherwise
- REAL(wp), DIMENSION(:,:), INTENT(out) :: pff_f, pff_t ! Coriolis factor at f-point [1/s]
- REAL(wp), DIMENSION(:,:), INTENT(out) :: pe1t, pe1u, pe1v, pe1f ! i-scale factors [m]
- REAL(wp), DIMENSION(:,:), INTENT(out) :: pe2t, pe2u, pe2v, pe2f ! j-scale factors [m]
- INTEGER , INTENT(out) :: ke1e2u_v ! =1 u- & v-surfaces computed here, =0 otherwise
- REAL(wp), DIMENSION(:,:), INTENT(out) :: pe1e2u, pe1e2v ! u- & v-surfaces (if reduction in strait) [m2]
- !
- INTEGER :: ji, jj ! dummy loop indices
- REAL(wp) :: zfact, zti, zui, zvi, zfi, ztj, zuj, zvj, zfj ! local scalars
- !!-------------------------------------------------------------------------------
- !
- IF(lwp) THEN
- WRITE(numout,*)
- WRITE(numout,*) 'usr_def_hgr : ISOMIP configuration'
- WRITE(numout,*) '~~~~~~~~~~~'
- WRITE(numout,*)
- WRITE(numout,*) ' ===>> geographical mesh on the sphere with regular grid-spacing'
- WRITE(numout,*) ' given by rn_e1deg and rn_e2deg'
- ENDIF
- !
- ! !== grid point position ==! (in degrees)
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- ! ! longitude (west coast at lon=0°)
- plamt(ji,jj) = rn_e1deg * ( - 0.5 + REAL( mig0(ji)-1 , wp ) )
- plamu(ji,jj) = rn_e1deg * ( REAL( mig0(ji)-1 , wp ) )
- plamv(ji,jj) = plamt(ji,jj)
- plamf(ji,jj) = plamu(ji,jj)
- ! ! latitude (south coast at lat=-80°)
- pphit(ji,jj) = rn_e2deg * ( - 0.5 + REAL( mjg0(jj)-1 , wp ) ) - 80._wp
- pphiu(ji,jj) = pphit(ji,jj)
- pphiv(ji,jj) = rn_e2deg * ( REAL( mjg0(jj)-1 , wp ) ) - 80._wp
- pphif(ji,jj) = pphiv(ji,jj)
- END_2D
- !
- ! !== Horizontal scale factors ==! (in meters)
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- ! ! e1 (zonal)
- pe1t(ji,jj) = ra * rad * COS( rad * pphit(ji,jj) ) * rn_e1deg
- pe1u(ji,jj) = ra * rad * COS( rad * pphiu(ji,jj) ) * rn_e1deg
- pe1v(ji,jj) = ra * rad * COS( rad * pphiv(ji,jj) ) * rn_e1deg
- pe1f(ji,jj) = ra * rad * COS( rad * pphif(ji,jj) ) * rn_e1deg
- ! ! e2 (meridional)
- pe2t(ji,jj) = ra * rad * rn_e2deg
- pe2u(ji,jj) = ra * rad * rn_e2deg
- pe2v(ji,jj) = ra * rad * rn_e2deg
- pe2f(ji,jj) = ra * rad * rn_e2deg
- END_2D
- ! ! NO reduction of grid size in some straits
- ke1e2u_v = 0 ! ==>> u_ & v_surfaces will be computed in dom_ghr routine
- pe1e2u(:,:) = 0._wp ! CAUTION: set to zero to avoid error with some compilers that
- pe1e2v(:,:) = 0._wp ! require an initialization of INTENT(out) arguments
- !
- !
- ! !== Coriolis parameter ==!
- kff = 0 ! Coriolis parameter calculated on the sphere
- pff_f(:,:) = 0._wp ! CAUTION: set to zero to avoid error with some compilers that
- pff_t(:,:) = 0._wp ! require an initialization of INTENT(out) arguments
- !
- END SUBROUTINE usr_def_hgr
-
- !!======================================================================
-END MODULE usrdef_hgr
diff --git a/tests/ISOMIP/MY_SRC/usrdef_istate.F90 b/tests/ISOMIP/MY_SRC/usrdef_istate.F90
deleted file mode 100644
index 42cf30fd2d67ddbb8fa411873beec23c58de5c9c..0000000000000000000000000000000000000000
--- a/tests/ISOMIP/MY_SRC/usrdef_istate.F90
+++ /dev/null
@@ -1,87 +0,0 @@
-MODULE usrdef_istate
- !!======================================================================
- !! *** MODULE usrdef_istate ***
- !!
- !! === ISOMIP configuration ===
- !!
- !! User defined : set the initial state of a user configuration
- !!======================================================================
- !! History : NEMO ! 2016-11 (S. Flavoni) Original code
- !! ! 2017-02 (P. Mathiot, S. Flavoni) Adapt code to ISOMIP case
- !! ! 2020-11 (S. Techene, G. Madec) separate tsuv from ssh
- !!----------------------------------------------------------------------
-
- !!----------------------------------------------------------------------
- !! usr_def_istate : initial state in Temperature and salinity
- !!----------------------------------------------------------------------
- USE par_oce ! ocean space and time domain
- USE dom_oce , ONLY : glamt
- USE phycst ! physical constants
- !
- USE in_out_manager ! I/O manager
- USE lib_mpp ! MPP library
-
- IMPLICIT NONE
- PRIVATE
-
- PUBLIC usr_def_istate ! called by istate.F90
- PUBLIC usr_def_istate_ssh ! called by domqco.F90
-
- !!----------------------------------------------------------------------
- !! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: usrdef_istate.F90 14053 2020-12-03 13:48:38Z techene $
- !! Software governed by the CeCILL license (see ./LICENSE)
- !!----------------------------------------------------------------------
-CONTAINS
-
- SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv )
- !!----------------------------------------------------------------------
- !! *** ROUTINE usr_def_istate ***
- !!
- !! ** Purpose : Initialization of the dynamics and tracers
- !! Here ISOMIP configuration
- !!
- !! ** Method : - set temperature field
- !! - set salinity field
- !!----------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pdept ! depth of t-point [m]
- REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: ptmask ! t-point ocean mask [m]
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT( out) :: pts ! T & S fields [Celsius ; g/kg]
- REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pu ! i-component of the velocity [m/s]
- REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pv ! j-component of the velocity [m/s]
- !!----------------------------------------------------------------------
- !
- IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*) 'usr_def_istate : ISOMIP configuration, analytical definition of initial state'
- IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~ Ocean at rest, with a constant salinity and temperature. '
- pu (:,:,:) = 0._wp ! ocean at rest
- pv (:,:,:) = 0._wp
- ! ! T & S profiles
- pts(:,:,:,jp_tem) = - 1.9 * ptmask(:,:,:) ! ISOMIP configuration : start from constant T+S fields
- pts(:,:,:,jp_sal) = 34.4 * ptmask(:,:,:)
- !
- END SUBROUTINE usr_def_istate
-
-
- SUBROUTINE usr_def_istate_ssh( ptmask, pssh )
- !!----------------------------------------------------------------------
- !! *** ROUTINE usr_def_istate_ssh ***
- !!
- !! ** Purpose : Initialization of ssh
- !! Here ISOMIP configuration
- !!
- !! ** Method : set ssh to 0
- !!----------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: ptmask ! t-point ocean mask [m]
- REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height [m]
- !!----------------------------------------------------------------------
- !
- IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : ISOMIP configuration, analytical definition of initial state'
- !
- pssh(:,:) = 0._wp
- !
- END SUBROUTINE usr_def_istate_ssh
-
- !!======================================================================
-END MODULE usrdef_istate
diff --git a/tests/ISOMIP/MY_SRC/usrdef_nam.F90 b/tests/ISOMIP/MY_SRC/usrdef_nam.F90
deleted file mode 100644
index b10630838bb8cb52d6067d92a147d7686e169e36..0000000000000000000000000000000000000000
--- a/tests/ISOMIP/MY_SRC/usrdef_nam.F90
+++ /dev/null
@@ -1,108 +0,0 @@
-MODULE usrdef_nam
- !!======================================================================
- !! *** MODULE usrdef_nam ***
- !!
- !! === ISOMIP configuration ===
- !!
- !! User defined : set the domain characteristics of a user configuration
- !!======================================================================
- !! History : NEMO ! 2016-03 (S. Flavoni, G. Madec) Original code
- !! ! 2017-02 (P. Mathiot, S. Flavoni) Adapt code to ISOMIP case
- !!----------------------------------------------------------------------
-
- !!----------------------------------------------------------------------
- !! usr_def_nam : read user defined namelist and set global domain size
- !! usr_def_hgr : initialize the horizontal mesh
- !!----------------------------------------------------------------------
- USE dom_oce , ONLY: ln_zco, ln_zps, ln_sco ! flag of type of coordinate
- USE par_oce ! ocean space and time domain
- USE phycst ! physical constants
- !
- USE in_out_manager ! I/O manager
- USE lib_mpp ! MPP library
- USE timing ! Timing
-
- IMPLICIT NONE
- PRIVATE
-
- PUBLIC usr_def_nam ! called by nemogcm.F90
-
- ! !!* namusr_def namelist *!!
- REAL(wp), PUBLIC :: rn_e1deg, rn_e2deg !: horizontal resolution [degrees]
- REAL(wp), PUBLIC :: rn_e3 !: vertical resolution [m]
-
- REAL(wp), PARAMETER, PUBLIC :: rbathy = 900._wp !: depth of the seafloor [m]
-
- !!----------------------------------------------------------------------
- !! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: usrdef_nam.F90 14433 2021-02-11 08:06:49Z smasson $
- !! Software governed by the CeCILL license (see ./LICENSE)
- !!----------------------------------------------------------------------
-CONTAINS
-
- SUBROUTINE usr_def_nam( cd_cfg, kk_cfg, kpi, kpj, kpk, ldIperio, ldJperio, ldNFold, cdNFtype )
- !!----------------------------------------------------------------------
- !! *** ROUTINE dom_nam ***
- !!
- !! ** Purpose : read user defined namelist and define the domain size
- !!
- !! ** Method : read in namusr_def containing all the user specific namelist parameter
- !!
- !! Here ISOMIP configuration
- !!
- !! ** input : - namusr_def namelist found in namelist_cfg
- !!----------------------------------------------------------------------
- CHARACTER(len=*), INTENT(out) :: cd_cfg ! configuration name
- INTEGER , INTENT(out) :: kk_cfg ! configuration resolution
- INTEGER , INTENT(out) :: kpi, kpj, kpk ! global domain sizes
- LOGICAL , INTENT(out) :: ldIperio, ldJperio ! i- and j- periodicity
- LOGICAL , INTENT(out) :: ldNFold ! North pole folding
- CHARACTER(len=1), INTENT(out) :: cdNFtype ! Folding type: T or F
- !
- INTEGER :: ios ! Local integer
- !!
- NAMELIST/namusr_def/ ln_zco, ln_zps, ln_sco, rn_e1deg, rn_e2deg, rn_e3
- !!----------------------------------------------------------------------
- !
- READ ( numnam_cfg, namusr_def, IOSTAT = ios, ERR = 902 )
-902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namusr_def in configuration namelist' )
- !
- IF(lwm) WRITE( numond, namusr_def )
- !
- cd_cfg = 'ISOMIP' ! name & resolution (not used)
- kk_cfg = INT( rn_e3 )
- !
- ! Global Domain size: ISOMIP domain is 15° x 10° x 900 m
- kpi = INT( 15.0 / rn_e1deg ) + 2 ! add 2 for t-point in the east & west coasts
- kpj = INT( 10.0 / rn_e2deg ) + 2 ! - - north & south -
- kpk = INT( rbathy / rn_e3 ) + 1 ! add 1 for t-point in the seafloor
- !
- ! ! Set the lateral boundary condition of the global domain
- ldIperio = .FALSE. ; ldJperio = .FALSE. ! ISOMIP configuration : closed domain
- ldNFold = .FALSE. ; cdNFtype = '-'
- !
- ! ! control print
- IF(lwp) THEN
- WRITE(numout,*) ' '
- WRITE(numout,*) 'usr_def_nam : read the user defined namelist (namusr_def) in namelist_cfg'
- WRITE(numout,*) '~~~~~~~~~~~ '
- WRITE(numout,*) ' Namelist namusr_def : ISOMIP test case'
- WRITE(numout,*) ' type of vertical coordinate : '
- WRITE(numout,*) ' z-coordinate flag ln_zco = ', ln_zco
- WRITE(numout,*) ' z-partial-step coordinate flag ln_zps = ', ln_zps
- WRITE(numout,*) ' s-coordinate flag ln_sco = ', ln_sco
- WRITE(numout,*) ' resolution'
- WRITE(numout,*) ' zonal resolution rn_e1deg = ', rn_e1deg, ' degrees'
- WRITE(numout,*) ' meridional resolution rn_e1deg = ', rn_e1deg, ' degrees'
- WRITE(numout,*) ' vertical resolution rn_e3 = ', rn_e3 , ' meters'
- WRITE(numout,*) ' ISOMIP domain = 15° x 10° x 900 m'
- WRITE(numout,*) ' resulting global domain size : Ni0glo = ', kpi
- WRITE(numout,*) ' Nj0glo = ', kpj
- WRITE(numout,*) ' jpkglo = ', kpk
- WRITE(numout,*) ' '
- ENDIF
- !
- END SUBROUTINE usr_def_nam
-
- !!======================================================================
-END MODULE usrdef_nam
diff --git a/tests/ISOMIP/MY_SRC/usrdef_sbc.F90 b/tests/ISOMIP/MY_SRC/usrdef_sbc.F90
deleted file mode 100644
index b3ff303a842d5898dd4f39d91aaa6ed5e0a65757..0000000000000000000000000000000000000000
--- a/tests/ISOMIP/MY_SRC/usrdef_sbc.F90
+++ /dev/null
@@ -1,90 +0,0 @@
-MODULE usrdef_sbc
- !!======================================================================
- !! *** MODULE usrdef_sbc ***
- !!
- !! === ISOMIP configuration ===
- !!
- !! User defined : surface forcing of a user configuration
- !!======================================================================
- !! History : 4.0 ! 2016-03 (S. Flavoni, G. Madec) user defined interface
- !! ! 2017-02 (P. Mathiot, S. Flavoni) adapt code to ISOMIP case
- !!----------------------------------------------------------------------
-
- !!----------------------------------------------------------------------
- !! usr_def_sbc : user defined surface bounday conditions in ISOMIP case
- !!----------------------------------------------------------------------
- USE oce ! ocean dynamics and tracers
- USE dom_oce ! ocean space and time domain
- USE sbc_oce ! Surface boundary condition: ocean fields
- USE sbc_ice ! Surface boundary condition: ice fields
- USE phycst ! physical constants
- !
- USE in_out_manager ! I/O manager
- USE lib_mpp ! distribued memory computing library
- USE lbclnk ! ocean lateral boundary conditions (or mpp link)
- USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
-
- IMPLICIT NONE
- PRIVATE
-
- PUBLIC usrdef_sbc_oce ! routine called in sbcmod module
- PUBLIC usrdef_sbc_ice_tau ! routine called by icestp.F90 for ice dynamics
- PUBLIC usrdef_sbc_ice_flx ! routine called by icestp.F90 for ice thermo
-
- !!----------------------------------------------------------------------
- !! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: usrdef_sbc.F90 12377 2020-02-12 14:39:06Z acc $
- !! Software governed by the CeCILL license (see ./LICENSE)
- !!----------------------------------------------------------------------
-CONTAINS
-
- SUBROUTINE usrdef_sbc_oce( kt, Kbb )
- !!---------------------------------------------------------------------
- !! *** ROUTINE usr_def_sbc ***
- !!
- !! ** Purpose : provide at each time-step the surface boundary
- !! condition, i.e. the momentum, heat and freshwater fluxes.
- !!
- !! ** Method : all 0 fields, for ISOMIP case
- !! CAUTION : never mask the surface stress field !
- !!
- !! ** Action : - set to ZERO all the ocean surface boundary condition, i.e.
- !! utau, vtau, taum, wndm, qns, qsr, emp, sfx
- !!
- !!----------------------------------------------------------------------
- INTEGER, INTENT(in) :: kt ! ocean time step
- INTEGER, INTENT(in) :: Kbb ! ocean time index
- !!---------------------------------------------------------------------
- !
- IF( kt == nit000 ) THEN
- !
- IF(lwp) WRITE(numout,*)' usr_sbc : ISOMIP case: NO surface forcing'
- IF(lwp) WRITE(numout,*)' ~~~~~~~~~~~ utau = vtau = taum = wndm = qns = qsr = emp = sfx = 0'
- !
- utau(:,:) = 0._wp
- vtau(:,:) = 0._wp
- taum(:,:) = 0._wp
- wndm(:,:) = 0._wp
- !
- emp (:,:) = 0._wp
- sfx (:,:) = 0._wp
- qns (:,:) = 0._wp
- qsr (:,:) = 0._wp
- !
- ENDIF
- !
- END SUBROUTINE usrdef_sbc_oce
-
- SUBROUTINE usrdef_sbc_ice_tau( kt )
- INTEGER, INTENT(in) :: kt ! ocean time step
- END SUBROUTINE usrdef_sbc_ice_tau
-
-
- SUBROUTINE usrdef_sbc_ice_flx( kt, phs, phi )
- INTEGER, INTENT(in) :: kt ! ocean time step
- REAL(wp), DIMENSION(:,:,:), INTENT(in) :: phs ! snow thickness
- REAL(wp), DIMENSION(:,:,:), INTENT(in) :: phi ! ice thickness
- END SUBROUTINE usrdef_sbc_ice_flx
-
- !!======================================================================
-END MODULE usrdef_sbc
diff --git a/tests/ISOMIP/MY_SRC/usrdef_zgr.F90 b/tests/ISOMIP/MY_SRC/usrdef_zgr.F90
deleted file mode 100644
index 225e1ca0f45a25490726832681b8e63650ec801b..0000000000000000000000000000000000000000
--- a/tests/ISOMIP/MY_SRC/usrdef_zgr.F90
+++ /dev/null
@@ -1,236 +0,0 @@
-MODULE usrdef_zgr
- !!======================================================================
- !! *** MODULE usrdef_zgr ***
- !!
- !! === ISOMIP case ===
- !!
- !! user defined : vertical coordinate system of a user configuration
- !!======================================================================
- !! History : 4.0 ! 2016-08 (G. Madec, S. Flavoni) Original code
- !! ! 2017-02 (P. Mathiot, S. Flavoni) Adapt code to ISOMIP case
- !!----------------------------------------------------------------------
-
- !!----------------------------------------------------------------------
- !! usr_def_zgr : user defined vertical coordinate system (required)
- !! zgr_z1d : reference 1D z-coordinate
- !!---------------------------------------------------------------------
- USE oce ! ocean variables
- USE dom_oce , ONLY: mj0 , mj1 ! ocean space and time domain
- USE dom_oce , ONLY: glamt , gphit ! ocean space and time domain
- USE usrdef_nam ! User defined : namelist variables
- !
- USE in_out_manager ! I/O manager
- USE lbclnk ! ocean lateral boundary conditions (or mpp link)
- USE lib_mpp ! distributed memory computing library
- USE timing ! Timing
-
- IMPLICIT NONE
- PRIVATE
-
- PUBLIC usr_def_zgr ! called by domzgr.F90
-
- !! * Substitutions
-# include "do_loop_substitute.h90"
- !!----------------------------------------------------------------------
- !! NEMO/OCE 4.0 , NEMO Consortium (2018)
- !! $Id: usrdef_zgr.F90 13295 2020-07-10 18:24:21Z acc $
- !! Software governed by the CeCILL license (see ./LICENSE)
- !!----------------------------------------------------------------------
-CONTAINS
-
- SUBROUTINE usr_def_zgr( ld_zco , ld_zps , ld_sco , ld_isfcav, & ! type of vertical coordinate
- & pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d , & ! 1D reference vertical coordinate
- & pdept , pdepw , & ! 3D t & w-points depth
- & pe3t , pe3u , pe3v , pe3f , & ! vertical scale factors
- & pe3w , pe3uw , pe3vw, & ! - - -
- & k_top , k_bot ) ! top & bottom ocean level
- !!---------------------------------------------------------------------
- !! *** ROUTINE usr_def_zgr ***
- !!
- !! ** Purpose : User defined the vertical coordinates
- !!
- !!----------------------------------------------------------------------
- LOGICAL , INTENT(in ) :: ld_zco, ld_zps, ld_sco ! vertical coordinate flags ( read in namusr_def )
- LOGICAL , INTENT( out) :: ld_isfcav ! under iceshelf cavity flag
- REAL(wp), DIMENSION(:) , INTENT( out) :: pdept_1d, pdepw_1d ! 1D grid-point depth [m]
- REAL(wp), DIMENSION(:) , INTENT( out) :: pe3t_1d , pe3w_1d ! 1D grid-point depth [m]
- REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pdept, pdepw ! grid-point depth [m]
- REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pe3t , pe3u , pe3v , pe3f ! vertical scale factors [m]
- REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pe3w , pe3uw, pe3vw ! i-scale factors
- INTEGER , DIMENSION(:,:) , INTENT( out) :: k_top, k_bot ! first & last ocean level
- !
- INTEGER :: ji , jj, jk ! dummy indices
- INTEGER :: ij0, ij1 ! dummy indices
- INTEGER :: ik ! local integers
- REAL(wp) :: zfact, z1_jpkm1 ! local scalar
- REAL(wp) :: ze3min, zdepth ! local scalar
- REAL(wp), DIMENSION(jpi,jpj) :: zht , zhu ! bottom depth
- REAL(wp), DIMENSION(jpi,jpj) :: zhisf, zhisfu ! top depth
- !!----------------------------------------------------------------------
- !
- IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*) 'usr_def_zgr : ISOMIP configuration (z(ps)- or s-coordinate closed box ocean without cavities)'
- IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
- !
- !
- ! type of vertical coordinate
- ! ---------------------------
- ! set in usrdef_nam.F90 by reading the namusr_def namelist except for ISF
- ld_isfcav = .TRUE. ! ISF Ice Shelves Flag
- !
- !
- ! Build the vertical coordinate system
- ! ------------------------------------
- !
- ! !== isfdraft ==!
- !
- zht (:,:) = rbathy
- zhisf(:,:) = 200._wp
- ij0 = 1 ; ij1 = 40+nn_hls
- DO jj = mj0(ij0), mj1(ij1)
- zhisf(:,jj)=700.0_wp-(gphit(:,jj)+80.0_wp)*125.0_wp
- END DO
- !
- CALL zgr_z1d( pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d ) ! Reference z-coordinate system
- !
- ! !== top masked level bathymetry ==! (all coordinates)
- !
- IF ( ld_zps ) THEN !== zps-coordinate ==! (partial bottom-steps)
- !
- ze3min = 0.1_wp * rn_e3
- IF(lwp) WRITE(numout,*) ' minimum thickness of the partial cells = 10 % of e3 = ', ze3min
- !
- ! !* bottom ocean compute from the depth of grid-points
- k_bot(:,:) = jpkm1
- DO jk = jpkm1, 1, -1
- WHERE( zht(:,:) < pdepw_1d(jk) + ze3min ) k_bot(:,:) = jk-1
- END DO
- ! !* top ocean compute from the depth of grid-points
- k_top(:,:) = 1 !
- DO jk = 2, jpkm1
- zdepth = pdepw_1d(jk+1) - ze3min
- WHERE( zhisf(:,:) > 0.0 .AND. zhisf(:,:) >= zdepth ) k_top(:,:) = (jk + 1)
- END DO
- !
- ! !* vertical coordinate system
- DO jk = 1, jpk ! initialization to the reference z-coordinate
- pdept(:,:,jk) = pdept_1d(jk)
- pdepw(:,:,jk) = pdepw_1d(jk)
- pe3t (:,:,jk) = pe3t_1d (jk)
- pe3u (:,:,jk) = pe3t_1d (jk)
- pe3v (:,:,jk) = pe3t_1d (jk)
- pe3f (:,:,jk) = pe3t_1d (jk)
- pe3w (:,:,jk) = pe3w_1d (jk)
- pe3uw(:,:,jk) = pe3w_1d (jk)
- pe3vw(:,:,jk) = pe3w_1d (jk)
- END DO
- ! top scale factors and depth at T- and W-points
- DO_2D( 1, 1, 1, 1 )
- ik = k_top(ji,jj)
- IF ( ik > 2 ) THEN
- ! pdeptw at the interface
- pdepw(ji,jj,ik ) = MAX( zhisf(ji,jj) , pdepw(ji,jj,ik) )
- ! e3t in both side of the interface
- pe3t (ji,jj,ik ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik)
- ! pdept in both side of the interface (from previous e3t)
- pdept(ji,jj,ik ) = pdepw(ji,jj,ik ) + pe3t (ji,jj,ik ) * 0.5_wp
- pdept(ji,jj,ik-1) = pdepw(ji,jj,ik ) - pe3t (ji,jj,ik ) * 0.5_wp
- ! pe3w on both side of the interface
- pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik )
- pe3w (ji,jj,ik ) = pdept(ji,jj,ik ) - pdept(ji,jj,ik-1)
- ! e3t into the ice shelf
- pe3t (ji,jj,ik-1) = pdepw(ji,jj,ik ) - pdepw(ji,jj,ik-1)
- pe3w (ji,jj,ik-1) = pdept(ji,jj,ik-1) - pdept(ji,jj,ik-2)
- END IF
- END_2D
- ! bottom scale factors and depth at T- and W-points
- DO_2D( 1, 1, 1, 1 )
- ik = k_bot(ji,jj)
- pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) )
- pe3t (ji,jj,ik ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik)
- pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik )
- !
- pdept(ji,jj,ik ) = pdepw(ji,jj,ik ) + pe3t (ji,jj,ik ) * 0.5_wp
- pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp
- pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik)
- END_2D
- ! ! bottom scale factors and depth at U-, V-, UW and VW-points
- pe3u (:,:,:) = pe3t(:,:,:)
- pe3uw(:,:,:) = pe3w(:,:,:)
- DO_3D( 0, 0, 0, 0, 1, jpk )
- ! ! Computed as the minimum of neighbooring scale factors
- pe3v (ji,jj,jk) = MIN( pe3t(ji,jj,jk), pe3t(ji,jj+1,jk) )
- pe3vw(ji,jj,jk) = MIN( pe3w(ji,jj,jk), pe3w(ji,jj+1,jk) )
- pe3f (ji,jj,jk) = pe3v(ji,jj,jk)
- END_3D
- CALL lbc_lnk( 'usrdef_zgr', pe3v , 'V', 1._wp ) ; CALL lbc_lnk( 'usrdef_zgr', pe3vw, 'V', 1._wp )
- CALL lbc_lnk( 'usrdef_zgr', pe3f , 'F', 1._wp )
- DO jk = 1, jpk
- ! set to z-scale factor if zero (i.e. along closed boundaries) because of lbclnk
- WHERE( pe3u (:,:,jk) == 0._wp ) pe3u (:,:,jk) = pe3t_1d(jk)
- WHERE( pe3v (:,:,jk) == 0._wp ) pe3v (:,:,jk) = pe3t_1d(jk)
- WHERE( pe3f (:,:,jk) == 0._wp ) pe3f (:,:,jk) = pe3t_1d(jk)
- WHERE( pe3uw(:,:,jk) == 0._wp ) pe3uw(:,:,jk) = pe3w_1d(jk)
- WHERE( pe3vw(:,:,jk) == 0._wp ) pe3vw(:,:,jk) = pe3w_1d(jk)
- END DO
- !
- ENDIF
- !
- END SUBROUTINE usr_def_zgr
-
-
- SUBROUTINE zgr_z1d( pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d ) ! 1D reference vertical coordinate
- !!----------------------------------------------------------------------
- !! *** ROUTINE zgr_z1d ***
- !!
- !! ** Purpose : set the depth of model levels and the resulting
- !! vertical scale factors.
- !!
- !! ** Method : 1D z-coordinate system (use in all type of coordinate)
- !! The depth of model levels is set from dep(k), an analytical function:
- !! w-level: depw_1d = dep(k)
- !! t-level: dept_1d = dep(k+0.5)
- !! The scale factors are the discrete derivative of the depth:
- !! e3w_1d(jk) = dk[ dept_1d ]
- !! e3t_1d(jk) = dk[ depw_1d ]
- !!
- !! === Here constant vertical resolution ===
- !!
- !! ** Action : - pdept_1d, pdepw_1d : depth of T- and W-point (m)
- !! - pe3t_1d , pe3w_1d : scale factors at T- and W-levels (m)
- !!----------------------------------------------------------------------
- REAL(wp), DIMENSION(:), INTENT(out) :: pdept_1d, pdepw_1d ! 1D grid-point depth [m]
- REAL(wp), DIMENSION(:), INTENT(out) :: pe3t_1d , pe3w_1d ! 1D vertical scale factors [m]
- !
- INTEGER :: jk ! dummy loop indices
- REAL(wp) :: zt, zw ! local scalar
- !!----------------------------------------------------------------------
- !
- IF(lwp) THEN ! Parameter print
- WRITE(numout,*)
- WRITE(numout,*) ' zgr_z1d : Reference vertical z-coordinates: uniform dz = ', rn_e3
- WRITE(numout,*) ' ~~~~~~~'
- ENDIF
- !
- ! Reference z-coordinate (depth - scale factor at T- and W-points) ! Madec & Imbard 1996 function
- ! ----------------------
- DO jk = 1, jpk
- zw = REAL( jk , wp )
- zt = REAL( jk , wp ) + 0.5_wp
- pdepw_1d(jk) = rn_e3 * REAL( jk-1 , wp )
- pdept_1d(jk) = rn_e3 * ( REAL( jk-1 , wp ) + 0.5_wp )
- pe3w_1d (jk) = rn_e3
- pe3t_1d (jk) = rn_e3
- END DO
- !
- IF(lwp) THEN ! control print
- WRITE(numout,*)
- WRITE(numout,*) ' Reference 1D z-coordinate depth and scale factors:'
- WRITE(numout, "(9x,' level gdept_1d gdepw_1d e3t_1d e3w_1d ')" )
- WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, pdept_1d(jk), pdepw_1d(jk), pe3t_1d(jk), pe3w_1d(jk), jk = 1, jpk )
- ENDIF
- !
- END SUBROUTINE zgr_z1d
-
- !!======================================================================
-END MODULE usrdef_zgr
diff --git a/tests/ISOMIP/cpp_ISOMIP.fcm b/tests/ISOMIP/cpp_ISOMIP.fcm
deleted file mode 100644
index 4055ae28435f2ceea81e07f39f5f06ecbb0e2103..0000000000000000000000000000000000000000
--- a/tests/ISOMIP/cpp_ISOMIP.fcm
+++ /dev/null
@@ -1 +0,0 @@
- bld::tool::fppkeys key_xios
diff --git a/tests/LOCK_EXCHANGE/MY_SRC/usrdef_hgr.F90 b/tests/LOCK_EXCHANGE/MY_SRC/usrdef_hgr.F90
index 62a161477baf829e5cdc9046f3aa4567270fed3c..b4cac5c173f0d2b1a08a778aa8411ce7a0c6e129 100644
--- a/tests/LOCK_EXCHANGE/MY_SRC/usrdef_hgr.F90
+++ b/tests/LOCK_EXCHANGE/MY_SRC/usrdef_hgr.F90
@@ -75,14 +75,14 @@ CONTAINS
zfact = rn_dx * 1.e-3 ! conversion in km
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
! ! longitude (west coast at lon=0°)
- plamt(ji,jj) = zfact * ( - 0.5 + REAL( mig0(ji)-1 , wp ) )
- plamu(ji,jj) = zfact * ( REAL( mig0(ji)-1 , wp ) )
+ plamt(ji,jj) = zfact * ( - 0.5 + REAL( mig(ji,0)-1 , wp ) )
+ plamu(ji,jj) = zfact * ( REAL( mig(ji,0)-1 , wp ) )
plamv(ji,jj) = plamt(ji,jj)
plamf(ji,jj) = plamu(ji,jj)
! ! latitude (south coast at lat= 0°)
- pphit(ji,jj) = zfact * ( - 0.5 + REAL( mjg0(jj)-1 , wp ) )
+ pphit(ji,jj) = zfact * ( - 0.5 + REAL( mjg(jj,0)-1 , wp ) )
pphiu(ji,jj) = pphit(ji,jj)
- pphiv(ji,jj) = zfact * ( REAL( mjg0(jj)-1 , wp ) )
+ pphiv(ji,jj) = zfact * ( REAL( mjg(jj,0)-1 , wp ) )
pphif(ji,jj) = pphiv(ji,jj)
END_2D
!
diff --git a/tests/OVERFLOW/MY_SRC/usrdef_hgr.F90 b/tests/OVERFLOW/MY_SRC/usrdef_hgr.F90
index 0abf8552b8b9fef6f4aef3463d80b948b4724ec8..55d8d2a6125dcc9a1a86f487308ef48c265ca12d 100644
--- a/tests/OVERFLOW/MY_SRC/usrdef_hgr.F90
+++ b/tests/OVERFLOW/MY_SRC/usrdef_hgr.F90
@@ -75,14 +75,14 @@ CONTAINS
zfact = rn_dx * 1.e-3 ! conversion in km
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
! ! longitude (west coast at lon=0°)
- plamt(ji,jj) = zfact * ( - 0.5 + REAL( mig0(ji)-1 , wp ) )
- plamu(ji,jj) = zfact * ( REAL( mig0(ji)-1 , wp ) )
+ plamt(ji,jj) = zfact * ( - 0.5 + REAL( mig(ji,0)-1 , wp ) )
+ plamu(ji,jj) = zfact * ( REAL( mig(ji,0)-1 , wp ) )
plamv(ji,jj) = plamt(ji,jj)
plamf(ji,jj) = plamu(ji,jj)
! ! latitude (south coast at lat= 0°)
- pphit(ji,jj) = zfact * ( - 0.5 + REAL( mjg0(jj)-1 , wp ) )
+ pphit(ji,jj) = zfact * ( - 0.5 + REAL( mjg(jj,0)-1 , wp ) )
pphiu(ji,jj) = pphit(ji,jj)
- pphiv(ji,jj) = zfact * ( REAL( mjg0(jj)-1 , wp ) )
+ pphiv(ji,jj) = zfact * ( REAL( mjg(jj,0)-1 , wp ) )
pphif(ji,jj) = pphiv(ji,jj)
END_2D
!
diff --git a/tests/OVERFLOW/MY_SRC/usrdef_zgr.F90 b/tests/OVERFLOW/MY_SRC/usrdef_zgr.F90
index b39e22ab155ee6eaf7ba10d463f3edfc0205a74d..d0d126ed5631cbf1d65f985ef91fc18f8a6d15b9 100644
--- a/tests/OVERFLOW/MY_SRC/usrdef_zgr.F90
+++ b/tests/OVERFLOW/MY_SRC/usrdef_zgr.F90
@@ -14,8 +14,7 @@ MODULE usrdef_zgr
!! zgr_z1d : reference 1D z-coordinate
!!---------------------------------------------------------------------
USE oce ! ocean variables
- USE dom_oce , ONLY: mi0, mi1 ! ocean space and time domain
- USE dom_oce , ONLY: glamt ! ocean space and time domain
+ USE dom_oce ! ocean space and time domain
USE usrdef_nam ! User defined : namelist variables
!
USE in_out_manager ! I/O manager
@@ -94,10 +93,10 @@ CONTAINS
END_2D
CALL lbc_lnk( 'usrdef_zgr', zhu, 'U', 1. ) ! boundary condition: this mask the surrouding grid-points
! ! ==>>> set by hand non-zero value on first/last columns & rows
- DO ji = mi0(1), mi1(1) ! first row of global domain only
+ DO ji = mi0(1,nn_hls), mi1(1,nn_hls) ! first row of global domain only
zhu(ji,2) = zht(ji,2)
END DO
- DO ji = mi0(jpiglo), mi1(jpiglo) ! last row of global domain only
+ DO ji = mi0(jpiglo,nn_hls), mi1(jpiglo,nn_hls) ! last row of global domain only
zhu(ji,2) = zht(ji,2)
END DO
zhu(:,1) = zhu(:,2)
diff --git a/tests/STATION_ASF/MY_SRC/icesbc.F90 b/tests/STATION_ASF/MY_SRC/icesbc.F90
index 644ad0cfb5607f8dfd1f8c05e880e0650a8c5437..a03ed99fd4b3f07fd7e3a710b8d00486c6c9d0ed 100644
--- a/tests/STATION_ASF/MY_SRC/icesbc.F90
+++ b/tests/STATION_ASF/MY_SRC/icesbc.F90
@@ -152,13 +152,13 @@ CONTAINS
& sf(jp_slp)%fnow(:,:,1), sf(jp_qlw)%fnow(:,:,1), &
& sf(jp_prec)%fnow(:,:,1), sf(jp_snow)%fnow(:,:,1) )
!
- IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su, phs=h_s, phi=h_i )
+ IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( kt, picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su, phs=h_s, phi=h_i )
IF( nn_flxdist /= -1 ) CALL ice_flx_dist ( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_flxdist )
! ! compute conduction flux and surface temperature (as in Jules surface module)
IF( ln_cndflx .AND. .NOT.ln_cndemulate ) &
& CALL blk_ice_qcn ( ln_virtual_itd, t_su, t_bo, h_s, h_i )
CASE ( jp_purecpl ) !--- coupled formulation
- CALL sbc_cpl_ice_flx( picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su, phs=h_s, phi=h_i )
+ CALL sbc_cpl_ice_flx( kt, picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su, phs=h_s, phi=h_i )
IF( nn_flxdist /= -1 ) CALL ice_flx_dist ( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_flxdist )
END SELECT
diff --git a/tests/STATION_ASF/MY_SRC/stpctl.F90 b/tests/STATION_ASF/MY_SRC/stpctl.F90
index c51b350411df9c704245f23b616ec899dc5af078..8923df79f04f0812475d05d3dbf81123be3eae8b 100644
--- a/tests/STATION_ASF/MY_SRC/stpctl.F90
+++ b/tests/STATION_ASF/MY_SRC/stpctl.F90
@@ -74,8 +74,8 @@ CONTAINS
IF( nstop > 0 .AND. ngrdstop > -1 ) RETURN ! stpctl was already called by a child grid
!
ll_wrtstp = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend )
- ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1
- ll_wrtruns = ( ll_colruns .OR. jpnij == 1 ) .AND. lwm
+ ll_colruns = sn_cfctl%l_runstat .AND. ll_wrtstp .AND. jpnij > 1
+ ll_wrtruns = sn_cfctl%l_runstat .AND. ll_wrtstp .AND. lwm
!
IF( kt == nit000 ) THEN
!
@@ -121,8 +121,8 @@ CONTAINS
!
ll_0oce = .NOT. ANY( llmsk(:,:) ) ! no ocean point in the inner domain?
!
- zmax(1) = MAXVAL( taum(:,:) , mask = llmsk ) ! max wind stress module
- zmax(2) = MAXVAL( ABS( qns(:,:) ), mask = llmsk ) ! max non-solar heat flux
+ zmax(1) = MAXVAL( taum(:,:) , mask = llmsk(A2D(0)) ) ! max wind stress module
+ zmax(2) = MAXVAL( ABS( qns(:,:) ), mask = llmsk(A2D(0)) ) ! max non-solar heat flux
zmax(3) = MAXVAL( ABS( emp(:,:) ), mask = llmsk ) ! max E-P
zmax(jpvar+1) = REAL( nstop, wp ) ! stop indicator
!
@@ -159,9 +159,9 @@ CONTAINS
! first: close the netcdf file, so we can read it
IF( lwm .AND. kt /= nitend ) istatus = NF90_CLOSE(nrunid)
! get global loc on the min/max
- CALL mpp_maxloc( 'stpctl', taum(:,:) , llmsk, zzz, iloc(1:2,1) ) ! mpp_maxloc ok if mask = F
- CALL mpp_maxloc( 'stpctl',ABS( qns(:,:) ), llmsk, zzz, iloc(1:2,2) )
- CALL mpp_minloc( 'stpctl',ABS( emp(:,:) ), llmsk, zzz, iloc(1:2,3) )
+ CALL mpp_maxloc( 'stpctl', taum(:,:) , llmsk(A2D(0)), zzz, iloc(1:2,1) ) ! mpp_maxloc ok if mask = F
+ CALL mpp_maxloc( 'stpctl',ABS( qns(:,:) ), llmsk(A2D(0)), zzz, iloc(1:2,2) )
+ CALL mpp_minloc( 'stpctl',ABS( emp(:,:) ), llmsk , zzz, iloc(1:2,3) )
! find which subdomain has the max.
iareamin(:) = jpnij+1 ; iareamax(:) = 0 ; iareasum(:) = 0
DO ji = 1, jptst
@@ -174,11 +174,11 @@ CONTAINS
CALL mpp_sum( "stpctl", iareasum ) ! sum over the global domain
ELSE ! find local min and max locations:
! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc
- iloc(1:2,1) = MAXLOC( taum(:,:) , mask = llmsk )
- iloc(1:2,2) = MAXLOC( ABS( qns(:,:) ), mask = llmsk )
- iloc(1:2,3) = MINLOC( ABS( emp(:,:) ), mask = llmsk )
+ iloc(1:2,1) = MAXLOC( taum(:,:) , mask = llmsk(A2D(0)) )
+ iloc(1:2,2) = MAXLOC( ABS( qns(:,:) ), mask = llmsk(A2D(0)) )
+ iloc(1:2,3) = MINLOC( ABS( emp(:,:) ), mask = llmsk )
DO ji = 1, jptst ! local domain indices ==> global domain indices, excluding halos
- iloc(1:2,ji) = (/ mig0(iloc(1,ji)), mjg0(iloc(2,ji)) /)
+ iloc(1:2,ji) = (/ mig(iloc(1,ji),0), mjg(iloc(2,ji),0) /)
END DO
iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information
ENDIF
diff --git a/tests/STATION_ASF/MY_SRC/usrdef_hgr.F90 b/tests/STATION_ASF/MY_SRC/usrdef_hgr.F90
index 65d186a5be42264facc748ed403f1ab2cae91198..199dce11f323fa08fd2b5b3467d7a5ccf5952c67 100644
--- a/tests/STATION_ASF/MY_SRC/usrdef_hgr.F90
+++ b/tests/STATION_ASF/MY_SRC/usrdef_hgr.F90
@@ -13,7 +13,6 @@ MODULE usrdef_hgr
!!----------------------------------------------------------------------
!! usr_def_hgr : initialize the horizontal mesh
!!----------------------------------------------------------------------
- USE dom_oce , ONLY: nimpp, njmpp ! ocean space and time domain
USE c1d , ONLY: rn_lon1d, rn_lat1d ! ocean lon/lat define by namelist
USE par_oce ! ocean space and time domain
USE phycst ! physical constants
diff --git a/tests/STATION_ASF/MY_SRC/usrdef_nam.F90 b/tests/STATION_ASF/MY_SRC/usrdef_nam.F90
index fda9175c2fe7d013006c4dbf0400440518bde157..b16e928502e23c493acda8bb985d5b0a4dc3f57d 100644
--- a/tests/STATION_ASF/MY_SRC/usrdef_nam.F90
+++ b/tests/STATION_ASF/MY_SRC/usrdef_nam.F90
@@ -14,7 +14,6 @@ MODULE usrdef_nam
!! usr_def_nam : read user defined namelist and set global domain size
!! usr_def_hgr : initialize the horizontal mesh
!!----------------------------------------------------------------------
- USE dom_oce , ONLY: nimpp, njmpp ! ocean space and time domain
USE par_oce ! ocean space and time domain
USE phycst ! physical constants
!
diff --git a/tests/SWG/MY_SRC/usrdef_fmask.F90 b/tests/SWG/MY_SRC/usrdef_fmask.F90
index 014180924d3278374617df69cf3ce38eee13e865..6ad45ee16aab6edb5d60c5558acdfaa390ccf764 100644
--- a/tests/SWG/MY_SRC/usrdef_fmask.F90
+++ b/tests/SWG/MY_SRC/usrdef_fmask.F90
@@ -68,22 +68,22 @@ CONTAINS
!
IF(lwp) WRITE(numout,*) ' Gibraltar '
ij0 = 101 ; ij1 = 101 ! Gibraltar strait : partial slip (pfmsk=0.5)
- ii0 = 139 ; ii1 = 140 ; pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 0.5_wp
+ ii0 = 139 ; ii1 = 140 ; pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls) , mj0(ij0,nn_hls):mj1(ij1,nn_hls) , 1:jpk ) = 0.5_wp
ij0 = 102 ; ij1 = 102
- ii0 = 139 ; ii1 = 140 ; pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 0.5_wp
+ ii0 = 139 ; ii1 = 140 ; pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls) , mj0(ij0,nn_hls):mj1(ij1,nn_hls) , 1:jpk ) = 0.5_wp
!
IF(lwp) WRITE(numout,*) ' Bab el Mandeb '
ij0 = 87 ; ij1 = 88 ! Bab el Mandeb : partial slip (pfmsk=1)
- ii0 = 160 ; ii1 = 160 ; pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 1._wp
+ ii0 = 160 ; ii1 = 160 ; pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls) , mj0(ij0,nn_hls):mj1(ij1,nn_hls) , 1:jpk ) = 1._wp
ij0 = 88 ; ij1 = 88
- ii0 = 159 ; ii1 = 159 ; pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 1._wp
+ ii0 = 159 ; ii1 = 159 ; pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls) , mj0(ij0,nn_hls):mj1(ij1,nn_hls) , 1:jpk ) = 1._wp
!
! We keep this as an example but it is instable in this case
!IF(lwp) WRITE(numout,*) ' Danish straits '
! ij0 = 115 ; ij1 = 115 ! Danish straits : strong slip (pfmsk > 2)
- ! ii0 = 145 ; ii1 = 146 ; pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp
+ ! ii0 = 145 ; ii1 = 146 ; pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls) , mj0(ij0,nn_hls):mj1(ij1,nn_hls) , 1:jpk ) = 4._wp
! ij0 = 116 ; ij1 = 116
- ! ii0 = 145 ; ii1 = 146 ; pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp
+ ! ii0 = 145 ; ii1 = 146 ; pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls) , mj0(ij0,nn_hls):mj1(ij1,nn_hls) , 1:jpk ) = 4._wp
!
CASE( 1 ) ! R1 case
IF(lwp) WRITE(numout,*)
@@ -99,35 +99,35 @@ CONTAINS
IF(lwp) WRITE(numout,*) ' orca_r1: increase friction near the following straits : '
IF(lwp) WRITE(numout,*) ' Gibraltar '
ii0 = 282 ; ii1 = 283 ! Gibraltar Strait
- ij0 = 241 - isrow ; ij1 = 241 - isrow ; pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp
+ ij0 = 241 - isrow ; ij1 = 241 - isrow ; pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls),mj0(ij0,nn_hls):mj1(ij1,nn_hls),1:jpk ) = 2._wp
!
IF(lwp) WRITE(numout,*) ' Bhosporus '
ii0 = 314 ; ii1 = 315 ! Bhosporus Strait
- ij0 = 248 - isrow ; ij1 = 248 - isrow ; pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp
+ ij0 = 248 - isrow ; ij1 = 248 - isrow ; pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls),mj0(ij0,nn_hls):mj1(ij1,nn_hls),1:jpk ) = 2._wp
!
IF(lwp) WRITE(numout,*) ' Makassar (Top) '
ii0 = 48 ; ii1 = 48 ! Makassar Strait (Top)
- ij0 = 189 - isrow ; ij1 = 190 - isrow ; pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp
+ ij0 = 189 - isrow ; ij1 = 190 - isrow ; pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls),mj0(ij0,nn_hls):mj1(ij1,nn_hls),1:jpk ) = 3._wp
!
IF(lwp) WRITE(numout,*) ' Lombok '
ii0 = 44 ; ii1 = 44 ! Lombok Strait
- ij0 = 164 - isrow ; ij1 = 165 - isrow ; pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp
+ ij0 = 164 - isrow ; ij1 = 165 - isrow ; pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls),mj0(ij0,nn_hls):mj1(ij1,nn_hls),1:jpk ) = 2._wp
!
IF(lwp) WRITE(numout,*) ' Ombai '
ii0 = 53 ; ii1 = 53 ! Ombai Strait
- ij0 = 164 - isrow ; ij1 = 165 - isrow ; pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp
+ ij0 = 164 - isrow ; ij1 = 165 - isrow ; pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls),mj0(ij0,nn_hls):mj1(ij1,nn_hls),1:jpk ) = 2._wp
!
IF(lwp) WRITE(numout,*) ' Timor Passage '
ii0 = 56 ; ii1 = 56 ! Timor Passage
- ij0 = 164 - isrow ; ij1 = 165 - isrow ; pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp
+ ij0 = 164 - isrow ; ij1 = 165 - isrow ; pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls),mj0(ij0,nn_hls):mj1(ij1,nn_hls),1:jpk ) = 2._wp
!
IF(lwp) WRITE(numout,*) ' West Halmahera '
ii0 = 58 ; ii1 = 58 ! West Halmahera Strait
- ij0 = 181 - isrow ; ij1 = 182 - isrow ; pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp
+ ij0 = 181 - isrow ; ij1 = 182 - isrow ; pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls),mj0(ij0,nn_hls):mj1(ij1,nn_hls),1:jpk ) = 3._wp
!
IF(lwp) WRITE(numout,*) ' East Halmahera '
ii0 = 55 ; ii1 = 55 ! East Halmahera Strait
- ij0 = 181 - isrow ; ij1 = 182 - isrow ; pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp
+ ij0 = 181 - isrow ; ij1 = 182 - isrow ; pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls),mj0(ij0,nn_hls):mj1(ij1,nn_hls),1:jpk ) = 3._wp
!
CASE DEFAULT
IF(lwp) WRITE(numout,*)
diff --git a/tests/SWG/MY_SRC/usrdef_nam.F90 b/tests/SWG/MY_SRC/usrdef_nam.F90
index 37742d7658c322b8a30b21be343e830a8db20e83..fb95a32ef02068a0972ecf257ddde41f12adce92 100644
--- a/tests/SWG/MY_SRC/usrdef_nam.F90
+++ b/tests/SWG/MY_SRC/usrdef_nam.F90
@@ -14,7 +14,6 @@ MODULE usrdef_nam
!! usr_def_nam : read user defined namelist and set global domain size
!! usr_def_hgr : initialize the horizontal mesh
!!----------------------------------------------------------------------
- USE dom_oce , ONLY: nimpp, njmpp ! ocean space and time domain
USE par_oce ! ocean space and time domain
USE phycst ! physical constants
!
diff --git a/tests/SWG/MY_SRC/usrdef_sbc.F90 b/tests/SWG/MY_SRC/usrdef_sbc.F90
index 66ea77ad2ea3d1a8fc6f939af2f1336c644b7032..6283b4a579bbd5f9d238646aaf3ba6b8cd72e2fe 100644
--- a/tests/SWG/MY_SRC/usrdef_sbc.F90
+++ b/tests/SWG/MY_SRC/usrdef_sbc.F90
@@ -86,6 +86,7 @@ CONTAINS
ztauu = REAL( rn_tau, wp ) * COS( rn_theta * rad ) ! N.m-2
ztauv = - REAL( rn_tau, wp ) * SIN( rn_theta * rad ) ! N.m-2
+ zcoef = 1. / ( zrhoa * zcdrag )
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
! length of the domain : 2000km x 2000km
utau(ji,jj) = - ztauu * COS( rpi * gphit(ji,jj) / 2000000._wp)
@@ -93,10 +94,9 @@ CONTAINS
END_2D
! module of wind stress and wind speed at T-point
- zcoef = 1. / ( zrhoa * zcdrag )
- DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+ DO_2D( 0, 0, 0, 0 )
zmod = SQRT( utau(ji,jj) * utau(ji,jj) + vtau(ji,jj) * vtau(ji,jj) )
- taum(ji,jj) = zmod
+ taum(ji,jj) = zmod
wndm(ji,jj) = SQRT( zmod * zcoef )
END_2D
!
diff --git a/tests/TSUNAMI/MY_SRC/usrdef_hgr.F90 b/tests/TSUNAMI/MY_SRC/usrdef_hgr.F90
index 5c9921e476aeb7ce0149f0a8ca0bfbbd0fd0343b..d8a5d6d84375f21df21d3056028b6d60d830122d 100644
--- a/tests/TSUNAMI/MY_SRC/usrdef_hgr.F90
+++ b/tests/TSUNAMI/MY_SRC/usrdef_hgr.F90
@@ -88,8 +88,8 @@ CONTAINS
#endif
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- zti = REAL( mig0(ji)-ii0, wp ) ! =0 at i=ii0 in the global grid without halos
- ztj = REAL( mjg0(jj)-ij0, wp ) ! =0 at i=ij0 in the global grid without halos
+ zti = REAL( mig(ji,0)-ii0, wp ) ! =0 at i=ii0 in the global grid without halos
+ ztj = REAL( mjg(jj,0)-ij0, wp ) ! =0 at i=ij0 in the global grid without halos
plamt(ji,jj) = rn_dx * zti
plamu(ji,jj) = rn_dx * ( zti + 0.5_wp )
diff --git a/tests/VORTEX/MY_SRC/usrdef_hgr.F90 b/tests/VORTEX/MY_SRC/usrdef_hgr.F90
index 7721821ba9be90850d0366fc2e5996a50e21be54..c6d0003e8d1ad92018c9dcd946dc0024fabf6767 100644
--- a/tests/VORTEX/MY_SRC/usrdef_hgr.F90
+++ b/tests/VORTEX/MY_SRC/usrdef_hgr.F90
@@ -93,8 +93,8 @@ CONTAINS
ENDIF
#endif
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- zti = REAL( mig0(ji)-1, wp ) ! start at i=0 in the global grid without halos
- ztj = REAL( mjg0(jj)-1, wp ) ! start at j=0 in the global grid without halos
+ zti = REAL( mig(ji,0)-1, wp ) ! start at i=0 in the global grid without halos
+ ztj = REAL( mjg(jj,0)-1, wp ) ! start at j=0 in the global grid without halos
plamt(ji,jj) = roffsetx + rn_dx * 1.e-3 * ( zti - 0.5_wp )
plamu(ji,jj) = roffsetx + rn_dx * 1.e-3 * zti
diff --git a/tests/WAD/MY_SRC/usrdef_hgr.F90 b/tests/WAD/MY_SRC/usrdef_hgr.F90
index 38cec157e7b781e96bd2ca967faf0dd227091de6..459c26dc3f54ce0ae00738abb1548fc7bfe6eabc 100644
--- a/tests/WAD/MY_SRC/usrdef_hgr.F90
+++ b/tests/WAD/MY_SRC/usrdef_hgr.F90
@@ -75,14 +75,14 @@ CONTAINS
zfact = rn_dx * 1.e-3 ! conversion in km
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
! ! longitude (west coast at lon=0°)
- plamt(ji,jj) = zfact * ( - 0.5 + REAL( mig0(ji)-1 , wp ) )
- plamu(ji,jj) = zfact * ( REAL( mig0(ji)-1 , wp ) )
+ plamt(ji,jj) = zfact * ( - 0.5 + REAL( mig(ji,0)-1 , wp ) )
+ plamu(ji,jj) = zfact * ( REAL( mig(ji,0)-1 , wp ) )
plamv(ji,jj) = plamt(ji,jj)
plamf(ji,jj) = plamu(ji,jj)
! ! latitude (south coast at lat= 0°)
- pphit(ji,jj) = zfact * ( - 0.5 + REAL( mjg0(jj)-1 , wp ) )
+ pphit(ji,jj) = zfact * ( - 0.5 + REAL( mjg(jj,0)-1 , wp ) )
pphiu(ji,jj) = pphit(ji,jj)
- pphiv(ji,jj) = zfact * ( REAL( mjg0(jj)-1 , wp ) )
+ pphiv(ji,jj) = zfact * ( REAL( mjg(jj,0)-1 , wp ) )
pphif(ji,jj) = pphiv(ji,jj)
END_2D
!
diff --git a/tests/WAD/MY_SRC/usrdef_istate.F90 b/tests/WAD/MY_SRC/usrdef_istate.F90
index b34b77c77fbe69505b28bef4498976e054688eef..36896424d5c92494e0f2ecb14b9243711f3a4019 100644
--- a/tests/WAD/MY_SRC/usrdef_istate.F90
+++ b/tests/WAD/MY_SRC/usrdef_istate.F90
@@ -13,8 +13,7 @@ MODULE usrdef_istate
!!----------------------------------------------------------------------
!! usr_def_istate : initial state in Temperature and salinity
!!----------------------------------------------------------------------
- USE par_oce ! ocean space and time domain
- USE dom_oce , ONLY : mi0, mig, mjg, glamt, gphit, ht_0
+ USE dom_oce ! ocean space and time domain
USE phycst ! physical constants
USE wet_dry ! Wetting and drying
!
@@ -44,7 +43,7 @@ CONTAINS
!! ** Purpose : Initialization of the dynamics and tracers
!! Here WAD_TEST_CASES configuration
!!
-q !! ** Method : - set temprature field
+ !! ** Method : - set temprature field
!! - set salinity field
!!----------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pdept ! depth of t-point [m]
@@ -116,7 +115,7 @@ q !! ** Method : - set temprature field
IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel with gaussian ridge'
IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
!
- DO ji = mi0(jpiglo/2), mi0(jpiglo)
+ DO ji = mi0(jpiglo/2,nn_hls), mi1(jpiglo,nn_hls)
pts(ji,:,:,jp_sal) = 30._wp
END DO
!
@@ -230,7 +229,7 @@ q !! ** Method : - set temprature field
pssh(ji,:) = ( -2.5_wp + 5.5_wp*(50._wp-glamt(ji,1))/50._wp)*ptmask(ji,:,1)
END DO
!
- DO ji = mi0(jpiglo/2), mi0(jpiglo)
+ DO ji = mi0(jpiglo/2,nn_hls), mi1(jpiglo,nn_hls)
pssh(ji,:) = -0.1*ptmask(ji,:,1)
END DO
!
diff --git a/tests/WAD/MY_SRC/usrdef_zgr.F90 b/tests/WAD/MY_SRC/usrdef_zgr.F90
index eab2b9a325da1789b58db614c2e3bc6bc181996e..df9970a0b289ce811f436720e5ef95cf711b0a36 100644
--- a/tests/WAD/MY_SRC/usrdef_zgr.F90
+++ b/tests/WAD/MY_SRC/usrdef_zgr.F90
@@ -14,7 +14,7 @@ MODULE usrdef_zgr
!! zgr_z : reference 1D z-coordinate
!!---------------------------------------------------------------------
USE oce ! ocean variables
- USE dom_oce , ONLY: ht_0, mi0, mi1, mj0, mj1, glamt, gphit ! ocean space and time domain
+ USE dom_oce ! ocean space and time domain
USE usrdef_nam ! User defined : namelist variables
USE wet_dry , ONLY: rn_wdmin1, rn_wdmin2, rn_wdld ! Wetting and drying
!
@@ -101,10 +101,10 @@ CONTAINS
zi = MIN((glamt(ji,1) - 10.0)/40.0, 1.0 )
zht(ji,:) = MAX(zbathy*zi, -2.0)
END DO
- zht(mi0(1):mi1(1),:) = -4._wp
- zht(mi0(jpiglo):mi1(jpiglo),:) = -4._wp
- zht(:,mj0(1):mj1(1)) = -4._wp
- zht(:,mj0(jpjglo):mj1(jpjglo)) = -4._wp
+ zht(mi0( 1,nn_hls):mi1( 1,nn_hls),:) = -4._wp
+ zht(mi0(jpiglo,nn_hls):mi1(jpiglo,nn_hls),:) = -4._wp
+ zht(:,mj0( 1,nn_hls):mj1( 1,nn_hls)) = -4._wp
+ zht(:,mj0(jpjglo,nn_hls):mj1(jpjglo,nn_hls)) = -4._wp
! ! ====================
CASE ( 2, 3, 8 ) ! WAD 2 or 3 configuration
! ! ====================
@@ -117,11 +117,11 @@ CONTAINS
zi = MAX(1.0-((glamt(ji,1)-25.0)**2)/484.0, -0.3 )
zht(ji,:) = MAX(zbathy*zi, -2.0)
END DO
- zht(mi0(1):mi1(1),:) = -4._wp
- zht(mi0(jpiglo):mi1(jpiglo),:) = -4._wp
+ zht(mi0( 1,nn_hls):mi1( 1,nn_hls),:) = -4._wp
+ zht(mi0(jpiglo,nn_hls):mi1(jpiglo,nn_hls),:) = -4._wp
IF( nn_cfg /= 8 ) THEN
- zht(:,mj0(1):mj1(1)) = -4._wp
- zht(:,mj0(jpjglo):mj1(jpjglo)) = -4._wp
+ zht(:,mj0( 1,nn_hls):mj1( 1,nn_hls)) = -4._wp
+ zht(:,mj0(jpjglo,nn_hls):mj1(jpjglo,nn_hls)) = -4._wp
ENDIF
! ! ====================
CASE ( 4 ) ! WAD 4 configuration
@@ -138,10 +138,10 @@ CONTAINS
zht(ji,jj) = MAX(zbathy*zi*zj, -2.0)
END DO
END DO
- zht(mi0(1):mi1(1),:) = -4._wp
- zht(mi0(jpiglo):mi1(jpiglo),:) = -4._wp
- zht(:,mj0(1):mj1(1)) = -4._wp
- zht(:,mj0(jpjglo):mj1(jpjglo)) = -4._wp
+ zht(mi0(1 ,nn_hls):mi1( 1,nn_hls),:) = -4._wp
+ zht(mi0(jpiglo,nn_hls):mi1(jpiglo,nn_hls),:) = -4._wp
+ zht(:,mj0( 1,nn_hls):mj1( 1,nn_hls)) = -4._wp
+ zht(:,mj0(jpjglo,nn_hls):mj1(jpjglo,nn_hls)) = -4._wp
! ! ===========================
CASE ( 5 ) ! WAD 5 configuration
! ! ====================
@@ -168,10 +168,10 @@ CONTAINS
ENDIF
END DO
! ! ===========================
- zht(mi0(1):mi1(1),:) = -4._wp
- zht(mi0(jpiglo):mi1(jpiglo),:) = -4._wp
- zht(:,mj0(1):mj1(1)) = -4._wp
- zht(:,mj0(jpjglo):mj1(jpjglo)) = -4._wp
+ zht(mi0( 1,nn_hls):mi1( 1,nn_hls),:) = -4._wp
+ zht(mi0(jpiglo,nn_hls):mi1(jpiglo,nn_hls),:) = -4._wp
+ zht(:,mj0( 1,nn_hls):mj1( 1,nn_hls)) = -4._wp
+ zht(:,mj0(jpjglo,nn_hls):mj1(jpjglo,nn_hls)) = -4._wp
! ! ===========================
CASE ( 6 ) ! WAD 6 configuration
! ! ====================
@@ -185,10 +185,10 @@ CONTAINS
zj = 1.075*MAX(EXP(-1.0*((glamt(ji,1)-25.0)**2)/32.0) , 0.0 )
zht(ji,:) = MAX(zbathy*(zi-zj), -2.0)
END DO
- zht(mi0(1):mi1(1),:) = -4._wp
- zht(mi0(jpiglo):mi1(jpiglo),:) = -4._wp
- zht(:,mj0(1):mj1(1)) = -4._wp
- zht(:,mj0(jpjglo):mj1(jpjglo)) = -4._wp
+ zht(mi0( 1,nn_hls):mi1( 1,nn_hls),:) = -4._wp
+ zht(mi0(jpiglo,nn_hls):mi1(jpiglo,nn_hls),:) = -4._wp
+ zht(:,mj0( 1,nn_hls):mj1( 1,nn_hls)) = -4._wp
+ zht(:,mj0(jpjglo,nn_hls):mj1(jpjglo,nn_hls)) = -4._wp
! ! ===========================
CASE ( 7 ) ! WAD 7 configuration
! ! ====================
@@ -215,9 +215,9 @@ CONTAINS
ENDIF
END DO
! ! ===========================
- zht(mi0(1):mi1(1),:) = -4._wp
- zht(:,mj0(1):mj1(1)) = -4._wp
- zht(:,mj0(jpjglo):mj1(jpjglo)) = -4._wp
+ zht(mi0( 1,nn_hls):mi1( 1,nn_hls),:) = -4._wp
+ zht(:,mj0( 1,nn_hls):mj1( 1,nn_hls)) = -4._wp
+ zht(:,mj0(jpjglo,nn_hls):mj1(jpjglo,nn_hls)) = -4._wp
CASE DEFAULT
! ! ===========================
WRITE(ctmp1,*) 'WAD test with a ', nn_cfg,' option is not coded'
@@ -234,10 +234,10 @@ CONTAINS
END_2D
CALL lbc_lnk( 'usrdef_zgr', zhu, 'U', 1. ) ! boundary condition: this mask the surrounding grid-points
! ! ==>>> set by hand non-zero value on first/last columns & rows
- DO ji = mi0(1), mi1(1) ! first row of global domain only
+ DO ji = mi0( 1,nn_hls), mi1( 1,nn_hls) ! first row of global domain only
zhu(ji,:) = zht(1,:)
END DO
- DO ji = mi0(jpiglo), mi1(jpiglo) ! last row of global domain only
+ DO ji = mi0(jpiglo,nn_hls), mi1(jpiglo,nn_hls) ! last row of global domain only
zhu(ji,:) = zht(jpi,:)
END DO
! at v-point: averaging zht
@@ -246,10 +246,10 @@ CONTAINS
zhv(ji,jj) = 0.5_wp * ( zht(ji,jj) + zht(ji,jj+1) )
END_2D
CALL lbc_lnk( 'usrdef_zgr', zhv, 'V', 1. ) ! boundary condition: this mask the surrounding grid-points
- DO jj = mj0(1), mj1(1) ! first row of global domain only
+ DO jj = mj0( 1,nn_hls), mj1( 1,nn_hls) ! first row of global domain only
zhv(:,jj) = zht(:,jj)
END DO
- DO jj = mj0(jpjglo), mj1(jpjglo) ! last row of global domain only
+ DO jj = mj0(jpjglo,nn_hls), mj1(jpjglo,nn_hls) ! last row of global domain only
zhv(:,jj) = zht(:,jj)
END DO
!
@@ -261,10 +261,10 @@ CONTAINS
! no ocean cavities : top ocean level is ONE, except over land
! the ocean basin surrounnded by land (1+nn_hls grid-points) set through lbc_lnk call
z2d(:,:) = 1._wp ! surface ocean is the 1st level
- z2d(mi0(1):mi1(1),:) = 0._wp
- z2d(mi0(jpiglo):mi1(jpiglo),:) = 0._wp
- z2d(:,mj0(1):mj1(1)) = 0._wp
- z2d(:,mj0(jpjglo):mj1(jpjglo)) = 0._wp
+ z2d(mi0( 1,nn_hls):mi1( 1,nn_hls),:) = 0._wp
+ z2d(mi0(jpiglo,nn_hls):mi1(jpiglo,nn_hls),:) = 0._wp
+ z2d(:,mj0( 1,nn_hls):mj1( 1,nn_hls)) = 0._wp
+ z2d(:,mj0(jpjglo,nn_hls):mj1(jpjglo,nn_hls)) = 0._wp
CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. ) ! closed basin, see userdef_nam.F90
k_top(:,:) = NINT( z2d(:,:) )
diff --git a/tools/MISCELLANEOUS/chk_jijj_in_doloops.sh b/tools/MISCELLANEOUS/chk_jijj_in_doloops.sh
new file mode 100755
index 0000000000000000000000000000000000000000..2664643b2eb7ef59a8fc836a1b1e7390dc1bd016
--- /dev/null
+++ b/tools/MISCELLANEOUS/chk_jijj_in_doloops.sh
@@ -0,0 +1,55 @@
+#!/bin/bash
+#
+# check if a do loop, starting with DO_2D, DO_3D ou DO ji=, contains (:,:
+# that most probably should be (ji,jj
+#
+set -u
+
+for ff in $( find src -name "*90" ) */*/MY_SRC/*90
+do
+
+ for ll1 in $( grep -n DO_2D $ff | sed -s "s/:.*//" )
+ do
+ nb=$( sed -n ${ll1},/END_2D/p $ff | sed -e "s/\!.*//" | grep -c "( *: *, *:" )
+ if [ $nb -ne 0 ]
+ then
+ echo "----------------------------------------------"
+ echo
+ echo "error in DO_2D: $ff $nb"
+ sed -n ${ll1},/END_2D/p $ff
+ echo
+ fi
+ done
+
+ for ll1 in $( grep -n DO_3D $ff | sed -s "s/:.*//" )
+ do
+ nb=$( sed -n ${ll1},/END_3D/p $ff | sed -e "s/\!.*//" | grep -c "( *: *, *:" )
+ if [ $nb -ne 0 ]
+ then
+ echo "----------------------------------------------"
+ echo
+ echo "error in DO_3D: $ff $nb"
+ sed -n ${ll1},/END_3D/p $ff
+ echo
+ fi
+ done
+
+ for ll1 in $( grep -in "DO *ji *=" $ff | sed -s "s/:.*//" )
+ do
+ nb=$( sed -n ${ll1},/"[eE][nN][dD] *[dD][oO]"/p $ff | sed -e "s/\!.*//" | grep -c "( *: *, *:" )
+ if [ $nb -ne 0 ]
+ then
+ echo "----------------------------------------------"
+ echo
+ echo "error in END DO: $ff $nb"
+ sed -n ${ll1},/"[eE][nN][dD] *[dD][oO]"/p $ff
+ echo
+ fi
+ done
+
+done
+
+
+
+
+
diff --git a/tools/TOYATM/EXP/grids.nc b/tools/TOYATM/EXP/grids.nc
index e728348cc573dc61bd3941920bbdb73e9bec8889..ef44d6ed4e5b6a1d734dbe7bd546fbdaa3ef2d43 100644
Binary files a/tools/TOYATM/EXP/grids.nc and b/tools/TOYATM/EXP/grids.nc differ
diff --git a/tools/TOYATM/EXP/masks.nc b/tools/TOYATM/EXP/masks.nc
index edce6309194676c00c6d703cf96208dc965c9a72..019431eb8d1333490745140b93ebfd780a23f809 100644
Binary files a/tools/TOYATM/EXP/masks.nc and b/tools/TOYATM/EXP/masks.nc differ
diff --git a/tools/TOYATM/EXP/namcouple b/tools/TOYATM/EXP/namcouple
index 5885241cc6bfb0e004a18647c88da96347ac2508..1890c33ffdda09b79a59647f38a3074e5a30a53d 100755
--- a/tools/TOYATM/EXP/namcouple
+++ b/tools/TOYATM/EXP/namcouple
@@ -19,7 +19,7 @@
############################################
$STRINGS
O_TepMix ATSSTSST 1 5400 3 rst.nc EXPOUT
-182 149 180 90 torc lmdz
+180 148 180 90 torc lmdz
P 2 P 0
CHECKIN SCRIPR CHECKOUT
INT=1
@@ -27,7 +27,7 @@ BILINEAR LR SCALAR LATLON 1
INT=1
#
ATSOLFLX O_QnsMix 1 5400 4 rst.nc EXPOUT
-180 90 182 149 lmdz torc
+180 90 180 148 lmdz torc
P 0 P 2
CHECKIN BLASOLD SCRIPR CHECKOUT
INT=1
@@ -36,7 +36,7 @@ BILINEAR LR SCALAR LATLON 1
INT=1
#
ATSOLFLX O_QnsIce 1 5400 4 rst.nc EXPOUT
-180 90 182 149 lmdz torc
+180 90 180 148 lmdz torc
P 0 P 2
CHECKIN BLASOLD SCRIPR CHECKOUT
INT=1
@@ -45,7 +45,7 @@ BILINEAR LR SCALAR LATLON 1
INT=1
#
ATSOLFLX O_QsrIce 1 5400 4 rst.nc EXPOUT
-180 90 182 149 lmdz torc
+180 90 180 148 lmdz torc
P 0 P 2
CHECKIN BLASOLD SCRIPR CHECKOUT
INT=1
@@ -54,7 +54,7 @@ BILINEAR LR SCALAR LATLON 1
INT=1
#
ATSOLFLX O_QsrMix 1 5400 4 rst.nc EXPOUT
-180 90 182 149 lmdz torc
+180 90 180 148 lmdz torc
P 0 P 2
CHECKIN BLASOLD SCRIPR CHECKOUT
INT=1
@@ -63,7 +63,7 @@ BILINEAR LR SCALAR LATLON 1
INT=1
#
ATSOLFLX O_dQnsdT 1 5400 4 rst.nc EXPOUT
-180 90 182 149 lmdz torc
+180 90 180 148 lmdz torc
P 0 P 2
CHECKIN BLASOLD SCRIPR CHECKOUT
INT=1
@@ -72,7 +72,7 @@ BILINEAR LR SCALAR LATLON 1
INT=1
#
ATSOLFLX O_OTaux1 1 5400 4 rst.nc EXPOUT
-180 90 182 149 lmdz torc
+180 90 180 148 lmdz torc
P 0 P 2
CHECKIN BLASOLD SCRIPR CHECKOUT
INT=1
@@ -81,7 +81,7 @@ BILINEAR LR SCALAR LATLON 1
INT=1
#
ATSOLFLX O_OTauy1 1 5400 4 rst.nc EXPOUT
-180 90 182 149 lmdz torc
+180 90 180 148 lmdz torc
P 0 P 2
CHECKIN BLASOLD SCRIPR CHECKOUT
INT=1
@@ -90,7 +90,7 @@ BILINEAR LR SCALAR LATLON 1
INT=1
#
ATFLXEMP OTotRain 1 5400 3 rst.nc EXPOUT
-180 90 182 149 lmdz torc
+180 90 180 148 lmdz torc
P 0 P 2
CHECKIN SCRIPR CHECKOUT
INT=1
@@ -98,7 +98,7 @@ BILINEAR LR SCALAR LATLON 1
INT=1
#
ATFLXEMP OTotSnow 1 5400 3 rst.nc EXPOUT
-180 90 182 149 lmdz torc
+180 90 180 148 lmdz torc
P 0 P 2
CHECKIN SCRIPR CHECKOUT
INT=1
@@ -106,7 +106,7 @@ BILINEAR LR SCALAR LATLON 1
INT=1
#
ATFLXEMP OTotEvap 1 5400 3 rst.nc EXPOUT
-180 90 182 149 lmdz torc
+180 90 180 148 lmdz torc
P 0 P 2
CHECKIN SCRIPR CHECKOUT
INT=1
@@ -114,7 +114,7 @@ BILINEAR LR SCALAR LATLON 1
INT=1
#
ATFLXEMP OIceEvap 1 5400 3 rst.nc EXPOUT
-180 90 182 149 lmdz torc
+180 90 180 148 lmdz torc
P 0 P 2
CHECKIN SCRIPR CHECKOUT
INT=1
diff --git a/tools/TOYATM/cpp_TOYATM.fcm b/tools/TOYATM/cpp_TOYATM.fcm
new file mode 100644
index 0000000000000000000000000000000000000000..83c89d8685cb18708320302b3b7bb84b1461de8c
--- /dev/null
+++ b/tools/TOYATM/cpp_TOYATM.fcm
@@ -0,0 +1 @@
+bld::tool::fppkeys key_oasis3