Changeset 3116
- Timestamp:
- 2011-11-15T21:55:40+01:00 (13 years ago)
- Location:
- branches/2011/dev_NEMO_MERGE_2011
- Files:
-
- 1 deleted
- 127 edited
- 23 copied
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/dev_NEMO_MERGE_2011/DOC/TexFiles/Biblio/Biblio.bib
r3104 r3116 1317 1317 } 1318 1318 1319 @ARTICLE{HollowayOM86, 1320 author = {Greg Holloway}, 1321 title = {A Shelf Wave/Topographic Pump Drives Mean Coastal Circulation (part I)}, 1322 journal = OM, 1323 year = {1986}, 1324 volume = {68}, 1325 } 1326 1327 @ARTICLE{HollowayJPO92, 1328 author = {Greg Holloway}, 1329 title = {Representing Topographic Stress for Large-Scale Ocean Models}, 1330 journal = JPO, 1331 year = {1992}, 1332 volume = {22}, 1333 pages = {1033--1046}, 1334 } 1335 1336 @ARTICLE{HollowayJPO94, 1337 author = {Michael Eby and Greg Holloway}, 1338 title = {Sensitivity of a Large-Scale Ocean Model to a Parameterization of Topographic Stress}, 1339 journal = JPO, 1340 year = {1994}, 1341 volume = {24}, 1342 pages = {2577--2587}, 1343 } 1344 1345 @ARTICLE{HollowayJGR09, 1346 author = {Greg Holloway and Zeliang Wang}, 1347 title = {Representing eddy stress in an Arctic Ocean model}, 1348 journal = JGR, 1349 year = {2009}, 1350 doi = {10.1029/2008JC005169}, 1351 } 1352 1353 @ARTICLE{HollowayOM08, 1354 author = {Mathew Maltrud and Greg Holloway}, 1355 title = {Implementing biharmonic neptune in a global eddying ocean model}, 1356 journal = OM, 1357 year = {2008}, 1358 volume = {21}, 1359 pages = {22--34}, 1360 } 1361 1319 1362 @ARTICLE{Hordoir_al_CD08, 1320 1363 author = {R. Hordoir and J. Polcher and J.-C. Brun-Cottan and G. Madec}, … … 1346 1389 volume = {23}, 1347 1390 pages = {2428--2446} 1391 } 1392 1393 @ARTICLE{Hunke2008, 1394 author = {E.C. Hunke and W.H. Lipscomb}, 1395 title = {CICE: the Los Alamos sea ice model documentation and software user's manual, 1396 Version 4.0}, 1397 publisher = {LA-CC-06-012, Los Alamos National Laboratory, N.M.}, 1398 year = {2008} 1348 1399 } 1349 1400 -
branches/2011/dev_NEMO_MERGE_2011/DOC/TexFiles/Chapters/Chap_ASM.tex
r3092 r3116 15 15 The ASM code adds the functionality to apply increments to the model variables: 16 16 temperature, salinity, sea surface height, velocity and sea ice concentration. 17 These are read into the model from a NetCDF file which may be produced by data18 assimilation . The code can also output model background fields which are used17 These are read into the model from a NetCDF file which may be produced by separate data 18 assimilation code. The code can also output model background fields which are used 19 19 as an input to data assimilation code. This is all controlled by the namelist 20 20 \textit{nam\_asminc}. There is a brief description of all the namelist options -
branches/2011/dev_NEMO_MERGE_2011/DOC/TexFiles/Chapters/Chap_DYN.tex
r3084 r3116 610 610 documented or tested. 611 611 612 $\bullet$ Traditional coding (see for example \citet{Madec_al_JPO96}: (\np{ln\_dynhpg\_sco}=true, 613 \np{ln\_dynhpg\_hel}=true) 612 $\bullet$ Traditional coding (see for example \citet{Madec_al_JPO96}: (\np{ln\_dynhpg\_sco}=true) 614 613 \begin{equation} \label{Eq_dynhpg_sco} 615 614 \left\{ \begin{aligned} … … 624 623 \eqref{Eq_dynhpg_zco_surf} - \eqref{Eq_dynhpg_zco}, and $z_T$ is the depth of 625 624 the $T$-point evaluated from the sum of the vertical scale factors at the $w$-point 626 ($e_{3w}$). The version \np{ln\_dynhpg\_hel}=true has been added by Aike 627 Beckmann and involves a redefinition of the relative position of $T$-points relative 628 to $w$-points. 629 630 $\bullet$ Weighted density Jacobian (WDJ) \citep{Song1998} (\np{ln\_dynhpg\_wdj}=true) 625 ($e_{3w}$). 631 626 632 627 $\bullet$ Density Jacobian with cubic polynomial scheme (DJC) \citep{Shchepetkin_McWilliams_OM05} 633 628 (\np{ln\_dynhpg\_djc}=true) 634 629 635 $\bullet$ Rotated axes scheme (rot) \citep{Thiem_Berntsen_OM06} (\np{ln\_dynhpg\_rot}=true)636 637 Note that expression \eqref{Eq_dynhpg_sco} is used when the variable volume630 $\bullet$ Pressure Jacobian scheme (prj) \citep{Thiem_Berntsen_OM06} (\np{ln\_dynhpg\_prj}=true) 631 632 Note that expression \eqref{Eq_dynhpg_sco} is commonly used when the variable volume 638 633 formulation is activated (\key{vvl}) because in that case, even with a flat bottom, 639 634 the coordinate surfaces are not horizontal but follow the free surface 640 \citep{Levier2007}. The other pressure gradient options are not yet available. 635 \citep{Levier2007}. Only the pressure jacobian scheme (\np{ln\_dynhpg\_prj}=true) is available as an 636 alternative to the default \np{ln\_dynhpg\_sco}=true when \key{vvl} is active. The pressure Jacobian scheme uses 637 a constrained cubic spline to reconstruct the density profile across the water column. This method 638 maintains the monotonicity between the density nodes and is of a higher order than the linear 639 interpolation method. The pressure can be calculated by analytical integration of the density profile and 640 a pressure Jacobian method is used to solve the horizontal pressure gradient. This method should 641 provide a more accurate calculation of the horizontal pressure gradient than the standard scheme. 641 642 642 643 %-------------------------------------------------------------------------------------------------------------- … … 1164 1165 1165 1166 % ================================================================ 1167 % Neptune effect 1168 % ================================================================ 1169 \section [Neptune effect (\textit{dynnept})] 1170 {Neptune effect (\mdl{dynnept})} 1171 \label{DYN_nept} 1172 1173 The "Neptune effect" (thus named in \citep{HollowayOM86}) is a 1174 parameterisation of the potentially large effect of topographic form stress 1175 (caused by eddies) in driving the ocean circulation. Originally developed for 1176 low-resolution models, in which it was applied via a Laplacian (second-order) 1177 diffusion-like term in the momentum equation, it can also be applied in eddy 1178 permitting or resolving models, in which a more scale-selective bilaplacian 1179 (fourth-order) implementation is preferred. This mechanism has a 1180 significant effect on boundary currents (including undercurrents), and the 1181 upwelling of deep water near continental shelves. 1182 1183 The theoretical basis for the method can be found in 1184 \citep{HollowayJPO92}, including the explanation of why form stress is not 1185 necessarily a drag force, but may actually drive the flow. 1186 \citep{HollowayJPO94} demonstrate the effects of the parameterisation in 1187 the GFDL-MOM model, at a horizontal resolution of about 1.8 degrees. 1188 \citep{HollowayOM08} demonstrate the biharmonic version of the 1189 parameterisation in a global run of the POP model, with an average horizontal 1190 grid spacing of about 32km. 1191 1192 The NEMO implementation is a simplified form of that supplied by 1193 Greg Holloway, the testing of which was described in \citep{HollowayJGR09}. 1194 The major simplification is that a time invariant Neptune velocity 1195 field is assumed. This is computed only once, during start-up, and 1196 made available to the rest of the code via a module. Vertical 1197 diffusive terms are also ignored, and the model topography itself 1198 is used, rather than a separate topographic dataset as in 1199 \citep{HollowayOM08}. This implementation is only in the iso-level 1200 formulation, as is the case anyway for the bilaplacian operator. 1201 1202 The velocity field is derived from a transport stream function given by: 1203 1204 \begin{equation} \label{Eq_dynnept_sf} 1205 \psi = -fL^2H 1206 \end{equation} 1207 1208 where $L$ is a latitude-dependant length scale given by: 1209 1210 \begin{equation} \label{Eq_dynnept_ls} 1211 L = l_1 + (l_2 -l_1)\left ( {1 + \cos 2\phi \over 2 } \right ) 1212 \end{equation} 1213 1214 where $\phi$ is latitude and $l_1$ and $l_2$ are polar and equatorial length scales respectively. 1215 Neptune velocity components, $u^*$, $v^*$ are derived from the stremfunction as: 1216 1217 \begin{equation} \label{Eq_dynnept_vel} 1218 u^* = -{1\over H} {\partial \psi \over \partial y}\ \ \ ,\ \ \ v^* = {1\over H} {\partial \psi \over \partial x} 1219 \end{equation} 1220 1221 \smallskip 1222 %----------------------------------------------namdom---------------------------------------------------- 1223 \namdisplay{namdyn_nept} 1224 %-------------------------------------------------------------------------------------------------------- 1225 \smallskip 1226 1227 The Neptune effect is enabled when \np{ln\_neptsimp}=true (default=false). 1228 \np{ln\_smooth\_neptvel} controls whether a scale-selective smoothing is applied 1229 to the Neptune effect flow field (default=false) (this smoothing method is as 1230 used by Holloway). \np{rn\_tslse} and \np{rn\_tslsp} are the equatorial and 1231 polar values respectively of the length-scale parameter $L$ used in determining 1232 the Neptune stream function \eqref{Eq_dynnept_sf} and \eqref{Eq_dynnept_ls}. 1233 Values at intermediate latitudes are given by a cosine fit, mimicking the 1234 variation of the deformation radius with latitude. The default values of 12km 1235 and 3km are those given in \citep{HollowayJPO94}, appropriate for a coarse 1236 resolution model. The finer resolution study of \citep{HollowayOM08} increased 1237 the values of L by a factor of $\sqrt 2$ to 17km and 4.2km, thus doubling the 1238 stream function for a given topography. 1239 1240 The simple formulation for ($u^*$, $v^*$) can give unacceptably large velocities 1241 in shallow water, and \citep{HollowayOM08} add an offset to the depth in the 1242 denominator to control this problem. In this implementation we offer instead (at 1243 the suggestion of G. Madec) the option of ramping down the Neptune flow field to 1244 zero over a finite depth range. The switch \np{ln\_neptramp} activates this 1245 option (default=false), in which case velocities at depths greater than 1246 \np{rn\_htrmax} are unaltered, but ramp down linearly with depth to zero at a 1247 depth of \np{rn\_htrmin} (and shallower). 1248 1249 % ================================================================ -
branches/2011/dev_NEMO_MERGE_2011/DOC/TexFiles/Chapters/Chap_MISC.tex
r2541 r3116 253 253 Note this implementation may be sensitive to the optimization level. 254 254 255 \subsection{MPP scalability} 256 \label{MISC_mppsca} 257 258 The default method of communicating values across the north-fold in distributed memory applications 259 (\key{mpp\_mpi}) uses a \textsc{MPI\_ALLGATHER} function to exchange values from each processing 260 region in the northern row with every other processing region in the northern row. This enables a 261 global width array containing the top 4 rows to be collated on every northern row processor and then 262 folded with a simple algorithm. Although conceptually simple, this "All to All" communication will 263 hamper performance scalability for large numbers of northern row processors. From version 3.4 264 onwards an alternative method is available which only performs direct "Peer to Peer" communications 265 between each processor and its immediate "neighbours" across the fold line. This is achieved by 266 using the default \textsc{MPI\_ALLGATHER} method during initialisation to help identify the "active" 267 neighbours. Stored lists of these neighbours are then used in all subsequent north-fold exchanges to 268 restrict exchanges to those between associated regions. The collated global width array for each 269 region is thus only partially filled but is guaranteed to be set at all the locations actually 270 required by each individual for the fold operation. This alternative method should give identical 271 results to the default \textsc{ALLGATHER} method and is recommended for large values of \np{jpni}. 272 The new method is activated by setting \np{ln\_nnogather} to be true ({\bf nammpp}). The 273 reproducibility of results using the two methods should be confirmed for each new, non-reference 274 configuration. 255 275 256 276 % ================================================================ -
branches/2011/dev_NEMO_MERGE_2011/DOC/TexFiles/Chapters/Chap_OBS.tex
r2483 r3116 13 13 $\ $\newline % force a new line 14 14 15 The observation and model comparison code (OBS) reads in observation files 16 (profile temperature and salinity, sea surface temperature, sea level anomaly,17 sea ice concentration, and velocity) and calculates an interpolated model equivalent 18 value at the observation location and nearest model timestep. The OBS code is 19 called from \np{opa.F90} in order to initialise the model and to calculate the 20 model equivalent values for observations on the 0th timestep. The code is then 21 called again after each timestep from \np{step.F90}. The code was originally 22 developed for use with NEMOVAR. 23 24 For all data types a 2D horizontal interpolator is needed 25 to interpolate the model fields to the observation location.26 For {\em in situ} profiles, a 1D vertical interpolator is needed in addition to 27 provide model fields at the observation depths. Currently this only works in 28 z-level model configurations, but is being developed to work with a 29 generalised vertical coordinate system. 30 Temperature data from moored buoys (TAO, TRITON, PIRATA) in the 31 ENACT/ENSEMBLES data-base are available as daily averaged quantities. For this 32 type of observation the 33 observation operator will compare such observations to the model temperature15 The observation and model comparison code (OBS) reads in observation files (profile 16 temperature and salinity, sea surface temperature, sea level anomaly, sea ice concentration, 17 and velocity) and calculates an interpolated model equivalent value at the observation 18 location and nearest model timestep. The resulting data are saved in a ``feedback'' file (or 19 files). The code was originally developed for use with the NEMOVAR data assimilation code, but 20 can be used for validation or verification of model or any other data assimilation system. 21 22 The OBS code is called from \np{opa.F90} for model initialisation and to calculate the model 23 equivalent values for observations on the 0th timestep. The code is then called again after 24 each timestep from \np{step.F90}. To build with the OBS code active \key{diaobs} must be 25 set. 26 27 For all data types a 2D horizontal interpolator is needed to interpolate the model fields to 28 the observation location. For {\em in situ} profiles, a 1D vertical interpolator is needed in 29 addition to provide model fields at the observation depths. Currently this only works in 30 z-level model configurations, but is being developed to work with a generalised vertical 31 coordinate system. Temperature data from moored buoys (TAO, TRITON, PIRATA) in the 32 ENACT/ENSEMBLES data-base are available as daily averaged quantities. For this type of 33 observation the observation operator will compare such observations to the model temperature 34 34 fields averaged over one day. The relevant observation type may be specified in the namelist 35 using \np{endailyavtypes}. Otherwise the model value from the nearest 36 timestep to the observation time is used. 37 38 The resulting data are saved in a ``feedback'' file (or files) which can be used 39 for model validation and verification and also to provide information for data 40 assimilation. This code is controlled by the namelist \textit{nam\_obs}. To 41 build with the OBS code active \key{diaobs} must be set. 42 43 Section~\ref{OBS_example} introduces a test example of the observation operator 44 code including where to obtain data and how to setup the namelist. 45 Section~\ref{OBS_details} introduces some more technical details of the 46 different observation types used and also shows a more complete namelist. 47 Finally section~\ref{OBS_theory} introduces some of the theoretical aspects of 48 the observation operator including interpolation methods and running on multiple 49 processors. 35 using \np{endailyavtypes}. Otherwise the model value from the nearest timestep to the 36 observation time is used. 37 38 The code is controlled by the namelist \textit{nam\_obs}. See the following sections for more 39 details on setting up the namelist. 40 41 Section~\ref{OBS_example} introduces a test example of the observation operator code including 42 where to obtain data and how to setup the namelist. Section~\ref{OBS_details} introduces some 43 more technical details of the different observation types used and also shows a more complete 44 namelist. Section~\ref{OBS_theory} introduces some of the theoretical aspects of the 45 observation operator including interpolation methods and running on multiple processors. 46 Section~\ref{OBS_obsutils} introduces some utilities to help working with the files produced 47 by the OBS code. 50 48 51 49 % ================================================================ … … 69 67 \item Add the following to the NEMO namelist to run the observation 70 68 operator on this data. Set the \np{enactfiles} namelist parameter to the 71 observation file name (or link in to \np{profiles\_01\.nc}):69 observation file name: 72 70 \end{enumerate} 73 71 … … 76 74 %------------------------------------------------------------------------------------------------------------- 77 75 78 The option \np{ln\_t3d} and \np{ln\_s3d} switch on the temperature and salinity76 The options \np{ln\_t3d} and \np{ln\_s3d} switch on the temperature and salinity 79 77 profile observation operator code. The \np{ln\_ena} switch turns on the reading 80 78 of ENACT/ENSEMBLES type profile data. The filename or array of filenames are … … 88 86 Setting \np{ln\_grid\_global} means that the code distributes the observations 89 87 evenly between processors. Alternatively each processor will work with 90 observations located within the model subdomain .91 92 The NEMOVAR system contains utilitiesto plot the feedback files, convert and93 recombine the files. These are available on request from the NEMOVAR team.88 observations located within the model subdomain (see section~\ref{OBS_parallel}). 89 90 A number of utilities are now provided to plot the feedback files, convert and 91 recombine the files. These are explained in more detail in section~\ref{OBS_obsutils}. 94 92 95 93 \section{Technical details} … … 713 711 714 712 \subsection{Parallel aspects of horizontal interpolation} 713 \label{OBS_parallel} 715 714 716 715 For horizontal interpolation, there is the basic problem that the … … 779 778 \subsection{Vertical interpolation operator} 780 779 781 The vertical interpolation is achieved using either a cubic spline or780 Vertical interpolation is achieved using either a cubic spline or 782 781 linear interpolation. For the cubic spline, the top and 783 782 bottom boundary conditions for the second derivative of the 784 783 interpolating polynomial in the spline are set to zero. 785 784 At the bottom boundary, this is done using the land-ocean mask. 785 786 \newpage 787 788 \section{Observation Utilities} 789 \label{OBS_obsutils} 790 791 Some tools for viewing and processing of observation and feedback files are provided in the 792 NEMO repository for convenience. These include OBSTOOLS which are a collection of Fortran 793 programs which are helpful to deal with feedback files. They do such tasks as observation file 794 conversion, printing of file contents, some basic statistical analysis of feedback files. The 795 other tool is an IDL program called dataplot which uses a graphical interface to visualise 796 observations and feedback files. OBSTOOLS and dataplot are described in more detail below. 797 798 \subsection{Obstools} 799 800 A series of Fortran utilities is provided with NEMO called OBSTOOLS. This are helpful in 801 handling observation files and the feedback file output from the NEMO observation operator. 802 The utilities are as follows 803 804 \subsubsection{corio2fb} 805 806 The program corio2fb converts profile observation files from the Coriolis format to the 807 standard feedback format. The program is called in the following way: 808 809 \begin{alltt} 810 \footnotesize 811 \begin{verbatim} 812 corio2fb.exe outputfile inputfile1 inputfile2 ... 813 \end{verbatim} 814 \end{alltt} 815 816 \subsubsection{enact2fb} 817 818 The program enact2fb converts profile observation files from the ENACT format to the standard 819 feedback format. The program is called in the following way: 820 821 \begin{alltt} 822 \footnotesize 823 \begin{verbatim} 824 enact2fb.exe outputfile inputfile1 inputfile2 ... 825 \end{verbatim} 826 \end{alltt} 827 828 \subsubsection{fbcomb} 829 830 The program fbcomb combines multiple feedback files produced by individual processors in an 831 MPI run of NEMO into a single feedback file. The program is called in the following way: 832 833 \begin{alltt} 834 \footnotesize 835 \begin{verbatim} 836 fbcomb.exe outputfile inputfile1 inputfile2 ... 837 \end{verbatim} 838 \end{alltt} 839 840 \subsubsection{fbmatchup} 841 842 The program fbmatchup will match observations from two feedback files. The program is called 843 in the following way: 844 845 \begin{alltt} 846 \footnotesize 847 \begin{verbatim} 848 fbmatchup.exe outputfile inputfile1 varname1 inputfile2 varname2 ... 849 \end{verbatim} 850 \end{alltt} 851 852 853 \subsubsection{fbprint} 854 855 The program fbprint will print the contents of a feedback file or files to standard output. 856 Selected information can be output using optional arguments. The program is called in the 857 following way: 858 859 \begin{alltt} 860 \footnotesize 861 \begin{verbatim} 862 fbprint.exe [options] inputfile 863 864 options: 865 -b shorter output 866 -q Select observations based on QC flags 867 -Q Select observations based on QC flags 868 -B Select observations based on QC flags 869 -u unsorted 870 -s ID select station ID 871 -t TYPE select observation type 872 -v NUM1-NUM2 select variable range to print by number 873 (default all) 874 -a NUM1-NUM2 select additional variable range to print by number 875 (default all) 876 -e NUM1-NUM2 select extra variable range to print by number 877 (default all) 878 -d output date range 879 -D print depths 880 -z use zipped files 881 \end{verbatim} 882 \end{alltt} 883 884 \subsubsection{fbsel} 885 886 The program fbsel will select or subsample observations. The program is called in the 887 following way: 888 889 \begin{alltt} 890 \footnotesize 891 \begin{verbatim} 892 fbsel.exe <input filename> <output filename> 893 \end{verbatim} 894 \end{alltt} 895 896 \subsubsection{fbstat} 897 898 The program fbstat will output summary statistics in different global areas into a number of 899 files. The program is called in the following way: 900 901 \begin{alltt} 902 \footnotesize 903 \begin{verbatim} 904 fbstat.exe [-nmlev] <filenames> 905 \end{verbatim} 906 \end{alltt} 907 908 \subsubsection{fbthin} 909 910 The program fbthin will thin the data to 1 degree resolution. The code could easily be 911 modified to thin to a different resolution. The program is called in the following way: 912 913 \begin{alltt} 914 \footnotesize 915 \begin{verbatim} 916 fbthin.exe inputfile outputfile 917 \end{verbatim} 918 \end{alltt} 919 920 \subsubsection{sla2fb} 921 922 The program sla2fb will convert an AVISO SLA format file to feedback format. The program is 923 called in the following way: 924 925 \begin{alltt} 926 \footnotesize 927 \begin{verbatim} 928 sla2fb.exe [-s type] outputfile inputfile1 inputfile2 ... 929 930 Option: 931 -s Select altimeter data_source 932 \end{verbatim} 933 \end{alltt} 934 935 \subsubsection{vel2fb} 936 937 The program vel2fb will convert TAO/PIRATA/RAMA currents files to feedback format. The program 938 is called in the following way: 939 940 \begin{alltt} 941 \footnotesize 942 \begin{verbatim} 943 vel2fb.exe outputfile inputfile1 inputfile2 ... 944 \end{verbatim} 945 \end{alltt} 946 947 \subsection{building the obstools} 948 949 To build the obstools use in the tools directory use ./maketools -n OBSTOOLS -m [ARCH]. 950 951 \subsection{Dataplot} 952 953 An IDL program called dataplot is included which uses a graphical interface to visualise 954 observations and feedback files. It is possible to zoom in, plot individual profiles and 955 calculate some basic statistics. To plot some data run IDL and then: 956 \begin{alltt} 957 \footnotesize 958 \begin{verbatim} 959 IDL> dataplot, "filename" 960 \end{verbatim} 961 \end{alltt} 962 963 To read multiple files into dataplot, for example multiple feedback files from different 964 processors or from different days, the easiest method is to use the spawn command to generate 965 a list of files which can then be passed to dataplot. 966 \begin{alltt} 967 \footnotesize 968 \begin{verbatim} 969 IDL> spawn, 'ls profb*.nc', files 970 IDL> dataplot, files 971 \end{verbatim} 972 \end{alltt} 973 974 Fig~\ref{fig:obsdataplotmain} shows the main window which is launched when dataplot starts. 975 This is split into three parts. At the top there is a menu bar which contains a variety of 976 drop down menus. Areas - zooms into prespecified regions; plot - plots the data as a 977 timeseries or a T-S diagram if appropriate; Find - allows data to be searched; Config - sets 978 various configuration options. 979 980 The middle part is a plot of the geographical location of the observations. This will plot the 981 observation value, the model background value or observation minus background value depending 982 on the option selected in the radio button at the bottom of the window. The plotting colour 983 range can be changed by clicking on the colour bar. The title of the plot gives some basic 984 information about the date range and depth range shown, the extreme values, and the mean and 985 rms values. It is possible to zoom in using a drag-box. You may also zoom in or out using the 986 mouse wheel. 987 988 The bottom part of the window controls what is visible in the plot above. There are two bars 989 which select the level range plotted (for profile data). The other bars below select the date 990 range shown. The bottom of the figure allows the option to plot the mean, root mean square, 991 standard deviation or mean square values. As mentioned above you can choose to plot the 992 observation value, the model background value or observation minus background value. The next 993 group of radio buttons selects the map projection. This can either be regular latitude 994 longitude grid, or north or south polar stereographic. The next group of radio buttons will 995 plot bad observations, switch to salinity and plot density for profile observations. The 996 rightmost group of buttons will print the plot window as a postscript, save it as png, or exit 997 from dataplot. 998 999 %>>>>>>>>>>>>>>>>>>>>>>>>>>>> 1000 \begin{figure} \begin{center} 1001 %\includegraphics[width=10cm,height=12cm,angle=-90.]{./TexFiles/Figures/Fig_OBS_dataplot_main} 1002 \includegraphics[width=9cm,angle=-90.]{./TexFiles/Figures/Fig_OBS_dataplot_main} 1003 \caption{ \label{fig:obsdataplotmain} 1004 Main window of dataplot.} 1005 \end{center} \end{figure} 1006 %>>>>>>>>>>>>>>>>>>>>>>>>>>>> 1007 1008 If a profile point is clicked with the mouse button a plot of the observation and background 1009 values as a function of depth (Fig~\ref{fig:obsdataplotprofile}). 1010 1011 %>>>>>>>>>>>>>>>>>>>>>>>>>>>> 1012 \begin{figure} \begin{center} 1013 %\includegraphics[width=10cm,height=12cm,angle=-90.]{./TexFiles/Figures/Fig_OBS_dataplot_prof} 1014 \includegraphics[width=7cm,angle=-90.]{./TexFiles/Figures/Fig_OBS_dataplot_prof} 1015 \caption{ \label{fig:obsdataplotprofile} 1016 Profile plot from dataplot produced by right clicking on a point in the main window.} 1017 \end{center} \end{figure} 1018 %>>>>>>>>>>>>>>>>>>>>>>>>>>>> 1019 1020 1021 1022 -
branches/2011/dev_NEMO_MERGE_2011/DOC/TexFiles/Chapters/Chap_SBC.tex
r3105 r3116 641 641 \footnote{The \key{oasis4} exist. It activates portion of the code that are still under development.}. 642 642 It has been successfully used to interface \NEMO to most of the European atmospheric 643 GCM (ARPEGE, ECHAM, ECMWF, HadAM, LMDz),643 GCM (ARPEGE, ECHAM, ECMWF, HadAM, HadGAM, LMDz), 644 644 as well as to \href{http://wrf-model.org/}{WRF} (Weather Research and Forecasting Model). 645 645 … … 649 649 When PISCES biogeochemical model (\key{top} and \key{pisces}) is also used in the coupled system, 650 650 the whole carbon cycle is computed by defining \key{cpl\_carbon\_cycle}. In this case, 651 CO$_2$ fluxes are exchanged between the atmosphere and the ice-ocean system. 651 CO$_2$ fluxes will be exchanged between the atmosphere and the ice-ocean system (and need to be activated 652 in namsbc{\_}cpl). 653 654 The new namelist above allows control of various aspects of the coupling fields (particularly for 655 vectors) and now allows for any coupling fields to have multiple sea ice categories (as required by LIM3 656 and CICE). When indicating a multi-category coupling field in namsbc{\_}cpl the number of categories will be 657 determined by the number used in the sea ice model. In some limited cases it may be possible to specify 658 single category coupling fields even when the sea ice model is running with multiple categories - in this 659 case the user should examine the code to be sure the assumptions made are satisfactory. In cases where 660 this is definitely not possible the model should abort with an error message. The new code has been tested using 661 ECHAM with LIM2, and HadGAM3 with CICE but although it will compile with \key{lim3} additional minor code changes 662 may be required to run using LIM3. 652 663 653 664 … … 1001 1012 ice-ocean fluxes, that are combined with the air-sea fluxes using the ice fraction of 1002 1013 each model cell to provide the surface ocean fluxes. Note that the activation of a 1003 sea-ice model is is done by defining a CPP key (\key{lim2} or \key{lim3}).1004 The activation automatically ove writethe read value of nn{\_}ice to its appropriate1005 value ($i.e.$ $2$ for LIM-2 and $3$ for LIM-3).1014 sea-ice model is is done by defining a CPP key (\key{lim2}, \key{lim3} or \key{cice}). 1015 The activation automatically overwrites the read value of nn{\_}ice to its appropriate 1016 value ($i.e.$ $2$ for LIM-2, $3$ for LIM-3 or $4$ for CICE). 1006 1017 \end{description} 1007 1018 1008 1019 % {Description of Ice-ocean interface to be added here or in LIM 2 and 3 doc ?} 1020 1021 \subsection [Interface to CICE (\textit{sbcice\_cice})] 1022 {Interface to CICE (\mdl{sbcice\_cice})} 1023 \label{SBC_cice} 1024 1025 It is now possible to couple a global NEMO configuration (without AGRIF) to the CICE sea-ice 1026 model by using \key{cice}. The CICE code can be obtained from 1027 \href{http://oceans11.lanl.gov/trac/CICE/}{LANL} and the additional 'hadgem3' drivers will be required, 1028 even with the latest code release. Input grid files consistent with those used in NEMO will also be needed, 1029 and CICE CPP keys \textbf{ORCA\_GRID}, \textbf{CICE\_IN\_NEMO} and \textbf{coupled} should be used (seek advice from UKMO 1030 if necessary). Currently the code is only designed to work when using the CORE forcing option for NEMO (with 1031 \textit{calc\_strair~=~true} and \textit{calc\_Tsfc~=~true} in the CICE name-list), or alternatively when NEMO 1032 is coupled to the HadGAM3 atmosphere model (with \textit{calc\_strair~=~false} and \textit{calc\_Tsfc~=~false}). 1033 The code is intended to be used with \np{nn\_fsbc} set to 1 (although coupling ocean and ice less frequently 1034 should work, it is possible the calculation of some of the ocean-ice fluxes needs to be modified slightly - the 1035 user should check that results are not significantly different to the standard case). 1036 1037 There are two options for the technical coupling between NEMO and CICE. The standard version allows 1038 complete flexibility for the domain decompositions in the individual models, but this is at the expense of global 1039 gather and scatter operations in the coupling which become very expensive on larger numbers of processors. The 1040 alternative option (using \key{nemocice\_decomp} for both NEMO and CICE) ensures that the domain decomposition is 1041 identical in both models (provided domain parameters are set appropriately, and 1042 \textit{processor\_shape~=~square-ice} and \textit{distribution\_wght~=~block} in the CICE name-list) and allows 1043 much more efficient direct coupling on individual processors. This solution scales much better although it is at 1044 the expense of having more idle CICE processors in areas where there is no sea ice. 1045 1009 1046 1010 1047 % ------------------------------------------------------------------------------------------------------------- -
branches/2011/dev_NEMO_MERGE_2011/DOC/TexFiles/Chapters/Chap_ZDF.tex
r3104 r3116 1 1 % ================================================================ 2 % Chapter ÑVertical Ocean Physics (ZDF)2 % Chapter Vertical Ocean Physics (ZDF) 3 3 % ================================================================ 4 4 \chapter{Vertical Ocean Physics (ZDF)} … … 563 563 the clipping factor is of crucial importance for the entrainment depth predicted in 564 564 stably stratified situations, and that its value has to be chosen in accordance 565 with the algebraic model for the turbulent ßuxes. The clipping is only activated565 with the algebraic model for the turbulent fluxes. The clipping is only activated 566 566 if \np{ln\_length\_lim}=true, and the $c_{lim}$ is set to the \np{rn\_clim\_galp} value. 567 567 … … 1005 1005 reduced as necessary to ensure stability; these changes are not reported. 1006 1006 1007 Limits on the bottom friction coefficient are not imposed if the user has elected to 1008 handle the bottom friction implicitly (see \S\ref{ZDF_bfr_imp}). The number of potential 1009 breaches of the explicit stability criterion are still reported for information purposes. 1010 1011 % ------------------------------------------------------------------------------------------------------------- 1012 % Implicit Bottom Friction 1013 % ------------------------------------------------------------------------------------------------------------- 1014 \subsection{Implicit Bottom Friction (\np{ln\_bfrimp}$=$\textit{T})} 1015 \label{ZDF_bfr_imp} 1016 1017 An optional implicit form of bottom friction has been implemented to improve 1018 model stability. We recommend this option for shelf sea and coastal ocean applications, especially 1019 for split-explicit time splitting. This option can be invoked by setting \np{ln\_bfrimp} 1020 to \textit{true} in the \textit{nambfr} namelist. This option requires \np{ln\_zdfexp} to be \textit{false} 1021 in the \textit{namzdf} namelist. 1022 1023 This implementation is realised in \mdl{dynzdf\_imp} and \mdl{dynspg\_ts}. In \mdl{dynzdf\_imp}, the 1024 bottom boundary condition is implemented implicitly. 1025 1026 \begin{equation} \label{Eq_dynzdf_bfr} 1027 \left.{\left( {\frac{A^{vm} }{e_3 }\ \frac{\partial \textbf{U}_h}{\partial k}} \right)} \right|_{mbk} 1028 = \binom{c_{b}^{u}u^{n+1}_{mbk}}{c_{b}^{v}v^{n+1}_{mbk}} 1029 \end{equation} 1030 1031 where $mbk$ is the layer number of the bottom wet layer. superscript $n+1$ means the velocity used in the 1032 friction formula is to be calculated, so, it is implicit. 1033 1034 If split-explicit time splitting is used, care must be taken to avoid the double counting of 1035 the bottom friction in the 2-D barotropic momentum equations. As NEMO only updates the barotropic 1036 pressure gradient and Coriolis' forcing terms in the 2-D barotropic calculation, we need to remove 1037 the bottom friction induced by these two terms which has been included in the 3-D momentum trend 1038 and update it with the latest value. On the other hand, the bottom friction contributed by the 1039 other terms (e.g. the advection term, viscosity term) has been included in the 3-D momentum equations 1040 and should not be added in the 2-D barotropic mode. 1041 1042 The implementation of the implicit bottom friction in \mdl{dynspg\_ts} is done in two steps as the 1043 following: 1044 1045 \begin{equation} \label{Eq_dynspg_ts_bfr1} 1046 \frac{\textbf{U}_{med}-\textbf{U}^{m-1}}{2\Delta t}=-g\nabla\eta-f\textbf{k}\times\textbf{U}^{m}+c_{b} 1047 \left(\textbf{U}_{med}-\textbf{U}^{m-1}\right) 1048 \end{equation} 1049 \begin{equation} \label{Eq_dynspg_ts_bfr2} 1050 \frac{\textbf{U}^{m+1}-\textbf{U}_{med}}{2\Delta t}=\textbf{T}+ 1051 \left(g\nabla\eta^{'}+f\textbf{k}\times\textbf{U}^{'}\right)- 1052 2\Delta t_{bc}c_{b}\left(g\nabla\eta^{'}+f\textbf{k}\times\textbf{u}_{b}\right) 1053 \end{equation} 1054 1055 where $\textbf{T}$ is the vertical integrated 3-D momentum trend. We assume the leap-frog time-stepping 1056 is used here. $\Delta t$ is the barotropic mode time step and $\Delta t_{bc}$ is the baroclinic mode time step. 1057 $c_{b}$ is the friction coefficient. $\eta$ is the sea surface level calculated in the barotropic loops 1058 while $\eta^{'}$ is the sea surface level used in the 3-D baroclinic mode. $\textbf{u}_{b}$ is the bottom 1059 layer horizontal velocity. 1060 1061 1062 1063 1007 1064 % ------------------------------------------------------------------------------------------------------------- 1008 1065 % Bottom Friction with split-explicit time splitting 1009 1066 % ------------------------------------------------------------------------------------------------------------- 1010 \subsection{Bottom Friction with split-explicit time splitting }1067 \subsection{Bottom Friction with split-explicit time splitting (\np{ln\_bfrimp}$=$\textit{F})} 1011 1068 \label{ZDF_bfr_ts} 1012 1069 … … 1017 1074 {\key{dynspg\_flt}). Extra attention is required, however, when using 1018 1075 split-explicit time stepping (\key{dynspg\_ts}). In this case the free surface 1019 equation is solved with a small time step \np{ nn\_baro}*\np{rn\_rdt}, while the three1020 dimensional prognostic variables are solved with a longer time step that is a1021 multiple of \np{rn\_rdt}. The trend in the barotropic momentum due to bottom1076 equation is solved with a small time step \np{rn\_rdt}/\np{nn\_baro}, while the three 1077 dimensional prognostic variables are solved with the longer time step 1078 of \np{rn\_rdt} seconds. The trend in the barotropic momentum due to bottom 1022 1079 friction appropriate to this method is that given by the selected parameterisation 1023 1080 ($i.e.$ linear or non-linear bottom friction) computed with the evolving velocities … … 1042 1099 \end{enumerate} 1043 1100 1044 Note that the use of an implicit formulation 1101 Note that the use of an implicit formulation within the barotropic loop 1045 1102 for the bottom friction trend means that any limiting of the bottom friction coefficient 1046 1103 in \mdl{dynbfr} does not adversely affect the solution when using split-explicit time 1047 1104 splitting. This is because the major contribution to bottom friction is likely to come from 1048 the barotropic component which uses the unrestricted value of the coefficient. 1049 1050 The implicit formulation takes the form: 1105 the barotropic component which uses the unrestricted value of the coefficient. However, if the 1106 limiting is thought to be having a major effect (a more likely prospect in coastal and shelf seas 1107 applications) then the fully implicit form of the bottom friction should be used (see \S\ref{ZDF_bfr_imp} ) 1108 which can be selected by setting \np{ln\_bfrimp} $=$ \textit{true}. 1109 1110 Otherwise, the implicit formulation takes the form: 1051 1111 \begin{equation} \label{Eq_zdfbfr_implicitts} 1052 1112 \bar{U}^{t+ \rdt} = \; \left [ \bar{U}^{t-\rdt}\; + 2 \rdt\;RHS \right ] / \left [ 1 - 2 \rdt \;c_b^{u} / H_e \right ] … … 1115 1175 The essential goal of the parameterization is to represent the momentum 1116 1176 exchange between the barotropic tides and the unrepresented internal waves 1117 induced by the tidal ßow over rough topography in a stratified ocean.1177 induced by the tidal flow over rough topography in a stratified ocean. 1118 1178 In the current version of \NEMO, the map is built from the output of 1119 1179 the barotropic global ocean tide model MOG2D-G \citep{Carrere_Lyard_GRL03}. -
branches/2011/dev_NEMO_MERGE_2011/DOC/TexFiles/Chapters/Introduction.tex
r2570 r3116 63 63 \citep{OASIS2006}. Two-way nesting is also available through an interface to the 64 64 AGRIF package (Adaptative Grid Refinement in \textsc{Fortran}) \citep{Debreu_al_CG2008}. 65 The interface code for coupling to an alternative sea ice model (CICE, \citet{Hunke2008}) is now 66 available although this is currently only designed for global domains, without the use of AGRIF. 65 67 66 68 Other model characteristics are the lateral boundary conditions (chapter~\ref{LBC}). -
branches/2011/dev_NEMO_MERGE_2011/DOC/TexFiles/Namelist/nambfr
r2540 r3116 9 9 ln_bfr2d = .false. ! horizontal variation of the bottom friction coef (read a 2D mask file ) 10 10 rn_bfrien = 50. ! local multiplying factor of bfr (ln_bfr2d=T) 11 ln_bfrimp = .false. ! implicit bottom friction (requires ln_zdfexp = .false. if true) 11 12 / -
branches/2011/dev_NEMO_MERGE_2011/DOC/TexFiles/Namelist/namdyn_hpg
r2540 r3116 5 5 ln_hpg_zps = .true. ! z-coordinate - partial steps (interpolation) 6 6 ln_hpg_sco = .false. ! s-coordinate (standard jacobian formulation) 7 ln_hpg_hel = .false. ! s-coordinate (helsinki modification)8 ln_hpg_wdj = .false. ! s-coordinate (weighted density jacobian)9 7 ln_hpg_djc = .false. ! s-coordinate (Density Jacobian with Cubic polynomial) 10 ln_hpg_rot = .false. ! s-coordinate (ROTated axes scheme) 11 rn_gamma = 0.e0 ! weighting coefficient (wdj scheme) 8 ln_hpg_prj = .false. ! s-coordinate (Pressure Jacobian scheme) 12 9 ln_dynhpg_imp = .false. ! time stepping: semi-implicit time scheme (T) 13 10 ! centered time scheme (F) -
branches/2011/dev_NEMO_MERGE_2011/DOC/TexFiles/Namelist/namobs_example
r2298 r3116 57 57 ln_s3d = .true. 58 58 ln_ena = .true. 59 enactfiles = ' profiles_01.nc'59 enactfiles = 'enact.1.nc' 60 60 ln_grid_global = .true. 61 61 ln_grid_search_lookup = .true. -
branches/2011/dev_NEMO_MERGE_2011/DOC/TexFiles/Namelist/namsbc_cpl
r2540 r3116 2 2 &namsbc_cpl ! coupled ocean/atmosphere model ("key_coupled") 3 3 !----------------------------------------------------------------------- 4 ! ! send 5 cn_snd_temperature= 'weighted oce and ice' ! 'oce only' 'weighted oce and ice' 'mixed oce-ice' 6 cn_snd_albedo = 'weighted ice' ! 'none' 'weighted ice' 'mixed oce-ice' 7 cn_snd_thickness = 'none' ! 'none' 'weighted ice and snow' 8 cn_snd_crt_nature = 'none' ! 'none' 'oce only' 'weighted oce and ice' 'mixed oce-ice' 9 cn_snd_crt_refere = 'spherical' ! 'spherical' 'cartesian' 10 cn_snd_crt_orient = 'eastward-northward' ! 'eastward-northward' or 'local grid' 11 cn_snd_crt_grid = 'T' ! 'T' 12 ! ! receive 13 cn_rcv_w10m = 'none' ! 'none' 'coupled' 14 cn_rcv_taumod = 'coupled' ! 'none' 'coupled' 15 cn_rcv_tau_nature = 'oce only' ! 'oce only' 'oce and ice' 'mixed oce-ice' 16 cn_rcv_tau_refere = 'cartesian' ! 'spherical' 'cartesian' 17 cn_rcv_tau_orient = 'eastward-northward' ! 'eastward-northward' or 'local grid' 18 cn_rcv_tau_grid = 'U,V' ! 'T' 'U,V' 'U,V,F' 'U,V,I' 'T,F' 'T,I' 'T,U,V' 19 cn_rcv_dqnsdt = 'coupled' ! 'none' 'coupled' 20 cn_rcv_qsr = 'oce and ice' ! 'conservative' 'oce and ice' 'mixed oce-ice' 21 cn_rcv_qns = 'oce and ice' ! 'conservative' 'oce and ice' 'mixed oce-ice' 22 cn_rcv_emp = 'conservative' ! 'conservative' 'oce and ice' 'mixed oce-ice' 23 cn_rcv_rnf = 'coupled' ! 'coupled' 'climato' 'mixed' 24 cn_rcv_cal = 'coupled' ! 'none' 'coupled' 4 ! ! description ! multiple ! vector ! vector ! vector ! 5 ! ! ! categories ! reference ! orientation ! grids ! 6 ! send 7 sn_snd_temp = 'weighted oce and ice' , 'no' , '' , '' , '' 8 sn_snd_alb = 'weighted ice' , 'no' , '' , '' , '' 9 sn_snd_thick = 'none' , 'no' , '' , '' , '' 10 sn_snd_crt = 'none' , 'no' , 'spherical' , 'eastward-northward' , 'T' 11 sn_snd_co2 = 'coupled' , 'no' , '' , '' , '' 12 ! receive 13 sn_rcv_w10m = 'none' , 'no' , '' , '' , '' 14 sn_rcv_taumod = 'coupled' , 'no' , '' , '' , '' 15 sn_rcv_tau = 'oce only' , 'no' , 'cartesian' , 'eastward-northward', 'U,V' 16 sn_rcv_dqnsdt = 'coupled' , 'no' , '' , '' , '' 17 sn_rcv_qsr = 'oce and ice' , 'no' , '' , '' , '' 18 sn_rcv_qns = 'oce and ice' , 'no' , '' , '' , '' 19 sn_rcv_emp = 'conservative' , 'no' , '' , '' , '' 20 sn_rcv_rnf = 'coupled' , 'no' , '' , '' , '' 21 sn_rcv_cal = 'coupled' , 'no' , '' , '' , '' 22 sn_rcv_co2 = 'coupled' , 'no' , '' , '' , '' 25 23 / -
branches/2011/dev_NEMO_MERGE_2011/DOC/TexFiles/Namelist/namtra_ldf
r2540 r3116 9 9 ln_traldf_hor = .false. ! horizontal (geopotential) (require "key_ldfslp" when ln_sco=T) 10 10 ln_traldf_iso = .true. ! iso-neutral (require "key_ldfslp") 11 ln_traldf_grif = .false. ! griffies skew flux formulation (require "key_ldfslp") ! UNDER TEST, DO NOT USE 12 ln_traldf_gdia = .false. ! griffies operator strfn diagnostics (require "key_ldfslp") ! UNDER TEST, DO NOT USE 11 ln_traldf_grif = .false. ! griffies skew flux formulation (require "key_ldfslp") 12 ln_traldf_gdia = .false. ! griffies operator strfn diagnostics (require "key_ldfslp") 13 ln_triad_iso = .false. ! griffies operator calculates triads twice => pure lateral mixing in ML (require "key_ldfslp") 14 ln_botmix_grif = .false. ! griffies operator with lateral mixing on bottom (require "key_ldfslp") 13 15 ! ! Coefficient 14 16 rn_aht_0 = 2000. ! horizontal eddy diffusivity for tracers [m2/s] -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/ARCH/arch-ALTIX_NAUTILUS4.fcm
r2364 r3116 22 22 # Note use of -Bstatic because the library root directories are not accessible to the back-end compute nodes 23 23 %NCDF_LIB -L%HDF5_HOME/lib -L%NCDF_HOME/lib -Bstatic -lnetcdf -lhdf5_fortran -lhdf5_hl -lhdf5 -Bdynamic -lz 24 %FC mpif9024 %FC ifort 25 25 %FCFLAGS -r8 -O3 -xT -ip -vec-report0 26 26 %FFLAGS -r8 -O3 -xT -ip -vec-report0 27 %LD mpif9027 %LD ifort 28 28 %FPPFLAGS -P -C -traditional 29 %LDFLAGS 29 %LDFLAGS -lmpi 30 30 %AR ar 31 31 %ARFLAGS -r -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/CONFIG/AMM12_PISCES/EXP00/namelist
r3113 r3116 94 94 / 95 95 !----------------------------------------------------------------------- 96 &namdta_tem ! data : temperature ("key_dtatem") 97 !----------------------------------------------------------------------- 98 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim !'yearly' or ! weights ! rotation ! 99 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! 100 sn_tem = 'data_1m_potential_temperature_nomask', -1,'votemper', .true. , .true., 'yearly' , ' ' , ' ' 96 &namtsd ! data : Temperature & Salinity 97 !----------------------------------------------------------------------- 98 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim !'yearly' or ! weights ! rotation ! 99 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! 100 sn_tem = 'data_1m_potential_temperature_nomask', -1,'votemper', .true. , .true., 'yearly' , ' ' , ' ' 101 sn_sal = 'data_1m_salinity_nomask' , -1,'vosaline', .true. , .true., 'yearly' , '' , ' ' 101 102 ! 102 cn_dir = './' ! root directory for the location of the runoff files 103 / 104 !----------------------------------------------------------------------- 105 &namdta_sal ! data : salinity ("key_dtasal") 106 !----------------------------------------------------------------------- 107 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim !'yearly' or ! weights ! rotation ! 108 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! 109 sn_sal = 'data_1m_salinity_nomask', -1 ,'vosaline', .true. , .true., 'yearly' , '' , ' ' 110 ! 111 cn_dir = './' ! root directory for the location of the runoff files 112 / 113 103 cn_dir = './' ! root directory for the location of the runoff files 104 ln_tsd_init = .false. ! Initialisation of ocean T & S with T &S input data (T) or not (F) 105 ln_tsd_tradmp = .false. ! damping of ocean T & S toward T &S input data (T) or not (F) 106 / 114 107 !!====================================================================== 115 108 !! *** Surface Boundary Condition namelists *** -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/CONFIG/AMM12_PISCES/EXP00/namelist_pisces
r3034 r3116 15 15 &nampisext ! air-sea exchange 16 16 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 17 atcco2 = 287. ! atmospheric pCO2 17 ln_co2int = .false. ! read atm pco2 from a file (T) or constant (F) 18 atcco2 = 287. ! Constant value atmospheric pCO2 - ln_co2int = F 19 clname = 'atcco2.txt' ! Name of atm pCO2 file - ln_co2int = T 20 nn_offset = 0 ! Offset model-data start year - ln_co2int = T 21 ! ! If your model year is iyy, nn_offset=(years(1)-iyy) 22 ! ! then the first atmospheric CO2 record read is at years(1) 23 / 24 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 25 &nampisatm ! Atmospheric prrssure 26 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 27 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! 28 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! 29 sn_patm = 'presatm' , -1 , 'patm' , .true. , .true. , 'yearly' , '' , '' 30 cn_dir = './' ! root directory for the location of the dynamical files 31 ! 32 ln_presatm = .true. ! constant atmopsheric pressure (F) or from a file (T) 18 33 / 19 34 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 20 35 &nampisbio ! biological parameters 21 36 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 22 part = 0.85 ! part of calcite not dissolved in guts 23 nrdttrc = 1 ! time step frequency for biology 24 wsbio = 2. ! POC sinking speed 25 xkmort = 1.E-7 ! half saturation constant for mortality 26 ferat3 = 3.E-6 ! Fe/C in zooplankton 27 wsbio2 = 30. ! Big particles sinking speed 37 nrdttrc = 1 ! time step frequency for biology 38 wsbio = 2. ! POC sinking speed 39 xkmort = 1.E-7 ! half saturation constant for mortality 40 ferat3 = 10.E-6 ! Fe/C in zooplankton 41 wsbio2 = 30. ! Big particles sinking speed 28 42 / 29 43 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' … … 31 45 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 32 46 conc0 = 2.e-6 ! Phosphate half saturation 33 conc1 = 10E-6 ! Phosphate half saturation for diatoms 34 conc2 = 0.01E-9 ! Iron half saturation for phyto 35 conc2m = 0.08E-9 ! Max iron half saturation for phyto 36 conc3 = 0.1E-9 ! Iron half saturation for diatoms 37 conc3m = 0.4E-9 ! Maxi iron half saturation for diatoms 47 conc1 = 8E-6 ! Phosphate half saturation for diatoms 48 conc2 = 2E-9 ! Iron half saturation for phyto 49 conc2m = 4E-9 ! Max iron half saturation for phyto 50 conc3 = 3E-9 ! Iron half saturation for diatoms 51 conc3m = 9E-9 ! Maxi iron half saturation for diatoms 52 xsizedia = 5.E-7 ! Minimum size criteria for diatoms 53 xsizephy = 1.E-6 ! Minimum size criteria for phyto 38 54 concnnh4 = 1.E-7 ! NH4 half saturation for phyto 39 concdnh4 = 5.E-7 ! NH4 half saturation for diatoms55 concdnh4 = 4.E-7 ! NH4 half saturation for diatoms 40 56 xksi1 = 2.E-6 ! half saturation constant for Si uptake 41 57 xksi2 = 3.33E-6 ! half saturation constant for Si/C 42 58 xkdoc = 417.E-6 ! half-saturation constant of DOC remineralization 43 caco3r = 0.15 ! mean rain ratio 59 concfebac = 3.E-11 ! Half-saturation for Fe limitation of Bacteria 60 qnfelim = 7.E-6 ! Optimal quota of phyto 61 qdfelim = 7.E-6 ! Optimal quota of diatoms 62 caco3r = 0.16 ! mean rain ratio 44 63 / 45 64 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 46 65 &nampisprod ! parameters for phytoplankton growth 47 66 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 48 pislope = 3. ! P-I slope 49 pislope2 = 3. ! P-I slope for diatoms67 pislope = 3. ! P-I slope 68 pislope2 = 2. ! P-I slope for diatoms 50 69 excret = 0.05 ! excretion ratio of phytoplankton 51 70 excret2 = 0.05 ! excretion ratio of diatoms 71 ln_newprod = .false. ! Enable new parame. of production (T/F) 72 bresp = 0.00333 ! Basal respiration rate 52 73 chlcnm = 0.033 ! Minimum Chl/C in nanophytoplankton 53 chlcdm = 0.05 ! Minimum Chl/C in diatoms 54 fecnm = 10E-6 ! Maximum Fe/C in nanophytoplankton 55 fecdm = 15E-6 ! Minimum Fe/C in diatoms 74 chlcdm = 0.04 ! Minimum Chl/C in diatoms 75 chlcmin = 0.0033 ! Maximum Chl/c in phytoplankton 76 fecnm = 40E-6 ! Maximum Fe/C in nanophytoplankton 77 fecdm = 40E-6 ! Minimum Fe/C in diatoms 56 78 grosip = 0.151 ! mean Si/C ratio 57 79 / … … 68 90 &nampismes ! parameters for mesozooplankton 69 91 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 92 part2 = 0.75 ! part of calcite not dissolved in mesozoo guts 70 93 grazrat2 = 0.7 ! maximal mesozoo grazing rate 71 94 resrat2 = 0.005 ! exsudation rate of mesozooplankton 72 95 mzrat2 = 0.03 ! mesozooplankton mortality rate 73 96 xprefc = 1. ! zoo preference for phyto 74 xprefp = 0. 2! zoo preference for POC97 xprefp = 0.3 ! zoo preference for POC 75 98 xprefz = 1. ! zoo preference for zoo 76 xprefpoc = 0.2 ! zoo preference for poc 99 xprefpoc = 0.3 ! zoo preference for poc 100 xthresh2zoo = 1E-8 ! zoo feeding threshold for mesozooplankton 101 xthresh2dia = 1E-8 ! diatoms feeding threshold for mesozooplankton 102 xthresh2phy = 2E-7 ! nanophyto feeding threshold for mesozooplankton 103 xthresh2poc = 1E-8 ! poc feeding threshold for mesozooplankton 104 xthresh2 = 0. ! Food threshold for grazing 77 105 xkgraz2 = 20.E-6 ! half sturation constant for meso grazing 78 epsher2 = 0.33 ! Efficicency of Mesozoo growth 106 epsher2 = 0.33 ! Efficicency of Mesozoo growth 79 107 sigma2 = 0.6 ! Fraction of mesozoo excretion as DOM 80 108 unass2 = 0.3 ! non assimilated fraction of P by mesozoo 81 grazflux = 5.e3 ! flux-feeding rate109 grazflux = 3.e3 ! flux-feeding rate 82 110 / 83 111 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 84 112 &nampiszoo ! parameters for microzooplankton 85 113 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 86 grazrat = 4.0 ! maximal zoo grazing rate 114 part = 0.5 ! part of calcite not dissolved in microzoo gutsa 115 grazrat = 3.0 ! maximal zoo grazing rate 87 116 resrat = 0.03 ! exsudation rate of zooplankton 88 117 mzrat = 0.0 ! zooplankton mortality rate 89 xpref2c = 0.1 ! Microzoo preference for POM 90 xpref2p = 0.45 ! Microzoo preference for Nanophyto 91 xpref2d = 0.45 ! Microzoo preference for Diatoms 92 xkgraz = 20.E-6 ! half sturation constant for grazing 118 xpref2c = 0.1 ! Microzoo preference for POM 119 xpref2p = 1. ! Microzoo preference for Nanophyto 120 xpref2d = 0.6 ! Microzoo preference for Diatoms 121 xthreshdia = 1.E-8 ! Diatoms feeding threshold for microzooplankton 122 xthreshphy = 2.E-7 ! Nanophyto feeding threshold for microzooplankton 123 xthreshpoc = 1.E-8 ! POC feeding threshold for microzooplankton 124 xthresh = 0. ! Food threshold for feeding 125 xkgraz = 20.E-6 ! half sturation constant for grazing 93 126 epsher = 0.33 ! Efficiency of microzoo growth 94 127 sigma1 = 0.6 ! Fraction of microzoo excretion as DOM … … 98 131 &nampisrem ! parameters for remineralization 99 132 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 100 xremik = 0. 3! remineralization rate of DOC133 xremik = 0.25 ! remineralization rate of DOC 101 134 xremip = 0.025 ! remineralisation rate of POC 102 135 nitrif = 0.05 ! NH4 nitrification rate 103 xsirem = 0.015 ! remineralization rate of Si 136 xsirem = 0.003 ! remineralization rate of Si 137 xsiremlab = 0.025 ! fast remineralization rate of Si 138 xsilab = 0.31 ! Fraction of labile biogenic silica 104 139 xlam1 = 0.005 ! scavenging rate of Iron 105 oxymin = 1.E-6 ! Half-saturation constant for anoxia 140 oxymin = 1.E-6 ! Half-saturation constant for anoxia 141 ligand = 0.6E-9 ! Ligands concentration 106 142 / 107 143 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 108 144 &nampiscal ! parameters for Calcite chemistry 109 145 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 110 kdca = 0.327e3! calcite dissolution rate constant (1/time)146 kdca = 6. ! calcite dissolution rate constant (1/time) 111 147 nca = 1. ! order of dissolution reaction (dimensionless) 112 148 / … … 114 150 &nampissed ! parameters for inputs deposition 115 151 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 116 ln_dustfer = .false. ! boolean for dust input from the atmosphere 117 ln_river = .false. ! boolean for river input of nutrients 152 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! 153 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! 154 sn_dust = 'dust.orca' , -1 , 'dust' , .true. , .true. , 'yearly' , '' , '' 155 sn_riverdic = 'river.orca' , -12 , 'riverdic' , .false. , .true. , 'yearly' , '' , '' 156 sn_riverdoc = 'river.orca' , -12 , 'riverdoc' , .false. , .true. , 'yearly' , '' , '' 157 sn_ndepo = 'ndeposition.orca', -12 , 'ndep' , .false. , .true. , 'yearly' , '' , '' 158 sn_ironsed = 'bathy.orca' , -12 , 'bathy' , .false. , .true. , 'yearly' , '' , '' 159 ! 160 cn_dir = './' ! root directory for the location of the dynamical files 161 ln_dust = .false. ! boolean for dust input from the atmosphere 162 ln_river = .false. ! boolean for river input of nutrients 118 163 ln_ndepo = .false. ! boolean for atmospheric deposition of N 119 ln_ sedinput= .false. ! boolean for Fe input from sediments164 ln_ironsed = .false. ! boolean for Fe input from sediments 120 165 sedfeinput = 1E-9 ! Coastal release of Iron 121 dustsolub = 0.014 ! Solubility of the dust 166 dustsolub = 0.02 ! Solubility of the dust 167 wdust = 2.0 ! Dust sinking speed 168 nitrfix = 1E-7 ! Nitrogen fixation rate 169 diazolight = 50. ! Diazotrophs sensitivity to light (W/m2) 170 concfediaz = 1.E-10 ! Diazotrophs half-saturation Cste for Iron 122 171 / 123 172 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' … … 140 189 / 141 190 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 142 &nampisdia ! additional 2D/3D tracers diagnostics ("key_trc_diaadd") 143 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 144 nn_writedia = 5475 ! time step frequency for tracers diagnostics 145 ! 191 &nampisdia ! additional 2D/3D tracers diagnostics 192 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 146 193 ! ! name ! title of the field ! units ! 147 194 ! ! ! ! ! … … 175 222 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 176 223 ln_pisdmp = .true. ! Relaxation fo some tracers to a mean value 177 / 224 nn_pisdmp = 5475 ! Frequency of Relaxation 225 / -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/CONFIG/AMM12_PISCES/EXP00/namelist_top
r3034 r3116 1 1 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 2 2 !! NEMO/TOP1 : 1 - tracer definition (namtrc ) 3 !! namelists 2 - dynamical tracer trends (namtrc_trd)3 !! 2 - tracer data initialisation (namtrc_dta) 4 4 !! 3 - tracer advection (namtrc_adv) 5 5 !! 4 - tracer lateral diffusion (namtrc_ldf) 6 6 !! 5 - tracer vertical physics (namtrc_zdf) 7 7 !! 6 - tracer newtonian damping (namtrc_dmp) 8 !! 7 - dynamical tracer trends (namtrc_trd) 9 !! 8 - tracer output diagonstics (namtrc_dia) 8 10 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 9 11 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 10 12 &namtrc ! tracers definition 11 13 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 12 nn_dttrc = 1 ! time step frequency for passive sn_tracers14 nn_dttrc = 1 ! time step frequency for passive sn_tracers 13 15 nn_writetrc = 10 ! time step frequency for sn_tracer outputs 14 16 ln_rsttr = .false. ! start from a restart file (T) or not (F) … … 18 20 cn_trcrst_in = "restart_trc" ! suffix of pass. sn_tracer restart name (input) 19 21 cn_trcrst_out = "restart_trc" ! suffix of pass. sn_tracer restart name (output) 22 ln_trcdta = .false. ! Initialisation from data input file (T) or not (F) 20 23 ! 21 24 ! ! name ! title of the field ! units ! initial data ! save ! 22 25 ! ! ! ! ! from file ! or not ! 23 26 ! ! ! ! ! or not ! ! 24 sn_tracer(1) = 'DIC ' , 'Dissolved inorganic Concentration ', 'mol-C/L' , . false. , .true.25 sn_tracer(2) = 'Alkalini' , 'Total Alkalinity Concentration ', 'eq/L ' , . false. , .true.26 sn_tracer(3) = 'O2 ' , 'Dissolved Oxygen Concentration ', 'mol-C/L' , . false. , .true.27 sn_tracer(1) = 'DIC ' , 'Dissolved inorganic Concentration ', 'mol-C/L' , .true. , .true. 28 sn_tracer(2) = 'Alkalini' , 'Total Alkalinity Concentration ', 'eq/L ' , .true. , .true. 29 sn_tracer(3) = 'O2 ' , 'Dissolved Oxygen Concentration ', 'mol-C/L' , .true. , .true. 27 30 sn_tracer(4) = 'CaCO3 ' , 'Calcite Concentration ', 'mol-C/L' , .false. , .true. 28 sn_tracer(5) = 'PO4 ' , 'Phosphate Concentration ', 'mol-C/L' , . false. , .true.31 sn_tracer(5) = 'PO4 ' , 'Phosphate Concentration ', 'mol-C/L' , .true. , .true. 29 32 sn_tracer(6) = 'POC ' , 'Small organic carbon Concentration ', 'mol-C/L' , .false. , .true. 30 sn_tracer(7) = 'Si ' , 'Silicate Concentration ', 'mol-C/L' , . false. , .true.33 sn_tracer(7) = 'Si ' , 'Silicate Concentration ', 'mol-C/L' , .true. , .true. 31 34 sn_tracer(8) = 'PHY ' , 'Nanophytoplankton Concentration ', 'mol-C/L' , .false. , .true. 32 35 sn_tracer(9) = 'ZOO ' , 'Microzooplankton Concentration ', 'mol-C/L' , .false. , .true. … … 35 38 sn_tracer(12) = 'ZOO2 ' , 'Mesozooplankton Concentration ', 'mol-C/L' , .false. , .true. 36 39 sn_tracer(13) = 'BSi ' , 'Diatoms Silicate Concentration ', 'mol-C/L' , .false. , .true. 37 sn_tracer(14) = 'Fer ' , 'Dissolved Iron Concentration ', 'mol-C/L' , . false. , .true.40 sn_tracer(14) = 'Fer ' , 'Dissolved Iron Concentration ', 'mol-C/L' , .true. , .true. 38 41 sn_tracer(15) = 'BFe ' , 'Big iron particles Concentration ', 'mol-C/L' , .false. , .true. 39 42 sn_tracer(16) = 'GOC ' , 'Big organic carbon Concentration ', 'mol-C/L' , .false. , .true. … … 44 47 sn_tracer(21) = 'NCHL ' , 'Nano chlorophyl Concentration ', 'mol-C/L' , .false. , .true. 45 48 sn_tracer(22) = 'DCHL ' , 'Diatoms chlorophyl Concentration ', 'mol-C/L' , .false. , .true. 46 sn_tracer(23) = 'NO3 ' , 'Nitrates Concentration ', 'mol-C/L' , . false. , .true.49 sn_tracer(23) = 'NO3 ' , 'Nitrates Concentration ', 'mol-C/L' , .true. , .true. 47 50 sn_tracer(24) = 'NH4 ' , 'Ammonium Concentration ', 'mol-C/L' , .false. , .true. 51 / 52 !----------------------------------------------------------------------- 53 &namtrc_dta ! Initialisation from data input file 54 !----------------------------------------------------------------------- 55 ! 56 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! 57 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! 58 sn_trcdta(1) = 'data_DIC_nomask' , -12 , 'DIC' , .false. , .true. , 'yearly' , '' , '' 59 sn_trcdta(2) = 'data_Alkalini_nomask' , -12 , 'Alkalini', .false. , .true. , 'yearly' , '' , '' 60 sn_trcdta(3) = 'data_O2_nomask' , -1 , 'O2' , .true. , .true. , 'yearly' , '' , '' 61 sn_trcdta(5) = 'data_PO4_nomask' , -1 , 'PO4' , .true. , .true. , 'yearly' , '' , '' 62 sn_trcdta(7) = 'data_Si_nomask' , -1 , 'Si' , .true. , .true. , 'yearly' , '' , '' 63 sn_trcdta(10) = 'data_DOC_nomask' , -12 , 'DOC' , .false. , .true. , 'yearly' , '' , '' 64 sn_trcdta(14) = 'data_Fer_nomask' , -12 , 'Fer' , .false. , .true. , 'yearly' , '' , '' 65 sn_trcdta(23) = 'data_NO3_nomask' , -1 , 'NO3' , .true. , .true. , 'yearly' , '' , '' 66 ! 67 cn_dir = './' ! root directory for the location of the data files 68 rn_trfac(1) = 1.0e-06 ! multiplicative factor 69 rn_trfac(2) = 1.0e-06 ! - - - - 70 rn_trfac(3) = 44.6e-06 ! - - - - 71 rn_trfac(5) = 122.0e-06 ! - - - - 72 rn_trfac(7) = 1.0e-06 ! - - - - 73 rn_trfac(10) = 1.0 ! - - - - 74 rn_trfac(14) = 1.0 ! - - - - 75 rn_trfac(23) = 7.6e-06 ! - - - - 48 76 / 49 77 !----------------------------------------------------------------------- … … 69 97 ln_trcldf_iso = .true. ! iso-neutral (require "key_ldfslp") 70 98 ! ! Coefficient 99 rn_ahtrc_0 = 2000. ! horizontal eddy diffusivity for tracers [m2/s] 71 100 rn_ahtrb_0 = 0. ! background eddy diffusivity for ldf_iso [m2/s] 72 101 / … … 83 112 / 84 113 !----------------------------------------------------------------------- 85 &namtrc_dmp ! passive tracer newtonian damping ('key_tradmp && key_trcdmp')114 &namtrc_dmp ! passive tracer newtonian damping 86 115 !----------------------------------------------------------------------- 116 ln_trcdmp = .false. ! add a damping termn (T) or not (F) 87 117 nn_hdmp_tr = -1 ! horizontal shape =-1, damping in Med and Red Seas only 88 118 ! =XX, damping poleward of XX degrees (XX>0) … … 107 137 ln_trdtrc(1) = .true. 108 138 ln_trdtrc(2) = .true. 109 ln_trdtrc(3) = .false.110 ln_trdtrc(4) = .false.111 ln_trdtrc(5) = .false.112 ln_trdtrc(6) = .false.113 ln_trdtrc(7) = .false.114 ln_trdtrc(8) = .false.115 ln_trdtrc(9) = .false.116 ln_trdtrc(10) = .false.117 ln_trdtrc(11) = .false.118 ln_trdtrc(12) = .false.119 ln_trdtrc(13) = .false.120 ln_trdtrc(14) = .false.121 ln_trdtrc(15) = .false.122 ln_trdtrc(16) = .false.123 ln_trdtrc(17) = .false.124 ln_trdtrc(18) = .false.125 ln_trdtrc(19) = .false.126 ln_trdtrc(20) = .false.127 ln_trdtrc(21) = .false.128 ln_trdtrc(22) = .false.129 139 ln_trdtrc(23) = .true. 130 ln_trdtrc(24) = .false.131 140 / 141 !----------------------------------------------------------------------- 142 &namtrc_dia ! parameters for passive tracer additional diagnostics 143 !---------------------------------------------------------------------- 144 ln_diatrc = .false. ! save additional diag. (T) or not (F) 145 nn_writedia = 5475 ! time step frequency for diagnostics 146 / -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/CONFIG/AMM12_PISCES/cpp_AMM12_PISCES.fcm
r3110 r3116 1 bld::tool::fppkeys key_top key_pisces key_ diatrc key_bdy key_vectopt_loop key_amm_12km key_dynspg_ts key_ldfslp key_zdfgls key_vvl key_diainstant key_mpp_mpi1 bld::tool::fppkeys key_top key_pisces key_bdy key_vectopt_loop key_amm_12km key_dynspg_ts key_ldfslp key_zdfgls key_vvl key_diainstant key_mpp_mpi -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/CONFIG/GYRE/EXP00/namelist
r3105 r3116 3 3 !! namelists 2 - Domain (namzgr, namzgr_sco, namdom, namtsd) 4 4 !! 3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core 5 !! namsbc_cpl, nam sbc_cpl_co2 namtra_qsr, namsbc_rnf,5 !! namsbc_cpl, namtra_qsr, namsbc_rnf, 6 6 !! namsbc_apr, namsbc_ssr, namsbc_alb) 7 7 !! 4 - lateral boundary (namlbc, namcla, namobc, namagrif, nambdy, nambdy_tide) … … 114 114 !! namsbc_mfs MFS bulk formulae formulation 115 115 !! namsbc_cpl CouPLed formulation ("key_coupled") 116 !! namsbc_cpl_co2 coupled ocean/biogeo/atmosphere model ("key_cpl_carbon_cycle")117 116 !! namtra_qsr penetrative solar radiation 118 117 !! namsbc_rnf river runoffs … … 222 221 &namsbc_cpl ! coupled ocean/atmosphere model ("key_coupled") 223 222 !----------------------------------------------------------------------- 224 ! ! send 225 cn_snd_temperature= 'weighted oce and ice' ! 'oce only' 'weighted oce and ice' 'mixed oce-ice' 226 cn_snd_albedo = 'weighted ice' ! 'none' 'weighted ice' 'mixed oce-ice' 227 cn_snd_thickness = 'none' ! 'none' 'weighted ice and snow' 228 cn_snd_crt_nature = 'none' ! 'none' 'oce only' 'weighted oce and ice' 'mixed oce-ice' 229 cn_snd_crt_refere = 'spherical' ! 'spherical' 'cartesian' 230 cn_snd_crt_orient = 'eastward-northward' ! 'eastward-northward' or 'local grid' 231 cn_snd_crt_grid = 'T' ! 'T' 232 ! ! receive 233 cn_rcv_w10m = 'none' ! 'none' 'coupled' 234 cn_rcv_taumod = 'coupled' ! 'none' 'coupled' 235 cn_rcv_tau_nature = 'oce only' ! 'oce only' 'oce and ice' 'mixed oce-ice' 236 cn_rcv_tau_refere = 'cartesian' ! 'spherical' 'cartesian' 237 cn_rcv_tau_orient = 'eastward-northward' ! 'eastward-northward' or 'local grid' 238 cn_rcv_tau_grid = 'U,V' ! 'T' 'U,V' 'U,V,F' 'U,V,I' 'T,F' 'T,I' 'T,U,V' 239 cn_rcv_dqnsdt = 'coupled' ! 'none' 'coupled' 240 cn_rcv_qsr = 'oce and ice' ! 'conservative' 'oce and ice' 'mixed oce-ice' 241 cn_rcv_qns = 'oce and ice' ! 'conservative' 'oce and ice' 'mixed oce-ice' 242 cn_rcv_emp = 'conservative' ! 'conservative' 'oce and ice' 'mixed oce-ice' 243 cn_rcv_rnf = 'coupled' ! 'coupled' 'climato' 'mixed' 244 cn_rcv_cal = 'coupled' ! 'none' 'coupled' 245 / 246 !----------------------------------------------------------------------- 247 &namsbc_cpl_co2 ! coupled ocean/biogeo/atmosphere model ("key_cpl_carbon_cycle") 248 !----------------------------------------------------------------------- 249 cn_snd_co2 = 'coupled' ! send : 'none' 'coupled' 250 cn_rcv_co2 = 'coupled' ! receive : 'none' 'coupled' 223 ! ! description ! multiple ! vector ! vector ! vector ! 224 ! ! ! categories ! reference ! orientation ! grids ! 225 ! send 226 sn_snd_temp = 'weighted oce and ice' , 'no' , '' , '' , '' 227 sn_snd_alb = 'weighted ice' , 'no' , '' , '' , '' 228 sn_snd_thick = 'none' , 'no' , '' , '' , '' 229 sn_snd_crt = 'none' , 'no' , 'spherical' , 'eastward-northward' , 'T' 230 sn_snd_co2 = 'coupled' , 'no' , '' , '' , '' 231 ! receive 232 sn_rcv_w10m = 'none' , 'no' , '' , '' , '' 233 sn_rcv_taumod = 'coupled' , 'no' , '' , '' , '' 234 sn_rcv_tau = 'oce only' , 'no' , 'cartesian' , 'eastward-northward', 'U,V' 235 sn_rcv_dqnsdt = 'coupled' , 'no' , '' , '' , '' 236 sn_rcv_qsr = 'oce and ice' , 'no' , '' , '' , '' 237 sn_rcv_qns = 'oce and ice' , 'no' , '' , '' , '' 238 sn_rcv_emp = 'conservative' , 'no' , '' , '' , '' 239 sn_rcv_rnf = 'coupled' , 'no' , '' , '' , '' 240 sn_rcv_cal = 'coupled' , 'no' , '' , '' , '' 241 sn_rcv_co2 = 'coupled' , 'no' , '' , '' , '' 251 242 / 252 243 !----------------------------------------------------------------------- … … 402 393 &nambdy ! unstructured open boundaries ("key_bdy") 403 394 !----------------------------------------------------------------------- 404 cn_mask = '' ! name of mask file (ln_mask=T) 405 cn_dta_frs_T= 'bdydata_grid_T.nc' ! name of data file (T-points) 406 cn_dta_frs_U= 'bdydata_grid_U.nc' ! name of data file (U-points) 407 cn_dta_frs_V= 'bdydata_grid_V.nc' ! name of data file (V-points) 408 cn_dta_fla_T= 'bdydata_bt_grid_T.nc' ! name of data file for Flather condition (T-points) 409 cn_dta_fla_U= 'bdydata_bt_grid_U.nc' ! name of data file for Flather condition (U-points) 410 cn_dta_fla_V= 'bdydata_bt_grid_V.nc' ! name of data file for Flather condition (V-points) 411 412 ln_clim = .false. ! contain 1 (T) or 12 (F) time dumps and be cyclic 413 ln_vol = .false. ! total volume correction (see volbdy parameter) 414 ln_mask = .false. ! boundary mask from filbdy_mask (T), boundaries are on edges of domain (F) 415 ln_tides = .false. ! Apply tidal harmonic forcing with Flather condition 416 ln_dyn_fla = .false. ! Apply Flather condition to velocities 417 ln_tra_frs = .false. ! Apply FRS condition to temperature and salinity 418 ln_dyn_frs = .false. ! Apply FRS condition to velocities 419 nn_rimwidth = 9 ! width of the relaxation zone 420 nn_dtactl = 1 ! = 0, bdy data are equal to the initial state 395 nb_bdy = 1 ! number of open boundary sets 396 ln_coords_file = .true. ! =T : read bdy coordinates from file 397 cn_coords_file = 'coordinates.bdy.nc' ! bdy coordinates files 398 ln_mask_file = .false. ! =T : read mask from file 399 cn_mask_file = '' ! name of mask file (if ln_mask_file=.TRUE.) 400 nn_dyn2d = 2 ! boundary conditions for barotropic fields 401 nn_dyn2d_dta = 3 ! = 0, bdy data are equal to the initial state 402 ! = 1, bdy data are read in 'bdydata .nc' files 403 ! = 2, use tidal harmonic forcing data from files 404 ! = 3, use external data AND tidal harmonic forcing 405 nn_dyn3d = 0 ! boundary conditions for baroclinic velocities 406 nn_dyn3d_dta = 0 ! = 0, bdy data are equal to the initial state 421 407 ! = 1, bdy data are read in 'bdydata .nc' files 422 nn_volctl = 0 ! = 0, the total water flux across open boundaries is zero 423 ! = 1, the total volume of the system is conserved 424 / 425 !----------------------------------------------------------------------- 426 &nambdy_tide ! tidal forcing at unstructured boundaries 427 !----------------------------------------------------------------------- 428 filtide = 'bdytide_' ! file name root of tidal forcing files 429 tide_cpt = 'M2','S1' ! names of tidal components used 430 tide_speed = 28.984106, 15.000001 ! phase speeds of tidal components (deg/hour) 431 ln_tide_date= .false. ! adjust tidal harmonics for start date of run 432 / 433 408 nn_tra = 1 ! boundary conditions for T and S 409 nn_tra_dta = 1 ! = 0, bdy data are equal to the initial state 410 ! = 1, bdy data are read in 'bdydata .nc' files 411 nn_rimwidth = 10 ! width of the relaxation zone 412 nn_dmp2d_in = 0 ! 413 nn_dmp2d_out = 0 ! 414 nn_dmp2d_in = 0 ! 415 nn_dmp2d_out = 0 ! 416 ln_vol = .false. ! total volume correction (see nn_volctl parameter) 417 nn_volctl = 1 ! = 0, the total water flux across open boundaries is zero 418 / 419 !----------------------------------------------------------------------- 420 &nambdy_dta ! open boundaries - external data ("key_bdy") 421 !----------------------------------------------------------------------- 422 ! ! file name ! frequency (hours) ! variable ! time interpol. ! clim ! 'yearly'/ ! weights ! rotation ! 423 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! 424 bn_ssh = 'amm12_bdyT_u2d' , 24 , 'sossheig' , .true. , .false. , 'daily' , '' , '' 425 bn_u2d = 'amm12_bdyU_u2d' , 24 , 'vobtcrtx' , .true. , .false. , 'daily' , '' , '' 426 bn_v2d = 'amm12_bdyV_u2d' , 24 , 'vobtcrty' , .true. , .false. , 'daily' , '' , '' 427 bn_u3d = 'amm12_bdyU_u3d' , 24 , 'vozocrtx' , .true. , .false. , 'daily' , '' , '' 428 bn_v3d = 'amm12_bdyV_u3d' , 24 , 'vomecrty' , .true. , .false. , 'daily' , '' , '' 429 bn_tem = 'amm12_bdyT_tra' , 24 , 'votemper' , .true. , .false. , 'daily' , '' , '' 430 bn_sal = 'amm12_bdyT_tra' , 24 , 'vosaline' , .true. , .false. , 'daily' , '' , '' 431 cn_dir = 'bdydta/' 432 ln_full_vel = .false. 433 / 434 !----------------------------------------------------------------------- 435 &nambdy_tide ! tidal forcing at open boundaries 436 !----------------------------------------------------------------------- 437 filtide = 'bdydta/amm12_bdytide_' ! file name root of tidal forcing files 438 tide_cpt(1) ='Q1' ! names of tidal components used 439 tide_cpt(2) ='O1' ! names of tidal components used 440 tide_cpt(3) ='P1' ! names of tidal components used 441 tide_cpt(4) ='S1' ! names of tidal components used 442 tide_cpt(5) ='K1' ! names of tidal components used 443 tide_cpt(6) ='2N2' ! names of tidal components used 444 tide_cpt(7) ='MU2' ! names of tidal components used 445 tide_cpt(8) ='N2' ! names of tidal components used 446 tide_cpt(9) ='NU2' ! names of tidal components used 447 tide_cpt(10) ='M2' ! names of tidal components used 448 tide_cpt(11) ='L2' ! names of tidal components used 449 tide_cpt(12) ='T2' ! names of tidal components used 450 tide_cpt(13) ='S2' ! names of tidal components used 451 tide_cpt(14) ='K2' ! names of tidal components used 452 tide_cpt(15) ='M4' ! names of tidal components used 453 tide_speed(1) = 13.398661 ! phase speeds of tidal components (deg/hour) 454 tide_speed(2) = 13.943036 ! phase speeds of tidal components (deg/hour) 455 tide_speed(3) = 14.958932 ! phase speeds of tidal components (deg/hour) 456 tide_speed(4) = 15.000001 ! phase speeds of tidal components (deg/hour) 457 tide_speed(5) = 15.041069 ! phase speeds of tidal components (deg/hour) 458 tide_speed(6) = 27.895355 ! phase speeds of tidal components (deg/hour) 459 tide_speed(7) = 27.968210 ! phase speeds of tidal components (deg/hour) 460 tide_speed(8) = 28.439730 ! phase speeds of tidal components (deg/hour) 461 tide_speed(9) = 28.512585 ! phase speeds of tidal components (deg/hour) 462 tide_speed(10) = 28.984106 ! phase speeds of tidal components (deg/hour) 463 tide_speed(11) = 29.528479 ! phase speeds of tidal components (deg/hour) 464 tide_speed(12) = 29.958935 ! phase speeds of tidal components (deg/hour) 465 tide_speed(13) = 30.000002 ! phase speeds of tidal components (deg/hour) 466 tide_speed(14) = 30.082138 ! phase speeds of tidal components (deg/hour) 467 tide_speed(15) = 57.968212 ! phase speeds of tidal components (deg/hour) 468 ln_tide_date = .true. ! adjust tidal harmonics for start date of run 469 / 434 470 !!====================================================================== 435 471 !! *** Bottom boundary condition *** … … 450 486 ln_bfr2d = .false. ! horizontal variation of the bottom friction coef (read a 2D mask file ) 451 487 rn_bfrien = 50. ! local multiplying factor of bfr (ln_bfr2d = .true.) 488 ln_bfrimp = .true. ! implicit bottom friction (requires ln_zdfexp = .false. if true) 452 489 / 453 490 !----------------------------------------------------------------------- … … 496 533 ln_traadv_muscl2 = .false. ! MUSCL2 scheme + cen2 at boundaries 497 534 ln_traadv_ubs = .false. ! UBS scheme 498 ln_traadv_qck = .false. ! QU CIKEST scheme535 ln_traadv_qck = .false. ! QUICKEST scheme 499 536 / 500 537 !----------------------------------------------------------------------- … … 508 545 ln_traldf_hor = .false. ! horizontal (geopotential) (require "key_ldfslp" when ln_sco=T) 509 546 ln_traldf_iso = .true. ! iso-neutral (require "key_ldfslp") 510 ln_traldf_grif = .false. ! griffies skew flux formulation (require "key_ldfslp") ! UNDER TEST, DO NOT USE 511 ln_traldf_gdia = .false. ! griffies operator strfn diagnostics (require "key_ldfslp") ! UNDER TEST, DO NOT USE 547 ln_traldf_grif = .false. ! griffies skew flux formulation (require "key_ldfslp") 548 ln_traldf_gdia = .false. ! griffies operator strfn diagnostics (require "key_ldfslp") 549 ln_triad_iso = .false. ! griffies operator calculates triads twice => pure lateral mixing in ML (require "key_ldfslp") 550 ln_botmix_grif = .false. ! griffies operator with lateral mixing on bottom (require "key_ldfslp") 512 551 ! ! Coefficient 513 552 rn_aht_0 = 1000. ! horizontal eddy diffusivity for tracers [m2/s] … … 562 601 ln_hpg_zps = .false. ! z-coordinate - partial steps (interpolation) 563 602 ln_hpg_sco = .false. ! s-coordinate (standard jacobian formulation) 564 ln_hpg_hel = .false. ! s-coordinate (helsinki modification)565 ln_hpg_wdj = .false. ! s-coordinate (weighted density jacobian)566 603 ln_hpg_djc = .false. ! s-coordinate (Density Jacobian with Cubic polynomial) 567 ln_hpg_rot = .false. ! s-coordinate (ROTated axes scheme) 568 rn_gamma = 0.e0 ! weighting coefficient (wdj scheme) 604 ln_hpg_prj = .false. ! s-coordinate (Pressure Jacobian scheme) 569 605 ln_dynhpg_imp = .false. ! time stepping: semi-implicit time scheme (T) 570 606 ! centered time scheme (F) … … 735 771 ! buffer blocking send or immediate non-blocking sends, resp. 736 772 nn_buffer = 0 ! size in bytes of exported buffer ('B' case), 0 no exportation 773 ln_nnogather= .false. ! activate code to avoid mpi_allgather use at the northfold 737 774 jpni = 0 ! jpni number of processors following i (set automatically if < 1) 738 775 jpnj = 0 ! jpnj number of processors following j (set automatically if < 1) … … 926 963 cn_dir_cdg = './' ! root directory for the location of drag coefficient files 927 964 / 965 !----------------------------------------------------------------------- 966 &namdyn_nept ! Neptune effect (simplified: lateral and vertical diffusions removed) 967 !----------------------------------------------------------------------- 968 ! Suggested lengthscale values are those of Eby & Holloway (1994) for a coarse model 969 ln_neptsimp = .false. ! yes/no use simplified neptune 970 971 ln_smooth_neptvel = .false. ! yes/no smooth zunep, zvnep 972 rn_tslse = 1.2e4 ! value of lengthscale L at the equator 973 rn_tslsp = 3.0e3 ! value of lengthscale L at the pole 974 ! Specify whether to ramp down the Neptune velocity in shallow 975 ! water, and if so the depth range controlling such ramping down 976 ln_neptramp = .false. ! ramp down Neptune velocity in shallow water 977 rn_htrmin = 100.0 ! min. depth of transition range 978 rn_htrmax = 200.0 ! max. depth of transition range 979 / -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist
r3104 r3116 3 3 !! namelists 2 - Domain (namzgr, namzgr_sco, namdom, namdta_tem, namdta_sal) 4 4 !! 3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core 5 !! namsbc_cpl, nam sbc_cpl_co2 namtra_qsr, namsbc_rnf,5 !! namsbc_cpl, namtra_qsr, namsbc_rnf, 6 6 !! namsbc_apr, namsbc_ssr, namsbc_alb) 7 7 !! 4 - lateral boundary (namlbc, namcla, namobc, namagrif, nambdy, nambdy_tide) … … 121 121 !! namsbc_core CORE bulk formulea formulation 122 122 !! namsbc_cpl CouPLed formulation ("key_coupled") 123 !! namsbc_cpl_co2 coupled ocean/biogeo/atmosphere model ("key_cpl_carbon_cycle")124 123 !! namtra_qsr penetrative solar radiation 125 124 !! namsbc_rnf river runoffs … … 212 211 &namsbc_cpl ! coupled ocean/atmosphere model ("key_coupled") 213 212 !----------------------------------------------------------------------- 214 ! ! send 215 cn_snd_temperature= 'weighted oce and ice' ! 'oce only' 'weighted oce and ice' 'mixed oce-ice' 216 cn_snd_albedo = 'weighted ice' ! 'none' 'weighted ice' 'mixed oce-ice' 217 cn_snd_thickness = 'none' ! 'none' 'weighted ice and snow' 218 cn_snd_crt_nature = 'none' ! 'none' 'oce only' 'weighted oce and ice' 'mixed oce-ice' 219 cn_snd_crt_refere = 'spherical' ! 'spherical' 'cartesian' 220 cn_snd_crt_orient = 'eastward-northward' ! 'eastward-northward' or 'local grid' 221 cn_snd_crt_grid = 'T' ! 'T' 222 ! ! receive 223 cn_rcv_w10m = 'none' ! 'none' 'coupled' 224 cn_rcv_taumod = 'coupled' ! 'none' 'coupled' 225 cn_rcv_tau_nature = 'oce only' ! 'oce only' 'oce and ice' 'mixed oce-ice' 226 cn_rcv_tau_refere = 'cartesian' ! 'spherical' 'cartesian' 227 cn_rcv_tau_orient = 'eastward-northward' ! 'eastward-northward' or 'local grid' 228 cn_rcv_tau_grid = 'U,V' ! 'T' 'U,V' 'U,V,F' 'U,V,I' 'T,F' 'T,I' 'T,U,V' 229 cn_rcv_dqnsdt = 'coupled' ! 'none' 'coupled' 230 cn_rcv_qsr = 'oce and ice' ! 'conservative' 'oce and ice' 'mixed oce-ice' 231 cn_rcv_qns = 'oce and ice' ! 'conservative' 'oce and ice' 'mixed oce-ice' 232 cn_rcv_emp = 'conservative' ! 'conservative' 'oce and ice' 'mixed oce-ice' 233 cn_rcv_rnf = 'coupled' ! 'coupled' 'climato' 'mixed' 234 cn_rcv_cal = 'coupled' ! 'none' 'coupled' 235 / 236 !----------------------------------------------------------------------- 237 &namsbc_cpl_co2 ! coupled ocean/biogeo/atmosphere model ("key_cpl_carbon_cycle") 238 !----------------------------------------------------------------------- 239 cn_snd_co2 = 'coupled' ! send : 'none' 'coupled' 240 cn_rcv_co2 = 'coupled' ! receive : 'none' 'coupled' 213 ! ! description ! multiple ! vector ! vector ! vector ! 214 ! ! ! categories ! reference ! orientation ! grids ! 215 ! send 216 sn_snd_temp = 'weighted oce and ice' , 'no' , '' , '' , '' 217 sn_snd_alb = 'weighted ice' , 'no' , '' , '' , '' 218 sn_snd_thick = 'none' , 'no' , '' , '' , '' 219 sn_snd_crt = 'none' , 'no' , 'spherical' , 'eastward-northward' , 'T' 220 sn_snd_co2 = 'coupled' , 'no' , '' , '' , '' 221 ! receive 222 sn_rcv_w10m = 'none' , 'no' , '' , '' , '' 223 sn_rcv_taumod = 'coupled' , 'no' , '' , '' , '' 224 sn_rcv_tau = 'oce only' , 'no' , 'cartesian' , 'eastward-northward', 'U,V' 225 sn_rcv_dqnsdt = 'coupled' , 'no' , '' , '' , '' 226 sn_rcv_qsr = 'oce and ice' , 'no' , '' , '' , '' 227 sn_rcv_qns = 'oce and ice' , 'no' , '' , '' , '' 228 sn_rcv_emp = 'conservative' , 'no' , '' , '' , '' 229 sn_rcv_rnf = 'coupled' , 'no' , '' , '' , '' 230 sn_rcv_cal = 'coupled' , 'no' , '' , '' , '' 231 sn_rcv_co2 = 'coupled' , 'no' , '' , '' , '' 241 232 / 242 233 !----------------------------------------------------------------------- … … 369 360 &nambdy ! unstructured open boundaries ("key_bdy") 370 361 !----------------------------------------------------------------------- 371 cn_mask = '' ! name of mask file (ln_mask=T) 372 cn_dta_frs_T= 'bdydata_grid_T.nc' ! name of data file (T-points) 373 cn_dta_frs_U= 'bdydata_grid_U.nc' ! name of data file (U-points) 374 cn_dta_frs_V= 'bdydata_grid_V.nc' ! name of data file (V-points) 375 cn_dta_fla_T= 'bdydata_bt_grid_T.nc' ! name of data file for Flather condition (T-points) 376 cn_dta_fla_U= 'bdydata_bt_grid_U.nc' ! name of data file for Flather condition (U-points) 377 cn_dta_fla_V= 'bdydata_bt_grid_V.nc' ! name of data file for Flather condition (V-points) 378 379 ln_clim = .false. ! contain 1 (T) or 12 (F) time dumps and be cyclic 380 ln_vol = .false. ! total volume correction (see volbdy parameter) 381 ln_mask = .false. ! boundary mask from filbdy_mask (T), boundaries are on edges of domain (F) 382 ln_tides = .false. ! Apply tidal harmonic forcing with Flather condition 383 ln_dyn_fla = .false. ! Apply Flather condition to velocities 384 ln_tra_frs = .false. ! Apply FRS condition to temperature and salinity 385 ln_dyn_frs = .false. ! Apply FRS condition to velocities 386 nn_rimwidth = 9 ! width of the relaxation zone 387 nn_dtactl = 1 ! = 0, bdy data are equal to the initial state 362 nb_bdy = 1 ! number of open boundary sets 363 ln_coords_file = .true. ! =T : read bdy coordinates from file 364 cn_coords_file = 'coordinates.bdy.nc' ! bdy coordinates files 365 ln_mask_file = .false. ! =T : read mask from file 366 cn_mask_file = '' ! name of mask file (if ln_mask_file=.TRUE.) 367 nn_dyn2d = 2 ! boundary conditions for barotropic fields 368 nn_dyn2d_dta = 3 ! = 0, bdy data are equal to the initial state 369 ! = 1, bdy data are read in 'bdydata .nc' files 370 ! = 2, use tidal harmonic forcing data from files 371 ! = 3, use external data AND tidal harmonic forcing 372 nn_dyn3d = 0 ! boundary conditions for baroclinic velocities 373 nn_dyn3d_dta = 0 ! = 0, bdy data are equal to the initial state 388 374 ! = 1, bdy data are read in 'bdydata .nc' files 389 nn_volctl = 0 ! = 0, the total water flux across open boundaries is zero 390 ! = 1, the total volume of the system is conserved 391 / 392 !----------------------------------------------------------------------- 393 &nambdy_tide ! tidal forcing at unstructured boundaries 394 !----------------------------------------------------------------------- 395 filtide = 'bdytide_' ! file name root of tidal forcing files 396 tide_cpt = 'M2','S1' ! names of tidal components used 397 tide_speed = 28.984106, 15.000001 ! phase speeds of tidal components (deg/hour) 398 ln_tide_date= .false. ! adjust tidal harmonics for start date of run 399 / 400 375 nn_tra = 1 ! boundary conditions for T and S 376 nn_tra_dta = 1 ! = 0, bdy data are equal to the initial state 377 ! = 1, bdy data are read in 'bdydata .nc' files 378 nn_rimwidth = 10 ! width of the relaxation zone 379 nn_dmp2d_in = 0 ! 380 nn_dmp2d_out = 0 ! 381 nn_dmp2d_in = 0 ! 382 nn_dmp2d_out = 0 ! 383 ln_vol = .false. ! total volume correction (see nn_volctl parameter) 384 nn_volctl = 1 ! = 0, the total water flux across open boundaries is zero 385 / 386 !----------------------------------------------------------------------- 387 &nambdy_dta ! open boundaries - external data ("key_bdy") 388 !----------------------------------------------------------------------- 389 ! ! file name ! frequency (hours) ! variable ! time interpol. ! clim ! 'yearly'/ ! weights ! rotation ! 390 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! 391 bn_ssh = 'amm12_bdyT_u2d' , 24 , 'sossheig' , .true. , .false. , 'daily' , '' , '' 392 bn_u2d = 'amm12_bdyU_u2d' , 24 , 'vobtcrtx' , .true. , .false. , 'daily' , '' , '' 393 bn_v2d = 'amm12_bdyV_u2d' , 24 , 'vobtcrty' , .true. , .false. , 'daily' , '' , '' 394 bn_u3d = 'amm12_bdyU_u3d' , 24 , 'vozocrtx' , .true. , .false. , 'daily' , '' , '' 395 bn_v3d = 'amm12_bdyV_u3d' , 24 , 'vomecrty' , .true. , .false. , 'daily' , '' , '' 396 bn_tem = 'amm12_bdyT_tra' , 24 , 'votemper' , .true. , .false. , 'daily' , '' , '' 397 bn_sal = 'amm12_bdyT_tra' , 24 , 'vosaline' , .true. , .false. , 'daily' , '' , '' 398 cn_dir = 'bdydta/' 399 ln_full_vel = .false. 400 / 401 !----------------------------------------------------------------------- 402 &nambdy_tide ! tidal forcing at open boundaries 403 !----------------------------------------------------------------------- 404 filtide = 'bdydta/amm12_bdytide_' ! file name root of tidal forcing files 405 tide_cpt(1) ='Q1' ! names of tidal components used 406 tide_cpt(2) ='O1' ! names of tidal components used 407 tide_cpt(3) ='P1' ! names of tidal components used 408 tide_cpt(4) ='S1' ! names of tidal components used 409 tide_cpt(5) ='K1' ! names of tidal components used 410 tide_cpt(6) ='2N2' ! names of tidal components used 411 tide_cpt(7) ='MU2' ! names of tidal components used 412 tide_cpt(8) ='N2' ! names of tidal components used 413 tide_cpt(9) ='NU2' ! names of tidal components used 414 tide_cpt(10) ='M2' ! names of tidal components used 415 tide_cpt(11) ='L2' ! names of tidal components used 416 tide_cpt(12) ='T2' ! names of tidal components used 417 tide_cpt(13) ='S2' ! names of tidal components used 418 tide_cpt(14) ='K2' ! names of tidal components used 419 tide_cpt(15) ='M4' ! names of tidal components used 420 tide_speed(1) = 13.398661 ! phase speeds of tidal components (deg/hour) 421 tide_speed(2) = 13.943036 ! phase speeds of tidal components (deg/hour) 422 tide_speed(3) = 14.958932 ! phase speeds of tidal components (deg/hour) 423 tide_speed(4) = 15.000001 ! phase speeds of tidal components (deg/hour) 424 tide_speed(5) = 15.041069 ! phase speeds of tidal components (deg/hour) 425 tide_speed(6) = 27.895355 ! phase speeds of tidal components (deg/hour) 426 tide_speed(7) = 27.968210 ! phase speeds of tidal components (deg/hour) 427 tide_speed(8) = 28.439730 ! phase speeds of tidal components (deg/hour) 428 tide_speed(9) = 28.512585 ! phase speeds of tidal components (deg/hour) 429 tide_speed(10) = 28.984106 ! phase speeds of tidal components (deg/hour) 430 tide_speed(11) = 29.528479 ! phase speeds of tidal components (deg/hour) 431 tide_speed(12) = 29.958935 ! phase speeds of tidal components (deg/hour) 432 tide_speed(13) = 30.000002 ! phase speeds of tidal components (deg/hour) 433 tide_speed(14) = 30.082138 ! phase speeds of tidal components (deg/hour) 434 tide_speed(15) = 57.968212 ! phase speeds of tidal components (deg/hour) 435 ln_tide_date = .true. ! adjust tidal harmonics for start date of run 436 / 401 437 !!====================================================================== 402 438 !! *** Bottom boundary condition *** … … 417 453 ln_bfr2d = .false. ! horizontal variation of the bottom friction coef (read a 2D mask file ) 418 454 rn_bfrien = 50. ! local multiplying factor of bfr (ln_bfr2d=T) 455 ln_bfrimp = .true. ! implicit bottom friction (requires ln_zdfexp = .false. if true) 419 456 / 420 457 !----------------------------------------------------------------------- … … 528 565 ln_hpg_zps = .true. ! z-coordinate - partial steps (interpolation) 529 566 ln_hpg_sco = .false. ! s-coordinate (standard jacobian formulation) 530 ln_hpg_hel = .false. ! s-coordinate (helsinki modification)531 ln_hpg_wdj = .false. ! s-coordinate (weighted density jacobian)532 567 ln_hpg_djc = .false. ! s-coordinate (Density Jacobian with Cubic polynomial) 533 ln_hpg_rot = .false. ! s-coordinate (ROTated axes scheme) 534 rn_gamma = 0.e0 ! weighting coefficient (wdj scheme) 568 ln_hpg_prj = .false. ! s-coordinate (Pressure Jacobian scheme) 535 569 ln_dynhpg_imp = .false. ! time stepping: semi-implicit time scheme (T) 536 570 ! centered time scheme (F) -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist
r3105 r3116 3 3 !! namelists 2 - Domain (namzgr, namzgr_sco, namdom, namtsd) 4 4 !! 3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core 5 !! namsbc_cpl, nam sbc_cpl_co2 namtra_qsr, namsbc_rnf,5 !! namsbc_cpl, namtra_qsr, namsbc_rnf, 6 6 !! namsbc_apr, namsbc_ssr, namsbc_alb) 7 7 !! 4 - lateral boundary (namlbc, namcla, namobc, namagrif, nambdy, nambdy_tide) … … 114 114 !! namsbc_mfs MFS bulk formulae formulation 115 115 !! namsbc_cpl CouPLed formulation ("key_coupled") 116 !! namsbc_cpl_co2 coupled ocean/biogeo/atmosphere model ("key_cpl_carbon_cycle")117 116 !! namtra_qsr penetrative solar radiation 118 117 !! namsbc_rnf river runoffs … … 222 221 &namsbc_cpl ! coupled ocean/atmosphere model ("key_coupled") 223 222 !----------------------------------------------------------------------- 224 ! ! send 225 cn_snd_temperature= 'weighted oce and ice' ! 'oce only' 'weighted oce and ice' 'mixed oce-ice' 226 cn_snd_albedo = 'weighted ice' ! 'none' 'weighted ice' 'mixed oce-ice' 227 cn_snd_thickness = 'none' ! 'none' 'weighted ice and snow' 228 cn_snd_crt_nature = 'none' ! 'none' 'oce only' 'weighted oce and ice' 'mixed oce-ice' 229 cn_snd_crt_refere = 'spherical' ! 'spherical' 'cartesian' 230 cn_snd_crt_orient = 'eastward-northward' ! 'eastward-northward' or 'local grid' 231 cn_snd_crt_grid = 'T' ! 'T' 232 ! ! receive 233 cn_rcv_w10m = 'none' ! 'none' 'coupled' 234 cn_rcv_taumod = 'coupled' ! 'none' 'coupled' 235 cn_rcv_tau_nature = 'oce only' ! 'oce only' 'oce and ice' 'mixed oce-ice' 236 cn_rcv_tau_refere = 'cartesian' ! 'spherical' 'cartesian' 237 cn_rcv_tau_orient = 'eastward-northward' ! 'eastward-northward' or 'local grid' 238 cn_rcv_tau_grid = 'U,V' ! 'T' 'U,V' 'U,V,F' 'U,V,I' 'T,F' 'T,I' 'T,U,V' 239 cn_rcv_dqnsdt = 'coupled' ! 'none' 'coupled' 240 cn_rcv_qsr = 'oce and ice' ! 'conservative' 'oce and ice' 'mixed oce-ice' 241 cn_rcv_qns = 'oce and ice' ! 'conservative' 'oce and ice' 'mixed oce-ice' 242 cn_rcv_emp = 'conservative' ! 'conservative' 'oce and ice' 'mixed oce-ice' 243 cn_rcv_rnf = 'coupled' ! 'coupled' 'climato' 'mixed' 244 cn_rcv_cal = 'coupled' ! 'none' 'coupled' 245 / 246 !----------------------------------------------------------------------- 247 &namsbc_cpl_co2 ! coupled ocean/biogeo/atmosphere model ("key_cpl_carbon_cycle") 248 !----------------------------------------------------------------------- 249 cn_snd_co2 = 'coupled' ! send : 'none' 'coupled' 250 cn_rcv_co2 = 'coupled' ! receive : 'none' 'coupled' 223 ! ! description ! multiple ! vector ! vector ! vector ! 224 ! ! ! categories ! reference ! orientation ! grids ! 225 ! send 226 sn_snd_temp = 'weighted oce and ice' , 'no' , '' , '' , '' 227 sn_snd_alb = 'weighted ice' , 'no' , '' , '' , '' 228 sn_snd_thick = 'none' , 'no' , '' , '' , '' 229 sn_snd_crt = 'none' , 'no' , 'spherical' , 'eastward-northward' , 'T' 230 sn_snd_co2 = 'coupled' , 'no' , '' , '' , '' 231 ! receive 232 sn_rcv_w10m = 'none' , 'no' , '' , '' , '' 233 sn_rcv_taumod = 'coupled' , 'no' , '' , '' , '' 234 sn_rcv_tau = 'oce only' , 'no' , 'cartesian' , 'eastward-northward', 'U,V' 235 sn_rcv_dqnsdt = 'coupled' , 'no' , '' , '' , '' 236 sn_rcv_qsr = 'oce and ice' , 'no' , '' , '' , '' 237 sn_rcv_qns = 'oce and ice' , 'no' , '' , '' , '' 238 sn_rcv_emp = 'conservative' , 'no' , '' , '' , '' 239 sn_rcv_rnf = 'coupled' , 'no' , '' , '' , '' 240 sn_rcv_cal = 'coupled' , 'no' , '' , '' , '' 241 sn_rcv_co2 = 'coupled' , 'no' , '' , '' , '' 251 242 / 252 243 !----------------------------------------------------------------------- … … 397 388 &nambdy ! unstructured open boundaries ("key_bdy") 398 389 !----------------------------------------------------------------------- 399 cn_mask = '' ! name of mask file (ln_mask=T) 400 cn_dta_frs_T= 'bdydata_grid_T.nc' ! name of data file (T-points) 401 cn_dta_frs_U= 'bdydata_grid_U.nc' ! name of data file (U-points) 402 cn_dta_frs_V= 'bdydata_grid_V.nc' ! name of data file (V-points) 403 cn_dta_fla_T= 'bdydata_bt_grid_T.nc' ! name of data file for Flather condition (T-points) 404 cn_dta_fla_U= 'bdydata_bt_grid_U.nc' ! name of data file for Flather condition (U-points) 405 cn_dta_fla_V= 'bdydata_bt_grid_V.nc' ! name of data file for Flather condition (V-points) 406 407 ln_clim = .false. ! contain 1 (T) or 12 (F) time dumps and be cyclic 408 ln_vol = .false. ! total volume correction (see volbdy parameter) 409 ln_mask = .false. ! boundary mask from filbdy_mask (T), boundaries are on edges of domain (F) 410 ln_tides = .false. ! Apply tidal harmonic forcing with Flather condition 411 ln_dyn_fla = .false. ! Apply Flather condition to velocities 412 ln_tra_frs = .false. ! Apply FRS condition to temperature and salinity 413 ln_dyn_frs = .false. ! Apply FRS condition to velocities 414 nn_rimwidth = 9 ! width of the relaxation zone 415 nn_dtactl = 1 ! = 0, bdy data are equal to the initial state 390 nb_bdy = 1 ! number of open boundary sets 391 ln_coords_file = .true. ! =T : read bdy coordinates from file 392 cn_coords_file = 'coordinates.bdy.nc' ! bdy coordinates files 393 ln_mask_file = .false. ! =T : read mask from file 394 cn_mask_file = '' ! name of mask file (if ln_mask_file=.TRUE.) 395 nn_dyn2d = 2 ! boundary conditions for barotropic fields 396 nn_dyn2d_dta = 3 ! = 0, bdy data are equal to the initial state 397 ! = 1, bdy data are read in 'bdydata .nc' files 398 ! = 2, use tidal harmonic forcing data from files 399 ! = 3, use external data AND tidal harmonic forcing 400 nn_dyn3d = 0 ! boundary conditions for baroclinic velocities 401 nn_dyn3d_dta = 0 ! = 0, bdy data are equal to the initial state 416 402 ! = 1, bdy data are read in 'bdydata .nc' files 417 nn_volctl = 0 ! = 0, the total water flux across open boundaries is zero 418 ! = 1, the total volume of the system is conserved 419 / 420 !----------------------------------------------------------------------- 421 &nambdy_tide ! tidal forcing at unstructured boundaries 422 !----------------------------------------------------------------------- 423 filtide = 'bdytide_' ! file name root of tidal forcing files 424 tide_cpt = 'M2','S1' ! names of tidal components used 425 tide_speed = 28.984106, 15.000001 ! phase speeds of tidal components (deg/hour) 426 ln_tide_date= .false. ! adjust tidal harmonics for start date of run 427 / 428 403 nn_tra = 1 ! boundary conditions for T and S 404 nn_tra_dta = 1 ! = 0, bdy data are equal to the initial state 405 ! = 1, bdy data are read in 'bdydata .nc' files 406 nn_rimwidth = 10 ! width of the relaxation zone 407 nn_dmp2d_in = 0 ! 408 nn_dmp2d_out = 0 ! 409 nn_dmp2d_in = 0 ! 410 nn_dmp2d_out = 0 ! 411 ln_vol = .false. ! total volume correction (see nn_volctl parameter) 412 nn_volctl = 1 ! = 0, the total water flux across open boundaries is zero 413 / 414 !----------------------------------------------------------------------- 415 &nambdy_dta ! open boundaries - external data ("key_bdy") 416 !----------------------------------------------------------------------- 417 ! ! file name ! frequency (hours) ! variable ! time interpol. ! clim ! 'yearly'/ ! weights ! rotation ! 418 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! 419 bn_ssh = 'amm12_bdyT_u2d' , 24 , 'sossheig' , .true. , .false. , 'daily' , '' , '' 420 bn_u2d = 'amm12_bdyU_u2d' , 24 , 'vobtcrtx' , .true. , .false. , 'daily' , '' , '' 421 bn_v2d = 'amm12_bdyV_u2d' , 24 , 'vobtcrty' , .true. , .false. , 'daily' , '' , '' 422 bn_u3d = 'amm12_bdyU_u3d' , 24 , 'vozocrtx' , .true. , .false. , 'daily' , '' , '' 423 bn_v3d = 'amm12_bdyV_u3d' , 24 , 'vomecrty' , .true. , .false. , 'daily' , '' , '' 424 bn_tem = 'amm12_bdyT_tra' , 24 , 'votemper' , .true. , .false. , 'daily' , '' , '' 425 bn_sal = 'amm12_bdyT_tra' , 24 , 'vosaline' , .true. , .false. , 'daily' , '' , '' 426 cn_dir = 'bdydta/' 427 ln_full_vel = .false. 428 / 429 !----------------------------------------------------------------------- 430 &nambdy_tide ! tidal forcing at open boundaries 431 !----------------------------------------------------------------------- 432 filtide = 'bdydta/amm12_bdytide_' ! file name root of tidal forcing files 433 tide_cpt(1) ='Q1' ! names of tidal components used 434 tide_cpt(2) ='O1' ! names of tidal components used 435 tide_cpt(3) ='P1' ! names of tidal components used 436 tide_cpt(4) ='S1' ! names of tidal components used 437 tide_cpt(5) ='K1' ! names of tidal components used 438 tide_cpt(6) ='2N2' ! names of tidal components used 439 tide_cpt(7) ='MU2' ! names of tidal components used 440 tide_cpt(8) ='N2' ! names of tidal components used 441 tide_cpt(9) ='NU2' ! names of tidal components used 442 tide_cpt(10) ='M2' ! names of tidal components used 443 tide_cpt(11) ='L2' ! names of tidal components used 444 tide_cpt(12) ='T2' ! names of tidal components used 445 tide_cpt(13) ='S2' ! names of tidal components used 446 tide_cpt(14) ='K2' ! names of tidal components used 447 tide_cpt(15) ='M4' ! names of tidal components used 448 tide_speed(1) = 13.398661 ! phase speeds of tidal components (deg/hour) 449 tide_speed(2) = 13.943036 ! phase speeds of tidal components (deg/hour) 450 tide_speed(3) = 14.958932 ! phase speeds of tidal components (deg/hour) 451 tide_speed(4) = 15.000001 ! phase speeds of tidal components (deg/hour) 452 tide_speed(5) = 15.041069 ! phase speeds of tidal components (deg/hour) 453 tide_speed(6) = 27.895355 ! phase speeds of tidal components (deg/hour) 454 tide_speed(7) = 27.968210 ! phase speeds of tidal components (deg/hour) 455 tide_speed(8) = 28.439730 ! phase speeds of tidal components (deg/hour) 456 tide_speed(9) = 28.512585 ! phase speeds of tidal components (deg/hour) 457 tide_speed(10) = 28.984106 ! phase speeds of tidal components (deg/hour) 458 tide_speed(11) = 29.528479 ! phase speeds of tidal components (deg/hour) 459 tide_speed(12) = 29.958935 ! phase speeds of tidal components (deg/hour) 460 tide_speed(13) = 30.000002 ! phase speeds of tidal components (deg/hour) 461 tide_speed(14) = 30.082138 ! phase speeds of tidal components (deg/hour) 462 tide_speed(15) = 57.968212 ! phase speeds of tidal components (deg/hour) 463 ln_tide_date = .true. ! adjust tidal harmonics for start date of run 464 / 429 465 !!====================================================================== 430 466 !! *** Bottom boundary condition *** … … 445 481 ln_bfr2d = .false. ! horizontal variation of the bottom friction coef (read a 2D mask file ) 446 482 rn_bfrien = 50. ! local multiplying factor of bfr (ln_bfr2d=T) 483 ln_bfrimp = .true. ! implicit bottom friction (requires ln_zdfexp = .false. if true) 447 484 / 448 485 !----------------------------------------------------------------------- … … 491 528 ln_traadv_muscl2 = .false. ! MUSCL2 scheme + cen2 at boundaries 492 529 ln_traadv_ubs = .false. ! UBS scheme 493 ln_traadv_qck = .false. ! QU CIKEST scheme530 ln_traadv_qck = .false. ! QUICKEST scheme 494 531 / 495 532 !----------------------------------------------------------------------- … … 503 540 ln_traldf_hor = .false. ! horizontal (geopotential) (require "key_ldfslp" when ln_sco=T) 504 541 ln_traldf_iso = .true. ! iso-neutral (require "key_ldfslp") 505 ln_traldf_grif = .false. ! griffies skew flux formulation (require "key_ldfslp") ! UNDER TEST, DO NOT USE 506 ln_traldf_gdia = .false. ! griffies operator strfn diagnostics (require "key_ldfslp") ! UNDER TEST, DO NOT USE 507 ! ! Coefficient 542 ln_traldf_grif = .false. ! griffies skew flux formulation (require "key_ldfslp") 543 ln_traldf_gdia = .false. ! griffies operator strfn diagnostics (require "key_ldfslp") 544 ln_triad_iso = .false. ! griffies operator calculates triads twice => pure lateral mixing in ML (require "key_ldfslp") 545 ln_botmix_grif = .false. ! griffies operator with lateral mixing on bottom (require "key_ldfslp") 546 ! Coefficient 508 547 rn_aht_0 = 2000. ! horizontal eddy diffusivity for tracers [m2/s] 509 548 rn_ahtb_0 = 0. ! background eddy diffusivity for ldf_iso [m2/s] … … 557 596 ln_hpg_zps = .true. ! z-coordinate - partial steps (interpolation) 558 597 ln_hpg_sco = .false. ! s-coordinate (standard jacobian formulation) 559 ln_hpg_hel = .false. ! s-coordinate (helsinki modification)560 ln_hpg_wdj = .false. ! s-coordinate (weighted density jacobian)561 598 ln_hpg_djc = .false. ! s-coordinate (Density Jacobian with Cubic polynomial) 562 ln_hpg_rot = .false. ! s-coordinate (ROTated axes scheme) 563 rn_gamma = 0.e0 ! weighting coefficient (wdj scheme) 599 ln_hpg_prj = .false. ! s-coordinate (Pressure Jacobian scheme) 564 600 ln_dynhpg_imp = .false. ! time stepping: semi-implicit time scheme (T) 565 601 ! centered time scheme (F) … … 730 766 ! buffer blocking send or immediate non-blocking sends, resp. 731 767 nn_buffer = 0 ! size in bytes of exported buffer ('B' case), 0 no exportation 768 ln_nnogather= .false. ! activate code to avoid mpi_allgather use at the northfold 732 769 jpni = 0 ! jpni number of processors following i (set automatically if < 1) 733 770 jpnj = 0 ! jpnj number of processors following j (set automatically if < 1) … … 931 968 cn_dir_cdg = './' ! root directory for the location of drag coefficient files 932 969 / 970 !----------------------------------------------------------------------- 971 &namdyn_nept ! Neptune effect (simplified: lateral and vertical diffusions removed) 972 !----------------------------------------------------------------------- 973 ! Suggested lengthscale values are those of Eby & Holloway (1994) for a coarse model 974 ln_neptsimp = .false. ! yes/no use simplified neptune 975 976 ln_smooth_neptvel = .false. ! yes/no smooth zunep, zvnep 977 rn_tslse = 1.2e4 ! value of lengthscale L at the equator 978 rn_tslsp = 3.0e3 ! value of lengthscale L at the pole 979 ! Specify whether to ramp down the Neptune velocity in shallow 980 ! water, and if so the depth range controlling such ramping down 981 ln_neptramp = .true. ! ramp down Neptune velocity in shallow water 982 rn_htrmin = 100.0 ! min. depth of transition range 983 rn_htrmax = 200.0 ! max. depth of transition range 984 / 985 >>>>>>> .merge-right.r3114 -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist
r3105 r3116 3 3 !! namelists 2 - Domain (namzgr, namzgr_sco, namdom, namtsd) 4 4 !! 3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core 5 !! namsbc_cpl, nam sbc_cpl_co2 namtra_qsr, namsbc_rnf,5 !! namsbc_cpl, namtra_qsr, namsbc_rnf, 6 6 !! namsbc_apr, namsbc_ssr, namsbc_alb) 7 7 !! 4 - lateral boundary (namlbc, namcla, namobc, namagrif, nambdy, nambdy_tide) … … 114 114 !! namsbc_mfs MFS bulk formulae formulation 115 115 !! namsbc_cpl CouPLed formulation ("key_coupled") 116 !! namsbc_cpl_co2 coupled ocean/biogeo/atmosphere model ("key_cpl_carbon_cycle")117 116 !! namtra_qsr penetrative solar radiation 118 117 !! namsbc_rnf river runoffs … … 222 221 &namsbc_cpl ! coupled ocean/atmosphere model ("key_coupled") 223 222 !----------------------------------------------------------------------- 224 ! ! send 225 cn_snd_temperature= 'weighted oce and ice' ! 'oce only' 'weighted oce and ice' 'mixed oce-ice' 226 cn_snd_albedo = 'weighted ice' ! 'none' 'weighted ice' 'mixed oce-ice' 227 cn_snd_thickness = 'none' ! 'none' 'weighted ice and snow' 228 cn_snd_crt_nature = 'none' ! 'none' 'oce only' 'weighted oce and ice' 'mixed oce-ice' 229 cn_snd_crt_refere = 'spherical' ! 'spherical' 'cartesian' 230 cn_snd_crt_orient = 'eastward-northward' ! 'eastward-northward' or 'local grid' 231 cn_snd_crt_grid = 'T' ! 'T' 232 ! ! receive 233 cn_rcv_w10m = 'none' ! 'none' 'coupled' 234 cn_rcv_taumod = 'coupled' ! 'none' 'coupled' 235 cn_rcv_tau_nature = 'oce only' ! 'oce only' 'oce and ice' 'mixed oce-ice' 236 cn_rcv_tau_refere = 'cartesian' ! 'spherical' 'cartesian' 237 cn_rcv_tau_orient = 'eastward-northward' ! 'eastward-northward' or 'local grid' 238 cn_rcv_tau_grid = 'U,V' ! 'T' 'U,V' 'U,V,F' 'U,V,I' 'T,F' 'T,I' 'T,U,V' 239 cn_rcv_dqnsdt = 'coupled' ! 'none' 'coupled' 240 cn_rcv_qsr = 'oce and ice' ! 'conservative' 'oce and ice' 'mixed oce-ice' 241 cn_rcv_qns = 'oce and ice' ! 'conservative' 'oce and ice' 'mixed oce-ice' 242 cn_rcv_emp = 'conservative' ! 'conservative' 'oce and ice' 'mixed oce-ice' 243 cn_rcv_rnf = 'coupled' ! 'coupled' 'climato' 'mixed' 244 cn_rcv_cal = 'coupled' ! 'none' 'coupled' 245 / 246 !----------------------------------------------------------------------- 247 &namsbc_cpl_co2 ! coupled ocean/biogeo/atmosphere model ("key_cpl_carbon_cycle") 248 !----------------------------------------------------------------------- 249 cn_snd_co2 = 'coupled' ! send : 'none' 'coupled' 250 cn_rcv_co2 = 'coupled' ! receive : 'none' 'coupled' 251 / 252 !----------------------------------------------------------------------- 223 ! ! description ! multiple ! vector ! vector ! vector ! 224 ! ! ! categories ! reference ! orientation ! grids ! 225 ! send 226 sn_snd_temp = 'weighted oce and ice' , 'no' , '' , '' , '' 227 sn_snd_alb = 'weighted ice' , 'no' , '' , '' , '' 228 sn_snd_thick = 'none' , 'no' , '' , '' , '' 229 sn_snd_crt = 'none' , 'no' , 'spherical' , 'eastward-northward' , 'T' 230 sn_snd_co2 = 'coupled' , 'no' , '' , '' , '' 231 ! receive 232 sn_rcv_w10m = 'none' , 'no' , '' , '' , '' 233 sn_rcv_taumod = 'coupled' , 'no' , '' , '' , '' 234 sn_rcv_tau = 'oce only' , 'no' , 'cartesian' , 'eastward-northward', 'U,V' 235 sn_rcv_dqnsdt = 'coupled' , 'no' , '' , '' , '' 236 sn_rcv_qsr = 'oce and ice' , 'no' , '' , '' , '' 237 sn_rcv_qns = 'oce and ice' , 'no' , '' , '' , '' 238 sn_rcv_emp = 'conservative' , 'no' , '' , '' , '' 239 sn_rcv_rnf = 'coupled' , 'no' , '' , '' , '' 240 sn_rcv_cal = 'coupled' , 'no' , '' , '' , '' 241 sn_rcv_co2 = 'coupled' , 'no' , '' , '' , '' 242 / 253 243 &namtra_qsr ! penetrative solar radiation 254 244 !----------------------------------------------------------------------- … … 380 370 &nambdy ! unstructured open boundaries ("key_bdy") 381 371 !----------------------------------------------------------------------- 382 cn_mask = '' ! name of mask file (ln_mask=T) 383 cn_dta_frs_T= 'bdydata_grid_T.nc' ! name of data file (T-points) 384 cn_dta_frs_U= 'bdydata_grid_U.nc' ! name of data file (U-points) 385 cn_dta_frs_V= 'bdydata_grid_V.nc' ! name of data file (V-points) 386 cn_dta_fla_T= 'bdydata_bt_grid_T.nc' ! name of data file for Flather condition (T-points) 387 cn_dta_fla_U= 'bdydata_bt_grid_U.nc' ! name of data file for Flather condition (U-points) 388 cn_dta_fla_V= 'bdydata_bt_grid_V.nc' ! name of data file for Flather condition (V-points) 389 390 ln_clim = .false. ! contain 1 (T) or 12 (F) time dumps and be cyclic 391 ln_vol = .false. ! total volume correction (see volbdy parameter) 392 ln_mask = .false. ! boundary mask from filbdy_mask (T), boundaries are on edges of domain (F) 393 ln_tides = .false. ! Apply tidal harmonic forcing with Flather condition 394 ln_dyn_fla = .false. ! Apply Flather condition to velocities 395 ln_tra_frs = .false. ! Apply FRS condition to temperature and salinity 396 ln_dyn_frs = .false. ! Apply FRS condition to velocities 397 nn_rimwidth = 9 ! width of the relaxation zone 398 nn_dtactl = 1 ! = 0, bdy data are equal to the initial state 372 nb_bdy = 1 ! number of open boundary sets 373 ln_coords_file = .true. ! =T : read bdy coordinates from file 374 cn_coords_file = 'coordinates.bdy.nc' ! bdy coordinates files 375 ln_mask_file = .false. ! =T : read mask from file 376 cn_mask_file = '' ! name of mask file (if ln_mask_file=.TRUE.) 377 nn_dyn2d = 2 ! boundary conditions for barotropic fields 378 nn_dyn2d_dta = 3 ! = 0, bdy data are equal to the initial state 379 ! = 1, bdy data are read in 'bdydata .nc' files 380 ! = 2, use tidal harmonic forcing data from files 381 ! = 3, use external data AND tidal harmonic forcing 382 nn_dyn3d = 0 ! boundary conditions for baroclinic velocities 383 nn_dyn3d_dta = 0 ! = 0, bdy data are equal to the initial state 399 384 ! = 1, bdy data are read in 'bdydata .nc' files 400 nn_volctl = 0 ! = 0, the total water flux across open boundaries is zero 401 ! = 1, the total volume of the system is conserved 402 / 403 !----------------------------------------------------------------------- 404 &nambdy_tide ! tidal forcing at unstructured boundaries 405 !----------------------------------------------------------------------- 406 filtide = 'bdytide_' ! file name root of tidal forcing files 407 tide_cpt = 'M2','S1' ! names of tidal components used 408 tide_speed = 28.984106, 15.000001 ! phase speeds of tidal components (deg/hour) 409 ln_tide_date= .false. ! adjust tidal harmonics for start date of run 410 / 411 385 nn_tra = 1 ! boundary conditions for T and S 386 nn_tra_dta = 1 ! = 0, bdy data are equal to the initial state 387 ! = 1, bdy data are read in 'bdydata .nc' files 388 nn_rimwidth = 10 ! width of the relaxation zone 389 nn_dmp2d_in = 0 ! 390 nn_dmp2d_out = 0 ! 391 nn_dmp2d_in = 0 ! 392 nn_dmp2d_out = 0 ! 393 ln_vol = .false. ! total volume correction (see nn_volctl parameter) 394 nn_volctl = 1 ! = 0, the total water flux across open boundaries is zero 395 / 396 !----------------------------------------------------------------------- 397 &nambdy_dta ! open boundaries - external data ("key_bdy") 398 !----------------------------------------------------------------------- 399 ! ! file name ! frequency (hours) ! variable ! time interpol. ! clim ! 'yearly'/ ! weights ! rotation ! 400 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! 401 bn_ssh = 'amm12_bdyT_u2d' , 24 , 'sossheig' , .true. , .false. , 'daily' , '' , '' 402 bn_u2d = 'amm12_bdyU_u2d' , 24 , 'vobtcrtx' , .true. , .false. , 'daily' , '' , '' 403 bn_v2d = 'amm12_bdyV_u2d' , 24 , 'vobtcrty' , .true. , .false. , 'daily' , '' , '' 404 bn_u3d = 'amm12_bdyU_u3d' , 24 , 'vozocrtx' , .true. , .false. , 'daily' , '' , '' 405 bn_v3d = 'amm12_bdyV_u3d' , 24 , 'vomecrty' , .true. , .false. , 'daily' , '' , '' 406 bn_tem = 'amm12_bdyT_tra' , 24 , 'votemper' , .true. , .false. , 'daily' , '' , '' 407 bn_sal = 'amm12_bdyT_tra' , 24 , 'vosaline' , .true. , .false. , 'daily' , '' , '' 408 cn_dir = 'bdydta/' 409 ln_full_vel = .false. 410 / 411 !----------------------------------------------------------------------- 412 &nambdy_tide ! tidal forcing at open boundaries 413 !----------------------------------------------------------------------- 414 filtide = 'bdydta/amm12_bdytide_' ! file name root of tidal forcing files 415 tide_cpt(1) ='Q1' ! names of tidal components used 416 tide_cpt(2) ='O1' ! names of tidal components used 417 tide_cpt(3) ='P1' ! names of tidal components used 418 tide_cpt(4) ='S1' ! names of tidal components used 419 tide_cpt(5) ='K1' ! names of tidal components used 420 tide_cpt(6) ='2N2' ! names of tidal components used 421 tide_cpt(7) ='MU2' ! names of tidal components used 422 tide_cpt(8) ='N2' ! names of tidal components used 423 tide_cpt(9) ='NU2' ! names of tidal components used 424 tide_cpt(10) ='M2' ! names of tidal components used 425 tide_cpt(11) ='L2' ! names of tidal components used 426 tide_cpt(12) ='T2' ! names of tidal components used 427 tide_cpt(13) ='S2' ! names of tidal components used 428 tide_cpt(14) ='K2' ! names of tidal components used 429 tide_cpt(15) ='M4' ! names of tidal components used 430 tide_speed(1) = 13.398661 ! phase speeds of tidal components (deg/hour) 431 tide_speed(2) = 13.943036 ! phase speeds of tidal components (deg/hour) 432 tide_speed(3) = 14.958932 ! phase speeds of tidal components (deg/hour) 433 tide_speed(4) = 15.000001 ! phase speeds of tidal components (deg/hour) 434 tide_speed(5) = 15.041069 ! phase speeds of tidal components (deg/hour) 435 tide_speed(6) = 27.895355 ! phase speeds of tidal components (deg/hour) 436 tide_speed(7) = 27.968210 ! phase speeds of tidal components (deg/hour) 437 tide_speed(8) = 28.439730 ! phase speeds of tidal components (deg/hour) 438 tide_speed(9) = 28.512585 ! phase speeds of tidal components (deg/hour) 439 tide_speed(10) = 28.984106 ! phase speeds of tidal components (deg/hour) 440 tide_speed(11) = 29.528479 ! phase speeds of tidal components (deg/hour) 441 tide_speed(12) = 29.958935 ! phase speeds of tidal components (deg/hour) 442 tide_speed(13) = 30.000002 ! phase speeds of tidal components (deg/hour) 443 tide_speed(14) = 30.082138 ! phase speeds of tidal components (deg/hour) 444 tide_speed(15) = 57.968212 ! phase speeds of tidal components (deg/hour) 445 ln_tide_date = .true. ! adjust tidal harmonics for start date of run 446 / 412 447 !!====================================================================== 413 448 !! *** Bottom boundary condition *** … … 428 463 ln_bfr2d = .false. ! horizontal variation of the bottom friction coef (read a 2D mask file ) 429 464 rn_bfrien = 50. ! local multiplying factor of bfr (ln_bfr2d=T) 465 ln_bfrimp = .true. ! implicit bottom friction (requires ln_zdfexp = .false. if true) 430 466 / 431 467 !----------------------------------------------------------------------- … … 474 510 ln_traadv_muscl2 = .false. ! MUSCL2 scheme + cen2 at boundaries 475 511 ln_traadv_ubs = .false. ! UBS scheme 476 ln_traadv_qck = .false. ! QU CIKEST scheme512 ln_traadv_qck = .false. ! QUICKEST scheme 477 513 / 478 514 !----------------------------------------------------------------------- … … 486 522 ln_traldf_hor = .false. ! horizontal (geopotential) (require "key_ldfslp" when ln_sco=T) 487 523 ln_traldf_iso = .true. ! iso-neutral (require "key_ldfslp") 488 ln_traldf_grif = .false. ! griffies skew flux formulation (require "key_ldfslp") ! UNDER TEST, DO NOT USE 489 ln_traldf_gdia = .false. ! griffies operator strfn diagnostics (require "key_ldfslp") ! UNDER TEST, DO NOT USE 490 ! ! Coefficient 524 ln_traldf_grif = .false. ! griffies skew flux formulation (require "key_ldfslp") 525 ln_traldf_gdia = .false. ! griffies operator strfn diagnostics (require "key_ldfslp") 526 ln_triad_iso = .false. ! griffies operator calculates triads twice => pure lateral mixing in ML (require "key_ldfslp") 527 ln_botmix_grif = .false. ! griffies operator with lateral mixing on bottom (require "key_ldfslp") 528 ! Coefficient 491 529 rn_aht_0 = 2000. ! horizontal eddy diffusivity for tracers [m2/s] 492 530 rn_ahtb_0 = 0. ! background eddy diffusivity for ldf_iso [m2/s] … … 540 578 ln_hpg_zps = .true. ! z-coordinate - partial steps (interpolation) 541 579 ln_hpg_sco = .false. ! s-coordinate (standard jacobian formulation) 542 ln_hpg_hel = .false. ! s-coordinate (helsinki modification)543 ln_hpg_wdj = .false. ! s-coordinate (weighted density jacobian)544 580 ln_hpg_djc = .false. ! s-coordinate (Density Jacobian with Cubic polynomial) 545 ln_hpg_rot = .false. ! s-coordinate (ROTated axes scheme) 546 rn_gamma = 0.e0 ! weighting coefficient (wdj scheme) 581 ln_hpg_prj = .false. ! s-coordinate (Pressure Jacobian scheme) 547 582 ln_dynhpg_imp = .false. ! time stepping: semi-implicit time scheme (T) 548 583 ! centered time scheme (F) … … 737 772 ! buffer blocking send or immediate non-blocking sends, resp. 738 773 nn_buffer = 0 ! size in bytes of exported buffer ('B' case), 0 no exportation 774 ln_nnogather= .false. ! activate code to avoid mpi_allgather use at the northfold 739 775 jpni = 0 ! jpni number of processors following i (set automatically if < 1) 740 776 jpnj = 0 ! jpnj number of processors following j (set automatically if < 1) … … 928 964 cn_dir_cdg = './' ! root directory for the location of drag coefficient files 929 965 / 966 !----------------------------------------------------------------------- 967 &namdyn_nept ! Neptune effect (simplified: lateral and vertical diffusions removed) 968 !----------------------------------------------------------------------- 969 ! Suggested lengthscale values are those of Eby & Holloway (1994) for a coarse model 970 ln_neptsimp = .false. ! yes/no use simplified neptune 971 972 ln_smooth_neptvel = .false. ! yes/no smooth zunep, zvnep 973 rn_tslse = 1.2e4 ! value of lengthscale L at the equator 974 rn_tslsp = 3.0e3 ! value of lengthscale L at the pole 975 ! Specify whether to ramp down the Neptune velocity in shallow 976 ! water, and if so the depth range controlling such ramping down 977 ln_neptramp = .false. ! ramp down Neptune velocity in shallow water 978 rn_htrmin = 100.0 ! min. depth of transition range 979 rn_htrmax = 200.0 ! max. depth of transition range 980 / 981 >>>>>>> .merge-right.r3114 -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/CONFIG/POMME/EXP00/namelist
r3105 r3116 3 3 !! namelists 2 - Domain (namzgr, namzgr_sco, namdom, namtsd) 4 4 !! 3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core 5 !! namsbc_cpl, nam sbc_cpl_co2 namtra_qsr, namsbc_rnf,5 !! namsbc_cpl, namtra_qsr, namsbc_rnf, 6 6 !! namsbc_apr, namsbc_ssr, namsbc_alb) 7 7 !! 4 - lateral boundary (namlbc, namcla, namobc, namagrif, nambdy, nambdy_tide) … … 114 114 !! namsbc_mfs MFS bulk formulae formulation 115 115 !! namsbc_cpl CouPLed formulation ("key_coupled") 116 !! namsbc_cpl_co2 coupled ocean/biogeo/atmosphere model ("key_cpl_carbon_cycle")117 116 !! namtra_qsr penetrative solar radiation 118 117 !! namsbc_rnf river runoffs … … 222 221 &namsbc_cpl ! coupled ocean/atmosphere model ("key_coupled") 223 222 !----------------------------------------------------------------------- 224 ! ! send 225 cn_snd_temperature= 'weighted oce and ice' ! 'oce only' 'weighted oce and ice' 'mixed oce-ice' 226 cn_snd_albedo = 'weighted ice' ! 'none' 'weighted ice' 'mixed oce-ice' 227 cn_snd_thickness = 'none' ! 'none' 'weighted ice and snow' 228 cn_snd_crt_nature = 'none' ! 'none' 'oce only' 'weighted oce and ice' 'mixed oce-ice' 229 cn_snd_crt_refere = 'spherical' ! 'spherical' 'cartesian' 230 cn_snd_crt_orient = 'eastward-northward' ! 'eastward-northward' or 'local grid' 231 cn_snd_crt_grid = 'T' ! 'T' 232 ! ! receive 233 cn_rcv_w10m = 'none' ! 'none' 'coupled' 234 cn_rcv_taumod = 'coupled' ! 'none' 'coupled' 235 cn_rcv_tau_nature = 'oce only' ! 'oce only' 'oce and ice' 'mixed oce-ice' 236 cn_rcv_tau_refere = 'cartesian' ! 'spherical' 'cartesian' 237 cn_rcv_tau_orient = 'eastward-northward' ! 'eastward-northward' or 'local grid' 238 cn_rcv_tau_grid = 'U,V' ! 'T' 'U,V' 'U,V,F' 'U,V,I' 'T,F' 'T,I' 'T,U,V' 239 cn_rcv_dqnsdt = 'coupled' ! 'none' 'coupled' 240 cn_rcv_qsr = 'oce and ice' ! 'conservative' 'oce and ice' 'mixed oce-ice' 241 cn_rcv_qns = 'oce and ice' ! 'conservative' 'oce and ice' 'mixed oce-ice' 242 cn_rcv_emp = 'conservative' ! 'conservative' 'oce and ice' 'mixed oce-ice' 243 cn_rcv_rnf = 'coupled' ! 'coupled' 'climato' 'mixed' 244 cn_rcv_cal = 'coupled' ! 'none' 'coupled' 245 / 246 !----------------------------------------------------------------------- 247 &namsbc_cpl_co2 ! coupled ocean/biogeo/atmosphere model ("key_cpl_carbon_cycle") 248 !----------------------------------------------------------------------- 249 cn_snd_co2 = 'coupled' ! send : 'none' 'coupled' 250 cn_rcv_co2 = 'coupled' ! receive : 'none' 'coupled' 223 ! ! description ! multiple ! vector ! vector ! vector ! 224 ! ! ! categories ! reference ! orientation ! grids ! 225 ! send 226 sn_snd_temp = 'weighted oce and ice' , 'no' , '' , '' , '' 227 sn_snd_alb = 'weighted ice' , 'no' , '' , '' , '' 228 sn_snd_thick = 'none' , 'no' , '' , '' , '' 229 sn_snd_crt = 'none' , 'no' , 'spherical' , 'eastward-northward' , 'T' 230 sn_snd_co2 = 'coupled' , 'no' , '' , '' , '' 231 ! receive 232 sn_rcv_w10m = 'none' , 'no' , '' , '' , '' 233 sn_rcv_taumod = 'coupled' , 'no' , '' , '' , '' 234 sn_rcv_tau = 'oce only' , 'no' , 'cartesian' , 'eastward-northward', 'U,V' 235 sn_rcv_dqnsdt = 'coupled' , 'no' , '' , '' , '' 236 sn_rcv_qsr = 'oce and ice' , 'no' , '' , '' , '' 237 sn_rcv_qns = 'oce and ice' , 'no' , '' , '' , '' 238 sn_rcv_emp = 'conservative' , 'no' , '' , '' , '' 239 sn_rcv_rnf = 'coupled' , 'no' , '' , '' , '' 240 sn_rcv_cal = 'coupled' , 'no' , '' , '' , '' 241 sn_rcv_co2 = 'coupled' , 'no' , '' , '' , '' 251 242 / 252 243 !----------------------------------------------------------------------- … … 402 393 &nambdy ! unstructured open boundaries ("key_bdy") 403 394 !----------------------------------------------------------------------- 404 cn_mask = '' ! name of mask file (ln_mask=T) 405 cn_dta_frs_T= 'bdydata_grid_T.nc' ! name of data file (T-points) 406 cn_dta_frs_U= 'bdydata_grid_U.nc' ! name of data file (U-points) 407 cn_dta_frs_V= 'bdydata_grid_V.nc' ! name of data file (V-points) 408 cn_dta_fla_T= 'bdydata_bt_grid_T.nc' ! name of data file for Flather condition (T-points) 409 cn_dta_fla_U= 'bdydata_bt_grid_U.nc' ! name of data file for Flather condition (U-points) 410 cn_dta_fla_V= 'bdydata_bt_grid_V.nc' ! name of data file for Flather condition (V-points) 411 412 ln_clim = .false. ! contain 1 (T) or 12 (F) time dumps and be cyclic 413 ln_vol = .false. ! total volume correction (see volbdy parameter) 414 ln_mask = .false. ! boundary mask from filbdy_mask (T), boundaries are on edges of domain (F) 415 ln_tides = .false. ! Apply tidal harmonic forcing with Flather condition 416 ln_dyn_fla = .false. ! Apply Flather condition to velocities 417 ln_tra_frs = .false. ! Apply FRS condition to temperature and salinity 418 ln_dyn_frs = .false. ! Apply FRS condition to velocities 419 nn_rimwidth = 9 ! width of the relaxation zone 420 nn_dtactl = 1 ! = 0, bdy data are equal to the initial state 395 nb_bdy = 1 ! number of open boundary sets 396 ln_coords_file = .true. ! =T : read bdy coordinates from file 397 cn_coords_file = 'coordinates.bdy.nc' ! bdy coordinates files 398 ln_mask_file = .false. ! =T : read mask from file 399 cn_mask_file = '' ! name of mask file (if ln_mask_file=.TRUE.) 400 nn_dyn2d = 2 ! boundary conditions for barotropic fields 401 nn_dyn2d_dta = 3 ! = 0, bdy data are equal to the initial state 402 ! = 1, bdy data are read in 'bdydata .nc' files 403 ! = 2, use tidal harmonic forcing data from files 404 ! = 3, use external data AND tidal harmonic forcing 405 nn_dyn3d = 0 ! boundary conditions for baroclinic velocities 406 nn_dyn3d_dta = 0 ! = 0, bdy data are equal to the initial state 421 407 ! = 1, bdy data are read in 'bdydata .nc' files 422 nn_volctl = 0 ! = 0, the total water flux across open boundaries is zero 423 ! = 1, the total volume of the system is conserved 424 / 425 !----------------------------------------------------------------------- 426 &nambdy_tide ! tidal forcing at unstructured boundaries 427 !----------------------------------------------------------------------- 428 filtide = 'bdytide_' ! file name root of tidal forcing files 429 tide_cpt = 'M2','S1' ! names of tidal components used 430 tide_speed = 28.984106, 15.000001 ! phase speeds of tidal components (deg/hour) 431 ln_tide_date= .false. ! adjust tidal harmonics for start date of run 432 / 433 408 nn_tra = 1 ! boundary conditions for T and S 409 nn_tra_dta = 1 ! = 0, bdy data are equal to the initial state 410 ! = 1, bdy data are read in 'bdydata .nc' files 411 nn_rimwidth = 10 ! width of the relaxation zone 412 nn_dmp2d_in = 0 ! 413 nn_dmp2d_out = 0 ! 414 nn_dmp2d_in = 0 ! 415 nn_dmp2d_out = 0 ! 416 ln_vol = .false. ! total volume correction (see nn_volctl parameter) 417 nn_volctl = 1 ! = 0, the total water flux across open boundaries is zero 418 / 419 !----------------------------------------------------------------------- 420 &nambdy_dta ! open boundaries - external data ("key_bdy") 421 !----------------------------------------------------------------------- 422 ! ! file name ! frequency (hours) ! variable ! time interpol. ! clim ! 'yearly'/ ! weights ! rotation ! 423 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! 424 bn_ssh = 'amm12_bdyT_u2d' , 24 , 'sossheig' , .true. , .false. , 'daily' , '' , '' 425 bn_u2d = 'amm12_bdyU_u2d' , 24 , 'vobtcrtx' , .true. , .false. , 'daily' , '' , '' 426 bn_v2d = 'amm12_bdyV_u2d' , 24 , 'vobtcrty' , .true. , .false. , 'daily' , '' , '' 427 bn_u3d = 'amm12_bdyU_u3d' , 24 , 'vozocrtx' , .true. , .false. , 'daily' , '' , '' 428 bn_v3d = 'amm12_bdyV_u3d' , 24 , 'vomecrty' , .true. , .false. , 'daily' , '' , '' 429 bn_tem = 'amm12_bdyT_tra' , 24 , 'votemper' , .true. , .false. , 'daily' , '' , '' 430 bn_sal = 'amm12_bdyT_tra' , 24 , 'vosaline' , .true. , .false. , 'daily' , '' , '' 431 cn_dir = 'bdydta/' 432 ln_full_vel = .false. 433 / 434 !----------------------------------------------------------------------- 435 &nambdy_tide ! tidal forcing at open boundaries 436 !----------------------------------------------------------------------- 437 filtide = 'bdydta/amm12_bdytide_' ! file name root of tidal forcing files 438 tide_cpt(1) ='Q1' ! names of tidal components used 439 tide_cpt(2) ='O1' ! names of tidal components used 440 tide_cpt(3) ='P1' ! names of tidal components used 441 tide_cpt(4) ='S1' ! names of tidal components used 442 tide_cpt(5) ='K1' ! names of tidal components used 443 tide_cpt(6) ='2N2' ! names of tidal components used 444 tide_cpt(7) ='MU2' ! names of tidal components used 445 tide_cpt(8) ='N2' ! names of tidal components used 446 tide_cpt(9) ='NU2' ! names of tidal components used 447 tide_cpt(10) ='M2' ! names of tidal components used 448 tide_cpt(11) ='L2' ! names of tidal components used 449 tide_cpt(12) ='T2' ! names of tidal components used 450 tide_cpt(13) ='S2' ! names of tidal components used 451 tide_cpt(14) ='K2' ! names of tidal components used 452 tide_cpt(15) ='M4' ! names of tidal components used 453 tide_speed(1) = 13.398661 ! phase speeds of tidal components (deg/hour) 454 tide_speed(2) = 13.943036 ! phase speeds of tidal components (deg/hour) 455 tide_speed(3) = 14.958932 ! phase speeds of tidal components (deg/hour) 456 tide_speed(4) = 15.000001 ! phase speeds of tidal components (deg/hour) 457 tide_speed(5) = 15.041069 ! phase speeds of tidal components (deg/hour) 458 tide_speed(6) = 27.895355 ! phase speeds of tidal components (deg/hour) 459 tide_speed(7) = 27.968210 ! phase speeds of tidal components (deg/hour) 460 tide_speed(8) = 28.439730 ! phase speeds of tidal components (deg/hour) 461 tide_speed(9) = 28.512585 ! phase speeds of tidal components (deg/hour) 462 tide_speed(10) = 28.984106 ! phase speeds of tidal components (deg/hour) 463 tide_speed(11) = 29.528479 ! phase speeds of tidal components (deg/hour) 464 tide_speed(12) = 29.958935 ! phase speeds of tidal components (deg/hour) 465 tide_speed(13) = 30.000002 ! phase speeds of tidal components (deg/hour) 466 tide_speed(14) = 30.082138 ! phase speeds of tidal components (deg/hour) 467 tide_speed(15) = 57.968212 ! phase speeds of tidal components (deg/hour) 468 ln_tide_date = .true. ! adjust tidal harmonics for start date of run 469 / 434 470 !!====================================================================== 435 471 !! *** Bottom boundary condition *** … … 450 486 ln_bfr2d = .false. ! horizontal variation of the bottom friction coef (read a 2D mask file ) 451 487 rn_bfrien = 50. ! local multiplying factor of bfr (ln_bfr2d=T) 488 ln_bfrimp = .true. ! implicit bottom friction (requires ln_zdfexp = .false. if true) 452 489 / 453 490 !----------------------------------------------------------------------- … … 496 533 ln_traadv_muscl2 = .false. ! MUSCL2 scheme + cen2 at boundaries 497 534 ln_traadv_ubs = .false. ! UBS scheme 498 ln_traadv_qck = .false. ! QU CIKEST scheme535 ln_traadv_qck = .false. ! QUICKEST scheme 499 536 / 500 537 !----------------------------------------------------------------------- … … 508 545 ln_traldf_hor = .false. ! horizontal (geopotential) (require "key_ldfslp" when ln_sco=T) 509 546 ln_traldf_iso = .true. ! iso-neutral (require "key_ldfslp") 510 ln_traldf_grif = .false. ! griffies skew flux formulation (require "key_ldfslp") ! UNDER TEST, DO NOT USE 511 ln_traldf_gdia = .false. ! griffies operator strfn diagnostics (require "key_ldfslp") ! UNDER TEST, DO NOT USE 547 ln_traldf_grif = .false. ! griffies skew flux formulation (require "key_ldfslp") 548 ln_traldf_gdia = .false. ! griffies operator strfn diagnostics (require "key_ldfslp") 549 ln_triad_iso = .false. ! griffies operator calculates triads twice => pure lateral mixing in ML (require "key_ldfslp") 550 ln_botmix_grif = .false. ! griffies operator with lateral mixing on bottom (require "key_ldfslp") 512 551 ! ! Coefficient 513 552 rn_aht_0 = 300. ! horizontal eddy diffusivity for tracers [m2/s] … … 562 601 ln_hpg_zps = .true. ! z-coordinate - partial steps (interpolation) 563 602 ln_hpg_sco = .false. ! s-coordinate (standard jacobian formulation) 564 ln_hpg_hel = .false. ! s-coordinate (helsinki modification)565 ln_hpg_wdj = .false. ! s-coordinate (weighted density jacobian)566 603 ln_hpg_djc = .false. ! s-coordinate (Density Jacobian with Cubic polynomial) 567 ln_hpg_rot = .false. ! s-coordinate (ROTated axes scheme) 568 rn_gamma = 0.e0 ! weighting coefficient (wdj scheme) 604 ln_hpg_prj = .false. ! s-coordinate (Pressure Jacobian scheme) 569 605 ln_dynhpg_imp = .true. ! time stepping: semi-implicit time scheme (T) 570 606 ! centered time scheme (F) … … 931 967 cn_dir_cdg = './' ! root directory for the location of drag coefficient files 932 968 / 969 !----------------------------------------------------------------------- 970 &namdyn_nept ! Neptune effect (simplified: lateral and vertical diffusions removed) 971 !----------------------------------------------------------------------- 972 ! Suggested lengthscale values are those of Eby & Holloway (1994) for a coarse model 973 ln_neptsimp = .false. ! yes/no use simplified neptune 974 975 ln_smooth_neptvel = .false. ! yes/no smooth zunep, zvnep 976 rn_tslse = 1.2e4 ! value of lengthscale L at the equator 977 rn_tslsp = 3.0e3 ! value of lengthscale L at the pole 978 ! Specify whether to ramp down the Neptune velocity in shallow 979 ! water, and if so the depth range controlling such ramping down 980 ln_neptramp = .false. ! ramp down Neptune velocity in shallow water 981 rn_htrmin = 100.0 ! min. depth of transition range 982 rn_htrmax = 200.0 ! max. depth of transition range 983 / 984 >>>>>>> .merge-right.r3114 -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90
r2715 r3116 27 27 USE sbc_ice ! surface boundary condition: ice 28 28 USE sbc_oce ! surface boundary condition: ocean 29 USE sbccpl 29 30 30 31 USE albedo ! albedo parameters … … 234 235 !-----------------------------------------------! 235 236 236 IF( lk_cpl ) THEN ! coupled case 237 tn_ice(:,:,1) = sist(:,:) ! sea-ice surface temperature 238 ! ! Computation of snow/ice and ocean albedo 239 CALL albedo_ice( tn_ice, reshape( hicif, (/jpi,jpj,1/) ), reshape( hsnif, (/jpi,jpj,1/) ), zalbp, zalb ) 240 alb_ice(:,:,1) = 0.5 * ( zalbp(:,:,1) + zalb (:,:,1) ) ! Ice albedo (mean clear and overcast skys) 241 CALL iom_put( "icealb_cea", alb_ice(:,:,1) * fr_i(:,:) ) ! ice albedo 242 ENDIF 237 #if defined key_coupled 238 tn_ice(:,:,1) = sist(:,:) ! sea-ice surface temperature 239 ht_i(:,:,1) = hicif(:,:) 240 ht_s(:,:,1) = hsnif(:,:) 241 a_i(:,:,1) = fr_i(:,:) 242 ! ! Computation of snow/ice and ocean albedo 243 CALL albedo_ice( tn_ice, ht_i, ht_s, zalbp, zalb ) 244 alb_ice(:,:,1) = 0.5 * ( zalbp(:,:,1) + zalb (:,:,1) ) ! Ice albedo (mean clear and overcast skys) 245 CALL iom_put( "icealb_cea", alb_ice(:,:,1) * fr_i(:,:) ) ! ice albedo 246 #endif 243 247 244 248 IF(ln_ctl) THEN ! control print -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90
r2715 r3116 372 372 DO ji = kideb, kiut 373 373 sist_1d(ji) = MIN( ztsmlt(ji) , sist_1d(ji) ) 374 qla_ice_1d(ji) = -9999. ! default definition, not used as parsub = 0. in this case 374 375 zfcsu(ji) = zksndh(ji) * ( ztbif(ji) - sist_1d(ji) ) 375 376 END DO -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90
r2715 r3116 7 7 !! 3.0 ! 2008-04 (NEMO team) add in the reference version 8 8 !! 3.3 ! 2010-09 (D. Storkey) add ice boundary conditions 9 !! 3.4 ! 2011 (D. Storkey, J. Chanut) OBC-BDY merge 9 10 !!---------------------------------------------------------------------- 10 11 #if defined key_bdy … … 19 20 PUBLIC 20 21 22 TYPE, PUBLIC :: OBC_INDEX !: Indices and weights which define the open boundary 23 INTEGER, DIMENSION(jpbgrd) :: nblen 24 INTEGER, DIMENSION(jpbgrd) :: nblenrim 25 INTEGER, POINTER, DIMENSION(:,:) :: nbi 26 INTEGER, POINTER, DIMENSION(:,:) :: nbj 27 INTEGER, POINTER, DIMENSION(:,:) :: nbr 28 INTEGER, POINTER, DIMENSION(:,:) :: nbmap 29 REAL , POINTER, DIMENSION(:,:) :: nbw 30 REAL , POINTER, DIMENSION(:) :: flagu 31 REAL , POINTER, DIMENSION(:) :: flagv 32 END TYPE OBC_INDEX 33 34 TYPE, PUBLIC :: OBC_DATA !: Storage for external data 35 REAL, POINTER, DIMENSION(:) :: ssh 36 REAL, POINTER, DIMENSION(:) :: u2d 37 REAL, POINTER, DIMENSION(:) :: v2d 38 REAL, POINTER, DIMENSION(:,:) :: u3d 39 REAL, POINTER, DIMENSION(:,:) :: v3d 40 REAL, POINTER, DIMENSION(:,:) :: tem 41 REAL, POINTER, DIMENSION(:,:) :: sal 42 #if defined key_lim2 43 REAL, POINTER, DIMENSION(:) :: frld 44 REAL, POINTER, DIMENSION(:) :: hicif 45 REAL, POINTER, DIMENSION(:) :: hsnif 46 #endif 47 END TYPE OBC_DATA 48 21 49 !!---------------------------------------------------------------------- 22 50 !! Namelist variables 23 51 !!---------------------------------------------------------------------- 24 CHARACTER(len=80) :: cn_mask !: Name of unstruct. bdy mask file 25 CHARACTER(len=80) :: cn_dta_frs_T !: Name of unstruct. bdy data file at T points for FRS conditions 26 CHARACTER(len=80) :: cn_dta_frs_U !: Name of unstruct. bdy data file at U points for FRS conditions 27 CHARACTER(len=80) :: cn_dta_frs_V !: Name of unstruct. bdy data file at V points for FRS conditions 28 CHARACTER(len=80) :: cn_dta_fla_T !: Name of unstruct. bdy data file at T points for Flather scheme 29 CHARACTER(len=80) :: cn_dta_fla_U !: Name of unstruct. bdy data file at U points for Flather scheme 30 CHARACTER(len=80) :: cn_dta_fla_V !: Name of unstruct. bdy data file at V points for Flather scheme 52 CHARACTER(len=80), DIMENSION(jp_bdy) :: cn_coords_file !: Name of bdy coordinates file 53 CHARACTER(len=80) :: cn_mask_file !: Name of bdy mask file 31 54 ! 32 LOGICAL :: ln_tides = .false. !: =T apply tidal harmonic forcing along open boundaries 33 LOGICAL :: ln_vol = .false. !: =T volume correction 34 LOGICAL :: ln_mask = .false. !: =T read bdymask from file 35 LOGICAL :: ln_clim = .false. !: =T bdy data files contain 1 time dump (-->bdy forcing will be constant) 36 ! ! or 12 months (-->bdy forcing will be cyclic) 37 LOGICAL :: ln_dyn_fla = .false. !: =T Flather boundary conditions on barotropic velocities 38 LOGICAL :: ln_dyn_frs = .false. !: =T FRS boundary conditions on velocities 39 LOGICAL :: ln_tra_frs = .false. !: =T FRS boundary conditions on tracers (T and S) 40 LOGICAL :: ln_ice_frs = .false. !: =T FRS boundary conditions on seaice (leads fraction, ice depth, snow depth) 55 LOGICAL, DIMENSION(jp_bdy) :: ln_coords_file !: =T read bdy coordinates from file; 56 ! !: =F read bdy coordinates from namelist 57 LOGICAL :: ln_mask_file !: =T read bdymask from file 58 LOGICAL :: ln_vol !: =T volume correction 41 59 ! 42 INTEGER :: nn_rimwidth = 7 !: boundary rim width 43 INTEGER :: nn_dtactl = 1 !: = 0 use the initial state as bdy dta ; = 1 read it in a NetCDF file 44 INTEGER :: nn_volctl = 1 !: = 0 the total volume will have the variability of the surface Flux E-P 45 ! ! = 1 the volume will be constant during all the integration. 60 INTEGER :: nb_bdy !: number of open boundary sets 61 INTEGER, DIMENSION(jp_bdy) :: nn_rimwidth !: boundary rim width for Flow Relaxation Scheme 62 INTEGER :: nn_volctl !: = 0 the total volume will have the variability of the surface Flux E-P 63 ! ! = 1 the volume will be constant during all the integration. 64 INTEGER, DIMENSION(jp_bdy) :: nn_dyn2d ! Choice of boundary condition for barotropic variables (U,V,SSH) 65 INTEGER, DIMENSION(jp_bdy) :: nn_dyn2d_dta !: = 0 use the initial state as bdy dta ; 66 !: = 1 read it in a NetCDF file 67 !: = 2 read tidal harmonic forcing from a NetCDF file 68 !: = 3 read external data AND tidal harmonic forcing from NetCDF files 69 INTEGER, DIMENSION(jp_bdy) :: nn_dyn3d ! Choice of boundary condition for baroclinic velocities 70 INTEGER, DIMENSION(jp_bdy) :: nn_dyn3d_dta !: = 0 use the initial state as bdy dta ; 71 !: = 1 read it in a NetCDF file 72 INTEGER, DIMENSION(jp_bdy) :: nn_tra ! Choice of boundary condition for active tracers (T and S) 73 INTEGER, DIMENSION(jp_bdy) :: nn_tra_dta !: = 0 use the initial state as bdy dta ; 74 !: = 1 read it in a NetCDF file 75 #if defined key_lim2 76 INTEGER, DIMENSION(jp_bdy) :: nn_ice_lim2 ! Choice of boundary condition for sea ice variables 77 INTEGER, DIMENSION(jp_bdy) :: nn_ice_lim2_dta !: = 0 use the initial state as bdy dta ; 78 !: = 1 read it in a NetCDF file 79 #endif 80 ! 81 INTEGER, DIMENSION(jp_bdy) :: nn_dmp2d_in ! Damping timescale (days) for 2D solution for inward radiation or FRS 82 INTEGER, DIMENSION(jp_bdy) :: nn_dmp2d_out ! Damping timescale (days) for 2D solution for outward radiation 83 INTEGER, DIMENSION(jp_bdy) :: nn_dmp3d_in ! Damping timescale (days) for 3D solution for inward radiation or FRS 84 INTEGER, DIMENSION(jp_bdy) :: nn_dmp3d_out ! Damping timescale (days) for 3D solution for outward radiation 46 85 86 47 87 !!---------------------------------------------------------------------- 48 88 !! Global variables … … 52 92 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: bdyvmask !: Mask defining computational domain at V-points 53 93 94 REAL(wp) :: bdysurftot !: Lateral surface of unstructured open boundary 95 96 REAL(wp), POINTER, DIMENSION(:,:) :: pssh !: 97 REAL(wp), POINTER, DIMENSION(:,:) :: phur !: 98 REAL(wp), POINTER, DIMENSION(:,:) :: phvr !: Pointers for barotropic fields 99 REAL(wp), POINTER, DIMENSION(:,:) :: pu2d !: 100 REAL(wp), POINTER, DIMENSION(:,:) :: pv2d !: 101 54 102 !!---------------------------------------------------------------------- 55 !! Unstructuredopen boundary data variables103 !! open boundary data variables 56 104 !!---------------------------------------------------------------------- 57 INTEGER, DIMENSION(jpbgrd) :: nblen = 0 !: Size of bdy data on a proc for each grid type58 INTEGER, DIMENSION(jpbgrd) :: nblenrim = 0 !: Size of bdy data on a proc for first rim ind59 INTEGER, DIMENSION(jpbgrd) :: nblendta = 0 !: Size of bdy data in file60 105 61 INTEGER, DIMENSION(jpbdim,jpbgrd) :: nbi, nbj !: i and j indices of bdy dta 62 INTEGER, DIMENSION(jpbdim,jpbgrd) :: nbr !: Discrete distance from rim points 63 INTEGER, DIMENSION(jpbdim,jpbgrd) :: nbmap !: Indices of data in file for data in memory 64 65 REAL(wp) :: bdysurftot !: Lateral surface of unstructured open boundary 66 67 REAL(wp), DIMENSION(jpbdim) :: flagu, flagv !: Flag for normal velocity compnt for velocity components 68 REAL(wp), DIMENSION(jpbdim,jpbgrd) :: nbw !: Rim weights of bdy data 69 70 REAL(wp), DIMENSION(jpbdim) :: sshbdy !: Now clim of bdy sea surface height (Flather) 71 REAL(wp), DIMENSION(jpbdim) :: ubtbdy, vbtbdy !: Now clim of bdy barotropic velocity components 72 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: tbdy , sbdy !: Now clim of bdy temperature and salinity 73 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ubdy , vbdy !: Now clim of bdy velocity components 74 REAL(wp), DIMENSION(jpbdim) :: sshtide !: Tidal boundary array : SSH 75 REAL(wp), DIMENSION(jpbdim) :: utide, vtide !: Tidal boundary array : U and V 76 #if defined key_lim2 77 REAL(wp), DIMENSION(jpbdim) :: frld_bdy !: now ice leads fraction climatology 78 REAL(wp), DIMENSION(jpbdim) :: hicif_bdy !: Now ice thickness climatology 79 REAL(wp), DIMENSION(jpbdim) :: hsnif_bdy !: now snow thickness 80 #endif 106 INTEGER, DIMENSION(jp_bdy) :: nn_dta !: =0 => *all* data is set to initial conditions 107 !: =1 => some data to be read in from data files 108 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: dta_global !: workspace for reading in global data arrays 109 TYPE(OBC_INDEX), DIMENSION(jp_bdy), TARGET :: idx_bdy !: bdy indices (local process) 110 TYPE(OBC_DATA) , DIMENSION(jp_bdy) :: dta_bdy !: bdy external data (local process) 81 111 82 112 !!---------------------------------------------------------------------- … … 94 124 !!---------------------------------------------------------------------- 95 125 ! 96 ALLOCATE( bdytmask(jpi,jpj) , tbdy(jpbdim,jpk) , sbdy(jpbdim,jpk) , & 97 & bdyumask(jpi,jpj) , ubdy(jpbdim,jpk) , & 98 & bdyvmask(jpi,jpj) , vbdy(jpbdim,jpk) , STAT=bdy_oce_alloc ) 126 ALLOCATE( bdytmask(jpi,jpj) , bdyumask(jpi,jpj), bdyvmask(jpi,jpj), & 127 & STAT=bdy_oce_alloc ) 99 128 ! 100 129 IF( lk_mpp ) CALL mpp_sum ( bdy_oce_alloc ) … … 112 141 !!====================================================================== 113 142 END MODULE bdy_oce 143 -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_par.F90
r2528 r3116 17 17 18 18 LOGICAL, PUBLIC, PARAMETER :: lk_bdy = .TRUE. !: Unstructured Ocean Boundary Condition flag 19 INTEGER, PUBLIC, PARAMETER :: jpbdta = 20000 !: Max length of bdy field in file 20 INTEGER, PUBLIC, PARAMETER :: jpbdim = 20000 !: Max length of bdy field on a processor 19 INTEGER, PUBLIC, PARAMETER :: jp_bdy = 10 !: Maximum number of bdy sets 21 20 INTEGER, PUBLIC, PARAMETER :: jpbtime = 1000 !: Max number of time dumps per file 22 INTEGER, PUBLIC, PARAMETER :: jpbgrd = 6 !: Number of horizontal grid types used (T, u, v, f) 21 INTEGER, PUBLIC, PARAMETER :: jpbgrd = 3 !: Number of horizontal grid types used (T, U, V) 22 23 !! Flags for choice of schemes 24 INTEGER, PUBLIC, PARAMETER :: jp_none = 0 !: Flag for no open boundary condition 25 INTEGER, PUBLIC, PARAMETER :: jp_frs = 1 !: Flag for Flow Relaxation Scheme 26 INTEGER, PUBLIC, PARAMETER :: jp_flather = 2 !: Flag for Flather 23 27 #else 24 28 !!---------------------------------------------------------------------- -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90
r2977 r3116 10 10 !! 3.3 ! 2010-09 (E.O'Dea) modifications for Shelf configurations 11 11 !! 3.3 ! 2010-09 (D.Storkey) add ice boundary conditions 12 !! 3.4 ???????????????? 12 13 !!---------------------------------------------------------------------- 13 14 #if defined key_bdy 14 15 !!---------------------------------------------------------------------- 15 !! 'key_bdy' UnstructuredOpen Boundary Conditions16 !!---------------------------------------------------------------------- 17 !! bdy_dta_frs : read u, v, t, s data along open boundaries18 !! bdy_dta_fla : read depth-mean velocities and elevation along open boundaries16 !! 'key_bdy' Open Boundary Conditions 17 !!---------------------------------------------------------------------- 18 !! bdy_dta : read external data along open boundaries from file 19 !! bdy_dta_init : initialise arrays etc for reading of external data 19 20 !!---------------------------------------------------------------------- 20 21 USE oce ! ocean dynamics and tracers 21 22 USE dom_oce ! ocean space and time domain 22 23 USE phycst ! physical constants 23 USE bdy_oce ! ocean open boundary conditions 24 USE bdy_oce ! ocean open boundary conditions 24 25 USE bdytides ! tidal forcing at boundaries 25 USE iom26 USE io ipsl26 USE fldread ! read input fields 27 USE iom ! IOM library 27 28 USE in_out_manager ! I/O logical units 28 29 #if defined key_lim2 … … 33 34 PRIVATE 34 35 35 PUBLIC bdy_dta_frs ! routines called by step.F90 36 PUBLIC bdy_dta_fla 37 PUBLIC bdy_dta_alloc ! routine called by bdy_init.F90 38 39 INTEGER :: numbdyt, numbdyu, numbdyv ! logical units for T-, U-, & V-points data file, resp. 40 INTEGER :: ntimes_bdy ! exact number of time dumps in data files 41 INTEGER :: nbdy_b, nbdy_a ! record of bdy data file for before and after time step 42 INTEGER :: numbdyt_bt, numbdyu_bt, numbdyv_bt ! logical unit for T-, U- & V-points data file, resp. 43 INTEGER :: ntimes_bdy_bt ! exact number of time dumps in data files 44 INTEGER :: nbdy_b_bt, nbdy_a_bt ! record of bdy data file for before and after time step 45 46 INTEGER, DIMENSION (jpbtime) :: istep, istep_bt ! time array in seconds in each data file 47 48 REAL(wp) :: zoffset ! time offset between time origin in file & start time of model run 49 50 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tbdydta, sbdydta ! time interpolated values of T and S bdy data 51 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ubdydta, vbdydta ! time interpolated values of U and V bdy data 52 REAL(wp), DIMENSION(jpbdim,2) :: ubtbdydta, vbtbdydta ! Arrays used for time interpolation of bdy data 53 REAL(wp), DIMENSION(jpbdim,2) :: sshbdydta ! bdy data of ssh 54 55 #if defined key_lim2 56 REAL(wp), DIMENSION(jpbdim,2) :: frld_bdydta ! } 57 REAL(wp), DIMENSION(jpbdim,2) :: hicif_bdydta ! } Arrays used for time interp. of ice bdy data 58 REAL(wp), DIMENSION(jpbdim,2) :: hsnif_bdydta ! } 59 #endif 60 36 PUBLIC bdy_dta ! routine called by step.F90 and dynspg_ts.F90 37 PUBLIC bdy_dta_init ! routine called by nemogcm.F90 38 39 INTEGER, ALLOCATABLE, DIMENSION(:) :: nb_bdy_fld ! Number of fields to update for each boundary set. 40 INTEGER :: nb_bdy_fld_sum ! Total number of fields to update for all boundary sets. 41 42 LOGICAL, DIMENSION(jp_bdy) :: ln_full_vel_array ! =T => full velocities in 3D boundary conditions 43 ! =F => baroclinic velocities in 3D boundary conditions 44 45 TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:), TARGET :: bf ! structure of input fields (file informations, fields read) 46 47 TYPE(MAP_POINTER), ALLOCATABLE, DIMENSION(:) :: nbmap_ptr ! array of pointers to nbmap 48 49 # include "domzgr_substitute.h90" 61 50 !!---------------------------------------------------------------------- 62 51 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 66 55 CONTAINS 67 56 68 FUNCTION bdy_dta_alloc() 69 !!---------------------------------------------------------------------- 70 USE lib_mpp, ONLY: ctl_warn, mpp_sum 71 ! 72 INTEGER :: bdy_dta_alloc 73 !!---------------------------------------------------------------------- 74 ! 75 ALLOCATE(tbdydta(jpbdim,jpk,2), sbdydta(jpbdim,jpk,2), & 76 ubdydta(jpbdim,jpk,2), vbdydta(jpbdim,jpk,2), Stat=bdy_dta_alloc) 77 78 IF( lk_mpp ) CALL mpp_sum ( bdy_dta_alloc ) 79 IF(bdy_dta_alloc /= 0) CALL ctl_warn('bdy_dta_alloc: failed to allocate arrays') 80 81 END FUNCTION bdy_dta_alloc 82 83 84 SUBROUTINE bdy_dta_frs( kt ) 57 SUBROUTINE bdy_dta( kt, jit, time_offset ) 85 58 !!---------------------------------------------------------------------- 86 !! *** SUBROUTINE bdy_dta _frs***59 !! *** SUBROUTINE bdy_dta *** 87 60 !! 88 !! ** Purpose : Read unstructured boundary data for FRS condition.61 !! ** Purpose : Update external data for open boundary conditions 89 62 !! 90 !! ** Method : At the first timestep, read in boundary data for two 91 !! times from the file and time-interpolate. At other 92 !! timesteps, check to see if we need another time from 93 !! the file. If so read it in. Time interpolate. 63 !! ** Method : Use fldread.F90 64 !! 94 65 !!---------------------------------------------------------------------- 95 INTEGER, INTENT( in ) :: kt ! ocean time-step index (for timesplitting option, otherwise zero) 66 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 67 USE wrk_nemo, ONLY: wrk_2d_22, wrk_2d_23 ! 2D workspace 96 68 !! 97 CHARACTER(LEN=80), DIMENSION(3) :: clfile ! names of input files 98 CHARACTER(LEN=70 ) :: clunits ! units attribute of time coordinate 99 LOGICAL :: lect ! flag for reading 100 INTEGER :: it, ib, ik, igrd ! dummy loop indices 101 INTEGER :: igrd_start, igrd_end ! start and end of loops on igrd 102 INTEGER :: idvar ! netcdf var ID 103 INTEGER :: iman, i15, imois ! Time variables for monthly clim forcing 104 INTEGER :: ntimes_bdyt, ntimes_bdyu, ntimes_bdyv 105 INTEGER :: itimer, totime 106 INTEGER :: ii, ij ! array addresses 107 INTEGER :: ipi, ipj, ipk, inum ! local integers (NetCDF read) 108 INTEGER :: iyear0, imonth0, iday0 109 INTEGER :: ihours0, iminutes0, isec0 110 INTEGER :: iyear, imonth, iday, isecs 111 INTEGER, DIMENSION(jpbtime) :: istept, istepu, istepv ! time arrays from data files 112 REAL(wp) :: dayfrac, zxy, zoffsett 113 REAL(wp) :: zoffsetu, zoffsetv 114 REAL(wp) :: dayjul0, zdayjulini 115 REAL(wp), DIMENSION(jpbtime) :: zstepr ! REAL time array from data files 116 REAL(wp), DIMENSION(jpbdta,1,jpk) :: zdta ! temporary array for data fields 69 INTEGER, INTENT( in ) :: kt ! ocean time-step index 70 INTEGER, INTENT( in ), OPTIONAL :: jit ! subcycle time-step index (for timesplitting option) 71 INTEGER, INTENT( in ), OPTIONAL :: time_offset ! time offset in units of timesteps. NB. if jit 72 ! is present then units = subcycle timesteps. 73 ! time_offset = 0 => get data at "now" time level 74 ! time_offset = -1 => get data at "before" time level 75 ! time_offset = +1 => get data at "after" time level 76 ! etc. 77 !! 78 INTEGER :: ib_bdy, jfld, jstart, jend, ib, ii, ij, ik, igrd ! local indices 79 INTEGER, DIMENSION(jpbgrd) :: ilen1 80 INTEGER, POINTER, DIMENSION(:) :: nblen, nblenrim ! short cuts 81 !! 117 82 !!--------------------------------------------------------------------------- 118 83 119 120 IF( ln_dyn_frs .OR. ln_tra_frs & 121 & .OR. ln_ice_frs ) THEN ! If these are both false then this routine does nothing 122 123 ! -------------------- ! 124 ! Initialization ! 125 ! -------------------- ! 126 127 lect = .false. ! If true, read a time record 128 129 ! Some time variables for monthly climatological forcing: 130 ! ******************************************************* 131 132 !!gm here use directely daymod calendar variables 133 134 iman = INT( raamo ) ! Number of months in a year 135 136 i15 = INT( 2*REAL( nday, wp ) / ( REAL( nmonth_len(nmonth), wp ) + 0.5 ) ) 137 ! i15=0 if the current day is in the first half of the month, else i15=1 138 139 imois = nmonth + i15 - 1 ! imois is the first month record 140 IF( imois == 0 ) imois = iman 141 142 ! Time variable for non-climatological forcing: 143 ! ********************************************* 144 itimer = (kt-nit000+1)*rdt ! current time in seconds for interpolation 145 146 147 ! !-------------------! 148 IF( kt == nit000 ) THEN ! First call only ! 149 ! !-------------------! 150 istep(:) = 0 151 nbdy_b = 0 152 nbdy_a = 0 153 154 ! Get time information from bdy data file 155 ! *************************************** 156 157 IF(lwp) WRITE(numout,*) 158 IF(lwp) WRITE(numout,*) 'bdy_dta_frs : Initialize unstructured boundary data' 159 IF(lwp) WRITE(numout,*) '~~~~~~~' 160 161 IF ( nn_dtactl == 0 ) THEN 162 ! 163 IF(lwp) WRITE(numout,*) ' Bdy data are taken from initial conditions' 164 ! 165 ELSEIF (nn_dtactl == 1) THEN 166 ! 167 IF(lwp) WRITE(numout,*) ' Bdy data are read in netcdf files' 168 ! 169 dayfrac = adatrj - REAL( itimer, wp ) / 86400. ! day fraction at time step kt-1 170 dayfrac = dayfrac - INT ( dayfrac ) ! 171 totime = ( nitend - nit000 + 1 ) * rdt ! Total time of the run to verify that all the 172 ! ! necessary time dumps in file are included 173 ! 174 clfile(1) = cn_dta_frs_T 175 clfile(2) = cn_dta_frs_U 176 clfile(3) = cn_dta_frs_V 177 ! 178 ! how many files are we to read in? 179 igrd_start = 1 180 igrd_end = 3 181 IF(.NOT. ln_tra_frs .AND. .NOT. ln_ice_frs) THEN ! No T-grid file. 182 igrd_start = 2 183 ELSEIF ( .NOT. ln_dyn_frs ) THEN ! No U-grid or V-grid file. 184 igrd_end = 1 185 ENDIF 186 187 DO igrd = igrd_start, igrd_end ! loop over T, U & V grid ! 188 ! !---------------------------! 189 CALL iom_open( clfile(igrd), inum ) 190 CALL iom_gettime( inum, zstepr, kntime=ntimes_bdy, cdunits=clunits ) 191 192 SELECT CASE( igrd ) 193 CASE (1) ; numbdyt = inum 194 CASE (2) ; numbdyu = inum 195 CASE (3) ; numbdyv = inum 196 END SELECT 197 198 ! Calculate time offset 199 READ(clunits,7000) iyear0, imonth0, iday0, ihours0, iminutes0, isec0 200 ! Convert time origin in file to julian days 201 isec0 = isec0 + ihours0*60.*60. + iminutes0*60. 202 CALL ymds2ju(iyear0, imonth0, iday0, REAL(isec0, wp), dayjul0) 203 ! Compute model initialization time 204 iyear = ndastp / 10000 205 imonth = ( ndastp - iyear * 10000 ) / 100 206 iday = ndastp - iyear * 10000 - imonth * 100 207 isecs = dayfrac * 86400 208 CALL ymds2ju(iyear, imonth, iday, REAL(isecs, wp) , zdayjulini) 209 ! offset from initialization date: 210 zoffset = (dayjul0-zdayjulini)*86400 211 ! 212 7000 FORMAT('seconds since ', I4.4,'-',I2.2,'-',I2.2,' ',I2.2,':',I2.2,':',I2.2) 213 214 !! TO BE DONE... Check consistency between calendar from file 215 !! (available optionally from iom_gettime) and calendar in model 216 !! when calendar in model available outside of IOIPSL. 217 218 IF(lwp) WRITE(numout,*) 'number of times: ',ntimes_bdy 219 IF(lwp) WRITE(numout,*) 'offset: ',zoffset 220 IF(lwp) WRITE(numout,*) 'totime: ',totime 221 IF(lwp) WRITE(numout,*) 'zstepr: ',zstepr(1:ntimes_bdy) 222 223 ! Check that there are not too many times in the file. 224 IF( ntimes_bdy > jpbtime ) THEN 225 WRITE(ctmp1,*) 'Check file: ', clfile(igrd), 'jpbtime= ', jpbtime, ' ntimes_bdy= ', ntimes_bdy 226 CALL ctl_stop( 'Number of time dumps in files exceed jpbtime parameter', ctmp1 ) 227 ENDIF 228 229 ! Check that time array increases: 230 it = 1 231 DO WHILE( zstepr(it+1) > zstepr(it) .AND. it /= ntimes_bdy - 1 ) 232 it = it + 1 233 END DO 234 ! 235 IF( it /= ntimes_bdy-1 .AND. ntimes_bdy > 1 ) THEN 236 WRITE(ctmp1,*) 'Check file: ', clfile(igrd) 237 CALL ctl_stop( 'Time array in unstructured boundary data files', & 238 & 'does not continuously increase.' , ctmp1 ) 239 ENDIF 240 ! 241 ! Check that times in file span model run time: 242 IF( zstepr(1) + zoffset > 0 ) THEN 243 WRITE(ctmp1,*) 'Check file: ', clfile(igrd) 244 CALL ctl_stop( 'First time dump in bdy file is after model initial time', ctmp1 ) 245 END IF 246 IF( zstepr(ntimes_bdy) + zoffset < totime ) THEN 247 WRITE(ctmp1,*) 'Check file: ', clfile(igrd) 248 CALL ctl_stop( 'Last time dump in bdy file is before model final time', ctmp1 ) 249 END IF 250 ! 251 SELECT CASE( igrd ) 252 CASE (1) 253 ntimes_bdyt = ntimes_bdy 254 zoffsett = zoffset 255 istept(:) = INT( zstepr(:) + zoffset ) 256 numbdyt = inum 257 CASE (2) 258 ntimes_bdyu = ntimes_bdy 259 zoffsetu = zoffset 260 istepu(:) = INT( zstepr(:) + zoffset ) 261 numbdyu = inum 262 CASE (3) 263 ntimes_bdyv = ntimes_bdy 264 zoffsetv = zoffset 265 istepv(:) = INT( zstepr(:) + zoffset ) 266 numbdyv = inum 267 END SELECT 268 ! 269 END DO ! end loop over T, U & V grid 270 271 IF (igrd_start == 1 .and. igrd_end == 3) THEN 272 ! Only test differences if we are reading in 3 files 273 ! Verify time consistency between files 274 IF( ntimes_bdyu /= ntimes_bdyt .OR. ntimes_bdyv /= ntimes_bdyt ) THEN 275 CALL ctl_stop( 'Bdy data files must have the same number of time dumps', & 276 & 'Multiple time frequencies not implemented yet' ) 277 ENDIF 278 ntimes_bdy = ntimes_bdyt 279 ! 280 IF( zoffsetu /= zoffsett .OR. zoffsetv /= zoffsett ) THEN 281 CALL ctl_stop( 'Bdy data files must have the same time origin', & 282 & 'Multiple time frequencies not implemented yet' ) 283 ENDIF 284 zoffset = zoffsett 285 ENDIF 286 287 IF( igrd_start == 1 ) THEN ; istep(:) = istept(:) 288 ELSE ; istep(:) = istepu(:) 289 ENDIF 290 291 ! Check number of time dumps: 292 IF( ntimes_bdy == 1 .AND. .NOT. ln_clim ) THEN 293 CALL ctl_stop( 'There is only one time dump in data files', & 294 & 'Choose ln_clim=.true. in namelist for constant bdy forcing.' ) 295 ENDIF 296 297 IF( ln_clim ) THEN 298 IF( ntimes_bdy /= 1 .AND. ntimes_bdy /= 12 ) THEN 299 CALL ctl_stop( 'For climatological boundary forcing (ln_clim=.true.),', & 300 & 'bdy data files must contain 1 or 12 time dumps.' ) 301 ELSEIF( ntimes_bdy == 1 ) THEN 302 IF(lwp) WRITE(numout,*) 303 IF(lwp) WRITE(numout,*) 'We assume constant boundary forcing from bdy data files' 304 ELSEIF( ntimes_bdy == 12 ) THEN 305 IF(lwp) WRITE(numout,*) 306 IF(lwp) WRITE(numout,*) 'We assume monthly (and cyclic) boundary forcing from bdy data files' 307 ENDIF 308 ENDIF 309 310 ! Find index of first record to read (before first model time). 311 it = 1 312 DO WHILE( istep(it+1) <= 0 .AND. it <= ntimes_bdy - 1 ) 313 it = it + 1 314 END DO 315 nbdy_b = it 316 ! 317 IF(lwp) WRITE(numout,*) 'Time offset is ',zoffset 318 IF(lwp) WRITE(numout,*) 'First record to read is ',nbdy_b 319 320 ENDIF ! endif (nn_dtactl == 1) 321 322 323 ! 1.2 Read first record in file if necessary (ie if nn_dtactl == 1) 324 ! ***************************************************************** 325 326 IF( nn_dtactl == 0 ) THEN ! boundary data arrays are filled with initial conditions 327 ! 328 IF (ln_tra_frs) THEN 329 igrd = 1 ! T-points data 330 DO ib = 1, nblen(igrd) 331 ii = nbi(ib,igrd) 332 ij = nbj(ib,igrd) 84 IF(wrk_in_use(2, 22,23) ) THEN 85 CALL ctl_stop('bdy_dta: ERROR: requested workspace arrays are unavailable.') ; RETURN 86 END IF 87 88 ! Initialise data arrays once for all from initial conditions where required 89 !--------------------------------------------------------------------------- 90 IF( kt .eq. nit000 .and. .not. PRESENT(jit) ) THEN 91 92 ! Calculate depth-mean currents 93 !----------------------------- 94 pu2d => wrk_2d_22 95 pu2d => wrk_2d_23 96 97 pu2d(:,:) = 0.e0 98 pv2d(:,:) = 0.e0 99 100 DO ik = 1, jpkm1 !! Vertically integrated momentum trends 101 pu2d(:,:) = pu2d(:,:) + fse3u(:,:,ik) * umask(:,:,ik) * un(:,:,ik) 102 pv2d(:,:) = pv2d(:,:) + fse3v(:,:,ik) * vmask(:,:,ik) * vn(:,:,ik) 103 END DO 104 pu2d(:,:) = pu2d(:,:) * hur(:,:) 105 pv2d(:,:) = pv2d(:,:) * hvr(:,:) 106 107 DO ib_bdy = 1, nb_bdy 108 109 nblen => idx_bdy(ib_bdy)%nblen 110 nblenrim => idx_bdy(ib_bdy)%nblenrim 111 112 IF( nn_dyn2d(ib_bdy) .gt. 0 .and. nn_dyn2d_dta(ib_bdy) .eq. 0 ) THEN 113 IF( nn_dyn2d(ib_bdy) .eq. jp_frs ) THEN 114 ilen1(:) = nblen(:) 115 ELSE 116 ilen1(:) = nblenrim(:) 117 ENDIF 118 igrd = 1 119 DO ib = 1, ilen1(igrd) 120 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 121 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 122 dta_bdy(ib_bdy)%ssh(ib) = sshn(ii,ij) * tmask(ii,ij,1) 123 END DO 124 igrd = 2 125 DO ib = 1, ilen1(igrd) 126 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 127 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 128 dta_bdy(ib_bdy)%u2d(ib) = pu2d(ii,ij) * umask(ii,ij,1) 129 END DO 130 igrd = 3 131 DO ib = 1, ilen1(igrd) 132 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 133 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 134 dta_bdy(ib_bdy)%v2d(ib) = pv2d(ii,ij) * vmask(ii,ij,1) 135 END DO 136 ENDIF 137 138 IF( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN 139 IF( nn_dyn3d(ib_bdy) .eq. jp_frs ) THEN 140 ilen1(:) = nblen(:) 141 ELSE 142 ilen1(:) = nblenrim(:) 143 ENDIF 144 igrd = 2 145 DO ib = 1, ilen1(igrd) 333 146 DO ik = 1, jpkm1 334 tbdy(ib,ik) = tsn(ii,ij,ik,jp_tem) 335 sbdy(ib,ik) = tsn(ii,ij,ik,jp_sal) 147 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 148 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 149 dta_bdy(ib_bdy)%u3d(ib,ik) = ( un(ii,ij,ik) - pu2d(ii,ij) ) * umask(ii,ij,ik) 150 END DO 151 END DO 152 igrd = 3 153 DO ib = 1, ilen1(igrd) 154 DO ik = 1, jpkm1 155 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 156 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 157 dta_bdy(ib_bdy)%v3d(ib,ik) = ( vn(ii,ij,ik) - pv2d(ii,ij) ) * vmask(ii,ij,ik) 158 END DO 159 END DO 160 ENDIF 161 162 IF( nn_tra(ib_bdy) .gt. 0 .and. nn_tra_dta(ib_bdy) .eq. 0 ) THEN 163 IF( nn_tra(ib_bdy) .eq. jp_frs ) THEN 164 ilen1(:) = nblen(:) 165 ELSE 166 ilen1(:) = nblenrim(:) 167 ENDIF 168 igrd = 1 ! Everything is at T-points here 169 DO ib = 1, ilen1(igrd) 170 DO ik = 1, jpkm1 171 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 172 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 173 dta_bdy(ib_bdy)%tem(ib,ik) = tsn(ii,ij,ik,jp_tem) * tmask(ii,ij,ik) 174 dta_bdy(ib_bdy)%sal(ib,ik) = tsn(ii,ij,ik,jp_sal) * tmask(ii,ij,ik) 175 END DO 176 END DO 177 ENDIF 178 179 #if defined key_lim2 180 IF( nn_ice_lim2(ib_bdy) .gt. 0 .and. nn_ice_lim2_dta(ib_bdy) .eq. 0 ) THEN 181 IF( nn_ice_lim2(ib_bdy) .eq. jp_frs ) THEN 182 ilen1(:) = nblen(:) 183 ELSE 184 ilen1(:) = nblenrim(:) 185 ENDIF 186 igrd = 1 ! Everything is at T-points here 187 DO ib = 1, ilen1(igrd) 188 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 189 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 190 dta_bdy(ib_bdy)%frld(ib) = frld(ii,ij) * tmask(ii,ij,1) 191 dta_bdy(ib_bdy)%hicif(ib) = hicif(ii,ij) * tmask(ii,ij,1) 192 dta_bdy(ib_bdy)%hsnif(ib) = hsnif(ii,ij) * tmask(ii,ij,1) 193 END DO 194 ENDIF 195 #endif 196 197 ENDDO ! ib_bdy 198 199 ENDIF ! kt .eq. nit000 200 201 ! update external data from files 202 !-------------------------------- 203 204 jstart = 1 205 DO ib_bdy = 1, nb_bdy 206 IF( nn_dta(ib_bdy) .eq. 1 ) THEN ! skip this bit if no external data required 207 208 IF( PRESENT(jit) ) THEN 209 ! Update barotropic boundary conditions only 210 ! jit is optional argument for fld_read and tide_update 211 IF( nn_dyn2d(ib_bdy) .gt. 0 ) THEN 212 IF( nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 213 dta_bdy(ib_bdy)%ssh(:) = 0.0 214 dta_bdy(ib_bdy)%u2d(:) = 0.0 215 dta_bdy(ib_bdy)%v2d(:) = 0.0 216 ENDIF 217 IF( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) THEN ! update external data 218 jend = jstart + 2 219 CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend), jit=jit, time_offset=time_offset ) 220 ENDIF 221 IF( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN ! update tidal harmonic forcing 222 CALL tide_update( kt=kt, idx=idx_bdy(ib_bdy), dta=dta_bdy(ib_bdy), td=tides(ib_bdy), jit=jit, time_offset=time_offset ) 223 ENDIF 224 ENDIF 225 ELSE 226 IF( nn_dyn2d(ib_bdy) .gt. 0 .and. nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 227 dta_bdy(ib_bdy)%ssh(:) = 0.0 228 dta_bdy(ib_bdy)%u2d(:) = 0.0 229 dta_bdy(ib_bdy)%v2d(:) = 0.0 230 ENDIF 231 IF( nb_bdy_fld(ib_bdy) .gt. 0 ) THEN ! update external data 232 jend = jstart + nb_bdy_fld(ib_bdy) - 1 233 CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend), time_offset=time_offset ) 234 ENDIF 235 IF( nn_dyn2d(ib_bdy) .gt. 0 .and. nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN ! update tidal harmonic forcing 236 CALL tide_update( kt=kt, idx=idx_bdy(ib_bdy), dta=dta_bdy(ib_bdy), td=tides(ib_bdy), time_offset=time_offset ) 237 ENDIF 238 ENDIF 239 jstart = jend+1 240 241 ! If full velocities in boundary data then split into barotropic and baroclinic data 242 ! (Note that we have already made sure that you can't use ln_full_vel = .true. at the same 243 ! time as the dynspg_ts option). 244 245 IF( ln_full_vel_array(ib_bdy) .and. & 246 & ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 .or. nn_dyn3d_dta(ib_bdy) .eq. 1 ) ) THEN 247 248 igrd = 2 ! zonal velocity 249 dta_bdy(ib_bdy)%u2d(:) = 0.0 250 DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 251 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 252 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 253 DO ik = 1, jpkm1 254 dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) & 255 & + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta_bdy(ib_bdy)%u3d(ib,ik) 256 END DO 257 dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) * hur(ii,ij) 258 DO ik = 1, jpkm1 259 dta_bdy(ib_bdy)%u3d(ib,ik) = dta_bdy(ib_bdy)%u3d(ib,ik) - dta_bdy(ib_bdy)%u2d(ib) 336 260 END DO 337 261 END DO 338 ENDIF 339 340 IF(ln_dyn_frs) THEN 341 igrd = 2 ! U-points data 342 DO ib = 1, nblen(igrd) 343 ii = nbi(ib,igrd) 344 ij = nbj(ib,igrd) 262 263 igrd = 3 ! meridional velocity 264 dta_bdy(ib_bdy)%v2d(:) = 0.0 265 DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 266 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 267 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 345 268 DO ik = 1, jpkm1 346 ubdy(ib,ik) = un(ii, ij, ik) 269 dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) & 270 & + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta_bdy(ib_bdy)%v3d(ib,ik) 271 END DO 272 dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) * hvr(ii,ij) 273 DO ik = 1, jpkm1 274 dta_bdy(ib_bdy)%v3d(ib,ik) = dta_bdy(ib_bdy)%v3d(ib,ik) - dta_bdy(ib_bdy)%v2d(ib) 347 275 END DO 348 276 END DO 349 ! 350 igrd = 3 ! V-points data 351 DO ib = 1, nblen(igrd) 352 ii = nbi(ib,igrd) 353 ij = nbj(ib,igrd) 354 DO ik = 1, jpkm1 355 vbdy(ib,ik) = vn(ii, ij, ik) 356 END DO 357 END DO 358 ENDIF 359 ! 360 #if defined key_lim2 361 IF( ln_ice_frs ) THEN 362 igrd = 1 ! T-points data 363 DO ib = 1, nblen(igrd) 364 frld_bdy (ib) = frld(nbi(ib,igrd), nbj(ib,igrd)) 365 hicif_bdy(ib) = hicif(nbi(ib,igrd), nbj(ib,igrd)) 366 hsnif_bdy(ib) = hsnif(nbi(ib,igrd), nbj(ib,igrd)) 367 END DO 368 ENDIF 369 #endif 370 ELSEIF( nn_dtactl == 1 ) THEN ! Set first record in the climatological case: 371 ! 372 IF( ln_clim .AND. ntimes_bdy == 1 ) THEN 373 nbdy_a = 1 374 ELSEIF( ln_clim .AND. ntimes_bdy == iman ) THEN 375 nbdy_b = 0 376 nbdy_a = imois 277 278 ENDIF 279 280 END IF ! nn_dta(ib_bdy) = 1 281 END DO ! ib_bdy 282 283 IF(wrk_not_released(2, 22,23) ) CALL ctl_stop('bdy_dta: ERROR: failed to release workspace arrays.') 284 285 END SUBROUTINE bdy_dta 286 287 288 SUBROUTINE bdy_dta_init 289 !!---------------------------------------------------------------------- 290 !! *** SUBROUTINE bdy_dta_init *** 291 !! 292 !! ** Purpose : Initialise arrays for reading of external data 293 !! for open boundary conditions 294 !! 295 !! ** Method : Use fldread.F90 296 !! 297 !!---------------------------------------------------------------------- 298 USE dynspg_oce, ONLY: lk_dynspg_ts 299 !! 300 INTEGER :: ib_bdy, jfld, jstart, jend, ierror ! local indices 301 !! 302 CHARACTER(len=100) :: cn_dir ! Root directory for location of data files 303 CHARACTER(len=100), DIMENSION(nb_bdy) :: cn_dir_array ! Root directory for location of data files 304 LOGICAL :: ln_full_vel ! =T => full velocities in 3D boundary data 305 ! =F => baroclinic velocities in 3D boundary data 306 INTEGER :: ilen_global ! Max length required for global bdy dta arrays 307 INTEGER, DIMENSION(jpbgrd) :: ilen0 ! size of local arrays 308 INTEGER, ALLOCATABLE, DIMENSION(:) :: ilen1, ilen3 ! size of 1st and 3rd dimensions of local arrays 309 INTEGER, ALLOCATABLE, DIMENSION(:) :: ibdy ! bdy set for a particular jfld 310 INTEGER, ALLOCATABLE, DIMENSION(:) :: igrid ! index for grid type (1,2,3 = T,U,V) 311 INTEGER, POINTER, DIMENSION(:) :: nblen, nblenrim ! short cuts 312 TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: blf_i ! array of namelist information structures 313 TYPE(FLD_N) :: bn_tem, bn_sal, bn_u3d, bn_v3d ! 314 TYPE(FLD_N) :: bn_ssh, bn_u2d, bn_v2d ! informations about the fields to be read 315 #if defined key_lim2 316 TYPE(FLD_N) :: bn_frld, bn_hicif, bn_hsnif ! 317 #endif 318 NAMELIST/nambdy_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d 319 #if defined key_lim2 320 NAMELIST/nambdy_dta/ bn_frld, bn_hicif, bn_hsnif 321 #endif 322 NAMELIST/nambdy_dta/ ln_full_vel 323 !!--------------------------------------------------------------------------- 324 325 ! Set nn_dta 326 DO ib_bdy = 1, nb_bdy 327 nn_dta(ib_bdy) = MAX( nn_dyn2d_dta(ib_bdy) & 328 ,nn_dyn3d_dta(ib_bdy) & 329 ,nn_tra_dta(ib_bdy) & 330 #if defined key_ice_lim2 331 ,nn_ice_lim2_dta(ib_bdy) & 332 #endif 333 ) 334 IF(nn_dta(ib_bdy) .gt. 1) nn_dta(ib_bdy) = 1 335 END DO 336 337 ! Work out upper bound of how many fields there are to read in and allocate arrays 338 ! --------------------------------------------------------------------------- 339 ALLOCATE( nb_bdy_fld(nb_bdy) ) 340 nb_bdy_fld(:) = 0 341 DO ib_bdy = 1, nb_bdy 342 IF( nn_dyn2d(ib_bdy) .gt. 0 .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) THEN 343 nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3 344 ENDIF 345 IF( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ) THEN 346 nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2 347 ENDIF 348 IF( nn_tra(ib_bdy) .gt. 0 .and. nn_tra_dta(ib_bdy) .eq. 1 ) THEN 349 nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2 350 ENDIF 351 #if defined key_lim2 352 IF( nn_ice_lim2(ib_bdy) .gt. 0 .and. nn_ice_lim2_dta(ib_bdy) .eq. 1 ) THEN 353 nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3 354 ENDIF 355 #endif 356 ENDDO 357 358 nb_bdy_fld_sum = SUM( nb_bdy_fld ) 359 360 ALLOCATE( bf(nb_bdy_fld_sum), STAT=ierror ) 361 IF( ierror > 0 ) THEN 362 CALL ctl_stop( 'bdy_dta: unable to allocate bf structure' ) ; RETURN 363 ENDIF 364 ALLOCATE( blf_i(nb_bdy_fld_sum), STAT=ierror ) 365 IF( ierror > 0 ) THEN 366 CALL ctl_stop( 'bdy_dta: unable to allocate blf_i structure' ) ; RETURN 367 ENDIF 368 ALLOCATE( nbmap_ptr(nb_bdy_fld_sum), STAT=ierror ) 369 IF( ierror > 0 ) THEN 370 CALL ctl_stop( 'bdy_dta: unable to allocate nbmap_ptr structure' ) ; RETURN 371 ENDIF 372 ALLOCATE( ilen1(nb_bdy_fld_sum), ilen3(nb_bdy_fld_sum) ) 373 ALLOCATE( ibdy(nb_bdy_fld_sum) ) 374 ALLOCATE( igrid(nb_bdy_fld_sum) ) 375 376 ! Read namelists 377 ! -------------- 378 REWIND(numnam) 379 jfld = 0 380 DO ib_bdy = 1, nb_bdy 381 IF( nn_dta(ib_bdy) .eq. 1 ) THEN 382 ! set file information 383 cn_dir = './' ! directory in which the model is executed 384 ln_full_vel = .false. 385 ! ... default values (NB: frequency positive => hours, negative => months) 386 ! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation ! 387 ! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs ! 388 bn_ssh = FLD_N( 'bdy_ssh' , 24 , 'sossheig' , .false. , .false. , 'yearly' , '' , '' ) 389 bn_u2d = FLD_N( 'bdy_vel2d_u' , 24 , 'vobtcrtx' , .false. , .false. , 'yearly' , '' , '' ) 390 bn_v2d = FLD_N( 'bdy_vel2d_v' , 24 , 'vobtcrty' , .false. , .false. , 'yearly' , '' , '' ) 391 bn_u3d = FLD_N( 'bdy_vel3d_u' , 24 , 'vozocrtx' , .false. , .false. , 'yearly' , '' , '' ) 392 bn_v3d = FLD_N( 'bdy_vel3d_v' , 24 , 'vomecrty' , .false. , .false. , 'yearly' , '' , '' ) 393 bn_tem = FLD_N( 'bdy_tem' , 24 , 'votemper' , .false. , .false. , 'yearly' , '' , '' ) 394 bn_sal = FLD_N( 'bdy_sal' , 24 , 'vosaline' , .false. , .false. , 'yearly' , '' , '' ) 395 #if defined key_lim2 396 bn_frld = FLD_N( 'bdy_frld' , 24 , 'ildsconc' , .false. , .false. , 'yearly' , '' , '' ) 397 bn_hicif = FLD_N( 'bdy_hicif' , 24 , 'iicethic' , .false. , .false. , 'yearly' , '' , '' ) 398 bn_hsnif = FLD_N( 'bdy_hsnif' , 24 , 'isnothic' , .false. , .false. , 'yearly' , '' , '' ) 399 #endif 400 401 ! Important NOT to rewind here. 402 READ( numnam, nambdy_dta ) 403 404 cn_dir_array(ib_bdy) = cn_dir 405 ln_full_vel_array(ib_bdy) = ln_full_vel 406 407 IF( ln_full_vel_array(ib_bdy) .and. lk_dynspg_ts ) THEN 408 CALL ctl_stop( 'bdy_dta_init: ERROR, cannot specify full velocities in boundary data',& 409 & 'with dynspg_ts option' ) ; RETURN 410 ENDIF 411 412 nblen => idx_bdy(ib_bdy)%nblen 413 nblenrim => idx_bdy(ib_bdy)%nblenrim 414 415 ! Only read in necessary fields for this set. 416 ! Important that barotropic variables come first. 417 IF( nn_dyn2d(ib_bdy) .gt. 0 .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) THEN 418 419 IF( nn_dyn2d(ib_bdy) .ne. jp_frs ) THEN 420 jfld = jfld + 1 421 blf_i(jfld) = bn_ssh 422 ibdy(jfld) = ib_bdy 423 igrid(jfld) = 1 424 ilen1(jfld) = nblenrim(igrid(jfld)) 425 ilen3(jfld) = 1 426 ENDIF 427 428 IF( .not. ln_full_vel_array(ib_bdy) ) THEN 429 430 jfld = jfld + 1 431 blf_i(jfld) = bn_u2d 432 ibdy(jfld) = ib_bdy 433 igrid(jfld) = 2 434 IF( nn_dyn2d(ib_bdy) .eq. jp_frs ) THEN 435 ilen1(jfld) = nblen(igrid(jfld)) 436 ELSE 437 ilen1(jfld) = nblenrim(igrid(jfld)) 438 ENDIF 439 ilen3(jfld) = 1 440 441 jfld = jfld + 1 442 blf_i(jfld) = bn_v2d 443 ibdy(jfld) = ib_bdy 444 igrid(jfld) = 3 445 IF( nn_dyn2d(ib_bdy) .eq. jp_frs ) THEN 446 ilen1(jfld) = nblen(igrid(jfld)) 447 ELSE 448 ilen1(jfld) = nblenrim(igrid(jfld)) 449 ENDIF 450 ilen3(jfld) = 1 451 452 ENDIF 453 454 ENDIF 455 456 ! baroclinic velocities 457 IF( ( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ) .or. & 458 & ( ln_full_vel_array(ib_bdy) .and. nn_dyn2d(ib_bdy) .gt. 0 .and. & 459 & ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN 460 461 jfld = jfld + 1 462 blf_i(jfld) = bn_u3d 463 ibdy(jfld) = ib_bdy 464 igrid(jfld) = 2 465 IF( nn_dyn3d(ib_bdy) .eq. jp_frs ) THEN 466 ilen1(jfld) = nblen(igrid(jfld)) 467 ELSE 468 ilen1(jfld) = nblenrim(igrid(jfld)) 469 ENDIF 470 ilen3(jfld) = jpk 471 472 jfld = jfld + 1 473 blf_i(jfld) = bn_v3d 474 ibdy(jfld) = ib_bdy 475 igrid(jfld) = 3 476 IF( nn_dyn3d(ib_bdy) .eq. jp_frs ) THEN 477 ilen1(jfld) = nblen(igrid(jfld)) 478 ELSE 479 ilen1(jfld) = nblenrim(igrid(jfld)) 480 ENDIF 481 ilen3(jfld) = jpk 482 483 ENDIF 484 485 ! temperature and salinity 486 IF( nn_tra(ib_bdy) .gt. 0 .and. nn_tra_dta(ib_bdy) .eq. 1 ) THEN 487 488 jfld = jfld + 1 489 blf_i(jfld) = bn_tem 490 ibdy(jfld) = ib_bdy 491 igrid(jfld) = 1 492 IF( nn_tra(ib_bdy) .eq. jp_frs ) THEN 493 ilen1(jfld) = nblen(igrid(jfld)) 494 ELSE 495 ilen1(jfld) = nblenrim(igrid(jfld)) 496 ENDIF 497 ilen3(jfld) = jpk 498 499 jfld = jfld + 1 500 blf_i(jfld) = bn_sal 501 ibdy(jfld) = ib_bdy 502 igrid(jfld) = 1 503 IF( nn_tra(ib_bdy) .eq. jp_frs ) THEN 504 ilen1(jfld) = nblen(igrid(jfld)) 505 ELSE 506 ilen1(jfld) = nblenrim(igrid(jfld)) 507 ENDIF 508 ilen3(jfld) = jpk 509 510 ENDIF 511 512 #if defined key_lim2 513 ! sea ice 514 IF( nn_ice_lim2(ib_bdy) .gt. 0 .and. nn_ice_lim2_dta(ib_bdy) .eq. 1 ) THEN 515 516 jfld = jfld + 1 517 blf_i(jfld) = bn_frld 518 ibdy(jfld) = ib_bdy 519 igrid(jfld) = 1 520 IF( nn_ice_lim2(ib_bdy) .eq. jp_frs ) THEN 521 ilen1(jfld) = nblen(igrid(jfld)) 522 ELSE 523 ilen1(jfld) = nblenrim(igrid(jfld)) 524 ENDIF 525 ilen3(jfld) = 1 526 527 jfld = jfld + 1 528 blf_i(jfld) = bn_hicif 529 ibdy(jfld) = ib_bdy 530 igrid(jfld) = 1 531 IF( nn_ice_lim2(ib_bdy) .eq. jp_frs ) THEN 532 ilen1(jfld) = nblen(igrid(jfld)) 533 ELSE 534 ilen1(jfld) = nblenrim(igrid(jfld)) 535 ENDIF 536 ilen3(jfld) = 1 537 538 jfld = jfld + 1 539 blf_i(jfld) = bn_hsnif 540 ibdy(jfld) = ib_bdy 541 igrid(jfld) = 1 542 IF( nn_ice_lim2(ib_bdy) .eq. jp_frs ) THEN 543 ilen1(jfld) = nblen(igrid(jfld)) 544 ELSE 545 ilen1(jfld) = nblenrim(igrid(jfld)) 546 ENDIF 547 ilen3(jfld) = 1 548 549 ENDIF 550 #endif 551 ! Recalculate field counts 552 !------------------------- 553 nb_bdy_fld_sum = 0 554 IF( ib_bdy .eq. 1 ) THEN 555 nb_bdy_fld(ib_bdy) = jfld 556 nb_bdy_fld_sum = jfld 377 557 ELSE 378 nbdy_a = nbdy_b 379 ENDIF 380 381 ! Read first record: 382 ipj = 1 383 ipk = jpk 384 igrd = 1 385 ipi = nblendta(igrd) 386 387 IF(ln_tra_frs) THEN 388 ! 389 igrd = 1 ! Temperature 390 IF( nblendta(igrd) <= 0 ) THEN 391 idvar = iom_varid( numbdyt, 'votemper' ) 392 nblendta(igrd) = iom_file(numbdyt)%dimsz(1,idvar) 393 ENDIF 394 IF(lwp) WRITE(numout,*) 'Dim size for votemper is ', nblendta(igrd) 395 ipi = nblendta(igrd) 396 CALL iom_get ( numbdyt, jpdom_unknown, 'votemper', zdta(1:ipi,1:ipj,1:ipk), nbdy_a ) 397 ! 398 DO ib = 1, nblen(igrd) 399 DO ik = 1, jpkm1 400 tbdydta(ib,ik,2) = zdta(nbmap(ib,igrd),1,ik) 401 END DO 402 END DO 403 ! 404 igrd = 1 ! salinity 405 IF( nblendta(igrd) .le. 0 ) THEN 406 idvar = iom_varid( numbdyt, 'vosaline' ) 407 nblendta(igrd) = iom_file(numbdyt)%dimsz(1,idvar) 408 ENDIF 409 IF(lwp) WRITE(numout,*) 'Dim size for vosaline is ', nblendta(igrd) 410 ipi = nblendta(igrd) 411 CALL iom_get ( numbdyt, jpdom_unknown, 'vosaline', zdta(1:ipi,1:ipj,1:ipk), nbdy_a ) 412 ! 413 DO ib = 1, nblen(igrd) 414 DO ik = 1, jpkm1 415 sbdydta(ib,ik,2) = zdta(nbmap(ib,igrd),1,ik) 416 END DO 417 END DO 418 ENDIF ! ln_tra_frs 419 420 IF( ln_dyn_frs ) THEN 421 ! 422 igrd = 2 ! u-velocity 423 IF ( nblendta(igrd) .le. 0 ) THEN 424 idvar = iom_varid( numbdyu,'vozocrtx' ) 425 nblendta(igrd) = iom_file(numbdyu)%dimsz(1,idvar) 426 ENDIF 427 IF(lwp) WRITE(numout,*) 'Dim size for vozocrtx is ', nblendta(igrd) 428 ipi = nblendta(igrd) 429 CALL iom_get ( numbdyu, jpdom_unknown,'vozocrtx',zdta(1:ipi,1:ipj,1:ipk),nbdy_a ) 430 DO ib = 1, nblen(igrd) 431 DO ik = 1, jpkm1 432 ubdydta(ib,ik,2) = zdta(nbmap(ib,igrd),1,ik) 433 END DO 434 END DO 435 ! 436 igrd = 3 ! v-velocity 437 IF ( nblendta(igrd) .le. 0 ) THEN 438 idvar = iom_varid( numbdyv,'vomecrty' ) 439 nblendta(igrd) = iom_file(numbdyv)%dimsz(1,idvar) 440 ENDIF 441 IF(lwp) WRITE(numout,*) 'Dim size for vomecrty is ', nblendta(igrd) 442 ipi = nblendta(igrd) 443 CALL iom_get ( numbdyv, jpdom_unknown,'vomecrty',zdta(1:ipi,1:ipj,1:ipk),nbdy_a ) 444 DO ib = 1, nblen(igrd) 445 DO ik = 1, jpkm1 446 vbdydta(ib,ik,2) = zdta(nbmap(ib,igrd),1,ik) 447 END DO 448 END DO 449 ENDIF ! ln_dyn_frs 450 451 #if defined key_lim2 452 IF( ln_ice_frs ) THEN 453 ! 454 igrd=1 ! leads fraction 455 IF(lwp) WRITE(numout,*) 'Dim size for ildsconc is ',nblendta(igrd) 456 ipi=nblendta(igrd) 457 CALL iom_get ( numbdyt, jpdom_unknown,'ildsconc',zdta(1:ipi,:,1),nbdy_a ) 458 DO ib=1, nblen(igrd) 459 frld_bdydta(ib,2) = zdta(nbmap(ib,igrd),1,1) 460 END DO 461 ! 462 igrd=1 ! ice thickness 463 IF(lwp) WRITE(numout,*) 'Dim size for iicethic is ',nblendta(igrd) 464 ipi=nblendta(igrd) 465 CALL iom_get ( numbdyt, jpdom_unknown,'iicethic',zdta(1:ipi,:,1),nbdy_a ) 466 DO ib=1, nblen(igrd) 467 hicif_bdydta(ib,2) = zdta(nbmap(ib,igrd),1,1) 468 END DO 469 ! 470 igrd=1 ! snow thickness 471 IF(lwp) WRITE(numout,*) 'Dim size for isnowthi is ',nblendta(igrd) 472 ipi=nblendta(igrd) 473 CALL iom_get ( numbdyt, jpdom_unknown,'isnowthi',zdta(1:ipi,:,1),nbdy_a ) 474 DO ib=1, nblen(igrd) 475 hsnif_bdydta(ib,2) = zdta(nbmap(ib,igrd),1,1) 476 END DO 477 ENDIF ! just if ln_ice_frs is set 478 #endif 479 480 IF( .NOT.ln_clim .AND. istep(1) > 0 ) THEN ! First data time is after start of run 481 nbdy_b = nbdy_a ! Put first value in both time levels 482 IF( ln_tra_frs ) THEN 483 tbdydta(:,:,1) = tbdydta(:,:,2) 484 sbdydta(:,:,1) = sbdydta(:,:,2) 485 ENDIF 486 IF( ln_dyn_frs ) THEN 487 ubdydta(:,:,1) = ubdydta(:,:,2) 488 vbdydta(:,:,1) = vbdydta(:,:,2) 489 ENDIF 490 #if defined key_lim2 491 IF( ln_ice_frs ) THEN 492 frld_bdydta (:,1) = frld_bdydta(:,2) 493 hicif_bdydta(:,1) = hicif_bdydta(:,2) 494 hsnif_bdydta(:,1) = hsnif_bdydta(:,2) 495 ENDIF 496 #endif 497 END IF 498 ! 499 END IF ! nn_dtactl == 0/1 500 501 ! In the case of constant boundary forcing fill bdy arrays once for all 502 IF( ln_clim .AND. ntimes_bdy == 1 ) THEN 503 IF( ln_tra_frs ) THEN 504 tbdy (:,:) = tbdydta (:,:,2) 505 sbdy (:,:) = sbdydta (:,:,2) 506 ENDIF 507 IF( ln_dyn_frs) THEN 508 ubdy (:,:) = ubdydta (:,:,2) 509 vbdy (:,:) = vbdydta (:,:,2) 510 ENDIF 511 #if defined key_lim2 512 IF( ln_ice_frs ) THEN 513 frld_bdy (:) = frld_bdydta (:,2) 514 hicif_bdy(:) = hicif_bdydta(:,2) 515 hsnif_bdy(:) = hsnif_bdydta(:,2) 516 ENDIF 517 #endif 518 519 IF( ln_tra_frs .OR. ln_ice_frs) CALL iom_close( numbdyt ) 520 IF( ln_dyn_frs ) CALL iom_close( numbdyu ) 521 IF( ln_dyn_frs ) CALL iom_close( numbdyv ) 522 END IF 523 ! 524 ENDIF ! End if nit000 525 526 527 ! !---------------------! 528 IF( nn_dtactl == 1 .AND. ntimes_bdy > 1 ) THEN ! at each time step ! 529 ! !---------------------! 530 ! Read one more record if necessary 531 !********************************** 532 533 IF( ln_clim .AND. imois /= nbdy_b ) THEN ! remember that nbdy_b=0 for kt=nit000 534 nbdy_b = imois 535 nbdy_a = imois + 1 536 nbdy_b = MOD( nbdy_b, iman ) ; IF( nbdy_b == 0 ) nbdy_b = iman 537 nbdy_a = MOD( nbdy_a, iman ) ; IF( nbdy_a == 0 ) nbdy_a = iman 538 lect=.true. 539 ELSEIF( .NOT.ln_clim .AND. itimer >= istep(nbdy_a) ) THEN 540 541 IF( nbdy_a < ntimes_bdy ) THEN 542 nbdy_b = nbdy_a 543 nbdy_a = nbdy_a + 1 544 lect =.true. 558 nb_bdy_fld(ib_bdy) = jfld - nb_bdy_fld_sum 559 nb_bdy_fld_sum = nb_bdy_fld_sum + nb_bdy_fld(ib_bdy) 560 ENDIF 561 562 ENDIF ! nn_dta .eq. 1 563 ENDDO ! ib_bdy 564 565 566 DO jfld = 1, nb_bdy_fld_sum 567 ALLOCATE( bf(jfld)%fnow(ilen1(jfld),1,ilen3(jfld)) ) 568 IF( blf_i(jfld)%ln_tint ) ALLOCATE( bf(jfld)%fdta(ilen1(jfld),1,ilen3(jfld),2) ) 569 nbmap_ptr(jfld)%ptr => idx_bdy(ibdy(jfld))%nbmap(:,igrid(jfld)) 570 ENDDO 571 572 ! fill bf with blf_i and control print 573 !------------------------------------- 574 jstart = 1 575 DO ib_bdy = 1, nb_bdy 576 jend = jstart + nb_bdy_fld(ib_bdy) - 1 577 CALL fld_fill( bf(jstart:jend), blf_i(jstart:jend), cn_dir_array(ib_bdy), 'bdy_dta', 'open boundary conditions', 'nambdy_dta' ) 578 jstart = jend + 1 579 ENDDO 580 581 ! Initialise local boundary data arrays 582 ! nn_xxx_dta=0 : allocate space - will be filled from initial conditions later 583 ! nn_xxx_dta=1 : point to "fnow" arrays 584 !------------------------------------- 585 586 jfld = 0 587 DO ib_bdy=1, nb_bdy 588 589 nblen => idx_bdy(ib_bdy)%nblen 590 nblenrim => idx_bdy(ib_bdy)%nblenrim 591 592 IF (nn_dyn2d(ib_bdy) .gt. 0) THEN 593 IF( nn_dyn2d_dta(ib_bdy) .eq. 0 .or. nn_dyn2d_dta(ib_bdy) .eq. 2 .or. ln_full_vel_array(ib_bdy) ) THEN 594 IF( nn_dyn2d(ib_bdy) .eq. jp_frs ) THEN 595 ilen0(1:3) = nblen(1:3) 596 ELSE 597 ilen0(1:3) = nblenrim(1:3) 598 ENDIF 599 ALLOCATE( dta_bdy(ib_bdy)%ssh(ilen0(1)) ) 600 ALLOCATE( dta_bdy(ib_bdy)%u2d(ilen0(2)) ) 601 ALLOCATE( dta_bdy(ib_bdy)%v2d(ilen0(3)) ) 545 602 ELSE 546 ! We have reached the end of the file 547 ! put the last data time into both time levels 548 nbdy_b = nbdy_a 549 IF(ln_tra_frs) THEN 550 tbdydta(:,:,1) = tbdydta(:,:,2) 551 sbdydta(:,:,1) = sbdydta(:,:,2) 552 ENDIF 553 IF(ln_dyn_frs) THEN 554 ubdydta(:,:,1) = ubdydta(:,:,2) 555 vbdydta(:,:,1) = vbdydta(:,:,2) 556 ENDIF 557 #if defined key_lim2 558 IF(ln_ice_frs) THEN 559 frld_bdydta (:,1) = frld_bdydta (:,2) 560 hicif_bdydta(:,1) = hicif_bdydta(:,2) 561 hsnif_bdydta(:,1) = hsnif_bdydta(:,2) 562 ENDIF 563 #endif 564 END IF ! nbdy_a < ntimes_bdy 565 ! 566 END IF 567 568 IF( lect ) THEN ! Swap arrays 569 IF( ln_tra_frs ) THEN 570 tbdydta(:,:,1) = tbdydta(:,:,2) 571 sbdydta(:,:,1) = sbdydta(:,:,2) 572 ENDIF 573 IF( ln_dyn_frs ) THEN 574 ubdydta(:,:,1) = ubdydta(:,:,2) 575 vbdydta(:,:,1) = vbdydta(:,:,2) 576 ENDIF 577 #if defined key_lim2 578 IF( ln_ice_frs ) THEN 579 frld_bdydta (:,1) = frld_bdydta (:,2) 580 hicif_bdydta(:,1) = hicif_bdydta(:,2) 581 hsnif_bdydta(:,1) = hsnif_bdydta(:,2) 582 ENDIF 583 #endif 584 ! read another set 585 ipj = 1 586 ipk = jpk 587 588 IF( ln_tra_frs ) THEN 589 ! 590 igrd = 1 ! temperature 591 ipi = nblendta(igrd) 592 CALL iom_get ( numbdyt, jpdom_unknown, 'votemper', zdta(1:ipi,1:ipj,1:ipk), nbdy_a ) 593 DO ib = 1, nblen(igrd) 594 DO ik = 1, jpkm1 595 tbdydta(ib,ik,2) = zdta(nbmap(ib,igrd),1,ik) 596 END DO 597 END DO 598 ! 599 igrd = 1 ! salinity 600 ipi = nblendta(igrd) 601 CALL iom_get ( numbdyt, jpdom_unknown, 'vosaline', zdta(1:ipi,1:ipj,1:ipk), nbdy_a ) 602 DO ib = 1, nblen(igrd) 603 DO ik = 1, jpkm1 604 sbdydta(ib,ik,2) = zdta(nbmap(ib,igrd),1,ik) 605 END DO 606 END DO 607 ENDIF ! ln_tra_frs 608 609 IF(ln_dyn_frs) THEN 610 ! 611 igrd = 2 ! u-velocity 612 ipi = nblendta(igrd) 613 CALL iom_get ( numbdyu, jpdom_unknown,'vozocrtx',zdta(1:ipi,1:ipj,1:ipk),nbdy_a ) 614 DO ib = 1, nblen(igrd) 615 DO ik = 1, jpkm1 616 ubdydta(ib,ik,2) = zdta(nbmap(ib,igrd),1,ik) 617 END DO 618 END DO 619 ! 620 igrd = 3 ! v-velocity 621 ipi = nblendta(igrd) 622 CALL iom_get ( numbdyv, jpdom_unknown,'vomecrty',zdta(1:ipi,1:ipj,1:ipk),nbdy_a ) 623 DO ib = 1, nblen(igrd) 624 DO ik = 1, jpkm1 625 vbdydta(ib,ik,2) = zdta(nbmap(ib,igrd),1,ik) 626 END DO 627 END DO 628 ENDIF ! ln_dyn_frs 629 ! 630 #if defined key_lim2 631 IF(ln_ice_frs) THEN 632 ! 633 igrd = 1 ! ice concentration 634 ipi=nblendta(igrd) 635 CALL iom_get ( numbdyt, jpdom_unknown,'ildsconc',zdta(1:ipi,:,1),nbdy_a ) 636 DO ib=1, nblen(igrd) 637 frld_bdydta(ib,2) = zdta( nbmap(ib,igrd), 1, 1 ) 638 END DO 639 ! 640 igrd=1 ! ice thickness 641 ipi=nblendta(igrd) 642 CALL iom_get ( numbdyt, jpdom_unknown,'iicethic',zdta(1:ipi,:,1),nbdy_a ) 643 DO ib=1, nblen(igrd) 644 hicif_bdydta(ib,2) = zdta( nbmap(ib,igrd), 1, 1 ) 645 END DO 646 ! 647 igrd=1 ! snow thickness 648 ipi=nblendta(igrd) 649 CALL iom_get ( numbdyt, jpdom_unknown,'isnowthi',zdta(1:ipi,:,1),nbdy_a ) 650 DO ib=1, nblen(igrd) 651 hsnif_bdydta(ib,2) = zdta( nbmap(ib,igrd), 1, 1 ) 652 END DO 653 ENDIF ! ln_ice_frs 654 #endif 655 ! 656 IF(lwp) WRITE(numout,*) 'bdy_dta_frs : first record file used nbdy_b ',nbdy_b 657 IF(lwp) WRITE(numout,*) '~~~~~~~~ last record file used nbdy_a ',nbdy_a 658 IF (.NOT.ln_clim) THEN 659 IF(lwp) WRITE(numout,*) 'first record time (s): ', istep(nbdy_b) 660 IF(lwp) WRITE(numout,*) 'model time (s) : ', itimer 661 IF(lwp) WRITE(numout,*) 'second record time (s): ', istep(nbdy_a) 662 ENDIF 663 ! 664 ENDIF ! end lect=.true. 665 666 667 ! Interpolate linearly 668 ! ******************** 669 ! 670 IF( ln_clim ) THEN ; zxy = REAL( nday ) / REAL( nmonth_len(nbdy_b) ) + 0.5 - i15 671 ELSEIF( istep(nbdy_b) == istep(nbdy_a) ) THEN 672 zxy = 0.0_wp 673 ELSE ; zxy = REAL( istep(nbdy_b) - itimer ) / REAL( istep(nbdy_b) - istep(nbdy_a) ) 674 END IF 675 676 IF(ln_tra_frs) THEN 677 igrd = 1 ! temperature & salinity 678 DO ib = 1, nblen(igrd) 679 DO ik = 1, jpkm1 680 tbdy(ib,ik) = zxy * tbdydta(ib,ik,2) + (1.-zxy) * tbdydta(ib,ik,1) 681 sbdy(ib,ik) = zxy * sbdydta(ib,ik,2) + (1.-zxy) * sbdydta(ib,ik,1) 682 END DO 683 END DO 684 ENDIF 685 686 IF(ln_dyn_frs) THEN 687 igrd = 2 ! u-velocity 688 DO ib = 1, nblen(igrd) 689 DO ik = 1, jpkm1 690 ubdy(ib,ik) = zxy * ubdydta(ib,ik,2) + (1.-zxy) * ubdydta(ib,ik,1) 691 END DO 692 END DO 693 ! 694 igrd = 3 ! v-velocity 695 DO ib = 1, nblen(igrd) 696 DO ik = 1, jpkm1 697 vbdy(ib,ik) = zxy * vbdydta(ib,ik,2) + (1.-zxy) * vbdydta(ib,ik,1) 698 END DO 699 END DO 700 ENDIF 701 702 #if defined key_lim2 703 IF(ln_ice_frs) THEN 704 igrd=1 705 DO ib=1, nblen(igrd) 706 frld_bdy(ib) = zxy * frld_bdydta(ib,2) + (1.-zxy) * frld_bdydta(ib,1) 707 hicif_bdy(ib) = zxy * hicif_bdydta(ib,2) + (1.-zxy) * hicif_bdydta(ib,1) 708 hsnif_bdy(ib) = zxy * hsnif_bdydta(ib,2) + (1.-zxy) * hsnif_bdydta(ib,1) 709 END DO 710 ENDIF ! just if ln_ice_frs is true 711 #endif 712 713 END IF !end if ((nn_dtactl==1).AND.(ntimes_bdy>1)) 714 715 716 ! !---------------------! 717 ! ! last call ! 718 ! !---------------------! 719 IF( kt == nitend ) THEN 720 IF(ln_tra_frs .or. ln_ice_frs) CALL iom_close( numbdyt ) ! Closing of the 3 files 721 IF(ln_dyn_frs) CALL iom_close( numbdyu ) 722 IF(ln_dyn_frs) CALL iom_close( numbdyv ) 723 ENDIF 724 ! 725 ENDIF ! ln_dyn_frs .OR. ln_tra_frs 726 ! 727 END SUBROUTINE bdy_dta_frs 728 729 730 SUBROUTINE bdy_dta_fla( kt, jit, icycl ) 731 !!--------------------------------------------------------------------------- 732 !! *** SUBROUTINE bdy_dta_fla *** 733 !! 734 !! ** Purpose : Read unstructured boundary data for Flather condition 735 !! 736 !! ** Method : At the first timestep, read in boundary data for two 737 !! times from the file and time-interpolate. At other 738 !! timesteps, check to see if we need another time from 739 !! the file. If so read it in. Time interpolate. 740 !!--------------------------------------------------------------------------- 741 !!gm DOCTOR names : argument integer : start with "k" 742 INTEGER, INTENT( in ) :: kt ! ocean time-step index 743 INTEGER, INTENT( in ) :: jit ! barotropic time step index 744 INTEGER, INTENT( in ) :: icycl ! number of cycles need for final file close 745 ! ! (for timesplitting option, otherwise zero) 746 !! 747 LOGICAL :: lect ! flag for reading 748 INTEGER :: it, ib, igrd ! dummy loop indices 749 INTEGER :: idvar ! netcdf var ID 750 INTEGER :: iman, i15, imois ! Time variables for monthly clim forcing 751 INTEGER :: ntimes_bdyt, ntimes_bdyu, ntimes_bdyv 752 INTEGER :: itimer, totime 753 INTEGER :: ipi, ipj, ipk, inum ! temporary integers (NetCDF read) 754 INTEGER :: iyear0, imonth0, iday0 755 INTEGER :: ihours0, iminutes0, isec0 756 INTEGER :: iyear, imonth, iday, isecs 757 INTEGER, DIMENSION(jpbtime) :: istept, istepu, istepv ! time arrays from data files 758 REAL(wp) :: dayfrac, zxy, zoffsett 759 REAL(wp) :: zoffsetu, zoffsetv 760 REAL(wp) :: dayjul0, zdayjulini 761 REAL(wp) :: zinterval_s, zinterval_e ! First and last interval in time axis 762 REAL(wp), DIMENSION(jpbtime) :: zstepr ! REAL time array from data files 763 REAL(wp), DIMENSION(jpbdta,1) :: zdta ! temporary array for data fields 764 CHARACTER(LEN=80), DIMENSION(6) :: clfile 765 CHARACTER(LEN=70 ) :: clunits ! units attribute of time coordinate 766 !!--------------------------------------------------------------------------- 767 768 !!gm add here the same style as in bdy_dta_frs 769 !!gm clearly bdy_dta_fla and bdy_dta_frs can be combined... 770 !!gm too many things duplicated in the read of data... simplification can be done 771 772 ! -------------------- ! 773 ! Initialization ! 774 ! -------------------- ! 775 776 lect = .false. ! If true, read a time record 777 778 ! Some time variables for monthly climatological forcing: 779 ! ******************************************************* 780 !!gm here use directely daymod variables 781 782 iman = INT( raamo ) ! Number of months in a year 783 784 i15 = INT( 2*REAL( nday, wp ) / ( REAL( nmonth_len(nmonth), wp ) + 0.5 ) ) 785 ! i15=0 if the current day is in the first half of the month, else i15=1 786 787 imois = nmonth + i15 - 1 ! imois is the first month record 788 IF( imois == 0 ) imois = iman 789 790 ! Time variable for non-climatological forcing: 791 ! ********************************************* 792 793 itimer = ((kt-1)-nit000+1)*rdt ! current time in seconds for interpolation 794 itimer = itimer + jit*rdt/REAL(nn_baro,wp) ! in non-climatological case 795 796 IF ( ln_tides ) THEN 797 798 ! -------------------------------------! 799 ! Update BDY fields with tidal forcing ! 800 ! -------------------------------------! 801 802 CALL tide_update( kt, jit ) 803 804 ENDIF 805 806 IF ( ln_dyn_fla ) THEN 807 808 ! -------------------------------------! 809 ! Update BDY fields with model data ! 810 ! -------------------------------------! 811 812 ! !-------------------! 813 IF( kt == nit000 .and. jit ==2 ) THEN ! First call only ! 814 ! !-------------------! 815 istep_bt(:) = 0 816 nbdy_b_bt = 0 817 nbdy_a_bt = 0 818 819 ! Get time information from bdy data file 820 ! *************************************** 821 822 IF(lwp) WRITE(numout,*) 823 IF(lwp) WRITE(numout,*) 'bdy_dta_fla :Initialize unstructured boundary data for barotropic variables.' 824 IF(lwp) WRITE(numout,*) '~~~~~~~' 825 826 IF( nn_dtactl == 0 ) THEN 827 IF(lwp) WRITE(numout,*) 'Bdy data are taken from initial conditions' 828 829 ELSEIF (nn_dtactl == 1) THEN 830 IF(lwp) WRITE(numout,*) 'Bdy data are read in netcdf files' 831 832 dayfrac = adatrj - REAL(itimer,wp)/86400. ! day fraction at time step kt-1 833 dayfrac = dayfrac - INT (dayfrac) ! 834 totime = (nitend-nit000+1)*rdt ! Total time of the run to verify that all the 835 ! necessary time dumps in file are included 836 837 clfile(4) = cn_dta_fla_T 838 clfile(5) = cn_dta_fla_U 839 clfile(6) = cn_dta_fla_V 840 841 DO igrd = 4,6 842 843 CALL iom_open( clfile(igrd), inum ) 844 CALL iom_gettime( inum, zstepr, kntime=ntimes_bdy_bt, cdunits=clunits ) 845 846 SELECT CASE( igrd ) 847 CASE (4) 848 numbdyt_bt = inum 849 CASE (5) 850 numbdyu_bt = inum 851 CASE (6) 852 numbdyv_bt = inum 853 END SELECT 854 855 ! Calculate time offset 856 READ(clunits,7000) iyear0, imonth0, iday0, ihours0, iminutes0, isec0 857 ! Convert time origin in file to julian days 858 isec0 = isec0 + ihours0*60.*60. + iminutes0*60. 859 CALL ymds2ju(iyear0, imonth0, iday0, REAL(isec0, wp), dayjul0) 860 ! Compute model initialization time 861 iyear = ndastp / 10000 862 imonth = ( ndastp - iyear * 10000 ) / 100 863 iday = ndastp - iyear * 10000 - imonth * 100 864 isecs = dayfrac * 86400 865 CALL ymds2ju(iyear, imonth, iday, REAL(isecs, wp) , zdayjulini) 866 ! zoffset from initialization date: 867 zoffset = (dayjul0-zdayjulini)*86400 868 ! 869 870 7000 FORMAT('seconds since ', I4.4,'-',I2.2,'-',I2.2,' ',I2.2,':',I2.2,':',I2.2) 871 872 !! TO BE DONE... Check consistency between calendar from file 873 !! (available optionally from iom_gettime) and calendar in model 874 !! when calendar in model available outside of IOIPSL. 875 876 ! Check that there are not too many times in the file. 877 IF (ntimes_bdy_bt > jpbtime) CALL ctl_stop( & 878 'Number of time dumps in bdy file exceed jpbtime parameter', & 879 'Check file:' // TRIM(clfile(igrd)) ) 880 881 ! Check that time array increases (or interp will fail): 882 DO it = 2, ntimes_bdy_bt 883 IF ( zstepr(it-1) >= zstepr(it) ) THEN 884 CALL ctl_stop('Time array in unstructured boundary data file', & 885 'does not continuously increase.', & 886 'Check file:' // TRIM(clfile(igrd)) ) 887 EXIT 888 END IF 889 END DO 890 891 IF ( .NOT. ln_clim ) THEN 892 ! Check that times in file span model run time: 893 894 ! Note: the fields may be time means, so we allow nit000 to be before 895 ! first time in the file, provided that it falls inside the meaning 896 ! period of the first field. Until we can get the meaning period 897 ! from the file, use the interval between fields as a proxy. 898 ! If nit000 is before the first time, use the value at first time 899 ! instead of extrapolating. This is done by putting time 1 into 900 ! both time levels. 901 ! The same applies to the last time level: see setting of lect below. 902 903 IF ( ntimes_bdy_bt == 1 ) CALL ctl_stop( & 904 'There is only one time dump in data files', & 905 'Set ln_clim=.true. in namelist for constant bdy forcing.' ) 906 907 zinterval_s = zstepr(2) - zstepr(1) 908 zinterval_e = zstepr(ntimes_bdy_bt) - zstepr(ntimes_bdy_bt-1) 909 910 IF( zstepr(1) + zoffset > 0 ) THEN 911 WRITE(ctmp1,*) 'Check file: ', clfile(igrd) 912 CALL ctl_stop( 'First time dump in bdy file is after model initial time', ctmp1 ) 913 END IF 914 IF( zstepr(ntimes_bdy_bt) + zoffset < totime ) THEN 915 WRITE(ctmp1,*) 'Check file: ', clfile(igrd) 916 CALL ctl_stop( 'Last time dump in bdy file is before model final time', ctmp1 ) 917 END IF 918 END IF ! .NOT. ln_clim 919 920 IF ( igrd .EQ. 4) THEN 921 ntimes_bdyt = ntimes_bdy_bt 922 zoffsett = zoffset 923 istept(:) = INT( zstepr(:) + zoffset ) 924 ELSE IF (igrd .EQ. 5) THEN 925 ntimes_bdyu = ntimes_bdy_bt 926 zoffsetu = zoffset 927 istepu(:) = INT( zstepr(:) + zoffset ) 928 ELSE IF (igrd .EQ. 6) THEN 929 ntimes_bdyv = ntimes_bdy_bt 930 zoffsetv = zoffset 931 istepv(:) = INT( zstepr(:) + zoffset ) 932 ENDIF 933 934 ENDDO 935 936 ! Verify time consistency between files 937 938 IF ( ntimes_bdyu /= ntimes_bdyt .OR. ntimes_bdyv /= ntimes_bdyt ) THEN 939 CALL ctl_stop( & 940 'Time axis lengths differ between bdy data files', & 941 'Multiple time frequencies not implemented yet' ) 942 ELSE 943 ntimes_bdy_bt = ntimes_bdyt 944 ENDIF 945 946 IF (zoffsetu.NE.zoffsett .OR. zoffsetv.NE.zoffsett) THEN 947 CALL ctl_stop( & 948 'Bdy data files must have the same time origin', & 949 'Multiple time frequencies not implemented yet' ) 950 ENDIF 951 zoffset = zoffsett 952 953 !! Check that times are the same in the three files... HERE. 954 istep_bt(:) = istept(:) 955 956 ! Check number of time dumps: 957 IF (ln_clim) THEN 958 SELECT CASE ( ntimes_bdy_bt ) 959 CASE( 1 ) 960 IF(lwp) WRITE(numout,*) 961 IF(lwp) WRITE(numout,*) 'We assume constant boundary forcing from bdy data files' 962 IF(lwp) WRITE(numout,*) 963 CASE( 12 ) 964 IF(lwp) WRITE(numout,*) 965 IF(lwp) WRITE(numout,*) 'We assume monthly (and cyclic) boundary forcing from bdy data files' 966 IF(lwp) WRITE(numout,*) 967 CASE DEFAULT 968 CALL ctl_stop( & 969 'For climatological boundary forcing (ln_clim=.true.),',& 970 'bdy data files must contain 1 or 12 time dumps.' ) 971 END SELECT 972 ENDIF 973 974 ! Find index of first record to read (before first model time). 975 976 it=1 977 DO WHILE ( ((istep_bt(it+1)) <= 0 ).AND.(it.LE.(ntimes_bdy_bt-1))) 978 it=it+1 979 END DO 980 nbdy_b_bt = it 981 982 IF(lwp) WRITE(numout,*) 'Time offset is ',zoffset 983 IF(lwp) WRITE(numout,*) 'First record to read is ',nbdy_b_bt 984 985 ENDIF ! endif (nn_dtactl == 1) 986 987 ! 1.2 Read first record in file if necessary (ie if nn_dtactl == 1) 988 ! ***************************************************************** 989 990 IF ( nn_dtactl == 0) THEN 991 ! boundary data arrays are filled with initial conditions 992 igrd = 5 ! U-points data 993 DO ib = 1, nblen(igrd) 994 ubtbdy(ib) = un(nbi(ib,igrd), nbj(ib,igrd), 1) 995 END DO 996 997 igrd = 6 ! V-points data 998 DO ib = 1, nblen(igrd) 999 vbtbdy(ib) = vn(nbi(ib,igrd), nbj(ib,igrd), 1) 1000 END DO 1001 1002 igrd = 4 ! T-points data 1003 DO ib = 1, nblen(igrd) 1004 sshbdy(ib) = sshn(nbi(ib,igrd), nbj(ib,igrd)) 1005 END DO 1006 1007 ELSEIF (nn_dtactl == 1) THEN 1008 1009 ! Set first record in the climatological case: 1010 IF ((ln_clim).AND.(ntimes_bdy_bt==1)) THEN 1011 nbdy_a_bt = 1 1012 ELSEIF ((ln_clim).AND.(ntimes_bdy_bt==iman)) THEN 1013 nbdy_b_bt = 0 1014 nbdy_a_bt = imois 1015 ELSE 1016 nbdy_a_bt = nbdy_b_bt 1017 END IF 1018 1019 ! Open Netcdf files: 1020 1021 CALL iom_open ( cn_dta_fla_T, numbdyt_bt ) 1022 CALL iom_open ( cn_dta_fla_U, numbdyu_bt ) 1023 CALL iom_open ( cn_dta_fla_V, numbdyv_bt ) 1024 1025 ! Read first record: 1026 ipj=1 1027 igrd=4 1028 ipi=nblendta(igrd) 1029 1030 ! ssh 1031 igrd=4 1032 IF ( nblendta(igrd) .le. 0 ) THEN 1033 idvar = iom_varid( numbdyt_bt,'sossheig' ) 1034 nblendta(igrd) = iom_file(numbdyt_bt)%dimsz(1,idvar) 1035 ENDIF 1036 WRITE(numout,*) 'Dim size for sossheig is ',nblendta(igrd) 1037 ipi=nblendta(igrd) 1038 1039 CALL iom_get ( numbdyt_bt, jpdom_unknown,'sossheig',zdta(1:ipi,1:ipj),nbdy_a_bt ) 1040 1041 DO ib=1, nblen(igrd) 1042 sshbdydta(ib,2) = zdta(nbmap(ib,igrd),1) 1043 END DO 1044 1045 ! u-velocity 1046 igrd=5 1047 IF ( nblendta(igrd) .le. 0 ) THEN 1048 idvar = iom_varid( numbdyu_bt,'vobtcrtx' ) 1049 nblendta(igrd) = iom_file(numbdyu_bt)%dimsz(1,idvar) 1050 ENDIF 1051 WRITE(numout,*) 'Dim size for vobtcrtx is ',nblendta(igrd) 1052 ipi=nblendta(igrd) 1053 1054 CALL iom_get ( numbdyu_bt, jpdom_unknown,'vobtcrtx',zdta(1:ipi,1:ipj),nbdy_a_bt ) 1055 1056 DO ib=1, nblen(igrd) 1057 ubtbdydta(ib,2) = zdta(nbmap(ib,igrd),1) 1058 END DO 1059 1060 ! v-velocity 1061 igrd=6 1062 IF ( nblendta(igrd) .le. 0 ) THEN 1063 idvar = iom_varid( numbdyv_bt,'vobtcrty' ) 1064 nblendta(igrd) = iom_file(numbdyv_bt)%dimsz(1,idvar) 1065 ENDIF 1066 WRITE(numout,*) 'Dim size for vobtcrty is ',nblendta(igrd) 1067 ipi=nblendta(igrd) 1068 1069 CALL iom_get ( numbdyv_bt, jpdom_unknown,'vobtcrty',zdta(1:ipi,1:ipj),nbdy_a_bt ) 1070 1071 DO ib=1, nblen(igrd) 1072 vbtbdydta(ib,2) = zdta(nbmap(ib,igrd),1) 1073 END DO 1074 1075 END IF 1076 1077 ! In the case of constant boundary forcing fill bdy arrays once for all 1078 IF ((ln_clim).AND.(ntimes_bdy_bt==1)) THEN 1079 1080 ubtbdy (:) = ubtbdydta (:,2) 1081 vbtbdy (:) = vbtbdydta (:,2) 1082 sshbdy (:) = sshbdydta (:,2) 1083 1084 CALL iom_close( numbdyt_bt ) 1085 CALL iom_close( numbdyu_bt ) 1086 CALL iom_close( numbdyv_bt ) 1087 1088 END IF 1089 1090 ENDIF ! End if nit000 1091 1092 ! -------------------- ! 1093 ! 2. At each time step ! 1094 ! -------------------- ! 1095 1096 IF ((nn_dtactl==1).AND.(ntimes_bdy_bt>1)) THEN 1097 1098 ! 2.1 Read one more record if necessary 1099 !************************************** 1100 1101 IF ( (ln_clim).AND.(imois/=nbdy_b_bt) ) THEN ! remember that nbdy_b_bt=0 for kt=nit000 1102 nbdy_b_bt = imois 1103 nbdy_a_bt = imois+1 1104 nbdy_b_bt = MOD( nbdy_b_bt, iman ) 1105 IF( nbdy_b_bt == 0 ) nbdy_b_bt = iman 1106 nbdy_a_bt = MOD( nbdy_a_bt, iman ) 1107 IF( nbdy_a_bt == 0 ) nbdy_a_bt = iman 1108 lect=.true. 1109 1110 ELSEIF ((.NOT.ln_clim).AND.(itimer >= istep_bt(nbdy_a_bt))) THEN 1111 nbdy_b_bt=nbdy_a_bt 1112 nbdy_a_bt=nbdy_a_bt+1 1113 lect=.true. 1114 END IF 1115 1116 IF (lect) THEN 1117 1118 ! Swap arrays 1119 sshbdydta(:,1) = sshbdydta(:,2) 1120 ubtbdydta(:,1) = ubtbdydta(:,2) 1121 vbtbdydta(:,1) = vbtbdydta(:,2) 1122 1123 ! read another set 1124 1125 ipj=1 1126 ipk=jpk 1127 igrd=4 1128 ipi=nblendta(igrd) 1129 1130 1131 ! ssh 1132 igrd=4 1133 ipi=nblendta(igrd) 1134 1135 CALL iom_get ( numbdyt_bt, jpdom_unknown,'sossheig',zdta(1:ipi,1:ipj),nbdy_a_bt ) 1136 1137 DO ib=1, nblen(igrd) 1138 sshbdydta(ib,2) = zdta(nbmap(ib,igrd),1) 1139 END DO 1140 1141 ! u-velocity 1142 igrd=5 1143 ipi=nblendta(igrd) 1144 1145 CALL iom_get ( numbdyu_bt, jpdom_unknown,'vobtcrtx',zdta(1:ipi,1:ipj),nbdy_a_bt ) 1146 1147 DO ib=1, nblen(igrd) 1148 ubtbdydta(ib,2) = zdta(nbmap(ib,igrd),1) 1149 END DO 1150 1151 ! v-velocity 1152 igrd=6 1153 ipi=nblendta(igrd) 1154 1155 CALL iom_get ( numbdyv_bt, jpdom_unknown,'vobtcrty',zdta(1:ipi,1:ipj),nbdy_a_bt ) 1156 1157 DO ib=1, nblen(igrd) 1158 vbtbdydta(ib,2) = zdta(nbmap(ib,igrd),1) 1159 END DO 1160 1161 1162 IF(lwp) WRITE(numout,*) 'bdy_dta_fla : first record file used nbdy_b_bt ',nbdy_b_bt 1163 IF(lwp) WRITE(numout,*) '~~~~~~~~ last record file used nbdy_a_bt ',nbdy_a_bt 1164 IF (.NOT.ln_clim) THEN 1165 IF(lwp) WRITE(numout,*) 'first record time (s): ', istep_bt(nbdy_b_bt) 1166 IF(lwp) WRITE(numout,*) 'model time (s) : ', itimer 1167 IF(lwp) WRITE(numout,*) 'second record time (s): ', istep_bt(nbdy_a_bt) 1168 ENDIF 1169 END IF ! end lect=.true. 1170 1171 1172 ! 2.2 Interpolate linearly: 1173 ! *************************** 1174 1175 IF (ln_clim) THEN 1176 zxy = REAL( nday, wp ) / REAL( nmonth_len(nbdy_b_bt), wp ) + 0.5 - i15 1177 ELSE 1178 zxy = REAL(istep_bt(nbdy_b_bt)-itimer, wp) / REAL(istep_bt(nbdy_b_bt)-istep_bt(nbdy_a_bt), wp) 1179 END IF 1180 1181 igrd=4 1182 DO ib=1, nblen(igrd) 1183 sshbdy(ib) = zxy * sshbdydta(ib,2) + & 1184 (1.-zxy) * sshbdydta(ib,1) 1185 END DO 1186 1187 igrd=5 1188 DO ib=1, nblen(igrd) 1189 ubtbdy(ib) = zxy * ubtbdydta(ib,2) + & 1190 (1.-zxy) * ubtbdydta(ib,1) 1191 END DO 1192 1193 igrd=6 1194 DO ib=1, nblen(igrd) 1195 vbtbdy(ib) = zxy * vbtbdydta(ib,2) + & 1196 (1.-zxy) * vbtbdydta(ib,1) 1197 END DO 1198 1199 1200 END IF !end if ((nn_dtactl==1).AND.(ntimes_bdy_bt>1)) 1201 1202 ! ------------------- ! 1203 ! Last call kt=nitend ! 1204 ! ------------------- ! 1205 1206 ! Closing of the 3 files 1207 IF( kt == nitend .and. jit == icycl ) THEN 1208 CALL iom_close( numbdyt_bt ) 1209 CALL iom_close( numbdyu_bt ) 1210 CALL iom_close( numbdyv_bt ) 1211 ENDIF 1212 1213 ENDIF ! ln_dyn_frs 1214 1215 END SUBROUTINE bdy_dta_fla 1216 603 IF( nn_dyn2d(ib_bdy) .ne. jp_frs ) THEN 604 jfld = jfld + 1 605 dta_bdy(ib_bdy)%ssh => bf(jfld)%fnow(:,1,1) 606 ENDIF 607 jfld = jfld + 1 608 dta_bdy(ib_bdy)%u2d => bf(jfld)%fnow(:,1,1) 609 jfld = jfld + 1 610 dta_bdy(ib_bdy)%v2d => bf(jfld)%fnow(:,1,1) 611 ENDIF 612 ENDIF 613 614 IF ( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN 615 IF( nn_dyn3d(ib_bdy) .eq. jp_frs ) THEN 616 ilen0(1:3) = nblen(1:3) 617 ELSE 618 ilen0(1:3) = nblenrim(1:3) 619 ENDIF 620 ALLOCATE( dta_bdy(ib_bdy)%u3d(ilen0(2),jpk) ) 621 ALLOCATE( dta_bdy(ib_bdy)%v3d(ilen0(3),jpk) ) 622 ENDIF 623 IF ( ( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ).or. & 624 & ( ln_full_vel_array(ib_bdy) .and. nn_dyn2d(ib_bdy) .gt. 0 .and. & 625 & ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN 626 jfld = jfld + 1 627 dta_bdy(ib_bdy)%u3d => bf(jfld)%fnow(:,1,:) 628 jfld = jfld + 1 629 dta_bdy(ib_bdy)%v3d => bf(jfld)%fnow(:,1,:) 630 ENDIF 631 632 IF (nn_tra(ib_bdy) .gt. 0) THEN 633 IF( nn_tra_dta(ib_bdy) .eq. 0 ) THEN 634 IF( nn_tra(ib_bdy) .eq. jp_frs ) THEN 635 ilen0(1:3) = nblen(1:3) 636 ELSE 637 ilen0(1:3) = nblenrim(1:3) 638 ENDIF 639 ALLOCATE( dta_bdy(ib_bdy)%tem(ilen0(1),jpk) ) 640 ALLOCATE( dta_bdy(ib_bdy)%sal(ilen0(1),jpk) ) 641 ELSE 642 jfld = jfld + 1 643 dta_bdy(ib_bdy)%tem => bf(jfld)%fnow(:,1,:) 644 jfld = jfld + 1 645 dta_bdy(ib_bdy)%sal => bf(jfld)%fnow(:,1,:) 646 ENDIF 647 ENDIF 648 649 #if defined key_lim2 650 IF (nn_ice_lim2(ib_bdy) .gt. 0) THEN 651 IF( nn_ice_lim2_dta(ib_bdy) .eq. 0 ) THEN 652 IF( nn_ice_lim2(ib_bdy) .eq. jp_frs ) THEN 653 ilen0(1:3) = nblen(1:3) 654 ELSE 655 ilen0(1:3) = nblenrim(1:3) 656 ENDIF 657 ALLOCATE( dta_bdy(ib_bdy)%frld(ilen0(1)) ) 658 ALLOCATE( dta_bdy(ib_bdy)%hicif(ilen0(1)) ) 659 ALLOCATE( dta_bdy(ib_bdy)%hsnif(ilen0(1)) ) 660 ELSE 661 jfld = jfld + 1 662 dta_bdy(ib_bdy)%frld => bf(jfld)%fnow(:,1,1) 663 jfld = jfld + 1 664 dta_bdy(ib_bdy)%hicif => bf(jfld)%fnow(:,1,1) 665 jfld = jfld + 1 666 dta_bdy(ib_bdy)%hsnif => bf(jfld)%fnow(:,1,1) 667 ENDIF 668 ENDIF 669 #endif 670 671 ENDDO ! ib_bdy 672 673 END SUBROUTINE bdy_dta_init 1217 674 1218 675 #else 1219 676 !!---------------------------------------------------------------------- 1220 !! Dummy module NO UnstructOpen Boundary Conditions677 !! Dummy module NO Open Boundary Conditions 1221 678 !!---------------------------------------------------------------------- 1222 679 CONTAINS 1223 SUBROUTINE bdy_dta_frs( kt ) ! Empty routine 1224 WRITE(*,*) 'bdy_dta_frs: You should not have seen this print! error?', kt 1225 END SUBROUTINE bdy_dta_frs 1226 SUBROUTINE bdy_dta_fla( kt, kit, icycle ) ! Empty routine 1227 WRITE(*,*) 'bdy_dta_frs: You should not have seen this print! error?', kt, kit 1228 END SUBROUTINE bdy_dta_fla 680 SUBROUTINE bdy_dta( kt, jit, time_offset ) ! Empty routine 681 INTEGER, INTENT( in ) :: kt 682 INTEGER, INTENT( in ), OPTIONAL :: jit 683 INTEGER, INTENT( in ), OPTIONAL :: time_offset 684 WRITE(*,*) 'bdy_dta: You should not have seen this print! error?', kt 685 END SUBROUTINE bdy_dta 686 SUBROUTINE bdy_dta_init() ! Empty routine 687 WRITE(*,*) 'bdy_dta_init: You should not have seen this print! error?' 688 END SUBROUTINE bdy_dta_init 1229 689 #endif 1230 690 -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90
r2528 r3116 15 15 !! 'key_bdy' : Unstructured Open Boundary Condition 16 16 !!---------------------------------------------------------------------- 17 !! bdy_dyn _frs : relaxation of velocities on unstructured open boundary18 !! bdy_dyn _fla : Flather condition for barotropic solution17 !! bdy_dyn3d : apply open boundary conditions to baroclinic velocities 18 !! bdy_dyn3d_frs : apply Flow Relaxation Scheme 19 19 !!---------------------------------------------------------------------- 20 20 USE oce ! ocean dynamics and tracers 21 21 USE dom_oce ! ocean space and time domain 22 USE dynspg_oce 22 23 USE bdy_oce ! ocean open boundary conditions 23 USE dynspg_oce ! for barotropic variables24 USE phycst ! physical constants24 USE bdydyn2d ! open boundary conditions for barotropic solution 25 USE bdydyn3d ! open boundary conditions for baroclinic velocities 25 26 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 26 USE bdytides ! for tidal harmonic forcing at boundary27 27 USE in_out_manager ! 28 28 … … 30 30 PRIVATE 31 31 32 PUBLIC bdy_dyn_frs ! routine called in dynspg_flt (free surface case ONLY) 33 # if defined key_dynspg_exp || defined key_dynspg_ts 34 PUBLIC bdy_dyn_fla ! routine called in dynspg_flt (free surface case ONLY) 35 # endif 32 PUBLIC bdy_dyn ! routine called in dynspg_flt (if lk_dynspg_flt) or 33 ! dyn_nxt (if lk_dynspg_ts or lk_dynspg_exp) 36 34 35 # include "domzgr_substitute.h90" 37 36 !!---------------------------------------------------------------------- 38 37 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 42 41 CONTAINS 43 42 44 SUBROUTINE bdy_dyn _frs( kt)43 SUBROUTINE bdy_dyn( kt, dyn3d_only ) 45 44 !!---------------------------------------------------------------------- 46 !! *** SUBROUTINE bdy_dyn _frs***45 !! *** SUBROUTINE bdy_dyn *** 47 46 !! 48 !! ** Purpose : - Apply the Flow Relaxation Scheme for dynamic in the 49 !! case of unstructured open boundaries. 47 !! ** Purpose : - Wrapper routine for bdy_dyn2d and bdy_dyn3d. 50 48 !! 51 !! References :- Engedahl H., 1995: Use of the flow relaxation scheme in52 !! a three-dimensional baroclinic ocean model with realistic53 !! topography. Tellus, 365-382.54 49 !!---------------------------------------------------------------------- 55 INTEGER, INTENT( in ) :: kt ! Main time step counter 50 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 51 USE wrk_nemo, ONLY: wrk_2d_7, wrk_2d_8 ! 2D workspace 56 52 !! 57 INTEGER :: jb, jk ! dummy loop indices 58 INTEGER :: ii, ij, igrd ! local integers 59 REAL(wp) :: zwgt ! boundary weight 60 !!---------------------------------------------------------------------- 61 ! 62 IF(ln_dyn_frs) THEN ! If this is false, then this routine does nothing. 63 ! 64 IF( kt == nit000 ) THEN 65 IF(lwp) WRITE(numout,*) 66 IF(lwp) WRITE(numout,*) 'bdy_dyn_frs : Flow Relaxation Scheme on momentum' 67 IF(lwp) WRITE(numout,*) '~~~~~~~' 68 ENDIF 69 ! 70 igrd = 2 ! Relaxation of zonal velocity 71 DO jb = 1, nblen(igrd) 72 DO jk = 1, jpkm1 73 ii = nbi(jb,igrd) 74 ij = nbj(jb,igrd) 75 zwgt = nbw(jb,igrd) 76 ua(ii,ij,jk) = ( ua(ii,ij,jk) * ( 1.- zwgt ) + ubdy(jb,jk) * zwgt ) * umask(ii,ij,jk) 77 END DO 78 END DO 79 ! 80 igrd = 3 ! Relaxation of meridional velocity 81 DO jb = 1, nblen(igrd) 82 DO jk = 1, jpkm1 83 ii = nbi(jb,igrd) 84 ij = nbj(jb,igrd) 85 zwgt = nbw(jb,igrd) 86 va(ii,ij,jk) = ( va(ii,ij,jk) * ( 1.- zwgt ) + vbdy(jb,jk) * zwgt ) * vmask(ii,ij,jk) 87 END DO 88 END DO 89 CALL lbc_lnk( ua, 'U', -1. ) ; CALL lbc_lnk( va, 'V', -1. ) ! Boundary points should be updated 90 ! 91 ENDIF ! ln_dyn_frs 92 ! 93 END SUBROUTINE bdy_dyn_frs 53 INTEGER, INTENT( in ) :: kt ! Main time step counter 54 LOGICAL, INTENT( in ), OPTIONAL :: dyn3d_only ! T => only update baroclinic velocities 55 !! 56 INTEGER :: jk,ii,ij,ib,igrd ! Loop counter 57 LOGICAL :: ll_dyn2d, ll_dyn3d 58 !! 94 59 60 IF(wrk_in_use(2, 7,8) ) THEN 61 CALL ctl_stop('bdy_dyn: ERROR: requested workspace arrays are unavailable.') ; RETURN 62 END IF 95 63 96 # if defined key_dynspg_exp || defined key_dynspg_ts 97 !!---------------------------------------------------------------------- 98 !! 'key_dynspg_exp' OR explicit sea surface height 99 !! 'key_dynspg_ts ' split-explicit sea surface height 100 !!---------------------------------------------------------------------- 101 102 !! Option to use Flather with dynspg_flt not coded yet... 64 ll_dyn2d = .true. 65 ll_dyn3d = .true. 103 66 104 SUBROUTINE bdy_dyn_fla( pssh ) 105 !!---------------------------------------------------------------------- 106 !! *** SUBROUTINE bdy_dyn_fla *** 107 !! 108 !! - Apply Flather boundary conditions on normal barotropic velocities 109 !! (ln_dyn_fla=.true. or ln_tides=.true.) 110 !! 111 !! ** WARNINGS about FLATHER implementation: 112 !!1. According to Palma and Matano, 1998 "after ssh" is used. 113 !! In ROMS and POM implementations, it is "now ssh". In the current 114 !! implementation (tested only in the EEL-R5 conf.), both cases were unstable. 115 !! So I use "before ssh" in the following. 116 !! 117 !!2. We assume that the normal ssh gradient at the bdy is zero. As a matter of 118 !! fact, the model ssh just inside the dynamical boundary is used (the outside 119 !! ssh in the code is not updated). 120 !! 121 !! References: Flather, R. A., 1976: A tidal model of the northwest European 122 !! continental shelf. Mem. Soc. R. Sci. Liege, Ser. 6,10, 141-164. 123 !!---------------------------------------------------------------------- 124 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pssh 67 IF( PRESENT(dyn3d_only) ) THEN 68 IF( dyn3d_only ) ll_dyn2d = .false. 69 ENDIF 125 70 126 INTEGER :: jb, igrd ! dummy loop indices 127 INTEGER :: ii, ij, iim1, iip1, ijm1, ijp1 ! 2D addresses 128 REAL(wp) :: zcorr ! Flather correction 129 REAL(wp) :: zforc ! temporary scalar 130 !!---------------------------------------------------------------------- 71 !------------------------------------------------------- 72 ! Set pointers 73 !------------------------------------------------------- 131 74 132 ! ---------------------------------!133 ! Flather boundary conditions :!134 ! ---------------------------------!135 136 IF(ln_dyn_fla .OR. ln_tides) THEN ! If these are both false, then this routine does nothing.75 pssh => sshn 76 phur => hur 77 phvr => hvr 78 pu2d => wrk_2d_7 79 pv2d => wrk_2d_8 137 80 138 ! Fill temporary array with ssh data (here spgu): 139 igrd = 4 140 spgu(:,:) = 0.0 141 DO jb = 1, nblenrim(igrd) 142 ii = nbi(jb,igrd) 143 ij = nbj(jb,igrd) 144 IF( ln_dyn_fla ) spgu(ii, ij) = sshbdy(jb) 145 IF( ln_tides ) spgu(ii, ij) = spgu(ii, ij) + sshtide(jb) 146 END DO 147 ! 148 igrd = 5 ! Flather bc on u-velocity; 149 ! ! remember that flagu=-1 if normal velocity direction is outward 150 ! ! I think we should rather use after ssh ? 151 DO jb = 1, nblenrim(igrd) 152 ii = nbi(jb,igrd) 153 ij = nbj(jb,igrd) 154 iim1 = ii + MAX( 0, INT( flagu(jb) ) ) ! T pts i-indice inside the boundary 155 iip1 = ii - MIN( 0, INT( flagu(jb) ) ) ! T pts i-indice outside the boundary 156 ! 157 zcorr = - flagu(jb) * SQRT( grav * hur_e(ii, ij) ) * ( pssh(iim1, ij) - spgu(iip1,ij) ) 158 zforc = ubtbdy(jb) + utide(jb) 159 ua_e(ii,ij) = zforc + zcorr * umask(ii,ij,1) 160 END DO 161 ! 162 igrd = 6 ! Flather bc on v-velocity 163 ! ! remember that flagv=-1 if normal velocity direction is outward 164 DO jb = 1, nblenrim(igrd) 165 ii = nbi(jb,igrd) 166 ij = nbj(jb,igrd) 167 ijm1 = ij + MAX( 0, INT( flagv(jb) ) ) ! T pts j-indice inside the boundary 168 ijp1 = ij - MIN( 0, INT( flagv(jb) ) ) ! T pts j-indice outside the boundary 169 ! 170 zcorr = - flagv(jb) * SQRT( grav * hvr_e(ii, ij) ) * ( pssh(ii, ijm1) - spgu(ii,ijp1) ) 171 zforc = vbtbdy(jb) + vtide(jb) 172 va_e(ii,ij) = zforc + zcorr * vmask(ii,ij,1) 173 END DO 174 CALL lbc_lnk( ua_e, 'U', -1. ) ! Boundary points should be updated 175 CALL lbc_lnk( va_e, 'V', -1. ) ! 176 ! 177 ENDIF ! ln_dyn_fla .or. ln_tides 178 ! 179 END SUBROUTINE bdy_dyn_fla 180 #endif 81 !------------------------------------------------------- 82 ! Split velocities into barotropic and baroclinic parts 83 !------------------------------------------------------- 84 85 pu2d(:,:) = 0.e0 86 pv2d(:,:) = 0.e0 87 DO jk = 1, jpkm1 !! Vertically integrated momentum trends 88 pu2d(:,:) = pu2d(:,:) + fse3u(:,:,jk) * umask(:,:,jk) * ua(:,:,jk) 89 pv2d(:,:) = pv2d(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) * va(:,:,jk) 90 END DO 91 pu2d(:,:) = pu2d(:,:) * phur(:,:) 92 pv2d(:,:) = pv2d(:,:) * phvr(:,:) 93 DO jk = 1 , jpkm1 94 ua(:,:,jk) = ua(:,:,jk) - pu2d(:,:) 95 va(:,:,jk) = va(:,:,jk) - pv2d(:,:) 96 END DO 97 98 !------------------------------------------------------- 99 ! Apply boundary conditions to barotropic and baroclinic 100 ! parts separately 101 !------------------------------------------------------- 102 103 IF( ll_dyn2d ) CALL bdy_dyn2d( kt ) 104 105 IF( ll_dyn3d ) CALL bdy_dyn3d( kt ) 106 107 !------------------------------------------------------- 108 ! Recombine velocities 109 !------------------------------------------------------- 110 111 DO jk = 1 , jpkm1 112 ua(:,:,jk) = ( ua(:,:,jk) + pu2d(:,:) ) * umask(:,:,jk) 113 va(:,:,jk) = ( va(:,:,jk) + pv2d(:,:) ) * vmask(:,:,jk) 114 END DO 115 116 IF(wrk_not_released(2, 7,8) ) CALL ctl_stop('bdy_dyn: ERROR: failed to release workspace arrays.') 117 118 END SUBROUTINE bdy_dyn 181 119 182 120 #else … … 185 123 !!---------------------------------------------------------------------- 186 124 CONTAINS 187 SUBROUTINE bdy_dyn_frs( kt ) ! Empty routine 188 WRITE(*,*) 'bdy_dyn_frs: You should not have seen this print! error?', kt 189 END SUBROUTINE bdy_dyn_frs 190 SUBROUTINE bdy_dyn_fla( pssh ) ! Empty routine 191 REAL :: pssh(:,:) 192 WRITE(*,*) 'bdy_dyn_fla: You should not have seen this print! error?', pssh(1,1) 193 END SUBROUTINE bdy_dyn_fla 125 SUBROUTINE bdy_dyn( kt ) ! Empty routine 126 WRITE(*,*) 'bdy_dyn: You should not have seen this print! error?', kt 127 END SUBROUTINE bdy_dyn 194 128 #endif 195 129 -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
r2715 r3116 10 10 !! 3.3 ! 2010-09 (E.O'Dea) updates for Shelf configurations 11 11 !! 3.3 ! 2010-09 (D.Storkey) add ice boundary conditions 12 !! 3.4 ! 2011 (D. Storkey, J. Chanut) OBC-BDY merge 13 !! ! --- Renamed bdyini.F90 -> bdyini.F90 --- 12 14 !!---------------------------------------------------------------------- 13 15 #if defined key_bdy … … 19 21 USE oce ! ocean dynamics and tracers variables 20 22 USE dom_oce ! ocean space and time domain 21 USE obc_par ! ocean open boundary conditions22 23 USE bdy_oce ! unstructured open boundary conditions 23 USE bdydta, ONLY: bdy_dta_alloc ! open boundary data24 USE bdytides ! tides at open boundaries initialization (tide_init routine)25 24 USE in_out_manager ! I/O units 26 25 USE lbclnk ! ocean lateral boundary conditions (or mpp link) … … 52 51 !! ** Input : bdy_init.nc, input file for unstructured open boundaries 53 52 !!---------------------------------------------------------------------- 54 INTEGER :: ii, ij, ik, igrd, ib, ir ! dummy loop indices 55 INTEGER :: icount, icountr, ib_len, ibr_max ! local integers 56 INTEGER :: iw, ie, is, in, inum, id_dummy ! - - 57 INTEGER :: igrd_start, igrd_end ! - - 58 REAL(wp) :: zefl, zwfl, znfl, zsfl ! local scalars 59 INTEGER, DIMENSION (2) :: kdimsz 60 INTEGER, DIMENSION(jpbdta, jpbgrd) :: nbidta, nbjdta ! Index arrays: i and j indices of bdy dta 61 INTEGER, DIMENSION(jpbdta, jpbgrd) :: nbrdta ! Discrete distance from rim points 62 REAL(wp), DIMENSION(jpidta,jpjdta) :: zmask ! global domain mask 63 REAL(wp), DIMENSION(jpbdta,1) :: zdta ! temporary array 64 CHARACTER(LEN=80),DIMENSION(6) :: clfile 53 ! namelist variables 54 !------------------- 55 INTEGER, PARAMETER :: jp_nseg = 100 56 INTEGER :: nbdysege, nbdysegw, nbdysegn, nbdysegs 57 INTEGER, DIMENSION(jp_nseg) :: jpieob, jpjedt, jpjeft 58 INTEGER, DIMENSION(jp_nseg) :: jpiwob, jpjwdt, jpjwft 59 INTEGER, DIMENSION(jp_nseg) :: jpjnob, jpindt, jpinft 60 INTEGER, DIMENSION(jp_nseg) :: jpjsob, jpisdt, jpisft 61 62 ! local variables 63 !------------------- 64 INTEGER :: ib_bdy, ii, ij, ik, igrd, ib, ir, iseg ! dummy loop indices 65 INTEGER :: icount, icountr, ibr_max, ilen1, ibm1 ! local integers 66 INTEGER :: iw, ie, is, in, inum, id_dummy ! - - 67 INTEGER :: igrd_start, igrd_end, jpbdta ! - - 68 INTEGER, POINTER :: nbi, nbj, nbr ! short cuts 69 REAL , POINTER :: flagu, flagv ! - - 70 REAL(wp) :: zefl, zwfl, znfl, zsfl ! local scalars 71 INTEGER, DIMENSION (2) :: kdimsz 72 INTEGER, DIMENSION(jpbgrd,jp_bdy) :: nblendta ! Length of index arrays 73 INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: nbidta, nbjdta ! Index arrays: i and j indices of bdy dta 74 INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: nbrdta ! Discrete distance from rim points 75 REAL(wp), DIMENSION(jpidta,jpjdta) :: zmask ! global domain mask 76 CHARACTER(LEN=80),DIMENSION(jpbgrd) :: clfile 77 CHARACTER(LEN=1),DIMENSION(jpbgrd) :: cgrid 65 78 !! 66 NAMELIST/nambdy/cn_mask, cn_dta_frs_T, cn_dta_frs_U, cn_dta_frs_V, & 67 & cn_dta_fla_T, cn_dta_fla_U, cn_dta_fla_V, & 68 & ln_tides, ln_clim, ln_vol, ln_mask, & 69 & ln_dyn_fla, ln_dyn_frs, ln_tra_frs,ln_ice_frs, & 70 & nn_dtactl, nn_rimwidth, nn_volctl 79 NAMELIST/nambdy/ nb_bdy, ln_coords_file, cn_coords_file, & 80 & ln_mask_file, cn_mask_file, nn_dyn2d, nn_dyn2d_dta, & 81 & nn_dyn3d, nn_dyn3d_dta, nn_tra, nn_tra_dta, & 82 #if defined key_lim2 83 & nn_ice_lim2, nn_ice_lim2_dta, & 84 #endif 85 & ln_vol, nn_volctl, & 86 & nn_rimwidth, nn_dmp2d_in, nn_dmp2d_out, & 87 & nn_dmp3d_in, nn_dmp3d_out 88 !! 89 NAMELIST/nambdy_index/ nbdysege, jpieob, jpjedt, jpjeft, & 90 nbdysegw, jpiwob, jpjwdt, jpjwft, & 91 nbdysegn, jpjnob, jpindt, jpinft, & 92 nbdysegs, jpjsob, jpisdt, jpisft 93 71 94 !!---------------------------------------------------------------------- 72 95 96 IF( bdy_oce_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'bdy_init : unable to allocate oce arrays' ) 97 73 98 IF(lwp) WRITE(numout,*) 74 IF(lwp) WRITE(numout,*) 'bdy_init : initialization of unstructuredopen boundaries'99 IF(lwp) WRITE(numout,*) 'bdy_init : initialization of open boundaries' 75 100 IF(lwp) WRITE(numout,*) '~~~~~~~~' 76 101 ! 77 ! ! allocate bdy_oce arrays78 IF( bdy_oce_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'bdy_init : unable to allocate oce arrays' )79 IF( bdy_dta_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'bdy_init : unable to allocate dta arrays' )80 102 81 103 IF( jperio /= 0 ) CALL ctl_stop( 'Cyclic or symmetric,', & 82 & ' and unstructured open boundary condition are not compatible' ) 83 84 IF( lk_obc ) CALL ctl_stop( 'Straight open boundaries,', & 85 & ' and unstructured open boundaries are not compatible' ) 86 87 ! --------------------------- 88 REWIND( numnam ) ! Read namelist parameters 104 & ' and general open boundary condition are not compatible' ) 105 106 cgrid= (/'t','u','v'/) 107 108 ! ----------------------------------------- 109 ! Initialise and read namelist parameters 110 ! ----------------------------------------- 111 112 nb_bdy = 0 113 ln_coords_file(:) = .false. 114 cn_coords_file(:) = '' 115 ln_mask_file = .false. 116 cn_mask_file(:) = '' 117 nn_dyn2d(:) = 0 118 nn_dyn2d_dta(:) = -1 ! uninitialised flag 119 nn_dyn3d(:) = 0 120 nn_dyn3d_dta(:) = -1 ! uninitialised flag 121 nn_tra(:) = 0 122 nn_tra_dta(:) = -1 ! uninitialised flag 123 #if defined key_lim2 124 nn_ice_lim2(:) = 0 125 nn_ice_lim2_dta(:)= -1 ! uninitialised flag 126 #endif 127 ln_vol = .false. 128 nn_volctl = -1 ! uninitialised flag 129 nn_rimwidth(:) = -1 ! uninitialised flag 130 nn_dmp2d_in(:) = -1 ! uninitialised flag 131 nn_dmp2d_out(:) = -1 ! uninitialised flag 132 nn_dmp3d_in(:) = -1 ! uninitialised flag 133 nn_dmp3d_out(:) = -1 ! uninitialised flag 134 135 REWIND( numnam ) 89 136 READ ( numnam, nambdy ) 137 138 ! ----------------------------------------- 139 ! Check and write out namelist parameters 140 ! ----------------------------------------- 90 141 91 142 ! ! control prints 92 143 IF(lwp) WRITE(numout,*) ' nambdy' 93 144 94 ! ! check type of data used (nn_dtactl value) 95 IF(lwp) WRITE(numout,*) 'nn_dtactl =', nn_dtactl 96 IF(lwp) WRITE(numout,*) 97 SELECT CASE( nn_dtactl ) ! 98 CASE( 0 ) ; IF(lwp) WRITE(numout,*) ' initial state used for bdy data' 99 CASE( 1 ) ; IF(lwp) WRITE(numout,*) ' boundary data taken from file' 100 CASE DEFAULT ; CALL ctl_stop( 'nn_dtactl must be 0 or 1' ) 101 END SELECT 102 103 IF(lwp) WRITE(numout,*) 104 IF(lwp) WRITE(numout,*) 'Boundary rim width for the FRS nn_rimwidth = ', nn_rimwidth 105 106 IF(lwp) WRITE(numout,*) 107 IF(lwp) WRITE(numout,*) ' nn_volctl = ', nn_volctl 108 109 IF( ln_vol ) THEN ! check volume conservation (nn_volctl value) 110 SELECT CASE ( nn_volctl ) 145 IF( nb_bdy .eq. 0 ) THEN 146 IF(lwp) WRITE(numout,*) 'nb_bdy = 0, NO OPEN BOUNDARIES APPLIED.' 147 ELSE 148 IF(lwp) WRITE(numout,*) 'Number of open boundary sets : ',nb_bdy 149 ENDIF 150 151 DO ib_bdy = 1,nb_bdy 152 IF(lwp) WRITE(numout,*) ' ' 153 IF(lwp) WRITE(numout,*) '------ Open boundary data set ',ib_bdy,'------' 154 155 IF( ln_coords_file(ib_bdy) ) THEN 156 IF(lwp) WRITE(numout,*) 'Boundary definition read from file '//TRIM(cn_coords_file(ib_bdy)) 157 ELSE 158 IF(lwp) WRITE(numout,*) 'Boundary defined in namelist.' 159 ENDIF 160 IF(lwp) WRITE(numout,*) 161 162 IF(lwp) WRITE(numout,*) 'Boundary conditions for barotropic solution: ' 163 SELECT CASE( nn_dyn2d(ib_bdy) ) 164 CASE( 0 ) ; IF(lwp) WRITE(numout,*) ' no open boundary condition' 165 CASE( 1 ) ; IF(lwp) WRITE(numout,*) ' Flow Relaxation Scheme' 166 CASE( 2 ) ; IF(lwp) WRITE(numout,*) ' Flather radiation condition' 167 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for nn_dyn2d' ) 168 END SELECT 169 IF( nn_dyn2d(ib_bdy) .gt. 0 ) THEN 170 SELECT CASE( nn_dyn2d_dta(ib_bdy) ) ! 171 CASE( 0 ) ; IF(lwp) WRITE(numout,*) ' initial state used for bdy data' 172 CASE( 1 ) ; IF(lwp) WRITE(numout,*) ' boundary data taken from file' 173 CASE( 2 ) ; IF(lwp) WRITE(numout,*) ' tidal harmonic forcing taken from file' 174 CASE( 3 ) ; IF(lwp) WRITE(numout,*) ' boundary data AND tidal harmonic forcing taken from files' 175 CASE DEFAULT ; CALL ctl_stop( 'nn_dyn2d_dta must be between 0 and 3' ) 176 END SELECT 177 ENDIF 178 IF(lwp) WRITE(numout,*) 179 180 IF(lwp) WRITE(numout,*) 'Boundary conditions for baroclinic velocities: ' 181 SELECT CASE( nn_dyn3d(ib_bdy) ) 182 CASE( 0 ) ; IF(lwp) WRITE(numout,*) ' no open boundary condition' 183 CASE( 1 ) ; IF(lwp) WRITE(numout,*) ' Flow Relaxation Scheme' 184 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for nn_dyn3d' ) 185 END SELECT 186 IF( nn_dyn3d(ib_bdy) .gt. 0 ) THEN 187 SELECT CASE( nn_dyn3d_dta(ib_bdy) ) ! 188 CASE( 0 ) ; IF(lwp) WRITE(numout,*) ' initial state used for bdy data' 189 CASE( 1 ) ; IF(lwp) WRITE(numout,*) ' boundary data taken from file' 190 CASE DEFAULT ; CALL ctl_stop( 'nn_dyn3d_dta must be 0 or 1' ) 191 END SELECT 192 ENDIF 193 IF(lwp) WRITE(numout,*) 194 195 IF(lwp) WRITE(numout,*) 'Boundary conditions for temperature and salinity: ' 196 SELECT CASE( nn_tra(ib_bdy) ) 197 CASE( 0 ) ; IF(lwp) WRITE(numout,*) ' no open boundary condition' 198 CASE( 1 ) ; IF(lwp) WRITE(numout,*) ' Flow Relaxation Scheme' 199 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for nn_tra' ) 200 END SELECT 201 IF( nn_tra(ib_bdy) .gt. 0 ) THEN 202 SELECT CASE( nn_tra_dta(ib_bdy) ) ! 203 CASE( 0 ) ; IF(lwp) WRITE(numout,*) ' initial state used for bdy data' 204 CASE( 1 ) ; IF(lwp) WRITE(numout,*) ' boundary data taken from file' 205 CASE DEFAULT ; CALL ctl_stop( 'nn_tra_dta must be 0 or 1' ) 206 END SELECT 207 ENDIF 208 IF(lwp) WRITE(numout,*) 209 210 #if defined key_lim2 211 IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice: ' 212 SELECT CASE( nn_ice_lim2(ib_bdy) ) 213 CASE( 0 ) ; IF(lwp) WRITE(numout,*) ' no open boundary condition' 214 CASE( 1 ) ; IF(lwp) WRITE(numout,*) ' Flow Relaxation Scheme' 215 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for nn_tra' ) 216 END SELECT 217 IF( nn_ice_lim2(ib_bdy) .gt. 0 ) THEN 218 SELECT CASE( nn_ice_lim2_dta(ib_bdy) ) ! 219 CASE( 0 ) ; IF(lwp) WRITE(numout,*) ' initial state used for bdy data' 220 CASE( 1 ) ; IF(lwp) WRITE(numout,*) ' boundary data taken from file' 221 CASE DEFAULT ; CALL ctl_stop( 'nn_ice_lim2_dta must be 0 or 1' ) 222 END SELECT 223 ENDIF 224 IF(lwp) WRITE(numout,*) 225 #endif 226 227 IF(lwp) WRITE(numout,*) 'Boundary rim width for the FRS scheme = ', nn_rimwidth(ib_bdy) 228 IF(lwp) WRITE(numout,*) 229 230 ENDDO 231 232 IF( ln_vol ) THEN ! check volume conservation (nn_volctl value) 233 IF(lwp) WRITE(numout,*) 'Volume correction applied at open boundaries' 234 IF(lwp) WRITE(numout,*) 235 SELECT CASE ( nn_volctl ) 111 236 CASE( 1 ) ; IF(lwp) WRITE(numout,*) ' The total volume will be constant' 112 237 CASE( 0 ) ; IF(lwp) WRITE(numout,*) ' The total volume will vary according to the surface E-P flux' 113 238 CASE DEFAULT ; CALL ctl_stop( 'nn_volctl must be 0 or 1' ) 114 END SELECT 115 IF(lwp) WRITE(numout,*) 116 ELSE 117 IF(lwp) WRITE(numout,*) 'No volume correction with unstructured open boundaries' 118 IF(lwp) WRITE(numout,*) 119 ENDIF 120 121 IF( ln_tides ) THEN 122 IF(lwp) WRITE(numout,*) 'Tidal harmonic forcing at unstructured open boundaries' 123 IF(lwp) WRITE(numout,*) 124 ENDIF 125 126 IF( ln_dyn_fla ) THEN 127 IF(lwp) WRITE(numout,*) 'Flather condition on U, V at unstructured open boundaries' 128 IF(lwp) WRITE(numout,*) 129 ENDIF 130 131 IF( ln_dyn_frs ) THEN 132 IF(lwp) WRITE(numout,*) 'FRS condition on U and V at unstructured open boundaries' 133 IF(lwp) WRITE(numout,*) 134 ENDIF 135 136 IF( ln_tra_frs ) THEN 137 IF(lwp) WRITE(numout,*) 'FRS condition on T & S fields at unstructured open boundaries' 138 IF(lwp) WRITE(numout,*) 139 ENDIF 140 141 IF( ln_ice_frs ) THEN 142 IF(lwp) WRITE(numout,*) 'FRS condition on ice fields at unstructured open boundaries' 143 IF(lwp) WRITE(numout,*) 144 ENDIF 145 146 IF( ln_tides ) CALL tide_init ! Read tides namelist 147 148 149 ! Read arrays defining unstructured open boundaries 239 END SELECT 240 IF(lwp) WRITE(numout,*) 241 ELSE 242 IF(lwp) WRITE(numout,*) 'No volume correction applied at open boundaries' 243 IF(lwp) WRITE(numout,*) 244 ENDIF 245 150 246 ! ------------------------------------------------- 247 ! Initialise indices arrays for open boundaries 248 ! ------------------------------------------------- 249 250 ! Work out global dimensions of boundary data 251 ! --------------------------------------------- 252 REWIND( numnam ) 253 DO ib_bdy = 1, nb_bdy 254 255 jpbdta = 1 256 IF( .NOT. ln_coords_file(ib_bdy) ) THEN ! Work out size of global arrays from namelist parameters 257 258 ! No REWIND here because may need to read more than one nambdy_index namelist. 259 READ ( numnam, nambdy_index ) 260 261 ! Automatic boundary definition: if nbdysegX = -1 262 ! set boundary to whole side of model domain. 263 IF( nbdysege == -1 ) THEN 264 nbdysege = 1 265 jpieob(1) = jpiglo - 1 266 jpjedt(1) = 2 267 jpjeft(1) = jpjglo - 1 268 ENDIF 269 IF( nbdysegw == -1 ) THEN 270 nbdysegw = 1 271 jpiwob(1) = 2 272 jpjwdt(1) = 2 273 jpjwft(1) = jpjglo - 1 274 ENDIF 275 IF( nbdysegn == -1 ) THEN 276 nbdysegn = 1 277 jpjnob(1) = jpjglo - 1 278 jpindt(1) = 2 279 jpinft(1) = jpiglo - 1 280 ENDIF 281 IF( nbdysegs == -1 ) THEN 282 nbdysegs = 1 283 jpjsob(1) = 2 284 jpisdt(1) = 2 285 jpisft(1) = jpiglo - 1 286 ENDIF 287 288 nblendta(:,ib_bdy) = 0 289 DO iseg = 1, nbdysege 290 igrd = 1 291 nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpjeft(iseg) - jpjedt(iseg) + 1 292 igrd = 2 293 nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpjeft(iseg) - jpjedt(iseg) + 1 294 igrd = 3 295 nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpjeft(iseg) - jpjedt(iseg) 296 ENDDO 297 DO iseg = 1, nbdysegw 298 igrd = 1 299 nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpjwft(iseg) - jpjwdt(iseg) + 1 300 igrd = 2 301 nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpjwft(iseg) - jpjwdt(iseg) + 1 302 igrd = 3 303 nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpjwft(iseg) - jpjwdt(iseg) 304 ENDDO 305 DO iseg = 1, nbdysegn 306 igrd = 1 307 nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpinft(iseg) - jpindt(iseg) + 1 308 igrd = 2 309 nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpinft(iseg) - jpindt(iseg) 310 igrd = 3 311 nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpinft(iseg) - jpindt(iseg) + 1 312 ENDDO 313 DO iseg = 1, nbdysegs 314 igrd = 1 315 nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpisft(iseg) - jpisdt(iseg) + 1 316 igrd = 2 317 nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpisft(iseg) - jpisdt(iseg) 318 igrd = 3 319 nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpisft(iseg) - jpisdt(iseg) + 1 320 ENDDO 321 322 nblendta(:,ib_bdy) = nblendta(:,ib_bdy) * nn_rimwidth(ib_bdy) 323 jpbdta = MAXVAL(nblendta(:,ib_bdy)) 324 325 326 ELSE ! Read size of arrays in boundary coordinates file. 327 328 329 CALL iom_open( cn_coords_file(ib_bdy), inum ) 330 jpbdta = 1 331 DO igrd = 1, jpbgrd 332 id_dummy = iom_varid( inum, 'nbi'//cgrid(igrd), kdimsz=kdimsz ) 333 nblendta(igrd,ib_bdy) = kdimsz(1) 334 jpbdta = MAX(jpbdta, kdimsz(1)) 335 ENDDO 336 337 ENDIF 338 339 ENDDO ! ib_bdy 340 341 ! Allocate arrays 342 !--------------- 343 ALLOCATE( nbidta(jpbdta, jpbgrd, nb_bdy), nbjdta(jpbdta, jpbgrd, nb_bdy), & 344 & nbrdta(jpbdta, jpbgrd, nb_bdy) ) 345 346 ALLOCATE( dta_global(jpbdta, 1, jpk) ) 347 348 ! Calculate global boundary index arrays or read in from file 349 !------------------------------------------------------------ 350 REWIND( numnam ) 351 DO ib_bdy = 1, nb_bdy 352 353 IF( .NOT. ln_coords_file(ib_bdy) ) THEN ! Calculate global index arrays from namelist parameters 354 355 ! No REWIND here because may need to read more than one nambdy_index namelist. 356 READ ( numnam, nambdy_index ) 357 358 ! Automatic boundary definition: if nbdysegX = -1 359 ! set boundary to whole side of model domain. 360 IF( nbdysege == -1 ) THEN 361 nbdysege = 1 362 jpieob(1) = jpiglo - 1 363 jpjedt(1) = 2 364 jpjeft(1) = jpjglo - 1 365 ENDIF 366 IF( nbdysegw == -1 ) THEN 367 nbdysegw = 1 368 jpiwob(1) = 2 369 jpjwdt(1) = 2 370 jpjwft(1) = jpjglo - 1 371 ENDIF 372 IF( nbdysegn == -1 ) THEN 373 nbdysegn = 1 374 jpjnob(1) = jpjglo - 1 375 jpindt(1) = 2 376 jpinft(1) = jpiglo - 1 377 ENDIF 378 IF( nbdysegs == -1 ) THEN 379 nbdysegs = 1 380 jpjsob(1) = 2 381 jpisdt(1) = 2 382 jpisft(1) = jpiglo - 1 383 ENDIF 384 385 ! ------------ T points ------------- 386 igrd = 1 387 icount = 0 388 DO ir = 1, nn_rimwidth(ib_bdy) 389 ! east 390 DO iseg = 1, nbdysege 391 DO ij = jpjedt(iseg), jpjeft(iseg) 392 icount = icount + 1 393 nbidta(icount, igrd, ib_bdy) = jpieob(iseg) - ir + 1 394 nbjdta(icount, igrd, ib_bdy) = ij 395 nbrdta(icount, igrd, ib_bdy) = ir 396 ENDDO 397 ENDDO 398 ! west 399 DO iseg = 1, nbdysegw 400 DO ij = jpjwdt(iseg), jpjwft(iseg) 401 icount = icount + 1 402 nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1 403 nbjdta(icount, igrd, ib_bdy) = ij 404 nbrdta(icount, igrd, ib_bdy) = ir 405 ENDDO 406 ENDDO 407 ! north 408 DO iseg = 1, nbdysegn 409 DO ii = jpindt(iseg), jpinft(iseg) 410 icount = icount + 1 411 nbidta(icount, igrd, ib_bdy) = ii 412 nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) - ir + 1 413 nbrdta(icount, igrd, ib_bdy) = ir 414 ENDDO 415 ENDDO 416 ! south 417 DO iseg = 1, nbdysegs 418 DO ii = jpisdt(iseg), jpisft(iseg) 419 icount = icount + 1 420 nbidta(icount, igrd, ib_bdy) = ii 421 nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir + 1 422 nbrdta(icount, igrd, ib_bdy) = ir 423 ENDDO 424 ENDDO 425 ENDDO 426 427 ! ------------ U points ------------- 428 igrd = 2 429 icount = 0 430 DO ir = 1, nn_rimwidth(ib_bdy) 431 ! east 432 DO iseg = 1, nbdysege 433 DO ij = jpjedt(iseg), jpjeft(iseg) 434 icount = icount + 1 435 nbidta(icount, igrd, ib_bdy) = jpieob(iseg) - ir 436 nbjdta(icount, igrd, ib_bdy) = ij 437 nbrdta(icount, igrd, ib_bdy) = ir 438 ENDDO 439 ENDDO 440 ! west 441 DO iseg = 1, nbdysegw 442 DO ij = jpjwdt(iseg), jpjwft(iseg) 443 icount = icount + 1 444 nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1 445 nbjdta(icount, igrd, ib_bdy) = ij 446 nbrdta(icount, igrd, ib_bdy) = ir 447 ENDDO 448 ENDDO 449 ! north 450 DO iseg = 1, nbdysegn 451 DO ii = jpindt(iseg), jpinft(iseg) - 1 452 icount = icount + 1 453 nbidta(icount, igrd, ib_bdy) = ii 454 nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) - ir + 1 455 nbrdta(icount, igrd, ib_bdy) = ir 456 ENDDO 457 ENDDO 458 ! south 459 DO iseg = 1, nbdysegs 460 DO ii = jpisdt(iseg), jpisft(iseg) - 1 461 icount = icount + 1 462 nbidta(icount, igrd, ib_bdy) = ii 463 nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir + 1 464 nbrdta(icount, igrd, ib_bdy) = ir 465 ENDDO 466 ENDDO 467 ENDDO 468 469 ! ------------ V points ------------- 470 igrd = 3 471 icount = 0 472 DO ir = 1, nn_rimwidth(ib_bdy) 473 ! east 474 DO iseg = 1, nbdysege 475 DO ij = jpjedt(iseg), jpjeft(iseg) - 1 476 icount = icount + 1 477 nbidta(icount, igrd, ib_bdy) = jpieob(iseg) - ir + 1 478 nbjdta(icount, igrd, ib_bdy) = ij 479 nbrdta(icount, igrd, ib_bdy) = ir 480 ENDDO 481 ENDDO 482 ! west 483 DO iseg = 1, nbdysegw 484 DO ij = jpjwdt(iseg), jpjwft(iseg) - 1 485 icount = icount + 1 486 nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1 487 nbjdta(icount, igrd, ib_bdy) = ij 488 nbrdta(icount, igrd, ib_bdy) = ir 489 ENDDO 490 ENDDO 491 ! north 492 DO iseg = 1, nbdysegn 493 DO ii = jpindt(iseg), jpinft(iseg) 494 icount = icount + 1 495 nbidta(icount, igrd, ib_bdy) = ii 496 nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) - ir 497 nbrdta(icount, igrd, ib_bdy) = ir 498 ENDDO 499 ENDDO 500 ! south 501 DO iseg = 1, nbdysegs 502 DO ii = jpisdt(iseg), jpisft(iseg) 503 icount = icount + 1 504 nbidta(icount, igrd, ib_bdy) = ii 505 nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir + 1 506 nbrdta(icount, igrd, ib_bdy) = ir 507 ENDDO 508 ENDDO 509 ENDDO 510 511 ELSE ! Read global index arrays from boundary coordinates file. 512 513 DO igrd = 1, jpbgrd 514 CALL iom_get( inum, jpdom_unknown, 'nbi'//cgrid(igrd), dta_global(1:nblendta(igrd,ib_bdy),:,1) ) 515 DO ii = 1,nblendta(igrd,ib_bdy) 516 nbidta(ii,igrd,ib_bdy) = INT( dta_global(ii,1,1) ) 517 END DO 518 CALL iom_get( inum, jpdom_unknown, 'nbj'//cgrid(igrd), dta_global(1:nblendta(igrd,ib_bdy),:,1) ) 519 DO ii = 1,nblendta(igrd,ib_bdy) 520 nbjdta(ii,igrd,ib_bdy) = INT( dta_global(ii,1,1) ) 521 END DO 522 CALL iom_get( inum, jpdom_unknown, 'nbr'//cgrid(igrd), dta_global(1:nblendta(igrd,ib_bdy),:,1) ) 523 DO ii = 1,nblendta(igrd,ib_bdy) 524 nbrdta(ii,igrd,ib_bdy) = INT( dta_global(ii,1,1) ) 525 END DO 526 527 ibr_max = MAXVAL( nbrdta(:,igrd,ib_bdy) ) 528 IF(lwp) WRITE(numout,*) 529 IF(lwp) WRITE(numout,*) ' Maximum rimwidth in file is ', ibr_max 530 IF(lwp) WRITE(numout,*) ' nn_rimwidth from namelist is ', nn_rimwidth(ib_bdy) 531 IF (ibr_max < nn_rimwidth(ib_bdy)) & 532 CALL ctl_stop( 'nn_rimwidth is larger than maximum rimwidth in file',cn_coords_file(ib_bdy) ) 533 534 END DO 535 CALL iom_close( inum ) 536 537 ENDIF 538 539 ENDDO 540 541 ! Work out dimensions of boundary data on each processor 542 ! ------------------------------------------------------ 543 544 iw = mig(1) + 1 ! if monotasking and no zoom, iw=2 545 ie = mig(1) + nlci-1 - 1 ! if monotasking and no zoom, ie=jpim1 546 is = mjg(1) + 1 ! if monotasking and no zoom, is=2 547 in = mjg(1) + nlcj-1 - 1 ! if monotasking and no zoom, in=jpjm1 548 549 DO ib_bdy = 1, nb_bdy 550 DO igrd = 1, jpbgrd 551 icount = 0 552 icountr = 0 553 idx_bdy(ib_bdy)%nblen(igrd) = 0 554 idx_bdy(ib_bdy)%nblenrim(igrd) = 0 555 DO ib = 1, nblendta(igrd,ib_bdy) 556 ! check that data is in correct order in file 557 ibm1 = MAX(1,ib-1) 558 IF(lwp) THEN ! Since all procs read global data only need to do this check on one proc... 559 IF( nbrdta(ib,igrd,ib_bdy) < nbrdta(ibm1,igrd,ib_bdy) ) THEN 560 CALL ctl_stop('bdy_init : ERROR : boundary data in file must be defined in order of distance from edge nbr.', & 561 'A utility for re-ordering boundary coordinates and data files exists in CDFTOOLS') 562 ENDIF 563 ENDIF 564 ! check if point is in local domain 565 IF( nbidta(ib,igrd,ib_bdy) >= iw .AND. nbidta(ib,igrd,ib_bdy) <= ie .AND. & 566 & nbjdta(ib,igrd,ib_bdy) >= is .AND. nbjdta(ib,igrd,ib_bdy) <= in ) THEN 567 ! 568 icount = icount + 1 569 ! 570 IF( nbrdta(ib,igrd,ib_bdy) == 1 ) icountr = icountr+1 571 ENDIF 572 ENDDO 573 idx_bdy(ib_bdy)%nblenrim(igrd) = icountr !: length of rim boundary data on each proc 574 idx_bdy(ib_bdy)%nblen (igrd) = icount !: length of boundary data on each proc 575 ENDDO ! igrd 576 577 ! Allocate index arrays for this boundary set 578 !-------------------------------------------- 579 ilen1 = MAXVAL(idx_bdy(ib_bdy)%nblen(:)) 580 ALLOCATE( idx_bdy(ib_bdy)%nbi(ilen1,jpbgrd) ) 581 ALLOCATE( idx_bdy(ib_bdy)%nbj(ilen1,jpbgrd) ) 582 ALLOCATE( idx_bdy(ib_bdy)%nbr(ilen1,jpbgrd) ) 583 ALLOCATE( idx_bdy(ib_bdy)%nbmap(ilen1,jpbgrd) ) 584 ALLOCATE( idx_bdy(ib_bdy)%nbw(ilen1,jpbgrd) ) 585 ALLOCATE( idx_bdy(ib_bdy)%flagu(ilen1) ) 586 ALLOCATE( idx_bdy(ib_bdy)%flagv(ilen1) ) 587 588 ! Dispatch mapping indices and discrete distances on each processor 589 ! ----------------------------------------------------------------- 590 591 DO igrd = 1, jpbgrd 592 icount = 0 593 ! Loop on rimwidth to ensure outermost points come first in the local arrays. 594 DO ir=1, nn_rimwidth(ib_bdy) 595 DO ib = 1, nblendta(igrd,ib_bdy) 596 ! check if point is in local domain and equals ir 597 IF( nbidta(ib,igrd,ib_bdy) >= iw .AND. nbidta(ib,igrd,ib_bdy) <= ie .AND. & 598 & nbjdta(ib,igrd,ib_bdy) >= is .AND. nbjdta(ib,igrd,ib_bdy) <= in .AND. & 599 & nbrdta(ib,igrd,ib_bdy) == ir ) THEN 600 ! 601 icount = icount + 1 602 idx_bdy(ib_bdy)%nbi(icount,igrd) = nbidta(ib,igrd,ib_bdy)- mig(1)+1 603 idx_bdy(ib_bdy)%nbj(icount,igrd) = nbjdta(ib,igrd,ib_bdy)- mjg(1)+1 604 idx_bdy(ib_bdy)%nbr(icount,igrd) = nbrdta(ib,igrd,ib_bdy) 605 idx_bdy(ib_bdy)%nbmap(icount,igrd) = ib 606 ENDIF 607 ENDDO 608 ENDDO 609 ENDDO 610 611 ! Compute rim weights for FRS scheme 612 ! ---------------------------------- 613 DO igrd = 1, jpbgrd 614 DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 615 nbr => idx_bdy(ib_bdy)%nbr(ib,igrd) 616 idx_bdy(ib_bdy)%nbw(ib,igrd) = 1.- TANH( FLOAT( nbr - 1 ) *0.5 ) ! tanh formulation 617 ! idx_bdy(ib_bdy)%nbw(ib,igrd) = (FLOAT(nn_rimwidth+1-nbr)/FLOAT(nn_rimwidth))**2 ! quadratic 618 ! idx_bdy(ib_bdy)%nbw(ib,igrd) = FLOAT(nn_rimwidth+1-nbr)/FLOAT(nn_rimwidth) ! linear 619 END DO 620 END DO 621 622 ENDDO 623 624 ! ------------------------------------------------------ 625 ! Initialise masks and find normal/tangential directions 626 ! ------------------------------------------------------ 151 627 152 628 ! Read global 2D mask at T-points: bdytmask 153 ! *****************************************629 ! ----------------------------------------- 154 630 ! bdytmask = 1 on the computational domain AND on open boundaries 155 631 ! = 0 elsewhere … … 158 634 zmask( : ,:) = 0.e0 159 635 zmask(jpizoom+1:jpizoom+jpiglo-2,:) = 1.e0 160 ELSE IF( ln_mask ) THEN161 CALL iom_open( cn_mask , inum )636 ELSE IF( ln_mask_file ) THEN 637 CALL iom_open( cn_mask_file, inum ) 162 638 CALL iom_get ( inum, jpdom_data, 'bdy_msk', zmask(:,:) ) 163 639 CALL iom_close( inum ) … … 184 660 185 661 186 ! Read discrete distance and mapping indices187 ! ******************************************188 nbidta(:,:) = 0.e0189 nbjdta(:,:) = 0.e0190 nbrdta(:,:) = 0.e0191 192 IF( cp_cfg == "eel" .AND. jp_cfg == 5 ) THEN193 icount = 0194 DO ir = 1, nn_rimwidth ! Define west boundary (from ii=2 to ii=1+nn_rimwidth):195 DO ij = 3, jpjglo-2196 icount = icount + 1197 nbidta(icount,:) = ir + 1 + (jpizoom-1)198 nbjdta(icount,:) = ij + (jpjzoom-1)199 nbrdta(icount,:) = ir200 END DO201 END DO202 !203 DO ir = 1, nn_rimwidth ! Define east boundary (from ii=jpiglo-1 to ii=jpiglo-nn_rimwidth):204 DO ij=3,jpjglo-2205 icount = icount + 1206 nbidta(icount,:) = jpiglo-ir + (jpizoom-1)207 nbidta(icount,2) = jpiglo-ir-1 + (jpizoom-1) ! special case for u points208 nbjdta(icount,:) = ij + (jpjzoom-1)209 nbrdta(icount,:) = ir210 END DO211 END DO212 !213 ELSE ! Read indices and distances in unstructured boundary data files214 !215 IF( ln_tides ) THEN ! Read tides input files for preference in case there are no bdydata files216 clfile(4) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_T.nc'217 clfile(5) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_U.nc'218 clfile(6) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_V.nc'219 ENDIF220 IF( ln_dyn_fla .AND. .NOT. ln_tides ) THEN221 clfile(4) = cn_dta_fla_T222 clfile(5) = cn_dta_fla_U223 clfile(6) = cn_dta_fla_V224 ENDIF225 226 IF( ln_tra_frs ) THEN227 clfile(1) = cn_dta_frs_T228 IF( .NOT. ln_dyn_frs ) THEN229 clfile(2) = cn_dta_frs_T ! Dummy read re read T file for sake of 6 files230 clfile(3) = cn_dta_frs_T !231 ENDIF232 ENDIF233 IF( ln_dyn_frs ) THEN234 IF( .NOT. ln_tra_frs ) clfile(1) = cn_dta_frs_U ! Dummy Read235 clfile(2) = cn_dta_frs_U236 clfile(3) = cn_dta_frs_V237 ENDIF238 239 ! ! how many files are we to read in?240 IF(ln_tides .OR. ln_dyn_fla) igrd_start = 4241 !242 IF(ln_tra_frs ) THEN ; igrd_start = 1243 ELSEIF(ln_dyn_frs) THEN ; igrd_start = 2244 ENDIF245 !246 IF( ln_tra_frs ) igrd_end = 1247 !248 IF(ln_dyn_fla .OR. ln_tides) THEN ; igrd_end = 6249 ELSEIF( ln_dyn_frs ) THEN ; igrd_end = 3250 ENDIF251 252 DO igrd = igrd_start, igrd_end253 CALL iom_open( clfile(igrd), inum )254 id_dummy = iom_varid( inum, 'nbidta', kdimsz=kdimsz )255 IF(lwp) WRITE(numout,*) 'kdimsz : ',kdimsz256 ib_len = kdimsz(1)257 IF( ib_len > jpbdta) CALL ctl_stop( 'Boundary data array in file too long.', &258 & 'File :', TRIM(clfile(igrd)),'increase parameter jpbdta.' )259 260 CALL iom_get( inum, jpdom_unknown, 'nbidta', zdta(1:ib_len,:) )261 DO ii = 1,ib_len262 nbidta(ii,igrd) = INT( zdta(ii,1) )263 END DO264 CALL iom_get( inum, jpdom_unknown, 'nbjdta', zdta(1:ib_len,:) )265 DO ii = 1,ib_len266 nbjdta(ii,igrd) = INT( zdta(ii,1) )267 END DO268 CALL iom_get( inum, jpdom_unknown, 'nbrdta', zdta(1:ib_len,:) )269 DO ii = 1,ib_len270 nbrdta(ii,igrd) = INT( zdta(ii,1) )271 END DO272 CALL iom_close( inum )273 274 IF( igrd < 4) THEN ! Check that rimwidth in file is big enough for Frs case(barotropic is one):275 ibr_max = MAXVAL( nbrdta(:,igrd) )276 IF(lwp) WRITE(numout,*)277 IF(lwp) WRITE(numout,*) ' Maximum rimwidth in file is ', ibr_max278 IF(lwp) WRITE(numout,*) ' nn_rimwidth from namelist is ', nn_rimwidth279 IF (ibr_max < nn_rimwidth) CALL ctl_stop( 'nn_rimwidth is larger than maximum rimwidth in file' )280 ENDIF !Check igrd < 4281 !282 END DO283 !284 ENDIF285 286 ! Dispatch mapping indices and discrete distances on each processor287 ! *****************************************************************288 289 iw = mig(1) + 1 ! if monotasking and no zoom, iw=2290 ie = mig(1) + nlci-1 - 1 ! if monotasking and no zoom, ie=jpim1291 is = mjg(1) + 1 ! if monotasking and no zoom, is=2292 in = mjg(1) + nlcj-1 - 1 ! if monotasking and no zoom, in=jpjm1293 294 DO igrd = igrd_start, igrd_end295 icount = 0296 icountr = 0297 nblen (igrd) = 0298 nblenrim(igrd) = 0299 nblendta(igrd) = 0300 DO ir=1, nn_rimwidth301 DO ib = 1, jpbdta302 ! check if point is in local domain and equals ir303 IF( nbidta(ib,igrd) >= iw .AND. nbidta(ib,igrd) <= ie .AND. &304 & nbjdta(ib,igrd) >= is .AND. nbjdta(ib,igrd) <= in .AND. &305 & nbrdta(ib,igrd) == ir ) THEN306 !307 icount = icount + 1308 !309 IF( ir == 1 ) icountr = icountr+1310 IF (icount > jpbdim) THEN311 IF(lwp) WRITE(numout,*) 'bdy_ini: jpbdim too small'312 nstop = nstop + 1313 ELSE314 nbi(icount, igrd) = nbidta(ib,igrd)- mig(1)+1315 nbj(icount, igrd) = nbjdta(ib,igrd)- mjg(1)+1316 nbr(icount, igrd) = nbrdta(ib,igrd)317 nbmap(icount,igrd) = ib318 ENDIF319 ENDIF320 END DO321 END DO322 nblenrim(igrd) = icountr !: length of rim boundary data on each proc323 nblen (igrd) = icount !: length of boundary data on each proc324 END DO325 326 ! Compute rim weights327 ! -------------------328 DO igrd = igrd_start, igrd_end329 DO ib = 1, nblen(igrd)330 nbw(ib,igrd) = 1.- TANH( FLOAT( nbr(ib,igrd) - 1 ) *0.5 ) ! tanh formulation331 ! nbw(ib,igrd) = (FLOAT(nn_rimwidth+1-nbr(ib,igrd))/FLOAT(nn_rimwidth))**2 ! quadratic332 ! nbw(ib,igrd) = FLOAT(nn_rimwidth+1-nbr(ib,igrd))/FLOAT(nn_rimwidth) ! linear333 END DO334 END DO335 336 662 ! Mask corrections 337 663 ! ---------------- … … 361 687 ! bdy masks and bmask are now set to zero on boundary points: 362 688 igrd = 1 ! In the free surface case, bmask is at T-points 363 DO ib = 1, nblenrim(igrd) 364 bmask(nbi(ib,igrd), nbj(ib,igrd)) = 0.e0 365 END DO 689 DO ib_bdy = 1, nb_bdy 690 DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 691 bmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0.e0 692 ENDDO 693 ENDDO 366 694 ! 367 695 igrd = 1 368 DO ib = 1, nblenrim(igrd) 369 bdytmask(nbi(ib,igrd), nbj(ib,igrd)) = 0.e0 370 END DO 696 DO ib_bdy = 1, nb_bdy 697 DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 698 bdytmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0.e0 699 ENDDO 700 ENDDO 371 701 ! 372 702 igrd = 2 373 DO ib = 1, nblenrim(igrd) 374 bdyumask(nbi(ib,igrd), nbj(ib,igrd)) = 0.e0 375 END DO 703 DO ib_bdy = 1, nb_bdy 704 DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 705 bdyumask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0.e0 706 ENDDO 707 ENDDO 376 708 ! 377 709 igrd = 3 378 DO ib = 1, nblenrim(igrd) 379 bdyvmask(nbi(ib,igrd), nbj(ib,igrd)) = 0.e0 380 END DO 710 DO ib_bdy = 1, nb_bdy 711 DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 712 bdyvmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0.e0 713 ENDDO 714 ENDDO 381 715 382 716 ! Lateral boundary conditions … … 384 718 CALL lbc_lnk( bdyumask(:,:), 'U', 1. ) ; CALL lbc_lnk( bdyvmask(:,:), 'V', 1. ) 385 719 386 IF( ln_vol .OR. ln_dyn_fla ) THEN ! Indices and directions of rim velocity components 387 ! 720 DO ib_bdy = 1, nb_bdy ! Indices and directions of rim velocity components 721 722 idx_bdy(ib_bdy)%flagu(:) = 0.e0 723 idx_bdy(ib_bdy)%flagv(:) = 0.e0 724 icount = 0 725 388 726 !flagu = -1 : u component is normal to the dynamical boundary but its direction is outward 389 727 !flagu = 0 : u is tangential 390 728 !flagu = 1 : u is normal to the boundary and is direction is inward 391 icount = 0 392 flagu(:) = 0.e0 393 729 394 730 igrd = 2 ! u-component 395 DO ib = 1, nblenrim(igrd) 396 zefl=bdytmask(nbi(ib,igrd) , nbj(ib,igrd)) 397 zwfl=bdytmask(nbi(ib,igrd)+1, nbj(ib,igrd)) 398 IF( zefl + zwfl ==2 ) THEN 399 icount = icount +1 731 DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 732 nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 733 nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 734 zefl = bdytmask(nbi ,nbj) 735 zwfl = bdytmask(nbi+1,nbj) 736 IF( zefl + zwfl == 2 ) THEN 737 icount = icount + 1 400 738 ELSE 401 flagu(ib)=-zefl+zwfl739 idx_bdy(ib_bdy)%flagu(ib)=-zefl+zwfl 402 740 ENDIF 403 741 END DO … … 406 744 !flagv = 0 : u is tangential 407 745 !flagv = 1 : u is normal to the boundary and is direction is inward 408 flagv(:) = 0.e0409 746 410 747 igrd = 3 ! v-component 411 DO ib = 1, nblenrim(igrd) 412 znfl = bdytmask(nbi(ib,igrd), nbj(ib,igrd)) 413 zsfl = bdytmask(nbi(ib,igrd), nbj(ib,igrd)+1) 414 IF( znfl + zsfl ==2 ) THEN 748 DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 749 nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 750 nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 751 znfl = bdytmask(nbi,nbj ) 752 zsfl = bdytmask(nbi,nbj+1) 753 IF( znfl + zsfl == 2 ) THEN 415 754 icount = icount + 1 416 755 ELSE 417 flagv(ib) = -znfl + zsfl756 idx_bdy(ib_bdy)%flagv(ib) = -znfl + zsfl 418 757 END IF 419 758 END DO … … 422 761 IF(lwp) WRITE(numout,*) 423 762 IF(lwp) WRITE(numout,*) ' E R R O R : Some data velocity points,', & 424 ' are not boundary points. Check nbi, nbj, indices .'763 ' are not boundary points. Check nbi, nbj, indices for boundary set ',ib_bdy 425 764 IF(lwp) WRITE(numout,*) ' ========== ' 426 765 IF(lwp) WRITE(numout,*) … … 428 767 ENDIF 429 768 430 END IF769 ENDDO 431 770 432 771 ! Compute total lateral surface for volume correction: … … 435 774 IF( ln_vol ) THEN 436 775 igrd = 2 ! Lateral surface at U-points 437 DO ib = 1, nblenrim(igrd) 438 bdysurftot = bdysurftot + hu (nbi(ib,igrd) ,nbj(ib,igrd)) & 439 & * e2u (nbi(ib,igrd) ,nbj(ib,igrd)) * ABS( flagu(ib) ) & 440 & * tmask_i(nbi(ib,igrd) ,nbj(ib,igrd)) & 441 & * tmask_i(nbi(ib,igrd)+1,nbj(ib,igrd)) 442 END DO 776 DO ib_bdy = 1, nb_bdy 777 DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 778 nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 779 nbj => idx_bdy(ib_bdy)%nbi(ib,igrd) 780 flagu => idx_bdy(ib_bdy)%flagu(ib) 781 bdysurftot = bdysurftot + hu (nbi , nbj) & 782 & * e2u (nbi , nbj) * ABS( flagu ) & 783 & * tmask_i(nbi , nbj) & 784 & * tmask_i(nbi+1, nbj) 785 ENDDO 786 ENDDO 443 787 444 788 igrd=3 ! Add lateral surface at V-points 445 DO ib = 1, nblenrim(igrd) 446 bdysurftot = bdysurftot + hv (nbi(ib,igrd),nbj(ib,igrd) ) & 447 & * e1v (nbi(ib,igrd),nbj(ib,igrd) ) * ABS( flagv(ib) ) & 448 & * tmask_i(nbi(ib,igrd),nbj(ib,igrd) ) & 449 & * tmask_i(nbi(ib,igrd),nbj(ib,igrd)+1) 450 END DO 789 DO ib_bdy = 1, nb_bdy 790 DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 791 nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 792 nbj => idx_bdy(ib_bdy)%nbi(ib,igrd) 793 flagv => idx_bdy(ib_bdy)%flagv(ib) 794 bdysurftot = bdysurftot + hv (nbi, nbj ) & 795 & * e1v (nbi, nbj ) * ABS( flagv ) & 796 & * tmask_i(nbi, nbj ) & 797 & * tmask_i(nbi, nbj+1) 798 ENDDO 799 ENDDO 451 800 ! 452 801 IF( lk_mpp ) CALL mpp_sum( bdysurftot ) ! sum over the global domain 453 802 END IF 454 455 ! Initialise bdy data arrays456 ! --------------------------457 tbdy(:,:) = 0.e0458 sbdy(:,:) = 0.e0459 ubdy(:,:) = 0.e0460 vbdy(:,:) = 0.e0461 sshbdy(:) = 0.e0462 ubtbdy(:) = 0.e0463 vbtbdy(:) = 0.e0464 #if defined key_lim2465 frld_bdy(:) = 0.e0466 hicif_bdy(:) = 0.e0467 hsnif_bdy(:) = 0.e0468 #endif469 470 ! Read in tidal constituents and adjust for model start time471 ! ----------------------------------------------------------472 IF( ln_tides ) CALL tide_data473 803 ! 804 ! Tidy up 805 !-------- 806 DEALLOCATE(nbidta, nbjdta, nbrdta) 807 474 808 END SUBROUTINE bdy_init 475 809 476 810 #else 477 811 !!--------------------------------------------------------------------------------- 478 !! Dummy module NO unstructuredopen boundaries812 !! Dummy module NO open boundaries 479 813 !!--------------------------------------------------------------------------------- 480 814 CONTAINS -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90
r2528 r3116 11 11 #if defined key_bdy 12 12 !!---------------------------------------------------------------------- 13 !! 'key_bdy' UnstructuredOpen Boundary Condition13 !! 'key_bdy' Open Boundary Condition 14 14 !!---------------------------------------------------------------------- 15 15 !! PUBLIC 16 !! tide_init : read of namelist 17 !! tide_data : read in and initialisation of tidal constituents at boundary 16 !! tide_init : read of namelist and initialisation of tidal harmonics data 18 17 !! tide_update : calculation of tidal forcing at each timestep 19 18 !! PRIVATE … … 33 32 USE bdy_oce ! ocean open boundary conditions 34 33 USE daymod ! calendar 34 USE fldread, ONLY: fld_map 35 35 36 36 IMPLICIT NONE 37 37 PRIVATE 38 38 39 PUBLIC tide_init ! routine called in bdyini 40 PUBLIC tide_data ! routine called in bdyini 39 PUBLIC tide_init ! routine called in nemo_init 41 40 PUBLIC tide_update ! routine called in bdydyn 42 41 43 LOGICAL, PUBLIC :: ln_tide_date !: =T correct tide phases and amplitude for model start date 44 INTEGER, PUBLIC, PARAMETER :: jptides_max = 15 !: Max number of tidal contituents 45 INTEGER, PUBLIC :: ntide !: Actual number of tidal constituents 46 47 CHARACTER(len=80), PUBLIC :: filtide !: Filename root for tidal input files 48 CHARACTER(len= 4), PUBLIC, DIMENSION(jptides_max) :: tide_cpt !: Names of tidal components used. 49 50 INTEGER , PUBLIC, DIMENSION(jptides_max) :: nindx !: ??? 51 REAL(wp), PUBLIC, DIMENSION(jptides_max) :: tide_speed !: Phase speed of tidal constituent (deg/hr) 52 53 REAL(wp), DIMENSION(jpbdim,jptides_max) :: ssh1, ssh2 ! Tidal constituents : SSH 54 REAL(wp), DIMENSION(jpbdim,jptides_max) :: u1 , u2 ! Tidal constituents : U 55 REAL(wp), DIMENSION(jpbdim,jptides_max) :: v1 , v2 ! Tidal constituents : V 42 TYPE, PUBLIC :: TIDES_DATA !: Storage for external tidal harmonics data 43 INTEGER :: ncpt !: Actual number of tidal components 44 REAL(wp), POINTER, DIMENSION(:) :: speed !: Phase speed of tidal constituent (deg/hr) 45 REAL(wp), POINTER, DIMENSION(:,:,:) :: ssh !: Tidal constituents : SSH 46 REAL(wp), POINTER, DIMENSION(:,:,:) :: u !: Tidal constituents : U 47 REAL(wp), POINTER, DIMENSION(:,:,:) :: v !: Tidal constituents : V 48 END TYPE TIDES_DATA 49 50 INTEGER, PUBLIC, PARAMETER :: jptides_max = 15 !: Max number of tidal contituents 51 52 TYPE(TIDES_DATA), PUBLIC, DIMENSION(jp_bdy), TARGET :: tides !: External tidal harmonics data 56 53 57 54 !!---------------------------------------------------------------------- … … 66 63 !! *** SUBROUTINE tide_init *** 67 64 !! 68 !! ** Purpose : - Read in namelist for tides 69 !! 70 !!---------------------------------------------------------------------- 71 INTEGER :: itide ! dummy loop index 65 !! ** Purpose : - Read in namelist for tides and initialise external 66 !! tidal harmonics data 67 !! 68 !!---------------------------------------------------------------------- 69 !! namelist variables 70 !!------------------- 71 LOGICAL :: ln_tide_date !: =T correct tide phases and amplitude for model start date 72 CHARACTER(len=80) :: filtide !: Filename root for tidal input files 73 CHARACTER(len= 4), DIMENSION(jptides_max) :: tide_cpt !: Names of tidal components used. 74 REAL(wp), DIMENSION(jptides_max) :: tide_speed !: Phase speed of tidal constituent (deg/hr) 75 !! 76 INTEGER, DIMENSION(jptides_max) :: nindx !: index of pre-set tidal components 77 INTEGER :: ib_bdy, itide, ib !: dummy loop indices 78 INTEGER :: inum, igrd 79 INTEGER, DIMENSION(3) :: ilen0 !: length of boundary data (from OBC arrays) 80 CHARACTER(len=80) :: clfile !: full file name for tidal input file 81 REAL(wp) :: z_arg, z_atde, z_btde, z1t, z2t 82 REAL(wp),DIMENSION(jptides_max) :: z_vplu, z_ftc 83 REAL(wp),ALLOCATABLE, DIMENSION(:,:,:) :: dta_read !: work space to read in tidal harmonics data 84 !! 85 TYPE(TIDES_DATA), POINTER :: td !: local short cut 72 86 !! 73 87 NAMELIST/nambdy_tide/ln_tide_date, filtide, tide_cpt, tide_speed … … 78 92 IF(lwp) WRITE(numout,*) '~~~~~~~~~' 79 93 80 ! Namelist nambdy_tide : tidal harmonic forcing at open boundaries 81 ln_tide_date = .false. 82 filtide(:) = '' 83 tide_speed(:) = 0.0 84 tide_cpt(:) = '' 85 REWIND( numnam ) ! Read namelist parameters 86 READ ( numnam, nambdy_tide ) 87 ! ! Count number of components specified 88 ntide = jptides_max 89 DO itide = 1, jptides_max 90 IF( tide_cpt(itide) == '' ) THEN 91 ntide = itide-1 92 exit 93 ENDIF 94 END DO 95 96 ! ! find constituents in standard list 97 DO itide = 1, ntide 98 nindx(itide) = 0 99 IF( TRIM( tide_cpt(itide) ) == 'Q1' ) nindx(itide) = 1 100 IF( TRIM( tide_cpt(itide) ) == 'O1' ) nindx(itide) = 2 101 IF( TRIM( tide_cpt(itide) ) == 'P1' ) nindx(itide) = 3 102 IF( TRIM( tide_cpt(itide) ) == 'S1' ) nindx(itide) = 4 103 IF( TRIM( tide_cpt(itide) ) == 'K1' ) nindx(itide) = 5 104 IF( TRIM( tide_cpt(itide) ) == '2N2' ) nindx(itide) = 6 105 IF( TRIM( tide_cpt(itide) ) == 'MU2' ) nindx(itide) = 7 106 IF( TRIM( tide_cpt(itide) ) == 'N2' ) nindx(itide) = 8 107 IF( TRIM( tide_cpt(itide) ) == 'NU2' ) nindx(itide) = 9 108 IF( TRIM( tide_cpt(itide) ) == 'M2' ) nindx(itide) = 10 109 IF( TRIM( tide_cpt(itide) ) == 'L2' ) nindx(itide) = 11 110 IF( TRIM( tide_cpt(itide) ) == 'T2' ) nindx(itide) = 12 111 IF( TRIM( tide_cpt(itide) ) == 'S2' ) nindx(itide) = 13 112 IF( TRIM( tide_cpt(itide) ) == 'K2' ) nindx(itide) = 14 113 IF( TRIM( tide_cpt(itide) ) == 'M4' ) nindx(itide) = 15 114 IF( nindx(itide) == 0 .AND. lwp ) THEN 115 WRITE(ctmp1,*) 'constitunent', itide,':', tide_cpt(itide), 'not in standard list' 116 CALL ctl_warn( ctmp1 ) 117 ENDIF 118 END DO 119 ! ! Parameter control and print 120 IF( ntide < 1 ) THEN 121 CALL ctl_stop( ' Did not find any tidal components in namelist nambdy_tide' ) 122 ELSE 123 IF(lwp) WRITE(numout,*) ' Namelist nambdy_tide : tidal harmonic forcing at open boundaries' 124 IF(lwp) WRITE(numout,*) ' tidal components specified ', ntide 125 IF(lwp) WRITE(numout,*) ' ', tide_cpt(1:ntide) 126 IF(lwp) WRITE(numout,*) ' associated phase speeds (deg/hr) : ' 127 IF(lwp) WRITE(numout,*) ' ', tide_speed(1:ntide) 128 ENDIF 129 130 ! Initialisation of tidal harmonics arrays 131 sshtide(:) = 0.e0 132 utide (:) = 0.e0 133 vtide (:) = 0.e0 134 ! 94 REWIND(numnam) 95 DO ib_bdy = 1, nb_bdy 96 IF( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN 97 98 td => tides(ib_bdy) 99 100 ! Namelist nambdy_tide : tidal harmonic forcing at open boundaries 101 ln_tide_date = .false. 102 filtide(:) = '' 103 tide_speed(:) = 0.0 104 tide_cpt(:) = '' 105 106 ! Don't REWIND here - may need to read more than one of these namelists. 107 READ ( numnam, nambdy_tide ) 108 ! ! Count number of components specified 109 td%ncpt = 0 110 DO itide = 1, jptides_max 111 IF( tide_cpt(itide) /= '' ) THEN 112 td%ncpt = td%ncpt + 1 113 ENDIF 114 END DO 115 116 ! Fill in phase speeds from namelist 117 ALLOCATE( td%speed(td%ncpt) ) 118 td%speed = tide_speed(1:td%ncpt) 119 120 ! Find constituents in standard list 121 DO itide = 1, td%ncpt 122 nindx(itide) = 0 123 IF( TRIM( tide_cpt(itide) ) == 'Q1' ) nindx(itide) = 1 124 IF( TRIM( tide_cpt(itide) ) == 'O1' ) nindx(itide) = 2 125 IF( TRIM( tide_cpt(itide) ) == 'P1' ) nindx(itide) = 3 126 IF( TRIM( tide_cpt(itide) ) == 'S1' ) nindx(itide) = 4 127 IF( TRIM( tide_cpt(itide) ) == 'K1' ) nindx(itide) = 5 128 IF( TRIM( tide_cpt(itide) ) == '2N2' ) nindx(itide) = 6 129 IF( TRIM( tide_cpt(itide) ) == 'MU2' ) nindx(itide) = 7 130 IF( TRIM( tide_cpt(itide) ) == 'N2' ) nindx(itide) = 8 131 IF( TRIM( tide_cpt(itide) ) == 'NU2' ) nindx(itide) = 9 132 IF( TRIM( tide_cpt(itide) ) == 'M2' ) nindx(itide) = 10 133 IF( TRIM( tide_cpt(itide) ) == 'L2' ) nindx(itide) = 11 134 IF( TRIM( tide_cpt(itide) ) == 'T2' ) nindx(itide) = 12 135 IF( TRIM( tide_cpt(itide) ) == 'S2' ) nindx(itide) = 13 136 IF( TRIM( tide_cpt(itide) ) == 'K2' ) nindx(itide) = 14 137 IF( TRIM( tide_cpt(itide) ) == 'M4' ) nindx(itide) = 15 138 IF( nindx(itide) == 0 .AND. lwp ) THEN 139 WRITE(ctmp1,*) 'constitunent', itide,':', tide_cpt(itide), 'not in standard list' 140 CALL ctl_warn( ctmp1 ) 141 ENDIF 142 END DO 143 ! ! Parameter control and print 144 IF( td%ncpt < 1 ) THEN 145 CALL ctl_stop( ' Did not find any tidal components in namelist nambdy_tide' ) 146 ELSE 147 IF(lwp) WRITE(numout,*) ' Namelist nambdy_tide : tidal harmonic forcing at open boundaries' 148 IF(lwp) WRITE(numout,*) ' tidal components specified ', td%ncpt 149 IF(lwp) WRITE(numout,*) ' ', tide_cpt(1:td%ncpt) 150 IF(lwp) WRITE(numout,*) ' associated phase speeds (deg/hr) : ' 151 IF(lwp) WRITE(numout,*) ' ', tide_speed(1:td%ncpt) 152 ENDIF 153 154 155 ! Allocate space for tidal harmonics data - 156 ! get size from OBC data arrays 157 ! --------------------------------------- 158 159 ilen0(1) = SIZE( dta_bdy(ib_bdy)%ssh ) 160 ALLOCATE( td%ssh( ilen0(1), td%ncpt, 2 ) ) 161 162 ilen0(2) = SIZE( dta_bdy(ib_bdy)%u2d ) 163 ALLOCATE( td%u( ilen0(2), td%ncpt, 2 ) ) 164 165 ilen0(3) = SIZE( dta_bdy(ib_bdy)%v2d ) 166 ALLOCATE( td%v( ilen0(3), td%ncpt, 2 ) ) 167 168 ALLOCATE( dta_read( MAXVAL(ilen0), 1, 1 ) ) 169 170 171 ! Open files and read in tidal forcing data 172 ! ----------------------------------------- 173 174 DO itide = 1, td%ncpt 175 ! ! SSH fields 176 clfile = TRIM(filtide)//TRIM(tide_cpt(itide))//'_grid_T.nc' 177 IF(lwp) WRITE(numout,*) 'Reading data from file ', clfile 178 CALL iom_open( clfile, inum ) 179 CALL fld_map( inum, 'z1' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 180 td%ssh(:,itide,1) = dta_read(1:ilen0(1),1,1) 181 CALL fld_map( inum, 'z2' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 182 td%ssh(:,itide,2) = dta_read(1:ilen0(1),1,1) 183 CALL iom_close( inum ) 184 ! ! U fields 185 clfile = TRIM(filtide)//TRIM(tide_cpt(itide))//'_grid_U.nc' 186 IF(lwp) WRITE(numout,*) 'Reading data from file ', clfile 187 CALL iom_open( clfile, inum ) 188 CALL fld_map( inum, 'u1' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 189 td%u(:,itide,1) = dta_read(1:ilen0(2),1,1) 190 CALL fld_map( inum, 'u2' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 191 td%u(:,itide,2) = dta_read(1:ilen0(2),1,1) 192 CALL iom_close( inum ) 193 ! ! V fields 194 clfile = TRIM(filtide)//TRIM(tide_cpt(itide))//'_grid_V.nc' 195 IF(lwp) WRITE(numout,*) 'Reading data from file ', clfile 196 CALL iom_open( clfile, inum ) 197 CALL fld_map( inum, 'v1' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 198 td%v(:,itide,1) = dta_read(1:ilen0(3),1,1) 199 CALL fld_map( inum, 'v2' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 200 td%v(:,itide,2) = dta_read(1:ilen0(3),1,1) 201 CALL iom_close( inum ) 202 ! 203 END DO ! end loop on tidal components 204 205 IF( ln_tide_date ) THEN ! correct for date factors 206 207 !! used nmonth, nyear and nday from daymod.... 208 ! Calculate date corrects for 15 standard consituents 209 ! This is the initialisation step, so nday, nmonth, nyear are the 210 ! initial date/time of the integration. 211 print *, nday,nmonth,nyear 212 nyear = int(ndate0 / 10000 ) ! initial year 213 nmonth = int((ndate0 - nyear * 10000 ) / 100 ) ! initial month 214 nday = int(ndate0 - nyear * 10000 - nmonth * 100) 215 216 CALL uvset( 0, nday, nmonth, nyear, z_ftc, z_vplu ) 217 218 IF(lwp) WRITE(numout,*) 'Correcting tide for date:', nday, nmonth, nyear 219 220 DO itide = 1, td%ncpt ! loop on tidal components 221 ! 222 IF( nindx(itide) /= 0 ) THEN 223 !!gm use rpi and rad global variable 224 z_arg = 3.14159265d0 * z_vplu(nindx(itide)) / 180.0d0 225 z_atde=z_ftc(nindx(itide))*cos(z_arg) 226 z_btde=z_ftc(nindx(itide))*sin(z_arg) 227 IF(lwp) WRITE(numout,'(2i5,8f10.6)') itide, nindx(itide), td%speed(itide), & 228 & z_ftc(nindx(itide)), z_vplu(nindx(itide)) 229 ELSE 230 z_atde = 1.0_wp 231 z_btde = 0.0_wp 232 ENDIF 233 ! ! elevation 234 igrd = 1 235 DO ib = 1, ilen0(igrd) 236 z1t = z_atde * td%ssh(ib,itide,1) + z_btde * td%ssh(ib,itide,2) 237 z2t = z_atde * td%ssh(ib,itide,2) - z_btde * td%ssh(ib,itide,1) 238 td%ssh(ib,itide,1) = z1t 239 td%ssh(ib,itide,2) = z2t 240 END DO 241 ! ! u 242 igrd = 2 243 DO ib = 1, ilen0(igrd) 244 z1t = z_atde * td%u(ib,itide,1) + z_btde * td%u(ib,itide,2) 245 z2t = z_atde * td%u(ib,itide,2) - z_btde * td%u(ib,itide,1) 246 td%u(ib,itide,1) = z1t 247 td%u(ib,itide,2) = z2t 248 END DO 249 ! ! v 250 igrd = 3 251 DO ib = 1, ilen0(igrd) 252 z1t = z_atde * td%v(ib,itide,1) + z_btde * td%v(ib,itide,2) 253 z2t = z_atde * td%v(ib,itide,2) - z_btde * td%v(ib,itide,1) 254 td%v(ib,itide,1) = z1t 255 td%v(ib,itide,2) = z2t 256 END DO 257 ! 258 END DO ! end loop on tidal components 259 ! 260 ENDIF ! date correction 261 ! 262 ENDIF ! nn_dyn2d_dta(ib_bdy) .ge. 2 263 ! 264 END DO ! loop on ib_bdy 265 135 266 END SUBROUTINE tide_init 136 267 137 268 138 SUBROUTINE tide_data 139 !!---------------------------------------------------------------------- 140 !! *** SUBROUTINE tide_data *** 141 !! 142 !! ** Purpose : - Read in tidal harmonics data and adjust for the start 143 !! time of the model run. 144 !! 145 !!---------------------------------------------------------------------- 146 INTEGER :: itide, igrd, ib ! dummy loop indices 147 CHARACTER(len=80) :: clfile ! full file name for tidal input file 148 INTEGER :: ipi, ipj, inum, idvar ! temporary integers (netcdf read) 149 INTEGER, DIMENSION(6) :: lendta=0 ! length of data in the file (note may be different from nblendta!) 150 REAL(wp) :: z_arg, z_atde, z_btde, z1t, z2t 151 REAL(wp), DIMENSION(jpbdta,1) :: zdta ! temporary array for data fields 152 REAL(wp), DIMENSION(jptides_max) :: z_vplu, z_ftc 153 !!------------------------------------------------------------------------------ 154 155 ! Open files and read in tidal forcing data 156 ! ----------------------------------------- 157 158 ipj = 1 159 160 DO itide = 1, ntide 161 ! ! SSH fields 162 clfile = TRIM(filtide)//TRIM(tide_cpt(itide))//'_grid_T.nc' 163 IF(lwp) WRITE(numout,*) 'Reading data from file ', clfile 164 CALL iom_open( clfile, inum ) 165 igrd = 4 166 IF( nblendta(igrd) <= 0 ) THEN 167 idvar = iom_varid( inum,'z1' ) 168 IF(lwp) WRITE(numout,*) 'iom_file(1)%ndims(idvar) : ',iom_file%ndims(idvar) 169 nblendta(igrd) = iom_file(inum)%dimsz(1,idvar) 170 WRITE(numout,*) 'Dim size for z1 is ', nblendta(igrd) 171 ENDIF 172 ipi = nblendta(igrd) 173 CALL iom_get( inum, jpdom_unknown, 'z1', zdta(1:ipi,1:ipj) ) 174 DO ib = 1, nblenrim(igrd) 175 ssh1(ib,itide) = zdta(nbmap(ib,igrd),1) 176 END DO 177 CALL iom_get( inum, jpdom_unknown, 'z2', zdta(1:ipi,1:ipj) ) 178 DO ib = 1, nblenrim(igrd) 179 ssh2(ib,itide) = zdta(nbmap(ib,igrd),1) 180 END DO 181 CALL iom_close( inum ) 182 ! 183 ! ! U fields 184 clfile = TRIM(filtide)//TRIM(tide_cpt(itide))//'_grid_U.nc' 185 IF(lwp) WRITE(numout,*) 'Reading data from file ', clfile 186 CALL iom_open( clfile, inum ) 187 igrd = 5 188 IF( lendta(igrd) <= 0 ) THEN 189 idvar = iom_varid( inum,'u1' ) 190 lendta(igrd) = iom_file(inum)%dimsz(1,idvar) 191 WRITE(numout,*) 'Dim size for u1 is ',lendta(igrd) 192 ENDIF 193 ipi = lendta(igrd) 194 CALL iom_get( inum, jpdom_unknown, 'u1', zdta(1:ipi,1:ipj) ) 195 DO ib = 1, nblenrim(igrd) 196 u1(ib,itide) = zdta(nbmap(ib,igrd),1) 197 END DO 198 CALL iom_get( inum, jpdom_unknown, 'u2', zdta(1:ipi,1:ipj) ) 199 DO ib = 1, nblenrim(igrd) 200 u2(ib,itide) = zdta(nbmap(ib,igrd),1) 201 END DO 202 CALL iom_close( inum ) 203 ! 204 ! ! V fields 205 clfile = TRIM(filtide)//TRIM(tide_cpt(itide))//'_grid_V.nc' 206 if(lwp) write(numout,*) 'Reading data from file ', clfile 207 CALL iom_open( clfile, inum ) 208 igrd = 6 209 IF( lendta(igrd) <= 0 ) THEN 210 idvar = iom_varid( inum,'v1' ) 211 lendta(igrd) = iom_file(inum)%dimsz(1,idvar) 212 WRITE(numout,*) 'Dim size for v1 is ', lendta(igrd) 213 ENDIF 214 ipi = lendta(igrd) 215 CALL iom_get( inum, jpdom_unknown, 'v1', zdta(1:ipi,1:ipj) ) 216 DO ib = 1, nblenrim(igrd) 217 v1(ib,itide) = zdta(nbmap(ib,igrd),1) 218 END DO 219 CALL iom_get( inum, jpdom_unknown, 'v2', zdta(1:ipi,1:ipj) ) 220 DO ib=1, nblenrim(igrd) 221 v2(ib,itide) = zdta(nbmap(ib,igrd),1) 222 END DO 223 CALL iom_close( inum ) 224 ! 225 END DO ! end loop on tidal components 226 227 IF( ln_tide_date ) THEN ! correct for date factors 228 229 !! used nmonth, nyear and nday from daymod.... 230 ! Calculate date corrects for 15 standard consituents 231 ! This is the initialisation step, so nday, nmonth, nyear are the 232 ! initial date/time of the integration. 233 print *, nday,nmonth,nyear 234 nyear = int(ndate0 / 10000 ) ! initial year 235 nmonth = int((ndate0 - nyear * 10000 ) / 100 ) ! initial month 236 nday = int(ndate0 - nyear * 10000 - nmonth * 100) 237 238 CALL uvset( 0, nday, nmonth, nyear, z_ftc, z_vplu ) 239 240 IF(lwp) WRITE(numout,*) 'Correcting tide for date:', nday, nmonth, nyear 241 242 DO itide = 1, ntide ! loop on tidal components 243 ! 244 IF( nindx(itide) /= 0 ) THEN 245 !!gm use rpi and rad global variable 246 z_arg = 3.14159265d0 * z_vplu(nindx(itide)) / 180.0d0 247 z_atde=z_ftc(nindx(itide))*cos(z_arg) 248 z_btde=z_ftc(nindx(itide))*sin(z_arg) 249 IF(lwp) WRITE(numout,'(2i5,8f10.6)') itide, nindx(itide), tide_speed(itide), & 250 & z_ftc(nindx(itide)), z_vplu(nindx(itide)) 251 ELSE 252 z_atde = 1.0_wp 253 z_btde = 0.0_wp 254 ENDIF 255 ! ! elevation 256 igrd = 4 257 DO ib = 1, nblenrim(igrd) 258 z1t = z_atde * ssh1(ib,itide) + z_btde * ssh2(ib,itide) 259 z2t = z_atde * ssh2(ib,itide) - z_btde * ssh1(ib,itide) 260 ssh1(ib,itide) = z1t 261 ssh2(ib,itide) = z2t 262 END DO 263 ! ! u 264 igrd = 5 265 DO ib = 1, nblenrim(igrd) 266 z1t = z_atde * u1(ib,itide) + z_btde * u2(ib,itide) 267 z2t = z_atde * u2(ib,itide) - z_btde * u1(ib,itide) 268 u1(ib,itide) = z1t 269 u2(ib,itide) = z2t 270 END DO 271 ! ! v 272 igrd = 6 273 DO ib = 1, nblenrim(igrd) 274 z1t = z_atde * v1(ib,itide) + z_btde * v2(ib,itide) 275 z2t = z_atde * v2(ib,itide) - z_btde * v1(ib,itide) 276 v1(ib,itide) = z1t 277 v2(ib,itide) = z2t 278 END DO 279 ! 280 END DO ! end loop on tidal components 281 ! 282 ENDIF ! date correction 283 ! 284 END SUBROUTINE tide_data 285 286 287 SUBROUTINE tide_update ( kt, jit ) 269 SUBROUTINE tide_update ( kt, idx, dta, td, jit, time_offset ) 288 270 !!---------------------------------------------------------------------- 289 271 !! *** SUBROUTINE tide_update *** 290 272 !! 291 !! ** Purpose : - Add tidal forcing to ssh bdy, ubtbdy and vbtbdyarrays.273 !! ** Purpose : - Add tidal forcing to ssh, u2d and v2d OBC data arrays. 292 274 !! 293 275 !!---------------------------------------------------------------------- 294 INTEGER, INTENT( in ) :: kt ! Main timestep counter276 INTEGER, INTENT( in ) :: kt ! Main timestep counter 295 277 !!gm doctor jit ==> kit 296 INTEGER, INTENT( in ) :: jit ! Barotropic timestep counter (for timesplitting option) 297 !! 298 INTEGER :: itide, igrd, ib ! dummy loop indices 299 REAL(wp) :: z_arg, z_sarg ! 278 TYPE(OBC_INDEX), INTENT( in ) :: idx ! OBC indices 279 TYPE(OBC_DATA), INTENT(inout) :: dta ! OBC external data 280 TYPE(TIDES_DATA),INTENT( in ) :: td ! tidal harmonics data 281 INTEGER,INTENT(in),OPTIONAL :: jit ! Barotropic timestep counter (for timesplitting option) 282 INTEGER,INTENT( in ), OPTIONAL :: time_offset ! time offset in units of timesteps. NB. if jit 283 ! is present then units = subcycle timesteps. 284 ! time_offset = 0 => get data at "now" time level 285 ! time_offset = -1 => get data at "before" time level 286 ! time_offset = +1 => get data at "after" time level 287 ! etc. 288 !! 289 INTEGER :: itide, igrd, ib ! dummy loop indices 290 INTEGER :: time_add ! time offset in units of timesteps 291 REAL(wp) :: z_arg, z_sarg 300 292 REAL(wp), DIMENSION(jptides_max) :: z_sist, z_cost 301 293 !!---------------------------------------------------------------------- 302 294 295 time_add = 0 296 IF( PRESENT(time_offset) ) THEN 297 time_add = time_offset 298 ENDIF 299 303 300 ! Note tide phase speeds are in deg/hour, so we need to convert the 304 301 ! elapsed time in seconds to hours by dividing by 3600.0 305 IF( jit == 0 ) THEN 306 z_arg = kt * rdt * rad / 3600.0 307 ELSE ! we are in a barotropic subcycle (for timesplitting option) 308 ! z_arg = ( (kt-1) * rdt + jit * rdt / REAL(nn_baro,lwp) ) * rad / 3600.0 309 z_arg = ( (kt-1) * rdt + jit * rdt / REAL(nn_baro,wp) ) * rad / 3600.0 302 IF( PRESENT(jit) ) THEN 303 z_arg = ( (kt-1) * rdt + (jit+time_add) * rdt / REAL(nn_baro,wp) ) * rad / 3600.0 304 ELSE 305 z_arg = (kt+time_add) * rdt * rad / 3600.0 310 306 ENDIF 311 307 312 DO itide = 1, ntide313 z_sarg = z_arg * t ide_speed(itide)308 DO itide = 1, td%ncpt 309 z_sarg = z_arg * td%speed(itide) 314 310 z_cost(itide) = COS( z_sarg ) 315 311 z_sist(itide) = SIN( z_sarg ) 316 312 END DO 317 313 318 ! summing of tidal constituents into BDY arrays 319 sshtide(:) = 0.0 320 utide (:) = 0.0 321 vtide (:) = 0.0 322 ! 323 DO itide = 1, ntide 324 igrd=4 ! SSH on tracer grid. 325 DO ib = 1, nblenrim(igrd) 326 sshtide(ib) =sshtide(ib)+ ssh1(ib,itide)*z_cost(itide) + ssh2(ib,itide)*z_sist(itide) 327 ! if(lwp) write(numout,*) 'z',ib,itide,sshtide(ib), ssh1(ib,itide),ssh2(ib,itide) 314 DO itide = 1, td%ncpt 315 igrd=1 ! SSH on tracer grid. 316 DO ib = 1, idx%nblenrim(igrd) 317 dta%ssh(ib) = dta%ssh(ib) + td%ssh(ib,itide,1)*z_cost(itide) + td%ssh(ib,itide,2)*z_sist(itide) 318 ! if(lwp) write(numout,*) 'z', ib, itide, dta%ssh(ib), td%ssh(ib,itide,1),td%ssh(ib,itide,2) 328 319 END DO 329 igrd= 5! U grid330 DO ib=1, nblenrim(igrd)331 utide(ib) = utide(ib)+ u1(ib,itide)*z_cost(itide) + u2(ib,itide)*z_sist(itide)332 ! if(lwp) write(numout,*) 'u',ib,itide,utide(ib), u1(ib,itide),u2(ib,itide)320 igrd=2 ! U grid 321 DO ib=1, idx%nblenrim(igrd) 322 dta%u2d(ib) = dta%u2d(ib) + td%u(ib,itide,1)*z_cost(itide) + td%u(ib,itide,2)*z_sist(itide) 323 ! if(lwp) write(numout,*) 'u',ib,itide,utide(ib), td%u(ib,itide,1),td%u(ib,itide,2) 333 324 END DO 334 igrd= 6! V grid335 DO ib=1, nblenrim(igrd)336 vtide(ib) = vtide(ib)+ v1(ib,itide)*z_cost(itide) + v2(ib,itide)*z_sist(itide)337 ! if(lwp) write(numout,*) 'v',ib,itide,vtide(ib), v1(ib,itide),v2(ib,itide)325 igrd=3 ! V grid 326 DO ib=1, idx%nblenrim(igrd) 327 dta%v2d(ib) = dta%v2d(ib) + td%v(ib,itide,1)*z_cost(itide) + td%v(ib,itide,2)*z_sist(itide) 328 ! if(lwp) write(numout,*) 'v',ib,itide,vtide(ib), td%v(ib,itide,1),td%v(ib,itide,2) 338 329 END DO 339 330 END DO -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90
r2977 r3116 11 11 !! 'key_bdy' Unstructured Open Boundary Conditions 12 12 !!---------------------------------------------------------------------- 13 !! bdy_tra_frs : Relaxation of tracers on unstructured open boundaries 13 !! bdy_tra : Apply open boundary conditions to T and S 14 !! bdy_tra_frs : Apply Flow Relaxation Scheme 14 15 !!---------------------------------------------------------------------- 15 16 USE oce ! ocean dynamics and tracers variables 16 17 USE dom_oce ! ocean space and time domain variables 17 18 USE bdy_oce ! ocean open boundary conditions 19 USE bdydta, ONLY: bf 18 20 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 19 21 USE in_out_manager ! I/O manager … … 22 24 PRIVATE 23 25 24 PUBLIC bdy_tra _frs! routine called in tranxt.F9026 PUBLIC bdy_tra ! routine called in tranxt.F90 25 27 26 28 !!---------------------------------------------------------------------- … … 31 33 CONTAINS 32 34 33 SUBROUTINE bdy_tra_frs( kt ) 35 SUBROUTINE bdy_tra( kt ) 36 !!---------------------------------------------------------------------- 37 !! *** SUBROUTINE bdy_dyn3d *** 38 !! 39 !! ** Purpose : - Apply open boundary conditions for baroclinic velocities 40 !! 41 !!---------------------------------------------------------------------- 42 INTEGER, INTENT( in ) :: kt ! Main time step counter 43 !! 44 INTEGER :: ib_bdy ! Loop index 45 46 DO ib_bdy=1, nb_bdy 47 48 SELECT CASE( nn_tra(ib_bdy) ) 49 CASE(jp_none) 50 CYCLE 51 CASE(jp_frs) 52 CALL bdy_tra_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 53 CASE DEFAULT 54 CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' ) 55 END SELECT 56 ENDDO 57 58 END SUBROUTINE bdy_tra 59 60 SUBROUTINE bdy_tra_frs( idx, dta, kt ) 34 61 !!---------------------------------------------------------------------- 35 62 !! *** SUBROUTINE bdy_tra_frs *** 36 63 !! 37 !! ** Purpose : Apply the Flow Relaxation Scheme for tracers in the 38 !! case of unstructured open boundaries. 64 !! ** Purpose : Apply the Flow Relaxation Scheme for tracers at open boundaries. 39 65 !! 40 66 !! Reference : Engedahl H., 1995, Tellus, 365-382. 41 67 !!---------------------------------------------------------------------- 42 INTEGER, INTENT( in ) :: kt 68 INTEGER, INTENT(in) :: kt 69 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 70 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 43 71 !! 44 72 REAL(wp) :: zwgt ! boundary weight … … 47 75 !!---------------------------------------------------------------------- 48 76 ! 49 IF(ln_tra_frs) THEN ! If this is false, then this routine does nothing.50 !51 IF( kt == nit000 ) THEN52 IF(lwp) WRITE(numout,*)53 IF(lwp) WRITE(numout,*) 'bdy_tra_frs : Flow Relaxation Scheme for tracers'54 IF(lwp) WRITE(numout,*) '~~~~~~~'55 ENDIF56 !57 igrd = 1 ! Everything is at T-points here58 DO ib = 1, nblen(igrd)59 DO ik = 1, jpkm160 ii = nbi(ib,igrd)61 ij = nbj(ib,igrd)62 zwgt = nbw(ib,igrd)63 tsa(ii,ij,ik,jp_tem) = ( tsa(ii,ij,ik,jp_tem) * (1.-zwgt) + tbdy(ib,ik) * zwgt ) * tmask(ii,ij,ik)64 tsa(ii,ij,ik,jp_sal) = ( tsa(ii,ij,ik,jp_sal) * (1.-zwgt) + sbdy(ib,ik) * zwgt ) * tmask(ii,ij,ik)65 END DO66 END DO67 ! ! Boundary points should be updated68 CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )69 CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )70 !71 ENDIF ! ln_tra_frs72 77 ! 78 igrd = 1 ! Everything is at T-points here 79 DO ib = 1, idx%nblen(igrd) 80 DO ik = 1, jpkm1 81 ii = idx%nbi(ib,igrd) 82 ij = idx%nbj(ib,igrd) 83 zwgt = idx%nbw(ib,igrd) 84 tsa(ii,ij,ik,jp_tem) = ( tsa(ii,ij,ik,jp_tem) + zwgt * ( dta%tem(ib,ik) - tsa(ii,ij,ik,jp_tem) ) ) * tmask(ii,ij,ik) 85 tsa(ii,ij,ik,jp_sal) = ( tsa(ii,ij,ik,jp_sal) + zwgt * ( dta%sal(ib,ik) - tsa(ii,ij,ik,jp_sal) ) ) * tmask(ii,ij,ik) 86 END DO 87 END DO 88 ! 89 CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. ) ; CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. ) ! Boundary points should be updated 90 ! 91 IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 92 ! 73 93 END SUBROUTINE bdy_tra_frs 74 94 … … 78 98 !!---------------------------------------------------------------------- 79 99 CONTAINS 80 SUBROUTINE bdy_tra _frs(kt) ! Empty routine81 WRITE(*,*) 'bdy_tra _frs: You should not have seen this print! error?', kt82 END SUBROUTINE bdy_tra _frs100 SUBROUTINE bdy_tra(kt) ! Empty routine 101 WRITE(*,*) 'bdy_tra: You should not have seen this print! error?', kt 102 END SUBROUTINE bdy_tra 83 103 #endif 84 104 -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90
r2528 r3116 71 71 !! 72 72 INTEGER :: ji, jj, jk, jb, jgrd 73 INTEGER :: i i, ij73 INTEGER :: ib_bdy, ii, ij 74 74 REAL(wp) :: zubtpecor, z_cflxemp, ztranst 75 TYPE(OBC_INDEX), POINTER :: idx 75 76 !!----------------------------------------------------------------------------- 76 77 … … 91 92 ! ------------------------------------------------ 92 93 zubtpecor = 0.e0 93 jgrd = 2 ! cumulate u component contribution first 94 DO jb = 1, nblenrim(jgrd) 95 DO jk = 1, jpkm1 96 ii = nbi(jb,jgrd) 97 ij = nbj(jb,jgrd) 98 zubtpecor = zubtpecor + flagu(jb) * ua(ii,ij, jk) * e2u(ii,ij) * fse3u(ii,ij,jk) 94 DO ib_bdy = 1, nb_bdy 95 idx => idx_bdy(ib_bdy) 96 97 jgrd = 2 ! cumulate u component contribution first 98 DO jb = 1, idx%nblenrim(jgrd) 99 DO jk = 1, jpkm1 100 ii = idx%nbi(jb,jgrd) 101 ij = idx%nbj(jb,jgrd) 102 zubtpecor = zubtpecor + idx%flagu(jb) * ua(ii,ij, jk) * e2u(ii,ij) * fse3u(ii,ij,jk) 103 END DO 99 104 END DO 100 END DO101 jgrd = 3 ! then add v component contribution102 DO jb = 1, nblenrim(jgrd)103 DO jk = 1, jpkm1104 ii = nbi(jb,jgrd)105 ij = nbj(jb,jgrd)106 zubtpecor = zubtpecor + flagv(jb) * va(ii,ij, jk) * e1v(ii,ij) * fse3v(ii,ij,jk)105 jgrd = 3 ! then add v component contribution 106 DO jb = 1, idx%nblenrim(jgrd) 107 DO jk = 1, jpkm1 108 ii = idx%nbi(jb,jgrd) 109 ij = idx%nbj(jb,jgrd) 110 zubtpecor = zubtpecor + idx%flagv(jb) * va(ii,ij, jk) * e1v(ii,ij) * fse3v(ii,ij,jk) 111 END DO 107 112 END DO 113 108 114 END DO 109 115 IF( lk_mpp ) CALL mpp_sum( zubtpecor ) ! sum over the global domain … … 118 124 ! ------------------------------------------------------------- 119 125 ztranst = 0.e0 120 jgrd = 2 ! correct u component 121 DO jb = 1, nblenrim(jgrd) 122 DO jk = 1, jpkm1 123 ii = nbi(jb,jgrd) 124 ij = nbj(jb,jgrd) 125 ua(ii,ij,jk) = ua(ii,ij,jk) - flagu(jb) * zubtpecor * umask(ii,ij,jk) 126 ztranst = ztranst + flagu(jb) * ua(ii,ij,jk) * e2u(ii,ij) * fse3u(ii,ij,jk) 126 DO ib_bdy = 1, nb_bdy 127 idx => idx_bdy(ib_bdy) 128 129 jgrd = 2 ! correct u component 130 DO jb = 1, idx%nblenrim(jgrd) 131 DO jk = 1, jpkm1 132 ii = idx%nbi(jb,jgrd) 133 ij = idx%nbj(jb,jgrd) 134 ua(ii,ij,jk) = ua(ii,ij,jk) - idx%flagu(jb) * zubtpecor * umask(ii,ij,jk) 135 ztranst = ztranst + idx%flagu(jb) * ua(ii,ij,jk) * e2u(ii,ij) * fse3u(ii,ij,jk) 136 END DO 127 137 END DO 128 END DO129 jgrd = 3 ! correct v component130 DO jb = 1, nblenrim(jgrd)131 DO jk = 1, jpkm1132 ii = nbi(jb,jgrd)133 ij = nbj(jb,jgrd)134 va(ii,ij,jk) = va(ii,ij,jk) -flagv(jb) * zubtpecor * vmask(ii,ij,jk)135 ztranst = ztranst + flagv(jb) * va(ii,ij,jk) * e1v(ii,ij) * fse3v(ii,ij,jk)138 jgrd = 3 ! correct v component 139 DO jb = 1, idx%nblenrim(jgrd) 140 DO jk = 1, jpkm1 141 ii = idx%nbi(jb,jgrd) 142 ij = idx%nbj(jb,jgrd) 143 va(ii,ij,jk) = va(ii,ij,jk) -idx%flagv(jb) * zubtpecor * vmask(ii,ij,jk) 144 ztranst = ztranst + idx%flagv(jb) * va(ii,ij,jk) * e1v(ii,ij) * fse3v(ii,ij,jk) 145 END DO 136 146 END DO 147 137 148 END DO 138 149 IF( lk_mpp ) CALL mpp_sum( ztranst ) ! sum over the global domain -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r2977 r3116 18 18 USE lib_mpp ! distributed memory computing library 19 19 USE trabbc ! bottom boundary condition 20 USE obc_par ! (for lk_obc) 20 21 USE bdy_par ! (for lk_bdy) 21 USE obc_par ! (for lk_obc)22 22 23 23 IMPLICIT NONE … … 205 205 WRITE(numout,*) "dia_hsb: heat salt volume budgets activated" 206 206 WRITE(numout,*) "~~~~~~~ output written in the 'heat_salt_volume_budgets.txt' ASCII file" 207 IF( lk_obc . OR. lk_bdy) THEN207 IF( lk_obc .or. lk_bdy ) THEN 208 208 CALL ctl_warn( 'dia_hsb does not take open boundary fluxes into account' ) 209 209 ENDIF -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r2715 r3116 150 150 LOGICAL, PUBLIC, PARAMETER :: lk_vvl = .FALSE. !: fixed grid flag 151 151 #endif 152 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hur , hvr !: inverse of u and v-points ocean depth (1/m)153 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu , hv !: depth at u- and v-points (meters)154 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_0 , hv_0 !: refernce depth at u- and v-points (meters)152 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: hur , hvr !: inverse of u and v-points ocean depth (1/m) 153 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu , hv !: depth at u- and v-points (meters) 154 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_0 , hv_0 !: refernce depth at u- and v-points (meters) 155 155 156 156 INTEGER, PUBLIC :: nla10 !: deepest W level Above ~10m (nlb10 - 1) -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
r3097 r3116 25 25 USE oce ! ocean dynamics and tracers 26 26 USE dom_oce ! ocean space and time domain 27 USE obc_oce ! ocean open boundary conditions28 27 USE in_out_manager ! I/O manager 29 28 USE lbclnk ! ocean lateral boundary conditions (or mpp link) -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r2779 r3116 24 24 PRIVATE 25 25 26 PUBLIC dom_vvl ! called by domain.F9027 PUBLIC dom_vvl_ alloc ! called by nemogcm.F9028 29 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ee_t, ee_u, ee_v, ee_f !: ??? 30 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: mut , muu , muv , muf !: ???26 PUBLIC dom_vvl ! called by domain.F90 27 PUBLIC dom_vvl_2 ! called by domain.F90 28 PUBLIC dom_vvl_alloc ! called by nemogcm.F90 29 30 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: mut , muu , muv , muf !: 1/H_0 at t-,u-,v-,f-points 31 31 32 32 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: r2dt ! vertical profile time-step, = 2 rdttra … … 49 49 ! 50 50 ALLOCATE( mut (jpi,jpj,jpk) , muu (jpi,jpj,jpk) , muv (jpi,jpj,jpk) , muf (jpi,jpj,jpk) , & 51 & ee_t(jpi,jpj) , ee_u(jpi,jpj) , ee_v(jpi,jpj) , ee_f(jpi,jpj) , &52 51 & r2dt (jpk) , STAT=dom_vvl_alloc ) 53 52 ! … … 62 61 !! *** ROUTINE dom_vvl *** 63 62 !! 64 !! ** Purpose : compute coefficients muX at T-U-V-F points to spread 65 !! ssh over the whole water column (scale factors) 63 !! ** Purpose : compute mu coefficients at t-, u-, v- and f-points to 64 !! spread ssh over the whole water column (scale factors) 65 !! set the before and now ssh at u- and v-points 66 !! (also f-point in now case) 66 67 !!---------------------------------------------------------------------- 67 68 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 68 USE wrk_nemo, ONLY: z s_t => wrk_2d_1 , zs_u_1 => wrk_2d_2 , zs_v_1 => wrk_2d_3! 2D workspace69 USE wrk_nemo, ONLY: zee_t => wrk_2d_1, zee_u => wrk_2d_2, zee_v => wrk_2d_3, zee_f => wrk_2d_4 ! 2D workspace 69 70 ! 70 71 INTEGER :: ji, jj, jk ! dummy loop indices 71 REAL(wp) :: zcoefu , zcoefv , zcoeff! local scalars72 REAL(wp) :: zv _t_ij, zv_t_ip1j, zv_t_ijp1, zv_t_ip1jp1 ! - -73 !!---------------------------------------------------------------------- 74 75 IF( wrk_in_use(2, 1,2,3 ) ) THEN72 REAL(wp) :: zcoefu, zcoefv , zcoeff ! local scalars 73 REAL(wp) :: zvt , zvt_ip1, zvt_jp1, zvt_ip1jp1 ! - - 74 !!---------------------------------------------------------------------- 75 76 IF( wrk_in_use(2, 1,2,3,4) ) THEN 76 77 CALL ctl_stop('dom_vvl: requested workspace arrays unavailable') ; RETURN 77 78 ENDIF … … 97 98 98 99 ! !== mu computation ==! 99 ee_t(:,:) = fse3t_0(:,:,1) ! Lower bound : thickness of the first model level100 ee_u(:,:) = fse3u_0(:,:,1)101 ee_v(:,:) = fse3v_0(:,:,1)102 ee_f(:,:) = fse3f_0(:,:,1)100 zee_t(:,:) = fse3t_0(:,:,1) ! Lower bound : thickness of the first model level 101 zee_u(:,:) = fse3u_0(:,:,1) 102 zee_v(:,:) = fse3v_0(:,:,1) 103 zee_f(:,:) = fse3f_0(:,:,1) 103 104 DO jk = 2, jpkm1 ! Sum of the masked vertical scale factors 104 ee_t(:,:) =ee_t(:,:) + fse3t_0(:,:,jk) * tmask(:,:,jk)105 ee_u(:,:) =ee_u(:,:) + fse3u_0(:,:,jk) * umask(:,:,jk)106 ee_v(:,:) =ee_v(:,:) + fse3v_0(:,:,jk) * vmask(:,:,jk)105 zee_t(:,:) = zee_t(:,:) + fse3t_0(:,:,jk) * tmask(:,:,jk) 106 zee_u(:,:) = zee_u(:,:) + fse3u_0(:,:,jk) * umask(:,:,jk) 107 zee_v(:,:) = zee_v(:,:) + fse3v_0(:,:,jk) * vmask(:,:,jk) 107 108 DO jj = 1, jpjm1 ! f-point : fmask=shlat at coasts, use the product of umask 108 ee_f(:,jj) =ee_f(:,jj) + fse3f_0(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk)109 zee_f(:,jj) = zee_f(:,jj) + fse3f_0(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk) 109 110 END DO 110 111 END DO 111 112 ! ! Compute and mask the inverse of the local depth at T, U, V and F points 112 ee_t(:,:) = 1. /ee_t(:,:) * tmask(:,:,1)113 ee_u(:,:) = 1. /ee_u(:,:) * umask(:,:,1)114 ee_v(:,:) = 1. /ee_v(:,:) * vmask(:,:,1)113 zee_t(:,:) = 1._wp / zee_t(:,:) * tmask(:,:,1) 114 zee_u(:,:) = 1._wp / zee_u(:,:) * umask(:,:,1) 115 zee_v(:,:) = 1._wp / zee_v(:,:) * vmask(:,:,1) 115 116 DO jj = 1, jpjm1 ! f-point case fmask cannot be used 116 ee_f(:,jj) = 1. /ee_f(:,jj) * umask(:,jj,1) * umask(:,jj+1,1)117 END DO 118 CALL lbc_lnk( ee_f, 'F', 1. )! lateral boundary condition on ee_f117 zee_f(:,jj) = 1._wp / zee_f(:,jj) * umask(:,jj,1) * umask(:,jj+1,1) 118 END DO 119 CALL lbc_lnk( zee_f, 'F', 1. ) ! lateral boundary condition on ee_f 119 120 ! 120 121 DO jk = 1, jpk ! mu coefficients 121 mut(:,:,jk) = ee_t(:,:) * tmask(:,:,jk) ! T-point at T levels122 muu(:,:,jk) = ee_u(:,:) * umask(:,:,jk) ! U-point at T levels123 muv(:,:,jk) = ee_v(:,:) * vmask(:,:,jk) ! V-point at T levels122 mut(:,:,jk) = zee_t(:,:) * tmask(:,:,jk) ! T-point at T levels 123 muu(:,:,jk) = zee_u(:,:) * umask(:,:,jk) ! U-point at T levels 124 muv(:,:,jk) = zee_v(:,:) * vmask(:,:,jk) ! V-point at T levels 124 125 END DO 125 126 DO jk = 1, jpk ! F-point : fmask=shlat at coasts, use the product of umask 126 127 DO jj = 1, jpjm1 127 muf(:,jj,jk) = ee_f(:,jj) * umask(:,jj,jk) * umask(:,jj+1,jk) ! at T levels128 END DO 129 muf(:,jpj,jk) = 0. e0128 muf(:,jj,jk) = zee_f(:,jj) * umask(:,jj,jk) * umask(:,jj+1,jk) ! at T levels 129 END DO 130 muf(:,jpj,jk) = 0._wp 130 131 END DO 131 132 CALL lbc_lnk( muf, 'F', 1. ) ! lateral boundary condition … … 139 140 END DO 140 141 141 ! surface at t-points and inverse surface at (u/v)-points used in surface averaging computations142 ! for ssh and scale factors143 zs_t (:,:) = e1t(:,:) * e2t(:,:)144 zs_u_1(:,:) = 0.5 / ( e1u(:,:) * e2u(:,:) )145 zs_v_1(:,:) = 0.5 / ( e1v(:,:) * e2v(:,:) )146 147 142 DO jj = 1, jpjm1 ! initialise before and now Sea Surface Height at u-, v-, f-points 148 143 DO ji = 1, jpim1 ! NO vector opt. 149 zcoefu = umask(ji,jj,1) * zs_u_1(ji,jj)150 zcoefv = vmask(ji,jj,1) * zs_v_1(ji,jj)151 zcoeff = 0. 5 * umask(ji,jj,1) * umask(ji,jj+1,1) / ( e1f(ji,jj) * e2f(ji,jj))152 ! before fields153 zv _t_ij = zs_t(ji ,jj ) * sshb(ji ,jj )154 zv _t_ip1j = zs_t(ji+1,jj ) * sshb(ji+1,jj )155 zv _t_ijp1 = zs_t(ji ,jj+1) * sshb(ji ,jj+1)156 sshu_b(ji,jj) = zcoefu * ( zv _t_ij + zv_t_ip1j)157 sshv_b(ji,jj) = zcoefv * ( zv _t_ij + zv_t_ijp1 )158 ! now fields159 zv _t_ij = zs_t(ji ,jj ) * sshn(ji ,jj )160 zv _t_ip1j = zs_t(ji+1,jj ) * sshn(ji+1,jj )161 zv _t_ijp1 = zs_t(ji ,jj+1) * sshn(ji ,jj+1)162 zv _t_ip1jp1 = zs_t(ji ,jj+1) * sshn(ji,jj+1)163 sshu_n(ji,jj) = zcoefu * ( zv _t_ij + zv_t_ip1j)164 sshv_n(ji,jj) = zcoefv * ( zv _t_ij + zv_t_ijp1 )165 sshf_n(ji,jj) = zcoeff * ( zv _t_ij + zv_t_ip1j + zv_t_ijp1 + zv_t_ip1jp1 )144 zcoefu = 0.50_wp / ( e1u(ji,jj) * e2u(ji,jj) ) * umask(ji,jj,1) 145 zcoefv = 0.50_wp / ( e1v(ji,jj) * e2v(ji,jj) ) * vmask(ji,jj,1) 146 zcoeff = 0.25_wp / ( e1f(ji,jj) * e2f(ji,jj) ) * umask(ji,jj,1) * umask(ji,jj+1,1) 147 ! 148 zvt = e1e2t(ji ,jj ) * sshb(ji ,jj ) ! before fields 149 zvt_ip1 = e1e2t(ji+1,jj ) * sshb(ji+1,jj ) 150 zvt_jp1 = e1e2t(ji ,jj+1) * sshb(ji ,jj+1) 151 sshu_b(ji,jj) = zcoefu * ( zvt + zvt_ip1 ) 152 sshv_b(ji,jj) = zcoefv * ( zvt + zvt_jp1 ) 153 ! 154 zvt = e1e2t(ji ,jj ) * sshn(ji ,jj ) ! now fields 155 zvt_ip1 = e1e2t(ji+1,jj ) * sshn(ji+1,jj ) 156 zvt_jp1 = e1e2t(ji ,jj+1) * sshn(ji ,jj+1) 157 zvt_ip1jp1 = e1e2t(ji+1,jj+1) * sshn(ji+1,jj+1) 158 sshu_n(ji,jj) = zcoefu * ( zvt + zvt_ip1 ) 159 sshv_n(ji,jj) = zcoefv * ( zvt + zvt_jp1 ) 160 sshf_n(ji,jj) = zcoeff * ( zvt + zvt_ip1 + zvt_jp1 + zvt_ip1jp1 ) 166 161 END DO 167 162 END DO … … 169 164 CALL lbc_lnk( sshv_n, 'V', 1. ) ; CALL lbc_lnk( sshv_b, 'V', 1. ) 170 165 CALL lbc_lnk( sshf_n, 'F', 1. ) 171 172 ! initialise before scale factors at (u/v)-points 173 ! Scale factor anomaly at (u/v)-points: surface averaging of scale factor at t-points 174 DO jk = 1, jpkm1 175 DO jj = 1, jpjm1 176 DO ji = 1, jpim1 177 zv_t_ij = zs_t(ji ,jj ) * fse3t_b(ji ,jj ,jk) 178 zv_t_ip1j = zs_t(ji+1,jj ) * fse3t_b(ji+1,jj ,jk) 179 zv_t_ijp1 = zs_t(ji ,jj+1) * fse3t_b(ji ,jj+1,jk) 180 fse3u_b(ji,jj,jk) = umask(ji,jj,jk) * ( zs_u_1(ji,jj) * ( zv_t_ij + zv_t_ip1j ) - fse3u_0(ji,jj,jk) ) 181 fse3v_b(ji,jj,jk) = vmask(ji,jj,jk) * ( zs_v_1(ji,jj) * ( zv_t_ij + zv_t_ijp1 ) - fse3v_0(ji,jj,jk) ) 182 END DO 183 END DO 184 END DO 185 CALL lbc_lnk( fse3u_b(:,:,:), 'U', 1. ) ! lateral boundary conditions 186 CALL lbc_lnk( fse3v_b(:,:,:), 'V', 1. ) 187 ! Add initial scale factor to scale factor anomaly 188 fse3u_b(:,:,:) = fse3u_b(:,:,:) + fse3u_0(:,:,:) 189 fse3v_b(:,:,:) = fse3v_b(:,:,:) + fse3v_0(:,:,:) 190 ! 191 IF( wrk_not_released(2, 1,2,3) ) CALL ctl_stop('dom_vvl: failed to release workspace arrays') 166 ! 167 IF( wrk_not_released(2, 1,2,3,4) ) CALL ctl_stop('dom_vvl: failed to release workspace arrays') 192 168 ! 193 169 END SUBROUTINE dom_vvl 194 170 171 172 SUBROUTINE dom_vvl_2( kt, pe3u_b, pe3v_b ) 173 !!---------------------------------------------------------------------- 174 !! *** ROUTINE dom_vvl_2 *** 175 !! 176 !! ** Purpose : compute the vertical scale factors at u- and v-points 177 !! in variable volume case. 178 !! 179 !! ** Method : In variable volume case (non linear sea surface) the 180 !! the vertical scale factor at velocity points is computed 181 !! as the average of the cell surface weighted e3t. 182 !! It uses the sea surface heigth so it have to be initialized 183 !! after ssh is read/set 184 !!---------------------------------------------------------------------- 185 INTEGER , INTENT(in ) :: kt ! ocean time-step index 186 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pe3u_b, pe3v_b ! before vertical scale factor at u- & v-pts 187 ! 188 INTEGER :: ji, jj, jk ! dummy loop indices 189 INTEGER :: iku, ikv ! local integers 190 INTEGER :: ii0, ii1, ij0, ij1 ! temporary integers 191 REAL(wp) :: zvt ! local scalars 192 !!---------------------------------------------------------------------- 193 194 IF( lwp .AND. kt == nit000 ) THEN 195 WRITE(numout,*) 196 WRITE(numout,*) 'dom_vvl_2 : Variable volume, fse3t_b initialization' 197 WRITE(numout,*) '~~~~~~~~~ ' 198 pe3u_b(:,:,jpk) = fse3u_0(:,:,jpk) 199 pe3v_b(:,:,jpk) = fse3u_0(:,:,jpk) 200 ENDIF 201 202 DO jk = 1, jpkm1 ! set the before scale factors at u- & v-points 203 DO jj = 2, jpjm1 204 DO ji = fs_2, fs_jpim1 205 zvt = fse3t_b(ji,jj,jk) * e1e2t(ji,jj) 206 pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1e2t(ji+1,jj) ) / ( e1u(ji,jj) * e2u(ji,jj) ) 207 pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e1e2t(ji,jj+1) ) / ( e1v(ji,jj) * e2v(ji,jj) ) 208 END DO 209 END DO 210 END DO 211 212 ! Correct scale factors at locations that have been individually modified in domhgr 213 ! Such modifications break the relationship between e1e2t and e1u*e2u etc. Recompute 214 ! scale factors ignoring the modified metric. 215 ! ! ===================== 216 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA R2 configuration 217 ! ! ===================== 218 IF( nn_cla == 0 ) THEN 219 ! 220 ii0 = 139 ; ii1 = 140 ! Gibraltar Strait (e2u was modified) 221 ij0 = 102 ; ij1 = 102 222 DO jk = 1, jpkm1 ! set the before scale factors at u-points 223 DO jj = mj0(ij0), mj1(ij1) 224 DO ji = mi0(ii0), mi1(ii1) 225 zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj) 226 pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) ) 227 END DO 228 END DO 229 END DO 230 ! 231 ii0 = 160 ; ii1 = 160 ! Bab el Mandeb (e2u and e1v were modified) 232 ij0 = 88 ; ij1 = 88 233 DO jk = 1, jpkm1 ! set the before scale factors at u-points 234 DO jj = mj0(ij0), mj1(ij1) 235 DO ji = mi0(ii0), mi1(ii1) 236 zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj) 237 pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) ) 238 END DO 239 END DO 240 END DO 241 DO jk = 1, jpkm1 ! set the before scale factors at v-points 242 DO jj = mj0(ij0), mj1(ij1) 243 DO ji = mi0(ii0), mi1(ii1) 244 zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj) 245 pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) ) 246 END DO 247 END DO 248 END DO 249 ENDIF 250 251 ii0 = 145 ; ii1 = 146 ! Danish Straits (e2u was modified) 252 ij0 = 116 ; ij1 = 116 253 DO jk = 1, jpkm1 ! set the before scale factors at u-points 254 DO jj = mj0(ij0), mj1(ij1) 255 DO ji = mi0(ii0), mi1(ii1) 256 zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj) 257 pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) ) 258 END DO 259 END DO 260 END DO 261 ! 262 ENDIF 263 ! ! ===================== 264 IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN ! ORCA R1 configuration 265 ! ! ===================== 266 267 ii0 = 281 ; ii1 = 282 ! Gibraltar Strait (e2u was modified) 268 ij0 = 200 ; ij1 = 200 269 DO jk = 1, jpkm1 ! set the before scale factors at u-points 270 DO jj = mj0(ij0), mj1(ij1) 271 DO ji = mi0(ii0), mi1(ii1) 272 zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj) 273 pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) ) 274 END DO 275 END DO 276 END DO 277 278 ii0 = 314 ; ii1 = 315 ! Bhosporus Strait (e2u was modified) 279 ij0 = 208 ; ij1 = 208 280 DO jk = 1, jpkm1 ! set the before scale factors at u-points 281 DO jj = mj0(ij0), mj1(ij1) 282 DO ji = mi0(ii0), mi1(ii1) 283 zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj) 284 pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) ) 285 END DO 286 END DO 287 END DO 288 289 ii0 = 44 ; ii1 = 44 ! Lombok Strait (e1v was modified) 290 ij0 = 124 ; ij1 = 125 291 DO jk = 1, jpkm1 ! set the before scale factors at v-points 292 DO jj = mj0(ij0), mj1(ij1) 293 DO ji = mi0(ii0), mi1(ii1) 294 zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj) 295 pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) ) 296 END DO 297 END DO 298 END DO 299 300 ii0 = 48 ; ii1 = 48 ! Sumba Strait (e1v was modified) [closed from bathy_11 on] 301 ij0 = 124 ; ij1 = 125 302 DO jk = 1, jpkm1 ! set the before scale factors at v-points 303 DO jj = mj0(ij0), mj1(ij1) 304 DO ji = mi0(ii0), mi1(ii1) 305 zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj) 306 pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) ) 307 END DO 308 END DO 309 END DO 310 311 ii0 = 53 ; ii1 = 53 ! Ombai Strait (e1v was modified) 312 ij0 = 124 ; ij1 = 125 313 DO jk = 1, jpkm1 ! set the before scale factors at v-points 314 DO jj = mj0(ij0), mj1(ij1) 315 DO ji = mi0(ii0), mi1(ii1) 316 zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj) 317 pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) ) 318 END DO 319 END DO 320 END DO 321 322 ii0 = 56 ; ii1 = 56 ! Timor Passage (e1v was modified) 323 ij0 = 124 ; ij1 = 125 324 DO jk = 1, jpkm1 ! set the before scale factors at v-points 325 DO jj = mj0(ij0), mj1(ij1) 326 DO ji = mi0(ii0), mi1(ii1) 327 zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj) 328 pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) ) 329 END DO 330 END DO 331 END DO 332 333 ii0 = 55 ; ii1 = 55 ! West Halmahera Strait (e1v was modified) 334 ij0 = 141 ; ij1 = 142 335 DO jk = 1, jpkm1 ! set the before scale factors at v-points 336 DO jj = mj0(ij0), mj1(ij1) 337 DO ji = mi0(ii0), mi1(ii1) 338 zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj) 339 pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) ) 340 END DO 341 END DO 342 END DO 343 344 ii0 = 58 ; ii1 = 58 ! East Halmahera Strait (e1v was modified) 345 ij0 = 141 ; ij1 = 142 346 DO jk = 1, jpkm1 ! set the before scale factors at v-points 347 DO jj = mj0(ij0), mj1(ij1) 348 DO ji = mi0(ii0), mi1(ii1) 349 zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj) 350 pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) ) 351 END DO 352 END DO 353 END DO 354 355 ! 356 ENDIF 357 ! ! ====================== 358 IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN ! ORCA R05 configuration 359 ! ! ====================== 360 ii0 = 563 ; ii1 = 564 ! Gibraltar Strait (e2u was modified) 361 ij0 = 327 ; ij1 = 327 362 DO jk = 1, jpkm1 ! set the before scale factors at u-points 363 DO jj = mj0(ij0), mj1(ij1) 364 DO ji = mi0(ii0), mi1(ii1) 365 zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj) 366 pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) ) 367 END DO 368 END DO 369 END DO 370 ! 371 ii0 = 627 ; ii1 = 628 ! Bosphore Strait (e2u was modified) 372 ij0 = 343 ; ij1 = 343 373 DO jk = 1, jpkm1 ! set the before scale factors at u-points 374 DO jj = mj0(ij0), mj1(ij1) 375 DO ji = mi0(ii0), mi1(ii1) 376 zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj) 377 pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) ) 378 END DO 379 END DO 380 END DO 381 ! 382 ii0 = 93 ; ii1 = 94 ! Sumba Strait (e2u was modified) 383 ij0 = 232 ; ij1 = 232 384 DO jk = 1, jpkm1 ! set the before scale factors at u-points 385 DO jj = mj0(ij0), mj1(ij1) 386 DO ji = mi0(ii0), mi1(ii1) 387 zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj) 388 pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) ) 389 END DO 390 END DO 391 END DO 392 ! 393 ii0 = 103 ; ii1 = 103 ! Ombai Strait (e2u was modified) 394 ij0 = 232 ; ij1 = 232 395 DO jk = 1, jpkm1 ! set the before scale factors at u-points 396 DO jj = mj0(ij0), mj1(ij1) 397 DO ji = mi0(ii0), mi1(ii1) 398 zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj) 399 pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) ) 400 END DO 401 END DO 402 END DO 403 ! 404 ii0 = 15 ; ii1 = 15 ! Palk Strait (e2u was modified) 405 ij0 = 270 ; ij1 = 270 406 DO jk = 1, jpkm1 ! set the before scale factors at u-points 407 DO jj = mj0(ij0), mj1(ij1) 408 DO ji = mi0(ii0), mi1(ii1) 409 zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj) 410 pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) ) 411 END DO 412 END DO 413 END DO 414 ! 415 ii0 = 87 ; ii1 = 87 ! Lombok Strait (e1v was modified) 416 ij0 = 232 ; ij1 = 233 417 DO jk = 1, jpkm1 ! set the before scale factors at v-points 418 DO jj = mj0(ij0), mj1(ij1) 419 DO ji = mi0(ii0), mi1(ii1) 420 zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj) 421 pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) ) 422 END DO 423 END DO 424 END DO 425 ! 426 ii0 = 662 ; ii1 = 662 ! Bab el Mandeb (e1v was modified) 427 ij0 = 276 ; ij1 = 276 428 DO jk = 1, jpkm1 ! set the before scale factors at v-points 429 DO jj = mj0(ij0), mj1(ij1) 430 DO ji = mi0(ii0), mi1(ii1) 431 zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj) 432 pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) ) 433 END DO 434 END DO 435 END DO 436 ! 437 ENDIF 438 ! End of individual corrections to scale factors 439 440 IF( ln_zps ) THEN ! minimum of the e3t at partial cell level 441 DO jj = 2, jpjm1 442 DO ji = fs_2, fs_jpim1 443 iku = mbku(ji,jj) 444 ikv = mbkv(ji,jj) 445 pe3u_b(ji,jj,iku) = MIN( fse3t_b(ji,jj,iku), fse3t_b(ji+1,jj ,iku) ) 446 pe3v_b(ji,jj,ikv) = MIN( fse3t_b(ji,jj,ikv), fse3t_b(ji ,jj+1,ikv) ) 447 END DO 448 END DO 449 ENDIF 450 451 pe3u_b(:,:,:) = pe3u_b(:,:,:) - fse3u_0(:,:,:) ! anomaly to avoid zero along closed boundary/extra halos 452 pe3v_b(:,:,:) = pe3v_b(:,:,:) - fse3v_0(:,:,:) 453 CALL lbc_lnk( pe3u_b(:,:,:), 'U', 1. ) ! lateral boundary conditions 454 CALL lbc_lnk( pe3v_b(:,:,:), 'V', 1. ) 455 pe3u_b(:,:,:) = pe3u_b(:,:,:) + fse3u_0(:,:,:) ! recover the full scale factor 456 pe3v_b(:,:,:) = pe3v_b(:,:,:) + fse3v_0(:,:,:) 457 ! 458 END SUBROUTINE dom_vvl_2 459 195 460 #else 196 461 !!---------------------------------------------------------------------- … … 200 465 SUBROUTINE dom_vvl 201 466 END SUBROUTINE dom_vvl 467 SUBROUTINE dom_vvl_2(kdum, pudum, pvdum ) 468 USE par_kind 469 INTEGER , INTENT(in ) :: kdum 470 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pudum, pvdum 471 END SUBROUTINE dom_vvl_2 202 472 #endif 203 473 -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r2715 r3116 1495 1495 ! 1496 1496 !! H. Liu, POL. April 2009. Added for passing the scale check for the new released vvl code. 1497 where (e3t (:,:,:).eq.0.0) e3t(:,:,:) = 1.0 1498 where (e3u (:,:,:).eq.0.0) e3u(:,:,:) = 1.0 1499 where (e3v (:,:,:).eq.0.0) e3v(:,:,:) = 1.0 1500 where (e3f (:,:,:).eq.0.0) e3f(:,:,:) = 1.0 1501 where (e3w (:,:,:).eq.0.0) e3w(:,:,:) = 1.0 1502 where (e3uw (:,:,:).eq.0.0) e3uw(:,:,:) = 1.0 1503 where (e3vw (:,:,:).eq.0.0) e3vw(:,:,:) = 1.0 1504 1497 1505 1498 1506 fsdept(:,:,:) = gdept (:,:,:) -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
r2977 r3116 83 83 neuler = 1 ! Set time-step indicator at nit000 (leap-frog) 84 84 CALL rst_read ! Read the restart file 85 ! ! define e3u_b, e3v_b from e3t_b read in restart file 86 CALL dom_vvl_2( nit000, fse3u_b(:,:,:), fse3v_b(:,:,:) ) 85 87 CALL day_init ! model calendar (using both namelist and restart infos) 86 88 ELSE … … 91 93 CALL day_init ! model calendar (using both namelist and restart infos) 92 94 ! ! Initialization of ocean to zero 93 ! before fields ! now fields94 sshb (:,:) = 0. e0 ; sshn (:,:) = 0.e095 ub (:,:,:) = 0. e0 ; un (:,:,:) = 0.e096 vb (:,:,:) = 0. e0 ; vn (:,:,:) = 0.e097 rotb (:,:,:) = 0. e0 ; rotn (:,:,:) = 0.e098 hdivb(:,:,:) = 0. e0 ; hdivn(:,:,:) = 0.e095 ! before fields ! now fields 96 sshb (:,:) = 0._wp ; sshn (:,:) = 0._wp 97 ub (:,:,:) = 0._wp ; un (:,:,:) = 0._wp 98 vb (:,:,:) = 0._wp ; vn (:,:,:) = 0._wp 99 rotb (:,:,:) = 0._wp ; rotn (:,:,:) = 0._wp 100 hdivb(:,:,:) = 0._wp ; hdivn(:,:,:) = 0._wp 99 101 ! 100 IF( cp_cfg == 'eel' ) THEN 102 ! ! define e3u_b, e3v_b from e3t_b initialized in domzgr 103 CALL dom_vvl_2( nit000, fse3u_b(:,:,:), fse3v_b(:,:,:) ) 104 ! 105 IF( cp_cfg == 'eel' ) THEN 101 106 CALL istate_eel ! EEL configuration : start from pre-defined U,V T-S fields 102 107 ELSEIF( cp_cfg == 'gyre' ) THEN -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90
r2528 r3116 9 9 !! - ! 2006-08 (G. Madec) style 10 10 !! 3.2 ! 2006-08 (S. Masson, G. Madec) suppress useless variables + style 11 !! 3.4 ! 2011-11 (C. Harris) minor changes for CICE constants 11 12 !!---------------------------------------------------------------------- 12 13 … … 48 49 #endif 49 50 51 #if defined key_cice 52 REAL(wp), PUBLIC :: rau0 = 1026._wp !: reference volumic mass (density) (kg/m3) 53 #else 50 54 REAL(wp), PUBLIC :: rau0 = 1035._wp !: reference volumic mass (density) (kg/m3) 55 #endif 51 56 REAL(wp), PUBLIC :: rau0r !: reference specific volume (m3/kg) 52 57 REAL(wp), PUBLIC :: rcp = 4.e+3_wp !: ocean specific heat 53 58 REAL(wp), PUBLIC :: ro0cpr !: = 1. / ( rau0 * rcp ) 54 59 55 #if defined key_lim3 60 #if defined key_lim3 || defined key_cice 56 61 REAL(wp), PUBLIC :: rcdsn = 0.31_wp !: thermal conductivity of snow 57 62 REAL(wp), PUBLIC :: rcdic = 2.034396_wp !: thermal conductivity of fresh ice … … 100 105 rsiyea = 365.25 * rday * 2. * rpi / 6.283076 101 106 rsiday = rday / ( 1. + rday / rsiyea ) 107 #if defined key_cice 108 omega = 7.292116e-05 109 #else 102 110 omega = 2. * rpi / rsiday 111 #endif 103 112 104 113 rau0r = 1. / rau0 … … 155 164 WRITE(numout,*) ' latent heat of fusion of fresh ice / snow = ', lfus , ' J/kg' 156 165 WRITE(numout,*) ' latent heat of subl. of fresh ice / snow = ', lsub , ' J/kg' 166 #elif defined key_cice 167 WRITE(numout,*) ' latent heat of fusion of fresh ice / snow = ', lfus , ' J/kg' 157 168 #else 158 169 WRITE(numout,*) ' density times specific heat for snow = ', rcpsn , ' J/m^3/K' -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90
r2715 r3116 27 27 USE sbc_oce, ONLY : ln_rnf ! surface boundary condition: ocean 28 28 USE sbcrnf ! river runoff 29 USE obc_oce ! ocean lateral open boundary condition30 29 USE cla ! cross land advection (cla_div routine) 31 30 USE in_out_manager ! I/O manager … … 121 120 END DO 122 121 123 #if defined key_obc124 IF( Agrif_Root() ) THEN125 ! open boundaries (div must be zero behind the open boundary)126 ! mpp remark: The zeroing of hdivn can probably be extended to 1->jpi/jpj for the correct row/column127 IF( lp_obc_east ) hdivn(nie0p1:nie1p1,nje0 :nje1 ,jk) = 0.e0 ! east128 IF( lp_obc_west ) hdivn(niw0 :niw1 ,njw0 :njw1 ,jk) = 0.e0 ! west129 IF( lp_obc_north ) hdivn(nin0 :nin1 ,njn0p1:njn1p1,jk) = 0.e0 ! north130 IF( lp_obc_south ) hdivn(nis0 :nis1 ,njs0 :njs1 ,jk) = 0.e0 ! south131 ENDIF132 #endif133 122 IF( .NOT. AGRIF_Root() ) THEN 134 123 IF ((nbondi == 1).OR.(nbondi == 2)) hdivn(nlci-1 , : ,jk) = 0.e0 ! east … … 304 293 END DO 305 294 306 #if defined key_obc307 IF( Agrif_Root() ) THEN308 ! open boundaries (div must be zero behind the open boundary)309 ! mpp remark: The zeroing of hdivn can probably be extended to 1->jpi/jpj for the correct row/column310 IF( lp_obc_east ) hdivn(nie0p1:nie1p1,nje0 :nje1 ,jk) = 0.e0 ! east311 IF( lp_obc_west ) hdivn(niw0 :niw1 ,njw0 :njw1 ,jk) = 0.e0 ! west312 IF( lp_obc_north ) hdivn(nin0 :nin1 ,njn0p1:njn1p1,jk) = 0.e0 ! north313 IF( lp_obc_south ) hdivn(nis0 :nis1 ,njs0 :njs1 ,jk) = 0.e0 ! south314 ENDIF315 #endif316 295 IF( .NOT. AGRIF_Root() ) THEN 317 296 IF ((nbondi == 1).OR.(nbondi == 2)) hdivn(nlci-1 , : ,jk) = 0.e0 ! east -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90
r2715 r3116 13 13 USE dom_oce ! ocean space and time domain variables 14 14 USE zdf_oce ! ocean vertical physics variables 15 USE zdfbfr ! ocean bottom friction variables 15 16 USE trdmod ! ocean active dynamics and tracers trends 16 17 USE trdmod_oce ! ocean variables trends … … 51 52 !!--------------------------------------------------------------------- 52 53 ! 53 zm1_2dt = - 1._wp / ( 2._wp * rdt ) 54 IF( .not. ln_bfrimp) THEN ! only for explicit bottom friction form 55 ! implicit bfr is implemented in dynzdf_imp 56 ! H. Liu, Sept. 2011 54 57 55 IF( l_trddyn ) THEN ! temporary save of ua and va trends 56 ztrduv(:,:,:,1) = ua(:,:,:) 57 ztrduv(:,:,:,2) = va(:,:,:) 58 ENDIF 58 zm1_2dt = - 1._wp / ( 2._wp * rdt ) 59 60 IF( l_trddyn ) THEN ! temporary save of ua and va trends 61 ztrduv(:,:,:,1) = ua(:,:,:) 62 ztrduv(:,:,:,2) = va(:,:,:) 63 ENDIF 64 59 65 60 66 # if defined key_vectopt_loop 61 DO jj = 1, 162 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling)67 DO jj = 1, 1 68 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling) 63 69 # else 64 DO jj = 2, jpjm165 DO ji = 2, jpim170 DO jj = 2, jpjm1 71 DO ji = 2, jpim1 66 72 # endif 67 ikbu = mbku(ji,jj) ! deepest ocean u- & v-levels68 ikbv = mbkv(ji,jj)69 !70 ! Apply stability criteria on absolute value : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt)71 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX( bfrua(ji,jj) / fse3u(ji,jj,ikbu) , zm1_2dt ) * ub(ji,jj,ikbu)72 va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX( bfrva(ji,jj) / fse3v(ji,jj,ikbv) , zm1_2dt ) * vb(ji,jj,ikbv)73 END DO74 END DO73 ikbu = mbku(ji,jj) ! deepest ocean u- & v-levels 74 ikbv = mbkv(ji,jj) 75 ! 76 ! Apply stability criteria on absolute value : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt) 77 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX( bfrua(ji,jj) / fse3u(ji,jj,ikbu) , zm1_2dt ) * ub(ji,jj,ikbu) 78 va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX( bfrva(ji,jj) / fse3v(ji,jj,ikbv) , zm1_2dt ) * vb(ji,jj,ikbv) 79 END DO 80 END DO 75 81 76 ! 77 IF( l_trddyn ) THEN ! save the vertical diffusive trends for further diagnostics 78 ztrduv(:,:,:,1) = ua(:,:,:) - ztrduv(:,:,:,1) 79 ztrduv(:,:,:,2) = va(:,:,:) - ztrduv(:,:,:,2) 80 CALL trd_mod( ztrduv(:,:,:,1), ztrduv(:,:,:,2), jpdyn_trd_bfr, 'DYN', kt ) 81 ENDIF 82 ! ! print mean trends (used for debugging) 83 IF(ln_ctl) CALL prt_ctl( tab3d_1=ua, clinfo1=' bfr - Ua: ', mask1=umask, & 84 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 85 ! 82 ! 83 IF( l_trddyn ) THEN ! save the vertical diffusive trends for further diagnostics 84 ztrduv(:,:,:,1) = ua(:,:,:) - ztrduv(:,:,:,1) 85 ztrduv(:,:,:,2) = va(:,:,:) - ztrduv(:,:,:,2) 86 CALL trd_mod( ztrduv(:,:,:,1), ztrduv(:,:,:,2), jpdyn_trd_bfr, 'DYN', kt ) 87 ENDIF 88 ! ! print mean trends (used for debugging) 89 IF(ln_ctl) CALL prt_ctl( tab3d_1=ua, clinfo1=' bfr - Ua: ', mask1=umask, & 90 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 91 ! 92 ENDIF ! end explicit bottom friction 86 93 END SUBROUTINE dyn_bfr 87 94 -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
r2977 r3116 14 14 !! - ! 2005-11 (G. Madec) style & small optimisation 15 15 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 16 !! 3.4 ! 2011-11 (A. Coward, H. Liu) introduction of prj scheme; 17 !! ! suppression of hel, wdj and rot options 16 18 !!---------------------------------------------------------------------- 17 19 … … 23 25 !! hpg_zps : z-coordinate plus partial steps (interpolation) 24 26 !! hpg_sco : s-coordinate (standard jacobian formulation) 25 !! hpg_hel : s-coordinate (helsinki modification)26 !! hpg_wdj : s-coordinate (weighted density jacobian)27 27 !! hpg_djc : s-coordinate (Density Jacobian with Cubic polynomial) 28 !! hpg_ rot : s-coordinate (ROTated axes scheme)28 !! hpg_prj : s-coordinate (Pressure Jacobian with Cubic polynomial) 29 29 !!---------------------------------------------------------------------- 30 30 USE oce ! ocean dynamics and tracers … … 48 48 LOGICAL , PUBLIC :: ln_hpg_zps = .FALSE. !: z-coordinate - partial steps (interpolation) 49 49 LOGICAL , PUBLIC :: ln_hpg_sco = .FALSE. !: s-coordinate (standard jacobian formulation) 50 LOGICAL , PUBLIC :: ln_hpg_hel = .FALSE. !: s-coordinate (helsinki modification)51 LOGICAL , PUBLIC :: ln_hpg_wdj = .FALSE. !: s-coordinate (weighted density jacobian)52 50 LOGICAL , PUBLIC :: ln_hpg_djc = .FALSE. !: s-coordinate (Density Jacobian with Cubic polynomial) 53 LOGICAL , PUBLIC :: ln_hpg_rot = .FALSE. !: s-coordinate (ROTated axes scheme) 54 REAL(wp), PUBLIC :: rn_gamma = 0._wp !: weighting coefficient 51 LOGICAL , PUBLIC :: ln_hpg_prj = .FALSE. !: s-coordinate (Pressure Jacobian scheme) 55 52 LOGICAL , PUBLIC :: ln_dynhpg_imp = .FALSE. !: semi-implicite hpg flag 56 53 57 INTEGER :: nhpg = 0 ! = 0 to 6, type of pressure gradient scheme used ! (deduced from ln_hpg_... flags)54 INTEGER :: nhpg = 0 ! = 0 to 7, type of pressure gradient scheme used ! (deduced from ln_hpg_... flags) 58 55 59 56 !! * Substitutions … … 91 88 ENDIF 92 89 ! 93 SELECT CASE ( nhpg ) ! Hydr astatic pressure gradient computation90 SELECT CASE ( nhpg ) ! Hydrostatic pressure gradient computation 94 91 CASE ( 0 ) ; CALL hpg_zco ( kt ) ! z-coordinate 95 92 CASE ( 1 ) ; CALL hpg_zps ( kt ) ! z-coordinate plus partial steps (interpolation) 96 93 CASE ( 2 ) ; CALL hpg_sco ( kt ) ! s-coordinate (standard jacobian formulation) 97 CASE ( 3 ) ; CALL hpg_hel ( kt ) ! s-coordinate (helsinki modification) 98 CASE ( 4 ) ; CALL hpg_wdj ( kt ) ! s-coordinate (weighted density jacobian) 99 CASE ( 5 ) ; CALL hpg_djc ( kt ) ! s-coordinate (Density Jacobian with Cubic polynomial) 100 CASE ( 6 ) ; CALL hpg_rot ( kt ) ! s-coordinate (ROTated axes scheme) 94 CASE ( 3 ) ; CALL hpg_djc ( kt ) ! s-coordinate (Density Jacobian with Cubic polynomial) 95 CASE ( 4 ) ; CALL hpg_prj ( kt ) ! s-coordinate (Pressure Jacobian scheme) 101 96 END SELECT 102 97 ! … … 125 120 INTEGER :: ioptio = 0 ! temporary integer 126 121 !! 127 NAMELIST/namdyn_hpg/ ln_hpg_zco, ln_hpg_zps, ln_hpg_sco, ln_hpg_hel,&128 & ln_hpg_ wdj, ln_hpg_djc, ln_hpg_rot, rn_gamma, ln_dynhpg_imp122 NAMELIST/namdyn_hpg/ ln_hpg_zco, ln_hpg_zps, ln_hpg_sco, & 123 & ln_hpg_djc, ln_hpg_prj, ln_dynhpg_imp 129 124 !!---------------------------------------------------------------------- 130 125 ! … … 140 135 WRITE(numout,*) ' z-coord. - partial steps (interpolation) ln_hpg_zps = ', ln_hpg_zps 141 136 WRITE(numout,*) ' s-coord. (standard jacobian formulation) ln_hpg_sco = ', ln_hpg_sco 142 WRITE(numout,*) ' s-coord. (helsinki modification) ln_hpg_hel = ', ln_hpg_hel143 WRITE(numout,*) ' s-coord. (weighted density jacobian) ln_hpg_wdj = ', ln_hpg_wdj144 137 WRITE(numout,*) ' s-coord. (Density Jacobian: Cubic polynomial) ln_hpg_djc = ', ln_hpg_djc 145 WRITE(numout,*) ' s-coord. (ROTated axes scheme) ln_hpg_rot = ', ln_hpg_rot 146 WRITE(numout,*) ' weighting coeff. (wdj scheme) rn_gamma = ', rn_gamma 138 WRITE(numout,*) ' s-coord. (Pressure Jacobian: Cubic polynomial) ln_hpg_prj = ', ln_hpg_prj 147 139 WRITE(numout,*) ' time stepping: centered (F) or semi-implicit (T) ln_dynhpg_imp = ', ln_dynhpg_imp 148 140 ENDIF 149 141 ! 150 IF( lk_vvl .AND. .NOT. ln_hpg_sco ) & 151 & CALL ctl_stop('dyn_hpg_init : variable volume key_vvl require the standard jacobian formulation hpg_sco') 142 IF( lk_vvl .AND. .NOT. (ln_hpg_sco.OR.ln_hpg_prj) ) & 143 & CALL ctl_stop('dyn_hpg_init : variable volume key_vvl requires:& 144 & the standard jacobian formulation hpg_sco or & 145 & the pressure jacobian formulation hpg_prj') 152 146 ! 153 147 ! ! Set nhpg from ln_hpg_... flags … … 155 149 IF( ln_hpg_zps ) nhpg = 1 156 150 IF( ln_hpg_sco ) nhpg = 2 157 IF( ln_hpg_hel ) nhpg = 3 158 IF( ln_hpg_wdj ) nhpg = 4 159 IF( ln_hpg_djc ) nhpg = 5 160 IF( ln_hpg_rot ) nhpg = 6 161 ! 162 ! ! Consitency check 151 IF( ln_hpg_djc ) nhpg = 3 152 IF( ln_hpg_prj ) nhpg = 4 153 ! 154 ! ! Consistency check 163 155 ioptio = 0 164 156 IF( ln_hpg_zco ) ioptio = ioptio + 1 165 157 IF( ln_hpg_zps ) ioptio = ioptio + 1 166 158 IF( ln_hpg_sco ) ioptio = ioptio + 1 167 IF( ln_hpg_hel ) ioptio = ioptio + 1168 IF( ln_hpg_wdj ) ioptio = ioptio + 1169 159 IF( ln_hpg_djc ) ioptio = ioptio + 1 170 IF( ln_hpg_ rot) ioptio = ioptio + 1160 IF( ln_hpg_prj ) ioptio = ioptio + 1 171 161 IF( ioptio /= 1 ) CALL ctl_stop( 'NO or several hydrostatic pressure gradient options used' ) 172 162 ! … … 433 423 END SUBROUTINE hpg_sco 434 424 435 436 SUBROUTINE hpg_hel( kt )437 !!---------------------------------------------------------------------438 !! *** ROUTINE hpg_hel ***439 !!440 !! ** Method : s-coordinate case.441 !! The now hydrostatic pressure gradient at a given level442 !! jk is computed by taking the vertical integral of the in-situ443 !! density gradient along the model level from the suface to that444 !! level. s-coordinates (ln_sco): a corrective term is added445 !! to the horizontal pressure gradient :446 !! zhpi = grav ..... + 1/e1u mi(rhd) di[ grav dep3w ]447 !! zhpj = grav ..... + 1/e2v mj(rhd) dj[ grav dep3w ]448 !! add it to the general momentum trend (ua,va).449 !! ua = ua - 1/e1u * zhpi450 !! va = va - 1/e2v * zhpj451 !!452 !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend453 !! - Save the trend (l_trddyn=T)454 !!----------------------------------------------------------------------455 USE oce, ONLY: tsa ! (tsa) used as 2 3D workspace456 !!457 INTEGER, INTENT(in) :: kt ! ocean time-step index458 !!459 INTEGER :: ji, jj, jk ! dummy loop indices460 REAL(wp) :: zcoef0, zuap, zvap ! temporary scalars461 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhpi, zhpj462 !!----------------------------------------------------------------------463 464 zhpi => tsa(:,:,:,1)465 zhpj => tsa(:,:,:,2)466 !467 IF( kt == nit000 ) THEN468 IF(lwp) WRITE(numout,*)469 IF(lwp) WRITE(numout,*) 'dyn:hpg_hel : hydrostatic pressure gradient trend'470 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ s-coordinate case, helsinki modified scheme'471 ENDIF472 473 ! Local constant initialization474 zcoef0 = - grav * 0.5_wp475 476 ! Surface value477 DO jj = 2, jpjm1478 DO ji = fs_2, fs_jpim1 ! vector opt.479 ! hydrostatic pressure gradient along s-surfaces480 zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj) * ( fse3t(ji+1,jj ,1) * rhd(ji+1,jj ,1) &481 & - fse3t(ji ,jj ,1) * rhd(ji ,jj ,1) )482 zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj) * ( fse3t(ji ,jj+1,1) * rhd(ji ,jj+1,1) &483 & - fse3t(ji ,jj ,1) * rhd(ji ,jj ,1) )484 ! s-coordinate pressure gradient correction485 zuap = -zcoef0 * ( rhd (ji+1,jj,1) + rhd (ji,jj,1) ) &486 & * ( fsdept(ji+1,jj,1) - fsdept(ji,jj,1) ) / e1u(ji,jj)487 zvap = -zcoef0 * ( rhd (ji,jj+1,1) + rhd (ji,jj,1) ) &488 & * ( fsdept(ji,jj+1,1) - fsdept(ji,jj,1) ) / e2v(ji,jj)489 ! add to the general momentum trend490 ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) + zuap491 va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1) + zvap492 END DO493 END DO494 !495 ! interior value (2=<jk=<jpkm1)496 DO jk = 2, jpkm1497 DO jj = 2, jpjm1498 DO ji = fs_2, fs_jpim1 ! vector opt.499 ! hydrostatic pressure gradient along s-surfaces500 zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) &501 & + zcoef0 / e1u(ji,jj) * ( fse3t(ji+1,jj,jk ) * rhd(ji+1,jj,jk) &502 & -fse3t(ji ,jj,jk ) * rhd(ji ,jj,jk) ) &503 & + zcoef0 / e1u(ji,jj) * ( fse3t(ji+1,jj,jk-1) * rhd(ji+1,jj,jk-1) &504 & -fse3t(ji ,jj,jk-1) * rhd(ji ,jj,jk-1) )505 zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) &506 & + zcoef0 / e2v(ji,jj) * ( fse3t(ji,jj+1,jk ) * rhd(ji,jj+1,jk) &507 & -fse3t(ji,jj ,jk ) * rhd(ji,jj, jk) ) &508 & + zcoef0 / e2v(ji,jj) * ( fse3t(ji,jj+1,jk-1) * rhd(ji,jj+1,jk-1) &509 & -fse3t(ji,jj ,jk-1) * rhd(ji,jj, jk-1) )510 ! s-coordinate pressure gradient correction511 zuap = - zcoef0 * ( rhd (ji+1,jj,jk) + rhd (ji,jj,jk) ) &512 & * ( fsdept(ji+1,jj,jk) - fsdept(ji,jj,jk) ) / e1u(ji,jj)513 zvap = - zcoef0 * ( rhd (ji,jj+1,jk) + rhd (ji,jj,jk) ) &514 & * ( fsdept(ji,jj+1,jk) - fsdept(ji,jj,jk) ) / e2v(ji,jj)515 ! add to the general momentum trend516 ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) + zuap517 va(ji,jj,jk) = va(ji,jj,jk) + zhpj(ji,jj,jk) + zvap518 END DO519 END DO520 END DO521 !522 END SUBROUTINE hpg_hel523 524 525 SUBROUTINE hpg_wdj( kt )526 !!---------------------------------------------------------------------527 !! *** ROUTINE hpg_wdj ***528 !!529 !! ** Method : Weighted Density Jacobian (wdj) scheme (song 1998)530 !! The weighting coefficients from the namelist parameter rn_gamma531 !! (alpha=0.5-rn_gamma ; beta=1-alpha=0.5+rn_gamma532 !!533 !! Reference : Song, Mon. Wea. Rev., 126, 3213-3230, 1998.534 !!----------------------------------------------------------------------535 USE oce, ONLY: tsa ! (tsa) used as 2 3D workspace536 !!537 INTEGER, INTENT(in) :: kt ! ocean time-step index538 !!539 INTEGER :: ji, jj, jk ! dummy loop indices540 REAL(wp) :: zcoef0, zuap, zvap ! temporary scalars541 REAL(wp) :: zalph , zbeta ! " "542 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhpi, zhpj543 !!----------------------------------------------------------------------544 !545 zhpi => tsa(:,:,:,1)546 zhpj => tsa(:,:,:,2)547 !548 IF( kt == nit000 ) THEN549 IF(lwp) WRITE(numout,*)550 IF(lwp) WRITE(numout,*) 'dyn:hpg_wdj : hydrostatic pressure gradient trend'551 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ Weighted Density Jacobian'552 ENDIF553 554 ! Local constant initialization555 zcoef0 = - grav * 0.5_wp556 zalph = 0.5_wp - rn_gamma ! weighting coefficients (alpha=0.5-rn_gamma557 zbeta = 0.5_wp + rn_gamma ! (beta =1-alpha=0.5+rn_gamma558 559 ! Surface value (no ponderation)560 DO jj = 2, jpjm1561 DO ji = fs_2, fs_jpim1 ! vector opt.562 ! hydrostatic pressure gradient along s-surfaces563 zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj) * ( fse3w(ji+1,jj ,1) * rhd(ji+1,jj ,1) &564 & - fse3w(ji ,jj ,1) * rhd(ji ,jj ,1) )565 zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj) * ( fse3w(ji ,jj+1,1) * rhd(ji ,jj+1,1) &566 & - fse3w(ji ,jj ,1) * rhd(ji, jj ,1) )567 ! s-coordinate pressure gradient correction568 zuap = -zcoef0 * ( rhd (ji+1,jj,1) + rhd (ji,jj,1) ) &569 & * ( fsde3w(ji+1,jj,1) - fsde3w(ji,jj,1) ) / e1u(ji,jj)570 zvap = -zcoef0 * ( rhd (ji,jj+1,1) + rhd (ji,jj,1) ) &571 & * ( fsde3w(ji,jj+1,1) - fsde3w(ji,jj,1) ) / e2v(ji,jj)572 ! add to the general momentum trend573 ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) + zuap574 va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1) + zvap575 END DO576 END DO577 578 ! Interior value (2=<jk=<jpkm1) (weighted with zalph & zbeta)579 DO jk = 2, jpkm1580 DO jj = 2, jpjm1581 DO ji = fs_2, fs_jpim1 ! vector opt.582 zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 / e1u(ji,jj) &583 & * ( ( fsde3w(ji+1,jj,jk ) + fsde3w(ji,jj,jk ) &584 & - fsde3w(ji+1,jj,jk-1) - fsde3w(ji,jj,jk-1) ) &585 & * ( zalph * ( rhd (ji+1,jj,jk-1) - rhd (ji,jj,jk-1) ) &586 & + zbeta * ( rhd (ji+1,jj,jk ) - rhd (ji,jj,jk ) ) ) &587 & - ( rhd (ji+1,jj,jk ) + rhd (ji,jj,jk ) &588 & - rhd (ji+1,jj,jk-1) - rhd (ji,jj,jk-1) ) &589 & * ( zalph * ( fsde3w(ji+1,jj,jk-1) - fsde3w(ji,jj,jk-1) ) &590 & + zbeta * ( fsde3w(ji+1,jj,jk ) - fsde3w(ji,jj,jk ) ) ) )591 zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 / e2v(ji,jj) &592 & * ( ( fsde3w(ji,jj+1,jk ) + fsde3w(ji,jj,jk ) &593 & - fsde3w(ji,jj+1,jk-1) - fsde3w(ji,jj,jk-1) ) &594 & * ( zalph * ( rhd (ji,jj+1,jk-1) - rhd (ji,jj,jk-1) ) &595 & + zbeta * ( rhd (ji,jj+1,jk ) - rhd (ji,jj,jk ) ) ) &596 & - ( rhd (ji,jj+1,jk ) + rhd (ji,jj,jk ) &597 & - rhd (ji,jj+1,jk-1) - rhd (ji,jj,jk-1) ) &598 & * ( zalph * ( fsde3w(ji,jj+1,jk-1) - fsde3w(ji,jj,jk-1) ) &599 & + zbeta * ( fsde3w(ji,jj+1,jk ) - fsde3w(ji,jj,jk ) ) ) )600 ! add to the general momentum trend601 ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk)602 va(ji,jj,jk) = va(ji,jj,jk) + zhpj(ji,jj,jk)603 END DO604 END DO605 END DO606 !607 END SUBROUTINE hpg_wdj608 609 610 425 SUBROUTINE hpg_djc( kt ) 611 426 !!--------------------------------------------------------------------- … … 843 658 844 659 845 SUBROUTINE hpg_ rot( kt )660 SUBROUTINE hpg_prj( kt ) 846 661 !!--------------------------------------------------------------------- 847 !! *** ROUTINE hpg_rot *** 848 !! 849 !! ** Method : rotated axes scheme (Thiem and Berntsen 2005) 850 !! 851 !! Reference: Thiem & Berntsen, Ocean Modelling, In press, 2005. 852 !!---------------------------------------------------------------------- 662 !! *** ROUTINE hpg_prj *** 663 !! 664 !! ** Method : s-coordinate case. 665 !! A Pressure-Jacobian horizontal pressure gradient method 666 !! based on the constrained cubic-spline interpolation for 667 !! all vertical coordinate systems 668 !! 669 !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend 670 !! - Save the trend (l_trddyn=T) 671 !! 672 !!---------------------------------------------------------------------- 673 853 674 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 854 675 USE oce , ONLY: tsa ! (tsa) used as 2 3D workspace 855 USE wrk_nemo, ONLY: zdistr => wrk_2d_1 , zsina => wrk_2d_2 , zcosa => wrk_2d_3 856 USE wrk_nemo, ONLY: zhpiorg => wrk_3d_1 , zhpirot => wrk_3d_2 857 USE wrk_nemo, ONLY: zhpitra => wrk_3d_3 , zhpine => wrk_3d_4 858 USE wrk_nemo, ONLY: zhpjorg => wrk_3d_5 , zhpjrot => wrk_3d_6 859 USE wrk_nemo, ONLY: zhpjtra => wrk_3d_7 , zhpjne => wrk_3d_8 860 !! 861 INTEGER, INTENT(in) :: kt ! ocean time-step index 862 !! 863 INTEGER :: ji, jj, jk ! dummy loop indices 864 REAL(wp) :: zforg, zcoef0, zuap, zmskd1, zmskd1m ! temporary scalar 865 REAL(wp) :: zfrot , zvap, zmskd2, zmskd2m ! " " 866 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhpi, zhpj 867 !!---------------------------------------------------------------------- 868 869 IF( wrk_in_use(2, 1,2,3) .OR. & 870 wrk_in_use(3, 1,2,3,4,5,6,7,8) ) THEN 871 CALL ctl_stop('dyn:hpg_rot: requested workspace arrays unavailable') ; RETURN 676 USE wrk_nemo, ONLY: zhpi => wrk_3d_3 677 USE wrk_nemo, ONLY: zu => wrk_3d_4 678 USE wrk_nemo, ONLY: zv => wrk_3d_5 679 USE wrk_nemo, ONLY: sp => wrk_3d_6 680 USE wrk_nemo, ONLY: sp => wrk_3d_7 681 USE wrk_nemo, ONLY: sp => wrk_3d_8 682 USE wrk_nemo, ONLY: sp => wrk_3d_9 683 USE wrk_nemo, ONLY: sp => wrk_3d_10 684 USE wrk_nemo, ONLY: sp => wrk_3d_11 685 !! 686 !!---------------------------------------------------------------------- 687 !! 688 INTEGER, PARAMETER :: polynomial_type = 1 ! 1: cubic spline, 2: linear 689 INTEGER, INTENT(in) :: kt ! ocean time-step index 690 !! 691 INTEGER :: ji, jj, jk, jkk ! dummy loop indices 692 REAL(wp) :: zcoef0, znad ! temporary scalars 693 !! 694 !! The local variables for the correction term 695 INTEGER :: jk1, jis, jid, jjs, jjd 696 REAL(wp) :: zuijk, zvijk, zpwes, zpwed, zpnss, zpnsd, zdeps 697 REAL(wp) :: zrhdt1 698 REAL(wp) :: zdpdx1, zdpdx2, zdpdy1, zdpdy2 699 INTEGER :: zbhitwe, zbhitns 700 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdeptht, zrhh 701 !!---------------------------------------------------------------------- 702 703 IF( wrk_in_use(3, 3,4,5,6,7,8,9,10,11) ) THEN 704 CALL ctl_stop('dyn:hpg_prj: requested workspace arrays unavailable') ; RETURN 872 705 ENDIF 873 706 ! 874 z hpi=> tsa(:,:,:,1)875 z hpj=> tsa(:,:,:,2)707 zdeptht => tsa(:,:,:,1) 708 zrhh => tsa(:,:,:,2) 876 709 877 710 IF( kt == nit000 ) THEN 878 711 IF(lwp) WRITE(numout,*) 879 IF(lwp) WRITE(numout,*) 'dyn:hpg_ rot: hydrostatic pressure gradient trend'880 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ s-coordinate case, rotated axes scheme used'712 IF(lwp) WRITE(numout,*) 'dyn:hpg_prj : hydrostatic pressure gradient trend' 713 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ s-coordinate case, cubic spline pressure Jacobian' 881 714 ENDIF 882 715 883 ! ------------------------------- 884 ! Local constant initialization 885 ! ------------------------------- 886 zcoef0 = - grav * 0.5_wp 887 zforg = 0.95_wp 888 zfrot = 1._wp - zforg 889 890 ! inverse of the distance between 2 diagonal T-points (defined at F-point) (here zcoef0/distance) 891 zdistr(:,:) = zcoef0 / SQRT( e1f(:,:)*e1f(:,:) + e2f(:,:)*e1f(:,:) ) 892 893 ! sinus and cosinus of diagonal angle at F-point 894 zsina(:,:) = ATAN2( e2f(:,:), e1f(:,:) ) 895 zcosa(:,:) = COS( zsina(:,:) ) 896 zsina(:,:) = SIN( zsina(:,:) ) 897 898 ! --------------- 899 ! Surface value 900 ! --------------- 901 ! compute and add to the general trend the pressure gradients along the axes 902 DO jj = 2, jpjm1 903 DO ji = fs_2, fs_jpim1 ! vector opt. 904 ! hydrostatic pressure gradient along s-surfaces 905 zhpiorg(ji,jj,1) = zcoef0 / e1u(ji,jj) * ( fse3t(ji+1,jj,1) * rhd(ji+1,jj,1) & 906 & - fse3t(ji ,jj,1) * rhd(ji ,jj,1) ) 907 zhpjorg(ji,jj,1) = zcoef0 / e2v(ji,jj) * ( fse3t(ji,jj+1,1) * rhd(ji,jj+1,1) & 908 & - fse3t(ji,jj ,1) * rhd(ji,jj ,1) ) 909 ! s-coordinate pressure gradient correction 910 zuap = -zcoef0 * ( rhd (ji+1,jj ,1) + rhd (ji,jj,1) ) & 911 & * ( fsdept(ji+1,jj ,1) - fsdept(ji,jj,1) ) / e1u(ji,jj) 912 zvap = -zcoef0 * ( rhd (ji ,jj+1,1) + rhd (ji,jj,1) ) & 913 & * ( fsdept(ji ,jj+1,1) - fsdept(ji,jj,1) ) / e2v(ji,jj) 914 ! add to the general momentum trend 915 ua(ji,jj,1) = ua(ji,jj,1) + zforg * ( zhpiorg(ji,jj,1) + zuap ) 916 va(ji,jj,1) = va(ji,jj,1) + zforg * ( zhpjorg(ji,jj,1) + zvap ) 917 END DO 918 END DO 919 920 ! compute the pressure gradients in the diagonal directions 921 DO jj = 1, jpjm1 922 DO ji = 1, fs_jpim1 ! vector opt. 923 zmskd1 = tmask(ji+1,jj+1,1) * tmask(ji ,jj,1) ! mask in the 1st diagnonal 924 zmskd2 = tmask(ji ,jj+1,1) * tmask(ji+1,jj,1) ! mask in the 2nd diagnonal 925 ! hydrostatic pressure gradient along s-surfaces 926 zhpitra(ji,jj,1) = zdistr(ji,jj) * zmskd1 * ( fse3t(ji+1,jj+1,1) * rhd(ji+1,jj+1,1) & 927 & - fse3t(ji ,jj ,1) * rhd(ji ,jj ,1) ) 928 zhpjtra(ji,jj,1) = zdistr(ji,jj) * zmskd2 * ( fse3t(ji ,jj+1,1) * rhd(ji ,jj+1,1) & 929 & - fse3t(ji+1,jj ,1) * rhd(ji+1,jj ,1) ) 930 ! s-coordinate pressure gradient correction 931 zuap = -zdistr(ji,jj) * zmskd1 * ( rhd (ji+1,jj+1,1) + rhd (ji ,jj,1) ) & 932 & * ( fsdept(ji+1,jj+1,1) - fsdept(ji ,jj,1) ) 933 zvap = -zdistr(ji,jj) * zmskd2 * ( rhd (ji ,jj+1,1) + rhd (ji+1,jj,1) ) & 934 & * ( fsdept(ji ,jj+1,1) - fsdept(ji+1,jj,1) ) 935 ! back rotation 936 zhpine(ji,jj,1) = zcosa(ji,jj) * ( zhpitra(ji,jj,1) + zuap ) & 937 & - zsina(ji,jj) * ( zhpjtra(ji,jj,1) + zvap ) 938 zhpjne(ji,jj,1) = zsina(ji,jj) * ( zhpitra(ji,jj,1) + zuap ) & 939 & + zcosa(ji,jj) * ( zhpjtra(ji,jj,1) + zvap ) 940 END DO 941 END DO 942 943 ! interpolate and add to the general trend the diagonal gradient 944 DO jj = 2, jpjm1 945 DO ji = fs_2, fs_jpim1 ! vector opt. 946 ! averaging 947 zhpirot(ji,jj,1) = 0.5 * ( zhpine(ji,jj,1) + zhpine(ji ,jj-1,1) ) 948 zhpjrot(ji,jj,1) = 0.5 * ( zhpjne(ji,jj,1) + zhpjne(ji-1,jj ,1) ) 949 ! add to the general momentum trend 950 ua(ji,jj,1) = ua(ji,jj,1) + zfrot * zhpirot(ji,jj,1) 951 va(ji,jj,1) = va(ji,jj,1) + zfrot * zhpjrot(ji,jj,1) 952 END DO 953 END DO 954 955 ! ----------------- 956 ! 2. interior value (2=<jk=<jpkm1) 957 ! ----------------- 958 ! compute and add to the general trend the pressure gradients along the axes 959 DO jk = 2, jpkm1 960 DO jj = 2, jpjm1 961 DO ji = fs_2, fs_jpim1 ! vector opt. 962 ! hydrostatic pressure gradient along s-surfaces 963 zhpiorg(ji,jj,jk) = zhpiorg(ji,jj,jk-1) & 964 & + zcoef0 / e1u(ji,jj) * ( fse3t(ji+1,jj,jk ) * rhd(ji+1,jj,jk ) & 965 & - fse3t(ji ,jj,jk ) * rhd(ji ,jj,jk ) & 966 & + fse3t(ji+1,jj,jk-1) * rhd(ji+1,jj,jk-1) & 967 & - fse3t(ji ,jj,jk-1) * rhd(ji ,jj,jk-1) ) 968 zhpjorg(ji,jj,jk) = zhpjorg(ji,jj,jk-1) & 969 & + zcoef0 / e2v(ji,jj) * ( fse3t(ji,jj+1,jk ) * rhd(ji,jj+1,jk ) & 970 & - fse3t(ji,jj ,jk ) * rhd(ji,jj, jk ) & 971 & + fse3t(ji,jj+1,jk-1) * rhd(ji,jj+1,jk-1) & 972 & - fse3t(ji,jj ,jk-1) * rhd(ji,jj, jk-1) ) 973 ! s-coordinate pressure gradient correction 974 zuap = - zcoef0 * ( rhd (ji+1,jj ,jk) + rhd (ji,jj,jk) ) & 975 & * ( fsdept(ji+1,jj ,jk) - fsdept(ji,jj,jk) ) / e1u(ji,jj) 976 zvap = - zcoef0 * ( rhd (ji ,jj+1,jk) + rhd (ji,jj,jk) ) & 977 & * ( fsdept(ji ,jj+1,jk) - fsdept(ji,jj,jk) ) / e2v(ji,jj) 978 ! add to the general momentum trend 979 ua(ji,jj,jk) = ua(ji,jj,jk) + zforg*( zhpiorg(ji,jj,jk) + zuap ) 980 va(ji,jj,jk) = va(ji,jj,jk) + zforg*( zhpjorg(ji,jj,jk) + zvap ) 981 END DO 982 END DO 983 END DO 984 985 ! compute the pressure gradients in the diagonal directions 986 DO jk = 2, jpkm1 987 DO jj = 1, jpjm1 988 DO ji = 1, fs_jpim1 ! vector opt. 989 zmskd1 = tmask(ji+1,jj+1,jk ) * tmask(ji ,jj,jk ) ! level jk mask in the 1st diagnonal 990 zmskd1m = tmask(ji+1,jj+1,jk-1) * tmask(ji ,jj,jk-1) ! level jk-1 " " 991 zmskd2 = tmask(ji ,jj+1,jk ) * tmask(ji+1,jj,jk ) ! level jk mask in the 2nd diagnonal 992 zmskd2m = tmask(ji ,jj+1,jk-1) * tmask(ji+1,jj,jk-1) ! level jk-1 " " 993 ! hydrostatic pressure gradient along s-surfaces 994 zhpitra(ji,jj,jk) = zhpitra(ji,jj,jk-1) & 995 & + zdistr(ji,jj) * zmskd1 * ( fse3t(ji+1,jj+1,jk ) * rhd(ji+1,jj+1,jk) & 996 & -fse3t(ji ,jj ,jk ) * rhd(ji ,jj ,jk) ) & 997 & + zdistr(ji,jj) * zmskd1m * ( fse3t(ji+1,jj+1,jk-1) * rhd(ji+1,jj+1,jk-1) & 998 & -fse3t(ji ,jj ,jk-1) * rhd(ji ,jj ,jk-1) ) 999 zhpjtra(ji,jj,jk) = zhpjtra(ji,jj,jk-1) & 1000 & + zdistr(ji,jj) * zmskd2 * ( fse3t(ji ,jj+1,jk ) * rhd(ji ,jj+1,jk) & 1001 & -fse3t(ji+1,jj ,jk ) * rhd(ji+1,jj, jk) ) & 1002 & + zdistr(ji,jj) * zmskd2m * ( fse3t(ji ,jj+1,jk-1) * rhd(ji ,jj+1,jk-1) & 1003 & -fse3t(ji+1,jj ,jk-1) * rhd(ji+1,jj, jk-1) ) 1004 ! s-coordinate pressure gradient correction 1005 zuap = - zdistr(ji,jj) * zmskd1 * ( rhd (ji+1,jj+1,jk) + rhd (ji ,jj,jk) ) & 1006 & * ( fsdept(ji+1,jj+1,jk) - fsdept(ji ,jj,jk) ) 1007 zvap = - zdistr(ji,jj) * zmskd2 * ( rhd (ji ,jj+1,jk) + rhd (ji+1,jj,jk) ) & 1008 & * ( fsdept(ji ,jj+1,jk) - fsdept(ji+1,jj,jk) ) 1009 ! back rotation 1010 zhpine(ji,jj,jk) = zcosa(ji,jj) * ( zhpitra(ji,jj,jk) + zuap ) & 1011 & - zsina(ji,jj) * ( zhpjtra(ji,jj,jk) + zvap ) 1012 zhpjne(ji,jj,jk) = zsina(ji,jj) * ( zhpitra(ji,jj,jk) + zuap ) & 1013 & + zcosa(ji,jj) * ( zhpjtra(ji,jj,jk) + zvap ) 1014 END DO 1015 END DO 1016 END DO 1017 1018 ! interpolate and add to the general trend 1019 DO jk = 2, jpkm1 1020 DO jj = 2, jpjm1 1021 DO ji = fs_2, fs_jpim1 ! vector opt. 1022 ! averaging 1023 zhpirot(ji,jj,jk) = 0.5 * ( zhpine(ji,jj,jk) + zhpine(ji ,jj-1,jk) ) 1024 zhpjrot(ji,jj,jk) = 0.5 * ( zhpjne(ji,jj,jk) + zhpjne(ji-1,jj ,jk) ) 1025 ! add to the general momentum trend 1026 ua(ji,jj,jk) = ua(ji,jj,jk) + zfrot * zhpirot(ji,jj,jk) 1027 va(ji,jj,jk) = va(ji,jj,jk) + zfrot * zhpjrot(ji,jj,jk) 1028 END DO 1029 END DO 1030 END DO 1031 ! 1032 IF( wrk_not_released(2, 1,2,3) .OR. & 1033 wrk_not_released(3, 1,2,3,4,5,6,7,8) ) CALL ctl_stop('dyn:hpg_rot: failed to release workspace arrays') 1034 ! 1035 END SUBROUTINE hpg_rot 716 !!---------------------------------------------------------------------- 717 ! Local constant initialization 718 zcoef0 = - grav 719 znad = 0.0_wp 720 IF( lk_vvl ) znad = 1._wp 721 722 ! Clean 3-D work arrays 723 zhpi(:,:,:) = 0._wp 724 zrhh(:,:,:) = rhd(:,:,:) 725 726 ! Preparing vertical density profile for hybrid-sco coordinate 727 DO jj = 1, jpj 728 DO ji = 1, jpi 729 jk = mbathy(ji,jj) 730 IF( jk <= 0 ) THEN; zrhh(ji,jj,:) = 0._wp 731 ELSE IF(jk == 1) THEN; zrhh(ji,jj, jk+1:jpk) = rhd(ji,jj,jk) 732 ELSE IF(jk < jpkm1) THEN 733 DO jkk = jk+1, jpk 734 zrhh(ji,jj,jkk) = interp1(fsde3w(ji,jj,jkk), fsde3w(ji,jj,jkk-1), & 735 fsde3w(ji,jj,jkk-2), rhd(ji,jj,jkk-1), rhd(ji,jj,jkk-2)) 736 END DO 737 ENDIF 738 END DO 739 END DO 740 741 DO jj = 1, jpj 742 DO ji = 1, jpi 743 zdeptht(ji,jj,1) = 0.5_wp * fse3w(ji,jj,1) 744 zdeptht(ji,jj,1) = zdeptht(ji,jj,1) - sshn(ji,jj) * znad 745 DO jk = 2, jpk 746 zdeptht(ji,jj,jk) = zdeptht(ji,jj,jk-1) + fse3w(ji,jj,jk) 747 END DO 748 END DO 749 END DO 750 751 DO jk = 1, jpkm1 752 DO jj = 1, jpj 753 DO ji = 1, jpi 754 fsp(ji,jj,jk) = zrhh(ji,jj,jk) 755 xsp(ji,jj,jk) = zdeptht(ji,jj,jk) 756 END DO 757 END DO 758 END DO 759 760 ! Construct the vertical density profile with the 761 ! constrained cubic spline interpolation 762 CALL cspline(fsp,xsp,asp,bsp,csp,dsp,polynomial_type) 763 764 ! Calculate the hydrostatic pressure at T(ji,jj,1) 765 DO jj = 2, jpj 766 DO ji = 2, jpi 767 zrhdt1 = zrhh(ji,jj,1) - interp3(zdeptht(ji,jj,1),asp(ji,jj,1), & 768 bsp(ji,jj,1), csp(ji,jj,1), & 769 dsp(ji,jj,1) ) * 0.5_wp * zdeptht(ji,jj,1) 770 zrhdt1 = MAX(zrhdt1, 1000._wp - rau0) ! no lighter than fresh water 771 772 ! assuming linear profile across the top half surface layer 773 zhpi(ji,jj,1) = 0.5_wp * fse3w(ji,jj,1) * zrhdt1 774 END DO 775 END DO 776 777 ! Calculate the pressure at T(ji,jj,2:jpkm1) 778 DO jk = 2, jpkm1 779 DO jj = 2, jpj 780 DO ji = 2, jpi 781 zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + & 782 integ2(zdeptht(ji,jj,jk-1), zdeptht(ji,jj,jk),& 783 asp(ji,jj,jk-1), bsp(ji,jj,jk-1), & 784 csp(ji,jj,jk-1), dsp(ji,jj,jk-1)) 785 END DO 786 END DO 787 END DO 788 789 ! Z coordinate of U(ji,jj,1:jpkm1) and V(ji,jj,1:jpkm1) 790 DO jj = 2, jpjm1 791 DO ji = 2, jpim1 792 zu(ji,jj,1) = - ( fse3u(ji,jj,1) - sshu_n(ji,jj) * znad) 793 zv(ji,jj,1) = - ( fse3v(ji,jj,1) - sshv_n(ji,jj) * znad) 794 END DO 795 END DO 796 797 DO jk = 2, jpkm1 798 DO jj = 2, jpjm1 799 DO ji = 2, jpim1 800 zu(ji,jj,jk) = zu(ji,jj,jk-1)- fse3u(ji,jj,jk) 801 zv(ji,jj,jk) = zv(ji,jj,jk-1)- fse3v(ji,jj,jk) 802 END DO 803 END DO 804 END DO 805 806 DO jk = 1, jpkm1 807 DO jj = 2, jpjm1 808 DO ji = 2, jpim1 809 zu(ji,jj,jk) = zu(ji,jj,jk) + 0.5_wp * fse3u(ji,jj,jk) 810 zv(ji,jj,jk) = zv(ji,jj,jk) + 0.5_wp * fse3v(ji,jj,jk) 811 END DO 812 END DO 813 END DO 814 815 DO jk = 1, jpkm1 816 DO jj = 2, jpjm1 817 DO ji = 2, jpim1 818 zpwes = 0._wp; zpwed = 0._wp 819 zpnss = 0._wp; zpnsd = 0._wp 820 zuijk = zu(ji,jj,jk) 821 zvijk = zv(ji,jj,jk) 822 823 !!!!! for u equation 824 IF( jk <= mbku(ji,jj) ) THEN 825 IF( -zdeptht(ji+1,jj,mbku(ji,jj)) >= -zdeptht(ji,jj,mbku(ji,jj)) ) THEN 826 jis = ji + 1; jid = ji 827 ELSE 828 jis = ji; jid = ji +1 829 ENDIF 830 831 ! integrate the pressure on the shallow side 832 jk1 = jk 833 zbhitwe = 0 834 DO WHILE ( -zdeptht(jis,jj,jk1) > zuijk ) 835 IF( jk1 == mbku(ji,jj) ) THEN 836 zbhitwe = 1 837 EXIT 838 ENDIF 839 zdeps = MIN(zdeptht(jis,jj,jk1+1), -zuijk) 840 zpwes = zpwes + & 841 integ2(zdeptht(jis,jj,jk1), zdeps, & 842 asp(jis,jj,jk1), bsp(jis,jj,jk1), & 843 csp(jis,jj,jk1), dsp(jis,jj,jk1)) 844 jk1 = jk1 + 1 845 END DO 846 847 IF(zbhitwe == 1) THEN 848 zuijk = -zdeptht(jis,jj,jk1) 849 ENDIF 850 851 ! integrate the pressure on the deep side 852 jk1 = jk 853 zbhitwe = 0 854 DO WHILE ( -zdeptht(jid,jj,jk1) < zuijk ) 855 IF( jk1 == 1 ) THEN 856 zbhitwe = 1 857 EXIT 858 ENDIF 859 zdeps = MAX(zdeptht(jid,jj,jk1-1), -zuijk) 860 zpwed = zpwed + & 861 integ2(zdeps, zdeptht(jid,jj,jk1), & 862 asp(jid,jj,jk1-1), bsp(jid,jj,jk1-1), & 863 csp(jid,jj,jk1-1), dsp(jid,jj,jk1-1) ) 864 jk1 = jk1 - 1 865 END DO 866 867 IF( zbhitwe == 1 ) THEN 868 zdeps = zdeptht(jid,jj,1) + MIN(zuijk, sshn(jid,jj)*znad) 869 zrhdt1 = zrhh(jid,jj,1) - interp3(zdeptht(jid,jj,1), asp(jid,jj,1), & 870 bsp(jid,jj,1), csp(jid,jj,1), & 871 dsp(jid,jj,1)) * zdeps 872 zrhdt1 = MAX(zrhdt1, 1000._wp - rau0) ! no lighter than fresh water 873 zpwed = zpwed + 0.5_wp * (zrhh(jid,jj,1) + zrhdt1) * zdeps 874 ENDIF 875 876 ! update the momentum trends in u direction 877 878 zdpdx1 = zcoef0 / e1u(ji,jj) * (zhpi(ji+1,jj,jk) - zhpi(ji,jj,jk)) 879 IF( lk_vvl ) THEN 880 zdpdx2 = zcoef0 / e1u(ji,jj) * & 881 ( REAL(jis-jid, wp) * (zpwes + zpwed) + (sshn(ji+1,jj)-sshn(ji,jj)) ) 882 ELSE 883 zdpdx2 = zcoef0 / e1u(ji,jj) * REAL(jis-jid, wp) * (zpwes + zpwed) 884 ENDIF 885 886 ua(ji,jj,jk) = ua(ji,jj,jk) + (zdpdx1 + zdpdx2) * & 887 & umask(ji,jj,jk) * tmask(ji,jj,jk) * tmask(ji+1,jj,jk) 888 ENDIF 889 890 !!!!! for v equation 891 IF( jk <= mbkv(ji,jj) ) THEN 892 IF( -zdeptht(ji,jj+1,mbkv(ji,jj)) >= -zdeptht(ji,jj,mbkv(ji,jj)) ) THEN 893 jjs = jj + 1; jjd = jj 894 ELSE 895 jjs = jj ; jjd = jj + 1 896 ENDIF 897 898 ! integrate the pressure on the shallow side 899 jk1 = jk 900 zbhitns = 0 901 DO WHILE ( -zdeptht(ji,jjs,jk1) > zvijk ) 902 IF( jk1 == mbkv(ji,jj) ) THEN 903 zbhitns = 1 904 EXIT 905 ENDIF 906 zdeps = MIN(zdeptht(ji,jjs,jk1+1), -zvijk) 907 zpnss = zpnss + & 908 integ2(zdeptht(ji,jjs,jk1), zdeps, & 909 asp(ji,jjs,jk1), bsp(ji,jjs,jk1), & 910 csp(ji,jjs,jk1), dsp(ji,jjs,jk1) ) 911 jk1 = jk1 + 1 912 END DO 913 914 IF(zbhitns == 1) THEN 915 zvijk = -zdeptht(ji,jjs,jk1) 916 ENDIF 917 918 ! integrate the pressure on the deep side 919 jk1 = jk 920 zbhitns = 0 921 DO WHILE ( -zdeptht(ji,jjd,jk1) < zvijk ) 922 IF( jk1 == 1 ) THEN 923 zbhitns = 1 924 EXIT 925 ENDIF 926 zdeps = MAX(zdeptht(ji,jjd,jk1-1), -zvijk) 927 zpnsd = zpnsd + & 928 integ2(zdeps, zdeptht(ji,jjd,jk1), & 929 asp(ji,jjd,jk1-1), bsp(ji,jjd,jk1-1), & 930 csp(ji,jjd,jk1-1), dsp(ji,jjd,jk1-1) ) 931 jk1 = jk1 - 1 932 END DO 933 934 IF( zbhitns == 1 ) THEN 935 zdeps = zdeptht(ji,jjd,1) + MIN(zvijk, sshn(ji,jjd)*znad) 936 zrhdt1 = zrhh(ji,jjd,1) - interp3(zdeptht(ji,jjd,1), asp(ji,jjd,1), & 937 bsp(ji,jjd,1), csp(ji,jjd,1), & 938 dsp(ji,jjd,1) ) * zdeps 939 zrhdt1 = MAX(zrhdt1, 1000._wp - rau0) ! no lighter than fresh water 940 zpnsd = zpnsd + 0.5_wp * (zrhh(ji,jjd,1) + zrhdt1) * zdeps 941 ENDIF 942 943 ! update the momentum trends in v direction 944 945 zdpdy1 = zcoef0 / e2v(ji,jj) * (zhpi(ji,jj+1,jk) - zhpi(ji,jj,jk)) 946 IF( lk_vvl ) THEN 947 zdpdy2 = zcoef0 / e2v(ji,jj) * & 948 ( REAL(jjs-jjd, wp) * (zpnss + zpnsd) + (sshn(ji,jj+1)-sshn(ji,jj)) ) 949 ELSE 950 zdpdy2 = zcoef0 / e2v(ji,jj) * REAL(jjs-jjd, wp) * (zpnss + zpnsd ) 951 ENDIF 952 953 va(ji,jj,jk) = va(ji,jj,jk) + (zdpdy1 + zdpdy2)*& 954 & vmask(ji,jj,jk)*tmask(ji,jj,jk)*tmask(ji,jj+1,jk) 955 ENDIF 956 957 958 END DO 959 END DO 960 END DO 961 962 ! 963 IF( wrk_not_released(3, 3,4,5,6,7,8,9,10,11) ) & 964 CALL ctl_stop('dyn:hpg_prj: failed to release workspace arrays') 965 ! 966 END SUBROUTINE hpg_prj 967 968 SUBROUTINE cspline(fsp, xsp, asp, bsp, csp, dsp, polynomial_type) 969 !!---------------------------------------------------------------------- 970 !! *** ROUTINE cspline *** 971 !! 972 !! ** Purpose : constrained cubic spline interpolation 973 !! 974 !! ** Method : f(x) = asp + bsp*x + csp*x^2 + dsp*x^3 975 !! Reference: K.W. Brodlie, A review of mehtods for curve and function 976 !! drawing, 1980 977 !! 978 !!---------------------------------------------------------------------- 979 IMPLICIT NONE 980 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: fsp, xsp ! value and coordinate 981 REAL(wp), DIMENSION(:,:,:), INTENT(out) :: asp, bsp, csp, dsp ! coefficients of 982 ! the interpoated function 983 INTEGER, INTENT(in) :: polynomial_type ! 1: cubic spline 984 ! 2: Linear 985 986 ! Local Variables 987 INTEGER :: ji, jj, jk ! dummy loop indices 988 INTEGER :: jpi, jpj, jpkm1 989 REAL(wp) :: zdf1, zdf2, zddf1, zddf2, ztmp1, ztmp2, zdxtmp 990 REAL(wp) :: zdxtmp1, zdxtmp2, zalpha 991 REAL(wp) :: zdf(size(fsp,3)) 992 !!---------------------------------------------------------------------- 993 994 jpi = size(fsp,1) 995 jpj = size(fsp,2) 996 jpkm1 = size(fsp,3) - 1 997 998 ! Clean output arrays 999 asp = 0.0_wp 1000 bsp = 0.0_wp 1001 csp = 0.0_wp 1002 dsp = 0.0_wp 1003 1004 DO ji = 1, jpi 1005 DO jj = 1, jpj 1006 IF (polynomial_type == 1) THEN ! Constrained Cubic Spline 1007 DO jk = 2, jpkm1-1 1008 zdxtmp1 = xsp(ji,jj,jk) - xsp(ji,jj,jk-1) 1009 zdxtmp2 = xsp(ji,jj,jk+1) - xsp(ji,jj,jk) 1010 zdf1 = ( fsp(ji,jj,jk) - fsp(ji,jj,jk-1) ) / zdxtmp1 1011 zdf2 = ( fsp(ji,jj,jk+1) - fsp(ji,jj,jk) ) / zdxtmp2 1012 1013 zalpha = ( zdxtmp1 + 2._wp * zdxtmp2 ) / ( zdxtmp1 + zdxtmp2 ) / 3._wp 1014 1015 IF(zdf1 * zdf2 <= 0._wp) THEN 1016 zdf(jk) = 0._wp 1017 ELSE 1018 zdf(jk) = zdf1 * zdf2 / ( ( 1._wp - zalpha ) * zdf1 + zalpha * zdf2 ) 1019 ENDIF 1020 END DO 1021 1022 zdf(1) = 1.5_wp * ( fsp(ji,jj,2) - fsp(ji,jj,1) ) / & 1023 & ( xsp(ji,jj,2) - xsp(ji,jj,1) ) - 0.5_wp * zdf(2) 1024 zdf(jpkm1) = 1.5_wp * ( fsp(ji,jj,jpkm1) - fsp(ji,jj,jpkm1-1) ) / & 1025 & ( xsp(ji,jj,jpkm1) - xsp(ji,jj,jpkm1-1) ) - & 1026 & 0.5_wp * zdf(jpkm1 - 1) 1027 1028 DO jk = 1, jpkm1 - 1 1029 zdxtmp = xsp(ji,jj,jk+1) - xsp(ji,jj,jk) 1030 ztmp1 = (zdf(jk+1) + 2._wp * zdf(jk)) / zdxtmp 1031 ztmp2 = 6._wp * (fsp(ji,jj,jk+1) - fsp(ji,jj,jk)) / zdxtmp / zdxtmp 1032 zddf1 = -2._wp * ztmp1 + ztmp2 1033 ztmp1 = (2._wp * zdf(jk+1) + zdf(jk)) / zdxtmp 1034 zddf2 = 2._wp * ztmp1 - ztmp2 1035 1036 dsp(ji,jj,jk) = (zddf2 - zddf1) / 6._wp / zdxtmp 1037 csp(ji,jj,jk) = ( xsp(ji,jj,jk+1) * zddf1 - xsp(ji,jj,jk)*zddf2 ) / 2._wp / zdxtmp 1038 bsp(ji,jj,jk) = ( fsp(ji,jj,jk+1) - fsp(ji,jj,jk) ) / zdxtmp - & 1039 & csp(ji,jj,jk) * ( xsp(ji,jj,jk+1) + xsp(ji,jj,jk) ) - & 1040 & dsp(ji,jj,jk) * ( xsp(ji,jj,jk+1)**2 + & 1041 & xsp(ji,jj,jk+1) * xsp(ji,jj,jk) + & 1042 & xsp(ji,jj,jk)**2 ) 1043 asp(ji,jj,jk) = fsp(ji,jj,jk) - bsp(ji,jj,jk) * xsp(ji,jj,jk) - & 1044 & csp(ji,jj,jk) * xsp(ji,jj,jk)**2 - & 1045 & dsp(ji,jj,jk) * xsp(ji,jj,jk)**3 1046 END DO 1047 1048 ELSE IF (polynomial_type == 2) THEN ! Linear 1049 1050 DO jk = 1, jpkm1-1 1051 zdxtmp =xsp(ji,jj,jk+1) - xsp(ji,jj,jk) 1052 ztmp1 = fsp(ji,jj,jk+1) - fsp(ji,jj,jk) 1053 1054 dsp(ji,jj,jk) = 0._wp 1055 csp(ji,jj,jk) = 0._wp 1056 bsp(ji,jj,jk) = ztmp1 / zdxtmp 1057 asp(ji,jj,jk) = fsp(ji,jj,jk) - bsp(ji,jj,jk) * xsp(ji,jj,jk) 1058 END DO 1059 1060 ELSE 1061 CALL ctl_stop( 'invalid polynomial type in cspline' ) 1062 ENDIF 1063 1064 END DO 1065 END DO 1066 1067 END SUBROUTINE cspline 1068 1069 1070 FUNCTION interp1(x, xl, xr, fl, fr) RESULT(f) 1071 !!---------------------------------------------------------------------- 1072 !! *** ROUTINE interp1 *** 1073 !! 1074 !! ** Purpose : 1-d linear interpolation 1075 !! 1076 !! ** Method : 1077 !! interpolation is straight forward 1078 !! extrapolation is also permitted (no value limit) 1079 !! 1080 !! H.Liu, Jan 2009, POL 1081 !!---------------------------------------------------------------------- 1082 IMPLICIT NONE 1083 REAL(wp), INTENT(in) :: x, xl, xr, fl, fr 1084 REAL(wp) :: f ! result of the interpolation (extrapolation) 1085 REAL(wp) :: zdeltx 1086 !!---------------------------------------------------------------------- 1087 1088 zdeltx = xr - xl 1089 IF(abs(zdeltx) <= 10._wp * EPSILON(x)) THEN 1090 f = 0.5_wp * (fl + fr) 1091 ELSE 1092 f = ( (x - xl ) * fr - ( x - xr ) * fl ) / zdeltx 1093 ENDIF 1094 1095 END FUNCTION interp1 1096 1097 FUNCTION interp2(x, a, b, c, d) RESULT(f) 1098 !!---------------------------------------------------------------------- 1099 !! *** ROUTINE interp1 *** 1100 !! 1101 !! ** Purpose : 1-d constrained cubic spline interpolation 1102 !! 1103 !! ** Method : cubic spline interpolation 1104 !! 1105 !!---------------------------------------------------------------------- 1106 IMPLICIT NONE 1107 REAL(wp), INTENT(in) :: x, a, b, c, d 1108 REAL(wp) :: f ! value from the interpolation 1109 !!---------------------------------------------------------------------- 1110 1111 f = a + x* ( b + x * ( c + d * x ) ) 1112 1113 END FUNCTION interp2 1114 1115 1116 FUNCTION interp3(x, a, b, c, d) RESULT(f) 1117 !!---------------------------------------------------------------------- 1118 !! *** ROUTINE interp1 *** 1119 !! 1120 !! ** Purpose : Calculate the first order of deriavtive of 1121 !! a cubic spline function y=a+b*x+c*x^2+d*x^3 1122 !! 1123 !! ** Method : f=dy/dx=b+2*c*x+3*d*x^2 1124 !! 1125 !!---------------------------------------------------------------------- 1126 IMPLICIT NONE 1127 REAL(wp), INTENT(in) :: x, a, b, c, d 1128 REAL(wp) :: f ! value from the interpolation 1129 !!---------------------------------------------------------------------- 1130 1131 f = b + x * ( 2._wp * c + 3._wp * d * x) 1132 1133 END FUNCTION interp3 1134 1135 1136 FUNCTION integ2(xl, xr, a, b, c, d) RESULT(f) 1137 !!---------------------------------------------------------------------- 1138 !! *** ROUTINE interp1 *** 1139 !! 1140 !! ** Purpose : 1-d constrained cubic spline integration 1141 !! 1142 !! ** Method : integrate polynomial a+bx+cx^2+dx^3 from xl to xr 1143 !! 1144 !!---------------------------------------------------------------------- 1145 IMPLICIT NONE 1146 REAL(wp), INTENT(in) :: xl, xr, a, b, c, d 1147 REAL(wp) :: za1, za2, za3 1148 REAL(wp) :: f ! integration result 1149 !!---------------------------------------------------------------------- 1150 1151 za1 = 0.5_wp * b 1152 za2 = c / 3.0_wp 1153 za3 = 0.25_wp * d 1154 1155 f = xr * ( a + xr * ( za1 + xr * ( za2 + za3 * xr ) ) ) - & 1156 & xl * ( a + xl * ( za1 + xl * ( za2 + za3 * xl ) ) ) 1157 1158 END FUNCTION integ2 1159 1036 1160 1037 1161 !!====================================================================== -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
r2977 r3116 33 33 USE obcdyn_bt ! 2D open boundary condition for momentum (obc_dyn_bt routine) 34 34 USE obcvol ! ocean open boundary condition (obc_vol routines) 35 USE bdy_oce ! unstructured open boundary conditions 36 USE bdydta ! unstructured open boundary conditions 37 USE bdydyn ! unstructured open boundary conditions 35 USE bdy_oce ! ocean open boundary conditions 36 USE bdydta ! ocean open boundary conditions 37 USE bdydyn ! ocean open boundary conditions 38 USE bdyvol ! ocean open boundary condition (bdy_vol routines) 38 39 USE in_out_manager ! I/O manager 39 40 USE lbclnk ! lateral boundary condition (or mpp link) … … 77 78 !! * Apply lateral boundary conditions on after velocity 78 79 !! at the local domain boundaries through lbc_lnk call, 79 !! at the radiative open boundaries (lk_obc=T), 80 !! at the relaxed open boundaries (lk_bdy=T), and 80 !! at the one-way open boundaries (lk_obc=T), 81 81 !! at the AGRIF zoom boundaries (lk_agrif=T) 82 82 !! … … 92 92 !! un,vn now horizontal velocity of next time-step 93 93 !!---------------------------------------------------------------------- 94 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released95 94 USE oce , ONLY: tsa ! tsa used as 2 3D workspace 96 USE wrk_nemo, ONLY: zs_t => wrk_2d_1 , zs_u_1 => wrk_2d_2 , zs_v_1 => wrk_2d_397 95 ! 98 96 INTEGER, INTENT( in ) :: kt ! ocean time-step index 99 97 ! 100 98 INTEGER :: ji, jj, jk ! dummy loop indices 99 INTEGER :: iku, ikv ! local integers 101 100 #if ! defined key_dynspg_flt 102 101 REAL(wp) :: z2dt ! temporary scalar 103 102 #endif 104 REAL(wp) :: zue3a, zue3n, zue3b, zuf ! local scalars 105 REAL(wp) :: zve3a, zve3n, zve3b, zvf ! - - 106 REAL(wp) :: zec, zv_t_ij, zv_t_ip1j, zv_t_ijp1 103 REAL(wp) :: zue3a, zue3n, zue3b, zuf, zec ! local scalars 104 REAL(wp) :: zve3a, zve3n, zve3b, zvf ! - - 107 105 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze3u_f, ze3v_f 108 106 !!---------------------------------------------------------------------- 109 107 110 IF( wrk_in_use(2, 1,2,3) ) THEN111 CALL ctl_stop('dyn_nxt: requested workspace arrays unavailable') ; RETURN112 ENDIF113 108 ! 114 109 ze3u_f => tsa(:,:,:,1) … … 178 173 ENDIF 179 174 ! 180 # elif defined key_bdy 175 # elif defined key_bdy 181 176 ! !* BDY open boundaries 182 IF( .NOT. lk_dynspg_flt ) THEN 183 CALL bdy_dyn_frs( kt ) 184 # if ! defined key_vvl 185 ua_e(:,:) = 0.e0 186 va_e(:,:) = 0.e0 187 ! Set these variables for use in bdy_dyn_fla 188 hur_e(:,:) = hur(:,:) 189 hvr_e(:,:) = hvr(:,:) 190 DO jk = 1, jpkm1 !! Vertically integrated momentum trends 191 ua_e(:,:) = ua_e(:,:) + fse3u(:,:,jk) * umask(:,:,jk) * ua(:,:,jk) 192 va_e(:,:) = va_e(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) * va(:,:,jk) 193 END DO 194 ua_e(:,:) = ua_e(:,:) * hur(:,:) 195 va_e(:,:) = va_e(:,:) * hvr(:,:) 196 DO jk = 1 , jpkm1 197 ua(:,:,jk) = ua(:,:,jk) - ua_e(:,:) 198 va(:,:,jk) = va(:,:,jk) - va_e(:,:) 199 END DO 200 CALL bdy_dta_fla( kt+1, 0,2*nn_baro) 201 CALL bdy_dyn_fla( sshn_b ) 202 CALL lbc_lnk( ua_e, 'U', -1. ) ! Boundary points should be updated 203 CALL lbc_lnk( va_e, 'V', -1. ) ! 204 DO jk = 1 , jpkm1 205 ua(:,:,jk) = ( ua(:,:,jk) + ua_e(:,:) ) * umask(:,:,jk) 206 va(:,:,jk) = ( va(:,:,jk) + va_e(:,:) ) * vmask(:,:,jk) 207 END DO 208 # endif 209 ENDIF 177 IF( lk_dynspg_exp ) CALL bdy_dyn( kt ) 178 IF( lk_dynspg_ts ) CALL bdy_dyn( kt, dyn3d_only=.true. ) 179 180 !!$ Do we need a call to bdy_vol here?? 181 ! 210 182 # endif 211 183 ! … … 242 214 ELSE ! Variable volume ! 243 215 ! ! ================! 244 ! Before scale factor at t-points 245 ! ------------------------------- 246 DO jk = 1, jpkm1 216 ! 217 DO jk = 1, jpkm1 ! Before scale factor at t-points 247 218 fse3t_b(:,:,jk) = fse3t_n(:,:,jk) & 248 219 & + atfp * ( fse3t_b(:,:,jk) + fse3t_a(:,:,jk) & 249 & - 2.e0 * fse3t_n(:,:,jk) ) 250 ENDDO 251 ! Add volume filter correction only at the first level of t-point scale factors 252 zec = atfp * rdt / rau0 220 & - 2._wp * fse3t_n(:,:,jk) ) 221 END DO 222 zec = atfp * rdt / rau0 ! Add filter correction only at the 1st level of t-point scale factors 253 223 fse3t_b(:,:,1) = fse3t_b(:,:,1) - zec * ( emp_b(:,:) - emp(:,:) ) * tmask(:,:,1) 254 ! surface at t-points and inverse surface at (u/v)-points used in surface averaging computations255 zs_t (:,:) = e1t(:,:) * e2t(:,:)256 zs_u_1(:,:) = 0.5 / ( e1u(:,:) * e2u(:,:) )257 zs_v_1(:,:) = 0.5 / ( e1v(:,:) * e2v(:,:) )258 224 ! 259 IF( ln_dynadv_vec ) THEN 260 ! Before scale factor at (u/v)-points 261 ! ----------------------------------- 262 ! Scale factor anomaly at (u/v)-points: surface averaging of scale factor at t-points 263 DO jk = 1, jpkm1 264 DO jj = 1, jpjm1 265 DO ji = 1, jpim1 266 zv_t_ij = zs_t(ji ,jj ) * fse3t_b(ji ,jj ,jk) 267 zv_t_ip1j = zs_t(ji+1,jj ) * fse3t_b(ji+1,jj ,jk) 268 zv_t_ijp1 = zs_t(ji ,jj+1) * fse3t_b(ji ,jj+1,jk) 269 fse3u_b(ji,jj,jk) = umask(ji,jj,jk) * ( zs_u_1(ji,jj) * ( zv_t_ij + zv_t_ip1j ) - fse3u_0(ji,jj,jk) ) 270 fse3v_b(ji,jj,jk) = vmask(ji,jj,jk) * ( zs_v_1(ji,jj) * ( zv_t_ij + zv_t_ijp1 ) - fse3v_0(ji,jj,jk) ) 271 END DO 272 END DO 273 END DO 274 ! lateral boundary conditions 275 CALL lbc_lnk( fse3u_b(:,:,:), 'U', 1. ) 276 CALL lbc_lnk( fse3v_b(:,:,:), 'V', 1. ) 277 ! Add initial scale factor to scale factor anomaly 278 fse3u_b(:,:,:) = fse3u_b(:,:,:) + fse3u_0(:,:,:) 279 fse3v_b(:,:,:) = fse3v_b(:,:,:) + fse3v_0(:,:,:) 280 ! Leap-Frog - Asselin filter and swap: applied on velocity 281 ! ----------------------------------- 282 DO jk = 1, jpkm1 283 DO jj = 1, jpj 225 IF( ln_dynadv_vec ) THEN ! vector invariant form (no thickness weighted calulation) 226 ! 227 ! ! before scale factors at u- & v-pts (computed from fse3t_b) 228 CALL dom_vvl_2( kt, fse3u_b(:,:,:), fse3v_b(:,:,:) ) 229 ! 230 DO jk = 1, jpkm1 ! Leap-Frog - Asselin filter and swap: applied on velocity 231 DO jj = 1, jpj ! -------- 284 232 DO ji = 1, jpi 285 233 zuf = un(ji,jj,jk) + atfp * ( ub(ji,jj,jk) - 2.e0 * un(ji,jj,jk) + ua(ji,jj,jk) ) … … 294 242 END DO 295 243 ! 296 ELSE 297 ! Temporary filered scale factor at (u/v)-points (will become before scale factor) 298 !----------------------------------------------- 299 ! Scale factor anomaly at (u/v)-points: surface averaging of scale factor at t-points 300 DO jk = 1, jpkm1 301 DO jj = 1, jpjm1 302 DO ji = 1, jpim1 303 zv_t_ij = zs_t(ji ,jj ) * fse3t_b(ji ,jj ,jk) 304 zv_t_ip1j = zs_t(ji+1,jj ) * fse3t_b(ji+1,jj ,jk) 305 zv_t_ijp1 = zs_t(ji ,jj+1) * fse3t_b(ji ,jj+1,jk) 306 ze3u_f(ji,jj,jk) = umask(ji,jj,jk) * ( zs_u_1(ji,jj) * ( zv_t_ij + zv_t_ip1j ) - fse3u_0(ji,jj,jk) ) 307 ze3v_f(ji,jj,jk) = vmask(ji,jj,jk) * ( zs_v_1(ji,jj) * ( zv_t_ij + zv_t_ijp1 ) - fse3v_0(ji,jj,jk) ) 308 END DO 309 END DO 310 END DO 311 ! lateral boundary conditions 312 CALL lbc_lnk( ze3u_f, 'U', 1. ) 313 CALL lbc_lnk( ze3v_f, 'V', 1. ) 314 ! Add initial scale factor to scale factor anomaly 315 ze3u_f(:,:,:) = ze3u_f(:,:,:) + fse3u_0(:,:,:) 316 ze3v_f(:,:,:) = ze3v_f(:,:,:) + fse3v_0(:,:,:) 317 ! Leap-Frog - Asselin filter and swap: applied on thickness weighted velocity 318 ! ----------------------------------- =========================== 319 DO jk = 1, jpkm1 320 DO jj = 1, jpj 321 DO ji = 1, jpim1 244 ELSE ! flux form (thickness weighted calulation) 245 ! 246 CALL dom_vvl_2( kt, ze3u_f, ze3v_f ) ! before scale factors at u- & v-pts (computed from fse3t_b) 247 ! 248 DO jk = 1, jpkm1 ! Leap-Frog - Asselin filter and swap: 249 DO jj = 1, jpj ! applied on thickness weighted velocity 250 DO ji = 1, jpim1 ! --------------------------- 322 251 zue3a = ua(ji,jj,jk) * fse3u_a(ji,jj,jk) 323 252 zve3a = va(ji,jj,jk) * fse3v_a(ji,jj,jk) … … 327 256 zve3b = vb(ji,jj,jk) * fse3v_b(ji,jj,jk) 328 257 ! 329 zuf = ( zue3n + atfp * ( zue3b - 2.e0* zue3n + zue3a ) ) / ze3u_f(ji,jj,jk)330 zvf = ( zve3n + atfp * ( zve3b - 2.e0* zve3n + zve3a ) ) / ze3v_f(ji,jj,jk)258 zuf = ( zue3n + atfp * ( zue3b - 2._wp * zue3n + zue3a ) ) / ze3u_f(ji,jj,jk) 259 zvf = ( zve3n + atfp * ( zve3b - 2._wp * zve3n + zve3a ) ) / ze3v_f(ji,jj,jk) 331 260 ! 332 ub(ji,jj,jk) = zuf 261 ub(ji,jj,jk) = zuf ! ub <-- filtered velocity 333 262 vb(ji,jj,jk) = zvf 334 un(ji,jj,jk) = ua(ji,jj,jk) 263 un(ji,jj,jk) = ua(ji,jj,jk) ! un <-- ua 335 264 vn(ji,jj,jk) = va(ji,jj,jk) 336 265 END DO 337 266 END DO 338 267 END DO 339 fse3u_b(:,:, :) = ze3u_f(:,:,:)! e3u_b <-- filtered scale factor340 fse3v_b(:,:, :) = ze3v_f(:,:,:)341 CALL lbc_lnk( ub, 'U', -1. ) 268 fse3u_b(:,:,1:jpkm1) = ze3u_f(:,:,1:jpkm1) ! e3u_b <-- filtered scale factor 269 fse3v_b(:,:,1:jpkm1) = ze3v_f(:,:,1:jpkm1) 270 CALL lbc_lnk( ub, 'U', -1. ) ! lateral boundary conditions 342 271 CALL lbc_lnk( vb, 'V', -1. ) 343 272 ENDIF … … 350 279 & tab3d_2=vn, clinfo2=' Vn: ' , mask2=vmask ) 351 280 ! 352 IF( wrk_not_released(2, 1,2,3) ) CALL ctl_stop('dyn_nxt: failed to release workspace arrays')353 !354 281 END SUBROUTINE dyn_nxt 355 282 -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
r2715 r3116 15 15 USE dom_oce ! ocean space and time domain variables 16 16 USE phycst ! physical constants 17 USE obc_oce ! ocean open boundary conditions18 17 USE sbc_oce ! surface boundary condition: ocean 19 18 USE sbcapr ! surface boundary condition: atmospheric pressure … … 222 221 ENDIF 223 222 224 #if defined key_obc225 ! ! Conservation of ocean volume (key_dynspg_flt)226 IF( lk_dynspg_flt ) ln_vol_cst = .true.227 228 ! ! Application of Flather's algorithm at open boundaries229 IF( lk_dynspg_flt ) ln_obc_fla = .false.230 IF( lk_dynspg_exp ) ln_obc_fla = .true.231 IF( lk_dynspg_ts ) ln_obc_fla = .true.232 #endif233 223 ! 234 224 END SUBROUTINE dyn_spg_init -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90
r2715 r3116 21 21 USE phycst ! physical constants 22 22 USE obc_par ! open boundary condition parameters 23 USE obcdta ! open boundary condition data ( obc_dta_bt routine)23 USE obcdta ! open boundary condition data (bdy_dta_bt routine) 24 24 USE in_out_manager ! I/O manager 25 25 USE lib_mpp ! distributed memory computing library -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90
r2977 r3116 26 26 USE sbc_oce ! surface boundary condition: ocean 27 27 USE obc_oce ! Lateral open boundary condition 28 USE bdy_oce ! Lateral open boundary condition 28 29 USE sol_oce ! ocean elliptic solver 29 30 USE phycst ! physical constants … … 33 34 USE solpcg ! preconditionned conjugate gradient solver 34 35 USE solsor ! Successive Over-relaxation solver 35 USE obcdyn ! ocean open boundary condition (obc_dyn routines) 36 USE obcvol ! ocean open boundary condition (obc_vol routines) 37 USE bdy_oce ! Unstructured open boundaries condition 38 USE bdydyn ! Unstructured open boundaries condition (bdy_dyn routine) 39 USE bdyvol ! Unstructured open boundaries condition (bdy_vol routine) 36 USE obcdyn ! ocean open boundary condition on dynamics 37 USE obcvol ! ocean open boundary condition (obc_vol routine) 38 USE bdydyn ! ocean open boundary condition on dynamics 39 USE bdyvol ! ocean open boundary condition (bdy_vol routine) 40 40 USE cla ! cross land advection 41 41 USE in_out_manager ! I/O manager … … 191 191 #endif 192 192 #if defined key_bdy 193 CALL bdy_dyn _frs( kt ) ! Update velocities on unstructured boundary using the Flow Relaxation Scheme194 CALL bdy_vol( kt ) 193 CALL bdy_dyn( kt ) ! Update velocities on each open boundary 194 CALL bdy_vol( kt ) ! Correction of the barotropic component velocity to control the volume of the system 195 195 #endif 196 196 #if defined key_agrif … … 308 308 #if defined key_obc 309 309 ! caution : grad D = 0 along open boundaries 310 ! Remark: The filtering force could be reduced here in the FRS zone 311 ! by multiplying spgu/spgv by (1-alpha) ?? 310 312 spgu(ji,jj) = z2dt * ztdgu * obcumask(ji,jj) 311 313 spgv(ji,jj) = z2dt * ztdgv * obcvmask(ji,jj) 312 314 #elif defined key_bdy 313 315 ! caution : grad D = 0 along open boundaries 314 ! Remark: The filtering force could be reduced here in the FRS zone315 ! by multiplying spgu/spgv by (1-alpha) ??316 316 spgu(ji,jj) = z2dt * ztdgu * bdyumask(ji,jj) 317 spgv(ji,jj) = z2dt * ztdgv * bdyvmask(ji,jj) 317 spgv(ji,jj) = z2dt * ztdgv * bdyvmask(ji,jj) 318 318 #else 319 319 spgu(ji,jj) = z2dt * ztdgu -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_oce.F90
r2715 r3116 34 34 35 35 ! !!! Time splitting scheme (key_dynspg_ts) 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshn_e, ssha_e ! sea surface heigth (now, after, average)37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ua_e , va_e ! barotropic velocities (after)38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_e , hv_e ! now ocean depth ( = Ho+sshn_e )39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hur_e , hvr_e ! inverse of hu_e and hv_e40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshn_b! before field without time-filter36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: sshn_e, ssha_e ! sea surface heigth (now, after, average) 37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: ua_e , va_e ! barotropic velocities (after) 38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_e , hv_e ! now ocean depth ( = Ho+sshn_e ) 39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: hur_e , hvr_e ! inverse of hu_e and hv_e 40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: sshn_b ! before field without time-filter 41 41 42 42 !!---------------------------------------------------------------------- -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r3104 r3116 25 25 USE domvvl ! variable volume 26 26 USE zdfbfr ! bottom friction 27 USE obcdta ! open boundary condition data28 USE obcfla ! Flather open boundary condition29 27 USE dynvor ! vorticity term 30 28 USE obc_oce ! Lateral open boundary condition 31 29 USE obc_par ! open boundary condition parameters 32 USE bdy_oce ! unstructured open boundaries 33 USE bdy_par ! unstructured open boundaries 34 USE bdydta ! unstructured open boundaries 35 USE bdydyn ! unstructured open boundaries 36 USE bdytides ! tidal forcing at unstructured open boundaries. 30 USE obcdta ! open boundary condition data 31 USE obcfla ! Flather open boundary condition 32 USE bdy_par ! for lk_bdy 33 USE bdy_oce ! Lateral open boundary condition 34 USE bdydta ! open boundary condition data 35 USE bdydyn2d ! open boundary conditions on barotropic variables 37 36 USE sbctide 38 37 USE updtide … … 121 120 INTEGER :: ji, jj, jk, jn ! dummy loop indices 122 121 INTEGER :: icycle ! local scalar 123 REAL(wp) :: zraur, zcoef, z2dt_e, z2dt_b ! local scalars 124 REAL(wp) :: z1_8, zx1, zy1 ! - - 125 REAL(wp) :: z1_4, zx2, zy2 ! - - 126 REAL(wp) :: zu_spg, zu_cor, zu_sld, zu_asp ! - - 127 REAL(wp) :: zv_spg, zv_cor, zv_sld, zv_asp ! - - 122 INTEGER :: ikbu, ikbv ! local scalar 123 REAL(wp) :: zraur, zcoef, z2dt_e, z1_2dt_b, z2dt_bf ! local scalars 124 REAL(wp) :: z1_8, zx1, zy1 ! - - 125 REAL(wp) :: z1_4, zx2, zy2 ! - - 126 REAL(wp) :: zu_spg, zu_cor, zu_sld, zu_asp ! - - 127 REAL(wp) :: zv_spg, zv_cor, zv_sld, zv_asp ! - - 128 REAL(wp) :: ua_btm, va_btm ! - - 128 129 !!---------------------------------------------------------------------- 129 130 … … 149 150 hvr_e (:,:) = hvr (:,:) 150 151 IF( ln_dynvor_een ) THEN 151 ftne(1,:) = 0. e0 ; ftnw(1,:) = 0.e0 ; ftse(1,:) = 0.e0 ; ftsw(1,:) = 0.e0152 ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 152 153 DO jj = 2, jpj 153 154 DO ji = fs_2, jpi ! vector opt. 154 ftne(ji,jj) = ( ff(ji-1,jj ) + ff(ji ,jj ) + ff(ji ,jj-1) ) / 3. 155 ftnw(ji,jj) = ( ff(ji-1,jj-1) + ff(ji-1,jj ) + ff(ji ,jj ) ) / 3. 156 ftse(ji,jj) = ( ff(ji ,jj ) + ff(ji ,jj-1) + ff(ji-1,jj-1) ) / 3. 157 ftsw(ji,jj) = ( ff(ji ,jj-1) + ff(ji-1,jj-1) + ff(ji-1,jj ) ) / 3. 155 ftne(ji,jj) = ( ff(ji-1,jj ) + ff(ji ,jj ) + ff(ji ,jj-1) ) / 3._wp 156 ftnw(ji,jj) = ( ff(ji-1,jj-1) + ff(ji-1,jj ) + ff(ji ,jj ) ) / 3._wp 157 ftse(ji,jj) = ( ff(ji ,jj ) + ff(ji ,jj-1) + ff(ji-1,jj-1) ) / 3._wp 158 ftsw(ji,jj) = ( ff(ji ,jj-1) + ff(ji-1,jj-1) + ff(ji-1,jj ) ) / 3._wp 158 159 END DO 159 160 END DO … … 162 163 ENDIF 163 164 164 ! !* Local constant initialization 165 z2dt_b = 2.0 * rdt ! baroclinic time step 166 z1_8 = 0.5 * 0.25 ! coefficient for vorticity estimates 167 z1_4 = 0.5 * 0.5 168 zraur = 1. / rau0 ! 1 / volumic mass 169 ! 170 zhdiv(:,:) = 0.e0 ! barotropic divergence 171 zu_sld = 0.e0 ; zu_asp = 0.e0 ! tides trends (lk_tide=F) 172 zv_sld = 0.e0 ; zv_asp = 0.e0 165 ! !* Local constant initialization 166 z1_2dt_b = 1._wp / ( 2.0_wp * rdt ) ! reciprocal of baroclinic time step 167 IF( neuler == 0 .AND. kt == nit000 ) z1_2dt_b = 1.0_wp / rdt ! reciprocal of baroclinic 168 ! time step (euler timestep) 169 z1_8 = 0.125_wp ! coefficient for vorticity estimates 170 z1_4 = 0.25_wp 171 zraur = 1._wp / rau0 ! 1 / volumic mass 172 ! 173 zhdiv(:,:) = 0._wp ! barotropic divergence 174 zu_sld = 0._wp ; zu_asp = 0._wp ! tides trends (lk_tide=F) 175 zv_sld = 0._wp ; zv_asp = 0._wp 176 177 IF( kt == nit000 .AND. neuler == 0) THEN ! for implicit bottom friction 178 z2dt_bf = rdt 179 ELSE 180 z2dt_bf = 2.0_wp * rdt 181 ENDIF 173 182 174 183 ! ----------------------------------------------------------------------------- … … 178 187 ! !* e3*d/dt(Ua), e3*Ub, e3*Vn (Vertically integrated) 179 188 ! ! -------------------------- 180 zua(:,:) = 0. e0 ; zun(:,:) = 0.e0 ; ub_b(:,:) = 0.e0181 zva(:,:) = 0. e0 ; zvn(:,:) = 0.e0 ; vb_b(:,:) = 0.e0189 zua(:,:) = 0._wp ; zun(:,:) = 0._wp ; ub_b(:,:) = 0._wp 190 zva(:,:) = 0._wp ; zvn(:,:) = 0._wp ; vb_b(:,:) = 0._wp 182 191 ! 183 192 DO jk = 1, jpkm1 … … 197 206 ! 198 207 #if defined key_vvl 199 ub_b(ji,jj) = ub_b(ji,jj) + (fse3u_0(ji,jj,jk)*(1.+sshu_b(ji,jj)*muu(ji,jj,jk)))* ub(ji,jj,jk)200 vb_b(ji,jj) = vb_b(ji,jj) + (fse3v_0(ji,jj,jk)*(1.+sshv_b(ji,jj)*muv(ji,jj,jk)))* vb(ji,jj,jk)208 ub_b(ji,jj) = ub_b(ji,jj) + fse3u_b(ji,jj,jk)* ub(ji,jj,jk) *umask(ji,jj,jk) 209 vb_b(ji,jj) = vb_b(ji,jj) + fse3v_b(ji,jj,jk)* vb(ji,jj,jk) *vmask(ji,jj,jk) 201 210 #else 202 211 ub_b(ji,jj) = ub_b(ji,jj) + fse3u_0(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk) … … 272 281 DO jj = 2, jpjm1 ! Remove coriolis term (and possibly spg) from barotropic trend 273 282 DO ji = fs_2, fs_jpim1 274 zua(ji,jj) = zua(ji,jj) - zcu(ji,jj)275 zva(ji,jj) = zva(ji,jj) - zcv(ji,jj)276 END DO283 zua(ji,jj) = zua(ji,jj) - zcu(ji,jj) 284 zva(ji,jj) = zva(ji,jj) - zcv(ji,jj) 285 END DO 277 286 END DO 278 287 … … 280 289 ! ! Remove barotropic contribution of bottom friction 281 290 ! ! from the barotropic transport trend 282 zcoef = -1. / z2dt_b 291 zcoef = -1._wp * z1_2dt_b 292 293 IF(ln_bfrimp) THEN 294 ! ! Remove the bottom stress trend from 3-D sea surface level gradient 295 ! ! and Coriolis forcing in case of 3D semi-implicit bottom friction 296 DO jj = 2, jpjm1 297 DO ji = fs_2, fs_jpim1 298 ikbu = mbku(ji,jj) 299 ikbv = mbkv(ji,jj) 300 ua_btm = zcu(ji,jj) * z2dt_bf * hur(ji,jj) * umask (ji,jj,ikbu) 301 va_btm = zcv(ji,jj) * z2dt_bf * hvr(ji,jj) * vmask (ji,jj,ikbv) 302 303 zua(ji,jj) = zua(ji,jj) - bfrua(ji,jj) * ua_btm 304 zva(ji,jj) = zva(ji,jj) - bfrva(ji,jj) * va_btm 305 END DO 306 END DO 307 308 ELSE 309 283 310 # if defined key_vectopt_loop 284 DO jj = 1, 1285 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling)311 DO jj = 1, 1 312 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 286 313 # else 287 DO jj = 2, jpjm1288 DO ji = 2, jpim1314 DO jj = 2, jpjm1 315 DO ji = 2, jpim1 289 316 # endif 290 317 ! Apply stability criteria for bottom friction 291 318 !RBbug for vvl and external mode we may need to use varying fse3 292 319 !!gm Rq: the bottom e3 present the smallest variation, the use of e3u_0 is not a big approx. 293 zbfru(ji,jj) = MAX( bfrua(ji,jj) , fse3u(ji,jj,mbku(ji,jj)) * zcoef ) 294 zbfrv(ji,jj) = MAX( bfrva(ji,jj) , fse3v(ji,jj,mbkv(ji,jj)) * zcoef ) 295 END DO 296 END DO 297 298 IF( lk_vvl ) THEN 299 DO jj = 2, jpjm1 300 DO ji = fs_2, fs_jpim1 ! vector opt. 301 zua(ji,jj) = zua(ji,jj) - zbfru(ji,jj) * ub_b(ji,jj) & 302 & / ( hu_0(ji,jj) + sshu_b(ji,jj) + 1.e0 - umask(ji,jj,1) ) 303 zva(ji,jj) = zva(ji,jj) - zbfrv(ji,jj) * vb_b(ji,jj) & 304 & / ( hv_0(ji,jj) + sshv_b(ji,jj) + 1.e0 - vmask(ji,jj,1) ) 305 END DO 306 END DO 307 ELSE 308 DO jj = 2, jpjm1 309 DO ji = fs_2, fs_jpim1 ! vector opt. 310 zua(ji,jj) = zua(ji,jj) - zbfru(ji,jj) * ub_b(ji,jj) * hur(ji,jj) 311 zva(ji,jj) = zva(ji,jj) - zbfrv(ji,jj) * vb_b(ji,jj) * hvr(ji,jj) 312 END DO 313 END DO 314 ENDIF 315 320 zbfru(ji,jj) = MAX( bfrua(ji,jj) , fse3u(ji,jj,mbku(ji,jj)) * zcoef ) 321 zbfrv(ji,jj) = MAX( bfrva(ji,jj) , fse3v(ji,jj,mbkv(ji,jj)) * zcoef ) 322 END DO 323 END DO 324 325 IF( lk_vvl ) THEN 326 DO jj = 2, jpjm1 327 DO ji = fs_2, fs_jpim1 ! vector opt. 328 zua(ji,jj) = zua(ji,jj) - zbfru(ji,jj) * ub_b(ji,jj) & 329 & / ( hu_0(ji,jj) + sshu_b(ji,jj) + 1._wp - umask(ji,jj,1) ) 330 zva(ji,jj) = zva(ji,jj) - zbfrv(ji,jj) * vb_b(ji,jj) & 331 & / ( hv_0(ji,jj) + sshv_b(ji,jj) + 1._wp - vmask(ji,jj,1) ) 332 END DO 333 END DO 334 ELSE 335 DO jj = 2, jpjm1 336 DO ji = fs_2, fs_jpim1 ! vector opt. 337 zua(ji,jj) = zua(ji,jj) - zbfru(ji,jj) * ub_b(ji,jj) * hur(ji,jj) 338 zva(ji,jj) = zva(ji,jj) - zbfrv(ji,jj) * vb_b(ji,jj) * hvr(ji,jj) 339 END DO 340 END DO 341 ENDIF 342 END IF ! end (ln_bfrimp) 343 344 316 345 ! !* d/dt(Ua), Ub, Vn (Vertical mean velocity) 317 346 ! ! -------------------------- … … 320 349 ! 321 350 IF( lk_vvl ) THEN 322 ub_b(:,:) = ub_b(:,:) * umask(:,:,1) / ( hu_0(:,:) + sshu_b(:,:) + 1. e0- umask(:,:,1) )323 vb_b(:,:) = vb_b(:,:) * vmask(:,:,1) / ( hv_0(:,:) + sshv_b(:,:) + 1. e0- vmask(:,:,1) )351 ub_b(:,:) = ub_b(:,:) * umask(:,:,1) / ( hu_0(:,:) + sshu_b(:,:) + 1._wp - umask(:,:,1) ) 352 vb_b(:,:) = vb_b(:,:) * vmask(:,:,1) / ( hv_0(:,:) + sshv_b(:,:) + 1._wp - vmask(:,:,1) ) 324 353 ELSE 325 354 ub_b(:,:) = ub_b(:,:) * hur(:,:) … … 357 386 ! set ssh corrections to 0 358 387 ! ssh corrections are applied to normal velocities (Flather's algorithm) and averaged over the barotropic loop 359 IF( lp_obc_east ) sshfoe_b(:,:) = 0. e0360 IF( lp_obc_west ) sshfow_b(:,:) = 0. e0361 IF( lp_obc_south ) sshfos_b(:,:) = 0. e0362 IF( lp_obc_north ) sshfon_b(:,:) = 0. e0388 IF( lp_obc_east ) sshfoe_b(:,:) = 0._wp 389 IF( lp_obc_west ) sshfow_b(:,:) = 0._wp 390 IF( lp_obc_south ) sshfos_b(:,:) = 0._wp 391 IF( lp_obc_north ) sshfon_b(:,:) = 0._wp 363 392 #endif 364 393 … … 369 398 IF( jn == 1 ) z2dt_e = rdt / nn_baro 370 399 371 ! !* Update the forcing ( OBC,BDY and tides)400 ! !* Update the forcing (BDY and tides) 372 401 ! ! ------------------ 373 402 IF( lk_obc ) CALL obc_dta_bt ( kt, jn ) 374 IF( lk_bdy ) CALL bdy_dta _fla( kt, jn+1, icycle)403 IF( lk_bdy ) CALL bdy_dta ( kt, jit=jn, time_offset=+1 ) 375 404 IF ( ln_tide_pot ) CALL upd_tide( kt, jn ) 376 405 377 406 ! !* after ssh_e 378 407 ! ! ----------- 379 DO jj = 2, jpjm1 408 DO jj = 2, jpjm1 ! Horizontal divergence of barotropic transports 380 409 DO ji = fs_2, fs_jpim1 ! vector opt. 381 410 zhdiv(ji,jj) = ( e2u(ji ,jj) * zun_e(ji ,jj) * hu_e(ji ,jj) & … … 389 418 ! ! OBC : zhdiv must be zero behind the open boundary 390 419 !! mpp remark: The zeroing of hdiv can probably be extended to 1->jpi/jpj for the correct row/column 391 IF( lp_obc_east ) zhdiv(nie0p1:nie1p1,nje0 :nje1 ) = 0. e0! east392 IF( lp_obc_west ) zhdiv(niw0 :niw1 ,njw0 :njw1 ) = 0. e0! west393 IF( lp_obc_north ) zhdiv(nin0 :nin1 ,njn0p1:njn1p1) = 0. e0! north394 IF( lp_obc_south ) zhdiv(nis0 :nis1 ,njs0 :njs1 ) = 0. e0! south420 IF( lp_obc_east ) zhdiv(nie0p1:nie1p1,nje0 :nje1 ) = 0._wp ! east 421 IF( lp_obc_west ) zhdiv(niw0 :niw1 ,njw0 :njw1 ) = 0._wp ! west 422 IF( lp_obc_north ) zhdiv(nin0 :nin1 ,njn0p1:njn1p1) = 0._wp ! north 423 IF( lp_obc_south ) zhdiv(nis0 :nis1 ,njs0 :njs1 ) = 0._wp ! south 395 424 #endif 396 425 #if defined key_bdy … … 406 435 ! !* after barotropic velocities (vorticity scheme dependent) 407 436 ! ! --------------------------- 408 zwx(:,:) = e2u(:,:) * zun_e(:,:) * hu_e(:,:) 437 zwx(:,:) = e2u(:,:) * zun_e(:,:) * hu_e(:,:) ! now_e transport 409 438 zwy(:,:) = e1v(:,:) * zvn_e(:,:) * hv_e(:,:) 410 439 ! … … 435 464 zv_cor =-z1_4 * ( ff(ji-1,jj ) * zx1 + ff(ji,jj) * zx2 ) * hvr_e(ji,jj) 436 465 ! after velocities with implicit bottom friction 437 ua_e(ji,jj) = ( zub_e(ji,jj) + z2dt_e * ( zu_cor + zu_spg + zu_sld + zu_asp + zua(ji,jj) ) ) * umask(ji,jj,1) & 438 & / ( 1.e0 - z2dt_e * bfrua(ji,jj) * hur_e(ji,jj) ) 439 va_e(ji,jj) = ( zvb_e(ji,jj) + z2dt_e * ( zv_cor + zv_spg + zv_sld + zv_asp + zva(ji,jj) ) ) * vmask(ji,jj,1) & 440 & / ( 1.e0 - z2dt_e * bfrva(ji,jj) * hvr_e(ji,jj) ) 466 467 IF( ln_bfrimp ) THEN ! implicit bottom friction 468 ! A new method to implement the implicit bottom friction. 469 ! H. Liu 470 ! Sept 2011 471 ua_e(ji,jj) = umask(ji,jj,1) * ( zub_e(ji,jj) + & 472 & z2dt_e * ( zu_cor + zu_spg + zu_sld + zu_asp ) & 473 & / ( 1._wp - z2dt_e * bfrua(ji,jj) * hur_e(ji,jj) ) ) 474 ua_e(ji,jj) = ( ua_e(ji,jj) + z2dt_e * zua(ji,jj) ) * umask(ji,jj,1) 475 ! 476 va_e(ji,jj) = vmask(ji,jj,1) * ( zvb_e(ji,jj) + & 477 & z2dt_e * ( zv_cor + zv_spg + zv_sld + zv_asp ) & 478 & / ( 1._wp - z2dt_e * bfrva(ji,jj) * hvr_e(ji,jj) ) ) 479 va_e(ji,jj) = ( va_e(ji,jj) + z2dt_e * zva(ji,jj) ) * vmask(ji,jj,1) 480 ! 481 ELSE 482 ua_e(ji,jj) = ( zub_e(ji,jj) + z2dt_e * ( zu_cor + zu_spg + zu_sld + zu_asp + zua(ji,jj) ) ) * umask(ji,jj,1) & 483 & / ( 1._wp - z2dt_e * bfrua(ji,jj) * hur_e(ji,jj) ) 484 va_e(ji,jj) = ( zvb_e(ji,jj) + z2dt_e * ( zv_cor + zv_spg + zv_sld + zv_asp + zva(ji,jj) ) ) * vmask(ji,jj,1) & 485 & / ( 1._wp - z2dt_e * bfrva(ji,jj) * hvr_e(ji,jj) ) 486 ENDIF 441 487 END DO 442 488 END DO … … 466 512 zv_cor = zx1 * ( ff(ji-1,jj ) + ff(ji,jj) ) * hvr_e(ji,jj) 467 513 ! after velocities with implicit bottom friction 468 ua_e(ji,jj) = ( zub_e(ji,jj) + z2dt_e * ( zu_cor + zu_spg + zu_sld + zu_asp + zua(ji,jj) ) ) * umask(ji,jj,1) & 469 & / ( 1.e0 - z2dt_e * bfrua(ji,jj) * hur_e(ji,jj) ) 470 va_e(ji,jj) = ( zvb_e(ji,jj) + z2dt_e * ( zv_cor + zv_spg + zv_sld + zv_asp + zva(ji,jj) ) ) * vmask(ji,jj,1) & 471 & / ( 1.e0 - z2dt_e * bfrva(ji,jj) * hvr_e(ji,jj) ) 514 IF( ln_bfrimp ) THEN 515 ! A new method to implement the implicit bottom friction. 516 ! H. Liu 517 ! Sept 2011 518 ua_e(ji,jj) = umask(ji,jj,1) * ( zub_e(ji,jj) + & 519 & z2dt_e * ( zu_cor + zu_spg + zu_sld + zu_asp ) & 520 & / ( 1._wp - z2dt_e * bfrua(ji,jj) * hur_e(ji,jj) ) ) 521 ua_e(ji,jj) = ( ua_e(ji,jj) + z2dt_e * zua(ji,jj) ) * umask(ji,jj,1) 522 ! 523 va_e(ji,jj) = vmask(ji,jj,1) * ( zvb_e(ji,jj) + & 524 & z2dt_e * ( zv_cor + zv_spg + zv_sld + zv_asp ) & 525 & / ( 1._wp - z2dt_e * bfrva(ji,jj) * hvr_e(ji,jj) ) ) 526 va_e(ji,jj) = ( va_e(ji,jj) + z2dt_e * zva(ji,jj) ) * vmask(ji,jj,1) 527 ! 528 ELSE 529 ua_e(ji,jj) = ( zub_e(ji,jj) + z2dt_e * ( zu_cor + zu_spg + zu_sld + zu_asp + zua(ji,jj) ) ) * umask(ji,jj,1) & 530 & / ( 1._wp - z2dt_e * bfrua(ji,jj) * hur_e(ji,jj) ) 531 va_e(ji,jj) = ( zvb_e(ji,jj) + z2dt_e * ( zv_cor + zv_spg + zv_sld + zv_asp + zva(ji,jj) ) ) * vmask(ji,jj,1) & 532 & / ( 1._wp - z2dt_e * bfrva(ji,jj) * hvr_e(ji,jj) ) 533 ENDIF 472 534 END DO 473 535 END DO … … 497 559 & + ftnw(ji,jj ) * zwx(ji-1,jj ) + ftne(ji,jj ) * zwx(ji ,jj ) ) * hvr_e(ji,jj) 498 560 ! after velocities with implicit bottom friction 499 ua_e(ji,jj) = ( zub_e(ji,jj) + z2dt_e * ( zu_cor + zu_spg + zu_sld + zu_asp + zua(ji,jj) ) ) * umask(ji,jj,1) & 500 & / ( 1.e0 - z2dt_e * bfrua(ji,jj) * hur_e(ji,jj) ) 501 va_e(ji,jj) = ( zvb_e(ji,jj) + z2dt_e * ( zv_cor + zv_spg + zv_sld + zv_asp + zva(ji,jj) ) ) * vmask(ji,jj,1) & 502 & / ( 1.e0 - z2dt_e * bfrva(ji,jj) * hvr_e(ji,jj) ) 561 IF( ln_bfrimp ) THEN 562 ! A new method to implement the implicit bottom friction. 563 ! H. Liu 564 ! Sept 2011 565 ua_e(ji,jj) = umask(ji,jj,1) * ( zub_e(ji,jj) + & 566 & z2dt_e * ( zu_cor + zu_spg + zu_sld + zu_asp ) & 567 & / ( 1._wp - z2dt_e * bfrua(ji,jj) * hur_e(ji,jj) ) ) 568 ua_e(ji,jj) = ( ua_e(ji,jj) + z2dt_e * zua(ji,jj) ) * umask(ji,jj,1) 569 ! 570 va_e(ji,jj) = vmask(ji,jj,1) * ( zvb_e(ji,jj) + & 571 & z2dt_e * ( zv_cor + zv_spg + zv_sld + zv_asp ) & 572 & / ( 1._wp - z2dt_e * bfrva(ji,jj) * hvr_e(ji,jj) ) ) 573 va_e(ji,jj) = ( va_e(ji,jj) + z2dt_e * zva(ji,jj) ) * vmask(ji,jj,1) 574 ! 575 ELSE 576 ua_e(ji,jj) = ( zub_e(ji,jj) + z2dt_e * ( zu_cor + zu_spg + zu_sld + zu_asp + zua(ji,jj) ) ) * umask(ji,jj,1) & 577 & / ( 1._wp - z2dt_e * bfrua(ji,jj) * hur_e(ji,jj) ) 578 va_e(ji,jj) = ( zvb_e(ji,jj) + z2dt_e * ( zv_cor + zv_spg + zv_sld + zv_asp + zva(ji,jj) ) ) * vmask(ji,jj,1) & 579 & / ( 1._wp - z2dt_e * bfrva(ji,jj) * hvr_e(ji,jj) ) 580 ENDIF 503 581 END DO 504 582 END DO 505 583 ! 506 584 ENDIF 507 ! !* domain lateral boundary 508 ! ! ----------------------- 509 ! ! Flather's boundary condition for the barotropic loop : 510 ! ! - Update sea surface height on each open boundary 511 ! ! - Correct the velocity 512 585 ! !* domain lateral boundary 586 ! ! ----------------------- 587 588 ! OBC open boundaries 513 589 IF( lk_obc ) CALL obc_fla_ts ( ua_e, va_e, sshn_e, ssha_e ) 514 IF( lk_bdy .OR. ln_tides ) CALL bdy_dyn_fla( sshn_e ) 590 591 ! BDY open boundaries 592 #if defined key_bdy 593 pssh => sshn_e 594 phur => hur_e 595 phvr => hvr_e 596 pu2d => ua_e 597 pv2d => va_e 598 599 IF( lk_bdy ) CALL bdy_dyn2d( kt ) 600 #endif 601 515 602 ! 516 603 CALL lbc_lnk( ua_e , 'U', -1. ) ! local domain boundaries … … 544 631 DO jj = 1, jpjm1 ! Sea Surface Height at u- & v-points 545 632 DO ji = 1, fs_jpim1 ! Vector opt. 546 zsshun_e(ji,jj) = 0.5 * umask(ji,jj,1) / ( e1u(ji,jj) * e2u(ji,jj) ) &547 & * ( e1t(ji ,jj) * e2t(ji ,jj) * sshn_e(ji ,jj) &548 & +e1t(ji+1,jj) * e2t(ji+1,jj) * sshn_e(ji+1,jj) )549 zsshvn_e(ji,jj) = 0.5 * vmask(ji,jj,1) / ( e1v(ji,jj) * e2v(ji,jj) ) &550 & * ( e1t(ji,jj ) * e2t(ji,jj ) * sshn_e(ji,jj ) &551 & +e1t(ji,jj+1) * e2t(ji,jj+1) * sshn_e(ji,jj+1) )633 zsshun_e(ji,jj) = 0.5_wp * umask(ji,jj,1) / ( e1u(ji,jj) * e2u(ji,jj) ) & 634 & * ( e1t(ji ,jj) * e2t(ji ,jj) * sshn_e(ji ,jj) & 635 & + e1t(ji+1,jj) * e2t(ji+1,jj) * sshn_e(ji+1,jj) ) 636 zsshvn_e(ji,jj) = 0.5_wp * vmask(ji,jj,1) / ( e1v(ji,jj) * e2v(ji,jj) ) & 637 & * ( e1t(ji,jj ) * e2t(ji,jj ) * sshn_e(ji,jj ) & 638 & + e1t(ji,jj+1) * e2t(ji,jj+1) * sshn_e(ji,jj+1) ) 552 639 END DO 553 640 END DO … … 557 644 hu_e (:,:) = hu_0(:,:) + zsshun_e(:,:) ! Ocean depth at U- and V-points 558 645 hv_e (:,:) = hv_0(:,:) + zsshvn_e(:,:) 559 hur_e(:,:) = umask(:,:,1) / ( hu_e(:,:) + 1. e0- umask(:,:,1) )560 hvr_e(:,:) = vmask(:,:,1) / ( hv_e(:,:) + 1. e0- vmask(:,:,1) )646 hur_e(:,:) = umask(:,:,1) / ( hu_e(:,:) + 1._wp - umask(:,:,1) ) 647 hvr_e(:,:) = vmask(:,:,1) / ( hv_e(:,:) + 1._wp - vmask(:,:,1) ) 561 648 ! 562 649 ENDIF … … 577 664 ! 578 665 ! !* Time average ==> after barotropic u, v, ssh 579 zcoef = 1. e0/ ( 2 * nn_baro + 1 )666 zcoef = 1._wp / ( 2 * nn_baro + 1 ) 580 667 zu_sum(:,:) = zcoef * zu_sum (:,:) 581 668 zv_sum(:,:) = zcoef * zv_sum (:,:) … … 583 670 ! !* update the general momentum trend 584 671 DO jk=1,jpkm1 585 ua(:,:,jk) = ua(:,:,jk) + ( zu_sum(:,:) - ub_b(:,:) ) / z2dt_b586 va(:,:,jk) = va(:,:,jk) + ( zv_sum(:,:) - vb_b(:,:) ) / z2dt_b672 ua(:,:,jk) = ua(:,:,jk) + ( zu_sum(:,:) - ub_b(:,:) ) * z1_2dt_b 673 va(:,:,jk) = va(:,:,jk) + ( zv_sum(:,:) - vb_b(:,:) ) * z1_2dt_b 587 674 END DO 588 675 un_b (:,:) = zu_sum(:,:) … … 618 705 CALL iom_get( numror, jpdom_autoglo, 'vn_b' , vn_b (:,:) ) ! from barotropic loop 619 706 ELSE 620 un_b (:,:) = 0. e0621 vn_b (:,:) = 0. e0707 un_b (:,:) = 0._wp 708 vn_b (:,:) = 0._wp 622 709 ! vertical sum 623 710 IF( lk_vopt_loop ) THEN ! vector opt., forced unroll … … 640 727 ! Vertically integrated velocity (before) 641 728 IF (neuler/=0) THEN 642 ub_b (:,:) = 0. e0643 vb_b (:,:) = 0. e0729 ub_b (:,:) = 0._wp 730 vb_b (:,:) = 0._wp 644 731 645 732 ! vertical sum … … 659 746 660 747 IF( lk_vvl ) THEN 661 ub_b (:,:) = ub_b(:,:) * umask(:,:,1) / ( hu_0(:,:) + sshu_b(:,:) + 1. e0- umask(:,:,1) )662 vb_b (:,:) = vb_b(:,:) * vmask(:,:,1) / ( hv_0(:,:) + sshv_b(:,:) + 1. e0- vmask(:,:,1) )748 ub_b (:,:) = ub_b(:,:) * umask(:,:,1) / ( hu_0(:,:) + sshu_b(:,:) + 1._wp - umask(:,:,1) ) 749 vb_b (:,:) = vb_b(:,:) * vmask(:,:,1) / ( hv_0(:,:) + sshv_b(:,:) + 1._wp - vmask(:,:,1) ) 663 750 ELSE 664 751 ub_b(:,:) = ub_b(:,:) * hur(:,:) -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r2977 r3116 20 20 USE in_out_manager ! I/O manager 21 21 USE lib_mpp ! MPP library 22 USE zdfbfr ! bottom friction setup 22 23 23 24 IMPLICIT NONE … … 61 62 REAL(wp), INTENT(in) :: p2dt ! vertical profile of tracer time-step 62 63 !! 63 INTEGER :: ji, jj, jk ! dummy loop indices 64 REAL(wp) :: z1_p2dt, zcoef, zzwi, zzws, zrhs ! local scalars 64 INTEGER :: ji, jj, jk ! dummy loop indices 65 INTEGER :: ikbum1, ikbvm1 ! local variable 66 REAL(wp) :: z1_p2dt, z2dtf, zcoef, zzwi, zzws, zrhs ! local scalars 67 68 !! * Local variables for implicit bottom friction. H. Liu 69 REAL(wp) :: zbfru, zbfrv 70 REAL(wp) :: zbfr_imp = 0._wp ! toggle (SAVE'd by assignment) 65 71 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwd, zws 72 !!---------------------------------------------------------------------- 66 73 !!---------------------------------------------------------------------- 67 74 … … 77 84 IF(lwp) WRITE(numout,*) 'dyn_zdf_imp : vertical momentum diffusion implicit operator' 78 85 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ ' 86 IF(ln_bfrimp) zbfr_imp = 1._wp 79 87 ENDIF 80 88 … … 84 92 85 93 ! 1. Vertical diffusion on u 94 95 ! Vertical diffusion on u&v 86 96 ! --------------------------- 87 97 ! Matrix and second member construction 88 ! bottom boundary condition: both zwi and zws must be masked as avmu can take 89 ! non zero value at the ocean bottom depending on the bottom friction 90 ! used but the bottom velocities have already been updated with the bottom 91 ! friction velocity in dyn_bfr using values from the previous timestep. There 92 ! is no need to include these in the implicit calculation. 93 ! 94 DO jk = 1, jpkm1 ! Matrix 95 DO jj = 2, jpjm1 96 DO ji = fs_2, fs_jpim1 ! vector opt. 98 !! bottom boundary condition: both zwi and zws must be masked as avmu can take 99 !! non zero value at the ocean bottom depending on the bottom friction 100 !! used but the bottom velocities have already been updated with the bottom 101 !! friction velocity in dyn_bfr using values from the previous timestep. There 102 !! is no need to include these in the implicit calculation. 103 104 ! The code has been modified here to implicitly implement bottom 105 ! friction: u(v)mask is not necessary here anymore. 106 ! H. Liu, April 2010. 107 108 ! 1. Vertical diffusion on u 109 DO jj = 2, jpjm1 110 DO ji = fs_2, fs_jpim1 ! vector opt. 111 ikbum1 = mbku(ji,jj) 112 zbfru = bfrua(ji,jj) 113 114 DO jk = 1, ikbum1 97 115 zcoef = - p2dt / fse3u(ji,jj,jk) 98 zzwi = zcoef * avmu (ji,jj,jk ) / fse3uw(ji,jj,jk ) 99 zwi(ji,jj,jk) = zzwi * umask(ji,jj,jk) 100 zzws = zcoef * avmu (ji,jj,jk+1) / fse3uw(ji,jj,jk+1) 101 zws(ji,jj,jk) = zzws * umask(ji,jj,jk+1) 102 zwd(ji,jj,jk) = 1._wp - zwi(ji,jj,jk) - zzws 103 END DO 104 END DO 105 END DO 106 DO jj = 2, jpjm1 ! Surface boudary conditions 107 DO ji = fs_2, fs_jpim1 ! vector opt. 116 zwi(ji,jj,jk) = zcoef * avmu(ji,jj,jk ) / fse3uw(ji,jj,jk ) 117 zws(ji,jj,jk) = zcoef * avmu(ji,jj,jk+1) / fse3uw(ji,jj,jk+1) 118 zwd(ji,jj,jk) = 1._wp - zwi(ji,jj,jk) - zws(ji,jj,jk) 119 END DO 120 121 ! Surface boundary conditions 108 122 zwi(ji,jj,1) = 0._wp 109 123 zwd(ji,jj,1) = 1._wp - zws(ji,jj,1) 110 END DO 111 END DO 124 125 ! Bottom boundary conditions ! H. Liu, May, 2010 126 ! !commented out to be consistent with v3.2, h.liu 127 ! z2dtf = p2dt * zbfru / fse3u(ji,jj,ikbum1) * 2.0_wp * zbfr_imp 128 z2dtf = p2dt * zbfru / fse3u(ji,jj,ikbum1) * 1.0_wp * zbfr_imp 129 zws(ji,jj,ikbum1) = 0._wp 130 zwd(ji,jj,ikbum1) = 1._wp - zwi(ji,jj,ikbum1) - z2dtf 112 131 113 132 ! Matrix inversion starting from the first level … … 125 144 ! The solution (the after velocity) is in ua 126 145 !----------------------------------------------------------------------- 127 ! 128 DO jk = 2, jpkm1 !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) == 129 DO jj = 2, jpjm1 130 DO ji = fs_2, fs_jpim1 ! vector opt. 146 147 ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) 148 DO jk = 2, ikbum1 131 149 zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1) 132 150 END DO 133 END DO 134 END DO 135 ! 136 DO jj = 2, jpjm1 !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 == 137 DO ji = fs_2, fs_jpim1 ! vector opt. 138 ua(ji,jj,1) = ub(ji,jj,1) + p2dt * ( ua(ji,jj,1) + 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) ) & 139 & / ( fse3u(ji,jj,1) * rau0 ) ) 140 END DO 141 END DO 142 DO jk = 2, jpkm1 143 DO jj = 2, jpjm1 144 DO ji = fs_2, fs_jpim1 ! vector opt. 151 152 ! second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 153 z2dtf = 0.5_wp * p2dt / ( fse3u(ji,jj,1) * rau0 ) 154 ua(ji,jj,1) = ub(ji,jj,1) + p2dt * ua(ji,jj,1) + z2dtf * (utau_b(ji,jj) + utau(ji,jj)) 155 DO jk = 2, ikbum1 145 156 zrhs = ub(ji,jj,jk) + p2dt * ua(ji,jj,jk) ! zrhs=right hand side 146 157 ua(ji,jj,jk) = zrhs - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * ua(ji,jj,jk-1) 147 158 END DO 148 END DO 149 END DO 150 ! 151 DO jj = 2, jpjm1 !== thrid recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk == 152 DO ji = fs_2, fs_jpim1 ! vector opt. 153 ua(ji,jj,jpkm1) = ua(ji,jj,jpkm1) / zwd(ji,jj,jpkm1) 154 END DO 155 END DO 156 DO jk = jpk-2, 1, -1 157 DO jj = 2, jpjm1 158 DO ji = fs_2, fs_jpim1 ! vector opt. 159 ua(ji,jj,jk) = ( ua(ji,jj,jk) - zws(ji,jj,jk) * ua(ji,jj,jk+1) ) / zwd(ji,jj,jk) 159 160 161 ! third recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk 162 ua(ji,jj,ikbum1) = ua(ji,jj,ikbum1) / zwd(ji,jj,ikbum1) 163 DO jk = ikbum1-1, 1, -1 164 ua(ji,jj,jk) =( ua(ji,jj,jk) - zws(ji,jj,jk) * ua(ji,jj,jk+1) ) / zwd(ji,jj,jk) 160 165 END DO 161 166 END DO … … 174 179 ! 2. Vertical diffusion on v 175 180 ! --------------------------- 176 ! Matrix and second member construction 177 ! bottom boundary condition: both zwi and zws must be masked as avmv can take 178 ! non zero value at the ocean bottom depending on the bottom friction 179 ! used but the bottom velocities have already been updated with the bottom 180 ! friction velocity in dyn_bfr using values from the previous timestep. There 181 ! is no need to include these in the implicit calculation. 182 ! 183 DO jk = 1, jpkm1 ! Matrix 181 182 DO ji = fs_2, fs_jpim1 ! vector opt. 184 183 DO jj = 2, jpjm1 185 DO ji = fs_2, fs_jpim1 ! vector opt. 184 ikbvm1 = mbkv(ji,jj) 185 zbfrv = bfrva(ji,jj) 186 187 DO jk = 1, ikbvm1 186 188 zcoef = -p2dt / fse3v(ji,jj,jk) 187 zzwi = zcoef * avmv (ji,jj,jk ) / fse3vw(ji,jj,jk ) 188 zwi(ji,jj,jk) = zzwi * vmask(ji,jj,jk) 189 zzws = zcoef * avmv (ji,jj,jk+1) / fse3vw(ji,jj,jk+1) 190 zws(ji,jj,jk) = zzws * vmask(ji,jj,jk+1) 191 zwd(ji,jj,jk) = 1._wp - zwi(ji,jj,jk) - zzws 192 END DO 193 END DO 194 END DO 195 DO jj = 2, jpjm1 ! Surface boudary conditions 196 DO ji = fs_2, fs_jpim1 ! vector opt. 189 zwi(ji,jj,jk) = zcoef * avmv(ji,jj,jk ) / fse3vw(ji,jj,jk ) 190 zws(ji,jj,jk) = zcoef * avmv(ji,jj,jk+1) / fse3vw(ji,jj,jk+1) 191 zwd(ji,jj,jk) = 1._wp - zwi(ji,jj,jk) - zws(ji,jj,jk) 192 END DO 193 194 ! Surface boundary conditions 197 195 zwi(ji,jj,1) = 0._wp 198 196 zwd(ji,jj,1) = 1._wp - zws(ji,jj,1) 199 END DO 200 END DO 197 198 ! Bottom boundary conditions ! H. Liu, May, 2010 199 ! !commented out to be consistent with v3.2, h.liu 200 ! z2dtf = p2dt * zbfrv / fse3v(ji,jj,ikbvm1) * 2.0_wp * zbfr_imp 201 z2dtf = p2dt * zbfrv / fse3v(ji,jj,ikbvm1) * 1.0_wp * zbfr_imp 202 zws(ji,jj,ikbvm1) = 0._wp 203 zwd(ji,jj,ikbvm1) = 1._wp - zwi(ji,jj,ikbvm1) - z2dtf 201 204 202 205 ! Matrix inversion … … 210 213 ! ( 0 0 0 zwik zwdk )( zwxk ) ( zwyk ) 211 214 ! 212 ! m is decomposed in the product of an upper and lower triangular matrix 215 ! m is decomposed in the product of an upper and lower triangular 216 ! matrix 213 217 ! The 3 diagonal terms are in 2d arrays: zwd, zws, zwi 214 218 ! The solution (after velocity) is in 2d array va 215 219 !----------------------------------------------------------------------- 216 ! 217 DO jk = 2, jpkm1 !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) == 218 DO jj = 2, jpjm1 219 DO ji = fs_2, fs_jpim1 ! vector opt. 220 221 ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) 222 DO jk = 2, ikbvm1 220 223 zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1) 221 224 END DO 222 END DO 223 END DO 224 ! 225 DO jj = 2, jpjm1 !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 == 226 DO ji = fs_2, fs_jpim1 ! vector opt. 227 va(ji,jj,1) = vb(ji,jj,1) + p2dt * ( va(ji,jj,1) + 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) & 228 & / ( fse3v(ji,jj,1) * rau0 ) ) 229 END DO 230 END DO 231 DO jk = 2, jpkm1 232 DO jj = 2, jpjm1 233 DO ji = fs_2, fs_jpim1 ! vector opt. 225 226 ! second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 227 z2dtf = 0.5_wp * p2dt / ( fse3v(ji,jj,1)*rau0 ) 228 va(ji,jj,1) = vb(ji,jj,1) + p2dt * va(ji,jj,1) + z2dtf * (vtau_b(ji,jj) + vtau(ji,jj)) 229 DO jk = 2, ikbvm1 234 230 zrhs = vb(ji,jj,jk) + p2dt * va(ji,jj,jk) ! zrhs=right hand side 235 231 va(ji,jj,jk) = zrhs - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * va(ji,jj,jk-1) 236 232 END DO 237 END DO 238 END DO 239 ! 240 DO jj = 2, jpjm1 !== thrid recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk == 241 DO ji = fs_2, fs_jpim1 ! vector opt. 242 va(ji,jj,jpkm1) = va(ji,jj,jpkm1) / zwd(ji,jj,jpkm1) 243 END DO 244 END DO 245 DO jk = jpk-2, 1, -1 246 DO jj = 2, jpjm1 247 DO ji = fs_2, fs_jpim1 ! vector opt. 248 va(ji,jj,jk) = ( va(ji,jj,jk) - zws(ji,jj,jk) * va(ji,jj,jk+1) ) / zwd(ji,jj,jk) 249 END DO 233 234 ! third recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk 235 va(ji,jj,ikbvm1) = va(ji,jj,ikbvm1) / zwd(ji,jj,ikbvm1) 236 237 DO jk = ikbvm1-1, 1, -1 238 va(ji,jj,jk) =( va(ji,jj,jk) - zws(ji,jj,jk) * va(ji,jj,jk+1) ) / zwd(ji,jj,jk) 239 END DO 240 250 241 END DO 251 242 END DO … … 262 253 IF( wrk_not_released(3, 3) ) CALL ctl_stop('dyn_zdf_imp: failed to release workspace array') 263 254 ! 255 264 256 END SUBROUTINE dyn_zdf_imp 265 257 -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r2977 r3116 183 183 #if defined key_bdy 184 184 ssha(:,:) = ssha(:,:) * bdytmask(:,:) 185 CALL lbc_lnk( ssha, 'T', 1. ) 185 CALL lbc_lnk( ssha, 'T', 1. ) ! absolutly compulsory !! (jmm) 186 186 #endif 187 187 -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90
r2715 r3116 5 5 !!====================================================================== 6 6 !! History : 9.0 ! 05-07 (C. Talandier) original code 7 !! 3.4 ! 11-11 (C. Harris) decomposition changes for running with CICE 7 8 !!---------------------------------------------------------------------- 8 9 USE dom_oce ! ocean space and time domain variables … … 434 435 435 436 ijpi = ( jpiglo-2*jpreci + (isplt-1) ) / isplt + 2*jpreci 437 #if defined key_nemocice_decomp 438 ijpj = ( jpjglo+1-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj 439 #else 436 440 ijpj = ( jpjglo-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj 441 #endif 437 442 438 443 ALLOCATE(ilcitl (isplt,jsplt)) … … 445 450 446 451 IF( irestil == 0 ) irestil = isplt 452 #if defined key_nemocice_decomp 453 454 ! In order to match CICE the size of domains in NEMO has to be changed 455 ! The last line of blocks (west) will have fewer points 456 DO jj = 1, jsplt 457 DO ji=1, isplt-1 458 ilcitl(ji,jj) = ijpi 459 END DO 460 ilcitl(isplt,jj) = jpiglo - (isplt - 1) * (ijpi - nrecil) 461 END DO 462 463 #else 464 447 465 DO jj = 1, jsplt 448 466 DO ji = 1, irestil … … 453 471 END DO 454 472 END DO 473 474 #endif 455 475 456 476 IF( irestjl == 0 ) irestjl = jsplt 477 #if defined key_nemocice_decomp 478 479 ! Same change to domains in North-South direction as in East-West. 480 DO ji = 1, isplt 481 DO jj=1, jsplt-1 482 ilcjtl(ji,jj) = ijpj 483 END DO 484 ilcjtl(ji,jsplt) = jpjglo - (jsplt - 1) * (ijpj - nrecjl) 485 END DO 486 487 #else 488 457 489 DO ji = 1, isplt 458 490 DO jj = 1, irestjl … … 463 495 END DO 464 496 END DO 465 497 498 #endif 466 499 zidom = nrecil 467 500 DO ji = 1, isplt -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90
r2715 r3116 236 236 END DO 237 237 END DO 238 CASE ( 'J' ) ! first ice U-V point 239 DO jl =0, ipr2dj 240 pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl) 241 DO ji = 3, jpiglo 242 iju = jpiglo - ji + 3 243 pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl) 244 END DO 245 END DO 246 CASE ( 'K' ) ! second ice U-V point 247 DO jl =0, ipr2dj 248 pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl) 249 DO ji = 3, jpiglo 250 iju = jpiglo - ji + 3 251 pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl) 252 END DO 253 END DO 238 254 END SELECT 239 255 ! … … 285 301 END DO 286 302 END DO 303 CASE ( 'J' ) ! first ice U-V point 304 pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0 305 DO jl = 0, ipr2dj 306 DO ji = 2 , jpiglo-1 307 ijt = jpiglo - ji + 2 308 pt2d(ji,ijpj+jl)= pt2d(ji,ijpj-1-jl) 309 END DO 310 END DO 311 CASE ( 'K' ) ! second ice U-V point 312 pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0 313 DO jl = 0, ipr2dj 314 DO ji = 2 , jpiglo-1 315 ijt = jpiglo - ji + 2 316 pt2d(ji,ijpj+jl)= pt2d(ijt,ijpj-1-jl) 317 END DO 318 END DO 287 319 END SELECT 288 320 ! … … 298 330 pt2d(:, 1:1-ipr2dj ) = 0.e0 299 331 pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0 332 CASE ( 'J' ) ! first ice U-V point 333 pt2d(:, 1:1-ipr2dj ) = 0.e0 334 pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0 335 CASE ( 'K' ) ! second ice U-V point 336 pt2d(:, 1:1-ipr2dj ) = 0.e0 337 pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0 300 338 END SELECT 301 339 ! -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r2731 r3116 164 164 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: ztab, znorthloc 165 165 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, SAVE :: znorthgloio 166 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: zfoldwk ! Workspace for message transfers avoiding mpi_allgather 166 167 167 168 ! Arrays used in mpp_lbc_north_2d() 168 169 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: ztab_2d, znorthloc_2d 169 170 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: znorthgloio_2d 171 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: zfoldwk_2d ! Workspace for message transfers avoiding mpi_allgather 170 172 171 173 ! Arrays used in mpp_lbc_north_e() … … 173 175 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: znorthgloio_e 174 176 177 ! North fold arrays used to minimise the use of allgather operations. Set in nemo_northcomms (nemogcm) so need to be public 178 INTEGER, PUBLIC, PARAMETER :: jpmaxngh = 8 ! Assumed maximum number of active neighbours 179 INTEGER, PUBLIC, PARAMETER :: jptyps = 5 ! Number of different neighbour lists to be used for northfold exchanges 180 INTEGER, PUBLIC, DIMENSION (jpmaxngh,jptyps) :: isendto 181 INTEGER, PUBLIC, DIMENSION (jptyps) :: nsndto 182 LOGICAL, PUBLIC :: ln_nnogather = .FALSE. ! namelist control of northfold comms 183 LOGICAL, PUBLIC :: l_north_nogather = .FALSE. ! internal control of northfold comms 184 INTEGER, PUBLIC :: ityp 175 185 !!---------------------------------------------------------------------- 176 186 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 203 213 ! 204 214 & ztab(jpiglo,4,jpk) , znorthloc(jpi,4,jpk) , znorthgloio(jpi,4,jpk,jpni) , & 215 & zfoldwk(jpi,4,jpk) , & 205 216 ! 206 217 & ztab_2d(jpiglo,4) , znorthloc_2d(jpi,4) , znorthgloio_2d(jpi,4,jpni) , & 218 & zfoldwk_2d(jpi,4) , & 207 219 ! 208 220 & ztab_e(jpiglo,4+2*jpr2dj) , znorthloc_e(jpi,4+2*jpr2dj) , znorthgloio_e(jpi,4+2*jpr2dj,jpni) , & … … 232 244 LOGICAL :: mpi_was_called 233 245 ! 234 NAMELIST/nammpp/ cn_mpi_send, nn_buffer, jpni, jpnj, jpnij 246 NAMELIST/nammpp/ cn_mpi_send, nn_buffer, jpni, jpnj, jpnij, ln_nnogather 235 247 !!---------------------------------------------------------------------- 236 248 ! … … 269 281 WRITE(ldtxt(ii),*) ' number of local domains jpnij = ',jpnij; ii = ii +1 270 282 END IF 283 284 WRITE(ldtxt(ii),*) ' avoid use of mpi_allgather at the north fold ln_nnogather = ', ln_nnogather ; ii = ii + 1 271 285 272 286 CALL mpi_initialized ( mpi_was_called, code ) … … 441 455 CASE ( -1 ) 442 456 CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req1 ) 443 CALL mpprecv( 1, t3ew(1,1,1,2), imigr )457 CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea ) 444 458 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 445 459 CASE ( 0 ) 446 460 CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 ) 447 461 CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req2 ) 448 CALL mpprecv( 1, t3ew(1,1,1,2), imigr )449 CALL mpprecv( 2, t3we(1,1,1,2), imigr )462 CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea ) 463 CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe ) 450 464 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 451 465 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 452 466 CASE ( 1 ) 453 467 CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 ) 454 CALL mpprecv( 2, t3we(1,1,1,2), imigr )468 CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe ) 455 469 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 456 470 END SELECT … … 494 508 CASE ( -1 ) 495 509 CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req1 ) 496 CALL mpprecv( 3, t3ns(1,1,1,2), imigr )510 CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono ) 497 511 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 498 512 CASE ( 0 ) 499 513 CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 ) 500 514 CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req2 ) 501 CALL mpprecv( 3, t3ns(1,1,1,2), imigr )502 CALL mpprecv( 4, t3sn(1,1,1,2), imigr )515 CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono ) 516 CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso ) 503 517 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 504 518 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 505 519 CASE ( 1 ) 506 520 CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 ) 507 CALL mpprecv( 4, t3sn(1,1,1,2), imigr )521 CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso ) 508 522 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 509 523 END SELECT … … 635 649 CASE ( -1 ) 636 650 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 ) 637 CALL mpprecv( 1, t2ew(1,1,2), imigr )651 CALL mpprecv( 1, t2ew(1,1,2), imigr, noea ) 638 652 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 639 653 CASE ( 0 ) 640 654 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 ) 641 655 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 ) 642 CALL mpprecv( 1, t2ew(1,1,2), imigr )643 CALL mpprecv( 2, t2we(1,1,2), imigr )656 CALL mpprecv( 1, t2ew(1,1,2), imigr, noea ) 657 CALL mpprecv( 2, t2we(1,1,2), imigr, nowe ) 644 658 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 645 659 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 646 660 CASE ( 1 ) 647 661 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 ) 648 CALL mpprecv( 2, t2we(1,1,2), imigr )662 CALL mpprecv( 2, t2we(1,1,2), imigr, nowe ) 649 663 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 650 664 END SELECT … … 688 702 CASE ( -1 ) 689 703 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 ) 690 CALL mpprecv( 3, t2ns(1,1,2), imigr )704 CALL mpprecv( 3, t2ns(1,1,2), imigr, nono ) 691 705 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 692 706 CASE ( 0 ) 693 707 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 ) 694 708 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 ) 695 CALL mpprecv( 3, t2ns(1,1,2), imigr )696 CALL mpprecv( 4, t2sn(1,1,2), imigr )709 CALL mpprecv( 3, t2ns(1,1,2), imigr, nono ) 710 CALL mpprecv( 4, t2sn(1,1,2), imigr, noso ) 697 711 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 698 712 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 699 713 CASE ( 1 ) 700 714 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 ) 701 CALL mpprecv( 4, t2sn(1,1,2), imigr )715 CALL mpprecv( 4, t2sn(1,1,2), imigr, noso ) 702 716 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 703 717 END SELECT … … 816 830 CASE ( -1 ) 817 831 CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req1 ) 818 CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr )832 CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr, noea ) 819 833 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 820 834 CASE ( 0 ) 821 835 CALL mppsend( 1, t4ew(1,1,1,1,1), imigr, nowe, ml_req1 ) 822 836 CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req2 ) 823 CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr )824 CALL mpprecv( 2, t4we(1,1,1,1,2), imigr )837 CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr, noea ) 838 CALL mpprecv( 2, t4we(1,1,1,1,2), imigr, nowe ) 825 839 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 826 840 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 827 841 CASE ( 1 ) 828 842 CALL mppsend( 1, t4ew(1,1,1,1,1), imigr, nowe, ml_req1 ) 829 CALL mpprecv( 2, t4we(1,1,1,1,2), imigr )843 CALL mpprecv( 2, t4we(1,1,1,1,2), imigr, nowe ) 830 844 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 831 845 END SELECT … … 875 889 CASE ( -1 ) 876 890 CALL mppsend( 4, t4sn(1,1,1,1,1), imigr, nono, ml_req1 ) 877 CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr )891 CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr, nono ) 878 892 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 879 893 CASE ( 0 ) 880 894 CALL mppsend( 3, t4ns(1,1,1,1,1), imigr, noso, ml_req1 ) 881 895 CALL mppsend( 4, t4sn(1,1,1,1,1), imigr, nono, ml_req2 ) 882 CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr )883 CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr )896 CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr, nono ) 897 CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr, noso ) 884 898 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 885 899 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 886 900 CASE ( 1 ) 887 901 CALL mppsend( 3, t4ns(1,1,1,1,1), imigr, noso, ml_req1 ) 888 CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr )902 CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr, noso ) 889 903 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 890 904 END SELECT … … 1019 1033 CASE ( -1 ) 1020 1034 CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req1 ) 1021 CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr )1035 CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr, noea ) 1022 1036 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1023 1037 CASE ( 0 ) 1024 1038 CALL mppsend( 1, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 ) 1025 1039 CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req2 ) 1026 CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr )1027 CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr )1040 CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr, noea ) 1041 CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr, nowe ) 1028 1042 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1029 1043 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 1030 1044 CASE ( 1 ) 1031 1045 CALL mppsend( 1, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 ) 1032 CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr )1046 CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr, nowe ) 1033 1047 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1034 1048 END SELECT … … 1072 1086 CASE ( -1 ) 1073 1087 CALL mppsend( 4, tr2sn(1-jpr2di,1,1), imigr, nono, ml_req1 ) 1074 CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr )1088 CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr, nono ) 1075 1089 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1076 1090 CASE ( 0 ) 1077 1091 CALL mppsend( 3, tr2ns(1-jpr2di,1,1), imigr, noso, ml_req1 ) 1078 1092 CALL mppsend( 4, tr2sn(1-jpr2di,1,1), imigr, nono, ml_req2 ) 1079 CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr )1080 CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr )1093 CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr, nono ) 1094 CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr, noso ) 1081 1095 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1082 1096 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 1083 1097 CASE ( 1 ) 1084 1098 CALL mppsend( 3, tr2ns(1-jpr2di,1,1), imigr, noso, ml_req1 ) 1085 CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr )1099 CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr, noso ) 1086 1100 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1087 1101 END SELECT … … 1138 1152 1139 1153 1140 SUBROUTINE mpprecv( ktyp, pmess, kbytes )1154 SUBROUTINE mpprecv( ktyp, pmess, kbytes, ksource ) 1141 1155 !!---------------------------------------------------------------------- 1142 1156 !! *** routine mpprecv *** … … 1148 1162 INTEGER , INTENT(in ) :: kbytes ! suze of the array pmess 1149 1163 INTEGER , INTENT(in ) :: ktyp ! Tag of the recevied message 1164 INTEGER, OPTIONAL, INTENT(in) :: ksource ! source process number 1150 1165 !! 1151 1166 INTEGER :: istatus(mpi_status_size) 1152 1167 INTEGER :: iflag 1153 !!---------------------------------------------------------------------- 1154 ! 1155 CALL mpi_recv( pmess, kbytes, mpi_double_precision, mpi_any_source, ktyp, mpi_comm_opa, istatus, iflag ) 1168 INTEGER :: use_source 1169 !!---------------------------------------------------------------------- 1170 ! 1171 1172 ! If a specific process number has been passed to the receive call, 1173 ! use that one. Default is to use mpi_any_source 1174 use_source=mpi_any_source 1175 if(present(ksource)) then 1176 use_source=ksource 1177 end if 1178 1179 CALL mpi_recv( pmess, kbytes, mpi_double_precision, use_source, ktyp, mpi_comm_opa, istatus, iflag ) 1156 1180 ! 1157 1181 END SUBROUTINE mpprecv … … 1833 1857 IF( nbondi == -1 ) THEN 1834 1858 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 ) 1835 CALL mpprecv( 1, t2ew(1,1,2), imigr )1859 CALL mpprecv( 1, t2ew(1,1,2), imigr, noea ) 1836 1860 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 1837 1861 ELSEIF( nbondi == 0 ) THEN 1838 1862 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 ) 1839 1863 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 ) 1840 CALL mpprecv( 1, t2ew(1,1,2), imigr )1841 CALL mpprecv( 2, t2we(1,1,2), imigr )1864 CALL mpprecv( 1, t2ew(1,1,2), imigr, noea ) 1865 CALL mpprecv( 2, t2we(1,1,2), imigr, nowe ) 1842 1866 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 1843 1867 IF(l_isend) CALL mpi_wait( ml_req2, ml_stat, ml_err ) 1844 1868 ELSEIF( nbondi == 1 ) THEN 1845 1869 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 ) 1846 CALL mpprecv( 2, t2we(1,1,2), imigr )1870 CALL mpprecv( 2, t2we(1,1,2), imigr, nowe ) 1847 1871 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 1848 1872 ENDIF … … 1879 1903 IF( nbondj == -1 ) THEN 1880 1904 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 ) 1881 CALL mpprecv( 3, t2ns(1,1,2), imigr )1905 CALL mpprecv( 3, t2ns(1,1,2), imigr, nono ) 1882 1906 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 1883 1907 ELSEIF( nbondj == 0 ) THEN 1884 1908 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 ) 1885 1909 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 ) 1886 CALL mpprecv( 3, t2ns(1,1,2), imigr )1887 CALL mpprecv( 4, t2sn(1,1,2), imigr )1910 CALL mpprecv( 3, t2ns(1,1,2), imigr, nono ) 1911 CALL mpprecv( 4, t2sn(1,1,2), imigr, noso ) 1888 1912 IF( l_isend ) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 1889 1913 IF( l_isend ) CALL mpi_wait( ml_req2, ml_stat, ml_err ) 1890 1914 ELSEIF( nbondj == 1 ) THEN 1891 1915 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 ) 1892 CALL mpprecv( 4, t2sn(1,1,2), imigr )1916 CALL mpprecv( 4, t2sn(1,1,2), imigr, noso) 1893 1917 IF( l_isend ) CALL mpi_wait( ml_req1, ml_stat, ml_err ) 1894 1918 ENDIF … … 2209 2233 INTEGER :: ierr, itaille, ildi, ilei, iilb 2210 2234 INTEGER :: ijpj, ijpjm1, ij, iproc 2235 INTEGER, DIMENSION (jpmaxngh) :: ml_req_nf ! for mpi_isend when avoiding mpi_allgather 2236 INTEGER :: ml_err ! for mpi_isend when avoiding mpi_allgather 2237 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for mpi_isend when avoiding mpi_allgather 2211 2238 !!---------------------------------------------------------------------- 2212 2239 ! 2213 2240 ijpj = 4 2241 ityp = -1 2214 2242 ijpjm1 = 3 2215 2243 ztab(:,:,:) = 0.e0 … … 2222 2250 ! ! Build in procs of ncomm_north the znorthgloio 2223 2251 itaille = jpi * jpk * ijpj 2224 CALL MPI_ALLGATHER( znorthloc , itaille, MPI_DOUBLE_PRECISION, & 2225 & znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 2226 ! 2227 ! ! recover the global north array 2228 DO jr = 1, ndim_rank_north 2229 iproc = nrank_north(jr) + 1 2230 ildi = nldit (iproc) 2231 ilei = nleit (iproc) 2232 iilb = nimppt(iproc) 2233 DO jj = 1, 4 2234 DO ji = ildi, ilei 2235 ztab(ji+iilb-1,jj,:) = znorthgloio(ji,jj,:,jr) 2252 IF ( l_north_nogather ) THEN 2253 ! 2254 ! Avoid the use of mpi_allgather by exchanging only with the processes already identified 2255 ! (in nemo_northcomms) as being involved in this process' northern boundary exchange 2256 ! 2257 DO jj = nlcj-ijpj+1, nlcj ! First put local values into the global array 2258 ij = jj - nlcj + ijpj 2259 DO ji = 1, nlci 2260 ztab(ji+nimpp-1,ij,:) = pt3d(ji,jj,:) 2236 2261 END DO 2237 2262 END DO 2238 END DO 2263 2264 ! 2265 ! Set the exchange type in order to access the correct list of active neighbours 2266 ! 2267 SELECT CASE ( cd_type ) 2268 CASE ( 'T' , 'W' ) 2269 ityp = 1 2270 CASE ( 'U' ) 2271 ityp = 2 2272 CASE ( 'V' ) 2273 ityp = 3 2274 CASE ( 'F' ) 2275 ityp = 4 2276 CASE ( 'I' ) 2277 ityp = 5 2278 CASE DEFAULT 2279 ityp = -1 ! Set a default value for unsupported types which 2280 ! will cause a fallback to the mpi_allgather method 2281 END SELECT 2282 IF ( ityp .gt. 0 ) THEN 2283 2284 DO jr = 1,nsndto(ityp) 2285 CALL mppsend(5, znorthloc, itaille, isendto(jr,ityp), ml_req_nf(jr) ) 2286 END DO 2287 DO jr = 1,nsndto(ityp) 2288 CALL mpprecv(5, zfoldwk, itaille, isendto(jr,ityp)) 2289 iproc = isendto(jr,ityp) + 1 2290 ildi = nldit (iproc) 2291 ilei = nleit (iproc) 2292 iilb = nimppt(iproc) 2293 DO jj = 1, ijpj 2294 DO ji = ildi, ilei 2295 ztab(ji+iilb-1,jj,:) = zfoldwk(ji,jj,:) 2296 END DO 2297 END DO 2298 END DO 2299 IF (l_isend) THEN 2300 DO jr = 1,nsndto(ityp) 2301 CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 2302 END DO 2303 ENDIF 2304 2305 ENDIF 2306 2307 ENDIF 2308 2309 IF ( ityp .lt. 0 ) THEN 2310 CALL MPI_ALLGATHER( znorthloc , itaille, MPI_DOUBLE_PRECISION, & 2311 & znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 2312 ! 2313 DO jr = 1, ndim_rank_north ! recover the global north array 2314 iproc = nrank_north(jr) + 1 2315 ildi = nldit (iproc) 2316 ilei = nleit (iproc) 2317 iilb = nimppt(iproc) 2318 DO jj = 1, ijpj 2319 DO ji = ildi, ilei 2320 ztab(ji+iilb-1,jj,:) = znorthgloio(ji,jj,:,jr) 2321 END DO 2322 END DO 2323 END DO 2324 ENDIF 2325 ! 2326 ! The ztab array has been either: 2327 ! a. Fully populated by the mpi_allgather operation or 2328 ! b. Had the active points for this domain and northern neighbours populated 2329 ! by peer to peer exchanges 2330 ! Either way the array may be folded by lbc_nfd and the result for the span of 2331 ! this domain will be identical. 2239 2332 ! 2240 2333 CALL lbc_nfd( ztab, cd_type, psgn ) ! North fold boundary condition … … 2272 2365 INTEGER :: ierr, itaille, ildi, ilei, iilb 2273 2366 INTEGER :: ijpj, ijpjm1, ij, iproc 2367 INTEGER, DIMENSION (jpmaxngh) :: ml_req_nf ! for mpi_isend when avoiding mpi_allgather 2368 INTEGER :: ml_err ! for mpi_isend when avoiding mpi_allgather 2369 INTEGER, DIMENSION(MPI_STATUS_SIZE):: ml_stat ! for mpi_isend when avoiding mpi_allgather 2274 2370 !!---------------------------------------------------------------------- 2275 2371 ! 2276 2372 ijpj = 4 2373 ityp = -1 2277 2374 ijpjm1 = 3 2278 2375 ztab_2d(:,:) = 0.e0 … … 2285 2382 ! ! Build in procs of ncomm_north the znorthgloio_2d 2286 2383 itaille = jpi * ijpj 2287 CALL MPI_ALLGATHER( znorthloc_2d , itaille, MPI_DOUBLE_PRECISION, & 2288 & znorthgloio_2d, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 2289 ! 2290 DO jr = 1, ndim_rank_north ! recover the global north array 2291 iproc = nrank_north(jr) + 1 2292 ildi=nldit (iproc) 2293 ilei=nleit (iproc) 2294 iilb=nimppt(iproc) 2295 DO jj = 1, 4 2296 DO ji = ildi, ilei 2297 ztab_2d(ji+iilb-1,jj) = znorthgloio_2d(ji,jj,jr) 2384 IF ( l_north_nogather ) THEN 2385 ! 2386 ! Avoid the use of mpi_allgather by exchanging only with the processes already identified 2387 ! (in nemo_northcomms) as being involved in this process' northern boundary exchange 2388 ! 2389 DO jj = nlcj-ijpj+1, nlcj ! First put local values into the global array 2390 ij = jj - nlcj + ijpj 2391 DO ji = 1, nlci 2392 ztab_2d(ji+nimpp-1,ij) = pt2d(ji,jj) 2298 2393 END DO 2299 2394 END DO 2300 END DO 2395 2396 ! 2397 ! Set the exchange type in order to access the correct list of active neighbours 2398 ! 2399 SELECT CASE ( cd_type ) 2400 CASE ( 'T' , 'W' ) 2401 ityp = 1 2402 CASE ( 'U' ) 2403 ityp = 2 2404 CASE ( 'V' ) 2405 ityp = 3 2406 CASE ( 'F' ) 2407 ityp = 4 2408 CASE ( 'I' ) 2409 ityp = 5 2410 CASE DEFAULT 2411 ityp = -1 ! Set a default value for unsupported types which 2412 ! will cause a fallback to the mpi_allgather method 2413 END SELECT 2414 2415 IF ( ityp .gt. 0 ) THEN 2416 2417 DO jr = 1,nsndto(ityp) 2418 CALL mppsend(5, znorthloc_2d, itaille, isendto(jr,ityp), ml_req_nf(jr) ) 2419 END DO 2420 DO jr = 1,nsndto(ityp) 2421 CALL mpprecv(5, zfoldwk_2d, itaille, isendto(jr,ityp)) 2422 iproc = isendto(jr,ityp) + 1 2423 ildi = nldit (iproc) 2424 ilei = nleit (iproc) 2425 iilb = nimppt(iproc) 2426 DO jj = 1, ijpj 2427 DO ji = ildi, ilei 2428 ztab_2d(ji+iilb-1,jj) = zfoldwk_2d(ji,jj) 2429 END DO 2430 END DO 2431 END DO 2432 IF (l_isend) THEN 2433 DO jr = 1,nsndto(ityp) 2434 CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 2435 END DO 2436 ENDIF 2437 2438 ENDIF 2439 2440 ENDIF 2441 2442 IF ( ityp .lt. 0 ) THEN 2443 CALL MPI_ALLGATHER( znorthloc_2d , itaille, MPI_DOUBLE_PRECISION, & 2444 & znorthgloio_2d, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 2445 ! 2446 DO jr = 1, ndim_rank_north ! recover the global north array 2447 iproc = nrank_north(jr) + 1 2448 ildi = nldit (iproc) 2449 ilei = nleit (iproc) 2450 iilb = nimppt(iproc) 2451 DO jj = 1, ijpj 2452 DO ji = ildi, ilei 2453 ztab_2d(ji+iilb-1,jj) = znorthgloio_2d(ji,jj,jr) 2454 END DO 2455 END DO 2456 END DO 2457 ENDIF 2458 ! 2459 ! The ztab array has been either: 2460 ! a. Fully populated by the mpi_allgather operation or 2461 ! b. Had the active points for this domain and northern neighbours populated 2462 ! by peer to peer exchanges 2463 ! Either way the array may be folded by lbc_nfd and the result for the span of 2464 ! this domain will be identical. 2301 2465 ! 2302 2466 CALL lbc_nfd( ztab_2d, cd_type, psgn ) ! North fold boundary condition … … 2499 2663 2500 2664 LOGICAL, PUBLIC, PARAMETER :: lk_mpp = .FALSE. !: mpp flag 2665 LOGICAL, PUBLIC :: ln_nnogather = .FALSE. !: namelist control of northfold comms (needed here in case "key_mpp_mpi" is not used) 2501 2666 INTEGER :: ncomm_ice 2502 2667 !!---------------------------------------------------------------------- -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90
r2715 r3116 125 125 !! ! 98-05 (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI versions 126 126 !! 8.5 ! 02-08 (G. Madec) F90 : free form 127 !! 3.4 ! 11-11 (C. Harris) decomposition changes for running with CICE 127 128 !!---------------------------------------------------------------------- 128 129 INTEGER :: ji, jj, jn ! dummy loop indices … … 152 153 153 154 IF( iresti == 0 ) iresti = jpni 155 156 #if defined key_nemocice_decomp 157 ! In order to match CICE the size of domains in NEMO has to be changed 158 ! The last line of blocks (west) will have fewer points 159 160 DO jj = 1, jpnj 161 DO ji=1, jpni-1 162 ilcit(ji,jj) = jpi 163 END DO 164 ilcit(jpni,jj) = jpiglo - (jpni - 1) * (jpi - nreci) 165 END DO 166 167 #else 168 154 169 DO jj = 1, jpnj 155 170 DO ji = 1, iresti … … 161 176 END DO 162 177 178 #endif 163 179 IF( irestj == 0 ) irestj = jpnj 180 181 #if defined key_nemocice_decomp 182 ! Same change to domains in North-South direction as in East-West. 183 DO ji=1,jpni 184 DO jj=1,jpnj-1 185 ilcjt(ji,jj) = jpj 186 END DO 187 ilcjt(ji,jpnj) = jpjglo - (jpnj - 1) * (jpj - nrecj) 188 END DO 189 190 #else 191 164 192 DO ji = 1, jpni 165 193 DO jj = 1, irestj … … 171 199 END DO 172 200 201 #endif 173 202 IF(lwp) THEN 174 203 WRITE(numout,*) -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
r2977 r3116 46 46 ! !! Griffies operator 47 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wslp2 !: wslp**2 from Griffies quarter cells 48 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) :: triadi_g, triadj_g !: skew flux slopes relative to geopotentials 48 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) :: triadi_g, triadj_g !: skew flux slopes relative to geopotentials 49 49 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) :: triadi , triadj !: isoneutral slopes relative to model-coordinate 50 50 … … 58 58 59 59 ! Workspace arrays for ldf_slp_grif. These could be replaced by several 3D and 2D workspace 60 ! arrays from the wrk_nemo module with a bit of code re-writing. The 4D workspace 60 ! arrays from the wrk_nemo module with a bit of code re-writing. The 4D workspace 61 61 ! arrays can't be used here because of the zero-indexing of some of the ranks. ARPDBG. 62 62 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: zdzrho , zdyrho, zdxrho ! Horizontal and vertical density gradients … … 93 93 !!---------------------------------------------------------------------- 94 94 !! *** ROUTINE ldf_slp *** 95 !! 95 !! 96 96 !! ** Purpose : Compute the slopes of neutral surface (slope of isopycnal 97 97 !! surfaces referenced locally) (ln_traldf_iso=T). 98 !! 99 !! ** Method : The slope in the i-direction is computed at U- and 100 !! W-points (uslp, wslpi) and the slope in the j-direction is 98 !! 99 !! ** Method : The slope in the i-direction is computed at U- and 100 !! W-points (uslp, wslpi) and the slope in the j-direction is 101 101 !! computed at V- and W-points (vslp, wslpj). 102 102 !! They are bounded by 1/100 over the whole ocean, and within the … … 112 112 !! bottom slope (ln_sco=T) at level jpk in inildf] 113 113 !! 114 !! ** Action : - uslp, wslpi, and vslp, wslpj, the i- and j-slopes 114 !! ** Action : - uslp, wslpi, and vslp, wslpj, the i- and j-slopes 115 115 !! of now neutral surfaces at u-, w- and v- w-points, resp. 116 116 !!---------------------------------------------------------------------- … … 127 127 INTEGER :: ii0, ii1, iku ! temporary integer 128 128 INTEGER :: ij0, ij1, ikv ! temporary integer 129 REAL(wp) :: zeps, zm1_g, zm1_2g, z1_16 129 REAL(wp) :: zeps, zm1_g, zm1_2g, z1_16, zcofw ! local scalars 130 130 REAL(wp) :: zci, zfi, zau, zbu, zai, zbi ! - - 131 131 REAL(wp) :: zcj, zfj, zav, zbv, zaj, zbj ! - - … … 152 152 DO jj = 1, jpjm1 153 153 DO ji = 1, fs_jpim1 ! vector opt. 154 zgru(ji,jj,jk) = umask(ji,jj,jk) * ( prd(ji+1,jj ,jk) - prd(ji,jj,jk) ) 155 zgrv(ji,jj,jk) = vmask(ji,jj,jk) * ( prd(ji ,jj+1,jk) - prd(ji,jj,jk) ) 154 zgru(ji,jj,jk) = umask(ji,jj,jk) * ( prd(ji+1,jj ,jk) - prd(ji,jj,jk) ) 155 zgrv(ji,jj,jk) = vmask(ji,jj,jk) * ( prd(ji ,jj+1,jk) - prd(ji,jj,jk) ) 156 156 END DO 157 157 END DO 158 158 END DO 159 159 IF( ln_zps ) THEN ! partial steps correction at the bottom ocean level 160 # if defined key_vectopt_loop 160 # if defined key_vectopt_loop 161 161 DO jj = 1, 1 162 162 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) … … 165 165 DO ji = 1, jpim1 166 166 # endif 167 zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj) 168 zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj) 167 zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj) 168 zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj) 169 169 END DO 170 170 END DO … … 185 185 CALL ldf_slp_mxl( prd, pn2, zgru, zgrv, zdzr ) ! output: uslpml, vslpml, wslpiml, wslpjml 186 186 187 187 188 188 ! I. slopes at u and v point | uslp = d/di( prd ) / d/dz( prd ) 189 189 ! =========================== | vslp = d/dj( prd ) / d/dz( prd ) 190 ! 190 ! 191 191 DO jk = 2, jpkm1 !* Slopes at u and v points 192 192 DO jj = 2, jpjm1 … … 229 229 DO jk = 2, jpkm1 230 230 DO jj = 2, jpjm1, MAX(1, jpj-3) ! rows jj=2 and =jpjm1 only 231 DO ji = 2, jpim1 231 DO ji = 2, jpim1 232 232 uslp(ji,jj,jk) = z1_16 * ( zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk) & 233 233 & + zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk) & … … 270 270 ! II. slopes at w point | wslpi = mij( d/di( prd ) / d/dz( prd ) 271 271 ! =========================== | wslpj = mij( d/dj( prd ) / d/dz( prd ) 272 ! 272 ! 273 273 DO jk = 2, jpkm1 274 274 DO jj = 2, jpjm1 … … 312 312 DO jj = 2, jpjm1, MAX(1, jpj-3) ! rows jj=2 and =jpjm1 only 313 313 DO ji = 2, jpim1 314 zcofw = tmask(ji,jj,jk) * z1_16 314 315 wslpi(ji,jj,jk) = ( zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk) & 315 & + zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk) &316 & + 2.*( zwz(ji ,jj-1,jk) + zwz(ji-1,jj ,jk) &317 & + zwz(ji+1,jj ,jk) + zwz(ji ,jj+1,jk) ) &318 & + 4.* zwz(ji ,jj ,jk) ) * z1_16 * tmask(ji,jj,jk)316 & + zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk) & 317 & + 2.*( zwz(ji ,jj-1,jk) + zwz(ji-1,jj ,jk) & 318 & + zwz(ji+1,jj ,jk) + zwz(ji ,jj+1,jk) ) & 319 & + 4.* zwz(ji ,jj ,jk) ) * zcofw 319 320 320 321 wslpj(ji,jj,jk) = ( zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk) & 321 & + zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk) &322 & + 2.*( zww(ji ,jj-1,jk) + zww(ji-1,jj ,jk) &323 & + zww(ji+1,jj ,jk) + zww(ji ,jj+1,jk) ) &324 & + 4.* zww(ji ,jj ,jk) ) * z1_16 * tmask(ji,jj,jk)325 END DO 326 END DO 322 & + zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk) & 323 & + 2.*( zww(ji ,jj-1,jk) + zww(ji-1,jj ,jk) & 324 & + zww(ji+1,jj ,jk) + zww(ji ,jj+1,jk) ) & 325 & + 4.* zww(ji ,jj ,jk) ) * zcofw 326 END DO 327 END DO 327 328 DO jj = 3, jpj-2 ! other rows 328 329 DO ji = fs_2, fs_jpim1 ! vector opt. 330 zcofw = tmask(ji,jj,jk) * z1_16 329 331 wslpi(ji,jj,jk) = ( zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk) & 330 & + zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk) &331 & + 2.*( zwz(ji ,jj-1,jk) + zwz(ji-1,jj ,jk) &332 & + zwz(ji+1,jj ,jk) + zwz(ji ,jj+1,jk) ) &333 & + 4.* zwz(ji ,jj ,jk) ) * z1_16 * tmask(ji,jj,jk)332 & + zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk) & 333 & + 2.*( zwz(ji ,jj-1,jk) + zwz(ji-1,jj ,jk) & 334 & + zwz(ji+1,jj ,jk) + zwz(ji ,jj+1,jk) ) & 335 & + 4.* zwz(ji ,jj ,jk) ) * zcofw 334 336 335 337 wslpj(ji,jj,jk) = ( zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk) & 336 & + zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk) &337 & + 2.*( zww(ji ,jj-1,jk) + zww(ji-1,jj ,jk) &338 & + zww(ji+1,jj ,jk) + zww(ji ,jj+1,jk) ) &339 & + 4.* zww(ji ,jj ,jk) ) * z1_16 * tmask(ji,jj,jk)338 & + zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk) & 339 & + 2.*( zww(ji ,jj-1,jk) + zww(ji-1,jj ,jk) & 340 & + zww(ji+1,jj ,jk) + zww(ji ,jj+1,jk) ) & 341 & + 4.* zww(ji ,jj ,jk) ) * zcofw 340 342 END DO 341 343 END DO … … 350 352 END DO 351 353 END DO 352 353 ! III. Specific grid points 354 ! =========================== 355 ! 354 355 ! III. Specific grid points 356 ! =========================== 357 ! 356 358 IF( cp_cfg == "orca" .AND. jp_cfg == 4 ) THEN ! ORCA_R4 configuration: horizontal diffusion in specific area 357 359 ! ! Gibraltar Strait … … 372 374 ENDIF 373 375 374 ! IV. Lateral boundary conditions 376 377 ! IV. Lateral boundary conditions 375 378 ! =============================== 376 379 CALL lbc_lnk( uslp , 'U', -1. ) ; CALL lbc_lnk( vslp , 'V', -1. ) … … 386 389 ! 387 390 END SUBROUTINE ldf_slp 388 391 389 392 390 393 SUBROUTINE ldf_slp_grif ( kt ) … … 394 397 !! ** Purpose : Compute the squared slopes of neutral surfaces (slope 395 398 !! of iso-pycnal surfaces referenced locally) (ln_traldf_grif=T) 396 !! at W-points using the Griffies quarter-cells. 397 !! 398 !! ** Method : calculates alpha and beta at T-points 399 !! at W-points using the Griffies quarter-cells. 400 !! 401 !! ** Method : calculates alpha and beta at T-points 399 402 !! 400 403 !! ** Action : - triadi_g, triadj_g T-pts i- and j-slope triads relative to geopot. (used for eiv) … … 403 406 !!---------------------------------------------------------------------- 404 407 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 408 USE oce , ONLY: zalbet => ua ! use ua as workspace 405 409 USE wrk_nemo, ONLY: z1_mlbw => wrk_2d_1 406 USE wrk_nemo, ONLY: zalpha => wrk_3d_2 , zbeta => wrk_3d_3 ! alpha, beta at T points, at depth fsgdept 407 USE wrk_nemo, ONLY: zdits => wrk_4d_1 , zdjts => wrk_4d_2, zdkts => wrk_4d_3 ! 4D workspace 408 !! 409 INTEGER, INTENT( in ) :: kt ! ocean time-step index 410 !! 411 INTEGER :: ji, jj, jk, jn, jl, ip, jp, kp ! dummy loop indices 412 INTEGER :: iku, ikv ! local integer 413 REAL(wp) :: zfacti, zfactj, zatempw,zatempu,zatempv ! local scalars 414 REAL(wp) :: zbu, zbv, zbti, zbtj ! - - 415 REAL(wp) :: zdxrho_raw, zti_coord, zti_raw, zti_lim, zti_lim2, zti_g_raw, zti_g_lim 416 REAL(wp) :: zdyrho_raw, ztj_coord, ztj_raw, ztj_lim, ztj_lim2, ztj_g_raw, ztj_g_lim 410 !! 411 INTEGER, INTENT( in ) :: kt ! ocean time-step index 412 !! 413 INTEGER :: ji, jj, jk, jl, ip, jp, kp ! dummy loop indices 414 INTEGER :: iku, ikv ! local integer 415 REAL(wp) :: zfacti, zfactj ! local scalars 416 REAL(wp) :: znot_thru_surface ! local scalars 417 REAL(wp) :: zdit, zdis, zdjt, zdjs, zdkt, zdks, zbu, zbv, zbti, zbtj 418 REAL(wp) :: zdxrho_raw, zti_coord, zti_raw, zti_lim, zti_g_raw, zti_g_lim 419 REAL(wp) :: zdyrho_raw, ztj_coord, ztj_raw, ztj_lim, ztj_g_raw, ztj_g_lim 417 420 REAL(wp) :: zdzrho_raw 421 REAL(wp) :: zbeta0 418 422 !!---------------------------------------------------------------------- 419 423 … … 426 430 !--------------------------------! 427 431 ! 428 CALL eos_alpbet( tsb, zalpha, zbeta ) !== before thermal and haline expension coeff. at T-points ==! 429 ! 430 DO jn = 1, jpts 431 DO jk = 1, jpkm1 !== before lateral T & S gradients at T-level jk ==! 432 DO jj = 1, jpjm1 433 DO ji = 1, fs_jpim1 ! vector opt. 434 zdits(ji,jj,jk,jn) = ( tsb(ji+1,jj,jk,jn) - tsb(ji,jj,jk,jn) ) * umask(ji,jj,jk) ! i-gradient of T and S at jj 435 zdjts(ji,jj,jk,jn) = ( tsb(ji,jj+1,jk,jn) - tsb(ji,jj,jk,jn) ) * vmask(ji,jj,jk) ! j-gradient of T and S at jj 432 CALL eos_alpbet( tsb, zalbet, zbeta0 ) !== before local thermal/haline expension ratio at T-points ==! 433 ! 434 DO jl = 0, 1 !== unmasked before density i- j-, k-gradients ==! 435 ! 436 ip = jl ; jp = jl ! guaranteed nonzero gradients ( absolute value larger than repsln) 437 DO jk = 1, jpkm1 ! done each pair of triad 438 DO jj = 1, jpjm1 ! NB: not masked ==> a minimum value is set 439 DO ji = 1, fs_jpim1 ! vector opt. 440 zdit = ( tsb(ji+1,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) ! i-gradient of T & S at u-point 441 zdis = ( tsb(ji+1,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 442 zdjt = ( tsb(ji,jj+1,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) ! j-gradient of T & S at v-point 443 zdjs = ( tsb(ji,jj+1,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 444 zdxrho_raw = ( - zalbet(ji+ip,jj ,jk) * zdit + zbeta0*zdis ) / e1u(ji,jj) 445 zdyrho_raw = ( - zalbet(ji ,jj+jp,jk) * zdjt + zbeta0*zdjs ) / e2v(ji,jj) 446 zdxrho(ji+ip,jj ,jk,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw ) ! keep the sign 447 zdyrho(ji ,jj+jp,jk,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw ) 436 448 END DO 437 449 END DO 438 450 END DO 439 IF( ln_zps ) THEN ! partial steps: correction at the last level 451 ! 452 IF( ln_zps.and.l_grad_zps ) THEN ! partial steps: correction of i- & j-grad on bottom 440 453 # if defined key_vectopt_loop 441 454 DO jj = 1, 1 442 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling)455 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 443 456 # else 444 457 DO jj = 1, jpjm1 445 458 DO ji = 1, jpim1 446 459 # endif 447 zdits(ji,jj,mbku(ji,jj),jn) = gtsu(ji,jj,jn) ! i-gradient of T and S 448 zdjts(ji,jj,mbkv(ji,jj),jn) = gtsv(ji,jj,jn) ! j-gradient of T and S 460 iku = mbku(ji,jj) ; ikv = mbkv(ji,jj) ! last ocean level (u- & v-points) 461 zdit = gtsu(ji,jj,jp_tem) ; zdjt = gtsv(ji,jj,jp_tem) ! i- & j-gradient of Temperature 462 zdis = gtsu(ji,jj,jp_sal) ; zdjs = gtsv(ji,jj,jp_sal) ! i- & j-gradient of Salinity 463 zdxrho_raw = ( - zalbet(ji+ip,jj ,iku) * zdit + zbeta0*zdis ) / e1u(ji,jj) 464 zdyrho_raw = ( - zalbet(ji ,jj+jp,ikv) * zdjt + zbeta0*zdjs ) / e2v(ji,jj) 465 zdxrho(ji+ip,jj ,iku,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw ) ! keep the sign 466 zdyrho(ji ,jj+jp,ikv,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw ) 449 467 END DO 450 468 END DO 451 469 ENDIF 452 470 ! 453 zdkts(:,:,1,jn) = 0._wp !== before vertical T & S gradient at w-level ==! 454 DO jk = 2, jpk 455 zdkts(:,:,jk,jn) = ( tsb(:,:,jk-1,jn) - tsb(:,:,jk,jn) ) * tmask(:,:,jk) 456 END DO 457 ! 458 END DO 459 ! 460 DO jl = 0, 1 !== density i-, j-, and k-gradients ==! 461 ip = jl ; jp = jl ! guaranteed nonzero gradients ( absolute value larger than repsln) 462 DO jk = 1, jpkm1 ! done each pair of triad 463 DO jj = 1, jpjm1 ! NB: not masked due to the minimum value set 464 DO ji = 1, fs_jpim1 ! vector opt. 465 zdxrho_raw = ( zalpha(ji+ip,jj ,jk) * zdits(ji,jj,jk,jp_tem) + zbeta(ji+ip,jj ,jk) * zdits(ji,jj,jk,jp_sal) ) / e1u(ji,jj) 466 zdyrho_raw = ( zalpha(ji ,jj+jp,jk) * zdjts(ji,jj,jk,jp_tem) + zbeta(ji ,jj+jp,jk) * zdjts(ji,jj,jk,jp_sal) ) / e2v(ji,jj) 467 zdxrho(ji+ip,jj ,jk,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw ) ! keep the sign 468 zdyrho(ji ,jj+jp,jk,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw ) 469 END DO 470 END DO 471 END DO 472 END DO 473 DO kp = 0, 1 !== density i-, j-, and k-gradients ==! 474 DO jk = 1, jpkm1 ! done each pair of triad 475 DO jj = 1, jpj ! NB: not masked due to the minimum value set 476 DO ji = 1, jpi ! vector opt. 477 zdzrho_raw = ( zalpha(ji,jj,jk) * zdkts(ji,jj,jk+kp,jp_tem) + zbeta(ji,jj,jk) * zdkts(ji,jj,jk+kp,jp_sal) ) & 478 & / fse3w(ji,jj,jk+kp) 479 zdzrho(ji ,jj ,jk, kp) = - MIN( - repsln, zdzrho_raw ) ! force zdzrho >= repsln 480 END DO 481 END DO 482 END DO 483 END DO 484 ! 485 DO jj = 1, jpj !== Reciprocal depth of the w-point below ML base ==! 471 END DO 472 473 DO kp = 0, 1 !== unmasked before density i- j-, k-gradients ==! 474 DO jk = 1, jpkm1 ! done each pair of triad 475 DO jj = 1, jpj ! NB: not masked ==> a minimum value is set 476 DO ji = 1, jpi ! vector opt. 477 IF( jk+kp > 1 ) THEN ! k-gradient of T & S a jk+kp 478 zdkt = ( tsb(ji,jj,jk+kp-1,jp_tem) - tsb(ji,jj,jk+kp,jp_tem) ) 479 zdks = ( tsb(ji,jj,jk+kp-1,jp_sal) - tsb(ji,jj,jk+kp,jp_sal) ) 480 ELSE 481 zdkt = 0._wp ! 1st level gradient set to zero 482 zdks = 0._wp 483 ENDIF 484 zdzrho_raw = ( - zalbet(ji ,jj ,jk) * zdkt + zbeta0*zdks ) / fse3w(ji,jj,jk+kp) 485 zdzrho(ji ,jj ,jk, kp) = - MIN( - repsln, zdzrho_raw ) ! force zdzrho >= repsln 486 END DO 487 END DO 488 END DO 489 END DO 490 ! 491 DO jj = 1, jpj !== Reciprocal depth of the w-point below ML base ==! 486 492 DO ji = 1, jpi 487 493 jk = MIN( nmln(ji,jj), mbkt(ji,jj) ) + 1 ! MIN in case ML depth is the ocean depth … … 490 496 END DO 491 497 ! 492 ! !== intialisations to zero ==!493 ! 494 wslp2 (:,:,:) = 0._wp 495 triadi_g(:,:,1,:,:) = 0._wp ; triadi_g(:,:,jpk,:,:) = 0._wp 498 ! !== intialisations to zero ==! 499 ! 500 wslp2 (:,:,:) = 0._wp ! wslp2 will be cumulated 3D field set to zero 501 triadi_g(:,:,1,:,:) = 0._wp ; triadi_g(:,:,jpk,:,:) = 0._wp ! set surface and bottom slope to zero 496 502 triadj_g(:,:,1,:,:) = 0._wp ; triadj_g(:,:,jpk,:,:) = 0._wp 497 !!gm _iso set to zero missing498 triadi (:,:,1,:,:) = 0._wp ; triadj (:,:,jpk,:,:) = 0._wp! set surface and bottom slope to zero499 triadj (:,:,1,:,:) = 0._wp ; triadj(:,:,jpk,:,:) = 0._wp500 503 !!gm _iso set to zero missing 504 triadi (:,:,1,:,:) = 0._wp ; triadj (:,:,jpk,:,:) = 0._wp ! set surface and bottom slope to zero 505 triadj (:,:,1,:,:) = 0._wp ; triadj (:,:,jpk,:,:) = 0._wp 506 501 507 !-------------------------------------! 502 508 ! Triads just below the Mixed Layer ! 503 509 !-------------------------------------! 504 510 ! 505 DO jl = 0, 1 ! calculate slope of the 4 triads immediately ONE level below mixed-layer base506 DO kp = 0, 1 ! with only the slope-max limit and MASKED511 DO jl = 0, 1 ! calculate slope of the 4 triads immediately ONE level below mixed-layer base 512 DO kp = 0, 1 ! with only the slope-max limit and MASKED 507 513 DO jj = 1, jpjm1 508 514 DO ji = 1, fs_jpim1 509 515 ip = jl ; jp = jl 510 516 jk = MIN( nmln(ji+ip,jj) , mbkt(ji+ip,jj) ) + 1 ! ML level+1 (MIN in case ML depth is the ocean depth) 517 ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth) 511 518 zti_g_raw = ( zdxrho(ji+ip,jj,jk-kp,1-ip) / zdzrho(ji+ip,jj,jk-kp,kp) & 512 & +( fsdept(ji+1,jj,jk-kp) - fsdept(ji,jj,jk-kp) ) / e1u(ji,jj) ) * umask(ji,jj,jk)519 & - ( fsdept(ji+1,jj,jk-kp) - fsdept(ji,jj,jk-kp) ) / e1u(ji,jj) ) * umask(ji,jj,jk) 513 520 jk = MIN( nmln(ji,jj+jp) , mbkt(ji,jj+jp) ) + 1 514 521 ztj_g_raw = ( zdyrho(ji,jj+jp,jk-kp,1-jp) / zdzrho(ji,jj+jp,jk-kp,kp) & 515 & +( fsdept(ji,jj+1,jk-kp) - fsdept(ji,jj,jk-kp) ) / e2v(ji,jj) ) * vmask(ji,jj,jk)522 & - ( fsdept(ji,jj+1,jk-kp) - fsdept(ji,jj,jk-kp) ) / e2v(ji,jj) ) * vmask(ji,jj,jk) 516 523 zti_mlb(ji+ip,jj ,1-ip,kp) = SIGN( MIN( rn_slpmax, ABS( zti_g_raw ) ), zti_g_raw ) 517 524 ztj_mlb(ji ,jj+jp,1-jp,kp) = SIGN( MIN( rn_slpmax, ABS( ztj_g_raw ) ), ztj_g_raw ) … … 525 532 !-------------------------------------! 526 533 ! 527 DO kp = 0, 1 ! k-index of triads534 DO kp = 0, 1 ! k-index of triads 528 535 DO jl = 0, 1 529 ip = jl ; jp = jl ! i- and j-indices of triads (i-k and j-k planes)536 ip = jl ; jp = jl ! i- and j-indices of triads (i-k and j-k planes) 530 537 DO jk = 1, jpkm1 538 ! Must mask contribution to slope from dz/dx at constant s for triads jk=1,kp=0 that poke up though ocean surface 539 znot_thru_surface = REAL( 1-1/(jk+kp), wp ) !jk+kp=1,=0.; otherwise=1.0 531 540 DO jj = 1, jpjm1 532 DO ji = 1, fs_jpim1 ! vector opt.541 DO ji = 1, fs_jpim1 ! vector opt. 533 542 ! 534 543 ! Calculate slope relative to geopotentials used for GM skew fluxes 535 ! For s-coordinate, subtract slope at t-points (equivalent to *adding* gradient of depth)544 ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth) 536 545 ! Limit by slope *relative to geopotentials* by rn_slpmax, and mask by psi-point 537 546 ! masked by umask taken at the level of dz(rho) … … 541 550 zti_raw = zdxrho(ji+ip,jj ,jk,1-ip) / zdzrho(ji+ip,jj ,jk,kp) ! unmasked 542 551 ztj_raw = zdyrho(ji ,jj+jp,jk,1-jp) / zdzrho(ji ,jj+jp,jk,kp) 543 zti_coord = ( fsdept(ji+1,jj ,jk) - fsdept(ji,jj,jk) ) / e1u(ji,jj) 544 ztj_coord = ( fsdept(ji ,jj+1,jk) - fsdept(ji,jj,jk) ) / e2v(ji,jj) 545 ! unmasked 546 zti_g_raw = zti_raw + zti_coord ! ref to geopot surfaces 547 ztj_g_raw = ztj_raw + ztj_coord 552 553 ! Must mask contribution to slope for triad jk=1,kp=0 that poke up though ocean surface 554 zti_coord = znot_thru_surface * ( fsdept(ji+1,jj ,jk) - fsdept(ji,jj,jk) ) / e1u(ji,jj) 555 ztj_coord = znot_thru_surface * ( fsdept(ji ,jj+1,jk) - fsdept(ji,jj,jk) ) / e2v(ji,jj) ! unmasked 556 zti_g_raw = zti_raw - zti_coord ! ref to geopot surfaces 557 ztj_g_raw = ztj_raw - ztj_coord 548 558 zti_g_lim = SIGN( MIN( rn_slpmax, ABS( zti_g_raw ) ), zti_g_raw ) 549 559 ztj_g_lim = SIGN( MIN( rn_slpmax, ABS( ztj_g_raw ) ), ztj_g_raw ) 550 560 ! 551 ! Below ML use limited zti_g as is 552 ! Inside ML replace by linearly reducing sx_mlb towards surface 561 ! Below ML use limited zti_g as is & mask 562 ! Inside ML replace by linearly reducing sx_mlb towards surface & mask 553 563 ! 554 564 zfacti = REAL( 1 - 1/(1 + (jk+kp-1)/nmln(ji+ip,jj)), wp ) ! k index of uppermost point(s) of triad is jk+kp-1 555 565 zfactj = REAL( 1 - 1/(1 + (jk+kp-1)/nmln(ji,jj+jp)), wp ) ! must be .ge. nmln(ji,jj) for zfact=1 556 566 ! ! otherwise zfact=0 557 zti_g_lim = zfacti * zti_g_lim &567 zti_g_lim = ( zfacti * zti_g_lim & 558 568 & + ( 1._wp - zfacti ) * zti_mlb(ji+ip,jj,1-ip,kp) & 559 & * fsdepw(ji+ip,jj,jk+kp) * z1_mlbw(ji+ip,jj) 560 ztj_g_lim = zfactj * ztj_g_lim &569 & * fsdepw(ji+ip,jj,jk+kp) * z1_mlbw(ji+ip,jj) ) * umask(ji,jj,jk+kp) 570 ztj_g_lim = ( zfactj * ztj_g_lim & 561 571 & + ( 1._wp - zfactj ) * ztj_mlb(ji,jj+jp,1-jp,kp) & 562 & * fsdepw(ji,jj+jp,jk+kp) * z1_mlbw(ji,jj+jp) ! masked563 ! 564 triadi_g(ji+ip,jj ,jk,1-ip,kp) = zti_g_lim * umask(ji,jj,jk+kp)565 triadj_g(ji ,jj+jp,jk,1-jp,kp) = ztj_g_lim * vmask(ji,jj,jk+kp)572 & * fsdepw(ji,jj+jp,jk+kp) * z1_mlbw(ji,jj+jp) ) * vmask(ji,jj,jk+kp) 573 ! 574 triadi_g(ji+ip,jj ,jk,1-ip,kp) = zti_g_lim 575 triadj_g(ji ,jj+jp,jk,1-jp,kp) = ztj_g_lim 566 576 ! 567 577 ! Get coefficients of isoneutral diffusion tensor … … 572 582 ! Equivalent to tapering A_iso = sx_limited**2/(real slope)**2 573 583 ! 574 zti_lim = zti_g_lim - zti_coord ! remove the coordinate slope ==> relative to coordinate surfaces 575 ztj_lim = ztj_g_lim - ztj_coord 576 zti_lim2 = zti_lim * zti_lim * umask(ji,jj,jk+kp) ! square of limited slopes ! masked <<== 577 ztj_lim2 = ztj_lim * ztj_lim * vmask(ji,jj,jk+kp) 578 ! 584 zti_lim = ( zti_g_lim + zti_coord ) * umask(ji,jj,jk+kp) ! remove coordinate slope => relative to coordinate surfaces 585 ztj_lim = ( ztj_g_lim + ztj_coord ) * vmask(ji,jj,jk+kp) 586 ! 587 IF( ln_triad_iso ) THEN 588 zti_raw = ( zti_lim*zti_lim ) / zti_raw 589 ztj_raw = ( ztj_lim*ztj_lim ) / ztj_raw 590 zti_raw = SIGN( MIN( ABS(zti_lim), ABS( zti_raw ) ), zti_raw ) 591 ztj_raw = SIGN( MIN( ABS(ztj_lim), ABS( ztj_raw ) ), ztj_raw ) 592 zti_lim = zfacti * zti_lim & 593 & + ( 1._wp - zfacti ) * zti_raw 594 ztj_lim = zfactj * ztj_lim & 595 & + ( 1._wp - zfactj ) * ztj_raw 596 ENDIF 597 triadi(ji+ip,jj ,jk,1-ip,kp) = zti_lim 598 triadj(ji ,jj+jp,jk,1-jp,kp) = ztj_lim 599 ! 579 600 zbu = e1u(ji ,jj) * e2u(ji ,jj) * fse3u(ji ,jj,jk ) 580 601 zbv = e1v(ji ,jj) * e2v(ji ,jj) * fse3v(ji ,jj,jk ) … … 582 603 zbtj = e1t(ji,jj+jp) * e2t(ji,jj+jp) * fse3w(ji,jj+jp,jk+kp) 583 604 ! 584 triadi(ji+ip,jj ,jk,1-ip,kp) = zti_lim2 / zti_raw ! masked 585 triadj(ji ,jj+jp,jk,1-jp,kp) = ztj_lim2 / ztj_raw 586 ! 587 !!gm this may inhibit vectorization on Vect Computers, and even on scalar computers.... ==> to be checked 588 wslp2 (ji+ip,jj,jk+kp) = wslp2(ji+ip,jj,jk+kp) + 0.25_wp * zbu / zbti * zti_lim2 ! masked 589 wslp2 (ji,jj+jp,jk+kp) = wslp2(ji,jj+jp,jk+kp) + 0.25_wp * zbv / zbtj * ztj_lim2 605 !!gm this may inhibit vectorization on Vect Computers, and even on scalar computers.... ==> to be checked 606 wslp2 (ji+ip,jj,jk+kp) = wslp2(ji+ip,jj,jk+kp) + 0.25_wp * zbu / zbti * ( zti_g_lim * zti_g_lim ) ! masked 607 wslp2 (ji,jj+jp,jk+kp) = wslp2(ji,jj+jp,jk+kp) + 0.25_wp * zbv / zbtj * ( ztj_g_lim * ztj_g_lim ) 590 608 END DO 591 609 END DO … … 595 613 ! 596 614 wslp2(:,:,1) = 0._wp ! force the surface wslp to zero 597 615 598 616 CALL lbc_lnk( wslp2, 'W', 1. ) ! lateral boundary confition on wslp2 only ==>>> gm : necessary ? to be checked 599 617 ! … … 609 627 !! *** ROUTINE ldf_slp_mxl *** 610 628 !! 611 !! ** Purpose : Compute the slopes of iso-neutral surface just below 629 !! ** Purpose : Compute the slopes of iso-neutral surface just below 612 630 !! the mixed layer. 613 631 !! … … 618 636 !! 619 637 !! ** Action : uslpml, wslpiml : i- & j-slopes of neutral surfaces 620 !! vslpml, wslpjml just below the mixed layer 638 !! vslpml, wslpjml just below the mixed layer 621 639 !! omlmask : mixed layer mask 622 640 !!---------------------------------------------------------------------- … … 626 644 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: p_dzr ! z-gradient of density (T-point) 627 645 !! 628 INTEGER :: ji , jj , jk ! dummy loop indices629 INTEGER :: iku, ikv, ik, ikm1 ! local integers646 INTEGER :: ji , jj , jk ! dummy loop indices 647 INTEGER :: iku, ikv, ik, ikm1 ! local integers 630 648 REAL(wp) :: zeps, zm1_g, zm1_2g ! local scalars 631 649 REAL(wp) :: zci, zfi, zau, zbu, zai, zbi ! - - … … 643 661 wslpjml(1,:) = 0._wp ; wslpjml(jpi,:) = 0._wp 644 662 ! 645 ! !== surface mixed layer mask !646 DO jk = 1, jpk ! =1 inside the mixed layer, =0 otherwise663 ! !== surface mixed layer mask ! 664 DO jk = 1, jpk ! =1 inside the mixed layer, =0 otherwise 647 665 # if defined key_vectopt_loop 648 666 DO jj = 1, 1 649 DO ji = 1, jpij ! vector opt. (forced unrolling)667 DO ji = 1, jpij ! vector opt. (forced unrolling) 650 668 # else 651 669 DO jj = 1, jpj … … 678 696 DO ji = 2, jpim1 679 697 # endif 680 ! !== Slope at u- & v-points just below the Mixed Layer ==!698 ! !== Slope at u- & v-points just below the Mixed Layer ==! 681 699 ! 682 ! 700 ! !- vertical density gradient for u- and v-slopes (from dzr at T-point) 683 701 iku = MIN( MAX( 1, nmln(ji,jj) , nmln(ji+1,jj) ) , jpkm1 ) ! ML (MAX of T-pts, bound by jpkm1) 684 ikv = MIN( MAX( 1, nmln(ji,jj) , nmln(ji,jj+1) ) , jpkm1 ) ! 702 ikv = MIN( MAX( 1, nmln(ji,jj) , nmln(ji,jj+1) ) , jpkm1 ) ! 685 703 zbu = 0.5_wp * ( p_dzr(ji,jj,iku) + p_dzr(ji+1,jj ,iku) ) 686 704 zbv = 0.5_wp * ( p_dzr(ji,jj,ikv) + p_dzr(ji ,jj+1,ikv) ) 687 ! 705 ! !- horizontal density gradient at u- & v-points 688 706 zau = p_gru(ji,jj,iku) / e1u(ji,jj) 689 707 zav = p_grv(ji,jj,ikv) / e2v(ji,jj) 690 ! 691 ! 708 ! !- bound the slopes: abs(zw.)<= 1/100 and zb..<0 709 ! kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 692 710 zbu = MIN( zbu , -100._wp* ABS( zau ) , -7.e+3_wp/fse3u(ji,jj,iku)* ABS( zau ) ) 693 711 zbv = MIN( zbv , -100._wp* ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,ikv)* ABS( zav ) ) 694 ! 712 ! !- Slope at u- & v-points (uslpml, vslpml) 695 713 uslpml(ji,jj) = zau / ( zbu - zeps ) * umask(ji,jj,iku) 696 714 vslpml(ji,jj) = zav / ( zbv - zeps ) * vmask(ji,jj,ikv) 697 715 ! 698 ! !== i- & j-slopes at w-points just below the Mixed Layer ==!716 ! !== i- & j-slopes at w-points just below the Mixed Layer ==! 699 717 ! 700 718 ik = MIN( nmln(ji,jj) + 1, jpk ) 701 719 ikm1 = MAX( 1, ik-1 ) 702 ! 720 ! !- vertical density gradient for w-slope (from N^2) 703 721 zbw = zm1_2g * pn2 (ji,jj,ik) * ( prd (ji,jj,ik) + prd (ji,jj,ikm1) + 2. ) 704 ! 722 ! !- horizontal density i- & j-gradient at w-points 705 723 zci = MAX( umask(ji-1,jj,ik ) + umask(ji,jj,ik ) & 706 & + umask(ji-1,jj,ikm1) + umask(ji,jj,ikm1) , zeps ) * e1t(ji,jj) 724 & + umask(ji-1,jj,ikm1) + umask(ji,jj,ikm1) , zeps ) * e1t(ji,jj) 707 725 zcj = MAX( vmask(ji,jj-1,ik ) + vmask(ji,jj,ik ) & 708 726 & + vmask(ji,jj-1,ikm1) + vmask(ji,jj,ikm1) , zeps ) * e2t(ji,jj) … … 711 729 zaj = ( p_grv(ji,jj-1,ik ) + p_grv(ji,jj,ik ) & 712 730 & + p_grv(ji,jj-1,ikm1) + p_grv(ji,jj,ikm1) ) / zcj * tmask(ji,jj,ik) 713 ! 714 ! 731 ! !- bound the slopes: abs(zw.)<= 1/100 and zb..<0. 732 ! kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 715 733 zbi = MIN( zbw , -100._wp* ABS( zai ) , -7.e+3_wp/fse3w(ji,jj,ik)* ABS( zai ) ) 716 734 zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w(ji,jj,ik)* ABS( zaj ) ) 717 ! 735 ! !- i- & j-slope at w-points (wslpiml, wslpjml) 718 736 wslpiml(ji,jj) = zai / ( zbi - zeps ) * tmask (ji,jj,ik) 719 737 wslpjml(ji,jj) = zaj / ( zbj - zeps ) * tmask (ji,jj,ik) 720 738 END DO 721 739 END DO 722 !!gm this lbc_lnk should be useless....740 !!gm this lbc_lnk should be useless.... 723 741 CALL lbc_lnk( uslpml , 'U', -1. ) ; CALL lbc_lnk( vslpml , 'V', -1. ) ! lateral boundary cond. (sign change) 724 742 CALL lbc_lnk( wslpiml, 'W', -1. ) ; CALL lbc_lnk( wslpjml, 'W', -1. ) ! lateral boundary conditions … … 733 751 !! ** Purpose : Initialization for the isopycnal slopes computation 734 752 !! 735 !! ** Method : read the nammbf namelist and check the parameter 736 !! 753 !! ** Method : read the nammbf namelist and check the parameter 754 !! values called by tra_dmp at the first timestep (nit000) 737 755 !!---------------------------------------------------------------------- 738 756 INTEGER :: ji, jj, jk ! dummy loop indices 739 757 INTEGER :: ierr ! local integer 740 758 !!---------------------------------------------------------------------- 741 742 IF(lwp) THEN 759 760 IF(lwp) THEN 743 761 WRITE(numout,*) 744 762 WRITE(numout,*) 'ldf_slp_init : direction of lateral mixing' 745 763 WRITE(numout,*) '~~~~~~~~~~~~' 746 764 ENDIF 747 765 748 766 IF( ln_traldf_grif ) THEN ! Griffies operator : triad of slopes 749 767 ALLOCATE( triadi_g(jpi,jpj,jpk,0:1,0:1) , triadj_g(jpi,jpj,jpk,0:1,0:1) , wslp2(jpi,jpj,jpk) , STAT=ierr ) … … 754 772 IF( ln_dynldf_iso ) CALL ctl_stop( 'ldf_slp_init: Griffies operator on momentum not supported' ) 755 773 ! 756 IF( ( ln_traldf_hor .OR. ln_dynldf_hor ) .AND. ln_sco ) &757 CALL ctl_stop( 'ldf_slp_init: horizontal Griffies operator in s-coordinate not supported' )758 !759 774 ELSE ! Madec operator : slopes at u-, v-, and w-points 760 775 ALLOCATE( uslp(jpi,jpj,jpk) , vslp(jpi,jpj,jpk) , wslpi(jpi,jpj,jpk) , wslpj(jpi,jpj,jpk) , & … … 769 784 wslpj(:,:,:) = 0._wp ; wslpjml(:,:) = 0._wp 770 785 771 !!gm I no longer understand this.....786 !!gm I no longer understand this..... 772 787 IF( (ln_traldf_hor .OR. ln_dynldf_hor) .AND. .NOT. (lk_vvl .AND. ln_rstart) ) THEN 773 788 IF(lwp) WRITE(numout,*) ' Horizontal mixing in s-coordinate: slope = slope of s-surfaces' … … 802 817 LOGICAL, PUBLIC, PARAMETER :: lk_ldfslp = .FALSE. !: slopes flag 803 818 CONTAINS 804 SUBROUTINE ldf_slp( kt, prd, pn2 ) 805 INTEGER, INTENT(in) :: kt 819 SUBROUTINE ldf_slp( kt, prd, pn2 ) ! Dummy routine 820 INTEGER, INTENT(in) :: kt 806 821 REAL, DIMENSION(:,:,:), INTENT(in) :: prd, pn2 807 822 WRITE(*,*) 'ldf_slp: You should not have seen this print! error?', kt, prd(1,1,1), pn2(1,1,1) … … 811 826 WRITE(*,*) 'ldf_slp_grif: You should not have seen this print! error?', kt 812 827 END SUBROUTINE ldf_slp_grif 813 SUBROUTINE ldf_slp_init ! Dummy routine828 SUBROUTINE ldf_slp_init ! Dummy routine 814 829 END SUBROUTINE ldf_slp_init 815 830 #endif -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90
r2715 r3116 67 67 & ln_traldf_level, ln_traldf_hor , ln_traldf_iso, & 68 68 & ln_traldf_grif , ln_traldf_gdia, & 69 & ln_triad_iso , ln_botmix_grif, & 69 70 & rn_aht_0 , rn_ahtb_0 , rn_aeiv_0, & 70 71 & rn_slpmax … … 94 95 WRITE(numout,*) ' maximum isoppycnal slope rn_slpmax = ', rn_slpmax 95 96 WRITE(numout,*) ' + griffies operator internal controls not set via the namelist (experimental): ' 96 WRITE(numout,*) ' calculate triads twice l _triad_iso = ', l_triad_iso97 WRITE(numout,*) ' no Shapiro filter l_no_smooth = ', l_no_smooth97 WRITE(numout,*) ' calculate triads twice ln_triad_iso = ', ln_triad_iso 98 WRITE(numout,*) ' GM -->lat mixing on bottom ln_botmix_grif = ', ln_botmix_grif 98 99 WRITE(numout,*) 99 100 ENDIF -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_oce.F90
r2977 r3116 32 32 33 33 REAL(wp), PUBLIC :: aht0, ahtb0, aeiv0 !!: OLD namelist names 34 LOGICAL , PUBLIC :: l_triad_iso = .FALSE. !: calculate triads twice 35 LOGICAL , PUBLIC :: l_no_smooth = .FALSE. !: no Shapiro smoothing 34 LOGICAL , PUBLIC :: ln_triad_iso = .FALSE. !: calculate triads twice 35 LOGICAL , PUBLIC :: ln_botmix_grif = .FALSE. !: mixing on bottom 36 LOGICAL , PUBLIC :: l_grad_zps = .FALSE. !: special treatment for Horz Tgradients w partial steps 36 37 37 38 REAL(wp), PUBLIC :: rldf !: multiplicative factor of diffusive coefficient -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/OBC/obcdta.F90
r2977 r3116 1237 1237 WRITE(*,*) 'obc_dta: You should not have seen this print! error?', kt 1238 1238 END SUBROUTINE obc_dta 1239 !!----------------------------------------------------------------------------- 1240 !! Default option 1241 !!----------------------------------------------------------------------------- 1242 SUBROUTINE obc_dta_bt ( kt, kbt ) ! Empty routine 1243 INTEGER,INTENT(in) :: kt 1244 INTEGER, INTENT( in ) :: kbt ! barotropic ocean time-step index 1245 WRITE(*,*) 'obc_dta_bt: You should not have seen this print! error?', kt 1246 WRITE(*,*) 'obc_dta_bt: You should not have seen this print! error?', kbt 1247 END SUBROUTINE obc_dta_bt 1239 1248 #endif 1240 1249 !!============================================================================== -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
r2715 r3116 13 13 !! " " ! 06-01 (W. Park) modification of physical part 14 14 !! " " ! 06-02 (R. Redler, W. Park) buffer array fix for root exchange 15 !! 3.4 ! 11-11 (C. Harris) Changes to allow mutiple category fields 15 16 !!---------------------------------------------------------------------- 16 17 #if defined key_oasis3 … … 52 53 INTEGER, PARAMETER :: nmaxfld=40 ! Maximum number of coupling fields 53 54 54 TYPE, PUBLIC :: FLD_CPL !: Type for coupling field information 55 LOGICAL :: laction ! To be coupled or not 56 CHARACTER(len = 8) :: clname ! Name of the coupling field 57 CHARACTER(len = 1) :: clgrid ! Grid type 58 REAL(wp) :: nsgn ! Control of the sign change 59 INTEGER :: nid ! Id of the field 55 TYPE, PUBLIC :: FLD_CPL !: Type for coupling field information 56 LOGICAL :: laction ! To be coupled or not 57 CHARACTER(len = 8) :: clname ! Name of the coupling field 58 CHARACTER(len = 1) :: clgrid ! Grid type 59 REAL(wp) :: nsgn ! Control of the sign change 60 INTEGER, DIMENSION(9) :: nid ! Id of the field (no more than 9 categories) 61 INTEGER :: nct ! Number of categories in field 60 62 END TYPE FLD_CPL 61 63 … … 118 120 INTEGER :: paral(5) ! OASIS3 box partition 119 121 INTEGER :: ishape(2,2) ! shape of arrays passed to PSMILe 120 INTEGER :: ji ! local loop indicees 122 INTEGER :: ji,jc ! local loop indicees 123 CHARACTER(LEN=8) :: zclname 121 124 !!-------------------------------------------------------------------- 122 125 … … 164 167 DO ji = 1, ksnd 165 168 IF ( ssnd(ji)%laction ) THEN 166 CALL prism_def_var_proto (ssnd(ji)%nid, ssnd(ji)%clname, id_part, (/ 2, 0/), & 167 & PRISM_Out , ishape , PRISM_REAL, nerror) 168 IF ( nerror /= PRISM_Ok ) THEN 169 WRITE(numout,*) 'Failed to define transient ', ji, TRIM(ssnd(ji)%clname) 170 CALL prism_abort_proto ( ssnd(ji)%nid, 'cpl_prism_define', 'Failure in prism_def_var') 171 ENDIF 169 DO jc = 1, ssnd(ji)%nct 170 IF ( ssnd(ji)%nct .gt. 1 ) THEN 171 WRITE(zclname,'( a7, i1)') ssnd(ji)%clname,jc 172 ELSE 173 zclname=ssnd(ji)%clname 174 ENDIF 175 WRITE(numout,*) "Define",ji,jc,zclname," for",PRISM_Out 176 CALL prism_def_var_proto (ssnd(ji)%nid(jc), zclname, id_part, (/ 2, 0/), & 177 PRISM_Out, ishape, PRISM_REAL, nerror) 178 IF ( nerror /= PRISM_Ok ) THEN 179 WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname) 180 CALL prism_abort_proto ( ssnd(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var') 181 ENDIF 182 END DO 172 183 ENDIF 173 184 END DO … … 177 188 DO ji = 1, krcv 178 189 IF ( srcv(ji)%laction ) THEN 179 CALL prism_def_var_proto ( srcv(ji)%nid, srcv(ji)%clname, id_part, (/ 2, 0/), & 180 & PRISM_In , ishape , PRISM_REAL, nerror) 181 IF ( nerror /= PRISM_Ok ) THEN 182 WRITE(numout,*) 'Failed to define transient ', ji, TRIM(srcv(ji)%clname) 183 CALL prism_abort_proto ( srcv(ji)%nid, 'cpl_prism_define', 'Failure in prism_def_var') 184 ENDIF 190 DO jc = 1, srcv(ji)%nct 191 IF ( srcv(ji)%nct .gt. 1 ) THEN 192 WRITE(zclname,'( a7, i1)') srcv(ji)%clname,jc 193 ELSE 194 zclname=srcv(ji)%clname 195 ENDIF 196 WRITE(numout,*) "Define",ji,jc,zclname," for",PRISM_In 197 CALL prism_def_var_proto ( srcv(ji)%nid(jc), zclname, id_part, (/ 2, 0/), & 198 & PRISM_In , ishape , PRISM_REAL, nerror) 199 IF ( nerror /= PRISM_Ok ) THEN 200 WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname) 201 CALL prism_abort_proto ( srcv(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var') 202 ENDIF 203 END DO 185 204 ENDIF 186 205 END DO … … 203 222 !! like sst or ice cover to the coupler or remote application. 204 223 !!---------------------------------------------------------------------- 205 INTEGER , INTENT(in ) :: kid ! variable index in the array 206 INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument 207 INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds 208 REAL(wp), DIMENSION(:,:), INTENT(in ) :: pdata 224 INTEGER , INTENT(in ) :: kid ! variable index in the array 225 INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument 226 INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds 227 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pdata 228 !! 229 INTEGER :: jc ! local loop index 209 230 !!-------------------------------------------------------------------- 210 231 ! 211 232 ! snd data to OASIS3 212 233 ! 213 CALL prism_put_proto ( ssnd(kid)%nid, kstep, pdata(nldi:nlei, nldj:nlej), kinfo ) 214 215 IF ( ln_ctl ) THEN 216 IF ( kinfo == PRISM_Sent .OR. kinfo == PRISM_ToRest .OR. & 217 & kinfo == PRISM_SentOut .OR. kinfo == PRISM_ToRestOut ) THEN 218 WRITE(numout,*) '****************' 219 WRITE(numout,*) 'prism_put_proto: Outgoing ', ssnd(kid)%clname 220 WRITE(numout,*) 'prism_put_proto: ivarid ', ssnd(kid)%nid 221 WRITE(numout,*) 'prism_put_proto: kstep ', kstep 222 WRITE(numout,*) 'prism_put_proto: info ', kinfo 223 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata) 224 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata) 225 WRITE(numout,*) ' - Sum value is ', SUM(pdata) 226 WRITE(numout,*) '****************' 234 DO jc = 1, ssnd(kid)%nct 235 236 CALL prism_put_proto ( ssnd(kid)%nid(jc), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo ) 237 238 IF ( ln_ctl ) THEN 239 IF ( kinfo == PRISM_Sent .OR. kinfo == PRISM_ToRest .OR. & 240 & kinfo == PRISM_SentOut .OR. kinfo == PRISM_ToRestOut ) THEN 241 WRITE(numout,*) '****************' 242 WRITE(numout,*) 'prism_put_proto: Outgoing ', ssnd(kid)%clname 243 WRITE(numout,*) 'prism_put_proto: ivarid ', ssnd(kid)%nid(jc) 244 WRITE(numout,*) 'prism_put_proto: kstep ', kstep 245 WRITE(numout,*) 'prism_put_proto: info ', kinfo 246 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc)) 247 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc)) 248 WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc)) 249 WRITE(numout,*) '****************' 250 ENDIF 227 251 ENDIF 228 ENDIF 252 253 ENDDO 229 254 ! 230 255 END SUBROUTINE cpl_prism_snd … … 238 263 !! like stresses and fluxes from the coupler or remote application. 239 264 !!---------------------------------------------------------------------- 240 INTEGER , INTENT(in ) :: kid ! variable index in the array 241 INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds 242 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pdata ! IN to keep the value if nothing is done 243 INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument 244 !! 245 LOGICAL :: llaction 265 INTEGER , INTENT(in ) :: kid ! variable index in the array 266 INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds 267 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pdata ! IN to keep the value if nothing is done 268 INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument 269 !! 270 INTEGER :: jc ! local loop index 271 LOGICAL :: llaction 246 272 !!-------------------------------------------------------------------- 247 273 ! 248 274 ! receive local data from OASIS3 on every process 249 275 ! 250 CALL prism_get_proto ( srcv(kid)%nid, kstep, exfld, kinfo ) 251 252 llaction = .false. 253 IF( kinfo == PRISM_Recvd .OR. kinfo == PRISM_FromRest .OR. & 254 kinfo == PRISM_RecvOut .OR. kinfo == PRISM_FromRestOut ) llaction = .TRUE. 255 256 IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid 257 258 IF ( llaction ) THEN 259 260 kinfo = OASIS_Rcv 261 pdata(nldi:nlei, nldj:nlej) = exfld(:,:) 262 263 !--- Fill the overlap areas and extra hallows (mpp) 264 !--- check periodicity conditions (all cases) 265 CALL lbc_lnk( pdata, srcv(kid)%clgrid, srcv(kid)%nsgn ) 266 267 IF ( ln_ctl ) THEN 268 WRITE(numout,*) '****************' 269 WRITE(numout,*) 'prism_get_proto: Incoming ', srcv(kid)%clname 270 WRITE(numout,*) 'prism_get_proto: ivarid ' , srcv(kid)%nid 271 WRITE(numout,*) 'prism_get_proto: kstep', kstep 272 WRITE(numout,*) 'prism_get_proto: info ', kinfo 273 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata) 274 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata) 275 WRITE(numout,*) ' - Sum value is ', SUM(pdata) 276 WRITE(numout,*) '****************' 276 DO jc = 1, srcv(kid)%nct 277 278 CALL prism_get_proto ( srcv(kid)%nid(jc), kstep, exfld, kinfo ) 279 280 llaction = .false. 281 IF( kinfo == PRISM_Recvd .OR. kinfo == PRISM_FromRest .OR. & 282 kinfo == PRISM_RecvOut .OR. kinfo == PRISM_FromRestOut ) llaction = .TRUE. 283 284 IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc) 285 286 IF ( llaction ) THEN 287 288 kinfo = OASIS_Rcv 289 pdata(nldi:nlei, nldj:nlej,jc) = exfld(:,:) 290 291 !--- Fill the overlap areas and extra hallows (mpp) 292 !--- check periodicity conditions (all cases) 293 CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn ) 294 295 IF ( ln_ctl ) THEN 296 WRITE(numout,*) '****************' 297 WRITE(numout,*) 'prism_get_proto: Incoming ', srcv(kid)%clname 298 WRITE(numout,*) 'prism_get_proto: ivarid ' , srcv(kid)%nid(jc) 299 WRITE(numout,*) 'prism_get_proto: kstep', kstep 300 WRITE(numout,*) 'prism_get_proto: info ', kinfo 301 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc)) 302 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc)) 303 WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc)) 304 WRITE(numout,*) '****************' 305 ENDIF 306 307 ELSE 308 kinfo = OASIS_idle 277 309 ENDIF 278 279 ELSE 280 kinfo = OASIS_idle 281 ENDIF 310 311 ENDDO 282 312 ! 283 313 END SUBROUTINE cpl_prism_rcv -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
r2777 r3116 24 24 IMPLICIT NONE 25 25 PRIVATE 26 27 PUBLIC fld_map ! routine called by tides_init 26 28 27 29 TYPE, PUBLIC :: FLD_N !: Namelist field informations … … 56 58 LOGICAL :: rotn ! flag to indicate whether field has been rotated 57 59 END TYPE FLD 60 61 TYPE, PUBLIC :: MAP_POINTER !: Array of integer pointers to 1D arrays 62 INTEGER, POINTER :: ptr(:) 63 END TYPE MAP_POINTER 58 64 59 65 !$AGRIF_DO_NOT_TREAT … … 98 104 CONTAINS 99 105 100 SUBROUTINE fld_read( kt, kn_fsbc, sd )106 SUBROUTINE fld_read( kt, kn_fsbc, sd, map, jit, time_offset ) 101 107 !!--------------------------------------------------------------------- 102 108 !! *** ROUTINE fld_read *** … … 113 119 INTEGER , INTENT(in ) :: kn_fsbc ! sbc computation period (in time step) 114 120 TYPE(FLD), INTENT(inout), DIMENSION(:) :: sd ! input field related variables 121 TYPE(MAP_POINTER),INTENT(in), OPTIONAL, DIMENSION(:) :: map ! global-to-local mapping index 122 INTEGER , INTENT(in ), OPTIONAL :: jit ! subcycle timestep for timesplitting option 123 INTEGER , INTENT(in ), OPTIONAL :: time_offset ! provide fields at time other than "now" 124 ! time_offset = -1 => fields at "before" time level 125 ! time_offset = +1 => fields at "after" time levels 126 ! etc. 115 127 !! 116 128 INTEGER :: imf ! size of the structure sd … … 119 131 INTEGER :: isecend ! number of second since Jan. 1st 00h of nit000 year at nitend 120 132 INTEGER :: isecsbc ! number of seconds between Jan. 1st 00h of nit000 year and the middle of sbc time step 133 INTEGER :: time_add ! local time_offset variable 121 134 LOGICAL :: llnxtyr ! open next year file? 122 135 LOGICAL :: llnxtmth ! open next month file? 123 136 LOGICAL :: llstop ! stop is the file does not exist 137 LOGICAL :: ll_firstcall ! true if this is the first call to fld_read for this set of fields 124 138 REAL(wp) :: ztinta ! ratio applied to after records when doing time interpolation 125 139 REAL(wp) :: ztintb ! ratio applied to before records when doing time interpolation 126 140 CHARACTER(LEN=1000) :: clfmt ! write format 127 141 !!--------------------------------------------------------------------- 142 ll_firstcall = .false. 143 IF( PRESENT(jit) ) THEN 144 IF(kt == nit000 .and. jit == 1) ll_firstcall = .true. 145 ELSE 146 IF(kt == nit000) ll_firstcall = .true. 147 ENDIF 148 149 time_add = 0 150 IF( PRESENT(time_offset) ) THEN 151 time_add = time_offset 152 ENDIF 153 128 154 ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar 129 isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdttra(1)) ! middle of sbc time step 155 IF( present(jit) ) THEN 156 ! ignore kn_fsbc in this case 157 isecsbc = nsec_year + nsec1jan000 + (jit+time_add)*rdt/REAL(nn_baro,wp) 158 ELSE 159 isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdttra(1)) + time_add * rdttra(1) ! middle of sbc time step 160 ENDIF 130 161 imf = SIZE( sd ) 131 162 ! 132 IF( kt == nit000 ) THEN ! initialization 133 DO jf = 1, imf 134 CALL fld_init( kn_fsbc, sd(jf) ) ! read each before field (put them in after as they will be swapped) 135 END DO 163 IF( ll_firstcall ) THEN ! initialization 164 IF( PRESENT(map) ) THEN 165 DO jf = 1, imf 166 CALL fld_init( kn_fsbc, sd(jf), map(jf)%ptr ) ! read each before field (put them in after as they will be swapped) 167 END DO 168 ELSE 169 DO jf = 1, imf 170 CALL fld_init( kn_fsbc, sd(jf) ) ! read each before field (put them in after as they will be swapped) 171 END DO 172 ENDIF 136 173 IF( lwp ) CALL wgt_print() ! control print 137 174 CALL fld_rot( kt, sd ) ! rotate vector fiels if needed … … 143 180 DO jf = 1, imf ! --- loop over field --- ! 144 181 145 IF( isecsbc > sd(jf)%nrec_a(2) .OR. kt == nit000) THEN ! read/update the after data?182 IF( isecsbc > sd(jf)%nrec_a(2) .OR. ll_firstcall ) THEN ! read/update the after data? 146 183 147 184 IF( sd(jf)%ln_tint ) THEN ! swap before record field and informations … … 151 188 ENDIF 152 189 153 CALL fld_rec( kn_fsbc, sd(jf) ) ! update record informations 190 IF( PRESENT(jit) ) THEN 191 CALL fld_rec( kn_fsbc, sd(jf), jit=jit ) ! update record informations 192 ELSE 193 CALL fld_rec( kn_fsbc, sd(jf) ) ! update record informations 194 ENDIF 154 195 155 196 ! do we have to change the year/month/week/day of the forcing field?? … … 212 253 213 254 ! read after data 214 CALL fld_get( sd(jf) ) 255 IF( PRESENT(map) ) THEN 256 CALL fld_get( sd(jf), map(jf)%ptr ) 257 ELSE 258 CALL fld_get( sd(jf) ) 259 ENDIF 215 260 216 261 ENDIF … … 225 270 clfmt = "('fld_read: var ', a, ' kt = ', i8, ' (', f7.2,' days), Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," // & 226 271 & "', records b/a: ', i4.4, '/', i4.4, ' (days ', f7.2,'/', f7.2, ')')" 227 WRITE(numout, clfmt) TRIM( sd(jf)%clvar ), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday, & 272 WRITE(numout, clfmt) TRIM( sd(jf)%clvar ), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday, & 228 273 & sd(jf)%nrec_b(1), sd(jf)%nrec_a(1), REAL(sd(jf)%nrec_b(2),wp)/rday, REAL(sd(jf)%nrec_a(2),wp)/rday 274 WRITE(numout, *) 'time_add is : ',time_add 229 275 ENDIF 230 276 ! temporal interpolation weights … … 253 299 254 300 255 SUBROUTINE fld_init( kn_fsbc, sdjf )301 SUBROUTINE fld_init( kn_fsbc, sdjf, map ) 256 302 !!--------------------------------------------------------------------- 257 303 !! *** ROUTINE fld_init *** … … 262 308 INTEGER , INTENT(in ) :: kn_fsbc ! sbc computation period (in time step) 263 309 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 310 INTEGER , INTENT(in), OPTIONAL, DIMENSION(:) :: map ! global-to-local mapping indices 264 311 !! 265 312 LOGICAL :: llprevyr ! are we reading previous year file? … … 364 411 365 412 ! read before data 366 CALL fld_get( sdjf ) ! read before values in after arrays(as we will swap it later) 413 IF( PRESENT(map) ) THEN 414 CALL fld_get( sdjf, map ) ! read before values in after arrays(as we will swap it later) 415 ELSE 416 CALL fld_get( sdjf ) ! read before values in after arrays(as we will swap it later) 417 ENDIF 367 418 368 419 clfmt = "('fld_init : time-interpolation for ', a, ' read previous record = ', i4, ' at time = ', f7.2, ' days')" … … 396 447 397 448 398 SUBROUTINE fld_rec( kn_fsbc, sdjf, ldbefore )449 SUBROUTINE fld_rec( kn_fsbc, sdjf, ldbefore, jit ) 399 450 !!--------------------------------------------------------------------- 400 451 !! *** ROUTINE fld_rec *** … … 410 461 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 411 462 LOGICAL , INTENT(in ), OPTIONAL :: ldbefore ! sent back before record values (default = .FALSE.) 463 INTEGER , INTENT(in ), OPTIONAL :: jit ! index of barotropic subcycle 412 464 ! used only if sdjf%ln_tint = .TRUE. 413 465 !! … … 443 495 ! 444 496 ztmp = REAL( nday, wp ) / REAL( nyear_len(1), wp ) + 0.5 497 IF( PRESENT(jit) ) ztmp = ztmp + jit*rdt/REAL(nn_baro,wp) 445 498 sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) 446 499 ! swap at the middle of the year … … 471 524 ! 472 525 ztmp = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 526 IF( PRESENT(jit) ) ztmp = ztmp + jit*rdt/REAL(nn_baro,wp) 473 527 imth = nmonth + INT( ztmp ) - COUNT((/llbefore/)) 474 528 IF( sdjf%cltype == 'monthly' ) THEN ; sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) … … 498 552 ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * rdttra(1) ! shift time to be centrered in the middle of sbc time step 499 553 ztmp = ztmp + 0.01 * rdttra(1) ! add 0.01 time step to avoid truncation error 554 IF( PRESENT(jit) ) ztmp = ztmp + jit*rdt/REAL(nn_baro,wp) 500 555 IF( sdjf%ln_tint ) THEN ! time interpolation, shift by 1/2 record 501 556 ! … … 546 601 547 602 548 SUBROUTINE fld_get( sdjf )549 !!--------------------------------------------------------------------- 550 !! *** ROUTINE fld_ clopn***603 SUBROUTINE fld_get( sdjf, map ) 604 !!--------------------------------------------------------------------- 605 !! *** ROUTINE fld_get *** 551 606 !! 552 607 !! ** Purpose : read the data 553 608 !!---------------------------------------------------------------------- 554 609 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 610 INTEGER , INTENT(in), OPTIONAL, DIMENSION(:) :: map ! global-to-local mapping indices 555 611 !! 556 612 INTEGER :: ipk ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) … … 559 615 560 616 ipk = SIZE( sdjf%fnow, 3 ) 561 IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 617 618 IF( PRESENT(map) ) THEN 619 IF( sdjf%ln_tint ) THEN ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), map ) 620 ELSE ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,: ), sdjf%nrec_a(1), map ) 621 ENDIF 622 ELSE IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 562 623 CALL wgt_list( sdjf, iw ) 563 624 IF( sdjf%ln_tint ) THEN ; CALL fld_interp( sdjf%num, sdjf%clvar, iw , ipk , sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) ) … … 581 642 END SUBROUTINE fld_get 582 643 644 SUBROUTINE fld_map( num, clvar, dta, nrec, map ) 645 !!--------------------------------------------------------------------- 646 !! *** ROUTINE fld_get *** 647 !! 648 !! ** Purpose : read global data from file and map onto local data 649 !! using a general mapping (for open boundaries) 650 !!---------------------------------------------------------------------- 651 #if defined key_bdy 652 USE bdy_oce, ONLY: dta_global ! workspace to read in global data arrays 653 #endif 654 655 INTEGER , INTENT(in ) :: num ! stream number 656 CHARACTER(LEN=*) , INTENT(in ) :: clvar ! variable name 657 REAL(wp), DIMENSION(:,:,:), INTENT(out) :: dta ! output field on model grid (2 dimensional) 658 INTEGER , INTENT(in ) :: nrec ! record number to read (ie time slice) 659 INTEGER, DIMENSION(:) , INTENT(in ) :: map ! global-to-local mapping indices 660 !! 661 INTEGER :: ipi ! length of boundary data on local process 662 INTEGER :: ipj ! length of dummy dimension ( = 1 ) 663 INTEGER :: ipk ! number of vertical levels of dta ( 2D: ipk=1 ; 3D: ipk=jpk ) 664 INTEGER :: ilendta ! length of data in file 665 INTEGER :: idvar ! variable ID 666 INTEGER :: ib, ik ! loop counters 667 INTEGER :: ierr 668 REAL(wp), POINTER, DIMENSION(:,:,:) :: dta_read ! work space for global data 669 !!--------------------------------------------------------------------- 670 671 #if defined key_bdy 672 dta_read => dta_global 673 #endif 674 675 ipi = SIZE( dta, 1 ) 676 ipj = 1 677 ipk = SIZE( dta, 3 ) 678 679 idvar = iom_varid( num, clvar ) 680 ilendta = iom_file(num)%dimsz(1,idvar) 681 IF(lwp) WRITE(numout,*) 'Dim size for ',TRIM(clvar),' is ', ilendta 682 IF(lwp) WRITE(numout,*) 'Number of levels for ',TRIM(clvar),' is ', ipk 683 684 SELECT CASE( ipk ) 685 CASE(1) 686 CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1 ), nrec ) 687 CASE DEFAULT 688 CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1:ipk), nrec ) 689 END SELECT 690 ! 691 DO ib = 1, ipi 692 DO ik = 1, ipk 693 dta(ib,1,ik) = dta_read(map(ib),1,ik) 694 END DO 695 END DO 696 697 END SUBROUTINE fld_map 698 583 699 584 700 SUBROUTINE fld_rot( kt, sd ) 585 701 !!--------------------------------------------------------------------- 586 !! *** ROUTINE fld_ clopn***702 !! *** ROUTINE fld_rot *** 587 703 !! 588 704 !! ** Purpose : Vector fields may need to be rotated onto the local grid direction 589 705 !!---------------------------------------------------------------------- 590 706 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 591 USE wrk_nemo, ONLY: utmp => wrk_2d_ 4, vtmp => wrk_2d_5 ! 2D workspace707 USE wrk_nemo, ONLY: utmp => wrk_2d_24, vtmp => wrk_2d_25 ! 2D workspace 592 708 !! 593 709 INTEGER , INTENT(in ) :: kt ! ocean time step … … 601 717 !!--------------------------------------------------------------------- 602 718 603 IF(wrk_in_use(2, 4,5) ) THEN719 IF(wrk_in_use(2, 24,25) ) THEN 604 720 CALL ctl_stop('fld_rot: ERROR: requested workspace arrays are unavailable.') ; RETURN 605 721 END IF … … 638 754 END DO 639 755 ! 640 IF(wrk_not_released(2, 4,5) ) CALL ctl_stop('fld_rot: ERROR: failed to release workspace arrays.')756 IF(wrk_not_released(2, 24,25) ) CALL ctl_stop('fld_rot: ERROR: failed to release workspace arrays.') 641 757 ! 642 758 END SUBROUTINE fld_rot … … 672 788 ! 673 789 CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof = LEN(TRIM(sdjf%wgtname)) > 0 ) 674 790 ! 675 791 END SUBROUTINE fld_clopn 676 792 -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90
r2777 r3116 6 6 !! History : 3.0 ! 2006-08 (G. Madec) Surface module 7 7 !! 3.2 ! 2009-06 (S. Masson) merge with ice_oce 8 !! 4.0 ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 8 !! 3.3.1! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 9 !! 3.4 ! 2011-11 (C. Harris) CICE added as an option 9 10 !!---------------------------------------------------------------------- 10 #if defined key_lim3 || defined key_lim2 11 #if defined key_lim3 || defined key_lim2 || defined key_cice 11 12 !!---------------------------------------------------------------------- 12 13 !! 'key_lim2' or 'key_lim3' : LIM-2 or LIM-3 sea-ice model … … 19 20 USE par_ice_2 ! LIM-2 parameters 20 21 # endif 22 # if defined key_cice 23 USE ice_domain_size, only: ncat 24 #endif 21 25 USE lib_mpp ! MPP library 22 26 USE in_out_manager ! I/O manager … … 30 34 LOGICAL , PUBLIC, PARAMETER :: lk_lim2 = .TRUE. !: LIM-2 ice model 31 35 LOGICAL , PUBLIC, PARAMETER :: lk_lim3 = .FALSE. !: no LIM-3 36 LOGICAL , PUBLIC, PARAMETER :: lk_cice = .FALSE. !: no CICE 32 37 # if defined key_lim2_vp 33 38 CHARACTER(len=1), PUBLIC, PARAMETER :: cp_ice_msh = 'I' !: VP : 'I'-grid ice-velocity (B-grid lower left corner) … … 39 44 LOGICAL , PUBLIC, PARAMETER :: lk_lim2 = .FALSE. !: no LIM-2 40 45 LOGICAL , PUBLIC, PARAMETER :: lk_lim3 = .TRUE. !: LIM-3 ice model 46 LOGICAL , PUBLIC, PARAMETER :: lk_cice = .FALSE. !: no CICE 41 47 CHARACTER(len=1), PUBLIC, PARAMETER :: cp_ice_msh = 'C' !: 'C'-grid ice-velocity 42 48 # endif 49 # if defined key_cice 50 LOGICAL , PUBLIC, PARAMETER :: lk_lim2 = .FALSE. !: no LIM-2 51 LOGICAL , PUBLIC, PARAMETER :: lk_lim3 = .FALSE. !: no LIM-3 52 LOGICAL , PUBLIC, PARAMETER :: lk_cice = .TRUE. !: CICE ice model 53 CHARACTER(len=1), PUBLIC :: cp_ice_msh = 'F' !: 'F'-grid ice-velocity 54 # endif 43 55 56 #if defined key_lim3 || defined key_lim2 44 57 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qns_ice !: non solar heat flux over ice [W/m2] 45 58 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice !: solar heat flux over ice [W/m2] … … 60 73 # endif 61 74 75 #elif defined key_cice 76 ! 77 ! for consistency with LIM, these are declared with three dimensions 78 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qlw_ice !: incoming long-wave 79 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qla_ice !: latent flux over ice [W/m2] 80 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice !: solar heat flux over ice [W/m2] 81 ! 82 ! other forcing arrays are two dimensional 83 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ss_iou !: x ice-ocean surface stress at NEMO U point 84 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ss_iov !: y ice-ocean surface stress at NEMO V point 85 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_ice !: sublimation-snow budget over ice [kg/m2] 86 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tatm_ice !: air temperature 87 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qatm_ice !: specific humidity 88 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wndi_ice !: i wind at T point 89 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wndj_ice !: j wind at T point 90 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: nfrzmlt !: NEMO frzmlt 91 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr_iu !: ice fraction at NEMO U point 92 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr_iv !: ice fraction at NEMO V point 93 ! 94 ! finally, arrays corresponding to different ice categories 95 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i !: category ice fraction 96 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: topmelt !: category topmelt 97 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: botmelt !: category botmelt 98 #endif 99 62 100 !!---------------------------------------------------------------------- 63 101 !! NEMO/OPA 4.0 , NEMO Consortium (2011) … … 71 109 !! *** FUNCTION sbc_ice_alloc *** 72 110 !!---------------------------------------------------------------------- 111 #if defined key_lim3 || defined key_lim2 73 112 ALLOCATE( qns_ice (jpi,jpj,jpl) , qsr_ice (jpi,jpj,jpl) , & 74 113 & qla_ice (jpi,jpj,jpl) , dqla_ice(jpi,jpj,jpl) , & … … 77 116 & utau_ice(jpi,jpj) , vtau_ice(jpi,jpj) , & 78 117 & fr1_i0 (jpi,jpj) , fr2_i0 (jpi,jpj) , & 79 # 118 #if defined key_lim3 80 119 & emp_ice(jpi,jpj) , tatm_ice(jpi,jpj) , STAT= sbc_ice_alloc ) 81 # 120 #else 82 121 & emp_ice(jpi,jpj) , STAT= sbc_ice_alloc ) 83 # endif 122 #endif 123 #elif defined key_cice 124 ALLOCATE( qla_ice(jpi,jpj,1) , qlw_ice(jpi,jpj,1) , qsr_ice(jpi,jpj,1) , & 125 wndi_ice(jpi,jpj) , tatm_ice(jpi,jpj) , qatm_ice(jpi,jpj) , & 126 wndj_ice(jpi,jpj) , nfrzmlt(jpi,jpj) , ss_iou(jpi,jpj) , & 127 ss_iov(jpi,jpj) , fr_iu(jpi,jpj) , fr_iv(jpi,jpj) , & 128 a_i(jpi,jpj,ncat) , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat), STAT= sbc_ice_alloc ) 129 #endif 84 130 ! 85 131 IF( lk_mpp ) CALL mpp_sum ( sbc_ice_alloc ) … … 89 135 #else 90 136 !!---------------------------------------------------------------------- 91 !! Default option NO LIM 2.0 or 3.0 sea-ice model137 !! Default option NO LIM 2.0 or 3.0 or CICE sea-ice model 92 138 !!---------------------------------------------------------------------- 93 139 LOGICAL , PUBLIC, PARAMETER :: lk_lim2 = .FALSE. !: no LIM-2 ice model 94 140 LOGICAL , PUBLIC, PARAMETER :: lk_lim3 = .FALSE. !: no LIM-3 ice model 141 LOGICAL , PUBLIC, PARAMETER :: lk_cice = .FALSE. !: no CICE ice model 95 142 CHARACTER(len=1), PUBLIC, PARAMETER :: cp_ice_msh = '-' !: no grid ice-velocity 96 143 #endif -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90
r2715 r3116 10 10 !! sbc_apr : read atmospheric pressure in netcdf files 11 11 !!---------------------------------------------------------------------- 12 USE bdy_par ! Unstructured boundary parameters13 12 USE obc_par ! open boundary condition parameters 14 13 USE dom_oce ! ocean space and time domain … … 30 29 ! !!* namsbc_apr namelist (Atmospheric PRessure) * 31 30 LOGICAL, PUBLIC :: ln_apr_obc = .FALSE. !: inverse barometer added to OBC ssh data 32 LOGICAL, PUBLIC :: ln_apr_bdy = .FALSE. !: inverse barometer added to BDY ssh data33 31 LOGICAL, PUBLIC :: ln_ref_apr = .FALSE. !: ref. pressure: global mean Patm (F) or a constant (F) 34 32 … … 115 113 ! 116 114 ! !* control check 117 IF( ln_apr_obc .OR. ln_apr_bdy) &118 CALL ctl_stop( 'sbc_apr: inverse barometer added to OBC or BDYssh data not yet implemented ' )115 IF( ln_apr_obc ) & 116 CALL ctl_stop( 'sbc_apr: inverse barometer added to OBC ssh data not yet implemented ' ) 119 117 IF( ln_apr_obc .AND. .NOT. lk_obc ) & 120 118 CALL ctl_stop( 'sbc_apr: add inverse barometer to OBC requires to use key_obc' ) 121 IF( ln_apr_bdy .AND. .NOT. lk_bdy ) & 122 CALL ctl_stop( 'sbc_apr: add inverse barometer to OBC requires to use key_bdy' ) 123 IF( ( ln_apr_obc .OR. ln_apr_bdy ) .AND. .NOT. lk_dynspg_ts ) & 119 IF( ( ln_apr_obc ) .AND. .NOT. lk_dynspg_ts ) & 124 120 CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY possible with time-splitting' ) 125 IF( ( ln_apr_obc .OR. ln_apr_bdy) .AND. .NOT. ln_apr_dyn ) &121 IF( ( ln_apr_obc ) .AND. .NOT. ln_apr_dyn ) & 126 122 CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY requires ln_apr_dyn=T' ) 127 123 ENDIF -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r3105 r3116 14 14 !! 3.2 ! 2009-04 (B. Lemaire) Introduce iom_put 15 15 !! 3.3 ! 2010-10 (S. Masson) add diurnal cycle 16 !! 3.4 ! 2011-11 (C. Harris) Fill arrays required by CICE 16 17 !!---------------------------------------------------------------------- 17 18 … … 35 36 USE prtctl ! Print control 36 37 USE sbcwave,ONLY : cdn_wave !wave module 37 #if defined key_lim3 38 #if defined key_lim3 || defined key_cice 38 39 USE sbc_ice ! Surface boundary condition: ice fields 39 40 #endif … … 184 185 ! ! surface ocean fluxes computed with CLIO bulk formulea 185 186 IF( MOD( kt - 1, nn_fsbc ) == 0 ) CALL blk_oce_core( sf, sst_m, ssu_m, ssv_m ) 187 188 #if defined key_cice 189 IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 190 qlw_ice(:,:,1) = sf(jp_qlw)%fnow(:,:,1) 191 qsr_ice(:,:,1) = sf(jp_qsr)%fnow(:,:,1) 192 tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1) 193 qatm_ice(:,:) = sf(jp_humi)%fnow(:,:,1) 194 tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac 195 sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac 196 wndi_ice(:,:) = sf(jp_wndi)%fnow(:,:,1) 197 wndj_ice(:,:) = sf(jp_wndj)%fnow(:,:,1) 198 ENDIF 199 #endif 186 200 ! 187 201 END SUBROUTINE sbc_blk_core -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r2977 r3116 7 7 !! 3.0 ! 2008-02 (G. Madec, C Talandier) surface module 8 8 !! 3.1 ! 2009_02 (G. Madec, S. Masson, E. Maisonave, A. Caubel) generic coupled interface 9 !! 3.4 ! 2011_11 (C. Harris) more flexibility + multi-category fields 9 10 !!---------------------------------------------------------------------- 10 11 #if defined key_oasis3 || defined key_oasis4 … … 51 52 #endif 52 53 USE diaar5, ONLY : lk_diaar5 54 #if defined key_cice 55 USE ice_domain_size, only: ncat 56 #endif 53 57 IMPLICIT NONE 54 58 PRIVATE … … 89 93 INTEGER, PARAMETER :: jpr_cal = 29 ! calving 90 94 INTEGER, PARAMETER :: jpr_taum = 30 ! wind stress module 91 #if ! defined key_cpl_carbon_cycle92 INTEGER, PARAMETER :: jprcv = 30 ! total number of fields received93 #else94 95 INTEGER, PARAMETER :: jpr_co2 = 31 95 INTEGER, PARAMETER :: jprcv = 31 ! total number of fields received 96 #endif 96 INTEGER, PARAMETER :: jpr_topm = 32 ! topmeltn 97 INTEGER, PARAMETER :: jpr_botm = 33 ! botmeltn 98 INTEGER, PARAMETER :: jprcv = 33 ! total number of fields received 99 97 100 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction 98 101 INTEGER, PARAMETER :: jps_toce = 2 ! ocean temperature … … 109 112 INTEGER, PARAMETER :: jps_ivy1 = 13 ! 110 113 INTEGER, PARAMETER :: jps_ivz1 = 14 ! 111 #if ! defined key_cpl_carbon_cycle112 INTEGER, PARAMETER :: jpsnd = 14 ! total number of fields sended113 #else114 114 INTEGER, PARAMETER :: jps_co2 = 15 115 115 INTEGER, PARAMETER :: jpsnd = 15 ! total number of fields sended 116 #endif 116 117 117 ! !!** namelist namsbc_cpl ** 118 ! Send to the atmosphere ! 119 CHARACTER(len=100) :: cn_snd_temperature = 'oce only' ! 'oce only' 'weighted oce and ice' or 'mixed oce-ice' 120 CHARACTER(len=100) :: cn_snd_albedo = 'none' ! 'none' 'weighted ice' or 'mixed oce-ice' 121 CHARACTER(len=100) :: cn_snd_thickness = 'none' ! 'none' or 'weighted ice and snow' 122 CHARACTER(len=100) :: cn_snd_crt_nature = 'none' ! 'none' 'oce only' 'weighted oce and ice' or 'mixed oce-ice' 123 CHARACTER(len=100) :: cn_snd_crt_refere = 'spherical' ! 'spherical' or 'cartesian' 124 CHARACTER(len=100) :: cn_snd_crt_orient = 'local grid' ! 'eastward-northward' or 'local grid' 125 CHARACTER(len=100) :: cn_snd_crt_grid = 'T' ! always at 'T' point 126 #if defined key_cpl_carbon_cycle 127 CHARACTER(len=100) :: cn_snd_co2 = 'none' ! 'none' or 'coupled' 118 TYPE :: FLD_C 119 CHARACTER(len = 32) :: cldes ! desciption of the coupling strategy 120 CHARACTER(len = 32) :: clcat ! multiple ice categories strategy 121 CHARACTER(len = 32) :: clvref ! reference of vector ('spherical' or 'cartesian') 122 CHARACTER(len = 32) :: clvor ! orientation of vector fields ('eastward-northward' or 'local grid') 123 CHARACTER(len = 32) :: clvgrd ! grids on which is located the vector fields 124 END TYPE FLD_C 125 ! Send to the atmosphere ! 126 TYPE(FLD_C) :: sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2 127 ! Received from the atmosphere ! 128 TYPE(FLD_C) :: sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr, sn_rcv_qns, sn_rcv_emp, sn_rcv_rnf 129 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2 130 131 TYPE :: DYNARR 132 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3 133 END TYPE DYNARR 134 135 TYPE( DYNARR ), SAVE, DIMENSION(jprcv) :: frcv ! all fields recieved from the atmosphere 136 137 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: albedo_oce_mix ! ocean albedo sent to atmosphere (mix clear/overcast sky) 138 139 INTEGER , ALLOCATABLE, SAVE, DIMENSION( :) :: nrcvinfo ! OASIS info argument 140 141 #if ! defined key_lim2 && ! defined key_lim3 142 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice,fr1_i0,fr2_i0 ! jpi, jpj 143 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tn_ice, alb_ice, qns_ice, dqns_ice ! (jpi,jpj,jpl) 128 144 #endif 129 ! Received from the atmosphere ! 130 CHARACTER(len=100) :: cn_rcv_tau_nature = 'oce only' ! 'oce only' 'oce and ice' or 'mixed oce-ice' 131 CHARACTER(len=100) :: cn_rcv_tau_refere = 'spherical' ! 'spherical' or 'cartesian' 132 CHARACTER(len=100) :: cn_rcv_tau_orient = 'local grid' ! 'eastward-northward' or 'local grid' 133 CHARACTER(len=100) :: cn_rcv_tau_grid = 'T' ! 'T', 'U,V', 'U,V,I', 'T,I', or 'T,U,V' 134 CHARACTER(len=100) :: cn_rcv_w10m = 'none' ! 'none' or 'coupled' 135 CHARACTER(len=100) :: cn_rcv_dqnsdt = 'none' ! 'none' or 'coupled' 136 CHARACTER(len=100) :: cn_rcv_qsr = 'oce only' ! 'oce only' 'conservative' 'oce and ice' or 'mixed oce-ice' 137 CHARACTER(len=100) :: cn_rcv_qns = 'oce only' ! 'oce only' 'conservative' 'oce and ice' or 'mixed oce-ice' 138 CHARACTER(len=100) :: cn_rcv_emp = 'oce only' ! 'oce only' 'conservative' or 'oce and ice' 139 CHARACTER(len=100) :: cn_rcv_rnf = 'coupled' ! 'coupled' 'climato' or 'mixed' 140 CHARACTER(len=100) :: cn_rcv_cal = 'none' ! 'none' or 'coupled' 141 CHARACTER(len=100) :: cn_rcv_taumod = 'none' ! 'none' or 'coupled' 142 #if defined key_cpl_carbon_cycle 143 CHARACTER(len=100) :: cn_rcv_co2 = 'none' ! 'none' or 'coupled' 145 146 #if defined key_cice 147 INTEGER, PARAMETER :: jpl = ncat 148 #elif ! defined key_lim2 && ! defined key_lim3 149 INTEGER, PARAMETER :: jpl = 1 150 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_ice 151 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice 144 152 #endif 145 153 146 !! CHARACTER(len=100), PUBLIC :: cn_rcv_rnf !: ??? ==>> !!gm treat this case in a different maner 147 148 CHARACTER(len=100), DIMENSION(4) :: cn_snd_crt ! array combining cn_snd_crt_* 149 CHARACTER(len=100), DIMENSION(4) :: cn_rcv_tau ! array combining cn_rcv_tau_* 150 151 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: albedo_oce_mix ! ocean albedo sent to atmosphere (mix clear/overcast sky) 152 153 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: frcv ! all fields recieved from the atmosphere 154 INTEGER , ALLOCATABLE, SAVE, DIMENSION( :) :: nrcvinfo ! OASIS info argument 155 156 #if ! defined key_lim2 && ! defined key_lim3 157 ! quick patch to be able to run the coupled model without sea-ice... 158 INTEGER, PARAMETER :: jpl = 1 159 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: hicif, hsnif, u_ice, v_ice,fr1_i0,fr2_i0 ! jpi, jpj 160 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tn_ice, alb_ice ! (jpi,jpj,jpl) 161 REAL(wp) :: lfus 154 #if ! defined key_lim3 && ! defined key_cice 155 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i 156 #endif 157 158 #if ! defined key_lim3 159 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ht_i, ht_s 160 #endif 161 162 #if ! defined key_cice 163 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: topmelt, botmelt 162 164 #endif 163 165 … … 176 178 !! *** FUNCTION sbc_cpl_alloc *** 177 179 !!---------------------------------------------------------------------- 178 INTEGER :: ierr( 2)180 INTEGER :: ierr(4),jn 179 181 !!---------------------------------------------------------------------- 180 182 ierr(:) = 0 181 183 ! 182 ALLOCATE( albedo_oce_mix(jpi,jpj), frcv(jpi,jpj,jprcv),nrcvinfo(jprcv), STAT=ierr(1) )184 ALLOCATE( albedo_oce_mix(jpi,jpj), nrcvinfo(jprcv), STAT=ierr(1) ) 183 185 ! 184 186 #if ! defined key_lim2 && ! defined key_lim3 185 187 ! quick patch to be able to run the coupled model without sea-ice... 186 ALLOCATE( hicif(jpi,jpj) , u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,jpl) , & 187 hsnif(jpi,jpj) , v_ice(jpi,jpj) , fr2_i0(jpi,jpj) , alb_ice(jpi,jpj,jpl) , STAT=ierr(2) ) 188 ALLOCATE( u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,1) , & 189 v_ice(jpi,jpj) , fr2_i0(jpi,jpj) , alb_ice(jpi,jpj,1), & 190 emp_ice(jpi,jpj) , qns_ice(jpi,jpj,1) , dqns_ice(jpi,jpj,1) , STAT=ierr(2) ) 191 #endif 192 193 #if ! defined key_lim3 && ! defined key_cice 194 ALLOCATE( a_i(jpi,jpj,jpl) , STAT=ierr(3) ) 195 #endif 196 197 #if defined key_cice || defined key_lim2 198 ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(4) ) 188 199 #endif 189 200 sbc_cpl_alloc = MAXVAL( ierr ) … … 213 224 INTEGER :: jn ! dummy loop index 214 225 !! 215 NAMELIST/namsbc_cpl/ cn_snd_temperature, cn_snd_albedo , cn_snd_thickness, & 216 cn_snd_crt_nature, cn_snd_crt_refere , cn_snd_crt_orient, cn_snd_crt_grid , & 217 cn_rcv_w10m , cn_rcv_taumod , & 218 cn_rcv_tau_nature, cn_rcv_tau_refere , cn_rcv_tau_orient, cn_rcv_tau_grid , & 219 cn_rcv_dqnsdt , cn_rcv_qsr , cn_rcv_qns , cn_rcv_emp , cn_rcv_rnf , cn_rcv_cal 220 #if defined key_cpl_carbon_cycle 221 NAMELIST/namsbc_cpl_co2/ cn_snd_co2, cn_rcv_co2 222 #endif 226 NAMELIST/namsbc_cpl/ sn_snd_temp, sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2, & 227 & sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr, & 228 & sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , sn_rcv_iceflx , sn_rcv_co2 223 229 !!--------------------------------------------------------------------- 224 230 … … 230 236 ! Namelist informations ! 231 237 ! ================================ ! 238 239 ! default definitions 240 ! ! description ! multiple ! vector ! vector ! vector ! 241 ! ! ! categories ! reference ! orientation ! grids ! 242 ! send 243 sn_snd_temp = FLD_C( 'weighted oce and ice', 'no' , '' , '' , '' ) 244 sn_snd_alb = FLD_C( 'weighted ice' , 'no' , '' , '' , '' ) 245 sn_snd_thick = FLD_C( 'none' , 'no' , '' , '' , '' ) 246 sn_snd_crt = FLD_C( 'none' , 'no' , 'spherical' , 'eastward-northward' , 'T' ) 247 sn_snd_co2 = FLD_C( 'none' , 'no' , '' , '' , '' ) 248 ! receive 249 sn_rcv_w10m = FLD_C( 'none' , 'no' , '' , '' , '' ) 250 sn_rcv_taumod = FLD_C( 'coupled' , 'no' , '' , '' , '' ) 251 sn_rcv_tau = FLD_C( 'oce only' , 'no' , 'cartesian' , 'eastward-northward', 'U,V' ) 252 sn_rcv_dqnsdt = FLD_C( 'coupled' , 'no' , '' , '' , '' ) 253 sn_rcv_qsr = FLD_C( 'oce and ice' , 'no' , '' , '' , '' ) 254 sn_rcv_qns = FLD_C( 'oce and ice' , 'no' , '' , '' , '' ) 255 sn_rcv_emp = FLD_C( 'conservative' , 'no' , '' , '' , '' ) 256 sn_rcv_rnf = FLD_C( 'coupled' , 'no' , '' , '' , '' ) 257 sn_rcv_cal = FLD_C( 'coupled' , 'no' , '' , '' , '' ) 258 sn_rcv_iceflx = FLD_C( 'none' , 'no' , '' , '' , '' ) 259 sn_rcv_co2 = FLD_C( 'none' , 'no' , '' , '' , '' ) 232 260 233 261 REWIND( numnam ) ! ... read namlist namsbc_cpl … … 238 266 WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist ' 239 267 WRITE(numout,*)'~~~~~~~~~~~~' 240 WRITE(numout,*)' received fields' 241 WRITE(numout,*)' 10m wind module cn_rcv_w10m = ', cn_rcv_w10m 242 WRITE(numout,*)' surface stress - nature cn_rcv_tau_nature = ', cn_rcv_tau_nature 243 WRITE(numout,*)' - referential cn_rcv_tau_refere = ', cn_rcv_tau_refere 244 WRITE(numout,*)' - orientation cn_rcv_tau_orient = ', cn_rcv_tau_orient 245 WRITE(numout,*)' - mesh cn_rcv_tau_grid = ', cn_rcv_tau_grid 246 WRITE(numout,*)' non-solar heat flux sensitivity cn_rcv_dqnsdt = ', cn_rcv_dqnsdt 247 WRITE(numout,*)' solar heat flux cn_rcv_qsr = ', cn_rcv_qsr 248 WRITE(numout,*)' non-solar heat flux cn_rcv_qns = ', cn_rcv_qns 249 WRITE(numout,*)' freshwater budget cn_rcv_emp = ', cn_rcv_emp 250 WRITE(numout,*)' runoffs cn_rcv_rnf = ', cn_rcv_rnf 251 WRITE(numout,*)' calving cn_rcv_cal = ', cn_rcv_cal 252 WRITE(numout,*)' stress module cn_rcv_taumod = ', cn_rcv_taumod 253 WRITE(numout,*)' sent fields' 254 WRITE(numout,*)' surface temperature cn_snd_temperature = ', cn_snd_temperature 255 WRITE(numout,*)' albedo cn_snd_albedo = ', cn_snd_albedo 256 WRITE(numout,*)' ice/snow thickness cn_snd_thickness = ', cn_snd_thickness 257 WRITE(numout,*)' surface current - nature cn_snd_crt_nature = ', cn_snd_crt_nature 258 WRITE(numout,*)' - referential cn_snd_crt_refere = ', cn_snd_crt_refere 259 WRITE(numout,*)' - orientation cn_snd_crt_orient = ', cn_snd_crt_orient 260 WRITE(numout,*)' - mesh cn_snd_crt_grid = ', cn_snd_crt_grid 261 ENDIF 262 263 #if defined key_cpl_carbon_cycle 264 REWIND( numnam ) ! read namlist namsbc_cpl_co2 265 READ ( numnam, namsbc_cpl_co2 ) 266 IF(lwp) THEN ! control print 267 WRITE(numout,*) 268 WRITE(numout,*)'sbc_cpl_init : namsbc_cpl_co2 namelist ' 269 WRITE(numout,*)'~~~~~~~~~~~~' 270 WRITE(numout,*)' received fields' 271 WRITE(numout,*)' atm co2 cn_rcv_co2 = ', cn_rcv_co2 272 WRITE(numout,*)' sent fields' 273 WRITE(numout,*)' oce co2 flux cn_snd_co2 = ', cn_snd_co2 274 WRITE(numout,*) 275 ENDIF 276 #endif 277 ! save current & stress in an array and suppress possible blank in the name 278 cn_snd_crt(1) = TRIM( cn_snd_crt_nature ) ; cn_snd_crt(2) = TRIM( cn_snd_crt_refere ) 279 cn_snd_crt(3) = TRIM( cn_snd_crt_orient ) ; cn_snd_crt(4) = TRIM( cn_snd_crt_grid ) 280 cn_rcv_tau(1) = TRIM( cn_rcv_tau_nature ) ; cn_rcv_tau(2) = TRIM( cn_rcv_tau_refere ) 281 cn_rcv_tau(3) = TRIM( cn_rcv_tau_orient ) ; cn_rcv_tau(4) = TRIM( cn_rcv_tau_grid ) 282 283 ! ! allocate zdfric arrays 268 WRITE(numout,*)' received fields (mutiple ice categogies)' 269 WRITE(numout,*)' 10m wind module = ', TRIM(sn_rcv_w10m%cldes ), ' (', TRIM(sn_rcv_w10m%clcat ), ')' 270 WRITE(numout,*)' stress module = ', TRIM(sn_rcv_taumod%cldes), ' (', TRIM(sn_rcv_taumod%clcat), ')' 271 WRITE(numout,*)' surface stress = ', TRIM(sn_rcv_tau%cldes ), ' (', TRIM(sn_rcv_tau%clcat ), ')' 272 WRITE(numout,*)' - referential = ', sn_rcv_tau%clvref 273 WRITE(numout,*)' - orientation = ', sn_rcv_tau%clvor 274 WRITE(numout,*)' - mesh = ', sn_rcv_tau%clvgrd 275 WRITE(numout,*)' non-solar heat flux sensitivity = ', TRIM(sn_rcv_dqnsdt%cldes), ' (', TRIM(sn_rcv_dqnsdt%clcat), ')' 276 WRITE(numout,*)' solar heat flux = ', TRIM(sn_rcv_qsr%cldes ), ' (', TRIM(sn_rcv_qsr%clcat ), ')' 277 WRITE(numout,*)' non-solar heat flux = ', TRIM(sn_rcv_qns%cldes ), ' (', TRIM(sn_rcv_qns%clcat ), ')' 278 WRITE(numout,*)' freshwater budget = ', TRIM(sn_rcv_emp%cldes ), ' (', TRIM(sn_rcv_emp%clcat ), ')' 279 WRITE(numout,*)' runoffs = ', TRIM(sn_rcv_rnf%cldes ), ' (', TRIM(sn_rcv_rnf%clcat ), ')' 280 WRITE(numout,*)' calving = ', TRIM(sn_rcv_cal%cldes ), ' (', TRIM(sn_rcv_cal%clcat ), ')' 281 WRITE(numout,*)' sea ice heat fluxes = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 282 WRITE(numout,*)' atm co2 = ', TRIM(sn_rcv_co2%cldes ), ' (', TRIM(sn_rcv_co2%clcat ), ')' 283 WRITE(numout,*)' sent fields (multiple ice categories)' 284 WRITE(numout,*)' surface temperature = ', TRIM(sn_snd_temp%cldes ), ' (', TRIM(sn_snd_temp%clcat ), ')' 285 WRITE(numout,*)' albedo = ', TRIM(sn_snd_alb%cldes ), ' (', TRIM(sn_snd_alb%clcat ), ')' 286 WRITE(numout,*)' ice/snow thickness = ', TRIM(sn_snd_thick%cldes ), ' (', TRIM(sn_snd_thick%clcat ), ')' 287 WRITE(numout,*)' surface current = ', TRIM(sn_snd_crt%cldes ), ' (', TRIM(sn_snd_crt%clcat ), ')' 288 WRITE(numout,*)' - referential = ', sn_snd_crt%clvref 289 WRITE(numout,*)' - orientation = ', sn_snd_crt%clvor 290 WRITE(numout,*)' - mesh = ', sn_snd_crt%clvgrd 291 WRITE(numout,*)' oce co2 flux = ', TRIM(sn_snd_co2%cldes ), ' (', TRIM(sn_snd_co2%clcat ), ')' 292 ENDIF 293 294 ! ! allocate sbccpl arrays 284 295 IF( sbc_cpl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 285 296 … … 294 305 295 306 ! default definitions of srcv 296 srcv(:)%laction = .FALSE. ; srcv(:)%clgrid = 'T' ; srcv(:)%nsgn = 1. 307 srcv(:)%laction = .FALSE. ; srcv(:)%clgrid = 'T' ; srcv(:)%nsgn = 1. ; srcv(:)%nct = 1 297 308 298 309 ! ! ------------------------- ! … … 315 326 ! 316 327 ! Vectors: change of sign at north fold ONLY if on the local grid 317 IF( TRIM( cn_rcv_tau(3)) == 'local grid' ) srcv(jpr_otx1:jpr_itz2)%nsgn = -1.328 IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' ) srcv(jpr_otx1:jpr_itz2)%nsgn = -1. 318 329 319 330 ! ! Set grid and action 320 SELECT CASE( TRIM( cn_rcv_tau(4)) ) ! 'T', 'U,V', 'U,V,I', 'U,V,F', 'T,I', 'T,F', or 'T,U,V'331 SELECT CASE( TRIM( sn_rcv_tau%clvgrd ) ) ! 'T', 'U,V', 'U,V,I', 'U,V,F', 'T,I', 'T,F', or 'T,U,V' 321 332 CASE( 'T' ) 322 333 srcv(jpr_otx1:jpr_itz2)%clgrid = 'T' ! oce and ice components given at T-point … … 364 375 srcv(jpr_itx1:jpr_itz2)%laction = .TRUE. ! receive ice components on grid 1 & 2 365 376 CASE default 366 CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_tau(4)' )377 CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_tau%clvgrd' ) 367 378 END SELECT 368 379 ! 369 IF( TRIM( cn_rcv_tau(2)) == 'spherical' ) & ! spherical: 3rd component not received380 IF( TRIM( sn_rcv_tau%clvref ) == 'spherical' ) & ! spherical: 3rd component not received 370 381 & srcv( (/jpr_otz1, jpr_otz2, jpr_itz1, jpr_itz2/) )%laction = .FALSE. 371 382 ! 372 IF( TRIM( cn_rcv_tau(1)) /= 'oce and ice' ) THEN ! 'oce and ice' case ocean stress on ocean mesh used383 IF( TRIM( sn_rcv_tau%cldes ) /= 'oce and ice' ) THEN ! 'oce and ice' case ocean stress on ocean mesh used 373 384 srcv(jpr_itx1:jpr_itz2)%laction = .FALSE. ! ice components not received 374 385 srcv(jpr_itx1)%clgrid = 'U' ! ocean stress used after its transformation … … 388 399 srcv(jpr_semp)%clname = 'OISubMSn' ! ice solid water budget = sublimation - solid precipitation 389 400 srcv(jpr_oemp)%clname = 'OOEvaMPr' ! ocean water budget = ocean Evap - ocean precip 390 SELECT CASE( TRIM( cn_rcv_emp) )401 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 391 402 CASE( 'oce only' ) ; srcv( jpr_oemp )%laction = .TRUE. 392 403 CASE( 'conservative' ) ; srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE. 393 404 CASE( 'oce and ice' ) ; srcv( (/jpr_ievp, jpr_sbpr, jpr_semp, jpr_oemp/) )%laction = .TRUE. 394 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_emp' )405 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' ) 395 406 END SELECT 396 407 … … 398 409 ! ! Runoffs & Calving ! 399 410 ! ! ------------------------- ! 400 srcv(jpr_rnf )%clname = 'O_Runoff' ; IF( TRIM( cn_rcv_rnf ) == 'coupled' ) srcv(jpr_rnf)%laction = .TRUE. 401 IF( TRIM( cn_rcv_rnf ) == 'climato' ) THEN ; ln_rnf = .TRUE. 402 ELSE ; ln_rnf = .FALSE. 403 ENDIF 404 srcv(jpr_cal )%clname = 'OCalving' ; IF( TRIM( cn_rcv_cal ) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE. 411 srcv(jpr_rnf )%clname = 'O_Runoff' ; IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) srcv(jpr_rnf)%laction = .TRUE. 412 ! This isn't right - really just want ln_rnf_emp changed 413 ! IF( TRIM( sn_rcv_rnf%cldes ) == 'climato' ) THEN ; ln_rnf = .TRUE. 414 ! ELSE ; ln_rnf = .FALSE. 415 ! ENDIF 416 srcv(jpr_cal )%clname = 'OCalving' ; IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE. 405 417 406 418 ! ! ------------------------- ! … … 410 422 srcv(jpr_qnsice)%clname = 'O_QnsIce' 411 423 srcv(jpr_qnsmix)%clname = 'O_QnsMix' 412 SELECT CASE( TRIM( cn_rcv_qns ) )424 SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) 413 425 CASE( 'oce only' ) ; srcv( jpr_qnsoce )%laction = .TRUE. 414 426 CASE( 'conservative' ) ; srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE. 415 427 CASE( 'oce and ice' ) ; srcv( (/jpr_qnsice, jpr_qnsoce/) )%laction = .TRUE. 416 428 CASE( 'mixed oce-ice' ) ; srcv( jpr_qnsmix )%laction = .TRUE. 417 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_qns' )429 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qns%cldes' ) 418 430 END SELECT 419 431 IF( TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' .AND. jpl > 1 ) & 432 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qns%cldes not currently allowed to be mixed oce-ice for multi-category ice' ) 420 433 ! ! ------------------------- ! 421 434 ! ! solar radiation ! Qsr … … 424 437 srcv(jpr_qsrice)%clname = 'O_QsrIce' 425 438 srcv(jpr_qsrmix)%clname = 'O_QsrMix' 426 SELECT CASE( TRIM( cn_rcv_qsr) )439 SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) 427 440 CASE( 'oce only' ) ; srcv( jpr_qsroce )%laction = .TRUE. 428 441 CASE( 'conservative' ) ; srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE. 429 442 CASE( 'oce and ice' ) ; srcv( (/jpr_qsrice, jpr_qsroce/) )%laction = .TRUE. 430 443 CASE( 'mixed oce-ice' ) ; srcv( jpr_qsrmix )%laction = .TRUE. 431 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_qsr' )444 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qsr%cldes' ) 432 445 END SELECT 433 446 IF( TRIM( sn_rcv_qsr%cldes ) == 'mixed oce-ice' .AND. jpl > 1 ) & 447 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qsr%cldes not currently allowed to be mixed oce-ice for multi-category ice' ) 434 448 ! ! ------------------------- ! 435 449 ! ! non solar sensitivity ! d(Qns)/d(T) 436 450 ! ! ------------------------- ! 437 451 srcv(jpr_dqnsdt)%clname = 'O_dQnsdT' 438 IF( TRIM( cn_rcv_dqnsdt) == 'coupled' ) srcv(jpr_dqnsdt)%laction = .TRUE.439 ! 440 ! non solar sensitivity mandatory for ice model441 IF( TRIM( cn_rcv_dqnsdt ) == 'none' .AND. k_ice /= 0) &442 CALL ctl_stop( 'sbc_cpl_init: cn_rcv_dqnsdtmust be coupled in namsbc_cpl namelist' )452 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'coupled' ) srcv(jpr_dqnsdt)%laction = .TRUE. 453 ! 454 ! non solar sensitivity mandatory for LIM ice model 455 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4) & 456 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' ) 443 457 ! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique 444 IF( TRIM( cn_rcv_dqnsdt ) == 'none' .AND. TRIM( cn_rcv_qns ) == 'mixed oce-ice' ) &445 CALL ctl_stop( 'sbc_cpl_init: namsbc_cpl namelist mismatch between cn_rcv_qns and cn_rcv_dqnsdt' )458 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' ) & 459 CALL ctl_stop( 'sbc_cpl_init: namsbc_cpl namelist mismatch between sn_rcv_qns%cldes and sn_rcv_dqnsdt%cldes' ) 446 460 ! ! ------------------------- ! 447 461 ! ! Ice Qsr penetration ! … … 456 470 ! ! 10m wind module ! 457 471 ! ! ------------------------- ! 458 srcv(jpr_w10m)%clname = 'O_Wind10' ; IF( TRIM( cn_rcv_w10m) == 'coupled' ) srcv(jpr_w10m)%laction = .TRUE.472 srcv(jpr_w10m)%clname = 'O_Wind10' ; IF( TRIM(sn_rcv_w10m%cldes ) == 'coupled' ) srcv(jpr_w10m)%laction = .TRUE. 459 473 ! 460 474 ! ! ------------------------- ! 461 475 ! ! wind stress module ! 462 476 ! ! ------------------------- ! 463 srcv(jpr_taum)%clname = 'O_TauMod' ; IF( TRIM( cn_rcv_taumod) == 'coupled' ) srcv(jpr_taum)%laction = .TRUE.477 srcv(jpr_taum)%clname = 'O_TauMod' ; IF( TRIM(sn_rcv_taumod%cldes) == 'coupled' ) srcv(jpr_taum)%laction = .TRUE. 464 478 lhftau = srcv(jpr_taum)%laction 465 479 466 #if defined key_cpl_carbon_cycle467 480 ! ! ------------------------- ! 468 481 ! ! Atmospheric CO2 ! 469 482 ! ! ------------------------- ! 470 srcv(jpr_co2 )%clname = 'O_AtmCO2' ; IF( TRIM(cn_rcv_co2 ) == 'coupled' ) srcv(jpr_co2 )%laction = .TRUE. 471 #endif 472 483 srcv(jpr_co2 )%clname = 'O_AtmCO2' ; IF( TRIM(sn_rcv_co2%cldes ) == 'coupled' ) srcv(jpr_co2 )%laction = .TRUE. 484 ! ! ------------------------- ! 485 ! ! topmelt and botmelt ! 486 ! ! ------------------------- ! 487 srcv(jpr_topm )%clname = 'OTopMlt' 488 srcv(jpr_botm )%clname = 'OBotMlt' 489 IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN 490 IF ( TRIM( sn_rcv_iceflx%clcat ) == 'yes' ) THEN 491 srcv(jpr_topm:jpr_botm)%nct = jpl 492 ELSE 493 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_iceflx%clcat should always be set to yes currently' ) 494 ENDIF 495 srcv(jpr_topm:jpr_botm)%laction = .TRUE. 496 ENDIF 497 498 ! Allocate all parts of frcv used for received fields 499 DO jn = 1, jprcv 500 IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 501 END DO 502 ! Allocate taum part of frcv which is used even when not received as coupling field 503 IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jn)%nct) ) 504 473 505 ! ================================ ! 474 506 ! Define the send interface ! 475 507 ! ================================ ! 476 ! for each field: define the OASIS name (s rcv(:)%clname)477 ! define send or not from the namelist parameters (s rcv(:)%laction)478 ! define the north fold type of lbc (s rcv(:)%nsgn)508 ! for each field: define the OASIS name (ssnd(:)%clname) 509 ! define send or not from the namelist parameters (ssnd(:)%laction) 510 ! define the north fold type of lbc (ssnd(:)%nsgn) 479 511 480 512 ! default definitions of nsnd 481 ssnd(:)%laction = .FALSE. ; ssnd(:)%clgrid = 'T' ; ssnd(:)%nsgn = 1. 513 ssnd(:)%laction = .FALSE. ; ssnd(:)%clgrid = 'T' ; ssnd(:)%nsgn = 1. ; ssnd(:)%nct = 1 482 514 483 515 ! ! ------------------------- ! … … 487 519 ssnd(jps_tice)%clname = 'O_TepIce' 488 520 ssnd(jps_tmix)%clname = 'O_TepMix' 489 SELECT CASE( TRIM( cn_snd_temperature) )521 SELECT CASE( TRIM( sn_snd_temp%cldes ) ) 490 522 CASE( 'oce only' ) ; ssnd( jps_toce )%laction = .TRUE. 491 CASE( 'weighted oce and ice' ) ; ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 523 CASE( 'weighted oce and ice' ) 524 ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 525 IF ( TRIM( sn_snd_temp%clcat ) == 'yes' ) ssnd(jps_tice)%nct = jpl 492 526 CASE( 'mixed oce-ice' ) ; ssnd( jps_tmix )%laction = .TRUE. 493 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_snd_temperature' )527 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' ) 494 528 END SELECT 495 529 … … 499 533 ssnd(jps_albice)%clname = 'O_AlbIce' 500 534 ssnd(jps_albmix)%clname = 'O_AlbMix' 501 SELECT CASE( TRIM( cn_snd_albedo) )535 SELECT CASE( TRIM( sn_snd_alb%cldes ) ) 502 536 CASE( 'none' ) ! nothing to do 503 537 CASE( 'weighted ice' ) ; ssnd(jps_albice)%laction = .TRUE. 504 538 CASE( 'mixed oce-ice' ) ; ssnd(jps_albmix)%laction = .TRUE. 505 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_snd_albedo' )539 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_alb%cldes' ) 506 540 END SELECT 507 541 ! … … 509 543 ! 1. sending mixed oce-ice albedo or 510 544 ! 2. receiving mixed oce-ice solar radiation 511 IF ( TRIM ( cn_snd_albedo ) == 'mixed oce-ice' .OR. TRIM ( cn_rcv_qsr) == 'mixed oce-ice' ) THEN545 IF ( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN 512 546 CALL albedo_oce( zaos, zacs ) 513 547 ! Due to lack of information on nebulosity : mean clear/overcast sky … … 518 552 ! ! Ice fraction & Thickness ! 519 553 ! ! ------------------------- ! 520 ssnd(jps_fice)%clname = 'OIceFrac' 521 ssnd(jps_hice)%clname = 'O_IceTck' 522 ssnd(jps_hsnw)%clname = 'O_SnwTck' 523 IF( k_ice /= 0 ) ssnd(jps_fice)%laction = .TRUE. ! if ice treated in the ocean (even in climato case) 524 IF( TRIM( cn_snd_thickness ) == 'weighted ice and snow' ) ssnd( (/jps_hice, jps_hsnw/) )%laction = .TRUE. 525 554 ssnd(jps_fice)%clname = 'OIceFrc' 555 ssnd(jps_hice)%clname = 'OIceTck' 556 ssnd(jps_hsnw)%clname = 'OSnwTck' 557 IF( k_ice /= 0 ) THEN 558 ssnd(jps_fice)%laction = .TRUE. ! if ice treated in the ocean (even in climato case) 559 ! Currently no namelist entry to determine sending of multi-category ice fraction so use the thickness entry for now 560 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl 561 ENDIF 562 563 SELECT CASE ( TRIM( sn_snd_thick%cldes ) ) 564 CASE ( 'ice and snow' ) 565 ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 566 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN 567 ssnd(jps_hice:jps_hsnw)%nct = jpl 568 ELSE 569 IF ( jpl > 1 ) THEN 570 CALL ctl_stop( 'sbc_cpl_init: use weighted ice and snow option for sn_snd_thick%cldes if not exchanging category fields' ) 571 ENDIF 572 ENDIF 573 CASE ( 'weighted ice and snow' ) 574 ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 575 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hice:jps_hsnw)%nct = jpl 576 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_thick%cldes' ) 577 END SELECT 578 526 579 ! ! ------------------------- ! 527 580 ! ! Surface current ! … … 534 587 ssnd(jps_ocx1:jps_ivz1)%nsgn = -1. ! vectors: change of the sign at the north fold 535 588 536 IF( cn_snd_crt(4) /= 'T' ) CALL ctl_stop( 'cn_snd_crt(4) must be equal to T' ) 537 ssnd(jps_ocx1:jps_ivz1)%clgrid = 'T' ! all oce and ice components on the same unique grid 538 589 IF( sn_snd_crt%clvgrd == 'U,V' ) THEN 590 ssnd(jps_ocx1)%clgrid = 'U' ; ssnd(jps_ocy1)%clgrid = 'V' 591 ELSE IF( sn_snd_crt%clvgrd /= 'T' ) THEN 592 CALL ctl_stop( 'sn_snd_crt%clvgrd must be equal to T' ) 593 ssnd(jps_ocx1:jps_ivz1)%clgrid = 'T' ! all oce and ice components on the same unique grid 594 ENDIF 539 595 ssnd(jps_ocx1:jps_ivz1)%laction = .TRUE. ! default: all are send 540 IF( TRIM( cn_snd_crt(2) ) == 'spherical' ) ssnd( (/jps_ocz1, jps_ivz1/) )%laction = .FALSE. 541 SELECT CASE( TRIM( cn_snd_crt(1) ) ) 596 IF( TRIM( sn_snd_crt%clvref ) == 'spherical' ) ssnd( (/jps_ocz1, jps_ivz1/) )%laction = .FALSE. 597 IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) ssnd(jps_ocx1:jps_ivz1)%nsgn = 1. 598 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 542 599 CASE( 'none' ) ; ssnd(jps_ocx1:jps_ivz1)%laction = .FALSE. 543 600 CASE( 'oce only' ) ; ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE. 544 601 CASE( 'weighted oce and ice' ) ! nothing to do 545 602 CASE( 'mixed oce-ice' ) ; ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE. 546 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_snd_crt(1)' )603 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_crt%cldes' ) 547 604 END SELECT 548 605 549 #if defined key_cpl_carbon_cycle550 606 ! ! ------------------------- ! 551 607 ! ! CO2 flux ! 552 608 ! ! ------------------------- ! 553 ssnd(jps_co2)%clname = 'O_CO2FLX' ; IF( TRIM(cn_snd_co2) == 'coupled' ) ssnd(jps_co2 )%laction = .TRUE. 554 #endif 609 ssnd(jps_co2)%clname = 'O_CO2FLX' ; IF( TRIM(sn_snd_co2%cldes) == 'coupled' ) ssnd(jps_co2 )%laction = .TRUE. 555 610 ! 556 611 ! ================================ ! … … 636 691 isec = ( kt - nit000 ) * NINT( rdttra(1) ) ! date of exchanges 637 692 DO jn = 1, jprcv ! received fields sent by the atmosphere 638 IF( srcv(jn)%laction ) CALL cpl_prism_rcv( jn, isec, frcv( :,:,jn), nrcvinfo(jn) )693 IF( srcv(jn)%laction ) CALL cpl_prism_rcv( jn, isec, frcv(jn)%z3, nrcvinfo(jn) ) 639 694 END DO 640 695 … … 642 697 IF( srcv(jpr_otx1)%laction ) THEN ! ocean stress components ! 643 698 ! ! ========================= ! 644 ! define frcv( :,:,jpr_otx1) and frcv(:,:,jpr_oty1): stress at U/V point along model grid699 ! define frcv(jpr_otx1)%z3(:,:,1) and frcv(jpr_oty1)%z3(:,:,1): stress at U/V point along model grid 645 700 ! => need to be done only when we receive the field 646 701 IF( nrcvinfo(jpr_otx1) == OASIS_Rcv ) THEN 647 702 ! 648 IF( TRIM( cn_rcv_tau(2)) == 'cartesian' ) THEN ! 2 components on the sphere703 IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN ! 2 components on the sphere 649 704 ! ! (cartesian to spherical -> 3 to 2 components) 650 705 ! 651 CALL geo2oce( frcv( :,:,jpr_otx1), frcv(:,:,jpr_oty1), frcv(:,:,jpr_otz1), &706 CALL geo2oce( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), frcv(jpr_otz1)%z3(:,:,1), & 652 707 & srcv(jpr_otx1)%clgrid, ztx, zty ) 653 frcv( :,:,jpr_otx1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid654 frcv( :,:,jpr_oty1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid708 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid 709 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid 655 710 ! 656 711 IF( srcv(jpr_otx2)%laction ) THEN 657 CALL geo2oce( frcv( :,:,jpr_otx2), frcv(:,:,jpr_oty2), frcv(:,:,jpr_otz2), &712 CALL geo2oce( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), frcv(jpr_otz2)%z3(:,:,1), & 658 713 & srcv(jpr_otx2)%clgrid, ztx, zty ) 659 frcv( :,:,jpr_otx2) = ztx(:,:) ! overwrite 1st comp. on the 2nd grid660 frcv( :,:,jpr_oty2) = zty(:,:) ! overwrite 2nd comp. on the 2nd grid714 frcv(jpr_otx2)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 2nd grid 715 frcv(jpr_oty2)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 2nd grid 661 716 ENDIF 662 717 ! 663 718 ENDIF 664 719 ! 665 IF( TRIM( cn_rcv_tau(3)) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid720 IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid 666 721 ! ! (geographical to local grid -> rotate the components) 667 CALL rot_rep( frcv( :,:,jpr_otx1), frcv(:,:,jpr_oty1), srcv(jpr_otx1)%clgrid, 'en->i', ztx )668 frcv( :,:,jpr_otx1) = ztx(:,:) ! overwrite 1st component on the 1st grid722 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) 723 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid 669 724 IF( srcv(jpr_otx2)%laction ) THEN 670 CALL rot_rep( frcv( :,:,jpr_otx2), frcv(:,:,jpr_oty2), srcv(jpr_otx2)%clgrid, 'en->j', zty )671 ELSE 672 CALL rot_rep( frcv( :,:,jpr_otx1), frcv(:,:,jpr_oty1), srcv(jpr_otx1)%clgrid, 'en->j', zty )725 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) 726 ELSE 727 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 673 728 ENDIF 674 frcv( :,:,jpr_oty1) = zty(:,:) ! overwrite 2nd component on the 2nd grid729 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid 675 730 ENDIF 676 731 ! … … 678 733 DO jj = 2, jpjm1 ! T ==> (U,V) 679 734 DO ji = fs_2, fs_jpim1 ! vector opt. 680 frcv(j i,jj,jpr_otx1) = 0.5 * ( frcv(ji+1,jj ,jpr_otx1) + frcv(ji,jj,jpr_otx1) )681 frcv(j i,jj,jpr_oty1) = 0.5 * ( frcv(ji ,jj+1,jpr_oty1) + frcv(ji,jj,jpr_oty1) )735 frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) ) 736 frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) ) 682 737 END DO 683 738 END DO 684 CALL lbc_lnk( frcv( :,:,jpr_otx1), 'U', -1. ) ; CALL lbc_lnk( frcv(:,:,jpr_oty1), 'V', -1. )739 CALL lbc_lnk( frcv(jpr_otx1)%z3(:,:,1), 'U', -1. ) ; CALL lbc_lnk( frcv(jpr_oty1)%z3(:,:,1), 'V', -1. ) 685 740 ENDIF 686 741 llnewtx = .TRUE. … … 691 746 ELSE ! No dynamical coupling ! 692 747 ! ! ========================= ! 693 frcv( :,:,jpr_otx1) = 0.e0 ! here simply set to zero694 frcv( :,:,jpr_oty1) = 0.e0 ! an external read in a file can be added instead748 frcv(jpr_otx1)%z3(:,:,1) = 0.e0 ! here simply set to zero 749 frcv(jpr_oty1)%z3(:,:,1) = 0.e0 ! an external read in a file can be added instead 695 750 llnewtx = .TRUE. 696 751 ! … … 708 763 !CDIR NOVERRCHK 709 764 DO ji = fs_2, fs_jpim1 ! vect. opt. 710 zzx = frcv(j i-1,jj ,jpr_otx1) + frcv(ji,jj,jpr_otx1)711 zzy = frcv(j i ,jj-1,jpr_oty1) + frcv(ji,jj,jpr_oty1)712 frcv(j i,jj,jpr_taum) = 0.5 * SQRT( zzx * zzx + zzy * zzy )765 zzx = frcv(jpr_otx1)%z3(ji-1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) 766 zzy = frcv(jpr_oty1)%z3(ji ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1) 767 frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy ) 713 768 END DO 714 769 END DO 715 CALL lbc_lnk( frcv( :,:,jpr_taum), 'T', 1. )770 CALL lbc_lnk( frcv(jpr_taum)%z3(:,:,1), 'T', 1. ) 716 771 llnewtau = .TRUE. 717 772 ELSE … … 722 777 ! Stress module can be negative when received (interpolation problem) 723 778 IF( llnewtau ) THEN 724 DO jj = 1, jpj 725 DO ji = 1, jpi 726 frcv(ji,jj,jpr_taum) = MAX( 0.0e0, frcv(ji,jj,jpr_taum) ) 727 END DO 728 END DO 779 frcv(jpr_taum)%z3(:,:,1) = MAX( 0.0e0, frcv(jpr_taum)%z3(:,:,1) ) 729 780 ENDIF 730 781 ENDIF … … 742 793 !CDIR NOVERRCHK 743 794 DO ji = 1, jpi 744 frcv(ji,jj,jpr_w10m) = SQRT( frcv(ji,jj,jpr_taum) * zcoef )795 wndm(ji,jj) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 745 796 END DO 746 797 END DO 747 798 ENDIF 748 ENDIF 749 750 ! u(v)tau and taum will be modified by ice model (wndm will be changed by PISCES) 799 ELSE 800 IF ( nrcvinfo(jpr_w10m) == OASIS_Rcv ) wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1) 801 ENDIF 802 803 ! u(v)tau and taum will be modified by ice model 751 804 ! -> need to be reset before each call of the ice/fsbc 752 805 IF( MOD( kt-1, k_fsbc ) == 0 ) THEN 753 806 ! 754 utau(:,:) = frcv(:,:,jpr_otx1) 755 vtau(:,:) = frcv(:,:,jpr_oty1) 756 taum(:,:) = frcv(:,:,jpr_taum) 757 wndm(:,:) = frcv(:,:,jpr_w10m) 807 utau(:,:) = frcv(jpr_otx1)%z3(:,:,1) 808 vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1) 809 taum(:,:) = frcv(jpr_taum)%z3(:,:,1) 758 810 CALL iom_put( "taum_oce", taum ) ! output wind stress module 759 811 ! 760 812 ENDIF 813 814 #if defined key_cpl_carbon_cycle 815 ! ! atmosph. CO2 (ppm) 816 IF( srcv(jpr_co2)%laction ) atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 817 #endif 818 761 819 ! ! ========================= ! 762 820 IF( k_ice <= 1 ) THEN ! heat & freshwater fluxes ! (Ocean only case) … … 764 822 ! 765 823 ! ! non solar heat flux over the ocean (qns) 766 IF( srcv(jpr_qnsoce)%laction ) qns(:,:) = frcv( :,:,jpr_qnsoce)767 IF( srcv(jpr_qnsmix)%laction ) qns(:,:) = frcv( :,:,jpr_qnsmix)824 IF( srcv(jpr_qnsoce)%laction ) qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 825 IF( srcv(jpr_qnsmix)%laction ) qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 768 826 ! add the latent heat of solid precip. melting 769 IF( srcv(jpr_snow )%laction ) qns(:,:) = qns(:,:) - frcv( :,:,jpr_snow) * lfus827 IF( srcv(jpr_snow )%laction ) qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus 770 828 771 829 ! ! solar flux over the ocean (qsr) 772 IF( srcv(jpr_qsroce)%laction ) qsr(:,:) = frcv( :,:,jpr_qsroce)773 IF( srcv(jpr_qsrmix)%laction ) qsr(:,:) = frcv( :,:,jpr_qsrmix)830 IF( srcv(jpr_qsroce)%laction ) qsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) 831 IF( srcv(jpr_qsrmix)%laction ) qsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1) 774 832 IF( ln_dm2dc ) qsr(:,:) = sbc_dcy( qsr ) ! modify qsr to include the diurnal cycle 775 833 ! 776 834 ! ! total freshwater fluxes over the ocean (emp, emps) 777 SELECT CASE( TRIM( cn_rcv_emp) ) ! evaporation - precipitation835 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) ! evaporation - precipitation 778 836 CASE( 'conservative' ) 779 emp(:,:) = frcv( :,:,jpr_tevp) - ( frcv(:,:,jpr_rain) + frcv(:,:,jpr_snow) )837 emp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) ) 780 838 CASE( 'oce only', 'oce and ice' ) 781 emp(:,:) = frcv( :,:,jpr_oemp)839 emp(:,:) = frcv(jpr_oemp)%z3(:,:,1) 782 840 CASE default 783 CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of cn_rcv_emp' )841 CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' ) 784 842 END SELECT 785 843 ! 786 844 ! ! runoffs and calving (added in emp) 787 IF( srcv(jpr_rnf)%laction ) emp(:,:) = emp(:,:) - frcv( :,:,jpr_rnf)788 IF( srcv(jpr_cal)%laction ) emp(:,:) = emp(:,:) - frcv( :,:,jpr_cal)845 IF( srcv(jpr_rnf)%laction ) emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 846 IF( srcv(jpr_cal)%laction ) emp(:,:) = emp(:,:) - frcv(jpr_cal)%z3(:,:,1) 789 847 ! 790 848 !!gm : this seems to be internal cooking, not sure to need that in a generic interface 791 849 !!gm at least should be optional... 792 !! IF( TRIM( cn_rcv_rnf) == 'coupled' ) THEN ! add to the total freshwater budget850 !! IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN ! add to the total freshwater budget 793 851 !! ! remove negative runoff 794 !! zcumulpos = SUM( MAX( frcv( :,:,jpr_rnf), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )795 !! zcumulneg = SUM( MIN( frcv( :,:,jpr_rnf), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )852 !! zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 853 !! zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 796 854 !! IF( lk_mpp ) CALL mpp_sum( zcumulpos ) ! sum over the global domain 797 855 !! IF( lk_mpp ) CALL mpp_sum( zcumulneg ) 798 856 !! IF( zcumulpos /= 0. ) THEN ! distribute negative runoff on positive runoff grid points 799 857 !! zcumulneg = 1.e0 + zcumulneg / zcumulpos 800 !! frcv( :,:,jpr_rnf) = MAX( frcv(:,:,jpr_rnf), 0.e0 ) * zcumulneg858 !! frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg 801 859 !! ENDIF 802 860 !! ! add runoff to e-p 803 !! emp(:,:) = emp(:,:) - frcv( :,:,jpr_rnf)861 !! emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 804 862 !! ENDIF 805 863 !!gm end of internal cooking … … 807 865 emps(:,:) = emp(:,:) ! concentration/dilution = emp 808 866 809 ! ! 10 m wind speed810 IF( srcv(jpr_w10m)%laction ) wndm(:,:) = frcv(:,:,jpr_w10m)811 !812 #if defined key_cpl_carbon_cycle813 ! ! atmosph. CO2 (ppm)814 IF( srcv(jpr_co2)%laction ) atm_co2(:,:) = frcv(:,:,jpr_co2)815 #endif816 817 867 ENDIF 818 868 ! … … 880 930 ! ! ======================= ! 881 931 ! 882 IF( TRIM( cn_rcv_tau(2)) == 'cartesian' ) THEN ! 2 components on the sphere932 IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN ! 2 components on the sphere 883 933 ! ! (cartesian to spherical -> 3 to 2 components) 884 CALL geo2oce( frcv(:,:,jpr_itx1), frcv(:,:,jpr_ity1), frcv(:,:,jpr_itz1), &934 CALL geo2oce( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), frcv(jpr_itz1)%z3(:,:,1), & 885 935 & srcv(jpr_itx1)%clgrid, ztx, zty ) 886 frcv( :,:,jpr_itx1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid887 frcv( :,:,jpr_itx1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid936 frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 1st grid 937 frcv(jpr_ity1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 1st grid 888 938 ! 889 939 IF( srcv(jpr_itx2)%laction ) THEN 890 CALL geo2oce( frcv( :,:,jpr_itx2), frcv(:,:,jpr_ity2), frcv(:,:,jpr_itz2), &940 CALL geo2oce( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), frcv(jpr_itz2)%z3(:,:,1), & 891 941 & srcv(jpr_itx2)%clgrid, ztx, zty ) 892 frcv( :,:,jpr_itx2) = ztx(:,:) ! overwrite 1st comp. on the 2nd grid893 frcv( :,:,jpr_ity2) = zty(:,:) ! overwrite 2nd comp. on the 2nd grid942 frcv(jpr_itx2)%z3(:,:,1) = ztx(:,:) ! overwrite 1st comp. on the 2nd grid 943 frcv(jpr_ity2)%z3(:,:,1) = zty(:,:) ! overwrite 2nd comp. on the 2nd grid 894 944 ENDIF 895 945 ! 896 946 ENDIF 897 947 ! 898 IF( TRIM( cn_rcv_tau(3)) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid948 IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid 899 949 ! ! (geographical to local grid -> rotate the components) 900 CALL rot_rep( frcv( :,:,jpr_itx1), frcv(:,:,jpr_ity1), srcv(jpr_itx1)%clgrid, 'en->i', ztx )901 frcv( :,:,jpr_itx1) = ztx(:,:) ! overwrite 1st component on the 1st grid950 CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->i', ztx ) 951 frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid 902 952 IF( srcv(jpr_itx2)%laction ) THEN 903 CALL rot_rep( frcv( :,:,jpr_itx2), frcv(:,:,jpr_ity2), srcv(jpr_itx2)%clgrid, 'en->j', zty )953 CALL rot_rep( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), srcv(jpr_itx2)%clgrid, 'en->j', zty ) 904 954 ELSE 905 CALL rot_rep( frcv( :,:,jpr_itx1), frcv(:,:,jpr_ity1), srcv(jpr_itx1)%clgrid, 'en->j', zty )955 CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->j', zty ) 906 956 ENDIF 907 frcv( :,:,jpr_ity1) = zty(:,:) ! overwrite 2nd component on the 1st grid957 frcv(jpr_ity1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 1st grid 908 958 ENDIF 909 959 ! ! ======================= ! 910 960 ELSE ! use ocean stress ! 911 961 ! ! ======================= ! 912 frcv( :,:,jpr_itx1) = frcv(:,:,jpr_otx1)913 frcv( :,:,jpr_ity1) = frcv(:,:,jpr_oty1)962 frcv(jpr_itx1)%z3(:,:,1) = frcv(jpr_otx1)%z3(:,:,1) 963 frcv(jpr_ity1)%z3(:,:,1) = frcv(jpr_oty1)%z3(:,:,1) 914 964 ! 915 965 ENDIF … … 934 984 DO jj = 2, jpjm1 ! (U,V) ==> I 935 985 DO ji = 2, jpim1 ! NO vector opt. 936 p_taui(ji,jj) = 0.5 * ( frcv(j i-1,jj ,jpr_itx1) + frcv(ji-1,jj-1,jpr_itx1) )937 p_tauj(ji,jj) = 0.5 * ( frcv(j i ,jj-1,jpr_ity1) + frcv(ji-1,jj-1,jpr_ity1) )986 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji-1,jj ,1) + frcv(jpr_itx1)%z3(ji-1,jj-1,1) ) 987 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji ,jj-1,1) + frcv(jpr_ity1)%z3(ji-1,jj-1,1) ) 938 988 END DO 939 989 END DO … … 941 991 DO jj = 2, jpjm1 ! F ==> I 942 992 DO ji = 2, jpim1 ! NO vector opt. 943 p_taui(ji,jj) = frcv(j i-1,jj-1,jpr_itx1)944 p_tauj(ji,jj) = frcv(j i-1,jj-1,jpr_ity1)993 p_taui(ji,jj) = frcv(jpr_itx1)%z3(ji-1,jj-1,1) 994 p_tauj(ji,jj) = frcv(jpr_ity1)%z3(ji-1,jj-1,1) 945 995 END DO 946 996 END DO … … 948 998 DO jj = 2, jpjm1 ! T ==> I 949 999 DO ji = 2, jpim1 ! NO vector opt. 950 p_taui(ji,jj) = 0.25 * ( frcv(j i,jj ,jpr_itx1) + frcv(ji-1,jj ,jpr_itx1) &951 & + frcv(j i,jj-1,jpr_itx1) + frcv(ji-1,jj-1,jpr_itx1) )952 p_tauj(ji,jj) = 0.25 * ( frcv(j i,jj ,jpr_ity1) + frcv(ji-1,jj ,jpr_ity1) &953 & + frcv(j i,jj-1,jpr_ity1) + frcv(ji-1,jj-1,jpr_ity1) )1000 p_taui(ji,jj) = 0.25 * ( frcv(jpr_itx1)%z3(ji,jj ,1) + frcv(jpr_itx1)%z3(ji-1,jj ,1) & 1001 & + frcv(jpr_itx1)%z3(ji,jj-1,1) + frcv(jpr_itx1)%z3(ji-1,jj-1,1) ) 1002 p_tauj(ji,jj) = 0.25 * ( frcv(jpr_ity1)%z3(ji,jj ,1) + frcv(jpr_ity1)%z3(ji-1,jj ,1) & 1003 & + frcv(jpr_oty1)%z3(ji,jj-1,1) + frcv(jpr_ity1)%z3(ji-1,jj-1,1) ) 954 1004 END DO 955 1005 END DO 956 1006 CASE( 'I' ) 957 p_taui(:,:) = frcv( :,:,jpr_itx1) ! I ==> I958 p_tauj(:,:) = frcv( :,:,jpr_ity1)1007 p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! I ==> I 1008 p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 959 1009 END SELECT 960 1010 IF( srcv(jpr_itx1)%clgrid /= 'I' ) THEN … … 967 1017 DO jj = 2, jpjm1 ! (U,V) ==> F 968 1018 DO ji = fs_2, fs_jpim1 ! vector opt. 969 p_taui(ji,jj) = 0.5 * ( frcv(j i,jj,jpr_itx1) + frcv(ji ,jj+1,jpr_itx1) )970 p_tauj(ji,jj) = 0.5 * ( frcv(j i,jj,jpr_ity1) + frcv(ji+1,jj ,jpr_ity1) )1019 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji ,jj+1,1) ) 1020 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji,jj,1) + frcv(jpr_ity1)%z3(ji+1,jj ,1) ) 971 1021 END DO 972 1022 END DO … … 974 1024 DO jj = 2, jpjm1 ! I ==> F 975 1025 DO ji = 2, jpim1 ! NO vector opt. 976 p_taui(ji,jj) = frcv(j i+1,jj+1,jpr_itx1)977 p_tauj(ji,jj) = frcv(j i+1,jj+1,jpr_ity1)1026 p_taui(ji,jj) = frcv(jpr_itx1)%z3(ji+1,jj+1,1) 1027 p_tauj(ji,jj) = frcv(jpr_ity1)%z3(ji+1,jj+1,1) 978 1028 END DO 979 1029 END DO … … 981 1031 DO jj = 2, jpjm1 ! T ==> F 982 1032 DO ji = 2, jpim1 ! NO vector opt. 983 p_taui(ji,jj) = 0.25 * ( frcv(j i,jj ,jpr_itx1) + frcv(ji+1,jj ,jpr_itx1) &984 & + frcv(j i,jj+1,jpr_itx1) + frcv(ji+1,jj+1,jpr_itx1) )985 p_tauj(ji,jj) = 0.25 * ( frcv(j i,jj ,jpr_ity1) + frcv(ji+1,jj ,jpr_ity1) &986 & + frcv(j i,jj+1,jpr_ity1) + frcv(ji+1,jj+1,jpr_ity1) )1033 p_taui(ji,jj) = 0.25 * ( frcv(jpr_itx1)%z3(ji,jj ,1) + frcv(jpr_itx1)%z3(ji+1,jj ,1) & 1034 & + frcv(jpr_itx1)%z3(ji,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj+1,1) ) 1035 p_tauj(ji,jj) = 0.25 * ( frcv(jpr_ity1)%z3(ji,jj ,1) + frcv(jpr_ity1)%z3(ji+1,jj ,1) & 1036 & + frcv(jpr_ity1)%z3(ji,jj+1,1) + frcv(jpr_ity1)%z3(ji+1,jj+1,1) ) 987 1037 END DO 988 1038 END DO 989 1039 CASE( 'F' ) 990 p_taui(:,:) = frcv( :,:,jpr_itx1) ! F ==> F991 p_tauj(:,:) = frcv( :,:,jpr_ity1)1040 p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! F ==> F 1041 p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 992 1042 END SELECT 993 1043 IF( srcv(jpr_itx1)%clgrid /= 'F' ) THEN … … 998 1048 SELECT CASE ( srcv(jpr_itx1)%clgrid ) 999 1049 CASE( 'U' ) 1000 p_taui(:,:) = frcv( :,:,jpr_itx1) ! (U,V) ==> (U,V)1001 p_tauj(:,:) = frcv( :,:,jpr_ity1)1050 p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! (U,V) ==> (U,V) 1051 p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 1002 1052 CASE( 'F' ) 1003 1053 DO jj = 2, jpjm1 ! F ==> (U,V) 1004 1054 DO ji = fs_2, fs_jpim1 ! vector opt. 1005 p_taui(ji,jj) = 0.5 * ( frcv(j i,jj,jpr_itx1) + frcv(ji ,jj-1,jpr_itx1) )1006 p_tauj(ji,jj) = 0.5 * ( frcv(j i,jj,jpr_ity1) + frcv(ji-1,jj ,jpr_ity1) )1055 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji ,jj-1,1) ) 1056 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(jj,jj,1) + frcv(jpr_ity1)%z3(ji-1,jj ,1) ) 1007 1057 END DO 1008 1058 END DO … … 1010 1060 DO jj = 2, jpjm1 ! T ==> (U,V) 1011 1061 DO ji = fs_2, fs_jpim1 ! vector opt. 1012 p_taui(ji,jj) = 0.5 * ( frcv(j i+1,jj ,jpr_itx1) + frcv(ji,jj,jpr_itx1) )1013 p_tauj(ji,jj) = 0.5 * ( frcv(j i ,jj+1,jpr_ity1) + frcv(ji,jj,jpr_ity1) )1062 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj ,1) + frcv(jpr_itx1)%z3(ji,jj,1) ) 1063 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) ) 1014 1064 END DO 1015 1065 END DO … … 1017 1067 DO jj = 2, jpjm1 ! I ==> (U,V) 1018 1068 DO ji = 2, jpim1 ! NO vector opt. 1019 p_taui(ji,jj) = 0.5 * ( frcv(j i+1,jj+1,jpr_itx1) + frcv(ji+1,jj ,jpr_itx1) )1020 p_tauj(ji,jj) = 0.5 * ( frcv(j i+1,jj+1,jpr_ity1) + frcv(ji ,jj+1,jpr_ity1) )1069 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj ,1) ) 1070 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji+1,jj+1,1) + frcv(jpr_ity1)%z3(ji ,jj+1,1) ) 1021 1071 END DO 1022 1072 END DO … … 1027 1077 END SELECT 1028 1078 1029 !!gm Should be useless as sbc_cpl_ice_tau only called at coupled frequency1030 ! The receive stress are transformed such that in all case frcv(:,:,jpr_itx1), frcv(:,:,jpr_ity1)1031 ! become the i-component and j-component of the stress at the right grid point1032 !!gm frcv(:,:,jpr_itx1) = p_taui(:,:)1033 !!gm frcv(:,:,jpr_ity1) = p_tauj(:,:)1034 !!gm1035 1079 ENDIF 1036 1080 ! … … 1040 1084 1041 1085 1042 SUBROUTINE sbc_cpl_ice_flx( p_frld , & 1043 & pqns_tot, pqns_ice, pqsr_tot , pqsr_ice, & 1044 & pemp_tot, pemp_ice, pdqns_ice, psprecip, & 1045 & palbi , psst , pist ) 1086 SUBROUTINE sbc_cpl_ice_flx( p_frld , palbi , psst , pist ) 1046 1087 !!---------------------------------------------------------------------- 1047 !! *** ROUTINE sbc_cpl_ice_flx _rcv***1088 !! *** ROUTINE sbc_cpl_ice_flx *** 1048 1089 !! 1049 1090 !! ** Purpose : provide the heat and freshwater fluxes of the … … 1066 1107 !! the atmosphere 1067 1108 !! 1068 !! N.B. - fields over sea-ice are passed in argument so that1069 !! the module can be compile without sea-ice.1070 1109 !! - the fluxes have been separated from the stress as 1071 1110 !! (a) they are updated at each ice time step compare to … … 1078 1117 !! 1079 1118 !! ** Action : update at each nf_ice time step: 1080 !! pqns_tot, pqsr_tot non-solar and solar total heat fluxes1081 !! pqns_ice, pqsr_ice non-solar and solar heat fluxes over the ice1082 !! pemp_tot total evaporation - precipitation(liquid and solid) (-runoff)(-calving)1083 !! pemp_ice ice sublimation - solid precipitation over the ice1084 !! pdqns_ice d(non-solar heat flux)/d(Temperature) over the ice1119 !! qns_tot, qsr_tot non-solar and solar total heat fluxes 1120 !! qns_ice, qsr_ice non-solar and solar heat fluxes over the ice 1121 !! emp_tot total evaporation - precipitation(liquid and solid) (-runoff)(-calving) 1122 !! emp_ice ice sublimation - solid precipitation over the ice 1123 !! dqns_ice d(non-solar heat flux)/d(Temperature) over the ice 1085 1124 !! sprecip solid precipitation over the ocean 1086 1125 !!---------------------------------------------------------------------- 1087 1126 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 1088 USE wrk_nemo, ONLY: zcptn => wrk_2d_1 ! rcp * tsn(:,:,1,jp_tem) 1089 USE wrk_nemo, ONLY: ztmp => wrk_2d_2 ! temporary array 1090 USE wrk_nemo, ONLY: zsnow => wrk_2d_3 ! snow precipitation 1091 USE wrk_nemo, ONLY: zicefr => wrk_3d_4 ! ice fraction 1092 !! 1093 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: p_frld ! lead fraction [0 to 1] 1094 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pqns_tot ! total non solar heat flux [W/m2] 1095 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: pqns_ice ! ice non solar heat flux [W/m2] 1096 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pqsr_tot ! total solar heat flux [W/m2] 1097 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: pqsr_ice ! ice solar heat flux [W/m2] 1098 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pemp_tot ! total freshwater budget [Kg/m2/s] 1099 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pemp_ice ! solid freshwater budget over ice [Kg/m2/s] 1100 REAL(wp), INTENT( out), DIMENSION(:,: ) :: psprecip ! Net solid precipitation (=emp_ice) [Kg/m2/s] 1101 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: pdqns_ice ! d(Q non solar)/d(Temperature) over ice 1127 USE wrk_nemo, ONLY: zcptn => wrk_2d_2 ! rcp * tsn(:,:,1,jp_tem) 1128 USE wrk_nemo, ONLY: ztmp => wrk_2d_3 ! temporary array 1129 USE wrk_nemo, ONLY: zicefr => wrk_2d_4 ! ice fraction 1130 !! 1131 REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! lead fraction [0 to 1] 1102 1132 ! optional arguments, used only in 'mixed oce-ice' case 1103 1133 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! ice albedo 1104 1134 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celcius] 1105 1135 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1106 !! 1107 INTEGER :: ji, jj ! dummy loop indices 1108 INTEGER :: isec, info ! temporary integer 1109 REAL(wp):: zcoef, ztsurf ! temporary scalar 1136 ! 1137 INTEGER :: jl ! dummy loop index 1110 1138 !!---------------------------------------------------------------------- 1111 1139 1112 IF( wrk_in_use(2, 1,2,3) .OR. wrk_in_use(3,4) ) THEN1140 IF( wrk_in_use(2, 2,3,4) ) THEN 1113 1141 CALL ctl_stop('sbc_cpl_ice_flx: requested workspace arrays unavailable') ; RETURN 1114 1142 ENDIF 1115 1143 1116 zicefr(:,: ,1) = 1.- p_frld(:,:,1)1144 zicefr(:,:) = 1.- p_frld(:,:) 1117 1145 IF( lk_diaar5 ) zcptn(:,:) = rcp * tsn(:,:,1,jp_tem) 1118 1146 ! … … 1124 1152 ! ! solid precipitation - sublimation (emp_ice) 1125 1153 ! ! solid Precipitation (sprecip) 1126 SELECT CASE( TRIM( cn_rcv_emp) )1154 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 1127 1155 CASE( 'conservative' ) ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp 1128 pemp_tot(:,:) = frcv(:,:,jpr_tevp) - frcv(:,:,jpr_rain) - frcv(:,:,jpr_snow) 1129 pemp_ice(:,:) = frcv(:,:,jpr_ievp) - frcv(:,:,jpr_snow) 1130 zsnow (:,:) = frcv(:,:,jpr_snow) 1131 CALL iom_put( 'rain' , frcv(:,:,jpr_rain) ) ! liquid precipitation 1132 IF( lk_diaar5 ) CALL iom_put( 'hflx_rain_cea', frcv(:,:,jpr_rain) * zcptn(:,:) ) ! heat flux from liq. precip. 1133 ztmp(:,:) = frcv(:,:,jpr_tevp) - frcv(:,:,jpr_ievp) * zicefr(:,:,1) 1156 sprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here 1157 tprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + sprecip (:,:) ! May need to ensure positive here 1158 emp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - tprecip(:,:) 1159 emp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 1160 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation 1161 IF( lk_diaar5 ) CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from liq. precip. 1162 ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 1134 1163 CALL iom_put( 'evap_ao_cea' , ztmp ) ! ice-free oce evap (cell average) 1135 1164 IF( lk_diaar5 ) CALL iom_put( 'hflx_evap_cea', ztmp(:,: ) * zcptn(:,:) ) ! heat flux from from evap (cell ave) 1136 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp 1137 pemp_tot(:,:) = p_frld(:,:,1) * frcv(:,:,jpr_oemp) + zicefr(:,:,1) * frcv(:,:,jpr_sbpr)1138 pemp_ice(:,:) = frcv(:,:,jpr_semp)1139 zsnow (:,:) = - frcv(:,:,jpr_semp) + frcv(:,:,jpr_ievp)1165 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1166 emp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 1167 emp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 1168 sprecip(:,:) = - frcv(jpr_semp)%z3(:,:,1) + frcv(jpr_ievp)%z3(:,:,1) 1140 1169 END SELECT 1141 psprecip(:,:) = - pemp_ice(:,:) 1142 CALL iom_put( 'snowpre' , zsnow) ! Snow1143 CALL iom_put( 'snow_ao_cea', zsnow(:,: ) * p_frld(:,:,1)) ! Snow over ice-free ocean (cell average)1144 CALL iom_put( 'snow_ai_cea', zsnow(:,: ) * zicefr(:,:,1)) ! Snow over sea-ice (cell average)1145 CALL iom_put( 'subl_ai_cea', frcv (:,:,jpr_ievp) * zicefr(:,:,1) ) ! Sublimation over sea-ice (cell average)1170 1171 CALL iom_put( 'snowpre' , sprecip ) ! Snow 1172 CALL iom_put( 'snow_ao_cea', sprecip(:,: ) * p_frld(:,:) ) ! Snow over ice-free ocean (cell average) 1173 CALL iom_put( 'snow_ai_cea', sprecip(:,: ) * zicefr(:,:) ) ! Snow over sea-ice (cell average) 1174 CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1146 1175 ! 1147 1176 ! ! runoffs and calving (put in emp_tot) 1148 1177 IF( srcv(jpr_rnf)%laction ) THEN 1149 pemp_tot(:,:) = pemp_tot(:,:) - frcv(:,:,jpr_rnf)1150 CALL iom_put( 'runoffs' , frcv( :,:,jpr_rnf) ) ! rivers1151 IF( lk_diaar5 ) CALL iom_put( 'hflx_rnf_cea' , frcv( :,:,jpr_rnf) * zcptn(:,:) ) ! heat flux from rivers1178 emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) 1179 CALL iom_put( 'runoffs' , frcv(jpr_rnf)%z3(:,:,1) ) ! rivers 1180 IF( lk_diaar5 ) CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from rivers 1152 1181 ENDIF 1153 1182 IF( srcv(jpr_cal)%laction ) THEN 1154 pemp_tot(:,:) = pemp_tot(:,:) - frcv(:,:,jpr_cal)1155 CALL iom_put( 'calving', frcv( :,:,jpr_cal) )1183 emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 1184 CALL iom_put( 'calving', frcv(jpr_cal)%z3(:,:,1) ) 1156 1185 ENDIF 1157 1186 ! … … 1159 1188 !!gm at least should be optional... 1160 1189 !! ! remove negative runoff ! sum over the global domain 1161 !! zcumulpos = SUM( MAX( frcv( :,:,jpr_rnf), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )1162 !! zcumulneg = SUM( MIN( frcv( :,:,jpr_rnf), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )1190 !! zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 1191 !! zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 1163 1192 !! IF( lk_mpp ) CALL mpp_sum( zcumulpos ) 1164 1193 !! IF( lk_mpp ) CALL mpp_sum( zcumulneg ) 1165 1194 !! IF( zcumulpos /= 0. ) THEN ! distribute negative runoff on positive runoff grid points 1166 1195 !! zcumulneg = 1.e0 + zcumulneg / zcumulpos 1167 !! frcv( :,:,jpr_rnf) = MAX( frcv(:,:,jpr_rnf), 0.e0 ) * zcumulneg1196 !! frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg 1168 1197 !! ENDIF 1169 !! pemp_tot(:,:) = pemp_tot(:,:) - frcv(:,:,jpr_rnf) ! add runoff to e-p1198 !! emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) ! add runoff to e-p 1170 1199 !! 1171 1200 !!gm end of internal cooking 1172 1201 1173 1174 1202 ! ! ========================= ! 1175 SELECT CASE( TRIM( cn_rcv_qns ) )! non solar heat fluxes ! (qns)1203 SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) ! non solar heat fluxes ! (qns) 1176 1204 ! ! ========================= ! 1205 CASE( 'oce only' ) ! the required field is directly provided 1206 qns_tot(:,: ) = frcv(jpr_qnsoce)%z3(:,:,1) 1177 1207 CASE( 'conservative' ) ! the required fields are directly provided 1178 pqns_tot(:,: ) = frcv(:,:,jpr_qnsmix) 1179 pqns_ice(:,:,1) = frcv(:,:,jpr_qnsice) 1208 qns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1209 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1210 qns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 1211 ELSE 1212 ! Set all category values equal for the moment 1213 DO jl=1,jpl 1214 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1215 ENDDO 1216 ENDIF 1180 1217 CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes 1181 pqns_tot(:,: ) = p_frld(:,:,1) * frcv(:,:,jpr_qnsoce) + zicefr(:,:,1) * frcv(:,:,jpr_qnsice) 1182 pqns_ice(:,:,1) = frcv(:,:,jpr_qnsice) 1218 qns_tot(:,: ) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 1219 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1220 DO jl=1,jpl 1221 qns_tot(:,: ) = qns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl) 1222 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl) 1223 ENDDO 1224 ELSE 1225 DO jl=1,jpl 1226 qns_tot(:,: ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1227 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1228 ENDDO 1229 ENDIF 1183 1230 CASE( 'mixed oce-ice' ) ! the ice flux is cumputed from the total flux, the SST and ice informations 1184 pqns_tot(:,: ) = frcv(:,:,jpr_qnsmix) 1185 pqns_ice(:,:,1) = frcv(:,:,jpr_qnsmix) & 1186 & + frcv(:,:,jpr_dqnsdt) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:,1) & 1187 & + pist(:,:,1) * zicefr(:,:,1) ) ) 1231 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1232 qns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1233 qns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) & 1234 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:) & 1235 & + pist(:,:,1) * zicefr(:,:) ) ) 1188 1236 END SELECT 1189 ztmp(:,:) = p_frld(:,: ,1) * zsnow(:,:) * lfus ! add the latent heat of solid precip. melting1190 pqns_tot(:,:) = pqns_tot(:,:) - ztmp(:,:)! over free ocean1191 IF( lk_diaar5 ) CALL iom_put( 'hflx_snow_cea', ztmp + zsnow(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average)1237 ztmp(:,:) = p_frld(:,:) * sprecip(:,:) * lfus ! add the latent heat of solid precip. melting 1238 qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:) ! over free ocean 1239 IF( lk_diaar5 ) CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average) 1192 1240 !!gm 1193 1241 !! currently it is taken into account in leads budget but not in the qns_tot, and thus not in … … 1199 1247 ! 1200 1248 IF( srcv(jpr_cal)%laction ) THEN ! Iceberg melting 1201 ztmp(:,:) = frcv( :,:,jpr_cal) * lfus! add the latent heat of iceberg melting1202 pqns_tot(:,:) = pqns_tot(:,:) - ztmp(:,:)1203 IF( lk_diaar5 ) CALL iom_put( 'hflx_cal_cea', ztmp + frcv( :,:,jpr_cal) * zcptn(:,:) ) ! heat flux from calving1249 ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus ! add the latent heat of iceberg melting 1250 qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:) 1251 IF( lk_diaar5 ) CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from calving 1204 1252 ENDIF 1205 1253 1206 1254 ! ! ========================= ! 1207 SELECT CASE( TRIM( cn_rcv_qsr ) )! solar heat fluxes ! (qsr)1255 SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) ! solar heat fluxes ! (qsr) 1208 1256 ! ! ========================= ! 1257 CASE( 'oce only' ) 1258 qsr_tot(:,: ) = MAX(0.0,frcv(jpr_qsroce)%z3(:,:,1)) 1209 1259 CASE( 'conservative' ) 1210 pqsr_tot(:,: ) = frcv(:,:,jpr_qsrmix) 1211 pqsr_ice(:,:,1) = frcv(:,:,jpr_qsrice) 1260 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1261 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1262 qsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl) 1263 ELSE 1264 ! Set all category values equal for the moment 1265 DO jl=1,jpl 1266 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1267 ENDDO 1268 ENDIF 1269 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1270 qsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 1212 1271 CASE( 'oce and ice' ) 1213 pqsr_tot(:,: ) = p_frld(:,:,1) * frcv(:,:,jpr_qsroce) + zicefr(:,:,1) * frcv(:,:,jpr_qsrice) 1214 pqsr_ice(:,:,1) = frcv(:,:,jpr_qsrice) 1272 qsr_tot(:,: ) = p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 1273 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1274 DO jl=1,jpl 1275 qsr_tot(:,: ) = qsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl) 1276 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl) 1277 ENDDO 1278 ELSE 1279 DO jl=1,jpl 1280 qsr_tot(:,: ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 1281 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1282 ENDDO 1283 ENDIF 1215 1284 CASE( 'mixed oce-ice' ) 1216 pqsr_tot(:,: ) = frcv(:,:,jpr_qsrmix) 1285 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1286 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1217 1287 ! Create solar heat flux over ice using incoming solar heat flux and albedos 1218 1288 ! ( see OASIS3 user guide, 5th edition, p39 ) 1219 pqsr_ice(:,:,1) = frcv(:,:,jpr_qsrmix) * ( 1.- palbi(:,:,1) ) &1220 & / ( 1.- ( albedo_oce_mix(:,: ) * p_frld(:,: ,1)&1221 & + palbi (:,:,1) * zicefr(:,: ,1) ) )1289 qsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) & 1290 & / ( 1.- ( albedo_oce_mix(:,: ) * p_frld(:,:) & 1291 & + palbi (:,:,1) * zicefr(:,:) ) ) 1222 1292 END SELECT 1223 1293 IF( ln_dm2dc ) THEN ! modify qsr to include the diurnal cycle 1224 pqsr_tot(:,: ) = sbc_dcy( pqsr_tot(:,: ) ) 1225 pqsr_ice(:,:,1) = sbc_dcy( pqsr_ice(:,:,1) ) 1226 ENDIF 1227 1228 SELECT CASE( TRIM( cn_rcv_dqnsdt ) ) 1294 qsr_tot(:,: ) = sbc_dcy( qsr_tot(:,: ) ) 1295 DO jl=1,jpl 1296 qsr_ice(:,:,jl) = sbc_dcy( qsr_ice(:,:,jl) ) 1297 ENDDO 1298 ENDIF 1299 1300 SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) 1229 1301 CASE ('coupled') 1230 pdqns_ice(:,:,1) = frcv(:,:,jpr_dqnsdt) 1302 IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 1303 dqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 1304 ELSE 1305 ! Set all category values equal for the moment 1306 DO jl=1,jpl 1307 dqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1) 1308 ENDDO 1309 ENDIF 1231 1310 END SELECT 1232 1311 1233 IF( wrk_not_released(2, 1,2,3) .OR. & 1234 wrk_not_released(3, 4) ) CALL ctl_stop('sbc_cpl_ice_flx: failed to release workspace arrays') 1312 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) 1313 CASE ('coupled') 1314 topmelt(:,:,:)=frcv(jpr_topm)%z3(:,:,:) 1315 botmelt(:,:,:)=frcv(jpr_botm)%z3(:,:,:) 1316 END SELECT 1317 1318 IF( wrk_not_released(2, 2,3,4) ) CALL ctl_stop('sbc_cpl_ice_flx: failed to release workspace arrays') 1235 1319 ! 1236 1320 END SUBROUTINE sbc_cpl_ice_flx … … 1249 1333 USE wrk_nemo, ONLY: zfr_l => wrk_2d_1 ! 1. - fr_i(:,:) 1250 1334 USE wrk_nemo, ONLY: ztmp1 => wrk_2d_2 , ztmp2 => wrk_2d_3 1335 USE wrk_nemo, ONLY: ztmp3 => wrk_3d_1 , ztmp4 => wrk_3d_2 1251 1336 USE wrk_nemo, ONLY: zotx1 => wrk_2d_4 , zoty1 => wrk_2d_5 , zotz1 => wrk_2d_6 1252 1337 USE wrk_nemo, ONLY: zitx1 => wrk_2d_7 , zity1 => wrk_2d_8 , zitz1 => wrk_2d_9 … … 1254 1339 INTEGER, INTENT(in) :: kt 1255 1340 ! 1256 INTEGER :: ji, jj 1341 INTEGER :: ji, jj, jl ! dummy loop indices 1257 1342 INTEGER :: isec, info ! local integer 1258 1343 !!---------------------------------------------------------------------- 1259 1344 1260 IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,9) ) THEN1345 IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,9) .OR. wrk_in_use(3, 1,2) ) THEN 1261 1346 CALL ctl_stop('sbc_cpl_snd: requested workspace arrays are unavailable') ; RETURN 1262 1347 ENDIF … … 1269 1354 ! ! Surface temperature ! in Kelvin 1270 1355 ! ! ------------------------- ! 1271 SELECT CASE( cn_snd_temperature)1356 SELECT CASE( sn_snd_temp%cldes) 1272 1357 CASE( 'oce only' ) ; ztmp1(:,:) = tsn(:,:,1,jp_tem) + rt0 1273 CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:) 1274 ztmp2(:,:) = tn_ice(:,:,1) * fr_i(:,:) 1275 CASE( 'mixed oce-ice' ) ; ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:) + tn_ice(:,:,1) * fr_i(:,:) 1276 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of cn_snd_temperature' ) 1358 CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:) 1359 SELECT CASE( sn_snd_temp%clcat ) 1360 CASE( 'yes' ) 1361 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1362 CASE( 'no' ) 1363 ztmp3(:,:,:) = 0.0 1364 DO jl=1,jpl 1365 ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 1366 ENDDO 1367 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 1368 END SELECT 1369 CASE( 'mixed oce-ice' ) 1370 ztmp1(:,:) = ( tsn(:,:,1,1) + rt0 ) * zfr_l(:,:) 1371 DO jl=1,jpl 1372 ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 1373 ENDDO 1374 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 1277 1375 END SELECT 1278 IF( ssnd(jps_toce)%laction ) CALL cpl_prism_snd( jps_toce, isec, ztmp1, info )1279 IF( ssnd(jps_tice)%laction ) CALL cpl_prism_snd( jps_tice, isec, ztmp 2, info )1280 IF( ssnd(jps_tmix)%laction ) CALL cpl_prism_snd( jps_tmix, isec, ztmp1, info )1376 IF( ssnd(jps_toce)%laction ) CALL cpl_prism_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1377 IF( ssnd(jps_tice)%laction ) CALL cpl_prism_snd( jps_tice, isec, ztmp3, info ) 1378 IF( ssnd(jps_tmix)%laction ) CALL cpl_prism_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1281 1379 ! 1282 1380 ! ! ------------------------- ! … … 1284 1382 ! ! ------------------------- ! 1285 1383 IF( ssnd(jps_albice)%laction ) THEN ! ice 1286 ztmp 1(:,:) = alb_ice(:,:,1) * fr_i(:,:)1287 CALL cpl_prism_snd( jps_albice, isec, ztmp 1, info )1384 ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1385 CALL cpl_prism_snd( jps_albice, isec, ztmp3, info ) 1288 1386 ENDIF 1289 1387 IF( ssnd(jps_albmix)%laction ) THEN ! mixed ice-ocean 1290 ztmp1(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:) + alb_ice(:,:,1) * fr_i(:,:) 1291 CALL cpl_prism_snd( jps_albmix, isec, ztmp1, info ) 1388 ztmp1(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:) 1389 DO jl=1,jpl 1390 ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl) 1391 ENDDO 1392 CALL cpl_prism_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1292 1393 ENDIF 1293 1394 ! ! ------------------------- ! 1294 1395 ! ! Ice fraction & Thickness ! 1295 1396 ! ! ------------------------- ! 1296 IF( ssnd(jps_fice)%laction ) CALL cpl_prism_snd( jps_fice, isec, fr_i , info ) 1297 IF( ssnd(jps_hice)%laction ) CALL cpl_prism_snd( jps_hice, isec, hicif(:,:) * fr_i(:,:), info ) 1298 IF( ssnd(jps_hsnw)%laction ) CALL cpl_prism_snd( jps_hsnw, isec, hsnif(:,:) * fr_i(:,:), info ) 1397 ! Send ice fraction field 1398 SELECT CASE( sn_snd_thick%clcat ) 1399 CASE( 'yes' ) 1400 ztmp3(:,:,1:jpl) = a_i(:,:,1:jpl) 1401 CASE( 'no' ) 1402 ztmp3(:,:,1) = fr_i(:,:) 1403 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 1404 END SELECT 1405 IF( ssnd(jps_fice)%laction ) CALL cpl_prism_snd( jps_fice, isec, ztmp3, info ) 1406 1407 ! Send ice and snow thickness field 1408 SELECT CASE( sn_snd_thick%cldes) 1409 CASE( 'weighted ice and snow' ) 1410 SELECT CASE( sn_snd_thick%clcat ) 1411 CASE( 'yes' ) 1412 ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) * a_i(:,:,1:jpl) 1413 ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) * a_i(:,:,1:jpl) 1414 CASE( 'no' ) 1415 ztmp3(:,:,:) = 0.0 ; ztmp4(:,:,:) = 0.0 1416 DO jl=1,jpl 1417 ztmp3(:,:,1) = ztmp3(:,:,1) + ht_i(:,:,jl) * a_i(:,:,jl) 1418 ztmp4(:,:,1) = ztmp4(:,:,1) + ht_s(:,:,jl) * a_i(:,:,jl) 1419 ENDDO 1420 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 1421 END SELECT 1422 CASE( 'ice and snow' ) 1423 ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) 1424 ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) 1425 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' ) 1426 END SELECT 1427 IF( ssnd(jps_hice)%laction ) CALL cpl_prism_snd( jps_hice, isec, ztmp3, info ) 1428 IF( ssnd(jps_hsnw)%laction ) CALL cpl_prism_snd( jps_hsnw, isec, ztmp4, info ) 1299 1429 ! 1300 1430 #if defined key_cpl_carbon_cycle … … 1302 1432 ! ! CO2 flux from PISCES ! 1303 1433 ! ! ------------------------- ! 1304 IF( ssnd(jps_co2)%laction ) CALL cpl_prism_snd( jps_co2, isec, oce_co2, info )1434 IF( ssnd(jps_co2)%laction ) CALL cpl_prism_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info ) 1305 1435 ! 1306 1436 #endif 1437 ! ! ------------------------- ! 1307 1438 IF( ssnd(jps_ocx1)%laction ) THEN ! Surface current ! 1308 1439 ! ! ------------------------- ! … … 1316 1447 ! i-1 i i 1317 1448 ! i i+1 (for I) 1318 SELECT CASE( TRIM( cn_snd_crt(1)) )1449 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 1319 1450 CASE( 'oce only' ) ! C-grid ==> T 1320 1451 DO jj = 2, jpjm1 … … 1394 1525 END SELECT 1395 1526 END SELECT 1396 CALL lbc_lnk( zotx1, 'T', -1. ) ; CALL lbc_lnk( zoty1, 'T', -1. )1527 CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. ) ; CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. ) 1397 1528 ! 1398 1529 ! 1399 IF( TRIM( cn_snd_crt(3)) == 'eastward-northward' ) THEN ! Rotation of the components1530 IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN ! Rotation of the components 1400 1531 ! ! Ocean component 1401 1532 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component … … 1412 1543 ! 1413 1544 ! spherical coordinates to cartesian -> 2 components to 3 components 1414 IF( TRIM( cn_snd_crt(2)) == 'cartesian' ) THEN1545 IF( TRIM( sn_snd_crt%clvref ) == 'cartesian' ) THEN 1415 1546 ztmp1(:,:) = zotx1(:,:) ! ocean currents 1416 1547 ztmp2(:,:) = zoty1(:,:) … … 1424 1555 ENDIF 1425 1556 ! 1426 IF( ssnd(jps_ocx1)%laction ) CALL cpl_prism_snd( jps_ocx1, isec, zotx1, info ) ! ocean x current 1st grid1427 IF( ssnd(jps_ocy1)%laction ) CALL cpl_prism_snd( jps_ocy1, isec, zoty1, info ) ! ocean y current 1st grid1428 IF( ssnd(jps_ocz1)%laction ) CALL cpl_prism_snd( jps_ocz1, isec, zotz1, info ) ! ocean z current 1st grid1557 IF( ssnd(jps_ocx1)%laction ) CALL cpl_prism_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info ) ! ocean x current 1st grid 1558 IF( ssnd(jps_ocy1)%laction ) CALL cpl_prism_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info ) ! ocean y current 1st grid 1559 IF( ssnd(jps_ocz1)%laction ) CALL cpl_prism_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info ) ! ocean z current 1st grid 1429 1560 ! 1430 IF( ssnd(jps_ivx1)%laction ) CALL cpl_prism_snd( jps_ivx1, isec, zitx1, info ) ! ice x current 1st grid1431 IF( ssnd(jps_ivy1)%laction ) CALL cpl_prism_snd( jps_ivy1, isec, zity1, info ) ! ice y current 1st grid1432 IF( ssnd(jps_ivz1)%laction ) CALL cpl_prism_snd( jps_ivz1, isec, zitz1, info ) ! ice z current 1st grid1561 IF( ssnd(jps_ivx1)%laction ) CALL cpl_prism_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info ) ! ice x current 1st grid 1562 IF( ssnd(jps_ivy1)%laction ) CALL cpl_prism_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info ) ! ice y current 1st grid 1563 IF( ssnd(jps_ivz1)%laction ) CALL cpl_prism_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info ) ! ice z current 1st grid 1433 1564 ! 1434 1565 ENDIF 1435 1566 ! 1436 IF( wrk_not_released(2, 1,2,3,4,5,6,7,8,9) ) CALL ctl_stop('sbc_cpl_snd: failed to release workspace arrays')1567 IF( wrk_not_released(2, 1,2,3,4,5,6,7,8,9) .OR. wrk_not_released(3, 1,2) ) CALL ctl_stop('sbc_cpl_snd: failed to release workspace arrays') 1437 1568 ! 1438 1569 END SUBROUTINE sbc_cpl_snd … … 1459 1590 END SUBROUTINE sbc_cpl_ice_tau 1460 1591 ! 1461 SUBROUTINE sbc_cpl_ice_flx( p_frld , & 1462 & pqns_tot, pqns_ice, pqsr_tot , pqsr_ice, & 1463 & pemp_tot, pemp_ice, pdqns_ice, psprecip, & 1464 & palbi , psst , pist ) 1465 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: p_frld ! lead fraction [0 to 1] 1466 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pqns_tot ! total non solar heat flux [W/m2] 1467 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: pqns_ice ! ice non solar heat flux [W/m2] 1468 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pqsr_tot ! total solar heat flux [W/m2] 1469 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: pqsr_ice ! ice solar heat flux [W/m2] 1470 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pemp_tot ! total freshwater budget [Kg/m2/s] 1471 REAL(wp), INTENT( out), DIMENSION(:,: ) :: pemp_ice ! ice solid freshwater budget [Kg/m2/s] 1472 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: pdqns_ice ! d(Q non solar)/d(Temperature) over ice 1473 REAL(wp), INTENT( out), DIMENSION(:,: ) :: psprecip ! solid precipitation [Kg/m2/s] 1592 SUBROUTINE sbc_cpl_ice_flx( p_frld , palbi , psst , pist ) 1593 REAL(wp), INTENT(in ), DIMENSION(:,: ) :: p_frld ! lead fraction [0 to 1] 1474 1594 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! ice albedo 1475 1595 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celcius] 1476 1596 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1477 WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', p_frld(1,1,1), palbi(1,1,1), psst(1,1), pist(1,1,1) 1478 ! stupid definition to avoid warning message when compiling... 1479 pqns_tot(:,:) = 0. ; pqns_ice(:,:,:) = 0. ; pdqns_ice(:,:,:) = 0. 1480 pqsr_tot(:,:) = 0. ; pqsr_ice(:,:,:) = 0. 1481 pemp_tot(:,:) = 0. ; pemp_ice(:,:) = 0. ; psprecip(:,:) = 0. 1597 WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', p_frld(1,1), palbi(1,1,1), psst(1,1), pist(1,1,1) 1482 1598 END SUBROUTINE sbc_cpl_ice_flx 1483 1599 -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90
r2977 r3116 16 16 USE eosbn2 ! equation of state 17 17 USE sbc_oce ! surface boundary condition: ocean fields 18 USE sbccpl 18 19 USE fldread ! read input field 19 20 USE iom ! I/O manager library … … 97 98 98 99 fr_i(:,:) = tfreez( sss_m ) * tmask(:,:,1) ! sea surface freezing temperature [Celcius] 100 #if defined key_coupled 101 a_i(:,:,1) = fr_i(:,:) 102 #endif 99 103 100 104 ! Flux and ice fraction computation -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
r2715 r3116 202 202 #if defined key_coupled 203 203 ! ! Ice surface fluxes in coupled mode 204 IF( ksbc == 5 ) CALL sbc_cpl_ice_flx( reshape( frld, (/jpi,jpj,1/) ), &205 & qns_tot, qns_ice, qsr_tot , qsr_ice, &206 & emp_tot, emp_ice, dqns_ice, sprecip,&204 IF( ksbc == 5 ) THEN 205 a_i(:,:,1)=fr_i 206 CALL sbc_cpl_ice_flx( frld, & 207 207 ! optional arguments, used only in 'mixed oce-ice' case 208 208 & palbi = zalb_ice_cs, psst = sst_m, pist = zsist ) 209 sprecip(:,:) = - emp_ice(:,:) ! Ugly patch, WARNING, in coupled mode, sublimation included in snow (parsub = 0.) 210 ENDIF 209 211 #endif 210 212 CALL lim_thd_2 ( kt ) ! Ice thermodynamics -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r3105 r3116 11 11 !! - ! 2010-11 (G. Madec) ice-ocean stress always computed at each ocean time-step 12 12 !! - ! 2010-10 (J. Chanut, C. Bricaud, G. Madec) add the surface pressure forcing 13 !! 3.4 ! 2011-11 (C. Harris) CICE added as an option 13 14 !!---------------------------------------------------------------------- 14 15 … … 33 34 USE sbcice_lim ! surface boundary condition: LIM 3.0 sea-ice model 34 35 USE sbcice_lim_2 ! surface boundary condition: LIM 2.0 sea-ice model 36 USE sbcice_cice ! surface boundary condition: CICE sea-ice model 35 37 USE sbccpl ! surface boundary condition: coupled florulation 36 38 USE cpl_oasis3, ONLY:lk_cpl ! are we in coupled mode? … … 39 41 USE sbcfwb ! surface boundary condition: freshwater budget 40 42 USE closea ! closed sea 41 USE bdy_par ! unstructured open boundary data variables42 USE bdyice ! unstructured open boundary data (bdy_ice_frsroutine)43 USE bdy_par ! for lk_bdy 44 USE bdyice_lim2 ! unstructured open boundary data (bdy_ice_lim_2 routine) 43 45 44 46 USE prtctl ! Print control (prt_ctl routine) … … 96 98 IF( lk_lim2 ) nn_ice = 2 97 99 IF( lk_lim3 ) nn_ice = 3 100 IF( lk_cice ) nn_ice = 4 98 101 ENDIF 99 102 IF( cp_cfg == 'gyre' ) THEN ! GYRE configuration … … 147 150 & CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' ) 148 151 ! 149 IF( nn_ice == 2 .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. lk_cpl ) ) & 150 & CALL ctl_stop( 'sea-ice model requires a bulk formulation or coupled configuration' ) 152 IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. lk_cpl ) ) & 153 & CALL ctl_stop( 'LIM sea-ice model requires a bulk formulation or coupled configuration' ) 154 IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. lk_cpl ) ) & 155 & CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or lk_cpl' ) 156 IF( nn_ice == 4 .AND. ( .NOT. ( cp_cfg == 'orca' ) .OR. lk_agrif ) ) & 157 & CALL ctl_stop( 'CICE sea-ice model currently only available in a global ORCA configuration without AGRIF' ) 151 158 152 159 IF( ln_dm2dc ) nday_qsr = -1 ! initialisation flag … … 191 198 IF( nsbc == 6 ) WRITE(numout,*) ' MFS Bulk formulation' 192 199 ENDIF 200 201 IF( nn_ice == 4 ) CALL cice_sbc_init (nsbc) 193 202 ! 194 203 END SUBROUTINE sbc_init … … 264 273 ! 265 274 CASE( 2 ) ; CALL sbc_ice_lim_2( kt, nsbc ) ! LIM-2 ice model 266 IF( lk_bdy ) CALL bdy_ice_ frs( kt ) ! BDY boundary condition275 IF( lk_bdy ) CALL bdy_ice_lim_2( kt ) ! BDY boundary condition 267 276 ! 268 277 CASE( 3 ) ; CALL sbc_ice_lim ( kt, nsbc ) ! LIM-3 ice model 278 ! 279 CASE( 4 ) ; CALL sbc_ice_cice ( kt, nsbc ) ! CICE ice model 269 280 END SELECT 270 281 … … 349 360 & tab2d_2=vtau , clinfo2=' vtau - : ', mask2=vmask, ovlap=1 ) 350 361 ENDIF 362 363 IF( kt == nitend ) CALL sbc_final ! Close down surface module if necessary 351 364 ! 352 365 END SUBROUTINE sbc 366 367 SUBROUTINE sbc_final 368 !!--------------------------------------------------------------------- 369 !! *** ROUTINE sbc_final *** 370 !!--------------------------------------------------------------------- 371 372 !----------------------------------------------------------------- 373 ! Finalize CICE (if used) 374 !----------------------------------------------------------------- 375 376 IF( nn_ice == 4 ) CALL cice_sbc_final 377 ! 378 END SUBROUTINE sbc_final 353 379 354 380 !!====================================================================== -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SOL/solver.F90
r2715 r3116 23 23 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient 24 24 USE solmat ! matrix of the solver 25 USE obc_oce ! Lateral open boundary condition26 25 USE in_out_manager ! I/O manager 27 26 USE lbclnk ! ocean lateral boundary conditions (or mpp link) -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
r2715 r3116 3 3 !! *** MODULE eosbn2 *** 4 4 !! Ocean diagnostic variable : equation of state - in situ and potential density 5 !! - Brunt-Vaisala frequency 5 !! - Brunt-Vaisala frequency 6 6 !!============================================================================== 7 7 !! History : OPA ! 1989-03 (O. Marti) Original code … … 27 27 !! eos_insitu_2d : Compute the in situ density for 2d fields 28 28 !! eos_bn2 : Compute the Brunt-Vaisala frequency 29 !! eos_alpbet : calculates the in situ thermal and haline expansion coeff.29 !! eos_alpbet : calculates the in situ thermal/haline expansion ratio 30 30 !! tfreez : Compute the surface freezing temperature 31 31 !! eos_init : set eos parameters (namelist) … … 41 41 PRIVATE 42 42 43 ! !! * Interface 43 ! !! * Interface 44 44 INTERFACE eos 45 45 MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d 46 END INTERFACE 46 END INTERFACE 47 47 INTERFACE bn2 48 48 MODULE PROCEDURE eos_bn2 49 END INTERFACE 49 END INTERFACE 50 50 51 51 PUBLIC eos ! called by step, istate, tranpc and zpsgrd modules … … 61 61 62 62 REAL(wp), PUBLIC :: ralpbet !: alpha / beta ratio 63 63 64 64 !! * Substitutions 65 65 # include "domzgr_substitute.h90" … … 75 75 !!---------------------------------------------------------------------- 76 76 !! *** ROUTINE eos_insitu *** 77 !! 78 !! ** Purpose : Compute the in situ density (ratio rho/rau0) from 77 !! 78 !! ** Purpose : Compute the in situ density (ratio rho/rau0) from 79 79 !! potential temperature and salinity using an equation of state 80 80 !! defined through the namelist parameter nn_eos. … … 134 134 !CDIR NOVERRCHK 135 135 zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) ) 136 ! 136 ! 137 137 DO jk = 1, jpkm1 138 138 DO jj = 1, jpj … … 199 199 !!---------------------------------------------------------------------- 200 200 !! *** ROUTINE eos_insitu_pot *** 201 !! 201 !! 202 202 !! ** Purpose : Compute the in situ density (ratio rho/rau0) and the 203 203 !! potential volumic mass (Kg/m3) from potential temperature and 204 !! salinity fields using an equation of state defined through the 204 !! salinity fields using an equation of state defined through the 205 205 !! namelist parameter nn_eos. 206 206 !! … … 230 230 !! nn_eos = 2 : linear equation of state function of temperature and 231 231 !! salinity 232 !! prd(t,s) = ( rho(t,s) - rau0 ) / rau0 232 !! prd(t,s) = ( rho(t,s) - rau0 ) / rau0 233 233 !! = rn_beta * s - rn_alpha * tn - 1. 234 234 !! rhop(t,s) = rho(t,s) … … 265 265 !CDIR NOVERRCHK 266 266 zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) ) 267 ! 267 ! 268 268 DO jk = 1, jpkm1 269 269 DO jj = 1, jpj … … 336 336 !! *** ROUTINE eos_insitu_2d *** 337 337 !! 338 !! ** Purpose : Compute the in situ density (ratio rho/rau0) from 338 !! ** Purpose : Compute the in situ density (ratio rho/rau0) from 339 339 !! potential temperature and salinity using an equation of state 340 340 !! defined through the namelist parameter nn_eos. * 2D field case … … 374 374 ! ! 2 : salinity [psu] 375 375 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pdep ! depth [m] 376 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: prd ! in situ density 376 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: prd ! in situ density 377 377 !! 378 378 INTEGER :: ji, jj ! dummy loop indices … … 449 449 DO jj = 1, jpjm1 450 450 DO ji = 1, fs_jpim1 ! vector opt. 451 prd(ji,jj) = ( rn_beta * pts(ji,jj,jp_sal) - rn_alpha * pts(ji,jj,jp_tem) ) * tmask(ji,jj,1) 451 prd(ji,jj) = ( rn_beta * pts(ji,jj,jp_sal) - rn_alpha * pts(ji,jj,jp_tem) ) * tmask(ji,jj,1) 452 452 END DO 453 453 END DO … … 468 468 !! ** Purpose : Compute the local Brunt-Vaisala frequency at the time- 469 469 !! step of the input arguments 470 !! 470 !! 471 471 !! ** Method : 472 472 !! * nn_eos = 0 : UNESCO sea water properties … … 482 482 !! N^2 = grav * (rn_alpha * dk[ t ] - rn_beta * dk[ s ] ) / e3w 483 483 !! The use of potential density to compute N^2 introduces e r r o r 484 !! in the sign of N^2 at great depths. We recommand the use of 484 !! in the sign of N^2 at great depths. We recommand the use of 485 485 !! nn_eos = 0, except for academical studies. 486 486 !! Macro-tasked on horizontal slab (jk-loop) … … 497 497 !! 498 498 INTEGER :: ji, jj, jk ! dummy loop indices 499 REAL(wp) :: zgde3w, zt, zs, zh, zalbet, zbeta ! local scalars 499 REAL(wp) :: zgde3w, zt, zs, zh, zalbet, zbeta ! local scalars 500 500 #if defined key_zdfddm 501 501 REAL(wp) :: zds ! local scalars … … 504 504 505 505 ! pn2 : interior points only (2=< jk =< jpkm1 ) 506 ! -------------------------- 506 ! -------------------------- 507 507 ! 508 508 SELECT CASE( nn_eos ) … … 542 542 & - 0.121555e-07_wp ) * zh 543 543 ! 544 pn2(ji,jj,jk) = zgde3w * zbeta * tmask(ji,jj,jk) & ! N^2 544 pn2(ji,jj,jk) = zgde3w * zbeta * tmask(ji,jj,jk) & ! N^2 545 545 & * ( zalbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) & 546 546 & - ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) ) … … 565 565 & - rn_beta * ( pts(:,:,jk-1,jp_sal) - pts(:,:,jk,jp_sal) ) ) & 566 566 & / fse3w(:,:,jk) * tmask(:,:,jk) 567 END DO 567 END DO 568 568 #if defined key_zdfddm 569 569 DO jk = 2, jpkm1 ! Rrau = (alpha / beta) (dk[t] / dk[s]) 570 570 DO jj = 1, jpj 571 571 DO ji = 1, jpi 572 zds = ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) 572 zds = ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) 573 573 IF ( ABS( zds ) <= 1.e-20_wp ) zds = 1.e-20_wp 574 574 rrau(ji,jj,jk) = ralpbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) / zds … … 587 587 588 588 589 SUBROUTINE eos_alpbet( pts, palp h, pbeta)590 !!---------------------------------------------------------------------- 591 !! *** ROUTINE ldf_slp_grif***592 !! 593 !! ** Purpose : Calculates the thermal and haline expansion coefficients at T-points.594 !! 595 !! ** Method : calculates alpha and beta at T-points589 SUBROUTINE eos_alpbet( pts, palpbet, beta0 ) 590 !!---------------------------------------------------------------------- 591 !! *** ROUTINE eos_alpbet *** 592 !! 593 !! ** Purpose : Calculates the in situ thermal/haline expansion ratio at T-points 594 !! 595 !! ** Method : calculates alpha / beta ratio at T-points 596 596 !! * nn_eos = 0 : UNESCO sea water properties 597 !! The brunt-vaisala frequency is computed using the polynomial 598 !! polynomial expression of McDougall (1987): 599 !! N^2 = grav * beta * ( alpha/beta*dk[ t ] - dk[ s ] )/e3w 600 !! If lk_zdfddm=T, the heat/salt buoyancy flux ratio Rrau is 601 !! computed and used in zdfddm module : 602 !! Rrau = alpha/beta * ( dk[ t ] / dk[ s ] ) 597 !! The alpha/beta ratio is returned as 3-D array palpbet using the polynomial 598 !! polynomial expression of McDougall (1987). 599 !! Scalar beta0 is returned = 1. 603 600 !! * nn_eos = 1 : linear equation of state (temperature only) 604 !! N^2 = grav * rn_alpha * dk[ t ]/e3w 601 !! The ratio is undefined, so we return alpha as palpbet 602 !! Scalar beta0 is returned = 0. 605 603 !! * nn_eos = 2 : linear equation of state (temperature & salinity) 606 !! N^2 = grav * (rn_alpha * dk[ t ] - rn_beta * dk[ s ] ) / e3w 607 !! * nn_eos = 3 : Jackett JAOT 2003 ??? 608 !! 609 !! ** Action : - palph, pbeta : thermal and haline expansion coeff. at T-point 610 !!---------------------------------------------------------------------- 611 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature & salinity 612 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: palph, pbeta ! thermal & haline expansion coeff. 613 ! 604 !! The alpha/beta ratio is returned as ralpbet 605 !! Scalar beta0 is returned = 1. 606 !! 607 !! ** Action : - palpbet : thermal/haline expansion ratio at T-points 608 !! : beta0 : 1. or 0. 609 !!---------------------------------------------------------------------- 610 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature & salinity 611 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: palpbet ! thermal/haline expansion ratio 612 REAL(wp), INTENT( out) :: beta0 ! set = 1 except with case 1 eos, rho=rho(T) 613 !! 614 614 INTEGER :: ji, jj, jk ! dummy loop indices 615 REAL(wp) :: zt, zs, zh ! local scalars 615 REAL(wp) :: zt, zs, zh ! local scalars 616 616 !!---------------------------------------------------------------------- 617 617 ! … … 624 624 zt = pts(ji,jj,jk,jp_tem) ! potential temperature 625 625 zs = pts(ji,jj,jk,jp_sal) - 35._wp ! salinity anomaly (s-35) 626 zh = fsdept(ji,jj,jk) ! depth in meters 627 ! 628 pbeta(ji,jj,jk) = ( ( -0.415613e-09_wp * zt + 0.555579e-07_wp ) * zt & 629 & - 0.301985e-05_wp ) * zt & 630 & + 0.785567e-03_wp & 631 & + ( 0.515032e-08_wp * zs & 632 & + 0.788212e-08_wp * zt - 0.356603e-06_wp ) * zs & 633 & + ( ( 0.121551e-17_wp * zh & 634 & - 0.602281e-15_wp * zs & 635 & - 0.175379e-14_wp * zt + 0.176621e-12_wp ) * zh & 636 & + 0.408195e-10_wp * zs & 637 & + ( - 0.213127e-11_wp * zt + 0.192867e-09_wp ) * zt & 638 & - 0.121555e-07_wp ) * zh 639 ! 640 palph(ji,jj,jk) = - pbeta(ji,jj,jk) * & 641 & ((( ( - 0.255019e-07_wp * zt + 0.298357e-05_wp ) * zt & 642 & - 0.203814e-03_wp ) * zt & 643 & + 0.170907e-01_wp ) * zt & 644 & + 0.665157e-01_wp & 645 & + ( - 0.678662e-05_wp * zs & 646 & - 0.846960e-04_wp * zt + 0.378110e-02_wp ) * zs & 647 & + ( ( - 0.302285e-13_wp * zh & 648 & - 0.251520e-11_wp * zs & 649 & + 0.512857e-12_wp * zt * zt ) * zh & 650 & - 0.164759e-06_wp * zs & 651 & +( 0.791325e-08_wp * zt - 0.933746e-06_wp ) * zt & 652 & + 0.380374e-04_wp ) * zh) 626 zh = fsdept(ji,jj,jk) ! depth in meters 627 ! 628 palpbet(ji,jj,jk) = & 629 & ( ( ( - 0.255019e-07_wp * zt + 0.298357e-05_wp ) * zt & 630 & - 0.203814e-03_wp ) * zt & 631 & + 0.170907e-01_wp ) * zt & 632 & + 0.665157e-01_wp & 633 & + ( - 0.678662e-05_wp * zs & 634 & - 0.846960e-04_wp * zt + 0.378110e-02_wp ) * zs & 635 & + ( ( - 0.302285e-13_wp * zh & 636 & - 0.251520e-11_wp * zs & 637 & + 0.512857e-12_wp * zt * zt ) * zh & 638 & - 0.164759e-06_wp * zs & 639 & +( 0.791325e-08_wp * zt - 0.933746e-06_wp ) * zt & 640 & + 0.380374e-04_wp ) * zh 653 641 END DO 654 642 END DO 655 643 END DO 656 ! 657 CASE ( 1 ) 658 palph(:,:,:) = - rn_alpha 659 pbeta(:,:,:) = 0._wp 660 ! 661 CASE ( 2 ) 662 palph(:,:,:) = - rn_alpha 663 pbeta(:,:,:) = rn_beta 644 beta0 = 1._wp 645 ! 646 CASE ( 1 ) !== Linear formulation = F( temperature ) ==! 647 palpbet(:,:,:) = rn_alpha 648 beta0 = 0._wp 649 ! 650 CASE ( 2 ) !== Linear formulation = F( temperature , salinity ) ==! 651 palpbet(:,:,:) = ralpbet 652 beta0 = 1._wp 664 653 ! 665 654 CASE DEFAULT … … 747 736 748 737 !!====================================================================== 749 END MODULE eosbn2 738 END MODULE eosbn2 -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
r2715 r3116 93 93 ! 94 94 IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif ) & 95 & CALL tra_adv_eiv( kt, zun, zvn, zwn, 'TRA' )! add the eiv transport (if necessary)95 & CALL tra_adv_eiv( kt, nit000, zun, zvn, zwn, 'TRA' ) ! add the eiv transport (if necessary) 96 96 ! 97 97 CALL iom_put( "uocetr_eff", zun ) ! output effective transport … … 100 100 101 101 SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==! 102 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! 2nd order centered103 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD104 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts ) ! MUSCL105 CASE ( 4 ) ; CALL tra_adv_muscl2( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! MUSCL2106 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! UBS107 CASE ( 6 ) ; CALL tra_adv_qck ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! QUICKEST102 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, nit000, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! 2nd order centered 103 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD 104 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts ) ! MUSCL 105 CASE ( 4 ) ; CALL tra_adv_muscl2( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! MUSCL2 106 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! UBS 107 CASE ( 6 ) ; CALL tra_adv_qck ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! QUICKEST 108 108 ! 109 109 CASE (-1 ) !== esopa: test all possibility with control print ==! 110 CALL tra_adv_cen2 ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts )110 CALL tra_adv_cen2 ( kt, nit000, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) 111 111 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv0 - Ta: ', mask1=tmask, & 112 112 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 113 CALL tra_adv_tvd ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )113 CALL tra_adv_tvd ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 114 114 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv1 - Ta: ', mask1=tmask, & 115 115 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 116 CALL tra_adv_muscl ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts )116 CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts ) 117 117 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv3 - Ta: ', mask1=tmask, & 118 118 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 119 CALL tra_adv_muscl2( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )119 CALL tra_adv_muscl2( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 120 120 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv4 - Ta: ', mask1=tmask, & 121 121 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 122 CALL tra_adv_ubs ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )122 CALL tra_adv_ubs ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 123 123 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv5 - Ta: ', mask1=tmask, & 124 124 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 125 CALL tra_adv_qck ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )125 CALL tra_adv_qck ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 126 126 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv6 - Ta: ', mask1=tmask, & 127 127 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90
r2977 r3116 53 53 CONTAINS 54 54 55 SUBROUTINE tra_adv_cen2( kt, cdtype, pun, pvn, pwn,&55 SUBROUTINE tra_adv_cen2( kt, kit000, cdtype, pun, pvn, pwn, & 56 56 & ptb, ptn, pta, kjpt ) 57 57 !!---------------------------------------------------------------------- … … 116 116 ! 117 117 INTEGER , INTENT(in ) :: kt ! ocean time-step index 118 INTEGER , INTENT(in ) :: kit000 ! first time step index 118 119 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 119 120 INTEGER , INTENT(in ) :: kjpt ! number of tracers … … 135 136 ENDIF 136 137 137 IF( kt == nit000 ) THEN138 IF( kt == kit000 ) THEN 138 139 IF(lwp) WRITE(numout,*) 139 140 IF(lwp) WRITE(numout,*) 'tra_adv_cen2 : 2nd order centered advection scheme on ', cdtype … … 141 142 IF(lwp) WRITE(numout,*) 142 143 ! 143 ALLOCATE( upsmsk(jpi,jpj), STAT=ierr ) 144 IF( ierr /= 0 ) CALL ctl_stop('STOP', 'tra_adv_cen2: unable to allocate array') 144 IF (.not. ALLOCATED(upsmsk))THEN 145 ALLOCATE( upsmsk(jpi,jpj), STAT=ierr ) 146 IF( ierr /= 0 ) CALL ctl_stop('STOP', 'tra_adv_cen2: unable to allocate array') 147 ENDIF 148 145 149 ! 146 150 upsmsk(:,:) = 0._wp ! not upstream by default -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90
r2715 r3116 45 45 CONTAINS 46 46 47 SUBROUTINE tra_adv_eiv( kt, pun, pvn, pwn, cdtype )47 SUBROUTINE tra_adv_eiv( kt, kit000, pun, pvn, pwn, cdtype ) 48 48 !!---------------------------------------------------------------------- 49 49 !! *** ROUTINE tra_adv_eiv *** … … 69 69 #endif 70 70 INTEGER , INTENT(in ) :: kt ! ocean time-step index 71 INTEGER , INTENT(in ) :: kit000 ! first time step index 71 72 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 72 73 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pun ! in : 3 ocean velocity components … … 90 91 ENDIF 91 92 92 IF( kt == nit000 ) THEN93 IF( kt == kit000 ) THEN 93 94 IF(lwp) WRITE(numout,*) 94 95 IF(lwp) WRITE(numout,*) 'tra_adv_eiv : eddy induced advection on ', cdtype,' :' … … 203 204 !!---------------------------------------------------------------------- 204 205 CONTAINS 205 SUBROUTINE tra_adv_eiv( kt, pun, pvn, pwn, cdtype ) ! Empty routine206 SUBROUTINE tra_adv_eiv( kt, kit000, pun, pvn, pwn, cdtype ) ! Empty routine 206 207 INTEGER :: kt 208 INTEGER :: kit000 207 209 CHARACTER(len=3) :: cdtype 208 210 REAL, DIMENSION(:,:,:) :: pun, pvn, pwn -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90
r2977 r3116 44 44 CONTAINS 45 45 46 SUBROUTINE tra_adv_muscl( kt, cdtype, p2dt, pun, pvn, pwn, &46 SUBROUTINE tra_adv_muscl( kt, kit000, cdtype, p2dt, pun, pvn, pwn, & 47 47 & ptb, pta, kjpt ) 48 48 !!---------------------------------------------------------------------- … … 66 66 ! 67 67 INTEGER , INTENT(in ) :: kt ! ocean time-step index 68 INTEGER , INTENT(in ) :: kit000 ! first time step index 68 69 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 69 70 INTEGER , INTENT(in ) :: kjpt ! number of tracers … … 83 84 ENDIF 84 85 85 IF( kt == nit000 ) THEN86 IF( kt == kit000 ) THEN 86 87 IF(lwp) WRITE(numout,*) 87 88 IF(lwp) WRITE(numout,*) 'tra_adv : MUSCL advection scheme on ', cdtype -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90
r2977 r3116 42 42 CONTAINS 43 43 44 SUBROUTINE tra_adv_muscl2( kt, cdtype, p2dt, pun, pvn, pwn, &44 SUBROUTINE tra_adv_muscl2( kt, kit000, cdtype, p2dt, pun, pvn, pwn, & 45 45 & ptb, ptn, pta, kjpt ) 46 46 !!---------------------------------------------------------------------- … … 64 64 !! 65 65 INTEGER , INTENT(in ) :: kt ! ocean time-step index 66 INTEGER , INTENT(in ) :: kit000 ! first time step index 66 67 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 67 68 INTEGER , INTENT(in ) :: kjpt ! number of tracers … … 81 82 ENDIF 82 83 83 IF( kt == nit000 ) THEN84 IF( kt == kit000 ) THEN 84 85 IF(lwp) WRITE(numout,*) 85 86 IF(lwp) WRITE(numout,*) 'tra_adv_muscl2 : MUSCL2 advection scheme on ', cdtype -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90
r2977 r3116 45 45 CONTAINS 46 46 47 SUBROUTINE tra_adv_qck ( kt, cdtype, p2dt, pun, pvn, pwn, &47 SUBROUTINE tra_adv_qck ( kt, kit000, cdtype, p2dt, pun, pvn, pwn, & 48 48 & ptb, ptn, pta, kjpt ) 49 49 !!---------------------------------------------------------------------- … … 82 82 !!---------------------------------------------------------------------- 83 83 INTEGER , INTENT(in ) :: kt ! ocean time-step index 84 INTEGER , INTENT(in ) :: kit000 ! first time step index 84 85 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 85 86 INTEGER , INTENT(in ) :: kjpt ! number of tracers … … 90 91 !!---------------------------------------------------------------------- 91 92 92 IF( kt == nit000 ) THEN93 IF( kt == kit000 ) THEN 93 94 IF(lwp) WRITE(numout,*) 94 95 IF(lwp) WRITE(numout,*) 'tra_adv_qck : 3rd order quickest advection scheme on ', cdtype -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r2715 r3116 51 51 CONTAINS 52 52 53 SUBROUTINE tra_adv_tvd ( kt, cdtype, p2dt, pun, pvn, pwn, &53 SUBROUTINE tra_adv_tvd ( kt, kit000, cdtype, p2dt, pun, pvn, pwn, & 54 54 & ptb, ptn, pta, kjpt ) 55 55 !!---------------------------------------------------------------------- … … 71 71 ! 72 72 INTEGER , INTENT(in ) :: kt ! ocean time-step index 73 INTEGER , INTENT(in ) :: kit000 ! first time step index 73 74 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 74 75 INTEGER , INTENT(in ) :: kjpt ! number of tracers … … 89 90 ENDIF 90 91 91 IF( kt == nit000 ) THEN92 IF( kt == kit000 ) THEN 92 93 IF(lwp) WRITE(numout,*) 93 94 IF(lwp) WRITE(numout,*) 'tra_adv_tvd : TVD advection scheme on ', cdtype -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
r2715 r3116 40 40 CONTAINS 41 41 42 SUBROUTINE tra_adv_ubs ( kt, cdtype, p2dt, pun, pvn, pwn, &42 SUBROUTINE tra_adv_ubs ( kt, kit000, cdtype, p2dt, pun, pvn, pwn, & 43 43 & ptb, ptn, pta, kjpt ) 44 44 !!---------------------------------------------------------------------- … … 80 80 ! 81 81 INTEGER , INTENT(in ) :: kt ! ocean time-step index 82 INTEGER , INTENT(in ) :: kit000 ! first time step index 82 83 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 83 84 INTEGER , INTENT(in ) :: kjpt ! number of tracers … … 97 98 ENDIF 98 99 99 IF( kt == nit000 ) THEN100 IF( kt == kit000 ) THEN 100 101 IF(lwp) WRITE(numout,*) 101 102 IF(lwp) WRITE(numout,*) 'tra_adv_ubs : horizontal UBS advection scheme on ', cdtype -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
r2715 r3116 106 106 !!---------------------------------------------------------------------- 107 107 108 IF( l_trdtra ) THEN !* Save ta and sa trends108 IF( l_trdtra ) THEN !* Save ta and sa trends 109 109 ALLOCATE( ztrdt(jpi,jpj,jpk) ) ; ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 110 110 ALLOCATE( ztrds(jpi,jpj,jpk) ) ; ztrds(:,:,:) = tsa(:,:,:,jp_sal) 111 111 ENDIF 112 112 113 IF( l_bbl ) CALL bbl( kt, 'TRA' )!* bbl coef. and transport (only if not already done in trcbbl)114 115 116 IF( nn_bbl_ldf == 1 ) THEN !* Diffusive bbl113 IF( l_bbl ) CALL bbl( kt, nit000, 'TRA' ) !* bbl coef. and transport (only if not already done in trcbbl) 114 115 116 IF( nn_bbl_ldf == 1 ) THEN !* Diffusive bbl 117 117 CALL tra_bbl_dif( tsb, tsa, jpts ) 118 118 IF( ln_ctl ) & … … 311 311 312 312 313 SUBROUTINE bbl( kt, cdtype )313 SUBROUTINE bbl( kt, kit000, cdtype ) 314 314 !!---------------------------------------------------------------------- 315 315 !! *** ROUTINE bbl *** … … 343 343 ! 344 344 INTEGER , INTENT(in ) :: kt ! ocean time-step index 345 INTEGER , INTENT(in ) :: kit000 ! first time step index 345 346 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 346 347 !! … … 389 390 ENDIF 390 391 391 IF( kt == nit000 ) THEN392 IF( kt == kit000 ) THEN 392 393 IF(lwp) WRITE(numout,*) 393 394 IF(lwp) WRITE(numout,*) 'trabbl:bbl : Compute bbl velocities and diffusive coefficients in ', cdtype … … 537 538 !! 538 539 !! ** Method : Read the nambbl namelist and check the parameters 539 !! called by nemo_init at the first timestep ( nit000)540 !! called by nemo_init at the first timestep (kit000) 540 541 !!---------------------------------------------------------------------- 541 542 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90
r2977 r3116 70 70 71 71 SELECT CASE ( nldf ) ! compute lateral mixing trend and add it to the general trend 72 CASE ( 0 ) ; CALL tra_ldf_lap ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts ) ! iso-level laplacian72 CASE ( 0 ) ; CALL tra_ldf_lap ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts ) ! iso-level laplacian 73 73 CASE ( 1 ) ! rotated laplacian 74 74 IF( ln_traldf_grif ) THEN 75 CALL tra_ldf_iso_grif( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) ! Griffies operator75 CALL tra_ldf_iso_grif( kt, nit000,'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) ! Griffies operator 76 76 ELSE 77 CALL tra_ldf_iso ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) ! Madec operator78 ENDIF 79 CASE ( 2 ) ; CALL tra_ldf_bilap ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts ) ! iso-level bilaplacian80 CASE ( 3 ) ; CALL tra_ldf_bilapg ( kt, 'TRA', tsb, tsa, jpts ) ! s-coord. geopot. bilap.77 CALL tra_ldf_iso ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) ! Madec operator 78 ENDIF 79 CASE ( 2 ) ; CALL tra_ldf_bilap ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts ) ! iso-level bilaplacian 80 CASE ( 3 ) ; CALL tra_ldf_bilapg ( kt, nit000, 'TRA', tsb, tsa, jpts ) ! s-coord. geopot. bilap. 81 81 ! 82 82 CASE ( -1 ) ! esopa: test all possibility with control print 83 CALL tra_ldf_lap ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts )83 CALL tra_ldf_lap ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts ) 84 84 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf0 - Ta: ', mask1=tmask, & 85 85 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 86 86 IF( ln_traldf_grif ) THEN 87 CALL tra_ldf_iso_grif( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )87 CALL tra_ldf_iso_grif( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) 88 88 ELSE 89 CALL tra_ldf_iso ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )89 CALL tra_ldf_iso ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) 90 90 ENDIF 91 91 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf1 - Ta: ', mask1=tmask, & 92 92 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 93 CALL tra_ldf_bilap ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts )93 CALL tra_ldf_bilap ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts ) 94 94 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf2 - Ta: ', mask1=tmask, & 95 95 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 96 CALL tra_ldf_bilapg( kt, 'TRA', tsb, tsa, jpts )96 CALL tra_ldf_bilapg( kt, nit000, 'TRA', tsb, tsa, jpts ) 97 97 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf3 - Ta: ', mask1=tmask, & 98 98 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) … … 299 299 ! Compute the ldf trends 300 300 ! ---------------------- 301 CALL tra_ldf( nit000 +1 ) ! horizontal components (+1: no more init)302 CALL tra_zdf( nit000 ) ! vertical component (if necessary nit000 to performed the init)301 CALL tra_ldf( nit000 + 1 ) ! horizontal components (+1: no more init) 302 CALL tra_zdf( nit000 ) ! vertical component (if necessary nit000 to performed the init) 303 303 304 304 ! finalise the computation and recover all arrays -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90
r2715 r3116 47 47 CONTAINS 48 48 49 SUBROUTINE tra_ldf_bilap( kt, cdtype, pgu, pgv, &49 SUBROUTINE tra_ldf_bilap( kt, kit000, cdtype, pgu, pgv, & 50 50 & ptb, pta, kjpt ) 51 51 !!---------------------------------------------------------------------- … … 79 79 !! 80 80 INTEGER , INTENT(in ) :: kt ! ocean time-step index 81 INTEGER , INTENT(in ) :: kit000 ! first time step index 81 82 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 82 83 INTEGER , INTENT(in ) :: kjpt ! number of tracers … … 93 94 ENDIF 94 95 95 IF( kt == nit000 ) THEN96 IF( kt == kit000 ) THEN 96 97 IF(lwp) WRITE(numout,*) 97 98 IF(lwp) WRITE(numout,*) 'tra_ldf_bilap : iso-level biharmonic operator on ', cdtype -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90
r2715 r3116 42 42 CONTAINS 43 43 44 SUBROUTINE tra_ldf_bilapg( kt, cdtype, ptb, pta, kjpt )44 SUBROUTINE tra_ldf_bilapg( kt, kit000, cdtype, ptb, pta, kjpt ) 45 45 !!---------------------------------------------------------------------- 46 46 !! *** ROUTINE tra_ldf_bilapg *** … … 70 70 ! 71 71 INTEGER , INTENT(in ) :: kt ! ocean time-step index 72 INTEGER , INTENT(in ) :: kit000 ! first time step index 72 73 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 73 74 INTEGER , INTENT(in ) :: kjpt ! number of tracers … … 82 83 ENDIF 83 84 84 IF( kt == nit000 ) THEN85 IF( kt == kit000 ) THEN 85 86 IF(lwp) WRITE(numout,*) 86 87 IF(lwp) WRITE(numout,*) 'tra_ldf_bilapg : horizontal biharmonic operator in s-coordinate on ', cdtype … … 345 346 !!---------------------------------------------------------------------- 346 347 CONTAINS 347 SUBROUTINE tra_ldf_bilapg( kt, cdtype, ptb, pta, kjpt ) ! Empty routine 348 SUBROUTINE tra_ldf_bilapg( kt, kit000, cdtype, ptb, pta, kjpt ) ! Empty routine 349 INTEGER :: kt, kit000 348 350 CHARACTER(len=3) :: cdtype 349 351 REAL, DIMENSION(:,:,:,:) :: ptb, pta 350 WRITE(*,*) 'tra_ldf_iso: You should not have seen this print! error?', kt, cdtype, ptb(1,1,1,1), pta(1,1,1,1), kjpt 352 WRITE(*,*) 'tra_ldf_iso: You should not have seen this print! error?', & 353 & kt, kit000, cdtype, ptb(1,1,1,1), pta(1,1,1,1), kjpt 351 354 END SUBROUTINE tra_ldf_bilapg 352 355 #endif -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r2715 r3116 49 49 CONTAINS 50 50 51 SUBROUTINE tra_ldf_iso( kt, cdtype, pgu, pgv, &51 SUBROUTINE tra_ldf_iso( kt, kit000, cdtype, pgu, pgv, & 52 52 & ptb, pta, kjpt, pahtb0 ) 53 53 !!---------------------------------------------------------------------- … … 96 96 ! 97 97 INTEGER , INTENT(in ) :: kt ! ocean time-step index 98 INTEGER , INTENT(in ) :: kit000 ! first time step index 98 99 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 99 100 INTEGER , INTENT(in ) :: kjpt ! number of tracers … … 116 117 ENDIF 117 118 118 IF( kt == nit000 ) THEN119 IF( kt == kit000 ) THEN 119 120 IF(lwp) WRITE(numout,*) 120 121 IF(lwp) WRITE(numout,*) 'tra_ldf_iso : rotated laplacian diffusion operator on ', cdtype … … 301 302 !!---------------------------------------------------------------------- 302 303 CONTAINS 303 SUBROUTINE tra_ldf_iso( kt, cdtype, pgu, pgv, ptb, pta, kjpt, pahtb0 ) ! Empty routine 304 SUBROUTINE tra_ldf_iso( kt, kit000,cdtype, pgu, pgv, ptb, pta, kjpt, pahtb0 ) ! Empty routine 305 INTEGER:: kt, kit000 304 306 CHARACTER(len=3) :: cdtype 305 307 REAL, DIMENSION(:,:,:) :: pgu, pgv ! tracer gradient at pstep levels 306 308 REAL, DIMENSION(:,:,:,:) :: ptb, pta 307 WRITE(*,*) 'tra_ldf_iso: You should not have seen this print! error?', kt, cdtype, pgu(1,1,1), pgv(1,1,1), &308 & 309 WRITE(*,*) 'tra_ldf_iso: You should not have seen this print! error?', kt, kit000, cdtype, & 310 & pgu(1,1,1), pgv(1,1,1), ptb(1,1,1,1), pta(1,1,1,1), kjpt, pahtb0 309 311 END SUBROUTINE tra_ldf_iso 310 312 #endif -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90
r2715 r3116 4 4 !! Ocean tracers: horizontal component of the lateral tracer mixing trend 5 5 !!====================================================================== 6 !! History : 3.3 ! 2010-10 (G. Nurser, C. Harris, G. Madec) 6 !! History : 3.3 ! 2010-10 (G. Nurser, C. Harris, G. Madec) 7 7 !! ! Griffies operator version adapted from traldf_iso.F90 8 8 !!---------------------------------------------------------------------- … … 11 11 !! 'key_ldfslp' slope of the lateral diffusive direction 12 12 !!---------------------------------------------------------------------- 13 !! tra_ldf_iso_grif : update the tracer trend with the horizontal component 14 !! of the Griffies iso-neutral laplacian operator 13 !! tra_ldf_iso_grif : update the tracer trend with the horizontal component 14 !! of the Griffies iso-neutral laplacian operator 15 15 !!---------------------------------------------------------------------- 16 16 USE oce ! ocean dynamics and active tracers … … 34 34 REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE, SAVE :: psix_eiv, psiy_eiv !: eiv stream function (diag only) 35 35 REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE, SAVE :: ah_wslp2 !: aeiv*w-slope^2 36 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: zdkt ! atypic workspace36 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: zdkt3d !: vertical tracer gradient at 2 levels 37 37 38 38 !! * Substitutions … … 48 48 CONTAINS 49 49 50 SUBROUTINE tra_ldf_iso_grif( kt, cdtype, pgu, pgv, &50 SUBROUTINE tra_ldf_iso_grif( kt, kit000, cdtype, pgu, pgv, & 51 51 & ptb, pta, kjpt, pahtb0 ) 52 52 !!---------------------------------------------------------------------- 53 53 !! *** ROUTINE tra_ldf_iso_grif *** 54 54 !! 55 !! ** Purpose : Compute the before horizontal tracer (t & s) diffusive 56 !! trend for a laplacian tensor (ezxcept the dz[ dz[.] ] term) and 55 !! ** Purpose : Compute the before horizontal tracer (t & s) diffusive 56 !! trend for a laplacian tensor (ezxcept the dz[ dz[.] ] term) and 57 57 !! add it to the general trend of tracer equation. 58 58 !! 59 !! ** Method : The horizontal component of the lateral diffusive trends 59 !! ** Method : The horizontal component of the lateral diffusive trends 60 60 !! is provided by a 2nd order operator rotated along neural or geopo- 61 61 !! tential surfaces to which an eddy induced advection can be added … … 67 67 !! 68 68 !! 2nd part : horizontal fluxes of the lateral mixing operator 69 !! ======== 69 !! ======== 70 70 !! zftu = (aht+ahtb0) e2u*e3u/e1u di[ tb ] 71 71 !! - aht e2u*uslp dk[ mi(mk(tb)) ] … … 95 95 ! 96 96 INTEGER , INTENT(in ) :: kt ! ocean time-step index 97 INTEGER , INTENT(in ) :: kit000 ! first time step index 97 98 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 98 99 INTEGER , INTENT(in ) :: kjpt ! number of tracers 99 100 REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels 100 101 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 101 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 102 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 102 103 REAL(wp) , INTENT(in ) :: pahtb0 ! background diffusion coef 103 104 ! … … 108 109 REAL(wp) :: zmskv, zabe2, zcof2, zcoef4 ! - - 109 110 REAL(wp) :: zcoef0, zbtr ! - - 110 !REAL(wp), POINTER, DIMENSION(:,:,:) :: zdkt ! 2D+1 workspace111 111 ! 112 112 REAL(wp) :: zslope_skew, zslope_iso, zslope2, zbu, zbv … … 121 121 CALL ctl_stop('tra_ldf_iso_grif: requested workspace arrays unavailable.') ; RETURN 122 122 ENDIF 123 ! ARP - line below uses 'bounds re-mapping' which is only defined in 124 ! Fortran 2003 and up. We would be OK if code was written to use 125 ! zdkt(:,:,1:2) instead as then wouldn't need to re-map bounds. 126 ! As it is, we make zdkt a module array and allocate it in _alloc(). 127 !zdkt(1:jpi,1:jpj,0:1) => wrk_3d_9(:,:,1:2) 128 129 IF( kt == nit000 ) THEN 123 124 IF( kt == kit000 .AND. .NOT.ALLOCATED(ah_wslp2) ) THEN 130 125 IF(lwp) WRITE(numout,*) 131 126 IF(lwp) WRITE(numout,*) 'tra_ldf_iso_grif : rotated laplacian diffusion operator on ', cdtype 132 IF(lwp) WRITE(numout,*) ' WARNING: STILL UNDER TEST, NOT RECOMMENDED. USE AT YOUR OWN PERIL'133 127 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 134 ALLOCATE( ah_wslp2(jpi,jpj,jpk) , zdkt (jpi,jpj,0:1), STAT=ierr )128 ALLOCATE( ah_wslp2(jpi,jpj,jpk) , zdkt3d(jpi,jpj,0:1), STAT=ierr ) 135 129 IF( lk_mpp ) CALL mpp_sum ( ierr ) 136 130 IF( ierr > 0 ) CALL ctl_stop('STOP', 'tra_ldf_iso_grif: unable to allocate arrays') 137 131 IF( ln_traldf_gdia ) THEN 138 ALLOCATE( psix_eiv(jpi,jpj,jpk) , psiy_eiv(jpi,jpj,jpk) , STAT=ierr ) 139 IF( lk_mpp ) CALL mpp_sum ( ierr ) 140 IF( ierr > 0 ) CALL ctl_stop('STOP', 'tra_ldf_iso_grif: unable to allocate diagnostics') 132 IF (.not. ALLOCATED(psix_eiv))THEN 133 ALLOCATE( psix_eiv(jpi,jpj,jpk) , psiy_eiv(jpi,jpj,jpk) , STAT=ierr ) 134 IF( lk_mpp ) CALL mpp_sum ( ierr ) 135 IF( ierr > 0 ) CALL ctl_stop('STOP', 'tra_ldf_iso_grif: unable to allocate diagnostics') 136 ENDIF 141 137 ENDIF 142 138 ENDIF 143 139 144 140 !!---------------------------------------------------------------------- 145 !! 0 - calculate ah_wslp2, psix_eiv, psiy_eiv 141 !! 0 - calculate ah_wslp2, psix_eiv, psiy_eiv 146 142 !!---------------------------------------------------------------------- 147 143 148 !!gm Future development: consider using Ah defined at T-points and attached to the 4 t-point triads144 !!gm Future development: consider using Ah defined at T-points and attached to the 4 t-point triads 149 145 150 146 ah_wslp2(:,:,:) = 0._wp … … 159 155 DO jj = 1, jpjm1 160 156 DO ji = 1, fs_jpim1 157 ze1ur = 1._wp / e1u(ji,jj) 161 158 ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp) 162 159 zbu = 0.25_wp * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 163 zah = fsahtu(ji,jj,jk) ! 160 zah = fsahtu(ji,jj,jk) ! fsaht(ji+ip,jj,jk) 164 161 zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 165 zslope2 = zslope_skew - ( fsdept(ji+1,jj,jk) - fsdept(ji ,jj ,jk) ) * ze1ur * umask(ji,jj,jk+kp) 162 ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces 163 ! (do this by *adding* gradient of depth) 164 zslope2 = zslope_skew + ( fsdept(ji+1,jj,jk) - fsdept(ji ,jj ,jk) ) * ze1ur * umask(ji,jj,jk+kp) 166 165 zslope2 = zslope2 *zslope2 167 166 ah_wslp2(ji+ip,jj,jk+kp) = ah_wslp2(ji+ip,jj,jk+kp) & 168 167 & + zah * ( zbu * ze3wr / ( e1t(ji+ip,jj) * e2t(ji+ip,jj) ) ) * zslope2 169 168 IF( ln_traldf_gdia ) THEN 170 zaei_slp = fsaeiw(ji+ip,jj,jk) * zslope_skew !fsaeit(ji+ip,jj,jk)*zslope_skew169 zaei_slp = fsaeiw(ji+ip,jj,jk) * zslope_skew ! fsaeit(ji+ip,jj,jk)*zslope_skew 171 170 psix_eiv(ji,jj,jk+kp) = psix_eiv(ji,jj,jk+kp) + 0.25_wp * zaei_slp 172 171 ENDIF … … 182 181 DO jj = 1, jpjm1 183 182 DO ji=1,fs_jpim1 183 ze2vr = 1._wp / e2v(ji,jj) 184 184 ze3wr = 1.0_wp / fse3w(ji,jj+jp,jk+kp) 185 185 zbv = 0.25_wp * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 186 zah = fsaht u(ji,jj,jk) !fsaht(ji,jj+jp,jk)186 zah = fsahtv(ji,jj,jk) ! fsaht(ji,jj+jp,jk) 187 187 zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 188 zslope2 = zslope_skew - ( fsdept(ji,jj+1,jk) - fsdept(ji,jj,jk) ) * ze2vr * vmask(ji,jj,jk+kp) 188 ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces 189 ! (do this by *adding* gradient of depth) 190 zslope2 = zslope_skew + ( fsdept(ji,jj+1,jk) - fsdept(ji,jj,jk) ) * ze2vr * vmask(ji,jj,jk+kp) 189 191 zslope2 = zslope2 * zslope2 190 192 ah_wslp2(ji,jj+jp,jk+kp) = ah_wslp2(ji,jj+jp,jk+kp) & 191 193 & + zah * ( zbv * ze3wr / ( e1t(ji,jj+jp) * e2t(ji,jj+jp) ) ) * zslope2 192 194 IF( ln_traldf_gdia ) THEN 193 zaei_slp = fsaeiw(ji,jj+jp,jk) * zslope_skew !fsaeit(ji,jj+jp,jk)*zslope_skew195 zaei_slp = fsaeiw(ji,jj+jp,jk) * zslope_skew ! fsaeit(ji,jj+jp,jk)*zslope_skew 194 196 psiy_eiv(ji,jj,jk+kp) = psiy_eiv(ji,jj,jk+kp) + 0.25_wp * zaei_slp 195 197 ENDIF … … 207 209 zftu(:,:,:) = 0._wp 208 210 zftv(:,:,:) = 0._wp 209 ! 211 ! 210 212 DO jk = 1, jpkm1 !== before lateral T & S gradients at T-level jk ==! 211 213 DO jj = 1, jpjm1 … … 216 218 END DO 217 219 END DO 218 IF( ln_zps ) THEN! partial steps: correction at the last level220 IF( ln_zps.and.l_grad_zps ) THEN ! partial steps: correction at the last level 219 221 # if defined key_vectopt_loop 220 222 DO jj = 1, 1 … … 224 226 DO ji = 1, jpim1 225 227 # endif 226 zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn) 227 zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) 228 zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn) 229 zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) 228 230 END DO 229 231 END DO … … 237 239 ! 238 240 ! !== Vertical tracer gradient at level jk and jk+1 239 zdkt (:,:,1) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * tmask(:,:,jk+1)241 zdkt3d(:,:,1) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * tmask(:,:,jk+1) 240 242 ! 241 ! ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2)242 IF( jk == 1 ) THEN ; zdkt (:,:,0) = zdkt(:,:,1)243 ELSE ; zdkt (:,:,0) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * tmask(:,:,jk)243 ! ! surface boundary condition: zdkt3d(jk=0)=zdkt3d(jk=1) 244 IF( jk == 1 ) THEN ; zdkt3d(:,:,0) = zdkt3d(:,:,1) 245 ELSE ; zdkt3d(:,:,0) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * tmask(:,:,jk) 244 246 ENDIF 245 247 246 IF( .NOT. l_triad_iso ) THEN 247 triadi = triadi_g 248 triadj = triadj_g 249 ENDIF 250 251 DO ip = 0, 1 !== Horizontal & vertical fluxes 252 DO kp = 0, 1 253 DO jj = 1, jpjm1 254 DO ji = 1, fs_jpim1 255 ze1ur = 1._wp / e1u(ji,jj) 256 zdxt = zdit(ji,jj,jk) * ze1ur 257 ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp) 258 zdzt = zdkt(ji+ip,jj,kp) * ze3wr 259 zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 260 zslope_iso = triadi(ji+ip,jj,jk,1-ip,kp) 261 262 zbu = 0.25_wp * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 263 zah = fsahtu(ji,jj,jk) !*umask(ji,jj,jk+kp) !fsaht(ji+ip,jj,jk) ===>> ???? 264 zah_slp = zah * zslope_iso 265 zaei_slp = fsaeiw(ji+ip,jj,jk) * zslope_skew !fsaeit(ji+ip,jj,jk)*zslope_skew 266 zftu(ji,jj,jk) = zftu(ji,jj,jk) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur 267 ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - (zah_slp + zaei_slp) * zdxt * zbu * ze3wr 248 249 IF (ln_botmix_grif) THEN 250 DO ip = 0, 1 !== Horizontal & vertical fluxes 251 DO kp = 0, 1 252 DO jj = 1, jpjm1 253 DO ji = 1, fs_jpim1 254 ze1ur = 1._wp / e1u(ji,jj) 255 zdxt = zdit(ji,jj,jk) * ze1ur 256 ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp) 257 zdzt = zdkt3d(ji+ip,jj,kp) * ze3wr 258 zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 259 zslope_iso = triadi(ji+ip,jj,jk,1-ip,kp) 260 261 zbu = 0.25_wp * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 262 ! ln_botmix_grif is .T. don't mask zah for bottom half cells 263 zah = fsahtu(ji,jj,jk) !*umask(ji,jj,jk+kp) !fsaht(ji+ip,jj,jk) ===>> ???? 264 zah_slp = zah * zslope_iso 265 zaei_slp = fsaeiw(ji+ip,jj,jk) * zslope_skew !fsaeit(ji+ip,jj,jk)*zslope_skew 266 zftu(ji,jj,jk) = zftu(ji,jj,jk) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur 267 ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - (zah_slp + zaei_slp) * zdxt * zbu * ze3wr 268 END DO 268 269 END DO 269 270 END DO 270 271 END DO 271 END DO 272 273 DO jp = 0, 1 274 DO kp = 0, 1 275 DO jj = 1, jpjm1 276 DO ji = 1, fs_jpim1 277 ze2vr = 1._wp / e2v(ji,jj) 278 zdyt = zdjt(ji,jj,jk) * ze2vr 279 ze3wr = 1._wp / fse3w(ji,jj+jp,jk+kp) 280 zdzt = zdkt(ji,jj+jp,kp) * ze3wr 281 zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 282 zslope_iso = triadj(ji,jj+jp,jk,1-jp,kp) 283 zbv = 0.25_wp * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 284 zah = fsahtv(ji,jj,jk) !*vmask(ji,jj,jk+kp) !fsaht(ji,jj+jp,jk) 285 zah_slp = zah * zslope_iso 286 zaei_slp = fsaeiw(ji,jj+jp,jk) * zslope_skew !fsaeit(ji,jj+jp,jk)*zslope_skew 287 zftv(ji,jj,jk) = zftv(ji,jj,jk) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr 288 ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - (zah_slp + zaei_slp) * zdyt * zbv * ze3wr 272 273 DO jp = 0, 1 274 DO kp = 0, 1 275 DO jj = 1, jpjm1 276 DO ji = 1, fs_jpim1 277 ze2vr = 1._wp / e2v(ji,jj) 278 zdyt = zdjt(ji,jj,jk) * ze2vr 279 ze3wr = 1._wp / fse3w(ji,jj+jp,jk+kp) 280 zdzt = zdkt3d(ji,jj+jp,kp) * ze3wr 281 zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 282 zslope_iso = triadj(ji,jj+jp,jk,1-jp,kp) 283 zbv = 0.25_wp * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 284 ! ln_botmix_grif is .T. don't mask zah for bottom half cells 285 zah = fsahtv(ji,jj,jk) !*vmask(ji,jj,jk+kp) ! fsaht(ji,jj+jp,jk) 286 zah_slp = zah * zslope_iso 287 zaei_slp = fsaeiw(ji,jj+jp,jk) * zslope_skew ! fsaeit(ji,jj+jp,jk)*zslope_skew 288 zftv(ji,jj,jk) = zftv(ji,jj,jk) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr 289 ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - (zah_slp + zaei_slp) * zdyt * zbv * ze3wr 290 END DO 289 291 END DO 290 292 END DO 291 293 END DO 292 END DO 293 294 ! !== divergence and add to the general trend ==! 294 ELSE 295 DO ip = 0, 1 !== Horizontal & vertical fluxes 296 DO kp = 0, 1 297 DO jj = 1, jpjm1 298 DO ji = 1, fs_jpim1 299 ze1ur = 1._wp / e1u(ji,jj) 300 zdxt = zdit(ji,jj,jk) * ze1ur 301 ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp) 302 zdzt = zdkt3d(ji+ip,jj,kp) * ze3wr 303 zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 304 zslope_iso = triadi(ji+ip,jj,jk,1-ip,kp) 305 306 zbu = 0.25_wp * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 307 ! ln_botmix_grif is .F. mask zah for bottom half cells 308 zah = fsahtu(ji,jj,jk) * umask(ji,jj,jk+kp) ! fsaht(ji+ip,jj,jk) ===>> ???? 309 zah_slp = zah * zslope_iso 310 zaei_slp = fsaeiw(ji+ip,jj,jk) * zslope_skew ! fsaeit(ji+ip,jj,jk)*zslope_skew 311 zftu(ji,jj,jk) = zftu(ji,jj,jk) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur 312 ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - (zah_slp + zaei_slp) * zdxt * zbu * ze3wr 313 END DO 314 END DO 315 END DO 316 END DO 317 318 DO jp = 0, 1 319 DO kp = 0, 1 320 DO jj = 1, jpjm1 321 DO ji = 1, fs_jpim1 322 ze2vr = 1._wp / e2v(ji,jj) 323 zdyt = zdjt(ji,jj,jk) * ze2vr 324 ze3wr = 1._wp / fse3w(ji,jj+jp,jk+kp) 325 zdzt = zdkt3d(ji,jj+jp,kp) * ze3wr 326 zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 327 zslope_iso = triadj(ji,jj+jp,jk,1-jp,kp) 328 zbv = 0.25_wp * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 329 ! ln_botmix_grif is .F. mask zah for bottom half cells 330 zah = fsahtv(ji,jj,jk) * vmask(ji,jj,jk+kp) ! fsaht(ji,jj+jp,jk) 331 zah_slp = zah * zslope_iso 332 zaei_slp = fsaeiw(ji,jj+jp,jk) * zslope_skew ! fsaeit(ji,jj+jp,jk)*zslope_skew 333 zftv(ji,jj,jk) = zftv(ji,jj,jk) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr 334 ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - (zah_slp + zaei_slp) * zdyt * zbv * ze3wr 335 END DO 336 END DO 337 END DO 338 END DO 339 END IF 340 ! !== divergence and add to the general trend ==! 295 341 DO jj = 2 , jpjm1 296 DO ji = fs_2, fs_jpim1 342 DO ji = fs_2, fs_jpim1 ! vector opt. 297 343 zbtr = 1._wp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 298 344 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zbtr * ( zftu(ji-1,jj,jk) - zftu(ji,jj,jk) & … … 303 349 END DO 304 350 ! 305 DO jk = 1, jpkm1 !== Divergence of vertical fluxes added to the general tracer trend351 DO jk = 1, jpkm1 !== Divergence of vertical fluxes added to the general tracer trend 306 352 DO jj = 2, jpjm1 307 DO ji = fs_2, fs_jpim1 353 DO ji = fs_2, fs_jpim1 ! vector opt. 308 354 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ( ztfw(ji,jj,jk+1) - ztfw(ji,jj,jk) ) & 309 355 & / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) … … 312 358 END DO 313 359 ! 314 ! ! "Poleward" diffusive heat or salt transports (T-S case only)360 ! ! "Poleward" diffusive heat or salt transports (T-S case only) 315 361 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 316 362 IF( jn == jp_tem) htr_ldf(:) = ptr_vj( zftv(:,:,:) ) ! 3.3 names … … 320 366 #if defined key_diaar5 321 367 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN 322 z2d(:,:) = 0._wp 323 zztmp = rau0 * rcp 368 z2d(:,:) = 0._wp 369 zztmp = rau0 * rcp 324 370 DO jk = 1, jpkm1 325 371 DO jj = 2, jpjm1 326 372 DO ji = fs_2, fs_jpim1 ! vector opt. 327 z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 373 z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 328 374 END DO 329 375 END DO … … 332 378 CALL lbc_lnk( z2d, 'U', -1. ) 333 379 CALL iom_put( "udiff_heattr", z2d ) ! heat transport in i-direction 334 z2d(:,:) = 0._wp 380 z2d(:,:) = 0._wp 335 381 DO jk = 1, jpkm1 336 382 DO jj = 2, jpjm1 337 383 DO ji = fs_2, fs_jpim1 ! vector opt. 338 z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 384 z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 339 385 END DO 340 386 END DO … … 342 388 z2d(:,:) = zztmp * z2d(:,:) 343 389 CALL lbc_lnk( z2d, 'V', -1. ) 344 CALL iom_put( "vdiff_heattr", z2d ) ! heat transport in i-direction390 CALL iom_put( "vdiff_heattr", z2d ) ! heat transport in j-direction 345 391 END IF 346 392 #endif -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90
r2715 r3116 44 44 CONTAINS 45 45 46 SUBROUTINE tra_ldf_lap( kt, cdtype, pgu, pgv, &46 SUBROUTINE tra_ldf_lap( kt, kit000, cdtype, pgu, pgv, & 47 47 & ptb, pta, kjpt ) 48 48 !!---------------------------------------------------------------------- … … 66 66 ! 67 67 INTEGER , INTENT(in ) :: kt ! ocean time-step index 68 INTEGER , INTENT(in ) :: kit000 ! first time step index 68 69 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 69 70 INTEGER , INTENT(in ) :: kjpt ! number of tracers … … 77 78 !!---------------------------------------------------------------------- 78 79 79 IF( kt == nit000 ) THEN80 IF( kt == kit000 ) THEN 80 81 IF(lwp) WRITE(numout,*) 81 82 IF(lwp) WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype 82 83 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ ' 83 84 ! 84 ALLOCATE( e1ur(jpi,jpj), e2vr(jpi,jpj), STAT=ierr ) 85 IF( lk_mpp ) CALL mpp_sum( ierr ) 86 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'tra_ldf_lap : unable to allocate arrays' ) 87 ! 88 e1ur(:,:) = e2u(:,:) / e1u(:,:) 89 e2vr(:,:) = e1v(:,:) / e2v(:,:) 85 IF( .NOT. ALLOCATED( e1ur ) ) THEN 86 ! This routine may be called for both active and passive tracers. 87 ! Allocate and set saved arrays on first call only. 88 ALLOCATE( e1ur(jpi,jpj), e2vr(jpi,jpj), STAT=ierr ) 89 IF( lk_mpp ) CALL mpp_sum( ierr ) 90 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'tra_ldf_lap : unable to allocate arrays' ) 91 ! 92 e1ur(:,:) = e2u(:,:) / e1u(:,:) 93 e2vr(:,:) = e1v(:,:) / e2v(:,:) 94 ENDIF 90 95 ENDIF 91 96 -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
r2977 r3116 36 36 USE obc_oce 37 37 USE obctra ! open boundary condition (obc_tra routine) 38 USE bdy_ par ! Unstructured open boundary condition (bdy_tra_frs routine)39 USE bdytra ! Unstructured open boundary condition (bdy_tra_frsroutine)38 USE bdy_oce 39 USE bdytra ! open boundary condition (bdy_tra routine) 40 40 USE in_out_manager ! I/O manager 41 41 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 42 42 USE prtctl ! Print control 43 43 USE traqsr ! penetrative solar radiation (needed for nksr) 44 USE obc_oce45 44 #if defined key_agrif 46 45 USE agrif_opa_update … … 80 79 !! - Apply lateral boundary conditions on (ta,sa) 81 80 !! at the local domain boundaries through lbc_lnk call, 82 !! at the radiative open boundaries (lk_obc=T), 83 !! at the relaxed open boundaries (lk_bdy=T), and 81 !! at the one-way open boundaries (lk_obc=T), 84 82 !! at the AGRIF zoom boundaries (lk_agrif=T) 85 83 !! … … 114 112 #endif 115 113 #if defined key_bdy 116 IF( lk_bdy ) CALL bdy_tra _frs( kt ) ! BDY open boundaries114 IF( lk_bdy ) CALL bdy_tra( kt ) ! BDY open boundaries 117 115 #endif 118 116 #if defined key_agrif … … 139 137 ELSE ! Leap-Frog + Asselin filter time stepping 140 138 ! 141 IF( lk_vvl ) THEN ; CALL tra_nxt_vvl( kt, 'TRA', tsb, tsn, tsa, jpts ) ! variable volume level (vvl)142 ELSE ; CALL tra_nxt_fix( kt, 'TRA', tsb, tsn, tsa, jpts ) ! fixed volume level139 IF( lk_vvl ) THEN ; CALL tra_nxt_vvl( kt, nit000, 'TRA', tsb, tsn, tsa, jpts ) ! variable volume level (vvl) 140 ELSE ; CALL tra_nxt_fix( kt, nit000, 'TRA', tsb, tsn, tsa, jpts ) ! fixed volume level 143 141 ENDIF 144 142 ENDIF … … 168 166 169 167 170 SUBROUTINE tra_nxt_fix( kt, cdtype, ptb, ptn, pta, kjpt )168 SUBROUTINE tra_nxt_fix( kt, kit000, cdtype, ptb, ptn, pta, kjpt ) 171 169 !!---------------------------------------------------------------------- 172 170 !! *** ROUTINE tra_nxt_fix *** … … 192 190 !!---------------------------------------------------------------------- 193 191 INTEGER , INTENT(in ) :: kt ! ocean time-step index 192 INTEGER , INTENT(in ) :: kit000 ! first time step index 194 193 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 195 194 INTEGER , INTENT(in ) :: kjpt ! number of tracers … … 203 202 !!---------------------------------------------------------------------- 204 203 205 IF( kt == nit000 ) THEN204 IF( kt == kit000 ) THEN 206 205 IF(lwp) WRITE(numout,*) 207 IF(lwp) WRITE(numout,*) 'tra_nxt_fix : time stepping' 206 IF(lwp) WRITE(numout,*) 'tra_nxt_fix : time stepping', cdtype 208 207 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 209 208 ENDIF … … 234 233 235 234 236 SUBROUTINE tra_nxt_vvl( kt, cdtype, ptb, ptn, pta, kjpt )235 SUBROUTINE tra_nxt_vvl( kt, kit000, cdtype, ptb, ptn, pta, kjpt ) 237 236 !!---------------------------------------------------------------------- 238 237 !! *** ROUTINE tra_nxt_vvl *** … … 259 258 !!---------------------------------------------------------------------- 260 259 INTEGER , INTENT(in ) :: kt ! ocean time-step index 260 INTEGER , INTENT(in ) :: kit000 ! first time step index 261 261 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 262 262 INTEGER , INTENT(in ) :: kjpt ! number of tracers … … 271 271 !!---------------------------------------------------------------------- 272 272 273 IF( kt == nit000 )THEN273 IF( kt == kit000 ) THEN 274 274 IF(lwp) WRITE(numout,*) 275 IF(lwp) WRITE(numout,*) 'tra_nxt_vvl : time stepping' 275 IF(lwp) WRITE(numout,*) 'tra_nxt_vvl : time stepping', cdtype 276 276 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 277 277 ENDIF -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90
r2715 r3116 76 76 77 77 SELECT CASE ( nzdf ) ! compute lateral mixing trend and add it to the general trend 78 CASE ( 0 ) ; CALL tra_zdf_exp( kt, 'TRA', r2dtra, nn_zdfexp, tsb, tsa, jpts ) ! explicit scheme79 CASE ( 1 ) ; CALL tra_zdf_imp( kt, 'TRA', r2dtra, tsb, tsa, jpts ) ! implicit scheme78 CASE ( 0 ) ; CALL tra_zdf_exp( kt, nit000, 'TRA', r2dtra, nn_zdfexp, tsb, tsa, jpts ) ! explicit scheme 79 CASE ( 1 ) ; CALL tra_zdf_imp( kt, nit000, 'TRA', r2dtra, tsb, tsa, jpts ) ! implicit scheme 80 80 CASE ( -1 ) ! esopa: test all possibility with control print 81 CALL tra_zdf_exp( kt, 'TRA', r2dtra, nn_zdfexp, tsb, tsa, jpts )81 CALL tra_zdf_exp( kt, nit000, 'TRA', r2dtra, nn_zdfexp, tsb, tsa, jpts ) 82 82 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf0 - Ta: ', mask1=tmask, & 83 83 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 84 CALL tra_zdf_imp( kt, 'TRA', r2dtra, tsb, tsa, jpts )84 CALL tra_zdf_imp( kt, nit000, 'TRA', r2dtra, tsb, tsa, jpts ) 85 85 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf1 - Ta: ', mask1=tmask, & 86 86 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90
r2715 r3116 48 48 CONTAINS 49 49 50 SUBROUTINE tra_zdf_exp( kt, cdtype, p2dt, kn_zdfexp, &50 SUBROUTINE tra_zdf_exp( kt, kit000, cdtype, p2dt, kn_zdfexp, & 51 51 & ptb , pta , kjpt ) 52 52 !!---------------------------------------------------------------------- … … 77 77 ! 78 78 INTEGER , INTENT(in ) :: kt ! ocean time-step index 79 INTEGER , INTENT(in ) :: kit000 ! first time step index 79 80 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 80 81 INTEGER , INTENT(in ) :: kjpt ! number of tracers … … 93 94 ENDIF 94 95 95 IF( kt == nit000 ) THEN96 IF( kt == kit000 ) THEN 96 97 IF(lwp) WRITE(numout,*) 97 98 IF(lwp) WRITE(numout,*) 'tra_zdf_exp : explicit vertical mixing on ', cdtype -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90
r2715 r3116 55 55 CONTAINS 56 56 57 SUBROUTINE tra_zdf_imp( kt, cdtype, p2dt, ptb, pta, kjpt )57 SUBROUTINE tra_zdf_imp( kt, kit000, cdtype, p2dt, ptb, pta, kjpt ) 58 58 !!---------------------------------------------------------------------- 59 59 !! *** ROUTINE tra_zdf_imp *** … … 79 79 ! 80 80 INTEGER , INTENT(in ) :: kt ! ocean time-step index 81 INTEGER , INTENT(in ) :: kit000 ! first time step index 81 82 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 82 83 INTEGER , INTENT(in ) :: kjpt ! number of tracers … … 93 94 ENDIF 94 95 95 IF( kt == nit000 ) THEN96 IF( kt == kit000 ) THEN 96 97 IF(lwp)WRITE(numout,*) 97 98 IF(lwp)WRITE(numout,*) 'tra_zdf_imp : implicit vertical mixing on ', cdtype -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90
r2715 r3116 36 36 REAL(wp) :: rn_bfrien = 30._wp ! local factor to enhance coefficient bfri 37 37 LOGICAL :: ln_bfr2d = .false. ! logical switch for 2D enhancement 38 39 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: bfrcoef2d ! 2D bottom drag coefficient38 LOGICAL , PUBLIC :: ln_bfrimp = .false. ! logical switch for implicit bottom friction 39 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: bfrcoef2d ! 2D bottom drag coefficient 40 40 41 41 !! * Substitutions … … 142 142 REAL(wp) :: zfru, zfrv ! - - 143 143 !! 144 NAMELIST/nambfr/ nn_bfr, rn_bfri1, rn_bfri2, rn_bfeb2, ln_bfr2d, rn_bfrien 144 NAMELIST/nambfr/ nn_bfr, rn_bfri1, rn_bfri2, rn_bfeb2, ln_bfr2d, rn_bfrien, ln_bfrimp 145 145 !!---------------------------------------------------------------------- 146 146 … … 156 156 ! ! allocate zdfbfr arrays 157 157 IF( zdf_bfr_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'zdf_bfr_init : unable to allocate arrays' ) 158 159 ! ! Make sure ln_zdfexp=.false. when use implicit bfr 160 IF( ln_bfrimp .AND. ln_zdfexp ) THEN 161 IF(lwp) THEN 162 WRITE(numout,*) 163 WRITE(numout,*) 'Implicit bottom friction can only be used when ln_zdfexp=.false.' 164 WRITE(numout,*) ' but you set: ln_bfrimp=.true. and ln_zdfexp=.true.!!!!' 165 WRITE(ctmp1,*) ' bad ln_bfrimp value = .true.' 166 CALL ctl_stop( ctmp1 ) 167 END IF 168 END IF 158 169 159 170 SELECT CASE (nn_bfr) … … 207 218 ! 208 219 END SELECT 220 IF(lwp) WRITE(numout,*) ' implicit bottom friction switch ln_bfrimp = ', ln_bfrimp 209 221 ! 210 222 ! Basic stability check on bottom friction coefficient -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r3104 r3116 27 27 !! 3.3 ! 2010-05 (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface 28 28 !! - ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 29 !! 4.0 ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 29 !! 3.3.1! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 30 !! 3.4 ! 2011-11 (C. Harris) decomposition changes for running with CICE 30 31 !!---------------------------------------------------------------------- 31 32 … … 46 47 USE domain ! domain initialization (dom_init routine) 47 48 USE obcini ! open boundary cond. initialization (obc_ini routine) 48 USE bdyini ! unstructured open boundary cond. initialization (bdy_init routine) 49 USE bdyini ! open boundary cond. initialization (bdy_init routine) 50 USE bdydta ! open boundary cond. initialization (bdy_dta_init routine) 51 USE bdytides ! open boundary cond. initialization (tide_init routine) 49 52 USE istate ! initial state setting (istate_init routine) 50 53 USE ldfdyn ! lateral viscosity setting (ldfdyn_init routine) … … 67 70 USE c1d ! 1D configuration 68 71 USE step_c1d ! Time stepping loop for the 1D configuration 72 USE dynnept ! simplified form of Neptune effect 69 73 #if defined key_top 70 74 USE trcini ! passive tracer initialisation … … 246 250 IF( Agrif_Root() ) THEN 247 251 jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim. 252 #if defined key_nemocice_decomp 253 jpj = ( jpjglo+1-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 254 #else 248 255 jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 256 #endif 249 257 jpk = jpkdta ! third dim 250 258 jpim1 = jpi-1 ! inner domain indices … … 293 301 CALL dom_init ! Domain 294 302 303 IF( ln_nnogather ) CALL nemo_northcomms ! Initialise the northfold neighbour lists (must be done after the masks are defined) 304 295 305 IF( ln_ctl ) CALL prt_ctl_init ! Print control 296 306 297 307 IF( lk_obc ) CALL obc_init ! Open boundaries 298 IF( lk_bdy ) CALL bdy_init ! Unstructured open boundaries 308 IF( lk_bdy ) CALL bdy_init ! Open boundaries initialisation 309 IF( lk_bdy ) CALL bdy_dta_init ! Open boundaries initialisation of external data arrays 310 IF( lk_bdy ) CALL tide_init ! Open boundaries initialisation of tidal harmonic forcing 311 312 CALL flush(numout) 313 CALL dyn_nept_init ! simplified form of Neptune effect 314 CALL flush(numout) 299 315 300 316 CALL istate_init ! ocean initial state (Dynamics and tracers) … … 623 639 END SUBROUTINE factorise 624 640 641 #if defined key_mpp_mpi 642 SUBROUTINE nemo_northcomms 643 !!====================================================================== 644 !! *** ROUTINE nemo_northcomms *** 645 !! nemo_northcomms : Setup for north fold exchanges with explicit peer to peer messaging 646 !!===================================================================== 647 !!---------------------------------------------------------------------- 648 !! 649 !! ** Purpose : Initialization of the northern neighbours lists. 650 !!---------------------------------------------------------------------- 651 !! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) 652 !!---------------------------------------------------------------------- 653 654 INTEGER :: ji, jj, jk, ij, jtyp ! dummy loop indices 655 INTEGER :: ijpj ! number of rows involved in north-fold exchange 656 INTEGER :: northcomms_alloc ! allocate return status 657 REAL(wp), ALLOCATABLE, DIMENSION ( :,: ) :: znnbrs ! workspace 658 LOGICAL, ALLOCATABLE, DIMENSION ( : ) :: lrankset ! workspace 659 660 IF(lwp) WRITE(numout,*) 661 IF(lwp) WRITE(numout,*) 'nemo_northcomms : Initialization of the northern neighbours lists' 662 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 663 664 !!---------------------------------------------------------------------- 665 ALLOCATE( znnbrs(jpi,jpj), stat = northcomms_alloc ) 666 ALLOCATE( lrankset(jpnij), stat = northcomms_alloc ) 667 IF( northcomms_alloc /= 0 ) THEN 668 WRITE(numout,cform_war) 669 WRITE(numout,*) 'northcomms_alloc : failed to allocate arrays' 670 CALL ctl_stop( 'STOP', 'nemo_northcomms : unable to allocate temporary arrays' ) 671 ENDIF 672 nsndto = 0 673 isendto = -1 674 ijpj = 4 675 ! 676 ! This routine has been called because ln_nnogather has been set true ( nammpp ) 677 ! However, these first few exchanges have to use the mpi_allgather method to 678 ! establish the neighbour lists to use in subsequent peer to peer exchanges. 679 ! Consequently, set l_north_nogather to be false here and set it true only after 680 ! the lists have been established. 681 ! 682 l_north_nogather = .FALSE. 683 ! 684 ! Exchange and store ranks on northern rows 685 686 DO jtyp = 1,4 687 688 lrankset = .FALSE. 689 znnbrs = narea 690 SELECT CASE (jtyp) 691 CASE(1) 692 CALL lbc_lnk( znnbrs, 'T', 1. ) ! Type 1: T,W-points 693 CASE(2) 694 CALL lbc_lnk( znnbrs, 'U', 1. ) ! Type 2: U-point 695 CASE(3) 696 CALL lbc_lnk( znnbrs, 'V', 1. ) ! Type 3: V-point 697 CASE(4) 698 CALL lbc_lnk( znnbrs, 'F', 1. ) ! Type 4: F-point 699 END SELECT 700 701 IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN 702 DO jj = nlcj-ijpj+1, nlcj 703 ij = jj - nlcj + ijpj 704 DO ji = 1,jpi 705 IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 706 & lrankset(INT(znnbrs(ji,jj))) = .true. 707 END DO 708 END DO 709 710 DO jj = 1,jpnij 711 IF ( lrankset(jj) ) THEN 712 nsndto(jtyp) = nsndto(jtyp) + 1 713 IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN 714 CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', & 715 & ' jpmaxngh will need to be increased ') 716 ENDIF 717 isendto(nsndto(jtyp),jtyp) = jj-1 ! narea converted to MPI rank 718 ENDIF 719 END DO 720 ENDIF 721 722 END DO 723 724 ! 725 ! Type 5: I-point 726 ! 727 ! ICE point exchanges may involve some averaging. The neighbours list is 728 ! built up using two exchanges to ensure that the whole stencil is covered. 729 ! lrankset should not be reset between these 'J' and 'K' point exchanges 730 731 jtyp = 5 732 lrankset = .FALSE. 733 znnbrs = narea 734 CALL lbc_lnk( znnbrs, 'J', 1. ) ! first ice U-V point 735 736 IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN 737 DO jj = nlcj-ijpj+1, nlcj 738 ij = jj - nlcj + ijpj 739 DO ji = 1,jpi 740 IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 741 & lrankset(INT(znnbrs(ji,jj))) = .true. 742 END DO 743 END DO 744 ENDIF 745 746 znnbrs = narea 747 CALL lbc_lnk( znnbrs, 'K', 1. ) ! second ice U-V point 748 749 IF ( njmppt(narea) .EQ. MAXVAL( njmppt )) THEN 750 DO jj = nlcj-ijpj+1, nlcj 751 ij = jj - nlcj + ijpj 752 DO ji = 1,jpi 753 IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 754 & lrankset( INT(znnbrs(ji,jj))) = .true. 755 END DO 756 END DO 757 758 DO jj = 1,jpnij 759 IF ( lrankset(jj) ) THEN 760 nsndto(jtyp) = nsndto(jtyp) + 1 761 IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN 762 CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', & 763 & ' jpmaxngh will need to be increased ') 764 ENDIF 765 isendto(nsndto(jtyp),jtyp) = jj-1 ! narea converted to MPI rank 766 ENDIF 767 END DO 768 ! 769 ! For northern row areas, set l_north_nogather so that all subsequent exchanges 770 ! can use peer to peer communications at the north fold 771 ! 772 l_north_nogather = .TRUE. 773 ! 774 ENDIF 775 DEALLOCATE( znnbrs ) 776 DEALLOCATE( lrankset ) 777 778 END SUBROUTINE nemo_northcomms 779 #else 780 SUBROUTINE nemo_northcomms ! Dummy routine 781 WRITE(*,*) 'nemo_northcomms: You should not have seen this print! error?' 782 END SUBROUTINE nemo_northcomms 783 #endif 625 784 !!====================================================================== 626 785 END MODULE nemogcm -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/oce.F90
r2977 r3116 35 35 !! free surface ! before ! now ! after ! 36 36 !! ------------ ! fields ! fields ! trends ! 37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshb , sshn , ssha !: sea surface height at t-point [m]38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshu_b , sshu_n , sshu_a !: sea surface height at u-point [m]39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshv_b , sshv_n , sshv_a !: sea surface height at u-point [m]40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshf_n !: sea surface height at f-point [m]37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: sshb , sshn , ssha !: sea surface height at t-point [m] 38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshu_b , sshu_n , sshu_a !: sea surface height at u-point [m] 39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshv_b , sshv_n , sshv_a !: sea surface height at u-point [m] 40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshf_n !: sea surface height at f-point [m] 41 41 ! 42 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: spgu, spgv !: horizontal surface pressure gradient -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/par_oce.F90
r2715 r3116 81 81 !!--------------------------------------------------------------------- 82 82 # include "par_POMME_R025.h90" 83 #elif defined key_amm_12km 84 !!--------------------------------------------------------------------- 85 !! 'key_amm_12km': Atlantic Margin Model : AMM12km 86 !!--------------------------------------------------------------------- 87 # include "par_AMM_12km.h90" 83 88 #else 84 89 !!--------------------------------------------------------------------- -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/step.F90
r3104 r3116 37 37 #endif 38 38 USE asminc ! assimilation increments (tra_asm_inc, dyn_asm_inc routines) 39 USE dynnept ! simplified form of Neptune effect 39 40 40 41 IMPLICIT NONE … … 99 100 IF( lk_obc ) CALL obc_dta( kstp ) ! update dynamic and tracer data at open boundaries 100 101 IF( lk_obc ) CALL obc_rad( kstp ) ! compute phase velocities at open boundaries 101 IF( lk_bdy ) CALL bdy_dta _frs( kstp ) ! update dynamic and tracer data for FRS conditions (BDY)102 IF( lk_bdy ) CALL bdy_dta( kstp, time_offset=+1 ) ! update dynamic and tracer data at open boundaries 102 103 103 104 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 219 220 IF( ln_asmiau .AND. & 220 221 & ln_dyninc ) CALL dyn_asm_inc( kstp ) ! apply dynamics assimilation increment 222 IF( ln_neptsimp ) CALL dyn_nept_cor( kstp ) ! subtract Neptune velocities (simplified) 221 223 CALL dyn_adv( kstp ) ! advection (vector or flux form) 222 224 CALL dyn_vor( kstp ) ! vorticity term including Coriolis 223 225 CALL dyn_ldf( kstp ) ! lateral mixing 226 IF( ln_neptsimp ) CALL dyn_nept_cor( kstp ) ! add Neptune velocities (simplified) 224 227 #if defined key_agrif 225 228 IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_dyn ! momemtum sponge -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
r3104 r3116 52 52 USE obcrad ! open boundary cond. radiation (obc_rad routine) 53 53 54 USE bdy_par ! unstructured open boundary data variables55 USE bdydta ! unstructured open boundary data(bdy_dta routine)54 USE bdy_par ! for lk_bdy 55 USE bdydta ! open boundary condition data (bdy_dta routine) 56 56 57 57 USE sshwzv ! vertical velocity and ssh (ssh_wzv routine) -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90
r3028 r3116 119 119 ENDIF 120 120 121 IF( kt == nit 000 ) THEN ! Computation of decay coeffcient121 IF( kt == nittrc000 ) THEN ! Computation of decay coeffcient 122 122 zdemi = 5730._wp 123 123 xlambda = LOG(2.) / zdemi / ( nyear_len(1) * rday ) -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/CFC/trcnam_cfc.F90
r2977 r3116 38 38 !! 39 39 !! ** Method : Read the namcfc namelist and check the parameter 40 !! values called at the first timestep (nit 000)40 !! values called at the first timestep (nittrc000) 41 41 !! 42 42 !! ** input : Namelist namcfc -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90
r2977 r3116 96 96 ENDIF 97 97 98 IF( kt == nit 000 ) CALL trc_cfc_cst98 IF( kt == nittrc000 ) CALL trc_cfc_cst 99 99 100 100 ! Temporal interpolation -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcbio.F90
r3028 r3116 89 89 ENDIF 90 90 91 IF( kt == nit 000 ) THEN91 IF( kt == nittrc000 ) THEN 92 92 IF(lwp) WRITE(numout,*) 93 93 IF(lwp) WRITE(numout,*) ' trc_bio: LOBSTER bio-model' -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcexp.F90
r2977 r3116 62 62 !!--------------------------------------------------------------------- 63 63 64 IF( kt == nit 000 ) THEN64 IF( kt == nittrc000 ) THEN 65 65 IF(lwp) WRITE(numout,*) 66 66 IF(lwp) WRITE(numout,*) ' trc_exp: LOBSTER export' -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcopt.F90
r2715 r3116 72 72 END IF 73 73 74 IF( kt == nit 000 ) THEN74 IF( kt == nittrc000 ) THEN 75 75 IF(lwp) WRITE(numout,*) 76 76 IF(lwp) WRITE(numout,*) ' trc_opt : LOBSTER optic-model' -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcsed.F90
r3028 r3116 67 67 !!--------------------------------------------------------------------- 68 68 69 IF( kt == nit 000 ) THEN69 IF( kt == nittrc000 ) THEN 70 70 IF(lwp) WRITE(numout,*) 71 71 IF(lwp) WRITE(numout,*) ' trc_sed: LOBSTER sedimentation' -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/trcsms_pisces.F90
r2977 r3116 66 66 !!--------------------------------------------------------------------- 67 67 68 IF( kt == nit 000 )CALL trc_sms_pisces_init ! Initialization (first time-step only)68 IF( kt == nittrc000 ) CALL trc_sms_pisces_init ! Initialization (first time-step only) 69 69 IF( ln_rsttr .AND. ln_pisdmp .AND. MOD( kt - 1, nn_pisdmp ) == 0 ) CALL trc_sms_pisces_dmp( kt ) ! Relaxation of some tracers 70 71 70 72 71 IF( ndayflxtr /= nday_year ) THEN ! New days -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/SED/sedini.F90
r2761 r3116 449 449 450 450 dtsed = rdt 451 nitsed000 = nit 000451 nitsed000 = nittrc000 452 452 nitsedend = nitend 453 453 #if ! defined key_sed_off -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/SED/sedmodel.F90
r2528 r3116 35 35 36 36 37 IF( kt == nit 000 ) CALL sed_init ! Initialization of sediment model37 IF( kt == nittrc000 ) CALL sed_init ! Initialization of sediment model 38 38 39 39 CALL sed_stp( kt ) ! Time stepping of Sediment model -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/SED/sedwri.F90
r2761 r3116 56 56 ! Initialisation 57 57 ! ----------------- 58 IF( kt == nit 000 ) ALLOCATE( ndext52(jpij*jpksed), ndext51(jpij) )58 IF( kt == nittrc000 ) ALLOCATE( ndext52(jpij*jpksed), ndext51(jpij) ) 59 59 60 60 ! Define frequency of output and means -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
r2715 r3116 35 35 INTEGER :: nadv ! choice of the type of advection scheme 36 36 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: r2dt ! vertical profile time-step, = 2 rdttra 37 ! ! except at nit 000 (=rdttra) if neuler=037 ! ! except at nitrrc000 (=rdttra) if neuler=0 38 38 39 39 !! * Substitutions … … 80 80 ENDIF 81 81 82 IF( kt == nit 000 ) CALL trc_adv_ctl ! initialisation & control of options82 IF( kt == nittrc000 ) CALL trc_adv_ctl ! initialisation & control of options 83 83 84 84 #if ! defined key_pisces 85 IF( neuler == 0 .AND. kt == nit 000 ) THEN ! at nit00085 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ! at nittrc000 86 86 r2dt(:) = rdttrc(:) ! = rdttrc (restarting with Euler time stepping) 87 ELSEIF( kt <= nit 000 + nn_dttrc ) THEN ! at nit000 or nit000+187 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ! at nittrc000 or nittrc000+1 88 88 r2dt(:) = 2. * rdttrc(:) ! = 2 rdttrc (leapfrog) 89 89 ENDIF … … 102 102 zwn(:,:,jpk) = 0.e0 ! no transport trough the bottom 103 103 104 !! add the eiv transport (if necessary)105 IF( lk_traldf_eiv ) CALL tra_adv_eiv( kt, zun, zvn, zwn, 'TRC' )104 IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif ) & ! add the eiv transport (if necessary) 105 & CALL tra_adv_eiv( kt, nittrc000, zun, zvn, zwn, 'TRC' ) 106 106 ! 107 107 SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==! 108 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) ! 2nd order centered109 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! TVD110 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, tra, jptra ) ! MUSCL111 CASE ( 4 ) ; CALL tra_adv_muscl2( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! MUSCL2112 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! UBS113 CASE ( 6 ) ; CALL tra_adv_qck ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! QUICKEST108 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, nittrc000, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) ! 2nd order centered 109 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! TVD 110 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, tra, jptra ) ! MUSCL 111 CASE ( 4 ) ; CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! MUSCL2 112 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! UBS 113 CASE ( 6 ) ; CALL tra_adv_qck ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! QUICKEST 114 114 ! 115 115 CASE (-1 ) !== esopa: test all possibility with control print ==! 116 CALL tra_adv_cen2 ( kt, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra )116 CALL tra_adv_cen2 ( kt, nittrc000, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) 117 117 WRITE(charout, FMT="('adv1')") ; CALL prt_ctl_trc_info(charout) 118 118 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 119 CALL tra_adv_tvd ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )119 CALL tra_adv_tvd ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) 120 120 WRITE(charout, FMT="('adv2')") ; CALL prt_ctl_trc_info(charout) 121 121 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 122 CALL tra_adv_muscl ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, tra, jptra )122 CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, tra, jptra ) 123 123 WRITE(charout, FMT="('adv3')") ; CALL prt_ctl_trc_info(charout) 124 124 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 125 CALL tra_adv_muscl2( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )125 CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) 126 126 WRITE(charout, FMT="('adv4')") ; CALL prt_ctl_trc_info(charout) 127 127 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 128 CALL tra_adv_ubs ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )128 CALL tra_adv_ubs ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) 129 129 WRITE(charout, FMT="('adv5')") ; CALL prt_ctl_trc_info(charout) 130 130 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 131 CALL tra_adv_qck ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )131 CALL tra_adv_qck ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) 132 132 WRITE(charout, FMT="('adv6')") ; CALL prt_ctl_trc_info(charout) 133 133 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90
r2528 r3116 56 56 !!---------------------------------------------------------------------- 57 57 58 IF( .NOT. lk_offline ) THEN59 CALL bbl( kt, 'TRC' )! Online coupling with dynamics : Computation of bbl coef and bbl transport60 l_bbl = .FALSE. ! Offline coupling with dynamics : Read bbl coef and bbl transport from input files58 IF( .NOT. lk_offline .AND. nn_dttrc == 1 ) THEN 59 CALL bbl( kt, nittrc000, 'TRC' ) ! Online coupling with dynamics : Computation of bbl coef and bbl transport 60 l_bbl = .FALSE. ! Offline coupling with dynamics : Read bbl coef and bbl transport from input files 61 61 ENDIF 62 62 63 63 IF( l_trdtrc ) THEN 64 ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) ) 64 ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) ) ! temporary save of trends 65 65 ztrtrd(:,:,:,:) = tra(:,:,:,:) 66 66 ENDIF -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90
r2715 r3116 94 94 ! 0. Initialization (first time-step only) 95 95 ! -------------- 96 IF( kt == nit 000 ) CALL trc_dmp_init96 IF( kt == nittrc000 ) CALL trc_dmp_init 97 97 98 98 IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) ) ! temporary save of trends … … 173 173 !! 174 174 !! ** Method : read the nammbf namelist and check the parameters 175 !! called by trc_dmp at the first timestep (nit 000)175 !! called by trc_dmp at the first timestep (nittrc000) 176 176 !!---------------------------------------------------------------------- 177 177 -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90
r2977 r3116 2 2 !!====================================================================== 3 3 !! *** MODULE trcldf *** 4 !! Ocean Passive tracers : lateral diffusive trends 4 !! Ocean Passive tracers : lateral diffusive trends 5 5 !!===================================================================== 6 6 !! History : 9.0 ! 2005-11 (G. Madec) Original code 7 !! NEMO 3.0 ! 2008-01 (C. Ethe, G. Madec) merge TRC-TRA 7 !! NEMO 3.0 ! 2008-01 (C. Ethe, G. Madec) merge TRC-TRA 8 8 !!---------------------------------------------------------------------- 9 9 #if defined key_top … … 22 22 USE traldf_bilap ! lateral mixing (tra_ldf_bilap routine) 23 23 USE traldf_iso ! lateral mixing (tra_ldf_iso routine) 24 USE traldf_iso_grif ! lateral mixing (tra_ldf_iso_grif routine) 24 25 USE traldf_lap ! lateral mixing (tra_ldf_lap routine) 25 26 USE trdmod_oce … … 30 31 PRIVATE 31 32 32 PUBLIC trc_ldf ! called by step.F90 33 PUBLIC trc_ldf ! called by step.F90 33 34 ! !!: ** lateral mixing namelist (nam_trcldf) ** 34 35 REAL(wp) :: rldf_rat ! ratio between active and passive tracers diffusive coefficient … … 39 40 !!---------------------------------------------------------------------- 40 41 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 41 !! $Id$ 42 !! $Id$ 42 43 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 43 44 !!---------------------------------------------------------------------- … … 48 49 !!---------------------------------------------------------------------- 49 50 !! *** ROUTINE tra_ldf *** 50 !! 51 !! 51 52 !! ** Purpose : compute the lateral ocean tracer physics. 52 53 !! … … 59 60 !!---------------------------------------------------------------------- 60 61 61 IF( kt == nit 000 ) CALL ldf_ctl ! initialisation & control of options62 IF( kt == nittrc000 ) CALL ldf_ctl ! initialisation & control of options 62 63 63 64 rldf = rldf_rat 64 65 65 IF( l_trdtrc ) THEN 66 IF( l_trdtrc ) THEN 66 67 ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) ) ! temporary save of trends 67 68 ztrtrd(:,:,:,:) = tra(:,:,:,:) … … 69 70 70 71 SELECT CASE ( nldf ) ! compute lateral mixing trend and add it to the general trend 71 CASE ( 0 ) ; CALL tra_ldf_lap ( kt, 'TRC', gtru, gtrv, trb, tra, jptra ) ! iso-level laplacian 72 CASE ( 1 ) ; CALL tra_ldf_iso ( kt, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtrb_0 ) ! rotated laplacian 73 CASE ( 2 ) ; CALL tra_ldf_bilap ( kt, 'TRC', gtru, gtrv, trb, tra, jptra ) ! iso-level bilaplacian 74 CASE ( 3 ) ; CALL tra_ldf_bilapg( kt, 'TRC', trb, tra, jptra ) ! s-coord. horizontal bilaplacian 72 CASE ( 0 ) ; CALL tra_ldf_lap ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra ) ! iso-level laplacian 73 CASE ( 1 ) ! rotated laplacian 74 IF( ln_traldf_grif ) THEN 75 CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 76 ELSE 77 CALL tra_ldf_iso ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 78 ENDIF 79 CASE ( 2 ) ; CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra ) ! iso-level bilaplacian 80 CASE ( 3 ) ; CALL tra_ldf_bilapg( kt, nittrc000, 'TRC', trb, tra, jptra ) ! s-coord. horizontal bilaplacian 75 81 ! 76 82 CASE ( -1 ) ! esopa: test all possibility with control print 77 CALL tra_ldf_lap ( kt, 'TRC', gtru, gtrv, trb, tra, jptra)83 CALL tra_ldf_lap ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra ) 78 84 WRITE(charout, FMT="('ldf0 ')") ; CALL prt_ctl_trc_info(charout) 79 85 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 80 CALL tra_ldf_iso ( kt, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtrb_0 ) 86 IF( ln_traldf_grif ) THEN 87 CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 88 ELSE 89 CALL tra_ldf_iso ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 90 ENDIF 81 91 WRITE(charout, FMT="('ldf1 ')") ; CALL prt_ctl_trc_info(charout) 82 92 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 83 CALL tra_ldf_bilap ( kt, 'TRC', gtru, gtrv, trb, tra, jptra)93 CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra ) 84 94 WRITE(charout, FMT="('ldf2 ')") ; CALL prt_ctl_trc_info(charout) 85 95 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 86 CALL tra_ldf_bilapg( kt, 'TRC', trb, tra, jptra)96 CALL tra_ldf_bilapg( kt, nittrc000, 'TRC', trb, tra, jptra ) 87 97 WRITE(charout, FMT="('ldf3 ')") ; CALL prt_ctl_trc_info(charout) 88 98 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) … … 94 104 CALL trd_tra( kt, 'TRC', jn, jptra_trd_ldf, ztrtrd(:,:,:,jn) ) 95 105 END DO 96 DEALLOCATE( ztrtrd ) 106 DEALLOCATE( ztrtrd ) 97 107 ENDIF 98 108 ! ! print mean trends (used for debugging) … … 108 118 !!---------------------------------------------------------------------- 109 119 !! *** ROUTINE ldf_ctl *** 110 !! 120 !! 111 121 !! ** Purpose : Choice of the operator for the lateral tracer diffusion 112 122 !! 113 123 !! ** Method : set nldf from the namtra_ldf logicals 114 !! nldf == -2 No lateral diffusion 124 !! nldf == -2 No lateral diffusion 115 125 !! nldf == -1 ESOPA test: ALL operators are used 116 126 !! nldf == 0 laplacian operator … … 119 129 !! nldf == 3 Rotated bilaplacian 120 130 !!---------------------------------------------------------------------- 121 INTEGER :: ioptio, ierr ! temporary integers 131 INTEGER :: ioptio, ierr ! temporary integers 122 132 !!---------------------------------------------------------------------- 123 133 … … 126 136 ! Define the lateral mixing oparator for tracers 127 137 ! =============================================== 128 138 129 139 ! ! control the input 130 140 ioptio = 0 … … 167 177 ENDIF 168 178 IF ( ln_zps ) THEN ! z-coordinate 169 IF ( ln_trcldf_level ) ierr = 1 ! iso-level not allowed 179 IF ( ln_trcldf_level ) ierr = 1 ! iso-level not allowed 170 180 IF ( ln_trcldf_hor ) nldf = 2 ! horizontal (no rotation) 171 181 IF ( ln_trcldf_iso ) ierr = 2 ! isoneutral ( rotation) -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
r2715 r3116 96 96 !!---------------------------------------------------------------------- 97 97 98 IF( kt == nit 000 .AND. lwp ) THEN98 IF( kt == nittrc000 .AND. lwp ) THEN 99 99 WRITE(numout,*) 100 100 WRITE(numout,*) 'trc_nxt : time stepping on passive tracers' … … 119 119 120 120 ! set time step size (Euler/Leapfrog) 121 IF( neuler == 0 .AND. kt == nit 000) THEN ; r2dt(:) = rdttrc(:) ! at nit000 (Euler)122 ELSEIF( kt <= nit 000 + 1) THEN ; r2dt(:) = 2.* rdttrc(:) ! at nit000 or nit000+1 (Leapfrog)121 IF( neuler == 0 .AND. kt == nittrc000) THEN ; r2dt(:) = rdttrc(:) ! at nittrc000 (Euler) 122 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ; r2dt(:) = 2.* rdttrc(:) ! at nit000 or nit000+1 (Leapfrog) 123 123 ENDIF 124 124 … … 129 129 ENDIF 130 130 ! Leap-Frog + Asselin filter time stepping 131 IF( neuler == 0 .AND. kt == nit 000 ) THEN ! Euler time-stepping at first time-step132 ! ! (only swap)131 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ! Euler time-stepping at first time-step 132 ! ! (only swap) 133 133 DO jn = 1, jptra 134 134 DO jk = 1, jpkm1 … … 139 139 ELSE 140 140 ! Leap-Frog + Asselin filter time stepping 141 IF( lk_vvl ) THEN ; CALL tra_nxt_vvl( kt, 'TRC', trb, trn, tra, jptra ) ! variable volume level (vvl)142 ELSE ; CALL tra_nxt_fix( kt, 'TRC', trb, trn, tra, jptra ) ! fixed volume level141 IF( lk_vvl ) THEN ; CALL tra_nxt_vvl( kt,nittrc000, 'TRC', trb, trn, tra, jptra ) ! variable volume level (vvl) 142 ELSE ; CALL tra_nxt_fix( kt,nittrc000, 'TRC', trb, trn, tra, jptra ) ! fixed volume level 143 143 ENDIF 144 144 ENDIF -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90
r3003 r3116 53 53 !!---------------------------------------------------------------------- 54 54 55 IF( kt == nit 000 ) THEN55 IF( kt == nittrc000 ) THEN 56 56 IF(lwp) WRITE(numout,*) 57 57 IF(lwp) WRITE(numout,*) 'trc_rad : Correct artificial negative concentrations ' -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
r2715 r3116 72 72 END IF 73 73 74 IF( kt == nit 000 ) THEN74 IF( kt == nittrc000 ) THEN 75 75 IF(lwp) WRITE(numout,*) 76 76 IF(lwp) WRITE(numout,*) 'trc_sbc : Passive tracers surface boundary condition' -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90
r2715 r3116 32 32 ! ! defined from ln_zdf... namlist logicals) 33 33 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: r2dt ! vertical profile time-step, = 2 rdttra 34 ! ! except at nit 000 (=rdttra) if neuler=034 ! ! except at nittrc000 (=rdttra) if neuler=0 35 35 36 36 !! * Substitutions … … 69 69 !!--------------------------------------------------------------------- 70 70 71 IF( kt == nit 000 ) CALL zdf_ctl ! initialisation & control of options71 IF( kt == nittrc000 ) CALL zdf_ctl ! initialisation & control of options 72 72 73 73 #if ! defined key_pisces 74 IF( neuler == 0 .AND. kt == nit 000 ) THEN ! at nit00074 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ! at nittrc000 75 75 r2dt(:) = rdttrc(:) ! = rdttrc (restarting with Euler time stepping) 76 ELSEIF( kt <= nit 000 + nn_dttrc ) THEN ! at nit000 or nit000+176 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ! at nittrc000 or nittrc000+nn_dttrc 77 77 r2dt(:) = 2. * rdttrc(:) ! = 2 rdttrc (leapfrog) 78 78 ENDIF … … 88 88 SELECT CASE ( nzdf ) ! compute lateral mixing trend and add it to the general trend 89 89 CASE ( -1 ) ! esopa: test all possibility with control print 90 CALL tra_zdf_exp( kt, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra )90 CALL tra_zdf_exp( kt,nittrc000, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra ) 91 91 WRITE(charout, FMT="('zdf1 ')") ; CALL prt_ctl_trc_info(charout) 92 92 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 93 CALL tra_zdf_imp( kt, 'TRC', r2dt, trb, tra, jptra )93 CALL tra_zdf_imp( kt,nittrc000, 'TRC', r2dt, trb, tra, jptra ) 94 94 WRITE(charout, FMT="('zdf2 ')") ; CALL prt_ctl_trc_info(charout) 95 95 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 96 CASE ( 0 ) ; CALL tra_zdf_exp( kt, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra ) ! explicit scheme97 CASE ( 1 ) ; CALL tra_zdf_imp( kt, 'TRC', r2dt, trb, tra, jptra ) ! implicit scheme96 CASE ( 0 ) ; CALL tra_zdf_exp( kt,nittrc000, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra ) ! explicit scheme 97 CASE ( 1 ) ; CALL tra_zdf_imp( kt,nittrc000, 'TRC', r2dt, trb, tra, jptra ) ! implicit scheme 98 98 99 99 END SELECT -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/TRP/trdmld_trc.F90
r2715 r3116 475 475 ! II.1 Set before values of vertically averages passive tracers 476 476 ! ------------------------------------------------------------- 477 IF( kt > nit 000 ) THEN477 IF( kt > nittrc000 ) THEN 478 478 DO jn = 1, jptra 479 479 IF( ln_trdtrc(jn) ) THEN … … 497 497 ! II.3 Initialize mixed-layer "before" arrays for the 1rst analysis window 498 498 ! ------------------------------------------------------------------------ 499 IF( kt == 2) THEN ! i.e. ( .NOT. ln_rstart ).AND.( kt == nit000 + 1) ???499 IF( kt == nittrc000 + nn_dttrc ) THEN ! i.e. ( .NOT. ln_rstart ).AND.( kt == nit000 + 1) ??? 500 500 ! 501 501 DO jn = 1, jptra … … 560 560 tmltrd_trc(:,:,:,:) = tmltrd_trc(:,:,:,:) * rn_ucf_trc 561 561 562 itmod = kt - nit 000 + 1562 itmod = kt - nittrc000 + 1 563 563 it = kt 564 564 … … 980 980 ! II.3 Initialize mixed-layer "before" arrays for the 1rst analysis window 981 981 ! ------------------------------------------------------------------------ 982 IF( kt == 2) THEN ! i.e. ( .NOT. ln_rstart ).AND.( kt == nit000 + 1)982 IF( kt == nittrc000 + nn_dttrc ) THEN ! i.e. ( .NOT. ln_rstart ).AND.( kt == nit000 + 1) 983 983 ! 984 984 tmltrd_csum_ub_bio (:,:,:) = 0.e0 … … 1086 1086 1087 1087 ! define time axis 1088 itmod = kt - nit 000 + 11088 itmod = kt - nittrc000 + 1 1089 1089 it = kt 1090 1090 … … 1331 1331 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 1332 1332 IF(lwp) WRITE(numout,*)' ' 1333 IF(lwp) WRITE(numout,*)' Date 0 used :', nit 000&1333 IF(lwp) WRITE(numout,*)' Date 0 used :', nittrc000 & 1334 1334 & ,' YEAR ', nyear, ' MONTH ', nmonth,' DAY ', nday & 1335 1335 & ,'Julian day : ', zjulian … … 1360 1360 CALL dia_nam( clhstnam, nn_trd_trc, csuff ) 1361 1361 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & 1362 & 1, jpi, 1, jpj, nit 000, zjulian, rdt, nh_t(jn), nidtrd(jn), domain_id=nidom, snc4chunks=snc4set )1362 & 1, jpi, 1, jpj, nittrc000, zjulian, rdt, nh_t(jn), nidtrd(jn), domain_id=nidom, snc4chunks=snc4set ) 1363 1363 1364 1364 !-- Define the ML depth variable … … 1373 1373 CALL dia_nam( clhstnam, nn_trd_trc, 'trdbio' ) 1374 1374 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & 1375 & 1, jpi, 1, jpj, nit 000, zjulian, rdt, nh_tb, nidtrdbio, domain_id=nidom, snc4chunks=snc4set )1375 & 1, jpi, 1, jpj, nittrc000, zjulian, rdt, nh_tb, nidtrdbio, domain_id=nidom, snc4chunks=snc4set ) 1376 1376 #endif 1377 1377 -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/TRP/trdmod_trc.F90
r2528 r3116 50 50 !!---------------------------------------------------------------------- 51 51 52 IF( kt == nit 000 ) THEN52 IF( kt == nittrc000 ) THEN 53 53 ! IF(lwp)WRITE(numout,*) 54 54 ! IF(lwp)WRITE(numout,*) 'trd_mod_trc:' -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90
r2977 r3116 108 108 USE dom_oce , ONLY : e3w_0 => e3w_0 !: reference depth of w-points (m) 109 109 USE dom_oce , ONLY : gdepw_0 => gdepw_0 !: reference depth of w-points (m) 110 # if ! defined key_zco 110 111 USE dom_oce , ONLY : gdep3w => gdep3w !: ??? 111 112 USE dom_oce , ONLY : gdept => gdept !: depth of t-points (m) … … 118 119 USE dom_oce , ONLY : e3uw => e3uw !: uw-points (m) 119 120 USE dom_oce , ONLY : e3vw => e3vw !: vw-points (m) 120 121 # endif 121 122 USE dom_oce , ONLY : ln_zps => ln_zps !: partial steps flag 122 123 USE dom_oce , ONLY : ln_sco => ln_sco !: s-coordinate flag … … 190 191 USE oce , ONLY : rhd => rhd !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units) 191 192 USE oce , ONLY : hdivn => hdivn !: horizontal divergence (1/s) 193 USE oce , ONLY : rotn => rotn !: relative vorticity [s-1] 194 USE oce , ONLY : hdivb => hdivb !: horizontal divergence (1/s) 195 USE oce , ONLY : rotb => rotb !: relative vorticity [s-1] 196 USE oce , ONLY : sshn => sshn !: sea surface height at t-point [m] 197 USE oce , ONLY : sshb => sshb !: sea surface height at t-point [m] 198 USE oce , ONLY : ssha => ssha !: sea surface height at t-point [m] 199 USE oce , ONLY : sshu_n => sshu_n !: sea surface height at u-point [m] 200 USE oce , ONLY : sshu_b => sshu_b !: sea surface height at u-point [m] 201 USE oce , ONLY : sshu_a => sshu_a !: sea surface height at u-point [m] 202 USE oce , ONLY : sshv_n => sshv_n !: sea surface height at v-point [m] 203 USE oce , ONLY : sshv_b => sshv_b !: sea surface height at v-point [m] 204 USE oce , ONLY : sshv_a => sshv_a !: sea surface height at v-point [m] 205 USE oce , ONLY : sshf_n => sshf_n !: sea surface height at v-point [m] 192 206 USE oce , ONLY : l_traldf_rot => l_traldf_rot !: rotated laplacian operator for lateral diffusion 193 207 #if defined key_offline … … 206 220 USE sbc_oce , ONLY : qsr => qsr !: penetrative solar radiation (w m-2) 207 221 USE sbc_oce , ONLY : emp => emp !: freshwater budget: volume flux [Kg/m2/s] 222 USE sbc_oce , ONLY : emp_b => emp_b !: freshwater budget: volume flux [Kg/m2/s] 208 223 USE sbc_oce , ONLY : emps => emps !: freshwater budget: concentration/dillution [Kg/m2/s] 209 224 USE sbc_oce , ONLY : rnf => rnf !: river runoff [Kg/m2/s] … … 216 231 USE sbcrnf , ONLY : rnfmsk => rnfmsk !: mixed adv scheme in runoffs vicinity (hori.) 217 232 USE sbcrnf , ONLY : rnfmsk_z => rnfmsk_z !: mixed adv scheme in runoffs vicinity (vert.) 233 USE sbcrnf , ONLY : h_rnf => h_rnf !: river runoff [Kg/m2/s] 218 234 219 235 USE trc_oce -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/trc.F90
r2997 r3116 54 54 LOGICAL , PUBLIC :: ln_trcdta !: Read inputs data from files 55 55 LOGICAL , PUBLIC :: ln_trcdmp !: internal damping flag 56 INTEGER , PUBLIC :: nittrc000 !: first time step of passive tracers model 56 57 57 58 !! information for outputs … … 98 99 CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ctrbiu !: bio field unit 99 100 101 !! variables to average over physics over passive tracer sub-steps. 102 !! ---------------------------------------------------------------- 103 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_tm !: i-horizontal velocity average [m/s] 104 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: vn_tm !: j-horizontal velocity average [m/s] 105 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: tsn_tm !: t/s average [m/s] 106 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avt_tm !: vertical diffusivity coeff. at w-point [m2/s] 107 # if defined key_zdfddm 108 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avs_tm !: vertical double diffusivity coeff. at w-point [m/s] 109 # endif 110 #if defined key_ldfslp 111 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wslpi_tm !: i-direction slope at u-, w-points 112 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wslpj_tm !: j-direction slope at u-, w-points 113 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uslp_tm !: j-direction slope at u-, w-points 114 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: vslp_tm !: j-direction slope at u-, w-points 115 #endif 116 #if defined key_trabbl 117 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahu_bbl_tm !: u-, w-points 118 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahv_bbl_tm !: j-direction slope at u-, w-points 119 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utr_bbl_tm !: j-direction slope at u-, w-points 120 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vtr_bbl_tm !: j-direction slope at u-, w-points 121 #endif 122 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshn_tm !: average ssh for the now step [m] 123 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshu_n_tm !: average ssh for the now step [m] 124 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshv_n_tm !: average ssh for the now step [m] 125 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshb_hold !:hold sshb from the beginning of each sub-stepping[m] 126 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshu_b_hold !:hold sshb from the beginning of each sub-stepping[m] 127 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshv_b_hold !:hold sshb from the beginning of each sub-stepping[m] 128 129 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rnf_tm !: river runoff 130 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: h_rnf_tm !: depth in metres to the bottom of the relevant grid box 131 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hmld_tm !: mixed layer depth average [m] 132 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr_i_tm !: average ice fraction [m/s] 133 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_tm !: freshwater budget: volume flux [Kg/m2/s] 134 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emps_tm !: freshwater budget:concentration/dilution [Kg/m2/s] 135 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_b_hold !: hold emp from the beginning of each sub-stepping[m] 136 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsr_tm !: solar radiation average [m] 137 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wndm_tm !: 10m wind average [m] 138 ! 139 #if defined key_traldf_c3d 140 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ahtt_tm, ahtu_tm, ahtv_tm, ahtw_tm !: ** 3D coefficients ** at T-,U-,V-,W-points 141 #elif defined key_traldf_c2d 142 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahtt_tm, ahtu_tm, ahtv_tm, ahtw_tm !: ** 2D coefficients ** at T-,U-,V-,W-points 143 #elif defined key_traldf_c1d 144 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ahtt_tm, ahtu_tm, ahtv_tm, ahtw_tm !: ** 1D coefficients ** at T-,U-,V-,W-points 145 #else 146 REAL(wp), PUBLIC :: ahtt_tm, ahtu_tm, ahtv_tm, ahtw_tm !: ** 0D coefficients ** at T-,U-,V-,W-points 147 #endif 148 ! 149 #if defined key_traldf_eiv 150 # if defined key_traldf_c3d 151 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: aeiu_tm , aeiv_tm , aeiw_tm !: ** 3D coefficients ** 152 # elif defined key_traldf_c2d 153 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: aeiu_tm , aeiv_tm , aeiw_tm !: ** 2D coefficients ** 154 # elif defined key_traldf_c1d 155 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: aeiu_tm , aeiv_tm, aeiw_tm !: ** 1D coefficients ** 156 # else 157 REAL(wp), PUBLIC :: aeiu_tm , aeiv_tm , aeiw_tm !: ** 0D coefficients ** 158 # endif 159 #endif 160 161 ! Temporary physical arrays for sub_stepping 162 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: tsn_temp 163 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_temp,vn_temp,wn_temp !: hold current values of avt, un, vn, wn 164 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avt_temp !: hold current values of avt, un, vn, wn 165 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3t_temp,e3u_temp,e3v_temp,e3w_temp !: hold current values 166 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshn_temp, sshb_temp, ssha_temp, rnf_temp,h_rnf_temp 167 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshu_n_temp, sshu_b_temp, sshu_a_temp 168 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshf_n_temp 169 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshv_n_temp, sshv_b_temp, sshv_a_temp 170 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_temp, hv_temp, hur_temp, hvr_temp 171 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdivn_temp, rotn_temp 172 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdivb_temp, rotb_temp 173 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hmld_temp, qsr_temp, fr_i_temp,wndm_temp 174 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_temp, emps_temp, emp_b_temp 175 ! 176 #if defined key_trabbl 177 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahu_bbl_temp, ahv_bbl_temp, utr_bbl_temp, vtr_bbl_temp !: hold current values 178 #endif 179 ! 180 #if defined key_ldfslp 181 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wslpi_temp, wslpj_temp, uslp_temp, vslp_temp !: hold current values 182 #endif 183 ! 184 # if defined key_zdfddm 185 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avs_temp !: salinity vertical diffusivity coeff. at w-point [m/s] 186 # endif 187 ! 188 #if defined key_traldf_c3d 189 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ahtt_temp, ahtu_temp, ahtv_temp, ahtw_temp 190 #elif defined key_traldf_c2d 191 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahtt_temp, ahtu_temp, ahtv_temp, ahtw_temp 192 #elif defined key_traldf_c1d 193 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ahtt_temp, ahtu_temp, ahtv_temp, ahtw_temp 194 #else 195 REAL(wp), PUBLIC :: ahtt_temp, ahtu_temp, ahtv_temp, ahtw_temp 196 #endif 197 ! 198 #if defined key_traldf_eiv 199 # if defined key_traldf_c3d 200 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: aeiu_temp , aeiv_temp , aeiw_temp !: ** 3D coefficients ** 201 # elif defined key_traldf_c2d 202 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: aeiu_temp , aeiv_temp , aeiw_temp !: ** 2D coefficients ** 203 # elif defined key_traldf_c1d 204 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: aeiu_temp , aeiv_temp, aeiw_temp !: ** 1D coefficients ** 205 # else 206 REAL(wp), PUBLIC :: aeiu_temp , aeiv_temp , aeiw_temp !: ** 0D coefficients ** 207 # endif 208 # endif 209 100 210 !!---------------------------------------------------------------------- 101 211 !! NEMO/TOP 3.3.1 , NEMO Consortium (2010) -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/trcdia.F90
r2977 r3116 93 93 !! ** Purpose : Standard output of passive tracer : concentration fields 94 94 !! 95 !! ** Method : At the beginning of the first time step (nit 000), define all95 !! ** Method : At the beginning of the first time step (nittrc000), define all 96 96 !! the NETCDF files and fields for concentration of passive tracer 97 97 !! … … 143 143 144 144 ! define time axis 145 itmod = kt - nit 000 + 1145 itmod = kt - nittrc000 + 1 146 146 it = kt 147 147 iiter = ( nit000 - 1 ) / nn_dttrc … … 152 152 IF(ll_print)WRITE(numout,*)'trcdit_wr kt=',kt,' kindic ',kindic 153 153 154 IF( kt == nit 000 ) THEN154 IF( kt == nittrc000 ) THEN 155 155 156 156 IF(lwp) THEN ! control print … … 167 167 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 168 168 IF(lwp)WRITE(numout,*)' ' 169 IF(lwp)WRITE(numout,*)' Date 0 used :', nit 000 &169 IF(lwp)WRITE(numout,*)' Date 0 used :', nittrc000 & 170 170 & ,' YEAR ', nyear, ' MONTH ', nmonth, ' DAY ', nday & 171 171 & ,'Julian day : ', zjulian … … 241 241 !! ** Purpose : output of passive tracer : additional 2D and 3D arrays 242 242 !! 243 !! ** Method : At the beginning of the first time step (nit 000), define all243 !! ** Method : At the beginning of the first time step (nittrc000), define all 244 244 !! the NETCDF files and fields for concentration of passive tracer 245 245 !! … … 290 290 291 291 ! define time axis 292 itmod = kt - nit 000 + 1292 itmod = kt - nittrc000 + 1 293 293 it = kt 294 294 iiter = ( nit000 - 1 ) / nn_dttrc … … 299 299 IF( ll_print ) WRITE(numout,*) 'trcdii_wr kt=', kt, ' kindic ', kindic 300 300 301 IF( kt == nit 000 ) THEN301 IF( kt == nittrc000 ) THEN 302 302 303 303 ! Define the NETCDF files for additional arrays : 2D or 3D … … 382 382 !! ** Purpose : output of passive tracer : biological fields 383 383 !! 384 !! ** Method : At the beginning of the first time step (nit 000), define all384 !! ** Method : At the beginning of the first time step (nittrc000), define all 385 385 !! the NETCDF files and fields for concentration of passive tracer 386 386 !! … … 431 431 432 432 ! define time axis 433 itmod = kt - nit 000 + 1433 itmod = kt - nittrc000 + 1 434 434 it = kt 435 435 iiter = ( nit000 - 1 ) / nn_dttrc … … 440 440 IF(ll_print) WRITE(numout,*)'trcdib_wr kt=',kt,' kindic ',kindic 441 441 442 IF( kt == nit 000 ) THEN442 IF( kt == nittrc000 ) THEN 443 443 444 444 ! Define the NETCDF files for biological trends -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r2997 r3116 29 29 USE zpshde ! partial step: hor. derivative (zps_hde routine) 30 30 USE prtctl_trc ! Print control passive tracers (prt_ctl_trc_init routine) 31 USE trcsub ! variables to substep passive tracers 31 32 32 33 IMPLICIT NONE … … 106 107 IF( ln_rsttr ) THEN 107 108 ! 108 IF( lk_offline ) neuler = 1 ! Set time-step indicator at nit 000 (leap-frog)109 IF( lk_offline ) neuler = 1 ! Set time-step indicator at nittrc000 (leap-frog) 109 110 CALL trc_rst_read ! restart from a file 110 111 ! 111 112 ELSE 112 113 IF( lk_offline ) THEN 113 neuler = 0 ! Set time-step indicator at nit 000 (euler)114 neuler = 0 ! Set time-step indicator at nittrc000 (euler) 114 115 CALL day_init ! set calendar 115 116 ENDIF … … 138 139 139 140 IF( ln_zps .AND. .NOT. lk_c1d ) & ! Partial steps: before horizontal gradient of passive 140 & CALL zps_hde( nit000, jptra, trn, gtru, gtrv ) ! tracers at the bottom ocean level 141 141 & CALL zps_hde( nittrc000, jptra, trn, gtru, gtrv ) ! tracers at the bottom ocean level 142 142 ! ! masked grid volume 143 143 DO jk = 1, jpk … … 147 147 ! ! total volume of the ocean 148 148 areatot = glob_sum( cvol(:,:,:) ) 149 150 ! 151 IF( nn_dttrc /= 1 ) CALL trc_sub_ini ! Initialize variables for substepping passive tracers 152 ! 149 153 150 154 trai(:) = 0._wp ! initial content of all tracers -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
r2977 r3116 105 105 END DO 106 106 107 !!KPE computes the first time step of tracer model 108 nittrc000 = nit000 + nn_dttrc - 1 109 107 110 108 111 IF(lwp) THEN ! control print … … 112 115 WRITE(numout,*) ' restart for passive tracer ln_rsttr = ', ln_rsttr 113 116 WRITE(numout,*) ' control of time step for passive tracer nn_rsttr = ', nn_rsttr 117 WRITE(numout,*) ' first time step for pass. trac. nittrc000 = ', nittrc000 118 WRITE(numout,*) ' frequency of outputs for passive tracers nn_writetrc = ', nn_writetrc 114 119 WRITE(numout,*) ' Read inputs data from file ln_trcdta = ', ln_trcdta 115 120 WRITE(numout,*) ' ' -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
r2997 r3116 60 60 ! 61 61 IF( lk_offline ) THEN 62 IF( kt == nit 000 ) THEN62 IF( kt == nittrc000 ) THEN 63 63 lrst_trc = .FALSE. 64 64 nitrst = nitend … … 71 71 ENDIF 72 72 ELSE 73 IF( kt == nit 000 ) lrst_trc = .FALSE.73 IF( kt == nittrc000 ) lrst_trc = .FALSE. 74 74 ENDIF 75 75 … … 77 77 ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 2*nn_dttrc + 1) 78 78 ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 2*nn_dttrc + 1 79 IF( kt == nitrst - 2*nn_dttrc + 1 .OR. nstock == nn_dttrc .OR. ( kt == nitend - nn_dttrc + 1.AND. .NOT. lrst_trc ) ) THEN79 IF( kt == nitrst - 2*nn_dttrc .OR. nstock == nn_dttrc .OR. ( kt == nitend - nn_dttrc .AND. .NOT. lrst_trc ) ) THEN 80 80 ! beware of the format used to write kt (default is i8.8, that should be large enough) 81 81 IF( nitrst > 1.0e9 ) THEN ; WRITE(clkt,* ) nitrst … … 119 119 ! Time domain : restart 120 120 ! --------------------- 121 CALL trc_rst_cal( nit 000, 'READ' ) ! calendar121 CALL trc_rst_cal( nittrc000, 'READ' ) ! calendar 122 122 123 123 ! READ prognostic variables and computes diagnostic variable … … 151 151 REAL(wp) :: zarak0 152 152 !!---------------------------------------------------------------------- 153 154 153 155 154 CALL trc_rst_cal( kt, 'WRITE' ) ! calendar … … 196 195 !! 197 196 !! According to namelist parameter nrstdt, 198 !! nn_rsttr = 0 no control on the date (nit 000 is arbitrary).199 !! nn_rsttr = 1 we verify that nit 000 is equal to the last197 !! nn_rsttr = 0 no control on the date (nittrc000 is arbitrary). 198 !! nn_rsttr = 1 we verify that nittrc000 is equal to the last 200 199 !! time step of previous run + 1. 201 200 !! In both those options, the exact duration of the experiment … … 223 222 WRITE(numout,*) ' *** restart option' 224 223 SELECT CASE ( nn_rsttr ) 225 CASE ( 0 ) ; WRITE(numout,*) ' nn_rsttr = 0 : no control of nit 000'226 CASE ( 1 ) ; WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nit 000 (use ndate0 read in the namelist)'224 CASE ( 0 ) ; WRITE(numout,*) ' nn_rsttr = 0 : no control of nittrc000' 225 CASE ( 1 ) ; WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)' 227 226 CASE ( 2 ) ; WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart' 228 227 END SELECT … … 230 229 ENDIF 231 230 ! Control of date 232 IF( nit 000 - NINT( zkt ) /= nn_dttrc .AND. nn_rsttr /= 0 ) &233 & CALL ctl_stop( ' ===>>>> : problem with nit 000 for the restart', &231 IF( nittrc000 - NINT( zkt ) /= nn_dttrc .AND. nn_rsttr /= 0 ) & 232 & CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart', & 234 233 & ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' ) 235 234 IF( lk_offline ) THEN ! set the date in offline mode … … 246 245 ELSE 247 246 ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam 248 adatrj = ( REAL( nit 000-1, wp ) * rdttra(1) ) / rday247 adatrj = ( REAL( nittrc000-1, wp ) * rdttra(1) ) / rday 249 248 ! note this is wrong if time step has changed during run 250 249 ENDIF -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
r3093 r3116 22 22 USE iom 23 23 USE in_out_manager 24 USE trcsub 24 25 25 26 IMPLICIT NONE … … 53 54 !!------------------------------------------------------------------- 54 55 ! 55 IF( kt == nit 000 ) THEN56 IF( kt == nittrc000 ) THEN 56 57 CALL iom_close( numrtr ) ! close input passive tracers restart file 57 58 IF( lk_trdmld_trc ) CALL trd_mld_trc_init ! trends: Mixed-layer … … 66 67 ENDIF 67 68 ! 68 IF( MOD( kt - 1 , nn_dttrc ) == 0 ) THEN ! only every nn_dttrc time step 69 IF( nn_dttrc /= 1 ) CALL trc_sub_stp( kt ) ! averaging physical variables for sub-stepping 70 71 IF( MOD( kt , nn_dttrc ) == 0 ) THEN ! only every nn_dttrc time step 69 72 ! 70 73 IF(ln_ctl) THEN … … 83 86 IF( lrst_trc ) CALL trc_rst_wri( kt ) ! write tracer restart file 84 87 IF( lk_trdmld_trc ) CALL trd_mld_trc( kt ) ! trends: Mixed-layer 88 ! 89 IF( nn_dttrc /= 1 ) CALL trc_sub_reset( kt ) ! resetting physical variables when sub-stepping 85 90 ! 86 91 ENDIF -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/trcwri.F90
r2977 r3116 57 57 !!--------------------------------------------------------------------- 58 58 59 IF( lk_offline .AND. kt == nit 000 .AND. lwp ) THEN ! WRITE root name in date.file for use by postpro59 IF( lk_offline .AND. kt == nittrc000 .AND. lwp ) THEN ! WRITE root name in date.file for use by postpro 60 60 CALL dia_nam( clhstnam, nn_writetrc,' ' ) 61 61 CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/SETTE/sette.sh
r3029 r3116 145 145 cp BATCH_TEMPLATE/batch-${COMPILER} job_batch_template || exit 146 146 147 for config in 1 2 3 4 5 6 7 8 9 10147 for config in 1 2 3 4 5 6 7 8 9 148 148 do 149 149 … … 543 543 fi 544 544 545 546 545 if [ ${config} -eq 9 ] ; then 547 ## ORCA2_LIM with Agulhas AGRIF zoom 548 export TEST_NAME="SHORT" 549 cd ${SETTE_DIR} 550 . ../CONFIG/makenemo -m ${CMP_NAM} -n ORCA2AGUL -r ORCA2_LIM -j 8 add_key "key_agrif" del_key "key_zdftmx" 551 cd ${SETTE_DIR} 552 . param.cfg 553 . all_functions.sh 554 . prepare_exe_dir.sh 555 cd ${EXE_DIR} 556 set_namelist namelist nn_it000 1 557 set_namelist namelist nn_itend 75 546 ## Reproductibility tests for AMM12 547 cd ${SETTE_DIR} 548 . ../CONFIG/makenemo -m ${CMP_NAM} -n AMM12_32 -r AMM12 add_key "key_mpp_mpi key_mpp_rep" 549 cd ${SETTE_DIR} 550 . param.cfg 551 . all_functions.sh 552 copy_original namelist 553 set_namelist namelist nn_it000 1 554 set_namelist namelist nn_itend 576 555 set_namelist namelist nn_fwb 0 558 556 set_namelist namelist ln_ctl .false. 559 557 set_namelist namelist ln_clobber .true. 560 set_namelist 1_namelist nn_it000 1 561 set_namelist 1_namelist nn_itend 150 562 set_namelist 1_namelist ln_ctl .false. 563 set_namelist 1_namelist ln_clobber .true. 564 cd ${SETTE_DIR} 565 . ./fcm_job.sh input_ORCA2_LIM_AGRIF.cfg 1 ${TEST_NAME} 566 fi 567 568 if [ ${config} -eq 10 ] ; then 569 ## ORCA2_LIM with Agulhas AGRIF zoom in MPI 570 export TEST_NAME="SHORT" 571 cd ${SETTE_DIR} 572 . ../CONFIG/makenemo -m ${CMP_NAM} -n ORCA2AGUL_1_2 -r ORCA2_LIM -j 8 add_key "key_mpp_rep key_mpp_mpi key_agrif" del_key "key_zdftmx" 573 cd ${SETTE_DIR} 574 . param.cfg 575 . all_functions.sh 576 . prepare_exe_dir.sh 577 cd ${EXE_DIR} 578 set_namelist namelist nn_it000 1 579 set_namelist namelist nn_itend 75 558 set_namelist namelist jpni 8 559 set_namelist namelist jpnj 4 560 set_namelist namelist jpnij 32 561 cd ${SETTE_DIR} 562 . ./fcm_job.sh input_AMM12.cfg 32 REPRO_8_4 563 564 cd ${SETTE_DIR} 565 copy_original namelist 566 set_namelist namelist nn_it000 1 567 set_namelist namelist nn_itend 576 568 set_namelist namelist nn_fwb 0 580 569 set_namelist namelist ln_ctl .false. 581 570 set_namelist namelist ln_clobber .true. 582 set_namelist namelist jpni 1 583 set_namelist namelist jpnj 2 584 set_namelist namelist jpnij 2 585 set_namelist 1_namelist nn_it000 1 586 set_namelist 1_namelist nn_itend 150 587 set_namelist 1_namelist ln_ctl .false. 588 set_namelist 1_namelist ln_clobber .true. 589 cd ${SETTE_DIR} 590 . ./fcm_job.sh input_ORCA2_LIM_AGRIF.cfg 2 ${TEST_NAME} 591 fi 592 593 594 571 set_namelist namelist jpni 4 572 set_namelist namelist jpnj 8 573 set_namelist namelist jpnij 32 574 cd ${SETTE_DIR} 575 . ./fcm_job.sh input_AMM12.cfg 32 REPRO_4_8 576 fi 595 577 done -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/TOOLS/COMPILE/cfg.txt
r2977 r3116 3 3 GYRE_LOBSTER OPA_SRC TOP_SRC 4 4 ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC 5 POMME OPA_SRC NST_SRC6 5 ORCA2_LIM3 OPA_SRC LIM_SRC_3 7 6 ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC 8 ORCA2_LIM_CFC OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC 9 ORCA2_OFF_CFC OPA_SRC OFF_SRC TOP_SRC 7 POMME OPA_SRC NST_SRC 8 AMM12 OPA_SRC 9 AMM12-PISCES OPA_SRC TOP_SRC
Note: See TracChangeset
for help on using the changeset viewer.