Index: /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/NEMO_book.tex
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/NEMO_book.tex (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/NEMO_book.tex (revision 5602)
@@ -179,5 +179,5 @@
\newcommand{\hf} [1] {\textit{#1.h90}\index{h90 file!#1}} %module (h90 files)
\newcommand{\ngn} [1] {\textit{#1}\index{Namelist Group Name!#1}} %namelist name (nampar)
-\newcommand{\np} [1] {\textit{#1}\index{Namelist variables!#1}} %namelist variable
+\newcommand{\np} [1] {\textit{#1}\index{Namelist variables!#1}} %namelist variable
\newcommand{\jp} [1] {\textit{#1}\index{Model parameters!#1}} %model parameter (jp)
\newcommand{\pp} [1] {\textit{#1}\index{Model parameters!#1}} %namelist parameter (pp)
@@ -296,7 +296,9 @@
\include{./TexFiles/Chapters/Chap_DIA} % Outputs and Diagnostics
-\include{./TexFiles/Chapters/Chap_OBS} % Observation operator
-
-\include{./TexFiles/Chapters/Chap_ASM} % Assimilation increments
+\include{./TexFiles/Chapters/Chap_OBS} % Observation operator
+
+\include{./TexFiles/Chapters/Chap_ASM} % Assimilation increments
+
+\include{./TexFiles/Chapters/Chap_STO} % Stochastic param.
\include{./TexFiles/Chapters/Chap_MISC} % Miscellaneous topics
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Biblio/Biblio.bib
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Biblio/Biblio.bib (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Biblio/Biblio.bib (revision 5602)
@@ -271,4 +271,13 @@
volume = {326},
pages = {677--684}
+}
+
+@ARTICLE{Beckmann2003,
+ author = {A. Beckmann and H. Goosse},
+ title = {A parameterization of ice shelf-ocean interaction for climate models},
+ journal = OM
+ year = {2003}
+ volume = {5}
+ pages = {157--170}
}
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Chapters/Chap_DIA.tex
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Chapters/Chap_DIA.tex (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Chapters/Chap_DIA.tex (revision 5602)
@@ -74,5 +74,5 @@
The second functionality targets output performance when running in parallel (\key{mpp\_mpi}). Iomput provides the possibility to specify N dedicated I/O processes (in addition to the NEMO processes) to collect and write the outputs. With an appropriate choice of N by the user, the bottleneck associated with the writing of the output files can be greatly reduced.
-Since version 3.5, the iom\_put interface depends on an external code called \href{http://forge.ipsl.jussieu.fr/ioserver}{XIOS}. This new IO server can take advantage of the parallel I/O functionality of NetCDF4 to create a single output file and therefore to bypass the rebuilding phase. Note that writing in parallel into the same NetCDF files requires that your NetCDF4 library is linked to an HDF5 library that has been correctly compiled (i.e. with the configure option $--$enable-parallel). Note that the files created by iomput through XIOS are incompatible with NetCDF3. All post-processsing and visualization tools must therefore be compatible with NetCDF4 and not only NetCDF3.
+In version 3.6, the iom\_put interface depends on an external code called \href{https://forge.ipsl.jussieu.fr/ioserver/browser/XIOS/branchs/xios-1.0}{XIOS-1.0} (use of revision 618 or higher is required). This new IO server can take advantage of the parallel I/O functionality of NetCDF4 to create a single output file and therefore to bypass the rebuilding phase. Note that writing in parallel into the same NetCDF files requires that your NetCDF4 library is linked to an HDF5 library that has been correctly compiled (i.e. with the configure option $--$enable-parallel). Note that the files created by iomput through XIOS are incompatible with NetCDF3. All post-processsing and visualization tools must therefore be compatible with NetCDF4 and not only NetCDF3.
Even if not using the parallel I/O functionality of NetCDF4, using N dedicated I/O servers, where N is typically much less than the number of NEMO processors, will reduce the number of output files created. This can greatly reduce the post-processing burden usually associated with using large numbers of NEMO processors. Note that for smaller configurations, the rebuilding phase can be avoided, even without a parallel-enabled NetCDF4 library, simply by employing only one dedicated I/O server.
@@ -543,6 +543,137 @@
\end{tabular}
+\subsubsection{Advanced use of XIOS functionalities}
\subsection{XML reference tables}
+\label{IOM_xmlref}
+
+(1) Simple computation: directly define the computation when refering to the variable in the file definition.
+
+\vspace{-20pt}
+\begin{alltt} {{\scriptsize
+\begin{verbatim}
+ sst + 273.15
+ taum * taum
+ qt - qsr - qns
+\end{verbatim}
+}}\end{alltt}
+
+(2) Simple computation: define a new variable and use it in the file definition.
+
+in field\_definition:
+\vspace{-20pt}
+\begin{alltt} {{\scriptsize
+\begin{verbatim}
+ sst * sst
+\end{verbatim}
+}}\end{alltt}
+in file\_definition:
+\vspace{-20pt}
+\begin{alltt} {{\scriptsize
+\begin{verbatim}
+ sst2
+\end{verbatim}
+}}\end{alltt}
+Note that in this case, the following syntaxe $<$field field\_ref="sst2" /$>$ is not working as sst2 won't be evaluated.
+
+(3) Change of variable precision:
+
+\vspace{-20pt}
+\begin{alltt} {{\scriptsize
+\begin{verbatim}
+
+
+
+
+\end{verbatim}
+}}\end{alltt}
+Note that, then the code is crashing, writting real4 variables forces a numerical convection from real8 to real4 which will create an internal error in NetCDF and will avoid the creation of the output files. Forcing double precision outputs with prec="8" (for example in the field\_definition) will avoid this problem.
+
+(4) add user defined attributes:
+
+\vspace{-20pt}
+\begin{alltt} {{\scriptsize
+\begin{verbatim}
+
+
+
+ blabla
+ 3
+ 5.0
+
+ blabla\_global
+
+
+\end{verbatim}
+}}\end{alltt}
+
+(5) use of the ``@'' function: example 1, weighted temporal average
+
+ - define a new variable in field\_definition
+\vspace{-20pt}
+\begin{alltt} {{\scriptsize
+\begin{verbatim}
+ toce * e3t
+\end{verbatim}
+}}\end{alltt}
+ - use it when defining your file.
+\vspace{-20pt}
+\begin{alltt} {{\scriptsize
+\begin{verbatim}
+
+
+ @toce\_e3t / @e3t
+
+
+\end{verbatim}
+}}\end{alltt}
+The freq\_op="5d" attribute is used to define the operation frequency of the ``@'' function: here 5 day. The temporal operation done by the ``@'' is the one defined in the field definition: here we use the default, average. So, in the above case, @toce\_e3t will do the 5-day mean of toce*e3t. Operation="instant" refers to the temporal operation to be performed on the field''@toce\_e3t / @e3t'': here the temporal average is alreday done by the ``@'' function so we just use instant to do the ratio of the 2 mean values. field\_ref="toce" means that attributes not explicitely defined, are inherited from toce field. Note that in this case, freq\_op must be equal to the file output\_freq.
+
+(6) use of the ``@'' function: example 2, monthly SSH standard deviation
+
+ - define a new variable in field\_definition
+\vspace{-20pt}
+\begin{alltt} {{\scriptsize
+\begin{verbatim}
+ ssh * ssh
+\end{verbatim}
+}}\end{alltt}
+ - use it when defining your file.
+\vspace{-20pt}
+\begin{alltt} {{\scriptsize
+\begin{verbatim}
+
+
+ sqrt( @ssh2 - @ssh * @ssh )
+
+
+\end{verbatim}
+}}\end{alltt}
+The freq\_op="1m" attribute is used to define the operation frequency of the ``@'' function: here 1 month. The temporal operation done by the ``@'' is the one defined in the field definition: here we use the default, average. So, in the above case, @ssh2 will do the monthly mean of ssh*ssh. Operation="instant" refers to the temporal operation to be performed on the field ''sqrt( @ssh2 - @ssh * @ssh )'': here the temporal average is alreday done by the ``@'' function so we just use instant. field\_ref="ssh" means that attributes not explicitely defined, are inherited from ssh field. Note that in this case, freq\_op must be equal to the file output\_freq.
+
+(7) use of the ``@'' function: example 3, monthly average of SST diurnal cycle
+
+ - define 2 new variables in field\_definition
+\vspace{-20pt}
+\begin{alltt} {{\scriptsize
+\begin{verbatim}
+
+
+\end{verbatim}
+}}\end{alltt}
+ - use these 2 new variables when defining your file.
+\vspace{-20pt}
+\begin{alltt} {{\scriptsize
+\begin{verbatim}
+
+
+ @sstmax - @sstmin
+
+
+\end{verbatim}
+}}\end{alltt}
+The freq\_op="1d" attribute is used to define the operation frequency of the ``@'' function: here 1 day. The temporal operation done by the ``@'' is the one defined in the field definition: here maximum for sstmax and minimum for sstmin. So, in the above case, @sstmax will do the daily max and @sstmin the daily min. Operation="average" refers to the temporal operation to be performed on the field ``@sstmax - @sstmin'': here monthly mean (of daily max - daily min of the sst). field\_ref="sst" means that attributes not explicitely defined, are inherited from sst field.
+
+
\subsubsection{Tag list}
@@ -849,4 +980,9 @@
\end{longtable}
+\subsection{CF metadata standard compliance}
+
+Output from the XIOS-1.0 IO server is compliant with \href{http://cfconventions.org/Data/cf-conventions/cf-conventions-1.5/build/cf-conventions.html}{version 1.5} of the CF metadata standard. Therefore while a user may wish to add their own metadata to the output files (as demonstrated in example 4 of section \ref{IOM_xmlref}) the metadata should, for the most part, comply with the CF-1.5 standard.
+
+Some metadata that may significantly increase the file size (horizontal cell areas and vertices) are controlled by the namelist parameter \np{ln\_cfmeta} in the \ngn{namrun} namelist. This must be set to true if these metadata are to be included in the output files.
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Chapters/Chap_DOM.tex
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Chapters/Chap_DOM.tex (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Chapters/Chap_DOM.tex (revision 5602)
@@ -493,5 +493,6 @@
$z(i,j,k,t)$ (Fig.~\ref{Fig_z_zps_s_sps}f). This option can be used with full step
bathymetry or $s$-coordinate (hybrid and partial step coordinates have not
-yet been tested in NEMO v2.3).
+yet been tested in NEMO v2.3). If using $z$-coordinate with partial step bathymetry
+(\np{ln\_zps}~=~true), ocean cavity beneath ice shelves can be open (\np{ln\_isfcav}~=~true).
Contrary to the horizontal grid, the vertical grid is computed in the code and no
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Chapters/Chap_DYN.tex
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Chapters/Chap_DYN.tex (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Chapters/Chap_DYN.tex (revision 5602)
@@ -627,5 +627,8 @@
\eqref{Eq_dynhpg_zco_surf} - \eqref{Eq_dynhpg_zco}, and $z_T$ is the depth of
the $T$-point evaluated from the sum of the vertical scale factors at the $w$-point
-($e_{3w}$).
+($e_{3w}$).
+
+$\bullet$ Traditional coding with adaptation for ice shelf cavities (\np{ln\_dynhpg\_isf}=true).
+This scheme need the activation of ice shelf cavities (\np{ln\_isfcav}=true).
$\bullet$ Pressure Jacobian scheme (prj) (a research paper in preparation) (\np{ln\_dynhpg\_prj}=true)
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Chapters/Chap_MISC.tex
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Chapters/Chap_MISC.tex (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Chapters/Chap_MISC.tex (revision 5602)
@@ -141,4 +141,60 @@
computational domain is laid out on local processor memories following a 2D
horizontal splitting. % (see {\S}IV.2-c) ref to the section to be updated
+
+\subsection{Simple subsetting of input files via netCDF attributes}
+
+The extended grids for use with the under-shelf ice cavities will result in redundant rows
+around Antarctica if the ice cavities are not active. A simple mechanism for subsetting
+input files associated with the extended domains has been implemented to avoid the need to
+maintain different sets of input fields for use with or without active ice cavities. The
+existing 'zoom' options are overly complex for this task and marked for deletion anyway.
+This alternative subsetting operates for the j-direction only and works by optionally
+looking for and using a global file attribute (named: \np{open\_ocean\_jstart}) to
+determine the starting j-row for input. The use of this option is best explained with an
+example: Consider an ORCA1 configuration using the extended grid bathymetry and coordinate
+files:
+\vspace{-10pt}
+\begin{alltt}
+\tiny
+\begin{verbatim}
+eORCA1_bathymetry_v2.nc
+eORCA1_coordinates.nc
+\end{verbatim}
+\end{alltt}
+\noindent These files define a horizontal domain of 362x332. Assuming the first row with
+open ocean wet points in the non-isf bathymetry for this set is row 42 (Fortran indexing)
+then the formally correct setting for \np{open\_ocean\_jstart} is 41. Using this value as the
+first row to be read will result in a 362x292 domain which is the same size as the original
+ORCA1 domain. Thus the extended coordinates and bathymetry files can be used with all the
+original input files for ORCA1 if the ice cavities are not active (\np{ln\_isfcav =
+.false.}). Full instructions for achieving this are:
+
+\noindent Add the new attribute to any input files requiring a j-row offset, i.e:
+\vspace{-10pt}
+\begin{alltt}
+\tiny
+\begin{verbatim}
+ncatted -a open_ocean_jstart,global,a,d,41 eORCA1_coordinates.nc
+ncatted -a open_ocean_jstart,global,a,d,41 eORCA1_bathymetry_v2.nc
+\end{verbatim}
+\end{alltt}
+
+\noindent Add the logical switch to \ngn{namcfg} in the configuration namelist and set true:
+%--------------------------------------------namcfg--------------------------------------------------------
+\namdisplay{namcfg_orca1}
+%--------------------------------------------------------------------------------------------------------------
+
+\noindent Note the j-size of the global domain is the (extended j-size minus
+\np{open\_ocean\_jstart} + 1 ) and this must match the size of all datasets other than
+bathymetry and coordinates currently. However the option can be extended to any global, 2D
+and 3D, netcdf, input field by adding the:
+\vspace{-10pt}
+\begin{alltt}
+\tiny
+\begin{verbatim}
+lrowattr=ln_use_jattr
+\end{verbatim}
+\end{alltt}
+optional argument to the appropriate \np{iom\_get} call and the \np{open\_ocean\_jstart} attribute to the corresponding input files. It remains the users responsibility to set \np{jpjdta} and \np{jpjglo} values in the \np{namelist\_cfg} file according to their needs.
%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Chapters/Chap_SBC.tex
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Chapters/Chap_SBC.tex (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Chapters/Chap_SBC.tex (revision 5602)
@@ -1,6 +1,6 @@
% ================================================================
-% Chapter � Surface Boundary Condition (SBC, ICB)
-% ================================================================
-\chapter{Surface Boundary Condition (SBC, ICB) }
+% Chapter � Surface Boundary Condition (SBC, ISF, ICB)
+% ================================================================
+\chapter{Surface Boundary Condition (SBC, ISF, ICB) }
\label{SBC}
\minitoc
@@ -48,6 +48,8 @@
below ice-covered areas (using observed ice-cover or a sea-ice model)
(\np{nn\_ice}~=~0,1, 2 or 3); the addition of river runoffs as surface freshwater
-fluxes or lateral inflow (\np{ln\_rnf}~=~true); the addition of a freshwater flux adjustment
-in order to avoid a mean sea-level drift (\np{nn\_fwb}~=~0,~1~or~2); the
+fluxes or lateral inflow (\np{ln\_rnf}~=~true); the addition of isf melting as lateral inflow (parameterisation)
+(\np{nn\_isf}~=~2 or 3 and \np{ln\_isfcav}~=~false) or as surface flux at the land-ice ocean interface
+(\np{nn\_isf}~=~1 or 4 and \np{ln\_isfcav}~=~true);
+the addition of a freshwater flux adjustment in order to avoid a mean sea-level drift (\np{nn\_fwb}~=~0,~1~or~2); the
transformation of the solar radiation (if provided as daily mean) into a diurnal
cycle (\np{ln\_dm2dc}~=~true); and a neutral drag coefficient can be read from an external wave
@@ -60,4 +62,6 @@
Finally, the different options that further modify the fluxes applied to the ocean are discussed.
One of these is modification by icebergs (see \S\ref{ICB_icebergs}), which act as drifting sources of fresh water.
+Another example of modification is that due to the ice shelf melting/freezing (see \S\ref{SBC_isf}),
+which provides additional sources of fresh water.
@@ -686,5 +690,5 @@
air temperature, sea-surface temperature, cloud cover and relative humidity.
Sensible heat and latent heat fluxes are computed by classical
-bulk formulae parameterized according to \citet{Kondo1975}.
+bulk formulae parameterised according to \citet{Kondo1975}.
Details on the bulk formulae used can be found in \citet{Maggiore_al_PCE98} and \citet{Castellari_al_JMS1998}.
@@ -826,6 +830,6 @@
\Pi-g\delta = (1+k-h) \Pi_{A}(\lambda,\phi)
\end{equation}
-with $k$ a number of Love estimated to 0.6 which parametrized the astronomical tidal land,
-and $h$ a number of Love to 0.3 which parametrized the parametrization due to the astronomical tidal land.
+with $k$ a number of Love estimated to 0.6 which parameterised the astronomical tidal land,
+and $h$ a number of Love to 0.3 which parameterised the parameterisation due to the astronomical tidal land.
% ================================================================
@@ -945,6 +949,52 @@
%}
-
-
+% ================================================================
+% Ice shelf melting
+% ================================================================
+\section [Ice shelf melting (\textit{sbcisf})]
+ {Ice shelf melting (\mdl{sbcisf})}
+\label{SBC_isf}
+%------------------------------------------namsbc_isf----------------------------------------------------
+\namdisplay{namsbc_isf}
+%--------------------------------------------------------------------------------------------------------
+Namelist variable in \ngn{namsbc}, \np{nn\_isf}, control the kind of ice shelf representation used.
+\begin{description}
+\item[\np{nn\_isf}~=~1]
+The ice shelf cavity is represented. The fwf and heat flux are computed.
+Full description, sensitivity and validation in preparation.
+
+\item[\np{nn\_isf}~=~2]
+A parameterisation of isf is used. The ice shelf cavity is not represented.
+The fwf is distributed along the ice shelf edge between the depth of the average grounding line (GL)
+(\np{sn\_depmax\_isf}) and the base of the ice shelf along the calving front (\np{sn\_depmin\_isf}) as in (\np{nn\_isf}~=~3).
+Furthermore the fwf is computed using the \citet{Beckmann2003} parameterisation of isf melting.
+The effective melting length (\np{sn\_Leff\_isf}) is read from a file.
+
+\item[\np{nn\_isf}~=~3]
+A simple parameterisation of isf is used. The ice shelf cavity is not represented.
+The fwf (\np{sn\_rnfisf}) is distributed along the ice shelf edge between the depth of the average grounding line (GL)
+(\np{sn\_depmax\_isf}) and the base of the ice shelf along the calving front (\np{sn\_depmin\_isf}).
+Full description, sensitivity and validation in preparation.
+
+\item[\np{nn\_isf}~=~4]
+The ice shelf cavity is represented. However, the fwf (\np{sn\_fwfisf}) and heat flux (\np{sn\_qisf}) are
+not computed but specified from file.
+\end{description}
+
+\np{nn\_isf}~=~1 and \np{nn\_isf}~=~2 compute a melt rate based on the water masse properties, ocean velocities and depth.
+ This flux is thus highly dependent of the model resolution (horizontal and vertical), realism of the water masse onto the shelf ...
+
+\np{nn\_isf}~=~3 and \np{nn\_isf}~=~4 read the melt rate and heat flux from a file. You have total control of the fwf scenario.
+
+ This can be usefull if the water masses on the shelf are not realistic or the resolution (horizontal/vertical) are too
+coarse to have realistic melting or for sensitivity studies where you want to control your input.
+Full description, sensitivity and validation in preparation.
+
+There is 2 ways to apply the fwf to NEMO. The first possibility (\np{ln\_divisf}~=~false) applied the fwf
+ and heat flux directly on the salinity and temperature tendancy. The second possibility (\np{ln\_divisf}~=~true)
+ apply the fwf as for the runoff fwf (see \S\ref{SBC_rnf}). The mass/volume addition due to the ice shelf melting is,
+ at each relevant depth level, added to the horizontal divergence (\textit{hdivn}) in the subroutine \rou{sbc\_isf\_div}
+(called from \mdl{divcur}).
+%
% ================================================================
% Handling of icebergs
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Chapters/Chap_STO.tex
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Chapters/Chap_STO.tex (revision 5602)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Chapters/Chap_STO.tex (revision 5602)
@@ -0,0 +1,11 @@
+% ================================================================
+% Chapter stochastic parametrization of EOS (STO)
+% ================================================================
+\chapter{Stochastic parametrization of EOS (STO)}
+\label{STO}
+
+\minitoc
+
+
+\newpage
+$\ $\newline % force a new line
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Chapters/Chap_TRA.tex
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Chapters/Chap_TRA.tex (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Chapters/Chap_TRA.tex (revision 5602)
@@ -1077,6 +1077,5 @@
correctly set ($i.e.$ that $T_o$ and $S_o$ are provided in input files and read
using \mdl{fldread}, see \S\ref{SBC_fldread}).
-The restoring coefficient $\gamma$ is a three-dimensional array initialized by the
-user in routine \rou{dtacof} also located in module \mdl{tradmp}.
+The restoring coefficient $\gamma$ is a three-dimensional array read in during the \rou{tra\_dmp\_init} routine. The file name is specified by the namelist variable \np{cn\_resto}. The DMP\_TOOLS tool is provided to allow users to generate the netcdf file.
The two main cases in which \eqref{Eq_tra_dmp} is used are \textit{(a)}
@@ -1092,23 +1091,5 @@
diagnostic method \citep{Sarmiento1982}. It allows us to find the velocity
field consistent with the model dynamics whilst having a $T$, $S$ field
-close to a given climatological field ($T_o$, $S_o$). The time scale
-associated with $S_o$ is generally not a constant but spatially varying
-in order to respect other properties. For example, it is usually set to zero
-in the mixed layer (defined either on a density or $S_o$ criterion)
-\citep{Madec_al_JPO96} and in the equatorial region
-\citep{Reverdin1991, Fujio1991, Marti_PhD92} since these two regions
-have a short time scale of adjustment; while smaller $\gamma$ are used
-in the deep ocean where the typical time scale is long \citep{Sarmiento1982}.
-In addition the time scale is reduced (even to zero) along the western
-boundary to allow the model to reconstruct its own western boundary
-structure in equilibrium with its physics.
-The choice of the shape of the Newtonian damping is controlled by two
-namelist parameters \np{nn\_hdmp} and \np{nn\_zdmp}. The former allows us to specify: the
-width of the equatorial band in which no damping is applied; a decrease
-in the vicinity of the coast; and a damping everywhere in the Red and Med Seas.
-The latter sets whether damping should act in the mixed layer or not.
-The time scale associated with the damping depends on the depth as
-a hyperbolic tangent, with \np{rn\_surf} as surface value, \np{rn\_bot} as
-bottom value and a transition depth of \np{rn\_dep}.
+close to a given climatological field ($T_o$, $S_o$).
The robust diagnostic method is very efficient in preventing temperature
@@ -1118,9 +1099,19 @@
by stabilising the water column too much.
-An example of the computation of $\gamma$ for a robust diagnostic experiment
-with the ORCA2 model is provided in the \mdl{tradmp} module
-(subroutines \rou{dtacof} and \rou{cofdis} which compute the coefficient
-and the distance to the bathymetry, respectively). These routines are
-provided as examples and can be customised by the user.
+The namelist parameter \np{nn\_zdmp} sets whether the damping should be applied in the whole water column or only below the mixed layer (defined either on a density or $S_o$ criterion). It is common to set the damping to zero in the mixed layer as the adjustment time scale is short here \citep{Madec_al_JPO96}.
+
+\subsection[DMP\_TOOLS]{Generating resto.nc using DMP\_TOOLS}
+
+DMP\_TOOLS can be used to generate a netcdf file containing the restoration coefficient $\gamma$. Note that in order to maintain bit comparison with previous NEMO versions DMP\_TOOLS must be compiled and run on the same machine as the NEMO model. A mesh\_mask.nc file for the model configuration is required as an input. This can be generated by carrying out a short model run with the namelist parameter \np{nn\_msh} set to 1. The namelist parameter \np{ln\_tradmp} will also need to be set to .false. for this to work. The \nl{nam\_dmp\_create} namelist in the DMP\_TOOLS directory is used to specify options for the restoration coefficient.
+
+%--------------------------------------------nam_dmp_create-------------------------------------------------
+\namdisplay{nam_dmp_create}
+%-------------------------------------------------------------------------------------------------------
+
+\np{cp\_cfg}, \np{cp\_cpz}, \np{jp\_cfg} and \np{jperio} specify the model configuration being used and should be the same as specified in \nl{namcfg}. The variable \nl{lzoom} is used to specify that the damping is being used as in case \textit{a} above to provide boundary conditions to a zoom configuration. In the case of the arctic or antarctic zoom configurations this includes some specific treatment. Otherwise damping is applied to the 6 grid points along the ocean boundaries. The open boundaries are specified by the variables \np{lzoom\_n}, \np{lzoom\_e}, \np{lzoom\_s}, \np{lzoom\_w} in the \nl{nam\_zoom\_dmp} name list.
+
+The remaining switch namelist variables determine the spatial variation of the restoration coefficient in non-zoom configurations. \np{ln\_full\_field} specifies that newtonian damping should be applied to the whole model domain. \np{ln\_med\_red\_seas} specifies grid specific restoration coefficients in the Mediterranean Sea for the ORCA4, ORCA2 and ORCA05 configurations. If \np{ln\_old\_31\_lev\_code} is set then the depth variation of the coeffients will be specified as a function of the model number. This option is included to allow backwards compatability of the ORCA2 reference configurations with previous model versions. \np{ln\_coast} specifies that the restoration coefficient should be reduced near to coastlines. This option only has an effect if \np{ln\_full\_field} is true. \np{ln\_zero\_top\_layer} specifies that the restoration coefficient should be zero in the surface layer. Finally \np{ln\_custom} specifies that the custom module will be called. This module is contained in the file custom.F90 and can be edited by users. For example damping could be applied in a specific region.
+
+The restoration coefficient can be set to zero in equatorial regions by specifying a positive value of \np{nn\_hdmp}. Equatorward of this latitude the restoration coefficient will be zero with a smooth transition to the full values of a 10$^{\circ}$ latitud band. This is often used because of the short adjustment time scale in the equatorial region \citep{Reverdin1991, Fujio1991, Marti_PhD92}. The time scale associated with the damping depends on the depth as a hyperbolic tangent, with \np{rn\_surf} as surface value, \np{rn\_bot} as bottom value and a transition depth of \np{rn\_dep}.
% ================================================================
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Chapters/Chap_ZDF.tex
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Chapters/Chap_ZDF.tex (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Chapters/Chap_ZDF.tex (revision 5602)
@@ -830,5 +830,5 @@
% Bottom Friction
% ================================================================
-\section [Bottom Friction (\textit{zdfbfr})] {Bottom Friction (\mdl{zdfbfr} module)}
+\section [Bottom and top Friction (\textit{zdfbfr})] {Bottom Friction (\mdl{zdfbfr} module)}
\label{ZDF_bfr}
@@ -837,5 +837,8 @@
%--------------------------------------------------------------------------------------------------------------
-Options are defined through the \ngn{nambfr} namelist variables.
+Options to define the top and bottom friction are defined through the \ngn{nambfr} namelist variables.
+The top friction is activated only if the ice shelf cavities are opened (\np{ln\_isfcav}~=~true).
+As the friction processes at the top and bottom are the represented similarly, only the bottom friction is described in detail.
+
Both the surface momentum flux (wind stress) and the bottom momentum
flux (bottom friction) enter the equations as a condition on the vertical
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Namelist/nam_dmp_create
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Namelist/nam_dmp_create (revision 5602)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Namelist/nam_dmp_create (revision 5602)
@@ -0,0 +1,23 @@
+&nam_dmp_create
+ cp_cfg = 'orca' ! Name of model grid (orca and C1D have special options
+ ! otherwise ignored)
+ cp_cfz = 'antarctic' ! Name of zoom configuration (arctic and antarctic have
+ ! some special treatment if lzoom=.true.)
+ jp_cfg = 2 ! Resolution of the model (used for med_red_seas damping)
+ lzoom = .false. ! Zoom configuration or not
+ ln_full_field = .false. ! Calculate coefficient over whole of domain
+ ln_med_red_seas = .true. ! Damping in Med/Red Seas
+ ! (or local modifications here if ln_full_field=.true.)
+ ln_old_31_lev_code = .true. ! Replicate behaviour of old online code for 31 level model
+ ! (Med/Red seas damping based on level number instead of depth)
+ ln_coast = .true. ! Reduce near to coastlines
+ ln_zero_top_layer = .true. ! No damping in top layer
+ ln_custom = .false. ! Call "custom" module to apply user modifications to the
+ ! damping coefficient field
+ pn_surf = 0.25 ! Surface Relaxation timescale (days)
+ pn_bot = 0.25 ! Bottom relaxation timescale (days)
+ pn_dep = 1000 ! Transition depth from upper to deep ocean
+ nn_hdmp = 10 ! Damp poleward of this latitude (smooth transition up to maximum damping)
+ jperio = 2 ! Lateral boundary condition (as specified in namelist_cfg for model run).
+/
+
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Namelist/nambfr
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Namelist/nambfr (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Namelist/nambfr (revision 5602)
@@ -5,9 +5,19 @@
! = 2 : nonlinear friction
rn_bfri1 = 4.e-4 ! bottom drag coefficient (linear case)
- rn_bfri2 = 1.e-3 ! bottom drag coefficient (non linear case)
+ rn_bfri2 = 1.e-3 ! bottom drag coefficient (non linear case). Minimum coeft if ln_loglayer=T
+ rn_bfri2_max = 1.e-1 ! max. bottom drag coefficient (non linear case and ln_loglayer=T)
rn_bfeb2 = 2.5e-3 ! bottom turbulent kinetic energy background (m2/s2)
- rn_bfrz0 = 3.e-3 ! bottom roughness for loglayer bfr coeff
+ rn_bfrz0 = 3.e-3 ! bottom roughness [m] if ln_loglayer=T
ln_bfr2d = .false. ! horizontal variation of the bottom friction coef (read a 2D mask file )
rn_bfrien = 50. ! local multiplying factor of bfr (ln_bfr2d=T)
+ rn_tfri1 = 4.e-4 ! top drag coefficient (linear case)
+ rn_tfri2 = 2.5e-3 ! top drag coefficient (non linear case). Minimum coeft if ln_loglayer=T
+ rn_tfri2_max = 1.e-1 ! max. top drag coefficient (non linear case and ln_loglayer=T)
+ rn_tfeb2 = 0.0 ! top turbulent kinetic energy background (m2/s2)
+ rn_tfrz0 = 3.e-3 ! top roughness [m] if ln_loglayer=T
+ ln_tfr2d = .false. ! horizontal variation of the top friction coef (read a 2D mask file )
+ rn_tfrien = 50. ! local multiplying factor of tfr (ln_tfr2d=T)
+
ln_bfrimp = .true. ! implicit bottom friction (requires ln_zdfexp = .false. if true)
+ ln_loglayer = .false. ! logarithmic formulation (non linear case)
/
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Namelist/namcfg_orca1
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Namelist/namcfg_orca1 (revision 5602)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Namelist/namcfg_orca1 (revision 5602)
@@ -0,0 +1,12 @@
+!-----------------------------------------------------------------------
+&namcfg ! parameters of the configuration
+!-----------------------------------------------------------------------
+ cp_cfg = "orca" ! name of the configuration
+ jp_cfg = 1 ! resolution of the configuration
+ jpidta = 362 ! 1st lateral dimension ( >= jpi )
+ jpjdta = 292 ! 2nd " " ( >= jpj )
+ jpkdta = 75 ! number of levels ( >= jpk )
+ jpiglo = 362 ! 1st dimension of global domain --> i =jpidta
+ jpjglo = 292 ! 2nd - - --> j =jpjdta
+ jperio = 6 ! lateral cond. type (between 0 and 6)
+ ln_use_jattr = .true. ! use (T) the file attribute: open_ocean_jstart if present
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Namelist/namdyn_hpg
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Namelist/namdyn_hpg (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Namelist/namdyn_hpg (revision 5602)
@@ -5,4 +5,5 @@
ln_hpg_zps = .true. ! z-coordinate - partial steps (interpolation)
ln_hpg_sco = .false. ! s-coordinate (standard jacobian formulation)
+ ln_hpg_isf = .false. ! s-coordinate (sco ) adapted to ice shelf cavity
ln_hpg_djc = .false. ! s-coordinate (Density Jacobian with Cubic polynomial)
ln_hpg_prj = .false. ! s-coordinate (Pressure Jacobian scheme)
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Namelist/namsbc
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Namelist/namsbc (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Namelist/namsbc (revision 5602)
@@ -19,4 +19,9 @@
ln_dm2dc = .false. ! daily mean to diurnal cycle on short wave
ln_rnf = .true. ! runoffs (T => fill namsbc_rnf)
+ nn_isf = 0 ! ice shelf melting/freezing (/=0 => fill namsbc_isf)
+ ! 0 =no isf 1 = presence of ISF
+ ! 2 = bg03 parametrisation 3 = rnf file for isf
+ ! 4 = ISF fwf specified
+ ! option 1 and 4 need ln_isfcav = .true. (domzgr)
ln_ssr = .true. ! Sea Surface Restoring on T and/or S (T => fill namsbc_ssr)
nn_fwb = 3 ! FreshWater Budget: =0 unchecked
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Namelist/namsbc_isf
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Namelist/namsbc_isf (revision 5602)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Namelist/namsbc_isf (revision 5602)
@@ -0,0 +1,30 @@
+!-----------------------------------------------------------------------
+&namsbc_isf ! Top boundary layer (ISF)
+!-----------------------------------------------------------------------
+! ! file name ! frequency (hours) ! variable ! time interpol. ! clim ! 'yearly'/ ! weights ! rotation !
+! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing !
+! nn_isf == 4
+ sn_qisf = 'rnfisf' , -12 ,'sohflisf', .false. , .true. , 'yearly' , '' , ''
+ sn_fwfisf = 'rnfisf' , -12 ,'sowflisf', .false. , .true. , 'yearly' , '' , ''
+! nn_isf == 3
+ sn_rnfisf = 'runoffs' , -12 ,'sofwfisf', .false. , .true. , 'yearly' , '' , ''
+! nn_isf == 2 and 3
+ sn_depmax_isf = 'runoffs' , -12 ,'sozisfmax' , .false. , .true. , 'yearly' , '' , ''
+ sn_depmin_isf = 'runoffs' , -12 ,'sozisfmin' , .false. , .true. , 'yearly' , '' , ''
+! nn_isf == 2
+ sn_Leff_isf = 'rnfisf' , 0 ,'Leff' , .false. , .true. , 'yearly' , '' , ''
+! for all case
+ ln_divisf = .true. ! apply isf melting as a mass flux or in the salinity trend. (maybe I should remove this option as for runoff?)
+! only for nn_isf = 1 or 2
+ rn_gammat0 = 1.0e-4 ! gammat coefficient used in blk formula
+ rn_gammas0 = 1.0e-4 ! gammas coefficient used in blk formula
+! only for nn_isf = 1
+ nn_isfblk = 1 ! 1 ISOMIP ; 2 conservative (3 equation formulation, Jenkins et al. 1991 ??)
+ rn_hisf_tbl = 30. ! thickness of the top boundary layer (Losh et al. 2008)
+ ! 0 => thickness of the tbl = thickness of the first wet cell
+ ln_conserve = .true. ! conservative case (take into account meltwater advection)
+ nn_gammablk = 1 ! 0 = cst Gammat (= gammat/s)
+ ! 1 = velocity dependend Gamma (u* * gammat/s) (Jenkins et al. 2010)
+ ! if you want to keep the cd as in global config, adjust rn_gammat0 to compensate
+ ! 2 = velocity and stability dependent Gamma Holland et al. 1999
+/
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Namelist/namtra_dmp
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Namelist/namtra_dmp (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Namelist/namtra_dmp (revision 5602)
@@ -2,14 +2,9 @@
&namtra_dmp ! tracer: T & S newtonian damping
!-----------------------------------------------------------------------
- ln_tradmp = .true. ! add a damping termn (T) or not (F)
- nn_hdmp = -1 ! horizontal shape =-1, damping in Med and Red Seas only
- ! =XX, damping poleward of XX degrees (XX>0)
- ! + F(distance-to-coast) + Red and Med Seas
- nn_zdmp = 0 ! vertical shape =0 damping throughout the water column
- ! =1 no damping in the mixing layer (kz criteria)
- ! =2 no damping in the mixed layer (rho crieria)
- rn_surf = 50. ! surface time scale of damping [days]
- rn_bot = 360. ! bottom time scale of damping [days]
- rn_dep = 800. ! depth of transition between rn_surf and rn_bot [meters]
- nn_file = 0 ! create a damping.coeff NetCDF file (=1) or not (=0)
+ ln_tradmp = .true. ! add a damping termn (T) or not (F)
+ nn_zdmp = 0 ! vertical shape =0 damping throughout the water column
+ ! =1 no damping in the mixing layer (kz criteria)
+ ! =2 no damping in the mixed layer (rho crieria)
+ cn_resto = 'resto.nc' ! Name of file containing restoration coefficient field (use dmp_tools to create this)
+
/
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Namelist/namzgr
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Namelist/namzgr (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/DOC/TexFiles/Namelist/namzgr (revision 5602)
@@ -5,3 +5,4 @@
ln_zps = .true. ! z-coordinate - partial steps (T/F)
ln_sco = .false. ! s- or hybrid z-s-coordinate (T/F)
+ ln_isfcav = .false. ! ice shelf cavity (T/F)
/
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/ARCH/INGV/arch-IBM_EKMAN_INGV.fcm
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/ARCH/INGV/arch-IBM_EKMAN_INGV.fcm (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/ARCH/INGV/arch-IBM_EKMAN_INGV.fcm (revision 5602)
@@ -18,12 +18,12 @@
%NCDF_INC -I/srv/lib/netcdf-x/include
%NCDF_LIB -L/srv/lib/netcdf-x/lib -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 -lcurl -lstdc++
-%XIOS_ROOT /home/delrosso/XIOS_447/trunk
+%XIOS_ROOT /home/delrosso/XIOS_1.0/xios-1.0
%MPI_INTEL -I/srv/intel/impi/4.1.0.024/include
%CPP cpp
%FC mpiifort
-%FCFLAGS -r8 -O3 -g -traceback
+%FCFLAGS -r8 -O1 -g -traceback -fp-model precise
%FFLAGS %FCFLAGS
%LD mpiifort
-%LDFLAGS
+%LDFLAGS
%FPPFLAGS -P -C -traditional
%AR ar
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/ARCH/OLD/arch-ifort_MERCATOR_CLUSTER.fcm
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/ARCH/OLD/arch-ifort_MERCATOR_CLUSTER.fcm (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/ARCH/OLD/arch-ifort_MERCATOR_CLUSTER.fcm (revision 5602)
@@ -16,14 +16,17 @@
%NCDF_INC -I$NETCDF_INC
-%NCDF_LIB -L $NETCDF_LIB -lnetcdf
+%NCDF_LIB -L$NETCDF_LIB -lnetcdff -lnetcdf -L$HDF5_LIB -lhdf5_hl -lhdf5 -lz
+
+%CPP cpp
%FC mpif90
-%FCFLAGS -assume byterecl -convert big_endian -i4 -r8 -O2 -fp-model precise
+%FCFLAGS -O2 -fp-model precise -traceback -r8 -convert big_endian -assume byterecl
%FFLAGS %FCFLAGS
-%LD mpif90
+%LD mpif90
%FPPFLAGS -P -C -traditional
-%LDFLAGS -O2 -shared-intel
+%LDFLAGS -O2
%AR ar
-%ARFLAGS -r
+%ARFLAGS -rs
%MK gmake
-%USER_INC %NCDF_INC
-%USER_LIB %NCDF_LIB
+%USER_INC -I$XIOS_INC %NCDF_INC
+%USER_LIB -L$XIOS_LIB -lxios %NCDF_LIB -lstdc++
+
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/ARCH/OLD/arch-ifort_linux.fcm
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/ARCH/OLD/arch-ifort_linux.fcm (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/ARCH/OLD/arch-ifort_linux.fcm (revision 5602)
@@ -17,5 +17,5 @@
%NCDF_INC -I/usr/local/netcdf/include
%NCDF_LIB -L /usr/local/netcdf/lib -lnetcdf
-%FC ifort
+%FC ifort
%FCFLAGS -r8 -O3 -traceback
%FFLAGS -r8 -O3 -traceback
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/ARCH/arch-PW7_METO.fcm
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/ARCH/arch-PW7_METO.fcm (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/ARCH/arch-PW7_METO.fcm (revision 5602)
@@ -17,8 +17,8 @@
-%NCDF_INC -I/home/cr/ocean/hadcv/netcdf/4.1.3_seq/include
-%NCDF_LIB -L/home/cr/ocean/hadcv/netcdf/4.1.3_seq/lib -lnetcdf -lnetcdff -lhdf5 -lhdf5_hl -lhdf5_fortran -lz
-%XIOS_INC -I/data/nwp/ofrd/share/NEMO/xios_lib/seq/xios_r451/inc
-%XIOS_LIB -L/data/nwp/ofrd/share/NEMO/xios_lib/seq/xios_r451/lib -lxios
+%NCDF_INC -I/home/cr/ocean/hadcv/netcdf/4.1.3_par/include
+%NCDF_LIB -L/home/cr/ocean/hadcv/netcdf/4.1.3_par/lib -lnetcdf -lnetcdff -lhdf5 -lhdf5_hl -lhdf5_fortran -lz
+%XIOS_INC -I/home/cr/ocean/hadcv/xios_lib/par/r618/xios/inc
+%XIOS_LIB -L/home/cr/ocean/hadcv/xios_lib/par/r618/xios/lib -lxios
%CPP cpp
%FC mpxlf90_r
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/ARCH/arch-PW7_MONSOON.fcm
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/ARCH/arch-PW7_MONSOON.fcm (revision 5602)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/ARCH/arch-PW7_MONSOON.fcm (revision 5602)
@@ -0,0 +1,33 @@
+# IBM POWER7 UKMO
+# NCDF_INC netcdf include file
+# NCDF_LIB netcdf library
+# XIOS_INC XIOS include files
+# XIOS_LIB XIOS library
+# FC Fortran compiler command
+# FCFLAGS Fortran compiler flags
+# FFLAGS Fortran 77 compiler flags
+# LD linker
+# LDFLAGS linker flags, e.g. -L if you have libraries in a
+# FPPFLAGS pre-processing flags
+# AR assembler
+# ARFLAGS assembler flags
+# MK make
+# USER_INC additional include files for the compiler, e.g. -I
+# USER_LIB additional libraries to pass to the linker, e.g. -l
+
+%NCDF_INC -I/home/dcalve/netcdf/4.1.3_seq/include
+%NCDF_LIB -L/home/dcalve/netcdf/4.1.3_seq/lib -lnetcdf -lnetcdff -lhdf5 -lhdf5_hl -lhdf5_fortran -lz
+%XIOS_INC -I/home/dstork/xios_lib/par/r521/xios/inc
+%XIOS_LIB -L/home/dstork/xios_lib/par/r521/xios/lib -lxios
+%CPP cpp
+%FC mpxlf90_r
+%FCFLAGS -qrealsize=8 -qextname -qsuffix=f=f90 -qarch=pwr7 -qtune=pwr7 -g -O2 -qstrict -qinitauto=7FBFFFFF
+%FFLAGS -qrealsize=8 -qextname -qarch=pwr7 -qtune=pwr7 -g -O2 -qstrict -qinitauto=7FBFFFFF -qfixed
+%LD mpCC_r
+%LDFLAGS -lxlf90 -L/projects/um1/lib -lsig -O2 -L MASS
+%FPPFLAGS -E -P -traditional -I/opt/ibmhpc/pecurrent/ppe.poe/include -I/usr/lpp/ppe.poe/include/thread64
+%AR ar
+%ARFLAGS rs
+%MK gmake
+%USER_INC %NCDF_INC %XIOS_INC
+%USER_LIB %NCDF_LIB %XIOS_LIB
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/ARCH/arch-X64_ADA.fcm
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/ARCH/arch-X64_ADA.fcm (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/ARCH/arch-X64_ADA.fcm (revision 5602)
@@ -32,5 +32,6 @@
%HDF5_HOME /smplocal/pub/HDF5/1.8.9/par
%XIOS_HOME $WORKDIR/XIOS
-%OASIS_HOME /not/yet/defined
+####%OASIS_HOME $WORKDIR/oasis3-mct/BLD
+%OASIS_HOME /not/defined
%NCDF_INC -I%NCDF_HOME/include
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/ARCH/arch-X64_CURIE.fcm
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/ARCH/arch-X64_CURIE.fcm (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/ARCH/arch-X64_CURIE.fcm (revision 5602)
@@ -29,7 +29,7 @@
# - fcm variables are starting with a % (and not a $)
#
-%NCDF_HOME /usr/local/netcdf-4.2_hdf5_parallel
-%HDF5_HOME /usr/local/hdf5-1.8.9_parallel
-%XIOS_HOME $WORKDIR/now/models/xios
+%NCDF_HOME /usr/local/netcdf-4.3.3.1_hdf5_parallel
+%HDF5_HOME /usr/local/hdf5-1.8.12_parallel
+%XIOS_HOME $WORKDIR/xios-1.0
%OASIS_HOME $WORKDIR/now/models/oa3mct
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/ARCH/arch-X64_MOBILIS.fcm
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/ARCH/arch-X64_MOBILIS.fcm (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/ARCH/arch-X64_MOBILIS.fcm (revision 5602)
@@ -36,5 +36,5 @@
%NCDF_HOME /home/acc/shared
%HDF5_HOME /home/acc/shared
-%XIOS_HOME /home/acc/XIOS
+%XIOS_HOME /home/acc/XIOS_1.0
%OASIS_HOME
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/ARCH/arch-XC40_METO.fcm
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/ARCH/arch-XC40_METO.fcm (revision 5602)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/ARCH/arch-XC40_METO.fcm (revision 5602)
@@ -0,0 +1,52 @@
+# compiler options for Archer CRAY XC-40 (using crayftn compiler)
+#
+# NCDF_HOME root directory containing lib and include subdirectories for netcdf4
+# HDF5_HOME root directory containing lib and include subdirectories for HDF5
+# XIOS_HOME root directory containing lib for XIOS
+# OASIS_HOME root directory containing lib for OASIS
+#
+# NCDF_INC netcdf4 include file
+# NCDF_LIB netcdf4 library
+# XIOS_INC xios include file (taken into accound only if key_iomput is activated)
+# XIOS_LIB xios library (taken into accound only if key_iomput is activated)
+# OASIS_INC oasis include file (taken into accound only if key_oasis3 is activated)
+# OASIS_LIB oasis library (taken into accound only if key_oasis3 is activated)
+#
+# FC Fortran compiler command
+# FCFLAGS Fortran compiler flags
+# FFLAGS Fortran 77 compiler flags
+# LD linker
+# LDFLAGS linker flags, e.g. -L if you have libraries
+# FPPFLAGS pre-processing flags
+# AR assembler
+# ARFLAGS assembler flags
+# MK make
+# USER_INC complete list of include files
+# USER_LIB complete list of libraries to pass to the linker
+#
+# Note that:
+# - unix variables "$..." are accpeted and will be evaluated before calling fcm.
+# - fcm variables are starting with a % (and not a $)
+#
+%NCDF_HOME /opt/cray/netcdf-hdf5parallel/4.3.2/CRAY/83
+%HDF5_HOME /opt/cray/hdf5-parallel/1.8.13/CRAY/83
+%XIOS_HOME /projects/ocean/nemo/xios/xios_1.0_r618_20150619/XIOS
+
+%NCDF_INC -I%NCDF_HOME/include -I%HDF5_HOME/include
+%NCDF_LIB -L%HDF5_HOME/lib -L%NCDF_HOME/lib -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 -lz
+%XIOS_INC -I%XIOS_HOME/inc
+%XIOS_LIB -L%XIOS_HOME/lib -lxios
+
+%CPP cpp
+%FC ftn
+%FCFLAGS -emf -s real64 -s integer32 -O2 -hflex_mp=intolerant -Rb
+%FFLAGS -emf -s real64 -s integer32 -O0 -hflex_mp=strict -Rb
+%LD ftn
+%FPPFLAGS -P -E -traditional-cpp
+%LDFLAGS -hbyteswapio
+%AR ar
+%ARFLAGS -r
+%MK gmake
+
+%USER_INC %XIOS_INC
+%USER_LIB %XIOS_LIB
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/ARCH/arch-macport_osx.fcm
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/ARCH/arch-macport_osx.fcm (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/ARCH/arch-macport_osx.fcm (revision 5602)
@@ -40,5 +40,5 @@
%NCDF_HOME /opt/local
%HDF5_HOME /opt/local
-%XIOS_HOME /Users/$( whoami )/XIOS
+%XIOS_HOME /Users/$( whoami )/xios-1.0
%OASIS_HOME /not/defined
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/AMM12/EXP00/iodef.xml
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/AMM12/EXP00/iodef.xml (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/AMM12/EXP00/iodef.xml (revision 5602)
@@ -34,18 +34,19 @@
-
-
-
+
+
+
-
+
-
+
+
@@ -53,34 +54,34 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
+
+
@@ -107,10 +108,13 @@
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
@@ -126,4 +130,7 @@
+
+
+
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/AMM12/EXP00/namelist_cfg
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/AMM12/EXP00/namelist_cfg (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/AMM12/EXP00/namelist_cfg (revision 5602)
@@ -99,4 +99,6 @@
ln_ssr = .false. ! Sea Surface Restoring on T and/or S (T => fill namsbc_ssr)
nn_fwb = 0 ! FreshWater Budget: =0 unchecked
+ ln_apr_dyn = .false. ! Patm gradient added in ocean & ice Eqs. (T => fill namsbc_apr )
+
/
!-----------------------------------------------------------------------
@@ -129,5 +131,5 @@
/
!-----------------------------------------------------------------------
-&namsbc_cpl ! coupled ocean/atmosphere model ("key_coupled")
+&namsbc_cpl ! coupled ocean/atmosphere model ("key_oasis3")
!-----------------------------------------------------------------------
/
@@ -158,10 +160,10 @@
! ! 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_apr = 'patm' , -1 ,'somslpre', .true. , .true. , 'yearly' , '' , '' , ''
+ sn_apr = 'amm12_mslp' , 1 , 'p_msl' , .false. , .false. , 'daily' , '' , '' , ''
- cn_dir = './' ! root directory for the location of the bulk files
- rn_pref = 101000._wp ! reference atmospheric pressure [N/m2]/
+ cn_dir = './fluxes/' ! root directory for the location of the bulk files
+ rn_pref = 101000. ! reference atmospheric pressure [N/m2]/
ln_ref_apr = .false. ! ref. pressure: global mean Patm (T) or a constant (F)
- ln_apr_obc = .false. ! inverse barometer added to OBC ssh data
+ ln_apr_obc = .true. ! inverse barometer added to OBC ssh data
/
!-----------------------------------------------------------------------
@@ -355,4 +357,5 @@
!-----------------------------------------------------------------------
rn_charn = 100000. ! Charnock constant for wb induced roughness length
+ nn_z0_met = 1 ! Method for surface roughness computation (0/1/2)
/
!-----------------------------------------------------------------------
@@ -393,10 +396,5 @@
&namptr ! Poleward Transport Diagnostic
!-----------------------------------------------------------------------
- ln_diaznl = .false. ! Add zonal means and meridional stream functions
- ln_subbas = .false. ! Atlantic/Pacific/Indian basins computation (T) or not
- ! (orca configuration only, need input basins mask file named "subbasins.nc"
- ln_ptrcomp = .false. ! Add decomposition : overturning
-/
-!-----------------------------------------------------------------------
+/
&namhsb ! Heat and salt budgets
!-----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/C1D_PAPA/EXP00/iodef.xml
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/C1D_PAPA/EXP00/iodef.xml (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/C1D_PAPA/EXP00/iodef.xml (revision 5602)
@@ -34,19 +34,19 @@
-
+
-
+
-
+
-
+
@@ -54,5 +54,5 @@
-
+
@@ -72,19 +72,19 @@
-
+
-
+
-
+
-
+
@@ -92,5 +92,5 @@
-
+
@@ -98,4 +98,5 @@
+
@@ -118,10 +119,13 @@
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/C1D_PAPA/EXP00/namelist_cfg
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/C1D_PAPA/EXP00/namelist_cfg (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/C1D_PAPA/EXP00/namelist_cfg (revision 5602)
@@ -42,6 +42,6 @@
nn_msh = 0 ! create (=1) a mesh file or not (=0)
rn_rdt = 360. ! time step for the dynamics (and tracer if nn_acc=0)
- rn_rdtmin = 360. ! minimum time step on tracers (used if nn_acc=1)
- rn_rdtmax = 360. ! maximum time step on tracers (used if nn_acc=1)
+ rn_rdtmin = 360. ! minimum time step on tracers (used if nn_acc=1)
+ rn_rdtmax = 360. ! maximum time step on tracers (used if nn_acc=1)
jphgr_msh = 1 ! type of horizontal mesh
ppglam0 = -150.0 ! longitude of first raw and column T-point (jphgr_msh = 1)
@@ -102,6 +102,4 @@
&namsbc_ana ! analytical surface boundary condition
!-----------------------------------------------------------------------
- nn_tau000 = 100 ! gently increase the stress over the first ntau_rst time-steps
- rn_utau0 = 0.1e0 ! uniform value for the i-stress
/
!-----------------------------------------------------------------------
@@ -126,5 +124,5 @@
sn_prec = 'forcing_PAPASTATION_1h' , 1 , 'prec' , .false. , .false. , 'yearly' , '' , '', ''
sn_snow = 'forcing_PAPASTATION_1h' , 1 , 'snow' , .false. , .false. , 'yearly' , '' , '', ''
- ln_2m = .true. ! air temperature and humidity referenced at 2m (T) instead 10m (F)
+ rn_zqt = 2. ! air temperature and humidity referenced at 2m (T) instead 10m (F)
/
!-----------------------------------------------------------------------
@@ -133,5 +131,5 @@
/
!-----------------------------------------------------------------------
-&namsbc_cpl ! coupled ocean/atmosphere model ("key_coupled")
+&namsbc_cpl ! coupled ocean/atmosphere model ("key_oasis3")
!-----------------------------------------------------------------------
/
@@ -219,4 +217,9 @@
&nameos ! ocean physical parameters
!-----------------------------------------------------------------------
+ nn_eos = 0 ! type of equation of state and Brunt-Vaisala frequency
+ ! =-1, TEOS-10
+ ! = 0, EOS-80
+ ! = 1, S-EOS (simplified eos)
+ ln_useCT = .false. ! use of Conservative Temp. ==> surface CT converted in Pot. Temp. in sbcssm
/
!-----------------------------------------------------------------------
@@ -241,6 +244,4 @@
!-----------------------------------------------------------------------
ln_tradmp = .false. ! add a damping termn (T) or not (F)
- nn_zdmp = -1 ! vertical shape =0 damping throughout the water column
- nn_file = 1 ! create a damping.coeff NetCDF file (=1) or not (=0)
/
!-----------------------------------------------------------------------
@@ -257,4 +258,8 @@
/
!-----------------------------------------------------------------------
+&namc1d_dyndmp ! U & V newtonian damping ("key_c1d")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
&namdyn_hpg ! Hydrostatic pressure gradient option
!-----------------------------------------------------------------------
@@ -271,7 +276,5 @@
&namzdf ! vertical physics
!-----------------------------------------------------------------------
-! rn_avm0 = 5.0e-6 !rbb 1.2e-4 ! vertical eddy viscosity [m2/s] (background Kz if not "key_zdfcst")
-! rn_avt0 = 5.0e-6 !rbb 1.2e-5 ! vertical eddy diffusivity [m2/s] (background Kz if not "key_zdfcst")
- ln_zdfevd = .false. !rbb .true. ! enhanced vertical diffusion (evd) (T) or not (F)
+ ln_zdfevd = .false. ! enhanced vertical diffusion (evd) (T) or not (F)
/
!-----------------------------------------------------------------------
@@ -290,5 +293,4 @@
&namzdf_gls ! GLS vertical diffusion ("key_zdfgls")
!-----------------------------------------------------------------------
- rn_clim_galp = 0.267 ! galperin limit
/
!-----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/GYRE/EXP00/iodef.xml
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/GYRE/EXP00/iodef.xml (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/GYRE/EXP00/iodef.xml (revision 5602)
@@ -42,28 +42,19 @@
-
+
-
-
+
-
-
+
-
-
+
@@ -71,5 +62,5 @@
-
+
@@ -95,10 +86,13 @@
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/GYRE/EXP00/namelist_cfg
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/GYRE/EXP00/namelist_cfg (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/GYRE/EXP00/namelist_cfg (revision 5602)
@@ -116,5 +116,5 @@
/
!-----------------------------------------------------------------------
-&namsbc_cpl ! coupled ocean/atmosphere model ("key_coupled")
+&namsbc_cpl ! coupled ocean/atmosphere model ("key_oasis3")
!-----------------------------------------------------------------------
/
@@ -245,6 +245,4 @@
!-----------------------------------------------------------------------
ln_tradmp = .false. ! add a damping termn (T) or not (F)
- nn_zdmp = 1 ! vertical shape =0 damping throughout the water column
- nn_file = 1 ! create a damping.coeff NetCDF file (=1) or not (=0)
/
!-----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/GYRE_BFM/EXP00/iodef.xml
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/GYRE_BFM/EXP00/iodef.xml (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/GYRE_BFM/EXP00/iodef.xml (revision 5602)
@@ -31,9 +31,7 @@
-
-
+
-
-
+
@@ -57,10 +55,13 @@
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_cfg
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_cfg (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_cfg (revision 5602)
@@ -121,5 +121,5 @@
/
!-----------------------------------------------------------------------
-&namsbc_cpl ! coupled ocean/atmosphere model ("key_coupled")
+&namsbc_cpl ! coupled ocean/atmosphere model ("key_oasis3")
!-----------------------------------------------------------------------
/
@@ -244,6 +244,4 @@
!-----------------------------------------------------------------------
ln_tradmp = .false. ! add a damping termn (T) or not (F)
- nn_zdmp = 1 ! vertical shape =0 damping throughout the water column
- nn_file = 1 ! create a damping.coeff NetCDF file (=1) or not (=0)
/
!-----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/iodef.xml
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/iodef.xml (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/iodef.xml (revision 5602)
@@ -43,11 +43,8 @@
-
+
-
@@ -55,7 +52,4 @@
-
@@ -63,7 +57,4 @@
-
@@ -132,10 +123,13 @@
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_cfg
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_cfg (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_cfg (revision 5602)
@@ -155,6 +155,4 @@
!-----------------------------------------------------------------------
ln_tradmp = .false. ! add a damping termn (T) or not (F)
- nn_zdmp = 1 ! vertical shape =0 damping throughout the water column
- nn_file = 1 ! create a damping.coeff NetCDF file (=1) or not (=0)
/
!-----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/iodef.xml
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/iodef.xml (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/iodef.xml (revision 5602)
@@ -42,28 +42,19 @@
-
+
-
-
+
-
-
+
-
-
+
@@ -71,5 +62,5 @@
-
+
@@ -95,10 +86,13 @@
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/namelist_cfg
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/namelist_cfg (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/namelist_cfg (revision 5602)
@@ -110,5 +110,5 @@
/
!-----------------------------------------------------------------------
-&namsbc_cpl ! coupled ocean/atmosphere model ("key_coupled")
+&namsbc_cpl ! coupled ocean/atmosphere model ("key_oasis3")
!-----------------------------------------------------------------------
/
@@ -195,5 +195,5 @@
&nameos ! ocean physical parameters
!-----------------------------------------------------------------------
- nn_eos = 2 ! type of equation of state and Brunt-Vaisala frequency
+ nn_eos = 0 ! type of equation of state and Brunt-Vaisala frequency
/
!-----------------------------------------------------------------------
@@ -216,6 +216,4 @@
!-----------------------------------------------------------------------
ln_tradmp = .false. ! add a damping termn (T) or not (F)
- nn_zdmp = 1 ! vertical shape =0 damping throughout the water column
- nn_file = 1 ! create a damping.coeff NetCDF file (=1) or not (=0)
/
!-----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist_cfg
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist_cfg (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist_cfg (revision 5602)
@@ -94,13 +94,12 @@
sn_snow = 'ncar_precip.15JUNE2009_fill' , -1 , 'SNOW' , .false. , .true. , 'yearly' , 'weights_core2_agrif_bilinear.nc' , '' , ''
sn_tdif = 'taudif_core' , 24 , 'taudif' , .false. , .true. , 'yearly' , 'weights_core2_agrif_bilinear.nc' , '' , ''
+
cn_dir = './' ! root directory for the location of the bulk files
- ln_2m = .false. ! air temperature and humidity referenced at 2m (T) instead 10m (F)
ln_taudif = .false. ! HF tau contribution: use "mean of stress module - module of the mean stress" data
- ln_bulk2z = .false. ! Air temperature/humidity and wind vectors are referenced at heights rn_zqt and rn_zu
- rn_zqt = 3. ! Air temperature and humidity reference height (m) (ln_bulk2z)
- rn_zu = 4. ! Wind vector reference height (m) (ln_bulk2z)
+ rn_zqt = 10. ! Air temperature and humidity reference height (m)
+ rn_zu = 10. ! Wind vector reference height (m)
rn_pfac = 1. ! multiplicative factor for precipitation (total & snow)
rn_efac = 1. ! multiplicative factor for evaporation (0. or 1.)
- rn_vfac = 0. ! multiplicative factor for ocean/ice velocity
+ rn_vfac = 0. ! multiplicative factor for ocean/ice velocity
! in the calculation of the wind stress (0.=absolute winds or 1.=relative winds)
/
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef.xml
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef.xml (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef.xml (revision 5602)
@@ -35,58 +35,59 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+ @toce_e3t / @e3t
+ @soce_e3t / @e3t
+
+
+
+ sqrt( @sst2 - @sst * @sst )
+ sqrt( @ssh2 - @ssh * @ssh )
+ @sstmax - @sstmin
+
+
+ @mldr10_1max - @mldr10_1min
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+ @uoce_e3u / @e3u
+
-
-
-
-
+
+
+ @voce_e3v / @e3v
+
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
@@ -101,10 +102,8 @@
-->
+
-
-
-
@@ -126,12 +125,15 @@
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
+
@@ -145,4 +147,7 @@
+
+
+
@@ -156,5 +161,5 @@
We must have buffer_size > jpi*jpj*jpk*8 (with jpi and jpj the subdomain size)
-->
- 5000000
+ 50000000
2
0
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_ar5.xml
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_ar5.xml (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_ar5.xml (revision 5602)
@@ -32,7 +32,7 @@
-
-
-
+
+
+
@@ -40,21 +40,21 @@
++++++++++++++++++++++++++++++++++++++++++++++ monthly +++++++++++++++++++++++++++++++++++++++++++++++++
-->
-
+
-
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
@@ -62,17 +62,20 @@
-
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
+
+
@@ -84,5 +87,6 @@
-
+
+
@@ -101,6 +105,8 @@
+
-
+
+
-
-
-
-
-
+
+
+
+
+
-
+
@@ -123,13 +129,13 @@
-->
-
-
-
-
-
+
+
+
+
+
-
+
@@ -138,19 +144,19 @@
-->
-
-
+
+
-
-
+
+
-
+
-
+
-
+
@@ -159,5 +165,5 @@
-
+
@@ -175,11 +181,11 @@
-->
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
-
+
-
+
-
+
-
-
-
-
-
+
+
+
+
+
-
+
@@ -214,10 +220,10 @@
-
-
-
-
-
-
+
+
+
+
+
+
@@ -243,11 +249,14 @@
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
@@ -262,4 +271,7 @@
+
+
+
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_crs.xml
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_crs.xml (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_crs.xml (revision 5602)
@@ -34,15 +34,15 @@
-
-
-
+
+
+
-
+
-
+
@@ -54,50 +54,50 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
@@ -124,9 +124,13 @@
-
-
-
-
-
+
+
+
+
+
+
+
+
+
@@ -142,4 +146,7 @@
+
+
+
@@ -169,15 +176,15 @@
-
-
-
+
+
+
-
+
-
+
@@ -187,26 +194,26 @@
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
+
@@ -233,9 +240,14 @@
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
Index: anches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_default.xml
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_default.xml (revision 5601)
+++ (revision )
@@ -1,170 +1,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- 5000000
- 2
- 0
- false
- false
- oceanx
-
-
-
-
-
-
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_demo.xml
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_demo.xml (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_demo.xml (revision 5602)
@@ -64,5 +64,5 @@
-
+
@@ -78,13 +78,16 @@
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
@@ -100,4 +103,7 @@
+
+
+
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_oldstyle.xml
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_oldstyle.xml (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_oldstyle.xml (revision 5602)
@@ -111,11 +111,14 @@
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
@@ -130,4 +133,7 @@
+
+
+
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/README
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/README (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/README (revision 5602)
@@ -2,5 +2,16 @@
# prerequired
#----------------------------------------------------------------------
-To use these idl tools, you need to download some climatogies and mask files;
+First, you need either :
+- IDL (version 6.4 or above), see : http://www.exelisvis.com/ProductsServices/IDL.aspx
+ In this case, you also need to download SAXO which is a free package of IDL scripts:
+ define $PATH_SAXO, the path where you will download SAXO and get it through svn with the following command.
+ > PATH_SAXO=...
+ > svn checkout http://forge.ipsl.jussieu.fr/saxo/svn/trunk/SRC $PATH_SAXO/SAXO_DIR/SRC
+
+- or the IDL Virtual Machine which is free to use and does not require a license to run , see :
+ http://www.exelisvis.com/Support/HelpArticlesDetail/TabId/219/ArtMID/900/ArticleID/12395/The-IDL-Virtual-Machine.aspx
+ the virtual machine requites std_main.sav that is distributed with this README.
+
+Next, to use these idl tools, you need to download some climatogies and mask files;
that you can find here: http://dodsp.idris.fr/reee512/NEMO_OUT/ORCA2_LIM/
@@ -13,14 +24,13 @@
# define your std_plot_vardef.sh or std_ts_vardef.sh file
#----------------------------------------------------------------------
-Use the examples provided in :
+These files are needed to define your PATHs, the experiments and variables names you used in your experiment.
+ - std_plot_vardef.sh is used to do all plots based on temporal mean (maps, vertical profiles...).
+ - std_ts_vardef.sh is used to do all time-series type of plot.
+
+To build you own std_plot_vardef.sh or std_ts_vardef.sh file; use the examples provided such as:
- std_ts_vardef.sh_example1 or std_ts_vardef.sh_example2
- std_plot_vardef.sh_example1 or std_plot_vardef.sh_example2
-to build your own std_plot_vardef.sh or std_ts_vardef.sh file.
-This file is needed to define you PATH, the experiments and variables names
-
-you can copy std_ts_vardef.sh_example1 con std_ts_vardef.sh
-and std_plot_vardef.sh_example1 std_plot_vardef.sh
-
+Note that if you use the IDL Virtual Machine, the variable SAXO_DIR defined in std_plot_vardef.sh or std_ts_vardef.sh is not used. Any definition will be ok.
#----------------------------------------------------------------------
@@ -32,6 +42,13 @@
-#----------------------------------------------------------------------
-# short note on: How to build IDL virtual Machine:
+
+
+##########################################################################################################
+# short note for developers of this package on:
+# How to build the tarball required for IDL virtual Machine:
+##########################################################################################################
+#
+# we need to recreate std_main.sav as soon as we change IDL programmes files as
+# std_main.sav contains all ".pro" files aready compiled to be used with the virtual machine
#
. ./std_plot_vardef.sh # or . ./std_ts_vardef.sh
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh.500yfwb0
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh.500yfwb0 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh.500yfwb0 (revision 5602)
@@ -114,5 +114,5 @@
export VAR1_Ithick V1It_PREF V1It_SUFF
export VAR1_SNOW V1SNOW_PREF V1SNOW_SUFF
-export VAR1_IvelV V1IvV_PREF V1IvV_PREF
+export VAR1_IvelV V1IvV_PREF V1IvV_SUFF
#===================== EXP2 =====================
export DATE1_2 DATE2_2
@@ -127,4 +127,4 @@
export VAR2_Ithick V2It_PREF V2It_SUFF
export VAR2_SNOW V2SNOW_PREF V2SNOW_SUFF
-export VAR2_IvelV V2IvV_PREF V2IvV_PREF
+export VAR2_IvelV V2IvV_PREF V2IvV_SUFF
#
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh.500yfwb2
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh.500yfwb2 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh.500yfwb2 (revision 5602)
@@ -114,5 +114,5 @@
export VAR1_Ithick V1It_PREF V1It_SUFF
export VAR1_SNOW V1SNOW_PREF V1SNOW_SUFF
-export VAR1_IvelV V1IvV_PREF V1IvV_PREF
+export VAR1_IvelV V1IvV_PREF V1IvV_SUFF
#===================== EXP2 =====================
export DATE1_2 DATE2_2
@@ -127,4 +127,4 @@
export VAR2_Ithick V2It_PREF V2It_SUFF
export VAR2_SNOW V2SNOW_PREF V2SNOW_SUFF
-export VAR2_IvelV V2IvV_PREF V2IvV_PREF
+export VAR2_IvelV V2IvV_PREF V2IvV_SUFF
#
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh_example1
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh_example1 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh_example1 (revision 5602)
@@ -112,5 +112,5 @@
export VAR1_Ithick V1It_PREF V1It_SUFF
export VAR1_SNOW V1SNOW_PREF V1SNOW_SUFF
-export VAR1_IvelV V1IvV_PREF V1IvV_PREF
+export VAR1_IvelV V1IvV_PREF V1IvV_SUFF
#===================== EXP2 =====================
export DATE1_2 DATE2_2
@@ -125,4 +125,4 @@
export VAR2_Ithick V2It_PREF V2It_SUFF
export VAR2_SNOW V2SNOW_PREF V2SNOW_SUFF
-export VAR2_IvelV V2IvV_PREF V2IvV_PREF
+export VAR2_IvelV V2IvV_PREF V2IvV_SUFF
#
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh_example2
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh_example2 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh_example2 (revision 5602)
@@ -112,5 +112,5 @@
export VAR1_Ithick V1It_PREF V1It_SUFF
export VAR1_SNOW V1SNOW_PREF V1SNOW_SUFF
-export VAR1_IvelV V1IvV_PREF V1IvV_PREF
+export VAR1_IvelV V1IvV_PREF V1IvV_SUFF
#===================== EXP2 =====================
export DATE1_2 DATE2_2
@@ -125,4 +125,4 @@
export VAR2_Ithick V2It_PREF V2It_SUFF
export VAR2_SNOW V2SNOW_PREF V2SNOW_SUFF
-export VAR2_IvelV V2IvV_PREF V2IvV_PREF
+export VAR2_IvelV V2IvV_PREF V2IvV_SUFF
#
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/cpp_ORCA2_LIM.fcm
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/cpp_ORCA2_LIM.fcm (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM/cpp_ORCA2_LIM.fcm (revision 5602)
@@ -1,1 +1,1 @@
-bld::tool::fppkeys key_trabbl key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi key_diaobs key_asminc
+bld::tool::fppkeys key_trabbl key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi key_diaobs key_asminc
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/1_namelist_cfg
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/1_namelist_cfg (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/1_namelist_cfg (revision 5602)
@@ -94,13 +94,12 @@
sn_snow = 'ncar_precip.15JUNE2009_fill' , -1 , 'SNOW' , .false. , .true. , 'yearly' , 'weights_core2_agrif_bilinear.nc' , '' , ''
sn_tdif = 'taudif_core' , 24 , 'taudif' , .false. , .true. , 'yearly' , 'weights_core2_agrif_bilinear.nc' , '' , ''
+
cn_dir = './' ! root directory for the location of the bulk files
- ln_2m = .false. ! air temperature and humidity referenced at 2m (T) instead 10m (F)
ln_taudif = .false. ! HF tau contribution: use "mean of stress module - module of the mean stress" data
- ln_bulk2z = .false. ! Air temperature/humidity and wind vectors are referenced at heights rn_zqt and rn_zu
- rn_zqt = 3. ! Air temperature and humidity reference height (m) (ln_bulk2z)
- rn_zu = 4. ! Wind vector reference height (m) (ln_bulk2z)
+ rn_zqt = 10. ! Air temperature and humidity reference height (m)
+ rn_zu = 10. ! Wind vector reference height (m)
rn_pfac = 1. ! multiplicative factor for precipitation (total & snow)
rn_efac = 1. ! multiplicative factor for evaporation (0. or 1.)
- rn_vfac = 0. ! multiplicative factor for ocean/ice velocity
+ rn_vfac = 0. ! multiplicative factor for ocean/ice velocity
! in the calculation of the wind stress (0.=absolute winds or 1.=relative winds)
/
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef.xml
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef.xml (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef.xml (revision 5602)
@@ -35,72 +35,82 @@
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
+
+ @toce_e3t / @e3t
+ @soce_e3t / @e3t
+
+
+
+ sqrt( @sst2 - @sst * @sst )
+ sqrt( @ssh2 - @ssh * @ssh )
+ @sstmax - @sstmin
+
+
+ @mldr10_1max - @mldr10_1min
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
-
-
-
+
+
+ @uoce_e3u / @e3u
+
-
-
-
+
+
+
-
-
-
+
+
+ @voce_e3v / @e3v
+
-
-
-
+
+
+
-
-
-
+
+
+
+
-
-
-
-
-
+
+
+
+
+
@@ -118,137 +128,140 @@
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
@@ -267,10 +280,5 @@
-
-
-
-
-
@@ -292,11 +300,13 @@
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
@@ -312,4 +322,7 @@
+
+
+
@@ -323,5 +336,5 @@
We must have buffer_size > jpi*jpj*jpk*8 (with jpi and jpj the subdomain size)
-->
- 5000000
+ 50000000
2
0
Index: anches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef_ar5.xml
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef_ar5.xml (revision 5601)
+++ (revision )
@@ -1,288 +1,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- 25000000
- 2
- 0
- false
- false
- oceanx
-
-
-
-
-
-
-
Index: anches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef_default.xml
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef_default.xml (revision 5601)
+++ (revision )
@@ -1,336 +1,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- 5000000
- 2
- 0
- true
- false
- oceanx
-
-
-
-
-
-
Index: anches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef_demo.xml
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef_demo.xml (revision 5601)
+++ (revision )
@@ -1,125 +1,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- 25000000
- 2
- 0
- false
- false
- oceanx
-
-
-
-
-
-
Index: anches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef_oldstyle.xml
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef_oldstyle.xml (revision 5601)
+++ (revision )
@@ -1,153 +1,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- 25000000
- 2
- 0
- false
- false
- oceanx
-
-
-
-
-
-
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM3/cpp_ORCA2_LIM3.fcm
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM3/cpp_ORCA2_LIM3.fcm (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM3/cpp_ORCA2_LIM3.fcm (revision 5602)
@@ -1,1 +1,1 @@
- bld::tool::fppkeys key_trabbl key_lim3 key_vvl key_dynspg_ts key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi key_diaobs key_asminc
+ bld::tool::fppkeys key_trabbl key_lim3 key_vvl key_dynspg_ts key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi key_diaobs key_asminc
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/1_namelist_cfg
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/1_namelist_cfg (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/1_namelist_cfg (revision 5602)
@@ -110,5 +110,5 @@
!! namsbc_clio CLIO bulk formulea formulation
!! namsbc_core CORE bulk formulea formulation
-!! namsbc_cpl CouPLed formulation ("key_coupled")
+!! namsbc_cpl CouPLed formulation ("key_oasis3")
!! namtra_qsr penetrative solar radiation
!! namsbc_rnf river runoffs
@@ -199,5 +199,5 @@
/
!-----------------------------------------------------------------------
-&namsbc_cpl ! coupled ocean/atmosphere model ("key_coupled")
+&namsbc_cpl ! coupled ocean/atmosphere model ("key_oasis3")
!-----------------------------------------------------------------------
! ! description ! multiple ! vector ! vector ! vector !
@@ -640,5 +640,5 @@
! = 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 ("key_coupled")
+ ! = 3 as = 1 applied on HF part of the stress ("key_oasis3")
rn_efr = 0.05 ! fraction of surface tke value which penetrates below the ML (nn_etau=1 or 2)
nn_htau = 1 ! type of exponential decrease of tke penetration below the ML
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/iodef.xml
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/iodef.xml (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/iodef.xml (revision 5602)
@@ -36,64 +36,64 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
-
-
-
-
-
+
+
+
+
+
@@ -120,10 +120,13 @@
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/iodef.xml_cfc
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/iodef.xml_cfc (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/iodef.xml_cfc (revision 5602)
@@ -1,3 +1,6 @@
+
+
+
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/namelist_cfg
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/namelist_cfg (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/namelist_cfg (revision 5602)
@@ -104,5 +104,5 @@
/
!-----------------------------------------------------------------------
-&namsbc_cpl ! coupled ocean/atmosphere model ("key_coupled")
+&namsbc_cpl ! coupled ocean/atmosphere model ("key_oasis3")
!-----------------------------------------------------------------------
/
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/iodef.xml
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/iodef.xml (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/iodef.xml (revision 5602)
@@ -34,15 +34,15 @@
-
-
-
+
+
+
-
+
-
+
@@ -55,4 +55,5 @@
tintpp * 12. * 86400. * 365. / 1e15
pno3tot * 16. / 122. * 1e6
+ ppo4tot * 1. / 122. * 1e6
psiltot * 1e6
palktot * 1e6
@@ -66,58 +67,49 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
-
-
-
-
+
+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
@@ -245,10 +237,13 @@
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_top_cfg
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_top_cfg (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_top_cfg (revision 5602)
@@ -5,5 +5,4 @@
&namtrc_run ! run information
!-----------------------------------------------------------------------
- ln_top_euler = .true. ! use Euler time-stepping for TOP
/
!-----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/iodef.xml
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/iodef.xml (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/iodef.xml (revision 5602)
@@ -39,4 +39,5 @@
tintpp * 12. * 86400. * 365. / 1e15
pno3tot * 16. / 122. * 1e6
+ ppo4tot * 1. / 122. * 1e6
psiltot * 1e6
palktot * 1e6
@@ -167,10 +168,13 @@
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_cfg
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_cfg (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_cfg (revision 5602)
@@ -67,4 +67,5 @@
!-----------------------------------------------------------------------
nn_fsbc = 1 ! frequency of surface boundary condition computation
+ ln_rnf = .false. ! runoffs
/
!-----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_top_cfg
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_top_cfg (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_top_cfg (revision 5602)
@@ -6,5 +6,4 @@
!-----------------------------------------------------------------------
nn_writetrc = 1460 ! time step frequency for sn_tracer outputs
- ln_top_euler = .true. ! use Euler time-stepping for TOP
/
!-----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_SAS_LIM/EXP00/iodef.xml
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_SAS_LIM/EXP00/iodef.xml (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/ORCA2_SAS_LIM/EXP00/iodef.xml (revision 5602)
@@ -31,64 +31,64 @@
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
+
-
+
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
@@ -115,11 +115,14 @@
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/SHARED/README_configs_namcfg_namdom
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/SHARED/README_configs_namcfg_namdom (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/SHARED/README_configs_namcfg_namdom (revision 5602)
@@ -331,7 +331,7 @@
!-----------------------------------------------------------------------
cp_cfg = "orca" ! name of the configuration
- jp_cfg = 1442 ! resolution of the configuration
- jpidta = 1021 ! 1st lateral dimension ( >= jpi )
- jpjdta = 511 ! 2nd " " ( >= jpj )
+ jp_cfg = 025 ! resolution of the configuration
+ jpidta = 1442 ! 1st lateral dimension ( >= jpi )
+ jpjdta = 1021 ! 2nd " " ( >= jpj )
jpkdta = 75 ! number of levels ( >= jpk )
jpiglo = 1442 ! 1st dimension of global domain --> i =jpidta
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/SHARED/domain_def.xml
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/SHARED/domain_def.xml (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/SHARED/domain_def.xml (revision 5602)
@@ -169,10 +169,15 @@
-
-
-
+
+
+
+
+
+
+
+
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/SHARED/field_def.xml
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/SHARED/field_def.xml (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/SHARED/field_def.xml (revision 5602)
@@ -13,241 +13,265 @@
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+ toce * e3t
+
+ soce * e3t
+
+
+ sst * sst
+
+
+
+
+
+
+
+ sss * sss
+
+
+
+
+
+
+
+ ssh * ssh
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+
+
-
-
+
+
+
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+ topthdep - pycndep
+
+
+
+
+
+
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
-
-
-
-
+
+
+
+
-
-
-
-
-
+
+
+
+
+
-
-
+
+
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
@@ -255,9 +279,11 @@
-
+
+
+
-
+
@@ -266,23 +292,24 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
@@ -298,25 +325,37 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
@@ -325,51 +364,69 @@
-
-
-
-
-
-
+
+
+
+ uoce * e3u
+
+
+
+
+
+
+
-
+
+
-
+
+
-
-
+
+
+
-
+
+
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+ voce * e3v
+
+
+
+
+
+
+
-
+
+
-
+
+
-
-
+
+
+
-
+
+
-
-
-
-
-
+
+
+
+
+
@@ -377,25 +434,32 @@
-
-
+
+
+
+
-
+
+
-
-
+
+
+
-
+
+
-
-
+
+
+
-
+
+
-
-
-
+
+
+
-
-
+
+
@@ -403,283 +467,480 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ sqrt( ttrd_xad^2 + ttrd_yad^2 + ttrd_zad^2 )
+ sqrt( strd_xad^2 + strd_yad^2 + strd_zad^2 )
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+ DIC * e3t
+
+ Alkalini * e3t
+
+ O2 * e3t
+
+ CaCO3 * e3t
+
+ PO4 * e3t
+
+ POC * e3t
+
+ Si * e3t
+
+ PHY * e3t
+
+ ZOO * e3t
+
+ DOC * e3t
+
+ PHY2 * e3t
+
+ ZOO2 * e3t
+
+ DSi * e3t
+
+ Fer * e3t
+
+ BFe * e3t
+
+ GOC * e3t
+
+ SFe * e3t
+
+ DFe * e3t
+
+ GSi * e3t
+
+ NFe * e3t
+
+ NCHL * e3t
+
+ DCHL * e3t
+
+ NO3 * e3t
+
+ NH4 * e3t
-
+
+ Num * e3t
-
-
+
+ DET * e3t
+
+ DOM * e3t
-
+
+ CFC11 * e3t
-
+
+ C14B * e3t
-
+
+
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
@@ -702,22 +963,21 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
@@ -730,15 +990,15 @@
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
@@ -759,121 +1019,4 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/SHARED/namelist_ice_lim2_ref
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/SHARED/namelist_ice_lim2_ref (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/SHARED/namelist_ice_lim2_ref (revision 5602)
@@ -14,5 +14,7 @@
!-----------------------------------------------------------------------
cn_icerst_in = "restart_ice_in" ! suffix of ice restart name (input)
+ cn_icerst_indir = "." ! directory from which to read input ice restarts
cn_icerst_out = "restart_ice" ! suffix of ice restart name (output)
+ cn_icerst_outdir = "." ! directory in which to write output ice restarts
ln_limdyn = .true. ! ice dynamics (T) or thermodynamics only (F)
ln_limdmp = .false. ! restoring ice thickness and fraction leads (T => fill namice_dmp)
@@ -48,11 +50,10 @@
c_rhg = 20.0 ! 2nd bulk-rhelogy parameter
etamn = 0.0e+07 ! minimun value for viscosity
- creepl = 1.0e-08 ! creep limit
- ecc = 2.0 ! eccentricity of the elliptical yield curve
+ rn_creepl = 1.0e-08 ! creep limit
+ rn_ecc = 2.0 ! eccentricity of the elliptical yield curve
ahi0 = 350.e0 ! horizontal eddy diffusivity coefficient for sea-ice [m2/s]
- nevp = 120 ! number of EVP subcycling iterations
+ nn_nevp = 120 ! number of EVP subcycling iterations
telast = 9600 ! timescale for EVP elastic waves
alphaevp = 1.0 ! coefficient for the solution of EVP int. stresses
- hminrhg = 0.05 ! ice thickness (m) below which ice velocity equal ocean velocity
/
!-----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/SHARED/namelist_ice_lim3_ref
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/SHARED/namelist_ice_lim3_ref (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/SHARED/namelist_ice_lim3_ref (revision 5602)
@@ -1,126 +1,136 @@
!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-!! NEMO/LIM3 : 1 - dynamics/advection/thermo (namicerun)
-!! namelists 2 - ice intialisation (namiceini)
-!! 3 - ice dynamic (namicedyn)
-!! 4 - ice advection (namicetrp)
-!! 5 - thermodynamic (namicethd)
-!! 6 - ice salinity (namicesal)
-!! 7 - mechanical redistribution of ice (namiceitdme)
-!! 8 - ice diagnostics (namicedia)
-!! 9 - ice outputs (namiceout)
+!! LIM3 namelist :
+!! 1 - Generic parameters (namicerun)
+!! 2 - Ice initialization (namiceini)
+!! 3 - Ice discretization (namiceitd)
+!! 4 - Ice dynamics and transport (namicedyn)
+!! 5 - Ice thermodynamics (namicethd)
+!! 6 - Ice salinity (namicesal)
+!! 7 - Ice mechanical redistribution (namiceitdme)
!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-
-!-----------------------------------------------------------------------
-&namicerun ! Share parameters for dynamics/advection/thermo
-!-----------------------------------------------------------------------
+!
+!------------------------------------------------------------------------------
+&namicerun ! Generic parameters
+!------------------------------------------------------------------------------
+ jpl = 5 ! number of ice categories
+ nlay_i = 2 ! number of ice layers
+ nlay_s = 1 ! number of snow layers (only 1 is working)
cn_icerst_in = "restart_ice" ! suffix of ice restart name (input)
+ cn_icerst_indir = "." ! directory from which to read input ice restarts
cn_icerst_out = "restart_ice" ! suffix of ice restart name (output)
+ cn_icerst_outdir = "." ! directory in which to write output ice restarts
ln_limdyn = .true. ! ice dynamics (T) or thermodynamics only (F)
- amax = 0.999 ! maximum ice concentration
- cai = 1.40e-3 ! atmospheric drag over sea ice (clio)
- cao = 1.00e-3 ! atmospheric drag over ocean (clio)
- ln_nicep = .false. ! Ice points output for debug (yes or no)
- ln_limdiahsb = .false. ! check the heat and salt budgets (T) or not (F)
+ rn_amax = 0.999 ! maximum tolerated ice concentration
+ ln_limdiahsb = .false. ! check the heat and salt budgets (T) or not (F)
ln_limdiaout = .true. ! output the heat and salt budgets (T) or not (F)
+ ln_icectl = .false. ! ice points output for debug (T or F)
+ iiceprt = 10 ! i-index for debug
+ jiceprt = 10 ! j-index for debug
/
-!-----------------------------------------------------------------------
-&namiceini ! ice initialisation
-!-----------------------------------------------------------------------
- ln_limini = .false. ! activate ice initialization (T) or not (F)
- thres_sst = 0.0 ! threshold water temperature for initial sea ice
- hts_ini_n = 0.3 ! initial snow thickness in the north
- hts_ini_s = 0.3 ! " " south
- hti_ini_n = 1.0 ! initial ice thickness in the north
- hti_ini_s = 1.0 ! " " south
- ati_ini_n = 0.9 ! initial ice concentration in the north
- ati_ini_s = 0.9 ! " " south
- smi_ini_n = 6.301 ! initial ice salinity in the north
- smi_ini_s = 6.301 ! " " south
- tmi_ini_n = 270. ! initial ice/snw temp in the north
- tmi_ini_s = 270. ! initial ice/snw temp in the south
+!------------------------------------------------------------------------------
+&namiceini ! Ice initialization
+!------------------------------------------------------------------------------
+ ln_iceini = .true. ! activate ice initialization (T) or not (F)
+ rn_thres_sst = 2.0 ! maximum water temperature with initial ice (degC)
+ rn_hts_ini_n = 0.3 ! initial real snow thickness (m), North
+ rn_hts_ini_s = 0.3 ! " " South
+ rn_hti_ini_n = 3.0 ! initial real ice thickness (m), North
+ rn_hti_ini_s = 1.0 ! " " South
+ rn_ati_ini_n = 0.9 ! initial ice concentration (-), North
+ rn_ati_ini_s = 0.9 ! " " South
+ rn_smi_ini_n = 6.3 ! initial ice salinity (g/kg), North
+ rn_smi_ini_s = 6.3 ! " " South
+ rn_tmi_ini_n = 270. ! initial ice/snw temperature (K), North
+ rn_tmi_ini_s = 270. ! " " South
/
-!-----------------------------------------------------------------------
-&namicedyn ! ice dynamic
-!-----------------------------------------------------------------------
- epsd = 1.0e-20 ! tolerance parameter
- om = 0.5 ! relaxation constant
- cw = 5.0e-03 ! drag coefficient for oceanic stress
- pstar = 2.0e+04 ! 1st bulk-rheology parameter
- c_rhg = 20.0 ! 2nd bulk-rhelogy parameter
- creepl = 1.0e-12 ! creep limit
- ecc = 2.0 ! eccentricity of the elliptical yield curve
- ahi0 = 350.e0 ! horizontal eddy diffusivity coefficient for sea-ice [m2/s]
- nevp = 120 ! number of iterations for subcycling in EVP
- relast = 0.333 ! ratio of elastic timescale over ice time step (1/3 if nevp=120 ; 1/9 if nevp=300)
- alphaevp = 1.0 ! coefficient for the solution of internal ice stresses
- hminrhg = 0.001 ! ice volume (a*h in m) below which ice velocity equal ocean velocity
+!------------------------------------------------------------------------------
+&namiceitd ! Ice discretization
+!------------------------------------------------------------------------------
+ nn_catbnd = 2 ! computation of ice category boundaries based on
+ ! 1: tanh function
+ ! 2: h^(-alpha), function of rn_himean
+ rn_himean = 2.0 ! expected domain-average ice thickness (m), nn_catbnd = 2 only
/
-!-----------------------------------------------------------------------
-&namicethd ! ice thermodynamic
-!-----------------------------------------------------------------------
- hmelt = -0.15 ! maximum melting at the bottom
- hiccrit = 0.1 ! ice thickness for lateral accretion
- ! caution 1.0, 1.0 best value to be used!!! (gilles G.) ????
- fraz_swi = 0 ! use of frazil ice collection thickness in function of wind (1.0) or not (0.0)
- maxfrazb = 0.0 ! maximum portion of frazil ice collecting at the ice bottom
- vfrazb = 0.4166667 ! thresold drift speed for frazil ice collecting at the ice bottom
- Cfrazb = 5.0 ! squeezing coefficient for frazil ice collecting at the ice bottom
- hiclim = 0.10 ! minimum ice thickness
- hnzst = 0.1 ! thickness of the surf. layer in temp. computation
- parsub = 1.0 ! switch for snow sublimation or not
- betas = 0.6 ! exponent in lead-ice fractionation of snow precipitation 0.66
- ! betas = 1 -> equipartition, betas < 1 -> more on leads
- kappa_i = 1.0 ! extinction radiation parameter in sea ice (1.0)
- nconv_i_thd = 50 ! maximal number of iterations for heat diffusion computation
- maxer_i_thd = 0.0001 ! maximal error in temperature for heat diffusion computation
- thcon_i_swi = 1 ! switch for computation of thermal conductivity in the ice
- ! (0) Untersteiner (1964), (1) Pringle et al. (2007)
+!------------------------------------------------------------------------------
+&namicedyn ! Ice dynamics and transport
+!------------------------------------------------------------------------------
+ nn_icestr = 0 ! ice strength parameteriztaion
+ ! 0: Hibler_79 P = pstar**exp(-c_rhg*A)
+ ! 1: Rothrock_75 P = Cf*coeff*integral(wr.h^2)
+ ln_icestr_bvf = .false. ! ice strength function brine volume (T) or not (F)
+ rn_pe_rdg = 17.0 ! ridging work divided by pot. energy change in ridging, if nn_icestr = 1
+ rn_pstar = 2.0e+04 ! ice strength thickness parameter (N/m2), nn_icestr = 0
+ rn_crhg = 20.0 ! ice strength conc. parameter (-), nn_icestr = 0
+ rn_cio = 5.0e-03 ! ice-ocean drag coefficient (-)
+ rn_creepl = 1.0e-12 ! creep limit (s-1)
+ rn_ecc = 2.0 ! eccentricity of the elliptical yield curve
+ nn_nevp = 120 ! number of EVP subcycles
+ rn_relast = 0.333 ! ratio of elastic timescale to ice time step: Telast = dt_ice * rn_relast
+ ! advised value: 1/3 (rn_nevp=120) or 1/9 (rn_nevp=300)
+ nn_ahi0 = 2 ! horizontal diffusivity computation
+ ! 0: use rn_ahi0_ref
+ ! 1: use rn_ahi0_ref x mean grid cell length / ( 2deg mean grid cell length )
+ ! 2: use rn_ahi0_ref x grid cell length / ( 2deg mean grid cell length )
+ rn_ahi0_ref = 350.0 ! horizontal sea ice diffusivity (m2/s)
+ ! if nn_ahi0 > 0, rn_ahi0_ref is the reference value at a nominal 2 deg resolution
/
-!-----------------------------------------------------------------------
-&namicesal ! ice salinity
-!-----------------------------------------------------------------------
- num_sal = 2 ! salinity option: 1 -> S = bulk_sal
- ! 2 -> S = S(z,t) with a simple parameterization
- ! 3 -> S = S(z) profile of Scwharzacher [1959]
- ! 4 -> S = S(h) Cox and Weeks [1974]
- bulk_sal = 4.0 ! if 1 is used, it represents the ice salinity
- sal_G = 5.00 ! restoring salinity for GD
- time_G = 1.728e+6 ! restoring time for GD
- sal_F = 2.00 ! restoring salinity for flushing
- time_F = 8.640e+5 ! restoring time for flushing
- s_i_max = 20.0 ! Maximum salinity
- s_i_min = 0.1 ! Minimum tolerated ice salinity
- s_i_0 = 3.5 ! 1st salinity for salinity profile
- s_i_1 = 4.5 ! 2nd salinity for salinity profile
+!------------------------------------------------------------------------------
+&namicehdf ! Ice horizontal diffusion
+!------------------------------------------------------------------------------
+ nn_convfrq = 5 ! convergence check frequency of the Crant-Nicholson scheme (perf. optimization)
/
-!-----------------------------------------------------------------------
-&namiceitdme ! parameters for mechanical redistribution of ice
-!-----------------------------------------------------------------------
- ridge_scheme_swi = 0 ! which ridging scheme using (1=Rothrock,else=Hibler79)
- Cs = 0.50 ! shearing energy contribution to ridging
- Cf = 17.0 ! ratio of ridging work to PE change in ridging
- fsnowrdg = 0.5 ! snow fraction that survives in ridging
- fsnowrft = 0.5 ! snow fraction that survives in rafting
- Gstar = 0.15 ! fractional area of thin ice being ridged
- astar = 0.05 ! equivalent of gstar (0.05 for TH75 and 0.03 for weaker ice)
- Hstar = 100.0 ! parameter determining the maximum thickness of ridged ice
- raft_swi = 1 ! rafting or not
- hparmeter = 0.75 ! threshold thickness for rafting or not
- Craft = 5.0 ! coefficient used in the rafting function
- ridge_por = 0.3 ! initial porosity of the ridged ice (typically 0.30)
- partfun_swi = 1 ! participation function linear, TH75 (0) or exponential Letal07 (1)
- brinstren_swi = 0 ! (1) use brine volume to diminish ice strength
+!------------------------------------------------------------------------------
+&namicethd ! Ice thermodynamics
+!------------------------------------------------------------------------------
+ rn_hnewice = 0.1 ! thickness for new ice formation in open water (m)
+ ln_frazil = .false. ! use frazil ice collection thickness as a function of wind (T) or not (F)
+ rn_maxfrazb = 0.0 ! maximum fraction of frazil ice collecting at the ice base
+ rn_vfrazb = 0.417 ! thresold drift speed for frazil ice collecting at the ice bottom (m/s)
+ rn_Cfrazb = 5.0 ! squeezing coefficient for frazil ice collecting at the ice bottom
+ rn_himin = 0.10 ! minimum ice thickness (m) used in remapping, must be smaller than rn_hnewice
+ rn_betas = 0.66 ! exponent in lead-ice repratition of snow precipitation
+ ! betas = 1 -> equipartition, betas < 1 -> more on leads
+ rn_kappa_i = 1.0 ! radiation attenuation coefficient in sea ice (m-1)
+ nn_conv_dif = 50 ! maximal number of iterations for heat diffusion computation
+ rn_terr_dif = 0.0001 ! maximum temperature after heat diffusion (degC)
+ nn_ice_thcon= 1 ! sea ice thermal conductivity
+ ! 0: k = k0 + beta.S/T (Untersteiner, 1964)
+ ! 1: k = k0 + beta1.S/T - beta2.T (Pringle et al., 2007)
+ nn_monocat = 0 ! virtual ITD mono-category parameterizations (1, jpl = 1 only) or not (0)
+ ! 2: simple piling instead of ridging --- temporary option
+ ! 3: activate G(he) only --- temporary option
+ ! 4: activate lateral melting only --- temporary option
+ ln_it_qnsice = .true. ! iterate the surface non-solar flux with surface temperature (T) or not (F)
/
-!-----------------------------------------------------------------------
-&namicedia ! ice diagnostics
-!-----------------------------------------------------------------------
- fmtinf ='1PE13.5 ' ! format of the output values
- nfrinf = 4 ! number of variables written in one line
- ntmoy = 1 ! instantaneous values of ice evolution or averaging
- ninfo = 1 ! frequency of ouputs on file ice_evolu in case of averaging
+!------------------------------------------------------------------------------
+&namicesal ! Ice salinity
+!------------------------------------------------------------------------------
+ nn_icesal = 2 ! ice salinity option
+ ! 1: constant ice salinity (S=rn_icesal)
+ ! 2: varying salinity parameterization S(z,t)
+ ! 3: prescribed salinity profile S(z), Schwarzacher, 1959
+ rn_icesal = 4. ! ice salinity (g/kg, nn_icesal = 1 only)
+ rn_sal_gd = 5. ! restoring ice salinity, gravity drainage (g/kg)
+ rn_time_gd = 1.73e+6 ! restoring time scale, gravity drainage (s)
+ rn_sal_fl = 2. ! restoring ice salinity, flushing (g/kg)
+ rn_time_fl = 8.64e+5 ! restoring time scale, flushing (s)
+ rn_simax = 20. ! maximum tolerated ice salinity (g/kg)
+ rn_simin = 0.1 ! minimum tolerated ice salinity (g/kg)
/
-!!-----------------------------------------------------------------------
-!&namicehsb ! Heat and salt budgets
-!!-----------------------------------------------------------------------
-!/
-
+!------------------------------------------------------------------------------
+&namiceitdme ! Ice mechanical redistribution (ridging and rafting)
+!------------------------------------------------------------------------------
+ rn_Cs = 0.5 ! fraction of shearing energy contributing to ridging
+ rn_fsnowrdg = 0.5 ! snow volume fraction that survives in ridging
+ rn_fsnowrft = 0.5 ! snow volume fraction that survives in rafting
+ nn_partfun = 1 ! type of ridging participation function
+ ! 0: linear (Thorndike et al, 1975)
+ ! 1: exponential (Lipscomb, 2007
+ rn_gstar = 0.15 ! fractional area of thin ice being ridged (nn_partfun = 0)
+ rn_astar = 0.05 ! exponential measure of ridging ice fraction (nn_partfun = 1)
+ rn_hstar = 100.0 ! determines the maximum thickness of ridged ice (m) (Hibler, 1980)
+ ln_rafting = .true. ! rafting activated (T) or not (F)
+ rn_hraft = 0.75 ! threshold thickness for rafting (m)
+ rn_craft = 5.0 ! squeezing coefficient used in the rafting function
+ rn_por_rdg = 0.3 ! porosity of newly ridged ice (Lepparanta et al., 1995)
+/
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/SHARED/namelist_pisces_ref
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/SHARED/namelist_pisces_ref (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/SHARED/namelist_pisces_ref (revision 5602)
@@ -48,12 +48,12 @@
!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
concnno3 = 1.e-6 ! Nitrate half saturation of nanophytoplankton
- concdno3 = 3.E-6 ! Phosphate half saturation for diatoms
+ concdno3 = 3.E-6 ! Nitrate half saturation for diatoms
concnnh4 = 1.E-7 ! NH4 half saturation for phyto
concdnh4 = 3.E-7 ! NH4 half saturation for diatoms
concnfer = 1.E-9 ! Iron half saturation for phyto
concdfer = 3.E-9 ! Iron half saturation for diatoms
- concbfe = 1.E-11 ! Half-saturation for Fe limitation of Bacteria
- concbnh4 = 2.E-8 ! NH4 half saturation for phyto
- concbno3 = 2.E-7 ! Phosphate half saturation for diatoms
+ concbfe = 1.E-11 ! Iron half-saturation for DOC remin.
+ concbnh4 = 2.E-8 ! NH4 half saturation for DOC remin.
+ concbno3 = 2.E-7 ! Nitrate half saturation for DOC remin.
xsizedia = 1.E-6 ! Minimum size criteria for diatoms
xsizephy = 1.E-6 ! Minimum size criteria for phyto
@@ -61,5 +61,5 @@
xsizerd = 3.0 ! Size ratio for diatoms
xksi1 = 2.E-6 ! half saturation constant for Si uptake
- xksi2 = 20E-6 ! half saturation constant for Si/C
+ xksi2 = 20E-6 ! half saturation constant for Si/C
xkdoc = 417.E-6 ! half-saturation constant of DOC remineralization
qnfelim = 7.E-6 ! Optimal quota of phyto
@@ -86,10 +86,10 @@
excret2 = 0.05 ! excretion ratio of diatoms
ln_newprod = .true. ! Enable new parame. of production (T/F)
- bresp = 0.00333 ! Basal respiration rate
- chlcnm = 0.033 ! Minimum Chl/C in nanophytoplankton
- chlcdm = 0.05 ! Minimum Chl/C in diatoms
- chlcmin = 0.004 ! Maximum Chl/c in phytoplankton
+ bresp = 0.033 ! Basal respiration rate
+ chlcnm = 0.033 ! Maximum Chl/C in nanophytoplankton
+ chlcdm = 0.05 ! Maximum Chl/C in diatoms
+ chlcmin = 0.004 ! Minimum Chl/c in phytoplankton
fecnm = 40E-6 ! Maximum Fe/C in nanophytoplankton
- fecdm = 40E-6 ! Minimum Fe/C in diatoms
+ fecdm = 40E-6 ! Maximum Fe/C in diatoms
grosip = 0.159 ! mean Si/C ratio
/
@@ -110,8 +110,8 @@
resrat2 = 0.005 ! exsudation rate of mesozooplankton
mzrat2 = 0.03 ! mesozooplankton mortality rate
- xprefc = 1. ! zoo preference for phyto
- xprefp = 0.3 ! zoo preference for POC
- xprefz = 1. ! zoo preference for zoo
- xprefpoc = 0.3 ! zoo preference for poc
+ xprefc = 1. ! mesozoo preference for diatoms
+ xprefp = 0.3 ! mesozoo preference for nanophyto.
+ xprefz = 1. ! mesozoo preference for microzoo.
+ xprefpoc = 0.3 ! mesozoo preference for poc
xthresh2zoo = 1E-8 ! zoo feeding threshold for mesozooplankton
xthresh2dia = 1E-8 ! diatoms feeding threshold for mesozooplankton
@@ -119,5 +119,5 @@
xthresh2poc = 1E-8 ! poc feeding threshold for mesozooplankton
xthresh2 = 3E-7 ! Food threshold for grazing
- xkgraz2 = 20.E-6 ! half sturation constant for meso grazing
+ xkgraz2 = 20.E-6 ! half saturation constant for meso grazing
epsher2 = 0.35 ! Efficicency of Mesozoo growth
sigma2 = 0.6 ! Fraction of mesozoo excretion as DOM
@@ -156,5 +156,5 @@
&nampisrem ! parameters for remineralization
!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
- xremik = 0.35 ! remineralization rate of DOC
+ xremik = 0.3 ! remineralization rate of DOC
xremip = 0.025 ! remineralisation rate of POC
nitrif = 0.05 ! NH4 nitrification rate
@@ -207,4 +207,45 @@
/
!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisice ! Prescribed sea ice tracers
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+! constant ocean tracer concentrations are defined in trcice_pisces.F90 (Global, Arctic, Antarctic and Baltic)
+! trc_ice_ratio * betw 0 and 1: prescribed ice/ocean tracer concentration ratio
+! * -1 => the ice-ocean tracer concentration ratio follows the
+! ice-ocean salinity ratio
+! * -2 => tracer concentration in sea ice is prescribed and
+! trc_ice_prescr is used
+! trc_ice_prescr * prescribed tracer concentration. used only if
+! trc_ice_ratio = -2. equals -99 if not used.
+! cn_trc_o * 'GL' use global ocean values making the Baltic distinction only
+! 'AA' use specific Arctic/Antarctic/Baltic values
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+! sn_tri_ ! trc_ice_ratio ! trc_ice_prescr ! cn_trc_o
+ sn_tri_dic = -1., -99., 'AA'
+ sn_tri_doc = 0., -99., 'AA'
+ sn_tri_tal = -1., -99., 'AA'
+ sn_tri_oxy = -1., -99., 'AA'
+ sn_tri_cal = 0., -99., 'AA'
+ sn_tri_po4 = -1., -99., 'AA'
+ sn_tri_poc = 0., -99., 'AA'
+ sn_tri_goc = 0., -99., 'AA'
+ sn_tri_bfe = 0., -99., 'AA'
+ sn_tri_num = 0., -99., 'AA'
+ sn_tri_sil = -1., -99., 'AA'
+ sn_tri_dsi = 0., -99., 'AA'
+ sn_tri_gsi = 0., -99., 'AA'
+ sn_tri_phy = 0., -99., 'AA'
+ sn_tri_dia = 0., -99., 'AA'
+ sn_tri_zoo = 0., -99., 'AA'
+ sn_tri_mes = 0., -99., 'AA'
+ sn_tri_fer = -2., 15E-9, 'AA'
+ sn_tri_sfe = 0., -99., 'AA'
+ sn_tri_dfe = 0., -99., 'AA'
+ sn_tri_nfe = 0., -99., 'AA'
+ sn_tri_nch = 0., -99., 'AA'
+ sn_tri_dch = 0., -99., 'AA'
+ sn_tri_no3 = -1., -99., 'AA'
+ sn_tri_nh4 = 1., -99., 'AA'
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
&nampiskrp ! Kriest parameterization : parameters "key_kriest"
!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/SHARED/namelist_ref
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/SHARED/namelist_ref (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/SHARED/namelist_ref (revision 5602)
@@ -10,5 +10,5 @@
!! 7 - dynamics (namdyn_adv, namdyn_vor, namdyn_hpg, namdyn_spg, namdyn_ldf)
!! 8 - Verical physics (namzdf, namzdf_ric, namzdf_tke, namzdf_kpp, namzdf_ddm, namzdf_tmx)
-!! 9 - diagnostics (namnc4, namtrd, namspr, namflo, namptr, namhsb)
+!! 9 - diagnostics (namnc4, namtrd, namspr, namflo, namhsb, namsto)
!! 10 - miscellaneous (namsol, nammpp, namctl)
!! 11 - Obs & Assim (namobs, nam_asminc)
@@ -37,10 +37,15 @@
! = 2 nn_date0 read in restart ; nn_it000 : check consistancy between namelist and restart
cn_ocerst_in = "restart" ! suffix of ocean restart name (input)
+ cn_ocerst_indir = "." ! directory from which to read input ocean restarts
cn_ocerst_out = "restart" ! suffix of ocean restart name (output)
+ cn_ocerst_outdir = "." ! directory in which to write output ocean restarts
nn_istate = 0 ! output the initial state (1) or not (0)
+ ln_rst_list = .false. ! output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F)
nn_stock = 5475 ! frequency of creation of a restart file (modulo referenced to 1)
+ nn_stocklist = 0,0,0,0,0,0,0,0,0,0 ! List of timesteps when a restart file is to be written
nn_write = 5475 ! frequency of write in the output file (modulo referenced to nn_it000)
ln_dimgnnn = .false. ! DIMG file format: 1 file for all processors (F) or by processor (T)
ln_mskland = .false. ! mask land points in NetCDF outputs (costly: + ~15%)
+ ln_cfmeta = .false. ! output additional data to netCDF files required for compliance with the CF metadata standard
ln_clobber = .false. ! clobber (overwrite) an existing file
nn_chunksz = 0 ! chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
@@ -50,5 +55,5 @@
!! *** Domain namelists ***
!!======================================================================
-!! namcfg parameters of the configuration
+!! namcfg parameters of the configuration
!! namzgr vertical coordinate
!! namzgr_sco s-coordinate or hybrid z-s-coordinate
@@ -58,5 +63,5 @@
!
!-----------------------------------------------------------------------
-&namcfg ! parameters of the configuration
+&namcfg ! parameters of the configuration
!-----------------------------------------------------------------------
cp_cfg = "default" ! name of the configuration
@@ -72,8 +77,10 @@
jperio = 0 ! lateral cond. type (between 0 and 6)
! = 0 closed ; = 1 cyclic East-West
- ! = 2 equatorial symmetric ; = 3 North fold T-point pivot
+ ! = 2 equatorial symmetric ; = 3 North fold T-point pivot
! = 4 cyclic East-West AND North fold T-point pivot
! = 5 North fold F-point pivot
! = 6 cyclic East-West AND North fold F-point pivot
+ ln_use_jattr = .false. ! use (T) the file attribute: open_ocean_jstart, if present
+ ! in netcdf input files, as the start j-row for reading
/
!-----------------------------------------------------------------------
@@ -83,5 +90,5 @@
ln_zps = .true. ! z-coordinate - partial steps (T/F)
ln_sco = .false. ! s- or hybrid z-s-coordinate (T/F)
- ln_isfcav = .false. ! ice shelf cavity
+ ln_isfcav = .false. ! ice shelf cavity (T/F)
/
!-----------------------------------------------------------------------
@@ -99,5 +106,5 @@
!!!!!!! SH94 stretching coefficients (ln_s_sh94 = .true.)
rn_theta = 6.0 ! surface control parameter (0<=theta<=20)
- rn_bb = 0.8 ! stretching with SH94 s-sigma
+ rn_bb = 0.8 ! stretching with SH94 s-sigma
!!!!!!! SF12 stretching coefficient (ln_s_sf12 = .true.)
rn_alpha = 4.4 ! stretching with SF12 s-sigma
@@ -108,5 +115,5 @@
rn_zb_b = -0.2 ! offset for calculating Zb
!!!!!!!! Other stretching (not SH94 or SF12) [also uses rn_theta above]
- rn_thetb = 1.0 ! bottom control parameter (0<=thetb<= 1)
+ rn_thetb = 1.0 ! bottom control parameter (0<=thetb<= 1)
/
!-----------------------------------------------------------------------
@@ -116,5 +123,5 @@
rn_bathy = 0. ! value of the bathymetry. if (=0) bottom flat at jpkm1
nn_closea = 0 ! remove (=0) or keep (=1) closed seas and lakes (ORCA)
- nn_msh = 0 ! create (=1) a mesh file or not (=0)
+ nn_msh = 1 ! create (=1) a mesh file or not (=0)
rn_hmin = -3. ! min depth of the ocean (>0) or min number of ocean level (<0)
rn_e3zps_min= 20. ! partial step thickness is set larger than the minimum of
@@ -162,9 +169,9 @@
nn_baro = 30 ! Number of iterations of barotropic mode
! during rn_rdt seconds. Only used if ln_bt_nn_auto=F
- rn_bt_cmax = 0.8 ! Maximum courant number allowed if ln_bt_nn_auto=T
+ rn_bt_cmax = 0.8 ! Maximum courant number allowed if ln_bt_nn_auto=T
nn_bt_flt = 1 ! Time filter choice
! = 0 None
! = 1 Boxcar over nn_baro barotropic steps
- ! = 2 Boxcar over 2*nn_baro " "
+ ! = 2 Boxcar over 2*nn_baro " "
/
!-----------------------------------------------------------------------
@@ -213,5 +220,5 @@
!! namsbc_core CORE bulk formulae formulation
!! namsbc_mfs MFS bulk formulae formulation
-!! namsbc_cpl CouPLed formulation ("key_coupled")
+!! namsbc_cpl CouPLed formulation ("key_oasis3")
!! namsbc_sas StAndalone Surface module
!! namtra_qsr penetrative solar radiation
@@ -233,4 +240,10 @@
ln_blk_core = .true. ! CORE bulk formulation (T => fill namsbc_core)
ln_blk_mfs = .false. ! MFS bulk formulation (T => fill namsbc_mfs )
+ ln_cpl = .false. ! atmosphere coupled formulation ( requires key_oasis3 )
+ ln_mixcpl = .false. ! forced-coupled mixed formulation ( requires key_oasis3 )
+ nn_components = 0 ! configuration of the opa-sas OASIS coupling
+ ! =0 no opa-sas OASIS coupling: default single executable configuration
+ ! =1 opa-sas OASIS coupling: multi executable configuration, OPA component
+ ! =2 opa-sas OASIS coupling: multi executable configuration, SAS component
ln_apr_dyn = .false. ! Patm gradient added in ocean & ice Eqs. (T => fill namsbc_apr )
nn_ice = 2 ! =0 no ice boundary condition ,
@@ -243,6 +256,6 @@
ln_rnf = .true. ! runoffs (T => fill namsbc_rnf)
nn_isf = 0 ! ice shelf melting/freezing (/=0 => fill namsbc_isf)
- ! 0 =no isf 1 = presence of ISF
- ! 2 = bg03 parametrisation 3 = rnf file for isf
+ ! 0 =no isf 1 = presence of ISF
+ ! 2 = bg03 parametrisation 3 = rnf file for isf
! 4 = ISF fwf specified
! option 1 and 4 need ln_isfcav = .true. (domzgr)
@@ -275,5 +288,5 @@
&namsbc_flx ! surface boundary condition : flux formulation
!-----------------------------------------------------------------------
-! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask !
+! ! 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_utau = 'utau' , 24 , 'utau' , .false. , .false., 'yearly' , '' , '' , ''
@@ -318,8 +331,8 @@
ln_taudif = .false. ! HF tau contribution: use "mean of stress module - module of the mean stress" data
rn_zqt = 10. ! Air temperature and humidity reference height (m)
- rn_zu = 10. ! Wind vector reference height (m)
+ rn_zu = 10. ! Wind vector reference height (m)
rn_pfac = 1. ! multiplicative factor for precipitation (total & snow)
rn_efac = 1. ! multiplicative factor for evaporation (0. or 1.)
- rn_vfac = 0. ! multiplicative factor for ocean/ice velocity
+ rn_vfac = 0. ! multiplicative factor for ocean/ice velocity
! in the calculation of the wind stress (0.=absolute winds or 1.=relative winds)
/
@@ -340,5 +353,5 @@
/
!-----------------------------------------------------------------------
-&namsbc_cpl ! coupled ocean/atmosphere model ("key_coupled")
+&namsbc_cpl ! coupled ocean/atmosphere model ("key_oasis3")
!-----------------------------------------------------------------------
! ! description ! multiple ! vector ! vector ! vector !
@@ -371,11 +384,14 @@
! ! 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_usp = 'sas_grid_U' , 120 , 'vozocrtx' , .true. , .true. , 'yearly' , '' , '' , ''
+ sn_usp = 'sas_grid_U' , 120 , 'vozocrtx' , .true. , .true. , 'yearly' , '' , '' , ''
sn_vsp = 'sas_grid_V' , 120 , 'vomecrty' , .true. , .true. , 'yearly' , '' , '' , ''
sn_tem = 'sas_grid_T' , 120 , 'sosstsst' , .true. , .true. , 'yearly' , '' , '' , ''
sn_sal = 'sas_grid_T' , 120 , 'sosaline' , .true. , .true. , 'yearly' , '' , '' , ''
sn_ssh = 'sas_grid_T' , 120 , 'sossheig' , .true. , .true. , 'yearly' , '' , '' , ''
-
- ln_3d_uv = .true. ! specify whether we are supplying a 3D u,v field
+ sn_e3t = 'sas_grid_T' , 120 , 'e3t_m' , .true. , .true. , 'yearly' , '' , '' , ''
+ sn_frq = 'sas_grid_T' , 120 , 'frq_m' , .true. , .true. , 'yearly' , '' , '' , ''
+
+ ln_3d_uve = .true. ! specify whether we are supplying a 3D u,v and e3 field
+ ln_read_frq = .false. ! specify whether we must read frq or not
cn_dir = './' ! root directory for the location of the bulk files are
/
@@ -410,5 +426,4 @@
cn_dir = './' ! root directory for the location of the runoff files
- ln_rnf_emp = .false. ! runoffs included into precipitation field (T) or into a file (F)
ln_rnf_mouth = .true. ! specific treatment at rivers mouths
rn_hrnf = 15.e0 ! depth over which enhanced vertical mixing is used
@@ -418,7 +433,11 @@
ln_rnf_tem = .false. ! read in temperature information for runoff
ln_rnf_sal = .false. ! read in salinity information for runoff
-/
-!-----------------------------------------------------------------------
-&namsbc_isf ! Top boundary layer (ISF)
+ ln_rnf_depth_ini = .false. ! compute depth at initialisation from runoff file
+ rn_rnf_max = 5.735e-4 ! max value of the runoff climatologie over global domain ( ln_rnf_depth_ini = .true )
+ rn_dep_max = 150. ! depth over which runoffs is spread ( ln_rnf_depth_ini = .true )
+ nn_rnf_depth_file = 0 ! create (=1) a runoff depth file or not (=0)
+/
+!-----------------------------------------------------------------------
+&namsbc_isf ! Top boundary layer (ISF)
!-----------------------------------------------------------------------
! ! file name ! frequency (hours) ! variable ! time interpol. ! clim ! 'yearly'/ ! weights ! rotation !
@@ -457,5 +476,5 @@
cn_dir = './' ! root directory for the location of the bulk files
- rn_pref = 101000._wp ! reference atmospheric pressure [N/m2]/
+ rn_pref = 101000. ! reference atmospheric pressure [N/m2]/
ln_ref_apr = .false. ! ref. pressure: global mean Patm (T) or a constant (F)
ln_apr_obc = .false. ! inverse barometer added to OBC ssh data
@@ -497,8 +516,8 @@
! Initial mass required for an iceberg of each class
rn_initial_mass = 8.8e7, 4.1e8, 3.3e9, 1.8e10, 3.8e10, 7.5e10, 1.2e11, 2.2e11, 3.9e11, 7.4e11
- ! Proportion of calving mass to apportion to each class
+ ! Proportion of calving mass to apportion to each class
rn_distribution = 0.24, 0.12, 0.15, 0.18, 0.12, 0.07, 0.03, 0.03, 0.03, 0.02
! Ratio between effective and real iceberg mass (non-dim)
- ! i.e. number of icebergs represented at a point
+ ! i.e. number of icebergs represented at a point
rn_mass_scaling = 2000, 200, 50, 20, 10, 5, 2, 1, 1, 1
! thickness of newly calved bergs (m)
@@ -509,15 +528,15 @@
rn_bits_erosion_fraction = 0. ! Fraction of erosion melt flux to divert to bergy bits
rn_sicn_shift = 0. ! Shift of sea-ice concn in erosion flux (0 surface CT converted in Pot. Temp. in sbcssm
@@ -791,14 +807,8 @@
!-----------------------------------------------------------------------
ln_tradmp = .true. ! add a damping termn (T) or not (F)
- nn_hdmp = -1 ! horizontal shape =-1, damping in Med and Red Seas only
- ! =XX, damping poleward of XX degrees (XX>0)
- ! + F(distance-to-coast) + Red and Med Seas
nn_zdmp = 0 ! vertical shape =0 damping throughout the water column
! =1 no damping in the mixing layer (kz criteria)
! =2 no damping in the mixed layer (rho crieria)
- rn_surf = 50. ! surface time scale of damping [days]
- rn_bot = 360. ! bottom time scale of damping [days]
- rn_dep = 800. ! depth of transition between rn_surf and rn_bot [meters]
- nn_file = 0 ! create a damping.coeff NetCDF file (=1) or not (=0)
+ cn_resto = 'resto.nc' ! Name of file containing restoration coefficient field (use dmp_tools to create this)
/
@@ -817,4 +827,5 @@
!-----------------------------------------------------------------------
ln_dynadv_vec = .true. ! vector form (T) or flux form (F)
+ nn_dynkeg = 0 ! scheme for grad(KE): =0 C2 ; =1 Hollingsworth correction
ln_dynadv_cen2= .false. ! flux form - 2nd order centered scheme
ln_dynadv_ubs = .false. ! flux form - 3rd order UBS scheme
@@ -824,5 +835,5 @@
&nam_vvl ! vertical coordinate options
!-----------------------------------------------------------------------
- ln_vvl_zstar = .true. ! zstar vertical coordinate
+ ln_vvl_zstar = .true. ! zstar vertical coordinate
ln_vvl_ztilde = .false. ! ztilde vertical coordinate: only high frequency variations
ln_vvl_layer = .false. ! full layer vertical coordinate
@@ -842,4 +853,5 @@
ln_dynvor_mix = .false. ! mixed scheme
ln_dynvor_een = .true. ! energy & enstrophy scheme
+ ln_dynvor_een_old = .false. ! energy & enstrophy scheme - original formulation
/
!-----------------------------------------------------------------------
@@ -849,4 +861,5 @@
ln_hpg_zps = .true. ! z-coordinate - partial steps (interpolation)
ln_hpg_sco = .false. ! s-coordinate (standard jacobian formulation)
+ ln_hpg_isf = .false. ! s-coordinate (sco ) adapted to isf
ln_hpg_djc = .false. ! s-coordinate (Density Jacobian with Cubic polynomial)
ln_hpg_prj = .false. ! s-coordinate (Pressure Jacobian scheme)
@@ -944,5 +957,5 @@
! = 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 ("key_coupled")
+ ! = 3 as = 1 applied on HF part of the stress ("key_oasis3")
rn_efr = 0.05 ! fraction of surface tke value which penetrates below the ML (nn_etau=1 or 2)
nn_htau = 1 ! type of exponential decrease of tke penetration below the ML
@@ -966,18 +979,18 @@
&namzdf_gls ! GLS vertical diffusion ("key_zdfgls")
!-----------------------------------------------------------------------
- rn_emin = 1.e-6 ! minimum value of e [m2/s2]
+ rn_emin = 1.e-7 ! minimum value of e [m2/s2]
rn_epsmin = 1.e-12 ! minimum value of eps [m2/s3]
ln_length_lim = .true. ! limit on the dissipation rate under stable stratification (Galperin et al., 1988)
- rn_clim_galp = 0.53 ! galperin limit
- ln_crban = .true. ! Use Craig & Banner (1994) surface wave mixing parametrisation
+ rn_clim_galp = 0.267 ! galperin limit
ln_sigpsi = .true. ! Activate or not Burchard 2001 mods on psi schmidt number in the wb case
rn_crban = 100. ! Craig and Banner 1994 constant for wb tke flux
rn_charn = 70000. ! Charnock constant for wb induced roughness length
- nn_tkebc_surf = 1 ! surface tke condition (0/1/2=Dir/Neum/Dir Mellor-Blumberg)
- nn_tkebc_bot = 1 ! bottom tke condition (0/1=Dir/Neum)
- nn_psibc_surf = 1 ! surface psi condition (0/1/2=Dir/Neum/Dir Mellor-Blumberg)
- nn_psibc_bot = 1 ! bottom psi condition (0/1=Dir/Neum)
- nn_stab_func = 2 ! stability function (0=Galp, 1= KC94, 2=CanutoA, 3=CanutoB)
- nn_clos = 1 ! predefined closure type (0=MY82, 1=k-eps, 2=k-w, 3=Gen)
+ rn_hsro = 0.02 ! Minimum surface roughness
+ rn_frac_hs = 1.3 ! Fraction of wave height as roughness (if nn_z0_met=2)
+ nn_z0_met = 2 ! Method for surface roughness computation (0/1/2)
+ nn_bc_surf = 1 ! surface condition (0/1=Dir/Neum)
+ nn_bc_bot = 1 ! bottom condition (0/1=Dir/Neum)
+ nn_stab_func = 2 ! stability function (0=Galp, 1= KC94, 2=CanutoA, 3=CanutoB)
+ nn_clos = 1 ! predefined closure type (0=MY82, 1=k-eps, 2=k-w, 3=Gen)
/
!-----------------------------------------------------------------------
@@ -1007,4 +1020,5 @@
!! namc1d_uvd data: U & V currents ("key_c1d")
!! namc1d_dyndmp U & V newtonian damping ("key_c1d")
+!! namsto Stochastic parametrization of EOS
!!======================================================================
!
@@ -1065,4 +1079,21 @@
ln_dyndmp = .false. ! add a damping term (T) or not (F)
/
+!-----------------------------------------------------------------------
+&namsto ! Stochastic parametrization of EOS
+!-----------------------------------------------------------------------
+ ln_rststo = .false. ! start from mean parameter (F) or from restart file (T)
+ ln_rstseed = .true. ! read seed of RNG from restart file
+ cn_storst_in = "restart_sto" ! suffix of stochastic parameter restart file (input)
+ cn_storst_out = "restart_sto" ! suffix of stochastic parameter restart file (output)
+
+ ln_sto_eos = .false. ! stochastic equation of state
+ nn_sto_eos = 1 ! number of independent random walks
+ rn_eos_stdxy = 1.4 ! random walk horz. standard deviation (in grid points)
+ rn_eos_stdz = 0.7 ! random walk vert. standard deviation (in grid points)
+ rn_eos_tcor = 1440.0 ! random walk time correlation (in timesteps)
+ nn_eos_ord = 1 ! order of autoregressive processes
+ nn_eos_flt = 0 ! passes of Laplacian filter
+ rn_eos_lim = 2.0 ! limitation factor (default = 3.0)
+/
!!======================================================================
@@ -1071,6 +1102,6 @@
!! namnc4 netcdf4 chunking and compression settings ("key_netcdf4")
!! namtrd dynamics and/or tracer trends
+!! namptr Poleward Transport Diagnostics
!! namflo float parameters ("key_float")
-!! namptr Poleward Transport Diagnostics
!! namhsb Heat and salt budgets
!!======================================================================
@@ -1126,10 +1157,5 @@
!-----------------------------------------------------------------------
ln_diaptr = .false. ! Poleward heat and salt transport (T) or not (F)
- ln_diaznl = .true. ! Add zonal means and meridional stream functions
- ln_subbas = .true. ! Atlantic/Pacific/Indian basins computation (T) or not
- ! (orca configuration only, need input basins mask file named "subbasins.nc"
- ln_ptrcomp = .true. ! Add decomposition : overturning
- nn_fptr = 1 ! Frequency of ptr computation [time step]
- nn_fwri = 15 ! Frequency of ptr outputs [time step]
+ ln_subbas = .false. ! Atlantic/Pacific/Indian basins computation (T) or not
/
!-----------------------------------------------------------------------
@@ -1181,5 +1207,5 @@
ln_sst = .false. ! Logical switch for SST observations
ln_reysst = .false. ! ln_reysst Logical switch for Reynolds observations
- ln_ghrsst = .false. ! ln_ghrsst Logical switch for GHRSST observations
+ ln_ghrsst = .false. ! ln_ghrsst Logical switch for GHRSST observations
ln_sstfb = .false. ! Logical switch for feedback SST data
@@ -1208,5 +1234,5 @@
sstfbfiles = 'sst_01.nc'
! seaicefiles Sea Ice input observation file names
- seaicefiles = 'seaice_01.nc'
+ seaicefiles = 'seaice_01.nc'
! velavcurfiles Vel. cur. daily av. input file name
! velhvcurfiles Vel. cur. high freq. input file name
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/SHARED/namelist_top_ref
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/SHARED/namelist_top_ref (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/SHARED/namelist_top_ref (revision 5602)
@@ -21,5 +21,7 @@
! = 2 calendar parameters read in the restart file
cn_trcrst_in = "restart_trc" ! suffix of pass. sn_tracer restart name (input)
+ cn_trcrst_indir = "." ! directory from which to read input passive tracer restarts
cn_trcrst_out = "restart_trc" ! suffix of pass. sn_tracer restart name (output)
+ cn_trcrst_outdir = "." ! directory to which to write output passive tracer restarts
/
!-----------------------------------------------------------------------
@@ -50,5 +52,4 @@
&namtrc_ldf ! lateral diffusion scheme for passive tracer
!-----------------------------------------------------------------------
- ln_trcldf_diff = .true. ! performs lateral diffusion (T) or not (F)
! ! Type of the operator :
ln_trcldf_lap = .true. ! laplacian operator
@@ -76,14 +77,16 @@
&namtrc_dmp ! passive tracer newtonian damping
!-----------------------------------------------------------------------
- nn_hdmp_tr = -1 ! horizontal shape =-1, damping in Med and Red Seas only
- ! =XX, damping poleward of XX degrees (XX>0)
- ! + F(distance-to-coast) + Red and Med Seas
nn_zdmp_tr = 1 ! vertical shape =0 damping throughout the water column
! =1 no damping in the mixing layer (kz criteria)
! =2 no damping in the mixed layer (rho crieria)
- rn_surf_tr = 50. ! surface time scale of damping [days]
- rn_bot_tr = 360. ! bottom time scale of damping [days]
- rn_dep_tr = 800. ! depth of transition between rn_surf and rn_bot [meters]
- nn_file_tr = 0 ! create a damping.coeff NetCDF file (=1) or not (=0)
+ cn_resto_tr = 'resto_tr.nc' ! create a damping.coeff NetCDF file (=1) or not (=0)
+/
+!-----------------------------------------------------------------------
+&namtrc_ice ! Representation of sea ice growth & melt effects
+!-----------------------------------------------------------------------
+ nn_ice_tr = -1 ! tracer concentration in sea ice
+ ! =-1 (no vvl: identical cc in ice and ocean / vvl: cc_ice = 0)
+ ! = 0 (no vvl: cc_ice = zero / vvl: cc_ice = )
+ ! = 1 prescribed to a namelist value (implemented in pisces only)
/
!-----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/cfg.txt
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/cfg.txt (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/cfg.txt (revision 5602)
@@ -7,7 +7,6 @@
AMM12 OPA_SRC
ORCA2_LIM_PISCES OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC
-ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC
-ISOMIP OPA_SRC
GYRE OPA_SRC
ORCA2_LIM3 OPA_SRC LIM_SRC_3 NST_SRC
ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC
+ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/makenemo
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/makenemo (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/makenemo (revision 5602)
@@ -200,11 +200,11 @@
;;
add_key)
- list_add_key=$2
- export ${list_add_key}
+ # Checking if argument has anything other than whitespace
+ [[ ! "$2" =~ ^\ +$ ]] && { list_add_key=$2; export ${list_add_key}; }
shift
;;
del_key)
- list_del_key=$2
- export ${list_del_key}
+ # Checking if argument has anything other than whitespace
+ [[ ! "$2" =~ ^\ +$ ]] && { list_del_key=$2; export ${list_del_key}; }
shift
;;
@@ -316,13 +316,7 @@
fi
-#- At this stage new configuration has been added,
-#- We add or remove keys
-if [ ${#list_add_key} -ne 0 ] ; then
- . ${COMPIL_DIR}/Fadd_keys.sh ${NEW_CONF} add_key ${list_add_key}
-fi
-
-if [ ${#list_del_key} -ne 0 ] ; then
- . ${COMPIL_DIR}/Fdel_keys.sh ${NEW_CONF} del_key ${list_del_key}
-fi
+#- At this stage new configuration has been added, we add or remove keys
+[ ! -z "${list_add_key}" ] && { . ${COMPIL_DIR}/Fadd_keys.sh ${NEW_CONF} add_key ${list_add_key}; }
+[ ! -z "${list_del_key}" ] && { . ${COMPIL_DIR}/Fdel_keys.sh ${NEW_CONF} del_key ${list_del_key}; }
#- check that all keys are really existing...
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/uspcfg.txt
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/uspcfg.txt (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/CONFIG/uspcfg.txt (revision 5602)
@@ -1,1 +1,2 @@
ORCA1_CICE # ORCA2_LIM # OPA_SRC TOP_SRC # http://gws-access.ceda.ac.uk/public/nemo/uspconfigs/ORCA1_CICE/v3.6.0/ORCA1_CICE_ctl.txt
+ISOMIP # GYRE # OPA_SRC # http://gws-access.ceda.ac.uk/public/nemo/uspconfigs/ISOMIP/v3.6.0/ISOMIP_ctl.txt
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90 (revision 5602)
@@ -24,5 +24,7 @@
! !!* namicerun read in iceini *
CHARACTER(len=32) , PUBLIC :: cn_icerst_in !: suffix of ice restart name (input)
+ CHARACTER(len=256) , PUBLIC :: cn_icerst_indir !: ice restart in directory
CHARACTER(len=32) , PUBLIC :: cn_icerst_out !: suffix of ice restart name (output)
+ CHARACTER(len=256) , PUBLIC :: cn_icerst_outdir !: ice restart out directory
LOGICAL , PUBLIC :: ln_limdyn !: flag for ice dynamics (T) or not (F)
LOGICAL , PUBLIC :: ln_limdmp !: Ice damping
@@ -35,5 +37,5 @@
INTEGER , PUBLIC :: nbiter !: number of sub-time steps for relaxation
INTEGER , PUBLIC :: nbitdr !: maximum number of iterations for relaxation
- INTEGER , PUBLIC :: nevp !: number of EVP subcycling iterations
+ INTEGER , PUBLIC :: nn_nevp !: number of EVP subcycling iterations
INTEGER , PUBLIC :: telast !: timescale for EVP elastic waves
REAL(wp), PUBLIC :: epsd !: tolerance parameter for dynamic
@@ -47,15 +49,17 @@
REAL(wp), PUBLIC :: c_rhg !: second bulk-rhelogy parameter
REAL(wp), PUBLIC :: etamn !: minimun value for viscosity
- REAL(wp), PUBLIC :: creepl !: creep limit
- REAL(wp), PUBLIC :: ecc !: eccentricity of the elliptical yield curve
+ REAL(wp), PUBLIC :: rn_creepl !: creep limit
+ REAL(wp), PUBLIC :: rn_ecc !: eccentricity of the elliptical yield curve
REAL(wp), PUBLIC :: ahi0 !: sea-ice hor. eddy diffusivity coeff. (m2/s)
REAL(wp), PUBLIC :: alphaevp !: coefficient for the solution of EVP int. stresses
- REAL(wp), PUBLIC :: hminrhg = 0.001_wp !: clem : ice volume (a*h in m) below which ice velocity is set to ocean velocity
-
- REAL(wp), PUBLIC :: usecc2 !: = 1.0 / ( ecc * ecc )
+
+ REAL(wp), PUBLIC :: usecc2 !: = 1.0 / ( rn_ecc * rn_ecc )
REAL(wp), PUBLIC :: rhoco !: = rau0 * cw
REAL(wp), PUBLIC :: sangvg, cangvg !: sin and cos of the turning angle for ocean stress
REAL(wp), PUBLIC :: pstarh !: pstar / 2.0
+ ! !!** switch for presence of ice or not
+ REAL(wp), PUBLIC :: rswitch
+
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahiu , ahiv !: hor. diffusivity coeff. at ocean U- and V-points (m2/s)
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: pahu , pahv !: ice hor. eddy diffusivity coef. at ocean U- and V-points
@@ -63,7 +67,4 @@
!!* Ice Rheology
-
- LOGICAL , PUBLIC:: ltrcdm2dc_ice = .FALSE. !: In case of Diurnal Cycle short wave, compute a Daily Mean short waves flux
-
# if defined key_lim2_vp
! !!* VP rheology *
@@ -111,5 +112,5 @@
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qdtcn !: energy from the ice to the ocean point (at a factor 2)
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: thcm !: part of the solar energy used in the lead heat budget
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fstric_daymean!: Solar flux transmitted trough the ice, for day mean of qsr ( PISCES, with dirunal cycle )
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fstric_mean !: Solar flux transmitted trough the ice, for day mean of qsr ( PISCES, with dirunal cycle )
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fstric !: Solar flux transmitted trough the ice
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ffltbif !: linked with the max heat contained in brine pockets (?)
@@ -171,6 +172,4 @@
& tbif (jpi,jpj,jplayersp1) , STAT=ierr(5))
- IF( ltrcdm2dc_ice ) ALLOCATE(fstric_daymean(jpi,jpj), STAT=ierr(6) )
-
!* moment used in the advection scheme
ALLOCATE(sxice (jpi,jpj) , syice (jpi,jpj) , sxxice(jpi,jpj) , &
@@ -199,5 +198,4 @@
!! Default option Empty module NO LIM 2.0 sea-ice model
!!----------------------------------------------------------------------
- LOGICAL , PUBLIC:: ltrcdm2dc_ice = .FALSE. !: In case of Diurnal Cycle short wave, compute a Daily Mean short waves flux
#endif
!!-----------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90 (revision 5602)
@@ -40,5 +40,5 @@
!!----------------------------------------------------------------------
!! NEMO/LIM2 4.0 , UCL - NEMO Consortium (2011)
- !! $Id$
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
@@ -60,9 +60,4 @@
ENDIF
!
- ! When Diurnal cycle, core bulk and LIM2 are activated,
- ! a daily mean qsr is computed for tracer/biogeochemistery model !
- IF( ltrcdm2dc )THEN ; ltrcdm2dc_ice = .TRUE.
- ELSE ; ltrcdm2dc_ice = .FALSE.
- ENDIF
! ! Allocate the ice arrays
ierr = ice_alloc_2 () ! ice variables
@@ -123,5 +118,6 @@
!! ** input : Namelist namicerun
!!-------------------------------------------------------------------
- NAMELIST/namicerun/ cn_icerst_in, cn_icerst_out, ln_limdyn, ln_limdmp, acrit, hsndif, hicdif
+ NAMELIST/namicerun/ cn_icerst_in, cn_icerst_indir, cn_icerst_out, cn_icerst_outdir, &
+ ln_limdyn, ln_limdmp, acrit, hsndif, hicdif
INTEGER :: ios ! Local integer output status for namelist read
!!-------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90 (revision 5602)
@@ -227,6 +227,6 @@
NAMELIST/namicedyn/ epsd, alpha, &
& dm, nbiter, nbitdr, om, resl, cw, angvg, pstar, &
- & c_rhg, etamn, creepl, ecc, ahi0, &
- & nevp, telast, alphaevp, hminrhg
+ & c_rhg, etamn, rn_creepl, rn_ecc, ahi0, &
+ & nn_nevp, telast, alphaevp
!!-------------------------------------------------------------------
@@ -256,11 +256,10 @@
WRITE(numout,*) ' second bulk-rhelogy parameter c_rhg = ', c_rhg
WRITE(numout,*) ' minimun value for viscosity etamn = ', etamn
- WRITE(numout,*) ' creep limit creepl = ', creepl
- WRITE(numout,*) ' eccentricity of the elliptical yield curve ecc = ', ecc
+ WRITE(numout,*) ' creep limit rn_creepl = ', rn_creepl
+ WRITE(numout,*) ' eccentricity of the elliptical yield curve rn_ecc = ', rn_ecc
WRITE(numout,*) ' horizontal diffusivity coeff. for sea-ice ahi0 = ', ahi0
- WRITE(numout,*) ' number of iterations for subcycling nevp = ', nevp
+ WRITE(numout,*) ' number of iterations for subcycling nn_nevp= ', nn_nevp
WRITE(numout,*) ' timescale for elastic waves telast = ', telast
WRITE(numout,*) ' coefficient for the solution of int. stresses alphaevp = ', alphaevp
- WRITE(numout,*) ' min ice thickness for rheology calculations hminrhg = ', hminrhg
ENDIF
!
@@ -272,5 +271,5 @@
! Initialization
- usecc2 = 1.0 / ( ecc * ecc )
+ usecc2 = 1.0 / ( rn_ecc * rn_ecc )
rhoco = rau0 * cw
angvg = angvg * rad ! convert angvg from degree to radian
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90 (revision 5602)
@@ -266,5 +266,5 @@
! Creep limit depends on the size of the grid.
- zdelta = MAX( SQRT( ztrace2 + ( ztrace2 - 4._wp * zdeter ) * usecc2 ), creepl)
+ zdelta = MAX( SQRT( ztrace2 + ( ztrace2 - 4._wp * zdeter ) * usecc2 ), rn_creepl)
!- Computation of viscosities.
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_2/limrst_2.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_2/limrst_2.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_2/limrst_2.F90 (revision 5602)
@@ -50,4 +50,5 @@
CHARACTER(LEN=20) :: clkt ! ocean time-step deine as a character
CHARACTER(LEN=50) :: clname ! ice output restart file name
+ CHARACTER(len=150) :: clpath ! full path to ice output restart file
!!----------------------------------------------------------------------
!
@@ -58,24 +59,30 @@
! except if we write ice restart files every ice time step or if an ice restart file was writen at nitend - 2*nn_fsbc + 1
IF( kt == nitrst - 2*nn_fsbc + 1 .OR. nstock == nn_fsbc .OR. ( kt == nitend - nn_fsbc + 1 .AND. .NOT. lrst_ice ) ) THEN
- ! beware of the format used to write kt (default is i8.8, that should be large enough...)
- IF( nitrst > 99999999 ) THEN ; WRITE(clkt, * ) nitrst
- ELSE ; WRITE(clkt, '(i8.8)') nitrst
+ IF( nitrst <= nitend .AND. nitrst > 0 ) THEN
+ ! beware of the format used to write kt (default is i8.8, that should be large enough...)
+ IF( nitrst > 99999999 ) THEN ; WRITE(clkt, * ) nitrst
+ ELSE ; WRITE(clkt, '(i8.8)') nitrst
+ ENDIF
+ ! create the file
+ clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out)
+ clpath = TRIM(cn_icerst_outdir)
+ IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath)//'/'
+ IF(lwp) THEN
+ WRITE(numout,*)
+ SELECT CASE ( jprstlib )
+ CASE ( jprstdimg )
+ WRITE(numout,*) ' open ice restart binary file: ',TRIM(clpath)//clname
+ CASE DEFAULT
+ WRITE(numout,*) ' open ice restart NetCDF file: ',TRIM(clpath)//clname
+ END SELECT
+ IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN
+ WRITE(numout,*) ' kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp
+ ELSE ; WRITE(numout,*) ' kt = ' , kt,' date= ', ndastp
+ ENDIF
+ ENDIF
+
+ CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kiolib = jprstlib )
+ lrst_ice = .TRUE.
ENDIF
- ! create the file
- clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out)
- IF(lwp) THEN
- WRITE(numout,*)
- SELECT CASE ( jprstlib )
- CASE ( jprstdimg ) ; WRITE(numout,*) ' open ice restart binary file: '//clname
- CASE DEFAULT ; WRITE(numout,*) ' open ice restart NetCDF file: '//clname
- END SELECT
- IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN
- WRITE(numout,*) ' kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp
- ELSE ; WRITE(numout,*) ' kt = ' , kt,' date= ', ndastp
- ENDIF
- ENDIF
-
- CALL iom_open( clname, numriw, ldwrt = .TRUE., kiolib = jprstlib )
- lrst_ice = .TRUE.
ENDIF
!
@@ -188,9 +195,9 @@
! eventually read netcdf file (monobloc) for restarting on different number of processors
! if {cn_icerst_in}.nc exists, then set jlibalt to jpnf90
- INQUIRE( FILE = TRIM(cn_icerst_in)//'.nc', EXIST = llok )
+ INQUIRE( FILE = TRIM(cn_icerst_indir)//'/'//TRIM(cn_icerst_in)//'.nc', EXIST = llok )
IF ( llok ) THEN ; jlibalt = jpnf90 ; ELSE ; jlibalt = jprstlib ; ENDIF
ENDIF
- CALL iom_open ( cn_icerst_in, numrir, kiolib = jlibalt )
+ CALL iom_open ( TRIM(cn_icerst_indir)//'/'//TRIM(cn_icerst_in), numrir, kiolib = jlibalt )
CALL iom_get( numrir, 'kt_ice' , ziter )
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90 (revision 5602)
@@ -46,5 +46,4 @@
PUBLIC lim_sbc_flx_2 ! called by sbc_ice_lim_2
PUBLIC lim_sbc_tau_2 ! called by sbc_ice_lim_2
- PUBLIC lim_bio_meanqsr_2 ! called by sbc_ice_lim_2
REAL(wp) :: r1_rdtice ! = 1. / rdt_ice
@@ -97,5 +96,5 @@
!! - fr_i : ice fraction
!! - tn_ice : sea-ice surface temperature
- !! - alb_ice : sea-ice albedo (lk_cpl=T)
+ !! - alb_ice : sea-ice albedo (ln_cpl=T)
!!
!! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90.
@@ -179,5 +178,5 @@
! computation the solar flux at ocean surface
- IF( lk_cpl ) THEN
+ IF( ln_cpl ) THEN
zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) )
ELSE
@@ -203,5 +202,5 @@
! mass flux at the ocean-atmosphere interface (open ocean fraction = leads area)
! ! coupled mode:
- IF( lk_cpl ) THEN
+ IF( ln_cpl ) THEN
zemp = + emp_tot(ji,jj) & ! net mass flux over the grid cell (ice+ocean area)
& - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) ) ! minus the mass flux intercepted by sea-ice
@@ -253,5 +252,5 @@
!-----------------------------------------------!
- IF( lk_cpl) THEN
+ IF( ln_cpl) THEN
tn_ice(:,:,1) = sist(:,:) ! sea-ice surface temperature
ht_i(:,:,1) = hicif(:,:)
@@ -430,18 +429,4 @@
END SUBROUTINE lim_sbc_tau_2
- SUBROUTINE lim_bio_meanqsr_2
- !!---------------------------------------------------------------------
- !! *** ROUTINE lim_bio_meanqsr
- !!
- !! ** Purpose : provide daily qsr_mean for PISCES when
- !! analytic diurnal cycle is applied in physic
- !!
- !! ** Method : add part under ice
- !!
- !!---------------------------------------------------------------------
-
- qsr_mean(:,:) = pfrld(:,:) * qsr_mean(:,:) + ( 1. - pfrld(:,:) ) * fstric_daymean(:,:)
-
- END SUBROUTINE lim_bio_meanqsr_2
SUBROUTINE lim_sbc_init_2
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90 (revision 5602)
@@ -114,5 +114,5 @@
CALL wrk_alloc( jpi, jpj, jpk, zmsk )
- IF( kt == nit000 ) CALL lim_thd_init_2 ! Initialization (first time-step only)
+ IF( kt == nit000 ) CALL lim_thd_init_2 ! Initialization (first time-step only)
!-------------------------------------------!
@@ -137,5 +137,4 @@
rdq_ice(:,:) = 0.e0 ! heat content associated with rdm_ice
zmsk (:,:,:) = 0.e0
- IF( ltrcdm2dc_ice ) fstric_daymean (:,:) = 0.e0 ! part of solar radiation absorbing inside the ice
! set to zero snow thickness smaller than epsi04
@@ -217,5 +216,5 @@
! partial computation of the lead energy budget (qldif)
- IF( lk_cpl ) THEN
+ IF( ln_cpl ) THEN
qldif(ji,jj) = tms(ji,jj) * rdt_ice &
& * ( ( qsr_tot(ji,jj) - qsr_ice(ji,jj,1) * zfricp ) * ( 1.0 - thcm(ji,jj) ) &
@@ -285,11 +284,9 @@
CALL tab_2d_1d_2( nbpb, tbif_1d (1:nbpb , 3 ), tbif(:,:,3) , jpi, jpj, npb(1:nbpb) )
CALL tab_2d_1d_2( nbpb, qsr_ice_1d (1:nbpb) , qsr_ice(:,:,1) , jpi, jpj, npb(1:nbpb) )
- IF( ltrcdm2dc_ice ) &
- & CALL tab_2d_1d_2( nbpb, qsr_ice_mean_1d (1:nbpb), qsr_ice_mean(:,:,1), jpi, jpj, npb(1:nbpb) )
CALL tab_2d_1d_2( nbpb, fr1_i0_1d (1:nbpb) , fr1_i0 , jpi, jpj, npb(1:nbpb) )
CALL tab_2d_1d_2( nbpb, fr2_i0_1d (1:nbpb) , fr2_i0 , jpi, jpj, npb(1:nbpb) )
CALL tab_2d_1d_2( nbpb, qns_ice_1d(1:nbpb) , qns_ice(:,:,1), jpi, jpj, npb(1:nbpb) )
CALL tab_2d_1d_2( nbpb, dqns_ice_1d(1:nbpb) , dqns_ice(:,:,1), jpi, jpj, npb(1:nbpb) )
- IF( .NOT. lk_cpl ) THEN
+ IF( .NOT. ln_cpl ) THEN
CALL tab_2d_1d_2( nbpb, qla_ice_1d (1:nbpb) , qla_ice(:,:,1), jpi, jpj, npb(1:nbpb) )
CALL tab_2d_1d_2( nbpb, dqla_ice_1d(1:nbpb) , dqla_ice(:,:,1), jpi, jpj, npb(1:nbpb) )
@@ -336,9 +333,5 @@
CALL tab_1d_2d_2( nbpb, qsr_ice(:,:,1), npb, qsr_ice_1d(1:nbpb) , jpi, jpj )
CALL tab_1d_2d_2( nbpb, qns_ice(:,:,1), npb, qns_ice_1d(1:nbpb) , jpi, jpj )
- IF( ltrcdm2dc_ice )THEN
- CALL tab_1d_2d_2( nbpb, fstric_daymean , npb, fstbif_daymean_1d (1:nbpb) , jpi, jpj )
- CALL tab_1d_2d_2( nbpb, qsr_ice_mean(:,:,1), npb, qsr_ice_mean_1d(1:nbpb) , jpi, jpj )
- ENDIF
- IF( .NOT. lk_cpl ) CALL tab_1d_2d_2( nbpb, qla_ice(:,:,1), npb, qla_ice_1d(1:nbpb) , jpi, jpj )
+ IF( .NOT. ln_cpl ) CALL tab_1d_2d_2( nbpb, qla_ice(:,:,1), npb, qla_ice_1d(1:nbpb), jpi, jpj )
!
ENDIF
@@ -441,5 +434,5 @@
IF( iom_use('qsr_ai_cea' ) ) CALL iom_put( 'qsr_ai_cea', qsr_ice(:,:,1) * ztmp(:,:) ) ! Solar flux over the ice [W/m2]
IF( iom_use('qns_ai_cea' ) ) CALL iom_put( 'qns_ai_cea', qns_ice(:,:,1) * ztmp(:,:) ) ! Non-solar flux over the ice [W/m2]
- IF( iom_use('qla_ai_cea' ) .AND. .NOT. lk_cpl ) &
+ IF( iom_use('qla_ai_cea' ) .AND. .NOT. ln_cpl ) &
& CALL iom_put( 'qla_ai_cea', qla_ice(:,:,1) * ztmp(:,:) ) ! Latent flux over the ice [W/m2]
!
@@ -564,5 +557,5 @@
IF(lwm) WRITE ( numoni, namicethd )
- IF( lk_cpl .AND. parsub /= 0.0 ) CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' )
+ IF( ln_cpl .AND. parsub /= 0.0 ) CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' )
!
IF(lwp) THEN ! control print
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90 (revision 5602)
@@ -18,5 +18,5 @@
USE ice_2
USE limistate_2
- USE sbc_oce, ONLY : lk_cpl
+ USE sbc_oce, ONLY : ln_cpl
USE in_out_manager
USE lib_mpp ! MPP library
@@ -273,16 +273,4 @@
END DO
- IF( ltrcdm2dc_ice )THEN
-
- DO ji = kideb , kiut
- zihsn = MAX( zzero , SIGN (zone , -h_snow_1d(ji) ) )
- zihic = MAX( zzero , 1.0 - ( h_ice_1d(ji) / zhsu ) )
- zi0(ji) = zihsn * ( fr1_i0_1d(ji) + zihic * fr2_i0_1d(ji) )
- zexp = MIN( zone , EXP( -1.5 * ( h_ice_1d(ji) - zhsu ) ) )
- fstbif_daymean_1d(ji) = zi0(ji) * qsr_ice_mean_1d(ji) * zexp
- END DO
-
- ENDIF
-
!--------------------------------------------------------------------------------
! 4. Computation of the surface temperature : determined by considering the
@@ -337,5 +325,5 @@
!----------------------------------------------------------------------
- IF ( .NOT. lk_cpl ) THEN ! duplicate the loop for performances issues
+ IF ( .NOT. ln_cpl ) THEN ! duplicate the loop for performances issues
DO ji = kideb, kiut
sist_1d(ji) = MIN( ztsmlt(ji) , sist_1d(ji) )
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_2/thd_ice_2.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_2/thd_ice_2.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_2/thd_ice_2.F90 (revision 5602)
@@ -55,8 +55,6 @@
fstbif_1d , & !: " " fstric
fltbif_1d , & !: " " ffltbif
- fstbif_daymean_1d, & !: " " fstric_daymean
fscbq_1d , & !: " " fscmcbq
qsr_ice_1d , & !: " " qsr_ice
- qsr_ice_mean_1d , & !: " " qsr_ice_mean
fr1_i0_1d , & !: " " fr1_i0
fr2_i0_1d , & !: " " fr2_i0
@@ -122,6 +120,4 @@
& tbif_1d(jpij, jplayersp1), Stat=ierr(4))
!
- IF( ltrcdm2dc_ice )ALLOCATE(fstbif_daymean_1d(jpij),qsr_ice_mean_1d(jpij),Stat=ierr(5))
- !
thd_ice_alloc_2 = MAXVAL(ierr)
IF( thd_ice_alloc_2 /= 0 ) CALL ctl_warn('thd_ice_alloc_2: failed to allocate arrays')
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/dom_ice.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/dom_ice.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/dom_ice.F90 (revision 5602)
@@ -5,7 +5,6 @@
!!======================================================================
!! History : 3.0 ! 2003-08 (M. Vancoppenolle) LIM-3 original code
- !! 4.0 ! 2011-02 (G. Madec) dynamical allocation
+ !! 3.5 ! 2011-02 (G. Madec) dynamical allocation
!!----------------------------------------------------------------------
- USE par_ice ! LIM-3 parameter
USE in_out_manager ! I/O manager
USE lib_mpp ! MPP library
@@ -21,11 +20,5 @@
INTEGER, PUBLIC :: njeq , njeqm1 !: j-index of the equator if it is inside the domain
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fcor !: coriolis coefficient
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: covrai !: sine of geographic latitude
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: area !: surface of grid cell
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tms, tmi !: temperature mask, mask for stress
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmu, tmv !: mask at u and v velocity points
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmf !: mask at f-point
-
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fcor !: coriolis coefficient
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wght !: weight of the 4 neighbours to compute averages
@@ -44,10 +37,5 @@
!!-------------------------------------------------------------------
!
- ALLOCATE( fcor(jpi,jpj) , &
- & covrai(jpi,jpj) , area(jpi,jpj) , &
- & tms (jpi,jpj) , tmi (jpi,jpj) , &
- & tmu (jpi,jpj) , tmv (jpi,jpj) , &
- & tmf (jpi,jpj) , &
- & wght(jpi,jpj,2,2) , STAT = dom_ice_alloc )
+ ALLOCATE( fcor(jpi,jpj), wght(jpi,jpj,2,2), STAT = dom_ice_alloc )
!
IF( dom_ice_alloc /= 0 ) CALL ctl_warn( 'dom_ice_alloc: failed to allocate arrays.' )
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/ice.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/ice.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/ice.F90 (revision 5602)
@@ -11,5 +11,4 @@
!! 'key_lim3' LIM-3 sea-ice model
!!----------------------------------------------------------------------
- USE par_ice ! LIM sea-ice parameters
USE in_out_manager ! I/O manager
USE lib_mpp ! MPP library
@@ -18,5 +17,5 @@
PRIVATE
- PUBLIC ice_alloc ! Called in iceini.F90
+ PUBLIC ice_alloc ! Called in sbc_lim_init
!!======================================================================
@@ -110,7 +109,7 @@
!! smv_i | - | Sea ice salt content | ppt.m |
!! oa_i ! - ! Sea ice areal age content | day |
- !! e_i ! - ! Ice enthalpy | 10^9 J|
+ !! e_i ! - ! Ice enthalpy | J/m2 |
!! - ! q_i_1d ! Ice enthalpy per unit vol. | J/m3 |
- !! e_s ! - ! Snow enthalpy | 10^9 J|
+ !! e_s ! - ! Snow enthalpy | J/m2 |
!! - ! q_s_1d ! Snow enthalpy per unit vol. | J/m3 |
!! |
@@ -148,6 +147,6 @@
!! tm_i | - | Mean sea ice temperature | K |
!! ot_i ! - ! Sea ice areal age content | day |
- !! et_i ! - ! Total ice enthalpy | 10^9 J|
- !! et_s ! - ! Total snow enthalpy | 10^9 J|
+ !! et_i ! - ! Total ice enthalpy | J/m2 |
+ !! et_s ! - ! Total snow enthalpy | J/m2 |
!! bv_i ! - ! Mean relative brine volume | ??? |
!!=====================================================================
@@ -165,67 +164,68 @@
REAL(wp), PUBLIC :: r1_rdtice !: = 1. / rdt_ice
- ! !!** ice-dynamic namelist (namicedyn) **
- INTEGER , PUBLIC :: nevp !: number of iterations for subcycling
- REAL(wp), PUBLIC :: epsd !: tolerance parameter for dynamic
- REAL(wp), PUBLIC :: om !: relaxation constant
- REAL(wp), PUBLIC :: cw !: drag coefficient for oceanic stress
- REAL(wp), PUBLIC :: pstar !: determines ice strength (N/M), Hibler JPO79
- REAL(wp), PUBLIC :: c_rhg !: determines changes in ice strength
- REAL(wp), PUBLIC :: creepl !: creep limit : has to be under 1.0e-9
- REAL(wp), PUBLIC :: ecc !: eccentricity of the elliptical yield curve
- REAL(wp), PUBLIC :: ahi0 !: sea-ice hor. eddy diffusivity coeff. (m2/s)
- REAL(wp), PUBLIC :: telast !: timescale for elastic waves (s)
- REAL(wp), PUBLIC :: relast !: ratio => telast/rdt_ice (1/3 or 1/9 depending on nb of subcycling nevp)
- REAL(wp), PUBLIC :: alphaevp !: coeficient of the internal stresses
- REAL(wp), PUBLIC :: hminrhg !: ice volume (a*h, in m) below which ice velocity is set to ocean velocity
+ ! !!** ice-thickness distribution namelist (namiceitd) **
+ INTEGER , PUBLIC :: nn_catbnd !: categories distribution following: tanh function (1), or h^(-alpha) function (2)
+ REAL(wp), PUBLIC :: rn_himean !: mean thickness of the domain (used to compute the distribution, nn_itdshp = 2 only)
+
+ ! !!** ice-dynamics namelist (namicedyn) **
+ LOGICAL , PUBLIC :: ln_icestr_bvf !: use brine volume to diminish ice strength
+ INTEGER , PUBLIC :: nn_icestr !: ice strength parameterization (0=Hibler79 1=Rothrock75)
+ INTEGER , PUBLIC :: nn_nevp !: number of iterations for subcycling
+ INTEGER , PUBLIC :: nn_ahi0 !: sea-ice hor. eddy diffusivity coeff. (3 ways of calculation)
+ REAL(wp), PUBLIC :: rn_pe_rdg !: ridging work divided by pot. energy change in ridging, nn_icestr = 1
+ REAL(wp), PUBLIC :: rn_cio !: drag coefficient for oceanic stress
+ REAL(wp), PUBLIC :: rn_pstar !: determines ice strength (N/M), Hibler JPO79
+ REAL(wp), PUBLIC :: rn_crhg !: determines changes in ice strength
+ REAL(wp), PUBLIC :: rn_creepl !: creep limit : has to be under 1.0e-9
+ REAL(wp), PUBLIC :: rn_ecc !: eccentricity of the elliptical yield curve
+ REAL(wp), PUBLIC :: rn_ahi0_ref !: sea-ice hor. eddy diffusivity coeff. (m2/s)
+ REAL(wp), PUBLIC :: rn_relast !: ratio => telast/rdt_ice (1/3 or 1/9 depending on nb of subcycling nevp)
! !!** ice-salinity namelist (namicesal) **
- REAL(wp), PUBLIC :: s_i_max !: maximum ice salinity [PSU]
- REAL(wp), PUBLIC :: s_i_min !: minimum ice salinity [PSU]
- REAL(wp), PUBLIC :: s_i_0 !: 1st sal. value for the computation of sal .prof. [PSU]
- REAL(wp), PUBLIC :: s_i_1 !: 2nd sal. value for the computation of sal .prof. [PSU]
- REAL(wp), PUBLIC :: sal_G !: restoring salinity for gravity drainage [PSU]
- REAL(wp), PUBLIC :: sal_F !: restoring salinity for flushing [PSU]
- REAL(wp), PUBLIC :: time_G !: restoring time constant for gravity drainage (= 20 days) [s]
- REAL(wp), PUBLIC :: time_F !: restoring time constant for gravity drainage (= 10 days) [s]
- REAL(wp), PUBLIC :: bulk_sal !: bulk salinity (ppt) in case of constant salinity
+ REAL(wp), PUBLIC :: rn_simax !: maximum ice salinity [PSU]
+ REAL(wp), PUBLIC :: rn_simin !: minimum ice salinity [PSU]
+ REAL(wp), PUBLIC :: rn_sal_gd !: restoring salinity for gravity drainage [PSU]
+ REAL(wp), PUBLIC :: rn_sal_fl !: restoring salinity for flushing [PSU]
+ REAL(wp), PUBLIC :: rn_time_gd !: restoring time constant for gravity drainage (= 20 days) [s]
+ REAL(wp), PUBLIC :: rn_time_fl !: restoring time constant for gravity drainage (= 10 days) [s]
+ REAL(wp), PUBLIC :: rn_icesal !: bulk salinity (ppt) in case of constant salinity
! !!** ice-salinity namelist (namicesal) **
- INTEGER , PUBLIC :: num_sal !: salinity configuration used in the model
+ INTEGER , PUBLIC :: nn_icesal !: salinity configuration used in the model
! ! 1 - constant salinity in both space and time
! ! 2 - prognostic salinity (s(z,t))
! ! 3 - salinity profile, constant in time
- INTEGER , PUBLIC :: thcon_i_swi !: thermal conductivity: =0 Untersteiner (1964) ; =1 Pringle et al (2007)
+ INTEGER , PUBLIC :: nn_ice_thcon !: thermal conductivity: =0 Untersteiner (1964) ; =1 Pringle et al (2007)
+ INTEGER , PUBLIC :: nn_monocat !: virtual ITD mono-category parameterizations (1) or not (0)
+ LOGICAL , PUBLIC :: ln_it_qnsice !: iterate surface flux with changing surface temperature or not (F)
! !!** ice-mechanical redistribution namelist (namiceitdme)
- REAL(wp), PUBLIC :: Cs !: fraction of shearing energy contributing to ridging
- REAL(wp), PUBLIC :: Cf !: ratio of ridging work to PE loss
- REAL(wp), PUBLIC :: fsnowrdg !: fractional snow loss to the ocean during ridging
- REAL(wp), PUBLIC :: fsnowrft !: fractional snow loss to the ocean during ridging
- REAL(wp), PUBLIC :: Gstar !: fractional area of young ice contributing to ridging
- REAL(wp), PUBLIC :: astar !: equivalent of G* for an exponential participation function
- REAL(wp), PUBLIC :: Hstar !: thickness that determines the maximal thickness of ridged ice
- REAL(wp), PUBLIC :: hparmeter !: threshold thickness (m) for rafting / ridging
- REAL(wp), PUBLIC :: Craft !: coefficient for smoothness of the hyperbolic tangent in rafting
- REAL(wp), PUBLIC :: ridge_por !: initial porosity of ridges (0.3 regular value)
- REAL(wp), PUBLIC :: betas !: coef. for partitioning of snowfall between leads and sea ice
- REAL(wp), PUBLIC :: kappa_i !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m]
- REAL(wp), PUBLIC :: nconv_i_thd !: maximal number of iterations for heat diffusion
- REAL(wp), PUBLIC :: maxer_i_thd !: maximal tolerated error (C) for heat diffusion
+ REAL(wp), PUBLIC :: rn_cs !: fraction of shearing energy contributing to ridging
+ REAL(wp), PUBLIC :: rn_fsnowrdg !: fractional snow loss to the ocean during ridging
+ REAL(wp), PUBLIC :: rn_fsnowrft !: fractional snow loss to the ocean during ridging
+ REAL(wp), PUBLIC :: rn_gstar !: fractional area of young ice contributing to ridging
+ REAL(wp), PUBLIC :: rn_astar !: equivalent of G* for an exponential participation function
+ REAL(wp), PUBLIC :: rn_hstar !: thickness that determines the maximal thickness of ridged ice
+ REAL(wp), PUBLIC :: rn_hraft !: threshold thickness (m) for rafting / ridging
+ REAL(wp), PUBLIC :: rn_craft !: coefficient for smoothness of the hyperbolic tangent in rafting
+ REAL(wp), PUBLIC :: rn_por_rdg !: initial porosity of ridges (0.3 regular value)
+ REAL(wp), PUBLIC :: rn_betas !: coef. for partitioning of snowfall between leads and sea ice
+ REAL(wp), PUBLIC :: rn_kappa_i !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m]
+ REAL(wp), PUBLIC :: nn_conv_dif !: maximal number of iterations for heat diffusion
+ REAL(wp), PUBLIC :: rn_terr_dif !: maximal tolerated error (C) for heat diffusion
! !!** ice-mechanical redistribution namelist (namiceitdme)
- INTEGER , PUBLIC :: ridge_scheme_swi !: scheme used for ice ridging
- INTEGER , PUBLIC :: raft_swi !: rafting of ice or not
- INTEGER , PUBLIC :: partfun_swi !: participation function: =0 Thorndike et al. (1975), =1 Lipscomb et al. (2007)
- INTEGER , PUBLIC :: brinstren_swi !: use brine volume to diminish ice strength
-
- REAL(wp), PUBLIC :: usecc2 !: = 1.0 / ( ecc * ecc )
- REAL(wp), PUBLIC :: rhoco !: = rau0 * cw
-
+ LOGICAL , PUBLIC :: ln_rafting !: rafting of ice or not
+ INTEGER , PUBLIC :: nn_partfun !: participation function: =0 Thorndike et al. (1975), =1 Lipscomb et al. (2007)
+
+ REAL(wp), PUBLIC :: usecc2 !: = 1.0 / ( rn_ecc * rn_ecc )
+ REAL(wp), PUBLIC :: rhoco !: = rau0 * cio
+ REAL(wp), PUBLIC :: r1_nlay_i !: 1 / nlay_i
+ REAL(wp), PUBLIC :: r1_nlay_s !: 1 / nlay_s
+ !
! !!** switch for presence of ice or not
REAL(wp), PUBLIC :: rswitch
-
+ !
! !!** define some parameters
- REAL(wp), PUBLIC, PARAMETER :: unit_fac = 1.e+09_wp !: conversion factor for ice / snow enthalpy
REAL(wp), PUBLIC, PARAMETER :: epsi06 = 1.e-06_wp !: small number
REAL(wp), PUBLIC, PARAMETER :: epsi10 = 1.e-10_wp !: small number
@@ -266,4 +266,8 @@
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_res !: residual component of wfx_ice [kg/m2]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: afx_tot !: ice concentration tendency (total) [s-1]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: afx_thd !: ice concentration tendency (thermodynamics) [s-1]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: afx_dyn !: ice concentration tendency (dynamics) [s-1]
+
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bog !: salt flux due to ice growth/melt [PSU/m2/s]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bom !: salt flux due to ice growth/melt [PSU/m2/s]
@@ -282,4 +286,5 @@
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_snw !: heat flux for snow melt
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_err !: heat flux error after heat diffusion
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_err_dif !: heat flux remaining due to change in non-solar flux
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_err_rem !: heat flux error after heat remapping
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_in !: heat flux available for thermo transformations
@@ -296,7 +301,4 @@
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ftr_ice !: transmitted solar radiation under ice
-
- ! temporary arrays for dummy version of the code
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dh_i_surf2D, dh_i_bott2D, q_s
!!--------------------------------------------------------------------------
@@ -333,5 +335,5 @@
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: t_i !: ice temperatures [K]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_i !: ice thermal contents [Giga J]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_i !: ice thermal contents [J/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: s_i !: ice salinities [PSU]
@@ -356,57 +358,47 @@
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_i_b !: ice temperatures
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice_b, v_ice_b !: ice velocity
-
-
- !!--------------------------------------------------------------------------
- !! * Increment of global variables
- !!--------------------------------------------------------------------------
+
+ !!--------------------------------------------------------------------------
+ !! * Ice thickness distribution variables
+ !!--------------------------------------------------------------------------
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hi_max !: Boundary of ice thickness categories in thickness space
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hi_mean !: Mean ice thickness in catgories
+
+ !!--------------------------------------------------------------------------
+ !! * Ice Run
+ !!--------------------------------------------------------------------------
+ ! !!: ** Namelist namicerun read in sbc_lim_init **
+ INTEGER , PUBLIC :: jpl !: number of ice categories
+ INTEGER , PUBLIC :: nlay_i !: number of ice layers
+ INTEGER , PUBLIC :: nlay_s !: number of snow layers
+ CHARACTER(len=32), PUBLIC :: cn_icerst_in !: suffix of ice restart name (input)
+ CHARACTER(len=256), PUBLIC :: cn_icerst_indir !: ice restart input directory
+ CHARACTER(len=32), PUBLIC :: cn_icerst_out !: suffix of ice restart name (output)
+ CHARACTER(len=256), PUBLIC :: cn_icerst_outdir!: ice restart output directory
+ LOGICAL , PUBLIC :: ln_limdyn !: flag for ice dynamics (T) or not (F)
+ LOGICAL , PUBLIC :: ln_icectl !: flag for sea-ice points output (T) or not (F)
+ REAL(wp) , PUBLIC :: rn_amax !: maximum ice concentration
+ INTEGER , PUBLIC :: iiceprt !: debug i-point
+ INTEGER , PUBLIC :: jiceprt !: debug j-point
+ !
+ !!--------------------------------------------------------------------------
+ !! * Ice diagnostics
+ !!--------------------------------------------------------------------------
+ ! Increment of global variables
! thd refers to changes induced by thermodynamics
! trp '' '' '' advection (transport of ice)
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: d_a_i_thd , d_a_i_trp !: icefractions
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: d_v_s_thd , d_v_s_trp !: snow volume
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: d_v_i_thd , d_v_i_trp !: ice volume
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: d_smv_i_thd, d_smv_i_trp !:
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: d_sm_i_fl , d_sm_i_gd !:
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: d_sm_i_se , d_sm_i_si , d_sm_i_la !:
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: d_oa_i_thd , d_oa_i_trp !:
-
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: d_e_s_thd , d_e_s_trp !:
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: d_e_i_thd , d_e_i_trp !:
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: d_u_ice_dyn, d_v_ice_dyn !: ice velocity
-
- !!--------------------------------------------------------------------------
- !! * Ice thickness distribution variables
- !!--------------------------------------------------------------------------
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hi_max !: Boundary of ice thickness categories in thickness space
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hi_mean !: Mean ice thickness in catgories
-
- !!--------------------------------------------------------------------------
- !! * Ice Run
- !!--------------------------------------------------------------------------
- ! !!: ** Namelist namicerun read in iceini **
- CHARACTER(len=32) , PUBLIC :: cn_icerst_in !: suffix of ice restart name (input)
- CHARACTER(len=32) , PUBLIC :: cn_icerst_out !: suffix of ice restart name (output)
- LOGICAL , PUBLIC :: ln_limdyn !: flag for ice dynamics (T) or not (F)
- LOGICAL , PUBLIC :: ln_nicep !: flag for sea-ice points output (T) or not (F)
- REAL(wp) , PUBLIC :: cai !: atmospheric drag over sea ice
- REAL(wp) , PUBLIC :: cao !: atmospheric drag over ocean
- REAL(wp) , PUBLIC :: amax !: maximum ice concentration
+ LOGICAL , PUBLIC :: ln_limdiahsb !: flag for ice diag (T) or not (F)
+ LOGICAL , PUBLIC :: ln_limdiaout !: flag for ice diag (T) or not (F)
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_vi !: transport of ice volume
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_vs !: transport of snw volume
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_ei !: transport of ice enthalpy (W/m2)
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_es !: transport of snw enthalpy (W/m2)
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_smv !: transport of salt content
!
- !!--------------------------------------------------------------------------
- !! * Ice diagnostics
- !!--------------------------------------------------------------------------
- !! Check if everything down here is necessary
- LOGICAL , PUBLIC :: ln_limdiahsb !: flag for ice diag (T) or not (F)
- LOGICAL , PUBLIC :: ln_limdiaout !: flag for ice diag (T) or not (F)
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dv_dt_thd !: thermodynamic growth rates
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_vi !: transport of ice volume
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_vs !: transport of snw volume
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_ei !: transport of ice enthalpy (W/m2)
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_es !: transport of snw enthalpy (W/m2)
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_heat !: snw/ice heat content variation [W/m2]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_smvi !: ice salt content variation []
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_vice !: ice volume variation [m/s]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_vsnw !: snw volume variation [m/s]
!
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_heat_dhc !: snw/ice heat content variation [W/m2]
- !
- INTEGER , PUBLIC :: jiindx, jjindx !: indexes of the debugging point
-
!!----------------------------------------------------------------------
!! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010)
@@ -422,5 +414,5 @@
INTEGER :: ice_alloc
!
- INTEGER :: ierr(19), ii
+ INTEGER :: ierr(17), ii
!!-----------------------------------------------------------------
@@ -439,15 +431,17 @@
ii = ii + 1
- ALLOCATE( sist (jpi,jpj) , icethi (jpi,jpj) , t_bo (jpi,jpj) , &
- & frld (jpi,jpj) , pfrld (jpi,jpj) , phicif (jpi,jpj) , &
- & wfx_snw(jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(jpi,jpj) , &
+ ALLOCATE( sist (jpi,jpj) , icethi (jpi,jpj) , t_bo (jpi,jpj) , &
+ & frld (jpi,jpj) , pfrld (jpi,jpj) , phicif (jpi,jpj) , &
+ & wfx_snw(jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(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) , qlead (jpi,jpj) , &
- & fhtur (jpi,jpj) , ftr_ice(jpi,jpj,jpl) , &
- & sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(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) , hfx_err(jpi,jpj) , hfx_err_rem(jpi,jpj), &
- & hfx_in (jpi,jpj) , hfx_out(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) , &
+ & wfx_res(jpi,jpj) , wfx_sni(jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) , &
+ & afx_tot(jpi,jpj) , afx_thd(jpi,jpj), afx_dyn(jpi,jpj) , &
+ & fhtur (jpi,jpj) , ftr_ice(jpi,jpj,jpl), qlead (jpi,jpj) , &
+ & sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(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) , hfx_err(jpi,jpj) , &
+ & hfx_err_dif(jpi,jpj) , hfx_err_rem(jpi,jpj) , &
+ & hfx_in (jpi,jpj) , hfx_out(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) , STAT=ierr(ii) )
@@ -464,8 +458,7 @@
& bv_i (jpi,jpj) , smt_i(jpi,jpj) , STAT=ierr(ii) )
ii = ii + 1
- ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) , &
- & e_s(jpi,jpj,nlay_s,jpl) , STAT=ierr(ii) )
- ii = ii + 1
- ALLOCATE( t_i(jpi,jpj,nlay_i+1,jpl) , e_i(jpi,jpj,nlay_i+1,jpl) , s_i(jpi,jpj,nlay_i+1,jpl) , STAT=ierr(ii) )
+ ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) , e_s(jpi,jpj,nlay_s,jpl) , STAT=ierr(ii) )
+ ii = ii + 1
+ ALLOCATE( t_i(jpi,jpj,nlay_i,jpl) , e_i(jpi,jpj,nlay_i,jpl) , s_i(jpi,jpj,nlay_i,jpl) , STAT=ierr(ii) )
! * Moments for advection
@@ -483,24 +476,12 @@
& STAT=ierr(ii) )
ii = ii + 1
- ALLOCATE( sxe (jpi,jpj,nlay_i+1,jpl) , sye (jpi,jpj,nlay_i+1,jpl) , sxxe(jpi,jpj,nlay_i+1,jpl) , &
- & syye(jpi,jpj,nlay_i+1,jpl) , sxye(jpi,jpj,nlay_i+1,jpl) , STAT=ierr(ii) )
+ ALLOCATE( sxe (jpi,jpj,nlay_i,jpl) , sye (jpi,jpj,nlay_i,jpl) , sxxe(jpi,jpj,nlay_i,jpl) , &
+ & syye(jpi,jpj,nlay_i,jpl) , sxye(jpi,jpj,nlay_i,jpl) , STAT=ierr(ii) )
! * Old values of global variables
ii = ii + 1
ALLOCATE( v_s_b (jpi,jpj,jpl) , v_i_b (jpi,jpj,jpl) , e_s_b(jpi,jpj,nlay_s,jpl) , &
- & a_i_b (jpi,jpj,jpl) , smv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i+1 ,jpl) , &
- & oa_i_b (jpi,jpj,jpl) , &
- & u_ice_b(jpi,jpj) , v_ice_b(jpi,jpj) , STAT=ierr(ii) )
-
- ! * Increment of global variables
- ii = ii + 1
- ALLOCATE( d_a_i_thd(jpi,jpj,jpl) , d_a_i_trp (jpi,jpj,jpl) , d_v_s_thd (jpi,jpj,jpl) , d_v_s_trp (jpi,jpj,jpl) , &
- & d_v_i_thd(jpi,jpj,jpl) , d_v_i_trp (jpi,jpj,jpl) , d_smv_i_thd(jpi,jpj,jpl) , d_smv_i_trp(jpi,jpj,jpl) , &
- & d_sm_i_fl(jpi,jpj,jpl) , d_sm_i_gd (jpi,jpj,jpl) , d_sm_i_se (jpi,jpj,jpl) , d_sm_i_si (jpi,jpj,jpl) , &
- & d_sm_i_la(jpi,jpj,jpl) , d_oa_i_thd(jpi,jpj,jpl) , d_oa_i_trp (jpi,jpj,jpl) , &
- & STAT=ierr(ii) )
- ii = ii + 1
- ALLOCATE( d_e_s_thd(jpi,jpj,nlay_s,jpl) , d_e_i_thd(jpi,jpj,nlay_i,jpl) , d_u_ice_dyn(jpi,jpj) , &
- & d_e_s_trp(jpi,jpj,nlay_s,jpl) , d_e_i_trp(jpi,jpj,nlay_i,jpl) , d_v_ice_dyn(jpi,jpj) , STAT=ierr(ii) )
+ & a_i_b (jpi,jpj,jpl) , smv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i,jpl) , &
+ & oa_i_b (jpi,jpj,jpl) , u_ice_b(jpi,jpj) , v_ice_b(jpi,jpj) , STAT=ierr(ii) )
! * Ice thickness distribution variables
@@ -510,7 +491,7 @@
! * Ice diagnostics
ii = ii + 1
- ALLOCATE( dv_dt_thd(jpi,jpj,jpl), &
- & diag_trp_vi(jpi,jpj), diag_trp_vs (jpi,jpj), diag_trp_ei(jpi,jpj), &
- & diag_trp_es(jpi,jpj), diag_heat_dhc(jpi,jpj), STAT=ierr(ii) )
+ ALLOCATE( diag_trp_vi(jpi,jpj), diag_trp_vs (jpi,jpj), diag_trp_ei(jpi,jpj), &
+ & diag_trp_es(jpi,jpj), diag_trp_smv(jpi,jpj), diag_heat (jpi,jpj), &
+ & diag_smvi (jpi,jpj), diag_vice (jpi,jpj), diag_vsnw (jpi,jpj), STAT=ierr(ii) )
ice_alloc = MAXVAL( ierr(:) )
Index: anches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/iceini.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/iceini.F90 (revision 5601)
+++ (revision )
@@ -1,225 +1,0 @@
-MODULE iceini
- !!======================================================================
- !! *** MODULE iceini ***
- !! Sea-ice model : LIM Sea ice model Initialization
- !!======================================================================
- !! History : 3.0 ! 2008-03 (M. Vancoppenolle) LIM-3 original code
- !! 3.3 ! 2010-12 (G. Madec) add call to lim_thd_init and lim_thd_sal_init
- !! 4.0 ! 2011-02 (G. Madec) dynamical allocation
- !!----------------------------------------------------------------------
-#if defined key_lim3
- !!----------------------------------------------------------------------
- !! 'key_lim3' LIM sea-ice model
- !!----------------------------------------------------------------------
- !! ice_init : sea-ice model initialization
- !!----------------------------------------------------------------------
- USE phycst ! physical constants
- USE dom_oce ! ocean domain
- USE sbc_oce ! Surface boundary condition: ocean fields
- USE sbc_ice ! Surface boundary condition: ice fields
- USE ice ! LIM variables
- USE par_ice ! LIM parameters
- USE dom_ice ! LIM domain
- USE thd_ice ! LIM thermodynamical variables
- USE limitd_me ! LIM ice thickness distribution
- USE limmsh ! LIM mesh
- USE limistate ! LIM initial state
- USE limrst ! LIM restart
- USE limthd ! LIM ice thermodynamics
- USE limthd_sal ! LIM ice thermodynamics: salinity
- USE limvar ! LIM variables
- USE limsbc ! LIM surface boundary condition
- 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)
-
- IMPLICIT NONE
- PRIVATE
-
- PUBLIC ice_init ! called by sbcice_lim.F90
-
- !!----------------------------------------------------------------------
- !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
- !! $Id$
- !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
- !!----------------------------------------------------------------------
-CONTAINS
-
- SUBROUTINE ice_init
- !!----------------------------------------------------------------------
- !! *** ROUTINE ice_init ***
- !!
- !! ** purpose : Allocate all the dynamic arrays of the LIM-3 modules
- !!----------------------------------------------------------------------
- INTEGER :: ierr
- !!----------------------------------------------------------------------
-
- ! ! Allocate the ice arrays
- ierr = ice_alloc () ! ice variables
- ierr = ierr + dom_ice_alloc () ! domain
- ierr = ierr + sbc_ice_alloc () ! surface forcing
- ierr = ierr + thd_ice_alloc () ! thermodynamics
- ierr = ierr + lim_itd_me_alloc () ! ice thickness distribution - mechanics
- !
- IF( lk_mpp ) CALL mpp_sum( ierr )
- IF( ierr /= 0 ) CALL ctl_stop('STOP', 'ice_init : unable to allocate ice arrays')
- !
- ! ! adequation jpk versus ice/snow layers/categories
- IF( jpl > jpk .OR. (nlay_i+1) > jpk .OR. nlay_s > jpk ) &
- & CALL ctl_stop( 'STOP', &
- & 'ice_init: the 3rd dimension of workspace arrays is too small.', &
- & 'use more ocean levels or less ice/snow layers/categories.' )
-
- ! Open the reference and configuration namelist files and namelist output file
- CALL ctl_opn( numnam_ice_ref, 'namelist_ice_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
- CALL ctl_opn( numnam_ice_cfg, 'namelist_ice_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
- IF(lwm) CALL ctl_opn( numoni, 'output.namelist.ice', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, 1 )
- !
- CALL ice_run ! set some ice run parameters
- !
- CALL lim_thd_init ! set ice thermodynics parameters
- !
- CALL lim_thd_sal_init ! set ice salinity parameters
- !
- rdt_ice = nn_fsbc * rdttra(1) ! sea-ice timestep
- r1_rdtice = 1._wp / rdt_ice ! sea-ice timestep inverse
- !
- CALL lim_msh ! ice mesh initialization
- !
- CALL lim_itd_ini ! ice thickness distribution initialization
- !
- CALL lim_itd_me_init ! ice thickness distribution initialization
- ! ! Initial sea-ice state
- IF( .NOT. ln_rstart ) THEN ! start from rest
- numit = 0
- numit = nit000 - 1
- CALL lim_istate ! start from rest: sea-ice deduced from sst
- CALL lim_var_agg(1) ! aggregate category variables in bulk variables
- CALL lim_var_glo2eqv ! convert global variables in equivalent variables
- ELSE ! start from a restart file
- CALL lim_rst_read ! read the restart file
- numit = nit000 - 1
- CALL lim_var_agg(1) ! aggregate ice variables
- CALL lim_var_glo2eqv ! convert global var in equivalent variables
- ENDIF
- !
- hi_max(jpl) = 99._wp ! Set hi_max(jpl) to a big value to ensure that all ice is thinner than hi_max(jpl)
- !
- CALL lim_sbc_init ! ice surface boundary condition
- !
- fr_i(:,:) = at_i(:,:) ! initialisation of sea-ice fraction
- tn_ice(:,:,:) = t_su(:,:,:) ! initialisation of surface temp for coupled simu
- !
- nstart = numit + nn_fsbc
- nitrun = nitend - nit000 + 1
- nlast = numit + nitrun
- !
- IF( nstock == 0 ) nstock = nlast + 1
- !
- END SUBROUTINE ice_init
-
-
- SUBROUTINE ice_run
- !!-------------------------------------------------------------------
- !! *** ROUTINE ice_run ***
- !!
- !! ** Purpose : Definition some run parameter for ice model
- !!
- !! ** Method : Read the namicerun namelist and check the parameter
- !! values called at the first timestep (nit000)
- !!
- !! ** input : Namelist namicerun
- !!-------------------------------------------------------------------
- NAMELIST/namicerun/ cn_icerst_in, cn_icerst_out, ln_limdyn, amax, cai, cao, ln_nicep, ln_limdiahsb, ln_limdiaout
- INTEGER :: ios ! Local integer output status for namelist read
- !!-------------------------------------------------------------------
- !
- REWIND( numnam_ice_ref ) ! Namelist namicerun in reference namelist : Parameters for ice
- READ ( numnam_ice_ref, namicerun, IOSTAT = ios, ERR = 901)
-901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in reference namelist', lwp )
-
- REWIND( numnam_ice_cfg ) ! Namelist namicerun in configuration namelist : Parameters for ice
- READ ( numnam_ice_cfg, namicerun, IOSTAT = ios, ERR = 902 )
-902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in configuration namelist', lwp )
- IF(lwm) WRITE ( numoni, namicerun )
- !
- !IF( lk_mpp .AND. ln_nicep ) THEN
- ! ln_nicep = .FALSE.
- ! CALL ctl_warn( 'ice_run : specific control print for LIM3 desactivated with MPI' )
- !ENDIF
- !
- IF(lwp) THEN ! control print
- WRITE(numout,*)
- WRITE(numout,*) 'ice_run : ice share parameters for dynamics/advection/thermo of sea-ice'
- WRITE(numout,*) ' ~~~~~~'
- WRITE(numout,*) ' switch for ice dynamics (1) or not (0) ln_limdyn = ', ln_limdyn
- WRITE(numout,*) ' maximum ice concentration = ', amax
- WRITE(numout,*) ' atmospheric drag over sea ice = ', cai
- WRITE(numout,*) ' atmospheric drag over ocean = ', cao
- WRITE(numout,*) ' Several ice points in the ice or not in ocean.output = ', ln_nicep
- WRITE(numout,*) ' Diagnose heat/salt budget or not ln_limdiahsb = ', ln_limdiahsb
- WRITE(numout,*) ' Output heat/salt budget or not ln_limdiaout = ', ln_limdiaout
- ENDIF
- !
- END SUBROUTINE ice_run
-
-
- SUBROUTINE lim_itd_ini
- !!------------------------------------------------------------------
- !! *** ROUTINE lim_itd_ini ***
- !!
- !! ** Purpose : Initializes the ice thickness distribution
- !! ** Method : ...
- !! Note : hi_max(jpl) is here set up to a value close to 7 m for
- !! limistate (only) and is changed to 99 m in ice_init
- !!------------------------------------------------------------------
- INTEGER :: jl ! dummy loop index
- REAL(wp) :: zc1, zc2, zc3, zx1 ! local scalars
- !!------------------------------------------------------------------
-
- IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*) 'lim_itd_ini : Initialization of ice thickness distribution '
- IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
-
- !------------------------------------------------------------------------------!
- ! 1) Ice thickness distribution parameters initialization
- !------------------------------------------------------------------------------!
- IF(lwp) THEN
- WRITE(numout,*) ' Number of ice categories jpl = ', jpl
- ENDIF
-
- !- Thickness categories boundaries
- !----------------------------------
- hi_max(:) = 0._wp
-
- zc1 = 3._wp / REAL( jpl, wp )
- zc2 = 10._wp * zc1
- zc3 = 3._wp
-
- DO jl = 1, jpl
- zx1 = REAL( jl-1, wp ) / REAL( jpl, wp )
- hi_max(jl) = hi_max(jl-1) + zc1 + zc2 * (1._wp + TANH( zc3 * (zx1 - 1._wp ) ) )
- END DO
-
- IF(lwp) WRITE(numout,*) ' Thickness category boundaries '
- IF(lwp) WRITE(numout,*) ' hi_max ', hi_max(0:jpl)
-
- !
- DO jl = 1, jpl
- hi_mean(jl) = ( hi_max(jl) + hi_max(jl-1) ) * 0.5_wp
- END DO
- !
- !
- END SUBROUTINE lim_itd_ini
-
-#else
- !!----------------------------------------------------------------------
- !! Default option : Empty module NO LIM sea-ice model
- !!----------------------------------------------------------------------
-CONTAINS
- SUBROUTINE ice_init ! Empty routine
- END SUBROUTINE ice_init
-#endif
-
- !!======================================================================
-END MODULE iceini
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90 (revision 5602)
@@ -63,5 +63,5 @@
!!
INTEGER :: ji, jj ! dummy loop indices
- REAL(wp) :: zs1max, zrdt, zslpmax, ztemp, zin0 ! local scalars
+ REAL(wp) :: zs1max, zrdt, zslpmax, ztemp ! local scalars
REAL(wp) :: zs1new, zalf , zalfq , zbt ! - -
REAL(wp) :: zs2new, zalf1, zalf1q, zbt1 ! - -
@@ -85,17 +85,17 @@
zs2new = MIN( 2.0 * zslpmax - 0.3334 * ABS( zs1new ), &
& MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj) ) )
- zin0 = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tms(ji,jj) ! Case of empty boxes & Apply mask
+ rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1) ! Case of empty boxes & Apply mask
ps0 (ji,jj) = zslpmax
- psx (ji,jj) = zs1new * zin0
- psxx(ji,jj) = zs2new * zin0
- psy (ji,jj) = psy (ji,jj) * zin0
- psyy(ji,jj) = psyy(ji,jj) * zin0
- psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * zin0
+ psx (ji,jj) = zs1new * rswitch
+ psxx(ji,jj) = zs2new * rswitch
+ psy (ji,jj) = psy (ji,jj) * rswitch
+ psyy(ji,jj) = psyy(ji,jj) * rswitch
+ psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * rswitch
END DO
END DO
! Initialize volumes of boxes (=area if adv_x first called, =psm otherwise)
- psm (:,:) = MAX( pcrh * area(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 )
+ psm (:,:) = MAX( pcrh * e12t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 )
! Calculate fluxes and moments between boxes i<-->i+1
@@ -207,8 +207,8 @@
!-- Lateral boundary conditions
- CALL lbc_lnk( psm , 'T', 1. ) ; CALL lbc_lnk( ps0 , 'T', 1. )
- CALL lbc_lnk( psx , 'T', -1. ) ; CALL lbc_lnk( psy , 'T', -1. ) ! caution gradient ==> the sign changes
- CALL lbc_lnk( psxx, 'T', 1. ) ; CALL lbc_lnk( psyy, 'T', 1. )
- CALL lbc_lnk( psxy, 'T', 1. )
+ CALL lbc_lnk_multi( psm , 'T', 1., ps0 , 'T', 1. &
+ & , psx , 'T', -1., psy , 'T', -1. & ! caution gradient ==> the sign changes
+ & , psxx, 'T', 1., psyy, 'T', 1. &
+ & , psxy, 'T', 1. )
IF(ln_ctl) THEN
@@ -248,5 +248,5 @@
!!
INTEGER :: ji, jj ! dummy loop indices
- REAL(wp) :: zs1max, zrdt, zslpmax, ztemp, zin0 ! temporary scalars
+ REAL(wp) :: zs1max, zrdt, zslpmax, ztemp ! temporary scalars
REAL(wp) :: zs1new, zalf , zalfq , zbt ! - -
REAL(wp) :: zs2new, zalf1, zalf1q, zbt1 ! - -
@@ -270,17 +270,17 @@
zs2new = MIN( ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ), &
& MAX( ABS( zs1new )-zslpmax, psyy(ji,jj) ) )
- zin0 = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tms(ji,jj) ! Case of empty boxes & Apply mask
+ rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1) ! Case of empty boxes & Apply mask
!
ps0 (ji,jj) = zslpmax
- psx (ji,jj) = psx (ji,jj) * zin0
- psxx(ji,jj) = psxx(ji,jj) * zin0
- psy (ji,jj) = zs1new * zin0
- psyy(ji,jj) = zs2new * zin0
- psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * zin0
+ psx (ji,jj) = psx (ji,jj) * rswitch
+ psxx(ji,jj) = psxx(ji,jj) * rswitch
+ psy (ji,jj) = zs1new * rswitch
+ psyy(ji,jj) = zs2new * rswitch
+ psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * rswitch
END DO
END DO
! Initialize volumes of boxes (=area if adv_x first called, =psm otherwise)
- psm(:,:) = MAX( pcrh * area(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 )
+ psm(:,:) = MAX( pcrh * e12t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 )
! Calculate fluxes and moments between boxes j<-->j+1
@@ -393,8 +393,8 @@
!-- Lateral boundary conditions
- CALL lbc_lnk( psm , 'T', 1. ) ; CALL lbc_lnk( ps0 , 'T', 1. )
- CALL lbc_lnk( psx , 'T', -1. ) ; CALL lbc_lnk( psy , 'T', -1. ) ! caution gradient ==> the sign changes
- CALL lbc_lnk( psxx, 'T', 1. ) ; CALL lbc_lnk( psyy, 'T', 1. )
- CALL lbc_lnk( psxy, 'T', 1. )
+ CALL lbc_lnk_multi( psm , 'T', 1., ps0 , 'T', 1. &
+ & , psx , 'T', -1., psy , 'T', -1. & ! caution gradient ==> the sign changes
+ & , psxx, 'T', 1., psyy, 'T', 1. &
+ & , psxy, 'T', 1. )
IF(ln_ctl) THEN
Index: anches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limcat_1D.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limcat_1D.F90 (revision 5601)
+++ (revision )
@@ -1,215 +1,0 @@
-MODULE limcat_1D
- !!======================================================================
- !! *** MODULE limcat_1D ***
- !! Used for LIM3 to convert cell averages of ice thickness, snow thickness
- !! and ice cover into a prescribed distribution over the cell.
- !! (Example of application: BDY forcings when input are cell averaged)
- !!======================================================================
- !! History : - ! Original code from M. Vancoppenolle (?)
- !! ! 2011-12 (C. Rousset) rewritten for clarity
- !!----------------------------------------------------------------------
-#if defined key_lim3
- !!----------------------------------------------------------------------
- !! 'key_lim3' : LIM3 sea-ice model
- !!----------------------------------------------------------------------
- !! lim_cat_1D : main subroutine
- !!----------------------------------------------------------------------
- !! Modules used
- USE phycst
- USE oce ! dynamics and tracers variables
- USE dom_oce
- USE sbc_oce ! Surface boundary condition: ocean fields
- USE par_ice ! ice parameters
- USE ice ! ice variables
- USE eosbn2 ! equation of state
- USE in_out_manager
- USE dom_ice
- USE ice
- USE lbclnk
- USE timing ! Timing
-
- IMPLICIT NONE
- PRIVATE
-
- !! Accessibility
- PUBLIC lim_cat_1D
-
-CONTAINS
-
- SUBROUTINE lim_cat_1D(zhti,zhts,zai,zht_i,zht_s,za_i)
- !! Local variables
- INTEGER :: ji, jk, jl ! dummy loop indices
- INTEGER :: ijpij, i_fill, jl0, ztest_1, ztest_2, ztest_3, ztest_4, ztests
- REAL(wp) :: zarg, zV, zconv
- REAL(wp), DIMENSION(:), INTENT(in) :: zhti, zhts, zai ! input ice/snow variables
- REAL(wp), DIMENSION(:,:), INTENT(inout) :: zht_i, zht_s, za_i ! output ice/snow variables
- REAL(wp) :: epsi06 = 1.0e-6
- REAL(wp) :: zc1, zc2, zc3, zx1, zdh ! local scalars
- REAL(wp), DIMENSION(0:jpl) :: zhi_max !:Boundary of ice thickness categories in thickness space
-
- IF( nn_timing == 1 ) CALL timing_start('limcat_1D')
- !--------------------------------------------------------------------
- ! initialisation of variables
- !--------------------------------------------------------------------
- ijpij = SIZE(zhti,1)
- zht_i(1:ijpij,1:jpl) = 0._wp
- zht_s(1:ijpij,1:jpl) = 0._wp
- za_i (1:ijpij,1:jpl) = 0._wp
-
- !------------------------------------------------------------------------------------
- ! Distribute ice concentration and thickness into the categories
- !------------------------------------------------------------------------------------
- ! Method: we first try to fill the jpl ice categories bounded by thicknesses
- ! hmax(0:jpl) with a gaussian distribution, and check whether the distribution
- ! fulfills volume and area conservation, positivity and ice categories bounds.
- ! In other words, if ice input is too thin, the last category (jpl)
- ! cannot be filled, so we try to fill jpl-1 categories...
- ! And so forth iteratively until the number of categories filled
- ! fulfills ice volume concervation between input and output (ztests=4)
- !--------------------------------------------------------------------------------------
-
- !- Thickness categories boundaries
- ! hi_max is calculated in iceini.F90 but since limcat_1D.F90 routine
- ! is called before (in bdydta.F90), one must recalculate it.
- ! Note clem: there may be a way of doing things cleaner
- !----------------------------------
- zhi_max(:) = 0._wp
- zc1 = 3._wp / REAL( jpl , wp ) ; zc2 = 10._wp * zc1 ; zc3 = 3._wp
- DO jl = 1, jpl
- zx1 = REAL( jl-1 , wp ) / REAL( jpl , wp )
- zhi_max(jl) = zhi_max(jl-1) + zc1 + zc2 * ( 1._wp + TANH( zc3 * ( zx1 - 1._wp ) ) )
- END DO
-
- ! ----------------------------------------
- ! distribution over the jpl ice categories
- ! ----------------------------------------
- DO ji = 1, ijpij
-
- IF( zhti(ji) > 0._wp ) THEN
-
- ! initialisation of tests
- ztest_1 = 0
- ztest_2 = 0
- ztest_3 = 0
- ztest_4 = 0
- ztests = 0
-
- i_fill = jpl + 1 !====================================
- DO WHILE ( ( ztests /= 4 ) .AND. ( i_fill >= 2 ) ) ! iterative loop on i_fill categories
- ! iteration !====================================
- i_fill = i_fill - 1
-
- ! initialisation of ice variables for each try
- zht_i(ji,1:jpl) = 0._wp
- za_i (ji,1:jpl) = 0._wp
-
- ! *** case very thin ice: fill only category 1
- IF ( i_fill == 1 ) THEN
- zht_i(ji,1) = zhti(ji)
- za_i (ji,1) = zai (ji)
- ! *** case ice is thicker: fill categories >1
- ELSE
-
- ! Fill ice thicknesses except the last one (i_fill) by (hmax-hmin)/2
- DO jl = 1, i_fill - 1
- zht_i(ji,jl) = ( zhi_max(jl) + zhi_max(jl-1) ) * 0.5_wp
- END DO
-
- ! find which category (jl0) the input ice thickness falls into
- jl0 = i_fill
- DO jl = 1, i_fill
- IF ( ( zhti(ji) >= zhi_max(jl-1) ) .AND. ( zhti(ji) < zhi_max(jl) ) ) THEN
- jl0 = jl
- CYCLE
- ENDIF
- END DO
-
- ! Concentrations in the (i_fill-1) categories
- za_i(ji,jl0) = zai(ji) / SQRT(REAL(jpl))
- DO jl = 1, i_fill - 1
- IF ( jl == jl0 ) CYCLE
- zarg = ( zht_i(ji,jl) - zhti(ji) ) / ( zhti(ji) * 0.5_wp )
- za_i(ji,jl) = za_i (ji,jl0) * EXP(-zarg**2)
- END DO
-
- ! Concentration in the last (i_fill) category
- za_i(ji,i_fill) = zai(ji) - SUM( za_i(ji,1:i_fill-1) )
-
- ! Ice thickness in the last (i_fill) category
- zV = SUM( za_i(ji,1:i_fill-1) * zht_i(ji,1:i_fill-1) )
- zht_i(ji,i_fill) = ( zhti(ji)*zai(ji) - zV ) / za_i(ji,i_fill)
-
- ENDIF ! case ice is thick or thin
-
- !---------------------
- ! Compatibility tests
- !---------------------
- ! Test 1: area conservation
- zconv = ABS( zai(ji) - SUM( za_i(ji,1:jpl) ) )
- IF ( zconv < epsi06 ) ztest_1 = 1
-
- ! Test 2: volume conservation
- zconv = ABS( zhti(ji)*zai(ji) - SUM( za_i(ji,1:jpl)*zht_i(ji,1:jpl) ) )
- IF ( zconv < epsi06 ) ztest_2 = 1
-
- ! Test 3: thickness of the last category is in-bounds ?
- IF ( zht_i(ji,i_fill) >= zhi_max(i_fill-1) ) ztest_3 = 1
-
- ! Test 4: positivity of ice concentrations
- ztest_4 = 1
- DO jl = 1, i_fill
- IF ( za_i(ji,jl) < 0._wp ) ztest_4 = 0
- END DO
-
- ztests = ztest_1 + ztest_2 + ztest_3 + ztest_4
- !============================
- END DO ! end iteration on categories
- !============================
- ! Check if tests have passed (i.e. volume conservation...)
- !IF ( ztests /= 4 ) THEN
- ! WRITE(numout,*) ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! '
- ! WRITE(numout,*) ' !! ALERT categories distribution !!'
- ! WRITE(numout,*) ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! '
- ! WRITE(numout,*) ' *** ztests is not equal to 4 '
- ! WRITE(numout,*) ' *** ztest (1:4) = ', ztest_1, ztest_2, ztest_3, ztest_4
- ! WRITE(numout,*) 'i_fill=',i_fill
- ! WRITE(numout,*) 'zai(ji)=',zai(ji)
- ! WRITE(numout,*) 'za_i(ji,jpl)=',za_i(ji,:)
- !ENDIF
-
- ENDIF ! if zhti > 0
-
- END DO ! i loop
-
- ! ------------------------------------------------
- ! Adding Snow in each category where za_i is not 0
- ! ------------------------------------------------
- DO jl = 1, jpl
- DO ji = 1, ijpij
- IF( za_i(ji,jl) > 0._wp ) THEN
- zht_s(ji,jl) = zht_i(ji,jl) * ( zhts(ji) / zhti(ji) )
- ! In case snow load is in excess that would lead to transformation from snow to ice
- ! Then, transfer the snow excess into the ice (different from limthd_dh)
- zdh = MAX( 0._wp, ( rhosn * zht_s(ji,jl) + ( rhoic - rau0 ) * zht_i(ji,jl) ) * r1_rau0 )
- ! recompute ht_i, ht_s avoiding out of bounds values
- zht_i(ji,jl) = MIN( zhi_max(jl), zht_i(ji,jl) + zdh )
- zht_s(ji,jl) = MAX( 0._wp, zht_s(ji,jl) - zdh * rhoic / rhosn )
- ENDIF
- ENDDO
- ENDDO
-
- IF( nn_timing == 1 ) CALL timing_stop('limcat_1D')
-
- END SUBROUTINE lim_cat_1D
-
-#else
- !!----------------------------------------------------------------------
- !! Default option : Empty module NO LIM sea-ice model
- !!----------------------------------------------------------------------
-CONTAINS
- SUBROUTINE lim_cat_1D ! Empty routine
- END SUBROUTINE lim_cat_1D
-#endif
-
- !!======================================================================
-END MODULE limcat_1D
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90 (revision 5602)
@@ -6,6 +6,7 @@
!! History : - ! Original code from William H. Lipscomb, LANL
!! 3.0 ! 2004-06 (M. Vancoppenolle) Energy Conservation
- !! 4.0 ! 2011-02 (G. Madec) add mpp considerations
+ !! 3.5 ! 2011-02 (G. Madec) add mpp considerations
!! - ! 2014-05 (C. Rousset) add lim_cons_hsm
+ !! - ! 2015-03 (C. Rousset) add lim_cons_final
!!----------------------------------------------------------------------
#if defined key_lim3
@@ -16,5 +17,4 @@
!!----------------------------------------------------------------------
USE phycst ! physical constants
- USE par_ice ! LIM-3 parameter
USE ice ! LIM-3 variables
USE dom_ice ! LIM-3 domain
@@ -23,4 +23,5 @@
USE lib_mpp ! MPP library
USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+ USE sbc_oce , ONLY : sfx ! Surface boundary condition: ocean fields
IMPLICIT NONE
@@ -31,4 +32,5 @@
PUBLIC lim_cons_check
PUBLIC lim_cons_hsm
+ PUBLIC lim_cons_final
!!----------------------------------------------------------------------
@@ -73,8 +75,8 @@
!! ** Method : Arithmetics
!!---------------------------------------------------------------------
- INTEGER , INTENT(in ) :: ksum !: number of categories
- INTEGER , INTENT(in ) :: klay !: number of vertical layers
- REAL(wp), DIMENSION(jpi,jpj,nlay_i+1,jpl), INTENT(in ) :: pin !: input field
- REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pout !: output field
+ INTEGER , INTENT(in ) :: ksum !: number of categories
+ INTEGER , INTENT(in ) :: klay !: number of vertical layers
+ REAL(wp), DIMENSION(jpi,jpj,nlay_i,jpl), INTENT(in ) :: pin !: input field
+ REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pout !: output field
!
INTEGER :: jk, jl ! dummy loop indices
@@ -156,61 +158,106 @@
SUBROUTINE lim_cons_hsm( icount, cd_routine, zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b )
- !!-------------------------------------------------------------------
- !! *** ROUTINE lim_cons_hsm ***
- !!
- !! ** Purpose : Test the conservation of heat, salt and mass for each routine
- !!
- !! ** Method :
- !!---------------------------------------------------------------------
- INTEGER , INTENT(in) :: icount ! determine wether this is the beggining of the routine (0) or the end (1)
- CHARACTER(len=*), INTENT(in) :: cd_routine ! name of the routine
+ !!--------------------------------------------------------------------------------------------------------
+ !! *** ROUTINE lim_cons_hsm ***
+ !!
+ !! ** Purpose : Test the conservation of heat, salt and mass for each ice routine
+ !! + test if ice concentration and volume are > 0
+ !!
+ !! ** Method : This is an online diagnostics which can be activated with ln_limdiahsb=true
+ !! It prints in ocean.output if there is a violation of conservation at each time-step
+ !! The thresholds (zv_sill, zs_sill, zh_sill) which determine violations are set to
+ !! a minimum of 1 mm of ice (over the ice area) that is lost/gained spuriously during 100 years.
+ !! For salt and heat thresholds, ice is considered to have a salinity of 10
+ !! and a heat content of 3e5 J/kg (=latent heat of fusion)
+ !!--------------------------------------------------------------------------------------------------------
+ INTEGER , INTENT(in) :: icount ! determine wether this is the beggining of the routine (0) or the end (1)
+ CHARACTER(len=*), INTENT(in) :: cd_routine ! name of the routine
REAL(wp) , INTENT(inout) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b
REAL(wp) :: zvi, zsmv, zei, zfs, zfw, zft
REAL(wp) :: zvmin, zamin, zamax
+ REAL(wp) :: zvtrp, zetrp
+ REAL(wp) :: zarea, zv_sill, zs_sill, zh_sill
+ REAL(wp), PARAMETER :: zconv = 1.e-9 ! convert W to GW and kg to Mt
IF( icount == 0 ) THEN
- zvi_b = glob_sum( SUM( v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) )
- zsmv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) )
- zei_b = glob_sum( SUM( e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) )
- zfw_b = glob_sum( - ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + &
- & wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:) &
- & ) * area(:,:) * tms(:,:) )
- zfs_b = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + &
- & sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) &
- & ) * area(:,:) * tms(:,:) )
- zft_b = glob_sum( ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:) &
- & - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:) &
- & ) * area(:,:) / unit_fac * tms(:,:) )
+ ! salt flux
+ zfs_b = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + &
+ & sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) &
+ & ) * e12t(:,:) * tmask(:,:,1) * zconv )
+
+ ! water flux
+ zfw_b = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + &
+ & wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:) &
+ & ) * e12t(:,:) * tmask(:,:,1) * zconv )
+
+ ! heat flux
+ zft_b = glob_sum( ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:) &
+ & - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:) &
+ & ) * e12t(:,:) * tmask(:,:,1) * zconv )
+
+ zvi_b = glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 ) * e12t * tmask(:,:,1) * zconv )
+
+ zsmv_b = glob_sum( SUM( smv_i * rhoic , dim=3 ) * e12t * tmask(:,:,1) * zconv )
+
+ zei_b = glob_sum( ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) + &
+ & SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 ) &
+ ) * e12t * tmask(:,:,1) * zconv )
ELSEIF( icount == 1 ) THEN
- zfs = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + &
- & sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) &
- & ) * area(:,:) * tms(:,:) ) - zfs_b
- zfw = glob_sum( - ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + &
- & wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:) &
- & ) * area(:,:) * tms(:,:) ) - zfw_b
- zft = glob_sum( ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:) &
- & - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:) &
- & ) * area(:,:) / unit_fac * tms(:,:) ) - zft_b
+ ! salt flux
+ zfs = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + &
+ & sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) &
+ & ) * e12t(:,:) * tmask(:,:,1) * zconv ) - zfs_b
+
+ ! water flux
+ zfw = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + &
+ & wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:) &
+ & ) * e12t(:,:) * tmask(:,:,1) * zconv ) - zfw_b
+
+ ! heat flux
+ zft = glob_sum( ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:) &
+ & - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:) &
+ & ) * e12t(:,:) * tmask(:,:,1) * zconv ) - zft_b
- zvi = ( glob_sum( SUM( v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) - zvi_b ) * r1_rdtice - zfw
- zsmv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zsmv_b ) * r1_rdtice + ( zfs / rhoic )
- zei = glob_sum( SUM( e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) * r1_rdtice - zei_b * r1_rdtice + zft
-
- zvmin = glob_min(v_i)
- zamax = glob_max(SUM(a_i,dim=3))
- zamin = glob_min(a_i)
-
+ ! outputs
+ zvi = ( ( glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 ) &
+ & * e12t * tmask(:,:,1) * zconv ) - zvi_b ) * r1_rdtice - zfw ) * rday
+
+ zsmv = ( ( glob_sum( SUM( smv_i * rhoic , dim=3 ) &
+ & * e12t * tmask(:,:,1) * zconv ) - zsmv_b ) * r1_rdtice + zfs ) * rday
+
+ zei = glob_sum( ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) + &
+ & SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 ) &
+ & ) * e12t * tmask(:,:,1) * zconv ) * r1_rdtice - zei_b * r1_rdtice + zft
+
+ ! zvtrp and zetrp must be close to 0 if the advection scheme is conservative
+ zvtrp = glob_sum( ( diag_trp_vi * rhoic + diag_trp_vs * rhosn ) * e12t * tmask(:,:,1) * zconv ) * rday
+ zetrp = glob_sum( ( diag_trp_ei + diag_trp_es ) * e12t * tmask(:,:,1) * zconv )
+
+ zvmin = glob_min( v_i )
+ zamax = glob_max( SUM( a_i, dim=3 ) )
+ zamin = glob_min( a_i )
+
+ ! set threshold values and calculate the ice area (+epsi10 to set a threshold > 0 when there is no ice)
+ zarea = glob_sum( SUM( a_i + epsi10, dim=3 ) * e12t * zconv ) ! in 1.e9 m2
+ zv_sill = zarea * 2.5e-5
+ zs_sill = zarea * 25.e-5
+ zh_sill = zarea * 10.e-5
+
IF(lwp) THEN
- IF ( ABS( zvi ) > 1.e-4 ) WRITE(numout,*) 'violation volume [kg/day] (',cd_routine,') = ',(zvi * rday)
- IF ( ABS( zsmv ) > 1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (',cd_routine,') = ',(zsmv * rday)
- IF ( ABS( zei ) > 1. ) WRITE(numout,*) 'violation enthalpy [1e9 J] (',cd_routine,') = ',(zei)
- IF ( zvmin < 0. ) WRITE(numout,*) 'violation v_i<0 [m] (',cd_routine,') = ',(zvmin)
- IF( cd_routine /= 'limtrp' .AND. cd_routine /= 'limitd_me' .AND. zamax > amax+1.e-10 ) THEN
- WRITE(numout,*) 'violation a_i>amax (',cd_routine,') = ',zamax
+ IF ( ABS( zvi ) > zv_sill ) WRITE(numout,*) 'violation volume [Mt/day] (',cd_routine,') = ',zvi
+ IF ( ABS( zsmv ) > zs_sill ) WRITE(numout,*) 'violation saline [psu*Mt/day] (',cd_routine,') = ',zsmv
+ IF ( ABS( zei ) > zh_sill ) WRITE(numout,*) 'violation enthalpy [GW] (',cd_routine,') = ',zei
+ IF ( ABS(zvtrp ) > zv_sill .AND. cd_routine == 'limtrp' ) THEN
+ WRITE(numout,*) 'violation vtrp [Mt/day] (',cd_routine,') = ',zvtrp
+ WRITE(numout,*) 'violation etrp [GW] (',cd_routine,') = ',zetrp
ENDIF
- IF ( zamin < 0. ) WRITE(numout,*) 'violation a_i<0 (',cd_routine,') = ',zamin
+ IF ( zvmin < -epsi10 ) WRITE(numout,*) 'violation v_i<0 [m] (',cd_routine,') = ',zvmin
+ IF ( zamax > rn_amax+epsi10 .AND. cd_routine /= 'limtrp' .AND. cd_routine /= 'limitd_me' ) THEN
+ WRITE(numout,*) 'violation a_i>amax (',cd_routine,') = ',zamax
+ ENDIF
+ IF ( zamin < -epsi10 ) WRITE(numout,*) 'violation a_i<0 (',cd_routine,') = ',zamin
ENDIF
@@ -218,4 +265,43 @@
END SUBROUTINE lim_cons_hsm
+
+ SUBROUTINE lim_cons_final( cd_routine )
+ !!---------------------------------------------------------------------------------------------------------
+ !! *** ROUTINE lim_cons_final ***
+ !!
+ !! ** Purpose : Test the conservation of heat, salt and mass at the end of each ice time-step
+ !!
+ !! ** Method : This is an online diagnostics which can be activated with ln_limdiahsb=true
+ !! It prints in ocean.output if there is a violation of conservation at each time-step
+ !! The thresholds (zv_sill, zs_sill, zh_sill) which determine the violation are set to
+ !! a minimum of 1 mm of ice (over the ice area) that is lost/gained spuriously during 100 years.
+ !! For salt and heat thresholds, ice is considered to have a salinity of 10
+ !! and a heat content of 3e5 J/kg (=latent heat of fusion)
+ !!--------------------------------------------------------------------------------------------------------
+ CHARACTER(len=*), INTENT(in) :: cd_routine ! name of the routine
+ REAL(wp) :: zhfx, zsfx, zvfx
+ REAL(wp) :: zarea, zv_sill, zs_sill, zh_sill
+ REAL(wp), PARAMETER :: zconv = 1.e-9 ! convert W to GW and kg to Mt
+
+#if ! defined key_bdy
+ ! heat flux
+ zhfx = glob_sum( ( hfx_in - hfx_out - diag_heat - diag_trp_ei - diag_trp_es - hfx_sub ) * e12t * tmask(:,:,1) * zconv )
+ ! salt flux
+ zsfx = glob_sum( ( sfx + diag_smvi ) * e12t * tmask(:,:,1) * zconv ) * rday
+ ! water flux
+ zvfx = glob_sum( ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + diag_vice + diag_vsnw ) * e12t * tmask(:,:,1) * zconv ) * rday
+
+ ! set threshold values and calculate the ice area (+epsi10 to set a threshold > 0 when there is no ice)
+ zarea = glob_sum( SUM( a_i + epsi10, dim=3 ) * e12t * zconv ) ! in 1.e9 m2
+ zv_sill = zarea * 2.5e-5
+ zs_sill = zarea * 25.e-5
+ zh_sill = zarea * 10.e-5
+
+ IF( ABS( zvfx ) > zv_sill ) WRITE(numout,*) 'violation vfx [Mt/day] (',cd_routine,') = ',(zvfx)
+ IF( ABS( zsfx ) > zs_sill ) WRITE(numout,*) 'violation sfx [psu*Mt/day] (',cd_routine,') = ',(zsfx)
+ IF( ABS( zhfx ) > zh_sill ) WRITE(numout,*) 'violation hfx [GW] (',cd_routine,') = ',(zhfx)
+#endif
+
+ END SUBROUTINE lim_cons_final
#else
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limctl.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limctl.F90 (revision 5602)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limctl.F90 (revision 5602)
@@ -0,0 +1,458 @@
+MODULE limctl
+ !!======================================================================
+ !! *** MODULE limctl ***
+ !! LIM-3 : control and printing
+ !!======================================================================
+ !! History : 3.5 ! 2015-01 (M. Vancoppenolle) Original code
+ !!----------------------------------------------------------------------
+#if defined key_lim3
+ !!----------------------------------------------------------------------
+ !! 'key_lim3' LIM3 sea-ice model
+ !!----------------------------------------------------------------------
+ !! lim_ctl : control prints in case of crash
+ !! lim_prt : ice control print at a given grid point
+ !!----------------------------------------------------------------------
+ USE oce ! ocean dynamics and tracers
+ USE dom_oce ! ocean space and time domain
+ USE ice ! LIM-3: ice variables
+ USE thd_ice ! LIM-3: thermodynamical variables
+ USE dom_ice ! LIM-3: ice domain
+ USE sbc_oce ! Surface boundary condition: ocean fields
+ USE sbc_ice ! Surface boundary condition: ice fields
+
+ USE phycst ! Define parameters for the routines
+
+ USE lib_mpp ! MPP library
+ USE wrk_nemo ! work arrays
+ USE timing ! Timing
+ USE in_out_manager ! I/O manager
+ USE prtctl ! Print control
+ USE lib_fortran !
+
+ IMPLICIT NONE
+ PRIVATE
+
+ PUBLIC lim_ctl
+ PUBLIC lim_prt
+
+ !! * Substitutions
+# include "vectopt_loop_substitute.h90"
+ !!----------------------------------------------------------------------
+ !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
+ !! $Id: limctl.F90 5043 2015-01-28 16:44:18Z clem $
+ !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+ !!----------------------------------------------------------------------
+
+CONTAINS
+
+ SUBROUTINE lim_ctl( kt )
+ !!-----------------------------------------------------------------------
+ !! *** ROUTINE lim_ctl ***
+ !!
+ !! ** Purpose : Alerts in case of model crash
+ !!-------------------------------------------------------------------
+ INTEGER, INTENT(in) :: kt ! ocean time step
+ INTEGER :: ji, jj, jk, jl ! dummy loop indices
+ INTEGER :: inb_altests ! number of alert tests (max 20)
+ INTEGER :: ialert_id ! number of the current alert
+ REAL(wp) :: ztmelts ! ice layer melting point
+ CHARACTER (len=30), DIMENSION(20) :: cl_alname ! name of alert
+ INTEGER , DIMENSION(20) :: inb_alp ! number of alerts positive
+ !!-------------------------------------------------------------------
+
+ inb_altests = 10
+ inb_alp(:) = 0
+
+ ! Alert if incompatible volume and concentration
+ ialert_id = 2 ! reference number of this alert
+ cl_alname(ialert_id) = ' Incompat vol and con ' ! name of the alert
+
+ DO jl = 1, jpl
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ IF( v_i(ji,jj,jl) /= 0._wp .AND. a_i(ji,jj,jl) == 0._wp ) THEN
+ !WRITE(numout,*) ' ALERTE 2 : Incompatible volume and concentration '
+ !WRITE(numout,*) ' at_i ', at_i(ji,jj)
+ !WRITE(numout,*) ' Point - category', ji, jj, jl
+ !WRITE(numout,*) ' a_i *** a_i_b ', a_i (ji,jj,jl), a_i_b (ji,jj,jl)
+ !WRITE(numout,*) ' v_i *** v_i_b ', v_i (ji,jj,jl), v_i_b (ji,jj,jl)
+ inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+ ENDIF
+ END DO
+ END DO
+ END DO
+
+ ! Alerte if very thick ice
+ ialert_id = 3 ! reference number of this alert
+ cl_alname(ialert_id) = ' Very thick ice ' ! name of the alert
+ jl = jpl
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ IF( ht_i(ji,jj,jl) > 50._wp ) THEN
+ !CALL lim_prt( kt, ji, jj, 2, ' ALERTE 3 : Very thick ice ' )
+ inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+ ENDIF
+ END DO
+ END DO
+
+ ! Alert if very fast ice
+ ialert_id = 4 ! reference number of this alert
+ cl_alname(ialert_id) = ' Very fast ice ' ! name of the alert
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ IF( MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 1.5 .AND. &
+ & at_i(ji,jj) > 0._wp ) THEN
+ !CALL lim_prt( kt, ji, jj, 1, ' ALERTE 4 : Very fast ice ' )
+ !WRITE(numout,*) ' ice strength : ', strength(ji,jj)
+ !WRITE(numout,*) ' oceanic stress utau : ', utau(ji,jj)
+ !WRITE(numout,*) ' oceanic stress vtau : ', vtau(ji,jj)
+ !WRITE(numout,*) ' sea-ice stress utau_ice : ', utau_ice(ji,jj)
+ !WRITE(numout,*) ' sea-ice stress vtau_ice : ', vtau_ice(ji,jj)
+ !WRITE(numout,*) ' oceanic speed u : ', u_oce(ji,jj)
+ !WRITE(numout,*) ' oceanic speed v : ', v_oce(ji,jj)
+ !WRITE(numout,*) ' sst : ', sst_m(ji,jj)
+ !WRITE(numout,*) ' sss : ', sss_m(ji,jj)
+ !WRITE(numout,*)
+ inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+ ENDIF
+ END DO
+ END DO
+
+ ! Alert if there is ice on continents
+ ialert_id = 6 ! reference number of this alert
+ cl_alname(ialert_id) = ' Ice on continents ' ! name of the alert
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ IF( tmask(ji,jj,1) <= 0._wp .AND. at_i(ji,jj) > 0._wp ) THEN
+ !CALL lim_prt( kt, ji, jj, 1, ' ALERTE 6 : Ice on continents ' )
+ !WRITE(numout,*) ' masks s, u, v : ', tmask(ji,jj,1), umask(ji,jj,1), vmask(ji,jj,1)
+ !WRITE(numout,*) ' sst : ', sst_m(ji,jj)
+ !WRITE(numout,*) ' sss : ', sss_m(ji,jj)
+ !WRITE(numout,*) ' at_i(ji,jj) : ', at_i(ji,jj)
+ !WRITE(numout,*) ' v_ice(ji,jj) : ', v_ice(ji,jj)
+ !WRITE(numout,*) ' v_ice(ji,jj-1) : ', v_ice(ji,jj-1)
+ !WRITE(numout,*) ' u_ice(ji-1,jj) : ', u_ice(ji-1,jj)
+ !WRITE(numout,*) ' u_ice(ji,jj) : ', v_ice(ji,jj)
+ !
+ inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+ ENDIF
+ END DO
+ END DO
+
+!
+! ! Alert if very fresh ice
+ ialert_id = 7 ! reference number of this alert
+ cl_alname(ialert_id) = ' Very fresh ice ' ! name of the alert
+ DO jl = 1, jpl
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ IF( sm_i(ji,jj,jl) < 0.1 .AND. a_i(ji,jj,jl) > 0._wp ) THEN
+! CALL lim_prt(kt,ji,jj,1, ' ALERTE 7 : Very fresh ice ' )
+! WRITE(numout,*) ' sst : ', sst_m(ji,jj)
+! WRITE(numout,*) ' sss : ', sss_m(ji,jj)
+! WRITE(numout,*)
+ inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+ ENDIF
+ END DO
+ END DO
+ END DO
+!
+
+! ! Alert if too old ice
+ ialert_id = 9 ! reference number of this alert
+ cl_alname(ialert_id) = ' Very old ice ' ! name of the alert
+ DO jl = 1, jpl
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ IF ( ( ( ABS( o_i(ji,jj,jl) ) > rdt_ice ) .OR. &
+ ( ABS( o_i(ji,jj,jl) ) < 0._wp) ) .AND. &
+ ( a_i(ji,jj,jl) > 0._wp ) ) THEN
+ !CALL lim_prt( kt, ji, jj, 1, ' ALERTE 9 : Wrong ice age ')
+ inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+ ENDIF
+ END DO
+ END DO
+ END DO
+
+ ! Alert on salt flux
+ ialert_id = 5 ! reference number of this alert
+ cl_alname(ialert_id) = ' High salt flux ' ! name of the alert
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ IF( ABS( sfx (ji,jj) ) > 1.0e-2 ) THEN ! = 1 psu/day for 1m ocean depth
+ !CALL lim_prt( kt, ji, jj, 3, ' ALERTE 5 : High salt flux ' )
+ !DO jl = 1, jpl
+ !WRITE(numout,*) ' Category no: ', jl
+ !WRITE(numout,*) ' a_i : ', a_i (ji,jj,jl) , ' a_i_b : ', a_i_b (ji,jj,jl)
+ !WRITE(numout,*) ' v_i : ', v_i (ji,jj,jl) , ' v_i_b : ', v_i_b (ji,jj,jl)
+ !WRITE(numout,*) ' '
+ !END DO
+ inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+ ENDIF
+ END DO
+ END DO
+
+ ! Alert if qns very big
+ ialert_id = 8 ! reference number of this alert
+ cl_alname(ialert_id) = ' fnsolar very big ' ! name of the alert
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ IF( ABS( qns(ji,jj) ) > 1500._wp .AND. at_i(ji,jj) > 0._wp ) THEN
+ !
+ !WRITE(numout,*) ' ALERTE 8 : Very high non-solar heat flux'
+ !WRITE(numout,*) ' ji, jj : ', ji, jj
+ !WRITE(numout,*) ' qns : ', qns(ji,jj)
+ !WRITE(numout,*) ' sst : ', sst_m(ji,jj)
+ !WRITE(numout,*) ' sss : ', sss_m(ji,jj)
+ !
+ !CALL lim_prt( kt, ji, jj, 2, ' ')
+ inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+ !
+ ENDIF
+ END DO
+ END DO
+ !+++++
+
+ ! Alert if very warm ice
+ ialert_id = 10 ! reference number of this alert
+ cl_alname(ialert_id) = ' Very warm ice ' ! name of the alert
+ inb_alp(ialert_id) = 0
+ DO jl = 1, jpl
+ DO jk = 1, nlay_i
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ ztmelts = -tmut * s_i(ji,jj,jk,jl) + rt0
+ IF( t_i(ji,jj,jk,jl) >= ztmelts .AND. v_i(ji,jj,jl) > 1.e-10 &
+ & .AND. a_i(ji,jj,jl) > 0._wp ) THEN
+ !WRITE(numout,*) ' ALERTE 10 : Very warm ice'
+ !WRITE(numout,*) ' ji, jj, jk, jl : ', ji, jj, jk, jl
+ !WRITE(numout,*) ' t_i : ', t_i(ji,jj,jk,jl)
+ !WRITE(numout,*) ' e_i : ', e_i(ji,jj,jk,jl)
+ !WRITE(numout,*) ' s_i : ', s_i(ji,jj,jk,jl)
+ !WRITE(numout,*) ' ztmelts : ', ztmelts
+ inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+ ENDIF
+ END DO
+ END DO
+ END DO
+ END DO
+
+ ! sum of the alerts on all processors
+ IF( lk_mpp ) THEN
+ DO ialert_id = 1, inb_altests
+ CALL mpp_sum(inb_alp(ialert_id))
+ END DO
+ ENDIF
+
+ ! print alerts
+ IF( lwp ) THEN
+ ialert_id = 1 ! reference number of this alert
+ cl_alname(ialert_id) = ' NO alerte 1 ' ! name of the alert
+ WRITE(numout,*) ' time step ',kt
+ WRITE(numout,*) ' All alerts at the end of ice model '
+ DO ialert_id = 1, inb_altests
+ WRITE(numout,*) ialert_id, cl_alname(ialert_id)//' : ', inb_alp(ialert_id), ' times ! '
+ END DO
+ ENDIF
+ !
+ END SUBROUTINE lim_ctl
+
+
+ SUBROUTINE lim_prt( kt, ki, kj, kn, cd1 )
+ !!-----------------------------------------------------------------------
+ !! *** ROUTINE lim_prt ***
+ !!
+ !! ** Purpose : Writes global ice state on the (i,j) point
+ !! in ocean.ouput
+ !! 3 possibilities exist
+ !! n = 1/-1 -> simple ice state (plus Mechanical Check if -1)
+ !! n = 2 -> exhaustive state
+ !! n = 3 -> ice/ocean salt fluxes
+ !!
+ !! ** input : point coordinates (i,j)
+ !! n : number of the option
+ !!-------------------------------------------------------------------
+ INTEGER , INTENT(in) :: kt ! ocean time step
+ INTEGER , INTENT(in) :: ki, kj, kn ! ocean gridpoint indices
+ CHARACTER(len=*), INTENT(in) :: cd1 !
+ !!
+ INTEGER :: jl, ji, jj
+ !!-------------------------------------------------------------------
+
+ DO ji = mi0(ki), mi1(ki)
+ DO jj = mj0(kj), mj1(kj)
+
+ WRITE(numout,*) ' time step ',kt,' ',cd1 ! print title
+
+ !----------------
+ ! Simple state
+ !----------------
+
+ IF ( kn == 1 .OR. kn == -1 ) THEN
+ WRITE(numout,*) ' lim_prt - Point : ',ji,jj
+ WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
+ WRITE(numout,*) ' Simple state '
+ WRITE(numout,*) ' masks s,u,v : ', tmask(ji,jj,1), umask(ji,jj,1), vmask(ji,jj,1)
+ WRITE(numout,*) ' lat - long : ', gphit(ji,jj), glamt(ji,jj)
+ WRITE(numout,*) ' Time step : ', numit
+ WRITE(numout,*) ' - Ice drift '
+ WRITE(numout,*) ' ~~~~~~~~~~~ '
+ WRITE(numout,*) ' u_ice(i-1,j) : ', u_ice(ji-1,jj)
+ WRITE(numout,*) ' u_ice(i ,j) : ', u_ice(ji,jj)
+ WRITE(numout,*) ' v_ice(i ,j-1): ', v_ice(ji,jj-1)
+ WRITE(numout,*) ' v_ice(i ,j) : ', v_ice(ji,jj)
+ WRITE(numout,*) ' strength : ', strength(ji,jj)
+ WRITE(numout,*)
+ WRITE(numout,*) ' - Cell values '
+ WRITE(numout,*) ' ~~~~~~~~~~~ '
+ WRITE(numout,*) ' cell area : ', e12t(ji,jj)
+ WRITE(numout,*) ' at_i : ', at_i(ji,jj)
+ WRITE(numout,*) ' vt_i : ', vt_i(ji,jj)
+ WRITE(numout,*) ' vt_s : ', vt_s(ji,jj)
+ DO jl = 1, jpl
+ WRITE(numout,*) ' - Category (', jl,')'
+ WRITE(numout,*) ' a_i : ', a_i(ji,jj,jl)
+ WRITE(numout,*) ' ht_i : ', ht_i(ji,jj,jl)
+ WRITE(numout,*) ' ht_s : ', ht_s(ji,jj,jl)
+ WRITE(numout,*) ' v_i : ', v_i(ji,jj,jl)
+ WRITE(numout,*) ' v_s : ', v_s(ji,jj,jl)
+ WRITE(numout,*) ' e_s : ', e_s(ji,jj,1,jl)
+ WRITE(numout,*) ' e_i : ', e_i(ji,jj,1:nlay_i,jl)
+ WRITE(numout,*) ' t_su : ', t_su(ji,jj,jl)
+ WRITE(numout,*) ' t_snow : ', t_s(ji,jj,1,jl)
+ WRITE(numout,*) ' t_i : ', t_i(ji,jj,1:nlay_i,jl)
+ WRITE(numout,*) ' sm_i : ', sm_i(ji,jj,jl)
+ WRITE(numout,*) ' smv_i : ', smv_i(ji,jj,jl)
+ WRITE(numout,*)
+ END DO
+ ENDIF
+ IF( kn == -1 ) THEN
+ WRITE(numout,*) ' Mechanical Check ************** '
+ WRITE(numout,*) ' Check what means ice divergence '
+ WRITE(numout,*) ' Total ice concentration ', at_i (ji,jj)
+ WRITE(numout,*) ' Total lead fraction ', ato_i(ji,jj)
+ WRITE(numout,*) ' Sum of both ', ato_i(ji,jj) + at_i(ji,jj)
+ WRITE(numout,*) ' Sum of both minus 1 ', ato_i(ji,jj) + at_i(ji,jj) - 1.00
+ ENDIF
+
+
+ !--------------------
+ ! Exhaustive state
+ !--------------------
+
+ IF ( kn .EQ. 2 ) THEN
+ WRITE(numout,*) ' lim_prt - Point : ',ji,jj
+ WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
+ WRITE(numout,*) ' Exhaustive state '
+ WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj)
+ WRITE(numout,*) ' Time step ', numit
+ WRITE(numout,*)
+ WRITE(numout,*) ' - Cell values '
+ WRITE(numout,*) ' ~~~~~~~~~~~ '
+ WRITE(numout,*) ' cell area : ', e12t(ji,jj)
+ WRITE(numout,*) ' at_i : ', at_i(ji,jj)
+ WRITE(numout,*) ' vt_i : ', vt_i(ji,jj)
+ WRITE(numout,*) ' vt_s : ', vt_s(ji,jj)
+ WRITE(numout,*) ' u_ice(i-1,j) : ', u_ice(ji-1,jj)
+ WRITE(numout,*) ' u_ice(i ,j) : ', u_ice(ji,jj)
+ WRITE(numout,*) ' v_ice(i ,j-1): ', v_ice(ji,jj-1)
+ WRITE(numout,*) ' v_ice(i ,j) : ', v_ice(ji,jj)
+ WRITE(numout,*) ' strength : ', strength(ji,jj)
+ WRITE(numout,*) ' u_ice_b : ', u_ice_b(ji,jj) , ' v_ice_b : ', v_ice_b(ji,jj)
+ WRITE(numout,*)
+
+ DO jl = 1, jpl
+ WRITE(numout,*) ' - Category (',jl,')'
+ WRITE(numout,*) ' ~~~~~~~~ '
+ WRITE(numout,*) ' ht_i : ', ht_i(ji,jj,jl) , ' ht_s : ', ht_s(ji,jj,jl)
+ WRITE(numout,*) ' t_i : ', t_i(ji,jj,1:nlay_i,jl)
+ WRITE(numout,*) ' t_su : ', t_su(ji,jj,jl) , ' t_s : ', t_s(ji,jj,1,jl)
+ WRITE(numout,*) ' sm_i : ', sm_i(ji,jj,jl) , ' o_i : ', o_i(ji,jj,jl)
+ WRITE(numout,*) ' a_i : ', a_i(ji,jj,jl) , ' a_i_b : ', a_i_b(ji,jj,jl)
+ WRITE(numout,*) ' v_i : ', v_i(ji,jj,jl) , ' v_i_b : ', v_i_b(ji,jj,jl)
+ WRITE(numout,*) ' v_s : ', v_s(ji,jj,jl) , ' v_s_b : ', v_s_b(ji,jj,jl)
+ WRITE(numout,*) ' e_i1 : ', e_i(ji,jj,1,jl) , ' ei1 : ', e_i_b(ji,jj,1,jl)
+ WRITE(numout,*) ' e_i2 : ', e_i(ji,jj,2,jl) , ' ei2_b : ', e_i_b(ji,jj,2,jl)
+ WRITE(numout,*) ' e_snow : ', e_s(ji,jj,1,jl) , ' e_snow_b : ', e_s_b(ji,jj,1,jl)
+ WRITE(numout,*) ' smv_i : ', smv_i(ji,jj,jl) , ' smv_i_b : ', smv_i_b(ji,jj,jl)
+ WRITE(numout,*) ' oa_i : ', oa_i(ji,jj,jl) , ' oa_i_b : ', oa_i_b(ji,jj,jl)
+ END DO !jl
+
+ WRITE(numout,*)
+ WRITE(numout,*) ' - Heat / FW fluxes '
+ WRITE(numout,*) ' ~~~~~~~~~~~~~~~~ '
+ WRITE(numout,*) ' - Heat fluxes in and out the ice ***'
+ WRITE(numout,*) ' qsr_ini : ', pfrld(ji,jj) * qsr(ji,jj) + SUM( a_i_b(ji,jj,:) * qsr_ice(ji,jj,:) )
+ WRITE(numout,*) ' qns_ini : ', pfrld(ji,jj) * qns(ji,jj) + SUM( a_i_b(ji,jj,:) * qns_ice(ji,jj,:) )
+ WRITE(numout,*)
+ WRITE(numout,*)
+ WRITE(numout,*) ' sst : ', sst_m(ji,jj)
+ WRITE(numout,*) ' sss : ', sss_m(ji,jj)
+ WRITE(numout,*)
+ WRITE(numout,*) ' - Stresses '
+ WRITE(numout,*) ' ~~~~~~~~ '
+ WRITE(numout,*) ' utau_ice : ', utau_ice(ji,jj)
+ WRITE(numout,*) ' vtau_ice : ', vtau_ice(ji,jj)
+ WRITE(numout,*) ' utau : ', utau (ji,jj)
+ WRITE(numout,*) ' vtau : ', vtau (ji,jj)
+ WRITE(numout,*) ' oc. vel. u : ', u_oce (ji,jj)
+ WRITE(numout,*) ' oc. vel. v : ', v_oce (ji,jj)
+ ENDIF
+
+ !---------------------
+ ! Salt / heat fluxes
+ !---------------------
+
+ IF ( kn .EQ. 3 ) THEN
+ WRITE(numout,*) ' lim_prt - Point : ',ji,jj
+ WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
+ WRITE(numout,*) ' - Salt / Heat Fluxes '
+ WRITE(numout,*) ' ~~~~~~~~~~~~~~~~ '
+ WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj)
+ WRITE(numout,*) ' Time step ', numit
+ WRITE(numout,*)
+ WRITE(numout,*) ' - Heat fluxes at bottom interface ***'
+ WRITE(numout,*) ' qsr : ', qsr(ji,jj)
+ WRITE(numout,*) ' qns : ', qns(ji,jj)
+ WRITE(numout,*)
+ WRITE(numout,*) ' hfx_mass : ', hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_snw(ji,jj) + hfx_res(ji,jj)
+ WRITE(numout,*) ' hfx_in : ', hfx_in(ji,jj)
+ WRITE(numout,*) ' hfx_out : ', hfx_out(ji,jj)
+ WRITE(numout,*) ' dhc : ', diag_heat(ji,jj)
+ WRITE(numout,*)
+ WRITE(numout,*) ' hfx_dyn : ', hfx_dyn(ji,jj)
+ WRITE(numout,*) ' hfx_thd : ', hfx_thd(ji,jj)
+ WRITE(numout,*) ' hfx_res : ', hfx_res(ji,jj)
+ WRITE(numout,*) ' fhtur : ', fhtur(ji,jj)
+ WRITE(numout,*) ' qlead : ', qlead(ji,jj) * r1_rdtice
+ WRITE(numout,*)
+ WRITE(numout,*) ' - Salt fluxes at bottom interface ***'
+ WRITE(numout,*) ' emp : ', emp (ji,jj)
+ WRITE(numout,*) ' sfx : ', sfx (ji,jj)
+ WRITE(numout,*) ' sfx_res : ', sfx_res(ji,jj)
+ WRITE(numout,*) ' sfx_bri : ', sfx_bri(ji,jj)
+ WRITE(numout,*) ' sfx_dyn : ', sfx_dyn(ji,jj)
+ WRITE(numout,*)
+ WRITE(numout,*) ' - Momentum fluxes '
+ WRITE(numout,*) ' utau : ', utau(ji,jj)
+ WRITE(numout,*) ' vtau : ', vtau(ji,jj)
+ ENDIF
+ WRITE(numout,*) ' '
+ !
+ END DO
+ END DO
+ !
+ END SUBROUTINE lim_prt
+
+#else
+ !!--------------------------------------------------------------------------
+ !! Default option Empty Module No LIM3 sea-ice model
+ !!--------------------------------------------------------------------------
+CONTAINS
+ SUBROUTINE lim_ctl ! Empty routine
+ END SUBROUTINE lim_ctl
+ SUBROUTINE lim_prt ! Empty routine
+ END SUBROUTINE lim_prt
+#endif
+ !!======================================================================
+END MODULE limctl
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90 (revision 5602)
@@ -14,5 +14,4 @@
!!----------------------------------------------------------------------
USE ice ! LIM-3: sea-ice variable
- USE par_ice ! LIM-3: ice parameters
USE dom_ice ! LIM-3: sea-ice domain
USE dom_oce ! ocean domain
@@ -32,6 +31,4 @@
PUBLIC lim_diahsb ! routine called by ice_step.F90
- !!PUBLIC lim_diahsb_init ! routine called by ice_init.F90
- !!PUBLIC lim_diahsb_rst ! routine called by ice_init.F90
real(wp) :: frc_sal, frc_vol ! global forcing trends
@@ -43,5 +40,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.4 , NEMO Consortium (2012)
- !! $Id: limdiahsb.F90 3294 2012-10-18 16:44:18Z rblod $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
@@ -74,71 +71,72 @@
! 1/area
- z1_area = 1._wp / MAX( glob_sum( area(:,:) * tms(:,:) ), epsi06 )
-
- rswitch = MAX( 0._wp , SIGN( 1._wp , glob_sum( area(:,:) * tms(:,:) ) - epsi06 ) )
+ z1_area = 1._wp / MAX( glob_sum( e12t(:,:) * tmask(:,:,1) ), epsi06 )
+
+ rswitch = MAX( 0._wp , SIGN( 1._wp , glob_sum( e12t(:,:) * tmask(:,:,1) ) - epsi06 ) )
! ----------------------- !
! 1 - Content variations !
! ----------------------- !
- zbg_ivo = glob_sum( vt_i(:,:) * area(:,:) * tms(:,:) ) ! volume ice
- zbg_svo = glob_sum( vt_s(:,:) * area(:,:) * tms(:,:) ) ! volume snow
- zbg_are = glob_sum( at_i(:,:) * area(:,:) * tms(:,:) ) ! area
- zbg_sal = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) ! mean salt content
- zbg_tem = glob_sum( ( tm_i(:,:) - rtt ) * vt_i(:,:) * area(:,:) * tms(:,:) ) ! mean temp content
-
- !zbg_ihc = glob_sum( et_i(:,:) * area(:,:) * tms(:,:) ) / MAX( zbg_ivo,epsi06 ) ! ice heat content
- !zbg_shc = glob_sum( et_s(:,:) * area(:,:) * tms(:,:) ) / MAX( zbg_svo,epsi06 ) ! snow heat content
+ zbg_ivo = glob_sum( vt_i(:,:) * e12t(:,:) * tmask(:,:,1) ) ! volume ice
+ zbg_svo = glob_sum( vt_s(:,:) * e12t(:,:) * tmask(:,:,1) ) ! volume snow
+ zbg_are = glob_sum( at_i(:,:) * e12t(:,:) * tmask(:,:,1) ) ! area
+ zbg_sal = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * e12t(:,:) * tmask(:,:,1) ) ! mean salt content
+ zbg_tem = glob_sum( ( tm_i(:,:) - rt0 ) * vt_i(:,:) * e12t(:,:) * tmask(:,:,1) ) ! mean temp content
+
+ !zbg_ihc = glob_sum( et_i(:,:) * e12t(:,:) * tmask(:,:,1) ) / MAX( zbg_ivo,epsi06 ) ! ice heat content
+ !zbg_shc = glob_sum( et_s(:,:) * e12t(:,:) * tmask(:,:,1) ) / MAX( zbg_svo,epsi06 ) ! snow heat content
! Volume
ztmp = rswitch * z1_area * r1_rau0 * rday
- zbg_vfx = ztmp * glob_sum( emp(:,:) * area(:,:) * tms(:,:) )
- zbg_vfx_bog = ztmp * glob_sum( wfx_bog(:,:) * area(:,:) * tms(:,:) )
- zbg_vfx_opw = ztmp * glob_sum( wfx_opw(:,:) * area(:,:) * tms(:,:) )
- zbg_vfx_sni = ztmp * glob_sum( wfx_sni(:,:) * area(:,:) * tms(:,:) )
- zbg_vfx_dyn = ztmp * glob_sum( wfx_dyn(:,:) * area(:,:) * tms(:,:) )
- zbg_vfx_bom = ztmp * glob_sum( wfx_bom(:,:) * area(:,:) * tms(:,:) )
- zbg_vfx_sum = ztmp * glob_sum( wfx_sum(:,:) * area(:,:) * tms(:,:) )
- zbg_vfx_res = ztmp * glob_sum( wfx_res(:,:) * area(:,:) * tms(:,:) )
- zbg_vfx_spr = ztmp * glob_sum( wfx_spr(:,:) * area(:,:) * tms(:,:) )
- zbg_vfx_snw = ztmp * glob_sum( wfx_snw(:,:) * area(:,:) * tms(:,:) )
- zbg_vfx_sub = ztmp * glob_sum( wfx_sub(:,:) * area(:,:) * tms(:,:) )
+ zbg_vfx = ztmp * glob_sum( emp(:,:) * e12t(:,:) * tmask(:,:,1) )
+ zbg_vfx_bog = ztmp * glob_sum( wfx_bog(:,:) * e12t(:,:) * tmask(:,:,1) )
+ zbg_vfx_opw = ztmp * glob_sum( wfx_opw(:,:) * e12t(:,:) * tmask(:,:,1) )
+ zbg_vfx_sni = ztmp * glob_sum( wfx_sni(:,:) * e12t(:,:) * tmask(:,:,1) )
+ zbg_vfx_dyn = ztmp * glob_sum( wfx_dyn(:,:) * e12t(:,:) * tmask(:,:,1) )
+ zbg_vfx_bom = ztmp * glob_sum( wfx_bom(:,:) * e12t(:,:) * tmask(:,:,1) )
+ zbg_vfx_sum = ztmp * glob_sum( wfx_sum(:,:) * e12t(:,:) * tmask(:,:,1) )
+ zbg_vfx_res = ztmp * glob_sum( wfx_res(:,:) * e12t(:,:) * tmask(:,:,1) )
+ zbg_vfx_spr = ztmp * glob_sum( wfx_spr(:,:) * e12t(:,:) * tmask(:,:,1) )
+ zbg_vfx_snw = ztmp * glob_sum( wfx_snw(:,:) * e12t(:,:) * tmask(:,:,1) )
+ zbg_vfx_sub = ztmp * glob_sum( wfx_sub(:,:) * e12t(:,:) * tmask(:,:,1) )
! Salt
- zbg_sfx = ztmp * glob_sum( sfx(:,:) * area(:,:) * tms(:,:) )
- zbg_sfx_bri = ztmp * glob_sum( sfx_bri(:,:) * area(:,:) * tms(:,:) )
- zbg_sfx_res = ztmp * glob_sum( sfx_res(:,:) * area(:,:) * tms(:,:) )
- zbg_sfx_dyn = ztmp * glob_sum( sfx_dyn(:,:) * area(:,:) * tms(:,:) )
-
- zbg_sfx_bog = ztmp * glob_sum( sfx_bog(:,:) * area(:,:) * tms(:,:) )
- zbg_sfx_opw = ztmp * glob_sum( sfx_opw(:,:) * area(:,:) * tms(:,:) )
- zbg_sfx_sni = ztmp * glob_sum( sfx_sni(:,:) * area(:,:) * tms(:,:) )
- zbg_sfx_bom = ztmp * glob_sum( sfx_bom(:,:) * area(:,:) * tms(:,:) )
- zbg_sfx_sum = ztmp * glob_sum( sfx_sum(:,:) * area(:,:) * tms(:,:) )
+ zbg_sfx = ztmp * glob_sum( sfx(:,:) * e12t(:,:) * tmask(:,:,1) )
+ zbg_sfx_bri = ztmp * glob_sum( sfx_bri(:,:) * e12t(:,:) * tmask(:,:,1) )
+ zbg_sfx_res = ztmp * glob_sum( sfx_res(:,:) * e12t(:,:) * tmask(:,:,1) )
+ zbg_sfx_dyn = ztmp * glob_sum( sfx_dyn(:,:) * e12t(:,:) * tmask(:,:,1) )
+
+ zbg_sfx_bog = ztmp * glob_sum( sfx_bog(:,:) * e12t(:,:) * tmask(:,:,1) )
+ zbg_sfx_opw = ztmp * glob_sum( sfx_opw(:,:) * e12t(:,:) * tmask(:,:,1) )
+ zbg_sfx_sni = ztmp * glob_sum( sfx_sni(:,:) * e12t(:,:) * tmask(:,:,1) )
+ zbg_sfx_bom = ztmp * glob_sum( sfx_bom(:,:) * e12t(:,:) * tmask(:,:,1) )
+ zbg_sfx_sum = ztmp * glob_sum( sfx_sum(:,:) * e12t(:,:) * tmask(:,:,1) )
! Heat budget
- zbg_ihc = glob_sum( et_i(:,:) * 1.e-20 ) ! ice heat content [1.e-20 J]
- zbg_shc = glob_sum( et_s(:,:) * 1.e-20 ) ! snow heat content [1.e-20 J]
- zbg_hfx_dhc = glob_sum( diag_heat_dhc(:,:) * area(:,:) * tms(:,:) ) ! [in W]
- zbg_hfx_spr = glob_sum( hfx_spr(:,:) * area(:,:) * tms(:,:) ) ! [in W]
-
- zbg_hfx_thd = glob_sum( hfx_thd(:,:) * area(:,:) * tms(:,:) ) ! [in W]
- zbg_hfx_dyn = glob_sum( hfx_dyn(:,:) * area(:,:) * tms(:,:) ) ! [in W]
- zbg_hfx_res = glob_sum( hfx_res(:,:) * area(:,:) * tms(:,:) ) ! [in W]
- zbg_hfx_sub = glob_sum( hfx_sub(:,:) * area(:,:) * tms(:,:) ) ! [in W]
- zbg_hfx_snw = glob_sum( hfx_snw(:,:) * area(:,:) * tms(:,:) ) ! [in W]
- zbg_hfx_sum = glob_sum( hfx_sum(:,:) * area(:,:) * tms(:,:) ) ! [in W]
- zbg_hfx_bom = glob_sum( hfx_bom(:,:) * area(:,:) * tms(:,:) ) ! [in W]
- zbg_hfx_bog = glob_sum( hfx_bog(:,:) * area(:,:) * tms(:,:) ) ! [in W]
- zbg_hfx_dif = glob_sum( hfx_dif(:,:) * area(:,:) * tms(:,:) ) ! [in W]
- zbg_hfx_opw = glob_sum( hfx_opw(:,:) * area(:,:) * tms(:,:) ) ! [in W]
- zbg_hfx_out = glob_sum( hfx_out(:,:) * area(:,:) * tms(:,:) ) ! [in W]
- zbg_hfx_in = glob_sum( hfx_in(:,:) * area(:,:) * tms(:,:) ) ! [in W]
+ zbg_ihc = glob_sum( et_i(:,:) * e12t(:,:) * 1.e-20 ) ! ice heat content [1.e20 J]
+ zbg_shc = glob_sum( et_s(:,:) * e12t(:,:) * 1.e-20 ) ! snow heat content [1.e20 J]
+ zbg_hfx_dhc = glob_sum( diag_heat(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
+ zbg_hfx_spr = glob_sum( hfx_spr(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
+
+ zbg_hfx_thd = glob_sum( hfx_thd(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
+ zbg_hfx_dyn = glob_sum( hfx_dyn(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
+ zbg_hfx_res = glob_sum( hfx_res(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
+ zbg_hfx_sub = glob_sum( hfx_sub(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
+ zbg_hfx_snw = glob_sum( hfx_snw(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
+ zbg_hfx_sum = glob_sum( hfx_sum(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
+ zbg_hfx_bom = glob_sum( hfx_bom(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
+ zbg_hfx_bog = glob_sum( hfx_bog(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
+ zbg_hfx_dif = glob_sum( hfx_dif(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
+ zbg_hfx_opw = glob_sum( hfx_opw(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
+ zbg_hfx_out = glob_sum( hfx_out(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
+ zbg_hfx_in = glob_sum( hfx_in(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]
! --------------------------------------------- !
! 2 - Trends due to forcing and ice growth/melt !
! --------------------------------------------- !
- z_frc_vol = r1_rau0 * glob_sum( - emp(:,:) * area(:,:) * tms(:,:) ) ! volume fluxes
- z_frc_sal = r1_rau0 * glob_sum( sfx(:,:) * area(:,:) * tms(:,:) ) ! salt fluxes
+ z_frc_vol = r1_rau0 * glob_sum( - emp(:,:) * e12t(:,:) * tmask(:,:,1) ) ! volume fluxes
+ z_frc_sal = r1_rau0 * glob_sum( sfx(:,:) * e12t(:,:) * tmask(:,:,1) ) ! salt fluxes
z_bg_grme = glob_sum( - ( wfx_bog(:,:) + wfx_opw(:,:) + wfx_sni(:,:) + wfx_dyn(:,:) + &
- & wfx_bom(:,:) + wfx_sum(:,:) + wfx_res(:,:) + wfx_snw(:,:) + wfx_sub(:,:) ) * area(:,:) * tms(:,:) ) ! volume fluxes
+ & wfx_bom(:,:) + wfx_sum(:,:) + wfx_res(:,:) + wfx_snw(:,:) + &
+ & wfx_sub(:,:) ) * e12t(:,:) * tmask(:,:,1) ) ! volume fluxes
!
frc_vol = frc_vol + z_frc_vol * rdt_ice
@@ -247,11 +245,4 @@
WRITE(numout,*) '~~~~~~~~~~~~'
ENDIF
-
- ! ---------------------------------- !
- ! 2 - initial conservation variables !
- ! ---------------------------------- !
- !frc_vol = 0._wp ! volume trend due to forcing
- !frc_sal = 0._wp ! salt content - - - -
- !bg_grme = 0._wp ! ice growth + melt volume trend
!
CALL lim_diahsb_rst( nstart, 'READ' ) !* read or initialize all required files
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90 (revision 5602)
@@ -6,5 +6,5 @@
!! history : 1.0 ! 2002-08 (C. Ethe, G. Madec) original VP code
!! 3.0 ! 2007-03 (MA Morales Maqueda, S. Bouillon, M. Vancoppenolle) LIM3: EVP-Cgrid
- !! 4.0 ! 2011-02 (G. Madec) dynamical allocation
+ !! 3.5 ! 2011-02 (G. Madec) dynamical allocation
!!----------------------------------------------------------------------
#if defined key_lim3
@@ -20,5 +20,4 @@
USE sbc_ice ! Surface boundary condition: ice fields
USE ice ! LIM-3 variables
- USE par_ice ! LIM-3 parameters
USE dom_ice ! LIM-3 domain
USE limrhg ! LIM-3 rheology
@@ -31,4 +30,5 @@
USE timing ! Timing
USE limcons ! conservation tests
+ USE limvar
IMPLICIT NONE
@@ -76,4 +76,6 @@
CALL wrk_alloc( jpj, zswitch, zmsk )
+ CALL lim_var_agg(1) ! aggregate ice categories
+
IF( kt == nit000 ) CALL lim_dyn_init ! Initialization (first time-step only)
@@ -83,6 +85,6 @@
IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
- u_ice_b(:,:) = u_ice(:,:) * tmu(:,:)
- v_ice_b(:,:) = v_ice(:,:) * tmv(:,:)
+ u_ice_b(:,:) = u_ice(:,:) * umask(:,:,1)
+ v_ice_b(:,:) = v_ice(:,:) * vmask(:,:,1)
! Rheology (ice dynamics)
@@ -101,5 +103,5 @@
DO jj = 1, jpj
zswitch(jj) = SUM( 1.0 - at_i(:,jj) ) ! = REAL(jpj) if ocean everywhere on a j-line
- zmsk(jj) = SUM( tmask(:,jj,1) ) ! = 0 if land everywhere on a j-line
+ zmsk (jj) = SUM( tmask(:,jj,1) ) ! = 0 if land everywhere on a j-line
END DO
@@ -157,9 +159,9 @@
zv_io(:,:) = v_ice(:,:) - ssv_m(:,:)
! frictional velocity at T-point
- zcoef = 0.5_wp * cw
+ zcoef = 0.5_wp * rn_cio
DO jj = 2, jpjm1
DO ji = fs_2, fs_jpim1 ! vector opt.
ust2s(ji,jj) = zcoef * ( zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj) &
- & + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) * tms(ji,jj)
+ & + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) * tmask(ji,jj,1)
END DO
END DO
@@ -170,9 +172,9 @@
ELSE ! no ice dynamics : transmit directly the atmospheric stress to the ocean
!
- zcoef = SQRT( 0.5_wp ) / rau0
+ zcoef = SQRT( 0.5_wp ) * r1_rau0
DO jj = 2, jpjm1
DO ji = fs_2, fs_jpim1 ! vector opt.
ust2s(ji,jj) = zcoef * SQRT( utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj) &
- & + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) * tms(ji,jj)
+ & + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) * tmask(ji,jj,1)
END DO
END DO
@@ -189,5 +191,5 @@
CALL prt_ctl(tab2d_1=delta_i , clinfo1=' lim_dyn : delta_i :')
CALL prt_ctl(tab2d_1=strength , clinfo1=' lim_dyn : strength :')
- CALL prt_ctl(tab2d_1=area , clinfo1=' lim_dyn : cell area :')
+ CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_dyn : cell area :')
CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_dyn : at_i :')
CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_dyn : vt_i :')
@@ -241,7 +243,8 @@
!!-------------------------------------------------------------------
INTEGER :: ios ! Local integer output status for namelist read
- NAMELIST/namicedyn/ epsd, om, cw, pstar, &
- & c_rhg, creepl, ecc, ahi0, &
- & nevp, relast, alphaevp, hminrhg
+ NAMELIST/namicedyn/ nn_icestr, ln_icestr_bvf, rn_pe_rdg, rn_pstar, rn_crhg, rn_cio, rn_creepl, rn_ecc, &
+ & nn_nevp, rn_relast, nn_ahi0, rn_ahi0_ref
+ INTEGER :: ji, jj
+ REAL(wp) :: za00, zd_max
!!-------------------------------------------------------------------
@@ -259,28 +262,64 @@
WRITE(numout,*) 'lim_dyn_init : ice parameters for ice dynamics '
WRITE(numout,*) '~~~~~~~~~~~~'
- WRITE(numout,*) ' tolerance parameter epsd = ', epsd
- WRITE(numout,*) ' relaxation constant om = ', om
- WRITE(numout,*) ' drag coefficient for oceanic stress cw = ', cw
- WRITE(numout,*) ' first bulk-rheology parameter pstar = ', pstar
- WRITE(numout,*) ' second bulk-rhelogy parameter c_rhg = ', c_rhg
- WRITE(numout,*) ' creep limit creepl = ', creepl
- WRITE(numout,*) ' eccentricity of the elliptical yield curve ecc = ', ecc
- WRITE(numout,*) ' horizontal diffusivity coeff. for sea-ice ahi0 = ', ahi0
- WRITE(numout,*) ' number of iterations for subcycling nevp = ', nevp
- WRITE(numout,*) ' ratio of elastic timescale over ice time step relast = ', relast
- WRITE(numout,*) ' coefficient for the solution of int. stresses alphaevp = ', alphaevp
- WRITE(numout,*) ' min ice thickness for rheology calculations hminrhg = ', hminrhg
+ WRITE(numout,*)' ice strength parameterization (0=Hibler 1=Rothrock) nn_icestr = ', nn_icestr
+ WRITE(numout,*)' Including brine volume in ice strength comp. ln_icestr_bvf = ', ln_icestr_bvf
+ WRITE(numout,*)' Ratio of ridging work to PotEner change in ridging rn_pe_rdg = ', rn_pe_rdg
+ WRITE(numout,*) ' drag coefficient for oceanic stress rn_cio = ', rn_cio
+ WRITE(numout,*) ' first bulk-rheology parameter rn_pstar = ', rn_pstar
+ WRITE(numout,*) ' second bulk-rhelogy parameter rn_crhg = ', rn_crhg
+ WRITE(numout,*) ' creep limit rn_creepl = ', rn_creepl
+ WRITE(numout,*) ' eccentricity of the elliptical yield curve rn_ecc = ', rn_ecc
+ WRITE(numout,*) ' number of iterations for subcycling nn_nevp = ', nn_nevp
+ WRITE(numout,*) ' ratio of elastic timescale over ice time step rn_relast = ', rn_relast
+ WRITE(numout,*) ' horizontal diffusivity calculation nn_ahi0 = ', nn_ahi0
+ WRITE(numout,*) ' horizontal diffusivity coeff. (orca2 grid) rn_ahi0_ref = ', rn_ahi0_ref
ENDIF
!
- usecc2 = 1._wp / ( ecc * ecc )
- rhoco = rau0 * cw
-
- ! elastic damping
- telast = relast * rdt_ice
-
- ! Diffusion coefficients.
- ahiu(:,:) = ahi0 * umask(:,:,1)
- ahiv(:,:) = ahi0 * vmask(:,:,1)
- !
+ usecc2 = 1._wp / ( rn_ecc * rn_ecc )
+ rhoco = rau0 * rn_cio
+ !
+ ! Diffusion coefficients
+ SELECT CASE( nn_ahi0 )
+
+ CASE( 0 )
+ ahiu(:,:) = rn_ahi0_ref
+ ahiv(:,:) = rn_ahi0_ref
+
+ IF(lwp) WRITE(numout,*) ''
+ IF(lwp) WRITE(numout,*) ' laplacian operator: ahim constant = rn_ahi0_ref'
+
+ CASE( 1 )
+
+ zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) )
+ IF( lk_mpp ) CALL mpp_max( zd_max ) ! max over the global domain
+
+ ahiu(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp ! 1.e05 = 100km = max grid space at 60° latitude in orca2
+ ! (60° = min latitude for ice cover)
+ ahiv(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp
+
+ IF(lwp) WRITE(numout,*) ''
+ IF(lwp) WRITE(numout,*) ' laplacian operator: ahim proportional to max of e1 e2 over the domain (', zd_max, ')'
+ IF(lwp) WRITE(numout,*) ' value for ahim = ', rn_ahi0_ref * zd_max * 1.e-05_wp
+
+ CASE( 2 )
+
+ zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) )
+ IF( lk_mpp ) CALL mpp_max( zd_max ) ! max over the global domain
+
+ za00 = rn_ahi0_ref * 1.e-05_wp ! 1.e05 = 100km = max grid space at 60° latitude in orca2
+ ! (60° = min latitude for ice cover)
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ ahiu(ji,jj) = za00 * MAX( e1t(ji,jj), e2t(ji,jj) ) * umask(ji,jj,1)
+ ahiv(ji,jj) = za00 * MAX( e1f(ji,jj), e2f(ji,jj) ) * vmask(ji,jj,1)
+ END DO
+ END DO
+ !
+ IF(lwp) WRITE(numout,*) ''
+ IF(lwp) WRITE(numout,*) ' laplacian operator: ahim proportional to e1'
+ IF(lwp) WRITE(numout,*) ' maximum grid-spacing = ', zd_max, ' maximum value for ahim = ', za00*zd_max
+
+ END SELECT
+
END SUBROUTINE lim_dyn_init
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90 (revision 5602)
@@ -13,4 +13,5 @@
!!----------------------------------------------------------------------
!! lim_hdf : diffusion trend on sea-ice variable
+ !! lim_hdf_init : initialisation of diffusion trend on sea-ice variable
!!----------------------------------------------------------------------
USE dom_oce ! ocean domain
@@ -26,8 +27,9 @@
PRIVATE
- PUBLIC lim_hdf ! called by lim_tra
-
- LOGICAL :: linit = .TRUE. ! initialization flag (set to flase after the 1st call)
- REAL(wp) :: epsi04 = 1.e-04 ! constant
+ PUBLIC lim_hdf ! called by lim_trp
+ PUBLIC lim_hdf_init ! called by sbc_lim_init
+
+ LOGICAL :: linit = .TRUE. ! initialization flag (set to flase after the 1st call)
+ INTEGER :: nn_convfrq !: convergence check frequency of the Crant-Nicholson scheme
REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: efact ! metric coefficient
@@ -54,9 +56,12 @@
REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) :: ptab ! Field on which the diffusion is applied
!
- INTEGER :: ji, jj ! dummy loop indices
- INTEGER :: its, iter, ierr ! local integers
- REAL(wp) :: zalfa, zrlxint, zconv ! local scalars
- REAL(wp), POINTER, DIMENSION(:,:) :: zrlx, zflu, zflv, zdiv0, zdiv, ztab0
- CHARACTER(lc) :: charout ! local character
+ INTEGER :: ji, jj ! dummy loop indices
+ INTEGER :: iter, ierr ! local integers
+ REAL(wp) :: zrlxint, zconv ! local scalars
+ REAL(wp), POINTER, DIMENSION(:,:) :: zrlx, zflu, zflv, zdiv0, zdiv, ztab0
+ CHARACTER(lc) :: charout ! local character
+ REAL(wp), PARAMETER :: zrelax = 0.5_wp ! relaxation constant for iterative procedure
+ REAL(wp), PARAMETER :: zalfa = 0.5_wp ! =1.0/0.5/0.0 = implicit/Cranck-Nicholson/explicit
+ INTEGER , PARAMETER :: its = 100 ! Maximum number of iteration
!!-------------------------------------------------------------------
@@ -71,5 +76,5 @@
DO jj = 2, jpjm1
DO ji = fs_2 , fs_jpim1 ! vector opt.
- efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj) + e1v(ji,jj) + e1v(ji,jj-1) ) / ( e1t(ji,jj) * e2t(ji,jj) )
+ efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj) + e1v(ji,jj) + e1v(ji,jj-1) ) * r1_e12t(ji,jj)
END DO
END DO
@@ -77,6 +82,4 @@
ENDIF
! ! Time integration parameters
- zalfa = 0.5_wp ! =1.0/0.5/0.0 = implicit/Cranck-Nicholson/explicit
- its = 100 ! Maximum number of iteration
!
ztab0(:, : ) = ptab(:,:) ! Arrays initialization
@@ -91,5 +94,5 @@
iter = 0
!
- DO WHILE( zconv > ( 2._wp * epsi04 ) .AND. iter <= its ) ! Sub-time step loop
+ DO WHILE( zconv > ( 2._wp * 1.e-04 ) .AND. iter <= its ) ! Sub-time step loop
!
iter = iter + 1 ! incrementation of the sub-time step number
@@ -97,6 +100,6 @@
DO jj = 1, jpjm1 ! diffusive fluxes in U- and V- direction
DO ji = 1 , fs_jpim1 ! vector opt.
- zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) / e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) )
- zflv(ji,jj) = pahv(ji,jj) * e1v(ji,jj) / e2v(ji,jj) * ( ptab(ji,jj+1) - ptab(ji,jj) )
+ zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) * r1_e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) )
+ zflv(ji,jj) = pahv(ji,jj) * e1v(ji,jj) * r1_e2v(ji,jj) * ( ptab(ji,jj+1) - ptab(ji,jj) )
END DO
END DO
@@ -104,6 +107,5 @@
DO jj= 2, jpjm1 ! diffusive trend : divergence of the fluxes
DO ji = fs_2 , fs_jpim1 ! vector opt.
- zdiv (ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj ) &
- & + zflv(ji,jj) - zflv(ji ,jj-1) ) / ( e1t (ji,jj) * e2t (ji,jj) )
+ zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e12t(ji,jj)
END DO
END DO
@@ -115,18 +117,20 @@
zrlxint = ( ztab0(ji,jj) &
& + rdt_ice * ( zalfa * ( zdiv(ji,jj) + efact(ji,jj) * ptab(ji,jj) ) &
- & + ( 1.0 - zalfa ) * zdiv0(ji,jj) ) ) &
- & / ( 1.0 + zalfa * rdt_ice * efact(ji,jj) )
- zrlx(ji,jj) = ptab(ji,jj) + om * ( zrlxint - ptab(ji,jj) )
+ & + ( 1.0 - zalfa ) * zdiv0(ji,jj) ) &
+ & ) / ( 1.0 + zalfa * rdt_ice * efact(ji,jj) )
+ zrlx(ji,jj) = ptab(ji,jj) + zrelax * ( zrlxint - ptab(ji,jj) )
END DO
END DO
CALL lbc_lnk( zrlx, 'T', 1. ) ! lateral boundary condition
!
- zconv = 0._wp ! convergence test
- DO jj = 2, jpjm1
- DO ji = fs_2, fs_jpim1
- zconv = MAX( zconv, ABS( zrlx(ji,jj) - ptab(ji,jj) ) )
- END DO
- END DO
- IF( lk_mpp ) CALL mpp_max( zconv ) ! max over the global domain
+ IF ( MOD( iter, nn_convfrq ) == 0 ) THEN ! convergence test every nn_convfrq iterations (perf. optimization)
+ zconv = 0._wp
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1
+ zconv = MAX( zconv, ABS( zrlx(ji,jj) - ptab(ji,jj) ) )
+ END DO
+ END DO
+ IF( lk_mpp ) CALL mpp_max( zconv ) ! max over the global domain
+ ENDIF
!
ptab(:,:) = zrlx(:,:)
@@ -138,6 +142,6 @@
DO jj = 1, jpjm1 ! diffusive fluxes in U- and V- direction
DO ji = 1 , fs_jpim1 ! vector opt.
- zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) / e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) )
- zflv(ji,jj) = pahv(ji,jj) * e1v(ji,jj) / e2v(ji,jj) * ( ptab(ji,jj+1) - ptab(ji,jj) )
+ zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) * r1_e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) )
+ zflv(ji,jj) = pahv(ji,jj) * e1v(ji,jj) * r1_e2v(ji,jj) * ( ptab(ji,jj+1) - ptab(ji,jj) )
END DO
END DO
@@ -145,6 +149,5 @@
DO jj= 2, jpjm1 ! diffusive trend : divergence of the fluxes
DO ji = fs_2 , fs_jpim1 ! vector opt.
- zdiv (ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj ) &
- & + zflv(ji,jj) - zflv(ji ,jj-1) ) / ( e1t (ji,jj) * e2t (ji,jj) )
+ zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e12t(ji,jj)
ptab(ji,jj) = ztab0(ji,jj) + 0.5 * ( zdiv(ji,jj) + zdiv0(ji,jj) )
END DO
@@ -164,11 +167,45 @@
END SUBROUTINE lim_hdf
+
+ SUBROUTINE lim_hdf_init
+ !!-------------------------------------------------------------------
+ !! *** ROUTINE lim_hdf_init ***
+ !!
+ !! ** Purpose : Initialisation of horizontal diffusion of sea-ice
+ !!
+ !! ** Method : Read the namicehdf namelist
+ !!
+ !! ** input : Namelist namicehdf
+ !!-------------------------------------------------------------------
+ INTEGER :: ios ! Local integer output status for namelist read
+ NAMELIST/namicehdf/ nn_convfrq
+ !!-------------------------------------------------------------------
+ !
+ IF(lwp) THEN
+ WRITE(numout,*)
+ WRITE(numout,*) 'lim_hdf : Ice horizontal diffusion'
+ WRITE(numout,*) '~~~~~~~'
+ ENDIF
+ !
+ REWIND( numnam_ice_ref ) ! Namelist namicehdf in reference namelist : Ice horizontal diffusion
+ READ ( numnam_ice_ref, namicehdf, IOSTAT = ios, ERR = 901)
+901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicehdf in reference namelist', lwp )
+
+ REWIND( numnam_ice_cfg ) ! Namelist namicehdf in configuration namelist : Ice horizontal diffusion
+ READ ( numnam_ice_cfg, namicehdf, IOSTAT = ios, ERR = 902 )
+902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicehdf in configuration namelist', lwp )
+ IF(lwm) WRITE ( numoni, namicehdf )
+ !
+ IF(lwp) THEN ! control print
+ WRITE(numout,*)
+ WRITE(numout,*)' Namelist of ice parameters for ice horizontal diffusion computation '
+ WRITE(numout,*)' convergence check frequency of the Crant-Nicholson scheme nn_convfrq = ', nn_convfrq
+ ENDIF
+ !
+ END SUBROUTINE lim_hdf_init
#else
!!----------------------------------------------------------------------
!! Default option Dummy module NO LIM sea-ice model
!!----------------------------------------------------------------------
-CONTAINS
- SUBROUTINE lim_hdf ! Empty routine
- END SUBROUTINE lim_hdf
#endif
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90 (revision 5602)
@@ -22,5 +22,4 @@
USE eosbn2 ! equation of state
USE ice ! sea-ice variables
- USE par_ice ! ice parameters
USE par_oce ! ocean parameters
USE dom_ice ! sea-ice domain
@@ -36,17 +35,17 @@
! !!** init namelist (namiceini) **
- REAL(wp) :: thres_sst ! threshold water temperature for initial sea ice
- REAL(wp) :: hts_ini_n ! initial snow thickness in the north
- REAL(wp) :: hts_ini_s ! initial snow thickness in the south
- REAL(wp) :: hti_ini_n ! initial ice thickness in the north
- REAL(wp) :: hti_ini_s ! initial ice thickness in the south
- REAL(wp) :: ati_ini_n ! initial leads area in the north
- REAL(wp) :: ati_ini_s ! initial leads area in the south
- REAL(wp) :: smi_ini_n ! initial salinity
- REAL(wp) :: smi_ini_s ! initial salinity
- REAL(wp) :: tmi_ini_n ! initial temperature
- REAL(wp) :: tmi_ini_s ! initial temperature
-
- LOGICAL :: ln_limini ! initialization or not
+ REAL(wp) :: rn_thres_sst ! threshold water temperature for initial sea ice
+ REAL(wp) :: rn_hts_ini_n ! initial snow thickness in the north
+ REAL(wp) :: rn_hts_ini_s ! initial snow thickness in the south
+ REAL(wp) :: rn_hti_ini_n ! initial ice thickness in the north
+ REAL(wp) :: rn_hti_ini_s ! initial ice thickness in the south
+ REAL(wp) :: rn_ati_ini_n ! initial leads area in the north
+ REAL(wp) :: rn_ati_ini_s ! initial leads area in the south
+ REAL(wp) :: rn_smi_ini_n ! initial salinity
+ REAL(wp) :: rn_smi_ini_s ! initial salinity
+ REAL(wp) :: rn_tmi_ini_n ! initial temperature
+ REAL(wp) :: rn_tmi_ini_s ! initial temperature
+
+ LOGICAL :: ln_iceini ! initialization or not
!!----------------------------------------------------------------------
!! LIM 3.0, UCL-LOCEAN-IPSL (2008)
@@ -87,5 +86,5 @@
!! * Local variables
INTEGER :: ji, jj, jk, jl ! dummy loop indices
- REAL(wp) :: epsi20, ztmelts, zdh
+ REAL(wp) :: ztmelts, zdh
INTEGER :: i_hemis, i_fill, jl0
REAL(wp) :: ztest_1, ztest_2, ztest_3, ztest_4, ztests, zsigma, zarg, zA, zV, zA_cons, zV_cons, zconv
@@ -101,6 +100,4 @@
CALL wrk_alloc( 2, zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini )
- epsi20 = 1.e-20_wp
-
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) 'lim_istate : Ice initialization '
@@ -115,12 +112,12 @@
! surface temperature
DO jl = 1, jpl ! loop over categories
- t_su (:,:,jl) = rtt * tms(:,:)
- tn_ice(:,:,jl) = rtt * tms(:,:)
+ t_su (:,:,jl) = rt0 * tmask(:,:,1)
+ tn_ice(:,:,jl) = rt0 * tmask(:,:,1)
END DO
! basal temperature (considered at freezing point)
- t_bo(:,:) = ( eos_fzp( tsn(:,:,1,jp_sal) ) + rt0 ) * tms(:,:)
-
- IF( ln_limini ) THEN
+ t_bo(:,:) = ( eos_fzp( sss_m(:,:) ) + rt0 ) * tmask(:,:,1)
+
+ IF( ln_iceini ) THEN
!--------------------------------------------------------------------
@@ -130,8 +127,8 @@
DO jj = 1, jpj ! ice if sst <= t-freez + ttest
DO ji = 1, jpi
- IF( ( tsn(ji,jj,1,jp_tem) - ( t_bo(ji,jj) - rt0 ) ) * tms(ji,jj) >= thres_sst ) THEN
- zswitch(ji,jj) = 0._wp * tms(ji,jj) ! no ice
+ IF( ( sst_m(ji,jj) - ( t_bo(ji,jj) - rt0 ) ) * tmask(ji,jj,1) >= rn_thres_sst ) THEN
+ zswitch(ji,jj) = 0._wp * tmask(ji,jj,1) ! no ice
ELSE
- zswitch(ji,jj) = 1._wp * tms(ji,jj) ! ice
+ zswitch(ji,jj) = 1._wp * tmask(ji,jj,1) ! ice
ENDIF
END DO
@@ -158,9 +155,9 @@
!-----------------------------
! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array
- zht_i_ini(1) = hti_ini_n ; zht_i_ini(2) = hti_ini_s ! ice thickness
- zht_s_ini(1) = hts_ini_n ; zht_s_ini(2) = hts_ini_s ! snow depth
- zat_i_ini(1) = ati_ini_n ; zat_i_ini(2) = ati_ini_s ! ice concentration
- zsm_i_ini(1) = smi_ini_n ; zsm_i_ini(2) = smi_ini_s ! bulk ice salinity
- ztm_i_ini(1) = tmi_ini_n ; ztm_i_ini(2) = tmi_ini_s ! temperature (ice and snow)
+ zht_i_ini(1) = rn_hti_ini_n ; zht_i_ini(2) = rn_hti_ini_s ! ice thickness
+ zht_s_ini(1) = rn_hts_ini_n ; zht_s_ini(2) = rn_hts_ini_s ! snow depth
+ zat_i_ini(1) = rn_ati_ini_n ; zat_i_ini(2) = rn_ati_ini_s ! ice concentration
+ zsm_i_ini(1) = rn_smi_ini_n ; zsm_i_ini(2) = rn_smi_ini_s ! bulk ice salinity
+ ztm_i_ini(1) = rn_tmi_ini_n ; ztm_i_ini(2) = rn_tmi_ini_s ! temperature (ice and snow)
zvt_i_ini(:) = zht_i_ini(:) * zat_i_ini(:) ! ice volume
@@ -197,11 +194,11 @@
!--- Ice thicknesses in the i_fill - 1 first categories
DO jl = 1, i_fill - 1
- zh_i_ini(jl,i_hemis) = 0.5 * ( hi_max(jl) + hi_max(jl-1) )
+ zh_i_ini(jl,i_hemis) = hi_mean(jl)
END DO
!--- jl0: most likely index where cc will be maximum
DO jl = 1, jpl
- IF ( ( zht_i_ini(i_hemis) .GT. hi_max(jl-1) ) .AND. &
- ( zht_i_ini(i_hemis) .LE. hi_max(jl) ) ) THEN
+ IF ( ( zht_i_ini(i_hemis) > hi_max(jl-1) ) .AND. &
+ & ( zht_i_ini(i_hemis) <= hi_max(jl) ) ) THEN
jl0 = jl
ENDIF
@@ -267,5 +264,5 @@
! Test 3: thickness of the last category is in-bounds ?
- IF ( zh_i_ini(i_fill, i_hemis) .GT. hi_max(i_fill-1) ) THEN
+ IF ( zh_i_ini(i_fill, i_hemis) > hi_max(i_fill-1) ) THEN
ztest_3 = 1
ELSE
@@ -317,9 +314,9 @@
DO ji = 1, jpi
a_i(ji,jj,jl) = zswitch(ji,jj) * za_i_ini (jl,zhemis(ji,jj)) ! concentration
- ht_i(ji,jj,jl) = zswitch(ji,jj) * zh_i_ini(jl,zhemis(ji,jj)) ! ice thickness
+ ht_i(ji,jj,jl) = zswitch(ji,jj) * zh_i_ini(jl,zhemis(ji,jj)) ! ice thickness
ht_s(ji,jj,jl) = ht_i(ji,jj,jl) * ( zht_s_ini( zhemis(ji,jj) ) / zht_i_ini( zhemis(ji,jj) ) ) ! snow depth
- sm_i(ji,jj,jl) = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * s_i_min ! salinity
- o_i(ji,jj,jl) = zswitch(ji,jj) * 1._wp + ( 1._wp - zswitch(ji,jj) ) ! age
- t_su(ji,jj,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt ! surf temp
+ sm_i(ji,jj,jl) = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) ! salinity
+ o_i(ji,jj,jl) = zswitch(ji,jj) * 1._wp ! age (1 day)
+ t_su(ji,jj,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0 ! surf temp
! This case below should not be used if (ht_s/ht_i) is ok in namelist
@@ -329,5 +326,5 @@
! recompute ht_i, ht_s avoiding out of bounds values
ht_i(ji,jj,jl) = MIN( hi_max(jl), ht_i(ji,jj,jl) + zdh )
- ht_s(ji,jj,jl) = MAX( 0._wp, ht_s(ji,jj,jl) - zdh * rhoic / rhosn )
+ ht_s(ji,jj,jl) = MAX( 0._wp, ht_s(ji,jj,jl) - zdh * rhoic * r1_rhosn )
! ice volume, salt content, age content
@@ -336,7 +333,7 @@
smv_i(ji,jj,jl) = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) ! salt content
oa_i(ji,jj,jl) = o_i(ji,jj,jl) * a_i(ji,jj,jl) ! age content
- END DO ! ji
- END DO ! jj
- END DO ! jl
+ END DO
+ END DO
+ END DO
! Snow temperature and heat content
@@ -345,15 +342,14 @@
DO jj = 1, jpj
DO ji = 1, jpi
- t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt
+ t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0
! Snow energy of melting
- e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhosn * ( cpic * ( rtt - t_s(ji,jj,jk,jl) ) + lfus )
- ! Change dimensions
- e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / unit_fac
- ! Multiply by volume, so that heat content in Joules
- e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * area(ji,jj) * v_s(ji,jj,jl) / nlay_s
- END DO ! ji
- END DO ! jj
- END DO ! jl
- END DO ! jk
+ e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhosn * ( cpic * ( rt0 - t_s(ji,jj,jk,jl) ) + lfus )
+
+ ! Mutliply by volume, and divide by number of layers to get heat content in J/m2
+ e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * v_s(ji,jj,jl) * r1_nlay_s
+ END DO
+ END DO
+ END DO
+ END DO
! Ice salinity, temperature and heat content
@@ -362,27 +358,24 @@
DO jj = 1, jpj
DO ji = 1, jpi
- t_i(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt
- s_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * s_i_min
- ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt !Melting temperature in K
+ t_i(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0
+ s_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * rn_simin
+ ztmelts = - tmut * s_i(ji,jj,jk,jl) + rt0 !Melting temperature in K
! heat content per unit volume
e_i(ji,jj,jk,jl) = zswitch(ji,jj) * rhoic * ( cpic * ( ztmelts - t_i(ji,jj,jk,jl) ) &
- + lfus * ( 1._wp - (ztmelts-rtt) / MIN((t_i(ji,jj,jk,jl)-rtt),-epsi20) ) &
- - rcp * ( ztmelts - rtt ) )
-
- ! Correct dimensions to avoid big values
- e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / unit_fac
-
- ! Mutliply by ice volume, and divide by number of layers to get heat content in J
- e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / nlay_i
- END DO ! ji
- END DO ! jj
- END DO ! jl
- END DO ! jk
+ + lfus * ( 1._wp - (ztmelts-rt0) / MIN((t_i(ji,jj,jk,jl)-rt0),-epsi20) ) &
+ - rcp * ( ztmelts - rt0 ) )
+
+ ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2
+ e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i
+ END DO
+ END DO
+ END DO
+ END DO
tn_ice (:,:,:) = t_su (:,:,:)
ELSE
- ! if ln_limini=false
+ ! if ln_iceini=false
a_i (:,:,:) = 0._wp
v_i (:,:,:) = 0._wp
@@ -400,12 +393,12 @@
DO jl = 1, jpl
DO jk = 1, nlay_i
- t_i(:,:,jk,jl) = rtt * tms(:,:)
+ t_i(:,:,jk,jl) = rt0 * tmask(:,:,1)
END DO
DO jk = 1, nlay_s
- t_s(:,:,jk,jl) = rtt * tms(:,:)
+ t_s(:,:,jk,jl) = rt0 * tmask(:,:,1)
END DO
END DO
- ENDIF ! ln_limini
+ ENDIF ! ln_iceini
at_i (:,:) = 0.0_wp
@@ -481,6 +474,6 @@
!! 8.5 ! 07-11 (M. Vancoppenolle) rewritten initialization
!!-----------------------------------------------------------------------------
- NAMELIST/namiceini/ ln_limini, thres_sst, hts_ini_n, hts_ini_s, hti_ini_n, hti_ini_s, &
- & ati_ini_n, ati_ini_s, smi_ini_n, smi_ini_s, tmi_ini_n, tmi_ini_s
+ NAMELIST/namiceini/ ln_iceini, rn_thres_sst, rn_hts_ini_n, rn_hts_ini_s, rn_hti_ini_n, rn_hti_ini_s, &
+ & rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, rn_smi_ini_s, rn_tmi_ini_n, rn_tmi_ini_s
INTEGER :: ios ! Local integer output status for namelist read
!!-----------------------------------------------------------------------------
@@ -502,16 +495,16 @@
WRITE(numout,*) 'lim_istate_init : ice parameters inititialisation '
WRITE(numout,*) '~~~~~~~~~~~~~~~'
- WRITE(numout,*) ' initialization with ice (T) or not (F) ln_limini = ', ln_limini
- WRITE(numout,*) ' threshold water temp. for initial sea-ice thres_sst = ', thres_sst
- WRITE(numout,*) ' initial snow thickness in the north hts_ini_n = ', hts_ini_n
- WRITE(numout,*) ' initial snow thickness in the south hts_ini_s = ', hts_ini_s
- WRITE(numout,*) ' initial ice thickness in the north hti_ini_n = ', hti_ini_n
- WRITE(numout,*) ' initial ice thickness in the south hti_ini_s = ', hti_ini_s
- WRITE(numout,*) ' initial ice concentr. in the north ati_ini_n = ', ati_ini_n
- WRITE(numout,*) ' initial ice concentr. in the north ati_ini_s = ', ati_ini_s
- WRITE(numout,*) ' initial ice salinity in the north smi_ini_n = ', smi_ini_n
- WRITE(numout,*) ' initial ice salinity in the south smi_ini_s = ', smi_ini_s
- WRITE(numout,*) ' initial ice/snw temp in the north tmi_ini_n = ', tmi_ini_n
- WRITE(numout,*) ' initial ice/snw temp in the south tmi_ini_s = ', tmi_ini_s
+ WRITE(numout,*) ' initialization with ice (T) or not (F) ln_iceini = ', ln_iceini
+ WRITE(numout,*) ' threshold water temp. for initial sea-ice rn_thres_sst = ', rn_thres_sst
+ WRITE(numout,*) ' initial snow thickness in the north rn_hts_ini_n = ', rn_hts_ini_n
+ WRITE(numout,*) ' initial snow thickness in the south rn_hts_ini_s = ', rn_hts_ini_s
+ WRITE(numout,*) ' initial ice thickness in the north rn_hti_ini_n = ', rn_hti_ini_n
+ WRITE(numout,*) ' initial ice thickness in the south rn_hti_ini_s = ', rn_hti_ini_s
+ WRITE(numout,*) ' initial ice concentr. in the north rn_ati_ini_n = ', rn_ati_ini_n
+ WRITE(numout,*) ' initial ice concentr. in the north rn_ati_ini_s = ', rn_ati_ini_s
+ WRITE(numout,*) ' initial ice salinity in the north rn_smi_ini_n = ', rn_smi_ini_n
+ WRITE(numout,*) ' initial ice salinity in the south rn_smi_ini_s = ', rn_smi_ini_s
+ WRITE(numout,*) ' initial ice/snw temp in the north rn_tmi_ini_n = ', rn_tmi_ini_n
+ WRITE(numout,*) ' initial ice/snw temp in the south rn_tmi_ini_s = ', rn_tmi_ini_s
ENDIF
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90 (revision 5602)
@@ -18,14 +18,12 @@
USE thd_ice ! LIM thermodynamics
USE ice ! LIM variables
- USE par_ice ! LIM parameters
USE dom_ice ! LIM domain
- USE limthd_lac ! LIM
USE limvar ! LIM
- USE in_out_manager ! I/O manager
USE lbclnk ! lateral boundary condition - MPP exchanges
USE lib_mpp ! MPP library
USE wrk_nemo ! work arrays
USE prtctl ! Print control
- ! Check budget (Rousset)
+
+ USE in_out_manager ! I/O manager
USE iom ! I/O manager
USE lib_fortran ! glob_sum
@@ -40,6 +38,5 @@
PUBLIC lim_itd_me_icestrength
PUBLIC lim_itd_me_init
- PUBLIC lim_itd_me_zapsmall
- PUBLIC lim_itd_me_alloc ! called by iceini.F90
+ PUBLIC lim_itd_me_alloc ! called by sbc_lim_init
!-----------------------------------------------------------------------
@@ -125,18 +122,19 @@
!! and Elizabeth C. Hunke, LANL are gratefully acknowledged
!!--------------------------------------------------------------------!
- INTEGER :: ji, jj, jk, jl ! dummy loop index
- INTEGER :: niter, nitermax = 20 ! local integer
- LOGICAL :: asum_error ! flag for asum .ne. 1
+ INTEGER :: ji, jj, jk, jl ! dummy loop index
+ INTEGER :: niter ! local integer
INTEGER :: iterate_ridging ! if true, repeat the ridging
- REAL(wp) :: w1, tmpfac ! local scalar
+ REAL(wp) :: za, zfac ! local scalar
CHARACTER (len = 15) :: fieldid
- REAL(wp), POINTER, DIMENSION(:,:) :: closing_net ! net rate at which area is removed (1/s)
- ! (ridging ice area - area of new ridges) / dt
- REAL(wp), POINTER, DIMENSION(:,:) :: divu_adv ! divu as implied by transport scheme (1/s)
- REAL(wp), POINTER, DIMENSION(:,:) :: opning ! rate of opening due to divergence/shear
- REAL(wp), POINTER, DIMENSION(:,:) :: closing_gross ! rate at which area removed, not counting area of new ridges
- REAL(wp), POINTER, DIMENSION(:,:) :: msnow_mlt ! mass of snow added to ocean (kg m-2)
- REAL(wp), POINTER, DIMENSION(:,:) :: esnow_mlt ! energy needed to melt snow in ocean (J m-2)
- REAL(wp), POINTER, DIMENSION(:,:) :: vt_i_init, vt_i_final ! ice volume summed over categories
+ REAL(wp), POINTER, DIMENSION(:,:) :: closing_net ! net rate at which area is removed (1/s)
+ ! (ridging ice area - area of new ridges) / dt
+ REAL(wp), POINTER, DIMENSION(:,:) :: divu_adv ! divu as implied by transport scheme (1/s)
+ REAL(wp), POINTER, DIMENSION(:,:) :: opning ! rate of opening due to divergence/shear
+ REAL(wp), POINTER, DIMENSION(:,:) :: closing_gross ! rate at which area removed, not counting area of new ridges
+ REAL(wp), POINTER, DIMENSION(:,:) :: msnow_mlt ! mass of snow added to ocean (kg m-2)
+ REAL(wp), POINTER, DIMENSION(:,:) :: esnow_mlt ! energy needed to melt snow in ocean (J m-2)
+ REAL(wp), POINTER, DIMENSION(:,:) :: vt_i_init, vt_i_final ! ice volume summed over categories
+ !
+ INTEGER, PARAMETER :: nitermax = 20
!
REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b
@@ -144,5 +142,5 @@
IF( nn_timing == 1 ) CALL timing_start('limitd_me')
- CALL wrk_alloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final )
+ CALL wrk_alloc( jpi,jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final )
IF(ln_ctl) THEN
@@ -156,8 +154,11 @@
IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+ CALL lim_var_zapsmall
+ CALL lim_var_glo2eqv ! equivalent variables, requested for rafting
+
!-----------------------------------------------------------------------------!
! 1) Thickness categories boundaries, ice / o.w. concentrations, init_ons
!-----------------------------------------------------------------------------!
- Cp = 0.5 * grav * (rau0-rhoic) * rhoic / rau0 ! proport const for PE
+ Cp = 0.5 * grav * (rau0-rhoic) * rhoic * r1_rau0 ! proport const for PE
!
CALL lim_itd_me_ridgeprep ! prepare ridging
@@ -193,5 +194,5 @@
! (thick, newly ridged ice).
- closing_net(ji,jj) = Cs * 0.5 * ( Delta_i(ji,jj) - ABS( divu_i(ji,jj) ) ) - MIN( divu_i(ji,jj), 0._wp )
+ closing_net(ji,jj) = rn_cs * 0.5 * ( delta_i(ji,jj) - ABS( divu_i(ji,jj) ) ) - MIN( divu_i(ji,jj), 0._wp )
! 2.2 divu_adv
@@ -237,15 +238,13 @@
! Reduce the closing rate if more than 100% of the open water
! would be removed. Reduce the opening rate proportionately.
- IF ( ato_i(ji,jj) .GT. epsi10 .AND. athorn(ji,jj,0) .GT. 0.0 ) THEN
- w1 = athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice
- IF ( w1 .GT. ato_i(ji,jj)) THEN
- tmpfac = ato_i(ji,jj) / w1
- closing_gross(ji,jj) = closing_gross(ji,jj) * tmpfac
- opning(ji,jj) = opning(ji,jj) * tmpfac
- ENDIF !w1
- ENDIF !at0i and athorn
-
- END DO ! ji
- END DO ! jj
+ za = athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice
+ IF( za > epsi20 ) THEN
+ zfac = MIN( 1._wp, ato_i(ji,jj) / za )
+ closing_gross(ji,jj) = closing_gross(ji,jj) * zfac
+ opning (ji,jj) = opning (ji,jj) * zfac
+ ENDIF
+
+ END DO
+ END DO
! correction to closing rate / opening if excessive ice removal
@@ -253,19 +252,16 @@
! Reduce the closing rate if more than 100% of any ice category
! would be removed. Reduce the opening rate proportionately.
-
DO jl = 1, jpl
DO jj = 1, jpj
DO ji = 1, jpi
- IF ( a_i(ji,jj,jl) > epsi10 .AND. athorn(ji,jj,jl) > 0._wp )THEN
- w1 = athorn(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice
- IF ( w1 > a_i(ji,jj,jl) ) THEN
- tmpfac = a_i(ji,jj,jl) / w1
- closing_gross(ji,jj) = closing_gross(ji,jj) * tmpfac
- opning (ji,jj) = opning (ji,jj) * tmpfac
- ENDIF
+ za = athorn(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice
+ IF( za > epsi20 ) THEN
+ zfac = MIN( 1._wp, a_i(ji,jj,jl) / za )
+ closing_gross(ji,jj) = closing_gross(ji,jj) * zfac
+ opning (ji,jj) = opning (ji,jj) * zfac
ENDIF
- END DO !ji
- END DO ! jj
- END DO !jl
+ END DO
+ END DO
+ END DO
! 3.3 Redistribute area, volume, and energy.
@@ -276,6 +272,9 @@
! 3.4 Compute total area of ice plus open water after ridging.
!-----------------------------------------------------------------------------!
-
- CALL lim_itd_me_asumr
+ ! This is in general not equal to one because of divergence during transport
+ asum(:,:) = ato_i(:,:)
+ DO jl = 1, jpl
+ asum(:,:) = asum(:,:) + a_i(:,:,jl)
+ END DO
! 3.5 Do we keep on iterating ???
@@ -288,5 +287,5 @@
DO jj = 1, jpj
DO ji = 1, jpi
- IF (ABS(asum(ji,jj) - kamax ) .LT. epsi10) THEN
+ IF (ABS(asum(ji,jj) - kamax ) < epsi10) THEN
closing_net(ji,jj) = 0._wp
opning (ji,jj) = 0._wp
@@ -324,11 +323,6 @@
! Convert ridging rate diagnostics to correct units.
! Update fresh water and heat fluxes due to snow melt.
-
- asum_error = .false.
-
DO jj = 1, jpj
DO ji = 1, jpi
-
- IF(ABS(asum(ji,jj) - kamax) > epsi10 ) asum_error = .true.
dardg1dt(ji,jj) = dardg1dt(ji,jj) * r1_rdtice
@@ -341,5 +335,5 @@
!-----------------------------------------------------------------------------!
wfx_snw(ji,jj) = wfx_snw(ji,jj) + msnow_mlt(ji,jj) * r1_rdtice ! fresh water source for ocean
- hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + esnow_mlt(ji,jj) * unit_fac / area(ji,jj) * r1_rdtice ! heat sink for ocean (<0, W.m-2)
+ hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + esnow_mlt(ji,jj) * r1_rdtice ! heat sink for ocean (<0, W.m-2)
END DO
@@ -347,20 +341,21 @@
! Check if there is a ridging error
- DO jj = 1, jpj
- DO ji = 1, jpi
- IF( ABS( asum(ji,jj) - kamax) > epsi10 ) THEN ! there is a bug
- WRITE(numout,*) ' '
- WRITE(numout,*) ' ALERTE : Ridging error: total area = ', asum(ji,jj)
- WRITE(numout,*) ' limitd_me '
- WRITE(numout,*) ' POINT : ', ji, jj
- WRITE(numout,*) ' jpl, a_i, athorn '
- WRITE(numout,*) 0, ato_i(ji,jj), athorn(ji,jj,0)
- DO jl = 1, jpl
- WRITE(numout,*) jl, a_i(ji,jj,jl), athorn(ji,jj,jl)
- END DO
- ENDIF ! asum
-
- END DO !ji
- END DO !jj
+ IF( lwp ) THEN
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ IF( ABS( asum(ji,jj) - kamax) > epsi10 ) THEN ! there is a bug
+ WRITE(numout,*) ' '
+ WRITE(numout,*) ' ALERTE : Ridging error: total area = ', asum(ji,jj)
+ WRITE(numout,*) ' limitd_me '
+ WRITE(numout,*) ' POINT : ', ji, jj
+ WRITE(numout,*) ' jpl, a_i, athorn '
+ WRITE(numout,*) 0, ato_i(ji,jj), athorn(ji,jj,0)
+ DO jl = 1, jpl
+ WRITE(numout,*) jl, a_i(ji,jj,jl), athorn(ji,jj,jl)
+ END DO
+ ENDIF
+ END DO
+ END DO
+ END IF
! Conservation check
@@ -371,16 +366,16 @@
ENDIF
+ CALL lim_var_agg( 1 )
+
!-----------------------------------------------------------------------------!
- ! 6) Updating state variables and trend terms (done in limupdate)
+ ! control prints
!-----------------------------------------------------------------------------!
- CALL lim_var_glo2eqv
- CALL lim_itd_me_zapsmall
-
-
- IF(ln_ctl) THEN ! Control print
+ IF(ln_ctl) THEN
+ CALL lim_var_glo2eqv
+
CALL prt_ctl_info(' ')
CALL prt_ctl_info(' - Cell values : ')
CALL prt_ctl_info(' ~~~~~~~~~~~~~ ')
- CALL prt_ctl(tab2d_1=area , clinfo1=' lim_itd_me : cell area :')
+ CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_itd_me : cell area :')
CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_me : at_i :')
CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_me : vt_i :')
@@ -436,9 +431,8 @@
!!----------------------------------------------------------------------
INTEGER, INTENT(in) :: kstrngth ! = 1 for Rothrock formulation, 0 for Hibler (1979)
-
- INTEGER :: ji,jj, jl ! dummy loop indices
- INTEGER :: ksmooth ! smoothing the resistance to deformation
- INTEGER :: numts_rm ! number of time steps for the P smoothing
- REAL(wp) :: hi, zw1, zp, zdummy, zzc, z1_3 ! local scalars
+ INTEGER :: ji,jj, jl ! dummy loop indices
+ INTEGER :: ksmooth ! smoothing the resistance to deformation
+ INTEGER :: numts_rm ! number of time steps for the P smoothing
+ REAL(wp) :: zhi, zp, z1_3 ! local scalars
REAL(wp), POINTER, DIMENSION(:,:) :: zworka ! temporary array used here
!!----------------------------------------------------------------------
@@ -466,30 +460,29 @@
!
IF( a_i(ji,jj,jl) > epsi10 .AND. athorn(ji,jj,jl) > 0._wp ) THEN
- hi = v_i(ji,jj,jl) / a_i(ji,jj,jl)
+ zhi = v_i(ji,jj,jl) / a_i(ji,jj,jl)
!----------------------------
! PE loss from deforming ice
!----------------------------
- strength(ji,jj) = strength(ji,jj) - athorn(ji,jj,jl) * hi * hi
+ strength(ji,jj) = strength(ji,jj) - athorn(ji,jj,jl) * zhi * zhi
!--------------------------
! PE gain from rafting ice
!--------------------------
- strength(ji,jj) = strength(ji,jj) + 2._wp * araft(ji,jj,jl) * hi * hi
+ strength(ji,jj) = strength(ji,jj) + 2._wp * araft(ji,jj,jl) * zhi * zhi
!----------------------------
! PE gain from ridging ice
!----------------------------
- strength(ji,jj) = strength(ji,jj) + aridge(ji,jj,jl)/krdg(ji,jj,jl) &
- * z1_3 * (hrmax(ji,jj,jl)**3 - hrmin(ji,jj,jl)**3) / ( hrmax(ji,jj,jl)-hrmin(ji,jj,jl) )
-!!gm Optimization: (a**3-b**3)/(a-b) = a*a+ab+b*b ==> less costly operations even if a**3 is replaced by a*a*a...
- ENDIF ! aicen > epsi10
+ strength(ji,jj) = strength(ji,jj) + aridge(ji,jj,jl) / krdg(ji,jj,jl) &
+ * z1_3 * ( hrmax(ji,jj,jl)**2 + hrmin(ji,jj,jl)**2 + hrmax(ji,jj,jl) * hrmin(ji,jj,jl) )
+ !!(a**3-b**3)/(a-b) = a*a+ab+b*b
+ ENDIF
!
- END DO ! ji
- END DO !jj
- END DO !jl
-
- zzc = Cf * Cp ! where Cp = (g/2)*(rhow-rhoi)*(rhoi/rhow) and Cf accounts for frictional dissipation
- strength(:,:) = zzc * strength(:,:) / aksum(:,:)
-
+ END DO
+ END DO
+ END DO
+
+ strength(:,:) = rn_pe_rdg * Cp * strength(:,:) / aksum(:,:)
+ ! where Cp = (g/2)*(rhow-rhoi)*(rhoi/rhow) and rn_pe_rdg accounts for frictional dissipation
ksmooth = 1
@@ -499,5 +492,5 @@
ELSE ! kstrngth ne 1: Hibler (1979) form
!
- strength(:,:) = Pstar * vt_i(:,:) * EXP( - C_rhg * ( 1._wp - at_i(:,:) ) )
+ strength(:,:) = rn_pstar * vt_i(:,:) * EXP( - rn_crhg * ( 1._wp - at_i(:,:) ) )
!
ksmooth = 1
@@ -511,16 +504,11 @@
! CAN BE REMOVED
!
- IF ( brinstren_swi == 1 ) THEN
+ IF( ln_icestr_bvf ) THEN
DO jj = 1, jpj
DO ji = 1, jpi
- IF ( bv_i(ji,jj) .GT. 0.0 ) THEN
- zdummy = MIN ( bv_i(ji,jj), 0.10 ) * MIN( bv_i(ji,jj), 0.10 )
- ELSE
- zdummy = 0.0
- ENDIF
strength(ji,jj) = strength(ji,jj) * exp(-5.88*SQRT(MAX(bv_i(ji,jj),0.0)))
- END DO ! j
- END DO ! i
+ END DO
+ END DO
ENDIF
@@ -538,16 +526,11 @@
CALL lbc_lnk( strength, 'T', 1. )
- DO jj = 2, jpj - 1
- DO ji = 2, jpi - 1
- IF ( ( asum(ji,jj) - ato_i(ji,jj) ) .GT. epsi10) THEN ! ice is
- ! present
- zworka(ji,jj) = 4.0 * strength(ji,jj) &
- & + strength(ji-1,jj) * tms(ji-1,jj) &
- & + strength(ji+1,jj) * tms(ji+1,jj) &
- & + strength(ji,jj-1) * tms(ji,jj-1) &
- & + strength(ji,jj+1) * tms(ji,jj+1)
-
- zw1 = 4.0 + tms(ji-1,jj) + tms(ji+1,jj) + tms(ji,jj-1) + tms(ji,jj+1)
- zworka(ji,jj) = zworka(ji,jj) / zw1
+ DO jj = 2, jpjm1
+ DO ji = 2, jpim1
+ IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp) THEN
+ zworka(ji,jj) = ( 4.0 * strength(ji,jj) &
+ & + strength(ji-1,jj) * tmask(ji-1,jj,1) + strength(ji+1,jj) * tmask(ji+1,jj,1) &
+ & + strength(ji,jj-1) * tmask(ji,jj-1,1) + strength(ji,jj+1) * tmask(ji,jj+1,1) &
+ & ) / ( 4.0 + tmask(ji-1,jj,1) + tmask(ji+1,jj,1) + tmask(ji,jj-1,1) + tmask(ji,jj+1,1) )
ELSE
zworka(ji,jj) = 0._wp
@@ -556,6 +539,6 @@
END DO
- DO jj = 2, jpj - 1
- DO ji = 2, jpi - 1
+ DO jj = 2, jpjm1
+ DO ji = 2, jpim1
strength(ji,jj) = zworka(ji,jj)
END DO
@@ -563,5 +546,5 @@
CALL lbc_lnk( strength, 'T', 1. )
- ENDIF ! ksmooth
+ ENDIF
!--------------------
@@ -580,8 +563,8 @@
DO jj = 1, jpj - 1
DO ji = 1, jpi - 1
- IF ( ( asum(ji,jj) - ato_i(ji,jj) ) .GT. epsi10) THEN ! ice is present
+ IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp) THEN
numts_rm = 1 ! number of time steps for the running mean
- IF ( strp1(ji,jj) .GT. 0.0 ) numts_rm = numts_rm + 1
- IF ( strp2(ji,jj) .GT. 0.0 ) numts_rm = numts_rm + 1
+ IF ( strp1(ji,jj) > 0.0 ) numts_rm = numts_rm + 1
+ IF ( strp2(ji,jj) > 0.0 ) numts_rm = numts_rm + 1
zp = ( strength(ji,jj) + strp1(ji,jj) + strp2(ji,jj) ) / numts_rm
strp2(ji,jj) = strp1(ji,jj)
@@ -612,5 +595,5 @@
!!---------------------------------------------------------------------!
INTEGER :: ji,jj, jl ! dummy loop indices
- REAL(wp) :: Gstari, astari, hi, hrmean, zdummy ! local scalar
+ REAL(wp) :: Gstari, astari, zhi, hrmean, zdummy ! local scalar
REAL(wp), POINTER, DIMENSION(:,:) :: zworka ! temporary array used here
REAL(wp), POINTER, DIMENSION(:,:,:) :: Gsum ! Gsum(n) = sum of areas in categories 0 to n
@@ -620,6 +603,6 @@
CALL wrk_alloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 )
- Gstari = 1.0/Gstar
- astari = 1.0/astar
+ Gstari = 1.0/rn_gstar
+ astari = 1.0/rn_astar
aksum(:,:) = 0.0
athorn(:,:,:) = 0.0
@@ -632,5 +615,5 @@
! ! Zero out categories with very small areas
- CALL lim_itd_me_zapsmall
+ CALL lim_var_zapsmall
!------------------------------------------------------------------------------!
@@ -639,7 +622,9 @@
! Compute total area of ice plus open water.
- CALL lim_itd_me_asumr
- ! This is in general not equal to one
- ! because of divergence during transport
+ ! This is in general not equal to one because of divergence during transport
+ asum(:,:) = ato_i(:,:)
+ DO jl = 1, jpl
+ asum(:,:) = asum(:,:) + a_i(:,:,jl)
+ END DO
! Compute cumulative thickness distribution function
@@ -649,22 +634,9 @@
Gsum(:,:,-1) = 0._wp
-
- DO jj = 1, jpj
- DO ji = 1, jpi
- IF( ato_i(ji,jj) > epsi10 ) THEN ; Gsum(ji,jj,0) = ato_i(ji,jj)
- ELSE ; Gsum(ji,jj,0) = 0._wp
- ENDIF
- END DO
- END DO
+ Gsum(:,:,0 ) = ato_i(:,:)
! for each value of h, you have to add ice concentration then
DO jl = 1, jpl
- DO jj = 1, jpj
- DO ji = 1, jpi
- IF( a_i(ji,jj,jl) .GT. epsi10 ) THEN ; Gsum(ji,jj,jl) = Gsum(ji,jj,jl-1) + a_i(ji,jj,jl)
- ELSE ; Gsum(ji,jj,jl) = Gsum(ji,jj,jl-1)
- ENDIF
- END DO
- END DO
+ Gsum(:,:,jl) = Gsum(:,:,jl-1) + a_i(:,:,jl)
END DO
@@ -687,51 +659,50 @@
!-----------------------------------------------------------------
- IF( partfun_swi == 0 ) THEN !--- Linear formulation (Thorndike et al., 1975)
+ IF( nn_partfun == 0 ) THEN !--- Linear formulation (Thorndike et al., 1975)
DO jl = 0, jpl
DO jj = 1, jpj
DO ji = 1, jpi
- IF( Gsum(ji,jj,jl) < Gstar) THEN
- athorn(ji,jj,jl) = Gstari * (Gsum(ji,jj,jl)-Gsum(ji,jj,jl-1)) * &
- (2.0 - (Gsum(ji,jj,jl-1)+Gsum(ji,jj,jl))*Gstari)
- ELSEIF (Gsum(ji,jj,jl-1) < Gstar) THEN
- athorn(ji,jj,jl) = Gstari * (Gstar-Gsum(ji,jj,jl-1)) * &
- (2.0 - (Gsum(ji,jj,jl-1)+Gstar)*Gstari)
+ IF( Gsum(ji,jj,jl) < rn_gstar) THEN
+ athorn(ji,jj,jl) = Gstari * ( Gsum(ji,jj,jl) - Gsum(ji,jj,jl-1) ) * &
+ & ( 2.0 - (Gsum(ji,jj,jl-1) + Gsum(ji,jj,jl) ) * Gstari )
+ ELSEIF (Gsum(ji,jj,jl-1) < rn_gstar) THEN
+ athorn(ji,jj,jl) = Gstari * ( rn_gstar - Gsum(ji,jj,jl-1) ) * &
+ & ( 2.0 - ( Gsum(ji,jj,jl-1) + rn_gstar ) * Gstari )
ELSE
athorn(ji,jj,jl) = 0.0
ENDIF
- END DO ! ji
- END DO ! jj
- END DO ! jl
+ END DO
+ END DO
+ END DO
ELSE !--- Exponential, more stable formulation (Lipscomb et al, 2007)
!
zdummy = 1._wp / ( 1._wp - EXP(-astari) ) ! precompute exponential terms using Gsum as a work array
-
DO jl = -1, jpl
Gsum(:,:,jl) = EXP( -Gsum(:,:,jl) * astari ) * zdummy
- END DO !jl
+ END DO
DO jl = 0, jpl
athorn(:,:,jl) = Gsum(:,:,jl-1) - Gsum(:,:,jl)
END DO
!
- ENDIF ! partfun_swi
-
- IF( raft_swi == 1 ) THEN ! Ridging and rafting ice participation functions
+ ENDIF
+
+ IF( ln_rafting ) THEN ! Ridging and rafting ice participation functions
!
DO jl = 1, jpl
DO jj = 1, jpj
DO ji = 1, jpi
- IF ( athorn(ji,jj,jl) .GT. 0._wp ) THEN
+ IF ( athorn(ji,jj,jl) > 0._wp ) THEN
!!gm TANH( -X ) = - TANH( X ) so can be computed only 1 time....
- aridge(ji,jj,jl) = ( TANH ( Craft * ( ht_i(ji,jj,jl) - hparmeter ) ) + 1.0 ) * 0.5 * athorn(ji,jj,jl)
- araft (ji,jj,jl) = ( TANH ( -Craft * ( ht_i(ji,jj,jl) - hparmeter ) ) + 1.0 ) * 0.5 * athorn(ji,jj,jl)
+ aridge(ji,jj,jl) = ( TANH ( rn_craft * ( ht_i(ji,jj,jl) - rn_hraft ) ) + 1.0 ) * 0.5 * athorn(ji,jj,jl)
+ araft (ji,jj,jl) = ( TANH ( -rn_craft * ( ht_i(ji,jj,jl) - rn_hraft ) ) + 1.0 ) * 0.5 * athorn(ji,jj,jl)
IF ( araft(ji,jj,jl) < epsi06 ) araft(ji,jj,jl) = 0._wp
aridge(ji,jj,jl) = MAX( athorn(ji,jj,jl) - araft(ji,jj,jl), 0.0 )
- ENDIF ! athorn
- END DO ! ji
- END DO ! jj
- END DO ! jl
-
- ELSE ! raft_swi = 0
+ ENDIF
+ END DO
+ END DO
+ END DO
+
+ ELSE
!
DO jl = 1, jpl
@@ -741,11 +712,11 @@
ENDIF
- IF ( raft_swi == 1 ) THEN
-
- IF( MAXVAL(aridge + araft - athorn(:,:,1:jpl)) .GT. epsi10 ) THEN
+ IF( ln_rafting ) THEN
+
+ IF( MAXVAL(aridge + araft - athorn(:,:,1:jpl)) > epsi10 .AND. lwp ) THEN
DO jl = 1, jpl
DO jj = 1, jpj
DO ji = 1, jpi
- IF ( aridge(ji,jj,jl) + araft(ji,jj,jl) - athorn(ji,jj,jl) .GT. epsi10 ) THEN
+ IF ( aridge(ji,jj,jl) + araft(ji,jj,jl) - athorn(ji,jj,jl) > epsi10 ) THEN
WRITE(numout,*) ' ALERTE 96 : wrong participation function ... '
WRITE(numout,*) ' ji, jj, jl : ', ji, jj, jl
@@ -793,11 +764,11 @@
DO ji = 1, jpi
- IF (a_i(ji,jj,jl) .GT. epsi10 .AND. athorn(ji,jj,jl) .GT. 0.0 ) THEN
- hi = v_i(ji,jj,jl) / a_i(ji,jj,jl)
- hrmean = MAX(SQRT(Hstar*hi), hi*krdgmin)
- hrmin(ji,jj,jl) = MIN(2.0*hi, 0.5*(hrmean + hi))
+ IF (a_i(ji,jj,jl) > epsi10 .AND. athorn(ji,jj,jl) > 0.0 ) THEN
+ zhi = v_i(ji,jj,jl) / a_i(ji,jj,jl)
+ hrmean = MAX(SQRT(rn_hstar*zhi), zhi*krdgmin)
+ hrmin(ji,jj,jl) = MIN(2.0*zhi, 0.5*(hrmean + zhi))
hrmax(ji,jj,jl) = 2.0*hrmean - hrmin(ji,jj,jl)
- hraft(ji,jj,jl) = kraft*hi
- krdg(ji,jj,jl) = hrmean / hi
+ hraft(ji,jj,jl) = kraft*zhi
+ krdg(ji,jj,jl) = hrmean / zhi
ELSE
hraft(ji,jj,jl) = 0.0
@@ -807,7 +778,7 @@
ENDIF
- END DO ! ji
- END DO ! jj
- END DO ! jl
+ END DO
+ END DO
+ END DO
! Normalization factor : aksum, ensures mass conservation
@@ -841,12 +812,8 @@
LOGICAL, PARAMETER :: l_conservation_check = .true. ! if true, check conservation (useful for debugging)
!
- LOGICAL :: neg_ato_i ! flag for ato_i(i,j) < -puny
- LOGICAL :: large_afrac ! flag for afrac > 1
- LOGICAL :: large_afrft ! flag for afrac > 1
INTEGER :: ji, jj, jl, jl1, jl2, jk ! dummy loop indices
INTEGER :: ij ! horizontal index, combines i and j loops
INTEGER :: icells ! number of cells with aicen > puny
- REAL(wp) :: hL, hR, farea, zdummy, zdummy0, ztmelts ! left and right limits of integration
- REAL(wp) :: zsstK ! SST in Kelvin
+ REAL(wp) :: hL, hR, farea, ztmelts ! left and right limits of integration
INTEGER , POINTER, DIMENSION(:) :: indxi, indxj ! compressed indices
@@ -864,5 +831,4 @@
REAL(wp), POINTER, DIMENSION(:,:) :: ardg1 , ardg2 ! area of ice ridged & new ridges
REAL(wp), POINTER, DIMENSION(:,:) :: vsrdg , esrdg ! snow volume & energy of ridging ice
- REAL(wp), POINTER, DIMENSION(:,:) :: oirdg1, oirdg2 ! areal age content of ridged & rifging ice
REAL(wp), POINTER, DIMENSION(:,:) :: dhr , dhr2 ! hrmax - hrmin & hrmax^2 - hrmin^2
@@ -873,4 +839,5 @@
REAL(wp), POINTER, DIMENSION(:,:) :: srdg2 ! sal*volume of new ridges
REAL(wp), POINTER, DIMENSION(:,:) :: smsw ! sal*volume of water trapped into ridges
+ REAL(wp), POINTER, DIMENSION(:,:) :: oirdg1, oirdg2 ! ice age of ice ridged
REAL(wp), POINTER, DIMENSION(:,:) :: afrft ! fraction of category area rafted
@@ -878,5 +845,5 @@
REAL(wp), POINTER, DIMENSION(:,:) :: virft , vsrft ! ice & snow volume of rafting ice
REAL(wp), POINTER, DIMENSION(:,:) :: esrft , smrft ! snow energy & salinity of rafting ice
- REAL(wp), POINTER, DIMENSION(:,:) :: oirft1, oirft2 ! areal age content of rafted ice & rafting ice
+ REAL(wp), POINTER, DIMENSION(:,:) :: oirft1, oirft2 ! ice age of ice rafted
REAL(wp), POINTER, DIMENSION(:,:,:) :: eirft ! ice energy of rafting ice
@@ -886,12 +853,12 @@
!!----------------------------------------------------------------------
- CALL wrk_alloc( (jpi+1)*(jpj+1), indxi, indxj )
- CALL wrk_alloc( jpi, jpj, vice_init, vice_final, eice_init, eice_final )
- CALL wrk_alloc( jpi, jpj, afrac, fvol , ardg1, ardg2, vsrdg, esrdg, oirdg1, oirdg2, dhr, dhr2 )
- CALL wrk_alloc( jpi, jpj, vrdg1, vrdg2, vsw , srdg1, srdg2, smsw )
- CALL wrk_alloc( jpi, jpj, afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 )
- CALL wrk_alloc( jpi, jpj, jpl, aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init )
- CALL wrk_alloc( jpi, jpj, nlay_i+1, eirft, erdg1, erdg2, ersw )
- CALL wrk_alloc( jpi, jpj, nlay_i+1, jpl, eicen_init )
+ CALL wrk_alloc( (jpi+1)*(jpj+1), indxi, indxj )
+ CALL wrk_alloc( jpi, jpj, vice_init, vice_final, eice_init, eice_final )
+ CALL wrk_alloc( jpi, jpj, afrac, fvol , ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 )
+ CALL wrk_alloc( jpi, jpj, vrdg1, vrdg2, vsw , srdg1, srdg2, smsw, oirdg1, oirdg2 )
+ CALL wrk_alloc( jpi, jpj, afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 )
+ CALL wrk_alloc( jpi, jpj, jpl, aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init )
+ CALL wrk_alloc( jpi, jpj, nlay_i, eirft, erdg1, erdg2, ersw )
+ CALL wrk_alloc( jpi, jpj, nlay_i, jpl, eicen_init )
! Conservation check
@@ -901,6 +868,6 @@
CALL lim_column_sum (jpl, v_i, vice_init )
CALL lim_column_sum_energy (jpl, nlay_i, e_i, eice_init )
- DO ji = mi0(jiindx), mi1(jiindx)
- DO jj = mj0(jjindx), mj1(jjindx)
+ DO ji = mi0(iiceprt), mi1(iiceprt)
+ DO jj = mj0(jiceprt), mj1(jiceprt)
WRITE(numout,*) ' vice_init : ', vice_init(ji,jj)
WRITE(numout,*) ' eice_init : ', eice_init(ji,jj)
@@ -912,52 +879,26 @@
! 1) Compute change in open water area due to closing and opening.
!-------------------------------------------------------------------------------
-
- neg_ato_i = .false.
-
DO jj = 1, jpj
DO ji = 1, jpi
ato_i(ji,jj) = ato_i(ji,jj) - athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice &
& + opning(ji,jj) * rdt_ice
- IF( ato_i(ji,jj) < -epsi10 ) THEN
- neg_ato_i = .TRUE.
- ELSEIF( ato_i(ji,jj) < 0._wp ) THEN ! roundoff error
+ IF ( ato_i(ji,jj) < -epsi10 ) THEN ! there is a bug
+ IF(lwp) WRITE(numout,*) 'Ridging error: ato_i < 0 -- ato_i : ',ato_i(ji,jj)
+ ELSEIF( ato_i(ji,jj) < 0._wp ) THEN ! roundoff error
ato_i(ji,jj) = 0._wp
ENDIF
- END DO !jj
- END DO !ji
-
- ! if negative open water area alert it
- IF( neg_ato_i ) THEN ! there is a bug
- DO jj = 1, jpj
- DO ji = 1, jpi
- IF( ato_i(ji,jj) < -epsi10 ) THEN
- WRITE(numout,*) ''
- WRITE(numout,*) 'Ridging error: ato_i < 0'
- WRITE(numout,*) 'ato_i : ', ato_i(ji,jj)
- ENDIF ! ato_i < -epsi10
- END DO
- END DO
- ENDIF
+ END DO
+ END DO
!-----------------------------------------------------------------
! 2) Save initial state variables
!-----------------------------------------------------------------
-
- DO jl = 1, jpl
- aicen_init(:,:,jl) = a_i(:,:,jl)
- vicen_init(:,:,jl) = v_i(:,:,jl)
- vsnwn_init(:,:,jl) = v_s(:,:,jl)
- !
- smv_i_init(:,:,jl) = smv_i(:,:,jl)
- oa_i_init (:,:,jl) = oa_i (:,:,jl)
- END DO !jl
-
- esnwn_init(:,:,:) = e_s(:,:,1,:)
-
- DO jl = 1, jpl
- DO jk = 1, nlay_i
- eicen_init(:,:,jk,jl) = e_i(:,:,jk,jl)
- END DO
- END DO
+ aicen_init(:,:,:) = a_i (:,:,:)
+ vicen_init(:,:,:) = v_i (:,:,:)
+ vsnwn_init(:,:,:) = v_s (:,:,:)
+ smv_i_init(:,:,:) = smv_i(:,:,:)
+ esnwn_init(:,:,:) = e_s (:,:,1,:)
+ eicen_init(:,:,:,:) = e_i (:,:,:,:)
+ oa_i_init (:,:,:) = oa_i (:,:,:)
!
@@ -982,12 +923,8 @@
indxi(icells) = ji
indxj(icells) = jj
- ENDIF ! test on a_icen_init
- END DO ! ji
- END DO ! jj
-
- large_afrac = .false.
- large_afrft = .false.
-
-!CDIR NODEP
+ ENDIF
+ END DO
+ END DO
+
DO ij = 1, icells
ji = indxi(ij)
@@ -1003,9 +940,4 @@
arft2(ji,jj) = arft1(ji,jj) / kraft
- oirdg1(ji,jj)= aridge(ji,jj,jl1)*closing_gross(ji,jj)*rdt_ice
- oirft1(ji,jj)= araft (ji,jj,jl1)*closing_gross(ji,jj)*rdt_ice
- oirdg2(ji,jj)= oirdg1(ji,jj) / krdg(ji,jj,jl1)
- oirft2(ji,jj)= oirft1(ji,jj) / kraft
-
!---------------------------------------------------------------
! 3.3) Compute ridging /rafting fractions, make sure afrac <=1
@@ -1015,12 +947,13 @@
afrft(ji,jj) = arft1(ji,jj) / aicen_init(ji,jj,jl1) !rafting
- IF (afrac(ji,jj) > kamax + epsi10) THEN !riging
- large_afrac = .true.
- ELSEIF (afrac(ji,jj) > kamax) THEN ! roundoff error
+ IF( afrac(ji,jj) > kamax + epsi10 ) THEN ! there is a bug
+ IF(lwp) WRITE(numout,*) ' ardg > a_i -- ardg, aicen_init : ', ardg1(ji,jj), aicen_init(ji,jj,jl1)
+ ELSEIF( afrac(ji,jj) > kamax ) THEN ! roundoff error
afrac(ji,jj) = kamax
ENDIF
- IF (afrft(ji,jj) > kamax + epsi10) THEN !rafting
- large_afrft = .true.
- ELSEIF (afrft(ji,jj) > kamax) THEN ! roundoff error
+
+ IF( afrft(ji,jj) > kamax + epsi10 ) THEN ! there is a bug
+ IF(lwp) WRITE(numout,*) ' arft > a_i -- arft, aicen_init : ', arft1(ji,jj), aicen_init(ji,jj,jl1)
+ ELSEIF( afrft(ji,jj) > kamax) THEN ! roundoff error
afrft(ji,jj) = kamax
ENDIF
@@ -1031,39 +964,42 @@
!--------------------------------------------------------------------------
vrdg1(ji,jj) = vicen_init(ji,jj,jl1) * afrac(ji,jj)
- vrdg2(ji,jj) = vrdg1(ji,jj) * ( 1. + ridge_por )
- vsw (ji,jj) = vrdg1(ji,jj) * ridge_por
-
- vsrdg(ji,jj) = vsnwn_init(ji,jj,jl1) * afrac(ji,jj)
- esrdg(ji,jj) = esnwn_init(ji,jj,jl1) * afrac(ji,jj)
- srdg1(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj)
- srdg2(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) !! MV HC 2014 this line seems useless
+ vrdg2(ji,jj) = vrdg1(ji,jj) * ( 1. + rn_por_rdg )
+ vsw (ji,jj) = vrdg1(ji,jj) * rn_por_rdg
+
+ vsrdg (ji,jj) = vsnwn_init(ji,jj,jl1) * afrac(ji,jj)
+ esrdg (ji,jj) = esnwn_init(ji,jj,jl1) * afrac(ji,jj)
+ srdg1 (ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj)
+ oirdg1(ji,jj) = oa_i_init (ji,jj,jl1) * afrac(ji,jj)
+ oirdg2(ji,jj) = oa_i_init (ji,jj,jl1) * afrac(ji,jj) / krdg(ji,jj,jl1)
! rafting volumes, heat contents ...
- virft(ji,jj) = vicen_init(ji,jj,jl1) * afrft(ji,jj)
- vsrft(ji,jj) = vsnwn_init(ji,jj,jl1) * afrft(ji,jj)
- esrft(ji,jj) = esnwn_init(ji,jj,jl1) * afrft(ji,jj)
- smrft(ji,jj) = smv_i_init(ji,jj,jl1) * afrft(ji,jj)
+ virft (ji,jj) = vicen_init(ji,jj,jl1) * afrft(ji,jj)
+ vsrft (ji,jj) = vsnwn_init(ji,jj,jl1) * afrft(ji,jj)
+ esrft (ji,jj) = esnwn_init(ji,jj,jl1) * afrft(ji,jj)
+ smrft (ji,jj) = smv_i_init(ji,jj,jl1) * afrft(ji,jj)
+ oirft1(ji,jj) = oa_i_init (ji,jj,jl1) * afrft(ji,jj)
+ oirft2(ji,jj) = oa_i_init (ji,jj,jl1) * afrft(ji,jj) / kraft
! substract everything
- a_i(ji,jj,jl1) = a_i(ji,jj,jl1) - ardg1(ji,jj) - arft1(ji,jj)
- v_i(ji,jj,jl1) = v_i(ji,jj,jl1) - vrdg1(ji,jj) - virft(ji,jj)
- v_s(ji,jj,jl1) = v_s(ji,jj,jl1) - vsrdg(ji,jj) - vsrft(ji,jj)
- e_s(ji,jj,1,jl1) = e_s(ji,jj,1,jl1) - esrdg(ji,jj) - esrft(ji,jj)
+ a_i(ji,jj,jl1) = a_i(ji,jj,jl1) - ardg1 (ji,jj) - arft1 (ji,jj)
+ v_i(ji,jj,jl1) = v_i(ji,jj,jl1) - vrdg1 (ji,jj) - virft (ji,jj)
+ v_s(ji,jj,jl1) = v_s(ji,jj,jl1) - vsrdg (ji,jj) - vsrft (ji,jj)
+ e_s(ji,jj,1,jl1) = e_s(ji,jj,1,jl1) - esrdg (ji,jj) - esrft (ji,jj)
+ smv_i(ji,jj,jl1) = smv_i(ji,jj,jl1) - srdg1 (ji,jj) - smrft (ji,jj)
oa_i(ji,jj,jl1) = oa_i(ji,jj,jl1) - oirdg1(ji,jj) - oirft1(ji,jj)
- smv_i(ji,jj,jl1) = smv_i(ji,jj,jl1) - srdg1(ji,jj) - smrft(ji,jj)
!-----------------------------------------------------------------
! 3.5) Compute properties of new ridges
!-----------------------------------------------------------------
- !-------------
+ !---------
! Salinity
- !-------------
+ !---------
smsw(ji,jj) = vsw(ji,jj) * sss_m(ji,jj) ! salt content of seawater frozen in voids !! MV HC2014
srdg2(ji,jj) = srdg1(ji,jj) + smsw(ji,jj) ! salt content of new ridge
- !srdg2(ji,jj) = MIN( s_i_max * vrdg2(ji,jj) , zsrdg2 ) ! impose a maximum salinity
+ !srdg2(ji,jj) = MIN( rn_simax * vrdg2(ji,jj) , zsrdg2 ) ! impose a maximum salinity
sfx_dyn(ji,jj) = sfx_dyn(ji,jj) - smsw(ji,jj) * rhoic * r1_rdtice
- wfx_dyn(ji,jj) = wfx_dyn(ji,jj) - vsw (ji,jj) * rhoic * r1_rdtice ! gurvan: increase in ice volume du to seawater frozen in voids
+ wfx_dyn(ji,jj) = wfx_dyn(ji,jj) - vsw (ji,jj) * rhoic * r1_rdtice ! increase in ice volume du to seawater frozen in voids
!------------------------------------
@@ -1091,10 +1027,10 @@
! ij looping 1-icells
- msnow_mlt(ji,jj) = msnow_mlt(ji,jj) + rhosn*vsrdg(ji,jj)*(1.0-fsnowrdg) & ! rafting included
- & + rhosn*vsrft(ji,jj)*(1.0-fsnowrft)
-
- ! in 1e-9 Joules (same as e_s)
- esnow_mlt(ji,jj) = esnow_mlt(ji,jj) - esrdg(ji,jj)*(1.0-fsnowrdg) & !rafting included
- & - esrft(ji,jj)*(1.0-fsnowrft)
+ msnow_mlt(ji,jj) = msnow_mlt(ji,jj) + rhosn*vsrdg(ji,jj)*(1.0-rn_fsnowrdg) & ! rafting included
+ & + rhosn*vsrft(ji,jj)*(1.0-rn_fsnowrft)
+
+ ! in J/m2 (same as e_s)
+ esnow_mlt(ji,jj) = esnow_mlt(ji,jj) - esrdg(ji,jj)*(1.0-rn_fsnowrdg) & !rafting included
+ & - esrft(ji,jj)*(1.0-rn_fsnowrft)
!-----------------------------------------------------------------
@@ -1109,5 +1045,5 @@
dhr2(ji,jj) = hrmax(ji,jj,jl1) * hrmax(ji,jj,jl1) - hrmin(ji,jj,jl1) * hrmin(ji,jj,jl1)
- END DO ! ij
+ END DO
!--------------------------------------------------------------------
@@ -1116,5 +1052,4 @@
!--------------------------------------------------------------------
DO jk = 1, nlay_i
-!CDIR NODEP
DO ij = 1, icells
ji = indxi(ij)
@@ -1128,57 +1063,23 @@
! enthalpy of the trapped seawater (J/m2, >0)
! clem: if sst>0, then ersw <0 (is that possible?)
- zsstK = sst_m(ji,jj) + rt0
- ersw(ji,jj,jk) = - rhoic * vsw(ji,jj) * rcp * ( zsstK - rt0 ) / REAL( nlay_i )
+ ersw(ji,jj,jk) = - rhoic * vsw(ji,jj) * rcp * sst_m(ji,jj) * r1_nlay_i
! heat flux to the ocean
hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + ersw(ji,jj,jk) * r1_rdtice ! > 0 [W.m-2] ocean->ice flux
- ! Correct dimensions to avoid big values
- ersw(ji,jj,jk) = ersw(ji,jj,jk) / unit_fac
-
- ! Mutliply by ice volume, and divide by number of layers to get heat content in 1.e9 J
- ! it is added to sea ice because the sign convention is the opposite of the sign convention for the ocean
- !! MV HC 2014
- ersw (ji,jj,jk) = ersw(ji,jj,jk) * area(ji,jj)
-
+ ! it is added to sea ice because the sign convention is the opposite of the sign convention for the ocean
erdg2(ji,jj,jk) = erdg1(ji,jj,jk) + ersw(ji,jj,jk)
- END DO ! ij
- END DO !jk
+ END DO
+ END DO
IF( con_i ) THEN
DO jk = 1, nlay_i
-!CDIR NODEP
DO ij = 1, icells
ji = indxi(ij)
jj = indxj(ij)
eice_init(ji,jj) = eice_init(ji,jj) + erdg2(ji,jj,jk) - erdg1(ji,jj,jk)
- END DO ! ij
- END DO !jk
- ENDIF
-
- IF( large_afrac ) THEN ! there is a bug
-!CDIR NODEP
- DO ij = 1, icells
- ji = indxi(ij)
- jj = indxj(ij)
- IF( afrac(ji,jj) > kamax + epsi10 ) THEN
- WRITE(numout,*) ''
- WRITE(numout,*) ' ardg > a_i'
- WRITE(numout,*) ' ardg, aicen_init : ', ardg1(ji,jj), aicen_init(ji,jj,jl1)
- ENDIF
- END DO
- ENDIF
- IF( large_afrft ) THEN ! there is a bug
-!CDIR NODEP
- DO ij = 1, icells
- ji = indxi(ij)
- jj = indxj(ij)
- IF( afrft(ji,jj) > kamax + epsi10 ) THEN
- WRITE(numout,*) ''
- WRITE(numout,*) ' arft > a_i'
- WRITE(numout,*) ' arft, aicen_init : ', arft1(ji,jj), aicen_init(ji,jj,jl1)
- ENDIF
+ END DO
END DO
ENDIF
@@ -1190,5 +1091,4 @@
DO jl2 = 1, jpl
! over categories to which ridged ice is transferred
-!CDIR NODEP
DO ij = 1, icells
ji = indxi(ij)
@@ -1199,6 +1099,5 @@
! Transfer area, volume, and energy accordingly.
- IF( hrmin(ji,jj,jl1) >= hi_max(jl2) .OR. &
- hrmax(ji,jj,jl1) <= hi_max(jl2-1) ) THEN
+ IF( hrmin(ji,jj,jl1) >= hi_max(jl2) .OR. hrmax(ji,jj,jl1) <= hi_max(jl2-1) ) THEN
hL = 0._wp
hR = 0._wp
@@ -1214,18 +1113,17 @@
a_i (ji,jj ,jl2) = a_i (ji,jj ,jl2) + ardg2 (ji,jj) * farea
v_i (ji,jj ,jl2) = v_i (ji,jj ,jl2) + vrdg2 (ji,jj) * fvol(ji,jj)
- v_s (ji,jj ,jl2) = v_s (ji,jj ,jl2) + vsrdg (ji,jj) * fvol(ji,jj) * fsnowrdg
- e_s (ji,jj,1,jl2) = e_s (ji,jj,1,jl2) + esrdg (ji,jj) * fvol(ji,jj) * fsnowrdg
+ v_s (ji,jj ,jl2) = v_s (ji,jj ,jl2) + vsrdg (ji,jj) * fvol(ji,jj) * rn_fsnowrdg
+ e_s (ji,jj,1,jl2) = e_s (ji,jj,1,jl2) + esrdg (ji,jj) * fvol(ji,jj) * rn_fsnowrdg
smv_i(ji,jj ,jl2) = smv_i(ji,jj ,jl2) + srdg2 (ji,jj) * fvol(ji,jj)
oa_i (ji,jj ,jl2) = oa_i (ji,jj ,jl2) + oirdg2(ji,jj) * farea
- END DO ! ij
+ END DO
! Transfer ice energy to category jl2 by ridging
DO jk = 1, nlay_i
-!CDIR NODEP
DO ij = 1, icells
ji = indxi(ij)
jj = indxj(ij)
- e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) + fvol(ji,jj)*erdg2(ji,jj,jk)
+ e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) + fvol(ji,jj) * erdg2(ji,jj,jk)
END DO
END DO
@@ -1235,5 +1133,4 @@
DO jl2 = 1, jpl
-!CDIR NODEP
DO ij = 1, icells
ji = indxi(ij)
@@ -1242,30 +1139,27 @@
! thickness category jl2, transfer area, volume, and energy accordingly.
!
- IF( hraft(ji,jj,jl1) <= hi_max(jl2) .AND. &
- hraft(ji,jj,jl1) > hi_max(jl2-1) ) THEN
+ IF( hraft(ji,jj,jl1) <= hi_max(jl2) .AND. hraft(ji,jj,jl1) > hi_max(jl2-1) ) THEN
a_i (ji,jj ,jl2) = a_i (ji,jj ,jl2) + arft2 (ji,jj)
v_i (ji,jj ,jl2) = v_i (ji,jj ,jl2) + virft (ji,jj)
- v_s (ji,jj ,jl2) = v_s (ji,jj ,jl2) + vsrft (ji,jj) * fsnowrft
- e_s (ji,jj,1,jl2) = e_s (ji,jj,1,jl2) + esrft (ji,jj) * fsnowrft
+ v_s (ji,jj ,jl2) = v_s (ji,jj ,jl2) + vsrft (ji,jj) * rn_fsnowrft
+ e_s (ji,jj,1,jl2) = e_s (ji,jj,1,jl2) + esrft (ji,jj) * rn_fsnowrft
smv_i(ji,jj ,jl2) = smv_i(ji,jj ,jl2) + smrft (ji,jj)
- oa_i (ji,jj ,jl2) = oa_i (ji,jj ,jl2) + oirft2(ji,jj)
- ENDIF ! hraft
+ oa_i (ji,jj ,jl2) = oa_i (ji,jj ,jl2) + oirft2(ji,jj)
+ ENDIF
!
- END DO ! ij
+ END DO
! Transfer rafted ice energy to category jl2
DO jk = 1, nlay_i
-!CDIR NODEP
DO ij = 1, icells
ji = indxi(ij)
jj = indxj(ij)
- IF( hraft(ji,jj,jl1) <= hi_max(jl2) .AND. &
- hraft(ji,jj,jl1) > hi_max(jl2-1) ) THEN
+ IF( hraft(ji,jj,jl1) <= hi_max(jl2) .AND. hraft(ji,jj,jl1) > hi_max(jl2-1) ) THEN
e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) + eirft(ji,jj,jk)
ENDIF
- END DO ! ij
- END DO !jk
-
- END DO ! jl2
+ END DO
+ END DO
+
+ END DO
END DO ! jl1 (deforming categories)
@@ -1281,6 +1175,6 @@
CALL lim_cons_check (eice_init, eice_final, 1.0e-2, fieldid)
- DO ji = mi0(jiindx), mi1(jiindx)
- DO jj = mj0(jjindx), mj1(jjindx)
+ DO ji = mi0(iiceprt), mi1(iiceprt)
+ DO jj = mj0(jiceprt), mj1(jiceprt)
WRITE(numout,*) ' vice_init : ', vice_init (ji,jj)
WRITE(numout,*) ' vice_final : ', vice_final(ji,jj)
@@ -1291,37 +1185,14 @@
ENDIF
!
- CALL wrk_dealloc( (jpi+1)*(jpj+1), indxi, indxj )
- CALL wrk_dealloc( jpi, jpj, vice_init, vice_final, eice_init, eice_final )
- CALL wrk_dealloc( jpi, jpj, afrac, fvol , ardg1, ardg2, vsrdg, esrdg, oirdg1, oirdg2, dhr, dhr2 )
- CALL wrk_dealloc( jpi, jpj, vrdg1, vrdg2, vsw , srdg1, srdg2, smsw )
- CALL wrk_dealloc( jpi, jpj, afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 )
- CALL wrk_dealloc( jpi, jpj, jpl, aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init )
- CALL wrk_dealloc( jpi, jpj, nlay_i+1, eirft, erdg1, erdg2, ersw )
- CALL wrk_dealloc( jpi, jpj, nlay_i+1, jpl, eicen_init )
+ CALL wrk_dealloc( (jpi+1)*(jpj+1), indxi, indxj )
+ CALL wrk_dealloc( jpi, jpj, vice_init, vice_final, eice_init, eice_final )
+ CALL wrk_dealloc( jpi, jpj, afrac, fvol , ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 )
+ CALL wrk_dealloc( jpi, jpj, vrdg1, vrdg2, vsw , srdg1, srdg2, smsw, oirdg1, oirdg2 )
+ CALL wrk_dealloc( jpi, jpj, afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 )
+ CALL wrk_dealloc( jpi, jpj, jpl, aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init )
+ CALL wrk_dealloc( jpi, jpj, nlay_i, eirft, erdg1, erdg2, ersw )
+ CALL wrk_dealloc( jpi, jpj, nlay_i, jpl, eicen_init )
!
END SUBROUTINE lim_itd_me_ridgeshift
-
-
- SUBROUTINE lim_itd_me_asumr
- !!-----------------------------------------------------------------------------
- !! *** ROUTINE lim_itd_me_asumr ***
- !!
- !! ** Purpose : finds total fractional area
- !!
- !! ** Method : Find the total area of ice plus open water in each grid cell.
- !! This is similar to the aggregate_area subroutine except that the
- !! total area can be greater than 1, so the open water area is
- !! included in the sum instead of being computed as a residual.
- !!-----------------------------------------------------------------------------
- INTEGER :: jl ! dummy loop index
- !!-----------------------------------------------------------------------------
- !
- asum(:,:) = ato_i(:,:) ! open water
- DO jl = 1, jpl ! ice categories
- asum(:,:) = asum(:,:) + a_i(:,:,jl)
- END DO
- !
- END SUBROUTINE lim_itd_me_asumr
-
SUBROUTINE lim_itd_me_init
@@ -1339,7 +1210,7 @@
!!-------------------------------------------------------------------
INTEGER :: ios ! Local integer output status for namelist read
- NAMELIST/namiceitdme/ ridge_scheme_swi, Cs, Cf, fsnowrdg, fsnowrft, &
- & Gstar, astar, Hstar, raft_swi, hparmeter, Craft, ridge_por, &
- & partfun_swi, brinstren_swi
+ NAMELIST/namiceitdme/ rn_cs, rn_fsnowrdg, rn_fsnowrft, &
+ & rn_gstar, rn_astar, rn_hstar, ln_rafting, rn_hraft, rn_craft, rn_por_rdg, &
+ & nn_partfun
!!-------------------------------------------------------------------
!
@@ -1357,130 +1228,18 @@
WRITE(numout,*)' lim_itd_me_init : ice parameters for mechanical ice redistribution '
WRITE(numout,*)' ~~~~~~~~~~~~~~~'
- WRITE(numout,*)' Switch choosing the ice redistribution scheme ridge_scheme_swi', ridge_scheme_swi
- WRITE(numout,*)' Fraction of shear energy contributing to ridging Cs ', Cs
- WRITE(numout,*)' Ratio of ridging work to PotEner change in ridging Cf ', Cf
- WRITE(numout,*)' Fraction of snow volume conserved during ridging fsnowrdg ', fsnowrdg
- WRITE(numout,*)' Fraction of snow volume conserved during ridging fsnowrft ', fsnowrft
- WRITE(numout,*)' Fraction of total ice coverage contributing to ridging Gstar ', Gstar
- WRITE(numout,*)' Equivalent to G* for an exponential part function astar ', astar
- WRITE(numout,*)' Quantity playing a role in max ridged ice thickness Hstar ', Hstar
- WRITE(numout,*)' Rafting of ice sheets or not raft_swi ', raft_swi
- WRITE(numout,*)' Parmeter thickness (threshold between ridge-raft) hparmeter ', hparmeter
- WRITE(numout,*)' Rafting hyperbolic tangent coefficient Craft ', Craft
- WRITE(numout,*)' Initial porosity of ridges ridge_por ', ridge_por
- WRITE(numout,*)' Switch for part. function (0) linear (1) exponential partfun_swi ', partfun_swi
- WRITE(numout,*)' Switch for including brine volume in ice strength comp. brinstren_swi ', brinstren_swi
+ WRITE(numout,*)' Fraction of shear energy contributing to ridging rn_cs = ', rn_cs
+ WRITE(numout,*)' Fraction of snow volume conserved during ridging rn_fsnowrdg = ', rn_fsnowrdg
+ WRITE(numout,*)' Fraction of snow volume conserved during ridging rn_fsnowrft = ', rn_fsnowrft
+ WRITE(numout,*)' Fraction of total ice coverage contributing to ridging rn_gstar = ', rn_gstar
+ WRITE(numout,*)' Equivalent to G* for an exponential part function rn_astar = ', rn_astar
+ WRITE(numout,*)' Quantity playing a role in max ridged ice thickness rn_hstar = ', rn_hstar
+ WRITE(numout,*)' Rafting of ice sheets or not ln_rafting = ', ln_rafting
+ WRITE(numout,*)' Parmeter thickness (threshold between ridge-raft) rn_hraft = ', rn_hraft
+ WRITE(numout,*)' Rafting hyperbolic tangent coefficient rn_craft = ', rn_craft
+ WRITE(numout,*)' Initial porosity of ridges rn_por_rdg = ', rn_por_rdg
+ WRITE(numout,*)' Switch for part. function (0) linear (1) exponential nn_partfun = ', nn_partfun
ENDIF
!
END SUBROUTINE lim_itd_me_init
-
-
- SUBROUTINE lim_itd_me_zapsmall
- !!-------------------------------------------------------------------
- !! *** ROUTINE lim_itd_me_zapsmall ***
- !!
- !! ** Purpose : Remove too small sea ice areas and correct salt fluxes
- !!
- !! history :
- !! author: William H. Lipscomb, LANL
- !! Nov 2003: Modified by Julie Schramm to conserve volume and energy
- !! Sept 2004: Modified by William Lipscomb; replaced normalize_state with
- !! additions to local freshwater, salt, and heat fluxes
- !! 9.0, LIM3.0 - 02-2006 (M. Vancoppenolle) original code
- !!-------------------------------------------------------------------
- INTEGER :: ji, jj, jl, jk ! dummy loop indices
- INTEGER :: icells ! number of cells with ice to zap
-
- REAL(wp), POINTER, DIMENSION(:,:) :: zmask ! 2D workspace
- REAL(wp) :: zmask_glo, zsal, zvi, zvs, zei, zes
-!!gm REAL(wp) :: xtmp ! temporary variable
- !!-------------------------------------------------------------------
-
- CALL wrk_alloc( jpi, jpj, zmask )
-
- ! to be sure that at_i is the sum of a_i(jl)
- at_i(:,:) = SUM( a_i(:,:,:), dim=3 )
-
- DO jl = 1, jpl
- !-----------------------------------------------------------------
- ! Count categories to be zapped.
- !-----------------------------------------------------------------
- icells = 0
- zmask(:,:) = 0._wp
- DO jj = 1, jpj
- DO ji = 1, jpi
- IF( a_i(ji,jj,jl) <= epsi10 .OR. v_i(ji,jj,jl) <= epsi10 .OR. at_i(ji,jj) <= epsi10 ) THEN
- zmask(ji,jj) = 1._wp
- ENDIF
- END DO
- END DO
- !zmask_glo = glob_sum(zmask)
- !IF( ln_nicep .AND. lwp ) WRITE(numout,*) zmask_glo, ' cells of ice zapped in the ocean '
-
- !-----------------------------------------------------------------
- ! Zap ice energy and use ocean heat to melt ice
- !-----------------------------------------------------------------
-
- DO jk = 1, nlay_i
- DO jj = 1 , jpj
- DO ji = 1 , jpi
- zei = e_i(ji,jj,jk,jl)
- e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * ( 1._wp - zmask(ji,jj) )
- t_i(ji,jj,jk,jl) = t_i(ji,jj,jk,jl) * ( 1._wp - zmask(ji,jj) ) + rtt * zmask(ji,jj)
- ! update exchanges with ocean
- hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_i(ji,jj,jk,jl) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0
- END DO
- END DO
- END DO
-
- DO jj = 1 , jpj
- DO ji = 1 , jpi
-
- zsal = smv_i(ji,jj,jl)
- zvi = v_i(ji,jj,jl)
- zvs = v_s(ji,jj,jl)
- zes = e_s(ji,jj,1,jl)
- !-----------------------------------------------------------------
- ! Zap snow energy and use ocean heat to melt snow
- !-----------------------------------------------------------------
- ! xtmp = esnon(i,j,n) / dt ! < 0
- ! fhnet(i,j) = fhnet(i,j) + xtmp
- ! fhnet_hist(i,j) = fhnet_hist(i,j) + xtmp
- ! xtmp is greater than 0
- ! fluxes are positive to the ocean
- ! here the flux has to be negative for the ocean
- t_s(ji,jj,1,jl) = rtt * zmask(ji,jj) + t_s(ji,jj,1,jl) * ( 1._wp - zmask(ji,jj) )
-
- !-----------------------------------------------------------------
- ! zap ice and snow volume, add water and salt to ocean
- !-----------------------------------------------------------------
- ato_i(ji,jj) = a_i (ji,jj,jl) * zmask(ji,jj) + ato_i(ji,jj)
- a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - zmask(ji,jj) )
- v_i (ji,jj,jl) = v_i (ji,jj,jl) * ( 1._wp - zmask(ji,jj) )
- v_s (ji,jj,jl) = v_s (ji,jj,jl) * ( 1._wp - zmask(ji,jj) )
- t_su (ji,jj,jl) = t_su (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) + t_bo(ji,jj) * zmask(ji,jj)
- oa_i (ji,jj,jl) = oa_i (ji,jj,jl) * ( 1._wp - zmask(ji,jj) )
- smv_i(ji,jj,jl) = smv_i(ji,jj,jl) * ( 1._wp - zmask(ji,jj) )
- e_s(ji,jj,1,jl) = e_s(ji,jj,1,jl) * ( 1._wp - zmask(ji,jj) )
- ! additional condition
- IF( v_s(ji,jj,jl) <= epsi10 ) THEN
- v_s(ji,jj,jl) = 0._wp
- e_s(ji,jj,1,jl) = 0._wp
- ENDIF
- ! update exchanges with ocean
- sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice
- wfx_res(ji,jj) = wfx_res(ji,jj) - ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice
- wfx_snw(ji,jj) = wfx_snw(ji,jj) - ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice
- hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0
- END DO
- END DO
- END DO ! jl
-
- ! to be sure that at_i is the sum of a_i(jl)
- at_i(:,:) = SUM( a_i(:,:,:), dim=3 )
- !
- CALL wrk_dealloc( jpi, jpj, zmask )
- !
- END SUBROUTINE lim_itd_me_zapsmall
#else
@@ -1493,10 +1252,6 @@
SUBROUTINE lim_itd_me_icestrength
END SUBROUTINE lim_itd_me_icestrength
- SUBROUTINE lim_itd_me_sort
- END SUBROUTINE lim_itd_me_sort
SUBROUTINE lim_itd_me_init
END SUBROUTINE lim_itd_me_init
- SUBROUTINE lim_itd_me_zapsmall
- END SUBROUTINE lim_itd_me_zapsmall
#endif
!!======================================================================
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90 (revision 5602)
@@ -13,5 +13,4 @@
!! 'key_lim3' : LIM3 sea-ice model
!!----------------------------------------------------------------------
- !! lim_itd_th : thermodynamics of ice thickness distribution
!! lim_itd_th_rem :
!! lim_itd_th_reb :
@@ -25,8 +24,5 @@
USE thd_ice ! LIM-3 thermodynamic variables
USE ice ! LIM-3 variables
- USE par_ice ! LIM-3 parameters
- USE limthd_lac ! LIM-3 lateral accretion
USE limvar ! LIM-3 variables
- USE limcons ! LIM-3 conservation
USE prtctl ! Print control
USE in_out_manager ! I/O manager
@@ -34,15 +30,11 @@
USE wrk_nemo ! work arrays
USE lib_fortran ! to use key_nosignedzero
- USE timing ! Timing
- USE limcons ! conservation tests
+ USE limcons ! conservation tests
IMPLICIT NONE
PRIVATE
- PUBLIC lim_itd_th ! called by ice_stp
PUBLIC lim_itd_th_rem
PUBLIC lim_itd_th_reb
- PUBLIC lim_itd_fitline
- PUBLIC lim_itd_shiftice
!!----------------------------------------------------------------------
@@ -53,84 +45,4 @@
CONTAINS
- SUBROUTINE lim_itd_th( kt )
- !!------------------------------------------------------------------
- !! *** ROUTINE lim_itd_th ***
- !!
- !! ** Purpose : computes the thermodynamics of ice thickness distribution
- !!
- !! ** Method :
- !!------------------------------------------------------------------
- INTEGER, INTENT(in) :: kt ! time step index
- !
- INTEGER :: ji, jj, jk, jl ! dummy loop index
- !
- REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b
- !!------------------------------------------------------------------
- IF( nn_timing == 1 ) CALL timing_start('limitd_th')
-
- ! conservation test
- IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_th', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
-
- IF( kt == nit000 .AND. lwp ) THEN
- WRITE(numout,*)
- WRITE(numout,*) 'lim_itd_th : Thermodynamics of the ice thickness distribution'
- WRITE(numout,*) '~~~~~~~~~~~'
- ENDIF
-
- !------------------------------------------------------------------------------|
- ! 1) Transport of ice between thickness categories. |
- !------------------------------------------------------------------------------|
- ! Given thermodynamic growth rates, transport ice between
- ! thickness categories.
- IF( jpl > 1 ) CALL lim_itd_th_rem( 1, jpl, kt )
- !
- CALL lim_var_glo2eqv ! only for info
- CALL lim_var_agg(1)
-
- !------------------------------------------------------------------------------|
- ! 3) Add frazil ice growing in leads.
- !------------------------------------------------------------------------------|
- CALL lim_thd_lac
- CALL lim_var_glo2eqv ! only for info
-
- IF(ln_ctl) THEN ! Control print
- CALL prt_ctl_info(' ')
- CALL prt_ctl_info(' - Cell values : ')
- CALL prt_ctl_info(' ~~~~~~~~~~~~~ ')
- CALL prt_ctl(tab2d_1=area , clinfo1=' lim_itd_th : cell area :')
- CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_th : at_i :')
- CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_th : vt_i :')
- CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_itd_th : vt_s :')
- DO jl = 1, jpl
- CALL prt_ctl_info(' ')
- CALL prt_ctl_info(' - Category : ', ivar1=jl)
- CALL prt_ctl_info(' ~~~~~~~~~~')
- CALL prt_ctl(tab2d_1=a_i (:,:,jl) , clinfo1= ' lim_itd_th : a_i : ')
- CALL prt_ctl(tab2d_1=ht_i (:,:,jl) , clinfo1= ' lim_itd_th : ht_i : ')
- CALL prt_ctl(tab2d_1=ht_s (:,:,jl) , clinfo1= ' lim_itd_th : ht_s : ')
- CALL prt_ctl(tab2d_1=v_i (:,:,jl) , clinfo1= ' lim_itd_th : v_i : ')
- CALL prt_ctl(tab2d_1=v_s (:,:,jl) , clinfo1= ' lim_itd_th : v_s : ')
- CALL prt_ctl(tab2d_1=e_s (:,:,1,jl) , clinfo1= ' lim_itd_th : e_s : ')
- CALL prt_ctl(tab2d_1=t_su (:,:,jl) , clinfo1= ' lim_itd_th : t_su : ')
- CALL prt_ctl(tab2d_1=t_s (:,:,1,jl) , clinfo1= ' lim_itd_th : t_snow : ')
- CALL prt_ctl(tab2d_1=sm_i (:,:,jl) , clinfo1= ' lim_itd_th : sm_i : ')
- CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' lim_itd_th : smv_i : ')
- DO jk = 1, nlay_i
- CALL prt_ctl_info(' ')
- CALL prt_ctl_info(' - Layer : ', ivar1=jk)
- CALL prt_ctl_info(' ~~~~~~~')
- CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_itd_th : t_i : ')
- CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_itd_th : e_i : ')
- END DO
- END DO
- ENDIF
- !
- ! conservation test
- IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limitd_th', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
- !
- IF( nn_timing == 1 ) CALL timing_stop('limitd_th')
- END SUBROUTINE lim_itd_th
- !
-
SUBROUTINE lim_itd_th_rem( klbnd, kubnd, kt )
!!------------------------------------------------------------------
@@ -153,5 +65,5 @@
REAL(wp) :: zx1, zwk1, zdh0, zetamin, zdamax ! local scalars
REAL(wp) :: zx2, zwk2, zda0, zetamax ! - -
- REAL(wp) :: zx3, zareamin ! - -
+ REAL(wp) :: zx3
CHARACTER (len = 15) :: fieldid
@@ -179,14 +91,12 @@
!!------------------------------------------------------------------
- CALL wrk_alloc( jpi,jpj, zremap_flag ) ! integer
- CALL wrk_alloc( jpi,jpj,jpl-1, zdonor ) ! integer
+ CALL wrk_alloc( jpi,jpj, zremap_flag )
+ CALL wrk_alloc( jpi,jpj,jpl-1, zdonor )
CALL wrk_alloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es )
CALL wrk_alloc( jpi,jpj,jpl-1, zdaice, zdvice )
CALL wrk_alloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 )
CALL wrk_alloc( (jpi+1)*(jpj+1), zvetamin, zvetamax )
- CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j ) ! integer
+ CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j )
CALL wrk_alloc( jpi,jpj, zhb0,zhb1,vt_i_init,vt_i_final,vt_s_init,vt_s_final,et_i_init,et_i_final,et_s_init,et_s_final )
-
- zareamin = epsi10 !minimum area in thickness categories tolerated by the conceptors of the model
!!----------------------------------------------------------------------------------------------
@@ -216,9 +126,9 @@
DO jj = 1, jpj
DO ji = 1, jpi
- rswitch = 1.0 - MAX( 0.0, SIGN( 1.0, - a_i(ji,jj,jl) + epsi10 ) ) !0 if no ice and 1 if yes
+ rswitch = MAX( 0.0, SIGN( 1.0, a_i(ji,jj,jl) - epsi10 ) ) !0 if no ice and 1 if yes
ht_i(ji,jj,jl) = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * rswitch
- rswitch = 1.0 - MAX( 0.0, SIGN( 1.0, - a_i_b(ji,jj,jl) + epsi10) ) !0 if no ice and 1 if yes
+ rswitch = MAX( 0.0, SIGN( 1.0, a_i_b(ji,jj,jl) - epsi10) )
zht_i_b(ji,jj,jl) = v_i_b(ji,jj,jl) / MAX( a_i_b(ji,jj,jl), epsi10 ) * rswitch
- IF( a_i(ji,jj,jl) > epsi10 ) zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_b(ji,jj,jl)
+ IF( a_i(ji,jj,jl) > epsi10 ) zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_b(ji,jj,jl) ! clem: useless IF statement?
END DO
END DO
@@ -239,5 +149,5 @@
DO jj = 1, jpj
DO ji = 1, jpi
- IF ( at_i(ji,jj) .gt. zareamin ) THEN
+ IF ( at_i(ji,jj) > epsi10 ) THEN
nbrem = nbrem + 1
nind_i(nbrem) = ji
@@ -247,6 +157,6 @@
zremap_flag(ji,jj) = 0
ENDIF
- END DO !ji
- END DO !jj
+ END DO
+ END DO
!-----------------------------------------------------------------------------------------------
@@ -254,7 +164,4 @@
!-----------------------------------------------------------------------------------------------
!- 4.1 Compute category boundaries
- ! Tricky trick see limitd_me.F90
- ! will be soon removed, CT
- ! hi_max(kubnd) = 99.
zhbnew(:,:,:) = 0._wp
@@ -265,11 +172,11 @@
!
zhbnew(ii,ij,jl) = hi_max(jl)
- IF ( a_i_b(ii,ij,jl) > epsi10 .AND. a_i_b(ii,ij,jl+1) > epsi10 ) THEN
+ IF ( a_i_b(ii,ij,jl) > epsi10 .AND. a_i_b(ii,ij,jl+1) > epsi10 ) THEN
!interpolate between adjacent category growth rates
zslope = ( zdhice(ii,ij,jl+1) - zdhice(ii,ij,jl) ) / ( zht_i_b(ii,ij,jl+1) - zht_i_b(ii,ij,jl) )
zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) + zslope * ( hi_max(jl) - zht_i_b(ii,ij,jl) )
- ELSEIF ( a_i_b(ii,ij,jl) > epsi10) THEN
+ ELSEIF( a_i_b(ii,ij,jl) > epsi10) THEN
zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl)
- ELSEIF ( a_i_b(ii,ij,jl+1) > epsi10) THEN
+ ELSEIF( a_i_b(ii,ij,jl+1) > epsi10) THEN
zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl+1)
ENDIF
@@ -280,16 +187,23 @@
ii = nind_i(ji)
ij = nind_j(ji)
- IF( a_i(ii,ij,jl) > epsi10 .AND. ht_i(ii,ij,jl) >= zhbnew(ii,ij,jl) ) THEN
+
+ ! clem: we do not want ht_i to be too close to either HR or HL otherwise a division by nearly 0 is possible
+ ! in lim_itd_fitline in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice)
+ IF ( a_i(ii,ij,jl ) > epsi10 .AND. ht_i(ii,ij,jl ) > ( zhbnew(ii,ij,jl) - epsi10 ) ) THEN
zremap_flag(ii,ij) = 0
- ELSEIF( a_i(ii,ij,jl+1) > epsi10 .AND. ht_i(ii,ij,jl+1) <= zhbnew(ii,ij,jl) ) THEN
+ ELSEIF( a_i(ii,ij,jl+1) > epsi10 .AND. ht_i(ii,ij,jl+1) < ( zhbnew(ii,ij,jl) + epsi10 ) ) THEN
zremap_flag(ii,ij) = 0
ENDIF
!- 4.3 Check that each zhbnew does not exceed maximal values hi_max
+ IF( zhbnew(ii,ij,jl) < hi_max(jl-1) ) zremap_flag(ii,ij) = 0
IF( zhbnew(ii,ij,jl) > hi_max(jl+1) ) zremap_flag(ii,ij) = 0
- IF( zhbnew(ii,ij,jl) < hi_max(jl-1) ) zremap_flag(ii,ij) = 0
- END DO
-
- END DO !jl
+ ! clem bug: why is not the following instead?
+ !!IF( zhbnew(ii,ij,jl) < hi_max(jl-1) ) zremap_flag(ii,ij) = 0
+ !!IF( zhbnew(ii,ij,jl) > hi_max(jl ) ) zremap_flag(ii,ij) = 0
+
+ END DO
+
+ END DO
!-----------------------------------------------------------------------------------------------
@@ -312,21 +226,24 @@
DO jj = 1, jpj
DO ji = 1, jpi
- zhb0(ji,jj) = hi_max(0) ! 0eme
- zhb1(ji,jj) = hi_max(1) ! 1er
-
- zhbnew(ji,jj,klbnd-1) = 0._wp
+ zhb0(ji,jj) = hi_max(0)
+ zhb1(ji,jj) = hi_max(1)
IF( a_i(ji,jj,kubnd) > epsi10 ) THEN
- zhbnew(ji,jj,kubnd) = 3._wp * ht_i(ji,jj,kubnd) - 2._wp * zhbnew(ji,jj,kubnd-1)
+ zhbnew(ji,jj,kubnd) = MAX( hi_max(kubnd-1), 3._wp * ht_i(ji,jj,kubnd) - 2._wp * zhbnew(ji,jj,kubnd-1) )
ELSE
- zhbnew(ji,jj,kubnd) = hi_max(kubnd)
- !!? clem bug: since hi_max(jpl)=99, this limit is very high
- !!? but I think it is erased in fitline subroutine
- ENDIF
-
- IF( zhbnew(ji,jj,kubnd) < hi_max(kubnd-1) ) zhbnew(ji,jj,kubnd) = hi_max(kubnd-1)
-
- END DO !jj
- END DO !jj
+!clem bug zhbnew(ji,jj,kubnd) = hi_max(kubnd)
+ zhbnew(ji,jj,kubnd) = hi_max(kubnd-1) ! not used anyway
+ ENDIF
+
+ ! clem: we do not want ht_i_b to be too close to either HR or HL otherwise a division by nearly 0 is possible
+ ! in lim_itd_fitline in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice)
+ IF ( zht_i_b(ji,jj,klbnd) < ( zhb0(ji,jj) + epsi10 ) ) THEN
+ zremap_flag(ji,jj) = 0
+ ELSEIF( zht_i_b(ji,jj,klbnd) > ( zhb1(ji,jj) - epsi10 ) ) THEN
+ zremap_flag(ji,jj) = 0
+ ENDIF
+
+ END DO
+ END DO
!-----------------------------------------------------------------------------------------------
@@ -334,6 +251,5 @@
!-----------------------------------------------------------------------------------------------
!- 7.1 g(h) for category 1 at start of time step
- CALL lim_itd_fitline( klbnd, zhb0, zhb1, zht_i_b(:,:,klbnd), &
- & g0(:,:,klbnd), g1(:,:,klbnd), hL(:,:,klbnd), &
+ CALL lim_itd_fitline( klbnd, zhb0, zhb1, zht_i_b(:,:,klbnd), g0(:,:,klbnd), g1(:,:,klbnd), hL(:,:,klbnd), &
& hR(:,:,klbnd), zremap_flag )
@@ -343,48 +259,39 @@
ij = nind_j(ji)
- !ji
- IF (a_i(ii,ij,klbnd) .gt. epsi10) THEN
+ IF( a_i(ii,ij,klbnd) > epsi10 ) THEN
+
zdh0 = zdhice(ii,ij,klbnd) !decrease of ice thickness in the lower category
- ! ji, a_i > epsi10
- IF (zdh0 .lt. 0.0) THEN !remove area from category 1
- ! ji, a_i > epsi10; zdh0 < 0
- zdh0 = MIN(-zdh0,hi_max(klbnd))
-
+
+ IF( zdh0 < 0.0 ) THEN !remove area from category 1
+ zdh0 = MIN( -zdh0, hi_max(klbnd) )
!Integrate g(1) from 0 to dh0 to estimate area melted
- zetamax = MIN(zdh0,hR(ii,ij,klbnd)) - hL(ii,ij,klbnd)
- IF (zetamax.gt.0.0) THEN
- zx1 = zetamax
- zx2 = 0.5 * zetamax*zetamax
- zda0 = g1(ii,ij,klbnd) * zx2 + g0(ii,ij,klbnd) * zx1 !ice area removed
- ! Constrain new thickness <= ht_i
- zdamax = a_i(ii,ij,klbnd) * &
- (1.0 - ht_i(ii,ij,klbnd)/zht_i_b(ii,ij,klbnd)) ! zdamax > 0
- !ice area lost due to melting of thin ice
- zda0 = MIN(zda0, zdamax)
-
+ zetamax = MIN( zdh0, hR(ii,ij,klbnd) ) - hL(ii,ij,klbnd)
+
+ IF( zetamax > 0.0 ) THEN
+ zx1 = zetamax
+ zx2 = 0.5 * zetamax * zetamax
+ zda0 = g1(ii,ij,klbnd) * zx2 + g0(ii,ij,klbnd) * zx1 ! ice area removed
+ zdamax = a_i(ii,ij,klbnd) * (1.0 - ht_i(ii,ij,klbnd) / zht_i_b(ii,ij,klbnd) ) ! Constrain new thickness <= ht_i
+ zda0 = MIN( zda0, zdamax ) ! ice area lost due to melting
+ ! of thin ice (zdamax > 0)
! Remove area, conserving volume
- ht_i(ii,ij,klbnd) = ht_i(ii,ij,klbnd) &
- * a_i(ii,ij,klbnd) / ( a_i(ii,ij,klbnd) - zda0 )
+ ht_i(ii,ij,klbnd) = ht_i(ii,ij,klbnd) * a_i(ii,ij,klbnd) / ( a_i(ii,ij,klbnd) - zda0 )
a_i(ii,ij,klbnd) = a_i(ii,ij,klbnd) - zda0
- v_i(ii,ij,klbnd) = a_i(ii,ij,klbnd)*ht_i(ii,ij,klbnd) ! clem-useless ?
- ENDIF ! zetamax > 0
- ! ji, a_i > epsi10
-
- ELSE ! if ice accretion
- ! ji, a_i > epsi10; zdh0 > 0
- zhbnew(ii,ij,klbnd-1) = MIN(zdh0,hi_max(klbnd))
- ! zhbnew was 0, and is shifted to the right to account for thin ice
- ! growth in openwater (F0 = f1)
- ENDIF ! zdh0
-
- ! a_i > epsi10
- ENDIF ! a_i > epsi10
-
- END DO ! ji
+ v_i(ii,ij,klbnd) = a_i(ii,ij,klbnd) * ht_i(ii,ij,klbnd) ! clem-useless ?
+ ENDIF
+
+ ELSE ! if ice accretion zdh0 > 0
+ ! zhbnew was 0, and is shifted to the right to account for thin ice growth in openwater (F0 = f1)
+ zhbnew(ii,ij,klbnd-1) = MIN( zdh0, hi_max(klbnd) )
+ ENDIF
+
+ ENDIF
+
+ END DO
!- 7.3 g(h) for each thickness category
DO jl = klbnd, kubnd
- CALL lim_itd_fitline(jl, zhbnew(:,:,jl-1), zhbnew(:,:,jl), ht_i(:,:,jl), &
- g0(:,:,jl), g1(:,:,jl), hL(:,:,jl), hR(:,:,jl), zremap_flag)
+ CALL lim_itd_fitline( jl, zhbnew(:,:,jl-1), zhbnew(:,:,jl), ht_i(:,:,jl), &
+ & g0(:,:,jl), g1(:,:,jl), hL(:,:,jl), hR(:,:,jl), zremap_flag )
END DO
@@ -406,36 +313,34 @@
ij = nind_j(ji)
- IF (zhbnew(ii,ij,jl) .gt. hi_max(jl)) THEN ! transfer from jl to jl+1
-
+ IF (zhbnew(ii,ij,jl) > hi_max(jl)) THEN ! transfer from jl to jl+1
! left and right integration limits in eta space
- zvetamin(ji) = MAX(hi_max(jl), hL(ii,ij,jl)) - hL(ii,ij,jl)
- zvetamax(ji) = MIN(zhbnew(ii,ij,jl), hR(ii,ij,jl)) - hL(ii,ij,jl)
+ zvetamin(ji) = MAX( hi_max(jl), hL(ii,ij,jl) ) - hL(ii,ij,jl)
+ zvetamax(ji) = MIN( zhbnew(ii,ij,jl), hR(ii,ij,jl) ) - hL(ii,ij,jl)
zdonor(ii,ij,jl) = jl
- ELSE ! zhbnew(jl) <= hi_max(jl) ; transfer from jl+1 to jl
-
+ ELSE ! zhbnew(jl) <= hi_max(jl) ; transfer from jl+1 to jl
! left and right integration limits in eta space
zvetamin(ji) = 0.0
- zvetamax(ji) = MIN(hi_max(jl), hR(ii,ij,jl+1)) - hL(ii,ij,jl+1)
+ zvetamax(ji) = MIN( hi_max(jl), hR(ii,ij,jl+1) ) - hL(ii,ij,jl+1)
zdonor(ii,ij,jl) = jl + 1
- ENDIF ! zhbnew(jl) > hi_max(jl)
-
- zetamax = MAX(zvetamax(ji), zvetamin(ji)) ! no transfer if etamax < etamin
+ ENDIF
+
+ zetamax = MAX( zvetamax(ji), zvetamin(ji) ) ! no transfer if etamax < etamin
zetamin = zvetamin(ji)
zx1 = zetamax - zetamin
- zwk1 = zetamin*zetamin
- zwk2 = zetamax*zetamax
- zx2 = 0.5 * (zwk2 - zwk1)
+ zwk1 = zetamin * zetamin
+ zwk2 = zetamax * zetamax
+ zx2 = 0.5 * ( zwk2 - zwk1 )
zwk1 = zwk1 * zetamin
zwk2 = zwk2 * zetamax
- zx3 = 1.0/3.0 * (zwk2 - zwk1)
+ zx3 = 1.0 / 3.0 * ( zwk2 - zwk1 )
nd = zdonor(ii,ij,jl)
zdaice(ii,ij,jl) = g1(ii,ij,nd)*zx2 + g0(ii,ij,nd)*zx1
zdvice(ii,ij,jl) = g1(ii,ij,nd)*zx3 + g0(ii,ij,nd)*zx2 + zdaice(ii,ij,jl)*hL(ii,ij,nd)
- END DO ! ji
- END DO ! jl klbnd -> kubnd - 1
+ END DO
+ END DO
!!----------------------------------------------------------------------------------------------
@@ -451,9 +356,9 @@
ii = nind_i(ji)
ij = nind_j(ji)
- IF ( a_i(ii,ij,1) > epsi10 .AND. ht_i(ii,ij,1) < hiclim ) THEN
- a_i(ii,ij,1) = a_i(ii,ij,1) * ht_i(ii,ij,1) / hiclim
- ht_i(ii,ij,1) = hiclim
+ IF ( a_i(ii,ij,1) > epsi10 .AND. ht_i(ii,ij,1) < rn_himin ) THEN
+ a_i (ii,ij,1) = a_i(ii,ij,1) * ht_i(ii,ij,1) / rn_himin
+ ht_i(ii,ij,1) = rn_himin
ENDIF
- END DO !ji
+ END DO
!!----------------------------------------------------------------------------------------------
@@ -479,11 +384,11 @@
ENDIF
- CALL wrk_dealloc( jpi,jpj, zremap_flag ) ! integer
- CALL wrk_dealloc( jpi,jpj,jpl-1, zdonor ) ! integer
+ CALL wrk_dealloc( jpi,jpj, zremap_flag )
+ CALL wrk_dealloc( jpi,jpj,jpl-1, zdonor )
CALL wrk_dealloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es )
CALL wrk_dealloc( jpi,jpj,jpl-1, zdaice, zdvice )
CALL wrk_dealloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 )
CALL wrk_dealloc( (jpi+1)*(jpj+1), zvetamin, zvetamax )
- CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j ) ! integer
+ CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j )
CALL wrk_dealloc( jpi,jpj, zhb0,zhb1,vt_i_init,vt_i_final,vt_s_init,vt_s_final,et_i_init,et_i_final,et_s_init,et_s_final )
@@ -491,6 +396,5 @@
- SUBROUTINE lim_itd_fitline( num_cat, HbL, Hbr, hice, &
- & g0, g1, hL, hR, zremap_flag )
+ SUBROUTINE lim_itd_fitline( num_cat, HbL, Hbr, hice, g0, g1, hL, hR, zremap_flag )
!!------------------------------------------------------------------
!! *** ROUTINE lim_itd_fitline ***
@@ -511,5 +415,5 @@
INTEGER , DIMENSION(jpi,jpj), INTENT(in ) :: zremap_flag !
!
- INTEGER :: ji,jj ! horizontal indices
+ INTEGER :: ji,jj ! horizontal indices
REAL(wp) :: zh13 ! HbL + 1/3 * (HbR - HbL)
REAL(wp) :: zh23 ! HbL + 2/3 * (HbR - HbL)
@@ -518,20 +422,17 @@
!!------------------------------------------------------------------
!
- !
DO jj = 1, jpj
DO ji = 1, jpi
!
IF( zremap_flag(ji,jj) == 1 .AND. a_i(ji,jj,num_cat) > epsi10 &
- & .AND. hice(ji,jj) > 0._wp ) THEN
+ & .AND. hice(ji,jj) > 0._wp ) THEN
! Initialize hL and hR
-
hL(ji,jj) = HbL(ji,jj)
hR(ji,jj) = HbR(ji,jj)
! Change hL or hR if hice falls outside central third of range
-
- zh13 = 1.0/3.0 * (2.0*hL(ji,jj) + hR(ji,jj))
- zh23 = 1.0/3.0 * (hL(ji,jj) + 2.0*hR(ji,jj))
+ zh13 = 1.0 / 3.0 * ( 2.0 * hL(ji,jj) + hR(ji,jj) )
+ zh23 = 1.0 / 3.0 * ( hL(ji,jj) + 2.0 * hR(ji,jj) )
IF ( hice(ji,jj) < zh13 ) THEN ; hR(ji,jj) = 3._wp * hice(ji,jj) - 2._wp * hL(ji,jj)
@@ -540,17 +441,16 @@
! Compute coefficients of g(eta) = g0 + g1*eta
-
zdhr = 1._wp / (hR(ji,jj) - hL(ji,jj))
zwk1 = 6._wp * a_i(ji,jj,num_cat) * zdhr
zwk2 = ( hice(ji,jj) - hL(ji,jj) ) * zdhr
- g0(ji,jj) = zwk1 * ( 2._wp/3._wp - zwk2 )
- g1(ji,jj) = 2._wp * zdhr * zwk1 * (zwk2 - 0.5)
+ g0(ji,jj) = zwk1 * ( 2._wp / 3._wp - zwk2 )
+ g1(ji,jj) = 2._wp * zdhr * zwk1 * ( zwk2 - 0.5 )
!
- ELSE ! remap_flag = .false. or a_i < epsi10
+ ELSE ! remap_flag = .false. or a_i < epsi10
hL(ji,jj) = 0._wp
hR(ji,jj) = 0._wp
g0(ji,jj) = 0._wp
g1(ji,jj) = 0._wp
- ENDIF ! a_i > epsi10
+ ENDIF
!
END DO
@@ -576,5 +476,5 @@
INTEGER :: ji, jj, jl, jl2, jl1, jk ! dummy loop indices
- INTEGER :: ii, ij ! indices when changing from 2D-1D is done
+ INTEGER :: ii, ij ! indices when changing from 2D-1D is done
REAL(wp), POINTER, DIMENSION(:,:,:) :: zaTsfn
@@ -589,15 +489,10 @@
INTEGER, POINTER, DIMENSION(:) :: nind_i, nind_j ! compressed indices for i/j directions
- INTEGER :: nbrem ! number of cells with ice to transfer
-
- LOGICAL :: zdaice_negative ! true if daice < -puny
- LOGICAL :: zdvice_negative ! true if dvice < -puny
- LOGICAL :: zdaice_greater_aicen ! true if daice > aicen
- LOGICAL :: zdvice_greater_vicen ! true if dvice > vicen
+ INTEGER :: nbrem ! number of cells with ice to transfer
!!------------------------------------------------------------------
CALL wrk_alloc( jpi,jpj,jpl, zaTsfn )
CALL wrk_alloc( jpi,jpj, zworka )
- CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j ) ! integer
+ CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j )
!----------------------------------------------------------------------------------------------
@@ -606,91 +501,9 @@
DO jl = klbnd, kubnd
- zaTsfn(:,:,jl) = a_i(:,:,jl)*t_su(:,:,jl)
- END DO
-
- !----------------------------------------------------------------------------------------------
- ! 2) Check for daice or dvice out of range, allowing for roundoff error
- !----------------------------------------------------------------------------------------------
- ! Note: zdaice < 0 or zdvice < 0 usually happens when category jl
- ! has a small area, with h(n) very close to a boundary. Then
- ! the coefficients of g(h) are large, and the computed daice and
- ! dvice can be in error. If this happens, it is best to transfer
- ! either the entire category or nothing at all, depending on which
- ! side of the boundary hice(n) lies.
- !-----------------------------------------------------------------
- DO jl = klbnd, kubnd-1
-
- zdaice_negative = .false.
- zdvice_negative = .false.
- zdaice_greater_aicen = .false.
- zdvice_greater_vicen = .false.
-
- DO jj = 1, jpj
- DO ji = 1, jpi
-
- IF (zdonor(ji,jj,jl) .GT. 0) THEN
- jl1 = zdonor(ji,jj,jl)
-
- IF (zdaice(ji,jj,jl) .LT. 0.0) THEN
- IF (zdaice(ji,jj,jl) .GT. -epsi10) THEN
- IF ( ( jl1.EQ.jl .AND. ht_i(ji,jj,jl1) .GT. hi_max(jl) ) &
- .OR. &
- ( jl1.EQ.jl+1 .AND. ht_i(ji,jj,jl1) .LE. hi_max(jl) ) &
- ) THEN
- zdaice(ji,jj,jl) = a_i(ji,jj,jl1) ! shift entire category
- zdvice(ji,jj,jl) = v_i(ji,jj,jl1)
- ELSE
- zdaice(ji,jj,jl) = 0.0 ! shift no ice
- zdvice(ji,jj,jl) = 0.0
- ENDIF
- ELSE
- zdaice_negative = .true.
- ENDIF
- ENDIF
-
- IF (zdvice(ji,jj,jl) .LT. 0.0) THEN
- IF (zdvice(ji,jj,jl) .GT. -epsi10 ) THEN
- IF ( ( jl1.EQ.jl .AND. ht_i(ji,jj,jl1).GT.hi_max(jl) ) &
- .OR. &
- ( jl1.EQ.jl+1 .AND. ht_i(ji,jj,jl1) .LE. hi_max(jl) ) &
- ) THEN
- zdaice(ji,jj,jl) = a_i(ji,jj,jl1) ! shift entire category
- zdvice(ji,jj,jl) = v_i(ji,jj,jl1)
- ELSE
- zdaice(ji,jj,jl) = 0.0 ! shift no ice
- zdvice(ji,jj,jl) = 0.0
- ENDIF
- ELSE
- zdvice_negative = .true.
- ENDIF
- ENDIF
-
- ! If daice is close to aicen, set daice = aicen.
- IF (zdaice(ji,jj,jl) .GT. a_i(ji,jj,jl1) - epsi10 ) THEN
- IF (zdaice(ji,jj,jl) .LT. a_i(ji,jj,jl1)+epsi10) THEN
- zdaice(ji,jj,jl) = a_i(ji,jj,jl1)
- zdvice(ji,jj,jl) = v_i(ji,jj,jl1)
- ELSE
- zdaice_greater_aicen = .true.
- ENDIF
- ENDIF
-
- IF (zdvice(ji,jj,jl) .GT. v_i(ji,jj,jl1)-epsi10) THEN
- IF (zdvice(ji,jj,jl) .LT. v_i(ji,jj,jl1)+epsi10) THEN
- zdaice(ji,jj,jl) = a_i(ji,jj,jl1)
- zdvice(ji,jj,jl) = v_i(ji,jj,jl1)
- ELSE
- zdvice_greater_vicen = .true.
- ENDIF
- ENDIF
-
- ENDIF ! donor > 0
- END DO ! i
- END DO ! j
-
- END DO !jl
+ zaTsfn(:,:,jl) = a_i(:,:,jl) * t_su(:,:,jl)
+ END DO
!-------------------------------------------------------------------------------
- ! 3) Transfer volume and energy between categories
+ ! 2) Transfer volume and energy between categories
!-------------------------------------------------------------------------------
@@ -699,9 +512,9 @@
DO jj = 1, jpj
DO ji = 1, jpi
- IF (zdaice(ji,jj,jl) .GT. 0.0 ) THEN ! daice(n) can be < puny
+ IF (zdaice(ji,jj,jl) > 0.0 ) THEN ! daice(n) can be < puny
nbrem = nbrem + 1
nind_i(nbrem) = ji
nind_j(nbrem) = jj
- ENDIF ! tmask
+ ENDIF
END DO
END DO
@@ -712,8 +525,8 @@
jl1 = zdonor(ii,ij,jl)
- rswitch = MAX( 0.0 , SIGN( 1.0 , v_i(ii,ij,jl1) - epsi10 ) )
- zworka(ii,ij) = zdvice(ii,ij,jl) / MAX(v_i(ii,ij,jl1),epsi10) * rswitch
+ rswitch = MAX( 0._wp , SIGN( 1._wp , v_i(ii,ij,jl1) - epsi10 ) )
+ zworka(ii,ij) = zdvice(ii,ij,jl) / MAX( v_i(ii,ij,jl1), epsi10 ) * rswitch
IF( jl1 == jl) THEN ; jl2 = jl1+1
- ELSE ; jl2 = jl
+ ELSE ; jl2 = jl
ENDIF
@@ -721,5 +534,4 @@
! Ice areas
!--------------
-
a_i(ii,ij,jl1) = a_i(ii,ij,jl1) - zdaice(ii,ij,jl)
a_i(ii,ij,jl2) = a_i(ii,ij,jl2) + zdaice(ii,ij,jl)
@@ -728,5 +540,4 @@
! Ice volumes
!--------------
-
v_i(ii,ij,jl1) = v_i(ii,ij,jl1) - zdvice(ii,ij,jl)
v_i(ii,ij,jl2) = v_i(ii,ij,jl2) + zdvice(ii,ij,jl)
@@ -735,5 +546,4 @@
! Snow volumes
!--------------
-
zdvsnow = v_s(ii,ij,jl1) * zworka(ii,ij)
v_s(ii,ij,jl1) = v_s(ii,ij,jl1) - zdvsnow
@@ -743,5 +553,4 @@
! Snow heat content
!--------------------
-
zdesnow = e_s(ii,ij,1,jl1) * zworka(ii,ij)
e_s(ii,ij,1,jl1) = e_s(ii,ij,1,jl1) - zdesnow
@@ -751,5 +560,4 @@
! Ice age
!--------------
-
zdo_aice = oa_i(ii,ij,jl1) * zdaice(ii,ij,jl)
oa_i(ii,ij,jl1) = oa_i(ii,ij,jl1) - zdo_aice
@@ -759,5 +567,4 @@
! Ice salinity
!--------------
-
zdsm_vice = smv_i(ii,ij,jl1) * zworka(ii,ij)
smv_i(ii,ij,jl1) = smv_i(ii,ij,jl1) - zdsm_vice
@@ -767,10 +574,9 @@
! Surface temperature
!---------------------
-
zdaTsf = t_su(ii,ij,jl1) * zdaice(ii,ij,jl)
zaTsfn(ii,ij,jl1) = zaTsfn(ii,ij,jl1) - zdaTsf
zaTsfn(ii,ij,jl2) = zaTsfn(ii,ij,jl2) + zdaTsf
- END DO ! ji
+ END DO
!------------------
@@ -779,5 +585,4 @@
DO jk = 1, nlay_i
-!CDIR NODEP
DO ji = 1, nbrem
ii = nind_i(ji)
@@ -785,5 +590,5 @@
jl1 = zdonor(ii,ij,jl)
- IF (jl1 .EQ. jl) THEN
+ IF (jl1 == jl) THEN
jl2 = jl+1
ELSE ! n1 = n+1
@@ -794,6 +599,6 @@
e_i(ii,ij,jk,jl1) = e_i(ii,ij,jk,jl1) - zdeice
e_i(ii,ij,jk,jl2) = e_i(ii,ij,jk,jl2) + zdeice
- END DO ! ji
- END DO ! jk
+ END DO
+ END DO
END DO ! boundaries, 1 to ncat-1
@@ -809,16 +614,15 @@
ht_i(ji,jj,jl) = v_i (ji,jj,jl) / a_i(ji,jj,jl)
t_su(ji,jj,jl) = zaTsfn(ji,jj,jl) / a_i(ji,jj,jl)
- rswitch = 1.0 - MAX(0.0,SIGN(1.0,-v_s(ji,jj,jl)+epsi10)) !0 if no ice and 1 if yes
ELSE
ht_i(ji,jj,jl) = 0._wp
- t_su(ji,jj,jl) = rtt
+ t_su(ji,jj,jl) = rt0
ENDIF
- END DO ! ji
- END DO ! jj
- END DO ! jl
+ END DO
+ END DO
+ END DO
!
CALL wrk_dealloc( jpi,jpj,jpl, zaTsfn )
CALL wrk_dealloc( jpi,jpj, zworka )
- CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j ) ! integer
+ CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j )
!
END SUBROUTINE lim_itd_shiftice
@@ -846,5 +650,4 @@
REAL(wp), POINTER, DIMENSION(:,:) :: vt_s_init, vt_s_final ! snow volume summed over categories
!!------------------------------------------------------------------
- !! clem 2014/04: be carefull, rebining does not conserve salt(maybe?) => the difference is taken into account in limupdate
CALL wrk_alloc( jpi,jpj,jpl, zdonor ) ! interger
@@ -864,9 +667,6 @@
DO jj = 1, jpj
DO ji = 1, jpi
- IF( a_i(ji,jj,jl) > epsi10 ) THEN
- ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl)
- ELSE
- ht_i(ji,jj,jl) = 0._wp
- ENDIF
+ rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi10 ) )
+ ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * rswitch
END DO
END DO
@@ -874,19 +674,5 @@
!------------------------------------------------------------------------------
- ! 2) Make sure thickness of cat klbnd is at least hi_max(klbnd)
- !------------------------------------------------------------------------------
- DO jj = 1, jpj
- DO ji = 1, jpi
- IF( a_i(ji,jj,klbnd) > epsi10 ) THEN
- IF( ht_i(ji,jj,klbnd) <= hi_max(0) .AND. hi_max(0) > 0._wp ) THEN
- a_i(ji,jj,klbnd) = v_i(ji,jj,klbnd) / hi_max(0)
- ht_i(ji,jj,klbnd) = hi_max(0)
- ENDIF
- ENDIF
- END DO
- END DO
-
- !------------------------------------------------------------------------------
- ! 3) If a category thickness is not in bounds, shift the
+ ! 2) If a category thickness is not in bounds, shift the
! entire area, volume, and energy to the neighboring category
!------------------------------------------------------------------------------
@@ -917,15 +703,13 @@
zdonor(ji,jj,jl) = jl
! begin TECLIM change
- !zdaice(ji,jj,jl) = a_i(ji,jj,jl)
- !zdvice(ji,jj,jl) = v_i(ji,jj,jl)
!zdaice(ji,jj,jl) = a_i(ji,jj,jl) * 0.5_wp
!zdvice(ji,jj,jl) = v_i(ji,jj,jl)-zdaice(ji,jj,jl)*(hi_max(jl)+hi_max(jl-1)) * 0.5_wp
! end TECLIM change
! clem: how much of a_i you send in cat sup is somewhat arbitrary
- zdaice(ji,jj,jl) = a_i(ji,jj,jl) * ( ht_i(ji,jj,jl) - hi_max(jl) + epsi10 ) / ht_i(ji,jj,jl)
- zdvice(ji,jj,jl) = v_i(ji,jj,jl) - ( a_i(ji,jj,jl) - zdaice(ji,jj,jl) ) * ( hi_max(jl) - epsi10 )
+ zdaice(ji,jj,jl) = a_i(ji,jj,jl) * ( ht_i(ji,jj,jl) - hi_max(jl) + epsi20 ) / ht_i(ji,jj,jl)
+ zdvice(ji,jj,jl) = v_i(ji,jj,jl) - ( a_i(ji,jj,jl) - zdaice(ji,jj,jl) ) * ( hi_max(jl) - epsi20 )
ENDIF
- END DO ! ji
- END DO ! jj
+ END DO
+ END DO
IF(lk_mpp) CALL mpp_max( zshiftflag )
@@ -938,5 +722,5 @@
ENDIF
!
- END DO ! jl
+ END DO
!----------------------------
@@ -951,5 +735,4 @@
zshiftflag = 0
-!clem-change
DO jj = 1, jpj
DO ji = 1, jpi
@@ -961,6 +744,6 @@
zdvice(ji,jj,jl) = v_i(ji,jj,jl+1)
ENDIF
- END DO ! ji
- END DO ! jj
+ END DO
+ END DO
IF(lk_mpp) CALL mpp_max( zshiftflag )
@@ -973,21 +756,9 @@
zdvice(:,:,jl) = 0._wp
ENDIF
-!clem-change
-
-! ! clem-change begin: why not doing that?
-! DO jj = 1, jpj
-! DO ji = 1, jpi
-! IF( a_i(ji,jj,jl+1) > epsi10 .AND. ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN
-! ht_i(ji,jj,jl+1) = hi_max(jl) + epsi10
-! a_i (ji,jj,jl+1) = v_i(ji,jj,jl+1) / ht_i(ji,jj,jl+1)
-! ENDIF
-! END DO ! ji
-! END DO ! jj
- ! clem-change end
-
- END DO ! jl
+
+ END DO
!------------------------------------------------------------------------------
- ! 4) Conservation check
+ ! 3) Conservation check
!------------------------------------------------------------------------------
@@ -1002,5 +773,5 @@
ENDIF
!
- CALL wrk_dealloc( jpi,jpj,jpl, zdonor ) ! interger
+ CALL wrk_dealloc( jpi,jpj,jpl, zdonor )
CALL wrk_dealloc( jpi,jpj,jpl, zdaice, zdvice )
CALL wrk_dealloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final )
@@ -1013,8 +784,4 @@
!!----------------------------------------------------------------------
CONTAINS
- SUBROUTINE lim_itd_th ! Empty routines
- END SUBROUTINE lim_itd_th
- SUBROUTINE lim_itd_th_ini
- END SUBROUTINE lim_itd_th_ini
SUBROUTINE lim_itd_th_rem
END SUBROUTINE lim_itd_th_rem
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limmsh.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limmsh.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limmsh.F90 (revision 5602)
@@ -23,5 +23,5 @@
PRIVATE
- PUBLIC lim_msh ! routine called by ice_ini.F90
+ PUBLIC lim_msh ! routine called by sbcice_lim.F90
!!----------------------------------------------------------------------
@@ -41,5 +41,4 @@
!! - Definition of some constants linked with the grid
!! - Definition of the metric coef. for the sea/ice
- !! - Initialization of the ice masks (tmsk, umsk)
!!
!! Reference : Deleersnijder et al. Ocean Modelling 100, 7-10
@@ -103,17 +102,4 @@
!!gm end
- ! !== ice masks ==!
- tms(:,:) = tmask(:,:,1) ! ice T-point : use surface tmask
- tmu(:,:) = umask(:,:,1) ! ice U-point : use surface umask (C-grid EVP)
- tmv(:,:) = vmask(:,:,1) ! ice V-point : use surface vmask (C-grid EVP)
- DO jj = 1, jpjm1 ! ice F-point : recompute fmask (due to nn_shlat)
- DO ji = 1 , jpim1 ! NO vector opt.
- tmf(ji,jj) = tms(ji,jj) * tms(ji+1,jj) * tms(ji,jj+1) * tms(ji+1,jj+1)
- END DO
- END DO
- CALL lbc_lnk( tmf(:,:), 'F', 1. ) ! lateral boundary conditions
-
- ! !== unmasked and masked area of T-grid cell
- area(:,:) = e1t(:,:) * e2t(:,:)
!
END SUBROUTINE lim_msh
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90 (revision 5602)
@@ -102,5 +102,5 @@
!! and charge ellipse.
!! The user should make sure that the parameters
- !! nevp, telast and creepl maintain stress state
+ !! nn_nevp, elastic time scale and rn_creepl maintain stress state
!! on the charge ellipse for plastic flow
!! e.g. in the Canadian Archipelago
@@ -108,5 +108,4 @@
!! References : Hunke and Dukowicz, JPO97
!! Bouillon et al., Ocean Modelling 2009
- !! Vancoppenolle et al., Ocean Modelling 2008
!!-------------------------------------------------------------------
INTEGER, INTENT(in) :: k_j1 ! southern j-index for ice computation
@@ -117,18 +116,17 @@
CHARACTER (len=50) :: charout
REAL(wp) :: zt11, zt12, zt21, zt22, ztagnx, ztagny, delta !
- REAL(wp) :: za, zstms, zmask ! local scalars
- REAL(wp) :: zc1, zc2, zc3 ! ice mass
-
- REAL(wp) :: dtevp ! time step for subcycling
- REAL(wp) :: dtotel, ecc2, ecci ! square of yield ellipse eccenticity
- REAL(wp) :: z0, zr, zcca, zccb ! temporary scalars
- REAL(wp) :: zu_ice2, zv_ice1 !
- REAL(wp) :: zddc, zdtc ! delta on corners and on centre
- REAL(wp) :: zdst ! shear at the center of the grid point
- REAL(wp) :: zdsshx, zdsshy ! term for the gradient of ocean surface
- REAL(wp) :: sigma1, sigma2 ! internal ice stress
+ REAL(wp) :: za, zstms ! local scalars
+ REAL(wp) :: zc1, zc2, zc3 ! ice mass
+
+ REAL(wp) :: dtevp , z1_dtevp ! time step for subcycling
+ REAL(wp) :: dtotel, z1_dtotel, ecc2, ecci ! square of yield ellipse eccenticity
+ REAL(wp) :: z0, zr, zcca, zccb ! temporary scalars
+ REAL(wp) :: zu_ice2, zv_ice1 !
+ REAL(wp) :: zddc, zdtc ! delta on corners and on centre
+ REAL(wp) :: zdst ! shear at the center of the grid point
+ REAL(wp) :: zdsshx, zdsshy ! term for the gradient of ocean surface
+ REAL(wp) :: sigma1, sigma2 ! internal ice stress
REAL(wp) :: zresm ! Maximal error on ice velocity
- REAL(wp) :: zdummy ! dummy argument
REAL(wp) :: zintb, zintn ! dummy argument
@@ -139,8 +137,9 @@
REAL(wp), POINTER, DIMENSION(:,:) :: zcorl1, zcorl2 ! coriolis parameter on U/V points
REAL(wp), POINTER, DIMENSION(:,:) :: za1ct , za2ct ! temporary arrays
- REAL(wp), POINTER, DIMENSION(:,:) :: u_oce1, v_oce1 ! ocean u/v component on U points
- REAL(wp), POINTER, DIMENSION(:,:) :: u_oce2, v_oce2 ! ocean u/v component on V points
+ REAL(wp), POINTER, DIMENSION(:,:) :: v_oce1 ! ocean u/v component on U points
+ REAL(wp), POINTER, DIMENSION(:,:) :: u_oce2 ! ocean u/v component on V points
REAL(wp), POINTER, DIMENSION(:,:) :: u_ice2, v_ice1 ! ice u/v component on V/U point
REAL(wp), POINTER, DIMENSION(:,:) :: zf1 , zf2 ! arrays for internal stresses
+ REAL(wp), POINTER, DIMENSION(:,:) :: zmask ! mask ocean grid points
REAL(wp), POINTER, DIMENSION(:,:) :: zdt ! tension at centre of grid cells
@@ -152,8 +151,11 @@
! ocean surface (ssh_m) if ice is not embedded
! ice top surface if ice is embedded
+
+ REAL(wp), PARAMETER :: zepsi = 1.0e-20_wp ! tolerance parameter
+ REAL(wp), PARAMETER :: zvmin = 1.0e-03_wp ! ice volume below which ice velocity equals ocean velocity
!!-------------------------------------------------------------------
CALL wrk_alloc( jpi,jpj, zpresh, zfrld1, zmass1, zcorl1, za1ct , zpreshc, zfrld2, zmass2, zcorl2, za2ct )
- CALL wrk_alloc( jpi,jpj, u_oce1, u_oce2, u_ice2, v_oce1 , v_oce2, v_ice1 )
+ CALL wrk_alloc( jpi,jpj, u_oce2, u_ice2, v_oce1 , v_ice1 , zmask )
CALL wrk_alloc( jpi,jpj, zf1 , zu_ice, zf2 , zv_ice , zdt , zds )
CALL wrk_alloc( jpi,jpj, zdt , zds , zs1 , zs2 , zs12 , zresr , zpice )
@@ -161,14 +163,14 @@
#if defined key_lim2 && ! defined key_lim2_vp
# if defined key_agrif
- USE ice_2, vt_s => hsnm
- USE ice_2, vt_i => hicm
+ USE ice_2, vt_s => hsnm
+ USE ice_2, vt_i => hicm
# else
- vt_s => hsnm
- vt_i => hicm
+ vt_s => hsnm
+ vt_i => hicm
# endif
- at_i(:,:) = 1. - frld(:,:)
+ at_i(:,:) = 1. - frld(:,:)
#endif
#if defined key_agrif && defined key_lim2
- CALL agrif_rhg_lim2_load ! First interpolation of coarse values
+ CALL agrif_rhg_lim2_load ! First interpolation of coarse values
#endif
!
@@ -186,19 +188,17 @@
#if defined key_lim3
- CALL lim_itd_me_icestrength( ridge_scheme_swi ) ! LIM-3: Ice strength on T-points
-#endif
-
-!CDIR NOVERRCHK
+ CALL lim_itd_me_icestrength( nn_icestr ) ! LIM-3: Ice strength on T-points
+#endif
+
DO jj = k_j1 , k_jpj ! Ice mass and temp variables
-!CDIR NOVERRCHK
DO ji = 1 , jpi
#if defined key_lim3
- zpresh(ji,jj) = tms(ji,jj) * strength(ji,jj)
+ zpresh(ji,jj) = tmask(ji,jj,1) * strength(ji,jj)
#endif
#if defined key_lim2
- zpresh(ji,jj) = tms(ji,jj) * pstar * vt_i(ji,jj) * EXP( -c_rhg * (1. - at_i(ji,jj) ) )
-#endif
- ! tmi = 1 where there is ice or on land
- tmi(ji,jj) = 1._wp - ( 1._wp - MAX( 0._wp , SIGN ( 1._wp , vt_i(ji,jj) - epsd ) ) ) * tms(ji,jj)
+ zpresh(ji,jj) = tmask(ji,jj,1) * pstar * vt_i(ji,jj) * EXP( -c_rhg * (1. - at_i(ji,jj) ) )
+#endif
+ ! zmask = 1 where there is ice or on land
+ zmask(ji,jj) = 1._wp - ( 1._wp - MAX( 0._wp , SIGN ( 1._wp , vt_i(ji,jj) - zepsi ) ) ) * tmask(ji,jj,1)
END DO
END DO
@@ -206,20 +206,13 @@
! Ice strength on grid cell corners (zpreshc)
! needed for calculation of shear stress
-!CDIR NOVERRCHK
DO jj = k_j1+1, k_jpj-1
-!CDIR NOVERRCHK
DO ji = 2, jpim1 !RB caution no fs_ (ji+1,jj+1)
- zstms = tms(ji+1,jj+1) * wght(ji+1,jj+1,2,2) + &
- & tms(ji,jj+1) * wght(ji+1,jj+1,1,2) + &
- & tms(ji+1,jj) * wght(ji+1,jj+1,2,1) + &
- & tms(ji,jj) * wght(ji+1,jj+1,1,1)
- zpreshc(ji,jj) = ( zpresh(ji+1,jj+1) * wght(ji+1,jj+1,2,2) + &
- & zpresh(ji,jj+1) * wght(ji+1,jj+1,1,2) + &
- & zpresh(ji+1,jj) * wght(ji+1,jj+1,2,1) + &
- & zpresh(ji,jj) * wght(ji+1,jj+1,1,1) &
- & ) / MAX( zstms, epsd )
+ zstms = tmask(ji+1,jj+1,1) * wght(ji+1,jj+1,2,2) + tmask(ji,jj+1,1) * wght(ji+1,jj+1,1,2) + &
+ & tmask(ji+1,jj,1) * wght(ji+1,jj+1,2,1) + tmask(ji,jj,1) * wght(ji+1,jj+1,1,1)
+ zpreshc(ji,jj) = ( zpresh(ji+1,jj+1) * wght(ji+1,jj+1,2,2) + zpresh(ji,jj+1) * wght(ji+1,jj+1,1,2) + &
+ & zpresh(ji+1,jj) * wght(ji+1,jj+1,2,1) + zpresh(ji,jj) * wght(ji+1,jj+1,1,1) &
+ & ) / MAX( zstms, zepsi )
END DO
END DO
-
CALL lbc_lnk( zpreshc(:,:), 'F', 1. )
!
@@ -236,21 +229,19 @@
! zcorl2: Coriolis parameter on V-points
! (ztagnx,ztagny): wind stress on U/V points
- ! u_oce1: ocean u component on u points
! v_oce1: ocean v component on u points
! u_oce2: ocean u component on v points
- ! v_oce2: ocean v component on v points
IF( nn_ice_embd == 2 ) THEN !== embedded sea ice: compute representative ice top surface ==!
- !
- ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1}
- ! = (1/nn_fsbc)^2 * {SUM[n], n=0,nn_fsbc-1}
+ !
+ ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1}
+ ! = (1/nn_fsbc)^2 * {SUM[n], n=0,nn_fsbc-1}
zintn = REAL( nn_fsbc - 1 ) / REAL( nn_fsbc ) * 0.5_wp
- !
- ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1}
- ! = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1})
+ !
+ ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1}
+ ! = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1})
zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp
- !
+ !
zpice(:,:) = ssh_m(:,:) + ( zintn * snwice_mass(:,:) + zintb * snwice_mass_b(:,:) ) * r1_rau0
- !
+ !
ELSE !== non-embedded sea ice: use ocean surface for slope calculation ==!
zpice(:,:) = ssh_m(:,:)
@@ -260,36 +251,33 @@
DO ji = fs_2, fs_jpim1
- zc1 = tms(ji ,jj ) * ( rhosn * vt_s(ji ,jj ) + rhoic * vt_i(ji ,jj ) )
- zc2 = tms(ji+1,jj ) * ( rhosn * vt_s(ji+1,jj ) + rhoic * vt_i(ji+1,jj ) )
- zc3 = tms(ji ,jj+1) * ( rhosn * vt_s(ji ,jj+1) + rhoic * vt_i(ji ,jj+1) )
-
- zt11 = tms(ji ,jj) * e1t(ji ,jj)
- zt12 = tms(ji+1,jj) * e1t(ji+1,jj)
- zt21 = tms(ji,jj ) * e2t(ji,jj )
- zt22 = tms(ji,jj+1) * e2t(ji,jj+1)
+ zc1 = tmask(ji ,jj ,1) * ( rhosn * vt_s(ji ,jj ) + rhoic * vt_i(ji ,jj ) )
+ zc2 = tmask(ji+1,jj ,1) * ( rhosn * vt_s(ji+1,jj ) + rhoic * vt_i(ji+1,jj ) )
+ zc3 = tmask(ji ,jj+1,1) * ( rhosn * vt_s(ji ,jj+1) + rhoic * vt_i(ji ,jj+1) )
+
+ zt11 = tmask(ji ,jj,1) * e1t(ji ,jj)
+ zt12 = tmask(ji+1,jj,1) * e1t(ji+1,jj)
+ zt21 = tmask(ji,jj ,1) * e2t(ji,jj )
+ zt22 = tmask(ji,jj+1,1) * e2t(ji,jj+1)
! Leads area.
- zfrld1(ji,jj) = ( zt12 * ( 1.0 - at_i(ji,jj) ) + zt11 * ( 1.0 - at_i(ji+1,jj) ) ) / ( zt11 + zt12 + epsd )
- zfrld2(ji,jj) = ( zt22 * ( 1.0 - at_i(ji,jj) ) + zt21 * ( 1.0 - at_i(ji,jj+1) ) ) / ( zt21 + zt22 + epsd )
+ zfrld1(ji,jj) = ( zt12 * ( 1.0 - at_i(ji,jj) ) + zt11 * ( 1.0 - at_i(ji+1,jj) ) ) / ( zt11 + zt12 + zepsi )
+ zfrld2(ji,jj) = ( zt22 * ( 1.0 - at_i(ji,jj) ) + zt21 * ( 1.0 - at_i(ji,jj+1) ) ) / ( zt21 + zt22 + zepsi )
! Mass, coriolis coeff. and currents
- zmass1(ji,jj) = ( zt12*zc1 + zt11*zc2 ) / (zt11+zt12+epsd)
- zmass2(ji,jj) = ( zt22*zc1 + zt21*zc3 ) / (zt21+zt22+epsd)
- zcorl1(ji,jj) = zmass1(ji,jj) * ( e1t(ji+1,jj)*fcor(ji,jj) + e1t(ji,jj)*fcor(ji+1,jj) ) &
- & / ( e1t(ji,jj) + e1t(ji+1,jj) + epsd )
- zcorl2(ji,jj) = zmass2(ji,jj) * ( e2t(ji,jj+1)*fcor(ji,jj) + e2t(ji,jj)*fcor(ji,jj+1) ) &
- & / ( e2t(ji,jj+1) + e2t(ji,jj) + epsd )
+ zmass1(ji,jj) = ( zt12 * zc1 + zt11 * zc2 ) / ( zt11 + zt12 + zepsi )
+ zmass2(ji,jj) = ( zt22 * zc1 + zt21 * zc3 ) / ( zt21 + zt22 + zepsi )
+ zcorl1(ji,jj) = zmass1(ji,jj) * ( e1t(ji+1,jj) * fcor(ji,jj) + e1t(ji,jj) * fcor(ji+1,jj) ) &
+ & / ( e1t(ji,jj) + e1t(ji+1,jj) + zepsi )
+ zcorl2(ji,jj) = zmass2(ji,jj) * ( e2t(ji,jj+1) * fcor(ji,jj) + e2t(ji,jj) * fcor(ji,jj+1) ) &
+ & / ( e2t(ji,jj+1) + e2t(ji,jj) + zepsi )
!
- u_oce1(ji,jj) = u_oce(ji,jj)
- v_oce2(ji,jj) = v_oce(ji,jj)
-
! Ocean has no slip boundary condition
- v_oce1(ji,jj) = 0.5*( (v_oce(ji,jj)+v_oce(ji,jj-1))*e1t(ji,jj) &
- & +(v_oce(ji+1,jj)+v_oce(ji+1,jj-1))*e1t(ji+1,jj)) &
- & /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj)
-
- u_oce2(ji,jj) = 0.5*((u_oce(ji,jj)+u_oce(ji-1,jj))*e2t(ji,jj) &
- & +(u_oce(ji,jj+1)+u_oce(ji-1,jj+1))*e2t(ji,jj+1)) &
- & / (e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj)
+ v_oce1(ji,jj) = 0.5 * ( ( v_oce(ji ,jj) + v_oce(ji ,jj-1) ) * e1t(ji,jj) &
+ & + ( v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * e1t(ji+1,jj) ) &
+ & / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1)
+
+ u_oce2(ji,jj) = 0.5 * ( ( u_oce(ji,jj ) + u_oce(ji-1,jj ) ) * e2t(ji,jj) &
+ & + ( u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * e2t(ji,jj+1) ) &
+ & / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1)
! Wind stress at U,V-point
@@ -303,6 +291,6 @@
! include it later
- zdsshx = ( zpice(ji+1,jj) - zpice(ji,jj) ) / e1u(ji,jj)
- zdsshy = ( zpice(ji,jj+1) - zpice(ji,jj) ) / e2v(ji,jj)
+ zdsshx = ( zpice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj)
+ zdsshy = ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj)
za1ct(ji,jj) = ztagnx - zmass1(ji,jj) * grav * zdsshx
@@ -318,9 +306,14 @@
!
! Time step for subcycling
- dtevp = rdt_ice / nevp
+ dtevp = rdt_ice / nn_nevp
+#if defined key_lim3
+ dtotel = dtevp / ( 2._wp * rn_relast * rdt_ice )
+#else
dtotel = dtevp / ( 2._wp * telast )
-
+#endif
+ z1_dtotel = 1._wp / ( 1._wp + dtotel )
+ z1_dtevp = 1._wp / dtevp
!-ecc2: square of yield ellipse eccenticrity (reminder: must become a namelist parameter)
- ecc2 = ecc * ecc
+ ecc2 = rn_ecc * rn_ecc
ecci = 1. / ecc2
@@ -331,5 +324,5 @@
! !----------------------!
- DO jter = 1 , nevp ! loop over jter !
+ DO jter = 1 , nn_nevp ! loop over jter !
! !----------------------!
DO jj = k_j1, k_jpj-1
@@ -339,5 +332,5 @@
DO jj = k_j1+1, k_jpj-1
- DO ji = fs_2, jpim1 !RB bug no vect opt due to tmi
+ DO ji = fs_2, fs_jpim1 !RB bug no vect opt due to zmask
!
@@ -360,122 +353,80 @@
!
!
- divu_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) &
- & ) &
- & / area(ji,jj)
-
- zdt(ji,jj) = ( ( u_ice(ji,jj)/e2u(ji,jj) &
- & -u_ice(ji-1,jj)/e2u(ji-1,jj) &
- & )*e2t(ji,jj)*e2t(ji,jj) &
- & -( v_ice(ji,jj)/e1v(ji,jj) &
- & -v_ice(ji,jj-1)/e1v(ji,jj-1) &
- & )*e1t(ji,jj)*e1t(ji,jj) &
- & ) &
- & / area(ji,jj)
+ divu_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_e12t(ji,jj)
+
+ zdt(ji,jj) = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj) &
+ & - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj) &
+ & ) * r1_e12t(ji,jj)
!
- zds(ji,jj) = ( ( u_ice(ji,jj+1)/e1u(ji,jj+1) &
- & -u_ice(ji,jj)/e1u(ji,jj) &
- & )*e1f(ji,jj)*e1f(ji,jj) &
- & +( v_ice(ji+1,jj)/e2v(ji+1,jj) &
- & -v_ice(ji,jj)/e2v(ji,jj) &
- & )*e2f(ji,jj)*e2f(ji,jj) &
- & ) &
- & / ( e1f(ji,jj) * e2f(ji,jj) ) * ( 2.0 - tmf(ji,jj) ) &
- & * tmi(ji,jj) * tmi(ji,jj+1) &
- & * tmi(ji+1,jj) * tmi(ji+1,jj+1)
-
-
- v_ice1(ji,jj) = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji+1,jj) &
- & +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji,jj)) &
- & /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj)
-
- u_ice2(ji,jj) = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj+1) &
- & +(u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj)) &
- & /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj)
-
- END DO
- END DO
- CALL lbc_lnk( v_ice1, 'U', -1. ) ; CALL lbc_lnk( u_ice2, 'V', -1. ) ! lateral boundary cond.
-
-!CDIR NOVERRCHK
+ 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) &
+ & + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) &
+ & ) * r1_e12f(ji,jj) * ( 2._wp - fmask(ji,jj,1) ) &
+ & * zmask(ji,jj) * zmask(ji,jj+1) * zmask(ji+1,jj) * zmask(ji+1,jj+1)
+
+
+ v_ice1(ji,jj) = 0.5_wp * ( ( v_ice(ji ,jj) + v_ice(ji ,jj-1) ) * e1t(ji+1,jj) &
+ & + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji ,jj) ) &
+ & / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1)
+
+ u_ice2(ji,jj) = 0.5_wp * ( ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * e2t(ji,jj+1) &
+ & + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj ) ) &
+ & / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1)
+ END DO
+ END DO
+
+ CALL lbc_lnk_multi( v_ice1, 'U', -1., u_ice2, 'V', -1. ) ! lateral boundary cond.
+
DO jj = k_j1+1, k_jpj-1
-!CDIR NOVERRCHK
DO ji = fs_2, fs_jpim1
!- Calculate Delta at centre of grid cells
- zdst = ( e2u(ji , jj) * v_ice1(ji ,jj) &
- & - e2u(ji-1, jj) * v_ice1(ji-1,jj) &
- & + e1v(ji, jj ) * u_ice2(ji,jj ) &
- & - e1v(ji, jj-1) * u_ice2(ji,jj-1) &
- & ) &
- & / area(ji,jj)
-
- delta = SQRT( divu_i(ji,jj)*divu_i(ji,jj) + ( zdt(ji,jj)*zdt(ji,jj) + zdst*zdst ) * usecc2 )
- delta_i(ji,jj) = delta + creepl
- !-Calculate stress tensor components zs1 and zs2
- !-at centre of grid cells (see section 3.5 of CICE user's guide).
- zs1(ji,jj) = ( zs1(ji,jj) + dtotel * ( ( divu_i(ji,jj) / delta_i(ji,jj) - delta / delta_i(ji,jj) ) &
- & * zpresh(ji,jj) ) ) / ( 1._wp + dtotel )
- zs2(ji,jj) = ( zs2(ji,jj) + dtotel * ( ecci * zdt(ji,jj) / delta_i(ji,jj) * zpresh(ji,jj) ) ) &
- & / ( 1._wp + dtotel )
-
- END DO
- END DO
-
- CALL lbc_lnk( zs1(:,:), 'T', 1. )
- CALL lbc_lnk( zs2(:,:), 'T', 1. )
-
-!CDIR NOVERRCHK
- DO jj = k_j1+1, k_jpj-1
-!CDIR NOVERRCHK
- DO ji = fs_2, fs_jpim1
+ zdst = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u(ji-1,jj ) * v_ice1(ji-1,jj ) &
+ & + e1v(ji,jj) * u_ice2(ji,jj) - e1v(ji ,jj-1) * u_ice2(ji ,jj-1) &
+ & ) * r1_e12t(ji,jj)
+
+ delta = SQRT( divu_i(ji,jj)**2 + ( zdt(ji,jj)**2 + zdst**2 ) * usecc2 )
+ delta_i(ji,jj) = delta + rn_creepl
+
!- Calculate Delta on corners
- zddc = ( ( v_ice1(ji,jj+1)/e1u(ji,jj+1) &
- & -v_ice1(ji,jj)/e1u(ji,jj) &
- & )*e1f(ji,jj)*e1f(ji,jj) &
- & +( u_ice2(ji+1,jj)/e2v(ji+1,jj) &
- & -u_ice2(ji,jj)/e2v(ji,jj) &
- & )*e2f(ji,jj)*e2f(ji,jj) &
- & ) &
- & / ( e1f(ji,jj) * e2f(ji,jj) )
-
- zdtc = (-( v_ice1(ji,jj+1)/e1u(ji,jj+1) &
- & -v_ice1(ji,jj)/e1u(ji,jj) &
- & )*e1f(ji,jj)*e1f(ji,jj) &
- & +( u_ice2(ji+1,jj)/e2v(ji+1,jj) &
- & -u_ice2(ji,jj)/e2v(ji,jj) &
- & )*e2f(ji,jj)*e2f(ji,jj) &
- & ) &
- & / ( e1f(ji,jj) * e2f(ji,jj) )
-
- zddc = SQRT(zddc**2+(zdtc**2+zds(ji,jj)**2)*usecc2) + creepl
-
- !-Calculate stress tensor component zs12 at corners (see section 3.5 of CICE user's guide).
- zs12(ji,jj) = ( zs12(ji,jj) + dtotel * &
- & ( ecci * zds(ji,jj) / ( 2._wp * zddc ) * zpreshc(ji,jj) ) ) &
- & / ( 1.0 + dtotel )
-
- END DO ! ji
- END DO ! jj
-
- CALL lbc_lnk( zs12(:,:), 'F', 1. )
-
+ zddc = ( ( v_ice1(ji,jj+1) * r1_e1u(ji,jj+1) - v_ice1(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) &
+ & + ( u_ice2(ji+1,jj) * r1_e2v(ji+1,jj) - u_ice2(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) &
+ & ) * r1_e12f(ji,jj)
+
+ zdtc = (- ( v_ice1(ji,jj+1) * r1_e1u(ji,jj+1) - v_ice1(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) &
+ & + ( u_ice2(ji+1,jj) * r1_e2v(ji+1,jj) - u_ice2(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) &
+ & ) * r1_e12f(ji,jj)
+
+ zddc = SQRT( zddc**2 + ( zdtc**2 + zds(ji,jj)**2 ) * usecc2 ) + rn_creepl
+
+ !-Calculate stress tensor components zs1 and zs2 at centre of grid cells (see section 3.5 of CICE user's guide).
+ zs1(ji,jj) = ( zs1 (ji,jj) + dtotel * ( divu_i(ji,jj) - delta ) / delta_i(ji,jj) * zpresh(ji,jj) &
+ & ) * z1_dtotel
+ zs2(ji,jj) = ( zs2 (ji,jj) + dtotel * ecci * zdt(ji,jj) / delta_i(ji,jj) * zpresh(ji,jj) &
+ & ) * z1_dtotel
+ !-Calculate stress tensor component zs12 at corners
+ zs12(ji,jj) = ( zs12(ji,jj) + dtotel * ecci * zds(ji,jj) / ( 2._wp * zddc ) * zpreshc(ji,jj) &
+ & ) * z1_dtotel
+
+ END DO
+ END DO
+
+ CALL lbc_lnk_multi( zs1 , 'T', 1., zs2, 'T', 1., zs12, 'F', 1. )
+
! Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002)
DO jj = k_j1+1, k_jpj-1
DO ji = fs_2, fs_jpim1
!- contribution of zs1, zs2 and zs12 to zf1
- zf1(ji,jj) = 0.5*( (zs1(ji+1,jj)-zs1(ji,jj))*e2u(ji,jj) &
- & +(zs2(ji+1,jj)*e2t(ji+1,jj)**2-zs2(ji,jj)*e2t(ji,jj)**2)/e2u(ji,jj) &
- & +2.0*(zs12(ji,jj)*e1f(ji,jj)**2-zs12(ji,jj-1)*e1f(ji,jj-1)**2)/e1u(ji,jj) &
- & ) / ( e1u(ji,jj)*e2u(ji,jj) )
+ zf1(ji,jj) = 0.5 * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj) &
+ & + ( zs2(ji+1,jj) * e2t(ji+1,jj)**2 - zs2(ji,jj) * e2t(ji,jj)**2 ) * r1_e2u(ji,jj) &
+ & + 2.0 * ( zs12(ji,jj) * e1f(ji,jj)**2 - zs12(ji,jj-1) * e1f(ji,jj-1)**2 ) * r1_e1u(ji,jj) &
+ & ) * r1_e12u(ji,jj)
! contribution of zs1, zs2 and zs12 to zf2
- zf2(ji,jj) = 0.5*( (zs1(ji,jj+1)-zs1(ji,jj))*e1v(ji,jj) &
- & -(zs2(ji,jj+1)*e1t(ji,jj+1)**2 - zs2(ji,jj)*e1t(ji,jj)**2)/e1v(ji,jj) &
- & + 2.0*(zs12(ji,jj)*e2f(ji,jj)**2 - &
- zs12(ji-1,jj)*e2f(ji-1,jj)**2)/e2v(ji,jj) &
- & ) / ( e1v(ji,jj)*e2v(ji,jj) )
+ zf2(ji,jj) = 0.5 * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj) &
+ & - ( zs2(ji,jj+1) * e1t(ji,jj+1)**2 - zs2(ji,jj) * e1t(ji,jj)**2 ) * r1_e1v(ji,jj) &
+ & + 2.0 * ( zs12(ji,jj) * e2f(ji,jj)**2 - zs12(ji-1,jj) * e2f(ji-1,jj)**2 ) * r1_e2v(ji,jj) &
+ & ) * r1_e12v(ji,jj)
END DO
END DO
@@ -487,23 +438,19 @@
IF (MOD(jter,2).eq.0) THEN
-!CDIR NOVERRCHK
DO jj = k_j1+1, k_jpj-1
-!CDIR NOVERRCHK
DO ji = fs_2, fs_jpim1
- zmask = (1.0-MAX(0._wp,SIGN(1._wp,-zmass1(ji,jj))))*tmu(ji,jj)
- z0 = zmass1(ji,jj)/dtevp
+ rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass1(ji,jj) ) ) ) * umask(ji,jj,1)
+ z0 = zmass1(ji,jj) * z1_dtevp
! SB modif because ocean has no slip boundary condition
- zv_ice1 = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji,jj) &
- & +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji+1,jj)) &
- & /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj)
- za = rhoco*SQRT((u_ice(ji,jj)-u_oce1(ji,jj))**2 + &
- (zv_ice1-v_oce1(ji,jj))**2) * (1.0-zfrld1(ji,jj))
- zr = z0*u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + &
- za*(u_oce1(ji,jj))
- zcca = z0+za
+ zv_ice1 = 0.5 * ( ( v_ice(ji ,jj) + v_ice(ji ,jj-1) ) * e1t(ji ,jj) &
+ & + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji+1,jj) ) &
+ & / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1)
+ za = rhoco * SQRT( ( u_ice(ji,jj) - u_oce(ji,jj) )**2 + &
+ & ( zv_ice1 - v_oce1(ji,jj) )**2 ) * ( 1.0 - zfrld1(ji,jj) )
+ zr = z0 * u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + za * u_oce(ji,jj)
+ zcca = z0 + za
zccb = zcorl1(ji,jj)
- u_ice(ji,jj) = (zr+zccb*zv_ice1)/(zcca+epsd)*zmask
-
+ u_ice(ji,jj) = ( zr + zccb * zv_ice1 ) / ( zcca + zepsi ) * rswitch
END DO
END DO
@@ -511,5 +458,5 @@
CALL lbc_lnk( u_ice(:,:), 'U', -1. )
#if defined key_agrif && defined key_lim2
- CALL agrif_rhg_lim2( jter, nevp, 'U' )
+ CALL agrif_rhg_lim2( jter, nn_nevp, 'U' )
#endif
#if defined key_bdy
@@ -517,23 +464,19 @@
#endif
-!CDIR NOVERRCHK
DO jj = k_j1+1, k_jpj-1
-!CDIR NOVERRCHK
DO ji = fs_2, fs_jpim1
- zmask = (1.0-MAX(0._wp,SIGN(1._wp,-zmass2(ji,jj))))*tmv(ji,jj)
- z0 = zmass2(ji,jj)/dtevp
+ rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass2(ji,jj) ) ) ) * vmask(ji,jj,1)
+ z0 = zmass2(ji,jj) * z1_dtevp
! SB modif because ocean has no slip boundary condition
- zu_ice2 = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj) &
- & + (u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj+1)) &
- & /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj)
- za = rhoco*SQRT((zu_ice2-u_oce2(ji,jj))**2 + &
- (v_ice(ji,jj)-v_oce2(ji,jj))**2)*(1.0-zfrld2(ji,jj))
- zr = z0*v_ice(ji,jj) + zf2(ji,jj) + &
- za2ct(ji,jj) + za*(v_oce2(ji,jj))
- zcca = z0+za
+ zu_ice2 = 0.5 * ( ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * e2t(ji,jj) &
+ & + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj+1) ) &
+ & / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1)
+ za = rhoco * SQRT( ( zu_ice2 - u_oce2(ji,jj) )**2 + &
+ & ( v_ice(ji,jj) - v_oce(ji,jj))**2 ) * ( 1.0 - zfrld2(ji,jj) )
+ zr = z0 * v_ice(ji,jj) + zf2(ji,jj) + za2ct(ji,jj) + za * v_oce(ji,jj)
+ zcca = z0 + za
zccb = zcorl2(ji,jj)
- v_ice(ji,jj) = (zr-zccb*zu_ice2)/(zcca+epsd)*zmask
-
+ v_ice(ji,jj) = ( zr - zccb * zu_ice2 ) / ( zcca + zepsi ) * rswitch
END DO
END DO
@@ -541,5 +484,5 @@
CALL lbc_lnk( v_ice(:,:), 'V', -1. )
#if defined key_agrif && defined key_lim2
- CALL agrif_rhg_lim2( jter, nevp, 'V' )
+ CALL agrif_rhg_lim2( jter, nn_nevp, 'V' )
#endif
#if defined key_bdy
@@ -548,23 +491,19 @@
ELSE
-!CDIR NOVERRCHK
DO jj = k_j1+1, k_jpj-1
-!CDIR NOVERRCHK
DO ji = fs_2, fs_jpim1
- zmask = (1.0-MAX(0._wp,SIGN(1._wp,-zmass2(ji,jj))))*tmv(ji,jj)
- z0 = zmass2(ji,jj)/dtevp
+ rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass2(ji,jj) ) ) ) * vmask(ji,jj,1)
+ z0 = zmass2(ji,jj) * z1_dtevp
! SB modif because ocean has no slip boundary condition
- zu_ice2 = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj) &
- & +(u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj+1)) &
- & /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj)
-
- za = rhoco*SQRT((zu_ice2-u_oce2(ji,jj))**2 + &
- (v_ice(ji,jj)-v_oce2(ji,jj))**2)*(1.0-zfrld2(ji,jj))
- zr = z0*v_ice(ji,jj) + zf2(ji,jj) + &
- za2ct(ji,jj) + za*(v_oce2(ji,jj))
- zcca = z0+za
+ zu_ice2 = 0.5 * ( ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * e2t(ji,jj) &
+ & +( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj+1) ) &
+ & / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1)
+
+ za = rhoco * SQRT( ( zu_ice2 - u_oce2(ji,jj) )**2 + &
+ & ( v_ice(ji,jj) - v_oce(ji,jj) )**2 ) * ( 1.0 - zfrld2(ji,jj) )
+ zr = z0 * v_ice(ji,jj) + zf2(ji,jj) + za2ct(ji,jj) + za * v_oce(ji,jj)
+ zcca = z0 + za
zccb = zcorl2(ji,jj)
- v_ice(ji,jj) = (zr-zccb*zu_ice2)/(zcca+epsd)*zmask
-
+ v_ice(ji,jj) = ( zr - zccb * zu_ice2 ) / ( zcca + zepsi ) * rswitch
END DO
END DO
@@ -572,5 +511,5 @@
CALL lbc_lnk( v_ice(:,:), 'V', -1. )
#if defined key_agrif && defined key_lim2
- CALL agrif_rhg_lim2( jter, nevp, 'V' )
+ CALL agrif_rhg_lim2( jter, nn_nevp, 'V' )
#endif
#if defined key_bdy
@@ -578,27 +517,24 @@
#endif
-!CDIR NOVERRCHK
DO jj = k_j1+1, k_jpj-1
-!CDIR NOVERRCHK
DO ji = fs_2, fs_jpim1
- zmask = (1.0-MAX(0._wp,SIGN(1._wp,-zmass1(ji,jj))))*tmu(ji,jj)
- z0 = zmass1(ji,jj)/dtevp
- zv_ice1 = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji,jj) &
- & +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji+1,jj)) &
- & /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj)
-
- za = rhoco*SQRT((u_ice(ji,jj)-u_oce1(ji,jj))**2 + &
- (zv_ice1-v_oce1(ji,jj))**2)*(1.0-zfrld1(ji,jj))
- zr = z0*u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + &
- za*(u_oce1(ji,jj))
- zcca = z0+za
+ rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass1(ji,jj) ) ) ) * umask(ji,jj,1)
+ z0 = zmass1(ji,jj) * z1_dtevp
+ zv_ice1 = 0.5 * ( ( v_ice(ji ,jj) + v_ice(ji ,jj-1) ) * e1t(ji,jj) &
+ & + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji+1,jj) ) &
+ & / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1)
+
+ za = rhoco * SQRT( ( u_ice(ji,jj) - u_oce(ji,jj) )**2 + &
+ & ( zv_ice1 - v_oce1(ji,jj) )**2 ) * ( 1.0 - zfrld1(ji,jj) )
+ zr = z0 * u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + za * u_oce(ji,jj)
+ zcca = z0 + za
zccb = zcorl1(ji,jj)
- u_ice(ji,jj) = (zr+zccb*zv_ice1)/(zcca+epsd)*zmask
- END DO ! ji
- END DO ! jj
+ u_ice(ji,jj) = ( zr + zccb * zv_ice1 ) / ( zcca + zepsi ) * rswitch
+ END DO
+ END DO
CALL lbc_lnk( u_ice(:,:), 'U', -1. )
#if defined key_agrif && defined key_lim2
- CALL agrif_rhg_lim2( jter, nevp, 'U' )
+ CALL agrif_rhg_lim2( jter, nn_nevp, 'U' )
#endif
#if defined key_bdy
@@ -611,8 +547,7 @@
!--- Convergence test.
DO jj = k_j1+1 , k_jpj-1
- zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ) , &
- ABS( v_ice(:,jj) - zv_ice(:,jj) ) )
- END DO
- zresm = MAXVAL( zresr( 1:jpi , k_j1+1:k_jpj-1 ) )
+ zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ), ABS( v_ice(:,jj) - zv_ice(:,jj) ) )
+ END DO
+ zresm = MAXVAL( zresr( 1:jpi, k_j1+1:k_jpj-1 ) )
IF( lk_mpp ) CALL mpp_max( zresm ) ! max over the global domain
ENDIF
@@ -625,24 +560,20 @@
! 4) Prevent ice velocities when the ice is thin
!------------------------------------------------------------------------------!
- ! If the ice thickness is below hminrhg (5cm) then ice velocity should equal the
- ! ocean velocity,
- ! This prevents high velocity when ice is thin
-!CDIR NOVERRCHK
+ ! If the ice volume is below zvmin then ice velocity should equal the
+ ! ocean velocity. This prevents high velocity when ice is thin
DO jj = k_j1+1, k_jpj-1
-!CDIR NOVERRCHK
DO ji = fs_2, fs_jpim1
- zdummy = vt_i(ji,jj)
- IF ( zdummy .LE. hminrhg ) THEN
+ IF ( vt_i(ji,jj) <= zvmin ) THEN
u_ice(ji,jj) = u_oce(ji,jj)
v_ice(ji,jj) = v_oce(ji,jj)
- ENDIF ! zdummy
+ ENDIF
END DO
END DO
- CALL lbc_lnk( u_ice(:,:), 'U', -1. )
- CALL lbc_lnk( v_ice(:,:), 'V', -1. )
+ CALL lbc_lnk_multi( u_ice(:,:), 'U', -1., v_ice(:,:), 'V', -1. )
+
#if defined key_agrif && defined key_lim2
- CALL agrif_rhg_lim2( nevp , nevp, 'U' )
- CALL agrif_rhg_lim2( nevp , nevp, 'V' )
+ CALL agrif_rhg_lim2( nn_nevp , nn_nevp, 'U' )
+ CALL agrif_rhg_lim2( nn_nevp , nn_nevp, 'V' )
#endif
#if defined key_bdy
@@ -653,93 +584,64 @@
DO jj = k_j1+1, k_jpj-1
DO ji = fs_2, fs_jpim1
- zdummy = vt_i(ji,jj)
- IF ( zdummy .LE. hminrhg ) THEN
- v_ice1(ji,jj) = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji+1,jj) &
- & +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji,jj)) &
- & /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj)
-
- u_ice2(ji,jj) = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj+1) &
- & +(u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj)) &
- & /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj)
- ENDIF ! zdummy
+ IF ( vt_i(ji,jj) <= zvmin ) THEN
+ v_ice1(ji,jj) = 0.5_wp * ( ( v_ice(ji ,jj) + v_ice(ji, jj-1) ) * e1t(ji+1,jj) &
+ & + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji ,jj) ) &
+ & / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1)
+
+ u_ice2(ji,jj) = 0.5_wp * ( ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * e2t(ji,jj+1) &
+ & + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj ) ) &
+ & / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1)
+ ENDIF
END DO
END DO
- CALL lbc_lnk( u_ice2(:,:), 'V', -1. )
- CALL lbc_lnk( v_ice1(:,:), 'U', -1. )
+ CALL lbc_lnk_multi( u_ice2(:,:), 'V', -1., v_ice1(:,:), 'U', -1. )
! Recompute delta, shear and div, inputs for mechanical redistribution
-!CDIR NOVERRCHK
DO jj = k_j1+1, k_jpj-1
-!CDIR NOVERRCHK
- DO ji = fs_2, jpim1 !RB bug no vect opt due to tmi
+ DO ji = fs_2, jpim1 !RB bug no vect opt due to zmask
!- divu_i(:,:), zdt(:,:): divergence and tension at centre
!- zds(:,:): shear on northeast corner of grid cells
- zdummy = vt_i(ji,jj)
- IF ( zdummy .LE. hminrhg ) THEN
-
- divu_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) &
- & ) &
- & / area(ji,jj)
-
- zdt(ji,jj) = ( ( u_ice(ji,jj)/e2u(ji,jj) &
- & -u_ice(ji-1,jj)/e2u(ji-1,jj) &
- & )*e2t(ji,jj)*e2t(ji,jj) &
- & -( v_ice(ji,jj)/e1v(ji,jj) &
- & -v_ice(ji,jj-1)/e1v(ji,jj-1) &
- & )*e1t(ji,jj)*e1t(ji,jj) &
- & ) &
- & / area(ji,jj)
+ IF ( vt_i(ji,jj) <= zvmin ) THEN
+
+ divu_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_e12t(ji,jj)
+
+ zdt(ji,jj) = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj) &
+ & -( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj) &
+ & ) * r1_e12t(ji,jj)
!
! SB modif because ocean has no slip boundary condition
- zds(ji,jj) = ( ( u_ice(ji,jj+1) / e1u(ji,jj+1) &
- & - u_ice(ji,jj) / e1u(ji,jj) ) &
- & * e1f(ji,jj) * e1f(ji,jj) &
- & + ( v_ice(ji+1,jj) / e2v(ji+1,jj) &
- & - v_ice(ji,jj) / e2v(ji,jj) ) &
- & * e2f(ji,jj) * e2f(ji,jj) ) &
- & / ( e1f(ji,jj) * e2f(ji,jj) ) * ( 2.0 - tmf(ji,jj) ) &
- & * tmi(ji,jj) * tmi(ji,jj+1) &
- & * tmi(ji+1,jj) * tmi(ji+1,jj+1)
-
- zdst = ( e2u( ji , jj ) * v_ice1(ji ,jj ) &
- & - e2u( ji-1, jj ) * v_ice1(ji-1,jj ) &
- & + e1v( ji , jj ) * u_ice2(ji ,jj ) &
- & - e1v( ji , jj-1 ) * u_ice2(ji ,jj-1) ) / area(ji,jj)
-
- delta = SQRT( divu_i(ji,jj)*divu_i(ji,jj) + ( zdt(ji,jj)*zdt(ji,jj) + zdst*zdst ) * usecc2 )
- delta_i(ji,jj) = delta + creepl
+ 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) &
+ & +( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) &
+ & ) * r1_e12f(ji,jj) * ( 2.0 - fmask(ji,jj,1) ) &
+ & * zmask(ji,jj) * zmask(ji,jj+1) * zmask(ji+1,jj) * zmask(ji+1,jj+1)
+
+ zdst = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u(ji-1,jj ) * v_ice1(ji-1,jj ) &
+ & + e1v(ji,jj) * u_ice2(ji,jj) - e1v(ji ,jj-1) * u_ice2(ji ,jj-1) ) * r1_e12t(ji,jj)
+
+ delta = SQRT( divu_i(ji,jj)**2 + ( zdt(ji,jj)**2 + zdst**2 ) * usecc2 )
+ delta_i(ji,jj) = delta + rn_creepl
- ENDIF ! zdummy
-
- END DO !jj
- END DO !ji
+ ENDIF
+ END DO
+ END DO
!
!------------------------------------------------------------------------------!
! 5) Store stress tensor and its invariants
!------------------------------------------------------------------------------!
- !
! * Invariants of the stress tensor are required for limitd_me
! (accelerates convergence and improves stability)
DO jj = k_j1+1, k_jpj-1
DO ji = fs_2, fs_jpim1
- ! begin TECLIM change
- zdst= ( e2u( ji , jj ) * v_ice1(ji,jj) &
- & - e2u( ji-1, jj ) * v_ice1(ji-1,jj) &
- & + e1v( ji , jj ) * u_ice2(ji,jj) &
- & - e1v( ji , jj-1 ) * u_ice2(ji,jj-1) ) / area(ji,jj)
+ zdst = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u( ji-1, jj ) * v_ice1(ji-1,jj) &
+ & + e1v(ji,jj) * u_ice2(ji,jj) - e1v( ji , jj-1 ) * u_ice2(ji,jj-1) ) * r1_e12t(ji,jj)
shear_i(ji,jj) = SQRT( zdt(ji,jj) * zdt(ji,jj) + zdst * zdst )
- ! end TECLIM change
END DO
END DO
! Lateral boundary condition
- CALL lbc_lnk( divu_i (:,:), 'T', 1. )
- CALL lbc_lnk( delta_i(:,:), 'T', 1. )
- ! CALL lbc_lnk( shear_i(:,:), 'F', 1. )
- CALL lbc_lnk( shear_i(:,:), 'T', 1. )
+ CALL lbc_lnk_multi( divu_i (:,:), 'T', 1., delta_i(:,:), 'T', 1., shear_i(:,:), 'T', 1. )
! * Store the stress tensor for the next time step
@@ -772,5 +674,5 @@
DO jj = k_j1+1, k_jpj-1
DO ji = 2, jpim1
- IF (zpresh(ji,jj) .GT. 1.0) THEN
+ IF (zpresh(ji,jj) > 1.0) THEN
sigma1 = ( zs1(ji,jj) + (zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 )**0.5 ) / ( 2*zpresh(ji,jj) )
sigma2 = ( zs1(ji,jj) - (zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 )**0.5 ) / ( 2*zpresh(ji,jj) )
@@ -786,5 +688,5 @@
!
CALL wrk_dealloc( jpi,jpj, zpresh, zfrld1, zmass1, zcorl1, za1ct , zpreshc, zfrld2, zmass2, zcorl2, za2ct )
- CALL wrk_dealloc( jpi,jpj, u_oce1, u_oce2, u_ice2, v_oce1 , v_oce2, v_ice1 )
+ CALL wrk_dealloc( jpi,jpj, u_oce2, u_ice2, v_oce1 , v_ice1 , zmask )
CALL wrk_dealloc( jpi,jpj, zf1 , zu_ice, zf2 , zv_ice , zdt , zds )
CALL wrk_dealloc( jpi,jpj, zdt , zds , zs1 , zs2 , zs12 , zresr , zpice )
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90 (revision 5602)
@@ -18,5 +18,4 @@
USE ice ! sea-ice variables
USE oce , ONLY : snwice_mass, snwice_mass_b
- USE par_ice ! sea-ice parameters
USE dom_oce ! ocean domain
USE sbc_oce ! Surface boundary condition: ocean fields
@@ -27,4 +26,5 @@
USE wrk_nemo ! work arrays
USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+ USE limctl
IMPLICIT NONE
@@ -33,5 +33,5 @@
PUBLIC lim_rst_opn ! routine called by icestep.F90
PUBLIC lim_rst_write ! routine called by icestep.F90
- PUBLIC lim_rst_read ! routine called by iceini.F90
+ PUBLIC lim_rst_read ! routine called by sbc_lim_init
LOGICAL, PUBLIC :: lrst_ice !: logical to control the ice restart write
@@ -55,4 +55,5 @@
CHARACTER(LEN=20) :: clkt ! ocean time-step define as a character
CHARACTER(LEN=50) :: clname ! ice output restart file name
+ CHARACTER(len=256) :: clpath ! full path to ice output restart file
!!----------------------------------------------------------------------
!
@@ -64,26 +65,33 @@
IF( kt == nitrst - 2*nn_fsbc + 1 .OR. nstock == nn_fsbc &
& .OR. ( kt == nitend - nn_fsbc + 1 .AND. .NOT. lrst_ice ) ) THEN
- ! beware of the format used to write kt (default is i8.8, that should be large enough...)
- IF( nitrst > 99999999 ) THEN ; WRITE(clkt, * ) nitrst
- ELSE ; WRITE(clkt, '(i8.8)') nitrst
+ IF( nitrst <= nitend .AND. nitrst > 0 ) THEN
+ ! beware of the format used to write kt (default is i8.8, that should be large enough...)
+ IF( nitrst > 99999999 ) THEN ; WRITE(clkt, * ) nitrst
+ ELSE ; WRITE(clkt, '(i8.8)') nitrst
+ ENDIF
+ ! create the file
+ clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out)
+ clpath = TRIM(cn_icerst_outdir)
+ IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath)//'/'
+ IF(lwp) THEN
+ WRITE(numout,*)
+ SELECT CASE ( jprstlib )
+ CASE ( jprstdimg )
+ WRITE(numout,*) ' open ice restart binary file: ',TRIM(clpath)//clname
+ CASE DEFAULT
+ WRITE(numout,*) ' open ice restart NetCDF file: ',TRIM(clpath)//clname
+ END SELECT
+ IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN
+ WRITE(numout,*) ' kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp
+ ELSE ; WRITE(numout,*) ' kt = ' , kt,' date= ', ndastp
+ ENDIF
+ ENDIF
+ !
+ CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kiolib = jprstlib )
+ lrst_ice = .TRUE.
ENDIF
- ! create the file
- clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out)
- IF(lwp) THEN
- WRITE(numout,*)
- SELECT CASE ( jprstlib )
- CASE ( jprstdimg ) ; WRITE(numout,*) ' open ice restart binary file: '//clname
- CASE DEFAULT ; WRITE(numout,*) ' open ice restart NetCDF file: '//clname
- END SELECT
- IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN
- WRITE(numout,*) ' kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp
- ELSE ; WRITE(numout,*) ' kt = ' , kt,' date= ', ndastp
- ENDIF
- ENDIF
- !
- CALL iom_open( clname, numriw, ldwrt = .TRUE., kiolib = jprstlib )
- lrst_ice = .TRUE.
ENDIF
!
+ IF( ln_icectl ) CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - Beginning the time step - ' ) ! control print
END SUBROUTINE lim_rst_opn
@@ -142,5 +150,5 @@
CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
END DO
-
+
DO jl = 1, jpl
WRITE(zchar,'(I1)') jl
@@ -165,6 +173,6 @@
CALL iom_rstput( iter, nitrst, numriw, 'stress2_i' , stress2_i )
CALL iom_rstput( iter, nitrst, numriw, 'stress12_i' , stress12_i )
- CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass' , snwice_mass ) !clem modif
- CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass_b', snwice_mass_b ) !clem modif
+ CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass' , snwice_mass )
+ CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass_b', snwice_mass_b )
DO jl = 1, jpl
@@ -306,8 +314,6 @@
!! ** purpose : read of sea-ice variable restart in a netcdf file
!!----------------------------------------------------------------------
- INTEGER :: ji, jj, jk, jl, indx
+ INTEGER :: ji, jj, jk, jl
REAL(wp) :: zfice, ziter
- REAL(wp) :: zs_inf, z_slope_s, zsmax, zsmin, zalpha ! local scalars used for the salinity profile
- REAL(wp), POINTER, DIMENSION(:) :: zs_zero
REAL(wp), POINTER, DIMENSION(:,:) :: z2d
CHARACTER(len=15) :: znam
@@ -317,5 +323,4 @@
!!----------------------------------------------------------------------
- CALL wrk_alloc( nlay_i, zs_zero )
CALL wrk_alloc( jpi, jpj, z2d )
@@ -329,9 +334,9 @@
! eventually read netcdf file (monobloc) for restarting on different number of processors
! if {cn_icerst_in}.nc exists, then set jlibalt to jpnf90
- INQUIRE( FILE = TRIM(cn_icerst_in)//'.nc', EXIST = llok )
+ INQUIRE( FILE = TRIM(cn_icerst_indir)//'/'//TRIM(cn_icerst_in)//'.nc', EXIST = llok )
IF ( llok ) THEN ; jlibalt = jpnf90 ; ELSE ; jlibalt = jprstlib ; ENDIF
ENDIF
- CALL iom_open ( cn_icerst_in, numrir, kiolib = jprstlib )
+ CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir, kiolib = jprstlib )
CALL iom_get( numrir, 'nn_fsbc', zfice )
@@ -395,6 +400,6 @@
CALL iom_get( numrir, jpdom_autoglo, 'stress2_i' , stress2_i )
CALL iom_get( numrir, jpdom_autoglo, 'stress12_i', stress12_i )
- CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass' , snwice_mass ) !clem modif
- CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass_b', snwice_mass_b ) !clem modif
+ CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass' , snwice_mass )
+ CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass_b', snwice_mass_b )
DO jl = 1, jpl
@@ -521,10 +526,10 @@
!
! clem: I do not understand why the following IF is needed
- ! I suspect something inconsistent in the main code with option num_sal=1
- IF( num_sal == 1 ) THEN
+ ! I suspect something inconsistent in the main code with option nn_icesal=1
+ IF( nn_icesal == 1 ) THEN
DO jl = 1, jpl
- sm_i(:,:,jl) = bulk_sal
+ sm_i(:,:,jl) = rn_icesal
DO jk = 1, nlay_i
- s_i(:,:,jk,jl) = bulk_sal
+ s_i(:,:,jk,jl) = rn_icesal
END DO
END DO
@@ -533,5 +538,4 @@
!CALL iom_close( numrir ) !clem: closed in sbcice_lim.F90
!
- CALL wrk_dealloc( nlay_i, zs_zero )
CALL wrk_dealloc( jpi, jpj, z2d )
!
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90 (revision 5602)
@@ -25,12 +25,10 @@
USE par_oce ! ocean parameters
USE phycst ! physical constants
- USE par_ice ! ice parameters
USE dom_oce ! ocean domain
- USE dom_ice, ONLY : tms, area
USE ice ! LIM sea-ice variables
USE sbc_ice ! Surface boundary condition: sea-ice fields
USE sbc_oce ! Surface boundary condition: ocean fields
USE sbccpl
- USE oce , ONLY : fraqsr_1lev, sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass
+ USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass
USE albedo ! albedo parameters
USE lbclnk ! ocean lateral boundary condition - MPP exchanges
@@ -40,12 +38,14 @@
USE prtctl ! Print control
USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
- USE traqsr ! clem: add penetration of solar flux into the calculation of heat budget
+ USE traqsr ! add penetration of solar flux in the calculation of heat budget
USE iom
USE domvvl ! Variable volume
+ USE limctl
+ USE limcons
IMPLICIT NONE
PRIVATE
- PUBLIC lim_sbc_init ! called by ice_init
+ PUBLIC lim_sbc_init ! called by sbc_lim_init
PUBLIC lim_sbc_flx ! called by sbc_ice_lim
PUBLIC lim_sbc_tau ! called by sbc_ice_lim
@@ -94,18 +94,15 @@
!! - fr_i : ice fraction
!! - tn_ice : sea-ice surface temperature
- !! - alb_ice : sea-ice albedo (lk_cpl=T)
+ !! - alb_ice : sea-ice albedo (only useful in coupled mode)
!!
!! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90.
!! Tartinville et al. 2001 Ocean Modelling, 3, 95-108.
!! These refs are now obsolete since everything has been revised
- !! The ref should be Rousset et al., 2015?
+ !! The ref should be Rousset et al., 2015
!!---------------------------------------------------------------------
- INTEGER, INTENT(in) :: kt ! number of iteration
- !
- INTEGER :: ji, jj, jl, jk ! dummy loop indices
- !
- REAL(wp) :: zemp ! local scalars
- REAL(wp) :: zf_mass ! Heat flux associated with mass exchange ice->ocean (W.m-2)
- REAL(wp) :: zfcm1 ! New solar flux received by the ocean
+ INTEGER, INTENT(in) :: kt ! number of iteration
+ INTEGER :: ji, jj, jl, jk ! dummy loop indices
+ REAL(wp) :: zqmass ! Heat flux associated with mass exchange ice->ocean (W.m-2)
+ REAL(wp) :: zqsr ! New solar flux received by the ocean
!
REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_cs, zalb_os ! 2D/3D workspace
@@ -113,11 +110,14 @@
! make calls for heat fluxes before it is modified
- IF( iom_use('qsr_oce') ) CALL iom_put( "qsr_oce" , qsr(:,:) * pfrld(:,:) ) ! solar flux at ocean surface
- IF( iom_use('qns_oce') ) CALL iom_put( "qns_oce" , qns(:,:) * pfrld(:,:) ) ! non-solar flux at ocean surface
- IF( iom_use('qsr_ice') ) CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux at ice surface
- IF( iom_use('qns_ice') ) CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! non-solar flux at ice surface
- IF( iom_use('qtr_ice') ) CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux transmitted thru ice
- IF( iom_use('qt_oce' ) ) CALL iom_put( "qt_oce" , ( qsr(:,:) + qns(:,:) ) * pfrld(:,:) )
- IF( iom_use('qt_ice' ) ) CALL iom_put( "qt_ice" , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) ) * a_i_b(:,:,:), dim=3 ) )
+ IF( iom_use('qsr_oce') ) CALL iom_put( "qsr_oce" , qsr_oce(:,:) * pfrld(:,:) ) ! solar flux at ocean surface
+ IF( iom_use('qns_oce') ) CALL iom_put( "qns_oce" , qns_oce(:,:) * pfrld(:,:) + qemp_oce(:,:) ) ! non-solar flux at ocean surface
+ IF( iom_use('qsr_ice') ) CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux at ice surface
+ IF( iom_use('qns_ice') ) CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) ! non-solar flux at ice surface
+ IF( iom_use('qtr_ice') ) CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux transmitted thru ice
+ IF( iom_use('qt_oce' ) ) CALL iom_put( "qt_oce" , ( qsr_oce(:,:) + qns_oce(:,:) ) * pfrld(:,:) + 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('qemp_oce' ) ) CALL iom_put( "qemp_oce" , qemp_oce(:,:) )
+ IF( iom_use('qemp_ice' ) ) CALL iom_put( "qemp_ice" , qemp_ice(:,:) )
! pfrld is the lead fraction at the previous time step (actually between TRP and THD)
@@ -128,29 +128,24 @@
! heat flux at the ocean surface !
!------------------------------------------!
- ! Solar heat flux reaching the ocean = zfcm1 (W.m-2)
+ ! Solar heat flux reaching the ocean = zqsr (W.m-2)
!---------------------------------------------------
- IF( lk_cpl ) THEN
- !!! LIM2 version zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) )
- zfcm1 = qsr_tot(ji,jj)
- DO jl = 1, jpl
- zfcm1 = zfcm1 + ( ftr_ice(ji,jj,jl) - qsr_ice(ji,jj,jl) ) * a_i_b(ji,jj,jl)
- END DO
- ELSE
- !!! LIM2 version zqsr = pfrld(ji,jj) * qsr(ji,jj) + ( 1. - pfrld(ji,jj) ) * fstric(ji,jj)
- zfcm1 = pfrld(ji,jj) * qsr(ji,jj)
- DO jl = 1, jpl
- zfcm1 = zfcm1 + a_i_b(ji,jj,jl) * ftr_ice(ji,jj,jl)
- END DO
- ENDIF
+ zqsr = qsr_tot(ji,jj)
+ DO jl = 1, jpl
+ zqsr = zqsr - a_i_b(ji,jj,jl) * ( qsr_ice(ji,jj,jl) - ftr_ice(ji,jj,jl) )
+ END DO
! Total heat flux reaching the ocean = hfx_out (W.m-2)
!---------------------------------------------------
- zf_mass = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC)
- hfx_out(ji,jj) = hfx_out(ji,jj) + zf_mass + zfcm1
+ zqmass = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC)
+ hfx_out(ji,jj) = hfx_out(ji,jj) + zqmass + zqsr
+
+ ! Add the residual from heat diffusion equation (W.m-2)
+ !-------------------------------------------------------
+ hfx_out(ji,jj) = hfx_out(ji,jj) + hfx_err_dif(ji,jj)
! New qsr and qns used to compute the oceanic heat flux at the next time step
!---------------------------------------------------
- qsr(ji,jj) = zfcm1
- qns(ji,jj) = hfx_out(ji,jj) - zfcm1
+ qsr(ji,jj) = zqsr
+ qns(ji,jj) = hfx_out(ji,jj) - zqsr
!------------------------------------------!
@@ -165,14 +160,4 @@
! Even if i see Ice melting as a FW and SALT flux
!
- ! computing freshwater exchanges at the ice/ocean interface
- IF( lk_cpl ) THEN
- zemp = - emp_tot(ji,jj) + emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) ) & !
- & + wfx_snw(ji,jj)
- ELSE
- zemp = emp(ji,jj) * pfrld(ji,jj) & ! evaporation over oceanic fraction
- & - tprecip(ji,jj) * ( 1._wp - pfrld(ji,jj) ) & ! all precipitation reach the ocean
- & + sprecip(ji,jj) * ( 1._wp - pfrld(ji,jj)**betas ) ! except solid precip intercepted by sea-ice
- ENDIF
-
! mass flux from ice/ocean
wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj) &
@@ -180,6 +165,6 @@
! mass flux at the ocean/ice interface
- fmmflx(ji,jj) = - wfx_ice(ji,jj) * rdt_ice ! F/M mass flux save at least for biogeochemical model
- emp(ji,jj) = zemp - wfx_ice(ji,jj) - wfx_snw(ji,jj) ! mass flux + F/M mass flux (always ice/ocean mass exchange)
+ fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) ) * r1_rdtice ! F/M mass flux save at least for biogeochemical model
+ emp(ji,jj) = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) ! mass flux + F/M mass flux (always ice/ocean mass exchange)
END DO
@@ -199,5 +184,5 @@
snwice_mass_b(:,:) = snwice_mass(:,:)
! new mass per unit area
- snwice_mass (:,:) = tms(:,:) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:) )
+ snwice_mass (:,:) = tmask(:,:,1) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:) )
! time evolution of snow+ice mass
snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) * r1_rdtice
@@ -210,19 +195,17 @@
tn_ice(:,:,:) = t_su(:,:,:) ! Ice surface temperature
- !------------------------------------------------!
- ! Snow/ice albedo (only if sent to coupler) !
- !------------------------------------------------!
- IF( lk_cpl ) THEN ! coupled case
-
- CALL wrk_alloc( jpi, jpj, jpl, zalb_cs, zalb_os )
-
- CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos
-
- alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
-
- CALL wrk_dealloc( jpi, jpj, jpl, zalb_cs, zalb_os )
-
- ENDIF
-
+ !------------------------------------------------------------------------!
+ ! Snow/ice albedo (only if sent to coupler, useless in forced mode) !
+ !------------------------------------------------------------------------!
+ CALL wrk_alloc( jpi, jpj, jpl, zalb_cs, zalb_os )
+ CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos
+ alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
+ CALL wrk_dealloc( jpi, jpj, jpl, zalb_cs, zalb_os )
+
+ ! conservation test
+ IF( ln_limdiahsb ) CALL lim_cons_final( 'limsbc' )
+
+ ! control prints
+ IF( ln_icectl ) CALL lim_prt( kt, iiceprt, jiceprt, 3, ' - Final state lim_sbc - ' )
IF(ln_ctl) THEN
@@ -270,7 +253,5 @@
!
IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN !== Ice time-step only ==! (i.e. surface module time-step)
-!CDIR NOVERRCHK
DO jj = 2, jpjm1 !* update the modulus of stress at ocean surface (T-point)
-!CDIR NOVERRCHK
DO ji = fs_2, fs_jpim1
! ! 2*(U_ice-U_oce) at T-point
@@ -322,6 +303,4 @@
!! ** input : Namelist namicedia
!!-------------------------------------------------------------------
- REAL(wp) :: zsum, zarea
- !
INTEGER :: ji, jj, jk ! dummy loop indices
REAL(wp) :: zcoefu, zcoefv, zcoeff ! local scalar
@@ -343,14 +322,9 @@
END WHERE
ENDIF
- ! clem modif
- IF( .NOT. ln_rstart ) THEN
- fraqsr_1lev(:,:) = 1._wp
- ENDIF
- !
- ! clem: snwice_mass in the restart file now
+ !
IF( .NOT. ln_rstart ) THEN
! ! embedded sea ice
IF( nn_ice_embd /= 0 ) THEN ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass
- snwice_mass (:,:) = tms(:,:) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:) )
+ snwice_mass (:,:) = tmask(:,:,1) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:) )
snwice_mass_b(:,:) = snwice_mass(:,:)
ELSE
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90 (revision 5602)
@@ -22,16 +22,15 @@
USE phycst ! physical constants
USE dom_oce ! ocean space and time domain variables
- USE oce , ONLY : fraqsr_1lev
USE ice ! LIM: sea-ice variables
- USE par_ice ! LIM: sea-ice parameters
USE sbc_oce ! Surface boundary condition: ocean fields
USE sbc_ice ! Surface boundary condition: ice fields
USE thd_ice ! LIM thermodynamic sea-ice variables
USE dom_ice ! LIM sea-ice domain
- USE domvvl ! domain: variable volume level
USE limthd_dif ! LIM: thermodynamics, vertical diffusion
USE limthd_dh ! LIM: thermodynamics, ice and snow thickness variation
USE limthd_sal ! LIM: thermodynamics, ice salinity
USE limthd_ent ! LIM: thermodynamics, ice enthalpy redistribution
+ USE limthd_lac ! LIM-3 lateral accretion
+ USE limitd_th ! remapping thickness distribution
USE limtab ! LIM: 1D <==> 2D transformation
USE limvar ! LIM: sea-ice variables
@@ -44,10 +43,11 @@
USE timing ! Timing
USE limcons ! conservation tests
+ USE limctl
IMPLICIT NONE
PRIVATE
- PUBLIC lim_thd ! called by limstp module
- PUBLIC lim_thd_init ! called by iceini module
+ PUBLIC lim_thd ! called by limstp module
+ PUBLIC lim_thd_init ! called by sbc_lim_init
!! * Substitutions
@@ -80,19 +80,15 @@
!! ** References :
!!---------------------------------------------------------------------
- INTEGER, INTENT(in) :: kt ! number of iteration
+ INTEGER, INTENT(in) :: kt ! number of iteration
!!
INTEGER :: ji, jj, jk, jl ! dummy loop indices
- INTEGER :: nbpb ! nb of icy pts for thermo. cal.
+ INTEGER :: nbpb ! nb of icy pts for vertical thermo calculations
INTEGER :: ii, ij ! temporary dummy loop index
- REAL(wp) :: zfric_umin = 0._wp ! lower bound for the friction velocity (cice value=5.e-04)
- REAL(wp) :: zch = 0.0057_wp ! heat transfer coefficient
- REAL(wp) :: zareamin
REAL(wp) :: zfric_u, zqld, zqfr
- !
REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b
- !
- REAL(wp), POINTER, DIMENSION(:,:) :: zqsr, zqns
+ 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
+ !
!!-------------------------------------------------------------------
- CALL wrk_alloc( jpi, jpj, zqsr, zqns )
IF( nn_timing == 1 ) CALL timing_start('limthd')
@@ -101,4 +97,5 @@
IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+ CALL lim_var_glo2eqv
!------------------------------------------------------------------------!
! 1) Initialization of some variables !
@@ -106,9 +103,8 @@
ftr_ice(:,:,:) = 0._wp ! part of solar radiation transmitted through the ice
-
!--------------------
! 1.2) Heat content
!--------------------
- ! Change the units of heat content; from global units to J.m3
+ ! Change the units of heat content; from J/m2 to J/m3
DO jl = 1, jpl
DO jk = 1, nlay_i
@@ -116,9 +112,7 @@
DO ji = 1, jpi
!0 if no ice and 1 if yes
- rswitch = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 ) )
+ rswitch = MAX( 0._wp , SIGN( 1._wp , v_i(ji,jj,jl) - epsi20 ) )
!Energy of melting q(S,T) [J.m-3]
- e_i(ji,jj,jk,jl) = rswitch * e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi10 ) ) * REAL( nlay_i )
- !convert units ! very important that this line is here
- e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac
+ e_i(ji,jj,jk,jl) = rswitch * e_i(ji,jj,jk,jl) / MAX( v_i(ji,jj,jl) , epsi20 ) * REAL( nlay_i )
END DO
END DO
@@ -128,9 +122,7 @@
DO ji = 1, jpi
!0 if no ice and 1 if yes
- rswitch = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_s(ji,jj,jl) + epsi10 ) )
+ rswitch = MAX( 0._wp , SIGN( 1._wp , v_s(ji,jj,jl) - epsi20 ) )
!Energy of melting q(S,T) [J.m-3]
- e_s(ji,jj,jk,jl) = rswitch * e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL( nlay_s )
- !convert units ! very important that this line is here
- e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * unit_fac
+ e_s(ji,jj,jk,jl) = rswitch * e_s(ji,jj,jk,jl) / MAX( v_s(ji,jj,jl) , epsi20 ) * REAL( nlay_s )
END DO
END DO
@@ -140,30 +132,7 @@
! 2) Partial computation of forcing for the thermodynamic sea ice model. !
!-----------------------------------------------------------------------------!
-
- !--- Ocean solar and non solar fluxes to be used in zqld
- IF ( .NOT. lk_cpl ) THEN ! --- forced case, fluxes to the lead are the same as over the ocean
- !
- zqsr(:,:) = qsr(:,:) ; zqns(:,:) = qns(:,:)
- !
- ELSE ! --- coupled case, fluxes to the lead are total - intercepted
- !
- zqsr(:,:) = qsr_tot(:,:) ; zqns(:,:) = qns_tot(:,:)
- !
- DO jl = 1, jpl
- DO jj = 1, jpj
- DO ji = 1, jpi
- zqsr(ji,jj) = zqsr(ji,jj) - qsr_ice(ji,jj,jl) * a_i_b(ji,jj,jl)
- zqns(ji,jj) = zqns(ji,jj) - qns_ice(ji,jj,jl) * a_i_b(ji,jj,jl)
- END DO
- END DO
- END DO
- !
- ENDIF
-
-!CDIR NOVERRCHK
DO jj = 1, jpj
-!CDIR NOVERRCHK
DO ji = 1, jpi
- rswitch = tms(ji,jj) * ( 1._wp - MAX( 0._wp , SIGN( 1._wp , - at_i(ji,jj) + epsi10 ) ) ) ! 0 if no ice
+ rswitch = tmask(ji,jj,1) * MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) ! 0 if no ice
!
! ! solar irradiance transmission at the mixed layer bottom and used in the lead heat budget
@@ -173,31 +142,25 @@
! ! temperature and turbulent mixing (McPhee, 1992)
!
-
! --- Energy received in the lead, zqld is defined everywhere (J.m-2) --- !
- ! REMARK valid at least in forced mode from clem
- ! precip is included in qns but not in qns_ice
- IF ( lk_cpl ) THEN
- zqld = tms(ji,jj) * rdt_ice * &
- & ( zqsr(ji,jj) * fraqsr_1lev(ji,jj) + zqns(ji,jj) & ! pfrld already included in coupled mode
- & + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj) * & ! heat content of precip
- & ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus ) &
- & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) )
- ELSE
- zqld = tms(ji,jj) * rdt_ice * &
- & ( pfrld(ji,jj) * ( zqsr(ji,jj) * fraqsr_1lev(ji,jj) + zqns(ji,jj) ) &
- & + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj) * & ! heat content of precip
- & ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus ) &
- & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) )
- ENDIF
-
- !-- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- !
- zqfr = tms(ji,jj) * rau0 * rcp * fse3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) )
+ zqld = tmask(ji,jj,1) * rdt_ice * &
+ & ( pfrld(ji,jj) * qsr_oce(ji,jj) * frq_m(ji,jj) + pfrld(ji,jj) * qns_oce(ji,jj) + qemp_oce(ji,jj) )
+
+ ! --- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- !
+ zqfr = tmask(ji,jj,1) * rau0 * rcp * fse3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) )
+
+ ! --- Energy from the turbulent oceanic heat flux (W/m2) --- !
+ zfric_u = MAX( SQRT( ust2s(ji,jj) ), zfric_umin )
+ fhtur(ji,jj) = MAX( 0._wp, rswitch * rau0 * rcp * zch * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ) ! W.m-2
+ fhtur(ji,jj) = rswitch * MIN( fhtur(ji,jj), - zqfr * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) )
+ ! upper bound for fhtur: the heat retrieved from the ocean must be smaller than the heat necessary to reach
+ ! the freezing point, so that we do not have SST < T_freeze
+ ! This implies: - ( fhtur(ji,jj) * at_i(ji,jj) * rtdice ) - zqfr >= 0
!-- Energy Budget of the leads (J.m-2). Must be < 0 to form ice
- qlead(ji,jj) = MIN( 0._wp , zqld - zqfr )
+ qlead(ji,jj) = MIN( 0._wp , zqld - ( fhtur(ji,jj) * at_i(ji,jj) * rdt_ice ) - zqfr )
! If there is ice and leads are warming, then transfer energy from the lead budget and use it for bottom melting
- IF( at_i(ji,jj) > epsi10 .AND. zqld > 0._wp ) THEN
- fhld (ji,jj) = zqld * r1_rdtice / at_i(ji,jj) ! divided by at_i since this is (re)multiplied by a_i in limthd_dh.F90
+ IF( zqld > 0._wp ) THEN
+ fhld (ji,jj) = rswitch * zqld * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ! divided by at_i since this is (re)multiplied by a_i in limthd_dh.F90
qlead(ji,jj) = 0._wp
ELSE
@@ -205,44 +168,20 @@
ENDIF
!
- !-- Energy from the turbulent oceanic heat flux --- !
- !clem zfric_u = MAX ( MIN( SQRT( ust2s(ji,jj) ) , zfric_umax ) , zfric_umin )
- zfric_u = MAX( SQRT( ust2s(ji,jj) ), zfric_umin )
- fhtur(ji,jj) = MAX( 0._wp, rswitch * rau0 * rcp * zch * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ) ! W.m-2
- ! upper bound for fhtur: we do not want SST to drop below Tfreeze.
- ! So we say that the heat retrieved from the ocean (fhtur+fhld) must be < to the heat necessary to reach Tfreeze (zqfr)
- ! This is not a clean budget, so that should be corrected at some point
- fhtur(ji,jj) = rswitch * MIN( fhtur(ji,jj), - fhld(ji,jj) - zqfr * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) )
-
! -----------------------------------------
! Net heat flux on top of ice-ocean [W.m-2]
! -----------------------------------------
- ! First step here : heat flux at the ocean surface + precip
- ! Second step below : heat flux at the ice surface (after limthd_dif)
- hfx_in(ji,jj) = hfx_in(ji,jj) &
- ! heat flux above the ocean
- & + pfrld(ji,jj) * ( zqns(ji,jj) + zqsr(ji,jj) ) &
- ! latent heat of precip (note that precip is included in qns but not in qns_ice)
- & + ( 1._wp - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus ) &
- & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt )
+ hfx_in(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj)
! -----------------------------------------------------------------------------
- ! Net heat flux that is retroceded to the ocean or taken from the ocean [W.m-2]
+ ! Net heat flux on top of the ocean after ice thermo (1st step) [W.m-2]
! -----------------------------------------------------------------------------
! First step here : non solar + precip - qlead - qturb
! Second step in limthd_dh : heat remaining if total melt (zq_rema)
! Third step in limsbc : heat from ice-ocean mass exchange (zf_mass) + solar
- hfx_out(ji,jj) = hfx_out(ji,jj) &
- ! Non solar heat flux received by the ocean
- & + pfrld(ji,jj) * qns(ji,jj) &
- ! latent heat of precip (note that precip is included in qns but not in qns_ice)
- & + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj) &
- & * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus ) &
- & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) &
- ! heat flux taken from the ocean where there is open water ice formation
- & - qlead(ji,jj) * r1_rdtice &
- ! heat flux taken from the ocean during bottom growth/melt (fhld should be 0 while bott growth)
- & - at_i(ji,jj) * fhtur(ji,jj) &
- & - at_i(ji,jj) * fhld(ji,jj)
-
+ hfx_out(ji,jj) = pfrld(ji,jj) * qns_oce(ji,jj) + qemp_oce(ji,jj) & ! Non solar heat flux received by the ocean
+ & - qlead(ji,jj) * r1_rdtice & ! heat flux taken from the ocean where there is open water ice formation
+ & - at_i(ji,jj) * fhtur(ji,jj) & ! heat flux taken by turbulence
+ & - at_i(ji,jj) * fhld(ji,jj) ! heat flux taken during bottom growth/melt
+ ! (fhld should be 0 while bott growth)
END DO
END DO
@@ -259,9 +198,8 @@
ENDIF
- zareamin = epsi10
nbpb = 0
DO jj = 1, jpj
DO ji = 1, jpi
- IF ( a_i(ji,jj,jl) .gt. zareamin ) THEN
+ IF ( a_i(ji,jj,jl) > epsi10 ) THEN
nbpb = nbpb + 1
npb(nbpb) = (jj - 1) * jpi + ji
@@ -272,7 +210,7 @@
! debug point to follow
jiindex_1d = 0
- IF( ln_nicep ) THEN
- DO ji = mi0(jiindx), mi1(jiindx)
- DO jj = mj0(jjindx), mj1(jjindx)
+ IF( ln_icectl ) THEN
+ DO ji = mi0(iiceprt), mi1(iiceprt)
+ DO jj = mj0(jiceprt), mj1(jiceprt)
jiindex_1d = (jj - 1) * jpi + ji
WRITE(numout,*) ' lim_thd : Category no : ', jl
@@ -289,83 +227,16 @@
IF( nbpb > 0 ) THEN ! If there is no ice, do nothing.
- !-------------------------
- ! 4.1 Move to 1D arrays
- !-------------------------
-
- CALL tab_2d_1d( nbpb, at_i_1d (1:nbpb), at_i , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, a_i_1d (1:nbpb), a_i(:,:,jl) , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, ht_i_1d (1:nbpb), ht_i(:,:,jl) , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, ht_s_1d (1:nbpb), ht_s(:,:,jl) , jpi, jpj, npb(1:nbpb) )
-
- CALL tab_2d_1d( nbpb, t_su_1d (1:nbpb), t_su(:,:,jl) , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, sm_i_1d (1:nbpb), sm_i(:,:,jl) , jpi, jpj, npb(1:nbpb) )
- DO jk = 1, nlay_s
- CALL tab_2d_1d( nbpb, t_s_1d(1:nbpb,jk), t_s(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, q_s_1d(1:nbpb,jk), e_s(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) )
- END DO
- DO jk = 1, nlay_i
- CALL tab_2d_1d( nbpb, t_i_1d(1:nbpb,jk), t_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, q_i_1d(1:nbpb,jk), e_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, s_i_1d(1:nbpb,jk), s_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) )
- END DO
-
- CALL tab_2d_1d( nbpb, tatm_ice_1d(1:nbpb), tatm_ice(:,:) , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, qsr_ice_1d (1:nbpb), qsr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, fr1_i0_1d (1:nbpb), fr1_i0 , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, fr2_i0_1d (1:nbpb), fr2_i0 , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, qns_ice_1d (1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, ftr_ice_1d (1:nbpb), ftr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) )
- IF( .NOT. lk_cpl ) THEN
- CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb), dqla_ice(:,:,jl), jpi, jpj, npb(1:nbpb) )
- ENDIF
- CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl), jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, t_bo_1d (1:nbpb), t_bo , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, sprecip_1d (1:nbpb), sprecip , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, fhtur_1d (1:nbpb), fhtur , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, qlead_1d (1:nbpb), qlead , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, fhld_1d (1:nbpb), fhld , jpi, jpj, npb(1:nbpb) )
-
- CALL tab_2d_1d( nbpb, wfx_snw_1d (1:nbpb), wfx_snw , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, wfx_sub_1d (1:nbpb), wfx_sub , jpi, jpj, npb(1:nbpb) )
-
- CALL tab_2d_1d( nbpb, wfx_bog_1d (1:nbpb), wfx_bog , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, wfx_bom_1d (1:nbpb), wfx_bom , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, wfx_sum_1d (1:nbpb), wfx_sum , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, wfx_sni_1d (1:nbpb), wfx_sni , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, wfx_res_1d (1:nbpb), wfx_res , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, wfx_spr_1d (1:nbpb), wfx_spr , jpi, jpj, npb(1:nbpb) )
-
- CALL tab_2d_1d( nbpb, sfx_bog_1d (1:nbpb), sfx_bog , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, sfx_bom_1d (1:nbpb), sfx_bom , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, sfx_sum_1d (1:nbpb), sfx_sum , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, sfx_sni_1d (1:nbpb), sfx_sni , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res , jpi, jpj, npb(1:nbpb) )
-
- CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, hfx_spr_1d (1:nbpb), hfx_spr , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, hfx_sum_1d (1:nbpb), hfx_sum , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, hfx_bom_1d (1:nbpb), hfx_bom , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, hfx_bog_1d (1:nbpb), hfx_bog , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, hfx_dif_1d (1:nbpb), hfx_dif , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, hfx_opw_1d (1:nbpb), hfx_opw , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, hfx_snw_1d (1:nbpb), hfx_snw , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, hfx_sub_1d (1:nbpb), hfx_sub , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, hfx_err_1d (1:nbpb), hfx_err , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, hfx_res_1d (1:nbpb), hfx_res , jpi, jpj, npb(1:nbpb) )
- CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) )
-
- !--------------------------------
- ! 4.3) Thermodynamic processes
- !--------------------------------
+ !-------------------------!
+ ! --- Move to 1D arrays ---
+ !-------------------------!
+ CALL lim_thd_1d2d( nbpb, jl, 1 )
+
+ !--------------------------------------!
+ ! --- Ice/Snow Temperature profile --- !
+ !--------------------------------------!
+ CALL lim_thd_dif( 1, nbpb )
!---------------------------------!
- ! Ice/Snow Temperature profile !
- !---------------------------------!
- CALL lim_thd_dif( 1, nbpb )
-
- !---------------------------------!
- ! Ice/Snow thicnkess !
+ ! --- Ice/Snow thickness --- !
!---------------------------------!
CALL lim_thd_dh( 1, nbpb )
@@ -375,71 +246,30 @@
!---------------------------------!
- ! --- Ice salinity --- !
+ ! --- Ice salinity --- !
!---------------------------------!
CALL lim_thd_sal( 1, nbpb )
!---------------------------------!
- ! --- temperature update --- !
+ ! --- temperature update --- !
!---------------------------------!
CALL lim_thd_temp( 1, nbpb )
- !--------------------------------
- ! 4.4) Move 1D to 2D vectors
- !--------------------------------
-
- CALL tab_1d_2d( nbpb, at_i , npb, at_i_1d (1:nbpb) , jpi, jpj )
- CALL tab_1d_2d( nbpb, ht_i(:,:,jl) , npb, ht_i_1d (1:nbpb) , jpi, jpj )
- CALL tab_1d_2d( nbpb, ht_s(:,:,jl) , npb, ht_s_1d (1:nbpb) , jpi, jpj )
- CALL tab_1d_2d( nbpb, a_i (:,:,jl) , npb, a_i_1d (1:nbpb) , jpi, jpj )
- CALL tab_1d_2d( nbpb, t_su(:,:,jl) , npb, t_su_1d (1:nbpb) , jpi, jpj )
- CALL tab_1d_2d( nbpb, sm_i(:,:,jl) , npb, sm_i_1d (1:nbpb) , jpi, jpj )
- DO jk = 1, nlay_s
- CALL tab_1d_2d( nbpb, t_s(:,:,jk,jl), npb, t_s_1d (1:nbpb,jk), jpi, jpj)
- CALL tab_1d_2d( nbpb, e_s(:,:,jk,jl), npb, q_s_1d (1:nbpb,jk), jpi, jpj)
- END DO
- DO jk = 1, nlay_i
- CALL tab_1d_2d( nbpb, t_i(:,:,jk,jl), npb, t_i_1d (1:nbpb,jk), jpi, jpj)
- CALL tab_1d_2d( nbpb, e_i(:,:,jk,jl), npb, q_i_1d (1:nbpb,jk), jpi, jpj)
- CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_1d (1:nbpb,jk), jpi, jpj)
- END DO
- CALL tab_1d_2d( nbpb, qlead , npb, qlead_1d (1:nbpb) , jpi, jpj )
-
- CALL tab_1d_2d( nbpb, wfx_snw , npb, wfx_snw_1d(1:nbpb) , jpi, jpj )
- CALL tab_1d_2d( nbpb, wfx_sub , npb, wfx_sub_1d(1:nbpb) , jpi, jpj )
-
- CALL tab_1d_2d( nbpb, wfx_bog , npb, wfx_bog_1d(1:nbpb) , jpi, jpj )
- CALL tab_1d_2d( nbpb, wfx_bom , npb, wfx_bom_1d(1:nbpb) , jpi, jpj )
- CALL tab_1d_2d( nbpb, wfx_sum , npb, wfx_sum_1d(1:nbpb) , jpi, jpj )
- CALL tab_1d_2d( nbpb, wfx_sni , npb, wfx_sni_1d(1:nbpb) , jpi, jpj )
- CALL tab_1d_2d( nbpb, wfx_res , npb, wfx_res_1d(1:nbpb) , jpi, jpj )
- CALL tab_1d_2d( nbpb, wfx_spr , npb, wfx_spr_1d(1:nbpb) , jpi, jpj )
-
- CALL tab_1d_2d( nbpb, sfx_bog , npb, sfx_bog_1d(1:nbpb) , jpi, jpj )
- CALL tab_1d_2d( nbpb, sfx_bom , npb, sfx_bom_1d(1:nbpb) , jpi, jpj )
- CALL tab_1d_2d( nbpb, sfx_sum , npb, sfx_sum_1d(1:nbpb) , jpi, jpj )
- CALL tab_1d_2d( nbpb, sfx_sni , npb, sfx_sni_1d(1:nbpb) , jpi, jpj )
- CALL tab_1d_2d( nbpb, sfx_res , npb, sfx_res_1d(1:nbpb) , jpi, jpj )
- CALL tab_1d_2d( nbpb, sfx_bri , npb, sfx_bri_1d(1:nbpb) , jpi, jpj )
-
- CALL tab_1d_2d( nbpb, hfx_thd , npb, hfx_thd_1d(1:nbpb) , jpi, jpj )
- CALL tab_1d_2d( nbpb, hfx_spr , npb, hfx_spr_1d(1:nbpb) , jpi, jpj )
- CALL tab_1d_2d( nbpb, hfx_sum , npb, hfx_sum_1d(1:nbpb) , jpi, jpj )
- CALL tab_1d_2d( nbpb, hfx_bom , npb, hfx_bom_1d(1:nbpb) , jpi, jpj )
- CALL tab_1d_2d( nbpb, hfx_bog , npb, hfx_bog_1d(1:nbpb) , jpi, jpj )
- CALL tab_1d_2d( nbpb, hfx_dif , npb, hfx_dif_1d(1:nbpb) , jpi, jpj )
- CALL tab_1d_2d( nbpb, hfx_opw , npb, hfx_opw_1d(1:nbpb) , jpi, jpj )
- CALL tab_1d_2d( nbpb, hfx_snw , npb, hfx_snw_1d(1:nbpb) , jpi, jpj )
- CALL tab_1d_2d( nbpb, hfx_sub , npb, hfx_sub_1d(1:nbpb) , jpi, jpj )
- CALL tab_1d_2d( nbpb, hfx_err , npb, hfx_err_1d(1:nbpb) , jpi, jpj )
- CALL tab_1d_2d( nbpb, hfx_res , npb, hfx_res_1d(1:nbpb) , jpi, jpj )
- CALL tab_1d_2d( nbpb, hfx_err_rem , npb, hfx_err_rem_1d(1:nbpb) , jpi, jpj )
- !
- CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj)
- CALL tab_1d_2d( nbpb, ftr_ice(:,:,jl), npb, ftr_ice_1d(1:nbpb) , jpi, jpj )
+ !------------------------------------!
+ ! --- lateral melting if monocat --- !
+ !------------------------------------!
+ IF ( ( nn_monocat == 1 .OR. nn_monocat == 4 ) .AND. jpl == 1 ) THEN
+ CALL lim_thd_lam( 1, nbpb )
+ END IF
+
+ !-------------------------!
+ ! --- Move to 2D arrays ---
+ !-------------------------!
+ CALL lim_thd_1d2d( nbpb, jl, 2 )
+
!
IF( lk_mpp ) CALL mpp_comm_free( ncomm_ice ) !RB necessary ??
ENDIF
!
- END DO
+ END DO !jl
!------------------------------------------------------------------------------!
@@ -448,36 +278,52 @@
!------------------------
- ! 5.1) Ice heat content
+ ! Ice heat content
!------------------------
- ! Enthalpies are global variables we have to readjust the units (heat content in Joules)
+ ! Enthalpies are global variables we have to readjust the units (heat content in J/m2)
DO jl = 1, jpl
DO jk = 1, nlay_i
- e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_i(:,:,jl) / ( unit_fac * REAL( nlay_i ) )
+ e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * a_i(:,:,jl) * ht_i(:,:,jl) * r1_nlay_i
END DO
END DO
!------------------------
- ! 5.2) Snow heat content
+ ! Snow heat content
!------------------------
- ! Enthalpies are global variables we have to readjust the units (heat content in Joules)
+ ! Enthalpies are global variables we have to readjust the units (heat content in J/m2)
DO jl = 1, jpl
DO jk = 1, nlay_s
- e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_s(:,:,jl) / ( unit_fac * REAL( nlay_s ) )
+ e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * a_i(:,:,jl) * ht_s(:,:,jl) * r1_nlay_s
END DO
END DO
-
+
!----------------------------------
- ! 5.3) Change thickness to volume
+ ! Change thickness to volume
!----------------------------------
- CALL lim_var_eqv2glo
+ v_i(:,:,:) = ht_i(:,:,:) * a_i(:,:,:)
+ v_s(:,:,:) = ht_s(:,:,:) * a_i(:,:,:)
+ smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:)
+
+ ! update ice age (in case a_i changed, i.e. becomes 0 or lateral melting in monocat)
+ DO jl = 1, jpl
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ rswitch = MAX( 0._wp , SIGN( 1._wp, a_i_b(ji,jj,jl) - epsi10 ) )
+ oa_i(ji,jj,jl) = rswitch * oa_i(ji,jj,jl) * a_i(ji,jj,jl) / MAX( a_i_b(ji,jj,jl), epsi10 )
+ END DO
+ END DO
+ END DO
+
+ CALL lim_var_zapsmall
!--------------------------------------------
- ! 5.4) Diagnostic thermodynamic growth rates
+ ! Diagnostic thermodynamic growth rates
!--------------------------------------------
+ IF( ln_icectl ) CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermodyn. - ' ) ! control print
+
IF(ln_ctl) THEN ! Control print
CALL prt_ctl_info(' ')
CALL prt_ctl_info(' - Cell values : ')
CALL prt_ctl_info(' ~~~~~~~~~~~~~ ')
- CALL prt_ctl(tab2d_1=area , clinfo1=' lim_thd : cell area :')
+ CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_thd : cell area :')
CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_thd : at_i :')
CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_thd : vt_i :')
@@ -508,9 +354,59 @@
!
!
- CALL wrk_dealloc( jpi, jpj, zqsr, zqns )
-
- !
- ! conservation test
IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
+ !------------------------------------------------------------------------------|
+ ! 6) Transport of ice between thickness categories. |
+ !------------------------------------------------------------------------------|
+ ! Given thermodynamic growth rates, transport ice between thickness categories.
+ IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
+ IF( jpl > 1 ) CALL lim_itd_th_rem( 1, jpl, kt )
+
+ IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
+ !------------------------------------------------------------------------------|
+ ! 7) Add frazil ice growing in leads.
+ !------------------------------------------------------------------------------|
+ IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
+ CALL lim_thd_lac
+
+ IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
+ ! Control print
+ IF(ln_ctl) THEN
+ CALL lim_var_glo2eqv
+
+ CALL prt_ctl_info(' ')
+ CALL prt_ctl_info(' - Cell values : ')
+ CALL prt_ctl_info(' ~~~~~~~~~~~~~ ')
+ CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_itd_th : cell area :')
+ CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_th : at_i :')
+ CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_th : vt_i :')
+ CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_itd_th : vt_s :')
+ DO jl = 1, jpl
+ CALL prt_ctl_info(' ')
+ CALL prt_ctl_info(' - Category : ', ivar1=jl)
+ CALL prt_ctl_info(' ~~~~~~~~~~')
+ CALL prt_ctl(tab2d_1=a_i (:,:,jl) , clinfo1= ' lim_itd_th : a_i : ')
+ CALL prt_ctl(tab2d_1=ht_i (:,:,jl) , clinfo1= ' lim_itd_th : ht_i : ')
+ CALL prt_ctl(tab2d_1=ht_s (:,:,jl) , clinfo1= ' lim_itd_th : ht_s : ')
+ CALL prt_ctl(tab2d_1=v_i (:,:,jl) , clinfo1= ' lim_itd_th : v_i : ')
+ CALL prt_ctl(tab2d_1=v_s (:,:,jl) , clinfo1= ' lim_itd_th : v_s : ')
+ CALL prt_ctl(tab2d_1=e_s (:,:,1,jl) , clinfo1= ' lim_itd_th : e_s : ')
+ CALL prt_ctl(tab2d_1=t_su (:,:,jl) , clinfo1= ' lim_itd_th : t_su : ')
+ CALL prt_ctl(tab2d_1=t_s (:,:,1,jl) , clinfo1= ' lim_itd_th : t_snow : ')
+ CALL prt_ctl(tab2d_1=sm_i (:,:,jl) , clinfo1= ' lim_itd_th : sm_i : ')
+ CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' lim_itd_th : smv_i : ')
+ DO jk = 1, nlay_i
+ CALL prt_ctl_info(' ')
+ CALL prt_ctl_info(' - Layer : ', ivar1=jk)
+ CALL prt_ctl_info(' ~~~~~~~')
+ CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_itd_th : t_i : ')
+ CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_itd_th : e_i : ')
+ END DO
+ END DO
+ ENDIF
!
IF( nn_timing == 1 ) CALL timing_stop('limthd')
@@ -518,4 +414,5 @@
END SUBROUTINE lim_thd
+
SUBROUTINE lim_thd_temp( kideb, kiut )
!!-----------------------------------------------------------------------
@@ -534,19 +431,188 @@
DO jk = 1, nlay_i
DO ji = kideb, kiut
- ztmelts = -tmut * s_i_1d(ji,jk) + rtt
+ ztmelts = -tmut * s_i_1d(ji,jk) + rt0
! Conversion q(S,T) -> T (second order equation)
zaaa = cpic
- zbbb = ( rcp - cpic ) * ( ztmelts - rtt ) + q_i_1d(ji,jk) / rhoic - lfus
- zccc = lfus * ( ztmelts - rtt )
+ zbbb = ( rcp - cpic ) * ( ztmelts - rt0 ) + q_i_1d(ji,jk) * r1_rhoic - lfus
+ zccc = lfus * ( ztmelts - rt0 )
zdiscrim = SQRT( MAX( zbbb * zbbb - 4._wp * zaaa * zccc, 0._wp ) )
- t_i_1d(ji,jk) = rtt - ( zbbb + zdiscrim ) / ( 2._wp * zaaa )
+ t_i_1d(ji,jk) = rt0 - ( zbbb + zdiscrim ) / ( 2._wp * zaaa )
! mask temperature
rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_i_1d(ji) ) )
- t_i_1d(ji,jk) = rswitch * t_i_1d(ji,jk) + ( 1._wp - rswitch ) * rtt
+ t_i_1d(ji,jk) = rswitch * t_i_1d(ji,jk) + ( 1._wp - rswitch ) * rt0
END DO
END DO
END SUBROUTINE lim_thd_temp
+
+ SUBROUTINE lim_thd_lam( kideb, kiut )
+ !!-----------------------------------------------------------------------
+ !! *** ROUTINE lim_thd_lam ***
+ !!
+ !! ** Purpose : Lateral melting in case monocategory
+ !! ( dA = A/2h dh )
+ !!-----------------------------------------------------------------------
+ INTEGER, INTENT(in) :: kideb, kiut ! bounds for the spatial loop
+ INTEGER :: ji ! dummy loop indices
+ REAL(wp) :: zhi_bef ! ice thickness before thermo
+ REAL(wp) :: zdh_mel, zda_mel ! net melting
+ REAL(wp) :: zvi, zvs ! ice/snow volumes
+
+ DO ji = kideb, kiut
+ zdh_mel = MIN( 0._wp, dh_i_surf(ji) + dh_i_bott(ji) + dh_snowice(ji) )
+ IF( zdh_mel < 0._wp .AND. a_i_1d(ji) > 0._wp ) THEN
+ zvi = a_i_1d(ji) * ht_i_1d(ji)
+ zvs = a_i_1d(ji) * ht_s_1d(ji)
+ ! lateral melting = concentration change
+ zhi_bef = ht_i_1d(ji) - zdh_mel
+ rswitch = MAX( 0._wp , SIGN( 1._wp , zhi_bef - epsi20 ) )
+ zda_mel = rswitch * a_i_1d(ji) * zdh_mel / ( 2._wp * MAX( zhi_bef, epsi20 ) )
+ a_i_1d(ji) = MAX( epsi20, a_i_1d(ji) + zda_mel )
+ ! adjust thickness
+ ht_i_1d(ji) = zvi / a_i_1d(ji)
+ ht_s_1d(ji) = zvs / a_i_1d(ji)
+ ! retrieve total concentration
+ at_i_1d(ji) = a_i_1d(ji)
+ END IF
+ END DO
+
+ END SUBROUTINE lim_thd_lam
+
+ SUBROUTINE lim_thd_1d2d( nbpb, jl, kn )
+ !!-----------------------------------------------------------------------
+ !! *** ROUTINE lim_thd_1d2d ***
+ !!
+ !! ** Purpose : move arrays from 1d to 2d and the reverse
+ !!-----------------------------------------------------------------------
+ INTEGER, INTENT(in) :: kn ! 1= from 2D to 1D
+ ! 2= from 1D to 2D
+ INTEGER, INTENT(in) :: nbpb ! size of 1D arrays
+ INTEGER, INTENT(in) :: jl ! ice cat
+ INTEGER :: jk ! dummy loop indices
+
+ SELECT CASE( kn )
+
+ CASE( 1 )
+
+ CALL tab_2d_1d( nbpb, at_i_1d (1:nbpb), at_i , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, a_i_1d (1:nbpb), a_i(:,:,jl) , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, ht_i_1d (1:nbpb), ht_i(:,:,jl) , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, ht_s_1d (1:nbpb), ht_s(:,:,jl) , jpi, jpj, npb(1:nbpb) )
+
+ CALL tab_2d_1d( nbpb, t_su_1d (1:nbpb), t_su(:,:,jl) , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, sm_i_1d (1:nbpb), sm_i(:,:,jl) , jpi, jpj, npb(1:nbpb) )
+ DO jk = 1, nlay_s
+ CALL tab_2d_1d( nbpb, t_s_1d(1:nbpb,jk), t_s(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, q_s_1d(1:nbpb,jk), e_s(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) )
+ END DO
+ DO jk = 1, nlay_i
+ CALL tab_2d_1d( nbpb, t_i_1d(1:nbpb,jk), t_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, q_i_1d(1:nbpb,jk), e_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, s_i_1d(1:nbpb,jk), s_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) )
+ END DO
+
+ CALL tab_2d_1d( nbpb, qprec_ice_1d(1:nbpb), qprec_ice(:,:) , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, qsr_ice_1d (1:nbpb), qsr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, fr1_i0_1d (1:nbpb), fr1_i0 , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, fr2_i0_1d (1:nbpb), fr2_i0 , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, qns_ice_1d (1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, ftr_ice_1d (1:nbpb), ftr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, evap_ice_1d (1:nbpb), evap_ice(:,:,jl), jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl), jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, t_bo_1d (1:nbpb), t_bo , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, sprecip_1d (1:nbpb), sprecip , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, fhtur_1d (1:nbpb), fhtur , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, qlead_1d (1:nbpb), qlead , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, fhld_1d (1:nbpb), fhld , jpi, jpj, npb(1:nbpb) )
+
+ CALL tab_2d_1d( nbpb, wfx_snw_1d (1:nbpb), wfx_snw , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, wfx_sub_1d (1:nbpb), wfx_sub , jpi, jpj, npb(1:nbpb) )
+
+ CALL tab_2d_1d( nbpb, wfx_bog_1d (1:nbpb), wfx_bog , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, wfx_bom_1d (1:nbpb), wfx_bom , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, wfx_sum_1d (1:nbpb), wfx_sum , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, wfx_sni_1d (1:nbpb), wfx_sni , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, wfx_res_1d (1:nbpb), wfx_res , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, wfx_spr_1d (1:nbpb), wfx_spr , jpi, jpj, npb(1:nbpb) )
+
+ CALL tab_2d_1d( nbpb, sfx_bog_1d (1:nbpb), sfx_bog , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, sfx_bom_1d (1:nbpb), sfx_bom , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, sfx_sum_1d (1:nbpb), sfx_sum , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, sfx_sni_1d (1:nbpb), sfx_sni , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res , jpi, jpj, npb(1:nbpb) )
+
+ CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, hfx_spr_1d (1:nbpb), hfx_spr , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, hfx_sum_1d (1:nbpb), hfx_sum , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, hfx_bom_1d (1:nbpb), hfx_bom , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, hfx_bog_1d (1:nbpb), hfx_bog , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, hfx_dif_1d (1:nbpb), hfx_dif , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, hfx_opw_1d (1:nbpb), hfx_opw , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, hfx_snw_1d (1:nbpb), hfx_snw , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, hfx_sub_1d (1:nbpb), hfx_sub , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, hfx_err_1d (1:nbpb), hfx_err , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, hfx_res_1d (1:nbpb), hfx_res , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, hfx_err_dif_1d (1:nbpb), hfx_err_dif , jpi, jpj, npb(1:nbpb) )
+ CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) )
+
+ CASE( 2 )
+
+ CALL tab_1d_2d( nbpb, at_i , npb, at_i_1d (1:nbpb) , jpi, jpj )
+ CALL tab_1d_2d( nbpb, ht_i(:,:,jl) , npb, ht_i_1d (1:nbpb) , jpi, jpj )
+ CALL tab_1d_2d( nbpb, ht_s(:,:,jl) , npb, ht_s_1d (1:nbpb) , jpi, jpj )
+ CALL tab_1d_2d( nbpb, a_i (:,:,jl) , npb, a_i_1d (1:nbpb) , jpi, jpj )
+ CALL tab_1d_2d( nbpb, t_su(:,:,jl) , npb, t_su_1d (1:nbpb) , jpi, jpj )
+ CALL tab_1d_2d( nbpb, sm_i(:,:,jl) , npb, sm_i_1d (1:nbpb) , jpi, jpj )
+ DO jk = 1, nlay_s
+ CALL tab_1d_2d( nbpb, t_s(:,:,jk,jl), npb, t_s_1d (1:nbpb,jk), jpi, jpj)
+ CALL tab_1d_2d( nbpb, e_s(:,:,jk,jl), npb, q_s_1d (1:nbpb,jk), jpi, jpj)
+ END DO
+ DO jk = 1, nlay_i
+ CALL tab_1d_2d( nbpb, t_i(:,:,jk,jl), npb, t_i_1d (1:nbpb,jk), jpi, jpj)
+ CALL tab_1d_2d( nbpb, e_i(:,:,jk,jl), npb, q_i_1d (1:nbpb,jk), jpi, jpj)
+ CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_1d (1:nbpb,jk), jpi, jpj)
+ END DO
+ CALL tab_1d_2d( nbpb, qlead , npb, qlead_1d (1:nbpb) , jpi, jpj )
+
+ CALL tab_1d_2d( nbpb, wfx_snw , npb, wfx_snw_1d(1:nbpb) , jpi, jpj )
+ CALL tab_1d_2d( nbpb, wfx_sub , npb, wfx_sub_1d(1:nbpb) , jpi, jpj )
+
+ CALL tab_1d_2d( nbpb, wfx_bog , npb, wfx_bog_1d(1:nbpb) , jpi, jpj )
+ CALL tab_1d_2d( nbpb, wfx_bom , npb, wfx_bom_1d(1:nbpb) , jpi, jpj )
+ CALL tab_1d_2d( nbpb, wfx_sum , npb, wfx_sum_1d(1:nbpb) , jpi, jpj )
+ CALL tab_1d_2d( nbpb, wfx_sni , npb, wfx_sni_1d(1:nbpb) , jpi, jpj )
+ CALL tab_1d_2d( nbpb, wfx_res , npb, wfx_res_1d(1:nbpb) , jpi, jpj )
+ CALL tab_1d_2d( nbpb, wfx_spr , npb, wfx_spr_1d(1:nbpb) , jpi, jpj )
+
+ CALL tab_1d_2d( nbpb, sfx_bog , npb, sfx_bog_1d(1:nbpb) , jpi, jpj )
+ CALL tab_1d_2d( nbpb, sfx_bom , npb, sfx_bom_1d(1:nbpb) , jpi, jpj )
+ CALL tab_1d_2d( nbpb, sfx_sum , npb, sfx_sum_1d(1:nbpb) , jpi, jpj )
+ CALL tab_1d_2d( nbpb, sfx_sni , npb, sfx_sni_1d(1:nbpb) , jpi, jpj )
+ CALL tab_1d_2d( nbpb, sfx_res , npb, sfx_res_1d(1:nbpb) , jpi, jpj )
+ CALL tab_1d_2d( nbpb, sfx_bri , npb, sfx_bri_1d(1:nbpb) , jpi, jpj )
+
+ CALL tab_1d_2d( nbpb, hfx_thd , npb, hfx_thd_1d(1:nbpb) , jpi, jpj )
+ CALL tab_1d_2d( nbpb, hfx_spr , npb, hfx_spr_1d(1:nbpb) , jpi, jpj )
+ CALL tab_1d_2d( nbpb, hfx_sum , npb, hfx_sum_1d(1:nbpb) , jpi, jpj )
+ CALL tab_1d_2d( nbpb, hfx_bom , npb, hfx_bom_1d(1:nbpb) , jpi, jpj )
+ CALL tab_1d_2d( nbpb, hfx_bog , npb, hfx_bog_1d(1:nbpb) , jpi, jpj )
+ CALL tab_1d_2d( nbpb, hfx_dif , npb, hfx_dif_1d(1:nbpb) , jpi, jpj )
+ CALL tab_1d_2d( nbpb, hfx_opw , npb, hfx_opw_1d(1:nbpb) , jpi, jpj )
+ CALL tab_1d_2d( nbpb, hfx_snw , npb, hfx_snw_1d(1:nbpb) , jpi, jpj )
+ CALL tab_1d_2d( nbpb, hfx_sub , npb, hfx_sub_1d(1:nbpb) , jpi, jpj )
+ CALL tab_1d_2d( nbpb, hfx_err , npb, hfx_err_1d(1:nbpb) , jpi, jpj )
+ CALL tab_1d_2d( nbpb, hfx_res , npb, hfx_res_1d(1:nbpb) , jpi, jpj )
+ CALL tab_1d_2d( nbpb, hfx_err_rem , npb, hfx_err_rem_1d(1:nbpb), jpi, jpj )
+ CALL tab_1d_2d( nbpb, hfx_err_dif , npb, hfx_err_dif_1d(1:nbpb), jpi, jpj )
+ !
+ CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj)
+ CALL tab_1d_2d( nbpb, ftr_ice(:,:,jl), npb, ftr_ice_1d(1:nbpb) , jpi, jpj )
+ !
+ END SELECT
+
+ END SUBROUTINE lim_thd_1d2d
+
SUBROUTINE lim_thd_init
@@ -563,7 +629,7 @@
!!-------------------------------------------------------------------
INTEGER :: ios ! Local integer output status for namelist read
- NAMELIST/namicethd/ hmelt , hiccrit, fraz_swi, maxfrazb, vfrazb, Cfrazb, &
- & hiclim, hnzst, parsub, betas, &
- & kappa_i, nconv_i_thd, maxer_i_thd, thcon_i_swi
+ NAMELIST/namicethd/ rn_hnewice, ln_frazil, rn_maxfrazb, rn_vfrazb, rn_Cfrazb, &
+ & rn_himin, rn_betas, rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon, &
+ & nn_monocat, ln_it_qnsice
!!-------------------------------------------------------------------
!
@@ -582,26 +648,29 @@
902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicethd in configuration namelist', lwp )
IF(lwm) WRITE ( numoni, namicethd )
-
- IF( lk_cpl .AND. parsub /= 0.0 ) CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' )
+ !
+ IF ( ( jpl > 1 ) .AND. ( nn_monocat == 1 ) ) THEN
+ nn_monocat = 0
+ IF(lwp) WRITE(numout, *) ' nn_monocat must be 0 in multi-category case '
+ ENDIF
+
!
IF(lwp) THEN ! control print
WRITE(numout,*)
WRITE(numout,*)' Namelist of ice parameters for ice thermodynamic computation '
- WRITE(numout,*)' maximum melting at the bottom hmelt = ', hmelt
- WRITE(numout,*)' ice thick. for lateral accretion hiccrit = ', hiccrit
- WRITE(numout,*)' Frazil ice thickness as a function of wind or not fraz_swi = ', fraz_swi
- WRITE(numout,*)' Maximum proportion of frazil ice collecting at bottom maxfrazb = ', maxfrazb
- WRITE(numout,*)' Thresold relative drift speed for collection of frazil vfrazb = ', vfrazb
- WRITE(numout,*)' Squeezing coefficient for collection of frazil Cfrazb = ', Cfrazb
- WRITE(numout,*)' minimum ice thickness hiclim = ', hiclim
+ WRITE(numout,*)' ice thick. for lateral accretion rn_hnewice = ', rn_hnewice
+ WRITE(numout,*)' Frazil ice thickness as a function of wind or not ln_frazil = ', ln_frazil
+ WRITE(numout,*)' Maximum proportion of frazil ice collecting at bottom rn_maxfrazb = ', rn_maxfrazb
+ WRITE(numout,*)' Thresold relative drift speed for collection of frazil rn_vfrazb = ', rn_vfrazb
+ WRITE(numout,*)' Squeezing coefficient for collection of frazil rn_Cfrazb = ', rn_Cfrazb
+ WRITE(numout,*)' minimum ice thickness rn_himin = ', rn_himin
WRITE(numout,*)' numerical carac. of the scheme for diffusion in ice '
- WRITE(numout,*)' thickness of the surf. layer in temp. computation hnzst = ', hnzst
- WRITE(numout,*)' switch for snow sublimation (=1) or not (=0) parsub = ', parsub
- WRITE(numout,*)' coefficient for ice-lead partition of snowfall betas = ', betas
- WRITE(numout,*)' extinction radiation parameter in sea ice (1.0) kappa_i = ', kappa_i
- WRITE(numout,*)' maximal n. of iter. for heat diffusion computation nconv_i_thd = ', nconv_i_thd
- WRITE(numout,*)' maximal err. on T for heat diffusion computation maxer_i_thd = ', maxer_i_thd
- WRITE(numout,*)' switch for comp. of thermal conductivity in the ice thcon_i_swi = ', thcon_i_swi
+ WRITE(numout,*)' coefficient for ice-lead partition of snowfall rn_betas = ', rn_betas
+ WRITE(numout,*)' extinction radiation parameter in sea ice rn_kappa_i = ', rn_kappa_i
+ WRITE(numout,*)' maximal n. of iter. for heat diffusion computation nn_conv_dif = ', nn_conv_dif
+ WRITE(numout,*)' maximal err. on T for heat diffusion computation rn_terr_dif = ', rn_terr_dif
+ WRITE(numout,*)' switch for comp. of thermal conductivity in the ice nn_ice_thcon = ', nn_ice_thcon
WRITE(numout,*)' check heat conservation in the ice/snow con_i = ', con_i
+ WRITE(numout,*)' virtual ITD mono-category parameterizations (1) or not nn_monocat = ', nn_monocat
+ WRITE(numout,*)' iterate the surface non-solar flux (T) or not (F) ln_it_qnsice = ', ln_it_qnsice
ENDIF
!
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90 (revision 5602)
@@ -20,5 +20,4 @@
USE sbc_oce ! Surface boundary condition: ocean fields
USE ice ! LIM variables
- USE par_ice ! LIM parameters
USE thd_ice ! LIM thermodynamics
USE in_out_manager ! I/O manager
@@ -30,5 +29,10 @@
PRIVATE
- PUBLIC lim_thd_dh ! called by lim_thd
+ PUBLIC lim_thd_dh ! called by lim_thd
+ PUBLIC lim_thd_snwblow ! called in sbcblk/sbcclio/sbccpl and here
+
+ INTERFACE lim_thd_snwblow
+ MODULE PROCEDURE lim_thd_snwblow_1d, lim_thd_snwblow_2d
+ END INTERFACE
!!----------------------------------------------------------------------
@@ -70,8 +74,7 @@
REAL(wp) :: ztmelts ! local scalar
- REAL(wp) :: zdh, zfdum !
+ REAL(wp) :: zfdum
REAL(wp) :: zfracs ! fractionation coefficient for bottom salt entrapment
- REAL(wp) :: zcoeff ! dummy argument for snowfall partitioning over ice and leads
- REAL(wp) :: zs_snic ! snow-ice salinity
+ REAL(wp) :: zs_snic ! snow-ice salinity
REAL(wp) :: zswi1 ! switch for computation of bottom salinity
REAL(wp) :: zswi12 ! switch for computation of bottom salinity
@@ -87,12 +90,9 @@
REAL(wp) :: zsstK ! SST in Kelvin
- REAL(wp), POINTER, DIMENSION(:) :: zh_s ! snow layer thickness
REAL(wp), POINTER, DIMENSION(:) :: zqprec ! energy of fallen snow (J.m-3)
REAL(wp), POINTER, DIMENSION(:) :: zq_su ! heat for surface ablation (J.m-2)
REAL(wp), POINTER, DIMENSION(:) :: zq_bo ! heat for bottom ablation (J.m-2)
- REAL(wp), POINTER, DIMENSION(:) :: zq_1cat ! corrected heat in case 1-cat and hmelt>15cm (J.m-2)
REAL(wp), POINTER, DIMENSION(:) :: zq_rema ! remaining heat at the end of the routine (J.m-2)
- REAL(wp), POINTER, DIMENSION(:) :: zf_tt ! Heat budget to determine melting or freezing(W.m-2)
- INTEGER , POINTER, DIMENSION(:) :: icount ! number of layers vanished by melting
+ REAL(wp), POINTER, DIMENSION(:) :: zf_tt ! Heat budget to determine melting or freezing(W.m-2)
REAL(wp), POINTER, DIMENSION(:) :: zdh_s_mel ! snow melt
@@ -102,11 +102,12 @@
REAL(wp), POINTER, DIMENSION(:,:) :: zdeltah
REAL(wp), POINTER, DIMENSION(:,:) :: zh_i ! ice layer thickness
+ INTEGER , POINTER, DIMENSION(:,:) :: icount ! number of layers vanished by melting
REAL(wp), POINTER, DIMENSION(:) :: zqh_i ! total ice heat content (J.m-2)
REAL(wp), POINTER, DIMENSION(:) :: zqh_s ! total snow heat content (J.m-2)
REAL(wp), POINTER, DIMENSION(:) :: zq_s ! total snow enthalpy (J.m-3)
-
- ! mass and salt flux (clem)
- REAL(wp) :: zdvres, zswitch_sal
+ REAL(wp), POINTER, DIMENSION(:) :: zsnw ! distribution of snow after wind blowing
+
+ REAL(wp) :: zswitch_sal
! Heat conservation
@@ -115,31 +116,31 @@
!!------------------------------------------------------------------
- ! Discriminate between varying salinity (num_sal=2) and prescribed cases (other values)
- SELECT CASE( num_sal ) ! varying salinity or not
+ ! Discriminate between varying salinity (nn_icesal=2) and prescribed cases (other values)
+ SELECT CASE( nn_icesal ) ! varying salinity or not
CASE( 1, 3, 4 ) ; zswitch_sal = 0 ! prescribed salinity profile
CASE( 2 ) ; zswitch_sal = 1 ! varying salinity profile
END SELECT
- CALL wrk_alloc( jpij, zh_s, zqprec, zq_su, zq_bo, zf_tt, zq_1cat, zq_rema )
+ CALL wrk_alloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw )
CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s )
- CALL wrk_alloc( jpij, nlay_i+1, zdeltah, zh_i )
- CALL wrk_alloc( jpij, icount )
-
+ CALL wrk_alloc( jpij, nlay_i, zdeltah, zh_i )
+ CALL wrk_alloc( jpij, nlay_i, icount )
+
dh_i_surf (:) = 0._wp ; dh_i_bott (:) = 0._wp ; dh_snowice(:) = 0._wp
dsm_i_se_1d(:) = 0._wp ; dsm_i_si_1d(:) = 0._wp
-
- zqprec (:) = 0._wp ; zq_su (:) = 0._wp ; zq_bo (:) = 0._wp ; zf_tt (:) = 0._wp
- zq_1cat(:) = 0._wp ; zq_rema(:) = 0._wp
-
- zh_s (:) = 0._wp
- zdh_s_pre(:) = 0._wp
- zdh_s_mel(:) = 0._wp
- zdh_s_sub(:) = 0._wp
- zqh_s (:) = 0._wp
- zqh_i (:) = 0._wp
-
- zh_i (:,:) = 0._wp
- zdeltah (:,:) = 0._wp
- icount (:) = 0
+
+ zqprec (:) = 0._wp ; zq_su (:) = 0._wp ; zq_bo (:) = 0._wp ; zf_tt(:) = 0._wp
+ zq_rema (:) = 0._wp ; zsnw (:) = 0._wp
+ zdh_s_mel(:) = 0._wp ; zdh_s_pre(:) = 0._wp ; zdh_s_sub(:) = 0._wp ; zqh_i(:) = 0._wp
+ zqh_s (:) = 0._wp ; zq_s (:) = 0._wp
+
+ zdeltah(:,:) = 0._wp ; zh_i(:,:) = 0._wp
+ icount (:,:) = 0
+
+
+ ! Initialize enthalpy at nlay_i+1
+ DO ji = kideb, kiut
+ q_i_1d(ji,nlay_i+1) = 0._wp
+ END DO
! initialize layer thicknesses and enthalpies
@@ -148,5 +149,5 @@
DO jk = 1, nlay_i
DO ji = kideb, kiut
- h_i_old (ji,jk) = ht_i_1d(ji) / REAL( nlay_i )
+ h_i_old (ji,jk) = ht_i_1d(ji) * r1_nlay_i
qh_i_old(ji,jk) = q_i_1d(ji,jk) * h_i_old(ji,jk)
ENDDO
@@ -158,11 +159,8 @@
!
DO ji = kideb, kiut
- rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_1d(ji) ) )
- ztmelts = rswitch * rtt + ( 1._wp - rswitch ) * rtt
-
zfdum = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji)
zf_tt(ji) = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji)
- zq_su (ji) = MAX( 0._wp, zfdum * rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - ztmelts ) )
+ zq_su (ji) = MAX( 0._wp, zfdum * rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - rt0 ) )
zq_bo (ji) = MAX( 0._wp, zf_tt(ji) * rdt_ice )
END DO
@@ -174,5 +172,5 @@
!------------------------------------------------------------------------------!
DO ji = kideb, kiut
- IF( t_s_1d(ji,1) > rtt ) THEN !!! Internal melting
+ IF( t_s_1d(ji,1) > rt0 ) THEN !!! Internal melting
! Contribution to heat flux to the ocean [W.m-2], < 0
hfx_res_1d(ji) = hfx_res_1d(ji) + q_s_1d(ji,1) * ht_s_1d(ji) * a_i_1d(ji) * r1_rdtice
@@ -182,5 +180,5 @@
ht_s_1d(ji) = 0._wp
q_s_1d (ji,1) = 0._wp
- t_s_1d (ji,1) = rtt
+ t_s_1d (ji,1) = rt0
END IF
END DO
@@ -190,11 +188,7 @@
!------------------------------------------------------------!
!
- DO ji = kideb, kiut
- zh_s(ji) = ht_s_1d(ji) / REAL( nlay_s )
- END DO
- !
DO jk = 1, nlay_s
DO ji = kideb, kiut
- zqh_s(ji) = zqh_s(ji) + q_s_1d(ji,jk) * zh_s(ji)
+ zqh_s(ji) = zqh_s(ji) + q_s_1d(ji,jk) * ht_s_1d(ji) * r1_nlay_s
END DO
END DO
@@ -202,5 +196,5 @@
DO jk = 1, nlay_i
DO ji = kideb, kiut
- zh_i(ji,jk) = ht_i_1d(ji) / REAL( nlay_i )
+ zh_i(ji,jk) = ht_i_1d(ji) * r1_nlay_i
zqh_i(ji) = zqh_i(ji) + q_i_1d(ji,jk) * zh_i(ji,jk)
END DO
@@ -225,4 +219,7 @@
! Martin Vancoppenolle, December 2006
+ CALL lim_thd_snwblow( 1. - at_i_1d(kideb:kiut), zsnw(kideb:kiut) ) ! snow distribution over ice after wind blowing
+
+ zdeltah(:,:) = 0._wp
DO ji = kideb, kiut
!-----------
@@ -230,8 +227,7 @@
!-----------
! thickness change
- zcoeff = ( 1._wp - ( 1._wp - at_i_1d(ji) )**betas ) / at_i_1d(ji)
- zdh_s_pre(ji) = zcoeff * sprecip_1d(ji) * rdt_ice / rhosn
- ! enthalpy of the precip (>0, J.m-3) (tatm_ice is now in K)
- zqprec (ji) = rhosn * ( cpic * ( rtt - MIN( tatm_ice_1d(ji), rt0_snow) ) + lfus )
+ zdh_s_pre(ji) = zsnw(ji) * sprecip_1d(ji) * rdt_ice * r1_rhosn / at_i_1d(ji)
+ ! enthalpy of the precip (>0, J.m-3)
+ zqprec (ji) = - qprec_ice_1d(ji)
IF( sprecip_1d(ji) == 0._wp ) zqprec(ji) = 0._wp
! heat flux from snow precip (>0, W.m-2)
@@ -239,6 +235,4 @@
! mass flux, <0
wfx_spr_1d(ji) = wfx_spr_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_pre(ji) * r1_rdtice
- ! update thickness
- ht_s_1d (ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_pre(ji) )
!---------------------
@@ -246,30 +240,28 @@
!---------------------
! thickness change
- IF( zdh_s_pre(ji) > 0._wp ) THEN
- rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zqprec(ji) + epsi20 ) )
- zdh_s_mel (ji) = - rswitch * zq_su(ji) / MAX( zqprec(ji) , epsi20 )
- zdh_s_mel (ji) = MAX( - zdh_s_pre(ji), zdh_s_mel(ji) ) ! bound melting
+ rswitch = MAX( 0._wp , SIGN( 1._wp , zqprec(ji) - epsi20 ) )
+ zdeltah (ji,1) = - rswitch * zq_su(ji) / MAX( zqprec(ji) , epsi20 )
+ zdeltah (ji,1) = MAX( - zdh_s_pre(ji), zdeltah(ji,1) ) ! bound melting
! heat used to melt snow (W.m-2, >0)
- hfx_snw_1d(ji) = hfx_snw_1d(ji) - zdh_s_mel(ji) * a_i_1d(ji) * zqprec(ji) * r1_rdtice
+ hfx_snw_1d(ji) = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_1d(ji) * zqprec(ji) * r1_rdtice
! snow melting only = water into the ocean (then without snow precip), >0
- wfx_snw_1d(ji) = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_mel(ji) * r1_rdtice
-
- ! updates available heat + thickness
- zq_su (ji) = MAX( 0._wp , zq_su (ji) + zdh_s_mel(ji) * zqprec(ji) )
- ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_mel(ji) )
- zh_s (ji) = ht_s_1d(ji) / REAL( nlay_s )
-
- ENDIF
- END DO
-
- ! If heat still available, then melt more snow
- zdeltah(:,:) = 0._wp ! important
+ wfx_snw_1d(ji) = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice
+ ! updates available heat + precipitations after melting
+ zq_su (ji) = MAX( 0._wp , zq_su (ji) + zdeltah(ji,1) * zqprec(ji) )
+ zdh_s_pre (ji) = zdh_s_pre(ji) + zdeltah(ji,1)
+
+ ! update thickness
+ ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_pre(ji) )
+ END DO
+
+ ! If heat still available (zq_su > 0), then melt more snow
+ zdeltah(:,:) = 0._wp
DO jk = 1, nlay_s
DO ji = kideb, kiut
! thickness change
rswitch = 1._wp - MAX( 0._wp, SIGN( 1._wp, - ht_s_1d(ji) ) )
- rswitch = rswitch * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, - q_s_1d(ji,jk) + epsi20 ) ) )
+ rswitch = rswitch * ( MAX( 0._wp, SIGN( 1._wp, q_s_1d(ji,jk) - epsi20 ) ) )
zdeltah (ji,jk) = - rswitch * zq_su(ji) / MAX( q_s_1d(ji,jk), epsi20 )
- zdeltah (ji,jk) = MAX( zdeltah(ji,jk) , - zh_s(ji) ) ! bound melting
+ zdeltah (ji,jk) = MAX( zdeltah(ji,jk) , - ht_s_1d(ji) ) ! bound melting
zdh_s_mel(ji) = zdh_s_mel(ji) + zdeltah(ji,jk)
! heat used to melt snow(W.m-2, >0)
@@ -277,9 +269,7 @@
! snow melting only = water into the ocean (then without snow precip)
wfx_snw_1d(ji) = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
-
! updates available heat + thickness
- zq_su (ji) = MAX( 0._wp , zq_su (ji) + zdeltah(ji,jk) * q_s_1d(ji,jk) )
+ zq_su (ji) = MAX( 0._wp , zq_su (ji) + zdeltah(ji,jk) * q_s_1d(ji,jk) )
ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdeltah(ji,jk) )
-
END DO
END DO
@@ -289,31 +279,29 @@
!----------------------
! qla_ice is always >=0 (upwards), heat goes to the atmosphere, therefore snow sublimates
- ! clem comment: not counted in mass exchange in limsbc since this is an exchange with atm. (not ocean)
+ ! clem comment: not counted in mass/heat exchange in limsbc since this is an exchange with atm. (not ocean)
! clem comment: ice should also sublimate
- IF( lk_cpl ) THEN
- ! coupled mode: sublimation already included in emp_ice (to do in limsbc_ice)
- zdh_s_sub(:) = 0._wp
- ELSE
- ! forced mode: snow thickness change due to sublimation
- DO ji = kideb, kiut
- zdh_s_sub(ji) = MAX( - ht_s_1d(ji) , - parsub * qla_ice_1d(ji) / ( rhosn * lsub ) * rdt_ice )
- ! Heat flux by sublimation [W.m-2], < 0
- ! sublimate first snow that had fallen, then pre-existing snow
- zcoeff = ( MAX( zdh_s_sub(ji), - MAX( 0._wp, zdh_s_pre(ji) + zdh_s_mel(ji) ) ) * zqprec(ji) + &
- & ( zdh_s_sub(ji) - MAX( zdh_s_sub(ji), - MAX( 0._wp, zdh_s_pre(ji) + zdh_s_mel(ji) ) ) ) * q_s_1d(ji,1) ) &
- & * a_i_1d(ji) * r1_rdtice
- hfx_sub_1d(ji) = hfx_sub_1d(ji) + zcoeff
- ! Mass flux by sublimation
- wfx_sub_1d(ji) = wfx_sub_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_sub(ji) * r1_rdtice
- ! new snow thickness
- ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_sub(ji) )
- END DO
- ENDIF
-
+ zdeltah(:,:) = 0._wp
+ ! coupled mode: sublimation is set to 0 (evap_ice = 0) until further notice
+ ! forced mode: snow thickness change due to sublimation
+ DO ji = kideb, kiut
+ zdh_s_sub(ji) = MAX( - ht_s_1d(ji) , - evap_ice_1d(ji) * r1_rhosn * rdt_ice )
+ ! Heat flux by sublimation [W.m-2], < 0
+ ! sublimate first snow that had fallen, then pre-existing snow
+ zdeltah(ji,1) = MAX( zdh_s_sub(ji), - zdh_s_pre(ji) )
+ hfx_sub_1d(ji) = hfx_sub_1d(ji) + ( zdeltah(ji,1) * zqprec(ji) + ( zdh_s_sub(ji) - zdeltah(ji,1) ) * q_s_1d(ji,1) &
+ & ) * a_i_1d(ji) * r1_rdtice
+ ! Mass flux by sublimation
+ wfx_sub_1d(ji) = wfx_sub_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_sub(ji) * r1_rdtice
+ ! new snow thickness
+ ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_sub(ji) )
+ ! update precipitations after sublimation and correct sublimation
+ zdh_s_pre(ji) = zdh_s_pre(ji) + zdeltah(ji,1)
+ zdh_s_sub(ji) = zdh_s_sub(ji) - zdeltah(ji,1)
+ END DO
+
! --- Update snow diags --- !
DO ji = kideb, kiut
- dh_s_tot(ji) = zdh_s_mel(ji) + zdh_s_pre(ji) + zdh_s_sub(ji)
- zh_s(ji) = ht_s_1d(ji) / REAL( nlay_s )
- END DO ! ji
+ dh_s_tot(ji) = zdh_s_mel(ji) + zdh_s_pre(ji) + zdh_s_sub(ji)
+ END DO
!-------------------------------------------
@@ -324,8 +312,8 @@
DO jk = 1, nlay_s
DO ji = kideb,kiut
- rswitch = MAX( 0._wp , SIGN( 1._wp, - ht_s_1d(ji) + epsi20 ) )
- q_s_1d(ji,jk) = ( 1._wp - rswitch ) / MAX( ht_s_1d(ji), epsi20 ) * &
- & ( ( MAX( 0._wp, dh_s_tot(ji) ) ) * zqprec(ji) + &
- & ( - MAX( 0._wp, dh_s_tot(ji) ) + ht_s_1d(ji) ) * rhosn * ( cpic * ( rtt - t_s_1d(ji,jk) ) + lfus ) )
+ rswitch = MAX( 0._wp , SIGN( 1._wp, ht_s_1d(ji) - epsi20 ) )
+ q_s_1d(ji,jk) = rswitch / MAX( ht_s_1d(ji), epsi20 ) * &
+ & ( ( zdh_s_pre(ji) ) * zqprec(ji) + &
+ & ( ht_s_1d(ji) - zdh_s_pre(ji) ) * rhosn * ( cpic * ( rt0 - t_s_1d(ji,jk) ) + lfus ) )
zq_s(ji) = zq_s(ji) + q_s_1d(ji,jk)
END DO
@@ -337,45 +325,68 @@
zdeltah(:,:) = 0._wp ! important
DO jk = 1, nlay_i
- DO ji = kideb, kiut
- zEi = - q_i_1d(ji,jk) / rhoic ! Specific enthalpy of layer k [J/kg, <0]
-
- ztmelts = - tmut * s_i_1d(ji,jk) + rtt ! Melting point of layer k [K]
-
- zEw = rcp * ( ztmelts - rt0 ) ! Specific enthalpy of resulting meltwater [J/kg, <0]
-
- zdE = zEi - zEw ! Specific enthalpy difference < 0
-
- zfmdt = - zq_su(ji) / zdE ! Mass flux to the ocean [kg/m2, >0]
-
- zdeltah(ji,jk) = - zfmdt / rhoic ! Melt of layer jk [m, <0]
-
- zdeltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk) , - zh_i(ji,jk) ) ) ! Melt of layer jk cannot exceed the layer thickness [m, <0]
-
- zq_su(ji) = MAX( 0._wp , zq_su(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat
-
- dh_i_surf(ji) = dh_i_surf(ji) + zdeltah(ji,jk) ! Cumulate surface melt
-
- zfmdt = - rhoic * zdeltah(ji,jk) ! Recompute mass flux [kg/m2, >0]
-
- zQm = zfmdt * zEw ! Energy of the melt water sent to the ocean [J/m2, <0]
-
- ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok)
- sfx_sum_1d(ji) = sfx_sum_1d(ji) - sm_i_1d(ji) * a_i_1d(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice
-
- ! Contribution to heat flux [W.m-2], < 0
- hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice
-
- ! Total heat flux used in this process [W.m-2], > 0
- hfx_sum_1d(ji) = hfx_sum_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice
-
- ! Contribution to mass flux
- wfx_sum_1d(ji) = wfx_sum_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
-
+ DO ji = kideb, kiut
+ ztmelts = - tmut * s_i_1d(ji,jk) + rt0 ! Melting point of layer k [K]
+
+ IF( t_i_1d(ji,jk) >= ztmelts ) THEN !!! Internal melting
+
+ zEi = - q_i_1d(ji,jk) * r1_rhoic ! Specific enthalpy of layer k [J/kg, <0]
+ zdE = 0._wp ! Specific enthalpy difference (J/kg, <0)
+ ! set up at 0 since no energy is needed to melt water...(it is already melted)
+ zdeltah(ji,jk) = MIN( 0._wp , - zh_i(ji,jk) ) ! internal melting occurs when the internal temperature is above freezing
+ ! this should normally not happen, but sometimes, heat diffusion leads to this
+ zfmdt = - zdeltah(ji,jk) * rhoic ! Mass flux x time step > 0
+
+ dh_i_surf(ji) = dh_i_surf(ji) + zdeltah(ji,jk) ! Cumulate surface melt
+
+ zfmdt = - rhoic * zdeltah(ji,jk) ! Recompute mass flux [kg/m2, >0]
+
+ ! Contribution to heat flux to the ocean [W.m-2], <0 (ice enthalpy zEi is "sent" to the ocean)
+ hfx_res_1d(ji) = hfx_res_1d(ji) + zfmdt * a_i_1d(ji) * zEi * r1_rdtice
+
+ ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok)
+ sfx_res_1d(ji) = sfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice
+
+ ! Contribution to mass flux
+ wfx_res_1d(ji) = wfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
+
+ ELSE !!! Surface melting
+
+ zEi = - q_i_1d(ji,jk) * r1_rhoic ! Specific enthalpy of layer k [J/kg, <0]
+ zEw = rcp * ( ztmelts - rt0 ) ! Specific enthalpy of resulting meltwater [J/kg, <0]
+ zdE = zEi - zEw ! Specific enthalpy difference < 0
+
+ zfmdt = - zq_su(ji) / zdE ! Mass flux to the ocean [kg/m2, >0]
+
+ zdeltah(ji,jk) = - zfmdt * r1_rhoic ! Melt of layer jk [m, <0]
+
+ zdeltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk) , - zh_i(ji,jk) ) ) ! Melt of layer jk cannot exceed the layer thickness [m, <0]
+
+ zq_su(ji) = MAX( 0._wp , zq_su(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat
+
+ dh_i_surf(ji) = dh_i_surf(ji) + zdeltah(ji,jk) ! Cumulate surface melt
+
+ zfmdt = - rhoic * zdeltah(ji,jk) ! Recompute mass flux [kg/m2, >0]
+
+ zQm = zfmdt * zEw ! Energy of the melt water sent to the ocean [J/m2, <0]
+
+ ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok)
+ sfx_sum_1d(ji) = sfx_sum_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice
+
+ ! Contribution to heat flux [W.m-2], < 0
+ hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice
+
+ ! Total heat flux used in this process [W.m-2], > 0
+ hfx_sum_1d(ji) = hfx_sum_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice
+
+ ! Contribution to mass flux
+ wfx_sum_1d(ji) = wfx_sum_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
+
+ END IF
! record which layers have disappeared (for bottom melting)
! => icount=0 : no layer has vanished
! => icount=5 : 5 layers have vanished
- rswitch = MAX( 0._wp , SIGN( 1._wp , - ( zh_i(ji,jk) + zdeltah(ji,jk) ) ) )
- icount(ji) = icount(ji) + NINT( rswitch )
- zh_i(ji,jk) = MAX( 0._wp , zh_i(ji,jk) + zdeltah(ji,jk) )
+ rswitch = MAX( 0._wp , SIGN( 1._wp , - ( zh_i(ji,jk) + zdeltah(ji,jk) ) ) )
+ icount(ji,jk) = NINT( rswitch )
+ zh_i(ji,jk) = MAX( 0._wp , zh_i(ji,jk) + zdeltah(ji,jk) )
! update heat content (J.m-2) and layer thickness
@@ -408,14 +419,6 @@
! -> need for an iterative procedure, which converges quickly
- IF ( num_sal == 2 ) THEN
- num_iter_max = 5
- ELSE
- num_iter_max = 1
- ENDIF
-
- !clem debug. Just to be sure that enthalpy at nlay_i+1 is null
- DO ji = kideb, kiut
- q_i_1d(ji,nlay_i+1) = 0._wp
- END DO
+ num_iter_max = 1
+ IF( nn_icesal == 2 ) num_iter_max = 5
! Iterative procedure
@@ -440,11 +443,11 @@
+ ( 1. - zswitch_sal ) * sm_i_1d(ji)
! New ice growth
- ztmelts = - tmut * s_i_new(ji) + rtt ! New ice melting point (K)
+ ztmelts = - tmut * s_i_new(ji) + rt0 ! New ice melting point (K)
zt_i_new = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i)
zEi = cpic * ( zt_i_new - ztmelts ) & ! Specific enthalpy of forming ice (J/kg, <0)
- & - lfus * ( 1.0 - ( ztmelts - rtt ) / ( zt_i_new - rtt ) ) &
- & + rcp * ( ztmelts-rtt )
+ & - lfus * ( 1.0 - ( ztmelts - rt0 ) / ( zt_i_new - rt0 ) ) &
+ & + rcp * ( ztmelts-rt0 )
zEw = rcp * ( t_bo_1d(ji) - rt0 ) ! Specific enthalpy of seawater (J/kg, < 0)
@@ -456,7 +459,7 @@
q_i_1d(ji,nlay_i+1) = -zEi * rhoic ! New ice energy of melting (J/m3, >0)
- ENDIF ! fc_bo_i
- END DO ! ji
- END DO ! iter
+ ENDIF
+ END DO
+ END DO
! Contribution to Energy and Salt Fluxes
@@ -467,11 +470,11 @@
zfmdt = - rhoic * dh_i_bott(ji) ! Mass flux x time step (kg/m2, < 0)
- ztmelts = - tmut * s_i_new(ji) + rtt ! New ice melting point (K)
+ ztmelts = - tmut * s_i_new(ji) + rt0 ! New ice melting point (K)
zt_i_new = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i)
zEi = cpic * ( zt_i_new - ztmelts ) & ! Specific enthalpy of forming ice (J/kg, <0)
- & - lfus * ( 1.0 - ( ztmelts - rtt ) / ( zt_i_new - rtt ) ) &
- & + rcp * ( ztmelts-rtt )
+ & - lfus * ( 1.0 - ( ztmelts - rt0 ) / ( zt_i_new - rt0 ) ) &
+ & + rcp * ( ztmelts-rt0 )
zEw = rcp * ( t_bo_1d(ji) - rt0 ) ! Specific enthalpy of seawater (J/kg, < 0)
@@ -486,5 +489,5 @@
! Contribution to salt flux, <0
- sfx_bog_1d(ji) = sfx_bog_1d(ji) + s_i_new(ji) * a_i_1d(ji) * zfmdt * r1_rdtice
+ sfx_bog_1d(ji) = sfx_bog_1d(ji) - rhoic * a_i_1d(ji) * dh_i_bott(ji) * s_i_new(ji) * r1_rdtice
! Contribution to mass flux, <0
@@ -503,23 +506,19 @@
DO jk = nlay_i, 1, -1
DO ji = kideb, kiut
- IF( zf_tt(ji) >= 0._wp .AND. jk > icount(ji) ) THEN ! do not calculate where layer has already disappeared from surface melting
-
- ztmelts = - tmut * s_i_1d(ji,jk) + rtt ! Melting point of layer jk (K)
+ IF( zf_tt(ji) > 0._wp .AND. jk > icount(ji,jk) ) THEN ! do not calculate where layer has already disappeared by surface melting
+
+ ztmelts = - tmut * s_i_1d(ji,jk) + rt0 ! Melting point of layer jk (K)
IF( t_i_1d(ji,jk) >= ztmelts ) THEN !!! Internal melting
- zEi = - q_i_1d(ji,jk) / rhoic ! Specific enthalpy of melting ice (J/kg, <0)
-
- !!zEw = rcp * ( t_i_1d(ji,jk) - rtt ) ! Specific enthalpy of meltwater at T = t_i_1d (J/kg, <0)
-
+ zEi = - q_i_1d(ji,jk) * r1_rhoic ! Specific enthalpy of melting ice (J/kg, <0)
zdE = 0._wp ! Specific enthalpy difference (J/kg, <0)
! set up at 0 since no energy is needed to melt water...(it is already melted)
-
- zdeltah (ji,jk) = MIN( 0._wp , - zh_i(ji,jk) ) ! internal melting occurs when the internal temperature is above freezing
- ! this should normally not happen, but sometimes, heat diffusion leads to this
+ zdeltah (ji,jk) = MIN( 0._wp , - zh_i(ji,jk) ) ! internal melting occurs when the internal temperature is above freezing
+ ! this should normally not happen, but sometimes, heat diffusion leads to this
dh_i_bott (ji) = dh_i_bott(ji) + zdeltah(ji,jk)
- zfmdt = - zdeltah(ji,jk) * rhoic ! Mass flux x time step > 0
+ zfmdt = - zdeltah(ji,jk) * rhoic ! Mass flux x time step > 0
! Contribution to heat flux to the ocean [W.m-2], <0 (ice enthalpy zEi is "sent" to the ocean)
@@ -527,5 +526,5 @@
! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok)
- sfx_res_1d(ji) = sfx_res_1d(ji) - sm_i_1d(ji) * a_i_1d(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice
+ sfx_res_1d(ji) = sfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice
! Contribution to mass flux
@@ -538,35 +537,33 @@
ELSE !!! Basal melting
- zEi = - q_i_1d(ji,jk) / rhoic ! Specific enthalpy of melting ice (J/kg, <0)
-
- zEw = rcp * ( ztmelts - rtt )! Specific enthalpy of meltwater (J/kg, <0)
-
- zdE = zEi - zEw ! Specific enthalpy difference (J/kg, <0)
-
- zfmdt = - zq_bo(ji) / zdE ! Mass flux x time step (kg/m2, >0)
-
- zdeltah(ji,jk) = - zfmdt / rhoic ! Gross thickness change
-
- zdeltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk), - zh_i(ji,jk) ) ) ! bound thickness change
+ zEi = - q_i_1d(ji,jk) * r1_rhoic ! Specific enthalpy of melting ice (J/kg, <0)
+ zEw = rcp * ( ztmelts - rt0 ) ! Specific enthalpy of meltwater (J/kg, <0)
+ zdE = zEi - zEw ! Specific enthalpy difference (J/kg, <0)
+
+ zfmdt = - zq_bo(ji) / zdE ! Mass flux x time step (kg/m2, >0)
+
+ zdeltah(ji,jk) = - zfmdt * r1_rhoic ! Gross thickness change
+
+ zdeltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk), - zh_i(ji,jk) ) ) ! bound thickness change
- zq_bo(ji) = MAX( 0._wp , zq_bo(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat. MAX is necessary for roundup errors
-
- dh_i_bott(ji) = dh_i_bott(ji) + zdeltah(ji,jk) ! Update basal melt
-
- zfmdt = - zdeltah(ji,jk) * rhoic ! Mass flux x time step > 0
-
- zQm = zfmdt * zEw ! Heat exchanged with ocean
+ zq_bo(ji) = MAX( 0._wp , zq_bo(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat. MAX is necessary for roundup errors
+
+ dh_i_bott(ji) = dh_i_bott(ji) + zdeltah(ji,jk) ! Update basal melt
+
+ zfmdt = - zdeltah(ji,jk) * rhoic ! Mass flux x time step > 0
+
+ zQm = zfmdt * zEw ! Heat exchanged with ocean
! Contribution to heat flux to the ocean [W.m-2], <0
- hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice
+ hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice
! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok)
- sfx_bom_1d(ji) = sfx_bom_1d(ji) - sm_i_1d(ji) * a_i_1d(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice
+ sfx_bom_1d(ji) = sfx_bom_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice
! Total heat flux used in this process [W.m-2], >0
- hfx_bom_1d(ji) = hfx_bom_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice
+ hfx_bom_1d(ji) = hfx_bom_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice
! Contribution to mass flux
- wfx_bom_1d(ji) = wfx_bom_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
+ wfx_bom_1d(ji) = wfx_bom_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
! update heat content (J.m-2) and layer thickness
@@ -576,31 +573,6 @@
ENDIF
- END DO ! ji
- END DO ! jk
-
- !------------------------------------------------------------------------------!
- ! Excessive ablation in a 1-category model
- ! in a 1-category sea ice model, bottom ablation must not exceed hmelt (-0.15)
- !------------------------------------------------------------------------------!
- ! ??? keep ???
- ! clem bug: I think this should be included above, so we would not have to
- ! track heat/salt/mass fluxes backwards
-! IF( jpl == 1 ) THEN
-! DO ji = kideb, kiut
-! IF( zf_tt(ji) >= 0._wp ) THEN
-! zdh = MAX( hmelt , dh_i_bott(ji) )
-! zdvres = zdh - dh_i_bott(ji) ! >=0
-! dh_i_bott(ji) = zdh
-!
-! ! excessive energy is sent to lateral ablation
-! rswitch = MAX( 0._wp, SIGN( 1._wp , 1._wp - at_i_1d(ji) - epsi20 ) )
-! zq_1cat(ji) = rswitch * rhoic * lfus * at_i_1d(ji) / MAX( 1._wp - at_i_1d(ji) , epsi20 ) * zdvres ! J.m-2 >=0
-!
-! ! correct salt and mass fluxes
-! sfx_bom_1d(ji) = sfx_bom_1d(ji) - sm_i_1d(ji) * a_i_1d(ji) * zdvres * rhoic * r1_rdtice ! this is only a raw approximation
-! wfx_bom_1d(ji) = wfx_bom_1d(ji) - rhoic * a_i_1d(ji) * zdvres * r1_rdtice
-! ENDIF
-! END DO
-! ENDIF
+ END DO
+ END DO
!-------------------------------------------
@@ -619,23 +591,22 @@
DO ji = kideb, kiut
zq_rema(ji) = zq_su(ji) + zq_bo(ji)
-! zindh = 1._wp - MAX( 0._wp, SIGN( 1._wp, - ht_s_1d(ji) ) ) ! =1 if snow
-! zindq = 1._wp - MAX( 0._wp, SIGN( 1._wp, - zq_s(ji) + epsi20 ) )
-! zdeltah (ji,1) = - zindh * zindq * zq_rema(ji) / MAX( zq_s(ji), epsi20 )
-! zdeltah (ji,1) = MIN( 0._wp , MAX( zdeltah(ji,1) , - ht_s_1d(ji) ) ) ! bound melting
-! zdh_s_mel(ji) = zdh_s_mel(ji) + zdeltah(ji,1)
-! dh_s_tot (ji) = dh_s_tot(ji) + zdeltah(ji,1)
-! ht_s_1d (ji) = ht_s_1d(ji) + zdeltah(ji,1)
-!
-! zq_rema(ji) = zq_rema(ji) + zdeltah(ji,1) * zq_s(ji) ! update available heat (J.m-2)
-! ! heat used to melt snow
-! hfx_snw_1d(ji) = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_1d(ji) * zq_s(ji) * r1_rdtice ! W.m-2 (>0)
-! ! Contribution to mass flux
-! wfx_snw_1d(ji) = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice
-!
+ rswitch = 1._wp - MAX( 0._wp, SIGN( 1._wp, - ht_s_1d(ji) ) ) ! =1 if snow
+ rswitch = rswitch * MAX( 0._wp, SIGN( 1._wp, q_s_1d(ji,1) - epsi20 ) )
+ zdeltah (ji,1) = - rswitch * zq_rema(ji) / MAX( q_s_1d(ji,1), epsi20 )
+ zdeltah (ji,1) = MIN( 0._wp , MAX( zdeltah(ji,1) , - ht_s_1d(ji) ) ) ! bound melting
+ dh_s_tot (ji) = dh_s_tot(ji) + zdeltah(ji,1)
+ ht_s_1d (ji) = ht_s_1d(ji) + zdeltah(ji,1)
+
+ zq_rema(ji) = zq_rema(ji) + zdeltah(ji,1) * q_s_1d(ji,1) ! update available heat (J.m-2)
+ ! heat used to melt snow
+ hfx_snw_1d(ji) = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_1d(ji) * q_s_1d(ji,1) * r1_rdtice ! W.m-2 (>0)
+ ! Contribution to mass flux
+ wfx_snw_1d(ji) = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice
+ !
ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1
! Remaining heat flux (W.m-2) is sent to the ocean heat budget
- hfx_out(ii,ij) = hfx_out(ii,ij) + ( zq_1cat(ji) + zq_rema(ji) * a_i_1d(ji) ) * r1_rdtice
-
- IF( ln_nicep .AND. zq_rema(ji) < 0. .AND. lwp ) WRITE(numout,*) 'ALERTE zq_rema <0 = ', zq_rema(ji)
+ hfx_out(ii,ij) = hfx_out(ii,ij) + ( zq_rema(ji) * a_i_1d(ji) ) * r1_rdtice
+
+ IF( ln_icectl .AND. zq_rema(ji) < 0. .AND. lwp ) WRITE(numout,*) 'ALERTE zq_rema <0 = ', zq_rema(ji)
END DO
@@ -650,20 +621,20 @@
dh_snowice(ji) = MAX( 0._wp , ( rhosn * ht_s_1d(ji) + (rhoic-rau0) * ht_i_1d(ji) ) / ( rhosn+rau0-rhoic ) )
- ht_i_1d(ji) = ht_i_1d(ji) + dh_snowice(ji)
- ht_s_1d(ji) = ht_s_1d(ji) - dh_snowice(ji)
+ ht_i_1d(ji) = ht_i_1d(ji) + dh_snowice(ji)
+ ht_s_1d(ji) = ht_s_1d(ji) - dh_snowice(ji)
! Salinity of snow ice
ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1
- zs_snic = zswitch_sal * sss_m(ii,ij) * ( rhoic - rhosn ) / rhoic + ( 1. - zswitch_sal ) * sm_i_1d(ji)
+ zs_snic = zswitch_sal * sss_m(ii,ij) * ( rhoic - rhosn ) * r1_rhoic + ( 1. - zswitch_sal ) * sm_i_1d(ji)
! entrapment during snow ice formation
- ! new salinity difference stored (to be used in limthd_ent.F90)
- IF ( num_sal == 2 ) THEN
- rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i_1d(ji) - epsi10 ) )
+ ! new salinity difference stored (to be used in limthd_sal.F90)
+ IF ( nn_icesal == 2 ) THEN
+ rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i_1d(ji) - epsi20 ) )
! salinity dif due to snow-ice formation
- dsm_i_si_1d(ji) = ( zs_snic - sm_i_1d(ji) ) * dh_snowice(ji) / MAX( ht_i_1d(ji), epsi10 ) * rswitch
+ dsm_i_si_1d(ji) = ( zs_snic - sm_i_1d(ji) ) * dh_snowice(ji) / MAX( ht_i_1d(ji), epsi20 ) * rswitch
! salinity dif due to bottom growth
IF ( zf_tt(ji) < 0._wp ) THEN
- dsm_i_se_1d(ji) = ( s_i_new(ji) - sm_i_1d(ji) ) * dh_i_bott(ji) / MAX( ht_i_1d(ji), epsi10 ) * rswitch
+ dsm_i_se_1d(ji) = ( s_i_new(ji) - sm_i_1d(ji) ) * dh_i_bott(ji) / MAX( ht_i_1d(ji), epsi20 ) * rswitch
ENDIF
ENDIF
@@ -691,8 +662,5 @@
h_i_old (ji,0) = h_i_old (ji,0) + dh_snowice(ji)
- ! Total ablation (to debug)
- IF( ht_i_1d(ji) <= 0._wp ) a_i_1d(ji) = 0._wp
-
- END DO !ji
+ END DO
!
@@ -700,27 +668,47 @@
! Update temperature, energy
!-------------------------------------------
- !clem bug: we should take snow into account here
DO ji = kideb, kiut
rswitch = 1.0 - MAX( 0._wp , SIGN( 1._wp , - ht_i_1d(ji) ) )
- t_su_1d(ji) = rswitch * t_su_1d(ji) + ( 1.0 - rswitch ) * rtt
- END DO ! ji
+ t_su_1d(ji) = rswitch * t_su_1d(ji) + ( 1.0 - rswitch ) * rt0
+ END DO
DO jk = 1, nlay_s
DO ji = kideb,kiut
! mask enthalpy
- rswitch = MAX( 0._wp , SIGN( 1._wp, - ht_s_1d(ji) ) )
- q_s_1d(ji,jk) = ( 1.0 - rswitch ) * q_s_1d(ji,jk)
+ rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp, - ht_s_1d(ji) ) )
+ q_s_1d(ji,jk) = rswitch * q_s_1d(ji,jk)
! recalculate t_s_1d from q_s_1d
- t_s_1d(ji,jk) = rtt + ( 1._wp - rswitch ) * ( - q_s_1d(ji,jk) / ( rhosn * cpic ) + lfus / cpic )
+ t_s_1d(ji,jk) = rt0 + rswitch * ( - q_s_1d(ji,jk) / ( rhosn * cpic ) + lfus / cpic )
END DO
END DO
- CALL wrk_dealloc( jpij, zh_s, zqprec, zq_su, zq_bo, zf_tt, zq_1cat, zq_rema )
+ ! --- ensure that a_i = 0 where ht_i = 0 ---
+ WHERE( ht_i_1d == 0._wp ) a_i_1d = 0._wp
+
+ CALL wrk_dealloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw )
CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s )
- CALL wrk_dealloc( jpij, nlay_i+1, zdeltah, zh_i )
- CALL wrk_dealloc( jpij, icount )
+ CALL wrk_dealloc( jpij, nlay_i, zdeltah, zh_i )
+ CALL wrk_dealloc( jpij, nlay_i, icount )
!
!
END SUBROUTINE lim_thd_dh
+
+
+ !!--------------------------------------------------------------------------
+ !! INTERFACE lim_thd_snwblow
+ !! ** Purpose : Compute distribution of precip over the ice
+ !!--------------------------------------------------------------------------
+ SUBROUTINE lim_thd_snwblow_2d( pin, pout )
+ REAL(wp), DIMENSION(:,:), INTENT(in ) :: pin ! previous fraction lead ( pfrld or (1. - a_i_b) )
+ REAL(wp), DIMENSION(:,:), INTENT(inout) :: pout
+ pout = ( 1._wp - ( pin )**rn_betas )
+ END SUBROUTINE lim_thd_snwblow_2d
+
+ SUBROUTINE lim_thd_snwblow_1d( pin, pout )
+ REAL(wp), DIMENSION(:), INTENT(in ) :: pin
+ REAL(wp), DIMENSION(:), INTENT(inout) :: pout
+ pout = ( 1._wp - ( pin )**rn_betas )
+ END SUBROUTINE lim_thd_snwblow_1d
+
#else
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90 (revision 5602)
@@ -19,5 +19,4 @@
USE phycst ! physical constants (ocean directory)
USE ice ! LIM-3 variables
- USE par_ice ! LIM-3 parameters
USE thd_ice ! LIM-3: thermodynamics
USE in_out_manager ! I/O manager
@@ -25,5 +24,4 @@
USE wrk_nemo ! work arrays
USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
- USE sbc_oce, ONLY : lk_cpl
IMPLICIT NONE
@@ -100,7 +98,8 @@
INTEGER :: nconv ! number of iterations in iterative procedure
INTEGER :: minnumeqmin, maxnumeqmax
+
INTEGER, POINTER, DIMENSION(:) :: numeqmin ! reference number of top equation
INTEGER, POINTER, DIMENSION(:) :: numeqmax ! reference number of bottom equation
- INTEGER, POINTER, DIMENSION(:) :: isnow ! switch for presence (1) or absence (0) of snow
+
REAL(wp) :: zg1s = 2._wp ! for the tridiagonal system
REAL(wp) :: zg1 = 2._wp !
@@ -112,47 +111,66 @@
REAL(wp) :: ztmelt_i ! ice melting temperature
REAL(wp) :: zerritmax ! current maximal error on temperature
- REAL(wp), POINTER, DIMENSION(:) :: ztfs ! ice melting point
- REAL(wp), POINTER, DIMENSION(:) :: ztsub ! old surface temperature (before the iterative procedure )
- REAL(wp), POINTER, DIMENSION(:) :: ztsubit ! surface temperature at previous iteration
- REAL(wp), POINTER, DIMENSION(:) :: zh_i ! ice layer thickness
- REAL(wp), POINTER, DIMENSION(:) :: zh_s ! snow layer thickness
- REAL(wp), POINTER, DIMENSION(:) :: zfsw ! solar radiation absorbed at the surface
- REAL(wp), POINTER, DIMENSION(:) :: zf ! surface flux function
- REAL(wp), POINTER, DIMENSION(:) :: dzf ! derivative of the surface flux function
- REAL(wp), POINTER, DIMENSION(:) :: zerrit ! current error on temperature
- REAL(wp), POINTER, DIMENSION(:) :: zdifcase ! case of the equation resolution (1->4)
- REAL(wp), POINTER, DIMENSION(:) :: zftrice ! solar radiation transmitted through the ice
- REAL(wp), POINTER, DIMENSION(:) :: zihic, zhsu
- REAL(wp), POINTER, DIMENSION(:,:) :: ztcond_i ! Ice thermal conductivity
- REAL(wp), POINTER, DIMENSION(:,:) :: zradtr_i ! Radiation transmitted through the ice
- REAL(wp), POINTER, DIMENSION(:,:) :: zradab_i ! Radiation absorbed in the ice
- REAL(wp), POINTER, DIMENSION(:,:) :: zkappa_i ! Kappa factor in the ice
- REAL(wp), POINTER, DIMENSION(:,:) :: ztib ! Old temperature in the ice
- REAL(wp), POINTER, DIMENSION(:,:) :: zeta_i ! Eta factor in the ice
- REAL(wp), POINTER, DIMENSION(:,:) :: ztitemp ! Temporary temperature in the ice to check the convergence
- REAL(wp), POINTER, DIMENSION(:,:) :: zspeche_i ! Ice specific heat
- REAL(wp), POINTER, DIMENSION(:,:) :: z_i ! Vertical cotes of the layers in the ice
- REAL(wp), POINTER, DIMENSION(:,:) :: zradtr_s ! Radiation transmited through the snow
- REAL(wp), POINTER, DIMENSION(:,:) :: zradab_s ! Radiation absorbed in the snow
- REAL(wp), POINTER, DIMENSION(:,:) :: zkappa_s ! Kappa factor in the snow
- REAL(wp), POINTER, DIMENSION(:,:) :: zeta_s ! Eta factor in the snow
- REAL(wp), POINTER, DIMENSION(:,:) :: ztstemp ! Temporary temperature in the snow to check the convergence
- REAL(wp), POINTER, DIMENSION(:,:) :: ztsb ! Temporary temperature in the snow
- REAL(wp), POINTER, DIMENSION(:,:) :: z_s ! Vertical cotes of the layers in the snow
- REAL(wp), POINTER, DIMENSION(:,:) :: zswiterm ! Independent term
- REAL(wp), POINTER, DIMENSION(:,:) :: zswitbis ! temporary independent term
- REAL(wp), POINTER, DIMENSION(:,:) :: zdiagbis
- REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrid ! tridiagonal system terms
+ REAL(wp) :: zhsu
+
+ REAL(wp), POINTER, DIMENSION(:) :: isnow ! switch for presence (1) or absence (0) of snow
+ REAL(wp), POINTER, DIMENSION(:) :: ztsub ! old surface temperature (before the iterative procedure )
+ REAL(wp), POINTER, DIMENSION(:) :: ztsubit ! surface temperature at previous iteration
+ REAL(wp), POINTER, DIMENSION(:) :: zh_i ! ice layer thickness
+ REAL(wp), POINTER, DIMENSION(:) :: zh_s ! snow layer thickness
+ REAL(wp), POINTER, DIMENSION(:) :: zfsw ! solar radiation absorbed at the surface
+ REAL(wp), POINTER, DIMENSION(:) :: zqns_ice_b ! solar radiation absorbed at the surface
+ REAL(wp), POINTER, DIMENSION(:) :: zf ! surface flux function
+ REAL(wp), POINTER, DIMENSION(:) :: dzf ! derivative of the surface flux function
+ REAL(wp), POINTER, DIMENSION(:) :: zerrit ! current error on temperature
+ REAL(wp), POINTER, DIMENSION(:) :: zdifcase ! case of the equation resolution (1->4)
+ REAL(wp), POINTER, DIMENSION(:) :: zftrice ! solar radiation transmitted through the ice
+ REAL(wp), POINTER, DIMENSION(:) :: zihic
+
+ REAL(wp), POINTER, DIMENSION(:,:) :: ztcond_i ! Ice thermal conductivity
+ REAL(wp), POINTER, DIMENSION(:,:) :: zradtr_i ! Radiation transmitted through the ice
+ REAL(wp), POINTER, DIMENSION(:,:) :: zradab_i ! Radiation absorbed in the ice
+ REAL(wp), POINTER, DIMENSION(:,:) :: zkappa_i ! Kappa factor in the ice
+ REAL(wp), POINTER, DIMENSION(:,:) :: ztib ! Old temperature in the ice
+ REAL(wp), POINTER, DIMENSION(:,:) :: zeta_i ! Eta factor in the ice
+ REAL(wp), POINTER, DIMENSION(:,:) :: ztitemp ! Temporary temperature in the ice to check the convergence
+ REAL(wp), POINTER, DIMENSION(:,:) :: zspeche_i ! Ice specific heat
+ REAL(wp), POINTER, DIMENSION(:,:) :: z_i ! Vertical cotes of the layers in the ice
+ REAL(wp), POINTER, DIMENSION(:,:) :: zradtr_s ! Radiation transmited through the snow
+ REAL(wp), POINTER, DIMENSION(:,:) :: zradab_s ! Radiation absorbed in the snow
+ REAL(wp), POINTER, DIMENSION(:,:) :: zkappa_s ! Kappa factor in the snow
+ REAL(wp), POINTER, DIMENSION(:,:) :: zeta_s ! Eta factor in the snow
+ REAL(wp), POINTER, DIMENSION(:,:) :: ztstemp ! Temporary temperature in the snow to check the convergence
+ REAL(wp), POINTER, DIMENSION(:,:) :: ztsb ! Temporary temperature in the snow
+ REAL(wp), POINTER, DIMENSION(:,:) :: z_s ! Vertical cotes of the layers in the snow
+ REAL(wp), POINTER, DIMENSION(:,:) :: zindterm ! 'Ind'ependent term
+ REAL(wp), POINTER, DIMENSION(:,:) :: zindtbis ! Temporary 'ind'ependent term
+ REAL(wp), POINTER, DIMENSION(:,:) :: zdiagbis ! Temporary 'dia'gonal term
+ REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrid ! Tridiagonal system terms
+
! diag errors on heat
- REAL(wp), POINTER, DIMENSION(:) :: zdq, zq_ini, zhfx_err
+ REAL(wp), POINTER, DIMENSION(:) :: zdq, zq_ini, zhfx_err
+
+ ! Mono-category
+ REAL(wp) :: zepsilon ! determines thres. above which computation of G(h) is done
+ REAL(wp) :: zratio_s ! dummy factor
+ REAL(wp) :: zratio_i ! dummy factor
+ REAL(wp) :: zh_thres ! thickness thres. for G(h) computation
+ REAL(wp) :: zhe ! dummy factor
+ REAL(wp) :: zkimean ! mean sea ice thermal conductivity
+ REAL(wp) :: zfac ! dummy factor
+ REAL(wp) :: zihe ! dummy factor
+ REAL(wp) :: zheshth ! dummy factor
+
+ REAL(wp), POINTER, DIMENSION(:) :: zghe ! G(he), th. conduct enhancement factor, mono-cat
+
!!------------------------------------------------------------------
!
- CALL wrk_alloc( jpij, numeqmin, numeqmax, isnow )
- CALL wrk_alloc( jpij, ztfs, ztsub, ztsubit, zh_i, zh_s, zfsw )
- CALL wrk_alloc( jpij, zf, dzf, zerrit, zdifcase, zftrice, zihic, zhsu )
- CALL wrk_alloc( jpij, nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart=0)
- CALL wrk_alloc( jpij, nlay_s+1, zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart=0)
- CALL wrk_alloc( jpij, nlay_i+3, zswiterm, zswitbis, zdiagbis )
- CALL wrk_alloc( jpij, nlay_i+3, 3, ztrid )
+ CALL wrk_alloc( jpij, numeqmin, numeqmax )
+ CALL wrk_alloc( jpij, isnow, ztsub, ztsubit, zh_i, zh_s, zfsw )
+ CALL wrk_alloc( jpij, zf, dzf, zqns_ice_b, zerrit, zdifcase, zftrice, zihic, zghe )
+ CALL wrk_alloc( jpij,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart=0 )
+ CALL wrk_alloc( jpij,nlay_s+1, zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart=0 )
+ CALL wrk_alloc( jpij,nlay_i+3, zindterm, zindtbis, zdiagbis )
+ CALL wrk_alloc( jpij,nlay_i+3,3, ztrid )
CALL wrk_alloc( jpij, zdq, zq_ini, zhfx_err )
@@ -161,6 +179,6 @@
zdq(:) = 0._wp ; zq_ini(:) = 0._wp
DO ji = kideb, kiut
- zq_ini(ji) = ( SUM( q_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) / REAL( nlay_i ) + &
- & SUM( q_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) / REAL( nlay_s ) )
+ zq_ini(ji) = ( SUM( q_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) * r1_nlay_i + &
+ & SUM( q_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) * r1_nlay_s )
END DO
@@ -168,13 +186,9 @@
! 1) Initialization !
!------------------------------------------------------------------------------!
- ! clem clean: replace just ztfs by rtt
DO ji = kideb , kiut
- ! is there snow or not
- isnow(ji)= NINT( 1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_1d(ji) ) ) )
- ! surface temperature of fusion
- ztfs(ji) = REAL( isnow(ji) ) * rtt + REAL( 1 - isnow(ji) ) * rtt
+ isnow(ji)= 1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_1d(ji) ) ) ! is there snow or not
! layer thickness
- zh_i(ji) = ht_i_1d(ji) / REAL( nlay_i )
- zh_s(ji) = ht_s_1d(ji) / REAL( nlay_s )
+ zh_i(ji) = ht_i_1d(ji) * r1_nlay_i
+ zh_s(ji) = ht_s_1d(ji) * r1_nlay_s
END DO
@@ -188,5 +202,5 @@
DO jk = 1, nlay_s ! vert. coord of the up. lim. of the layer-th snow layer
DO ji = kideb , kiut
- z_s(ji,jk) = z_s(ji,jk-1) + ht_s_1d(ji) / REAL( nlay_s )
+ z_s(ji,jk) = z_s(ji,jk-1) + ht_s_1d(ji) * r1_nlay_s
END DO
END DO
@@ -194,10 +208,10 @@
DO jk = 1, nlay_i ! vert. coord of the up. lim. of the layer-th ice layer
DO ji = kideb , kiut
- z_i(ji,jk) = z_i(ji,jk-1) + ht_i_1d(ji) / REAL( nlay_i )
+ z_i(ji,jk) = z_i(ji,jk-1) + ht_i_1d(ji) * r1_nlay_i
END DO
END DO
!
!------------------------------------------------------------------------------|
- ! 2) Radiations |
+ ! 2) Radiation |
!------------------------------------------------------------------------------|
!
@@ -212,19 +226,13 @@
! zftrice = io.qsr_ice is below the surface
! ftr_ice = io.qsr_ice.exp(-k(h_i)) transmitted below the ice
-
+ ! fr1_i0_1d = i0 for a thin ice cover, fr1_i0_2d = i0 for a thick ice cover
+ zhsu = 0.1_wp ! threshold for the computation of i0
DO ji = kideb , kiut
! switches
- isnow(ji) = NINT( 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_1d(ji) ) ) )
+ isnow(ji) = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_1d(ji) ) )
! hs > 0, isnow = 1
- zhsu (ji) = hnzst ! threshold for the computation of i0
- zihic(ji) = MAX( 0._wp , 1._wp - ( ht_i_1d(ji) / zhsu(ji) ) )
-
- i0(ji) = REAL( 1 - isnow(ji) ) * ( fr1_i0_1d(ji) + zihic(ji) * fr2_i0_1d(ji) )
- !fr1_i0_1d = i0 for a thin ice surface
- !fr1_i0_2d = i0 for a thick ice surface
- ! a function of the cloud cover
- !
- !i0(ji) = (1.0-FLOAT(isnow(ji)))*3.0/(100*ht_s_1d(ji)+10.0)
- !formula used in Cice
+ zihic(ji) = MAX( 0._wp , 1._wp - ( ht_i_1d(ji) / zhsu ) )
+
+ i0(ji) = ( 1._wp - isnow(ji) ) * ( fr1_i0_1d(ji) + zihic(ji) * fr2_i0_1d(ji) )
END DO
@@ -234,7 +242,8 @@
!-------------------------------------------------------
DO ji = kideb , kiut
- zfsw (ji) = qsr_ice_1d(ji) * ( 1 - i0(ji) ) ! Shortwave radiation absorbed at surface
- zftrice(ji) = qsr_ice_1d(ji) * i0(ji) ! Solar radiation transmitted below the surface layer
- dzf (ji) = dqns_ice_1d(ji) ! derivative of incoming nonsolar flux
+ zfsw (ji) = qsr_ice_1d(ji) * ( 1 - i0(ji) ) ! Shortwave radiation absorbed at surface
+ zftrice(ji) = qsr_ice_1d(ji) * i0(ji) ! Solar radiation transmitted below the surface layer
+ dzf (ji) = dqns_ice_1d(ji) ! derivative of incoming nonsolar flux
+ zqns_ice_b(ji) = qns_ice_1d(ji) ! store previous qns_ice_1d value
END DO
@@ -257,5 +266,5 @@
DO ji = kideb, kiut ! ice initialization
- zradtr_i(ji,0) = zradtr_s(ji,nlay_s) * REAL( isnow(ji) ) + zftrice(ji) * REAL( 1 - isnow(ji) )
+ zradtr_i(ji,0) = zradtr_s(ji,nlay_s) * isnow(ji) + zftrice(ji) * ( 1._wp - isnow(ji) )
END DO
@@ -263,5 +272,5 @@
DO ji = kideb, kiut
! ! radiation transmitted below the layer-th ice layer
- zradtr_i(ji,jk) = zradtr_i(ji,0) * EXP( - kappa_i * ( MAX ( 0._wp , z_i(ji,jk) ) ) )
+ zradtr_i(ji,jk) = zradtr_i(ji,0) * EXP( - rn_kappa_i * ( MAX ( 0._wp , z_i(ji,jk) ) ) )
! ! radiation absorbed by the layer-th ice layer
zradab_i(ji,jk) = zradtr_i(ji,jk-1) - zradtr_i(ji,jk)
@@ -273,5 +282,4 @@
END DO
- !
!------------------------------------------------------------------------------|
! 3) Iterative procedure begins |
@@ -281,6 +289,6 @@
ztsub (ji) = t_su_1d(ji) ! temperature at the beg of iter pr.
ztsubit(ji) = t_su_1d(ji) ! temperature at the previous iter
- t_su_1d (ji) = MIN( t_su_1d(ji), ztfs(ji) - ztsu_err ) ! necessary
- zerrit (ji) = 1000._wp ! initial value of error
+ t_su_1d(ji) = MIN( t_su_1d(ji), rt0 - ztsu_err ) ! necessary
+ zerrit (ji) = 1000._wp ! initial value of error
END DO
@@ -300,5 +308,5 @@
zerritmax = 1000._wp ! maximal value of error on all points
- DO WHILE ( zerritmax > maxer_i_thd .AND. nconv < nconv_i_thd )
+ DO WHILE ( zerritmax > rn_terr_dif .AND. nconv < nn_conv_dif )
!
nconv = nconv + 1
@@ -308,78 +316,118 @@
!------------------------------------------------------------------------------|
!
- IF( thcon_i_swi == 0 ) THEN ! Untersteiner (1964) formula
- DO ji = kideb , kiut
- ztcond_i(ji,0) = rcdic + zbeta*s_i_1d(ji,1) / MIN(-epsi10,t_i_1d(ji,1)-rtt)
- ztcond_i(ji,0) = MAX(ztcond_i(ji,0),zkimin)
+ IF( nn_ice_thcon == 0 ) THEN ! Untersteiner (1964) formula
+ DO ji = kideb , kiut
+ ztcond_i(ji,0) = rcdic + zbeta * s_i_1d(ji,1) / MIN( -epsi10, t_i_1d(ji,1) - rt0 )
+ ztcond_i(ji,0) = MAX( ztcond_i(ji,0), zkimin )
END DO
DO jk = 1, nlay_i-1
DO ji = kideb , kiut
- ztcond_i(ji,jk) = rcdic + zbeta*( s_i_1d(ji,jk) + s_i_1d(ji,jk+1) ) / &
- MIN(-2.0_wp * epsi10, t_i_1d(ji,jk)+t_i_1d(ji,jk+1) - 2.0_wp * rtt)
- ztcond_i(ji,jk) = MAX(ztcond_i(ji,jk),zkimin)
+ ztcond_i(ji,jk) = rcdic + zbeta * ( s_i_1d(ji,jk) + s_i_1d(ji,jk+1) ) / &
+ MIN(-2.0_wp * epsi10, t_i_1d(ji,jk) + t_i_1d(ji,jk+1) - 2.0_wp * rt0)
+ ztcond_i(ji,jk) = MAX( ztcond_i(ji,jk), zkimin )
END DO
END DO
ENDIF
- IF( thcon_i_swi == 1 ) THEN ! Pringle et al formula included: 2.11 + 0.09 S/T - 0.011.T
- DO ji = kideb , kiut
- ztcond_i(ji,0) = rcdic + 0.090_wp * s_i_1d(ji,1) / MIN( -epsi10, t_i_1d(ji,1)-rtt ) &
- & - 0.011_wp * ( t_i_1d(ji,1) - rtt )
+ IF( nn_ice_thcon == 1 ) THEN ! Pringle et al formula included: 2.11 + 0.09 S/T - 0.011.T
+ DO ji = kideb , kiut
+ ztcond_i(ji,0) = rcdic + 0.090_wp * s_i_1d(ji,1) / MIN( -epsi10, t_i_1d(ji,1) - rt0 ) &
+ & - 0.011_wp * ( t_i_1d(ji,1) - rt0 )
ztcond_i(ji,0) = MAX( ztcond_i(ji,0), zkimin )
END DO
DO jk = 1, nlay_i-1
DO ji = kideb , kiut
- ztcond_i(ji,jk) = rcdic + &
- & 0.090_wp * ( s_i_1d(ji,jk) + s_i_1d(ji,jk+1) ) &
- & / MIN(-2.0_wp * epsi10, t_i_1d(ji,jk)+t_i_1d(ji,jk+1) - 2.0_wp * rtt) &
- & - 0.0055_wp* ( t_i_1d(ji,jk) + t_i_1d(ji,jk+1) - 2.0*rtt )
+ ztcond_i(ji,jk) = rcdic + &
+ & 0.09_wp * ( s_i_1d(ji,jk) + s_i_1d(ji,jk+1) ) &
+ & / MIN( -2._wp * epsi10, t_i_1d(ji,jk) + t_i_1d(ji,jk+1) - 2.0_wp * rt0 ) &
+ & - 0.0055_wp * ( t_i_1d(ji,jk) + t_i_1d(ji,jk+1) - 2.0 * rt0 )
ztcond_i(ji,jk) = MAX( ztcond_i(ji,jk), zkimin )
END DO
END DO
DO ji = kideb , kiut
- ztcond_i(ji,nlay_i) = rcdic + 0.090_wp * s_i_1d(ji,nlay_i) / MIN(-epsi10,t_bo_1d(ji)-rtt) &
- & - 0.011_wp * ( t_bo_1d(ji) - rtt )
+ ztcond_i(ji,nlay_i) = rcdic + 0.090_wp * s_i_1d(ji,nlay_i) / MIN( -epsi10, t_bo_1d(ji) - rt0 ) &
+ & - 0.011_wp * ( t_bo_1d(ji) - rt0 )
ztcond_i(ji,nlay_i) = MAX( ztcond_i(ji,nlay_i), zkimin )
END DO
ENDIF
- !
- !------------------------------------------------------------------------------|
- ! 5) kappa factors |
- !------------------------------------------------------------------------------|
- !
+
+ !
+ !------------------------------------------------------------------------------|
+ ! 5) G(he) - enhancement of thermal conductivity in mono-category case |
+ !------------------------------------------------------------------------------|
+ !
+ ! Computation of effective thermal conductivity G(h)
+ ! Used in mono-category case only to simulate an ITD implicitly
+ ! Fichefet and Morales Maqueda, JGR 1997
+
+ zghe(:) = 1._wp
+
+ SELECT CASE ( nn_monocat )
+
+ CASE (1,3) ! LIM3
+
+ zepsilon = 0.1_wp
+ zh_thres = EXP( 1._wp ) * zepsilon * 0.5_wp
+
+ DO ji = kideb, kiut
+
+ ! Mean sea ice thermal conductivity
+ zkimean = SUM( ztcond_i(ji,0:nlay_i) ) / REAL( nlay_i+1, wp )
+
+ ! Effective thickness he (zhe)
+ zfac = 1._wp / ( rcdsn + zkimean )
+ zratio_s = rcdsn * zfac
+ zratio_i = zkimean * zfac
+ zhe = zratio_s * ht_i_1d(ji) + zratio_i * ht_s_1d(ji)
+
+ ! G(he)
+ rswitch = MAX( 0._wp , SIGN( 1._wp , zhe - zh_thres ) ) ! =0 if zhe < zh_thres, if >
+ zghe(ji) = ( 1._wp - rswitch ) + rswitch * 0.5_wp * ( 1._wp + LOG( 2._wp * zhe / zepsilon ) )
+
+ ! Impose G(he) < 2.
+ zghe(ji) = MIN( zghe(ji), 2._wp )
+
+ END DO
+
+ END SELECT
+
+ !
+ !------------------------------------------------------------------------------|
+ ! 6) kappa factors |
+ !------------------------------------------------------------------------------|
+ !
+ !--- Snow
DO ji = kideb, kiut
-
- !-- Snow kappa factors
- zkappa_s(ji,0) = rcdsn / MAX(epsi10,zh_s(ji))
- zkappa_s(ji,nlay_s) = rcdsn / MAX(epsi10,zh_s(ji))
+ zfac = 1. / MAX( epsi10 , zh_s(ji) )
+ zkappa_s(ji,0) = zghe(ji) * rcdsn * zfac
+ zkappa_s(ji,nlay_s) = zghe(ji) * rcdsn * zfac
END DO
DO jk = 1, nlay_s-1
DO ji = kideb , kiut
- zkappa_s(ji,jk) = 2.0 * rcdsn / &
- MAX(epsi10,2.0*zh_s(ji))
- END DO
- END DO
-
+ zkappa_s(ji,jk) = zghe(ji) * 2.0 * rcdsn / MAX( epsi10, 2.0 * zh_s(ji) )
+ END DO
+ END DO
+
+ !--- Ice
DO jk = 1, nlay_i-1
DO ji = kideb , kiut
- !-- Ice kappa factors
- zkappa_i(ji,jk) = 2.0*ztcond_i(ji,jk)/ &
- MAX(epsi10,2.0*zh_i(ji))
- END DO
- END DO
-
- DO ji = kideb , kiut
- zkappa_i(ji,0) = ztcond_i(ji,0)/MAX(epsi10,zh_i(ji))
- zkappa_i(ji,nlay_i) = ztcond_i(ji,nlay_i) / MAX(epsi10,zh_i(ji))
- !-- Interface
- zkappa_s(ji,nlay_s) = 2.0*rcdsn*ztcond_i(ji,0)/MAX(epsi10, &
- (ztcond_i(ji,0)*zh_s(ji) + rcdsn*zh_i(ji)))
- zkappa_i(ji,0) = zkappa_s(ji,nlay_s)*REAL( isnow(ji) ) &
- + zkappa_i(ji,0)*REAL( 1 - isnow(ji) )
- END DO
- !
- !------------------------------------------------------------------------------|
- ! 6) Sea ice specific heat, eta factors |
+ zkappa_i(ji,jk) = zghe(ji) * 2.0 * ztcond_i(ji,jk) / MAX( epsi10 , 2.0 * zh_i(ji) )
+ END DO
+ END DO
+
+ !--- Snow-ice interface
+ DO ji = kideb , kiut
+ zfac = 1./ MAX( epsi10 , zh_i(ji) )
+ zkappa_i(ji,0) = zghe(ji) * ztcond_i(ji,0) * zfac
+ zkappa_i(ji,nlay_i) = zghe(ji) * ztcond_i(ji,nlay_i) * zfac
+ zkappa_s(ji,nlay_s) = zghe(ji) * zghe(ji) * 2.0 * rcdsn * ztcond_i(ji,0) / &
+ & MAX( epsi10, ( zghe(ji) * ztcond_i(ji,0) * zh_s(ji) + zghe(ji) * rcdsn * zh_i(ji) ) )
+ zkappa_i(ji,0) = zkappa_s(ji,nlay_s) * isnow(ji) + zkappa_i(ji,0) * ( 1._wp - isnow(ji) )
+ END DO
+
+ !
+ !------------------------------------------------------------------------------|
+ ! 7) Sea ice specific heat, eta factors |
!------------------------------------------------------------------------------|
!
@@ -387,8 +435,6 @@
DO ji = kideb , kiut
ztitemp(ji,jk) = t_i_1d(ji,jk)
- zspeche_i(ji,jk) = cpic + zgamma*s_i_1d(ji,jk)/ &
- MAX((t_i_1d(ji,jk)-rtt)*(ztib(ji,jk)-rtt),epsi10)
- zeta_i(ji,jk) = rdt_ice / MAX(rhoic*zspeche_i(ji,jk)*zh_i(ji), &
- epsi10)
+ zspeche_i(ji,jk) = cpic + zgamma * s_i_1d(ji,jk) / MAX( ( t_i_1d(ji,jk) - rt0 ) * ( ztib(ji,jk) - rt0 ), epsi10 )
+ zeta_i(ji,jk) = rdt_ice / MAX( rhoic * zspeche_i(ji,jk) * zh_i(ji), epsi10 )
END DO
END DO
@@ -397,13 +443,14 @@
DO ji = kideb , kiut
ztstemp(ji,jk) = t_s_1d(ji,jk)
- zeta_s(ji,jk) = rdt_ice / MAX(rhosn*cpic*zh_s(ji),epsi10)
- END DO
- END DO
- !
- !------------------------------------------------------------------------------|
- ! 7) surface flux computation |
- !------------------------------------------------------------------------------|
- !
- IF( .NOT. lk_cpl ) THEN !--- forced atmosphere case
+ zeta_s(ji,jk) = rdt_ice / MAX( rhosn * cpic * zh_s(ji), epsi10 )
+ END DO
+ END DO
+
+ !
+ !------------------------------------------------------------------------------|
+ ! 8) surface flux computation |
+ !------------------------------------------------------------------------------|
+ !
+ IF ( ln_it_qnsice ) THEN
DO ji = kideb , kiut
! update of the non solar flux according to the update in T_su
@@ -415,12 +462,11 @@
DO ji = kideb , kiut
! update incoming flux
- zf(ji) = zfsw(ji) & ! net absorbed solar radiation
- + qns_ice_1d(ji) ! non solar total flux
- ! (LWup, LWdw, SH, LH)
- END DO
-
- !
- !------------------------------------------------------------------------------|
- ! 8) tridiagonal system terms |
+ zf(ji) = zfsw(ji) & ! net absorbed solar radiation
+ & + qns_ice_1d(ji) ! non solar total flux (LWup, LWdw, SH, LH)
+ END DO
+
+ !
+ !------------------------------------------------------------------------------|
+ ! 9) tridiagonal system terms |
!------------------------------------------------------------------------------|
!
@@ -437,6 +483,6 @@
ztrid(ji,numeq,2) = 0.
ztrid(ji,numeq,3) = 0.
- zswiterm(ji,numeq)= 0.
- zswitbis(ji,numeq)= 0.
+ zindterm(ji,numeq)= 0.
+ zindtbis(ji,numeq)= 0.
zdiagbis(ji,numeq)= 0.
ENDDO
@@ -445,11 +491,9 @@
DO numeq = nlay_s + 2, nlay_s + nlay_i
DO ji = kideb , kiut
- jk = numeq - nlay_s - 1
- ztrid(ji,numeq,1) = - zeta_i(ji,jk)*zkappa_i(ji,jk-1)
- ztrid(ji,numeq,2) = 1.0 + zeta_i(ji,jk)*(zkappa_i(ji,jk-1) + &
- zkappa_i(ji,jk))
- ztrid(ji,numeq,3) = - zeta_i(ji,jk)*zkappa_i(ji,jk)
- zswiterm(ji,numeq) = ztib(ji,jk) + zeta_i(ji,jk)* &
- zradab_i(ji,jk)
+ jk = numeq - nlay_s - 1
+ ztrid(ji,numeq,1) = - zeta_i(ji,jk) * zkappa_i(ji,jk-1)
+ ztrid(ji,numeq,2) = 1.0 + zeta_i(ji,jk) * ( zkappa_i(ji,jk-1) + zkappa_i(ji,jk) )
+ ztrid(ji,numeq,3) = - zeta_i(ji,jk) * zkappa_i(ji,jk)
+ zindterm(ji,numeq) = ztib(ji,jk) + zeta_i(ji,jk) * zradab_i(ji,jk)
END DO
ENDDO
@@ -459,15 +503,13 @@
!!ice bottom term
ztrid(ji,numeq,1) = - zeta_i(ji,nlay_i)*zkappa_i(ji,nlay_i-1)
- ztrid(ji,numeq,2) = 1.0 + zeta_i(ji,nlay_i)*( zkappa_i(ji,nlay_i)*zg1 &
- + zkappa_i(ji,nlay_i-1) )
+ ztrid(ji,numeq,2) = 1.0 + zeta_i(ji,nlay_i) * ( zkappa_i(ji,nlay_i) * zg1 + zkappa_i(ji,nlay_i-1) )
ztrid(ji,numeq,3) = 0.0
- zswiterm(ji,numeq) = ztib(ji,nlay_i) + zeta_i(ji,nlay_i)* &
- ( zradab_i(ji,nlay_i) + zkappa_i(ji,nlay_i)*zg1 &
- * t_bo_1d(ji) )
+ zindterm(ji,numeq) = ztib(ji,nlay_i) + zeta_i(ji,nlay_i) * &
+ & ( zradab_i(ji,nlay_i) + zkappa_i(ji,nlay_i) * zg1 * t_bo_1d(ji) )
ENDDO
DO ji = kideb , kiut
- IF ( ht_s_1d(ji).gt.0.0 ) THEN
+ IF ( ht_s_1d(ji) > 0.0 ) THEN
!
!------------------------------------------------------------------------------|
@@ -477,11 +519,9 @@
!!snow interior terms (bottom equation has the same form as the others)
DO numeq = 3, nlay_s + 1
- jk = numeq - 1
- ztrid(ji,numeq,1) = - zeta_s(ji,jk)*zkappa_s(ji,jk-1)
- ztrid(ji,numeq,2) = 1.0 + zeta_s(ji,jk)*( zkappa_s(ji,jk-1) + &
- zkappa_s(ji,jk) )
+ jk = numeq - 1
+ ztrid(ji,numeq,1) = - zeta_s(ji,jk) * zkappa_s(ji,jk-1)
+ ztrid(ji,numeq,2) = 1.0 + zeta_s(ji,jk) * ( zkappa_s(ji,jk-1) + zkappa_s(ji,jk) )
ztrid(ji,numeq,3) = - zeta_s(ji,jk)*zkappa_s(ji,jk)
- zswiterm(ji,numeq) = ztsb(ji,jk) + zeta_s(ji,jk)* &
- zradab_s(ji,jk)
+ zindterm(ji,numeq) = ztsb(ji,jk) + zeta_s(ji,jk) * zradab_s(ji,jk)
END DO
@@ -489,9 +529,8 @@
IF ( nlay_i.eq.1 ) THEN
ztrid(ji,nlay_s+2,3) = 0.0
- zswiterm(ji,nlay_s+2) = zswiterm(ji,nlay_s+2) + zkappa_i(ji,1)* &
- t_bo_1d(ji)
+ zindterm(ji,nlay_s+2) = zindterm(ji,nlay_s+2) + zkappa_i(ji,1) * t_bo_1d(ji)
ENDIF
- IF ( t_su_1d(ji) .LT. rtt ) THEN
+ IF ( t_su_1d(ji) < rt0 ) THEN
!------------------------------------------------------------------------------|
@@ -503,14 +542,14 @@
!!surface equation
- ztrid(ji,1,1) = 0.0
- ztrid(ji,1,2) = dzf(ji) - zg1s*zkappa_s(ji,0)
- ztrid(ji,1,3) = zg1s*zkappa_s(ji,0)
- zswiterm(ji,1) = dzf(ji)*t_su_1d(ji) - zf(ji)
+ ztrid(ji,1,1) = 0.0
+ ztrid(ji,1,2) = dzf(ji) - zg1s * zkappa_s(ji,0)
+ ztrid(ji,1,3) = zg1s * zkappa_s(ji,0)
+ zindterm(ji,1) = dzf(ji) * t_su_1d(ji) - zf(ji)
!!first layer of snow equation
- ztrid(ji,2,1) = - zkappa_s(ji,0)*zg1s*zeta_s(ji,1)
- ztrid(ji,2,2) = 1.0 + zeta_s(ji,1)*(zkappa_s(ji,1) + zkappa_s(ji,0)*zg1s)
+ ztrid(ji,2,1) = - zkappa_s(ji,0) * zg1s * zeta_s(ji,1)
+ ztrid(ji,2,2) = 1.0 + zeta_s(ji,1) * ( zkappa_s(ji,1) + zkappa_s(ji,0) * zg1s )
ztrid(ji,2,3) = - zeta_s(ji,1)* zkappa_s(ji,1)
- zswiterm(ji,2) = ztsb(ji,1) + zeta_s(ji,1)*zradab_s(ji,1)
+ zindterm(ji,2) = ztsb(ji,1) + zeta_s(ji,1) * zradab_s(ji,1)
ELSE
@@ -526,10 +565,8 @@
!!first layer of snow equation
ztrid(ji,2,1) = 0.0
- ztrid(ji,2,2) = 1.0 + zeta_s(ji,1) * ( zkappa_s(ji,1) + &
- zkappa_s(ji,0) * zg1s )
+ ztrid(ji,2,2) = 1.0 + zeta_s(ji,1) * ( zkappa_s(ji,1) + zkappa_s(ji,0) * zg1s )
ztrid(ji,2,3) = - zeta_s(ji,1)*zkappa_s(ji,1)
- zswiterm(ji,2) = ztsb(ji,1) + zeta_s(ji,1) * &
- ( zradab_s(ji,1) + &
- zkappa_s(ji,0) * zg1s * t_su_1d(ji) )
+ zindterm(ji,2) = ztsb(ji,1) + zeta_s(ji,1) * &
+ & ( zradab_s(ji,1) + zkappa_s(ji,0) * zg1s * t_su_1d(ji) )
ENDIF
ELSE
@@ -539,5 +576,5 @@
!------------------------------------------------------------------------------|
!
- IF (t_su_1d(ji) .LT. rtt) THEN
+ IF ( t_su_1d(ji) < rt0 ) THEN
!
!------------------------------------------------------------------------------|
@@ -553,26 +590,24 @@
ztrid(ji,numeqmin(ji),2) = dzf(ji) - zkappa_i(ji,0)*zg1
ztrid(ji,numeqmin(ji),3) = zkappa_i(ji,0)*zg1
- zswiterm(ji,numeqmin(ji)) = dzf(ji)*t_su_1d(ji) - zf(ji)
+ zindterm(ji,numeqmin(ji)) = dzf(ji)*t_su_1d(ji) - zf(ji)
!!first layer of ice equation
ztrid(ji,numeqmin(ji)+1,1) = - zkappa_i(ji,0) * zg1 * zeta_i(ji,1)
- ztrid(ji,numeqmin(ji)+1,2) = 1.0 + zeta_i(ji,1) * ( zkappa_i(ji,1) &
- + zkappa_i(ji,0) * zg1 )
- ztrid(ji,numeqmin(ji)+1,3) = - zeta_i(ji,1)*zkappa_i(ji,1)
- zswiterm(ji,numeqmin(ji)+1)= ztib(ji,1) + zeta_i(ji,1)*zradab_i(ji,1)
+ ztrid(ji,numeqmin(ji)+1,2) = 1.0 + zeta_i(ji,1) * ( zkappa_i(ji,1) + zkappa_i(ji,0) * zg1 )
+ ztrid(ji,numeqmin(ji)+1,3) = - zeta_i(ji,1) * zkappa_i(ji,1)
+ zindterm(ji,numeqmin(ji)+1)= ztib(ji,1) + zeta_i(ji,1) * zradab_i(ji,1)
!!case of only one layer in the ice (surface & ice equations are altered)
- IF (nlay_i.eq.1) THEN
+ IF ( nlay_i == 1 ) THEN
ztrid(ji,numeqmin(ji),1) = 0.0
- ztrid(ji,numeqmin(ji),2) = dzf(ji) - zkappa_i(ji,0)*2.0
- ztrid(ji,numeqmin(ji),3) = zkappa_i(ji,0)*2.0
- ztrid(ji,numeqmin(ji)+1,1) = -zkappa_i(ji,0)*2.0*zeta_i(ji,1)
- ztrid(ji,numeqmin(ji)+1,2) = 1.0 + zeta_i(ji,1)*(zkappa_i(ji,0)*2.0 + &
- zkappa_i(ji,1))
+ ztrid(ji,numeqmin(ji),2) = dzf(ji) - zkappa_i(ji,0) * 2.0
+ ztrid(ji,numeqmin(ji),3) = zkappa_i(ji,0) * 2.0
+ ztrid(ji,numeqmin(ji)+1,1) = -zkappa_i(ji,0) * 2.0 * zeta_i(ji,1)
+ ztrid(ji,numeqmin(ji)+1,2) = 1.0 + zeta_i(ji,1) * ( zkappa_i(ji,0) * 2.0 + zkappa_i(ji,1) )
ztrid(ji,numeqmin(ji)+1,3) = 0.0
- zswiterm(ji,numeqmin(ji)+1) = ztib(ji,1) + zeta_i(ji,1)* &
- ( zradab_i(ji,1) + zkappa_i(ji,1)*t_bo_1d(ji) )
+ zindterm(ji,numeqmin(ji)+1) = ztib(ji,1) + zeta_i(ji,1) * &
+ & ( zradab_i(ji,1) + zkappa_i(ji,1) * t_bo_1d(ji) )
ENDIF
@@ -590,19 +625,16 @@
!!first layer of ice equation
ztrid(ji,numeqmin(ji),1) = 0.0
- ztrid(ji,numeqmin(ji),2) = 1.0 + zeta_i(ji,1)*(zkappa_i(ji,1) + zkappa_i(ji,0)* &
- zg1)
+ ztrid(ji,numeqmin(ji),2) = 1.0 + zeta_i(ji,1) * ( zkappa_i(ji,1) + zkappa_i(ji,0) * zg1 )
ztrid(ji,numeqmin(ji),3) = - zeta_i(ji,1) * zkappa_i(ji,1)
- zswiterm(ji,numeqmin(ji)) = ztib(ji,1) + zeta_i(ji,1)*( zradab_i(ji,1) + &
- zkappa_i(ji,0) * zg1 * t_su_1d(ji) )
+ zindterm(ji,numeqmin(ji)) = ztib(ji,1) + zeta_i(ji,1) * &
+ & ( zradab_i(ji,1) + zkappa_i(ji,0) * zg1 * t_su_1d(ji) )
!!case of only one layer in the ice (surface & ice equations are altered)
- IF (nlay_i.eq.1) THEN
+ IF ( nlay_i == 1 ) THEN
ztrid(ji,numeqmin(ji),1) = 0.0
- ztrid(ji,numeqmin(ji),2) = 1.0 + zeta_i(ji,1)*(zkappa_i(ji,0)*2.0 + &
- zkappa_i(ji,1))
+ ztrid(ji,numeqmin(ji),2) = 1.0 + zeta_i(ji,1) * ( zkappa_i(ji,0) * 2.0 + zkappa_i(ji,1) )
ztrid(ji,numeqmin(ji),3) = 0.0
- zswiterm(ji,numeqmin(ji)) = ztib(ji,1) + zeta_i(ji,1)* &
- (zradab_i(ji,1) + zkappa_i(ji,1)*t_bo_1d(ji)) &
- + t_su_1d(ji)*zeta_i(ji,1)*zkappa_i(ji,0)*2.0
+ zindterm(ji,numeqmin(ji)) = ztib(ji,1) + zeta_i(ji,1) * ( zradab_i(ji,1) + zkappa_i(ji,1) * t_bo_1d(ji) ) &
+ & + t_su_1d(ji) * zeta_i(ji,1) * zkappa_i(ji,0) * 2.0
ENDIF
@@ -614,5 +646,5 @@
!
!------------------------------------------------------------------------------|
- ! 9) tridiagonal system solving |
+ ! 10) tridiagonal system solving |
!------------------------------------------------------------------------------|
!
@@ -626,5 +658,5 @@
DO ji = kideb , kiut
- zswitbis(ji,numeqmin(ji)) = zswiterm(ji,numeqmin(ji))
+ zindtbis(ji,numeqmin(ji)) = zindterm(ji,numeqmin(ji))
zdiagbis(ji,numeqmin(ji)) = ztrid(ji,numeqmin(ji),2)
minnumeqmin = MIN(numeqmin(ji),minnumeqmin)
@@ -635,8 +667,6 @@
DO ji = kideb , kiut
numeq = min(max(numeqmin(ji)+1,jk),numeqmax(ji))
- zdiagbis(ji,numeq) = ztrid(ji,numeq,2) - ztrid(ji,numeq,1)* &
- ztrid(ji,numeq-1,3)/zdiagbis(ji,numeq-1)
- zswitbis(ji,numeq) = zswiterm(ji,numeq) - ztrid(ji,numeq,1)* &
- zswitbis(ji,numeq-1)/zdiagbis(ji,numeq-1)
+ zdiagbis(ji,numeq) = ztrid(ji,numeq,2) - ztrid(ji,numeq,1) * ztrid(ji,numeq-1,3) / zdiagbis(ji,numeq-1)
+ zindtbis(ji,numeq) = zindterm(ji,numeq) - ztrid(ji,numeq,1) * zindtbis(ji,numeq-1) / zdiagbis(ji,numeq-1)
END DO
END DO
@@ -644,12 +674,11 @@
DO ji = kideb , kiut
! ice temperatures
- t_i_1d(ji,nlay_i) = zswitbis(ji,numeqmax(ji))/zdiagbis(ji,numeqmax(ji))
- END DO
-
- DO numeq = nlay_i + nlay_s + 1, nlay_s + 2, -1
+ t_i_1d(ji,nlay_i) = zindtbis(ji,numeqmax(ji)) / zdiagbis(ji,numeqmax(ji))
+ END DO
+
+ DO numeq = nlay_i + nlay_s, nlay_s + 2, -1
DO ji = kideb , kiut
jk = numeq - nlay_s - 1
- t_i_1d(ji,jk) = (zswitbis(ji,numeq) - ztrid(ji,numeq,3)* &
- t_i_1d(ji,jk+1))/zdiagbis(ji,numeq)
+ t_i_1d(ji,jk) = ( zindtbis(ji,numeq) - ztrid(ji,numeq,3) * t_i_1d(ji,jk+1) ) / zdiagbis(ji,numeq)
END DO
END DO
@@ -657,32 +686,31 @@
DO ji = kideb , kiut
! snow temperatures
- IF (ht_s_1d(ji).GT.0._wp) &
- t_s_1d(ji,nlay_s) = (zswitbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) &
- * t_i_1d(ji,1))/zdiagbis(ji,nlay_s+1) &
- * MAX(0.0,SIGN(1.0,ht_s_1d(ji)))
+ IF (ht_s_1d(ji) > 0._wp) &
+ t_s_1d(ji,nlay_s) = ( zindtbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) * t_i_1d(ji,1) ) &
+ & / zdiagbis(ji,nlay_s+1) * MAX( 0.0, SIGN( 1.0, ht_s_1d(ji) ) )
! surface temperature
- isnow(ji) = NINT( 1.0 - MAX( 0.0 , SIGN( 1.0 , -ht_s_1d(ji) ) ) )
+ isnow(ji) = 1._wp - MAX( 0._wp , SIGN( 1._wp , -ht_s_1d(ji) ) )
ztsubit(ji) = t_su_1d(ji)
- IF( t_su_1d(ji) < ztfs(ji) ) &
- t_su_1d(ji) = ( zswitbis(ji,numeqmin(ji)) - ztrid(ji,numeqmin(ji),3)* ( REAL( isnow(ji) )*t_s_1d(ji,1) &
- & + REAL( 1 - isnow(ji) )*t_i_1d(ji,1) ) ) / zdiagbis(ji,numeqmin(ji))
+ IF( t_su_1d(ji) < rt0 ) &
+ t_su_1d(ji) = ( zindtbis(ji,numeqmin(ji)) - ztrid(ji,numeqmin(ji),3) * &
+ & ( isnow(ji) * t_s_1d(ji,1) + ( 1._wp - isnow(ji) ) * t_i_1d(ji,1) ) ) / zdiagbis(ji,numeqmin(ji))
END DO
!
!--------------------------------------------------------------------------
- ! 10) Has the scheme converged ?, end of the iterative procedure |
+ ! 11) Has the scheme converged ?, end of the iterative procedure |
!--------------------------------------------------------------------------
!
! check that nowhere it has started to melt
- ! zerrit(ji) is a measure of error, it has to be under maxer_i_thd
- DO ji = kideb , kiut
- t_su_1d(ji) = MAX( MIN( t_su_1d(ji) , ztfs(ji) ) , 190._wp )
- zerrit(ji) = ABS( t_su_1d(ji) - ztsubit(ji) )
+ ! zerrit(ji) is a measure of error, it has to be under terr_dif
+ DO ji = kideb , kiut
+ t_su_1d(ji) = MAX( MIN( t_su_1d(ji) , rt0 ) , 190._wp )
+ zerrit(ji) = ABS( t_su_1d(ji) - ztsubit(ji) )
END DO
DO jk = 1, nlay_s
DO ji = kideb , kiut
- t_s_1d(ji,jk) = MAX( MIN( t_s_1d(ji,jk), rtt ), 190._wp )
- zerrit(ji) = MAX(zerrit(ji),ABS(t_s_1d(ji,jk) - ztstemp(ji,jk)))
+ t_s_1d(ji,jk) = MAX( MIN( t_s_1d(ji,jk), rt0 ), 190._wp )
+ zerrit(ji) = MAX( zerrit(ji), ABS( t_s_1d(ji,jk) - ztstemp(ji,jk) ) )
END DO
END DO
@@ -690,7 +718,7 @@
DO jk = 1, nlay_i
DO ji = kideb , kiut
- ztmelt_i = -tmut * s_i_1d(ji,jk) + rtt
- t_i_1d(ji,jk) = MAX(MIN(t_i_1d(ji,jk),ztmelt_i), 190._wp)
- zerrit(ji) = MAX(zerrit(ji),ABS(t_i_1d(ji,jk) - ztitemp(ji,jk)))
+ ztmelt_i = -tmut * s_i_1d(ji,jk) + rt0
+ t_i_1d(ji,jk) = MAX( MIN( t_i_1d(ji,jk), ztmelt_i ), 190._wp )
+ zerrit(ji) = MAX( zerrit(ji), ABS( t_i_1d(ji,jk) - ztitemp(ji,jk) ) )
END DO
END DO
@@ -706,5 +734,5 @@
END DO ! End of the do while iterative procedure
- IF( ln_nicep .AND. lwp ) THEN
+ IF( ln_icectl .AND. lwp ) THEN
WRITE(numout,*) ' zerritmax : ', zerritmax
WRITE(numout,*) ' nconv : ', nconv
@@ -713,16 +741,39 @@
!
!-------------------------------------------------------------------------!
- ! 11) Fluxes at the interfaces !
+ ! 12) Fluxes at the interfaces !
!-------------------------------------------------------------------------!
DO ji = kideb, kiut
- ! forced mode only : update of latent heat fluxes (sublimation) (always >=0, upward flux)
- IF( .NOT. lk_cpl) qla_ice_1d (ji) = MAX( 0._wp, qla_ice_1d (ji) + dqla_ice_1d(ji) * ( t_su_1d(ji) - ztsub(ji) ) )
! ! surface ice conduction flux
- isnow(ji) = NINT( 1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_1d(ji) ) ) )
- fc_su(ji) = - REAL( isnow(ji) ) * zkappa_s(ji,0) * zg1s * (t_s_1d(ji,1) - t_su_1d(ji)) &
- & - REAL( 1 - isnow(ji) ) * zkappa_i(ji,0) * zg1 * (t_i_1d(ji,1) - t_su_1d(ji))
+ isnow(ji) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_1d(ji) ) )
+ fc_su(ji) = - isnow(ji) * zkappa_s(ji,0) * zg1s * (t_s_1d(ji,1) - t_su_1d(ji)) &
+ & - ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1 * (t_i_1d(ji,1) - t_su_1d(ji))
! ! bottom ice conduction flux
fc_bo_i(ji) = - zkappa_i(ji,nlay_i) * ( zg1*(t_bo_1d(ji) - t_i_1d(ji,nlay_i)) )
END DO
+
+ ! --- computes sea ice energy of melting compulsory for limthd_dh --- !
+ CALL lim_thd_enmelt( kideb, kiut )
+
+ ! --- diagnose the change in non-solar flux due to surface temperature change --- !
+ IF ( ln_it_qnsice ) THEN
+ DO ji = kideb, kiut
+ hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) - ( qns_ice_1d(ji) - zqns_ice_b(ji) ) * a_i_1d(ji)
+ END DO
+ END IF
+
+ ! --- diag conservation imbalance on heat diffusion - PART 2 --- !
+ DO ji = kideb, kiut
+ zdq(ji) = - zq_ini(ji) + ( SUM( q_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) * r1_nlay_i + &
+ & SUM( q_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) * r1_nlay_s )
+ IF( t_su_1d(ji) < rt0 ) THEN ! case T_su < 0degC
+ zhfx_err(ji) = qns_ice_1d(ji) + qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice
+ ELSE ! case T_su = 0degC
+ zhfx_err(ji) = fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice
+ ENDIF
+ hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err(ji) * a_i_1d(ji)
+
+ ! total heat that is sent to the ocean (i.e. not used in the heat diffusion equation)
+ hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) + zhfx_err(ji) * a_i_1d(ji)
+ END DO
!-----------------------------------------
@@ -730,55 +781,22 @@
!-----------------------------------------
DO ji = kideb, kiut
- IF( t_su_1d(ji) < rtt ) THEN ! case T_su < 0degC
+ IF( t_su_1d(ji) < rt0 ) THEN ! case T_su < 0degC
hfx_dif_1d(ji) = hfx_dif_1d(ji) + &
& ( qns_ice_1d(ji) + qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_1d(ji)
- ELSE ! case T_su = 0degC
+ ELSE ! case T_su = 0degC
hfx_dif_1d(ji) = hfx_dif_1d(ji) + &
& ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_1d(ji)
ENDIF
- END DO
-
- ! --- computes sea ice energy of melting compulsory for limthd_dh --- !
- CALL lim_thd_enmelt( kideb, kiut )
-
- ! --- diag conservation imbalance on heat diffusion - PART 2 --- !
- DO ji = kideb, kiut
- zdq(ji) = - zq_ini(ji) + ( SUM( q_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) / REAL( nlay_i ) + &
- & SUM( q_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) / REAL( nlay_s ) )
- zhfx_err(ji) = ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice )
- hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err(ji) * a_i_1d(ji)
- END DO
-
- ! diagnose external surface (forced case) or bottom (forced case) from heat conservation
- IF( .NOT. lk_cpl ) THEN ! --- forced case: qns_ice and fc_su are diagnosed
- !
- DO ji = kideb, kiut
- qns_ice_1d(ji) = qns_ice_1d(ji) - zhfx_err(ji)
- fc_su (ji) = fc_su(ji) - zhfx_err(ji)
- END DO
- !
- ELSE ! --- coupled case: ocean turbulent heat flux is diagnosed
- !
- DO ji = kideb, kiut
- fhtur_1d (ji) = fhtur_1d(ji) - zhfx_err(ji)
- END DO
- !
- ENDIF
-
- ! --- compute diagnostic net heat flux at the surface of the snow-ice system (W.m2)
- DO ji = kideb, kiut
- ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1
- hfx_in (ii,ij) = hfx_in (ii,ij) + a_i_1d(ji) * ( qsr_ice_1d(ji) + qns_ice_1d(ji) )
- END DO
-
+ ! correction on the diagnosed heat flux due to non-convergence of the algorithm used to solve heat equation
+ hfx_dif_1d(ji) = hfx_dif_1d(ji) - zhfx_err(ji) * a_i_1d(ji)
+ END DO
!
- CALL wrk_dealloc( jpij, numeqmin, numeqmax, isnow )
- CALL wrk_dealloc( jpij, ztfs, ztsub, ztsubit, zh_i, zh_s, zfsw )
- CALL wrk_dealloc( jpij, zf, dzf, zerrit, zdifcase, zftrice, zihic, zhsu )
- CALL wrk_dealloc( jpij, nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, &
- & ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart = 0 )
- CALL wrk_dealloc( jpij, nlay_s+1, zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart = 0 )
- CALL wrk_dealloc( jpij, nlay_i+3, zswiterm, zswitbis, zdiagbis )
- CALL wrk_dealloc( jpij, nlay_i+3, 3, ztrid )
+ CALL wrk_dealloc( jpij, numeqmin, numeqmax )
+ CALL wrk_dealloc( jpij, isnow, ztsub, ztsubit, zh_i, zh_s, zfsw )
+ CALL wrk_dealloc( jpij, zf, dzf, zqns_ice_b, zerrit, zdifcase, zftrice, zihic, zghe )
+ CALL wrk_dealloc( jpij,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart = 0 )
+ CALL wrk_dealloc( jpij,nlay_s+1, zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart = 0 )
+ CALL wrk_dealloc( jpij,nlay_i+3, zindterm, zindtbis, zdiagbis )
+ CALL wrk_dealloc( jpij,nlay_i+3,3, ztrid )
CALL wrk_dealloc( jpij, zdq, zq_ini, zhfx_err )
@@ -801,14 +819,15 @@
DO jk = 1, nlay_i ! Sea ice energy of melting
DO ji = kideb, kiut
- ztmelts = - tmut * s_i_1d(ji,jk) + rtt
- rswitch = MAX( 0._wp , SIGN( 1._wp , -(t_i_1d(ji,jk) - rtt) - epsi10 ) )
- q_i_1d(ji,jk) = rhoic * ( cpic * ( ztmelts - t_i_1d(ji,jk) ) &
- & + lfus * ( 1.0 - rswitch * ( ztmelts-rtt ) / MIN( t_i_1d(ji,jk)-rtt, -epsi10 ) ) &
- & - rcp * ( ztmelts-rtt ) )
+ ztmelts = - tmut * s_i_1d(ji,jk) + rt0
+ t_i_1d(ji,jk) = MIN( t_i_1d(ji,jk), ztmelts ) ! Force t_i_1d to be lower than melting point
+ ! (sometimes dif scheme produces abnormally high temperatures)
+ q_i_1d(ji,jk) = rhoic * ( cpic * ( ztmelts - t_i_1d(ji,jk) ) &
+ & + lfus * ( 1.0 - ( ztmelts-rt0 ) / ( t_i_1d(ji,jk) - rt0 ) ) &
+ & - rcp * ( ztmelts-rt0 ) )
END DO
END DO
DO jk = 1, nlay_s ! Snow energy of melting
DO ji = kideb, kiut
- q_s_1d(ji,jk) = rhosn * ( cpic * ( rtt - t_s_1d(ji,jk) ) + lfus )
+ q_s_1d(ji,jk) = rhosn * ( cpic * ( rt0 - t_s_1d(ji,jk) ) + lfus )
END DO
END DO
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90 (revision 5602)
@@ -25,5 +25,4 @@
USE sbc_oce ! Surface boundary condition: ocean fields
USE ice ! LIM variables
- USE par_ice ! LIM parameters
USE thd_ice ! LIM thermodynamics
USE limvar ! LIM variables
@@ -87,5 +86,5 @@
!--------------------------------------------------------------------------
- ! 1) Cumulative integral of old enthalpy * thicnkess and layers interfaces
+ ! 1) Cumulative integral of old enthalpy * thickness and layers interfaces
!--------------------------------------------------------------------------
zqh_cum0(:,0:nlay_i+2) = 0._wp
@@ -103,5 +102,5 @@
! new layer thickesses
DO ji = kideb, kiut
- zhnew(ji) = SUM( h_i_old(ji,0:nlay_i+1) ) / REAL( nlay_i )
+ zhnew(ji) = SUM( h_i_old(ji,0:nlay_i+1) ) * r1_nlay_i
ENDDO
@@ -133,6 +132,6 @@
DO jk1 = 1, nlay_i
DO ji = kideb, kiut
- rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zhnew(ji) + epsi10 ) )
- qnew(ji,jk1) = rswitch * ( zqh_cum1(ji,jk1) - zqh_cum1(ji,jk1-1) ) / MAX( zhnew(ji), epsi10 )
+ rswitch = MAX( 0._wp , SIGN( 1._wp , zhnew(ji) - epsi20 ) )
+ qnew(ji,jk1) = rswitch * ( zqh_cum1(ji,jk1) - zqh_cum1(ji,jk1-1) ) / MAX( zhnew(ji), epsi20 )
ENDDO
ENDDO
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90 (revision 5602)
@@ -22,5 +22,4 @@
USE thd_ice ! LIM thermodynamics
USE dom_ice ! LIM domain
- USE par_ice ! LIM parameters
USE ice ! LIM variables
USE limtab ! LIM 2D <==> 1D
@@ -32,4 +31,5 @@
USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
USE limthd_ent
+ USE limvar
IMPLICIT NONE
@@ -106,5 +106,4 @@
REAL(wp), POINTER, DIMENSION(:,:) :: za_i_1d ! 1-D version of a_i
REAL(wp), POINTER, DIMENSION(:,:) :: zv_i_1d ! 1-D version of v_i
- REAL(wp), POINTER, DIMENSION(:,:) :: zoa_i_1d ! 1-D version of oa_i
REAL(wp), POINTER, DIMENSION(:,:) :: zsmv_i_1d ! 1-D version of smv_i
@@ -112,4 +111,6 @@
REAL(wp), POINTER, DIMENSION(:,:) :: zvrel ! relative ice / frazil velocity
+
+ REAL(wp) :: zcai = 1.4e-3_wp
!!-----------------------------------------------------------------------!
@@ -117,8 +118,10 @@
CALL wrk_alloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice )
CALL wrk_alloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d )
- CALL wrk_alloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zoa_i_1d, zsmv_i_1d )
- CALL wrk_alloc( jpij,nlay_i+1,jpl, ze_i_1d )
+ CALL wrk_alloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zsmv_i_1d )
+ CALL wrk_alloc( jpij,nlay_i,jpl, ze_i_1d )
CALL wrk_alloc( jpi,jpj, zvrel )
+ CALL lim_var_agg(1)
+ CALL lim_var_glo2eqv
!------------------------------------------------------------------------------|
! 2) Convert units for ice internal energy
@@ -129,8 +132,6 @@
DO ji = 1, jpi
!Energy of melting q(S,T) [J.m-3]
- rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , -v_i(ji,jj,jl) + epsi10 ) ) !0 if no ice and 1 if yes
- e_i(ji,jj,jk,jl) = rswitch * e_i(ji,jj,jk,jl) &
- & / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi10 ) ) * REAL( nlay_i, wp )
- e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac
+ rswitch = MAX( 0._wp , SIGN( 1._wp , v_i(ji,jj,jl) - epsi20 ) ) !0 if no ice
+ e_i(ji,jj,jk,jl) = rswitch * e_i(ji,jj,jk,jl) / MAX( v_i(ji,jj,jl), epsi20 ) * REAL( nlay_i, wp )
END DO
END DO
@@ -155,7 +156,7 @@
! Default new ice thickness
- hicol(:,:) = hiccrit
-
- IF( fraz_swi == 1 ) THEN
+ hicol(:,:) = rn_hnewice
+
+ IF( ln_frazil ) THEN
!--------------------
@@ -166,5 +167,5 @@
zhicrit = 0.04 ! frazil ice thickness
ztwogp = 2. * rau0 / ( grav * 0.3 * ( rau0 - rhoic ) ) ! reduced grav
- zsqcd = 1.0 / SQRT( 1.3 * cai ) ! 1/SQRT(airdensity*drag)
+ zsqcd = 1.0 / SQRT( 1.3 * zcai ) ! 1/SQRT(airdensity*drag)
zgamafr = 0.03
@@ -176,8 +177,8 @@
!-------------
! C-grid wind stress components
- ztaux = ( utau_ice(ji-1,jj ) * tmu(ji-1,jj ) &
- & + utau_ice(ji ,jj ) * tmu(ji ,jj ) ) * 0.5_wp
- ztauy = ( vtau_ice(ji ,jj-1) * tmv(ji ,jj-1) &
- & + vtau_ice(ji ,jj ) * tmv(ji ,jj ) ) * 0.5_wp
+ ztaux = ( utau_ice(ji-1,jj ) * umask(ji-1,jj ,1) &
+ & + utau_ice(ji ,jj ) * umask(ji ,jj ,1) ) * 0.5_wp
+ ztauy = ( vtau_ice(ji ,jj-1) * vmask(ji ,jj-1,1) &
+ & + vtau_ice(ji ,jj ) * vmask(ji ,jj ,1) ) * 0.5_wp
! Square root of wind stress
ztenagm = SQRT( SQRT( ztaux**2 + ztauy**2 ) )
@@ -195,6 +196,6 @@
! C-grid ice velocity
rswitch = MAX( 0._wp, SIGN( 1._wp , at_i(ji,jj) ) )
- zvgx = rswitch * ( u_ice(ji-1,jj ) * tmu(ji-1,jj ) + u_ice(ji,jj) * tmu(ji,jj) ) * 0.5_wp
- zvgy = rswitch * ( v_ice(ji ,jj-1) * tmv(ji ,jj-1) + v_ice(ji,jj) * tmv(ji,jj) ) * 0.5_wp
+ zvgx = rswitch * ( u_ice(ji-1,jj ) * umask(ji-1,jj ,1) + u_ice(ji,jj) * umask(ji,jj,1) ) * 0.5_wp
+ zvgy = rswitch * ( v_ice(ji ,jj-1) * vmask(ji ,jj-1,1) + v_ice(ji,jj) * vmask(ji,jj,1) ) * 0.5_wp
!-----------------------------------
@@ -222,5 +223,5 @@
iterate_frazil = .true.
- DO WHILE ( iter .LT. 100 .AND. iterate_frazil )
+ DO WHILE ( iter < 100 .AND. iterate_frazil )
zf = ( hicol(ji,jj) - zhicrit ) * ( hicol(ji,jj)**2 - zhicrit**2 ) &
- hicol(ji,jj) * zhicrit * ztwogp * zvrel2
@@ -266,7 +267,7 @@
! debug point to follow
jiindex_1d = 0
- IF( ln_nicep ) THEN
- DO ji = mi0(jiindx), mi1(jiindx)
- DO jj = mj0(jjindx), mj1(jjindx)
+ IF( ln_icectl ) THEN
+ DO ji = mi0(iiceprt), mi1(iiceprt)
+ DO jj = mj0(jiceprt), mj1(jiceprt)
IF ( qlead(ji,jj) < 0._wp ) THEN
jiindex_1d = (jj - 1) * jpi + ji
@@ -276,5 +277,5 @@
ENDIF
- IF( ln_nicep ) WRITE(numout,*) 'lim_thd_lac : nbpac = ', nbpac
+ IF( ln_icectl ) WRITE(numout,*) 'lim_thd_lac : nbpac = ', nbpac
!------------------------------
@@ -290,10 +291,9 @@
CALL tab_2d_1d( nbpac, za_i_1d (1:nbpac,jl), a_i (:,:,jl), jpi, jpj, npac(1:nbpac) )
CALL tab_2d_1d( nbpac, zv_i_1d (1:nbpac,jl), v_i (:,:,jl), jpi, jpj, npac(1:nbpac) )
- CALL tab_2d_1d( nbpac, zoa_i_1d (1:nbpac,jl), oa_i (:,:,jl), jpi, jpj, npac(1:nbpac) )
CALL tab_2d_1d( nbpac, zsmv_i_1d(1:nbpac,jl), smv_i(:,:,jl), jpi, jpj, npac(1:nbpac) )
DO jk = 1, nlay_i
CALL tab_2d_1d( nbpac, ze_i_1d(1:nbpac,jk,jl), e_i(:,:,jk,jl) , jpi, jpj, npac(1:nbpac) )
- END DO ! jk
- END DO ! jl
+ END DO
+ END DO
CALL tab_2d_1d( nbpac, qlead_1d (1:nbpac) , qlead , jpi, jpj, npac(1:nbpac) )
@@ -320,19 +320,19 @@
!----------------------
DO ji = 1, nbpac
- zh_newice(ji) = hiccrit
- END DO
- IF( fraz_swi == 1 ) zh_newice(1:nbpac) = hicol_1d(1:nbpac)
+ zh_newice(ji) = rn_hnewice
+ END DO
+ IF( ln_frazil ) zh_newice(1:nbpac) = hicol_1d(1:nbpac)
!----------------------
! Salinity of new ice
!----------------------
- SELECT CASE ( num_sal )
+ SELECT CASE ( nn_icesal )
CASE ( 1 ) ! Sice = constant
- zs_newice(1:nbpac) = bulk_sal
+ zs_newice(1:nbpac) = rn_icesal
CASE ( 2 ) ! Sice = F(z,t) [Vancoppenolle et al (2005)]
DO ji = 1, nbpac
ii = MOD( npac(ji) - 1 , jpi ) + 1
ij = ( npac(ji) - 1 ) / jpi + 1
- zs_newice(ji) = MIN( 4.606 + 0.91 / zh_newice(ji) , s_i_max , 0.5 * sss_m(ii,ij) )
+ zs_newice(ji) = MIN( 4.606 + 0.91 / zh_newice(ji) , rn_simax , 0.5 * sss_m(ii,ij) )
END DO
CASE ( 3 ) ! Sice = F(z) [multiyear ice]
@@ -345,9 +345,9 @@
! We assume that new ice is formed at the seawater freezing point
DO ji = 1, nbpac
- ztmelts = - tmut * zs_newice(ji) + rtt ! Melting point (K)
+ ztmelts = - tmut * zs_newice(ji) + rt0 ! Melting point (K)
ze_newice(ji) = rhoic * ( cpic * ( ztmelts - t_bo_1d(ji) ) &
- & + lfus * ( 1.0 - ( ztmelts - rtt ) / MIN( t_bo_1d(ji) - rtt, -epsi10 ) ) &
- & - rcp * ( ztmelts - rtt ) )
- END DO ! ji
+ & + lfus * ( 1.0 - ( ztmelts - rt0 ) / MIN( t_bo_1d(ji) - rt0, -epsi10 ) ) &
+ & - rcp * ( ztmelts - rt0 ) )
+ END DO
!----------------
@@ -356,5 +356,5 @@
DO ji = 1, nbpac
zo_newice(ji) = 0._wp
- END DO ! ji
+ END DO
!-------------------
@@ -363,7 +363,7 @@
DO ji = 1, nbpac
- zEi = - ze_newice(ji) / rhoic ! specific enthalpy of forming ice [J/kg]
-
- zEw = rcp * ( t_bo_1d(ji) - rt0 ) ! specific enthalpy of seawater at t_bo_1d [J/kg]
+ zEi = - ze_newice(ji) * r1_rhoic ! specific enthalpy of forming ice [J/kg]
+
+ zEw = rcp * ( t_bo_1d(ji) - rt0 ) ! specific enthalpy of seawater at t_bo_1d [J/kg]
! clem: we suppose we are already at the freezing point (condition qlead<0 is satisfyied)
@@ -372,5 +372,5 @@
zfmdt = - qlead_1d(ji) / zdE ! Fm.dt [kg/m2] (<0)
! clem: we use qlead instead of zqld (limthd) because we suppose we are at the freezing point
- zv_newice(ji) = - zfmdt / rhoic
+ zv_newice(ji) = - zfmdt * r1_rhoic
zQm = zfmdt * zEw ! heat to the ocean >0 associated with mass flux
@@ -387,5 +387,5 @@
! A fraction zfrazb of frazil ice is accreted at the ice bottom
rswitch = 1._wp - MAX( 0._wp, SIGN( 1._wp , - zat_i_1d(ji) ) )
- zfrazb = rswitch * ( TANH ( Cfrazb * ( zvrel_1d(ji) - vfrazb ) ) + 1.0 ) * 0.5 * maxfrazb
+ zfrazb = rswitch * ( TANH ( rn_Cfrazb * ( zvrel_1d(ji) - rn_vfrazb ) ) + 1.0 ) * 0.5 * rn_maxfrazb
zv_frazb(ji) = zfrazb * zv_newice(ji)
zv_newice(ji) = ( 1.0 - zfrazb ) * zv_newice(ji)
@@ -409,6 +409,6 @@
! we keep the excessive volume in memory and attribute it later to bottom accretion
DO ji = 1, nbpac
- IF ( za_newice(ji) > ( amax - zat_i_1d(ji) ) ) THEN
- zda_res(ji) = za_newice(ji) - ( amax - zat_i_1d(ji) )
+ IF ( za_newice(ji) > ( rn_amax - zat_i_1d(ji) ) ) THEN
+ zda_res(ji) = za_newice(ji) - ( rn_amax - zat_i_1d(ji) )
zdv_res(ji) = zda_res (ji) * zh_newice(ji)
za_newice(ji) = za_newice(ji) - zda_res (ji)
@@ -459,5 +459,5 @@
DO jk = 1, nlay_i
DO ji = 1, nbpac
- h_i_old (ji,jk) = zv_i_1d(ji,jl) / REAL( nlay_i )
+ h_i_old (ji,jk) = zv_i_1d(ji,jl) * r1_nlay_i
qh_i_old(ji,jk) = ze_i_1d(ji,jk,jl) * h_i_old(ji,jk)
END DO
@@ -478,14 +478,4 @@
ENDDO
- !------------
- ! Update age
- !------------
- DO jl = 1, jpl
- DO ji = 1, nbpac
- rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_1d(ji,jl) + epsi20 ) ) ! 0 if no ice and 1 if yes
- zoa_i_1d(ji,jl) = za_b(ji,jl) * zoa_i_1d(ji,jl) / MAX( za_i_1d(ji,jl) , epsi20 ) * rswitch
- END DO
- END DO
-
!-----------------
! Update salinity
@@ -504,5 +494,4 @@
CALL tab_1d_2d( nbpac, a_i (:,:,jl), npac(1:nbpac), za_i_1d (1:nbpac,jl), jpi, jpj )
CALL tab_1d_2d( nbpac, v_i (:,:,jl), npac(1:nbpac), zv_i_1d (1:nbpac,jl), jpi, jpj )
- CALL tab_1d_2d( nbpac, oa_i(:,:,jl), npac(1:nbpac), zoa_i_1d(1:nbpac,jl), jpi, jpj )
CALL tab_1d_2d( nbpac, smv_i (:,:,jl), npac(1:nbpac), zsmv_i_1d(1:nbpac,jl) , jpi, jpj )
DO jk = 1, nlay_i
@@ -525,6 +514,6 @@
DO jj = 1, jpj
DO ji = 1, jpi
- ! heat content in Joules
- e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / ( REAL( nlay_i ,wp ) * unit_fac )
+ ! heat content in J/m2
+ e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i
END DO
END DO
@@ -536,6 +525,6 @@
CALL wrk_dealloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice )
CALL wrk_dealloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d )
- CALL wrk_dealloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zoa_i_1d, zsmv_i_1d )
- CALL wrk_dealloc( jpij,nlay_i+1,jpl, ze_i_1d )
+ CALL wrk_dealloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zsmv_i_1d )
+ CALL wrk_dealloc( jpij,nlay_i,jpl, ze_i_1d )
CALL wrk_dealloc( jpi,jpj, zvrel )
!
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90 (revision 5602)
@@ -18,5 +18,4 @@
USE sbc_oce ! Surface boundary condition: ocean fields
USE ice ! LIM variables
- USE par_ice ! LIM parameters
USE thd_ice ! LIM thermodynamics
USE limvar ! LIM variables
@@ -30,5 +29,5 @@
PUBLIC lim_thd_sal ! called by limthd module
- PUBLIC lim_thd_sal_init ! called by iceini module
+ PUBLIC lim_thd_sal_init ! called by sbc_lim_init
!!----------------------------------------------------------------------
@@ -46,7 +45,7 @@
!!
!! ** Method : 3 possibilities
- !! -> num_sal = 1 -> Sice = cst [ice salinity constant in both time & space]
- !! -> num_sal = 2 -> Sice = S(z,t) [Vancoppenolle et al. 2005]
- !! -> num_sal = 3 -> Sice = S(z) [multiyear ice]
+ !! -> nn_icesal = 1 -> Sice = cst [ice salinity constant in both time & space]
+ !! -> nn_icesal = 2 -> Sice = S(z,t) [Vancoppenolle et al. 2005]
+ !! -> nn_icesal = 3 -> Sice = S(z) [multiyear ice]
!!---------------------------------------------------------------------
INTEGER, INTENT(in) :: kideb, kiut ! thickness category index
@@ -66,10 +65,10 @@
! 1) Constant salinity, constant in time |
!------------------------------------------------------------------------------|
-!!gm comment: if num_sal = 1 s_i_new, s_i_1d and sm_i_1d can be set to bulk_sal one for all in the initialisation phase !!
-!!gm ===>>> simplification of almost all test on num_sal value
- IF( num_sal == 1 ) THEN
- s_i_1d (kideb:kiut,1:nlay_i) = bulk_sal
- sm_i_1d(kideb:kiut) = bulk_sal
- s_i_new(kideb:kiut) = bulk_sal
+!!gm comment: if nn_icesal = 1 s_i_new, s_i_1d and sm_i_1d can be set to rn_icesal one for all in the initialisation phase !!
+!!gm ===>>> simplification of almost all test on nn_icesal value
+ IF( nn_icesal == 1 ) THEN
+ s_i_1d (kideb:kiut,1:nlay_i) = rn_icesal
+ sm_i_1d(kideb:kiut) = rn_icesal
+ s_i_new(kideb:kiut) = rn_icesal
ENDIF
@@ -77,5 +76,5 @@
! Module 2 : Constant salinity varying in time |
!------------------------------------------------------------------------------|
- IF( num_sal == 2 ) THEN
+ IF( nn_icesal == 2 ) THEN
DO ji = kideb, kiut
@@ -83,5 +82,5 @@
! Switches
!----------
- iflush = MAX( 0._wp , SIGN( 1._wp , t_su_1d(ji) - rtt ) ) ! =1 if summer
+ iflush = MAX( 0._wp , SIGN( 1._wp , t_su_1d(ji) - rt0 ) ) ! =1 if summer
igravdr = MAX( 0._wp , SIGN( 1._wp , t_bo_1d(ji) - t_su_1d(ji) ) ) ! =1 if t_su < t_bo
@@ -90,7 +89,7 @@
!---------------------
! drainage by gravity drainage
- dsm_i_gd_1d(ji) = - igravdr * MAX( sm_i_1d(ji) - sal_G , 0._wp ) / time_G * rdt_ice
+ dsm_i_gd_1d(ji) = - igravdr * MAX( sm_i_1d(ji) - rn_sal_gd , 0._wp ) / rn_time_gd * rdt_ice
! drainage by flushing
- dsm_i_fl_1d(ji) = - iflush * MAX( sm_i_1d(ji) - sal_F , 0._wp ) / time_F * rdt_ice
+ dsm_i_fl_1d(ji) = - iflush * MAX( sm_i_1d(ji) - rn_sal_fl , 0._wp ) / rn_time_fl * rdt_ice
!-----------------
@@ -116,5 +115,5 @@
! Module 3 : Profile of salinity, constant in time |
!------------------------------------------------------------------------------|
- IF( num_sal == 3 ) CALL lim_var_salprof1d( kideb, kiut )
+ IF( nn_icesal == 3 ) CALL lim_var_salprof1d( kideb, kiut )
!
@@ -134,6 +133,6 @@
!!-------------------------------------------------------------------
INTEGER :: ios ! Local integer output status for namelist read
- NAMELIST/namicesal/ num_sal, bulk_sal, sal_G, time_G, sal_F, time_F, &
- & s_i_max, s_i_min, s_i_0, s_i_1
+ NAMELIST/namicesal/ nn_icesal, rn_icesal, rn_sal_gd, rn_time_gd, rn_sal_fl, rn_time_fl, &
+ & rn_simax, rn_simin
!!-------------------------------------------------------------------
!
@@ -151,14 +150,12 @@
WRITE(numout,*) 'lim_thd_sal_init : Ice parameters for salinity '
WRITE(numout,*) '~~~~~~~~~~~~~~~~'
- WRITE(numout,*) ' switch for salinity num_sal : ', num_sal
- WRITE(numout,*) ' bulk salinity value if num_sal = 1 : ', bulk_sal
- WRITE(numout,*) ' restoring salinity for GD : ', sal_G
- WRITE(numout,*) ' restoring time for GD : ', time_G
- WRITE(numout,*) ' restoring salinity for flushing : ', sal_F
- WRITE(numout,*) ' restoring time for flushing : ', time_F
- WRITE(numout,*) ' Maximum tolerated ice salinity : ', s_i_max
- WRITE(numout,*) ' Minimum tolerated ice salinity : ', s_i_min
- WRITE(numout,*) ' 1st salinity for salinity profile : ', s_i_0
- WRITE(numout,*) ' 2nd salinity for salinity profile : ', s_i_1
+ WRITE(numout,*) ' switch for salinity nn_icesal = ', nn_icesal
+ WRITE(numout,*) ' bulk salinity value if nn_icesal = 1 = ', rn_icesal
+ WRITE(numout,*) ' restoring salinity for GD = ', rn_sal_gd
+ WRITE(numout,*) ' restoring time for GD = ', rn_time_gd
+ WRITE(numout,*) ' restoring salinity for flushing = ', rn_sal_fl
+ WRITE(numout,*) ' restoring time for flushing = ', rn_time_fl
+ WRITE(numout,*) ' Maximum tolerated ice salinity = ', rn_simax
+ WRITE(numout,*) ' Minimum tolerated ice salinity = ', rn_simin
ENDIF
!
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90 (revision 5602)
@@ -17,9 +17,10 @@
USE dom_oce ! ocean domain
USE sbc_oce ! ocean surface boundary condition
- USE par_ice ! ice parameter
USE dom_ice ! ice domain
USE ice ! ice variables
USE limadv ! ice advection
USE limhdf ! ice horizontal diffusion
+ USE limvar !
+ !
USE in_out_manager ! I/O manager
USE lbclnk ! lateral boundary conditions -- MPP exchanges
@@ -28,12 +29,14 @@
USE prtctl ! Print control
USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
- USE limvar ! clem for ice thickness correction
- USE timing ! Timing
+ USE timing ! Timing
USE limcons ! conservation tests
+ USE limctl ! control prints
IMPLICIT NONE
PRIVATE
- PUBLIC lim_trp ! called by ice_step
+ PUBLIC lim_trp ! called by sbcice_lim
+
+ INTEGER :: ncfl ! number of ice time step with CFL>1/2
!! * Substitution
@@ -58,27 +61,28 @@
!! ** action :
!!---------------------------------------------------------------------
- INTEGER, INTENT(in) :: kt ! number of iteration
+ INTEGER, INTENT(in) :: kt ! number of iteration
!
- INTEGER :: ji, jj, jk, jl, jn ! dummy loop indices
+ INTEGER :: ji, jj, jk, jl, jt ! dummy loop indices
INTEGER :: initad ! number of sub-timestep for the advection
REAL(wp) :: zcfl , zusnit ! - -
+ CHARACTER(len=80) :: cltmp
!
- REAL(wp), POINTER, DIMENSION(:,:) :: zui_u, zvi_v, zsm, zs0at, zs0ow
- REAL(wp), POINTER, DIMENSION(:,:,:) :: zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi
- REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zs0e
- REAL(wp), POINTER, DIMENSION(:,:,:) :: zviold, zvsold ! old ice volume...
- REAL(wp), POINTER, DIMENSION(:,:,:) :: zaiold, zhimax ! old ice concentration and thickness
- REAL(wp), POINTER, DIMENSION(:,:) :: zeiold, zesold ! old enthalpies
- REAL(wp) :: zdv, zda, zvi, zvs, zsmv, zes, zei
- !
- REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b
+ REAL(wp), POINTER, DIMENSION(:,:) :: zsm
+ REAL(wp), POINTER, DIMENSION(:,:,:) :: z0ice, z0snw, z0ai, z0es , z0smi , z0oi
+ REAL(wp), POINTER, DIMENSION(:,:,:) :: z0opw
+ REAL(wp), POINTER, DIMENSION(:,:,:,:) :: z0ei
+ REAL(wp), POINTER, DIMENSION(:,:,:) :: zviold, zvsold, zsmvold ! old ice volume...
+ REAL(wp), POINTER, DIMENSION(:,:,:) :: zhimax ! old ice thickness
+ REAL(wp), POINTER, DIMENSION(:,:) :: zatold, zeiold, zesold ! old concentration, enthalpies
+ REAL(wp) :: zdv, zvi, zvs, zsmv, zes, zei
+ REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b
!!---------------------------------------------------------------------
IF( nn_timing == 1 ) CALL timing_start('limtrp')
- CALL wrk_alloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow, zeiold, zesold )
- CALL wrk_alloc( jpi, jpj, jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi )
- CALL wrk_alloc( jpi, jpj, nlay_i+1, jpl, zs0e )
-
- CALL wrk_alloc( jpi, jpj, jpl, zaiold, zhimax, zviold, zvsold ) ! clem
+ CALL wrk_alloc( jpi,jpj, zsm, zatold, zeiold, zesold )
+ CALL wrk_alloc( jpi,jpj,jpl, z0ice, z0snw, z0ai, z0es , z0smi , z0oi )
+ CALL wrk_alloc( jpi,jpj,1, z0opw )
+ CALL wrk_alloc( jpi,jpj,nlay_i,jpl, z0ei )
+ CALL wrk_alloc( jpi,jpj,jpl, zhimax, zviold, zvsold, zsmvold )
IF( numit == nstart .AND. lwp ) THEN
@@ -88,8 +92,9 @@
ENDIF
WRITE(numout,*) '~~~~~~~~~~~~'
+ ncfl = 0 ! nb of time step with CFL > 1/2
ENDIF
+
+ zsm(:,:) = e12t(:,:)
- zsm(:,:) = area(:,:)
-
! !-------------------------------------!
IF( ln_limdyn ) THEN ! Advection of sea ice properties !
@@ -97,27 +102,33 @@
! conservation test
- IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
-
- ! mass and salt flux init (clem)
+ IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
+ ! mass and salt flux init
zviold(:,:,:) = v_i(:,:,:)
- zeiold(:,:) = SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 )
- zesold(:,:) = SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 )
-
- !--- Thickness correction init. (clem) -------------------------------
- CALL lim_var_glo2eqv
- zaiold(:,:,:) = a_i(:,:,:)
+ zvsold(:,:,:) = v_s(:,:,:)
+ zsmvold(:,:,:) = smv_i(:,:,:)
+ zeiold(:,:) = SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 )
+ zesold(:,:) = SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 )
+
+ !--- Thickness correction init. -------------------------------
+ zatold(:,:) = SUM( a_i(:,:,:), dim=3 )
+ DO jl = 1, jpl
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) )
+ ht_i (ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
+ ht_s (ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
+ END DO
+ END DO
+ END DO
!---------------------------------------------------------------------
- ! Record max of the surrounding ice thicknesses for correction in limupdate
+ ! Record max of the surrounding ice thicknesses for correction
! in case advection creates ice too thick.
!---------------------------------------------------------------------
- zhimax(:,:,:) = ht_i(:,:,:)
+ zhimax(:,:,:) = ht_i(:,:,:) + ht_s(:,:,:)
DO jl = 1, jpl
DO jj = 2, jpjm1
DO ji = 2, jpim1
- zhimax(ji,jj,jl) = MAXVAL( ht_i(ji-1:ji+1,jj-1:jj+1,jl) )
- !zhimax(ji,jj,jl) = ( ht_i(ji ,jj ,jl) * tmask(ji, jj ,1) + ht_i(ji-1,jj-1,jl) * tmask(ji-1,jj-1,1) + ht_i(ji+1,jj+1,jl) * tmask(ji+1,jj+1,1) &
- ! & + ht_i(ji-1,jj ,jl) * tmask(ji-1,jj ,1) + ht_i(ji ,jj-1,jl) * tmask(ji ,jj-1,1) &
- ! & + ht_i(ji+1,jj ,jl) * tmask(ji+1,jj ,1) + ht_i(ji ,jj+1,jl) * tmask(ji ,jj+1,1) &
- ! & + ht_i(ji-1,jj+1,jl) * tmask(ji-1,jj+1,1) + ht_i(ji+1,jj-1,jl) * tmask(ji+1,jj-1,1) )
+ zhimax(ji,jj,jl) = MAXVAL( ht_i(ji-1:ji+1,jj-1:jj+1,jl) + ht_s(ji-1:ji+1,jj-1:jj+1,jl) )
END DO
END DO
@@ -125,74 +136,80 @@
END DO
+ !=============================!
+ !== Prather scheme ==!
+ !=============================!
+
+ ! If ice drift field is too fast, use an appropriate time step for advection.
+ zcfl = MAXVAL( ABS( u_ice(:,:) ) * rdt_ice * r1_e1u(:,:) ) ! CFL test for stability
+ zcfl = MAX( zcfl, MAXVAL( ABS( v_ice(:,:) ) * rdt_ice * r1_e2v(:,:) ) )
+ IF(lk_mpp ) CALL mpp_max( zcfl )
+
+ IF( zcfl > 0.5 ) THEN ; initad = 2 ; zusnit = 0.5_wp
+ ELSE ; initad = 1 ; zusnit = 1.0_wp
+ ENDIF
+
+ IF( zcfl > 0.5_wp .AND. lwp ) ncfl = ncfl + 1
+!! IF( lwp ) THEN
+!! IF( ncfl > 0 ) THEN
+!! WRITE(cltmp,'(i6.1)') ncfl
+!! CALL ctl_warn( 'lim_trp: ncfl= ', TRIM(cltmp), 'advective ice time-step using a split in sub-time-step ')
+!! ELSE
+!! ! WRITE(numout,*) 'lim_trp : CFL criterion for ice advection is always smaller than 1/2 '
+!! ENDIF
+!! ENDIF
+
!-------------------------
! transported fields
!-------------------------
- ! Snow vol, ice vol, salt and age contents, area
- zs0ow(:,:) = ato_i(:,:) * area(:,:) ! Open water area
- DO jl = 1, jpl
- zs0sn (:,:,jl) = v_s (:,:,jl) * area(:,:) ! Snow volume
- zs0ice(:,:,jl) = v_i (:,:,jl) * area(:,:) ! Ice volume
- zs0a (:,:,jl) = a_i (:,:,jl) * area(:,:) ! Ice area
- zs0sm (:,:,jl) = smv_i(:,:,jl) * area(:,:) ! Salt content
- zs0oi (:,:,jl) = oa_i (:,:,jl) * area(:,:) ! Age content
- zs0c0 (:,:,jl) = e_s (:,:,1,jl) ! Snow heat content
- zs0e (:,:,:,jl) = e_i (:,:,:,jl) ! Ice heat content
- END DO
-
- !--------------------------
- ! Advection of Ice fields (Prather scheme)
- !--------------------------
- ! If ice drift field is too fast, use an appropriate time step for advection.
- ! CFL test for stability
- zcfl = MAXVAL( ABS( u_ice(:,:) ) * rdt_ice / e1u(:,:) )
- zcfl = MAX( zcfl, MAXVAL( ABS( v_ice(:,:) ) * rdt_ice / e2v(:,:) ) )
- IF(lk_mpp ) CALL mpp_max( zcfl )
-!!gm more readability:
-! IF( zcfl > 0.5 ) THEN ; initad = 2 ; zusnit = 0.5_wp
-! ELSE ; initad = 1 ; zusnit = 1.0_wp
-! ENDIF
-!!gm end
- initad = 1 + NINT( MAX( 0._wp, SIGN( 1._wp, zcfl-0.5 ) ) )
- zusnit = 1.0 / REAL( initad )
- IF( zcfl > 0.5 .AND. lwp ) &
- WRITE(numout,*) 'lim_trp : CFL violation at day ', nday, ', cfl = ', zcfl, &
- & ': the ice time stepping is split in two'
+ z0opw(:,:,1) = ato_i(:,:) * e12t(:,:) ! Open water area
+ DO jl = 1, jpl
+ z0snw (:,:,jl) = v_s (:,:,jl) * e12t(:,:) ! Snow volume
+ z0ice(:,:,jl) = v_i (:,:,jl) * e12t(:,:) ! Ice volume
+ z0ai (:,:,jl) = a_i (:,:,jl) * e12t(:,:) ! Ice area
+ z0smi (:,:,jl) = smv_i(:,:,jl) * e12t(:,:) ! Salt content
+ z0oi (:,:,jl) = oa_i (:,:,jl) * e12t(:,:) ! Age content
+ z0es (:,:,jl) = e_s (:,:,1,jl) * e12t(:,:) ! Snow heat content
+ DO jk = 1, nlay_i
+ z0ei (:,:,jk,jl) = e_i (:,:,jk,jl) * e12t(:,:) ! Ice heat content
+ END DO
+ END DO
+
IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0 ) THEN !== odd ice time step: adv_x then adv_y ==!
- DO jn = 1,initad
- CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0ow (:,:), sxopw(:,:), & !--- ice open water area
- & sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:) )
- CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0ow (:,:), sxopw(:,:), &
- & sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:) )
+ DO jt = 1, initad
+ CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0opw (:,:,1), sxopw(:,:), & !--- ice open water area
+ & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) )
+ CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0opw (:,:,1), sxopw(:,:), &
+ & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) )
DO jl = 1, jpl
- CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0ice(:,:,jl), sxice(:,:,jl), & !--- ice volume ---
+ CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0ice (:,:,jl), sxice(:,:,jl), & !--- ice volume ---
& sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) )
- CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0ice(:,:,jl), sxice(:,:,jl), &
+ CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0ice (:,:,jl), sxice(:,:,jl), &
& sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) )
- CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0sn (:,:,jl), sxsn (:,:,jl), & !--- snow volume ---
+ CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0snw (:,:,jl), sxsn (:,:,jl), & !--- snow volume ---
& sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) )
- CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0sn (:,:,jl), sxsn (:,:,jl), &
+ CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0snw (:,:,jl), sxsn (:,:,jl), &
& sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) )
- CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0sm (:,:,jl), sxsal(:,:,jl), & !--- ice salinity ---
+ CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0smi (:,:,jl), sxsal(:,:,jl), & !--- ice salinity ---
& sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) )
- CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0sm (:,:,jl), sxsal(:,:,jl), &
+ CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0smi (:,:,jl), sxsal(:,:,jl), &
& sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) )
- CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0oi (:,:,jl), sxage(:,:,jl), & !--- ice age ---
+ CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0oi (:,:,jl), sxage(:,:,jl), & !--- ice age ---
& sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) )
- CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0oi (:,:,jl), sxage(:,:,jl), &
+ CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0oi (:,:,jl), sxage(:,:,jl), &
& sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) )
- CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0a (:,:,jl), sxa (:,:,jl), & !--- ice concentrations ---
+ CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0ai (:,:,jl), sxa (:,:,jl), & !--- ice concentrations ---
& sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) )
- CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0a (:,:,jl), sxa (:,:,jl), &
+ CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0ai (:,:,jl), sxa (:,:,jl), &
& sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) )
- CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), & !--- snow heat contents ---
+ CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0es (:,:,jl), sxc0 (:,:,jl), & !--- snow heat contents ---
& sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) )
- CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), &
+ CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0es (:,:,jl), sxc0 (:,:,jl), &
& sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) )
- DO jk = 1, nlay_i !--- ice heat contents ---
- CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0e(:,:,jk,jl), sxe (:,:,jk,jl), &
+ DO jk = 1, nlay_i !--- ice heat contents ---
+ CALL lim_adv_x( zusnit, u_ice, 1._wp, zsm, z0ei(:,:,jk,jl), sxe (:,:,jk,jl), &
& sxxe(:,:,jk,jl), sye (:,:,jk,jl), &
& syye(:,:,jk,jl), sxye(:,:,jk,jl) )
- CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0e(:,:,jk,jl), sxe (:,:,jk,jl), &
+ CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, z0ei(:,:,jk,jl), sxe (:,:,jk,jl), &
& sxxe(:,:,jk,jl), sye (:,:,jk,jl), &
& syye(:,:,jk,jl), sxye(:,:,jk,jl) )
@@ -201,40 +218,39 @@
END DO
ELSE
- DO jn = 1, initad
- CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0ow (:,:), sxopw(:,:), & !--- ice open water area
- & sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:) )
- CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0ow (:,:), sxopw(:,:), &
- & sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:) )
+ DO jt = 1, initad
+ CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0opw (:,:,1), sxopw(:,:), & !--- ice open water area
+ & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) )
+ CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0opw (:,:,1), sxopw(:,:), &
+ & sxxopw(:,:) , syopw(:,:), syyopw(:,:), sxyopw(:,:) )
DO jl = 1, jpl
- CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0ice(:,:,jl), sxice(:,:,jl), & !--- ice volume ---
+ CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0ice (:,:,jl), sxice(:,:,jl), & !--- ice volume ---
& sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) )
- CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0ice(:,:,jl), sxice(:,:,jl), &
+ CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0ice (:,:,jl), sxice(:,:,jl), &
& sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) )
- CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0sn (:,:,jl), sxsn (:,:,jl), & !--- snow volume ---
+ CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0snw (:,:,jl), sxsn (:,:,jl), & !--- snow volume ---
& sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) )
- CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0sn (:,:,jl), sxsn (:,:,jl), &
+ CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0snw (:,:,jl), sxsn (:,:,jl), &
& sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) )
- CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0sm (:,:,jl), sxsal(:,:,jl), & !--- ice salinity ---
+ CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0smi (:,:,jl), sxsal(:,:,jl), & !--- ice salinity ---
& sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) )
- CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0sm (:,:,jl), sxsal(:,:,jl), &
+ CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0smi (:,:,jl), sxsal(:,:,jl), &
& sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) )
-
- CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0oi (:,:,jl), sxage(:,:,jl), & !--- ice age ---
+ CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0oi (:,:,jl), sxage(:,:,jl), & !--- ice age ---
& sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) )
- CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0oi (:,:,jl), sxage(:,:,jl), &
+ CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0oi (:,:,jl), sxage(:,:,jl), &
& sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) )
- CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0a (:,:,jl), sxa (:,:,jl), & !--- ice concentrations ---
+ CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0ai (:,:,jl), sxa (:,:,jl), & !--- ice concentrations ---
& sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) )
- CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0a (:,:,jl), sxa (:,:,jl), &
+ CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0ai (:,:,jl), sxa (:,:,jl), &
& sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) )
- CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), & !--- snow heat contents ---
+ CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0es (:,:,jl), sxc0 (:,:,jl), & !--- snow heat contents ---
& sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) )
- CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), &
+ CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0es (:,:,jl), sxc0 (:,:,jl), &
& sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) )
DO jk = 1, nlay_i !--- ice heat contents ---
- CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0e(:,:,jk,jl), sxe (:,:,jk,jl), &
+ CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0ei(:,:,jk,jl), sxe (:,:,jk,jl), &
& sxxe(:,:,jk,jl), sye (:,:,jk,jl), &
& syye(:,:,jk,jl), sxye(:,:,jk,jl) )
- CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0e(:,:,jk,jl), sxe (:,:,jk,jl), &
+ CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0ei(:,:,jk,jl), sxe (:,:,jk,jl), &
& sxxe(:,:,jk,jl), sye (:,:,jk,jl), &
& syye(:,:,jk,jl), sxye(:,:,jk,jl) )
@@ -247,37 +263,41 @@
! Recover the properties from their contents
!-------------------------------------------
- zs0ow(:,:) = zs0ow(:,:) / area(:,:)
- DO jl = 1, jpl
- zs0ice(:,:,jl) = zs0ice(:,:,jl) / area(:,:)
- zs0sn (:,:,jl) = zs0sn (:,:,jl) / area(:,:)
- zs0sm (:,:,jl) = zs0sm (:,:,jl) / area(:,:)
- zs0oi (:,:,jl) = zs0oi (:,:,jl) / area(:,:)
- zs0a (:,:,jl) = zs0a (:,:,jl) / area(:,:)
- !
+ ato_i(:,:) = z0opw(:,:,1) * r1_e12t(:,:)
+ DO jl = 1, jpl
+ v_i (:,:,jl) = z0ice(:,:,jl) * r1_e12t(:,:)
+ v_s (:,:,jl) = z0snw(:,:,jl) * r1_e12t(:,:)
+ smv_i(:,:,jl) = z0smi(:,:,jl) * r1_e12t(:,:)
+ oa_i (:,:,jl) = z0oi (:,:,jl) * r1_e12t(:,:)
+ a_i (:,:,jl) = z0ai (:,:,jl) * r1_e12t(:,:)
+ e_s (:,:,1,jl) = z0es (:,:,jl) * r1_e12t(:,:)
+ DO jk = 1, nlay_i
+ e_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e12t(:,:)
+ END DO
+ END DO
+
+ at_i(:,:) = a_i(:,:,1) ! total ice fraction
+ DO jl = 2, jpl
+ at_i(:,:) = at_i(:,:) + a_i(:,:,jl)
END DO
!------------------------------------------------------------------------------!
- ! 4) Diffusion of Ice fields
+ ! Diffusion of Ice fields
!------------------------------------------------------------------------------!
+ !
!--------------------------------
! diffusion of open water area
!--------------------------------
- zs0at(:,:) = zs0a(:,:,1) ! total ice fraction
- DO jl = 2, jpl
- zs0at(:,:) = zs0at(:,:) + zs0a(:,:,jl)
- END DO
- !
! ! Masked eddy diffusivity coefficient at ocean U- and V-points
DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row
DO ji = 1 , fs_jpim1 ! vector opt.
- pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0at(ji ,jj) ) ) ) &
- & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0at(ji+1,jj) ) ) ) * ahiu(ji,jj)
- pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0at(ji,jj ) ) ) ) &
- & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- zs0at(ji,jj+1) ) ) ) * ahiv(ji,jj)
+ pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji ,jj) ) ) ) &
+ & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji+1,jj) ) ) ) * ahiu(ji,jj)
+ pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji,jj ) ) ) ) &
+ & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- at_i(ji,jj+1) ) ) ) * ahiv(ji,jj)
END DO
END DO
!
- CALL lim_hdf( zs0ow (:,:) ) ! Diffusion
+ CALL lim_hdf( ato_i (:,:) )
!------------------------------------
@@ -288,93 +308,64 @@
DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row
DO ji = 1 , fs_jpim1 ! vector opt.
- pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0a(ji ,jj,jl) ) ) ) &
- & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0a(ji+1,jj,jl) ) ) ) * ahiu(ji,jj)
- pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0a(ji,jj ,jl) ) ) ) &
- & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- zs0a(ji,jj+1,jl) ) ) ) * ahiv(ji,jj)
- END DO
- END DO
-
- CALL lim_hdf( zs0ice (:,:,jl) )
- CALL lim_hdf( zs0sn (:,:,jl) )
- CALL lim_hdf( zs0sm (:,:,jl) )
- CALL lim_hdf( zs0oi (:,:,jl) )
- CALL lim_hdf( zs0a (:,:,jl) )
- CALL lim_hdf( zs0c0 (:,:,jl) )
+ pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji ,jj,jl) ) ) ) &
+ & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji+1,jj,jl) ) ) ) * ahiu(ji,jj)
+ pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji,jj ,jl) ) ) ) &
+ & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- a_i(ji,jj+1,jl) ) ) ) * ahiv(ji,jj)
+ END DO
+ END DO
+
+ CALL lim_hdf( v_i (:,:, jl) )
+ CALL lim_hdf( v_s (:,:, jl) )
+ CALL lim_hdf( smv_i(:,:, jl) )
+ CALL lim_hdf( oa_i (:,:, jl) )
+ CALL lim_hdf( a_i (:,:, jl) )
+ CALL lim_hdf( e_s (:,:,1,jl) )
DO jk = 1, nlay_i
- CALL lim_hdf( zs0e (:,:,jk,jl) )
+ CALL lim_hdf( e_i(:,:,jk,jl) )
END DO
END DO
!------------------------------------------------------------------------------!
- ! 5) Update and limit ice properties after transport
+ ! limit ice properties after transport
!------------------------------------------------------------------------------!
-
- !--------------------------------------------------
- ! 5.1) Recover mean values over the grid squares.
- !--------------------------------------------------
- zs0at(:,:) = 0._wp
+!!gm & cr : MAX should not be active if adv scheme is positive !
DO jl = 1, jpl
DO jj = 1, jpj
DO ji = 1, jpi
- zs0sn (ji,jj,jl) = MAX( 0._wp, zs0sn (ji,jj,jl) )
- zs0ice(ji,jj,jl) = MAX( 0._wp, zs0ice(ji,jj,jl) )
- zs0sm (ji,jj,jl) = MAX( 0._wp, zs0sm (ji,jj,jl) )
- zs0oi (ji,jj,jl) = MAX( 0._wp, zs0oi (ji,jj,jl) )
- zs0a (ji,jj,jl) = MAX( 0._wp, zs0a (ji,jj,jl) )
- zs0c0 (ji,jj,jl) = MAX( 0._wp, zs0c0 (ji,jj,jl) )
- zs0at (ji,jj) = zs0at(ji,jj) + zs0a(ji,jj,jl)
- END DO
- END DO
- END DO
-
- !---------------------------------------------------------
- ! 5.2) Update and mask variables
- !---------------------------------------------------------
- DO jl = 1, jpl
- DO jj = 1, jpj
- DO ji = 1, jpi
- rswitch = MAX( 0._wp , SIGN( 1._wp, zs0a(ji,jj,jl) - epsi10 ) )
-
- zvi = zs0ice(ji,jj,jl)
- zvs = zs0sn (ji,jj,jl)
- zes = zs0c0 (ji,jj,jl)
- zsmv = zs0sm (ji,jj,jl)
- !
- ! Remove very small areas
- v_s(ji,jj,jl) = rswitch * zs0sn (ji,jj,jl)
- v_i(ji,jj,jl) = rswitch * zs0ice(ji,jj,jl)
- a_i(ji,jj,jl) = rswitch * zs0a (ji,jj,jl)
- e_s(ji,jj,1,jl) = rswitch * zs0c0 (ji,jj,jl)
- ! Ice salinity and age
- IF( num_sal == 2 ) THEN
- smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), zsmv ), s_i_min * v_i(ji,jj,jl) )
- ENDIF
- oa_i(ji,jj,jl) = MAX( rswitch * zs0oi(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ), 0._wp ) * a_i(ji,jj,jl)
-
- ! Update fluxes
- wfx_res(ji,jj) = wfx_res(ji,jj) - ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice
- wfx_snw(ji,jj) = wfx_snw(ji,jj) - ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice
- sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice
- hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0
- END DO
- END DO
- END DO
-
- DO jl = 1, jpl
+ v_s (ji,jj,jl) = MAX( 0._wp, v_s (ji,jj,jl) )
+ v_i (ji,jj,jl) = MAX( 0._wp, v_i (ji,jj,jl) )
+ smv_i(ji,jj,jl) = MAX( 0._wp, smv_i(ji,jj,jl) )
+ oa_i (ji,jj,jl) = MAX( 0._wp, oa_i (ji,jj,jl) )
+ a_i (ji,jj,jl) = MAX( 0._wp, a_i (ji,jj,jl) )
+ e_s (ji,jj,1,jl) = MAX( 0._wp, e_s (ji,jj,1,jl) )
+ END DO
+ END DO
+
DO jk = 1, nlay_i
DO jj = 1, jpj
DO ji = 1, jpi
- rswitch = MAX( 0._wp , SIGN( 1._wp, zs0a(ji,jj,jl) - epsi10 ) )
- zei = zs0e(ji,jj,jk,jl)
- e_i(ji,jj,jk,jl) = rswitch * MAX( 0._wp, zs0e(ji,jj,jk,jl) )
- ! Update fluxes
- hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_i(ji,jj,jk,jl) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0
- END DO !ji
- END DO ! jj
- END DO ! jk
- END DO ! jl
-
- !--- Thickness correction in case too high (clem) --------------------------------------------------------
- CALL lim_var_glo2eqv
+ e_i(ji,jj,jk,jl) = MAX( 0._wp, e_i(ji,jj,jk,jl) )
+ END DO
+ END DO
+ END DO
+ END DO
+!!gm & cr
+
+ ! --- diags ---
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ diag_trp_ei(ji,jj) = ( SUM( e_i(ji,jj,1:nlay_i,:) ) - zeiold(ji,jj) ) * r1_rdtice
+ diag_trp_es(ji,jj) = ( SUM( e_s(ji,jj,1:nlay_s,:) ) - zesold(ji,jj) ) * r1_rdtice
+
+ diag_trp_vi (ji,jj) = SUM( v_i(ji,jj,:) - zviold(ji,jj,:) ) * r1_rdtice
+ diag_trp_vs (ji,jj) = SUM( v_s(ji,jj,:) - zvsold(ji,jj,:) ) * r1_rdtice
+ diag_trp_smv(ji,jj) = SUM( smv_i(ji,jj,:) - zsmvold(ji,jj,:) ) * r1_rdtice
+ END DO
+ END DO
+
+ ! zap small areas
+ CALL lim_var_zapsmall
+
+ !--- Thickness correction in case too high --------------------------------------------------------
DO jl = 1, jpl
DO jj = 1, jpj
@@ -382,4 +373,9 @@
IF ( v_i(ji,jj,jl) > 0._wp ) THEN
+
+ rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) )
+ ht_i (ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
+ ht_s (ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
+
zvi = v_i (ji,jj,jl)
zvs = v_s (ji,jj,jl)
@@ -387,48 +383,47 @@
zes = e_s (ji,jj,1,jl)
zei = SUM( e_i(ji,jj,1:nlay_i,jl) )
- zdv = v_i(ji,jj,jl) - zviold(ji,jj,jl)
- !zda = a_i(ji,jj,jl) - zaiold(ji,jj,jl)
-
- rswitch = 1._wp
- IF ( ( zdv > 0.0 .AND. ht_i(ji,jj,jl) > zhimax(ji,jj,jl) .AND. SUM( zaiold(ji,jj,1:jpl) ) < 0.80 ) .OR. &
- & ( zdv < 0.0 .AND. ht_i(ji,jj,jl) > zhimax(ji,jj,jl) ) ) THEN
- ht_i(ji,jj,jl) = MIN( zhimax(ji,jj,jl), hi_max(jl) )
- rswitch = MAX( 0._wp, SIGN( 1._wp, ht_i(ji,jj,jl) - epsi20 ) )
- a_i(ji,jj,jl) = rswitch * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi20 )
- ELSE
- ht_i(ji,jj,jl) = MAX( MIN( ht_i(ji,jj,jl), hi_max(jl) ), hi_max(jl-1) )
- rswitch = MAX( 0._wp, SIGN( 1._wp, ht_i(ji,jj,jl) - epsi20 ) )
- a_i(ji,jj,jl) = rswitch * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi20 )
+
+ zdv = v_i(ji,jj,jl) + v_s(ji,jj,jl) - zviold(ji,jj,jl) - zvsold(ji,jj,jl)
+
+ IF ( ( zdv > 0.0 .AND. (ht_i(ji,jj,jl)+ht_s(ji,jj,jl)) > zhimax(ji,jj,jl) .AND. zatold(ji,jj) < 0.80 ) .OR. &
+ & ( zdv <= 0.0 .AND. (ht_i(ji,jj,jl)+ht_s(ji,jj,jl)) > zhimax(ji,jj,jl) ) ) THEN
+
+ rswitch = MAX( 0._wp, SIGN( 1._wp, zhimax(ji,jj,jl) - epsi20 ) )
+ a_i(ji,jj,jl) = rswitch * ( v_i(ji,jj,jl) + v_s(ji,jj,jl) ) / MAX( zhimax(ji,jj,jl), epsi20 )
+
+ ! small correction due to *rswitch for a_i
+ v_i (ji,jj,jl) = rswitch * v_i (ji,jj,jl)
+ v_s (ji,jj,jl) = rswitch * v_s (ji,jj,jl)
+ smv_i(ji,jj,jl) = rswitch * smv_i(ji,jj,jl)
+ e_s(ji,jj,1,jl) = rswitch * e_s(ji,jj,1,jl)
+ e_i(ji,jj,1:nlay_i,jl) = rswitch * e_i(ji,jj,1:nlay_i,jl)
+
+ ! Update mass fluxes
+ wfx_res(ji,jj) = wfx_res(ji,jj) - ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice
+ wfx_snw(ji,jj) = wfx_snw(ji,jj) - ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice
+ sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice
+ hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * r1_rdtice ! W.m-2 <0
+ hfx_res(ji,jj) = hfx_res(ji,jj) + ( SUM( e_i(ji,jj,1:nlay_i,jl) ) - zei ) * r1_rdtice ! W.m-2 <0
+
ENDIF
- ! small correction due to *rswitch for a_i
- v_i (ji,jj,jl) = rswitch * v_i (ji,jj,jl)
- v_s (ji,jj,jl) = rswitch * v_s (ji,jj,jl)
- smv_i(ji,jj,jl) = rswitch * smv_i(ji,jj,jl)
- e_s(ji,jj,1,jl) = rswitch * e_s(ji,jj,1,jl)
- e_i(ji,jj,1:nlay_i,jl) = rswitch * e_i(ji,jj,1:nlay_i,jl)
-
- ! Update mass fluxes
- wfx_res(ji,jj) = wfx_res(ji,jj) - ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice
- wfx_snw(ji,jj) = wfx_snw(ji,jj) - ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice
- sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice
- hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0
- hfx_res(ji,jj) = hfx_res(ji,jj) + ( SUM( e_i(ji,jj,1:nlay_i,jl) ) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0
ENDIF
+
END DO
END DO
END DO
! -------------------------------------------------
-
- ! --- diags ---
- DO jj = 1, jpj
- DO ji = 1, jpi
- diag_trp_ei(ji,jj) = ( SUM( e_i(ji,jj,1:nlay_i,:) ) - zeiold(ji,jj) ) / area(ji,jj) * unit_fac * r1_rdtice
- diag_trp_es(ji,jj) = ( SUM( e_s(ji,jj,1:nlay_s,:) ) - zesold(ji,jj) ) / area(ji,jj) * unit_fac * r1_rdtice
-
- diag_trp_vi(ji,jj) = SUM( v_i(ji,jj,:) - zviold(ji,jj,:) ) * r1_rdtice
- diag_trp_vs(ji,jj) = SUM( v_s(ji,jj,:) - zvsold(ji,jj,:) ) * r1_rdtice
- END DO
- END DO
+
+ !--------------------------------------
+ ! Impose a_i < amax in mono-category
+ !--------------------------------------
+ !
+ IF ( ( nn_monocat == 2 ) .AND. ( jpl == 1 ) ) THEN ! simple conservative piling, comparable with LIM2
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ a_i(ji,jj,1) = MIN( a_i(ji,jj,1), rn_amax )
+ END DO
+ END DO
+ ENDIF
! --- agglomerate variables -----------------
@@ -436,23 +431,19 @@
vt_s (:,:) = 0._wp
at_i (:,:) = 0._wp
- !
DO jl = 1, jpl
DO jj = 1, jpj
DO ji = 1, jpi
- !
- vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) ! ice volume
- vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) ! snow volume
- at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration
- END DO
- END DO
- END DO
- ! -------------------------------------------------
-
- ! open water
+ vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl)
+ vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl)
+ at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl)
+ END DO
+ END DO
+ END DO
+
+ ! --- open water = 1 if at_i=0 --------------------------------
DO jj = 1, jpj
DO ji = 1, jpi
- ! open water = 1 if at_i=0
rswitch = MAX( 0._wp , SIGN( 1._wp, - at_i(ji,jj) ) )
- ato_i(ji,jj) = rswitch + (1._wp - rswitch ) * zs0ow(ji,jj)
+ ato_i(ji,jj) = rswitch + (1._wp - rswitch ) * ato_i(ji,jj)
END DO
END DO
@@ -463,43 +454,17 @@
ENDIF
- IF(ln_ctl) THEN ! Control print
- CALL prt_ctl_info(' ')
- CALL prt_ctl_info(' - Cell values : ')
- CALL prt_ctl_info(' ~~~~~~~~~~~~~ ')
- CALL prt_ctl(tab2d_1=area , clinfo1=' lim_trp : cell area :')
- CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_trp : at_i :')
- CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_trp : vt_i :')
- CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_trp : vt_s :')
- DO jl = 1, jpl
- CALL prt_ctl_info(' ')
- CALL prt_ctl_info(' - Category : ', ivar1=jl)
- CALL prt_ctl_info(' ~~~~~~~~~~')
- CALL prt_ctl(tab2d_1=a_i (:,:,jl) , clinfo1= ' lim_trp : a_i : ')
- CALL prt_ctl(tab2d_1=ht_i (:,:,jl) , clinfo1= ' lim_trp : ht_i : ')
- CALL prt_ctl(tab2d_1=ht_s (:,:,jl) , clinfo1= ' lim_trp : ht_s : ')
- CALL prt_ctl(tab2d_1=v_i (:,:,jl) , clinfo1= ' lim_trp : v_i : ')
- CALL prt_ctl(tab2d_1=v_s (:,:,jl) , clinfo1= ' lim_trp : v_s : ')
- CALL prt_ctl(tab2d_1=e_s (:,:,1,jl) , clinfo1= ' lim_trp : e_s : ')
- CALL prt_ctl(tab2d_1=t_su (:,:,jl) , clinfo1= ' lim_trp : t_su : ')
- CALL prt_ctl(tab2d_1=t_s (:,:,1,jl) , clinfo1= ' lim_trp : t_snow : ')
- CALL prt_ctl(tab2d_1=sm_i (:,:,jl) , clinfo1= ' lim_trp : sm_i : ')
- CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' lim_trp : smv_i : ')
- DO jk = 1, nlay_i
- CALL prt_ctl_info(' ')
- CALL prt_ctl_info(' - Layer : ', ivar1=jk)
- CALL prt_ctl_info(' ~~~~~~~')
- CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_trp : t_i : ')
- CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_trp : e_i : ')
- END DO
- END DO
- ENDIF
+ ! -------------------------------------------------
+ ! control prints
+ ! -------------------------------------------------
+ IF( ln_icectl ) CALL lim_prt( kt, iiceprt, jiceprt,-1, ' - ice dyn & trp - ' )
!
- CALL wrk_dealloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow, zeiold, zesold )
- CALL wrk_dealloc( jpi, jpj, jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi )
- CALL wrk_dealloc( jpi, jpj, nlay_i+1, jpl, zs0e )
-
- CALL wrk_dealloc( jpi, jpj, jpl, zviold, zvsold, zaiold, zhimax ) ! clem
+ CALL wrk_dealloc( jpi,jpj, zsm, zatold, zeiold, zesold )
+ CALL wrk_dealloc( jpi,jpj,jpl, z0ice, z0snw, z0ai, z0es , z0smi , z0oi )
+ CALL wrk_dealloc( jpi,jpj,1, z0opw )
+ CALL wrk_dealloc( jpi,jpj,nlay_i,jpl, z0ei )
+ CALL wrk_dealloc( jpi,jpj,jpl, zviold, zvsold, zhimax, zsmvold )
!
IF( nn_timing == 1 ) CALL timing_stop('limtrp')
+
END SUBROUTINE lim_trp
@@ -512,5 +477,4 @@
END SUBROUTINE lim_trp
#endif
-
!!======================================================================
END MODULE limtrp
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90 (revision 5602)
@@ -5,5 +5,5 @@
!!======================================================================
!! History : 3.0 ! 2006-04 (M. Vancoppenolle) Original code
- !! 3.6 ! 2014-06 (C. Rousset) Complete rewriting/cleaning
+ !! 3.5 ! 2014-06 (C. Rousset) Complete rewriting/cleaning
!!----------------------------------------------------------------------
#if defined key_lim3
@@ -13,40 +13,25 @@
!! lim_update1 : computes update of sea-ice global variables from trend terms
!!----------------------------------------------------------------------
- USE limrhg ! ice rheology
-
- USE dom_oce
- USE oce ! dynamics and tracers variables
- USE in_out_manager
USE sbc_oce ! Surface boundary condition: ocean fields
USE sbc_ice ! Surface boundary condition: ice fields
USE dom_ice
+ USE dom_oce
USE phycst ! physical constants
USE ice
- USE limdyn
- USE limtrp
- USE limthd
- USE limsbc
- USE limdiahsb
- USE limwri
- USE limrst
USE thd_ice ! LIM thermodynamic sea-ice variables
- USE par_ice
USE limitd_th
- USE limitd_me
USE limvar
- USE prtctl ! Print control
- USE lbclnk ! lateral boundary condition - MPP exchanges
- USE wrk_nemo ! work arrays
- USE lib_fortran ! glob_sum
- USE in_out_manager ! I/O manager
- USE iom ! I/O manager
- USE lib_mpp ! MPP library
+ USE prtctl ! Print control
+ USE wrk_nemo ! work arrays
USE timing ! Timing
- USE limcons ! conservation tests
+ USE limcons ! conservation tests
+ USE lib_mpp ! MPP library
+ USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+ USE in_out_manager ! I/O manager
IMPLICIT NONE
PRIVATE
- PUBLIC lim_update1 ! routine called by ice_step
+ PUBLIC lim_update1
!! * Substitutions
@@ -54,10 +39,10 @@
!!----------------------------------------------------------------------
!! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
- !! $Id: limupdate.F90 3294 2012-01-28 16:44:18Z rblod $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
CONTAINS
- SUBROUTINE lim_update1
+ SUBROUTINE lim_update1( kt )
!!-------------------------------------------------------------------
!! *** ROUTINE lim_update1 ***
@@ -67,9 +52,8 @@
!!
!!---------------------------------------------------------------------
+ INTEGER, INTENT(in) :: kt ! number of iteration
INTEGER :: ji, jj, jk, jl ! dummy loop indices
- INTEGER :: i_ice_switch
REAL(wp) :: zsal
- !
- REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b
+ REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b
!!-------------------------------------------------------------------
IF( nn_timing == 1 ) CALL timing_start('limupdate1')
@@ -77,19 +61,15 @@
IF( ln_limdyn ) THEN
+ IF( kt == nit000 .AND. lwp ) THEN
+ WRITE(numout,*) ' lim_update1 '
+ WRITE(numout,*) ' ~~~~~~~~~~~ '
+ ENDIF
+
! conservation test
IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
- !-----------------
- ! zap small values
- !-----------------
- CALL lim_itd_me_zapsmall
-
- CALL lim_var_glo2eqv
-
!----------------------------------------------------
- ! Rebin categories with thickness out of bounds
- !----------------------------------------------------
- IF ( jpl > 1 ) CALL lim_itd_th_reb(1, jpl)
-
+ ! ice concentration should not exceed amax
+ !-----------------------------------------------------
at_i(:,:) = 0._wp
DO jl = 1, jpl
@@ -97,45 +77,26 @@
END DO
- !----------------------------------------------------
- ! ice concentration should not exceed amax
- !-----------------------------------------------------
DO jl = 1, jpl
DO jj = 1, jpj
DO ji = 1, jpi
- IF( at_i(ji,jj) > amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN
- a_i(ji,jj,jl) = a_i(ji,jj,jl) * ( 1._wp - ( 1._wp - amax / at_i(ji,jj) ) )
- ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl)
+ IF( at_i(ji,jj) > rn_amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN
+ a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) )
+ oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) )
ENDIF
END DO
END DO
END DO
-
- at_i(:,:) = 0._wp
- DO jl = 1, jpl
- at_i(:,:) = a_i(:,:,jl) + at_i(:,:)
- END DO
- ! --------------------------------------
- ! Final thickness distribution rebinning
- ! --------------------------------------
- IF ( jpl > 1 ) CALL lim_itd_th_reb(1, jpl)
-
- !-----------------
- ! zap small values
- !-----------------
- CALL lim_itd_me_zapsmall
-
!---------------------
! Ice salinity bounds
!---------------------
- IF ( num_sal == 2 ) THEN
+ IF ( nn_icesal == 2 ) THEN
DO jl = 1, jpl
DO jj = 1, jpj
DO ji = 1, jpi
zsal = smv_i(ji,jj,jl)
- smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl)
! salinity stays in bounds
- i_ice_switch = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) )
- smv_i(ji,jj,jl) = i_ice_switch * MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) )
+ rswitch = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) )
+ smv_i(ji,jj,jl) = rswitch * MAX( MIN( rn_simax * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), rn_simin * v_i(ji,jj,jl) )
! associated salt flux
sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice
@@ -145,26 +106,45 @@
ENDIF
+ !----------------------------------------------------
+ ! Rebin categories with thickness out of bounds
+ !----------------------------------------------------
+ IF ( jpl > 1 ) CALL lim_itd_th_reb(1, jpl)
+
+ !-----------------
+ ! zap small values
+ !-----------------
+ CALL lim_var_zapsmall
+
! -------------------------------------------------
! Diagnostics
! -------------------------------------------------
- d_u_ice_dyn(:,:) = u_ice(:,:) - u_ice_b(:,:)
- d_v_ice_dyn(:,:) = v_ice(:,:) - v_ice_b(:,:)
- d_a_i_trp (:,:,:) = a_i (:,:,:) - a_i_b (:,:,:)
- d_v_s_trp (:,:,:) = v_s (:,:,:) - v_s_b (:,:,:)
- d_v_i_trp (:,:,:) = v_i (:,:,:) - v_i_b (:,:,:)
- d_e_s_trp (:,:,:,:) = e_s (:,:,:,:) - e_s_b (:,:,:,:)
- d_e_i_trp (:,:,1:nlay_i,:) = e_i (:,:,1:nlay_i,:) - e_i_b(:,:,1:nlay_i,:)
- d_oa_i_trp (:,:,:) = oa_i (:,:,:) - oa_i_b (:,:,:)
- d_smv_i_trp(:,:,:) = 0._wp
- IF( num_sal == 2 ) d_smv_i_trp(:,:,:) = smv_i(:,:,:) - smv_i_b(:,:,:)
+ DO jl = 1, jpl
+ afx_dyn(:,:) = afx_dyn(:,:) + ( a_i(:,:,jl) - a_i_b(:,:,jl) ) * r1_rdtice
+ END DO
+
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ ! heat content variation (W.m-2)
+ diag_heat(ji,jj) = - ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) + &
+ & SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) ) &
+ & ) * r1_rdtice
+ ! salt, volume
+ diag_smvi(ji,jj) = SUM( smv_i(ji,jj,:) - smv_i_b(ji,jj,:) ) * rhoic * r1_rdtice
+ diag_vice(ji,jj) = SUM( v_i (ji,jj,:) - v_i_b (ji,jj,:) ) * rhoic * r1_rdtice
+ diag_vsnw(ji,jj) = SUM( v_s (ji,jj,:) - v_s_b (ji,jj,:) ) * rhosn * r1_rdtice
+ END DO
+ END DO
! conservation test
IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+ ! -------------------------------------------------
+ ! control prints
+ ! -------------------------------------------------
IF(ln_ctl) THEN ! Control print
CALL prt_ctl_info(' ')
CALL prt_ctl_info(' - Cell values : ')
CALL prt_ctl_info(' ~~~~~~~~~~~~~ ')
- CALL prt_ctl(tab2d_1=area , clinfo1=' lim_update1 : cell area :')
+ CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_update1 : cell area :')
CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_update1 : at_i :')
CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_update1 : vt_i :')
@@ -172,5 +152,4 @@
CALL prt_ctl(tab2d_1=strength , clinfo1=' lim_update1 : strength :')
CALL prt_ctl(tab2d_1=u_ice , clinfo1=' lim_update1 : u_ice :', tab2d_2=v_ice , clinfo2=' v_ice :')
- CALL prt_ctl(tab2d_1=d_u_ice_dyn, clinfo1=' lim_update1 : d_u_ice_dyn :', tab2d_2=d_v_ice_dyn, clinfo2=' d_v_ice_dyn :')
CALL prt_ctl(tab2d_1=u_ice_b , clinfo1=' lim_update1 : u_ice_b :', tab2d_2=v_ice_b , clinfo2=' v_ice_b :')
@@ -187,26 +166,18 @@
CALL prt_ctl(tab2d_1=a_i (:,:,jl) , clinfo1= ' lim_update1 : a_i : ')
CALL prt_ctl(tab2d_1=a_i_b (:,:,jl) , clinfo1= ' lim_update1 : a_i_b : ')
- CALL prt_ctl(tab2d_1=d_a_i_trp (:,:,jl) , clinfo1= ' lim_update1 : d_a_i_trp : ')
CALL prt_ctl(tab2d_1=v_i (:,:,jl) , clinfo1= ' lim_update1 : v_i : ')
CALL prt_ctl(tab2d_1=v_i_b (:,:,jl) , clinfo1= ' lim_update1 : v_i_b : ')
- CALL prt_ctl(tab2d_1=d_v_i_trp (:,:,jl) , clinfo1= ' lim_update1 : d_v_i_trp : ')
CALL prt_ctl(tab2d_1=v_s (:,:,jl) , clinfo1= ' lim_update1 : v_s : ')
CALL prt_ctl(tab2d_1=v_s_b (:,:,jl) , clinfo1= ' lim_update1 : v_s_b : ')
- CALL prt_ctl(tab2d_1=d_v_s_trp (:,:,jl) , clinfo1= ' lim_update1 : d_v_s_trp : ')
- CALL prt_ctl(tab2d_1=e_i (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1 : e_i1 : ')
- CALL prt_ctl(tab2d_1=e_i_b (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1 : e_i1_b : ')
- CALL prt_ctl(tab2d_1=d_e_i_trp (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1 : de_i1_trp : ')
- CALL prt_ctl(tab2d_1=e_i (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1 : e_i2 : ')
- CALL prt_ctl(tab2d_1=e_i_b (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1 : e_i2_b : ')
- CALL prt_ctl(tab2d_1=d_e_i_trp (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1 : de_i2_trp : ')
+ CALL prt_ctl(tab2d_1=e_i (:,:,1,jl) , clinfo1= ' lim_update1 : e_i1 : ')
+ CALL prt_ctl(tab2d_1=e_i_b (:,:,1,jl) , clinfo1= ' lim_update1 : e_i1_b : ')
+ CALL prt_ctl(tab2d_1=e_i (:,:,2,jl) , clinfo1= ' lim_update1 : e_i2 : ')
+ CALL prt_ctl(tab2d_1=e_i_b (:,:,2,jl) , clinfo1= ' lim_update1 : e_i2_b : ')
CALL prt_ctl(tab2d_1=e_s (:,:,1,jl) , clinfo1= ' lim_update1 : e_snow : ')
CALL prt_ctl(tab2d_1=e_s_b (:,:,1,jl) , clinfo1= ' lim_update1 : e_snow_b : ')
- CALL prt_ctl(tab2d_1=d_e_s_trp (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1 : d_e_s_trp : ')
CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' lim_update1 : smv_i : ')
CALL prt_ctl(tab2d_1=smv_i_b (:,:,jl) , clinfo1= ' lim_update1 : smv_i_b : ')
- CALL prt_ctl(tab2d_1=d_smv_i_trp(:,:,jl) , clinfo1= ' lim_update1 : d_smv_i_trp : ')
CALL prt_ctl(tab2d_1=oa_i (:,:,jl) , clinfo1= ' lim_update1 : oa_i : ')
CALL prt_ctl(tab2d_1=oa_i_b (:,:,jl) , clinfo1= ' lim_update1 : oa_i_b : ')
- CALL prt_ctl(tab2d_1=d_oa_i_trp (:,:,jl) , clinfo1= ' lim_update1 : d_oa_i_trp : ')
DO jk = 1, nlay_i
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90 (revision 5602)
@@ -5,5 +5,5 @@
!!======================================================================
!! History : 3.0 ! 2006-04 (M. Vancoppenolle) Original code
- !! 3.6 ! 2014-06 (C. Rousset) Complete rewriting/cleaning
+ !! 3.5 ! 2014-06 (C. Rousset) Complete rewriting/cleaning
!!----------------------------------------------------------------------
#if defined key_lim3
@@ -13,32 +13,22 @@
!! lim_update2 : computes update of sea-ice global variables from trend terms
!!----------------------------------------------------------------------
- USE limrhg ! ice rheology
-
- USE dom_oce
- USE oce ! dynamics and tracers variables
- USE in_out_manager
USE sbc_oce ! Surface boundary condition: ocean fields
USE sbc_ice ! Surface boundary condition: ice fields
USE dom_ice
+ USE dom_oce
USE phycst ! physical constants
USE ice
- USE limdyn
- USE limtrp
- USE limthd
- USE limsbc
- USE limdiahsb
- USE limwri
- USE limrst
USE thd_ice ! LIM thermodynamic sea-ice variables
- USE par_ice
USE limitd_th
- USE limitd_me
USE limvar
- USE prtctl ! Print control
- USE lbclnk ! lateral boundary condition - MPP exchanges
- USE wrk_nemo ! work arrays
- USE lib_fortran ! glob_sum
+ USE prtctl ! Print control
+ USE lbclnk ! lateral boundary condition - MPP exchanges
+ USE wrk_nemo ! work arrays
USE timing ! Timing
- USE limcons ! conservation tests
+ USE limcons ! conservation tests
+ USE limctl
+ USE lib_mpp ! MPP library
+ USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+ USE in_out_manager
IMPLICIT NONE
@@ -51,10 +41,10 @@
!!----------------------------------------------------------------------
!! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
- !! $Id: limupdate.F90 3294 2012-01-28 16:44:18Z rblod $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
CONTAINS
- SUBROUTINE lim_update2
+ SUBROUTINE lim_update2( kt )
!!-------------------------------------------------------------------
!! *** ROUTINE lim_update2 ***
@@ -64,37 +54,29 @@
!!
!!---------------------------------------------------------------------
- INTEGER :: ji, jj, jk, jl ! dummy loop indices
- INTEGER :: i_ice_switch
- REAL(wp) :: zh, zsal
- !
- REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b
+ INTEGER, INTENT(in) :: kt ! number of iteration
+ INTEGER :: ji, jj, jk, jl ! dummy loop indices
+ REAL(wp) :: zsal
+ REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b
!!-------------------------------------------------------------------
IF( nn_timing == 1 ) CALL timing_start('limupdate2')
+ IF( kt == nit000 .AND. lwp ) THEN
+ WRITE(numout,*) ' lim_update2 '
+ WRITE(numout,*) ' ~~~~~~~~~~~ '
+ ENDIF
+
! conservation test
IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
- !-----------------
- ! zap small values
- !-----------------
- CALL lim_itd_me_zapsmall
-
- CALL lim_var_glo2eqv
-
- !----------------------------------------------------
- ! Rebin categories with thickness out of bounds
- !----------------------------------------------------
- IF ( jpl > 1 ) CALL lim_itd_th_reb(1, jpl)
-
!----------------------------------------------------------------------
- ! Constrain the thickness of the smallest category above hiclim
+ ! Constrain the thickness of the smallest category above himin
!----------------------------------------------------------------------
DO jj = 1, jpj
DO ji = 1, jpi
- IF( v_i(ji,jj,1) > 0._wp .AND. ht_i(ji,jj,1) < hiclim ) THEN
- zh = hiclim / ht_i(ji,jj,1)
- ht_s(ji,jj,1) = ht_s(ji,jj,1) * zh
- ht_i(ji,jj,1) = ht_i(ji,jj,1) * zh
- a_i (ji,jj,1) = a_i(ji,jj,1) / zh
+ rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,1) - epsi20 ) ) !0 if no ice and 1 if yes
+ ht_i(ji,jj,1) = v_i (ji,jj,1) / MAX( a_i(ji,jj,1) , epsi20 ) * rswitch
+ IF( v_i(ji,jj,1) > 0._wp .AND. ht_i(ji,jj,1) < rn_himin ) THEN
+ a_i (ji,jj,1) = a_i (ji,jj,1) * ht_i(ji,jj,1) / rn_himin
+ oa_i(ji,jj,1) = oa_i(ji,jj,1) * ht_i(ji,jj,1) / rn_himin
ENDIF
END DO
@@ -112,7 +94,7 @@
DO jj = 1, jpj
DO ji = 1, jpi
- IF( at_i(ji,jj) > amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN
- a_i(ji,jj,jl) = a_i(ji,jj,jl) * ( 1._wp - ( 1._wp - amax / at_i(ji,jj) ) )
- ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl)
+ IF( at_i(ji,jj) > rn_amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN
+ a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) )
+ oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) )
ENDIF
END DO
@@ -120,40 +102,34 @@
END DO
- at_i(:,:) = 0.0
- DO jl = 1, jpl
- at_i(:,:) = a_i(:,:,jl) + at_i(:,:)
- END DO
-
- ! --------------------------------------
- ! Final thickness distribution rebinning
- ! --------------------------------------
- IF ( jpl > 1 ) CALL lim_itd_th_reb( 1, jpl )
-
- !-----------------
- ! zap small values
- !-----------------
- CALL lim_itd_me_zapsmall
-
!---------------------
- ! 2.11) Ice salinity
+ ! Ice salinity
!---------------------
- IF ( num_sal == 2 ) THEN
+ IF ( nn_icesal == 2 ) THEN
DO jl = 1, jpl
DO jj = 1, jpj
DO ji = 1, jpi
zsal = smv_i(ji,jj,jl)
- smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl)
! salinity stays in bounds
- i_ice_switch = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) )
- smv_i(ji,jj,jl) = i_ice_switch * MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) ) !+ s_i_min * ( 1._wp - i_ice_switch ) * v_i(ji,jj,jl)
+ rswitch = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) )
+ smv_i(ji,jj,jl) = rswitch * MAX( MIN( rn_simax * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), rn_simin * v_i(ji,jj,jl) )
! associated salt flux
sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice
- END DO ! ji
- END DO ! jj
- END DO !jl
+ END DO
+ END DO
+ END DO
ENDIF
+ !----------------------------------------------------
+ ! Rebin categories with thickness out of bounds
+ !----------------------------------------------------
+ IF ( jpl > 1 ) CALL lim_itd_th_reb( 1, jpl )
+
+ !-----------------
+ ! zap small values
+ !-----------------
+ CALL lim_var_zapsmall
+
!------------------------------------------------------------------------------
- ! 2) Corrections to avoid wrong values |
+ ! Corrections to avoid wrong values |
!------------------------------------------------------------------------------
! Ice drift
@@ -173,32 +149,41 @@
CALL lbc_lnk( v_ice(:,:), 'V', -1. )
!mask velocities
- u_ice(:,:) = u_ice(:,:) * tmu(:,:)
- v_ice(:,:) = v_ice(:,:) * tmv(:,:)
+ u_ice(:,:) = u_ice(:,:) * umask(:,:,1)
+ v_ice(:,:) = v_ice(:,:) * vmask(:,:,1)
! -------------------------------------------------
! Diagnostics
! -------------------------------------------------
- d_a_i_thd(:,:,:) = a_i(:,:,:) - a_i_b(:,:,:)
- d_v_s_thd(:,:,:) = v_s(:,:,:) - v_s_b(:,:,:)
- d_v_i_thd(:,:,:) = v_i(:,:,:) - v_i_b(:,:,:)
- d_e_s_thd(:,:,:,:) = e_s(:,:,:,:) - e_s_b(:,:,:,:)
- d_e_i_thd(:,:,1:nlay_i,:) = e_i(:,:,1:nlay_i,:) - e_i_b(:,:,1:nlay_i,:)
- !?? d_oa_i_thd(:,:,:) = oa_i (:,:,:) - oa_i_b (:,:,:)
- d_smv_i_thd(:,:,:) = 0._wp
- IF( num_sal == 2 ) d_smv_i_thd(:,:,:) = smv_i(:,:,:) - smv_i_b(:,:,:)
- ! diag only (clem)
- dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) * r1_rdtice * rday
-
- ! heat content variation (W.m-2)
+ DO jl = 1, jpl
+ oa_i(:,:,jl) = oa_i(:,:,jl) + a_i(:,:,jl) * rdt_ice / rday ! ice natural aging
+ afx_thd(:,:) = afx_thd(:,:) + ( a_i(:,:,jl) - a_i_b(:,:,jl) ) * r1_rdtice
+ END DO
+ afx_tot = afx_thd + afx_dyn
+
DO jj = 1, jpj
DO ji = 1, jpi
- diag_heat_dhc(ji,jj) = ( SUM( d_e_i_trp(ji,jj,1:nlay_i,:) + d_e_i_thd(ji,jj,1:nlay_i,:) ) + &
- & SUM( d_e_s_trp(ji,jj,1:nlay_s,:) + d_e_s_thd(ji,jj,1:nlay_s,:) ) &
- & ) * unit_fac * r1_rdtice / area(ji,jj)
+ ! heat content variation (W.m-2)
+ diag_heat(ji,jj) = diag_heat(ji,jj) - &
+ & ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) + &
+ & SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) ) &
+ & ) * r1_rdtice
+ ! salt, volume
+ diag_smvi(ji,jj) = diag_smvi(ji,jj) + SUM( smv_i(ji,jj,:) - smv_i_b(ji,jj,:) ) * rhoic * r1_rdtice
+ diag_vice(ji,jj) = diag_vice(ji,jj) + SUM( v_i (ji,jj,:) - v_i_b (ji,jj,:) ) * rhoic * r1_rdtice
+ diag_vsnw(ji,jj) = diag_vsnw(ji,jj) + SUM( v_s (ji,jj,:) - v_s_b (ji,jj,:) ) * rhosn * r1_rdtice
END DO
END DO
! conservation test
- IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+ IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
+
+ ! necessary calls (at least for coupling)
+ CALL lim_var_glo2eqv
+ CALL lim_var_agg(2)
+
+ ! -------------------------------------------------
+ ! control prints
+ ! -------------------------------------------------
+ IF( ln_icectl ) CALL lim_prt( kt, iiceprt, jiceprt, 2, ' - Final state - ' ) ! control print
IF(ln_ctl) THEN ! Control print
@@ -206,5 +191,5 @@
CALL prt_ctl_info(' - Cell values : ')
CALL prt_ctl_info(' ~~~~~~~~~~~~~ ')
- CALL prt_ctl(tab2d_1=area , clinfo1=' lim_update2 : cell area :')
+ CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_update2 : cell area :')
CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_update2 : at_i :')
CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_update2 : vt_i :')
@@ -226,26 +211,18 @@
CALL prt_ctl(tab2d_1=a_i (:,:,jl) , clinfo1= ' lim_update2 : a_i : ')
CALL prt_ctl(tab2d_1=a_i_b (:,:,jl) , clinfo1= ' lim_update2 : a_i_b : ')
- CALL prt_ctl(tab2d_1=d_a_i_thd (:,:,jl) , clinfo1= ' lim_update2 : d_a_i_thd : ')
CALL prt_ctl(tab2d_1=v_i (:,:,jl) , clinfo1= ' lim_update2 : v_i : ')
CALL prt_ctl(tab2d_1=v_i_b (:,:,jl) , clinfo1= ' lim_update2 : v_i_b : ')
- CALL prt_ctl(tab2d_1=d_v_i_thd (:,:,jl) , clinfo1= ' lim_update2 : d_v_i_thd : ')
CALL prt_ctl(tab2d_1=v_s (:,:,jl) , clinfo1= ' lim_update2 : v_s : ')
CALL prt_ctl(tab2d_1=v_s_b (:,:,jl) , clinfo1= ' lim_update2 : v_s_b : ')
- CALL prt_ctl(tab2d_1=d_v_s_thd (:,:,jl) , clinfo1= ' lim_update2 : d_v_s_thd : ')
- CALL prt_ctl(tab2d_1=e_i (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2 : e_i1 : ')
- CALL prt_ctl(tab2d_1=e_i_b (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2 : e_i1_b : ')
- CALL prt_ctl(tab2d_1=d_e_i_thd (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2 : de_i1_thd : ')
- CALL prt_ctl(tab2d_1=e_i (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2 : e_i2 : ')
- CALL prt_ctl(tab2d_1=e_i_b (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2 : e_i2_b : ')
- CALL prt_ctl(tab2d_1=d_e_i_thd (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2 : de_i2_thd : ')
+ CALL prt_ctl(tab2d_1=e_i (:,:,1,jl) , clinfo1= ' lim_update2 : e_i1 : ')
+ CALL prt_ctl(tab2d_1=e_i_b (:,:,1,jl) , clinfo1= ' lim_update2 : e_i1_b : ')
+ CALL prt_ctl(tab2d_1=e_i (:,:,2,jl) , clinfo1= ' lim_update2 : e_i2 : ')
+ CALL prt_ctl(tab2d_1=e_i_b (:,:,2,jl) , clinfo1= ' lim_update2 : e_i2_b : ')
CALL prt_ctl(tab2d_1=e_s (:,:,1,jl) , clinfo1= ' lim_update2 : e_snow : ')
CALL prt_ctl(tab2d_1=e_s_b (:,:,1,jl) , clinfo1= ' lim_update2 : e_snow_b : ')
- CALL prt_ctl(tab2d_1=d_e_s_thd (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2 : d_e_s_thd : ')
CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' lim_update2 : smv_i : ')
CALL prt_ctl(tab2d_1=smv_i_b (:,:,jl) , clinfo1= ' lim_update2 : smv_i_b : ')
- CALL prt_ctl(tab2d_1=d_smv_i_thd(:,:,jl) , clinfo1= ' lim_update2 : d_smv_i_thd : ')
CALL prt_ctl(tab2d_1=oa_i (:,:,jl) , clinfo1= ' lim_update2 : oa_i : ')
CALL prt_ctl(tab2d_1=oa_i_b (:,:,jl) , clinfo1= ' lim_update2 : oa_i_b : ')
- CALL prt_ctl(tab2d_1=d_oa_i_thd (:,:,jl) , clinfo1= ' lim_update2 : d_oa_i_thd : ')
DO jk = 1, nlay_i
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90 (revision 5602)
@@ -30,5 +30,5 @@
!!======================================================================
!! History : - ! 2006-01 (M. Vancoppenolle) Original code
- !! 4.0 ! 2011-02 (G. Madec) dynamical allocation
+ !! 3.4 ! 2011-02 (G. Madec) dynamical allocation
!!----------------------------------------------------------------------
#if defined key_lim3
@@ -36,16 +36,8 @@
!! 'key_lim3' LIM3 sea-ice model
!!----------------------------------------------------------------------
- !! lim_var_agg :
- !! lim_var_glo2eqv :
- !! lim_var_eqv2glo :
- !! lim_var_salprof :
- !! lim_var_salprof1d :
- !! lim_var_bv :
- !!----------------------------------------------------------------------
USE par_oce ! ocean parameters
USE phycst ! physical constants (ocean directory)
USE sbc_oce ! Surface boundary condition: ocean fields
USE ice ! ice variables
- USE par_ice ! ice parameters
USE thd_ice ! ice variables (thermodynamics)
USE dom_ice ! ice domain
@@ -58,14 +50,16 @@
PRIVATE
- PUBLIC lim_var_agg !
- PUBLIC lim_var_glo2eqv !
- PUBLIC lim_var_eqv2glo !
- PUBLIC lim_var_salprof !
- PUBLIC lim_var_icetm !
- PUBLIC lim_var_bv !
- PUBLIC lim_var_salprof1d !
+ PUBLIC lim_var_agg
+ PUBLIC lim_var_glo2eqv
+ PUBLIC lim_var_eqv2glo
+ PUBLIC lim_var_salprof
+ PUBLIC lim_var_icetm
+ PUBLIC lim_var_bv
+ PUBLIC lim_var_salprof1d
+ PUBLIC lim_var_zapsmall
+ PUBLIC lim_var_itd
!!----------------------------------------------------------------------
- !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
+ !! NEMO/LIM3 3.5 , UCL - NEMO Consortium (2011)
!! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
@@ -129,9 +123,9 @@
DO jj = 1, jpj
DO ji = 1, jpi
- et_s(ji,jj) = et_s(ji,jj) + e_s(ji,jj,1,jl) ! snow heat content
- rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) )
- smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , epsi10 ) * rswitch ! ice salinity
- rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) )
- ot_i(ji,jj) = ot_i(ji,jj) + oa_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi10 ) * rswitch ! ice age
+ et_s(ji,jj) = et_s(ji,jj) + e_s(ji,jj,1,jl) ! snow heat content
+ rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi20 ) )
+ smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , epsi20 ) * rswitch ! ice salinity
+ rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi20 ) )
+ ot_i(ji,jj) = ot_i(ji,jj) + oa_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi20 ) * rswitch ! ice age
END DO
END DO
@@ -167,18 +161,20 @@
DO jj = 1, jpj
DO ji = 1, jpi
- rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) + epsi10 ) ) !0 if no ice and 1 if yes
- ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * rswitch
- ht_s(ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * rswitch
- o_i(ji,jj,jl) = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * rswitch
- END DO
- END DO
- END DO
-
- IF( num_sal == 2 )THEN
+ rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) ) !0 if no ice and 1 if yes
+ ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
+ ht_s(ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
+ o_i(ji,jj,jl) = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
+ END DO
+ END DO
+ END DO
+
+ IF( nn_icesal == 2 )THEN
DO jl = 1, jpl
DO jj = 1, jpj
DO ji = 1, jpi
- rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) + epsi10 ) ) !0 if no ice and 1 if yes
- sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX( v_i(ji,jj,jl) , epsi10 ) * rswitch
+ rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) - epsi20 ) ) !0 if no ice and 1 if yes
+ sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX( v_i(ji,jj,jl) , epsi20 ) * rswitch
+ ! ! bounding salinity
+ sm_i(ji,jj,jl) = MAX( sm_i(ji,jj,jl), rn_simin )
END DO
END DO
@@ -191,24 +187,19 @@
! Ice temperatures
!-------------------
-!CDIR NOVERRCHK
- DO jl = 1, jpl
-!CDIR NOVERRCHK
+ DO jl = 1, jpl
DO jk = 1, nlay_i
-!CDIR NOVERRCHK
DO jj = 1, jpj
-!CDIR NOVERRCHK
DO ji = 1, jpi
! ! Energy of melting q(S,T) [J.m-3]
- rswitch = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 ) ) ! rswitch = 0 if no ice and 1 if yes
- zq_i = rswitch * e_i(ji,jj,jk,jl) / area(ji,jj) / MAX( v_i(ji,jj,jl) , epsi10 ) * REAL(nlay_i,wp)
- zq_i = zq_i * unit_fac !convert units
- ztmelts = -tmut * s_i(ji,jj,jk,jl) + rtt ! Ice layer melt temperature
+ rswitch = MAX( 0.0 , SIGN( 1.0 , v_i(ji,jj,jl) - epsi20 ) ) ! rswitch = 0 if no ice and 1 if yes
+ zq_i = rswitch * e_i(ji,jj,jk,jl) / MAX( v_i(ji,jj,jl) , epsi20 ) * REAL(nlay_i,wp)
+ ztmelts = -tmut * s_i(ji,jj,jk,jl) + rt0 ! Ice layer melt temperature
!
zaaa = cpic ! Conversion q(S,T) -> T (second order equation)
- zbbb = ( rcp - cpic ) * ( ztmelts - rtt ) + zq_i / rhoic - lfus
- zccc = lfus * (ztmelts-rtt)
+ zbbb = ( rcp - cpic ) * ( ztmelts - rt0 ) + zq_i * r1_rhoic - lfus
+ zccc = lfus * (ztmelts-rt0)
zdiscrim = SQRT( MAX(zbbb*zbbb - 4._wp*zaaa*zccc , 0._wp) )
- t_i(ji,jj,jk,jl) = rtt + rswitch *( - zbbb - zdiscrim ) / ( 2.0 *zaaa )
- t_i(ji,jj,jk,jl) = MIN( rtt, MAX( 173.15_wp, t_i(ji,jj,jk,jl) ) ) ! 100-rtt < t_i < rtt
+ t_i(ji,jj,jk,jl) = rt0 + rswitch *( - zbbb - zdiscrim ) / ( 2.0 *zaaa )
+ t_i(ji,jj,jk,jl) = MIN( ztmelts, MAX( rt0 - 100._wp, t_i(ji,jj,jk,jl) ) ) ! -100 < t_i < ztmelts
END DO
END DO
@@ -226,10 +217,9 @@
DO ji = 1, jpi
!Energy of melting q(S,T) [J.m-3]
- rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - v_s(ji,jj,jl) + epsi10 ) ) ! rswitch = 0 if no ice and 1 if yes
- zq_s = rswitch * e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL(nlay_s,wp)
- zq_s = zq_s * unit_fac ! convert units
+ rswitch = MAX( 0._wp , SIGN( 1._wp , v_s(ji,jj,jl) - epsi20 ) ) ! rswitch = 0 if no ice and 1 if yes
+ zq_s = rswitch * e_s(ji,jj,jk,jl) / MAX( v_s(ji,jj,jl) , epsi20 ) * REAL(nlay_s,wp)
!
- t_s(ji,jj,jk,jl) = rtt + rswitch * ( - zfac1 * zq_s + zfac2 )
- t_s(ji,jj,jk,jl) = MIN( rtt, MAX( 173.15, t_s(ji,jj,jk,jl) ) ) ! 100-rtt < t_i < rtt
+ t_s(ji,jj,jk,jl) = rt0 + rswitch * ( - zfac1 * zq_s + zfac2 )
+ t_s(ji,jj,jk,jl) = MIN( rt0, MAX( rt0 - 100._wp , t_s(ji,jj,jk,jl) ) ) ! -100 < t_s < rt0
END DO
END DO
@@ -240,4 +230,9 @@
! Mean temperature
!-------------------
+ vt_i (:,:) = 0._wp
+ DO jl = 1, jpl
+ vt_i(:,:) = vt_i(:,:) + v_i(:,:,jl)
+ END DO
+
tm_i(:,:) = 0._wp
DO jl = 1, jpl
@@ -245,11 +240,12 @@
DO jj = 1, jpj
DO ji = 1, jpi
- rswitch = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) ) )
- tm_i(ji,jj) = tm_i(ji,jj) + rswitch * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl) &
- & / ( REAL(nlay_i,wp) * MAX( vt_i(ji,jj) , epsi10 ) )
- END DO
- END DO
- END DO
- END DO
+ rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) )
+ tm_i(ji,jj) = tm_i(ji,jj) + r1_nlay_i * rswitch * ( t_i(ji,jj,jk,jl) - rt0 ) * v_i(ji,jj,jl) &
+ & / MAX( vt_i(ji,jj) , epsi10 )
+ END DO
+ END DO
+ END DO
+ END DO
+ tm_i = tm_i + rt0
!
END SUBROUTINE lim_var_glo2eqv
@@ -270,5 +266,4 @@
v_s(:,:,:) = ht_s(:,:,:) * a_i(:,:,:)
smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:)
- oa_i (:,:,:) = o_i (:,:,:) * a_i(:,:,:)
!
END SUBROUTINE lim_var_eqv2glo
@@ -281,17 +276,19 @@
!! ** Purpose : computes salinity profile in function of bulk salinity
!!
- !! ** Method : If bulk salinity greater than s_i_1,
+ !! ** Method : If bulk salinity greater than zsi1,
!! the profile is assumed to be constant (S_inf)
- !! If bulk salinity lower than s_i_0,
+ !! If bulk salinity lower than zsi0,
!! the profile is linear with 0 at the surface (S_zero)
- !! If it is between s_i_0 and s_i_1, it is a
+ !! If it is between zsi0 and zsi1, it is a
!! alpha-weighted linear combination of s_inf and s_zero
!!
- !! ** References : Vancoppenolle et al., 2007 (in preparation)
+ !! ** References : Vancoppenolle et al., 2007
!!------------------------------------------------------------------
INTEGER :: ji, jj, jk, jl ! dummy loop index
- REAL(wp) :: dummy_fac0, dummy_fac1, dummy_fac, zsal ! local scalar
- REAL(wp) :: zswi0, zswi01, zswibal, zargtemp , zs_zero ! - -
- REAL(wp), POINTER, DIMENSION(:,:,:) :: z_slope_s, zalpha ! 3D pointer
+ REAL(wp) :: zfac0, zfac1, zsal
+ REAL(wp) :: zswi0, zswi01, zargtemp , zs_zero
+ REAL(wp), POINTER, DIMENSION(:,:,:) :: z_slope_s, zalpha
+ REAL(wp), PARAMETER :: zsi0 = 3.5_wp
+ REAL(wp), PARAMETER :: zsi1 = 4.5_wp
!!------------------------------------------------------------------
@@ -301,10 +298,10 @@
! Vertically constant, constant in time
!---------------------------------------
- IF( num_sal == 1 ) s_i(:,:,:,:) = bulk_sal
+ IF( nn_icesal == 1 ) s_i(:,:,:,:) = rn_icesal
!-----------------------------------
! Salinity profile, varying in time
!-----------------------------------
- IF( num_sal == 2 ) THEN
+ IF( nn_icesal == 2 ) THEN
!
DO jk = 1, nlay_i
@@ -315,11 +312,12 @@
DO jj = 1, jpj
DO ji = 1, jpi
- z_slope_s(ji,jj,jl) = 2._wp * sm_i(ji,jj,jl) / MAX( epsi10 , ht_i(ji,jj,jl) )
- END DO
- END DO
- END DO
- !
- dummy_fac0 = 1._wp / ( s_i_0 - s_i_1 ) ! Weighting factor between zs_zero and zs_inf
- dummy_fac1 = s_i_1 / ( s_i_1 - s_i_0 )
+ rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i(ji,jj,jl) - epsi20 ) )
+ z_slope_s(ji,jj,jl) = rswitch * 2._wp * sm_i(ji,jj,jl) / MAX( epsi20 , ht_i(ji,jj,jl) )
+ END DO
+ END DO
+ END DO
+ !
+ zfac0 = 1._wp / ( zsi0 - zsi1 ) ! Weighting factor between zs_zero and zs_inf
+ zfac1 = zsi1 / ( zsi1 - zsi0 )
!
zalpha(:,:,:) = 0._wp
@@ -327,18 +325,18 @@
DO jj = 1, jpj
DO ji = 1, jpi
- ! zswi0 = 1 if sm_i le s_i_0 and 0 otherwise
- zswi0 = MAX( 0._wp , SIGN( 1._wp , s_i_0 - sm_i(ji,jj,jl) ) )
- ! zswi01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws
- zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp , SIGN( 1._wp , s_i_1 - sm_i(ji,jj,jl) ) )
- ! If 2.sm_i GE sss_m then zswibal = 1
+ ! zswi0 = 1 if sm_i le zsi0 and 0 otherwise
+ zswi0 = MAX( 0._wp , SIGN( 1._wp , zsi0 - sm_i(ji,jj,jl) ) )
+ ! zswi01 = 1 if sm_i is between zsi0 and zsi1 and 0 othws
+ zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp , SIGN( 1._wp , zsi1 - sm_i(ji,jj,jl) ) )
+ ! If 2.sm_i GE sss_m then rswitch = 1
! this is to force a constant salinity profile in the Baltic Sea
- zswibal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i(ji,jj,jl) - sss_m(ji,jj) ) )
- zalpha(ji,jj,jl) = zswi0 + zswi01 * ( sm_i(ji,jj,jl) * dummy_fac0 + dummy_fac1 )
- zalpha(ji,jj,jl) = zalpha(ji,jj,jl) * ( 1._wp - zswibal )
- END DO
- END DO
- END DO
-
- dummy_fac = 1._wp / REAL( nlay_i ) ! Computation of the profile
+ rswitch = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i(ji,jj,jl) - sss_m(ji,jj) ) )
+ zalpha(ji,jj,jl) = zswi0 + zswi01 * ( sm_i(ji,jj,jl) * zfac0 + zfac1 )
+ zalpha(ji,jj,jl) = zalpha(ji,jj,jl) * ( 1._wp - rswitch )
+ END DO
+ END DO
+ END DO
+
+ ! Computation of the profile
DO jl = 1, jpl
DO jk = 1, nlay_i
@@ -346,13 +344,15 @@
DO ji = 1, jpi
! ! linear profile with 0 at the surface
- zs_zero = z_slope_s(ji,jj,jl) * ( REAL(jk,wp) - 0.5_wp ) * ht_i(ji,jj,jl) * dummy_fac
+ zs_zero = z_slope_s(ji,jj,jl) * ( REAL(jk,wp) - 0.5_wp ) * ht_i(ji,jj,jl) * r1_nlay_i
! ! weighting the profile
s_i(ji,jj,jk,jl) = zalpha(ji,jj,jl) * zs_zero + ( 1._wp - zalpha(ji,jj,jl) ) * sm_i(ji,jj,jl)
- END DO ! ji
- END DO ! jj
- END DO ! jk
- END DO ! jl
- !
- ENDIF ! num_sal
+ ! ! bounding salinity
+ s_i(ji,jj,jk,jl) = MIN( rn_simax, MAX( s_i(ji,jj,jk,jl), rn_simin ) )
+ END DO
+ END DO
+ END DO
+ END DO
+ !
+ ENDIF ! nn_icesal
!-------------------------------------------------------
@@ -360,12 +360,11 @@
!-------------------------------------------------------
- IF( num_sal == 3 ) THEN ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30)
+ IF( nn_icesal == 3 ) THEN ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30)
!
sm_i(:,:,:) = 2.30_wp
!
DO jl = 1, jpl
-!CDIR NOVERRCHK
DO jk = 1, nlay_i
- zargtemp = ( REAL(jk,wp) - 0.5_wp ) / REAL(nlay_i,wp)
+ zargtemp = ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i
zsal = 1.6_wp * ( 1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) ) )
s_i(:,:,jk,jl) = zsal
@@ -373,5 +372,5 @@
END DO
!
- ENDIF ! num_sal
+ ENDIF ! nn_icesal
!
CALL wrk_dealloc( jpi, jpj, jpl, z_slope_s, zalpha )
@@ -390,4 +389,9 @@
! Mean sea ice temperature
+ vt_i (:,:) = 0._wp
+ DO jl = 1, jpl
+ vt_i(:,:) = vt_i(:,:) + v_i(:,:,jl)
+ END DO
+
tm_i(:,:) = 0._wp
DO jl = 1, jpl
@@ -395,11 +399,12 @@
DO jj = 1, jpj
DO ji = 1, jpi
- rswitch = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) ) )
- tm_i(ji,jj) = tm_i(ji,jj) + rswitch * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl) &
- & / ( REAL(nlay_i,wp) * MAX( vt_i(ji,jj) , epsi10 ) )
- END DO
- END DO
- END DO
- END DO
+ rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) )
+ tm_i(ji,jj) = tm_i(ji,jj) + r1_nlay_i * rswitch * ( t_i(ji,jj,jk,jl) - rt0 ) * v_i(ji,jj,jl) &
+ & / MAX( vt_i(ji,jj) , epsi10 )
+ END DO
+ END DO
+ END DO
+ END DO
+ tm_i = tm_i + rt0
END SUBROUTINE lim_var_icetm
@@ -420,4 +425,9 @@
!!------------------------------------------------------------------
!
+ vt_i (:,:) = 0._wp
+ DO jl = 1, jpl
+ vt_i(:,:) = vt_i(:,:) + v_i(:,:,jl)
+ END DO
+
bv_i(:,:) = 0._wp
DO jl = 1, jpl
@@ -425,9 +435,9 @@
DO jj = 1, jpj
DO ji = 1, jpi
- rswitch = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , (t_i(ji,jj,jk,jl) - rtt) + epsi10 ) ) )
- zbvi = - rswitch * tmut * s_i(ji,jj,jk,jl) / MIN( t_i(ji,jj,jk,jl) - rtt, - epsi10 ) &
- & * v_i(ji,jj,jl) / REAL(nlay_i,wp)
- rswitch = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) ) )
- bv_i(ji,jj) = bv_i(ji,jj) + rswitch * zbvi / MAX( vt_i(ji,jj) , epsi10 )
+ rswitch = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , (t_i(ji,jj,jk,jl) - rt0) + epsi10 ) ) )
+ zbvi = - rswitch * tmut * s_i(ji,jj,jk,jl) / MIN( t_i(ji,jj,jk,jl) - rt0, - epsi10 ) &
+ & * v_i(ji,jj,jl) * r1_nlay_i
+ rswitch = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi20 ) ) )
+ bv_i(ji,jj) = bv_i(ji,jj) + rswitch * zbvi / MAX( vt_i(ji,jj) , epsi20 )
END DO
END DO
@@ -448,9 +458,11 @@
!
INTEGER :: ji, jk ! dummy loop indices
- INTEGER :: ii, ij ! local integers
- REAL(wp) :: dummy_fac0, dummy_fac1, dummy_fac2, zargtemp, zsal ! local scalars
- REAL(wp) :: zalpha, zswi0, zswi01, zswibal, zs_zero ! - -
+ INTEGER :: ii, ij ! local integers
+ REAL(wp) :: zfac0, zfac1, zargtemp, zsal ! local scalars
+ REAL(wp) :: zalpha, zswi0, zswi01, zs_zero ! - -
!
REAL(wp), POINTER, DIMENSION(:) :: z_slope_s
+ REAL(wp), PARAMETER :: zsi0 = 3.5_wp
+ REAL(wp), PARAMETER :: zsi1 = 4.5_wp
!!---------------------------------------------------------------------
@@ -460,5 +472,5 @@
! Vertically constant, constant in time
!---------------------------------------
- IF( num_sal == 1 ) s_i_1d(:,:) = bulk_sal
+ IF( nn_icesal == 1 ) s_i_1d(:,:) = rn_icesal
!------------------------------------------------------
@@ -466,39 +478,38 @@
!------------------------------------------------------
- IF( num_sal == 2 ) THEN
+ IF( nn_icesal == 2 ) THEN
!
DO ji = kideb, kiut ! Slope of the linear profile zs_zero
- z_slope_s(ji) = 2._wp * sm_i_1d(ji) / MAX( epsi10 , ht_i_1d(ji) )
+ rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i_1d(ji) - epsi20 ) )
+ z_slope_s(ji) = rswitch * 2._wp * sm_i_1d(ji) / MAX( epsi20 , ht_i_1d(ji) )
END DO
! Weighting factor between zs_zero and zs_inf
!---------------------------------------------
- dummy_fac0 = 1._wp / ( s_i_0 - s_i_1 )
- dummy_fac1 = s_i_1 / ( s_i_1 - s_i_0 )
- dummy_fac2 = 1._wp / REAL(nlay_i,wp)
-
-!CDIR NOVERRCHK
+ zfac0 = 1._wp / ( zsi0 - zsi1 )
+ zfac1 = zsi1 / ( zsi1 - zsi0 )
DO jk = 1, nlay_i
-!CDIR NOVERRCHK
DO ji = kideb, kiut
ii = MOD( npb(ji) - 1 , jpi ) + 1
ij = ( npb(ji) - 1 ) / jpi + 1
- ! zswi0 = 1 if sm_i le s_i_0 and 0 otherwise
- zswi0 = MAX( 0._wp , SIGN( 1._wp , s_i_0 - sm_i_1d(ji) ) )
- ! zswi01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws
- zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp , SIGN( 1._wp , s_i_1 - sm_i_1d(ji) ) )
- ! if 2.sm_i GE sss_m then zswibal = 1
+ ! zswi0 = 1 if sm_i le zsi0 and 0 otherwise
+ zswi0 = MAX( 0._wp , SIGN( 1._wp , zsi0 - sm_i_1d(ji) ) )
+ ! zswi01 = 1 if sm_i is between zsi0 and zsi1 and 0 othws
+ zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp , SIGN( 1._wp , zsi1 - sm_i_1d(ji) ) )
+ ! if 2.sm_i GE sss_m then rswitch = 1
! this is to force a constant salinity profile in the Baltic Sea
- zswibal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_1d(ji) - sss_m(ii,ij) ) )
+ rswitch = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_1d(ji) - sss_m(ii,ij) ) )
!
- zalpha = ( zswi0 + zswi01 * ( sm_i_1d(ji) * dummy_fac0 + dummy_fac1 ) ) * ( 1.0 - zswibal )
+ zalpha = ( zswi0 + zswi01 * ( sm_i_1d(ji) * zfac0 + zfac1 ) ) * ( 1._wp - rswitch )
!
- zs_zero = z_slope_s(ji) * ( REAL(jk,wp) - 0.5_wp ) * ht_i_1d(ji) * dummy_fac2
+ zs_zero = z_slope_s(ji) * ( REAL(jk,wp) - 0.5_wp ) * ht_i_1d(ji) * r1_nlay_i
! weighting the profile
s_i_1d(ji,jk) = zalpha * zs_zero + ( 1._wp - zalpha ) * sm_i_1d(ji)
- END DO ! ji
- END DO ! jk
-
- ENDIF ! num_sal
+ ! bounding salinity
+ s_i_1d(ji,jk) = MIN( rn_simax, MAX( s_i_1d(ji,jk), rn_simin ) )
+ END DO
+ END DO
+
+ ENDIF
!-------------------------------------------------------
@@ -506,12 +517,11 @@
!-------------------------------------------------------
- IF( num_sal == 3 ) THEN ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30)
+ IF( nn_icesal == 3 ) THEN ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30)
!
sm_i_1d(:) = 2.30_wp
!
-!CDIR NOVERRCHK
DO jk = 1, nlay_i
- zargtemp = ( REAL(jk,wp) - 0.5_wp ) / REAL(nlay_i,wp)
- zsal = 1.6_wp * ( 1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) ) )
+ zargtemp = ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i
+ zsal = 1.6_wp * ( 1._wp - COS( rpi * zargtemp**( 0.407_wp / ( 0.573_wp + zargtemp ) ) ) )
DO ji = kideb, kiut
s_i_1d(ji,jk) = zsal
@@ -524,4 +534,252 @@
!
END SUBROUTINE lim_var_salprof1d
+
+ SUBROUTINE lim_var_zapsmall
+ !!-------------------------------------------------------------------
+ !! *** ROUTINE lim_var_zapsmall ***
+ !!
+ !! ** Purpose : Remove too small sea ice areas and correct fluxes
+ !!
+ !! history : LIM3.5 - 01-2014 (C. Rousset) original code
+ !!-------------------------------------------------------------------
+ INTEGER :: ji, jj, jl, jk ! dummy loop indices
+ REAL(wp) :: zsal, zvi, zvs, zei, zes
+ !!-------------------------------------------------------------------
+ at_i (:,:) = 0._wp
+ DO jl = 1, jpl
+ at_i(:,:) = at_i(:,:) + a_i(:,:,jl)
+ END DO
+
+ DO jl = 1, jpl
+
+ !-----------------------------------------------------------------
+ ! Zap ice energy and use ocean heat to melt ice
+ !-----------------------------------------------------------------
+ DO jk = 1, nlay_i
+ DO jj = 1 , jpj
+ DO ji = 1 , jpi
+ rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi10 ) )
+ rswitch = MAX( 0._wp , SIGN( 1._wp, at_i(ji,jj ) - epsi10 ) ) * rswitch
+ rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) - epsi10 ) ) * rswitch
+ rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) * rswitch &
+ & / MAX( a_i(ji,jj,jl), epsi10 ) - epsi10 ) ) * rswitch
+ zei = e_i(ji,jj,jk,jl)
+ e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * rswitch
+ t_i(ji,jj,jk,jl) = t_i(ji,jj,jk,jl) * rswitch + rt0 * ( 1._wp - rswitch )
+ ! update exchanges with ocean
+ hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_i(ji,jj,jk,jl) - zei ) * r1_rdtice ! W.m-2 <0
+ END DO
+ END DO
+ END DO
+
+ DO jj = 1 , jpj
+ DO ji = 1 , jpi
+ rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi10 ) )
+ rswitch = MAX( 0._wp , SIGN( 1._wp, at_i(ji,jj ) - epsi10 ) ) * rswitch
+ rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) - epsi10 ) ) * rswitch
+ rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) * rswitch &
+ & / MAX( a_i(ji,jj,jl), epsi10 ) - epsi10 ) ) * rswitch
+ zsal = smv_i(ji,jj, jl)
+ zvi = v_i (ji,jj, jl)
+ zvs = v_s (ji,jj, jl)
+ zes = e_s (ji,jj,1,jl)
+ !-----------------------------------------------------------------
+ ! Zap snow energy
+ !-----------------------------------------------------------------
+ t_s(ji,jj,1,jl) = t_s(ji,jj,1,jl) * rswitch + rt0 * ( 1._wp - rswitch )
+ e_s(ji,jj,1,jl) = e_s(ji,jj,1,jl) * rswitch
+
+ !-----------------------------------------------------------------
+ ! zap ice and snow volume, add water and salt to ocean
+ !-----------------------------------------------------------------
+ ato_i(ji,jj) = a_i (ji,jj,jl) * ( 1._wp - rswitch ) + ato_i(ji,jj)
+ a_i (ji,jj,jl) = a_i (ji,jj,jl) * rswitch
+ v_i (ji,jj,jl) = v_i (ji,jj,jl) * rswitch
+ v_s (ji,jj,jl) = v_s (ji,jj,jl) * rswitch
+ t_su (ji,jj,jl) = t_su (ji,jj,jl) * rswitch + t_bo(ji,jj) * ( 1._wp - rswitch )
+ oa_i (ji,jj,jl) = oa_i (ji,jj,jl) * rswitch
+ smv_i(ji,jj,jl) = smv_i(ji,jj,jl) * rswitch
+
+ ! update exchanges with ocean
+ sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice
+ wfx_res(ji,jj) = wfx_res(ji,jj) - ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice
+ wfx_snw(ji,jj) = wfx_snw(ji,jj) - ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice
+ hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * r1_rdtice ! W.m-2 <0
+ END DO
+ END DO
+ END DO
+
+ ! to be sure that at_i is the sum of a_i(jl)
+ at_i (:,:) = 0._wp
+ DO jl = 1, jpl
+ at_i(:,:) = at_i(:,:) + a_i(:,:,jl)
+ END DO
+
+ ! open water = 1 if at_i=0
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ rswitch = MAX( 0._wp , SIGN( 1._wp, - at_i(ji,jj) ) )
+ ato_i(ji,jj) = rswitch + (1._wp - rswitch ) * ato_i(ji,jj)
+ END DO
+ END DO
+
+ !
+ END SUBROUTINE lim_var_zapsmall
+
+ SUBROUTINE lim_var_itd( zhti, zhts, zai, zht_i, zht_s, za_i )
+ !!------------------------------------------------------------------
+ !! *** ROUTINE lim_var_itd ***
+ !!
+ !! ** Purpose : converting 1-cat ice to multiple ice categories
+ !!
+ !! ice thickness distribution follows a gaussian law
+ !! around the concentration of the most likely ice thickness
+ !! (similar as limistate.F90)
+ !!
+ !! ** Method: Iterative procedure
+ !!
+ !! 1) Try to fill the jpl ice categories (bounds hi_max(0:jpl)) with a gaussian
+ !!
+ !! 2) Check whether the distribution conserves area and volume, positivity and
+ !! category boundaries
+ !!
+ !! 3) If not (input ice is too thin), the last category is empty and
+ !! the number of categories is reduced (jpl-1)
+ !!
+ !! 4) Iterate until ok (SUM(itest(:) = 4)
+ !!
+ !! ** Arguments : zhti: 1-cat ice thickness
+ !! zhts: 1-cat snow depth
+ !! zai : 1-cat ice concentration
+ !!
+ !! ** Output : jpl-cat
+ !!
+ !! (Example of application: BDY forcings when input are cell averaged)
+ !!
+ !!-------------------------------------------------------------------
+ !! History : LIM3.5 - 2012 (M. Vancoppenolle) Original code
+ !! 2014 (C. Rousset) Rewriting
+ !!-------------------------------------------------------------------
+ !! Local variables
+ INTEGER :: ji, jk, jl ! dummy loop indices
+ INTEGER :: ijpij, i_fill, jl0
+ REAL(wp) :: zarg, zV, zconv, zdh
+ REAL(wp), DIMENSION(:), INTENT(in) :: zhti, zhts, zai ! input ice/snow variables
+ REAL(wp), DIMENSION(:,:), INTENT(inout) :: zht_i, zht_s, za_i ! output ice/snow variables
+ INTEGER , POINTER, DIMENSION(:) :: itest
+
+ CALL wrk_alloc( 4, itest )
+ !--------------------------------------------------------------------
+ ! initialisation of variables
+ !--------------------------------------------------------------------
+ ijpij = SIZE(zhti,1)
+ zht_i(1:ijpij,1:jpl) = 0._wp
+ zht_s(1:ijpij,1:jpl) = 0._wp
+ za_i (1:ijpij,1:jpl) = 0._wp
+
+ ! ----------------------------------------
+ ! distribution over the jpl ice categories
+ ! ----------------------------------------
+ DO ji = 1, ijpij
+
+ IF( zhti(ji) > 0._wp ) THEN
+
+ ! initialisation of tests
+ itest(:) = 0
+
+ i_fill = jpl + 1 !====================================
+ DO WHILE ( ( SUM( itest(:) ) /= 4 ) .AND. ( i_fill >= 2 ) ) ! iterative loop on i_fill categories
+ ! iteration !====================================
+ i_fill = i_fill - 1
+
+ ! initialisation of ice variables for each try
+ zht_i(ji,1:jpl) = 0._wp
+ za_i (ji,1:jpl) = 0._wp
+
+ ! *** case very thin ice: fill only category 1
+ IF ( i_fill == 1 ) THEN
+ zht_i(ji,1) = zhti(ji)
+ za_i (ji,1) = zai (ji)
+
+ ! *** case ice is thicker: fill categories >1
+ ELSE
+
+ ! Fill ice thicknesses except the last one (i_fill) by hmean
+ DO jl = 1, i_fill - 1
+ zht_i(ji,jl) = hi_mean(jl)
+ END DO
+
+ ! find which category (jl0) the input ice thickness falls into
+ jl0 = i_fill
+ DO jl = 1, i_fill
+ IF ( ( zhti(ji) >= hi_max(jl-1) ) .AND. ( zhti(ji) < hi_max(jl) ) ) THEN
+ jl0 = jl
+ CYCLE
+ ENDIF
+ END DO
+
+ ! Concentrations in the (i_fill-1) categories
+ za_i(ji,jl0) = zai(ji) / SQRT(REAL(jpl))
+ DO jl = 1, i_fill - 1
+ IF ( jl == jl0 ) CYCLE
+ zarg = ( zht_i(ji,jl) - zhti(ji) ) / ( zhti(ji) * 0.5_wp )
+ za_i(ji,jl) = za_i (ji,jl0) * EXP(-zarg**2)
+ END DO
+
+ ! Concentration in the last (i_fill) category
+ za_i(ji,i_fill) = zai(ji) - SUM( za_i(ji,1:i_fill-1) )
+
+ ! Ice thickness in the last (i_fill) category
+ zV = SUM( za_i(ji,1:i_fill-1) * zht_i(ji,1:i_fill-1) )
+ zht_i(ji,i_fill) = ( zhti(ji) * zai(ji) - zV ) / za_i(ji,i_fill)
+
+ ENDIF ! case ice is thick or thin
+
+ !---------------------
+ ! Compatibility tests
+ !---------------------
+ ! Test 1: area conservation
+ zconv = ABS( zai(ji) - SUM( za_i(ji,1:jpl) ) )
+ IF ( zconv < epsi06 ) itest(1) = 1
+
+ ! Test 2: volume conservation
+ zconv = ABS( zhti(ji)*zai(ji) - SUM( za_i(ji,1:jpl)*zht_i(ji,1:jpl) ) )
+ IF ( zconv < epsi06 ) itest(2) = 1
+
+ ! Test 3: thickness of the last category is in-bounds ?
+ IF ( zht_i(ji,i_fill) >= hi_max(i_fill-1) ) itest(3) = 1
+
+ ! Test 4: positivity of ice concentrations
+ itest(4) = 1
+ DO jl = 1, i_fill
+ IF ( za_i(ji,jl) < 0._wp ) itest(4) = 0
+ END DO
+ !============================
+ END DO ! end iteration on categories
+ !============================
+ ENDIF ! if zhti > 0
+ END DO ! i loop
+
+ ! ------------------------------------------------
+ ! Adding Snow in each category where za_i is not 0
+ ! ------------------------------------------------
+ DO jl = 1, jpl
+ DO ji = 1, ijpij
+ IF( za_i(ji,jl) > 0._wp ) THEN
+ zht_s(ji,jl) = zht_i(ji,jl) * ( zhts(ji) / zhti(ji) )
+ ! In case snow load is in excess that would lead to transformation from snow to ice
+ ! Then, transfer the snow excess into the ice (different from limthd_dh)
+ zdh = MAX( 0._wp, ( rhosn * zht_s(ji,jl) + ( rhoic - rau0 ) * zht_i(ji,jl) ) * r1_rau0 )
+ ! recompute ht_i, ht_s avoiding out of bounds values
+ zht_i(ji,jl) = MIN( hi_max(jl), zht_i(ji,jl) + zdh )
+ zht_s(ji,jl) = MAX( 0._wp, zht_s(ji,jl) - zdh * rhoic * r1_rhosn )
+ ENDIF
+ ENDDO
+ ENDDO
+
+ CALL wrk_dealloc( 4, itest )
+ !
+ END SUBROUTINE lim_var_itd
+
#else
@@ -542,4 +800,8 @@
SUBROUTINE lim_var_salprof1d ! Emtpy routines
END SUBROUTINE lim_var_salprof1d
+ SUBROUTINE lim_var_zapsmall
+ END SUBROUTINE lim_var_zapsmall
+ SUBROUTINE lim_var_itd
+ END SUBROUTINE lim_var_itd
#endif
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90 (revision 5602)
@@ -24,5 +24,4 @@
USE lib_mpp ! MPP library
USE wrk_nemo ! work arrays
- USE par_ice
USE iom
USE timing ! Timing
@@ -61,5 +60,5 @@
REAL(wp) :: z1_365
REAL(wp) :: ztmp
- REAL(wp), POINTER, DIMENSION(:,:,:) :: zoi, zei
+ REAL(wp), POINTER, DIMENSION(:,:,:) :: zoi, zei, zt_i, zt_s
REAL(wp), POINTER, DIMENSION(:,:) :: z2d, z2da, z2db, zswi ! 2D workspace
!!-------------------------------------------------------------------
@@ -67,5 +66,5 @@
IF( nn_timing == 1 ) CALL timing_start('limwri')
- CALL wrk_alloc( jpi, jpj, jpl, zoi, zei )
+ CALL wrk_alloc( jpi, jpj, jpl, zoi, zei, zt_i, zt_s )
CALL wrk_alloc( jpi, jpj , z2d, z2da, z2db, zswi )
@@ -73,4 +72,5 @@
! Mean category values
!-----------------------------
+ z1_365 = 1._wp / 365._wp
CALL lim_var_icetm ! mean sea ice temperature
@@ -107,12 +107,12 @@
DO jj = 2 , jpjm1
DO ji = 2 , jpim1
- z2da(ji,jj) = ( u_ice(ji,jj) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) ) * 0.5_wp
- z2db(ji,jj) = ( v_ice(ji,jj) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) ) * 0.5_wp
+ z2da(ji,jj) = ( u_ice(ji,jj) * umask(ji,jj,1) + u_ice(ji-1,jj) * umask(ji-1,jj,1) ) * 0.5_wp
+ z2db(ji,jj) = ( v_ice(ji,jj) * vmask(ji,jj,1) + v_ice(ji,jj-1) * vmask(ji,jj-1,1) ) * 0.5_wp
END DO
END DO
CALL lbc_lnk( z2da, 'T', -1. )
CALL lbc_lnk( z2db, 'T', -1. )
- CALL iom_put( "uice_ipa" , z2da ) ! ice velocity u component
- CALL iom_put( "vice_ipa" , z2db ) ! ice velocity v component
+ CALL iom_put( "uice_ipa" , z2da ) ! ice velocity u component
+ CALL iom_put( "vice_ipa" , z2db ) ! ice velocity v component
DO jj = 1, jpj
DO ji = 1, jpi
@@ -120,5 +120,5 @@
END DO
END DO
- CALL iom_put( "icevel" , z2d ) ! ice velocity module
+ CALL iom_put( "icevel" , z2d ) ! ice velocity module
ENDIF
!
@@ -128,10 +128,10 @@
DO jj = 1, jpj
DO ji = 1, jpi
- z2d(ji,jj) = z2d(ji,jj) + zswi(ji,jj) * oa_i(ji,jj,jl)
+ rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.1 ) )
+ z2d(ji,jj) = z2d(ji,jj) + rswitch * oa_i(ji,jj,jl) / MAX( at_i(ji,jj), 0.1 )
END DO
END DO
END DO
- z1_365 = 1._wp / 365._wp
- CALL iom_put( "miceage" , z2d * z1_365 ) ! mean ice age
+ CALL iom_put( "miceage" , z2d * z1_365 ) ! mean ice age
ENDIF
@@ -139,8 +139,8 @@
DO jj = 1, jpj
DO ji = 1, jpi
- z2d(ji,jj) = ( tm_i(ji,jj) - rtt ) * zswi(ji,jj)
- END DO
- END DO
- CALL iom_put( "micet" , z2d ) ! mean ice temperature
+ z2d(ji,jj) = ( tm_i(ji,jj) - rt0 ) * zswi(ji,jj)
+ END DO
+ END DO
+ CALL iom_put( "micet" , z2d ) ! mean ice temperature
ENDIF
!
@@ -150,9 +150,9 @@
DO jj = 1, jpj
DO ji = 1, jpi
- z2d(ji,jj) = z2d(ji,jj) + zswi(ji,jj) * ( t_su(ji,jj,jl) - rtt ) * a_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi06 )
+ z2d(ji,jj) = z2d(ji,jj) + zswi(ji,jj) * ( t_su(ji,jj,jl) - rt0 ) * a_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi06 )
END DO
END DO
END DO
- CALL iom_put( "icest" , z2d ) ! ice surface temperature
+ CALL iom_put( "icest" , z2d ) ! ice surface temperature
ENDIF
@@ -164,5 +164,5 @@
END DO
END DO
- CALL iom_put( "icecolf" , z2d ) ! frazil ice collection thickness
+ CALL iom_put( "icecolf" , z2d ) ! frazil ice collection thickness
ENDIF
@@ -176,5 +176,5 @@
CALL iom_put( "utau_ice" , utau_ice ) ! wind stress over ice along i-axis at I-point
CALL iom_put( "vtau_ice" , vtau_ice ) ! wind stress over ice along j-axis at I-point
- CALL iom_put( "snowpre" , sprecip ) ! snow precipitation
+ CALL iom_put( "snowpre" , sprecip * 86400. ) ! snow precipitation
CALL iom_put( "micesalt" , smt_i ) ! mean ice salinity
@@ -186,4 +186,5 @@
CALL iom_put( "icetrp" , diag_trp_vi * rday ) ! ice volume transport
CALL iom_put( "snwtrp" , diag_trp_vs * rday ) ! snw volume transport
+ CALL iom_put( "saltrp" , diag_trp_smv * rday * rhoic ) ! salt content transport
CALL iom_put( "deitrp" , diag_trp_ei ) ! advected ice enthalpy (W/m2)
CALL iom_put( "destrp" , diag_trp_es ) ! advected snw enthalpy (W/m2)
@@ -200,34 +201,38 @@
ztmp = rday / rhoic
- CALL iom_put( "vfxres" , wfx_res * ztmp ) ! daily prod./melting due to limupdate
- CALL iom_put( "vfxopw" , wfx_opw * ztmp ) ! daily lateral thermodynamic ice production
- CALL iom_put( "vfxsni" , wfx_sni * ztmp ) ! daily snowice ice production
- CALL iom_put( "vfxbog" , wfx_bog * ztmp ) ! daily bottom thermodynamic ice production
- CALL iom_put( "vfxdyn" , wfx_dyn * ztmp ) ! daily dynamic ice production (rid/raft)
- CALL iom_put( "vfxsum" , wfx_sum * ztmp ) ! surface melt
- CALL iom_put( "vfxbom" , wfx_bom * ztmp ) ! bottom melt
- CALL iom_put( "vfxice" , wfx_ice * ztmp ) ! total ice growth/melt
- CALL iom_put( "vfxsnw" , wfx_snw * ztmp ) ! total snw growth/melt
- CALL iom_put( "vfxsub" , wfx_sub * ztmp ) ! sublimation (snow)
- CALL iom_put( "vfxspr" , wfx_spr * ztmp ) ! precip (snow)
-
- CALL iom_put ('hfxthd', hfx_thd(:,:) ) !
- CALL iom_put ('hfxdyn', hfx_dyn(:,:) ) !
- CALL iom_put ('hfxres', hfx_res(:,:) ) !
- CALL iom_put ('hfxout', hfx_out(:,:) ) !
- CALL iom_put ('hfxin' , hfx_in(:,:) ) !
- CALL iom_put ('hfxsnw', hfx_snw(:,:) ) !
- CALL iom_put ('hfxsub', hfx_sub(:,:) ) !
- CALL iom_put ('hfxerr', hfx_err(:,:) ) !
- CALL iom_put ('hfxerr_rem', hfx_err_rem(:,:) ) !
-
- CALL iom_put ('hfxsum', hfx_sum(:,:) ) !
- CALL iom_put ('hfxbom', hfx_bom(:,:) ) !
- CALL iom_put ('hfxbog', hfx_bog(:,:) ) !
- CALL iom_put ('hfxdif', hfx_dif(:,:) ) !
- CALL iom_put ('hfxopw', hfx_opw(:,:) ) !
- CALL iom_put ('hfxtur', fhtur(:,:) * at_i(:,:) ) ! turbulent heat flux at ice base
- CALL iom_put ('hfxdhc', diag_heat_dhc(:,:) ) ! Heat content variation in snow and ice
- CALL iom_put ('hfxspr', hfx_spr(:,:) ) ! Heat content of snow precip
+ CALL iom_put( "vfxres" , wfx_res * ztmp ) ! daily prod./melting due to limupdate
+ CALL iom_put( "vfxopw" , wfx_opw * ztmp ) ! daily lateral thermodynamic ice production
+ CALL iom_put( "vfxsni" , wfx_sni * ztmp ) ! daily snowice ice production
+ CALL iom_put( "vfxbog" , wfx_bog * ztmp ) ! daily bottom thermodynamic ice production
+ CALL iom_put( "vfxdyn" , wfx_dyn * ztmp ) ! daily dynamic ice production (rid/raft)
+ CALL iom_put( "vfxsum" , wfx_sum * ztmp ) ! surface melt
+ CALL iom_put( "vfxbom" , wfx_bom * ztmp ) ! bottom melt
+ CALL iom_put( "vfxice" , wfx_ice * ztmp ) ! total ice growth/melt
+ CALL iom_put( "vfxsnw" , wfx_snw * ztmp ) ! total snw growth/melt
+ CALL iom_put( "vfxsub" , wfx_sub * ztmp ) ! sublimation (snow)
+ CALL iom_put( "vfxspr" , wfx_spr * ztmp ) ! precip (snow)
+
+ CALL iom_put( "afxtot" , afx_tot * rday ) ! concentration tendency (total)
+ CALL iom_put( "afxdyn" , afx_dyn * rday ) ! concentration tendency (dynamics)
+ CALL iom_put( "afxthd" , afx_thd * rday ) ! concentration tendency (thermo)
+
+ CALL iom_put ('hfxthd' , hfx_thd(:,:) ) !
+ CALL iom_put ('hfxdyn' , hfx_dyn(:,:) ) !
+ CALL iom_put ('hfxres' , hfx_res(:,:) ) !
+ CALL iom_put ('hfxout' , hfx_out(:,:) ) !
+ CALL iom_put ('hfxin' , hfx_in(:,:) ) !
+ CALL iom_put ('hfxsnw' , hfx_snw(:,:) ) !
+ CALL iom_put ('hfxsub' , hfx_sub(:,:) ) !
+ CALL iom_put ('hfxerr' , hfx_err(:,:) ) !
+ CALL iom_put ('hfxerr_rem' , hfx_err_rem(:,:) ) !
+
+ CALL iom_put ('hfxsum' , hfx_sum(:,:) ) !
+ CALL iom_put ('hfxbom' , hfx_bom(:,:) ) !
+ CALL iom_put ('hfxbog' , hfx_bog(:,:) ) !
+ CALL iom_put ('hfxdif' , hfx_dif(:,:) ) !
+ CALL iom_put ('hfxopw' , hfx_opw(:,:) ) !
+ CALL iom_put ('hfxtur' , fhtur(:,:) * SUM(a_i_b(:,:,:), dim=3) ) ! turbulent heat flux at ice base
+ CALL iom_put ('hfxdhc' , diag_heat(:,:) ) ! Heat content variation in snow and ice
+ CALL iom_put ('hfxspr' , hfx_spr(:,:) ) ! Heat content of snow precip
!--------------------------------
@@ -239,4 +244,16 @@
CALL iom_put( "salinity_cat" , sm_i ) ! salinity for categories
+ ! ice temperature
+ IF ( iom_use( "icetemp_cat" ) ) THEN
+ zt_i(:,:,:) = SUM( t_i(:,:,:,:), dim=3 ) * r1_nlay_i
+ CALL iom_put( "icetemp_cat" , zt_i - rt0 )
+ ENDIF
+
+ ! snow temperature
+ IF ( iom_use( "snwtemp_cat" ) ) THEN
+ zt_s(:,:,:) = SUM( t_s(:,:,:,:), dim=3 ) * r1_nlay_s
+ CALL iom_put( "snwtemp_cat" , zt_s - rt0 )
+ ENDIF
+
! Compute ice age
IF ( iom_use( "iceage_cat" ) ) THEN
@@ -244,10 +261,11 @@
DO jj = 1, jpj
DO ji = 1, jpi
- rswitch = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) )
- zoi(ji,jj,jl) = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi06 ) * rswitch
+ rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.1 ) )
+ rswitch = rswitch * MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - 0.1 ) )
+ zoi(ji,jj,jl) = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , 0.1 ) * rswitch
END DO
END DO
END DO
- CALL iom_put( "iceage_cat" , zoi ) ! ice age for categories
+ CALL iom_put( "iceage_cat" , zoi * z1_365 ) ! ice age for categories
ENDIF
@@ -260,12 +278,12 @@
DO ji = 1, jpi
rswitch = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) )
- zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0* &
- ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rtt ), - epsi06 ) ) * &
- rswitch / nlay_i
+ zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0 * &
+ ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rt0 ), - epsi06 ) ) * &
+ rswitch * r1_nlay_i
END DO
END DO
END DO
END DO
- CALL iom_put( "brinevol_cat" , zei ) ! brine volume for categories
+ CALL iom_put( "brinevol_cat" , zei ) ! brine volume for categories
ENDIF
@@ -274,5 +292,5 @@
! not yet implemented
- CALL wrk_dealloc( jpi, jpj, jpl, zoi, zei )
+ CALL wrk_dealloc( jpi, jpj, jpl, zoi, zei, zt_i, zt_s )
CALL wrk_dealloc( jpi, jpj , z2d, zswi, z2da, z2db )
@@ -348,5 +366,5 @@
CALL histwrite( kid, "iicethic", kt, icethi , jpi*jpj, (/1/) )
CALL histwrite( kid, "iiceconc", kt, at_i , jpi*jpj, (/1/) )
- CALL histwrite( kid, "iicetemp", kt, tm_i - rtt , jpi*jpj, (/1/) )
+ CALL histwrite( kid, "iicetemp", kt, tm_i - rt0 , jpi*jpj, (/1/) )
CALL histwrite( kid, "iicevelu", kt, u_ice , jpi*jpj, (/1/) )
CALL histwrite( kid, "iicevelv", kt, v_ice , jpi*jpj, (/1/) )
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limwri_dimg.h90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limwri_dimg.h90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limwri_dimg.h90 (revision 5602)
@@ -92,5 +92,5 @@
zinda = MAX( 0._wp , SIGN( 1._wp , ( 1.0 - frld(ji,jj) ) - 0.10 ) )
zindb = zindh * zinda
- ztmu = MAX( 0.5 * 1._wp , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) )
+ ztmu = MAX( 0.5 * 1._wp , ( umask(ji,jj,1) + umask(ji+1,jj,1) + umask(ji,jj+1,1) + umask(ji+1,jj+1,1) ) )
zcmo(ji,jj,1) = ht_s (ji,jj,1)
zcmo(ji,jj,2) = ht_i (ji,jj,1)
@@ -99,10 +99,10 @@
zcmo(ji,jj,5) = sist (ji,jj)
zcmo(ji,jj,6) = fhtur (ji,jj)
- zcmo(ji,jj,7) = zindb * ( u_ice(ji,jj ) * tmu(ji,jj ) + u_ice(ji+1,jj ) * tmu(ji+1,jj ) &
- + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
+ zcmo(ji,jj,7) = zindb * ( u_ice(ji,jj ) * umask(ji,jj,1) + u_ice(ji+1,jj ) * umask(ji+1,jj,1) &
+ + u_ice(ji,jj+1) * umask(ji,jj+1,1) + u_ice(ji+1,jj+1) * umask(ji+1,jj+1,1) ) &
/ ztmu
- zcmo(ji,jj,8) = zindb * ( v_ice(ji,jj ) * tmu(ji,jj ) + v_ice(ji+1,jj ) * tmu(ji+1,jj ) &
- + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
+ zcmo(ji,jj,8) = zindb * ( v_ice(ji,jj ) * umask(ji,jj,1) + v_ice(ji+1,jj ) * umask(ji+1,jj,1) &
+ + v_ice(ji,jj+1) * umask(ji,jj+1,1) + v_ice(ji+1,jj+1) * umask(ji+1,jj+1,1) ) &
/ ztmu
zcmo(ji,jj,9) = sst_m(ji,jj)
@@ -135,5 +135,5 @@
zinda = MAX( 0._wp , SIGN( 1._wp , ( 1.0 - frld(ji,jj) ) - 0.10 ) )
zindb = zindh * zinda
- ztmu = MAX( 0.5 * 1._wp , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) )
+ ztmu = MAX( 0.5 * 1._wp , ( umask(ji,jj,1) + umask(ji+1,jj,1) + umask(ji,jj+1,1) + umask(ji+1,jj+1,1) ) )
rcmoy(ji,jj,1) = ht_s (ji,jj,1)
rcmoy(ji,jj,2) = ht_i (ji,jj,1)
@@ -142,10 +142,10 @@
rcmoy(ji,jj,5) = sist (ji,jj)
rcmoy(ji,jj,6) = fhtur (ji,jj)
- rcmoy(ji,jj,7) = zindb * ( u_ice(ji,jj ) * tmu(ji,jj ) + u_ice(ji+1,jj ) * tmu(ji+1,jj ) &
- + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
+ rcmoy(ji,jj,7) = zindb * ( u_ice(ji,jj ) * umask(ji,jj,1) + u_ice(ji+1,jj ) * umask(ji+1,jj,1) &
+ + u_ice(ji,jj+1) * umask(ji,jj+1,1) + u_ice(ji+1,jj+1) * umask(ji+1,jj+1,1) ) &
/ ztmu
- rcmoy(ji,jj,8) = zindb * ( v_ice(ji,jj ) * tmu(ji,jj ) + v_ice(ji+1,jj ) * tmu(ji+1,jj ) &
- + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
+ rcmoy(ji,jj,8) = zindb * ( v_ice(ji,jj ) * umask(ji,jj,1) + v_ice(ji+1,jj ) * umask(ji+1,jj,1) &
+ + v_ice(ji,jj+1) * umask(ji,jj+1,1) + v_ice(ji+1,jj+1) * umask(ji+1,jj+1,1) ) &
/ ztmu
rcmoy(ji,jj,9) = sst_m(ji,jj)
Index: anches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/par_ice.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/par_ice.F90 (revision 5601)
+++ (revision )
@@ -1,25 +1,0 @@
-MODULE par_ice
- !!======================================================================
- !! *** MODULE par_ice ***
- !! LIM-3 Sea Ice : definition of parameters
- !!======================================================================
- !! History : 3.0 ! 2003-08 (M. Vancoppenolle) LIM-3
- !!----------------------------------------------------------------------
- USE par_oce
-
- IMPLICIT NONE
- PUBLIC
-
- ! !!! ice thermodynamics
- INTEGER, PUBLIC, PARAMETER :: nlay_i = 5 !: number of ice layers
- INTEGER, PUBLIC, PARAMETER :: nlay_s = 1 !: number of snow layers
-
- ! !!! ice mechanical redistribution
- INTEGER, PUBLIC, PARAMETER :: jpl = 5 !: number of ice categories
-
- !!----------------------------------------------------------------------
- !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
- !! $Id$
- !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
- !!======================================================================
-END MODULE par_ice
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90 (revision 5602)
@@ -6,7 +6,7 @@
!! History : 3.0 ! 2002-11 (C. Ethe) F90: Free form and module
!!----------------------------------------------------------------------
- USE par_ice ! LIM-3 parameters
USE in_out_manager ! I/O manager
USE lib_mpp ! MPP library
+ USE ice, ONLY : nlay_i, nlay_s
IMPLICIT NONE
@@ -19,14 +19,11 @@
!!---------------------------
! !!! ** ice-thermo namelist (namicethd) **
- REAL(wp), PUBLIC :: hmelt !: maximum melting at the bottom; active only for one category
- REAL(wp), PUBLIC :: hiclim !: minimum ice thickness
- REAL(wp), PUBLIC :: hnzst !: thick. of the surf. layer in temp. comp.
- REAL(wp), PUBLIC :: parsub !: switch for snow sublimation or not
- REAL(wp), PUBLIC :: maxfrazb !: maximum portion of frazil ice collecting at the ice bottom
- REAL(wp), PUBLIC :: vfrazb !: threshold drift speed for collection of bottom frazil ice
- REAL(wp), PUBLIC :: Cfrazb !: squeezing coefficient for collection of bottom frazil ice
- REAL(wp), PUBLIC :: hiccrit !: ice th. for lateral accretion in the NH (SH) (m)
+ REAL(wp), PUBLIC :: rn_himin !: minimum ice thickness
+ REAL(wp), PUBLIC :: rn_maxfrazb !: maximum portion of frazil ice collecting at the ice bottom
+ REAL(wp), PUBLIC :: rn_vfrazb !: threshold drift speed for collection of bottom frazil ice
+ REAL(wp), PUBLIC :: rn_Cfrazb !: squeezing coefficient for collection of bottom frazil ice
+ REAL(wp), PUBLIC :: rn_hnewice !: thickness for new ice formation (m)
- INTEGER , PUBLIC :: fraz_swi !: use of frazil ice collection in function of wind (1) or not (0)
+ LOGICAL , PUBLIC :: ln_frazil !: use of frazil ice collection as function of wind (T) or not (F)
!!-----------------------------
@@ -37,6 +34,7 @@
!: are the variables corresponding to 2d vectors
- INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: npb !: number of points where computations has to be done
- INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: npac !: correspondance between points (lateral accretion)
+ INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: npb !: address vector for 1d vertical thermo computations
+ INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nplm !: address vector for mono-category lateral melting
+ INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: npac !: address vector for new ice formation
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qlead_1d
@@ -56,4 +54,5 @@
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_err_1d
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_err_rem_1d
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_err_dif_1d
! heat flux associated with ice-atmosphere mass exchange
@@ -90,7 +89,6 @@
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fhld_1d !: <==> the 2D fhld
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dqns_ice_1d !: <==> the 2D dqns_ice
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qla_ice_1d !: <==> the 2D qla_ice
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dqla_ice_1d !: <==> the 2D dqla_ice
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: tatm_ice_1d !: <==> the 2D tatm_ice
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: evap_ice_1d !: <==> the 2D evap_ice
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qprec_ice_1d !: <==> the 2D qprec_ice
! ! to reintegrate longwave flux inside the ice thermodynamics
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: i0 !: fraction of radiation transmitted to the ice
@@ -140,35 +138,31 @@
!!---------------------------------------------------------------------!
- ALLOCATE( npb (jpij) , npac (jpij), &
- ! !
- & qlead_1d (jpij) , ftr_ice_1d (jpij) , &
- & qsr_ice_1d (jpij) , &
- & fr1_i0_1d(jpij) , fr2_i0_1d(jpij) , qns_ice_1d(jpij) , &
- & t_bo_1d (jpij) , &
- & hfx_sum_1d(jpij) , hfx_bom_1d(jpij) ,hfx_bog_1d(jpij) , &
- & hfx_dif_1d(jpij) ,hfx_opw_1d(jpij) , &
- & hfx_thd_1d(jpij) , hfx_spr_1d(jpij) , &
- & hfx_snw_1d(jpij) , hfx_sub_1d(jpij) , hfx_err_1d(jpij) , &
- & hfx_res_1d(jpij) , hfx_err_rem_1d(jpij), STAT=ierr(1) )
+ ALLOCATE( npb (jpij) , nplm (jpij) , npac (jpij) , &
+ & qlead_1d (jpij) , ftr_ice_1d(jpij) , qsr_ice_1d (jpij) , &
+ & fr1_i0_1d(jpij) , fr2_i0_1d (jpij) , qns_ice_1d(jpij) , &
+ & t_bo_1d (jpij) , &
+ & hfx_sum_1d(jpij) , hfx_bom_1d(jpij) ,hfx_bog_1d(jpij) , &
+ & hfx_dif_1d(jpij) , hfx_opw_1d(jpij) , &
+ & hfx_thd_1d(jpij) , hfx_spr_1d(jpij) , &
+ & hfx_snw_1d(jpij) , hfx_sub_1d(jpij) , hfx_err_1d(jpij) , &
+ & hfx_res_1d(jpij) , hfx_err_rem_1d(jpij) , hfx_err_dif_1d(jpij) , STAT=ierr(1) )
!
- ALLOCATE( sprecip_1d (jpij) , frld_1d (jpij) , at_i_1d (jpij) , &
- & fhtur_1d (jpij) , wfx_snw_1d (jpij) , wfx_spr_1d (jpij) , &
- & fhld_1d (jpij) , wfx_sub_1d (jpij) , wfx_bog_1d(jpij) , wfx_bom_1d(jpij) , &
- & wfx_sum_1d(jpij) , wfx_sni_1d (jpij) , wfx_opw_1d (jpij) , wfx_res_1d (jpij) , &
- & dqns_ice_1d(jpij) , qla_ice_1d (jpij) , dqla_ice_1d(jpij) , &
- & tatm_ice_1d(jpij) , &
- & i0 (jpij) , &
- & sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) ,sfx_sum_1d (jpij) , &
- & sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) , &
- & dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) , &
+ ALLOCATE( sprecip_1d (jpij) , frld_1d (jpij) , at_i_1d (jpij) , &
+ & fhtur_1d (jpij) , wfx_snw_1d (jpij) , wfx_spr_1d (jpij) , &
+ & fhld_1d (jpij) , wfx_sub_1d (jpij) , wfx_bog_1d (jpij) , wfx_bom_1d(jpij) , &
+ & wfx_sum_1d(jpij) , wfx_sni_1d (jpij) , wfx_opw_1d (jpij) , wfx_res_1d(jpij) , &
+ & dqns_ice_1d(jpij) , evap_ice_1d (jpij), &
+ & qprec_ice_1d(jpij), i0 (jpij) , &
+ & sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) , sfx_sum_1d (jpij), &
+ & sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) , &
+ & dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) , &
& dsm_i_si_1d(jpij) , hicol_1d (jpij) , STAT=ierr(2) )
!
- ALLOCATE( t_su_1d (jpij) , a_i_1d (jpij) , ht_i_1d (jpij) , &
- & ht_s_1d (jpij) , fc_su (jpij) , fc_bo_i (jpij) , &
+ ALLOCATE( t_su_1d (jpij) , a_i_1d (jpij) , ht_i_1d (jpij) , &
+ & ht_s_1d (jpij) , fc_su (jpij) , fc_bo_i (jpij) , &
& dh_s_tot (jpij) , dh_i_surf(jpij) , dh_i_bott(jpij) , &
- & dh_snowice(jpij) , sm_i_1d (jpij) , s_i_new (jpij) , &
- & t_s_1d(jpij,nlay_s), &
- & t_i_1d(jpij,nlay_i+1), s_i_1d(jpij,nlay_i+1) , &
- & q_i_1d(jpij,nlay_i+1), q_s_1d(jpij,nlay_i+1) , &
+ & dh_snowice(jpij) , sm_i_1d (jpij) , s_i_new (jpij) , &
+ & t_s_1d(jpij,nlay_s) , t_i_1d(jpij,nlay_i) , s_i_1d(jpij,nlay_i) , &
+ & q_i_1d(jpij,nlay_i+1) , q_s_1d(jpij,nlay_s) , &
& qh_i_old(jpij,0:nlay_i+1), h_i_old(jpij,0:nlay_i+1) , STAT=ierr(3))
!
Index: anches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OFF_SRC/domain.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OFF_SRC/domain.F90 (revision 5601)
+++ (revision )
@@ -1,428 +1,0 @@
-MODULE domain
- !!==============================================================================
- !! *** MODULE domain ***
- !! Ocean initialization : domain initialization
- !!==============================================================================
-
- !!----------------------------------------------------------------------
- !! dom_init : initialize the space and time domain
- !! dom_nam : read and contral domain namelists
- !! dom_ctl : control print for the ocean domain
- !!----------------------------------------------------------------------
- !! * Modules used
- USE oce !
- USE dom_oce ! ocean space and time domain
- USE phycst ! physical constants
- USE in_out_manager ! I/O manager
- USE lib_mpp ! distributed memory computing library
-
- USE domstp ! domain: set the time-step
- USE domrea ! domain: write the meshmask file
- USE dommsk ! domain : mask
-
- IMPLICIT NONE
- PRIVATE
-
- !! * Routine accessibility
- PUBLIC dom_init ! called by opa.F90
-
- !! * Substitutions
-# include "domzgr_substitute.h90"
- !!----------------------------------------------------------------------
- !! NEMO/OFF 3.3 , NEMO Consortium (2010)
- !! $Id$
- !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
- !!----------------------------------------------------------------------
-
-CONTAINS
-
- SUBROUTINE dom_init
- !!----------------------------------------------------------------------
- !! *** ROUTINE dom_init ***
- !!
- !! ** Purpose : Domain initialization. Call the routines that are
- !! required to create the arrays which define the space and time
- !! domain of the ocean model.
- !!
- !! ** Method :
- !! - dom_stp: defined the model time step
- !! - dom_rea: read the meshmask file if nmsh=1
- !!
- !! History :
- !! ! 90-10 (C. Levy - G. Madec) Original code
- !! ! 91-11 (G. Madec)
- !! ! 92-01 (M. Imbard) insert time step initialization
- !! ! 96-06 (G. Madec) generalized vertical coordinate
- !! ! 97-02 (G. Madec) creation of domwri.F
- !! ! 01-05 (E.Durand - G. Madec) insert closed sea
- !! 8.5 ! 02-08 (G. Madec) F90: Free form and module
- !!----------------------------------------------------------------------
- !! * Local declarations
- INTEGER :: jk ! dummy loop argument
- INTEGER :: iconf = 0 ! temporary integers
- !!----------------------------------------------------------------------
-
- IF(lwp) THEN
- WRITE(numout,*)
- WRITE(numout,*) 'dom_init : domain initialization'
- WRITE(numout,*) '~~~~~~~~'
- ENDIF
-
- CALL dom_nam ! read namelist ( namrun, namdom, namcla )
- CALL dom_zgr ! Vertical mesh and bathymetry option
- CALL dom_rea ! Create a domain file
-
- !
- ! - ML - Used in dom_vvl_sf_nxt and lateral diffusion routines
- ! but could be usefull in many other routines
- e12t (:,:) = e1t(:,:) * e2t(:,:)
- e1e2t (:,:) = e1t(:,:) * e2t(:,:)
- e12u (:,:) = e1u(:,:) * e2u(:,:)
- e12v (:,:) = e1v(:,:) * e2v(:,:)
- e12f (:,:) = e1f(:,:) * e2f(:,:)
- r1_e12t (:,:) = 1._wp / e12t(:,:)
- r1_e12u (:,:) = 1._wp / e12u(:,:)
- r1_e12v (:,:) = 1._wp / e12v(:,:)
- r1_e12f (:,:) = 1._wp / e12f(:,:)
- re2u_e1u(:,:) = e2u(:,:) / e1u(:,:)
- re1v_e2v(:,:) = e1v(:,:) / e2v(:,:)
- !
- hu(:,:) = 0._wp ! Ocean depth at U- and V-points
- hv(:,:) = 0._wp
- DO jk = 1, jpk
- hu(:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk)
- hv(:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk)
- END DO
- ! ! Inverse of the local depth
- hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask(:,:,1) ) * umask(:,:,1)
- hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask(:,:,1) ) * vmask(:,:,1)
-
- CALL dom_stp ! Time step
- CALL dom_msk ! Masks
- CALL dom_ctl ! Domain control
-
- END SUBROUTINE dom_init
-
- SUBROUTINE dom_nam
- !!----------------------------------------------------------------------
- !! *** ROUTINE dom_nam ***
- !!
- !! ** Purpose : read domaine namelists and print the variables.
- !!
- !! ** input : - namrun namelist
- !! - namdom namelist
- !! - namcla namelist
- !!----------------------------------------------------------------------
- USE ioipsl
- INTEGER :: ios ! Local integer output status for namelist read
- NAMELIST/namrun/ nn_no , cn_exp , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl, &
- & nn_it000, nn_itend , nn_date0 , nn_leapy , nn_istate , nn_stock , &
- & nn_write, ln_dimgnnn, ln_mskland , ln_clobber , nn_chunksz, nn_euler
- NAMELIST/namdom/ nn_bathy , rn_bathy, rn_e3zps_min, rn_e3zps_rat, nn_msh , rn_hmin, &
- & nn_acc , rn_atfp , rn_rdt , rn_rdtmin , &
- & rn_rdtmax, rn_rdth , nn_baro , nn_closea , ln_crs, &
- & jphgr_msh, &
- & ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, &
- & ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, &
- & ppa2, ppkth2, ppacr2
- NAMELIST/namcla/ nn_cla
-#if defined key_netcdf4
- NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
-#endif
- !!----------------------------------------------------------------------
-
- REWIND( numnam_ref ) ! Namelist namrun in reference namelist : Parameters of the run
- READ ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
-901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
-
- REWIND( numnam_cfg ) ! Namelist namrun in configuration namelist : Parameters of the run
- READ ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
-902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
- IF(lwm) WRITE ( numond, namrun )
- !
- IF(lwp) THEN ! control print
- WRITE(numout,*)
- WRITE(numout,*) 'dom_nam : domain initialization through namelist read'
- WRITE(numout,*) '~~~~~~~ '
- WRITE(numout,*) ' Namelist namrun'
- WRITE(numout,*) ' job number nn_no = ', nn_no
- WRITE(numout,*) ' experiment name for output cn_exp = ', cn_exp
- WRITE(numout,*) ' restart logical ln_rstart = ', ln_rstart
- WRITE(numout,*) ' control of time step nn_rstctl = ', nn_rstctl
- WRITE(numout,*) ' number of the first time step nn_it000 = ', nn_it000
- WRITE(numout,*) ' number of the last time step nn_itend = ', nn_itend
- WRITE(numout,*) ' initial calendar date aammjj nn_date0 = ', nn_date0
- WRITE(numout,*) ' leap year calendar (0/1) nn_leapy = ', nn_leapy
- WRITE(numout,*) ' initial state output nn_istate = ', nn_istate
- WRITE(numout,*) ' frequency of restart file nn_stock = ', nn_stock
- WRITE(numout,*) ' frequency of output file nn_write = ', nn_write
- WRITE(numout,*) ' multi file dimgout ln_dimgnnn = ', ln_dimgnnn
- WRITE(numout,*) ' mask land points ln_mskland = ', ln_mskland
- WRITE(numout,*) ' overwrite an existing file ln_clobber = ', ln_clobber
- WRITE(numout,*) ' NetCDF chunksize (bytes) nn_chunksz = ', nn_chunksz
- ENDIF
- no = nn_no ! conversion DOCTOR names into model names (this should disappear soon)
- cexper = cn_exp
- nrstdt = nn_rstctl
- nit000 = nn_it000
- nitend = nn_itend
- ndate0 = nn_date0
- nleapy = nn_leapy
- ninist = nn_istate
- nstock = nn_stock
- nwrite = nn_write
-
-
- ! ! control of output frequency
- IF ( nstock == 0 .OR. nstock > nitend ) THEN
- WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
- CALL ctl_warn( ctmp1 )
- nstock = nitend
- ENDIF
- IF ( nwrite == 0 ) THEN
- WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
- CALL ctl_warn( ctmp1 )
- nwrite = nitend
- ENDIF
-
- ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day)
- ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
- adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
-
-#if defined key_agrif
- IF( Agrif_Root() ) THEN
-#endif
- SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL
- CASE ( 1 )
- CALL ioconf_calendar('gregorian')
- IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "gregorian", i.e. leap year'
- CASE ( 0 )
- CALL ioconf_calendar('noleap')
- IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "noleap", i.e. no leap year'
- CASE ( 30 )
- CALL ioconf_calendar('360d')
- IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "360d", i.e. 360 days in a year'
- END SELECT
-#if defined key_agrif
- ENDIF
-#endif
-
- REWIND( numnam_ref ) ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
- READ ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
-903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
-
- REWIND( numnam_cfg ) ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
- READ ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
-904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
- IF(lwm) WRITE ( numond, namdom )
-
- IF(lwp) THEN
- WRITE(numout,*)
- WRITE(numout,*) ' Namelist namdom : space & time domain'
- WRITE(numout,*) ' flag read/compute bathymetry nn_bathy = ', nn_bathy
- WRITE(numout,*) ' Depth (if =0 bathy=jpkm1) rn_bathy = ', rn_bathy
- WRITE(numout,*) ' min depth of the ocean (>0) or rn_hmin = ', rn_hmin
- WRITE(numout,*) ' minimum thickness of partial rn_e3zps_min = ', rn_e3zps_min, ' (m)'
- WRITE(numout,*) ' step level rn_e3zps_rat = ', rn_e3zps_rat
- WRITE(numout,*) ' create mesh/mask file(s) nn_msh = ', nn_msh
- WRITE(numout,*) ' = 0 no file created '
- WRITE(numout,*) ' = 1 mesh_mask '
- WRITE(numout,*) ' = 2 mesh and mask '
- WRITE(numout,*) ' = 3 mesh_hgr, msh_zgr and mask '
- WRITE(numout,*) ' ocean time step rn_rdt = ', rn_rdt
- WRITE(numout,*) ' asselin time filter parameter rn_atfp = ', rn_atfp
- WRITE(numout,*) ' time-splitting: nb of sub time-step nn_baro = ', nn_baro
- WRITE(numout,*) ' acceleration of converge nn_acc = ', nn_acc
- WRITE(numout,*) ' nn_acc=1: surface tracer rdt rn_rdtmin = ', rn_rdtmin
- WRITE(numout,*) ' bottom tracer rdt rdtmax = ', rn_rdtmax
- WRITE(numout,*) ' depth of transition rn_rdth = ', rn_rdth
- WRITE(numout,*) ' suppression of closed seas (=0) nn_closea = ', nn_closea
- WRITE(numout,*) ' type of horizontal mesh jphgr_msh = ', jphgr_msh
- WRITE(numout,*) ' longitude of first raw and column T-point ppglam0 = ', ppglam0
- WRITE(numout,*) ' latitude of first raw and column T-point ppgphi0 = ', ppgphi0
- WRITE(numout,*) ' zonal grid-spacing (degrees) ppe1_deg = ', ppe1_deg
- WRITE(numout,*) ' meridional grid-spacing (degrees) ppe2_deg = ', ppe2_deg
- WRITE(numout,*) ' zonal grid-spacing (degrees) ppe1_m = ', ppe1_m
- WRITE(numout,*) ' meridional grid-spacing (degrees) ppe2_m = ', ppe2_m
- WRITE(numout,*) ' ORCA r4, r2 and r05 coefficients ppsur = ', ppsur
- WRITE(numout,*) ' ppa0 = ', ppa0
- WRITE(numout,*) ' ppa1 = ', ppa1
- WRITE(numout,*) ' ppkth = ', ppkth
- WRITE(numout,*) ' ppacr = ', ppacr
- WRITE(numout,*) ' Minimum vertical spacing ppdzmin = ', ppdzmin
- WRITE(numout,*) ' Maximum depth pphmax = ', pphmax
- WRITE(numout,*) ' Use double tanf function for vertical coordinates ldbletanh = ', ldbletanh
- WRITE(numout,*) ' Double tanh function parameters ppa2 = ', ppa2
- WRITE(numout,*) ' ppkth2 = ', ppkth2
- WRITE(numout,*) ' ppacr2 = ', ppacr2
- ENDIF
-
- ntopo = nn_bathy ! conversion DOCTOR names into model names (this should disappear soon)
- e3zps_min = rn_e3zps_min
- e3zps_rat = rn_e3zps_rat
- nmsh = nn_msh
- nacc = nn_acc
- atfp = rn_atfp
- rdt = rn_rdt
- rdtmin = rn_rdtmin
- rdtmax = rn_rdtmin
- rdth = rn_rdth
-
- REWIND( numnam_ref ) ! Namelist namcla in reference namelist : Cross land advection
- READ ( numnam_ref, namcla, IOSTAT = ios, ERR = 905)
-905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in reference namelist', lwp )
-
- REWIND( numnam_cfg ) ! Namelist namcla in configuration namelist : Cross land advection
- READ ( numnam_cfg, namcla, IOSTAT = ios, ERR = 906 )
-906 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in configuration namelist', lwp )
- IF(lwm) WRITE( numond, namcla )
-
- IF(lwp) THEN
- WRITE(numout,*)
- WRITE(numout,*) ' Namelist namcla'
- WRITE(numout,*) ' cross land advection nn_cla = ', nn_cla
- ENDIF
-
-#if defined key_netcdf4
- ! ! NetCDF 4 case ("key_netcdf4" defined)
- REWIND( numnam_ref ) ! Namelist namnc4 in reference namelist : NETCDF
- READ ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
-907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp )
-
- REWIND( numnam_cfg ) ! Namelist namnc4 in configuration namelist : NETCDF
- READ ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
-908 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp )
- IF(lwm) WRITE( numond, namnc4 )
- IF(lwp) THEN ! control print
- WRITE(numout,*)
- WRITE(numout,*) ' Namelist namnc4 - Netcdf4 chunking parameters'
- WRITE(numout,*) ' number of chunks in i-dimension nn_nchunks_i = ', nn_nchunks_i
- WRITE(numout,*) ' number of chunks in j-dimension nn_nchunks_j = ', nn_nchunks_j
- WRITE(numout,*) ' number of chunks in k-dimension nn_nchunks_k = ', nn_nchunks_k
- WRITE(numout,*) ' apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
- ENDIF
-
- ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
- ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
- snc4set%ni = nn_nchunks_i
- snc4set%nj = nn_nchunks_j
- snc4set%nk = nn_nchunks_k
- snc4set%luse = ln_nc4zip
-#else
- snc4set%luse = .FALSE. ! No NetCDF 4 case
-#endif
- !
- END SUBROUTINE dom_nam
-
- SUBROUTINE dom_zgr
- !!----------------------------------------------------------------------
- !! *** ROUTINE dom_zgr ***
- !!
- !! ** Purpose : set the depth of model levels and the resulting
- !! vertical scale factors.
- !!
- !! ** Method : - reference 1D vertical coordinate (gdep._1d, e3._1d)
- !! - read/set ocean depth and ocean levels (bathy, mbathy)
- !! - vertical coordinate (gdep., e3.) depending on the
- !! coordinate chosen :
- !! ln_zco=T z-coordinate
- !! ln_zps=T z-coordinate with partial steps
- !! ln_zco=T s-coordinate
- !!
- !! ** Action : define gdep., e3., mbathy and bathy
- !!----------------------------------------------------------------------
- INTEGER :: ioptio = 0 ! temporary integer
- INTEGER :: ios
- !!
- NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav
- !!----------------------------------------------------------------------
-
- REWIND( numnam_ref ) ! Namelist namzgr in reference namelist : Vertical coordinate
- READ ( numnam_ref, namzgr, IOSTAT = ios, ERR = 901 )
-901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist', lwp )
-
- REWIND( numnam_cfg ) ! Namelist namzgr in configuration namelist : Vertical coordinate
- READ ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 )
-902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp )
- IF(lwm) WRITE ( numond, namzgr )
-
- IF(lwp) THEN ! Control print
- WRITE(numout,*)
- WRITE(numout,*) 'dom_zgr : vertical coordinate'
- WRITE(numout,*) '~~~~~~~'
- WRITE(numout,*) ' Namelist namzgr : set vertical coordinate'
- WRITE(numout,*) ' z-coordinate - full steps ln_zco = ', ln_zco
- WRITE(numout,*) ' z-coordinate - partial steps ln_zps = ', ln_zps
- WRITE(numout,*) ' s- or hybrid z-s-coordinate ln_sco = ', ln_sco
- WRITE(numout,*) ' ice shelf cavity ln_isfcav = ', ln_isfcav
- ENDIF
-
- ioptio = 0 ! Check Vertical coordinate options
- IF( ln_zco ) ioptio = ioptio + 1
- IF( ln_zps ) ioptio = ioptio + 1
- IF( ln_sco ) ioptio = ioptio + 1
- IF( ln_isfcav ) ioptio = 33
- IF ( ioptio /= 1 ) CALL ctl_stop( ' none or several vertical coordinate options used' )
- IF ( ioptio == 33 ) CALL ctl_stop( ' isf cavity with off line module not yet done ' )
-
- END SUBROUTINE dom_zgr
-
- SUBROUTINE dom_ctl
- !!----------------------------------------------------------------------
- !! *** ROUTINE dom_ctl ***
- !!
- !! ** Purpose : Domain control.
- !!
- !! ** Method : compute and print extrema of masked scale factors
- !!
- !! History :
- !! 8.5 ! 02-08 (G. Madec) Original code
- !!----------------------------------------------------------------------
- !! * Local declarations
- INTEGER :: iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
- INTEGER, DIMENSION(2) :: iloc !
- REAL(wp) :: ze1min, ze1max, ze2min, ze2max
- !!----------------------------------------------------------------------
-
- ! Extrema of the scale factors
-
- IF(lwp)WRITE(numout,*)
- IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
- IF(lwp)WRITE(numout,*) '~~~~~~~'
-
- IF (lk_mpp) THEN
- CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
- CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
- CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
- CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
- ELSE
- ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
- ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
- ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
- ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
-
- iloc = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
- iimi1 = iloc(1) + nimpp - 1
- ijmi1 = iloc(2) + njmpp - 1
- iloc = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
- iimi2 = iloc(1) + nimpp - 1
- ijmi2 = iloc(2) + njmpp - 1
- iloc = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
- iima1 = iloc(1) + nimpp - 1
- ijma1 = iloc(2) + njmpp - 1
- iloc = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
- iima2 = iloc(1) + nimpp - 1
- ijma2 = iloc(2) + njmpp - 1
- ENDIF
-
- IF(lwp) THEN
- WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
- WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
- WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
- WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
- ENDIF
-
- END SUBROUTINE dom_ctl
-
- !!======================================================================
-END MODULE domain
Index: anches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OFF_SRC/dommsk.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OFF_SRC/dommsk.F90 (revision 5601)
+++ (revision )
@@ -1,104 +1,0 @@
-MODULE dommsk
- !!======================================================================
- !! *** MODULE dommsk ***
- !! Ocean initialization : domain land/sea masks, off-line case
- !!======================================================================
- !! History : 3.3 ! 2010-10 (C. Ethe) adapted from OPA_SRC/DOM/dommsk
- !!----------------------------------------------------------------------
-
- !!----------------------------------------------------------------------
- !! dom_msk : compute land/ocean mask
- !!----------------------------------------------------------------------
- USE oce ! ocean dynamics and tracers
- USE dom_oce ! ocean space and time domain
- USE lib_mpp ! MPP library
- USE in_out_manager ! I/O manager
- USE wrk_nemo
-
- IMPLICIT NONE
- PRIVATE
-
- PUBLIC dom_msk ! routine called by inidom.F90
-
- REAL(wp) :: rn_shlat = 2. ! type of lateral boundary condition on velocity
- LOGICAL, PUBLIC :: ln_vorlat = .false. ! consistency of vorticity boundary condition
-
- !! * Substitutions
-# include "vectopt_loop_substitute.h90"
- !!----------------------------------------------------------------------
- !! NEMO/OFF 3.3 , NEMO Consortium (2010)
- !! $Id$
- !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
- !!----------------------------------------------------------------------
-CONTAINS
-
- SUBROUTINE dom_msk
- !!---------------------------------------------------------------------
- !! *** ROUTINE dom_msk ***
- !!
- !! ** Purpose : Off-line case: defines the interior domain T-mask.
- !!
- !! ** Method : The interior ocean/land mask is computed from tmask
- !! setting to zero the duplicated row and lines due to
- !! MPP exchange halos, est-west cyclic and north fold
- !! boundary conditions.
- !!
- !! ** Action : tmask_i : interiorland/ocean mask at t-point
- !! tpol : ???
- !!----------------------------------------------------------------------
- !
- INTEGER :: ji, jk ! dummy loop indices
- INTEGER :: iif, iil, ijf, ijl ! local integers
- INTEGER, POINTER, DIMENSION(:,:) :: imsk
- !
- !!---------------------------------------------------------------------
-
- CALL wrk_alloc( jpi, jpj, imsk )
- !
- ! Interior domain mask (used for global sum)
- ! --------------------
- ssmask(:,:) = tmask(:,:,1)
- tmask_i(:,:) = tmask(:,:,1)
- iif = jpreci ! thickness of exchange halos in i-axis
- iil = nlci - jpreci + 1
- ijf = jprecj ! thickness of exchange halos in j-axis
- ijl = nlcj - jprecj + 1
- !
- tmask_i( 1 :iif, : ) = 0._wp ! first columns
- tmask_i(iil:jpi, : ) = 0._wp ! last columns (including mpp extra columns)
- tmask_i( : , 1 :ijf) = 0._wp ! first rows
- tmask_i( : ,ijl:jpj) = 0._wp ! last rows (including mpp extra rows)
- !
- ! ! north fold mask
- tpol(1:jpiglo) = 1._wp
- !
- IF( jperio == 3 .OR. jperio == 4 ) tpol(jpiglo/2+1:jpiglo) = 0._wp ! T-point pivot
- IF( jperio == 5 .OR. jperio == 6 ) tpol( 1 :jpiglo) = 0._wp ! F-point pivot
- IF( jperio == 3 .OR. jperio == 4 ) THEN ! T-point pivot: only half of the nlcj-1 row
- IF( mjg(ijl-1) == jpjglo-1 ) THEN
- DO ji = iif+1, iil-1
- tmask_i(ji,ijl-1) = tmask_i(ji,ijl-1) * tpol(mig(ji))
- END DO
- ENDIF
- ENDIF
- !
- IF( nprint == 1 .AND. lwp ) THEN ! Control print
- imsk(:,:) = INT( tmask_i(:,:) )
- WRITE(numout,*) ' tmask_i : '
- CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout)
- WRITE (numout,*)
- WRITE (numout,*) ' dommsk: tmask for each level'
- WRITE (numout,*) ' ----------------------------'
- DO jk = 1, jpk
- imsk(:,:) = INT( tmask(:,:,jk) )
- WRITE(numout,*)
- WRITE(numout,*) ' level = ',jk
- CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout)
- END DO
- ENDIF
- !
- CALL wrk_dealloc( jpi, jpj, imsk )
- !
- END SUBROUTINE dom_msk
- !!======================================================================
-END MODULE dommsk
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OFF_SRC/domrea.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OFF_SRC/domrea.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OFF_SRC/domrea.F90 (revision 5602)
@@ -1,35 +1,41 @@
MODULE domrea
- !!======================================================================
- !! *** MODULE domrea ***
- !! Ocean initialization : read the ocean domain meshmask file(s)
- !!======================================================================
- !! History : 3.3 ! 2010-05 (C. Ethe) Full reorganization of the off-line
+ !!==============================================================================
+ !! *** MODULE domrea ***
+ !! Ocean initialization : domain initialization
+ !!==============================================================================
+
!!----------------------------------------------------------------------
-
+ !! dom_init : initialize the space and time domain
+ !! dom_nam : read and contral domain namelists
+ !! dom_ctl : control print for the ocean domain
!!----------------------------------------------------------------------
- !! dom_rea : read mesh and mask file(s)
- !! nmsh = 1 : mesh_mask file
- !! = 2 : mesh and mask file
- !! = 3 : mesh_hgr, mesh_zgr and mask
- !!----------------------------------------------------------------------
+ !! * Modules used
+ USE oce !
USE dom_oce ! ocean space and time domain
- USE dommsk ! domain: masks
+ USE phycst ! physical constants
+ USE in_out_manager ! I/O manager
+ USE lib_mpp ! distributed memory computing library
+
+ USE domstp ! domain: set the time-step
+
USE lbclnk ! lateral boundary condition - MPP exchanges
USE trc_oce ! shared ocean/biogeochemical variables
- USE lib_mpp
- USE in_out_manager
USE wrk_nemo
-
+
IMPLICIT NONE
PRIVATE
- PUBLIC dom_rea ! routine called by inidom.F90
- !! * Substitutions
+ !! * Routine accessibility
+ PUBLIC dom_rea ! called by opa.F90
+
+ !! * Substitutions
# include "domzgr_substitute.h90"
+# include "vectopt_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OFF 3.3 , NEMO Consortium (2010)
!! $Id$
- !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+ !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
+
CONTAINS
@@ -37,4 +43,395 @@
!!----------------------------------------------------------------------
!! *** ROUTINE dom_rea ***
+ !!
+ !! ** Purpose : Domain initialization. Call the routines that are
+ !! required to create the arrays which define the space and time
+ !! domain of the ocean model.
+ !!
+ !! ** Method :
+ !! - dom_stp: defined the model time step
+ !! - dom_rea: read the meshmask file if nmsh=1
+ !!
+ !! History :
+ !! ! 90-10 (C. Levy - G. Madec) Original code
+ !! ! 91-11 (G. Madec)
+ !! ! 92-01 (M. Imbard) insert time step initialization
+ !! ! 96-06 (G. Madec) generalized vertical coordinate
+ !! ! 97-02 (G. Madec) creation of domwri.F
+ !! ! 01-05 (E.Durand - G. Madec) insert closed sea
+ !! 8.5 ! 02-08 (G. Madec) F90: Free form and module
+ !!----------------------------------------------------------------------
+ !! * Local declarations
+ INTEGER :: jk ! dummy loop argument
+ INTEGER :: iconf = 0 ! temporary integers
+ !!----------------------------------------------------------------------
+
+ IF(lwp) THEN
+ WRITE(numout,*)
+ WRITE(numout,*) 'dom_init : domain initialization'
+ WRITE(numout,*) '~~~~~~~~'
+ ENDIF
+
+ CALL dom_nam ! read namelist ( namrun, namdom, namcla )
+ CALL dom_zgr ! Vertical mesh and bathymetry option
+ CALL dom_grd ! Create a domain file
+
+ !
+ ! - ML - Used in dom_vvl_sf_nxt and lateral diffusion routines
+ ! but could be usefull in many other routines
+ e12t (:,:) = e1t(:,:) * e2t(:,:)
+ e1e2t (:,:) = e1t(:,:) * e2t(:,:)
+ e12u (:,:) = e1u(:,:) * e2u(:,:)
+ e12v (:,:) = e1v(:,:) * e2v(:,:)
+ e12f (:,:) = e1f(:,:) * e2f(:,:)
+ r1_e12t (:,:) = 1._wp / e12t(:,:)
+ r1_e12u (:,:) = 1._wp / e12u(:,:)
+ r1_e12v (:,:) = 1._wp / e12v(:,:)
+ r1_e12f (:,:) = 1._wp / e12f(:,:)
+ re2u_e1u(:,:) = e2u(:,:) / e1u(:,:)
+ re1v_e2v(:,:) = e1v(:,:) / e2v(:,:)
+ !
+ hu(:,:) = 0._wp ! Ocean depth at U- and V-points
+ hv(:,:) = 0._wp
+ DO jk = 1, jpk
+ hu(:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk)
+ hv(:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk)
+ END DO
+ ! ! Inverse of the local depth
+ hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask(:,:,1) ) * umask(:,:,1)
+ hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask(:,:,1) ) * vmask(:,:,1)
+
+ CALL dom_stp ! Time step
+ CALL dom_msk ! Masks
+ CALL dom_ctl ! Domain control
+
+ END SUBROUTINE dom_rea
+
+ SUBROUTINE dom_nam
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE dom_nam ***
+ !!
+ !! ** Purpose : read domaine namelists and print the variables.
+ !!
+ !! ** input : - namrun namelist
+ !! - namdom namelist
+ !! - namcla namelist
+ !!----------------------------------------------------------------------
+ USE ioipsl
+ INTEGER :: ios ! Local integer output status for namelist read
+ NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list, &
+ & nn_no , cn_exp , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl, &
+ & nn_it000, nn_itend , nn_date0 , nn_leapy , nn_istate , nn_stock , &
+ & nn_write, ln_dimgnnn, ln_mskland , ln_cfmeta , ln_clobber, nn_chunksz, nn_euler
+ NAMELIST/namdom/ nn_bathy , rn_bathy, rn_e3zps_min, rn_e3zps_rat, nn_msh , rn_hmin, &
+ & nn_acc , rn_atfp , rn_rdt , rn_rdtmin , &
+ & rn_rdtmax, rn_rdth , nn_baro , nn_closea , ln_crs, &
+ & jphgr_msh, &
+ & ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, &
+ & ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, &
+ & ppa2, ppkth2, ppacr2
+ NAMELIST/namcla/ nn_cla
+#if defined key_netcdf4
+ NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
+#endif
+ !!----------------------------------------------------------------------
+
+ REWIND( numnam_ref ) ! Namelist namrun in reference namelist : Parameters of the run
+ READ ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
+901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
+
+ REWIND( numnam_cfg ) ! Namelist namrun in configuration namelist : Parameters of the run
+ READ ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
+902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
+ IF(lwm) WRITE ( numond, namrun )
+ !
+ IF(lwp) THEN ! control print
+ WRITE(numout,*)
+ WRITE(numout,*) 'dom_nam : domain initialization through namelist read'
+ WRITE(numout,*) '~~~~~~~ '
+ WRITE(numout,*) ' Namelist namrun'
+ WRITE(numout,*) ' job number nn_no = ', nn_no
+ WRITE(numout,*) ' experiment name for output cn_exp = ', cn_exp
+ WRITE(numout,*) ' restart logical ln_rstart = ', ln_rstart
+ WRITE(numout,*) ' control of time step nn_rstctl = ', nn_rstctl
+ WRITE(numout,*) ' number of the first time step nn_it000 = ', nn_it000
+ WRITE(numout,*) ' number of the last time step nn_itend = ', nn_itend
+ WRITE(numout,*) ' initial calendar date aammjj nn_date0 = ', nn_date0
+ WRITE(numout,*) ' leap year calendar (0/1) nn_leapy = ', nn_leapy
+ WRITE(numout,*) ' initial state output nn_istate = ', nn_istate
+ WRITE(numout,*) ' frequency of restart file nn_stock = ', nn_stock
+ WRITE(numout,*) ' frequency of output file nn_write = ', nn_write
+ WRITE(numout,*) ' multi file dimgout ln_dimgnnn = ', ln_dimgnnn
+ WRITE(numout,*) ' mask land points ln_mskland = ', ln_mskland
+ WRITE(numout,*) ' additional CF standard metadata ln_cfmeta = ', ln_cfmeta
+ WRITE(numout,*) ' overwrite an existing file ln_clobber = ', ln_clobber
+ WRITE(numout,*) ' NetCDF chunksize (bytes) nn_chunksz = ', nn_chunksz
+ ENDIF
+ no = nn_no ! conversion DOCTOR names into model names (this should disappear soon)
+ cexper = cn_exp
+ nrstdt = nn_rstctl
+ nit000 = nn_it000
+ nitend = nn_itend
+ ndate0 = nn_date0
+ nleapy = nn_leapy
+ ninist = nn_istate
+ nstock = nn_stock
+ nstocklist = nn_stocklist
+ nwrite = nn_write
+
+
+ ! ! control of output frequency
+ IF ( nstock == 0 .OR. nstock > nitend ) THEN
+ WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
+ CALL ctl_warn( ctmp1 )
+ nstock = nitend
+ ENDIF
+ IF ( nwrite == 0 ) THEN
+ WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
+ CALL ctl_warn( ctmp1 )
+ nwrite = nitend
+ ENDIF
+
+ ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day)
+ ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
+ adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
+
+#if defined key_agrif
+ IF( Agrif_Root() ) THEN
+#endif
+ SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL
+ CASE ( 1 )
+ CALL ioconf_calendar('gregorian')
+ IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "gregorian", i.e. leap year'
+ CASE ( 0 )
+ CALL ioconf_calendar('noleap')
+ IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "noleap", i.e. no leap year'
+ CASE ( 30 )
+ CALL ioconf_calendar('360d')
+ IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "360d", i.e. 360 days in a year'
+ END SELECT
+#if defined key_agrif
+ ENDIF
+#endif
+
+ REWIND( numnam_ref ) ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
+ READ ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
+903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
+
+ REWIND( numnam_cfg ) ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
+ READ ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
+904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
+ IF(lwm) WRITE ( numond, namdom )
+
+ IF(lwp) THEN
+ WRITE(numout,*)
+ WRITE(numout,*) ' Namelist namdom : space & time domain'
+ WRITE(numout,*) ' flag read/compute bathymetry nn_bathy = ', nn_bathy
+ WRITE(numout,*) ' Depth (if =0 bathy=jpkm1) rn_bathy = ', rn_bathy
+ WRITE(numout,*) ' min depth of the ocean (>0) or rn_hmin = ', rn_hmin
+ WRITE(numout,*) ' minimum thickness of partial rn_e3zps_min = ', rn_e3zps_min, ' (m)'
+ WRITE(numout,*) ' step level rn_e3zps_rat = ', rn_e3zps_rat
+ WRITE(numout,*) ' create mesh/mask file(s) nn_msh = ', nn_msh
+ WRITE(numout,*) ' = 0 no file created '
+ WRITE(numout,*) ' = 1 mesh_mask '
+ WRITE(numout,*) ' = 2 mesh and mask '
+ WRITE(numout,*) ' = 3 mesh_hgr, msh_zgr and mask '
+ WRITE(numout,*) ' ocean time step rn_rdt = ', rn_rdt
+ WRITE(numout,*) ' asselin time filter parameter rn_atfp = ', rn_atfp
+ WRITE(numout,*) ' time-splitting: nb of sub time-step nn_baro = ', nn_baro
+ WRITE(numout,*) ' acceleration of converge nn_acc = ', nn_acc
+ WRITE(numout,*) ' nn_acc=1: surface tracer rdt rn_rdtmin = ', rn_rdtmin
+ WRITE(numout,*) ' bottom tracer rdt rdtmax = ', rn_rdtmax
+ WRITE(numout,*) ' depth of transition rn_rdth = ', rn_rdth
+ WRITE(numout,*) ' suppression of closed seas (=0) nn_closea = ', nn_closea
+ WRITE(numout,*) ' type of horizontal mesh jphgr_msh = ', jphgr_msh
+ WRITE(numout,*) ' longitude of first raw and column T-point ppglam0 = ', ppglam0
+ WRITE(numout,*) ' latitude of first raw and column T-point ppgphi0 = ', ppgphi0
+ WRITE(numout,*) ' zonal grid-spacing (degrees) ppe1_deg = ', ppe1_deg
+ WRITE(numout,*) ' meridional grid-spacing (degrees) ppe2_deg = ', ppe2_deg
+ WRITE(numout,*) ' zonal grid-spacing (degrees) ppe1_m = ', ppe1_m
+ WRITE(numout,*) ' meridional grid-spacing (degrees) ppe2_m = ', ppe2_m
+ WRITE(numout,*) ' ORCA r4, r2 and r05 coefficients ppsur = ', ppsur
+ WRITE(numout,*) ' ppa0 = ', ppa0
+ WRITE(numout,*) ' ppa1 = ', ppa1
+ WRITE(numout,*) ' ppkth = ', ppkth
+ WRITE(numout,*) ' ppacr = ', ppacr
+ WRITE(numout,*) ' Minimum vertical spacing ppdzmin = ', ppdzmin
+ WRITE(numout,*) ' Maximum depth pphmax = ', pphmax
+ WRITE(numout,*) ' Use double tanf function for vertical coordinates ldbletanh = ', ldbletanh
+ WRITE(numout,*) ' Double tanh function parameters ppa2 = ', ppa2
+ WRITE(numout,*) ' ppkth2 = ', ppkth2
+ WRITE(numout,*) ' ppacr2 = ', ppacr2
+ ENDIF
+
+ ntopo = nn_bathy ! conversion DOCTOR names into model names (this should disappear soon)
+ e3zps_min = rn_e3zps_min
+ e3zps_rat = rn_e3zps_rat
+ nmsh = nn_msh
+ nacc = nn_acc
+ atfp = rn_atfp
+ rdt = rn_rdt
+ rdtmin = rn_rdtmin
+ rdtmax = rn_rdtmin
+ rdth = rn_rdth
+
+ REWIND( numnam_ref ) ! Namelist namcla in reference namelist : Cross land advection
+ READ ( numnam_ref, namcla, IOSTAT = ios, ERR = 905)
+905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in reference namelist', lwp )
+
+ REWIND( numnam_cfg ) ! Namelist namcla in configuration namelist : Cross land advection
+ READ ( numnam_cfg, namcla, IOSTAT = ios, ERR = 906 )
+906 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in configuration namelist', lwp )
+ IF(lwm) WRITE( numond, namcla )
+
+ IF(lwp) THEN
+ WRITE(numout,*)
+ WRITE(numout,*) ' Namelist namcla'
+ WRITE(numout,*) ' cross land advection nn_cla = ', nn_cla
+ ENDIF
+
+#if defined key_netcdf4
+ ! ! NetCDF 4 case ("key_netcdf4" defined)
+ REWIND( numnam_ref ) ! Namelist namnc4 in reference namelist : NETCDF
+ READ ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
+907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp )
+
+ REWIND( numnam_cfg ) ! Namelist namnc4 in configuration namelist : NETCDF
+ READ ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
+908 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp )
+ IF(lwm) WRITE( numond, namnc4 )
+ IF(lwp) THEN ! control print
+ WRITE(numout,*)
+ WRITE(numout,*) ' Namelist namnc4 - Netcdf4 chunking parameters'
+ WRITE(numout,*) ' number of chunks in i-dimension nn_nchunks_i = ', nn_nchunks_i
+ WRITE(numout,*) ' number of chunks in j-dimension nn_nchunks_j = ', nn_nchunks_j
+ WRITE(numout,*) ' number of chunks in k-dimension nn_nchunks_k = ', nn_nchunks_k
+ WRITE(numout,*) ' apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
+ ENDIF
+
+ ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
+ ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
+ snc4set%ni = nn_nchunks_i
+ snc4set%nj = nn_nchunks_j
+ snc4set%nk = nn_nchunks_k
+ snc4set%luse = ln_nc4zip
+#else
+ snc4set%luse = .FALSE. ! No NetCDF 4 case
+#endif
+ !
+ END SUBROUTINE dom_nam
+
+ SUBROUTINE dom_zgr
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE dom_zgr ***
+ !!
+ !! ** Purpose : set the depth of model levels and the resulting
+ !! vertical scale factors.
+ !!
+ !! ** Method : - reference 1D vertical coordinate (gdep._1d, e3._1d)
+ !! - read/set ocean depth and ocean levels (bathy, mbathy)
+ !! - vertical coordinate (gdep., e3.) depending on the
+ !! coordinate chosen :
+ !! ln_zco=T z-coordinate
+ !! ln_zps=T z-coordinate with partial steps
+ !! ln_zco=T s-coordinate
+ !!
+ !! ** Action : define gdep., e3., mbathy and bathy
+ !!----------------------------------------------------------------------
+ INTEGER :: ioptio = 0 ! temporary integer
+ INTEGER :: ios
+ !!
+ NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav
+ !!----------------------------------------------------------------------
+
+ REWIND( numnam_ref ) ! Namelist namzgr in reference namelist : Vertical coordinate
+ READ ( numnam_ref, namzgr, IOSTAT = ios, ERR = 901 )
+901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist', lwp )
+
+ REWIND( numnam_cfg ) ! Namelist namzgr in configuration namelist : Vertical coordinate
+ READ ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 )
+902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp )
+ IF(lwm) WRITE ( numond, namzgr )
+
+ IF(lwp) THEN ! Control print
+ WRITE(numout,*)
+ WRITE(numout,*) 'dom_zgr : vertical coordinate'
+ WRITE(numout,*) '~~~~~~~'
+ WRITE(numout,*) ' Namelist namzgr : set vertical coordinate'
+ WRITE(numout,*) ' z-coordinate - full steps ln_zco = ', ln_zco
+ WRITE(numout,*) ' z-coordinate - partial steps ln_zps = ', ln_zps
+ WRITE(numout,*) ' s- or hybrid z-s-coordinate ln_sco = ', ln_sco
+ WRITE(numout,*) ' ice shelf cavity ln_isfcav = ', ln_isfcav
+ ENDIF
+
+ ioptio = 0 ! Check Vertical coordinate options
+ IF( ln_zco ) ioptio = ioptio + 1
+ IF( ln_zps ) ioptio = ioptio + 1
+ IF( ln_sco ) ioptio = ioptio + 1
+ IF( ln_isfcav ) ioptio = 33
+ IF ( ioptio /= 1 ) CALL ctl_stop( ' none or several vertical coordinate options used' )
+ IF ( ioptio == 33 ) CALL ctl_stop( ' isf cavity with off line module not yet done ' )
+
+ END SUBROUTINE dom_zgr
+
+ SUBROUTINE dom_ctl
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE dom_ctl ***
+ !!
+ !! ** Purpose : Domain control.
+ !!
+ !! ** Method : compute and print extrema of masked scale factors
+ !!
+ !! History :
+ !! 8.5 ! 02-08 (G. Madec) Original code
+ !!----------------------------------------------------------------------
+ !! * Local declarations
+ INTEGER :: iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
+ INTEGER, DIMENSION(2) :: iloc !
+ REAL(wp) :: ze1min, ze1max, ze2min, ze2max
+ !!----------------------------------------------------------------------
+
+ ! Extrema of the scale factors
+
+ IF(lwp)WRITE(numout,*)
+ IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
+ IF(lwp)WRITE(numout,*) '~~~~~~~'
+
+ IF (lk_mpp) THEN
+ CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
+ CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
+ CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
+ CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
+ ELSE
+ ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
+ ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
+ ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
+ ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
+
+ iloc = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
+ iimi1 = iloc(1) + nimpp - 1
+ ijmi1 = iloc(2) + njmpp - 1
+ iloc = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
+ iimi2 = iloc(1) + nimpp - 1
+ ijmi2 = iloc(2) + njmpp - 1
+ iloc = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
+ iima1 = iloc(1) + nimpp - 1
+ ijma1 = iloc(2) + njmpp - 1
+ iloc = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
+ iima2 = iloc(1) + nimpp - 1
+ ijma2 = iloc(2) + njmpp - 1
+ ENDIF
+
+ IF(lwp) THEN
+ WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
+ WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
+ WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
+ WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
+ ENDIF
+
+ END SUBROUTINE dom_ctl
+
+ SUBROUTINE dom_grd
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE dom_grd ***
!!
!! ** Purpose : Read the NetCDF file(s) which contain(s) all the
@@ -344,5 +741,5 @@
CALL wrk_dealloc( jpi, jpj, zmbk, zprt, zprw )
!
- END SUBROUTINE dom_rea
+ END SUBROUTINE dom_grd
@@ -388,4 +785,101 @@
END SUBROUTINE zgr_bot_level
+ SUBROUTINE dom_msk
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE dom_msk ***
+ !!
+ !! ** Purpose : Off-line case: defines the interior domain T-mask.
+ !!
+ !! ** Method : The interior ocean/land mask is computed from tmask
+ !! setting to zero the duplicated row and lines due to
+ !! MPP exchange halos, est-west cyclic and north fold
+ !! boundary conditions.
+ !!
+ !! ** Action : tmask_i : interiorland/ocean mask at t-point
+ !! tpol : ???
+ !!----------------------------------------------------------------------
+ !
+ INTEGER :: ji, jj, jk ! dummy loop indices
+ INTEGER :: iif, iil, ijf, ijl ! local integers
+ INTEGER, POINTER, DIMENSION(:,:) :: imsk
+ !
+ !!---------------------------------------------------------------------
+
+ CALL wrk_alloc( jpi, jpj, imsk )
+ !
+ ! Interior domain mask (used for global sum)
+ ! --------------------
+ ssmask(:,:) = tmask(:,:,1)
+ tmask_i(:,:) = tmask(:,:,1)
+ iif = jpreci ! thickness of exchange halos in i-axis
+ iil = nlci - jpreci + 1
+ ijf = jprecj ! thickness of exchange halos in j-axis
+ ijl = nlcj - jprecj + 1
+ !
+ tmask_i( 1 :iif, : ) = 0._wp ! first columns
+ tmask_i(iil:jpi, : ) = 0._wp ! last columns (including mpp extra columns)
+ tmask_i( : , 1 :ijf) = 0._wp ! first rows
+ tmask_i( : ,ijl:jpj) = 0._wp ! last rows (including mpp extra rows)
+ !
+ ! ! north fold mask
+ tpol(1:jpiglo) = 1._wp
+ !
+ IF( jperio == 3 .OR. jperio == 4 ) tpol(jpiglo/2+1:jpiglo) = 0._wp ! T-point pivot
+ IF( jperio == 5 .OR. jperio == 6 ) tpol( 1 :jpiglo) = 0._wp ! F-point pivot
+ IF( jperio == 3 .OR. jperio == 4 ) THEN ! T-point pivot: only half of the nlcj-1 row
+ IF( mjg(ijl-1) == jpjglo-1 ) THEN
+ DO ji = iif+1, iil-1
+ tmask_i(ji,ijl-1) = tmask_i(ji,ijl-1) * tpol(mig(ji))
+ END DO
+ ENDIF
+ ENDIF
+ !
+ ! (ISF) MIN(1,SUM(umask)) is here to check if you have effectively at
+ ! least 1 wet u point
+ DO jj = 1, jpjm1
+ DO ji = 1, fs_jpim1 ! vector loop
+ umask_i(ji,jj) = ssmask(ji,jj) * ssmask(ji+1,jj ) * MIN(1._wp,SUM(umask(ji,jj,:)))
+ vmask_i(ji,jj) = ssmask(ji,jj) * ssmask(ji ,jj+1) * MIN(1._wp,SUM(vmask(ji,jj,:)))
+ END DO
+ DO ji = 1, jpim1 ! NO vector opt.
+ fmask_i(ji,jj) = ssmask(ji,jj ) * ssmask(ji+1,jj ) &
+ & * ssmask(ji,jj+1) * ssmask(ji+1,jj+1) * MIN(1._wp,SUM(fmask(ji,jj,:)))
+ END DO
+ END DO
+ CALL lbc_lnk( umask_i, 'U', 1._wp ) ! Lateral boundary conditions
+ CALL lbc_lnk( vmask_i, 'V', 1._wp )
+ CALL lbc_lnk( fmask_i, 'F', 1._wp )
+
+ ! 3. Ocean/land mask at wu-, wv- and w points
+ !----------------------------------------------
+ wmask (:,:,1) = tmask(:,:,1) ! ????????
+ wumask(:,:,1) = umask(:,:,1) ! ????????
+ wvmask(:,:,1) = vmask(:,:,1) ! ????????
+ DO jk=2,jpk
+ wmask (:,:,jk)=tmask(:,:,jk) * tmask(:,:,jk-1)
+ wumask(:,:,jk)=umask(:,:,jk) * umask(:,:,jk-1)
+ wvmask(:,:,jk)=vmask(:,:,jk) * vmask(:,:,jk-1)
+ END DO
+ !
+ IF( nprint == 1 .AND. lwp ) THEN ! Control print
+ imsk(:,:) = INT( tmask_i(:,:) )
+ WRITE(numout,*) ' tmask_i : '
+ CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout)
+ WRITE (numout,*)
+ WRITE (numout,*) ' dommsk: tmask for each level'
+ WRITE (numout,*) ' ----------------------------'
+ DO jk = 1, jpk
+ imsk(:,:) = INT( tmask(:,:,jk) )
+ WRITE(numout,*)
+ WRITE(numout,*) ' level = ',jk
+ CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout)
+ END DO
+ ENDIF
+ !
+ CALL wrk_dealloc( jpi, jpj, imsk )
+ !
+ END SUBROUTINE dom_msk
+
!!======================================================================
END MODULE domrea
+
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90 (revision 5602)
@@ -245,5 +245,10 @@
tsn(:,:,:,jp_sal) = sf_dyn(jf_sal)%fnow(:,:,:) * tmask(:,:,:) ! salinity
!
- CALL eos ( tsn, rhd, rhop, gdept_0(:,:,:) ) ! In any case, we need rhop
+ !
+ CALL eos ( tsn, rhd, rhop, gdept_0(:,:,:) ) ! In any case, we need rhop
+ CALL eos_rab( tsn, rab_n ) ! now local thermal/haline expension ratio at T-points
+ CALL bn2 ( tsn, rab_n, rn2 ) ! before Brunt-Vaisala frequency need for zdfmxl
+
+ rn2b(:,:,:) = rn2(:,:,:) ! need for zdfmxl
CALL zdf_mxl( kt ) ! In any case, we need mxl
!
@@ -259,5 +264,5 @@
fr_i(:,:) = sf_dyn(jf_ice)%fnow(:,:,1) * tmask(:,:,1) ! Sea-ice fraction
qsr (:,:) = sf_dyn(jf_qsr)%fnow(:,:,1) * tmask(:,:,1) ! solar radiation
- IF ( ln_dynrnf ) &
+ IF( ln_dynrnf ) &
rnf (:,:) = sf_dyn(jf_rnf)%fnow(:,:,1) * tmask(:,:,1) ! river runoffs
@@ -383,5 +388,5 @@
!
- IF ( ln_dynrnf ) THEN
+ IF( ln_dynrnf ) THEN
jf_rnf = jfld + 1 ; jfld = jf_rnf
slf_d(jf_rnf) = sn_rnf
@@ -535,14 +540,18 @@
!!---------------------------------------------------------------------
#if defined key_ldfslp && ! defined key_c1d
+ CALL eos ( pts, rhd, rhop, gdept_0(:,:,:) )
CALL eos_rab( pts, rab_n ) ! now local thermal/haline expension ratio at T-points
CALL bn2 ( pts, rab_n, rn2 ) ! now Brunt-Vaisala
- IF( ln_zps ) & ! Partial steps: before Horizontal DErivative
- & CALL zps_hde( kt, jpts, pts, gtsu, gtsv, & ! Partial steps: before horizontal gradient
- & rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv , & !
- & gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) ! of t, s, rd at the last ocean level
- ! only gtsu, gtsv, rhd, gru , grv are used
-
-
- ! ! of t, s, rd at the bottom ocean level
+
+ ! Partial steps: before Horizontal DErivative
+ IF( ln_zps .AND. .NOT. ln_isfcav) &
+ & CALL zps_hde ( kt, jpts, pts, gtsu, gtsv, & ! Partial steps: before horizontal gradient
+ & rhd, gru , grv ) ! of t, s, rd at the last ocean level
+ IF( ln_zps .AND. ln_isfcav) &
+ & CALL zps_hde_isf( kt, jpts, pts, gtsu, gtsv, & ! Partial steps for top cell (ISF)
+ & rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv , &
+ & gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) ! of t, s, rd at the first ocean level
+
+ rn2b(:,:,:) = rn2(:,:,:) ! need for zdfmxl
CALL zdf_mxl( kt ) ! mixed layer depth
CALL ldf_slp( kt, rhd, rn2 ) ! slopes
Index: anches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OFF_SRC/istate.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OFF_SRC/istate.F90 (revision 5601)
+++ (revision )
@@ -1,51 +1,0 @@
-MODULE istate
- !!======================================================================
- !! *** MODULE istate ***
- !! Ocean state : initial state setting, off-line case
- !!=====================================================================
- !! History : 3.3 ! 2010-10 (C. Ethe) original code
- !!----------------------------------------------------------------------
-
- !!----------------------------------------------------------------------
- !! istate_init : initial state set to zero
- !!----------------------------------------------------------------------
- USE oce ! ocean dynamics and active tracers
- USE dom_oce ! ocean space and time domain
-
- IMPLICIT NONE
- PRIVATE
-
- PUBLIC istate_init ! routine called by step.F90
-
- !! * Substitutions
-# include "domzgr_substitute.h90"
-# include "vectopt_loop_substitute.h90"
- !!----------------------------------------------------------------------
- !! NEMO/OFF 3.3 , NEMO Consortium (2010)
- !! $Id$
- !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
- !!---------------------------------------------------------------------
-CONTAINS
-
- SUBROUTINE istate_init
- !!----------------------------------------------------------------------
- !! *** ROUTINE istate_init ***
- !!
- !! ** Purpose : Initialization to zero of the dynamics and tracers.
- !!----------------------------------------------------------------------
- !
- ! now fields ! after fields !
- un (:,:,:) = 0._wp ; ua(:,:,:) = 0._wp !
- vn (:,:,:) = 0._wp ; va(:,:,:) = 0._wp !
- wn (:,:,:) = 0._wp ! !
- hdivn(:,:,:) = 0._wp ! !
- tsn (:,:,:,:) = 0._wp ! !
- !
- rhd (:,:,:) = 0.e0
- rhop (:,:,:) = 0.e0
- rn2 (:,:,:) = 0.e0
- !
- END SUBROUTINE istate_init
-
- !!=====================================================================
-END MODULE istate
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90 (revision 5602)
@@ -18,6 +18,6 @@
USE c1d ! 1D configuration
USE domcfg ! domain configuration (dom_cfg routine)
- USE domain ! domain initialization (dom_init routine)
- USE istate ! initial state setting (istate_init routine)
+ USE domain ! domain initialization from coordinate & bathymetry (dom_init routine)
+ USE domrea ! domain initialization from mesh_mask (dom_init routine)
USE eosbn2 ! equation of state (eos bn2 routine)
! ! ocean physics
@@ -34,5 +34,4 @@
USE trcstp ! passive tracer time-stepping (trc_stp routine)
USE dtadyn ! Lecture and interpolation of the dynamical fields
- USE stpctl ! time stepping control (stp_ctl routine)
! ! I/O & MPP
USE iom ! I/O library
@@ -46,5 +45,5 @@
USE timing ! Timing
USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
- USE lbcnfd, ONLY: isendto, nsndto
+ USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges
USE trc
@@ -62,5 +61,5 @@
!!----------------------------------------------------------------------
!! NEMO/OFF 3.3 , NEMO Consortium (2010)
- !! $Id: nemogcm.F90 2528 2010-12-27 17:33:53Z rblod $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
@@ -95,5 +94,5 @@
istp = nit000
!
- CALL iom_init( "nemo" ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)
+ CALL iom_init( cxios_context ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)
!
DO WHILE ( istp <= nitend .AND. nstop == 0 ) ! time stepping
@@ -108,5 +107,5 @@
END DO
#if defined key_iomput
- CALL iom_context_finalize( "nemo" ) ! needed for XIOS+AGRIF
+ CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF
#endif
@@ -143,4 +142,5 @@
INTEGER :: ilocal_comm ! local integer
INTEGER :: ios
+ LOGICAL :: llexist
CHARACTER(len=80), DIMENSION(16) :: cltxt
!!
@@ -149,7 +149,8 @@
& nn_bench, nn_timing
NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, &
- & jpizoom, jpjzoom, jperio
+ & jpizoom, jpjzoom, jperio, ln_use_jattr
!!----------------------------------------------------------------------
cltxt = ''
+ cxios_context = 'nemo'
!
! ! Open reference namelist and configuration namelist files
@@ -181,9 +182,9 @@
! !--------------------------------------------!
#if defined key_iomput
- CALL xios_initialize( "nemo",return_comm=ilocal_comm )
- narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection
+ CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )
+ narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection
#else
ilocal_comm = 0
- narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop ) ! Nodes selection (control print return in cltxt)
+ narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop ) ! Nodes selection (control print return in cltxt)
#endif
@@ -233,5 +234,5 @@
WRITE(numout,*) ' NEMO team'
WRITE(numout,*) ' Ocean General Circulation Model'
- WRITE(numout,*) ' version 3.5 (2012) '
+ WRITE(numout,*) ' version 3.6 (2015) '
WRITE(numout,*)
WRITE(numout,*)
@@ -268,5 +269,10 @@
IF( lk_c1d ) CALL c1d_init ! 1D column configuration
CALL dom_cfg ! Domain configuration
- CALL dom_init ! Domain
+ !
+ INQUIRE( FILE='coordinates.nc', EXIST = llexist ) ! Check if coordinate file exist
+ !
+ IF( llexist ) THEN ; CALL dom_init ! compute the grid from coordinates and bathymetry
+ ELSE ; CALL dom_rea ! read grid from the meskmask
+ ENDIF
CALL istate_init ! ocean initial state (Dynamics and tracers)
@@ -275,6 +281,6 @@
IF( ln_ctl ) CALL prt_ctl_init ! Print control
- ! ! Ocean physics
CALL sbc_init ! Forcings : surface module
+
#if ! defined key_degrad
CALL ldf_tra_init ! Lateral ocean tracer physics
@@ -282,27 +288,15 @@
IF( lk_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing
- ! ! Active tracers
CALL tra_qsr_init ! penetrative solar radiation qsr
IF( lk_trabbl ) CALL tra_bbl_init ! advective (and/or diffusive) bottom boundary layer scheme
- CALL trc_nam_run ! Needed to get restart parameters for passive tracers
- IF( ln_rsttr ) THEN
- neuler = 1 ! Set time-step indicator at nit000 (leap-frog)
- CALL trc_rst_cal( nit000, 'READ' ) ! calendar
- ELSE
- neuler = 0 ! Set time-step indicator at nit000 (euler)
- CALL day_init ! set calendar
- ENDIF
- ! ! Dynamics
+ CALL trc_nam_run ! Needed to get restart parameters for passive tracers
+ CALL trc_rst_cal( nit000, 'READ' ) ! calendar
CALL dta_dyn_init ! Initialization for the dynamics
- ! ! Passive tracers
CALL trc_init ! Passive tracers initialization
- !
- ! Initialise diaptr as some variables are used in if statements later (in
- ! various advection and diffusion routines.
- CALL dia_ptr_init
- !
- IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
+ CALL dia_ptr_init ! Initialise diaptr as some variables are used
+ ! ! in various advection and diffusion routines
+ IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
!
IF( nn_timing == 1 ) CALL timing_stop( 'nemo_init')
@@ -359,4 +353,5 @@
WRITE(numout,*) ' left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom
WRITE(numout,*) ' lateral cond. type (between 0 and 6) jperio = ', jperio
+ WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr
ENDIF
! ! Parameter control
@@ -594,5 +589,6 @@
!!----------------------------------------------------------------------
!! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE)
- !! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC)
+ !! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S.
+ !Mocavero, CMCC)
!!----------------------------------------------------------------------
@@ -617,27 +613,38 @@
!loop over the other north-fold processes to find the processes
!managing the points belonging to the sxT-dxT range
- DO jn = jpnij - jpni +1, jpnij
- IF ( njmppt(jn) == njmppmax ) THEN
+
+ DO jn = 1, jpni
!sxT is the first point (in the global domain) of the jn
!process
- sxT = nimppt(jn)
+ sxT = nfiimpp(jn, jpnj)
!dxT is the last point (in the global domain) of the jn
!process
- dxT = nimppt(jn) + nlcit(jn) - 1
+ dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1
IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN
nsndto = nsndto + 1
- isendto(nsndto) = jn
- ELSEIF ((sxM .le. sxT) .AND. (dxM .gt. dxT)) THEN
+ isendto(nsndto) = jn
+ ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN
nsndto = nsndto + 1
- isendto(nsndto) = jn
+ isendto(nsndto) = jn
ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN
nsndto = nsndto + 1
- isendto(nsndto) = jn
+ isendto(nsndto) = jn
END IF
- END IF
END DO
+ nfsloop = 1
+ nfeloop = nlci
+ DO jn = 2,jpni-1
+ IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN
+ IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN
+ nfsloop = nldi
+ ENDIF
+ IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN
+ nfeloop = nlei
+ ENDIF
+ ENDIF
+ END DO
+
ENDIF
l_north_nogather = .TRUE.
-
END SUBROUTINE nemo_northcomms
#else
@@ -646,4 +653,51 @@
END SUBROUTINE nemo_northcomms
#endif
+
+ SUBROUTINE istate_init
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE istate_init ***
+ !!
+ !! ** Purpose : Initialization to zero of the dynamics and tracers.
+ !!----------------------------------------------------------------------
+ !
+ ! now fields ! after fields !
+ un (:,:,:) = 0._wp ; ua(:,:,:) = 0._wp !
+ vn (:,:,:) = 0._wp ; va(:,:,:) = 0._wp !
+ wn (:,:,:) = 0._wp ! !
+ hdivn(:,:,:) = 0._wp ! !
+ tsn (:,:,:,:) = 0._wp ! !
+ !
+ rhd (:,:,:) = 0.e0
+ rhop (:,:,:) = 0.e0
+ rn2 (:,:,:) = 0.e0
+ !
+ END SUBROUTINE istate_init
+
+ SUBROUTINE stp_ctl( kt, kindic )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE stp_ctl ***
+ !!
+ !! ** Purpose : Control the run
+ !!
+ !! ** Method : - Save the time step in numstp
+ !!
+ !! ** Actions : 'time.step' file containing the last ocean time-step
+ !!----------------------------------------------------------------------
+ INTEGER, INTENT(in ) :: kt ! ocean time-step index
+ INTEGER, INTENT(inout) :: kindic ! indicator of solver convergence
+ !!----------------------------------------------------------------------
+ !
+ IF( kt == nit000 .AND. lwp ) THEN
+ WRITE(numout,*)
+ WRITE(numout,*) 'stp_ctl : time-stepping control'
+ WRITE(numout,*) '~~~~~~~'
+ ! open time.step file
+ CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
+ ENDIF
+ !
+ IF(lwp) WRITE ( numstp, '(1x, i8)' ) kt !* save the current time step in numstp
+ IF(lwp) REWIND( numstp ) ! --------------------------
+ !
+ END SUBROUTINE stp_ctl
!!======================================================================
END MODULE nemogcm
Index: anches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OFF_SRC/stpctl.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OFF_SRC/stpctl.F90 (revision 5601)
+++ (revision )
@@ -1,62 +1,0 @@
-MODULE stpctl
- !!======================================================================
- !! *** MODULE stpctl ***
- !! Ocean run control : Off-line case, only save the time step in numstp
- !!======================================================================
- !! History : OPA ! 1991-03 (G. Madec) Original code
- !! 6.0 ! 1992-06 (M. Imbard)
- !! 8.0 ! 1997-06 (A.M. Treguier)
- !! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module
- !! 2.0 ! 2009-07 (G. Madec) Add statistic for time-spliting
- !!----------------------------------------------------------------------
-
- !!----------------------------------------------------------------------
- !! stp_ctl : Control the run
- !!----------------------------------------------------------------------
- USE oce ! ocean dynamics and tracers variables
- USE dom_oce ! ocean space and time domain variables
- USE in_out_manager ! I/O manager
- USE lbclnk ! ocean lateral boundary conditions (or mpp link)
- USE lib_mpp ! distributed memory computing
-
- IMPLICIT NONE
- PRIVATE
-
- PUBLIC stp_ctl ! routine called by opa.F90
-
- !!----------------------------------------------------------------------
- !! NEMO/OFF 3.3 , NEMO Consortium (2010)
- !! $Id$
- !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
- !!----------------------------------------------------------------------
-CONTAINS
-
- SUBROUTINE stp_ctl( kt, kindic )
- !!----------------------------------------------------------------------
- !! *** ROUTINE stp_ctl ***
- !!
- !! ** Purpose : Control the run
- !!
- !! ** Method : - Save the time step in numstp
- !!
- !! ** Actions : 'time.step' file containing the last ocean time-step
- !!----------------------------------------------------------------------
- INTEGER, INTENT(in ) :: kt ! ocean time-step index
- INTEGER, INTENT(inout) :: kindic ! indicator of solver convergence
- !!----------------------------------------------------------------------
- !
- IF( kt == nit000 .AND. lwp ) THEN
- WRITE(numout,*)
- WRITE(numout,*) 'stp_ctl : time-stepping control'
- WRITE(numout,*) '~~~~~~~'
- ! open time.step file
- CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
- ENDIF
- !
- IF(lwp) WRITE ( numstp, '(1x, i8)' ) kt !* save the current time step in numstp
- IF(lwp) REWIND( numstp ) ! --------------------------
- !
- END SUBROUTINE stp_ctl
-
- !!======================================================================
-END MODULE stpctl
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OOO_SRC/nemogcm.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OOO_SRC/nemogcm.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OOO_SRC/nemogcm.F90 (revision 5602)
@@ -129,8 +129,9 @@
& nn_bench, nn_timing
NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, &
- & jpizoom, jpjzoom, jperio
+ & jpizoom, jpjzoom, jperio, ln_use_jattr
!!----------------------------------------------------------------------
!
cltxt = ''
+ cxios_context = 'nemo'
!
! ! Open reference namelist and configuration namelist files
@@ -162,22 +163,22 @@
#if defined key_iomput
IF( Agrif_Root() ) THEN
- IF( lk_cpl ) THEN
+ IF( lk_oasis ) THEN
CALL cpl_init( ilocal_comm ) ! nemo local communicator given by oasis
CALL xios_initialize( "oceanx",local_comm=ilocal_comm ) ! send nemo communicator to xios
ELSE
- CALL xios_initialize( "nemo",return_comm=ilocal_comm ) ! nemo local communicator given by xios
+ CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm ) ! nemo local communicator given by xios
ENDIF
ENDIF
ENDIF
- narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection
+ narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection
#else
- IF( lk_cpl ) THEN
+ IF( lk_oasis ) THEN
IF( Agrif_Root() ) THEN
CALL cpl_init( ilocal_comm ) ! nemo local communicator given by oasis
ENDIF
- narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection (control print return in cltxt)
+ narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection (control print return in cltxt)
ELSE
ilocal_comm = 0
- narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop ) ! Nodes selection (control print return in cltxt)
+ narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop ) ! Nodes selection (control print return in cltxt)
ENDIF
#endif
@@ -233,5 +234,5 @@
WRITE(numout,*) ' NEMO team'
WRITE(numout,*) ' Ocean General Circulation Model'
- WRITE(numout,*) ' version 3.4 (2011) '
+ WRITE(numout,*) ' version 3.6 (2015) '
WRITE(numout,*)
WRITE(numout,*)
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OOO_SRC/ooo_data.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OOO_SRC/ooo_data.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OOO_SRC/ooo_data.F90 (revision 5602)
@@ -40,4 +40,5 @@
CHARACTER(len=128) :: &
& alt_file !: altimeter file
+ !! $Id$
CONTAINS
SUBROUTINE ooo_data_init( ld_cl4 )
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OOO_SRC/ooo_intp.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OOO_SRC/ooo_intp.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OOO_SRC/ooo_intp.F90 (revision 5602)
@@ -16,4 +16,5 @@
PUBLIC ooo_interp
+ !! $Id$
CONTAINS
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OOO_SRC/ooo_read.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OOO_SRC/ooo_read.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OOO_SRC/ooo_read.F90 (revision 5602)
@@ -22,4 +22,5 @@
PUBLIC ooo_rea_dri
+ !! $Id$
CONTAINS
SUBROUTINE ooo_rea_dri(kfile)
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OOO_SRC/ooo_utils.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OOO_SRC/ooo_utils.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OOO_SRC/ooo_utils.F90 (revision 5602)
@@ -10,4 +10,5 @@
REAL(kind=dp), PARAMETER :: obfilldbl=99999.
+ !! $Id$
CONTAINS
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OOO_SRC/ooo_write.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OOO_SRC/ooo_write.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OOO_SRC/ooo_write.F90 (revision 5602)
@@ -29,4 +29,5 @@
END INTERFACE
+ !! $Id$
CONTAINS
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90 (revision 5602)
@@ -57,5 +57,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2010)
- !! $Id: $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90 (revision 5602)
@@ -746,8 +746,11 @@
- IF( ln_zps .AND. .NOT. lk_c1d ) &
- & CALL zps_hde( nit000, jpts, tsb, gtsu, gtsv, & ! Partial steps: before horizontal gradient
- & rhd, gru , grv, aru, arv, gzu, gzv, ge3ru, ge3rv, & !
- & gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) ! of t, s, rd at the last ocean level
+ IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav) &
+ & CALL zps_hde ( kt, jpts, tsb, gtsu, gtsv, & ! Partial steps: before horizontal gradient
+ & rhd, gru , grv ) ! of t, s, rd at the last ocean level
+ IF( ln_zps .AND. .NOT. lk_c1d .AND. ln_isfcav) &
+ & CALL zps_hde_isf( nit000, jpts, tsb, gtsu, gtsv, & ! Partial steps for top cell (ISF)
+ & rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv , &
+ & gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) ! of t, s, rd at the last ocean level
#if defined key_zdfkpp
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90 (revision 5602)
@@ -33,7 +33,6 @@
USE ice_2
#elif defined key_lim3
- USE par_ice
USE ice
- USE limcat_1D ! redistribute ice input into categories
+ USE limvar ! redistribute ice input into categories
#endif
USE sbcapr
@@ -380,5 +379,5 @@
#if defined key_lim3
IF( .NOT. ll_bdylim3 .AND. cn_ice_lim(ib_bdy) /= 'none' .AND. nn_ice_lim_dta(ib_bdy) == 1 ) THEN ! bdy ice input (case input is lim2 type)
- CALL lim_cat_1D ( bf(jfld_hti)%fnow(:,1,1), bf(jfld_hts)%fnow(:,1,1), bf(jfld_ai)%fnow(:,1,1), &
+ CALL lim_var_itd ( bf(jfld_hti)%fnow(:,1,1), bf(jfld_hts)%fnow(:,1,1), bf(jfld_ai)%fnow(:,1,1), &
& dta_bdy(ib_bdy)%ht_i, dta_bdy(ib_bdy)%ht_s, dta_bdy(ib_bdy)%a_i )
ENDIF
@@ -734,4 +733,5 @@
IF( blf_i(jfld)%ln_tint ) ALLOCATE( bf(jfld)%fdta(ilen1(jfld),1,ilen3(jfld),2) )
nbmap_ptr(jfld)%ptr => idx_bdy(ibdy(jfld))%nbmap(:,igrid(jfld))
+ nbmap_ptr(jfld)%ll_unstruc = ln_coords_file(ibdy(jfld))
ENDDO
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90 (revision 5602)
@@ -36,5 +36,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2010)
- !! $Id: bdydyn.F90 2528 2010-12-27 17:33:53Z rblod $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90 (revision 5602)
@@ -33,5 +33,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2010)
- !! $Id: bdydyn.F90 2528 2010-12-27 17:33:53Z rblod $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90 (revision 5602)
@@ -26,7 +26,7 @@
USE dom_ice_2 ! sea-ice domain
#elif defined key_lim3
- USE par_ice
USE ice ! LIM_3 ice variables
USE dom_ice ! sea-ice domain
+ USE limvar
#endif
USE par_oce ! ocean parameters
@@ -42,10 +42,10 @@
PRIVATE
- PUBLIC bdy_ice_lim ! routine called in sbcmod
+ PUBLIC bdy_ice_lim ! routine called in sbcmod
PUBLIC bdy_ice_lim_dyn ! routine called in limrhg
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2010)
- !! $Id: bdyice.F90 2715 2011-03-30 15:58:35Z rblod $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
@@ -60,6 +60,10 @@
!!----------------------------------------------------------------------
INTEGER, INTENT( in ) :: kt ! Main time step counter
- !!
INTEGER :: ib_bdy ! Loop index
+
+#if defined key_lim3
+ CALL lim_var_glo2eqv
+#endif
+
DO ib_bdy=1, nb_bdy
@@ -72,5 +76,11 @@
CALL ctl_stop( 'bdy_ice_lim : unrecognised option for open boundaries for ice fields' )
END SELECT
- ENDDO
+
+ END DO
+
+#if defined key_lim3
+ CALL lim_var_zapsmall
+ CALL lim_var_agg(1)
+#endif
END SUBROUTINE bdy_ice_lim
@@ -89,5 +99,5 @@
TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data
INTEGER, INTENT(in) :: kt ! main time-step counter
- INTEGER, INTENT(in) :: ib_bdy ! BDY set index !!
+ INTEGER, INTENT(in) :: ib_bdy ! BDY set index
INTEGER :: jpbound ! 0 = incoming ice
@@ -169,10 +179,14 @@
jpbound = 0; ii = ji; ij = jj;
- IF ( u_ice(ji+1,jj ) < 0. .AND. umask(ji-1,jj ,1) == 0. ) jpbound = 1; ii = ji+1; ij = jj
- IF ( u_ice(ji-1,jj ) > 0. .AND. umask(ji+1,jj ,1) == 0. ) jpbound = 1; ii = ji-1; ij = jj
- IF ( v_ice(ji ,jj+1) < 0. .AND. vmask(ji ,jj-1,1) == 0. ) jpbound = 1; ii = ji ; ij = jj+1
- IF ( v_ice(ji ,jj-1) > 0. .AND. vmask(ji ,jj+1,1) == 0. ) jpbound = 1; ii = ji ; ij = jj-1
-
- rswitch = 1.0 - MAX( 0.0_wp , SIGN ( 1.0_wp , - at_i(ii,ij) + 0.01 ) ) ! 0 if no ice
+ IF( u_ice(ji+1,jj ) < 0. .AND. umask(ji-1,jj ,1) == 0. ) jpbound = 1; ii = ji+1; ij = jj
+ IF( u_ice(ji-1,jj ) > 0. .AND. umask(ji+1,jj ,1) == 0. ) jpbound = 1; ii = ji-1; ij = jj
+ IF( v_ice(ji ,jj+1) < 0. .AND. vmask(ji ,jj-1,1) == 0. ) jpbound = 1; ii = ji ; ij = jj+1
+ IF( v_ice(ji ,jj-1) > 0. .AND. vmask(ji ,jj+1,1) == 0. ) jpbound = 1; ii = ji ; ij = jj-1
+
+ IF( nn_ice_lim_dta(ib_bdy) == 0 ) jpbound = 0; ii = ji; ij = jj ! case ice boundaries = initial conditions
+ ! do not make state variables dependent on velocity
+
+
+ rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ii,ij) - 0.01 ) ) ! 0 if no ice
! concentration and thickness
@@ -190,13 +204,13 @@
! Ice salinity, age, temperature
- sm_i(ji,jj,jl) = rswitch * rn_ice_sal(ib_bdy) + ( 1.0 - rswitch ) * s_i_min
- o_i(ji,jj,jl) = rswitch * rn_ice_age(ib_bdy) + ( 1.0 - rswitch )
+ sm_i(ji,jj,jl) = rswitch * rn_ice_sal(ib_bdy) + ( 1.0 - rswitch ) * rn_simin
+ oa_i(ji,jj,jl) = rswitch * rn_ice_age(ib_bdy) * a_i(ji,jj,jl)
t_su(ji,jj,jl) = rswitch * rn_ice_tem(ib_bdy) + ( 1.0 - rswitch ) * rn_ice_tem(ib_bdy)
DO jk = 1, nlay_s
- t_s(ji,jj,jk,jl) = rswitch * rn_ice_tem(ib_bdy) + ( 1.0 - rswitch ) * rtt
+ t_s(ji,jj,jk,jl) = rswitch * rn_ice_tem(ib_bdy) + ( 1.0 - rswitch ) * rt0
END DO
DO jk = 1, nlay_i
- t_i(ji,jj,jk,jl) = rswitch * rn_ice_tem(ib_bdy) + ( 1.0 - rswitch ) * rtt
- s_i(ji,jj,jk,jl) = rswitch * rn_ice_sal(ib_bdy) + ( 1.0 - rswitch ) * s_i_min
+ t_i(ji,jj,jk,jl) = rswitch * rn_ice_tem(ib_bdy) + ( 1.0 - rswitch ) * rt0
+ s_i(ji,jj,jk,jl) = rswitch * rn_ice_sal(ib_bdy) + ( 1.0 - rswitch ) * rn_simin
END DO
@@ -204,13 +218,13 @@
! Ice salinity, age, temperature
- sm_i(ji,jj,jl) = rswitch * sm_i(ii,ij,jl) + ( 1.0 - rswitch ) * s_i_min
- o_i(ji,jj,jl) = rswitch * o_i(ii,ij,jl) + ( 1.0 - rswitch )
- t_su(ji,jj,jl) = rswitch * t_su(ii,ij,jl) + ( 1.0 - rswitch ) * rtt
+ sm_i(ji,jj,jl) = rswitch * sm_i(ii,ij,jl) + ( 1.0 - rswitch ) * rn_simin
+ oa_i(ji,jj,jl) = rswitch * oa_i(ii,ij,jl)
+ t_su(ji,jj,jl) = rswitch * t_su(ii,ij,jl) + ( 1.0 - rswitch ) * rt0
DO jk = 1, nlay_s
- t_s(ji,jj,jk,jl) = rswitch * t_s(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rtt
+ t_s(ji,jj,jk,jl) = rswitch * t_s(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rt0
END DO
DO jk = 1, nlay_i
- t_i(ji,jj,jk,jl) = rswitch * t_i(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rtt
- s_i(ji,jj,jk,jl) = rswitch * s_i(ii,ij,jk,jl) + ( 1.0 - rswitch ) * s_i_min
+ t_i(ji,jj,jk,jl) = rswitch * t_i(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rt0
+ s_i(ji,jj,jk,jl) = rswitch * s_i(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rn_simin
END DO
@@ -218,37 +232,31 @@
! if salinity is constant, then overwrite rn_ice_sal
- IF( num_sal == 1 ) THEN
- sm_i(ji,jj,jl) = bulk_sal
- s_i (ji,jj,:,jl) = bulk_sal
+ IF( nn_icesal == 1 ) THEN
+ sm_i(ji,jj,jl) = rn_icesal
+ s_i (ji,jj,:,jl) = rn_icesal
ENDIF
! contents
smv_i(ji,jj,jl) = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl)
- oa_i(ji,jj,jl) = o_i(ji,jj,jl) * a_i(ji,jj,jl)
DO jk = 1, nlay_s
! Snow energy of melting
- e_s(ji,jj,jk,jl) = rswitch * rhosn * ( cpic * ( rtt - t_s(ji,jj,jk,jl) ) + lfus )
- ! Change dimensions
- e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / unit_fac
- ! Multiply by volume, so that heat content in 10^9 Joules
- e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * area(ji,jj) * v_s(ji,jj,jl) / nlay_s
+ e_s(ji,jj,jk,jl) = rswitch * rhosn * ( cpic * ( rt0 - t_s(ji,jj,jk,jl) ) + lfus )
+ ! Multiply by volume, so that heat content in J/m2
+ e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * v_s(ji,jj,jl) * r1_nlay_s
END DO
DO jk = 1, nlay_i
- ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt !Melting temperature in K
+ ztmelts = - tmut * s_i(ji,jj,jk,jl) + rt0 !Melting temperature in K
! heat content per unit volume
e_i(ji,jj,jk,jl) = rswitch * rhoic * &
( cpic * ( ztmelts - t_i(ji,jj,jk,jl) ) &
- + lfus * ( 1.0 - (ztmelts-rtt) / MIN((t_i(ji,jj,jk,jl)-rtt),-epsi20) ) &
- - rcp * ( ztmelts - rtt ) )
- ! Correct dimensions to avoid big values
- e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / unit_fac
- ! Mutliply by ice volume, and divide by number of layers to get heat content in 10^9 J
- e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * a_i(ji,jj,jl) * ht_i(ji,jj,jl) / nlay_i
+ + lfus * ( 1.0 - (ztmelts-rt0) / MIN((t_i(ji,jj,jk,jl)-rt0),-epsi20) ) &
+ - rcp * ( ztmelts - rt0 ) )
+ ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2
+ e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * a_i(ji,jj,jl) * ht_i(ji,jj,jl) * r1_nlay_i
END DO
-
- END DO !jb
+ END DO
- CALL lbc_bdy_lnk( a_i(:,:,jl), 'T', 1., ib_bdy ) ! lateral boundary conditions
+ CALL lbc_bdy_lnk( a_i(:,:,jl), 'T', 1., ib_bdy )
CALL lbc_bdy_lnk( ht_i(:,:,jl), 'T', 1., ib_bdy )
CALL lbc_bdy_lnk( ht_s(:,:,jl), 'T', 1., ib_bdy )
@@ -259,5 +267,4 @@
CALL lbc_bdy_lnk( sm_i(:,:,jl), 'T', 1., ib_bdy )
CALL lbc_bdy_lnk( oa_i(:,:,jl), 'T', 1., ib_bdy )
- CALL lbc_bdy_lnk( o_i(:,:,jl), 'T', 1., ib_bdy )
CALL lbc_bdy_lnk( t_su(:,:,jl), 'T', 1., ib_bdy )
DO jk = 1, nlay_s
@@ -291,7 +298,7 @@
!!
CHARACTER(len=1), INTENT(in) :: cd_type ! nature of velocity grid-points
- INTEGER :: jb, jgrd ! dummy loop indices
+ INTEGER :: jb, jgrd ! dummy loop indices
INTEGER :: ji, jj ! local scalar
- INTEGER :: ib_bdy ! Loop index
+ INTEGER :: ib_bdy ! Loop index
REAL(wp) :: zmsk1, zmsk2, zflag
!!------------------------------------------------------------------------------
@@ -309,7 +316,9 @@
CASE('frs')
-
+ IF( nn_ice_lim_dta(ib_bdy) == 0 ) CYCLE ! case ice boundaries = initial conditions
+ ! do not change ice velocity (it is only computed by rheology)
+
SELECT CASE ( cd_type )
-
+
CASE ( 'U' )
@@ -326,6 +335,6 @@
! u_ice = u_ice of the adjacent grid point except if this grid point is ice-free (then u_ice = u_oce)
- u_ice (ji,jj) = u_ice(ji+1,jj) * 0.5 * ABS( zflag + 1._wp ) * zmsk1 + &
- & u_ice(ji-1,jj) * 0.5 * ABS( zflag - 1._wp ) * zmsk2 + &
+ u_ice (ji,jj) = u_ice(ji+1,jj) * 0.5_wp * ABS( zflag + 1._wp ) * zmsk1 + &
+ & u_ice(ji-1,jj) * 0.5_wp * ABS( zflag - 1._wp ) * zmsk2 + &
& u_oce(ji ,jj) * ( 1._wp - MIN( 1._wp, zmsk1 + zmsk2 ) )
ELSE ! everywhere else
@@ -334,9 +343,9 @@
ENDIF
! mask ice velocities
- rswitch = 1.0 - MAX( 0.0_wp , SIGN ( 1.0_wp , - at_i(ji,jj) + 0.01 ) ) ! 0 if no ice
+ rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ji,jj) - 0.01_wp ) ) ! 0 if no ice
u_ice(ji,jj) = rswitch * u_ice(ji,jj)
ENDDO
-
+
CALL lbc_bdy_lnk( u_ice(:,:), 'U', -1., ib_bdy )
@@ -355,6 +364,6 @@
! u_ice = u_ice of the adjacent grid point except if this grid point is ice-free (then u_ice = u_oce)
- v_ice (ji,jj) = v_ice(ji,jj+1) * 0.5 * ABS( zflag + 1._wp ) * zmsk1 + &
- & v_ice(ji,jj-1) * 0.5 * ABS( zflag - 1._wp ) * zmsk2 + &
+ v_ice (ji,jj) = v_ice(ji,jj+1) * 0.5_wp * ABS( zflag + 1._wp ) * zmsk1 + &
+ & v_ice(ji,jj-1) * 0.5_wp * ABS( zflag - 1._wp ) * zmsk2 + &
& v_oce(ji,jj ) * ( 1._wp - MIN( 1._wp, zmsk1 + zmsk2 ) )
ELSE ! everywhere else
@@ -363,5 +372,5 @@
ENDIF
! mask ice velocities
- rswitch = 1.0 - MAX( 0.0_wp , SIGN ( 1.0_wp , - at_i(ji,jj) + 0.01 ) ) ! 0 if no ice
+ rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ji,jj) - 0.01 ) ) ! 0 if no ice
v_ice(ji,jj) = rswitch * v_ice(ji,jj)
@@ -369,5 +378,5 @@
CALL lbc_bdy_lnk( v_ice(:,:), 'V', -1., ib_bdy )
-
+
END SELECT
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/BDY/bdylib.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/BDY/bdylib.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/BDY/bdylib.F90 (revision 5602)
@@ -29,5 +29,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2010)
- !! $Id: bdydyn.F90 2528 2010-12-27 17:33:53Z rblod $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90 (revision 5602)
@@ -32,5 +32,5 @@
USE tideini
! USE tide_mod ! Useless ??
- USE fldread, ONLY: fld_map
+ USE fldread
USE dynspg_oce, ONLY: lk_dynspg_ts
@@ -88,4 +88,5 @@
!!
TYPE(TIDES_DATA), POINTER :: td !: local short cut
+ TYPE(MAP_POINTER), DIMENSION(jpbgrd) :: ibmap_ptr !: array of pointers to nbmap
!!
NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta, ln_bdytide_conj
@@ -125,7 +126,7 @@
IF(lwp) WRITE(numout,*) ' Number of tidal components to read: ', nb_harmo
IF(lwp) THEN
- WRITE(numout,*) ' Tidal cpt name - Phase speed (deg/hr)'
+ WRITE(numout,*) ' Tidal components: '
DO itide = 1, nb_harmo
- WRITE(numout,*) ' ', Wave(ntide(itide))%cname_tide, omega_tide(itide)
+ WRITE(numout,*) ' ', Wave(ntide(itide))%cname_tide
END DO
ENDIF
@@ -220,4 +221,12 @@
!
ALLOCATE( dta_read( MAXVAL(ilen0(1:3)), 1, 1 ) )
+ !
+ ! Set map structure
+ ibmap_ptr(1)%ptr => idx_bdy(ib_bdy)%nbmap(:,1)
+ ibmap_ptr(1)%ll_unstruc = ln_coords_file(ib_bdy)
+ ibmap_ptr(2)%ptr => idx_bdy(ib_bdy)%nbmap(:,2)
+ ibmap_ptr(2)%ll_unstruc = ln_coords_file(ib_bdy)
+ ibmap_ptr(3)%ptr => idx_bdy(ib_bdy)%nbmap(:,3)
+ ibmap_ptr(3)%ll_unstruc = ln_coords_file(ib_bdy)
! Open files and read in tidal forcing data
@@ -228,7 +237,7 @@
clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_T.nc'
CALL iom_open( clfile, inum )
- CALL fld_map( inum, 'z1' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) )
+ CALL fld_map( inum, 'z1' , dta_read(1:ilen0(1),1:1,1:1) , 1, ibmap_ptr(1) )
td%ssh0(:,itide,1) = dta_read(1:ilen0(1),1,1)
- CALL fld_map( inum, 'z2' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) )
+ CALL fld_map( inum, 'z2' , dta_read(1:ilen0(1),1:1,1:1) , 1, ibmap_ptr(1) )
td%ssh0(:,itide,2) = dta_read(1:ilen0(1),1,1)
CALL iom_close( inum )
@@ -236,7 +245,7 @@
clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_U.nc'
CALL iom_open( clfile, inum )
- CALL fld_map( inum, 'u1' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) )
+ CALL fld_map( inum, 'u1' , dta_read(1:ilen0(2),1:1,1:1) , 1, ibmap_ptr(2) )
td%u0(:,itide,1) = dta_read(1:ilen0(2),1,1)
- CALL fld_map( inum, 'u2' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) )
+ CALL fld_map( inum, 'u2' , dta_read(1:ilen0(2),1:1,1:1) , 1, ibmap_ptr(2) )
td%u0(:,itide,2) = dta_read(1:ilen0(2),1,1)
CALL iom_close( inum )
@@ -244,7 +253,7 @@
clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_V.nc'
CALL iom_open( clfile, inum )
- CALL fld_map( inum, 'v1' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) )
+ CALL fld_map( inum, 'v1' , dta_read(1:ilen0(3),1:1,1:1) , 1, ibmap_ptr(3) )
td%v0(:,itide,1) = dta_read(1:ilen0(3),1,1)
- CALL fld_map( inum, 'v2' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) )
+ CALL fld_map( inum, 'v2' , dta_read(1:ilen0(3),1:1,1:1) , 1, ibmap_ptr(3) )
td%v0(:,itide,2) = dta_read(1:ilen0(3),1,1)
CALL iom_close( inum )
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/C1D/c1d.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/C1D/c1d.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/C1D/c1d.F90 (revision 5602)
@@ -31,5 +31,5 @@
!!----------------------------------------------------------------------
!! NEMO/C1D 3.3 , NEMO Consortium (2010)
- !! $Id: c1d.F90 2382 2010-11-13 13:08:12Z gm $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!======================================================================
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/C1D/domc1d.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/C1D/domc1d.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/C1D/domc1d.F90 (revision 5602)
@@ -26,5 +26,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2010)
- !! $Id: domc1d.F90 3851 2013-04-30 10:30:51Z hadcv $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/C1D/dtauvd.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/C1D/dtauvd.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/C1D/dtauvd.F90 (revision 5602)
@@ -35,5 +35,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2010)
- !! $Id: dtauvd.F90 2392 2010-11-15 21:20:05Z gm $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/C1D/dyncor_c1d.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/C1D/dyncor_c1d.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/C1D/dyncor_c1d.F90 (revision 5602)
@@ -30,5 +30,5 @@
!!----------------------------------------------------------------------
!! NEMO/C1D 3.3 , NEMO Consortium (2010)
- !! $Id: dyncor_c1d.F90 2382 2010-11-13 13:08:12Z gm $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/C1D/dyndmp.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/C1D/dyndmp.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/C1D/dyndmp.F90 (revision 5602)
@@ -3,6 +3,9 @@
!! *** MODULE dyndmp ***
!! Ocean dynamics: internal restoring trend on momentum (U and V current)
+ !! This should only be used for C1D case in current form
!!======================================================================
!! History : 3.5 ! 2013-08 (D. Calvert) Original code
+ !! 3.6 ! 2014-08 (T. Graham) Modified to use netcdf file of
+ !! restoration coefficients supplied to tradmp
!!----------------------------------------------------------------------
@@ -25,4 +28,5 @@
USE wrk_nemo ! Memory allocation
USE timing ! Timing
+ USE iom ! I/O manager
IMPLICIT NONE
@@ -43,5 +47,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2010)
- !! $Id: dyndmp.F90 3294 2012-01-28 16:44:18Z rblod $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
@@ -73,4 +77,5 @@
NAMELIST/namc1d_dyndmp/ ln_dyndmp
INTEGER :: ios
+ INTEGER :: imask
!!----------------------------------------------------------------------
@@ -91,10 +96,7 @@
WRITE(numout,*) ' add a damping term or not ln_dyndmp = ', ln_dyndmp
WRITE(numout,*) ' Namelist namtra_dmp : Set damping parameters'
- WRITE(numout,*) ' horizontal damping option nn_hdmp = ', nn_hdmp
- WRITE(numout,*) ' mixed layer damping option nn_zdmp = ', nn_zdmp, '(non-C1D zoom: forced to 0)'
- WRITE(numout,*) ' surface time scale (days) rn_surf = ', rn_surf
- WRITE(numout,*) ' bottom time scale (days) rn_bot = ', rn_bot
- WRITE(numout,*) ' depth of transition (meters) rn_dep = ', rn_dep
- WRITE(numout,*) ' create a damping.coeff file nn_file = ', nn_file
+ 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
@@ -104,14 +106,4 @@
IF( dyn_dmp_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dyn_dmp_init: unable to allocate arrays' )
!
-#if ! defined key_c1d
- SELECT CASE ( nn_hdmp ) !== control print of horizontal option ==!
- CASE ( -1 ) ; IF(lwp) WRITE(numout,*) ' momentum damping in the Med & Red seas only'
- CASE ( 1:90 ) ; IF(lwp) WRITE(numout,*) ' momentum damping poleward of', nn_hdmp, ' degrees'
- CASE DEFAULT
- WRITE(ctmp1,*) ' bad flag value for nn_hdmp = ', nn_hdmp
- CALL ctl_stop(ctmp1)
- END SELECT
- !
-#endif
SELECT CASE ( nn_zdmp ) !== control print of vertical option ==!
CASE ( 0 ) ; IF(lwp) WRITE(numout,*) ' momentum damping throughout the water column'
@@ -130,13 +122,9 @@
utrdmp(:,:,:) = 0._wp ! internal damping trends
vtrdmp(:,:,:) = 0._wp
- ! !== Damping coefficients calculation: ==!
- ! !== use tradmp.F90 subroutines dtacof, dtacof_zoom and cofdis ==!
- ! !!! NOTE: these need to be altered for use in this module if
- ! !!! they are to be used outside the C1D context
- ! !!! (use of U,V grid variables)
- IF( lzoom .AND. .NOT. lk_c1d ) THEN ; CALL dtacof_zoom( resto_uv )
- ELSE ; CALL dtacof( nn_hdmp, rn_surf, rn_bot, rn_dep, nn_file, 'DYN', resto_uv )
- ENDIF
- !
+ !
+ !Read in mask from file
+ CALL iom_open ( cn_resto, imask)
+ CALL iom_get ( imask, jpdom_autoglo, 'resto', resto)
+ CALL iom_close( imask )
ENDIF
!
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/C1D/dynnxt_c1d.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/C1D/dynnxt_c1d.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/C1D/dynnxt_c1d.F90 (revision 5602)
@@ -25,5 +25,5 @@
!!----------------------------------------------------------------------
!! NEMO/C1D 3.3 , NEMO Consortium (2010)
- !! $Id: dynnxt_c1d.F90 2382 2010-11-13 13:08:12Z gm $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90 (revision 5602)
@@ -32,5 +32,5 @@
!!----------------------------------------------------------------------
!! NEMO/C1D 3.3 , NEMO Consortium (2010)
- !! $Id: step_c1d.F90 2382 2010-11-13 13:08:12Z gm $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
@@ -72,4 +72,6 @@
! Ocean physics update (ua, va, ta, sa used as workspace)
!<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+ CALL eos_rab( tsb, rab_b ) ! before local thermal/haline expension ratio at T-points
+ CALL eos_rab( tsn, rab_n ) ! now local thermal/haline expension ratio at T-points
CALL bn2( tsb, rab_b, rn2b ) ! before Brunt-Vaisala frequency
CALL bn2( tsn, rab_n, rn2 ) ! now Brunt-Vaisala frequency
@@ -132,4 +134,6 @@
CALL tra_nxt( kstp ) ! tracer fields at next time step
+
+
!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
! Dynamics (ta, sa used as workspace)
@@ -150,4 +154,8 @@
IF( lrst_oce ) CALL rst_write( kstp ) ! write output ocean restart file
!
+#if defined key_iomput
+ IF( kstp == nitend .OR. indic < 0 ) CALL xios_context_finalize() ! needed for XIOS
+ !
+#endif
END SUBROUTINE stp_c1d
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90 (revision 5602)
@@ -190,4 +190,5 @@
+ !! $Id$
CONTAINS
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90 (revision 5602)
@@ -57,4 +57,5 @@
# include "domzgr_substitute.h90"
+ !! $Id$
CONTAINS
@@ -2389,5 +2390,5 @@
CALL crs_lbc_lnk( p_surf_crs_msk, cd_type, 1.0, pval=1.0 )
- CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zsurfmsk )
+ CALL wrk_dealloc( jpi, jpj, jpk, zsurfmsk, zsurf )
END SUBROUTINE crs_dom_sfc
@@ -2892,6 +2893,4 @@
ENDDO
- CALL wrk_alloc( jpi_crs, jpj_crs, zmbk )
-
zmbk(:,:) = 0.0
zmbk(:,:) = REAL( mbathy_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'T',1.0) ; mbathy_crs(:,:) = INT( zmbk(:,:) )
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdomwri.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdomwri.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdomwri.F90 (revision 5602)
@@ -33,4 +33,5 @@
PUBLIC crs_dom_wri ! routine called by crsini.F90
+ !! $Id$
CONTAINS
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90 (revision 5602)
@@ -40,5 +40,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2010)
- !! $Id $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90 (revision 5602)
@@ -30,4 +30,5 @@
# include "domzgr_substitute.h90"
+ !! $Id$
CONTAINS
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90 (revision 5602)
@@ -22,4 +22,5 @@
PUBLIC crs_lbc_lnk
+ !! $Id$
CONTAINS
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90 (revision 5602)
@@ -21,4 +21,7 @@
USE timing ! preformance summary
USE wrk_nemo ! working arrays
+ USE fldread ! type FLD_N
+ USE phycst ! physical constant
+ USE in_out_manager ! I/O manager
IMPLICIT NONE
@@ -83,6 +86,4 @@
CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn )
- CALL iom_put( 'cellthc', fse3t(:,:,:) )
-
zarea_ssh(:,:) = area(:,:) * sshn(:,:)
@@ -105,9 +106,13 @@
END DO
IF( .NOT.lk_vvl ) THEN
- DO ji=1,jpi
- DO jj=1,jpj
- zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj)
- END DO
- END DO
+ IF ( ln_isfcav ) THEN
+ DO ji=1,jpi
+ DO jj=1,jpj
+ zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj)
+ END DO
+ END DO
+ ELSE
+ zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1)
+ END IF
END IF
!
@@ -127,9 +132,13 @@
END DO
IF( .NOT.lk_vvl ) THEN
- DO ji=1,jpi
- DO jj=1,jpj
- zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj)
- END DO
- END DO
+ IF ( ln_isfcav ) THEN
+ DO ji=1,jpi
+ DO jj=1,jpj
+ zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj)
+ END DO
+ END DO
+ ELSE
+ zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1)
+ END IF
END IF
!
@@ -157,10 +166,15 @@
END DO
IF( .NOT.lk_vvl ) THEN
- DO ji=1,jpi
- DO jj=1,jpj
- ztemp = ztemp + zarea_ssh(ji,jj) * tsn(ji,jj,mikt(ji,jj),jp_tem)
- zsal = zsal + zarea_ssh(ji,jj) * tsn(ji,jj,mikt(ji,jj),jp_sal)
- END DO
- END DO
+ IF ( ln_isfcav ) THEN
+ DO ji=1,jpi
+ DO jj=1,jpj
+ ztemp = ztemp + zarea_ssh(ji,jj) * tsn(ji,jj,mikt(ji,jj),jp_tem)
+ zsal = zsal + zarea_ssh(ji,jj) * tsn(ji,jj,mikt(ji,jj),jp_sal)
+ END DO
+ END DO
+ ELSE
+ ztemp = ztemp + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_tem) )
+ zsal = zsal + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_sal) )
+ END IF
ENDIF
IF( lk_mpp ) THEN
@@ -197,4 +211,22 @@
REAL(wp) :: zztmp
REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zsaldta ! Jan/Dec levitus salinity
+ ! reading initial file
+ LOGICAL :: ln_tsd_init !: T & S data flag
+ LOGICAL :: ln_tsd_tradmp !: internal damping toward input data flag
+ CHARACTER(len=100) :: cn_dir
+ TYPE(FLD_N) :: sn_tem,sn_sal
+ INTEGER :: ios=0
+
+ NAMELIST/namtsd/ ln_tsd_init,ln_tsd_tradmp,cn_dir,sn_tem,sn_sal
+ !
+
+ REWIND( numnam_ref ) ! Namelist namtsd in reference namelist :
+ READ ( numnam_ref, namtsd, IOSTAT = ios, ERR = 901)
+901 IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtsd in reference namelist for dia_ar5', lwp )
+ REWIND( numnam_cfg ) ! Namelist namtsd in configuration namelist : Parameters of the run
+ READ ( numnam_cfg, namtsd, IOSTAT = ios, ERR = 902 )
+902 IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtsd in configuration namelist for dia_ar5', lwp )
+ IF(lwm) WRITE ( numond, namtsd )
+ !
!!----------------------------------------------------------------------
!
@@ -216,8 +248,8 @@
END DO
IF( lk_mpp ) CALL mpp_sum( vol0 )
-
- CALL iom_open ( 'data_1m_salinity_nomask', inum )
- CALL iom_get ( inum, jpdom_data, 'vosaline', zsaldta(:,:,:,1), 1 )
- CALL iom_get ( inum, jpdom_data, 'vosaline', zsaldta(:,:,:,2), 12 )
+
+ CALL iom_open ( TRIM( cn_dir )//TRIM(sn_sal%clname), inum )
+ CALL iom_get ( inum, jpdom_data, TRIM(sn_sal%clvar), zsaldta(:,:,:,1), 1 )
+ CALL iom_get ( inum, jpdom_data, TRIM(sn_sal%clvar), zsaldta(:,:,:,2), 12 )
CALL iom_close( inum )
sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) )
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90 (revision 5602)
@@ -42,5 +42,4 @@
#endif
#if defined key_lim3
- USE par_ice
USE ice
#endif
@@ -113,4 +112,5 @@
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: transports_2d
+ !! $Id$
CONTAINS
@@ -176,5 +176,5 @@
!open output file
- IF( lwp ) THEN
+ IF( lwm ) THEN
CALL ctl_opn( numdct_vol, 'volume_transport', 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
CALL ctl_opn( numdct_heat, 'heat_transport' , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
@@ -283,5 +283,5 @@
DO jsec=1,nb_sec
- IF( lwp )CALL dia_dct_wri(kt,jsec,secs(jsec))
+ IF( lwm )CALL dia_dct_wri(kt,jsec,secs(jsec))
!nullify transports values after writing
@@ -1298,4 +1298,5 @@
LOGICAL, PUBLIC, PARAMETER :: lk_diadct = .FALSE. !: diamht flag
PUBLIC
+ !! $Id$
CONTAINS
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90 (revision 5602)
@@ -51,11 +51,12 @@
INTEGER, INTENT( in ) :: kt ! ocean time-step index
!!
- INTEGER :: inum ! temporary logical unit
- INTEGER :: ji, jj, jk, jt ! dummy loop indices
- INTEGER :: ii0, ii1, ij0, ij1
- REAL(wp) :: zarea, zvol, zwei
- REAL(wp) :: ztemi(4), ztemo(4), zsali(4), zsalo(4), zflxi(4), zflxo(4)
- REAL(wp) :: zt, zs, zu
- REAL(wp) :: zsm0, zfwfnew
+ INTEGER :: inum ! temporary logical unit
+ INTEGER :: ji, jj, jk, jt ! dummy loop indices
+ INTEGER :: ii0, ii1, ij0, ij1
+ INTEGER :: isrow ! index for ORCA1 starting row
+ REAL(wp) :: zarea, zvol, zwei
+ REAL(wp) :: ztemi(4), ztemo(4), zsali(4), zsalo(4), zflxi(4), zflxo(4)
+ REAL(wp) :: zt, zs, zu
+ REAL(wp) :: zsm0, zfwfnew
IF( cp_cfg == "orca" .AND. jp_cfg == 1 .OR. jp_cfg == 2 .OR. jp_cfg == 4 ) THEN
!!----------------------------------------------------------------------
@@ -165,6 +166,12 @@
CASE ( 1 ) ! ORCA_R1 configurations
! ! =======================
- ii0 = 283 ; ii1 = 283
- ij0 = 200 ; ij1 = 200
+ ! This dirty section will be suppressed by simplification process:
+ ! all this will come back in input files
+ ! Currently these hard-wired indices relate to configuration with
+ ! extend grid (jpjglo=332)
+ isrow = 332 - jpjglo
+ !
+ ii0 = 283 ; ii1 = 283
+ ij0 = 241 - isrow ; ij1 = 241 - isrow
! ! =======================
CASE DEFAULT ! ORCA R05 or R025
@@ -212,6 +219,11 @@
CASE ( 1 ) ! ORCA_R1 configurations
! ! =======================
- ii0 = 282 ; ii1 = 282
- ij0 = 200 ; ij1 = 200
+ ! This dirty section will be suppressed by simplification process:
+ ! all this will come back in input files
+ ! Currently these hard-wired indices relate to configuration with
+ ! extend grid (jpjglo=332)
+ isrow = 332 - jpjglo
+ ii0 = 282 ; ii1 = 282
+ ij0 = 240 - isrow ; ij1 = 240 - isrow
! ! =======================
CASE DEFAULT ! ORCA R05 or R025
@@ -259,6 +271,11 @@
CASE ( 1 ) ! ORCA_R1 configurations
! ! =======================
- ii0 = 331 ; ii1 = 331
- ij0 = 176 ; ij1 = 176
+ ! This dirty section will be suppressed by simplification process:
+ ! all this will come back in input files
+ ! Currently these hard-wired indices relate to configuration with
+ ! extend grid (jpjglo=332)
+ isrow = 332 - jpjglo
+ ii0 = 331 ; ii1 = 331
+ ij0 = 215 - isrow ; ij1 = 215 - isrow
! ! =======================
CASE DEFAULT ! ORCA R05 or R025
@@ -306,6 +323,11 @@
CASE ( 1 ) ! ORCA_R1 configurations
! ! =======================
- ii0 = 297 ; ii1 = 297
- ij0 = 230 ; ij1 = 230
+ ! This dirty section will be suppressed by simplification process:
+ ! all this will come back in input files
+ ! Currently these hard-wired indices relate to configuration with
+ ! extend grid (jpjglo=332)
+ isrow = 332 - jpjglo
+ ii0 = 297 ; ii1 = 297
+ ij0 = 269 - isrow ; ij1 = 269 - isrow
! ! =======================
CASE DEFAULT ! ORCA R05 or R025
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90 (revision 5602)
@@ -60,5 +60,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.5 , NEMO Consortium (2013)
- !! $Id:$
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90 (revision 5602)
@@ -96,8 +96,8 @@
z_frc_trd_t = glob_sum( sbc_tsc(:,:,jp_tem) * surf(:,:) ) ! heat fluxes
z_frc_trd_s = glob_sum( sbc_tsc(:,:,jp_sal) * surf(:,:) ) ! salt fluxes
- ! Add runoff heat & salt input
+ ! Add runoff heat & salt input
IF( ln_rnf ) z_frc_trd_t = z_frc_trd_t + glob_sum( rnf_tsc(:,:,jp_tem) * surf(:,:) )
IF( ln_rnf_sal) z_frc_trd_s = z_frc_trd_s + glob_sum( rnf_tsc(:,:,jp_sal) * surf(:,:) )
- ! Add geothermal ice shelf
+ ! Add ice shelf heat & salt input
IF( nn_isf .GE. 1 ) THEN
z_frc_trd_t = z_frc_trd_t &
@@ -112,11 +112,15 @@
!
IF( .NOT. lk_vvl ) THEN
- z2d0=0.0_wp ; z2d1=0.0_wp
- DO ji=1,jpi
- DO jj=1,jpj
- z2d0(ji,jj) = surf(ji,jj) * wn(ji,jj,mikt(ji,jj)) * tsb(ji,jj,mikt(ji,jj),jp_tem)
- z2d1(ji,jj) = surf(ji,jj) * wn(ji,jj,mikt(ji,jj)) * tsb(ji,jj,mikt(ji,jj),jp_sal)
+ IF ( ln_isfcav ) THEN
+ DO ji=1,jpi
+ DO jj=1,jpj
+ z2d0(ji,jj) = surf(ji,jj) * wn(ji,jj,mikt(ji,jj)) * tsb(ji,jj,mikt(ji,jj),jp_tem)
+ z2d1(ji,jj) = surf(ji,jj) * wn(ji,jj,mikt(ji,jj)) * tsb(ji,jj,mikt(ji,jj),jp_sal)
+ ENDDO
ENDDO
- ENDDO
+ ELSE
+ z2d0(:,:) = surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_tem)
+ z2d1(:,:) = surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_sal)
+ END IF
z_wn_trd_t = - glob_sum( z2d0 )
z_wn_trd_s = - glob_sum( z2d1 )
@@ -144,11 +148,15 @@
! heat & salt content variation (associated with ssh)
IF( .NOT. lk_vvl ) THEN
- z2d0 = 0._wp ; z2d1 = 0._wp
- DO ji = 1, jpi
- DO jj = 1, jpj
- z2d0(ji,jj) = surf(ji,jj) * ( tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj) - ssh_hc_loc_ini(ji,jj) )
- z2d1(ji,jj) = surf(ji,jj) * ( tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj) - ssh_sc_loc_ini(ji,jj) )
+ IF ( ln_isfcav ) THEN
+ DO ji = 1, jpi
+ DO jj = 1, jpj
+ z2d0(ji,jj) = surf(ji,jj) * ( tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj) - ssh_hc_loc_ini(ji,jj) )
+ z2d1(ji,jj) = surf(ji,jj) * ( tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj) - ssh_sc_loc_ini(ji,jj) )
+ END DO
END DO
- END DO
+ ELSE
+ z2d0(:,:) = surf(:,:) * ( tsn(:,:,1,jp_tem) * sshn(:,:) - ssh_hc_loc_ini(:,:) )
+ z2d1(:,:) = surf(:,:) * ( tsn(:,:,1,jp_sal) * sshn(:,:) - ssh_sc_loc_ini(:,:) )
+ END IF
z_ssh_hc = glob_sum( z2d0 )
z_ssh_sc = glob_sum( z2d1 )
@@ -277,10 +285,15 @@
frc_s = 0._wp ! salt content - - - -
IF( .NOT. lk_vvl ) THEN
- DO ji=1,jpi
- DO jj=1,jpj
- ssh_hc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj) ! initial heat content in ssh
- ssh_sc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj) ! initial salt content in ssh
+ IF ( ln_isfcav ) THEN
+ DO ji=1,jpi
+ DO jj=1,jpj
+ ssh_hc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj) ! initial heat content in ssh
+ ssh_sc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj) ! initial salt content in ssh
+ ENDDO
ENDDO
- ENDDO
+ ELSE
+ ssh_hc_loc_ini(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:) ! initial heat content in ssh
+ ssh_sc_loc_ini(:,:) = tsn(:,:,1,jp_sal) * sshn(:,:) ! initial salt content in ssh
+ END IF
frc_wn_t = 0._wp ! initial heat content misfit due to free surface
frc_wn_s = 0._wp ! initial salt content misfit due to free surface
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90 (revision 5602)
@@ -245,5 +245,4 @@
CALL iom_put( "mldr10_3", zrho10_3 ) ! MLD delta rho(10m) = 0.03
CALL iom_put( "pycndep" , zpycn ) ! MLD delta rho equi. delta T(10m) = 0.2
- CALL iom_put( "BLT" , ztm2 - zpycn ) ! Barrier Layer Thickness
CALL iom_put( "tinv" , ztinv ) ! max. temp. inv. (t10 ref)
CALL iom_put( "depti" , zdepinv ) ! depth of max. temp. inv. (t10 ref)
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90 (revision 5602)
@@ -8,4 +8,5 @@
!! 3.2 ! 2010-03 (O. Marti, S. Flavoni) Add fields
!! 3.3 ! 2010-10 (G. Madec) dynamical allocation
+ !! 3.6 ! 2014-12 (C. Ethe) use of IOM
!!----------------------------------------------------------------------
@@ -13,59 +14,37 @@
!! dia_ptr : Poleward Transport Diagnostics module
!! dia_ptr_init : Initialization, namelist read
- !! dia_ptr_wri : Output of poleward fluxes
- !! ptr_vjk : "zonal" sum computation of a "meridional" flux array
- !! ptr_tjk : "zonal" mean computation of a tracer field
- !! ptr_vj : "zonal" and vertical sum computation of a "meridional" flux array
- !! (Generic interface to ptr_vj_3d, ptr_vj_2d)
+ !! ptr_sjk : "zonal" mean computation of a field - tracer or flux array
+ !! ptr_sj : "zonal" and vertical sum computation of a "meridional" flux array
+ !! (Generic interface to ptr_sj_3d, ptr_sj_2d)
!!----------------------------------------------------------------------
USE oce ! ocean dynamics and active tracers
USE dom_oce ! ocean space and time domain
USE phycst ! physical constants
- USE ldftra_oce ! ocean active tracers: lateral physics
- USE dianam !
+ !
USE iom ! IOM library
- USE ioipsl ! IO-IPSL library
USE in_out_manager ! I/O manager
USE lib_mpp ! MPP library
- USE lbclnk ! lateral boundary condition - processor exchanges
USE timing ! preformance summary
- USE wrk_nemo ! working arrays
IMPLICIT NONE
PRIVATE
- INTERFACE ptr_vj
- MODULE PROCEDURE ptr_vj_3d, ptr_vj_2d
+ INTERFACE ptr_sj
+ MODULE PROCEDURE ptr_sj_3d, ptr_sj_2d
END INTERFACE
- PUBLIC dia_ptr_init ! call in opa module
+ PUBLIC ptr_sj ! call by tra_ldf & tra_adv routines
+ PUBLIC ptr_sjk !
+ PUBLIC dia_ptr_init ! call in step module
PUBLIC dia_ptr ! call in step module
- PUBLIC ptr_vj ! call by tra_ldf & tra_adv routines
- PUBLIC ptr_vjk ! call by tra_ldf & tra_adv routines
! !!** namelist namptr **
- LOGICAL , PUBLIC :: ln_diaptr !: Poleward transport flag (T) or not (F)
- LOGICAL , PUBLIC :: ln_subbas !: Atlantic/Pacific/Indian basins calculation
- LOGICAL , PUBLIC :: ln_diaznl !: Add zonal means and meridional stream functions
- LOGICAL , PUBLIC :: ln_ptrcomp !: Add decomposition : overturning (and gyre, soon ...)
- INTEGER , PUBLIC :: nn_fptr !: frequency of ptr computation [time step]
- INTEGER , PUBLIC :: nn_fwri !: frequency of ptr outputs [time step]
-
- REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) :: htr_adv, htr_ldf, htr_ove !: Heat TRansports (adv, diff, overturn.)
- REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) :: str_adv, str_ldf, str_ove !: Salt TRansports (adv, diff, overturn.)
+ REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) :: htr_adv, htr_ldf !: Heat TRansports (adv, diff, overturn.)
+ REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) :: str_adv, str_ldf !: Salt TRansports (adv, diff, overturn.)
- REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: btmsk ! T-point basin interior masks
- REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: btm30 ! mask out Southern Ocean (=0 south of 30°S)
- REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: htr , str ! adv heat and salt transports (approx)
- REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tn_jk, sn_jk , v_msf ! i-mean T and S, j-Stream-Function
- REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sjk , r1_sjk ! i-mean i-k-surface and its inverse
- REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: htr_eiv, str_eiv ! bolus adv heat ans salt transports ('key_diaeiv')
- REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_msf_eiv ! bolus j-streamfuction ('key_diaeiv')
-
-
- INTEGER :: niter !
- INTEGER :: nidom_ptr !
- INTEGER :: numptr ! logical unit for Poleward TRansports
- INTEGER :: nptr ! = 1 (ln_subbas=F) or = 5 (glo, atl, pac, ind, ipc) (ln_subbas=T)
+
+ LOGICAL, PUBLIC :: ln_diaptr ! Poleward transport flag (T) or not (F)
+ LOGICAL, PUBLIC :: ln_subbas ! Atlantic/Pacific/Indian basins calculation
+ INTEGER :: nptr ! = 1 (l_subbas=F) or = 5 (glo, atl, pac, ind, ipc) (l_subbas=T)
REAL(wp) :: rc_sv = 1.e-6_wp ! conversion from m3/s to Sverdrup
@@ -73,12 +52,11 @@
REAL(wp) :: rc_ggram = 1.e-6_wp ! conversion from g to Pg
- REAL(wp), TARGET, DIMENSION(:), ALLOCATABLE, SAVE :: p_fval1d
- REAL(wp), TARGET, DIMENSION(:,:), ALLOCATABLE, SAVE :: p_fval2d
-
- !! Integer, 1D workspace arrays. Not common enough to be implemented in
- !! wrk_nemo module.
- INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndex , ndex_atl , ndex_pac , ndex_ind , ndex_ipc
- INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndex_atl_30 , ndex_pac_30 , ndex_ind_30 , ndex_ipc_30
- INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndex_h, ndex_h_atl_30, ndex_h_pac_30, ndex_h_ind_30, ndex_h_ipc_30
+ CHARACTER(len=3), ALLOCATABLE, SAVE, DIMENSION(:) :: clsubb
+ REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: btmsk ! T-point basin interior masks
+ REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: btm30 ! mask out Southern Ocean (=0 south of 30°S)
+
+ REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:) :: p_fval1d
+ REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:,:) :: p_fval2d
+
!! * Substitutions
@@ -92,350 +70,114 @@
CONTAINS
- FUNCTION dia_ptr_alloc()
- !!----------------------------------------------------------------------
- !! *** ROUTINE dia_ptr_alloc ***
- !!----------------------------------------------------------------------
- INTEGER :: dia_ptr_alloc ! return value
- INTEGER, DIMENSION(6) :: ierr
- !!----------------------------------------------------------------------
- ierr(:) = 0
- !
- ALLOCATE( btmsk(jpi,jpj,nptr) , &
- & htr_adv(jpj) , str_adv(jpj) , &
- & htr_ldf(jpj) , str_ldf(jpj) , &
- & htr_ove(jpj) , str_ove(jpj), &
- & htr(jpj,nptr) , str(jpj,nptr) , &
- & tn_jk(jpj,jpk,nptr) , sn_jk (jpj,jpk,nptr) , v_msf(jpj,jpk,nptr) , &
- & sjk (jpj,jpk,nptr) , r1_sjk(jpj,jpk,nptr) , STAT=ierr(1) )
- !
-#if defined key_diaeiv
- ALLOCATE( htr_eiv(jpj,nptr) , str_eiv(jpj,nptr) , &
- & v_msf_eiv(jpj,jpk,nptr) , STAT=ierr(2) )
-#endif
- ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(3))
- !
- ALLOCATE(ndex(jpj*jpk), ndex_atl(jpj*jpk), ndex_pac(jpj*jpk), &
- & ndex_ind(jpj*jpk), ndex_ipc(jpj*jpk), &
- & ndex_atl_30(jpj*jpk), ndex_pac_30(jpj*jpk), Stat=ierr(4))
-
- ALLOCATE(ndex_ind_30(jpj*jpk), ndex_ipc_30(jpj*jpk), &
- & ndex_h(jpj), ndex_h_atl_30(jpj), ndex_h_pac_30(jpj), &
- & ndex_h_ind_30(jpj), ndex_h_ipc_30(jpj), Stat=ierr(5) )
- !
- ALLOCATE( btm30(jpi,jpj) , STAT=ierr(6) )
- !
- dia_ptr_alloc = MAXVAL( ierr )
- IF(lk_mpp) CALL mpp_sum( dia_ptr_alloc )
- !
- END FUNCTION dia_ptr_alloc
-
-
- FUNCTION ptr_vj_3d( pva ) RESULT ( p_fval )
- !!----------------------------------------------------------------------
- !! *** ROUTINE ptr_vj_3d ***
- !!
- !! ** Purpose : i-k sum computation of a j-flux array
- !!
- !! ** Method : - i-k sum of pva using the interior 2D vmask (vmask_i).
- !! pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v)
- !!
- !! ** Action : - p_fval: i-k-mean poleward flux of pva
- !!----------------------------------------------------------------------
- REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pva ! mask flux array at V-point
- !!
- INTEGER :: ji, jj, jk ! dummy loop arguments
- INTEGER :: ijpj ! ???
- REAL(wp), POINTER, DIMENSION(:) :: p_fval ! function value
- !!--------------------------------------------------------------------
- !
- p_fval => p_fval1d
-
- ijpj = jpj
- p_fval(:) = 0._wp
- DO jk = 1, jpkm1
- DO jj = 2, jpjm1
- DO ji = fs_2, fs_jpim1 ! Vector opt.
- p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * tmask_i(ji,jj)
- END DO
- END DO
- END DO
-#if defined key_mpp_mpi
- IF(lk_mpp) CALL mpp_sum( p_fval, ijpj, ncomm_znl)
-#endif
- !
- END FUNCTION ptr_vj_3d
-
-
- FUNCTION ptr_vj_2d( pva ) RESULT ( p_fval )
- !!----------------------------------------------------------------------
- !! *** ROUTINE ptr_vj_2d ***
- !!
- !! ** Purpose : "zonal" and vertical sum computation of a i-flux array
- !!
- !! ** Method : - i-k sum of pva using the interior 2D vmask (vmask_i).
- !! pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v)
- !!
- !! ** Action : - p_fval: i-k-mean poleward flux of pva
- !!----------------------------------------------------------------------
- IMPLICIT none
- REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pva ! mask flux array at V-point
- !!
- INTEGER :: ji,jj ! dummy loop arguments
- INTEGER :: ijpj ! ???
- REAL(wp), POINTER, DIMENSION(:) :: p_fval ! function value
- !!--------------------------------------------------------------------
- !
- p_fval => p_fval1d
-
- ijpj = jpj
- p_fval(:) = 0._wp
- DO jj = 2, jpjm1
- DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ?
- p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj)
- END DO
- END DO
-#if defined key_mpp_mpi
- CALL mpp_sum( p_fval, ijpj, ncomm_znl )
-#endif
- !
- END FUNCTION ptr_vj_2d
-
-
- FUNCTION ptr_vjk( pva, pmsk ) RESULT ( p_fval )
- !!----------------------------------------------------------------------
- !! *** ROUTINE ptr_vjk ***
- !!
- !! ** Purpose : i-sum computation of a j-velocity array
- !!
- !! ** Method : - i-sum of pva using the interior 2D vmask (vmask_i).
- !! pva is supposed to be a masked flux (i.e. * vmask)
- !!
- !! ** Action : - p_fval: i-mean poleward flux of pva
- !!----------------------------------------------------------------------
- !!
- IMPLICIT none
- REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pva ! mask flux array at V-point
- REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) , OPTIONAL :: pmsk ! Optional 2D basin mask
- !!
- INTEGER :: ji, jj, jk ! dummy loop arguments
- REAL(wp), POINTER, DIMENSION(:,:) :: p_fval ! return function value
-#if defined key_mpp_mpi
- INTEGER, DIMENSION(1) :: ish
- INTEGER, DIMENSION(2) :: ish2
- INTEGER :: ijpjjpk
-#endif
-#if defined key_mpp_mpi
- REAL(wp), POINTER, DIMENSION(:) :: zwork ! mask flux array at V-point
-#endif
- !!--------------------------------------------------------------------
- !
-#if defined key_mpp_mpi
- ijpjjpk = jpj*jpk
- CALL wrk_alloc( jpj*jpk, zwork )
-#endif
-
- p_fval => p_fval2d
-
- p_fval(:,:) = 0._wp
- !
- IF( PRESENT( pmsk ) ) THEN
- DO jk = 1, jpkm1
- DO jj = 2, jpjm1
-!!gm here, use of tmask_i ==> no need of loop over nldi, nlei....
- DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ?
- p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) * pmsk(ji,jj)
+ SUBROUTINE dia_ptr( pvtr )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE dia_ptr ***
+ !!----------------------------------------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: pvtr ! j-effective transport
+ !
+ INTEGER :: ji, jj, jk, jn ! dummy loop indices
+ REAL(wp) :: zv, zsfc ! local scalar
+ REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace
+ REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d ! 3D workspace
+ REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask ! 3D workspace
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zts ! 3D workspace
+ CHARACTER( len = 10 ) :: cl1
+ !!----------------------------------------------------------------------
+ !
+ IF( nn_timing == 1 ) CALL timing_start('dia_ptr')
+
+ !
+ IF( PRESENT( pvtr ) ) THEN
+ IF( iom_use("zomsfglo") ) THEN ! effective MSF
+ z3d(1,:,:) = ptr_sjk( pvtr(:,:,:) ) ! zonal cumulative effective transport
+ DO jk = 2, jpkm1
+ z3d(1,:,jk) = z3d(1,:,jk-1) + z3d(1,:,jk) ! effective j-Stream-Function (MSF)
+ END DO
+ DO ji = 1, jpi
+ z3d(ji,:,:) = z3d(1,:,:)
+ ENDDO
+ cl1 = TRIM('zomsf'//clsubb(1) )
+ CALL iom_put( cl1, z3d * rc_sv )
+ DO jn = 2, nptr ! by sub-basins
+ z3d(1,:,:) = ptr_sjk( pvtr(:,:,:), btmsk(:,:,jn)*btm30(:,:) )
+ DO jk = 2, jpkm1
+ z3d(1,:,jk) = z3d(1,:,jk-1) + z3d(1,:,jk) ! effective j-Stream-Function (MSF)
END DO
- END DO
- END DO
- ELSE
- DO jk = 1, jpkm1
- DO jj = 2, jpjm1
- DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ?
- p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) * tmask_i(ji,jj)
- END DO
- END DO
- END DO
- END IF
- !
-#if defined key_mpp_mpi
- ijpjjpk = jpj*jpk
- ish(1) = ijpjjpk ; ish2(1) = jpj ; ish2(2) = jpk
- zwork(1:ijpjjpk) = RESHAPE( p_fval, ish )
- CALL mpp_sum( zwork, ijpjjpk, ncomm_znl )
- p_fval(:,:) = RESHAPE( zwork, ish2 )
-#endif
- !
-#if defined key_mpp_mpi
- CALL wrk_dealloc( jpj*jpk, zwork )
-#endif
- !
- END FUNCTION ptr_vjk
-
-
- FUNCTION ptr_tjk( pta, pmsk ) RESULT ( p_fval )
- !!----------------------------------------------------------------------
- !! *** ROUTINE ptr_tjk ***
- !!
- !! ** Purpose : i-sum computation of e1t*e3t * a tracer field
- !!
- !! ** Method : - i-sum of mj(pta) using tmask
- !!
- !! ** Action : - p_fval: i-sum of e1t*e3t*pta
- !!----------------------------------------------------------------------
- !!
- REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pta ! tracer flux array at T-point
- REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pmsk ! Optional 2D basin mask
- !!
- INTEGER :: ji, jj, jk ! dummy loop arguments
- REAL(wp), POINTER, DIMENSION(:,:) :: p_fval ! return function value
-#if defined key_mpp_mpi
- INTEGER, DIMENSION(1) :: ish
- INTEGER, DIMENSION(2) :: ish2
- INTEGER :: ijpjjpk
-#endif
-#if defined key_mpp_mpi
- REAL(wp), POINTER, DIMENSION(:) :: zwork ! mask flux array at V-point
-#endif
- !!--------------------------------------------------------------------
- !
-#if defined key_mpp_mpi
- ijpjjpk = jpj*jpk
- CALL wrk_alloc( jpj*jpk, zwork )
-#endif
-
- p_fval => p_fval2d
-
- p_fval(:,:) = 0._wp
- DO jk = 1, jpkm1
- DO jj = 2, jpjm1
- DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ?
- p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * e1t(ji,jj) * fse3t(ji,jj,jk) * pmsk(ji,jj)
- END DO
- END DO
- END DO
-#if defined key_mpp_mpi
- ijpjjpk = jpj*jpk
- ish(1) = jpj*jpk ; ish2(1) = jpj ; ish2(2) = jpk
- zwork(1:ijpjjpk)= RESHAPE( p_fval, ish )
- CALL mpp_sum( zwork, ijpjjpk, ncomm_znl )
- p_fval(:,:)= RESHAPE( zwork, ish2 )
-#endif
- !
-#if defined key_mpp_mpi
- CALL wrk_dealloc( jpj*jpk, zwork )
-#endif
- !
- END FUNCTION ptr_tjk
-
-
- SUBROUTINE dia_ptr( kt )
- !!----------------------------------------------------------------------
- !! *** ROUTINE dia_ptr ***
- !!----------------------------------------------------------------------
- USE oce, vt => ua ! use ua as workspace
- USE oce, vs => va ! use va as workspace
- IMPLICIT none
- !!
- INTEGER, INTENT(in) :: kt ! ocean time step index
- !
- INTEGER :: ji, jj, jk, jn ! dummy loop indices
- REAL(wp) :: zv ! local scalar
- !!----------------------------------------------------------------------
- !
- IF( nn_timing == 1 ) CALL timing_start('dia_ptr')
- !
- IF( kt == nit000 .OR. MOD( kt, nn_fptr ) == 0 ) THEN
- !
- IF( MOD( kt, nn_fptr ) == 0 ) THEN
- !
- IF( ln_diaznl ) THEN ! i-mean temperature and salinity
- DO jn = 1, nptr
- tn_jk(:,:,jn) = ptr_tjk( tsn(:,:,:,jp_tem), btmsk(:,:,jn) ) * r1_sjk(:,:,jn)
- sn_jk(:,:,jn) = ptr_tjk( tsn(:,:,:,jp_sal), btmsk(:,:,jn) ) * r1_sjk(:,:,jn)
- END DO
- ENDIF
- !
- ! ! horizontal integral and vertical dz
- ! ! eulerian velocity
- v_msf(:,:,1) = ptr_vjk( vn(:,:,:) )
- DO jn = 2, nptr
- v_msf(:,:,jn) = ptr_vjk( vn(:,:,:), btmsk(:,:,jn)*btm30(:,:) )
- END DO
-#if defined key_diaeiv
- DO jn = 1, nptr ! bolus velocity
- v_msf_eiv(:,:,jn) = ptr_vjk( v_eiv(:,:,:), btmsk(:,:,jn) ) ! here no btm30 for MSFeiv
- END DO
- ! ! add bolus stream-function to the eulerian one
- v_msf(:,:,:) = v_msf(:,:,:) + v_msf_eiv(:,:,:)
-#endif
- !
- ! ! Transports
- ! ! local heat & salt transports at T-points ( tsn*mj[vn+v_eiv] )
- vt(:,:,jpk) = 0._wp ; vs(:,:,jpk) = 0._wp
- DO jk= 1, jpkm1
- DO jj = 2, jpj
+ DO ji = 1, jpi
+ z3d(ji,:,:) = z3d(1,:,:)
+ ENDDO
+ cl1 = TRIM('zomsf'//clsubb(jn) )
+ CALL iom_put( cl1, z3d * rc_sv )
+ END DO
+ ENDIF
+ !
+ ELSE
+ !
+ IF( iom_use("zotemglo") ) THEN ! i-mean i-k-surface
+ DO jk = 1, jpkm1
+ DO jj = 1, jpj
DO ji = 1, jpi
-#if defined key_diaeiv
- zv = ( vn(ji,jj,jk) + vn(ji,jj-1,jk) + v_eiv(ji,jj,jk) + v_eiv(ji,jj-1,jk) ) * 0.5_wp
-#else
- zv = ( vn(ji,jj,jk) + vn(ji,jj-1,jk) ) * 0.5_wp
-#endif
- vt(ji,jj,jk) = zv * tsn(ji,jj,jk,jp_tem)
- vs(ji,jj,jk) = zv * tsn(ji,jj,jk,jp_sal)
- END DO
- END DO
- END DO
-!!gm useless as overlap areas are not used in ptr_vjk
- CALL lbc_lnk( vs, 'V', -1. ) ; CALL lbc_lnk( vt, 'V', -1. )
-!!gm
- ! ! heat & salt advective transports (approximation)
- htr(:,1) = SUM( ptr_vjk( vt(:,:,:) ) , 2 ) * rc_pwatt ! SUM over jk + conversion
- str(:,1) = SUM( ptr_vjk( vs(:,:,:) ) , 2 ) * rc_ggram
- DO jn = 2, nptr
- htr(:,jn) = SUM( ptr_vjk( vt(:,:,:), btmsk(:,:,jn)*btm30(:,:) ) , 2 ) * rc_pwatt ! mask Southern Ocean
- str(:,jn) = SUM( ptr_vjk( vs(:,:,:), btmsk(:,:,jn)*btm30(:,:) ) , 2 ) * rc_ggram ! mask Southern Ocean
- END DO
-
- IF( ln_ptrcomp ) THEN ! overturning transport
- htr_ove(:) = SUM( v_msf(:,:,1) * tn_jk(:,:,1), 2 ) * rc_pwatt ! SUM over jk + conversion
- str_ove(:) = SUM( v_msf(:,:,1) * sn_jk(:,:,1), 2 ) * rc_ggram
- END IF
- ! ! Advective and diffusive transport
- htr_adv(:) = htr_adv(:) * rc_pwatt ! these are computed in tra_adv... and tra_ldf... routines
- htr_ldf(:) = htr_ldf(:) * rc_pwatt ! here just the conversion in PW and Gg
- str_adv(:) = str_adv(:) * rc_ggram
- str_ldf(:) = str_ldf(:) * rc_ggram
-
-#if defined key_diaeiv
- DO jn = 1, nptr ! Bolus component
- htr_eiv(:,jn) = SUM( v_msf_eiv(:,:,jn) * tn_jk(:,:,jn), 2 ) * rc_pwatt ! SUM over jk
- str_eiv(:,jn) = SUM( v_msf_eiv(:,:,jn) * sn_jk(:,:,jn), 2 ) * rc_ggram ! SUM over jk
- END DO
-#endif
- ! ! "Meridional" Stream-Function
+ zsfc = e1t(ji,jj) * fse3t(ji,jj,jk)
+ zmask(ji,jj,jk) = tmask(ji,jj,jk) * zsfc
+ zts(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem) * zsfc
+ zts(ji,jj,jk,jp_sal) = tsn(ji,jj,jk,jp_sal) * zsfc
+ ENDDO
+ ENDDO
+ ENDDO
DO jn = 1, nptr
- DO jk = 2, jpk
- v_msf (:,jk,jn) = v_msf (:,jk-1,jn) + v_msf (:,jk,jn) ! Eulerian j-Stream-Function
-#if defined key_diaeiv
- v_msf_eiv(:,jk,jn) = v_msf_eiv(:,jk-1,jn) + v_msf_eiv(:,jk,jn) ! Bolus j-Stream-Function
-
-#endif
- END DO
- END DO
- v_msf (:,:,:) = v_msf (:,:,:) * rc_sv ! converte in Sverdrups
-#if defined key_diaeiv
- v_msf_eiv(:,:,:) = v_msf_eiv(:,:,:) * rc_sv
-#endif
- ENDIF
- !
- CALL dia_ptr_wri( kt ) ! outputs
+ zmask(1,:,:) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) )
+ cl1 = TRIM('zosrf'//clsubb(jn) )
+ CALL iom_put( cl1, zmask )
+ !
+ z3d(1,:,:) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) &
+ & / MAX( zmask(1,:,:), 10.e-15 )
+ DO ji = 1, jpi
+ z3d(ji,:,:) = z3d(1,:,:)
+ ENDDO
+ cl1 = TRIM('zotem'//clsubb(jn) )
+ CALL iom_put( cl1, z3d )
+ !
+ z3d(1,:,:) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) &
+ & / MAX( zmask(1,:,:), 10.e-15 )
+ DO ji = 1, jpi
+ z3d(ji,:,:) = z3d(1,:,:)
+ ENDDO
+ cl1 = TRIM('zosal'//clsubb(jn) )
+ CALL iom_put( cl1, z3d )
+ END DO
+ ENDIF
+ !
+ ! ! Advective and diffusive heat and salt transport
+ IF( iom_use("sophtadv") .OR. iom_use("sopstadv") ) THEN
+ z2d(1,:) = htr_adv(:) * rc_pwatt ! (conversion in PW)
+ DO ji = 1, jpi
+ z2d(ji,:) = z2d(1,:)
+ ENDDO
+ cl1 = 'sophtadv'
+ CALL iom_put( TRIM(cl1), z2d )
+ z2d(1,:) = str_adv(:) * rc_ggram ! (conversion in Gg)
+ DO ji = 1, jpi
+ z2d(ji,:) = z2d(1,:)
+ ENDDO
+ cl1 = 'sopstadv'
+ CALL iom_put( TRIM(cl1), z2d )
+ ENDIF
+ !
+ IF( iom_use("sophtldf") .OR. iom_use("sopstldf") ) THEN
+ z2d(1,:) = htr_ldf(:) * rc_pwatt ! (conversion in PW)
+ DO ji = 1, jpi
+ z2d(ji,:) = z2d(1,:)
+ ENDDO
+ cl1 = 'sophtldf'
+ CALL iom_put( TRIM(cl1), z2d )
+ z2d(1,:) = str_ldf(:) * rc_ggram ! (conversion in Gg)
+ DO ji = 1, jpi
+ z2d(ji,:) = z2d(1,:)
+ ENDDO
+ cl1 = 'sopstldf'
+ CALL iom_put( TRIM(cl1), z2d )
+ ENDIF
!
ENDIF
- !
-#if defined key_mpp_mpi
- IF( kt == nitend .AND. l_znl_root ) CALL histclo( numptr ) ! Close the file
-#else
- IF( kt == nitend ) CALL histclo( numptr ) ! Close the file
-#endif
!
IF( nn_timing == 1 ) CALL timing_stop('dia_ptr')
@@ -450,12 +192,9 @@
!! ** Purpose : Initialization, namelist read
!!----------------------------------------------------------------------
- INTEGER :: jn ! dummy loop indices
- INTEGER :: inum, ierr ! local integers
- INTEGER :: ios ! Local integer output status for namelist read
-#if defined key_mpp_mpi
- INTEGER, DIMENSION(1) :: iglo, iloc, iabsf, iabsl, ihals, ihale, idid
-#endif
- !!
- NAMELIST/namptr/ ln_diaptr, ln_diaznl, ln_subbas, ln_ptrcomp, nn_fptr, nn_fwri
+ INTEGER :: jn ! local integers
+ INTEGER :: inum, ierr ! local integers
+ INTEGER :: ios ! Local integer output status for namelist read
+ !!
+ NAMELIST/namptr/ ln_diaptr, ln_subbas
!!----------------------------------------------------------------------
@@ -475,17 +214,17 @@
WRITE(numout,*) ' Namelist namptr : set ptr parameters'
WRITE(numout,*) ' Poleward heat & salt transport (T) or not (F) ln_diaptr = ', ln_diaptr
- WRITE(numout,*) ' Overturning heat & salt transport ln_ptrcomp = ', ln_ptrcomp
- WRITE(numout,*) ' T & S zonal mean and meridional stream function ln_diaznl = ', ln_diaznl
WRITE(numout,*) ' Global (F) or glo/Atl/Pac/Ind/Indo-Pac basins ln_subbas = ', ln_subbas
- WRITE(numout,*) ' Frequency of computation nn_fptr = ', nn_fptr
- WRITE(numout,*) ' Frequency of outputs nn_fwri = ', nn_fwri
ENDIF
-
- IF( ln_diaptr) THEN
-
- IF( nn_timing == 1 ) CALL timing_start('dia_ptr_init')
-
- IF( ln_subbas ) THEN ; nptr = 5 ! Global, Atlantic, Pacific, Indian, Indo-Pacific
- ELSE ; nptr = 1 ! Global only
+
+ IF( ln_diaptr ) THEN
+ !
+ IF( ln_subbas ) THEN
+ nptr = 5 ! Global, Atlantic, Pacific, Indian, Indo-Pacific
+ ALLOCATE( clsubb(nptr) )
+ clsubb(1) = 'glo' ; clsubb(2) = 'atl' ; clsubb(3) = 'pac' ; clsubb(4) = 'ind' ; clsubb(5) = 'ipc'
+ ELSE
+ nptr = 1 ! Global only
+ ALLOCATE( clsubb(nptr) )
+ clsubb(1) = 'glo'
ENDIF
@@ -493,10 +232,10 @@
IF( dia_ptr_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ptr_init : unable to allocate arrays' )
- rc_pwatt = rc_pwatt * rau0 * rcp ! conversion from K.s-1 to PetaWatt
+ rc_pwatt = rc_pwatt * rau0_rcp ! conversion from K.s-1 to PetaWatt
IF( lk_mpp ) CALL mpp_ini_znl( numout ) ! Define MPI communicator for zonal sum
IF( ln_subbas ) THEN ! load sub-basin mask
- CALL iom_open( 'subbasins', inum )
+ CALL iom_open( 'subbasins', inum, ldstop = .FALSE. )
CALL iom_get( inum, jpdom_data, 'atlmsk', btmsk(:,:,2) ) ! Atlantic basin
CALL iom_get( inum, jpdom_data, 'pacmsk', btmsk(:,:,3) ) ! Pacific basin
@@ -508,4 +247,5 @@
END WHERE
ENDIF
+
btmsk(:,:,1) = tmask_i(:,:) ! global ocean
@@ -513,32 +253,10 @@
btmsk(:,:,jn) = btmsk(:,:,jn) * tmask_i(:,:) ! interior domain only
END DO
-
- IF( lk_vvl ) CALL ctl_stop( 'diaptr: error in vvl case as constant i-mean surface is used' )
-
- ! ! i-sum of e1v*e3v surface and its inverse
- DO jn = 1, nptr
- sjk(:,:,jn) = ptr_tjk( tmask(:,:,:), btmsk(:,:,jn) )
- r1_sjk(:,:,jn) = 0._wp
- WHERE( sjk(:,:,jn) /= 0._wp ) r1_sjk(:,:,jn) = 1._wp / sjk(:,:,jn)
- END DO
-
- ! Initialise arrays to zero because diatpr is called before they are first calculated
- ! Note that this means diagnostics will not be exactly correct when model run is restarted.
- htr_adv(:) = 0._wp ; str_adv(:) = 0._wp ; htr_ldf(:) = 0._wp ; str_ldf(:) = 0._wp
-
-#if defined key_mpp_mpi
- iglo (1) = jpjglo ! MPP case using MPI ('key_mpp_mpi')
- iloc (1) = nlcj
- iabsf(1) = njmppt(narea)
- iabsl(:) = iabsf(:) + iloc(:) - 1
- ihals(1) = nldj - 1
- ihale(1) = nlcj - nlej
- idid (1) = 2
- CALL flio_dom_set( jpnj, nproc/jpni, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom_ptr )
-#else
- nidom_ptr = FLIO_DOM_NONE
-#endif
- IF( nn_timing == 1 ) CALL timing_stop('dia_ptr_init')
- !
+
+ ! Initialise arrays to zero because diatpr is called before they are first calculated
+ ! Note that this means diagnostics will not be exactly correct when model run is restarted.
+ htr_adv(:) = 0._wp ; str_adv(:) = 0._wp
+ htr_ldf(:) = 0._wp ; str_ldf(:) = 0._wp
+ !
ENDIF
!
@@ -546,350 +264,176 @@
- SUBROUTINE dia_ptr_wri( kt )
- !!---------------------------------------------------------------------
- !! *** ROUTINE dia_ptr_wri ***
- !!
- !! ** Purpose : output of poleward fluxes
- !!
- !! ** Method : NetCDF file
- !!----------------------------------------------------------------------
- !!
- INTEGER, INTENT(in) :: kt ! ocean time-step index
- !!
- INTEGER, SAVE :: nhoridz, ndepidzt, ndepidzw
- INTEGER, SAVE :: ndim , ndim_atl , ndim_pac , ndim_ind , ndim_ipc
- INTEGER, SAVE :: ndim_atl_30 , ndim_pac_30 , ndim_ind_30 , ndim_ipc_30
- INTEGER, SAVE :: ndim_h, ndim_h_atl_30, ndim_h_pac_30, ndim_h_ind_30, ndim_h_ipc_30
- !!
- CHARACTER (len=40) :: clhstnam, clop, clop_once, cl_comment ! temporary names
- INTEGER :: iline, it, itmod, ji, jj, jk !
-#if defined key_iomput
- INTEGER :: inum ! temporary logical unit
+ FUNCTION dia_ptr_alloc()
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE dia_ptr_alloc ***
+ !!----------------------------------------------------------------------
+ INTEGER :: dia_ptr_alloc ! return value
+ INTEGER, DIMENSION(3) :: ierr
+ !!----------------------------------------------------------------------
+ ierr(:) = 0
+ !
+ ALLOCATE( btmsk(jpi,jpj,nptr) , &
+ & htr_adv(jpj) , str_adv(jpj) , &
+ & htr_ldf(jpj) , str_ldf(jpj) , STAT=ierr(1) )
+ !
+ ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(2))
+ !
+ ALLOCATE( btm30(jpi,jpj), STAT=ierr(3) )
+
+ !
+ dia_ptr_alloc = MAXVAL( ierr )
+ IF(lk_mpp) CALL mpp_sum( dia_ptr_alloc )
+ !
+ END FUNCTION dia_ptr_alloc
+
+
+ FUNCTION ptr_sj_3d( pva, pmsk ) RESULT ( p_fval )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE ptr_sj_3d ***
+ !!
+ !! ** Purpose : i-k sum computation of a j-flux array
+ !!
+ !! ** Method : - i-k sum of pva using the interior 2D vmask (vmask_i).
+ !! pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v)
+ !!
+ !! ** Action : - p_fval: i-k-mean poleward flux of pva
+ !!----------------------------------------------------------------------
+ REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) :: pva ! mask flux array at V-point
+ REAL(wp), INTENT(in), DIMENSION(jpi,jpj), OPTIONAL :: pmsk ! Optional 2D basin mask
+ !
+ INTEGER :: ji, jj, jk ! dummy loop arguments
+ INTEGER :: ijpj ! ???
+ REAL(wp), POINTER, DIMENSION(:) :: p_fval ! function value
+ !!--------------------------------------------------------------------
+ !
+ p_fval => p_fval1d
+
+ ijpj = jpj
+ p_fval(:) = 0._wp
+ IF( PRESENT( pmsk ) ) THEN
+ DO jk = 1, jpkm1
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! Vector opt.
+ p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * tmask_i(ji,jj) * pmsk(ji,jj)
+ END DO
+ END DO
+ END DO
+ ELSE
+ DO jk = 1, jpkm1
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! Vector opt.
+ p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * tmask_i(ji,jj)
+ END DO
+ END DO
+ END DO
+ ENDIF
+#if defined key_mpp_mpi
+ IF(lk_mpp) CALL mpp_sum( p_fval, ijpj, ncomm_znl)
#endif
- REAL(wp) :: zsto, zout, zdt, zjulian ! temporary scalars
- !!
- REAL(wp), POINTER, DIMENSION(:) :: zphi, zfoo ! 1D workspace
- REAL(wp), POINTER, DIMENSION(:,:) :: z_1 ! 2D workspace
- !!--------------------------------------------------------------------
- !
- CALL wrk_alloc( jpj , zphi , zfoo )
- CALL wrk_alloc( jpj , jpk , z_1 )
-
- ! define time axis
- it = kt / nn_fptr
- itmod = kt - nit000 + 1
-
- ! Initialization
- ! --------------
- IF( kt == nit000 ) THEN
- niter = ( nit000 - 1 ) / nn_fptr
- zdt = rdt
- IF( nacc == 1 ) zdt = rdtmin
- !
- IF(lwp) THEN
- WRITE(numout,*)
- WRITE(numout,*) 'dia_ptr_wri : poleward transport and msf writing: initialization , niter = ', niter
- WRITE(numout,*) '~~~~~~~~~~~~'
- ENDIF
-
- ! Reference latitude (used in plots)
- ! ------------------
- ! ! =======================
- IF( cp_cfg == "orca" ) THEN ! ORCA configurations
- ! ! =======================
- IF( jp_cfg == 05 ) iline = 192 ! i-line that passes near the North Pole
- IF( jp_cfg == 025 ) iline = 384 ! i-line that passes near the North Pole
- IF( jp_cfg == 1 ) iline = 96 ! i-line that passes near the North Pole
- IF( jp_cfg == 2 ) iline = 48 ! i-line that passes near the North Pole
- IF( jp_cfg == 4 ) iline = 24 ! i-line that passes near the North Pole
- zphi(1:jpj) = 0._wp
- DO ji = mi0(iline), mi1(iline)
- zphi(1:jpj) = gphiv(ji,:) ! if iline is in the local domain
- ! Correct highest latitude for some configurations - will work if domain is parallelized in J ?
- IF( jp_cfg == 05 ) THEN
- DO jj = mj0(jpjdta), mj1(jpjdta)
- zphi( jj ) = zphi(mj0(jpjdta-1)) + ( zphi(mj0(jpjdta-1))-zphi(mj0(jpjdta-2)) ) * 0.5_wp
- zphi( jj ) = MIN( zphi(jj), 90._wp )
- END DO
- END IF
- IF( jp_cfg == 1 .OR. jp_cfg == 2 .OR. jp_cfg == 4 ) THEN
- DO jj = mj0(jpjdta-1), mj1(jpjdta-1)
- zphi( jj ) = 88.5_wp
- END DO
- DO jj = mj0(jpjdta ), mj1(jpjdta )
- zphi( jj ) = 89.5_wp
- END DO
- END IF
- END DO
- ! provide the correct zphi to all local domains
+ !
+ END FUNCTION ptr_sj_3d
+
+
+ FUNCTION ptr_sj_2d( pva, pmsk ) RESULT ( p_fval )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE ptr_sj_2d ***
+ !!
+ !! ** Purpose : "zonal" and vertical sum computation of a i-flux array
+ !!
+ !! ** Method : - i-k sum of pva using the interior 2D vmask (vmask_i).
+ !! pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v)
+ !!
+ !! ** Action : - p_fval: i-k-mean poleward flux of pva
+ !!----------------------------------------------------------------------
+ REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pva ! mask flux array at V-point
+ REAL(wp) , INTENT(in), DIMENSION(jpi,jpj), OPTIONAL :: pmsk ! Optional 2D basin mask
+ !
+ INTEGER :: ji,jj ! dummy loop arguments
+ INTEGER :: ijpj ! ???
+ REAL(wp), POINTER, DIMENSION(:) :: p_fval ! function value
+ !!--------------------------------------------------------------------
+ !
+ p_fval => p_fval1d
+
+ ijpj = jpj
+ p_fval(:) = 0._wp
+ IF( PRESENT( pmsk ) ) THEN
+ DO jj = 2, jpjm1
+ DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ?
+ p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj) * pmsk(ji,jj)
+ END DO
+ END DO
+ ELSE
+ DO jj = 2, jpjm1
+ DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ?
+ p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj)
+ END DO
+ END DO
+ ENDIF
#if defined key_mpp_mpi
- CALL mpp_sum( zphi, jpj, ncomm_znl )
+ CALL mpp_sum( p_fval, ijpj, ncomm_znl )
#endif
- ! ! =======================
- ELSE ! OTHER configurations
- ! ! =======================
- zphi(1:jpj) = gphiv(1,:) ! assume lat/lon coordinate, select the first i-line
- !
- ENDIF
- !
- ! Work only on westmost processor (will not work if mppini2 is used)
+ !
+ END FUNCTION ptr_sj_2d
+
+
+ FUNCTION ptr_sjk( pta, pmsk ) RESULT ( p_fval )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE ptr_sjk ***
+ !!
+ !! ** Purpose : i-sum computation of an array
+ !!
+ !! ** Method : - i-sum of pva using the interior 2D vmask (vmask_i).
+ !!
+ !! ** Action : - p_fval: i-mean poleward flux of pva
+ !!----------------------------------------------------------------------
+ !!
+ IMPLICIT none
+ REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pta ! mask flux array at V-point
+ REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) , OPTIONAL :: pmsk ! Optional 2D basin mask
+ !!
+ INTEGER :: ji, jj, jk ! dummy loop arguments
+ REAL(wp), POINTER, DIMENSION(:,:) :: p_fval ! return function value
#if defined key_mpp_mpi
- IF( l_znl_root ) THEN
+ INTEGER, DIMENSION(1) :: ish
+ INTEGER, DIMENSION(2) :: ish2
+ INTEGER :: ijpjjpk
+ REAL(wp), DIMENSION(jpj*jpk) :: zwork ! mask flux array at V-point
#endif
- !
- ! OPEN netcdf file
- ! ----------------
- ! Define frequency of output and means
- zsto = nn_fptr * zdt
- IF( ln_mskland ) THEN ! put 1.e+20 on land (very expensive!!)
- clop = "ave(only(x))"
- clop_once = "once(only(x))"
- ELSE ! no use of the mask value (require less cpu time)
- clop = "ave(x)"
- clop_once = "once"
- ENDIF
-
- zout = nn_fwri * zdt
- zfoo(1:jpj) = 0._wp
-
- CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian ) ! Compute julian date from starting date of the run
- zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment
-
-#if defined key_iomput
- ! Requested by IPSL people, use by their postpro...
- IF(lwp) THEN
- CALL dia_nam( clhstnam, nn_fwri,' ' )
- CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
- WRITE(inum,*) clhstnam
- CLOSE(inum)
- ENDIF
+ !!--------------------------------------------------------------------
+ !
+ p_fval => p_fval2d
+
+ p_fval(:,:) = 0._wp
+ !
+ IF( PRESENT( pmsk ) ) THEN
+ DO jk = 1, jpkm1
+ DO jj = 2, jpjm1
+!!gm here, use of tmask_i ==> no need of loop over nldi, nlei....
+ DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ?
+ p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * pmsk(ji,jj)
+ END DO
+ END DO
+ END DO
+ ELSE
+ DO jk = 1, jpkm1
+ DO jj = 2, jpjm1
+ DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ?
+ p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * tmask_i(ji,jj)
+ END DO
+ END DO
+ END DO
+ END IF
+ !
+#if defined key_mpp_mpi
+ ijpjjpk = jpj*jpk
+ ish(1) = ijpjjpk ; ish2(1) = jpj ; ish2(2) = jpk
+ zwork(1:ijpjjpk) = RESHAPE( p_fval, ish )
+ CALL mpp_sum( zwork, ijpjjpk, ncomm_znl )
+ p_fval(:,:) = RESHAPE( zwork, ish2 )
#endif
-
- CALL dia_nam( clhstnam, nn_fwri, 'diaptr' )
- IF(lwp)WRITE( numout,*)" Name of diaptr NETCDF file : ", clhstnam
-
- ! Horizontal grid : zphi()
- CALL histbeg(clhstnam, 1, zfoo, jpj, zphi, &
- 1, 1, 1, jpj, niter, zjulian, zdt*nn_fptr, nhoridz, numptr, domain_id=nidom_ptr)
- ! Vertical grids : gdept_1d, gdepw_1d
- CALL histvert( numptr, "deptht", "Vertical T levels", &
- & "m", jpk, gdept_1d, ndepidzt, "down" )
- CALL histvert( numptr, "depthw", "Vertical W levels", &
- & "m", jpk, gdepw_1d, ndepidzw, "down" )
- !
- CALL wheneq ( jpj*jpk, MIN(sjk(:,:,1), 1._wp), 1, 1., ndex , ndim ) ! Lat-Depth
- CALL wheneq ( jpj , MIN(sjk(:,1,1), 1._wp), 1, 1., ndex_h, ndim_h ) ! Lat
-
- IF( ln_subbas ) THEN
- z_1(:,1) = 1._wp
- WHERE ( gphit(jpi/2,:) < -30._wp ) z_1(:,1) = 0._wp
- DO jk = 2, jpk
- z_1(:,jk) = z_1(:,1)
- END DO
- ! ! Atlantic (jn=2)
- CALL wheneq ( jpj*jpk, MIN(sjk(:,:,2) , 1._wp), 1, 1., ndex_atl , ndim_atl ) ! Lat-Depth
- CALL wheneq ( jpj*jpk, MIN(sjk(:,:,2)*z_1(:,:), 1._wp), 1, 1., ndex_atl_30 , ndim_atl_30 ) ! Lat-Depth
- CALL wheneq ( jpj , MIN(sjk(:,1,2)*z_1(:,1), 1._wp), 1, 1., ndex_h_atl_30, ndim_h_atl_30 ) ! Lat
- ! ! Pacific (jn=3)
- CALL wheneq ( jpj*jpk, MIN(sjk(:,:,3) , 1._wp), 1, 1., ndex_pac , ndim_pac ) ! Lat-Depth
- CALL wheneq ( jpj*jpk, MIN(sjk(:,:,3)*z_1(:,:), 1._wp), 1, 1., ndex_pac_30 , ndim_pac_30 ) ! Lat-Depth
- CALL wheneq ( jpj , MIN(sjk(:,1,3)*z_1(:,1), 1._wp), 1, 1., ndex_h_pac_30, ndim_h_pac_30 ) ! Lat
- ! ! Indian (jn=4)
- CALL wheneq ( jpj*jpk, MIN(sjk(:,:,4) , 1._wp), 1, 1., ndex_ind , ndim_ind ) ! Lat-Depth
- CALL wheneq ( jpj*jpk, MIN(sjk(:,:,4)*z_1(:,:), 1._wp), 1, 1., ndex_ind_30 , ndim_ind_30 ) ! Lat-Depth
- CALL wheneq ( jpj , MIN(sjk(:,1,4)*z_1(:,1), 1._wp), 1, 1., ndex_h_ind_30, ndim_h_ind_30 ) ! Lat
- ! ! Indo-Pacific (jn=5)
- CALL wheneq ( jpj*jpk, MIN(sjk(:,:,5) , 1._wp), 1, 1., ndex_ipc , ndim_ipc ) ! Lat-Depth
- CALL wheneq ( jpj*jpk, MIN(sjk(:,:,5)*z_1(:,:), 1._wp), 1, 1., ndex_ipc_30 , ndim_ipc_30 ) ! Lat-Depth
- CALL wheneq ( jpj , MIN(sjk(:,1,5)*z_1(:,1), 1._wp), 1, 1., ndex_h_ipc_30, ndim_h_ipc_30 ) ! Lat
- ENDIF
- !
-#if defined key_diaeiv
- cl_comment = ' (Bolus part included)'
-#else
- cl_comment = ' '
-#endif
- IF( ln_diaznl ) THEN ! Zonal mean T and S
- CALL histdef( numptr, "zotemglo", "Zonal Mean Temperature","C" , &
- 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
- CALL histdef( numptr, "zosalglo", "Zonal Mean Salinity","PSU" , &
- 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
-
- CALL histdef( numptr, "zosrfglo", "Zonal Mean Surface","m^2" , &
- 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout )
- !
- IF (ln_subbas) THEN
- CALL histdef( numptr, "zotematl", "Zonal Mean Temperature: Atlantic","C" , &
- 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
- CALL histdef( numptr, "zosalatl", "Zonal Mean Salinity: Atlantic","PSU" , &
- 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
- CALL histdef( numptr, "zosrfatl", "Zonal Mean Surface: Atlantic","m^2" , &
- 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout )
-
- CALL histdef( numptr, "zotempac", "Zonal Mean Temperature: Pacific","C" , &
- 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
- CALL histdef( numptr, "zosalpac", "Zonal Mean Salinity: Pacific","PSU" , &
- 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
- CALL histdef( numptr, "zosrfpac", "Zonal Mean Surface: Pacific","m^2" , &
- 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout )
-
- CALL histdef( numptr, "zotemind", "Zonal Mean Temperature: Indian","C" , &
- 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
- CALL histdef( numptr, "zosalind", "Zonal Mean Salinity: Indian","PSU" , &
- 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
- CALL histdef( numptr, "zosrfind", "Zonal Mean Surface: Indian","m^2" , &
- 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout )
-
- CALL histdef( numptr, "zotemipc", "Zonal Mean Temperature: Pacific+Indian","C" , &
- 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
- CALL histdef( numptr, "zosalipc", "Zonal Mean Salinity: Pacific+Indian","PSU" , &
- 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
- CALL histdef( numptr, "zosrfipc", "Zonal Mean Surface: Pacific+Indian","m^2" , &
- 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout )
- ENDIF
- ENDIF
- !
- ! Meridional Stream-Function (Eulerian and Bolus)
- CALL histdef( numptr, "zomsfglo", "Meridional Stream-Function: Global"//TRIM(cl_comment),"Sv" , &
- 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
- IF( ln_subbas .AND. ln_diaznl ) THEN
- CALL histdef( numptr, "zomsfatl", "Meridional Stream-Function: Atlantic"//TRIM(cl_comment),"Sv" , &
- 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
- CALL histdef( numptr, "zomsfpac", "Meridional Stream-Function: Pacific"//TRIM(cl_comment),"Sv" , &
- 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
- CALL histdef( numptr, "zomsfind", "Meridional Stream-Function: Indian"//TRIM(cl_comment),"Sv" , &
- 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
- CALL histdef( numptr, "zomsfipc", "Meridional Stream-Function: Indo-Pacific"//TRIM(cl_comment),"Sv" ,&
- 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
- ENDIF
- !
- ! Heat transport
- CALL histdef( numptr, "sophtadv", "Advective Heat Transport" , &
- "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
- CALL histdef( numptr, "sophtldf", "Diffusive Heat Transport" , &
- "PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
- IF ( ln_ptrcomp ) THEN
- CALL histdef( numptr, "sophtove", "Overturning Heat Transport" , &
- "PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
- END IF
- IF( ln_subbas ) THEN
- CALL histdef( numptr, "sohtatl", "Heat Transport Atlantic"//TRIM(cl_comment), &
- "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
- CALL histdef( numptr, "sohtpac", "Heat Transport Pacific"//TRIM(cl_comment) , &
- "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
- CALL histdef( numptr, "sohtind", "Heat Transport Indian"//TRIM(cl_comment) , &
- "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
- CALL histdef( numptr, "sohtipc", "Heat Transport Pacific+Indian"//TRIM(cl_comment), &
- "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
- ENDIF
- !
- ! Salt transport
- CALL histdef( numptr, "sopstadv", "Advective Salt Transport" , &
- "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
- CALL histdef( numptr, "sopstldf", "Diffusive Salt Transport" , &
- "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
- IF ( ln_ptrcomp ) THEN
- CALL histdef( numptr, "sopstove", "Overturning Salt Transport" , &
- "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
- END IF
-#if defined key_diaeiv
- ! Eddy induced velocity
- CALL histdef( numptr, "zomsfeiv", "Bolus Meridional Stream-Function: global", &
- "Sv" , 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
- CALL histdef( numptr, "sophteiv", "Bolus Advective Heat Transport", &
- "PW" , 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
- CALL histdef( numptr, "sopsteiv", "Bolus Advective Salt Transport", &
- "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
-#endif
- IF( ln_subbas ) THEN
- CALL histdef( numptr, "sostatl", "Salt Transport Atlantic"//TRIM(cl_comment) , &
- "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
- CALL histdef( numptr, "sostpac", "Salt Transport Pacific"//TRIM(cl_comment) , &
- "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
- CALL histdef( numptr, "sostind", "Salt Transport Indian"//TRIM(cl_comment) , &
- "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
- CALL histdef( numptr, "sostipc", "Salt Transport Pacific+Indian"//TRIM(cl_comment), &
- "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
- ENDIF
- !
- CALL histend( numptr )
- !
- END IF
-#if defined key_mpp_mpi
- END IF
-#endif
-
-#if defined key_mpp_mpi
- IF( MOD( itmod, nn_fptr ) == 0 .AND. l_znl_root ) THEN
-#else
- IF( MOD( itmod, nn_fptr ) == 0 ) THEN
-#endif
- niter = niter + 1
-
- IF( ln_diaznl ) THEN
- CALL histwrite( numptr, "zosrfglo", niter, sjk (:,:,1) , ndim, ndex )
- CALL histwrite( numptr, "zotemglo", niter, tn_jk(:,:,1) , ndim, ndex )
- CALL histwrite( numptr, "zosalglo", niter, sn_jk(:,:,1) , ndim, ndex )
-
- IF (ln_subbas) THEN
- CALL histwrite( numptr, "zosrfatl", niter, sjk(:,:,2), ndim_atl, ndex_atl )
- CALL histwrite( numptr, "zosrfpac", niter, sjk(:,:,3), ndim_pac, ndex_pac )
- CALL histwrite( numptr, "zosrfind", niter, sjk(:,:,4), ndim_ind, ndex_ind )
- CALL histwrite( numptr, "zosrfipc", niter, sjk(:,:,5), ndim_ipc, ndex_ipc )
-
- CALL histwrite( numptr, "zotematl", niter, tn_jk(:,:,2) , ndim_atl, ndex_atl )
- CALL histwrite( numptr, "zosalatl", niter, sn_jk(:,:,2) , ndim_atl, ndex_atl )
- CALL histwrite( numptr, "zotempac", niter, tn_jk(:,:,3) , ndim_pac, ndex_pac )
- CALL histwrite( numptr, "zosalpac", niter, sn_jk(:,:,3) , ndim_pac, ndex_pac )
- CALL histwrite( numptr, "zotemind", niter, tn_jk(:,:,4) , ndim_ind, ndex_ind )
- CALL histwrite( numptr, "zosalind", niter, sn_jk(:,:,4) , ndim_ind, ndex_ind )
- CALL histwrite( numptr, "zotemipc", niter, tn_jk(:,:,5) , ndim_ipc, ndex_ipc )
- CALL histwrite( numptr, "zosalipc", niter, sn_jk(:,:,5) , ndim_ipc, ndex_ipc )
- END IF
- ENDIF
-
- ! overturning outputs:
- CALL histwrite( numptr, "zomsfglo", niter, v_msf(:,:,1), ndim, ndex )
- IF( ln_subbas .AND. ln_diaznl ) THEN
- CALL histwrite( numptr, "zomsfatl", niter, v_msf(:,:,2) , ndim_atl_30, ndex_atl_30 )
- CALL histwrite( numptr, "zomsfpac", niter, v_msf(:,:,3) , ndim_pac_30, ndex_pac_30 )
- CALL histwrite( numptr, "zomsfind", niter, v_msf(:,:,4) , ndim_ind_30, ndex_ind_30 )
- CALL histwrite( numptr, "zomsfipc", niter, v_msf(:,:,5) , ndim_ipc_30, ndex_ipc_30 )
- ENDIF
-#if defined key_diaeiv
- CALL histwrite( numptr, "zomsfeiv", niter, v_msf_eiv(:,:,1), ndim , ndex )
-#endif
-
- ! heat transport outputs:
- IF( ln_subbas ) THEN
- CALL histwrite( numptr, "sohtatl", niter, htr(:,2) , ndim_h_atl_30, ndex_h_atl_30 )
- CALL histwrite( numptr, "sohtpac", niter, htr(:,3) , ndim_h_pac_30, ndex_h_pac_30 )
- CALL histwrite( numptr, "sohtind", niter, htr(:,4) , ndim_h_ind_30, ndex_h_ind_30 )
- CALL histwrite( numptr, "sohtipc", niter, htr(:,5) , ndim_h_ipc_30, ndex_h_ipc_30 )
- CALL histwrite( numptr, "sostatl", niter, str(:,2) , ndim_h_atl_30, ndex_h_atl_30 )
- CALL histwrite( numptr, "sostpac", niter, str(:,3) , ndim_h_pac_30, ndex_h_pac_30 )
- CALL histwrite( numptr, "sostind", niter, str(:,4) , ndim_h_ind_30, ndex_h_ind_30 )
- CALL histwrite( numptr, "sostipc", niter, str(:,5) , ndim_h_ipc_30, ndex_h_ipc_30 )
- ENDIF
-
- CALL histwrite( numptr, "sophtadv", niter, htr_adv , ndim_h, ndex_h )
- CALL histwrite( numptr, "sophtldf", niter, htr_ldf , ndim_h, ndex_h )
- CALL histwrite( numptr, "sopstadv", niter, str_adv , ndim_h, ndex_h )
- CALL histwrite( numptr, "sopstldf", niter, str_ldf , ndim_h, ndex_h )
- IF( ln_ptrcomp ) THEN
- CALL histwrite( numptr, "sopstove", niter, str_ove(:) , ndim_h, ndex_h )
- CALL histwrite( numptr, "sophtove", niter, htr_ove(:) , ndim_h, ndex_h )
- ENDIF
-#if defined key_diaeiv
- CALL histwrite( numptr, "sophteiv", niter, htr_eiv(:,1) , ndim_h, ndex_h )
- CALL histwrite( numptr, "sopsteiv", niter, str_eiv(:,1) , ndim_h, ndex_h )
-#endif
- !
- ENDIF
- !
- CALL wrk_dealloc( jpj , zphi , zfoo )
- CALL wrk_dealloc( jpj , jpk, z_1 )
- !
- END SUBROUTINE dia_ptr_wri
+ !
+ END FUNCTION ptr_sjk
+
!!======================================================================
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90 (revision 5602)
@@ -46,4 +46,6 @@
USE iom
USE ioipsl
+ USE dynspg_oce, ONLY: un_adv, vn_adv ! barotropic velocities
+
#if defined key_lim2
USE limwri_2
@@ -78,5 +80,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2010)
- !! $Id $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
@@ -125,4 +127,5 @@
!!
INTEGER :: ji, jj, jk ! dummy loop indices
+ INTEGER :: jkbot !
REAL(wp) :: zztmp, zztmpx, zztmpy !
!!
@@ -142,85 +145,104 @@
ENDIF
- IF( lk_vvl ) THEN
- z3d(:,:,:) = tsn(:,:,:,jp_tem) !cbr * fse3t_n(:,:,:)
- CALL iom_put( "toce" , z3d ) ! heat content
+ IF( .NOT.lk_vvl ) THEN
+ CALL iom_put( "e3t" , fse3t_n(:,:,:) )
+ CALL iom_put( "e3u" , fse3u_n(:,:,:) )
+ CALL iom_put( "e3v" , fse3v_n(:,:,:) )
+ CALL iom_put( "e3w" , fse3w_n(:,:,:) )
+ ENDIF
+
+ CALL iom_put( "ssh" , sshn ) ! sea surface height
+ if( iom_use('ssh2') ) CALL iom_put( "ssh2", sshn(:,:) * sshn(:,:) ) ! square of sea surface height
+
+ CALL iom_put( "toce", tsn(:,:,:,jp_tem) ) ! 3D temperature
+ CALL iom_put( "sst", tsn(:,:,1,jp_tem) ) ! surface temperature
+ IF ( iom_use("sbt") ) THEN
DO jj = 1, jpj
DO ji = 1, jpi
- z2d(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem) * fse3t_n(ji,jj,mikt(ji,jj))
- END DO
- END DO
- CALL iom_put( "sst" , z2d(:,:) ) ! sea surface heat content
+ jkbot = mbkt(ji,jj)
+ z2d(ji,jj) = tsn(ji,jj,jkbot,jp_tem)
+ END DO
+ END DO
+ CALL iom_put( "sbt", z2d ) ! bottom temperature
+ ENDIF
+
+ CALL iom_put( "soce", tsn(:,:,:,jp_sal) ) ! 3D salinity
+ CALL iom_put( "sss", tsn(:,:,1,jp_sal) ) ! surface salinity
+ IF ( iom_use("sbs") ) THEN
DO jj = 1, jpj
DO ji = 1, jpi
- z2d(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem)**2 * fse3t_n(ji,jj,mikt(ji,jj))
- END DO
- END DO
- CALL iom_put( "sst2" , z2d(:,:) ) ! sea surface content of squared temperature
- z3d(:,:,:) = tsn(:,:,:,jp_sal) * fse3t_n(:,:,:)
- CALL iom_put( "soce" , z3d ) ! salinity content
+ jkbot = mbkt(ji,jj)
+ z2d(ji,jj) = tsn(ji,jj,jkbot,jp_sal)
+ END DO
+ END DO
+ CALL iom_put( "sbs", z2d ) ! bottom salinity
+ ENDIF
+
+ IF ( iom_use("taubot") ) THEN ! bottom stress
+ z2d(:,:) = 0._wp
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
+ zztmpx = ( bfrua(ji ,jj) * un(ji ,jj,mbku(ji ,jj)) &
+ & + bfrua(ji-1,jj) * un(ji-1,jj,mbku(ji-1,jj)) )
+ zztmpy = ( bfrva(ji, jj) * vn(ji,jj ,mbkv(ji,jj )) &
+ & + bfrva(ji,jj-1) * vn(ji,jj-1,mbkv(ji,jj-1)) )
+ z2d(ji,jj) = rau0 * SQRT( zztmpx * zztmpx + zztmpy * zztmpy ) * tmask(ji,jj,1)
+ !
+ ENDDO
+ ENDDO
+ CALL lbc_lnk( z2d, 'T', 1. )
+ CALL iom_put( "taubot", z2d )
+ ENDIF
+
+ CALL iom_put( "uoce", un(:,:,:) ) ! 3D i-current
+ CALL iom_put( "ssu", un(:,:,1) ) ! surface i-current
+ IF ( iom_use("sbu") ) THEN
DO jj = 1, jpj
DO ji = 1, jpi
- z2d(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal) * fse3t_n(ji,jj,mikt(ji,jj))
- END DO
- END DO
- CALL iom_put( "sss" , z2d(:,:) ) ! sea surface salinity content
+ jkbot = mbku(ji,jj)
+ z2d(ji,jj) = un(ji,jj,jkbot)
+ END DO
+ END DO
+ CALL iom_put( "sbu", z2d ) ! bottom i-current
+ ENDIF
+#if defined key_dynspg_ts
+ CALL iom_put( "ubar", un_adv(:,:) ) ! barotropic i-current
+#else
+ CALL iom_put( "ubar", un_b(:,:) ) ! barotropic i-current
+#endif
+
+ CALL iom_put( "voce", vn(:,:,:) ) ! 3D j-current
+ CALL iom_put( "ssv", vn(:,:,1) ) ! surface j-current
+ IF ( iom_use("sbv") ) THEN
DO jj = 1, jpj
DO ji = 1, jpi
- z2d(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal)**2 * fse3t_n(ji,jj,mikt(ji,jj))
- END DO
- END DO
- CALL iom_put( "sss2" , z2d(:,:) ) ! sea surface content of squared salinity
- ELSE
- CALL iom_put( "toce" , tsn(:,:,:,jp_tem) ) ! temperature
- IF ( iom_use("sst") ) THEN
- DO jj = 1, jpj
- DO ji = 1, jpi
- z2d(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem)
- END DO
- END DO
- CALL iom_put( "sst" , z2d(:,:) ) ! sea surface temperature
- ENDIF
- IF ( iom_use("sst2") ) CALL iom_put( "sst2" , z2d(:,:) * z2d(:,:) ) ! square of sea surface temperature
- CALL iom_put( "soce" , tsn(:,:,:,jp_sal) ) ! salinity
- IF ( iom_use("sss") ) THEN
- DO jj = 1, jpj
- DO ji = 1, jpi
- z2d(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal)
- END DO
- END DO
- CALL iom_put( "sss" , z2d(:,:) ) ! sea surface salinity
- ENDIF
- CALL iom_put( "sss2" , z2d(:,:) * z2d(:,:) ) ! square of sea surface salinity
- END IF
- IF( lk_vvl .AND. (.NOT. ln_dynadv_vec) ) THEN
- CALL iom_put( "uoce" , umask(:,:,:) * un(:,:,:) * fse3u_n(:,:,:) ) ! i-transport
- CALL iom_put( "voce" , vmask(:,:,:) * vn(:,:,:) * fse3v_n(:,:,:) ) ! j-transport
- ELSE
- CALL iom_put( "uoce" , umask(:,:,:) * un(:,:,:) ) ! i-current
- CALL iom_put( "voce" , vmask(:,:,:) * vn(:,:,:) ) ! j-current
- IF ( iom_use("ssu") ) THEN
- DO jj = 1, jpj
- DO ji = 1, jpi
- z2d(ji,jj) = un(ji,jj,miku(ji,jj))
- END DO
- END DO
- CALL iom_put( "ssu" , z2d ) ! i-current
- ENDIF
- IF ( iom_use("ssv") ) THEN
- DO jj = 1, jpj
- DO ji = 1, jpi
- z2d(ji,jj) = vn(ji,jj,mikv(ji,jj))
- END DO
- END DO
- CALL iom_put( "ssv" , z2d ) ! j-current
- ENDIF
- ENDIF
- CALL iom_put( "avt" , avt ) ! T vert. eddy diff. coef.
- CALL iom_put( "avm" , avmu ) ! T vert. eddy visc. coef.
- IF( lk_zdfddm ) THEN
- CALL iom_put( "avs" , fsavs(:,:,:) ) ! S vert. eddy diff. coef.
- ENDIF
-
- IF ( iom_use("sstgrad2") .OR. iom_use("sstgrad2") ) THEN
+ jkbot = mbkv(ji,jj)
+ z2d(ji,jj) = vn(ji,jj,jkbot)
+ END DO
+ END DO
+ CALL iom_put( "sbv", z2d ) ! bottom j-current
+ ENDIF
+#if defined key_dynspg_ts
+ CALL iom_put( "vbar", vn_adv(:,:) ) ! barotropic j-current
+#else
+ CALL iom_put( "vbar", vn_b(:,:) ) ! barotropic j-current
+#endif
+
+ CALL iom_put( "woce", wn ) ! vertical velocity
+ IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN ! vertical mass transport & its square value
+ ! Caution: in the VVL case, it only correponds to the baroclinic mass transport.
+ z2d(:,:) = rau0 * e12t(:,:)
+ DO jk = 1, jpk
+ z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:)
+ END DO
+ CALL iom_put( "w_masstr" , z3d )
+ IF( iom_use('w_masstr2') ) CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) )
+ ENDIF
+
+ CALL iom_put( "avt" , avt ) ! T vert. eddy diff. coef.
+ CALL iom_put( "avm" , avmu ) ! T vert. eddy visc. coef.
+ CALL iom_put( "avs" , fsavs(:,:,:) ) ! S vert. eddy diff. coef. (useful only with key_zdfddm)
+
+ IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN
DO jj = 2, jpjm1 ! sst gradient
DO ji = fs_2, fs_jpim1 ! vector opt.
@@ -234,5 +256,4 @@
CALL lbc_lnk( z2d, 'T', 1. )
CALL iom_put( "sstgrad2", z2d ) ! square of module of sst gradient
- !CDIR NOVERRCHK<
z2d(:,:) = SQRT( z2d(:,:) )
CALL iom_put( "sstgrad" , z2d ) ! module of sst gradient
@@ -243,11 +264,10 @@
z2d(:,:) = 0._wp
DO jk = 1, jpkm1
- DO jj = 2, jpjm1
- DO ji = fs_2, fs_jpim1 ! vector opt.
+ DO jj = 1, jpj
+ DO ji = 1, jpi
z2d(ji,jj) = z2d(ji,jj) + fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk)
END DO
END DO
END DO
- CALL lbc_lnk( z2d, 'T', 1. )
CALL iom_put( "heatc", (rau0 * rcp) * z2d ) ! vertically integrated heat content (J/m2)
ENDIF
@@ -256,11 +276,10 @@
z2d(:,:) = 0._wp
DO jk = 1, jpkm1
- DO jj = 2, jpjm1
- DO ji = fs_2, fs_jpim1 ! vector opt.
+ DO jj = 1, jpj
+ DO ji = 1, jpi
z2d(ji,jj) = z2d(ji,jj) + fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk)
END DO
END DO
END DO
- CALL lbc_lnk( z2d, 'T', 1. )
CALL iom_put( "saltc", rau0 * z2d ) ! vertically integrated salt content (PSU*kg/m2)
ENDIF
@@ -621,5 +640,5 @@
ENDIF
- IF( .NOT. lk_cpl ) THEN
+ IF( .NOT. ln_cpl ) THEN
CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping" , "W/m2" , & ! qrp
& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
@@ -630,5 +649,5 @@
ENDIF
- IF( lk_cpl .AND. nn_ice <= 1 ) THEN
+ IF( ln_cpl .AND. nn_ice <= 1 ) THEN
CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping" , "W/m2" , & ! qrp
& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
@@ -653,5 +672,5 @@
#endif
- IF( lk_cpl .AND. nn_ice == 2 ) THEN
+ IF( ln_cpl .AND. nn_ice == 2 ) THEN
CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature" , "K" , & ! tn_ice
& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
@@ -808,5 +827,5 @@
ENDIF
- IF( .NOT. lk_cpl ) THEN
+ IF( .NOT. ln_cpl ) THEN
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
@@ -814,5 +833,5 @@
CALL histwrite( nid_T, "sosafldp", it, zw2d , ndim_hT, ndex_hT ) ! salt flux damping
ENDIF
- IF( lk_cpl .AND. nn_ice <= 1 ) THEN
+ IF( ln_cpl .AND. nn_ice <= 1 ) THEN
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
@@ -830,5 +849,5 @@
#endif
- IF( lk_cpl .AND. nn_ice == 2 ) THEN
+ IF( ln_cpl .AND. nn_ice == 2 ) THEN
CALL histwrite( nid_T, "soicetem", it, tn_ice(:,:,1) , ndim_hT, ndex_hT ) ! surf. ice temperature
CALL histwrite( nid_T, "soicealb", it, alb_ice(:,:,1), ndim_hT, ndex_hT ) ! ice albedo
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90 (revision 5602)
@@ -72,4 +72,5 @@
!!----------------------------------------------------------------------
INTEGER :: jc ! dummy loop indices
+ INTEGER :: isrow ! local index
!!----------------------------------------------------------------------
@@ -91,7 +92,13 @@
CASE ( 1 ) ! ORCA_R1 configuration
! ! =======================
+ ! This dirty section will be suppressed by simplification process:
+ ! all this will come back in input files
+ ! Currently these hard-wired indices relate to configuration with
+ ! extend grid (jpjglo=332)
+ isrow = 332 - jpjglo
+ !
ncsnr(1) = 1 ; ncstt(1) = 0 ! Caspian Sea
- ncsi1(1) = 332 ; ncsj1(1) = 203
- ncsi2(1) = 344 ; ncsj2(1) = 235
+ ncsi1(1) = 332 ; ncsj1(1) = 243 - isrow
+ ncsi2(1) = 344 ; ncsj2(1) = 275 - isrow
ncsir(1,1) = 1 ; ncsjr(1,1) = 1
!
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90 (revision 5602)
@@ -164,8 +164,8 @@
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: gphit, gphiu !: latitude of t-, u-, v- and f-points (degre)
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: gphiv, gphif !:
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1t, e2t !: horizontal scale factors at t-point (m)
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1u, e2u !: horizontal scale factors at u-point (m)
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1v, e2v !: horizontal scale factors at v-point (m)
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1f, e2f !: horizontal scale factors at f-point (m)
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1t, e2t, r1_e1t, r1_e2t !: horizontal scale factors and inverse at t-point (m)
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1u, e2u, r1_e1u, r1_e2u !: horizontal scale factors and inverse at u-point (m)
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1v, e2v, r1_e1v, r1_e2v !: horizontal scale factors and inverse at v-point (m)
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1f, e2f, r1_e1f, r1_e2f !: horizontal scale factors and inverse at f-point (m)
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1e2t !: surface at t-point (m2)
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ff !: coriolis factor (2.*omega*sin(yphi) ) (s-1)
@@ -264,4 +264,5 @@
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, fmask !: land/ocean mask at T-, U-, V- and F-pts
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wmask, wumask, wvmask !: land/ocean mask at WT-, WU- and WV-pts
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: tpol, fpol !: north fold mask (jperio= 3 or 4)
@@ -334,5 +335,5 @@
INTEGER FUNCTION dom_oce_alloc()
!!----------------------------------------------------------------------
- INTEGER, DIMENSION(11) :: ierr
+ INTEGER, DIMENSION(12) :: ierr
!!----------------------------------------------------------------------
ierr(:) = 0
@@ -348,8 +349,9 @@
& tpol(jpiglo) , fpol(jpiglo) , STAT=ierr(2) )
!
- ALLOCATE( glamt(jpi,jpj) , gphit(jpi,jpj) , e1t(jpi,jpj) , e2t(jpi,jpj) , &
- & glamu(jpi,jpj) , gphiu(jpi,jpj) , e1u(jpi,jpj) , e2u(jpi,jpj) , &
- & glamv(jpi,jpj) , gphiv(jpi,jpj) , e1v(jpi,jpj) , e2v(jpi,jpj) , e1e2t(jpi,jpj) , &
- & glamf(jpi,jpj) , gphif(jpi,jpj) , e1f(jpi,jpj) , e2f(jpi,jpj) , ff (jpi,jpj) , STAT=ierr(3) )
+ ALLOCATE( glamt(jpi,jpj) , gphit(jpi,jpj) , e1t(jpi,jpj) , e2t(jpi,jpj) , r1_e1t(jpi,jpj) , r1_e2t(jpi,jpj) , &
+ & glamu(jpi,jpj) , gphiu(jpi,jpj) , e1u(jpi,jpj) , e2u(jpi,jpj) , r1_e1u(jpi,jpj) , r1_e2u(jpi,jpj) , &
+ & glamv(jpi,jpj) , gphiv(jpi,jpj) , e1v(jpi,jpj) , e2v(jpi,jpj) , r1_e1v(jpi,jpj) , r1_e2v(jpi,jpj) , &
+ & glamf(jpi,jpj) , gphif(jpi,jpj) , e1f(jpi,jpj) , e2f(jpi,jpj) , r1_e1f(jpi,jpj) , r1_e2f(jpi,jpj) , &
+ & e1e2t(jpi,jpj) , ff (jpi,jpj) , STAT=ierr(3) )
!
ALLOCATE( gdep3w_0(jpi,jpj,jpk) , e3v_0(jpi,jpj,jpk) , e3f_0 (jpi,jpj,jpk) , &
@@ -403,6 +405,8 @@
& vmask(jpi,jpj,jpk) , fmask(jpi,jpj,jpk), STAT=ierr(11) )
+ ALLOCATE( wmask(jpi,jpj,jpk) , wumask(jpi,jpj,jpk), wvmask(jpi,jpj,jpk) , STAT=ierr(12) )
+
#if defined key_noslip_accurate
- ALLOCATE( npcoa(4,jpk), nicoa(2*(jpi+jpj),4,jpk), njcoa(2*(jpi+jpj),4,jpk), STAT=ierr(11) )
+ ALLOCATE( npcoa(4,jpk), nicoa(2*(jpi+jpj),4,jpk), njcoa(2*(jpi+jpj),4,jpk), STAT=ierr(12) )
#endif
!
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90 (revision 5602)
@@ -135,7 +135,8 @@
!!----------------------------------------------------------------------
USE ioipsl
- NAMELIST/namrun/ nn_no , cn_exp , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl, &
+ NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list, &
+ & nn_no , cn_exp , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl, &
& nn_it000, nn_itend , nn_date0 , nn_leapy , nn_istate , nn_stock , &
- & nn_write, ln_dimgnnn, ln_mskland , ln_clobber , nn_chunksz, nn_euler
+ & nn_write, ln_dimgnnn, ln_mskland , ln_cfmeta , ln_clobber, nn_chunksz, nn_euler
NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin, &
& nn_acc , rn_atfp , rn_rdt , rn_rdtmin , &
@@ -169,5 +170,7 @@
WRITE(numout,*) ' experiment name for output cn_exp = ', cn_exp
WRITE(numout,*) ' file prefix restart input cn_ocerst_in= ', cn_ocerst_in
+ WRITE(numout,*) ' restart input directory cn_ocerst_indir= ', cn_ocerst_indir
WRITE(numout,*) ' file prefix restart output cn_ocerst_out= ', cn_ocerst_out
+ WRITE(numout,*) ' restart output directory cn_ocerst_outdir= ', cn_ocerst_outdir
WRITE(numout,*) ' restart logical ln_rstart = ', ln_rstart
WRITE(numout,*) ' start with forward time step nn_euler = ', nn_euler
@@ -178,8 +181,13 @@
WRITE(numout,*) ' leap year calendar (0/1) nn_leapy = ', nn_leapy
WRITE(numout,*) ' initial state output nn_istate = ', nn_istate
- WRITE(numout,*) ' frequency of restart file nn_stock = ', nn_stock
+ IF( ln_rst_list ) THEN
+ WRITE(numout,*) ' list of restart dump times nn_stocklist =', nn_stocklist
+ ELSE
+ WRITE(numout,*) ' frequency of restart file nn_stock = ', nn_stock
+ ENDIF
WRITE(numout,*) ' frequency of output file nn_write = ', nn_write
WRITE(numout,*) ' multi file dimgout ln_dimgnnn = ', ln_dimgnnn
WRITE(numout,*) ' mask land points ln_mskland = ', ln_mskland
+ WRITE(numout,*) ' additional CF standard metadata ln_cfmeta = ', ln_cfmeta
WRITE(numout,*) ' overwrite an existing file ln_clobber = ', ln_clobber
WRITE(numout,*) ' NetCDF chunksize (bytes) nn_chunksz = ', nn_chunksz
@@ -195,7 +203,8 @@
ninist = nn_istate
nstock = nn_stock
+ nstocklist = nn_stocklist
nwrite = nn_write
neuler = nn_euler
- IF ( neuler == 1 .AND. .NOT.ln_rstart ) THEN
+ IF ( neuler == 1 .AND. .NOT. ln_rstart ) THEN
WRITE(ctmp1,*) 'ln_rstart =.FALSE., nn_euler is forced to 0 '
CALL ctl_warn( ctmp1 )
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90 (revision 5602)
@@ -105,4 +105,6 @@
REAL(wp) :: zlam1, zcos_alpha, zim1 , zjm1 , ze1, ze1deg
REAL(wp) :: zphi1, zsin_alpha, zim05, zjm05
+ INTEGER :: isrow ! index for ORCA1 starting row
+
!!----------------------------------------------------------------------
!
@@ -159,49 +161,50 @@
IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN ! ORCA R1 configuration
! ! =====================
-
- ii0 = 281 ; ii1 = 282 ! Gibraltar Strait (e2u = 20 km)
- ij0 = 200 ; ij1 = 200 ; e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 20.e3
+ ! This dirty section will be suppressed by simplification process: all this will come back in input files
+ ! Currently these hard-wired indices relate to configuration with
+ ! extend grid (jpjglo=332)
+ ! which had a grid-size of 362x292.
+ !
+ isrow = 332 - jpjglo
+ !
+ ii0 = 282 ; ii1 = 283 ! Gibraltar Strait (e2u = 20 km)
+ ij0 = 201 + isrow ; ij1 = 241 - isrow ; e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 20.e3
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' orca_r1: Gibraltar : e2u reduced to 20 km'
- ii0 = 314 ; ii1 = 315 ! Bhosporus Strait (e2u = 10 km)
- ij0 = 208 ; ij1 = 208 ; e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 10.e3
+ ii0 = 314 ; ii1 = 315 ! Bhosporus Strait (e2u = 10 km)
+ ij0 = 208 + isrow ; ij1 = 248 - isrow ; e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 10.e3
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' orca_r1: Bhosporus : e2u reduced to 10 km'
- ii0 = 44 ; ii1 = 44 ! Lombok Strait (e1v = 13 km)
- ij0 = 124 ; ij1 = 125 ; e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 13.e3
+ ii0 = 44 ; ii1 = 44 ! Lombok Strait (e1v = 13 km)
+ ij0 = 124 + isrow ; ij1 = 165 - isrow ; e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 13.e3
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' orca_r1: Lombok : e1v reduced to 10 km'
- ii0 = 48 ; ii1 = 48 ! Sumba Strait (e1v = 8 km) [closed from bathy_11 on]
- ij0 = 124 ; ij1 = 125 ; e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 8.e3
+ ii0 = 48 ; ii1 = 48 ! Sumba Strait (e1v = 8 km) [closed from bathy_11 on]
+ ij0 = 124 + isrow ; ij1 = 165 - isrow ; e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 8.e3
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' orca_r1: Sumba : e1v reduced to 8 km'
- ii0 = 53 ; ii1 = 53 ! Ombai Strait (e1v = 13 km)
- ij0 = 124 ; ij1 = 125 ; e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 13.e3
+ ii0 = 53 ; ii1 = 53 ! Ombai Strait (e1v = 13 km)
+ ij0 = 124 + isrow ; ij1 = 165 - isrow ; e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 13.e3
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' orca_r1: Ombai : e1v reduced to 13 km'
- ii0 = 56 ; ii1 = 56 ! Timor Passage (e1v = 20 km)
- ij0 = 124 ; ij1 = 125 ; e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 20.e3
+ ii0 = 56 ; ii1 = 56 ! Timor Passage (e1v = 20 km)
+ ij0 = 124 + isrow ; ij1 = 145 - isrow ; e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 20.e3
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' orca_r1: Timor Passage : e1v reduced to 20 km'
- ii0 = 55 ; ii1 = 55 ! West Halmahera Strait (e1v = 30 km)
- ij0 = 141 ; ij1 = 142 ; e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 30.e3
+ ii0 = 55 ; ii1 = 55 ! West Halmahera Strait (e1v = 30 km)
+ ij0 = 141 + isrow ; ij1 = 182 - isrow ; e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 30.e3
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' orca_r1: W Halmahera : e1v reduced to 30 km'
- ii0 = 58 ; ii1 = 58 ! East Halmahera Strait (e1v = 50 km)
- ij0 = 141 ; ij1 = 142 ; e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 50.e3
+ ii0 = 58 ; ii1 = 58 ! East Halmahera Strait (e1v = 50 km)
+ ij0 = 141 + isrow ; ij1 = 182 - isrow ; e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 50.e3
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' orca_r1: E Halmahera : e1v reduced to 50 km'
-
- !
-
- !
- !
!
!
@@ -471,4 +474,12 @@
re2u_e1u(:,:) = e2u(:,:) / e1u(:,:)
re1v_e2v(:,:) = e1v(:,:) / e2v(:,:)
+ r1_e1t (:,:) = 1._wp / e1t(:,:)
+ r1_e1u (:,:) = 1._wp / e1u(:,:)
+ r1_e1v (:,:) = 1._wp / e1v(:,:)
+ r1_e1f (:,:) = 1._wp / e1f(:,:)
+ r1_e2t (:,:) = 1._wp / e2t(:,:)
+ r1_e2u (:,:) = 1._wp / e2u(:,:)
+ r1_e2v (:,:) = 1._wp / e2v(:,:)
+ r1_e2f (:,:) = 1._wp / e2f(:,:)
! Control printing : Grid informations (if not restart)
@@ -616,23 +627,23 @@
CALL iom_open( 'coordinates', inum )
- CALL iom_get( inum, jpdom_data, 'glamt', glamt )
- CALL iom_get( inum, jpdom_data, 'glamu', glamu )
- CALL iom_get( inum, jpdom_data, 'glamv', glamv )
- CALL iom_get( inum, jpdom_data, 'glamf', glamf )
-
- CALL iom_get( inum, jpdom_data, 'gphit', gphit )
- CALL iom_get( inum, jpdom_data, 'gphiu', gphiu )
- CALL iom_get( inum, jpdom_data, 'gphiv', gphiv )
- CALL iom_get( inum, jpdom_data, 'gphif', gphif )
-
- CALL iom_get( inum, jpdom_data, 'e1t', e1t )
- CALL iom_get( inum, jpdom_data, 'e1u', e1u )
- CALL iom_get( inum, jpdom_data, 'e1v', e1v )
- CALL iom_get( inum, jpdom_data, 'e1f', e1f )
-
- CALL iom_get( inum, jpdom_data, 'e2t', e2t )
- CALL iom_get( inum, jpdom_data, 'e2u', e2u )
- CALL iom_get( inum, jpdom_data, 'e2v', e2v )
- CALL iom_get( inum, jpdom_data, 'e2f', e2f )
+ CALL iom_get( inum, jpdom_data, 'glamt', glamt, lrowattr=ln_use_jattr )
+ CALL iom_get( inum, jpdom_data, 'glamu', glamu, lrowattr=ln_use_jattr )
+ CALL iom_get( inum, jpdom_data, 'glamv', glamv, lrowattr=ln_use_jattr )
+ CALL iom_get( inum, jpdom_data, 'glamf', glamf, lrowattr=ln_use_jattr )
+
+ CALL iom_get( inum, jpdom_data, 'gphit', gphit, lrowattr=ln_use_jattr )
+ CALL iom_get( inum, jpdom_data, 'gphiu', gphiu, lrowattr=ln_use_jattr )
+ CALL iom_get( inum, jpdom_data, 'gphiv', gphiv, lrowattr=ln_use_jattr )
+ CALL iom_get( inum, jpdom_data, 'gphif', gphif, lrowattr=ln_use_jattr )
+
+ CALL iom_get( inum, jpdom_data, 'e1t', e1t, lrowattr=ln_use_jattr )
+ CALL iom_get( inum, jpdom_data, 'e1u', e1u, lrowattr=ln_use_jattr )
+ CALL iom_get( inum, jpdom_data, 'e1v', e1v, lrowattr=ln_use_jattr )
+ CALL iom_get( inum, jpdom_data, 'e1f', e1f, lrowattr=ln_use_jattr )
+
+ CALL iom_get( inum, jpdom_data, 'e2t', e2t, lrowattr=ln_use_jattr )
+ CALL iom_get( inum, jpdom_data, 'e2u', e2u, lrowattr=ln_use_jattr )
+ CALL iom_get( inum, jpdom_data, 'e2v', e2v, lrowattr=ln_use_jattr )
+ CALL iom_get( inum, jpdom_data, 'e2f', e2f, lrowattr=ln_use_jattr )
CALL iom_close( inum )
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90 (revision 5602)
@@ -134,4 +134,5 @@
INTEGER :: ijf, ijl, ij0, ij1 ! - -
INTEGER :: ios
+ INTEGER :: isrow ! index for ORCA1 starting row
INTEGER , POINTER, DIMENSION(:,:) :: imsk
REAL(wp), POINTER, DIMENSION(:,:) :: zwf
@@ -281,4 +282,14 @@
CALL lbc_lnk( fmask_i, 'F', 1._wp )
+ ! 3. Ocean/land mask at wu-, wv- and w points
+ !----------------------------------------------
+ wmask (:,:,1) = tmask(:,:,1) ! ????????
+ wumask(:,:,1) = umask(:,:,1) ! ????????
+ wvmask(:,:,1) = vmask(:,:,1) ! ????????
+ DO jk=2,jpk
+ wmask (:,:,jk)=tmask(:,:,jk) * tmask(:,:,jk-1)
+ wumask(:,:,jk)=umask(:,:,jk) * umask(:,:,jk-1)
+ wvmask(:,:,jk)=vmask(:,:,jk) * vmask(:,:,jk-1)
+ END DO
! 4. ocean/land mask for the elliptic equation
@@ -391,37 +402,44 @@
IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN ! ORCA R1 configuration
! ! Increased lateral friction near of some straits
+ ! This dirty section will be suppressed by simplification process:
+ ! all this will come back in input files
+ ! Currently these hard-wired indices relate to configuration with
+ ! extend grid (jpjglo=332)
+ !
+ isrow = 332 - jpjglo
+ !
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' orca_r1: increase friction near the following straits : '
IF(lwp) WRITE(numout,*) ' Gibraltar '
- ii0 = 283 ; ii1 = 284 ! Gibraltar Strait
- ij0 = 200 ; ij1 = 200 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2._wp
+ ii0 = 282 ; ii1 = 283 ! Gibraltar Strait
+ ij0 = 201 + isrow ; ij1 = 241 - isrow ; fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp
IF(lwp) WRITE(numout,*) ' Bhosporus '
- ii0 = 314 ; ii1 = 315 ! Bhosporus Strait
- ij0 = 208 ; ij1 = 208 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2._wp
+ ii0 = 314 ; ii1 = 315 ! Bhosporus Strait
+ ij0 = 208 + isrow ; ij1 = 248 - isrow ; fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp
IF(lwp) WRITE(numout,*) ' Makassar (Top) '
- ii0 = 48 ; ii1 = 48 ! Makassar Strait (Top)
- ij0 = 149 ; ij1 = 150 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 3._wp
+ ii0 = 48 ; ii1 = 48 ! Makassar Strait (Top)
+ ij0 = 149 + isrow ; ij1 = 190 - isrow ; fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp
IF(lwp) WRITE(numout,*) ' Lombok '
- ii0 = 44 ; ii1 = 44 ! Lombok Strait
- ij0 = 124 ; ij1 = 125 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2._wp
+ ii0 = 44 ; ii1 = 44 ! Lombok Strait
+ ij0 = 124 + isrow ; ij1 = 165 - isrow ; fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp
IF(lwp) WRITE(numout,*) ' Ombai '
- ii0 = 53 ; ii1 = 53 ! Ombai Strait
- ij0 = 124 ; ij1 = 125 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2._wp
+ ii0 = 53 ; ii1 = 53 ! Ombai Strait
+ ij0 = 124 + isrow ; ij1 = 165 - isrow ; fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp
IF(lwp) WRITE(numout,*) ' Timor Passage '
- ii0 = 56 ; ii1 = 56 ! Timor Passage
- ij0 = 124 ; ij1 = 125 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2._wp
+ ii0 = 56 ; ii1 = 56 ! Timor Passage
+ ij0 = 124 + isrow ; ij1 = 165 - isrow ; fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp
IF(lwp) WRITE(numout,*) ' West Halmahera '
- ii0 = 58 ; ii1 = 58 ! West Halmahera Strait
- ij0 = 141 ; ij1 = 142 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 3._wp
+ ii0 = 58 ; ii1 = 58 ! West Halmahera Strait
+ ij0 = 141 + isrow ; ij1 = 182 - isrow ; fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp
IF(lwp) WRITE(numout,*) ' East Halmahera '
- ii0 = 55 ; ii1 = 55 ! East Halmahera Strait
- ij0 = 141 ; ij1 = 142 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 3._wp
+ ii0 = 55 ; ii1 = 55 ! East Halmahera Strait
+ ij0 = 141 + isrow ; ij1 = 182 - isrow ; fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp
!
ENDIF
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90 (revision 5602)
@@ -8,4 +8,5 @@
!! 3.3 ! 2011-10 (M. Leclair) totally rewrote domvvl:
!! vvl option includes z_star and z_tilde coordinates
+ !! 3.6 ! 2014-11 (P. Mathiot) add ice shelf capability
!!----------------------------------------------------------------------
!! 'key_vvl' variable volume
@@ -125,4 +126,5 @@
INTEGER :: ji,jj,jk
INTEGER :: ii0, ii1, ij0, ij1
+ REAL(wp):: zcoef
!!----------------------------------------------------------------------
IF( nn_timing == 1 ) CALL timing_start('dom_vvl_init')
@@ -164,4 +166,5 @@
! t- and w- points depth
! ----------------------
+ ! set the isf depth as it is in the initial step
fsdept_n(:,:,1) = 0.5_wp * fse3w_n(:,:,1)
fsdepw_n(:,:,1) = 0.0_wp
@@ -169,27 +172,19 @@
fsdept_b(:,:,1) = 0.5_wp * fse3w_b(:,:,1)
fsdepw_b(:,:,1) = 0.0_wp
- DO jj = 1,jpj
- DO ji = 1,jpi
- DO jk = 2,mikt(ji,jj)-1
- fsdept_n(ji,jj,jk) = gdept_0(ji,jj,jk)
- fsdepw_n(ji,jj,jk) = gdepw_0(ji,jj,jk)
- fsde3w_n(ji,jj,jk) = gdept_0(ji,jj,jk) - sshn(ji,jj)
- fsdept_b(ji,jj,jk) = gdept_0(ji,jj,jk)
- fsdepw_b(ji,jj,jk) = gdepw_0(ji,jj,jk)
- END DO
- IF (mikt(ji,jj) .GT. 1) THEN
- jk = mikt(ji,jj)
- fsdept_n(ji,jj,jk) = gdepw_0(ji,jj,jk) + 0.5_wp * fse3w_n(ji,jj,jk)
- fsdepw_n(ji,jj,jk) = gdepw_0(ji,jj,jk)
- fsde3w_n(ji,jj,jk) = fsdept_n(ji,jj,jk ) - sshn (ji,jj)
- fsdept_b(ji,jj,jk) = gdepw_0(ji,jj,jk) + 0.5_wp * fse3w_b(ji,jj,jk)
- fsdepw_b(ji,jj,jk) = gdepw_0(ji,jj,jk)
- END IF
- DO jk = mikt(ji,jj)+1, jpk
- fsdept_n(ji,jj,jk) = fsdept_n(ji,jj,jk-1) + fse3w_n(ji,jj,jk)
+
+ DO jk = 2, jpk
+ DO jj = 1,jpj
+ DO ji = 1,jpi
+ ! zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt
+ ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf)
+ ! 0.5 where jk = mikt
+ zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))
fsdepw_n(ji,jj,jk) = fsdepw_n(ji,jj,jk-1) + fse3t_n(ji,jj,jk-1)
- fsde3w_n(ji,jj,jk) = fsdept_n(ji,jj,jk ) - sshn (ji,jj)
- fsdept_b(ji,jj,jk) = fsdept_b(ji,jj,jk-1) + fse3w_b(ji,jj,jk)
+ fsdept_n(ji,jj,jk) = zcoef * ( fsdepw_n(ji,jj,jk ) + 0.5 * fse3w_n(ji,jj,jk)) &
+ & + (1-zcoef) * ( fsdept_n(ji,jj,jk-1) + fse3w_n(ji,jj,jk))
+ fsde3w_n(ji,jj,jk) = fsdept_n(ji,jj,jk) - sshn(ji,jj)
fsdepw_b(ji,jj,jk) = fsdepw_b(ji,jj,jk-1) + fse3t_b(ji,jj,jk-1)
+ fsdept_b(ji,jj,jk) = zcoef * ( fsdepw_b(ji,jj,jk ) + 0.5 * fse3w_b(ji,jj,jk)) &
+ & + (1-zcoef) * ( fsdept_b(ji,jj,jk-1) + fse3w_b(ji,jj,jk))
END DO
END DO
@@ -588,11 +583,9 @@
INTEGER, INTENT( in ) :: kt ! time step
!! * Local declarations
- REAL(wp), POINTER, DIMENSION(:,:,:) :: z_e3t_def
INTEGER :: ji,jj,jk ! dummy loop indices
+ REAL(wp) :: zcoef
!!----------------------------------------------------------------------
IF( nn_timing == 1 ) CALL timing_start('dom_vvl_sf_swp')
- !
- CALL wrk_alloc( jpi, jpj, jpk, z_e3t_def )
!
IF( kt == nit000 ) THEN
@@ -638,27 +631,23 @@
! t- and w- points depth
! ----------------------
+ ! set the isf depth as it is in the initial step
fsdept_n(:,:,1) = 0.5_wp * fse3w_n(:,:,1)
fsdepw_n(:,:,1) = 0.0_wp
fsde3w_n(:,:,1) = fsdept_n(:,:,1) - sshn(:,:)
- DO jj = 1,jpj
- DO ji = 1,jpi
- DO jk = 2,mikt(ji,jj)-1
- fsdept_n(ji,jj,jk) = gdept_0(ji,jj,jk)
- fsdepw_n(ji,jj,jk) = gdepw_0(ji,jj,jk)
- fsde3w_n(ji,jj,jk) = gdept_0(ji,jj,jk) - sshn(ji,jj)
- END DO
- IF (mikt(ji,jj) .GT. 1) THEN
- jk = mikt(ji,jj)
- fsdept_n(ji,jj,jk) = gdepw_0(ji,jj,jk) + 0.5_wp * fse3w_n(ji,jj,jk)
- fsdepw_n(ji,jj,jk) = gdepw_0(ji,jj,jk)
- fsde3w_n(ji,jj,jk) = fsdept_n(ji,jj,jk ) - sshn (ji,jj)
- END IF
- DO jk = mikt(ji,jj)+1, jpk
- fsdept_n(ji,jj,jk) = fsdept_n(ji,jj,jk-1) + fse3w_n(ji,jj,jk)
+
+ DO jk = 2, jpk
+ DO jj = 1,jpj
+ DO ji = 1,jpi
+ ! zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt
+ ! 1 for jk = mikt
+ zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))
fsdepw_n(ji,jj,jk) = fsdepw_n(ji,jj,jk-1) + fse3t_n(ji,jj,jk-1)
- fsde3w_n(ji,jj,jk) = fsdept_n(ji,jj,jk ) - sshn (ji,jj)
+ fsdept_n(ji,jj,jk) = zcoef * ( fsdepw_n(ji,jj,jk ) + 0.5 * fse3w_n(ji,jj,jk)) &
+ & + (1-zcoef) * ( fsdept_n(ji,jj,jk-1) + fse3w_n(ji,jj,jk))
+ fsde3w_n(ji,jj,jk) = fsdept_n(ji,jj,jk) - sshn(ji,jj)
END DO
END DO
END DO
+
! Local depth and Inverse of the local depth of the water column at u- and v- points
! ----------------------------------------------------------------------------------
@@ -679,14 +668,15 @@
! Write outputs
! =============
- z_e3t_def(:,:,:) = ( ( fse3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2
- CALL iom_put( "cellthc" , fse3t_n (:,:,:) )
+ CALL iom_put( "e3t" , fse3t_n (:,:,:) )
+ CALL iom_put( "e3u" , fse3u_n (:,:,:) )
+ CALL iom_put( "e3v" , fse3v_n (:,:,:) )
+ CALL iom_put( "e3w" , fse3w_n (:,:,:) )
CALL iom_put( "tpt_dep" , fsde3w_n (:,:,:) )
- CALL iom_put( "e3tdef" , z_e3t_def(:,:,:) )
+ IF( iom_use("e3tdef") ) &
+ CALL iom_put( "e3tdef" , ( ( fse3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 )
! write restart file
! ==================
IF( lrst_oce ) CALL dom_vvl_rst( kt, 'WRITE' )
- !
- CALL wrk_dealloc( jpi, jpj, jpk, z_e3t_def )
!
IF( nn_timing == 1 ) CALL timing_stop('dom_vvl_sf_swp')
@@ -1049,4 +1039,5 @@
INTEGER :: ji, jj, jk ! dummy loop indices
INTEGER :: ij0, ij1, ii0, ii1 ! dummy loop indices
+ INTEGER :: isrow ! index for ORCA1 starting row
!! acc
!! Hmm with the time splitting these "fixes" seem to do more harm than good. Temporarily disabled for
@@ -1132,7 +1123,13 @@
IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN ! ORCA R1 configuration
! ! =====================
- !
- ii0 = 281 ; ii1 = 282 ! Gibraltar Strait (e2u was modified)
- ij0 = 200 ; ij1 = 200
+ ! This dirty section will be suppressed by simplification process:
+ ! all this will come back in input files
+ ! Currently these hard-wired indices relate to configuration with
+ ! extend grid (jpjglo=332)
+ ! which had a grid-size of 362x292.
+ isrow = 332 - jpjglo
+ !
+ ii0 = 282 ; ii1 = 283 ! Gibraltar Strait (e2u was modified)
+ ij0 = 241 - isrow ; ij1 = 241 - isrow
DO jk = 1, jpkm1
DO jj = mj0(ij0), mj1(ij1)
@@ -1154,6 +1151,6 @@
END DO
!
- ii0 = 314 ; ii1 = 315 ! Bhosporus Strait (e2u was modified)
- ij0 = 208 ; ij1 = 208
+ ii0 = 314 ; ii1 = 315 ! Bhosporus Strait (e2u was modified)
+ ij0 = 248 - isrow ; ij1 = 248 - isrow
DO jk = 1, jpkm1
DO jj = mj0(ij0), mj1(ij1)
@@ -1175,6 +1172,6 @@
END DO
!
- ii0 = 44 ; ii1 = 44 ! Lombok Strait (e1v was modified)
- ij0 = 124 ; ij1 = 125
+ ii0 = 44 ; ii1 = 44 ! Lombok Strait (e1v was modified)
+ ij0 = 164 - isrow ; ij1 = 165 - isrow
DO jk = 1, jpkm1
DO jj = mj0(ij0), mj1(ij1)
@@ -1191,6 +1188,6 @@
END DO
!
- ii0 = 48 ; ii1 = 48 ! Sumba Strait (e1v was modified) [closed from bathy_11 on]
- ij0 = 124 ; ij1 = 125
+ ii0 = 48 ; ii1 = 48 ! Sumba Strait (e1v was modified) [closed from bathy_11 on]
+ ij0 = 164 - isrow ; ij1 = 165 - isrow
DO jk = 1, jpkm1
DO jj = mj0(ij0), mj1(ij1)
@@ -1207,6 +1204,6 @@
END DO
!
- ii0 = 53 ; ii1 = 53 ! Ombai Strait (e1v was modified)
- ij0 = 124 ; ij1 = 125
+ ii0 = 53 ; ii1 = 53 ! Ombai Strait (e1v was modified)
+ ij0 = 164 - isrow ; ij1 = 165 - isrow
DO jk = 1, jpkm1
DO jj = mj0(ij0), mj1(ij1)
@@ -1223,6 +1220,6 @@
END DO
!
- ii0 = 56 ; ii1 = 56 ! Timor Passage (e1v was modified)
- ij0 = 124 ; ij1 = 125
+ ii0 = 56 ; ii1 = 56 ! Timor Passage (e1v was modified)
+ ij0 = 164 - isrow ; ij1 = 165 - isrow
DO jk = 1, jpkm1
DO jj = mj0(ij0), mj1(ij1)
@@ -1239,6 +1236,6 @@
END DO
!
- ii0 = 55 ; ii1 = 55 ! West Halmahera Strait (e1v was modified)
- ij0 = 141 ; ij1 = 142
+ ii0 = 55 ; ii1 = 55 ! West Halmahera Strait (e1v was modified)
+ ij0 = 181 - isrow ; ij1 = 182 - isrow
DO jk = 1, jpkm1
DO jj = mj0(ij0), mj1(ij1)
@@ -1255,6 +1252,6 @@
END DO
!
- ii0 = 58 ; ii1 = 58 ! East Halmahera Strait (e1v was modified)
- ij0 = 141 ; ij1 = 142
+ ii0 = 58 ; ii1 = 58 ! East Halmahera Strait (e1v was modified)
+ ij0 = 181 - isrow ; ij1 = 182 - isrow
DO jk = 1, jpkm1
DO jj = mj0(ij0), mj1(ij1)
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90 (revision 5602)
@@ -17,4 +17,5 @@
!! 3.4 ! 2012-08 (J. Siddorn) added Siddorn and Furner stretching function
!! 3.4 ! 2012-12 (R. Bourdalle-Badie and G. Reffray) modify C1D case
+ !! 3.6 ! 2014-11 (P. Mathiot and C. Harris) add ice shelf capabilitye
!!----------------------------------------------------------------------
@@ -35,5 +36,4 @@
USE oce ! ocean variables
USE dom_oce ! ocean domain
- USE sbc_oce ! surface variable (isf)
USE closea ! closed seas
USE c1d ! 1D vertical configuration
@@ -298,15 +298,17 @@
ENDIF
+ IF ( ln_isfcav ) THEN
! need to be like this to compute the pressure gradient with ISF. If not, level beneath the ISF are not aligned (sum(e3t) /= depth)
! define e3t_0 and e3w_0 as the differences between gdept and gdepw respectively
- DO jk = 1, jpkm1
- e3t_1d(jk) = gdepw_1d(jk+1)-gdepw_1d(jk)
- END DO
- e3t_1d(jpk) = e3t_1d(jpk-1) ! we don't care because this level is masked in NEMO
-
- DO jk = 2, jpk
- e3w_1d(jk) = gdept_1d(jk) - gdept_1d(jk-1)
- END DO
- e3w_1d(1 ) = 2._wp * (gdept_1d(1) - gdepw_1d(1))
+ DO jk = 1, jpkm1
+ e3t_1d(jk) = gdepw_1d(jk+1)-gdepw_1d(jk)
+ END DO
+ e3t_1d(jpk) = e3t_1d(jpk-1) ! we don't care because this level is masked in NEMO
+
+ DO jk = 2, jpk
+ e3w_1d(jk) = gdept_1d(jk) - gdept_1d(jk-1)
+ END DO
+ e3w_1d(1 ) = 2._wp * (gdept_1d(1) - gdepw_1d(1))
+ END IF
!!gm BUG in s-coordinate this does not work!
@@ -365,16 +367,14 @@
INTEGER :: ji, jj, jl, jk ! dummy loop indices
INTEGER :: inum ! temporary logical unit
+ INTEGER :: ierror ! error flag
INTEGER :: ii_bump, ij_bump, ih ! bump center position
INTEGER :: ii0, ii1, ij0, ij1, ik ! local indices
REAL(wp) :: r_bump , h_bump , h_oce ! bump characteristics
REAL(wp) :: zi, zj, zh, zhmin ! local scalars
- INTEGER , POINTER, DIMENSION(:,:) :: idta ! global domain integer data
- REAL(wp), POINTER, DIMENSION(:,:) :: zdta ! global domain scalar data
+ INTEGER , ALLOCATABLE, DIMENSION(:,:) :: idta ! global domain integer data
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdta ! global domain scalar data
!!----------------------------------------------------------------------
!
IF( nn_timing == 1 ) CALL timing_start('zgr_bat')
- !
- CALL wrk_alloc( jpidta, jpjdta, idta )
- CALL wrk_alloc( jpidta, jpjdta, zdta )
!
IF(lwp) WRITE(numout,*)
@@ -385,4 +385,9 @@
! ! ================== !
! ! global domain level and meter bathymetry (idta,zdta)
+ !
+ ALLOCATE( idta(jpidta,jpjdta), STAT=ierror )
+ IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'zgr_bat: unable to allocate idta array' )
+ ALLOCATE( zdta(jpidta,jpjdta), STAT=ierror )
+ IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'zgr_bat: unable to allocate zdta array' )
!
IF( ntopo == 0 ) THEN ! flat basin
@@ -465,26 +470,8 @@
END DO
END DO
+ risfdep(:,:)=0.e0
+ misfdep(:,:)=1
!
- ! (ISF) TODO build ice draft netcdf file for isomip and build the corresponding part of code
- IF( cp_cfg == "isomip" ) THEN
- !
- risfdep(:,:)=200.e0
- misfdep(:,:)=1
- ij0 = 1 ; ij1 = 40
- DO jj = mj0(ij0), mj1(ij1)
- risfdep(:,jj)=700.0_wp-(gphit(:,jj)+80.0_wp)*125.0_wp
- END DO
- WHERE( bathy(:,:) <= 0._wp ) risfdep(:,:) = 0._wp
- !
- ELSEIF ( cp_cfg == "isomip2" ) THEN
- !
- risfdep(:,:)=0.e0
- misfdep(:,:)=1
- ij0 = 1 ; ij1 = 40
- DO jj = mj0(ij0), mj1(ij1)
- risfdep(:,jj)=700.0_wp-(gphit(:,jj)+80.0_wp)*125.0_wp
- END DO
- WHERE( bathy(:,:) <= 0._wp ) risfdep(:,:) = 0._wp
- END IF
+ DEALLOCATE( idta, zdta )
!
! ! ================ !
@@ -527,7 +514,11 @@
IF( ln_zps .OR. ln_sco .OR. ln_zco ) THEN ! zps or sco : read meter bathymetry
CALL iom_open ( 'bathy_meter.nc', inum )
- CALL iom_get ( inum, jpdom_data, 'Bathymetry', bathy )
+ IF ( ln_isfcav ) THEN
+ CALL iom_get ( inum, jpdom_data, 'Bathymetry_isf', bathy, lrowattr=.false. )
+ ELSE
+ CALL iom_get ( inum, jpdom_data, 'Bathymetry' , bathy, lrowattr=ln_use_jattr )
+ END IF
CALL iom_close( inum )
- !
+ !
risfdep(:,:)=0._wp
misfdep(:,:)=1
@@ -577,7 +568,9 @@
IF ( .not. ln_sco ) THEN !== set a minimum depth ==!
! patch to avoid case bathy = ice shelf draft and bathy between 0 and zhmin
- WHERE (bathy == risfdep)
- bathy = 0.0_wp ; risfdep = 0.0_wp
- END WHERE
+ IF ( ln_isfcav ) THEN
+ WHERE (bathy == risfdep)
+ bathy = 0.0_wp ; risfdep = 0.0_wp
+ END WHERE
+ END IF
! end patch
IF( rn_hmin < 0._wp ) THEN ; ik = - INT( rn_hmin ) ! from a nb of level
@@ -590,7 +583,4 @@
IF(lwp) write(numout,*) 'Minimum ocean depth: ', zhmin, ' minimum number of ocean levels : ', ik
ENDIF
- !
- CALL wrk_dealloc( jpidta, jpjdta, idta )
- CALL wrk_dealloc( jpidta, jpjdta, zdta )
!
IF( nn_timing == 1 ) CALL timing_stop('zgr_bat')
@@ -957,4 +947,312 @@
!!----------------------------------------------------------------------
!!
+ INTEGER :: ji, jj, jk ! dummy loop indices
+ INTEGER :: ik, it, ikb, ikt ! temporary integers
+ LOGICAL :: ll_print ! Allow control print for debugging
+ REAL(wp) :: ze3tp , ze3wp ! Last ocean level thickness at T- and W-points
+ REAL(wp) :: zdepwp, zdepth ! Ajusted ocean depth to avoid too small e3t
+ REAL(wp) :: zmax ! Maximum depth
+ REAL(wp) :: zdiff ! temporary scalar
+ REAL(wp) :: zrefdep ! temporary scalar
+ REAL(wp), POINTER, DIMENSION(:,:,:) :: zprt
+ !!---------------------------------------------------------------------
+ !
+ IF( nn_timing == 1 ) CALL timing_start('zgr_zps')
+ !
+ CALL wrk_alloc( jpi, jpj, jpk, zprt )
+ !
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) ' zgr_zps : z-coordinate with partial steps'
+ IF(lwp) WRITE(numout,*) ' ~~~~~~~ '
+ IF(lwp) WRITE(numout,*) ' mbathy is recomputed : bathy_level file is NOT used'
+
+ ll_print = .FALSE. ! Local variable for debugging
+
+ IF(lwp .AND. ll_print) THEN ! control print of the ocean depth
+ WRITE(numout,*)
+ WRITE(numout,*) 'dom_zgr_zps: bathy (in hundred of meters)'
+ CALL prihre( bathy, jpi, jpj, 1,jpi, 1, 1, jpj, 1, 1.e-2, numout )
+ ENDIF
+
+
+ ! bathymetry in level (from bathy_meter)
+ ! ===================
+ zmax = gdepw_1d(jpk) + e3t_1d(jpk) ! maximum depth (i.e. the last ocean level thickness <= 2*e3t_1d(jpkm1) )
+ bathy(:,:) = MIN( zmax , bathy(:,:) ) ! bounded value of bathy (min already set at the end of zgr_bat)
+ WHERE( bathy(:,:) == 0._wp ) ; mbathy(:,:) = 0 ! land : set mbathy to 0
+ ELSE WHERE ; mbathy(:,:) = jpkm1 ! ocean : initialize mbathy to the max ocean level
+ END WHERE
+
+ ! Compute mbathy for ocean points (i.e. the number of ocean levels)
+ ! find the number of ocean levels such that the last level thickness
+ ! is larger than the minimum of e3zps_min and e3zps_rat * e3t_1d (where
+ ! e3t_1d is the reference level thickness
+ DO jk = jpkm1, 1, -1
+ zdepth = gdepw_1d(jk) + MIN( e3zps_min, e3t_1d(jk)*e3zps_rat )
+ WHERE( 0._wp < bathy(:,:) .AND. bathy(:,:) <= zdepth ) mbathy(:,:) = jk-1
+ END DO
+
+ IF ( ln_isfcav ) CALL zgr_isf
+
+ ! Scale factors and depth at T- and W-points
+ DO jk = 1, jpk ! intitialization to the reference z-coordinate
+ gdept_0(:,:,jk) = gdept_1d(jk)
+ gdepw_0(:,:,jk) = gdepw_1d(jk)
+ e3t_0 (:,:,jk) = e3t_1d (jk)
+ e3w_0 (:,:,jk) = e3w_1d (jk)
+ END DO
+ !
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ ik = mbathy(ji,jj)
+ IF( ik > 0 ) THEN ! ocean point only
+ ! max ocean level case
+ IF( ik == jpkm1 ) THEN
+ zdepwp = bathy(ji,jj)
+ ze3tp = bathy(ji,jj) - gdepw_1d(ik)
+ ze3wp = 0.5_wp * e3w_1d(ik) * ( 1._wp + ( ze3tp/e3t_1d(ik) ) )
+ e3t_0(ji,jj,ik ) = ze3tp
+ e3t_0(ji,jj,ik+1) = ze3tp
+ e3w_0(ji,jj,ik ) = ze3wp
+ e3w_0(ji,jj,ik+1) = ze3tp
+ gdepw_0(ji,jj,ik+1) = zdepwp
+ gdept_0(ji,jj,ik ) = gdept_1d(ik-1) + ze3wp
+ gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + ze3tp
+ !
+ ELSE ! standard case
+ IF( bathy(ji,jj) <= gdepw_1d(ik+1) ) THEN ; gdepw_0(ji,jj,ik+1) = bathy(ji,jj)
+ ELSE ; gdepw_0(ji,jj,ik+1) = gdepw_1d(ik+1)
+ ENDIF
+!gm Bug? check the gdepw_1d
+ ! ... on ik
+ gdept_0(ji,jj,ik) = gdepw_1d(ik) + ( gdepw_0(ji,jj,ik+1) - gdepw_1d(ik) ) &
+ & * ((gdept_1d( ik ) - gdepw_1d(ik) ) &
+ & / ( gdepw_1d( ik+1) - gdepw_1d(ik) ))
+ e3t_0 (ji,jj,ik) = e3t_1d (ik) * ( gdepw_0 (ji,jj,ik+1) - gdepw_1d(ik) ) &
+ & / ( gdepw_1d( ik+1) - gdepw_1d(ik) )
+ e3w_0(ji,jj,ik) = 0.5_wp * ( gdepw_0(ji,jj,ik+1) + gdepw_1d(ik+1) - 2._wp * gdepw_1d(ik) ) &
+ & * ( e3w_1d(ik) / ( gdepw_1d(ik+1) - gdepw_1d(ik) ) )
+ ! ... on ik+1
+ e3w_0 (ji,jj,ik+1) = e3t_0 (ji,jj,ik)
+ e3t_0 (ji,jj,ik+1) = e3t_0 (ji,jj,ik)
+ gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + e3t_0(ji,jj,ik)
+ ENDIF
+ ENDIF
+ END DO
+ END DO
+ !
+ it = 0
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ ik = mbathy(ji,jj)
+ IF( ik > 0 ) THEN ! ocean point only
+ e3tp (ji,jj) = e3t_0(ji,jj,ik)
+ e3wp (ji,jj) = e3w_0(ji,jj,ik)
+ ! test
+ zdiff= gdepw_0(ji,jj,ik+1) - gdept_0(ji,jj,ik )
+ IF( zdiff <= 0._wp .AND. lwp ) THEN
+ it = it + 1
+ WRITE(numout,*) ' it = ', it, ' ik = ', ik, ' (i,j) = ', ji, jj
+ WRITE(numout,*) ' bathy = ', bathy(ji,jj)
+ WRITE(numout,*) ' gdept_0 = ', gdept_0(ji,jj,ik), ' gdepw_0 = ', gdepw_0(ji,jj,ik+1), ' zdiff = ', zdiff
+ WRITE(numout,*) ' e3tp = ', e3t_0 (ji,jj,ik), ' e3wp = ', e3w_0 (ji,jj,ik )
+ ENDIF
+ ENDIF
+ END DO
+ END DO
+ !
+ IF ( ln_isfcav ) THEN
+ ! (ISF) Definition of e3t, u, v, w for ISF case
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ ik = misfdep(ji,jj)
+ IF( ik > 1 ) THEN ! ice shelf point only
+ IF( risfdep(ji,jj) < gdepw_1d(ik) ) risfdep(ji,jj)= gdepw_1d(ik)
+ gdepw_0(ji,jj,ik) = risfdep(ji,jj)
+!gm Bug? check the gdepw_0
+ ! ... on ik
+ gdept_0(ji,jj,ik) = gdepw_1d(ik+1) - ( gdepw_1d(ik+1) - gdepw_0(ji,jj,ik) ) &
+ & * ( gdepw_1d(ik+1) - gdept_1d(ik) ) &
+ & / ( gdepw_1d(ik+1) - gdepw_1d(ik) )
+ e3t_0 (ji,jj,ik ) = gdepw_1d(ik+1) - gdepw_0(ji,jj,ik)
+ e3w_0 (ji,jj,ik+1) = gdept_1d(ik+1) - gdept_0(ji,jj,ik)
+
+ IF( ik + 1 == mbathy(ji,jj) ) THEN ! ice shelf point only (2 cell water column)
+ e3w_0 (ji,jj,ik+1) = gdept_0(ji,jj,ik+1) - gdept_0(ji,jj,ik)
+ ENDIF
+ ! ... on ik / ik-1
+ e3w_0 (ji,jj,ik ) = 2._wp * (gdept_0(ji,jj,ik) - gdepw_0(ji,jj,ik))
+ e3t_0 (ji,jj,ik-1) = gdepw_0(ji,jj,ik) - gdepw_1d(ik-1)
+! The next line isn't required and doesn't affect results - included for consistency with bathymetry code
+ gdept_0(ji,jj,ik-1) = gdept_1d(ik-1)
+ ENDIF
+ END DO
+ END DO
+ !
+ it = 0
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ ik = misfdep(ji,jj)
+ IF( ik > 1 ) THEN ! ice shelf point only
+ e3tp (ji,jj) = e3t_0(ji,jj,ik )
+ e3wp (ji,jj) = e3w_0(ji,jj,ik+1 )
+ ! test
+ zdiff= gdept_0(ji,jj,ik) - gdepw_0(ji,jj,ik )
+ IF( zdiff <= 0. .AND. lwp ) THEN
+ it = it + 1
+ WRITE(numout,*) ' it = ', it, ' ik = ', ik, ' (i,j) = ', ji, jj
+ WRITE(numout,*) ' risfdep = ', risfdep(ji,jj)
+ WRITE(numout,*) ' gdept = ', gdept_0(ji,jj,ik), ' gdepw = ', gdepw_0(ji,jj,ik+1), ' zdiff = ', zdiff
+ WRITE(numout,*) ' e3tp = ', e3tp(ji,jj), ' e3wp = ', e3wp(ji,jj)
+ ENDIF
+ ENDIF
+ END DO
+ END DO
+ END IF
+ ! END (ISF)
+
+ ! Scale factors and depth at U-, V-, UW and VW-points
+ DO jk = 1, jpk ! initialisation to z-scale factors
+ e3u_0 (:,:,jk) = e3t_1d(jk)
+ e3v_0 (:,:,jk) = e3t_1d(jk)
+ e3uw_0(:,:,jk) = e3w_1d(jk)
+ e3vw_0(:,:,jk) = e3w_1d(jk)
+ END DO
+ DO jk = 1,jpk ! Computed as the minimum of neighbooring scale factors
+ DO jj = 1, jpjm1
+ DO ji = 1, fs_jpim1 ! vector opt.
+ e3u_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji+1,jj,jk) )
+ e3v_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji,jj+1,jk) )
+ e3uw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji+1,jj,jk) )
+ e3vw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji,jj+1,jk) )
+ END DO
+ END DO
+ END DO
+ IF ( ln_isfcav ) THEN
+ ! (ISF) define e3uw (adapted for 2 cells in the water column)
+ DO jj = 2, jpjm1
+ DO ji = 2, fs_jpim1 ! vector opt.
+ ikb = MAX(mbathy (ji,jj),mbathy (ji+1,jj))
+ ikt = MAX(misfdep(ji,jj),misfdep(ji+1,jj))
+ IF (ikb == ikt+1) e3uw_0(ji,jj,ikb) = MIN( gdept_0(ji,jj,ikb ), gdept_0(ji+1,jj ,ikb ) ) &
+ & - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji+1,jj ,ikb-1) )
+ ikb = MAX(mbathy (ji,jj),mbathy (ji,jj+1))
+ ikt = MAX(misfdep(ji,jj),misfdep(ji,jj+1))
+ IF (ikb == ikt+1) e3vw_0(ji,jj,ikb) = MIN( gdept_0(ji,jj,ikb ), gdept_0(ji ,jj+1,ikb ) ) &
+ & - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji ,jj+1,ikb-1) )
+ END DO
+ END DO
+ END IF
+
+ CALL lbc_lnk( e3u_0 , 'U', 1._wp ) ; CALL lbc_lnk( e3uw_0, 'U', 1._wp ) ! lateral boundary conditions
+ CALL lbc_lnk( e3v_0 , 'V', 1._wp ) ; CALL lbc_lnk( e3vw_0, 'V', 1._wp )
+ !
+ DO jk = 1, jpk ! set to z-scale factor if zero (i.e. along closed boundaries)
+ WHERE( e3u_0 (:,:,jk) == 0._wp ) e3u_0 (:,:,jk) = e3t_1d(jk)
+ WHERE( e3v_0 (:,:,jk) == 0._wp ) e3v_0 (:,:,jk) = e3t_1d(jk)
+ WHERE( e3uw_0(:,:,jk) == 0._wp ) e3uw_0(:,:,jk) = e3w_1d(jk)
+ WHERE( e3vw_0(:,:,jk) == 0._wp ) e3vw_0(:,:,jk) = e3w_1d(jk)
+ END DO
+
+ ! Scale factor at F-point
+ DO jk = 1, jpk ! initialisation to z-scale factors
+ e3f_0(:,:,jk) = e3t_1d(jk)
+ END DO
+ DO jk = 1, jpk ! Computed as the minimum of neighbooring V-scale factors
+ DO jj = 1, jpjm1
+ DO ji = 1, fs_jpim1 ! vector opt.
+ e3f_0(ji,jj,jk) = MIN( e3v_0(ji,jj,jk), e3v_0(ji+1,jj,jk) )
+ END DO
+ END DO
+ END DO
+ CALL lbc_lnk( e3f_0, 'F', 1._wp ) ! Lateral boundary conditions
+ !
+ DO jk = 1, jpk ! set to z-scale factor if zero (i.e. along closed boundaries)
+ WHERE( e3f_0(:,:,jk) == 0._wp ) e3f_0(:,:,jk) = e3t_1d(jk)
+ END DO
+!!gm bug ? : must be a do loop with mj0,mj1
+ !
+ e3t_0(:,mj0(1),:) = e3t_0(:,mj0(2),:) ! we duplicate factor scales for jj = 1 and jj = 2
+ e3w_0(:,mj0(1),:) = e3w_0(:,mj0(2),:)
+ e3u_0(:,mj0(1),:) = e3u_0(:,mj0(2),:)
+ e3v_0(:,mj0(1),:) = e3v_0(:,mj0(2),:)
+ e3f_0(:,mj0(1),:) = e3f_0(:,mj0(2),:)
+
+ ! Control of the sign
+ IF( MINVAL( e3t_0 (:,:,:) ) <= 0._wp ) CALL ctl_stop( ' zgr_zps : e r r o r e3t_0 <= 0' )
+ IF( MINVAL( e3w_0 (:,:,:) ) <= 0._wp ) CALL ctl_stop( ' zgr_zps : e r r o r e3w_0 <= 0' )
+ IF( MINVAL( gdept_0(:,:,:) ) < 0._wp ) CALL ctl_stop( ' zgr_zps : e r r o r gdept_0 < 0' )
+ IF( MINVAL( gdepw_0(:,:,:) ) < 0._wp ) CALL ctl_stop( ' zgr_zps : e r r o r gdepw_0 < 0' )
+
+ ! Compute gdep3w_0 (vertical sum of e3w)
+ IF ( ln_isfcav ) THEN ! if cavity
+ WHERE (misfdep == 0) misfdep = 1
+ DO jj = 1,jpj
+ DO ji = 1,jpi
+ gdep3w_0(ji,jj,1) = 0.5_wp * e3w_0(ji,jj,1)
+ DO jk = 2, misfdep(ji,jj)
+ gdep3w_0(ji,jj,jk) = gdep3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk)
+ END DO
+ IF (misfdep(ji,jj) .GE. 2) gdep3w_0(ji,jj,misfdep(ji,jj)) = risfdep(ji,jj) + 0.5_wp * e3w_0(ji,jj,misfdep(ji,jj))
+ DO jk = misfdep(ji,jj) + 1, jpk
+ gdep3w_0(ji,jj,jk) = gdep3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk)
+ END DO
+ END DO
+ END DO
+ ELSE ! no cavity
+ gdep3w_0(:,:,1) = 0.5_wp * e3w_0(:,:,1)
+ DO jk = 2, jpk
+ gdep3w_0(:,:,jk) = gdep3w_0(:,:,jk-1) + e3w_0(:,:,jk)
+ END DO
+ END IF
+ ! ! ================= !
+ IF(lwp .AND. ll_print) THEN ! Control print !
+ ! ! ================= !
+ DO jj = 1,jpj
+ DO ji = 1, jpi
+ ik = MAX( mbathy(ji,jj), 1 )
+ zprt(ji,jj,1) = e3t_0 (ji,jj,ik)
+ zprt(ji,jj,2) = e3w_0 (ji,jj,ik)
+ zprt(ji,jj,3) = e3u_0 (ji,jj,ik)
+ zprt(ji,jj,4) = e3v_0 (ji,jj,ik)
+ zprt(ji,jj,5) = e3f_0 (ji,jj,ik)
+ zprt(ji,jj,6) = gdep3w_0(ji,jj,ik)
+ END DO
+ END DO
+ WRITE(numout,*)
+ WRITE(numout,*) 'domzgr e3t(mbathy)' ; CALL prihre(zprt(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+ WRITE(numout,*)
+ WRITE(numout,*) 'domzgr e3w(mbathy)' ; CALL prihre(zprt(:,:,2),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+ WRITE(numout,*)
+ WRITE(numout,*) 'domzgr e3u(mbathy)' ; CALL prihre(zprt(:,:,3),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+ WRITE(numout,*)
+ WRITE(numout,*) 'domzgr e3v(mbathy)' ; CALL prihre(zprt(:,:,4),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+ WRITE(numout,*)
+ WRITE(numout,*) 'domzgr e3f(mbathy)' ; CALL prihre(zprt(:,:,5),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+ WRITE(numout,*)
+ WRITE(numout,*) 'domzgr gdep3w(mbathy)' ; CALL prihre(zprt(:,:,6),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+ ENDIF
+ !
+ CALL wrk_dealloc( jpi, jpj, jpk, zprt )
+ !
+ IF( nn_timing == 1 ) CALL timing_stop('zgr_zps')
+ !
+ END SUBROUTINE zgr_zps
+
+ SUBROUTINE zgr_isf
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE zgr_isf ***
+ !!
+ !! ** Purpose : check the bathymetry in levels
+ !!
+ !! ** Method : THe water column have to contained at least 2 cells
+ !! Bathymetry and isfdraft are modified (dig/close) to respect
+ !! this criterion.
+ !!
+ !!
+ !! ** Action : - test compatibility between isfdraft and bathy
+ !! - bathy and isfdraft are modified
+ !!----------------------------------------------------------------------
+ !!
INTEGER :: ji, jj, jk, jl ! dummy loop indices
INTEGER :: ik, it ! temporary integers
@@ -967,45 +1265,15 @@
REAL(wp) :: zdiff ! temporary scalar
REAL(wp) :: zrefdep ! temporary scalar
- REAL(wp) :: zbathydiff, zrisfdepdiff
- REAL(wp), POINTER, DIMENSION(:,:) :: zrisfdep, zbathy, zmask ! 3D workspace (ISH)
- INTEGER , POINTER, DIMENSION(:,:) :: zmbathy, zmisfdep ! 3D workspace (ISH)
- REAL(wp), POINTER, DIMENSION(:,:,:) :: zprt
+ REAL(wp) :: zbathydiff, zrisfdepdiff ! isf temporary scalar
+ REAL(wp), POINTER, DIMENSION(:,:) :: zrisfdep, zbathy, zmask ! 2D workspace (ISH)
+ INTEGER , POINTER, DIMENSION(:,:) :: zmbathy, zmisfdep ! 2D workspace (ISH)
!!---------------------------------------------------------------------
!
- IF( nn_timing == 1 ) CALL timing_start('zgr_zps')
- !
- CALL wrk_alloc( jpi, jpj, jpk, zprt )
+ IF( nn_timing == 1 ) CALL timing_start('zgr_isf')
+ !
CALL wrk_alloc( jpi, jpj, zbathy, zmask, zrisfdep)
- CALL wrk_alloc( jpi, jpj, zmbathy, zmisfdep)
- !
- IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*) ' zgr_zps : z-coordinate with partial steps'
- IF(lwp) WRITE(numout,*) ' ~~~~~~~ '
- IF(lwp) WRITE(numout,*) ' mbathy is recomputed : bathy_level file is NOT used'
-
- ll_print = .FALSE. ! Local variable for debugging
-
- IF(lwp .AND. ll_print) THEN ! control print of the ocean depth
- WRITE(numout,*)
- WRITE(numout,*) 'dom_zgr_zps: bathy (in hundred of meters)'
- CALL prihre( bathy, jpi, jpj, 1,jpi, 1, 1, jpj, 1, 1.e-2, numout )
- ENDIF
-
- ! bathymetry in level (from bathy_meter)
- ! ===================
- zmax = gdepw_1d(jpk) + e3t_1d(jpk) ! maximum depth (i.e. the last ocean level thickness <= 2*e3t_1d(jpkm1) )
- bathy(:,:) = MIN( zmax , bathy(:,:) ) ! bounded value of bathy (min already set at the end of zgr_bat)
- WHERE( bathy(:,:) == 0._wp ) ; mbathy(:,:) = 0 ! land : set mbathy to 0
- ELSE WHERE ; mbathy(:,:) = jpkm1 ! ocean : initialize mbathy to the max ocean level
- END WHERE
-
- ! Compute mbathy for ocean points (i.e. the number of ocean levels)
- ! find the number of ocean levels such that the last level thickness
- ! is larger than the minimum of e3zps_min and e3zps_rat * e3t_1d (where
- ! e3t_1d is the reference level thickness
- DO jk = jpkm1, 1, -1
- zdepth = gdepw_1d(jk) + MIN( e3zps_min, e3t_1d(jk)*e3zps_rat )
- WHERE( 0._wp < bathy(:,:) .AND. bathy(:,:) <= zdepth ) mbathy(:,:) = jk-1
- END DO
+ CALL wrk_alloc( jpi, jpj, zmisfdep, zmbathy )
+
+
! (ISF) compute misfdep
WHERE( risfdep(:,:) == 0._wp .AND. bathy(:,:) .NE. 0) ; misfdep(:,:) = 1 ! open water : set misfdep to 1
@@ -1051,10 +1319,10 @@
misfdep(jpi,:) = misfdep( 2 ,:)
ENDIF
-
+
IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN
mbathy( 1 ,:) = mbathy(jpim1,:) ! local domain is cyclic east-west
mbathy(jpi,:) = mbathy( 2 ,:)
ENDIF
-
+
! split last cell if possible (only where water column is 2 cell or less)
DO jk = jpkm1, 1, -1
@@ -1074,5 +1342,5 @@
END WHERE
END DO
-
+
! Case where bathy and risfdep compatible but not the level variable mbathy/misfdep because of partial cell condition
@@ -1250,5 +1518,5 @@
! remove single point "bay" on isf coast line in the ice shelf draft'
- DO jk = 1, jpk
+ DO jk = 2, jpk
WHERE (misfdep==0) misfdep=jpk
zmask=0
@@ -1355,5 +1623,5 @@
IF( zmbathy(ji,jj) .LT. misfdep(ji ,jj+1) ) ibtestjp1 = 0
ibtest=MAX(ibtestim1, ibtestip1, ibtestjm1, ibtestjp1)
- IF( ibtest == 0 ) THEN
+ IF( ibtest == 0 .AND. misfdep(ji,jj) .GE. 2) THEN
mbathy(ji,jj) = 0 ; bathy(ji,jj) = 0.0_wp ; misfdep(ji,jj) = 0 ; risfdep(ji,jj) = 0.0_wp ;
END IF
@@ -1471,238 +1739,10 @@
ENDIF
- ! Scale factors and depth at T- and W-points
- DO jk = 1, jpk ! intitialization to the reference z-coordinate
- gdept_0(:,:,jk) = gdept_1d(jk)
- gdepw_0(:,:,jk) = gdepw_1d(jk)
- e3t_0 (:,:,jk) = e3t_1d (jk)
- e3w_0 (:,:,jk) = e3w_1d (jk)
- END DO
- !
- DO jj = 1, jpj
- DO ji = 1, jpi
- ik = mbathy(ji,jj)
- IF( ik > 0 ) THEN ! ocean point only
- ! max ocean level case
- IF( ik == jpkm1 ) THEN
- zdepwp = bathy(ji,jj)
- ze3tp = bathy(ji,jj) - gdepw_1d(ik)
- ze3wp = 0.5_wp * e3w_1d(ik) * ( 1._wp + ( ze3tp/e3t_1d(ik) ) )
- e3t_0(ji,jj,ik ) = ze3tp
- e3t_0(ji,jj,ik+1) = ze3tp
- e3w_0(ji,jj,ik ) = ze3wp
- e3w_0(ji,jj,ik+1) = ze3tp
- gdepw_0(ji,jj,ik+1) = zdepwp
- gdept_0(ji,jj,ik ) = gdept_1d(ik-1) + ze3wp
- gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + ze3tp
- !
- ELSE ! standard case
- IF( bathy(ji,jj) <= gdepw_1d(ik+1) ) THEN ; gdepw_0(ji,jj,ik+1) = bathy(ji,jj)
- ELSE ; gdepw_0(ji,jj,ik+1) = gdepw_1d(ik+1)
- ENDIF
-!gm Bug? check the gdepw_1d
- ! ... on ik
- gdept_0(ji,jj,ik) = gdepw_1d(ik) + ( gdepw_0(ji,jj,ik+1) - gdepw_1d(ik) ) &
- & * ((gdept_1d( ik ) - gdepw_1d(ik) ) &
- & / ( gdepw_1d( ik+1) - gdepw_1d(ik) ))
- e3t_0(ji,jj,ik) = e3t_1d (ik) * ( gdepw_0 (ji,jj,ik+1) - gdepw_1d(ik) ) &
- & / ( gdepw_1d( ik+1) - gdepw_1d(ik) )
- e3w_0(ji,jj,ik) = 0.5_wp * ( gdepw_0(ji,jj,ik+1) + gdepw_1d(ik+1) - 2._wp * gdepw_1d(ik) ) &
- & * ( e3w_1d(ik) / ( gdepw_1d(ik+1) - gdepw_1d(ik) ) )
- ! ... on ik+1
- e3w_0 (ji,jj,ik+1) = e3t_0 (ji,jj,ik)
- e3t_0 (ji,jj,ik+1) = e3t_0 (ji,jj,ik)
- gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + e3t_0(ji,jj,ik)
- ENDIF
- ENDIF
- END DO
- END DO
- !
- it = 0
- DO jj = 1, jpj
- DO ji = 1, jpi
- ik = mbathy(ji,jj)
- IF( ik > 0 ) THEN ! ocean point only
- e3tp (ji,jj) = e3t_0(ji,jj,ik)
- e3wp (ji,jj) = e3w_0(ji,jj,ik)
- ! test
- zdiff= gdepw_0(ji,jj,ik+1) - gdept_0(ji,jj,ik )
- IF( zdiff <= 0._wp .AND. lwp ) THEN
- it = it + 1
- WRITE(numout,*) ' it = ', it, ' ik = ', ik, ' (i,j) = ', ji, jj
- WRITE(numout,*) ' bathy = ', bathy(ji,jj)
- WRITE(numout,*) ' gdept_0 = ', gdept_0(ji,jj,ik), ' gdepw_0 = ', gdepw_0(ji,jj,ik+1), ' zdiff = ', zdiff
- WRITE(numout,*) ' e3tp = ', e3t_0 (ji,jj,ik), ' e3wp = ', e3w_0 (ji,jj,ik )
- ENDIF
- ENDIF
- END DO
- END DO
- !
- ! (ISF) Definition of e3t, u, v, w for ISF case
- DO jj = 1, jpj
- DO ji = 1, jpi
- ik = misfdep(ji,jj)
- IF( ik > 1 ) THEN ! ice shelf point only
- IF( risfdep(ji,jj) < gdepw_1d(ik) ) risfdep(ji,jj)= gdepw_1d(ik)
- gdepw_0(ji,jj,ik) = risfdep(ji,jj)
-!gm Bug? check the gdepw_0
- ! ... on ik
- gdept_0(ji,jj,ik) = gdepw_1d(ik+1) - ( gdepw_1d(ik+1) - gdepw_0(ji,jj,ik) ) &
- & * ( gdepw_1d(ik+1) - gdept_1d(ik) ) &
- & / ( gdepw_1d(ik+1) - gdepw_1d(ik) )
- e3t_0 (ji,jj,ik ) = gdepw_1d(ik+1) - gdepw_0(ji,jj,ik)
- e3w_0 (ji,jj,ik+1) = gdept_1d(ik+1) - gdept_0(ji,jj,ik)
-
- IF( ik + 1 == mbathy(ji,jj) ) THEN ! ice shelf point only (2 cell water column)
- e3w_0 (ji,jj,ik+1) = gdept_0(ji,jj,ik+1) - gdept_0(ji,jj,ik)
- ENDIF
- ! ... on ik / ik-1
- e3w_0 (ji,jj,ik ) = 2._wp * (gdept_0(ji,jj,ik) - gdepw_0(ji,jj,ik))
- e3t_0 (ji,jj,ik-1) = gdepw_0(ji,jj,ik) - gdepw_1d(ik-1)
-! The next line isn't required and doesn't affect results - included for consistency with bathymetry code
- gdept_0(ji,jj,ik-1) = gdept_1d(ik-1)
- ENDIF
- END DO
- END DO
- !
- it = 0
- DO jj = 1, jpj
- DO ji = 1, jpi
- ik = misfdep(ji,jj)
- IF( ik > 1 ) THEN ! ice shelf point only
- e3tp (ji,jj) = e3t_0(ji,jj,ik )
- e3wp (ji,jj) = e3w_0(ji,jj,ik+1 )
- ! test
- zdiff= gdept_0(ji,jj,ik) - gdepw_0(ji,jj,ik )
- IF( zdiff <= 0. .AND. lwp ) THEN
- it = it + 1
- WRITE(numout,*) ' it = ', it, ' ik = ', ik, ' (i,j) = ', ji, jj
- WRITE(numout,*) ' risfdep = ', risfdep(ji,jj)
- WRITE(numout,*) ' gdept = ', gdept_0(ji,jj,ik), ' gdepw = ', gdepw_0(ji,jj,ik+1), ' zdiff = ', zdiff
- WRITE(numout,*) ' e3tp = ', e3tp(ji,jj), ' e3wp = ', e3wp(ji,jj)
- ENDIF
- ENDIF
- END DO
- END DO
- ! END (ISF)
-
- ! Scale factors and depth at U-, V-, UW and VW-points
- DO jk = 1, jpk ! initialisation to z-scale factors
- e3u_0 (:,:,jk) = e3t_1d(jk)
- e3v_0 (:,:,jk) = e3t_1d(jk)
- e3uw_0(:,:,jk) = e3w_1d(jk)
- e3vw_0(:,:,jk) = e3w_1d(jk)
- END DO
- DO jk = 1,jpk ! Computed as the minimum of neighbooring scale factors
- DO jj = 1, jpjm1
- DO ji = 1, fs_jpim1 ! vector opt.
- e3u_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji+1,jj,jk) )
- e3v_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji,jj+1,jk) )
- e3uw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji+1,jj,jk) )
- e3vw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji,jj+1,jk) )
- END DO
- END DO
- END DO
- ! (ISF) define e3uw
- DO jk = 2,jpk
- DO jj = 1, jpjm1
- DO ji = 1, fs_jpim1 ! vector opt.
- e3uw_0(ji,jj,jk) = MIN( gdept_0(ji,jj,jk), gdept_0(ji+1,jj ,jk) ) &
- & - MAX( gdept_0(ji,jj,jk-1), gdept_0(ji+1,jj ,jk-1) )
- e3vw_0(ji,jj,jk) = MIN( gdept_0(ji,jj,jk), gdept_0(ji ,jj+1,jk) ) &
- & - MAX( gdept_0(ji,jj,jk-1), gdept_0(ji ,jj+1,jk-1) )
- END DO
- END DO
- END DO
- !End (ISF)
-
- CALL lbc_lnk( e3u_0 , 'U', 1._wp ) ; CALL lbc_lnk( e3uw_0, 'U', 1._wp ) ! lateral boundary conditions
- CALL lbc_lnk( e3v_0 , 'V', 1._wp ) ; CALL lbc_lnk( e3vw_0, 'V', 1._wp )
- !
- DO jk = 1, jpk ! set to z-scale factor if zero (i.e. along closed boundaries)
- WHERE( e3u_0 (:,:,jk) == 0._wp ) e3u_0 (:,:,jk) = e3t_1d(jk)
- WHERE( e3v_0 (:,:,jk) == 0._wp ) e3v_0 (:,:,jk) = e3t_1d(jk)
- WHERE( e3uw_0(:,:,jk) == 0._wp ) e3uw_0(:,:,jk) = e3w_1d(jk)
- WHERE( e3vw_0(:,:,jk) == 0._wp ) e3vw_0(:,:,jk) = e3w_1d(jk)
- END DO
-
- ! Scale factor at F-point
- DO jk = 1, jpk ! initialisation to z-scale factors
- e3f_0(:,:,jk) = e3t_1d(jk)
- END DO
- DO jk = 1, jpk ! Computed as the minimum of neighbooring V-scale factors
- DO jj = 1, jpjm1
- DO ji = 1, fs_jpim1 ! vector opt.
- e3f_0(ji,jj,jk) = MIN( e3v_0(ji,jj,jk), e3v_0(ji+1,jj,jk) )
- END DO
- END DO
- END DO
- CALL lbc_lnk( e3f_0, 'F', 1._wp ) ! Lateral boundary conditions
- !
- DO jk = 1, jpk ! set to z-scale factor if zero (i.e. along closed boundaries)
- WHERE( e3f_0(:,:,jk) == 0._wp ) e3f_0(:,:,jk) = e3t_1d(jk)
- END DO
-!!gm bug ? : must be a do loop with mj0,mj1
- !
- e3t_0(:,mj0(1),:) = e3t_0(:,mj0(2),:) ! we duplicate factor scales for jj = 1 and jj = 2
- e3w_0(:,mj0(1),:) = e3w_0(:,mj0(2),:)
- e3u_0(:,mj0(1),:) = e3u_0(:,mj0(2),:)
- e3v_0(:,mj0(1),:) = e3v_0(:,mj0(2),:)
- e3f_0(:,mj0(1),:) = e3f_0(:,mj0(2),:)
-
- ! Control of the sign
- IF( MINVAL( e3t_0 (:,:,:) ) <= 0._wp ) CALL ctl_stop( ' zgr_zps : e r r o r e3t_0 <= 0' )
- IF( MINVAL( e3w_0 (:,:,:) ) <= 0._wp ) CALL ctl_stop( ' zgr_zps : e r r o r e3w_0 <= 0' )
- IF( MINVAL( gdept_0(:,:,:) ) < 0._wp ) CALL ctl_stop( ' zgr_zps : e r r o r gdept_0 < 0' )
- IF( MINVAL( gdepw_0(:,:,:) ) < 0._wp ) CALL ctl_stop( ' zgr_zps : e r r o r gdepw_0 < 0' )
-
- ! Compute gdep3w_0 (vertical sum of e3w)
- WHERE (misfdep == 0) misfdep = 1
- DO jj = 1,jpj
- DO ji = 1,jpi
- gdep3w_0(ji,jj,1) = 0.5_wp * e3w_0(ji,jj,1)
- DO jk = 2, misfdep(ji,jj)
- gdep3w_0(ji,jj,jk) = gdep3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk)
- END DO
- IF (misfdep(ji,jj) .GE. 2) gdep3w_0(ji,jj,misfdep(ji,jj)) = risfdep(ji,jj) + 0.5_wp * e3w_0(ji,jj,misfdep(ji,jj))
- DO jk = misfdep(ji,jj) + 1, jpk
- gdep3w_0(ji,jj,jk) = gdep3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk)
- END DO
- END DO
- END DO
- ! ! ================= !
- IF(lwp .AND. ll_print) THEN ! Control print !
- ! ! ================= !
- DO jj = 1,jpj
- DO ji = 1, jpi
- ik = MAX( mbathy(ji,jj), 1 )
- zprt(ji,jj,1) = e3t_0 (ji,jj,ik)
- zprt(ji,jj,2) = e3w_0 (ji,jj,ik)
- zprt(ji,jj,3) = e3u_0 (ji,jj,ik)
- zprt(ji,jj,4) = e3v_0 (ji,jj,ik)
- zprt(ji,jj,5) = e3f_0 (ji,jj,ik)
- zprt(ji,jj,6) = gdep3w_0(ji,jj,ik)
- END DO
- END DO
- WRITE(numout,*)
- WRITE(numout,*) 'domzgr e3t(mbathy)' ; CALL prihre(zprt(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
- WRITE(numout,*)
- WRITE(numout,*) 'domzgr e3w(mbathy)' ; CALL prihre(zprt(:,:,2),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
- WRITE(numout,*)
- WRITE(numout,*) 'domzgr e3u(mbathy)' ; CALL prihre(zprt(:,:,3),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
- WRITE(numout,*)
- WRITE(numout,*) 'domzgr e3v(mbathy)' ; CALL prihre(zprt(:,:,4),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
- WRITE(numout,*)
- WRITE(numout,*) 'domzgr e3f(mbathy)' ; CALL prihre(zprt(:,:,5),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
- WRITE(numout,*)
- WRITE(numout,*) 'domzgr gdep3w(mbathy)' ; CALL prihre(zprt(:,:,6),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
- ENDIF
- !
- CALL wrk_dealloc( jpi, jpj, jpk, zprt )
CALL wrk_dealloc( jpi, jpj, zmask, zbathy, zrisfdep )
CALL wrk_dealloc( jpi, jpj, zmisfdep, zmbathy )
- !
- IF( nn_timing == 1 ) CALL timing_stop('zgr_zps')
- !
- END SUBROUTINE zgr_zps
+
+ IF( nn_timing == 1 ) CALL timing_stop('zgr_isf')
+
+ END SUBROUTINE
SUBROUTINE zgr_sco
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90 (revision 5602)
@@ -39,5 +39,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2010)
- !! $Id: dtatem.F90 2392 2010-11-15 21:20:05Z gm $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90 (revision 5602)
@@ -69,7 +69,6 @@
!! ** Purpose : Initialization of the dynamics and tracer fields.
!!----------------------------------------------------------------------
- ! - ML - needed for initialization of e3t_b
- INTEGER :: ji,jj,jk ! dummy loop indices
- REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zuvd ! U & V data workspace
+ INTEGER :: ji, jj, jk ! dummy loop indices
+ REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zuvd ! U & V data workspace
!!----------------------------------------------------------------------
!
@@ -84,10 +83,8 @@
IF( lk_c1d ) CALL dta_uvd_init ! Initialization of U & V input data
- rhd (:,:,: ) = 0._wp
- rhop (:,:,: ) = 0._wp
- rn2 (:,:,: ) = 0._wp
- tsa (:,:,:,:) = 0._wp
- rab_b(:,:,:,:) = 0._wp
- rab_n(:,:,:,:) = 0._wp
+ 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
+ tsa (:,:,:,:) = 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
IF( ln_rstart ) THEN ! Restart from a file
@@ -113,9 +110,4 @@
ELSEIF( cp_cfg == 'gyre' ) THEN
CALL istate_gyre ! GYRE configuration : start from pre-defined T-S fields
- ELSEIF( cp_cfg == 'isomip' .OR. cp_cfg == 'isomip2') THEN
- IF(lwp) WRITE(numout,*) 'Initialization of T+S for ISOMIP domain'
- tsn(:,:,:,jp_tem)=-1.9*tmask(:,:,:) ! ISOMIP configuration : start from constant T+S fields
- tsn(:,:,:,jp_sal)=34.4*tmask(:,:,:)
- tsb(:,:,:,:)=tsn(:,:,:,:)
ELSE ! Initial T-S, U-V fields read in files
IF ( ln_tsd_init ) THEN ! read 3D T and S data at nit000
@@ -137,7 +129,11 @@
CALL eos( tsb, rhd, rhop, gdept_0(:,:,:) ) ! before potential and in situ densities
#if ! defined key_c1d
- IF( ln_zps ) CALL zps_hde( nit000, jpts, tsb, gtsu, gtsv, & ! Partial steps: before horizontal gradient
- & rhd, gru , grv, aru, arv, gzu, gzv, ge3ru, ge3rv, & !
- & gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) ! of t, s, rd at the last ocean level
+ IF( ln_zps .AND. .NOT. ln_isfcav) &
+ & CALL zps_hde ( nit000, jpts, tsb, gtsu, gtsv, & ! Partial steps: before horizontal gradient
+ & rhd, gru , grv ) ! of t, s, rd at the last ocean level
+ IF( ln_zps .AND. ln_isfcav) &
+ & CALL zps_hde_isf( nit000, jpts, tsb, gtsu, gtsv, & ! Partial steps for top cell (ISF)
+ & rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv , &
+ & gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) ! of t, s, rd at the last ocean level
#endif
!
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90 (revision 5602)
@@ -41,6 +41,6 @@
REAL(wp), PUBLIC :: rt0 = 273.15_wp !: freezing point of fresh water [Kelvin]
#if defined key_lim3
- REAL(wp), PUBLIC :: rt0_snow = 273.16_wp !: melting point of snow [Kelvin]
- REAL(wp), PUBLIC :: rt0_ice = 273.16_wp !: melting point of ice [Kelvin]
+ REAL(wp), PUBLIC :: rt0_snow = 273.15_wp !: melting point of snow [Kelvin]
+ REAL(wp), PUBLIC :: rt0_ice = 273.15_wp !: melting point of ice [Kelvin]
#else
REAL(wp), PUBLIC :: rt0_snow = 273.15_wp !: melting point of snow [Kelvin]
@@ -51,4 +51,5 @@
REAL(wp), PUBLIC :: rcp !: ocean specific heat [J/Kelvin]
REAL(wp), PUBLIC :: r1_rcp !: = 1. / rcp [Kelvin/J]
+ REAL(wp), PUBLIC :: rau0_rcp !: = rau0 * rcp
REAL(wp), PUBLIC :: r1_rau0_rcp !: = 1. / ( rau0 * rcp )
@@ -82,4 +83,8 @@
REAL(wp), PUBLIC :: xlic = 300.33e+6_wp !: volumetric latent heat fusion of ice [J/m3]
REAL(wp), PUBLIC :: xsn = 2.8e+6_wp !: volumetric latent heat of sublimation of snow [J/m3]
+#endif
+#if defined key_lim3
+ REAL(wp), PUBLIC :: r1_rhoic !: 1 / rhoic
+ REAL(wp), PUBLIC :: r1_rhosn !: 1 / rhosn
#endif
!!----------------------------------------------------------------------
@@ -166,5 +171,8 @@
lfus = xlsn / rhosn ! latent heat of fusion of fresh ice
#endif
-
+#if defined key_lim3
+ r1_rhoic = 1._wp / rhoic
+ r1_rhosn = 1._wp / rhosn
+#endif
IF(lwp) THEN
WRITE(numout,*)
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90 (revision 5602)
@@ -17,4 +17,5 @@
!! 3.3 ! 2010-09 (D.Storkey and E.O'Dea) bug fixes for BDY module
!! - ! 2010-10 (R. Furner, G. Madec) runoff and cla added directly here
+ !! 3.6 ! 2014-11 (P. Mathiot) isf added directly here
!!----------------------------------------------------------------------
@@ -97,5 +98,5 @@
!
CALL wrk_alloc( jpi , jpj+2, zwu )
- CALL wrk_alloc( jpi+4, jpj , zwv, kjstart = -1 )
+ CALL wrk_alloc( jpi+4, jpj , zwv, kistart = -1 )
!
IF( kt == nit000 ) THEN
@@ -236,5 +237,5 @@
!
CALL wrk_dealloc( jpi , jpj+2, zwu )
- CALL wrk_dealloc( jpi+4, jpj , zwv, kjstart = -1 )
+ CALL wrk_dealloc( jpi+4, jpj , zwv, kistart = -1 )
!
IF( nn_timing == 1 ) CALL timing_stop('div_cur')
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90 (revision 5602)
@@ -5,5 +5,6 @@
!!==============================================================================
!! History : 1.0 ! 2006-11 (G. Madec) Original code
- !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase
+ !! 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
!!----------------------------------------------------------------------
@@ -17,4 +18,5 @@
USE dynkeg ! kinetic energy gradient (dyn_keg routine)
USE dynzad ! vertical advection (dyn_zad routine)
+ !
USE in_out_manager ! I/O manager
USE lib_mpp ! MPP library
@@ -25,7 +27,9 @@
PUBLIC dyn_adv ! routine called by step module
- PUBLIC dyn_adv_init ! routine called by opa module
+ PUBLIC dyn_adv_init ! routine called by opa module
+ ! !* namdyn_adv namelist *
LOGICAL, PUBLIC :: ln_dynadv_vec !: vector form flag
+ INTEGER, PUBLIC :: nn_dynkeg !: scheme of kinetic energy gradient: =0 C2 ; =1 Hollingsworth
LOGICAL, PUBLIC :: ln_dynadv_cen2 !: flux form - 2nd order centered scheme flag
LOGICAL, PUBLIC :: ln_dynadv_ubs !: flux form - 3rd order UBS scheme flag
@@ -38,5 +42,5 @@
# include "vectopt_loop_substitute.h90"
!!----------------------------------------------------------------------
- !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+ !! NEMO/OPA 3.6 , NEMO Consortium (2015)
!! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
@@ -63,16 +67,16 @@
SELECT CASE ( nadv ) ! compute advection trend and add it to general trend
CASE ( 0 )
- CALL dyn_keg ( kt ) ! vector form : horizontal gradient of kinetic energy
- CALL dyn_zad ( kt ) ! vector form : vertical advection
+ CALL dyn_keg ( kt, nn_dynkeg ) ! vector form : horizontal gradient of kinetic energy
+ CALL dyn_zad ( kt ) ! vector form : vertical advection
CASE ( 1 )
- CALL dyn_keg ( kt ) ! vector form : horizontal gradient of kinetic energy
- CALL dyn_zad_zts ( kt ) ! vector form : vertical advection with sub-timestepping
+ CALL dyn_keg ( kt, nn_dynkeg ) ! vector form : horizontal gradient of kinetic energy
+ CALL dyn_zad_zts ( kt ) ! vector form : vertical advection with sub-timestepping
CASE ( 2 )
- CALL dyn_adv_cen2( kt ) ! 2nd order centered scheme
+ CALL dyn_adv_cen2( kt ) ! 2nd order centered scheme
CASE ( 3 )
- CALL dyn_adv_ubs ( kt ) ! 3rd order UBS scheme
+ CALL dyn_adv_ubs ( kt ) ! 3rd order UBS scheme
!
- CASE (-1 ) ! esopa: test all possibility with control print
- CALL dyn_keg ( kt )
+ CASE (-1 ) ! esopa: test all possibility with control print
+ CALL dyn_keg ( kt, nn_dynkeg )
CALL dyn_zad ( kt )
CALL dyn_adv_cen2( kt )
@@ -92,10 +96,9 @@
!! momentum advection formulation & scheme and set nadv
!!----------------------------------------------------------------------
- INTEGER :: ioptio
- INTEGER :: ios ! Local integer output status for namelist read
- !!
- NAMELIST/namdyn_adv/ ln_dynadv_vec, ln_dynadv_cen2 , ln_dynadv_ubs, ln_dynzad_zts
+ INTEGER :: ioptio, ios ! Local integer
+ !
+ NAMELIST/namdyn_adv/ ln_dynadv_vec, nn_dynkeg, ln_dynadv_cen2 , ln_dynadv_ubs, ln_dynzad_zts
!!----------------------------------------------------------------------
-
+ !
REWIND( numnam_ref ) ! Namelist namdyn_adv in reference namelist : Momentum advection scheme
READ ( numnam_ref, namdyn_adv, IOSTAT = ios, ERR = 901)
@@ -112,8 +115,9 @@
WRITE(numout,*) '~~~~~~~~~~~'
WRITE(numout,*) ' Namelist namdyn_adv : chose a advection formulation & scheme for momentum'
- WRITE(numout,*) ' Vector/flux form (T/F) ln_dynadv_vec = ', ln_dynadv_vec
- WRITE(numout,*) ' 2nd order centred advection scheme ln_dynadv_cen2 = ', ln_dynadv_cen2
- WRITE(numout,*) ' 3rd order UBS advection scheme ln_dynadv_ubs = ', ln_dynadv_ubs
- WRITE(numout,*) ' Sub timestepping of vertical advection ln_dynzad_zts = ', ln_dynzad_zts
+ WRITE(numout,*) ' Vector/flux form (T/F) ln_dynadv_vec = ', ln_dynadv_vec
+ WRITE(numout,*) ' = 0 standard scheme ; =1 Hollingsworth scheme nn_dynkeg = ', nn_dynkeg
+ WRITE(numout,*) ' 2nd order centred advection scheme ln_dynadv_cen2 = ', ln_dynadv_cen2
+ WRITE(numout,*) ' 3rd order UBS advection scheme ln_dynadv_ubs = ', ln_dynadv_ubs
+ WRITE(numout,*) ' Sub timestepping of vertical advection ln_dynzad_zts = ', ln_dynzad_zts
ENDIF
@@ -126,5 +130,7 @@
IF( ioptio /= 1 ) CALL ctl_stop( 'Choose ONE advection scheme in namelist namdyn_adv' )
IF( ln_dynzad_zts .AND. .NOT. ln_dynadv_vec ) &
- CALL ctl_stop( 'Sub timestepping of vertical advection requires vector form; set ln_dynadv_vec = .TRUE.' )
+ CALL ctl_stop( 'Sub timestepping of vertical advection requires vector form; set ln_dynadv_vec = .TRUE.' )
+ IF( nn_dynkeg /= nkeg_C2 .AND. nn_dynkeg /= nkeg_HW ) &
+ CALL ctl_stop( 'KEG scheme wrong value of nn_dynkeg' )
! ! Set nadv
@@ -137,6 +143,10 @@
IF(lwp) THEN ! Print the choice
WRITE(numout,*)
- IF( nadv == 0 ) WRITE(numout,*) ' vector form : keg + zad + vor is used'
+ IF( nadv == 0 ) WRITE(numout,*) ' vector form : keg + zad + vor is used'
IF( nadv == 1 ) WRITE(numout,*) ' vector form : keg + zad_zts + vor is used'
+ IF( nadv == 0 .OR. nadv == 1 ) THEN
+ IF( nn_dynkeg == nkeg_C2 ) WRITE(numout,*) 'with Centered standard keg scheme'
+ IF( nn_dynkeg == nkeg_HW ) WRITE(numout,*) 'with Hollingsworth keg scheme'
+ ENDIF
IF( nadv == 2 ) WRITE(numout,*) ' flux form : 2nd order scheme is used'
IF( nadv == 3 ) WRITE(numout,*) ' flux form : UBS scheme is used'
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90 (revision 5602)
@@ -116,28 +116,25 @@
DO jj = 2, jpjm1 ! laplacian
DO ji = fs_2, fs_jpim1 ! vector opt.
- zlu_uu(ji,jj,jk,1) = ( ub (ji+1,jj,jk)-2.*ub (ji,jj,jk)+ub (ji-1,jj,jk) ) * umask(ji,jj,jk)
- zlv_vv(ji,jj,jk,1) = ( vb (ji,jj+1,jk)-2.*vb (ji,jj,jk)+vb (ji,jj-1,jk) ) * vmask(ji,jj,jk)
- zlu_uv(ji,jj,jk,1) = ( ub (ji,jj+1,jk)-2.*ub (ji,jj,jk)+ub (ji,jj-1,jk) ) * umask(ji,jj,jk)
- zlv_vu(ji,jj,jk,1) = ( vb (ji+1,jj,jk)-2.*vb (ji,jj,jk)+vb (ji-1,jj,jk) ) * vmask(ji,jj,jk)
- !
- zlu_uu(ji,jj,jk,2) = ( zfu(ji+1,jj,jk)-2.*zfu(ji,jj,jk)+zfu(ji-1,jj,jk) ) * umask(ji,jj,jk)
- zlv_vv(ji,jj,jk,2) = ( zfv(ji,jj+1,jk)-2.*zfv(ji,jj,jk)+zfv(ji,jj-1,jk) ) * vmask(ji,jj,jk)
- zlu_uv(ji,jj,jk,2) = ( zfu(ji,jj+1,jk)-2.*zfu(ji,jj,jk)+zfu(ji,jj-1,jk) ) * umask(ji,jj,jk)
- zlv_vu(ji,jj,jk,2) = ( zfv(ji+1,jj,jk)-2.*zfv(ji,jj,jk)+zfv(ji-1,jj,jk) ) * vmask(ji,jj,jk)
- END DO
- END DO
- END DO
-!!gm BUG !!! just below this should be +1 in all the communications
-! CALL lbc_lnk( zlu_uu(:,:,:,1), 'U', -1.) ; CALL lbc_lnk( zlu_uv(:,:,:,1), 'U', -1.)
-! CALL lbc_lnk( zlu_uu(:,:,:,2), 'U', -1.) ; CALL lbc_lnk( zlu_uv(:,:,:,2), 'U', -1.)
-! CALL lbc_lnk( zlv_vv(:,:,:,1), 'V', -1.) ; CALL lbc_lnk( zlv_vu(:,:,:,1), 'V', -1.)
-! CALL lbc_lnk( zlv_vv(:,:,:,2), 'V', -1.) ; CALL lbc_lnk( zlv_vu(:,:,:,2), 'V', -1.)
-!
-!!gm corrected:
+ !
+ zlu_uu(ji,jj,jk,1) = ( ub (ji+1,jj ,jk) - 2.*ub (ji,jj,jk) + ub (ji-1,jj ,jk) ) * umask(ji,jj,jk)
+ zlv_vv(ji,jj,jk,1) = ( vb (ji ,jj+1,jk) - 2.*vb (ji,jj,jk) + vb (ji ,jj-1,jk) ) * vmask(ji,jj,jk)
+ zlu_uv(ji,jj,jk,1) = ( ub (ji ,jj+1,jk) - ub (ji ,jj ,jk) ) * fmask(ji ,jj ,jk) &
+ & - ( ub (ji ,jj ,jk) - ub (ji ,jj-1,jk) ) * fmask(ji ,jj-1,jk)
+ zlv_vu(ji,jj,jk,1) = ( vb (ji+1,jj ,jk) - vb (ji ,jj ,jk) ) * fmask(ji ,jj ,jk) &
+ & - ( vb (ji ,jj ,jk) - vb (ji-1,jj ,jk) ) * fmask(ji-1,jj ,jk)
+ !
+ zlu_uu(ji,jj,jk,2) = ( zfu(ji+1,jj ,jk) - 2.*zfu(ji,jj,jk) + zfu(ji-1,jj ,jk) ) * umask(ji,jj,jk)
+ zlv_vv(ji,jj,jk,2) = ( zfv(ji ,jj+1,jk) - 2.*zfv(ji,jj,jk) + zfv(ji ,jj-1,jk) ) * vmask(ji,jj,jk)
+ zlu_uv(ji,jj,jk,2) = ( zfu(ji ,jj+1,jk) - zfu(ji ,jj ,jk) ) * fmask(ji ,jj ,jk) &
+ & - ( zfu(ji ,jj ,jk) - zfu(ji ,jj-1,jk) ) * fmask(ji ,jj-1,jk)
+ zlv_vu(ji,jj,jk,2) = ( zfv(ji+1,jj ,jk) - zfv(ji ,jj ,jk) ) * fmask(ji ,jj ,jk) &
+ & - ( zfv(ji ,jj ,jk) - zfv(ji-1,jj ,jk) ) * fmask(ji-1,jj ,jk)
+ END DO
+ END DO
+ END DO
CALL lbc_lnk( zlu_uu(:,:,:,1), 'U', 1. ) ; CALL lbc_lnk( zlu_uv(:,:,:,1), 'U', 1. )
CALL lbc_lnk( zlu_uu(:,:,:,2), 'U', 1. ) ; CALL lbc_lnk( zlu_uv(:,:,:,2), 'U', 1. )
CALL lbc_lnk( zlv_vv(:,:,:,1), 'V', 1. ) ; CALL lbc_lnk( zlv_vu(:,:,:,1), 'V', 1. )
CALL lbc_lnk( zlv_vv(:,:,:,2), 'V', 1. ) ; CALL lbc_lnk( zlv_vu(:,:,:,2), 'V', 1. )
-!!gm end
! ! ====================== !
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90 (revision 5602)
@@ -80,18 +80,23 @@
ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX( bfrua(ji,jj) / fse3u(ji,jj,ikbu) , zm1_2dt ) * ub(ji,jj,ikbu)
va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX( bfrva(ji,jj) / fse3v(ji,jj,ikbv) , zm1_2dt ) * vb(ji,jj,ikbv)
-
- ! (ISF) stability criteria for top friction
- ikbu = miku(ji,jj) ! first wet ocean u- & v-levels
- ikbv = mikv(ji,jj)
- !
- ! Apply stability criteria on absolute value : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt)
- ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX( tfrua(ji,jj) / fse3u(ji,jj,ikbu) , zm1_2dt ) * ub(ji,jj,ikbu) &
- & * (1.-umask(ji,jj,1))
- va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX( tfrva(ji,jj) / fse3v(ji,jj,ikbv) , zm1_2dt ) * vb(ji,jj,ikbv) &
- & * (1.-vmask(ji,jj,1))
- ! (ISF)
-
END DO
END DO
+
+ IF ( ln_isfcav ) THEN
+ DO jj = 2, jpjm1
+ DO ji = 2, jpim1
+ ! (ISF) stability criteria for top friction
+ ikbu = miku(ji,jj) ! first wet ocean u- & v-levels
+ ikbv = mikv(ji,jj)
+ !
+ ! Apply stability criteria on absolute value : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt)
+ ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX( tfrua(ji,jj) / fse3u(ji,jj,ikbu) , zm1_2dt ) * ub(ji,jj,ikbu) &
+ & * (1.-umask(ji,jj,1))
+ va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX( tfrva(ji,jj) / fse3v(ji,jj,ikbv) , zm1_2dt ) * vb(ji,jj,ikbv) &
+ & * (1.-vmask(ji,jj,1))
+ ! (ISF)
+ END DO
+ END DO
+ END IF
!
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90 (revision 5602)
@@ -16,4 +16,5 @@
!! 3.4 ! 2011-11 (H. Liu) hpg_prj: Original code for s-coordinates
!! ! (A. Coward) suppression of hel, wdj and rot options
+ !! 3.6 ! 2014-11 (P. Mathiot) hpg_isf: original code for ice shelf cavity
!!----------------------------------------------------------------------
@@ -25,4 +26,5 @@
!! hpg_zps : z-coordinate plus partial steps (interpolation)
!! hpg_sco : s-coordinate (standard jacobian formulation)
+ !! hpg_isf : s-coordinate (sco formulation) adapted to ice shelf
!! hpg_djc : s-coordinate (Density Jacobian with Cubic polynomial)
!! hpg_prj : s-coordinate (Pressure Jacobian with Cubic polynomial)
@@ -55,4 +57,5 @@
LOGICAL , PUBLIC :: ln_hpg_djc !: s-coordinate (Density Jacobian with Cubic polynomial)
LOGICAL , PUBLIC :: ln_hpg_prj !: s-coordinate (Pressure Jacobian scheme)
+ LOGICAL , PUBLIC :: ln_hpg_isf !: s-coordinate similar to sco modify for isf
LOGICAL , PUBLIC :: ln_dynhpg_imp !: semi-implicite hpg flag
@@ -97,4 +100,5 @@
CASE ( 3 ) ; CALL hpg_djc ( kt ) ! s-coordinate (Density Jacobian with Cubic polynomial)
CASE ( 4 ) ; CALL hpg_prj ( kt ) ! s-coordinate (Pressure Jacobian scheme)
+ CASE ( 5 ) ; CALL hpg_isf ( kt ) ! s-coordinate similar to sco modify for ice shelf
END SELECT
!
@@ -128,5 +132,5 @@
!!
NAMELIST/namdyn_hpg/ ln_hpg_zco, ln_hpg_zps, ln_hpg_sco, &
- & ln_hpg_djc, ln_hpg_prj, ln_dynhpg_imp
+ & ln_hpg_djc, ln_hpg_prj, ln_hpg_isf, ln_dynhpg_imp
!!----------------------------------------------------------------------
!
@@ -148,4 +152,5 @@
WRITE(numout,*) ' z-coord. - partial steps (interpolation) ln_hpg_zps = ', ln_hpg_zps
WRITE(numout,*) ' s-coord. (standard jacobian formulation) ln_hpg_sco = ', ln_hpg_sco
+ WRITE(numout,*) ' s-coord. (standard jacobian formulation) for isf ln_hpg_isf = ', ln_hpg_isf
WRITE(numout,*) ' s-coord. (Density Jacobian: Cubic polynomial) ln_hpg_djc = ', ln_hpg_djc
WRITE(numout,*) ' s-coord. (Pressure Jacobian: Cubic polynomial) ln_hpg_prj = ', ln_hpg_prj
@@ -158,8 +163,13 @@
& either ln_hpg_sco or ln_hpg_prj instead')
!
- IF( lk_vvl .AND. .NOT. (ln_hpg_sco.OR.ln_hpg_prj) ) &
+ IF( lk_vvl .AND. .NOT. (ln_hpg_sco.OR.ln_hpg_prj.OR.ln_hpg_isf) ) &
& CALL ctl_stop('dyn_hpg_init : variable volume key_vvl requires:&
& the standard jacobian formulation hpg_sco or &
& the pressure jacobian formulation hpg_prj')
+
+ IF( ln_hpg_isf .AND. .NOT. ln_isfcav ) &
+ & CALL ctl_stop( ' hpg_isf not available if ln_isfcav = false ' )
+ IF( .NOT. ln_hpg_isf .AND. ln_isfcav ) &
+ & CALL ctl_stop( 'Only hpg_isf has been corrected to work with ice shelf cavity.' )
!
! ! Set nhpg from ln_hpg_... flags
@@ -169,4 +179,5 @@
IF( ln_hpg_djc ) nhpg = 3
IF( ln_hpg_prj ) nhpg = 4
+ IF( ln_hpg_isf ) nhpg = 5
!
! ! Consistency check
@@ -177,7 +188,9 @@
IF( ln_hpg_djc ) ioptio = ioptio + 1
IF( ln_hpg_prj ) ioptio = ioptio + 1
+ IF( ln_hpg_isf ) ioptio = ioptio + 1
IF( ioptio /= 1 ) CALL ctl_stop( 'NO or several hydrostatic pressure gradient options used' )
- IF( (ln_hpg_zco .OR. ln_hpg_zps .OR. ln_hpg_djc .OR. ln_hpg_prj ) .AND. nn_isf .NE. 0 ) &
- & CALL ctl_stop( 'Only hpg_sco has been corrected to work with ice shelf cavity.' )
+ !
+ ! initialisation of ice load
+ riceload(:,:)=0.0
!
END SUBROUTINE dyn_hpg_init
@@ -345,5 +358,4 @@
END SUBROUTINE hpg_zps
-
SUBROUTINE hpg_sco( kt )
!!---------------------------------------------------------------------
@@ -366,4 +378,91 @@
INTEGER, INTENT(in) :: kt ! ocean time-step index
!!
+ INTEGER :: ji, jj, jk ! dummy loop indices
+ REAL(wp) :: zcoef0, zuap, zvap, znad ! temporary scalars
+ REAL(wp), POINTER, DIMENSION(:,:,:) :: zhpi, zhpj
+ !!----------------------------------------------------------------------
+ !
+ CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj )
+ !
+ IF( kt == nit000 ) THEN
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) 'dyn:hpg_sco : hydrostatic pressure gradient trend'
+ IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ s-coordinate case, OPA original scheme used'
+ ENDIF
+
+ ! Local constant initialization
+ zcoef0 = - grav * 0.5_wp
+ ! To use density and not density anomaly
+ IF ( lk_vvl ) THEN ; znad = 1._wp ! Variable volume
+ ELSE ; znad = 0._wp ! Fixed volume
+ ENDIF
+
+ ! Surface value
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
+ ! hydrostatic pressure gradient along s-surfaces
+ zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj) * ( fse3w(ji+1,jj ,1) * ( znad + rhd(ji+1,jj ,1) ) &
+ & - fse3w(ji ,jj ,1) * ( znad + rhd(ji ,jj ,1) ) )
+ zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj) * ( fse3w(ji ,jj+1,1) * ( znad + rhd(ji ,jj+1,1) ) &
+ & - fse3w(ji ,jj ,1) * ( znad + rhd(ji ,jj ,1) ) )
+ ! s-coordinate pressure gradient correction
+ zuap = -zcoef0 * ( rhd (ji+1,jj,1) + rhd (ji,jj,1) + 2._wp * znad ) &
+ & * ( fsde3w(ji+1,jj,1) - fsde3w(ji,jj,1) ) / e1u(ji,jj)
+ zvap = -zcoef0 * ( rhd (ji,jj+1,1) + rhd (ji,jj,1) + 2._wp * znad ) &
+ & * ( fsde3w(ji,jj+1,1) - fsde3w(ji,jj,1) ) / e2v(ji,jj)
+ ! add to the general momentum trend
+ ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) + zuap
+ va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1) + zvap
+ END DO
+ END DO
+
+ ! interior value (2=> ~ faster
-! don't forget to suppress local zu zv scalars
-! zhke(ji,jj,jk) = 0.25 * ( un(ji-1,jj ,jk) * un(ji-1,jj ,jk) &
-! & + un(ji ,jj ,jk) * un(ji ,jj ,jk) &
-! & + vn(ji ,jj-1,jk) * vn(ji ,jj-1,jk) &
-! & + vn(ji ,jj ,jk) * vn(ji ,jj ,jk) )
-!!gm end <<==
- END DO
- END DO
- DO jj = 2, jpjm1 ! add the gradient of kinetic energy to the general momentum trends
+ zhke(:,:,jpk) = 0._wp
+
+ SELECT CASE ( kscheme ) !== Horizontal kinetic energy at T-point ==!
+ !
+ CASE ( nkeg_C2 ) !-- Standard scheme --!
+ DO jk = 1, jpkm1
+ DO jj = 2, jpj
+ DO ji = fs_2, jpi ! vector opt.
+ zu = un(ji-1,jj ,jk) * un(ji-1,jj ,jk) &
+ & + un(ji ,jj ,jk) * un(ji ,jj ,jk)
+ zv = vn(ji ,jj-1,jk) * vn(ji ,jj-1,jk) &
+ & + vn(ji ,jj ,jk) * vn(ji ,jj ,jk)
+ zhke(ji,jj,jk) = 0.25_wp * ( zv + zu )
+ END DO
+ END DO
+ END DO
+ !
+ CASE ( nkeg_HW ) !-- Hollingsworth scheme --!
+ DO jk = 1, jpkm1
+ DO jj = 2, jpjm1
+ DO ji = fs_2, jpim1 ! vector opt.
+ zu = 8._wp * ( un(ji-1,jj ,jk) * un(ji-1,jj ,jk) &
+ & + un(ji ,jj ,jk) * un(ji ,jj ,jk) ) &
+ & + ( un(ji-1,jj-1,jk) + un(ji-1,jj+1,jk) ) * ( un(ji-1,jj-1,jk) + un(ji-1,jj+1,jk) ) &
+ & + ( un(ji ,jj-1,jk) + un(ji ,jj+1,jk) ) * ( un(ji ,jj-1,jk) + un(ji ,jj+1,jk) )
+ !
+ zv = 8._wp * ( vn(ji ,jj-1,jk) * vn(ji ,jj-1,jk) &
+ & + vn(ji ,jj ,jk) * vn(ji ,jj ,jk) ) &
+ & + ( vn(ji-1,jj-1,jk) + vn(ji+1,jj-1,jk) ) * ( vn(ji-1,jj-1,jk) + vn(ji+1,jj-1,jk) ) &
+ & + ( vn(ji-1,jj ,jk) + vn(ji+1,jj ,jk) ) * ( vn(ji-1,jj ,jk) + vn(ji+1,jj ,jk) )
+ zhke(ji,jj,jk) = r1_48 * ( zv + zu )
+ END DO
+ END DO
+ END DO
+ CALL lbc_lnk( zhke, 'T', 1. )
+ !
+ END SELECT
+ !
+ DO jk = 1, jpkm1 !== grad( KE ) added to the general momentum trends ==!
+ DO jj = 2, jpjm1
DO ji = fs_2, fs_jpim1 ! vector opt.
ua(ji,jj,jk) = ua(ji,jj,jk) - ( zhke(ji+1,jj ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj)
@@ -104,34 +141,11 @@
END DO
END DO
-!!gm idea to be tested ==>> is it faster on scalar computers ?
-! DO jj = 2, jpjm1 ! add the gradient of kinetic energy to the general momentum trends
-! DO ji = fs_2, fs_jpim1 ! vector opt.
-! ua(ji,jj,jk) = ua(ji,jj,jk) - 0.25 * ( + un(ji+1,jj ,jk) * un(ji+1,jj ,jk) &
-! & + vn(ji+1,jj-1,jk) * vn(ji+1,jj-1,jk) &
-! & + vn(ji+1,jj ,jk) * vn(ji+1,jj ,jk) &
-! !
-! & - un(ji-1,jj ,jk) * un(ji-1,jj ,jk) &
-! & - vn(ji ,jj-1,jk) * vn(ji ,jj-1,jk) &
-! & - vn(ji ,jj ,jk) * vn(ji ,jj ,jk) ) / e1u(ji,jj)
-! !
-! va(ji,jj,jk) = va(ji,jj,jk) - 0.25 * ( un(ji-1,jj+1,jk) * un(ji-1,jj+1,jk) &
-! & + un(ji ,jj+1,jk) * un(ji ,jj+1,jk) &
-! & + vn(ji ,jj+1,jk) * vn(ji ,jj+1,jk) &
-! !
-! & - un(ji-1,jj ,jk) * un(ji-1,jj ,jk) &
-! & - un(ji ,jj ,jk) * un(ji ,jj ,jk) &
-! & - vn(ji ,jj ,jk) * vn(ji ,jj ,jk) ) / e2v(ji,jj)
-! END DO
-! END DO
-!!gm en idea <<==
- ! ! ===============
- END DO ! End of slab
- ! ! ===============
-
- IF( l_trddyn ) THEN ! save the Kinetic Energy trends for diagnostic
+ END DO
+ !
+ IF( l_trddyn ) THEN ! save the Kinetic Energy trends for diagnostic
ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
CALL trd_dyn( ztrdu, ztrdv, jpdyn_keg, kt )
- CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv )
+ CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv )
ENDIF
!
@@ -139,7 +153,7 @@
& tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )
!
- CALL wrk_dealloc( jpi, jpj, jpk, zhke )
+ CALL wrk_dealloc( jpi,jpj,jpk, zhke )
!
- IF( nn_timing == 1 ) CALL timing_stop('dyn_keg')
+ IF( nn_timing == 1 ) CALL timing_stop('dyn_keg')
!
END SUBROUTINE dyn_keg
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynnept.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynnept.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynnept.F90 (revision 5602)
@@ -69,4 +69,5 @@
!!----------------------------------------------------------------------
+ !! $Id$
CONTAINS
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90 (revision 5602)
@@ -266,6 +266,6 @@
! Add volume filter correction: compatibility with tracer advection scheme
! => time filter + conservation correction (only at the first level)
- fse3t_b(:,:,1) = fse3t_b(:,:,1) - atfp * rdt * r1_rau0 * ( emp_b(:,:) - emp(:,:) ) * tmask(:,:,1)
- !
+ fse3t_b(:,:,1) = fse3t_b(:,:,1) - atfp * rdt * r1_rau0 * ( emp_b(:,:) - emp(:,:) &
+ & -rnf_b(:,:) + rnf(:,:) ) * tmask(:,:,1)
ENDIF
!
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90 (revision 5602)
@@ -250,5 +250,5 @@
IF( ( ioptio > 1 .AND. .NOT. lk_esopa ) .OR. ( ioptio == 0 .AND. .NOT. lk_c1d ) ) &
& CALL ctl_stop( ' Choose only one surface pressure gradient scheme with a key cpp' )
- IF( ( lk_dynspg_ts .OR. lk_dynspg_exp ) .AND. nn_isf .NE. 0 ) &
+ IF( ( lk_dynspg_ts .OR. lk_dynspg_exp ) .AND. ln_isfcav ) &
& CALL ctl_stop( ' dynspg_ts and dynspg_exp not tested with ice shelf cavity ' )
!
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90 (revision 5602)
@@ -22,4 +22,5 @@
USE dom_oce ! ocean space and time domain
USE sbc_oce ! surface boundary condition: ocean
+ USE sbcisf ! ice shelf variable (fwfisf)
USE dynspg_oce ! surface pressure gradient variables
USE phycst ! physical constants
@@ -78,5 +79,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.5 , NEMO Consortium (2013)
- !! $Id: dynspg_ts.F90
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
@@ -97,6 +98,6 @@
ALLOCATE( wgtbtp1(3*nn_baro), wgtbtp2(3*nn_baro), zwz(jpi,jpj), STAT= ierr(2) )
- IF( ln_dynvor_een ) ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , &
- & ftsw(jpi,jpj) , ftse(jpi,jpj) , STAT=ierr(3) )
+ IF( ln_dynvor_een .or. ln_dynvor_een_old ) ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , &
+ & ftsw(jpi,jpj) , ftse(jpi,jpj) , STAT=ierr(3) )
dyn_spg_ts_alloc = MAXVAL(ierr(:))
@@ -218,5 +219,25 @@
!
IF ( kt == nit000 .OR. lk_vvl ) THEN
- IF ( ln_dynvor_een ) THEN
+ IF ( ln_dynvor_een_old ) THEN
+ DO jj = 1, jpjm1
+ DO ji = 1, jpim1
+ zwz(ji,jj) = ( ht(ji ,jj+1) + ht(ji+1,jj+1) + &
+ & ht(ji ,jj ) + ht(ji+1,jj ) ) / 4._wp
+ IF( zwz(ji,jj) /= 0._wp ) zwz(ji,jj) = 1._wp / zwz(ji,jj)
+ END DO
+ END DO
+ CALL lbc_lnk( zwz, 'F', 1._wp )
+ zwz(:,:) = ff(:,:) * zwz(:,:)
+
+ ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp
+ DO jj = 2, jpj
+ DO ji = fs_2, jpi ! vector opt.
+ ftne(ji,jj) = zwz(ji-1,jj ) + zwz(ji ,jj ) + zwz(ji ,jj-1)
+ ftnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj ) + zwz(ji ,jj )
+ ftse(ji,jj) = zwz(ji ,jj ) + zwz(ji ,jj-1) + zwz(ji-1,jj-1)
+ ftsw(ji,jj) = zwz(ji ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj )
+ END DO
+ END DO
+ ELSE IF ( ln_dynvor_een ) THEN
DO jj = 1, jpjm1
DO ji = 1, jpim1
@@ -339,5 +360,5 @@
END DO
!
- ELSEIF ( ln_dynvor_een ) THEN ! enstrophy and energy conserving scheme
+ ELSEIF ( ln_dynvor_een .or. ln_dynvor_een_old ) THEN ! enstrophy and energy conserving scheme
DO jj = 2, jpjm1
DO ji = fs_2, fs_jpim1 ! vector opt.
@@ -433,12 +454,13 @@
! ! Surface net water flux and rivers
IF (ln_bt_fw) THEN
- zssh_frc(:,:) = zraur * ( emp(:,:) - rnf(:,:) )
+ zssh_frc(:,:) = zraur * ( emp(:,:) - rnf(:,:) + rdivisf * fwfisf(:,:) )
ELSE
- zssh_frc(:,:) = zraur * z1_2 * (emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:))
+ zssh_frc(:,:) = zraur * z1_2 * ( emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:) &
+ & + rdivisf * ( fwfisf(:,:) + fwfisf_b(:,:) ) )
ENDIF
#if defined key_asminc
! ! Include the IAU weighted SSH increment
IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN
- zssh_frc(:,:) = zssh_frc(:,:) + ssh_iau(:,:)
+ zssh_frc(:,:) = zssh_frc(:,:) - ssh_iau(:,:)
ENDIF
#endif
@@ -535,5 +557,5 @@
END DO
END DO
- CALL lbc_lnk( zwx, 'U', 1._wp ) ; CALL lbc_lnk( zwy, 'V', 1._wp )
+ CALL lbc_lnk_multi( zwx, 'U', 1._wp, zwy, 'V', 1._wp )
!
zhup2_e (:,:) = hu_0(:,:) + zwx(:,:) ! Ocean depth at U- and V-points
@@ -613,5 +635,5 @@
END DO
END DO
- CALL lbc_lnk( zsshu_a, 'U', 1._wp ) ; CALL lbc_lnk( zsshv_a, 'V', 1._wp )
+ CALL lbc_lnk_multi( zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp )
ENDIF
!
@@ -687,5 +709,5 @@
END DO
!
- ELSEIF ( ln_dynvor_een ) THEN !== energy and enstrophy conserving scheme ==!
+ ELSEIF ( ln_dynvor_een .or. ln_dynvor_een_old ) THEN !== energy and enstrophy conserving scheme ==!
DO jj = 2, jpjm1
DO ji = fs_2, fs_jpim1 ! vector opt.
@@ -781,6 +803,5 @@
! ! -----------------------
!
- CALL lbc_lnk( ua_e , 'U', -1._wp ) ! local domain boundaries
- CALL lbc_lnk( va_e , 'V', -1._wp )
+ CALL lbc_lnk_multi( ua_e, 'U', -1._wp, va_e , 'V', -1._wp )
#if defined key_bdy
@@ -837,5 +858,5 @@
END DO
END DO
- CALL lbc_lnk( zsshu_a, 'U', 1._wp ) ; CALL lbc_lnk( zsshv_a, 'V', 1._wp ) ! Boundary conditions
+ CALL lbc_lnk_multi( zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions
ENDIF
!
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90 (revision 5602)
@@ -51,4 +51,5 @@
LOGICAL, PUBLIC :: ln_dynvor_mix !: mixed scheme
LOGICAL, PUBLIC :: ln_dynvor_een !: energy and enstrophy conserving scheme
+ LOGICAL, PUBLIC :: ln_dynvor_een_old !: energy and enstrophy conserving scheme (original formulation)
INTEGER :: nvor = 0 ! type of vorticity trend used
@@ -596,15 +597,29 @@
IF( kt == nit000 .OR. lk_vvl ) THEN ! reciprocal of e3 at F-point (masked averaging of e3t over ocean points)
- DO jk = 1, jpk
- DO jj = 1, jpjm1
- DO ji = 1, jpim1
- ze3 = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk) &
- & + fse3t(ji,jj ,jk)*tmask(ji,jj ,jk) + fse3t(ji+1,jj ,jk)*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( ze3 /= 0._wp ) ze3f(ji,jj,jk) = zmsk / ze3
- END DO
- END DO
- END DO
+
+ IF( ln_dynvor_een_old ) THEN ! original formulation
+ DO jk = 1, jpk
+ DO jj = 1, jpjm1
+ DO ji = 1, jpim1
+ ze3 = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk) &
+ & + fse3t(ji,jj ,jk)*tmask(ji,jj ,jk) + fse3t(ji+1,jj ,jk)*tmask(ji+1,jj ,jk) )
+ IF( ze3 /= 0._wp ) ze3f(ji,jj,jk) = 4.0_wp / ze3
+ END DO
+ END DO
+ END DO
+ ELSE ! new formulation from NEMO 3.6
+ DO jk = 1, jpk
+ DO jj = 1, jpjm1
+ DO ji = 1, jpim1
+ ze3 = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk) &
+ & + fse3t(ji,jj ,jk)*tmask(ji,jj ,jk) + fse3t(ji+1,jj ,jk)*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( ze3 /= 0._wp ) ze3f(ji,jj,jk) = zmsk / ze3
+ END DO
+ END DO
+ END DO
+ ENDIF
+
CALL lbc_lnk( ze3f, 'F', 1. )
ENDIF
@@ -705,5 +720,5 @@
INTEGER :: ios ! Local integer output status for namelist read
!!
- NAMELIST/namdyn_vor/ ln_dynvor_ens, ln_dynvor_ene, ln_dynvor_mix, ln_dynvor_een
+ NAMELIST/namdyn_vor/ ln_dynvor_ens, ln_dynvor_ene, ln_dynvor_mix, ln_dynvor_een, ln_dynvor_een_old
!!----------------------------------------------------------------------
@@ -726,4 +741,5 @@
WRITE(numout,*) ' mixed enstrophy/energy conserving scheme ln_dynvor_mix = ', ln_dynvor_mix
WRITE(numout,*) ' enstrophy and energy conserving scheme ln_dynvor_een = ', ln_dynvor_een
+ WRITE(numout,*) ' enstrophy and energy conserving scheme (old) ln_dynvor_een_old= ', ln_dynvor_een_old
ENDIF
@@ -749,4 +765,5 @@
IF( ln_dynvor_mix ) ioptio = ioptio + 1
IF( ln_dynvor_een ) ioptio = ioptio + 1
+ IF( ln_dynvor_een_old ) ioptio = ioptio + 1
IF( lk_esopa ) ioptio = 1
@@ -757,5 +774,5 @@
IF( ln_dynvor_ens ) nvor = 1
IF( ln_dynvor_mix ) nvor = 2
- IF( ln_dynvor_een ) nvor = 3
+ IF( ln_dynvor_een .or. ln_dynvor_een_old ) nvor = 3
IF( lk_esopa ) nvor = -1
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90 (revision 5602)
@@ -95,12 +95,25 @@
END DO
END DO
- DO jj = 2, jpjm1 ! Surface and bottom values set to zero
- DO ji = fs_2, fs_jpim1 ! vector opt.
- zwuw(ji,jj, 1:miku(ji,jj) ) = 0._wp
- zwvw(ji,jj, 1:mikv(ji,jj) ) = 0._wp
- zwuw(ji,jj,jpk) = 0._wp
- zwvw(ji,jj,jpk) = 0._wp
- END DO
- END DO
+ !
+ ! Surface and bottom advective fluxes set to zero
+ IF ( ln_isfcav ) THEN
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
+ zwuw(ji,jj, 1:miku(ji,jj) ) = 0._wp
+ zwvw(ji,jj, 1:mikv(ji,jj) ) = 0._wp
+ zwuw(ji,jj,jpk) = 0._wp
+ zwvw(ji,jj,jpk) = 0._wp
+ END DO
+ END DO
+ ELSE
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
+ zwuw(ji,jj, 1 ) = 0._wp
+ zwvw(ji,jj, 1 ) = 0._wp
+ zwuw(ji,jj,jpk) = 0._wp
+ zwvw(ji,jj,jpk) = 0._wp
+ END DO
+ END DO
+ END IF
DO jk = 1, jpkm1 ! Vertical momentum advection at u- and v-points
@@ -196,9 +209,10 @@
END DO
END DO
-
- DO jj = 2, jpjm1 ! Surface and bottom advective fluxes set to zero
+ !
+ ! Surface and bottom advective fluxes set to zero
+ DO jj = 2, jpjm1
DO ji = fs_2, fs_jpim1 ! vector opt.
- zwuw(ji,jj, 1:miku(ji,jj) ) = 0._wp
- zwvw(ji,jj, 1:mikv(ji,jj) ) = 0._wp
+ zwuw(ji,jj, 1 ) = 0._wp
+ zwvw(ji,jj, 1 ) = 0._wp
zwuw(ji,jj,jpk) = 0._wp
zwvw(ji,jj,jpk) = 0._wp
@@ -228,6 +242,6 @@
DO jj = 2, jpjm1 ! vertical momentum advection at w-point
DO ji = fs_2, fs_jpim1 ! vector opt.
- zwuw(ji,jj,jk) = ( zww(ji+1,jj ,jk) + zww(ji,jj,jk) ) * ( zus(ji,jj,jk-1,jtn)-zus(ji,jj,jk,jtn) )
- zwvw(ji,jj,jk) = ( zww(ji ,jj+1,jk) + zww(ji,jj,jk) ) * ( zvs(ji,jj,jk-1,jtn)-zvs(ji,jj,jk,jtn) )
+ zwuw(ji,jj,jk) = ( zww(ji+1,jj ,jk) + zww(ji,jj,jk) ) * ( zus(ji,jj,jk-1,jtn)-zus(ji,jj,jk,jtn) ) !* wumask(ji,jj,jk)
+ zwvw(ji,jj,jk) = ( zww(ji ,jj+1,jk) + zww(ji,jj,jk) ) * ( zvs(ji,jj,jk-1,jtn)-zvs(ji,jj,jk,jtn) ) !* wvmask(ji,jj,jk)
END DO
END DO
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90 (revision 5602)
@@ -105,10 +105,16 @@
avmu(ji,jj,ikbu+1) = -bfrua(ji,jj) * fse3uw(ji,jj,ikbu+1)
avmv(ji,jj,ikbv+1) = -bfrva(ji,jj) * fse3vw(ji,jj,ikbv+1)
- ikbu = miku(ji,jj) ! ocean top level at u- and v-points
- ikbv = mikv(ji,jj) ! (first wet ocean u- and v-points)
- IF (ikbu .GE. 2) avmu(ji,jj,ikbu) = -tfrua(ji,jj) * fse3uw(ji,jj,ikbu)
- IF (ikbv .GE. 2) avmv(ji,jj,ikbv) = -tfrva(ji,jj) * fse3vw(ji,jj,ikbv)
- END DO
- END DO
+ END DO
+ END DO
+ IF ( ln_isfcav ) THEN
+ DO jj = 2, jpjm1
+ DO ji = 2, jpim1
+ ikbu = miku(ji,jj) ! ocean top level at u- and v-points
+ ikbv = mikv(ji,jj) ! (first wet ocean u- and v-points)
+ IF (ikbu .GE. 2) avmu(ji,jj,ikbu) = -tfrua(ji,jj) * fse3uw(ji,jj,ikbu)
+ IF (ikbv .GE. 2) avmv(ji,jj,ikbv) = -tfrva(ji,jj) * fse3vw(ji,jj,ikbv)
+ END DO
+ END DO
+ END IF
ENDIF
@@ -145,12 +151,18 @@
ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + p2dt * bfrua(ji,jj) * ua_b(ji,jj) / ze3ua
va(ji,jj,ikbv) = va(ji,jj,ikbv) + p2dt * bfrva(ji,jj) * va_b(ji,jj) / ze3va
- ikbu = miku(ji,jj) ! top ocean level at u- and v-points
- ikbv = mikv(ji,jj) ! (first wet ocean u- and v-points)
- ze3ua = ( 1._wp - r_vvl ) * fse3u_n(ji,jj,ikbu) + r_vvl * fse3u_a(ji,jj,ikbu)
- ze3va = ( 1._wp - r_vvl ) * fse3v_n(ji,jj,ikbv) + r_vvl * fse3v_a(ji,jj,ikbv)
- ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + p2dt * tfrua(ji,jj) * ua_b(ji,jj) / ze3ua
- va(ji,jj,ikbv) = va(ji,jj,ikbv) + p2dt * tfrva(ji,jj) * va_b(ji,jj) / ze3va
- END DO
- END DO
+ END DO
+ END DO
+ IF ( ln_isfcav ) THEN
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
+ ikbu = miku(ji,jj) ! top ocean level at u- and v-points
+ ikbv = mikv(ji,jj) ! (first wet ocean u- and v-points)
+ ze3ua = ( 1._wp - r_vvl ) * fse3u_n(ji,jj,ikbu) + r_vvl * fse3u_a(ji,jj,ikbu)
+ ze3va = ( 1._wp - r_vvl ) * fse3v_n(ji,jj,ikbv) + r_vvl * fse3v_a(ji,jj,ikbv)
+ ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + p2dt * tfrua(ji,jj) * ua_b(ji,jj) / ze3ua
+ va(ji,jj,ikbv) = va(ji,jj,ikbv) + p2dt * tfrva(ji,jj) * va_b(ji,jj) / ze3va
+ END DO
+ END DO
+ END IF
ENDIF
#endif
@@ -167,9 +179,9 @@
ze3ua = ( 1._wp - r_vvl ) * fse3u_n(ji,jj,jk) + r_vvl * fse3u_a(ji,jj,jk) ! after scale factor at T-point
zcoef = - p2dt / ze3ua
- zzwi = zcoef * avmu (ji,jj,jk ) / fse3uw(ji,jj,jk )
- zwi(ji,jj,jk) = zzwi * umask(ji,jj,jk)
- zzws = zcoef * avmu (ji,jj,jk+1) / fse3uw(ji,jj,jk+1)
- zws(ji,jj,jk) = zzws * umask(ji,jj,jk+1)
- zwd(ji,jj,jk) = 1._wp - zwi(ji,jj,jk) - zzws
+ zzwi = zcoef * avmu (ji,jj,jk ) / fse3uw(ji,jj,jk )
+ zwi(ji,jj,jk) = zzwi * wumask(ji,jj,jk )
+ zzws = zcoef * avmu (ji,jj,jk+1) / fse3uw(ji,jj,jk+1)
+ zws(ji,jj,jk) = zzws * wumask(ji,jj,jk+1)
+ zwd(ji,jj,jk) = 1._wp - zzwi - zzws
END DO
END DO
@@ -198,7 +210,7 @@
!
!== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) ==
- DO jj = 2, jpjm1
- DO ji = fs_2, fs_jpim1 ! vector opt.
- DO jk = miku(ji,jj)+1, jpkm1
+ DO jk = 2, jpkm1
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1)
END DO
@@ -208,14 +220,18 @@
DO jj = 2, jpjm1 !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 ==
DO ji = fs_2, fs_jpim1 ! vector opt.
- ze3ua = ( 1._wp - r_vvl ) * fse3u_n(ji,jj,miku(ji,jj)) + r_vvl * fse3u_a(ji,jj,miku(ji,jj))
#if defined key_dynspg_ts
- ua(ji,jj,miku(ji,jj)) = ua(ji,jj,miku(ji,jj)) + p2dt * 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) ) &
- & / ( ze3ua * rau0 )
+ ze3ua = ( 1._wp - r_vvl ) * fse3u_n(ji,jj,1) + r_vvl * fse3u_a(ji,jj,1)
+ ua(ji,jj,1) = ua(ji,jj,1) + p2dt * 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) ) &
+ & / ( ze3ua * rau0 ) * umask(ji,jj,1)
#else
- ua(ji,jj,miku(ji,jj)) = ub(ji,jj,miku(ji,jj)) &
- & + p2dt *(ua(ji,jj,miku(ji,jj)) + 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) ) &
- & / ( fse3u(ji,jj,miku(ji,jj)) * rau0 ) )
-#endif
- DO jk = miku(ji,jj)+1, jpkm1
+ ua(ji,jj,1) = ub(ji,jj,1) &
+ & + p2dt *(ua(ji,jj,1) + 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) ) &
+ & / ( fse3u(ji,jj,1) * rau0 ) * umask(ji,jj,1) )
+#endif
+ END DO
+ END DO
+ DO jk = 2, jpkm1
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1
#if defined key_dynspg_ts
zrhs = ua(ji,jj,jk) ! zrhs=right hand side
@@ -231,5 +247,9 @@
DO ji = fs_2, fs_jpim1 ! vector opt.
ua(ji,jj,jpkm1) = ua(ji,jj,jpkm1) / zwd(ji,jj,jpkm1)
- DO jk = jpk-2, miku(ji,jj), -1
+ END DO
+ END DO
+ DO jk = jpk-2, 1, -1
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1
ua(ji,jj,jk) = ( ua(ji,jj,jk) - zws(ji,jj,jk) * ua(ji,jj,jk+1) ) / zwd(ji,jj,jk)
END DO
@@ -260,8 +280,8 @@
zcoef = - p2dt / ze3va
zzwi = zcoef * avmv (ji,jj,jk ) / fse3vw(ji,jj,jk )
- zwi(ji,jj,jk) = zzwi * vmask(ji,jj,jk)
+ zwi(ji,jj,jk) = zzwi * wvmask(ji,jj,jk)
zzws = zcoef * avmv (ji,jj,jk+1) / fse3vw(ji,jj,jk+1)
- zws(ji,jj,jk) = zzws * vmask(ji,jj,jk+1)
- zwd(ji,jj,jk) = 1._wp - zwi(ji,jj,jk) - zzws
+ zws(ji,jj,jk) = zzws * wvmask(ji,jj,jk+1)
+ zwd(ji,jj,jk) = 1._wp - zzwi - zzws
END DO
END DO
@@ -290,7 +310,7 @@
!
!== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) ==
- DO jj = 2, jpjm1
- DO ji = fs_2, fs_jpim1 ! vector opt.
- DO jk = mikv(ji,jj)+1, jpkm1
+ DO jk = 2, jpkm1
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1)
END DO
@@ -300,14 +320,18 @@
DO jj = 2, jpjm1 !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 ==
DO ji = fs_2, fs_jpim1 ! vector opt.
- ze3va = ( 1._wp - r_vvl ) * fse3v_n(ji,jj,mikv(ji,jj)) + r_vvl * fse3v_a(ji,jj,mikv(ji,jj))
#if defined key_dynspg_ts
- va(ji,jj,mikv(ji,jj)) = va(ji,jj,mikv(ji,jj)) + p2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) &
+ ze3va = ( 1._wp - r_vvl ) * fse3v_n(ji,jj,1) + r_vvl * fse3v_a(ji,jj,1)
+ va(ji,jj,1) = va(ji,jj,1) + p2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) &
& / ( ze3va * rau0 )
#else
- va(ji,jj,mikv(ji,jj)) = vb(ji,jj,mikv(ji,jj)) &
- & + p2dt *(va(ji,jj,mikv(ji,jj)) + 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) &
- & / ( fse3v(ji,jj,mikv(ji,jj)) * rau0 ) )
-#endif
- DO jk = mikv(ji,jj)+1, jpkm1
+ va(ji,jj,1) = vb(ji,jj,1) &
+ & + p2dt *(va(ji,jj,1) + 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) &
+ & / ( fse3v(ji,jj,1) * rau0 ) )
+#endif
+ END DO
+ END DO
+ DO jk = 2, jpkm1
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
#if defined key_dynspg_ts
zrhs = va(ji,jj,jk) ! zrhs=right hand side
@@ -323,5 +347,9 @@
DO ji = fs_2, fs_jpim1 ! vector opt.
va(ji,jj,jpkm1) = va(ji,jj,jpkm1) / zwd(ji,jj,jpkm1)
- DO jk = jpk-2, mikv(ji,jj), -1
+ END DO
+ END DO
+ DO jk = jpk-2, 1, -1
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1
va(ji,jj,jk) = ( va(ji,jj,jk) - zws(ji,jj,jk) * va(ji,jj,jk+1) ) / zwd(ji,jj,jk)
END DO
@@ -349,10 +377,16 @@
avmu(ji,jj,ikbu+1) = 0.e0
avmv(ji,jj,ikbv+1) = 0.e0
- ikbu = miku(ji,jj) ! ocean top level at u- and v-points
- ikbv = mikv(ji,jj) ! (first wet ocean u- and v-points)
- IF (ikbu > 1) avmu(ji,jj,ikbu) = 0.e0
- IF (ikbv > 1) avmv(ji,jj,ikbv) = 0.e0
END DO
END DO
+ IF (ln_isfcav) THEN
+ DO jj = 2, jpjm1
+ DO ji = 2, jpim1
+ ikbu = miku(ji,jj) ! ocean top level at u- and v-points
+ ikbv = mikv(ji,jj) ! (first wet ocean u- and v-points)
+ IF (ikbu > 1) avmu(ji,jj,ikbu) = 0.e0
+ IF (ikbv > 1) avmv(ji,jj,ikbv) = 0.e0
+ END DO
+ END DO
+ END IF
ENDIF
!
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90 (revision 5602)
@@ -21,5 +21,4 @@
USE domvvl ! Variable volume
USE divcur ! hor. divergence and curl (div & cur routines)
- USE iom ! I/O library
USE restart ! only for lrst_oce
USE in_out_manager ! I/O manager
@@ -31,5 +30,4 @@
USE bdy_par
USE bdydyn2d ! bdy_ssh routine
- USE iom
#if defined key_agrif
USE agrif_opa_update
@@ -137,6 +135,4 @@
! ! outputs !
! !------------------------------!
- CALL iom_put( "ssh" , sshn ) ! sea surface height
- if( iom_use('ssh2') ) CALL iom_put( "ssh2", sshn(:,:) * sshn(:,:) ) ! square of sea surface height
!
IF(ln_ctl) CALL prt_ctl( tab2d_1=ssha, clinfo1=' ssha - : ', mask1=tmask, ovlap=1 )
@@ -228,22 +224,4 @@
#endif
!
- ! !------------------------------!
- ! ! outputs !
- ! !------------------------------!
- CALL iom_put( "woce", wn ) ! vertical velocity
- IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN ! vertical mass transport & its square value
- CALL wrk_alloc( jpi, jpj, z2d )
- CALL wrk_alloc( jpi, jpj, jpk, z3d )
- ! Caution: in the VVL case, it only correponds to the baroclinic mass transport.
- z2d(:,:) = rau0 * e12t(:,:)
- DO jk = 1, jpk
- z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:)
- END DO
- CALL iom_put( "w_masstr" , z3d )
- IF( iom_use('w_masstr2') ) CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) )
- CALL wrk_dealloc( jpi, jpj, z2d )
- CALL wrk_dealloc( jpi, jpj, jpk, z3d )
- ENDIF
- !
IF( nn_timing == 1 ) CALL timing_stop('wzv')
@@ -290,5 +268,5 @@
ELSE !** Leap-Frog time-stepping: Asselin filter + swap
sshb(:,:) = sshn(:,:) + atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:) ) ! before <-- now filtered
- IF( lk_vvl ) sshb(:,:) = sshb(:,:) - atfp * rdt / rau0 * ( emp_b(:,:) - emp(:,:) ) * ssmask(:,:)
+ IF( lk_vvl ) sshb(:,:) = sshb(:,:) - atfp * rdt / rau0 * ( emp_b(:,:) - emp(:,:) - rnf_b(:,:) + rnf(:,:) ) * ssmask(:,:)
sshn(:,:) = ssha(:,:) ! now <-- after
ENDIF
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/FLO/florst.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/FLO/florst.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/FLO/florst.F90 (revision 5602)
@@ -36,5 +36,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.2 , LODYC-IPSL (2009)
- !! $Header:
+ !! $Id$
!! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90 (revision 5602)
@@ -50,5 +50,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.2 , LODYC-IPSL (2009)
- !! $Header:
+ !! $Id$
!! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ICB/icb_oce.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ICB/icb_oce.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ICB/icb_oce.F90 (revision 5602)
@@ -146,5 +146,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2011)
- !! $Id: sbc_oce.F90 3340 2012-04-02 11:05:35Z sga $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ICB/icbclv.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ICB/icbclv.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ICB/icbclv.F90 (revision 5602)
@@ -33,5 +33,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2011)
- !! $Id:$
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ICB/icbdia.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ICB/icbdia.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ICB/icbdia.F90 (revision 5602)
@@ -76,5 +76,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2011)
- !! $Id:$
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ICB/icbdyn.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ICB/icbdyn.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ICB/icbdyn.F90 (revision 5602)
@@ -28,5 +28,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2011)
- !! $Id:$
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ICB/icbini.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ICB/icbini.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ICB/icbini.F90 (revision 5602)
@@ -41,5 +41,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2011)
- !! $Id:$
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ICB/icblbc.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ICB/icblbc.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ICB/icblbc.F90 (revision 5602)
@@ -67,5 +67,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2011)
- !! $Id:$
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ICB/icbrst.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ICB/icbrst.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ICB/icbrst.F90 (revision 5602)
@@ -42,5 +42,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2011)
- !! $Id:$
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
@@ -64,4 +64,5 @@
! start and count arrays
LOGICAL :: ll_found_restart
+ CHARACTER(len=256) :: cl_path
CHARACTER(len=256) :: cl_filename
CHARACTER(len=NF90_MAX_NAME) :: cl_dname
@@ -70,13 +71,15 @@
!!----------------------------------------------------------------------
- ! Find a restart file
+ ! Find a restart file. Assume iceberg restarts in same directory as ocean restarts.
+ cl_path = TRIM(cn_ocerst_indir)
+ IF( cl_path(LEN_TRIM(cl_path):) /= '/' ) cl_path = TRIM(cl_path) // '/'
cl_filename = ' '
IF ( lk_mpp ) THEN
cl_filename = ' '
WRITE( cl_filename, '("restart_icebergs_",I4.4,".nc")' ) narea-1
- INQUIRE( file=TRIM(cl_filename), exist=ll_found_restart )
+ INQUIRE( file=TRIM(cl_path)//TRIM(cl_filename), exist=ll_found_restart )
ELSE
cl_filename = 'restart_icebergs.nc'
- INQUIRE( file=TRIM(cl_filename), exist=ll_found_restart )
+ INQUIRE( file=TRIM(cl_path)//TRIM(cl_filename), exist=ll_found_restart )
ENDIF
@@ -86,7 +89,7 @@
IF (nn_verbose_level >= 0 .AND. lwp) &
- WRITE(numout,'(2a)') 'icebergs, read_restart_bergs: found restart file = ',TRIM(cl_filename)
-
- nret = NF90_OPEN(TRIM(cl_filename), NF90_NOWRITE, ncid)
+ WRITE(numout,'(2a)') 'icebergs, read_restart_bergs: found restart file = ',TRIM(cl_path)//TRIM(cl_filename)
+
+ nret = NF90_OPEN(TRIM(cl_path)//TRIM(cl_filename), NF90_NOWRITE, ncid)
IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, read_restart_bergs: nf_open failed')
@@ -228,4 +231,5 @@
INTEGER :: jn ! dummy loop index
INTEGER :: ix_dim, iy_dim, ik_dim, in_dim
+ CHARACTER(len=256) :: cl_path
CHARACTER(len=256) :: cl_filename
TYPE(iceberg), POINTER :: this
@@ -233,12 +237,15 @@
!!----------------------------------------------------------------------
+ ! Assume we write iceberg restarts to same directory as ocean restarts.
+ cl_path = TRIM(cn_ocerst_outdir)
+ IF( cl_path(LEN_TRIM(cl_path):) /= '/' ) cl_path = TRIM(cl_path) // '/'
IF( lk_mpp ) THEN
- WRITE(cl_filename,'("icebergs_",I8.8,"_restart_",I4.4,".nc")') kt, narea-1
+ WRITE(cl_filename,'(A,"_icebergs_",I8.8,"_restart_",I4.4,".nc")') TRIM(cexper), kt, narea-1
ELSE
- WRITE(cl_filename,'("icebergs_",I8.8,"_restart.nc")') kt
- ENDIF
- IF (nn_verbose_level >= 0) WRITE(numout,'(2a)') 'icebergs, write_restart: creating ',TRIM(cl_filename)
-
- nret = NF90_CREATE(TRIM(cl_filename), NF90_CLOBBER, ncid)
+ WRITE(cl_filename,'(A,"_icebergs_",I8.8,"_restart.nc")') TRIM(cexper), kt
+ ENDIF
+ IF (nn_verbose_level >= 0) WRITE(numout,'(2a)') 'icebergs, write_restart: creating ',TRIM(cl_path)//TRIM(cl_filename)
+
+ nret = NF90_CREATE(TRIM(cl_path)//TRIM(cl_filename), NF90_CLOBBER, ncid)
IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_create failed')
@@ -372,5 +379,5 @@
ENDIF
ENDDO
- IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_filename),' var: stored_ice written'
+ IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_path)//TRIM(cl_filename),' var: stored_ice written'
nret = NF90_PUT_VAR( ncid, nkountid, num_bergs(:) )
@@ -379,5 +386,5 @@
nret = NF90_PUT_VAR( ncid, nsheatid, berg_grid%stored_heat(:,:) )
IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_put_var stored_heat failed')
- IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_filename),' var: stored_heat written'
+ IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_path)//TRIM(cl_filename),' var: stored_heat written'
nret = NF90_PUT_VAR( ncid, ncalvid , src_calving(:,:) )
@@ -385,5 +392,5 @@
nret = NF90_PUT_VAR( ncid, ncalvhid, src_calving_hflx(:,:) )
IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_put_var calving_hflx failed')
- IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_filename),' var: calving written'
+ IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_path)//TRIM(cl_filename),' var: calving written'
IF ( ASSOCIATED(first_berg) ) THEN
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ICB/icbstp.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ICB/icbstp.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ICB/icbstp.F90 (revision 5602)
@@ -46,5 +46,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2011)
- !! $Id:$
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ICB/icbthm.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ICB/icbthm.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ICB/icbthm.F90 (revision 5602)
@@ -31,4 +31,5 @@
PUBLIC icb_thm ! routine called in icbstp.F90 module
+ !! $Id$
CONTAINS
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ICB/icbtrj.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ICB/icbtrj.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ICB/icbtrj.F90 (revision 5602)
@@ -44,5 +44,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2011)
- !! $Id:$
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ICB/icbutl.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ICB/icbutl.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ICB/icbutl.F90 (revision 5602)
@@ -51,5 +51,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2011)
- !! $Id:$
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!-------------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90 (revision 5602)
@@ -26,6 +26,9 @@
CHARACTER(lc) :: cn_exp !: experiment name used for output filename
CHARACTER(lc) :: cn_ocerst_in !: suffix of ocean restart name (input)
+ CHARACTER(lc) :: cn_ocerst_indir !: restart input directory
CHARACTER(lc) :: cn_ocerst_out !: suffix of ocean restart name (output)
+ CHARACTER(lc) :: cn_ocerst_outdir !: restart output directory
LOGICAL :: ln_rstart !: start from (F) rest or (T) a restart file
+ LOGICAL :: ln_rst_list !: output restarts at list of times (T) or by frequency (F)
INTEGER :: nn_no !: job number
INTEGER :: nn_rstctl !: control of the time step (0, 1 or 2)
@@ -38,7 +41,9 @@
INTEGER :: nn_write !: model standard output frequency
INTEGER :: nn_stock !: restart file frequency
+ INTEGER, DIMENSION(10) :: nn_stocklist !: restart dump times
LOGICAL :: ln_dimgnnn !: type of dimgout. (F): 1 file for all proc
!: (T): 1 file per proc
LOGICAL :: ln_mskland !: mask land points in NetCDF outputs (costly: + ~15%)
+ LOGICAL :: ln_cfmeta !: output additional data to netCDF files required for compliance with the CF metadata standard
LOGICAL :: ln_clobber !: clobber (overwrite) an existing file
INTEGER :: nn_chunksz !: chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
@@ -78,4 +83,5 @@
INTEGER :: nwrite !: model standard output frequency
INTEGER :: nstock !: restart file frequency
+ INTEGER, DIMENSION(10) :: nstocklist !: restart dump times
!!----------------------------------------------------------------------
@@ -84,5 +90,7 @@
INTEGER :: nitrst !: time step at which restart file should be written
LOGICAL :: lrst_oce !: logical to control the oce restart write
- INTEGER :: numror, numrow !: logical unit for cean restart (read and write)
+ INTEGER :: numror = 0 !: logical unit for ocean restart (read). Init to 0 is needed for SAS (in daymod.F90)
+ INTEGER :: numrow !: logical unit for ocean restart (write)
+ INTEGER :: nrst_lst !: number of restart to output next
!!----------------------------------------------------------------------
@@ -142,4 +150,5 @@
LOGICAL :: lwp = .FALSE. !: boolean : true on the 1st processor only .OR. ln_ctl
LOGICAL :: lsp_area = .TRUE. !: to make a control print over a specific area
+ CHARACTER(lc) :: cxios_context !: context name used in xios
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90 (revision 5602)
@@ -38,5 +38,5 @@
USE icb_oce, ONLY : nclasses, class_num ! !: iceberg classes
#if defined key_lim3
- USE par_ice
+ USE ice , ONLY : jpl
#elif defined key_lim2
USE par_ice_2
@@ -66,5 +66,5 @@
#if defined key_iomput
PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_get_file_attr, iom_set_grid_attr
- PRIVATE set_grid, set_scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate
+ PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate
# endif
@@ -103,13 +103,13 @@
CHARACTER(len=10) :: clname
INTEGER :: ji
- !!----------------------------------------------------------------------
+ !
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_bnds
+ !!----------------------------------------------------------------------
+
+ ALLOCATE( z_bnds(jpk,2) )
clname = cdname
IF( TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(cdname)
-# if defined key_mpp_mpi
CALL xios_context_initialize(TRIM(clname), mpi_comm_opa)
-# else
- CALL xios_context_initialize(TRIM(clname), 0)
-# endif
CALL iom_swap( cdname )
@@ -126,12 +126,24 @@
CALL set_scalar
- IF( TRIM(cdname) == "nemo" ) THEN
+ IF( TRIM(cdname) == TRIM(cxios_context) ) THEN
CALL set_grid( "T", glamt, gphit )
CALL set_grid( "U", glamu, gphiu )
CALL set_grid( "V", glamv, gphiv )
CALL set_grid( "W", glamt, gphit )
- ENDIF
-
- IF( TRIM(cdname) == "nemo_crs" ) THEN
+ CALL set_grid_znl( gphit )
+ !
+ IF( ln_cfmeta ) THEN ! Add additional grid metadata
+ CALL iom_set_domain_attr("grid_T", area = e12t(nldi:nlei, nldj:nlej))
+ CALL iom_set_domain_attr("grid_U", area = e12u(nldi:nlei, nldj:nlej))
+ CALL iom_set_domain_attr("grid_V", area = e12v(nldi:nlei, nldj:nlej))
+ CALL iom_set_domain_attr("grid_W", area = e12t(nldi:nlei, nldj:nlej))
+ CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit )
+ CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu )
+ CALL set_grid_bounds( "V", glamu, gphiu, glamv, gphiv )
+ CALL set_grid_bounds( "W", glamf, gphif, glamt, gphit )
+ ENDIF
+ ENDIF
+
+ IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN
CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain
!
@@ -140,8 +152,19 @@
CALL set_grid( "V", glamv_crs, gphiv_crs )
CALL set_grid( "W", glamt_crs, gphit_crs )
+ CALL set_grid_znl( gphit_crs )
!
CALL dom_grid_glo ! Return to parent grid domain
- ENDIF
-
+ !
+ IF( ln_cfmeta ) THEN ! Add additional grid metadata
+ CALL iom_set_domain_attr("grid_T", area = e1e2t_crs(nldi:nlei, nldj:nlej))
+ CALL iom_set_domain_attr("grid_U", area = e1u_crs(nldi:nlei, nldj:nlej) * e2u_crs(nldi:nlei, nldj:nlej))
+ CALL iom_set_domain_attr("grid_V", area = e1v_crs(nldi:nlei, nldj:nlej) * e2v_crs(nldi:nlei, nldj:nlej))
+ CALL iom_set_domain_attr("grid_W", area = e1e2t_crs(nldi:nlei, nldj:nlej))
+ CALL set_grid_bounds( "T", glamf_crs, gphif_crs, glamt_crs, gphit_crs )
+ CALL set_grid_bounds( "U", glamv_crs, gphiv_crs, glamu_crs, gphiu_crs )
+ CALL set_grid_bounds( "V", glamu_crs, gphiu_crs, glamv_crs, gphiv_crs )
+ CALL set_grid_bounds( "W", glamf_crs, gphif_crs, glamt_crs, gphit_crs )
+ ENDIF
+ ENDIF
! vertical grid definition
@@ -150,4 +173,17 @@
CALL iom_set_axis_attr( "depthv", gdept_1d )
CALL iom_set_axis_attr( "depthw", gdepw_1d )
+
+ ! Add vertical grid bounds
+ z_bnds(: ,1) = gdepw_1d(:)
+ z_bnds(1:jpkm1,2) = gdepw_1d(2:jpk)
+ z_bnds(jpk: ,2) = gdepw_1d(jpk) + e3t_1d(jpk)
+ CALL iom_set_axis_attr( "deptht", bounds=z_bnds )
+ CALL iom_set_axis_attr( "depthu", bounds=z_bnds )
+ CALL iom_set_axis_attr( "depthv", bounds=z_bnds )
+ z_bnds(: ,2) = gdept_1d(:)
+ z_bnds(2:jpk,1) = gdept_1d(1:jpkm1)
+ z_bnds(1 ,1) = gdept_1d(1) - e3w_1d(1)
+ CALL iom_set_axis_attr( "depthw", bounds=z_bnds )
+
# if defined key_floats
CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) )
@@ -157,4 +193,6 @@
#endif
CALL iom_set_axis_attr( "icbcla", class_num )
+ CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) )
+ CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) )
! automatic definitions of some of the xml attributs
@@ -167,4 +205,7 @@
CALL xios_update_calendar(0)
+
+ DEALLOCATE( z_bnds )
+
#endif
@@ -548,5 +589,5 @@
END SUBROUTINE iom_g1d
- SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )
+ SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr )
INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
INTEGER , INTENT(in ) :: kdom ! Type of domain to be read
@@ -556,12 +597,17 @@
INTEGER , INTENT(in ), DIMENSION(2) , OPTIONAL :: kstart ! start axis position of the reading
INTEGER , INTENT(in ), DIMENSION(2) , OPTIONAL :: kcount ! number of points in each axis
+ LOGICAL , INTENT(in ) , OPTIONAL :: lrowattr ! logical flag telling iom_get to
+ ! look for and use a file attribute
+ ! called open_ocean_jstart to set the start
+ ! value for the 2nd dimension (netcdf only)
!
IF( kiomid > 0 ) THEN
IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r2d=pvar, &
- & ktime=ktime, kstart=kstart, kcount=kcount )
+ & ktime=ktime, kstart=kstart, kcount=kcount, &
+ & lrowattr=lrowattr )
ENDIF
END SUBROUTINE iom_g2d
- SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )
+ SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr )
INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
INTEGER , INTENT(in ) :: kdom ! Type of domain to be read
@@ -571,8 +617,13 @@
INTEGER , INTENT(in ), DIMENSION(3) , OPTIONAL :: kstart ! start axis position of the reading
INTEGER , INTENT(in ), DIMENSION(3) , OPTIONAL :: kcount ! number of points in each axis
+ LOGICAL , INTENT(in ) , OPTIONAL :: lrowattr ! logical flag telling iom_get to
+ ! look for and use a file attribute
+ ! called open_ocean_jstart to set the start
+ ! value for the 2nd dimension (netcdf only)
!
IF( kiomid > 0 ) THEN
IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r3d=pvar, &
- & ktime=ktime, kstart=kstart, kcount=kcount )
+ & ktime=ktime, kstart=kstart, kcount=kcount, &
+ & lrowattr=lrowattr )
ENDIF
END SUBROUTINE iom_g3d
@@ -581,5 +632,6 @@
SUBROUTINE iom_get_123d( kiomid, kdom , cdvar , &
& pv_r1d, pv_r2d, pv_r3d, &
- & ktime , kstart, kcount )
+ & ktime , kstart, kcount, &
+ & lrowattr )
!!-----------------------------------------------------------------------
!! *** ROUTINE iom_get_123d ***
@@ -598,6 +650,12 @@
INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kstart ! start position of the reading in each axis
INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kcount ! number of points to be read in each axis
+ LOGICAL , INTENT(in ), OPTIONAL :: lrowattr ! logical flag telling iom_get to
+ ! look for and use a file attribute
+ ! called open_ocean_jstart to set the start
+ ! value for the 2nd dimension (netcdf only)
!
LOGICAL :: llnoov ! local definition to read overlap
+ LOGICAL :: luse_jattr ! local definition to read open_ocean_jstart file attribute
+ INTEGER :: jstartrow ! start point for 2nd dimension optionally set by file attribute
INTEGER :: jl ! loop on number of dimension
INTEGER :: idom ! type of domain
@@ -609,5 +667,5 @@
INTEGER :: ix1, ix2, iy1, iy2 ! subdomain indexes
INTEGER :: ji, jj ! loop counters
- INTEGER :: irankpv !
+ INTEGER :: irankpv !
INTEGER :: ind1, ind2 ! substring index
INTEGER, DIMENSION(jpmax_dims) :: istart ! starting point to read for each axis
@@ -633,4 +691,21 @@
IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present')
IF( PRESENT(kstart) .AND. idom /= jpdom_unknown ) CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown')
+
+ luse_jattr = .false.
+ IF( PRESENT(lrowattr) ) THEN
+ IF( lrowattr .AND. idom /= jpdom_data ) CALL ctl_stop(trim(clinfo), 'lrowattr present and true needs kdom = jpdom_data')
+ IF( lrowattr .AND. idom == jpdom_data ) luse_jattr = .true.
+ ENDIF
+ IF( luse_jattr ) THEN
+ SELECT CASE (iom_file(kiomid)%iolib)
+ CASE (jpioipsl, jprstdimg )
+ CALL ctl_warn(trim(clinfo), 'lrowattr present and true but this only works with netcdf (jpnf90)')
+ luse_jattr = .false.
+ CASE (jpnf90 )
+ ! Ok
+ CASE DEFAULT
+ CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+ END SELECT
+ ENDIF
! Search for the variable in the data base (eventually actualize data)
@@ -706,6 +781,12 @@
ELSE
IF( .NOT. PRESENT(pv_r1d) ) THEN ! not a 1D array
- IF( idom == jpdom_data ) THEN ; istart(1:2) = (/ mig(1), mjg(1) /) ! icnt(1:2) done bellow
- ELSEIF( idom == jpdom_global ) THEN ; istart(1:2) = (/ nimpp , njmpp /) ! icnt(1:2) done bellow
+ IF( idom == jpdom_data ) THEN
+ jstartrow = 1
+ IF( luse_jattr ) THEN
+ CALL iom_getatt(kiomid, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found
+ jstartrow = MAX(1,jstartrow)
+ ENDIF
+ istart(1:2) = (/ mig(1), mjg(1) + jstartrow - 1 /) ! icnt(1:2) done below
+ ELSEIF( idom == jpdom_global ) THEN ; istart(1:2) = (/ nimpp , njmpp /) ! icnt(1:2) done below
ENDIF
! we do not read the overlap -> we start to read at nldi, nldj
@@ -1072,11 +1153,13 @@
SUBROUTINE iom_set_domain_attr( cdid, ni_glo, nj_glo, ibegin, jbegin, ni, nj, zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, &
- & data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask )
- CHARACTER(LEN=*) , INTENT(in) :: cdid
- INTEGER , OPTIONAL, INTENT(in) :: ni_glo, nj_glo, ibegin, jbegin, ni, nj
- INTEGER , OPTIONAL, INTENT(in) :: data_dim, data_ibegin, data_ni, data_jbegin, data_nj
- INTEGER , OPTIONAL, INTENT(in) :: zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj
- REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: lonvalue, latvalue
- LOGICAL, DIMENSION(:,:), OPTIONAL, INTENT(in) :: mask
+ & data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask, &
+ & nvertex, bounds_lon, bounds_lat, area )
+ CHARACTER(LEN=*) , INTENT(in) :: cdid
+ INTEGER , OPTIONAL, INTENT(in) :: ni_glo, nj_glo, ibegin, jbegin, ni, nj
+ INTEGER , OPTIONAL, INTENT(in) :: data_dim, data_ibegin, data_ni, data_jbegin, data_nj
+ INTEGER , OPTIONAL, INTENT(in) :: zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, nvertex
+ REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: lonvalue, latvalue
+ REAL(wp), DIMENSION(:,:) , OPTIONAL, INTENT(in) :: bounds_lon, bounds_lat, area
+ LOGICAL, DIMENSION(:,:) , OPTIONAL, INTENT(in) :: mask
IF ( xios_is_valid_domain (cdid) ) THEN
@@ -1084,5 +1167,6 @@
& data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , &
& zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj, &
- & lonvalue=lonvalue, latvalue=latvalue,mask=mask )
+ & lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon, &
+ & bounds_lat=bounds_lat, area=area )
ENDIF
@@ -1091,5 +1175,6 @@
& data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , &
& zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj, &
- & lonvalue=lonvalue, latvalue=latvalue,mask=mask )
+ & lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon, &
+ & bounds_lat=bounds_lat, area=area )
ENDIF
CALL xios_solve_inheritance()
@@ -1098,9 +1183,14 @@
- SUBROUTINE iom_set_axis_attr( cdid, paxis )
+ SUBROUTINE iom_set_axis_attr( cdid, paxis, bounds )
CHARACTER(LEN=*) , INTENT(in) :: cdid
- REAL(wp), DIMENSION(:), INTENT(in) :: paxis
- IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, size=size(paxis),value=paxis )
- IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, size=size(paxis),value=paxis )
+ REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: paxis
+ REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) :: bounds
+ IF ( PRESENT(paxis) ) THEN
+ IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, size=SIZE(paxis), value=paxis )
+ IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, size=SIZE(paxis), value=paxis )
+ ENDIF
+ IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, bounds=bounds )
+ IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, bounds=bounds )
CALL xios_solve_inheritance()
END SUBROUTINE iom_set_axis_attr
@@ -1165,5 +1255,5 @@
CALL iom_swap( cdname ) ! swap to cdname context
CALL xios_update_calendar(kt)
- IF( cdname /= "nemo" ) CALL iom_swap( "nemo" ) ! return back to nemo context
+ IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) ) ! return back to nemo context
!
END SUBROUTINE iom_setkt
@@ -1175,5 +1265,5 @@
CALL iom_swap( cdname ) ! swap to cdname context
CALL xios_context_finalize() ! finalize the context
- IF( cdname /= "nemo" ) CALL iom_swap( "nemo" ) ! return back to nemo context
+ IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) ) ! return back to nemo context
ENDIF
!
@@ -1207,5 +1297,5 @@
CASE('T') ; zmask(:,:,:) = tmask(:,:,:)
CASE('U') ; zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:) ; CALL lbc_lnk( zmask, 'U', 1. )
- CASE('V') ; zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpi,:) ; CALL lbc_lnk( zmask, 'V', 1. )
+ CASE('V') ; zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:) ; CALL lbc_lnk( zmask, 'V', 1. )
CASE('W') ; zmask(:,:,2:jpk ) = tmask(:,:,1:jpkm1) + tmask(:,:,2:jpk) ; zmask(:,:,1) = tmask(:,:,1)
END SELECT
@@ -1218,4 +1308,142 @@
+ SUBROUTINE set_grid_bounds( cdgrd, plon_cnr, plat_cnr, plon_pnt, plat_pnt )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE set_grid_bounds ***
+ !!
+ !! ** Purpose : define horizontal grid corners
+ !!
+ !!----------------------------------------------------------------------
+ CHARACTER(LEN=1) , INTENT(in) :: cdgrd
+ !
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plon_cnr, plat_cnr ! Lat/lon coordinates of a contiguous vertex of cell (i,j)
+ REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt ! Lat/lon coordinates of the point of cell (i,j)
+ !
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z_bnds ! Lat/lon coordinates of the vertices of cell (i,j)
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_fld ! Working array to determine where to rotate cells
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_rot ! Lat/lon working array for rotation of cells
+ !
+ INTEGER :: icnr, jcnr ! Offset such that the vertex coordinate (i+icnr,j+jcnr)
+ ! ! represents the bottom-left corner of cell (i,j)
+ INTEGER :: ji, jj, jn, ni, nj
+
+ ALLOCATE( z_bnds(4,jpi,jpj,2), z_fld(jpi,jpj), z_rot(4,2) )
+
+ ! Offset of coordinate representing bottom-left corner
+ SELECT CASE ( TRIM(cdgrd) )
+ CASE ('T', 'W')
+ icnr = -1 ; jcnr = -1
+ CASE ('U')
+ icnr = 0 ; jcnr = -1
+ CASE ('V')
+ icnr = -1 ; jcnr = 0
+ END SELECT
+
+ ni = nlei-nldi+1 ; nj = nlej-nldj+1 ! Dimensions of subdomain interior
+
+ z_fld(:,:) = 1._wp
+ CALL lbc_lnk( z_fld, cdgrd, -1. ) ! Working array for location of northfold
+
+ ! Cell vertices that can be defined
+ DO jj = 2, jpjm1
+ DO ji = 2, jpim1
+ z_bnds(1,ji,jj,1) = plat_cnr(ji+icnr, jj+jcnr ) ! Bottom-left
+ z_bnds(2,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr ) ! Bottom-right
+ z_bnds(3,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right
+ z_bnds(4,ji,jj,1) = plat_cnr(ji+icnr, jj+jcnr+1) ! Top-left
+ z_bnds(1,ji,jj,2) = plon_cnr(ji+icnr, jj+jcnr ) ! Bottom-left
+ z_bnds(2,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr ) ! Bottom-right
+ z_bnds(3,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right
+ z_bnds(4,ji,jj,2) = plon_cnr(ji+icnr, jj+jcnr+1) ! Top-left
+ END DO
+ END DO
+
+ ! Cell vertices on boundries
+ DO jn = 1, 4
+ CALL lbc_lnk( z_bnds(jn,:,:,1), cdgrd, 1., pval=999._wp )
+ CALL lbc_lnk( z_bnds(jn,:,:,2), cdgrd, 1., pval=999._wp )
+ END DO
+
+ ! Zero-size cells at closed boundaries if cell points provided,
+ ! otherwise they are closed cells with unrealistic bounds
+ IF( PRESENT(plon_pnt) .AND. PRESENT(plat_pnt) ) THEN
+ IF( (nbondi == -1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN
+ DO jn = 1, 4 ! (West or jpni = 1), closed E-W
+ z_bnds(jn,1,:,1) = plat_pnt(1,:) ; z_bnds(jn,1,:,2) = plon_pnt(1,:)
+ END DO
+ ENDIF
+ IF( (nbondi == 1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN
+ DO jn = 1, 4 ! (East or jpni = 1), closed E-W
+ z_bnds(jn,nlci,:,1) = plat_pnt(nlci,:) ; z_bnds(jn,nlci,:,2) = plon_pnt(nlci,:)
+ END DO
+ ENDIF
+ IF( nbondj == -1 .OR. (nbondj == 2 .AND. jperio /= 2) ) THEN
+ DO jn = 1, 4 ! South or (jpnj = 1, not symmetric)
+ z_bnds(jn,:,1,1) = plat_pnt(:,1) ; z_bnds(jn,:,1,2) = plon_pnt(:,1)
+ END DO
+ ENDIF
+ IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio < 3 ) THEN
+ DO jn = 1, 4 ! (North or jpnj = 1), no north fold
+ z_bnds(jn,:,nlcj,1) = plat_pnt(:,nlcj) ; z_bnds(jn,:,nlcj,2) = plon_pnt(:,nlcj)
+ END DO
+ ENDIF
+ ENDIF
+
+ ! Rotate cells at the north fold
+ IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio >= 3 ) THEN
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ IF( z_fld(ji,jj) == -1. ) THEN
+ z_rot(1,:) = z_bnds(3,ji,jj,:) ; z_rot(2,:) = z_bnds(4,ji,jj,:)
+ z_rot(3,:) = z_bnds(1,ji,jj,:) ; z_rot(4,:) = z_bnds(2,ji,jj,:)
+ z_bnds(:,ji,jj,:) = z_rot(:,:)
+ ENDIF
+ END DO
+ END DO
+
+ ! Invert cells at the symmetric equator
+ ELSE IF( nbondj == 2 .AND. jperio == 2 ) THEN
+ DO ji = 1, jpi
+ z_rot(1:2,:) = z_bnds(3:4,ji,1,:)
+ z_rot(3:4,:) = z_bnds(1:2,ji,1,:)
+ z_bnds(:,ji,1,:) = z_rot(:,:)
+ END DO
+ ENDIF
+
+ CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,1),(/ 4,ni*nj /)), &
+ bounds_lon = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,2),(/ 4,ni*nj /)), nvertex=4 )
+
+ DEALLOCATE( z_bnds, z_fld, z_rot )
+
+ END SUBROUTINE set_grid_bounds
+
+
+ SUBROUTINE set_grid_znl( plat )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE set_grid_znl ***
+ !!
+ !! ** Purpose : define grids for zonal mean
+ !!
+ !!----------------------------------------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plat
+ !
+ REAL(wp), DIMENSION(:), ALLOCATABLE :: zlon
+ INTEGER :: ni,nj, ix, iy
+
+
+ ni=nlei-nldi+1 ; nj=nlej-nldj+1 ! define zonal mean domain (jpj*jpk)
+ ALLOCATE( zlon(ni*nj) ) ; zlon(:) = 0.
+
+ CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj)
+ CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)
+ CALL iom_set_domain_attr("gznl", lonvalue = zlon, &
+ & latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))
+ !
+ CALL dom_ngb( 180., 90., ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots)
+ CALL iom_set_domain_attr ('ptr', zoom_ibegin=ix, zoom_nj=jpjglo)
+ CALL iom_update_file_name('ptr')
+ !
+ END SUBROUTINE set_grid_znl
+
SUBROUTINE set_scalar
!!----------------------------------------------------------------------
@@ -1225,8 +1453,9 @@
!!
!!----------------------------------------------------------------------
- REAL(wp), DIMENSION(1) :: zz = 1.
+ REAL(wp), DIMENSION(1) :: zz = 1.
!!----------------------------------------------------------------------
CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea, jbegin=1, ni=1, nj=1)
CALL iom_set_domain_attr('scalarpoint', data_dim=2, data_ibegin = 1, data_ni = 1, data_jbegin = 1, data_nj = 1)
+
zz=REAL(narea,wp)
CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz)
@@ -1301,4 +1530,5 @@
zlatpira = (/ -19.0, -14.0, -8.0, 0.0, 4.0, 8.0, 12.0, 15.0, 20.0 /)
CALL set_mooring( zlonpira, zlatpira )
+
END SUBROUTINE set_xmlatt
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90 (revision 5602)
@@ -61,6 +61,6 @@
INTEGER, DIMENSION(2,5), INTENT(in ), OPTIONAL :: kdompar ! domain parameters:
- CHARACTER(LEN=100) :: clinfo ! info character
- CHARACTER(LEN=100) :: cltmp ! temporary character
+ CHARACTER(LEN=256) :: clinfo ! info character
+ CHARACTER(LEN=256) :: cltmp ! temporary character
INTEGER :: iln ! lengths of character
INTEGER :: istop ! temporary storage of nstop
@@ -393,5 +393,5 @@
INTEGER, DIMENSION(4) :: idimsz ! dimensions size
INTEGER, DIMENSION(4) :: idimid ! dimensions id
- CHARACTER(LEN=100) :: clinfo ! info character
+ CHARACTER(LEN=256) :: clinfo ! info character
CHARACTER(LEN= 12), DIMENSION(4) :: cltmp ! temporary character
INTEGER :: if90id ! nf90 file identifier
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90 (revision 5602)
@@ -164,10 +164,12 @@
ENDIF
- IF ( clinfo3 == 'tra' ) THEN
- zvctl1 = t_ctll(jn)
- zvctl2 = s_ctll(jn)
- ELSEIF ( clinfo3 == 'dyn' ) THEN
- zvctl1 = u_ctll(jn)
- zvctl2 = v_ctll(jn)
+ IF( PRESENT(clinfo3)) THEN
+ IF ( clinfo3 == 'tra' ) THEN
+ zvctl1 = t_ctll(jn)
+ zvctl2 = s_ctll(jn)
+ ELSEIF ( clinfo3 == 'dyn' ) THEN
+ zvctl1 = u_ctll(jn)
+ zvctl2 = v_ctll(jn)
+ ENDIF
ENDIF
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90 (revision 5602)
@@ -24,5 +24,4 @@
USE trdmxl_oce ! ocean active mixed layer tracers trends variables
USE divcur ! hor. divergence and curl (div & cur routines)
- USE sbc_ice, ONLY : lk_lim3
IMPLICIT NONE
@@ -57,12 +56,20 @@
!!
CHARACTER(LEN=20) :: clkt ! ocean time-step deine as a character
- CHARACTER(LEN=50) :: clname ! ice output restart file name
+ CHARACTER(LEN=50) :: clname ! ocean output restart file name
+ CHARACTER(lc) :: clpath ! full path to ocean output restart file
!!----------------------------------------------------------------------
!
IF( kt == nit000 ) THEN ! default definitions
lrst_oce = .FALSE.
- nitrst = nitend
- ENDIF
- IF( MOD( kt - 1, nstock ) == 0 ) THEN
+ IF( ln_rst_list ) THEN
+ nrst_lst = 1
+ nitrst = nstocklist( nrst_lst )
+ ELSE
+ nitrst = nitend
+ ENDIF
+ ENDIF
+
+ ! frequency-based restart dumping (nn_stock)
+ IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN
! we use kt - 1 and not kt - nit000 to keep the same periodicity from the beginning of the experiment
nitrst = kt + nstock - 1 ! define the next value of nitrst for restart writing
@@ -73,24 +80,30 @@
! except if we write ocean restart files every time step or if an ocean restart file was writen at nitend - 1
IF( kt == nitrst - 1 .OR. nstock == 1 .OR. ( kt == nitend .AND. .NOT. lrst_oce ) ) THEN
- ! beware of the format used to write kt (default is i8.8, that should be large enough...)
- IF( nitrst > 999999999 ) THEN ; WRITE(clkt, * ) nitrst
- ELSE ; WRITE(clkt, '(i8.8)') nitrst
- ENDIF
- ! create the file
- clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_ocerst_out)
- IF(lwp) THEN
- WRITE(numout,*)
- SELECT CASE ( jprstlib )
- CASE ( jprstdimg ) ; WRITE(numout,*) ' open ocean restart binary file: '//clname
- CASE DEFAULT ; WRITE(numout,*) ' open ocean restart NetCDF file: '//clname
- END SELECT
- IF ( snc4set%luse ) WRITE(numout,*) ' opened for NetCDF4 chunking and compression'
- IF( kt == nitrst - 1 ) THEN ; WRITE(numout,*) ' kt = nitrst - 1 = ', kt
- ELSE ; WRITE(numout,*) ' kt = ' , kt
+ IF( nitrst <= nitend .AND. nitrst > 0 ) THEN
+ ! beware of the format used to write kt (default is i8.8, that should be large enough...)
+ IF( nitrst > 999999999 ) THEN ; WRITE(clkt, * ) nitrst
+ ELSE ; WRITE(clkt, '(i8.8)') nitrst
ENDIF
- ENDIF
- !
- CALL iom_open( clname, numrow, ldwrt = .TRUE., kiolib = jprstlib )
- lrst_oce = .TRUE.
+ ! create the file
+ clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_ocerst_out)
+ clpath = TRIM(cn_ocerst_outdir)
+ IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
+ IF(lwp) THEN
+ WRITE(numout,*)
+ SELECT CASE ( jprstlib )
+ CASE ( jprstdimg ) ; WRITE(numout,*) &
+ ' open ocean restart binary file: ',TRIM(clpath)//clname
+ CASE DEFAULT ; WRITE(numout,*) &
+ ' open ocean restart NetCDF file: ',TRIM(clpath)//clname
+ END SELECT
+ IF ( snc4set%luse ) WRITE(numout,*) ' opened for NetCDF4 chunking and compression'
+ IF( kt == nitrst - 1 ) THEN ; WRITE(numout,*) ' kt = nitrst - 1 = ', kt
+ ELSE ; WRITE(numout,*) ' kt = ' , kt
+ ENDIF
+ ENDIF
+ !
+ CALL iom_open( TRIM(clpath)//TRIM(clname), numrow, ldwrt = .TRUE., kiolib = jprstlib )
+ lrst_oce = .TRUE.
+ ENDIF
ENDIF
!
@@ -120,6 +133,4 @@
CALL iom_rstput( kt, nitrst, numrow, 'hdivb' , hdivb )
CALL iom_rstput( kt, nitrst, numrow, 'sshb' , sshb )
- !
- IF( lk_lim3 ) CALL iom_rstput( kt, nitrst, numrow, 'fse3t_b', fse3t_b(:,:,:) )
!
CALL iom_rstput( kt, nitrst, numrow, 'un' , un ) ! now fields
@@ -134,7 +145,4 @@
CALL iom_rstput( kt, nitrst, numrow, 'rhd' , rhd )
#endif
- IF( lk_lim3 ) THEN
- CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev' , fraqsr_1lev ) !clem modif
- ENDIF
IF( kt == nitrst ) THEN
CALL iom_close( numrow ) ! close the restart file (only at last time step)
@@ -142,4 +150,9 @@
!!gm not sure what to do here ===>>> ask to Sebastian
lrst_oce = .FALSE.
+ IF( ln_rst_list ) THEN
+ nrst_lst = MIN(nrst_lst + 1, SIZE(nstocklist,1))
+ nitrst = nstocklist( nrst_lst )
+ ENDIF
+ lrst_oce = .FALSE.
ENDIF
!
@@ -156,6 +169,7 @@
!! the file has already been opened
!!----------------------------------------------------------------------
- INTEGER :: jlibalt = jprstlib
- LOGICAL :: llok
+ INTEGER :: jlibalt = jprstlib
+ LOGICAL :: llok
+ CHARACTER(lc) :: clpath ! full path to ocean output restart file
!!----------------------------------------------------------------------
!
@@ -171,11 +185,13 @@
ENDIF
+ clpath = TRIM(cn_ocerst_indir)
+ IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
IF ( jprstlib == jprstdimg ) THEN
! eventually read netcdf file (monobloc) for restarting on different number of processors
! if {cn_ocerst_in}.nc exists, then set jlibalt to jpnf90
- INQUIRE( FILE = TRIM(cn_ocerst_in)//'.nc', EXIST = llok )
+ INQUIRE( FILE = TRIM(cn_ocerst_indir)//'/'//TRIM(cn_ocerst_in)//'.nc', EXIST = llok )
IF ( llok ) THEN ; jlibalt = jpnf90 ; ELSE ; jlibalt = jprstlib ; ENDIF
ENDIF
- CALL iom_open( cn_ocerst_in, numror, kiolib = jlibalt )
+ CALL iom_open( TRIM(clpath)//cn_ocerst_in, numror, kiolib = jlibalt )
ENDIF
END SUBROUTINE rst_read_open
@@ -214,5 +230,4 @@
CALL iom_get( numror, jpdom_autoglo, 'hdivb' , hdivb )
CALL iom_get( numror, jpdom_autoglo, 'sshb' , sshb )
- IF( lk_lim3 ) CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) )
ELSE
neuler = 0
@@ -257,14 +272,4 @@
ENDIF
- IF( lk_lim3 .AND. .NOT. lk_vvl ) THEN
- DO jk = 1, jpk
- fse3t_b(:,:,jk) = fse3t_n(:,:,jk)
- END DO
- ENDIF
-
- ENDIF
- !
- IF( lk_lim3 ) THEN
- CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev' , fraqsr_1lev )
ENDIF
!
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90 (revision 5602)
@@ -22,4 +22,9 @@
USE lib_mpp ! distributed memory computing library
+
+ INTERFACE lbc_lnk_multi
+ MODULE PROCEDURE mpp_lnk_2d_9
+ END INTERFACE
+
INTERFACE lbc_lnk
MODULE PROCEDURE mpp_lnk_3d_gather, mpp_lnk_3d, mpp_lnk_2d
@@ -39,4 +44,5 @@
PUBLIC lbc_lnk ! ocean lateral boundary conditions
+ PUBLIC lbc_lnk_multi ! modified ocean lateral boundary conditions
PUBLIC lbc_lnk_e
PUBLIC lbc_bdy_lnk ! ocean lateral BDY boundary conditions
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90 (revision 5602)
@@ -71,4 +71,5 @@
PUBLIC mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc
PUBLIC mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e
+ PUBLIC mpp_lnk_2d_9
PUBLIC mppscatter, mppgather
PUBLIC mpp_ini_ice, mpp_ini_znl
@@ -78,4 +79,8 @@
PUBLIC mpp_lbc_north_icb, mpp_lnk_2d_icb
+ TYPE arrayptr
+ REAL , DIMENSION (:,:), POINTER :: pt2d
+ END TYPE arrayptr
+
!! * Interfaces
!! define generic interface for these routine as they are called sometimes
@@ -164,5 +169,5 @@
- FUNCTION mynode( ldtxt, kumnam_ref , kumnam_cfg , kumond , kstop, localComm )
+ FUNCTION mynode( ldtxt, ldname, kumnam_ref , kumnam_cfg , kumond , kstop, localComm )
!!----------------------------------------------------------------------
!! *** routine mynode ***
@@ -171,4 +176,5 @@
!!----------------------------------------------------------------------
CHARACTER(len=*),DIMENSION(:), INTENT( out) :: ldtxt
+ CHARACTER(len=*) , INTENT(in ) :: ldname
INTEGER , INTENT(in ) :: kumnam_ref ! logical unit for reference namelist
INTEGER , INTENT(in ) :: kumnam_cfg ! logical unit for configuration namelist
@@ -297,6 +303,6 @@
IF( mynode == 0 ) THEN
- CALL ctl_opn( kumond, 'output.namelist.dyn', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 )
- WRITE(kumond, nammpp)
+ CALL ctl_opn( kumond, TRIM(ldname), 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 )
+ WRITE(kumond, nammpp)
ENDIF
!
@@ -510,4 +516,290 @@
!
END SUBROUTINE mpp_lnk_3d
+
+ SUBROUTINE mpp_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields , cd_mpp, pval )
+ !!----------------------------------------------------------------------
+ !! *** routine mpp_lnk_2d_multiple ***
+ !!
+ !! ** Purpose : Message passing management for multiple 2d arrays
+ !!
+ !! ** Method : Use mppsend and mpprecv function for passing mask
+ !! between processors following neighboring subdomains.
+ !! domain parameters
+ !! nlci : first dimension of the local subdomain
+ !! nlcj : second dimension of the local subdomain
+ !! nbondi : mark for "east-west local boundary"
+ !! nbondj : mark for "north-south local boundary"
+ !! noea : number for local neighboring processors
+ !! nowe : number for local neighboring processors
+ !! noso : number for local neighboring processors
+ !! nono : number for local neighboring processors
+ !!
+ !!----------------------------------------------------------------------
+
+ INTEGER :: num_fields
+ TYPE( arrayptr ), DIMENSION(:) :: pt2d_array
+ CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: type_array ! define the nature of ptab array grid-points
+ ! ! = T , U , V , F , W and I points
+ REAL(wp) , DIMENSION(:), INTENT(in ) :: psgn_array ! =-1 the sign change across the north fold boundary
+ ! ! = 1. , the sign is kept
+ CHARACTER(len=3), OPTIONAL , INTENT(in ) :: cd_mpp ! fill the overlap area only
+ REAL(wp) , OPTIONAL , INTENT(in ) :: pval ! background value (used at closed boundaries)
+ !!
+ INTEGER :: ji, jj, jl ! dummy loop indices
+ INTEGER :: ii !!MULTI SEND DUMMY LOOP INDICES
+ INTEGER :: imigr, iihom, ijhom ! temporary integers
+ INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend
+
+ REAL(wp) :: zland
+ INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend
+ !
+ REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ns, zt2sn ! 2d for north-south & south-north
+ REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ew, zt2we ! 2d for east-west & west-east
+
+ !!----------------------------------------------------------------------
+
+ ALLOCATE( zt2ns(jpi,jprecj,2*num_fields), zt2sn(jpi,jprecj,2*num_fields), &
+ & zt2ew(jpj,jpreci,2*num_fields), zt2we(jpj,jpreci,2*num_fields) )
+
+ !
+ IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value
+ ELSE ; zland = 0.e0 ! zero by default
+ ENDIF
+
+ ! 1. standard boundary treatment
+ ! ------------------------------
+ !
+ !First Array
+ DO ii = 1 , num_fields
+ IF( PRESENT( cd_mpp ) ) THEN ! only fill added line/raw with existing values
+ !
+ ! WARNING pt2d is defined only between nld and nle
+ DO jj = nlcj+1, jpj ! added line(s) (inner only)
+ pt2d_array(ii)%pt2d(nldi :nlei , jj) = pt2d_array(ii)%pt2d(nldi:nlei, nlej)
+ pt2d_array(ii)%pt2d(1 :nldi-1, jj) = pt2d_array(ii)%pt2d(nldi , nlej)
+ pt2d_array(ii)%pt2d(nlei+1:nlci , jj) = pt2d_array(ii)%pt2d( nlei, nlej)
+ END DO
+ DO ji = nlci+1, jpi ! added column(s) (full)
+ pt2d_array(ii)%pt2d(ji, nldj :nlej ) = pt2d_array(ii)%pt2d(nlei, nldj:nlej)
+ pt2d_array(ii)%pt2d(ji, 1 :nldj-1) = pt2d_array(ii)%pt2d(nlei, nldj )
+ pt2d_array(ii)%pt2d(ji, nlej+1:jpj ) = pt2d_array(ii)%pt2d(nlei, nlej)
+ END DO
+ !
+ ELSE ! standard close or cyclic treatment
+ !
+ ! ! East-West boundaries
+ IF( nbondi == 2 .AND. & ! Cyclic east-west
+ & (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
+ pt2d_array(ii)%pt2d( 1 , : ) = pt2d_array(ii)%pt2d( jpim1, : ) ! west
+ pt2d_array(ii)%pt2d( jpi , : ) = pt2d_array(ii)%pt2d( 2 , : ) ! east
+ ELSE ! closed
+ IF( .NOT. type_array(ii) == 'F' ) pt2d_array(ii)%pt2d( 1 : jpreci,:) = zland ! south except F-point
+ pt2d_array(ii)%pt2d(nlci-jpreci+1 : jpi ,:) = zland ! north
+ ENDIF
+ ! ! North-South boundaries (always closed)
+ IF( .NOT. type_array(ii) == 'F' ) pt2d_array(ii)%pt2d(:, 1:jprecj ) = zland ! south except F-point
+ pt2d_array(ii)%pt2d(:, nlcj-jprecj+1:jpj ) = zland ! north
+ !
+ ENDIF
+ END DO
+
+ ! 2. East and west directions exchange
+ ! ------------------------------------
+ ! we play with the neigbours AND the row number because of the periodicity
+ !
+ DO ii = 1 , num_fields
+ SELECT CASE ( nbondi ) ! Read Dirichlet lateral conditions
+ CASE ( -1, 0, 1 ) ! all exept 2 (i.e. close case)
+ iihom = nlci-nreci
+ DO jl = 1, jpreci
+ zt2ew( : , jl , ii ) = pt2d_array(ii)%pt2d( jpreci+jl , : )
+ zt2we( : , jl , ii ) = pt2d_array(ii)%pt2d( iihom +jl , : )
+ END DO
+ END SELECT
+ END DO
+ !
+ ! ! Migrations
+ imigr = jpreci * jpj
+ !
+ SELECT CASE ( nbondi )
+ CASE ( -1 )
+ CALL mppsend( 2, zt2we(1,1,1), num_fields*imigr, noea, ml_req1 )
+ CALL mpprecv( 1, zt2ew(1,1,num_fields+1), num_fields*imigr, noea )
+ IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+ CASE ( 0 )
+ CALL mppsend( 1, zt2ew(1,1,1), num_fields*imigr, nowe, ml_req1 )
+ CALL mppsend( 2, zt2we(1,1,1), num_fields*imigr, noea, ml_req2 )
+ CALL mpprecv( 1, zt2ew(1,1,num_fields+1), num_fields*imigr, noea )
+ CALL mpprecv( 2, zt2we(1,1,num_fields+1), num_fields*imigr, nowe )
+ IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+ IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+ CASE ( 1 )
+ CALL mppsend( 1, zt2ew(1,1,1), num_fields*imigr, nowe, ml_req1 )
+ CALL mpprecv( 2, zt2we(1,1,num_fields+1), num_fields*imigr, nowe )
+ IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+ END SELECT
+ !
+ ! ! Write Dirichlet lateral conditions
+ iihom = nlci - jpreci
+ !
+
+ DO ii = 1 , num_fields
+ SELECT CASE ( nbondi )
+ CASE ( -1 )
+ DO jl = 1, jpreci
+ pt2d_array(ii)%pt2d( iihom+jl , : ) = zt2ew(:,jl,num_fields+ii)
+ END DO
+ CASE ( 0 )
+ DO jl = 1, jpreci
+ pt2d_array(ii)%pt2d( jl , : ) = zt2we(:,jl,num_fields+ii)
+ pt2d_array(ii)%pt2d( iihom+jl , : ) = zt2ew(:,jl,num_fields+ii)
+ END DO
+ CASE ( 1 )
+ DO jl = 1, jpreci
+ pt2d_array(ii)%pt2d( jl , : )= zt2we(:,jl,num_fields+ii)
+ END DO
+ END SELECT
+ END DO
+
+ ! 3. North and south directions
+ ! -----------------------------
+ ! always closed : we play only with the neigbours
+ !
+ !First Array
+ DO ii = 1 , num_fields
+ IF( nbondj /= 2 ) THEN ! Read Dirichlet lateral conditions
+ ijhom = nlcj-nrecj
+ DO jl = 1, jprecj
+ zt2sn(:,jl , ii) = pt2d_array(ii)%pt2d( : , ijhom +jl )
+ zt2ns(:,jl , ii) = pt2d_array(ii)%pt2d( : , jprecj+jl )
+ END DO
+ ENDIF
+ END DO
+ !
+ ! ! Migrations
+ imigr = jprecj * jpi
+ !
+ SELECT CASE ( nbondj )
+ CASE ( -1 )
+ CALL mppsend( 4, zt2sn(1,1,1), num_fields*imigr, nono, ml_req1 )
+ CALL mpprecv( 3, zt2ns(1,1,num_fields+1), num_fields*imigr, nono )
+ IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+ CASE ( 0 )
+ CALL mppsend( 3, zt2ns(1,1,1), num_fields*imigr, noso, ml_req1 )
+ CALL mppsend( 4, zt2sn(1,1,1), num_fields*imigr, nono, ml_req2 )
+ CALL mpprecv( 3, zt2ns(1,1,num_fields+1), num_fields*imigr, nono )
+ CALL mpprecv( 4, zt2sn(1,1,num_fields+1), num_fields*imigr, noso )
+ IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+ IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+ CASE ( 1 )
+ CALL mppsend( 3, zt2ns(1,1,1), num_fields*imigr, noso, ml_req1 )
+ CALL mpprecv( 4, zt2sn(1,1,num_fields+1), num_fields*imigr, noso )
+ IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+ END SELECT
+ !
+ ! ! Write Dirichlet lateral conditions
+ ijhom = nlcj - jprecj
+ !
+
+ DO ii = 1 , num_fields
+ !First Array
+ SELECT CASE ( nbondj )
+ CASE ( -1 )
+ DO jl = 1, jprecj
+ pt2d_array(ii)%pt2d( : , ijhom+jl ) = zt2ns( : , jl , num_fields+ii )
+ END DO
+ CASE ( 0 )
+ DO jl = 1, jprecj
+ pt2d_array(ii)%pt2d( : , jl ) = zt2sn( : , jl , num_fields + ii)
+ pt2d_array(ii)%pt2d( : , ijhom + jl ) = zt2ns( : , jl , num_fields + ii )
+ END DO
+ CASE ( 1 )
+ DO jl = 1, jprecj
+ pt2d_array(ii)%pt2d( : , jl ) = zt2sn( : , jl , num_fields + ii )
+ END DO
+ END SELECT
+ END DO
+
+ ! 4. north fold treatment
+ ! -----------------------
+ !
+ DO ii = 1 , num_fields
+ !First Array
+ IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
+ !
+ SELECT CASE ( jpni )
+ CASE ( 1 ) ; CALL lbc_nfd ( pt2d_array(ii)%pt2d( : , : ), type_array(ii) , psgn_array(ii) ) ! only 1 northern proc, no mpp
+ CASE DEFAULT ; CALL mpp_lbc_north( pt2d_array(ii)%pt2d( : , : ), type_array(ii), psgn_array(ii) ) ! for all northern procs.
+ END SELECT
+ !
+ ENDIF
+ !
+ END DO
+
+ DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we )
+ !
+ END SUBROUTINE mpp_lnk_2d_multiple
+
+
+ SUBROUTINE load_array(pt2d,cd_type,psgn,pt2d_array, type_array, psgn_array,num_fields)
+ !!---------------------------------------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj), TARGET , INTENT(inout) :: pt2d ! Second 2D array on which the boundary condition is applied
+ CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points
+ REAL(wp) , INTENT(in ) :: psgn ! =-1 the sign change across the north fold boundary
+ TYPE(arrayptr) , DIMENSION(9) :: pt2d_array
+ CHARACTER(len=1) , DIMENSION(9) :: type_array ! define the nature of ptab array grid-points
+ REAL(wp) , DIMENSION(9) :: psgn_array ! =-1 the sign change across the north fold boundary
+ INTEGER , INTENT (inout):: num_fields
+ !!---------------------------------------------------------------------
+ num_fields=num_fields+1
+ pt2d_array(num_fields)%pt2d=>pt2d
+ type_array(num_fields)=cd_type
+ psgn_array(num_fields)=psgn
+ END SUBROUTINE load_array
+
+
+ SUBROUTINE mpp_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC &
+ & , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF &
+ & , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval)
+ !!---------------------------------------------------------------------
+ ! Second 2D array on which the boundary condition is applied
+ REAL(wp), DIMENSION(jpi,jpj), TARGET , INTENT(inout) :: pt2dA
+ REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) :: pt2dB , pt2dC , pt2dD , pt2dE
+ REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) :: pt2dF , pt2dG , pt2dH , pt2dI
+ ! define the nature of ptab array grid-points
+ CHARACTER(len=1) , INTENT(in ) :: cd_typeA
+ CHARACTER(len=1) , OPTIONAL, INTENT(in ) :: cd_typeB , cd_typeC , cd_typeD , cd_typeE
+ CHARACTER(len=1) , OPTIONAL, INTENT(in ) :: cd_typeF , cd_typeG , cd_typeH , cd_typeI
+ ! =-1 the sign change across the north fold boundary
+ REAL(wp) , INTENT(in ) :: psgnA
+ REAL(wp) , OPTIONAL, INTENT(in ) :: psgnB , psgnC , psgnD , psgnE
+ REAL(wp) , OPTIONAL, INTENT(in ) :: psgnF , psgnG , psgnH , psgnI
+ CHARACTER(len=3) , OPTIONAL, INTENT(in ) :: cd_mpp ! fill the overlap area only
+ REAL(wp) , OPTIONAL, INTENT(in ) :: pval ! background value (used at closed boundaries)
+ !!
+ TYPE(arrayptr) , DIMENSION(9) :: pt2d_array
+ CHARACTER(len=1) , DIMENSION(9) :: type_array ! define the nature of ptab array grid-points
+ ! ! = T , U , V , F , W and I points
+ REAL(wp) , DIMENSION(9) :: psgn_array ! =-1 the sign change across the north fold boundary
+ INTEGER :: num_fields
+ !!---------------------------------------------------------------------
+
+ num_fields = 0
+
+ !! Load the first array
+ CALL load_array(pt2dA,cd_typeA,psgnA,pt2d_array, type_array, psgn_array,num_fields)
+
+ !! Look if more arrays are added
+ IF(PRESENT (psgnB) )CALL load_array(pt2dB,cd_typeB,psgnB,pt2d_array, type_array, psgn_array,num_fields)
+ IF(PRESENT (psgnC) )CALL load_array(pt2dC,cd_typeC,psgnC,pt2d_array, type_array, psgn_array,num_fields)
+ IF(PRESENT (psgnD) )CALL load_array(pt2dD,cd_typeD,psgnD,pt2d_array, type_array, psgn_array,num_fields)
+ IF(PRESENT (psgnE) )CALL load_array(pt2dE,cd_typeE,psgnE,pt2d_array, type_array, psgn_array,num_fields)
+ IF(PRESENT (psgnF) )CALL load_array(pt2dF,cd_typeF,psgnF,pt2d_array, type_array, psgn_array,num_fields)
+ IF(PRESENT (psgnG) )CALL load_array(pt2dG,cd_typeG,psgnG,pt2d_array, type_array, psgn_array,num_fields)
+ IF(PRESENT (psgnH) )CALL load_array(pt2dH,cd_typeH,psgnH,pt2d_array, type_array, psgn_array,num_fields)
+ IF(PRESENT (psgnI) )CALL load_array(pt2dI,cd_typeI,psgnI,pt2d_array, type_array, psgn_array,num_fields)
+
+ CALL mpp_lnk_2d_multiple(pt2d_array,type_array,psgn_array,num_fields,cd_mpp,pval)
+ END SUBROUTINE mpp_lnk_2d_9
@@ -3184,4 +3476,5 @@
LOGICAL, PUBLIC :: ln_nnogather !: namelist control of northfold comms (needed here in case "key_mpp_mpi" is not used)
INTEGER :: ncomm_ice
+ INTEGER, PUBLIC :: mpi_comm_opa ! opa local communicator
!!----------------------------------------------------------------------
CONTAINS
@@ -3192,11 +3485,13 @@
END FUNCTION lib_mpp_alloc
- FUNCTION mynode( ldtxt, kumnam_ref, knumnam_cfg, kumond , kstop, localComm ) RESULT (function_value)
+ FUNCTION mynode( ldtxt, ldname, kumnam_ref, knumnam_cfg, kumond , kstop, localComm ) RESULT (function_value)
INTEGER, OPTIONAL , INTENT(in ) :: localComm
CHARACTER(len=*),DIMENSION(:) :: ldtxt
+ CHARACTER(len=*) :: ldname
INTEGER :: kumnam_ref, knumnam_cfg , kumond , kstop
- IF( PRESENT( localComm ) .OR. .NOT.PRESENT( localComm ) ) function_value = 0
+ IF( PRESENT( localComm ) ) mpi_comm_opa = localComm
+ function_value = 0
IF( .FALSE. ) ldtxt(:) = 'never done'
- CALL ctl_opn( kumond, 'output.namelist.dyn', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 )
+ CALL ctl_opn( kumond, TRIM(ldname), 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 )
END FUNCTION mynode
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90 (revision 5602)
@@ -45,4 +45,5 @@
INTEGER :: inum ! temporary logical unit
INTEGER :: idir ! temporary integers
+ INTEGER :: jstartrow ! temporary integers
INTEGER :: ios ! Local integer output status for namelist read
INTEGER :: &
@@ -100,11 +101,25 @@
! open the file
! Remember that at this level in the code, mpp is not yet initialized, so
- ! the file must be open with jpdom_unknown, and kstart amd kcount forced
+ ! the file must be open with jpdom_unknown, and kstart and kcount forced
+ jstartrow = 1
IF ( ln_zco ) THEN
CALL iom_open ( 'bathy_level.nc', inum ) ! Level bathymetry
- CALL iom_get ( inum, jpdom_unknown, 'Bathy_level', zdta, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) )
+ ! Optionally use a file attribute (open_ocean_jstart) to set a start row for reading from the global file
+ ! This allows the unextended grid bathymetry to be stored in the same file as the under ice-shelf extended bathymetry
+ CALL iom_getatt(inum, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found
+ jstartrow = MAX(1,jstartrow)
+ CALL iom_get ( inum, jpdom_unknown, 'Bathy_level', zdta, kstart=(/jpizoom,jpjzoom+jstartrow-1/), kcount=(/jpiglo,jpjglo/) )
ELSE
CALL iom_open ( 'bathy_meter.nc', inum ) ! Meter bathy in case of partial steps
- CALL iom_get ( inum, jpdom_unknown, 'Bathymetry' , zdta, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) )
+ IF ( ln_isfcav ) THEN
+ CALL iom_get ( inum, jpdom_unknown, 'Bathymetry_isf' , zdta, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) )
+ ELSE
+ ! Optionally use a file attribute (open_ocean_jstart) to set a start row for reading from the global file
+ ! This allows the unextended grid bathymetry to be stored in the same file as the under ice-shelf extended bathymetry
+ CALL iom_getatt(inum, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found
+ jstartrow = MAX(1,jstartrow)
+ CALL iom_get ( inum, jpdom_unknown, 'Bathymetry' , zdta, kstart=(/jpizoom,jpjzoom+jstartrow-1/) &
+ & , kcount=(/jpiglo,jpjglo/) )
+ ENDIF
ENDIF
CALL iom_close (inum)
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c2d.h90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c2d.h90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c2d.h90 (revision 5602)
@@ -140,4 +140,5 @@
!!----------------------------------------------------------------------
USE ldftra_oce, ONLY: aht0
+ USE iom
!
LOGICAL, INTENT (in) :: ld_print ! If true, output arrays on numout
@@ -146,13 +147,12 @@
INTEGER :: inum, iim, ijm ! local integers
INTEGER :: ifreq, il1, il2, ij, ii
- INTEGER :: ijpt0,ijpt1
+ INTEGER :: ijpt0,ijpt1, ierror
REAL(wp) :: zahmeq, zcoft, zcoff, zmsk
CHARACTER (len=15) :: clexp
- INTEGER, POINTER, DIMENSION(:,:) :: icof
- INTEGER, POINTER, DIMENSION(:,:) :: idata
+ INTEGER, POINTER, DIMENSION(:,:) :: icof
+ REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ztemp2d ! temporary array to read ahmcoef file
!!----------------------------------------------------------------------
!
CALL wrk_alloc( jpi , jpj , icof )
- CALL wrk_alloc( jpidta, jpjdta, idata )
!
IF(lwp) WRITE(numout,*)
@@ -233,41 +233,12 @@
! Read 2d integer array to specify western boundary increase in the
! ===================== equatorial strip (20N-20S) defined at t-points
-
- CALL ctl_opn( inum, 'ahmcoef', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
- READ(inum,9101) clexp, iim, ijm
- READ(inum,'(/)')
- ifreq = 40
- il1 = 1
- DO jn = 1, jpidta/ifreq+1
- READ(inum,'(/)')
- il2 = MIN( jpidta, il1+ifreq-1 )
- READ(inum,9201) ( ii, ji = il1, il2, 5 )
- READ(inum,'(/)')
- DO jj = jpjdta, 1, -1
- READ(inum,9202) ij, ( idata(ji,jj), ji = il1, il2 )
- END DO
- il1 = il1 + ifreq
- END DO
-
- DO jj = 1, nlcj
- DO ji = 1, nlci
- icof(ji,jj) = idata( mig(ji), mjg(jj) )
- END DO
- END DO
- DO jj = nlcj+1, jpj
- DO ji = 1, nlci
- icof(ji,jj) = icof(ji,nlcj)
- END DO
- END DO
- DO jj = 1, jpj
- DO ji = nlci+1, jpi
- icof(ji,jj) = icof(nlci,jj)
- END DO
- END DO
-
-9101 FORMAT(1x,a15,2i8)
-9201 FORMAT(3x,13(i3,12x))
-9202 FORMAT(i3,41i3)
-
+ !
+ ALLOCATE( ztemp2d(jpi,jpj) )
+ ztemp2d(:,:) = 0.
+ CALL iom_open ( 'ahmcoef.nc', inum )
+ CALL iom_get ( inum, jpdom_data, 'icof', ztemp2d)
+ icof(:,:) = NINT(ztemp2d(:,:))
+ CALL iom_close( inum )
+ DEALLOCATE(ztemp2d)
! Set ahm1 and ahm2 ( T- and F- points) (used for laplacian operator)
@@ -346,5 +317,4 @@
!
CALL wrk_dealloc( jpi , jpj , icof )
- CALL wrk_dealloc( jpidta, jpjdta, idata )
!
END SUBROUTINE ldf_dyn_c2d_orca
@@ -367,4 +337,5 @@
!!----------------------------------------------------------------------
USE ldftra_oce, ONLY: aht0
+ USE iom
!
LOGICAL, INTENT (in) :: ld_print ! If true, output arrays on numout
@@ -374,15 +345,13 @@
INTEGER :: iim, ijm
INTEGER :: ifreq, il1, il2, ij, ii
- INTEGER :: ijpt0,ijpt1
+ INTEGER :: ijpt0,ijpt1, ierror
REAL(wp) :: zahmeq, zcoft, zcoff, zmsk, zam20s
CHARACTER (len=15) :: clexp
- INTEGER, POINTER, DIMENSION(:,:) :: icof
- INTEGER, POINTER, DIMENSION(:,:) :: idata
+ INTEGER, POINTER, DIMENSION(:,:) :: icof
+ REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ztemp2d ! temporary array to read ahmcoef file
!!----------------------------------------------------------------------
!
CALL wrk_alloc( jpi , jpj , icof )
- CALL wrk_alloc( jpidta, jpjdta, idata )
!
-
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) 'inildf: 2d eddy viscosity coefficient'
@@ -463,43 +432,11 @@
! Read 2d integer array to specify western boundary increase in the
! ===================== equatorial strip (20N-20S) defined at t-points
-
- CALL ctl_opn( inum, 'ahmcoef', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', &
- & 1, numout, lwp )
- REWIND inum
- READ(inum,9101) clexp, iim, ijm
- READ(inum,'(/)')
- ifreq = 40
- il1 = 1
- DO jn = 1, jpidta/ifreq+1
- READ(inum,'(/)')
- il2 = MIN( jpidta, il1+ifreq-1 )
- READ(inum,9201) ( ii, ji = il1, il2, 5 )
- READ(inum,'(/)')
- DO jj = jpjdta, 1, -1
- READ(inum,9202) ij, ( idata(ji,jj), ji = il1, il2 )
- END DO
- il1 = il1 + ifreq
- END DO
-
- DO jj = 1, nlcj
- DO ji = 1, nlci
- icof(ji,jj) = idata( mig(ji), mjg(jj) )
- END DO
- END DO
- DO jj = nlcj+1, jpj
- DO ji = 1, nlci
- icof(ji,jj) = icof(ji,nlcj)
- END DO
- END DO
- DO jj = 1, jpj
- DO ji = nlci+1, jpi
- icof(ji,jj) = icof(nlci,jj)
- END DO
- END DO
-
-9101 FORMAT(1x,a15,2i8)
-9201 FORMAT(3x,13(i3,12x))
-9202 FORMAT(i3,41i3)
-
+ ALLOCATE( ztemp2d(jpi,jpj) )
+ ztemp2d(:,:) = 0.
+ CALL iom_open ( 'ahmcoef.nc', inum )
+ CALL iom_get ( inum, jpdom_data, 'icof', ztemp2d)
+ icof(:,:) = NINT(ztemp2d(:,:))
+ CALL iom_close( inum )
+ DEALLOCATE(ztemp2d)
! Set ahm1 and ahm2 ( T- and F- points) (used for laplacian operator)
@@ -583,5 +520,4 @@
!
CALL wrk_dealloc( jpi , jpj , icof )
- CALL wrk_dealloc( jpidta, jpjdta, idata )
!
END SUBROUTINE ldf_dyn_c2d_orca_R1
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90 (revision 5602)
@@ -27,4 +27,5 @@
!!----------------------------------------------------------------------
USE ldftra_oce, ONLY : aht0
+ USE iom
!!
LOGICAL, INTENT (in) :: ld_print ! If true, output arrays on numout
@@ -193,4 +194,5 @@
!!----------------------------------------------------------------------
USE ldftra_oce, ONLY: aht0
+ USE iom
!!
LOGICAL, INTENT(in) :: ld_print ! If true, output arrays on numout
@@ -204,11 +206,11 @@
CHARACTER (len=15) :: clexp
INTEGER , POINTER, DIMENSION(:,:) :: icof
- INTEGER , POINTER, DIMENSION(:,:) :: idata
REAL(wp), POINTER, DIMENSION(: ) :: zcoef
REAL(wp), POINTER, DIMENSION(:,:) :: zahm0
+ !
+ REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ztemp2d ! temporary array to read ahmcoef file
!!----------------------------------------------------------------------
!
CALL wrk_alloc( jpi , jpj , icof )
- CALL wrk_alloc( jpidta, jpjdta, idata )
CALL wrk_alloc( jpk , zcoef )
CALL wrk_alloc( jpi , jpj , zahm0 )
@@ -221,41 +223,12 @@
! Read 2d integer array to specify western boundary increase in the
! ===================== equatorial strip (20N-20S) defined at t-points
-
- CALL ctl_opn( inum, 'ahmcoef', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
- READ(inum,9101) clexp, iim, ijm
- READ(inum,'(/)')
- ifreq = 40
- il1 = 1
- DO jn = 1, jpidta/ifreq+1
- READ(inum,'(/)')
- il2 = MIN( jpidta, il1+ifreq-1 )
- READ(inum,9201) ( ii, ji = il1, il2, 5 )
- READ(inum,'(/)')
- DO jj = jpjdta, 1, -1
- READ(inum,9202) ij, ( idata(ji,jj), ji = il1, il2 )
- END DO
- il1 = il1 + ifreq
- END DO
-
- DO jj = 1, nlcj
- DO ji = 1, nlci
- icof(ji,jj) = idata( mig(ji), mjg(jj) )
- END DO
- END DO
- DO jj = nlcj+1, jpj
- DO ji = 1, nlci
- icof(ji,jj) = icof(ji,nlcj)
- END DO
- END DO
- DO jj = 1, jpj
- DO ji = nlci+1, jpi
- icof(ji,jj) = icof(nlci,jj)
- END DO
- END DO
-
-9101 FORMAT(1x,a15,2i8)
-9201 FORMAT(3x,13(i3,12x))
-9202 FORMAT(i3,41i3)
-
+ ALLOCATE( ztemp2d(jpi,jpj) )
+ ztemp2d(:,:) = 0.
+ CALL iom_open ( 'ahmcoef.nc', inum )
+ CALL iom_get ( inum, jpdom_data, 'icof', ztemp2d)
+ icof(:,:) = NINT(ztemp2d(:,:))
+ CALL iom_close( inum )
+ DEALLOCATE(ztemp2d)
+
! Set ahm1 and ahm2
! =================
@@ -455,5 +428,4 @@
!
CALL wrk_dealloc( jpi , jpj , icof )
- CALL wrk_dealloc( jpidta, jpjdta, idata )
CALL wrk_dealloc( jpk , zcoef )
CALL wrk_dealloc( jpi , jpj , zahm0 )
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_smag.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_smag.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_smag.F90 (revision 5602)
@@ -31,5 +31,5 @@
!!----------------------------------------------------------------------
!! OPA 9.0 , LOCEAN-IPSL (2005)
- !! $Id: ldf_tra_smag.F90 1482 2010-06-13 15:28:06Z $
+ !! $Id$
!! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
!!----------------------------------------------------------------------
@@ -51,5 +51,5 @@
!!----------------------------------------------------------------------
!! OPA 9.0 , LOCEAN-IPSL (2005)
- !! $Id: ldfdyn_c3d.h90 1581 2009-08-05 14:53:12Z smasson $
+ !! $Id$
!! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90 (revision 5602)
@@ -143,7 +143,12 @@
DO jj = 1, jpjm1
DO ji = 1, jpim1
-! IF should be useless check zpshde (PM)
- IF ( mbku(ji,jj) > 1 ) zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj)
- IF ( mbkv(ji,jj) > 1 ) zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj)
+ zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj)
+ zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj)
+ END DO
+ END DO
+ ENDIF
+ IF( ln_zps .AND. ln_isfcav ) THEN ! partial steps correction at the bottom ocean level
+ DO jj = 1, jpjm1
+ DO ji = 1, jpim1
IF ( miku(ji,jj) > 1 ) zgru(ji,jj,miku(ji,jj)) = grui(ji,jj)
IF ( mikv(ji,jj) > 1 ) zgrv(ji,jj,mikv(ji,jj)) = grvi(ji,jj)
@@ -152,6 +157,7 @@
ENDIF
!
- zdzr(:,:,1) = 0._wp !== Local vertical density gradient at T-point == ! (evaluated from N^2)
- DO jk = 1, jpkm1
+ !== Local vertical density gradient at T-point == ! (evaluated from N^2)
+ ! interior value
+ DO jk = 2, jpkm1
! ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point
! ! trick: tmask(ik ) = 0 => all pn2 = 0 => zdzr = 0
@@ -163,9 +169,13 @@
END DO
! surface initialisation
- DO jj = 1, jpjm1
- DO ji = 1, jpim1
- zdzr(ji,jj,1:mikt(ji,jj)) = 0._wp
- END DO
- END DO
+ zdzr(:,:,1) = 0._wp
+ IF ( ln_isfcav ) THEN
+ ! if isf need to overwrite the interior value at at the first ocean point
+ DO jj = 1, jpjm1
+ DO ji = 1, jpim1
+ zdzr(ji,jj,1:mikt(ji,jj)) = 0._wp
+ END DO
+ END DO
+ END IF
!
! !== Slopes just below the mixed layer ==!
@@ -176,14 +186,23 @@
! =========================== | vslp = d/dj( prd ) / d/dz( prd )
!
- DO jj = 2, jpjm1
- DO ji = fs_2, fs_jpim1 ! vector opt.
- IF (miku(ji,jj) .GT. miku(ji+1,jj)) zhmlpu(ji,jj) = hmlpt(ji ,jj)
- IF (miku(ji,jj) .LT. miku(ji+1,jj)) zhmlpu(ji,jj) = hmlpt(ji+1,jj)
- IF (miku(ji,jj) .EQ. miku(ji+1,jj)) zhmlpu(ji,jj) = MAX(hmlpt(ji ,jj), hmlpt(ji+1,jj))
- IF (mikv(ji,jj) .GT. miku(ji,jj+1)) zhmlpv(ji,jj) = hmlpt(ji ,jj)
- IF (mikv(ji,jj) .LT. miku(ji,jj+1)) zhmlpv(ji,jj) = hmlpt(ji,jj+1)
- IF (mikv(ji,jj) .EQ. miku(ji,jj+1)) zhmlpv(ji,jj) = MAX(hmlpt(ji,jj), hmlpt(ji,jj+1))
+ IF ( ln_isfcav ) THEN
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
+ IF (miku(ji,jj) .GT. miku(ji+1,jj)) zhmlpu(ji,jj) = MAX(hmlpt(ji ,jj ), 5._wp)
+ IF (miku(ji,jj) .LT. miku(ji+1,jj)) zhmlpu(ji,jj) = MAX(hmlpt(ji+1,jj ), 5._wp)
+ IF (miku(ji,jj) .EQ. miku(ji+1,jj)) zhmlpu(ji,jj) = MAX(hmlpt(ji ,jj ), hmlpt(ji+1,jj ), 5._wp)
+ IF (mikv(ji,jj) .GT. miku(ji,jj+1)) zhmlpv(ji,jj) = MAX(hmlpt(ji ,jj ), 5._wp)
+ IF (mikv(ji,jj) .LT. miku(ji,jj+1)) zhmlpv(ji,jj) = MAX(hmlpt(ji ,jj+1), 5._wp)
+ IF (mikv(ji,jj) .EQ. miku(ji,jj+1)) zhmlpv(ji,jj) = MAX(hmlpt(ji ,jj ), hmlpt(ji ,jj+1), 5._wp)
+ ENDDO
ENDDO
- ENDDO
+ ELSE
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
+ zhmlpu(ji,jj) = MAX(hmlpt(ji,jj), hmlpt(ji+1,jj ), 5._wp)
+ zhmlpv(ji,jj) = MAX(hmlpt(ji,jj), hmlpt(ji ,jj+1), 5._wp)
+ ENDDO
+ ENDDO
+ END IF
DO jk = 2, jpkm1 !* Slopes at u and v points
DO jj = 2, jpjm1
@@ -199,21 +218,18 @@
zbv = MIN( zbv, -100._wp* ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,jk)* ABS( zav ) )
! ! uslp and vslp output in zwz and zww, resp.
- zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) )
- zfj = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) )
+ zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj ,jk) )
+ zfj = MAX( omlmask(ji,jj,jk), omlmask(ji ,jj+1,jk) )
! thickness of water column between surface and level k at u/v point
- zdepu = 0.5_wp * (( fsdept(ji,jj,jk) + fsdept(ji+1,jj ,jk) ) &
- - 2 * MAX( risfdep(ji,jj), risfdep(ji+1,jj ) ) &
- - fse3u(ji,jj,miku(ji,jj)) )
- zdepv = 0.5_wp * (( fsdept(ji,jj,jk) + fsdept(ji ,jj+1,jk) ) &
- - 2 * MAX( risfdep(ji,jj), risfdep(ji,jj+1) ) &
- - fse3v(ji,jj,mikv(ji,jj)) )
- zwz(ji,jj,jk) = ( 1. - zfi) * zau / ( zbu - zeps ) &
- & + zfi * uslpml(ji,jj) &
- & * zdepu / MAX( zhmlpu(ji,jj), 5._wp )
- zwz(ji,jj,jk) = zwz(ji,jj,jk) * umask(ji,jj,jk) * umask(ji,jj,jk-1)
- zww(ji,jj,jk) = ( 1. - zfj) * zav / ( zbv - zeps ) &
- & + zfj * vslpml(ji,jj) &
- & * zdepv / MAX( zhmlpv(ji,jj), 5._wp )
- zww(ji,jj,jk) = zww(ji,jj,jk) * vmask(ji,jj,jk) * vmask(ji,jj,jk-1)
+ zdepu = 0.5_wp * ( ( fsdept(ji,jj,jk) + fsdept(ji+1,jj ,jk) ) &
+ - 2 * MAX( risfdep(ji,jj), risfdep(ji+1,jj ) ) - fse3u(ji,jj,miku(ji,jj)) )
+ zdepv = 0.5_wp * ( ( fsdept(ji,jj,jk) + fsdept(ji ,jj+1,jk) ) &
+ - 2 * MAX( risfdep(ji,jj), risfdep(ji ,jj+1) ) - fse3v(ji,jj,mikv(ji,jj)) )
+ !
+ zwz(ji,jj,jk) = ( 1. - zfi) * zau / ( zbu - zeps ) &
+ & + zfi * uslpml(ji,jj) * zdepu / zhmlpu(ji,jj)
+ zwz(ji,jj,jk) = zwz(ji,jj,jk) * wumask(ji,jj,jk)
+ zww(ji,jj,jk) = ( 1. - zfj) * zav / ( zbv - zeps ) &
+ & + zfj * vslpml(ji,jj) * zdepv / zhmlpv(ji,jj)
+ zww(ji,jj,jk) = zww(ji,jj,jk) * wvmask(ji,jj,jk)
@@ -268,8 +284,8 @@
uslp(ji,jj,jk) = uslp(ji,jj,jk) * ( umask(ji,jj+1,jk) + umask(ji,jj-1,jk ) ) * 0.5_wp &
& * ( umask(ji,jj ,jk) + umask(ji,jj ,jk+1) ) * 0.5_wp &
- & * umask(ji,jj,jk-1) !* umask(ji,jj,jk) * umask(ji,jj,jk+1)
+ & * umask(ji,jj,jk-1)
vslp(ji,jj,jk) = vslp(ji,jj,jk) * ( vmask(ji+1,jj,jk) + vmask(ji-1,jj,jk ) ) * 0.5_wp &
& * ( vmask(ji ,jj,jk) + vmask(ji ,jj,jk+1) ) * 0.5_wp &
- & * vmask(ji,jj,jk-1) !* vmask(ji,jj,jk) * vmask(ji,jj,jk+1)
+ & * vmask(ji,jj,jk-1)
END DO
END DO
@@ -284,5 +300,5 @@
DO ji = fs_2, fs_jpim1 ! vector opt.
! !* Local vertical density gradient evaluated from N^2
- zbw = zm1_2g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1)
+ zbw = zm1_2g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. ) * wmask(ji,jj,jk)
! !* Slopes at w point
! ! i- & j-gradient of density at w-points
@@ -300,10 +316,10 @@
zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w(ji,jj,jk)* ABS( zaj ) )
! ! wslpi and wslpj with ML flattening (output in zwz and zww, resp.)
- zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) ) ! zfk=1 in the ML otherwise zfk=0
+ zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) ) ! zfk=1 in the ML otherwise zfk=0
zck = ( fsdepw(ji,jj,jk) - fsdepw(ji,jj,mikt(ji,jj) ) ) / MAX( hmlp(ji,jj), 10._wp )
zwz(ji,jj,jk) = ( zai / ( zbi - zeps ) * ( 1._wp - zfk ) &
- & + zck * wslpiml(ji,jj) * zfk ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1)
+ & + zck * wslpiml(ji,jj) * zfk ) * wmask(ji,jj,jk)
zww(ji,jj,jk) = ( zaj / ( zbj - zeps ) * ( 1._wp - zfk ) &
- & + zck * wslpjml(ji,jj) * zfk ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1)
+ & + zck * wslpjml(ji,jj) * zfk ) * wmask(ji,jj,jk)
!!gm modif to suppress omlmask.... (as in Griffies operator)
@@ -358,6 +374,6 @@
zck = ( umask(ji,jj,jk) + umask(ji-1,jj,jk) ) &
& * ( vmask(ji,jj,jk) + vmask(ji,jj-1,jk) ) * 0.25
- wslpi(ji,jj,jk) = wslpi(ji,jj,jk) * zck * tmask(ji,jj,jk-1) * tmask(ji,jj,jk)
- wslpj(ji,jj,jk) = wslpj(ji,jj,jk) * zck * tmask(ji,jj,jk-1) * tmask(ji,jj,jk)
+ wslpi(ji,jj,jk) = wslpi(ji,jj,jk) * zck * wmask(ji,jj,jk)
+ wslpj(ji,jj,jk) = wslpj(ji,jj,jk) * zck * wmask(ji,jj,jk)
END DO
END DO
@@ -425,7 +441,7 @@
vslp(ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk)
wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) &
- & * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) * 0.5
+ & * wmask(ji,jj,jk) * 0.5
wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) &
- & * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) * 0.5
+ & * wmask(ji,jj,jk) * 0.5
END DO
END DO
@@ -746,6 +762,8 @@
DO ji = 1, jpi
ik = nmln(ji,jj) - 1
- IF( jk <= ik .AND. jk >= mikt(ji,jj) ) THEN ; omlmask(ji,jj,jk) = 1._wp
- ELSE ; omlmask(ji,jj,jk) = 0._wp
+ IF( jk <= ik .AND. jk >= mikt(ji,jj) ) THEN
+ omlmask(ji,jj,jk) = 1._wp
+ ELSE
+ omlmask(ji,jj,jk) = 0._wp
ENDIF
END DO
@@ -804,6 +822,6 @@
zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w(ji,jj,ik)* ABS( zaj ) )
! !- i- & j-slope at w-points (wslpiml, wslpjml)
- wslpiml(ji,jj) = zai / ( zbi - zeps ) * tmask (ji,jj,ik)
- wslpjml(ji,jj) = zaj / ( zbj - zeps ) * tmask (ji,jj,ik)
+ wslpiml(ji,jj) = zai / ( zbi - zeps ) * wmask (ji,jj,ik)
+ wslpjml(ji,jj) = zaj / ( zbj - zeps ) * wmask (ji,jj,ik)
END DO
END DO
@@ -857,5 +875,5 @@
wslpj(:,:,:) = 0._wp ; wslpjml(:,:) = 0._wp
- IF( ln_traldf_hor .OR. ln_dynldf_hor ) THEN
+ IF(ln_sco .AND. (ln_traldf_hor .OR. ln_dynldf_hor )) THEN
IF(lwp) WRITE(numout,*) ' Horizontal mixing in s-coordinate: slope = slope of s-surfaces'
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_smag.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_smag.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_smag.F90 (revision 5602)
@@ -31,5 +31,5 @@
!!----------------------------------------------------------------------
!! OPA 9.0 , LOCEAN-IPSL (2005)
- !! $Id: ldf_tra_smag.F90 1482 2010-06-13 15:28:06Z $
+ !! $Id$
!! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/OBS/julian.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/OBS/julian.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/OBS/julian.F90 (revision 5602)
@@ -24,4 +24,5 @@
& greg2jul ! Convert date to relative time
+ !! $Id$
CONTAINS
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90 (revision 5602)
@@ -15,5 +15,6 @@
!!----------------------------------------------------------------------
!!----------------------------------------------------------------------
- !! 'key_oasis3' coupled Ocean/Atmosphere via OASIS3
+ !! 'key_oasis3' coupled Ocean/Atmosphere via OASIS3-MCT
+ !! 'key_oa3mct_v3' to be added for OASIS3-MCT version 3
!!----------------------------------------------------------------------
!! cpl_init : initialization of coupled mode communication
@@ -61,5 +62,8 @@
#endif
- INTEGER, PUBLIC, PARAMETER :: nmaxfld=40 ! Maximum number of coupling fields
+ INTEGER :: nrcv ! total number of fields received
+ INTEGER :: nsnd ! total number of fields sent
+ INTEGER :: ncplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data
+ INTEGER, PUBLIC, PARAMETER :: nmaxfld=50 ! Maximum number of coupling fields
INTEGER, PUBLIC, PARAMETER :: nmaxcat=5 ! Maximum number of coupling fields
INTEGER, PUBLIC, PARAMETER :: nmaxcpl=5 ! Maximum number of coupling fields
@@ -86,5 +90,5 @@
CONTAINS
- SUBROUTINE cpl_init( kl_comm )
+ SUBROUTINE cpl_init( cd_modname, kl_comm )
!!-------------------------------------------------------------------
!! *** ROUTINE cpl_init ***
@@ -95,5 +99,6 @@
!! ** Method : OASIS3 MPI communication
!!--------------------------------------------------------------------
- INTEGER, INTENT(out) :: kl_comm ! local communicator of the model
+ CHARACTER(len = *), INTENT(in) :: cd_modname ! model name as set in namcouple file
+ INTEGER , INTENT(out) :: kl_comm ! local communicator of the model
!!--------------------------------------------------------------------
@@ -104,5 +109,5 @@
! 1st Initialize the OASIS system for the application
!------------------------------------------------------------------
- CALL oasis_init_comp ( ncomp_id, 'oceanx', nerror )
+ CALL oasis_init_comp ( ncomp_id, TRIM(cd_modname), nerror )
IF ( nerror /= OASIS_Ok ) &
CALL oasis_abort (ncomp_id, 'cpl_init', 'Failure in oasis_init_comp')
@@ -144,7 +149,19 @@
IF(lwp) WRITE(numout,*)
+ ncplmodel = kcplmodel
IF( kcplmodel > nmaxcpl ) THEN
- CALL oasis_abort ( ncomp_id, 'cpl_define', 'kcplmodel is larger than nmaxcpl, increase nmaxcpl') ; RETURN
+ CALL oasis_abort ( ncomp_id, 'cpl_define', 'ncplmodel is larger than nmaxcpl, increase nmaxcpl') ; RETURN
ENDIF
+
+ nrcv = krcv
+ IF( nrcv > nmaxfld ) THEN
+ CALL oasis_abort ( ncomp_id, 'cpl_define', 'nrcv is larger than nmaxfld, increase nmaxfld') ; RETURN
+ ENDIF
+
+ nsnd = ksnd
+ IF( nsnd > nmaxfld ) THEN
+ CALL oasis_abort ( ncomp_id, 'cpl_define', 'nsnd is larger than nmaxfld, increase nmaxfld') ; RETURN
+ ENDIF
+
!
! ... Define the shape for the area that excludes the halo
@@ -400,5 +417,5 @@
- INTEGER FUNCTION cpl_freq( kid )
+ INTEGER FUNCTION cpl_freq( cdfieldname )
!!---------------------------------------------------------------------
!! *** ROUTINE cpl_freq ***
@@ -406,11 +423,48 @@
!! ** Purpose : - send back the coupling frequency for a particular field
!!----------------------------------------------------------------------
- INTEGER,INTENT(in) :: kid ! variable index
- !!
+ CHARACTER(len = *), INTENT(in) :: cdfieldname ! field name as set in namcouple file
+ !!
+ INTEGER :: id
INTEGER :: info
INTEGER, DIMENSION(1) :: itmp
+ INTEGER :: ji,jm ! local loop index
+ INTEGER :: mop
!!----------------------------------------------------------------------
- CALL oasis_get_freqs(kid, 1, itmp, info)
- cpl_freq = itmp(1)
+ cpl_freq = 0 ! defaut definition
+ id = -1 ! defaut definition
+ !
+ DO ji = 1, nsnd
+ IF (ssnd(ji)%laction ) THEN
+ DO jm = 1, ncplmodel
+ IF( ssnd(ji)%nid(1,jm) /= -1 ) THEN
+ IF( TRIM(cdfieldname) == TRIM(ssnd(ji)%clname) ) THEN
+ id = ssnd(ji)%nid(1,jm)
+ mop = OASIS_Out
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDDO
+ DO ji = 1, nrcv
+ IF (srcv(ji)%laction ) THEN
+ DO jm = 1, ncplmodel
+ IF( srcv(ji)%nid(1,jm) /= -1 ) THEN
+ IF( TRIM(cdfieldname) == TRIM(srcv(ji)%clname) ) THEN
+ id = srcv(ji)%nid(1,jm)
+ mop = OASIS_In
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDDO
+ !
+ IF( id /= -1 ) THEN
+#if defined key_oa3mct_v3
+ CALL oasis_get_freqs(id, mop, 1, itmp, info)
+#else
+ CALL oasis_get_freqs(id, 1, itmp, info)
+#endif
+ cpl_freq = itmp(1)
+ ENDIF
!
END FUNCTION cpl_freq
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/cyclone.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/cyclone.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/cyclone.F90 (revision 5602)
@@ -41,5 +41,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)
- !! $Id: module_example 1146 2008-06-25 11:42:56Z rblod $
+ !! $Id$
!! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90 (revision 5602)
@@ -69,6 +69,7 @@
END TYPE FLD
- TYPE, PUBLIC :: MAP_POINTER !: Array of integer pointers to 1D arrays
- INTEGER, POINTER :: ptr(:)
+ TYPE, PUBLIC :: MAP_POINTER !: Map from input data file to local domain
+ INTEGER, POINTER, DIMENSION(:) :: ptr ! Array of integer pointers to 1D arrays
+ LOGICAL :: ll_unstruc ! Unstructured (T) or structured (F) boundary data file
END TYPE MAP_POINTER
@@ -153,5 +154,7 @@
IF( PRESENT(kit) ) ll_firstcall = ll_firstcall .and. kit == 1
- it_offset = 0
+ IF ( nn_components == jp_iam_sas ) THEN ; it_offset = nn_fsbc
+ ELSE ; it_offset = 0
+ ENDIF
IF( PRESENT(kt_offset) ) it_offset = kt_offset
@@ -451,5 +454,7 @@
ENDIF
!
- it_offset = 0
+ IF ( nn_components == jp_iam_sas ) THEN ; it_offset = nn_fsbc
+ ELSE ; it_offset = 0
+ ENDIF
IF( PRESENT(kt_offset) ) it_offset = kt_offset
IF( PRESENT(kit) ) THEN ; it_offset = ( kit + it_offset ) * NINT( rdt/REAL(nn_baro,wp) )
@@ -601,6 +606,6 @@
!
IF( ASSOCIATED(map%ptr) ) THEN
- IF( sdjf%ln_tint ) THEN ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), map%ptr )
- ELSE ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,: ), sdjf%nrec_a(1), map%ptr )
+ IF( sdjf%ln_tint ) THEN ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), map )
+ ELSE ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,: ), sdjf%nrec_a(1), map )
ENDIF
ELSE IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN
@@ -672,5 +677,5 @@
REAL(wp), DIMENSION(:,:,:), INTENT(out) :: dta ! output field on model grid (2 dimensional)
INTEGER , INTENT(in ) :: nrec ! record number to read (ie time slice)
- INTEGER, DIMENSION(:) , INTENT(in ) :: map ! global-to-local mapping indices
+ TYPE(MAP_POINTER) , INTENT(in ) :: map ! global-to-local mapping indices
!!
INTEGER :: ipi ! length of boundary data on local process
@@ -693,7 +698,7 @@
#if defined key_bdy
ipj = iom_file(num)%dimsz(2,idvar)
- IF (ipj == 1) THEN ! we assume that this is a structured open boundary file
+ IF ( map%ll_unstruc) THEN ! unstructured open boundary data file
dta_read => dta_global
- ELSE
+ ELSE ! structured open boundary data file
dta_read => dta_global2
ENDIF
@@ -708,14 +713,14 @@
END SELECT
!
- IF (ipj==1) THEN
+ IF ( map%ll_unstruc ) THEN ! unstructured open boundary data file
DO ib = 1, ipi
DO ik = 1, ipk
- dta(ib,1,ik) = dta_read(map(ib),1,ik)
+ dta(ib,1,ik) = dta_read(map%ptr(ib),1,ik)
END DO
END DO
- ELSE ! we assume that this is a structured open boundary file
+ ELSE ! structured open boundary data file
DO ib = 1, ipi
- jj=1+floor(REAL(map(ib)-1)/REAL(ilendta))
- ji=map(ib)-(jj-1)*ilendta
+ jj=1+floor(REAL(map%ptr(ib)-1)/REAL(ilendta))
+ ji=map%ptr(ib)-(jj-1)*ilendta
DO ik = 1, ipk
dta(ib,1,ik) = dta_read(ji,jj,ik)
@@ -1020,5 +1025,5 @@
INTEGER :: ipk ! temporary vertical dimension
CHARACTER (len=5) :: aname
- INTEGER , DIMENSION(3) :: ddims
+ INTEGER , DIMENSION(:), ALLOCATABLE :: ddims
INTEGER , POINTER, DIMENSION(:,:) :: data_src
REAL(wp), POINTER, DIMENSION(:,:) :: data_tmp
@@ -1043,4 +1048,9 @@
!! get dimensions
+ IF ( SIZE(sd%fnow, 3) > 1 ) THEN
+ ALLOCATE( ddims(4) )
+ ELSE
+ ALLOCATE( ddims(3) )
+ ENDIF
id = iom_varid( inum, sd%clvar, ddims )
@@ -1139,4 +1149,6 @@
CALL ctl_stop( ' fld_weight : unable to read the file ' )
ENDIF
+
+ DEALLOCATE (ddims )
CALL wrk_dealloc( jpi,jpj, data_src ) ! integer
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90 (revision 5602)
@@ -16,5 +16,5 @@
USE sbc_oce ! surface boundary condition: ocean
# if defined key_lim3
- USE par_ice ! LIM-3 parameters
+ USE ice ! LIM-3 parameters
# endif
# if defined key_lim2
@@ -58,5 +58,4 @@
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qns_ice !: non solar heat flux over ice [W/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice !: solar heat flux over ice [W/m2]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice_mean !: daily mean solar heat flux over ice [W/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qla_ice !: latent flux over ice [W/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dqla_ice !: latent sensibility over ice [W/m2/K]
@@ -69,8 +68,22 @@
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr1_i0 !: Solar surface transmission parameter, thick ice [-]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr2_i0 !: Solar surface transmission parameter, thin ice [-]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_ice !: sublimation - precip over sea ice [kg/m2]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_ice !: sublimation - precip over sea ice [kg/m2/s]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: topmelt !: category topmelt
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: botmelt !: category botmelt
+
+#if defined key_lim3
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: evap_ice !: sublimation [kg/m2/s]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: devap_ice !: sublimation sensitivity [kg/m2/s/K]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qns_oce !: non solar heat flux over ocean [W/m2]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsr_oce !: non solar heat flux over ocean [W/m2]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qemp_oce !: heat flux of precip and evap over ocean [W/m2]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qemp_ice !: heat flux of precip and evap over ice [W/m2]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qprec_ice !: heat flux of precip over ice [J/m3]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_oce !: evap - precip over ocean [kg/m2/s]
+#endif
+#if defined key_lim3 || defined key_lim2
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wndm_ice !: wind speed module at T-point [m/s]
+#endif
#if defined key_cice
@@ -82,5 +95,4 @@
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ss_iou !: x ice-ocean surface stress at NEMO U point
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ss_iov !: y ice-ocean surface stress at NEMO V point
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_ice !: sublimation-snow budget over ice [kg/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qatm_ice !: specific humidity
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wndi_ice !: i wind at T point
@@ -101,6 +113,5 @@
#endif
-#if defined key_lim3 || defined key_cice
- ! not used with LIM2
+#if defined key_cice
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tatm_ice !: air temperature [K]
#endif
@@ -126,13 +137,14 @@
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) , &
- & utau_ice(jpi,jpj) , vtau_ice(jpi,jpj) , &
+ & dqns_ice(jpi,jpj,jpl) , tn_ice (jpi,jpj,jpl) , alb_ice (jpi,jpj,jpl) , &
+ & utau_ice(jpi,jpj) , vtau_ice(jpi,jpj) , wndm_ice(jpi,jpj) , &
& fr1_i0 (jpi,jpj) , fr2_i0 (jpi,jpj) , &
-#if defined key_lim3
- & tatm_ice(jpi,jpj) , &
-#endif
#if defined key_lim2
& a_i(jpi,jpj,jpl) , &
+#endif
+#if defined key_lim3
+ & evap_ice(jpi,jpj,jpl) , devap_ice(jpi,jpj,jpl) , qprec_ice(jpi,jpj) , &
+ & qemp_ice(jpi,jpj) , qemp_oce(jpi,jpj) , &
+ & qns_oce (jpi,jpj) , qsr_oce (jpi,jpj) , emp_oce (jpi,jpj) , &
#endif
& emp_ice(jpi,jpj) , STAT= ierr(1) )
@@ -146,5 +158,5 @@
a_i(jpi,jpj,ncat) , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat) , &
STAT= ierr(1) )
- IF( lk_cpl ) ALLOCATE( u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,1) , &
+ IF( ln_cpl ) ALLOCATE( u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,1) , &
& v_ice(jpi,jpj) , fr2_i0(jpi,jpj) , alb_ice(jpi,jpj,1) , &
& emp_ice(jpi,jpj) , qns_ice(jpi,jpj,1) , dqns_ice(jpi,jpj,1) , &
@@ -153,10 +165,6 @@
#endif
!
-#if defined key_lim2
- IF( ltrcdm2dc_ice ) ALLOCATE( qsr_ice_mean (jpi,jpj,jpl), STAT=ierr(3) )
-#endif
- !
#if defined key_cice || defined key_lim2
- IF( lk_cpl ) ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(5) )
+ IF( ln_cpl ) ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(5) )
#endif
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90 (revision 5602)
@@ -36,8 +36,10 @@
LOGICAL , PUBLIC :: ln_blk_mfs !: MFS bulk formulation
#if defined key_oasis3
- LOGICAL , PUBLIC :: lk_cpl = .TRUE. !: coupled formulation
+ LOGICAL , PUBLIC :: lk_oasis = .TRUE. !: OASIS used
#else
- LOGICAL , PUBLIC :: lk_cpl = .FALSE. !: coupled formulation
-#endif
+ LOGICAL , PUBLIC :: lk_oasis = .FALSE. !: OASIS unused
+#endif
+ LOGICAL , PUBLIC :: ln_cpl !: ocean-atmosphere coupled formulation
+ LOGICAL , PUBLIC :: ln_mixcpl !: ocean-atmosphere forced-coupled mixed formulation
LOGICAL , PUBLIC :: ln_dm2dc !: Daily mean to Diurnal Cycle short wave (qsr)
LOGICAL , PUBLIC :: ln_rnf !: runoffs / runoff mouths
@@ -50,5 +52,6 @@
! !: =1 levitating ice with mass and salt exchange but no presure effect
! !: =2 embedded sea-ice (full salt and mass exchanges and pressure)
- INTEGER , PUBLIC :: nn_limflx !: LIM3 Multi-category heat flux formulation
+ INTEGER , PUBLIC :: nn_components !: flag for sbc module (including sea-ice) coupling mode (see component definition below)
+ INTEGER , PUBLIC :: nn_limflx !: LIM3 Multi-category heat flux formulation
! !: =-1 Use of per-category fluxes
! !: = 0 Average per-category fluxes
@@ -69,18 +72,29 @@
!! switch definition (improve readability)
!!----------------------------------------------------------------------
- INTEGER , PUBLIC, PARAMETER :: jp_gyre = 0 !: GYRE analytical formulation
- INTEGER , PUBLIC, PARAMETER :: jp_ana = 1 !: analytical formulation
- INTEGER , PUBLIC, PARAMETER :: jp_flx = 2 !: flux formulation
- INTEGER , PUBLIC, PARAMETER :: jp_clio = 3 !: CLIO bulk formulation
- INTEGER , PUBLIC, PARAMETER :: jp_core = 4 !: CORE bulk formulation
- INTEGER , PUBLIC, PARAMETER :: jp_cpl = 5 !: Coupled formulation
- INTEGER , PUBLIC, PARAMETER :: jp_mfs = 6 !: MFS bulk formulation
+ INTEGER , PUBLIC, PARAMETER :: jp_gyre = 0 !: GYRE analytical formulation
+ INTEGER , PUBLIC, PARAMETER :: jp_ana = 1 !: analytical formulation
+ INTEGER , PUBLIC, PARAMETER :: jp_flx = 2 !: flux formulation
+ INTEGER , PUBLIC, PARAMETER :: jp_clio = 3 !: CLIO bulk formulation
+ INTEGER , PUBLIC, PARAMETER :: jp_core = 4 !: CORE bulk formulation
+ INTEGER , PUBLIC, PARAMETER :: jp_purecpl = 5 !: Pure ocean-atmosphere Coupled formulation
+ INTEGER , PUBLIC, PARAMETER :: jp_mfs = 6 !: MFS bulk formulation
+ INTEGER , PUBLIC, PARAMETER :: jp_none = 7 !: for OPA when doing coupling via SAS module
INTEGER , PUBLIC, PARAMETER :: jp_esopa = -1 !: esopa test, ALL formulations
!!----------------------------------------------------------------------
+ !! component definition
+ !!----------------------------------------------------------------------
+ INTEGER , PUBLIC, PARAMETER :: jp_iam_nemo = 0 !: Initial single executable configuration
+ ! (no internal OASIS coupling)
+ INTEGER , PUBLIC, PARAMETER :: jp_iam_opa = 1 !: Multi executable configuration - OPA component
+ ! (internal OASIS coupling)
+ INTEGER , PUBLIC, PARAMETER :: jp_iam_sas = 2 !: Multi executable configuration - SAS component
+ ! (internal OASIS coupling)
+ !!----------------------------------------------------------------------
!! Ocean Surface Boundary Condition fields
!!----------------------------------------------------------------------
+ INTEGER , PUBLIC :: ncpl_qsr_freq !: qsr coupling frequency per days from atmosphere
+ !
LOGICAL , PUBLIC :: lhftau = .FALSE. !: HF tau used in TKE: mean(stress module) - module(mean stress)
- LOGICAL , PUBLIC :: ltrcdm2dc !: In case of Diurnal Cycle short wave, compute a Daily Mean short waves flux
!! !! now ! before !!
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau , utau_b !: sea surface i-stress (ocean referential) [N/m2]
@@ -90,5 +104,4 @@
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wndm !: wind speed module at T-point (=|U10m-Uoce|) [m/s]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsr !: sea heat flux: solar [W/m2]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsr_mean !: daily mean sea heat flux: solar [W/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qns , qns_b !: sea heat flux: non solar [W/m2]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsr_tot !: total solar heat flux (over sea and ice) [W/m2]
@@ -98,5 +111,6 @@
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(:,:) :: rnf , rnf_b !: river runoff [Kg/m2/s]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fwfisf , fwfisf_b !: ice shelf melting [Kg/m2/s]
!!
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sbc_tsc, sbc_tsc_b !: sbc content trend [K.m/s] jpi,jpj,jpts
@@ -110,4 +124,5 @@
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: atm_co2 !: atmospheric pCO2 [ppm]
#endif
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xcplmask !: coupling mask for ln_mixcpl (warning: allocated in sbccpl)
!!----------------------------------------------------------------------
@@ -121,4 +136,5 @@
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ssh_m !: mean (nn_fsbc time-step) sea surface height [m]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e3t_m !: mean (nn_fsbc time-step) sea surface layer thickness [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: frq_m !: mean (nn_fsbc time-step) fraction of solar net radiation absorbed in the 1st T level [-]
!! * Substitutions
@@ -147,6 +163,6 @@
& sfx (jpi,jpj) , sfx_b(jpi,jpj) , emp_tot(jpi,jpj), fmmflx(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) , STAT=ierr(3) )
+ ALLOCATE( fwfisf (jpi,jpj), rnf (jpi,jpj) , sbc_tsc (jpi,jpj,jpts) , qsr_hc (jpi,jpj,jpk) , &
+ & fwfisf_b(jpi,jpj), rnf_b(jpi,jpj) , sbc_tsc_b(jpi,jpj,jpts) , qsr_hc_b(jpi,jpj,jpk) , STAT=ierr(3) )
!
ALLOCATE( tprecip(jpi,jpj) , sprecip(jpi,jpj) , fr_i(jpi,jpj) , &
@@ -154,12 +170,10 @@
& atm_co2(jpi,jpj) , &
#endif
- & ssu_m (jpi,jpj) , sst_m(jpi,jpj) , &
- & ssv_m (jpi,jpj) , sss_m (jpi,jpj), ssh_m(jpi,jpj) , STAT=ierr(4) )
+ & 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) )
!
#if defined key_vvl
ALLOCATE( e3t_m(jpi,jpj) , STAT=ierr(5) )
#endif
- !
- IF( ltrcdm2dc ) ALLOCATE( qsr_mean(jpi,jpj) , STAT=ierr(5) )
!
sbc_oce_alloc = MAXVAL( ierr )
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90 (revision 5602)
@@ -43,5 +43,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 4.0 , NEMO Consortium (2011)
- !! $Id: $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90 (revision 5602)
@@ -34,9 +34,12 @@
USE albedo
USE prtctl ! Print control
-#if defined key_lim3
+#if defined key_lim3
USE ice
USE sbc_ice ! Surface boundary condition: ice fields
+ USE limthd_dh ! for CALL lim_thd_snwblow
#elif defined key_lim2
USE ice_2
+ USE sbc_ice ! Surface boundary condition: ice fields
+ USE par_ice_2 ! Surface boundary condition: ice fields
#endif
@@ -45,5 +48,8 @@
PUBLIC sbc_blk_clio ! routine called by sbcmod.F90
- PUBLIC blk_ice_clio ! routine called by sbcice_lim.F90
+#if defined key_lim2 || defined key_lim3
+ PUBLIC blk_ice_clio_tau ! routine called by sbcice_lim.F90
+ PUBLIC blk_ice_clio_flx ! routine called by sbcice_lim.F90
+#endif
INTEGER , PARAMETER :: jpfld = 7 ! maximum number of files to read
@@ -62,9 +68,6 @@
LOGICAL :: lbulk_init = .TRUE. ! flag, bulk initialization done or not)
-#if ! defined key_lim3
- ! in namicerun with LIM3
REAL(wp) :: cai = 1.40e-3 ! best estimate of atm drag in order to get correct FS export in ORCA2-LIM
REAL(wp) :: cao = 1.00e-3 ! chosen by default ==> should depends on many things... !!gmto be updated
-#endif
REAL(wp) :: rdtbs2 !:
@@ -381,10 +384,19 @@
& + sf(jp_prec)%fnow(:,:,1) * sf(jp_tair)%fnow(:,:,1) * zcprec ! add precip. heat content at Tair in Celcius
qns(:,:) = qns(:,:) * tmask(:,:,1)
+#if defined key_lim3
+ qns_oce(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)
+ qsr_oce(:,:) = qsr(:,:)
+#endif
! NB: if sea-ice model, the snow precip are computed and the associated heat is added to qns (see blk_ice_clio)
- CALL iom_put( "qlw_oce", zqlw ) ! output downward longwave heat over the ocean
- CALL iom_put( "qsb_oce", - zqsb ) ! output downward sensible heat over the ocean
- CALL iom_put( "qla_oce", - zqla ) ! output downward latent heat over the ocean
- CALL iom_put( "qns_oce", qns ) ! output downward non solar heat over the ocean
+ IF ( nn_ice == 0 ) THEN
+ CALL iom_put( "qlw_oce" , zqlw ) ! output downward longwave heat over the ocean
+ CALL iom_put( "qsb_oce" , - zqsb ) ! output downward sensible heat over the ocean
+ CALL iom_put( "qla_oce" , - zqla ) ! output downward latent heat over the ocean
+ CALL iom_put( "qemp_oce", qns-zqlw+zqsb+zqla ) ! output downward heat content of E-P over the ocean
+ CALL iom_put( "qns_oce" , qns ) ! output downward non solar heat over the ocean
+ CALL iom_put( "qsr_oce" , qsr ) ! output downward solar heat over the ocean
+ CALL iom_put( "qt_oce" , qns+qsr ) ! output total downward heat over the ocean
+ ENDIF
IF(ln_ctl) THEN
@@ -402,12 +414,55 @@
END SUBROUTINE blk_oce_clio
-
- SUBROUTINE blk_ice_clio( pst , palb_cs, palb_os, palb, &
- & p_taui, p_tauj, p_qns , p_qsr, &
- & p_qla , p_dqns, p_dqla, &
- & p_tpr , p_spr , &
- & p_fr1 , p_fr2 , cd_grid, pdim )
+# if defined key_lim2 || defined key_lim3
+ SUBROUTINE blk_ice_clio_tau
!!---------------------------------------------------------------------------
- !! *** ROUTINE blk_ice_clio ***
+ !! *** ROUTINE blk_ice_clio_tau ***
+ !!
+ !! ** Purpose : Computation momentum flux at the ice-atm interface
+ !!
+ !! ** Method : Read utau from a forcing file. Rearrange if C-grid
+ !!
+ !!----------------------------------------------------------------------
+ REAL(wp) :: zcoef
+ INTEGER :: ji, jj ! dummy loop indices
+ !!---------------------------------------------------------------------
+ !
+ IF( nn_timing == 1 ) CALL timing_start('blk_ice_clio_tau')
+
+ SELECT CASE( cp_ice_msh )
+
+ CASE( 'C' ) ! C-grid ice dynamics
+
+ zcoef = cai / cao ! Change from air-sea stress to air-ice stress
+ utau_ice(:,:) = zcoef * utau(:,:)
+ vtau_ice(:,:) = zcoef * vtau(:,:)
+
+ CASE( 'I' ) ! I-grid ice dynamics: I-point (i.e. F-point lower-left corner)
+
+ zcoef = 0.5_wp * cai / cao ! Change from air-sea stress to air-ice stress
+ DO jj = 2, jpj ! stress from ocean U- and V-points to ice U,V point
+ DO ji = 2, jpi ! I-grid : no vector opt.
+ utau_ice(ji,jj) = zcoef * ( utau(ji-1,jj ) + utau(ji-1,jj-1) )
+ vtau_ice(ji,jj) = zcoef * ( vtau(ji ,jj-1) + vtau(ji-1,jj-1) )
+ END DO
+ END DO
+
+ CALL lbc_lnk( utau_ice(:,:), 'I', -1. ) ; CALL lbc_lnk( vtau_ice(:,:), 'I', -1. ) ! I-point
+
+ END SELECT
+
+ IF(ln_ctl) THEN
+ CALL prt_ctl(tab2d_1=utau_ice , clinfo1=' blk_ice_clio: utau_ice : ', tab2d_2=vtau_ice , clinfo2=' vtau_ice : ')
+ ENDIF
+
+ IF( nn_timing == 1 ) CALL timing_stop('blk_ice_clio_tau')
+
+ END SUBROUTINE blk_ice_clio_tau
+#endif
+
+# if defined key_lim2 || defined key_lim3
+ SUBROUTINE blk_ice_clio_flx( ptsu , palb_cs, palb_os, palb )
+ !!---------------------------------------------------------------------------
+ !! *** ROUTINE blk_ice_clio_flx ***
!!
!! ** Purpose : Computation of the heat fluxes at ocean and snow/ice
@@ -431,26 +486,12 @@
!! to take into account solid precip latent heat flux
!!----------------------------------------------------------------------
- REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: pst ! ice surface temperature [Kelvin]
+ REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: ptsu ! ice surface temperature [Kelvin]
REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: palb_cs ! ice albedo (clear sky) (alb_ice_cs) [-]
REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: palb_os ! ice albedo (overcast sky) (alb_ice_os) [-]
REAL(wp), INTENT( out), DIMENSION(:,:,:) :: palb ! ice albedo (actual value) [-]
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_taui ! surface ice stress at I-point (i-component) [N/m2]
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_tauj ! surface ice stress at I-point (j-component) [N/m2]
- REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_qns ! non solar heat flux over ice (T-point) [W/m2]
- REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_qsr ! solar heat flux over ice (T-point) [W/m2]
- REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_qla ! latent heat flux over ice (T-point) [W/m2]
- REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_dqns ! non solar heat sensistivity (T-point) [W/m2]
- REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_dqla ! latent heat sensistivity (T-point) [W/m2]
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_tpr ! total precipitation (T-point) [Kg/m2/s]
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_spr ! solid precipitation (T-point) [Kg/m2/s]
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_fr1 ! 1sr fraction of qsr penetration in ice [-]
- REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_fr2 ! 2nd fraction of qsr penetration in ice [-]
- CHARACTER(len=1), INTENT(in ) :: cd_grid ! type of sea-ice grid ("C" or "B" grid)
- INTEGER, INTENT(in ) :: pdim ! number of ice categories
!!
INTEGER :: ji, jj, jl ! dummy loop indices
- INTEGER :: ijpl ! number of ice categories (size of 3rd dim of input arrays)
- !!
- REAL(wp) :: zcoef, zmt1, zmt2, zmt3, ztatm3 ! temporary scalars
+ !!
+ REAL(wp) :: zmt1, zmt2, zmt3, ztatm3 ! temporary scalars
REAL(wp) :: ztaevbk, zind1, zind2, zind3, ztamr ! - -
REAL(wp) :: zesi, zqsati, zdesidt ! - -
@@ -458,4 +499,5 @@
REAL(wp) :: zcshi, zclei, zrhovaclei, zrhovacshi ! - -
REAL(wp) :: ztice3, zticemb, zticemb2, zdqlw, zdqsb ! - -
+ REAL(wp) :: z1_lsub ! - -
!!
REAL(wp), DIMENSION(:,:) , POINTER :: ztatm ! Tair in Kelvin
@@ -464,42 +506,18 @@
REAL(wp), DIMENSION(:,:) , POINTER :: zrhoa ! air density
REAL(wp), DIMENSION(:,:,:), POINTER :: z_qlw, z_qsb
+ REAL(wp), DIMENSION(:,:) , POINTER :: zevap, zsnw
!!---------------------------------------------------------------------
!
- IF( nn_timing == 1 ) CALL timing_start('blk_ice_clio')
+ IF( nn_timing == 1 ) CALL timing_start('blk_ice_clio_flx')
!
CALL wrk_alloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa )
- CALL wrk_alloc( jpi,jpj,pdim, z_qlw, z_qsb )
-
- ijpl = pdim ! number of ice categories
+ CALL wrk_alloc( jpi,jpj, jpl, z_qlw, z_qsb )
+
zpatm = 101000. ! atmospheric pressure (assumed constant here)
-
-#if defined key_lim3
- tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1) ! LIM3: make Tair available in sea-ice. WARNING allocated after call to ice_init
-#endif
- ! ! surface ocean fluxes computed with CLIO bulk formulea
- !------------------------------------!
- ! momentum fluxes (utau, vtau ) !
- !------------------------------------!
-
- SELECT CASE( cd_grid )
- CASE( 'C' ) ! C-grid ice dynamics
- zcoef = cai / cao ! Change from air-sea stress to air-ice stress
- p_taui(:,:) = zcoef * utau(:,:)
- p_tauj(:,:) = zcoef * vtau(:,:)
- CASE( 'I' ) ! I-grid ice dynamics: I-point (i.e. F-point lower-left corner)
- zcoef = 0.5_wp * cai / cao ! Change from air-sea stress to air-ice stress
- DO jj = 2, jpj ! stress from ocean U- and V-points to ice U,V point
- DO ji = 2, jpi ! I-grid : no vector opt.
- p_taui(ji,jj) = zcoef * ( utau(ji-1,jj ) + utau(ji-1,jj-1) )
- p_tauj(ji,jj) = zcoef * ( vtau(ji ,jj-1) + vtau(ji-1,jj-1) )
- END DO
- END DO
- CALL lbc_lnk( p_taui(:,:), 'I', -1. ) ; CALL lbc_lnk( p_tauj(:,:), 'I', -1. ) ! I-point
- END SELECT
-
-
+ !--------------------------------------------------------------------------------
! Determine cloud optical depths as a function of latitude (Chou et al., 1981).
! and the correction factor for taking into account the effect of clouds
- !------------------------------------------------------
+ !--------------------------------------------------------------------------------
+
!CDIR NOVERRCHK
!CDIR COLLAPSE
@@ -528,5 +546,5 @@
zmt2 = ( 272.0 - ztatm(ji,jj) ) / 38.0 ; zind2 = MAX( 0.e0, SIGN( 1.e0, zmt2 ) )
zmt3 = ( 281.0 - ztatm(ji,jj) ) / 18.0 ; zind3 = MAX( 0.e0, SIGN( 1.e0, zmt3 ) )
- p_spr(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) / rday & ! rday = converte mm/day to kg/m2/s
+ sprecip(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) / rday & ! rday = converte mm/day to kg/m2/s
& * ( zind1 & ! solid (snow) precipitation [kg/m2/s]
& + ( 1.0 - zind1 ) * ( zind2 * ( 0.5 + zmt2 ) &
@@ -538,22 +556,22 @@
! fraction of qsr_ice which is NOT absorbed in the thin surface layer
! and thus which penetrates inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 )
- p_fr1(ji,jj) = 0.18 * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.35 * sf(jp_ccov)%fnow(ji,jj,1)
- p_fr2(ji,jj) = 0.82 * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.65 * sf(jp_ccov)%fnow(ji,jj,1)
- END DO
- END DO
- CALL iom_put( 'snowpre', p_spr ) ! Snow precipitation
+ fr1_i0(ji,jj) = 0.18 * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.35 * sf(jp_ccov)%fnow(ji,jj,1)
+ fr2_i0(ji,jj) = 0.82 * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.65 * sf(jp_ccov)%fnow(ji,jj,1)
+ END DO
+ END DO
+ CALL iom_put( 'snowpre', sprecip ) ! Snow precipitation
!-----------------------------------------------------------!
! snow/ice Shortwave radiation (abedo already computed) !
!-----------------------------------------------------------!
- CALL blk_clio_qsr_ice( palb_cs, palb_os, p_qsr )
-
- DO jl = 1, ijpl
- palb(:,:,jl) = ( palb_cs(:,:,jl) * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) &
- & + palb_os(:,:,jl) * sf(jp_ccov)%fnow(ji,jj,1) )
+ CALL blk_clio_qsr_ice( palb_cs, palb_os, qsr_ice )
+
+ DO jl = 1, jpl
+ palb(:,:,jl) = ( palb_cs(:,:,jl) * ( 1.e0 - sf(jp_ccov)%fnow(:,:,1) ) &
+ & + palb_os(:,:,jl) * sf(jp_ccov)%fnow(:,:,1) )
END DO
! ! ========================== !
- DO jl = 1, ijpl ! Loop over ice categories !
+ DO jl = 1, jpl ! Loop over ice categories !
! ! ========================== !
!CDIR NOVERRCHK
@@ -569,5 +587,5 @@
ztaevbk = ztatm3 * ztatm(ji,jj) * zcldeff * ( 0.39 - 0.05 * zevsqr(ji,jj) )
!
- z_qlw(ji,jj,jl) = - emic * stefan * ( ztaevbk + 4. * ztatm3 * ( pst(ji,jj,jl) - ztatm(ji,jj) ) )
+ z_qlw(ji,jj,jl) = - emic * stefan * ( ztaevbk + 4. * ztatm3 * ( ptsu(ji,jj,jl) - ztatm(ji,jj) ) )
!----------------------------------------
@@ -576,12 +594,12 @@
! vapour pressure at saturation of ice (tmask to avoid overflow in the exponential)
- zesi = 611.0 * EXP( 21.8745587 * tmask(ji,jj,1) * ( pst(ji,jj,jl) - rtt )/ ( pst(ji,jj,jl) - 7.66 ) )
+ zesi = 611.0 * EXP( 21.8745587 * tmask(ji,jj,1) * ( ptsu(ji,jj,jl) - rtt )/ ( ptsu(ji,jj,jl) - 7.66 ) )
! humidity close to the ice surface (at saturation)
zqsati = ( 0.622 * zesi ) / ( zpatm - 0.378 * zesi )
! computation of intermediate values
- zticemb = pst(ji,jj,jl) - 7.66
+ zticemb = ptsu(ji,jj,jl) - 7.66
zticemb2 = zticemb * zticemb
- ztice3 = pst(ji,jj,jl) * pst(ji,jj,jl) * pst(ji,jj,jl)
+ ztice3 = ptsu(ji,jj,jl) * ptsu(ji,jj,jl) * ptsu(ji,jj,jl)
zdesidt = zesi * ( 9.5 * LOG( 10.0 ) * ( rtt - 7.66 ) / zticemb2 )
@@ -596,8 +614,8 @@
! sensible heat flux
- z_qsb(ji,jj,jl) = zrhovacshi * ( pst(ji,jj,jl) - ztatm(ji,jj) )
+ z_qsb(ji,jj,jl) = zrhovacshi * ( ptsu(ji,jj,jl) - ztatm(ji,jj) )
! latent heat flux
- p_qla(ji,jj,jl) = MAX( 0.e0, zrhovaclei * ( zqsati - zqatm(ji,jj) ) )
+ qla_ice(ji,jj,jl) = MAX( 0.e0, zrhovaclei * ( zqsati - zqatm(ji,jj) ) )
! sensitivity of non solar fluxes (dQ/dT) (long-wave, sensible and latent fluxes)
@@ -606,6 +624,6 @@
zdqla = zrhovaclei * ( zdesidt * ( zqsati * zqsati / ( zesi * zesi ) ) * ( zpatm / 0.622 ) )
!
- p_dqla(ji,jj,jl) = zdqla ! latent flux sensitivity
- p_dqns(ji,jj,jl) = -( zdqlw + zdqsb + zdqla ) ! total non solar sensitivity
+ dqla_ice(ji,jj,jl) = zdqla ! latent flux sensitivity
+ dqns_ice(ji,jj,jl) = -( zdqlw + zdqsb + zdqla ) ! total non solar sensitivity
END DO
!
@@ -619,7 +637,7 @@
!
!CDIR COLLAPSE
- p_qns(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - p_qla (:,:,:) ! Downward Non Solar flux
-!CDIR COLLAPSE
- p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) / rday ! total precipitation [kg/m2/s]
+ qns_ice(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - qla_ice (:,:,:) ! Downward Non Solar flux
+!CDIR COLLAPSE
+ tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) / rday ! total precipitation [kg/m2/s]
!
! ----------------------------------------------------------------------------- !
@@ -628,42 +646,79 @@
!CDIR COLLAPSE
qns(:,:) = qns(:,:) & ! update the non-solar heat flux with:
- & - p_spr(:,:) * lfus & ! remove melting solid precip
- & + p_spr(:,:) * MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow - rt0 ) * cpic & ! add solid P at least below melting
- & - p_spr(:,:) * sf(jp_tair)%fnow(:,:,1) * rcp ! remove solid precip. at Tair
- !
+ & - sprecip(:,:) * lfus & ! remove melting solid precip
+ & + sprecip(:,:) * MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow - rt0 ) * cpic & ! add solid P at least below melting
+ & - sprecip(:,:) * sf(jp_tair)%fnow(:,:,1) * rcp ! remove solid precip. at Tair
+
+#if defined key_lim3
+ ! ----------------------------------------------------------------------------- !
+ ! Distribute evapo, precip & associated heat over ice and ocean
+ ! ---------------=====--------------------------------------------------------- !
+ CALL wrk_alloc( jpi,jpj, zevap, zsnw )
+
+ ! --- evaporation --- !
+ z1_lsub = 1._wp / Lsub
+ evap_ice (:,:,:) = qla_ice (:,:,:) * z1_lsub ! sublimation
+ devap_ice(:,:,:) = dqla_ice(:,:,:) * z1_lsub
+ zevap (:,:) = emp(:,:) + tprecip(:,:) ! evaporation over ocean
+
+ ! --- evaporation minus precipitation --- !
+ zsnw(:,:) = 0._wp
+ CALL lim_thd_snwblow( pfrld, zsnw ) ! snow redistribution by wind
+ emp_oce(:,:) = pfrld(:,:) * 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(:,:) = - pfrld(:,:) * zevap(:,:) * sst_m(:,:) * rcp & ! evap
+ & + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp & ! liquid precip
+ & + sprecip(:,:) * ( 1._wp - zsnw ) * & ! solid precip
+ & ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus )
+ qemp_ice(:,:) = sprecip(:,:) * zsnw * & ! solid precip (only)
+ & ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus )
+
+ ! --- total solar and non solar fluxes --- !
+ qns_tot(:,:) = pfrld(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:)
+ qsr_tot(:,:) = pfrld(:,:) * 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(:,:) = rhosn * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus )
+
+ CALL wrk_dealloc( jpi,jpj, zevap, zsnw )
+#endif
+
!!gm : not necessary as all input data are lbc_lnk...
- CALL lbc_lnk( p_fr1 (:,:) , 'T', 1. )
- CALL lbc_lnk( p_fr2 (:,:) , 'T', 1. )
- DO jl = 1, ijpl
- CALL lbc_lnk( p_qns (:,:,jl) , 'T', 1. )
- CALL lbc_lnk( p_dqns(:,:,jl) , 'T', 1. )
- CALL lbc_lnk( p_qla (:,:,jl) , 'T', 1. )
- CALL lbc_lnk( p_dqla(:,:,jl) , 'T', 1. )
+ CALL lbc_lnk( fr1_i0 (:,:) , 'T', 1. )
+ CALL lbc_lnk( fr2_i0 (:,:) , 'T', 1. )
+ DO jl = 1, jpl
+ CALL lbc_lnk( qns_ice (:,:,jl) , 'T', 1. )
+ CALL lbc_lnk( dqns_ice(:,:,jl) , 'T', 1. )
+ CALL lbc_lnk( qla_ice (:,:,jl) , 'T', 1. )
+ CALL lbc_lnk( dqla_ice(:,:,jl) , 'T', 1. )
END DO
!!gm : mask is not required on forcing
- DO jl = 1, ijpl
- p_qns (:,:,jl) = p_qns (:,:,jl) * tmask(:,:,1)
- p_qla (:,:,jl) = p_qla (:,:,jl) * tmask(:,:,1)
- p_dqns(:,:,jl) = p_dqns(:,:,jl) * tmask(:,:,1)
- p_dqla(:,:,jl) = p_dqla(:,:,jl) * tmask(:,:,1)
- END DO
+ DO jl = 1, jpl
+ qns_ice (:,:,jl) = qns_ice (:,:,jl) * tmask(:,:,1)
+ qla_ice (:,:,jl) = qla_ice (:,:,jl) * tmask(:,:,1)
+ dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * tmask(:,:,1)
+ dqla_ice(:,:,jl) = dqla_ice(:,:,jl) * tmask(:,:,1)
+ END DO
+
+ CALL wrk_dealloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa )
+ CALL wrk_dealloc( jpi,jpj, jpl , z_qlw, z_qsb )
IF(ln_ctl) THEN
- CALL prt_ctl(tab3d_1=z_qsb , clinfo1=' blk_ice_clio: z_qsb : ', tab3d_2=z_qlw , clinfo2=' z_qlw : ', kdim=ijpl)
- CALL prt_ctl(tab3d_1=p_qla , clinfo1=' blk_ice_clio: z_qla : ', tab3d_2=p_qsr , clinfo2=' p_qsr : ', kdim=ijpl)
- CALL prt_ctl(tab3d_1=p_dqns , clinfo1=' blk_ice_clio: p_dqns : ', tab3d_2=p_qns , clinfo2=' p_qns : ', kdim=ijpl)
- CALL prt_ctl(tab3d_1=p_dqla , clinfo1=' blk_ice_clio: p_dqla : ', tab3d_2=pst , clinfo2=' pst : ', kdim=ijpl)
- CALL prt_ctl(tab2d_1=p_tpr , clinfo1=' blk_ice_clio: p_tpr : ', tab2d_2=p_spr , clinfo2=' p_spr : ')
- CALL prt_ctl(tab2d_1=p_taui , clinfo1=' blk_ice_clio: p_taui : ', tab2d_2=p_tauj , clinfo2=' p_tauj : ')
+ CALL prt_ctl(tab3d_1=z_qsb , clinfo1=' blk_ice_clio: z_qsb : ', tab3d_2=z_qlw , clinfo2=' z_qlw : ', kdim=jpl)
+ CALL prt_ctl(tab3d_1=qla_ice , clinfo1=' blk_ice_clio: z_qla : ', tab3d_2=qsr_ice , clinfo2=' qsr_ice : ', kdim=jpl)
+ CALL prt_ctl(tab3d_1=dqns_ice , clinfo1=' blk_ice_clio: dqns_ice : ', tab3d_2=qns_ice , clinfo2=' qns_ice : ', kdim=jpl)
+ CALL prt_ctl(tab3d_1=dqla_ice , clinfo1=' blk_ice_clio: dqla_ice : ', tab3d_2=ptsu , clinfo2=' ptsu : ', kdim=jpl)
+ CALL prt_ctl(tab2d_1=tprecip , clinfo1=' blk_ice_clio: tprecip : ', tab2d_2=sprecip , clinfo2=' sprecip : ')
ENDIF
- CALL wrk_dealloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa )
- CALL wrk_dealloc( jpi,jpj,pdim, z_qlw, z_qsb )
- !
- IF( nn_timing == 1 ) CALL timing_stop('blk_ice_clio')
- !
- END SUBROUTINE blk_ice_clio
-
+ IF( nn_timing == 1 ) CALL timing_stop('blk_ice_clio_flx')
+ !
+ END SUBROUTINE blk_ice_clio_flx
+
+#endif
SUBROUTINE blk_clio_qsr_oce( pqsr_oce )
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90 (revision 5602)
@@ -22,6 +22,4 @@
!! blk_oce_core : computes momentum, heat and freshwater fluxes over ocean
!! blk_ice_core : computes momentum, heat and freshwater fluxes over ice
- !! blk_bio_meanqsr : compute daily mean short wave radiation over the ocean
- !! blk_ice_meanqsr : compute daily mean short wave radiation over the ice
!! turb_core_2z : Computes turbulent transfert coefficients
!! cd_neutral_10m : Estimate of the neutral drag coefficient at 10m
@@ -46,4 +44,11 @@
USE sbc_ice ! Surface boundary condition: ice fields
USE lib_fortran ! to use key_nosignedzero
+#if defined key_lim3
+ USE ice, ONLY : u_ice, v_ice, jpl, pfrld, a_i_b
+ USE limthd_dh ! for CALL lim_thd_snwblow
+#elif defined key_lim2
+ USE ice_2, ONLY : u_ice, v_ice
+ USE par_ice_2
+#endif
IMPLICIT NONE
@@ -51,6 +56,8 @@
PUBLIC sbc_blk_core ! routine called in sbcmod module
- PUBLIC blk_ice_core ! routine called in sbc_ice_lim module
- PUBLIC blk_ice_meanqsr ! routine called in sbc_ice_lim module
+#if defined key_lim2 || defined key_lim3
+ PUBLIC blk_ice_core_tau ! routine called in sbc_ice_lim module
+ PUBLIC blk_ice_core_flx ! routine called in sbc_ice_lim module
+#endif
PUBLIC turb_core_2z ! routine calles in sbcblk_mfs module
@@ -195,7 +202,4 @@
! ! compute the surface ocean fluxes using CORE bulk formulea
IF( MOD( kt - 1, nn_fsbc ) == 0 ) CALL blk_oce_core( kt, sf, sst_m, ssu_m, ssv_m )
-
- ! If diurnal cycle is activated, compute a daily mean short waves flux for biogeochemistery
- IF( ltrcdm2dc ) CALL blk_bio_meanqsr
#if defined key_cice
@@ -302,4 +306,5 @@
ELSE ; qsr(:,:) = zztmp * sf(jp_qsr)%fnow(:,:,1) * tmask(:,:,1)
ENDIF
+
zqlw(:,:) = ( sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:) ) * tmask(:,:,1) ! Long Wave
! ----------------------------------------------------------------------------- !
@@ -376,5 +381,6 @@
emp (:,:) = ( zevap(:,:) & ! mass flux (evap. - precip.)
& - sf(jp_prec)%fnow(:,:,1) * rn_pfac ) * tmask(:,:,1)
- qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) & ! Downward Non Solar flux
+ !
+ qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) & ! Downward Non Solar
& - sf(jp_snow)%fnow(:,:,1) * rn_pfac * lfus & ! remove latent melting heat for solid precip
& - zevap(:,:) * pst(:,:) * rcp & ! remove evap heat content at SST
@@ -384,9 +390,18 @@
& * ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1)
!
- CALL iom_put( "qlw_oce", zqlw ) ! output downward longwave heat over the ocean
- CALL iom_put( "qsb_oce", - zqsb ) ! output downward sensible heat over the ocean
- CALL iom_put( "qla_oce", - zqla ) ! output downward latent heat over the ocean
- CALL iom_put( "qhc_oce", qns-zqlw+zqsb+zqla ) ! output downward heat content of E-P over the ocean
- CALL iom_put( "qns_oce", qns ) ! output downward non solar heat over the ocean
+#if defined key_lim3
+ qns_oce(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) ! non solar without emp (only needed by LIM3)
+ qsr_oce(:,:) = qsr(:,:)
+#endif
+ !
+ IF ( nn_ice == 0 ) THEN
+ CALL iom_put( "qlw_oce" , zqlw ) ! output downward longwave heat over the ocean
+ CALL iom_put( "qsb_oce" , - zqsb ) ! output downward sensible heat over the ocean
+ CALL iom_put( "qla_oce" , - zqla ) ! output downward latent heat over the ocean
+ CALL iom_put( "qemp_oce", qns-zqlw+zqsb+zqla ) ! output downward heat content of E-P over the ocean
+ CALL iom_put( "qns_oce" , qns ) ! output downward non solar heat over the ocean
+ CALL iom_put( "qsr_oce" , qsr ) ! output downward solar heat over the ocean
+ CALL iom_put( "qt_oce" , qns+qsr ) ! output total downward heat over the ocean
+ ENDIF
!
IF(ln_ctl) THEN
@@ -406,81 +421,37 @@
- SUBROUTINE blk_ice_core( pst , pui , pvi , palb , &
- & p_taui, p_tauj, p_qns , p_qsr, &
- & p_qla , p_dqns, p_dqla, &
- & p_tpr , p_spr , &
- & p_fr1 , p_fr2 , cd_grid, pdim )
- !!---------------------------------------------------------------------
- !! *** ROUTINE blk_ice_core ***
+#if defined key_lim2 || defined key_lim3
+ SUBROUTINE blk_ice_core_tau
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE blk_ice_core_tau ***
!!
!! ** Purpose : provide the surface boundary condition over sea-ice
!!
- !! ** Method : compute momentum, heat and freshwater exchanged
- !! between atmosphere and sea-ice using CORE bulk
- !! formulea, ice variables and read atmmospheric fields.
+ !! ** Method : compute momentum using CORE bulk
+ !! formulea, ice variables and read atmospheric fields.
!! NB: ice drag coefficient is assumed to be a constant
- !!
- !! caution : the net upward water flux has with mm/day unit
- !!---------------------------------------------------------------------
- REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pst ! ice surface temperature (>0, =rt0 over land) [Kelvin]
- REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pui ! ice surface velocity (i- and i- components [m/s]
- REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pvi ! at I-point (B-grid) or U & V-point (C-grid)
- REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: palb ! ice albedo (all skies) [%]
- REAL(wp), DIMENSION(:,:) , INTENT( out) :: p_taui ! i- & j-components of surface ice stress [N/m2]
- REAL(wp), DIMENSION(:,:) , INTENT( out) :: p_tauj ! at I-point (B-grid) or U & V-point (C-grid)
- REAL(wp), DIMENSION(:,:,:), INTENT( out) :: p_qns ! non solar heat flux over ice (T-point) [W/m2]
- REAL(wp), DIMENSION(:,:,:), INTENT( out) :: p_qsr ! solar heat flux over ice (T-point) [W/m2]
- REAL(wp), DIMENSION(:,:,:), INTENT( out) :: p_qla ! latent heat flux over ice (T-point) [W/m2]
- REAL(wp), DIMENSION(:,:,:), INTENT( out) :: p_dqns ! non solar heat sensistivity (T-point) [W/m2]
- REAL(wp), DIMENSION(:,:,:), INTENT( out) :: p_dqla ! latent heat sensistivity (T-point) [W/m2]
- REAL(wp), DIMENSION(:,:) , INTENT( out) :: p_tpr ! total precipitation (T-point) [Kg/m2/s]
- REAL(wp), DIMENSION(:,:) , INTENT( out) :: p_spr ! solid precipitation (T-point) [Kg/m2/s]
- REAL(wp), DIMENSION(:,:) , INTENT( out) :: p_fr1 ! 1sr fraction of qsr penetration in ice (T-point) [%]
- REAL(wp), DIMENSION(:,:) , INTENT( out) :: p_fr2 ! 2nd fraction of qsr penetration in ice (T-point) [%]
- CHARACTER(len=1) , INTENT(in ) :: cd_grid ! ice grid ( C or B-grid)
- INTEGER , INTENT(in ) :: pdim ! number of ice categories
- !!
- INTEGER :: ji, jj, jl ! dummy loop indices
- INTEGER :: ijpl ! number of ice categories (size of 3rd dim of input arrays)
- REAL(wp) :: zst2, zst3
- REAL(wp) :: zcoef_wnorm, zcoef_wnorm2, zcoef_dqlw, zcoef_dqla, zcoef_dqsb
- REAL(wp) :: zztmp ! temporary variable
- REAL(wp) :: zwnorm_f, zwndi_f , zwndj_f ! relative wind module and components at F-point
- REAL(wp) :: zwndi_t , zwndj_t ! relative wind components at T-point
- !!
- REAL(wp), DIMENSION(:,:) , POINTER :: z_wnds_t ! wind speed ( = | U10m - U_ice | ) at T-point
- REAL(wp), DIMENSION(:,:,:), POINTER :: z_qlw ! long wave heat flux over ice
- REAL(wp), DIMENSION(:,:,:), POINTER :: z_qsb ! sensible heat flux over ice
- REAL(wp), DIMENSION(:,:,:), POINTER :: z_dqlw ! long wave heat sensitivity over ice
- REAL(wp), DIMENSION(:,:,:), POINTER :: z_dqsb ! sensible heat sensitivity over ice
- !!---------------------------------------------------------------------
- !
- IF( nn_timing == 1 ) CALL timing_start('blk_ice_core')
- !
- CALL wrk_alloc( jpi,jpj, z_wnds_t )
- CALL wrk_alloc( jpi,jpj,pdim, z_qlw, z_qsb, z_dqlw, z_dqsb )
-
- ijpl = pdim ! number of ice categories
-
+ !!---------------------------------------------------------------------
+ INTEGER :: ji, jj ! dummy loop indices
+ REAL(wp) :: zcoef_wnorm, zcoef_wnorm2
+ REAL(wp) :: zwnorm_f, zwndi_f , zwndj_f ! relative wind module and components at F-point
+ REAL(wp) :: zwndi_t , zwndj_t ! relative wind components at T-point
+ !!---------------------------------------------------------------------
+ !
+ IF( nn_timing == 1 ) CALL timing_start('blk_ice_core_tau')
+ !
! local scalars ( place there for vector optimisation purposes)
zcoef_wnorm = rhoa * Cice
zcoef_wnorm2 = rhoa * Cice * 0.5
- zcoef_dqlw = 4.0 * 0.95 * Stef
- zcoef_dqla = -Ls * Cice * 11637800. * (-5897.8)
- zcoef_dqsb = rhoa * cpa * Cice
!!gm brutal....
- z_wnds_t(:,:) = 0.e0
- p_taui (:,:) = 0.e0
- p_tauj (:,:) = 0.e0
+ utau_ice (:,:) = 0._wp
+ vtau_ice (:,:) = 0._wp
+ wndm_ice (:,:) = 0._wp
!!gm end
-#if defined key_lim3
- tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1) ! LIM3: make Tair available in sea-ice. WARNING allocated after call to ice_init
-#endif
! ----------------------------------------------------------------------------- !
! Wind components and module relative to the moving ocean ( U10m - U_ice ) !
! ----------------------------------------------------------------------------- !
- SELECT CASE( cd_grid )
+ SELECT CASE( cp_ice_msh )
CASE( 'I' ) ! B-grid ice dynamics : I-point (i.e. F-point with sea-ice indexation)
! and scalar wind at T-point ( = | U10m - U_ice | ) (masked)
@@ -489,48 +460,94 @@
! ... scalar wind at I-point (fld being at T-point)
zwndi_f = 0.25 * ( sf(jp_wndi)%fnow(ji-1,jj ,1) + sf(jp_wndi)%fnow(ji ,jj ,1) &
- & + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji ,jj-1,1) ) - rn_vfac * pui(ji,jj)
+ & + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji ,jj-1,1) ) - rn_vfac * u_ice(ji,jj)
zwndj_f = 0.25 * ( sf(jp_wndj)%fnow(ji-1,jj ,1) + sf(jp_wndj)%fnow(ji ,jj ,1) &
- & + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji ,jj-1,1) ) - rn_vfac * pvi(ji,jj)
+ & + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji ,jj-1,1) ) - rn_vfac * v_ice(ji,jj)
zwnorm_f = zcoef_wnorm * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f )
! ... ice stress at I-point
- p_taui(ji,jj) = zwnorm_f * zwndi_f
- p_tauj(ji,jj) = zwnorm_f * zwndj_f
+ utau_ice(ji,jj) = zwnorm_f * zwndi_f
+ vtau_ice(ji,jj) = zwnorm_f * zwndj_f
! ... scalar wind at T-point (fld being at T-point)
- zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.25 * ( pui(ji,jj+1) + pui(ji+1,jj+1) &
- & + pui(ji,jj ) + pui(ji+1,jj ) )
- zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.25 * ( pvi(ji,jj+1) + pvi(ji+1,jj+1) &
- & + pvi(ji,jj ) + pvi(ji+1,jj ) )
- z_wnds_t(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)
+ zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.25 * ( u_ice(ji,jj+1) + u_ice(ji+1,jj+1) &
+ & + u_ice(ji,jj ) + u_ice(ji+1,jj ) )
+ zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.25 * ( v_ice(ji,jj+1) + v_ice(ji+1,jj+1) &
+ & + v_ice(ji,jj ) + v_ice(ji+1,jj ) )
+ wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)
END DO
END DO
- CALL lbc_lnk( p_taui , 'I', -1. )
- CALL lbc_lnk( p_tauj , 'I', -1. )
- CALL lbc_lnk( z_wnds_t, 'T', 1. )
+ CALL lbc_lnk( utau_ice, 'I', -1. )
+ CALL lbc_lnk( vtau_ice, 'I', -1. )
+ CALL lbc_lnk( wndm_ice, 'T', 1. )
!
CASE( 'C' ) ! C-grid ice dynamics : U & V-points (same as ocean)
DO jj = 2, jpj
DO ji = fs_2, jpi ! vect. opt.
- zwndi_t = ( sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pui(ji-1,jj ) + pui(ji,jj) ) )
- zwndj_t = ( sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pvi(ji ,jj-1) + pvi(ji,jj) ) )
- z_wnds_t(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)
+ zwndi_t = ( sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( u_ice(ji-1,jj ) + u_ice(ji,jj) ) )
+ zwndj_t = ( sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( v_ice(ji ,jj-1) + v_ice(ji,jj) ) )
+ wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)
END DO
END DO
DO jj = 2, jpjm1
DO ji = fs_2, fs_jpim1 ! vect. opt.
- p_taui(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji+1,jj ) + z_wnds_t(ji,jj) ) &
- & * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - rn_vfac * pui(ji,jj) )
- p_tauj(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji,jj+1 ) + z_wnds_t(ji,jj) ) &
- & * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - rn_vfac * pvi(ji,jj) )
+ utau_ice(ji,jj) = zcoef_wnorm2 * ( wndm_ice(ji+1,jj ) + wndm_ice(ji,jj) ) &
+ & * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - rn_vfac * u_ice(ji,jj) )
+ vtau_ice(ji,jj) = zcoef_wnorm2 * ( wndm_ice(ji,jj+1 ) + wndm_ice(ji,jj) ) &
+ & * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - rn_vfac * v_ice(ji,jj) )
END DO
END DO
- CALL lbc_lnk( p_taui , 'U', -1. )
- CALL lbc_lnk( p_tauj , 'V', -1. )
- CALL lbc_lnk( z_wnds_t, 'T', 1. )
+ CALL lbc_lnk( utau_ice, 'U', -1. )
+ CALL lbc_lnk( vtau_ice, 'V', -1. )
+ CALL lbc_lnk( wndm_ice, 'T', 1. )
!
END SELECT
+
+ IF(ln_ctl) THEN
+ CALL prt_ctl(tab2d_1=utau_ice , clinfo1=' blk_ice_core: utau_ice : ', tab2d_2=vtau_ice , clinfo2=' vtau_ice : ')
+ CALL prt_ctl(tab2d_1=wndm_ice , clinfo1=' blk_ice_core: wndm_ice : ')
+ ENDIF
+
+ IF( nn_timing == 1 ) CALL timing_stop('blk_ice_core_tau')
+
+ END SUBROUTINE blk_ice_core_tau
+
+
+ SUBROUTINE blk_ice_core_flx( ptsu, palb )
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE blk_ice_core_flx ***
+ !!
+ !! ** Purpose : provide the surface boundary condition over sea-ice
+ !!
+ !! ** Method : compute heat and freshwater exchanged
+ !! between atmosphere and sea-ice using CORE bulk
+ !! formulea, ice variables and read atmmospheric fields.
+ !!
+ !! caution : the net upward water flux has with mm/day unit
+ !!---------------------------------------------------------------------
+ REAL(wp), DIMENSION(:,:,:), INTENT(in) :: ptsu ! sea ice surface temperature
+ REAL(wp), DIMENSION(:,:,:), INTENT(in) :: palb ! ice albedo (all skies)
+ !!
+ INTEGER :: ji, jj, jl ! dummy loop indices
+ REAL(wp) :: zst2, zst3
+ REAL(wp) :: zcoef_dqlw, zcoef_dqla, zcoef_dqsb
+ REAL(wp) :: zztmp, z1_lsub ! temporary variable
+ !!
+ REAL(wp), DIMENSION(:,:,:), POINTER :: z_qlw ! long wave heat flux over ice
+ REAL(wp), DIMENSION(:,:,:), POINTER :: z_qsb ! sensible heat flux over ice
+ REAL(wp), DIMENSION(:,:,:), POINTER :: z_dqlw ! long wave heat sensitivity over ice
+ REAL(wp), DIMENSION(:,:,:), POINTER :: z_dqsb ! sensible heat sensitivity over ice
+ REAL(wp), DIMENSION(:,:) , POINTER :: zevap, zsnw ! evaporation and snw distribution after wind blowing (LIM3)
+ !!---------------------------------------------------------------------
+ !
+ IF( nn_timing == 1 ) CALL timing_start('blk_ice_core_flx')
+ !
+ CALL wrk_alloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb )
+
+ ! local scalars ( place there for vector optimisation purposes)
+ zcoef_dqlw = 4.0 * 0.95 * Stef
+ zcoef_dqla = -Ls * Cice * 11637800. * (-5897.8)
+ zcoef_dqsb = rhoa * cpa * Cice
zztmp = 1. / ( 1. - albo )
! ! ========================== !
- DO jl = 1, ijpl ! Loop over ice categories !
+ DO jl = 1, jpl ! Loop over ice categories !
! ! ========================== !
DO jj = 1 , jpj
@@ -539,10 +556,10 @@
! I Radiative FLUXES !
! ----------------------------!
- zst2 = pst(ji,jj,jl) * pst(ji,jj,jl)
- zst3 = pst(ji,jj,jl) * zst2
+ zst2 = ptsu(ji,jj,jl) * ptsu(ji,jj,jl)
+ zst3 = ptsu(ji,jj,jl) * zst2
! Short Wave (sw)
- p_qsr(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj)
+ qsr_ice(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj)
! Long Wave (lw)
- z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1)
+ z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * ptsu(ji,jj,jl) * zst3 ) * tmask(ji,jj,1)
! lw sensitivity
z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3
@@ -554,17 +571,17 @@
! ... turbulent heat fluxes
! Sensible Heat
- z_qsb(ji,jj,jl) = rhoa * cpa * Cice * z_wnds_t(ji,jj) * ( pst(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) )
+ z_qsb(ji,jj,jl) = rhoa * cpa * Cice * wndm_ice(ji,jj) * ( ptsu(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) )
! Latent Heat
- p_qla(ji,jj,jl) = rn_efac * MAX( 0.e0, rhoa * Ls * Cice * z_wnds_t(ji,jj) &
- & * ( 11637800. * EXP( -5897.8 / pst(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1) ) )
- ! Latent heat sensitivity for ice (Dqla/Dt)
- IF( p_qla(ji,jj,jl) > 0._wp ) THEN
- p_dqla(ji,jj,jl) = rn_efac * zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) )
+ qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, rhoa * Ls * Cice * wndm_ice(ji,jj) &
+ & * ( 11637800. * EXP( -5897.8 / ptsu(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1) ) )
+ ! Latent heat sensitivity for ice (Dqla/Dt)
+ IF( qla_ice(ji,jj,jl) > 0._wp ) THEN
+ dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * wndm_ice(ji,jj) / ( zst2 ) * EXP( -5897.8 / ptsu(ji,jj,jl) )
ELSE
- p_dqla(ji,jj,jl) = 0._wp
+ dqla_ice(ji,jj,jl) = 0._wp
ENDIF
! Sensible heat sensitivity (Dqsb_ice/Dtn_ice)
- z_dqsb(ji,jj,jl) = zcoef_dqsb * z_wnds_t(ji,jj)
+ z_dqsb(ji,jj,jl) = zcoef_dqsb * wndm_ice(ji,jj)
! ----------------------------!
@@ -572,7 +589,7 @@
! ----------------------------!
! Downward Non Solar flux
- p_qns (ji,jj,jl) = z_qlw (ji,jj,jl) - z_qsb (ji,jj,jl) - p_qla (ji,jj,jl)
+ qns_ice (ji,jj,jl) = z_qlw (ji,jj,jl) - z_qsb (ji,jj,jl) - qla_ice (ji,jj,jl)
! Total non solar heat flux sensitivity for ice
- p_dqns(ji,jj,jl) = - ( z_dqlw(ji,jj,jl) + z_dqsb(ji,jj,jl) + p_dqla(ji,jj,jl) )
+ dqns_ice(ji,jj,jl) = - ( z_dqlw(ji,jj,jl) + z_dqsb(ji,jj,jl) + dqla_ice(ji,jj,jl) )
END DO
!
@@ -581,4 +598,43 @@
END DO
!
+ tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac ! total precipitation [kg/m2/s]
+ sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac ! solid precipitation [kg/m2/s]
+ CALL iom_put( 'snowpre', sprecip * 86400. ) ! Snow precipitation
+ CALL iom_put( 'precip' , tprecip * 86400. ) ! Total precipitation
+
+#if defined key_lim3
+ CALL wrk_alloc( jpi,jpj, zevap, zsnw )
+
+ ! --- evaporation --- !
+ z1_lsub = 1._wp / Lsub
+ evap_ice (:,:,:) = qla_ice (:,:,:) * z1_lsub ! sublimation
+ devap_ice(:,:,:) = dqla_ice(:,:,:) * z1_lsub
+ zevap (:,:) = emp(:,:) + tprecip(:,:) ! evaporation over ocean
+
+ ! --- evaporation minus precipitation --- !
+ zsnw(:,:) = 0._wp
+ CALL lim_thd_snwblow( pfrld, zsnw ) ! snow distribution over ice after wind blowing
+ emp_oce(:,:) = pfrld(:,:) * 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(:,:) = - pfrld(:,:) * zevap(:,:) * sst_m(:,:) * rcp & ! evap at sst
+ & + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp & ! liquid precip at Tair
+ & + sprecip(:,:) * ( 1._wp - zsnw ) * & ! solid precip at min(Tair,Tsnow)
+ & ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus )
+ qemp_ice(:,:) = sprecip(:,:) * zsnw * & ! solid precip (only)
+ & ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus )
+
+ ! --- total solar and non solar fluxes --- !
+ qns_tot(:,:) = pfrld(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:)
+ qsr_tot(:,:) = pfrld(:,:) * 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(:,:) = rhosn * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus )
+
+ CALL wrk_dealloc( jpi,jpj, zevap, zsnw )
+#endif
+
!--------------------------------------------------------------------
! FRACTIONs of net shortwave radiation which is not absorbed in the
@@ -586,85 +642,23 @@
! ( Maykut and Untersteiner, 1971 ; Ebert and Curry, 1993 )
!
- p_fr1(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )
- p_fr2(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )
- !
- p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac ! total precipitation [kg/m2/s]
- p_spr(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac ! solid precipitation [kg/m2/s]
- CALL iom_put( 'snowpre', p_spr * 86400. ) ! Snow precipitation
- CALL iom_put( 'precip' , p_tpr * 86400. ) ! Total precipitation
+ fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )
+ fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )
+ !
!
IF(ln_ctl) THEN
- CALL prt_ctl(tab3d_1=p_qla , clinfo1=' blk_ice_core: p_qla : ', tab3d_2=z_qsb , clinfo2=' z_qsb : ', kdim=ijpl)
- CALL prt_ctl(tab3d_1=z_qlw , clinfo1=' blk_ice_core: z_qlw : ', tab3d_2=p_dqla , clinfo2=' p_dqla : ', kdim=ijpl)
- CALL prt_ctl(tab3d_1=z_dqsb , clinfo1=' blk_ice_core: z_dqsb : ', tab3d_2=z_dqlw , clinfo2=' z_dqlw : ', kdim=ijpl)
- CALL prt_ctl(tab3d_1=p_dqns , clinfo1=' blk_ice_core: p_dqns : ', tab3d_2=p_qsr , clinfo2=' p_qsr : ', kdim=ijpl)
- CALL prt_ctl(tab3d_1=pst , clinfo1=' blk_ice_core: pst : ', tab3d_2=p_qns , clinfo2=' p_qns : ', kdim=ijpl)
- CALL prt_ctl(tab2d_1=p_tpr , clinfo1=' blk_ice_core: p_tpr : ', tab2d_2=p_spr , clinfo2=' p_spr : ')
- CALL prt_ctl(tab2d_1=p_taui , clinfo1=' blk_ice_core: p_taui : ', tab2d_2=p_tauj , clinfo2=' p_tauj : ')
- CALL prt_ctl(tab2d_1=z_wnds_t, clinfo1=' blk_ice_core: z_wnds_t : ')
- ENDIF
-
- CALL wrk_dealloc( jpi,jpj, z_wnds_t )
- CALL wrk_dealloc( jpi,jpj, pdim, z_qlw, z_qsb, z_dqlw, z_dqsb )
- !
- IF( nn_timing == 1 ) CALL timing_stop('blk_ice_core')
- !
- END SUBROUTINE blk_ice_core
-
-
- SUBROUTINE blk_bio_meanqsr
- !!---------------------------------------------------------------------
- !! *** ROUTINE blk_bio_meanqsr
- !!
- !! ** Purpose : provide daily qsr_mean for PISCES when
- !! analytic diurnal cycle is applied in physic
- !!
- !! ** Method : add part where there is no ice
- !!
- !!---------------------------------------------------------------------
- IF( nn_timing == 1 ) CALL timing_start('blk_bio_meanqsr')
- !
- qsr_mean(:,:) = (1. - albo ) * sf(jp_qsr)%fnow(:,:,1)
- !
- IF( nn_timing == 1 ) CALL timing_stop('blk_bio_meanqsr')
- !
- END SUBROUTINE blk_bio_meanqsr
-
-
- SUBROUTINE blk_ice_meanqsr( palb, p_qsr_mean, pdim )
- !!---------------------------------------------------------------------
- !!
- !! ** Purpose : provide the daily qsr_mean over sea_ice for PISCES when
- !! analytic diurnal cycle is applied in physic
- !!
- !! ** Method : compute qsr
- !!
- !!---------------------------------------------------------------------
- REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: palb ! ice albedo (clear sky) (alb_ice_cs) [%]
- REAL(wp), DIMENSION(:,:,:), INTENT( out) :: p_qsr_mean ! solar heat flux over ice (T-point) [W/m2]
- INTEGER , INTENT(in ) :: pdim ! number of ice categories
- !
- INTEGER :: ijpl ! number of ice categories (size of 3rd dim of input arrays)
- INTEGER :: ji, jj, jl ! dummy loop indices
- REAL(wp) :: zztmp ! temporary variable
- !!---------------------------------------------------------------------
- IF( nn_timing == 1 ) CALL timing_start('blk_ice_meanqsr')
- !
- ijpl = pdim ! number of ice categories
- zztmp = 1. / ( 1. - albo )
- ! ! ========================== !
- DO jl = 1, ijpl ! Loop over ice categories !
- ! ! ========================== !
- DO jj = 1 , jpj
- DO ji = 1, jpi
- p_qsr_mean(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr_mean(ji,jj)
- END DO
- END DO
- END DO
- !
- IF( nn_timing == 1 ) CALL timing_stop('blk_ice_meanqsr')
- !
- END SUBROUTINE blk_ice_meanqsr
-
+ CALL prt_ctl(tab3d_1=qla_ice , clinfo1=' blk_ice_core: qla_ice : ', tab3d_2=z_qsb , clinfo2=' z_qsb : ', kdim=jpl)
+ CALL prt_ctl(tab3d_1=z_qlw , clinfo1=' blk_ice_core: z_qlw : ', tab3d_2=dqla_ice, clinfo2=' dqla_ice : ', kdim=jpl)
+ CALL prt_ctl(tab3d_1=z_dqsb , clinfo1=' blk_ice_core: z_dqsb : ', tab3d_2=z_dqlw , clinfo2=' z_dqlw : ', kdim=jpl)
+ CALL prt_ctl(tab3d_1=dqns_ice, clinfo1=' blk_ice_core: dqns_ice : ', tab3d_2=qsr_ice , clinfo2=' qsr_ice : ', kdim=jpl)
+ CALL prt_ctl(tab3d_1=ptsu , clinfo1=' blk_ice_core: ptsu : ', tab3d_2=qns_ice , clinfo2=' qns_ice : ', kdim=jpl)
+ CALL prt_ctl(tab2d_1=tprecip , clinfo1=' blk_ice_core: tprecip : ', tab2d_2=sprecip , clinfo2=' sprecip : ')
+ ENDIF
+
+ CALL wrk_dealloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb )
+ !
+ IF( nn_timing == 1 ) CALL timing_stop('blk_ice_core_flx')
+
+ END SUBROUTINE blk_ice_core_flx
+#endif
SUBROUTINE turb_core_2z( zt, zu, sst, T_zt, q_sat, q_zt, dU, &
@@ -848,5 +842,5 @@
rgt33 = 0.5_wp + SIGN( 0.5_wp, (zw10 - 33._wp) ) ! If zw10 < 33. => 0, else => 1
cd_neutral_10m = 1.e-3 * ( &
- & (rgt33 + 1._wp)*( 2.7_wp/zw10 + 0.142_wp + zw10/13.09_wp - 3.14807E-10*zw10**6) & ! zw10< 33.
+ & (1._wp - rgt33)*( 2.7_wp/zw10 + 0.142_wp + zw10/13.09_wp - 3.14807E-10*zw10**6) & ! zw10< 33.
& + rgt33 * 2.34 ) ! zw10 >= 33.
!
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90 (revision 5602)
@@ -46,5 +46,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)
- !! $Id: sbcblk_mfs.F90 1730 2009-11-16 14:34:19Z poddo $
+ !! $Id$
!! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 (revision 5602)
@@ -21,8 +21,8 @@
USE sbc_oce ! Surface boundary condition: ocean fields
USE sbc_ice ! Surface boundary condition: ice fields
+ USE sbcapr
USE sbcdcy ! surface boundary condition: diurnal cycle
USE phycst ! physical constants
#if defined key_lim3
- USE par_ice ! ice parameters
USE ice ! ice variables
#endif
@@ -33,5 +33,5 @@
USE cpl_oasis3 ! OASIS3 coupling
USE geo2ocean !
- USE oce , ONLY : tsn, un, vn
+ USE oce , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev
USE albedo !
USE in_out_manager ! I/O manager
@@ -41,4 +41,6 @@
USE timing ! Timing
USE lbclnk ! ocean lateral boundary conditions (or mpp link)
+ USE eosbn2
+ USE sbcrnf , ONLY : l_rnfcpl
#if defined key_cpl_carbon_cycle
USE p4zflx, ONLY : oce_co2
@@ -47,7 +49,11 @@
USE ice_domain_size, only: ncat
#endif
+#if defined key_lim3
+ USE limthd_dh ! for CALL lim_thd_snwblow
+#endif
+
IMPLICIT NONE
PRIVATE
-!EM XIOS-OASIS-MCT compliance
+
PUBLIC sbc_cpl_init ! routine called by sbcmod.F90
PUBLIC sbc_cpl_rcv ! routine called by sbc_ice_lim(_2).F90
@@ -55,4 +61,5 @@
PUBLIC sbc_cpl_ice_tau ! routine called by sbc_ice_lim(_2).F90
PUBLIC sbc_cpl_ice_flx ! routine called by sbc_ice_lim(_2).F90
+ PUBLIC sbc_cpl_alloc ! routine called in sbcice_cice.F90
INTEGER, PARAMETER :: jpr_otx1 = 1 ! 3 atmosphere-ocean stress components on grid 1
@@ -89,7 +96,16 @@
INTEGER, PARAMETER :: jpr_topm = 32 ! topmeltn
INTEGER, PARAMETER :: jpr_botm = 33 ! botmeltn
- INTEGER, PARAMETER :: jprcv = 33 ! total number of fields received
-
- INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction
+ INTEGER, PARAMETER :: jpr_sflx = 34 ! salt flux
+ INTEGER, PARAMETER :: jpr_toce = 35 ! ocean temperature
+ INTEGER, PARAMETER :: jpr_soce = 36 ! ocean salinity
+ INTEGER, PARAMETER :: jpr_ocx1 = 37 ! ocean current on grid 1
+ INTEGER, PARAMETER :: jpr_ocy1 = 38 !
+ INTEGER, PARAMETER :: jpr_ssh = 39 ! sea surface height
+ INTEGER, PARAMETER :: jpr_fice = 40 ! ice fraction
+ INTEGER, PARAMETER :: jpr_e3t1st = 41 ! first T level thickness
+ INTEGER, PARAMETER :: jpr_fraqsr = 42 ! fraction of solar net radiation absorbed in the first ocean level
+ INTEGER, PARAMETER :: jprcv = 42 ! total number of fields received
+
+ 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
@@ -106,5 +122,18 @@
INTEGER, PARAMETER :: jps_ivz1 = 14 !
INTEGER, PARAMETER :: jps_co2 = 15
- INTEGER, PARAMETER :: jpsnd = 15 ! total number of fields sended
+ INTEGER, PARAMETER :: jps_soce = 16 ! ocean salinity
+ INTEGER, PARAMETER :: jps_ssh = 17 ! sea surface height
+ INTEGER, PARAMETER :: jps_qsroce = 18 ! Qsr above the ocean
+ INTEGER, PARAMETER :: jps_qnsoce = 19 ! Qns above the ocean
+ INTEGER, PARAMETER :: jps_oemp = 20 ! ocean freshwater budget (evap - precip)
+ INTEGER, PARAMETER :: jps_sflx = 21 ! salt flux
+ INTEGER, PARAMETER :: jps_otx1 = 22 ! 2 atmosphere-ocean stress components on grid 1
+ INTEGER, PARAMETER :: jps_oty1 = 23 !
+ INTEGER, PARAMETER :: jps_rnf = 24 ! runoffs
+ INTEGER, PARAMETER :: jps_taum = 25 ! wind stress module
+ INTEGER, PARAMETER :: jps_fice2 = 26 ! ice fraction sent to OPA (by SAS when doing SAS-OPA coupling)
+ INTEGER, PARAMETER :: jps_e3t1st = 27 ! first level depth (vvl)
+ INTEGER, PARAMETER :: jps_fraqsr = 28 ! fraction of solar net radiation absorbed in the first ocean level
+ INTEGER, PARAMETER :: jpsnd = 28 ! total number of fields sended
! !!** namelist namsbc_cpl **
@@ -125,7 +154,4 @@
LOGICAL :: ln_usecplmask ! 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)
-
- REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: xcplmask
-
TYPE :: DYNARR
REAL(wp), POINTER, DIMENSION(:,:,:) :: z3
@@ -139,4 +165,5 @@
!! Substitution
+# include "domzgr_substitute.h90"
# include "vectopt_loop_substitute.h90"
!!----------------------------------------------------------------------
@@ -161,5 +188,5 @@
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,nn_cplmodel) , STAT=ierr(3) )
+ ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) )
!
sbc_cpl_alloc = MAXVAL( ierr )
@@ -182,5 +209,5 @@
!! * initialise the OASIS coupler
!!----------------------------------------------------------------------
- INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3)
+ INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3)
!!
INTEGER :: jn ! dummy loop index
@@ -216,4 +243,6 @@
WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist '
WRITE(numout,*)'~~~~~~~~~~~~'
+ ENDIF
+ IF( lwp .AND. ln_cpl ) THEN ! control print
WRITE(numout,*)' received fields (mutiple ice categogies)'
WRITE(numout,*)' 10m wind module = ', TRIM(sn_rcv_w10m%cldes ), ' (', TRIM(sn_rcv_w10m%clcat ), ')'
@@ -359,4 +388,5 @@
srcv(jpr_oemp)%clname = 'OOEvaMPr' ! ocean water budget = ocean Evap - ocean precip
SELECT CASE( TRIM( sn_rcv_emp%cldes ) )
+ CASE( 'none' ) ! nothing to do
CASE( 'oce only' ) ; srcv( jpr_oemp )%laction = .TRUE.
CASE( 'conservative' )
@@ -370,9 +400,13 @@
! ! Runoffs & Calving !
! ! ------------------------- !
- srcv(jpr_rnf )%clname = 'O_Runoff' ; IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) srcv(jpr_rnf)%laction = .TRUE.
-! This isn't right - really just want ln_rnf_emp changed
-! IF( TRIM( sn_rcv_rnf%cldes ) == 'climato' ) THEN ; ln_rnf = .TRUE.
-! ELSE ; ln_rnf = .FALSE.
-! ENDIF
+ srcv(jpr_rnf )%clname = 'O_Runoff'
+ IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN
+ srcv(jpr_rnf)%laction = .TRUE.
+ l_rnfcpl = .TRUE. ! -> no need to read runoffs in sbcrnf
+ ln_rnf = nn_components /= jp_iam_sas ! -> force to go through sbcrnf if not sas
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) ' runoffs received from oasis -> force ln_rnf = ', ln_rnf
+ ENDIF
+ !
srcv(jpr_cal )%clname = 'OCalving' ; IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE.
@@ -384,4 +418,5 @@
srcv(jpr_qnsmix)%clname = 'O_QnsMix'
SELECT CASE( TRIM( sn_rcv_qns%cldes ) )
+ CASE( 'none' ) ! nothing to do
CASE( 'oce only' ) ; srcv( jpr_qnsoce )%laction = .TRUE.
CASE( 'conservative' ) ; srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE.
@@ -399,4 +434,5 @@
srcv(jpr_qsrmix)%clname = 'O_QsrMix'
SELECT CASE( TRIM( sn_rcv_qsr%cldes ) )
+ CASE( 'none' ) ! nothing to do
CASE( 'oce only' ) ; srcv( jpr_qsroce )%laction = .TRUE.
CASE( 'conservative' ) ; srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE.
@@ -414,5 +450,5 @@
!
! non solar sensitivity mandatory for LIM ice model
- IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4) &
+ IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4 .AND. nn_components /= jp_iam_sas ) &
CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' )
! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique
@@ -447,6 +483,91 @@
srcv(jpr_topm:jpr_botm)%laction = .TRUE.
ENDIF
-
- ! Allocate all parts of frcv used for received fields
+ ! ! ------------------------------- !
+ ! ! OPA-SAS coupling - rcv by opa !
+ ! ! ------------------------------- !
+ srcv(jpr_sflx)%clname = 'O_SFLX'
+ srcv(jpr_fice)%clname = 'RIceFrc'
+ !
+ IF( nn_components == jp_iam_opa ) THEN ! OPA coupled to SAS via OASIS: force received field by OPA (sent by SAS)
+ srcv(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling
+ srcv(:)%clgrid = 'T' ! force default definition in case of opa <-> sas coupling
+ srcv(:)%nsgn = 1. ! force default definition in case of opa <-> sas coupling
+ srcv( (/jpr_qsroce, jpr_qnsoce, jpr_oemp, jpr_sflx, jpr_fice, jpr_otx1, jpr_oty1, jpr_taum/) )%laction = .TRUE.
+ srcv(jpr_otx1)%clgrid = 'U' ! oce components given at U-point
+ srcv(jpr_oty1)%clgrid = 'V' ! and V-point
+ ! Vectors: change of sign at north fold ONLY if on the local grid
+ srcv( (/jpr_otx1,jpr_oty1/) )%nsgn = -1.
+ sn_rcv_tau%clvgrd = 'U,V'
+ sn_rcv_tau%clvor = 'local grid'
+ sn_rcv_tau%clvref = 'spherical'
+ sn_rcv_emp%cldes = 'oce only'
+ !
+ IF(lwp) THEN ! control print
+ WRITE(numout,*)
+ WRITE(numout,*)' Special conditions for SAS-OPA coupling '
+ WRITE(numout,*)' OPA component '
+ WRITE(numout,*)
+ WRITE(numout,*)' received fields from SAS component '
+ WRITE(numout,*)' ice cover '
+ WRITE(numout,*)' oce only EMP '
+ WRITE(numout,*)' salt flux '
+ WRITE(numout,*)' mixed oce-ice solar flux '
+ WRITE(numout,*)' mixed oce-ice non solar flux '
+ WRITE(numout,*)' wind stress U,V on local grid and sperical coordinates '
+ WRITE(numout,*)' wind stress module'
+ WRITE(numout,*)
+ ENDIF
+ ENDIF
+ ! ! -------------------------------- !
+ ! ! OPA-SAS coupling - rcv by sas !
+ ! ! -------------------------------- !
+ srcv(jpr_toce )%clname = 'I_SSTSST'
+ srcv(jpr_soce )%clname = 'I_SSSal'
+ srcv(jpr_ocx1 )%clname = 'I_OCurx1'
+ srcv(jpr_ocy1 )%clname = 'I_OCury1'
+ srcv(jpr_ssh )%clname = 'I_SSHght'
+ srcv(jpr_e3t1st)%clname = 'I_E3T1st'
+ srcv(jpr_fraqsr)%clname = 'I_FraQsr'
+ !
+ IF( nn_components == jp_iam_sas ) THEN
+ IF( .NOT. ln_cpl ) srcv(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling
+ IF( .NOT. ln_cpl ) srcv(:)%clgrid = 'T' ! force default definition in case of opa <-> sas coupling
+ IF( .NOT. ln_cpl ) srcv(:)%nsgn = 1. ! force default definition in case of opa <-> sas coupling
+ srcv( (/jpr_toce, jpr_soce, jpr_ssh, jpr_fraqsr, jpr_ocx1, jpr_ocy1/) )%laction = .TRUE.
+ srcv( jpr_e3t1st )%laction = lk_vvl
+ srcv(jpr_ocx1)%clgrid = 'U' ! oce components given at U-point
+ srcv(jpr_ocy1)%clgrid = 'V' ! and V-point
+ ! Vectors: change of sign at north fold ONLY if on the local grid
+ srcv(jpr_ocx1:jpr_ocy1)%nsgn = -1.
+ ! Change first letter to couple with atmosphere if already coupled OPA
+ ! this is nedeed as each variable name used in the namcouple must be unique:
+ ! for example O_Runoff received by OPA from SAS and therefore O_Runoff received by SAS from the Atmosphere
+ DO jn = 1, jprcv
+ IF ( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname))
+ END DO
+ !
+ IF(lwp) THEN ! control print
+ WRITE(numout,*)
+ WRITE(numout,*)' Special conditions for SAS-OPA coupling '
+ WRITE(numout,*)' SAS component '
+ WRITE(numout,*)
+ IF( .NOT. ln_cpl ) THEN
+ WRITE(numout,*)' received fields from OPA component '
+ ELSE
+ WRITE(numout,*)' Additional received fields from OPA component : '
+ ENDIF
+ WRITE(numout,*)' sea surface temperature (Celcius) '
+ WRITE(numout,*)' sea surface salinity '
+ WRITE(numout,*)' surface currents '
+ WRITE(numout,*)' sea surface height '
+ WRITE(numout,*)' thickness of first ocean T level '
+ WRITE(numout,*)' fraction of solar net radiation absorbed in the first ocean level'
+ WRITE(numout,*)
+ ENDIF
+ ENDIF
+
+ ! =================================================== !
+ ! 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) )
@@ -454,4 +575,9 @@
! 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) )
+ ! 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) )
+ ! 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) )
! 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
@@ -477,13 +603,13 @@
ssnd(jps_tmix)%clname = 'O_TepMix'
SELECT CASE( TRIM( sn_snd_temp%cldes ) )
- CASE( 'none' ) ! nothing to do
- CASE( 'oce only' ) ; ssnd( jps_toce )%laction = .TRUE.
- CASE( 'weighted oce and ice' )
+ CASE( 'none' ) ! nothing to do
+ CASE( 'oce only' ) ; ssnd( jps_toce )%laction = .TRUE.
+ CASE( 'oce and ice' , 'weighted oce and ice' )
ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE.
IF ( TRIM( sn_snd_temp%clcat ) == 'yes' ) ssnd(jps_tice)%nct = jpl
- CASE( 'mixed oce-ice' ) ; ssnd( jps_tmix )%laction = .TRUE.
+ CASE( 'mixed oce-ice' ) ; ssnd( jps_tmix )%laction = .TRUE.
CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' )
END SELECT
-
+
! ! ------------------------- !
! ! Albedo !
@@ -492,7 +618,7 @@
ssnd(jps_albmix)%clname = 'O_AlbMix'
SELECT CASE( TRIM( sn_snd_alb%cldes ) )
- CASE( 'none' ) ! nothing to do
- CASE( 'weighted ice' ) ; ssnd(jps_albice)%laction = .TRUE.
- CASE( 'mixed oce-ice' ) ; ssnd(jps_albmix)%laction = .TRUE.
+ CASE( 'none' ) ! nothing to do
+ CASE( 'ice' , 'weighted ice' ) ; ssnd(jps_albice)%laction = .TRUE.
+ CASE( 'mixed oce-ice' ) ; ssnd(jps_albmix)%laction = .TRUE.
CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_alb%cldes' )
END SELECT
@@ -518,5 +644,5 @@
IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl
ENDIF
-
+
SELECT CASE ( TRIM( sn_snd_thick%cldes ) )
CASE( 'none' ) ! nothing to do
@@ -525,8 +651,4 @@
IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN
ssnd(jps_hice:jps_hsnw)%nct = jpl
- ELSE
- IF ( jpl > 1 ) THEN
-CALL ctl_stop( 'sbc_cpl_init: use weighted ice and snow option for sn_snd_thick%cldes if not exchanging category fields' )
- ENDIF
ENDIF
CASE ( 'weighted ice and snow' )
@@ -567,4 +689,77 @@
! ! ------------------------- !
ssnd(jps_co2)%clname = 'O_CO2FLX' ; IF( TRIM(sn_snd_co2%cldes) == 'coupled' ) ssnd(jps_co2 )%laction = .TRUE.
+
+ ! ! ------------------------------- !
+ ! ! OPA-SAS coupling - snd by opa !
+ ! ! ------------------------------- !
+ ssnd(jps_ssh )%clname = 'O_SSHght'
+ ssnd(jps_soce )%clname = 'O_SSSal'
+ ssnd(jps_e3t1st)%clname = 'O_E3T1st'
+ ssnd(jps_fraqsr)%clname = 'O_FraQsr'
+ !
+ IF( nn_components == jp_iam_opa ) THEN
+ ssnd(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling
+ ssnd( (/jps_toce, jps_soce, jps_ssh, jps_fraqsr, jps_ocx1, jps_ocy1/) )%laction = .TRUE.
+ ssnd( jps_e3t1st )%laction = lk_vvl
+ ! vector definition: not used but cleaner...
+ ssnd(jps_ocx1)%clgrid = 'U' ! oce components given at U-point
+ ssnd(jps_ocy1)%clgrid = 'V' ! and V-point
+ sn_snd_crt%clvgrd = 'U,V'
+ sn_snd_crt%clvor = 'local grid'
+ sn_snd_crt%clvref = 'spherical'
+ !
+ IF(lwp) THEN ! control print
+ WRITE(numout,*)
+ WRITE(numout,*)' sent fields to SAS component '
+ WRITE(numout,*)' sea surface temperature (T before, Celcius) '
+ WRITE(numout,*)' sea surface salinity '
+ WRITE(numout,*)' surface currents U,V on local grid and spherical coordinates'
+ WRITE(numout,*)' sea surface height '
+ WRITE(numout,*)' thickness of first ocean T level '
+ WRITE(numout,*)' fraction of solar net radiation absorbed in the first ocean level'
+ WRITE(numout,*)
+ ENDIF
+ ENDIF
+ ! ! ------------------------------- !
+ ! ! OPA-SAS coupling - snd by sas !
+ ! ! ------------------------------- !
+ ssnd(jps_sflx )%clname = 'I_SFLX'
+ ssnd(jps_fice2 )%clname = 'IIceFrc'
+ ssnd(jps_qsroce)%clname = 'I_QsrOce'
+ ssnd(jps_qnsoce)%clname = 'I_QnsOce'
+ ssnd(jps_oemp )%clname = 'IOEvaMPr'
+ ssnd(jps_otx1 )%clname = 'I_OTaux1'
+ ssnd(jps_oty1 )%clname = 'I_OTauy1'
+ ssnd(jps_rnf )%clname = 'I_Runoff'
+ ssnd(jps_taum )%clname = 'I_TauMod'
+ !
+ IF( nn_components == jp_iam_sas ) THEN
+ IF( .NOT. ln_cpl ) ssnd(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling
+ ssnd( (/jps_qsroce, jps_qnsoce, jps_oemp, jps_fice2, jps_sflx, jps_otx1, jps_oty1, jps_taum/) )%laction = .TRUE.
+ !
+ ! Change first letter to couple with atmosphere if already coupled with sea_ice
+ ! this is nedeed as each variable name used in the namcouple must be unique:
+ ! for example O_SSTSST sent by OPA to SAS and therefore S_SSTSST sent by SAS to the Atmosphere
+ DO jn = 1, jpsnd
+ IF ( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname))
+ END DO
+ !
+ IF(lwp) THEN ! control print
+ WRITE(numout,*)
+ IF( .NOT. ln_cpl ) THEN
+ WRITE(numout,*)' sent fields to OPA component '
+ ELSE
+ WRITE(numout,*)' Additional sent fields to OPA component : '
+ ENDIF
+ WRITE(numout,*)' ice cover '
+ WRITE(numout,*)' oce only EMP '
+ WRITE(numout,*)' salt flux '
+ WRITE(numout,*)' mixed oce-ice solar flux '
+ WRITE(numout,*)' mixed oce-ice non solar flux '
+ WRITE(numout,*)' wind stress U,V components'
+ WRITE(numout,*)' wind stress module'
+ ENDIF
+ ENDIF
+
!
! ================================ !
@@ -572,5 +767,6 @@
! ================================ !
- CALL cpl_define(jprcv, jpsnd,nn_cplmodel)
+ CALL cpl_define(jprcv, jpsnd, nn_cplmodel)
+
IF (ln_usecplmask) THEN
xcplmask(:,:,:) = 0.
@@ -582,7 +778,10 @@
xcplmask(:,:,:) = 1.
ENDIF
- !
- IF( ln_dm2dc .AND. ( cpl_freq( jpr_qsroce ) + cpl_freq( jpr_qsrmix ) /= 86400 ) ) &
+ xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 )
+ !
+ ncpl_qsr_freq = cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'I_QsrOce' ) + cpl_freq( 'I_QsrMix' )
+ IF( ln_dm2dc .AND. ln_cpl .AND. ncpl_qsr_freq /= 86400 ) &
& CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' )
+ ncpl_qsr_freq = 86400 / ncpl_qsr_freq
CALL wrk_dealloc( jpi,jpj, zacs, zaos )
@@ -638,9 +837,10 @@
!! emp upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case)
!!----------------------------------------------------------------------
- INTEGER, INTENT(in) :: kt ! ocean model time step index
- INTEGER, INTENT(in) :: k_fsbc ! frequency of sbc (-> ice model) computation
- INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3)
- !!
- LOGICAL :: llnewtx, llnewtau ! update wind stress components and module??
+ INTEGER, INTENT(in) :: kt ! ocean model time step index
+ INTEGER, INTENT(in) :: k_fsbc ! frequency of sbc (-> ice model) computation
+ INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3)
+
+ !!
+ LOGICAL :: llnewtx, llnewtau ! update wind stress components and module??
INTEGER :: ji, jj, jn ! dummy loop indices
INTEGER :: isec ! number of seconds since nit000 (assuming rdttra did not change since nit000)
@@ -650,14 +850,19 @@
REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient
REAL(wp) :: zzx, zzy ! temporary variables
- REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty
+ REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty, zmsk, zemp, zqns, zqsr
!!----------------------------------------------------------------------
!
IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv')
!
- CALL wrk_alloc( jpi,jpj, ztx, zty )
- ! ! Receive all the atmos. fields (including ice information)
- isec = ( kt - nit000 ) * NINT( rdttra(1) ) ! date of exchanges
- DO jn = 1, jprcv ! received fields sent by the atmosphere
- IF( srcv(jn)%laction ) CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask, nrcvinfo(jn) )
+ CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr )
+ !
+ IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0)
+ !
+ ! ! ======================================================= !
+ ! ! Receive all the atmos. fields (including ice information)
+ ! ! ======================================================= !
+ isec = ( kt - nit000 ) * NINT( rdttra(1) ) ! date of exchanges
+ DO jn = 1, jprcv ! received fields sent by the atmosphere
+ IF( srcv(jn)%laction ) CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) )
END DO
@@ -719,5 +924,4 @@
!
ENDIF
-
! ! ========================= !
! ! wind stress module ! (taum)
@@ -748,5 +952,5 @@
ENDIF
ENDIF
-
+ !
! ! ========================= !
! ! 10 m wind speed ! (wndm)
@@ -761,10 +965,8 @@
!CDIR NOVERRCHK
DO ji = 1, jpi
- wndm(ji,jj) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )
+ frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )
END DO
END DO
ENDIF
- ELSE
- IF ( nrcvinfo(jpr_w10m) == OASIS_Rcv ) wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1)
ENDIF
@@ -773,7 +975,15 @@
IF( MOD( kt-1, k_fsbc ) == 0 ) THEN
!
- utau(:,:) = frcv(jpr_otx1)%z3(:,:,1)
- vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1)
- taum(:,:) = frcv(jpr_taum)%z3(:,:,1)
+ IF( ln_mixcpl ) THEN
+ utau(:,:) = utau(:,:) * xcplmask(:,:,0) + frcv(jpr_otx1)%z3(:,:,1) * zmsk(:,:)
+ vtau(:,:) = vtau(:,:) * xcplmask(:,:,0) + frcv(jpr_oty1)%z3(:,:,1) * zmsk(:,:)
+ taum(:,:) = taum(:,:) * xcplmask(:,:,0) + frcv(jpr_taum)%z3(:,:,1) * zmsk(:,:)
+ wndm(:,:) = wndm(:,:) * xcplmask(:,:,0) + frcv(jpr_w10m)%z3(:,:,1) * zmsk(:,:)
+ ELSE
+ utau(:,:) = frcv(jpr_otx1)%z3(:,:,1)
+ vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1)
+ taum(:,:) = frcv(jpr_taum)%z3(:,:,1)
+ wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1)
+ ENDIF
CALL iom_put( "taum_oce", taum ) ! output wind stress module
!
@@ -781,61 +991,125 @@
#if defined key_cpl_carbon_cycle
- ! ! atmosph. CO2 (ppm)
+ ! ! ================== !
+ ! ! atmosph. CO2 (ppm) !
+ ! ! ================== !
IF( srcv(jpr_co2)%laction ) atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1)
#endif
+ ! Fields received by SAS when OASIS coupling
+ ! (arrays no more filled at sbcssm stage)
+ ! ! ================== !
+ ! ! SSS !
+ ! ! ================== !
+ IF( srcv(jpr_soce)%laction ) THEN ! received by sas in case of opa <-> sas coupling
+ sss_m(:,:) = frcv(jpr_soce)%z3(:,:,1)
+ CALL iom_put( 'sss_m', sss_m )
+ ENDIF
+ !
+ ! ! ================== !
+ ! ! SST !
+ ! ! ================== !
+ IF( srcv(jpr_toce)%laction ) THEN ! received by sas in case of opa <-> sas coupling
+ sst_m(:,:) = frcv(jpr_toce)%z3(:,:,1)
+ IF( srcv(jpr_soce)%laction .AND. ln_useCT ) THEN ! make sure that sst_m is the potential temperature
+ sst_m(:,:) = eos_pt_from_ct( sst_m(:,:), sss_m(:,:) )
+ ENDIF
+ ENDIF
+ ! ! ================== !
+ ! ! SSH !
+ ! ! ================== !
+ IF( srcv(jpr_ssh )%laction ) THEN ! received by sas in case of opa <-> sas coupling
+ ssh_m(:,:) = 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)
+ ub (:,:,1) = ssu_m(:,:) ! will be used in sbcice_lim in the call of lim_sbc_tau
+ CALL iom_put( 'ssu_m', ssu_m )
+ ENDIF
+ IF( srcv(jpr_ocy1)%laction ) THEN
+ ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1)
+ vb (:,:,1) = ssv_m(:,:) ! will be used in sbcice_lim in the call of lim_sbc_tau
+ CALL iom_put( 'ssv_m', ssv_m )
+ ENDIF
+ ! ! ======================== !
+ ! ! 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(:,:) )
+ 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)
+ CALL iom_put( 'frq_m', frq_m )
+ ENDIF
+
! ! ========================= !
- IF( k_ice <= 1 ) THEN ! heat & freshwater fluxes ! (Ocean only case)
+ IF( k_ice <= 1 .AND. MOD( kt-1, k_fsbc ) == 0 ) THEN ! heat & freshwater fluxes ! (Ocean only case)
! ! ========================= !
!
! ! total freshwater fluxes over the ocean (emp)
- SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) ! evaporation - precipitation
- CASE( 'conservative' )
- emp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) )
- CASE( 'oce only', 'oce and ice' )
- emp(:,:) = frcv(jpr_oemp)%z3(:,:,1)
- CASE default
- CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' )
- END SELECT
+ IF( srcv(jpr_oemp)%laction .OR. srcv(jpr_rain)%laction ) THEN
+ SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) ! evaporation - precipitation
+ CASE( 'conservative' )
+ zemp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) )
+ CASE( 'oce only', 'oce and ice' )
+ zemp(:,:) = frcv(jpr_oemp)%z3(:,:,1)
+ CASE default
+ CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' )
+ END SELECT
+ ELSE
+ zemp(:,:) = 0._wp
+ ENDIF
!
! ! runoffs and calving (added in emp)
- IF( srcv(jpr_rnf)%laction ) emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1)
- IF( srcv(jpr_cal)%laction ) emp(:,:) = emp(:,:) - frcv(jpr_cal)%z3(:,:,1)
- !
-!!gm : this seems to be internal cooking, not sure to need that in a generic interface
-!!gm at least should be optional...
-!! IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN ! add to the total freshwater budget
-!! ! remove negative runoff
-!! zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )
-!! zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )
-!! IF( lk_mpp ) CALL mpp_sum( zcumulpos ) ! sum over the global domain
-!! IF( lk_mpp ) CALL mpp_sum( zcumulneg )
-!! IF( zcumulpos /= 0. ) THEN ! distribute negative runoff on positive runoff grid points
-!! zcumulneg = 1.e0 + zcumulneg / zcumulpos
-!! frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg
-!! ENDIF
-!! ! add runoff to e-p
-!! emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1)
-!! ENDIF
-!!gm end of internal cooking
+ IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
+ IF( srcv(jpr_cal)%laction ) zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1)
+
+ IF( ln_mixcpl ) THEN ; emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:)
+ ELSE ; emp(:,:) = zemp(:,:)
+ ENDIF
!
! ! non solar heat flux over the ocean (qns)
- IF( srcv(jpr_qnsoce)%laction ) qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1)
- IF( srcv(jpr_qnsmix)%laction ) qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
+ IF( srcv(jpr_qnsoce)%laction ) THEN ; zqns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1)
+ ELSE IF( srcv(jpr_qnsmix)%laction ) THEN ; zqns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
+ ELSE ; zqns(:,:) = 0._wp
+ END IF
! update qns over the free ocean with:
- qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp ! remove heat content due to mass flux (assumed to be at SST)
- IF( srcv(jpr_snow )%laction ) THEN
- qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus ! energy for melting solid precipitation over the free ocean
+ IF( nn_components /= jp_iam_opa ) THEN
+ zqns(:,:) = zqns(:,:) - zemp(:,:) * sst_m(:,:) * 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) * lfus ! energy for melting solid precipitation over the free ocean
+ ENDIF
+ ENDIF
+ IF( ln_mixcpl ) THEN ; qns(:,:) = qns(:,:) * xcplmask(:,:,0) + zqns(:,:) * zmsk(:,:)
+ ELSE ; qns(:,:) = zqns(:,:)
ENDIF
! ! solar flux over the ocean (qsr)
- IF( srcv(jpr_qsroce)%laction ) qsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1)
- IF( srcv(jpr_qsrmix)%laction ) qsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1)
- IF( ln_dm2dc ) qsr(:,:) = sbc_dcy( qsr ) ! modify qsr to include the diurnal cycle
+ IF ( srcv(jpr_qsroce)%laction ) THEN ; zqsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1)
+ ELSE IF( srcv(jpr_qsrmix)%laction ) then ; zqsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1)
+ ELSE ; zqsr(:,:) = 0._wp
+ ENDIF
+ IF( ln_dm2dc .AND. ln_cpl ) zqsr(:,:) = sbc_dcy( zqsr ) ! modify qsr to include the diurnal cycle
+ IF( ln_mixcpl ) THEN ; qsr(:,:) = qsr(:,:) * xcplmask(:,:,0) + zqsr(:,:) * zmsk(:,:)
+ ELSE ; qsr(:,:) = zqsr(:,:)
+ ENDIF
!
-
- ENDIF
- !
- CALL wrk_dealloc( jpi,jpj, ztx, zty )
+ ! salt flux over the ocean (received by opa in case of opa <-> sas coupling)
+ IF( srcv(jpr_sflx )%laction ) sfx(:,:) = frcv(jpr_sflx )%z3(:,:,1)
+ ! Ice cover (received by opa in case of opa <-> sas coupling)
+ IF( srcv(jpr_fice )%laction ) fr_i(:,:) = frcv(jpr_fice )%z3(:,:,1)
+ !
+
+ ENDIF
+ !
+ CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr )
!
IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_rcv')
@@ -934,5 +1208,4 @@
!
ENDIF
-
! ! ======================= !
! ! put on ice grid !
@@ -1056,5 +1329,5 @@
- SUBROUTINE sbc_cpl_ice_flx( p_frld , palbi , psst , pist )
+ SUBROUTINE sbc_cpl_ice_flx( p_frld, palbi, psst, pist )
!!----------------------------------------------------------------------
!! *** ROUTINE sbc_cpl_ice_flx ***
@@ -1098,16 +1371,21 @@
REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! lead fraction [0 to 1]
! optional arguments, used only in 'mixed oce-ice' case
- 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(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin]
- !
- INTEGER :: jl ! dummy loop index
- REAL(wp), POINTER, DIMENSION(:,:) :: zcptn, ztmp, zicefr
+ 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(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin]
+ !
+ INTEGER :: jl ! dummy loop index
+ REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, ztmp, zicefr, zmsk
+ REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot
+ REAL(wp), POINTER, DIMENSION(:,:,:) :: zqns_ice, zqsr_ice, zdqns_ice
+ REAL(wp), POINTER, DIMENSION(:,: ) :: zevap, zsnw, zqns_oce, zqsr_oce, zqprec_ice, zqemp_oce ! for LIM3
!!----------------------------------------------------------------------
!
IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_flx')
!
- CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr )
-
+ CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot )
+ CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice )
+
+ IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0)
zicefr(:,:) = 1.- p_frld(:,:)
zcptn(:,:) = rcp * sst_m(:,:)
@@ -1117,13 +1395,14 @@
! ! ========================= !
!
- ! ! total Precipitations - total Evaporation (emp_tot)
- ! ! solid precipitation - sublimation (emp_ice)
- ! ! solid Precipitation (sprecip)
+ ! ! total Precipitation - total Evaporation (emp_tot)
+ ! ! solid precipitation - sublimation (emp_ice)
+ ! ! solid Precipitation (sprecip)
+ ! ! liquid + solid Precipitation (tprecip)
SELECT CASE( TRIM( sn_rcv_emp%cldes ) )
CASE( 'conservative' ) ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp
- sprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here
- tprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + sprecip (:,:) ! May need to ensure positive here
- emp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - tprecip(:,:)
- emp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1)
+ 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(:,:)
+ zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1)
CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation
IF( iom_use('hflx_rain_cea') ) &
@@ -1136,8 +1415,31 @@
CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) ) ! heat flux from from evap (cell average)
CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp
- emp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1)
- emp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1)
- sprecip(:,:) = - frcv(jpr_semp)%z3(:,:,1) + frcv(jpr_ievp)%z3(:,:,1)
+ zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1)
+ zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1)
+ zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1)
+ ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:)
END SELECT
+
+ IF( iom_use('subl_ai_cea') ) &
+ CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average)
+ !
+ ! ! runoffs and calving (put in emp_tot)
+ IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1)
+ IF( srcv(jpr_cal)%laction ) THEN
+ zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)
+ CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) )
+ ENDIF
+
+ IF( ln_mixcpl ) THEN
+ emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:)
+ emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:)
+ sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:)
+ tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:)
+ ELSE
+ emp_tot(:,:) = zemp_tot(:,:)
+ emp_ice(:,:) = zemp_ice(:,:)
+ sprecip(:,:) = zsprecip(:,:)
+ tprecip(:,:) = ztprecip(:,:)
+ ENDIF
CALL iom_put( 'snowpre' , sprecip ) ! Snow
@@ -1146,33 +1448,4 @@
IF( iom_use('snow_ai_cea') ) &
CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:) ) ! Snow over sea-ice (cell average)
- IF( iom_use('subl_ai_cea') ) &
- CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average)
- !
- ! ! runoffs and calving (put in emp_tot)
- IF( srcv(jpr_rnf)%laction ) THEN
- emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1)
- CALL iom_put( 'runoffs' , frcv(jpr_rnf)%z3(:,:,1) ) ! rivers
- IF( iom_use('hflx_rnf_cea') ) &
- CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from rivers
- ENDIF
- IF( srcv(jpr_cal)%laction ) THEN
- emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)
- CALL iom_put( 'calving', frcv(jpr_cal)%z3(:,:,1) )
- ENDIF
- !
-!!gm : this seems to be internal cooking, not sure to need that in a generic interface
-!!gm at least should be optional...
-!! ! remove negative runoff ! sum over the global domain
-!! zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )
-!! zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )
-!! IF( lk_mpp ) CALL mpp_sum( zcumulpos )
-!! IF( lk_mpp ) CALL mpp_sum( zcumulneg )
-!! IF( zcumulpos /= 0. ) THEN ! distribute negative runoff on positive runoff grid points
-!! zcumulneg = 1.e0 + zcumulneg / zcumulpos
-!! frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg
-!! ENDIF
-!! emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) ! add runoff to e-p
-!!
-!!gm end of internal cooking
! ! ========================= !
@@ -1180,44 +1453,38 @@
! ! ========================= !
CASE( 'oce only' ) ! the required field is directly provided
- qns_tot(:,: ) = frcv(jpr_qnsoce)%z3(:,:,1)
+ zqns_tot(:,: ) = frcv(jpr_qnsoce)%z3(:,:,1)
CASE( 'conservative' ) ! the required fields are directly provided
- qns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1)
+ zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1)
IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
- qns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl)
+ zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl)
ELSE
! Set all category values equal for the moment
DO jl=1,jpl
- qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)
+ zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)
ENDDO
ENDIF
CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes
- qns_tot(:,: ) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)
+ zqns_tot(:,: ) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)
IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
DO jl=1,jpl
- qns_tot(:,: ) = qns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)
- qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl)
+ zqns_tot(:,: ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)
+ zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl)
ENDDO
ELSE
+ qns_tot(:,: ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)
DO jl=1,jpl
- qns_tot(:,: ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)
- qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)
+ zqns_tot(:,: ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)
+ zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)
ENDDO
ENDIF
CASE( 'mixed oce-ice' ) ! the ice flux is cumputed from the total flux, the SST and ice informations
! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED **
- qns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1)
- qns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) &
+ zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1)
+ zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) &
& + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:) &
& + pist(:,:,1) * zicefr(:,:) ) )
END SELECT
- ztmp(:,:) = p_frld(:,:) * sprecip(:,:) * lfus
- qns_tot(:,:) = qns_tot(:,:) & ! qns_tot update over free ocean with:
- & - ztmp(:,:) & ! remove the latent heat flux of solid precip. melting
- & - ( emp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST)
- & - emp_ice(:,:) * zicefr(:,:) ) * zcptn(:,:)
- IF( iom_use('hflx_snow_cea') ) &
- CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average)
!!gm
-!! currently it is taken into account in leads budget but not in the qns_tot, and thus not in
+!! currently it is taken into account in leads budget but not in the zqns_tot, and thus not in
!! the flux that enter the ocean....
!! moreover 1 - it is not diagnose anywhere....
@@ -1228,8 +1495,86 @@
IF( srcv(jpr_cal)%laction ) THEN ! Iceberg melting
ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus ! add the latent heat of iceberg melting
- qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:)
+ zqns_tot(:,:) = zqns_tot(:,:) - ztmp(:,:)
IF( iom_use('hflx_cal_cea') ) &
CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from calving
ENDIF
+
+ ztmp(:,:) = p_frld(:,:) * zsprecip(:,:) * lfus
+ IF( iom_use('hflx_snow_cea') ) CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average)
+
+#if defined key_lim3
+ CALL wrk_alloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce )
+
+ ! --- evaporation --- !
+ ! clem: evap_ice is set to 0 for LIM3 since we still do not know what to do with sublimation
+ ! the problem is: the atm. imposes both mass evaporation and heat removed from the snow/ice
+ ! but it is incoherent WITH the ice model
+ DO jl=1,jpl
+ evap_ice(:,:,jl) = 0._wp ! should be: frcv(jpr_ievp)%z3(:,:,1)
+ ENDDO
+ zevap(:,:) = zemp_tot(:,:) + ztprecip(:,:) ! evaporation over ocean
+
+ ! --- evaporation minus precipitation --- !
+ emp_oce(:,:) = emp_tot(:,:) - emp_ice(:,:)
+
+ ! --- non solar flux over ocean --- !
+ ! note: p_frld cannot be = 0 since we limit the ice concentration to amax
+ zqns_oce = 0._wp
+ WHERE( p_frld /= 0._wp ) zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:)
+
+ ! --- heat flux associated with emp --- !
+ zsnw(:,:) = 0._wp
+ CALL lim_thd_snwblow( p_frld, zsnw ) ! snow distribution over ice after wind blowing
+ zqemp_oce(:,:) = - zevap(:,:) * p_frld(:,:) * zcptn(:,:) & ! evap
+ & + ( ztprecip(:,:) - zsprecip(:,:) ) * zcptn(:,:) & ! liquid precip
+ & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean
+ qemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * zcptn(:,:) & ! ice evap
+ & + zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice
+
+ ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- !
+ zqprec_ice(:,:) = rhosn * ( zcptn(:,:) - lfus )
+
+ ! --- total non solar flux --- !
+ zqns_tot(:,:) = zqns_tot(:,:) + qemp_ice(:,:) + zqemp_oce(:,:)
+
+ ! --- in case both coupled/forced are active, we must mix values --- !
+ IF( ln_mixcpl ) THEN
+ qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:)
+ qns_oce(:,:) = qns_oce(:,:) * xcplmask(:,:,0) + zqns_oce(:,:)* zmsk(:,:)
+ DO jl=1,jpl
+ qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) + zqns_ice(:,:,jl)* zmsk(:,:)
+ ENDDO
+ qprec_ice(:,:) = qprec_ice(:,:) * xcplmask(:,:,0) + zqprec_ice(:,:)* zmsk(:,:)
+ qemp_oce (:,:) = qemp_oce(:,:) * xcplmask(:,:,0) + zqemp_oce(:,:)* zmsk(:,:)
+!!clem evap_ice(:,:) = evap_ice(:,:) * xcplmask(:,:,0)
+ ELSE
+ qns_tot (:,: ) = zqns_tot (:,: )
+ qns_oce (:,: ) = zqns_oce (:,: )
+ qns_ice (:,:,:) = zqns_ice (:,:,:)
+ qprec_ice(:,:) = zqprec_ice(:,:)
+ qemp_oce (:,:) = zqemp_oce (:,:)
+ ENDIF
+
+ CALL wrk_dealloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce )
+#else
+
+ ! clem: this formulation is certainly wrong... but better than it was...
+ zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with:
+ & - ztmp(:,:) & ! remove the latent heat flux of solid precip. melting
+ & - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST)
+ & - zemp_ice(:,:) * zicefr(:,:) ) * zcptn(:,:)
+
+ IF( ln_mixcpl ) THEN
+ qns_tot(:,:) = qns(:,:) * p_frld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk
+ qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:)
+ DO jl=1,jpl
+ qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) + zqns_ice(:,:,jl)* zmsk(:,:)
+ ENDDO
+ ELSE
+ qns_tot(:,: ) = zqns_tot(:,: )
+ qns_ice(:,:,:) = zqns_ice(:,:,:)
+ ENDIF
+
+#endif
! ! ========================= !
@@ -1237,44 +1582,69 @@
! ! ========================= !
CASE( 'oce only' )
- qsr_tot(:,: ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) )
+ zqsr_tot(:,: ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) )
CASE( 'conservative' )
- qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)
+ zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)
IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
- qsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl)
+ zqsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl)
ELSE
! Set all category values equal for the moment
DO jl=1,jpl
- qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
+ zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
ENDDO
ENDIF
- qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)
- qsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1)
+ zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)
+ zqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1)
CASE( 'oce and ice' )
- qsr_tot(:,: ) = p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)
+ zqsr_tot(:,: ) = p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)
IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
DO jl=1,jpl
- qsr_tot(:,: ) = qsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)
- qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl)
+ zqsr_tot(:,: ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)
+ zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl)
ENDDO
ELSE
+ qsr_tot(:,: ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)
DO jl=1,jpl
- qsr_tot(:,: ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)
- qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
+ zqsr_tot(:,: ) = zqsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)
+ zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
ENDDO
ENDIF
CASE( 'mixed oce-ice' )
- qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)
+ zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)
! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED **
! Create solar heat flux over ice using incoming solar heat flux and albedos
! ( see OASIS3 user guide, 5th edition, p39 )
- qsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) &
+ zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) &
& / ( 1.- ( albedo_oce_mix(:,: ) * p_frld(:,:) &
& + palbi (:,:,1) * zicefr(:,:) ) )
END SELECT
- IF( ln_dm2dc ) THEN ! modify qsr to include the diurnal cycle
- qsr_tot(:,: ) = sbc_dcy( qsr_tot(:,: ) )
+ IF( ln_dm2dc .AND. ln_cpl ) THEN ! modify qsr to include the diurnal cycle
+ zqsr_tot(:,: ) = sbc_dcy( zqsr_tot(:,: ) )
DO jl=1,jpl
- qsr_ice(:,:,jl) = sbc_dcy( qsr_ice(:,:,jl) )
+ zqsr_ice(:,:,jl) = sbc_dcy( zqsr_ice(:,:,jl) )
ENDDO
+ ENDIF
+
+#if defined key_lim3
+ CALL wrk_alloc( jpi,jpj, zqsr_oce )
+ ! --- solar flux over ocean --- !
+ ! note: p_frld cannot be = 0 since we limit the ice concentration to amax
+ zqsr_oce = 0._wp
+ WHERE( p_frld /= 0._wp ) zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / p_frld(:,:)
+
+ IF( ln_mixcpl ) THEN ; qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) + zqsr_oce(:,:)* zmsk(:,:)
+ ELSE ; qsr_oce(:,:) = zqsr_oce(:,:) ; ENDIF
+
+ CALL wrk_dealloc( jpi,jpj, zqsr_oce )
+#endif
+
+ IF( ln_mixcpl ) THEN
+ qsr_tot(:,:) = qsr(:,:) * p_frld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), 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(:,:)
+ ENDDO
+ ELSE
+ qsr_tot(:,: ) = zqsr_tot(:,: )
+ qsr_ice(:,:,:) = zqsr_ice(:,:,:)
ENDIF
@@ -1284,13 +1654,21 @@
CASE ('coupled')
IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN
- dqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)
+ zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)
ELSE
! Set all category values equal for the moment
DO jl=1,jpl
- dqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1)
+ zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1)
ENDDO
ENDIF
END SELECT
-
+
+ IF( ln_mixcpl ) THEN
+ DO jl=1,jpl
+ dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:)
+ ENDDO
+ ELSE
+ dqns_ice(:,:,:) = zdqns_ice(:,:,:)
+ ENDIF
+
! ! ========================= !
SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! topmelt and botmelt !
@@ -1308,5 +1686,6 @@
fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )
- CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr )
+ CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot )
+ CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice )
!
IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_flx')
@@ -1328,4 +1707,5 @@
INTEGER :: ji, jj, jl ! dummy loop indices
INTEGER :: isec, info ! local integer
+ REAL(wp) :: zumax, zvmax
REAL(wp), POINTER, DIMENSION(:,:) :: zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1
REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmp3, ztmp4
@@ -1344,24 +1724,46 @@
! ! ------------------------- !
IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN
- SELECT CASE( sn_snd_temp%cldes)
- CASE( 'oce only' ) ; ztmp1(:,:) = tsn(:,:,1,jp_tem) + rt0
- CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:)
- SELECT CASE( sn_snd_temp%clcat )
- CASE( 'yes' )
- ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
- CASE( 'no' )
- ztmp3(:,:,:) = 0.0
+
+ IF ( nn_components == jp_iam_opa ) THEN
+ ztmp1(:,:) = tsn(:,:,1,jp_tem) ! send temperature as it is (potential or conservative) -> use of ln_useCT on the received part
+ ELSE
+ ! we must send the surface potential temperature
+ IF( ln_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) )
+ ELSE ; ztmp1(:,:) = tsn(:,:,1,jp_tem)
+ ENDIF
+ !
+ SELECT CASE( sn_snd_temp%cldes)
+ CASE( 'oce only' ) ; ztmp1(:,:) = ztmp1(:,:) + rt0
+ CASE( 'oce and ice' ) ; ztmp1(:,:) = ztmp1(:,:) + rt0
+ SELECT CASE( sn_snd_temp%clcat )
+ 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 )
+ ELSEWHERE
+ ztmp3(:,:,1) = rt0 ! TODO: Is freezing point a good default? (Maybe SST is better?)
+ END WHERE
+ CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
+ END SELECT
+ 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)
+ CASE( 'no' )
+ ztmp3(:,:,:) = 0.0
+ DO jl=1,jpl
+ ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,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
- ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl)
+ ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl)
ENDDO
- CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )
+ CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' )
END SELECT
- CASE( 'mixed oce-ice' )
- ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:)
- DO jl=1,jpl
- ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,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_tice)%laction ) CALL cpl_snd( jps_tice, isec, ztmp3, info )
@@ -1372,5 +1774,9 @@
! ! ------------------------- !
IF( ssnd(jps_albice)%laction ) THEN ! ice
- ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
+ SELECT CASE( sn_snd_alb%cldes )
+ CASE( 'ice' ) ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl)
+ CASE( 'weighted ice' ) ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
+ CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' )
+ END SELECT
CALL cpl_snd( jps_albice, isec, ztmp3, info )
ENDIF
@@ -1385,5 +1791,5 @@
! ! Ice fraction & Thickness !
! ! ------------------------- !
- ! Send ice fraction field
+ ! Send ice fraction field to atmosphere
IF( ssnd(jps_fice)%laction ) THEN
SELECT CASE( sn_snd_thick%clcat )
@@ -1392,5 +1798,11 @@
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 )
+ IF( ssnd(jps_fice)%laction ) CALL cpl_snd( jps_fice, isec, ztmp3, info )
+ ENDIF
+
+ ! Send ice fraction field to OPA (sent by SAS in SAS-OPA coupling)
+ IF( ssnd(jps_fice2)%laction ) THEN
+ ztmp3(:,:,1) = fr_i(:,:)
+ IF( ssnd(jps_fice2)%laction ) CALL cpl_snd( jps_fice2, isec, ztmp3, info )
ENDIF
@@ -1413,6 +1825,18 @@
END SELECT
CASE( 'ice and snow' )
- ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl)
- ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl)
+ SELECT CASE( sn_snd_thick%clcat )
+ CASE( 'yes' )
+ ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl)
+ ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl)
+ CASE( 'no' )
+ WHERE( SUM( a_i, dim=3 ) /= 0. )
+ ztmp3(:,:,1) = SUM( ht_i * a_i, dim=3 ) / SUM( a_i, dim=3 )
+ ztmp4(:,:,1) = SUM( ht_s * a_i, dim=3 ) / SUM( a_i, dim=3 )
+ ELSEWHERE
+ ztmp3(:,:,1) = 0.
+ ztmp4(:,:,1) = 0.
+ END WHERE
+ CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )
+ END SELECT
CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' )
END SELECT
@@ -1440,83 +1864,89 @@
! i-1 i i
! i i+1 (for I)
- SELECT CASE( TRIM( sn_snd_crt%cldes ) )
- CASE( 'oce only' ) ! C-grid ==> T
- DO jj = 2, jpjm1
- DO ji = fs_2, fs_jpim1 ! vector opt.
- zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) )
- zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) )
- END DO
- END DO
- CASE( 'weighted oce and ice' )
- SELECT CASE ( cp_ice_msh )
- CASE( 'C' ) ! Ocean and Ice on C-grid ==> T
+ IF( nn_components == jp_iam_opa ) THEN
+ zotx1(:,:) = un(:,:,1)
+ zoty1(:,:) = vn(:,:,1)
+ ELSE
+ SELECT CASE( TRIM( sn_snd_crt%cldes ) )
+ CASE( 'oce only' ) ! C-grid ==> T
DO jj = 2, jpjm1
DO ji = fs_2, fs_jpim1 ! vector opt.
- zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj)
- zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj)
- 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)
+ zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) )
+ zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) )
END DO
END DO
- CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T
- DO jj = 2, jpjm1
- DO ji = 2, jpim1 ! NO vector opt.
- zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj)
- zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj)
- zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) &
- & + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj)
- zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) &
- & + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj)
+ CASE( 'weighted oce and ice' )
+ SELECT CASE ( cp_ice_msh )
+ CASE( 'C' ) ! Ocean and Ice on C-grid ==> T
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
+ zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj)
+ zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj)
+ 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 DO
END DO
- END DO
- CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T
- DO jj = 2, jpjm1
- DO ji = 2, jpim1 ! NO vector opt.
- zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj)
- zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj)
- zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) &
- & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj)
- zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) &
- & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj)
+ CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T
+ DO jj = 2, jpjm1
+ DO ji = 2, jpim1 ! NO vector opt.
+ zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj)
+ zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj)
+ zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) &
+ & + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj)
+ zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) &
+ & + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj)
+ END DO
END DO
- END DO
+ CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T
+ DO jj = 2, jpjm1
+ DO ji = 2, jpim1 ! NO vector opt.
+ zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj)
+ zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj)
+ zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) &
+ & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj)
+ zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) &
+ & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj)
+ END DO
+ END DO
+ END SELECT
+ CALL lbc_lnk( zitx1, 'T', -1. ) ; CALL lbc_lnk( zity1, 'T', -1. )
+ CASE( 'mixed oce-ice' )
+ SELECT CASE ( cp_ice_msh )
+ CASE( 'C' ) ! Ocean and Ice on C-grid ==> T
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
+ zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) &
+ & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj)
+ zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) &
+ & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj)
+ END DO
+ END DO
+ CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T
+ DO jj = 2, jpjm1
+ DO ji = 2, jpim1 ! NO vector opt.
+ zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) &
+ & + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) &
+ & + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj)
+ zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) &
+ & + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) &
+ & + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj)
+ END DO
+ END DO
+ CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T
+ DO jj = 2, jpjm1
+ DO ji = 2, jpim1 ! NO vector opt.
+ zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) &
+ & + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) &
+ & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj)
+ zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) &
+ & + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) &
+ & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj)
+ END DO
+ END DO
+ END SELECT
END SELECT
- CALL lbc_lnk( zitx1, 'T', -1. ) ; CALL lbc_lnk( zity1, 'T', -1. )
- CASE( 'mixed oce-ice' )
- SELECT CASE ( cp_ice_msh )
- CASE( 'C' ) ! Ocean and Ice on C-grid ==> T
- DO jj = 2, jpjm1
- DO ji = fs_2, fs_jpim1 ! vector opt.
- zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) &
- & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj)
- zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) &
- & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj)
- END DO
- END DO
- CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T
- DO jj = 2, jpjm1
- DO ji = 2, jpim1 ! NO vector opt.
- zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) &
- & + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) &
- & + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj)
- zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) &
- & + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) &
- & + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj)
- END DO
- END DO
- CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T
- DO jj = 2, jpjm1
- DO ji = 2, jpim1 ! NO vector opt.
- zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) &
- & + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) &
- & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj)
- zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) &
- & + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) &
- & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj)
- END DO
- END DO
- END SELECT
- END SELECT
- CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. ) ; CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. )
+ CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. ) ; CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. )
+ !
+ ENDIF
!
!
@@ -1558,4 +1988,40 @@
ENDIF
!
+ !
+ ! Fields sent by OPA to SAS when doing OPA<->SAS coupling
+ ! ! SSH
+ 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(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
+ ELSE ; ztmp1(:,:) = sshn(:,:)
+ ENDIF
+ CALL cpl_snd( jps_ssh , isec, RESHAPE ( ztmp1 , (/jpi,jpj,1/) ), info )
+
+ ENDIF
+ ! ! SSS
+ IF( ssnd(jps_soce )%laction ) THEN
+ CALL cpl_snd( jps_soce , isec, RESHAPE ( tsn(:,:,1,jp_sal), (/jpi,jpj,1/) ), info )
+ ENDIF
+ ! ! first T level thickness
+ IF( ssnd(jps_e3t1st )%laction ) THEN
+ CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( fse3t_n(:,:,1) , (/jpi,jpj,1/) ), info )
+ ENDIF
+ ! ! Qsr fraction
+ IF( ssnd(jps_fraqsr)%laction ) THEN
+ CALL cpl_snd( jps_fraqsr, isec, RESHAPE ( fraqsr_1lev(:,:) , (/jpi,jpj,1/) ), info )
+ ENDIF
+ !
+ ! Fields sent by SAS to OPA 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 )
+
CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 )
CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 )
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90 (revision 5602)
@@ -8,4 +8,5 @@
!! 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
!!----------------------------------------------------------------------
@@ -88,6 +89,9 @@
!
IF( kn_fwb == 3 .AND. nn_sssr /= 2 ) CALL ctl_stop( 'sbc_fwb: nn_fwb = 3 requires nn_sssr = 2, we stop ' )
- !
- area = glob_sum( e1e2t(:,:) ) ! interior global domain surface
+ 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( 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_lim2 && ! defined key_lim3 && ! defined key_cice
@@ -106,6 +110,6 @@
z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + rdivisf * fwfisf(:,:) - snwice_fmass(:,:) ) ) / area ! sum over the global domain
zcoef = z_fwf * rcp
- emp(:,:) = emp(:,:) - z_fwf
- qns(:,:) = qns(:,:) + zcoef * sst_m(:,:) ! account for change to the heat budget due to fw correction
+ emp(:,:) = emp(:,:) - z_fwf * tmask(:,:,1)
+ qns(:,:) = qns(:,:) + zcoef * sst_m(:,:) * tmask(:,:,1) ! account for change to the heat budget due to fw correction
ENDIF
!
@@ -138,6 +142,6 @@
IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN ! correct the freshwater fluxes
zcoef = fwfold * rcp
- emp(:,:) = emp(:,:) + fwfold
- qns(:,:) = qns(:,:) - zcoef * sst_m(:,:) ! account for change to the heat budget due to fw correction
+ emp(:,:) = emp(:,:) + fwfold * tmask(:,:,1)
+ qns(:,:) = qns(:,:) - zcoef * sst_m(:,:) * tmask(:,:,1) ! account for change to the heat budget due to fw correction
ENDIF
!
@@ -158,5 +162,5 @@
zsurf_pos = glob_sum( e1e2t(:,:)*ztmsk_pos(:,:) )
! ! fwf global mean (excluding ocean to ice/snow exchanges)
- z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) - snwice_fmass(:,:) ) ) / area
+ z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + rdivisf * fwfisf(:,:) - snwice_fmass(:,:) ) ) / area
!
IF( z_fwf < 0._wp ) THEN ! spread out over >0 erp area to increase evaporation
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90 (revision 5602)
@@ -40,4 +40,5 @@
# if defined key_cice4
USE ice_flux, only: strax,stray,strocnx,strocny,frain,fsnow, &
+ strocnxT,strocnyT, &
sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_gbm, &
fresh_gbm,fhocn_gbm,fswthru_gbm,frzmlt, &
@@ -48,4 +49,5 @@
#else
USE ice_flux, only: strax,stray,strocnx,strocny,frain,fsnow, &
+ strocnxT,strocnyT, &
sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_ai, &
fresh_ai,fhocn_ai,fswthru_ai,frzmlt, &
@@ -94,4 +96,5 @@
# include "domzgr_substitute.h90"
+ !! $Id$
CONTAINS
@@ -135,5 +138,5 @@
IF ( ksbc == jp_flx ) THEN
CALL cice_sbc_force(kt)
- ELSE IF ( ksbc == jp_cpl ) THEN
+ ELSE IF ( ksbc == jp_purecpl ) THEN
CALL sbc_cpl_ice_flx( 1.0-fr_i )
ENDIF
@@ -143,5 +146,5 @@
CALL cice_sbc_out ( kt, ksbc )
- IF ( ksbc == jp_cpl ) CALL cice_sbc_hadgam(kt+1)
+ IF ( ksbc == jp_purecpl ) CALL cice_sbc_hadgam(kt+1)
ENDIF ! End sea-ice time step only
@@ -184,5 +187,5 @@
! Do some CICE consistency checks
- IF ( (ksbc == jp_flx) .OR. (ksbc == jp_cpl) ) THEN
+ IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN
IF ( calc_strair .OR. calc_Tsfc ) THEN
CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=F and calc_Tsfc=F in ice_in' )
@@ -209,5 +212,5 @@
CALL cice2nemo(aice,fr_i, 'T', 1. )
- IF ( (ksbc == jp_flx) .OR. (ksbc == jp_cpl) ) THEN
+ IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN
DO jl=1,ncat
CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. )
@@ -316,5 +319,5 @@
! forced and coupled case
- IF ( (ksbc == jp_flx).OR.(ksbc == jp_cpl) ) THEN
+ IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN
ztmpn(:,:,:)=0.0
@@ -506,5 +509,5 @@
CALL nemo2cice(ztmp,ss_tlty,'F', -1. )
- CALL wrk_dealloc( jpi,jpj, ztmp )
+ CALL wrk_dealloc( jpi,jpj, ztmp, zpice )
CALL wrk_dealloc( jpi,jpj,ncat, ztmpn )
!
@@ -560,7 +563,17 @@
! Combine wind stress and ocean-ice stress
! [Note that fr_iu hasn't yet been updated, so still from start of CICE timestep]
+! strocnx and strocny already weighted by ice fraction in CICE so not done here
utau(:,:)=(1.0-fr_iu(:,:))*utau(:,:)-ss_iou(:,:)
vtau(:,:)=(1.0-fr_iv(:,:))*vtau(:,:)-ss_iov(:,:)
+
+! Also need ice/ocean stress on T points so that taum can be updated
+! This interpolation is already done in CICE so best to use those values
+ CALL cice2nemo(strocnxT,ztmp1,'T',-1.)
+ CALL cice2nemo(strocnyT,ztmp2,'T',-1.)
+
+! Update taum with modulus of ice-ocean stress
+! strocnxT and strocnyT are not weighted by ice fraction in CICE so must be done here
+taum(:,:)=(1.0-fr_i(:,:))*taum(:,:)+fr_i(:,:)*SQRT(ztmp1**2. + ztmp2**2.)
! Freshwater fluxes
@@ -574,5 +587,5 @@
ELSE IF (ksbc == jp_core) THEN
emp(:,:) = (1.0-fr_i(:,:))*emp(:,:)
- ELSE IF (ksbc == jp_cpl) THEN
+ ELSE IF (ksbc == jp_purecpl) THEN
! emp_tot is set in sbc_cpl_ice_flx (called from cice_sbc_in above)
! This is currently as required with the coupling fields from the UM atmosphere
@@ -610,5 +623,5 @@
ENDIF
! Take into account snow melting except for fully coupled when already in qns_tot
- IF (ksbc == jp_cpl) THEN
+ IF (ksbc == jp_purecpl) THEN
qsr(:,:)= qsr_tot(:,:)
qns(:,:)= qns_tot(:,:)
@@ -645,5 +658,5 @@
CALL cice2nemo(aice,fr_i,'T', 1. )
- IF ( (ksbc == jp_flx).OR.(ksbc == jp_cpl) ) THEN
+ IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN
DO jl=1,ncat
CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. )
@@ -1083,4 +1096,5 @@
!! Default option Dummy module NO CICE sea-ice model
!!----------------------------------------------------------------------
+ !! $Id$
CONTAINS
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90 (revision 5602)
@@ -105,5 +105,5 @@
fr_i(:,:) = eos_fzp( sss_m ) * tmask(:,:,1) ! sea surface freezing temperature [Celcius]
- IF( lk_cpl ) a_i(:,:,1) = fr_i(:,:)
+ IF( ln_cpl ) a_i(:,:,1) = fr_i(:,:)
! Flux and ice fraction computation
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90 (revision 5602)
@@ -19,12 +19,9 @@
!!----------------------------------------------------------------------
!! sbc_ice_lim : sea-ice model time-stepping and update ocean sbc over ice-covered area
- !! lim_ctl : alerts in case of ice model crash
- !! lim_prt_state : ice control print at a given grid point
!!----------------------------------------------------------------------
USE oce ! ocean dynamics and tracers
USE dom_oce ! ocean space and time domain
- USE par_ice ! sea-ice parameters
USE ice ! LIM-3: ice variables
- USE iceini ! LIM-3: ice initialisation
+ USE thd_ice ! LIM-3: thermodynamical variables
USE dom_ice ! LIM-3: ice domain
@@ -40,6 +37,6 @@
USE limdyn ! Ice dynamics
USE limtrp ! Ice transport
+ USE limhdf ! Ice horizontal diffusion
USE limthd ! Ice thermodynamics
- USE limitd_th ! Thermodynamics on ice thickness distribution
USE limitd_me ! Mechanics on ice thickness distribution
USE limsbc ! sea surface boundary condition
@@ -47,7 +44,11 @@
USE limwri ! Ice outputs
USE limrst ! Ice restarts
- USE limupdate1 ! update of global variables
- USE limupdate2 ! update of global variables
+ USE limupdate1 ! update of global variables
+ USE limupdate2 ! update of global variables
USE limvar ! Ice variables switch
+
+ USE limmsh ! LIM mesh
+ USE limistate ! LIM initial state
+ USE limthd_sal ! LIM ice thermodynamics: salinity
USE c1d ! 1D vertical configuration
@@ -60,4 +61,5 @@
USE prtctl ! Print control
USE lib_fortran !
+ USE limctl
#if defined key_bdy
@@ -69,5 +71,5 @@
PUBLIC sbc_ice_lim ! routine called by sbcmod.F90
- PUBLIC lim_prt_state
+ PUBLIC sbc_lim_init ! routine called by sbcmod.F90
!! * Substitutions
@@ -106,58 +108,86 @@
INTEGER, INTENT(in) :: kblk ! type of bulk (=3 CLIO, =4 CORE, =5 COUPLED)
!!
- INTEGER :: jl ! dummy loop index
- REAL(wp) :: zcoef ! local scalar
+ INTEGER :: jl ! dummy loop index
REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_os, zalb_cs ! ice albedo under overcast/clear sky
REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_ice ! mean ice albedo (for coupled)
+ REAL(wp), POINTER, DIMENSION(:,: ) :: zutau_ice, zvtau_ice
!!----------------------------------------------------------------------
IF( nn_timing == 1 ) CALL timing_start('sbc_ice_lim')
- IF( kt == nit000 ) THEN
- IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*) 'sbc_ice_lim : update ocean surface boudary condition'
- IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ via Louvain la Neuve Ice Model (LIM-3) time stepping'
- !
- CALL ice_init
- !
- IF( ln_nicep ) THEN ! control print at a given point
- jiindx = 15 ; jjindx = 44
- IF(lwp) WRITE(numout,*) ' The debugging point is : jiindx : ',jiindx, ' jjindx : ',jjindx
- ENDIF
- ENDIF
-
- ! !----------------------!
- IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! Ice time-step only !
- ! !----------------------!
- ! ! Bulk Formulae !
- ! !----------------!
- !
- u_oce(:,:) = ssu_m(:,:) * umask(:,:,1) ! mean surface ocean current at ice velocity point
- v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1) ! (C-grid dynamics : U- & V-points as the ocean)
- !
- t_bo(:,:) = ( eos_fzp( sss_m ) + rt0 ) * tmask(:,:,1) + rt0 * ( 1. - tmask(:,:,1) ) ! masked sea surface freezing temperature [Kelvin]
- ! ! (set to rt0 over land)
- ! ! Ice albedo
- CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice )
-
- CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos
-
+ !-----------------------!
+ ! --- Ice time step --- !
+ !-----------------------!
+ IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN
+
+ ! mean surface ocean current at ice velocity point (C-grid dynamics : U- & V-points as the ocean)
+ u_oce(:,:) = ssu_m(:,:) * umask(:,:,1)
+ v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1)
+
+ ! masked sea surface freezing temperature [Kelvin] (set to rt0 over land)
+ t_bo(:,:) = ( eos_fzp( sss_m ) + rt0 ) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) )
+
+ ! Mask sea ice surface temperature (set to rt0 over land)
+ DO jl = 1, jpl
+ t_su(:,:,jl) = t_su(:,:,jl) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) )
+ END DO
+ !
+ !------------------------------------------------!
+ ! --- Dynamical coupling with the atmosphere --- !
+ !------------------------------------------------!
+ ! It provides the following fields:
+ ! utau_ice, vtau_ice : surface ice stress (U- & V-points) [N/m2]
+ !-----------------------------------------------------------------
SELECT CASE( kblk )
- CASE( jp_core , jp_cpl ) ! CORE and COUPLED bulk formulations
-
- ! albedo depends on cloud fraction because of non-linear spectral effects
- zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
- ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo
- ! (zalb_ice) is computed within the bulk routine
-
+ CASE( jp_clio ) ; CALL blk_ice_clio_tau ! CLIO bulk formulation
+ CASE( jp_core ) ; CALL blk_ice_core_tau ! CORE bulk formulation
+ CASE( jp_purecpl ) ; CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) ! Coupled formulation
END SELECT
- ! ! Mask sea ice surface temperature
- DO jl = 1, jpl
- t_su(:,:,jl) = t_su(:,:,jl) + rt0 * ( 1. - tmask(:,:,1) )
- END DO
-
- ! Bulk formulae - provides the following fields:
- ! utau_ice, vtau_ice : surface ice stress (U- & V-points) [N/m2]
+ IF( ln_mixcpl) THEN ! Case of a mixed Bulk/Coupled formulation
+ CALL wrk_alloc( jpi,jpj , zutau_ice, zvtau_ice)
+ CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice )
+ utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) )
+ vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) )
+ CALL wrk_dealloc( jpi,jpj , zutau_ice, zvtau_ice)
+ ENDIF
+
+ !-------------------------------------------------------!
+ ! --- ice dynamics and transport (except in 1D case) ---!
+ !-------------------------------------------------------!
+ numit = numit + nn_fsbc ! Ice model time step
+ !
+ CALL sbc_lim_bef ! Store previous ice values
+ CALL sbc_lim_diag0 ! set diag of mass, heat and salt fluxes to 0
+ CALL lim_rst_opn( kt ) ! Open Ice restart file
+ !
+ IF( .NOT. lk_c1d ) THEN
+ !
+ CALL lim_dyn( kt ) ! Ice dynamics ( rheology/dynamics )
+ !
+ CALL lim_trp( kt ) ! Ice transport ( Advection/diffusion )
+ !
+ IF( nn_monocat /= 2 ) CALL lim_itd_me ! Mechanical redistribution ! (ridging/rafting)
+ !
+#if defined key_bdy
+ CALL bdy_ice_lim( kt ) ! bdy ice thermo
+ IF( ln_icectl ) CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' )
+#endif
+ !
+ CALL lim_update1( kt ) ! Corrections
+ !
+ ENDIF
+
+ ! previous lead fraction and ice volume for flux calculations
+ CALL sbc_lim_bef
+ CALL lim_var_glo2eqv ! ht_i and ht_s for ice albedo calculation
+ CALL lim_var_agg(1) ! at_i for coupling (via pfrld)
+ pfrld(:,:) = 1._wp - at_i(:,:)
+ phicif(:,:) = vt_i(:,:)
+
+ !------------------------------------------------------!
+ ! --- Thermodynamical coupling with the atmosphere --- !
+ !------------------------------------------------------!
+ ! It provides the following fields:
! qsr_ice , qns_ice : solar & non solar heat flux over ice (T-point) [W/m2]
! qla_ice : latent heat flux over ice (T-point) [W/m2]
@@ -165,193 +195,282 @@
! tprecip , sprecip : total & solid precipitation (T-point) [Kg/m2/s]
! fr1_i0 , fr2_i0 : 1sr & 2nd fraction of qsr penetration in ice [%]
- !
+ !----------------------------------------------------------------------------------------
+ CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice )
+ CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos
+
SELECT CASE( kblk )
CASE( jp_clio ) ! CLIO bulk formulation
- CALL blk_ice_clio( t_su , zalb_cs , zalb_os , zalb_ice , &
- & utau_ice , vtau_ice , qns_ice , qsr_ice , &
- & qla_ice , dqns_ice , dqla_ice , &
- & tprecip , sprecip , &
- & fr1_i0 , fr2_i0 , cp_ice_msh, jpl )
- !
- IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , &
- & dqns_ice, qla_ice, dqla_ice, nn_limflx )
-
+ ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo
+ ! (zalb_ice) is computed within the bulk routine
+ CALL blk_ice_clio_flx( t_su, zalb_cs, zalb_os, zalb_ice )
+ IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su )
+ IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx )
CASE( jp_core ) ! CORE bulk formulation
- CALL blk_ice_core( t_su , u_ice , v_ice , zalb_ice , &
- & utau_ice , vtau_ice , qns_ice , qsr_ice , &
- & qla_ice , dqns_ice , dqla_ice , &
- & tprecip , sprecip , &
- & fr1_i0 , fr2_i0 , cp_ice_msh, jpl )
- !
- IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , &
- & dqns_ice, qla_ice, dqla_ice, nn_limflx )
- !
- CASE ( jp_cpl )
-
- CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )
-
- ! MV -> seb
-! CALL sbc_cpl_ice_flx( p_frld=ato_i, palbi=zalb_ice, psst=sst_m, pist=t_su )
-
-! IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , &
-! & dqns_ice, qla_ice, dqla_ice, nn_limflx )
-! ! Latent heat flux is forced to 0 in coupled :
-! ! it is included in qns (non-solar heat flux)
-! qla_ice (:,:,:) = 0._wp
-! dqla_ice (:,:,:) = 0._wp
- ! END MV -> seb
- !
+ ! albedo depends on cloud fraction because of non-linear spectral effects
+ zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
+ CALL blk_ice_core_flx( t_su, zalb_ice )
+ IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su )
+ IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx )
+ CASE ( jp_purecpl )
+ ! albedo depends on cloud fraction because of non-linear spectral effects
+ zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
+ CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su )
+ ! clem: evap_ice is forced to 0 in coupled mode for now
+ ! but it needs to be changed (along with modif in limthd_dh) once heat flux from evap will be avail. from atm. models
+ evap_ice (:,:,:) = 0._wp ; devap_ice (:,:,:) = 0._wp
+ IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx )
END SELECT
-
- ! !----------------------!
- ! ! LIM-3 time-stepping !
- ! !----------------------!
- !
- numit = numit + nn_fsbc ! Ice model time step
- !
- ! ! Store previous ice values
- a_i_b (:,:,:) = a_i (:,:,:) ! ice area
- e_i_b (:,:,:,:) = e_i (:,:,:,:) ! ice thermal energy
- v_i_b (:,:,:) = v_i (:,:,:) ! ice volume
- v_s_b (:,:,:) = v_s (:,:,:) ! snow volume
- e_s_b (:,:,:,:) = e_s (:,:,:,:) ! snow thermal energy
- smv_i_b(:,:,:) = smv_i(:,:,:) ! salt content
- oa_i_b (:,:,:) = oa_i (:,:,:) ! areal age content
- u_ice_b(:,:) = u_ice(:,:)
- v_ice_b(:,:) = v_ice(:,:)
-
- ! salt, heat and mass fluxes
- sfx (:,:) = 0._wp ;
- sfx_bri(:,:) = 0._wp ;
- sfx_sni(:,:) = 0._wp ; sfx_opw(:,:) = 0._wp
- sfx_bog(:,:) = 0._wp ; sfx_dyn(:,:) = 0._wp
- sfx_bom(:,:) = 0._wp ; sfx_sum(:,:) = 0._wp
- sfx_res(:,:) = 0._wp
-
- wfx_snw(:,:) = 0._wp ; wfx_ice(:,:) = 0._wp
- wfx_sni(:,:) = 0._wp ; wfx_opw(:,:) = 0._wp
- wfx_bog(:,:) = 0._wp ; wfx_dyn(:,:) = 0._wp
- wfx_bom(:,:) = 0._wp ; wfx_sum(:,:) = 0._wp
- wfx_res(:,:) = 0._wp ; wfx_sub(:,:) = 0._wp
- wfx_spr(:,:) = 0._wp ;
-
- hfx_in (:,:) = 0._wp ; hfx_out(:,:) = 0._wp
- hfx_thd(:,:) = 0._wp ;
- hfx_snw(:,:) = 0._wp ; hfx_opw(:,:) = 0._wp
- hfx_bog(:,:) = 0._wp ; hfx_dyn(:,:) = 0._wp
- hfx_bom(:,:) = 0._wp ; hfx_sum(:,:) = 0._wp
- hfx_res(:,:) = 0._wp ; hfx_sub(:,:) = 0._wp
- hfx_spr(:,:) = 0._wp ; hfx_dif(:,:) = 0._wp
- hfx_err(:,:) = 0._wp ; hfx_err_rem(:,:) = 0._wp
-
- CALL lim_rst_opn( kt ) ! Open Ice restart file
- !
- IF( ln_nicep ) CALL lim_prt_state( kt, jiindx, jjindx, 1, ' - Beginning the time step - ' ) ! control print
- ! ----------------------------------------------
- ! ice dynamics and transport (except in 1D case)
- ! ----------------------------------------------
- IF( .NOT. lk_c1d ) THEN
- CALL lim_dyn( kt ) ! Ice dynamics ( rheology/dynamics )
- CALL lim_trp( kt ) ! Ice transport ( Advection/diffusion )
- CALL lim_var_glo2eqv ! equivalent variables, requested for rafting
- IF( ln_nicep ) CALL lim_prt_state( kt, jiindx, jjindx,-1, ' - ice dyn & trp - ' ) ! control print
- CALL lim_itd_me ! Mechanical redistribution ! (ridging/rafting)
- CALL lim_var_agg( 1 )
-#if defined key_bdy
- ! bdy ice thermo
- CALL lim_var_glo2eqv ! equivalent variables
- CALL bdy_ice_lim( kt )
- CALL lim_itd_me_zapsmall
- CALL lim_var_agg(1)
- IF( ln_nicep ) CALL lim_prt_state( kt, jiindx, jjindx, 1, ' - ice thermo bdy - ' ) ! control print
-#endif
- CALL lim_update1
- ENDIF
-! !- Change old values for new values
- u_ice_b(:,:) = u_ice(:,:)
- v_ice_b(:,:) = v_ice(:,:)
- a_i_b (:,:,:) = a_i (:,:,:)
- v_s_b (:,:,:) = v_s (:,:,:)
- v_i_b (:,:,:) = v_i (:,:,:)
- e_s_b (:,:,:,:) = e_s (:,:,:,:)
- e_i_b (:,:,:,:) = e_i (:,:,:,:)
- oa_i_b (:,:,:) = oa_i (:,:,:)
- smv_i_b(:,:,:) = smv_i(:,:,:)
-
- ! ----------------------------------------------
- ! ice thermodynamic
- ! ----------------------------------------------
- CALL lim_var_glo2eqv ! equivalent variables
- CALL lim_var_agg(1) ! aggregate ice categories
- ! previous lead fraction and ice volume for flux calculations
- pfrld(:,:) = 1._wp - at_i(:,:)
- phicif(:,:) = vt_i(:,:)
-
- ! MV -> seb
- SELECT CASE( kblk )
- CASE ( jp_cpl )
- CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su )
- IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , &
- & dqns_ice, qla_ice, dqla_ice, nn_limflx )
- ! Latent heat flux is forced to 0 in coupled :
- ! it is included in qns (non-solar heat flux)
- qla_ice (:,:,:) = 0._wp
- dqla_ice (:,:,:) = 0._wp
- END SELECT
- ! END MV -> seb
- !
- CALL lim_var_bv ! bulk brine volume (diag)
- CALL lim_thd( kt ) ! Ice thermodynamics
- zcoef = rdt_ice /rday ! Ice natural aging
- oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * zcoef
- IF( ln_nicep ) CALL lim_prt_state( kt, jiindx, jjindx, 1, ' - ice thermodyn. - ' ) ! control print
- CALL lim_itd_th( kt ) ! Remap ice categories, lateral accretion !
- CALL lim_var_agg( 1 ) ! requested by limupdate
- CALL lim_update2 ! Global variables update
-
- CALL lim_var_glo2eqv ! equivalent variables (outputs)
- CALL lim_var_agg(2) ! aggregate ice thickness categories
- IF( ln_nicep ) CALL lim_prt_state( kt, jiindx, jjindx, 2, ' - Final state - ' ) ! control print
- !
- CALL lim_sbc_flx( kt ) ! Update surface ocean mass, heat and salt fluxes
- !
- IF( ln_nicep ) CALL lim_prt_state( kt, jiindx, jjindx, 3, ' - Final state lim_sbc - ' ) ! control print
- !
- ! ! Diagnostics and outputs
- IF (ln_limdiaout) CALL lim_diahsb
-
- CALL lim_wri( 1 ) ! Ice outputs
-
+ CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice )
+
+ !----------------------------!
+ ! --- ice thermodynamics --- !
+ !----------------------------!
+ CALL lim_thd( kt ) ! Ice thermodynamics
+ !
+ CALL lim_update2( kt ) ! Corrections
+ !
+ CALL lim_sbc_flx( kt ) ! Update surface ocean mass, heat and salt fluxes
+ !
+ IF(ln_limdiaout) CALL lim_diahsb ! Diagnostics and outputs
+ !
+ CALL lim_wri( 1 ) ! Ice outputs
+ !
IF( kt == nit000 .AND. ln_rstart ) &
- & CALL iom_close( numrir ) ! clem: close input ice restart file
- !
- IF( lrst_ice ) CALL lim_rst_write( kt ) ! Ice restart file
- CALL lim_var_glo2eqv ! ???
- !
- IF( ln_nicep ) CALL lim_ctl( kt ) ! alerts in case of model crash
- !
- CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice )
- !
- ENDIF ! End sea-ice time step only
-
- ! !--------------------------!
- ! ! at all ocean time step !
- ! !--------------------------!
- !
- ! ! Update surface ocean stresses (only in ice-dynamic case)
- ! ! otherwise the atm.-ocean stresses are used everywhere
+ & CALL iom_close( numrir ) ! close input ice restart file
+ !
+ IF( lrst_ice ) CALL lim_rst_write( kt ) ! Ice restart file
+ !
+ IF( ln_icectl ) CALL lim_ctl( kt ) ! alerts in case of model crash
+ !
+ ENDIF ! End sea-ice time step only
+
+ !-------------------------!
+ ! --- Ocean time step --- !
+ !-------------------------!
+ ! Update surface ocean stresses (only in ice-dynamic case) otherwise the atm.-ocean stresses are used everywhere
IF( ln_limdyn ) CALL lim_sbc_tau( kt, ub(:,:,1), vb(:,:,1) ) ! using before instantaneous surf. currents
!!gm remark, the ocean-ice stress is not saved in ice diag call above ..... find a solution!!!
-
- !
- IF( nn_timing == 1 ) CALL timing_stop('sbc_ice_lim')
+ !
+ IF( nn_timing == 1 ) CALL timing_stop('sbc_ice_lim')
!
END SUBROUTINE sbc_ice_lim
+
+ SUBROUTINE sbc_lim_init
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE sbc_lim_init ***
+ !!
+ !! ** purpose : Allocate all the dynamic arrays of the LIM-3 modules
+ !!----------------------------------------------------------------------
+ INTEGER :: ierr
+ !!----------------------------------------------------------------------
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) 'sbc_ice_lim : update ocean surface boudary condition'
+ IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ via Louvain la Neuve Ice Model (LIM-3) time stepping'
+ !
+ ! Open the reference and configuration namelist files and namelist output file
+ CALL ctl_opn( numnam_ice_ref, 'namelist_ice_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
+ CALL ctl_opn( numnam_ice_cfg, 'namelist_ice_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
+ IF(lwm) CALL ctl_opn( numoni, 'output.namelist.ice', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, 1 )
+
+ CALL ice_run ! set some ice run parameters
+ !
+ ! ! Allocate the ice arrays
+ ierr = ice_alloc () ! ice variables
+ ierr = ierr + dom_ice_alloc () ! domain
+ ierr = ierr + sbc_ice_alloc () ! surface forcing
+ ierr = ierr + thd_ice_alloc () ! thermodynamics
+ ierr = ierr + lim_itd_me_alloc () ! ice thickness distribution - mechanics
+ !
+ IF( lk_mpp ) CALL mpp_sum( ierr )
+ IF( ierr /= 0 ) CALL ctl_stop('STOP', 'sbc_lim_init : unable to allocate ice arrays')
+ !
+ ! ! adequation jpk versus ice/snow layers/categories
+ IF( jpl > jpk .OR. (nlay_i+1) > jpk .OR. nlay_s > jpk ) &
+ & CALL ctl_stop( 'STOP', &
+ & 'sbc_lim_init: the 3rd dimension of workspace arrays is too small.', &
+ & 'use more ocean levels or less ice/snow layers/categories.' )
+ !
+ CALL lim_itd_init ! ice thickness distribution initialization
+ !
+ CALL lim_hdf_init ! set ice horizontal diffusion computation parameters
+ !
+ CALL lim_thd_init ! set ice thermodynics parameters
+ !
+ CALL lim_thd_sal_init ! set ice salinity parameters
+ !
+ CALL lim_msh ! ice mesh initialization
+ !
+ CALL lim_itd_me_init ! ice thickness distribution initialization for mecanical deformation
+ ! ! Initial sea-ice state
+ IF( .NOT. ln_rstart ) THEN ! start from rest: sea-ice deduced from sst
+ numit = 0
+ numit = nit000 - 1
+ CALL lim_istate
+ ELSE ! start from a restart file
+ CALL lim_rst_read
+ numit = nit000 - 1
+ ENDIF
+ CALL lim_var_agg(1)
+ CALL lim_var_glo2eqv
+ !
+ CALL lim_sbc_init ! ice surface boundary condition
+ !
+ fr_i(:,:) = at_i(:,:) ! initialisation of sea-ice fraction
+ tn_ice(:,:,:) = t_su(:,:,:) ! initialisation of surface temp for coupled simu
+ !
+ nstart = numit + nn_fsbc
+ nitrun = nitend - nit000 + 1
+ nlast = numit + nitrun
+ !
+ IF( nstock == 0 ) nstock = nlast + 1
+ !
+ END SUBROUTINE sbc_lim_init
+
+
+ SUBROUTINE ice_run
+ !!-------------------------------------------------------------------
+ !! *** ROUTINE ice_run ***
+ !!
+ !! ** Purpose : Definition some run parameter for ice model
+ !!
+ !! ** Method : Read the namicerun namelist and check the parameter
+ !! values called at the first timestep (nit000)
+ !!
+ !! ** input : Namelist namicerun
+ !!-------------------------------------------------------------------
+ INTEGER :: ios ! Local integer output status for namelist read
+ NAMELIST/namicerun/ jpl, nlay_i, nlay_s, cn_icerst_in, cn_icerst_indir, cn_icerst_out, cn_icerst_outdir, &
+ & ln_limdyn, rn_amax, ln_limdiahsb, ln_limdiaout, ln_icectl, iiceprt, jiceprt
+ !!-------------------------------------------------------------------
+ !
+ REWIND( numnam_ice_ref ) ! Namelist namicerun in reference namelist : Parameters for ice
+ READ ( numnam_ice_ref, namicerun, IOSTAT = ios, ERR = 901)
+901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in reference namelist', lwp )
+
+ REWIND( numnam_ice_cfg ) ! Namelist namicerun in configuration namelist : Parameters for ice
+ READ ( numnam_ice_cfg, namicerun, IOSTAT = ios, ERR = 902 )
+902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in configuration namelist', lwp )
+ IF(lwm) WRITE ( numoni, namicerun )
+ !
+ !
+ IF(lwp) THEN ! control print
+ WRITE(numout,*)
+ WRITE(numout,*) 'ice_run : ice share parameters for dynamics/advection/thermo of sea-ice'
+ WRITE(numout,*) ' ~~~~~~'
+ WRITE(numout,*) ' number of ice categories = ', jpl
+ WRITE(numout,*) ' number of ice layers = ', nlay_i
+ WRITE(numout,*) ' number of snow layers = ', nlay_s
+ WRITE(numout,*) ' switch for ice dynamics (1) or not (0) ln_limdyn = ', ln_limdyn
+ WRITE(numout,*) ' maximum ice concentration = ', rn_amax
+ WRITE(numout,*) ' Diagnose heat/salt budget or not ln_limdiahsb = ', ln_limdiahsb
+ WRITE(numout,*) ' Output heat/salt budget or not ln_limdiaout = ', ln_limdiaout
+ WRITE(numout,*) ' control prints in ocean.out for (i,j)=(iiceprt,jiceprt) = ', ln_icectl
+ WRITE(numout,*) ' i-index for control prints (ln_icectl=true) = ', iiceprt
+ WRITE(numout,*) ' j-index for control prints (ln_icectl=true) = ', jiceprt
+ ENDIF
+ !
+ ! sea-ice timestep and inverse
+ rdt_ice = nn_fsbc * rdttra(1)
+ r1_rdtice = 1._wp / rdt_ice
+
+ ! inverse of nlay_i and nlay_s
+ r1_nlay_i = 1._wp / REAL( nlay_i, wp )
+ r1_nlay_s = 1._wp / REAL( nlay_s, wp )
+ !
+#if defined key_bdy
+ IF( lwp .AND. ln_limdiahsb ) CALL ctl_warn('online conservation check activated but it does not work with BDY')
+#endif
+ !
+ END SUBROUTINE ice_run
+
+
+ SUBROUTINE lim_itd_init
+ !!------------------------------------------------------------------
+ !! *** ROUTINE lim_itd_init ***
+ !!
+ !! ** Purpose : Initializes the ice thickness distribution
+ !! ** Method : ...
+ !! ** input : Namelist namiceitd
+ !!-------------------------------------------------------------------
+ INTEGER :: ios ! Local integer output status for namelist read
+ NAMELIST/namiceitd/ nn_catbnd, rn_himean
+ !
+ INTEGER :: jl ! dummy loop index
+ REAL(wp) :: zc1, zc2, zc3, zx1 ! local scalars
+ REAL(wp) :: zhmax, znum, zden, zalpha !
+ !!------------------------------------------------------------------
+ !
+ REWIND( numnam_ice_ref ) ! Namelist namiceitd in reference namelist : Parameters for ice
+ READ ( numnam_ice_ref, namiceitd, IOSTAT = ios, ERR = 903)
+903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in reference namelist', lwp )
+
+ REWIND( numnam_ice_cfg ) ! Namelist namiceitd in configuration namelist : Parameters for ice
+ READ ( numnam_ice_cfg, namiceitd, IOSTAT = ios, ERR = 904 )
+904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in configuration namelist', lwp )
+ IF(lwm) WRITE ( numoni, namiceitd )
+ !
+ !
+ IF(lwp) THEN ! control print
+ WRITE(numout,*)
+ WRITE(numout,*) 'ice_itd : ice cat distribution'
+ WRITE(numout,*) ' ~~~~~~'
+ WRITE(numout,*) ' shape of ice categories distribution nn_catbnd = ', nn_catbnd
+ WRITE(numout,*) ' mean ice thickness in the domain (only active if nn_catbnd=2) rn_himean = ', rn_himean
+ ENDIF
+
+ !----------------------------------
+ !- Thickness categories boundaries
+ !----------------------------------
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) 'lim_itd_init : Initialization of ice cat distribution '
+ IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+
+ hi_max(:) = 0._wp
+
+ SELECT CASE ( nn_catbnd )
+ !----------------------
+ CASE (1) ! tanh function (CICE)
+ !----------------------
+ zc1 = 3._wp / REAL( jpl, wp )
+ zc2 = 10._wp * zc1
+ zc3 = 3._wp
+
+ DO jl = 1, jpl
+ zx1 = REAL( jl-1, wp ) / REAL( jpl, wp )
+ hi_max(jl) = hi_max(jl-1) + zc1 + zc2 * (1._wp + TANH( zc3 * (zx1 - 1._wp ) ) )
+ END DO
+
+ !----------------------
+ CASE (2) ! h^(-alpha) function
+ !----------------------
+ zalpha = 0.05 ! exponent of the transform function
+
+ zhmax = 3.*rn_himean
+
+ DO jl = 1, jpl
+ znum = jpl * ( zhmax+1 )**zalpha
+ zden = ( jpl - jl ) * ( zhmax+1 )**zalpha + jl
+ hi_max(jl) = ( znum / zden )**(1./zalpha) - 1
+ END DO
+
+ END SELECT
+
+ DO jl = 1, jpl
+ hi_mean(jl) = ( hi_max(jl) + hi_max(jl-1) ) * 0.5_wp
+ END DO
+
+ ! Set hi_max(jpl) to a big value to ensure that all ice is thinner than hi_max(jpl)
+ hi_max(jpl) = 99._wp
+
+ IF(lwp) WRITE(numout,*) ' Thickness category boundaries '
+ IF(lwp) WRITE(numout,*) ' hi_max ', hi_max(0:jpl)
+ !
+ END SUBROUTINE lim_itd_init
+
- SUBROUTINE ice_lim_flx( ptn_ice, palb_ice, pqns_ice, pqsr_ice, &
- & pdqn_ice, pqla_ice, pdql_ice, k_limflx )
+ SUBROUTINE ice_lim_flx( ptn_ice, palb_ice, pqns_ice, pqsr_ice, pdqn_ice, pevap_ice, pdevap_ice, k_limflx )
!!---------------------------------------------------------------------
- !! *** ROUTINE sbc_ice_lim ***
+ !! *** ROUTINE ice_lim_flx ***
!!
!! ** Purpose : update the ice surface boundary condition by averaging and / or
@@ -369,6 +488,6 @@
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) :: pqla_ice ! latent heat flux
- REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pdql_ice ! latent heat flux sensitivity
+ REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pevap_ice ! sublimation
+ REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pdevap_ice ! sublimation sensitivity
!
INTEGER :: jl ! dummy loop index
@@ -379,7 +498,7 @@
REAL(wp), POINTER, DIMENSION(:,:) :: z_qsr_m ! Mean solar heat flux over all categories
REAL(wp), POINTER, DIMENSION(:,:) :: z_qns_m ! Mean non solar heat flux over all categories
- REAL(wp), POINTER, DIMENSION(:,:) :: z_qla_m ! Mean latent heat flux over all categories
+ REAL(wp), POINTER, DIMENSION(:,:) :: z_evap_m ! Mean sublimation over all categories
REAL(wp), POINTER, DIMENSION(:,:) :: z_dqn_m ! Mean d(qns)/dT over all categories
- REAL(wp), POINTER, DIMENSION(:,:) :: z_dql_m ! Mean d(qla)/dT over all categories
+ REAL(wp), POINTER, DIMENSION(:,:) :: z_devap_m ! Mean d(evap)/dT over all categories
!!----------------------------------------------------------------------
@@ -389,23 +508,23 @@
SELECT CASE( k_limflx ) !== averaged on all ice categories ==!
CASE( 0 , 1 )
- CALL wrk_alloc( jpi,jpj, z_qsr_m, z_qns_m, z_qla_m, z_dqn_m, z_dql_m)
- !
- z_qns_m(:,:) = fice_ice_ave ( pqns_ice (:,:,:) )
- z_qsr_m(:,:) = fice_ice_ave ( pqsr_ice (:,:,:) )
- z_dqn_m(:,:) = fice_ice_ave ( pdqn_ice (:,:,:) )
- z_qla_m(:,:) = fice_ice_ave ( pqla_ice (:,:,:) )
- z_dql_m(:,:) = fice_ice_ave ( pdql_ice (:,:,:) )
+ CALL wrk_alloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m)
+ !
+ z_qns_m (:,:) = fice_ice_ave ( pqns_ice (:,:,:) )
+ z_qsr_m (:,:) = fice_ice_ave ( pqsr_ice (:,:,:) )
+ z_dqn_m (:,:) = fice_ice_ave ( pdqn_ice (:,:,:) )
+ z_evap_m (:,:) = fice_ice_ave ( pevap_ice (:,:,:) )
+ z_devap_m(:,:) = fice_ice_ave ( pdevap_ice (:,:,:) )
DO jl = 1, jpl
- pdqn_ice(:,:,jl) = z_dqn_m(:,:)
- pdql_ice(:,:,jl) = z_dql_m(:,:)
+ pdqn_ice (:,:,jl) = z_dqn_m(:,:)
+ pdevap_ice(:,:,jl) = z_devap_m(:,:)
END DO
!
DO jl = 1, jpl
- pqns_ice(:,:,jl) = z_qns_m(:,:)
- pqsr_ice(:,:,jl) = z_qsr_m(:,:)
- pqla_ice(:,:,jl) = z_qla_m(:,:)
+ pqns_ice (:,:,jl) = z_qns_m(:,:)
+ pqsr_ice (:,:,jl) = z_qsr_m(:,:)
+ pevap_ice(:,:,jl) = z_evap_m(:,:)
END DO
!
- CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_qla_m, z_dqn_m, z_dql_m)
+ CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m)
END SELECT
@@ -417,7 +536,7 @@
ztem_m(:,:) = fice_ice_ave ( ptn_ice (:,:,:) )
DO jl = 1, jpl
- pqns_ice(:,:,jl) = pqns_ice(:,:,jl) + pdqn_ice(:,:,jl) * (ptn_ice(:,:,jl) - ztem_m(:,:))
- pqla_ice(:,:,jl) = pqla_ice(:,:,jl) + pdql_ice(:,:,jl) * (ptn_ice(:,:,jl) - ztem_m(:,:))
- pqsr_ice(:,:,jl) = pqsr_ice(:,:,jl) * ( 1._wp - palb_ice(:,:,jl) ) / ( 1._wp - zalb_m(:,:) )
+ 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(:,:) )
+ pqsr_ice (:,:,jl) = pqsr_ice (:,:,jl) * ( 1._wp - palb_ice(:,:,jl) ) / ( 1._wp - zalb_m(:,:) )
END DO
!
@@ -428,418 +547,61 @@
!
END SUBROUTINE ice_lim_flx
-
-
- SUBROUTINE lim_ctl( kt )
- !!-----------------------------------------------------------------------
- !! *** ROUTINE lim_ctl ***
- !!
- !! ** Purpose : Alerts in case of model crash
- !!-------------------------------------------------------------------
- INTEGER, INTENT(in) :: kt ! ocean time step
- INTEGER :: ji, jj, jk, jl ! dummy loop indices
- INTEGER :: inb_altests ! number of alert tests (max 20)
- INTEGER :: ialert_id ! number of the current alert
- REAL(wp) :: ztmelts ! ice layer melting point
- CHARACTER (len=30), DIMENSION(20) :: cl_alname ! name of alert
- INTEGER , DIMENSION(20) :: inb_alp ! number of alerts positive
- !!-------------------------------------------------------------------
-
- inb_altests = 10
- inb_alp(:) = 0
-
- ! Alert if incompatible volume and concentration
- ialert_id = 2 ! reference number of this alert
- cl_alname(ialert_id) = ' Incompat vol and con ' ! name of the alert
-
- DO jl = 1, jpl
- DO jj = 1, jpj
- DO ji = 1, jpi
- IF( v_i(ji,jj,jl) /= 0._wp .AND. a_i(ji,jj,jl) == 0._wp ) THEN
- !WRITE(numout,*) ' ALERTE 2 : Incompatible volume and concentration '
- !WRITE(numout,*) ' at_i ', at_i(ji,jj)
- !WRITE(numout,*) ' Point - category', ji, jj, jl
- !WRITE(numout,*) ' a_i *** a_i_b ', a_i (ji,jj,jl), a_i_b (ji,jj,jl)
- !WRITE(numout,*) ' v_i *** v_i_b ', v_i (ji,jj,jl), v_i_b (ji,jj,jl)
- !WRITE(numout,*) ' d_a_i_thd/trp ', d_a_i_thd(ji,jj,jl), d_a_i_trp(ji,jj,jl)
- !WRITE(numout,*) ' d_v_i_thd/trp ', d_v_i_thd(ji,jj,jl), d_v_i_trp(ji,jj,jl)
- inb_alp(ialert_id) = inb_alp(ialert_id) + 1
- ENDIF
- END DO
- END DO
- END DO
-
- ! Alerte if very thick ice
- ialert_id = 3 ! reference number of this alert
- cl_alname(ialert_id) = ' Very thick ice ' ! name of the alert
- jl = jpl
- DO jj = 1, jpj
- DO ji = 1, jpi
- IF( ht_i(ji,jj,jl) > 50._wp ) THEN
- !CALL lim_prt_state( kt, ji, jj, 2, ' ALERTE 3 : Very thick ice ' )
- inb_alp(ialert_id) = inb_alp(ialert_id) + 1
- ENDIF
- END DO
- END DO
-
- ! Alert if very fast ice
- ialert_id = 4 ! reference number of this alert
- cl_alname(ialert_id) = ' Very fast ice ' ! name of the alert
- DO jj = 1, jpj
- DO ji = 1, jpi
- IF( MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 1.5 .AND. &
- & at_i(ji,jj) > 0._wp ) THEN
- !CALL lim_prt_state( kt, ji, jj, 1, ' ALERTE 4 : Very fast ice ' )
- !WRITE(numout,*) ' ice strength : ', strength(ji,jj)
- !WRITE(numout,*) ' oceanic stress utau : ', utau(ji,jj)
- !WRITE(numout,*) ' oceanic stress vtau : ', vtau(ji,jj)
- !WRITE(numout,*) ' sea-ice stress utau_ice : ', utau_ice(ji,jj)
- !WRITE(numout,*) ' sea-ice stress vtau_ice : ', vtau_ice(ji,jj)
- !WRITE(numout,*) ' oceanic speed u : ', u_oce(ji,jj)
- !WRITE(numout,*) ' oceanic speed v : ', v_oce(ji,jj)
- !WRITE(numout,*) ' sst : ', sst_m(ji,jj)
- !WRITE(numout,*) ' sss : ', sss_m(ji,jj)
- !WRITE(numout,*)
- inb_alp(ialert_id) = inb_alp(ialert_id) + 1
- ENDIF
- END DO
- END DO
-
- ! Alert if there is ice on continents
- ialert_id = 6 ! reference number of this alert
- cl_alname(ialert_id) = ' Ice on continents ' ! name of the alert
- DO jj = 1, jpj
- DO ji = 1, jpi
- IF( tms(ji,jj) <= 0._wp .AND. at_i(ji,jj) > 0._wp ) THEN
- !CALL lim_prt_state( kt, ji, jj, 1, ' ALERTE 6 : Ice on continents ' )
- !WRITE(numout,*) ' masks s, u, v : ', tms(ji,jj), tmu(ji,jj), tmv(ji,jj)
- !WRITE(numout,*) ' sst : ', sst_m(ji,jj)
- !WRITE(numout,*) ' sss : ', sss_m(ji,jj)
- !WRITE(numout,*) ' at_i(ji,jj) : ', at_i(ji,jj)
- !WRITE(numout,*) ' v_ice(ji,jj) : ', v_ice(ji,jj)
- !WRITE(numout,*) ' v_ice(ji,jj-1) : ', v_ice(ji,jj-1)
- !WRITE(numout,*) ' u_ice(ji-1,jj) : ', u_ice(ji-1,jj)
- !WRITE(numout,*) ' u_ice(ji,jj) : ', v_ice(ji,jj)
- !
- inb_alp(ialert_id) = inb_alp(ialert_id) + 1
- ENDIF
- END DO
- END DO
-
-!
-! ! Alert if very fresh ice
- ialert_id = 7 ! reference number of this alert
- cl_alname(ialert_id) = ' Very fresh ice ' ! name of the alert
- DO jl = 1, jpl
- DO jj = 1, jpj
- DO ji = 1, jpi
- IF( sm_i(ji,jj,jl) < 0.1 .AND. a_i(ji,jj,jl) > 0._wp ) THEN
-! CALL lim_prt_state(kt,ji,jj,1, ' ALERTE 7 : Very fresh ice ' )
-! WRITE(numout,*) ' sst : ', sst_m(ji,jj)
-! WRITE(numout,*) ' sss : ', sss_m(ji,jj)
-! WRITE(numout,*)
- inb_alp(ialert_id) = inb_alp(ialert_id) + 1
- ENDIF
- END DO
- END DO
- END DO
-!
-
-! ! Alert if too old ice
- ialert_id = 9 ! reference number of this alert
- cl_alname(ialert_id) = ' Very old ice ' ! name of the alert
- DO jl = 1, jpl
- DO jj = 1, jpj
- DO ji = 1, jpi
- IF ( ( ( ABS( o_i(ji,jj,jl) ) > rdt_ice ) .OR. &
- ( ABS( o_i(ji,jj,jl) ) < 0._wp) ) .AND. &
- ( a_i(ji,jj,jl) > 0._wp ) ) THEN
- !CALL lim_prt_state( kt, ji, jj, 1, ' ALERTE 9 : Wrong ice age ')
- inb_alp(ialert_id) = inb_alp(ialert_id) + 1
- ENDIF
- END DO
- END DO
- END DO
-
- ! Alert on salt flux
- ialert_id = 5 ! reference number of this alert
- cl_alname(ialert_id) = ' High salt flux ' ! name of the alert
- DO jj = 1, jpj
- DO ji = 1, jpi
- IF( ABS( sfx (ji,jj) ) .GT. 1.0e-2 ) THEN ! = 1 psu/day for 1m ocean depth
- !CALL lim_prt_state( kt, ji, jj, 3, ' ALERTE 5 : High salt flux ' )
- !DO jl = 1, jpl
- !WRITE(numout,*) ' Category no: ', jl
- !WRITE(numout,*) ' a_i : ', a_i (ji,jj,jl) , ' a_i_b : ', a_i_b (ji,jj,jl)
- !WRITE(numout,*) ' d_a_i_trp : ', d_a_i_trp(ji,jj,jl) , ' d_a_i_thd : ', d_a_i_thd(ji,jj,jl)
- !WRITE(numout,*) ' v_i : ', v_i (ji,jj,jl) , ' v_i_b : ', v_i_b (ji,jj,jl)
- !WRITE(numout,*) ' d_v_i_trp : ', d_v_i_trp(ji,jj,jl) , ' d_v_i_thd : ', d_v_i_thd(ji,jj,jl)
- !WRITE(numout,*) ' '
- !END DO
- inb_alp(ialert_id) = inb_alp(ialert_id) + 1
- ENDIF
- END DO
- END DO
-
- ! Alert if qns very big
- ialert_id = 8 ! reference number of this alert
- cl_alname(ialert_id) = ' fnsolar very big ' ! name of the alert
- DO jj = 1, jpj
- DO ji = 1, jpi
- IF( ABS( qns(ji,jj) ) > 1500._wp .AND. at_i(ji,jj) > 0._wp ) THEN
- !
- !WRITE(numout,*) ' ALERTE 8 : Very high non-solar heat flux'
- !WRITE(numout,*) ' ji, jj : ', ji, jj
- !WRITE(numout,*) ' qns : ', qns(ji,jj)
- !WRITE(numout,*) ' sst : ', sst_m(ji,jj)
- !WRITE(numout,*) ' sss : ', sss_m(ji,jj)
- !
- !CALL lim_prt_state( kt, ji, jj, 2, ' ')
- inb_alp(ialert_id) = inb_alp(ialert_id) + 1
- !
- ENDIF
- END DO
- END DO
- !+++++
-
- ! Alert if very warm ice
- ialert_id = 10 ! reference number of this alert
- cl_alname(ialert_id) = ' Very warm ice ' ! name of the alert
- inb_alp(ialert_id) = 0
- DO jl = 1, jpl
- DO jk = 1, nlay_i
- DO jj = 1, jpj
- DO ji = 1, jpi
- ztmelts = -tmut * s_i(ji,jj,jk,jl) + rtt
- IF( t_i(ji,jj,jk,jl) >= ztmelts .AND. v_i(ji,jj,jl) > 1.e-10 &
- & .AND. a_i(ji,jj,jl) > 0._wp ) THEN
- !WRITE(numout,*) ' ALERTE 10 : Very warm ice'
- !WRITE(numout,*) ' ji, jj, jk, jl : ', ji, jj, jk, jl
- !WRITE(numout,*) ' t_i : ', t_i(ji,jj,jk,jl)
- !WRITE(numout,*) ' e_i : ', e_i(ji,jj,jk,jl)
- !WRITE(numout,*) ' s_i : ', s_i(ji,jj,jk,jl)
- !WRITE(numout,*) ' ztmelts : ', ztmelts
- inb_alp(ialert_id) = inb_alp(ialert_id) + 1
- ENDIF
- END DO
- END DO
- END DO
- END DO
-
- ! sum of the alerts on all processors
- IF( lk_mpp ) THEN
- DO ialert_id = 1, inb_altests
- CALL mpp_sum(inb_alp(ialert_id))
- END DO
- ENDIF
-
- ! print alerts
- IF( lwp ) THEN
- ialert_id = 1 ! reference number of this alert
- cl_alname(ialert_id) = ' NO alerte 1 ' ! name of the alert
- WRITE(numout,*) ' time step ',kt
- WRITE(numout,*) ' All alerts at the end of ice model '
- DO ialert_id = 1, inb_altests
- WRITE(numout,*) ialert_id, cl_alname(ialert_id)//' : ', inb_alp(ialert_id), ' times ! '
- END DO
- ENDIF
- !
- END SUBROUTINE lim_ctl
-
-
- SUBROUTINE lim_prt_state( kt, ki, kj, kn, cd1 )
- !!-----------------------------------------------------------------------
- !! *** ROUTINE lim_prt_state ***
- !!
- !! ** Purpose : Writes global ice state on the (i,j) point
- !! in ocean.ouput
- !! 3 possibilities exist
- !! n = 1/-1 -> simple ice state (plus Mechanical Check if -1)
- !! n = 2 -> exhaustive state
- !! n = 3 -> ice/ocean salt fluxes
- !!
- !! ** input : point coordinates (i,j)
- !! n : number of the option
- !!-------------------------------------------------------------------
- INTEGER , INTENT(in) :: kt ! ocean time step
- INTEGER , INTENT(in) :: ki, kj, kn ! ocean gridpoint indices
- CHARACTER(len=*), INTENT(in) :: cd1 !
- !!
- INTEGER :: jl, ji, jj
- !!-------------------------------------------------------------------
-
- DO ji = mi0(ki), mi1(ki)
- DO jj = mj0(kj), mj1(kj)
-
- WRITE(numout,*) ' time step ',kt,' ',cd1 ! print title
-
- !----------------
- ! Simple state
- !----------------
-
- IF ( kn == 1 .OR. kn == -1 ) THEN
- WRITE(numout,*) ' lim_prt_state - Point : ',ji,jj
- WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
- WRITE(numout,*) ' Simple state '
- WRITE(numout,*) ' masks s,u,v : ', tms(ji,jj), tmu(ji,jj), tmv(ji,jj)
- WRITE(numout,*) ' lat - long : ', gphit(ji,jj), glamt(ji,jj)
- WRITE(numout,*) ' Time step : ', numit
- WRITE(numout,*) ' - Ice drift '
- WRITE(numout,*) ' ~~~~~~~~~~~ '
- WRITE(numout,*) ' u_ice(i-1,j) : ', u_ice(ji-1,jj)
- WRITE(numout,*) ' u_ice(i ,j) : ', u_ice(ji,jj)
- WRITE(numout,*) ' v_ice(i ,j-1): ', v_ice(ji,jj-1)
- WRITE(numout,*) ' v_ice(i ,j) : ', v_ice(ji,jj)
- WRITE(numout,*) ' strength : ', strength(ji,jj)
- WRITE(numout,*)
- WRITE(numout,*) ' - Cell values '
- WRITE(numout,*) ' ~~~~~~~~~~~ '
- WRITE(numout,*) ' cell area : ', area(ji,jj)
- WRITE(numout,*) ' at_i : ', at_i(ji,jj)
- WRITE(numout,*) ' vt_i : ', vt_i(ji,jj)
- WRITE(numout,*) ' vt_s : ', vt_s(ji,jj)
- DO jl = 1, jpl
- WRITE(numout,*) ' - Category (', jl,')'
- WRITE(numout,*) ' a_i : ', a_i(ji,jj,jl)
- WRITE(numout,*) ' ht_i : ', ht_i(ji,jj,jl)
- WRITE(numout,*) ' ht_s : ', ht_s(ji,jj,jl)
- WRITE(numout,*) ' v_i : ', v_i(ji,jj,jl)
- WRITE(numout,*) ' v_s : ', v_s(ji,jj,jl)
- WRITE(numout,*) ' e_s : ', e_s(ji,jj,1,jl)/1.0e9
- WRITE(numout,*) ' e_i : ', e_i(ji,jj,1:nlay_i,jl)/1.0e9
- WRITE(numout,*) ' t_su : ', t_su(ji,jj,jl)
- WRITE(numout,*) ' t_snow : ', t_s(ji,jj,1,jl)
- WRITE(numout,*) ' t_i : ', t_i(ji,jj,1:nlay_i,jl)
- WRITE(numout,*) ' sm_i : ', sm_i(ji,jj,jl)
- WRITE(numout,*) ' smv_i : ', smv_i(ji,jj,jl)
- WRITE(numout,*)
- END DO
- ENDIF
- IF( kn == -1 ) THEN
- WRITE(numout,*) ' Mechanical Check ************** '
- WRITE(numout,*) ' Check what means ice divergence '
- WRITE(numout,*) ' Total ice concentration ', at_i (ji,jj)
- WRITE(numout,*) ' Total lead fraction ', ato_i(ji,jj)
- WRITE(numout,*) ' Sum of both ', ato_i(ji,jj) + at_i(ji,jj)
- WRITE(numout,*) ' Sum of both minus 1 ', ato_i(ji,jj) + at_i(ji,jj) - 1.00
- ENDIF
-
-
- !--------------------
- ! Exhaustive state
- !--------------------
-
- IF ( kn .EQ. 2 ) THEN
- WRITE(numout,*) ' lim_prt_state - Point : ',ji,jj
- WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
- WRITE(numout,*) ' Exhaustive state '
- WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj)
- WRITE(numout,*) ' Time step ', numit
- WRITE(numout,*)
- WRITE(numout,*) ' - Cell values '
- WRITE(numout,*) ' ~~~~~~~~~~~ '
- WRITE(numout,*) ' cell area : ', area(ji,jj)
- WRITE(numout,*) ' at_i : ', at_i(ji,jj)
- WRITE(numout,*) ' vt_i : ', vt_i(ji,jj)
- WRITE(numout,*) ' vt_s : ', vt_s(ji,jj)
- WRITE(numout,*) ' u_ice(i-1,j) : ', u_ice(ji-1,jj)
- WRITE(numout,*) ' u_ice(i ,j) : ', u_ice(ji,jj)
- WRITE(numout,*) ' v_ice(i ,j-1): ', v_ice(ji,jj-1)
- WRITE(numout,*) ' v_ice(i ,j) : ', v_ice(ji,jj)
- WRITE(numout,*) ' strength : ', strength(ji,jj)
- WRITE(numout,*) ' d_u_ice_dyn : ', d_u_ice_dyn(ji,jj), ' d_v_ice_dyn : ', d_v_ice_dyn(ji,jj)
- WRITE(numout,*) ' u_ice_b : ', u_ice_b(ji,jj) , ' v_ice_b : ', v_ice_b(ji,jj)
- WRITE(numout,*)
-
- DO jl = 1, jpl
- WRITE(numout,*) ' - Category (',jl,')'
- WRITE(numout,*) ' ~~~~~~~~ '
- WRITE(numout,*) ' ht_i : ', ht_i(ji,jj,jl) , ' ht_s : ', ht_s(ji,jj,jl)
- WRITE(numout,*) ' t_i : ', t_i(ji,jj,1:nlay_i,jl)
- WRITE(numout,*) ' t_su : ', t_su(ji,jj,jl) , ' t_s : ', t_s(ji,jj,1,jl)
- WRITE(numout,*) ' sm_i : ', sm_i(ji,jj,jl) , ' o_i : ', o_i(ji,jj,jl)
- WRITE(numout,*) ' a_i : ', a_i(ji,jj,jl) , ' a_i_b : ', a_i_b(ji,jj,jl)
- WRITE(numout,*) ' d_a_i_trp : ', d_a_i_trp(ji,jj,jl) , ' d_a_i_thd : ', d_a_i_thd(ji,jj,jl)
- WRITE(numout,*) ' v_i : ', v_i(ji,jj,jl) , ' v_i_b : ', v_i_b(ji,jj,jl)
- WRITE(numout,*) ' d_v_i_trp : ', d_v_i_trp(ji,jj,jl) , ' d_v_i_thd : ', d_v_i_thd(ji,jj,jl)
- WRITE(numout,*) ' v_s : ', v_s(ji,jj,jl) , ' v_s_b : ', v_s_b(ji,jj,jl)
- WRITE(numout,*) ' d_v_s_trp : ', d_v_s_trp(ji,jj,jl) , ' d_v_s_thd : ', d_v_s_thd(ji,jj,jl)
- WRITE(numout,*) ' e_i1 : ', e_i(ji,jj,1,jl)/1.0e9 , ' ei1 : ', e_i_b(ji,jj,1,jl)/1.0e9
- WRITE(numout,*) ' de_i1_trp : ', d_e_i_trp(ji,jj,1,jl)/1.0e9, ' de_i1_thd : ', d_e_i_thd(ji,jj,1,jl)/1.0e9
- WRITE(numout,*) ' e_i2 : ', e_i(ji,jj,2,jl)/1.0e9 , ' ei2_b : ', e_i_b(ji,jj,2,jl)/1.0e9
- WRITE(numout,*) ' de_i2_trp : ', d_e_i_trp(ji,jj,2,jl)/1.0e9, ' de_i2_thd : ', d_e_i_thd(ji,jj,2,jl)/1.0e9
- WRITE(numout,*) ' e_snow : ', e_s(ji,jj,1,jl) , ' e_snow_b : ', e_s_b(ji,jj,1,jl)
- WRITE(numout,*) ' d_e_s_trp : ', d_e_s_trp(ji,jj,1,jl) , ' d_e_s_thd : ', d_e_s_thd(ji,jj,1,jl)
- WRITE(numout,*) ' smv_i : ', smv_i(ji,jj,jl) , ' smv_i_b : ', smv_i_b(ji,jj,jl)
- WRITE(numout,*) ' d_smv_i_trp: ', d_smv_i_trp(ji,jj,jl) , ' d_smv_i_thd: ', d_smv_i_thd(ji,jj,jl)
- WRITE(numout,*) ' oa_i : ', oa_i(ji,jj,jl) , ' oa_i_b : ', oa_i_b(ji,jj,jl)
- WRITE(numout,*) ' d_oa_i_trp : ', d_oa_i_trp(ji,jj,jl) , ' d_oa_i_thd : ', d_oa_i_thd(ji,jj,jl)
- END DO !jl
-
- WRITE(numout,*)
- WRITE(numout,*) ' - Heat / FW fluxes '
- WRITE(numout,*) ' ~~~~~~~~~~~~~~~~ '
- WRITE(numout,*) ' - Heat fluxes in and out the ice ***'
- WRITE(numout,*) ' qsr_ini : ', pfrld(ji,jj) * qsr(ji,jj) + SUM( a_i_b(ji,jj,:) * qsr_ice(ji,jj,:) )
- WRITE(numout,*) ' qns_ini : ', pfrld(ji,jj) * qns(ji,jj) + SUM( a_i_b(ji,jj,:) * qns_ice(ji,jj,:) )
- WRITE(numout,*)
- WRITE(numout,*)
- WRITE(numout,*) ' sst : ', sst_m(ji,jj)
- WRITE(numout,*) ' sss : ', sss_m(ji,jj)
- WRITE(numout,*)
- WRITE(numout,*) ' - Stresses '
- WRITE(numout,*) ' ~~~~~~~~ '
- WRITE(numout,*) ' utau_ice : ', utau_ice(ji,jj)
- WRITE(numout,*) ' vtau_ice : ', vtau_ice(ji,jj)
- WRITE(numout,*) ' utau : ', utau (ji,jj)
- WRITE(numout,*) ' vtau : ', vtau (ji,jj)
- WRITE(numout,*) ' oc. vel. u : ', u_oce (ji,jj)
- WRITE(numout,*) ' oc. vel. v : ', v_oce (ji,jj)
- ENDIF
-
- !---------------------
- ! Salt / heat fluxes
- !---------------------
-
- IF ( kn .EQ. 3 ) THEN
- WRITE(numout,*) ' lim_prt_state - Point : ',ji,jj
- WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
- WRITE(numout,*) ' - Salt / Heat Fluxes '
- WRITE(numout,*) ' ~~~~~~~~~~~~~~~~ '
- WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj)
- WRITE(numout,*) ' Time step ', numit
- WRITE(numout,*)
- WRITE(numout,*) ' - Heat fluxes at bottom interface ***'
- WRITE(numout,*) ' qsr : ', qsr(ji,jj)
- WRITE(numout,*) ' qns : ', qns(ji,jj)
- WRITE(numout,*)
- WRITE(numout,*) ' hfx_mass : ', hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_snw(ji,jj) + hfx_res(ji,jj)
- WRITE(numout,*) ' hfx_in : ', hfx_in(ji,jj)
- WRITE(numout,*) ' hfx_out : ', hfx_out(ji,jj)
- WRITE(numout,*) ' dhc : ', diag_heat_dhc(ji,jj)
- WRITE(numout,*)
- WRITE(numout,*) ' hfx_dyn : ', hfx_dyn(ji,jj)
- WRITE(numout,*) ' hfx_thd : ', hfx_thd(ji,jj)
- WRITE(numout,*) ' hfx_res : ', hfx_res(ji,jj)
- WRITE(numout,*) ' fhtur : ', fhtur(ji,jj)
- WRITE(numout,*) ' qlead : ', qlead(ji,jj) * r1_rdtice
- WRITE(numout,*)
- WRITE(numout,*) ' - Salt fluxes at bottom interface ***'
- WRITE(numout,*) ' emp : ', emp (ji,jj)
- WRITE(numout,*) ' sfx : ', sfx (ji,jj)
- WRITE(numout,*) ' sfx_res : ', sfx_res(ji,jj)
- WRITE(numout,*) ' sfx_bri : ', sfx_bri(ji,jj)
- WRITE(numout,*) ' sfx_dyn : ', sfx_dyn(ji,jj)
- WRITE(numout,*)
- WRITE(numout,*) ' - Momentum fluxes '
- WRITE(numout,*) ' utau : ', utau(ji,jj)
- WRITE(numout,*) ' vtau : ', vtau(ji,jj)
- ENDIF
- WRITE(numout,*) ' '
- !
- END DO
- END DO
- !
- END SUBROUTINE lim_prt_state
-
+
+ SUBROUTINE sbc_lim_bef
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE sbc_lim_bef ***
+ !!
+ !! ** purpose : store ice variables at "before" time step
+ !!----------------------------------------------------------------------
+ a_i_b (:,:,:) = a_i (:,:,:) ! ice area
+ e_i_b (:,:,:,:) = e_i (:,:,:,:) ! ice thermal energy
+ v_i_b (:,:,:) = v_i (:,:,:) ! ice volume
+ v_s_b (:,:,:) = v_s (:,:,:) ! snow volume
+ e_s_b (:,:,:,:) = e_s (:,:,:,:) ! snow thermal energy
+ smv_i_b(:,:,:) = smv_i(:,:,:) ! salt content
+ oa_i_b (:,:,:) = oa_i (:,:,:) ! areal age content
+ u_ice_b(:,:) = u_ice(:,:)
+ v_ice_b(:,:) = v_ice(:,:)
+
+ END SUBROUTINE sbc_lim_bef
+
+ SUBROUTINE sbc_lim_diag0
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE sbc_lim_diag0 ***
+ !!
+ !! ** purpose : set ice-ocean and ice-atm. fluxes to zeros at the beggining
+ !! of the time step
+ !!----------------------------------------------------------------------
+ sfx (:,:) = 0._wp ;
+ sfx_bri(:,:) = 0._wp ;
+ sfx_sni(:,:) = 0._wp ; sfx_opw(:,:) = 0._wp
+ sfx_bog(:,:) = 0._wp ; sfx_dyn(:,:) = 0._wp
+ sfx_bom(:,:) = 0._wp ; sfx_sum(:,:) = 0._wp
+ sfx_res(:,:) = 0._wp
+
+ wfx_snw(:,:) = 0._wp ; wfx_ice(:,:) = 0._wp
+ wfx_sni(:,:) = 0._wp ; wfx_opw(:,:) = 0._wp
+ wfx_bog(:,:) = 0._wp ; wfx_dyn(:,:) = 0._wp
+ wfx_bom(:,:) = 0._wp ; wfx_sum(:,:) = 0._wp
+ wfx_res(:,:) = 0._wp ; wfx_sub(:,:) = 0._wp
+ wfx_spr(:,:) = 0._wp ;
+
+ hfx_thd(:,:) = 0._wp ;
+ hfx_snw(:,:) = 0._wp ; hfx_opw(:,:) = 0._wp
+ hfx_bog(:,:) = 0._wp ; hfx_dyn(:,:) = 0._wp
+ hfx_bom(:,:) = 0._wp ; hfx_sum(:,:) = 0._wp
+ hfx_res(:,:) = 0._wp ; hfx_sub(:,:) = 0._wp
+ hfx_spr(:,:) = 0._wp ; hfx_dif(:,:) = 0._wp
+ hfx_err(:,:) = 0._wp ; hfx_err_rem(:,:) = 0._wp
+ hfx_err_dif(:,:) = 0._wp ;
+
+ afx_tot(:,:) = 0._wp ;
+ afx_dyn(:,:) = 0._wp ; afx_thd(:,:) = 0._wp
+
+ diag_heat(:,:) = 0._wp ; diag_smvi(:,:) = 0._wp ;
+ diag_vice(:,:) = 0._wp ; diag_vsnw(:,:) = 0._wp ;
+
+ END SUBROUTINE sbc_lim_diag0
+
FUNCTION fice_cell_ave ( ptab )
@@ -852,8 +614,6 @@
fice_cell_ave (:,:) = 0.0_wp
-
DO jl = 1, jpl
- fice_cell_ave (:,:) = fice_cell_ave (:,:) &
- & + a_i (:,:,jl) * ptab (:,:,jl)
+ fice_cell_ave (:,:) = fice_cell_ave (:,:) + a_i (:,:,jl) * ptab (:,:,jl)
END DO
@@ -869,5 +629,5 @@
fice_ice_ave (:,:) = 0.0_wp
- WHERE ( at_i (:,:) .GT. 0.0_wp ) fice_ice_ave (:,:) = fice_cell_ave ( ptab (:,:,:)) / at_i (:,:)
+ WHERE ( at_i (:,:) > 0.0_wp ) fice_ice_ave (:,:) = fice_cell_ave ( ptab (:,:,:)) / at_i (:,:)
END FUNCTION fice_ice_ave
@@ -882,4 +642,6 @@
WRITE(*,*) 'sbc_ice_lim: You should not have seen this print! error?', kt, kblk
END SUBROUTINE sbc_ice_lim
+ SUBROUTINE sbc_lim_init ! Dummy routine
+ END SUBROUTINE sbc_lim_init
#endif
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90 (revision 5602)
@@ -101,7 +101,6 @@
REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice ! mean ice albedo
REAL(wp), DIMENSION(:,:,:), POINTER :: zsist ! ice surface temperature (K)
+ REAL(wp), DIMENSION(:,: ), POINTER :: zutau_ice, zvtau_ice
!!----------------------------------------------------------------------
-
- CALL wrk_alloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist )
IF( kt == nit000 ) THEN
@@ -124,4 +123,8 @@
&*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc)) + 1
# endif
+
+ CALL wrk_alloc( jpi,jpj , zutau_ice, zvtau_ice)
+ CALL wrk_alloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist )
+
! Bulk Formulea !
!----------------!
@@ -132,7 +135,7 @@
DO ji = 2, jpi ! NO vector opt. possible
u_oce(ji,jj) = 0.5_wp * ( ssu_m(ji-1,jj ) * umask(ji-1,jj ,1) &
- & + ssu_m(ji-1,jj-1) * umask(ji-1,jj-1,1) ) * tmu(ji,jj)
+ & + ssu_m(ji-1,jj-1) * umask(ji-1,jj-1,1) ) * tmu(ji,jj)
v_oce(ji,jj) = 0.5_wp * ( ssv_m(ji ,jj-1) * vmask(ji ,jj-1,1) &
- & + ssv_m(ji-1,jj-1) * vmask(ji-1,jj-1,1) ) * tmu(ji,jj)
+ & + ssv_m(ji-1,jj-1) * vmask(ji-1,jj-1,1) ) * tmu(ji,jj)
END DO
END DO
@@ -158,5 +161,5 @@
SELECT CASE( ksbc )
- CASE( jp_core , jp_cpl ) ! CORE and COUPLED bulk formulations
+ CASE( jp_core , jp_purecpl ) ! CORE and COUPLED bulk formulations
! albedo depends on cloud fraction because of non-linear spectral effects
@@ -182,21 +185,25 @@
SELECT CASE( ksbc )
CASE( jp_clio ) ! CLIO bulk formulation
- CALL blk_ice_clio( zsist, zalb_cs , zalb_os , zalb_ice , &
- & utau_ice , vtau_ice , qns_ice , qsr_ice, &
- & qla_ice , dqns_ice , dqla_ice , &
- & tprecip , sprecip , &
- & fr1_i0 , fr2_i0 , cp_ice_msh , jpl )
+! CALL blk_ice_clio( zsist, zalb_cs , zalb_os , zalb_ice , &
+! & utau_ice , vtau_ice , qns_ice , qsr_ice, &
+! & qla_ice , dqns_ice , dqla_ice , &
+! & tprecip , sprecip , &
+! & fr1_i0 , fr2_i0 , cp_ice_msh , jpl )
+ CALL blk_ice_clio_tau
+ CALL blk_ice_clio_flx( zsist, zalb_cs, zalb_os, zalb_ice )
CASE( jp_core ) ! CORE bulk formulation
- CALL blk_ice_core( zsist, u_ice , v_ice , zalb_ice , &
- & utau_ice , vtau_ice , qns_ice , qsr_ice, &
- & qla_ice , dqns_ice , dqla_ice , &
- & tprecip , sprecip , &
- & fr1_i0 , fr2_i0 , cp_ice_msh , jpl )
- IF( ltrcdm2dc_ice ) CALL blk_ice_meanqsr( zalb_ice, qsr_ice_mean, jpl )
-
- CASE( jp_cpl ) ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics)
+ CALL blk_ice_core_tau
+ CALL blk_ice_core_flx( zsist, zalb_ice )
+
+ CASE( jp_purecpl ) ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics)
CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )
END SELECT
+
+ IF( ln_mixcpl) THEN
+ CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice )
+ utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) )
+ vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) )
+ ENDIF
CALL iom_put( 'utau_ice', utau_ice ) ! Wind stress over ice along i-axis at I-point
@@ -228,16 +235,13 @@
END IF
! ! Ice surface fluxes in coupled mode
- IF( ksbc == jp_cpl ) THEN
+ IF( ln_cpl ) THEN ! pure coupled and mixed forced-coupled configurations
a_i(:,:,1)=fr_i
CALL sbc_cpl_ice_flx( frld, &
! optional arguments, used only in 'mixed oce-ice' case
- & palbi = zalb_ice, psst = sst_m, pist = zsist )
+ & palbi=zalb_ice, psst=sst_m, pist=zsist )
sprecip(:,:) = - emp_ice(:,:) ! Ugly patch, WARNING, in coupled mode, sublimation included in snow (parsub = 0.)
ENDIF
CALL lim_thd_2 ( kt ) ! Ice thermodynamics
CALL lim_sbc_flx_2 ( kt ) ! update surface ocean mass, heat & salt fluxes
-#if defined key_top
- IF( ltrcdm2dc_ice )CALL lim_bio_meanqsr_2
-#endif
IF( .NOT. lk_mpp )THEN
@@ -253,4 +257,7 @@
IF( .NOT. Agrif_Root() ) CALL agrif_update_lim2( kt )
# endif
+ !
+ CALL wrk_dealloc( jpi,jpj , zutau_ice, zvtau_ice)
+ CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist )
!
ENDIF ! End sea-ice time step only
@@ -264,6 +271,4 @@
IF( ln_limdyn ) CALL lim_sbc_tau_2( kt, ub(:,:,1), vb(:,:,1) ) ! using before instantaneous surf. currents
!
- CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist )
- !
END SUBROUTINE sbc_ice_lim_2
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90 (revision 5602)
@@ -7,5 +7,5 @@
!! 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
+ !! 3.4 ! 2013-03 (P. Mathiot) Merging + parametrization
!!----------------------------------------------------------------------
@@ -37,6 +37,5 @@
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: risf_tsc_b, risf_tsc
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fwfisf_b, fwfisf !: evaporation damping [kg/m2/s]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qisf !: net heat flux from ice shelf
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qisf !: net heat flux from ice shelf
REAL(wp), PUBLIC :: rn_hisf_tbl !: thickness of top boundary layer [m]
LOGICAL , PUBLIC :: ln_divisf !: flag to correct divergence
@@ -81,5 +80,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.0 , LOCEAN-IPSL (2008)
- !! $Id: sbcice_if.F90 1730 2009-11-16 14:34:19Z smasson $
+ !! $Id$
!! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
@@ -309,10 +308,9 @@
sbc_isf_alloc = 0 ! set to zero if no array to be allocated
IF( .NOT. ALLOCATED( qisf ) ) THEN
- ALLOCATE( risf_tsc(jpi,jpj,jpts), risf_tsc_b(jpi,jpj,jpts) , &
- & qisf(jpi,jpj) , fwfisf(jpi,jpj) , fwfisf_b(jpi,jpj) , &
- & rhisf_tbl(jpi,jpj), r1_hisf_tbl(jpi,jpj), rzisf_tbl(jpi,jpj) , &
- & ttbl(jpi,jpj) , stbl(jpi,jpj) , utbl(jpi,jpj) , &
- & vtbl(jpi, jpj) , risfLeff(jpi,jpj) , rhisf_tbl_0(jpi,jpj), &
- & ralpha(jpi,jpj) , misfkt(jpi,jpj) , misfkb(jpi,jpj) , &
+ ALLOCATE( risf_tsc(jpi,jpj,jpts), risf_tsc_b(jpi,jpj,jpts), qisf(jpi,jpj) , &
+ & rhisf_tbl(jpi,jpj) , r1_hisf_tbl(jpi,jpj), rzisf_tbl(jpi,jpj) , &
+ & ttbl(jpi,jpj) , stbl(jpi,jpj) , utbl(jpi,jpj) , &
+ & vtbl(jpi, jpj) , risfLeff(jpi,jpj) , rhisf_tbl_0(jpi,jpj), &
+ & ralpha(jpi,jpj) , misfkt(jpi,jpj) , misfkb(jpi,jpj) , &
& STAT= sbc_isf_alloc )
!
@@ -563,6 +561,5 @@
CALL iom_put('isfgammat', zgammat2d)
CALL iom_put('isfgammas', zgammas2d)
- !
- !CALL wrk_dealloc( jpi,jpj, zfrz,zpress,zti, zqisf, zfwfisf )
+ !
CALL wrk_dealloc( jpi,jpj, zfrz,zpress,zti, zgammat2d, zgammas2d )
!
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90 (revision 5602)
@@ -13,4 +13,5 @@
!! 3.4 ! 2011-11 (C. Harris) CICE added as an option
!! 3.5 ! 2012-11 (A. Coward, G. Madec) Rethink of heat, mass and salt surface fluxes
+ !! 3.6 ! 2014-11 (P. Mathiot, C. Harris) add ice shelves melting
!!----------------------------------------------------------------------
@@ -23,4 +24,5 @@
USE phycst ! physical constants
USE sbc_oce ! Surface boundary condition: ocean fields
+ USE trc_oce ! shared ocean-passive tracers variables
USE sbc_ice ! Surface boundary condition: ice fields
USE sbcdcy ! surface boundary condition: diurnal cycle
@@ -37,4 +39,5 @@
USE sbcice_cice ! surface boundary condition: CICE sea-ice model
USE sbccpl ! surface boundary condition: coupled florulation
+ USE cpl_oasis3 ! OASIS routines for coupling
USE sbcssr ! surface boundary condition: sea surface restoring
USE sbcrnf ! surface boundary condition: runoffs
@@ -50,4 +53,5 @@
USE timing ! Timing
USE sbcwave ! Wave module
+ USE bdy_par ! Require lk_bdy
IMPLICIT NONE
@@ -82,8 +86,11 @@
INTEGER :: icpt ! local integer
!!
- NAMELIST/namsbc/ nn_fsbc , ln_ana , ln_flx, ln_blk_clio, ln_blk_core, &
- & ln_blk_mfs, ln_apr_dyn, nn_ice, nn_ice_embd, ln_dm2dc , ln_rnf, &
- & ln_ssr , nn_isf , nn_fwb , ln_cdgw , ln_wave , ln_sdw, nn_lsm, nn_limflx
+ NAMELIST/namsbc/ nn_fsbc , ln_ana , ln_flx, ln_blk_clio, ln_blk_core, ln_mixcpl, &
+ & ln_blk_mfs, ln_apr_dyn, nn_ice, nn_ice_embd, ln_dm2dc , ln_rnf , &
+ & ln_ssr , nn_isf , nn_fwb, ln_cdgw , ln_wave , ln_sdw , &
+ & nn_lsm , nn_limflx , nn_components, ln_cpl
INTEGER :: ios
+ INTEGER :: ierr, ierr0, ierr1, ierr2, ierr3, jpm
+ LOGICAL :: ll_purecpl
!!----------------------------------------------------------------------
@@ -113,5 +120,5 @@
nn_ice = 0
ENDIF
-
+
IF(lwp) THEN ! Control print
WRITE(numout,*) ' Namelist namsbc (partly overwritten with CPP key setting)'
@@ -123,5 +130,8 @@
WRITE(numout,*) ' CORE bulk formulation ln_blk_core = ', ln_blk_core
WRITE(numout,*) ' MFS bulk formulation ln_blk_mfs = ', ln_blk_mfs
- WRITE(numout,*) ' coupled formulation (T if key_oasis3) lk_cpl = ', lk_cpl
+ WRITE(numout,*) ' ocean-atmosphere coupled formulation ln_cpl = ', ln_cpl
+ WRITE(numout,*) ' forced-coupled mixed formulation ln_mixcpl = ', ln_mixcpl
+ WRITE(numout,*) ' OASIS coupling (with atm or sas) lk_oasis = ', lk_oasis
+ WRITE(numout,*) ' components of your executable nn_components = ', nn_components
WRITE(numout,*) ' Multicategory heat flux formulation (LIM3) nn_limflx = ', nn_limflx
WRITE(numout,*) ' Misc. options of sbc : '
@@ -150,35 +160,29 @@
END SELECT
!
-#if defined key_top && ! defined key_offline
- ltrcdm2dc = (ln_dm2dc .AND. ln_blk_core .AND. nn_ice==2)
- IF( ltrcdm2dc )THEN
- IF(lwp)THEN
- WRITE(numout,*)"analytical diurnal cycle, core bulk formulation and LIM2 use: "
- WRITE(numout,*)"Diurnal cycle on physics but not in passive tracers"
- ENDIF
- ENDIF
-#else
- ltrcdm2dc = .FALSE.
-#endif
-
- !
+ IF ( nn_components /= jp_iam_nemo .AND. .NOT. lk_oasis ) &
+ & CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but key_oasis3 disabled' )
+ IF ( nn_components == jp_iam_opa .AND. ln_cpl ) &
+ & CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but ln_cpl = T in OPA' )
+ IF ( nn_components == jp_iam_opa .AND. ln_mixcpl ) &
+ & CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but ln_mixcpl = T in OPA' )
+ IF ( ln_cpl .AND. .NOT. lk_oasis ) &
+ & CALL ctl_stop( 'STOP', 'sbc_init : OASIS-coupled atmosphere model, but key_oasis3 disabled' )
+ IF( ln_mixcpl .AND. .NOT. lk_oasis ) &
+ & CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) requires the cpp key key_oasis3' )
+ IF( ln_mixcpl .AND. .NOT. ln_cpl ) &
+ & CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) requires ln_cpl = T' )
+ IF( ln_mixcpl .AND. nn_components /= jp_iam_nemo ) &
+ & CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) is not yet working with sas-opa coupling via oasis' )
+
! ! allocate sbc arrays
IF( sbc_oce_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_oce arrays' )
! ! Checks:
- IF( .NOT. ln_rnf ) THEN ! no specific treatment in vicinity of river mouths
- ln_rnf_mouth = .false.
- IF( sbc_rnf_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_rnf arrays' )
- nkrnf = 0
- rnf (:,:) = 0.0_wp
- rnf_b (:,:) = 0.0_wp
- rnfmsk (:,:) = 0.0_wp
- rnfmsk_z(:) = 0.0_wp
- ENDIF
IF( nn_isf .EQ. 0 ) THEN ! no specific treatment in vicinity of ice shelf
IF( sbc_isf_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_isf arrays' )
fwfisf (:,:) = 0.0_wp
+ fwfisf_b(:,:) = 0.0_wp
END IF
- IF( nn_ice == 0 ) fr_i(:,:) = 0.e0 ! no ice in the domain, ice fraction is always zero
+ IF( nn_ice == 0 .AND. nn_components /= jp_iam_opa ) fr_i(:,:) = 0.e0 ! no ice in the domain, ice fraction is always zero
sfx(:,:) = 0.0_wp ! the salt flux due to freezing/melting will be computed (i.e. will be non-zero)
@@ -190,18 +194,8 @@
! ! restartability
- IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 .OR. &
- MOD( nstock , nn_fsbc) /= 0 ) THEN
- WRITE(ctmp1,*) 'experiment length (', nitend - nit000 + 1, ') or nstock (', nstock, &
- & ' is NOT a multiple of nn_fsbc (', nn_fsbc, ')'
- CALL ctl_stop( ctmp1, 'Impossible to properly do model restart' )
- ENDIF
- !
- IF( MOD( rday, REAL(nn_fsbc, wp) * rdt ) /= 0 ) &
- & CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' )
- !
- IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. lk_cpl ) ) &
+ IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. ln_cpl ) ) &
& CALL ctl_stop( 'LIM sea-ice model requires a bulk formulation or coupled configuration' )
- IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. lk_cpl ) ) &
- & CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or lk_cpl' )
+ IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. ln_cpl ) ) &
+ & CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or ln_cpl' )
IF( nn_ice == 4 .AND. lk_agrif ) &
& CALL ctl_stop( 'CICE sea-ice model not currently available with AGRIF' )
@@ -210,17 +204,14 @@
IF( ( nn_ice /= 3 ) .AND. ( nn_limflx >= 0 ) ) &
& WRITE(numout,*) 'The nn_limflx>=0 option has no effect if sea ice model is not LIM3'
- IF( ( nn_ice == 3 ) .AND. ( lk_cpl ) .AND. ( ( nn_limflx == -1 ) .OR. ( nn_limflx == 1 ) ) ) &
+ IF( ( nn_ice == 3 ) .AND. ( ln_cpl ) .AND. ( ( nn_limflx == -1 ) .OR. ( nn_limflx == 1 ) ) ) &
& CALL ctl_stop( 'The chosen nn_limflx for LIM3 in coupled mode must be 0 or 2' )
- IF( ( nn_ice == 3 ) .AND. ( .NOT. lk_cpl ) .AND. ( nn_limflx == 2 ) ) &
+ IF( ( nn_ice == 3 ) .AND. ( .NOT. ln_cpl ) .AND. ( nn_limflx == 2 ) ) &
& CALL ctl_stop( 'The chosen nn_limflx for LIM3 in forced mode cannot be 2' )
IF( ln_dm2dc ) nday_qsr = -1 ! initialisation flag
- IF( ln_dm2dc .AND. .NOT.( ln_flx .OR. ln_blk_core ) ) &
+ IF( ln_dm2dc .AND. .NOT.( ln_flx .OR. ln_blk_core ) .AND. nn_components /= jp_iam_opa ) &
& CALL ctl_stop( 'diurnal cycle into qsr field from daily values requires a flux or core-bulk formulation' )
- IF( ln_dm2dc .AND. ( ( NINT(rday) / ( nn_fsbc * NINT(rdt) ) ) < 8 ) ) &
- & CALL ctl_warn( 'diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' )
-
IF ( ln_wave ) THEN
!Activated wave module but neither drag nor stokes drift activated
@@ -236,15 +227,18 @@
& asked coupling with drag coefficient (ln_cdgw =T) or Stokes drift (ln_sdw=T) ')
ENDIF
-
! ! Choice of the Surface Boudary Condition (set nsbc)
+ ll_purecpl = ln_cpl .AND. .NOT. ln_mixcpl
+ !
icpt = 0
- IF( ln_ana ) THEN ; nsbc = jp_ana ; icpt = icpt + 1 ; ENDIF ! analytical formulation
- IF( ln_flx ) THEN ; nsbc = jp_flx ; icpt = icpt + 1 ; ENDIF ! flux formulation
- IF( ln_blk_clio ) THEN ; nsbc = jp_clio ; icpt = icpt + 1 ; ENDIF ! CLIO bulk formulation
- IF( ln_blk_core ) THEN ; nsbc = jp_core ; icpt = icpt + 1 ; ENDIF ! CORE bulk formulation
- IF( ln_blk_mfs ) THEN ; nsbc = jp_mfs ; icpt = icpt + 1 ; ENDIF ! MFS bulk formulation
- IF( lk_cpl ) THEN ; nsbc = jp_cpl ; icpt = icpt + 1 ; ENDIF ! Coupled formulation
- IF( cp_cfg == 'gyre') THEN ; nsbc = jp_gyre ; ENDIF ! GYRE analytical formulation
- IF( lk_esopa ) nsbc = jp_esopa ! esopa test, ALL formulations
+ IF( ln_ana ) THEN ; nsbc = jp_ana ; icpt = icpt + 1 ; ENDIF ! analytical formulation
+ IF( ln_flx ) THEN ; nsbc = jp_flx ; icpt = icpt + 1 ; ENDIF ! flux formulation
+ IF( ln_blk_clio ) THEN ; nsbc = jp_clio ; icpt = icpt + 1 ; ENDIF ! CLIO bulk formulation
+ IF( ln_blk_core ) THEN ; nsbc = jp_core ; icpt = icpt + 1 ; ENDIF ! CORE bulk formulation
+ IF( ln_blk_mfs ) THEN ; nsbc = jp_mfs ; icpt = icpt + 1 ; ENDIF ! MFS bulk formulation
+ IF( ll_purecpl ) THEN ; nsbc = jp_purecpl ; icpt = icpt + 1 ; ENDIF ! Pure Coupled formulation
+ IF( cp_cfg == 'gyre') THEN ; nsbc = jp_gyre ; ENDIF ! GYRE analytical formulation
+ IF( nn_components == jp_iam_opa ) &
+ & THEN ; nsbc = jp_none ; icpt = icpt + 1 ; ENDIF ! opa coupling via SAS module
+ IF( lk_esopa ) nsbc = jp_esopa ! esopa test, ALL formulations
!
IF( icpt /= 1 .AND. .NOT.lk_esopa ) THEN
@@ -257,22 +251,58 @@
IF(lwp) THEN
WRITE(numout,*)
- IF( nsbc == jp_esopa ) WRITE(numout,*) ' ESOPA test All surface boundary conditions'
- IF( nsbc == jp_gyre ) WRITE(numout,*) ' GYRE analytical formulation'
- IF( nsbc == jp_ana ) WRITE(numout,*) ' analytical formulation'
- IF( nsbc == jp_flx ) WRITE(numout,*) ' flux formulation'
- IF( nsbc == jp_clio ) WRITE(numout,*) ' CLIO bulk formulation'
- IF( nsbc == jp_core ) WRITE(numout,*) ' CORE bulk formulation'
- IF( nsbc == jp_cpl ) WRITE(numout,*) ' coupled formulation'
- IF( nsbc == jp_mfs ) WRITE(numout,*) ' MFS Bulk formulation'
- ENDIF
- !
+ IF( nsbc == jp_esopa ) WRITE(numout,*) ' ESOPA test All surface boundary conditions'
+ IF( nsbc == jp_gyre ) WRITE(numout,*) ' GYRE analytical formulation'
+ IF( nsbc == jp_ana ) WRITE(numout,*) ' analytical formulation'
+ IF( nsbc == jp_flx ) WRITE(numout,*) ' flux formulation'
+ IF( nsbc == jp_clio ) WRITE(numout,*) ' CLIO bulk formulation'
+ IF( nsbc == jp_core ) WRITE(numout,*) ' CORE bulk formulation'
+ IF( nsbc == jp_purecpl ) WRITE(numout,*) ' pure coupled formulation'
+ IF( nsbc == jp_mfs ) WRITE(numout,*) ' MFS Bulk formulation'
+ IF( nsbc == jp_none ) WRITE(numout,*) ' OPA coupled to SAS via oasis'
+ IF( ln_mixcpl ) WRITE(numout,*) ' + forced-coupled mixed formulation'
+ IF( nn_components/= jp_iam_nemo ) &
+ & WRITE(numout,*) ' + OASIS coupled SAS'
+ ENDIF
+ !
+ IF( lk_oasis ) CALL sbc_cpl_init (nn_ice) ! OASIS initialisation. must be done before: (1) first time step
+ ! ! (2) the use of nn_fsbc
+
+! nn_fsbc initialization if OPA-SAS coupling via OASIS
+! sas model time step has to be declared in OASIS (mandatory) -> nn_fsbc has to be modified accordingly
+ IF ( nn_components /= jp_iam_nemo ) THEN
+
+ IF ( nn_components == jp_iam_opa ) nn_fsbc = cpl_freq('O_SFLX') / NINT(rdt)
+ IF ( nn_components == jp_iam_sas ) nn_fsbc = cpl_freq('I_SFLX') / NINT(rdt)
+ !
+ IF(lwp)THEN
+ WRITE(numout,*)
+ WRITE(numout,*)" OPA-SAS coupled via OASIS : nn_fsbc re-defined from OASIS namcouple ", nn_fsbc
+ WRITE(numout,*)
+ ENDIF
+ ENDIF
+
+ IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 .OR. &
+ MOD( nstock , nn_fsbc) /= 0 ) THEN
+ WRITE(ctmp1,*) 'experiment length (', nitend - nit000 + 1, ') or nstock (', nstock, &
+ & ' is NOT a multiple of nn_fsbc (', nn_fsbc, ')'
+ CALL ctl_stop( ctmp1, 'Impossible to properly do model restart' )
+ ENDIF
+ !
+ IF( MOD( rday, REAL(nn_fsbc, wp) * rdt ) /= 0 ) &
+ & CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' )
+ !
+ IF( ln_dm2dc .AND. ( ( NINT(rday) / ( nn_fsbc * NINT(rdt) ) ) < 8 ) ) &
+ & CALL ctl_warn( 'diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' )
+
CALL sbc_ssm_init ! Sea-surface mean fields initialisation
!
IF( ln_ssr ) CALL sbc_ssr_init ! Sea-Surface Restoring initialisation
!
+ CALL sbc_rnf_init ! Runof initialisation
+ !
+ IF( nn_ice == 3 ) CALL sbc_lim_init ! LIM3 initialisation
+
IF( nn_ice == 4 ) CALL cice_sbc_init( nsbc ) ! CICE initialisation
- !
- IF( nsbc == jp_cpl ) CALL sbc_cpl_init (nn_ice) ! OASIS initialisation. must be done before first time step
-
+
END SUBROUTINE sbc_init
@@ -314,9 +344,11 @@
! ! ---------------------------------------- !
!
- IF( ln_apr_dyn ) CALL sbc_apr( kt ) ! atmospheric pressure provided at kt+0.5*nn_fsbc
+ IF ( .NOT. lk_bdy ) then
+ IF( ln_apr_dyn ) CALL sbc_apr( kt ) ! atmospheric pressure provided at kt+0.5*nn_fsbc
+ ENDIF
! (caution called before sbc_ssm)
!
- CALL sbc_ssm( kt ) ! ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m)
- ! ! averaged over nf_sbc time-step
+ IF( nn_components /= jp_iam_sas ) CALL sbc_ssm( kt ) ! ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m)
+ ! ! averaged over nf_sbc time-step
IF (ln_wave) CALL sbc_wave( kt )
@@ -329,7 +361,15 @@
CASE( jp_flx ) ; CALL sbc_flx ( kt ) ! flux formulation
CASE( jp_clio ) ; CALL sbc_blk_clio( kt ) ! bulk formulation : CLIO for the ocean
- CASE( jp_core ) ; CALL sbc_blk_core( kt ) ! bulk formulation : CORE for the ocean
- CASE( jp_cpl ) ; CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! coupled formulation
+ CASE( jp_core )
+ IF( nn_components == jp_iam_sas ) &
+ & CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! OPA-SAS coupling: SAS receiving fields from OPA
+ CALL sbc_blk_core( kt ) ! bulk formulation : CORE for the ocean
+ ! from oce: sea surface variables (sst_m, sss_m, ssu_m, ssv_m)
+ CASE( jp_purecpl ) ; CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! pure coupled formulation
+ !
CASE( jp_mfs ) ; CALL sbc_blk_mfs ( kt ) ! bulk formulation : MFS for the ocean
+ CASE( jp_none )
+ IF( nn_components == jp_iam_opa ) &
+ CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! OPA-SAS coupling: OPA receiving fields from SAS
CASE( jp_esopa )
CALL sbc_ana ( kt ) ! ESOPA, test ALL the formulations
@@ -341,4 +381,7 @@
END SELECT
+ IF( ln_mixcpl ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! forced-coupled mixed formulation after forcing
+
+
! !== Misc. Options ==!
@@ -363,5 +406,6 @@
! ! (update freshwater fluxes)
!RBbug do not understand why see ticket 667
- !clem-bugsal CALL lbc_lnk( emp, 'T', 1. )
+!clem: it looks like it is necessary for the north fold (in certain circumstances). Don't know why.
+ CALL lbc_lnk( emp, 'T', 1. )
!
IF( kt == nit000 ) THEN ! set the forcing field at nit000 - 1 !
@@ -404,5 +448,5 @@
! CALL iom_rstput( kt, nitrst, numrow, 'qsr_b' , qsr )
CALL iom_rstput( kt, nitrst, numrow, 'emp_b' , emp )
- CALL iom_rstput( kt, nitrst, numrow, 'sfx_b' , sfx )
+ CALL iom_rstput( kt, nitrst, numrow, 'sfx_b' , sfx )
ENDIF
@@ -419,5 +463,5 @@
CALL iom_put( "qns" , qns ) ! solar heat flux
CALL iom_put( "qsr" , qsr ) ! solar heat flux
- IF( nn_ice > 0 ) CALL iom_put( "ice_cover", fr_i ) ! ice fraction
+ IF( nn_ice > 0 .OR. nn_components == jp_iam_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
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90 (revision 5602)
@@ -32,22 +32,27 @@
PUBLIC sbc_rnf ! routine call in sbcmod module
- PUBLIC sbc_rnf_div ! routine called in sshwzv module
+ PUBLIC sbc_rnf_div ! routine called in divcurl module
PUBLIC sbc_rnf_alloc ! routine call in sbcmod module
PUBLIC sbc_rnf_init ! (PUBLIC for TAM)
! !!* namsbc_rnf namelist *
- CHARACTER(len=100), PUBLIC :: cn_dir !: Root directory for location of ssr files
- LOGICAL , PUBLIC :: ln_rnf_depth !: depth river runoffs attribute specified in a file
- LOGICAL , PUBLIC :: ln_rnf_tem !: temperature river runoffs attribute specified in a file
+ CHARACTER(len=100) :: cn_dir !: Root directory for location of rnf files
+ LOGICAL :: ln_rnf_depth !: depth river runoffs attribute specified in a file
+ LOGICAL :: ln_rnf_depth_ini !: depth river runoffs computed at the initialisation
+ REAL(wp) :: rn_rnf_max !: maximum value of the runoff climatologie ( ln_rnf_depth_ini = .true )
+ REAL(wp) :: rn_dep_max !: depth over which runoffs is spread ( ln_rnf_depth_ini = .true )
+ INTEGER :: nn_rnf_depth_file !: create (=1) a runoff depth file or not (=0)
+ LOGICAL :: ln_rnf_tem !: temperature river runoffs attribute specified in a file
LOGICAL , PUBLIC :: ln_rnf_sal !: salinity river runoffs attribute specified in a file
- LOGICAL , PUBLIC :: ln_rnf_emp !: runoffs into a file to be read or already into precipitation
TYPE(FLD_N) , PUBLIC :: sn_rnf !: information about the runoff file to be read
- TYPE(FLD_N) , PUBLIC :: sn_cnf !: information about the runoff mouth file to be read
+ TYPE(FLD_N) :: sn_cnf !: information about the runoff mouth file to be read
TYPE(FLD_N) :: sn_s_rnf !: information about the salinities of runoff file to be read
TYPE(FLD_N) :: sn_t_rnf !: information about the temperatures of runoff file to be read
TYPE(FLD_N) :: sn_dep_rnf !: information about the depth which river inflow affects
LOGICAL , PUBLIC :: ln_rnf_mouth !: specific treatment in mouths vicinity
- REAL(wp) , PUBLIC :: rn_hrnf !: runoffs, depth over which enhanced vertical mixing is used
+ REAL(wp) :: rn_hrnf !: runoffs, depth over which enhanced vertical mixing is used
REAL(wp) , PUBLIC :: rn_avt_rnf !: runoffs, value of the additional vertical mixing coef. [m2/s]
- REAL(wp) , PUBLIC :: rn_rfact !: multiplicative factor for runoff
+ REAL(wp) :: rn_rfact !: multiplicative factor for runoff
+
+ LOGICAL , PUBLIC :: l_rnfcpl = .false. ! runoffs recieved from oasis
INTEGER , PUBLIC :: nkrnf = 0 !: nb of levels over which Kz is increased at river mouths
@@ -58,7 +63,7 @@
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rnf_tsc_b, rnf_tsc !: before and now T & S runoff contents [K.m/s & PSU.m/s]
- TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_rnf ! structure: river runoff (file information, fields read)
- TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_s_rnf ! structure: river runoff salinity (file information, fields read)
- TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_t_rnf ! structure: river runoff temperature (file information, fields read)
+ TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_rnf ! structure: river runoff (file information, fields read)
+ TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_s_rnf ! structure: river runoff salinity (file information, fields read)
+ TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_t_rnf ! structure: river runoff temperature (file information, fields read)
!! * Substitutions
@@ -105,7 +110,4 @@
CALL wrk_alloc( jpi,jpj, ztfrz)
- !
- IF( kt == nit000 ) CALL sbc_rnf_init ! Read namelist and allocate structures
-
! ! ---------------------------------------- !
IF( kt /= nit000 ) THEN ! Swap of forcing fields !
@@ -116,49 +118,44 @@
ENDIF
- ! !-------------------!
- IF( .NOT. ln_rnf_emp ) THEN ! Update runoff !
- ! !-------------------!
- !
- CALL fld_read ( kt, nn_fsbc, sf_rnf ) ! Read Runoffs data and provide it at kt
- 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
- !
- ! Runoff reduction only associated to the ORCA2_LIM configuration
- ! when reading the NetCDF file runoff_1m_nomask.nc
- IF( cp_cfg == 'orca' .AND. jp_cfg == 2 ) THEN
- WHERE( 40._wp < gphit(:,:) .AND. gphit(:,:) < 65._wp )
- sf_rnf(1)%fnow(:,:,1) = 0.85 * sf_rnf(1)%fnow(:,:,1)
+ ! !-------------------!
+ ! ! Update runoff !
+ ! !-------------------!
+ !
+ IF( .NOT. l_rnfcpl ) CALL fld_read ( kt, nn_fsbc, sf_rnf ) ! Read Runoffs data and provide it at kt
+ 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
+ !
+ ! Runoff reduction only associated to the ORCA2_LIM configuration
+ ! when reading the NetCDF file runoff_1m_nomask.nc
+ IF( cp_cfg == 'orca' .AND. jp_cfg == 2 .AND. .NOT. l_rnfcpl ) THEN
+ WHERE( 40._wp < gphit(:,:) .AND. gphit(:,:) < 65._wp )
+ sf_rnf(1)%fnow(:,:,1) = 0.85 * sf_rnf(1)%fnow(:,:,1)
+ END WHERE
+ ENDIF
+ !
+ IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN
+ !
+ IF( .NOT. l_rnfcpl ) rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) ) ! updated runoff value at time step kt
+ !
+ ! ! 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_rau0
+ 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_rau0
END WHERE
- ENDIF
- !
- IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN
- !
- rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) ) ! updated runoff value at time step kt
- !
- ! ! 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_rau0
- 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_rau0
- END WHERE
- WHERE( sf_t_rnf(1)%fnow(:,:,1) == -222._wp ) ! where fwf comes from melting of ice shelves or iceberg
- ztfrz(:,:) = -1.9 !tfreez( sss_m(:,:) ) !PM to be discuss (trouble if sensitivity study)
- rnf_tsc(:,:,jp_tem) = ztfrz(:,:) * rnf(:,:) * r1_rau0 - rnf(:,:) * lfusisf * r1_rau0_rcp
- END WHERE
- ELSE ! use SST as runoffs temperature
- rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0
- ENDIF
- ! ! use runoffs salinity data
- IF( ln_rnf_sal ) rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0
- ! ! else use S=0 for runoffs (done one for all in the init)
- IF ( ANY( rnf(:,:) < 0._wp ) ) z_err=1
- IF(lk_mpp) CALL mpp_sum(z_err)
- IF( z_err > 0 ) CALL ctl_stop( 'sbc_rnf : negative runnoff values exist' )
- !
- CALL iom_put( "runoffs", rnf ) ! output runoffs arrays
- ENDIF
- !
- ENDIF
- !
+ WHERE( sf_t_rnf(1)%fnow(:,:,1) == -222._wp ) ! where fwf comes from melting of ice shelves or iceberg
+ ztfrz(:,:) = -1.9 !tfreez( sss_m(:,:) ) !PM to be discuss (trouble if sensitivity study)
+ rnf_tsc(:,:,jp_tem) = ztfrz(:,:) * rnf(:,:) * r1_rau0 - rnf(:,:) * lfusisf * r1_rau0_rcp
+ END WHERE
+ ELSE ! use SST as runoffs temperature
+ rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0
+ ENDIF
+ ! ! use runoffs salinity data
+ IF( ln_rnf_sal ) rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0
+ ! ! else use S=0 for runoffs (done one for all in the init)
+ CALL iom_put( "runoffs", rnf ) ! output runoffs arrays
+ ENDIF
+ !
+ ! ! ---------------------------------------- !
IF( kt == nit000 ) THEN ! set the forcing field at nit000 - 1 !
! ! ---------------------------------------- !
@@ -171,6 +168,6 @@
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(:,:,:)
+ rnf_b (:,: ) = rnf (:,: )
+ rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:)
ENDIF
ENDIF
@@ -186,4 +183,5 @@
CALL iom_rstput( kt, nitrst, numrow, 'rnf_sc_b', rnf_tsc(:,:,jp_sal) )
ENDIF
+ !
CALL wrk_dealloc( jpi,jpj, ztfrz)
!
@@ -211,5 +209,5 @@
zfact = 0.5_wp
!
- IF( ln_rnf_depth ) THEN !== runoff distributed over several levels ==!
+ IF( ln_rnf_depth .OR. ln_rnf_depth_ini ) THEN !== runoff distributed over several levels ==!
IF( lk_vvl ) THEN ! variable volume case
DO jj = 1, jpj ! update the depth over which runoffs are distributed
@@ -255,12 +253,31 @@
!!----------------------------------------------------------------------
CHARACTER(len=32) :: rn_dep_file ! runoff file name
- INTEGER :: ji, jj, jk ! dummy loop indices
+ INTEGER :: ji, jj, jk, jm ! dummy loop indices
INTEGER :: ierror, inum ! temporary integer
INTEGER :: ios ! Local integer output status for namelist read
- !
- NAMELIST/namsbc_rnf/ cn_dir, ln_rnf_emp, ln_rnf_depth, ln_rnf_tem, ln_rnf_sal, &
+ INTEGER :: nbrec ! temporary integer
+ REAL(wp) :: zacoef
+ REAL(wp), DIMENSION(12) :: zrec ! times records
+ REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zrnfcl
+ REAL(wp), DIMENSION(:,: ), ALLOCATABLE :: zrnf
+ !
+ NAMELIST/namsbc_rnf/ cn_dir , ln_rnf_depth, ln_rnf_tem, ln_rnf_sal, &
& sn_rnf, sn_cnf , sn_s_rnf , sn_t_rnf , sn_dep_rnf, &
- & ln_rnf_mouth , rn_hrnf , rn_avt_rnf, rn_rfact
- !!----------------------------------------------------------------------
+ & ln_rnf_mouth , rn_hrnf , rn_avt_rnf, rn_rfact, &
+ & ln_rnf_depth_ini , rn_dep_max , rn_rnf_max, nn_rnf_depth_file
+ !!----------------------------------------------------------------------
+ !
+ ! !== allocate runoff arrays
+ IF( sbc_rnf_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_rnf_alloc : unable to allocate arrays' )
+ !
+ IF( .NOT. ln_rnf ) THEN ! no specific treatment in vicinity of river mouths
+ ln_rnf_mouth = .FALSE. ! default definition needed for example by sbc_ssr or by tra_adv_muscl
+ nkrnf = 0
+ rnf (:,:) = 0.0_wp
+ rnf_b (:,:) = 0.0_wp
+ rnfmsk (:,:) = 0.0_wp
+ rnfmsk_z(:) = 0.0_wp
+ RETURN
+ ENDIF
!
! ! ============
@@ -283,5 +300,4 @@
WRITE(numout,*) '~~~~~~~ '
WRITE(numout,*) ' Namelist namsbc_rnf'
- WRITE(numout,*) ' runoff in a file to be read ln_rnf_emp = ', ln_rnf_emp
WRITE(numout,*) ' specific river mouths treatment ln_rnf_mouth = ', ln_rnf_mouth
WRITE(numout,*) ' river mouth additional Kz rn_avt_rnf = ', rn_avt_rnf
@@ -289,21 +305,9 @@
WRITE(numout,*) ' multiplicative factor for runoff rn_rfact = ', rn_rfact
ENDIF
- !
! ! ==================
! ! Type of runoff
! ! ==================
- ! !== allocate runoff arrays
- IF( sbc_rnf_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_rnf_alloc : unable to allocate arrays' )
- !
- IF( ln_rnf_emp ) THEN !== runoffs directly provided in the precipitations ==!
- IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*) ' runoffs directly provided in the precipitations'
- IF( ln_rnf_depth .OR. ln_rnf_tem .OR. ln_rnf_sal ) THEN
- CALL ctl_warn( 'runoffs already included in precipitations, so runoff (T,S, depth) attributes will not be used' )
- ln_rnf_depth = .FALSE. ; ln_rnf_tem = .FALSE. ; ln_rnf_sal = .FALSE.
- ENDIF
- !
- ELSE !== runoffs read in a file : set sf_rnf structure ==!
- !
+ !
+ IF( .NOT. l_rnfcpl ) THEN
ALLOCATE( sf_rnf(1), STAT=ierror ) ! Create sf_rnf structure (runoff inflow)
IF(lwp) WRITE(numout,*)
@@ -314,70 +318,134 @@
ALLOCATE( sf_rnf(1)%fnow(jpi,jpj,1) )
IF( sn_rnf%ln_tint ) ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,1,2) )
- ! ! fill sf_rnf with the namelist (sn_rnf) and control print
CALL fld_fill( sf_rnf, (/ sn_rnf /), cn_dir, 'sbc_rnf_init', 'read runoffs data', 'namsbc_rnf' )
- !
- IF( ln_rnf_tem ) THEN ! Create (if required) sf_t_rnf structure
- IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*) ' runoffs temperatures read in a file'
- ALLOCATE( sf_t_rnf(1), STAT=ierror )
- 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) )
- CALL fld_fill (sf_t_rnf, (/ sn_t_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff temperature data', 'namsbc_rnf' )
- ENDIF
- !
- IF( ln_rnf_sal ) THEN ! Create (if required) sf_s_rnf and sf_t_rnf structures
- IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*) ' runoffs salinities read in a file'
- ALLOCATE( sf_s_rnf(1), STAT=ierror )
- 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) )
- CALL fld_fill (sf_s_rnf, (/ sn_s_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff salinity data', 'namsbc_rnf' )
- ENDIF
- !
- IF( ln_rnf_depth ) THEN ! depth of runoffs set from a file
- IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*) ' runoffs depth read in a file'
- rn_dep_file = TRIM( cn_dir )//TRIM( sn_dep_rnf%clname )
- IF( .NOT. sn_dep_rnf%ln_clim ) THEN ; WRITE(rn_dep_file, '(a,"_y",i4)' ) TRIM( rn_dep_file ), nyear ! add year
- IF( sn_dep_rnf%cltype == 'monthly' ) WRITE(rn_dep_file, '(a,"m",i2)' ) TRIM( rn_dep_file ), nmonth ! add month
- ENDIF
- CALL iom_open ( rn_dep_file, inum ) ! open file
- CALL iom_get ( inum, jpdom_data, sn_dep_rnf%clvar, h_rnf ) ! read the river mouth array
- CALL iom_close( inum ) ! close file
- !
- nk_rnf(:,:) = 0 ! set the number of level over which river runoffs are applied
- DO jj = 1, jpj
- DO ji = 1, jpi
- 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 ; END DO
- nk_rnf(ji,jj) = jk
- ELSEIF( h_rnf(ji,jj) == -1._wp ) THEN ; nk_rnf(ji,jj) = 1
- ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN ; nk_rnf(ji,jj) = mbkt(ji,jj)
- ELSE
- CALL ctl_stop( 'sbc_rnf_init: runoff depth not positive, and not -999 or -1, rnf value in file fort.999' )
- WRITE(999,*) 'ji, jj, h_rnf(ji,jj) :', ji, jj, h_rnf(ji,jj)
- ENDIF
+ ENDIF
+ !
+ IF( ln_rnf_tem ) THEN ! Create (if required) sf_t_rnf structure
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) ' runoffs temperatures read in a file'
+ ALLOCATE( sf_t_rnf(1), STAT=ierror )
+ 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) )
+ CALL fld_fill (sf_t_rnf, (/ sn_t_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff temperature data', 'namsbc_rnf' )
+ ENDIF
+ !
+ IF( ln_rnf_sal ) THEN ! Create (if required) sf_s_rnf and sf_t_rnf structures
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) ' runoffs salinities read in a file'
+ ALLOCATE( sf_s_rnf(1), STAT=ierror )
+ 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) )
+ CALL fld_fill (sf_s_rnf, (/ sn_s_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff salinity data', 'namsbc_rnf' )
+ ENDIF
+ !
+ IF( ln_rnf_depth ) THEN ! depth of runoffs set from a file
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) ' runoffs depth read in a file'
+ rn_dep_file = TRIM( cn_dir )//TRIM( sn_dep_rnf%clname )
+ IF( .NOT. sn_dep_rnf%ln_clim ) THEN ; WRITE(rn_dep_file, '(a,"_y",i4)' ) TRIM( rn_dep_file ), nyear ! add year
+ IF( sn_dep_rnf%cltype == 'monthly' ) WRITE(rn_dep_file, '(a,"m",i2)' ) TRIM( rn_dep_file ), nmonth ! add month
+ ENDIF
+ CALL iom_open ( rn_dep_file, inum ) ! open file
+ CALL iom_get ( inum, jpdom_data, sn_dep_rnf%clvar, h_rnf ) ! read the river mouth array
+ CALL iom_close( inum ) ! close file
+ !
+ nk_rnf(:,:) = 0 ! set the number of level over which river runoffs are applied
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ 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
+ END DO
+ nk_rnf(ji,jj) = jk
+ ELSEIF( h_rnf(ji,jj) == -1._wp ) THEN ; nk_rnf(ji,jj) = 1
+ ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN ; nk_rnf(ji,jj) = mbkt(ji,jj)
+ ELSE
+ CALL ctl_stop( 'sbc_rnf_init: runoff depth not positive, and not -999 or -1, rnf value in file fort.999' )
+ WRITE(999,*) 'ji, jj, h_rnf(ji,jj) :', ji, jj, h_rnf(ji,jj)
+ ENDIF
+ END DO
+ END DO
+ DO jj = 1, jpj ! set the associated depth
+ DO ji = 1, jpi
+ h_rnf(ji,jj) = 0._wp
+ DO jk = 1, nk_rnf(ji,jj)
+ h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk)
END DO
END DO
- DO jj = 1, jpj ! set the associated depth
- DO ji = 1, jpi
- h_rnf(ji,jj) = 0._wp
- DO jk = 1, nk_rnf(ji,jj)
- h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk)
+ END DO
+ !
+ ELSE IF( ln_rnf_depth_ini ) THEN ! runoffs applied at the surface
+ !
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) ' depth of runoff computed once from max value of runoff'
+ IF(lwp) WRITE(numout,*) ' max value of the runoff climatologie (over global domain) rn_rnf_max = ', rn_rnf_max
+ 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_gettime( inum, zrec, kntime=nbrec)
+ ALLOCATE( zrnfcl(jpi,jpj,nbrec) ) ; ALLOCATE( zrnf(jpi,jpj) )
+ DO jm = 1, nbrec
+ CALL iom_get( inum, jpdom_data, TRIM( sn_rnf%clvar ), zrnfcl(:,:,jm), jm )
+ END DO
+ CALL iom_close( inum )
+ zrnf(:,:) = MAXVAL( zrnfcl(:,:,:), DIM=3 ) ! maximum value in time
+ DEALLOCATE( zrnfcl )
+ !
+ h_rnf(:,:) = 1.
+ !
+ zacoef = rn_dep_max / rn_rnf_max ! coef of linear relation between runoff and its depth (150m for max of runoff)
+ !
+ WHERE( zrnf(:,:) > 0._wp ) h_rnf(:,:) = zacoef * zrnf(:,:) ! compute depth for all runoffs
+ !
+ DO jj = 1, jpj ! take in account min depth of ocean rn_hmin
+ DO ji = 1, jpi
+ IF( zrnf(ji,jj) > 0._wp ) THEN
+ jk = mbkt(ji,jj)
+ h_rnf(ji,jj) = MIN( h_rnf(ji,jj), gdept_0(ji,jj,jk ) )
+ ENDIF
+ END DO
+ END DO
+ !
+ nk_rnf(:,:) = 0 ! number of levels on which runoffs are distributed
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ IF( zrnf(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
END DO
+ nk_rnf(ji,jj) = jk
+ ELSE
+ nk_rnf(ji,jj) = 1
+ ENDIF
+ END DO
+ END DO
+ !
+ DEALLOCATE( zrnf )
+ !
+ DO jj = 1, jpj ! set the associated depth
+ DO ji = 1, jpi
+ h_rnf(ji,jj) = 0._wp
+ DO jk = 1, nk_rnf(ji,jj)
+ h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk)
END DO
END DO
- ELSE ! runoffs applied at the surface
- nk_rnf(:,:) = 1
- h_rnf (:,:) = fse3t(:,:,1)
- ENDIF
- !
+ END DO
+ !
+ 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., kiolib = jprstlib )
+ 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 (:,:) = fse3t(:,:,1)
ENDIF
!
@@ -400,5 +468,6 @@
IF( rn_hrnf > 0._wp ) THEN
nkrnf = 2
- DO WHILE( nkrnf /= jpkm1 .AND. gdepw_1d(nkrnf+1) < rn_hrnf ) ; nkrnf = nkrnf + 1 ; END DO
+ DO WHILE( nkrnf /= jpkm1 .AND. gdepw_1d(nkrnf+1) < rn_hrnf ) ; nkrnf = nkrnf + 1
+ END DO
IF( ln_sco ) CALL ctl_warn( 'sbc_rnf: number of levels over which Kz is increased is computed for zco...' )
ENDIF
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90 (revision 5602)
@@ -58,12 +58,9 @@
REAL(wp) :: zcoef, zf_sbc ! local scalar
REAL(wp), DIMENSION(jpi,jpj,jpts) :: zts
- REAL(wp), DIMENSION(jpi,jpj) :: zub, zvb,zdep
!!---------------------------------------------------------------------
-
- ! !* first wet T-, U-, V- ocean level (ISF) variables (T, S, depth, velocity)
+
+ ! !* surface T-, U-, V- ocean level variables (T, S, depth, velocity)
DO jj = 1, jpj
DO ji = 1, jpi
- zub(ji,jj) = ub (ji,jj,miku(ji,jj))
- zvb(ji,jj) = vb (ji,jj,mikv(ji,jj))
zts(ji,jj,jp_tem) = tsn(ji,jj,mikt(ji,jj),jp_tem)
zts(ji,jj,jp_sal) = tsn(ji,jj,mikt(ji,jj),jp_sal)
@@ -71,16 +68,8 @@
END DO
!
- IF( lk_vvl ) THEN
- DO jj = 1, jpj
- DO ji = 1, jpi
- zdep(ji,jj) = fse3t_n(ji,jj,mikt(ji,jj))
- END DO
- END DO
- ENDIF
- ! ! ---------------------------------------- !
IF( nn_fsbc == 1 ) THEN ! Instantaneous surface fields !
! ! ---------------------------------------- !
- ssu_m(:,:) = zub(:,:)
- ssv_m(:,:) = zvb(:,:)
+ ssu_m(:,:) = ub(:,:,1)
+ ssv_m(:,:) = vb(:,:,1)
IF( ln_useCT ) THEN ; sst_m(:,:) = eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) )
ELSE ; sst_m(:,:) = zts(:,:,jp_tem)
@@ -92,5 +81,7 @@
ENDIF
!
- IF( lk_vvl ) fse3t_m(:,:) = zdep(:,:)
+ IF( lk_vvl ) e3t_m(:,:) = fse3t_n(:,:,1)
+ !
+ frq_m(:,:) = fraqsr_1lev(:,:)
!
ELSE
@@ -101,6 +92,6 @@
IF(lwp) WRITE(numout,*) '~~~~~~~ mean fields initialised to instantaneous values'
zcoef = REAL( nn_fsbc - 1, wp )
- ssu_m(:,:) = zcoef * zub(:,:)
- ssv_m(:,:) = zcoef * zvb(:,:)
+ ssu_m(:,:) = zcoef * ub(:,:,1)
+ ssv_m(:,:) = zcoef * vb(:,:,1)
IF( ln_useCT ) THEN ; sst_m(:,:) = zcoef * eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) )
ELSE ; sst_m(:,:) = zcoef * zts(:,:,jp_tem)
@@ -112,5 +103,7 @@
ENDIF
!
- IF( lk_vvl ) fse3t_m(:,:) = zcoef * zdep(:,:)
+ IF( lk_vvl ) e3t_m(:,:) = zcoef * fse3t_n(:,:,1)
+ !
+ frq_m(:,:) = zcoef * fraqsr_1lev(:,:)
! ! ---------------------------------------- !
ELSEIF( MOD( kt - 2 , nn_fsbc ) == 0 ) THEN ! Initialisation: New mean computation !
@@ -121,11 +114,12 @@
sss_m(:,:) = 0.e0
ssh_m(:,:) = 0.e0
- IF( lk_vvl ) fse3t_m(:,:) = 0.e0
+ IF( lk_vvl ) e3t_m(:,:) = 0.e0
+ frq_m(:,:) = 0.e0
ENDIF
! ! ---------------------------------------- !
! ! Cumulate at each time step !
! ! ---------------------------------------- !
- ssu_m(:,:) = ssu_m(:,:) + zub(:,:)
- ssv_m(:,:) = ssv_m(:,:) + zvb(:,:)
+ ssu_m(:,:) = ssu_m(:,:) + ub(:,:,1)
+ ssv_m(:,:) = ssv_m(:,:) + vb(:,:,1)
IF( ln_useCT ) THEN ; sst_m(:,:) = sst_m(:,:) + eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) )
ELSE ; sst_m(:,:) = sst_m(:,:) + zts(:,:,jp_tem)
@@ -137,5 +131,7 @@
ENDIF
!
- IF( lk_vvl ) fse3t_m(:,:) = fse3t_m(:,:) + zdep(:,:)
+ IF( lk_vvl ) e3t_m(:,:) = fse3t_m(:,:) + fse3t_n(:,:,1)
+ !
+ frq_m(:,:) = frq_m(:,:) + fraqsr_1lev(:,:)
! ! ---------------------------------------- !
@@ -148,5 +144,6 @@
ssv_m(:,:) = ssv_m(:,:) * zcoef !
ssh_m(:,:) = ssh_m(:,:) * zcoef ! mean SSH [m]
- IF( lk_vvl ) fse3t_m(:,:) = fse3t_m(:,:) * zcoef ! mean vertical scale factor [m]
+ IF( lk_vvl ) e3t_m(:,:) = fse3t_m(:,:) * zcoef ! mean vertical scale factor [m]
+ frq_m(:,:) = frq_m(:,:) * zcoef ! mean fraction of solar net radiation absorbed in the 1st T level [-]
!
ENDIF
@@ -165,10 +162,19 @@
CALL iom_rstput( kt, nitrst, numrow, 'sss_m' , sss_m )
CALL iom_rstput( kt, nitrst, numrow, 'ssh_m' , ssh_m )
- IF( lk_vvl ) THEN
- CALL iom_rstput( kt, nitrst, numrow, 'fse3t_m' , fse3t_m(:,:) )
- END IF
- !
- ENDIF
- !
+ IF( lk_vvl ) CALL iom_rstput( kt, nitrst, numrow, 'e3t_m' , e3t_m )
+ CALL iom_rstput( kt, nitrst, numrow, 'frq_m' , frq_m )
+ !
+ ENDIF
+ !
+ ENDIF
+ !
+ IF( MOD( kt - 1 , nn_fsbc ) == 0 ) THEN ! Mean value at each nn_fsbc time-step !
+ CALL iom_put( 'ssu_m', ssu_m )
+ CALL iom_put( 'ssv_m', ssv_m )
+ CALL iom_put( 'sst_m', sst_m )
+ CALL iom_put( 'sss_m', sss_m )
+ CALL iom_put( 'ssh_m', ssh_m )
+ IF( lk_vvl ) CALL iom_put( 'e3t_m', e3t_m )
+ CALL iom_put( 'frq_m', frq_m )
ENDIF
!
@@ -206,5 +212,11 @@
CALL iom_get( numror, jpdom_autoglo, 'sss_m' , sss_m ) ! " " salinity (T-point)
CALL iom_get( numror, jpdom_autoglo, 'ssh_m' , ssh_m ) ! " " height (T-point)
- IF( lk_vvl ) CALL iom_get( numror, jpdom_autoglo, 'fse3t_m', fse3t_m(:,:) )
+ IF( lk_vvl ) CALL iom_get( numror, jpdom_autoglo, 'e3t_m', e3t_m )
+ ! fraction of solar net radiation absorbed in 1st T level
+ IF( iom_varid( numror, 'frq_m', ldstop = .FALSE. ) > 0 ) THEN
+ CALL iom_get( numror, jpdom_autoglo, 'frq_m' , frq_m )
+ ELSE
+ frq_m(:,:) = 1._wp ! default definition
+ ENDIF
!
IF( zf_sbc /= REAL( nn_fsbc, wp ) ) THEN ! nn_fsbc has changed between 2 runs
@@ -217,5 +229,6 @@
sss_m(:,:) = zcoef * sss_m(:,:)
ssh_m(:,:) = zcoef * ssh_m(:,:)
- IF( lk_vvl ) fse3t_m(:,:) = zcoef * fse3t_m(:,:)
+ IF( lk_vvl ) e3t_m(:,:) = zcoef * fse3t_m(:,:)
+ frq_m(:,:) = zcoef * frq_m(:,:)
ELSE
IF(lwp) WRITE(numout,*) '~~~~~~~ mean fields read in the ocean restart file'
@@ -224,4 +237,19 @@
ENDIF
!
+ IF( .NOT. l_ssm_mean ) THEN ! default initialisation. needed by lim_istate
+ !
+ IF(lwp) WRITE(numout,*) ' default initialisation of ss?_m arrays'
+ ssu_m(:,:) = ub(:,:,1)
+ ssv_m(:,:) = vb(:,:,1)
+ IF( ln_useCT ) THEN ; sst_m(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) )
+ ELSE ; sst_m(:,:) = tsn(:,:,1,jp_tem)
+ ENDIF
+ sss_m(:,:) = tsn(:,:,1,jp_sal)
+ ssh_m(:,:) = sshn(:,:)
+ IF( lk_vvl ) e3t_m(:,:) = fse3t_n(:,:,1)
+ frq_m(:,:) = 1._wp
+ !
+ ENDIF
+ !
END SUBROUTINE sbc_ssm_init
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbctide.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbctide.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbctide.F90 (revision 5602)
@@ -36,5 +36,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.5 , NEMO Consortium (2013)
- !! $Id: $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90 (revision 5602)
@@ -39,5 +39,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 4.0 , NEMO Consortium (2011)
- !! $Id: $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/tide_mod.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/tide_mod.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/tide_mod.F90 (revision 5602)
@@ -35,5 +35,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)
- !! $Id:$
+ !! $Id$
!! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/tideini.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/tideini.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/tideini.F90 (revision 5602)
@@ -36,5 +36,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.5 , NEMO Consortium (2013)
- !! $Id: $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
@@ -80,4 +80,7 @@
END DO
END DO
+ !
+ ! Ensure that tidal components have been set in namelist_cfg
+ IF( nb_harmo .EQ. 0 ) CALL ctl_stop( 'tide_init : No tidal components set in nam_tide' )
!
IF(lwp) THEN
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/updtide.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/updtide.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/updtide.F90 (revision 5602)
@@ -26,5 +26,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2010)
- !! $Id: sbcfwb.F90 3625 2012-11-21 13:19:18Z acc $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/STO/stopar.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/STO/stopar.F90 (revision 5602)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/STO/stopar.F90 (revision 5602)
@@ -0,0 +1,902 @@
+MODULE stopar
+ !!======================================================================
+ !! *** MODULE stopar ***
+ !! Stochastic parameters : definition and time stepping
+ !!=====================================================================
+ !! History : 3.3 ! 2011-10 (J.-M. Brankart) Original code
+ !!----------------------------------------------------------------------
+
+ !!----------------------------------------------------------------------
+ !! sto_par : update the stochastic parameters
+ !! sto_par_init : define the stochastic parameterization
+ !! sto_rst_read : read restart file for stochastic parameters
+ !! sto_rst_write : write restart file for stochastic parameters
+ !! sto_par_white : fill input array with white Gaussian noise
+ !! sto_par_flt : apply horizontal Laplacian filter to input array
+ !!----------------------------------------------------------------------
+ USE storng ! random number generator (external module)
+ USE par_oce ! ocean parameters
+ USE dom_oce ! ocean space and time domain variables
+ USE lbclnk ! lateral boundary conditions (or mpp link)
+ USE in_out_manager ! I/O manager
+ USE iom ! I/O module
+ USE lib_mpp
+
+
+ IMPLICIT NONE
+ PRIVATE
+
+ PUBLIC sto_par_init ! called by nemogcm.F90
+ PUBLIC sto_par ! called by step.F90
+ PUBLIC sto_rst_write ! called by step.F90
+
+ LOGICAL :: ln_rststo = .FALSE. ! restart stochastic parameters from restart file
+ LOGICAL :: ln_rstseed = .FALSE. ! read seed of RNG from restart file
+ CHARACTER(len=32) :: cn_storst_in = "restart_sto" ! suffix of sto restart name (input)
+ CHARACTER(len=32) :: cn_storst_out = "restart_sto" ! suffix of sto restart name (output)
+ INTEGER :: numstor, numstow ! logical unit for restart (read and write)
+
+ INTEGER :: jpsto2d = 0 ! number of 2D stochastic parameters
+ INTEGER :: jpsto3d = 0 ! number of 3D stochastic parameters
+
+ REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: sto2d ! 2D stochastic parameters
+ REAL(wp), PUBLIC, DIMENSION(:,:,:,:), ALLOCATABLE :: sto3d ! 3D stochastic parameters
+ REAL(wp), DIMENSION(:,:), ALLOCATABLE :: sto_tmp ! temporary workspace
+ REAL(wp), DIMENSION(:,:), ALLOCATABLE :: sto2d_abc ! a, b, c parameters (for 2D arrays)
+ REAL(wp), DIMENSION(:,:), ALLOCATABLE :: sto3d_abc ! a, b, c parameters (for 3D arrays)
+ REAL(wp), DIMENSION(:), ALLOCATABLE :: sto2d_ave ! mean value (for 2D arrays)
+ REAL(wp), DIMENSION(:), ALLOCATABLE :: sto3d_ave ! mean value (for 3D arrays)
+ REAL(wp), DIMENSION(:), ALLOCATABLE :: sto2d_std ! standard deviation (for 2D arrays)
+ REAL(wp), DIMENSION(:), ALLOCATABLE :: sto3d_std ! standard deviation (for 3D arrays)
+ REAL(wp), DIMENSION(:), ALLOCATABLE :: sto2d_lim ! limitation factor (for 2D arrays)
+ REAL(wp), DIMENSION(:), ALLOCATABLE :: sto3d_lim ! limitation factor (for 3D arrays)
+ REAL(wp), DIMENSION(:), ALLOCATABLE :: sto2d_tcor ! time correlation (for 2D arrays)
+ REAL(wp), DIMENSION(:), ALLOCATABLE :: sto3d_tcor ! time correlation (for 3D arrays)
+ INTEGER, DIMENSION(:), ALLOCATABLE :: sto2d_ord ! order of autoregressive process
+ INTEGER, DIMENSION(:), ALLOCATABLE :: sto3d_ord ! order of autoregressive process
+
+ CHARACTER(len=1), DIMENSION(:), ALLOCATABLE :: sto2d_typ ! nature of grid point (T, U, V, W, F, I)
+ CHARACTER(len=1), DIMENSION(:), ALLOCATABLE :: sto3d_typ ! nature of grid point (T, U, V, W, F, I)
+ REAL(wp), DIMENSION(:), ALLOCATABLE :: sto2d_sgn ! control of the sign accross the north fold
+ REAL(wp), DIMENSION(:), ALLOCATABLE :: sto3d_sgn ! control of the sign accross the north fold
+ INTEGER, DIMENSION(:), ALLOCATABLE :: sto2d_flt ! number of passes of Laplacian filter
+ INTEGER, DIMENSION(:), ALLOCATABLE :: sto3d_flt ! number of passes of Laplacian filter
+ REAL(wp), DIMENSION(:), ALLOCATABLE :: sto2d_fac ! factor to restore std after filtering
+ REAL(wp), DIMENSION(:), ALLOCATABLE :: sto3d_fac ! factor to restore std after filtering
+
+ LOGICAL, PUBLIC :: ln_sto_ldf = .FALSE. ! stochastic lateral diffusion
+ INTEGER, PUBLIC :: jsto_ldf ! index of lateral diffusion stochastic parameter
+ REAL(wp) :: rn_ldf_std ! lateral diffusion standard deviation (in percent)
+ REAL(wp) :: rn_ldf_tcor ! lateral diffusion correlation timescale (in timesteps)
+
+ LOGICAL, PUBLIC :: ln_sto_hpg = .FALSE. ! stochastic horizontal pressure gradient
+ INTEGER, PUBLIC :: jsto_hpgi ! index of stochastic hpg parameter (i direction)
+ INTEGER, PUBLIC :: jsto_hpgj ! index of stochastic hpg parameter (j direction)
+ REAL(wp) :: rn_hpg_std ! density gradient standard deviation (in percent)
+ REAL(wp) :: rn_hpg_tcor ! density gradient correlation timescale (in timesteps)
+
+ LOGICAL, PUBLIC :: ln_sto_pstar = .FALSE. ! stochastic ice strength
+ INTEGER, PUBLIC :: jsto_pstar ! index of stochastic ice strength
+ REAL(wp), PUBLIC:: rn_pstar_std ! ice strength standard deviation (in percent)
+ REAL(wp) :: rn_pstar_tcor ! ice strength correlation timescale (in timesteps)
+ INTEGER :: nn_pstar_flt = 0 ! number of passes of Laplacian filter
+ INTEGER :: nn_pstar_ord = 1 ! order of autoregressive processes
+
+ LOGICAL, PUBLIC :: ln_sto_trd = .FALSE. ! stochastic model trend
+ INTEGER, PUBLIC :: jsto_trd ! index of stochastic trend parameter
+ REAL(wp) :: rn_trd_std ! trend standard deviation (in percent)
+ REAL(wp) :: rn_trd_tcor ! trend correlation timescale (in timesteps)
+
+ LOGICAL, PUBLIC :: ln_sto_eos = .FALSE. ! stochastic equation of state
+ INTEGER, PUBLIC :: nn_sto_eos = 1 ! number of degrees of freedom in stochastic equation of state
+ INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE :: jsto_eosi ! index of stochastic eos parameter (i direction)
+ INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE :: jsto_eosj ! index of stochastic eos parameter (j direction)
+ INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE :: jsto_eosk ! index of stochastic eos parameter (k direction)
+ REAL(wp) :: rn_eos_stdxy ! random walk horz. standard deviation (in grid points)
+ REAL(wp) :: rn_eos_stdz ! random walk vert. standard deviation (in grid points)
+ REAL(wp) :: rn_eos_tcor ! random walk correlation timescale (in timesteps)
+ REAL(wp) :: rn_eos_lim = 3.0_wp ! limitation factor
+ INTEGER :: nn_eos_flt = 0 ! number of passes of Laplacian filter
+ INTEGER :: nn_eos_ord = 1 ! order of autoregressive processes
+
+ LOGICAL, PUBLIC :: ln_sto_trc = .FALSE. ! stochastic tracer dynamics
+ INTEGER, PUBLIC :: nn_sto_trc = 1 ! number of degrees of freedom in stochastic tracer dynamics
+ INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE :: jsto_trci ! index of stochastic trc parameter (i direction)
+ INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE :: jsto_trcj ! index of stochastic trc parameter (j direction)
+ INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE :: jsto_trck ! index of stochastic trc parameter (k direction)
+ REAL(wp) :: rn_trc_stdxy ! random walk horz. standard deviation (in grid points)
+ REAL(wp) :: rn_trc_stdz ! random walk vert. standard deviation (in grid points)
+ REAL(wp) :: rn_trc_tcor ! random walk correlation timescale (in timesteps)
+ REAL(wp) :: rn_trc_lim = 3.0_wp ! limitation factor
+ INTEGER :: nn_trc_flt = 0 ! number of passes of Laplacian filter
+ INTEGER :: nn_trc_ord = 1 ! order of autoregressive processes
+
+ !!----------------------------------------------------------------------
+ !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+ !! $Id: dynhpg.F90 2528 2010-12-27 17:33:53Z rblod $
+ !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+ !!----------------------------------------------------------------------
+CONTAINS
+
+ SUBROUTINE sto_par( kt )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE sto_par ***
+ !!
+ !! ** Purpose : update the stochastic parameters
+ !!
+ !! ** Method : model basic stochastic parameters
+ !! as a first order autoregressive process AR(1),
+ !! governed by the equation:
+ !! X(t) = a * X(t-1) + b * w + c
+ !! where the parameters a, b and c are related
+ !! to expected value, standard deviation
+ !! and time correlation (all stationary in time) by:
+ !! E [X(t)] = c / ( 1 - a )
+ !! STD [X(t)] = b / SQRT( 1 - a * a )
+ !! COR [X(t),X(t-k)] = a ** k
+ !! and w is a Gaussian white noise.
+ !!
+ !! Higher order autoregressive proces can be optionally generated
+ !! by replacing the white noise by a lower order process.
+ !!
+ !! 1) The statistics of the stochastic parameters (X) are assumed
+ !! constant in space (homogeneous) and time (stationary).
+ !! This could be generalized by replacing the constant
+ !! a, b, c parameters by functions of space and time.
+ !!
+ !! 2) The computation is performed independently for every model
+ !! grid point, which corresponds to assume that the stochastic
+ !! parameters are uncorrelated in space.
+ !! This could be generalized by including a spatial filter: Y = Filt[ X ]
+ !! (possibly non-homgeneous and non-stationary) in the computation,
+ !! or by solving an elliptic equation: L[ Y ] = X.
+ !!
+ !! 3) The stochastic model for the parameters could also
+ !! be generalized to depend on the current state of the ocean (not done here).
+ !!----------------------------------------------------------------------
+ INTEGER, INTENT( in ) :: kt ! ocean time-step index
+ !!
+ INTEGER :: ji, jj, jk, jsto, jflt
+ REAL(wp) :: stomax
+
+ !
+ ! Update 2D stochastic arrays
+ !
+ DO jsto = 1, jpsto2d
+ ! Store array from previous time step
+ sto_tmp(:,:) = sto2d(:,:,jsto)
+
+ IF ( sto2d_ord(jsto) == 1 ) THEN
+ ! Draw new random numbers from N(0,1) --> w
+ CALL sto_par_white( sto2d(:,:,jsto) )
+ ! Apply horizontal Laplacian filter to w
+ DO jflt = 1, sto2d_flt(jsto)
+ CALL lbc_lnk( sto2d(:,:,jsto), sto2d_typ(jsto), sto2d_sgn(jsto) )
+ CALL sto_par_flt( sto2d(:,:,jsto) )
+ END DO
+ ! Factor to restore standard deviation after filtering
+ sto2d(:,:,jsto) = sto2d(:,:,jsto) * sto2d_fac(jsto)
+ ELSE
+ ! Use previous process (one order lower) instead of white noise
+ sto2d(:,:,jsto) = sto2d(:,:,jsto-1)
+ ENDIF
+
+ ! Multiply white noise (or lower order process) by b --> b * w
+ sto2d(:,:,jsto) = sto2d(:,:,jsto) * sto2d_abc(jsto,2)
+ ! Update autoregressive processes --> a * X(t-1) + b * w
+ sto2d(:,:,jsto) = sto2d(:,:,jsto) + sto_tmp(:,:) * sto2d_abc(jsto,1)
+ ! Add parameter c --> a * X(t-1) + b * w + c
+ sto2d(:,:,jsto) = sto2d(:,:,jsto) + sto2d_abc(jsto,3)
+ ! Limit random parameter anomalies to std times the limitation factor
+ stomax = sto2d_std(jsto) * sto2d_lim(jsto)
+ sto2d(:,:,jsto) = sto2d(:,:,jsto) - sto2d_ave(jsto)
+ sto2d(:,:,jsto) = SIGN(MIN(stomax,ABS(sto2d(:,:,jsto))),sto2d(:,:,jsto))
+ sto2d(:,:,jsto) = sto2d(:,:,jsto) + sto2d_ave(jsto)
+
+ ! Lateral boundary conditions on sto2d
+ CALL lbc_lnk( sto2d(:,:,jsto), sto2d_typ(jsto), sto2d_sgn(jsto) )
+ END DO
+ !
+ ! Update 3D stochastic arrays
+ !
+ DO jsto = 1, jpsto3d
+ DO jk = 1, jpk
+ ! Store array from previous time step
+ sto_tmp(:,:) = sto3d(:,:,jk,jsto)
+
+ IF ( sto3d_ord(jsto) == 1 ) THEN
+ ! Draw new random numbers from N(0,1) --> w
+ CALL sto_par_white( sto3d(:,:,jk,jsto) )
+ ! Apply horizontal Laplacian filter to w
+ DO jflt = 1, sto3d_flt(jsto)
+ CALL lbc_lnk( sto3d(:,:,jk,jsto), sto3d_typ(jsto), sto3d_sgn(jsto) )
+ CALL sto_par_flt( sto3d(:,:,jk,jsto) )
+ END DO
+ ! Factor to restore standard deviation after filtering
+ sto3d(:,:,jk,jsto) = sto3d(:,:,jk,jsto) * sto3d_fac(jsto)
+ ELSE
+ ! Use previous process (one order lower) instead of white noise
+ sto3d(:,:,jk,jsto) = sto3d(:,:,jk,jsto-1)
+ ENDIF
+
+ ! Multiply white noise by b --> b * w
+ sto3d(:,:,jk,jsto) = sto3d(:,:,jk,jsto) * sto3d_abc(jsto,2)
+ ! Update autoregressive processes --> a * X(t-1) + b * w
+ sto3d(:,:,jk,jsto) = sto3d(:,:,jk,jsto) + sto_tmp(:,:) * sto3d_abc(jsto,1)
+ ! Add parameter c --> a * X(t-1) + b * w + c
+ sto3d(:,:,jk,jsto) = sto3d(:,:,jk,jsto) + sto3d_abc(jsto,3)
+ ! Limit random parameters anomalies to std times the limitation factor
+ stomax = sto3d_std(jsto) * sto3d_lim(jsto)
+ sto3d(:,:,jk,jsto) = sto3d(:,:,jk,jsto) - sto3d_ave(jsto)
+ sto3d(:,:,jk,jsto) = SIGN(MIN(stomax,ABS(sto3d(:,:,jk,jsto))),sto3d(:,:,jk,jsto))
+ sto3d(:,:,jk,jsto) = sto3d(:,:,jk,jsto) + sto3d_ave(jsto)
+ END DO
+ ! Lateral boundary conditions on sto3d
+ CALL lbc_lnk( sto3d(:,:,:,jsto), sto3d_typ(jsto), sto3d_sgn(jsto) )
+ END DO
+
+ END SUBROUTINE sto_par
+
+
+ SUBROUTINE sto_par_init
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE sto_par_init ***
+ !!
+ !! ** Purpose : define the stochastic parameterization
+ !!----------------------------------------------------------------------
+ NAMELIST/namsto/ ln_sto_ldf, rn_ldf_std, rn_ldf_tcor, &
+ & ln_sto_hpg, rn_hpg_std, rn_hpg_tcor, &
+ & ln_sto_pstar, rn_pstar_std, rn_pstar_tcor, nn_pstar_flt, nn_pstar_ord, &
+ & ln_sto_trd, rn_trd_std, rn_trd_tcor, &
+ & ln_sto_eos, nn_sto_eos, rn_eos_stdxy, rn_eos_stdz, &
+ & rn_eos_tcor, nn_eos_ord, nn_eos_flt, rn_eos_lim, &
+ & ln_sto_trc, nn_sto_trc, rn_trc_stdxy, rn_trc_stdz, &
+ & rn_trc_tcor, nn_trc_ord, nn_trc_flt, rn_trc_lim, &
+ & ln_rststo, ln_rstseed, cn_storst_in, cn_storst_out
+ !!----------------------------------------------------------------------
+ INTEGER :: jsto, jmem, jarea, jdof, jord, jordm1, jk, jflt
+ INTEGER(KIND=8) :: zseed1, zseed2, zseed3, zseed4
+ REAL(wp) :: rinflate
+ INTEGER :: ios ! Local integer output status for namelist read
+
+ ! Read namsto namelist : stochastic parameterization
+ REWIND( numnam_ref ) ! Namelist namdyn_adv in reference namelist : Momentum advection scheme
+ READ ( numnam_ref, namsto, IOSTAT = ios, ERR = 901)
+901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsto in reference namelist', lwp )
+
+ REWIND( numnam_cfg ) ! Namelist namdyn_adv in configuration namelist : Momentum advection scheme
+ READ ( numnam_cfg, namsto, IOSTAT = ios, ERR = 902 )
+902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsto in configuration namelist', lwp )
+ IF(lwm) WRITE ( numond, namsto )
+
+ !IF(ln_ens_rst_in) cn_storst_in = cn_mem//cn_storst_in
+
+ ! Parameter print
+ IF(lwp) THEN
+ WRITE(numout,*)
+ WRITE(numout,*) 'sto_par_init : stochastic parameterization'
+ WRITE(numout,*) '~~~~~~~~~~~~'
+ WRITE(numout,*) ' Namelist namsto : stochastic parameterization'
+ WRITE(numout,*) ' restart stochastic parameters ln_rststo = ', ln_rststo
+ WRITE(numout,*) ' read seed of RNG from restart file ln_rstseed = ', ln_rstseed
+ WRITE(numout,*) ' suffix of sto restart name (input) cn_storst_in = ', cn_storst_in
+ WRITE(numout,*) ' suffix of sto restart name (output) cn_storst_out = ', cn_storst_out
+
+ ! WRITE(numout,*) ' stochastic lateral diffusion ln_sto_ldf = ', ln_sto_ldf
+ ! WRITE(numout,*) ' lateral diffusion std (in percent) rn_ldf_std = ', rn_ldf_std
+ ! WRITE(numout,*) ' lateral diffusion tcor (in timesteps) rn_ldf_tcor = ', rn_ldf_tcor
+
+ ! WRITE(numout,*) ' stochastic horizontal pressure gradient ln_sto_hpg = ', ln_sto_hpg
+ ! WRITE(numout,*) ' density gradient std (in percent) rn_hpg_std = ', rn_hpg_std
+ ! WRITE(numout,*) ' density gradient tcor (in timesteps) rn_hpg_tcor = ', rn_hpg_tcor
+
+ ! WRITE(numout,*) ' stochastic ice strength ln_sto_pstar = ', ln_sto_pstar
+ ! WRITE(numout,*) ' ice strength std (in percent) rn_pstar_std = ', rn_pstar_std
+ ! WRITE(numout,*) ' ice strength tcor (in timesteps) rn_pstar_tcor = ', rn_pstar_tcor
+ ! WRITE(numout,*) ' order of autoregressive processes nn_pstar_ord = ', nn_pstar_ord
+ ! WRITE(numout,*) ' passes of Laplacian filter nn_pstar_flt = ', nn_pstar_flt
+
+ !WRITE(numout,*) ' stochastic trend ln_sto_trd = ', ln_sto_trd
+ !WRITE(numout,*) ' trend std (in percent) rn_trd_std = ', rn_trd_std
+ !WRITE(numout,*) ' trend tcor (in timesteps) rn_trd_tcor = ', rn_trd_tcor
+
+ WRITE(numout,*) ' stochastic equation of state ln_sto_eos = ', ln_sto_eos
+ WRITE(numout,*) ' number of degrees of freedom nn_sto_eos = ', nn_sto_eos
+ WRITE(numout,*) ' random walk horz. std (in grid points) rn_eos_stdxy = ', rn_eos_stdxy
+ WRITE(numout,*) ' random walk vert. std (in grid points) rn_eos_stdz = ', rn_eos_stdz
+ WRITE(numout,*) ' random walk tcor (in timesteps) rn_eos_tcor = ', rn_eos_tcor
+ WRITE(numout,*) ' order of autoregressive processes nn_eos_ord = ', nn_eos_ord
+ WRITE(numout,*) ' passes of Laplacian filter nn_eos_flt = ', nn_eos_flt
+ WRITE(numout,*) ' limitation factor rn_eos_lim = ', rn_eos_lim
+
+ ! WRITE(numout,*) ' stochastic tracers dynamics ln_sto_trc = ', ln_sto_trc
+ ! WRITE(numout,*) ' number of degrees of freedom nn_sto_trc = ', nn_sto_trc
+ ! WRITE(numout,*) ' random walk horz. std (in grid points) rn_trc_stdxy = ', rn_trc_stdxy
+ ! WRITE(numout,*) ' random walk vert. std (in grid points) rn_trc_stdz = ', rn_trc_stdz
+ ! WRITE(numout,*) ' random walk tcor (in timesteps) rn_trc_tcor = ', rn_trc_tcor
+ ! WRITE(numout,*) ' order of autoregressive processes nn_trc_ord = ', nn_trc_ord
+ ! WRITE(numout,*) ' passes of Laplacian filter nn_trc_flt = ', nn_trc_flt
+ ! WRITE(numout,*) ' limitation factor rn_trc_lim = ', rn_trc_lim
+
+ ENDIF
+
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) ' stochastic parameterization :'
+
+ ! Set number of 2D stochastic arrays
+ jpsto2d = 0
+ IF( ln_sto_ldf ) THEN
+ IF(lwp) WRITE(numout,*) ' - stochastic lateral diffusion'
+ jpsto2d = jpsto2d + 1
+ jsto_ldf = jpsto2d
+ ENDIF
+ IF( ln_sto_pstar ) THEN
+ IF(lwp) WRITE(numout,*) ' - stochastic ice strength'
+ jpsto2d = jpsto2d + 1 * nn_pstar_ord
+ jsto_pstar = jpsto2d
+ ENDIF
+ IF( ln_sto_eos ) THEN
+ IF ( lk_agrif ) CALL ctl_stop('EOS stochastic parametrization is not compatible with AGRIF')
+ IF(lwp) WRITE(numout,*) ' - stochastic equation of state'
+ ALLOCATE(jsto_eosi(nn_sto_eos))
+ ALLOCATE(jsto_eosj(nn_sto_eos))
+ ALLOCATE(jsto_eosk(nn_sto_eos))
+ DO jdof = 1, nn_sto_eos
+ jpsto2d = jpsto2d + 3 * nn_eos_ord
+ jsto_eosi(jdof) = jpsto2d - 2 * nn_eos_ord
+ jsto_eosj(jdof) = jpsto2d - 1 * nn_eos_ord
+ jsto_eosk(jdof) = jpsto2d
+ END DO
+ ELSE
+ nn_sto_eos = 0
+ ENDIF
+ IF( ln_sto_trc ) THEN
+ IF(lwp) WRITE(numout,*) ' - stochastic tracers dynamics'
+ ALLOCATE(jsto_trci(nn_sto_trc))
+ ALLOCATE(jsto_trcj(nn_sto_trc))
+ ALLOCATE(jsto_trck(nn_sto_trc))
+ DO jdof = 1, nn_sto_trc
+ jpsto2d = jpsto2d + 3 * nn_trc_ord
+ jsto_trci(jdof) = jpsto2d - 2 * nn_trc_ord
+ jsto_trcj(jdof) = jpsto2d - 1 * nn_trc_ord
+ jsto_trck(jdof) = jpsto2d
+ END DO
+ ELSE
+ nn_sto_trc = 0
+ ENDIF
+
+ ! Set number of 3D stochastic arrays
+ jpsto3d = 0
+ IF( ln_sto_hpg ) THEN
+ IF(lwp) WRITE(numout,*) ' - stochastic horizontal pressure gradient'
+ jpsto3d = jpsto3d + 2
+ jsto_hpgi = jpsto3d - 1
+ jsto_hpgj = jpsto3d
+ ENDIF
+ IF( ln_sto_trd ) THEN
+ IF(lwp) WRITE(numout,*) ' - stochastic trend'
+ jpsto3d = jpsto3d + 1
+ jsto_trd = jpsto3d
+ ENDIF
+
+ ! Allocate 2D stochastic arrays
+ IF ( jpsto2d > 0 ) THEN
+ ALLOCATE ( sto2d(jpi,jpj,jpsto2d) )
+ ALLOCATE ( sto2d_abc(jpsto2d,3) )
+ ALLOCATE ( sto2d_ave(jpsto2d) )
+ ALLOCATE ( sto2d_std(jpsto2d) )
+ ALLOCATE ( sto2d_lim(jpsto2d) )
+ ALLOCATE ( sto2d_tcor(jpsto2d) )
+ ALLOCATE ( sto2d_ord(jpsto2d) )
+ ALLOCATE ( sto2d_typ(jpsto2d) )
+ ALLOCATE ( sto2d_sgn(jpsto2d) )
+ ALLOCATE ( sto2d_flt(jpsto2d) )
+ ALLOCATE ( sto2d_fac(jpsto2d) )
+ ENDIF
+
+ ! Allocate 3D stochastic arrays
+ IF ( jpsto3d > 0 ) THEN
+ ALLOCATE ( sto3d(jpi,jpj,jpk,jpsto3d) )
+ ALLOCATE ( sto3d_abc(jpsto3d,3) )
+ ALLOCATE ( sto3d_ave(jpsto3d) )
+ ALLOCATE ( sto3d_std(jpsto3d) )
+ ALLOCATE ( sto3d_lim(jpsto3d) )
+ ALLOCATE ( sto3d_tcor(jpsto3d) )
+ ALLOCATE ( sto3d_ord(jpsto3d) )
+ ALLOCATE ( sto3d_typ(jpsto3d) )
+ ALLOCATE ( sto3d_sgn(jpsto3d) )
+ ALLOCATE ( sto3d_flt(jpsto3d) )
+ ALLOCATE ( sto3d_fac(jpsto3d) )
+ ENDIF
+
+ ! Allocate temporary workspace
+ IF ( jpsto2d > 0 .OR. jpsto3d > 0 ) THEN
+ ALLOCATE ( sto_tmp(jpi,jpj) ) ; sto_tmp(:,:) = 0._wp
+ ENDIF
+
+ ! 1) For every stochastic parameter:
+ ! ----------------------------------
+ ! - set nature of grid point and control of the sign
+ ! across the north fold (sto2d_typ, sto2d_sgn)
+ ! - set number of passes of Laplacian filter (sto2d_flt)
+ ! - set order of every autoregressive process (sto2d_ord)
+ DO jsto = 1, jpsto2d
+ sto2d_typ(jsto) = 'T'
+ sto2d_sgn(jsto) = 1._wp
+ sto2d_flt(jsto) = 0
+ sto2d_ord(jsto) = 1
+ DO jord = 0, nn_pstar_ord-1
+ IF ( jsto+jord == jsto_pstar ) THEN ! Stochastic ice strength (ave=1)
+ sto2d_ord(jsto) = nn_pstar_ord - jord
+ sto2d_flt(jsto) = nn_pstar_flt
+ ENDIF
+ ENDDO
+ DO jdof = 1, nn_sto_eos
+ DO jord = 0, nn_eos_ord-1
+ IF ( jsto+jord == jsto_eosi(jdof) ) THEN ! Stochastic equation of state i (ave=0)
+ sto2d_ord(jsto) = nn_eos_ord - jord
+ sto2d_sgn(jsto) = -1._wp
+ sto2d_flt(jsto) = nn_eos_flt
+ ENDIF
+ IF ( jsto+jord == jsto_eosj(jdof) ) THEN ! Stochastic equation of state j (ave=0)
+ sto2d_ord(jsto) = nn_eos_ord - jord
+ sto2d_sgn(jsto) = -1._wp
+ sto2d_flt(jsto) = nn_eos_flt
+ ENDIF
+ IF ( jsto+jord == jsto_eosk(jdof) ) THEN ! Stochastic equation of state k (ave=0)
+ sto2d_ord(jsto) = nn_eos_ord - jord
+ sto2d_flt(jsto) = nn_eos_flt
+ ENDIF
+ END DO
+ END DO
+ DO jdof = 1, nn_sto_trc
+ DO jord = 0, nn_trc_ord-1
+ IF ( jsto+jord == jsto_trci(jdof) ) THEN ! Stochastic tracers dynamics i (ave=0)
+ sto2d_ord(jsto) = nn_trc_ord - jord
+ sto2d_sgn(jsto) = -1._wp
+ sto2d_flt(jsto) = nn_trc_flt
+ ENDIF
+ IF ( jsto+jord == jsto_trcj(jdof) ) THEN ! Stochastic tracers dynamics j (ave=0)
+ sto2d_ord(jsto) = nn_trc_ord - jord
+ sto2d_sgn(jsto) = -1._wp
+ sto2d_flt(jsto) = nn_trc_flt
+ ENDIF
+ IF ( jsto+jord == jsto_trck(jdof) ) THEN ! Stochastic tracers dynamics k (ave=0)
+ sto2d_ord(jsto) = nn_trc_ord - jord
+ sto2d_flt(jsto) = nn_trc_flt
+ ENDIF
+ END DO
+ END DO
+
+ sto2d_fac(jsto) = sto_par_flt_fac ( sto2d_flt(jsto) )
+ END DO
+ !
+ DO jsto = 1, jpsto3d
+ sto3d_typ(jsto) = 'T'
+ sto3d_sgn(jsto) = 1._wp
+ sto3d_flt(jsto) = 0
+ sto3d_ord(jsto) = 1
+ IF ( jsto == jsto_hpgi ) THEN ! Stochastic density gradient i (ave=1)
+ sto3d_typ(jsto) = 'U'
+ ENDIF
+ IF ( jsto == jsto_hpgj ) THEN ! Stochastic density gradient j (ave=1)
+ sto3d_typ(jsto) = 'V'
+ ENDIF
+ sto3d_fac(jsto) = sto_par_flt_fac ( sto3d_flt(jsto) )
+ END DO
+
+ ! 2) For every stochastic parameter:
+ ! ----------------------------------
+ ! set average, standard deviation and time correlation
+ DO jsto = 1, jpsto2d
+ sto2d_ave(jsto) = 0._wp
+ sto2d_std(jsto) = 1._wp
+ sto2d_tcor(jsto) = 1._wp
+ sto2d_lim(jsto) = 3._wp
+ IF ( jsto == jsto_ldf ) THEN ! Stochastic lateral diffusion (ave=1)
+ sto2d_ave(jsto) = 1._wp
+ sto2d_std(jsto) = rn_ldf_std
+ sto2d_tcor(jsto) = rn_ldf_tcor
+ ENDIF
+ DO jord = 0, nn_pstar_ord-1
+ IF ( jsto+jord == jsto_pstar ) THEN ! Stochastic ice strength (ave=1)
+ sto2d_std(jsto) = 1._wp
+ sto2d_tcor(jsto) = rn_pstar_tcor
+ ENDIF
+ ENDDO
+ DO jdof = 1, nn_sto_eos
+ DO jord = 0, nn_eos_ord-1
+ IF ( jsto+jord == jsto_eosi(jdof) ) THEN ! Stochastic equation of state i (ave=0)
+ sto2d_std(jsto) = rn_eos_stdxy
+ sto2d_tcor(jsto) = rn_eos_tcor
+ sto2d_lim(jsto) = rn_eos_lim
+ ENDIF
+ IF ( jsto+jord == jsto_eosj(jdof) ) THEN ! Stochastic equation of state j (ave=0)
+ sto2d_std(jsto) = rn_eos_stdxy
+ sto2d_tcor(jsto) = rn_eos_tcor
+ sto2d_lim(jsto) = rn_eos_lim
+ ENDIF
+ IF ( jsto+jord == jsto_eosk(jdof) ) THEN ! Stochastic equation of state k (ave=0)
+ sto2d_std(jsto) = rn_eos_stdz
+ sto2d_tcor(jsto) = rn_eos_tcor
+ sto2d_lim(jsto) = rn_eos_lim
+ ENDIF
+ END DO
+ END DO
+ DO jdof = 1, nn_sto_trc
+ DO jord = 0, nn_trc_ord-1
+ IF ( jsto+jord == jsto_trci(jdof) ) THEN ! Stochastic tracer dynamics i (ave=0)
+ sto2d_std(jsto) = rn_trc_stdxy
+ sto2d_tcor(jsto) = rn_trc_tcor
+ sto2d_lim(jsto) = rn_trc_lim
+ ENDIF
+ IF ( jsto+jord == jsto_trcj(jdof) ) THEN ! Stochastic tracer dynamics j (ave=0)
+ sto2d_std(jsto) = rn_trc_stdxy
+ sto2d_tcor(jsto) = rn_trc_tcor
+ sto2d_lim(jsto) = rn_trc_lim
+ ENDIF
+ IF ( jsto+jord == jsto_trck(jdof) ) THEN ! Stochastic tracer dynamics k (ave=0)
+ sto2d_std(jsto) = rn_trc_stdz
+ sto2d_tcor(jsto) = rn_trc_tcor
+ sto2d_lim(jsto) = rn_trc_lim
+ ENDIF
+ END DO
+ END DO
+
+ END DO
+ !
+ DO jsto = 1, jpsto3d
+ sto3d_ave(jsto) = 0._wp
+ sto3d_std(jsto) = 1._wp
+ sto3d_tcor(jsto) = 1._wp
+ sto3d_lim(jsto) = 3._wp
+ IF ( jsto == jsto_hpgi ) THEN ! Stochastic density gradient i (ave=1)
+ sto3d_ave(jsto) = 1._wp
+ sto3d_std(jsto) = rn_hpg_std
+ sto3d_tcor(jsto) = rn_hpg_tcor
+ ENDIF
+ IF ( jsto == jsto_hpgj ) THEN ! Stochastic density gradient j (ave=1)
+ sto3d_ave(jsto) = 1._wp
+ sto3d_std(jsto) = rn_hpg_std
+ sto3d_tcor(jsto) = rn_hpg_tcor
+ ENDIF
+ IF ( jsto == jsto_trd ) THEN ! Stochastic trend (ave=1)
+ sto3d_ave(jsto) = 1._wp
+ sto3d_std(jsto) = rn_trd_std
+ sto3d_tcor(jsto) = rn_trd_tcor
+ ENDIF
+ END DO
+
+ ! 3) For every stochastic parameter:
+ ! ----------------------------------
+ ! - compute parameters (a, b, c) of the AR1 autoregressive process
+ ! from expected value (ave), standard deviation (std)
+ ! and time correlation (tcor):
+ ! a = EXP ( - 1 / tcor ) --> sto2d_abc(:,1)
+ ! b = std * SQRT( 1 - a * a ) --> sto2d_abc(:,2)
+ ! c = ave * ( 1 - a ) --> sto2d_abc(:,3)
+ ! - for higher order processes (ARn, n>1), use approximate formula
+ ! for the b parameter (valid for tcor>>1 time step)
+ DO jsto = 1, jpsto2d
+ IF ( sto2d_tcor(jsto) == 0._wp ) THEN
+ sto2d_abc(jsto,1) = 0._wp
+ ELSE
+ sto2d_abc(jsto,1) = EXP ( - 1._wp / sto2d_tcor(jsto) )
+ ENDIF
+ IF ( sto2d_ord(jsto) == 1 ) THEN ! Exact formula for 1st order process
+ rinflate = sto2d_std(jsto)
+ ELSE
+ ! Approximate formula, valid for tcor >> 1
+ jordm1 = sto2d_ord(jsto) - 1
+ rinflate = SQRT ( REAL( jordm1 , wp ) / REAL( 2*(2*jordm1-1) , wp ) )
+ ENDIF
+ sto2d_abc(jsto,2) = rinflate * SQRT ( 1._wp - sto2d_abc(jsto,1) &
+ * sto2d_abc(jsto,1) )
+ sto2d_abc(jsto,3) = sto2d_ave(jsto) * ( 1._wp - sto2d_abc(jsto,1) )
+ END DO
+ !
+ DO jsto = 1, jpsto3d
+ IF ( sto3d_tcor(jsto) == 0._wp ) THEN
+ sto3d_abc(jsto,1) = 0._wp
+ ELSE
+ sto3d_abc(jsto,1) = EXP ( - 1._wp / sto3d_tcor(jsto) )
+ ENDIF
+ IF ( sto3d_ord(jsto) == 1 ) THEN ! Exact formula for 1st order process
+ rinflate = sto3d_std(jsto)
+ ELSE
+ ! Approximate formula, valid for tcor >> 1
+ jordm1 = sto3d_ord(jsto) - 1
+ rinflate = SQRT ( REAL( jordm1 , wp ) / REAL( 2*(2*jordm1-1) , wp ) )
+ ENDIF
+ sto3d_abc(jsto,2) = rinflate * SQRT ( 1._wp - sto3d_abc(jsto,1) &
+ * sto3d_abc(jsto,1) )
+ sto3d_abc(jsto,3) = sto3d_ave(jsto) * ( 1._wp - sto3d_abc(jsto,1) )
+ END DO
+
+ ! 4) Initialize seeds for random number generator
+ ! -----------------------------------------------
+ ! using different seeds for different processors (jarea)
+ ! and different ensemble members (jmem)
+ CALL kiss_reset( )
+ DO jarea = 1, narea
+ !DO jmem = 0, nmember
+ zseed1 = kiss() ; zseed2 = kiss() ; zseed3 = kiss() ; zseed4 = kiss()
+ !END DO
+ END DO
+ CALL kiss_seed( zseed1, zseed2, zseed3, zseed4 )
+
+ ! 5) Initialize stochastic parameters to: ave + std * w
+ ! -----------------------------------------------------
+ DO jsto = 1, jpsto2d
+ ! Draw random numbers from N(0,1) --> w
+ CALL sto_par_white( sto2d(:,:,jsto) )
+ ! Apply horizontal Laplacian filter to w
+ DO jflt = 1, sto2d_flt(jsto)
+ CALL lbc_lnk( sto2d(:,:,jsto), sto2d_typ(jsto), sto2d_sgn(jsto) )
+ CALL sto_par_flt( sto2d(:,:,jsto) )
+ END DO
+ ! Factor to restore standard deviation after filtering
+ sto2d(:,:,jsto) = sto2d(:,:,jsto) * sto2d_fac(jsto)
+ ! Limit random parameter to the limitation factor
+ sto2d(:,:,jsto) = SIGN(MIN(sto2d_lim(jsto),ABS(sto2d(:,:,jsto))),sto2d(:,:,jsto))
+ ! Multiply by standard devation and add average value
+ sto2d(:,:,jsto) = sto2d(:,:,jsto) * sto2d_std(jsto) + sto2d_ave(jsto)
+ END DO
+ !
+ DO jsto = 1, jpsto3d
+ DO jk = 1, jpk
+ ! Draw random numbers from N(0,1) --> w
+ CALL sto_par_white( sto3d(:,:,jk,jsto) )
+ ! Apply horizontal Laplacian filter to w
+ DO jflt = 1, sto3d_flt(jsto)
+ CALL lbc_lnk( sto3d(:,:,jk,jsto), sto3d_typ(jsto), sto3d_sgn(jsto) )
+ CALL sto_par_flt( sto3d(:,:,jk,jsto) )
+ END DO
+ ! Factor to restore standard deviation after filtering
+ sto3d(:,:,jk,jsto) = sto3d(:,:,jk,jsto) * sto3d_fac(jsto)
+ ! Limit random parameter to the limitation factor
+ sto3d(:,:,jk,jsto) = SIGN(MIN(sto3d_lim(jsto),ABS(sto3d(:,:,jk,jsto))),sto3d(:,:,jk,jsto))
+ ! Multiply by standard devation and add average value
+ sto3d(:,:,jk,jsto) = sto3d(:,:,jk,jsto) * sto3d_std(jsto) + sto3d_ave(jsto)
+ END DO
+ END DO
+
+ ! 6) Restart stochastic parameters from file
+ ! ------------------------------------------
+ IF( ln_rststo ) CALL sto_rst_read
+
+ END SUBROUTINE sto_par_init
+
+
+ SUBROUTINE sto_rst_read
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE sto_rst_read ***
+ !!
+
+ !! ** Purpose : read stochastic parameters from restart file
+ !!----------------------------------------------------------------------
+
+ INTEGER :: jsto, jseed
+ INTEGER(KIND=8) :: ziseed(4) ! RNG seeds in integer type
+ REAL(KIND=8) :: zrseed(4) ! RNG seeds in real type (with same bits to save in restart)
+ CHARACTER(LEN=9) :: clsto2d='sto2d_000' ! stochastic parameter variable name
+ CHARACTER(LEN=9) :: clsto3d='sto3d_000' ! stochastic parameter variable name
+ CHARACTER(LEN=10) :: clseed='seed0_0000' ! seed variable name
+
+ IF ( jpsto2d > 0 .OR. jpsto3d > 0 ) THEN
+
+ IF(lwp) THEN
+ WRITE(numout,*)
+ WRITE(numout,*) 'sto_rst_read : read stochastic parameters from restart file'
+ WRITE(numout,*) '~~~~~~~~~~~~'
+ ENDIF
+
+ ! Open the restart file
+ CALL iom_open( cn_storst_in, numstor, kiolib = jprstlib )
+
+ ! Get stochastic parameters from restart file:
+ ! 2D stochastic parameters
+ DO jsto = 1 , jpsto2d
+ WRITE(clsto2d(7:9),'(i3.3)') jsto
+ CALL iom_get( numstor, jpdom_autoglo, clsto2d , sto2d(:,:,jsto) )
+ END DO
+ ! 3D stochastic parameters
+ DO jsto = 1 , jpsto3d
+ WRITE(clsto3d(7:9),'(i3.3)') jsto
+ CALL iom_get( numstor, jpdom_autoglo, clsto3d , sto3d(:,:,:,jsto) )
+ END DO
+
+ IF (ln_rstseed) THEN
+ ! Get saved state of the random number generator
+ DO jseed = 1 , 4
+ WRITE(clseed(5:5) ,'(i1.1)') jseed
+ WRITE(clseed(7:10),'(i4.4)') narea
+ CALL iom_get( numstor, clseed , zrseed(jseed) )
+ END DO
+ ziseed = TRANSFER( zrseed , ziseed)
+ CALL kiss_seed( ziseed(1) , ziseed(2) , ziseed(3) , ziseed(4) )
+ ENDIF
+
+ ! Close the restart file
+ CALL iom_close( numstor )
+
+ ENDIF
+
+ END SUBROUTINE sto_rst_read
+
+
+ SUBROUTINE sto_rst_write( kt )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE sto_rst_write ***
+ !!
+ !! ** Purpose : write stochastic parameters in restart file
+ !!----------------------------------------------------------------------
+ INTEGER, INTENT(in) :: kt ! ocean time-step
+ !!
+ INTEGER :: jsto, jseed
+ INTEGER(KIND=8) :: ziseed(4) ! RNG seeds in integer type
+ REAL(KIND=8) :: zrseed(4) ! RNG seeds in real type (with same bits to save in restart)
+ CHARACTER(LEN=20) :: clkt ! ocean time-step defined as a character
+ CHARACTER(LEN=50) :: clname ! restart file name
+ CHARACTER(LEN=9) :: clsto2d='sto2d_000' ! stochastic parameter variable name
+ CHARACTER(LEN=9) :: clsto3d='sto3d_000' ! stochastic parameter variable name
+ CHARACTER(LEN=10) :: clseed='seed0_0000' ! seed variable name
+
+ IF ( jpsto2d > 0 .OR. jpsto3d > 0 ) THEN
+
+ IF( kt == nitrst .OR. kt == nitend ) THEN
+ IF(lwp) THEN
+ WRITE(numout,*)
+ WRITE(numout,*) 'sto_rst_write : write stochastic parameters in restart file'
+ WRITE(numout,*) '~~~~~~~~~~~~~'
+ ENDIF
+ ENDIF
+
+ ! Put stochastic parameters in restart files
+ ! (as opened at previous timestep, see below)
+ IF( kt > nit000) THEN
+ IF( kt == nitrst .OR. kt == nitend ) THEN
+ ! get and save current state of the random number generator
+ CALL kiss_state( ziseed(1) , ziseed(2) , ziseed(3) , ziseed(4) )
+ zrseed = TRANSFER( ziseed , zrseed)
+ DO jseed = 1 , 4
+ WRITE(clseed(5:5) ,'(i1.1)') jseed
+ WRITE(clseed(7:10),'(i4.4)') narea
+ CALL iom_rstput( kt, nitrst, numstow, clseed , zrseed(jseed) )
+ END DO
+ ! 2D stochastic parameters
+ DO jsto = 1 , jpsto2d
+ WRITE(clsto2d(7:9),'(i3.3)') jsto
+ CALL iom_rstput( kt, nitrst, numstow, clsto2d , sto2d(:,:,jsto) )
+ END DO
+ ! 3D stochastic parameters
+ DO jsto = 1 , jpsto3d
+ WRITE(clsto3d(7:9),'(i3.3)') jsto
+ CALL iom_rstput( kt, nitrst, numstow, clsto3d , sto3d(:,:,:,jsto) )
+ END DO
+ ! close the restart file
+ CALL iom_close( numstow )
+ ENDIF
+ ENDIF
+
+ ! Open the restart file one timestep before writing restart
+ IF( kt < nitend) THEN
+ IF( kt == nitrst - 1 .OR. nstock == 1 .OR. kt == nitend-1 ) THEN
+ ! create the filename
+ IF( nitrst > 999999999 ) THEN ; WRITE(clkt, * ) nitrst
+ ELSE ; WRITE(clkt, '(i8.8)') nitrst
+ ENDIF
+ clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_storst_out)
+ ! print information
+ IF(lwp) THEN
+ WRITE(numout,*) ' open stochastic parameters restart file: '//clname
+ IF( kt == nitrst - 1 ) THEN
+ WRITE(numout,*) ' kt = nitrst - 1 = ', kt
+ ELSE
+ WRITE(numout,*) ' kt = ' , kt
+ ENDIF
+ ENDIF
+ ! open the restart file
+ CALL iom_open( clname, numstow, ldwrt = .TRUE., kiolib = jprstlib )
+ ENDIF
+ ENDIF
+
+ ENDIF
+
+ END SUBROUTINE sto_rst_write
+
+
+ SUBROUTINE sto_par_white( psto )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE sto_par_white ***
+ !!
+ !! ** Purpose : fill input array with white Gaussian noise
+ !!----------------------------------------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(out) :: psto
+ !!
+ INTEGER :: ji, jj
+ REAL(KIND=8) :: gran ! Gaussian random number (forced KIND=8 as in kiss_gaussian)
+
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ CALL kiss_gaussian( gran )
+ psto(ji,jj) = gran
+ END DO
+ END DO
+
+ END SUBROUTINE sto_par_white
+
+
+ SUBROUTINE sto_par_flt( psto )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE sto_par_flt ***
+ !!
+ !! ** Purpose : apply horizontal Laplacian filter to input array
+ !!----------------------------------------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(out) :: psto
+ !!
+ INTEGER :: ji, jj
+
+ DO jj = 2, jpj-1
+ DO ji = 2, jpi-1
+ psto(ji,jj) = 0.5_wp * psto(ji,jj) + 0.125_wp * &
+ & ( psto(ji-1,jj) + psto(ji+1,jj) + &
+ & psto(ji,jj-1) + psto(ji,jj+1) )
+ END DO
+ END DO
+
+ END SUBROUTINE sto_par_flt
+
+
+ REAL(wp) FUNCTION sto_par_flt_fac( kpasses )
+ !!----------------------------------------------------------------------
+ !! *** FUNCTION sto_par_flt_fac ***
+ !!
+ !! ** Purpose : compute factor to restore standard deviation
+ !! as a function of the number of passes
+ !! of the Laplacian filter
+ !!----------------------------------------------------------------------
+ INTEGER, INTENT(in) :: kpasses
+ !!
+ INTEGER :: jpasses, ji, jj, jflti, jfltj
+ INTEGER, DIMENSION(-1:1,-1:1) :: pflt0
+ REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pfltb
+ REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pflta
+ REAL(wp) :: ratio
+
+ pflt0(-1,-1) = 0 ; pflt0(-1,0) = 1 ; pflt0(-1,1) = 0
+ pflt0( 0,-1) = 1 ; pflt0( 0,0) = 4 ; pflt0( 0,1) = 1
+ pflt0( 1,-1) = 0 ; pflt0( 1,0) = 1 ; pflt0( 1,1) = 0
+
+ ALLOCATE(pfltb(-kpasses-1:kpasses+1,-kpasses-1:kpasses+1))
+ ALLOCATE(pflta(-kpasses-1:kpasses+1,-kpasses-1:kpasses+1))
+
+ pfltb(:,:) = 0
+ pfltb(0,0) = 1
+ DO jpasses = 1, kpasses
+ pflta(:,:) = 0
+ DO jflti= -1, 1
+ DO jfltj= -1, 1
+ DO ji= -kpasses, kpasses
+ DO jj= -kpasses, kpasses
+ pflta(ji,jj) = pflta(ji,jj) + pfltb(ji+jflti,jj+jfltj) * pflt0(jflti,jfltj)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+ pfltb(:,:) = pflta(:,:)
+ ENDDO
+
+ ratio = SUM(pfltb(:,:))
+ ratio = ratio * ratio / SUM(pfltb(:,:)*pfltb(:,:))
+ ratio = SQRT(ratio)
+
+ DEALLOCATE(pfltb,pflta)
+
+ sto_par_flt_fac = ratio
+
+ END FUNCTION sto_par_flt_fac
+
+
+END MODULE stopar
+
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/STO/stopts.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/STO/stopts.F90 (revision 5602)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/STO/stopts.F90 (revision 5602)
@@ -0,0 +1,146 @@
+MODULE stopts
+ !!==============================================================================
+ !! *** MODULE stopts ***
+ !! Stochastic parameterization: compute stochastic tracer fluctuations
+ !!==============================================================================
+ !! History : 3.3 ! 2011-12 (J.-M. Brankart) Original code
+ !!----------------------------------------------------------------------
+
+ !!----------------------------------------------------------------------
+ !! sto_pts : compute current stochastic tracer fluctuations
+ !! sto_pts_init : initialisation for stochastic tracer fluctuations
+ !!----------------------------------------------------------------------
+ USE dom_oce ! ocean space and time domain
+ USE lbclnk ! lateral boundary conditions (or mpp link)
+ USE phycst ! physical constants
+ USE stopar ! stochastic parameterization
+
+ IMPLICIT NONE
+ PRIVATE
+
+ PUBLIC sto_pts ! called by step.F90
+ PUBLIC sto_pts_init ! called by nemogcm.F90
+
+ ! Public array with random tracer fluctuations
+ REAL(wp), PUBLIC, DIMENSION(:,:,:,:,:), ALLOCATABLE :: pts_ran
+
+ !! * Substitutions
+# include "vectopt_loop_substitute.h90"
+ !!----------------------------------------------------------------------
+ !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+ !! $Id: eosbn2.F90 2528 2010-12-27 17:33:53Z rblod $
+ !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+ !!----------------------------------------------------------------------
+CONTAINS
+
+ SUBROUTINE sto_pts( pts )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE sto_pts ***
+ !!
+ !! ** Purpose : Compute current stochastic tracer fluctuations
+ !!
+ !! ** Method : Compute tracer differences from a random walk
+ !! around every model grid point
+ !!
+ !!----------------------------------------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(inout) :: pts ! 1 : potential temperature [Celsius]
+ ! ! 2 : salinity [psu]
+ INTEGER :: ji, jj, jk, jts, jdof ! dummy loop indices
+ INTEGER :: jim1, jjm1, jkm1 ! incremented indices
+ INTEGER :: jip1, jjp1, jkp1 ! - -
+ REAL(wp) :: zdtsim, zdtsjm, zdtskm ! temporary scalars
+ REAL(wp) :: zdtsip, zdtsjp, zdtskp, zdts ! - -
+ !!----------------------------------------------------------------------
+
+ DO jts = 1, jpts
+ CALL lbc_lnk( pts(:,:,:,jts), 'T' , 1._wp )
+ ENDDO
+
+ DO jdof = 1, nn_sto_eos
+ DO jts = 1, jpts
+ DO jk = 1, jpkm1
+ jkm1 = MAX(jk-1,1) ; jkp1 = MIN(jk+1,jpkm1)
+ DO jj = 1, jpj
+ jjm1 = MAX(jj-1,1) ; jjp1 = MIN(jj+1,jpj)
+ DO ji = 1, jpi
+ jim1 = MAX(ji-1,1) ; jip1 = MIN(ji+1,jpi)
+ !
+ ! compute tracer gradient
+ zdtsip = ( pts(jip1,jj,jk,jts) - pts(ji,jj,jk,jts) ) * tmask(jip1,jj,jk)
+ zdtsim = ( pts(ji,jj,jk,jts) - pts(jim1,jj,jk,jts) ) * tmask(jim1,jj,jk)
+ zdtsjp = ( pts(ji,jjp1,jk,jts) - pts(ji,jj,jk,jts) ) * tmask(ji,jjp1,jk)
+ zdtsjm = ( pts(ji,jj,jk,jts) - pts(ji,jjm1,jk,jts) ) * tmask(ji,jjm1,jk)
+ zdtskp = ( pts(ji,jj,jkp1,jts) - pts(ji,jj,jk,jts) ) * tmask(ji,jj,jkp1)
+ zdtskm = ( pts(ji,jj,jk,jts) - pts(ji,jj,jkm1,jts) ) * tmask(ji,jj,jkm1)
+ !
+ ! compute random tracer fluctuation (zdts)
+ zdts = ( zdtsip + zdtsim ) * sto2d(ji,jj,jsto_eosi(jdof)) + &
+ & ( zdtsjp + zdtsjm ) * sto2d(ji,jj,jsto_eosj(jdof)) + &
+ & ( zdtskp + zdtskm ) * sto2d(ji,jj,jsto_eosk(jdof))
+! zdts = zdtsip * MAX(sto2d(ji,jj,jsto_eosi),0._wp) + &
+! & zdtsim * MIN(sto2d(ji,jj,jsto_eosi),0._wp) + &
+! & zdtsjp * MAX(sto2d(ji,jj,jsto_eosj),0._wp) + &
+! & zdtsjm * MIN(sto2d(ji,jj,jsto_eosj),0._wp) + &
+! & zdtskp * MAX(sto2d(ji,jj,jsto_eosk),0._wp) + &
+! & zdtskm * MIN(sto2d(ji,jj,jsto_eosk),0._wp)
+ zdts = zdts * tmask(ji,jj,jk) *SIN( gphit(ji,jj) * rad )
+ pts_ran(ji,jj,jk,jts,jdof) = zdts * 0.5_wp
+ !
+ END DO
+ END DO
+ END DO
+ END DO
+ END DO
+
+ ! Eliminate any possible negative salinity
+ DO jdof = 1, nn_sto_eos
+ DO jk = 1, jpkm1
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ pts_ran(ji,jj,jk,jp_sal,jdof) = MIN( ABS(pts_ran(ji,jj,jk,jp_sal,jdof)) , &
+ & MAX(pts(ji,jj,jk,jp_sal),0._wp) ) &
+ & * SIGN(1._wp,pts_ran(ji,jj,jk,jp_sal,jdof))
+ END DO
+ END DO
+ END DO
+ END DO
+
+ ! Eliminate any temperature lower than -2 degC
+! DO jdof = 1, nn_sto_eos
+! DO jk = 1, jpkm1
+! DO jj = 1, jpj
+! DO ji = 1, jpi
+! pts_ran(ji,jj,jk,jp_tem,jdof) = MIN( ABS(pts_ran(ji,jj,jk,jp_tem,jdof)) , &
+! & MAX(pts(ji,jj,jk,jp_tem)+2._wp,0._wp) ) &
+! & * SIGN(1._wp,pts_ran(ji,jj,jk,jp_tem,jdof))
+! END DO
+! END DO
+! END DO
+! END DO
+
+
+ ! Lateral boundary conditions on pts_ran
+ DO jdof = 1, nn_sto_eos
+ DO jts = 1, jpts
+ CALL lbc_lnk( pts_ran(:,:,:,jts,jdof), 'T' , 1._wp )
+ END DO
+ END DO
+
+ END SUBROUTINE sto_pts
+
+
+ SUBROUTINE sto_pts_init
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE sto_pts_init ***
+ !!
+ !! ** Purpose : Initialisation for stochastic tracer fluctuations
+ !!
+ !! ** Method : Allocate required array
+ !!
+ !!----------------------------------------------------------------------
+
+ ALLOCATE(pts_ran(jpi,jpj,jpk,jpts,nn_sto_eos))
+
+ END SUBROUTINE sto_pts_init
+
+END MODULE stopts
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/STO/storng.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/STO/storng.F90 (revision 5602)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/STO/storng.F90 (revision 5602)
@@ -0,0 +1,407 @@
+MODULE storng
+!$AGRIF_DO_NOT_TREAT
+ !!======================================================================
+ !! *** MODULE storng ***
+ !! Random number generator, used in NEMO stochastic parameterization
+ !!
+ !!=====================================================================
+ !! History : 3.3 ! 2011-10 (J.-M. Brankart) Original code
+ !!----------------------------------------------------------------------
+
+ !!----------------------------------------------------------------------
+ !! The module is based on (and includes) the
+ !! 64-bit KISS (Keep It Simple Stupid) random number generator
+ !! distributed by George Marsaglia :
+ !! http://groups.google.com/group/comp.lang.fortran/
+ !! browse_thread/thread/a85bf5f2a97f5a55
+ !!----------------------------------------------------------------------
+
+ !!----------------------------------------------------------------------
+ !! kiss : 64-bit KISS random number generator (period ~ 2^250)
+ !! kiss_seed : Define seeds for KISS random number generator
+ !! kiss_state : Get current state of KISS random number generator
+ !! kiss_save : Save current state of KISS (for future restart)
+ !! kiss_load : Load the saved state of KISS
+ !! kiss_reset : Reset the default seeds
+ !! kiss_check : Check the KISS pseudo-random sequence
+ !! kiss_uniform : Real random numbers with uniform distribution in [0,1]
+ !! kiss_gaussian : Real random numbers with Gaussian distribution N(0,1)
+ !! kiss_gamma : Real random numbers with Gamma distribution Gamma(k,1)
+ !! kiss_sample : Select a random sample from a set of integers
+ !!
+ !! ---CURRENTLY NOT USED IN NEMO :
+ !! kiss_save, kiss_load, kiss_check, kiss_gamma, kiss_sample
+ !!----------------------------------------------------------------------
+ USE par_kind
+ USE lib_mpp
+
+ IMPLICIT NONE
+ PRIVATE
+
+ ! Public functions/subroutines
+ PUBLIC :: kiss, kiss_seed, kiss_state, kiss_reset ! kiss_save, kiss_load, kiss_check
+ PUBLIC :: kiss_uniform, kiss_gaussian, kiss_gamma, kiss_sample
+
+ ! Default/initial seeds
+ INTEGER(KIND=i8) :: x=1234567890987654321_8
+ INTEGER(KIND=i8) :: y=362436362436362436_8
+ INTEGER(KIND=i8) :: z=1066149217761810_8
+ INTEGER(KIND=i8) :: w=123456123456123456_8
+
+ ! Parameters to generate real random variates
+ REAL(KIND=wp), PARAMETER :: huge64=9223372036854775808.0 ! +1
+ REAL(KIND=wp), PARAMETER :: zero=0.0, half=0.5, one=1.0, two=2.0
+
+ ! Variables to store 2 Gaussian random numbers with current index (ig)
+ INTEGER(KIND=i8), SAVE :: ig=1
+ REAL(KIND=wp), SAVE :: gran1, gran2
+
+ !!----------------------------------------------------------------------
+ !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+ !! $Id: dynhpg.F90 2528 2010-12-27 17:33:53Z rblod $
+ !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+ !!----------------------------------------------------------------------
+CONTAINS
+
+ FUNCTION kiss()
+ !! --------------------------------------------------------------------
+ !! *** FUNCTION kiss ***
+ !!
+ !! ** Purpose : 64-bit KISS random number generator
+ !!
+ !! ** Method : combine several random number generators:
+ !! (1) Xorshift (XSH), period 2^64-1,
+ !! (2) Multiply-with-carry (MWC), period (2^121+2^63-1)
+ !! (3) Congruential generator (CNG), period 2^64.
+ !!
+ !! overall period:
+ !! (2^250+2^192+2^64-2^186-2^129)/6
+ !! ~= 2^(247.42) or 10^(74.48)
+ !!
+ !! set your own seeds with 'kiss_seed'
+ ! --------------------------------------------------------------------
+ IMPLICIT NONE
+ INTEGER(KIND=i8) :: kiss, t
+
+ t = ISHFT(x,58) + w
+ IF (s(x).eq.s(t)) THEN
+ w = ISHFT(x,-6) + s(x)
+ ELSE
+ w = ISHFT(x,-6) + 1 - s(x+t)
+ ENDIF
+ x = t + x
+ y = m( m( m(y,13_8), -17_8 ), 43_8 )
+ z = 6906969069_8 * z + 1234567_8
+
+ kiss = x + y + z
+
+ CONTAINS
+
+ FUNCTION s(k)
+ INTEGER(KIND=i8) :: s, k
+ s = ISHFT(k,-63)
+ END FUNCTION s
+
+ FUNCTION m(k, n)
+ INTEGER(KIND=i8) :: m, k, n
+ m = IEOR(k, ISHFT(k, n) )
+ END FUNCTION m
+
+ END FUNCTION kiss
+
+
+ SUBROUTINE kiss_seed(ix, iy, iz, iw)
+ !! --------------------------------------------------------------------
+ !! *** ROUTINE kiss_seed ***
+ !!
+ !! ** Purpose : Define seeds for KISS random number generator
+ !!
+ !! --------------------------------------------------------------------
+ IMPLICIT NONE
+ INTEGER(KIND=i8) :: ix, iy, iz, iw
+
+ x = ix
+ y = iy
+ z = iz
+ w = iw
+
+ END SUBROUTINE kiss_seed
+
+
+ SUBROUTINE kiss_state(ix, iy, iz, iw)
+ !! --------------------------------------------------------------------
+ !! *** ROUTINE kiss_state ***
+ !!
+ !! ** Purpose : Get current state of KISS random number generator
+ !!
+ !! --------------------------------------------------------------------
+ IMPLICIT NONE
+ INTEGER(KIND=i8) :: ix, iy, iz, iw
+
+ ix = x
+ iy = y
+ iz = z
+ iw = w
+
+ END SUBROUTINE kiss_state
+
+
+ SUBROUTINE kiss_reset()
+ !! --------------------------------------------------------------------
+ !! *** ROUTINE kiss_reset ***
+ !!
+ !! ** Purpose : Reset the default seeds for KISS random number generator
+ !!
+ !! --------------------------------------------------------------------
+ IMPLICIT NONE
+
+ x=1234567890987654321_8
+ y=362436362436362436_8
+ z=1066149217761810_8
+ w=123456123456123456_8
+
+ END SUBROUTINE kiss_reset
+
+
+ ! SUBROUTINE kiss_check(check_type)
+ ! !! --------------------------------------------------------------------
+ ! !! *** ROUTINE kiss_check ***
+ ! !!
+ ! !! ** Purpose : Check the KISS pseudo-random sequence
+ ! !!
+ ! !! ** Method : Check that it reproduces the correct sequence
+ ! !! from the default seed
+ ! !!
+ ! !! --------------------------------------------------------------------
+ ! IMPLICIT NONE
+ ! INTEGER(KIND=i8) :: iter, niter, correct, iran
+ ! CHARACTER(LEN=*) :: check_type
+ ! LOGICAL :: print_success
+
+ ! ! Save current state of KISS
+ ! CALL kiss_save()
+ ! ! Reset the default seed
+ ! CALL kiss_reset()
+
+ ! ! Select check type
+ ! SELECT CASE(check_type)
+ ! CASE('short')
+ ! niter = 5_8
+ ! correct = 542381058189297533
+ ! print_success = .FALSE.
+ ! CASE('long')
+ ! niter = 100000000_8
+ ! correct = 1666297717051644203 ! Check provided by G. Marsaglia
+ ! print_success = .TRUE.
+ ! CASE('default')
+ ! CASE DEFAULT
+ ! STOP 'Bad check type in kiss_check'
+ ! END SELECT
+
+ ! ! Run kiss for the required number of iterations (niter)
+ ! DO iter=1,niter
+ ! iran = kiss()
+ ! ENDDO
+
+ ! ! Check that last iterate is correct
+ ! IF (iran.NE.correct) THEN
+ ! STOP 'Check failed: KISS internal error !!'
+ ! ELSE
+ ! IF (print_success) PRINT *, 'Check successful: 100 million calls to KISS OK'
+ ! ENDIF
+
+ ! ! Reload the previous state of KISS
+ ! CALL kiss_load()
+
+ ! END SUBROUTINE kiss_check
+
+
+ ! SUBROUTINE kiss_save
+ ! !! --------------------------------------------------------------------
+ ! !! *** ROUTINE kiss_save ***
+ ! !!
+ ! !! ** Purpose : Save current state of KISS random number generator
+ ! !!
+ ! !! --------------------------------------------------------------------
+ ! INTEGER :: inum !! Local integer
+
+ ! IMPLICIT NONE
+
+ ! CALL ctl_opn( inum, '.kiss_restart', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
+
+ ! ! OPEN(UNIT=30,FILE='.kiss_restart')
+ ! WRITE(inum,*) x
+ ! WRITE(inum,*) y
+ ! WRITE(inum,*) z
+ ! WRITE(inum,*) w
+ ! CALL flush(inum)
+
+ ! END SUBROUTINE kiss_save
+
+
+ ! SUBROUTINE kiss_load
+ ! !! --------------------------------------------------------------------
+ ! !! *** ROUTINE kiss_load ***
+ ! !!
+ ! !! ** Purpose : Load the saved state of KISS random number generator
+ ! !!
+ ! !! --------------------------------------------------------------------
+ ! IMPLICIT NONE
+ ! LOGICAL :: filexists
+ ! Use ctl_opn routine rather than fortran intrinsic functions
+ ! INQUIRE(FILE='.kiss_restart',EXIST=filexists)
+ ! IF (filexists) THEN
+ ! OPEN(UNIT=30,FILE='.kiss_restart')
+ ! READ(30,*) x
+ ! READ(30,*) y
+ ! READ(30,*) z
+ ! READ(30,*) w
+ ! CLOSE(30)
+ ! ENDIF
+
+ ! END SUBROUTINE kiss_load
+
+
+ SUBROUTINE kiss_uniform(uran)
+ !! --------------------------------------------------------------------
+ !! *** ROUTINE kiss_uniform ***
+ !!
+ !! ** Purpose : Real random numbers with uniform distribution in [0,1]
+ !!
+ !! --------------------------------------------------------------------
+ IMPLICIT NONE
+ REAL(KIND=wp) :: uran
+
+ uran = half * ( one + REAL(kiss(),wp) / huge64 )
+
+ END SUBROUTINE kiss_uniform
+
+
+ SUBROUTINE kiss_gaussian(gran)
+ !! --------------------------------------------------------------------
+ !! *** ROUTINE kiss_gaussian ***
+ !!
+ !! ** Purpose : Real random numbers with Gaussian distribution N(0,1)
+ !!
+ !! ** Method : Generate 2 new Gaussian draws (gran1 and gran2)
+ !! from 2 uniform draws on [-1,1] (u1 and u2),
+ !! using the Marsaglia polar method
+ !! (see Devroye, Non-Uniform Random Variate Generation, p. 235-236)
+ !!
+ !! --------------------------------------------------------------------
+ IMPLICIT NONE
+ REAL(KIND=wp) :: gran, u1, u2, rsq, fac
+
+ IF (ig.EQ.1) THEN
+ rsq = two
+ DO WHILE ( (rsq.GE.one).OR. (rsq.EQ.zero) )
+ u1 = REAL(kiss(),wp) / huge64
+ u2 = REAL(kiss(),wp) / huge64
+ rsq = u1*u1 + u2*u2
+ ENDDO
+ fac = SQRT(-two*LOG(rsq)/rsq)
+ gran1 = u1 * fac
+ gran2 = u2 * fac
+ ENDIF
+
+ ! Output one of the 2 draws
+ IF (ig.EQ.1) THEN
+ gran = gran1 ; ig = 2
+ ELSE
+ gran = gran2 ; ig = 1
+ ENDIF
+
+ END SUBROUTINE kiss_gaussian
+
+
+ SUBROUTINE kiss_gamma(gamr,k)
+ !! --------------------------------------------------------------------
+ !! *** ROUTINE kiss_gamma ***
+ !!
+ !! ** Purpose : Real random numbers with Gamma distribution Gamma(k,1)
+ !!
+ !! --------------------------------------------------------------------
+ IMPLICIT NONE
+ REAL(KIND=wp), PARAMETER :: p1 = 4.5_8
+ REAL(KIND=wp), PARAMETER :: p2 = 2.50407739677627_8 ! 1+LOG(9/2)
+ REAL(KIND=wp), PARAMETER :: p3 = 1.38629436111989_8 ! LOG(4)
+ REAL(KIND=wp) :: gamr, k, u1, u2, b, c, d, xx, yy, zz, rr, ee
+ LOGICAL :: accepted
+
+ IF (k.GT.one) THEN
+ ! Cheng's rejection algorithm
+ ! (see Devroye, Non-Uniform Random Variate Generation, p. 413)
+ b = k - p3 ; d = SQRT(two*k-one) ; c = k + d
+
+ accepted=.FALSE.
+ DO WHILE (.NOT.accepted)
+ CALL kiss_uniform(u1)
+ yy = LOG(u1/(one-u1)) / d ! Mistake in Devroye: "* k" instead of "/ d"
+ xx = k * EXP(yy)
+ rr = b + c * yy - xx
+ CALL kiss_uniform(u2)
+ zz = u1 * u1 * u2
+
+ accepted = rr .GE. (zz*p1-p2)
+ IF (.NOT.accepted) accepted = rr .GE. LOG(zz)
+ ENDDO
+
+ gamr = xx
+
+ ELSEIF (k.LT.one) THEN
+ ! Rejection from the Weibull density
+ ! (see Devroye, Non-Uniform Random Variate Generation, p. 415)
+ c = one/k ; d = (one-k) * EXP( (k/(one-k)) * LOG(k) )
+
+ accepted=.FALSE.
+ DO WHILE (.NOT.accepted)
+ CALL kiss_uniform(u1)
+ zz = -LOG(u1)
+ xx = EXP( c * LOG(zz) )
+ CALL kiss_uniform(u2)
+ ee = -LOG(u2)
+
+ accepted = (zz+ee) .GE. (d+xx) ! Mistake in Devroye: "LE" instead of "GE"
+ ENDDO
+
+ gamr = xx
+
+ ELSE
+ ! Exponential distribution
+ CALL kiss_uniform(u1)
+ gamr = -LOG(u1)
+
+ ENDIF
+
+ END SUBROUTINE kiss_gamma
+
+
+ SUBROUTINE kiss_sample(a,n,k)
+ !! --------------------------------------------------------------------
+ !! *** ROUTINE kiss_sample ***
+ !!
+ !! ** Purpose : Select a random sample of size k from a set of n integers
+ !!
+ !! ** Method : The sample is output in the first k elements of a
+ !! Set k equal to n to obtain a random permutation
+ !! of the whole set of integers
+ !!
+ !! --------------------------------------------------------------------
+ IMPLICIT NONE
+ INTEGER(KIND=i8), DIMENSION(:) :: a
+ INTEGER(KIND=i8) :: n, k, i, j, atmp
+ REAL(KIND=wp) :: uran
+
+ ! Select the sample using the swapping method
+ ! (see Devroye, Non-Uniform Random Variate Generation, p. 612)
+ DO i=1,k
+ ! Randomly select the swapping element between i and n (inclusive)
+ CALL kiss_uniform(uran)
+ j = i - 1 + CEILING( REAL(n-i+1,8) * uran )
+ ! Swap elements i and j
+ atmp = a(i) ; a(i) = a(j) ; a(j) = atmp
+ ENDDO
+
+ END SUBROUTINE kiss_sample
+!$AGRIF_END_DO_NOT_TREAT
+END MODULE storng
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90 (revision 5602)
@@ -47,4 +47,6 @@
USE lbclnk ! ocean lateral boundary conditions
USE timing ! Timing
+ USE stopar ! Stochastic T/S fluctuations
+ USE stopts ! Stochastic T/S fluctuations
IMPLICIT NONE
@@ -72,7 +74,7 @@
PUBLIC eos_init ! called by istate module
- ! !!* Namelist (nameos) *
- INTEGER , PUBLIC :: nn_eos = 0 !: = 0/1/2 type of eq. of state and Brunt-Vaisala frequ.
- LOGICAL , PUBLIC :: ln_useCT = .FALSE. ! determine if eos_pt_from_ct is used to compute sst_m
+ ! !!* Namelist (nameos) *
+ INTEGER , PUBLIC :: nn_eos ! = 0/1/2 type of eq. of state and Brunt-Vaisala frequ.
+ LOGICAL , PUBLIC :: ln_useCT ! determine if eos_pt_from_ct is used to compute sst_m
! !!! simplified eos coefficients
@@ -313,7 +315,9 @@
REAL(wp), DIMENSION(jpi,jpj,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 ! - -
+ 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
!!----------------------------------------------------------------------
!
@@ -324,43 +328,108 @@
CASE( -1, 0 ) !== polynomial TEOS-10 / EOS-80 ==!
!
- DO jk = 1, jpkm1
- DO jj = 1, jpj
- DO ji = 1, jpi
- !
- 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_rau0 - 1._wp ) * ztm ! density anomaly (masked)
+ ! 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 jk = 1, jpkm1
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ !
+ ! 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_rau0 - 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 DO
END DO
END DO
- END DO
- !
+ DEALLOCATE(zn0_sto,zn_sto,zsign)
+ ! Non-stochastic equation of state
+ ELSE
+ DO jk = 1, jpkm1
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ !
+ 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_rau0 - 1._wp ) * ztm ! density anomaly (masked)
+ END DO
+ END DO
+ END DO
+ ENDIF
+
CASE( 1 ) !== simplified EOS ==!
!
@@ -1183,4 +1252,6 @@
WRITE(numout,*) ' model uses Conservative Temperature'
WRITE(numout,*) ' Important: model must be initialized with CT and SA fields'
+ ELSE
+ WRITE(numout,*) ' model does not use Conservative Temperature'
ENDIF
ENDIF
@@ -1589,7 +1660,8 @@
END SELECT
!
+ rau0_rcp = rau0 * rcp
r1_rau0 = 1._wp / rau0
r1_rcp = 1._wp / rcp
- r1_rau0_rcp = 1._wp / ( rau0 * rcp )
+ r1_rau0_rcp = 1._wp / rau0_rcp
!
IF(lwp) WRITE(numout,*)
@@ -1597,4 +1669,5 @@
IF(lwp) WRITE(numout,*) ' 1. / rau0 r1_rau0 = ', r1_rau0, ' m^3/kg'
IF(lwp) WRITE(numout,*) ' ocean specific heat rcp = ', rcp , ' J/Kelvin'
+ IF(lwp) WRITE(numout,*) ' rau0 * rcp rau0_rcp = ', rau0_rcp
IF(lwp) WRITE(numout,*) ' 1. / ( rau0 * rcp ) r1_rau0_rcp = ', r1_rau0_rcp
!
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90 (revision 5602)
@@ -26,4 +26,5 @@
USE cla ! cross land advection (cla_traadv routine)
USE ldftra_oce ! lateral diffusion coefficient on tracers
+ !
USE in_out_manager ! I/O manager
USE iom ! I/O module
@@ -33,4 +34,5 @@
USE timing ! Timing
USE sbc_oce
+ USE diaptr ! Poleward heat transport
@@ -111,16 +113,20 @@
!
IF( ln_mle ) CALL tra_adv_mle( kt, nit000, zun, zvn, zwn, 'TRA' ) ! add the mle transport (if necessary)
+ !
CALL iom_put( "uocetr_eff", zun ) ! output effective transport
CALL iom_put( "vocetr_eff", zvn )
CALL iom_put( "wocetr_eff", zwn )
-
+ !
+ IF( ln_diaptr ) CALL dia_ptr( zvn ) ! diagnose the effective MSF
+ !
+
SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==!
- CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, nit000, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! 2nd order centered
- CASE ( 2 ) ; CALL tra_adv_tvd ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD
- CASE ( 3 ) ; CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts, ln_traadv_msc_ups ) ! MUSCL
- CASE ( 4 ) ; CALL tra_adv_muscl2( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! MUSCL2
- CASE ( 5 ) ; CALL tra_adv_ubs ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! UBS
- CASE ( 6 ) ; CALL tra_adv_qck ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! QUICKEST
- CASE ( 7 ) ; CALL tra_adv_tvd_zts( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD ZTS
+ CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, nit000, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! 2nd order centered
+ CASE ( 2 ) ; CALL tra_adv_tvd ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD
+ CASE ( 3 ) ; CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts, ln_traadv_msc_ups ) ! MUSCL
+ CASE ( 4 ) ; CALL tra_adv_muscl2 ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! MUSCL2
+ CASE ( 5 ) ; CALL tra_adv_ubs ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! UBS
+ CASE ( 6 ) ; CALL tra_adv_qck ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! QUICKEST
+ CASE ( 7 ) ; CALL tra_adv_tvd_zts( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD ZTS
!
CASE (-1 ) !== esopa: test all possibility with control print ==!
@@ -206,6 +212,6 @@
IF( lk_esopa ) ioptio = 1
- IF( ( ln_traadv_muscl .OR. ln_traadv_muscl2 .OR. ln_traadv_ubs .OR. ln_traadv_qck ) .AND. nn_isf .NE. 0 ) &
- & CALL ctl_stop( 'Only traadv_cen2 and traadv_tvd is compatible with ice shelf cavity')
+ IF( ( ln_traadv_muscl .OR. ln_traadv_muscl2 .OR. ln_traadv_ubs .OR. ln_traadv_qck .OR. ln_traadv_tvd_zts ) &
+ .AND. ln_isfcav ) CALL ctl_stop( 'Only traadv_cen2 and traadv_tvd is compatible with ice shelf cavity')
IF( ioptio /= 1 ) CALL ctl_stop( 'Choose ONE advection scheme in namelist namtra_adv' )
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90 (revision 5602)
@@ -279,7 +279,7 @@
END IF
! ! "Poleward" heat and salt transports (contribution of upstream fluxes)
- IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN
- IF( jn == jp_tem ) htr_adv(:) = ptr_vj( zwy(:,:,:) )
- IF( jn == jp_sal ) str_adv(:) = ptr_vj( zwy(:,:,:) )
+ IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
+ IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) )
+ IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) )
ENDIF
!
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90 (revision 5602)
@@ -53,5 +53,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 4.0 , NEMO Consortium (2011)
- !! $Id:$
+ !! $Id$
!! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90 (revision 5602)
@@ -21,5 +21,5 @@
USE trdtra ! tracers trends manager
USE dynspg_oce ! choice/control of key cpp for surface pressure gradient
- USE sbcrnf ! river runoffs
+ USE sbcrnf ! river runoffs
USE diaptr ! poleward transport diagnostics
!
@@ -219,7 +219,7 @@
END IF
! ! "Poleward" heat and salt transports (contribution of upstream fluxes)
- IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN
- IF( jn == jp_tem ) htr_adv(:) = ptr_vj( zwy(:,:,:) )
- IF( jn == jp_sal ) str_adv(:) = ptr_vj( zwy(:,:,:) )
+ IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
+ IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) )
+ IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) )
ENDIF
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90 (revision 5602)
@@ -200,7 +200,7 @@
! ! "Poleward" heat and salt transports (contribution of upstream fluxes)
- IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN
- IF( jn == jp_tem ) htr_adv(:) = ptr_vj( zwy(:,:,:) )
- IF( jn == jp_sal ) str_adv(:) = ptr_vj( zwy(:,:,:) )
+ IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
+ IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) )
+ IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) )
ENDIF
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90 (revision 5602)
@@ -355,7 +355,7 @@
IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) )
! ! "Poleward" heat and salt transports (contribution of upstream fluxes)
- IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN
- IF( jn == jp_tem ) htr_adv(:) = ptr_vj( zwy(:,:,:) )
- IF( jn == jp_sal ) str_adv(:) = ptr_vj( zwy(:,:,:) )
+ IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
+ IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) )
+ IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) )
ENDIF
!
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90 (revision 5602)
@@ -106,14 +106,15 @@
ENDIF
!
- zwi(:,:,:) = 0.e0 ; zwz(:,:,:) = 0.e0
+ zwi(:,:,:) = 0.e0 ;
!
! ! ===========
DO jn = 1, kjpt ! tracer loop
! ! ===========
- ! 1. Bottom value : flux set to zero
+ ! 1. Bottom and k=1 value : flux set to zero
! ----------------------------------
zwx(:,:,jpk) = 0.e0 ; zwz(:,:,jpk) = 0.e0
zwy(:,:,jpk) = 0.e0 ; zwi(:,:,jpk) = 0.e0
-
+
+ zwz(:,:,1 ) = 0._wp
! 2. upstream advection with initial mass fluxes & intermediate update
! --------------------------------------------------------------------
@@ -134,28 +135,36 @@
! upstream tracer flux in the k direction
+ ! Interior value
+ DO jk = 2, jpkm1
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )
+ zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )
+ zwz(ji,jj,jk) = 0.5 * ( zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn) ) * wmask(ji,jj,jk)
+ END DO
+ END DO
+ END DO
! Surface value
IF( lk_vvl ) THEN
- DO jj = 1, jpj
- DO ji = 1, jpi
- zwz(ji,jj, mikt(ji,jj) ) = 0.e0 ! volume variable
- END DO
- END DO
+ IF ( ln_isfcav ) THEN
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ zwz(ji,jj, mikt(ji,jj) ) = 0.e0 ! volume variable
+ END DO
+ END DO
+ ELSE
+ zwz(:,:,1) = 0.e0 ! volume variable
+ END IF
ELSE
- DO jj = 1, jpj
- DO ji = 1, jpi
- zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn) ! linear free surface
- END DO
- END DO
+ IF ( ln_isfcav ) THEN
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn) ! linear free surface
+ END DO
+ END DO
+ ELSE
+ zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn) ! linear free surface
+ END IF
ENDIF
- ! Interior value
- DO jj = 1, jpj
- DO ji = 1, jpi
- DO jk = mikt(ji,jj)+1, jpkm1
- zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )
- zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )
- zwz(ji,jj,jk) = 0.5 * ( zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn) )
- END DO
- END DO
- END DO
! total advective trend
@@ -184,7 +193,7 @@
END IF
! ! "Poleward" heat and salt transports (contribution of upstream fluxes)
- IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN
- IF( jn == jp_tem ) htr_adv(:) = ptr_vj( zwy(:,:,:) )
- IF( jn == jp_sal ) str_adv(:) = ptr_vj( zwy(:,:,:) )
+ IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
+ IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) )
+ IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) )
ENDIF
@@ -202,17 +211,22 @@
! antidiffusive flux on k
- zwz(:,:,1) = 0.e0 ! Surface value
- !
- DO jj = 1, jpj
- DO ji = 1, jpi
- ik=mikt(ji,jj)
- ! surface value
- zwz(ji,jj,1:ik) = 0.e0
- ! Interior value
- DO jk = mikt(ji,jj)+1, jpkm1
+ ! Interior value
+ DO jk = 2, jpkm1
+ DO jj = 1, jpj
+ DO ji = 1, jpi
zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) - zwz(ji,jj,jk)
END DO
END DO
END DO
+ ! surface value
+ IF ( ln_isfcav ) THEN
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ zwz(ji,jj,mikt(ji,jj)) = 0.e0
+ END DO
+ END DO
+ ELSE
+ zwz(:,:,1) = 0.e0
+ END IF
CALL lbc_lnk( zwx, 'U', -1. ) ; CALL lbc_lnk( zwy, 'V', -1. ) ! Lateral bondary conditions
CALL lbc_lnk( zwz, 'W', 1. )
@@ -250,7 +264,7 @@
END IF
! ! "Poleward" heat and salt transports (contribution of upstream fluxes)
- IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN
- IF( jn == jp_tem ) htr_adv(:) = ptr_vj( zwy(:,:,:) ) + htr_adv(:)
- IF( jn == jp_sal ) str_adv(:) = ptr_vj( zwy(:,:,:) ) + str_adv(:)
+ IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
+ IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:)
+ IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:)
ENDIF
!
@@ -358,8 +372,4 @@
! upstream tracer flux in the k direction
- ! Surface value
- IF( lk_vvl ) THEN ; zwz(:,:, 1 ) = 0._wp ! volume variable
- ELSE ; zwz(:,:, 1 ) = pwn(:,:,1) * ptb(:,:,1,jn) ! linear free surface
- ENDIF
! Interior value
DO jk = 2, jpkm1
@@ -372,4 +382,26 @@
END DO
END DO
+ ! Surface value
+ IF( lk_vvl ) THEN
+ IF ( ln_isfcav ) THEN
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ zwz(ji,jj, mikt(ji,jj) ) = 0.e0 ! volume variable + isf
+ END DO
+ END DO
+ ELSE
+ zwz(:,:,1) = 0.e0 ! volume variable + no isf
+ END IF
+ ELSE
+ IF ( ln_isfcav ) THEN
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn) ! linear free surface + isf
+ END DO
+ END DO
+ ELSE
+ zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn) ! linear free surface + no isf
+ END IF
+ ENDIF
! total advective trend
@@ -398,7 +430,7 @@
END IF
! ! "Poleward" heat and salt transports (contribution of upstream fluxes)
- IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN
- IF( jn == jp_tem ) htr_adv(:) = ptr_vj( zwy(:,:,:) )
- IF( jn == jp_sal ) str_adv(:) = ptr_vj( zwy(:,:,:) )
+ IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
+ IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) )
+ IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) )
ENDIF
@@ -524,7 +556,7 @@
END IF
! ! "Poleward" heat and salt transports (contribution of upstream fluxes)
- IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN
- IF( jn == jp_tem ) htr_adv(:) = ptr_vj( zwy(:,:,:) ) + htr_adv(:)
- IF( jn == jp_sal ) str_adv(:) = ptr_vj( zwy(:,:,:) ) + str_adv(:)
+ IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
+ IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:)
+ IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:)
ENDIF
!
@@ -580,10 +612,10 @@
& paft * tmask + zbig * ( 1._wp - tmask ) )
- DO jj = 2, jpjm1
- DO ji = fs_2, fs_jpim1 ! vector opt.
- DO jk = mikt(ji,jj), jpkm1
- ikm1 = MAX(jk-1,mikt(ji,jj))
- z2dtt = p2dt(jk)
-
+ DO jk = 1, jpkm1
+ ikm1 = MAX(jk-1,1)
+ z2dtt = p2dt(jk)
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
+
! search maximum in neighbourhood
zup = MAX( zbup(ji ,jj ,jk ), &
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90 (revision 5602)
@@ -177,7 +177,7 @@
END IF
! ! "Poleward" heat and salt transports (contribution of upstream fluxes)
- IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN
- IF( jn == jp_tem ) htr_adv(:) = ptr_vj( ztv(:,:,:) )
- IF( jn == jp_sal ) str_adv(:) = ptr_vj( ztv(:,:,:) )
+ IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
+ IF( jn == jp_tem ) htr_adv(:) = ptr_sj( ztv(:,:,:) )
+ IF( jn == jp_sal ) str_adv(:) = ptr_sj( ztv(:,:,:) )
ENDIF
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90 (revision 5602)
@@ -21,4 +21,8 @@
USE trdtra ! trends manager: tracers
USE in_out_manager ! I/O manager
+ USE iom ! I/O manager
+ USE fldread ! read input fields
+ USE lbclnk ! ocean lateral boundary conditions (or mpp link)
+ USE lib_mpp ! distributed memory computing library
USE prtctl ! Print control
USE wrk_nemo ! Memory Allocation
@@ -37,4 +41,5 @@
REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: qgh_trd0 ! geothermal heating trend
+ TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_qgh ! structure of input qgh (file informations, fields read)
!! * Substitutions
@@ -42,5 +47,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2010)
- !! $Id $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
@@ -92,4 +97,6 @@
END DO
!
+ CALL lbc_lnk( tsa(:,:,:,jp_tem) , 'T', 1. )
+ !
IF( l_trdtra ) THEN ! Save the geothermal heat flux trend for diagnostics
ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
@@ -125,6 +132,10 @@
INTEGER :: inum ! temporary logical unit
INTEGER :: ios ! Local integer output status for namelist read
- !
- NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst
+ INTEGER :: ierror ! local integer
+ !
+ TYPE(FLD_N) :: sn_qgh ! informations about the geotherm. field to be read
+ CHARACTER(len=256) :: cn_dir ! Root directory for location of ssr files
+ !
+ NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst, sn_qgh, cn_dir
!!----------------------------------------------------------------------
@@ -161,8 +172,18 @@
CASE ( 2 ) !* variable geothermal heat flux : read the geothermal fluxes in mW/m2
IF(lwp) WRITE(numout,*) ' *** variable geothermal heat flux'
- CALL iom_open ( 'geothermal_heating.nc', inum )
- CALL iom_get ( inum, jpdom_data, 'heatflow', qgh_trd0 )
- CALL iom_close( inum )
- qgh_trd0(:,:) = r1_rau0_rcp * qgh_trd0(:,:) * 1.e-3 ! conversion in W/m2
+ !
+ ALLOCATE( sf_qgh(1), STAT=ierror )
+ IF( ierror > 0 ) THEN
+ CALL ctl_stop( 'tra_bbc_init: unable to allocate sf_qgh structure' ) ;
+ RETURN
+ ENDIF
+ ALLOCATE( sf_qgh(1)%fnow(jpi,jpj,1) )
+ IF( sn_qgh%ln_tint )ALLOCATE( sf_qgh(1)%fdta(jpi,jpj,1,2) )
+ ! fill sf_chl with sn_chl and control print
+ CALL fld_fill( sf_qgh, (/ sn_qgh /), cn_dir, 'tra_bbc_init', &
+ & 'bottom temperature boundary condition', 'nambbc' )
+
+ CALL fld_read( nit000, 1, sf_qgh ) ! Read qgh data
+ qgh_trd0(:,:) = r1_rau0_rcp * sf_qgh(1)%fnow(:,:,1) * 1.e-3 ! conversion in W/m2
!
CASE DEFAULT
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90 (revision 5602)
@@ -21,7 +21,4 @@
!! tra_dmp : update the tracer trend with the internal damping
!! tra_dmp_init : initialization, namlist read, parameters control
- !! dtacof_zoom : restoring coefficient for zoom domain
- !! dtacof : restoring coefficient for global domain
- !! cofdis : compute the distance to the coastline
!!----------------------------------------------------------------------
USE oce ! ocean: variables
@@ -39,4 +36,5 @@
USE wrk_nemo ! Memory allocation
USE timing ! Timing
+ USE iom
IMPLICIT NONE
@@ -45,17 +43,12 @@
PUBLIC tra_dmp ! routine called by step.F90
PUBLIC tra_dmp_init ! routine called by opa.F90
- PUBLIC dtacof ! routine called by tradmp.F90, trcdmp.F90 and dyndmp.F90
- PUBLIC dtacof_zoom ! routine called by tradmp.F90, trcdmp.F90 and dyndmp.F90
-
-!!gm why all namelist variable public???? only ln_tradmp should be sufficient
! !!* Namelist namtra_dmp : T & S newtonian damping *
+ ! nn_zdmp and cn_resto are public as they are used by C1D/dyndmp.F90
LOGICAL , PUBLIC :: ln_tradmp !: internal damping flag
- INTEGER , PUBLIC :: nn_hdmp ! = 0/-1/'latitude' for damping over T and S
INTEGER , PUBLIC :: nn_zdmp ! = 0/1/2 flag for damping in the mixed layer
- REAL(wp), PUBLIC :: rn_surf ! surface time scale for internal damping [days]
- REAL(wp), PUBLIC :: rn_bot ! bottom time scale for internal damping [days]
- REAL(wp), PUBLIC :: rn_dep ! depth of transition between rn_surf and rn_bot [meters]
- INTEGER , PUBLIC :: nn_file ! = 1 create a damping.coeff NetCDF file
+ CHARACTER(LEN=200) , PUBLIC :: cn_resto ! name of netcdf file containing restoration coefficient field
+ !
+
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: strdmp !: damping salinity trend (psu/s)
@@ -197,623 +190,60 @@
!! ** Method : read the namtra_dmp namelist and check the parameters
!!----------------------------------------------------------------------
- INTEGER :: ios ! Local integer output status for namelist read
- !!
- NAMELIST/namtra_dmp/ ln_tradmp, nn_hdmp, nn_zdmp, rn_surf, rn_bot, rn_dep, nn_file
- !!----------------------------------------------------------------------
- !
- REWIND( numnam_ref ) ! Namelist namtra_dmp in reference namelist : Temperature and salinity damping term
+ NAMELIST/namtra_dmp/ ln_tradmp, nn_zdmp, cn_resto
+ INTEGER :: ios ! Local integer for output status of namelist read
+ INTEGER :: imask ! File handle
+ !!
+ !!----------------------------------------------------------------------
+ !
+ REWIND( numnam_ref ) ! Namelist namtra_dmp in reference namelist : T & S relaxation
READ ( numnam_ref, namtra_dmp, IOSTAT = ios, ERR = 901)
901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in reference namelist', lwp )
!
- REWIND( numnam_cfg ) ! Namelist namtra_dmp in configuration namelist : Temperature and salinity damping term
+ REWIND( numnam_cfg ) ! Namelist namtra_dmp in configuration namelist : T & S relaxation
READ ( numnam_cfg, namtra_dmp, IOSTAT = ios, ERR = 902 )
902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in configuration namelist', lwp )
IF(lwm) WRITE ( numond, namtra_dmp )
-
- IF( lzoom .AND. .NOT. lk_c1d ) nn_zdmp = 0 ! restoring to climatology at closed north or south boundaries
-
- IF(lwp) THEN ! Namelist print
+
+ IF(lwp) THEN !Namelist print
WRITE(numout,*)
- WRITE(numout,*) 'tra_dmp_init : T and S newtonian damping'
+ WRITE(numout,*) 'tra_dmp_init : T and S newtonian relaxation'
WRITE(numout,*) '~~~~~~~'
- WRITE(numout,*) ' Namelist namtra_dmp : set damping parameter'
- WRITE(numout,*) ' add a damping term or not ln_tradmp = ', ln_tradmp
- WRITE(numout,*) ' T and S damping option nn_hdmp = ', nn_hdmp
- WRITE(numout,*) ' mixed layer damping option nn_zdmp = ', nn_zdmp, '(non-C1D zoom: forced to 0)'
- WRITE(numout,*) ' surface time scale (days) rn_surf = ', rn_surf
- WRITE(numout,*) ' bottom time scale (days) rn_bot = ', rn_bot
- WRITE(numout,*) ' depth of transition (meters) rn_dep = ', rn_dep
- WRITE(numout,*) ' create a damping.coeff file nn_file = ', nn_file
+ 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 ! initialization for T-S damping
- !
+ IF( ln_tradmp) THEN
+ !
+ !Allocate arrays
IF( tra_dmp_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'tra_dmp_init: unable to allocate arrays' )
- !
-!!gm I don't understand the specificities of c1d case......
-!!gm to be check with the autor of these lines
-
-#if ! defined key_c1d
- SELECT CASE ( nn_hdmp )
- CASE ( -1 ) ; IF(lwp) WRITE(numout,*) ' tracer damping in the Med & Red seas only'
- CASE ( 1:90 ) ; IF(lwp) WRITE(numout,*) ' tracer damping poleward of', nn_hdmp, ' degrees'
- CASE DEFAULT
- WRITE(ctmp1,*) ' bad flag value for nn_hdmp = ', nn_hdmp
- CALL ctl_stop(ctmp1)
+
+ !Check values of nn_zdmp
+ SELECT CASE (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 turbocline'
+ CASE ( 2 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the mixed layer'
END SELECT
- !
-#endif
- SELECT CASE ( nn_zdmp )
- CASE ( 0 ) ; IF(lwp) WRITE(numout,*) ' tracer damping throughout the water column'
- CASE ( 1 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the turbocline (avt > 5 cm2/s)'
- CASE ( 2 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the mixed layer'
- CASE DEFAULT
- WRITE(ctmp1,*) 'bad flag value for nn_zdmp = ', nn_zdmp
- CALL ctl_stop(ctmp1)
- END SELECT
- !
+
+ !TG: Initialisation of dtatsd - Would it be better to have dmpdta routine
+ !so can damp to something other than intitial conditions files?
IF( .NOT.ln_tsd_tradmp ) THEN
CALL ctl_warn( 'tra_dmp_init: read T-S data not initialized, we force ln_tsd_tradmp=T' )
CALL dta_tsd_init( ld_tradmp=ln_tradmp ) ! forces the initialisation of T-S data
ENDIF
- !
- strdmp(:,:,:) = 0._wp ! internal damping salinity trend (used in asmtrj)
+
+ !initialise arrays - Are these actually used anywhere else?
+ strdmp(:,:,:) = 0._wp
ttrdmp(:,:,:) = 0._wp
- ! ! Damping coefficients initialization
- IF( lzoom .AND. .NOT. lk_c1d ) THEN ; CALL dtacof_zoom( resto )
- ELSE ; CALL dtacof( nn_hdmp, rn_surf, rn_bot, rn_dep, nn_file, 'TRA', resto )
- ENDIF
- !
- ENDIF
- !
+
+ !Read in mask from file
+ CALL iom_open ( cn_resto, imask)
+ CALL iom_get ( imask, jpdom_autoglo, 'resto', resto)
+ CALL iom_close( imask )
+ ENDIF
+
END SUBROUTINE tra_dmp_init
-
- SUBROUTINE dtacof_zoom( presto )
- !!----------------------------------------------------------------------
- !! *** ROUTINE dtacof_zoom ***
- !!
- !! ** Purpose : Compute the damping coefficient for zoom domain
- !!
- !! ** Method : - set along closed boundary due to zoom a damping over
- !! 6 points with a max time scale of 5 days.
- !! - ORCA arctic/antarctic zoom: set the damping along
- !! south/north boundary over a latitude strip.
- !!
- !! ** Action : - resto, the damping coeff. for T and S
- !!----------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: presto ! restoring coeff. (s-1)
- !
- INTEGER :: ji, jj, jk, jn ! dummy loop indices
- REAL(wp) :: zlat, zlat0, zlat1, zlat2, z1_5d ! local scalar
- REAL(wp), DIMENSION(6) :: zfact ! 1Dworkspace
- !!----------------------------------------------------------------------
- !
- IF( nn_timing == 1 ) CALL timing_start( 'dtacof_zoom')
- !
-
- zfact(1) = 1._wp
- zfact(2) = 1._wp
- zfact(3) = 11._wp / 12._wp
- zfact(4) = 8._wp / 12._wp
- zfact(5) = 4._wp / 12._wp
- zfact(6) = 1._wp / 12._wp
- zfact(:) = zfact(:) / ( 5._wp * rday ) ! 5 days max restoring time scale
-
- presto(:,:,:) = 0._wp
-
- ! damping along the forced closed boundary over 6 grid-points
- DO jn = 1, 6
- IF( lzoom_w ) presto( mi0(jn+jpizoom):mi1(jn+jpizoom), : , : ) = zfact(jn) ! west closed
- IF( lzoom_s ) presto( : , mj0(jn+jpjzoom):mj1(jn+jpjzoom), : ) = zfact(jn) ! south closed
- IF( lzoom_e ) presto( mi0(jpiglo+jpizoom-1-jn):mi1(jpiglo+jpizoom-1-jn) , : , : ) = zfact(jn) ! east closed
- IF( lzoom_n ) presto( : , mj0(jpjglo+jpjzoom-1-jn):mj1(jpjglo+jpjzoom-1-jn) , : ) = zfact(jn) ! north closed
- END DO
-
- ! ! ====================================================
- IF( cp_cfz == "arctic" .OR. cp_cfz == "antarctic" ) THEN ! ORCA configuration : arctic or antarctic zoom
- ! ! ====================================================
- IF(lwp) WRITE(numout,*)
- IF(lwp .AND. cp_cfz == "arctic" ) WRITE(numout,*) ' dtacof_zoom : ORCA Arctic zoom'
- IF(lwp .AND. cp_cfz == "antarctic" ) WRITE(numout,*) ' dtacof_zoom : ORCA Antarctic zoom'
- IF(lwp) WRITE(numout,*)
- !
- ! ! Initialization :
- presto(:,:,:) = 0._wp
- zlat0 = 10._wp ! zlat0 : latitude strip where resto decreases
- zlat1 = 30._wp ! zlat1 : resto = 1 before zlat1
- zlat2 = zlat1 + zlat0 ! zlat2 : resto decreases from 1 to 0 between zlat1 and zlat2
- z1_5d = 1._wp / ( 5._wp * rday ) ! z1_5d : 1 / 5days
-
- DO jk = 2, jpkm1 ! Compute arrays resto ; value for internal damping : 5 days
- DO jj = 1, jpj
- DO ji = 1, jpi
- zlat = ABS( gphit(ji,jj) )
- IF( zlat1 <= zlat .AND. zlat <= zlat2 ) THEN
- presto(ji,jj,jk) = 0.5_wp * z1_5d * ( 1._wp - COS( rpi*(zlat2-zlat)/zlat0 ) )
- ELSEIF( zlat < zlat1 ) THEN
- presto(ji,jj,jk) = z1_5d
- ENDIF
- END DO
- END DO
- END DO
- !
- ENDIF
- ! ! Mask resto array
- presto(:,:,:) = presto(:,:,:) * tmask(:,:,:)
- !
- IF( nn_timing == 1 ) CALL timing_stop( 'dtacof_zoom')
- !
- END SUBROUTINE dtacof_zoom
-
-
- SUBROUTINE dtacof( kn_hdmp, pn_surf, pn_bot, pn_dep, &
- & kn_file, cdtype , presto )
- !!----------------------------------------------------------------------
- !! *** ROUTINE dtacof ***
- !!
- !! ** Purpose : Compute the damping coefficient
- !!
- !! ** Method : Arrays defining the damping are computed for each grid
- !! point for temperature and salinity (resto)
- !! Damping depends on distance to coast, depth and latitude
- !!
- !! ** Action : - resto, the damping coeff. for T and S
- !!----------------------------------------------------------------------
- USE iom
- USE ioipsl
- !!
- INTEGER , INTENT(in ) :: kn_hdmp ! damping option
- REAL(wp) , INTENT(in ) :: pn_surf ! surface time scale (days)
- REAL(wp) , INTENT(in ) :: pn_bot ! bottom time scale (days)
- REAL(wp) , INTENT(in ) :: pn_dep ! depth of transition (meters)
- INTEGER , INTENT(in ) :: kn_file ! save the damping coef on a file or not
- CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA, TRC or DYN (tracer/dynamics indicator)
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: presto ! restoring coeff. (s-1)
- !
- INTEGER :: ji, jj, jk ! dummy loop indices
- INTEGER :: ii0, ii1, ij0, ij1 ! local integers
- INTEGER :: inum0, icot ! - -
- REAL(wp) :: zinfl, zlon ! local scalars
- REAL(wp) :: zlat, zlat0, zlat1, zlat2 ! - -
- REAL(wp) :: zsdmp, zbdmp ! - -
- CHARACTER(len=20) :: cfile
- REAL(wp), POINTER, DIMENSION(: ) :: zhfac
- REAL(wp), POINTER, DIMENSION(:,: ) :: zmrs
- REAL(wp), POINTER, DIMENSION(:,:,:) :: zdct
- !!----------------------------------------------------------------------
- !
- IF( nn_timing == 1 ) CALL timing_start('dtacof')
- !
- CALL wrk_alloc( jpk, zhfac )
- CALL wrk_alloc( jpi, jpj, zmrs )
- CALL wrk_alloc( jpi, jpj, jpk, zdct )
-#if defined key_c1d
- ! ! ====================
- ! ! C1D configuration : local domain
- ! ! ====================
- !
- IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*) ' dtacof : C1D 3x3 local domain'
- IF(lwp) WRITE(numout,*) ' -----------------------------'
- !
- presto(:,:,:) = 0._wp
- !
- zsdmp = 1._wp / ( pn_surf * rday )
- zbdmp = 1._wp / ( pn_bot * rday )
- DO jk = 2, jpkm1
- DO jj = 1, jpj
- DO ji = 1, jpi
- ! ONLY vertical variation from zsdmp (sea surface) to zbdmp (bottom)
- presto(ji,jj,jk) = zbdmp + (zsdmp-zbdmp) * EXP(-fsdept(ji,jj,jk)/pn_dep)
- END DO
- END DO
- END DO
- !
- presto(:,:, : ) = presto(:,:,:) * tmask(:,:,:)
-#else
- ! ! ====================
- ! ! ORCA configuration : global domain
- ! ! ====================
- !
- IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*) ' dtacof : Global domain of ORCA'
- IF(lwp) WRITE(numout,*) ' ------------------------------'
- !
- presto(:,:,:) = 0._wp
- !
- IF( kn_hdmp > 0 ) THEN ! Damping poleward of 'nn_hdmp' degrees !
- ! !-----------------------------------------!
- IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*) ' Damping poleward of ', kn_hdmp, ' deg.'
- !
- CALL iom_open ( 'dist.coast.nc', icot, ldstop = .FALSE. )
- !
- IF( icot > 0 ) THEN ! distance-to-coast read in file
- CALL iom_get ( icot, jpdom_data, 'Tcoast', zdct )
- CALL iom_close( icot )
- ELSE ! distance-to-coast computed and saved in file (output in zdct)
- CALL cofdis( zdct )
- ENDIF
-
- ! ! Compute arrays resto
- zinfl = 1000.e3_wp ! distance of influence for damping term
- zlat0 = 10._wp ! latitude strip where resto decreases
- zlat1 = REAL( kn_hdmp ) ! resto = 0 between -zlat1 and zlat1
- zlat2 = zlat1 + zlat0 ! resto increases from 0 to 1 between |zlat1| and |zlat2|
-
- DO jj = 1, jpj
- DO ji = 1, jpi
- zlat = ABS( gphit(ji,jj) )
- IF ( zlat1 <= zlat .AND. zlat <= zlat2 ) THEN
- presto(ji,jj,1) = 0.5_wp * ( 1._wp - COS( rpi*(zlat-zlat1)/zlat0 ) )
- ELSEIF ( zlat > zlat2 ) THEN
- presto(ji,jj,1) = 1._wp
- ENDIF
- END DO
- END DO
-
- IF ( kn_hdmp == 20 ) THEN ! North Indian ocean (20N/30N x 45E/100E) : resto=0
- DO jj = 1, jpj
- DO ji = 1, jpi
- zlat = gphit(ji,jj)
- zlon = MOD( glamt(ji,jj), 360._wp )
- IF ( zlat1 < zlat .AND. zlat < zlat2 .AND. 45._wp < zlon .AND. zlon < 100._wp ) THEN
- presto(ji,jj,1) = 0._wp
- ENDIF
- END DO
- END DO
- ENDIF
-
- zsdmp = 1._wp / ( pn_surf * rday )
- zbdmp = 1._wp / ( pn_bot * rday )
- DO jk = 2, jpkm1
- DO jj = 1, jpj
- DO ji = 1, jpi
- zdct(ji,jj,jk) = MIN( zinfl, zdct(ji,jj,jk) )
- ! ... Decrease the value in the vicinity of the coast
- presto(ji,jj,jk) = presto(ji,jj,1 ) * 0.5_wp * ( 1._wp - COS( rpi*zdct(ji,jj,jk)/zinfl) )
- ! ... Vertical variation from zsdmp (sea surface) to zbdmp (bottom)
- presto(ji,jj,jk) = presto(ji,jj,jk) * ( zbdmp + (zsdmp-zbdmp) * EXP(-fsdept(ji,jj,jk)/pn_dep) )
- END DO
- END DO
- END DO
- !
- ENDIF
-
- ! ! =========================
- ! ! Med and Red Sea damping (ORCA configuration only)
- ! ! =========================
- IF( cp_cfg == "orca" .AND. ( kn_hdmp > 0 .OR. kn_hdmp == -1 ) ) THEN
- IF(lwp)WRITE(numout,*)
- IF(lwp)WRITE(numout,*) ' ORCA configuration: Damping in Med and Red Seas'
- !
- zmrs(:,:) = 0._wp
- !
- SELECT CASE ( jp_cfg )
- ! ! =======================
- CASE ( 4 ) ! ORCA_R4 configuration
- ! ! =======================
- ij0 = 50 ; ij1 = 56 ! Mediterranean Sea
-
- ii0 = 81 ; ii1 = 91 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp
- ij0 = 50 ; ij1 = 55
- ii0 = 75 ; ii1 = 80 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp
- ij0 = 52 ; ij1 = 53
- ii0 = 70 ; ii1 = 74 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp
- ! Smooth transition from 0 at surface to 1./rday at the 18th level in Med and Red Sea
- DO jk = 1, 17
- zhfac (jk) = 0.5_wp * ( 1._wp - COS( rpi * REAL(jk-1,wp) / 16._wp ) ) / rday
- END DO
- DO jk = 18, jpkm1
- zhfac (jk) = 1._wp / rday
- END DO
- ! ! =======================
- CASE ( 2 ) ! ORCA_R2 configuration
- ! ! =======================
- ij0 = 96 ; ij1 = 110 ! Mediterranean Sea
- ii0 = 157 ; ii1 = 181 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp
- ij0 = 100 ; ij1 = 110
- ii0 = 144 ; ii1 = 156 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp
- ij0 = 100 ; ij1 = 103
- ii0 = 139 ; ii1 = 143 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp
- !
- ij0 = 101 ; ij1 = 102 ! Decrease before Gibraltar Strait
- ii0 = 139 ; ii1 = 141 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0._wp
- ii0 = 142 ; ii1 = 142 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp / 90._wp
- ii0 = 143 ; ii1 = 143 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40_wp
- ii0 = 144 ; ii1 = 144 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.75_wp
- !
- ij0 = 87 ; ij1 = 96 ! Red Sea
- ii0 = 147 ; ii1 = 163 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp
- !
- ij0 = 91 ; ij1 = 91 ! Decrease before Bab el Mandeb Strait
- ii0 = 153 ; ii1 = 160 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.80_wp
- ij0 = 90 ; ij1 = 90
- ii0 = 153 ; ii1 = 160 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40_wp
- ij0 = 89 ; ij1 = 89
- ii0 = 158 ; ii1 = 160 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp / 90._wp
- ij0 = 88 ; ij1 = 88
- ii0 = 160 ; ii1 = 163 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0._wp
- ! Smooth transition from 0 at surface to 1./rday at the 18th level in Med and Red Sea
- DO jk = 1, 17
- zhfac (jk) = 0.5_wp * ( 1._wp - COS( rpi * REAL(jk-1,wp) / 16._wp ) ) / rday
- END DO
- DO jk = 18, jpkm1
- zhfac (jk) = 1._wp / rday
- END DO
- ! ! =======================
- CASE ( 05 ) ! ORCA_R05 configuration
- ! ! =======================
- ii0 = 568 ; ii1 = 574 ! Mediterranean Sea
- ij0 = 324 ; ij1 = 333 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp
- ii0 = 575 ; ii1 = 658
- ij0 = 314 ; ij1 = 366 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp
- !
- ii0 = 641 ; ii1 = 651 ! Black Sea (remaining part
- ij0 = 367 ; ij1 = 372 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp
- !
- ij0 = 324 ; ij1 = 333 ! Decrease before Gibraltar Strait
- ii0 = 565 ; ii1 = 565 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp / 90._wp
- ii0 = 566 ; ii1 = 566 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40_wp
- ii0 = 567 ; ii1 = 567 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.75_wp
- !
- ii0 = 641 ; ii1 = 665 ! Red Sea
- ij0 = 270 ; ij1 = 310 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp
- !
- ii0 = 666 ; ii1 = 675 ! Decrease before Bab el Mandeb Strait
- ij0 = 270 ; ij1 = 290
- DO ji = mi0(ii0), mi1(ii1)
- zmrs( ji , mj0(ij0):mj1(ij1) ) = 0.1_wp * ABS( FLOAT(ji - mi1(ii1)) )
- END DO
- zsdmp = 1._wp / ( pn_surf * rday )
- zbdmp = 1._wp / ( pn_bot * rday )
- DO jk = 1, jpk
- zhfac(jk) = ( zbdmp + (zsdmp-zbdmp) * EXP( -fsdept(1,1,jk)/pn_dep ) )
- END DO
- ! ! ========================
- CASE ( 025 ) ! ORCA_R025 configuration
- ! ! ========================
- CALL ctl_stop( ' Not yet implemented in ORCA_R025' )
- !
- END SELECT
-
- DO jk = 1, jpkm1
- presto(:,:,jk) = zmrs(:,:) * zhfac(jk) + ( 1._wp - zmrs(:,:) ) * presto(:,:,jk)
- END DO
-
- ! Mask resto array and set to 0 first and last levels
- presto(:,:, : ) = presto(:,:,:) * tmask(:,:,:)
- presto(:,:, 1 ) = 0._wp
- presto(:,:,jpk) = 0._wp
- ! !--------------------!
- ELSE ! No damping !
- ! !--------------------!
- CALL ctl_stop( 'Choose a correct value of nn_hdmp or put ln_tradmp to FALSE' )
- ENDIF
-#endif
-
- ! !--------------------------------!
- IF( kn_file == 1 ) THEN ! save damping coef. in a file !
- ! !--------------------------------!
- IF(lwp) WRITE(numout,*) ' create damping.coeff.nc file'
- IF( cdtype == 'TRA' ) cfile = 'damping.coeff'
- IF( cdtype == 'TRC' ) cfile = 'damping.coeff.trc'
- IF( cdtype == 'DYN' ) cfile = 'damping.coeff.dyn'
- cfile = TRIM( cfile )
- CALL iom_open ( cfile, inum0, ldwrt = .TRUE., kiolib = jprstlib )
- CALL iom_rstput( 0, 0, inum0, 'Resto', presto )
- CALL iom_close ( inum0 )
- ENDIF
- !
- CALL wrk_dealloc( jpk, zhfac)
- CALL wrk_dealloc( jpi, jpj, zmrs )
- CALL wrk_dealloc( jpi, jpj, jpk, zdct )
- !
- IF( nn_timing == 1 ) CALL timing_stop('dtacof')
- !
- END SUBROUTINE dtacof
-
-
- SUBROUTINE cofdis( pdct )
- !!----------------------------------------------------------------------
- !! *** ROUTINE cofdis ***
- !!
- !! ** Purpose : Compute the distance between ocean T-points and the
- !! ocean model coastlines. Save the distance in a NetCDF file.
- !!
- !! ** Method : For each model level, the distance-to-coast is
- !! computed as follows :
- !! - The coastline is defined as the serie of U-,V-,F-points
- !! that are at the ocean-land bound.
- !! - For each ocean T-point, the distance-to-coast is then
- !! computed as the smallest distance (on the sphere) between the
- !! T-point and all the coastline points.
- !! - For land T-points, the distance-to-coast is set to zero.
- !! C A U T I O N : Computation not yet implemented in mpp case.
- !!
- !! ** Action : - pdct, distance to the coastline (argument)
- !! - NetCDF file 'dist.coast.nc'
- !!----------------------------------------------------------------------
- USE ioipsl ! IOipsl librairy
- !!
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) :: pdct ! distance to the coastline
- !!
- INTEGER :: ji, jj, jk, jl ! dummy loop indices
- INTEGER :: iju, ijt, icoast, itime, ierr, icot ! local integers
- CHARACTER (len=32) :: clname ! local name
- REAL(wp) :: zdate0 ! local scalar
- REAL(wp), POINTER, DIMENSION(:,:) :: zxt, zyt, zzt, zmask
- REAL(wp), POINTER, DIMENSION(: ) :: zxc, zyc, zzc, zdis ! temporary workspace
- LOGICAL , ALLOCATABLE, DIMENSION(:,:) :: llcotu, llcotv, llcotf ! 2D logical workspace
- !!----------------------------------------------------------------------
- !
- IF( nn_timing == 1 ) CALL timing_start('cofdis')
- !
- CALL wrk_alloc( jpi, jpj , zxt, zyt, zzt, zmask )
- CALL wrk_alloc( 3*jpi*jpj, zxc, zyc, zzc, zdis )
- ALLOCATE( llcotu(jpi,jpj), llcotv(jpi,jpj), llcotf(jpi,jpj) )
- !
- IF( lk_mpp ) CALL mpp_sum( ierr )
- IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'cofdis: requested local arrays unavailable')
-
- ! 0. Initialization
- ! -----------------
- IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*) 'cofdis : compute the distance to coastline'
- IF(lwp) WRITE(numout,*) '~~~~~~'
- IF(lwp) WRITE(numout,*)
- IF( lk_mpp ) &
- & CALL ctl_stop(' Computation not yet implemented with key_mpp_...', &
- & ' Rerun the code on another computer or ', &
- & ' create the "dist.coast.nc" file using IDL' )
-
- pdct(:,:,:) = 0._wp
- zxt(:,:) = COS( rad * gphit(:,:) ) * COS( rad * glamt(:,:) )
- zyt(:,:) = COS( rad * gphit(:,:) ) * SIN( rad * glamt(:,:) )
- zzt(:,:) = SIN( rad * gphit(:,:) )
-
-
- ! 1. Loop on vertical levels
- ! --------------------------
- ! ! ===============
- DO jk = 1, jpkm1 ! Horizontal slab
- ! ! ===============
- ! Define the coastline points (U, V and F)
- DO jj = 2, jpjm1
- DO ji = 2, jpim1
- zmask(ji,jj) = ( tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk) &
- & + tmask(ji,jj ,jk) + tmask(ji+1,jj ,jk) )
- llcotu(ji,jj) = ( tmask(ji,jj, jk) + tmask(ji+1,jj ,jk) == 1._wp )
- llcotv(ji,jj) = ( tmask(ji,jj ,jk) + tmask(ji ,jj+1,jk) == 1._wp )
- llcotf(ji,jj) = ( zmask(ji,jj) > 0._wp ) .AND. ( zmask(ji,jj) < 4._wp )
- END DO
- END DO
-
- ! Lateral boundaries conditions
- llcotu(:, 1 ) = umask(:, 2 ,jk) == 1
- llcotu(:,jpj) = umask(:,jpjm1,jk) == 1
- llcotv(:, 1 ) = vmask(:, 2 ,jk) == 1
- llcotv(:,jpj) = vmask(:,jpjm1,jk) == 1
- llcotf(:, 1 ) = fmask(:, 2 ,jk) == 1
- llcotf(:,jpj) = fmask(:,jpjm1,jk) == 1
-
- IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN
- llcotu( 1 ,:) = llcotu(jpim1,:)
- llcotu(jpi,:) = llcotu( 2 ,:)
- llcotv( 1 ,:) = llcotv(jpim1,:)
- llcotv(jpi,:) = llcotv( 2 ,:)
- llcotf( 1 ,:) = llcotf(jpim1,:)
- llcotf(jpi,:) = llcotf( 2 ,:)
- ELSE
- llcotu( 1 ,:) = umask( 2 ,:,jk) == 1
- llcotu(jpi,:) = umask(jpim1,:,jk) == 1
- llcotv( 1 ,:) = vmask( 2 ,:,jk) == 1
- llcotv(jpi,:) = vmask(jpim1,:,jk) == 1
- llcotf( 1 ,:) = fmask( 2 ,:,jk) == 1
- llcotf(jpi,:) = fmask(jpim1,:,jk) == 1
- ENDIF
- IF( nperio == 3 .OR. nperio == 4 ) THEN
- DO ji = 1, jpim1
- iju = jpi - ji + 1
- llcotu(ji,jpj ) = llcotu(iju,jpj-2)
- llcotf(ji,jpjm1) = llcotf(iju,jpj-2)
- llcotf(ji,jpj ) = llcotf(iju,jpj-3)
- END DO
- DO ji = jpi/2, jpim1
- iju = jpi - ji + 1
- llcotu(ji,jpjm1) = llcotu(iju,jpjm1)
- END DO
- DO ji = 2, jpi
- ijt = jpi - ji + 2
- llcotv(ji,jpjm1) = llcotv(ijt,jpj-2)
- llcotv(ji,jpj ) = llcotv(ijt,jpj-3)
- END DO
- ENDIF
- IF( nperio == 5 .OR. nperio == 6 ) THEN
- DO ji = 1, jpim1
- iju = jpi - ji
- llcotu(ji,jpj ) = llcotu(iju,jpjm1)
- llcotf(ji,jpj ) = llcotf(iju,jpj-2)
- END DO
- DO ji = jpi/2, jpim1
- iju = jpi - ji
- llcotf(ji,jpjm1) = llcotf(iju,jpjm1)
- END DO
- DO ji = 1, jpi
- ijt = jpi - ji + 1
- llcotv(ji,jpj ) = llcotv(ijt,jpjm1)
- END DO
- DO ji = jpi/2+1, jpi
- ijt = jpi - ji + 1
- llcotv(ji,jpjm1) = llcotv(ijt,jpjm1)
- END DO
- ENDIF
-
- ! Compute cartesian coordinates of coastline points
- ! and the number of coastline points
- icoast = 0
- DO jj = 1, jpj
- DO ji = 1, jpi
- IF( llcotf(ji,jj) ) THEN
- icoast = icoast + 1
- zxc(icoast) = COS( rad*gphif(ji,jj) ) * COS( rad*glamf(ji,jj) )
- zyc(icoast) = COS( rad*gphif(ji,jj) ) * SIN( rad*glamf(ji,jj) )
- zzc(icoast) = SIN( rad*gphif(ji,jj) )
- ENDIF
- IF( llcotu(ji,jj) ) THEN
- icoast = icoast+1
- zxc(icoast) = COS( rad*gphiu(ji,jj) ) * COS( rad*glamu(ji,jj) )
- zyc(icoast) = COS( rad*gphiu(ji,jj) ) * SIN( rad*glamu(ji,jj) )
- zzc(icoast) = SIN( rad*gphiu(ji,jj) )
- ENDIF
- IF( llcotv(ji,jj) ) THEN
- icoast = icoast+1
- zxc(icoast) = COS( rad*gphiv(ji,jj) ) * COS( rad*glamv(ji,jj) )
- zyc(icoast) = COS( rad*gphiv(ji,jj) ) * SIN( rad*glamv(ji,jj) )
- zzc(icoast) = SIN( rad*gphiv(ji,jj) )
- ENDIF
- END DO
- END DO
-
- ! Distance for the T-points
- DO jj = 1, jpj
- DO ji = 1, jpi
- IF( tmask(ji,jj,jk) == 0._wp ) THEN
- pdct(ji,jj,jk) = 0._wp
- ELSE
- DO jl = 1, icoast
- zdis(jl) = ( zxt(ji,jj) - zxc(jl) )**2 &
- & + ( zyt(ji,jj) - zyc(jl) )**2 &
- & + ( zzt(ji,jj) - zzc(jl) )**2
- END DO
- pdct(ji,jj,jk) = ra * SQRT( MINVAL( zdis(1:icoast) ) )
- ENDIF
- END DO
- END DO
- ! ! ===============
- END DO ! End of slab
- ! ! ===============
-
-
- ! 2. Create the distance to the coast file in NetCDF format
- ! ----------------------------------------------------------
- clname = 'dist.coast'
- itime = 0
- CALL ymds2ju( 0 , 1 , 1 , 0._wp , zdate0 )
- CALL restini( 'NONE', jpi , jpj , glamt, gphit , &
- & jpk , gdept_1d, clname, itime, zdate0, &
- & rdt , icot )
- CALL restput( icot, 'Tcoast', jpi, jpj, jpk, 0, pdct )
- CALL restclo( icot )
- !
- CALL wrk_dealloc( jpi, jpj , zxt, zyt, zzt, zmask )
- CALL wrk_dealloc( 3*jpi*jpj, zxc, zyc, zzc, zdis )
- DEALLOCATE( llcotu, llcotv, llcotf )
- !
- IF( nn_timing == 1 ) CALL timing_stop('cofdis')
- !
- END SUBROUTINE cofdis
- !!======================================================================
END MODULE tradmp
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90 (revision 5602)
@@ -290,4 +290,9 @@
IF(lwp) WRITE(numout,*) ' homogeneous ocean T = ', zt0, ' S = ',zs0
+ ! Initialisation of gtui/gtvi in case of no cavity
+ IF ( .NOT. ln_isfcav ) THEN
+ gtui(:,:,:) = 0.0_wp
+ gtvi(:,:,:) = 0.0_wp
+ END IF
! ! T & S profile (to be coded +namelist parameter
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90 (revision 5602)
@@ -116,5 +116,4 @@
END DO
END DO
-
! !== Laplacian ==!
!
@@ -125,4 +124,5 @@
END DO
END DO
+ !
IF( ln_zps ) THEN ! set gradient at partial step level (last ocean level)
DO jj = 1, jpjm1
@@ -130,10 +130,17 @@
IF( mbku(ji,jj) == jk ) ztu(ji,jj,jk) = zeeu(ji,jj) * pgu(ji,jj,jn)
IF( mbkv(ji,jj) == jk ) ztv(ji,jj,jk) = zeev(ji,jj) * pgv(ji,jj,jn)
- ! (ISH)
- IF( miku(ji,jj) == jk ) ztu(ji,jj,jk) = zeeu(ji,jj) * pgui(ji,jj,jn)
- IF( mikv(ji,jj) == jk ) ztu(ji,jj,jk) = zeev(ji,jj) * pgvi(ji,jj,jn)
END DO
END DO
ENDIF
+ ! (ISH)
+ IF( ln_zps .AND. ln_isfcav ) THEN ! set gradient at partial step level (first ocean level in a cavity)
+ DO jj = 1, jpjm1
+ DO ji = 1, jpim1
+ IF( miku(ji,jj) == MAX(jk,2) ) ztu(ji,jj,jk) = zeeu(ji,jj) * pgui(ji,jj,jn)
+ IF( mikv(ji,jj) == MAX(jk,2) ) ztu(ji,jj,jk) = zeev(ji,jj) * pgvi(ji,jj,jn)
+ END DO
+ END DO
+ ENDIF
+ !
DO jj = 2, jpjm1 ! Second derivative (divergence) time the eddy diffusivity coefficient
DO ji = fs_2, fs_jpim1 ! vector opt.
@@ -166,7 +173,7 @@
!
! "zonal" mean lateral diffusive heat and salt transport
- IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN
- IF( jn == jp_tem ) htr_ldf(:) = ptr_vj( ztv(:,:,:) )
- IF( jn == jp_sal ) str_ldf(:) = ptr_vj( ztv(:,:,:) )
+ IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
+ IF( jn == jp_tem ) htr_ldf(:) = ptr_sj( ztv(:,:,:) )
+ IF( jn == jp_sal ) str_ldf(:) = ptr_sj( ztv(:,:,:) )
ENDIF
! ! ===========
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90 (revision 5602)
@@ -247,8 +247,8 @@
! ! ===============
! "Poleward" diffusive heat or salt transport
- IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( kaht == 2 ) .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN
+ IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( kaht == 2 ) ) THEN
! note sign is reversed to give down-gradient diffusive transports (#1043)
- IF( jn == jp_tem) htr_ldf(:) = ptr_vj( -zftv(:,:,:) )
- IF( jn == jp_sal) str_ldf(:) = ptr_vj( -zftv(:,:,:) )
+ IF( jn == jp_tem) htr_ldf(:) = ptr_sj( -zftv(:,:,:) )
+ IF( jn == jp_sal) str_ldf(:) = ptr_sj( -zftv(:,:,:) )
ENDIF
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90 (revision 5602)
@@ -28,8 +28,6 @@
USE in_out_manager ! I/O manager
USE iom ! I/O library
-#if defined key_diaar5
USE phycst ! physical constants
USE lbclnk ! ocean lateral boundary conditions (or mpp link)
-#endif
USE wrk_nemo ! Memory Allocation
USE timing ! Timing
@@ -106,10 +104,8 @@
!
INTEGER :: ji, jj, jk, jn ! dummy loop indices
+ INTEGER :: ikt
REAL(wp) :: zmsku, zabe1, zcof1, zcoef3 ! local scalars
REAL(wp) :: zmskv, zabe2, zcof2, zcoef4 ! - -
REAL(wp) :: zcoef0, zbtr, ztra ! - -
-#if defined key_diaar5
- REAL(wp) :: zztmp ! local scalar
-#endif
REAL(wp), POINTER, DIMENSION(:,: ) :: z2d
REAL(wp), POINTER, DIMENSION(:,:,:) :: zdkt, zdk1t, zdit, zdjt, ztfw
@@ -149,43 +145,59 @@
END DO
END DO
+
+ ! partial cell correction
IF( ln_zps ) THEN ! partial steps correction at the last ocean level
DO jj = 1, jpjm1
DO ji = 1, fs_jpim1 ! vector opt.
! IF useless if zpshde defines pgu everywhere
- IF (mbku(ji,jj) > 1) zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn)
- IF (mbkv(ji,jj) > 1) zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn)
- ! (ISF)
+ zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn)
+ zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn)
+ END DO
+ END DO
+ ENDIF
+ IF( ln_zps .AND. ln_isfcav ) THEN ! partial steps correction at the first wet level beneath a cavity
+ DO jj = 1, jpjm1
+ DO ji = 1, fs_jpim1 ! vector opt.
IF (miku(ji,jj) > 1) zdit(ji,jj,miku(ji,jj)) = pgui(ji,jj,jn)
IF (mikv(ji,jj) > 1) zdjt(ji,jj,mikv(ji,jj)) = pgvi(ji,jj,jn)
END DO
END DO
- ENDIF
+ END IF
!!----------------------------------------------------------------------
!! II - horizontal trend (full)
!!----------------------------------------------------------------------
-!CDIR PARALLEL DO PRIVATE( zdk1t )
- ! ! ===============
- DO jj = 1, jpj ! Horizontal slab
- ! ! ===============
- DO ji = 1, jpi ! vector opt.
- DO jk = mikt(ji,jj), jpkm1
- ! 1. Vertical tracer gradient at level jk and jk+1
- ! ------------------------------------------------
- ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2)
- zdk1t(ji,jj,jk) = ( ptb(ji,jj,jk,jn) - ptb(ji,jj,jk+1,jn) ) * tmask(ji,jj,jk+1)
- !
- IF( jk == mikt(ji,jj) ) THEN ; zdkt(ji,jj,jk) = zdk1t(ji,jj,jk)
- ELSE ; zdkt(ji,jj,jk) = ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) * tmask(ji,jj,jk)
- ENDIF
+!!!!!!!!!!CDIR PARALLEL DO PRIVATE( zdk1t )
+ ! 1. Vertical tracer gradient at level jk and jk+1
+ ! ------------------------------------------------
+ !
+ ! interior value
+ DO jk = 2, jpkm1
+ DO jj = 1, jpj
+ DO ji = 1, jpi ! vector opt.
+ zdk1t(ji,jj,jk) = ( ptb(ji,jj,jk,jn ) - ptb(ji,jj,jk+1,jn) ) * wmask(ji,jj,jk+1)
+ !
+ zdkt(ji,jj,jk) = ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn ) ) * wmask(ji,jj,jk)
END DO
END DO
END DO
-
- ! 2. Horizontal fluxes
- ! --------------------
- DO jj = 1 , jpjm1
- DO ji = 1, fs_jpim1 ! vector opt.
- DO jk = mikt(ji,jj), jpkm1
+ ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2)
+ zdk1t(:,:,1) = ( ptb(:,:,1,jn ) - ptb(:,:,2,jn) ) * wmask(:,:,2)
+ zdkt (:,:,1) = zdk1t(:,:,1)
+ IF ( ln_isfcav ) THEN
+ DO jj = 1, jpj
+ DO ji = 1, jpi ! vector opt.
+ ikt = mikt(ji,jj) ! surface level
+ zdk1t(ji,jj,ikt) = ( ptb(ji,jj,ikt,jn ) - ptb(ji,jj,ikt+1,jn) ) * wmask(ji,jj,ikt+1)
+ zdkt (ji,jj,ikt) = zdk1t(ji,jj,ikt)
+ END DO
+ END DO
+ END IF
+
+ ! 2. Horizontal fluxes
+ ! --------------------
+ DO jk = 1, jpkm1
+ DO jj = 1 , jpjm1
+ DO ji = 1, fs_jpim1 ! vector opt.
zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk)
zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk)
@@ -208,12 +220,10 @@
END DO
END DO
- END DO
! II.4 Second derivative (divergence) and add to the general trend
! ----------------------------------------------------------------
- DO jj = 2 , jpjm1
- DO ji = fs_2, fs_jpim1 ! vector opt.
- DO jk = mikt(ji,jj), jpkm1
- zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+ DO jj = 2 , jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
+ zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) )
ztra = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk) )
pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
@@ -225,38 +235,39 @@
!
! "Poleward" diffusive heat or salt transports (T-S case only)
- IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN
+ IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
! note sign is reversed to give down-gradient diffusive transports (#1043)
- IF( jn == jp_tem) htr_ldf(:) = ptr_vj( -zftv(:,:,:) )
- IF( jn == jp_sal) str_ldf(:) = ptr_vj( -zftv(:,:,:) )
+ IF( jn == jp_tem) htr_ldf(:) = ptr_sj( -zftv(:,:,:) )
+ IF( jn == jp_sal) str_ldf(:) = ptr_sj( -zftv(:,:,:) )
ENDIF
-#if defined key_diaar5
- IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN
- z2d(:,:) = 0._wp
- ! note sign is reversed to give down-gradient diffusive transports (#1043)
- zztmp = -1.0_wp * rau0 * rcp
- DO jk = 1, jpkm1
- DO jj = 2, jpjm1
- DO ji = fs_2, fs_jpim1 ! vector opt.
- z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk)
+ IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN
+ !
+ IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN
+ z2d(:,:) = 0._wp
+ DO jk = 1, jpkm1
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
+ z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk)
+ END DO
END DO
END DO
- END DO
- z2d(:,:) = zztmp * z2d(:,:)
- CALL lbc_lnk( z2d, 'U', -1. )
- CALL iom_put( "udiff_heattr", z2d ) ! heat transport in i-direction
- z2d(:,:) = 0._wp
- DO jk = 1, jpkm1
- DO jj = 2, jpjm1
- DO ji = fs_2, fs_jpim1 ! vector opt.
- z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk)
+ z2d(:,:) = - rau0_rcp * z2d(:,:) ! note sign is reversed to give down-gradient diffusive transports (#1043)
+ CALL lbc_lnk( z2d, 'U', -1. )
+ CALL iom_put( "udiff_heattr", z2d ) ! heat transport in i-direction
+ !
+ z2d(:,:) = 0._wp
+ DO jk = 1, jpkm1
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
+ z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk)
+ END DO
END DO
END DO
- END DO
- z2d(:,:) = zztmp * z2d(:,:)
- CALL lbc_lnk( z2d, 'V', -1. )
- CALL iom_put( "vdiff_heattr", z2d ) ! heat transport in i-direction
- END IF
-#endif
+ z2d(:,:) = - rau0_rcp * z2d(:,:) ! note sign is reversed to give down-gradient diffusive transports (#1043)
+ CALL lbc_lnk( z2d, 'V', -1. )
+ CALL iom_put( "vdiff_heattr", z2d ) ! heat transport in i-direction
+ END IF
+ !
+ ENDIF
!!----------------------------------------------------------------------
@@ -278,5 +289,5 @@
DO jj = 2, jpjm1
DO ji = fs_2, fs_jpim1 ! vector opt.
- zcoef0 = - fsahtw(ji,jj,jk) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1)
+ zcoef0 = - fsahtw(ji,jj,jk) * wmask(ji,jj,jk)
!
zmsku = 1./MAX( umask(ji ,jj,jk-1) + umask(ji-1,jj,jk) &
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90 (revision 5602)
@@ -113,7 +113,4 @@
REAL(wp) :: ze1ur, zdxt, ze2vr, ze3wr, zdyt, zdzt
REAL(wp) :: zah, zah_slp, zaei_slp
-#if defined key_diaar5
- REAL(wp) :: zztmp ! local scalar
-#endif
REAL(wp), POINTER, DIMENSION(:,: ) :: z2d
REAL(wp), POINTER, DIMENSION(:,:,:) :: zdit, zdjt, ztfw
@@ -207,32 +204,34 @@
END DO
!
-#if defined key_iomput
- IF( ln_traldf_gdia .AND. cdtype == 'TRA' ) THEN
- CALL wrk_alloc( jpi , jpj , jpk , zw3d )
- DO jk=1,jpkm1
- zw3d(:,:,jk) = (psix_eiv(:,:,jk+1) - psix_eiv(:,:,jk))/fse3u(:,:,jk) ! u_eiv = -dpsix/dz
- END DO
- zw3d(:,:,jpk) = 0._wp
- CALL iom_put( "uoce_eiv", zw3d ) ! i-eiv current
-
- DO jk=1,jpk-1
- zw3d(:,:,jk) = (psiy_eiv(:,:,jk+1) - psiy_eiv(:,:,jk))/fse3v(:,:,jk) ! v_eiv = -dpsiy/dz
- END DO
- zw3d(:,:,jpk) = 0._wp
- CALL iom_put( "voce_eiv", zw3d ) ! j-eiv current
-
- DO jk=1,jpk-1
- DO jj = 2, jpjm1
- DO ji = fs_2, fs_jpim1 ! vector opt.
- zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))/e2t(ji,jj) + &
- & (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))/e1t(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx
- END DO
- END DO
- END DO
- zw3d(:,:,jpk) = 0._wp
- CALL iom_put( "woce_eiv", zw3d ) ! vert. eiv current
- CALL wrk_dealloc( jpi , jpj , jpk , zw3d )
+ IF( iom_use("uoce_eiv") .OR. iom_use("voce_eiv") .OR. iom_use("woce_eiv") ) THEN
+ !
+ IF( ln_traldf_gdia .AND. cdtype == 'TRA' ) THEN
+ CALL wrk_alloc( jpi , jpj , jpk , zw3d )
+ DO jk=1,jpkm1
+ zw3d(:,:,jk) = (psix_eiv(:,:,jk+1) - psix_eiv(:,:,jk))/fse3u(:,:,jk) ! u_eiv = -dpsix/dz
+ END DO
+ zw3d(:,:,jpk) = 0._wp
+ CALL iom_put( "uoce_eiv", zw3d ) ! i-eiv current
+
+ DO jk=1,jpk-1
+ zw3d(:,:,jk) = (psiy_eiv(:,:,jk+1) - psiy_eiv(:,:,jk))/fse3v(:,:,jk) ! v_eiv = -dpsiy/dz
+ END DO
+ zw3d(:,:,jpk) = 0._wp
+ CALL iom_put( "voce_eiv", zw3d ) ! j-eiv current
+
+ DO jk=1,jpk-1
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
+ zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))/e2t(ji,jj) + &
+ & (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))/e1t(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx
+ END DO
+ END DO
+ END DO
+ zw3d(:,:,jpk) = 0._wp
+ CALL iom_put( "woce_eiv", zw3d ) ! vert. eiv current
+ CALL wrk_dealloc( jpi , jpj , jpk , zw3d )
+ ENDIF
+ !
ENDIF
-#endif
! ! ===========
DO jn = 1, kjpt ! tracer loop
@@ -387,36 +386,38 @@
!
! ! "Poleward" diffusive heat or salt transports (T-S case only)
- IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN
- IF( jn == jp_tem) htr_ldf(:) = ptr_vj( zftv(:,:,:) ) ! 3.3 names
- IF( jn == jp_sal) str_ldf(:) = ptr_vj( zftv(:,:,:) )
+ IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
+ IF( jn == jp_tem) htr_ldf(:) = ptr_sj( zftv(:,:,:) ) ! 3.3 names
+ IF( jn == jp_sal) str_ldf(:) = ptr_sj( zftv(:,:,:) )
ENDIF
-#if defined key_diaar5
- IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN
- z2d(:,:) = 0._wp
- zztmp = rau0 * rcp
- DO jk = 1, jpkm1
- DO jj = 2, jpjm1
- DO ji = fs_2, fs_jpim1 ! vector opt.
- z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk)
- END DO
- END DO
- END DO
- z2d(:,:) = zztmp * z2d(:,:)
- CALL lbc_lnk( z2d, 'U', -1. )
- CALL iom_put( "udiff_heattr", z2d ) ! heat transport in i-direction
- z2d(:,:) = 0._wp
- DO jk = 1, jpkm1
- DO jj = 2, jpjm1
- DO ji = fs_2, fs_jpim1 ! vector opt.
- z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk)
- END DO
- END DO
- END DO
- z2d(:,:) = zztmp * z2d(:,:)
- CALL lbc_lnk( z2d, 'V', -1. )
- CALL iom_put( "vdiff_heattr", z2d ) ! heat transport in j-direction
- END IF
-#endif
+ IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN
+ !
+ IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN
+ z2d(:,:) = 0._wp
+ DO jk = 1, jpkm1
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
+ z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk)
+ END DO
+ END DO
+ END DO
+ z2d(:,:) = rau0_rcp * z2d(:,:)
+ CALL lbc_lnk( z2d, 'U', -1. )
+ CALL iom_put( "udiff_heattr", z2d ) ! heat transport in i-direction
+ !
+ z2d(:,:) = 0._wp
+ DO jk = 1, jpkm1
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
+ z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk)
+ END DO
+ END DO
+ END DO
+ z2d(:,:) = rau0_rcp * z2d(:,:)
+ CALL lbc_lnk( z2d, 'V', -1. )
+ CALL iom_put( "vdiff_heattr", z2d ) ! heat transport in i-direction
+ END IF
+ !
+ ENDIF
!
END DO
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90 (revision 5602)
@@ -102,5 +102,5 @@
END DO
END DO
- IF( ln_zps ) THEN ! set gradient at partial step level
+ IF( ln_zps ) THEN ! set gradient at partial step level for the last ocean cell
DO jj = 1, jpjm1
DO ji = 1, fs_jpim1 ! vector opt.
@@ -116,6 +116,12 @@
ztv(ji,jj,jk) = zabe2 * pgv(ji,jj,jn)
ENDIF
-
- ! (ISH)
+ END DO
+ END DO
+ ENDIF
+ ! (ISH)
+ IF( ln_zps .AND. ln_isfcav ) THEN ! set gradient at partial step level for the first ocean cell
+ ! into a cavity
+ DO jj = 1, jpjm1
+ DO ji = 1, fs_jpim1 ! vector opt.
! ice shelf level level MAX(2,jk) => only where ice shelf
iku = miku(ji,jj)
@@ -148,7 +154,7 @@
!
! "Poleward" diffusive heat or salt transports
- IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN
- IF( jn == jp_tem) htr_ldf(:) = ptr_vj( ztv(:,:,:) )
- IF( jn == jp_sal) str_ldf(:) = ptr_vj( ztv(:,:,:) )
+ IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
+ IF( jn == jp_tem) htr_ldf(:) = ptr_sj( ztv(:,:,:) )
+ IF( jn == jp_sal) str_ldf(:) = ptr_sj( ztv(:,:,:) )
ENDIF
! ! ==================
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90 (revision 5602)
@@ -9,5 +9,5 @@
!! 3.0 ! 2008-06 (G. Madec) applied on ta, sa and called before tranxt in step.F90
!! 3.3 ! 2010-05 (C. Ethe, G. Madec) merge TRC-TRA
- !! 3.7 ! 2014-06 (L. Brodeau) new algorithm based on local Brunt-Vaisala freq.
+ !! 3.6 ! 2015-05 (L. Brodeau) new algorithm based on local Brunt-Vaisala freq.
!!----------------------------------------------------------------------
@@ -64,8 +64,9 @@
INTEGER :: ji, jj, jk ! dummy loop indices
INTEGER :: inpcc ! number of statically instable water column
- INTEGER :: jiter, ikbot, ik, ikup, ikdown, ilayer, ikm ! local integers
+ INTEGER :: jiter, ikbot, ikp, ikup, ikdown, ilayer, ik_low ! local integers
LOGICAL :: l_bottom_reached, l_column_treated
REAL(wp) :: zta, zalfa, zsum_temp, zsum_alfa, zaw, zdz, zsum_z
REAL(wp) :: zsa, zbeta, zsum_sali, zsum_beta, zbw, zrw, z1_r2dt
+ REAL(wp), PARAMETER :: zn2_zero = 1.e-14_wp ! acceptance criteria for neutrality (N2==0)
REAL(wp), POINTER, DIMENSION(:) :: zvn2 ! vertical profile of N2 at 1 given point...
REAL(wp), POINTER, DIMENSION(:,:) :: zvts ! vertical profile of T and S at 1 given point...
@@ -75,9 +76,7 @@
REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds ! 3D workspace
!
- !!LB debug:
- LOGICAL, PARAMETER :: l_LB_debug = .FALSE.
- INTEGER :: ilc1, jlc1, klc1, nncpu
- LOGICAL :: lp_monitor_point = .FALSE.
- !!LB debug.
+ LOGICAL, PARAMETER :: l_LB_debug = .FALSE. ! set to true if you want to follow what is
+ INTEGER :: ilc1, jlc1, klc1, nncpu ! actually happening in a water column at point "ilc1, jlc1"
+ LOGICAL :: lp_monitor_point = .FALSE. ! in CPU domain "nncpu"
!!----------------------------------------------------------------------
!
@@ -97,22 +96,13 @@
ENDIF
- !LB debug:
- IF( lwp .AND. l_LB_debug ) THEN
- WRITE(numout,*)
- WRITE(numout,*) 'LOLO: entering tra_npc, kt, narea =', kt, narea
- ENDIF
- !LBdebug: Monitoring of 1 column subject to convection...
IF( l_LB_debug ) THEN
- ! Location of 1 known convection spot to follow what's happening in the water column
- ilc1 = 54 ; jlc1 = 15 ; ! Labrador ORCA1 4x4 cpus:
- nncpu = 15 ; ! the CPU domain contains the convection spot
- !ilc1 = 14 ; jlc1 = 13 ; ! Labrador ORCA1 8x8 cpus:
- !nncpu = 54 ; ! the CPU domain contains the convection spot
+ ! Location of 1 known convection site to follow what's happening in the water column
+ ilc1 = 45 ; jlc1 = 3 ; ! ORCA2 4x4, Antarctic coast, more than 2 unstable portions in the water column...
+ nncpu = 1 ; ! the CPU domain contains the convection spot
klc1 = mbkt(ilc1,jlc1) ! bottom of the ocean for debug point...
ENDIF
- !LBdebug.
-
- CALL eos_rab( tsa, zab ) ! after alpha and beta
- CALL bn2 ( tsa, zab, zn2 ) ! after Brunt-Vaisala
+
+ CALL eos_rab( tsa, zab ) ! after alpha and beta (given on T-points)
+ CALL bn2 ( tsa, zab, zn2 ) ! after Brunt-Vaisala (given on W-points)
inpcc = 0
@@ -134,19 +124,9 @@
IF( ( ji == ilc1 ).AND.( jj == jlc1 ) ) lp_monitor_point = .TRUE.
! writing only if on CPU domain where conv region is:
- lp_monitor_point = (narea == nncpu).AND.lp_monitor_point
-
- IF(lp_monitor_point) THEN
- WRITE(numout,*) '' ;WRITE(numout,*) '' ;
- WRITE(numout,'("Time step = ",i6.6," !!!")') kt
- WRITE(numout,'(" *** BEFORE anything, N^2 for point ",i3,",",i3,":" )') ji,jj
- DO jk = 1, klc1
- WRITE(numout,*) jk, zvn2(jk)
- END DO
- WRITE(numout,*) ' '
- ENDIF
+ lp_monitor_point = (narea == nncpu).AND.lp_monitor_point
ENDIF !LB debug end
ikbot = mbkt(ji,jj) ! ikbot: ocean bottom T-level
- ik = 1 ! because N2 is irrelevant at the surface level (will start at ik=2)
+ ikp = 1 ! because N2 is irrelevant at the surface level (will start at ikp=2)
ilayer = 0
jiter = 0
@@ -163,34 +143,48 @@
DO WHILE ( .NOT. l_bottom_reached )
- ik = ik + 1
+ ikp = ikp + 1
- !! Checking level ik for instability
+ !! Testing level ikp for instability
!! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
- IF( zvn2(ik) < 0. ) THEN ! Instability found!
-
- ikm = ik ! first level whith negative N2
- ilayer = ilayer + 1 ! yet another layer found....
- IF(jiter == 1) inpcc = inpcc + 1
-
- IF(l_LB_debug .AND. lp_monitor_point) &
- & WRITE(numout,*) 'Negative N2 at ik =', ikm, ' layer nb.', ilayer, &
- & ' inpcc =', inpcc
-
- !! Case we mix with upper regions where N2==0:
- !! All the points above ikup where N2 == 0 must also be mixed => we go
- !! upward to find a new ikup, where the layer doesn't have N2==0
- ikup = ikm
- DO jk = ikm, 2, -1
- ikup = ikup - 1
- IF( (zvn2(jk-1) > 0.).OR.(ikup == 1) ) EXIT
- END DO
-
- ! adjusting ikup if the upper part of the unstable column was neutral (N2=0)
- IF((zvn2(ikup+1) == 0.).AND.(ikup /= 1)) ikup = ikup+1 ;
-
-
- IF( lp_monitor_point ) WRITE(numout,*) ' => ikup is =', ikup, ' layer nb.', ilayer
-
+ IF( zvn2(ikp) < -zn2_zero ) THEN ! Instability found!
+
+ ilayer = ilayer + 1 ! yet another instable portion of the water column found....
+
+ IF( lp_monitor_point ) THEN
+ WRITE(numout,*)
+ IF( ilayer == 1 .AND. jiter == 1 ) THEN ! first time a column is spoted with an instability
+ WRITE(numout,*)
+ WRITE(numout,*) 'Time step = ',kt,' !!!'
+ ENDIF
+ WRITE(numout,*) ' * Iteration #',jiter,': found instable portion #',ilayer, &
+ & ' in column! Starting at ikp =', ikp
+ WRITE(numout,*) ' *** N2 for point (i,j) = ',ji,' , ',jj
+ DO jk = 1, klc1
+ WRITE(numout,*) jk, zvn2(jk)
+ END DO
+ WRITE(numout,*)
+ ENDIF
+
+
+ IF( jiter == 1 ) inpcc = inpcc + 1
+
+ IF( lp_monitor_point ) WRITE(numout, *) 'Negative N2 at ikp =',ikp,' for layer #', ilayer
+
+ !! ikup is the uppermost point where mixing will start:
+ ikup = ikp - 1 ! ikup is always "at most at ikp-1", less if neutral levels overlying
+
+ !! If the points above ikp-1 have N2 == 0 they must also be mixed:
+ IF( ikp > 2 ) THEN
+ DO jk = ikp-1, 2, -1
+ IF( ABS(zvn2(jk)) < zn2_zero ) THEN
+ ikup = ikup - 1 ! 1 more upper level has N2=0 and must be added for the mixing
+ ELSE
+ EXIT
+ ENDIF
+ END DO
+ ENDIF
+
+ IF( ikup < 1 ) CALL ctl_stop( 'tra_npc : PROBLEM #1')
+
zsum_temp = 0._wp
zsum_sali = 0._wp
@@ -199,7 +193,5 @@
zsum_z = 0._wp
- DO jk = ikup, ikbot+1 ! Inside the instable (and overlying neutral) portion of the column
- !
- IF(l_LB_debug .AND. lp_monitor_point) WRITE(numout,*) ' -> summing for jk =', jk
+ DO jk = ikup, ikbot ! Inside the instable (and overlying neutral) portion of the column
!
zdz = fse3t(ji,jj,jk)
@@ -209,16 +201,14 @@
zsum_beta = zsum_beta + zvab(jk,jp_sal)*zdz
zsum_z = zsum_z + zdz
- !
- !! EXIT if we found the bottom of the unstable portion of the water column
- IF( (zvn2(jk+1) > 0.).OR.(jk == ikbot ).OR.((jk==ikm).AND.(zvn2(jk+1) == 0.)) ) EXIT
+ !
+ IF( jk == ikbot ) EXIT ! avoid array-index overshoot in case ikbot = jpk, cause we're calling jk+1 next line
+ !! EXIT when we have reached the last layer that is instable (N2<0) or neutral (N2=0):
+ IF( zvn2(jk+1) > zn2_zero ) EXIT
END DO
- !ik = jk !LB remove?
- ikdown = jk ! for the current unstable layer, ikdown is the deepest point with a negative N2
-
- IF(l_LB_debug .AND. lp_monitor_point) &
- & WRITE(numout,*) ' => ikdown =', ikdown, ' layer nb.', ilayer
-
- ! Mixing Temperature and salinity between ikup and ikdown:
+ ikdown = jk ! for the current unstable layer, ikdown is the deepest point with a negative or neutral N2
+ IF( ikup == ikdown ) CALL ctl_stop( 'tra_npc : PROBLEM #2')
+
+ ! Mixing Temperature, salinity, alpha and beta from ikup to ikdown included:
zta = zsum_temp/zsum_z
zsa = zsum_sali/zsum_z
@@ -226,8 +216,10 @@
zbeta = zsum_beta/zsum_z
- IF(l_LB_debug .AND. lp_monitor_point) THEN
+ IF( lp_monitor_point ) THEN
+ WRITE(numout,*) 'MIXED T, S, alfa and beta between ikup =',ikup, &
+ & ' and ikdown =',ikdown,', in layer #',ilayer
WRITE(numout,*) ' => Mean temp. in that portion =', zta
WRITE(numout,*) ' => Mean sali. in that portion =', zsa
- WRITE(numout,*) ' => Mean Alpha in that portion =', zalfa
+ WRITE(numout,*) ' => Mean Alfa in that portion =', zalfa
WRITE(numout,*) ' => Mean Beta in that portion =', zbeta
ENDIF
@@ -240,57 +232,64 @@
zvab(jk,jp_sal) = zbeta
END DO
- !
- !! Before updating N2, it is possible that another unstable
- !! layer exists underneath the one we just homogeneized!
- ik = ikdown
- !
- ENDIF ! IF( zvn2(ik+1) < 0. ) THEN
- !
- IF( ik == ikbot ) l_bottom_reached = .TRUE.
+
+
+ !! Updating N2 in the relvant portion of the water column
+ !! Temperature, Salinity, Alpha and Beta have been homogenized in the unstable portion
+ !! => Need to re-compute N2! will use Alpha and Beta!
+
+ ikup = MAX(2,ikup) ! ikup can never be 1 !
+ ik_low = MIN(ikdown+1,ikbot) ! we must go 1 point deeper than ikdown!
+
+ DO jk = ikup, ik_low ! we must go 1 point deeper than ikdown!
+
+ !! Interpolating alfa and beta at W point:
+ zrw = (fsdepw(ji,jj,jk ) - fsdept(ji,jj,jk)) &
+ & / (fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk))
+ zaw = zvab(jk,jp_tem) * (1._wp - zrw) + zvab(jk-1,jp_tem) * zrw
+ zbw = zvab(jk,jp_sal) * (1._wp - zrw) + zvab(jk-1,jp_sal) * zrw
+
+ !! N2 at W point, doing exactly as in eosbn2.F90:
+ zvn2(jk) = grav*( zaw * ( zvts(jk-1,jp_tem) - zvts(jk,jp_tem) ) &
+ & - zbw * ( zvts(jk-1,jp_sal) - zvts(jk,jp_sal) ) ) &
+ & / fse3w(ji,jj,jk) * tmask(ji,jj,jk)
+
+ !! OR, faster => just considering the vertical gradient of density
+ !! as only the signa maters...
+ !zvn2(jk) = ( zaw * ( zvts(jk-1,jp_tem) - zvts(jk,jp_tem) ) &
+ ! & - zbw * ( zvts(jk-1,jp_sal) - zvts(jk,jp_sal) ) )
+
+ END DO
+
+ ikp = MIN(ikdown+1,ikbot)
+
+
+ ENDIF !IF( zvn2(ikp) < 0. )
+
+
+ IF( ikp == ikbot ) l_bottom_reached = .TRUE.
!
END DO ! DO WHILE ( .NOT. l_bottom_reached )
- IF( ik /= ikbot ) STOP 'ERROR: tranpc.F90 => PROBLEM #1'
+ IF( ikp /= ikbot ) CALL ctl_stop( 'tra_npc : PROBLEM #3')
- ! ******* At this stage ik == ikbot ! *******
+ ! ******* At this stage ikp == ikbot ! *******
- IF( ilayer > 0 ) THEN
- !! least an unstable layer has been found
- !! Temperature, Salinity, Alpha and Beta have been homogenized in the unstable portion
- !! => Need to re-compute N2! will use Alpha and Beta!
+ IF( ilayer > 0 ) THEN !! least an unstable layer has been found
!
- DO jk = ikup+1, ikdown+1 ! we must go 1 point deeper than ikdown!
- !! Doing exactly as in eosbn2.F90:
- !! * Except that we only are interested in the sign of N2 !!!
- !! => just considering the vertical gradient of density
- zrw = (fsdepw(ji,jj,jk ) - fsdept(ji,jj,jk)) &
- & / (fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk))
- zaw = zvab(jk,jp_tem) * (1._wp - zrw) + zvab(jk-1,jp_tem) * zrw
- zbw = zvab(jk,jp_sal) * (1._wp - zrw) + zvab(jk-1,jp_sal) * zrw
-
- !zvn2(jk) = grav*( zaw * ( zvts(jk-1,jp_tem) - zvts(jk,jp_tem) ) &
- ! & - zbw * ( zvts(jk-1,jp_sal) - zvts(jk,jp_sal) ) ) &
- ! & / fse3w(ji,jj,jk) * tmask(ji,jj,jk)
- zvn2(jk) = ( zaw * ( zvts(jk-1,jp_tem) - zvts(jk,jp_tem) ) &
- & - zbw * ( zvts(jk-1,jp_sal) - zvts(jk,jp_sal) ) )
- END DO
-
- IF(l_LB_debug .AND. lp_monitor_point) THEN
- WRITE(numout, '(" *** After iteration #",i3.3,", N^2 for point ",i3,",",i3,":" )') &
- & jiter, ji,jj
+ IF( lp_monitor_point ) THEN
+ WRITE(numout,*)
+ WRITE(numout,*) 'After ',jiter,' iteration(s), we neutralized ',ilayer,' instable layer(s)'
+ WRITE(numout,*) ' ==> N2 at i,j=',ji,',',jj,' now looks like this:'
DO jk = 1, klc1
WRITE(numout,*) jk, zvn2(jk)
END DO
- WRITE(numout,*) ' '
+ WRITE(numout,*)
ENDIF
-
- ik = 1 ! starting again at the surface for the next iteration
+ !
+ ikp = 1 ! starting again at the surface for the next iteration
ilayer = 0
ENDIF
!
- IF( ik >= ikbot ) THEN
- IF(l_LB_debug .AND. lp_monitor_point) WRITE(numout,*) ' --- exiting jiter loop ---'
- l_column_treated = .TRUE.
- ENDIF
+ IF( ikp >= ikbot ) l_column_treated = .TRUE.
!
END DO ! DO WHILE ( .NOT. l_column_treated )
@@ -300,8 +299,8 @@
tsa(ji,jj,:,jp_sal) = zvts(:,jp_sal)
- !! lolo: Should we update something else????
- !! => like alpha and beta?
-
- IF(l_LB_debug .AND. lp_monitor_point) WRITE(numout,*) ''
+ !! LB: Potentially some other global variable beside theta and S can be treated here
+ !! like BGC tracers.
+
+ IF( lp_monitor_point ) WRITE(numout,*)
ENDIF ! IF( tmask(ji,jj,3) == 1 ) THEN
@@ -321,8 +320,7 @@
CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. ) ; CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )
!
- IF(lwp) THEN
- WRITE(numout,*) 'LOLO: exiting tra_npc, kt =', kt
- WRITE(numout,*)' => number of statically instable water column : ',inpcc
- WRITE(numout,*) '' ; WRITE(numout,*) ''
+ IF( lwp .AND. l_LB_debug ) THEN
+ WRITE(numout,*) 'Exiting tra_npc , kt = ',kt,', => numb. of statically instable water-columns: ', inpcc
+ WRITE(numout,*)
ENDIF
!
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90 (revision 5602)
@@ -27,4 +27,5 @@
USE dom_oce ! ocean space and time domain variables
USE sbc_oce ! surface boundary condition: ocean
+ USE sbcrnf ! river runoffs
USE zdf_oce ! ocean vertical mixing
USE domvvl ! variable volume
@@ -143,6 +144,7 @@
ELSE ! Leap-Frog + Asselin filter time stepping
!
- IF( lk_vvl ) THEN ; CALL tra_nxt_vvl( kt, nit000, 'TRA', tsb, tsn, tsa, jpts ) ! variable volume level (vvl)
- ELSE ; CALL tra_nxt_fix( kt, nit000, 'TRA', tsb, tsn, tsa, jpts ) ! fixed volume level
+ IF( lk_vvl ) THEN ; CALL tra_nxt_vvl( kt, nit000, rdttra, 'TRA', tsb, tsn, tsa, &
+ & sbc_tsc, sbc_tsc_b, jpts ) ! variable volume level (vvl)
+ ELSE ; CALL tra_nxt_fix( kt, nit000, 'TRA', tsb, tsn, tsa, jpts ) ! fixed volume level
ENDIF
ENDIF
@@ -241,5 +243,5 @@
- SUBROUTINE tra_nxt_vvl( kt, kit000, cdtype, ptb, ptn, pta, kjpt )
+ SUBROUTINE tra_nxt_vvl( kt, kit000, p2dt, cdtype, ptb, ptn, pta, psbc_tc, psbc_tc_b, kjpt )
!!----------------------------------------------------------------------
!! *** ROUTINE tra_nxt_vvl ***
@@ -265,13 +267,17 @@
!! - (ta,sa) time averaged (t,s) (ln_dynhpg_imp = T)
!!----------------------------------------------------------------------
- INTEGER , INTENT(in ) :: kt ! ocean time-step index
- 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(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb ! before tracer fields
- REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptn ! now tracer fields
- REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend
+ INTEGER , INTENT(in ) :: kt ! ocean time-step index
+ INTEGER , INTENT(in ) :: kit000 ! first time step index
+ REAL(wp) , INTENT(in ), DIMENSION(jpk) :: p2dt ! time-step
+ CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)
+ INTEGER , INTENT(in ) :: kjpt ! number of tracers
+ REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb ! before tracer fields
+ REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptn ! now tracer fields
+ REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend
+ REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,kjpt) :: psbc_tc ! surface tracer content
+ REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,kjpt) :: psbc_tc_b ! before surface tracer content
+
!!
- LOGICAL :: ll_tra, ll_tra_hpg, ll_traqsr ! local logical
+ LOGICAL :: ll_tra_hpg, ll_traqsr, ll_rnf ! local logical
INTEGER :: ji, jj, jk, jn ! dummy loop indices
REAL(wp) :: zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d ! local scalar
@@ -286,16 +292,16 @@
!
IF( cdtype == 'TRA' ) THEN
- ll_tra = .TRUE. ! active tracers case
ll_tra_hpg = ln_dynhpg_imp ! active tracers case and semi-implicit hpg
ll_traqsr = ln_traqsr ! active tracers case and solar penetration
+ ll_rnf = ln_rnf ! active tracers case and river runoffs
ELSE
- ll_tra = .FALSE. ! passive tracers case
ll_tra_hpg = .FALSE. ! passive tracers case or NO semi-implicit hpg
ll_traqsr = .FALSE. ! active tracers case and NO solar penetration
+ ll_rnf = .FALSE. ! passive tracers or NO river runoffs
ENDIF
!
DO jn = 1, kjpt
DO jk = 1, jpkm1
- zfact1 = atfp * rdttra(jk)
+ zfact1 = atfp * p2dt(jk)
zfact2 = zfact1 / rau0
DO jj = 1, jpj
@@ -315,19 +321,24 @@
ztc_f = ztc_n + atfp * ztc_d
!
- IF( ll_tra .AND. jk == 1 ) THEN ! first level only for T & S
- ze3t_f = ze3t_f - zfact2 * ( emp_b(ji,jj) - emp(ji,jj) )
- ztc_f = ztc_f - zfact1 * ( sbc_tsc(ji,jj,jn) - sbc_tsc_b(ji,jj,jn) )
+ IF( jk == 1 ) THEN ! first level
+ ze3t_f = ze3t_f - zfact2 * ( emp_b(ji,jj) - emp(ji,jj) + rnf(ji,jj) - rnf_b(ji,jj) )
+ ztc_f = ztc_f - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) )
ENDIF
+
IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr ) & ! solar penetration (temperature only)
& ztc_f = ztc_f - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) )
- ze3t_f = 1.e0 / ze3t_f
- ptb(ji,jj,jk,jn) = ztc_f * ze3t_f ! ptb <-- ptn filtered
- ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn) ! ptn <-- pta
- !
- IF( ll_tra_hpg ) THEN ! semi-implicit hpg (T & S only)
- ze3t_d = 1.e0 / ( ze3t_n + rbcp * ze3t_d )
- pta(ji,jj,jk,jn) = ze3t_d * ( ztc_n + rbcp * ztc_d ) ! ta <-- Brown & Campana average
- ENDIF
+ IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) ) & ! river runoffs
+ & ztc_f = ztc_f - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) &
+ & * fse3t_n(ji,jj,jk) / h_rnf(ji,jj)
+
+ ze3t_f = 1.e0 / ze3t_f
+ ptb(ji,jj,jk,jn) = ztc_f * ze3t_f ! ptb <-- ptn filtered
+ ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn) ! ptn <-- pta
+ !
+ IF( ll_tra_hpg ) THEN ! semi-implicit hpg (T & S only)
+ ze3t_d = 1.e0 / ( ze3t_n + rbcp * ze3t_d )
+ pta(ji,jj,jk,jn) = ze3t_d * ( ztc_n + rbcp * ztc_d ) ! ta <-- Brown & Campana average
+ ENDIF
END DO
END DO
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90 (revision 5602)
@@ -32,5 +32,4 @@
USE wrk_nemo ! Memory Allocation
USE timing ! Timing
- USE sbc_ice, ONLY : lk_lim3
IMPLICIT NONE
@@ -38,5 +37,5 @@
PUBLIC tra_qsr ! routine called by step.F90 (ln_traqsr=T)
- PUBLIC tra_qsr_init ! routine called by opa.F90
+ PUBLIC tra_qsr_init ! routine called by nemogcm.F90
! !!* Namelist namtra_qsr: penetrative solar radiation
@@ -50,5 +49,5 @@
REAL(wp), PUBLIC :: rn_si0 !: very near surface depth of extinction (RGB & 2 bands)
REAL(wp), PUBLIC :: rn_si1 !: deepest depth of extinction (water type I) (2 bands)
-
+
! Module variables
REAL(wp) :: xsi0r !: inverse of rn_si0
@@ -165,9 +164,11 @@
CALL iom_put( 'qsr3d', etot3 ) ! Shortwave Radiation 3D distribution
! clem: store attenuation coefficient of the first ocean level
- IF ( lk_lim3 .AND. ln_qsr_ice ) THEN
+ IF ( ln_qsr_ice ) THEN
DO jj = 1, jpj
DO ji = 1, jpi
IF ( qsr(ji,jj) /= 0._wp ) THEN
fraqsr_1lev(ji,jj) = ( qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) )
+ ELSE
+ fraqsr_1lev(ji,jj) = 1.
ENDIF
END DO
@@ -233,5 +234,5 @@
END DO
! clem: store attenuation coefficient of the first ocean level
- IF ( lk_lim3 .AND. ln_qsr_ice ) THEN
+ IF ( ln_qsr_ice ) THEN
DO jj = 1, jpj
DO ji = 1, jpi
@@ -256,5 +257,5 @@
END DO
! clem: store attenuation coefficient of the first ocean level
- IF ( lk_lim3 .AND. ln_qsr_ice ) THEN
+ IF ( ln_qsr_ice ) THEN
fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp
ENDIF
@@ -279,5 +280,5 @@
END DO
! clem: store attenuation coefficient of the first ocean level
- IF ( lk_lim3 .AND. ln_qsr_ice ) THEN
+ IF ( ln_qsr_ice ) THEN
DO jj = 1, jpj
DO ji = 1, jpi
@@ -298,5 +299,5 @@
END DO
! clem: store attenuation coefficient of the first ocean level
- IF ( lk_lim3 .AND. ln_qsr_ice ) THEN
+ IF ( ln_qsr_ice ) THEN
fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp
ENDIF
@@ -324,5 +325,6 @@
& 'at it= ', kt,' date= ', ndastp
IF(lwp) WRITE(numout,*) '~~~~'
- CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b', qsr_hc )
+ CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b' , qsr_hc )
+ CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev', fraqsr_1lev ) ! default definition in sbcssm
!
ENDIF
@@ -379,9 +381,4 @@
!
IF( nn_timing == 1 ) CALL timing_start('tra_qsr_init')
- !
- ! Default value for fraqsr_1lev
- IF( .NOT. ln_rstart ) THEN
- fraqsr_1lev(:,:) = 1._wp
- ENDIF
!
CALL wrk_alloc( jpi, jpj, zekb, zekg, zekr )
@@ -412,5 +409,4 @@
WRITE(numout,*) ' RGB & 2 bands: shortess depth of extinction rn_si0 = ', rn_si0
WRITE(numout,*) ' 2 bands: longest depth of extinction rn_si1 = ', rn_si1
- WRITE(numout,*) ' light penetration for ice-model LIM3 ln_qsr_ice = ', ln_qsr_ice
ENDIF
@@ -564,4 +560,11 @@
ENDIF
!
+ ! initialisation of fraqsr_1lev used in sbcssm
+ IF( iom_varid( numror, 'fraqsr_1lev', ldstop = .FALSE. ) > 0 ) THEN
+ CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev' , fraqsr_1lev )
+ ELSE
+ fraqsr_1lev(:,:) = 1._wp ! default definition
+ ENDIF
+ !
CALL wrk_dealloc( jpi, jpj, zekb, zekg, zekr )
CALL wrk_dealloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea )
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90 (revision 5602)
@@ -9,4 +9,5 @@
!! 3.3 ! 2010-04 (M. Leclair, G. Madec) Forcing averaged over 2 time steps
!! - ! 2010-09 (C. Ethe, G. Madec) Merge TRA-TRC
+ !! 3.6 ! 2014-11 (P. Mathiot) isf melting forcing
!!----------------------------------------------------------------------
@@ -20,4 +21,5 @@
USE sbcmod ! ln_rnf
USE sbcrnf ! River runoff
+ USE sbcisf ! Ice shelf
USE traqsr ! solar radiation penetration
USE trd_oce ! trends: ocean variables
@@ -26,7 +28,4 @@
USE in_out_manager ! I/O manager
USE prtctl ! Print control
- USE sbcrnf ! River runoff
- USE sbcisf ! Ice shelf
- USE sbcmod ! ln_rnf
USE iom
USE lbclnk ! ocean lateral boundary conditions (or mpp link)
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90 (revision 5602)
@@ -88,4 +88,8 @@
& tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )
END SELECT
+ ! DRAKKAR SSS control {
+ ! JMM avoid negative salinities near river outlet ! Ugly fix
+ ! JMM : restore negative salinities to small salinities:
+ WHERE ( tsa(:,:,:,jp_sal) < 0._wp ) tsa(:,:,:,jp_sal) = 0.1_wp
IF( l_trdtra ) THEN ! save the vertical diffusive trends for further diagnostics
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90 (revision 5602)
@@ -122,5 +122,5 @@
DO jj=1, jpj
DO ji=1, jpi
- zwt(ji,jj,1:mikt(ji,jj)) = 0._wp
+ zwt(ji,jj,1) = 0._wp
END DO
END DO
@@ -184,6 +184,10 @@
DO jj = 2, jpjm1
DO ji = fs_2, fs_jpim1
- zwt(ji,jj,1:mikt(ji,jj)) = zwd(ji,jj,1:mikt(ji,jj))
- DO jk = mikt(ji,jj)+1, jpkm1
+ zwt(ji,jj,1) = zwd(ji,jj,1)
+ END DO
+ END DO
+ DO jk = 2, jpkm1
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1
zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwt(ji,jj,jk-1)
END DO
@@ -196,9 +200,13 @@
DO jj = 2, jpjm1
DO ji = fs_2, fs_jpim1
- ze3tb = ( 1. - r_vvl ) + r_vvl * fse3t_b(ji,jj,mikt(ji,jj))
- ze3tn = ( 1. - r_vvl ) + r_vvl * fse3t(ji,jj,mikt(ji,jj))
- pta(ji,jj,mikt(ji,jj),jn) = ze3tb * ptb(ji,jj,mikt(ji,jj),jn) &
- & + p2dt(mikt(ji,jj)) * ze3tn * pta(ji,jj,mikt(ji,jj),jn)
- DO jk = mikt(ji,jj)+1, jpkm1
+ ze3tb = ( 1. - r_vvl ) + r_vvl * fse3t_b(ji,jj,1)
+ ze3tn = ( 1. - r_vvl ) + r_vvl * fse3t(ji,jj,1)
+ pta(ji,jj,1,jn) = ze3tb * ptb(ji,jj,1,jn) &
+ & + p2dt(1) * ze3tn * pta(ji,jj,1,jn)
+ END DO
+ END DO
+ DO jk = 2, jpkm1
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1
ze3tb = ( 1. - r_vvl ) + r_vvl * fse3t_b(ji,jj,jk)
ze3tn = ( 1. - r_vvl ) + r_vvl * fse3t (ji,jj,jk)
@@ -213,5 +221,9 @@
DO ji = fs_2, fs_jpim1
pta(ji,jj,jpkm1,jn) = pta(ji,jj,jpkm1,jn) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1)
- DO jk = jpk-2, mikt(ji,jj), -1
+ END DO
+ END DO
+ DO jk = jpk-2, 1, -1
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1
pta(ji,jj,jk,jn) = ( pta(ji,jj,jk,jn) - zws(ji,jj,jk) * pta(ji,jj,jk+1,jn) ) &
& / zwt(ji,jj,jk) * tmask(ji,jj,jk)
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90 (revision 5602)
@@ -8,4 +8,5 @@
!! - ! 2004-03 (C. Ethe) adapted for passive tracers
!! 3.3 ! 2010-05 (C. Ethe, G. Madec) merge TRC-TRA
+ !! 3.6 ! 2014-11 (P. Mathiot) Add zps_hde_isf (needed to open a cavity)
!!======================================================================
@@ -27,5 +28,6 @@
PRIVATE
- PUBLIC zps_hde ! routine called by step.F90
+ PUBLIC zps_hde ! routine called by step.F90
+ PUBLIC zps_hde_isf ! routine called by step.F90
!! * Substitutions
@@ -40,6 +42,161 @@
SUBROUTINE zps_hde( kt, kjpt, pta, pgtu, pgtv, &
+ & prd, pgru, pgrv )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE zps_hde ***
+ !!
+ !! ** Purpose : Compute the horizontal derivative of T, S and rho
+ !! at u- and v-points with a linear interpolation for z-coordinate
+ !! with partial steps.
+ !!
+ !! ** Method : In z-coord with partial steps, scale factors on last
+ !! levels are different for each grid point, so that T, S and rd
+ !! points are not at the same depth as in z-coord. To have horizontal
+ !! gradients again, we interpolate T and S at the good depth :
+ !! Linear interpolation of T, S
+ !! Computation of di(tb) and dj(tb) by vertical interpolation:
+ !! di(t) = t~ - t(i,j,k) or t(i+1,j,k) - t~
+ !! dj(t) = t~ - t(i,j,k) or t(i,j+1,k) - t~
+ !! This formulation computes the two cases:
+ !! CASE 1 CASE 2
+ !! k-1 ___ ___________ k-1 ___ ___________
+ !! Ti T~ T~ Ti+1
+ !! _____ _____
+ !! k | |Ti+1 k Ti | |
+ !! | |____ ____| |
+ !! ___ | | | ___ | | |
+ !!
+ !! case 1-> e3w(i+1) >= e3w(i) ( and e3w(j+1) >= e3w(j) ) then
+ !! t~ = t(i+1,j ,k) + (e3w(i+1) - e3w(i)) * dk(Ti+1)/e3w(i+1)
+ !! ( t~ = t(i ,j+1,k) + (e3w(j+1) - e3w(j)) * dk(Tj+1)/e3w(j+1) )
+ !! or
+ !! case 2-> e3w(i+1) <= e3w(i) ( and e3w(j+1) <= e3w(j) ) then
+ !! t~ = t(i,j,k) + (e3w(i) - e3w(i+1)) * dk(Ti)/e3w(i )
+ !! ( t~ = t(i,j,k) + (e3w(j) - e3w(j+1)) * dk(Tj)/e3w(j ) )
+ !! Idem for di(s) and dj(s)
+ !!
+ !! For rho, we call eos which will compute rd~(t~,s~) at the right
+ !! depth zh from interpolated T and S for the different formulations
+ !! of the equation of state (eos).
+ !! Gradient formulation for rho :
+ !! di(rho) = rd~ - rd(i,j,k) or rd(i+1,j,k) - rd~
+ !!
+ !! ** Action : compute for top interfaces
+ !! - pgtu, pgtv: horizontal gradient of tracer at u- & v-points
+ !! - pgru, pgrv: horizontal gradient of rho (if present) at u- & v-points
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in ) :: kt ! ocean time-step index
+ INTEGER , INTENT(in ) :: kjpt ! number of tracers
+ REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pta ! 4D tracers fields
+ REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts
+ REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields
+ REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom)
+ !
+ INTEGER :: ji, jj, jn ! Dummy loop indices
+ INTEGER :: iku, ikv, ikum1, ikvm1 ! partial step level (ocean bottom level) at u- and v-points
+ REAL(wp) :: ze3wu, ze3wv, zmaxu, zmaxv ! temporary scalars
+ REAL(wp), DIMENSION(jpi,jpj) :: zri, zrj, zhi, zhj ! NB: 3rd dim=1 to use eos
+ REAL(wp), DIMENSION(jpi,jpj,kjpt) :: zti, ztj !
+ !!----------------------------------------------------------------------
+ !
+ IF( nn_timing == 1 ) CALL timing_start( 'zps_hde')
+ !
+ pgtu(:,:,:)=0.0_wp ; pgtv(:,:,:)=0.0_wp ;
+ zti (:,:,:)=0.0_wp ; ztj (:,:,:)=0.0_wp ;
+ zhi (:,: )=0.0_wp ; zhj (:,: )=0.0_wp ;
+ !
+ DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==!
+ !
+ DO jj = 1, jpjm1
+ DO ji = 1, jpim1
+ iku = mbku(ji,jj) ; ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points
+ ikv = mbkv(ji,jj) ; ikvm1 = MAX( ikv - 1 , 1 ) ! if level first is a p-step, ik.m1=1
+ ze3wu = fse3w(ji+1,jj ,iku) - fse3w(ji,jj,iku)
+ ze3wv = fse3w(ji ,jj+1,ikv) - fse3w(ji,jj,ikv)
+ !
+ ! i- direction
+ IF( ze3wu >= 0._wp ) THEN ! case 1
+ zmaxu = ze3wu / fse3w(ji+1,jj,iku)
+ ! interpolated values of tracers
+ zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) )
+ ! gradient of tracers
+ pgtu(ji,jj,jn) = umask(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )
+ ELSE ! case 2
+ zmaxu = -ze3wu / fse3w(ji,jj,iku)
+ ! interpolated values of tracers
+ zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) )
+ ! gradient of tracers
+ pgtu(ji,jj,jn) = umask(ji,jj,1) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) )
+ ENDIF
+ !
+ ! j- direction
+ IF( ze3wv >= 0._wp ) THEN ! case 1
+ zmaxv = ze3wv / fse3w(ji,jj+1,ikv)
+ ! interpolated values of tracers
+ ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) )
+ ! gradient of tracers
+ pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )
+ ELSE ! case 2
+ zmaxv = -ze3wv / fse3w(ji,jj,ikv)
+ ! interpolated values of tracers
+ ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) )
+ ! gradient of tracers
+ pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) )
+ ENDIF
+ END DO
+ END DO
+ CALL lbc_lnk( pgtu(:,:,jn), 'U', -1. ) ; CALL lbc_lnk( pgtv(:,:,jn), 'V', -1. ) ! Lateral boundary cond.
+ !
+ END DO
+
+ ! horizontal derivative of density anomalies (rd)
+ IF( PRESENT( prd ) ) THEN ! depth of the partial step level
+ pgru(:,:)=0.0_wp ; pgrv(:,:)=0.0_wp ;
+ DO jj = 1, jpjm1
+ DO ji = 1, jpim1
+ iku = mbku(ji,jj)
+ ikv = mbkv(ji,jj)
+ ze3wu = fse3w(ji+1,jj ,iku) - fse3w(ji,jj,iku)
+ ze3wv = fse3w(ji ,jj+1,ikv) - fse3w(ji,jj,ikv)
+ IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = fsdept(ji ,jj,iku) ! i-direction: case 1
+ ELSE ; zhi(ji,jj) = fsdept(ji+1,jj,iku) ! - - case 2
+ ENDIF
+ IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = fsdept(ji,jj ,ikv) ! j-direction: case 1
+ ELSE ; zhj(ji,jj) = fsdept(ji,jj+1,ikv) ! - - case 2
+ ENDIF
+ END DO
+ END DO
+
+ ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial
+ ! step and store it in zri, zrj for each case
+ CALL eos( zti, zhi, zri )
+ CALL eos( ztj, zhj, zrj )
+
+ ! Gradient of density at the last level
+ DO jj = 1, jpjm1
+ DO ji = 1, jpim1
+ iku = mbku(ji,jj)
+ ikv = mbkv(ji,jj)
+ ze3wu = fse3w(ji+1,jj ,iku) - fse3w(ji,jj,iku)
+ ze3wv = fse3w(ji ,jj+1,ikv) - fse3w(ji,jj,ikv)
+ IF( ze3wu >= 0._wp ) THEN ; pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji ,jj ) - prd(ji,jj,iku) ) ! i: 1
+ ELSE ; pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj ) ) ! i: 2
+ ENDIF
+ IF( ze3wv >= 0._wp ) THEN ; pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj ) - prd(ji,jj,ikv) ) ! j: 1
+ ELSE ; pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj ) ) ! j: 2
+ ENDIF
+ END DO
+ END DO
+ CALL lbc_lnk( pgru , 'U', -1. ) ; CALL lbc_lnk( pgrv , 'V', -1. ) ! Lateral boundary conditions
+ !
+ END IF
+ !
+ IF( nn_timing == 1 ) CALL timing_stop( 'zps_hde')
+ !
+ END SUBROUTINE zps_hde
+ !
+ SUBROUTINE zps_hde_isf( kt, kjpt, pta, pgtu, pgtv, &
& prd, pgru, pgrv, pmru, pmrv, pgzu, pgzv, pge3ru, pge3rv, &
- & sgtu, sgtv, sgru, sgrv, smru, smrv, sgzu, sgzv, sge3ru, sge3rv )
+ & pgtui, pgtvi, pgrui, pgrvi, pmrui, pmrvi, pgzui, pgzvi, pge3rui, pge3rvi )
!!----------------------------------------------------------------------
!! *** ROUTINE zps_hde ***
@@ -82,9 +239,9 @@
!!
!! ** Action : compute for top and bottom interfaces
- !! - pgtu, pgtv, sgtu, sgtv: horizontal gradient of tracer at u- & v-points
- !! - pgru, pgrv, sgru, sgtv: horizontal gradient of rho (if present) at u- & v-points
- !! - pmru, pmrv, smru, smrv: horizontal sum of rho at u- & v- point (used in dynhpg with vvl)
- !! - pgzu, pgzv, sgzu, sgzv: horizontal gradient of z at u- and v- point (used in dynhpg with vvl)
- !! - pge3ru, pge3rv, sge3ru, sge3rv: horizontal gradient of rho weighted by local e3w at u- & v-points
+ !! - pgtu, pgtv, pgtui, pgtvi: horizontal gradient of tracer at u- & v-points
+ !! - pgru, pgrv, pgrui, pgtvi: horizontal gradient of rho (if present) at u- & v-points
+ !! - pmru, pmrv, pmrui, pmrvi: horizontal sum of rho at u- & v- point (used in dynhpg with vvl)
+ !! - pgzu, pgzv, pgzui, pgzvi: horizontal gradient of z at u- and v- point (used in dynhpg with vvl)
+ !! - pge3ru, pge3rv, pge3rui, pge3rvi: horizontal gradient of rho weighted by local e3w at u- & v-points
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: kt ! ocean time-step index
@@ -92,5 +249,5 @@
REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pta ! 4D tracers fields
REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts
- REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: sgtu, sgtv ! hor. grad. of stra at u- & v-pts (ISF)
+ REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF)
REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields
REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom)
@@ -98,8 +255,8 @@
REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgzu, pgzv ! hor. grad of z at u- & v-pts (bottom)
REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pge3ru, pge3rv ! hor. grad of prd weighted by local e3w at u- & v-pts (bottom)
- REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: sgru, sgrv ! hor. grad of prd at u- & v-pts (top)
- REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: smru, smrv ! hor. sum of prd at u- & v-pts (top)
- REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: sgzu, sgzv ! hor. grad of z at u- & v-pts (top)
- REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: sge3ru, sge3rv ! hor. grad of prd weighted by local e3w at u- & v-pts (top)
+ REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgrui, pgrvi ! hor. grad of prd at u- & v-pts (top)
+ REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pmrui, pmrvi ! hor. sum of prd at u- & v-pts (top)
+ REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgzui, pgzvi ! hor. grad of z at u- & v-pts (top)
+ REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pge3rui, pge3rvi ! hor. grad of prd weighted by local e3w at u- & v-pts (top)
!
INTEGER :: ji, jj, jn ! Dummy loop indices
@@ -110,8 +267,8 @@
!!----------------------------------------------------------------------
!
- IF( nn_timing == 1 ) CALL timing_start( 'zps_hde')
+ IF( nn_timing == 1 ) CALL timing_start( 'zps_hde_isf')
!
pgtu(:,:,:)=0.0_wp ; pgtv(:,:,:)=0.0_wp ;
- sgtu(:,:,:)=0.0_wp ; sgtv(:,:,:)=0.0_wp ;
+ pgtui(:,:,:)=0.0_wp ; pgtvi(:,:,:)=0.0_wp ;
zti (:,:,:)=0.0_wp ; ztj (:,:,:)=0.0_wp ;
zhi (:,: )=0.0_wp ; zhj (:,: )=0.0_wp ;
@@ -256,5 +413,5 @@
zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,iku+1,jn) - pta(ji+1,jj,iku,jn) )
! gradient of tracers
- sgtu(ji,jj,jn) = umask(ji,jj,iku) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )
+ pgtui(ji,jj,jn) = umask(ji,jj,iku) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )
ELSE ! case 2
zmaxu = - ze3wu / fse3w(ji,jj,iku+1)
@@ -262,5 +419,5 @@
zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,iku+1,jn) - pta(ji,jj,iku,jn) )
! gradient of tracers
- sgtu(ji,jj,jn) = umask(ji,jj,iku) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) )
+ pgtui(ji,jj,jn) = umask(ji,jj,iku) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) )
ENDIF
!
@@ -271,5 +428,5 @@
ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikv+1,jn) - pta(ji,jj+1,ikv,jn) )
! gradient of tracers
- sgtv(ji,jj,jn) = vmask(ji,jj,ikv) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )
+ pgtvi(ji,jj,jn) = vmask(ji,jj,ikv) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )
ELSE ! case 2
zmaxv = - ze3wv / fse3w(ji,jj,ikv+1)
@@ -277,9 +434,9 @@
ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikv+1,jn) - pta(ji,jj,ikv,jn) )
! gradient of tracers
- sgtv(ji,jj,jn) = vmask(ji,jj,ikv) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) )
+ pgtvi(ji,jj,jn) = vmask(ji,jj,ikv) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) )
ENDIF
END DO!!
END DO!!
- CALL lbc_lnk( sgtu(:,:,jn), 'U', -1. ) ; CALL lbc_lnk( sgtv(:,:,jn), 'V', -1. ) ! Lateral boundary cond.
+ CALL lbc_lnk( pgtui(:,:,jn), 'U', -1. ) ; CALL lbc_lnk( pgtvi(:,:,jn), 'V', -1. ) ! Lateral boundary cond.
!
END DO
@@ -287,8 +444,8 @@
! horizontal derivative of density anomalies (rd)
IF( PRESENT( prd ) ) THEN ! depth of the partial step level
- sgru(:,:) =0.0_wp ; sgrv(:,:) =0.0_wp ;
- sgzu(:,:) =0.0_wp ; sgzv(:,:) =0.0_wp ;
- smru(:,:) =0.0_wp ; smru(:,:) =0.0_wp ;
- sge3ru(:,:)=0.0_wp ; sge3rv(:,:)=0.0_wp ;
+ pgrui(:,:) =0.0_wp ; pgrvi(:,:) =0.0_wp ;
+ pgzui(:,:) =0.0_wp ; pgzvi(:,:) =0.0_wp ;
+ pmrui(:,:) =0.0_wp ; pmrui(:,:) =0.0_wp ;
+ pge3rui(:,:)=0.0_wp ; pge3rvi(:,:)=0.0_wp ;
DO jj = 1, jpjm1
@@ -321,31 +478,31 @@
ze3wv = (gdepw_0(ji,jj+1,ikv+1) - gdept_0(ji,jj+1,ikv)) - (gdepw_0(ji,jj,ikv+1) - gdept_0(ji,jj,ikv))
IF( ze3wu >= 0._wp ) THEN
- sgzu (ji,jj) = (fsde3w(ji+1,jj,iku) + ze3wu) - fsde3w(ji,jj,iku)
- sgru (ji,jj) = umask(ji,jj,iku) * ( zri(ji,jj) - prd(ji,jj,iku) ) ! i: 1
- smru (ji,jj) = umask(ji,jj,iku) * ( zri(ji,jj) + prd(ji,jj,iku) ) ! i: 1
- sge3ru(ji,jj) = umask(ji,jj,iku+1) &
+ pgzui (ji,jj) = (fsde3w(ji+1,jj,iku) + ze3wu) - fsde3w(ji,jj,iku)
+ pgrui (ji,jj) = umask(ji,jj,iku) * ( zri(ji,jj) - prd(ji,jj,iku) ) ! i: 1
+ pmrui (ji,jj) = umask(ji,jj,iku) * ( zri(ji,jj) + prd(ji,jj,iku) ) ! i: 1
+ pge3rui(ji,jj) = umask(ji,jj,iku+1) &
* ( (fse3w(ji+1,jj,iku+1) - ze3wu) * (zri(ji,jj ) + prd(ji+1,jj,iku+1) + 2._wp) &
- fse3w(ji ,jj,iku+1) * (prd(ji,jj,iku) + prd(ji ,jj,iku+1) + 2._wp) ) ! i: 1
ELSE
- sgzu (ji,jj) = fsde3w(ji+1,jj,iku) - (fsde3w(ji,jj,iku) - ze3wu)
- sgru (ji,jj) = umask(ji,jj,iku) * ( prd(ji+1,jj,iku) - zri(ji,jj) ) ! i: 2
- smru (ji,jj) = umask(ji,jj,iku) * ( prd(ji+1,jj,iku) + zri(ji,jj) ) ! i: 2
- sge3ru(ji,jj) = umask(ji,jj,iku+1) &
+ pgzui (ji,jj) = fsde3w(ji+1,jj,iku) - (fsde3w(ji,jj,iku) - ze3wu)
+ pgrui (ji,jj) = umask(ji,jj,iku) * ( prd(ji+1,jj,iku) - zri(ji,jj) ) ! i: 2
+ pmrui (ji,jj) = umask(ji,jj,iku) * ( prd(ji+1,jj,iku) + zri(ji,jj) ) ! i: 2
+ pge3rui(ji,jj) = umask(ji,jj,iku+1) &
* ( fse3w(ji+1,jj,iku+1) * (prd(ji+1,jj,iku) + prd(ji+1,jj,iku+1) + 2._wp) &
-(fse3w(ji ,jj,iku+1) + ze3wu) * (zri(ji,jj ) + prd(ji ,jj,iku+1) + 2._wp) ) ! i: 2
ENDIF
IF( ze3wv >= 0._wp ) THEN
- sgzv (ji,jj) = (fsde3w(ji,jj+1,ikv) + ze3wv) - fsde3w(ji,jj,ikv)
- sgrv (ji,jj) = vmask(ji,jj,ikv) * ( zrj(ji,jj ) - prd(ji,jj,ikv) ) ! j: 1
- smrv (ji,jj) = vmask(ji,jj,ikv) * ( zrj(ji,jj ) + prd(ji,jj,ikv) ) ! j: 1
- sge3rv(ji,jj) = vmask(ji,jj,ikv+1) &
+ pgzvi (ji,jj) = (fsde3w(ji,jj+1,ikv) + ze3wv) - fsde3w(ji,jj,ikv)
+ pgrvi (ji,jj) = vmask(ji,jj,ikv) * ( zrj(ji,jj ) - prd(ji,jj,ikv) ) ! j: 1
+ pmrvi (ji,jj) = vmask(ji,jj,ikv) * ( zrj(ji,jj ) + prd(ji,jj,ikv) ) ! j: 1
+ pge3rvi(ji,jj) = vmask(ji,jj,ikv+1) &
* ( (fse3w(ji,jj+1,ikv+1) - ze3wv) * ( zrj(ji,jj ) + prd(ji,jj+1,ikv+1) + 2._wp) &
- fse3w(ji,jj ,ikv+1) * ( prd(ji,jj,ikv) + prd(ji,jj ,ikv+1) + 2._wp) ) ! j: 1
! + 2 due to the formulation in density and not in anomalie in hpg sco
ELSE
- sgzv (ji,jj) = fsde3w(ji,jj+1,ikv) - (fsde3w(ji,jj,ikv) - ze3wv)
- sgrv (ji,jj) = vmask(ji,jj,ikv) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) ) ! j: 2
- smrv (ji,jj) = vmask(ji,jj,ikv) * ( prd(ji,jj+1,ikv) + zrj(ji,jj) ) ! j: 2
- sge3rv(ji,jj) = vmask(ji,jj,ikv+1) &
+ pgzvi (ji,jj) = fsde3w(ji,jj+1,ikv) - (fsde3w(ji,jj,ikv) - ze3wv)
+ pgrvi (ji,jj) = vmask(ji,jj,ikv) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) ) ! j: 2
+ pmrvi (ji,jj) = vmask(ji,jj,ikv) * ( prd(ji,jj+1,ikv) + zrj(ji,jj) ) ! j: 2
+ pge3rvi(ji,jj) = vmask(ji,jj,ikv+1) &
* ( fse3w(ji,jj+1,ikv+1) * ( prd(ji,jj+1,ikv) + prd(ji,jj+1,ikv+1) + 2._wp) &
-(fse3w(ji,jj ,ikv+1) + ze3wv) * ( zrj(ji,jj ) + prd(ji,jj ,ikv+1) + 2._wp) ) ! j: 2
@@ -353,15 +510,14 @@
END DO
END DO
- CALL lbc_lnk( sgru , 'U', -1. ) ; CALL lbc_lnk( sgrv , 'V', -1. ) ! Lateral boundary conditions
- CALL lbc_lnk( smru , 'U', 1. ) ; CALL lbc_lnk( smrv , 'V', 1. ) ! Lateral boundary conditions
- CALL lbc_lnk( sgzu , 'U', -1. ) ; CALL lbc_lnk( sgzv , 'V', -1. ) ! Lateral boundary conditions
- CALL lbc_lnk( sge3ru , 'U', -1. ) ; CALL lbc_lnk( sge3rv , 'V', -1. ) ! Lateral boundary conditions
+ CALL lbc_lnk( pgrui , 'U', -1. ) ; CALL lbc_lnk( pgrvi , 'V', -1. ) ! Lateral boundary conditions
+ CALL lbc_lnk( pmrui , 'U', 1. ) ; CALL lbc_lnk( pmrvi , 'V', 1. ) ! Lateral boundary conditions
+ CALL lbc_lnk( pgzui , 'U', -1. ) ; CALL lbc_lnk( pgzvi , 'V', -1. ) ! Lateral boundary conditions
+ CALL lbc_lnk( pge3rui , 'U', -1. ) ; CALL lbc_lnk( pge3rvi , 'V', -1. ) ! Lateral boundary conditions
!
END IF
!
- IF( nn_timing == 1 ) CALL timing_stop( 'zps_hde')
- !
- END SUBROUTINE zps_hde
-
+ IF( nn_timing == 1 ) CALL timing_stop( 'zps_hde_isf')
+ !
+ END SUBROUTINE zps_hde_isf
!!======================================================================
END MODULE zpshde
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trd_oce.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trd_oce.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trd_oce.F90 (revision 5602)
@@ -76,5 +76,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2010)
- !! $Id: trd_oce.F90 3318 2012-02-25 15:50:01Z gm $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!======================================================================
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trddyn.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trddyn.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trddyn.F90 (revision 5602)
@@ -40,5 +40,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2010)
- !! $Id: trddyn.F90 3325 2012-03-12 14:44:43Z gm $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trdglo.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trdglo.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trdglo.F90 (revision 5602)
@@ -56,5 +56,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2010)
- !! $Id: trdglo.F90 3325 2012-03-12 14:44:43Z gm $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trdini.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trdini.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trdini.F90 (revision 5602)
@@ -30,5 +30,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2010)
- !! $Id: trdini.F90 3329 2012-03-16 12:22:15Z gm $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90 (revision 5602)
@@ -44,5 +44,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2010)
- !! $Id: trdken.F90 3329 2012-03-16 12:22:15Z gm $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90 (revision 5602)
@@ -77,5 +77,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2010)
- !! $Id: trdmxl.F90 3318 2012-02-25 15:50:01Z gm $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_oce.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_oce.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_oce.F90 (revision 5602)
@@ -83,5 +83,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 4.0 , NEMO Consortium (2011)
- !! $Id: $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_rst.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_rst.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_rst.F90 (revision 5602)
@@ -27,5 +27,5 @@
!!---------------------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2010)
- !! $Id: $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!---------------------------------------------------------------------------------
@@ -43,5 +43,6 @@
INTEGER :: jk ! loop indice
CHARACTER(LEN=20) :: clkt ! ocean time-step deine as a character
- CHARACTER(LEN=50) :: clname ! ice output restart file name
+ CHARACTER(LEN=50) :: clname ! output restart file name
+ CHARACTER(LEN=256) :: clpath ! full path to restart file
!!--------------------------------------------------------------------------------
@@ -56,4 +57,6 @@
! create the file
clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trdrst_out)
+ clpath = TRIM(cn_ocerst_outdir)
+ IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
IF(lwp) THEN
WRITE(numout,*)
@@ -67,5 +70,5 @@
ENDIF
- CALL iom_open( clname, nummxlw, ldwrt = .TRUE., kiolib = jprstlib )
+ CALL iom_open( TRIM(clpath)//TRIM(clname), nummxlw, ldwrt = .TRUE., kiolib = jprstlib )
ENDIF
@@ -133,4 +136,5 @@
INTEGER :: jlibalt = jprstlib
LOGICAL :: llok
+ CHARACTER(LEN=256) :: clpath ! full path to restart file
!!-----------------------------------------------------------------------------
@@ -140,8 +144,12 @@
WRITE(numout,*) ' ~~~~~~~~~~~~~~~~'
ENDIF
+
+ clpath = TRIM(cn_ocerst_indir)
+ IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
+
IF ( jprstlib == jprstdimg ) THEN
! eventually read netcdf file (monobloc) for restarting on different number of processors
! if {cn_trdrst_in}.nc exists, then set jlibalt to jpnf90
- INQUIRE( FILE = TRIM(cn_trdrst_in)//'.nc', EXIST = llok )
+ INQUIRE( FILE = TRIM(clpath)//TRIM(cn_trdrst_in)//'.nc', EXIST = llok )
IF ( llok ) THEN ; jlibalt = jpnf90
ELSE ; jlibalt = jprstlib
@@ -149,5 +157,5 @@
ENDIF
- CALL iom_open( cn_trdrst_in, inum, kiolib = jlibalt )
+ CALL iom_open( TRIM(clpath)//TRIM(cn_trdrst_in), inum, kiolib = jlibalt )
IF( ln_trdmxl_instant ) THEN
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90 (revision 5602)
@@ -41,5 +41,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2010)
- !! $Id: trdtra.F90 3318 2012-02-25 15:50:01Z gm $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trdtrc.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trdtrc.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRD/trdtrc.F90 (revision 5602)
@@ -18,5 +18,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2010)
- !! $Id: trdtrc.F90 2715 2011-03-30 15:58:35Z rblod $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!======================================================================
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90 (revision 5602)
@@ -120,13 +120,18 @@
zbfrt(ji,jj) = MAX(bfrcoef2d(ji,jj), ztmp)
zbfrt(ji,jj) = MIN(zbfrt(ji,jj), rn_bfri2_max)
-! (ISF)
- ikbt = mikt(ji,jj)
-! JC: possible WAD implementation should modify line below if layers vanish
- ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp
- ztfrt(ji,jj) = MAX(tfrcoef2d(ji,jj), ztmp)
- ztfrt(ji,jj) = MIN(ztfrt(ji,jj), rn_tfri2_max)
-
END DO
END DO
+! (ISF)
+ IF ( ln_isfcav ) THEN
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ ikbt = mikt(ji,jj)
+! JC: possible WAD implementation should modify line below if layers vanish
+ ztmp = (1-tmask(ji,jj,1)) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp
+ ztfrt(ji,jj) = MAX(tfrcoef2d(ji,jj), ztmp)
+ ztfrt(ji,jj) = MIN(ztfrt(ji,jj), rn_tfri2_max)
+ END DO
+ END DO
+ END IF
!
ELSE
@@ -152,44 +157,54 @@
!
! in case of 2 cell water column, we assume each cell feels the top and bottom friction
- IF ( miku(ji,jj) + 2 .GE. mbku(ji,jj) ) THEN
- bfrua(ji,jj) = - 0.5_wp * ( ( zbfrt(ji,jj) + zbfrt(ji+1,jj ) ) &
- & + ( ztfrt(ji,jj) + ztfrt(ji+1,jj ) ) ) &
- & * zecu * (1._wp - umask(ji,jj,1))
- END IF
- IF ( mikv(ji,jj) + 2 .GE. mbkv(ji,jj) ) THEN
- bfrva(ji,jj) = - 0.5_wp * ( ( zbfrt(ji,jj) + zbfrt(ji ,jj+1) ) &
- & + ( ztfrt(ji,jj) + ztfrt(ji ,jj+1) ) ) &
- & * zecv * (1._wp - vmask(ji,jj,1))
- END IF
- ! (ISF) ========================================================================
- ikbu = miku(ji,jj) ! ocean bottom level at u- and v-points
- ikbv = mikv(ji,jj) ! (deepest ocean u- and v-points)
- !
- zvu = 0.25 * ( vn(ji,jj ,ikbu) + vn(ji+1,jj ,ikbu) &
- & + vn(ji,jj-1,ikbu) + vn(ji+1,jj-1,ikbu) )
- zuv = 0.25 * ( un(ji,jj ,ikbv) + un(ji-1,jj ,ikbv) &
- & + un(ji,jj+1,ikbv) + un(ji-1,jj+1,ikbv) )
- !
- zecu = SQRT( un(ji,jj,ikbu) * un(ji,jj,ikbu) + zvu*zvu + rn_bfeb2 )
- zecv = SQRT( vn(ji,jj,ikbv) * vn(ji,jj,ikbv) + zuv*zuv + rn_bfeb2 )
- !
- tfrua(ji,jj) = - 0.5_wp * ( ztfrt(ji,jj) + ztfrt(ji+1,jj ) ) * zecu * (1._wp - umask(ji,jj,1))
- tfrva(ji,jj) = - 0.5_wp * ( ztfrt(ji,jj) + ztfrt(ji ,jj+1) ) * zecv * (1._wp - vmask(ji,jj,1))
- ! (ISF) END ====================================================================
- ! in case of 2 cell water column, we assume each cell feels the top and bottom friction
- IF ( miku(ji,jj) + 2 .GE. mbku(ji,jj) ) THEN
- tfrua(ji,jj) = - 0.5_wp * ( ( ztfrt(ji,jj) + ztfrt(ji+1,jj ) ) &
- & + ( zbfrt(ji,jj) + zbfrt(ji+1,jj ) ) ) &
- & * zecu * (1._wp - umask(ji,jj,1))
- END IF
- IF ( mikv(ji,jj) + 2 .GE. mbkv(ji,jj) ) THEN
- tfrva(ji,jj) = - 0.5_wp * ( ( ztfrt(ji,jj) + ztfrt(ji ,jj+1) ) &
- & + ( zbfrt(ji,jj) + zbfrt(ji ,jj+1) ) ) &
- & * zecv * (1._wp - vmask(ji,jj,1))
+ IF ( ln_isfcav ) THEN
+ IF ( miku(ji,jj) + 1 .GE. mbku(ji,jj) ) THEN
+ bfrua(ji,jj) = - 0.5_wp * ( ( zbfrt(ji,jj) + zbfrt(ji+1,jj ) ) &
+ & + ( ztfrt(ji,jj) + ztfrt(ji+1,jj ) ) ) &
+ & * zecu * (1._wp - umask(ji,jj,1))
+ END IF
+ IF ( mikv(ji,jj) + 1 .GE. mbkv(ji,jj) ) THEN
+ bfrva(ji,jj) = - 0.5_wp * ( ( zbfrt(ji,jj) + zbfrt(ji ,jj+1) ) &
+ & + ( ztfrt(ji,jj) + ztfrt(ji ,jj+1) ) ) &
+ & * zecv * (1._wp - vmask(ji,jj,1))
+ END IF
END IF
END DO
END DO
- !
CALL lbc_lnk( bfrua, 'U', 1. ) ; CALL lbc_lnk( bfrva, 'V', 1. ) ! Lateral boundary condition
+
+ IF ( ln_isfcav ) THEN
+ DO jj = 2, jpjm1
+ DO ji = 2, jpim1
+ ! (ISF) ========================================================================
+ ikbu = miku(ji,jj) ! ocean top level at u- and v-points
+ ikbv = mikv(ji,jj) ! (1st wet ocean u- and v-points)
+ !
+ zvu = 0.25 * ( vn(ji,jj ,ikbu) + vn(ji+1,jj ,ikbu) &
+ & + vn(ji,jj-1,ikbu) + vn(ji+1,jj-1,ikbu) )
+ zuv = 0.25 * ( un(ji,jj ,ikbv) + un(ji-1,jj ,ikbv) &
+ & + un(ji,jj+1,ikbv) + un(ji-1,jj+1,ikbv) )
+ !
+ zecu = SQRT( un(ji,jj,ikbu) * un(ji,jj,ikbu) + zvu*zvu + rn_tfeb2 )
+ zecv = SQRT( vn(ji,jj,ikbv) * vn(ji,jj,ikbv) + zuv*zuv + rn_tfeb2 )
+ !
+ tfrua(ji,jj) = - 0.5_wp * ( ztfrt(ji,jj) + ztfrt(ji+1,jj ) ) * zecu * (1._wp - umask(ji,jj,1))
+ tfrva(ji,jj) = - 0.5_wp * ( ztfrt(ji,jj) + ztfrt(ji ,jj+1) ) * zecv * (1._wp - vmask(ji,jj,1))
+ ! (ISF) END ====================================================================
+ ! in case of 2 cell water column, we assume each cell feels the top and bottom friction
+ IF ( miku(ji,jj) + 1 .GE. mbku(ji,jj) ) THEN
+ tfrua(ji,jj) = - 0.5_wp * ( ( ztfrt(ji,jj) + ztfrt(ji+1,jj ) ) &
+ & + ( zbfrt(ji,jj) + zbfrt(ji+1,jj ) ) ) &
+ & * zecu * (1._wp - umask(ji,jj,1))
+ END IF
+ IF ( mikv(ji,jj) + 1 .GE. mbkv(ji,jj) ) THEN
+ tfrva(ji,jj) = - 0.5_wp * ( ( ztfrt(ji,jj) + ztfrt(ji ,jj+1) ) &
+ & + ( zbfrt(ji,jj) + zbfrt(ji ,jj+1) ) ) &
+ & * zecv * (1._wp - vmask(ji,jj,1))
+ END IF
+ END DO
+ END DO
+ CALL lbc_lnk( tfrua, 'U', 1. ) ; CALL lbc_lnk( tfrva, 'V', 1. ) ! Lateral boundary condition
+ END IF
+ !
!
IF(ln_ctl) CALL prt_ctl( tab2d_1=bfrua, clinfo1=' bfr - u: ', mask1=umask, &
@@ -264,9 +279,11 @@
IF(lwp) WRITE(numout,*) ' coef rn_bfri2 enhancement factor rn_bfrien = ',rn_bfrien
ENDIF
- IF(lwp) WRITE(numout,*) ' top friction coef. rn_bfri1 = ', rn_bfri1
- IF( ln_tfr2d ) THEN
- IF(lwp) WRITE(numout,*) ' read coef. enhancement distribution from file ln_tfr2d = ', ln_tfr2d
- IF(lwp) WRITE(numout,*) ' coef rn_tfri2 enhancement factor rn_tfrien = ',rn_tfrien
- ENDIF
+ IF ( ln_isfcav ) THEN
+ IF(lwp) WRITE(numout,*) ' top friction coef. rn_bfri1 = ', rn_tfri1
+ IF( ln_tfr2d ) THEN
+ IF(lwp) WRITE(numout,*) ' read coef. enhancement distribution from file ln_tfr2d = ', ln_tfr2d
+ IF(lwp) WRITE(numout,*) ' coef rn_tfri2 enhancement factor rn_tfrien = ',rn_tfrien
+ ENDIF
+ END IF
!
IF(ln_bfr2d) THEN
@@ -282,4 +299,19 @@
bfrua(:,:) = - bfrcoef2d(:,:)
bfrva(:,:) = - bfrcoef2d(:,:)
+ !
+ IF ( ln_isfcav ) THEN
+ IF(ln_tfr2d) THEN
+ ! tfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement
+ CALL iom_open('tfr_coef.nc',inum)
+ CALL iom_get (inum, jpdom_data, 'tfr_coef',tfrcoef2d,1) ! tfrcoef2d is used as tmp array
+ CALL iom_close(inum)
+ tfrcoef2d(:,:) = rn_tfri1 * ( 1 + rn_tfrien * tfrcoef2d(:,:) )
+ ELSE
+ tfrcoef2d(:,:) = rn_tfri1 ! initialize tfrcoef2d to the namelist variable
+ ENDIF
+ !
+ tfrua(:,:) = - tfrcoef2d(:,:)
+ tfrva(:,:) = - tfrcoef2d(:,:)
+ END IF
!
CASE( 2 )
@@ -298,18 +330,20 @@
IF(lwp) WRITE(numout,*) ' coef rn_bfri2 enhancement factor rn_bfrien = ',rn_bfrien
ENDIF
- IF(lwp) WRITE(numout,*) ' quadratic top friction'
- IF(lwp) WRITE(numout,*) ' friction coef. rn_bfri2 = ', rn_tfri2
- IF(lwp) WRITE(numout,*) ' Max. coef. (log case) rn_tfri2_max = ', rn_tfri2_max
- IF(lwp) WRITE(numout,*) ' background tke rn_tfeb2 = ', rn_tfeb2
- IF(lwp) WRITE(numout,*) ' log formulation ln_tfr2d = ', ln_loglayer
- IF(lwp) WRITE(numout,*) ' bottom roughness rn_tfrz0 [m] = ', rn_tfrz0
- IF( rn_tfrz0<=0.e0 ) THEN
- WRITE(ctmp1,*) ' bottom roughness must be strictly positive'
- CALL ctl_stop( ctmp1 )
- ENDIF
- IF( ln_tfr2d ) THEN
- IF(lwp) WRITE(numout,*) ' read coef. enhancement distribution from file ln_tfr2d = ', ln_tfr2d
- IF(lwp) WRITE(numout,*) ' coef rn_tfri2 enhancement factor rn_tfrien = ',rn_tfrien
- ENDIF
+ IF ( ln_isfcav ) THEN
+ IF(lwp) WRITE(numout,*) ' quadratic top friction'
+ IF(lwp) WRITE(numout,*) ' friction coef. rn_tfri2 = ', rn_tfri2
+ IF(lwp) WRITE(numout,*) ' Max. coef. (log case) rn_tfri2_max = ', rn_tfri2_max
+ IF(lwp) WRITE(numout,*) ' background tke rn_tfeb2 = ', rn_tfeb2
+ IF(lwp) WRITE(numout,*) ' log formulation ln_tfr2d = ', ln_loglayer
+ IF(lwp) WRITE(numout,*) ' top roughness rn_tfrz0 [m] = ', rn_tfrz0
+ IF( rn_tfrz0<=0.e0 ) THEN
+ WRITE(ctmp1,*) ' top roughness must be strictly positive'
+ CALL ctl_stop( ctmp1 )
+ ENDIF
+ IF( ln_tfr2d ) THEN
+ IF(lwp) WRITE(numout,*) ' read coef. enhancement distribution from file ln_tfr2d = ', ln_tfr2d
+ IF(lwp) WRITE(numout,*) ' coef rn_tfri2 enhancement factor rn_tfrien = ',rn_tfrien
+ ENDIF
+ END IF
!
IF(ln_bfr2d) THEN
@@ -323,4 +357,17 @@
bfrcoef2d(:,:) = rn_bfri2 ! initialize bfrcoef2d to the namelist variable
ENDIF
+
+ IF ( ln_isfcav ) THEN
+ IF(ln_tfr2d) THEN
+ ! tfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement
+ CALL iom_open('tfr_coef.nc',inum)
+ CALL iom_get (inum, jpdom_data, 'tfr_coef',tfrcoef2d,1) ! tfrcoef2d is used as tmp array
+ CALL iom_close(inum)
+ !
+ tfrcoef2d(:,:) = rn_tfri2 * ( 1 + rn_tfrien * tfrcoef2d(:,:) )
+ ELSE
+ tfrcoef2d(:,:) = rn_tfri2 ! initialize tfrcoef2d to the namelist variable
+ ENDIF
+ END IF
!
IF ( ln_loglayer.AND.(.NOT.lk_vvl) ) THEN ! set "log layer" bottom friction once for all
@@ -333,4 +380,14 @@
END DO
END DO
+ IF ( ln_isfcav ) THEN
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ ikbt = mikt(ji,jj)
+ ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_tfrz0 ))**2._wp
+ tfrcoef2d(ji,jj) = MAX(tfrcoef2d(ji,jj), ztmp)
+ tfrcoef2d(ji,jj) = MIN(tfrcoef2d(ji,jj), rn_tfri2_max)
+ END DO
+ END DO
+ END IF
ENDIF
!
@@ -385,4 +442,28 @@
zminbfr = MIN( zminbfr, MIN( zfru, ABS( bfrcoef2d(ji,jj) ) ) )
zmaxbfr = MAX( zmaxbfr, MIN( zfrv, ABS( bfrcoef2d(ji,jj) ) ) )
+! (ISF)
+ IF ( ln_isfcav ) THEN
+ ikbu = miku(ji,jj) ! 1st wet ocean level at u- and v-points
+ ikbv = mikv(ji,jj)
+ zfru = 0.5 * fse3u(ji,jj,ikbu) / rdt
+ zfrv = 0.5 * fse3v(ji,jj,ikbv) / rdt
+ IF( ABS( tfrcoef2d(ji,jj) ) > zfru ) THEN
+ IF( ln_ctl ) THEN
+ WRITE(numout,*) 'TFR ', narea, nimpp+ji, njmpp+jj, ikbu
+ WRITE(numout,*) 'TFR ', ABS( tfrcoef2d(ji,jj) ), zfru
+ ENDIF
+ ictu = ictu + 1
+ ENDIF
+ IF( ABS( tfrcoef2d(ji,jj) ) > zfrv ) THEN
+ IF( ln_ctl ) THEN
+ WRITE(numout,*) 'TFR ', narea, nimpp+ji, njmpp+jj, ikbv
+ WRITE(numout,*) 'TFR ', tfrcoef2d(ji,jj), zfrv
+ ENDIF
+ ictv = ictv + 1
+ ENDIF
+ zmintfr = MIN( zmintfr, MIN( zfru, ABS( tfrcoef2d(ji,jj) ) ) )
+ zmaxtfr = MAX( zmaxtfr, MIN( zfrv, ABS( tfrcoef2d(ji,jj) ) ) )
+ END IF
+! END ISF
END DO
END DO
@@ -392,12 +473,14 @@
CALL mpp_min( zminbfr )
CALL mpp_max( zmaxbfr )
+ IF ( ln_isfcav) CALL mpp_min( zmintfr )
+ IF ( ln_isfcav) CALL mpp_max( zmaxtfr )
ENDIF
IF( .NOT.ln_bfrimp) THEN
IF( lwp .AND. ictu + ictv > 0 ) THEN
- WRITE(numout,*) ' Bottom friction stability check failed at ', ictu, ' U-points '
- WRITE(numout,*) ' Bottom friction stability check failed at ', ictv, ' V-points '
+ WRITE(numout,*) ' Bottom/Top friction stability check failed at ', ictu, ' U-points '
+ WRITE(numout,*) ' Bottom/Top friction stability check failed at ', ictv, ' V-points '
WRITE(numout,*) ' Bottom friction coefficient now ranges from: ', zminbfr, ' to ', zmaxbfr
- WRITE(numout,*) ' Bottom friction coefficient now ranges from: ', zmintfr, ' to ', zmaxtfr
- WRITE(numout,*) ' Bottom friction coefficient will be reduced where necessary'
+ IF ( ln_isfcav ) WRITE(numout,*) ' Top friction coefficient now ranges from: ', zmintfr, ' to ', zmaxtfr
+ WRITE(numout,*) ' Bottom/Top friction coefficient will be reduced where necessary'
ENDIF
ENDIF
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90 (revision 5602)
@@ -156,5 +156,5 @@
END DO
! mask zmsk in order to have avt and avs masked
- zmsks(:,:) = zmsks(:,:) * tmask(:,:,jk)
+ zmsks(:,:) = zmsks(:,:) * wmask(:,:,jk)
@@ -191,8 +191,8 @@
avmu(ji,jj,jk) = MAX( avmu(ji,jj,jk), &
& avt(ji,jj,jk), avt(ji+1,jj,jk), &
- & avs(ji,jj,jk), avs(ji+1,jj,jk) ) * umask(ji,jj,jk)
+ & avs(ji,jj,jk), avs(ji+1,jj,jk) ) * wumask(ji,jj,jk)
avmv(ji,jj,jk) = MAX( avmv(ji,jj,jk), &
& avt(ji,jj,jk), avt(ji,jj+1,jk), &
- & avs(ji,jj,jk), avs(ji,jj+1,jk) ) * vmask(ji,jj,jk)
+ & avs(ji,jj,jk), avs(ji,jj+1,jk) ) * wvmask(ji,jj,jk)
END DO
END DO
@@ -255,5 +255,5 @@
IF( zdf_ddm_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'zdf_ddm_init : unable to allocate arrays' )
! ! initialization to masked Kz
- avs(:,:,:) = rn_avt0 * tmask(:,:,:)
+ avs(:,:,:) = rn_avt0 * wmask(:,:,:)
!
END SUBROUTINE zdf_ddm_init
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90 (revision 5602)
@@ -20,4 +20,5 @@
USE domvvl ! ocean space and time domain : variable volume layer
USE zdf_oce ! ocean vertical physics
+ USE zdfbfr ! bottom friction (only for rn_bfrz0)
USE sbc_oce ! surface boundary condition: ocean
USE phycst ! physical constants
@@ -52,11 +53,9 @@
! !! ** Namelist namzdf_gls **
- LOGICAL :: ln_crban ! =T use Craig and Banner scheme
LOGICAL :: ln_length_lim ! use limit on the dissipation rate under stable stratification (Galperin et al. 1988)
LOGICAL :: ln_sigpsi ! Activate Burchard (2003) modification for k-eps closure & wave breaking mixing
- INTEGER :: nn_tkebc_surf ! TKE surface boundary condition (=0/1)
- INTEGER :: nn_tkebc_bot ! TKE bottom boundary condition (=0/1)
- INTEGER :: nn_psibc_surf ! PSI surface boundary condition (=0/1)
- INTEGER :: nn_psibc_bot ! PSI bottom boundary condition (=0/1)
+ INTEGER :: nn_bc_surf ! surface boundary condition (=0/1)
+ INTEGER :: nn_bc_bot ! bottom boundary condition (=0/1)
+ INTEGER :: nn_z0_met ! Method for surface roughness computation
INTEGER :: nn_stab_func ! stability functions G88, KC or Canuto (=0/1/2)
INTEGER :: nn_clos ! closure 0/1/2/3 MY82/k-eps/k-w/gen
@@ -66,7 +65,7 @@
REAL(wp) :: rn_charn ! Charnock constant for surface breaking waves mixing : 1400. (standard) or 2.e5 (Stacey value)
REAL(wp) :: rn_crban ! Craig and Banner constant for surface breaking waves mixing
-
- REAL(wp) :: hsro = 0.003_wp ! Minimum surface roughness
- REAL(wp) :: hbro = 0.003_wp ! Bottom roughness (m)
+ REAL(wp) :: rn_hsro ! Minimum surface roughness
+ REAL(wp) :: rn_frac_hs ! Fraction of wave height as surface roughness (if nn_z0_met > 1)
+
REAL(wp) :: rcm_sf = 0.73_wp ! Shear free turbulence parameters
REAL(wp) :: ra_sf = -2.0_wp ! Must be negative -2 < ra_sf < -1
@@ -96,10 +95,9 @@
REAL(wp) :: rm7 = 0.0_wp
REAL(wp) :: rm8 = 0.318_wp
-
+ REAL(wp) :: rtrans = 0.1_wp
REAL(wp) :: rc02, rc02r, rc03, rc04 ! coefficients deduced from above parameters
- REAL(wp) :: rc03_sqrt2_galp ! - - - -
- REAL(wp) :: rsbc_tke1, rsbc_tke2, rsbc_tke3, rfact_tke ! - - - -
- REAL(wp) :: rsbc_psi1, rsbc_psi2, rsbc_psi3, rfact_psi ! - - - -
- REAL(wp) :: rsbc_mb , rsbc_std , rsbc_zs ! - - - -
+ REAL(wp) :: rsbc_tke1, rsbc_tke2, rfact_tke ! - - - -
+ REAL(wp) :: rsbc_psi1, rsbc_psi2, rfact_psi ! - - - -
+ REAL(wp) :: rsbc_zs1, rsbc_zs2 ! - - - -
REAL(wp) :: rc0, rc2, rc3, rf6, rcff, rc_diff ! - - - -
REAL(wp) :: rs0, rs1, rs2, rs4, rs5, rs6 ! - - - -
@@ -147,4 +145,5 @@
REAL(wp) :: gh, gm, shr, dif, zsqen, zav ! - -
REAL(wp), POINTER, DIMENSION(:,: ) :: zdep
+ REAL(wp), POINTER, DIMENSION(:,: ) :: zkar
REAL(wp), POINTER, DIMENSION(:,: ) :: zflxs ! Turbulence fluxed induced by internal waves
REAL(wp), POINTER, DIMENSION(:,: ) :: zhsro ! Surface roughness (surface waves)
@@ -153,13 +152,16 @@
REAL(wp), POINTER, DIMENSION(:,:,:) :: shear ! vertical shear
REAL(wp), POINTER, DIMENSION(:,:,:) :: eps ! dissipation rate
- REAL(wp), POINTER, DIMENSION(:,:,:) :: zwall_psi ! Wall function use in the wb case (ln_sigpsi.AND.ln_crban=T)
- REAL(wp), POINTER, DIMENSION(:,:,:) :: z_elem_a, z_elem_b, z_elem_c, psi
+ REAL(wp), POINTER, DIMENSION(:,:,:) :: zwall_psi ! Wall function use in the wb case (ln_sigpsi)
+ REAL(wp), POINTER, DIMENSION(:,:,:) :: psi ! psi at time now
+ REAL(wp), POINTER, DIMENSION(:,:,:) :: z_elem_a ! element of the first matrix diagonal
+ REAL(wp), POINTER, DIMENSION(:,:,:) :: z_elem_b ! element of the second matrix diagonal
+ REAL(wp), POINTER, DIMENSION(:,:,:) :: z_elem_c ! element of the third matrix diagonal
!!--------------------------------------------------------------------
!
IF( nn_timing == 1 ) CALL timing_start('zdf_gls')
!
- CALL wrk_alloc( jpi,jpj, zdep, zflxs, zhsro )
- CALL wrk_alloc( jpi,jpj,jpk, eb, mxlb, shear, eps, zwall_psi, z_elem_a, z_elem_b, z_elem_c, psi )
-
+ CALL wrk_alloc( jpi,jpj, zdep, zkar, zflxs, zhsro )
+ CALL wrk_alloc( jpi,jpj,jpk, eb, mxlb, shear, eps, zwall_psi, z_elem_a, z_elem_b, z_elem_c, psi )
+
! Preliminary computing
@@ -174,27 +176,34 @@
! Compute surface and bottom friction at T-points
-!CDIR NOVERRCHK
- DO jj = 2, jpjm1
-!CDIR NOVERRCHK
- DO ji = fs_2, fs_jpim1 ! vector opt.
- !
- ! surface friction
+!CDIR NOVERRCHK
+ DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+ DO ji = fs_2, fs_jpim1 ! vector opt.
+ !
+ ! surface friction
ustars2(ji,jj) = r1_rau0 * taum(ji,jj) * tmask(ji,jj,1)
- !
- ! bottom friction (explicit before friction)
- ! Note that we chose here not to bound the friction as in dynbfr)
- ztx2 = ( bfrua(ji,jj) * ub(ji,jj,mbku(ji,jj)) + bfrua(ji-1,jj) * ub(ji-1,jj,mbku(ji-1,jj)) ) &
- & * ( 1._wp - 0.5_wp * umask(ji,jj,1) * umask(ji-1,jj,1) )
- zty2 = ( bfrva(ji,jj) * vb(ji,jj,mbkv(ji,jj)) + bfrva(ji,jj-1) * vb(ji,jj-1,mbkv(ji,jj-1)) ) &
- & * ( 1._wp - 0.5_wp * vmask(ji,jj,1) * vmask(ji,jj-1,1) )
- ustarb2(ji,jj) = SQRT( ztx2 * ztx2 + zty2 * zty2 ) * tmask(ji,jj,1)
- END DO
- END DO
-
- ! In case of breaking surface waves mixing,
- ! Compute surface roughness length according to Charnock formula:
- IF( ln_crban ) THEN ; zhsro(:,:) = MAX(rsbc_zs * ustars2(:,:), hsro)
- ELSE ; zhsro(:,:) = hsro
- ENDIF
+ !
+ ! bottom friction (explicit before friction)
+ ! Note that we chose here not to bound the friction as in dynbfr)
+ ztx2 = ( bfrua(ji,jj) * ub(ji,jj,mbku(ji,jj)) + bfrua(ji-1,jj) * ub(ji-1,jj,mbku(ji-1,jj)) ) &
+ & * ( 1._wp - 0.5_wp * umask(ji,jj,1) * umask(ji-1,jj,1) )
+ zty2 = ( bfrva(ji,jj) * vb(ji,jj,mbkv(ji,jj)) + bfrva(ji,jj-1) * vb(ji,jj-1,mbkv(ji,jj-1)) ) &
+ & * ( 1._wp - 0.5_wp * vmask(ji,jj,1) * vmask(ji,jj-1,1) )
+ ustarb2(ji,jj) = SQRT( ztx2 * ztx2 + zty2 * zty2 ) * tmask(ji,jj,1)
+ END DO
+ END DO
+
+ ! Set surface roughness length
+ SELECT CASE ( nn_z0_met )
+ !
+ CASE ( 0 ) ! Constant roughness
+ zhsro(:,:) = rn_hsro
+ CASE ( 1 ) ! Standard Charnock formula
+ zhsro(:,:) = MAX(rsbc_zs1 * ustars2(:,:), rn_hsro)
+ CASE ( 2 ) ! Roughness formulae according to Rascle et al., Ocean Modelling (2008)
+ zdep(:,:) = 30.*TANH(2.*0.3/(28.*SQRT(MAX(ustars2(:,:),rsmall)))) ! Wave age (eq. 10)
+ zhsro(:,:) = MAX(rsbc_zs2 * ustars2(:,:) * zdep(:,:)**1.5, rn_hsro) ! zhsro = rn_frac_hs * Hsw (eq. 11)
+ !
+ END SELECT
! Compute shear and dissipation rate
@@ -303,78 +312,47 @@
!
! Set surface condition on zwall_psi (1 at the bottom)
- IF( ln_sigpsi ) THEN
- zcoef = rsc_psi / rsc_psi0
- DO jj = 2, jpjm1
- DO ji = fs_2, fs_jpim1 ! vector opt.
- zwall_psi(ji,jj,1) = zcoef
- END DO
- END DO
- ENDIF
-
+ zwall_psi(:,:,1) = zwall_psi(:,:,2)
+ zwall_psi(:,:,jpk) = 1.
+ !
! Surface boundary condition on tke
! ---------------------------------
!
- SELECT CASE ( nn_tkebc_surf )
+ SELECT CASE ( nn_bc_surf )
!
CASE ( 0 ) ! Dirichlet case
- !
- IF (ln_crban) THEN ! Wave induced mixing case
- ! ! en(1) = q2(1) = 0.5 * (15.8 * Ccb)^(2/3) * u*^2
- ! ! balance between the production and the dissipation terms including the wave effect
- en(:,:,1) = MAX( rsbc_tke1 * ustars2(:,:), rn_emin )
- z_elem_a(:,:,1) = en(:,:,1)
- z_elem_c(:,:,1) = 0._wp
- z_elem_b(:,:,1) = 1._wp
- !
- ! one level below
- en(:,:,2) = MAX( rsbc_tke1 * ustars2(:,:) * ( (zhsro(:,:)+fsdepw(:,:,2))/zhsro(:,:) )**ra_sf, rn_emin )
- z_elem_a(:,:,2) = 0._wp
- z_elem_c(:,:,2) = 0._wp
- z_elem_b(:,:,2) = 1._wp
- !
- ELSE ! No wave induced mixing case
- ! ! en(1) = u*^2/C0^2 & l(1) = K*zs
- ! ! balance between the production and the dissipation terms
- en(:,:,1) = MAX( rc02r * ustars2(:,:), rn_emin )
- z_elem_a(:,:,1) = en(:,:,1)
- z_elem_c(:,:,1) = 0._wp
- z_elem_b(:,:,1) = 1._wp
- !
- ! one level below
- en(:,:,2) = MAX( rc02r * ustars2(:,:), rn_emin )
- z_elem_a(:,:,2) = 0._wp
- z_elem_c(:,:,2) = 0._wp
- z_elem_b(:,:,2) = 1._wp
- !
- ENDIF
- !
+ ! First level
+ en(:,:,1) = rc02r * ustars2(:,:) * (1._wp + rsbc_tke1)**(2._wp/3._wp)
+ en(:,:,1) = MAX(en(:,:,1), rn_emin)
+ z_elem_a(:,:,1) = en(:,:,1)
+ z_elem_c(:,:,1) = 0._wp
+ z_elem_b(:,:,1) = 1._wp
+ !
+ ! One level below
+ en(:,:,2) = rc02r * ustars2(:,:) * (1._wp + rsbc_tke1 * ((zhsro(:,:)+fsdepw(:,:,2))/zhsro(:,:) )**(1.5_wp*ra_sf))**(2._wp/3._wp)
+ en(:,:,2) = MAX(en(:,:,2), rn_emin )
+ z_elem_a(:,:,2) = 0._wp
+ z_elem_c(:,:,2) = 0._wp
+ z_elem_b(:,:,2) = 1._wp
+ !
+ !
CASE ( 1 ) ! Neumann boundary condition on d(e)/dz
- !
- IF (ln_crban) THEN ! Shear free case: d(e)/dz= Fw
- !
- ! Dirichlet conditions at k=1 (Cosmetic)
- en(:,:,1) = MAX( rsbc_tke1 * ustars2(:,:), rn_emin )
- z_elem_a(:,:,1) = en(:,:,1)
- z_elem_c(:,:,1) = 0._wp
- z_elem_b(:,:,1) = 1._wp
- ! at k=2, set de/dz=Fw
- z_elem_b(:,:,2) = z_elem_b(:,:,2) + z_elem_a(:,:,2) ! Remove z_elem_a from z_elem_b
- z_elem_a(:,:,2) = 0._wp
- zflxs(:,:) = rsbc_tke3 * ustars2(:,:)**1.5_wp * ( (zhsro(:,:)+fsdept(:,:,1) ) / zhsro(:,:) )**(1.5*ra_sf)
- en(:,:,2) = en(:,:,2) + zflxs(:,:) / fse3w(:,:,2)
- !
- ELSE ! No wave induced mixing case: d(e)/dz=0.
- !
- ! Dirichlet conditions at k=1 (Cosmetic)
- en(:,:,1) = MAX( rc02r * ustars2(:,:), rn_emin )
- z_elem_a(:,:,1) = en(:,:,1)
- z_elem_c(:,:,1) = 0._wp
- z_elem_b(:,:,1) = 1._wp
- ! at k=2 set de/dz=0.:
- z_elem_b(:,:,2) = z_elem_b(:,:,2) + z_elem_a(:,:,2) ! Remove z_elem_a from z_elem_b
- z_elem_a(:,:,2) = 0._wp
- !
- ENDIF
- !
+ !
+ ! Dirichlet conditions at k=1
+ en(:,:,1) = rc02r * ustars2(:,:) * (1._wp + rsbc_tke1)**(2._wp/3._wp)
+ en(:,:,1) = MAX(en(:,:,1), rn_emin)
+ z_elem_a(:,:,1) = en(:,:,1)
+ z_elem_c(:,:,1) = 0._wp
+ z_elem_b(:,:,1) = 1._wp
+ !
+ ! at k=2, set de/dz=Fw
+ !cbr
+ z_elem_b(:,:,2) = z_elem_b(:,:,2) + z_elem_a(:,:,2) ! Remove z_elem_a from z_elem_b
+ z_elem_a(:,:,2) = 0._wp
+ zkar(:,:) = (rl_sf + (vkarmn-rl_sf)*(1.-exp(-rtrans*fsdept(:,:,1)/zhsro(:,:)) ))
+ zflxs(:,:) = rsbc_tke2 * ustars2(:,:)**1.5_wp * zkar(:,:) * ((zhsro(:,:)+fsdept(:,:,1))/zhsro(:,:) )**(1.5_wp*ra_sf)
+
+ en(:,:,2) = en(:,:,2) + zflxs(:,:)/fse3w(:,:,2)
+ !
+ !
END SELECT
@@ -382,5 +360,5 @@
! --------------------------------
!
- SELECT CASE ( nn_tkebc_bot )
+ SELECT CASE ( nn_bc_bot )
!
CASE ( 0 ) ! Dirichlet
@@ -457,5 +435,5 @@
! ! set the minimum value of tke
en(:,:,:) = MAX( en(:,:,:), rn_emin )
-
+
!!----------------------------------------!!
!! Solve prognostic equation for psi !!
@@ -560,84 +538,48 @@
! ---------------------------------
!
- SELECT CASE ( nn_psibc_surf )
+ SELECT CASE ( nn_bc_surf )
!
CASE ( 0 ) ! Dirichlet boundary conditions
- !
- IF( ln_crban ) THEN ! Wave induced mixing case
- ! ! en(1) = q2(1) = 0.5 * (15.8 * Ccb)^(2/3) * u*^2
- ! ! balance between the production and the dissipation terms including the wave effect
- zdep(:,:) = rl_sf * zhsro(:,:)
- psi (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
- z_elem_a(:,:,1) = psi(:,:,1)
- z_elem_c(:,:,1) = 0._wp
- z_elem_b(:,:,1) = 1._wp
- !
- ! one level below
- zex1 = (rmm*ra_sf+rnn)
- zex2 = (rmm*ra_sf)
- zdep(:,:) = ( (zhsro(:,:) + fsdepw(:,:,2))**zex1 ) / zhsro(:,:)**zex2
- psi (:,:,2) = rsbc_psi1 * ustars2(:,:)**rmm * zdep(:,:) * tmask(:,:,1)
- z_elem_a(:,:,2) = 0._wp
- z_elem_c(:,:,2) = 0._wp
- z_elem_b(:,:,2) = 1._wp
- !
- ELSE ! No wave induced mixing case
- ! ! en(1) = u*^2/C0^2 & l(1) = K*zs
- ! ! balance between the production and the dissipation terms
- !
- zdep(:,:) = vkarmn * zhsro(:,:)
- psi (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
- z_elem_a(:,:,1) = psi(:,:,1)
- z_elem_c(:,:,1) = 0._wp
- z_elem_b(:,:,1) = 1._wp
- !
- ! one level below
- zdep(:,:) = vkarmn * ( zhsro(:,:) + fsdepw(:,:,2) )
- psi (:,:,2) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
- z_elem_a(:,:,2) = 0._wp
- z_elem_c(:,:,2) = 0._wp
- z_elem_b(:,:,2) = 1.
- !
- ENDIF
- !
+ !
+ ! Surface value
+ zdep(:,:) = zhsro(:,:) * rl_sf ! Cosmetic
+ psi (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
+ z_elem_a(:,:,1) = psi(:,:,1)
+ z_elem_c(:,:,1) = 0._wp
+ z_elem_b(:,:,1) = 1._wp
+ !
+ ! One level below
+ zkar(:,:) = (rl_sf + (vkarmn-rl_sf)*(1._wp-exp(-rtrans*fsdepw(:,:,2)/zhsro(:,:) )))
+ zdep(:,:) = (zhsro(:,:) + fsdepw(:,:,2)) * zkar(:,:)
+ psi (:,:,2) = rc0**rpp * en(:,:,2)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
+ z_elem_a(:,:,2) = 0._wp
+ z_elem_c(:,:,2) = 0._wp
+ z_elem_b(:,:,2) = 1._wp
+ !
+ !
CASE ( 1 ) ! Neumann boundary condition on d(psi)/dz
- !
- IF( ln_crban ) THEN ! Wave induced mixing case
- !
- zdep(:,:) = rl_sf * zhsro(:,:)
- psi (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
- z_elem_a(:,:,1) = psi(:,:,1)
- z_elem_c(:,:,1) = 0._wp
- z_elem_b(:,:,1) = 1._wp
- !
- ! Neumann condition at k=2
- z_elem_b(:,:,2) = z_elem_b(:,:,2) + z_elem_a(:,:,2) ! Remove z_elem_a from z_elem_b
- z_elem_a(:,:,2) = 0._wp
- !
- ! Set psi vertical flux at the surface:
- zdep(:,:) = (zhsro(:,:) + fsdept(:,:,1))**(rmm*ra_sf+rnn-1._wp) / zhsro(:,:)**(rmm*ra_sf)
- zflxs(:,:) = rsbc_psi3 * ( zwall_psi(:,:,1)*avm(:,:,1) + zwall_psi(:,:,2)*avm(:,:,2) ) &
- & * en(:,:,1)**rmm * zdep
- psi(:,:,2) = psi(:,:,2) + zflxs(:,:) / fse3w(:,:,2)
- !
- ELSE ! No wave induced mixing
- !
- zdep(:,:) = vkarmn * zhsro(:,:)
- psi (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
- z_elem_a(:,:,1) = psi(:,:,1)
- z_elem_c(:,:,1) = 0._wp
- z_elem_b(:,:,1) = 1._wp
- !
- ! Neumann condition at k=2
- z_elem_b(:,:,2) = z_elem_b(:,:,2) + z_elem_a(:,:,2) ! Remove z_elem_a from z_elem_b
- z_elem_a(ji,jj,2) = 0._wp
- !
- ! Set psi vertical flux at the surface:
- zdep(:,:) = zhsro(:,:) + fsdept(:,:,1)
- zflxs(:,:) = rsbc_psi2 * ( avm(:,:,1) + avm(:,:,2) ) * en(:,:,1)**rmm * zdep**(rnn-1._wp)
- psi(:,:,2) = psi(:,:,2) + zflxs(:,:) / fse3w(:,:,2)
- !
- ENDIF
- !
+ !
+ ! Surface value: Dirichlet
+ zdep(:,:) = zhsro(:,:) * rl_sf
+ psi (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
+ z_elem_a(:,:,1) = psi(:,:,1)
+ z_elem_c(:,:,1) = 0._wp
+ z_elem_b(:,:,1) = 1._wp
+ !
+ ! Neumann condition at k=2
+ z_elem_b(:,:,2) = z_elem_b(:,:,2) + z_elem_a(:,:,2) ! Remove z_elem_a from z_elem_b
+ z_elem_a(:,:,2) = 0._wp
+ !
+ ! Set psi vertical flux at the surface:
+ zkar(:,:) = rl_sf + (vkarmn-rl_sf)*(1._wp-exp(-rtrans*fsdept(:,:,1)/zhsro(:,:) )) ! Lengh scale slope
+ zdep(:,:) = ((zhsro(:,:) + fsdept(:,:,1)) / zhsro(:,:))**(rmm*ra_sf)
+ zflxs(:,:) = (rnn + rsbc_tke1 * (rnn + rmm*ra_sf) * zdep(:,:))*(1._wp + rsbc_tke1*zdep(:,:))**(2._wp*rmm/3._wp-1_wp)
+ zdep(:,:) = rsbc_psi1 * (zwall_psi(:,:,1)*avm(:,:,1)+zwall_psi(:,:,2)*avm(:,:,2)) * &
+ & ustars2(:,:)**rmm * zkar(:,:)**rnn * (zhsro(:,:) + fsdept(:,:,1))**(rnn-1.)
+ zflxs(:,:) = zdep(:,:) * zflxs(:,:)
+ psi(:,:,2) = psi(:,:,2) + zflxs(:,:) / fse3w(:,:,2)
+
+ !
+ !
END SELECT
@@ -645,8 +587,9 @@
! --------------------------------
!
- SELECT CASE ( nn_psibc_bot )
+ SELECT CASE ( nn_bc_bot )
+ !
!
CASE ( 0 ) ! Dirichlet
- ! ! en(ibot) = u*^2 / Co2 and mxln(ibot) = vkarmn * hbro
+ ! ! en(ibot) = u*^2 / Co2 and mxln(ibot) = vkarmn * rn_bfrz0
! ! Balance between the production and the dissipation terms
!CDIR NOVERRCHK
@@ -656,5 +599,5 @@
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 * hbro
+ zdep(ji,jj) = vkarmn * rn_bfrz0
psi (ji,jj,ibot) = rc0**rpp * en(ji,jj,ibot)**rmm * zdep(ji,jj)**rnn
z_elem_a(ji,jj,ibot) = 0._wp
@@ -663,5 +606,5 @@
!
! Just above last level, Dirichlet condition again (GOTM like)
- zdep(ji,jj) = vkarmn * ( hbro + fse3t(ji,jj,ibotm1) )
+ zdep(ji,jj) = vkarmn * ( rn_bfrz0 + fse3t(ji,jj,ibotm1) )
psi (ji,jj,ibotm1) = rc0**rpp * en(ji,jj,ibot )**rmm * zdep(ji,jj)**rnn
z_elem_a(ji,jj,ibotm1) = 0._wp
@@ -681,5 +624,5 @@
!
! Bottom level Dirichlet condition:
- zdep(ji,jj) = vkarmn * hbro
+ zdep(ji,jj) = vkarmn * rn_bfrz0
psi (ji,jj,ibot) = rc0**rpp * en(ji,jj,ibot)**rmm * zdep(ji,jj)**rnn
!
@@ -693,5 +636,5 @@
!
! Set psi vertical flux at the bottom:
- zdep(ji,jj) = hbro + 0.5_wp*fse3t(ji,jj,ibotm1)
+ zdep(ji,jj) = rn_bfrz0 + 0.5_wp*fse3t(ji,jj,ibotm1)
zflxb = rsbc_psi2 * ( avm(ji,jj,ibot) + avm(ji,jj,ibotm1) ) &
& * (0.5_wp*(en(ji,jj,ibot)+en(ji,jj,ibotm1)))**rmm * zdep(ji,jj)**(rnn-1._wp)
@@ -736,5 +679,5 @@
DO jj = 2, jpjm1
DO ji = fs_2, fs_jpim1 ! vector opt.
- eps(ji,jj,jk) = rc03 * en(ji,jj,jk) * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / psi(ji,jj,jk)
+ 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 DO
END DO
@@ -783,5 +726,5 @@
! Galperin criterium (NOTE : Not required if the proper value of C3 in stable cases is calculated)
zrn2 = MAX( rn2(ji,jj,jk), rsmall )
- mxln(ji,jj,jk) = MIN( rn_clim_galp * SQRT( 2._wp * en(ji,jj,jk) / zrn2 ), mxln(ji,jj,jk) )
+ IF (ln_length_lim) mxln(ji,jj,jk) = MIN( rn_clim_galp * SQRT( 2._wp * en(ji,jj,jk) / zrn2 ), mxln(ji,jj,jk) )
END DO
END DO
@@ -847,14 +790,10 @@
! Boundary conditions on stability functions for momentum (Neumann):
! Lines below are useless if GOTM style Dirichlet conditions are used
- zcoef = rcm_sf / SQRT( 2._wp )
+
+ avmv(:,:,1) = avmv(:,:,2)
+
DO jj = 2, jpjm1
DO ji = fs_2, fs_jpim1 ! vector opt.
- avmv(ji,jj,1) = zcoef
- END DO
- END DO
- zcoef = rc0 / SQRT( 2._wp )
- DO jj = 2, jpjm1
- DO ji = fs_2, fs_jpim1 ! vector opt.
- avmv(ji,jj,mbkt(ji,jj)+1) = zcoef
+ avmv(ji,jj,mbkt(ji,jj)+1) = avmv(ji,jj,mbkt(ji,jj))
END DO
END DO
@@ -900,5 +839,5 @@
avmv_k(:,:,:) = avmv(:,:,:)
!
- CALL wrk_dealloc( jpi,jpj, zdep, zflxs, zhsro )
+ CALL wrk_dealloc( jpi,jpj, zdep, zkar, zflxs, zhsro )
CALL wrk_dealloc( jpi,jpj,jpk, eb, mxlb, shear, eps, zwall_psi, z_elem_a, z_elem_b, z_elem_c, psi )
!
@@ -932,8 +871,7 @@
!!
NAMELIST/namzdf_gls/rn_emin, rn_epsmin, ln_length_lim, &
- & rn_clim_galp, ln_crban, ln_sigpsi, &
- & rn_crban, rn_charn, &
- & nn_tkebc_surf, nn_tkebc_bot, &
- & nn_psibc_surf, nn_psibc_bot, &
+ & rn_clim_galp, ln_sigpsi, rn_hsro, &
+ & rn_crban, rn_charn, rn_frac_hs, &
+ & nn_bc_surf, nn_bc_bot, nn_z0_met, &
& nn_stab_func, nn_clos
!!----------------------------------------------------------
@@ -955,21 +893,19 @@
WRITE(numout,*) '~~~~~~~~~~~~'
WRITE(numout,*) ' Namelist namzdf_gls : set gls mixing parameters'
- WRITE(numout,*) ' minimum value of en rn_emin = ', rn_emin
- WRITE(numout,*) ' minimum value of eps rn_epsmin = ', rn_epsmin
- WRITE(numout,*) ' Limit dissipation rate under stable stratif. ln_length_lim = ', ln_length_lim
- WRITE(numout,*) ' Galperin limit (Standard: 0.53, Holt: 0.26) rn_clim_galp = ', rn_clim_galp
- WRITE(numout,*) ' TKE Surface boundary condition nn_tkebc_surf = ', nn_tkebc_surf
- WRITE(numout,*) ' TKE Bottom boundary condition nn_tkebc_bot = ', nn_tkebc_bot
- WRITE(numout,*) ' PSI Surface boundary condition nn_psibc_surf = ', nn_psibc_surf
- WRITE(numout,*) ' PSI Bottom boundary condition nn_psibc_bot = ', nn_psibc_bot
- WRITE(numout,*) ' Craig and Banner scheme ln_crban = ', ln_crban
- WRITE(numout,*) ' Modify psi Schmidt number (wb case) ln_sigpsi = ', ln_sigpsi
+ WRITE(numout,*) ' minimum value of en rn_emin = ', rn_emin
+ WRITE(numout,*) ' minimum value of eps rn_epsmin = ', rn_epsmin
+ WRITE(numout,*) ' Limit dissipation rate under stable stratif. ln_length_lim = ', ln_length_lim
+ WRITE(numout,*) ' Galperin limit (Standard: 0.53, Holt: 0.26) rn_clim_galp = ', rn_clim_galp
+ WRITE(numout,*) ' TKE Surface boundary condition nn_bc_surf = ', nn_bc_surf
+ WRITE(numout,*) ' TKE Bottom boundary condition nn_bc_bot = ', nn_bc_bot
+ WRITE(numout,*) ' Modify psi Schmidt number (wb case) ln_sigpsi = ', ln_sigpsi
WRITE(numout,*) ' Craig and Banner coefficient rn_crban = ', rn_crban
WRITE(numout,*) ' Charnock coefficient rn_charn = ', rn_charn
+ WRITE(numout,*) ' Surface roughness formula nn_z0_met = ', nn_z0_met
+ WRITE(numout,*) ' Wave height frac. (used if nn_z0_met=2) rn_frac_hs = ', rn_frac_hs
WRITE(numout,*) ' Stability functions nn_stab_func = ', nn_stab_func
WRITE(numout,*) ' Type of closure nn_clos = ', nn_clos
- WRITE(numout,*) ' Hard coded parameters'
- WRITE(numout,*) ' Surface roughness (m) hsro = ', hsro
- WRITE(numout,*) ' Bottom roughness (m) hbro = ', hbro
+ WRITE(numout,*) ' Surface roughness (m) rn_hsro = ', rn_hsro
+ WRITE(numout,*) ' Bottom roughness (m) (nambfr namelist) rn_bfrz0 = ', rn_bfrz0
ENDIF
@@ -978,8 +914,7 @@
! !* Check of some namelist values
- IF( nn_tkebc_surf < 0 .OR. nn_tkebc_surf > 1 ) CALL ctl_stop( 'bad flag: nn_tkebc_surf is 0 or 1' )
- IF( nn_psibc_surf < 0 .OR. nn_psibc_surf > 1 ) CALL ctl_stop( 'bad flag: nn_psibc_surf is 0 or 1' )
- IF( nn_tkebc_bot < 0 .OR. nn_tkebc_bot > 1 ) CALL ctl_stop( 'bad flag: nn_tkebc_bot is 0 or 1' )
- IF( nn_psibc_bot < 0 .OR. nn_psibc_bot > 1 ) CALL ctl_stop( 'bad flag: nn_psibc_bot is 0 or 1' )
+ IF( nn_bc_surf < 0 .OR. nn_bc_surf > 1 ) CALL ctl_stop( 'bad flag: nn_bc_surf is 0 or 1' )
+ IF( nn_bc_surf < 0 .OR. nn_bc_surf > 1 ) CALL ctl_stop( 'bad flag: nn_bc_surf is 0 or 1' )
+ IF( nn_z0_met < 0 .OR. nn_z0_met > 2 ) CALL ctl_stop( 'bad flag: nn_z0_met is 0, 1 or 2' )
IF( nn_stab_func < 0 .OR. nn_stab_func > 3 ) CALL ctl_stop( 'bad flag: nn_stab_func is 0, 1, 2 and 3' )
IF( nn_clos < 0 .OR. nn_clos > 3 ) CALL ctl_stop( 'bad flag: nn_clos is 0, 1, 2 or 3' )
@@ -1001,5 +936,5 @@
SELECT CASE ( nn_stab_func )
CASE( 0, 1 ) ; rpsi3m = 2.53_wp ! G88 or KC stability functions
- CASE( 2 ) ; rpsi3m = 2.38_wp ! Canuto A stability functions
+ CASE( 2 ) ; rpsi3m = 2.62_wp ! Canuto A stability functions
CASE( 3 ) ; rpsi3m = 2.38 ! Canuto B stability functions (caution : constant not identified)
END SELECT
@@ -1012,5 +947,5 @@
rnn = -1._wp
rsc_tke = 1._wp
- rsc_psi = 1.3_wp ! Schmidt number for psi
+ rsc_psi = 1.2_wp ! Schmidt number for psi
rpsi1 = 1.44_wp
rpsi3p = 1._wp
@@ -1140,9 +1075,10 @@
! ! See Eq. (13) of Carniel et al, OM, 30, 225-239, 2009
! ! or Eq. (17) of Burchard, JPO, 31, 3133-3145, 2001
- IF( ln_sigpsi .AND. ln_crban ) THEN
- zcr = SQRT( 1.5_wp*rsc_tke ) * rcm_sf / vkarmn
- rsc_psi0 = vkarmn*vkarmn / ( rpsi2 * rcm_sf*rcm_sf ) &
- & * ( rnn*rnn - 4._wp/3._wp * zcr*rnn*rmm - 1._wp/3._wp * zcr*rnn &
- & + 2._wp/9._wp * rmm * zcr*zcr + 4._wp/9._wp * zcr*zcr * rmm*rmm )
+ IF( ln_sigpsi ) THEN
+ ra_sf = -1.5 ! Set kinetic energy slope, then deduce rsc_psi and rl_sf
+ ! Verification: retrieve Burchard (2001) results by uncomenting the line below:
+ ! Note that the results depend on the value of rn_cm_sf which is constant (=rc0) in his work
+ ! ra_sf = -SQRT(2./3.*rc0**3./rn_cm_sf*rn_sc_tke)/vkarmn
+ rsc_psi0 = rsc_tke/(24.*rpsi2)*(-1.+(4.*rnn + ra_sf*(1.+4.*rmm))**2./(ra_sf**2.))
ELSE
rsc_psi0 = rsc_psi
@@ -1151,11 +1087,17 @@
! !* Shear free turbulence parameters
!
- ra_sf = -4._wp * rnn * SQRT( rsc_tke ) / ( (1._wp+4._wp*rmm) * SQRT( rsc_tke ) &
- & - SQRT(rsc_tke + 24._wp*rsc_psi0*rpsi2 ) )
- rl_sf = rc0 * SQRT( rc0 / rcm_sf ) &
- & * SQRT( ( (1._wp + 4._wp*rmm + 8._wp*rmm*rmm) * rsc_tke &
- & + 12._wp * rsc_psi0 * rpsi2 &
- & - (1._wp + 4._wp*rmm) * SQRT( rsc_tke*(rsc_tke+ 24._wp*rsc_psi0*rpsi2) ) ) &
- & / ( 12._wp*rnn*rnn ) )
+ ra_sf = -4._wp*rnn*SQRT(rsc_tke) / ( (1._wp+4._wp*rmm)*SQRT(rsc_tke) &
+ & - SQRT(rsc_tke + 24._wp*rsc_psi0*rpsi2 ) )
+
+ IF ( rn_crban==0._wp ) THEN
+ rl_sf = vkarmn
+ ELSE
+ rl_sf = rc0 * SQRT(rc0/rcm_sf) * SQRT( ( (1._wp + 4._wp*rmm + 8._wp*rmm**2_wp)*rsc_tke &
+ & + 12._wp * rsc_psi0*rpsi2 - (1._wp + 4._wp*rmm) &
+ & *SQRT(rsc_tke*(rsc_tke &
+ & + 24._wp*rsc_psi0*rpsi2)) ) &
+ & /(12._wp*rnn**2.) &
+ & )
+ ENDIF
!
@@ -1187,16 +1129,15 @@
rc03 = rc02 * rc0
rc04 = rc03 * rc0
- rc03_sqrt2_galp = rc03 / SQRT(2._wp) / rn_clim_galp
- rsbc_mb = 0.5_wp * (15.8_wp*rn_crban)**(2._wp/3._wp) ! Surf. bound. cond. from Mellor and Blumberg
- rsbc_std = 3.75_wp ! Surf. bound. cond. standard (prod=diss)
- rsbc_tke1 = (-rsc_tke*rn_crban/(rcm_sf*ra_sf*rl_sf))**(2._wp/3._wp) ! k_eps = 53. Dirichlet + Wave breaking
- rsbc_tke2 = 0.5_wp / rau0
- rsbc_tke3 = rdt * rn_crban ! Neumann + Wave breaking
- rsbc_zs = rn_charn / grav ! Charnock formula
- rsbc_psi1 = rc0**rpp * rsbc_tke1**rmm * rl_sf**rnn ! Dirichlet + Wave breaking
- rsbc_psi2 = -0.5_wp * rdt * rc0**rpp * rnn * vkarmn**rnn / rsc_psi ! Neumann + NO Wave breaking
- rsbc_psi3 = -0.5_wp * rdt * rc0**rpp * rl_sf**rnn / rsc_psi * (rnn + rmm*ra_sf) ! Neumann + Wave breaking
- rfact_tke = -0.5_wp / rsc_tke * rdt ! Cst used for the Diffusion term of tke
- rfact_psi = -0.5_wp / rsc_psi * rdt ! Cst used for the Diffusion term of tke
+ rsbc_tke1 = -3._wp/2._wp*rn_crban*ra_sf*rl_sf ! Dirichlet + Wave breaking
+ rsbc_tke2 = rdt * rn_crban / rl_sf ! Neumann + Wave breaking
+ zcr = MAX(rsmall, rsbc_tke1**(1./(-ra_sf*3._wp/2._wp))-1._wp )
+ rtrans = 0.2_wp / zcr ! Ad. inverse transition length between log and wave layer
+ rsbc_zs1 = rn_charn/grav ! Charnock formula for surface roughness
+ rsbc_zs2 = rn_frac_hs / 0.85_wp / grav * 665._wp ! Rascle formula for surface roughness
+ rsbc_psi1 = -0.5_wp * rdt * rc0**(rpp-2._wp*rmm) / rsc_psi
+ rsbc_psi2 = -0.5_wp * rdt * rc0**rpp * rnn * vkarmn**rnn / rsc_psi ! Neumann + NO Wave breaking
+
+ rfact_tke = -0.5_wp / rsc_tke * rdt ! Cst used for the Diffusion term of tke
+ rfact_psi = -0.5_wp / rsc_psi * rdt ! Cst used for the Diffusion term of tke
! !* Wall proximity function
@@ -1257,5 +1198,5 @@
IF(lwp) WRITE(numout,*) ' ===>>>> : previous run without gls scheme, en and mxln computed by iterative loop'
en (:,:,:) = rn_emin
- mxln(:,:,:) = 0.001
+ mxln(:,:,:) = 0.05
avt_k (:,:,:) = avt (:,:,:)
avm_k (:,:,:) = avm (:,:,:)
@@ -1267,5 +1208,5 @@
IF(lwp) WRITE(numout,*) ' ===>>>> : Initialisation of en and mxln by background values'
en (:,:,:) = rn_emin
- mxln(:,:,:) = 0.001
+ mxln(:,:,:) = 0.05
ENDIF
!
@@ -1273,8 +1214,8 @@
! ! -------------------
IF(lwp) WRITE(numout,*) '---- gls-rst ----'
- CALL iom_rstput( kt, nitrst, numrow, 'en' , en )
+ CALL iom_rstput( kt, nitrst, numrow, 'en' , en )
CALL iom_rstput( kt, nitrst, numrow, 'avt' , avt_k )
CALL iom_rstput( kt, nitrst, numrow, 'avm' , avm_k )
- CALL iom_rstput( kt, nitrst, numrow, 'avmu' , avmu_k )
+ CALL iom_rstput( kt, nitrst, numrow, 'avmu' , avmu_k )
CALL iom_rstput( kt, nitrst, numrow, 'avmv' , avmv_k )
CALL iom_rstput( kt, nitrst, numrow, 'mxln' , mxln )
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90 (revision 5602)
@@ -14,5 +14,4 @@
!!----------------------------------------------------------------------
USE par_oce ! mesh and scale factors
- USE sbc_oce ! surface module (only for nn_isf in the option compatibility test)
USE ldftra_oce ! ocean active tracers: lateral physics
USE ldfdyn_oce ! ocean dynamics lateral physics
@@ -118,5 +117,5 @@
IF( ioptio == 0 .OR. ioptio > 1 .AND. .NOT. lk_esopa ) &
& CALL ctl_stop( ' one and only one vertical diffusion option has to be defined ' )
- IF( ( lk_zdfric .OR. lk_zdfgls .OR. lk_zdfkpp ) .AND. nn_isf .NE. 0 ) &
+ IF( ( lk_zdfric .OR. lk_zdfgls .OR. lk_zdfkpp ) .AND. ln_isfcav ) &
& CALL ctl_stop( ' only zdfcst and zdftke were tested with ice shelves cavities ' )
!
@@ -125,6 +124,7 @@
IF(lwp) WRITE(numout,*) ' convection :'
!
- IF( ln_zdfnpc ) CALL ctl_stop( ' zdf_init: non penetrative convective scheme is not working', &
- & ' set ln_zdfnpc to FALSE' )
+#if defined key_top
+ IF( ln_zdfnpc ) CALL ctl_stop( ' zdf_init: npc scheme is not working with key_top' )
+#endif
!
ioptio = 0
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90 (revision 5602)
@@ -26,4 +26,5 @@
!! ! + cleaning of the parameters + bugs correction
!! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase
+ !! 3.6 ! 2014-11 (P. Mathiot) add ice shelf capability
!!----------------------------------------------------------------------
#if defined key_zdftke || defined key_esopa
@@ -236,14 +237,18 @@
zfact3 = 0.5_wp * rn_ediss
!
+ !
! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
! ! Surface boundary condition on tke
! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+ IF ( ln_isfcav ) THEN
+ DO jj = 2, jpjm1 ! en(mikt(ji,jj)) = rn_emin
+ DO ji = fs_2, fs_jpim1 ! vector opt.
+ en(ji,jj,mikt(ji,jj))=rn_emin * tmask(ji,jj,1)
+ END DO
+ END DO
+ END IF
DO jj = 2, jpjm1 ! en(1) = rn_ebb taum / rau0 (min value rn_emin0)
DO ji = fs_2, fs_jpim1 ! vector opt.
- IF (mikt(ji,jj) .GT. 1) THEN
- en(ji,jj,mikt(ji,jj))=rn_emin
- ELSE
- en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1)
- END IF
+ en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1)
END DO
END DO
@@ -301,6 +306,9 @@
END DO
zcof = 0.016 / SQRT( zrhoa * zcdrag )
+!CDIR NOVERRCHK
DO jk = 2, jpkm1 !* TKE Langmuir circulation source term added to en
- DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+ DO jj = 2, jpjm1
+!CDIR NOVERRCHK
DO ji = fs_2, fs_jpim1 ! vector opt.
zus = zcof * SQRT( taum(ji,jj) ) ! Stokes drift
@@ -309,5 +317,5 @@
zwlc = zind * rn_lc * zus * SIN( rpi * fsdepw(ji,jj,jk) / zhlc(ji,jj) )
! ! TKE Langmuir circulation source term
- en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj) * tmask(ji,jj,jk)
+ en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1)
END DO
END DO
@@ -328,6 +336,6 @@
avmu(ji,jj,jk) = avmu(ji,jj,jk) * ( un(ji,jj,jk-1) - un(ji,jj,jk) ) &
& * ( ub(ji,jj,jk-1) - ub(ji,jj,jk) ) &
- & / ( fse3uw_n(ji,jj,jk) &
- & * fse3uw_b(ji,jj,jk) )
+ & / ( fse3uw_n(ji,jj,jk) &
+ & * fse3uw_b(ji,jj,jk) )
avmv(ji,jj,jk) = avmv(ji,jj,jk) * ( vn(ji,jj,jk-1) - vn(ji,jj,jk) ) &
& * ( vb(ji,jj,jk-1) - vb(ji,jj,jk) ) &
@@ -338,7 +346,7 @@
END DO
!
- DO jj = 2, jpjm1
- DO ji = fs_2, fs_jpim1 ! vector opt.
- DO jk = mikt(ji,jj)+1, jpkm1 !* Matrix and right hand side in en
+ DO jk = 2, jpkm1 !* Matrix and right hand side in en
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
zcof = zfact1 * tmask(ji,jj,jk)
zzd_up = zcof * ( avm (ji,jj,jk+1) + avm (ji,jj,jk ) ) & ! upper diagonal
@@ -357,26 +365,48 @@
en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( zesh2 - avt(ji,jj,jk) * rn2(ji,jj,jk) &
& + zfact3 * dissl(ji,jj,jk) * en (ji,jj,jk) ) &
- & * tmask(ji,jj,jk) * tmask(ji,jj,jk-1)
- END DO
- ! !* Matrix inversion from level 2 (tke prescribed at level 1)
- DO jk = mikt(ji,jj)+2, jpkm1 ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
+ & * wmask(ji,jj,jk)
+ END DO
+ END DO
+ END DO
+ ! !* Matrix inversion from level 2 (tke prescribed at level 1)
+ DO jk = 3, jpkm1 ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
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 DO
- ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
- zd_lw(ji,jj,mikt(ji,jj)+1) = en(ji,jj,mikt(ji,jj)+1) - zd_lw(ji,jj,mikt(ji,jj)+1) * en(ji,jj,mikt(ji,jj)) ! Surface boudary conditions on tke
- !
- DO jk = mikt(ji,jj)+2, jpkm1
+ END DO
+ END DO
+ !
+ ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
+ zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1) ! Surface boudary conditions on tke
+ END DO
+ END DO
+ DO jk = 3, jpkm1
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
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 DO
- !
- ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
+ END DO
+ END DO
+ !
+ ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
en(ji,jj,jpkm1) = zd_lw(ji,jj,jpkm1) / zdiag(ji,jj,jpkm1)
- !
- DO jk = jpk-2, mikt(ji,jj)+1, -1
+ END DO
+ END DO
+ DO jk = jpk-2, 2, -1
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk)
END DO
- !
- DO jk = mikt(ji,jj), jpkm1 ! set the minimum value of tke
- en(ji,jj,jk) = MAX( en(ji,jj,jk), rn_emin ) * tmask(ji,jj,jk)
+ END DO
+ END DO
+ DO jk = 2, jpkm1 ! set the minimum value of tke
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
+ en(ji,jj,jk) = MAX( en(ji,jj,jk), rn_emin ) * wmask(ji,jj,jk)
END DO
END DO
@@ -391,5 +421,5 @@
DO ji = fs_2, fs_jpim1 ! vector opt.
en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) ) &
- & * ( 1._wp - fr_i(ji,jj) ) * tmask(ji,jj,jk) * tmask(ji,jj,1)
+ & * ( 1._wp - fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1)
END DO
END DO
@@ -400,5 +430,5 @@
jk = nmln(ji,jj)
en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) ) &
- & * ( 1._wp - fr_i(ji,jj) ) * tmask(ji,jj,jk) * tmask(ji,jj,1)
+ & * ( 1._wp - fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1)
END DO
END DO
@@ -416,5 +446,5 @@
zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add ) ! apply some modifications...
en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) ) &
- & * ( 1._wp - fr_i(ji,jj) ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) * tmask(ji,jj,1)
+ & * ( 1._wp - fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1)
END DO
END DO
@@ -484,34 +514,28 @@
! !* Buoyancy length scale: l=sqrt(2*e/n**2)
!
+ ! initialisation of interior minimum value (avoid a 2d loop with mikt)
+ zmxlm(:,:,:) = rmxl_min
+ zmxld(:,:,:) = rmxl_min
+ !
IF( ln_mxl0 ) THEN ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rau0*g)
DO jj = 2, jpjm1
DO ji = fs_2, fs_jpim1
- IF (mikt(ji,jj) .GT. 1) THEN
- zmxlm(ji,jj,mikt(ji,jj)) = rmxl_min
- ELSE
- zraug = vkarmn * 2.e5_wp / ( rau0 * grav )
- zmxlm(ji,jj,mikt(ji,jj)) = MAX( rn_mxl0, zraug * taum(ji,jj) )
- END IF
+ zraug = vkarmn * 2.e5_wp / ( rau0 * grav )
+ zmxlm(ji,jj,1) = MAX( rn_mxl0, zraug * taum(ji,jj) * tmask(ji,jj,1) )
END DO
END DO
ELSE
- DO jj = 2, jpjm1
- DO ji = fs_2, fs_jpim1 ! surface set to the minimum value
- zmxlm(ji,jj,mikt(ji,jj)) = MAX( tmask(ji,jj,1) * rn_mxl0, rmxl_min)
- END DO
- END DO
+ zmxlm(:,:,1) = rn_mxl0
ENDIF
- zmxlm(:,:,jpk) = rmxl_min ! last level set to the interior minium value
- !
-!CDIR NOVERRCHK
- DO jj = 2, jpjm1
-!CDIR NOVERRCHK
- DO ji = fs_2, fs_jpim1 ! vector opt.
- !CDIR NOVERRCHK
- DO jk = mikt(ji,jj)+1, jpkm1 ! interior value : l=sqrt(2*e/n^2)
+ !
+!CDIR NOVERRCHK
+ DO jk = 2, jpkm1 ! interior value : l=sqrt(2*e/n^2)
+!CDIR NOVERRCHK
+ DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+ DO ji = fs_2, fs_jpim1 ! vector opt.
zrn2 = MAX( rn2(ji,jj,jk), rsmall )
- zmxlm(ji,jj,jk) = MAX( rmxl_min, SQRT( 2._wp * en(ji,jj,jk) / zrn2 ) )
- END DO
- zmxld(ji,jj,mikt(ji,jj)) = zmxlm(ji,jj,mikt(ji,jj)) ! surface set to the minimum value
+ zmxlm(ji,jj,jk) = MAX( rmxl_min, SQRT( 2._wp * en(ji,jj,jk) / zrn2 ) )
+ END DO
END DO
END DO
@@ -519,17 +543,19 @@
! !* Physical limits for the mixing length
!
- zmxld(:,:, 1 ) = zmxlm(:,:,1) ! surface set to the zmxlm value
+ zmxld(:,:,1 ) = zmxlm(:,:,1) ! surface set to the minimum value
zmxld(:,:,jpk) = rmxl_min ! last level set to the minimum value
!
SELECT CASE ( nn_mxl )
!
+ ! where wmask = 0 set zmxlm == fse3w
CASE ( 0 ) ! bounded by the distance to surface and bottom
- DO jj = 2, jpjm1
- DO ji = fs_2, fs_jpim1 ! vector opt.
- DO jk = mikt(ji,jj)+1, jpkm1
+ DO jk = 2, jpkm1
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
zemxl = MIN( fsdepw(ji,jj,jk) - fsdepw(ji,jj,mikt(ji,jj)), zmxlm(ji,jj,jk), &
& fsdepw(ji,jj,mbkt(ji,jj)+1) - fsdepw(ji,jj,jk) )
- zmxlm(ji,jj,jk) = zemxl
- zmxld(ji,jj,jk) = zemxl
+ ! wmask prevent zmxlm = 0 if jk = mikt(ji,jj)
+ zmxlm(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN(zmxlm(ji,jj,jk),fse3w(ji,jj,jk)) * (1 - wmask(ji,jj,jk))
+ zmxld(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN(zmxlm(ji,jj,jk),fse3w(ji,jj,jk)) * (1 - wmask(ji,jj,jk))
END DO
END DO
@@ -537,7 +563,7 @@
!
CASE ( 1 ) ! bounded by the vertical scale factor
- DO jj = 2, jpjm1
- DO ji = fs_2, fs_jpim1 ! vector opt.
- DO jk = mikt(ji,jj)+1, jpkm1
+ DO jk = 2, jpkm1
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
zemxl = MIN( fse3w(ji,jj,jk), zmxlm(ji,jj,jk) )
zmxlm(ji,jj,jk) = zemxl
@@ -548,10 +574,14 @@
!
CASE ( 2 ) ! |dk[xml]| bounded by e3t :
- DO jj = 2, jpjm1
- DO ji = fs_2, fs_jpim1 ! vector opt.
- DO jk = mikt(ji,jj)+1, jpkm1 ! from the surface to the bottom :
+ DO jk = 2, jpkm1 ! from the surface to the bottom :
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk-1) + fse3t(ji,jj,jk-1), zmxlm(ji,jj,jk) )
END DO
- DO jk = jpkm1, mikt(ji,jj)+1, -1 ! from the bottom to the surface :
+ END DO
+ END DO
+ DO jk = jpkm1, 2, -1 ! from the bottom to the surface :
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
zemxl = MIN( zmxlm(ji,jj,jk+1) + fse3t(ji,jj,jk+1), zmxlm(ji,jj,jk) )
zmxlm(ji,jj,jk) = zemxl
@@ -562,10 +592,14 @@
!
CASE ( 3 ) ! lup and ldown, |dk[xml]| bounded by e3t :
- DO jj = 2, jpjm1
- DO ji = fs_2, fs_jpim1 ! vector opt.
- DO jk = mikt(ji,jj)+1, jpkm1 ! from the surface to the bottom : lup
+ DO jk = 2, jpkm1 ! from the surface to the bottom : lup
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
zmxld(ji,jj,jk) = MIN( zmxld(ji,jj,jk-1) + fse3t(ji,jj,jk-1), zmxlm(ji,jj,jk) )
END DO
- DO jk = jpkm1, mikt(ji,jj)+1, -1 ! from the bottom to the surface : ldown
+ END DO
+ END DO
+ DO jk = jpkm1, 2, -1 ! from the bottom to the surface : ldown
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk+1) + fse3t(ji,jj,jk+1), zmxlm(ji,jj,jk) )
END DO
@@ -604,6 +638,6 @@
zsqen = SQRT( en(ji,jj,jk) )
zav = rn_ediff * zmxlm(ji,jj,jk) * zsqen
- avm (ji,jj,jk) = MAX( zav, avmb(jk) ) * tmask(ji,jj,jk)
- avt (ji,jj,jk) = MAX( zav, avtb_2d(ji,jj) * avtb(jk) ) * tmask(ji,jj,jk)
+ avm (ji,jj,jk) = MAX( zav, avmb(jk) ) * wmask(ji,jj,jk)
+ avt (ji,jj,jk) = MAX( zav, avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk)
dissl(ji,jj,jk) = zsqen / zmxld(ji,jj,jk)
END DO
@@ -612,11 +646,9 @@
CALL lbc_lnk( avm, 'W', 1. ) ! Lateral boundary conditions (sign unchanged)
!
- DO jj = 2, jpjm1
- DO ji = fs_2, fs_jpim1 ! vector opt.
- DO jk = miku(ji,jj)+1, jpkm1 !* vertical eddy viscosity at u- and v-points
- avmu(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk) + avm(ji+1,jj ,jk) ) * umask(ji,jj,jk)
- END DO
- DO jk = mikv(ji,jj)+1, jpkm1
- avmv(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk) + avm(ji ,jj+1,jk) ) * vmask(ji,jj,jk)
+ DO jk = 2, jpkm1 !* vertical eddy viscosity at wu- and wv-points
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
+ avmu(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk) + avm(ji+1,jj ,jk) ) * wumask(ji,jj,jk)
+ avmv(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk) + avm(ji ,jj+1,jk) ) * wvmask(ji,jj,jk)
END DO
END DO
@@ -625,7 +657,7 @@
!
IF( nn_pdl == 1 ) THEN !* Prandtl number case: update avt
- DO jj = 2, jpjm1
- DO ji = fs_2, fs_jpim1 ! vector opt.
- DO jk = mikt(ji,jj)+1, jpkm1
+ DO jk = 2, jpkm1
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
zcoef = avm(ji,jj,jk) * 2._wp * fse3w(ji,jj,jk) * fse3w(ji,jj,jk)
! ! shear
@@ -639,8 +671,8 @@
!!gm and even better with the use of the "true" ri_crit=0.22222... (this change the results!)
!!gm zpdlr = MAX( 0.1_wp, ri_crit / MAX( ri_crit , zri ) )
- avt(ji,jj,jk) = MAX( zpdlr * avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * tmask(ji,jj,jk)
+ avt(ji,jj,jk) = MAX( zpdlr * avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk)
# if defined key_c1d
- e_pdl(ji,jj,jk) = zpdlr * tmask(ji,jj,jk) ! c1d configuration : save masked Prandlt number
- e_ric(ji,jj,jk) = zri * tmask(ji,jj,jk) ! c1d config. : save Ri
+ e_pdl(ji,jj,jk) = zpdlr * wmask(ji,jj,jk) ! c1d configuration : save masked Prandlt number
+ e_ric(ji,jj,jk) = zri * wmask(ji,jj,jk) ! c1d config. : save Ri
# endif
END DO
@@ -729,5 +761,5 @@
IF( nn_pdl < 0 .OR. nn_pdl > 1 ) CALL ctl_stop( 'bad flag: nn_pdl is 0 or 1 ' )
IF( nn_htau < 0 .OR. nn_htau > 1 ) CALL ctl_stop( 'bad flag: nn_htau is 0, 1 or 2 ' )
- IF( nn_etau == 3 .AND. .NOT. lk_cpl ) CALL ctl_stop( 'nn_etau == 3 : HF taum only known in coupled mode' )
+ IF( nn_etau == 3 .AND. .NOT. ln_cpl ) CALL ctl_stop( 'nn_etau == 3 : HF taum only known in coupled mode' )
IF( ln_mxl0 ) THEN
@@ -749,8 +781,8 @@
! !* set vertical eddy coef. to the background value
DO jk = 1, jpk
- avt (:,:,jk) = avtb(jk) * tmask(:,:,jk)
- avm (:,:,jk) = avmb(jk) * tmask(:,:,jk)
- avmu(:,:,jk) = avmb(jk) * umask(:,:,jk)
- avmv(:,:,jk) = avmb(jk) * vmask(:,:,jk)
+ avt (:,:,jk) = avtb(jk) * wmask (:,:,jk)
+ avm (:,:,jk) = avmb(jk) * wmask (:,:,jk)
+ avmu(:,:,jk) = avmb(jk) * wumask(:,:,jk)
+ avmv(:,:,jk) = avmb(jk) * wvmask(:,:,jk)
END DO
dissl(:,:,:) = 1.e-12_wp
@@ -803,4 +835,10 @@
en (:,:,:) = rn_emin * tmask(:,:,:)
CALL tke_avn ! recompute avt, avm, avmu, avmv and dissl (approximation)
+ !
+ avt_k (:,:,:) = avt (:,:,:)
+ avm_k (:,:,:) = avm (:,:,:)
+ avmu_k(:,:,:) = avmu(:,:,:)
+ avmv_k(:,:,:) = avmv(:,:,:)
+ !
DO jit = nit000 + 1, nit000 + 10 ; CALL zdf_tke( jit ) ; END DO
ENDIF
@@ -808,8 +846,8 @@
en(:,:,:) = rn_emin * tmask(:,:,:)
DO jk = 1, jpk ! set the Kz to the background value
- avt (:,:,jk) = avtb(jk) * tmask(:,:,jk)
- avm (:,:,jk) = avmb(jk) * tmask(:,:,jk)
- avmu(:,:,jk) = avmb(jk) * umask(:,:,jk)
- avmv(:,:,jk) = avmb(jk) * vmask(:,:,jk)
+ avt (:,:,jk) = avtb(jk) * wmask (:,:,jk)
+ avm (:,:,jk) = avmb(jk) * wmask (:,:,jk)
+ avmu(:,:,jk) = avmb(jk) * wumask(:,:,jk)
+ avmv(:,:,jk) = avmb(jk) * wvmask(:,:,jk)
END DO
ENDIF
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90 (revision 5602)
@@ -126,5 +126,5 @@
zkz(:,:) = 0.e0 !* Associated potential energy consummed over the whole water column
DO jk = 2, jpkm1
- zkz(:,:) = zkz(:,:) + fse3w(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zav_tide(:,:,jk)* tmask(:,:,jk) * tmask(:,:,jk-1)
+ zkz(:,:) = zkz(:,:) + fse3w(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zav_tide(:,:,jk) * wmask(:,:,jk)
END DO
@@ -135,8 +135,8 @@
END DO
- DO jj = 1, jpj !* Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx
- DO ji = 1, jpi
- DO jk = mikt(ji,jj)+1, jpkm1 !* Mutiply by zkz to recover en_tmx, BUT bound by 30/6 ==> zav_tide bound by 300 cm2/s
- zav_tide(ji,jj,jk) = zav_tide(ji,jj,jk) * MIN( zkz(ji,jj), 30./6. ) !kz max = 300 cm2/s
+ DO jk = 2, jpkm1 !* Mutiply by zkz to recover en_tmx, BUT bound by 30/6 ==> zav_tide bound by 300 cm2/s
+ DO jj = 1, jpj !* Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx
+ DO ji = 1, jpi
+ zav_tide(ji,jj,jk) = zav_tide(ji,jj,jk) * MIN( zkz(ji,jj), 30./6. ) * wmask(ji,jj,jk) !kz max = 300 cm2/s
END DO
END DO
@@ -166,18 +166,18 @@
! ! Update mixing coefs !
! ! ----------------------- !
- DO jj = 1, jpj !* Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx
- DO ji = 1, jpi
- DO jk = mikt(ji,jj)+1, jpkm1 !* update momentum & tracer diffusivity with tidal mixing
- avt(ji,jj,jk) = avt(ji,jj,jk) + zav_tide(ji,jj,jk)
- avm(ji,jj,jk) = avm(ji,jj,jk) + zav_tide(ji,jj,jk)
+ DO jk = 2, jpkm1 !* update momentum & tracer diffusivity with tidal mixing
+ DO jj = 1, jpj !* Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx
+ DO ji = 1, jpi
+ avt(ji,jj,jk) = avt(ji,jj,jk) + zav_tide(ji,jj,jk) * wmask(ji,jj,jk)
+ avm(ji,jj,jk) = avm(ji,jj,jk) + zav_tide(ji,jj,jk) * wmask(ji,jj,jk)
END DO
END DO
END DO
- DO jj = 2, jpjm1
- DO ji = fs_2, fs_jpim1 ! vector opt.
- DO jk = mikt(ji,jj)+1, jpkm1 !* update momentum & tracer diffusivity with tidal mixing
- avmu(ji,jj,jk) = avmu(ji,jj,jk) + 0.5 * ( zav_tide(ji,jj,jk) + zav_tide(ji+1,jj ,jk) ) * umask(ji,jj,jk)
- avmv(ji,jj,jk) = avmv(ji,jj,jk) + 0.5 * ( zav_tide(ji,jj,jk) + zav_tide(ji ,jj+1,jk) ) * vmask(ji,jj,jk)
+ DO jk = 2, jpkm1 !* update momentum & tracer diffusivity with tidal mixing
+ DO jj = 2, jpjm1
+ DO ji = fs_2, fs_jpim1 ! vector opt.
+ avmu(ji,jj,jk) = avmu(ji,jj,jk) + 0.5 * ( zav_tide(ji,jj,jk) + zav_tide(ji+1,jj ,jk) ) * wumask(ji,jj,jk)
+ avmv(ji,jj,jk) = avmv(ji,jj,jk) + 0.5 * ( zav_tide(ji,jj,jk) + zav_tide(ji ,jj+1,jk) ) * wvmask(ji,jj,jk)
END DO
END DO
@@ -427,8 +427,10 @@
en_tmx(:,:) = - rn_tfe * rn_me * ( zem2(:,:) * 1.25 + zek1(:,:) ) * ssmask(:,:)
+!============
+!TG: Bug for VVL? Should this section be moved out of _init and be updated at every timestep?
! Vertical structure (az_tmx)
DO jj = 1, jpj ! part independent of the level
DO ji = 1, jpi
- zhdep(ji,jj) = fsdepw(ji,jj,mbkt(ji,jj)+1) ! depth of the ocean
+ zhdep(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1) ! depth of the ocean
zfact(ji,jj) = rau0 * rn_htmx * ( 1. - EXP( -zhdep(ji,jj) / rn_htmx ) )
IF( zfact(ji,jj) /= 0 ) zfact(ji,jj) = en_tmx(ji,jj) / zfact(ji,jj)
@@ -438,8 +440,9 @@
DO jj = 1, jpj
DO ji = 1, jpi
- az_tmx(ji,jj,jk) = zfact(ji,jj) * EXP( -( zhdep(ji,jj)-fsdepw(ji,jj,jk) ) / rn_htmx ) * tmask(ji,jj,jk)
- END DO
- END DO
- END DO
+ az_tmx(ji,jj,jk) = zfact(ji,jj) * EXP( -( zhdep(ji,jj)-gdepw_0(ji,jj,jk) ) / rn_htmx ) * tmask(ji,jj,jk)
+ END DO
+ END DO
+ END DO
+!===========
IF( nprint == 1 .AND. lwp ) THEN
@@ -454,8 +457,8 @@
ztpc = 0.e0
zpc(:,:,:) = MAX(rn_n2min,rn2(:,:,:)) * zav_tide(:,:,:)
- DO jj = 1, jpj
- DO ji = 1, jpi
- DO jk= mikt(ji,jj)+1, jpkm1
- ztpc = ztpc + fse3w(ji,jj,jk) * e1t(ji,jj) * e2t(ji,jj) * zpc(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
+ DO jk= 2, jpkm1
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ ztpc = ztpc + fse3w(ji,jj,jk) * e1t(ji,jj) * e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj)
END DO
END DO
@@ -470,8 +473,8 @@
zav_tide(:,:,:) = MIN( zav_tide(:,:,:), 60.e-4 )
zkz(:,:) = 0.e0
- DO jj = 1, jpj
- DO ji = 1, jpi
- DO jk = mikt(ji,jj)+1, jpkm1
- zkz(ji,jj) = zkz(ji,jj) + fse3w(ji,jj,jk) * MAX( 0.e0, rn2(ji,jj,jk) ) * rau0 * zav_tide(ji,jj,jk)* tmask(ji,jj,jk)
+ DO jk = 2, jpkm1
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ zkz(ji,jj) = zkz(ji,jj) + fse3w(ji,jj,jk) * MAX(0.e0, rn2(ji,jj,jk)) * rau0 * zav_tide(ji,jj,jk) * wmask(ji,jj,jk)
END DO
END DO
@@ -495,8 +498,8 @@
WRITE(numout,*) ' Min de zkz ', ztpc, ' Max = ', maxval(zkz(:,:) )
- DO jj = 1, jpj
- DO ji = 1, jpi
- DO jk = mikt(ji,jj)+1, jpkm1
- zav_tide(ji,jj,jk) = zav_tide(ji,jj,jk) * MIN( zkz(ji,jj), 30./6. ) !kz max = 300 cm2/s
+ DO jk = 2, jpkm1
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ zav_tide(ji,jj,jk) = zav_tide(ji,jj,jk) * MIN( zkz(ji,jj), 30./6. ) * wmask(ji,jj,jk) !kz max = 300 cm2/s
END DO
END DO
@@ -507,5 +510,5 @@
DO jj = 1, jpj
DO ji = 1, jpi
- ztpc = ztpc + fse3w(ji,jj,jk) * e1t(ji,jj) * e2t(ji,jj) * zpc(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
+ ztpc = ztpc + fse3w(ji,jj,jk) * e1t(ji,jj) * e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj)
END DO
END DO
@@ -516,5 +519,5 @@
DO jk = 1, jpk
ze_z = SUM( e1t(:,:) * e2t(:,:) * zav_tide(:,:,jk) * tmask_i(:,:) ) &
- & / MAX( 1.e-20, SUM( e1t(:,:) * e2t(:,:) * tmask (:,:,jk) * tmask_i(:,:) ) )
+ & / MAX( 1.e-20, SUM( e1t(:,:) * e2t(:,:) * wmask (:,:,jk) * tmask_i(:,:) ) )
ztpc = 1.E50
DO jj = 1, jpj
@@ -537,5 +540,5 @@
END DO
ze_z = SUM( e1t(:,:) * e2t(:,:) * zkz(:,:) * tmask_i(:,:) ) &
- & / MAX( 1.e-20, SUM( e1t(:,:) * e2t(:,:) * tmask (:,:,jk) * tmask_i(:,:) ) )
+ & / MAX( 1.e-20, SUM( e1t(:,:) * e2t(:,:) * wmask (:,:,jk) * tmask_i(:,:) ) )
WRITE(numout,*) ' jk= ', jk,' ', ze_z * 1.e4,' cm2/s'
END DO
@@ -543,5 +546,5 @@
zkz(:,:) = az_tmx(:,:,jk) /rn_n2min
ze_z = SUM( e1t(:,:) * e2t(:,:) * zkz(:,:) * tmask_i(:,:) ) &
- & / MAX( 1.e-20, SUM( e1t(:,:) * e2t(:,:) * tmask (:,:,jk) * tmask_i(:,:) ) )
+ & / MAX( 1.e-20, SUM( e1t(:,:) * e2t(:,:) * wmask (:,:,jk) * tmask_i(:,:) ) )
WRITE(numout,*)
WRITE(numout,*) ' N2 min - jk= ', jk,' ', ze_z * 1.e4,' cm2/s min= ',MINVAL(zkz)*1.e4, &
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90 (revision 5602)
@@ -83,4 +83,7 @@
USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges
USE trabbl_crs
+ USE sbc_oce, ONLY: lk_oasis
+ USE stopar
+ USE stopts
IMPLICIT NONE
@@ -197,7 +200,7 @@
#if defined key_iomput
CALL xios_finalize ! end mpp communications with xios
- IF( lk_cpl ) CALL cpl_finalize ! end coupling and mpp communications with OASIS
+ IF( lk_oasis ) CALL cpl_finalize ! end coupling and mpp communications with OASIS
#else
- IF( lk_cpl ) THEN
+ IF( lk_oasis ) THEN
CALL cpl_finalize ! end coupling and mpp communications with OASIS
ELSE
@@ -224,8 +227,9 @@
& nn_bench, nn_timing
NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, &
- & jpizoom, jpjzoom, jperio
+ & jpizoom, jpjzoom, jperio, ln_use_jattr
!!----------------------------------------------------------------------
!
cltxt = ''
+ cxios_context = 'nemo'
!
! ! Open reference namelist and configuration namelist files
@@ -263,4 +267,5 @@
nperio = 0
jperio = 0
+ ln_use_jattr = .false.
ENDIF
#endif
@@ -273,21 +278,24 @@
#if defined key_iomput
IF( Agrif_Root() ) THEN
- IF( lk_cpl ) THEN
- CALL cpl_init( ilocal_comm ) ! nemo local communicator given by oasis
- CALL xios_initialize( "oceanx",local_comm=ilocal_comm ) ! send nemo communicator to xios
+ IF( lk_oasis ) THEN
+ CALL cpl_init( "oceanx", ilocal_comm ) ! nemo local communicator given by oasis
+ CALL xios_initialize( "not used",local_comm=ilocal_comm ) ! send nemo communicator to xios
ELSE
- CALL xios_initialize( "nemo",return_comm=ilocal_comm ) ! nemo local communicator given by xios
+ CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm ) ! nemo local communicator given by xios
ENDIF
ENDIF
- narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection
+ ! Nodes selection (control print return in cltxt)
+ narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )
#else
- IF( lk_cpl ) THEN
+ IF( lk_oasis ) THEN
IF( Agrif_Root() ) THEN
- CALL cpl_init( ilocal_comm ) ! nemo local communicator given by oasis
+ CALL cpl_init( "oceanx", ilocal_comm ) ! nemo local communicator given by oasis
ENDIF
- narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection (control print return in cltxt)
+ ! Nodes selection (control print return in cltxt)
+ narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )
ELSE
ilocal_comm = 0
- narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop ) ! Nodes selection (control print return in cltxt)
+ ! Nodes selection (control print return in cltxt)
+ narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop )
ENDIF
#endif
@@ -343,5 +351,5 @@
WRITE(numout,*) ' NEMO team'
WRITE(numout,*) ' Ocean General Circulation Model'
- WRITE(numout,*) ' version 3.4 (2011) '
+ WRITE(numout,*) ' version 3.6 (2015) '
WRITE(numout,*)
WRITE(numout,*)
@@ -385,4 +393,6 @@
IF( lk_tide ) CALL tide_init( nit000 ) ! Initialisation of the tidal harmonics
+ CALL sbc_init ! Forcings : surface module (clem: moved here for bdy purpose)
+
IF( lk_bdy ) CALL bdy_init ! Open boundaries initialisation
IF( lk_bdy ) CALL bdy_dta_init ! Open boundaries initialisation of external data arrays
@@ -391,10 +401,8 @@
CALL dyn_nept_init ! simplified form of Neptune effect
-
!
IF( ln_crs ) CALL crs_init ! Domain initialization of coarsened grid
!
! Ocean physics
- CALL sbc_init ! Forcings : surface module
! ! Vertical physics
CALL zdf_init ! namelist read
@@ -445,4 +453,6 @@
IF( nn_cla == 1 .AND. cp_cfg == 'orca' .AND. jp_cfg == 2 ) CALL cla_init ! Cross Land Advection
CALL icb_init( rdt, nit000) ! initialise icebergs instance
+ CALL sto_par_init ! Stochastic parametrization
+ IF( ln_sto_eos ) CALL sto_pts_init ! RRandom T/S fluctuations
#if defined key_top
@@ -522,4 +532,5 @@
WRITE(numout,*) ' left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom
WRITE(numout,*) ' lateral cond. type (between 0 and 6) jperio = ', jperio
+ WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr
ENDIF
! ! Parameter control
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/par_oce.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/par_oce.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/par_oce.F90 (revision 5602)
@@ -53,4 +53,11 @@
! ! = 6 cyclic East-West AND North fold F-point pivot
+ ! Input file read offset
+ LOGICAL :: ln_use_jattr !: Use file global attribute: open_ocean_jstart to determine start j-row
+ ! when reading input from those netcdf files that have the
+ ! attribute defined. This is designed to enable input files associated
+ ! with the extended grids used in the under ice shelf configurations to
+ ! be used without redundant rows when the ice shelves are not in use.
+
!! Values set to pp_not_used indicates that this parameter is not used in THIS config.
!! Values set to pp_to_be_computed indicates that variables will be computed in domzgr
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/step.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/step.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/step.F90 (revision 5602)
@@ -84,16 +84,17 @@
IF ( kstp == (nit000 + 1) ) lk_agrif_fstep = .FALSE.
# if defined key_iomput
- IF( Agrif_Nbstepint() == 0 ) CALL iom_swap( "nemo" )
+ IF( Agrif_Nbstepint() == 0 ) CALL iom_swap( cxios_context )
# endif
#endif
indic = 0 ! reset to no error condition
IF( kstp == nit000 ) THEN
- CALL iom_init( "nemo" ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)
- IF( ln_crs ) CALL iom_init( "nemo_crs" ) ! initialize context for coarse grid
+ ! must be done after nemo_init for AGRIF+XIOS+OASIS
+ CALL iom_init( cxios_context ) ! iom_put initialization
+ IF( ln_crs ) CALL iom_init( TRIM(cxios_context)//"_crs" ) ! initialize context for coarse grid
ENDIF
IF( kstp /= nit000 ) CALL day( kstp ) ! Calendar (day was already called at nit000 in day_init)
- CALL iom_setkt( kstp - nit000 + 1, "nemo" ) ! say to iom that we are at time step kstp
- IF( ln_crs ) CALL iom_setkt( kstp - nit000 + 1, "nemo_crs" ) ! say to iom that we are at time step kstp
+ CALL iom_setkt( kstp - nit000 + 1, cxios_context ) ! tell iom we are at time step kstp
+ IF( ln_crs ) CALL iom_setkt( kstp - nit000 + 1, TRIM(cxios_context)//"_crs" ) ! tell iom we are at time step kstp
!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
@@ -101,8 +102,14 @@
!<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
IF( lk_tide ) CALL sbc_tide( kstp )
- IF( lk_bdy ) CALL bdy_dta ( kstp, time_offset=+1 ) ! update dynamic & tracer data at open boundaries
-
+ IF( lk_bdy ) THEN
+ IF( ln_apr_dyn) CALL sbc_apr( kstp ) ! bdy_dta needs ssh_ib
+ CALL bdy_dta ( kstp, time_offset=+1 ) ! update dynamic & tracer data at open boundaries
+ ENDIF
CALL sbc ( kstp ) ! Sea Boundary Condition (including sea-ice)
! clem: moved here for bdy ice purpose
+ !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ ! Update stochastic parameters and random T/S fluctuations
+ !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ CALL sto_par( kstp ) ! Stochastic parameters
!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
@@ -123,7 +130,7 @@
IF( lk_zdfkpp ) CALL zdf_kpp( kstp ) ! KPP closure scheme for Kz
IF( lk_zdfcst ) THEN ! Constant Kz (reset avt, avm[uv] to the background value)
- avt (:,:,:) = rn_avt0 * tmask(:,:,:)
- avmu(:,:,:) = rn_avm0 * umask(:,:,:)
- avmv(:,:,:) = rn_avm0 * vmask(:,:,:)
+ avt (:,:,:) = rn_avt0 * wmask (:,:,:)
+ avmu(:,:,:) = rn_avm0 * wumask(:,:,:)
+ avmv(:,:,:) = rn_avm0 * wvmask(:,:,:)
ENDIF
IF( ln_rnf_mouth ) THEN ! increase diffusivity at rivers mouths
@@ -146,8 +153,13 @@
!
IF( lk_ldfslp ) THEN ! slope of lateral mixing
- CALL eos( tsb, rhd, gdept_0(:,:,:) ) ! before in situ density
- IF( ln_zps ) CALL zps_hde( kstp, jpts, tsb, gtsu, gtsv, & ! Partial steps: before horizontal gradient
- & rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv , & !
- & gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) ! of t, s, rd at the last ocean level
+ IF(ln_sto_eos ) CALL sto_pts( tsn ) ! Random T/S fluctuations
+ CALL eos( tsb, rhd, gdept_0(:,:,:) ) ! before in situ density
+ IF( ln_zps .AND. .NOT. ln_isfcav) &
+ & CALL zps_hde ( kstp, jpts, tsb, gtsu, gtsv, & ! Partial steps: before horizontal gradient
+ & rhd, gru , grv ) ! of t, s, rd at the last ocean level
+ IF( ln_zps .AND. ln_isfcav) &
+ & CALL zps_hde_isf( kstp, jpts, tsb, gtsu, gtsv, & ! Partial steps for top cell (ISF)
+ & rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv , &
+ & gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) ! of t, s, rd at the first ocean level
IF( ln_traldf_grif ) THEN ! before slope for Griffies operator
CALL ldf_slp_grif( kstp )
@@ -163,8 +175,8 @@
IF( lk_traldf_eiv ) CALL ldf_eiv( kstp ) ! eddy induced velocity coefficient
#endif
-#if defined key_traldf_c3d && key_traldf_smag
+#if defined key_traldf_c3d && defined key_traldf_smag
CALL ldf_tra_smag( kstp ) ! eddy induced velocity coefficient
# endif
-#if defined key_dynldf_c3d && key_dynldf_smag
+#if defined key_dynldf_c3d && defined key_dynldf_smag
CALL ldf_dyn_smag( kstp ) ! eddy induced velocity coefficient
# endif
@@ -181,8 +193,13 @@
! Note that the computation of vertical velocity above, hence "after" sea level
! is necessary to compute momentum advection for the rhs of barotropic loop:
+ IF(ln_sto_eos ) CALL sto_pts( tsn ) ! Random T/S fluctuations
CALL eos ( tsn, rhd, rhop, fsdept_n(:,:,:) ) ! now in situ density for hpg computation
- IF( ln_zps ) CALL zps_hde( kstp, jpts, tsn, gtsu, gtsv, & ! Partial steps: before horizontal gradient
- & rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv , & !
- & gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) ! of t, s, rd at the last ocean level
+ IF( ln_zps .AND. .NOT. ln_isfcav) &
+ & CALL zps_hde ( kstp, jpts, tsn, gtsu, gtsv, & ! Partial steps: before horizontal gradient
+ & rhd, gru , grv ) ! of t, s, rd at the last ocean level
+ IF( ln_zps .AND. ln_isfcav) &
+ & CALL zps_hde_isf( kstp, jpts, tsn, gtsu, gtsv, & ! Partial steps for top cell (ISF)
+ & rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv , &
+ & gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) ! of t, s, rd at the last ocean level
ua(:,:,:) = 0.e0 ! set dynamics trends to zero
@@ -213,15 +230,13 @@
! diagnostics and outputs (ua, va, tsa used as workspace)
!<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
- IF( lk_floats ) CALL flo_stp( kstp ) ! drifting Floats
- IF( lk_diahth ) CALL dia_hth( kstp ) ! Thermocline depth (20 degres isotherm depth)
- IF( .NOT. lk_cpl ) CALL dia_fwb( kstp ) ! Fresh water budget diagnostics
- IF( ln_diaptr ) CALL dia_ptr( kstp ) ! Poleward TRansports diagnostics
- IF( lk_diadct ) CALL dia_dct( kstp ) ! Transports
- IF( lk_diaar5 ) CALL dia_ar5( kstp ) ! ar5 diag
- IF( lk_diaharm ) CALL dia_harm( kstp ) ! Tidal harmonic analysis
- CALL dia_wri( kstp ) ! ocean model: outputs
- !
- IF( ln_crs ) CALL crs_fld( kstp ) ! ocean model: online field coarsening & output
-
+ IF( lk_floats ) CALL flo_stp( kstp ) ! drifting Floats
+ IF( lk_diahth ) CALL dia_hth( kstp ) ! Thermocline depth (20 degres isotherm depth)
+ IF( .NOT. ln_cpl ) CALL dia_fwb( kstp ) ! Fresh water budget diagnostics
+ IF( lk_diadct ) CALL dia_dct( kstp ) ! Transports
+ IF( lk_diaar5 ) CALL dia_ar5( kstp ) ! ar5 diag
+ IF( lk_diaharm ) CALL dia_harm( kstp ) ! Tidal harmonic analysis
+ CALL dia_wri( kstp ) ! ocean model: outputs
+ !
+ IF( ln_crs ) CALL crs_fld( kstp ) ! ocean model: online field coarsening & output
#if defined key_top
@@ -269,4 +284,7 @@
IF( lk_zdfkpp ) CALL tra_kpp ( kstp ) ! KPP non-local tracer fluxes
CALL tra_ldf ( kstp ) ! lateral mixing
+
+ IF( ln_diaptr ) CALL dia_ptr ! Poleward adv/ldf TRansports diagnostics
+
#if defined key_agrif
IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_tra ! tracers sponge
@@ -277,14 +295,24 @@
IF( ln_zdfnpc ) CALL tra_npc( kstp ) ! update after fields by non-penetrative convection
CALL tra_nxt( kstp ) ! tracer fields at next time step
+ IF( ln_sto_eos ) CALL sto_pts( tsn ) ! Random T/S fluctuations
CALL eos ( tsa, rhd, rhop, fsdept_n(:,:,:) ) ! Time-filtered in situ density for hpg computation
- IF( ln_zps ) CALL zps_hde( kstp, jpts, tsa, gtsu, gtsv, & ! Partial steps: before horizontal gradient
- & rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv , & !
- & gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) ! of t, s, rd at the last ocean level
+ IF( ln_zps .AND. .NOT. ln_isfcav) &
+ & CALL zps_hde ( kstp, jpts, tsa, gtsu, gtsv, & ! Partial steps: before horizontal gradient
+ & rhd, gru , grv ) ! of t, s, rd at the last ocean level
+ IF( ln_zps .AND. ln_isfcav) &
+ & CALL zps_hde_isf( kstp, jpts, tsa, gtsu, gtsv, & ! Partial steps for top cell (ISF)
+ & rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv , &
+ & gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) ! of t, s, rd at the last ocean level
ELSE ! centered hpg (eos then time stepping)
IF ( .NOT. lk_dynspg_ts ) THEN ! eos already called in time-split case
+ IF( ln_sto_eos ) CALL sto_pts( tsn ) ! Random T/S fluctuations
CALL eos ( tsn, rhd, rhop, fsdept_n(:,:,:) ) ! now in situ density for hpg computation
- IF( ln_zps ) CALL zps_hde( kstp, jpts, tsn, gtsu, gtsv, & ! Partial steps: before horizontal gradient
- & rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv , & !
- & gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) ! of t, s, rd at the last ocean level
+ IF( ln_zps .AND. .NOT. ln_isfcav) &
+ & CALL zps_hde ( kstp, jpts, tsn, gtsu, gtsv, & ! Partial steps: before horizontal gradient
+ & rhd, gru , grv ) ! of t, s, rd at the last ocean level
+ IF( ln_zps .AND. ln_isfcav) &
+ & CALL zps_hde_isf( kstp, jpts, tsn, gtsu, gtsv, & ! Partial steps for top cell (ISF)
+ & rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv , &
+ & gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) ! of t, s, rd at the last ocean level
ENDIF
IF( ln_zdfnpc ) CALL tra_npc( kstp ) ! update after fields by non-penetrative convection
@@ -347,5 +375,5 @@
CALL iom_close( numror ) ! close input ocean restart file
IF(lwm) CALL FLUSH ( numond ) ! flush output namelist oce
- IF(lwm) CALL FLUSH ( numoni ) ! flush output namelist ice
+ IF( lwm.AND.numoni /= -1 ) CALL FLUSH ( numoni ) ! flush output namelist ice
ENDIF
IF( lrst_oce ) CALL rst_write ( kstp ) ! write output ocean restart file
@@ -354,10 +382,10 @@
! Coupled mode
!<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
- IF( lk_cpl ) CALL sbc_cpl_snd( kstp ) ! coupled mode : field exchanges
+ IF( lk_oasis ) CALL sbc_cpl_snd( kstp ) ! coupled mode : field exchanges
!
#if defined key_iomput
IF( kstp == nitend .OR. indic < 0 ) THEN
- CALL iom_context_finalize( "nemo" ) ! needed for XIOS+AGRIF
- IF( ln_crs ) CALL iom_context_finalize( "nemo_crs" ) !
+ CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF
+ IF( ln_crs ) CALL iom_context_finalize( trim(cxios_context)//"_crs" ) !
ENDIF
#endif
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/step_oce.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/step_oce.F90 (revision 5602)
@@ -27,4 +27,5 @@
USE sbc_oce ! surface boundary condition: ocean
USE sbctide ! Tide initialisation
+ USE sbcapr ! surface boundary condition: ssh_ib required by bdydta
USE traqsr ! solar radiation penetration (tra_qsr routine)
@@ -53,4 +54,7 @@
USE dynnxt ! time-stepping (dyn_nxt routine)
+
+ USE stopar ! Stochastic parametrization (sto_par routine)
+ USE stopts
USE bdy_par ! for lk_bdy
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/timing.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/timing.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/timing.F90 (revision 5602)
@@ -211,5 +211,5 @@
WRITE(numtime,*) ' NEMO team'
WRITE(numtime,*) ' Ocean General Circulation Model'
- WRITE(numtime,*) ' version 3.3 (2010) '
+ WRITE(numtime,*) ' version 3.6 (2015) '
WRITE(numtime,*)
WRITE(numtime,*) ' Timing Informations '
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90 (revision 5602)
@@ -32,4 +32,5 @@
!! 'key_top' bio-model
!!----------------------------------------------------------------------
+ LOGICAL, PUBLIC, PARAMETER :: lk_top = .TRUE. !: TOP model
LOGICAL, PUBLIC, PARAMETER :: lk_qsr_bio = .TRUE. !: bio-model light absorption flag
#else
@@ -37,4 +38,5 @@
!! Default option No bio-model light absorption
!!----------------------------------------------------------------------
+ LOGICAL, PUBLIC, PARAMETER :: lk_top = .FALSE. !: TOP model
LOGICAL, PUBLIC, PARAMETER :: lk_qsr_bio = .FALSE. !: bio-model light absorption flag
#endif
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/wrk_nemo.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/wrk_nemo.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/wrk_nemo.F90 (revision 5602)
@@ -121,7 +121,8 @@
LOGICAL :: linit = .FALSE.
+ LOGICAL :: ldebug = .FALSE.
!!----------------------------------------------------------------------
!! NEMO/OPA 4.0 , NEMO Consortium (2011)
- !! $Id:$
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
@@ -486,4 +487,5 @@
IF( SUM( tree(ii)%ishape ) == 0 ) THEN ! create a new branch
+ IF(ldebug) PRINT *, 'create new branch ', ii,ishape, isrt, itype
tree(ii)%itype = itype ! define the type of this branch
tree(ii)%ishape(:) = ishape(:) ! define the shape of this branch
@@ -515,4 +517,5 @@
tree(ii)%current%next%in_use = .FALSE. ! this leaf is not yet used
tree(ii)%current%next%indic = tree(ii)%current%indic + 1 ! number of this leaf
+ IF(ldebug) PRINT *, 'add a leaf ', ii, tree(ii)%current%indic
tree(ii)%current%next%prev => tree(ii)%current ! previous leaf of the new leaf is the current leaf
tree(ii)%current%next%next => NULL() ! next leaf is not yet defined
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/SAS_SRC/daymod.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/SAS_SRC/daymod.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/SAS_SRC/daymod.F90 (revision 5602)
@@ -45,5 +45,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2010)
- !! $Id: daymod.F90 3294 2012-01-28 16:44:18Z rblod $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
@@ -80,15 +80,8 @@
ndt05 = NINT(0.5 * rdttra(1))
- ! parameters corresponding to nit000 - 1 (as we start the step loop with a call to day)
- ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
- adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
- IF( ABS(adatrj - REAL(NINT(adatrj),wp)) < 0.1 / rday ) adatrj = REAL(NINT(adatrj),wp) ! avoid truncation error
- !
- IF(lwp) THEN
- WRITE(numout,*) ' *** Info used values : '
- WRITE(numout,*) ' date ndastp : ', ndastp
- WRITE(numout,*) ' number of elapsed days since the begining of run : ', adatrj
- WRITE(numout,*)
- ENDIF
+ ! ==> clem: here we read the ocean restart for the date (only if it exists)
+ ! It is not clean and another solution should be found
+ CALL day_rst( nit000, 'READ' )
+ ! ==>
! set the calendar from ndastp (read in restart file and namelist)
@@ -131,5 +124,5 @@
! control print
- IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i6)')' ==============>> 1/2 time step before the start of the run DATE Y/M/D = ', &
+ IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i8,a,i8)')' =======>> 1/2 time step before the start of the run DATE Y/M/D = ', &
& nyear, '/', nmonth, '/', nday, ' nsec_day:', nsec_day, ' nsec_week:', nsec_week
@@ -285,4 +278,98 @@
!
END SUBROUTINE day
+
+
+ SUBROUTINE day_rst( kt, cdrw )
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE ts_rst ***
+ !!
+ !! ** Purpose : Read or write calendar in restart file:
+ !!
+ !! WRITE(READ) mode:
+ !! kt : number of time step since the begining of the experiment at the
+ !! end of the current(previous) run
+ !! adatrj(0) : number of elapsed days since the begining of the experiment at the
+ !! end of the current(previous) run (REAL -> keep fractions of day)
+ !! ndastp : date at the end of the current(previous) run (coded as yyyymmdd integer)
+ !!
+ !! According to namelist parameter nrstdt,
+ !! nrstdt = 0 no control on the date (nit000 is arbitrary).
+ !! nrstdt = 1 we verify that nit000 is equal to the last
+ !! time step of previous run + 1.
+ !! In both those options, the exact duration of the experiment
+ !! since the beginning (cumulated duration of all previous restart runs)
+ !! is not stored in the restart and is assumed to be (nit000-1)*rdt.
+ !! This is valid is the time step has remained constant.
+ !!
+ !! nrstdt = 2 the duration of the experiment in days (adatrj)
+ !! has been stored in the restart file.
+ !!----------------------------------------------------------------------
+ INTEGER , INTENT(in) :: kt ! ocean time-step
+ CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag
+ !
+ REAL(wp) :: zkt, zndastp
+ !!----------------------------------------------------------------------
+
+ IF( TRIM(cdrw) == 'READ' ) THEN
+
+ IF( iom_varid( numror, 'kt', ldstop = .FALSE. ) > 0 ) THEN
+ ! Get Calendar informations
+ CALL iom_get( numror, 'kt', zkt ) ! last time-step of previous run
+ IF(lwp) THEN
+ WRITE(numout,*) ' *** Info read in restart : '
+ WRITE(numout,*) ' previous time-step : ', NINT( zkt )
+ WRITE(numout,*) ' *** restart option'
+ SELECT CASE ( nrstdt )
+ CASE ( 0 ) ; WRITE(numout,*) ' nrstdt = 0 : no control of nit000'
+ CASE ( 1 ) ; WRITE(numout,*) ' nrstdt = 1 : no control the date at nit000 (use ndate0 read in the namelist)'
+ CASE ( 2 ) ; WRITE(numout,*) ' nrstdt = 2 : calendar parameters read in restart'
+ END SELECT
+ WRITE(numout,*)
+ ENDIF
+ ! Control of date
+ IF( nit000 - NINT( zkt ) /= 1 .AND. nrstdt /= 0 ) &
+ & CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart', &
+ & ' verify the restart file or rerun with nrstdt = 0 (namelist)' )
+ ! define ndastp and adatrj
+ IF ( nrstdt == 2 ) THEN
+ ! read the parameters correspondting to nit000 - 1 (last time step of previous run)
+ CALL iom_get( numror, 'ndastp', zndastp )
+ ndastp = NINT( zndastp )
+ CALL iom_get( numror, 'adatrj', adatrj )
+ ELSE
+ ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day)
+ ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
+ adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
+ ! note this is wrong if time step has changed during run
+ ENDIF
+ ELSE
+ ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day)
+ ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
+ adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
+ ENDIF
+ IF( ABS(adatrj - REAL(NINT(adatrj),wp)) < 0.1 / rday ) adatrj = REAL(NINT(adatrj),wp) ! avoid truncation error
+ !
+ IF(lwp) THEN
+ WRITE(numout,*) ' *** Info used values : '
+ WRITE(numout,*) ' date ndastp : ', ndastp
+ WRITE(numout,*) ' number of elapsed days since the begining of run : ', adatrj
+ WRITE(numout,*)
+ ENDIF
+ !
+ ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
+ !
+ IF( kt == nitrst ) THEN
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) 'rst_write : write oce restart file kt =', kt
+ IF(lwp) WRITE(numout,*) '~~~~~~~'
+ ENDIF
+ ! calendar control
+ CALL iom_rstput( kt, nitrst, numrow, 'kt' , REAL( kt , wp) ) ! time-step
+ CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, wp) ) ! date
+ CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj ) ! number of elapsed days since
+ ! ! the begining of the run [s]
+ ENDIF
+ !
+ END SUBROUTINE day_rst
!!======================================================================
END MODULE daymod
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/SAS_SRC/diawri.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/SAS_SRC/diawri.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/SAS_SRC/diawri.F90 (revision 5602)
@@ -70,5 +70,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2010)
- !! $Id $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90 (revision 5602)
@@ -42,5 +42,4 @@
USE step_oce ! module used in the ocean time stepping module
USE sbc_oce ! surface boundary condition: ocean
- USE cla ! cross land advection (tra_cla routine)
USE domcfg ! domain configuration (dom_cfg routine)
USE daymod ! calendar
@@ -50,9 +49,19 @@
USE step ! NEMO time-stepping (stp routine)
USE lib_mpp ! distributed memory computing
+#if defined key_nosignedzero
+ USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+#endif
#if defined key_iomput
USE xios
#endif
+ USE cpl_oasis3
USE sbcssm
- USE lbcnfd, ONLY: isendto, nsndto ! Setup of north fold exchanges
+ USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges
+ USE icbstp ! handle bergs, calving, themodynamics and transport
+#if defined key_bdy
+ USE bdyini ! open boundary cond. setting (bdy_init routine). clem: mandatory for LIM3
+ USE bdydta ! open boundary cond. setting (bdy_dta_init routine). clem: mandatory for LIM3
+#endif
+ USE bdy_par
IMPLICIT NONE
@@ -66,5 +75,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 4.0 , NEMO Consortium (2011)
- !! $Id: nemogcm.F90 3294 2012-01-28 16:44:18Z rblod $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
@@ -96,5 +105,12 @@
! !-----------------------!
#if defined key_agrif
- CALL Agrif_Declare_Var ! AGRIF: set the meshes
+ CALL Agrif_Declare_Var_dom ! AGRIF: set the meshes for DOM
+ CALL Agrif_Declare_Var ! " " " " " DYN/TRA
+# if defined key_top
+ CALL Agrif_Declare_Var_top ! " " " " " TOP
+# endif
+# if defined key_lim2
+ CALL Agrif_Declare_Var_lim2 ! " " " " " LIM
+# endif
#endif
! check that all process are still there... If some process have an error,
@@ -118,4 +134,7 @@
IF( lk_mpp ) CALL mpp_max( nstop )
END DO
+ !
+ IF( ln_icebergs ) CALL icb_end( nitend )
+
! !------------------------!
! !== finalize the run ==!
@@ -136,8 +155,14 @@
!
CALL nemo_closefile
+ !
#if defined key_iomput
CALL xios_finalize ! end mpp communications with xios
+ IF( lk_oasis ) CALL cpl_finalize ! end coupling and mpp communications with OASIS
#else
- IF( lk_mpp ) CALL mppstop ! end mpp communications
+ IF( lk_oasis ) THEN
+ CALL cpl_finalize ! end coupling and mpp communications with OASIS
+ ELSE
+ IF( lk_mpp ) CALL mppstop ! end mpp communications
+ ENDIF
#endif
!
@@ -154,18 +179,28 @@
INTEGER :: ilocal_comm ! local integer
INTEGER :: ios
-
CHARACTER(len=80), DIMENSION(16) :: cltxt
- !!
+ CHARACTER(len=80) :: clname
+ !
NAMELIST/namctl/ ln_ctl , nn_print, nn_ictls, nn_ictle, &
& nn_isplt, nn_jsplt, nn_jctls, nn_jctle, &
& nn_bench, nn_timing
NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, &
- & jpizoom, jpjzoom, jperio
- !!----------------------------------------------------------------------
+ & jpizoom, jpjzoom, jperio, ln_use_jattr
+ !!----------------------------------------------------------------------
+ !
cltxt = ''
!
! ! Open reference namelist and configuration namelist files
- CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
- CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+ IF( lk_oasis ) THEN
+ CALL ctl_opn( numnam_ref, 'namelist_sas_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+ CALL ctl_opn( numnam_cfg, 'namelist_sas_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+ cxios_context = 'sas'
+ clname = 'output.namelist_sas.dyn'
+ ELSE
+ CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+ CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+ cxios_context = 'nemo'
+ clname = 'output.namelist.dyn'
+ ENDIF
!
REWIND( numnam_ref ) ! Namelist namctl in reference namelist : Control prints & Benchmark
@@ -186,4 +221,21 @@
904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )
+! Force values for AGRIF zoom (cf. agrif_user.F90)
+#if defined key_agrif
+ IF( .NOT. Agrif_Root() ) THEN
+ jpiglo = nbcellsx + 2 + 2*nbghostcells
+ jpjglo = nbcellsy + 2 + 2*nbghostcells
+ jpi = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci
+ jpj = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj
+ jpidta = jpiglo
+ jpjdta = jpjglo
+ jpizoom = 1
+ jpjzoom = 1
+ nperio = 0
+ jperio = 0
+ ln_use_jattr = .false.
+ ENDIF
+#endif
+ !
! !--------------------------------------------!
! ! set communicator & select the local node !
@@ -193,10 +245,22 @@
#if defined key_iomput
IF( Agrif_Root() ) THEN
- CALL xios_initialize( "nemo",return_comm=ilocal_comm )
- ENDIF
- narea = mynode ( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection
+ IF( lk_oasis ) THEN
+ CALL cpl_init( "sas", ilocal_comm ) ! nemo local communicator given by oasis
+ CALL xios_initialize( "not used",local_comm=ilocal_comm ) ! send nemo communicator to xios
+ ELSE
+ CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm ) ! nemo local communicator given by xios
+ ENDIF
+ ENDIF
+ narea = mynode ( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection
#else
- ilocal_comm = 0
- narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection (control print return in cltxt)
+ IF( lk_oasis ) THEN
+ IF( Agrif_Root() ) THEN
+ CALL cpl_init( "sas", ilocal_comm ) ! nemo local communicator given by oasis
+ ENDIF
+ narea = mynode( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection (control print return in cltxt)
+ ELSE
+ ilocal_comm = 0
+ narea = mynode( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop ) ! Nodes selection (control print return in cltxt)
+ ENDIF
#endif
narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 )
@@ -229,10 +293,12 @@
! than variables
IF( Agrif_Root() ) THEN
+#if defined key_nemocice_decomp
+ jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim.
+ jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim.
+#else
jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim.
-#if defined key_nemocice_decomp
- jpj = ( jpjglo+1-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim.
-#else
jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim.
#endif
+ ENDIF
jpk = jpkdta ! third dim
jpim1 = jpi-1 ! inner domain indices
@@ -240,9 +306,12 @@
jpkm1 = jpk-1 ! " "
jpij = jpi*jpj ! jpi x j
- ENDIF
IF(lwp) THEN ! open listing units
!
- CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+ IF( lk_oasis ) THEN
+ CALL ctl_opn( numout, 'sas.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+ ELSE
+ CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+ ENDIF
!
WRITE(numout,*)
@@ -250,5 +319,5 @@
WRITE(numout,*) ' NEMO team'
WRITE(numout,*) ' Ocean General Circulation Model'
- WRITE(numout,*) ' version 3.4 (2011) '
+ WRITE(numout,*) ' version 3.6 (2015) '
WRITE(numout,*) ' StandAlone Surface version (SAS) '
WRITE(numout,*)
@@ -287,9 +356,14 @@
IF( ln_ctl ) CALL prt_ctl_init ! Print control
- CALL flush(numout)
-
CALL day_init ! model calendar (using both namelist and restart infos)
CALL sbc_init ! Forcings : surface module
+
+ ! ==> clem: open boundaries init. is mandatory for LIM3 because ice BDY is not decoupled from
+ ! the environment of ocean BDY. Therefore bdy is called in both OPA and SAS modules.
+ ! This is not clean and should be changed in the future.
+ IF( lk_bdy ) CALL bdy_init
+ IF( lk_bdy ) CALL bdy_dta_init
+ ! ==>
IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler
@@ -348,4 +422,5 @@
WRITE(numout,*) ' left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom
WRITE(numout,*) ' lateral cond. type (between 0 and 6) jperio = ', jperio
+ WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr
ENDIF
! ! Parameter control
@@ -396,4 +471,8 @@
ENDIF
!
+ IF( 1_wp /= SIGN(1._wp,-0._wp) ) CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ', &
+ & 'f2003 standard. ' , &
+ & 'Compile with key_nosignedzero enabled' )
+ !
END SUBROUTINE nemo_ctl
@@ -435,14 +514,37 @@
USE diawri , ONLY: dia_wri_alloc
USE dom_oce , ONLY: dom_oce_alloc
- USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass
- !
- INTEGER :: ierr,ierr4
+#if defined key_bdy
+ USE bdy_oce , ONLY: bdy_oce_alloc
+ USE oce ! clem: mandatory for LIM3 because needed for bdy arrays
+#else
+ USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass
+#endif
+ !
+ INTEGER :: ierr,ierr1,ierr2,ierr3,ierr4,ierr5,ierr6
+ INTEGER :: jpm
!!----------------------------------------------------------------------
!
ierr = dia_wri_alloc ()
ierr = ierr + dom_oce_alloc () ! ocean domain
- ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), &
- & snwice_fmass(jpi,jpj), STAT= ierr4 )
- ierr = ierr + ierr4
+#if defined key_bdy
+ ierr = ierr + bdy_oce_alloc () ! bdy masks (incl. initialization)
+ ierr = ierr + oce_alloc () ! (tsn...)
+#endif
+
+#if ! defined key_bdy
+ ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), &
+ & snwice_fmass(jpi,jpj) , STAT= ierr1 )
+ !
+ ! lim code currently uses surface temperature and salinity in tsn array for initialisation
+ ! and ub, vb arrays in ice dynamics, so allocate enough of arrays to use
+ ! clem: should not be needed. To be checked out
+ jpm = MAX(jp_tem, jp_sal)
+ ALLOCATE( tsn(jpi,jpj,1,jpm) , STAT=ierr2 )
+ ALLOCATE( ub(jpi,jpj,1) , STAT=ierr3 )
+ ALLOCATE( vb(jpi,jpj,1) , STAT=ierr4 )
+ ALLOCATE( tsb(jpi,jpj,1,jpm) , STAT=ierr5 )
+ ALLOCATE( sshn(jpi,jpj) , STAT=ierr6 )
+ ierr = ierr + ierr1 + ierr2 + ierr3 + ierr4 + ierr5 + ierr6
+#endif
!
IF( lk_mpp ) CALL mpp_sum( ierr )
@@ -469,9 +571,9 @@
INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors
!!----------------------------------------------------------------------
-
+ !
ierr = 0
-
+ !
CALL factorise( ifact, nfactmax, nfact, num_pes, ierr )
-
+ !
IF( nfact <= 1 ) THEN
WRITE (numout, *) 'WARNING: factorisation of number of PEs failed'
@@ -515,5 +617,5 @@
INTEGER, PARAMETER :: ntest = 14
INTEGER :: ilfax(ntest)
-
+ !
! lfax contains the set of allowed factors.
data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256, &
@@ -600,16 +702,16 @@
!loop over the other north-fold processes to find the processes
!managing the points belonging to the sxT-dxT range
- DO jn = jpnij - jpni +1, jpnij
- IF ( njmppt(jn) == njmppmax ) THEN
+
+ DO jn = 1, jpni
!sxT is the first point (in the global domain) of the jn
!process
- sxT = nimppt(jn)
+ sxT = nfiimpp(jn, jpnj)
!dxT is the last point (in the global domain) of the jn
!process
- dxT = nimppt(jn) + nlcit(jn) - 1
+ dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1
IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN
nsndto = nsndto + 1
- isendto(nsndto) = jn
- ELSEIF ((sxM .le. sxT) .AND. (dxM .gt. dxT)) THEN
+ isendto(nsndto) = jn
+ ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN
nsndto = nsndto + 1
isendto(nsndto) = jn
@@ -618,6 +720,18 @@
isendto(nsndto) = jn
END IF
- END IF
END DO
+ nfsloop = 1
+ nfeloop = nlci
+ DO jn = 2,jpni-1
+ IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN
+ IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN
+ nfsloop = nldi
+ ENDIF
+ IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN
+ nfeloop = nlei
+ ENDIF
+ ENDIF
+ END DO
+
ENDIF
l_north_nogather = .TRUE.
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90 (revision 5602)
@@ -36,26 +36,25 @@
PUBLIC sbc_ssm ! called by sbc
- CHARACTER(len=100) :: cn_dir = './' !: Root directory for location of ssm files
- LOGICAL :: ln_3d_uv = .true. !: specify whether input velocity data is 3D
- INTEGER , SAVE :: nfld_3d
- INTEGER , SAVE :: nfld_2d
-
- INTEGER , PARAMETER :: jpfld_3d = 4 ! maximum number of files to read
- INTEGER , PARAMETER :: jpfld_2d = 1 ! maximum number of files to read
- INTEGER , SAVE :: jf_tem ! index of temperature
- INTEGER , SAVE :: jf_sal ! index of salinity
- INTEGER , SAVE :: jf_usp ! index of u velocity component
- INTEGER , SAVE :: jf_vsp ! index of v velocity component
- INTEGER , SAVE :: jf_ssh ! index of sea surface height
+ CHARACTER(len=100) :: cn_dir !: Root directory for location of ssm files
+ LOGICAL :: ln_3d_uve !: specify whether input velocity data is 3D
+ LOGICAL :: ln_read_frq !: specify whether we must read frq or not
+ LOGICAL :: l_initdone = .false.
+ INTEGER :: nfld_3d
+ INTEGER :: nfld_2d
+
+ INTEGER :: jf_tem ! index of temperature
+ INTEGER :: jf_sal ! index of salinity
+ INTEGER :: jf_usp ! index of u velocity component
+ INTEGER :: jf_vsp ! index of v velocity component
+ INTEGER :: jf_ssh ! index of sea surface height
+ INTEGER :: jf_e3t ! index of first T level thickness
+ INTEGER :: jf_frq ! index of fraction of qsr absorbed in the 1st T level
TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ssm_3d ! structure of input fields (file information, fields read)
TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ssm_2d ! structure of input fields (file information, fields read)
- !! * Substitutions
-# include "domzgr_substitute.h90"
-# include "vectopt_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OFF 3.3 , NEMO Consortium (2010)
- !! $Id: sbcssm.F90 3294 2012-01-28 16:44:18Z rblod $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
@@ -86,10 +85,12 @@
IF( nfld_2d > 0 ) CALL fld_read( kt, 1, sf_ssm_2d ) !== read data at kt time step ==!
!
- IF( ln_3d_uv ) THEN
+ IF( ln_3d_uve ) THEN
ssu_m(:,:) = sf_ssm_3d(jf_usp)%fnow(:,:,1) * umask(:,:,1) ! u-velocity
ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity
+ IF( lk_vvl ) e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! v-velocity
ELSE
ssu_m(:,:) = sf_ssm_2d(jf_usp)%fnow(:,:,1) * umask(:,:,1) ! u-velocity
ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity
+ IF( lk_vvl ) e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! v-velocity
ENDIF
!
@@ -97,13 +98,14 @@
sss_m(:,:) = sf_ssm_2d(jf_sal)%fnow(:,:,1) * tmask(:,:,1) ! salinity
ssh_m(:,:) = sf_ssm_2d(jf_ssh)%fnow(:,:,1) * tmask(:,:,1) ! sea surface height
- !
- tsn(:,:,1,jp_tem) = sst_m(:,:)
- tsn(:,:,1,jp_sal) = sss_m(:,:)
+ IF( ln_read_frq ) frq_m(:,:) = sf_ssm_2d(jf_frq)%fnow(:,:,1) * tmask(:,:,1) ! sea surface height
+ !
IF ( nn_ice == 1 ) THEN
+ tsn(:,:,1,jp_tem) = sst_m(:,:)
+ tsn(:,:,1,jp_sal) = sss_m(:,:)
tsb(:,:,1,jp_tem) = sst_m(:,:)
tsb(:,:,1,jp_sal) = sss_m(:,:)
ENDIF
- ub (:,:,1 ) = ssu_m(:,:)
- vb (:,:,1 ) = ssv_m(:,:)
+ ub (:,:,1) = ssu_m(:,:)
+ vb (:,:,1) = ssv_m(:,:)
IF(ln_ctl) THEN ! print control
@@ -113,4 +115,16 @@
CALL prt_ctl(tab2d_1=ssv_m, clinfo1=' ssv_m - : ', mask1=vmask, ovlap=1 )
CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' ssh_m - : ', mask1=tmask, ovlap=1 )
+ IF( lk_vvl ) CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' e3t_m - : ', mask1=tmask, ovlap=1 )
+ IF( ln_read_frq ) CALL prt_ctl(tab2d_1=frq_m, clinfo1=' frq_m - : ', mask1=tmask, ovlap=1 )
+ ENDIF
+ !
+ IF( l_initdone ) THEN ! Mean value at each nn_fsbc time-step !
+ CALL iom_put( 'ssu_m', ssu_m )
+ CALL iom_put( 'ssv_m', ssv_m )
+ CALL iom_put( 'sst_m', sst_m )
+ CALL iom_put( 'sss_m', sss_m )
+ CALL iom_put( 'ssh_m', ssh_m )
+ IF( lk_vvl ) CALL iom_put( 'e3t_m', e3t_m )
+ IF( ln_read_frq ) CALL iom_put( 'frq_m', frq_m )
ENDIF
!
@@ -138,8 +152,11 @@
TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_2d ! array of namelist information on the fields to read
TYPE(FLD_N) :: sn_tem, sn_sal ! information about the fields to be read
- TYPE(FLD_N) :: sn_usp, sn_vsp, sn_ssh
- !
- NAMELIST/namsbc_sas/cn_dir, ln_3d_uv, sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh
- !!----------------------------------------------------------------------
+ TYPE(FLD_N) :: sn_usp, sn_vsp
+ TYPE(FLD_N) :: sn_ssh, sn_e3t, sn_frq
+ !
+ NAMELIST/namsbc_sas/cn_dir, ln_3d_uve, ln_read_frq, sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh, sn_e3t, sn_frq
+ !!----------------------------------------------------------------------
+
+ IF( ln_rstart .AND. nn_components == jp_iam_sas ) RETURN
REWIND( numnam_ref ) ! Namelist namsbc_sas in reference namelist : Input fields
@@ -159,7 +176,8 @@
WRITE(numout,*) '~~~~~~~~~~~ '
WRITE(numout,*) ' Namelist namsbc_sas'
+ WRITE(numout,*) ' Are we supplying a 3D u,v and e3 field ln_3d_uve = ', ln_3d_uve
+ WRITE(numout,*) ' Are we reading frq (fraction of qsr absorbed in the 1st T level) ln_read_frq = ', ln_read_frq
WRITE(numout,*)
ENDIF
-
!
!! switch off stuff that isn't sensible with a standalone module
@@ -170,8 +188,4 @@
ln_apr_dyn = .FALSE.
ENDIF
- IF( ln_dm2dc ) THEN
- IF( lwp ) WRITE(numout,*) 'No diurnal cycle needed with StandAlone Surface scheme'
- ln_dm2dc = .FALSE.
- ENDIF
IF( ln_rnf ) THEN
IF( lwp ) WRITE(numout,*) 'No runoff needed with StandAlone Surface scheme'
@@ -190,23 +204,22 @@
nn_closea = 0
ENDIF
-
!
!! following code is a bit messy, but distinguishes between when u,v are 3d arrays and
!! when we have other 3d arrays that we need to read in
!! so if a new field is added i.e. jf_new, just give it the next integer in sequence
- !! for the corresponding dimension (currently if ln_3d_uv is true, 4 for 2d and 3 for 3d,
- !! alternatively if ln_3d_uv is false, 6 for 2d and 1 for 3d), reset nfld_3d, nfld_2d,
+ !! for the corresponding dimension (currently if ln_3d_uve is true, 4 for 2d and 3 for 3d,
+ !! alternatively if ln_3d_uve is false, 6 for 2d and 1 for 3d), reset nfld_3d, nfld_2d,
!! and the rest of the logic should still work
!
- jf_tem = 1 ; jf_sal = 2 ; jf_ssh = 3
- !
- IF( ln_3d_uv ) THEN
- jf_usp = 1 ; jf_vsp = 2
- nfld_3d = 2
- nfld_2d = 3
+ jf_tem = 1 ; jf_sal = 2 ; jf_ssh = 3 ; jf_frq = 4 ! default 2D fields index
+ !
+ IF( ln_3d_uve ) THEN
+ jf_usp = 1 ; jf_vsp = 2 ; jf_e3t = 3 ! define 3D fields index
+ nfld_3d = 2 + COUNT( (/lk_vvl/) ) ! number of 3D fields to read
+ nfld_2d = 3 + COUNT( (/ln_read_frq/) ) ! number of 2D fields to read
ELSE
- jf_usp = 4 ; jf_vsp = 5
- nfld_3d = 0
- nfld_2d = 5
+ jf_usp = 4 ; jf_vsp = 5 ; jf_e3t = 6 ; jf_frq = 6 + COUNT( (/lk_vvl/) ) ! update 2D fields index
+ nfld_3d = 0 ! no 3D fields to read
+ nfld_2d = 5 + COUNT( (/lk_vvl/) ) + COUNT( (/ln_read_frq/) ) ! number of 2D fields to read
ENDIF
@@ -216,8 +229,7 @@
CALL ctl_stop( 'sbc_ssm_init: unable to allocate slf 3d structure' ) ; RETURN
ENDIF
- IF( ln_3d_uv ) THEN
- slf_3d(jf_usp) = sn_usp
- slf_3d(jf_vsp) = sn_vsp
- ENDIF
+ slf_3d(jf_usp) = sn_usp
+ slf_3d(jf_vsp) = sn_vsp
+ IF( lk_vvl ) slf_3d(jf_e3t) = sn_e3t
ENDIF
@@ -228,9 +240,12 @@
ENDIF
slf_2d(jf_tem) = sn_tem ; slf_2d(jf_sal) = sn_sal ; slf_2d(jf_ssh) = sn_ssh
- IF( .NOT. ln_3d_uv ) THEN
+ IF( ln_read_frq ) slf_2d(jf_frq) = sn_frq
+ IF( .NOT. ln_3d_uve ) THEN
slf_2d(jf_usp) = sn_usp ; slf_2d(jf_vsp) = sn_vsp
- ENDIF
- ENDIF
- !
+ IF( lk_vvl ) slf_2d(jf_e3t) = sn_e3t
+ ENDIF
+ ENDIF
+ !
+ ierr1 = 0 ! default definition if slf_?d(ifpr)%ln_tint = .false.
IF( nfld_3d > 0 ) THEN
ALLOCATE( sf_ssm_3d(nfld_3d), STAT=ierr ) ! set sf structure
@@ -265,23 +280,12 @@
ENDIF
!
- ! lim code currently uses surface temperature and salinity in tsn array for initialisation
- ! and ub, vb arrays in ice dynamics
- ! so allocate enough of arrays to use
- !
- ierr3 = 0
- jpm = MAX(jp_tem, jp_sal)
- ALLOCATE( tsn(jpi,jpj,1,jpm), STAT=ierr0 )
- ALLOCATE( ub(jpi,jpj,1) , STAT=ierr1 )
- ALLOCATE( vb(jpi,jpj,1) , STAT=ierr2 )
- IF ( nn_ice == 1 ) ALLOCATE( tsb(jpi,jpj,1,jpm), STAT=ierr3 )
- ierr = ierr0 + ierr1 + ierr2 + ierr3
- IF( ierr > 0 ) THEN
- CALL ctl_stop('sbc_ssm_init: unable to allocate surface arrays')
- ENDIF
- !
! finally tidy up
IF( nfld_3d > 0 ) DEALLOCATE( slf_3d, STAT=ierr )
IF( nfld_2d > 0 ) DEALLOCATE( slf_2d, STAT=ierr )
+
+ CALL sbc_ssm( nit000 ) ! need to define ss?_m arrays used in limistate
+ IF( .NOT. ln_read_frq ) frq_m(:,:) = 1.
+ l_initdone = .TRUE.
!
END SUBROUTINE sbc_ssm_init
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/SAS_SRC/step.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/SAS_SRC/step.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/SAS_SRC/step.F90 (revision 5602)
@@ -17,4 +17,6 @@
USE dom_oce ! ocean space and time domain variables
USE in_out_manager ! I/O manager
+ USE sbc_oce
+ USE sbccpl
USE iom !
USE lbclnk
@@ -36,4 +38,9 @@
USE timing ! Timing
+ USE bdy_par ! clem: mandatory for LIM3
+#if defined key_bdy
+ USE bdydta ! clem: mandatory for LIM3
+#endif
+
IMPLICIT NONE
PRIVATE
@@ -46,5 +53,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2010)
- !! $Id: step.F90 3294 2012-01-28 16:44:18Z rblod $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
@@ -72,11 +79,19 @@
kstp = nit000 + Agrif_Nb_Step()
# if defined key_iomput
- IF( Agrif_Nbstepint() == 0 ) CALL iom_swap( "nemo" )
+ IF( Agrif_Nbstepint() == 0 ) CALL iom_swap( cxios_context )
# endif
#endif
- IF( kstp == nit000 ) CALL iom_init( "nemo" ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)
+ IF( kstp == nit000 ) CALL iom_init( cxios_context ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)
IF( kstp /= nit000 ) CALL day( kstp ) ! Calendar (day was already called at nit000 in day_init)
- CALL iom_setkt( kstp, "nemo" ) ! say to iom that we are at time step kstp
+ CALL iom_setkt( kstp - nit000 + 1, cxios_context ) ! tell iom we are at time step kstp
+ ! ==> clem: open boundaries is mandatory for LIM3 because ice BDY is not decoupled from
+ ! the environment of ocean BDY. Therefore bdy is called in both OPA and SAS modules.
+ ! From SAS: ocean bdy data are wrong (but we do not care) and ice bdy data are OK.
+ ! This is not clean and should be changed in the future.
+#if defined key_bdy
+ IF( lk_bdy ) CALL bdy_dta ( kstp, time_offset=+1 ) ! update dynamic & tracer data at open boundaries
+#endif
+ ! ==>
CALL sbc ( kstp ) ! Sea Boundary Condition (including sea-ice)
@@ -86,6 +101,13 @@
! need to keep the same interface
CALL stp_ctl( kstp, indic )
+ !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+ ! Coupled mode
+ !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+ IF( lk_oasis ) CALL sbc_cpl_snd( kstp ) ! coupled mode : field exchanges if OASIS-coupled ice
+
#if defined key_iomput
- IF( kstp == nitend ) CALL iom_context_finalize( "nemo" ) ! needed for XIOS+AGRIF
+ IF( kstp == nitend .OR. indic < 0 ) THEN
+ CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF
+ ENDIF
#endif
!
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/SAS_SRC/stpctl.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/SAS_SRC/stpctl.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/SAS_SRC/stpctl.F90 (revision 5602)
@@ -28,5 +28,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2010)
- !! $Id: stpctl.F90 3294 2012-01-28 16:44:18Z rblod $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/C14b/trcice_c14b.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/C14b/trcice_c14b.F90 (revision 5602)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/C14b/trcice_c14b.F90 (revision 5602)
@@ -0,0 +1,47 @@
+MODULE trcice_c14b
+ !!======================================================================
+ !! *** MODULE trcice_c14b ***
+ !!======================================================================
+#if defined key_c14b
+ !!----------------------------------------------------------------------
+ !! 'key_c14b' CFC tracers
+ !!----------------------------------------------------------------------
+ !! trc_ice_c14b : MY_TRC model main routine
+ !!----------------------------------------------------------------------
+ USE par_trc ! TOP parameters
+ USE oce_trc ! Ocean variables
+ USE trc ! TOP variables
+
+ IMPLICIT NONE
+ PRIVATE
+
+ PUBLIC trc_ice_ini_c14b ! called by trcice.F90 module
+
+ !!----------------------------------------------------------------------
+ !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+ !! $Id: trcice_c14b.F90 4990 2014-12-15 16:42:49Z timgraham $
+ !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+ !!----------------------------------------------------------------------
+CONTAINS
+
+ SUBROUTINE trc_ice_ini_c14b
+ !!----------------------------------------------------------------------
+ !! *** trc_ice_c14b ***
+ !!
+ !!----------------------------------------------------------------------
+ !
+ !
+ END SUBROUTINE trc_ice_ini_c14b
+
+
+#else
+ !!----------------------------------------------------------------------
+ !! Dummy module No MY_TRC model
+ !!----------------------------------------------------------------------
+CONTAINS
+ SUBROUTINE trc_ice_ini_c14b ! Empty routine
+ END SUBROUTINE trc_ice_ini_c14b
+#endif
+
+ !!======================================================================
+END MODULE trcice_c14b
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90 (revision 5602)
@@ -54,5 +54,5 @@
!!----------------------------------------------------------------------
!! NEMO/TOP 3.3 , NEMO Consortium (2010)
- !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/SMS/trcc14bomb.F90,v 1.2 2005/11/14 16:42:43 opalod Exp $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/C14b/trcwri_c14b.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/C14b/trcwri_c14b.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/C14b/trcwri_c14b.F90 (revision 5602)
@@ -6,5 +6,5 @@
!! History : 1.0 ! 2009-05 (C. Ethe) Original code
!!----------------------------------------------------------------------
-#if defined key_top && key_c14b && defined key_iomput
+#if defined key_top && defined key_c14b && defined key_iomput
!!----------------------------------------------------------------------
!! 'key_c14b' c14b model
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/CFC/trcice_cfc.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/CFC/trcice_cfc.F90 (revision 5602)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/CFC/trcice_cfc.F90 (revision 5602)
@@ -0,0 +1,53 @@
+MODULE trcice_cfc
+ !!======================================================================
+ !! *** MODULE trcice_cfc ***
+ !! TOP : Main module of the MY_TRC tracers
+ !!======================================================================
+ !! History : 2.0 ! 2007-12 (C. Ethe, G. Madec) Original code
+ !!----------------------------------------------------------------------
+#if defined key_cfc
+ !!----------------------------------------------------------------------
+ !! 'key_cfc' CFC tracers
+ !!----------------------------------------------------------------------
+ !! trc_ice_cfc : MY_TRC model main routine
+ !!----------------------------------------------------------------------
+ USE par_trc ! TOP parameters
+ USE oce_trc ! Ocean variables
+ USE trc ! TOP variables
+
+ IMPLICIT NONE
+ PRIVATE
+
+ PUBLIC trc_ice_ini_cfc ! called by trcice.F90 module
+
+ !!----------------------------------------------------------------------
+ !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+ !! $Id: trcice_cfc.F90 4990 2014-12-15 16:42:49Z timgraham $
+ !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+ !!----------------------------------------------------------------------
+CONTAINS
+
+ SUBROUTINE trc_ice_ini_cfc
+ !!----------------------------------------------------------------------
+ !! *** trc_ice_cfc ***
+ !!
+ !! ** Purpose : main routine of MY_TRC model
+ !!
+ !! ** Method : -
+ !!----------------------------------------------------------------------
+ !
+ !
+ END SUBROUTINE trc_ice_ini_cfc
+
+
+#else
+ !!----------------------------------------------------------------------
+ !! Dummy module No MY_TRC model
+ !!----------------------------------------------------------------------
+CONTAINS
+ SUBROUTINE trc_ice_ini_cfc ! Empty routine
+ END SUBROUTINE trc_ice_ini_cfc
+#endif
+
+ !!======================================================================
+END MODULE trcice_cfc
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/CFC/trcwri_cfc.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/CFC/trcwri_cfc.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/CFC/trcwri_cfc.F90 (revision 5602)
@@ -6,5 +6,5 @@
!! History : 1.0 ! 2009-05 (C. Ethe) Original code
!!----------------------------------------------------------------------
-#if defined key_top && key_cfc && defined key_iomput
+#if defined key_top && defined key_cfc && defined key_iomput
!!----------------------------------------------------------------------
!! 'key_cfc' cfc model
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcice_my_trc.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcice_my_trc.F90 (revision 5602)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcice_my_trc.F90 (revision 5602)
@@ -0,0 +1,46 @@
+MODULE trcice_my_trc
+ !!======================================================================
+ !! *** MODULE trcice_my_trc ***
+ !!----------------------------------------------------------------------
+#if defined key_my_trc
+ !!----------------------------------------------------------------------
+ !! 'key_my_trc' CFC tracers
+ !!----------------------------------------------------------------------
+ !! trc_ice_my_trc : MY_TRC model main routine
+ !!----------------------------------------------------------------------
+ USE par_trc ! TOP parameters
+ USE oce_trc ! Ocean variables
+ USE trc ! TOP variables
+
+ IMPLICIT NONE
+ PRIVATE
+
+ PUBLIC trc_ice_ini_my_trc ! called by trcice.F90 module
+
+ !!----------------------------------------------------------------------
+ !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+ !! $Id: trcice_my_trc.F90 4990 2014-12-15 16:42:49Z timgraham $
+ !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+ !!----------------------------------------------------------------------
+CONTAINS
+
+ SUBROUTINE trc_ice_ini_my_trc
+ !!----------------------------------------------------------------------
+ !! *** trc_ice_my_trc ***
+ !!
+ !!----------------------------------------------------------------------
+ !
+ !
+ END SUBROUTINE trc_ice_ini_my_trc
+
+#else
+ !!----------------------------------------------------------------------
+ !! Dummy module No MY_TRC model
+ !!----------------------------------------------------------------------
+CONTAINS
+ SUBROUTINE trc_ice_ini_my_trc ! Empty routine
+ END SUBROUTINE trc_ice_ini_my_trc
+#endif
+
+ !!======================================================================
+END MODULE trcice_my_trc
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcini_my_trc.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcini_my_trc.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcini_my_trc.F90 (revision 5602)
@@ -43,5 +43,9 @@
IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*) ' trc_ini_my_trc: initialisation of MY_TRC model'
+ IF(lwp) WRITE(numout,*) ' trc_ini_my_trc: passive tracer unit vector'
+ IF(lwp) WRITE(numout,*) ' To check conservation : '
+ IF(lwp) WRITE(numout,*) ' 1 - No sea-ice model '
+ IF(lwp) WRITE(numout,*) ' 2 - No runoff '
+ IF(lwp) WRITE(numout,*) ' 3 - precipitation and evaporation equal to 1 : E=P=1 '
IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90 (revision 5602)
@@ -57,5 +57,5 @@
INTEGER :: jn, jk ! dummy loop index
REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrmyt
-!!----------------------------------------------------------------------
+ !!----------------------------------------------------------------------
!
IF( nn_timing == 1 ) CALL timing_start('trc_sms_my_trc')
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90 (revision 5602)
@@ -6,5 +6,5 @@
!! History : 1.0 ! 2009-05 (C. Ethe) Original code
!!----------------------------------------------------------------------
-#if defined key_top && key_my_trc && defined key_iomput
+#if defined key_top && defined key_my_trc && defined key_iomput
!!----------------------------------------------------------------------
!! 'key_my_trc' my_trc model
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90 (revision 5602)
@@ -63,5 +63,5 @@
!!----------------------------------------------------------------------
!! NEMO/TOP 3.3 , NEMO Consortium (2010)
- !! $Id: p2zbio.F90 3294 2012-01-28 16:44:18Z rblod $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90 (revision 5602)
@@ -45,5 +45,5 @@
!!----------------------------------------------------------------------
!! NEMO/TOP 3.3 , NEMO Consortium (2010)
- !! $Id: trcexp.F90 3294 2012-01-28 16:44:18Z rblod $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90 (revision 5602)
@@ -44,5 +44,5 @@
!!----------------------------------------------------------------------
!! NEMO/TOP 3.3 , NEMO Consortium (2010)
- !! $Id: trcopt.F90 3294 2012-01-28 16:44:18Z rblod $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
@@ -89,5 +89,8 @@
! ! surface irradiance
- zpar0m (:,:) = qsr (:,:) * 0.43 ! ------------------
+ ! ! ------------------
+ IF( ln_dm2dc ) THEN ; zpar0m(:,:) = qsr_mean(:,:) * 0.43
+ ELSE ; zpar0m(:,:) = qsr (:,:) * 0.43
+ ENDIF
zpar100(:,:) = zpar0m(:,:) * 0.01
zparr (:,:,1) = zpar0m(:,:) * 0.5
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90 (revision 5602)
@@ -38,5 +38,5 @@
!!----------------------------------------------------------------------
!! NEMO/TOP 3.3 , NEMO Consortium (2010)
- !! $Id: p2z_sed.F90 3294 2012-01-28 16:44:18Z rblod $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90 (revision 5602)
@@ -32,5 +32,5 @@
!!----------------------------------------------------------------------
!! NEMO/TOP 3.3 , NEMO Consortium (2010)
- !! $Id: p2zsms.F90 3294 2012-01-28 16:44:18Z rblod $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90 (revision 5602)
@@ -44,5 +44,5 @@
CONTAINS
- SUBROUTINE p4z_bio ( kt, jnt )
+ SUBROUTINE p4z_bio ( kt, knt )
!!---------------------------------------------------------------------
!! *** ROUTINE p4z_bio ***
@@ -54,10 +54,6 @@
!! ** Method : - ???
!!---------------------------------------------------------------------
- INTEGER, INTENT(in) :: kt, jnt
- INTEGER :: ji, jj, jk, jn
- REAL(wp) :: ztra
-#if defined key_kriest
- REAL(wp) :: zcoef1, zcoef2
-#endif
+ INTEGER, INTENT(in) :: kt, knt
+ INTEGER :: ji, jj, jk, jn
CHARACTER (len=25) :: charout
@@ -80,54 +76,21 @@
- CALL p4z_opt ( kt, jnt ) ! Optic: PAR in the water column
- CALL p4z_sink ( kt, jnt ) ! vertical flux of particulate organic matter
- CALL p4z_fechem(kt, jnt ) ! Iron chemistry/scavenging
- CALL p4z_lim ( kt, jnt ) ! co-limitations by the various nutrients
- CALL p4z_prod ( kt, jnt ) ! phytoplankton growth rate over the global ocean.
+ CALL p4z_opt ( kt, knt ) ! Optic: PAR in the water column
+ CALL p4z_sink ( kt, knt ) ! vertical flux of particulate organic matter
+ CALL p4z_fechem(kt, knt ) ! Iron chemistry/scavenging
+ CALL p4z_lim ( kt, knt ) ! co-limitations by the various nutrients
+ CALL p4z_prod ( kt, knt ) ! phytoplankton growth rate over the global ocean.
! ! (for each element : C, Si, Fe, Chl )
CALL p4z_mort ( kt ) ! phytoplankton mortality
- ! ! zooplankton sources/sinks routines
- CALL p4z_micro( kt, jnt ) ! microzooplankton
- CALL p4z_meso ( kt, jnt ) ! mesozooplankton
- CALL p4z_rem ( kt, jnt ) ! remineralization terms of organic matter+scavenging of Fe
+ ! ! zooplankton sources/sinks routines
+ CALL p4z_micro( kt, knt ) ! microzooplankton
+ CALL p4z_meso ( kt, knt ) ! mesozooplankton
+ CALL p4z_rem ( kt, knt ) ! remineralization terms of organic matter+scavenging of Fe
! ! test if tracers concentrations fall below 0.
- xnegtr(:,:,:) = 1.e0
- DO jn = jp_pcs0, jp_pcs1
- DO jk = 1, jpk
- DO jj = 1, jpj
- DO ji = 1, jpi
- IF( ( trn(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) < 0.e0 ) THEN
- ztra = ABS( trn(ji,jj,jk,jn) ) / ( ABS( tra(ji,jj,jk,jn) ) + rtrn )
-
- xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk), ztra )
- ENDIF
- END DO
- END DO
- END DO
- END DO
- ! ! where at least 1 tracer concentration becomes negative
- ! !
- DO jn = jp_pcs0, jp_pcs1
- trn(:,:,:,jn) = trn(:,:,:,jn) + xnegtr(:,:,:) * tra(:,:,:,jn)
- END DO
-
-
- tra(:,:,:,:) = 0.e0
-
-#if defined key_kriest
- !
- zcoef1 = 1.e0 / xkr_massp
- zcoef2 = 1.e0 / xkr_massp / 1.1
- DO jk = 1,jpkm1
- trn(:,:,jk,jpnum) = MAX( trn(:,:,jk,jpnum), trn(:,:,jk,jppoc) * zcoef1 / xnumm(jk) )
- trn(:,:,jk,jpnum) = MIN( trn(:,:,jk,jpnum), trn(:,:,jk,jppoc) * zcoef2 )
- END DO
-#endif
-
- !
+ ! !
IF(ln_ctl) THEN ! print mean trends (used for debugging)
WRITE(charout, FMT="('bio ')")
CALL prt_ctl_trc_info(charout)
- CALL prt_ctl_trc(tab4d=trn, mask=tmask, clinfo=ctrcnm)
+ CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
ENDIF
!
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90 (revision 5602)
@@ -168,5 +168,5 @@
!!----------------------------------------------------------------------
!! NEMO/TOP 3.3 , NEMO Consortium (2010)
- !! $Id: p4zche.F90 3294 2012-01-28 16:44:18Z rblod $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90 (revision 5602)
@@ -48,5 +48,5 @@
CONTAINS
- SUBROUTINE p4z_fechem( kt, jnt )
+ SUBROUTINE p4z_fechem( kt, knt )
!!---------------------------------------------------------------------
!! *** ROUTINE p4z_fechem ***
@@ -62,5 +62,5 @@
!!---------------------------------------------------------------------
!
- INTEGER, INTENT(in) :: kt, jnt ! ocean time step
+ INTEGER, INTENT(in) :: kt, knt ! ocean time step
!
INTEGER :: ji, jj, jk, jic
@@ -101,5 +101,5 @@
! -------------------------------------------------
IF( ln_ligvar ) THEN
- ztotlig(:,:,:) = 0.09 * trn(:,:,:,jpdoc) * 1E6 + ligand * 1E9
+ ztotlig(:,:,:) = 0.09 * trb(:,:,:,jpdoc) * 1E6 + ligand * 1E9
ztotlig(:,:,:) = MIN( ztotlig(:,:,:), 10. )
ELSE
@@ -127,5 +127,5 @@
zionic = 19.9201 * tsn(ji,jj,jk,jp_sal) / ( 1000. - 1.00488 * tsn(ji,jj,jk,jp_sal) + rtrn )
zph = -LOG10( MAX( hi(ji,jj,jk), rtrn) )
- zoxy = trn(ji,jj,jk,jpoxy) * ( rhop(ji,jj,jk) / 1.e3 )
+ zoxy = trb(ji,jj,jk,jpoxy) * ( rhop(ji,jj,jk) / 1.e3 )
! Fe2+ oxydation rate from Santana-Casiano et al. (2005)
zkox = 35.407 - 6.7109 * zph + 0.5342 * zph * zph - 5362.6 / ( tsn(ji,jj,jk,jp_tem) + 273.15 ) &
@@ -137,5 +137,5 @@
zkph1 = zkph2 / 5.
! pass the dfe concentration from PISCES
- ztfe = trn(ji,jj,jk,jpfer) * 1e9
+ ztfe = trb(ji,jj,jk,jpfer) * 1e9
! ----------------------------------------------------------
! ANALYTICAL SOLUTION OF ROOTS OF THE FE3+ EQUATION
@@ -204,5 +204,5 @@
zkeq = fekeq(ji,jj,jk)
zfesatur = zTL1(ji,jj,jk) * 1E-9
- ztfe = trn(ji,jj,jk,jpfer)
+ ztfe = trb(ji,jj,jk,jpfer)
! Fe' is the root of a 2nd order polynom
zFe3 (ji,jj,jk) = ( -( 1. + zfesatur * zkeq - zkeq * ztfe ) &
@@ -210,5 +210,5 @@
& + 4. * ztfe * zkeq) ) / ( 2. * zkeq )
zFe3 (ji,jj,jk) = zFe3(ji,jj,jk) * 1E9
- zFeL1(ji,jj,jk) = MAX( 0., trn(ji,jj,jk,jpfer) * 1E9 - zFe3(ji,jj,jk) )
+ zFeL1(ji,jj,jk) = MAX( 0., trb(ji,jj,jk,jpfer) * 1E9 - zFe3(ji,jj,jk) )
END DO
END DO
@@ -240,7 +240,7 @@
ENDIF
#if defined key_kriest
- ztrc = ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpcal) + trn(ji,jj,jk,jpgsi) ) * 1.e6
+ ztrc = ( trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpcal) + trb(ji,jj,jk,jpgsi) ) * 1.e6
#else
- ztrc = ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpgoc) + trn(ji,jj,jk,jpcal) + trn(ji,jj,jk,jpgsi) ) * 1.e6
+ ztrc = ( trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpgoc) + trb(ji,jj,jk,jpcal) + trb(ji,jj,jk,jpgsi) ) * 1.e6
#endif
IF( ln_dust ) zdust = dust(ji,jj) / ( wdust / rday ) * tmask(ji,jj,jk) ! dust in kg/m2/s
@@ -251,7 +251,7 @@
! to later allocate scavenged iron to the different organic pools
! ---------------------------------------------------------
- zdenom1 = xlam1 * trn(ji,jj,jk,jppoc) / zlam1b
+ zdenom1 = xlam1 * trb(ji,jj,jk,jppoc) / zlam1b
#if ! defined key_kriest
- zdenom2 = xlam1 * trn(ji,jj,jk,jpgoc) / zlam1b
+ zdenom2 = xlam1 * trb(ji,jj,jk,jpgoc) / zlam1b
#endif
@@ -262,6 +262,6 @@
zlamfac = MIN( 1. , zlamfac )
zdep = MIN( 1., 1000. / fsdept(ji,jj,jk) )
- zlam1b = xlam1 * MAX( 0.e0, ( trn(ji,jj,jk,jpfer) * 1.e9 - ztotlig(ji,jj,jk) ) )
- zcoag = zfeequi * zlam1b * zstep + 1E-4 * ( 1. - zlamfac ) * zdep * zstep * trn(ji,jj,jk,jpfer)
+ zlam1b = xlam1 * MAX( 0.e0, ( trb(ji,jj,jk,jpfer) * 1.e9 - ztotlig(ji,jj,jk) ) )
+ zcoag = zfeequi * zlam1b * zstep + 1E-4 * ( 1. - zlamfac ) * zdep * zstep * trb(ji,jj,jk,jpfer)
! Compute the coagulation of colloidal iron. This parameterization
@@ -269,6 +269,6 @@
! It requires certainly some more work as it is very poorly constrained.
! ----------------------------------------------------------------
- zlam1a = ( 0.369 * 0.3 * trn(ji,jj,jk,jpdoc) + 102.4 * trn(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk) &
- & + ( 114. * 0.3 * trn(ji,jj,jk,jpdoc) + 5.09E3 * trn(ji,jj,jk,jppoc) )
+ zlam1a = ( 0.369 * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4 * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk) &
+ & + ( 114. * 0.3 * trb(ji,jj,jk,jpdoc) + 5.09E3 * trb(ji,jj,jk,jppoc) )
zaggdfea = zlam1a * zstep * zfecoll
#if defined key_kriest
@@ -278,5 +278,5 @@
tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 + zaggdfea + zaggdfeb
#else
- zlam1b = 3.53E3 * trn(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk)
+ zlam1b = 3.53E3 * trb(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk)
zaggdfeb = zlam1b * zstep * zfecoll
!
@@ -292,12 +292,12 @@
! ----------------------------------------
IF( ln_fechem ) THEN
- biron(:,:,:) = MAX( 0., trn(:,:,:,jpfer) - zFeP(:,:,:) * 1E-9 )
+ biron(:,:,:) = MAX( 0., trb(:,:,:,jpfer) - zFeP(:,:,:) * 1E-9 )
ELSE
- biron(:,:,:) = trn(:,:,:,jpfer)
+ biron(:,:,:) = trb(:,:,:,jpfer)
ENDIF
! Output of some diagnostics variables
! ---------------------------------
- IF( lk_iomput .AND. jnt == nrdttrc ) THEN
+ IF( lk_iomput .AND. knt == nrdttrc ) THEN
IF( iom_use("Fe3") ) CALL iom_put("Fe3" , zFe3 (:,:,:) * tmask(:,:,:) ) ! Fe3+
IF( iom_use("FeL1") ) CALL iom_put("FeL1" , zFeL1 (:,:,:) * tmask(:,:,:) ) ! FeL1
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90 (revision 5602)
@@ -63,10 +63,10 @@
!!----------------------------------------------------------------------
!! NEMO/TOP 3.3 , NEMO Consortium (2010)
- !! $Id: p4zflx.F90 3294 2012-01-28 16:44:18Z rblod $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
CONTAINS
- SUBROUTINE p4z_flx ( kt )
+ SUBROUTINE p4z_flx ( kt, knt )
!!---------------------------------------------------------------------
!! *** ROUTINE p4z_flx ***
@@ -81,5 +81,5 @@
!!---------------------------------------------------------------------
!
- INTEGER, INTENT(in) :: kt !
+ INTEGER, INTENT(in) :: kt, knt !
!
INTEGER :: ji, jj, jm, iind, iindm1
@@ -101,5 +101,5 @@
! IS USED TO COMPUTE AIR-SEA FLUX OF CO2
- IF( kt /= nit000 ) CALL p4z_patm( kt ) ! Get sea-level pressure (E&K [1981] climatology) for use in flux calcs
+ IF( kt /= nit000 .AND. knt == 1 ) CALL p4z_patm( kt ) ! Get sea-level pressure (E&K [1981] climatology) for use in flux calcs
IF( ln_co2int ) THEN
@@ -130,7 +130,7 @@
zbot = borat(ji,jj,1)
zfact = rhop(ji,jj,1) / 1000. + rtrn
- zdic = trn(ji,jj,1,jpdic) / zfact
+ zdic = trb(ji,jj,1,jpdic) / zfact
zph = MAX( hi(ji,jj,1), 1.e-10 ) / zfact
- zalka = trn(ji,jj,1,jptal) / zfact
+ zalka = trb(ji,jj,1,jptal) / zfact
! CALCULATE [ALK]([CO3--], [HCO3-])
@@ -184,13 +184,13 @@
zfld = satmco2(ji,jj) * patm(ji,jj) * tmask(ji,jj,1) * chemc(ji,jj,1) * zkgco2(ji,jj) ! (mol/L) * (m/s)
zflu = zh2co3(ji,jj) * tmask(ji,jj,1) * zkgco2(ji,jj) ! (mol/L) (m/s) ?
- oce_co2(ji,jj) = ( zfld - zflu ) * rfact * e1e2t(ji,jj) * tmask(ji,jj,1) * 1000.
+ oce_co2(ji,jj) = ( zfld - zflu ) * rfact2 * e1e2t(ji,jj) * tmask(ji,jj,1) * 1000.
! compute the trend
- tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) / fse3t(ji,jj,1)
+ tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) * rfact2 / fse3t(ji,jj,1)
! Compute O2 flux
zfld16 = atcox * patm(ji,jj) * chemc(ji,jj,2) * tmask(ji,jj,1) * zkgo2(ji,jj) ! (mol/L) * (m/s)
- zflu16 = trn(ji,jj,1,jpoxy) * tmask(ji,jj,1) * zkgo2(ji,jj)
+ zflu16 = trb(ji,jj,1,jpoxy) * tmask(ji,jj,1) * zkgo2(ji,jj)
zoflx(ji,jj) = zfld16 - zflu16
- tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + zoflx(ji,jj) / fse3t(ji,jj,1)
+ tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + zoflx(ji,jj) * rfact2 / fse3t(ji,jj,1)
END DO
END DO
@@ -207,8 +207,8 @@
ENDIF
- IF( lk_iomput ) THEN
+ IF( lk_iomput .AND. knt == nrdttrc ) THEN
CALL wrk_alloc( jpi, jpj, zw2d )
IF( iom_use( "Cflx" ) ) THEN
- zw2d(:,:) = oce_co2(:,:) / e1e2t(:,:) / rfact
+ zw2d(:,:) = oce_co2(:,:) / e1e2t(:,:) * rfact2r
CALL iom_put( "Cflx" , zw2d )
ENDIF
@@ -226,5 +226,5 @@
ENDIF
IF( iom_use( "Dpo2" ) ) THEN
- zw2d(:,:) = ( atcox * patm(:,:) - trn(:,:,1,jpoxy) / ( chemc(:,:,2) + rtrn ) ) * tmask(:,:,1)
+ zw2d(:,:) = ( atcox * patm(:,:) - trb(:,:,1,jpoxy) / ( chemc(:,:,2) + rtrn ) ) * tmask(:,:,1)
CALL iom_put( "Dpo2" , zw2d )
ENDIF
@@ -235,5 +235,5 @@
ELSE
IF( ln_diatrc ) THEN
- trc2d(:,:,jp_pcs0_2d ) = oce_co2(:,:) / e1e2t(:,:) / rfact
+ trc2d(:,:,jp_pcs0_2d ) = oce_co2(:,:) / e1e2t(:,:) * rfact2r
trc2d(:,:,jp_pcs0_2d + 1) = zoflx(:,:) * 1000 * tmask(:,:,1)
trc2d(:,:,jp_pcs0_2d + 2) = zkgco2(:,:) * tmask(:,:,1)
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90 (revision 5602)
@@ -26,5 +26,5 @@
!!----------------------------------------------------------------------
!! NEMO/TOP 3.3 , NEMO Consortium (2010)
- !! $Id: p4zint.F90 3294 2012-01-28 16:44:18Z rblod $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
@@ -56,5 +56,5 @@
DO ji = 1, jpi
DO jj = 1, jpj
- zvar = trn(ji,jj,1,jpsil) * trn(ji,jj,1,jpsil)
+ zvar = trb(ji,jj,1,jpsil) * trb(ji,jj,1,jpsil)
xksimax(ji,jj) = MAX( xksimax(ji,jj), ( 1.+ 7.* zvar / ( xksilim * xksilim + zvar ) ) * 1e-6 )
END DO
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90 (revision 5602)
@@ -62,5 +62,5 @@
CONTAINS
- SUBROUTINE p4z_lim( kt, jnt )
+ SUBROUTINE p4z_lim( kt, knt )
!!---------------------------------------------------------------------
!! *** ROUTINE p4z_lim ***
@@ -72,10 +72,10 @@
!!---------------------------------------------------------------------
!
- INTEGER, INTENT(in) :: kt, jnt
+ INTEGER, INTENT(in) :: kt, knt
!
INTEGER :: ji, jj, jk
REAL(wp) :: zlim1, zlim2, zlim3, zlim4, zno3, zferlim
REAL(wp) :: zconcd, zconcd2, zconcn, zconcn2
- REAL(wp) :: z1_trndia, z1_trnphy, ztem1, ztem2, zetot1, zetot2
+ REAL(wp) :: z1_trbdia, z1_trbphy, ztem1, ztem2, zetot1, zetot2
REAL(wp) :: zdenom, zratio, zironmin
REAL(wp) :: zconc1d, zconc1dnh4, zconc0n, zconc0nnh4
@@ -90,37 +90,37 @@
! Tuning of the iron concentration to a minimum level that is set to the detection limit
!-------------------------------------
- zno3 = trn(ji,jj,jk,jpno3) / 40.e-6
+ zno3 = trb(ji,jj,jk,jpno3) / 40.e-6
zferlim = MAX( 3e-11 * zno3 * zno3, 5e-12 )
zferlim = MIN( zferlim, 7e-11 )
- trn(ji,jj,jk,jpfer) = MAX( trn(ji,jj,jk,jpfer), zferlim )
+ trb(ji,jj,jk,jpfer) = MAX( trb(ji,jj,jk,jpfer), zferlim )
! Computation of a variable Ks for iron on diatoms taking into account
! that increasing biomass is made of generally bigger cells
!------------------------------------------------
- zconcd = MAX( 0.e0 , trn(ji,jj,jk,jpdia) - xsizedia )
- zconcd2 = trn(ji,jj,jk,jpdia) - zconcd
- zconcn = MAX( 0.e0 , trn(ji,jj,jk,jpphy) - xsizephy )
- zconcn2 = trn(ji,jj,jk,jpphy) - zconcn
- z1_trnphy = 1. / ( trn(ji,jj,jk,jpphy) + rtrn )
- z1_trndia = 1. / ( trn(ji,jj,jk,jpdia) + rtrn )
-
- concdfe(ji,jj,jk) = MAX( concdfer, ( zconcd2 * concdfer + concdfer * xsizerd * zconcd ) * z1_trndia )
- zconc1d = MAX( concdno3, ( zconcd2 * concdno3 + concdno3 * xsizerd * zconcd ) * z1_trndia )
- zconc1dnh4 = MAX( concdnh4, ( zconcd2 * concdnh4 + concdnh4 * xsizerd * zconcd ) * z1_trndia )
-
- concnfe(ji,jj,jk) = MAX( concnfer, ( zconcn2 * concnfer + concnfer * xsizern * zconcn ) * z1_trnphy )
- zconc0n = MAX( concnno3, ( zconcn2 * concnno3 + concnno3 * xsizern * zconcn ) * z1_trnphy )
- zconc0nnh4 = MAX( concnnh4, ( zconcn2 * concnnh4 + concnnh4 * xsizern * zconcn ) * z1_trnphy )
+ zconcd = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia )
+ zconcd2 = trb(ji,jj,jk,jpdia) - zconcd
+ zconcn = MAX( 0.e0 , trb(ji,jj,jk,jpphy) - xsizephy )
+ zconcn2 = trb(ji,jj,jk,jpphy) - zconcn
+ z1_trbphy = 1. / ( trb(ji,jj,jk,jpphy) + rtrn )
+ z1_trbdia = 1. / ( trb(ji,jj,jk,jpdia) + rtrn )
+
+ concdfe(ji,jj,jk) = MAX( concdfer, ( zconcd2 * concdfer + concdfer * xsizerd * zconcd ) * z1_trbdia )
+ zconc1d = MAX( concdno3, ( zconcd2 * concdno3 + concdno3 * xsizerd * zconcd ) * z1_trbdia )
+ zconc1dnh4 = MAX( concdnh4, ( zconcd2 * concdnh4 + concdnh4 * xsizerd * zconcd ) * z1_trbdia )
+
+ concnfe(ji,jj,jk) = MAX( concnfer, ( zconcn2 * concnfer + concnfer * xsizern * zconcn ) * z1_trbphy )
+ zconc0n = MAX( concnno3, ( zconcn2 * concnno3 + concnno3 * xsizern * zconcn ) * z1_trbphy )
+ zconc0nnh4 = MAX( concnnh4, ( zconcn2 * concnnh4 + concnnh4 * xsizern * zconcn ) * z1_trbphy )
! Michaelis-Menten Limitation term for nutrients Small bacteria
! -------------------------------------------------------------
- zdenom = 1. / ( concbno3 * concbnh4 + concbnh4 * trn(ji,jj,jk,jpno3) + concbno3 * trn(ji,jj,jk,jpnh4) )
- xnanono3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * concbnh4 * zdenom
- xnanonh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * concbno3 * zdenom
+ zdenom = 1. / ( concbno3 * concbnh4 + concbnh4 * trb(ji,jj,jk,jpno3) + concbno3 * trb(ji,jj,jk,jpnh4) )
+ xnanono3(ji,jj,jk) = trb(ji,jj,jk,jpno3) * concbnh4 * zdenom
+ xnanonh4(ji,jj,jk) = trb(ji,jj,jk,jpnh4) * concbno3 * zdenom
!
zlim1 = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk)
- zlim2 = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + concbnh4 )
- zlim3 = trn(ji,jj,jk,jpfer) / ( concbfe + trn(ji,jj,jk,jpfer) )
- zlim4 = trn(ji,jj,jk,jpdoc) / ( xkdoc + trn(ji,jj,jk,jpdoc) )
+ zlim2 = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concbnh4 )
+ zlim3 = trb(ji,jj,jk,jpfer) / ( concbfe + trb(ji,jj,jk,jpfer) )
+ zlim4 = trb(ji,jj,jk,jpdoc) / ( xkdoc + trb(ji,jj,jk,jpdoc) )
xlimbacl(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 )
xlimbac (ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) * zlim4
@@ -128,12 +128,12 @@
! Michaelis-Menten Limitation term for nutrients Small flagellates
! -----------------------------------------------
- zdenom = 1. / ( zconc0n * zconc0nnh4 + zconc0nnh4 * trn(ji,jj,jk,jpno3) + zconc0n * trn(ji,jj,jk,jpnh4) )
- xnanono3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * zconc0nnh4 * zdenom
- xnanonh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * zconc0n * zdenom
+ zdenom = 1. / ( zconc0n * zconc0nnh4 + zconc0nnh4 * trb(ji,jj,jk,jpno3) + zconc0n * trb(ji,jj,jk,jpnh4) )
+ xnanono3(ji,jj,jk) = trb(ji,jj,jk,jpno3) * zconc0nnh4 * zdenom
+ xnanonh4(ji,jj,jk) = trb(ji,jj,jk,jpnh4) * zconc0n * zdenom
!
zlim1 = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk)
- zlim2 = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + zconc0nnh4 )
- zratio = trn(ji,jj,jk,jpnfe) * z1_trnphy
- zironmin = xcoef1 * trn(ji,jj,jk,jpnch) * z1_trnphy + xcoef2 * zlim1 + xcoef3 * xnanono3(ji,jj,jk)
+ zlim2 = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zconc0nnh4 )
+ zratio = trb(ji,jj,jk,jpnfe) * z1_trbphy
+ zironmin = xcoef1 * trb(ji,jj,jk,jpnch) * z1_trbphy + xcoef2 * zlim1 + xcoef3 * xnanono3(ji,jj,jk)
zlim3 = MAX( 0.,( zratio - zironmin ) / qnfelim )
xnanopo4(ji,jj,jk) = zlim2
@@ -143,13 +143,13 @@
! Michaelis-Menten Limitation term for nutrients Diatoms
! ----------------------------------------------
- zdenom = 1. / ( zconc1d * zconc1dnh4 + zconc1dnh4 * trn(ji,jj,jk,jpno3) + zconc1d * trn(ji,jj,jk,jpnh4) )
- xdiatno3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * zconc1dnh4 * zdenom
- xdiatnh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * zconc1d * zdenom
+ zdenom = 1. / ( zconc1d * zconc1dnh4 + zconc1dnh4 * trb(ji,jj,jk,jpno3) + zconc1d * trb(ji,jj,jk,jpnh4) )
+ xdiatno3(ji,jj,jk) = trb(ji,jj,jk,jpno3) * zconc1dnh4 * zdenom
+ xdiatnh4(ji,jj,jk) = trb(ji,jj,jk,jpnh4) * zconc1d * zdenom
!
zlim1 = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk)
- zlim2 = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + zconc1dnh4 )
- zlim3 = trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi(ji,jj) )
- zratio = trn(ji,jj,jk,jpdfe) * z1_trndia
- zironmin = xcoef1 * trn(ji,jj,jk,jpdch) * z1_trndia + xcoef2 * zlim1 + xcoef3 * xdiatno3(ji,jj,jk)
+ zlim2 = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zconc1dnh4 )
+ zlim3 = trb(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi(ji,jj) )
+ zratio = trb(ji,jj,jk,jpdfe) * z1_trbdia
+ zironmin = xcoef1 * trb(ji,jj,jk,jpdch) * z1_trbdia + xcoef2 * zlim1 + xcoef3 * xdiatno3(ji,jj,jk)
zlim4 = MAX( 0., ( zratio - zironmin ) / qdfelim )
xdiatpo4(ji,jj,jk) = zlim2
@@ -166,16 +166,16 @@
DO jj = 1, jpj
DO ji = 1, jpi
- zlim1 = ( trn(ji,jj,jk,jpno3) * concnnh4 + trn(ji,jj,jk,jpnh4) * concnno3 ) &
- & / ( concnno3 * concnnh4 + concnnh4 * trn(ji,jj,jk,jpno3) + concnno3 * trn(ji,jj,jk,jpnh4) )
- zlim2 = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + concnnh4 )
- zlim3 = trn(ji,jj,jk,jpfer) / ( trn(ji,jj,jk,jpfer) + 5.E-11 )
+ zlim1 = ( trb(ji,jj,jk,jpno3) * concnnh4 + trb(ji,jj,jk,jpnh4) * concnno3 ) &
+ & / ( concnno3 * concnnh4 + concnnh4 * trb(ji,jj,jk,jpno3) + concnno3 * trb(ji,jj,jk,jpnh4) )
+ zlim2 = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concnnh4 )
+ zlim3 = trb(ji,jj,jk,jpfer) / ( trb(ji,jj,jk,jpfer) + 5.E-11 )
ztem1 = MAX( 0., tsn(ji,jj,jk,jp_tem) )
ztem2 = tsn(ji,jj,jk,jp_tem) - 10.
- zetot1 = MAX( 0., etot(ji,jj,jk) - 1.) / ( 4. + etot(ji,jj,jk) )
- zetot2 = 30. / ( 30. + etot(ji,jj,jk) )
+ zetot1 = MAX( 0., etot_ndcy(ji,jj,jk) - 1.) / ( 4. + etot_ndcy(ji,jj,jk) )
+ zetot2 = 30. / ( 30. + etot_ndcy(ji,jj,jk) )
xfracal(ji,jj,jk) = caco3r * MIN( zlim1, zlim2, zlim3 ) &
& * ztem1 / ( 0.1 + ztem1 ) &
- & * MAX( 1., trn(ji,jj,jk,jpphy) * 1.e6 / 2. ) &
+ & * MAX( 1., trb(ji,jj,jk,jpphy) * 1.e6 / 2. ) &
& * zetot1 * zetot2 &
& * ( 1. + EXP(-ztem2 * ztem2 / 25. ) ) &
@@ -188,5 +188,5 @@
!
!
- IF( lk_iomput .AND. jnt == nrdttrc ) THEN ! save output diagnostics
+ IF( lk_iomput .AND. knt == nrdttrc ) THEN ! save output diagnostics
IF( iom_use( "xfracal" ) ) CALL iom_put( "xfracal", xfracal(:,:,:) * tmask(:,:,:) ) ! euphotic layer deptht
IF( iom_use( "LNnut" ) ) CALL iom_put( "LNnut" , xlimphy(:,:,:) * tmask(:,:,:) ) ! Nutrient limitation term
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90 (revision 5602)
@@ -48,5 +48,5 @@
CONTAINS
- SUBROUTINE p4z_lys( kt )
+ SUBROUTINE p4z_lys( kt, knt )
!!---------------------------------------------------------------------
!! *** ROUTINE p4z_lys ***
@@ -59,10 +59,9 @@
!!---------------------------------------------------------------------
!
- INTEGER, INTENT(in) :: kt ! ocean time step
+ INTEGER, INTENT(in) :: kt, knt ! ocean time step
INTEGER :: ji, jj, jk, jn
REAL(wp) :: zalk, zdic, zph, zah2
REAL(wp) :: zdispot, zfact, zcalcon, zalka, zaldi
REAL(wp) :: zomegaca, zexcess, zexcess0
- REAL(wp) :: zrfact2
CHARACTER (len=25) :: charout
REAL(wp), POINTER, DIMENSION(:,:,:) :: zco3, zcaldiss
@@ -89,6 +88,6 @@
zfact = rhop(ji,jj,jk) / 1000. + rtrn
zph = hi(ji,jj,jk) * tmask(ji,jj,jk) / zfact + ( 1.-tmask(ji,jj,jk) ) * 1.e-9 ! [H+]
- zdic = trn(ji,jj,jk,jpdic) / zfact
- zalka = trn(ji,jj,jk,jptal) / zfact
+ zdic = trb(ji,jj,jk,jpdic) / zfact
+ zalka = trb(ji,jj,jk,jptal) / zfact
! CALCULATE [ALK]([CO3--], [HCO3-])
zalk = zalka - ( akw3(ji,jj,jk) / zph - zph + borat(ji,jj,jk) / ( 1. + zph / akb3(ji,jj,jk) ) )
@@ -130,5 +129,5 @@
! (ACCORDING TO THIS FORMULATION ALSO SOME PARTICULATE
! CACO3 GETS DISSOLVED EVEN IN THE CASE OF OVERSATURATION)
- zdispot = kdca * zexcess * trn(ji,jj,jk,jpcal)
+ zdispot = kdca * zexcess * trb(ji,jj,jk,jpcal)
# if defined key_degrad
zdispot = zdispot * facvol(ji,jj,jk)
@@ -136,6 +135,6 @@
! CHANGE OF [CO3--] , [ALK], PARTICULATE [CACO3],
! AND [SUM(CO2)] DUE TO CACO3 DISSOLUTION/PRECIPITATION
- zcaldiss(ji,jj,jk) = zdispot / rmtss ! calcite dissolution
- zco3(ji,jj,jk) = zco3(ji,jj,jk) + zcaldiss(ji,jj,jk) * rfact
+ zcaldiss(ji,jj,jk) = zdispot * rfact2 / rmtss ! calcite dissolution
+ zco3(ji,jj,jk) = zco3(ji,jj,jk) + zcaldiss(ji,jj,jk)
!
tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * zcaldiss(ji,jj,jk)
@@ -147,9 +146,9 @@
!
- IF( lk_iomput ) THEN
+ IF( lk_iomput .AND. knt == nrdttrc ) THEN
IF( iom_use( "PH" ) ) CALL iom_put( "PH" , -1. * LOG10( hi(:,:,:) ) * tmask(:,:,:) )
IF( iom_use( "CO3" ) ) CALL iom_put( "CO3" , zco3(:,:,:) * 1.e+3 * tmask(:,:,:) )
IF( iom_use( "CO3sat" ) ) CALL iom_put( "CO3sat", aksp(:,:,:) * 1.e+3 / calcon * tmask(:,:,:) )
- IF( iom_use( "DCAL" ) ) CALL iom_put( "DCAL" , zcaldiss(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) )
+ IF( iom_use( "DCAL" ) ) CALL iom_put( "DCAL" , zcaldiss(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) )
ELSE
trc3d(:,:,:,jp_pcs0_3d ) = -1. * LOG10( hi(:,:,:) ) * tmask(:,:,:)
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90 (revision 5602)
@@ -60,5 +60,5 @@
CONTAINS
- SUBROUTINE p4z_meso( kt, jnt )
+ SUBROUTINE p4z_meso( kt, knt )
!!---------------------------------------------------------------------
!! *** ROUTINE p4z_meso ***
@@ -68,5 +68,5 @@
!! ** Method : - ???
!!---------------------------------------------------------------------
- INTEGER, INTENT(in) :: kt, jnt ! ocean time step
+ INTEGER, INTENT(in) :: kt, knt ! ocean time step
INTEGER :: ji, jj, jk
REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz, zcompam
@@ -97,5 +97,5 @@
DO jj = 1, jpj
DO ji = 1, jpi
- zcompam = MAX( ( trn(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 )
+ zcompam = MAX( ( trb(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 )
# if defined key_degrad
zstep = xstep * facvol(ji,jj,jk)
@@ -107,5 +107,5 @@
! Respiration rates of both zooplankton
! -------------------------------------
- zrespz2 = resrat2 * zfact * trn(ji,jj,jk,jpmes) / ( xkmort + trn(ji,jj,jk,jpmes) ) &
+ zrespz2 = resrat2 * zfact * trb(ji,jj,jk,jpmes) / ( xkmort + trb(ji,jj,jk,jpmes) ) &
& + resrat2 * zfact * 3. * nitrfac(ji,jj,jk)
@@ -113,14 +113,14 @@
! no real reason except that it seems to be more stable and may mimic predation
! ---------------------------------------------------------------
- ztortz2 = mzrat2 * 1.e6 * zfact * trn(ji,jj,jk,jpmes)
+ ztortz2 = mzrat2 * 1.e6 * zfact * trb(ji,jj,jk,jpmes)
!
- zcompadi = MAX( ( trn(ji,jj,jk,jpdia) - xthresh2dia ), 0.e0 )
- zcompaz = MAX( ( trn(ji,jj,jk,jpzoo) - xthresh2zoo ), 0.e0 )
+ zcompadi = MAX( ( trb(ji,jj,jk,jpdia) - xthresh2dia ), 0.e0 )
+ zcompaz = MAX( ( trb(ji,jj,jk,jpzoo) - xthresh2zoo ), 0.e0 )
! Size effect of nanophytoplankton on grazing : the smaller it is, the less prone
! it is to predation by mesozooplankton
! -------------------------------------------------------------------------------
- zcompaph = MAX( ( trn(ji,jj,jk,jpphy) - xthresh2phy ), 0.e0 ) &
+ zcompaph = MAX( ( trb(ji,jj,jk,jpphy) - xthresh2phy ), 0.e0 ) &
& * MIN(1., MAX( 0., ( quotan(ji,jj,jk) - 0.2) / 0.3 ) )
- zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - xthresh2poc ), 0.e0 )
+ zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthresh2poc ), 0.e0 )
zfood = xprefc * zcompadi + xprefz * zcompaz + xprefp * zcompaph + xprefpoc * zcompapoc
@@ -128,5 +128,5 @@
zdenom = zfoodlim / ( xkgraz2 + zfoodlim )
zdenom2 = zdenom / ( zfood + rtrn )
- zgraze2 = grazrat2 * zstep * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpmes)
+ zgraze2 = grazrat2 * zstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpmes)
zgrazd = zgraze2 * xprefc * zcompadi * zdenom2
@@ -135,7 +135,7 @@
zgrazpoc = zgraze2 * xprefpoc * zcompapoc * zdenom2
- zgraznf = zgrazn * trn(ji,jj,jk,jpnfe) / ( trn(ji,jj,jk,jpphy) + rtrn)
- zgrazf = zgrazd * trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn)
- zgrazpof = zgrazpoc * trn(ji,jj,jk,jpsfe) / ( trn(ji,jj,jk,jppoc) + rtrn)
+ zgraznf = zgrazn * trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn)
+ zgrazf = zgrazd * trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn)
+ zgrazpof = zgrazpoc * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn)
! Mesozooplankton flux feeding on GOC
@@ -144,10 +144,10 @@
# if ! defined key_kriest
zgrazffeg = grazflux * zstep * wsbio4(ji,jj,jk) &
- & * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes)
- zgrazfffg = zgrazffeg * trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn)
+ & * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes)
+ zgrazfffg = zgrazffeg * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn)
# endif
zgrazffep = grazflux * zstep * wsbio3(ji,jj,jk) &
- & * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes)
- zgrazfffp = zgrazffep * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)
+ & * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpmes)
+ zgrazfffp = zgrazffep * trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn)
!
# if ! defined key_kriest
@@ -158,10 +158,10 @@
! diatoms based aggregates are more prone to fractionation
! since they are more porous (marine snow instead of fecal pellets)
- zratio = trn(ji,jj,jk,jpgsi) / ( trn(ji,jj,jk,jpgoc) + rtrn )
+ zratio = trb(ji,jj,jk,jpgsi) / ( trb(ji,jj,jk,jpgoc) + rtrn )
zratio2 = zratio * zratio
zfrac = zproport * grazflux * zstep * wsbio4(ji,jj,jk) &
- & * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes) &
+ & * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes) &
& * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) )
- zfracfe = zfrac * trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn)
+ zfracfe = zfrac * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn)
zgrazffep = zproport * zgrazffep
@@ -215,8 +215,8 @@
tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zgrazz
tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazn
- tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazn * trn(ji,jj,jk,jpnch) / ( trn(ji,jj,jk,jpphy) + rtrn )
- tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazd * trn(ji,jj,jk,jpdch) / ( trn(ji,jj,jk,jpdia) + rtrn )
- tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazd * trn(ji,jj,jk,jpdsi) / ( trn(ji,jj,jk,jpdia) + rtrn )
- tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazd * trn(ji,jj,jk,jpdsi) / ( trn(ji,jj,jk,jpdia) + rtrn )
+ tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazn * trb(ji,jj,jk,jpnch) / ( trb(ji,jj,jk,jpphy) + rtrn )
+ tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazd * trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn )
+ tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazd * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn )
+ tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazd * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn )
tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgraznf
tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazf
@@ -231,5 +231,5 @@
tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca
#if defined key_kriest
- znumpoc = trn(ji,jj,jk,jpnum) / ( trn(ji,jj,jk,jppoc) + rtrn )
+ znumpoc = trb(ji,jj,jk,jpnum) / ( trb(ji,jj,jk,jppoc) + rtrn )
tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortzgoc - zgrazpoc - zgrazffep + zgrapoc2
tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) - zgrazpoc * znumpoc + zgrapoc2 * xkr_dmeso &
@@ -248,5 +248,5 @@
END DO
!
- IF( lk_iomput .AND. jnt == nrdttrc ) THEN
+ IF( lk_iomput .AND. knt == nrdttrc ) THEN
CALL wrk_alloc( jpi, jpj, jpk, zw3d )
IF( iom_use( "GRAZ2" ) ) THEN
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90 (revision 5602)
@@ -59,5 +59,5 @@
CONTAINS
- SUBROUTINE p4z_micro( kt, jnt )
+ SUBROUTINE p4z_micro( kt, knt )
!!---------------------------------------------------------------------
!! *** ROUTINE p4z_micro ***
@@ -68,5 +68,5 @@
!!---------------------------------------------------------------------
INTEGER, INTENT(in) :: kt ! ocean time step
- INTEGER, INTENT(in) :: jnt
+ INTEGER, INTENT(in) :: knt
!
INTEGER :: ji, jj, jk
@@ -90,5 +90,5 @@
DO jj = 1, jpj
DO ji = 1, jpi
- zcompaz = MAX( ( trn(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 )
+ zcompaz = MAX( ( trb(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 )
zstep = xstep
# if defined key_degrad
@@ -99,5 +99,5 @@
! Respiration rates of both zooplankton
! -------------------------------------
- zrespz = resrat * zfact * trn(ji,jj,jk,jpzoo) / ( xkmort + trn(ji,jj,jk,jpzoo) ) &
+ zrespz = resrat * zfact * trb(ji,jj,jk,jpzoo) / ( xkmort + trb(ji,jj,jk,jpzoo) ) &
& + resrat * zfact * 3. * nitrfac(ji,jj,jk)
@@ -105,9 +105,9 @@
! no real reason except that it seems to be more stable and may mimic predation.
! ---------------------------------------------------------------
- ztortz = mzrat * 1.e6 * zfact * trn(ji,jj,jk,jpzoo)
-
- zcompadi = MIN( MAX( ( trn(ji,jj,jk,jpdia) - xthreshdia ), 0.e0 ), xsizedia )
- zcompaph = MAX( ( trn(ji,jj,jk,jpphy) - xthreshphy ), 0.e0 )
- zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - xthreshpoc ), 0.e0 )
+ ztortz = mzrat * 1.e6 * zfact * trb(ji,jj,jk,jpzoo)
+
+ zcompadi = MIN( MAX( ( trb(ji,jj,jk,jpdia) - xthreshdia ), 0.e0 ), xsizedia )
+ zcompaph = MAX( ( trb(ji,jj,jk,jpphy) - xthreshphy ), 0.e0 )
+ zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthreshpoc ), 0.e0 )
! Microzooplankton grazing
@@ -117,5 +117,5 @@
zdenom = zfoodlim / ( xkgraz + zfoodlim )
zdenom2 = zdenom / ( zfood + rtrn )
- zgraze = grazrat * zstep * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpzoo)
+ zgraze = grazrat * zstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpzoo)
zgrazp = zgraze * xpref2p * zcompaph * zdenom2
@@ -123,7 +123,7 @@
zgrazsd = zgraze * xpref2d * zcompadi * zdenom2
- zgrazpf = zgrazp * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)
- zgrazmf = zgrazm * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)
- zgrazsf = zgrazsd * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)
+ zgrazpf = zgrazp * trb(ji,jj,jk,jpnfe) / (trb(ji,jj,jk,jpphy) + rtrn)
+ zgrazmf = zgrazm * trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn)
+ zgrazsf = zgrazsd * trb(ji,jj,jk,jpdfe) / (trb(ji,jj,jk,jpdia) + rtrn)
!
zgraztot = zgrazp + zgrazm + zgrazsd
@@ -165,8 +165,8 @@
tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazp
tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazsd
- tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazp * trn(ji,jj,jk,jpnch)/(trn(ji,jj,jk,jpphy)+rtrn)
- tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazsd * trn(ji,jj,jk,jpdch)/(trn(ji,jj,jk,jpdia)+rtrn)
- tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazsd * trn(ji,jj,jk,jpdsi)/(trn(ji,jj,jk,jpdia)+rtrn)
- tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazsd * trn(ji,jj,jk,jpdsi)/(trn(ji,jj,jk,jpdia)+rtrn)
+ tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazp * trb(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn)
+ tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazsd * trb(ji,jj,jk,jpdch)/(trb(ji,jj,jk,jpdia)+rtrn)
+ tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazsd * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn)
+ tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazsd * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn)
tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgrazpf
tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazsf
@@ -184,5 +184,5 @@
#if defined key_kriest
tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zmortz * xkr_dmicro &
- - zgrazm * trn(ji,jj,jk,jpnum) / ( trn(ji,jj,jk,jppoc) + rtrn )
+ - zgrazm * trb(ji,jj,jk,jpnum) / ( trb(ji,jj,jk,jppoc) + rtrn )
#endif
END DO
@@ -190,5 +190,5 @@
END DO
!
- IF( lk_iomput .AND. jnt == nrdttrc ) THEN
+ IF( lk_iomput .AND. knt == nrdttrc ) THEN
CALL wrk_alloc( jpi, jpj, jpk, zw3d )
IF( iom_use( "GRAZ1" ) ) THEN
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90 (revision 5602)
@@ -39,5 +39,5 @@
!!----------------------------------------------------------------------
!! NEMO/TOP 3.3 , NEMO Consortium (2010)
- !! $Id: p4zmort.F90 3160 2011-11-20 14:27:18Z cetlod $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
@@ -85,5 +85,5 @@
DO jj = 1, jpj
DO ji = 1, jpi
- zcompaph = MAX( ( trn(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 )
+ zcompaph = MAX( ( trb(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 )
zstep = xstep
# if defined key_degrad
@@ -94,5 +94,5 @@
! due to turbulence is negligible. Mortality is also set
! to 0
- zsizerat = MIN(1., MAX( 0., (quotan(ji,jj,jk) - 0.2) / 0.3) ) * trn(ji,jj,jk,jpphy)
+ zsizerat = MIN(1., MAX( 0., (quotan(ji,jj,jk) - 0.2) / 0.3) ) * trb(ji,jj,jk,jpphy)
! Squared mortality of Phyto similar to a sedimentation term during
! blooms (Doney et al. 1996)
@@ -102,5 +102,5 @@
! increased when nutrients are limiting phytoplankton growth
! as observed for instance in case of iron limitation.
- ztortp = mprat * xstep * zcompaph / ( xkmort + trn(ji,jj,jk,jpphy) ) * zsizerat
+ ztortp = mprat * xstep * zcompaph / ( xkmort + trb(ji,jj,jk,jpphy) ) * zsizerat
zmortp = zrespp + ztortp
@@ -108,6 +108,6 @@
! Update the arrays TRA which contains the biological sources and sinks
- zfactfe = trn(ji,jj,jk,jpnfe)/(trn(ji,jj,jk,jpphy)+rtrn)
- zfactch = trn(ji,jj,jk,jpnch)/(trn(ji,jj,jk,jpphy)+rtrn)
+ zfactfe = trb(ji,jj,jk,jpnfe)/(trb(ji,jj,jk,jpphy)+rtrn)
+ zfactch = trb(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn)
tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zmortp
tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zmortp * zfactch
@@ -172,5 +172,5 @@
DO ji = 1, jpi
- zcompadi = MAX( ( trn(ji,jj,jk,jpdia) - 1e-9), 0. )
+ zcompadi = MAX( ( trb(ji,jj,jk,jpdia) - 1e-9), 0. )
! Aggregation term for diatoms is increased in case of nutrient
@@ -186,9 +186,9 @@
zlim2 = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk)
zlim1 = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 )
- zrespp2 = 1.e6 * zstep * ( wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * trn(ji,jj,jk,jpdia)
+ zrespp2 = 1.e6 * zstep * ( wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * trb(ji,jj,jk,jpdia)
! Phytoplankton mortality.
! ------------------------
- ztortp2 = mprat2 * zstep * trn(ji,jj,jk,jpdia) / ( xkmort + trn(ji,jj,jk,jpdia) ) * zcompadi
+ ztortp2 = mprat2 * zstep * trb(ji,jj,jk,jpdia) / ( xkmort + trb(ji,jj,jk,jpdia) ) * zcompadi
zmortp2 = zrespp2 + ztortp2
@@ -196,7 +196,7 @@
! Update the arrays tra which contains the biological sources and sinks
! ---------------------------------------------------------------------
- zfactch = trn(ji,jj,jk,jpdch) / ( trn(ji,jj,jk,jpdia) + rtrn )
- zfactfe = trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn )
- zfactsi = trn(ji,jj,jk,jpdsi) / ( trn(ji,jj,jk,jpdia) + rtrn )
+ zfactch = trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn )
+ zfactfe = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn )
+ zfactsi = trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn )
tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zmortp2
tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zmortp2 * zfactch
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90 (revision 5602)
@@ -35,4 +35,5 @@
REAL(wp) :: parlux !: Fraction of shortwave as PAR
REAL(wp) :: xparsw !: parlux/3
+ REAL(wp) :: xsi0r !: 1. /rn_si0
TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_par ! structure of input par
@@ -42,5 +43,7 @@
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: enano, ediat !: PAR for phyto, nano and diat
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: etot_ndcy !: PAR over 24h in case of diurnal cycle
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: emoy !: averaged PAR in the mixed layer
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ekb, ekg, ekr !: wavelength (Red-Green-Blue)
INTEGER :: nksrp ! levels below which the light cannot penetrate ( depth larger than 391 m)
@@ -57,5 +60,5 @@
CONTAINS
- SUBROUTINE p4z_opt( kt, jnt )
+ SUBROUTINE p4z_opt( kt, knt )
!!---------------------------------------------------------------------
!! *** ROUTINE p4z_opt ***
@@ -67,12 +70,12 @@
!!---------------------------------------------------------------------
!
- INTEGER, INTENT(in) :: kt, jnt ! ocean time step
+ INTEGER, INTENT(in) :: kt, knt ! ocean time step
!
INTEGER :: ji, jj, jk
INTEGER :: irgb
- REAL(wp) :: zchl, zxsi0r
+ REAL(wp) :: zchl
REAL(wp) :: zc0 , zc1 , zc2, zc3, z1_dep
- REAL(wp), POINTER, DIMENSION(:,: ) :: zdepmoy, zetmp, zetmp1, zetmp2
- REAL(wp), POINTER, DIMENSION(:,:,:) :: zekg, zekr, zekb, ze0, ze1, ze2, ze3
+ REAL(wp), POINTER, DIMENSION(:,: ) :: zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4, zqsr100
+ REAL(wp), POINTER, DIMENSION(:,:,:) :: zpar, ze0, ze1, ze2, ze3
!!---------------------------------------------------------------------
!
@@ -80,15 +83,14 @@
!
! Allocate temporary workspace
- CALL wrk_alloc( jpi, jpj, zdepmoy, zetmp, zetmp1, zetmp2 )
- CALL wrk_alloc( jpi, jpj, jpk, zekg, zekr, zekb, ze0, ze1, ze2, ze3 )
-
- IF( jnt == 1 .AND. ln_varpar ) CALL p4z_optsbc( kt )
+ CALL wrk_alloc( jpi, jpj, zqsr100, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 )
+ CALL wrk_alloc( jpi, jpj, jpk, zpar, ze0, ze1, ze2, ze3 )
+
+ IF( knt == 1 .AND. ln_varpar ) CALL p4z_opt_sbc( kt )
! Initialisation of variables used to compute PAR
! -----------------------------------------------
- ze1(:,:,jpk) = 0._wp
- ze2(:,:,jpk) = 0._wp
- ze3(:,:,jpk) = 0._wp
-
+ ze1(:,:,:) = 0._wp
+ ze2(:,:,:) = 0._wp
+ ze3(:,:,:) = 0._wp
! !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue)
DO jk = 1, jpkm1 ! --------------------------------------------------------
@@ -97,103 +99,59 @@
!CDIR NOVERRCHK
DO ji = 1, jpi
- zchl = ( trn(ji,jj,jk,jpnch) + trn(ji,jj,jk,jpdch) + rtrn ) * 1.e6
+ zchl = ( trb(ji,jj,jk,jpnch) + trb(ji,jj,jk,jpdch) + rtrn ) * 1.e6
zchl = MIN( 10. , MAX( 0.05, zchl ) )
irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn )
!
- zekb(ji,jj,jk) = xkrgb(1,irgb) * fse3t(ji,jj,jk)
- zekg(ji,jj,jk) = xkrgb(2,irgb) * fse3t(ji,jj,jk)
- zekr(ji,jj,jk) = xkrgb(3,irgb) * fse3t(ji,jj,jk)
+ ekb(ji,jj,jk) = xkrgb(1,irgb) * fse3t(ji,jj,jk)
+ ekg(ji,jj,jk) = xkrgb(2,irgb) * fse3t(ji,jj,jk)
+ ekr(ji,jj,jk) = xkrgb(3,irgb) * fse3t(ji,jj,jk)
END DO
END DO
END DO
-
-
! !* Photosynthetically Available Radiation (PAR)
! ! --------------------------------------
-
- IF( ln_varpar ) THEN
- ze1(:,:,1) = par_varsw(:,:) * qsr(:,:) * EXP( -0.5 * zekb(:,:,1) )
- ze2(:,:,1) = par_varsw(:,:) * qsr(:,:) * EXP( -0.5 * zekg(:,:,1) )
- ze3(:,:,1) = par_varsw(:,:) * qsr(:,:) * EXP( -0.5 * zekr(:,:,1) )
+ IF( l_trcdm2dc ) THEN ! diurnal cycle
+ ! 1% of qsr to compute euphotic layer
+ zqsr100(:,:) = 0.01 * qsr_mean(:,:) ! daily mean qsr
+ !
+ CALL p4z_opt_par( kt, qsr_mean, ze1, ze2, ze3 )
+ !
+ DO jk = 1, nksrp
+ etot_ndcy(:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk)
+ enano (:,:,jk) = 2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk)
+ ediat (:,:,jk) = 1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk)
+ END DO
+ !
+ CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3 )
+ !
+ DO jk = 1, nksrp
+ etot(:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk)
+ END DO
+ !
ELSE
- ze1(:,:,1) = xparsw * qsr(:,:) * EXP( -0.5 * zekb(:,:,1) )
- ze2(:,:,1) = xparsw * qsr(:,:) * EXP( -0.5 * zekg(:,:,1) )
- ze3(:,:,1) = xparsw * qsr(:,:) * EXP( -0.5 * zekr(:,:,1) )
- ENDIF
-
-!CDIR NOVERRCHK
- DO jj = 1, jpj
-!CDIR NOVERRCHK
- DO ji = 1, jpi
- zc1 = ze1(ji,jj,1)
- zc2 = ze2(ji,jj,1)
- zc3 = ze3(ji,jj,1)
- etot (ji,jj,1) = ( zc1 + zc2 + zc3 )
- enano(ji,jj,1) = ( 2.1 * zc1 + 0.42 * zc2 + 0.4 * zc3 )
- ediat(ji,jj,1) = ( 1.6 * zc1 + 0.69 * zc2 + 0.7 * zc3 )
- END DO
- END DO
-
-
- DO jk = 2, nksrp
-!CDIR NOVERRCHK
- DO jj = 1, jpj
-!CDIR NOVERRCHK
- DO ji = 1, jpi
- zc1 = ze1(ji,jj,jk-1) * EXP( -0.5 * ( zekb(ji,jj,jk-1) + zekb(ji,jj,jk) ) )
- zc2 = ze2(ji,jj,jk-1) * EXP( -0.5 * ( zekg(ji,jj,jk-1) + zekg(ji,jj,jk) ) )
- zc3 = ze3(ji,jj,jk-1) * EXP( -0.5 * ( zekr(ji,jj,jk-1) + zekr(ji,jj,jk) ) )
- ze1 (ji,jj,jk) = zc1
- ze2 (ji,jj,jk) = zc2
- ze3 (ji,jj,jk) = zc3
- etot (ji,jj,jk) = ( zc1 + zc2 + zc3 )
- enano(ji,jj,jk) = ( 2.1 * zc1 + 0.42 * zc2 + 0.4 * zc3 )
- ediat(ji,jj,jk) = ( 1.6 * zc1 + 0.69 * zc2 + 0.7 * zc3 )
- END DO
- END DO
- END DO
+ ! 1% of qsr to compute euphotic layer
+ zqsr100(:,:) = 0.01 * qsr(:,:)
+ !
+ CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3 )
+ !
+ DO jk = 1, nksrp
+ etot (:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk)
+ enano(:,:,jk) = 2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk)
+ ediat(:,:,jk) = 1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk)
+ END DO
+ etot_ndcy(:,:,:) = etot(:,:,:)
+ ENDIF
+
IF( ln_qsr_bio ) THEN !* heat flux accros w-level (used in the dynamics)
! ! ------------------------
- zxsi0r = 1.e0 / rn_si0
- !
- ze0(:,:,1) = rn_abs * qsr(:,:)
- ! ! surface value : separation in R-G-B + near surface
- IF( ln_varpar ) THEN
- ze0(:,:,1) = ( 1. - 3. * par_varsw(:,:) ) * qsr(:,:)
- ze1(:,:,1) = par_varsw(:,:) * qsr(:,:)
- ze2(:,:,1) = par_varsw(:,:) * qsr(:,:)
- ze3(:,:,1) = par_varsw(:,:) * qsr(:,:)
- ELSE
- ze0(:,:,1) = ( 1. - 3. * xparsw ) * qsr(:,:)
- ze1(:,:,1) = xparsw * qsr(:,:)
- ze2(:,:,1) = xparsw * qsr(:,:)
- ze3(:,:,1) = xparsw * qsr(:,:)
- ENDIF
+ CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3, pe0=ze0 )
+ !
etot3(:,:,1) = qsr(:,:) * tmask(:,:,1)
- !
- !
DO jk = 2, nksrp + 1
-!CDIR NOVERRCHK
- DO jj = 1, jpj
-!CDIR NOVERRCHK
- DO ji = 1, jpi
- zc0 = ze0(ji,jj,jk-1) * EXP( -fse3t(ji,jj,jk-1) * zxsi0r )
- zc1 = ze1(ji,jj,jk-1) * EXP( -zekb(ji,jj,jk-1 ) )
- zc2 = ze2(ji,jj,jk-1) * EXP( -zekg(ji,jj,jk-1 ) )
- zc3 = ze3(ji,jj,jk-1) * EXP( -zekr(ji,jj,jk-1 ) )
- ze0(ji,jj,jk) = zc0
- ze1(ji,jj,jk) = zc1
- ze2(ji,jj,jk) = zc2
- ze3(ji,jj,jk) = zc3
- etot3(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * tmask(ji,jj,jk)
- END DO
- !
- END DO
- !
- END DO
- !
- ENDIF
-
+ etot3(:,:,jk) = ( ze0(:,:,jk) + ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) ) * tmask(:,:,jk)
+ END DO
+ ! ! ------------------------
+ ENDIF
! !* Euphotic depth and level
neln(:,:) = 1 ! ------------------------
@@ -203,7 +161,7 @@
DO jj = 1, jpj
DO ji = 1, jpi
- IF( etot(ji,jj,jk) * tmask(ji,jj,jk) >= 0.0043 * qsr(ji,jj) ) THEN
+ IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.43 * 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_mxl_trc_zint
+ ! ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint
heup(ji,jj) = fsdepw(ji,jj,jk+1) ! Euphotic layer depth
ENDIF
@@ -211,12 +169,12 @@
END DO
END DO
-
+ !
heup(:,:) = MIN( 300., heup(:,:) )
-
! !* mean light over the mixed layer
zdepmoy(:,:) = 0.e0 ! -------------------------------
- zetmp (:,:) = 0.e0
zetmp1 (:,:) = 0.e0
zetmp2 (:,:) = 0.e0
+ zetmp3 (:,:) = 0.e0
+ zetmp4 (:,:) = 0.e0
DO jk = 1, nksrp
@@ -226,7 +184,8 @@
DO ji = 1, jpi
IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
- zetmp (ji,jj) = zetmp (ji,jj) + etot (ji,jj,jk) * fse3t(ji,jj,jk)
- zetmp1 (ji,jj) = zetmp1 (ji,jj) + enano(ji,jj,jk) * fse3t(ji,jj,jk)
- zetmp2 (ji,jj) = zetmp2 (ji,jj) + ediat(ji,jj,jk) * fse3t(ji,jj,jk)
+ zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot (ji,jj,jk) * fse3t(ji,jj,jk) ! remineralisation
+ zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * fse3t(ji,jj,jk) ! production
+ zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano (ji,jj,jk) * fse3t(ji,jj,jk) ! production
+ zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat (ji,jj,jk) * fse3t(ji,jj,jk) ! production
zdepmoy(ji,jj) = zdepmoy(ji,jj) + fse3t(ji,jj,jk)
ENDIF
@@ -235,5 +194,6 @@
END DO
!
- emoy(:,:,:) = etot(:,:,:)
+ emoy(:,:,:) = etot(:,:,:) ! remineralisation
+ zpar(:,:,:) = etot_ndcy(:,:,:) ! diagnostic : PAR with no diurnal cycle
!
DO jk = 1, nksrp
@@ -244,26 +204,28 @@
IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn )
- emoy (ji,jj,jk) = zetmp (ji,jj) * z1_dep
- enano(ji,jj,jk) = zetmp1(ji,jj) * z1_dep
- ediat(ji,jj,jk) = zetmp2(ji,jj) * z1_dep
+ emoy (ji,jj,jk) = zetmp1(ji,jj) * z1_dep
+ zpar (ji,jj,jk) = zetmp2(ji,jj) * z1_dep
+ enano(ji,jj,jk) = zetmp3(ji,jj) * z1_dep
+ ediat(ji,jj,jk) = zetmp4(ji,jj) * z1_dep
ENDIF
END DO
END DO
END DO
-
+ !
IF( lk_iomput ) THEN
- IF( jnt == nrdttrc ) THEN
- IF( iom_use( "Heup" ) ) CALL iom_put( "Heup", heup(:,: ) * tmask(:,:,1) ) ! euphotic layer deptht
- IF( iom_use( "PAR" ) ) CALL iom_put( "PAR" , emoy(:,:,:) * tmask(:,:,:) ) ! Photosynthetically Available Radiation
+ IF( knt == nrdttrc ) THEN
+ IF( iom_use( "Heup" ) ) CALL iom_put( "Heup" , heup(:,: ) * tmask(:,:,1) ) ! euphotic layer deptht
+ IF( iom_use( "PARDM" ) ) CALL iom_put( "PARDM", zpar(:,:,:) * tmask(:,:,:) ) ! Photosynthetically Available Radiation
+ IF( iom_use( "PAR" ) ) CALL iom_put( "PAR" , emoy(:,:,:) * tmask(:,:,:) ) ! Photosynthetically Available Radiation
ENDIF
ELSE
IF( ln_diatrc ) THEN ! save output diagnostics
- trc2d(:,:, jp_pcs0_2d + 10) = heup(:,: ) * tmask(:,:,1)
+ trc2d(:,:, jp_pcs0_2d + 10) = heup(:,: ) * tmask(:,:,1)
trc3d(:,:,:,jp_pcs0_3d + 3) = etot(:,:,:) * tmask(:,:,:)
ENDIF
ENDIF
!
- CALL wrk_dealloc( jpi, jpj, zdepmoy, zetmp, zetmp1, zetmp2 )
- CALL wrk_dealloc( jpi, jpj, jpk, zekg, zekr, zekb, ze0, ze1, ze2, ze3 )
+ CALL wrk_dealloc( jpi, jpj, zqsr100, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 )
+ CALL wrk_dealloc( jpi, jpj, jpk, zpar, ze0, ze1, ze2, ze3 )
!
IF( nn_timing == 1 ) CALL timing_stop('p4z_opt')
@@ -271,7 +233,75 @@
END SUBROUTINE p4z_opt
- SUBROUTINE p4z_optsbc( kt )
- !!----------------------------------------------------------------------
- !! *** routine p4z_optsbc ***
+ SUBROUTINE p4z_opt_par( kt, pqsr, pe1, pe2, pe3, pe0 )
+ !!----------------------------------------------------------------------
+ !! *** routine p4z_opt_par ***
+ !!
+ !! ** purpose : compute PAR of each wavelength (Red-Green-Blue)
+ !! for a given shortwave radiation
+ !!
+ !!----------------------------------------------------------------------
+ !! * arguments
+ INTEGER, INTENT(in) :: kt ! ocean time-step
+ 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
+ !! * local variables
+ INTEGER :: ji, jj, jk ! dummy loop indices
+ REAL(wp), DIMENSION(jpi,jpj) :: zqsr ! shortwave
+ !!----------------------------------------------------------------------
+
+ ! Real shortwave
+ IF( ln_varpar ) THEN ; zqsr(:,:) = par_varsw(:,:) * pqsr(:,:)
+ ELSE ; zqsr(:,:) = xparsw * pqsr(:,:)
+ ENDIF
+ !
+ IF( PRESENT( pe0 ) ) THEN ! W-level
+ !
+ pe0(:,:,1) = pqsr(:,:) - 3. * zqsr(:,:) ! ( 1 - 3 * alpha ) * q
+ pe1(:,:,1) = zqsr(:,:)
+ pe2(:,:,1) = zqsr(:,:)
+ pe3(:,:,1) = zqsr(:,:)
+ !
+ DO jk = 2, nksrp + 1
+!CDIR NOVERRCHK
+ DO jj = 1, jpj
+!CDIR NOVERRCHK
+ DO ji = 1, jpi
+ pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -fse3t(ji,jj,jk-1) * 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 ) )
+ pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -ekr(ji,jj,jk-1 ) )
+ END DO
+ !
+ END DO
+ !
+ END DO
+ !
+ ELSE ! T- level
+ !
+ pe1(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekb(:,:,1) )
+ pe2(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekg(:,:,1) )
+ pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) )
+ !
+ DO jk = 2, nksrp
+!CDIR NOVERRCHK
+ DO jj = 1, jpj
+!CDIR NOVERRCHK
+ DO ji = 1, jpi
+ 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) ) )
+ END DO
+ END DO
+ END DO
+ !
+ ENDIF
+ !
+ END SUBROUTINE p4z_opt_par
+
+
+ SUBROUTINE p4z_opt_sbc( kt )
+ !!----------------------------------------------------------------------
+ !! *** routine p4z_opt_sbc ***
!!
!! ** purpose : read and interpolate the variable PAR fraction
@@ -284,5 +314,5 @@
!!----------------------------------------------------------------------
!! * arguments
- INTEGER, INTENT( in ) :: kt ! ocean time step
+ INTEGER , INTENT(in) :: kt ! ocean time step
!! * local declarations
@@ -297,5 +327,5 @@
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
+ par_varsw(:,:) = ( sf_par(1)%fnow(:,:,1) ) / 3.0
ENDIF
ENDIF
@@ -303,5 +333,5 @@
IF( nn_timing == 1 ) CALL timing_stop('p4z_optsbc')
!
- END SUBROUTINE p4z_optsbc
+ END SUBROUTINE p4z_opt_sbc
SUBROUTINE p4z_opt_init
@@ -347,4 +377,5 @@
!
xparsw = parlux / 3.0
+ xsi0r = 1.e0 / rn_si0
!
! Variable PAR at the surface of the ocean
@@ -372,8 +403,12 @@
IF(lwp) WRITE(numout,*) ' level of light extinction = ', nksrp, ' ref depth = ', gdepw_1d(nksrp+1), ' m'
!
- etot (:,:,:) = 0._wp
- enano(:,:,:) = 0._wp
- ediat(:,:,:) = 0._wp
- IF( ln_qsr_bio ) etot3(:,:,:) = 0._wp
+ ekr (:,:,:) = 0._wp
+ ekb (:,:,:) = 0._wp
+ ekg (:,:,:) = 0._wp
+ etot (:,:,:) = 0._wp
+ etot_ndcy(:,:,:) = 0._wp
+ enano (:,:,:) = 0._wp
+ ediat (:,:,:) = 0._wp
+ IF( ln_qsr_bio ) etot3 (:,:,:) = 0._wp
!
IF( nn_timing == 1 ) CALL timing_stop('p4z_opt_init')
@@ -386,5 +421,7 @@
!! *** ROUTINE p4z_opt_alloc ***
!!----------------------------------------------------------------------
- ALLOCATE( enano(jpi,jpj,jpk), ediat(jpi,jpj,jpk), emoy (jpi,jpj,jpk), STAT=p4z_opt_alloc )
+ ALLOCATE( ekb(jpi,jpj,jpk) , ekr(jpi,jpj,jpk), ekg(jpi,jpj,jpk), &
+ & enano(jpi,jpj,jpk) , ediat(jpi,jpj,jpk), &
+ & etot_ndcy(jpi,jpj,jpk), emoy (jpi,jpj,jpk), STAT=p4z_opt_alloc )
!
IF( p4z_opt_alloc /= 0 ) CALL ctl_warn('p4z_opt_alloc : failed to allocate arrays.')
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90 (revision 5602)
@@ -64,5 +64,5 @@
CONTAINS
- SUBROUTINE p4z_prod( kt , jnt )
+ SUBROUTINE p4z_prod( kt , knt )
!!---------------------------------------------------------------------
!! *** ROUTINE p4z_prod ***
@@ -74,5 +74,5 @@
!!---------------------------------------------------------------------
!
- INTEGER, INTENT(in) :: kt, jnt
+ INTEGER, INTENT(in) :: kt, knt
!
INTEGER :: ji, jj, jk
@@ -129,19 +129,17 @@
END DO
- IF( ln_newprod ) THEN
- ! Impact of the day duration on phytoplankton growth
- DO jk = 1, jpkm1
- DO jj = 1 ,jpj
- DO ji = 1, jpi
- IF( etot(ji,jj,jk) > 1.E-3 ) THEN
- zval = MAX( 1., zstrn(ji,jj) )
- zval = 1.5 * zval / ( 12. + zval )
- zprbio(ji,jj,jk) = prmax(ji,jj,jk) * zval
- zprdia(ji,jj,jk) = zprbio(ji,jj,jk)
- ENDIF
- END DO
- END DO
- END DO
- ENDIF
+ ! Impact of the day duration on phytoplankton growth
+ DO jk = 1, jpkm1
+ DO jj = 1 ,jpj
+ DO ji = 1, jpi
+ IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+ zval = MAX( 1., zstrn(ji,jj) )
+ zval = 1.5 * zval / ( 12. + zval )
+ zprbio(ji,jj,jk) = prmax(ji,jj,jk) * zval
+ zprdia(ji,jj,jk) = zprbio(ji,jj,jk)
+ ENDIF
+ END DO
+ END DO
+ END DO
! Maximum light intensity
@@ -157,17 +155,17 @@
DO ji = 1, jpi
! Computation of the P-I slope for nanos and diatoms
- IF( etot(ji,jj,jk) > 1.E-3 ) THEN
+ IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
ztn = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. )
zadap = xadap * ztn / ( 2.+ ztn )
- zconctemp = MAX( 0.e0 , trn(ji,jj,jk,jpdia) - xsizedia )
- zconctemp2 = trn(ji,jj,jk,jpdia) - zconctemp
+ zconctemp = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia )
+ zconctemp2 = trb(ji,jj,jk,jpdia) - zconctemp
znanotot = enano(ji,jj,jk) * zstrn(ji,jj)
zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj)
!
zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap * EXP( -znanotot ) ) &
- & * trn(ji,jj,jk,jpnch) /( trn(ji,jj,jk,jpphy) * 12. + rtrn)
+ & * trb(ji,jj,jk,jpnch) /( trb(ji,jj,jk,jpphy) * 12. + rtrn)
!
- zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( trn(ji,jj,jk,jpdia) + rtrn ) &
- & * trn(ji,jj,jk,jpdch) /( trn(ji,jj,jk,jpdia) * 12. + rtrn)
+ zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( trb(ji,jj,jk,jpdia) + rtrn ) &
+ & * trb(ji,jj,jk,jpdch) /( trb(ji,jj,jk,jpdia) * 12. + rtrn)
! Computation of production function for Carbon
@@ -196,30 +194,32 @@
! Computation of the P-I slope for nanos and diatoms
- IF( etot(ji,jj,jk) > 1.E-3 ) THEN
+ IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
ztn = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. )
zadap = ztn / ( 2.+ ztn )
- zconctemp = MAX( 0.e0 , trn(ji,jj,jk,jpdia) - xsizedia )
- zconctemp2 = trn(ji,jj,jk,jpdia) - zconctemp
+ zconctemp = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia )
+ zconctemp2 = trb(ji,jj,jk,jpdia) - zconctemp
+ znanotot = enano(ji,jj,jk) * zstrn(ji,jj)
+ zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj)
!
- zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap * EXP( -0.21 * enano(ji,jj,jk) ) )
- zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( trn(ji,jj,jk,jpdia) + rtrn )
-
- zpislopen = zpislopead(ji,jj,jk) * trn(ji,jj,jk,jpnch) &
- & / ( trn(ji,jj,jk,jpphy) * 12. + rtrn ) &
+ zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap * EXP( -znanotot ) )
+ zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( trb(ji,jj,jk,jpdia) + rtrn )
+
+ zpislopen = zpislopead(ji,jj,jk) * trb(ji,jj,jk,jpnch) &
+ & / ( trb(ji,jj,jk,jpphy) * 12. + rtrn ) &
& / ( prmax(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn )
- zpislope2n = zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch) &
- & / ( trn(ji,jj,jk,jpdia) * 12. + rtrn ) &
+ zpislope2n = zpislopead2(ji,jj,jk) * trb(ji,jj,jk,jpdch) &
+ & / ( trb(ji,jj,jk,jpdia) * 12. + rtrn ) &
& / ( prmax(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn )
! Computation of production function for Carbon
! ---------------------------------------------
- zprbio(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) )
- zprdia(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) ) )
+ zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * znanotot ) )
+ zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpislope2n * zdiattot ) )
! Computation of production function for Chlorophyll
!--------------------------------------------------
- zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) * zstrn(ji,jj) ) )
- zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) * zstrn(ji,jj) ) )
+ zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) )
+ zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) ) )
ENDIF
END DO
@@ -252,5 +252,5 @@
DO ji = 1, jpi
- IF( etot(ji,jj,jk) > 1.E-3 ) THEN
+ IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
! Si/C of diatoms
! ------------------------
@@ -258,8 +258,8 @@
! Si/C is arbitrariliy increased for very high Si concentrations
! to mimic the very high ratios observed in the Southern Ocean (silpot2)
- zlim = trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi1 )
+ zlim = trb(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi1 )
zsilim = MIN( zprdia(ji,jj,jk) / ( prmax(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) )
zsilfac = 4.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) ) ) + 1.e0
- zsiborn = trn(ji,jj,jk,jpsil) * trn(ji,jj,jk,jpsil) * trn(ji,jj,jk,jpsil)
+ zsiborn = trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil)
IF (gphit(ji,jj) < -30 ) THEN
zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 )
@@ -302,10 +302,10 @@
!CDIR NOVERRCHK
DO ji = 1, jpi
- IF( etot(ji,jj,jk) > 1.E-3 ) THEN
+ IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
! production terms for nanophyto.
- zprorca(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * trn(ji,jj,jk,jpphy) * rfact2
+ zprorca(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * trb(ji,jj,jk,jpphy) * rfact2
zpronew(ji,jj,jk) = zprorca(ji,jj,jk) * xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn )
!
- zratio = trn(ji,jj,jk,jpnfe) / ( trn(ji,jj,jk,jpphy) + rtrn )
+ zratio = trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn )
zratio = zratio / fecnm
zmax = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) )
@@ -313,10 +313,10 @@
& * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) ) &
& * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concnfe(ji,jj,jk) ) &
- & * zmax * trn(ji,jj,jk,jpphy) * rfact2
+ & * zmax * trb(ji,jj,jk,jpphy) * rfact2
! production terms for diatomees
- zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trn(ji,jj,jk,jpdia) * rfact2
+ zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trb(ji,jj,jk,jpdia) * rfact2
zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn )
!
- zratio = trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn )
+ zratio = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn )
zratio = zratio / fecdm
zmax = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) )
@@ -324,5 +324,5 @@
& * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) ) &
& * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concdfe(ji,jj,jk) ) &
- & * zmax * trn(ji,jj,jk,jpdia) * rfact2
+ & * zmax * trb(ji,jj,jk,jpdia) * rfact2
ENDIF
END DO
@@ -341,5 +341,5 @@
zprdch(ji,jj,jk) = zprdch(ji,jj,jk) * zmixdiat(ji,jj)
ENDIF
- IF( etot(ji,jj,jk) > 1.E-3 ) THEN
+ IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
! production terms for nanophyto. ( chlorophyll )
znanotot = enano(ji,jj,jk) * zstrn(ji,jj)
@@ -365,17 +365,17 @@
!CDIR NOVERRCHK
DO ji = 1, jpi
- IF( etot(ji,jj,jk) > 1.E-3 ) THEN
+ IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
! production terms for nanophyto. ( chlorophyll )
- znanotot = enano(ji,jj,jk) * zstrn(ji,jj)
- zprod = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * trn(ji,jj,jk,jpphy) * xlimphy(ji,jj,jk)
+ znanotot = enano(ji,jj,jk)
+ zprod = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * trb(ji,jj,jk,jpphy) * xlimphy(ji,jj,jk)
zprochln(ji,jj,jk) = chlcmin * 12. * zprorca (ji,jj,jk)
zprochln(ji,jj,jk) = zprochln(ji,jj,jk) + (chlcnm-chlcmin) * 144. * zprod &
- & / ( zpislopead(ji,jj,jk) * trn(ji,jj,jk,jpnch) * znanotot +rtrn )
+ & / ( zpislopead(ji,jj,jk) * trb(ji,jj,jk,jpnch) * znanotot +rtrn )
! production terms for diatomees ( chlorophyll )
- zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj)
- zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * trn(ji,jj,jk,jpdia) * xlimdia(ji,jj,jk)
+ zdiattot = ediat(ji,jj,jk)
+ zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * trb(ji,jj,jk,jpdia) * xlimdia(ji,jj,jk)
zprochld(ji,jj,jk) = chlcmin * 12. * zprorcad(ji,jj,jk)
zprochld(ji,jj,jk) = zprochld(ji,jj,jk) + (chlcdm-chlcmin) * 144. * zprod &
- & / ( zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch) * zdiattot +rtrn )
+ & / ( zpislopead2(ji,jj,jk) * trb(ji,jj,jk,jpdch) * zdiattot +rtrn )
ENDIF
END DO
@@ -414,9 +414,9 @@
! Total primary production per year
- IF( iom_use( "tintpp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. jnt == nrdttrc ) ) &
+ IF( iom_use( "tintpp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc ) ) &
& tpp = glob_sum( ( zprorca(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) )
IF( lk_iomput ) THEN
- IF( jnt == nrdttrc ) THEN
+ IF( knt == nrdttrc ) THEN
CALL wrk_alloc( jpi, jpj, zw2d )
CALL wrk_alloc( jpi, jpj, jpk, zw3d )
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90 (revision 5602)
@@ -59,5 +59,5 @@
CONTAINS
- SUBROUTINE p4z_rem( kt, jnt )
+ SUBROUTINE p4z_rem( kt, knt )
!!---------------------------------------------------------------------
!! *** ROUTINE p4z_rem ***
@@ -68,5 +68,5 @@
!!---------------------------------------------------------------------
!
- INTEGER, INTENT(in) :: kt, jnt ! ocean time step
+ INTEGER, INTENT(in) :: kt, knt ! ocean time step
!
INTEGER :: ji, jj, jk
@@ -104,5 +104,5 @@
zdep = MAX( hmld(ji,jj), heup(ji,jj) )
IF( fsdept(ji,jj,jk) < zdep ) THEN
- zdepbac(ji,jj,jk) = MIN( 0.7 * ( trn(ji,jj,jk,jpzoo) + 2.* trn(ji,jj,jk,jpmes) ), 4.e-6 )
+ zdepbac(ji,jj,jk) = MIN( 0.7 * ( trb(ji,jj,jk,jpzoo) + 2.* trb(ji,jj,jk,jpmes) ), 4.e-6 )
ztempbac(ji,jj) = zdepbac(ji,jj,jk)
ELSE
@@ -119,6 +119,6 @@
DO ji = 1, jpi
! denitrification factor computed from O2 levels
- nitrfac(ji,jj,jk) = MAX( 0.e0, 0.4 * ( 6.e-6 - trn(ji,jj,jk,jpoxy) ) &
- & / ( oxymin + trn(ji,jj,jk,jpoxy) ) )
+ nitrfac(ji,jj,jk) = MAX( 0.e0, 0.4 * ( 6.e-6 - trb(ji,jj,jk,jpoxy) ) &
+ & / ( oxymin + trb(ji,jj,jk,jpoxy) ) )
nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) )
END DO
@@ -140,10 +140,10 @@
! Ammonification in oxic waters with oxygen consumption
! -----------------------------------------------------
- zolimit = zremik * ( 1.- nitrfac(ji,jj,jk) ) * trn(ji,jj,jk,jpdoc)
- zolimi(ji,jj,jk) = MIN( ( trn(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimit )
+ zolimit = zremik * ( 1.- nitrfac(ji,jj,jk) ) * trb(ji,jj,jk,jpdoc)
+ zolimi(ji,jj,jk) = MIN( ( trb(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimit )
! Ammonification in suboxic waters with denitrification
! -------------------------------------------------------
- denitr(ji,jj,jk) = MIN( ( trn(ji,jj,jk,jpno3) - rtrn ) / rdenit, &
- & zremik * nitrfac(ji,jj,jk) * trn(ji,jj,jk,jpdoc) )
+ denitr(ji,jj,jk) = MIN( ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenit, &
+ & zremik * nitrfac(ji,jj,jk) * trb(ji,jj,jk,jpdoc) )
!
zolimi (ji,jj,jk) = MAX( 0.e0, zolimi (ji,jj,jk) )
@@ -165,6 +165,6 @@
! below 2 umol/L. Inhibited at strong light
! ----------------------------------------------------------
- zonitr =nitrif * zstep * trn(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) ) * ( 1.- nitrfac(ji,jj,jk) )
- denitnh4(ji,jj,jk) = nitrif * zstep * trn(ji,jj,jk,jpnh4) * nitrfac(ji,jj,jk)
+ zonitr =nitrif * zstep * trb(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) ) * ( 1.- nitrfac(ji,jj,jk) )
+ denitnh4(ji,jj,jk) = nitrif * zstep * trb(ji,jj,jk,jpnh4) * nitrfac(ji,jj,jk)
! Update of the tracers trends
! ----------------------------
@@ -192,5 +192,5 @@
! ----------------------------------------------------------
zbactfer = 10.e-6 * rfact2 * prmax(ji,jj,jk) * xlimbacl(ji,jj,jk) &
- & * trn(ji,jj,jk,jpfer) / ( 2.5E-10 + trn(ji,jj,jk,jpfer) ) &
+ & * trb(ji,jj,jk,jpfer) / ( 2.5E-10 + trb(ji,jj,jk,jpfer) ) &
& * zdepprod(ji,jj,jk) * zdepbac(ji,jj,jk)
#if defined key_kriest
@@ -228,11 +228,11 @@
! means a disaggregation constant about 0.5 the value in oxic zones
! -----------------------------------------------------------------
- zorem = zremip * trn(ji,jj,jk,jppoc)
- zofer = zremip * trn(ji,jj,jk,jpsfe)
+ zorem = zremip * trb(ji,jj,jk,jppoc)
+ zofer = zremip * trb(ji,jj,jk,jpsfe)
#if ! defined key_kriest
- zorem2 = zremip * trn(ji,jj,jk,jpgoc)
- zofer2 = zremip * trn(ji,jj,jk,jpbfe)
+ zorem2 = zremip * trb(ji,jj,jk,jpgoc)
+ zofer2 = zremip * trb(ji,jj,jk,jpbfe)
#else
- zorem2 = zremip * trn(ji,jj,jk,jpnum)
+ zorem2 = zremip * trb(ji,jj,jk,jpnum)
#endif
@@ -272,5 +272,5 @@
! Remineralization rate of BSi depedant on T and saturation
! ---------------------------------------------------------
- zsatur = ( sio3eq(ji,jj,jk) - trn(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn )
+ zsatur = ( sio3eq(ji,jj,jk) - trb(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn )
zsatur = MAX( rtrn, zsatur )
zsatur2 = ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**37
@@ -287,5 +287,5 @@
zfactdep = xsilab * EXP(-( xsiremlab - xsirem ) * znusil2 * zdep / wsbio2 ) * ztem / ( ztem + 10. )
zsiremin = ( xsiremlab * zfactdep + xsirem * ( 1. - zfactdep ) ) * zstep * znusil
- zosil = zsiremin * trn(ji,jj,jk,jpgsi)
+ zosil = zsiremin * trb(ji,jj,jk,jpgsi)
!
tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) - zosil
@@ -315,5 +315,5 @@
END DO
- IF( jnt == nrdttrc ) THEN
+ IF( knt == nrdttrc ) THEN
CALL wrk_alloc( jpi, jpj, jpk, zw3d )
zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90 (revision 5602)
@@ -85,5 +85,5 @@
!!----------------------------------------------------------------------
!! NEMO/TOP 3.3 , NEMO Consortium (2010)
- !! $Header:$
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
@@ -117,5 +117,9 @@
IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_dust > 1 ) ) THEN
CALL fld_read( kt, 1, sf_dust )
- dust(:,:) = sf_dust(1)%fnow(:,:,1)
+ IF( nn_ice_tr == -1 .AND. .NOT. ln_ironice ) THEN
+ dust(:,:) = sf_dust(1)%fnow(:,:,1)
+ ELSE
+ dust(:,:) = sf_dust(1)%fnow(:,:,1) * ( 1.0 - fr_i(:,:) )
+ ENDIF
ENDIF
ENDIF
@@ -136,5 +140,5 @@
DO jj = 1, jpj
DO ji = 1, jpi
- zcoef = ryyss * cvol(ji,jj,1)
+ zcoef = ryyss * e1e2t(ji,jj) * h_rnf(ji,jj)
rivalk(ji,jj) = sf_river(jr_dic)%fnow(ji,jj,1) &
& * 1.E3 / ( 12. * zcoef + rtrn )
@@ -187,4 +191,6 @@
INTEGER :: ierr, ierr1, ierr2, ierr3
INTEGER :: ios ! Local integer output status for namelist read
+ INTEGER :: ik50 ! last level where depth less than 50 m
+ INTEGER :: isrow ! index for ORCA1 starting row
REAL(wp) :: zexpide, zdenitide, zmaskt
REAL(wp) :: ztimes_dust, ztimes_riv, ztimes_ndep
@@ -216,4 +222,13 @@
902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampissbc in configuration namelist', lwp )
IF(lwm) WRITE ( numonp, nampissbc )
+
+ IF ( ( nn_ice_tr >= 0 ) .AND. ln_ironice ) THEN
+ IF(lwp) THEN
+ WRITE(numout,*) ' ln_ironice incompatible with nn_ice_tr = ', nn_ice_tr
+ WRITE(numout,*) ' Specify your sea ice iron concentration in nampisice instead '
+ WRITE(numout,*) ' ln_ironice is forced to .FALSE. '
+ ln_ironice = .FALSE.
+ ENDIF
+ ENDIF
IF(lwp) THEN
@@ -247,4 +262,11 @@
ENDIF
+ ! set the number of level over which river runoffs are applied
+ ! online configuration : computed in sbcrnf
+ IF( lk_offline ) THEN
+ nk_rnf(:,:) = 1
+ h_rnf (:,:) = fsdept(:,:,1)
+ ENDIF
+
! dust input from the atmosphere
! ------------------------------
@@ -358,5 +380,4 @@
rivalkinput = 0._wp
END IF
-
! nutrient input from dust
! ------------------------
@@ -410,5 +431,12 @@
CALL iom_close( numiron )
!
- DO jk = 1, 5
+ ik50 = 5 ! last level where depth less than 50 m
+ DO jk = jpkm1, 1, -1
+ IF( gdept_1d(jk) > 50. ) ik50 = jk - 1
+ END DO
+ IF (lwp) WRITE(numout,*)
+ IF (lwp) WRITE(numout,*) ' Level corresponding to 50m depth ', ik50,' ', gdept_1d(ik50+1)
+ IF (lwp) WRITE(numout,*)
+ DO jk = 1, ik50
DO jj = 2, jpjm1
DO ji = fs_2, fs_jpim1
@@ -421,30 +449,7 @@
END DO
END DO
- IF( cp_cfg == 'orca' .AND. jp_cfg == 2 ) THEN
- ii0 = 176 ; ii1 = 176 ! Southern Island : Kerguelen
- ij0 = 37 ; ij1 = 37 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp
- !
- ii0 = 119 ; ii1 = 119 ! South Georgia
- ij0 = 29 ; ij1 = 29 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp
- !
- ii0 = 111 ; ii1 = 111 ! Falklands
- ij0 = 35 ; ij1 = 35 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp
- !
- ii0 = 168 ; ii1 = 168 ! Crozet
- ij0 = 40 ; ij1 = 40 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp
- !
- ii0 = 119 ; ii1 = 119 ! South Orkney
- ij0 = 28 ; ij1 = 28 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp
- !
- ii0 = 140 ; ii1 = 140 ! Bouvet Island
- ij0 = 33 ; ij1 = 33 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp
- !
- ii0 = 178 ; ii1 = 178 ! Prince edwards
- ij0 = 34 ; ij1 = 34 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp
- !
- ii0 = 43 ; ii1 = 43 ! Balleny islands
- ij0 = 21 ; ij1 = 21 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp
- ENDIF
+ !
CALL lbc_lnk( zcmask , 'T', 1. ) ! lateral boundary conditions on cmask (sign unchanged)
+ !
DO jk = 1, jpk
DO jj = 1, jpj
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90 (revision 5602)
@@ -21,5 +21,4 @@
USE p4zopt ! optical model
USE p4zlim ! Co-limitations of differents nutrients
- USE p4zrem ! Remineralisation of organic matter
USE p4zsbc ! External source of nutrients
USE p4zint ! interpolation and computation of various fields
@@ -30,11 +29,12 @@
PRIVATE
- PUBLIC p4z_sed
+ PUBLIC p4z_sed
+ PUBLIC p4z_sed_alloc
+
!! * Module variables
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nitrpot !: Nitrogen fixation
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,: ) :: sdenit !: Nitrate reduction in the sediments
REAL(wp) :: r1_rday !: inverse of rday
-
- INTEGER :: numnit
-
!!* Substitution
@@ -42,10 +42,10 @@
!!----------------------------------------------------------------------
!! NEMO/TOP 3.3 , NEMO Consortium (2010)
- !! $Header:$
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
CONTAINS
- SUBROUTINE p4z_sed( kt, jnt )
+ SUBROUTINE p4z_sed( kt, knt )
!!---------------------------------------------------------------------
!! *** ROUTINE p4z_sed ***
@@ -58,5 +58,5 @@
!!---------------------------------------------------------------------
!
- INTEGER, INTENT(in) :: kt, jnt ! ocean time step
+ INTEGER, INTENT(in) :: kt, knt ! ocean time step
INTEGER :: ji, jj, jk, ikt
#if ! defined key_sed
@@ -69,25 +69,20 @@
REAL(wp) :: zsiloss, zcaloss, zws3, zws4, zwsc, zdep, zwstpoc
REAL(wp) :: ztrfer, ztrpo4, zwdust, zlight
- REAL(wp) :: zrdenittot, zsdenittot, znitrpottot
!
CHARACTER (len=25) :: charout
- REAL(wp), POINTER, DIMENSION(:,: ) :: zpdep, zsidep, zwork1, zwork2, zwork3, zwork4
+ REAL(wp), POINTER, DIMENSION(:,: ) :: zpdep, zsidep, zwork1, zwork2, zwork3
REAL(wp), POINTER, DIMENSION(:,: ) :: zdenit2d, zironice, zbureff
REAL(wp), POINTER, DIMENSION(:,: ) :: zwsbio3, zwsbio4, zwscal
- REAL(wp), POINTER, DIMENSION(:,:,:) :: znitrpot, zirondep, zsoufer
+ REAL(wp), POINTER, DIMENSION(:,:,:) :: zirondep, zsoufer
!!---------------------------------------------------------------------
!
IF( nn_timing == 1 ) CALL timing_start('p4z_sed')
!
- IF( kt == nittrc000 .AND. jnt == 1 ) THEN
- r1_rday = 1. / rday
- IF( ln_check_mass .AND. lwp) &
- & CALL ctl_opn( numnit, 'nitrogen.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
- ENDIF
+ IF( kt == nittrc000 .AND. knt == 1 ) r1_rday = 1. / rday
!
! Allocate temporary workspace
- CALL wrk_alloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zwork4, zbureff )
+ CALL wrk_alloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zbureff )
CALL wrk_alloc( jpi, jpj, zwsbio3, zwsbio4, zwscal )
- CALL wrk_alloc( jpi, jpj, jpk, znitrpot, zsoufer )
+ CALL wrk_alloc( jpi, jpj, jpk, zsoufer )
zdenit2d(:,:) = 0.e0
@@ -96,5 +91,4 @@
zwork2 (:,:) = 0.e0
zwork3 (:,:) = 0.e0
- zwork4 (:,:) = 0.e0
! Iron input/uptake due to sea ice : Crude parameterization based on Lancelot et al.
@@ -108,5 +102,5 @@
zdep = rfact2 / fse3t(ji,jj,1)
zwflux = fmmflx(ji,jj) / 1000._wp
- zfminus = MIN( 0._wp, -zwflux ) * trn(ji,jj,1,jpfer) * zdep
+ zfminus = MIN( 0._wp, -zwflux ) * trb(ji,jj,1,jpfer) * zdep
zfplus = MAX( 0._wp, -zwflux ) * icefeinput * zdep
zironice(ji,jj) = zfplus + zfminus
@@ -114,7 +108,7 @@
END DO
!
- trn(:,:,1,jpfer) = trn(:,:,1,jpfer) + zironice(:,:)
+ tra(:,:,1,jpfer) = tra(:,:,1,jpfer) + zironice(:,:)
!
- IF( lk_iomput .AND. jnt == nrdttrc .AND. iom_use( "Ironice" ) ) &
+ IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironice" ) ) &
& CALL iom_put( "Ironice", zironice(:,:) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1) ) ! iron flux from ice
!
@@ -144,10 +138,10 @@
END DO
! ! Iron solubilization of particles in the water column
- trn(:,:,1,jppo4) = trn(:,:,1,jppo4) + zpdep (:,:)
- trn(:,:,1,jpsil) = trn(:,:,1,jpsil) + zsidep (:,:)
- trn(:,:,:,jpfer) = trn(:,:,:,jpfer) + zirondep(:,:,:)
+ tra(:,:,1,jppo4) = tra(:,:,1,jppo4) + zpdep (:,:)
+ tra(:,:,1,jpsil) = tra(:,:,1,jpsil) + zsidep (:,:)
+ tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + zirondep(:,:,:)
!
IF( lk_iomput ) THEN
- IF( jnt == nrdttrc ) THEN
+ IF( knt == nrdttrc ) THEN
IF( iom_use( "Irondep" ) ) &
& CALL iom_put( "Irondep", zirondep(:,:,1) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1) ) ! surface downward dust depo of iron
@@ -167,10 +161,16 @@
! ----------------------------------------------------------
IF( ln_river ) THEN
- trn(:,:,1,jppo4) = trn(:,:,1,jppo4) + rivdip(:,:) * rfact2
- trn(:,:,1,jpno3) = trn(:,:,1,jpno3) + rivdin(:,:) * rfact2
- trn(:,:,1,jpfer) = trn(:,:,1,jpfer) + rivdic(:,:) * 5.e-5 * rfact2
- trn(:,:,1,jpsil) = trn(:,:,1,jpsil) + rivdsi(:,:) * rfact2
- trn(:,:,1,jpdic) = trn(:,:,1,jpdic) + rivdic(:,:) * rfact2
- trn(:,:,1,jptal) = trn(:,:,1,jptal) + ( rivalk(:,:) - rno3 * rivdin(:,:) ) * rfact2
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ DO jk = 1, nk_rnf(ji,jj)
+ tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + rivdip(ji,jj) * rfact2
+ tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + rivdin(ji,jj) * rfact2
+ tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + rivdic(ji,jj) * 5.e-5 * rfact2
+ tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) + rivdsi(ji,jj) * rfact2
+ tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + rivdic(ji,jj) * rfact2
+ tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + ( rivalk(ji,jj) - rno3 * rivdin(ji,jj) ) * rfact2
+ ENDDO
+ ENDDO
+ ENDDO
ENDIF
@@ -178,6 +178,6 @@
! ----------------------------------------------------------
IF( ln_ndepo ) THEN
- trn(:,:,1,jpno3) = trn(:,:,1,jpno3) + nitdep(:,:) * rfact2
- trn(:,:,1,jptal) = trn(:,:,1,jptal) - rno3 * nitdep(:,:) * rfact2
+ tra(:,:,1,jpno3) = tra(:,:,1,jpno3) + nitdep(:,:) * rfact2
+ tra(:,:,1,jptal) = tra(:,:,1,jptal) - rno3 * nitdep(:,:) * rfact2
ENDIF
@@ -185,7 +185,7 @@
! ------------------------------------------------------
IF( ln_ironsed ) THEN
- trn(:,:,:,jpfer) = trn(:,:,:,jpfer) + ironsed(:,:,:) * rfact2
+ tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + ironsed(:,:,:) * rfact2
!
- IF( lk_iomput .AND. jnt == nrdttrc .AND. iom_use( "Ironsed" ) ) &
+ IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironsed" ) ) &
& CALL iom_put( "Ironsed", ironsed(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! iron inputs from sediments
ENDIF
@@ -194,7 +194,7 @@
! ------------------------------------------------------
IF( ln_hydrofe ) THEN
- trn(:,:,:,jpfer) = trn(:,:,:,jpfer) + hydrofe(:,:,:) * rfact2
+ tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + hydrofe(:,:,:) * rfact2
!
- IF( lk_iomput .AND. jnt == nrdttrc .AND. iom_use( "HYDR" ) ) &
+ IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "HYDR" ) ) &
& CALL iom_put( "HYDR", hydrofe(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! hydrothermal iron input
ENDIF
@@ -222,12 +222,12 @@
ikt = mbkt(ji,jj)
# if defined key_kriest
- zflx = trn(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) * 1E3 * 1E6 / 1E4
+ zflx = trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) * 1E3 * 1E6 / 1E4
# else
- zflx = ( trn(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) &
- & + trn(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E3 * 1E6 / 1E4
+ zflx = ( trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) &
+ & + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E3 * 1E6 / 1E4
#endif
zflx = LOG10( MAX( 1E-3, zflx ) )
- zo2 = LOG10( MAX( 10. , trn(ji,jj,ikt,jpoxy) * 1E6 ) )
- zno3 = LOG10( MAX( 1. , trn(ji,jj,ikt,jpno3) * 1E6 * rno3 ) )
+ zo2 = LOG10( MAX( 10. , trb(ji,jj,ikt,jpoxy) * 1E6 ) )
+ zno3 = LOG10( MAX( 1. , trb(ji,jj,ikt,jpno3) * 1E6 * rno3 ) )
zdep = LOG10( fsdepw(ji,jj,ikt+1) )
zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3 &
@@ -235,6 +235,6 @@
zdenit2d(ji,jj) = 10.0**( zdenit2d(ji,jj) )
!
- zflx = ( trn(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) &
- & + trn(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E6
+ zflx = ( trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) &
+ & + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E6
zbureff(ji,jj) = 0.013 + 0.53 * zflx**2 / ( 7.0 + zflx )**2
ENDIF
@@ -251,14 +251,14 @@
ikt = mbkt(ji,jj)
# if defined key_kriest
- zwork1(ji,jj) = trn(ji,jj,ikt,jpgsi) * zwscal (ji,jj)
- zwork2(ji,jj) = trn(ji,jj,ikt,jppoc) * zwsbio3(ji,jj)
+ zwork1(ji,jj) = trb(ji,jj,ikt,jpgsi) * zwscal (ji,jj)
+ zwork2(ji,jj) = trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj)
# else
- zwork1(ji,jj) = trn(ji,jj,ikt,jpgsi) * zwsbio4(ji,jj)
- zwork2(ji,jj) = trn(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) + trn(ji,jj,ikt,jppoc) * zwsbio3(ji,jj)
+ zwork1(ji,jj) = trb(ji,jj,ikt,jpgsi) * zwsbio4(ji,jj)
+ zwork2(ji,jj) = trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj)
# endif
! For calcite, burial efficiency is made a function of saturation
zfactcal = MIN( excess(ji,jj,ikt), 0.2 )
zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) )
- zwork3(ji,jj) = trn(ji,jj,ikt,jpcal) * zwscal(ji,jj) * 2.e0 * zfactcal
+ zwork3(ji,jj) = trb(ji,jj,ikt,jpcal) * zwscal(ji,jj) * 2.e0 * zfactcal
ENDIF
END DO
@@ -279,23 +279,23 @@
DO ji = 1, jpi
ikt = mbkt(ji,jj)
- zdep = xstep / fse3t(ji,jj,ikt)
+ zdep = xstep / fse3t(ji,jj,ikt)
zws4 = zwsbio4(ji,jj) * zdep
zwsc = zwscal (ji,jj) * zdep
# if defined key_kriest
- zsiloss = trn(ji,jj,ikt,jpgsi) * zws4
+ zsiloss = trb(ji,jj,ikt,jpgsi) * zws4
# else
- zsiloss = trn(ji,jj,ikt,jpgsi) * zwsc
+ zsiloss = trb(ji,jj,ikt,jpgsi) * zwsc
# endif
- zcaloss = trn(ji,jj,ikt,jpcal) * zwsc
+ zcaloss = trb(ji,jj,ikt,jpcal) * zwsc
!
- trn(ji,jj,ikt,jpgsi) = trn(ji,jj,ikt,jpgsi) - zsiloss
- trn(ji,jj,ikt,jpcal) = trn(ji,jj,ikt,jpcal) - zcaloss
+ tra(ji,jj,ikt,jpgsi) = tra(ji,jj,ikt,jpgsi) - zsiloss
+ tra(ji,jj,ikt,jpcal) = tra(ji,jj,ikt,jpcal) - zcaloss
#if ! defined key_sed
- trn(ji,jj,ikt,jpsil) = trn(ji,jj,ikt,jpsil) + zsiloss * zrivsil
+ tra(ji,jj,ikt,jpsil) = tra(ji,jj,ikt,jpsil) + zsiloss * zrivsil
zfactcal = MIN( excess(ji,jj,ikt), 0.2 )
zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) )
zrivalk = 1._wp - ( rivalkinput * r1_ryyss ) * zfactcal / ( zsumsedcal + rtrn )
- trn(ji,jj,ikt,jptal) = trn(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0
- trn(ji,jj,ikt,jpdic) = trn(ji,jj,ikt,jpdic) + zcaloss * zrivalk
+ tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0
+ tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zcaloss * zrivalk
#endif
END DO
@@ -304,20 +304,20 @@
DO jj = 1, jpj
DO ji = 1, jpi
- ikt = mbkt(ji,jj)
- zdep = xstep / fse3t(ji,jj,ikt)
+ ikt = mbkt(ji,jj)
+ zdep = xstep / fse3t(ji,jj,ikt)
zws4 = zwsbio4(ji,jj) * zdep
zws3 = zwsbio3(ji,jj) * zdep
zrivno3 = 1. - zbureff(ji,jj)
# if ! defined key_kriest
- trn(ji,jj,ikt,jpgoc) = trn(ji,jj,ikt,jpgoc) - trn(ji,jj,ikt,jpgoc) * zws4
- trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) - trn(ji,jj,ikt,jppoc) * zws3
- trn(ji,jj,ikt,jpbfe) = trn(ji,jj,ikt,jpbfe) - trn(ji,jj,ikt,jpbfe) * zws4
- trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) - trn(ji,jj,ikt,jpsfe) * zws3
- zwstpoc = trn(ji,jj,ikt,jpgoc) * zws4 + trn(ji,jj,ikt,jppoc) * zws3
+ tra(ji,jj,ikt,jpgoc) = tra(ji,jj,ikt,jpgoc) - trb(ji,jj,ikt,jpgoc) * zws4
+ tra(ji,jj,ikt,jppoc) = tra(ji,jj,ikt,jppoc) - trb(ji,jj,ikt,jppoc) * zws3
+ tra(ji,jj,ikt,jpbfe) = tra(ji,jj,ikt,jpbfe) - trb(ji,jj,ikt,jpbfe) * zws4
+ tra(ji,jj,ikt,jpsfe) = tra(ji,jj,ikt,jpsfe) - trb(ji,jj,ikt,jpsfe) * zws3
+ zwstpoc = trb(ji,jj,ikt,jpgoc) * zws4 + trb(ji,jj,ikt,jppoc) * zws3
# else
- trn(ji,jj,ikt,jpnum) = trn(ji,jj,ikt,jpnum) - trn(ji,jj,ikt,jpnum) * zws4
- trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) - trn(ji,jj,ikt,jppoc) * zws3
- trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) - trn(ji,jj,ikt,jpsfe) * zws3
- zwstpoc = trn(ji,jj,ikt,jppoc) * zws3
+ tra(ji,jj,ikt,jpnum) = tra(ji,jj,ikt,jpnum) - trb(ji,jj,ikt,jpnum) * zws4
+ tra(ji,jj,ikt,jppoc) = tra(ji,jj,ikt,jppoc) - trb(ji,jj,ikt,jppoc) * zws3
+ tra(ji,jj,ikt,jpsfe) = tra(ji,jj,ikt,jpsfe) - trb(ji,jj,ikt,jpsfe) * zws3
+ zwstpoc = trb(ji,jj,ikt,jppoc) * zws3
# endif
@@ -325,16 +325,16 @@
! The 0.5 factor in zpdenit and zdenitt is to avoid negative NO3 concentration after both denitrification
! in the sediments and just above the sediments. Not very clever, but simpliest option.
- zpdenit = MIN( 0.5 * ( trn(ji,jj,ikt,jpno3) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 )
+ zpdenit = MIN( 0.5 * ( trb(ji,jj,ikt,jpno3) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 )
z1pdenit = zwstpoc * zrivno3 - zpdenit
- zolimit = MIN( ( trn(ji,jj,ikt,jpoxy) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) )
- zdenitt = MIN( 0.5 * ( trn(ji,jj,ikt,jpno3) - rtrn ) / rdenit, z1pdenit * nitrfac(ji,jj,ikt) )
- trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc) + z1pdenit - zolimit - zdenitt
- trn(ji,jj,ikt,jppo4) = trn(ji,jj,ikt,jppo4) + zpdenit + zolimit + zdenitt
- trn(ji,jj,ikt,jpnh4) = trn(ji,jj,ikt,jpnh4) + zpdenit + zolimit + zdenitt
- trn(ji,jj,ikt,jpno3) = trn(ji,jj,ikt,jpno3) - rdenit * (zpdenit + zdenitt)
- trn(ji,jj,ikt,jpoxy) = trn(ji,jj,ikt,jpoxy) - zolimit * o2ut
- trn(ji,jj,ikt,jptal) = trn(ji,jj,ikt,jptal) + rno3 * (zolimit + (1.+rdenit) * (zpdenit + zdenitt) )
- trn(ji,jj,ikt,jpdic) = trn(ji,jj,ikt,jpdic) + zpdenit + zolimit + zdenitt
- zwork4(ji,jj) = rdenit * zpdenit * fse3t(ji,jj,ikt)
+ zolimit = MIN( ( trb(ji,jj,ikt,jpoxy) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) )
+ zdenitt = MIN( 0.5 * ( trb(ji,jj,ikt,jpno3) - rtrn ) / rdenit, z1pdenit * nitrfac(ji,jj,ikt) )
+ tra(ji,jj,ikt,jpdoc) = tra(ji,jj,ikt,jpdoc) + z1pdenit - zolimit - zdenitt
+ tra(ji,jj,ikt,jppo4) = tra(ji,jj,ikt,jppo4) + zpdenit + zolimit + zdenitt
+ tra(ji,jj,ikt,jpnh4) = tra(ji,jj,ikt,jpnh4) + zpdenit + zolimit + zdenitt
+ tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) - rdenit * (zpdenit + zdenitt)
+ tra(ji,jj,ikt,jpoxy) = tra(ji,jj,ikt,jpoxy) - zolimit * o2ut
+ tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + rno3 * (zolimit + (1.+rdenit) * (zpdenit + zdenitt) )
+ tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zpdenit + zolimit + zdenitt
+ sdenit(ji,jj) = rdenit * zpdenit * fse3t(ji,jj,ikt)
#endif
END DO
@@ -356,7 +356,7 @@
#endif
ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) )
- ztrpo4 = trn (ji,jj,jk,jppo4) / ( concnnh4 + trn (ji,jj,jk,jppo4) )
- zlight = ( 1.- EXP( -etot(ji,jj,jk) / diazolight ) )
- znitrpot(ji,jj,jk) = MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * r1_rday ) &
+ ztrpo4 = trb (ji,jj,jk,jppo4) / ( concnnh4 + trb (ji,jj,jk,jppo4) )
+ zlight = ( 1.- EXP( -etot_ndcy(ji,jj,jk) / diazolight ) )
+ nitrpot(ji,jj,jk) = MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * r1_rday ) &
& * zfact * MIN( ztrfer, ztrpo4 ) * zlight
zsoufer(ji,jj,jk) = zlight * 2E-11 / (2E-11 + biron(ji,jj,jk))
@@ -370,39 +370,23 @@
DO jj = 1, jpj
DO ji = 1, jpi
- zfact = znitrpot(ji,jj,jk) * nitrfix
- trn(ji,jj,jk,jpnh4) = trn(ji,jj,jk,jpnh4) + zfact
- trn(ji,jj,jk,jptal) = trn(ji,jj,jk,jptal) + rno3 * zfact
- trn(ji,jj,jk,jpoxy) = trn(ji,jj,jk,jpoxy) + o2nit * zfact
- trn(ji,jj,jk,jppo4) = trn(ji,jj,jk,jppo4) + concdnh4 / ( concdnh4 + trn(ji,jj,jk,jppo4) ) &
- & * 0.002 * trn(ji,jj,jk,jpdoc) * rfact2 / rday
- trn(ji,jj,jk,jpfer) = trn(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday
+ zfact = nitrpot(ji,jj,jk) * nitrfix
+ tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zfact
+ tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zfact
+ tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2nit * zfact
+ tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + concdnh4 / ( concdnh4 + trb(ji,jj,jk,jppo4) ) &
+ & * 0.002 * trb(ji,jj,jk,jpdoc) * xstep
+ tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * xstep
END DO
END DO
END DO
- ! Global budget of N SMS : denitrification in the water column and in the sediment
- ! nitrogen fixation by the diazotrophs
- ! --------------------------------------------------------------------------------
- zrdenittot = glob_sum ( denitr(:,:,:) * rdenit * xnegtr(:,:,:) * cvol(:,:,:) )
- zsdenittot = glob_sum ( zwork4(:,:) * e1e2t(:,:) )
- znitrpottot = glob_sum ( znitrpot(:,:,:) * nitrfix * cvol(:,:,:) )
- zfact = 1.e+3 * rfact2r * rno3 * 14. / 1.e12 * ryyss ! conversion molC/l/kt ----> TgN/m3/year
- !
- IF( ln_check_mass .AND. ( kt == nitend .AND. jnt == nrdttrc ) .AND. ( lwp ) ) &
- & WRITE(numnit,9100) ndastp, znitrpottot * zfact , &
- & zrdenittot * zfact , &
- & zsdenittot * zfact
- !
IF( lk_iomput ) THEN
- IF( jnt == nrdttrc ) THEN
+ IF( knt == nrdttrc ) THEN
zfact = 1.e+3 * rfact2r * rno3 ! conversion from molC/l/kt to molN/m3/s
- IF( iom_use("Nfix" ) ) CALL iom_put( "Nfix" , znitrpot(:,:,:) * nitrfix * zfact * tmask(:,:,:) ) ! nitrogen fixation
- IF( iom_use("Sdenit" ) ) CALL iom_put( "Sdenit", zwork4(:,:) * zfact * tmask(:,:,1) ) ! Nitrate reduction in the sediments
- IF( iom_use("tnfix" ) ) CALL iom_put( "tnfix" , znitrpottot * zfact ) ! Global nitrogen fixation
- IF( iom_use("tdenit" ) ) CALL iom_put( "tdenit" , zrdenittot * zfact ) ! Total denitrification
+ IF( iom_use("Nfix" ) ) CALL iom_put( "Nfix", nitrpot(:,:,:) * nitrfix * zfact * tmask(:,:,:) ) ! nitrogen fixation
IF( iom_use("INTNFIX") ) THEN ! nitrogen fixation rate in ocean ( vertically integrated )
zwork1(:,:) = 0.
DO jk = 1, jpkm1
- zwork1(:,:) = zwork1(:,:) + znitrpot(:,:,jk) * nitrfix * zfact * fse3t(:,:,jk) * tmask(:,:,jk)
+ zwork1(:,:) = zwork1(:,:) + nitrpot(:,:,jk) * nitrfix * zfact * fse3t(:,:,jk) * tmask(:,:,jk)
ENDDO
CALL iom_put( "INTNFIX" , zwork1 )
@@ -411,5 +395,5 @@
ELSE
IF( ln_diatrc ) &
- & trc2d(:,:,jp_pcs0_2d + 12) = znitrpot(:,:,1) * nitrfix * rno3 * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1)
+ & trc2d(:,:,jp_pcs0_2d + 12) = nitrpot(:,:,1) * nitrfix * rno3 * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1)
ENDIF
!
@@ -417,10 +401,10 @@
WRITE(charout, fmt="('sed ')")
CALL prt_ctl_trc_info(charout)
- CALL prt_ctl_trc(tab4d=trn, mask=tmask, clinfo=ctrcnm)
- ENDIF
- !
- CALL wrk_dealloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zwork4, zbureff )
+ CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+ ENDIF
+ !
+ CALL wrk_dealloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zbureff )
CALL wrk_dealloc( jpi, jpj, zwsbio3, zwsbio4, zwscal )
- CALL wrk_dealloc( jpi, jpj, jpk, znitrpot, zsoufer )
+ CALL wrk_dealloc( jpi, jpj, jpk, zsoufer )
!
IF( nn_timing == 1 ) CALL timing_stop('p4z_sed')
@@ -429,4 +413,16 @@
!
END SUBROUTINE p4z_sed
+
+
+ INTEGER FUNCTION p4z_sed_alloc()
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE p4z_sed_alloc ***
+ !!----------------------------------------------------------------------
+ ALLOCATE( nitrpot(jpi,jpj,jpk), sdenit(jpi,jpj), STAT=p4z_sed_alloc )
+ !
+ IF( p4z_sed_alloc /= 0 ) CALL ctl_warn('p4z_sed_alloc: failed to allocate arrays')
+ !
+ END FUNCTION p4z_sed_alloc
+
#else
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90 (revision 5602)
@@ -79,5 +79,5 @@
!!----------------------------------------------------------------------
- SUBROUTINE p4z_sink ( kt, jnt )
+ SUBROUTINE p4z_sink ( kt, knt )
!!---------------------------------------------------------------------
!! *** ROUTINE p4z_sink ***
@@ -88,5 +88,5 @@
!! ** Method : - ???
!!---------------------------------------------------------------------
- INTEGER, INTENT(in) :: kt, jnt
+ INTEGER, INTENT(in) :: kt, knt
INTEGER :: ji, jj, jk, jit
INTEGER :: iiter1, iiter2
@@ -199,15 +199,15 @@
zfact = zstep * xdiss(ji,jj,jk)
! Part I : Coagulation dependent on turbulence
- zagg1 = 25.9 * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc)
- zagg2 = 4452. * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc)
+ zagg1 = 25.9 * zfact * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jppoc)
+ zagg2 = 4452. * zfact * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpgoc)
! Part II : Differential settling
! Aggregation of small into large particles
- zagg3 = 47.1 * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc)
- zagg4 = 3.3 * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc)
+ zagg3 = 47.1 * zstep * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpgoc)
+ zagg4 = 3.3 * zstep * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jppoc)
zagg = zagg1 + zagg2 + zagg3 + zagg4
- zaggfe = zagg * trn(ji,jj,jk,jpsfe) / ( trn(ji,jj,jk,jppoc) + rtrn )
+ zaggfe = zagg * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn )
! Aggregation of DOC to POC :
@@ -215,12 +215,12 @@
! 2nd term is shear aggregation of DOC-POC
! 3rd term is differential settling of DOC-POC
- zaggdoc = ( ( 0.369 * 0.3 * trn(ji,jj,jk,jpdoc) + 102.4 * trn(ji,jj,jk,jppoc) ) * zfact &
- & + 2.4 * zstep * trn(ji,jj,jk,jppoc) ) * 0.3 * trn(ji,jj,jk,jpdoc)
+ zaggdoc = ( ( 0.369 * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4 * trb(ji,jj,jk,jppoc) ) * zfact &
+ & + 2.4 * zstep * trb(ji,jj,jk,jppoc) ) * 0.3 * trb(ji,jj,jk,jpdoc)
! transfer of DOC to GOC :
! 1st term is shear aggregation
! 2nd term is differential settling
- zaggdoc2 = ( 3.53E3 * zfact + 0.1 * zstep ) * trn(ji,jj,jk,jpgoc) * 0.3 * trn(ji,jj,jk,jpdoc)
+ zaggdoc2 = ( 3.53E3 * zfact + 0.1 * zstep ) * trb(ji,jj,jk,jpgoc) * 0.3 * trb(ji,jj,jk,jpdoc)
! tranfer of DOC to POC due to brownian motion
- zaggdoc3 = ( 5095. * trn(ji,jj,jk,jppoc) + 114. * 0.3 * trn(ji,jj,jk,jpdoc) ) *zstep * 0.3 * trn(ji,jj,jk,jpdoc)
+ zaggdoc3 = ( 5095. * trb(ji,jj,jk,jppoc) + 114. * 0.3 * trb(ji,jj,jk,jpdoc) ) *zstep * 0.3 * trb(ji,jj,jk,jpdoc)
! Update the trends
@@ -237,9 +237,9 @@
! Total carbon export per year
- IF( iom_use( "tcexp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. jnt == nrdttrc ) ) &
+ IF( iom_use( "tcexp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc ) ) &
& t_oce_co2_exp = glob_sum( ( sinking(:,:,ik100) + sinking2(:,:,ik100) ) * e1e2t(:,:) * tmask(:,:,1) )
!
IF( lk_iomput ) THEN
- IF( jnt == nrdttrc ) THEN
+ IF( knt == nrdttrc ) THEN
CALL wrk_alloc( jpi, jpj, zw2d )
CALL wrk_alloc( jpi, jpj, jpk, zw3d )
@@ -328,5 +328,5 @@
!!----------------------------------------------------------------------
- SUBROUTINE p4z_sink ( kt, jnt )
+ SUBROUTINE p4z_sink ( kt, knt )
!!---------------------------------------------------------------------
!! *** ROUTINE p4z_sink ***
@@ -338,5 +338,5 @@
!!---------------------------------------------------------------------
!
- INTEGER, INTENT(in) :: kt, jnt
+ INTEGER, INTENT(in) :: kt, knt
!
INTEGER :: ji, jj, jk, jit, niter1, niter2
@@ -373,5 +373,5 @@
DO ji = 1, jpi
IF( tmask(ji,jj,jk) /= 0.e0 ) THEN
- znum = trn(ji,jj,jk,jppoc) / ( trn(ji,jj,jk,jpnum) + rtrn ) / xkr_massp
+ znum = trb(ji,jj,jk,jppoc) / ( trb(ji,jj,jk,jpnum) + rtrn ) / xkr_massp
! -------------- To avoid sinking speed over 50 m/day -------
znum = MIN( xnumm(jk), znum )
@@ -435,5 +435,5 @@
IF( tmask(ji,jj,jk) /= 0.e0 ) THEN
- znum = trn(ji,jj,jk,jppoc)/(trn(ji,jj,jk,jpnum)+rtrn) / xkr_massp
+ znum = trb(ji,jj,jk,jppoc)/(trb(ji,jj,jk,jpnum)+rtrn) / xkr_massp
!-------------- To avoid sinking speed over 50 m/day -------
znum = min(xnumm(jk),znum)
@@ -453,10 +453,10 @@
! ----------------------------------------------
- zagg1 = 0.163 * trn(ji,jj,jk,jpnum)**2 &
+ zagg1 = 0.163 * trb(ji,jj,jk,jpnum)**2 &
& * 2.*( (zfm-1.)*(zfm*xkr_mass_max**3-xkr_mass_min**3) &
& * (zeps-1)/zdiv1 + 3.*(zfm*xkr_mass_max-xkr_mass_min) &
& * (zfm*xkr_mass_max**2-xkr_mass_min**2) &
& * (zeps-1.)**2/(zdiv2*zdiv3))
- zagg2 = 2*0.163*trn(ji,jj,jk,jpnum)**2*zfm* &
+ zagg2 = 2*0.163*trb(ji,jj,jk,jpnum)**2*zfm* &
& ((xkr_mass_max**3+3.*(xkr_mass_max**2 &
& *xkr_mass_min*(zeps-1.)/zdiv2 &
@@ -466,5 +466,5 @@
& (zeps-2.)+(zeps-1.)/zdiv3)+(zeps-1.)/zdiv1))
- zagg3 = 0.163*trn(ji,jj,jk,jpnum)**2*zfm**2*8. * xkr_mass_max**3
+ zagg3 = 0.163*trb(ji,jj,jk,jpnum)**2*zfm**2*8. * xkr_mass_max**3
! Aggregation of small into large particles
@@ -472,5 +472,5 @@
! ----------------------------------------------
- zagg4 = 2.*3.141*0.125*trn(ji,jj,jk,jpnum)**2* &
+ zagg4 = 2.*3.141*0.125*trb(ji,jj,jk,jpnum)**2* &
& xkr_wsbio_min*(zeps-1.)**2 &
& *(xkr_mass_min**2*((1.-zsm*zfm)/(zdiv3*zdiv4) &
@@ -479,5 +479,5 @@
& *xkr_eta)/(zdiv*zdiv3*zdiv5) )
- zagg5 = 2.*3.141*0.125*trn(ji,jj,jk,jpnum)**2 &
+ zagg5 = 2.*3.141*0.125*trb(ji,jj,jk,jpnum)**2 &
& *(zeps-1.)*zfm*xkr_wsbio_min &
& *(zsm*(xkr_mass_min**2-zfm*xkr_mass_max**2) &
@@ -489,5 +489,5 @@
! ------------------------------------
- zfract = 2.*3.141*0.125*trn(ji,jj,jk,jpmes)*12./0.12/0.06**3*trn(ji,jj,jk,jpnum) &
+ zfract = 2.*3.141*0.125*trb(ji,jj,jk,jpmes)*12./0.12/0.06**3*trb(ji,jj,jk,jpnum) &
& * (0.01/xkr_mass_min)**(1.-zeps)*0.1**2 &
& * 10000.*xstep
@@ -496,8 +496,8 @@
! --------------------------------------
- zaggdoc = 0.83 * trn(ji,jj,jk,jpdoc) * xstep * xdiss(ji,jj,jk) * trn(ji,jj,jk,jpdoc) &
- & + 0.005 * 231. * trn(ji,jj,jk,jpdoc) * xstep * trn(ji,jj,jk,jpdoc)
- zaggdoc1 = 271. * trn(ji,jj,jk,jppoc) * xstep * xdiss(ji,jj,jk) * trn(ji,jj,jk,jpdoc) &
- & + 0.02 * 16706. * trn(ji,jj,jk,jppoc) * xstep * trn(ji,jj,jk,jpdoc)
+ zaggdoc = 0.83 * trb(ji,jj,jk,jpdoc) * xstep * xdiss(ji,jj,jk) * trb(ji,jj,jk,jpdoc) &
+ & + 0.005 * 231. * trb(ji,jj,jk,jpdoc) * xstep * trb(ji,jj,jk,jpdoc)
+ zaggdoc1 = 271. * trb(ji,jj,jk,jppoc) * xstep * xdiss(ji,jj,jk) * trb(ji,jj,jk,jpdoc) &
+ & + 0.02 * 16706. * trb(ji,jj,jk,jppoc) * xstep * trb(ji,jj,jk,jpdoc)
# if defined key_degrad
@@ -514,5 +514,5 @@
zagg = 0.5 * xkr_stick * ( zaggsh + zaggsi )
!
- znumdoc = trn(ji,jj,jk,jpnum) / ( trn(ji,jj,jk,jppoc) + rtrn )
+ znumdoc = trb(ji,jj,jk,jpnum) / ( trb(ji,jj,jk,jppoc) + rtrn )
tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zaggdoc + zaggdoc1
tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zfract + zaggdoc / xkr_massp - zagg
@@ -528,5 +528,5 @@
!
IF( lk_iomput ) THEN
- IF( jnt == nrdttrc ) THEN
+ IF( knt == nrdttrc ) THEN
CALL wrk_alloc( jpi, jpj, zw2d )
CALL wrk_alloc( jpi, jpj, jpk, zw3d )
@@ -800,5 +800,5 @@
ztraz(:,:,:) = 0.e0
zakz (:,:,:) = 0.e0
- ztrb (:,:,:) = trn(:,:,:,jp_tra)
+ ztrb (:,:,:) = trb(:,:,:,jp_tra)
DO jk = 1, jpkm1
@@ -815,5 +815,5 @@
! first guess of the slopes interior values
DO jk = 2, jpkm1
- ztraz(:,:,jk) = ( trn(:,:,jk-1,jp_tra) - trn(:,:,jk,jp_tra) ) * tmask(:,:,jk)
+ ztraz(:,:,jk) = ( trb(:,:,jk-1,jp_tra) - trb(:,:,jk,jp_tra) ) * tmask(:,:,jk)
END DO
ztraz(:,:,1 ) = 0.0
@@ -846,5 +846,5 @@
zigma = zwsink2(ji,jj,jk+1) * zstep / fse3w(ji,jj,jk+1)
zew = zwsink2(ji,jj,jk+1)
- psinkflx(ji,jj,jk+1) = -zew * ( trn(ji,jj,jk,jp_tra) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * zstep
+ psinkflx(ji,jj,jk+1) = -zew * ( trb(ji,jj,jk,jp_tra) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * zstep
END DO
END DO
@@ -859,5 +859,5 @@
DO ji = 1, jpi
zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / fse3t(ji,jj,jk)
- trn(ji,jj,jk,jp_tra) = trn(ji,jj,jk,jp_tra) + zflx
+ trb(ji,jj,jk,jp_tra) = trb(ji,jj,jk,jp_tra) + zflx
END DO
END DO
@@ -875,5 +875,5 @@
END DO
- trn(:,:,:,jp_tra) = ztrb(:,:,:)
+ trb(:,:,:,jp_tra) = ztrb(:,:,:)
psinkflx(:,:,:) = 2. * psinkflx(:,:,:)
!
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90 (revision 5602)
@@ -24,4 +24,5 @@
USE p4zsed ! Sedimentation
USE p4zint ! time interpolation
+ USE p4zrem ! remineralisation
USE iom ! I/O manager
USE trd_oce ! Ocean trends variables
@@ -36,7 +37,14 @@
PUBLIC p4z_sms ! called in p4zsms.F90
- REAL(wp) :: alkbudget, no3budget, silbudget, ferbudget
- INTEGER :: numco2, numnut !: logical unit for co2 budget
-
+ REAL(wp) :: alkbudget, no3budget, silbudget, ferbudget, po4budget
+ REAL(wp) :: xfact1, xfact2
+ INTEGER :: numco2, numnut, numnit !: logical unit for co2 budget
+
+ !!* Array used to indicate negative tracer values
+ REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xnegtr !: ???
+
+
+ !! * Substitutions
+# include "top_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -61,20 +69,17 @@
INTEGER, INTENT( in ) :: kt ! ocean time-step index
!!
- INTEGER :: jnt, jn, jl
+ INTEGER :: ji, jj, jk, jnt, jn, jl
+ REAL(wp) :: ztra
+#if defined key_kriest
+ REAL(wp) :: zcoef1, zcoef2
+#endif
CHARACTER (len=25) :: charout
- REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrdpis
!!---------------------------------------------------------------------
!
IF( nn_timing == 1 ) CALL timing_start('p4z_sms')
!
- IF( l_trdtrc ) THEN
- CALL wrk_alloc( jpi, jpj, jpk, jp_pisces, ztrdpis )
- DO jn = 1, jp_pisces
- jl = jn + jp_pcs0 - 1
- ztrdpis(:,:,:,jn) = trn(:,:,:,jl)
- ENDDO
- ENDIF
- !
IF( kt == nittrc000 ) THEN
+ !
+ ALLOCATE( xnegtr(jpi,jpj,jpk) )
!
CALL p4z_che ! initialize the chemical constants
@@ -88,4 +93,26 @@
IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 ) CALL p4z_dmp( kt ) ! Relaxation of some tracers
!
+ ! ! set time step size (Euler/Leapfrog)
+ IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN ; rfact = rdttrc(1) ! at nittrc000
+ ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ; rfact = 2. * rdttrc(1) ! at nittrc000 or nittrc000+nn_dttrc (Leapfrog)
+ ENDIF
+ !
+ IF( ( ln_top_euler .AND. kt == nittrc000 ) .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + nn_dttrc ) ) THEN
+ rfactr = 1. / rfact
+ rfact2 = rfact / FLOAT( nrdttrc )
+ rfact2r = 1. / rfact2
+ xstep = rfact2 / rday ! Time step duration for biology
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) ' Passive Tracer time step rfact = ', rfact, ' rdt = ', rdttra(1)
+ IF(lwp) write(numout,*) ' PISCES Biology time step rfact2 = ', rfact2
+ IF(lwp) WRITE(numout,*)
+ ENDIF
+
+ IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN
+ DO jn = jp_pcs0, jp_pcs1 ! SMS on tracer without Asselin time-filter
+ trb(:,:,:,jn) = trn(:,:,:,jn)
+ END DO
+ ENDIF
+ !
IF( ndayflxtr /= nday_year ) THEN ! New days
!
@@ -105,28 +132,57 @@
DO jnt = 1, nrdttrc ! Potential time splitting if requested
!
- CALL p4z_bio (kt, jnt) ! Biology
- CALL p4z_sed (kt, jnt) ! Sedimentation
- !
+ CALL p4z_bio( kt, jnt ) ! Biology
+ CALL p4z_sed( kt, jnt ) ! Sedimentation
+ CALL p4z_lys( kt, jnt ) ! Compute CaCO3 saturation
+ CALL p4z_flx( kt, jnt ) ! Compute surface fluxes
+ !
+ xnegtr(:,:,:) = 1.e0
DO jn = jp_pcs0, jp_pcs1
- trb(:,:,:,jn) = trn(:,:,:,jn)
- ENDDO
- !
+ DO jk = 1, jpk
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ IF( ( trb(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) < 0.e0 ) THEN
+ ztra = ABS( trb(ji,jj,jk,jn) ) / ( ABS( tra(ji,jj,jk,jn) ) + rtrn )
+ xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk), ztra )
+ ENDIF
+ END DO
+ END DO
+ END DO
+ END DO
+ ! ! where at least 1 tracer concentration becomes negative
+ ! !
+ DO jn = jp_pcs0, jp_pcs1
+ trb(:,:,:,jn) = trb(:,:,:,jn) + xnegtr(:,:,:) * tra(:,:,:,jn)
+ END DO
+ !
+ DO jn = jp_pcs0, jp_pcs1
+ tra(:,:,:,jn) = 0._wp
+ END DO
+ !
+ IF( ln_top_euler ) THEN
+ DO jn = jp_pcs0, jp_pcs1
+ trn(:,:,:,jn) = trb(:,:,:,jn)
+ END DO
+ ENDIF
END DO
- IF( l_trdtrc ) THEN
- DO jn = 1, jp_pisces
- jl = jn + jp_pcs0 - 1
- ztrdpis(:,:,:,jn) = ( ztrdpis(:,:,:,jn) - trn(:,:,:,jl) ) * rfact2r
- ENDDO
- ENDIF
- CALL p4z_lys( kt ) ! Compute CaCO3 saturation
- CALL p4z_flx( kt ) ! Compute surface fluxes
-
- DO jn = jp_pcs0, jp_pcs1
- CALL lbc_lnk( trn(:,:,:,jn), 'T', 1. )
- CALL lbc_lnk( trb(:,:,:,jn), 'T', 1. )
- CALL lbc_lnk( tra(:,:,:,jn), 'T', 1. )
+#if defined key_kriest
+ !
+ zcoef1 = 1.e0 / xkr_massp
+ zcoef2 = 1.e0 / xkr_massp / 1.1
+ DO jk = 1,jpkm1
+ trb(:,:,jk,jpnum) = MAX( trb(:,:,jk,jpnum), trb(:,:,jk,jppoc) * zcoef1 / xnumm(jk) )
+ trb(:,:,jk,jpnum) = MIN( trb(:,:,jk,jpnum), trb(:,:,jk,jppoc) * zcoef2 )
END DO
!
+#endif
+ !
+ !
+ IF( l_trdtrc ) THEN
+ DO jn = jp_pcs0, jp_pcs1
+ CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt ) ! save trends
+ END DO
+ END IF
+ !
IF( lk_sed ) THEN
!
@@ -134,5 +190,5 @@
!
DO jn = jp_pcs0, jp_pcs1
- CALL lbc_lnk( trn(:,:,:,jn), 'T', 1. )
+ CALL lbc_lnk( trb(:,:,:,jn), 'T', 1. )
END DO
!
@@ -141,13 +197,5 @@
IF( lrst_trc ) CALL p4z_rst( kt, 'WRITE' ) !* Write PISCES informations in restart file
!
- IF( l_trdtrc ) THEN
- DO jn = 1, jp_pisces
- jl = jn + jp_pcs0 - 1
- ztrdpis(:,:,:,jn) = ztrdpis(:,:,:,jn) + tra(:,:,:,jl)
- CALL trd_trc( ztrdpis(:,:,:,jn), jn, jptra_sms, kt ) ! save trends
- END DO
- CALL wrk_dealloc( jpi, jpj, jpk, jp_pisces, ztrdpis )
- END IF
- !
+
IF( lk_iomput .OR. ln_check_mass ) CALL p4z_chk_mass( kt ) ! Mass conservation checking
@@ -280,7 +328,7 @@
ztmas = tmask(ji,jj,jk)
ztmas1 = 1. - tmask(ji,jj,jk)
- zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / ( 1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) ) )
- zco3 = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1
- zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk )
+ zcaralk = trb(ji,jj,jk,jptal) - borat(ji,jj,jk) / ( 1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) ) )
+ zco3 = ( zcaralk - trb(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1
+ zbicarb = ( 2. * trb(ji,jj,jk,jpdic) - zcaralk )
hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1
END DO
@@ -361,5 +409,6 @@
REAL(wp) :: silmean = 91.51 ! mean value of silicate
!
- REAL(wp) :: zarea, zalksum, zpo4sum, zno3sum, zsilsum
+ REAL(wp) :: zarea, zalksumn, zpo4sumn, zno3sumn, zsilsumn
+ REAL(wp) :: zalksumb, zpo4sumb, zno3sumb, zsilsumb
!!---------------------------------------------------------------------
@@ -374,23 +423,44 @@
zarea = 1._wp / glob_sum( cvol(:,:,:) ) * 1e6
- zalksum = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:) ) * zarea
- zpo4sum = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r
- zno3sum = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3
- zsilsum = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:) ) * zarea
+ zalksumn = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:) ) * zarea
+ zpo4sumn = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r
+ zno3sumn = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3
+ zsilsumn = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:) ) * zarea
- IF(lwp) WRITE(numout,*) ' TALK mean : ', zalksum
- trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksum
-
- IF(lwp) WRITE(numout,*) ' PO4 mean : ', zpo4sum
- trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sum
-
- IF(lwp) WRITE(numout,*) ' NO3 mean : ', zno3sum
- trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sum
-
- IF(lwp) WRITE(numout,*) ' SiO3 mean : ', zsilsum
- trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsum )
- !
- ENDIF
-
+ IF(lwp) WRITE(numout,*) ' TALKN mean : ', zalksumn
+ trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksumn
+
+ IF(lwp) WRITE(numout,*) ' PO4N mean : ', zpo4sumn
+ trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sumn
+
+ IF(lwp) WRITE(numout,*) ' NO3N mean : ', zno3sumn
+ trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sumn
+
+ IF(lwp) WRITE(numout,*) ' SiO3N mean : ', zsilsumn
+ trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsumn )
+ !
+ !
+ IF( .NOT. ln_top_euler ) THEN
+ zalksumb = glob_sum( trb(:,:,:,jptal) * cvol(:,:,:) ) * zarea
+ zpo4sumb = glob_sum( trb(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r
+ zno3sumb = glob_sum( trb(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3
+ zsilsumb = glob_sum( trb(:,:,:,jpsil) * cvol(:,:,:) ) * zarea
+
+ IF(lwp) WRITE(numout,*) ' '
+ IF(lwp) WRITE(numout,*) ' TALKB mean : ', zalksumb
+ trb(:,:,:,jptal) = trb(:,:,:,jptal) * alkmean / zalksumb
+
+ IF(lwp) WRITE(numout,*) ' PO4B mean : ', zpo4sumb
+ trb(:,:,:,jppo4) = trb(:,:,:,jppo4) * po4mean / zpo4sumb
+
+ IF(lwp) WRITE(numout,*) ' NO3B mean : ', zno3sumb
+ trb(:,:,:,jpno3) = trb(:,:,:,jpno3) * no3mean / zno3sumb
+
+ IF(lwp) WRITE(numout,*) ' SiO3B mean : ', zsilsumb
+ trb(:,:,:,jpsil) = MIN( 400.e-6,trb(:,:,:,jpsil) * silmean / zsilsumb )
+ ENDIF
+ !
+ ENDIF
+ !
END SUBROUTINE p4z_dmp
@@ -406,5 +476,11 @@
INTEGER , INTENT( in ) :: kt ! ocean time-step index
REAL(wp) :: zfact
- !!
+ REAL(wp) :: zrdenittot, zsdenittot, znitrpottot
+ CHARACTER(LEN=100) :: cltxt
+ REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol
+ INTEGER :: jk
+ !!----------------------------------------------------------------------
+
+ !
!!---------------------------------------------------------------------
@@ -413,7 +489,14 @@
CALL ctl_opn( numco2, 'carbon.budget' , 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
CALL ctl_opn( numnut, 'nutrient.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+ CALL ctl_opn( numnit, 'nitrogen.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+ xfact1 = rfact2r * 12. / 1.e15 * ryyss ! conversion molC/kt --> PgC/yr
+ xfact2 = 1.e+3 * rno3 * 14. / 1.e12 * ryyss ! conversion molC/l/s ----> TgN/m3/yr
+ cltxt='time-step Alkalinity Nitrate Phosphorus Silicate Iron'
+ IF( lwp ) WRITE(numnut,*) TRIM(cltxt)
+ IF( lwp ) WRITE(numnut,*)
ENDIF
ENDIF
+ !
IF( iom_use( "pno3tot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
! Compute the budget of NO3, ALK, Si, Fer
@@ -431,5 +514,18 @@
ENDIF
!
- IF( iom_use( "psiltot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
+ IF( iom_use( "ppo4tot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
+ po4budget = glob_sum( ( trn(:,:,:,jppo4) &
+ & + trn(:,:,:,jpphy) + trn(:,:,:,jpdia) &
+ & + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) &
+ & + trn(:,:,:,jppoc) &
+#if ! defined key_kriest
+ & + trn(:,:,:,jpgoc) &
+#endif
+ & + trn(:,:,:,jpdoc) ) * cvol(:,:,:) )
+ po4budget = po4budget / areatot
+ CALL iom_put( "ppo4tot", po4budget )
+ ENDIF
+ !
+ IF( iom_use( "psiltot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
silbudget = glob_sum( ( trn(:,:,:,jpsil) + trn(:,:,:,jpgsi) &
& + trn(:,:,:,jpdsi) ) * cvol(:,:,:) )
@@ -439,5 +535,5 @@
ENDIF
!
- IF( iom_use( "palktot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
+ IF( iom_use( "palktot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
alkbudget = glob_sum( ( trn(:,:,:,jpno3) * rno3 &
& + trn(:,:,:,jptal) &
@@ -448,5 +544,5 @@
ENDIF
!
- IF( iom_use( "pfertot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
+ IF( iom_use( "pfertot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
ferbudget = glob_sum( ( trn(:,:,:,jpfer) + trn(:,:,:,jpnfe) &
& + trn(:,:,:,jpdfe) &
@@ -462,19 +558,45 @@
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 ( nitrpot(:,:,:) * nitrfix * cvol(:,:,:) )
+ CALL iom_put( "tnfix" , znitrpottot * 1.e+3 * rno3 ) ! Global nitrogen fixation molC/l to molN/m3
+ ENDIF
+ !
+ IF( iom_use( "tdenit" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
+ zrdenittot = glob_sum ( denitr(:,:,:) * rdenit * xnegtr(:,:,:) * cvol(:,:,:) )
+ CALL iom_put( "tdenit" , zrdenittot * 1.e+3 * rno3 ) ! Total denitrification molC/l to molN/m3
+ ENDIF
+ !
+ IF( iom_use( "Sdenit" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
+ zsdenittot = glob_sum ( sdenit(:,:) * e1e2t(:,:) )
+ CALL iom_put( "Sdenit", sdenit(:,:) * zfact * tmask(:,:,1) ) ! Nitrate reduction in the sediments
+ ENDIF
+
IF( ln_check_mass .AND. kt == nitend ) THEN ! Compute the budget of NO3, ALK, Si, Fer
- zfact = rfact2r * 12. / 1.e15 * ryyss ! conversion molC/kt --> PgC/year
t_atm_co2_flx = t_atm_co2_flx / glob_sum( e1e2t(:,:) )
- t_oce_co2_flx = t_oce_co2_flx * zfact * (-1 )
- tpp = tpp * 1000. * zfact
- t_oce_co2_exp = t_oce_co2_exp * 1000. * zfact
+ t_oce_co2_flx = t_oce_co2_flx * xfact1 * (-1 )
+ tpp = tpp * 1000. * xfact1
+ t_oce_co2_exp = t_oce_co2_exp * 1000. * xfact1
IF( lwp ) WRITE(numco2,9000) ndastp, t_atm_co2_flx, t_oce_co2_flx, tpp, t_oce_co2_exp
- IF( lwp ) WRITE(numnut,9500) ndastp, alkbudget * 1.e+06, &
+ IF( lwp ) WRITE(numnut,9100) ndastp, alkbudget * 1.e+06, &
& no3budget * rno3 * 1.e+06, &
+ & po4budget * po4r * 1.e+06, &
& silbudget * 1.e+06, &
& ferbudget * 1.e+09
+ !
+ IF( lwp ) WRITE(numnit,9200) ndastp, znitrpottot * xfact2 , &
+ & zrdenittot * xfact2 , &
+ & zsdenittot * xfact2
+
ENDIF
!
9000 FORMAT(i8,f10.5,e18.10,f10.5,f10.5)
- 9500 FORMAT(i8,4e18.10)
+ 9100 FORMAT(i8,5e18.10)
+ 9200 FORMAT(i8,3f10.5)
+
!
END SUBROUTINE p4z_chk_mass
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/par_sed.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/par_sed.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/par_sed.F90 (revision 5602)
@@ -7,4 +7,5 @@
!! ! 06-12 (C. Ethe) Orignal
!!----------------------------------------------------------------------
+ !! $Id$
#if defined key_sed
!! Domain characteristics
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sed.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sed.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sed.F90 (revision 5602)
@@ -160,4 +160,5 @@
INTEGER, PUBLIC :: numsed = 27 ! units
+ !! $Id$
CONTAINS
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedadv.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedadv.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedadv.F90 (revision 5602)
@@ -23,4 +23,5 @@
REAL(wp) :: eps = 1.e-13
+ !! $Id$
CONTAINS
@@ -438,4 +439,5 @@
!! MODULE sedbtb : Dummy module
!!======================================================================
+ !! $Id$
CONTAINS
SUBROUTINE sed_adv( kt ) ! Empty routine
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedarr.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedarr.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedarr.F90 (revision 5602)
@@ -29,5 +29,5 @@
!!----------------------------------------------------------------------
!! NEMO/TOP 3.3 , NEMO Consortium (2010)
- !! $Header: /home/opalod/NEMOCVSROOT/NEMO/LIM_SRC/limtab.F90,v 1.2 2005/03/27 18:34:42 opalod Exp $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedbtb.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedbtb.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedbtb.F90 (revision 5602)
@@ -12,4 +12,5 @@
+ !! $Id$
CONTAINS
@@ -77,4 +78,5 @@
!! MODULE sedbtb : Dummy module
!!======================================================================
+ !! $Id$
CONTAINS
SUBROUTINE sed_btb( kt ) ! Empty routine
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedchem.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedchem.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedchem.F90 (revision 5602)
@@ -163,4 +163,5 @@
DATA Ddsw / 999.842594 , 6.793952E-2 , -9.095290E-3, 1.001685E-4, -1.120083E-6, 6.536332E-9/
+ !! $Id$
CONTAINS
@@ -559,4 +560,5 @@
!! MODULE sedchem : Dummy module
!!======================================================================
+ !! $Id$
CONTAINS
SUBROUTINE sed_chem( kt ) ! Empty routine
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedco3.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedco3.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedco3.F90 (revision 5602)
@@ -23,4 +23,5 @@
!!----------------------------------------------------------------------
+ !! $Id$
CONTAINS
@@ -188,4 +189,5 @@
!! MODULE sedco3 : Dummy module
!!======================================================================
+ !! $Id$
CONTAINS
SUBROUTINE sed_co3( kt ) ! Empty routine
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddsr.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddsr.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddsr.F90 (revision 5602)
@@ -20,4 +20,5 @@
REAL(wp), DIMENSION(:), ALLOCATABLE, PUBLIC :: dens_mol_wgt ! molecular density
+ !! $Id$
CONTAINS
@@ -530,4 +531,5 @@
!! MODULE seddsr : Dummy module
!!======================================================================
+ !! $Id$
CONTAINS
SUBROUTINE sed_dsr ( kt )
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddta.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddta.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddta.F90 (revision 5602)
@@ -28,4 +28,5 @@
#endif
+ !! $Id$
CONTAINS
@@ -268,4 +269,5 @@
!! MODULE seddta : Dummy module
!!======================================================================
+ !! $Id$
CONTAINS
SUBROUTINE sed_dta ( kt )
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedini.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedini.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedini.F90 (revision 5602)
@@ -55,4 +55,5 @@
PUBLIC sed_init ! routine called by opa.F90
+ !! $Id$
CONTAINS
@@ -856,4 +857,5 @@
!! Dummy module : NO Sediment model
!!----------------------------------------------------------------------
+ !! $Id$
CONTAINS
SUBROUTINE sed_ini ! Empty routine
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmat.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmat.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmat.F90 (revision 5602)
@@ -22,4 +22,5 @@
+ !! $Id$
CONTAINS
@@ -257,4 +258,5 @@
!! MODULE sedmat : Dummy module
!!======================================================================
+ !! $Id$
CONTAINS
SUBROUTINE sed_mat ! Empty routine
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmbc.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmbc.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmbc.F90 (revision 5602)
@@ -36,4 +36,5 @@
REAL(wp) :: src13ca
+ !! $Id$
CONTAINS
@@ -311,4 +312,5 @@
!! MODULE sedmbc : Dummy module
!!======================================================================
+ !! $Id$
CONTAINS
SUBROUTINE sed_mbc( kt ) ! Empty routine
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmodel.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmodel.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmodel.F90 (revision 5602)
@@ -17,4 +17,5 @@
LOGICAL, PUBLIC, PARAMETER :: lk_sed = .TRUE. !: sediment flag
+ !! $Id$
CONTAINS
@@ -47,4 +48,5 @@
!!======================================================================
LOGICAL, PUBLIC, PARAMETER :: lk_sed = .FALSE. !: sediment flag
+ !! $Id$
CONTAINS
SUBROUTINE sed_model( kt ) ! Empty routine
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedrst.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedrst.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedrst.F90 (revision 5602)
@@ -25,4 +25,5 @@
+ !! $Id$
CONTAINS
@@ -270,4 +271,5 @@
!! MODULE sedrst : Dummy module
!!======================================================================
+ !! $Id$
CONTAINS
SUBROUTINE sed_rst_read ! Empty routines
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedsfc.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedsfc.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedsfc.F90 (revision 5602)
@@ -12,4 +12,5 @@
PUBLIC sed_sfc
+ !! $Id$
CONTAINS
@@ -67,4 +68,5 @@
!! MODULE sedsfc : Dummy module
!!======================================================================
+ !! $Id$
CONTAINS
SUBROUTINE sed_sfc ( kt )
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedstp.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedstp.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedstp.F90 (revision 5602)
@@ -23,4 +23,5 @@
PUBLIC sed_stp ! called by step.F90
+ !! $Id$
CONTAINS
@@ -69,4 +70,5 @@
!! MODULE sedstp : Dummy module
!!======================================================================
+ !! $Id$
CONTAINS
SUBROUTINE sed_stp( kt ) ! Empty routine
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedwri.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedwri.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedwri.F90 (revision 5602)
@@ -25,4 +25,5 @@
INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndext51
+ !! $Id$
CONTAINS
@@ -264,4 +265,5 @@
!! MODULE sedwri : Dummy module
!!======================================================================
+ !! $Id$
CONTAINS
SUBROUTINE sed_wri( kt ) ! Empty routine
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/par_pisces.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/par_pisces.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/par_pisces.F90 (revision 5602)
@@ -63,10 +63,10 @@
INTEGER, PUBLIC, PARAMETER :: jpdia = 11 !: Diatoms Concentration
INTEGER, PUBLIC, PARAMETER :: jpmes = 12 !: Mesozooplankton Concentration
- INTEGER, PUBLIC, PARAMETER :: jpdsi = 13 !: (big) Silicate Concentration
+ INTEGER, PUBLIC, PARAMETER :: jpdsi = 13 !: Diatoms Silicate Concentration
INTEGER, PUBLIC, PARAMETER :: jpfer = 14 !: Iron Concentration
INTEGER, PUBLIC, PARAMETER :: jpnum = 15 !: Big iron particles Concentration
INTEGER, PUBLIC, PARAMETER :: jpsfe = 16 !: number of particulate organic phosphate concentration
INTEGER, PUBLIC, PARAMETER :: jpdfe = 17 !: Diatoms iron Concentration
- INTEGER, PUBLIC, PARAMETER :: jpgsi = 18 !: Diatoms Silicate Concentration
+ INTEGER, PUBLIC, PARAMETER :: jpgsi = 18 !: (big) Silicate Concentration
INTEGER, PUBLIC, PARAMETER :: jpnfe = 19 !: Nano iron Concentration
INTEGER, PUBLIC, PARAMETER :: jpnch = 20 !: Nano Chlorophyll Concentration
@@ -102,5 +102,5 @@
INTEGER, PUBLIC, PARAMETER :: jpdia = 11 !: Diatoms Concentration
INTEGER, PUBLIC, PARAMETER :: jpmes = 12 !: Mesozooplankton Concentration
- INTEGER, PUBLIC, PARAMETER :: jpdsi = 13 !: (big) Silicate Concentration
+ INTEGER, PUBLIC, PARAMETER :: jpdsi = 13 !: Diatoms Silicate Concentration
INTEGER, PUBLIC, PARAMETER :: jpfer = 14 !: Iron Concentration
INTEGER, PUBLIC, PARAMETER :: jpbfe = 15 !: Big iron particles Concentration
@@ -108,5 +108,5 @@
INTEGER, PUBLIC, PARAMETER :: jpsfe = 17 !: Small iron particles Concentration
INTEGER, PUBLIC, PARAMETER :: jpdfe = 18 !: Diatoms iron Concentration
- INTEGER, PUBLIC, PARAMETER :: jpgsi = 19 !: Diatoms Silicate Concentration
+ INTEGER, PUBLIC, PARAMETER :: jpgsi = 19 !: (big) Silicate Concentration
INTEGER, PUBLIC, PARAMETER :: jpnfe = 20 !: Nano iron Concentration
INTEGER, PUBLIC, PARAMETER :: jpnch = 21 !: Nano Chlorophyll Concentration
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90 (revision 5602)
@@ -106,7 +106,4 @@
REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tgfunc2 !: Temp. dependancy of mesozooplankton rates
- !!* Array used to indicate negative tracer values
- REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xnegtr !: ???
-
#if defined key_kriest
!!* Kriest parameter for aggregation
@@ -131,5 +128,5 @@
!!----------------------------------------------------------------------
USE lib_mpp , ONLY: ctl_warn
- INTEGER :: ierr(6) ! Local variables
+ INTEGER :: ierr(5) ! Local variables
!!----------------------------------------------------------------------
ierr(:) = 0
@@ -162,6 +159,4 @@
ALLOCATE( tgfunc(jpi,jpj,jpk) , tgfunc2(jpi,jpj,jpk) , STAT=ierr(5) )
!
- !* Array used to indicate negative tracer values
- ALLOCATE( xnegtr(jpi,jpj,jpk) , STAT=ierr(6) )
#endif
!
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/trcice_pisces.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/trcice_pisces.F90 (revision 5602)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/trcice_pisces.F90 (revision 5602)
@@ -0,0 +1,266 @@
+MODULE trcice_pisces
+ !!======================================================================
+ !! *** MODULE trcice_pisces ***
+ !! TOP : initialisation of the PISCES biochemical model
+ !!======================================================================
+ !! History : 3.5 ! 2013 (M. Vancoppenolle, O. Aumont, G. Madec), original code
+ !! Comment ! probably not properly done when the second particle export
+ !! scheme (kriest) is used
+ !!----------------------------------------------------------------------
+#if defined key_pisces || defined key_pisces_reduced
+ !!----------------------------------------------------------------------
+ !! 'key_pisces' PISCES bio-model
+ !!----------------------------------------------------------------------
+ !! trc_ice_pisces : PISCES fake sea ice model setting
+ !!----------------------------------------------------------------------
+ USE par_trc ! TOP parameters
+ USE par_pisces ! PISCES parameters
+ USE oce_trc ! Shared variables between ocean and passive tracers
+ USE trc ! Passive tracers common variables
+ USE phycst ! Ocean physics parameters
+ USE sms_pisces ! PISCES Source Minus Sink variables
+ USE in_out_manager
+
+ IMPLICIT NONE
+ PRIVATE
+
+ PUBLIC trc_ice_ini_pisces ! called by trcini.F90 module
+
+CONTAINS
+
+ SUBROUTINE trc_ice_ini_pisces
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE trc_ice_ini_pisces ***
+ !!
+ !! ** Purpose : PISCES fake sea ice model setting
+ !! Method : Assign prescribe values to tracer concentrations in sea ice
+ !!
+ !! For levitating sea ice, constant ocean tracer concentrations also have to be defined.
+ !! This is done specifically for Global, Arctic, Antarctic and Baltic regions
+ !!
+ !! Sea ice concentrations are by default prescribed as follows
+ !! trc_i = zratio * trc_o
+ !!
+ !! This formulation is modulated by the namelist parameter trc_ice_ratio
+ !!
+ !! trc_ice_ratio * betw 0 and 1: prescribed ice/ocean tracer concentration ratio
+ !! * -1 => the ice-ocean tracer concentration ratio follows the
+ !! ice-ocean salinity ratio
+ !! * -2 => no ice-ocean tracer concentration is used
+ !! instead, the tracer concentration in sea ice
+ !! is prescribed to trc_ice_prescr
+ !!
+ !! cn_trc_o specifies which disinctions are made for prescribed tracer concentration
+ !! * 'GL' use global ocean values making distinction for Baltic Sea only
+ !! * 'AA' use Arctic/Antarctic contrasted values, + Baltic
+ !!
+ !!----------------------------------------------------------------------
+
+ !--- Dummy variables
+ REAL(wp), DIMENSION(jptra,2) &
+ :: zratio ! effective ice-ocean tracer cc ratio
+ REAL(wp), DIMENSION(2) :: zrs ! ice-ocean salinity ratio, 1 - global, 2- Baltic
+ REAL(wp) :: zsice_bal ! prescribed ice salinity in the Baltic
+ REAL(wp) :: zsoce_bal ! prescribed ocean salinity in the Baltic
+ REAL(wp) :: zfeoce_glo ! prescribed iron concentration in the global ocean
+ REAL(wp) :: zfeoce_bal ! prescribed iron concentration in the global ocean
+ INTEGER :: jn ! dummy loop index
+
+ !!----------------------------------------------------------------------
+
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) ' trc_ice_ini_pisces: Prescribed sea ice biogeochemistry '
+ IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~'
+
+ !--------------------------------------------
+ ! Initialize ocean prescribed concentrations
+ !--------------------------------------------
+ ! values taken from a 500 yr equilibrium run
+ ! used only in the levitating sea ice case with virtual salt / tracer
+ ! fluxes
+
+ !--- Global case
+ IF ( cn_trc_o(jpdic) == 'GL ' ) trc_o(:,:,jpdic) = 1.99e-3_wp
+ IF ( cn_trc_o(jpdoc) == 'GL ' ) trc_o(:,:,jpdoc) = 2.04e-5_wp
+ IF ( cn_trc_o(jptal) == 'GL ' ) trc_o(:,:,jptal) = 2.31e-3_wp
+ IF ( cn_trc_o(jpoxy) == 'GL ' ) trc_o(:,:,jpoxy) = 2.47e-4_wp
+ IF ( cn_trc_o(jpcal) == 'GL ' ) trc_o(:,:,jpcal) = 1.04e-8_wp
+ IF ( cn_trc_o(jppo4) == 'GL ' ) trc_o(:,:,jppo4) = 5.77e-7_wp / po4r
+ IF ( cn_trc_o(jppoc) == 'GL ' ) trc_o(:,:,jppoc) = 1.27e-6_wp
+# if ! defined key_kriest
+ IF ( cn_trc_o(jpgoc) == 'GL ' ) trc_o(:,:,jpgoc) = 5.23e-8_wp
+ IF ( cn_trc_o(jpbfe) == 'GL ' ) trc_o(:,:,jpbfe) = 9.84e-13_wp
+# else
+ IF ( cn_trc_o(jpnum) == 'GL ' ) trc_o(:,:,jpnum) = 0. ! could not get this value since did not use it
+# endif
+ IF ( cn_trc_o(jpsil) == 'GL ' ) trc_o(:,:,jpsil) = 7.36e-6_wp
+ IF ( cn_trc_o(jpdsi) == 'GL ' ) trc_o(:,:,jpdsi) = 1.07e-7_wp
+ IF ( cn_trc_o(jpgsi) == 'GL ' ) trc_o(:,:,jpgsi) = 1.53e-8_wp
+ IF ( cn_trc_o(jpphy) == 'GL ' ) trc_o(:,:,jpphy) = 9.57e-8_wp
+ IF ( cn_trc_o(jpdia) == 'GL ' ) trc_o(:,:,jpdia) = 4.24e-7_wp
+ IF ( cn_trc_o(jpzoo) == 'GL ' ) trc_o(:,:,jpzoo) = 6.07e-7_wp
+ IF ( cn_trc_o(jpmes) == 'GL ' ) trc_o(:,:,jpmes) = 3.44e-7_wp
+ IF ( cn_trc_o(jpfer) == 'GL ' ) trc_o(:,:,jpfer) = 4.06e-10_wp
+ IF ( cn_trc_o(jpsfe) == 'GL ' ) trc_o(:,:,jpsfe) = 2.51e-11_wp
+ IF ( cn_trc_o(jpdfe) == 'GL ' ) trc_o(:,:,jpdfe) = 6.57e-12_wp
+ IF ( cn_trc_o(jpnfe) == 'GL ' ) trc_o(:,:,jpnfe) = 1.76e-11_wp
+ IF ( cn_trc_o(jpnch) == 'GL ' ) trc_o(:,:,jpnch) = 1.67e-7_wp
+ IF ( cn_trc_o(jpdch) == 'GL ' ) trc_o(:,:,jpdch) = 1.02e-7_wp
+ IF ( cn_trc_o(jpno3) == 'GL ' ) trc_o(:,:,jpno3) = 5.79e-6_wp / rno3
+ IF ( cn_trc_o(jpnh4) == 'GL ' ) trc_o(:,:,jpnh4) = 3.22e-7_wp / rno3
+
+ !--- Arctic specificities (dissolved inorganic & DOM)
+ IF ( cn_trc_o(jpdic) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpdic) = 1.98e-3_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpdoc) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpdoc) = 6.00e-6_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jptal) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jptal) = 2.13e-3_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpoxy) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpoxy) = 3.65e-4_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpcal) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpcal) = 1.50e-9_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jppo4) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jppo4) = 4.09e-7_wp / po4r ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jppoc) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jppoc) = 4.05e-7_wp ; END WHERE ; ENDIF
+# if ! defined key_kriest
+ IF ( cn_trc_o(jpgoc) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpgoc) = 2.84e-8_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpbfe) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpbfe) = 7.03e-13_wp ; END WHERE ; ENDIF
+# else
+ IF ( cn_trc_o(jpnum) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpnum) = 0.00e-00_wp ; END WHERE ; ENDIF
+# endif
+ IF ( cn_trc_o(jpsil) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpsil) = 6.87e-6_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpdsi) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpdsi) = 1.73e-7_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpgsi) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpgsi) = 7.93e-9_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpphy) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpphy) = 5.25e-7_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpdia) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpdia) = 7.75e-7_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpzoo) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpzoo) = 3.34e-7_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpmes) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpmes) = 2.49e-7_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpfer) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpfer) = 1.43e-9_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpsfe) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpsfe) = 2.21e-11_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpdfe) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpdfe) = 2.04e-11_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpnfe) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpnfe) = 1.75e-11_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpnch) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpnch) = 1.46e-07_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpdch) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpdch) = 2.36e-07_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpno3) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpno3) = 3.51e-06_wp / rno3 ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpnh4) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpnh4) = 6.15e-08_wp / rno3 ; END WHERE ; ENDIF
+
+ !--- Antarctic specificities (dissolved inorganic & DOM)
+ IF ( cn_trc_o(jpdic) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpdic) = 2.20e-3_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpdoc) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpdoc) = 7.02e-6_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jptal) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jptal) = 2.37e-3_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpoxy) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpoxy) = 3.42e-4_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpcal) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpcal) = 3.17e-9_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jppo4) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jppo4) = 1.88e-6_wp / po4r ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jppoc) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jppoc) = 1.13e-6_wp ; END WHERE ; ENDIF
+# if ! defined key_kriest
+ IF ( cn_trc_o(jpgoc) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpgoc) = 2.89e-8_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpbfe) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpbfe) = 5.63e-13_wp ; END WHERE ; ENDIF
+# else
+ IF ( cn_trc_o(jpnum) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpnum) = 0.00e-00_wp ; END WHERE ; ENDIF
+# endif
+ IF ( cn_trc_o(jpsil) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpsil) = 4.96e-5_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpdsi) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpdsi) = 5.63e-7_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpgsi) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpgsi) = 5.35e-8_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpphy) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpphy) = 8.10e-7_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpdia) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpdia) = 5.77e-7_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpzoo) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpzoo) = 6.68e-7_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpmes) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpmes) = 3.55e-7_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpfer) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpfer) = 1.62e-10_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpsfe) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpsfe) = 2.29e-11_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpdfe) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpdfe) = 8.75e-12_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpnfe) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpnfe) = 1.48e-11_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpnch) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpnch) = 2.02e-7_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpdch) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpdch) = 1.60e-7_wp ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpno3) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpno3) = 2.64e-5_wp / rno3 ; END WHERE ; ENDIF
+ IF ( cn_trc_o(jpnh4) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpnh4) = 3.39e-7_wp / rno3 ; END WHERE ; ENDIF
+
+ !--- Baltic Sea particular case for ORCA configurations
+ IF( cp_cfg == "orca" ) THEN ! Baltic mask
+ WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND. &
+ 54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp )
+ trc_o(:,:,jpdic) = 1.14e-3_wp
+ trc_o(:,:,jpdoc) = 1.06e-5_wp
+ trc_o(:,:,jptal) = 1.16e-3_wp
+ trc_o(:,:,jpoxy) = 3.71e-4_wp
+ trc_o(:,:,jpcal) = 1.51e-9_wp
+ trc_o(:,:,jppo4) = 2.85e-9_wp / po4r
+ trc_o(:,:,jppoc) = 4.84e-7_wp
+# if ! defined key_kriest
+ trc_o(:,:,jpgoc) = 1.05e-8_wp
+ trc_o(:,:,jpbfe) = 4.97e-13_wp
+# else
+ trc_o(:,:,jpnum) = 0. ! could not get this value
+# endif
+ trc_o(:,:,jpsil) = 4.91e-5_wp
+ trc_o(:,:,jpdsi) = 3.25e-7_wp
+ trc_o(:,:,jpgsi) = 1.93e-8_wp
+ trc_o(:,:,jpphy) = 6.64e-7_wp
+ trc_o(:,:,jpdia) = 3.41e-7_wp
+ trc_o(:,:,jpzoo) = 3.83e-7_wp
+ trc_o(:,:,jpmes) = 0.225e-6_wp
+ trc_o(:,:,jpfer) = 2.45e-9_wp
+ trc_o(:,:,jpsfe) = 3.89e-11_wp
+ trc_o(:,:,jpdfe) = 1.33e-11_wp
+ trc_o(:,:,jpnfe) = 2.62e-11_wp
+ trc_o(:,:,jpnch) = 1.17e-7_wp
+ trc_o(:,:,jpdch) = 9.69e-8_wp
+ trc_o(:,:,jpno3) = 5.36e-5_wp / rno3
+ trc_o(:,:,jpnh4) = 7.18e-7_wp / rno3
+ END WHERE
+ ENDIF ! cfg
+
+ !-----------------------------
+ ! Assign ice-ocean cc ratios
+ !-----------------------------
+ ! 0 means zero concentration in sea ice
+ ! 1 means same concentration in the sea ice as in the ocean
+
+ ! Ice ocean salinity ratio
+ zsoce_bal = 4. ; zsice_bal = 2. !! Baltic ocean and sea ice salinities
+ zrs(1) = sice / soce !! ice-ocean salinity ratio, global case
+ zrs(2) = zsice_bal / zsoce_bal !! ice-ocean salinity ratio, Baltic case
+
+ DO jn = jp_pcs0, jp_pcs1
+ IF ( trc_ice_ratio(jn) >= 0._wp ) zratio(jn,:) = trc_ice_ratio(jn)
+ IF ( trc_ice_ratio(jn) == -1._wp ) zratio(jn,:) = zrs(:)
+ IF ( trc_ice_ratio(jn) == -2._wp ) zratio(jn,:) = -9999.99_wp
+ END DO
+
+ !-------------------------------
+ ! Sea ice tracer concentrations
+ !-------------------------------
+ DO jn = jp_pcs0, jp_pcs1
+ !-- Everywhere but in the Baltic
+ IF ( trc_ice_ratio(jn) >= -1._wp ) THEN !! no prescribed concentration
+ !! (typically everything but iron)
+ trc_i(:,:,jn) = zratio(jn,1) * trc_o(:,:,jn)
+ ELSE !! prescribed concentration
+ trc_i(:,:,jn) = trc_ice_prescr(jn)
+ ENDIF
+
+ !-- Baltic
+ IF( cp_cfg == "orca" ) THEN !! Baltic treated seperately for ORCA configs
+ IF ( trc_ice_ratio(jn) >= - 1._wp ) THEN !! no prescribed concentration
+ !! (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)
+ END WHERE
+ ELSE !! prescribed tracer concentration in ice
+ WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND. &
+ 54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp )
+ trc_i(:,:,jn) = trc_ice_prescr(jn)
+ END WHERE
+ ENDIF ! trc_ice_ratio
+ ENDIF
+ !
+ END DO ! jn
+
+ END SUBROUTINE trc_ice_ini_pisces
+
+#else
+ !!----------------------------------------------------------------------
+ !! Dummy module No PISCES biochemical model
+ !!----------------------------------------------------------------------
+CONTAINS
+ SUBROUTINE trc_ice_ini_pisces ! Empty routine
+ END SUBROUTINE trc_ice_ini_pisces
+#endif
+
+ !!======================================================================
+END MODULE trcice_pisces
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90 (revision 5602)
@@ -71,12 +71,13 @@
USE p4zmort ! Mortality terms for phytoplankton
USE p4zlys ! Calcite saturation
+ USE p4zsed ! Sedimentation & burial
!
REAL(wp), SAVE :: sco2 = 2.312e-3_wp
- REAL(wp), SAVE :: alka0 = 2.423e-3_wp
+ REAL(wp), SAVE :: alka0 = 2.426e-3_wp
REAL(wp), SAVE :: oxyg0 = 177.6e-6_wp
- REAL(wp), SAVE :: po4 = 2.174e-6_wp
+ REAL(wp), SAVE :: po4 = 2.165e-6_wp
REAL(wp), SAVE :: bioma0 = 1.000e-8_wp
- REAL(wp), SAVE :: silic1 = 91.65e-6_wp
- REAL(wp), SAVE :: no3 = 31.04e-6_wp * 7.625_wp
+ REAL(wp), SAVE :: silic1 = 91.51e-6_wp
+ REAL(wp), SAVE :: no3 = 30.9e-6_wp * 7.625_wp
!
INTEGER :: ji, jj, jk, ierr
@@ -97,4 +98,5 @@
ierr = ierr + p4z_rem_alloc()
ierr = ierr + p4z_flx_alloc()
+ ierr = ierr + p4z_sed_alloc()
!
IF( lk_mpp ) CALL mpp_sum( ierr )
@@ -107,13 +109,4 @@
CALL p4z_sms_init ! Maint routine
! ! Time-step
- rfact = rdttrc(1) ! ---------
- rfactr = 1. / rfact
- rfact2 = rfact / FLOAT( nrdttrc )
- rfact2r = 1. / rfact2
-
- IF(lwp) WRITE(numout,*) ' Passive Tracer time step rfact = ', rfact, ' rdt = ', rdttra(1)
- IF(lwp) write(numout,*) ' PISCES Biology time step rfact2 = ', rfact2
-
-
! Set biological ratios
@@ -165,6 +158,4 @@
END IF
- ! Time step duration for biology
- xstep = rfact2 / rday
CALL p4z_sink_init ! vertical flux of particulate organic matter
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90 (revision 5602)
@@ -84,14 +84,9 @@
IF( kt == nittrc000 ) CALL trc_adv_ctl ! initialisation & control of options
- IF( ln_top_euler) THEN
- r2dt(:) = rdttrc(:) ! = rdttrc (use Euler time stepping)
- ELSE
- IF( neuler == 0 .AND. kt == nittrc000 ) THEN ! at nittrc000
- r2dt(:) = rdttrc(:) ! = rdttrc (restarting with Euler time stepping)
- ELSEIF( kt <= nittrc000 + 1 ) THEN ! at nittrc000 or nittrc000+1
- r2dt(:) = 2. * rdttrc(:) ! = 2 rdttrc (leapfrog)
- ENDIF
+ IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN ! at nittrc000
+ r2dt(:) = rdttrc(:) ! = rdttrc (use or restarting with Euler time stepping)
+ ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ! at nittrc000 or nittrc000+1
+ r2dt(:) = 2. * rdttrc(:) ! = 2 rdttrc (leapfrog)
ENDIF
-
! ! effective transport
DO jk = 1, jpkm1
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90 (revision 5602)
@@ -24,4 +24,5 @@
USE trdtra
USE trd_oce
+ USE iom
IMPLICIT NONE
@@ -42,5 +43,5 @@
!!----------------------------------------------------------------------
!! NEMO/TOP 3.3 , NEMO Consortium (2010)
- !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcdmp.F90,v 1.11 2006/09/01 14:03:49 opalod Exp $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
@@ -125,5 +126,5 @@
DO jj = 2, jpjm1
DO ji = fs_2, fs_jpim1 ! vector opt.
- IF( avt(ji,jj,jk) <= 5.e-4 ) THEN
+ IF( avt(ji,jj,jk) <= 5.e-4_wp ) THEN
ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) )
tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
@@ -184,5 +185,6 @@
INTEGER, INTENT( in ) :: kt ! ocean time-step index
!
- INTEGER :: ji, jj, jk, jn, jl, jc ! dummy loop indicesa
+ INTEGER :: ji , jj, jk, jn, jl, jc ! dummy loop indicesa
+ INTEGER :: isrow ! local index
REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace
@@ -200,4 +202,13 @@
!
SELECT CASE ( jp_cfg )
+ ! ! =======================
+ CASE ( 1 ) ! eORCA_R1 configuration
+ ! ! =======================
+ isrow = 332 - jpjglo
+ !
+ ! Caspian Sea
+ nctsi1(1) = 332 ; nctsj1(1) = 243 - isrow
+ nctsi2(1) = 344 ; nctsj2(1) = 275 - isrow
+ !
! ! =======================
CASE ( 2 ) ! ORCA_R2 configuration
@@ -302,13 +313,8 @@
!!----------------------------------------------------------------------
!
+ INTEGER :: imask !local file handle
+
IF( nn_timing == 1 ) CALL timing_start('trc_dmp_init')
!
- SELECT CASE ( nn_hdmp_tr )
- CASE ( -1 ) ; IF(lwp) WRITE(numout,*) ' tracer damping in the Med & Red seas only'
- CASE ( 1:90 ) ; IF(lwp) WRITE(numout,*) ' tracer damping poleward of', nn_hdmp_tr, ' degrees'
- CASE DEFAULT
- WRITE(ctmp1,*) ' bad flag value for nn_hdmp_tr = ', nn_hdmp_tr
- CALL ctl_stop(ctmp1)
- END SELECT
IF( lzoom ) nn_zdmp_tr = 0 ! restoring to climatology at closed north or south boundaries
@@ -325,9 +331,9 @@
& CALL ctl_stop( 'passive trace damping need key_tradmp to compute damping coef.' )
!
- ! ! Damping coefficients initialization
- IF( lzoom ) THEN ; CALL dtacof_zoom( restotr )
- ELSE ; CALL dtacof( nn_hdmp_tr, rn_surf_tr, rn_bot_tr, rn_dep_tr, &
- & nn_file_tr, 'TRC' , restotr )
- ENDIF
+ ! ! Read damping coefficients from file
+ !Read in mask from file
+ CALL iom_open ( cn_resto_tr, imask)
+ CALL iom_get ( imask, jpdom_autoglo, 'resto', restotr)
+ CALL iom_close( imask )
!
IF( nn_timing == 1 ) CALL timing_stop('trc_dmp_init')
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90 (revision 5602)
@@ -217,9 +217,4 @@
ENDIF
- IF( .NOT. ln_trcldf_diff ) THEN
- IF(lwp) WRITE(numout,*) ' No lateral diffusion on passive tracers'
- nldf = -2
- ENDIF
-
IF(lwp) THEN
WRITE(numout,*)
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcnam_trp.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcnam_trp.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcnam_trp.F90 (revision 5602)
@@ -33,5 +33,4 @@
! !!: ** lateral mixing namelist (nam_trcldf) **
- LOGICAL , PUBLIC :: ln_trcldf_diff !: flag of perform or not the lateral diff.
LOGICAL , PUBLIC :: ln_trcldf_lap !: laplacian operator
LOGICAL , PUBLIC :: ln_trcldf_bilap !: bilaplacian operator
@@ -51,10 +50,6 @@
! !!: ** newtonian damping namelist (nam_trcdmp) **
! !!* Namelist namtrc_dmp : passive tracer newtonian damping *
- INTEGER , PUBLIC :: nn_hdmp_tr ! = 0/-1/'latitude' for damping over passive tracer
INTEGER , PUBLIC :: nn_zdmp_tr ! = 0/1/2 flag for damping in the mixed layer
- REAL(wp), PUBLIC :: rn_surf_tr ! surface time scale for internal damping [days]
- REAL(wp), PUBLIC :: rn_bot_tr ! bottom time scale for internal damping [days]
- REAL(wp), PUBLIC :: rn_dep_tr ! depth of transition between rn_surf and rn_bot [meters]
- INTEGER , PUBLIC :: nn_file_tr ! = 1 create a damping.coeff NetCDF file
+ CHARACTER(LEN=200) , PUBLIC :: cn_resto_tr !File containing restoration coefficient
!!----------------------------------------------------------------------
@@ -77,11 +72,10 @@
& ln_trcadv_ubs , ln_trcadv_qck, ln_trcadv_msc_ups
- NAMELIST/namtrc_ldf/ ln_trcldf_diff , ln_trcldf_lap , &
+ NAMELIST/namtrc_ldf/ ln_trcldf_lap , &
& ln_trcldf_bilap, ln_trcldf_level, &
& ln_trcldf_hor , ln_trcldf_iso , rn_ahtrc_0, rn_ahtrb_0
NAMELIST/namtrc_zdf/ ln_trczdf_exp , nn_trczdf_exp
NAMELIST/namtrc_rad/ ln_trcrad
- NAMELIST/namtrc_dmp/ nn_hdmp_tr, nn_zdmp_tr, rn_surf_tr, &
- & rn_bot_tr , rn_dep_tr , nn_file_tr
+ NAMELIST/namtrc_dmp/ nn_zdmp_tr , cn_resto_tr
!!----------------------------------------------------------------------
@@ -126,5 +120,4 @@
WRITE(numout,*) '~~~~~~~~~~~'
WRITE(numout,*) ' Namelist namtrc_ldf : set lateral mixing parameters (type, direction, coefficients)'
- WRITE(numout,*) ' perform lateral diffusion or not ln_trcldf_diff = ', ln_trcldf_diff
WRITE(numout,*) ' laplacian operator ln_trcldf_lap = ', ln_trcldf_lap
WRITE(numout,*) ' bilaplacian operator ln_trcldf_bilap = ', ln_trcldf_bilap
@@ -184,10 +177,6 @@
WRITE(numout,*) '~~~~~~~'
WRITE(numout,*) ' Namelist namtrc_dmp : set damping parameter'
- WRITE(numout,*) ' tracer damping option nn_hdmp_tr = ', nn_hdmp_tr
WRITE(numout,*) ' mixed layer damping option nn_zdmp_tr = ', nn_zdmp_tr, '(zoom: forced to 0)'
- WRITE(numout,*) ' surface time scale (days) rn_surf_tr = ', rn_surf_tr
- WRITE(numout,*) ' bottom time scale (days) rn_bot_tr = ', rn_bot_tr
- WRITE(numout,*) ' depth of transition (meters) rn_dep_tr = ', rn_dep_tr
- WRITE(numout,*) ' create a damping.coeff file nn_file_tr = ', nn_file_tr
+ WRITE(numout,*) ' Restoration coeff file cn_resto_tr = ', cn_resto_tr
ENDIF
!
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90 (revision 5602)
@@ -118,5 +118,5 @@
! set time step size (Euler/Leapfrog)
IF( neuler == 0 .AND. kt == nittrc000 ) THEN ; r2dt(:) = rdttrc(:) ! at nittrc000 (Euler)
- ELSEIF( kt <= nittrc000 + 1 ) THEN ; r2dt(:) = 2.* rdttrc(:) ! at nit000 or nit000+1 (Leapfrog)
+ ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ; r2dt(:) = 2.* rdttrc(:) ! at nit000 or nit000+1 (Leapfrog)
ENDIF
@@ -137,6 +137,7 @@
ELSE
! Leap-Frog + Asselin filter time stepping
- IF( lk_vvl ) THEN ; CALL tra_nxt_vvl( kt, nittrc000, 'TRC', trb, trn, tra, jptra ) ! variable volume level (vvl)
- ELSE ; CALL tra_nxt_fix( kt, nittrc000, 'TRC', trb, trn, tra, jptra ) ! fixed volume level
+ IF( lk_vvl ) THEN ; CALL tra_nxt_vvl( kt, nittrc000, rdttrc, 'TRC', trb, trn, tra, &
+ & sbc_trc, sbc_trc_b, jptra ) ! variable volume level (vvl)
+ ELSE ; CALL tra_nxt_fix( kt, nittrc000, 'TRC', trb, trn, tra, jptra ) ! fixed volume level
ENDIF
ENDIF
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90 (revision 5602)
@@ -19,4 +19,5 @@
USE trc ! ocean passive tracers variables
USE prtctl_trc ! Print control for debbuging
+ USE iom
USE trd_oce
USE trdtra
@@ -26,4 +27,6 @@
PUBLIC trc_sbc ! routine called by step.F90
+
+ REAL(wp) :: r2dt ! time-step at surface
!! * Substitutions
@@ -60,9 +63,11 @@
INTEGER, INTENT( in ) :: kt ! ocean time-step index
!
- INTEGER :: ji, jj, jn ! dummy loop indices
- REAL(wp) :: zsrau, zse3t ! temporary scalars
+ INTEGER :: ji, jj, jn ! dummy loop indices
+ REAL(wp) :: zse3t, zrtrn, zratio, zfact ! temporary scalars
+ REAL(wp) :: zswitch, zftra, zcd, zdtra, ztfx, ztra ! temporary scalars
CHARACTER (len=22) :: charout
REAL(wp), POINTER, DIMENSION(:,: ) :: zsfx
REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrd
+
!!---------------------------------------------------------------------
!
@@ -72,4 +77,23 @@
CALL wrk_alloc( jpi, jpj, zsfx )
IF( l_trdtrc ) CALL wrk_alloc( jpi, jpj, jpk, ztrtrd )
+ !
+ zrtrn = 1.e-15_wp
+
+ SELECT CASE( nn_ice_embd ) ! levitating or embedded sea-ice option
+ CASE( 0 ) ; zswitch = 1 ! (0) standard levitating sea-ice : salt exchange only
+ CASE( 1, 2 ) ; zswitch = 0 ! (1) levitating sea-ice: salt and volume exchange but no pressure effect
+ ! (2) embedded sea-ice : salt and volume fluxes and pressure
+ END SELECT
+
+ IF( ln_top_euler) THEN
+ r2dt = rdttrc(1) ! = rdttrc (use Euler time stepping)
+ ELSE
+ IF( neuler == 0 .AND. kt == nittrc000 ) THEN ! at nittrc000
+ r2dt = rdttrc(1) ! = rdttrc (restarting with Euler time stepping)
+ ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ! at nittrc000 or nittrc000+1
+ r2dt = 2. * rdttrc(1) ! = 2 rdttrc (leapfrog)
+ ENDIF
+ ENDIF
+
IF( kt == nittrc000 ) THEN
@@ -77,4 +101,25 @@
IF(lwp) WRITE(numout,*) 'trc_sbc : Passive tracers surface boundary condition'
IF(lwp) WRITE(numout,*) '~~~~~~~ '
+
+ IF( ln_rsttr .AND. & ! Restart: read in restart file
+ iom_varid( numrtr, 'sbc_'//TRIM(ctrcnm(1))//'_b', ldstop = .FALSE. ) > 0 ) THEN
+ IF(lwp) WRITE(numout,*) ' nittrc000-nn_dttrc surface tracer content forcing fields red in the restart file'
+ zfact = 0.5_wp
+ DO jn = 1, jptra
+ CALL iom_get( numrtr, jpdom_autoglo, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc_b(:,:,jn) ) ! before tracer content sbc
+ END DO
+ ELSE ! No restart or restart not found: Euler forward time stepping
+ zfact = 1._wp
+ sbc_trc_b(:,:,:) = 0._wp
+ ENDIF
+ ELSE ! Swap of forcing fields
+ IF( ln_top_euler ) THEN
+ zfact = 1._wp
+ sbc_trc_b(:,:,:) = 0._wp
+ ELSE
+ zfact = 0.5_wp
+ sbc_trc_b(:,:,:) = sbc_trc(:,:,:)
+ ENDIF
+ !
ENDIF
@@ -90,27 +135,47 @@
! 0. initialization
- zsrau = 1. / rau0
DO jn = 1, jptra
!
IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn) ! save trends
! ! add the trend to the general tracer trend
- IF( lk_vvl ) THEN ! online coupling with vvl
-
-
+
+ IF ( nn_ice_tr == -1 ) THEN ! No tracers in sea ice (null concentration in sea ice)
+
+ DO jj = 2, jpj
+ DO ji = fs_2, fs_jpim1 ! vector opt.
+ sbc_trc(ji,jj,jn) = zsfx(ji,jj) * r1_rau0 * trn(ji,jj,1,jn)
+ END DO
+ END DO
+
+ ELSE
+
DO jj = 2, jpj
DO ji = fs_2, fs_jpim1 ! vector opt.
zse3t = 1. / fse3t(ji,jj,1)
- tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + zsfx(ji,jj) * zsrau * trn(ji,jj,1,jn) * zse3t
+ ! tracer flux at the ice/ocean interface (tracer/m2/s)
+ zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice
+ zcd = trc_o(ji,jj,jn) * fmmflx(ji,jj) ! concentration dilution due to freezing-melting,
+ ! only used in the levitating sea ice case
+ ! tracer flux only : add concentration dilution term in net tracer flux, no F-M in volume flux
+ ! tracer and mass fluxes : no concentration dilution term in net tracer flux, F-M term in volume flux
+ ztfx = zftra + zswitch * zcd ! net tracer flux (+C/D if no ice/ocean mass exchange)
+
+ zdtra = r1_rau0 * ( ztfx + zsfx(ji,jj) * trn(ji,jj,1,jn) )
+ IF ( zdtra < 0. ) THEN
+ zratio = -zdtra * zse3t * r2dt / ( trn(ji,jj,1,jn) + zrtrn )
+ zdtra = MIN(1.0, zratio) * zdtra ! avoid negative concentrations to arise
+ ENDIF
+ sbc_trc(ji,jj,jn) = zdtra
END DO
END DO
- ELSE
- DO jj = 2, jpj
- DO ji = fs_2, fs_jpim1 ! vector opt.
- zse3t = 1. / fse3t(ji,jj,1)
- tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + zsfx(ji,jj) * zsrau * trn(ji,jj,1,jn) * zse3t
- END DO
- END DO
- ENDIF
-
+ ENDIF
+ ! Concentration dilution effect on tracers due to evaporation & precipitation
+ DO jj = 2, jpj
+ DO ji = fs_2, fs_jpim1 ! vector opt.
+ zse3t = zfact / fse3t(ji,jj,1)
+ tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t
+ END DO
+ END DO
+ !
IF( l_trdtrc ) THEN
ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:)
@@ -120,4 +185,17 @@
END DO ! tracer loop
! ! ===========
+
+ ! Write in the tracer restar file
+ ! *******************************
+ IF( lrst_trc ) THEN
+ IF(lwp) WRITE(numout,*)
+ IF(lwp) WRITE(numout,*) 'sbc : ocean surface tracer content forcing fields written in tracer restart file ', &
+ & 'at it= ', kt,' date= ', ndastp
+ IF(lwp) WRITE(numout,*) '~~~~'
+ DO jn = 1, jptra
+ CALL iom_rstput( kt, nitrst, numrtw, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc(:,:,jn) )
+ END DO
+ ENDIF
+ !
IF( ln_ctl ) THEN
WRITE(charout, FMT="('sbc ')") ; CALL prt_ctl_trc_info(charout)
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90 (revision 5602)
@@ -108,7 +108,12 @@
! Partial steps: now horizontal gradient of passive
IF( ln_zps )THEN
- IF( ln_crs_top ) THEN ; CALL zps_hde_crs( kstp, jptra, trn, gtru, gtrv )
- ELSE ; CALL zps_hde( kstp, jptra, trn, pgtu=gtru, pgtv=gtrv, sgtu=gtrui, sgtv=gtrvi )
- ENDIF
+ IF( ln_crs_top ) THEN
+ CALL zps_hde_crs( kstp, jptra, trn, gtru, gtrv )
+ ELSE
+ IF( ln_isfcav) &
+ CALL zps_hde_isf( kstp, jptra, trn, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi ) ! Partial steps: now horizontal gradient of passive
+ ELSE
+ CALL zps_hde ( kstp, jptra, trn, gtru, gtrv ) ! Partial steps: now horizontal gradient of passive
+ ENDIF
ENDIF
! tracers at the bottom ocean level
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90 (revision 5602)
@@ -73,12 +73,8 @@
IF( kt == nittrc000 ) CALL zdf_ctl ! initialisation & control of options
- IF( ln_top_euler) THEN
- r2dt(:) = rdttrc(:) ! = rdttrc (use Euler time stepping)
- ELSE
- IF( neuler == 0 .AND. kt == nittrc000 ) THEN ! at nittrc000
- r2dt(:) = rdttrc(:) ! = rdttrc (restarting with Euler time stepping)
- ELSEIF( kt <= nittrc000 + 1 ) THEN ! at nittrc000 or nittrc000+1
- r2dt(:) = 2. * rdttrc(:) ! = 2 rdttrc (leapfrog)
- ENDIF
+ IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN ! at nittrc000
+ r2dt(:) = rdttrc(:) ! = rdttrc (use or restarting with Euler time stepping)
+ ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ! at nittrc000 or nittrc000+1
+ r2dt(:) = 2. * rdttrc(:) ! = 2 rdttrc (leapfrog)
ENDIF
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc.F90 (revision 5602)
@@ -71,5 +71,5 @@
!!----------------------------------------------------------------------
!! NEMO/TOP 3.3 , NEMO Consortium (2010)
- !! $Header: $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc_rst.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc_rst.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc_rst.F90 (revision 5602)
@@ -23,5 +23,5 @@
!!---------------------------------------------------------------------------------
!! NEMO/TOP 3.3 , NEMO Consortium (2010)
- !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/TRD/trdmxl_rst.F90,v 1.6 2006/11/14 09:46:13 opalod Exp $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!---------------------------------------------------------------------------------
@@ -39,5 +39,6 @@
!
CHARACTER(LEN=20) :: clkt ! ocean time-step deine as a character
- CHARACTER(LEN=50) :: clname ! ice output restart file name
+ CHARACTER(LEN=50) :: clname ! output restart file name
+ CHARACTER(LEN=256) :: clpath ! full path to restart file
CHARACTER (len=35) :: charout
INTEGER :: jl, jk, jn ! loop indice
@@ -51,6 +52,8 @@
ENDIF
clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trdrst_trc_out)
- IF(lwp) WRITE(numout,*) ' open ocean restart_mld_trc NetCDF '//clname
- CALL iom_open( clname, nummldw_trc, ldwrt = .TRUE., kiolib = jprstlib )
+ clpath = TRIM(cn_trcrst_outdir)
+ IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
+ IF(lwp) WRITE(numout,*) ' open ocean restart_mld_trc NetCDF 'TRIM(clpath)//TRIM(clname)
+ CALL iom_open( TRIM(clpath)//TRIM(clname), nummldw_trc, ldwrt = .TRUE., kiolib = jprstlib )
ENDIF
@@ -133,4 +136,5 @@
INTEGER :: jlibalt = jprstlib
LOGICAL :: llok
+ CHARACTER(LEN=256) :: clpath ! full path to restart file
!!-----------------------------------------------------------------------------
@@ -141,12 +145,15 @@
ENDIF
+ clpath = TRIM(cn_trcrst_indir)
+ IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
+
IF ( jprstlib == jprstdimg ) THEN
! eventually read netcdf file (monobloc) for restarting on different number of processors
! if {cn_trdrst_trc_in}.nc exists, then set jlibalt to jpnf90
- INQUIRE( FILE = TRIM(cn_trdrst_trc_in)//'.nc', EXIST = llok )
+ INQUIRE( FILE = TRIM(clpath)//TRIM(cn_trdrst_trc_in)//'.nc', EXIST = llok )
IF ( llok ) THEN ; jlibalt = jpnf90 ; ELSE ; jlibalt = jprstlib ; ENDIF
ENDIF
- CALL iom_open( cn_trdrst_trc_in, inum, kiolib = jlibalt )
+ CALL iom_open( TRIM(clpath)//TRIM(cn_trdrst_trc_in), inum, kiolib = jlibalt )
IF( ln_trdmxl_trc_instant ) THEN
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc.F90 (revision 5602)
@@ -33,5 +33,5 @@
!!----------------------------------------------------------------------
!! NEMO/TOP 3.3 , NEMO Consortium (2010)
- !! $Header: $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc_oce.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc_oce.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc_oce.F90 (revision 5602)
@@ -118,5 +118,5 @@
!!----------------------------------------------------------------------
!! NEMO/TOP 3.3 , NEMO Consortium (2010)
- !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/TRD/trdmxl_oce.F90,v 1.2 2005/03/27 18:35:23 opalod Exp $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90 (revision 5602)
@@ -346,7 +346,9 @@
USE sbc_oce , ONLY : fmmflx => fmmflx !: freshwater budget: volume flux [Kg/m2/s]
USE sbc_oce , ONLY : rnf => rnf !: river runoff [Kg/m2/s]
- USE sbc_oce , ONLY : ln_dm2dc => ln_dm2dc !: Daily mean to Diurnal Cycle short wave (qsr)
+ USE sbc_oce , ONLY : ln_dm2dc => ln_dm2dc !: Diurnal Cycle
+ USE sbc_oce , ONLY : ncpl_qsr_freq => ncpl_qsr_freq !: qsr coupling frequency per days from atmospher
USE sbc_oce , ONLY : ln_rnf => ln_rnf !: runoffs / runoff mouths
USE sbc_oce , ONLY : fr_i => fr_i !: ice fraction (between 0 to 1)
+ USE sbc_oce , ONLY : nn_ice_embd => nn_ice_embd !: flag for levitating/embedding sea-ice in the ocean
USE traqsr , ONLY : rn_abs => rn_abs !: fraction absorbed in the very near surface
USE traqsr , ONLY : rn_si0 => rn_si0 !: very near surface depth of extinction
@@ -355,4 +357,5 @@
USE sbcrnf , ONLY : rnfmsk_z => rnfmsk_z !: mixed adv scheme in runoffs vicinity (vert.)
USE sbcrnf , ONLY : h_rnf => h_rnf !: river runoff [Kg/m2/s]
+ USE sbcrnf , ONLY : nk_rnf => nk_rnf !: depth of runoff in model level
USE trc_oce
@@ -394,5 +397,8 @@
# endif
+ USE diaar5 , ONLY : lk_diaar5 => lk_diaar5
+
#endif
+
#else
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trc.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trc.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trc.F90 (revision 5602)
@@ -34,7 +34,13 @@
REAL(wp), PUBLIC :: areatot !: total volume
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,: ) :: cvol !: volume correction -degrad option-
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: trn !: traceur concentration for now time step
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: tra !: traceur concentration for next time step
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: trb !: traceur concentration for before time step
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: trn !: tracer concentration for now time step
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: tra !: tracer concentration for next time step
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: trb !: tracer concentration for before time step
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,: ) :: sbc_trc_b !: Before sbc fluxes for tracers
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,: ) :: sbc_trc !: Now sbc fluxes for tracers
+
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,: ) :: trc_i !: prescribed tracer concentration in sea ice for SBC
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,: ) :: trc_o !: prescribed tracer concentration in ocean for SBC
+ INTEGER , PUBLIC :: nn_ice_tr !: handling of sea ice tracers
!! interpolated gradient
@@ -44,4 +50,5 @@
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gtrui !: hor. gradient at u-points at top ocean level
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gtrvi !: hor. gradient at v-points at top ocean level
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsr_mean !: daily mean qsr
!! passive tracers (input and output)
@@ -54,5 +61,7 @@
INTEGER , PUBLIC :: nn_rsttr !: control of the time step ( 0 or 1 ) for pass. tr.
CHARACTER(len = 80) , PUBLIC :: cn_trcrst_in !: suffix of pass. tracer restart name (input)
+ CHARACTER(len = 256), PUBLIC :: cn_trcrst_indir !: restart input directory
CHARACTER(len = 80) , PUBLIC :: cn_trcrst_out !: suffix of pass. tracer restart name (output)
+ CHARACTER(len = 256), PUBLIC :: cn_trcrst_outdir !: restart output directory
REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: rdttrc !: vertical profile of passive tracer time step
LOGICAL , PUBLIC :: ln_top_euler !: boolean term for euler integration
@@ -61,4 +70,17 @@
LOGICAL , PUBLIC :: ln_trcdmp_clo !: internal damping flag on closed seas
INTEGER , PUBLIC :: nittrc000 !: first time step of passive tracers model
+ LOGICAL , PUBLIC :: l_trcdm2dc !: Diurnal cycle for TOP
+
+ !! Information for the ice module for tracers
+ !! ------------------------------------------
+ TYPE TRC_I_NML !--- Ice tracer namelist structure
+ REAL(wp) :: trc_ratio ! ice-ocean trc ratio
+ REAL(wp) :: trc_prescr ! prescribed ice trc cc
+ CHARACTER(len=2) :: ctrc_o ! choice of ocean trc cc
+ END TYPE
+
+ REAL(wp), DIMENSION(jptra), PUBLIC :: trc_ice_ratio, & ! ice-ocean tracer ratio
+ trc_ice_prescr ! prescribed ice trc cc
+ CHARACTER(len=2), DIMENSION(jptra), PUBLIC :: cn_trc_o ! choice of ocean tracer cc
!! information for outputs
@@ -172,5 +194,5 @@
!!----------------------------------------------------------------------
!! NEMO/TOP 3.3.1 , NEMO Consortium (2010)
- !! $Id$
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
@@ -185,9 +207,11 @@
!
ALLOCATE( trn(jpi,jpj,jpk,jptra), trb(jpi,jpj,jpk,jptra), tra(jpi,jpj,jpk,jptra), &
+ & 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) , &
+ & sbc_trc_b(jpi,jpj,jptra), sbc_trc(jpi,jpj,jptra) , &
& cvol(jpi,jpj,jpk) , rdttrc(jpk) , trai(jptra) , &
& ctrcnm(jptra) , ctrcln(jptra) , ctrcun(jptra) , &
- & ln_trc_ini(jptra) , ln_trc_wri(jptra) , STAT = trc_alloc )
+ & ln_trc_ini(jptra) , ln_trc_wri(jptra) , qsr_mean(jpi,jpj) , STAT = trc_alloc )
IF( trc_alloc /= 0 ) CALL ctl_warn('trc_alloc: failed to allocate arrays')
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcbc.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcbc.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcbc.F90 (revision 5602)
@@ -44,5 +44,5 @@
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , NEMO Consortium (2010)
- !! $Id: trcdta.F90 2977 2011-10-22 13:46:41Z cetlod $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcdta.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcdta.F90 (revision 5602)
@@ -222,4 +222,9 @@
sf_dta(1)%fnow(ji,jj,ik) = (1.-zl) * sf_dta(1)%fnow(ji,jj,ik) + zl * sf_dta(1)%fnow(ji,jj,ik-1)
ENDIF
+ ik = mikt(ji,jj)
+ IF( ik > 1 ) THEN
+ zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) )
+ sf_dta(1)%fnow(ji,jj,ik) = (1.-zl) * sf_dta(1)%fnow(ji,jj,ik) + zl * sf_dta(1)%fnow(ji,jj,ik+1)
+ ENDIF
END DO
END DO
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcice.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcice.F90 (revision 5602)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcice.F90 (revision 5602)
@@ -0,0 +1,73 @@
+MODULE trcice
+ !!======================================================================
+ !! *** MODULE trcice ***
+ !! TOP : Manage the communication between TOP and sea ice
+ !!======================================================================
+ !! History : 3.5 ! 2013 (M. Vancoppenolle, O. Aumont, G. Madec), original code
+ !!----------------------------------------------------------------------
+#if defined key_top
+ !!----------------------------------------------------------------------
+ !! 'key_top' TOP models
+ !!----------------------------------------------------------------------
+ !! trc_ice : Call the appropriate sea ice tracer subroutine
+ !!----------------------------------------------------------------------
+
+ USE oce_trc ! shared variables between ocean and passive tracers
+ USE trc ! passive tracers common variables
+ USE trcice_cfc ! CFC initialisation
+ USE trcice_pisces ! PISCES initialisation
+ USE trcice_c14b ! C14 bomb initialisation
+ USE trcice_my_trc ! MY_TRC initialisation
+
+ IMPLICIT NONE
+ PRIVATE
+
+ PUBLIC trc_ice_ini ! called by trc_nam
+
+CONTAINS
+
+ SUBROUTINE trc_ice_ini
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE trc_ice_ini ***
+ !!
+ !! ** Purpose : Initialization of the ice module for tracers
+ !!
+ !! ** Method : -
+ !!
+ !!---------------------------------------------------------------------
+ ! --- Variable declarations --- !
+
+ IF(lwp) THEN
+ WRITE(numout,*)
+ WRITE(numout,*) 'trc_ice_ini : Initialize sea ice tracer boundary condition'
+ WRITE(numout,*) '~~~~~~~~~~~~~'
+ ENDIF
+
+ IF( nn_timing == 1 ) CALL timing_start('trc_ice_ini')
+
+ !
+ trc_i(:,:,:) = 0.0d0 ! by default
+ trc_o(:,:,:) = 0.0d0 ! by default
+
+ IF ( nn_ice_tr == 1 ) THEN
+ IF( lk_pisces ) CALL trc_ice_ini_pisces ! PISCES bio-model
+ IF( lk_cfc ) CALL trc_ice_ini_cfc ! CFC tracers
+ IF( lk_c14b ) CALL trc_ice_ini_c14b ! C14 bomb tracer
+ IF( lk_my_trc ) CALL trc_ice_ini_my_trc ! MY_TRC tracers
+ ENDIF
+
+ IF( nn_timing == 1 ) CALL timing_stop('trc_ice_ini')
+ !
+ END SUBROUTINE trc_ice_ini
+
+#else
+ !!----------------------------------------------------------------------
+ !! Empty module : No passive tracer
+ !!----------------------------------------------------------------------
+CONTAINS
+ SUBROUTINE trc_ice_ini ! Dummy routine
+ END SUBROUTINE trc_ice_ini
+#endif
+
+ !!======================================================================
+END MODULE trcice
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcini.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcini.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcini.F90 (revision 5602)
@@ -33,4 +33,5 @@
USE crs , ONLY : ln_crs
USE dom_oce, ONLY : nn_cla
+ USE trcice ! tracers in sea ice
IMPLICIT NONE
@@ -73,9 +74,9 @@
CALL top_alloc() ! allocate TOP arrays
-#if defined key_offline
- ltrcdm2dc = .FALSE.
-#endif
-
- IF( ltrcdm2dc )CALL ctl_warn( ' Diurnal cycle on physics but not in PISCES or LOBSTER ' )
+ l_trcdm2dc = ln_dm2dc .OR. ( ln_cpl .AND. ncpl_qsr_freq /= 1 )
+ l_trcdm2dc = l_trcdm2dc .AND. .NOT. lk_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) ')
IF( nn_cla == 1 ) &
@@ -102,4 +103,6 @@
IF( lk_c14b ) CALL trc_ini_c14b ! C14 bomb tracer
IF( lk_my_trc ) CALL trc_ini_my_trc ! MY_TRC tracers
+
+ CALL trc_ice_ini ! Tracers in sea ice
IF( lwp ) THEN
@@ -149,7 +152,11 @@
CALL zps_hde_crs( nit000, jptra, trn, gtru, gtrv )
ELSE
- CALL zps_hde( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, sgtu=gtrui, sgtv=gtrvi )! tracers at the bottom ocean level
+ IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav ) & ! Partial steps: before horizontal gradient of passive
+ & CALL zps_hde ( nit000, jptra, trn, gtru, gtrv ) ! Partial steps: before horizontal gradient
+ IF( ln_zps .AND. .NOT. lk_c1d .AND. ln_isfcav ) &
+ & CALL zps_hde_isf( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi ) ! tracers at the bottom ocean level
ENDIF
ENDIF
+
!
IF( nn_dttrc /= 1 ) CALL trc_sub_ini ! Initialize variables for substepping passive tracers
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcnam.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcnam.F90 (revision 5602)
@@ -39,5 +39,5 @@
!!----------------------------------------------------------------------
!! NEMO/TOP 3.3 , NEMO Consortium (2010)
- !! $Id$
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
@@ -147,4 +147,8 @@
+ ! Call the ice module for tracers
+ ! -------------------------------
+ CALL trc_nam_ice
+
! namelist of SMS
! ---------------
@@ -175,5 +179,6 @@
!!---------------------------------------------------------------------
NAMELIST/namtrc_run/ nn_dttrc, nn_writetrc, ln_rsttr, nn_rsttr, ln_top_euler, &
- & cn_trcrst_in, cn_trcrst_out
+ & cn_trcrst_indir, cn_trcrst_outdir, cn_trcrst_in, cn_trcrst_out
+
INTEGER :: ios ! Local integer output status for namelist read
@@ -215,4 +220,54 @@
END SUBROUTINE trc_nam_run
+ SUBROUTINE trc_nam_ice
+ !!---------------------------------------------------------------------
+ !! *** ROUTINE trc_nam_ice ***
+ !!
+ !! ** Purpose : Read the namelist for the ice effect on tracers
+ !!
+ !! ** Method : -
+ !!
+ !!---------------------------------------------------------------------
+ ! --- Variable declarations --- !
+ INTEGER :: jn ! dummy loop indices
+ INTEGER :: ios ! Local integer output status for namelist read
+
+ ! --- Namelist declarations --- !
+ TYPE(TRC_I_NML), DIMENSION(jptra) :: sn_tri_tracer
+ NAMELIST/namtrc_ice/ nn_ice_tr, sn_tri_tracer
+
+ IF(lwp) THEN
+ WRITE(numout,*)
+ WRITE(numout,*) 'trc_nam_ice : Read the namelist for trc_ice'
+ WRITE(numout,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+ ENDIF
+
+ IF( nn_timing == 1 ) CALL timing_start('trc_nam_ice')
+
+ !
+ REWIND( numnat_ref ) ! Namelist namtrc_ice in reference namelist : Passive tracer input data
+ READ ( numnat_ref, namtrc_ice, IOSTAT = ios, ERR = 901)
+ 901 IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtrc_ice in reference namelist ', lwp )
+
+ REWIND( numnat_cfg ) ! Namelist namtrc_ice in configuration namelist : Pisces external sources of nutrients
+ READ ( numnat_cfg, namtrc_ice, IOSTAT = ios, ERR = 902 )
+ 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ice in configuration namelist', lwp )
+
+ IF( lwp ) THEN
+ WRITE(numout,*) ' '
+ WRITE(numout,*) ' Sea ice tracers option (nn_ice_tr) : ', nn_ice_tr
+ WRITE(numout,*) ' '
+ ENDIF
+
+ ! Assign namelist stuff
+ DO jn = 1, jptra
+ trc_ice_ratio(jn) = sn_tri_tracer(jn)%trc_ratio
+ trc_ice_prescr(jn) = sn_tri_tracer(jn)%trc_prescr
+ cn_trc_o (jn) = sn_tri_tracer(jn)%ctrc_o
+ END DO
+
+ IF( nn_timing == 1 ) CALL timing_stop('trc_nam_ice')
+ !
+ END SUBROUTINE trc_nam_ice
SUBROUTINE trc_nam_trc
@@ -339,5 +394,5 @@
!!----------------------------------------------------------------------
!! NEMO/TOP 3.3 , NEMO Consortium (2010)
- !! $Id$
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!======================================================================
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcrst.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcrst.F90 (revision 5602)
@@ -54,4 +54,5 @@
CHARACTER(LEN=20) :: clkt ! ocean time-step define as a character
CHARACTER(LEN=50) :: clname ! trc output restart file name
+ CHARACTER(LEN=256) :: clpath ! full path to ocean output restart file
!!----------------------------------------------------------------------
!
@@ -59,8 +60,13 @@
IF( kt == nittrc000 ) THEN
lrst_trc = .FALSE.
- nitrst = nitend
- ENDIF
-
- IF( MOD( kt - 1, nstock ) == 0 ) THEN
+ IF( ln_rst_list ) THEN
+ nrst_lst = 1
+ nitrst = nstocklist( nrst_lst )
+ ELSE
+ nitrst = nitend
+ ENDIF
+ ENDIF
+
+ IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN
! we use kt - 1 and not kt - nittrc000 to keep the same periodicity from the beginning of the experiment
nitrst = kt + nstock - 1 ! define the next value of nitrst for restart writing
@@ -82,6 +88,9 @@
IF(lwp) WRITE(numout,*)
clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trcrst_out)
- IF(lwp) WRITE(numout,*) ' open trc restart.output NetCDF file: '//clname
- CALL iom_open( clname, numrtw, ldwrt = .TRUE., kiolib = jprstlib )
+ clpath = TRIM(cn_trcrst_outdir)
+ IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
+ IF(lwp) WRITE(numout,*) &
+ ' open trc restart.output NetCDF file: ',TRIM(clpath)//clname
+ CALL iom_open( TRIM(clpath)//TRIM(clname), numrtw, ldwrt = .TRUE., kiolib = jprstlib )
lrst_trc = .TRUE.
ENDIF
@@ -143,4 +152,8 @@
lrst_trc = .FALSE.
#endif
+ IF( lk_offline .AND. ln_rst_list ) THEN
+ nrst_lst = nrst_lst + 1
+ nitrst = nstocklist( nrst_lst )
+ ENDIF
ENDIF
!
@@ -193,39 +206,36 @@
! eventually read netcdf file (monobloc) for restarting on different number of processors
! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90
- INQUIRE( FILE = TRIM(cn_trcrst_in)//'.nc', EXIST = llok )
+ INQUIRE( FILE = TRIM(cn_trcrst_indir)//'/'//TRIM(cn_trcrst_in)//'.nc', EXIST = llok )
IF ( llok ) THEN ; jlibalt = jpnf90 ; ELSE ; jlibalt = jprstlib ; ENDIF
ENDIF
- CALL iom_open( cn_trcrst_in, numrtr, kiolib = jlibalt )
-
- CALL iom_get ( numrtr, 'kt', zkt ) ! last time-step of previous run
-
- IF(lwp) THEN
- WRITE(numout,*) ' *** Info read in restart : '
- WRITE(numout,*) ' previous time-step : ', NINT( zkt )
- WRITE(numout,*) ' *** restart option'
- SELECT CASE ( nn_rsttr )
- CASE ( 0 ) ; WRITE(numout,*) ' nn_rsttr = 0 : no control of nittrc000'
- CASE ( 1 ) ; WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)'
- CASE ( 2 ) ; WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart'
- END SELECT
- WRITE(numout,*)
- ENDIF
- ! Control of date
- IF( nittrc000 - NINT( zkt ) /= nn_dttrc .AND. nn_rsttr /= 0 ) &
- & CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart', &
- & ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' )
- IF( lk_offline ) THEN ! set the date in offline mode
- ! Check dynamics and tracer time-step consistency and force Euler restart if changed
- IF( iom_varid( numrtr, 'rdttrc1', ldstop = .FALSE. ) > 0 ) THEN
- CALL iom_get( numrtr, 'rdttrc1', zrdttrc1 )
- IF( zrdttrc1 /= rdt * nn_dttrc ) neuler = 0
- ENDIF
- ! ! define ndastp and adatrj
- IF( nn_rsttr == 2 ) THEN
+ IF( ln_rsttr ) THEN
+ CALL iom_open( TRIM(cn_trcrst_indir)//'/'//cn_trcrst_in, numrtr, kiolib = jlibalt )
+ CALL iom_get ( numrtr, 'kt', zkt ) ! last time-step of previous run
+
+ IF(lwp) THEN
+ WRITE(numout,*) ' *** Info read in restart : '
+ WRITE(numout,*) ' previous time-step : ', NINT( zkt )
+ WRITE(numout,*) ' *** restart option'
+ SELECT CASE ( nn_rsttr )
+ CASE ( 0 ) ; WRITE(numout,*) ' nn_rsttr = 0 : no control of nittrc000'
+ CASE ( 1 ) ; WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)'
+ CASE ( 2 ) ; WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart'
+ END SELECT
+ WRITE(numout,*)
+ ENDIF
+ ! Control of date
+ IF( nittrc000 - NINT( zkt ) /= nn_dttrc .AND. nn_rsttr /= 0 ) &
+ & CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart', &
+ & ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' )
+ ENDIF
+ !
+ IF( lk_offline ) THEN
+ ! ! set the date in offline mode
+ IF( ln_rsttr .AND. nn_rsttr == 2 ) THEN
CALL iom_get( numrtr, 'ndastp', zndastp )
ndastp = NINT( zndastp )
CALL iom_get( numrtr, 'adatrj', adatrj )
- ELSE
+ ELSE
ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam
adatrj = ( REAL( nittrc000-1, wp ) * rdttra(1) ) / rday
@@ -238,4 +248,8 @@
WRITE(numout,*) ' number of elapsed days since the begining of run : ', adatrj
WRITE(numout,*)
+ ENDIF
+ !
+ IF( ln_rsttr ) THEN ; neuler = 1
+ ELSE ; neuler = 0
ENDIF
!
@@ -268,4 +282,5 @@
INTEGER :: jk, jn
REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift
+ REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol
!!----------------------------------------------------------------------
@@ -276,6 +291,10 @@
ENDIF
!
- DO jn = 1, jptra
- ztraf = glob_sum( trn(:,:,:,jn) * cvol(:,:,:) )
+ DO jk = 1, jpk
+ zvol(:,:,jk) = e1e2t(:,:) * fse3t_a(:,:,jk) * tmask(:,:,jk)
+ END DO
+ !
+ DO jn = 1, jptra
+ ztraf = glob_sum( trn(:,:,:,jn) * zvol(:,:,:) )
zmin = MINVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
zmax = MAXVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
@@ -309,5 +328,5 @@
!!----------------------------------------------------------------------
!! NEMO/TOP 3.3 , NEMO Consortium (2010)
- !! $Id$
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!======================================================================
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcstp.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcstp.F90 (revision 5602)
@@ -31,4 +31,10 @@
PUBLIC trc_stp ! called by step
+ REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE :: qsr_arr ! save qsr during TOP time-step
+ REAL(wp) :: rdt_sampl
+ INTEGER :: nb_rec_per_days
+ INTEGER :: isecfst, iseclast
+ LOGICAL :: llnew
+
!! * Substitutions
# include "domzgr_substitute.h90"
@@ -55,5 +61,4 @@
CHARACTER (len=25) :: charout
- REAL(wp), DIMENSION(:,:), POINTER :: zqsr_tmp ! save qsr during TOP time-step
!!-------------------------------------------------------------------
!
@@ -69,12 +74,6 @@
areatot = glob_sum( cvol(:,:,:) )
ENDIF
- !
- IF( ltrcdm2dc ) THEN
- ! When Diurnal cycle, core bulk and LIM2 are activated, put daily mean qsr in qsr for TOP/biogeochemistery time-step
- ! and save qsr with diurnal cycle in qsr_tmp
- CALL wrk_alloc( jpi,jpj, zqsr_tmp )
- zqsr_tmp(:,:) = qsr (:,:)
- qsr (:,:) = qsr_mean(:,:)
- ENDIF
+ !
+ IF( l_trcdm2dc ) CALL trc_mean_qsr( kt )
!
IF( nn_dttrc /= 1 ) CALL trc_sub_stp( kt ) ! averaging physical variables for sub-stepping
@@ -107,10 +106,4 @@
ENDIF
!
- IF( ltrcdm2dc ) THEN
- ! put back qsr with diurnal cycle in qsr
- qsr(:,:) = zqsr_tmp(:,:)
- CALL wrk_dealloc( jpi,jpj, zqsr_tmp )
- ENDIF
- !
ztrai = 0._wp ! content of all tracers
DO jn = 1, jptra
@@ -123,4 +116,60 @@
!
END SUBROUTINE trc_stp
+
+ SUBROUTINE trc_mean_qsr( kt )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE trc_mean_qsr ***
+ !!
+ !! ** Purpose : Compute daily mean qsr for biogeochemical model in case
+ !! of diurnal cycle
+ !!
+ !! ** Method : store in TOP the qsr every hour ( or every time-step the latter
+ !! is greater than 1 hour ) and then, compute the mean with
+ !! a moving average over 24 hours.
+ !! In coupled mode, the sampling is done at every coupling frequency
+ !!----------------------------------------------------------------------
+ INTEGER, INTENT(in) :: kt
+ INTEGER :: jn
+
+ IF( kt == nittrc000 ) THEN
+ IF( ln_cpl ) THEN
+ rdt_sampl = 86400. / ncpl_qsr_freq
+ nb_rec_per_days = ncpl_qsr_freq
+ ELSE
+ rdt_sampl = MAX( 3600., rdt * nn_dttrc )
+ nb_rec_per_days = INT( 86400 / rdt_sampl )
+ ENDIF
+ !
+ IF( lwp ) THEN
+ WRITE(numout,*)
+ WRITE(numout,*) ' Sampling frequency dt = ', rdt_sampl, 's',' Number of sampling per day nrec = ', nb_rec_per_days
+ WRITE(numout,*)
+ ENDIF
+ !
+ ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_days ) )
+ DO jn = 1, nb_rec_per_days
+ qsr_arr(:,:,jn) = qsr(:,:)
+ ENDDO
+ qsr_mean(:,:) = qsr(:,:)
+ !
+ isecfst = nsec_year + nsec1jan000 ! number of seconds between Jan. 1st 00h of nit000 year and the middle of time step
+ iseclast = isecfst
+ !
+ ENDIF
+ !
+ iseclast = nsec_year + nsec1jan000
+ llnew = ( iseclast - isecfst ) > INT( rdt_sampl ) ! new shortwave to store
+ IF( kt /= nittrc000 .AND. llnew ) THEN
+ IF( lwp ) WRITE(numout,*) ' New shortwave to sample for TOP at time kt = ', kt, &
+ & ' time = ', (iseclast+rdt*nn_dttrc/2.)/3600.,'hours '
+ isecfst = iseclast
+ DO jn = 1, nb_rec_per_days - 1
+ qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1)
+ ENDDO
+ qsr_arr (:,:,nb_rec_per_days) = qsr(:,:)
+ qsr_mean(:,: ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_days
+ ENDIF
+ !
+ END SUBROUTINE trc_mean_qsr
#else
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcsub.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcsub.F90 (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/trcsub.F90 (revision 5602)
@@ -48,5 +48,5 @@
!!----------------------------------------------------------------------
!! NEMO/TOP 3.3 , NEMO Consortium (2010)
- !! $Id: trcstp.F90 2528 2010-12-27 17:33:53Z rblod $
+ !! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-IBM_EKMAN_INGV
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-IBM_EKMAN_INGV (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-IBM_EKMAN_INGV (revision 5602)
@@ -2,5 +2,5 @@
#!
#BSUB -q long
-#BSUB -n NPROCS
+#BSUB -n TOTAL_NPROCS
#BSUB -J MPI_config
#BSUB -o stdout.%J
@@ -14,4 +14,5 @@
#
OCEANCORES=NPROCS
+ XIOS_NUMPROCS=NXIOPROCS
export SETTE_DIR=DEF_SETTE_DIR
@@ -23,7 +24,11 @@
#
+ MPIPROGINF=detail
+ export MPIPROGINF
+ export LSF_PJL_TYPE="intelmpi"
+ export MP_PGMMODEL=mpmd
+ export MP_SHARED_MEMORY=yes
export MPIRUN="mpirun -n $OCEANCORES"
-
-#export MPIRUN="mpirun -np"
+ export MPIRUN_MPMD="mpirun -np $OCEANCORES ./opa : -np $XIOS_NUMPROCS /home/delrosso/XIOS_1.0/xios-1.0/bin/xios_server.exe"
#
@@ -67,7 +72,11 @@
if [ MPI_FLAG == "yes" ]; then
- time ${MPIRUN} ./opa
+ if [ $XIOS_NUMPROCS -eq 0 ]; then
+ time ${MPIRUN} ./opa
+ else
+ time ${MPIRUN_MPMD}
+ fi
else
- time ./opa
+ time ./opa
fi
#
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-PW7_MONSOON
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-PW7_MONSOON (revision 5602)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-PW7_MONSOON (revision 5602)
@@ -0,0 +1,89 @@
+#!/bin/bash
+#!
+# @ shell = /usr/bin/ksh
+# @ job_name = MPI_config
+# @ output = out.$(job_name).$(jobid)
+# @ error = err.$(job_name).$(jobid)
+# @ job_type = parallel
+# @ total_tasks = NPROCS
+# @ wall_clock_limit = 0:30:00
+# @ resources = ConsumableMemory(1562mb)
+# @ class = parallel
+# @ node_usage = shared
+# @ notification = error
+# @ task_affinity = core
+# @ queue
+
+ulimit -c unlimited
+ulimit -s unlimited
+#
+# Test specific settings. Do not hand edit these lines; the fcm_job.sh script will set these
+# (via sed operating on this template job file).
+#
+ OCEANCORES=NPROCS
+ export SETTE_DIR=DEF_SETTE_DIR
+
+###############################################################
+#
+# set up mpp computing environment
+#
+# Local settings for machine IBM Power7 (hpc2e at UK Met Office)
+#
+export MPIRUN="poe -pgmodel $MP_PGMMODEL -n $OCEANCORES -cmdfile"
+
+#
+# load sette functions (only post_test_tidyup needed)
+#
+ . ${SETTE_DIR}/all_functions.sh
+
+# Don't remove neither change the following comment line
+# BODY
+
+
+#
+# These variables are needed by post_test_tidyup function in all_functions.sh
+#
+ export EXE_DIR=DEF_EXE_DIR
+ export INPUT_DIR=DEF_INPUT_DIR
+ export CONFIG_DIR=DEF_CONFIG_DIR
+ export NEMO_VALIDATION_DIR=DEF_NEMO_VALIDATION
+ export NEW_CONF=DEF_NEW_CONF
+ export CMP_NAM=DEF_CMP_NAM
+ export TEST_NAME=DEF_TEST_NAME
+#
+# end of set up
+
+
+###############################################################
+#
+# change to the working directory
+#
+cd ${EXE_DIR}
+
+ echo Running on host `hostname`
+ echo Time is `date`
+ echo Directory is `pwd`
+#
+# Run the parallel MPI executable
+#
+ if [ MPI_FLAG == "yes" ]; then
+ n=1
+ echo "./opa" > ./alltasks
+ while [ $n -lt $OCEANCORES ]
+ do
+ echo "./opa" >> ./alltasks
+ n=$(( $n + 1 ))
+ done
+ time ${MPIRUN} ./alltasks
+ else
+ time ./opa
+ fi
+
+
+#
+ post_test_tidyup
+
+# END_BODY
+# Don't remove neither change the previous comment line
+
+ exit
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_CURIE
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_CURIE (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_CURIE (revision 5602)
@@ -8,5 +8,5 @@
#MSUB -n NPROCS # Total number of mpi task to use
#### #MSUB -N 2 # number of nodes to use
-#MSUB -A gen0826 # project name
+#MSUB -ra2286 # project name
#MSUB -q standard # (queue name) only for thin nodes
##########################################################################
@@ -33,6 +33,6 @@
module unload netcdf
module unload hdf5
-module load netcdf/4.2_hdf5_parallel
-module load hdf5/1.8.9_parallel
+module load netcdf/4.3.3.1_hdf5_parallel
+module load hdf5/1.8.12_parallel
# Don't remove neither change the following line
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-XC40_METO
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-XC40_METO (revision 5602)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-XC40_METO (revision 5602)
@@ -0,0 +1,95 @@
+#/bin/bash
+#!
+#PBS -N nemo_sette
+#PBS -l walltime=00:30:00
+#PBS -j oe
+#PBS -q QUEUE
+#PBS -l SELECT
+
+ export PBS_O_WORKDIR=$(readlink -f $PBS_O_WORKDIR)
+ export OMP_NUM_THREADS=1
+ cd $PBS_O_WORKDIR
+ export XIO_HOME=/projects/ocean/nemo/xios/xios_1.0_r618_20150619/XIOS
+#
+ echo " ";
+ export OMP_NUM_THREADS=1
+ O_PER_NODE=32
+ X_PER_NODE=4
+ OCORES=NPROCS
+ XCORES=NXIOPROCS
+ if [ $OCORES -le 32 ] ; then O_PER_NODE=$OCORES; fi
+ export SETTE_DIR=DEF_SETTE_DIR
+
+###############################################################
+#
+#
+# load sette functions (only post_test_tidyup needed)
+#
+ . ${SETTE_DIR}/all_functions.sh
+###############################################################
+#
+# Don't remove neither change the following line
+# BODY
+#
+# Test specific settings. Do not hand edit these lines; the fcm_job.sh script will set these
+# (via sed operating on this template job file). Note that the number of compute nodes required
+# is also set by the fcm_job.sh on the PBS select header line above.
+#
+# These variables are needed by post_test_tidyup function in all_functions.sh
+#
+ export INPUT_DIR=DEF_INPUT_DIR
+ export CONFIG_DIR=DEF_CONFIG_DIR
+ export NEMO_VALIDATION_DIR=DEF_NEMO_VALIDATION
+ export NEW_CONF=DEF_NEW_CONF
+ export CMP_NAM=DEF_CMP_NAM
+ export TEST_NAME=DEF_TEST_NAME
+ export EXE_DIR=DEF_EXE_DIR
+ ulimit -c unlimited
+ ulimit -s unlimited
+ export FORT_FMT_RECL=132
+#
+# end of set up
+###############################################################
+#
+# change to the working directory
+#
+ cd $EXE_DIR
+ echo Directory is `pwd`
+
+ if [ $XCORES -gt 0 ]; then
+#
+# Run MPMD case
+#
+ #XIOS will run on a separate node so will run in parallel queue
+ if [ ! -f ./xios_server.exe ] && [ -f ${XIO_HOME}/bin/xios_server.exe ]; then
+ cp ${XIO_HOME}/bin/xios_server.exe .
+ fi
+ if [ ! -f ./xios_server.exe ]; then
+ echo "./xios_server.exe not found"
+ echo "run aborted"
+ exit
+ fi
+ echo time aprun -b -n $XCORES -N $X_PER_NODE ./xios_server.exe : -n $OCORES -N $O_PER_NODE ./opa
+ time aprun -b -n $XCORES -N $X_PER_NODE ./xios_server.exe : -n $OCORES -N $O_PER_NODE ./opa
+#
+ else
+#
+# Run SPMD case
+#
+ if [ $OCORES -gt 32 ] ; then
+ #Still more than one node so run in parallel queue
+ echo time aprun -b -n $OCORES -N $O_PER_NODE ./opa
+ time aprun -b -n $OCORES -N $O_PER_NODE ./opa
+ else
+ echo time mpiexec -n $OCORES ./opa
+ time mpiexec -n $OCORES ./opa
+ fi
+ fi
+#
+
+#
+ post_test_tidyup
+# END_BODY
+# Don't remove neither change the previous line
+ exit
+
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/SETTE/prepare_job.sh
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/SETTE/prepare_job.sh (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/SETTE/prepare_job.sh (revision 5602)
@@ -226,5 +226,56 @@
# round up the number of nodes required.
#
- NB_NODES=$( echo $NB_NODES $NXIO_PROC | awk '{print ($1 + ( $2 / 4 ) + 1)}')
+ NB_NODES=$( echo $NB_NODES $NXIO_PROC | awk '{print ($1 + ( $2 / 4 ) + 1)}')
+ fi
+ ;;
+ XC40_METO*) #Setup for Met Office XC40 with any compiler
+ # ocean cores are packed 32 to a node
+ # If we need more than one node then have to use parallel queue and XIOS must have a node to itself
+ NB_REM=$( echo $NB_PROC | awk '{print ( $1 % 32 ) }')
+ if [ ${NB_REM} == 0 ] ; then
+ # number of processes required is an integer multiple of 32
+ #
+ NB_NODES=$( echo $NB_PROC $NXIO_PROC | awk '{print ($1) / 32}')
+ else
+ #
+ # number of processes required is not an integer multiple of 32
+ # round up the number of nodes required.
+ #
+ NB_NODES=$( echo $NB_PROC $NXIO_PROC | awk '{printf("%d",($1) / 32 + 1 )}')
+ fi
+ # xios cores are sparsely packed at 4 to a node
+ if [ $NXIO_PROC == 0 ] ; then
+ NB_XNODES=0
+ else
+ NB_REM=$( echo $NXIO_PROC | awk '{print ( $1 % 4 ) }')
+ if [ ${NB_REM} == 0 ] ; then
+ # number of processes required is an integer multiple of 4
+ #
+ NB_XNODES=$( echo $NXIO_PROC | awk '{print (( $1 / 4 ) + 1)}')
+ else
+ #
+ # number of processes required is not an integer multiple of 4
+ # round up the number of nodes required.
+ #
+ NB_XNODES=$( echo $NXIO_PROC | awk '{printf("%d",($1) / 4 + 1) }')
+ fi
+ fi
+ if [ ${NB_XNODES} -ge 1 ] ; then
+ NB_NODES=$((NB_NODES+NB_XNODES))
+ fi
+ echo NB_XNODES=${NB_XNODES}
+ echo Total NB_NODES=${NB_NODES}
+ if [ ${NB_NODES} -eq 1 ] ; then
+ QUEUE=shared
+ #Not using XIOS in detatched mode and using less than one node so should be ok on shared node
+ #Load snplauncher module to allow use of mpiexec
+ SELECT="select=1:ncpus=$((NXIO_PROC + NB_PROC))":mem=15GB
+ module load cray-snplauncher
+ echo 'Shared Queue'
+ else
+ QUEUE=normal
+ SELECT="select=$NB_NODES"
+ module unload cray-snplauncher #Make sure snplauncher module is not loaded
+ echo 'Normal Queue'
fi
;;
@@ -279,4 +330,9 @@
cat run_sette_test.job | sed -e"s/NPROC_NODE/${NB_PROC_NODE}/" \
-e"s:QUEUE:${QUEUE}:" > run_sette_test1.job
+ mv run_sette_test1.job run_sette_test.job
+ ;;
+ XC40_METO*)
+ cat run_sette_test.job | sed -e"s/QUEUE/${QUEUE}/" \
+ -e"s/SELECT/${SELECT}/" > run_sette_test1.job
mv run_sette_test1.job run_sette_test.job
;;
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/SETTE/sette.sh
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/SETTE/sette.sh (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/SETTE/sette.sh (revision 5602)
@@ -142,5 +142,5 @@
# ORCA2_LIM_OBS: 15
# ORCA2_AGRIF_LIM :16
-for config in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
+for config in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
do
@@ -857,4 +857,6 @@
export TEST_NAME="REPRO_4_8"
. ./prepare_exe_dir.sh
+ JOB_FILE=${EXE_DIR}/run_job.sh
+ if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi
cd ${EXE_DIR}
set_namelist namelist_cfg nn_it000 1
@@ -1000,5 +1002,5 @@
export TEST_NAME="LONG"
cd ${CONFIG_DIR}
- . ./makenemo -m ${CMP_NAM} -n ISOMIP_LONG -r ISOMIP -j 8 del_key ${DEL_KEYS}
+ . ./makenemo -m ${CMP_NAM} -n ISOMIP_LONG -u ISOMIP -j 8 del_key ${DEL_KEYS}
cd ${SETTE_DIR}
. ./param.cfg
@@ -1068,5 +1070,5 @@
export TEST_NAME="REPRO_1_4"
cd ${CONFIG_DIR}
- . ./makenemo -m ${CMP_NAM} -n ISOMIP_4 -r ISOMIP -j 8 add_key "key_mpp_rep" del_key ${DEL_KEYS}
+ . ./makenemo -m ${CMP_NAM} -n ISOMIP_4 -u ISOMIP -j 8 add_key "key_mpp_rep" del_key ${DEL_KEYS}
cd ${SETTE_DIR}
. ./param.cfg
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/COMPILE/bash-font-lock.el
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/COMPILE/bash-font-lock.el (revision 5602)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/COMPILE/bash-font-lock.el (revision 5602)
@@ -0,0 +1,81 @@
+; Bash syntax highlighting
+
+(defvar bash-builtins ;; Unrecognized UNIX commands
+ '("awk" "basename" "cat" "cp" "cut" "date" "diff" "dirname" "env" "find"
+ "grep" "head" "ls" "make" "mkdir" "mv" "rm" "sed" "sort" "svn" "tail" "tee"
+ "touch" "uniq" "xargs" ))
+
+(defvar bash-keywords ;; Bash keywords (consistency with 'return' command fontification)
+ '("declare" "let" "local" "readonly" "typeset" "set" "unset" ))
+
+(defvar bash-functions ;; Sourced or declared fonctions
+ '("fake_func" ;;
+ "em" "ev" "ge" "heil" "mkcd" "ok" ;; Common
+ "nemch" "nemde" "nemid" "nemtr" "nemst" ;; NEMO branchs
+ "cmpcf" "if90" "gf90" ;; NEMO cmp
+ "nemo_help" "nemo_cfg" ;; NEMO cfg
+ "append_output_file" "appech_output_file" "super_grep" "check_args_count" ;; NEMO SETTE
+ "set_namelist" "set_xio" "post_test_tidyup" )) ;; Id
+
+(defvar bash-font-lock ;; Be careful with order
+ '(;; Variables
+ ;;; GLOBALS variables|arrays
+ ("\\(?:export +\\)?\\$?{?\\(#?[A-Z][A-Z_0-9]+\\)\\(?:\\[\\(?2:[@*]\\)\\]\\)?"
+ (1 font-lock-constant-face ) (2 font-lock-constant-face nil t))
+ ;;; Locals arrays
+ ("\\(?1:#?[a-z][a-z_0-9]+\\)\\[\\([@*]\\)?"
+ (1 font-lock-variable-name-face) (2 font-lock-variable-name-face nil t))
+ ;;; Shell specials variables
+ ("\\${?\\([#@?!_-]?[a-z]?[a-z_0-9]*\\)}?" 1 font-lock-variable-name-face)
+
+ ;; Tests '[ ... ]' '[[ ... ]]' '(( ... ))'
+ ("\\((\\{2\\}\\) \\(?:.*\\) \\()\\{2\\}\\)"
+ (1 font-lock-builtin-face) (2 font-lock-builtin-face))
+ ("\\(\\[\\{1,2\\}\\) \\(?:[^]]+\\) \\(\\]\\{1,2\\}\\)"
+ (1 font-lock-builtin-face) (2 font-lock-builtin-face))
+
+ ;; Operators ' ! ' ' != ' ' ~= ' ' && ' ' || '
+ (" \\!=? \\| ~= " 0 font-lock-negation-char-face)
+ (" && \\| || " 0 font-lock-keyword-face )
+
+ ;; Compound commands
+ ("\\\\$" 0 font-lock-warning-face) ; '\'
+ ("\\(?:[^;]\\)\\(;\\) " 1 font-lock-keyword-face) ; '; '
+ ;;; Function
+ ("^\\(?:function +\\)?\\(\\sw+\\)(?)? +\\({\\)"
+ (1 font-lock-function-name-face) (2 font-lock-warning-face ))
+ ("^}$" 0 font-lock-warning-face )
+ ;;; Commands block ' { ...; }'
+ ("\\({\\) \\(?:[^}]*\\); +\\(}\\)?" (1 font-lock-warning-face) (2 font-lock-warning-face nil t))
+ ("\\(?:.*\\); +\\(}\\)$" 1 font-lock-warning-face )
+ ;;; Sub-shell '( ... )'
+ ("\\((\\) \\(?:[^)]*\\) \\()\\)" (1 font-lock-warning-face) (2 font-lock-warning-face))
+
+ ;; 'case ... in ...) ...;; esac'
+ ("\\()\\)\\(?:[^)]*\\)\\(;;\\)" (1 font-lock-keyword-face) (2 font-lock-keyword-face))
+ ("^[^(]*\\()\\)$" 1 font-lock-keyword-face) ; Regular syntax
+ ("^\\s-+;;$" 0 font-lock-keyword-face) ; " ""
+ )
+ )
+
+; Configuration loading
+(font-lock-add-keywords 'sh-mode `((,(regexp-opt bash-builtins 'words) 0 font-lock-builtin-face )))
+(font-lock-add-keywords 'sh-mode `((,(regexp-opt bash-keywords 'words) 0 font-lock-keyword-face )))
+(font-lock-add-keywords 'sh-mode `((,(regexp-opt bash-functions 'words) 0 font-lock-function-name-face)))
+(font-lock-add-keywords 'sh-mode bash-font-lock )
+
+; Highlighting example for font lock faces
+(font-lock-add-keywords 'sh-mode '(
+ ("font-lock-warning-face" . font-lock-warning-face )
+ ("font-lock-function-name-face" . font-lock-function-name-face )
+ ("font-lock-variable-name-face" . font-lock-variable-name-face )
+ ("font-lock-keyword-face" . font-lock-keyword-face )
+ ("font-lock-comment-face" . font-lock-comment-face )
+ ("font-lock-comment-delimiter-face" . font-lock-comment-delimiter-face)
+ ("font-lock-type-face" . font-lock-type-face )
+ ("font-lock-constant-face" . font-lock-constant-face )
+ ("font-lock-builtin-face" . font-lock-builtin-face )
+ ("font-lock-preprocessor-face" . font-lock-preprocessor-face )
+ ("font-lock-string-face" . font-lock-string-face )
+ ("font-lock-doc-face" . font-lock-doc-face )
+ ("font-lock-negation-char-face" . font-lock-negation-char-face )))
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/COMPILE/template.sh
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/COMPILE/template.sh (revision 5602)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/COMPILE/template.sh (revision 5602)
@@ -0,0 +1,186 @@
+#!/bin/bash
+
+
+#§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§
+#
+# This template for Bash coding pair with Emacs Lisp package 'bash-font-lock.el'
+# to enhance default shell syntax fontification. This package is based on regexs
+# to match examples of concsyntax showed below.
+# All this is not mandatory and probably not optimized with other correct rules
+# Feel free to add your tips, modify it at your convenience or give your feedback
+# to improve it.
+#
+#§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§
+
+
+# To automatically use it with a bash script, copy it to your ~/.emacs.d and
+# add '(load "~/.emacs.d/bash-font-lock.el")' in your .emacs configuration file
+#--------------------------------------------------------------------------------
+ # If a command is not highlighted, add its name to 'bash-builtins' list
+ # " " function "" " " , " " "" "" 'bash-functions' ""
+
+# UNIX built-in commands sample
+#-------------------------------
+.; alias; bg; bind; builtin; caller; compgen; complete; declare; dirs; disown
+enable; fc; fg; help; history; jobs; kill; let; local; popd; printf; pushd
+shopt; source; suspend; typeset; unalias; eval; export; getopts; newgrp; pwd
+read; readonly; times; ulimit; command; hash; test; type; cd; echo; eval; set
+shift; umask; unset; wait
+
+# Common bash built-in commands already added to 'bash-builtins' list
+#---------------------------------------------------------------------
+awk basename cat cp cut date diff dirname env find grep head ls make mkdir mv rm
+sed sort svn tail tee touch uniq xargs
+
+# Variables
+#-----------
+ # Specials parameters (see Bash manual for details, `man bash`)
+$0 $# $* $@ $? $! $_ $$ $-
+ # Positionnal parameters (ordered arguments given to run script "$0")
+$1 $2 $3 ...
+$* == "$1${IFS}$2${IFS}$3..." # Single word , recommended use for string
+$@ == "$1" "$2" "$3"... # Separate words, recommended use for array
+ # Identify locals against GLOBALS or ENVIRONMENT variables with case sensitive
+TEMP=${temp_0123}; temp=${TEMP_0123}; export TEMP=${TEMP_0123}
+ # Possibles variable assignation syntax
+temp='temp'; temp=$1 # Simple
+length_temp=${#temp} # Length of string
+temp=$(( 1 + 1 )) # Integer arithmetic evaluation
+temp=${........} # String operations
+temp=$(test ....) # Regular syntax
+temp=$( test ... ) # Highlight sub-shell '( ... )' & command or function call
+temp=`test .....` # Backquotes not recommended to avoid complete highlighting
+
+# Arrays
+#--------
+ # Initialisation
+declare -a array # Explicit
+array=([0]='zero' [1]='one' ...) # Implicit with index assignement
+array[0]='zero'; array[9]='ten' # Implicit or add element to array at an index
+ # Curly brackets are essential to work with arrays
+ # Last index of an array
+IDX=${#temp_0123[@]}; idx=${#TEMP_0123[@]}
+ # Get last element of an array (${#array[@]})
+LAST_ELMNT=array[${#array[@]}]; last_elmnt=ARRAY[${#ARRAY[@]}]
+ # Remove an element or entire array
+unset array[9]; unset array[@]
+
+# Strings
+#---------
+ # Single quotes are recommended to identified entire characters string instead
+ # of doubles quotes or initialize variable
+echo 'The name of the script is '$0' with following arguments '$*
+ # Doubles quotes should only be used when it's necessary to interpret escaping
+ # character or to perform parameter substitution
+printf "The value of PI is %8.6f.\n" $PI; sed "s/3.1415/$PI/" temp.txt
+
+# Function
+#----------
+ # 'function' word is not not mandatory at declaration if you have double
+ # brackets '()' right after name. A function has to be declared before its call
+ # so should be placed at the beginning of the main script. A clever solution is
+ # to gather similar functions in kind of a 'module' file which will be sourced
+ # from main script.
+ # 2 possibles syntax:
+function fake_func { local temp=''; ...; return ...; }
+fake_func() {
+ local temp='' # Declare variable as local, if not his attribute is global
+ ...
+ return ... # Function can only return an integer (stderr by default)
+ # export result by a global variable to bypass it
+}
+ # Function call (with or without argument)
+temp=$( fake_func $1 $2 ); fake_func $1 $2; fake_func
+
+# Tests operators differs with type of test (arithmetic or string comparison
+# for number/characters, file attributs), see manual for test with `man test`
+#----------------------------------------------------------------------------
+ # Possible syntax : literal 'test' or compact syntax with brackets/parenthesis
+ # at the ends
+ # '[ ... ]' & '[[ ... ]]' are almost identical (simple and extended test)
+ # With ' != ' & ' == ' operators, right string is considered as regex
+ # "" '~=' " , " "" " "" " extended "
+[ $temp ~= "..." ] && [[ ! -e temp.txt ]] || (( $temp >= 0 ))
+
+# For compound commands, prefer the use of command block '{ ...; }' instead of
+# a sub-shell '( ... )', keep in mind that despite sub-shell inherit from its
+# run script all variables declared as locals are lost at the end of execution
+
+# To cut a long sequence, put the escape character '\' at the end of line and
+# continue on next line (possible on several lines)
+printf "This is a very very very long sentence that I have to cut in order to \
+ be less than 80 characters for a line of code but I don't have to call \
+ the same command several times.\n "
+# A pipe ' | ' cannot be put at the end of a line, even if you have a '\'
+cat temp.txt | cut -d' ' -f-5 | sort -kr3n | uniq -c | sort | head -n25 \
+| awk '$3 >= 1024 {print $4}' \
+| xargs -t -i() mv () $HOST@$HOSTNAME:${REP_STORAGE}
+
+# 'if ...; then ...; fi'
+#------------------------
+ # Very short syntax with commands block '{ ...; }'
+[ ... ] && { ...; ...; }
+ # Short syntax with commands block '{ ...; }'
+[ ... ] && { ...; \
+ ...; }
+ # Regular syntax
+if [ ... ]; then
+ ...
+fi
+
+# 'if ...; then ...; else ...; fi'
+#----------------------------------
+ # Short syntax with commands block '{ ... }'
+{ [ ... ] && ...; } || { ...; ...; }
+ # Regular syntax
+if [ ... ]; then
+ ...
+else
+ ...
+fi
+
+# 'case ... in ...) ... ;; ... esac'
+#-----------------------------------
+case ... in
+ # Very short syntax
+ ...) ...;; ...) ...;; ...) ...;;
+ # Short syntax
+ ...) ...; ...; ...;;
+ # Regular syntax
+ ...)
+ ...
+ ;;
+esac
+
+# List font lock faces with effective highlighting (can be customized)
+#---------------------------------------------------------------------
+ font-lock-warning-face
+ # for a construct that is peculiar, or that greatly changes the meaning of
+ #other text
+ font-lock-function-name-face
+ # for the name of a function being defined or declared
+ font-lock-variable-name-face
+ # for the name of a variable being defined or declared
+ font-lock-keyword-face
+ # for a keyword with special syntactic significance, like ‘for’ and ‘if’ in C.
+ font-lock-comment-face
+ # for comments
+ font-lock-comment-delimiter-face
+ # for comments delimiters, like ‘/*’ and ‘*/’ in C. On most terminals, this
+ #inherits from font-lock-comment-face
+ font-lock-type-face
+ # for the names of user-defined data types
+ font-lock-constant-face
+ # for the names of constants, like ‘NULL’ in C
+ font-lock-builtin-face
+ # for the names of built-in functions
+ font-lock-preprocessor-face
+ # for preprocessor commands. This inherits, by default, from
+ #font-lock-builtin-face
+ font-lock-string-face
+ # for string constants
+ font-lock-doc-face
+ # for documentation strings in the code. This inherits, by default, from
+ #font-lock-string-face
+ font-lock-negation-char-face
+ # for easily-overlooked negation characters
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/DMP_TOOLS/README
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/DMP_TOOLS/README (revision 5602)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/DMP_TOOLS/README (revision 5602)
@@ -0,0 +1,5 @@
+DMP_TOOLS should be used to create a netcdf file called resto.nc containing restoration coefficients for use with the tra_dmp module in NEMO. Further instructions for it's use are available in the NEMO users guide.
+
+The tool can be compiled using the maketools script in the NEMOGCM/TOOLS directory as follows:
+./maketools -m $ARCH -n DMP_TOOLS
+where $ARCH indicates the arch file to be used from the directory NEMOGCM/ARCH. For example to use NEMOGCM/ARCH/arch-PW7_MONSOON.fcm, $ARCH would be PW7_MONSOON.
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/DMP_TOOLS/namelist
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/DMP_TOOLS/namelist (revision 5602)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/DMP_TOOLS/namelist (revision 5602)
@@ -0,0 +1,24 @@
+&nam_dmp_create
+ cp_cfg = 'orca' ! Name of model grid (orca and C1D have special options - otherwise ignored)
+ cp_cfz = 'antarctic' ! Name of zoom configuration (arctic and antarctic have some special treatment if lzoom=.true.)
+ jp_cfg = 2 ! Resolution of the model (used for med_red_seas damping)
+ lzoom = .false. ! Zoom configuration or not
+ ln_full_field = .false. ! Calculate coefficient over whole of domain
+ ln_med_red_seas = .true. ! Damping in Med/Red Seas (or local modifications here if ln_full_field=.true.)
+ ln_old_31_lev_code = .true. ! Replicate behaviour of old online code for 31 level model (Med/Red seas damping based on level number instead of depth)
+ ln_coast = .true. ! Reduce near to coastlines
+ ln_zero_top_layer = .true. ! No damping in top layer
+ ln_custom = .false. ! Call "custom" module to apply user modifications to the damping coefficient field
+ nn_hdmp = 10 ! Damp poleward of this latitude (smooth transition up to maximum damping)
+ pn_surf = 0.25 ! Surface Relaxation timescale (days)
+ pn_bot = 0.25 ! Bottom relaxation timescale (days)
+ pn_dep = 1000 ! Transition depth from upper to deep ocean
+ jperio = 2 ! Lateral boundary condition (as specified in namelist_cfg for model run).
+/
+
+&nam_zoom_dmp
+ lzoom_n = .false. ! Open boundary had northern edge?
+ lzoom_e = .false. ! Open boundary at eastern edge?
+ lzoom_w = .false. ! Open boundary at western edge?
+ lzoom_s = .false. ! Open boundary at southern edge?
+/
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/DMP_TOOLS/src/coast_dist.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/DMP_TOOLS/src/coast_dist.F90 (revision 5602)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/DMP_TOOLS/src/coast_dist.F90 (revision 5602)
@@ -0,0 +1,220 @@
+MODULE coastdist
+
+ USE utils
+ USE netcdf
+
+ IMPLICIT NONE
+ PUBLIC
+
+ CONTAINS
+
+ SUBROUTINE coast_dist_weight( presto )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE coast_dist_weight ***
+ !!
+ !! ** Purpose: Weight restoration coefficient by distance to coast
+ !!
+ !! ** Method: 1) Calculate distance to coast
+ !! 2) Reduce resto with 1000km of coast
+ !!
+ IMPLICIT NONE
+ REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) :: presto
+ REAL(wp), DIMENSION(jpi,jpj) :: zdct
+ REAL(wp) :: zinfl = 1000.e3_wp ! Distance of influence of coast line (could be
+ ! a namelist setting)
+ INTEGER :: jj, ji ! dummy loop indices
+
+
+ CALL cofdis( zdct )
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ zdct(ji,jj) = MIN( zinfl, zdct(ji,jj) )
+ presto(ji,jj) = presto(ji, jj) * 0.5_wp * ( 1._wp - COS( rpi*zdct(ji,jj)/zinfl) )
+ END DO
+ END DO
+
+ END SUBROUTINE coast_dist_weight
+
+
+ SUBROUTINE cofdis( pdct )
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE cofdis ***
+ !!
+ !! ** Purpose : Compute the distance between ocean T-points and the
+ !! ocean model coastlines.
+ !!
+ !! ** Method : For each model level, the distance-to-coast is
+ !! computed as follows :
+ !! - The coastline is defined as the serie of U-,V-,F-points
+ !! that are at the ocean-land bound.
+ !! - For each ocean T-point, the distance-to-coast is then
+ !! computed as the smallest distance (on the sphere) between the
+ !! T-point and all the coastline points.
+ !! - For land T-points, the distance-to-coast is set to zero.
+ !!
+ !! ** Action : - pdct, distance to the coastline (argument)
+ !! - NetCDF file 'dist.coast.nc'
+ !!----------------------------------------------------------------------
+ !!
+ REAL(wp), DIMENSION(jpi,jpj), INTENT( out ) :: pdct ! distance to the coastline
+ !!
+ INTEGER :: ji, jj, jl ! dummy loop indices
+ INTEGER :: iju, ijt, icoast, itime, ierr, icot ! local integers
+ CHARACTER (len=32) :: clname ! local name
+ REAL(wp) :: zdate0 ! local scalar
+ REAL(wp), POINTER, DIMENSION(:,:) :: zxt, zyt, zzt, zmask
+ REAL(wp), POINTER, DIMENSION(: ) :: zxc, zyc, zzc, zdis ! temporary workspace
+ LOGICAL , ALLOCATABLE, DIMENSION(:,:) :: llcotu, llcotv, llcotf ! 2D logical workspace
+
+ !!----------------------------------------------------------------------
+ !
+ ALLOCATE( zxt(jpi,jpj) , zyt(jpi,jpj) , zzt(jpi,jpj) , zmask(jpi,jpj) )
+ ALLOCATE(zxc(3*jpi*jpj), zyc(3*jpi*jpj), zzc(3*jpi*jpj), zdis(3*jpi*jpj) )
+ ALLOCATE( llcotu(jpi,jpj), llcotv(jpi,jpj), llcotf(jpi,jpj) )
+ ALLOCATE( gphiu(jpi,jpj), gphiv(jpi,jpj), gphif(jpi,jpj) )
+ ALLOCATE( glamu(jpi,jpj), glamv(jpi,jpj), glamf(jpi,jpj), glamt(jpi,jpj) )
+ ALLOCATE( umask(jpi,jpj), vmask(jpi,jpj), fmask(jpi,jpj) )
+ !
+
+ CALL check_nf90( nf90_get_var( ncin, gphit_id, gphit, (/ 1,1 /), (/ jpi, jpj /) ) )
+ CALL check_nf90( nf90_get_var( ncin, gphiu_id, gphiu, (/ 1,1 /), (/ jpi, jpj /) ) )
+ CALL check_nf90( nf90_get_var( ncin, gphiv_id, gphiv, (/ 1,1 /), (/ jpi, jpj /) ) )
+ CALL check_nf90( nf90_get_var( ncin, gphif_id, gphif, (/ 1,1 /), (/ jpi, jpj /) ) )
+ CALL check_nf90( nf90_get_var( ncin, glamt_id, glamt, (/ 1,1 /), (/ jpi, jpj /) ) )
+ CALL check_nf90( nf90_get_var( ncin, glamu_id, glamu, (/ 1,1 /), (/ jpi, jpj /) ) )
+ CALL check_nf90( nf90_get_var( ncin, glamv_id, glamv, (/ 1,1 /), (/ jpi, jpj /) ) )
+ CALL check_nf90( nf90_get_var( ncin, glamf_id, glamf, (/ 1,1 /), (/ jpi, jpj /) ) )
+ CALL check_nf90( nf90_get_var( ncin, tmask_id, tmask, (/ 1,1 /), (/ jpi, jpj /) ) )
+ CALL check_nf90( nf90_get_var( ncin, umask_id, umask, (/ 1,1 /), (/ jpi, jpj /) ) )
+ CALL check_nf90( nf90_get_var( ncin, vmask_id, vmask, (/ 1,1 /), (/ jpi, jpj /) ) )
+ CALL check_nf90( nf90_get_var( ncin, fmask_id, fmask, (/ 1,1 /), (/ jpi, jpj /) ) )
+
+ pdct(:,:) = 0._wp
+ zxt(:,:) = COS( rad * gphit(:,:) ) * COS( rad * glamt(:,:) )
+ zyt(:,:) = COS( rad * gphit(:,:) ) * SIN( rad * glamt(:,:) )
+ zzt(:,:) = SIN( rad * gphit(:,:) )
+
+
+ ! Define the coastline points (U, V and F)
+ DO jj = 2, jpj-1
+ DO ji = 2, jpi-1
+ zmask(ji,jj) = ( tmask(ji,jj+1) + tmask(ji+1,jj+1) &
+ & + tmask(ji,jj ) + tmask(ji+1,jj ) )
+ llcotu(ji,jj) = ( tmask(ji,jj ) + tmask(ji+1,jj ) == 1._wp )
+ llcotv(ji,jj) = ( tmask(ji,jj ) + tmask(ji ,jj+1) == 1._wp )
+ llcotf(ji,jj) = ( zmask(ji,jj) > 0._wp ) .AND. ( zmask(ji,jj) < 4._wp )
+ END DO
+ END DO
+
+ ! Lateral boundaries conditions
+ llcotu(:, 1 ) = umask(:, 2 ) == 1
+ llcotu(:,jpj) = umask(:,jpj-1) == 1
+ llcotv(:, 1 ) = vmask(:, 2 ) == 1
+ llcotv(:,jpj) = vmask(:,jpj-1) == 1
+ llcotf(:, 1 ) = fmask(:, 2 ) == 1
+ llcotf(:,jpj) = fmask(:,jpj-1) == 1
+
+ IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
+ llcotu( 1 ,:) = llcotu(jpi-1,:)
+ llcotu(jpi,:) = llcotu( 2 ,:)
+ llcotv( 1 ,:) = llcotv(jpi-1,:)
+ llcotv(jpi,:) = llcotv( 2 ,:)
+ llcotf( 1 ,:) = llcotf(jpi-1,:)
+ llcotf(jpi,:) = llcotf( 2 ,:)
+ ELSE
+ llcotu( 1 ,:) = umask( 2 ,:) == 1
+ llcotu(jpi,:) = umask(jpi-1,:) == 1
+ llcotv( 1 ,:) = vmask( 2 ,:) == 1
+ llcotv(jpi,:) = vmask(jpi-1,:) == 1
+ llcotf( 1 ,:) = fmask( 2 ,:) == 1
+ llcotf(jpi,:) = fmask(jpi-1,:) == 1
+ ENDIF
+ IF( jperio == 3 .OR. jperio == 4 ) THEN
+ DO ji = 1, jpi-1
+ iju = jpi - ji + 1
+ llcotu(ji,jpj ) = llcotu(iju,jpj-2)
+ llcotf(ji,jpj-1) = llcotf(iju,jpj-2)
+ llcotf(ji,jpj ) = llcotf(iju,jpj-3)
+ END DO
+ DO ji = jpi/2, jpi-1
+ iju = jpi - ji + 1
+ llcotu(ji,jpj-1) = llcotu(iju,jpj-1)
+ END DO
+ DO ji = 2, jpi
+ ijt = jpi - ji + 2
+ llcotv(ji,jpj-1) = llcotv(ijt,jpj-2)
+ llcotv(ji,jpj ) = llcotv(ijt,jpj-3)
+ END DO
+ ENDIF
+ IF( jperio == 5 .OR. jperio == 6 ) THEN
+ DO ji = 1, jpi-1
+ iju = jpi - ji
+ llcotu(ji,jpj ) = llcotu(iju,jpj-1)
+ llcotf(ji,jpj ) = llcotf(iju,jpj-2)
+ END DO
+ DO ji = jpi/2, jpi-1
+ iju = jpi - ji
+ llcotf(ji,jpj-1) = llcotf(iju,jpj-1)
+ END DO
+ DO ji = 1, jpi
+ ijt = jpi - ji + 1
+ llcotv(ji,jpj ) = llcotv(ijt,jpj-1)
+ END DO
+ DO ji = jpi/2+1, jpi
+ ijt = jpi - ji + 1
+ llcotv(ji,jpj-1) = llcotv(ijt,jpj-1)
+ END DO
+ ENDIF
+
+ ! Compute cartesian coordinates of coastline points
+ ! and the number of coastline points
+ icoast = 0
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ IF( llcotf(ji,jj) ) THEN
+ icoast = icoast + 1
+ zxc(icoast) = COS( rad*gphif(ji,jj) ) * COS( rad*glamf(ji,jj) )
+ zyc(icoast) = COS( rad*gphif(ji,jj) ) * SIN( rad*glamf(ji,jj) )
+ zzc(icoast) = SIN( rad*gphif(ji,jj) )
+ ENDIF
+ IF( llcotu(ji,jj) ) THEN
+ icoast = icoast+1
+ zxc(icoast) = COS( rad*gphiu(ji,jj) ) * COS( rad*glamu(ji,jj) )
+ zyc(icoast) = COS( rad*gphiu(ji,jj) ) * SIN( rad*glamu(ji,jj) )
+ zzc(icoast) = SIN( rad*gphiu(ji,jj) )
+ ENDIF
+ IF( llcotv(ji,jj) ) THEN
+ icoast = icoast+1
+ zxc(icoast) = COS( rad*gphiv(ji,jj) ) * COS( rad*glamv(ji,jj) )
+ zyc(icoast) = COS( rad*gphiv(ji,jj) ) * SIN( rad*glamv(ji,jj) )
+ zzc(icoast) = SIN( rad*gphiv(ji,jj) )
+ ENDIF
+ END DO
+ END DO
+
+ ! Distance for the T-points
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ IF( tmask(ji,jj) == 0._wp ) THEN
+ pdct(ji,jj) = 0._wp
+ ELSE
+ DO jl = 1, icoast
+ zdis(jl) = ( zxt(ji,jj) - zxc(jl) )**2 &
+ & + ( zyt(ji,jj) - zyc(jl) )**2 &
+ & + ( zzt(ji,jj) - zzc(jl) )**2
+ END DO
+ pdct(ji,jj) = ra * SQRT( MINVAL( zdis(1:icoast) ) )
+ ENDIF
+ END DO
+ END DO
+
+ DEALLOCATE( zxt , zyt , zzt , zmask )
+ DEALLOCATE(zxc, zyc, zzc, zdis )
+ DEALLOCATE( llcotu, llcotv, llcotf )
+ DEALLOCATE( gphiu, gphiv, gphif )
+ DEALLOCATE( glamu, glamv, glamf, glamt )
+ DEALLOCATE( umask, vmask, fmask )
+
+ END SUBROUTINE cofdis
+
+END MODULE coastdist
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/DMP_TOOLS/src/custom.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/DMP_TOOLS/src/custom.F90 (revision 5602)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/DMP_TOOLS/src/custom.F90 (revision 5602)
@@ -0,0 +1,22 @@
+MODULE custom
+
+ USE utils
+
+ IMPLICIT NONE
+ PUBLIC
+
+ CONTAINS
+
+ SUBROUTINE custom_resto( presto )
+ !!---------------------------------
+ !! **ROUTINE: custom_resto
+ !!
+ !! ** Purpose: Module to be edited by users to create custom restoration
+ !! coefficient files (e.g. regional damping).
+ !!
+ !!-------------------------------------
+ REAL(wp), DIMENSION(jpi,jpk), INTENT(inout) :: presto
+
+ END SUBROUTINE custom_resto
+
+END MODULE custom
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/DMP_TOOLS/src/make_dmp_file.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/DMP_TOOLS/src/make_dmp_file.F90 (revision 5602)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/DMP_TOOLS/src/make_dmp_file.F90 (revision 5602)
@@ -0,0 +1,123 @@
+PROGRAM make_dmp_file
+ !================================================================================
+ ! *** PROGRAM make_dmp_file ****
+ !================================================================================
+ !
+ ! Purpose: Create a file containing a spacially varying
+ ! restoration coefficient to be used by TRADMP
+ !
+ ! Method: 1) Read in tmask from mesh_mask file to use as a template
+ ! 2) Calculate restoration coefficients according to options
+ ! specified in the namelist. The user may modify custom.F90 to
+ ! specify specific damping options e.g. to mask certain regions only).
+ ! 3) Write the array to output file
+ !
+ ! History: Original code: Tim Graham (Jul 2014) - some code moved from
+ ! old tradmp.F90 module to this tool (as part of NEMO
+ ! simplification process).
+ !-------------------------------------------------------------------------------
+
+ ! Declare variables
+ USE netcdf
+ USE utils
+ USE coastdist
+ USE med_red_seas
+ USE zoom
+ USE custom
+
+ IMPLICIT NONE
+ INTEGER :: ji, jj, jk ! dummpy loop variables
+ REAL(wp) :: zsdmp, zbdmp ! Surface and bottom damping coeff
+ CHARACTER(LEN=200) :: meshfile = 'mesh_mask.nc' ! mesh file
+ CHARACTER(LEN=200) :: outfile = 'resto.nc' ! output file
+ REAL(wp) :: zlat, zlat2, zlat0
+
+ ! Read namelist
+ OPEN( UNIT=numnam, FILE='namelist', FORM='FORMATTED', STATUS='OLD' )
+ READ( numnam, nam_dmp_create )
+ CLOSE( numnam )
+
+ IF ( ln_full_field .AND. lzoom ) THEN
+ WRITE(numerr,*) 'Only one of ln_full_field and lzoom can be .true.'
+ STOP
+ ENDIF
+
+ CALL grid_info(meshfile)
+ WRITE(numout, *) 'jpi = ',jpi
+ WRITE(numout, *) 'jpj = ',jpj
+ WRITE(numout, *) 'jpk = ',jpk
+
+ ALLOCATE( resto(jpi, jpj) )
+
+ !Create output file
+ CALL make_outfile( outfile )
+
+ CALL check_nf90( nf90_get_var( ncin, gphit_id, gphit, (/ 1,1 /), (/ jpi, jpj /) ) )
+
+ !Calculate surface and bottom damping coefficients
+ zsdmp = 1._wp / ( pn_surf * rday )
+ zbdmp = 1._wp / ( pn_bot * rday )
+
+ !Loop through levels and read in tmask for each level as starting point for
+ !coefficient array
+ DO jk = 1, jpk-1
+ resto(:,:) = 0._wp
+
+ IF (.NOT. (jk == 1 .AND. ln_zero_top_layer) ) THEN
+ !Read in tmask depth for this level
+ CALL check_nf90( nf90_get_var( ncin, tmask_id, tmask, (/ 1,1,jk /), (/ jpi, jpj,1 /) ) )
+ CALL check_nf90( nf90_get_var( ncin, gdept_id, gdept, (/ 1,1,jk /), (/ jpi, jpj,1 /) ) )
+
+
+ IF ( ln_full_field ) THEN
+ !Set basic value of resto
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ resto(ji,jj) = tmask(ji, jj) * (zbdmp + (zsdmp-zbdmp) * EXP(-gdept(ji,jj)/pn_dep))
+ END DO
+ END DO
+ IF ((nn_hdmp > 0)) THEN
+ zlat0 = 10. !width of latitude strip where resto decreases
+ zlat2 = nn_hdmp + zlat0
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ zlat = ABS(gphit(ji,jj))
+ IF ( nn_hdmp <= zlat .AND. zlat <= zlat2 ) THEN
+ resto(ji,jj) = resto(ji,jj) * 0.5_wp * ( 1._wp - COS( rpi*(zlat-nn_hdmp)/zlat0 ) )
+ ELSE IF ( zlat < nn_hdmp ) THEN
+ resto(ji,jj) = 0._wp
+ ENDIF
+ END DO
+ END DO
+ ENDIF
+
+ IF (ln_coast) THEN
+ ! Reduce damping in vicinity of coastlines
+ CALL coast_dist_weight(resto)
+ ENDIF
+ ENDIF
+
+ ! Damping in Med/Red Seas (or local modifications if full field is set)
+ IF (ln_med_red_seas .AND. (cp_cfg == 'orca') .AND. (.NOT. lzoom)) THEN
+ CALL med_red_dmp(resto, jk, ln_old_31_lev_code)
+ ENDIF
+
+ IF ( lzoom ) THEN
+ CALL dtacof_zoom(resto, tmask)
+ ENDIF
+
+ !Any user modifications can be added in the custom module
+ IF ( ln_custom ) THEN
+ CALL custom_resto( resto )
+ ENDIF
+ ENDIF
+
+ ! Write out resto for this level
+ CALL check_nf90( nf90_put_var( ncout, resto_id, resto, (/ 1,1,jk /), (/ jpi, jpj,1 /) ) )
+
+ END DO
+
+ ! Close the output file
+ CALL check_nf90( nf90_close(ncout) )
+
+END PROGRAM make_dmp_file
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/DMP_TOOLS/src/med_red_seas.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/DMP_TOOLS/src/med_red_seas.F90 (revision 5602)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/DMP_TOOLS/src/med_red_seas.F90 (revision 5602)
@@ -0,0 +1,135 @@
+MODULE med_red_seas
+
+ USE utils
+
+ IMPLICIT NONE
+ PUBLIC
+
+ CONTAINS
+
+ SUBROUTINE med_red_dmp(presto, jk, ln_31_lev)
+ !!------------------------------------
+ !! **ROUTINE: med_red_dmp
+ !!
+ !! **Purpose: Apply specific modifications to damping coefficients on ORCA
+ !! grids in Med and Red Seas
+ !!
+ !!-----------------------------------
+ INTEGER :: ij0,ij1,ii0,ii1,ji,jj
+ INTEGER, INTENT(in) :: jk
+ REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zmrs
+ REAL(wp) :: zhfac, zsdmp, zbdmp
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: presto
+ LOGICAL, INTENT(in), OPTIONAL :: ln_31_lev
+ LOGICAL :: l_31_lev
+
+ WRITE(numout,*) 'ORCA Med and Red Seas Damping'
+
+ IF ( PRESENT(ln_31_lev)) THEN
+ l_31_lev = ln_31_lev
+ ELSE
+ l_31_lev = .false.
+ ENDIF
+
+ ALLOCATE( zmrs(jpi, jpj) )
+ !
+ zmrs(:,:) = 0._wp
+ !
+ SELECT CASE ( jp_cfg )
+ ! ! =======================
+ CASE ( 4 ) ! ORCA_R4 configuration
+ ! ! =======================
+ ij0 = 50 ; ij1 = 56 ! Mediterranean Sea
+
+ ii0 = 81 ; ii1 = 91 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1.
+ ij0 = 50 ; ij1 = 55
+ ii0 = 75 ; ii1 = 80 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1.
+ ij0 = 52 ; ij1 = 53
+ ii0 = 70 ; ii1 = 74 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1.
+ !
+ ! ! =======================
+ CASE ( 2 ) ! ORCA_R2 configuration
+ ! ! =======================
+ ij0 = 96 ; ij1 = 110 ! Mediterranean Sea
+ ii0 = 157 ; ii1 = 181 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
+ ij0 = 100 ; ij1 = 110
+ ii0 = 144 ; ii1 = 156 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
+ ij0 = 100 ; ij1 = 103
+ ii0 = 139 ; ii1 = 143 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
+ !
+ ij0 = 101 ; ij1 = 102 ! Decrease before Gibraltar Strait
+ ii0 = 139 ; ii1 = 141 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0._wp
+ ii0 = 142 ; ii1 = 142 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp / 90._wp
+ ii0 = 143 ; ii1 = 143 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0.40_wp
+ ii0 = 144 ; ii1 = 144 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0.75_wp
+ !
+ ij0 = 87 ; ij1 = 96 ! Red Sea
+ ii0 = 147 ; ii1 = 163 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
+ !
+ ij0 = 91 ; ij1 = 91 ! Decrease before Bab el Mandeb Strait
+ ii0 = 153 ; ii1 = 160 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0.80_wp
+ ij0 = 90 ; ij1 = 90
+ ii0 = 153 ; ii1 = 160 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0.40_wp
+ ij0 = 89 ; ij1 = 89
+ ii0 = 158 ; ii1 = 160 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp / 90._wp
+ ij0 = 88 ; ij1 = 88
+ ii0 = 160 ; ii1 = 163 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0._wp
+ !
+ ! ! =======================
+ CASE ( 05 ) ! ORCA_R05 configuration
+ ! ! =======================
+ ii0 = 568 ; ii1 = 574 ! Mediterranean Sea
+ ij0 = 324 ; ij1 = 333 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
+ ii0 = 575 ; ii1 = 658
+ ij0 = 314 ; ij1 = 366 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
+ !
+ ii0 = 641 ; ii1 = 651 ! Black Sea (remaining part
+ ij0 = 367 ; ij1 = 372 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
+ !
+ ij0 = 324 ; ij1 = 333 ! Decrease before Gibraltar Strait
+ ii0 = 565 ; ii1 = 565 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp / 90._wp
+ ii0 = 566 ; ii1 = 566 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0.40_wp
+ ii0 = 567 ; ii1 = 567 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0.75_wp
+ !
+ ii0 = 641 ; ii1 = 665 ! Red Sea
+ ij0 = 270 ; ij1 = 310 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
+ !
+ ii0 = 666 ; ii1 = 675 ! Decrease before Bab el Mandeb Strait
+ ij0 = 270 ; ij1 = 290
+ DO ji = ii0, ii1
+ zmrs( ji , ij0:ij1 ) = 0.1_wp * ABS( FLOAT(ji - ii1) )
+ END DO
+ ! ! ========================
+ CASE ( 025 ) ! ORCA_R025 configuration
+ ! ! ========================
+ WRITE(numerr,*) ' Mediterranean and Red Sea damping option not implemented for ORCA_R025'
+ WRITE(numerr,*) ' Set ln_med_red = .false.'
+ STOP
+ !
+ END SELECT
+
+ zsdmp = 1._wp / ( pn_surf * rday )
+ zbdmp = 1._wp / ( pn_bot * rday )
+
+ ! The l_31_lev option is used to reproduce the old behaviour of
+ ! defining the restoration coefficient based on the level number.
+ ! This is included to allow damping coefficients for reference
+ ! configurations to be kept the same.
+ IF (l_31_lev) THEN
+ IF (jk <= 17) THEN
+ zhfac = 0.5_wp * ( 1. - COS( rpi * REAL(jk-1,wp) / 16._wp ) ) / rday
+ ELSE
+ zhfac = 1._wp / rday
+ ENDIF
+ ELSE
+ zhfac = ( zbdmp + (zsdmp-zbdmp) * EXP( -gdept(1,1)/pn_dep ) )
+ ENDIF
+
+ presto(:,:) = zmrs(:,:) * zhfac + ( 1._wp - zmrs(:,:) ) * presto(:,:)
+
+ DEALLOCATE( zmrs )
+
+ END SUBROUTINE med_red_dmp
+
+
+END MODULE med_red_seas
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/DMP_TOOLS/src/utils.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/DMP_TOOLS/src/utils.F90 (revision 5602)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/DMP_TOOLS/src/utils.F90 (revision 5602)
@@ -0,0 +1,130 @@
+MODULE utils
+
+ USE netcdf
+
+ IMPLICIT NONE
+ PUBLIC
+
+ INTEGER, PUBLIC, PARAMETER :: dp=8 , sp=4, wp=dp
+ INTEGER :: tmask_id, umask_id, vmask_id, fmask_id
+ INTEGER :: gdept_id
+ INTEGER :: gphit_id, gphiv_id, gphiu_id, gphif_id ! Variable ids
+ INTEGER :: glamt_id, glamv_id, glamu_id, glamf_id ! Variable ids
+ INTEGER :: resto_id ! Variable ID for output
+ INTEGER :: jpi, jpj, jpk ! Size of domain
+ INTEGER :: ncin, ncout ! File handles for netCDF files
+ REAL(wp), DIMENSION(:,:), ALLOCATABLE :: gphit, glamt
+ REAL(wp), DIMENSION(:,:), ALLOCATABLE :: gphiu, glamu
+ REAL(wp), DIMENSION(:,:), ALLOCATABLE :: gphiv, glamv
+ REAL(wp), DIMENSION(:,:), ALLOCATABLE :: gphif, glamf
+ REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tmask, umask, vmask, fmask
+ REAL(wp), DIMENSION(:,:), ALLOCATABLE :: gdept
+ REAL(wp), DIMENSION(:,:), ALLOCATABLE :: resto
+
+ INTEGER,PARAMETER :: numout = 6
+ INTEGER,PARAMETER :: numerr = 0
+ INTEGER,PARAMETER :: numnam = 11
+ REAL(wp),PARAMETER :: rday = 86400 ! seconds in a day
+ REAL(wp),PARAMETER :: rpi = 3.141592653589793
+ REAL(wp),PARAMETER :: rad = 3.141592653589793/180.
+ REAL(wp),PARAMETER :: ra = 6371229.
+
+ ! Namelist variables
+ CHARACTER(LEN=30) :: cp_cfg = 'ORCA'
+ CHARACTER(LEN=30) :: cp_cfz = 'No zoom'
+ INTEGER :: jp_cfg = 2
+ REAL(KIND=8) :: pn_surf = 1
+ REAL(KIND=8) :: pn_bot = 1
+ REAL(KIND=8) :: pn_dep = 1000
+ INTEGER :: nn_hdmp = 0 ! damping option
+ INTEGER :: jperio = 0 ! damping option
+ LOGICAL :: lzoom = .false.
+ LOGICAL :: ln_coast = .false.
+ LOGICAL :: ln_full_field = .true.
+ LOGICAL :: ln_med_red_seas = .false.
+ LOGICAL :: ln_old_31_lev_code = .false.
+ LOGICAL :: ln_zero_top_layer = .false.
+ LOGICAL :: ln_custom = .false.
+
+ NAMELIST/nam_dmp_create/cp_cfg, cp_cfz, jp_cfg, lzoom, ln_full_field, &
+ ln_med_red_seas, ln_old_31_lev_code, ln_coast, &
+ ln_zero_top_layer, ln_custom, &
+ pn_surf, pn_bot, pn_dep, nn_hdmp, jperio
+
+ CONTAINS
+
+ SUBROUTINE grid_info(mesh)
+ CHARACTER(LEN=*),INTENT(in) :: mesh
+
+ ! Open meshfile
+ CALL check_nf90( nf90_open(mesh, NF90_NOWRITE, ncin), 'Error opening mesh_mask file' )
+
+ ! Get size of grid from meshfile
+ CALL dimlen( ncin, 'x', jpi )
+ CALL dimlen( ncin, 'y', jpj )
+ CALL dimlen( ncin, 'z', jpk )
+
+ ALLOCATE( tmask(jpi, jpj), gdept(jpi, jpj), gphit(jpi,jpj) )
+
+ !Get ID of tmask in meshfile
+ CALL check_nf90( nf90_inq_varid( ncin, 'tmask', tmask_id ), 'Cannot get variable ID for tmask')
+ CALL check_nf90( nf90_inq_varid( ncin, 'umask', umask_id ), 'Cannot get variable ID for umask')
+ CALL check_nf90( nf90_inq_varid( ncin, 'vmask', vmask_id ), 'Cannot get variable ID for vmask')
+ CALL check_nf90( nf90_inq_varid( ncin, 'fmask', fmask_id ), 'Cannot get variable ID for fmask')
+ CALL check_nf90( nf90_inq_varid( ncin, 'gdept_0', gdept_id ), 'Cannot get variable ID for gdept_0')
+ CALL check_nf90( nf90_inq_varid( ncin, 'gphit', gphit_id ), 'Cannot get variable ID for gphit')
+ CALL check_nf90( nf90_inq_varid( ncin, 'gphiu', gphiu_id ), 'Cannot get variable ID for gphiu')
+ CALL check_nf90( nf90_inq_varid( ncin, 'gphiv', gphiv_id ), 'Cannot get variable ID for gphiv')
+ CALL check_nf90( nf90_inq_varid( ncin, 'gphif', gphif_id ), 'Cannot get variable ID for gphif')
+ CALL check_nf90( nf90_inq_varid( ncin, 'glamt', glamt_id ), 'Cannot get variable ID for glamt')
+ CALL check_nf90( nf90_inq_varid( ncin, 'glamu', glamu_id ), 'Cannot get variable ID for glamu')
+ CALL check_nf90( nf90_inq_varid( ncin, 'glamv', glamv_id ), 'Cannot get variable ID for glamv')
+ CALL check_nf90( nf90_inq_varid( ncin, 'glamf', glamf_id ), 'Cannot get variable ID for glamf')
+
+ END SUBROUTINE grid_info
+
+ SUBROUTINE dimlen( ncid, dimname, len )
+ ! Determine the length of dimension dimname
+ INTEGER, INTENT(in) :: ncid
+ CHARACTER(LEN=*), INTENT(in) :: dimname
+ INTEGER, INTENT(out) :: len
+ ! Local variables
+ INTEGER :: id_var, istatus
+
+ id_var = 1
+ CALL check_nf90( nf90_inq_dimid(ncid, dimname, id_var), 'Dimension not found in file')
+ CALL check_nf90( nf90_inquire_dimension(ncid,id_var,len=len))
+
+ END SUBROUTINE dimlen
+
+ SUBROUTINE make_outfile( filename )
+ ! Create the output file
+ ! Define dimensions and resto variable
+ CHARACTER(LEN=*), INTENT(in) :: filename
+ INTEGER :: id_x, id_y, id_z
+
+ CALL check_nf90( nf90_create(filename, NF90_CLOBBER, ncout), 'Could not create output file')
+ CALL check_nf90( nf90_def_dim(ncout, 'x', jpi, id_x) )
+ CALL check_nf90( nf90_def_dim(ncout, 'y', jpj, id_y) )
+ CALL check_nf90( nf90_def_dim(ncout, 'z', jpk, id_z) )
+
+ CALL check_nf90( nf90_def_var(ncout, 'resto', nf90_double, (/id_x,id_y,id_z/), resto_id ) )
+ CALL check_nf90( nf90_enddef(ncout) )
+
+ END SUBROUTINE make_outfile
+
+
+ SUBROUTINE check_nf90( istat, message )
+ !Check for netcdf errors
+ INTEGER, INTENT(in) :: istat
+ CHARACTER(LEN=*), INTENT(in), OPTIONAL :: message
+
+ IF (istat /= nf90_noerr) THEN
+ WRITE(numerr,*) 'ERROR! : '//TRIM(nf90_strerror(istat))
+ IF ( PRESENT(message) ) THEN ; WRITE(numerr,*) message ; ENDIF
+ STOP
+ ENDIF
+
+ END SUBROUTINE check_nf90
+
+END MODULE utils
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/DMP_TOOLS/src/zoom.F90
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/DMP_TOOLS/src/zoom.F90 (revision 5602)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/DMP_TOOLS/src/zoom.F90 (revision 5602)
@@ -0,0 +1,90 @@
+MODULE zoom
+
+ USE utils
+
+ CONTAINS
+
+ SUBROUTINE dtacof_zoom( presto, mask)
+ !!----------------------------------------------------------------------
+ !! *** ROUTINE dtacof_zoom ***
+ !!
+ !! ** Purpose : Compute the damping coefficient for zoom domain
+ !!
+ !! ** Method : - set along closed boundary due to zoom a damping over
+ !! 6 points with a max time scale of 5 days.
+ !! - ORCA arctic/antarctic zoom: set the damping along
+ !! south/north boundary over a latitude strip.
+ !!
+ !! ** Action : - resto, the damping coeff. for T and S
+ !!----------------------------------------------------------------------
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: presto ! restoring coeff. (s-1)
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: mask ! restoring coeff. (s-1)
+ !
+ INTEGER :: ji, jj, jn ! dummy loop indices
+ REAL(wp) :: zlat, zlat0, zlat1, zlat2, z1_5d ! local scalar
+ REAL(wp), DIMENSION(6) :: zfact ! 1Dworkspace
+
+ !Namelist variables
+ LOGICAL :: lzoom_w, lzoom_e, lzoom_n, lzoom_s
+ NAMELIST/nam_zoom_dmp/lzoom_n,lzoom_e,lzoom_w,lzoom_s
+ !!----------------------------------------------------------------------
+ !
+ IF( nn_timing == 1 ) CALL timing_start( 'dtacof_zoom')
+ !
+
+ ! Read namelist
+ OPEN( UNIT=numnam, FILE='namelist', FORM='FORMATTED', STATUS='OLD' )
+ READ( numnam, nam_dmp_create )
+ CLOSE( numnam )
+
+ zfact(1) = 1._wp
+ zfact(2) = 1._wp
+ zfact(3) = 11._wp / 12._wp
+ zfact(4) = 8._wp / 12._wp
+ zfact(5) = 4._wp / 12._wp
+ zfact(6) = 1._wp / 12._wp
+ zfact(:) = zfact(:) / ( 5._wp * rday ) ! 5 days max restoring time scale
+
+ presto(:,:) = 0._wp
+
+ ! damping along the forced closed boundary over 6 grid-points
+ DO jn = 1, 6
+ IF( lzoom_w ) presto( jn, : ) = zfact(jn) ! west closed
+ IF( lzoom_s ) presto( : , jn ) = zfact(jn) ! south closed
+ IF( lzoom_e ) presto( jpi+1-jn , : ) = zfact(jn) ! east closed
+ IF( lzoom_n ) presto( : , jpj+1-jn ) = zfact(jn) ! north closed
+ END DO
+
+ ! ! ====================================================
+ IF( cp_cfz == "arctic" .OR. cp_cfz == "antarctic" ) THEN ! ORCA configuration : arctic or antarctic zoom
+ ! ! ====================================================
+ WRITE(numout,*)
+ IF(cp_cfz == "arctic" ) WRITE(numout,*) ' dtacof_zoom : ORCA Arctic zoom'
+ IF(cp_cfz == "antarctic" ) WRITE(numout,*) ' dtacof_zoom : ORCA Antarctic zoom'
+ WRITE(numout,*)
+ !
+ ! ! Initialization :
+ presto(:,:) = 0._wp
+ zlat0 = 10._wp ! zlat0 : latitude strip where resto decreases
+ zlat1 = 30._wp ! zlat1 : resto = 1 before zlat1
+ zlat2 = zlat1 + zlat0 ! zlat2 : resto decreases from 1 to 0 between zlat1 and zlat2
+ z1_5d = 1._wp / ( 5._wp * rday ) ! z1_5d : 1 / 5days
+
+ DO jj = 1, jpj
+ DO ji = 1, jpi
+ zlat = ABS( gphit(ji,jj) )
+ IF( zlat1 <= zlat .AND. zlat <= zlat2 ) THEN
+ presto(ji,jj) = 0.5_wp * z1_5d * ( 1._wp - COS( rpi*(zlat2-zlat)/zlat0 ) )
+ ELSEIF( zlat < zlat1 ) THEN
+ presto(ji,jj) = z1_5d
+ ENDIF
+ END DO
+ END DO
+ !
+ ENDIF
+ ! ! Mask resto array
+ presto(:,:) = presto(:,:) * mask(:,:)
+
+ END SUBROUTINE dtacof_zoom
+
+END MODULE zoom
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/MISCELLANEOUS/chk_ifdef.sh
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/MISCELLANEOUS/chk_ifdef.sh (revision 5602)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/MISCELLANEOUS/chk_ifdef.sh (revision 5602)
@@ -0,0 +1,31 @@
+#!/bin/bash
+#
+# check the propper syntax of C preprocessor directives.
+# for example:
+#if defined key_traldf_c3d && key_traldf_smag
+# is not good and should be
+#if defined key_traldf_c3d && defined key_traldf_smag
+#
+# use: go to TOOLS/MISCELLANEOUS/ and simply execute:
+# ./chk_ifdef.sh
+#
+set -u
+#
+grep -r "^ *#if" ../../NEMO | grep -v "~:" > tmp$$ # get each lines of the code starting with #if
+grep -r "^ *#elif" ../../NEMO | grep -v "~:" >> tmp$$ # get each lines of the code starting with #elif
+#
+for ll in $( seq 1 $( cat tmp$$ | wc -l ) ) # for each of these lines
+do
+ lll=$( sed -n -e "${ll}p" tmp$$ )
+ nbdef=$( echo $lll | grep -o defined | wc -l ) # number of occurences of "defined"
+ nband=$( echo $lll | grep -o "&&" | wc -l ) # number of occurences of "&&"
+ nbor=$( echo $lll | grep -o "||" | wc -l ) # number of occurences of "||"
+ [ $nbdef -ne $(( $nband + $nbor + 1 )) ] && echo $lll # print bad line
+done
+rm -f tmp$$
+
+#
+# add other basic tests
+#
+grep -ir ":,:.*ji,jj" * | grep -v "~:"
+grep -ir "ji,jj.*:,:" * | grep -v "~:"
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/MISCELLANEOUS/chk_wrk_alloc.sh
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/MISCELLANEOUS/chk_wrk_alloc.sh (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/MISCELLANEOUS/chk_wrk_alloc.sh (revision 5602)
@@ -12,22 +12,67 @@
# ../TOOLS/MISCELLANEOUS/chk_wrk_alloc.sh
#
-set -ue
+set -u
#
echo "check for all *90 files contained in "$( pwd )" and its subdirectories"
#
-for ff in $( grep -il wrk_nemo_2 $( find . -name "*90" ) )
+for ff in $( grep -il "^ *use *wrk_nemo" $( find . -name "*90" ) $( find . -name "*h90" ) )
do
+ ierr=0
+
+ # number of lines with wrk_alloc
+ n1=$( grep -ic "call *wrk_alloc *(" $ff )
+ # number of lines with wrk_dealloc
+ nn1=$( grep -ic "call *wrk_dealloc *(" $ff )
+
+ if [ $(( $n1 + $nn1 )) -ne 0 ]
+ then
+ # replace wrk_alloc with wrk_dealloc and count the lines
+ n2=$( sed -e "s/wrk_alloc/wrk_dealloc/" $ff | grep -ic "call *wrk_dealloc *(" )
+ # we should get n2 = 2 * n1...
+ if [ $(( 2 * $n1 )) -ne $n2 ]
+ then
+ ierr=1
+ echo "problem with wrk_alloc in $ff"
+ fi
+ # same story but for wrk_dealloc
+ nn2=$( sed -e "s/wrk_dealloc/wrk_alloc/" $ff | grep -ic "call *wrk_alloc *(" )
+ if [ $(( 2 * $nn1 )) -ne $nn2 ]
+ then
+ ierr=1
+ echo "problem with wrk_dealloc in $ff"
+ fi
- # number of lines with wrk_alloc
- n1=$( grep -ic "call *wrk_alloc *(" $ff )
- # replace wrk_alloc with wrk_dealloc and count the lines
- n2=$( sed -e "s/wrk_alloc/wrk_dealloc/" $ff | grep -ic "call *wrk_dealloc *(" )
- # we should get n2 = 2 * n1...
- [ $(( 2 * $n1 )) -ne $n2 ] && echo "problem with wrk_alloc in $ff"
-
- # same story but for wrk_dealloc
- n1=$( grep -ic "call *wrk_dealloc *(" $ff )
- n2=$( sed -e "s/wrk_dealloc/wrk_alloc/" $ff | grep -ic "call *wrk_alloc *(" )
- [ $(( 2 * $n1 )) -ne $n2 ] && echo "problem with wrk_dealloc in $ff"
-
+ if [ $ierr -eq 0 ] # check that wrk_alloc block is the same as wrk_dealloc block
+ then
+ grep -i "call *wrk_alloc *(" $ff | sed -e "s/ //g" | sed -e "s/!.*//g" > txt1$$
+ grep -i "call *wrk_dealloc *(" $ff | sed -e "s/wrk_dealloc/wrk_alloc/" | sed -e "s/ //g" | sed -e "s/!.*//g" > txt2$$
+ cmp txt1$$ txt2$$
+ if [ $? -ne 0 ]
+ then
+ echo "different syntax in wrk_alloc and wrk_dealloc in $ff"
+ echo
+ for ll in $( seq 1 $n1 ) # compare each line
+ do
+ sed -n ${ll}p txt1$$ > ll1$$
+ sed -n ${ll}p txt2$$ > ll2$$
+ cmp ll1$$ ll2$$ > /dev/null
+ if [ $? -ne 0 ]
+ then
+ grep -i "call *wrk_alloc *(" $ff | sed -n ${ll}p
+ grep -i "call *wrk_dealloc *(" $ff | sed -n ${ll}p
+ echo
+ fi
+ rm -f ll1$$ ll2$$
+ done
+ fi
+ rm -f txt1$$ txt2$$
+ else
+ grep -i "call *wrk_alloc *(" $ff
+ echo
+ grep -i "call *wrk_dealloc *(" $ff
+ echo
+ fi
+
+ fi
+
done
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/MISCELLANEOUS/rewrite_nemo.sh
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/MISCELLANEOUS/rewrite_nemo.sh (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/MISCELLANEOUS/rewrite_nemo.sh (revision 5602)
@@ -1,10 +1,15 @@
#!/bin/bash
+#
+# rsync -av NEMO/ NEMO_no_wrkarrays/
+# cd NEMO_no_wrkarrays/
+# ../TOOLS/MISCELLANEOUS/rewrite_nemo.sh
+# cd ../CONFIG
+# ./makenemo -n ORCA2_LIM3 -s NEMO_no_wrkarrays
#
set -u
#set -xv
#
-# for on each file containing a call to work alloc (exept BDY files that are too complicated...)
-#for i in $( ack -il "^ *call *wrk_alloc *\(" | grep -v BDY )
-for i in $( egrep -iRl "^ *call *wrk_alloc *\(" * | grep "90$" | grep -v BDY )
+# for on each file containing a call to work alloc
+for i in $( grep -iRl "^[^\!]*call *wrk_alloc *(" * | grep "90$" )
do
# create a temporary file that will be easier to process...
@@ -28,5 +33,5 @@
#
# number of the lines containing wrk_alloc
- cnt=$( grep -ci "^ *call *wrk_alloc *(" tmp$$ )
+ cnt=$( grep -ci "^[^\!]*call *wrk_alloc *(" tmp$$ )
# for each of these lines
ll=1
@@ -34,9 +39,9 @@
do
# get the line with its number
- line=$( grep -in "^ *call *wrk_alloc *(" tmp$$ | sed -n ${ll}p | sed -e "s/\!.*//" )
+ line=$( grep -in "^[^\!]*call *wrk_alloc *(" tmp$$ | sed -n ${ll}p | sed -e "s/\!.*//" )
# get its number
lline=$( echo $line | sed -e "s/:.*//" )
# keep only the arument of wrk_alloc between ()
- line=$( echo $line | sed -e "s/[^(]*\((.*)\).*/\1/" | sed -e "s/, *k[ijkl]start *=[^,]*,/,/" | sed -e "s/, *k[ijkl]start *=.*)/ )/" )
+ line=$( echo $line | sed -e "s/^.*[cC][aA][lL][lL] *[wW][rR][kK]_[aA][lL][lL][oO][cC]//" | sed -e "s/[^(]*\((.*)\).*/\1/" | sed -e "s/, *k[ijkl]start *=[^,]*,/,/" | sed -e "s/, *k[ijkl]start *=.*)/ )/" )
# find in which subroutine or function is located this call to wrk_alloc: l1 beginning l2: end
for lll in $linesbegin
@@ -132,35 +137,71 @@
#
# OPA_SRC/SBC/albedo.F90
-sed -e "s/DIMENSION(jpi,jpj,ijpl)/DIMENSION(jpi,jpj,SIZE(pt_ice,3))/" OPA_SRC/SBC/albedo.F90 > tmp$$
+sed -e "s/DIMENSION(jpi,jpj,ijpl/DIMENSION(jpi,jpj,SIZE(pt_ice,3)/" OPA_SRC/SBC/albedo.F90 > tmp$$
mv tmp$$ OPA_SRC/SBC/albedo.F90
+# see result of
+# grep -i "wrk_alloc" $( find . -name "*90" ) | grep "="
+#
# LIM_SRC_2/limrhg_2.F90
-sed -e "s/DIMENSION(jpi,jpj+2)/DIMENSION(jpi,0:jpj+1)/" LIM_SRC_2/limrhg_2.F90 > tmp$$
+#./LIM_SRC_2/limrhg_2.F90: CALL wrk_alloc( jpi,jpj+2, zu0, zv0, zu_n, zv_n, zu_a, zv_a, zviszeta, zviseta, kjstart = 0 )
+#./LIM_SRC_2/limrhg_2.F90: CALL wrk_alloc( jpi,jpj+2, zzfrld, zztms, zi1, zi2, zmasst, zpresh, kjstart = 0 )
+sed -e "s/DIMENSION(jpi,jpj+2/DIMENSION(jpi,0:jpj+1/" LIM_SRC_2/limrhg_2.F90 > tmp$$
mv tmp$$ LIM_SRC_2/limrhg_2.F90
+
# LIM_SRC_3/limitd_me.F90
+#./LIM_SRC_3/limitd_me.F90: CALL wrk_alloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 )
sed -e "s/DIMENSION(jpi,jpj,jpl+2)/DIMENSION(jpi,jpj,-1:jpl)/" LIM_SRC_3/limitd_me.F90 > tmp$$
mv tmp$$ LIM_SRC_3/limitd_me.F90
+
# LIM_SRC_3/limitd_th.F90
+#./LIM_SRC_3/limitd_th.F90: CALL wrk_alloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 )
sed -e "s/DIMENSION(jpi,jpj,jpl+1)/DIMENSION(jpi,jpj,0:jpl)/" LIM_SRC_3/limitd_th.F90 > tmp$$
mv tmp$$ LIM_SRC_3/limitd_th.F90
+
# LIM_SRC_3/limthd_dif.F90
+#./LIM_SRC_3/limthd_dif.F90: CALL wrk_alloc( jpij,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart=0 )
+#./LIM_SRC_3/limthd_dif.F90: CALL wrk_alloc( jpij,nlay_s+1, zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart=0 )
sed -e "s/DIMENSION(kiut,nlay_i+1)/DIMENSION(kiut,0:nlay_i)/" \
-e "s/DIMENSION(kiut,nlay_s+1)/DIMENSION(kiut,0:nlay_s)/" LIM_SRC_3/limthd_dif.F90 > tmp$$
mv tmp$$ LIM_SRC_3/limthd_dif.F90
+
# LIM_SRC_3/limthd_ent.F90
-sed -e "s/DIMENSION(jpij,jkmax+4)/DIMENSION(jpij,0:jkmax+3)/" \
- -e "s/DIMENSION(jkmax+4,jkmax+4)/DIMENSION(0:jkmax+3,0:jkmax+3)/" LIM_SRC_3/limthd_ent.F90 > tmp$$
+#./LIM_SRC_3/limthd_ent.F90: CALL wrk_alloc( jpij, nlay_i+3, zqh_cum0, zh_cum0, kjstart = 0 )
+#./LIM_SRC_3/limthd_ent.F90: CALL wrk_alloc( jpij, nlay_i+1, zqh_cum1, zh_cum1, kjstart = 0 )
+sed -e "s/DIMENSION(jpij,nlay_i+3)/DIMENSION(jpij,0:nlay_i+2)/" \
+ -e "s/DIMENSION(jpij,nlay_i+1)/DIMENSION(jpij,0:nlay_i)/" LIM_SRC_3/limthd_ent.F90 > tmp$$
mv tmp$$ LIM_SRC_3/limthd_ent.F90
+
# OPA_SRC/DYN/divcur.F90
+#./OPA_SRC/DYN/divcur.F90: CALL wrk_alloc( jpi+4, jpj , zwv, kjstart = -1 )
sed -e "s/DIMENSION(jpi+4,jpj)/DIMENSION(-1:jpi+2,jpj)/" OPA_SRC/DYN/divcur.F90 > tmp$$
mv tmp$$ OPA_SRC/DYN/divcur.F90
+
# OPA_SRC/LDF/ldfslp.F90
+#./OPA_SRC/LDF/ldfslp.F90: CALL wrk_alloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho, klstart = 0 )
+#./OPA_SRC/LDF/ldfslp.F90: CALL wrk_alloc( jpi,jpj, 2,2, zti_mlb, ztj_mlb, kkstart = 0, klstart = 0 )
sed -e "s/DIMENSION(jpi,jpj,jpk,2)/DIMENSION(jpi,jpj,jpk,0:1)/" \
-e "s/DIMENSION(jpi,jpj,2,2)/DIMENSION(jpi,jpj,0:1,0:1)/" OPA_SRC/LDF/ldfslp.F90 > tmp$$
mv tmp$$ OPA_SRC/LDF/ldfslp.F90
# OPA_SRC/ZDF/zdfkpp.F90
+#./OPA_SRC/ZDF/zdfkpp.F90: CALL wrk_alloc( jpi,3, zmoek, kjstart = 0 )
sed -e "s/DIMENSION(jpi,3) *::* zmoek/DIMENSION(jpi,0:2) :: zmoek/" OPA_SRC/ZDF/zdfkpp.F90 > tmp$$
mv tmp$$ OPA_SRC/ZDF/zdfkpp.F90
-# link for limrhg.F90...
+# links
+# see result of
+# find . -type l
+#
+# ./LIM_SRC_2/limrhg.F90
cd LIM_SRC_2
ln -sf ../LIM_SRC_3/limrhg.F90 .
+cd ..
+
+# ./OOO_SRC/dtadyn.F90
+cd OOO_SRC
+ln -sf ../OFF_SRC/dtadyn.F90 .
+cd ..
+
+# ./OOO_SRC/obs_fbm.F90
+cd OOO_SRC
+ln -sf ../OPA_SRC/OBS/obs_fbm.F90 .
+cd ..
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/SIREN/README
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/SIREN/README (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/SIREN/README (revision 5602)
@@ -1,10 +1,14 @@
- This is a first draft of the CONFIGURATION MANAGER demonstrator.
- Unfortunately, there are still bugs in those tools.
- I will continue to work on it next year, to fix those bugs and add some
- improvement as handle north fold...
+This is a first release of SIREN.
- '''WARNING : there are still bugs to fix in those tools!! '''
+To create SIREN documentation, go to ./src and run doxygen
+(http://www.stack.nl/~dimitri/doxygen/index.html version 1.8.3.1 or upper)
+then
+ open ../doc/index.html
+or
+ run ../doc/latex/gmake and open refman.pdf
- ''''''
+
+templates of namelists could be find in templates directory.
+read documentation for more information.
1- program to create coordinate file :
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg (revision 5602)
@@ -1,37 +1,73 @@
-# name | units | axis | point | standard name | long name | interpolation
-X | 1 | X | | projection_x_coordinate | |
-Y | 1 | Y | | projection_y_coordinate | |
-Z | 1 | Z | | projection_z_coordinate | |
-T | 1 | T | | projection_t_coordinate | |
-nav_lon | degrees_east | XY | T | longitude | Longitude | cubic
-nav_lat | degrees_north | XY | T | latitude | Latitude | cubic
-nav_lev | model_levels | Z | T | | Model levels | cubic
-deptht | m | Z | T | depth | Vertical T levels |
-time_counter | | T | | time | Time axis |
-Bathymetry | m | XY | T | bathymetry | Bathymetry | cubic
-votemper | degree_Celsius | XYZT | T | sea_water_potential_temperature | Temperature | cubic
-vozocrtx | m s-1 | XYZT | U | | Zonal velocity | cubic
-vomecrty | m s-1 | XYZT | V | | Meridional velocity| cubic
-vosaline | PSU | XYZT | T | sea_water_salinity | Salinity | cubic
-sossheig | m | XYT | T | sea_surface_height | Sea Surface Height | cubic
-glamt | degrees_east | XY | T | | Longitude_T | cubic
-glamu | degrees_east | XY | U | | Longitude_U | cubic
-glamv | degrees_east | XY | V | | Longitude_V | cubic
-glamf | degrees_east | XY | F | | Longitude_F | cubic
-gphit | degrees_north | XY | T | | Latitude_T | cubic
-gphiu | degrees_north | XY | U | | Latitude_U | cubic
-gphiv | degrees_north | XY | V | | Latitude_V | cubic
-gphif | degrees_north | XY | F | | Latitude_F | cubic
-e1t | m | XY | T | | | cubic/rhoi
-e1u | m | XY | U | | | cubic/rhoi
-e1v | m | XY | V | | | cubic/rhoi
-e1f | m | XY | F | | | cubic/rhoi
-e2t | m | XY | T | | | cubic/rhoj
-e2u | m | XY | U | | | cubic/rhoj
-e2v | m | XY | V | | | cubic/rhoj
-e2f | m | XY | F | | | cubic/rhoj
-tmask | | XYZ | T | | | nearest
-umask | | XYZ | U | | | nearest
-vmask | | XYZ | V | | | nearest
-fmask | | XYZ | F | | | nearest
-weight | | XY | T | | |
+# name | units | axis | point | standard name | long name | interpolation
+X | 1 | X | | projection_x_coordinate | |
+Y | 1 | Y | | projection_y_coordinate | |
+Z | 1 | Z | | projection_z_coordinate | |
+T | 1 | T | | projection_t_coordinate | |
+nav_lon | degrees_east | XY | T | longitude | Longitude | cubic
+nav_lat | degrees_north | XY | T | latitude | Latitude | cubic
+nav_lev | model_levels | Z | T | | Model levels | cubic
+deptht | m | Z | T | depth | Vertical T levels |
+time_counter | | T | | time | Time axis |
+Bathymetry | m | XY | T | bathymetry | Bathymetry | cubic
+votemper | degree_Celsius | XYZT | T | sea_water_potential_temperature | Temperature | cubic
+vozocrtx | m s-1 | XYZT | U | | Zonal velocity | cubic
+vomecrty | m s-1 | XYZT | V | | Meridional velocity| cubic
+vosaline | PSU | XYZT | T | sea_water_salinity | Salinity | cubic
+sossheig | m | XYT | T | sea_surface_height | Sea Surface Height | cubic
+glamt | degrees_east | XY | T | | Longitude_T | cubic
+glamu | degrees_east | XY | U | | Longitude_U | cubic
+glamv | degrees_east | XY | V | | Longitude_V | cubic
+glamf | degrees_east | XY | F | | Longitude_F | cubic
+gphit | degrees_north | XY | T | | Latitude_T | cubic
+gphiu | degrees_north | XY | U | | Latitude_U | cubic
+gphiv | degrees_north | XY | V | | Latitude_V | cubic
+gphif | degrees_north | XY | F | | Latitude_F | cubic
+e1t | m | XY | T | | | cubic/rhoi
+e1u | m | XY | U | | | cubic/rhoi
+e1v | m | XY | V | | | cubic/rhoi
+e1f | m | XY | F | | | cubic/rhoi
+e2t | m | XY | T | | | cubic/rhoj
+e2u | m | XY | U | | | cubic/rhoj
+e2v | m | XY | V | | | cubic/rhoj
+e2f | m | XY | F | | | cubic/rhoj
+tmask | | XYZ | T | | | nearest
+umask | | XYZ | U | | | nearest
+vmask | | XYZ | V | | | nearest
+fmask | | XYZ | F | | | nearest
+weight | | XY | T | | |
+kt | | | | | |
+ndastp | | | | | |
+adatrj | | | | | |
+kt | | | | | |
+rdt | | | | | |
+rdttra1 | | | | | |
+utau_b | | XYT | U |surface_downward_eastward_stress | |
+vtau_b | | XYT | V |surface_downward_northward_stress | |
+qns_b | | XYT | T | | |
+emp_b | | XYT | T | | |
+sfx_b | | XYT | T | | |
+en | | XYZT | T | | |
+avt | | XYZT | T | | |
+avm | | XYZT | T | | |
+avmu | | XYZT | T | | |
+avmv | | XYZT | T | | |
+dissl | | XYZT | T | | |
+sbc_hc_b | | XYT | T | | |
+sbc_sc_b | | XYT | T | | |
+gcx | | XYT | T | | |
+gcxb | | XYT | T | | |
+ub | | XYZT | U | | |
+vb | | XYZT | V | | |
+tb | | XYZT | T | | |
+sb | | XYZT | T | | |
+rotb | | XYZT | T | | |
+hdivb | | XYZT | T | | |
+sshb | | XYT | T | | |
+un | | XYZT | U | | |
+vn | | XYZT | V | | |
+tn | | XYZT | T | | |
+sn | | XYZT | T | | |
+rotn | | XYZT | T | | |
+hdivn | | XYZT | T | | |
+sshn | | XYT | T | | |
+rhop | | XYZT | T | | |
Index: /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/SIREN/src/Doxyfile
===================================================================
--- /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/SIREN/src/Doxyfile (revision 5601)
+++ /branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/SIREN/src/Doxyfile (revision 5602)
@@ -1,13 +1,16 @@
-# Doxyfile 1.6.1
+# Doxyfile 1.8.8
# This file describes the settings to be used by the documentation system
-# doxygen (www.doxygen.org) for a project
-#
-# All text after a hash (#) is considered a comment and will be ignored
+# doxygen (www.doxygen.org) for a project.
+#
+# All text after a double hash (##) is considered a comment and is placed in
+# front of the TAG it is preceding.
+#
+# All text after a single hash (#) is considered a comment and will be ignored.
# The format is:
-# TAG = value [value, ...]
-# For lists items can also be appended using:
-# TAG += value [value, ...]
-# Values that contain spaces should be placed between quotes (" ")
+# TAG = value [value, ...]
+# For lists, items can also be appended using:
+# TAG += value [value, ...]
+# Values that contain spaces should be placed between quotes (\" \").
#---------------------------------------------------------------------------
@@ -16,80 +19,110 @@
# This tag specifies the encoding used for all characters in the config file
-# that follow. The default is UTF-8 which is also the encoding used for all
-# text before the first occurrence of this tag. Doxygen uses libiconv (or the
-# iconv built into libc) for the transcoding. See
-# http://www.gnu.org/software/libiconv for the list of possible encodings.
+# that follow. The default is UTF-8 which is also the encoding used for all text
+# before the first occurrence of this tag. Doxygen uses libiconv (or the iconv
+# built into libc) for the transcoding. See http://www.gnu.org/software/libiconv
+# for the list of possible encodings.
+# The default value is: UTF-8.
DOXYFILE_ENCODING = UTF-8
-# The PROJECT_NAME tag is a single word (or a sequence of words surrounded
-# by quotes) that should identify the project.
-
-PROJECT_NAME = Doxygen Fortran Example
-
-# The PROJECT_NUMBER tag can be used to enter a project or revision number.
-# This could be handy for archiving the generated documentation or
-# if some version control system is used.
-
-PROJECT_NUMBER =
-
-# The OUTPUT_DIRECTORY tag is used to specify the (relative or absolute)
-# base path where the generated documentation will be put.
-# If a relative path is entered, it will be relative to the location
-# where doxygen was started. If left blank the current directory will be used.
-
-OUTPUT_DIRECTORY =
-
-# If the CREATE_SUBDIRS tag is set to YES, then doxygen will create
-# 4096 sub-directories (in 2 levels) under the output directory of each output
-# format and will distribute the generated files over these directories.
-# Enabling this option can be useful when feeding doxygen a huge amount of
-# source files, where putting all generated files in the same directory would
-# otherwise cause performance problems for the file system.
+# The PROJECT_NAME tag is a single word (or a sequence of words surrounded by
+# double-quotes, unless you are using Doxywizard) that should identify the
+# project for which the documentation is generated. This name is used in the
+# title of most generated pages and in a few other places.
+# The default value is: My Project.
+
+PROJECT_NAME = "SIREN"
+
+# The PROJECT_NUMBER tag can be used to enter a project or revision number. This
+# could be handy for archiving the generated documentation or if some version
+# control system is used.
+
+PROJECT_NUMBER = "NEMO 3.6"
+
+# Using the PROJECT_BRIEF tag one can provide an optional one line description
+# for a project that appears at the top of each page and should give viewer a
+# quick idea about the purpose of the project. Keep the description short.
+
+PROJECT_BRIEF = "System and Interface for oceanic RElocable Nesting"
+
+# With the PROJECT_LOGO tag one can specify an logo or icon that is included in
+# the documentation. The maximum height of the logo should not exceed 55 pixels
+# and the maximum width should not exceed 200 pixels. Doxygen will copy the logo
+# to the output directory.
+
+PROJECT_LOGO = ./docsrc/Image/logoSirenNemo.png
+
+# The OUTPUT_DIRECTORY tag is used to specify the (relative or absolute) path
+# into which the generated documentation will be written. If a relative path is
+# entered, it will be relative to the location where doxygen was started. If
+# left blank the current directory will be used.
+
+OUTPUT_DIRECTORY = ../doc
+
+# If the CREATE_SUBDIRS tag is set to YES, then doxygen will create 4096 sub-
+# directories (in 2 levels) under the output directory of each output format and
+# will distribute the generated files over these directories. Enabling this
+# option can be useful when feeding doxygen a huge amount of source files, where
+# putting all generated files in the same directory would otherwise causes
+# performance problems for the file system.
+# The default value is: NO.
CREATE_SUBDIRS = NO
+
+# If the ALLOW_UNICODE_NAMES tag is set to YES, doxygen will allow non-ASCII
+# characters to appear in the names of generated files. If set to NO, non-ASCII
+# characters will be escaped, for example _xE3_x81_x84 will be used for Unicode
+# U+3044.
+# The default value is: NO.
+
+ALLOW_UNICODE_NAMES = NO
# The OUTPUT_LANGUAGE tag is used to specify the language in which all
# documentation generated by doxygen is written. Doxygen will use this
# information to generate all constant output in the proper language.
-# The default language is English, other supported languages are:
-# Afrikaans, Arabic, Brazilian, Catalan, Chinese, Chinese-Traditional,
-# Croatian, Czech, Danish, Dutch, Esperanto, Farsi, Finnish, French, German,
-# Greek, Hungarian, Italian, Japanese, Japanese-en (Japanese with English
-# messages), Korean, Korean-en, Lithuanian, Norwegian, Macedonian, Persian,
-# Polish, Portuguese, Romanian, Russian, Serbian, Serbian-Cyrilic, Slovak,
-# Slovene, Spanish, Swedish, Ukrainian, and Vietnamese.
+# Possible values are: Afrikaans, Arabic, Armenian, Brazilian, Catalan, Chinese,
+# Chinese-Traditional, Croatian, Czech, Danish, Dutch, English (United States),
+# Esperanto, Farsi (Persian), Finnish, French, German, Greek, Hungarian,
+# Indonesian, Italian, Japanese, Japanese-en (Japanese with English messages),
+# Korean, Korean-en (Korean with English messages), Latvian, Lithuanian,
+# Macedonian, Norwegian, Persian (Farsi), Polish, Portuguese, Romanian, Russian,
+# Serbian, Serbian-Cyrillic, Slovak, Slovene, Spanish, Swedish, Turkish,
+# Ukrainian and Vietnamese.
+# The default value is: English.
OUTPUT_LANGUAGE = English
-# If the BRIEF_MEMBER_DESC tag is set to YES (the default) Doxygen will
-# include brief member descriptions after the members that are listed in
-# the file and class documentation (similar to JavaDoc).
-# Set to NO to disable this.
+# If the BRIEF_MEMBER_DESC tag is set to YES doxygen will include brief member
+# descriptions after the members that are listed in the file and class
+# documentation (similar to Javadoc). Set to NO to disable this.
+# The default value is: YES.
BRIEF_MEMBER_DESC = YES
-# If the REPEAT_BRIEF tag is set to YES (the default) Doxygen will prepend
-# the brief description of a member or function before the detailed description.
-# Note: if both HIDE_UNDOC_MEMBERS and BRIEF_MEMBER_DESC are set to NO, the
+# If the REPEAT_BRIEF tag is set to YES doxygen will prepend the brief
+# description of a member or function before the detailed description
+#
+# Note: If both HIDE_UNDOC_MEMBERS and BRIEF_MEMBER_DESC are set to NO, the
# brief descriptions will be completely suppressed.
+# The default value is: YES.
REPEAT_BRIEF = YES
-# This tag implements a quasi-intelligent brief description abbreviator
-# that is used to form the text in various listings. Each string
-# in this list, if found as the leading text of the brief description, will be
-# stripped from the text and the result after processing the whole list, is
-# used as the annotated text. Otherwise, the brief description is used as-is.
-# If left blank, the following values are used ("$name" is automatically
-# replaced with the name of the entity): "The $name class" "The $name widget"
-# "The $name file" "is" "provides" "specifies" "contains"
-# "represents" "a" "an" "the"
+# This tag implements a quasi-intelligent brief description abbreviator that is
+# used to form the text in various listings. Each string in this list, if found
+# as the leading text of the brief description, will be stripped from the text
+# and the result, after processing the whole list, is used as the annotated
+# text. Otherwise, the brief description is used as-is. If left blank, the
+# following values are used ($name is automatically replaced with the name of
+# the entity):The $name class, The $name widget, The $name file, is, provides,
+# specifies, contains, represents, a, an and the.
ABBREVIATE_BRIEF =
# If the ALWAYS_DETAILED_SEC and REPEAT_BRIEF tags are both set to YES then
-# Doxygen will generate a detailed section even if there is only a brief
+# doxygen will generate a detailed section even if there is only a brief
# description.
+# The default value is: NO.
ALWAYS_DETAILED_SEC = NO
@@ -99,130 +132,181 @@
# members were ordinary class members. Constructors, destructors and assignment
# operators of the base classes will not be shown.
+# The default value is: NO.
INLINE_INHERITED_MEMB = NO
-# If the FULL_PATH_NAMES tag is set to YES then Doxygen will prepend the full
-# path before files name in the file list and in the header files. If set
-# to NO the shortest path that makes the file name unique will be used.
+# If the FULL_PATH_NAMES tag is set to YES doxygen will prepend the full path
+# before files name in the file list and in the header files. If set to NO the
+# shortest path that makes the file name unique will be used
+# The default value is: YES.
FULL_PATH_NAMES = YES
-# If the FULL_PATH_NAMES tag is set to YES then the STRIP_FROM_PATH tag
-# can be used to strip a user-defined part of the path. Stripping is
-# only done if one of the specified strings matches the left-hand part of
-# the path. The tag can be used to show relative paths in the file list.
-# If left blank the directory from which doxygen is run is used as the
-# path to strip.
+# The STRIP_FROM_PATH tag can be used to strip a user-defined part of the path.
+# Stripping is only done if one of the specified strings matches the left-hand
+# part of the path. The tag can be used to show relative paths in the file list.
+# If left blank the directory from which doxygen is run is used as the path to
+# strip.
+#
+# Note that you can specify absolute paths here, but also relative paths, which
+# will be relative from the directory where doxygen is started.
+# This tag requires that the tag FULL_PATH_NAMES is set to YES.
STRIP_FROM_PATH =
-# The STRIP_FROM_INC_PATH tag can be used to strip a user-defined part of
-# the path mentioned in the documentation of a class, which tells
-# the reader which header file to include in order to use a class.
-# If left blank only the name of the header file containing the class
-# definition is used. Otherwise one should specify the include paths that
-# are normally passed to the compiler using the -I flag.
+# The STRIP_FROM_INC_PATH tag can be used to strip a user-defined part of the
+# path mentioned in the documentation of a class, which tells the reader which
+# header file to include in order to use a class. If left blank only the name of
+# the header file containing the class definition is used. Otherwise one should
+# specify the list of include paths that are normally passed to the compiler
+# using the -I flag.
STRIP_FROM_INC_PATH =
-# If the SHORT_NAMES tag is set to YES, doxygen will generate much shorter
-# (but less readable) file names. This can be useful is your file systems
-# doesn't support long names like on DOS, Mac, or CD-ROM.
+# If the SHORT_NAMES tag is set to YES, doxygen will generate much shorter (but
+# less readable) file names. This can be useful is your file systems doesn't
+# support long names like on DOS, Mac, or CD-ROM.
+# The default value is: NO.
SHORT_NAMES = NO
-# If the JAVADOC_AUTOBRIEF tag is set to YES then Doxygen
-# will interpret the first line (until the first dot) of a JavaDoc-style
-# comment as the brief description. If set to NO, the JavaDoc
-# comments will behave just like regular Qt-style comments
-# (thus requiring an explicit @brief command for a brief description.)
+# If the JAVADOC_AUTOBRIEF tag is set to YES then doxygen will interpret the
+# first line (until the first dot) of a Javadoc-style comment as the brief
+# description. If set to NO, the Javadoc-style will behave just like regular Qt-
+# style comments (thus requiring an explicit @brief command for a brief
+# description.)
+# The default value is: NO.
JAVADOC_AUTOBRIEF = NO
-# If the QT_AUTOBRIEF tag is set to YES then Doxygen will
-# interpret the first line (until the first dot) of a Qt-style
-# comment as the brief description. If set to NO, the comments
-# will behave just like regular Qt-style comments (thus requiring
-# an explicit \brief command for a brief description.)
+# If the QT_AUTOBRIEF tag is set to YES then doxygen will interpret the first
+# line (until the first dot) of a Qt-style comment as the brief description. If
+# set to NO, the Qt-style will behave just like regular Qt-style comments (thus
+# requiring an explicit \brief command for a brief description.)
+# The default value is: NO.
QT_AUTOBRIEF = NO
-# The MULTILINE_CPP_IS_BRIEF tag can be set to YES to make Doxygen
-# treat a multi-line C++ special comment block (i.e. a block of //! or ///
-# comments) as a brief description. This used to be the default behaviour.
-# The new default is to treat a multi-line C++ comment block as a detailed
-# description. Set this tag to YES if you prefer the old behaviour instead.
+# The MULTILINE_CPP_IS_BRIEF tag can be set to YES to make doxygen treat a
+# multi-line C++ special comment block (i.e. a block of //! or /// comments) as
+# a brief description. This used to be the default behavior. The new default is
+# to treat a multi-line C++ comment block as a detailed description. Set this
+# tag to YES if you prefer the old behavior instead.
+#
+# Note that setting this tag to YES also means that rational rose comments are
+# not recognized any more.
+# The default value is: NO.
MULTILINE_CPP_IS_BRIEF = NO
-# If the INHERIT_DOCS tag is set to YES (the default) then an undocumented
-# member inherits the documentation from any documented member that it
-# re-implements.
+# If the INHERIT_DOCS tag is set to YES then an undocumented member inherits the
+# documentation from any documented member that it re-implements.
+# The default value is: YES.
INHERIT_DOCS = YES
-# If the SEPARATE_MEMBER_PAGES tag is set to YES, then doxygen will produce
-# a new page for each member. If set to NO, the documentation of a member will
-# be part of the file/class/namespace that contains it.
+# If the SEPARATE_MEMBER_PAGES tag is set to YES, then doxygen will produce a
+# new page for each member. If set to NO, the documentation of a member will be
+# part of the file/class/namespace that contains it.
+# The default value is: NO.
SEPARATE_MEMBER_PAGES = NO
-# The TAB_SIZE tag can be used to set the number of spaces in a tab.
-# Doxygen uses this value to replace tabs by spaces in code fragments.
-
-TAB_SIZE = 8
-
-# This tag can be used to specify a number of aliases that acts
-# as commands in the documentation. An alias has the form "name=value".
-# For example adding "sideeffect=\par Side Effects:\n" will allow you to
-# put the command \sideeffect (or @sideeffect) in the documentation, which
-# will result in a user-defined paragraph with heading "Side Effects:".
-# You can put \n's in the value part of an alias to insert newlines.
+# The TAB_SIZE tag can be used to set the number of spaces in a tab. Doxygen
+# uses this value to replace tabs by spaces in code fragments.
+# Minimum value: 1, maximum value: 16, default value: 4.
+
+TAB_SIZE = 3
+
+# This tag can be used to specify a number of aliases that act as commands in
+# the documentation. An alias has the form:
+# name=value
+# For example adding
+# "sideeffect=@par Side Effects:\n"
+# will allow you to put the command \sideeffect (or @sideeffect) in the
+# documentation, which will result in a user-defined paragraph with heading
+# "Side Effects:". You can put \n's in the value part of an alias to insert
+# newlines.
ALIASES =
-# Set the OPTIMIZE_OUTPUT_FOR_C tag to YES if your project consists of C
-# sources only. Doxygen will then generate output that is more tailored for C.
-# For instance, some of the names that are used will be different. The list
-# of all members will be omitted, etc.
+# This tag can be used to specify a number of word-keyword mappings (TCL only).
+# A mapping has the form "name=value". For example adding "class=itcl::class"
+# will allow you to use the command class in the itcl::class meaning.
+
+TCL_SUBST =
+
+# Set the OPTIMIZE_OUTPUT_FOR_C tag to YES if your project consists of C sources
+# only. Doxygen will then generate output that is more tailored for C. For
+# instance, some of the names that are used will be different. The list of all
+# members will be omitted, etc.
+# The default value is: NO.
OPTIMIZE_OUTPUT_FOR_C = NO
-# Set the OPTIMIZE_OUTPUT_JAVA tag to YES if your project consists of Java
-# sources only. Doxygen will then generate output that is more tailored for
-# Java. For instance, namespaces will be presented as packages, qualified
-# scopes will look different, etc.
+# Set the OPTIMIZE_OUTPUT_JAVA tag to YES if your project consists of Java or
+# Python sources only. Doxygen will then generate output that is more tailored
+# for that language. For instance, namespaces will be presented as packages,
+# qualified scopes will look different, etc.
+# The default value is: NO.
OPTIMIZE_OUTPUT_JAVA = NO
# Set the OPTIMIZE_FOR_FORTRAN tag to YES if your project consists of Fortran
-# sources only. Doxygen will then generate output that is more tailored for
-# Fortran.
-
-OPTIMIZE_FOR_FORTRAN = YES
+# sources. Doxygen will then generate output that is tailored for Fortran.
+# The default value is: NO.
+
+OPTIMIZE_FOR_FORTRAN = NO
# Set the OPTIMIZE_OUTPUT_VHDL tag to YES if your project consists of VHDL
-# sources. Doxygen will then generate output that is tailored for
-# VHDL.
+# sources. Doxygen will then generate output that is tailored for VHDL.
+# The default value is: NO.
OPTIMIZE_OUTPUT_VHDL = NO
-# Doxygen selects the parser to use depending on the extension of the files it parses.
-# With this tag you can assign which parser to use for a given extension.
-# Doxygen has a built-in mapping, but you can override or extend it using this tag.
-# The format is ext=language, where ext is a file extension, and language is one of
-# the parsers supported by doxygen: IDL, Java, Javascript, C#, C, C++, D, PHP,
-# Objective-C, Python, Fortran, VHDL, C, C++. For instance to make doxygen treat
-# .inc files as Fortran files (default is PHP), and .f files as C (default is Fortran),
-# use: inc=Fortran f=C. Note that for custom extensions you also need to set FILE_PATTERNS otherwise the files are not read by doxygen.
-
-EXTENSION_MAPPING =
+# Doxygen selects the parser to use depending on the extension of the files it
+# parses. With this tag you can assign which parser to use for a given
+# extension. Doxygen has a built-in mapping, but you can override or extend it
+# using this tag. The format is ext=language, where ext is a file extension, and
+# language is one of the parsers supported by doxygen: IDL, Java, Javascript,
+# C#, C, C++, D, PHP, Objective-C, Python, Fortran (fixed format Fortran:
+# FortranFixed, free formatted Fortran: FortranFree, unknown formatted Fortran:
+# Fortran. In the later case the parser tries to guess whether the code is fixed
+# or free formatted code, this is the default for Fortran type files), VHDL. For
+# instance to make doxygen treat .inc files as Fortran files (default is PHP),
+# and .f files as C (default is Fortran), use: inc=Fortran f=C.
+#
+# Note For files without extension you can use no_extension as a placeholder.
+#
+# Note that for custom extensions you also need to set FILE_PATTERNS otherwise
+# the files are not read by doxygen.
+
+EXTENSION_MAPPING =
+
+# If the MARKDOWN_SUPPORT tag is enabled then doxygen pre-processes all comments
+# according to the Markdown format, which allows for more readable
+# documentation. See http://daringfireball.net/projects/markdown/ for details.
+# The output of markdown processing is further processed by doxygen, so you can
+# mix doxygen, HTML, and XML commands with Markdown formatting. Disable only in
+# case of backward compatibilities issues.
+# The default value is: YES.
+
+MARKDOWN_SUPPORT = YES
+
+# When enabled doxygen tries to link words that correspond to documented
+# classes, or namespaces to their corresponding documentation. Such a link can
+# be prevented in individual cases by by putting a % sign in front of the word
+# or globally by setting AUTOLINK_SUPPORT to NO.
+# The default value is: YES.
+
+AUTOLINK_SUPPORT = YES
# If you use STL classes (i.e. std::string, std::vector, etc.) but do not want
-# to include (a tag file for) the STL sources as input, then you should
-# set this tag to YES in order to let doxygen match functions declarations and
-# definitions whose arguments contain STL classes (e.g. func(std::string); v.s.
-# func(std::string) {}). This also make the inheritance and collaboration
+# to include (a tag file for) the STL sources as input, then you should set this
+# tag to YES in order to let doxygen match functions declarations and
+# definitions whose arguments contain STL classes (e.g. func(std::string);
+# versus func(std::string) {}). This also make the inheritance and collaboration
# diagrams that involve STL classes more complete and accurate.
+# The default value is: NO.
BUILTIN_STL_SUPPORT = NO
@@ -230,19 +314,23 @@
# If you use Microsoft's C++/CLI language, you should set this option to YES to
# enable parsing support.
+# The default value is: NO.
CPP_CLI_SUPPORT = NO
-# Set the SIP_SUPPORT tag to YES if your project consists of sip sources only.
-# Doxygen will parse them like normal C++ but will assume all classes use public
-# instead of private inheritance when no explicit protection keyword is present.
+# Set the SIP_SUPPORT tag to YES if your project consists of sip (see:
+# http://www.riverbankcomputing.co.uk/software/sip/intro) sources only. Doxygen
+# will parse them like normal C++ but will assume all classes use public instead
+# of private inheritance when no explicit protection keyword is present.
+# The default value is: NO.
SIP_SUPPORT = NO
-# For Microsoft's IDL there are propget and propput attributes to indicate getter
-# and setter methods for a property. Setting this option to YES (the default)
-# will make doxygen to replace the get and set methods by a property in the
-# documentation. This will only work if the methods are indeed getting or
-# setting a simple type. If this is not the case, or you want to show the
-# methods anyway, you should set this option to NO.
+# For Microsoft's IDL there are propget and propput attributes to indicate
+# getter and setter methods for a property. Setting this option to YES will make
+# doxygen to replace the get and set methods by a property in the documentation.
+# This will only work if the methods are indeed getting or setting a simple
+# type. If this is not the case, or you want to show the methods anyway, you
+# should set this option to NO.
+# The default value is: YES.
IDL_PROPERTY_SUPPORT = YES
@@ -252,40 +340,61 @@
# member in the group (if any) for the other members of the group. By default
# all members of a group must be documented explicitly.
+# The default value is: NO.
DISTRIBUTE_GROUP_DOC = NO
-# Set the SUBGROUPING tag to YES (the default) to allow class member groups of
-# the same type (for instance a group of public functions) to be put as a
-# subgroup of that type (e.g. under the Public Functions section). Set it to
-# NO to prevent subgrouping. Alternatively, this can be done per class using
-# the \nosubgrouping command.
+# Set the SUBGROUPING tag to YES to allow class member groups of the same type
+# (for instance a group of public functions) to be put as a subgroup of that
+# type (e.g. under the Public Functions section). Set it to NO to prevent
+# subgrouping. Alternatively, this can be done per class using the
+# \nosubgrouping command.
+# The default value is: YES.
SUBGROUPING = YES
-# When TYPEDEF_HIDES_STRUCT is enabled, a typedef of a struct, union, or enum
-# is documented as struct, union, or enum with the name of the typedef. So
+# When the INLINE_GROUPED_CLASSES tag is set to YES, classes, structs and unions
+# are shown inside the group in which they are included (e.g. using \ingroup)
+# instead of on a separate page (for HTML and Man pages) or section (for LaTeX
+# and RTF).
+#
+# Note that this feature does not work in combination with
+# SEPARATE_MEMBER_PAGES.
+# The default value is: NO.
+
+INLINE_GROUPED_CLASSES = NO
+
+# When the INLINE_SIMPLE_STRUCTS tag is set to YES, structs, classes, and unions
+# with only public data fields or simple typedef fields will be shown inline in
+# the documentation of the scope in which they are defined (i.e. file,
+# namespace, or group documentation), provided this scope is documented. If set
+# to NO, structs, classes, and unions are shown on a separate page (for HTML and
+# Man pages) or section (for LaTeX and RTF).
+# The default value is: NO.
+
+INLINE_SIMPLE_STRUCTS = NO
+
+# When TYPEDEF_HIDES_STRUCT tag is enabled, a typedef of a struct, union, or
+# enum is documented as struct, union, or enum with the name of the typedef. So
# typedef struct TypeS {} TypeT, will appear in the documentation as a struct
# with name TypeT. When disabled the typedef will appear as a member of a file,
-# namespace, or class. And the struct will be named TypeS. This can typically
-# be useful for C code in case the coding convention dictates that all compound
+# namespace, or class. And the struct will be named TypeS. This can typically be
+# useful for C code in case the coding convention dictates that all compound
# types are typedef'ed and only the typedef is referenced, never the tag name.
+# The default value is: NO.
TYPEDEF_HIDES_STRUCT = NO
-# The SYMBOL_CACHE_SIZE determines the size of the internal cache use to
-# determine which symbols to keep in memory and which to flush to disk.
-# When the cache is full, less often used symbols will be written to disk.
-# For small to medium size projects (<1000 input files) the default value is
-# probably good enough. For larger projects a too small cache size can cause
-# doxygen to be busy swapping symbols to and from disk most of the time
-# causing a significant performance penality.
-# If the system has enough physical memory increasing the cache will improve the
-# performance by keeping more symbols in memory. Note that the value works on
-# a logarithmic scale so increasing the size by one will rougly double the
-# memory usage. The cache size is given by this formula:
-# 2^(16+SYMBOL_CACHE_SIZE). The valid range is 0..9, the default is 0,
-# corresponding to a cache size of 2^16 = 65536 symbols
-
-SYMBOL_CACHE_SIZE = 0
+# The size of the symbol lookup cache can be set using LOOKUP_CACHE_SIZE. This
+# cache is used to resolve symbols given their name and scope. Since this can be
+# an expensive process and often the same symbol appears multiple times in the
+# code, doxygen keeps a cache of pre-resolved symbols. If the cache is too small
+# doxygen will become slower. If the cache is too large, memory is wasted. The
+# cache size is given by this formula: 2^(16+LOOKUP_CACHE_SIZE). The valid range
+# is 0..9, the default is 0, corresponding to a cache size of 2^16=65536
+# symbols. At the end of a run doxygen will report the cache usage and suggest
+# the optimal cache size from a speed point of view.
+# Minimum value: 0, maximum value: 9, default value: 0.
+
+LOOKUP_CACHE_SIZE = 0
#---------------------------------------------------------------------------
@@ -294,30 +403,44 @@
# If the EXTRACT_ALL tag is set to YES doxygen will assume all entities in
-# documentation are documented, even if no documentation was available.
-# Private class members and static file members will be hidden unless
-# the EXTRACT_PRIVATE and EXTRACT_STATIC tags are set to YES
-
-EXTRACT_ALL = YES
-
-# If the EXTRACT_PRIVATE tag is set to YES all private members of a class
-# will be included in the documentation.
+# documentation are documented, even if no documentation was available. Private
+# class members and static file members will be hidden unless the
+# EXTRACT_PRIVATE respectively EXTRACT_STATIC tags are set to YES.
+# Note: This will also disable the warnings about undocumented members that are
+# normally produced when WARNINGS is set to YES.
+# The default value is: NO.
+
+EXTRACT_ALL = NO
+
+# If the EXTRACT_PRIVATE tag is set to YES all private members of a class will
+# be included in the documentation.
+# The default value is: NO.
EXTRACT_PRIVATE = NO
-# If the EXTRACT_STATIC tag is set to YES all static members of a file
-# will be included in the documentation.
+# If the EXTRACT_PACKAGE tag is set to YES all members with package or internal
+# scope will be included in the documentation.
+# The default value is: NO.
+
+EXTRACT_PACKAGE = NO
+
+# If the EXTRACT_STATIC tag is set to YES all static members of a file will be
+# included in the documentation.
+# The default value is: NO.
EXTRACT_STATIC = NO
-# If the EXTRACT_LOCAL_CLASSES tag is set to YES classes (and structs)
-# defined locally in source files will be included in the documentation.
-# If set to NO only classes defined in header files are included.
+# If the EXTRACT_LOCAL_CLASSES tag is set to YES classes (and structs) defined
+# locally in source files will be included in the documentation. If set to NO
+# only classes defined in header files are included. Does not have any effect
+# for Java sources.
+# The default value is: YES.
EXTRACT_LOCAL_CLASSES = YES
-# This flag is only useful for Objective-C code. When set to YES local
-# methods, which are defined in the implementation section but not in
-# the interface are included in the documentation.
-# If set to NO (the default) only methods in the interface are included.
+# This flag is only useful for Objective-C code. When set to YES local methods,
+# which are defined in the implementation section but not in the interface are
+# included in the documentation. If set to NO only methods in the interface are
+# included.
+# The default value is: NO.
EXTRACT_LOCAL_METHODS = NO
@@ -325,166 +448,205 @@
# If this flag is set to YES, the members of anonymous namespaces will be
# extracted and appear in the documentation as a namespace called
-# 'anonymous_namespace{file}', where file will be replaced with the base
-# name of the file that contains the anonymous namespace. By default
-# anonymous namespace are hidden.
+# 'anonymous_namespace{file}', where file will be replaced with the base name of
+# the file that contains the anonymous namespace. By default anonymous namespace
+# are hidden.
+# The default value is: NO.
EXTRACT_ANON_NSPACES = NO
-# If the HIDE_UNDOC_MEMBERS tag is set to YES, Doxygen will hide all
-# undocumented members of documented classes, files or namespaces.
-# If set to NO (the default) these members will be included in the
-# various overviews, but no documentation section is generated.
-# This option has no effect if EXTRACT_ALL is enabled.
+# If the HIDE_UNDOC_MEMBERS tag is set to YES, doxygen will hide all
+# undocumented members inside documented classes or files. If set to NO these
+# members will be included in the various overviews, but no documentation
+# section is generated. This option has no effect if EXTRACT_ALL is enabled.
+# The default value is: NO.
HIDE_UNDOC_MEMBERS = NO
-# If the HIDE_UNDOC_CLASSES tag is set to YES, Doxygen will hide all
-# undocumented classes that are normally visible in the class hierarchy.
-# If set to NO (the default) these classes will be included in the various
-# overviews. This option has no effect if EXTRACT_ALL is enabled.
+# If the HIDE_UNDOC_CLASSES tag is set to YES, doxygen will hide all
+# undocumented classes that are normally visible in the class hierarchy. If set
+# to NO these classes will be included in the various overviews. This option has
+# no effect if EXTRACT_ALL is enabled.
+# The default value is: NO.
HIDE_UNDOC_CLASSES = NO
-# If the HIDE_FRIEND_COMPOUNDS tag is set to YES, Doxygen will hide all
-# friend (class|struct|union) declarations.
-# If set to NO (the default) these declarations will be included in the
-# documentation.
+# If the HIDE_FRIEND_COMPOUNDS tag is set to YES, doxygen will hide all friend
+# (class|struct|union) declarations. If set to NO these declarations will be
+# included in the documentation.
+# The default value is: NO.
HIDE_FRIEND_COMPOUNDS = NO
-# If the HIDE_IN_BODY_DOCS tag is set to YES, Doxygen will hide any
-# documentation blocks found inside the body of a function.
-# If set to NO (the default) these blocks will be appended to the
-# function's detailed documentation block.
+# If the HIDE_IN_BODY_DOCS tag is set to YES, doxygen will hide any
+# documentation blocks found inside the body of a function. If set to NO these
+# blocks will be appended to the function's detailed documentation block.
+# The default value is: NO.
HIDE_IN_BODY_DOCS = NO
-# The INTERNAL_DOCS tag determines if documentation
-# that is typed after a \internal command is included. If the tag is set
-# to NO (the default) then the documentation will be excluded.
-# Set it to YES to include the internal documentation.
+# The INTERNAL_DOCS tag determines if documentation that is typed after a
+# \internal command is included. If the tag is set to NO then the documentation
+# will be excluded. Set it to YES to include the internal documentation.
+# The default value is: NO.
INTERNAL_DOCS = NO
-# If the CASE_SENSE_NAMES tag is set to NO then Doxygen will only generate
-# file names in lower-case letters. If set to YES upper-case letters are also
+# If the CASE_SENSE_NAMES tag is set to NO then doxygen will only generate file
+# names in lower-case letters. If set to YES upper-case letters are also
# allowed. This is useful if you have classes or files whose names only differ
# in case and if your file system supports case sensitive file names. Windows
# and Mac users are advised to set this option to NO.
+# The default value is: system dependent.
CASE_SENSE_NAMES = YES
-# If the HIDE_SCOPE_NAMES tag is set to NO (the default) then Doxygen
-# will show members with their full class and namespace scopes in the
-# documentation. If set to YES the scope will be hidden.
+# If the HIDE_SCOPE_NAMES tag is set to NO then doxygen will show members with
+# their full class and namespace scopes in the documentation. If set to YES the
+# scope will be hidden.
+# The default value is: NO.
HIDE_SCOPE_NAMES = NO
-# If the SHOW_INCLUDE_FILES tag is set to YES (the default) then Doxygen
-# will put a list of the files that are included by a file in the documentation
-# of that file.
+# If the SHOW_INCLUDE_FILES tag is set to YES then doxygen will put a list of
+# the files that are included by a file in the documentation of that file.
+# The default value is: YES.
SHOW_INCLUDE_FILES = YES
-# If the INLINE_INFO tag is set to YES (the default) then a tag [inline]
-# is inserted in the documentation for inline members.
+# If the SHOW_GROUPED_MEMB_INC tag is set to YES then Doxygen will add for each
+# grouped member an include statement to the documentation, telling the reader
+# which file to include in order to use the member.
+# The default value is: NO.
+
+SHOW_GROUPED_MEMB_INC = NO
+
+# If the FORCE_LOCAL_INCLUDES tag is set to YES then doxygen will list include
+# files with double quotes in the documentation rather than with sharp brackets.
+# The default value is: NO.
+
+FORCE_LOCAL_INCLUDES = NO
+
+# If the INLINE_INFO tag is set to YES then a tag [inline] is inserted in the
+# documentation for inline members.
+# The default value is: YES.
INLINE_INFO = YES
-# If the SORT_MEMBER_DOCS tag is set to YES (the default) then doxygen
-# will sort the (detailed) documentation of file and class members
-# alphabetically by member name. If set to NO the members will appear in
-# declaration order.
+# If the SORT_MEMBER_DOCS tag is set to YES then doxygen will sort the
+# (detailed) documentation of file and class members alphabetically by member
+# name. If set to NO the members will appear in declaration order.
+# The default value is: YES.
SORT_MEMBER_DOCS = YES
-# If the SORT_BRIEF_DOCS tag is set to YES then doxygen will sort the
-# brief documentation of file, namespace and class members alphabetically
-# by member name. If set to NO (the default) the members will appear in
-# declaration order.
+# If the SORT_BRIEF_DOCS tag is set to YES then doxygen will sort the brief
+# descriptions of file, namespace and class members alphabetically by member
+# name. If set to NO the members will appear in declaration order. Note that
+# this will also influence the order of the classes in the class list.
+# The default value is: NO.
SORT_BRIEF_DOCS = NO
-# If the SORT_MEMBERS_CTORS_1ST tag is set to YES then doxygen will sort the (brief and detailed) documentation of class members so that constructors and destructors are listed first. If set to NO (the default) the constructors will appear in the respective orders defined by SORT_MEMBER_DOCS and SORT_BRIEF_DOCS. This tag will be ignored for brief docs if SORT_BRIEF_DOCS is set to NO and ignored for detailed docs if SORT_MEMBER_DOCS is set to NO.
+# If the SORT_MEMBERS_CTORS_1ST tag is set to YES then doxygen will sort the
+# (brief and detailed) documentation of class members so that constructors and
+# destructors are listed first. If set to NO the constructors will appear in the
+# respective orders defined by SORT_BRIEF_DOCS and SORT_MEMBER_DOCS.
+# Note: If SORT_BRIEF_DOCS is set to NO this option is ignored for sorting brief
+# member documentation.
+# Note: If SORT_MEMBER_DOCS is set to NO this option is ignored for sorting
+# detailed member documentation.
+# The default value is: NO.
SORT_MEMBERS_CTORS_1ST = NO
-# If the SORT_GROUP_NAMES tag is set to YES then doxygen will sort the
-# hierarchy of group names into alphabetical order. If set to NO (the default)
-# the group names will appear in their defined order.
+# If the SORT_GROUP_NAMES tag is set to YES then doxygen will sort the hierarchy
+# of group names into alphabetical order. If set to NO the group names will
+# appear in their defined order.
+# The default value is: NO.
SORT_GROUP_NAMES = NO
-# If the SORT_BY_SCOPE_NAME tag is set to YES, the class list will be
-# sorted by fully-qualified names, including namespaces. If set to
-# NO (the default), the class list will be sorted only by class name,
-# not including the namespace part.
+# If the SORT_BY_SCOPE_NAME tag is set to YES, the class list will be sorted by
+# fully-qualified names, including namespaces. If set to NO, the class list will
+# be sorted only by class name, not including the namespace part.
# Note: This option is not very useful if HIDE_SCOPE_NAMES is set to YES.
-# Note: This option applies only to the class list, not to the
-# alphabetical list.
+# Note: This option applies only to the class list, not to the alphabetical
+# list.
+# The default value is: NO.
SORT_BY_SCOPE_NAME = NO
-# The GENERATE_TODOLIST tag can be used to enable (YES) or
-# disable (NO) the todo list. This list is created by putting \todo
-# commands in the documentation.
+# If the STRICT_PROTO_MATCHING option is enabled and doxygen fails to do proper
+# type resolution of all parameters of a function it will reject a match between
+# the prototype and the implementation of a member function even if there is
+# only one candidate or it is obvious which candidate to choose by doing a
+# simple string match. By disabling STRICT_PROTO_MATCHING doxygen will still
+# accept a match between prototype and implementation in such cases.
+# The default value is: NO.
+
+STRICT_PROTO_MATCHING = NO
+
+# The GENERATE_TODOLIST tag can be used to enable ( YES) or disable ( NO) the
+# todo list. This list is created by putting \todo commands in the
+# documentation.
+# The default value is: YES.
GENERATE_TODOLIST = YES
-# The GENERATE_TESTLIST tag can be used to enable (YES) or
-# disable (NO) the test list. This list is created by putting \test
-# commands in the documentation.
+# The GENERATE_TESTLIST tag can be used to enable ( YES) or disable ( NO) the
+# test list. This list is created by putting \test commands in the
+# documentation.
+# The default value is: YES.
GENERATE_TESTLIST = YES
-# The GENERATE_BUGLIST tag can be used to enable (YES) or
-# disable (NO) the bug list. This list is created by putting \bug
-# commands in the documentation.
+# The GENERATE_BUGLIST tag can be used to enable ( YES) or disable ( NO) the bug
+# list. This list is created by putting \bug commands in the documentation.
+# The default value is: YES.
GENERATE_BUGLIST = YES
-# The GENERATE_DEPRECATEDLIST tag can be used to enable (YES) or
-# disable (NO) the deprecated list. This list is created by putting
-# \deprecated commands in the documentation.
+# The GENERATE_DEPRECATEDLIST tag can be used to enable ( YES) or disable ( NO)
+# the deprecated list. This list is created by putting \deprecated commands in
+# the documentation.
+# The default value is: YES.
GENERATE_DEPRECATEDLIST= YES
-# The ENABLED_SECTIONS tag can be used to enable conditional
-# documentation sections, marked by \if sectionname ... \endif.
+# The ENABLED_SECTIONS tag can be used to enable conditional documentation
+# sections, marked by \if ... \endif and \cond
+# ... \endcond blocks.
ENABLED_SECTIONS =
-# The MAX_INITIALIZER_LINES tag determines the maximum number of lines
-# the initial value of a variable or define consists of for it to appear in
-# the documentation. If the initializer consists of more lines than specified
-# here it will be hidden. Use a value of 0 to hide initializers completely.
-# The appearance of the initializer of individual variables and defines in the
-# documentation can be controlled using \showinitializer or \hideinitializer
-# command in the documentation regardless of this setting.
+# The MAX_INITIALIZER_LINES tag determines the maximum number of lines that the
+# initial value of a variable or macro / define can have for it to appear in the
+# documentation. If the initializer consists of more lines than specified here
+# it will be hidden. Use a value of 0 to hide initializers completely. The
+# appearance of the value of individual variables and macros / defines can be
+# controlled using \showinitializer or \hideinitializer command in the
+# documentation regardless of this setting.
+# Minimum value: 0, maximum value: 10000, default value: 30.
MAX_INITIALIZER_LINES = 30
-# Set the SHOW_USED_FILES tag to NO to disable the list of files generated
-# at the bottom of the documentation of classes and structs. If set to YES the
-# list will mention the files that were used to generate the documentation.
+# Set the SHOW_USED_FILES tag to NO to disable the list of files generated at
+# the bottom of the documentation of classes and structs. If set to YES the list
+# will mention the files that were used to generate the documentation.
+# The default value is: YES.
SHOW_USED_FILES = YES
-# If the sources in your project are distributed over multiple directories
-# then setting the SHOW_DIRECTORIES tag to YES will show the directory hierarchy
-# in the documentation. The default is NO.
-
-SHOW_DIRECTORIES = NO
-
-# Set the SHOW_FILES tag to NO to disable the generation of the Files page.
-# This will remove the Files entry from the Quick Index and from the
-# Folder Tree View (if specified). The default is YES.
+# Set the SHOW_FILES tag to NO to disable the generation of the Files page. This
+# will remove the Files entry from the Quick Index and from the Folder Tree View
+# (if specified).
+# The default value is: YES.
SHOW_FILES = YES
-# Set the SHOW_NAMESPACES tag to NO to disable the generation of the
-# Namespaces page.
-# This will remove the Namespaces entry from the Quick Index
-# and from the Folder Tree View (if specified). The default is YES.
+# Set the SHOW_NAMESPACES tag to NO to disable the generation of the Namespaces
+# page. This will remove the Namespaces entry from the Quick Index and from the
+# Folder Tree View (if specified).
+# The default value is: YES.
SHOW_NAMESPACES = YES
@@ -493,114 +655,144 @@
# doxygen should invoke to get the current version for each file (typically from
# the version control system). Doxygen will invoke the program by executing (via
-# popen()) the command , where is the value of
-# the FILE_VERSION_FILTER tag, and is the name of an input file
-# provided by doxygen. Whatever the program writes to standard output
-# is used as the file version. See the manual for examples.
+# popen()) the command command input-file, where command is the value of the
+# FILE_VERSION_FILTER tag, and input-file is the name of an input file provided
+# by doxygen. Whatever the program writes to standard output is used as the file
+# version. For an example see the documentation.
FILE_VERSION_FILTER =
-# The LAYOUT_FILE tag can be used to specify a layout file which will be parsed by
-# doxygen. The layout file controls the global structure of the generated output files
-# in an output format independent way. The create the layout file that represents
-# doxygen's defaults, run doxygen with the -l option. You can optionally specify a
-# file name after the option, if omitted DoxygenLayout.xml will be used as the name
-# of the layout file.
+# The LAYOUT_FILE tag can be used to specify a layout file which will be parsed
+# by doxygen. The layout file controls the global structure of the generated
+# output files in an output format independent way. To create the layout file
+# that represents doxygen's defaults, run doxygen with the -l option. You can
+# optionally specify a file name after the option, if omitted DoxygenLayout.xml
+# will be used as the name of the layout file.
+#
+# Note that if you run doxygen from a directory containing a file called
+# DoxygenLayout.xml, doxygen will parse it automatically even if the LAYOUT_FILE
+# tag is left empty.
LAYOUT_FILE =
-#---------------------------------------------------------------------------
-# configuration options related to warning and progress messages
-#---------------------------------------------------------------------------
-
-# The QUIET tag can be used to turn on/off the messages that are generated
-# by doxygen. Possible values are YES and NO. If left blank NO is used.
+# The CITE_BIB_FILES tag can be used to specify one or more bib files containing
+# the reference definitions. This must be a list of .bib files. The .bib
+# extension is automatically appended if omitted. This requires the bibtex tool
+# to be installed. See also http://en.wikipedia.org/wiki/BibTeX for more info.
+# For LaTeX the style of the bibliography can be controlled using
+# LATEX_BIB_STYLE. To use this feature you need bibtex and perl available in the
+# search path. See also \cite for info how to create references.
+
+CITE_BIB_FILES =
+
+#---------------------------------------------------------------------------
+# Configuration options related to warning and progress messages
+#---------------------------------------------------------------------------
+
+# The QUIET tag can be used to turn on/off the messages that are generated to
+# standard output by doxygen. If QUIET is set to YES this implies that the
+# messages are off.
+# The default value is: NO.
QUIET = NO
# The WARNINGS tag can be used to turn on/off the warning messages that are
-# generated by doxygen. Possible values are YES and NO. If left blank
-# NO is used.
+# generated to standard error ( stderr) by doxygen. If WARNINGS is set to YES
+# this implies that the warnings are on.
+#
+# Tip: Turn warnings on while writing the documentation.
+# The default value is: YES.
WARNINGS = YES
-# If WARN_IF_UNDOCUMENTED is set to YES, then doxygen will generate warnings
-# for undocumented members. If EXTRACT_ALL is set to YES then this flag will
-# automatically be disabled.
+# If the WARN_IF_UNDOCUMENTED tag is set to YES, then doxygen will generate
+# warnings for undocumented members. If EXTRACT_ALL is set to YES then this flag
+# will automatically be disabled.
+# The default value is: YES.
WARN_IF_UNDOCUMENTED = YES
-# If WARN_IF_DOC_ERROR is set to YES, doxygen will generate warnings for
-# potential errors in the documentation, such as not documenting some
-# parameters in a documented function, or documenting parameters that
-# don't exist or using markup commands wrongly.
+# If the WARN_IF_DOC_ERROR tag is set to YES, doxygen will generate warnings for
+# potential errors in the documentation, such as not documenting some parameters
+# in a documented function, or documenting parameters that don't exist or using
+# markup commands wrongly.
+# The default value is: YES.
WARN_IF_DOC_ERROR = YES
-# This WARN_NO_PARAMDOC option can be abled to get warnings for
-# functions that are documented, but have no documentation for their parameters
-# or return value. If set to NO (the default) doxygen will only warn about
-# wrong or incomplete parameter documentation, but not about the absence of
-# documentation.
+# This WARN_NO_PARAMDOC option can be enabled to get warnings for functions that
+# are documented, but have no documentation for their parameters or return
+# value. If set to NO doxygen will only warn about wrong or incomplete parameter
+# documentation, but not about the absence of documentation.
+# The default value is: NO.
WARN_NO_PARAMDOC = NO
-# The WARN_FORMAT tag determines the format of the warning messages that
-# doxygen can produce. The string should contain the $file, $line, and $text
-# tags, which will be replaced by the file and line number from which the
-# warning originated and the warning text. Optionally the format may contain
-# $version, which will be replaced by the version of the file (if it could
-# be obtained via FILE_VERSION_FILTER)
+# The WARN_FORMAT tag determines the format of the warning messages that doxygen
+# can produce. The string should contain the $file, $line, and $text tags, which
+# will be replaced by the file and line number from which the warning originated
+# and the warning text. Optionally the format may contain $version, which will
+# be replaced by the version of the file (if it could be obtained via
+# FILE_VERSION_FILTER)
+# The default value is: $file:$line: $text.
WARN_FORMAT = "$file:$line: $text"
-# The WARN_LOGFILE tag can be used to specify a file to which warning
-# and error messages should be written. If left blank the output is written
-# to stderr.
+# The WARN_LOGFILE tag can be used to specify a file to which warning and error
+# messages should be written. If left blank the output is written to standard
+# error (stderr).
WARN_LOGFILE =
#---------------------------------------------------------------------------
-# configuration options related to the input files
-#---------------------------------------------------------------------------
-
-# The INPUT tag can be used to specify the files and/or directories that contain
-# documented source files. You may enter file names like "myfile.cpp" or
-# directories like "/usr/src/myproject". Separate the files or directories
-# with spaces.
-
-INPUT =
+# Configuration options related to the input files
+#---------------------------------------------------------------------------
+
+# The INPUT tag is used to specify the files and/or directories that contain
+# documented source files. You may enter file names like myfile.cpp or
+# directories like /usr/src/myproject. Separate the files or directories with
+# spaces.
+# Note: If this tag is empty the current directory is searched.
+
+INPUT = . ./docsrc
# This tag can be used to specify the character encoding of the source files
-# that doxygen parses. Internally doxygen uses the UTF-8 encoding, which is
-# also the default input encoding. Doxygen uses libiconv (or the iconv built
-# into libc) for the transcoding. See http://www.gnu.org/software/libiconv for
-# the list of possible encodings.
+# that doxygen parses. Internally doxygen uses the UTF-8 encoding. Doxygen uses
+# libiconv (or the iconv built into libc) for the transcoding. See the libiconv
+# documentation (see: http://www.gnu.org/software/libiconv) for the list of
+# possible encodings.
+# The default value is: UTF-8.
INPUT_ENCODING = UTF-8
# If the value of the INPUT tag contains directories, you can use the
-# FILE_PATTERNS tag to specify one or more wildcard pattern (like *.cpp
-# and *.h) to filter out the source-files in the directories. If left
-# blank the following patterns are tested:
-# *.c *.cc *.cxx *.cpp *.c++ *.java *.ii *.ixx *.ipp *.i++ *.inl *.h *.hh *.hxx
-# *.hpp *.h++ *.idl *.odl *.cs *.php *.php3 *.inc *.m *.mm *.py *.f90
-
-FILE_PATTERNS = *.f90
-
-# The RECURSIVE tag can be used to turn specify whether or not subdirectories
-# should be searched for input files as well. Possible values are YES and NO.
-# If left blank NO is used.
+# FILE_PATTERNS tag to specify one or more wildcard patterns (like *.cpp and
+# *.h) to filter out the source-files in the directories. If left blank the
+# following patterns are tested:*.c, *.cc, *.cxx, *.cpp, *.c++, *.java, *.ii,
+# *.ixx, *.ipp, *.i++, *.inl, *.idl, *.ddl, *.odl, *.h, *.hh, *.hxx, *.hpp,
+# *.h++, *.cs, *.d, *.php, *.php4, *.php5, *.phtml, *.inc, *.m, *.markdown,
+# *.md, *.mm, *.dox, *.py, *.f90, *.f, *.for, *.tcl, *.vhd, *.vhdl, *.ucf,
+# *.qsf, *.as and *.js.
+
+FILE_PATTERNS =
+
+# The RECURSIVE tag can be used to specify whether or not subdirectories should
+# be searched for input files as well.
+# The default value is: NO.
RECURSIVE = NO
-# The EXCLUDE tag can be used to specify files and/or directories that should
+# The EXCLUDE tag can be used to specify files and/or directories that should be
# excluded from the INPUT source files. This way you can easily exclude a
# subdirectory from a directory tree whose root is specified with the INPUT tag.
+#
+# Note that relative paths are relative to the directory from which doxygen is
+# run.
EXCLUDE =
-# The EXCLUDE_SYMLINKS tag can be used select whether or not files or
-# directories that are symbolic links (a Unix filesystem feature) are excluded
+# The EXCLUDE_SYMLINKS tag can be used to select whether or not files or
+# directories that are symbolic links (a Unix file system feature) are excluded
# from the input.
+# The default value is: NO.
EXCLUDE_SYMLINKS = NO
@@ -608,7 +800,8 @@
# If the value of the INPUT tag contains directories, you can use the
# EXCLUDE_PATTERNS tag to specify one or more wildcard patterns to exclude
-# certain files from those directories. Note that the wildcards are matched
-# against the file with absolute path, so to exclude all test directories
-# for example use the pattern */test/*
+# certain files from those directories.
+#
+# Note that the wildcards are matched against the file with absolute path, so to
+# exclude all test directories for example use the pattern */test/*
EXCLUDE_PATTERNS =
@@ -619,596 +812,1087 @@
# wildcard * is used, a substring. Examples: ANamespace, AClass,
# AClass::ANamespace, ANamespace::*Test
+#
+# Note that the wildcards are matched against the file with absolute path, so to
+# exclude all test directories use the pattern */test/*
EXCLUDE_SYMBOLS =
-# The EXAMPLE_PATH tag can be used to specify one or more files or
-# directories that contain example code fragments that are included (see
-# the \include command).
+# The EXAMPLE_PATH tag can be used to specify one or more files or directories
+# that contain example code fragments that are included (see the \include
+# command).
EXAMPLE_PATH =
# If the value of the EXAMPLE_PATH tag contains directories, you can use the
-# EXAMPLE_PATTERNS tag to specify one or more wildcard pattern (like *.cpp
-# and *.h) to filter out the source-files in the directories. If left
-# blank all files are included.
+# EXAMPLE_PATTERNS tag to specify one or more wildcard pattern (like *.cpp and
+# *.h) to filter out the source-files in the directories. If left blank all
+# files are included.
EXAMPLE_PATTERNS =
# If the EXAMPLE_RECURSIVE tag is set to YES then subdirectories will be
-# searched for input files to be used with the \include or \dontinclude
-# commands irrespective of the value of the RECURSIVE tag.
-# Possible values are YES and NO. If left blank NO is used.
+# searched for input files to be used with the \include or \dontinclude commands
+# irrespective of the value of the RECURSIVE tag.
+# The default value is: NO.
EXAMPLE_RECURSIVE = NO
-# The IMAGE_PATH tag can be used to specify one or more files or
-# directories that contain image that are included in the documentation (see
-# the \image command).
-
-IMAGE_PATH =
+# The IMAGE_PATH tag can be used to specify one or more files or directories
+# that contain images that are to be included in the documentation (see the
+# \image command).
+
+IMAGE_PATH = ./docsrc/Image
# The INPUT_FILTER tag can be used to specify a program that doxygen should
# invoke to filter for each input file. Doxygen will invoke the filter program
-# by executing (via popen()) the command , where
-# is the value of the INPUT_FILTER tag, and is the name of an
-# input file. Doxygen will then use the output that the filter program writes
-# to standard output.
-# If FILTER_PATTERNS is specified, this tag will be
-# ignored.
+# by executing (via popen()) the command:
+#
+#
+#
+# where is the value of the INPUT_FILTER tag, and is the
+# name of an input file. Doxygen will then use the output that the filter
+# program writes to standard output. If FILTER_PATTERNS is specified, this tag
+# will be ignored.
+#
+# Note that the filter must not add or remove lines; it is applied before the
+# code is scanned, but not when the output code is generated. If lines are added
+# or removed, the anchors will not be placed correctly.
INPUT_FILTER =
# The FILTER_PATTERNS tag can be used to specify filters on a per file pattern
-# basis.
-# Doxygen will compare the file name with each pattern and apply the
-# filter if there is a match.
-# The filters are a list of the form:
-# pattern=filter (like *.cpp=my_cpp_filter). See INPUT_FILTER for further
-# info on how filters are used. If FILTER_PATTERNS is empty, INPUT_FILTER
-# is applied to all files.
+# basis. Doxygen will compare the file name with each pattern and apply the
+# filter if there is a match. The filters are a list of the form: pattern=filter
+# (like *.cpp=my_cpp_filter). See INPUT_FILTER for further information on how
+# filters are used. If the FILTER_PATTERNS tag is empty or if none of the
+# patterns match the file name, INPUT_FILTER is applied.
FILTER_PATTERNS =
# If the FILTER_SOURCE_FILES tag is set to YES, the input filter (if set using
-# INPUT_FILTER) will be used to filter the input files when producing source
-# files to browse (i.e. when SOURCE_BROWSER is set to YES).
+# INPUT_FILTER ) will also be used to filter the input files that are used for
+# producing the source files to browse (i.e. when SOURCE_BROWSER is set to YES).
+# The default value is: NO.
FILTER_SOURCE_FILES = NO
-#---------------------------------------------------------------------------
-# configuration options related to source browsing
-#---------------------------------------------------------------------------
-
-# If the SOURCE_BROWSER tag is set to YES then a list of source files will
-# be generated. Documented entities will be cross-referenced with these sources.
-# Note: To get rid of all source code in the generated output, make sure also
-# VERBATIM_HEADERS is set to NO.
+# The FILTER_SOURCE_PATTERNS tag can be used to specify source filters per file
+# pattern. A pattern will override the setting for FILTER_PATTERN (if any) and
+# it is also possible to disable source filtering for a specific pattern using
+# *.ext= (so without naming a filter).
+# This tag requires that the tag FILTER_SOURCE_FILES is set to YES.
+
+FILTER_SOURCE_PATTERNS =
+
+# If the USE_MDFILE_AS_MAINPAGE tag refers to the name of a markdown file that
+# is part of the input, its contents will be placed on the main page
+# (index.html). This can be useful if you have a project on for instance GitHub
+# and want to reuse the introduction page also for the doxygen output.
+
+USE_MDFILE_AS_MAINPAGE =
+
+#---------------------------------------------------------------------------
+# Configuration options related to source browsing
+#---------------------------------------------------------------------------
+
+# If the SOURCE_BROWSER tag is set to YES then a list of source files will be
+# generated. Documented entities will be cross-referenced with these sources.
+#
+# Note: To get rid of all source code in the generated output, make sure that
+# also VERBATIM_HEADERS is set to NO.
+# The default value is: NO.
SOURCE_BROWSER = NO
-# Setting the INLINE_SOURCES tag to YES will include the body
-# of functions and classes directly in the documentation.
+# Setting the INLINE_SOURCES tag to YES will include the body of functions,
+# classes and enums directly into the documentation.
+# The default value is: NO.
INLINE_SOURCES = NO
-# Setting the STRIP_CODE_COMMENTS tag to YES (the default) will instruct
-# doxygen to hide any special comment blocks from generated source code
-# fragments. Normal C and C++ comments will always remain visible.
+# Setting the STRIP_CODE_COMMENTS tag to YES will instruct doxygen to hide any
+# special comment blocks from generated source code fragments. Normal C, C++ and
+# Fortran comments will always remain visible.
+# The default value is: YES.
STRIP_CODE_COMMENTS = YES
-# If the REFERENCED_BY_RELATION tag is set to YES
-# then for each documented function all documented
-# functions referencing it will be listed.
+# If the REFERENCED_BY_RELATION tag is set to YES then for each documented
+# function all documented functions referencing it will be listed.
+# The default value is: NO.
REFERENCED_BY_RELATION = NO
-# If the REFERENCES_RELATION tag is set to YES
-# then for each documented function all documented entities
-# called/used by that function will be listed.
+# If the REFERENCES_RELATION tag is set to YES then for each documented function
+# all documented entities called/used by that function will be listed.
+# The default value is: NO.
REFERENCES_RELATION = NO
-# If the REFERENCES_LINK_SOURCE tag is set to YES (the default)
-# and SOURCE_BROWSER tag is set to YES, then the hyperlinks from
-# functions in REFERENCES_RELATION and REFERENCED_BY_RELATION lists will
-# link to the source code.
-# Otherwise they will link to the documentation.
+# If the REFERENCES_LINK_SOURCE tag is set to YES and SOURCE_BROWSER tag is set
+# to YES, then the hyperlinks from functions in REFERENCES_RELATION and
+# REFERENCED_BY_RELATION lists will link to the source code. Otherwise they will
+# link to the documentation.
+# The default value is: YES.
REFERENCES_LINK_SOURCE = YES
-# If the USE_HTAGS tag is set to YES then the references to source code
-# will point to the HTML generated by the htags(1) tool instead of doxygen
-# built-in source browser. The htags tool is part of GNU's global source
-# tagging system (see http://www.gnu.org/software/global/global.html). You
-# will need version 4.8.6 or higher.
+# If SOURCE_TOOLTIPS is enabled (the default) then hovering a hyperlink in the
+# source code will show a tooltip with additional information such as prototype,
+# brief description and links to the definition and documentation. Since this
+# will make the HTML file larger and loading of large files a bit slower, you
+# can opt to disable this feature.
+# The default value is: YES.
+# This tag requires that the tag SOURCE_BROWSER is set to YES.
+
+SOURCE_TOOLTIPS = YES
+
+# If the USE_HTAGS tag is set to YES then the references to source code will
+# point to the HTML generated by the htags(1) tool instead of doxygen built-in
+# source browser. The htags tool is part of GNU's global source tagging system
+# (see http://www.gnu.org/software/global/global.html). You will need version
+# 4.8.6 or higher.
+#
+# To use it do the following:
+# - Install the latest version of global
+# - Enable SOURCE_BROWSER and USE_HTAGS in the config file
+# - Make sure the INPUT points to the root of the source tree
+# - Run doxygen as normal
+#
+# Doxygen will invoke htags (and that will in turn invoke gtags), so these
+# tools must be available from the command line (i.e. in the search path).
+#
+# The result: instead of the source browser generated by doxygen, the links to
+# source code will now point to the output of htags.
+# The default value is: NO.
+# This tag requires that the tag SOURCE_BROWSER is set to YES.
USE_HTAGS = NO
-# If the VERBATIM_HEADERS tag is set to YES (the default) then Doxygen
-# will generate a verbatim copy of the header file for each class for
-# which an include is specified. Set to NO to disable this.
+# If the VERBATIM_HEADERS tag is set the YES then doxygen will generate a
+# verbatim copy of the header file for each class for which an include is
+# specified. Set to NO to disable this.
+# See also: Section \class.
+# The default value is: YES.
VERBATIM_HEADERS = YES
#---------------------------------------------------------------------------
-# configuration options related to the alphabetical class index
-#---------------------------------------------------------------------------
-
-# If the ALPHABETICAL_INDEX tag is set to YES, an alphabetical index
-# of all compounds will be generated. Enable this if the project
-# contains a lot of classes, structs, unions or interfaces.
+# Configuration options related to the alphabetical class index
+#---------------------------------------------------------------------------
+
+# If the ALPHABETICAL_INDEX tag is set to YES, an alphabetical index of all
+# compounds will be generated. Enable this if the project contains a lot of
+# classes, structs, unions or interfaces.
+# The default value is: YES.
ALPHABETICAL_INDEX = NO
-# If the alphabetical index is enabled (see ALPHABETICAL_INDEX) then
-# the COLS_IN_ALPHA_INDEX tag can be used to specify the number of columns
-# in which this list will be split (can be a number in the range [1..20])
+# The COLS_IN_ALPHA_INDEX tag can be used to specify the number of columns in
+# which the alphabetical index list will be split.
+# Minimum value: 1, maximum value: 20, default value: 5.
+# This tag requires that the tag ALPHABETICAL_INDEX is set to YES.
COLS_IN_ALPHA_INDEX = 5
-# In case all classes in a project start with a common prefix, all
-# classes will be put under the same header in the alphabetical index.
-# The IGNORE_PREFIX tag can be used to specify one or more prefixes that
-# should be ignored while generating the index headers.
+# In case all classes in a project start with a common prefix, all classes will
+# be put under the same header in the alphabetical index. The IGNORE_PREFIX tag
+# can be used to specify a prefix (or a list of prefixes) that should be ignored
+# while generating the index headers.
+# This tag requires that the tag ALPHABETICAL_INDEX is set to YES.
IGNORE_PREFIX =
#---------------------------------------------------------------------------
-# configuration options related to the HTML output
-#---------------------------------------------------------------------------
-
-# If the GENERATE_HTML tag is set to YES (the default) Doxygen will
-# generate HTML output.
+# Configuration options related to the HTML output
+#---------------------------------------------------------------------------
+
+# If the GENERATE_HTML tag is set to YES doxygen will generate HTML output
+# The default value is: YES.
GENERATE_HTML = YES
-# The HTML_OUTPUT tag is used to specify where the HTML docs will be put.
-# If a relative path is entered the value of OUTPUT_DIRECTORY will be
-# put in front of it. If left blank `html' will be used as the default path.
+# The HTML_OUTPUT tag is used to specify where the HTML docs will be put. If a
+# relative path is entered the value of OUTPUT_DIRECTORY will be put in front of
+# it.
+# The default directory is: html.
+# This tag requires that the tag GENERATE_HTML is set to YES.
HTML_OUTPUT = html
-# The HTML_FILE_EXTENSION tag can be used to specify the file extension for
-# each generated HTML page (for example: .htm,.php,.asp). If it is left blank
-# doxygen will generate files with .html extension.
+# The HTML_FILE_EXTENSION tag can be used to specify the file extension for each
+# generated HTML page (for example: .htm, .php, .asp).
+# The default value is: .html.
+# This tag requires that the tag GENERATE_HTML is set to YES.
HTML_FILE_EXTENSION = .html
-# The HTML_HEADER tag can be used to specify a personal HTML header for
-# each generated HTML page. If it is left blank doxygen will generate a
+# The HTML_HEADER tag can be used to specify a user-defined HTML header file for
+# each generated HTML page. If the tag is left blank doxygen will generate a
# standard header.
+#
+# To get valid HTML the header file that includes any scripts and style sheets
+# that doxygen needs, which is dependent on the configuration options used (e.g.
+# the setting GENERATE_TREEVIEW). It is highly recommended to start with a
+# default header using
+# doxygen -w html new_header.html new_footer.html new_stylesheet.css
+# YourConfigFile
+# and then modify the file new_header.html. See also section "Doxygen usage"
+# for information on how to generate the default header that doxygen normally
+# uses.
+# Note: The header is subject to change so you typically have to regenerate the
+# default header when upgrading to a newer version of doxygen. For a description
+# of the possible markers and block names see the documentation.
+# This tag requires that the tag GENERATE_HTML is set to YES.
HTML_HEADER =
-# The HTML_FOOTER tag can be used to specify a personal HTML footer for
-# each generated HTML page. If it is left blank doxygen will generate a
-# standard footer.
+# The HTML_FOOTER tag can be used to specify a user-defined HTML footer for each
+# generated HTML page. If the tag is left blank doxygen will generate a standard
+# footer. See HTML_HEADER for more information on how to generate a default
+# footer and what special commands can be used inside the footer. See also
+# section "Doxygen usage" for information on how to generate the default footer
+# that doxygen normally uses.
+# This tag requires that the tag GENERATE_HTML is set to YES.
HTML_FOOTER =
-# If the HTML_TIMESTAMP tag is set to YES then the generated HTML
-# documentation will contain the timesstamp.
-
-HTML_TIMESTAMP = NO
-
-# The HTML_STYLESHEET tag can be used to specify a user-defined cascading
-# style sheet that is used by each HTML page. It can be used to
-# fine-tune the look of the HTML output. If the tag is left blank doxygen
-# will generate a default style sheet. Note that doxygen will try to copy
-# the style sheet file to the HTML output directory, so don't put your own
-# stylesheet in the HTML output directory as well, or it will be erased!
+# The HTML_STYLESHEET tag can be used to specify a user-defined cascading style
+# sheet that is used by each HTML page. It can be used to fine-tune the look of
+# the HTML output. If left blank doxygen will generate a default style sheet.
+# See also section "Doxygen usage" for information on how to generate the style
+# sheet that doxygen normally uses.
+# Note: It is recommended to use HTML_EXTRA_STYLESHEET instead of this tag, as
+# it is more robust and this tag (HTML_STYLESHEET) will in the future become
+# obsolete.
+# This tag requires that the tag GENERATE_HTML is set to YES.
HTML_STYLESHEET =
-# If the HTML_ALIGN_MEMBERS tag is set to YES, the members of classes,
-# files or namespaces will be aligned in HTML using tables. If set to
-# NO a bullet list will be used.
-
-HTML_ALIGN_MEMBERS = YES
+# The HTML_EXTRA_STYLESHEET tag can be used to specify additional user-defined
+# cascading style sheets that are included after the standard style sheets
+# created by doxygen. Using this option one can overrule certain style aspects.
+# This is preferred over using HTML_STYLESHEET since it does not replace the
+# standard style sheet and is therefor more robust against future updates.
+# Doxygen will copy the style sheet files to the output directory.
+# Note: The order of the extra stylesheet files is of importance (e.g. the last
+# stylesheet in the list overrules the setting of the previous ones in the
+# list). For an example see the documentation.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_EXTRA_STYLESHEET =
+
+# The HTML_EXTRA_FILES tag can be used to specify one or more extra images or
+# other source files which should be copied to the HTML output directory. Note
+# that these files will be copied to the base HTML output directory. Use the
+# $relpath^ marker in the HTML_HEADER and/or HTML_FOOTER files to load these
+# files. In the HTML_STYLESHEET file, use the file name only. Also note that the
+# files will be copied as-is; there are no commands or markers available.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_EXTRA_FILES =
+
+# The HTML_COLORSTYLE_HUE tag controls the color of the HTML output. Doxygen
+# will adjust the colors in the stylesheet and background images according to
+# this color. Hue is specified as an angle on a colorwheel, see
+# http://en.wikipedia.org/wiki/Hue for more information. For instance the value
+# 0 represents red, 60 is yellow, 120 is green, 180 is cyan, 240 is blue, 300
+# purple, and 360 is red again.
+# Minimum value: 0, maximum value: 359, default value: 220.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_COLORSTYLE_HUE = 220
+
+# The HTML_COLORSTYLE_SAT tag controls the purity (or saturation) of the colors
+# in the HTML output. For a value of 0 the output will use grayscales only. A
+# value of 255 will produce the most vivid colors.
+# Minimum value: 0, maximum value: 255, default value: 100.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_COLORSTYLE_SAT = 100
+
+# The HTML_COLORSTYLE_GAMMA tag controls the gamma correction applied to the
+# luminance component of the colors in the HTML output. Values below 100
+# gradually make the output lighter, whereas values above 100 make the output
+# darker. The value divided by 100 is the actual gamma applied, so 80 represents
+# a gamma of 0.8, The value 220 represents a gamma of 2.2, and 100 does not
+# change the gamma.
+# Minimum value: 40, maximum value: 240, default value: 80.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_COLORSTYLE_GAMMA = 80
+
+# If the HTML_TIMESTAMP tag is set to YES then the footer of each generated HTML
+# page will contain the date and time when the page was generated. Setting this
+# to NO can help when comparing the output of multiple runs.
+# The default value is: YES.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_TIMESTAMP = YES
# If the HTML_DYNAMIC_SECTIONS tag is set to YES then the generated HTML
# documentation will contain sections that can be hidden and shown after the
-# page has loaded. For this to work a browser that supports
-# JavaScript and DHTML is required (for instance Mozilla 1.0+, Firefox
-# Netscape 6.0+, Internet explorer 5.0+, Konqueror, or Safari).
+# page has loaded.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTML is set to YES.
HTML_DYNAMIC_SECTIONS = NO
-# If the GENERATE_DOCSET tag is set to YES, additional index files
-# will be generated that can be used as input for Apple's Xcode 3
-# integrated development environment, introduced with OSX 10.5 (Leopard).
-# To create a documentation set, doxygen will generate a Makefile in the
-# HTML output directory. Running make will produce the docset in that
-# directory and running "make install" will install the docset in
-# ~/Library/Developer/Shared/Documentation/DocSets so that Xcode will find
-# it at startup.
-# See http://developer.apple.com/tools/creatingdocsetswithdoxygen.html for more information.
+# With HTML_INDEX_NUM_ENTRIES one can control the preferred number of entries
+# shown in the various tree structured indices initially; the user can expand
+# and collapse entries dynamically later on. Doxygen will expand the tree to
+# such a level that at most the specified number of entries are visible (unless
+# a fully collapsed tree already exceeds this amount). So setting the number of
+# entries 1 will produce a full collapsed tree by default. 0 is a special value
+# representing an infinite number of entries and will result in a full expanded
+# tree by default.
+# Minimum value: 0, maximum value: 9999, default value: 100.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_INDEX_NUM_ENTRIES = 100
+
+# If the GENERATE_DOCSET tag is set to YES, additional index files will be
+# generated that can be used as input for Apple's Xcode 3 integrated development
+# environment (see: http://developer.apple.com/tools/xcode/), introduced with
+# OSX 10.5 (Leopard). To create a documentation set, doxygen will generate a
+# Makefile in the HTML output directory. Running make will produce the docset in
+# that directory and running make install will install the docset in
+# ~/Library/Developer/Shared/Documentation/DocSets so that Xcode will find it at
+# startup. See http://developer.apple.com/tools/creatingdocsetswithdoxygen.html
+# for more information.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTML is set to YES.
GENERATE_DOCSET = NO
-# When GENERATE_DOCSET tag is set to YES, this tag determines the name of the
-# feed. A documentation feed provides an umbrella under which multiple
-# documentation sets from a single provider (such as a company or product suite)
-# can be grouped.
+# This tag determines the name of the docset feed. A documentation feed provides
+# an umbrella under which multiple documentation sets from a single provider
+# (such as a company or product suite) can be grouped.
+# The default value is: Doxygen generated docs.
+# This tag requires that the tag GENERATE_DOCSET is set to YES.
DOCSET_FEEDNAME = "Doxygen generated docs"
-# When GENERATE_DOCSET tag is set to YES, this tag specifies a string that
-# should uniquely identify the documentation set bundle. This should be a
-# reverse domain-name style string, e.g. com.mycompany.MyDocSet. Doxygen
-# will append .docset to the name.
+# This tag specifies a string that should uniquely identify the documentation
+# set bundle. This should be a reverse domain-name style string, e.g.
+# com.mycompany.MyDocSet. Doxygen will append .docset to the name.
+# The default value is: org.doxygen.Project.
+# This tag requires that the tag GENERATE_DOCSET is set to YES.
DOCSET_BUNDLE_ID = org.doxygen.Project
-# If the GENERATE_HTMLHELP tag is set to YES, additional index files
-# will be generated that can be used as input for tools like the
-# Microsoft HTML help workshop to generate a compiled HTML help file (.chm)
-# of the generated HTML documentation.
+# The DOCSET_PUBLISHER_ID tag specifies a string that should uniquely identify
+# the documentation publisher. This should be a reverse domain-name style
+# string, e.g. com.mycompany.MyDocSet.documentation.
+# The default value is: org.doxygen.Publisher.
+# This tag requires that the tag GENERATE_DOCSET is set to YES.
+
+DOCSET_PUBLISHER_ID = org.doxygen.Publisher
+
+# The DOCSET_PUBLISHER_NAME tag identifies the documentation publisher.
+# The default value is: Publisher.
+# This tag requires that the tag GENERATE_DOCSET is set to YES.
+
+DOCSET_PUBLISHER_NAME = Publisher
+
+# If the GENERATE_HTMLHELP tag is set to YES then doxygen generates three
+# additional HTML index files: index.hhp, index.hhc, and index.hhk. The
+# index.hhp is a project file that can be read by Microsoft's HTML Help Workshop
+# (see: http://www.microsoft.com/en-us/download/details.aspx?id=21138) on
+# Windows.
+#
+# The HTML Help Workshop contains a compiler that can convert all HTML output
+# generated by doxygen into a single compiled HTML file (.chm). Compiled HTML
+# files are now used as the Windows 98 help format, and will replace the old
+# Windows help format (.hlp) on all Windows platforms in the future. Compressed
+# HTML files also contain an index, a table of contents, and you can search for
+# words in the documentation. The HTML workshop also contains a viewer for
+# compressed HTML files.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTML is set to YES.
GENERATE_HTMLHELP = NO
-# If the GENERATE_HTMLHELP tag is set to YES, the CHM_FILE tag can
-# be used to specify the file name of the resulting .chm file. You
-# can add a path in front of the file if the result should not be
+# The CHM_FILE tag can be used to specify the file name of the resulting .chm
+# file. You can add a path in front of the file if the result should not be
# written to the html output directory.
+# This tag requires that the tag GENERATE_HTMLHELP is set to YES.
CHM_FILE =
-# If the GENERATE_HTMLHELP tag is set to YES, the HHC_LOCATION tag can
-# be used to specify the location (absolute path including file name) of
-# the HTML help compiler (hhc.exe). If non-empty doxygen will try to run
-# the HTML help compiler on the generated index.hhp.
+# The HHC_LOCATION tag can be used to specify the location (absolute path
+# including file name) of the HTML help compiler ( hhc.exe). If non-empty
+# doxygen will try to run the HTML help compiler on the generated index.hhp.
+# The file has to be specified with full path.
+# This tag requires that the tag GENERATE_HTMLHELP is set to YES.
HHC_LOCATION =
-# If the GENERATE_HTMLHELP tag is set to YES, the GENERATE_CHI flag
-# controls if a separate .chi index file is generated (YES) or that
-# it should be included in the master .chm file (NO).
+# The GENERATE_CHI flag controls if a separate .chi index file is generated (
+# YES) or that it should be included in the master .chm file ( NO).
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTMLHELP is set to YES.
GENERATE_CHI = NO
-# If the GENERATE_HTMLHELP tag is set to YES, the CHM_INDEX_ENCODING
-# is used to encode HtmlHelp index (hhk), content (hhc) and project file
-# content.
+# The CHM_INDEX_ENCODING is used to encode HtmlHelp index ( hhk), content ( hhc)
+# and project file content.
+# This tag requires that the tag GENERATE_HTMLHELP is set to YES.
CHM_INDEX_ENCODING =
-# If the GENERATE_HTMLHELP tag is set to YES, the BINARY_TOC flag
-# controls whether a binary table of contents is generated (YES) or a
-# normal table of contents (NO) in the .chm file.
+# The BINARY_TOC flag controls whether a binary table of contents is generated (
+# YES) or a normal table of contents ( NO) in the .chm file. Furthermore it
+# enables the Previous and Next buttons.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTMLHELP is set to YES.
BINARY_TOC = NO
-# The TOC_EXPAND flag can be set to YES to add extra items for group members
-# to the contents of the HTML help documentation and to the tree view.
+# The TOC_EXPAND flag can be set to YES to add extra items for group members to
+# the table of contents of the HTML help documentation and to the tree view.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTMLHELP is set to YES.
TOC_EXPAND = NO
-# If the GENERATE_QHP tag is set to YES and both QHP_NAMESPACE and QHP_VIRTUAL_FOLDER
-# are set, an additional index file will be generated that can be used as input for
-# Qt's qhelpgenerator to generate a Qt Compressed Help (.qch) of the generated
-# HTML documentation.
+# If the GENERATE_QHP tag is set to YES and both QHP_NAMESPACE and
+# QHP_VIRTUAL_FOLDER are set, an additional index file will be generated that
+# can be used as input for Qt's qhelpgenerator to generate a Qt Compressed Help
+# (.qch) of the generated HTML documentation.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTML is set to YES.
GENERATE_QHP = NO
-# If the QHG_LOCATION tag is specified, the QCH_FILE tag can
-# be used to specify the file name of the resulting .qch file.
-# The path specified is relative to the HTML output folder.
+# If the QHG_LOCATION tag is specified, the QCH_FILE tag can be used to specify
+# the file name of the resulting .qch file. The path specified is relative to
+# the HTML output folder.
+# This tag requires that the tag GENERATE_QHP is set to YES.
QCH_FILE =
-# The QHP_NAMESPACE tag specifies the namespace to use when generating
-# Qt Help Project output. For more information please see
-# http://doc.trolltech.com/qthelpproject.html#namespace
-
-QHP_NAMESPACE =
-
-# The QHP_VIRTUAL_FOLDER tag specifies the namespace to use when generating
-# Qt Help Project output. For more information please see
-# http://doc.trolltech.com/qthelpproject.html#virtual-folders
+# The QHP_NAMESPACE tag specifies the namespace to use when generating Qt Help
+# Project output. For more information please see Qt Help Project / Namespace
+# (see: http://qt-project.org/doc/qt-4.8/qthelpproject.html#namespace).
+# The default value is: org.doxygen.Project.
+# This tag requires that the tag GENERATE_QHP is set to YES.
+
+QHP_NAMESPACE = org.doxygen.Project
+
+# The QHP_VIRTUAL_FOLDER tag specifies the namespace to use when generating Qt
+# Help Project output. For more information please see Qt Help Project / Virtual
+# Folders (see: http://qt-project.org/doc/qt-4.8/qthelpproject.html#virtual-
+# folders).
+# The default value is: doc.
+# This tag requires that the tag GENERATE_QHP is set to YES.
QHP_VIRTUAL_FOLDER = doc
-# If QHP_CUST_FILTER_NAME is set, it specifies the name of a custom filter to add.
-# For more information please see
-# http://doc.trolltech.com/qthelpproject.html#custom-filters
+# If the QHP_CUST_FILTER_NAME tag is set, it specifies the name of a custom
+# filter to add. For more information please see Qt Help Project / Custom
+# Filters (see: http://qt-project.org/doc/qt-4.8/qthelpproject.html#custom-
+# filters).
+# This tag requires that the tag GENERATE_QHP is set to YES.
QHP_CUST_FILTER_NAME =
-# The QHP_CUST_FILT_ATTRS tag specifies the list of the attributes of the custom filter to add.For more information please see
-# Qt Help Project / Custom Filters.
+# The QHP_CUST_FILTER_ATTRS tag specifies the list of the attributes of the
+# custom filter to add. For more information please see Qt Help Project / Custom
+# Filters (see: http://qt-project.org/doc/qt-4.8/qthelpproject.html#custom-
+# filters).
+# This tag requires that the tag GENERATE_QHP is set to YES.
QHP_CUST_FILTER_ATTRS =
-# The QHP_SECT_FILTER_ATTRS tag specifies the list of the attributes this project's
-# filter section matches.
-# Qt Help Project / Filter Attributes.
+# The QHP_SECT_FILTER_ATTRS tag specifies the list of the attributes this
+# project's filter section matches. Qt Help Project / Filter Attributes (see:
+# http://qt-project.org/doc/qt-4.8/qthelpproject.html#filter-attributes).
+# This tag requires that the tag GENERATE_QHP is set to YES.
QHP_SECT_FILTER_ATTRS =
-# If the GENERATE_QHP tag is set to YES, the QHG_LOCATION tag can
-# be used to specify the location of Qt's qhelpgenerator.
-# If non-empty doxygen will try to run qhelpgenerator on the generated
-# .qhp file.
+# The QHG_LOCATION tag can be used to specify the location of Qt's
+# qhelpgenerator. If non-empty doxygen will try to run qhelpgenerator on the
+# generated .qhp file.
+# This tag requires that the tag GENERATE_QHP is set to YES.
QHG_LOCATION =
-# The DISABLE_INDEX tag can be used to turn on/off the condensed index at
-# top of each HTML page. The value NO (the default) enables the index and
-# the value YES disables it.
+# If the GENERATE_ECLIPSEHELP tag is set to YES, additional index files will be
+# generated, together with the HTML files, they form an Eclipse help plugin. To
+# install this plugin and make it available under the help contents menu in
+# Eclipse, the contents of the directory containing the HTML and XML files needs
+# to be copied into the plugins directory of eclipse. The name of the directory
+# within the plugins directory should be the same as the ECLIPSE_DOC_ID value.
+# After copying Eclipse needs to be restarted before the help appears.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+GENERATE_ECLIPSEHELP = NO
+
+# A unique identifier for the Eclipse help plugin. When installing the plugin
+# the directory name containing the HTML and XML files should also have this
+# name. Each documentation set should have its own identifier.
+# The default value is: org.doxygen.Project.
+# This tag requires that the tag GENERATE_ECLIPSEHELP is set to YES.
+
+ECLIPSE_DOC_ID = org.doxygen.Project
+
+# If you want full control over the layout of the generated HTML pages it might
+# be necessary to disable the index and replace it with your own. The
+# DISABLE_INDEX tag can be used to turn on/off the condensed index (tabs) at top
+# of each HTML page. A value of NO enables the index and the value YES disables
+# it. Since the tabs in the index contain the same information as the navigation
+# tree, you can set this option to YES if you also set GENERATE_TREEVIEW to YES.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTML is set to YES.
DISABLE_INDEX = NO
-# This tag can be used to set the number of enum values (range [1..20])
-# that doxygen will group on one line in the generated HTML documentation.
+# The GENERATE_TREEVIEW tag is used to specify whether a tree-like index
+# structure should be generated to display hierarchical information. If the tag
+# value is set to YES, a side panel will be generated containing a tree-like
+# index structure (just like the one that is generated for HTML Help). For this
+# to work a browser that supports JavaScript, DHTML, CSS and frames is required
+# (i.e. any modern browser). Windows users are probably better off using the
+# HTML help feature. Via custom stylesheets (see HTML_EXTRA_STYLESHEET) one can
+# further fine-tune the look of the index. As an example, the default style
+# sheet generated by doxygen has an example that shows how to put an image at
+# the root of the tree instead of the PROJECT_NAME. Since the tree basically has
+# the same information as the tab index, you could consider setting
+# DISABLE_INDEX to YES when enabling this option.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+GENERATE_TREEVIEW = NO
+
+# The ENUM_VALUES_PER_LINE tag can be used to set the number of enum values that
+# doxygen will group on one line in the generated HTML documentation.
+#
+# Note that a value of 0 will completely suppress the enum values from appearing
+# in the overview section.
+# Minimum value: 0, maximum value: 20, default value: 4.
+# This tag requires that the tag GENERATE_HTML is set to YES.
ENUM_VALUES_PER_LINE = 4
-# The GENERATE_TREEVIEW tag is used to specify whether a tree-like index
-# structure should be generated to display hierarchical information.
-# If the tag value is set to YES, a side panel will be generated
-# containing a tree-like index structure (just like the one that
-# is generated for HTML Help). For this to work a browser that supports
-# JavaScript, DHTML, CSS and frames is required (i.e. any modern browser).
-# Windows users are probably better off using the HTML help feature.
-
-GENERATE_TREEVIEW = NO
-
-# By enabling USE_INLINE_TREES, doxygen will generate the Groups, Directories,
-# and Class Hierarchy pages using a tree view instead of an ordered list.
-
-USE_INLINE_TREES = NO
-
-# If the treeview is enabled (see GENERATE_TREEVIEW) then this tag can be
-# used to set the initial width (in pixels) of the frame in which the tree
-# is shown.
+# If the treeview is enabled (see GENERATE_TREEVIEW) then this tag can be used
+# to set the initial width (in pixels) of the frame in which the tree is shown.
+# Minimum value: 0, maximum value: 1500, default value: 250.
+# This tag requires that the tag GENERATE_HTML is set to YES.
TREEVIEW_WIDTH = 250
-# Use this tag to change the font size of Latex formulas included
-# as images in the HTML documentation. The default is 10. Note that
-# when you change the font size after a successful doxygen run you need
-# to manually remove any form_*.png images from the HTML output directory
-# to force them to be regenerated.
+# When the EXT_LINKS_IN_WINDOW option is set to YES doxygen will open links to
+# external symbols imported via tag files in a separate window.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+EXT_LINKS_IN_WINDOW = NO
+
+# Use this tag to change the font size of LaTeX formulas included as images in
+# the HTML documentation. When you change the font size after a successful
+# doxygen run you need to manually remove any form_*.png images from the HTML
+# output directory to force them to be regenerated.
+# Minimum value: 8, maximum value: 50, default value: 10.
+# This tag requires that the tag GENERATE_HTML is set to YES.
FORMULA_FONTSIZE = 10
-# When the SEARCHENGINE tag is enable doxygen will generate a search box for the HTML output. The underlying search engine uses javascript
-# and DHTML and should work on any modern browser. Note that when using HTML help (GENERATE_HTMLHELP) or Qt help (GENERATE_QHP)
-# there is already a search function so this one should typically
-# be disabled.
+# Use the FORMULA_TRANPARENT tag to determine whether or not the images
+# generated for formulas are transparent PNGs. Transparent PNGs are not
+# supported properly for IE 6.0, but are supported on all modern browsers.
+#
+# Note that when changing this option you need to delete any form_*.png files in
+# the HTML output directory before the changes have effect.
+# The default value is: YES.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+FORMULA_TRANSPARENT = YES
+
+# Enable the USE_MATHJAX option to render LaTeX formulas using MathJax (see
+# http://www.mathjax.org) which uses client side Javascript for the rendering
+# instead of using prerendered bitmaps. Use this if you do not have LaTeX
+# installed or if you want to formulas look prettier in the HTML output. When
+# enabled you may also need to install MathJax separately and configure the path
+# to it using the MATHJAX_RELPATH option.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+USE_MATHJAX = NO
+
+# When MathJax is enabled you can set the default output format to be used for
+# the MathJax output. See the MathJax site (see:
+# http://docs.mathjax.org/en/latest/output.html) for more details.
+# Possible values are: HTML-CSS (which is slower, but has the best
+# compatibility), NativeMML (i.e. MathML) and SVG.
+# The default value is: HTML-CSS.
+# This tag requires that the tag USE_MATHJAX is set to YES.
+
+MATHJAX_FORMAT = HTML-CSS
+
+# When MathJax is enabled you need to specify the location relative to the HTML
+# output directory using the MATHJAX_RELPATH option. The destination directory
+# should contain the MathJax.js script. For instance, if the mathjax directory
+# is located at the same level as the HTML output directory, then
+# MATHJAX_RELPATH should be ../mathjax. The default value points to the MathJax
+# Content Delivery Network so you can quickly see the result without installing
+# MathJax. However, it is strongly recommended to install a local copy of
+# MathJax from http://www.mathjax.org before deployment.
+# The default value is: http://cdn.mathjax.org/mathjax/latest.
+# This tag requires that the tag USE_MATHJAX is set to YES.
+
+MATHJAX_RELPATH = http://cdn.mathjax.org/mathjax/latest
+
+# The MATHJAX_EXTENSIONS tag can be used to specify one or more MathJax
+# extension names that should be enabled during MathJax rendering. For example
+# MATHJAX_EXTENSIONS = TeX/AMSmath TeX/AMSsymbols
+# This tag requires that the tag USE_MATHJAX is set to YES.
+
+MATHJAX_EXTENSIONS =
+
+# The MATHJAX_CODEFILE tag can be used to specify a file with javascript pieces
+# of code that will be used on startup of the MathJax code. See the MathJax site
+# (see: http://docs.mathjax.org/en/latest/output.html) for more details. For an
+# example see the documentation.
+# This tag requires that the tag USE_MATHJAX is set to YES.
+
+MATHJAX_CODEFILE =
+
+# When the SEARCHENGINE tag is enabled doxygen will generate a search box for
+# the HTML output. The underlying search engine uses javascript and DHTML and
+# should work on any modern browser. Note that when using HTML help
+# (GENERATE_HTMLHELP), Qt help (GENERATE_QHP), or docsets (GENERATE_DOCSET)
+# there is already a search function so this one should typically be disabled.
+# For large projects the javascript based search engine can be slow, then
+# enabling SERVER_BASED_SEARCH may provide a better solution. It is possible to
+# search using the keyboard; to jump to the search box use + S
+# (what the is depends on the OS and browser, but it is typically
+# , /