Changeset 13991
- Timestamp:
- 2020-12-02T13:55:44+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r13787_SI3-10_EAP
- Files:
-
- 113 edited
- 6 copied
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13787_SI3-10_EAP
- Property svn:externals
-
old new 8 8 9 9 # SETTE 10 ^/utils/CI/sette @13559sette10 ^/utils/CI/sette_MPI3_LoopFusion@13943 sette
-
- Property svn:externals
-
NEMO/branches/2020/dev_r13787_SI3-10_EAP/cfgs/SHARED/namelist_ref
r13731 r13991 94 94 ln_use_jattr = .false. ! use (T) the file attribute: open_ocean_jstart, if present 95 95 ! ! in netcdf input files, as the start j-row for reading 96 / 97 !----------------------------------------------------------------------- 98 &namtile ! parameters of the tiling 99 !----------------------------------------------------------------------- 100 ln_tile = .false. ! Use tiling (T) or not (F) 101 nn_ltile_i = 10 ! Length of tiles in i 102 nn_ltile_j = 10 ! Length of tiles in j 96 103 / 97 104 !----------------------------------------------------------------------- -
NEMO/branches/2020/dev_r13787_SI3-10_EAP/doc/latex/NEMO/main/bibliography.bib
r12377 r13991 1906 1906 } 1907 1907 1908 @Article{ love_PRSLA1909, 1909 author = "A. E. H. Love", 1910 title = "The Yielding of the Earth to Disturbing Forces", 1911 journal = "Proc. R. Soc. Lond. A", 1912 year = "1909", 1913 volume = "82", 1914 pages = "73-88", 1915 doi = "10.1098/rspa.1909.0008" 1916 } 1917 1908 1918 @article{ losch_JGR08, 1909 1919 title = "Modeling ice shelf cavities in a z coordinate Ocean -
NEMO/branches/2020/dev_r13787_SI3-10_EAP/doc/latex/NEMO/subfiles/chap_DIA.tex
r12377 r13991 119 119 \subsection{XIOS: Reading and writing restart file} 120 120 121 XIOS may be used to read single file restart produced by \NEMO. Currently only the variables written to 122 file \forcode{numror} can be handled by XIOS. To activate restart reading using XIOS, set \np[=.true. ]{ln_xios_read}{ln\_xios\_read} 121 XIOS may be used to read single file restart produced by \NEMO. The variables written to 122 file \forcode{numror} (OCE), \forcode{numrir} (SI3), \forcode{numrtr} (TOP), \forcode{numrsr} (SED) can be handled by XIOS. 123 To activate restart reading using XIOS, set \np[=.true. ]{ln_xios_read}{ln\_xios\_read} 123 124 in \textit{namelist\_cfg}. This setting will be ignored when multiple restart files are present, and default \NEMO 124 125 functionality will be used for reading. There is no need to change iodef.xml file to use XIOS to read … … 142 143 have to be rebuild before continuing the run. This option aims to reduce number of restart files generated by \NEMO\ only, 143 144 and may be useful when there is a need to change number of processors used to run simulation. 144 145 If an additional variable must be written to a restart file, the following steps are needed:146 \begin{enumerate}147 \item Add variable name to a list of restart variables (in subroutine \rou{iom\_set\_rst\_vars,} \mdl{iom}) and148 define correct grid for the variable (\forcode{grid_N_3D} - 3D variable, \forcode{grid_N} - 2D variable, \forcode{grid_vector} -149 1D variable, \forcode{grid_scalar} - scalar),150 \item Add variable to the list of fields written by restart. This can be done either in subroutine151 \rou{iom\_set\_rstw\_core} (\mdl{iom}) or by calling \rou{iom\_set\_rstw\_active} (\mdl{iom}) with the name of a variable152 as an argument. This convention follows approach for writing restart using iom, where variables are153 written either by \rou{rst\_write} or by calling \rou{iom\_rstput} from individual routines.154 \end{enumerate}155 145 156 146 An older versions of XIOS do not support reading functionality. It's recommended to use at least XIOS2@1451. -
NEMO/branches/2020/dev_r13787_SI3-10_EAP/doc/latex/NEMO/subfiles/chap_DYN.tex
r11693 r13991 1245 1245 the atmospheric pressure is taken into account when computing the surface pressure gradient. 1246 1246 1247 (2) When \np[=.true.]{ln_tide_pot}{ln\_tide\_pot} and \np[=.true.]{ln_tide}{ln\_tide} (see \autoref{sec:SBC_ tide}),1247 (2) When \np[=.true.]{ln_tide_pot}{ln\_tide\_pot} and \np[=.true.]{ln_tide}{ln\_tide} (see \autoref{sec:SBC_TDE}), 1248 1248 the tidal potential is taken into account when computing the surface pressure gradient. 1249 1249 -
NEMO/branches/2020/dev_r13787_SI3-10_EAP/doc/latex/NEMO/subfiles/chap_LBC.tex
r11693 r13991 16 16 Release & Author(s) & Modifications \\ 17 17 \hline 18 {\em next} & {\em Simon M{\" u}ller} & {\em Minor update of \autoref{subsec:LBC_bdy_tides}} \\[2mm] 18 19 {\em 4.0} & {\em ...} & {\em ...} \\ 19 20 {\em 3.6} & {\em ...} & {\em ...} \\ … … 665 666 666 667 Tidal forcing at open boundaries requires the activation of surface 667 tides (i.e., in \nam{_tide}{\_tide}, \np{ln_tide}{ln\_tide} needs to be set to 668 \forcode{.true.} and the required constituents need to be activated by 669 including their names in the \np{clname}{clname} array; see 670 \autoref{sec:SBC_tide}). Specific options related to the reading in of 668 tides (i.e., in \nam{_tide}{\_tide}, \np[=.true.]{ln_tide}{ln\_tide} with the active tidal 669 constituents listed in the \np{sn_tide_cnames}{sn\_tide\_cnames} array; see 670 \autoref{sec:SBC_TDE}). The specific options related to the reading in of 671 671 the complex harmonic amplitudes of elevation (SSH) and barotropic 672 velocity (u,v) atopen boundaries are defined through the673 \nam{bdy_tide}{bdy\_tide} namelist parameters.\ \672 velocity components (u,v) at the open boundaries are defined through the 673 \nam{bdy_tide}{bdy\_tide} namelist parameters.\par 674 674 675 675 The tidal harmonic data at open boundaries can be specified in two 676 676 different ways, either on a two-dimensional grid covering the entire 677 677 model domain or along open boundary segments; these two variants can 678 be selected by setting \np{ln_bdytide_2ddta }{ln\_bdytide\_2ddta } to \forcode{.true.} or 679 \forcode{.false.}, respectively. In either case, the real and 680 imaginary parts of SSH and the two barotropic velocity components for 681 each activated tidal constituent \textit{tcname} have to be provided 682 separately: when two-dimensional data is used, variables 683 \textit{tcname\_z1} and \textit{tcname\_z2} for real and imaginary SSH, 684 respectively, are expected in input file \np{filtide}{filtide} with suffix 685 \ifile{\_grid\_T}, variables \textit{tcname\_u1} and 686 \textit{tcname\_u2} for real and imaginary u, respectively, are 687 expected in input file \np{filtide}{filtide} with suffix \ifile{\_grid\_U}, and 688 \textit{tcname\_v1} and \textit{tcname\_v2} for real and imaginary v, 689 respectively, are expected in input file \np{filtide}{filtide} with suffix 690 \ifile{\_grid\_V}; when data along open boundary segments is used, 691 variables \textit{z1} and \textit{z2} (real and imaginary part of SSH) 692 are expected to be available from file \np{filtide}{filtide} with suffix 693 \ifile{tcname\_grid\_T}, variables \textit{u1} and \textit{u2} (real 694 and imaginary part of u) are expected to be available from file 695 \np{filtide}{filtide} with suffix \ifile{tcname\_grid\_U}, and variables 696 \textit{v1} and \textit{v2} (real and imaginary part of v) are 697 expected to be available from file \np{filtide}{filtide} with suffix 698 \ifile{tcname\_grid\_V}. If \np{ln_bdytide_conj}{ln\_bdytide\_conj} is set to 699 \forcode{.true.}, the data is expected to be in complex conjugate 700 form. 678 be selected by setting \np[=.true.]{ln_bdytide_2ddta}{ln\_bdytide\_2ddta} or 679 \np[=.false.]{ln_bdytide_2ddta}{ln\_bdytide\_2ddta}, respectively. In either 680 case, the real and imaginary parts of SSH, u, and v amplitudes associated with 681 each activated tidal constituent \texttt{<constituent>} have to be provided 682 separately as fields in input files with names based on 683 \np[=<input>]{filtide}{filtide}: when two-dimensional data is used, variables 684 \texttt{<constituent>\_z1} and \texttt{<constituent>\_z2} for the real and imaginary parts of 685 SSH, respectively, are expected to be available in file 686 \ifile{<input>\_grid\_T}, variables \texttt{<constituent>\_u1} and 687 \texttt{<constituent>\_u2} for the real and imaginary parts of u, respectively, in file 688 \ifile{<input>\_grid\_U}, and \texttt{<constituent>\_v1} and 689 \texttt{<constituent>\_v2} for the real and imaginary parts of v, respectively, in file 690 \ifile{<input>\_grid\_V}; when data along open boundary segments is used, 691 variables \texttt{z1} and \texttt{z2} (real and imaginary part of SSH) are 692 expected to be available in file \ifile{<input><constituent>\_grid\_T}, 693 variables \texttt{u1} and \texttt{u2} (real and imaginary part of u) in file 694 \ifile{<input><constituent>\_grid\_U}, and variables \texttt{v1} and \texttt{v2} 695 (real and imaginary part of v) in file 696 \ifile{<input><constituent>\_grid\_V}.\par 701 697 702 698 Note that the barotropic velocity components are assumed to be defined -
NEMO/branches/2020/dev_r13787_SI3-10_EAP/doc/latex/NEMO/subfiles/chap_SBC.tex
r13165 r13991 5 5 \begin{document} 6 6 7 \chapter{Surface Boundary Condition (SBC, SAS, ISF, ICB )}7 \chapter{Surface Boundary Condition (SBC, SAS, ISF, ICB, TDE)} 8 8 \label{chap:SBC} 9 9 … … 18 18 Release & Author(s) & Modifications \\ 19 19 \hline 20 {\em next} & {\em Simon M{\" u}ller} & {\em Update of \autoref{sec:SBC_TDE}}\\[2mm] 20 21 {\em 4.0} & {\em ...} & {\em ...} \\ 21 22 {\em 3.6} & {\em ...} & {\em ...} \\ … … 1013 1014 1014 1015 %% ================================================================================================= 1015 \section [Surface tides (\textit{sbctide.F90})]{Surface tides (\protect\mdl{sbctide})}1016 \label{sec:SBC_ tide}1016 \section{Surface tides (TDE)} 1017 \label{sec:SBC_TDE} 1017 1018 1018 1019 \begin{listing} … … 1022 1023 \end{listing} 1023 1024 1024 The tidal forcing, generated by the gravity forces of the Earth-Moon and Earth-Sun sytems, 1025 is activated if \np{ln_tide}{ln\_tide} and \np{ln_tide_pot}{ln\_tide\_pot} are both set to \forcode{.true.} in \nam{_tide}{\_tide}. 1026 This translates as an additional barotropic force in the momentum \autoref{eq:MB_PE_dyn} such that: 1025 \subsection{Tidal constituents} 1026 Ocean model component TDE provides the common functionality for tidal forcing 1027 and tidal analysis in the model framework. This includes the computation of the gravitational 1028 surface forcing, as well as support for lateral forcing at open boundaries (see 1029 \autoref{subsec:LBC_bdy_tides}) and tidal harmonic analysis (see 1030 \autoref{subsec:DIA_diamlr} and \autoref{subsec:DIA_diadetide}). The module is 1031 activated with \np[=.true.]{ln_tide}{ln\_tide} in namelist 1032 \nam{_tide}{\_tide}. It provides the same 34 tidal constituents that are 1033 included in the 1034 \href{https://www.aviso.altimetry.fr/en/data/products/auxiliary-products/global-tide-fes.html}{FES2014 1035 ocean tide model}: Mf, Mm, Ssa, Mtm, Msf, Msqm, Sa, K1, O1, P1, Q1, J1, S1, 1036 M2, S2, N2, K2, nu2, mu2, 2N2, L2, T2, eps2, lam2, R2, M3, MKS2, MN4, MS4, M4, 1037 N4, S4, M6, and M8; see file \hf{tide} and \mdl{tide\_mod} for further 1038 information and references\footnote{As a legacy option \np{ln_tide_var} can be 1039 set to \forcode{0}, in which case the 19 tidal constituents (M2, N2, 2N2, S2, 1040 K2, K1, O1, Q1, P1, M4, Mf, Mm, Msqm, Mtm, S1, MU2, NU2, L2, and T2; see file 1041 \hf{tide}) and associated parameters that have been available in NEMO version 1042 4.0 and earlier are available}. Constituents to be included in the tidal forcing 1043 (surface and lateral boundaries) are selected by enumerating their respective 1044 names in namelist array \np{sn_tide_cnames}{sn\_tide\_cnames}.\par 1045 1046 \subsection{Surface tidal forcing} 1047 Surface tidal forcing can be represented in the model through an additional 1048 barotropic force in the momentum equation (\autoref{eq:MB_PE_dyn}) such that: 1027 1049 \[ 1028 % \label{eq:SBC_PE_dyn_tides} 1029 \frac{\partial {\mathrm {\mathbf U}}_h }{\partial t}= ... 1030 +g\nabla (\Pi_{eq} + \Pi_{sal}) 1050 \frac{\partial {\mathrm {\mathbf U}}_h }{\partial t} = \ldots +g\nabla (\gamma 1051 \Pi_{eq} + \Pi_{sal}) 1031 1052 \] 1032 where $\Pi_{eq}$ stands for the equilibrium tidal forcing and 1033 $\Pi_{sal}$ is a self-attraction and loading term (SAL). 1034 1035 The equilibrium tidal forcing is expressed as a sum over a subset of 1036 constituents chosen from the set of available tidal constituents 1037 defined in file \hf{SBC/tide} (this comprises the tidal 1038 constituents \textit{M2, N2, 2N2, S2, K2, K1, O1, Q1, P1, M4, Mf, Mm, 1039 Msqm, Mtm, S1, MU2, NU2, L2}, and \textit{T2}). Individual 1040 constituents are selected by including their names in the array 1041 \np{clname}{clname} in \nam{_tide}{\_tide} (e.g., \np{clname}{clname}\forcode{(1)='M2', } 1042 \np{clname}{clname}\forcode{(2)='S2'} to select solely the tidal consituents \textit{M2} 1043 and \textit{S2}). Optionally, when \np{ln_tide_ramp}{ln\_tide\_ramp} is set to 1044 \forcode{.true.}, the equilibrium tidal forcing can be ramped up 1045 linearly from zero during the initial \np{rdttideramp}{rdttideramp} days of the 1046 model run. 1053 where $\gamma \Pi_{eq}$ stands for the equilibrium tidal forcing scaled by a spatially 1054 uniform tilt factor $\gamma$, and $\Pi_{sal}$ is an optional 1055 self-attraction and loading term (SAL). These additional terms are enabled when, 1056 in addition to \np[=.true.]{ln_tide}{ln\_tide}), 1057 \np[=.true.]{ln_tide_pot}{ln\_tide\_pot}.\par 1058 1059 The equilibrium tidal forcing is expressed as a sum over the subset of 1060 constituents listed in \np{sn_tide_cnames}{sn\_tide\_cnames} of 1061 \nam{_tide} (e.g., 1062 \begin{forlines} 1063 sn_tide_cnames(1) = 'M2' 1064 sn_tide_cnames(2) = 'K1' 1065 sn_tide_cnames(3) = 'S2' 1066 sn_tide_cnames(4) = 'O1' 1067 \end{forlines} 1068 to select the four tidal constituents of strongest equilibrium tidal 1069 potential). The tidal tilt factor $\gamma = 1 + k - h$ includes the 1070 Love numbers $k$ and $h$ \citep{love_prsla1909}; this factor is 1071 configurable using \np{rn_tide_gamma} (default value 0.7). Optionally, 1072 when \np[=.true.]{ln_tide_ramp}{ln\_tide\_ramp}, the equilibrium tidal 1073 forcing can be ramped up linearly from zero during the initial 1074 \np{rn_tide_ramp_dt}{rn\_tide\_ramp\_dt} days of the model run.\par 1047 1075 1048 1076 The SAL term should in principle be computed online as it depends on 1049 1077 the model tidal prediction itself (see \citet{arbic.garner.ea_DSR04} for a 1050 discussion about the practical implementation of this term). 1051 Nevertheless, the complex calculations involved would make this 1052 computationally too expensive. Here, two options are available: 1053 $\Pi_{sal}$ generated by an external model can be read in 1054 (\np[=.true.]{ln_read_load}{ln\_read\_load}), or a ``scalar approximation'' can be 1055 used (\np[=.true.]{ln_scal_load}{ln\_scal\_load}). In the latter case 1078 discussion about the practical implementation of this term). The complex 1079 calculations involved in such computations, however, are computationally very 1080 expensive. Here, two mutually exclusive simpler variants are available: 1081 amplitudes generated by an external model for oscillatory $\Pi_{sal}$ 1082 contributions from each of the selected tidal constituents can be read in 1083 (\np[=.true.]{ln_read_load}{ln\_read\_load}) from the file specified in 1084 \np{cn_tide_load}{cn\_tide\_load} (the variable names are comprised of the 1085 tidal-constituent name and suffixes \forcode{_z1} and \forcode{_z2} for the two 1086 orthogonal components, respectively); alternatively, a ``scalar approximation'' 1087 can be used (\np[=.true.]{ln_scal_load}{ln\_scal\_load}), where 1056 1088 \[ 1057 1089 \Pi_{sal} = \beta \eta, 1058 1090 \] 1059 where $\beta$ (\np{rn_scal_load}{rn\_scal\_load} with a default value of 0.094) is a 1060 spatially constant scalar, often chosen to minimize tidal prediction 1061 errors. Setting both \np{ln_read_load}{ln\_read\_load} and \np{ln_scal_load}{ln\_scal\_load} to 1062 \forcode{.false.} removes the SAL contribution. 1091 with a spatially uniform coefficient $\beta$, which can be configured 1092 via \np{rn_scal_load}{rn\_scal\_load} (default value 0.094) and is 1093 often tuned to minimize tidal prediction errors.\par 1094 1095 For diagnostic purposes, the forcing potential of the individual tidal 1096 constituents (incl. load ptential, if activated) and the total forcing 1097 potential (incl. load potential, if activated) can be made available 1098 as diagnostic output by setting 1099 \np[=.true.]{ln_tide_dia}{ln\_tide\_dia} (fields 1100 \forcode{tide_pot_<constituent>} and \forcode{tide_pot}).\par 1063 1101 1064 1102 %% ================================================================================================= -
NEMO/branches/2020/dev_r13787_SI3-10_EAP/doc/namelists/nam_tide
r10075 r13991 3 3 !----------------------------------------------------------------------- 4 4 ln_tide = .false. ! Activate tides 5 ln_tide_pot = .true. ! use tidal potential forcing 5 nn_tide_var = 1 ! Variant of tidal parameter set and tide-potential computation 6 ! ! (1: default; 0: compatibility with previous versions) 7 ln_tide_dia = .false. ! Enable tidal diagnostic output 8 ln_tide_pot = .false. ! use tidal potential forcing 9 rn_tide_gamma = 0.7 ! Tidal tilt factor 6 10 ln_scal_load = .false. ! Use scalar approximation for 7 11 rn_scal_load = 0.094 ! load potential 8 12 ln_read_load = .false. ! Or read load potential from file 9 13 cn_tide_load = 'tide_LOAD_grid_T.nc' ! filename for load potential 10 ! 14 ! 11 15 ln_tide_ramp = .false. ! Use linear ramp for tides at startup 12 r dttideramp = 0.! ramp duration in days13 clname(1)= 'DUMMY' ! name of constituent - all tidal components must be set in namelist_cfg16 rn_tide_ramp_dt = 0. ! ramp duration in days 17 sn_tide_cnames(1) = 'DUMMY' ! name of constituent - all tidal components must be set in namelist_cfg 14 18 / -
NEMO/branches/2020/dev_r13787_SI3-10_EAP/doc/namelists/nambdy_tide
r10075 r13991 4 4 filtide = 'bdydta/amm12_bdytide_' ! file name root of tidal forcing files 5 5 ln_bdytide_2ddta = .false. ! 6 ln_bdytide_conj = .false. !7 6 / -
NEMO/branches/2020/dev_r13787_SI3-10_EAP/src/ICE/icedia.F90
r13286 r13991 261 261 ! Write in numriw (if iter == nitrst) 262 262 ! ------------------ 263 CALL iom_rstput( iter, nitrst, numriw, 'frc_voltop' , frc_voltop 264 CALL iom_rstput( iter, nitrst, numriw, 'frc_volbot' , frc_volbot 265 CALL iom_rstput( iter, nitrst, numriw, 'frc_temtop' , frc_temtop 266 CALL iom_rstput( iter, nitrst, numriw, 'frc_tembot' , frc_tembot 267 CALL iom_rstput( iter, nitrst, numriw, 'frc_sal' , frc_sal 263 CALL iom_rstput( iter, nitrst, numriw, 'frc_voltop' , frc_voltop ) 264 CALL iom_rstput( iter, nitrst, numriw, 'frc_volbot' , frc_volbot ) 265 CALL iom_rstput( iter, nitrst, numriw, 'frc_temtop' , frc_temtop ) 266 CALL iom_rstput( iter, nitrst, numriw, 'frc_tembot' , frc_tembot ) 267 CALL iom_rstput( iter, nitrst, numriw, 'frc_sal' , frc_sal ) 268 268 CALL iom_rstput( iter, nitrst, numriw, 'vol_loc_ini', vol_loc_ini ) 269 269 CALL iom_rstput( iter, nitrst, numriw, 'tem_loc_ini', tem_loc_ini ) -
NEMO/branches/2020/dev_r13787_SI3-10_EAP/src/ICE/icedyn_adv_pra.F90
r13637 r13991 989 989 DO jk = 1, nlay_s 990 990 WRITE(zchar1,'(I2.2)') jk 991 znam = 'sxc0'//'_l'//zchar1 ; CALL iom_get( numrir, jpdom_auto, znam , z3d, psgn = -1._wp ) ; sxc0 (:,:,jk,:) = z3d(:,:,:) 992 znam = 'syc0'//'_l'//zchar1 ; CALL iom_get( numrir, jpdom_auto, znam , z3d, psgn = -1._wp ) ; syc0 (:,:,jk,:) = z3d(:,:,:) 993 znam = 'sxxc0'//'_l'//zchar1 ; CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; sxxc0(:,:,jk,:) = z3d(:,:,:) 994 znam = 'syyc0'//'_l'//zchar1 ; CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; syyc0(:,:,jk,:) = z3d(:,:,:) 995 znam = 'sxyc0'//'_l'//zchar1 ; CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; sxyc0(:,:,jk,:) = z3d(:,:,:) 991 znam = 'sxc0'//'_l'//zchar1 992 CALL iom_get( numrir, jpdom_auto, znam , z3d, psgn = -1._wp ) ; sxc0 (:,:,jk,:) = z3d(:,:,:) 993 znam = 'syc0'//'_l'//zchar1 994 CALL iom_get( numrir, jpdom_auto, znam , z3d, psgn = -1._wp ) ; syc0 (:,:,jk,:) = z3d(:,:,:) 995 znam = 'sxxc0'//'_l'//zchar1 996 CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; sxxc0(:,:,jk,:) = z3d(:,:,:) 997 znam = 'syyc0'//'_l'//zchar1 998 CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; syyc0(:,:,jk,:) = z3d(:,:,:) 999 znam = 'sxyc0'//'_l'//zchar1 1000 CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; sxyc0(:,:,jk,:) = z3d(:,:,:) 996 1001 END DO 997 1002 ! ! ice layers heat content 998 1003 DO jk = 1, nlay_i 999 1004 WRITE(zchar1,'(I2.2)') jk 1000 znam = 'sxe'//'_l'//zchar1 ; CALL iom_get( numrir, jpdom_auto, znam , z3d, psgn = -1._wp ) ; sxe (:,:,jk,:) = z3d(:,:,:) 1001 znam = 'sye'//'_l'//zchar1 ; CALL iom_get( numrir, jpdom_auto, znam , z3d, psgn = -1._wp ) ; sye (:,:,jk,:) = z3d(:,:,:) 1002 znam = 'sxxe'//'_l'//zchar1 ; CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; sxxe(:,:,jk,:) = z3d(:,:,:) 1003 znam = 'syye'//'_l'//zchar1 ; CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; syye(:,:,jk,:) = z3d(:,:,:) 1004 znam = 'sxye'//'_l'//zchar1 ; CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; sxye(:,:,jk,:) = z3d(:,:,:) 1005 znam = 'sxe'//'_l'//zchar1 1006 CALL iom_get( numrir, jpdom_auto, znam , z3d, psgn = -1._wp ) ; sxe (:,:,jk,:) = z3d(:,:,:) 1007 znam = 'sye'//'_l'//zchar1 1008 CALL iom_get( numrir, jpdom_auto, znam , z3d, psgn = -1._wp ) ; sye (:,:,jk,:) = z3d(:,:,:) 1009 znam = 'sxxe'//'_l'//zchar1 1010 CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; sxxe(:,:,jk,:) = z3d(:,:,:) 1011 znam = 'syye'//'_l'//zchar1 1012 CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; syye(:,:,jk,:) = z3d(:,:,:) 1013 znam = 'sxye'//'_l'//zchar1 1014 CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; sxye(:,:,jk,:) = z3d(:,:,:) 1005 1015 END DO 1006 1016 ! … … 1067 1077 ! 1068 1078 ! ! ice thickness 1069 CALL iom_rstput( iter, nitrst, numriw, 'sxice' , sxice 1070 CALL iom_rstput( iter, nitrst, numriw, 'syice' , syice 1071 CALL iom_rstput( iter, nitrst, numriw, 'sxxice', sxxice 1072 CALL iom_rstput( iter, nitrst, numriw, 'syyice', syyice 1073 CALL iom_rstput( iter, nitrst, numriw, 'sxyice', sxyice 1079 CALL iom_rstput( iter, nitrst, numriw, 'sxice' , sxice) 1080 CALL iom_rstput( iter, nitrst, numriw, 'syice' , syice) 1081 CALL iom_rstput( iter, nitrst, numriw, 'sxxice', sxxice) 1082 CALL iom_rstput( iter, nitrst, numriw, 'syyice', syyice) 1083 CALL iom_rstput( iter, nitrst, numriw, 'sxyice', sxyice) 1074 1084 ! ! snow thickness 1075 CALL iom_rstput( iter, nitrst, numriw, 'sxsn' , sxsn 1076 CALL iom_rstput( iter, nitrst, numriw, 'sysn' , sysn 1077 CALL iom_rstput( iter, nitrst, numriw, 'sxxsn' , sxxsn 1078 CALL iom_rstput( iter, nitrst, numriw, 'syysn' , syysn 1079 CALL iom_rstput( iter, nitrst, numriw, 'sxysn' , sxysn 1085 CALL iom_rstput( iter, nitrst, numriw, 'sxsn' , sxsn ) 1086 CALL iom_rstput( iter, nitrst, numriw, 'sysn' , sysn ) 1087 CALL iom_rstput( iter, nitrst, numriw, 'sxxsn' , sxxsn ) 1088 CALL iom_rstput( iter, nitrst, numriw, 'syysn' , syysn ) 1089 CALL iom_rstput( iter, nitrst, numriw, 'sxysn' , sxysn ) 1080 1090 ! ! ice concentration 1081 CALL iom_rstput( iter, nitrst, numriw, 'sxa' , sxa 1082 CALL iom_rstput( iter, nitrst, numriw, 'sya' , sya 1083 CALL iom_rstput( iter, nitrst, numriw, 'sxxa' , sxxa 1084 CALL iom_rstput( iter, nitrst, numriw, 'syya' , syya 1085 CALL iom_rstput( iter, nitrst, numriw, 'sxya' , sxya 1091 CALL iom_rstput( iter, nitrst, numriw, 'sxa' , sxa ) 1092 CALL iom_rstput( iter, nitrst, numriw, 'sya' , sya ) 1093 CALL iom_rstput( iter, nitrst, numriw, 'sxxa' , sxxa ) 1094 CALL iom_rstput( iter, nitrst, numriw, 'syya' , syya ) 1095 CALL iom_rstput( iter, nitrst, numriw, 'sxya' , sxya ) 1086 1096 ! ! ice salinity 1087 CALL iom_rstput( iter, nitrst, numriw, 'sxsal' , sxsal 1088 CALL iom_rstput( iter, nitrst, numriw, 'sysal' , sysal 1089 CALL iom_rstput( iter, nitrst, numriw, 'sxxsal', sxxsal 1090 CALL iom_rstput( iter, nitrst, numriw, 'syysal', syysal 1091 CALL iom_rstput( iter, nitrst, numriw, 'sxysal', sxysal 1097 CALL iom_rstput( iter, nitrst, numriw, 'sxsal' , sxsal) 1098 CALL iom_rstput( iter, nitrst, numriw, 'sysal' , sysal) 1099 CALL iom_rstput( iter, nitrst, numriw, 'sxxsal', sxxsal) 1100 CALL iom_rstput( iter, nitrst, numriw, 'syysal', syysal) 1101 CALL iom_rstput( iter, nitrst, numriw, 'sxysal', sxysal) 1092 1102 ! ! ice age 1093 CALL iom_rstput( iter, nitrst, numriw, 'sxage' , sxage 1094 CALL iom_rstput( iter, nitrst, numriw, 'syage' , syage 1095 CALL iom_rstput( iter, nitrst, numriw, 'sxxage', sxxage 1096 CALL iom_rstput( iter, nitrst, numriw, 'syyage', syyage 1097 CALL iom_rstput( iter, nitrst, numriw, 'sxyage', sxyage 1103 CALL iom_rstput( iter, nitrst, numriw, 'sxage' , sxage) 1104 CALL iom_rstput( iter, nitrst, numriw, 'syage' , syage) 1105 CALL iom_rstput( iter, nitrst, numriw, 'sxxage', sxxage) 1106 CALL iom_rstput( iter, nitrst, numriw, 'syyage', syyage) 1107 CALL iom_rstput( iter, nitrst, numriw, 'sxyage', sxyage) 1098 1108 ! ! snow layers heat content 1099 1109 DO jk = 1, nlay_s 1100 1110 WRITE(zchar1,'(I2.2)') jk 1101 znam = 'sxc0'//'_l'//zchar1 ; z3d(:,:,:) = sxc0 (:,:,jk,:) ; CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 1102 znam = 'syc0'//'_l'//zchar1 ; z3d(:,:,:) = syc0 (:,:,jk,:) ; CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 1103 znam = 'sxxc0'//'_l'//zchar1 ; z3d(:,:,:) = sxxc0(:,:,jk,:) ; CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 1104 znam = 'syyc0'//'_l'//zchar1 ; z3d(:,:,:) = syyc0(:,:,jk,:) ; CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 1105 znam = 'sxyc0'//'_l'//zchar1 ; z3d(:,:,:) = sxyc0(:,:,jk,:) ; CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 1111 znam = 'sxc0'//'_l'//zchar1 ; z3d(:,:,:) = sxc0 (:,:,jk,:) 1112 CALL iom_rstput( iter, nitrst, numriw, znam , z3d) 1113 znam = 'syc0'//'_l'//zchar1 ; z3d(:,:,:) = syc0 (:,:,jk,:) 1114 CALL iom_rstput( iter, nitrst, numriw, znam , z3d) 1115 znam = 'sxxc0'//'_l'//zchar1 ; z3d(:,:,:) = sxxc0(:,:,jk,:) 1116 CALL iom_rstput( iter, nitrst, numriw, znam , z3d) 1117 znam = 'syyc0'//'_l'//zchar1 ; z3d(:,:,:) = syyc0(:,:,jk,:) 1118 CALL iom_rstput( iter, nitrst, numriw, znam , z3d) 1119 znam = 'sxyc0'//'_l'//zchar1 ; z3d(:,:,:) = sxyc0(:,:,jk,:) 1120 CALL iom_rstput( iter, nitrst, numriw, znam , z3d) 1106 1121 END DO 1107 1122 ! ! ice layers heat content 1108 1123 DO jk = 1, nlay_i 1109 1124 WRITE(zchar1,'(I2.2)') jk 1110 znam = 'sxe'//'_l'//zchar1 ; z3d(:,:,:) = sxe (:,:,jk,:) ; CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 1111 znam = 'sye'//'_l'//zchar1 ; z3d(:,:,:) = sye (:,:,jk,:) ; CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 1112 znam = 'sxxe'//'_l'//zchar1 ; z3d(:,:,:) = sxxe(:,:,jk,:) ; CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 1113 znam = 'syye'//'_l'//zchar1 ; z3d(:,:,:) = syye(:,:,jk,:) ; CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 1114 znam = 'sxye'//'_l'//zchar1 ; z3d(:,:,:) = sxye(:,:,jk,:) ; CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 1125 znam = 'sxe'//'_l'//zchar1 ; z3d(:,:,:) = sxe (:,:,jk,:) 1126 CALL iom_rstput( iter, nitrst, numriw, znam , z3d) 1127 znam = 'sye'//'_l'//zchar1 ; z3d(:,:,:) = sye (:,:,jk,:) 1128 CALL iom_rstput( iter, nitrst, numriw, znam , z3d) 1129 znam = 'sxxe'//'_l'//zchar1 ; z3d(:,:,:) = sxxe(:,:,jk,:) 1130 CALL iom_rstput( iter, nitrst, numriw, znam , z3d) 1131 znam = 'syye'//'_l'//zchar1 ; z3d(:,:,:) = syye(:,:,jk,:) 1132 CALL iom_rstput( iter, nitrst, numriw, znam , z3d) 1133 znam = 'sxye'//'_l'//zchar1 ; z3d(:,:,:) = sxye(:,:,jk,:) 1134 CALL iom_rstput( iter, nitrst, numriw, znam , z3d) 1115 1135 END DO 1116 1136 ! -
NEMO/branches/2020/dev_r13787_SI3-10_EAP/src/ICE/icedyn_rhg_evp.F90
r13612 r13991 199 199 zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 200 200 END_2D 201 CALL lbc_lnk( 'icedyn_rhg_evp', zfmask, 'F', 1._wp 201 CALL lbc_lnk( 'icedyn_rhg_evp', zfmask, 'F', 1._wp) 202 202 203 203 ! Lateral boundary conditions on velocity (modify zfmask) … … 1033 1033 iter = kt + nn_fsbc - 1 ! ice restarts are written at kt == nitrst - nn_fsbc + 1 1034 1034 ! 1035 CALL iom_rstput( iter, nitrst, numriw, 'stress1_i' , stress1_i 1036 CALL iom_rstput( iter, nitrst, numriw, 'stress2_i' , stress2_i 1035 CALL iom_rstput( iter, nitrst, numriw, 'stress1_i' , stress1_i ) 1036 CALL iom_rstput( iter, nitrst, numriw, 'stress2_i' , stress2_i ) 1037 1037 CALL iom_rstput( iter, nitrst, numriw, 'stress12_i', stress12_i ) 1038 1038 ! -
NEMO/branches/2020/dev_r13787_SI3-10_EAP/src/ICE/icerst.F90
r13472 r13991 55 55 CHARACTER(len=50) :: clname ! ice output restart file name 56 56 CHARACTER(len=256) :: clpath ! full path to ice output restart file 57 CHARACTER(LEN=52) :: clpname ! ocean output restart file name including prefix for AGRIF 57 58 !!---------------------------------------------------------------------- 58 59 ! … … 84 85 ENDIF 85 86 ! 86 CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' ) 87 IF(.NOT.lwxios) THEN 88 CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' ) 89 ELSE 90 #if defined key_iomput 91 cw_icerst_cxt = "rstwi_"//TRIM(ADJUSTL(clkt)) 92 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 93 clpname = clname 94 ELSE 95 clpname = TRIM(Agrif_CFixed())//"_"//clname 96 ENDIF 97 numriw = iom_xios_setid(TRIM(clpath)//TRIM(clpname)) 98 CALL iom_init( cw_icerst_cxt, kdid = numriw, ld_closedef = .FALSE. ) 99 CALL iom_swap( cxios_context ) 100 #else 101 clinfo = 'Can not use XIOS in rst_opn' 102 CALL ctl_stop(TRIM(clinfo)) 103 #endif 104 ENDIF 87 105 lrst_ice = .TRUE. 88 106 ENDIF … … 117 135 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~' 118 136 ENDIF 119 137 120 138 ! Write in numriw (if iter == nitrst) 121 139 ! ------------------ … … 123 141 CALL iom_rstput( iter, nitrst, numriw, 'nn_fsbc', REAL( nn_fsbc, wp ) ) ! time-step 124 142 CALL iom_rstput( iter, nitrst, numriw, 'kt_ice' , REAL( iter , wp ) ) ! date 125 CALL iom_delay_rst( 'WRITE', 'ICE', numriw ) ! save only ice delayed global communication variables 143 144 IF(.NOT.lwxios) CALL iom_delay_rst( 'WRITE', 'ICE', numriw ) ! save only ice delayed global communication variables 126 145 127 146 ! Prognostic variables … … 154 173 IF( ln_cpl ) THEN 155 174 CALL iom_rstput( iter, nitrst, numriw, 'cnd_ice', cnd_ice ) 156 CALL iom_rstput( iter, nitrst, numriw, 't1_ice' , t1_ice 175 CALL iom_rstput( iter, nitrst, numriw, 't1_ice' , t1_ice ) 157 176 ENDIF 158 177 ! … … 161 180 ! ------------------ 162 181 IF( iter == nitrst ) THEN 163 CALL iom_close( numriw ) 182 IF(.NOT.lwxios) THEN 183 CALL iom_close( numriw ) 184 ELSE 185 CALL iom_context_finalize( cw_icerst_cxt ) 186 iom_file(numriw)%nfid = 0 187 numriw = 0 188 ENDIF 164 189 lrst_ice = .FALSE. 165 190 ENDIF … … 181 206 CHARACTER(len=2) :: zchar, zchar1 182 207 REAL(wp) :: zfice, ziter 208 CHARACTER(lc) :: clpname 183 209 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z3d ! 3D workspace 184 210 !!---------------------------------------------------------------------- … … 190 216 ENDIF 191 217 218 lxios_sini = .FALSE. 192 219 CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir ) 220 221 IF( lrxios) THEN 222 cr_icerst_cxt = 'si3_rst' 223 IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS for SI3' 224 ! IF( TRIM(Agrif_CFixed()) == '0' ) THEN 225 ! clpname = cn_icerst_in 226 ! ELSE 227 ! clpname = TRIM(Agrif_CFixed())//"_"//cn_icerst_in 228 ! ENDIF 229 CALL iom_init( cr_icerst_cxt, kdid = numrir, ld_closedef = .TRUE. ) 230 ENDIF 193 231 194 232 ! test if v_i exists … … 198 236 IF( id0 > 0 ) THEN ! == case of a normal restart == ! 199 237 ! ! ------------------------------ ! 200 201 238 ! Time info 202 239 CALL iom_get( numrir, 'nn_fsbc', zfice ) … … 278 315 ENDIF 279 316 280 CALL iom_delay_rst( 'READ', 'ICE', numrir ) ! read only ice delayed global communication variables 281 317 IF(.NOT.lrxios) CALL iom_delay_rst( 'READ', 'ICE', numrir ) ! read only ice delayed global communication variables 282 318 ! ! ---------------------------------- ! 283 319 ELSE ! == case of a simplified restart == ! -
NEMO/branches/2020/dev_r13787_SI3-10_EAP/src/ICE/icestp.F90
r13721 r13991 291 291 tn_ice(:,:,:) = t_su(:,:,:) ! initialisation of surface temp for coupled simu 292 292 ! 293 IF( ln_rstart ) CALL iom_close( numrir ) ! close input ice restart file 293 IF( ln_rstart ) THEN 294 CALL iom_close( numrir ) ! close input ice restart file 295 IF(lrxios) CALL iom_context_finalize( cr_icerst_cxt ) 296 ENDIF 294 297 ! 295 298 END SUBROUTINE ice_init -
NEMO/branches/2020/dev_r13787_SI3-10_EAP/src/OCE/ASM/asminc.F90
r13295 r13991 26 26 USE par_oce ! Ocean space and time domain variables 27 27 USE dom_oce ! Ocean space and time domain 28 USE domain, ONLY : dom_tile 28 29 USE domvvl ! domain: variable volume level 29 30 USE ldfdyn ! lateral diffusion: eddy viscosity coefficients … … 518 519 ! 519 520 INTEGER :: ji, jj, jk 520 INTEGER :: it 521 INTEGER :: it, itile 521 522 REAL(wp) :: zincwgt ! IAU weight for current time step 522 REAL (wp), DIMENSION(jpi,jpj,jpk) :: fzptnz ! 3d freezing point values523 REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: fzptnz ! 3d freezing point values 523 524 !!---------------------------------------------------------------------- 524 525 ! 525 526 ! freezing point calculation taken from oc_fz_pt (but calculated for all depths) 526 527 ! used to prevent the applied increments taking the temperature below the local freezing point 527 DO jk = 1, jpkm1 528 CALL eos_fzp( pts(:,:,jk,jp_sal,Kmm), fzptnz(:,:,jk), gdept(:,:,jk,Kmm) ) 529 END DO 528 IF( ln_temnofreeze ) THEN 529 DO jk = 1, jpkm1 530 CALL eos_fzp( pts(:,:,jk,jp_sal,Kmm), fzptnz(:,:,jk), gdept(:,:,jk,Kmm) ) 531 END DO 532 ENDIF 530 533 ! 531 534 ! !-------------------------------------- … … 538 541 zincwgt = wgtiau(it) / rn_Dt ! IAU weight for the current time step 539 542 ! 540 IF(lwp) THEN 541 WRITE(numout,*) 542 WRITE(numout,*) 'tra_asm_inc : Tracer IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 543 WRITE(numout,*) '~~~~~~~~~~~~' 543 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 544 IF(lwp) THEN 545 WRITE(numout,*) 546 WRITE(numout,*) 'tra_asm_inc : Tracer IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 547 WRITE(numout,*) '~~~~~~~~~~~~' 548 ENDIF 544 549 ENDIF 545 550 ! … … 548 553 IF (ln_temnofreeze) THEN 549 554 ! Do not apply negative increments if the temperature will fall below freezing 550 WHERE(t_bkginc( :,:,jk) > 0.0_wp .OR. &551 & pts( :,:,jk,jp_tem,Kmm) + pts(:,:,jk,jp_tem,Krhs) + t_bkginc(:,:,jk) * wgtiau(it) > fzptnz(:,:,jk) )552 pts( :,:,jk,jp_tem,Krhs) = pts(:,:,jk,jp_tem,Krhs) + t_bkginc(:,:,jk) * zincwgt555 WHERE(t_bkginc(A2D(0),jk) > 0.0_wp .OR. & 556 & pts(A2D(0),jk,jp_tem,Kmm) + pts(A2D(0),jk,jp_tem,Krhs) + t_bkginc(A2D(0),jk) * wgtiau(it) > fzptnz(:,:,jk) ) 557 pts(A2D(0),jk,jp_tem,Krhs) = pts(A2D(0),jk,jp_tem,Krhs) + t_bkginc(A2D(0),jk) * zincwgt 553 558 END WHERE 554 559 ELSE 555 pts(:,:,jk,jp_tem,Krhs) = pts(:,:,jk,jp_tem,Krhs) + t_bkginc(:,:,jk) * zincwgt 560 DO_2D( 0, 0, 0, 0 ) 561 pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) + t_bkginc(ji,jj,jk) * zincwgt 562 END_2D 556 563 ENDIF 557 564 IF (ln_salfix) THEN 558 565 ! Do not apply negative increments if the salinity will fall below a specified 559 566 ! minimum value salfixmin 560 WHERE(s_bkginc( :,:,jk) > 0.0_wp .OR. &561 & pts( :,:,jk,jp_sal,Kmm) + pts(:,:,jk,jp_sal,Krhs) + s_bkginc(:,:,jk) * wgtiau(it) > salfixmin )562 pts( :,:,jk,jp_sal,Krhs) = pts(:,:,jk,jp_sal,Krhs) + s_bkginc(:,:,jk) * zincwgt567 WHERE(s_bkginc(A2D(0),jk) > 0.0_wp .OR. & 568 & pts(A2D(0),jk,jp_sal,Kmm) + pts(A2D(0),jk,jp_sal,Krhs) + s_bkginc(A2D(0),jk) * wgtiau(it) > salfixmin ) 569 pts(A2D(0),jk,jp_sal,Krhs) = pts(A2D(0),jk,jp_sal,Krhs) + s_bkginc(A2D(0),jk) * zincwgt 563 570 END WHERE 564 571 ELSE 565 pts(:,:,jk,jp_sal,Krhs) = pts(:,:,jk,jp_sal,Krhs) + s_bkginc(:,:,jk) * zincwgt 572 DO_2D( 0, 0, 0, 0 ) 573 pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) + s_bkginc(ji,jj,jk) * zincwgt 574 END_2D 566 575 ENDIF 567 576 END DO … … 569 578 ENDIF 570 579 ! 571 IF ( kt == nitiaufin_r + 1 ) THEN ! For bias crcn to work 572 DEALLOCATE( t_bkginc ) 573 DEALLOCATE( s_bkginc ) 580 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 581 IF ( kt == nitiaufin_r + 1 ) THEN ! For bias crcn to work 582 DEALLOCATE( t_bkginc ) 583 DEALLOCATE( s_bkginc ) 584 ENDIF 574 585 ENDIF 575 586 ! !-------------------------------------- … … 584 595 IF (ln_temnofreeze) THEN 585 596 ! Do not apply negative increments if the temperature will fall below freezing 586 WHERE( t_bkginc( :,:,:) > 0.0_wp .OR. pts(:,:,:,jp_tem,Kmm) + t_bkginc(:,:,:) > fzptnz(:,:,:) )587 pts( :,:,:,jp_tem,Kmm) = t_bkg(:,:,:) + t_bkginc(:,:,:)597 WHERE( t_bkginc(A2D(0),:) > 0.0_wp .OR. pts(A2D(0),:,jp_tem,Kmm) + t_bkginc(A2D(0),:) > fzptnz(:,:,:) ) 598 pts(A2D(0),:,jp_tem,Kmm) = t_bkg(A2D(0),:) + t_bkginc(A2D(0),:) 588 599 END WHERE 589 600 ELSE 590 pts(:,:,:,jp_tem,Kmm) = t_bkg(:,:,:) + t_bkginc(:,:,:) 601 DO_3D( 0, 0, 0, 0, 1, jpk ) 602 pts(ji,jj,jk,jp_tem,Kmm) = t_bkg(ji,jj,jk) + t_bkginc(ji,jj,jk) 603 END_3D 591 604 ENDIF 592 605 IF (ln_salfix) THEN 593 606 ! Do not apply negative increments if the salinity will fall below a specified 594 607 ! minimum value salfixmin 595 WHERE( s_bkginc( :,:,:) > 0.0_wp .OR. pts(:,:,:,jp_sal,Kmm) + s_bkginc(:,:,:) > salfixmin )596 pts( :,:,:,jp_sal,Kmm) = s_bkg(:,:,:) + s_bkginc(:,:,:)608 WHERE( s_bkginc(A2D(0),:) > 0.0_wp .OR. pts(A2D(0),:,jp_sal,Kmm) + s_bkginc(A2D(0),:) > salfixmin ) 609 pts(A2D(0),:,jp_sal,Kmm) = s_bkg(A2D(0),:) + s_bkginc(A2D(0),:) 597 610 END WHERE 598 611 ELSE 599 pts(:,:,:,jp_sal,Kmm) = s_bkg(:,:,:) + s_bkginc(:,:,:) 600 ENDIF 601 602 pts(:,:,:,:,Kbb) = pts(:,:,:,:,Kmm) ! Update before fields 612 DO_3D( 0, 0, 0, 0, 1, jpk ) 613 pts(ji,jj,jk,jp_sal,Kmm) = s_bkg(ji,jj,jk) + s_bkginc(ji,jj,jk) 614 END_3D 615 ENDIF 616 617 DO_3D( 0, 0, 0, 0, 1, jpk ) 618 pts(ji,jj,jk,:,Kbb) = pts(ji,jj,jk,:,Kmm) ! Update before fields 619 END_3D 603 620 604 621 CALL eos( pts(:,:,:,:,Kbb), rhd, rhop, gdept_0(:,:,:) ) ! Before potential and in situ densities … … 607 624 !!gm 608 625 609 IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav) & 610 & CALL zps_hde ( kt, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv, & ! Partial steps: before horizontal gradient 611 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 612 IF( ln_zps .AND. .NOT. lk_c1d .AND. ln_isfcav) & 613 & CALL zps_hde_isf( nit000, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv, gtui, gtvi, & ! Partial steps for top cell (ISF) 614 & rhd, gru , grv , grui, grvi ) ! of t, s, rd at the last ocean level 615 616 DEALLOCATE( t_bkginc ) 617 DEALLOCATE( s_bkginc ) 618 DEALLOCATE( t_bkg ) 619 DEALLOCATE( s_bkg ) 626 ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed from zps_hde*) 627 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 628 itile = ntile 629 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 630 631 IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav) & 632 & CALL zps_hde ( kt, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv, & ! Partial steps: before horizontal gradient 633 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 634 IF( ln_zps .AND. .NOT. lk_c1d .AND. ln_isfcav) & 635 & CALL zps_hde_isf( nit000, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv, gtui, gtvi, & ! Partial steps for top cell (ISF) 636 & rhd, gru , grv , grui, grvi ) ! of t, s, rd at the last ocean level 637 638 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile ) ! Revert to tile domain 639 ENDIF 640 641 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 642 DEALLOCATE( t_bkginc ) 643 DEALLOCATE( s_bkginc ) 644 DEALLOCATE( t_bkg ) 645 DEALLOCATE( s_bkg ) 646 ENDIF 647 ! 620 648 ENDIF 621 649 ! … … 829 857 INTEGER, INTENT(in), OPTIONAL :: kindic ! flag for disabling the deallocation 830 858 ! 859 INTEGER :: ji, jj 831 860 INTEGER :: it 832 861 REAL(wp) :: zincwgt ! IAU weight for current time step 833 862 #if defined key_si3 834 REAL(wp), DIMENSION( jpi,jpj) :: zofrld, zohicif, zseaicendg, zhicifinc863 REAL(wp), DIMENSION(A2D(nn_hls)) :: zofrld, zohicif, zseaicendg, zhicifinc 835 864 REAL(wp) :: zhicifmin = 0.5_wp ! ice minimum depth in metres 836 865 #endif … … 847 876 ! note this is not a tendency so should not be divided by rn_Dt (as with the tracer and other increments) 848 877 ! 849 IF(lwp) THEN 850 WRITE(numout,*) 851 WRITE(numout,*) 'seaice_asm_inc : sea ice conc IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 852 WRITE(numout,*) '~~~~~~~~~~~~' 878 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 879 IF(lwp) THEN 880 WRITE(numout,*) 881 WRITE(numout,*) 'seaice_asm_inc : sea ice conc IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 882 WRITE(numout,*) '~~~~~~~~~~~~' 883 ENDIF 853 884 ENDIF 854 885 ! … … 856 887 ! 857 888 #if defined key_si3 858 zofrld (:,:) = 1._wp - at_i(:,:) 859 zohicif(:,:) = hm_i(:,:) 860 ! 861 at_i (:,:) = 1. - MIN( MAX( 1.-at_i (:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp) 862 at_i_b(:,:) = 1. - MIN( MAX( 1.-at_i_b(:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp) 863 fr_i(:,:) = at_i(:,:) ! adjust ice fraction 864 ! 865 zseaicendg(:,:) = zofrld(:,:) - (1. - at_i(:,:)) ! find out actual sea ice nudge applied 889 DO_2D( 0, 0, 0, 0 ) 890 zofrld (ji,jj) = 1._wp - at_i(ji,jj) 891 zohicif(ji,jj) = hm_i(ji,jj) 892 ! 893 at_i (ji,jj) = 1. - MIN( MAX( 1.-at_i (ji,jj) - seaice_bkginc(ji,jj) * zincwgt, 0.0_wp), 1.0_wp) 894 at_i_b(ji,jj) = 1. - MIN( MAX( 1.-at_i_b(ji,jj) - seaice_bkginc(ji,jj) * zincwgt, 0.0_wp), 1.0_wp) 895 fr_i(ji,jj) = at_i(ji,jj) ! adjust ice fraction 896 ! 897 zseaicendg(ji,jj) = zofrld(ji,jj) - (1. - at_i(ji,jj)) ! find out actual sea ice nudge applied 898 END_2D 866 899 ! 867 900 ! Nudge sea ice depth to bring it up to a required minimum depth 868 WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i( :,:) < zhicifmin )869 zhicifinc(:,:) = (zhicifmin - hm_i( :,:)) * zincwgt901 WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i(A2D(0)) < zhicifmin ) 902 zhicifinc(:,:) = (zhicifmin - hm_i(A2D(0))) * zincwgt 870 903 ELSEWHERE 871 904 zhicifinc(:,:) = 0.0_wp … … 873 906 ! 874 907 ! nudge ice depth 875 hm_i (:,:) = hm_i (:,:) + zhicifinc(:,:) 908 DO_2D( 0, 0, 0, 0 ) 909 hm_i (ji,jj) = hm_i (ji,jj) + zhicifinc(ji,jj) 910 END_2D 876 911 ! 877 912 ! seaice salinity balancing (to add) … … 880 915 #if defined key_cice && defined key_asminc 881 916 ! Sea-ice : CICE case. Pass ice increment tendency into CICE 882 ndaice_da(:,:) = seaice_bkginc(:,:) * zincwgt / rn_Dt 883 #endif 884 ! 885 IF ( kt == nitiaufin_r ) THEN 886 DEALLOCATE( seaice_bkginc ) 917 DO_2D( 0, 0, 0, 0 ) 918 ndaice_da(ji,jj) = seaice_bkginc(ji,jj) * zincwgt / rn_Dt 919 END_2D 920 #endif 921 ! 922 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 923 IF ( kt == nitiaufin_r ) THEN 924 DEALLOCATE( seaice_bkginc ) 925 ENDIF 887 926 ENDIF 888 927 ! … … 890 929 ! 891 930 #if defined key_cice && defined key_asminc 892 ndaice_da(:,:) = 0._wp ! Sea-ice : CICE case. Zero ice increment tendency into CICE 931 DO_2D( 0, 0, 0, 0 ) 932 ndaice_da(ji,jj) = 0._wp ! Sea-ice : CICE case. Zero ice increment tendency into CICE 933 END_2D 893 934 #endif 894 935 ! … … 905 946 ! 906 947 #if defined key_si3 907 zofrld (:,:) = 1._wp - at_i(:,:) 908 zohicif(:,:) = hm_i(:,:) 909 ! 910 ! Initialize the now fields the background + increment 911 at_i(:,:) = 1. - MIN( MAX( 1.-at_i(:,:) - seaice_bkginc(:,:), 0.0_wp), 1.0_wp) 912 at_i_b(:,:) = at_i(:,:) 913 fr_i(:,:) = at_i(:,:) ! adjust ice fraction 914 ! 915 zseaicendg(:,:) = zofrld(:,:) - (1. - at_i(:,:)) ! find out actual sea ice nudge applied 948 DO_2D( 0, 0, 0, 0 ) 949 zofrld (ji,jj) = 1._wp - at_i(ji,jj) 950 zohicif(ji,jj) = hm_i(ji,jj) 951 ! 952 ! Initialize the now fields the background + increment 953 at_i(ji,jj) = 1. - MIN( MAX( 1.-at_i(ji,jj) - seaice_bkginc(ji,jj), 0.0_wp), 1.0_wp) 954 at_i_b(ji,jj) = at_i(ji,jj) 955 fr_i(ji,jj) = at_i(ji,jj) ! adjust ice fraction 956 ! 957 zseaicendg(ji,jj) = zofrld(ji,jj) - (1. - at_i(ji,jj)) ! find out actual sea ice nudge applied 958 END_2D 916 959 ! 917 960 ! Nudge sea ice depth to bring it up to a required minimum depth 918 WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i( :,:) < zhicifmin )919 zhicifinc(:,:) = zhicifmin - hm_i( :,:)961 WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i(A2D(0)) < zhicifmin ) 962 zhicifinc(:,:) = zhicifmin - hm_i(A2D(0)) 920 963 ELSEWHERE 921 964 zhicifinc(:,:) = 0.0_wp … … 923 966 ! 924 967 ! nudge ice depth 925 hm_i (:,:) = hm_i (:,:) + zhicifinc(:,:) 968 DO_2D( 0, 0, 0, 0 ) 969 hm_i(ji,jj) = hm_i (ji,jj) + zhicifinc(ji,jj) 970 END_2D 926 971 ! 927 972 ! seaice salinity balancing (to add) … … 930 975 #if defined key_cice && defined key_asminc 931 976 ! Sea-ice : CICE case. Pass ice increment tendency into CICE 932 ndaice_da(:,:) = seaice_bkginc(:,:) / rn_Dt 933 #endif 934 IF ( .NOT. PRESENT(kindic) ) THEN 935 DEALLOCATE( seaice_bkginc ) 936 END IF 977 DO_2D( 0, 0, 0, 0 ) 978 ndaice_da(ji,jj) = seaice_bkginc(ji,jj) / rn_Dt 979 END_2D 980 #endif 981 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 982 IF ( .NOT. PRESENT(kindic) ) THEN 983 DEALLOCATE( seaice_bkginc ) 984 END IF 985 ENDIF 937 986 ! 938 987 ELSE 939 988 ! 940 989 #if defined key_cice && defined key_asminc 941 ndaice_da(:,:) = 0._wp ! Sea-ice : CICE case. Zero ice increment tendency into CICE 990 DO_2D( 0, 0, 0, 0 ) 991 ndaice_da(ji,jj) = 0._wp ! Sea-ice : CICE case. Zero ice increment tendency into CICE 992 END_2D 942 993 #endif 943 994 ! -
NEMO/branches/2020/dev_r13787_SI3-10_EAP/src/OCE/BDY/bdytra.F90
r13527 r13991 13 13 !!---------------------------------------------------------------------- 14 14 USE oce ! ocean dynamics and tracers variables 15 USE dom_oce ! ocean space and time domain variables 15 USE dom_oce ! ocean space and time domain variables 16 16 USE bdy_oce ! ocean open boundary conditions 17 17 USE bdylib ! for orlanski library routines … … 157 157 INTEGER :: ib_bdy ! Loop index 158 158 !!---------------------------------------------------------------------- 159 IF( ntile /= 0 .AND. ntile /= 1 ) RETURN ! Do only for the full domain 159 160 ! 160 161 IF( ln_timing ) CALL timing_start('bdy_tra_dmp') -
NEMO/branches/2020/dev_r13787_SI3-10_EAP/src/OCE/C1D/step_c1d.F90
r13237 r13991 122 122 CALL dyn_atf ( kstp, Nbb, Nnn, Naa , uu, vv, e3t, e3u, e3v ) ! time filtering of "now" fields 123 123 IF(.NOT.ln_linssh)CALL ssh_atf ( kstp, Nbb, Nnn, Naa , ssh ) ! time filtering of "now" sea surface height 124 IF( kstp == nit000 .AND. ln_linssh) THEN 125 ssh(:,:,Naa) = ssh(:,:,Nnn) ! init ssh after in ln_linssh case 126 ENDIF 124 127 ! 125 128 ! Swap time levels -
NEMO/branches/2020/dev_r13787_SI3-10_EAP/src/OCE/DIA/diaar5.F90
r13497 r13991 34 34 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,: ) :: thick0 ! ocean thickness (interior domain) 35 35 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sn0 ! initial salinity 36 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: hstr_adv, hstr_ldf 36 37 37 38 LOGICAL :: l_ar5 … … 54 55 !!---------------------------------------------------------------------- 55 56 ! 56 ALLOCATE( thick0(jpi,jpj) , sn0(jpi,jpj,jpk) , STAT=dia_ar5_alloc ) 57 ALLOCATE( thick0(jpi,jpj) , sn0(jpi,jpj,jpk) , & 58 & hstr_adv(jpi,jpj,jpts,2), hstr_ldf(jpi,jpj,jpts,2), STAT=dia_ar5_alloc ) 57 59 ! 58 60 CALL mpp_sum ( 'diaar5', dia_ar5_alloc ) … … 304 306 END SUBROUTINE dia_ar5 305 307 306 307 SUBROUTINE dia_ar5_hst( ktra, cptr, puflx, pvflx ) 308 ! TEMP: [tiling] These changes not necessary if using XIOS (subdomain support, will not output haloes) 309 SUBROUTINE dia_ar5_hst( ktra, cptr, puflx, pvflx ) 308 310 !!---------------------------------------------------------------------- 309 311 !! *** ROUTINE dia_ar5_htr *** … … 314 316 INTEGER , INTENT(in ) :: ktra ! tracer index 315 317 CHARACTER(len=3) , INTENT(in) :: cptr ! transport type 'adv'/'ldf' 316 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(in) :: puflx ! u-flux of advection/diffusion317 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(in) :: pvflx ! v-flux of advection/diffusion318 REAL(wp), DIMENSION(A2D(nn_hls),jpk) , INTENT(in) :: puflx ! u-flux of advection/diffusion 319 REAL(wp), DIMENSION(A2D(nn_hls),jpk) , INTENT(in) :: pvflx ! v-flux of advection/diffusion 318 320 ! 319 321 INTEGER :: ji, jj, jk 320 REAL(wp), DIMENSION(jpi,jpj) :: z2d 321 322 323 IF( cptr /= 'adv' .AND. cptr /= 'ldf' ) RETURN 324 IF( ktra /= jp_tem .AND. ktra /= jp_sal ) RETURN 325 326 IF( cptr == 'adv' ) THEN 327 DO_2D( 0, 0, 0, 0 ) 328 hstr_adv(ji,jj,ktra,1) = puflx(ji,jj,1) 329 hstr_adv(ji,jj,ktra,2) = pvflx(ji,jj,1) 330 END_2D 331 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 332 hstr_adv(ji,jj,ktra,1) = hstr_adv(ji,jj,ktra,1) + puflx(ji,jj,jk) 333 hstr_adv(ji,jj,ktra,2) = hstr_adv(ji,jj,ktra,2) + pvflx(ji,jj,jk) 334 END_3D 335 ELSE IF( cptr == 'ldf' ) THEN 336 DO_2D( 0, 0, 0, 0 ) 337 hstr_ldf(ji,jj,ktra,1) = puflx(ji,jj,1) 338 hstr_ldf(ji,jj,ktra,2) = pvflx(ji,jj,1) 339 END_2D 340 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 341 hstr_ldf(ji,jj,ktra,1) = hstr_ldf(ji,jj,ktra,1) + puflx(ji,jj,jk) 342 hstr_ldf(ji,jj,ktra,2) = hstr_ldf(ji,jj,ktra,2) + pvflx(ji,jj,jk) 343 END_3D 344 ENDIF 345 346 IF( ntile == 0 .OR. ntile == nijtile ) THEN 347 IF( cptr == 'adv' ) THEN 348 IF( ktra == jp_tem ) CALL iom_put( 'uadv_heattr' , rho0_rcp * hstr_adv(:,:,ktra,1) ) ! advective heat transport in i-direction 349 IF( ktra == jp_sal ) CALL iom_put( 'uadv_salttr' , rho0 * hstr_adv(:,:,ktra,1) ) ! advective salt transport in i-direction 350 IF( ktra == jp_tem ) CALL iom_put( 'vadv_heattr' , rho0_rcp * hstr_adv(:,:,ktra,2) ) ! advective heat transport in j-direction 351 IF( ktra == jp_sal ) CALL iom_put( 'vadv_salttr' , rho0 * hstr_adv(:,:,ktra,2) ) ! advective salt transport in j-direction 352 ENDIF 353 IF( cptr == 'ldf' ) THEN 354 IF( ktra == jp_tem ) CALL iom_put( 'udiff_heattr' , rho0_rcp * hstr_ldf(:,:,ktra,1) ) ! diffusive heat transport in i-direction 355 IF( ktra == jp_sal ) CALL iom_put( 'udiff_salttr' , rho0 * hstr_ldf(:,:,ktra,1) ) ! diffusive salt transport in i-direction 356 IF( ktra == jp_tem ) CALL iom_put( 'vdiff_heattr' , rho0_rcp * hstr_ldf(:,:,ktra,2) ) ! diffusive heat transport in j-direction 357 IF( ktra == jp_sal ) CALL iom_put( 'vdiff_salttr' , rho0 * hstr_ldf(:,:,ktra,2) ) ! diffusive salt transport in j-direction 358 ENDIF 359 ENDIF 322 360 323 z2d(:,:) = puflx(:,:,1)324 DO_3D( 0, 0, 0, 0, 1, jpkm1 )325 z2d(ji,jj) = z2d(ji,jj) + puflx(ji,jj,jk)326 END_3D327 CALL lbc_lnk( 'diaar5', z2d, 'U', -1.0_wp )328 IF( cptr == 'adv' ) THEN329 IF( ktra == jp_tem ) CALL iom_put( 'uadv_heattr' , rho0_rcp * z2d ) ! advective heat transport in i-direction330 IF( ktra == jp_sal ) CALL iom_put( 'uadv_salttr' , rho0 * z2d ) ! advective salt transport in i-direction331 ENDIF332 IF( cptr == 'ldf' ) THEN333 IF( ktra == jp_tem ) CALL iom_put( 'udiff_heattr' , rho0_rcp * z2d ) ! diffusive heat transport in i-direction334 IF( ktra == jp_sal ) CALL iom_put( 'udiff_salttr' , rho0 * z2d ) ! diffusive salt transport in i-direction335 ENDIF336 !337 z2d(:,:) = pvflx(:,:,1)338 DO_3D( 0, 0, 0, 0, 1, jpkm1 )339 z2d(ji,jj) = z2d(ji,jj) + pvflx(ji,jj,jk)340 END_3D341 CALL lbc_lnk( 'diaar5', z2d, 'V', -1.0_wp )342 IF( cptr == 'adv' ) THEN343 IF( ktra == jp_tem ) CALL iom_put( 'vadv_heattr' , rho0_rcp * z2d ) ! advective heat transport in j-direction344 IF( ktra == jp_sal ) CALL iom_put( 'vadv_salttr' , rho0 * z2d ) ! advective salt transport in j-direction345 ENDIF346 IF( cptr == 'ldf' ) THEN347 IF( ktra == jp_tem ) CALL iom_put( 'vdiff_heattr' , rho0_rcp * z2d ) ! diffusive heat transport in j-direction348 IF( ktra == jp_sal ) CALL iom_put( 'vdiff_salttr' , rho0 * z2d ) ! diffusive salt transport in j-direction349 ENDIF350 351 361 END SUBROUTINE dia_ar5_hst 352 362 … … 371 381 & iom_use( 'masstot' ) .OR. iom_use( 'temptot' ) .OR. iom_use( 'saltot' ) .OR. & 372 382 & iom_use( 'botpres' ) .OR. iom_use( 'sshthster' ) .OR. iom_use( 'sshsteric' ) .OR. & 383 & iom_use( 'uadv_heattr' ) .OR. iom_use( 'udiff_heattr' ) .OR. & 384 & iom_use( 'uadv_salttr' ) .OR. iom_use( 'udiff_salttr' ) .OR. & 385 & iom_use( 'vadv_heattr' ) .OR. iom_use( 'vdiff_heattr' ) .OR. & 386 & iom_use( 'vadv_salttr' ) .OR. iom_use( 'vdiff_salttr' ) .OR. & 373 387 & iom_use( 'rhop' ) ) L_ar5 = .TRUE. 374 388 -
NEMO/branches/2020/dev_r13787_SI3-10_EAP/src/OCE/DIA/diahsb.F90
r13286 r13991 267 267 IF(lwp) WRITE(numout,*) ' dia_hsb_rst : read hsb restart at it= ', kt,' date= ', ndastp 268 268 IF(lwp) WRITE(numout,*) 269 CALL iom_get( numror, 'frc_v', frc_v , ldxios = lrxios)270 CALL iom_get( numror, 'frc_t', frc_t , ldxios = lrxios)271 CALL iom_get( numror, 'frc_s', frc_s , ldxios = lrxios)269 CALL iom_get( numror, 'frc_v', frc_v ) 270 CALL iom_get( numror, 'frc_t', frc_t ) 271 CALL iom_get( numror, 'frc_s', frc_s ) 272 272 IF( ln_linssh ) THEN 273 CALL iom_get( numror, 'frc_wn_t', frc_wn_t , ldxios = lrxios)274 CALL iom_get( numror, 'frc_wn_s', frc_wn_s , ldxios = lrxios)273 CALL iom_get( numror, 'frc_wn_t', frc_wn_t ) 274 CALL iom_get( numror, 'frc_wn_s', frc_wn_s ) 275 275 ENDIF 276 CALL iom_get( numror, jpdom_auto, 'surf_ini' , surf_ini , ldxios = lrxios) ! ice sheet coupling277 CALL iom_get( numror, jpdom_auto, 'ssh_ini' , ssh_ini , ldxios = lrxios)278 CALL iom_get( numror, jpdom_auto, 'e3t_ini' , e3t_ini , ldxios = lrxios)279 CALL iom_get( numror, jpdom_auto, 'tmask_ini' , tmask_ini , ldxios = lrxios)280 CALL iom_get( numror, jpdom_auto, 'hc_loc_ini', hc_loc_ini , ldxios = lrxios)281 CALL iom_get( numror, jpdom_auto, 'sc_loc_ini', sc_loc_ini , ldxios = lrxios)276 CALL iom_get( numror, jpdom_auto, 'surf_ini' , surf_ini ) ! ice sheet coupling 277 CALL iom_get( numror, jpdom_auto, 'ssh_ini' , ssh_ini ) 278 CALL iom_get( numror, jpdom_auto, 'e3t_ini' , e3t_ini ) 279 CALL iom_get( numror, jpdom_auto, 'tmask_ini' , tmask_ini ) 280 CALL iom_get( numror, jpdom_auto, 'hc_loc_ini', hc_loc_ini ) 281 CALL iom_get( numror, jpdom_auto, 'sc_loc_ini', sc_loc_ini ) 282 282 IF( ln_linssh ) THEN 283 CALL iom_get( numror, jpdom_auto, 'ssh_hc_loc_ini', ssh_hc_loc_ini , ldxios = lrxios)284 CALL iom_get( numror, jpdom_auto, 'ssh_sc_loc_ini', ssh_sc_loc_ini , ldxios = lrxios)283 CALL iom_get( numror, jpdom_auto, 'ssh_hc_loc_ini', ssh_hc_loc_ini ) 284 CALL iom_get( numror, jpdom_auto, 'ssh_sc_loc_ini', ssh_sc_loc_ini ) 285 285 ENDIF 286 286 ELSE … … 323 323 IF(lwp) WRITE(numout,*) 324 324 ! 325 IF( lwxios ) CALL iom_swap( cwxios_context ) 326 CALL iom_rstput( kt, nitrst, numrow, 'frc_v', frc_v, ldxios = lwxios ) 327 CALL iom_rstput( kt, nitrst, numrow, 'frc_t', frc_t, ldxios = lwxios ) 328 CALL iom_rstput( kt, nitrst, numrow, 'frc_s', frc_s, ldxios = lwxios ) 325 CALL iom_rstput( kt, nitrst, numrow, 'frc_v', frc_v ) 326 CALL iom_rstput( kt, nitrst, numrow, 'frc_t', frc_t ) 327 CALL iom_rstput( kt, nitrst, numrow, 'frc_s', frc_s ) 329 328 IF( ln_linssh ) THEN 330 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_t', frc_wn_t , ldxios = lwxios)331 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s , ldxios = lwxios)329 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_t', frc_wn_t ) 330 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s ) 332 331 ENDIF 333 CALL iom_rstput( kt, nitrst, numrow, 'surf_ini' , surf_ini , ldxios = lwxios) ! ice sheet coupling334 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini' , ssh_ini , ldxios = lwxios)335 CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini' , e3t_ini , ldxios = lwxios)336 CALL iom_rstput( kt, nitrst, numrow, 'tmask_ini' , tmask_ini , ldxios = lwxios)337 CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini , ldxios = lwxios)338 CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini , ldxios = lwxios)332 CALL iom_rstput( kt, nitrst, numrow, 'surf_ini' , surf_ini ) ! ice sheet coupling 333 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini' , ssh_ini ) 334 CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini' , e3t_ini ) 335 CALL iom_rstput( kt, nitrst, numrow, 'tmask_ini' , tmask_ini ) 336 CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini ) 337 CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini ) 339 338 IF( ln_linssh ) THEN 340 CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini , ldxios = lwxios)341 CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini , ldxios = lwxios)339 CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini ) 340 CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini ) 342 341 ENDIF 343 IF( lwxios ) CALL iom_swap( cxios_context )344 342 ! 345 343 ENDIF … … 385 383 IF( .NOT. ln_diahsb ) RETURN 386 384 387 IF(lwxios) THEN388 ! define variables in restart file when writing with XIOS389 CALL iom_set_rstw_var_active('frc_v')390 CALL iom_set_rstw_var_active('frc_t')391 CALL iom_set_rstw_var_active('frc_s')392 CALL iom_set_rstw_var_active('surf_ini')393 CALL iom_set_rstw_var_active('ssh_ini')394 CALL iom_set_rstw_var_active('e3t_ini')395 CALL iom_set_rstw_var_active('hc_loc_ini')396 CALL iom_set_rstw_var_active('sc_loc_ini')397 IF( ln_linssh ) THEN398 CALL iom_set_rstw_var_active('ssh_hc_loc_ini')399 CALL iom_set_rstw_var_active('ssh_sc_loc_ini')400 CALL iom_set_rstw_var_active('frc_wn_t')401 CALL iom_set_rstw_var_active('frc_wn_s')402 ENDIF403 ENDIF404 385 ! ------------------- ! 405 386 ! 1 - Allocate memory ! -
NEMO/branches/2020/dev_r13787_SI3-10_EAP/src/OCE/DIA/diaptr.F90
r13557 r13991 22 22 USE oce ! ocean dynamics and active tracers 23 23 USE dom_oce ! ocean space and time domain 24 USE domain, ONLY : dom_tile 24 25 USE phycst ! physical constants 25 26 ! … … 32 33 PRIVATE 33 34 35 INTERFACE ptr_sum 36 MODULE PROCEDURE ptr_sum_3d, ptr_sum_2d 37 END INTERFACE 38 34 39 INTERFACE ptr_sj 35 40 MODULE PROCEDURE ptr_sj_3d, ptr_sj_2d … … 39 44 PUBLIC dia_ptr_hst ! called from tra_ldf/tra_adv routines 40 45 41 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hstr_adv, hstr_ldf, hstr_eiv !: Heat/Salt TRansports(adv, diff, Bolus.) 42 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hstr_ove, hstr_btr, hstr_vtr !: heat Salt TRansports(overturn, baro, merional) 43 44 LOGICAL, PUBLIC :: l_diaptr !: tracers trend flag 46 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hstr_adv, hstr_ldf, hstr_eiv !: Heat/Salt TRansports(adv, diff, Bolus.) 47 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hstr_ove, hstr_btr, hstr_vtr !: heat Salt TRansports(overturn, baro, merional) 48 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: pvtr_int, pzon_int !: Other zonal integrals 49 50 LOGICAL, PUBLIC :: l_diaptr !: tracers trend flag 51 INTEGER, PARAMETER :: jp_msk = 3 52 INTEGER, PARAMETER :: jp_vtr = 4 45 53 46 54 REAL(wp) :: rc_sv = 1.e-6_wp ! conversion from m3/s to Sverdrup … … 51 59 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: btmsk34 ! mask out Southern Ocean (=0 south of 34°S) 52 60 53 REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:) :: p_fval1d54 REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:,:) :: p_fval2d55 56 61 LOGICAL :: ll_init = .TRUE. !: tracers trend flag 57 62 58 63 !! * Substitutions 59 64 # include "do_loop_substitute.h90" … … 72 77 INTEGER , INTENT(in) :: kt ! ocean time-step index 73 78 INTEGER , INTENT(in) :: Kmm ! time level index 74 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: pvtr ! j-effective transport 79 REAL(wp), DIMENSION(A2D(nn_hls),jpk) , INTENT(in), OPTIONAL :: pvtr ! j-effective transport 80 !!---------------------------------------------------------------------- 81 ! 82 IF( ln_timing ) CALL timing_start('dia_ptr') 83 84 IF( kt == nit000 .AND. ll_init ) CALL dia_ptr_init ! -> will define l_diaptr and nbasin 85 ! 86 IF( l_diaptr ) THEN 87 ! Calculate zonal integrals 88 IF( PRESENT( pvtr ) ) THEN 89 CALL dia_ptr_zint( Kmm, pvtr ) 90 ELSE 91 CALL dia_ptr_zint( Kmm ) 92 ENDIF 93 94 ! Calculate diagnostics only when zonal integrals have finished 95 IF( ntile == 0 .OR. ntile == nijtile ) CALL dia_ptr_iom(kt, Kmm, pvtr) 96 ENDIF 97 98 IF( ln_timing ) CALL timing_stop('dia_ptr') 99 ! 100 END SUBROUTINE dia_ptr 101 102 103 SUBROUTINE dia_ptr_iom( kt, Kmm, pvtr ) 104 !!---------------------------------------------------------------------- 105 !! *** ROUTINE dia_ptr_iom *** 106 !!---------------------------------------------------------------------- 107 !! ** Purpose : Calculate diagnostics and send to XIOS 108 !!---------------------------------------------------------------------- 109 INTEGER , INTENT(in) :: kt ! ocean time-step index 110 INTEGER , INTENT(in) :: Kmm ! time level index 111 REAL(wp), DIMENSION(A2D(nn_hls),jpk) , INTENT(in), OPTIONAL :: pvtr ! j-effective transport 75 112 ! 76 113 INTEGER :: ji, jj, jk, jn ! dummy loop indices 77 REAL(wp) :: zsfc,zvfc ! local scalar78 114 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace 79 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask ! 3D workspace80 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d ! 3D workspace81 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zts ! 3D workspace82 115 REAL(wp), DIMENSION(jpj) :: zvsum, ztsum, zssum ! 1D workspace 83 116 ! … … 90 123 !!---------------------------------------------------------------------- 91 124 ! 92 IF( ln_timing ) CALL timing_start('dia_ptr')93 94 IF( kt == nit000 .AND. ll_init ) CALL dia_ptr_init ! -> will define l_diaptr and nbasin95 !96 IF( .NOT. l_diaptr ) THEN97 IF( ln_timing ) CALL timing_stop('dia_ptr')98 RETURN99 ENDIF100 !101 125 ALLOCATE( z3dtr(jpi,jpj,nbasin) ) 102 ! 126 103 127 IF( PRESENT( pvtr ) ) THEN 104 128 IF( iom_use( 'zomsf' ) ) THEN ! effective MSF 105 129 ALLOCATE( z4d1(jpi,jpj,jpk,nbasin) ) 130 ! 106 131 DO jn = 1, nbasin ! by sub-basins 107 z4d1(1,:,:,jn) = p tr_sjk( pvtr(:,:,:), btmsk34(:,:,jn) )! zonal cumulative effective transport excluding closed seas108 DO jk = jpkm1, 1, -1 132 z4d1(1,:,:,jn) = pvtr_int(:,:,jp_vtr,jn) ! zonal cumulative effective transport excluding closed seas 133 DO jk = jpkm1, 1, -1 109 134 z4d1(1,:,jk,jn) = z4d1(1,:,jk+1,jn) - z4d1(1,:,jk,jn) ! effective j-Stream-Function (MSF) 110 135 END DO 111 DO ji = 1, jpi136 DO ji = 2, jpi 112 137 z4d1(ji,:,:,jn) = z4d1(1,:,:,jn) 113 138 ENDDO 114 139 END DO 115 140 CALL iom_put( 'zomsf', z4d1 * rc_sv ) 141 ! 116 142 DEALLOCATE( z4d1 ) 117 143 ENDIF 144 IF( iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) ) THEN 145 ALLOCATE( sjk(jpj,jpk,nbasin), r1_sjk(jpj,jpk,nbasin), v_msf(jpj,jpk,nbasin), & 146 & zt_jk(jpj,jpk,nbasin), zs_jk(jpj,jpk,nbasin) ) 147 ! 148 DO jn = 1, nbasin 149 sjk(:,:,jn) = pvtr_int(:,:,jp_msk,jn) 150 r1_sjk(:,:,jn) = 0._wp 151 WHERE( sjk(:,:,jn) /= 0._wp ) r1_sjk(:,:,jn) = 1._wp / sjk(:,:,jn) 152 ! i-mean T and S, j-Stream-Function, basin 153 zt_jk(:,:,jn) = pvtr_int(:,:,jp_tem,jn) * r1_sjk(:,:,jn) 154 zs_jk(:,:,jn) = pvtr_int(:,:,jp_sal,jn) * r1_sjk(:,:,jn) 155 v_msf(:,:,jn) = pvtr_int(:,:,jp_vtr,jn) 156 hstr_ove(:,jp_tem,jn) = SUM( v_msf(:,:,jn)*zt_jk(:,:,jn), 2 ) 157 hstr_ove(:,jp_sal,jn) = SUM( v_msf(:,:,jn)*zs_jk(:,:,jn), 2 ) 158 ! 159 ENDDO 160 DO jn = 1, nbasin 161 z3dtr(1,:,jn) = hstr_ove(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 162 DO ji = 2, jpi 163 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 164 ENDDO 165 ENDDO 166 CALL iom_put( 'sophtove', z3dtr ) 167 DO jn = 1, nbasin 168 z3dtr(1,:,jn) = hstr_ove(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 169 DO ji = 2, jpi 170 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 171 ENDDO 172 ENDDO 173 CALL iom_put( 'sopstove', z3dtr ) 174 ! 175 DEALLOCATE( sjk, r1_sjk, v_msf, zt_jk, zs_jk ) 176 ENDIF 177 178 IF( iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) ) THEN 179 ! Calculate barotropic heat and salt transport here 180 ALLOCATE( sjk(jpj,1,nbasin), r1_sjk(jpj,1,nbasin) ) 181 ! 182 DO jn = 1, nbasin 183 sjk(:,1,jn) = SUM( pvtr_int(:,:,jp_msk,jn), 2 ) 184 r1_sjk(:,1,jn) = 0._wp 185 WHERE( sjk(:,1,jn) /= 0._wp ) r1_sjk(:,1,jn) = 1._wp / sjk(:,1,jn) 186 ! 187 zvsum(:) = SUM( pvtr_int(:,:,jp_vtr,jn), 2 ) 188 ztsum(:) = SUM( pvtr_int(:,:,jp_tem,jn), 2 ) 189 zssum(:) = SUM( pvtr_int(:,:,jp_sal,jn), 2 ) 190 hstr_btr(:,jp_tem,jn) = zvsum(:) * ztsum(:) * r1_sjk(:,1,jn) 191 hstr_btr(:,jp_sal,jn) = zvsum(:) * zssum(:) * r1_sjk(:,1,jn) 192 ! 193 ENDDO 194 DO jn = 1, nbasin 195 z3dtr(1,:,jn) = hstr_btr(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 196 DO ji = 2, jpi 197 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 198 ENDDO 199 ENDDO 200 CALL iom_put( 'sophtbtr', z3dtr ) 201 DO jn = 1, nbasin 202 z3dtr(1,:,jn) = hstr_btr(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 203 DO ji = 2, jpi 204 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 205 ENDDO 206 ENDDO 207 CALL iom_put( 'sopstbtr', z3dtr ) 208 ! 209 DEALLOCATE( sjk, r1_sjk ) 210 ENDIF 211 ! 212 hstr_ove(:,:,:) = 0._wp ! Zero before next timestep 213 hstr_btr(:,:,:) = 0._wp 214 pvtr_int(:,:,:,:) = 0._wp 215 ELSE 216 IF( iom_use( 'zotem' ) .OR. iom_use( 'zosal' ) .OR. iom_use( 'zosrf' ) ) THEN ! i-mean i-k-surface 217 ALLOCATE( z4d1(jpi,jpj,jpk,nbasin), z4d2(jpi,jpj,jpk,nbasin) ) 218 ! 219 DO jn = 1, nbasin 220 z4d1(1,:,:,jn) = pzon_int(:,:,jp_msk,jn) 221 DO ji = 2, jpi 222 z4d1(ji,:,:,jn) = z4d1(1,:,:,jn) 223 ENDDO 224 ENDDO 225 CALL iom_put( 'zosrf', z4d1 ) 226 ! 227 DO jn = 1, nbasin 228 z4d2(1,:,:,jn) = pzon_int(:,:,jp_tem,jn) / MAX( z4d1(1,:,:,jn), 10.e-15 ) 229 DO ji = 2, jpi 230 z4d2(ji,:,:,jn) = z4d2(1,:,:,jn) 231 ENDDO 232 ENDDO 233 CALL iom_put( 'zotem', z4d2 ) 234 ! 235 DO jn = 1, nbasin 236 z4d2(1,:,:,jn) = pzon_int(:,:,jp_sal,jn) / MAX( z4d1(1,:,:,jn), 10.e-15 ) 237 DO ji = 2, jpi 238 z4d2(ji,:,:,jn) = z4d2(1,:,:,jn) 239 ENDDO 240 ENDDO 241 CALL iom_put( 'zosal', z4d2 ) 242 ! 243 DEALLOCATE( z4d1, z4d2 ) 244 ENDIF 245 ! 246 ! ! Advective and diffusive heat and salt transport 247 IF( iom_use( 'sophtadv' ) .OR. iom_use( 'sopstadv' ) ) THEN 248 ! 249 DO jn = 1, nbasin 250 z3dtr(1,:,jn) = hstr_adv(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 251 DO ji = 2, jpi 252 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 253 ENDDO 254 ENDDO 255 CALL iom_put( 'sophtadv', z3dtr ) 256 DO jn = 1, nbasin 257 z3dtr(1,:,jn) = hstr_adv(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 258 DO ji = 2, jpi 259 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 260 ENDDO 261 ENDDO 262 CALL iom_put( 'sopstadv', z3dtr ) 263 ENDIF 264 ! 265 IF( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) THEN 266 ! 267 DO jn = 1, nbasin 268 z3dtr(1,:,jn) = hstr_ldf(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 269 DO ji = 2, jpi 270 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 271 ENDDO 272 ENDDO 273 CALL iom_put( 'sophtldf', z3dtr ) 274 DO jn = 1, nbasin 275 z3dtr(1,:,jn) = hstr_ldf(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 276 DO ji = 2, jpi 277 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 278 ENDDO 279 ENDDO 280 CALL iom_put( 'sopstldf', z3dtr ) 281 ENDIF 282 ! 283 IF( iom_use( 'sophteiv' ) .OR. iom_use( 'sopsteiv' ) ) THEN 284 ! 285 DO jn = 1, nbasin 286 z3dtr(1,:,jn) = hstr_eiv(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 287 DO ji = 2, jpi 288 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 289 ENDDO 290 ENDDO 291 CALL iom_put( 'sophteiv', z3dtr ) 292 DO jn = 1, nbasin 293 z3dtr(1,:,jn) = hstr_eiv(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 294 DO ji = 2, jpi 295 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 296 ENDDO 297 ENDDO 298 CALL iom_put( 'sopsteiv', z3dtr ) 299 ENDIF 300 ! 301 IF( iom_use( 'sopstvtr' ) .OR. iom_use( 'sophtvtr' ) ) THEN 302 DO jn = 1, nbasin 303 z3dtr(1,:,jn) = hstr_vtr(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 304 DO ji = 2, jpi 305 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 306 ENDDO 307 ENDDO 308 CALL iom_put( 'sophtvtr', z3dtr ) 309 DO jn = 1, nbasin 310 z3dtr(1,:,jn) = hstr_vtr(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 311 DO ji = 2, jpi 312 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 313 ENDDO 314 ENDDO 315 CALL iom_put( 'sopstvtr', z3dtr ) 316 ENDIF 317 ! 318 IF( iom_use( 'uocetr_vsum_cumul' ) ) THEN 319 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 320 CALL iom_get_var( 'uocetr_vsum_op', z2d ) ! get uocetr_vsum_op from xml 321 z2d(:,:) = ptr_ci_2d( z2d(:,:) ) 322 CALL iom_put( 'uocetr_vsum_cumul', z2d ) 323 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = nijtile ) ! Revert to tile domain 324 ENDIF 325 ! 326 hstr_adv(:,:,:) = 0._wp ! Zero before next timestep 327 hstr_ldf(:,:,:) = 0._wp 328 hstr_eiv(:,:,:) = 0._wp 329 hstr_vtr(:,:,:) = 0._wp 330 pzon_int(:,:,:,:) = 0._wp 331 ENDIF 332 ! 333 DEALLOCATE( z3dtr ) 334 ! 335 END SUBROUTINE dia_ptr_iom 336 337 338 SUBROUTINE dia_ptr_zint( Kmm, pvtr ) 339 !!---------------------------------------------------------------------- 340 !! *** ROUTINE dia_ptr_zint *** 341 !!---------------------------------------------------------------------- 342 !! ** Purpose : i and i-k sum operations on arrays 343 !! 344 !! ** Method : - Call ptr_sjk (i sum) or ptr_sj (i-k sum) to perform the sum operation 345 !! - Call ptr_sum to add this result to the sum over tiles 346 !! 347 !! ** Action : pvtr_int - terms for volume streamfunction, heat/salt transport barotropic/overturning terms 348 !! pzon_int - terms for i mean temperature/salinity 349 !!---------------------------------------------------------------------- 350 INTEGER , INTENT(in) :: Kmm ! time level index 351 REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(in), OPTIONAL :: pvtr ! j-effective transport 352 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zmask ! 3D workspace 353 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zts ! 4D workspace 354 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: sjk, v_msf ! Zonal sum: i-k surface area, j-effective transport 355 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt_jk, zs_jk ! Zonal sum: i-k surface area * (T, S) 356 REAL(wp) :: zsfc, zvfc ! i-k surface area 357 INTEGER :: ji, jj, jk, jn ! dummy loop indices 358 !!---------------------------------------------------------------------- 359 360 IF( PRESENT( pvtr ) ) THEN 361 ! i sum of effective j transport excluding closed seas 362 IF( iom_use( 'zomsf' ) .OR. iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) ) THEN 363 ALLOCATE( v_msf(A1Dj(nn_hls),jpk,nbasin) ) 364 365 DO jn = 1, nbasin 366 v_msf(:,:,jn) = ptr_sjk( pvtr(:,:,:), btmsk34(:,:,jn) ) 367 ENDDO 368 369 CALL ptr_sum( pvtr_int(:,:,jp_vtr,:), v_msf(:,:,:) ) 370 371 DEALLOCATE( v_msf ) 372 ENDIF 373 374 ! i sum of j surface area, j surface area - temperature/salinity product on V grid 118 375 IF( iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) .OR. & 119 376 & iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) ) THEN 120 ! define fields multiplied by scalar 377 ALLOCATE( zmask(A2D(nn_hls),jpk), zts(A2D(nn_hls),jpk,jpts), & 378 & sjk(A1Dj(nn_hls),jpk,nbasin), & 379 & zt_jk(A1Dj(nn_hls),jpk,nbasin), zs_jk(A1Dj(nn_hls),jpk,nbasin) ) 380 121 381 zmask(:,:,:) = 0._wp 122 382 zts(:,:,:,:) = 0._wp 383 123 384 DO_3D( 1, 0, 1, 1, 1, jpkm1 ) 124 385 zvfc = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) 125 386 zmask(ji,jj,jk) = vmask(ji,jj,jk) * zvfc 126 zts(ji,jj,jk,jp_tem) = (ts(ji,jj,jk,jp_tem,Kmm)+ts(ji,jj+1,jk,jp_tem,Kmm)) * 0.5 * zvfc 387 zts(ji,jj,jk,jp_tem) = (ts(ji,jj,jk,jp_tem,Kmm)+ts(ji,jj+1,jk,jp_tem,Kmm)) * 0.5 * zvfc !Tracers averaged onto V grid 127 388 zts(ji,jj,jk,jp_sal) = (ts(ji,jj,jk,jp_sal,Kmm)+ts(ji,jj+1,jk,jp_sal,Kmm)) * 0.5 * zvfc 128 389 END_3D 129 ENDIF 130 IF( iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) ) THEN 131 DO jn = 1, nbasin 132 ALLOCATE( sjk(jpj,jpk,nbasin), r1_sjk(jpj,jpk,nbasin), v_msf(jpj,jpk,nbasin), & 133 & zt_jk(jpj,jpk,nbasin), zs_jk(jpj,jpk,nbasin) ) 134 sjk(:,:,jn) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 135 r1_sjk(:,:,jn) = 0._wp 136 WHERE( sjk(:,:,jn) /= 0._wp ) r1_sjk(:,:,jn) = 1._wp / sjk(:,:,jn) 137 ! i-mean T and S, j-Stream-Function, basin 138 zt_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 139 zs_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 140 v_msf(:,:,jn) = ptr_sjk( pvtr(:,:,:), btmsk34(:,:,jn) ) 141 hstr_ove(:,jp_tem,jn) = SUM( v_msf(:,:,jn)*zt_jk(:,:,jn), 2 ) 142 hstr_ove(:,jp_sal,jn) = SUM( v_msf(:,:,jn)*zs_jk(:,:,jn), 2 ) 143 DEALLOCATE( sjk, r1_sjk, v_msf, zt_jk, zs_jk ) 144 ! 145 ENDDO 146 DO jn = 1, nbasin 147 z3dtr(1,:,jn) = hstr_ove(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 148 DO ji = 1, jpi 149 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 150 ENDDO 151 ENDDO 152 CALL iom_put( 'sophtove', z3dtr ) 153 DO jn = 1, nbasin 154 z3dtr(1,:,jn) = hstr_ove(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 155 DO ji = 1, jpi 156 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 157 ENDDO 158 ENDDO 159 CALL iom_put( 'sopstove', z3dtr ) 160 ENDIF 161 162 IF( iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) ) THEN 163 ! Calculate barotropic heat and salt transport here 164 DO jn = 1, nbasin 165 ALLOCATE( sjk(jpj,1,nbasin), r1_sjk(jpj,1,nbasin) ) 166 sjk(:,1,jn) = ptr_sj( zmask(:,:,:), btmsk(:,:,jn) ) 167 r1_sjk(:,1,jn) = 0._wp 168 WHERE( sjk(:,1,jn) /= 0._wp ) r1_sjk(:,1,jn) = 1._wp / sjk(:,1,jn) 169 ! 170 zvsum(:) = ptr_sj( pvtr(:,:,:), btmsk34(:,:,jn) ) 171 ztsum(:) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) 172 zssum(:) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) 173 hstr_btr(:,jp_tem,jn) = zvsum(:) * ztsum(:) * r1_sjk(:,1,jn) 174 hstr_btr(:,jp_sal,jn) = zvsum(:) * zssum(:) * r1_sjk(:,1,jn) 175 DEALLOCATE( sjk, r1_sjk ) 176 ! 177 ENDDO 178 DO jn = 1, nbasin 179 z3dtr(1,:,jn) = hstr_btr(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 180 DO ji = 1, jpi 181 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 182 ENDDO 183 ENDDO 184 CALL iom_put( 'sophtbtr', z3dtr ) 185 DO jn = 1, nbasin 186 z3dtr(1,:,jn) = hstr_btr(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 187 DO ji = 1, jpi 188 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 189 ENDDO 190 ENDDO 191 CALL iom_put( 'sopstbtr', z3dtr ) 192 ENDIF 193 ! 390 391 DO jn = 1, nbasin 392 sjk(:,:,jn) = ptr_sjk( zmask(:,:,:) , btmsk(:,:,jn) ) 393 zt_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) 394 zs_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) 395 ENDDO 396 397 CALL ptr_sum( pvtr_int(:,:,jp_msk,:), sjk(:,:,:) ) 398 CALL ptr_sum( pvtr_int(:,:,jp_tem,:), zt_jk(:,:,:) ) 399 CALL ptr_sum( pvtr_int(:,:,jp_sal,:), zs_jk(:,:,:) ) 400 401 DEALLOCATE( zmask, zts, sjk, zt_jk, zs_jk ) 402 ENDIF 194 403 ELSE 195 ! 196 zmask(:,:,:) = 0._wp 197 zts(:,:,:,:) = 0._wp 198 IF( iom_use( 'zotem' ) .OR. iom_use( 'zosal' ) .OR. iom_use( 'zosrf' ) ) THEN ! i-mean i-k-surface 199 ALLOCATE( z4d1(jpi,jpj,jpk,nbasin), z4d2(jpi,jpj,jpk,nbasin) ) 404 ! i sum of j surface area - temperature/salinity product on T grid 405 IF( iom_use( 'zotem' ) .OR. iom_use( 'zosal' ) .OR. iom_use( 'zosrf' ) ) THEN 406 ALLOCATE( zmask(A2D(nn_hls),jpk), zts(A2D(nn_hls),jpk,jpts), & 407 & sjk(A1Dj(nn_hls),jpk,nbasin), & 408 & zt_jk(A1Dj(nn_hls),jpk,nbasin), zs_jk(A1Dj(nn_hls),jpk,nbasin) ) 409 410 zmask(:,:,:) = 0._wp 411 zts(:,:,:,:) = 0._wp 412 200 413 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 201 414 zsfc = e1t(ji,jj) * e3t(ji,jj,jk,Kmm) … … 204 417 zts(ji,jj,jk,jp_sal) = ts(ji,jj,jk,jp_sal,Kmm) * zsfc 205 418 END_3D 206 ! 207 DO jn = 1, nbasin 208 zmask(1,:,:) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 209 DO ji = 1, jpi 210 zmask(ji,:,:) = zmask(1,:,:) 211 ENDDO 212 z4d1(:,:,:,jn) = zmask(:,:,:) 213 ENDDO 214 CALL iom_put( 'zosrf', z4d1 ) 215 ! 216 DO jn = 1, nbasin 217 z4d2(1,:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) & 218 & / MAX( z4d1(1,:,:,jn), 10.e-15 ) 219 DO ji = 1, jpi 220 z4d2(ji,:,:,jn) = z4d2(1,:,:,jn) 221 ENDDO 222 ENDDO 223 CALL iom_put( 'zotem', z4d2 ) 224 ! 225 DO jn = 1, nbasin 226 z4d2(1,:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) & 227 & / MAX( z4d1(1,:,:,jn), 10.e-15 ) 228 DO ji = 1, jpi 229 z4d2(ji,:,:,jn) = z4d2(1,:,:,jn) 230 ENDDO 231 ENDDO 232 CALL iom_put( 'zosal', z4d2 ) 233 DEALLOCATE( z4d1, z4d2 ) 234 ! 235 ENDIF 236 ! 237 ! ! Advective and diffusive heat and salt transport 238 IF( iom_use( 'sophtadv' ) .OR. iom_use( 'sopstadv' ) ) THEN 239 ! 240 DO jn = 1, nbasin 241 z3dtr(1,:,jn) = hstr_adv(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 242 DO ji = 1, jpi 243 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 244 ENDDO 245 ENDDO 246 CALL iom_put( 'sophtadv', z3dtr ) 247 DO jn = 1, nbasin 248 z3dtr(1,:,jn) = hstr_adv(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 249 DO ji = 1, jpi 250 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 251 ENDDO 252 ENDDO 253 CALL iom_put( 'sopstadv', z3dtr ) 254 ENDIF 255 ! 256 IF( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) THEN 257 ! 258 DO jn = 1, nbasin 259 z3dtr(1,:,jn) = hstr_ldf(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 260 DO ji = 1, jpi 261 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 262 ENDDO 263 ENDDO 264 CALL iom_put( 'sophtldf', z3dtr ) 265 DO jn = 1, nbasin 266 z3dtr(1,:,jn) = hstr_ldf(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 267 DO ji = 1, jpi 268 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 269 ENDDO 270 ENDDO 271 CALL iom_put( 'sopstldf', z3dtr ) 272 ENDIF 273 ! 274 IF( iom_use( 'sophteiv' ) .OR. iom_use( 'sopsteiv' ) ) THEN 275 ! 276 DO jn = 1, nbasin 277 z3dtr(1,:,jn) = hstr_eiv(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 278 DO ji = 1, jpi 279 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 280 ENDDO 281 ENDDO 282 CALL iom_put( 'sophteiv', z3dtr ) 283 DO jn = 1, nbasin 284 z3dtr(1,:,jn) = hstr_eiv(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 285 DO ji = 1, jpi 286 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 287 ENDDO 288 ENDDO 289 CALL iom_put( 'sopsteiv', z3dtr ) 290 ENDIF 291 ! 419 420 DO jn = 1, nbasin 421 sjk(:,:,jn) = ptr_sjk( zmask(:,:,:) , btmsk(:,:,jn) ) 422 zt_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) 423 zs_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) 424 ENDDO 425 426 CALL ptr_sum( pzon_int(:,:,jp_msk,:), sjk(:,:,:) ) 427 CALL ptr_sum( pzon_int(:,:,jp_tem,:), zt_jk(:,:,:) ) 428 CALL ptr_sum( pzon_int(:,:,jp_sal,:), zs_jk(:,:,:) ) 429 430 DEALLOCATE( zmask, zts, sjk, zt_jk, zs_jk ) 431 ENDIF 432 433 ! i-k sum of j surface area - temperature/salinity product on V grid 292 434 IF( iom_use( 'sopstvtr' ) .OR. iom_use( 'sophtvtr' ) ) THEN 435 ALLOCATE( zts(A2D(nn_hls),jpk,jpts) ) 436 293 437 zts(:,:,:,:) = 0._wp 438 294 439 DO_3D( 1, 0, 1, 1, 1, jpkm1 ) 295 440 zvfc = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) … … 297 442 zts(ji,jj,jk,jp_sal) = (ts(ji,jj,jk,jp_sal,Kmm)+ts(ji,jj+1,jk,jp_sal,Kmm)) * 0.5 * zvfc 298 443 END_3D 299 CALL dia_ptr_hst( jp_tem, 'vtr', zts(:,:,:,jp_tem) ) 300 CALL dia_ptr_hst( jp_sal, 'vtr', zts(:,:,:,jp_sal) ) 301 DO jn = 1, nbasin 302 z3dtr(1,:,jn) = hstr_vtr(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 303 DO ji = 1, jpi 304 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 305 ENDDO 306 ENDDO 307 CALL iom_put( 'sophtvtr', z3dtr ) 308 DO jn = 1, nbasin 309 z3dtr(1,:,jn) = hstr_vtr(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 310 DO ji = 1, jpi 311 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 312 ENDDO 313 ENDDO 314 CALL iom_put( 'sopstvtr', z3dtr ) 315 ENDIF 316 ! 317 IF( iom_use( 'uocetr_vsum_cumul' ) ) THEN 318 CALL iom_get_var( 'uocetr_vsum_op', z2d ) ! get uocetr_vsum_op from xml 319 z2d(:,:) = ptr_ci_2d( z2d(:,:) ) 320 CALL iom_put( 'uocetr_vsum_cumul', z2d ) 321 ENDIF 322 ! 444 445 CALL dia_ptr_hst( jp_tem, 'vtr', zts(:,:,:,jp_tem) ) 446 CALL dia_ptr_hst( jp_sal, 'vtr', zts(:,:,:,jp_sal) ) 447 448 DEALLOCATE( zts ) 449 ENDIF 323 450 ENDIF 324 ! 325 DEALLOCATE( z3dtr ) 326 ! 327 IF( ln_timing ) CALL timing_stop('dia_ptr') 328 ! 329 END SUBROUTINE dia_ptr 451 END SUBROUTINE dia_ptr_zint 330 452 331 453 … … 340 462 REAL(wp), DIMENSION(jpi,jpj) :: zmsk 341 463 !!---------------------------------------------------------------------- 342 464 343 465 ! l_diaptr is defined with iom_use 344 466 ! --> dia_ptr_init must be done after the call to iom_init … … 347 469 & iom_use( 'zosrf' ) .OR. iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) .OR. & 348 470 & iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) .OR. iom_use( 'sophtadv' ) .OR. & 349 & iom_use( 'sopstadv' ) .OR. iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) .OR. & 471 & iom_use( 'sopstadv' ) .OR. iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) .OR. & 350 472 & iom_use( 'sophteiv' ) .OR. iom_use( 'sopsteiv' ) .OR. iom_use( 'sopstvtr' ) .OR. & 351 & iom_use( 'sophtvtr' ) .OR. iom_use( 'uocetr_vsum_cumul' ) 352 473 & iom_use( 'sophtvtr' ) .OR. iom_use( 'uocetr_vsum_cumul' ) 474 353 475 IF(lwp) THEN ! Control print 354 476 WRITE(numout,*) … … 398 520 hstr_btr(:,:,:) = 0._wp ! 399 521 hstr_vtr(:,:,:) = 0._wp ! 522 pvtr_int(:,:,:,:) = 0._wp 523 pzon_int(:,:,:,:) = 0._wp 400 524 ! 401 525 ll_init = .FALSE. … … 415 539 INTEGER , INTENT(in ) :: ktra ! tracer index 416 540 CHARACTER(len=3) , INTENT(in) :: cptr ! transport type 'adv'/'ldf'/'eiv' 417 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: pvflx ! 3D input array of advection/diffusion 541 REAL(wp), DIMENSION(A2D(nn_hls),jpk) , INTENT(in) :: pvflx ! 3D input array of advection/diffusion 542 REAL(wp), DIMENSION(A1Dj(nn_hls),nbasin) :: zsj ! 418 543 INTEGER :: jn ! 419 544 545 DO jn = 1, nbasin 546 zsj(:,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 547 ENDDO 420 548 ! 421 549 IF( cptr == 'adv' ) THEN 422 IF( ktra == jp_tem ) THEN 423 DO jn = 1, nbasin 424 hstr_adv(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 425 ENDDO 426 ENDIF 427 IF( ktra == jp_sal ) THEN 428 DO jn = 1, nbasin 429 hstr_adv(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 430 ENDDO 431 ENDIF 550 IF( ktra == jp_tem ) CALL ptr_sum( hstr_adv(:,jp_tem,:), zsj(:,:) ) 551 IF( ktra == jp_sal ) CALL ptr_sum( hstr_adv(:,jp_sal,:), zsj(:,:) ) 552 ELSE IF( cptr == 'ldf' ) THEN 553 IF( ktra == jp_tem ) CALL ptr_sum( hstr_ldf(:,jp_tem,:), zsj(:,:) ) 554 IF( ktra == jp_sal ) CALL ptr_sum( hstr_ldf(:,jp_sal,:), zsj(:,:) ) 555 ELSE IF( cptr == 'eiv' ) THEN 556 IF( ktra == jp_tem ) CALL ptr_sum( hstr_eiv(:,jp_tem,:), zsj(:,:) ) 557 IF( ktra == jp_sal ) CALL ptr_sum( hstr_eiv(:,jp_sal,:), zsj(:,:) ) 558 ELSE IF( cptr == 'vtr' ) THEN 559 IF( ktra == jp_tem ) CALL ptr_sum( hstr_vtr(:,jp_tem,:), zsj(:,:) ) 560 IF( ktra == jp_sal ) CALL ptr_sum( hstr_vtr(:,jp_sal,:), zsj(:,:) ) 432 561 ENDIF 433 562 ! 434 IF( cptr == 'ldf' ) THEN 435 IF( ktra == jp_tem ) THEN 436 DO jn = 1, nbasin 437 hstr_ldf(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 438 ENDDO 439 ENDIF 440 IF( ktra == jp_sal ) THEN 441 DO jn = 1, nbasin 442 hstr_ldf(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 443 ENDDO 444 ENDIF 563 END SUBROUTINE dia_ptr_hst 564 565 566 SUBROUTINE ptr_sum_2d( phstr, pva ) 567 !!---------------------------------------------------------------------- 568 !! *** ROUTINE ptr_sum_2d *** 569 !!---------------------------------------------------------------------- 570 !! ** Purpose : Add two 2D arrays with (j,nbasin) dimensions 571 !! 572 !! ** Method : - phstr = phstr + pva 573 !! - Call mpp_sum if the final tile 574 !! 575 !! ** Action : phstr 576 !!---------------------------------------------------------------------- 577 REAL(wp), DIMENSION(jpj,nbasin) , INTENT(inout) :: phstr ! 578 REAL(wp), DIMENSION(A1Dj(nn_hls),nbasin), INTENT(in) :: pva ! 579 INTEGER :: jj 580 #if defined key_mpp_mpi 581 INTEGER, DIMENSION(1) :: ish1d 582 INTEGER, DIMENSION(2) :: ish2d 583 REAL(wp), DIMENSION(jpj*nbasin) :: zwork 584 #endif 585 586 DO jj = ntsj, ntej 587 phstr(jj,:) = phstr(jj,:) + pva(jj,:) 588 END DO 589 590 #if defined key_mpp_mpi 591 IF( ntile == 0 .OR. ntile == nijtile ) THEN 592 ish1d(1) = jpj*nbasin 593 ish2d(1) = jpj ; ish2d(2) = nbasin 594 zwork(:) = RESHAPE( phstr(:,:), ish1d ) 595 CALL mpp_sum( 'diaptr', zwork, ish1d(1), ncomm_znl ) 596 phstr(:,:) = RESHAPE( zwork, ish2d ) 445 597 ENDIF 446 ! 447 IF( cptr == 'eiv' ) THEN 448 IF( ktra == jp_tem ) THEN 449 DO jn = 1, nbasin 450 hstr_eiv(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 451 ENDDO 452 ENDIF 453 IF( ktra == jp_sal ) THEN 454 DO jn = 1, nbasin 455 hstr_eiv(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 456 ENDDO 457 ENDIF 598 #endif 599 END SUBROUTINE ptr_sum_2d 600 601 602 SUBROUTINE ptr_sum_3d( phstr, pva ) 603 !!---------------------------------------------------------------------- 604 !! *** ROUTINE ptr_sum_3d *** 605 !!---------------------------------------------------------------------- 606 !! ** Purpose : Add two 3D arrays with (j,k,nbasin) dimensions 607 !! 608 !! ** Method : - phstr = phstr + pva 609 !! - Call mpp_sum if the final tile 610 !! 611 !! ** Action : phstr 612 !!---------------------------------------------------------------------- 613 REAL(wp), DIMENSION(jpj,jpk,nbasin) , INTENT(inout) :: phstr ! 614 REAL(wp), DIMENSION(A1Dj(nn_hls),jpk,nbasin), INTENT(in) :: pva ! 615 INTEGER :: jj, jk 616 #if defined key_mpp_mpi 617 INTEGER, DIMENSION(1) :: ish1d 618 INTEGER, DIMENSION(3) :: ish3d 619 REAL(wp), DIMENSION(jpj*jpk*nbasin) :: zwork 620 #endif 621 622 DO jk = 1, jpk 623 DO jj = ntsj, ntej 624 phstr(jj,jk,:) = phstr(jj,jk,:) + pva(jj,jk,:) 625 END DO 626 END DO 627 628 #if defined key_mpp_mpi 629 IF( ntile == 0 .OR. ntile == nijtile ) THEN 630 ish1d(1) = jpj*jpk*nbasin 631 ish3d(1) = jpj ; ish3d(2) = jpk ; ish3d(3) = nbasin 632 zwork(:) = RESHAPE( phstr(:,:,:), ish1d ) 633 CALL mpp_sum( 'diaptr', zwork, ish1d(1), ncomm_znl ) 634 phstr(:,:,:) = RESHAPE( zwork, ish3d ) 458 635 ENDIF 459 ! 460 IF( cptr == 'vtr' ) THEN 461 IF( ktra == jp_tem ) THEN 462 DO jn = 1, nbasin 463 hstr_vtr(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 464 ENDDO 465 ENDIF 466 IF( ktra == jp_sal ) THEN 467 DO jn = 1, nbasin 468 hstr_vtr(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 469 ENDDO 470 ENDIF 471 ENDIF 472 ! 473 END SUBROUTINE dia_ptr_hst 636 #endif 637 END SUBROUTINE ptr_sum_3d 474 638 475 639 … … 479 643 !!---------------------------------------------------------------------- 480 644 INTEGER :: dia_ptr_alloc ! return value 481 INTEGER, DIMENSION( 3) :: ierr645 INTEGER, DIMENSION(2) :: ierr 482 646 !!---------------------------------------------------------------------- 483 647 ierr(:) = 0 … … 491 655 & hstr_ldf(jpj,jpts,nbasin), hstr_vtr(jpj,jpts,nbasin), STAT=ierr(1) ) 492 656 ! 493 ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(2)) 657 ALLOCATE( pvtr_int(jpj,jpk,jpts+2,nbasin), & 658 & pzon_int(jpj,jpk,jpts+1,nbasin), STAT=ierr(2) ) 494 659 ! 495 660 dia_ptr_alloc = MAXVAL( ierr ) … … 511 676 !! ** Action : - p_fval: i-k-mean poleward flux of pvflx 512 677 !!---------------------------------------------------------------------- 513 REAL(wp), INTENT(in), DIMENSION( jpi,jpj,jpk) :: pvflx ! mask flux array at V-point514 REAL(wp), INTENT(in), DIMENSION(jpi,jpj) 678 REAL(wp), INTENT(in), DIMENSION(A2D(nn_hls),jpk) :: pvflx ! mask flux array at V-point 679 REAL(wp), INTENT(in), DIMENSION(jpi,jpj) :: pmsk ! Optional 2D basin mask 515 680 ! 516 681 INTEGER :: ji, jj, jk ! dummy loop arguments 517 INTEGER :: ijpj ! ??? 518 REAL(wp), POINTER, DIMENSION(:) :: p_fval ! function value 682 REAL(wp), DIMENSION(A1Dj(nn_hls)) :: p_fval ! function value 519 683 !!-------------------------------------------------------------------- 520 684 ! 521 p_fval => p_fval1d522 523 ijpj = jpj524 685 p_fval(:) = 0._wp 525 686 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 526 687 p_fval(jj) = p_fval(jj) + pvflx(ji,jj,jk) * pmsk(ji,jj) * tmask_i(ji,jj) 527 688 END_3D 528 #if defined key_mpp_mpi529 CALL mpp_sum( 'diaptr', p_fval, ijpj, ncomm_znl)530 #endif531 !532 689 END FUNCTION ptr_sj_3d 533 690 … … 544 701 !! ** Action : - p_fval: i-k-mean poleward flux of pvflx 545 702 !!---------------------------------------------------------------------- 546 REAL(wp) , INTENT(in), DIMENSION( jpi,jpj):: pvflx ! mask flux array at V-point703 REAL(wp) , INTENT(in), DIMENSION(A2D(nn_hls)) :: pvflx ! mask flux array at V-point 547 704 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pmsk ! Optional 2D basin mask 548 705 ! 549 706 INTEGER :: ji,jj ! dummy loop arguments 550 INTEGER :: ijpj ! ??? 551 REAL(wp), POINTER, DIMENSION(:) :: p_fval ! function value 707 REAL(wp), DIMENSION(A1Dj(nn_hls)) :: p_fval ! function value 552 708 !!-------------------------------------------------------------------- 553 ! 554 p_fval => p_fval1d 555 556 ijpj = jpj 709 ! 557 710 p_fval(:) = 0._wp 558 711 DO_2D( 0, 0, 0, 0 ) 559 712 p_fval(jj) = p_fval(jj) + pvflx(ji,jj) * pmsk(ji,jj) * tmask_i(ji,jj) 560 713 END_2D 561 #if defined key_mpp_mpi562 CALL mpp_sum( 'diaptr', p_fval, ijpj, ncomm_znl )563 #endif564 !565 714 END FUNCTION ptr_sj_2d 566 715 … … 588 737 p_fval(ji,jj) = p_fval(ji,jj-1) + pva(ji,jj) * tmask_i(ji,jj) 589 738 END_2D 590 CALL lbc_lnk( 'diaptr', p_fval, 'U', -1.0_wp )591 739 END DO 592 740 ! … … 607 755 !! 608 756 IMPLICIT none 609 REAL(wp) , INTENT(in), DIMENSION( jpi,jpj,jpk) :: pta ! mask flux array at V-point610 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) 757 REAL(wp) , INTENT(in), DIMENSION(A2D(nn_hls),jpk) :: pta ! mask flux array at V-point 758 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pmsk ! Optional 2D basin mask 611 759 !! 612 760 INTEGER :: ji, jj, jk ! dummy loop arguments 613 REAL(wp), POINTER, DIMENSION(:,:) :: p_fval ! return function value 614 #if defined key_mpp_mpi 615 INTEGER, DIMENSION(1) :: ish 616 INTEGER, DIMENSION(2) :: ish2 617 INTEGER :: ijpjjpk 618 REAL(wp), DIMENSION(jpj*jpk) :: zwork ! mask flux array at V-point 619 #endif 761 REAL(wp), DIMENSION(A1Dj(nn_hls),jpk) :: p_fval ! return function value 620 762 !!-------------------------------------------------------------------- 621 763 ! 622 p_fval => p_fval2d623 624 764 p_fval(:,:) = 0._wp 625 765 ! … … 627 767 p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * pmsk(ji,jj) * tmask_i(ji,jj) 628 768 END_3D 629 !630 #if defined key_mpp_mpi631 ijpjjpk = jpj*jpk632 ish(1) = ijpjjpk ; ish2(1) = jpj ; ish2(2) = jpk633 zwork(1:ijpjjpk) = RESHAPE( p_fval, ish )634 CALL mpp_sum( 'diaptr', zwork, ijpjjpk, ncomm_znl )635 p_fval(:,:) = RESHAPE( zwork, ish2 )636 #endif637 !638 769 END FUNCTION ptr_sjk 639 770 -
NEMO/branches/2020/dev_r13787_SI3-10_EAP/src/OCE/DOM/daymod.F90
r13558 r13991 149 149 CALL day( nit000 ) 150 150 ! 151 IF( lwxios ) THEN152 ! define variables in restart file when writing with XIOS153 CALL iom_set_rstw_var_active('kt')154 CALL iom_set_rstw_var_active('ndastp')155 CALL iom_set_rstw_var_active('adatrj')156 CALL iom_set_rstw_var_active('ntime')157 ENDIF158 159 151 END SUBROUTINE day_init 160 152 … … 324 316 325 317 IF( TRIM(cdrw) == 'READ' ) THEN 326 327 318 IF( iom_varid( numror, 'kt', ldstop = .FALSE. ) > 0 ) THEN 328 319 ! Get Calendar informations 329 CALL iom_get( numror, 'kt', zkt , ldxios = lrxios) ! last time-step of previous run320 CALL iom_get( numror, 'kt', zkt ) ! last time-step of previous run 330 321 IF(lwp) THEN 331 322 WRITE(numout,*) ' *** Info read in restart : ' … … 346 337 IF ( nrstdt == 2 ) THEN 347 338 ! read the parameters corresponding to nit000 - 1 (last time step of previous run) 348 CALL iom_get( numror, 'ndastp', zndastp , ldxios = lrxios)339 CALL iom_get( numror, 'ndastp', zndastp ) 349 340 ndastp = NINT( zndastp ) 350 CALL iom_get( numror, 'adatrj', adatrj , ldxios = lrxios)351 CALL iom_get( numror, 'ntime' , ktime , ldxios = lrxios)341 CALL iom_get( numror, 'adatrj', adatrj ) 342 CALL iom_get( numror, 'ntime' , ktime ) 352 343 nn_time0 = NINT(ktime) 353 344 ! calculate start time in hours and minutes … … 410 401 ENDIF 411 402 ! calendar control 412 IF( lwxios ) CALL iom_swap( cwxios_context ) 413 CALL iom_rstput( kt, nitrst, numrow, 'kt' , REAL( kt , wp) , ldxios = lwxios ) ! time-step 414 CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, wp) , ldxios = lwxios ) ! date 415 CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj , ldxios = lwxios ) ! number of elapsed days since 403 CALL iom_rstput( kt, nitrst, numrow, 'kt' , REAL( kt , wp) ) ! time-step 404 CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, wp) ) ! date 405 CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj ) ! number of elapsed days since 416 406 ! ! the begining of the run [s] 417 CALL iom_rstput( kt, nitrst, numrow, 'ntime' , REAL( nn_time0, wp), ldxios = lwxios ) ! time 418 IF( lwxios ) CALL iom_swap( cxios_context ) 407 CALL iom_rstput( kt, nitrst, numrow, 'ntime' , REAL( nn_time0, wp) ) ! time 419 408 ENDIF 420 409 ! -
NEMO/branches/2020/dev_r13787_SI3-10_EAP/src/OCE/DOM/dom_oce.F90
r13557 r13991 74 74 LOGICAL, PUBLIC :: l_Iperio, l_Jperio ! should we explicitely take care I/J periodicity 75 75 76 ! Tiling namelist 77 LOGICAL, PUBLIC :: ln_tile 78 INTEGER :: nn_ltile_i, nn_ltile_j 79 80 ! Domain tiling (all tiles) 81 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ntsi_a !: start of internal part of tile domain 82 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ntsj_a ! 83 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ntei_a !: end of internal part of tile domain 84 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ntej_a ! 85 76 86 ! !: domain MPP decomposition parameters 77 87 INTEGER , PUBLIC :: nimpp, njmpp !: i- & j-indexes for mpp-subdomain left bottom … … 87 97 INTEGER, PUBLIC :: noea, nowe !: index of the local neighboring processors in 88 98 INTEGER, PUBLIC :: noso, nono !: east, west, south and north directions 99 INTEGER, PUBLIC :: nones, nonws !: north-east, north-west directions for sending 100 INTEGER, PUBLIC :: noses, nosws !: south-east, south-west directions for sending 101 INTEGER, PUBLIC :: noner, nonwr !: north-east, north-west directions for receiving 102 INTEGER, PUBLIC :: noser, noswr !: south-east, south-west directions for receiving 89 103 INTEGER, PUBLIC :: nidom !: ??? 90 104 … … 296 310 ALLOCATE( e3t(jpi,jpj,jpk,jpt) , e3u (jpi,jpj,jpk,jpt) , e3v (jpi,jpj,jpk,jpt) , e3f(jpi,jpj,jpk) , & 297 311 & e3w(jpi,jpj,jpk,jpt) , e3uw(jpi,jpj,jpk,jpt) , e3vw(jpi,jpj,jpk,jpt) , STAT=ierr(ii) ) 298 #endif 312 #endif 299 313 ! 300 314 ii = ii+1 301 315 ALLOCATE( r3t (jpi,jpj,jpt) , r3u (jpi,jpj,jpt) , r3v (jpi,jpj,jpt) , r3f (jpi,jpj) , & 302 & r3t_f(jpi,jpj) , r3u_f(jpi,jpj) , r3v_f(jpi,jpj) , STAT=ierr(ii) ) 316 & r3t_f(jpi,jpj) , r3u_f(jpi,jpj) , r3v_f(jpi,jpj) , STAT=ierr(ii) ) 303 317 ! 304 318 ii = ii+1 … … 317 331 ! 318 332 ii = ii+1 319 ALLOCATE( risfdep(jpi,jpj) , bathy(jpi,jpj) , STAT=ierr(ii) ) 333 ALLOCATE( risfdep(jpi,jpj) , bathy(jpi,jpj) , STAT=ierr(ii) ) 320 334 ! 321 335 ii = ii+1 … … 323 337 ! 324 338 ii = ii+1 325 ALLOCATE( tmask_i(jpi,jpj) , tmask_h(jpi,jpj) , & 339 ALLOCATE( tmask_i(jpi,jpj) , tmask_h(jpi,jpj) , & 326 340 & ssmask (jpi,jpj) , ssumask(jpi,jpj) , ssvmask(jpi,jpj) , ssfmask(jpi,jpj) , & 327 341 & mbkt (jpi,jpj) , mbku (jpi,jpj) , mbkv (jpi,jpj) , STAT=ierr(ii) ) … … 331 345 ! 332 346 ii = ii+1 333 ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk) , & 347 ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk) , & 334 348 & vmask(jpi,jpj,jpk) , fmask(jpi,jpj,jpk) , STAT=ierr(ii) ) 335 349 ! -
NEMO/branches/2020/dev_r13787_SI3-10_EAP/src/OCE/DOM/domain.F90
r13558 r13991 45 45 USE closea , ONLY : dom_clo ! closed seas 46 46 ! 47 USE prtctl ! Print control (prt_ctl_info routine) 47 48 USE in_out_manager ! I/O manager 48 49 USE iom ! I/O library … … 55 56 PUBLIC dom_init ! called by nemogcm.F90 56 57 PUBLIC domain_cfg ! called by nemogcm.F90 58 PUBLIC dom_tile ! called by step.F90 57 59 58 60 !!------------------------------------------------------------------------- … … 63 65 CONTAINS 64 66 65 SUBROUTINE dom_init( Kbb, Kmm, Kaa , cdstr)67 SUBROUTINE dom_init( Kbb, Kmm, Kaa ) 66 68 !!---------------------------------------------------------------------- 67 69 !! *** ROUTINE dom_init *** … … 79 81 !!---------------------------------------------------------------------- 80 82 INTEGER , INTENT(in) :: Kbb, Kmm, Kaa ! ocean time level indices 81 CHARACTER (len=*), INTENT(in) :: cdstr ! model: NEMO or SAS. Determines core restart variables82 83 ! 83 84 INTEGER :: ji, jj, jk, jt ! dummy loop indices … … 120 121 WRITE(numout,*) ' cn_cfg = ', TRIM( cn_cfg ), ' nn_cfg = ', nn_cfg 121 122 ENDIF 123 nn_wxios = 0 124 ln_xios_read = .FALSE. 122 125 ! 123 126 ! !== Reference coordinate system ==! 124 127 ! 125 CALL dom_glo ! global domain versus local domain 126 CALL dom_nam ! read namelist ( namrun, namdom ) 127 ! 128 IF( lwxios ) THEN 129 !define names for restart write and set core output (restart.F90) 130 CALL iom_set_rst_vars(rst_wfields) 131 CALL iom_set_rstw_core(cdstr) 132 ENDIF 133 !reset namelist for SAS 134 IF(cdstr == 'SAS') THEN 135 IF(lrxios) THEN 136 IF(lwp) write(numout,*) 'Disable reading restart file using XIOS for SAS' 137 lrxios = .FALSE. 138 ENDIF 139 ENDIF 128 CALL dom_glo ! global domain versus local domain 129 CALL dom_nam ! read namelist ( namrun, namdom ) 130 CALL dom_tile( ntsi, ntsj, ntei, ntej ) ! Tile domain 131 140 132 ! 141 133 CALL dom_hgr ! Horizontal mesh … … 285 277 286 278 279 SUBROUTINE dom_tile( ktsi, ktsj, ktei, ktej, ktile ) 280 !!---------------------------------------------------------------------- 281 !! *** ROUTINE dom_tile *** 282 !! 283 !! ** Purpose : Set tile domain variables 284 !! 285 !! ** Action : - ktsi, ktsj : start of internal part of domain 286 !! - ktei, ktej : end of internal part of domain 287 !! - ntile : current tile number 288 !! - nijtile : total number of tiles 289 !!---------------------------------------------------------------------- 290 INTEGER, INTENT(out) :: ktsi, ktsj, ktei, ktej ! Tile domain indices 291 INTEGER, INTENT(in), OPTIONAL :: ktile ! Tile number 292 INTEGER :: jt ! dummy loop argument 293 INTEGER :: iitile, ijtile ! Local integers 294 CHARACTER (len=11) :: charout 295 !!---------------------------------------------------------------------- 296 IF( PRESENT(ktile) .AND. ln_tile ) THEN 297 ntile = ktile ! Set domain indices for tile 298 ktsi = ntsi_a(ktile) 299 ktsj = ntsj_a(ktile) 300 ktei = ntei_a(ktile) 301 ktej = ntej_a(ktile) 302 303 IF(sn_cfctl%l_prtctl) THEN 304 WRITE(charout, FMT="('ntile =', I4)") ktile 305 CALL prt_ctl_info( charout ) 306 ENDIF 307 ELSE 308 ntile = 0 ! Initialise to full domain 309 nijtile = 1 310 ktsi = Nis0 311 ktsj = Njs0 312 ktei = Nie0 313 ktej = Nje0 314 315 IF( ln_tile ) THEN ! Calculate tile domain indices 316 iitile = Ni_0 / nn_ltile_i ! Number of tiles 317 ijtile = Nj_0 / nn_ltile_j 318 IF( MOD( Ni_0, nn_ltile_i ) /= 0 ) iitile = iitile + 1 319 IF( MOD( Nj_0, nn_ltile_j ) /= 0 ) ijtile = ijtile + 1 320 321 nijtile = iitile * ijtile 322 ALLOCATE( ntsi_a(0:nijtile), ntsj_a(0:nijtile), ntei_a(0:nijtile), ntej_a(0:nijtile) ) 323 324 ntsi_a(0) = ktsi ! Full domain 325 ntsj_a(0) = ktsj 326 ntei_a(0) = ktei 327 ntej_a(0) = ktej 328 329 DO jt = 1, nijtile ! Tile domains 330 ntsi_a(jt) = Nis0 + nn_ltile_i * MOD(jt - 1, iitile) 331 ntsj_a(jt) = Njs0 + nn_ltile_j * ((jt - 1) / iitile) 332 ntei_a(jt) = MIN(ntsi_a(jt) + nn_ltile_i - 1, Nie0) 333 ntej_a(jt) = MIN(ntsj_a(jt) + nn_ltile_j - 1, Nje0) 334 ENDDO 335 ENDIF 336 337 IF(lwp) THEN ! control print 338 WRITE(numout,*) 339 WRITE(numout,*) 'dom_tile : Domain tiling decomposition' 340 WRITE(numout,*) '~~~~~~~~' 341 IF( ln_tile ) THEN 342 WRITE(numout,*) iitile, 'tiles in i' 343 WRITE(numout,*) ' Starting indices' 344 WRITE(numout,*) ' ', (ntsi_a(jt), jt=1, iitile) 345 WRITE(numout,*) ' Ending indices' 346 WRITE(numout,*) ' ', (ntei_a(jt), jt=1, iitile) 347 WRITE(numout,*) ijtile, 'tiles in j' 348 WRITE(numout,*) ' Starting indices' 349 WRITE(numout,*) ' ', (ntsj_a(jt), jt=1, nijtile, iitile) 350 WRITE(numout,*) ' Ending indices' 351 WRITE(numout,*) ' ', (ntej_a(jt), jt=1, nijtile, iitile) 352 ELSE 353 WRITE(numout,*) 'No domain tiling' 354 WRITE(numout,*) ' i indices =', ktsi, ':', ktei 355 WRITE(numout,*) ' j indices =', ktsj, ':', ktej 356 ENDIF 357 ENDIF 358 ENDIF 359 END SUBROUTINE dom_tile 360 361 287 362 SUBROUTINE dom_nam 288 363 !!---------------------------------------------------------------------- … … 293 368 !! ** input : - namrun namelist 294 369 !! - namdom namelist 370 !! - namtile namelist 295 371 !! - namnc4 namelist ! "key_netcdf4" only 296 372 !!---------------------------------------------------------------------- … … 305 381 & ln_cfmeta, ln_xios_read, nn_wxios 306 382 NAMELIST/namdom/ ln_linssh, rn_Dt, rn_atfp, ln_crs, ln_meshmask 383 NAMELIST/namtile/ ln_tile, nn_ltile_i, nn_ltile_j 307 384 #if defined key_netcdf4 308 385 NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip … … 441 518 r1_Dt = 1._wp / rDt 442 519 520 READ ( numnam_ref, namtile, IOSTAT = ios, ERR = 905 ) 521 905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtile in reference namelist' ) 522 READ ( numnam_cfg, namtile, IOSTAT = ios, ERR = 906 ) 523 906 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtile in configuration namelist' ) 524 IF(lwm) WRITE( numond, namtile ) 525 526 IF(lwp) THEN 527 WRITE(numout,*) 528 WRITE(numout,*) ' Namelist : namtile --- Domain tiling decomposition' 529 WRITE(numout,*) ' Tiling (T) or not (F) ln_tile = ', ln_tile 530 WRITE(numout,*) ' Length of tile in i nn_ltile_i = ', nn_ltile_i 531 WRITE(numout,*) ' Length of tile in j nn_ltile_j = ', nn_ltile_j 532 WRITE(numout,*) 533 IF( ln_tile ) THEN 534 WRITE(numout,*) ' The domain will be decomposed into tiles of size', nn_ltile_i, 'x', nn_ltile_j 535 ELSE 536 WRITE(numout,*) ' Domain tiling will NOT be used' 537 ENDIF 538 ENDIF 539 443 540 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 444 541 lrxios = ln_xios_read.AND.ln_rstart -
NEMO/branches/2020/dev_r13787_SI3-10_EAP/src/OCE/DOM/domqco.F90
r13295 r13991 91 91 ! 92 92 CALL dom_qco_zgr(Kbb, Kmm, Kaa) ! interpolation scale factor, depth and water column 93 !94 ! IF(lwxios) THEN ! define variables in restart file when writing with XIOS95 ! CALL iom_set_rstw_var_active('e3t_b')96 ! CALL iom_set_rstw_var_active('e3t_n')97 ! ENDIF98 93 ! 99 94 END SUBROUTINE dom_qco_init … … 217 212 ! 218 213 IF( MIN( id1, id2 ) > 0 ) THEN ! all required arrays exist 219 CALL iom_get( numror, jpdom_auto, 'sshb' , ssh(:,:,Kbb) , ldxios = lrxios)220 CALL iom_get( numror, jpdom_auto, 'sshn' , ssh(:,:,Kmm) , ldxios = lrxios)214 CALL iom_get( numror, jpdom_auto, 'sshb' , ssh(:,:,Kbb) ) 215 CALL iom_get( numror, jpdom_auto, 'sshn' , ssh(:,:,Kmm) ) 221 216 ! needed to restart if land processor not computed 222 217 IF(lwp) write(numout,*) 'qe_rst_read : ssh(:,:,Kbb) and ssh(:,:,Kmm) found in restart files' … … 232 227 IF(lwp) write(numout,*) 'sshn set equal to sshb.' 233 228 IF(lwp) write(numout,*) 'neuler is forced to 0' 234 CALL iom_get( numror, jpdom_auto, 'sshb', ssh(:,:,Kbb) , ldxios = lrxios)229 CALL iom_get( numror, jpdom_auto, 'sshb', ssh(:,:,Kbb) ) 235 230 ssh(:,:,Kmm) = ssh(:,:,Kbb) 236 231 l_1st_euler = .TRUE. … … 239 234 IF(lwp) write(numout,*) 'sshb set equal to sshn.' 240 235 IF(lwp) write(numout,*) 'neuler is forced to 0' 241 CALL iom_get( numror, jpdom_auto, 'sshn', ssh(:,:,Kmm) , ldxios = lrxios)236 CALL iom_get( numror, jpdom_auto, 'sshn', ssh(:,:,Kmm) ) 242 237 ssh(:,:,Kbb) = ssh(:,:,Kmm) 243 238 l_1st_euler = .TRUE. -
NEMO/branches/2020/dev_r13787_SI3-10_EAP/src/OCE/DOM/domutl.F90
r13458 r13991 21 21 PRIVATE 22 22 23 INTERFACE is_tile 24 MODULE PROCEDURE is_tile_2d, is_tile_3d, is_tile_4d 25 END INTERFACE is_tile 26 23 27 PUBLIC dom_ngb ! routine called in iom.F90 module 24 28 PUBLIC dom_uniq ! Called by dommsk and domwri 29 PUBLIC is_tile 25 30 26 31 !!---------------------------------------------------------------------- … … 109 114 ! 110 115 END SUBROUTINE dom_uniq 111 116 117 118 FUNCTION is_tile_2d( pt ) 119 !! 120 REAL(wp), DIMENSION(:,:), INTENT(in) :: pt 121 INTEGER :: is_tile_2d 122 !! 123 IF( ln_tile .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN 124 is_tile_2d = 1 125 ELSE 126 is_tile_2d = 0 127 ENDIF 128 END FUNCTION is_tile_2d 129 130 131 FUNCTION is_tile_3d( pt ) 132 !! 133 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: pt 134 INTEGER :: is_tile_3d 135 !! 136 IF( ln_tile .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN 137 is_tile_3d = 1 138 ELSE 139 is_tile_3d = 0 140 ENDIF 141 END FUNCTION is_tile_3d 142 143 144 FUNCTION is_tile_4d( pt ) 145 !! 146 REAL(wp), DIMENSION(:,:,:,:), INTENT(in) :: pt 147 INTEGER :: is_tile_4d 148 !! 149 IF( ln_tile .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN 150 is_tile_4d = 1 151 ELSE 152 is_tile_4d = 0 153 ENDIF 154 END FUNCTION is_tile_4d 155 112 156 !!====================================================================== 113 157 END MODULE domutl -
NEMO/branches/2020/dev_r13787_SI3-10_EAP/src/OCE/DOM/domvvl.F90
r13497 r13991 282 282 ENDIF 283 283 ! 284 IF(lwxios) THEN285 ! define variables in restart file when writing with XIOS286 CALL iom_set_rstw_var_active('e3t_b')287 CALL iom_set_rstw_var_active('e3t_n')288 ! ! ----------------------- !289 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases !290 ! ! ----------------------- !291 CALL iom_set_rstw_var_active('tilde_e3t_b')292 CALL iom_set_rstw_var_active('tilde_e3t_n')293 END IF294 ! ! -------------!295 IF( ln_vvl_ztilde ) THEN ! z_tilde case !296 ! ! ------------ !297 CALL iom_set_rstw_var_active('hdiv_lf')298 ENDIF299 !300 ENDIF301 !302 284 END SUBROUTINE dom_vvl_zgr 303 285 … … 440 422 ! (stored for tracer advction and continuity equation) 441 423 CALL lbc_lnk_multi( 'domvvl', un_td , 'U' , -1._wp, vn_td , 'V' , -1._wp) 442 443 424 ! 4 - Time stepping of baroclinic scale factors 444 425 ! --------------------------------------------- … … 803 784 IF( ln_rstart ) THEN !* Read the restart file 804 785 CALL rst_read_open ! open the restart file if necessary 805 CALL iom_get( numror, jpdom_auto, 'sshn' , ssh(:,:,Kmm) , ldxios = lrxios)786 CALL iom_get( numror, jpdom_auto, 'sshn' , ssh(:,:,Kmm) ) 806 787 ! 807 788 id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) … … 816 797 ! 817 798 IF( MIN( id1, id2 ) > 0 ) THEN ! all required arrays exist 818 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) , ldxios = lrxios)819 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) , ldxios = lrxios)799 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) ) 800 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 820 801 ! needed to restart if land processor not computed 821 802 IF(lwp) write(numout,*) 'dom_vvl_rst : e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) found in restart files' … … 831 812 IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 832 813 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 833 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) , ldxios = lrxios)814 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) ) 834 815 e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 835 816 l_1st_euler = .true. … … 838 819 IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 839 820 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 840 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) , ldxios = lrxios)821 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 841 822 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 842 823 l_1st_euler = .true. … … 863 844 ! ! ----------------------- ! 864 845 IF( MIN( id3, id4 ) > 0 ) THEN ! all required arrays exist 865 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:) , ldxios = lrxios)866 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:) , ldxios = lrxios)846 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:) ) 847 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:) ) 867 848 ELSE ! one at least array is missing 868 849 tilde_e3t_b(:,:,:) = 0.0_wp … … 873 854 ! ! ------------ ! 874 855 IF( id5 > 0 ) THEN ! required array exists 875 CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:) , ldxios = lrxios)856 CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:) ) 876 857 ELSE ! array is missing 877 858 hdiv_lf(:,:,:) = 0.0_wp … … 946 927 ! ! =================== 947 928 IF(lwp) WRITE(numout,*) '---- dom_vvl_rst ----' 948 IF( lwxios ) CALL iom_swap( cwxios_context )949 929 ! ! --------- ! 950 930 ! ! all cases ! 951 931 ! ! --------- ! 952 CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t(:,:,:,Kbb) , ldxios = lwxios)953 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t(:,:,:,Kmm) , ldxios = lwxios)932 CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t(:,:,:,Kbb) ) 933 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t(:,:,:,Kmm) ) 954 934 ! ! ----------------------- ! 955 935 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases ! 956 936 ! ! ----------------------- ! 957 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:) , ldxios = lwxios)958 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:) , ldxios = lwxios)937 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:)) 938 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:)) 959 939 END IF 960 940 ! ! -------------! 961 941 IF( ln_vvl_ztilde ) THEN ! z_tilde case ! 962 942 ! ! ------------ ! 963 CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:) , ldxios = lwxios)943 CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:)) 964 944 ENDIF 965 945 ! 966 IF( lwxios ) CALL iom_swap( cxios_context )967 946 ENDIF 968 947 ! -
NEMO/branches/2020/dev_r13787_SI3-10_EAP/src/OCE/DOM/dtatsd.F90
r13497 r13991 18 18 USE phycst ! physical constants 19 19 USE dom_oce ! ocean space and time domain 20 USE domain, ONLY : dom_tile 20 21 USE fldread ! read input fields 21 22 ! … … 135 136 !! ** Action : ptsd T-S data on medl mesh and interpolated at time-step kt 136 137 !!---------------------------------------------------------------------- 137 INTEGER 138 REAL(wp), DIMENSION( jpi,jpj,jpk,jpts), INTENT( out) :: ptsd ! T & S data138 INTEGER , INTENT(in ) :: kt ! ocean time-step 139 REAL(wp), DIMENSION(A2D(nn_hls),jpk,jpts), INTENT( out) :: ptsd ! T & S data 139 140 ! 140 141 INTEGER :: ji, jj, jk, jl, jkk ! dummy loop indicies 141 142 INTEGER :: ik, il0, il1, ii0, ii1, ij0, ij1 ! local integers 143 INTEGER :: itile 142 144 REAL(wp):: zl, zi ! local scalars 143 145 REAL(wp), DIMENSION(jpk) :: ztp, zsp ! 1D workspace 144 146 !!---------------------------------------------------------------------- 145 147 ! 146 CALL fld_read( kt, 1, sf_tsd ) !== read T & S data at kt time step ==! 148 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only for the full domain 149 itile = ntile 150 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 151 CALL fld_read( kt, 1, sf_tsd ) !== read T & S data at kt time step ==! 147 152 ! 148 153 ! 149 154 !!gm This should be removed from the code ===>>>> T & S files has to be changed 150 ! 151 ! !== ORCA_R2 configuration and T & S damping ==! 152 IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 153 IF( nn_cfg == 2 .AND. ln_tsd_dmp ) THEN ! some hand made alterations 154 ! 155 ij0 = 101 + nn_hls ; ij1 = 109 + nn_hls ! Reduced T & S in the Alboran Sea 156 ii0 = 141 + nn_hls - 1 ; ii1 = 155 + nn_hls - 1 157 DO jj = mj0(ij0), mj1(ij1) 158 DO ji = mi0(ii0), mi1(ii1) 159 sf_tsd(jp_tem)%fnow(ji,jj,13:13) = sf_tsd(jp_tem)%fnow(ji,jj,13:13) - 0.20_wp 160 sf_tsd(jp_tem)%fnow(ji,jj,14:15) = sf_tsd(jp_tem)%fnow(ji,jj,14:15) - 0.35_wp 161 sf_tsd(jp_tem)%fnow(ji,jj,16:25) = sf_tsd(jp_tem)%fnow(ji,jj,16:25) - 0.40_wp 162 ! 163 sf_tsd(jp_sal)%fnow(ji,jj,13:13) = sf_tsd(jp_sal)%fnow(ji,jj,13:13) - 0.15_wp 164 sf_tsd(jp_sal)%fnow(ji,jj,14:15) = sf_tsd(jp_sal)%fnow(ji,jj,14:15) - 0.25_wp 165 sf_tsd(jp_sal)%fnow(ji,jj,16:17) = sf_tsd(jp_sal)%fnow(ji,jj,16:17) - 0.30_wp 166 sf_tsd(jp_sal)%fnow(ji,jj,18:25) = sf_tsd(jp_sal)%fnow(ji,jj,18:25) - 0.35_wp 155 ! 156 ! !== ORCA_R2 configuration and T & S damping ==! 157 IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 158 IF( nn_cfg == 2 .AND. ln_tsd_dmp ) THEN ! some hand made alterations 159 ! 160 ij0 = 101 + nn_hls ; ij1 = 109 + nn_hls ! Reduced T & S in the Alboran Sea 161 ii0 = 141 + nn_hls - 1 ; ii1 = 155 + nn_hls - 1 162 DO jj = mj0(ij0), mj1(ij1) 163 DO ji = mi0(ii0), mi1(ii1) 164 sf_tsd(jp_tem)%fnow(ji,jj,13:13) = sf_tsd(jp_tem)%fnow(ji,jj,13:13) - 0.20_wp 165 sf_tsd(jp_tem)%fnow(ji,jj,14:15) = sf_tsd(jp_tem)%fnow(ji,jj,14:15) - 0.35_wp 166 sf_tsd(jp_tem)%fnow(ji,jj,16:25) = sf_tsd(jp_tem)%fnow(ji,jj,16:25) - 0.40_wp 167 ! 168 sf_tsd(jp_sal)%fnow(ji,jj,13:13) = sf_tsd(jp_sal)%fnow(ji,jj,13:13) - 0.15_wp 169 sf_tsd(jp_sal)%fnow(ji,jj,14:15) = sf_tsd(jp_sal)%fnow(ji,jj,14:15) - 0.25_wp 170 sf_tsd(jp_sal)%fnow(ji,jj,16:17) = sf_tsd(jp_sal)%fnow(ji,jj,16:17) - 0.30_wp 171 sf_tsd(jp_sal)%fnow(ji,jj,18:25) = sf_tsd(jp_sal)%fnow(ji,jj,18:25) - 0.35_wp 172 END DO 167 173 END DO 168 END DO 169 ij0 = 87 + nn_hls ; ij1 = 96 + nn_hls ! Reduced temperature in Red Sea 170 ii0 = 148 + nn_hls - 1 ; ii1 = 160 + nn_hls - 1 171 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 ) = 7.0_wp 172 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5_wp 173 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0_wp 174 ENDIF 175 ENDIF 174 ij0 = 87 + nn_hls ; ij1 = 96 + nn_hls ! Reduced temperature in Red Sea 175 ii0 = 148 + nn_hls - 1 ; ii1 = 160 + nn_hls - 1 176 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 ) = 7.0_wp 177 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5_wp 178 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0_wp 179 ENDIF 180 ENDIF 176 181 !!gm end 177 ! 178 ptsd(:,:,:,jp_tem) = sf_tsd(jp_tem)%fnow(:,:,:) ! NO mask 179 ptsd(:,:,:,jp_sal) = sf_tsd(jp_sal)%fnow(:,:,:) 182 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile ) ! Revert to tile domain 183 ENDIF 184 ! 185 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 186 ptsd(ji,jj,jk,jp_tem) = sf_tsd(jp_tem)%fnow(ji,jj,jk) ! NO mask 187 ptsd(ji,jj,jk,jp_sal) = sf_tsd(jp_sal)%fnow(ji,jj,jk) 188 END_3D 180 189 ! 181 190 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! 182 191 ! 183 IF( kt == nit000 .AND. lwp )THEN 184 WRITE(numout,*) 185 WRITE(numout,*) 'dta_tsd: interpolates T & S data onto the s- or mixed s-z-coordinate mesh' 186 ENDIF 187 ! 188 DO_2D( 1, 1, 1, 1 ) ! vertical interpolation of T & S 192 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 193 IF( kt == nit000 .AND. lwp )THEN 194 WRITE(numout,*) 195 WRITE(numout,*) 'dta_tsd: interpolates T & S data onto the s- or mixed s-z-coordinate mesh' 196 ENDIF 197 ENDIF 198 ! 199 ! NOTE: [tiling-comms-merge] This fix was necessary to take out tra_adv lbc_lnk statements in the zps case, but did not work in the zco case 200 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! vertical interpolation of T & S 189 201 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 190 202 zl = gdept_0(ji,jj,jk) … … 215 227 ELSE !== z- or zps- coordinate ==! 216 228 ! 217 ptsd(:,:,:,jp_tem) = ptsd(:,:,:,jp_tem) * tmask(:,:,:) ! Mask 218 ptsd(:,:,:,jp_sal) = ptsd(:,:,:,jp_sal) * tmask(:,:,:) 229 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 230 ptsd(ji,jj,jk,jp_tem) = ptsd(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) ! Mask 231 ptsd(ji,jj,jk,jp_sal) = ptsd(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 232 END_3D 219 233 ! 220 234 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level 221 DO_2D( 1, 1, 1, 1 ) 235 ! NOTE: [tiling-comms-merge] This fix was necessary to take out tra_adv lbc_lnk statements in the zps case 236 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 222 237 ik = mbkt(ji,jj) 223 238 IF( ik > 1 ) THEN -
NEMO/branches/2020/dev_r13787_SI3-10_EAP/src/OCE/DYN/dynhpg.F90
r13295 r13991 302 302 INTEGER :: iku, ikv ! temporary integers 303 303 REAL(wp) :: zcoef0, zcoef1, zcoef2, zcoef3 ! temporary scalars 304 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zhpi, zhpj 305 REAL(wp), DIMENSION(jpi,jpj) :: zgtsu, zgtsv, zgru, zgrv 304 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zhpi, zhpj 305 REAL(wp), DIMENSION(jpi,jpj,jpts) :: zgtsu, zgtsv 306 REAL(wp), DIMENSION(jpi,jpj) :: zgru, zgrv 306 307 !!---------------------------------------------------------------------- 307 308 ! -
NEMO/branches/2020/dev_r13787_SI3-10_EAP/src/OCE/DYN/dynspg_ts.F90
r13546 r13991 900 900 ! ! --------------- 901 901 IF( ln_rstart .AND. ln_bt_fw .AND. (.NOT.l_1st_euler) ) THEN !* Read the restart file 902 CALL iom_get( numror, jpdom_auto, 'ub2_b' , ub2_b (:,:), cd_type = 'U', psgn = -1._wp , ldxios = lrxios)903 CALL iom_get( numror, jpdom_auto, 'vb2_b' , vb2_b (:,:), cd_type = 'V', psgn = -1._wp , ldxios = lrxios)904 CALL iom_get( numror, jpdom_auto, 'un_bf' , un_bf (:,:), cd_type = 'U', psgn = -1._wp , ldxios = lrxios)905 CALL iom_get( numror, jpdom_auto, 'vn_bf' , vn_bf (:,:), cd_type = 'V', psgn = -1._wp , ldxios = lrxios)902 CALL iom_get( numror, jpdom_auto, 'ub2_b' , ub2_b (:,:), cd_type = 'U', psgn = -1._wp ) 903 CALL iom_get( numror, jpdom_auto, 'vb2_b' , vb2_b (:,:), cd_type = 'V', psgn = -1._wp ) 904 CALL iom_get( numror, jpdom_auto, 'un_bf' , un_bf (:,:), cd_type = 'U', psgn = -1._wp ) 905 CALL iom_get( numror, jpdom_auto, 'vn_bf' , vn_bf (:,:), cd_type = 'V', psgn = -1._wp ) 906 906 IF( .NOT.ln_bt_av ) THEN 907 CALL iom_get( numror, jpdom_auto, 'sshbb_e' , sshbb_e(:,:), cd_type = 'T', psgn = 1._wp , ldxios = lrxios)908 CALL iom_get( numror, jpdom_auto, 'ubb_e' , ubb_e(:,:), cd_type = 'U', psgn = -1._wp , ldxios = lrxios)909 CALL iom_get( numror, jpdom_auto, 'vbb_e' , vbb_e(:,:), cd_type = 'V', psgn = -1._wp , ldxios = lrxios)910 CALL iom_get( numror, jpdom_auto, 'sshb_e' , sshb_e(:,:), cd_type = 'T', psgn = 1._wp , ldxios = lrxios)911 CALL iom_get( numror, jpdom_auto, 'ub_e' , ub_e(:,:), cd_type = 'U', psgn = -1._wp , ldxios = lrxios)912 CALL iom_get( numror, jpdom_auto, 'vb_e' , vb_e(:,:), cd_type = 'V', psgn = -1._wp , ldxios = lrxios)907 CALL iom_get( numror, jpdom_auto, 'sshbb_e' , sshbb_e(:,:), cd_type = 'T', psgn = 1._wp ) 908 CALL iom_get( numror, jpdom_auto, 'ubb_e' , ubb_e(:,:), cd_type = 'U', psgn = -1._wp ) 909 CALL iom_get( numror, jpdom_auto, 'vbb_e' , vbb_e(:,:), cd_type = 'V', psgn = -1._wp ) 910 CALL iom_get( numror, jpdom_auto, 'sshb_e' , sshb_e(:,:), cd_type = 'T', psgn = 1._wp ) 911 CALL iom_get( numror, jpdom_auto, 'ub_e' , ub_e(:,:), cd_type = 'U', psgn = -1._wp ) 912 CALL iom_get( numror, jpdom_auto, 'vb_e' , vb_e(:,:), cd_type = 'V', psgn = -1._wp ) 913 913 ENDIF 914 914 #if defined key_agrif 915 915 ! Read time integrated fluxes 916 916 IF ( .NOT.Agrif_Root() ) THEN 917 CALL iom_get( numror, jpdom_auto, 'ub2_i_b' , ub2_i_b(:,:), cd_type = 'U', psgn = -1._wp , ldxios = lrxios)918 CALL iom_get( numror, jpdom_auto, 'vb2_i_b' , vb2_i_b(:,:), cd_type = 'V', psgn = -1._wp , ldxios = lrxios)917 CALL iom_get( numror, jpdom_auto, 'ub2_i_b' , ub2_i_b(:,:), cd_type = 'U', psgn = -1._wp ) 918 CALL iom_get( numror, jpdom_auto, 'vb2_i_b' , vb2_i_b(:,:), cd_type = 'V', psgn = -1._wp ) 919 919 ELSE 920 920 ub2_i_b(:,:) = 0._wp ; vb2_i_b(:,:) = 0._wp ! used in the 1st update of agrif … … 935 935 ! ! ------------------- 936 936 IF(lwp) WRITE(numout,*) '---- ts_rst ----' 937 IF( lwxios ) CALL iom_swap( cwxios_context ) 938 CALL iom_rstput( kt, nitrst, numrow, 'ub2_b' , ub2_b (:,:), ldxios = lwxios ) 939 CALL iom_rstput( kt, nitrst, numrow, 'vb2_b' , vb2_b (:,:), ldxios = lwxios ) 940 CALL iom_rstput( kt, nitrst, numrow, 'un_bf' , un_bf (:,:), ldxios = lwxios ) 941 CALL iom_rstput( kt, nitrst, numrow, 'vn_bf' , vn_bf (:,:), ldxios = lwxios ) 937 CALL iom_rstput( kt, nitrst, numrow, 'ub2_b' , ub2_b (:,:) ) 938 CALL iom_rstput( kt, nitrst, numrow, 'vb2_b' , vb2_b (:,:) ) 939 CALL iom_rstput( kt, nitrst, numrow, 'un_bf' , un_bf (:,:) ) 940 CALL iom_rstput( kt, nitrst, numrow, 'vn_bf' , vn_bf (:,:) ) 942 941 ! 943 942 IF (.NOT.ln_bt_av) THEN 944 CALL iom_rstput( kt, nitrst, numrow, 'sshbb_e' , sshbb_e(:,:) , ldxios = lwxios)945 CALL iom_rstput( kt, nitrst, numrow, 'ubb_e' , ubb_e(:,:) , ldxios = lwxios)946 CALL iom_rstput( kt, nitrst, numrow, 'vbb_e' , vbb_e(:,:) , ldxios = lwxios)947 CALL iom_rstput( kt, nitrst, numrow, 'sshb_e' , sshb_e(:,:) , ldxios = lwxios)948 CALL iom_rstput( kt, nitrst, numrow, 'ub_e' , ub_e(:,:) , ldxios = lwxios)949 CALL iom_rstput( kt, nitrst, numrow, 'vb_e' , vb_e(:,:) , ldxios = lwxios)943 CALL iom_rstput( kt, nitrst, numrow, 'sshbb_e' , sshbb_e(:,:) ) 944 CALL iom_rstput( kt, nitrst, numrow, 'ubb_e' , ubb_e(:,:) ) 945 CALL iom_rstput( kt, nitrst, numrow, 'vbb_e' , vbb_e(:,:) ) 946 CALL iom_rstput( kt, nitrst, numrow, 'sshb_e' , sshb_e(:,:) ) 947 CALL iom_rstput( kt, nitrst, numrow, 'ub_e' , ub_e(:,:) ) 948 CALL iom_rstput( kt, nitrst, numrow, 'vb_e' , vb_e(:,:) ) 950 949 ENDIF 951 950 #if defined key_agrif 952 951 ! Save time integrated fluxes 953 952 IF ( .NOT.Agrif_Root() ) THEN 954 CALL iom_rstput( kt, nitrst, numrow, 'ub2_i_b' , ub2_i_b(:,:) , ldxios = lwxios)955 CALL iom_rstput( kt, nitrst, numrow, 'vb2_i_b' , vb2_i_b(:,:) , ldxios = lwxios)953 CALL iom_rstput( kt, nitrst, numrow, 'ub2_i_b' , ub2_i_b(:,:) ) 954 CALL iom_rstput( kt, nitrst, numrow, 'vb2_i_b' , vb2_i_b(:,:) ) 956 955 ENDIF 957 956 #endif 958 IF( lwxios ) CALL iom_swap( cxios_context )959 957 ENDIF 960 958 ! … … 1048 1046 ! ! read restart when needed 1049 1047 CALL ts_rst( nit000, 'READ' ) 1050 !1051 IF( lwxios ) THEN1052 ! define variables in restart file when writing with XIOS1053 CALL iom_set_rstw_var_active('ub2_b')1054 CALL iom_set_rstw_var_active('vb2_b')1055 CALL iom_set_rstw_var_active('un_bf')1056 CALL iom_set_rstw_var_active('vn_bf')1057 !1058 IF (.NOT.ln_bt_av) THEN1059 CALL iom_set_rstw_var_active('sshbb_e')1060 CALL iom_set_rstw_var_active('ubb_e')1061 CALL iom_set_rstw_var_active('vbb_e')1062 CALL iom_set_rstw_var_active('sshb_e')1063 CALL iom_set_rstw_var_active('ub_e')1064 CALL iom_set_rstw_var_active('vb_e')1065 ENDIF1066 #if defined key_agrif1067 ! Save time integrated fluxes1068 IF ( .NOT.Agrif_Root() ) THEN1069 CALL iom_set_rstw_var_active('ub2_i_b')1070 CALL iom_set_rstw_var_active('vb2_i_b')1071 ENDIF1072 #endif1073 ENDIF1074 1048 ! 1075 1049 END SUBROUTINE dyn_spg_ts_init -
NEMO/branches/2020/dev_r13787_SI3-10_EAP/src/OCE/IOM/in_out_manager.F90
r13286 r13991 89 89 LOGICAL :: lrst_abl !: logical to control the abl restart write 90 90 INTEGER :: numror = 0 !: logical unit for ocean restart (read). Init to 0 is needed for SAS (in daymod.F90) 91 INTEGER :: numrir !: logical unit for ice restart (read) 92 INTEGER :: numrar !: logical unit for abl restart (read) 93 INTEGER :: numrow !: logical unit for ocean restart (write) 94 INTEGER :: numriw !: logical unit for ice restart (write) 95 INTEGER :: numraw !: logical unit for abl restart (write) 91 INTEGER :: numrir = 0 !: logical unit for ice restart (read) 92 INTEGER :: numrar = 0 !: logical unit for abl restart (read) 93 INTEGER :: numrow = 0 !: logical unit for ocean restart (write) 94 INTEGER :: numriw = 0 !: logical unit for ice restart (write) 95 INTEGER :: numraw = 0 !: logical unit for abl restart (write) 96 INTEGER :: numrtr = 0 !: trc restart (read ) 97 INTEGER :: numrtw = 0 !: trc restart (write ) 98 INTEGER :: numrsr = 0 !: logical unit for sed restart (read) 99 INTEGER :: numrsw = 0 !: logical unit for sed restart (write) 100 96 101 INTEGER :: nrst_lst !: number of restart to output next 97 102 … … 165 170 LOGICAL :: lwp = .FALSE. !: boolean : true on the 1st processor only .OR. sn_cfctl%l_oceout=T 166 171 LOGICAL :: lsp_area = .TRUE. !: to make a control print over a specific area 167 CHARACTER(lc) :: cxios_context !: context name used in xios 168 CHARACTER(lc) :: crxios_context !: context name used in xios to read restart 169 CHARACTER(lc) :: cwxios_context !: context name used in xios to write restart file 172 CHARACTER(LEN=lc) :: cxios_context !: context name used in xios 173 CHARACTER(LEN=lc) :: cr_ocerst_cxt !: context name used in xios to read OCE restart 174 CHARACTER(LEN=lc) :: cw_ocerst_cxt !: context name used in xios to write OCE restart file 175 CHARACTER(LEN=lc) :: cr_icerst_cxt !: context name used in xios to read SI3 restart 176 CHARACTER(LEN=lc) :: cw_icerst_cxt !: context name used in xios to write SI3 restart file 177 CHARACTER(LEN=lc) :: cr_toprst_cxt !: context name used in xios to read TOP restart 178 CHARACTER(LEN=lc) :: cw_toprst_cxt !: context name used in xios to write TOP restart file 179 CHARACTER(LEN=lc) :: cr_sedrst_cxt !: context name used in xios to read SEDIMENT restart 180 CHARACTER(LEN=lc) :: cw_sedrst_cxt !: context name used in xios to write SEDIMENT restart file 181 182 183 170 184 171 185 !! * Substitutions -
NEMO/branches/2020/dev_r13787_SI3-10_EAP/src/OCE/IOM/iom.F90
r13747 r13991 46 46 USE lib_fortran 47 47 USE diu_bulk, ONLY : ln_diurnal_only, ln_diurnal 48 USE iom_nf90 49 USE netcdf 48 50 49 51 IMPLICIT NONE … … 58 60 PUBLIC iom_chkatt, iom_getatt, iom_putatt, iom_getszuld, iom_rstput, iom_delay_rst, iom_put 59 61 PUBLIC iom_use, iom_context_finalize, iom_update_file_name, iom_miss_val 62 PUBLIC iom_xios_setid 60 63 61 64 PRIVATE iom_rp0d_sp, iom_rp1d_sp, iom_rp2d_sp, iom_rp3d_sp … … 69 72 PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_get_file_attr, iom_set_grid_attr 70 73 PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_sdate 71 PRIVATE iom_set_rst_context, iom_set_ rstw_active, iom_set_rstr_active74 PRIVATE iom_set_rst_context, iom_set_vars_active 72 75 # endif 73 PUBLIC iom_set_rstw_var_active, iom_set_rstw_core, iom_set_rst_vars 76 PRIVATE set_xios_context 77 PRIVATE iom_set_rstw_active 74 78 75 79 INTERFACE iom_get … … 101 105 CONTAINS 102 106 103 SUBROUTINE iom_init( cdname, fname, ld_closedef )107 SUBROUTINE iom_init( cdname, kdid, ld_closedef ) 104 108 !!---------------------------------------------------------------------- 105 109 !! *** ROUTINE *** … … 109 113 !!---------------------------------------------------------------------- 110 114 CHARACTER(len=*), INTENT(in) :: cdname 111 CHARACTER(len=*), OPTIONAL, INTENT(in) :: fname115 INTEGER , OPTIONAL, INTENT(in) :: kdid 112 116 LOGICAL , OPTIONAL, INTENT(in) :: ld_closedef 113 117 #if defined key_iomput … … 118 122 INTEGER :: irefyear, irefmonth, irefday 119 123 INTEGER :: ji 120 LOGICAL :: llrst_context ! is context related to restart 124 LOGICAL :: llrst_context ! is context related to restart 125 LOGICAL :: llrstr, llrstw 126 INTEGER :: inum 121 127 ! 122 128 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds 123 129 REAL(wp), DIMENSION(2,jpkam1) :: za_bnds ! ABL vertical boundaries 124 LOGICAL :: ll_closedef = .TRUE.130 LOGICAL :: ll_closedef 125 131 LOGICAL :: ll_exist 126 132 !!---------------------------------------------------------------------- 127 133 ! 134 ll_closedef = .TRUE. 128 135 IF ( PRESENT(ld_closedef) ) ll_closedef = ld_closedef 129 136 ! … … 134 141 CALL xios_context_initialize(TRIM(clname), mpi_comm_oce) 135 142 CALL iom_swap( cdname ) 136 llrst_context = (TRIM(cdname) == TRIM(crxios_context) .OR. TRIM(cdname) == TRIM(cwxios_context)) 143 144 llrstr = (cdname == cr_ocerst_cxt) .OR. (cdname == cr_icerst_cxt) 145 llrstr = llrstr .OR. (cdname == cr_toprst_cxt) 146 llrstr = llrstr .OR. (cdname == cr_sedrst_cxt) 147 148 llrstw = (cdname == cw_ocerst_cxt) .OR. (cdname == cw_icerst_cxt) 149 llrstw = llrstw .OR. (cdname == cw_toprst_cxt) 150 llrstw = llrstw .OR. (cdname == cw_sedrst_cxt) 151 152 llrst_context = llrstr .OR. llrstw 137 153 138 154 ! Calendar type is now defined in xml file … … 153 169 IF(.NOT.llrst_context) CALL set_scalar 154 170 ! 155 IF( TRIM(cdname) == TRIM(cxios_context)) THEN171 IF( cdname == cxios_context ) THEN 156 172 CALL set_grid( "T", glamt, gphit, .FALSE., .FALSE. ) 157 173 CALL set_grid( "U", glamu, gphiu, .FALSE., .FALSE. ) … … 197 213 ! vertical grid definition 198 214 IF(.NOT.llrst_context) THEN 199 200 201 202 215 CALL iom_set_axis_attr( "deptht", paxis = gdept_1d ) 216 CALL iom_set_axis_attr( "depthu", paxis = gdept_1d ) 217 CALL iom_set_axis_attr( "depthv", paxis = gdept_1d ) 218 CALL iom_set_axis_attr( "depthw", paxis = gdepw_1d ) 203 219 204 220 ! ABL 205 206 207 208 209 210 211 221 IF( .NOT. ALLOCATED(ght_abl) ) THEN ! force definition for xml files (xios) 222 ALLOCATE( ght_abl(jpka), ghw_abl(jpka), e3t_abl(jpka), e3w_abl(jpka) ) ! default allocation needed by iom 223 ght_abl(:) = -1._wp ; ghw_abl(:) = -1._wp 224 e3t_abl(:) = -1._wp ; e3w_abl(:) = -1._wp 225 ENDIF 226 CALL iom_set_axis_attr( "ght_abl", ght_abl(2:jpka) ) 227 CALL iom_set_axis_attr( "ghw_abl", ghw_abl(2:jpka) ) 212 228 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 229 ! Add vertical grid bounds 230 zt_bnds(2,: ) = gdept_1d(:) 231 zt_bnds(1,2:jpk ) = gdept_1d(1:jpkm1) 232 zt_bnds(1,1 ) = gdept_1d(1) - e3w_1d(1) 233 zw_bnds(1,: ) = gdepw_1d(:) 234 zw_bnds(2,1:jpkm1) = gdepw_1d(2:jpk) 235 zw_bnds(2,jpk: ) = gdepw_1d(jpk) + e3t_1d(jpk) 236 CALL iom_set_axis_attr( "deptht", bounds=zw_bnds ) 237 CALL iom_set_axis_attr( "depthu", bounds=zw_bnds ) 238 CALL iom_set_axis_attr( "depthv", bounds=zw_bnds ) 239 CALL iom_set_axis_attr( "depthw", bounds=zt_bnds ) 240 241 ! ABL 242 za_bnds(1,:) = ghw_abl(1:jpkam1) 243 za_bnds(2,:) = ghw_abl(2:jpka ) 244 CALL iom_set_axis_attr( "ght_abl", bounds=za_bnds ) 245 za_bnds(1,:) = ght_abl(2:jpka ) 246 za_bnds(2,:) = ght_abl(2:jpka ) + e3w_abl(2:jpka) 247 CALL iom_set_axis_attr( "ghw_abl", bounds=za_bnds ) 248 249 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,jpnfl) /) ) 234 250 # if defined key_si3 235 236 237 251 CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) ) 252 ! SIMIP diagnostics (4 main arctic straits) 253 CALL iom_set_axis_attr( "nstrait", (/ (REAL(ji,wp), ji=1,4) /) ) 238 254 # endif 239 255 #if defined key_top 240 241 #endif 242 243 244 245 246 247 248 249 256 IF( ALLOCATED(profsed) ) CALL iom_set_axis_attr( "profsed", paxis = profsed ) 257 #endif 258 CALL iom_set_axis_attr( "icbcla", class_num ) 259 CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) ) ! strange syntaxe and idea... 260 CALL iom_set_axis_attr( "iax_26C", (/ REAL(26,wp) /) ) ! strange syntaxe and idea... 261 CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) ) ! strange syntaxe and idea... 262 ! for diaprt, we need to define an axis which size can be 1 (default) or 5 (if the file subbasins.nc exists) 263 INQUIRE( FILE = 'subbasins.nc', EXIST = ll_exist ) 264 nbasin = 1 + 4 * COUNT( (/ll_exist/) ) 265 CALL iom_set_axis_attr( "basin" , (/ (REAL(ji,wp), ji=1,nbasin) /) ) 250 266 ENDIF 251 267 ! 252 268 ! automatic definitions of some of the xml attributs 253 IF( TRIM(cdname) == TRIM(crxios_context) ) THEN 254 !set names of the fields in restart file IF using XIOS to read data 255 CALL iom_set_rst_context(.TRUE.) 256 CALL iom_set_rst_vars(rst_rfields) 257 !set which fields are to be read from restart file 258 CALL iom_set_rstr_active() 259 ELSE IF( TRIM(cdname) == TRIM(cwxios_context) ) THEN 260 !set names of the fields in restart file IF using XIOS to write data 261 CALL iom_set_rst_context(.FALSE.) 262 CALL iom_set_rst_vars(rst_wfields) 263 !set which fields are to be written to a restart file 264 CALL iom_set_rstw_active(fname) 269 IF(llrstr) THEN 270 IF(PRESENT(kdid)) THEN 271 CALL iom_set_rst_context(.TRUE.) 272 !set which fields will be read from restart file 273 CALL iom_set_vars_active(kdid) 274 ELSE 275 CALL ctl_stop( 'iom_init:', 'restart read with XIOS: missing pointer to NETCDF file' ) 276 ENDIF 277 ELSE IF(llrstw) THEN 278 CALL iom_set_rstw_file(iom_file(kdid)%name) 265 279 ELSE 266 280 CALL set_xmlatt 267 281 ENDIF 268 282 ! … … 280 294 END SUBROUTINE iom_init 281 295 282 SUBROUTINE iom_init_closedef 296 SUBROUTINE iom_init_closedef(cdname) 283 297 !!---------------------------------------------------------------------- 284 298 !! *** SUBROUTINE iom_init_closedef *** … … 288 302 !! 289 303 !!---------------------------------------------------------------------- 290 304 CHARACTER(len=*), OPTIONAL, INTENT(IN) :: cdname 291 305 #if defined key_iomput 292 CALL xios_close_context_definition() 293 CALL xios_update_calendar( 0 ) 306 LOGICAL :: llrstw 307 308 llrstw = .FALSE. 309 IF(PRESENT(cdname)) THEN 310 llrstw = (cdname == cw_ocerst_cxt) 311 llrstw = llrstw .OR. (cdname == cw_icerst_cxt) 312 llrstw = llrstw .OR. (cdname == cw_toprst_cxt) 313 llrstw = llrstw .OR. (cdname == cw_sedrst_cxt) 314 ENDIF 315 316 IF( llrstw ) THEN 317 !set names of the fields in restart file IF using XIOS to write data 318 CALL iom_set_rst_context(.FALSE.) 319 CALL xios_close_context_definition() 320 ELSE 321 CALL xios_close_context_definition() 322 CALL xios_update_calendar( 0 ) 323 ENDIF 294 324 #else 295 325 IF( .FALSE. ) WRITE(numout,*) 'iom_init_closedef: should not see this' ! useless statement to avoid compilation warnings … … 298 328 END SUBROUTINE iom_init_closedef 299 329 300 SUBROUTINE iom_set_ rstw_var_active(field)330 SUBROUTINE iom_set_vars_active(idnum) 301 331 !!--------------------------------------------------------------------- 302 !! *** SUBROUTINE iom_set_rstw_var_active *** 303 !! 304 !! ** Purpose : enable variable in restart file when writing with XIOS 332 !! *** SUBROUTINE iom_set_vars_active *** 333 !! 334 !! ** Purpose : define filename in XIOS context for reading file, 335 !! enable variables present in a file for reading with XIOS 336 !! id of the file is assumed to be rrestart. 305 337 !!--------------------------------------------------------------------- 306 CHARACTER(len = *), INTENT(IN) :: field 307 INTEGER :: i 308 LOGICAL :: llis_set 309 CHARACTER(LEN=256) :: clinfo ! info character 310 338 INTEGER, INTENT(IN) :: idnum 339 311 340 #if defined key_iomput 312 llis_set = .FALSE. 313 314 DO i = 1, max_rst_fields 315 IF(TRIM(rst_wfields(i)%vname) == field) THEN 316 rst_wfields(i)%active = .TRUE. 317 llis_set = .TRUE. 318 EXIT 319 ENDIF 320 ENDDO 321 !Warn if variable is not in defined in rst_wfields 322 IF(.NOT.llis_set) THEN 323 WRITE(ctmp1,*) 'iom_set_rstw_var_active: variable ', field ,' is available for writing but not defined' 324 CALL ctl_stop( 'iom_set_rstw_var_active:', ctmp1 ) 325 ENDIF 326 #else 327 clinfo = 'iom_set_rstw_var_active: key_iomput is needed to use XIOS restart read/write functionality' 328 CALL ctl_stop('STOP', TRIM(clinfo)) 329 #endif 330 331 END SUBROUTINE iom_set_rstw_var_active 332 333 SUBROUTINE iom_set_rstr_active() 341 INTEGER :: ndims, nvars, natts, unlimitedDimId, dimlen, xtype,mdims 342 TYPE(xios_field) :: field_hdl 343 TYPE(xios_file) :: file_hdl 344 TYPE(xios_filegroup) :: filegroup_hdl 345 INTEGER :: dimids(4), jv,i, idim 346 CHARACTER(LEN=256) :: clinfo ! info character 347 INTEGER, ALLOCATABLE :: indimlens(:) 348 CHARACTER(LEN=nf90_max_name), ALLOCATABLE :: indimnames(:) 349 CHARACTER(LEN=nf90_max_name) :: dimname, varname 350 INTEGER :: iln 351 CHARACTER(LEN=lc) :: fname 352 LOGICAL :: lmeta 353 !metadata in restart file for restart read with XIOS 354 INTEGER, PARAMETER :: NMETA = 10 355 CHARACTER(LEN=lc) :: meta(NMETA) 356 357 358 meta(1) = "nav_lat" 359 meta(2) = "nav_lon" 360 meta(3) = "nav_lev" 361 meta(4) = "time_instant" 362 meta(5) = "time_instant_bounds" 363 meta(6) = "time_counter" 364 meta(7) = "time_counter_bounds" 365 meta(8) = "x" 366 meta(9) = "y" 367 meta(10) = "numcat" 368 369 clinfo = ' iom_set_vars_active, file: '//TRIM(iom_file(idnum)%name) 370 371 iln = INDEX( iom_file(idnum)%name, '.nc' ) 372 !XIOS doee not need .nc 373 IF(iln > 0) THEN 374 fname = iom_file(idnum)%name(1:iln-1) 375 ELSE 376 fname = iom_file(idnum)%name 377 ENDIF 378 379 !set name of the restart file and enable available fields 380 CALL xios_get_handle("file_definition", filegroup_hdl ) 381 CALL xios_add_child(filegroup_hdl, file_hdl, 'rrestart') 382 CALL xios_set_file_attr( "rrestart", name=fname, type="one_file", & 383 par_access="collective", enabled=.TRUE., mode="read", & 384 output_freq=xios_timestep ) 385 386 CALL iom_nf90_check( nf90_inquire(iom_file(idnum)%nfid, ndims, nvars, natts ), clinfo ) 387 ALLOCATE(indimlens(ndims), indimnames(ndims)) 388 CALL iom_nf90_check( nf90_inquire(iom_file(idnum)%nfid, unlimitedDimId = unlimitedDimId ), clinfo ) 389 390 DO idim = 1, ndims 391 CALL iom_nf90_check( nf90_inquire_dimension(iom_file(idnum)%nfid, idim, dimname, dimlen ), clinfo ) 392 indimlens(idim) = dimlen 393 indimnames(idim) = dimname 394 ENDDO 395 396 DO jv =1, nvars 397 lmeta = .FALSE. 398 CALL iom_nf90_check( nf90_inquire_variable(iom_file(idnum)%nfid, jv, varname, xtype, ndims, dimids, natts ), clinfo ) 399 DO i = 1, NMETA 400 IF(varname == meta(i)) THEN 401 lmeta = .TRUE. 402 ENDIF 403 ENDDO 404 IF(.NOT.lmeta) THEN 405 CALL xios_add_child(file_hdl, field_hdl, varname) 406 mdims = ndims 407 408 IF(ANY(dimids(1:ndims) == unlimitedDimId)) THEN 409 mdims = mdims - 1 410 ENDIF 411 412 IF(mdims == 3) THEN 413 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname, & 414 domain_ref="grid_N", & 415 axis_ref=iom_axis(indimlens(dimids(mdims))), & 416 prec = 8, operation = "instant" ) 417 ELSEIF(mdims == 2) THEN 418 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname, & 419 domain_ref="grid_N", prec = 8, & 420 operation = "instant" ) 421 ELSEIF(mdims == 1) THEN 422 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname, & 423 axis_ref=iom_axis(indimlens(dimids(mdims))), & 424 prec = 8, operation = "instant" ) 425 ELSEIF(mdims == 0) THEN 426 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname, & 427 scalar_ref = "grid_scalar", prec = 8, & 428 operation = "instant" ) 429 ELSE 430 WRITE(ctmp1,*) 'iom_set_vars_active: variable ', TRIM(varname) ,' incorrect number of dimensions' 431 CALL ctl_stop( 'iom_set_vars_active:', ctmp1 ) 432 ENDIF 433 ENDIF 434 ENDDO 435 DEALLOCATE(indimlens, indimnames) 436 #endif 437 END SUBROUTINE iom_set_vars_active 438 439 SUBROUTINE iom_set_rstw_file(cdrst_file) 334 440 !!--------------------------------------------------------------------- 335 !! *** SUBROUTINE iom_set_rstr_active *** 336 !! 337 !! ** Purpose : define file name in XIOS context for reading restart file, 338 !! enable variables present in restart file for reading with XIOS 441 !! *** SUBROUTINE iom_set_rstw_file *** 442 !! 443 !! ** Purpose : define file name in XIOS context for writing restart 339 444 !!--------------------------------------------------------------------- 340 341 !sets enabled = .TRUE. for each field in restart file 342 CHARACTER(len=256) :: rst_file 343 445 CHARACTER(len=*) :: cdrst_file 344 446 #if defined key_iomput 345 TYPE(xios_field) :: field_hdl 346 TYPE(xios_file) :: file_hdl 347 TYPE(xios_filegroup) :: filegroup_hdl 348 INTEGER :: i 349 CHARACTER(lc) :: clpath 350 351 clpath = TRIM(cn_ocerst_indir) 352 IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 353 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 354 rst_file = TRIM(clpath)//TRIM(cn_ocerst_in) 355 ELSE 356 rst_file = TRIM(clpath)//TRIM(Agrif_CFixed())//'_'//TRIM(cn_ocerst_in) 357 ENDIF 447 TYPE(xios_file) :: file_hdl 448 TYPE(xios_filegroup) :: filegroup_hdl 449 358 450 !set name of the restart file and enable available fields 359 if(lwp) WRITE(numout,*) 'Setting restart filename (for XIOS) to: ',rst_file 360 CALL xios_get_handle("file_definition", filegroup_hdl ) 361 CALL xios_add_child(filegroup_hdl, file_hdl, 'rrestart') 362 CALL xios_set_file_attr( "rrestart", name=trim(rst_file), type="one_file", & 363 par_access="collective", enabled=.TRUE., mode="read", & 364 output_freq=xios_timestep) 365 !define variables for restart context 366 DO i = 1, max_rst_fields 367 IF( TRIM(rst_rfields(i)%vname) /= "NO_NAME") THEN 368 IF( iom_varid( numror, TRIM(rst_rfields(i)%vname), ldstop = .FALSE. ) > 0 ) THEN 369 CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_rfields(i)%vname)) 370 SELECT CASE (TRIM(rst_rfields(i)%grid)) 371 CASE ("grid_N_3D") 372 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 373 domain_ref="grid_N", axis_ref="nav_lev", operation = "instant") 374 CASE ("grid_N") 375 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 376 domain_ref="grid_N", operation = "instant") 377 CASE ("grid_vector") 378 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 379 axis_ref="nav_lev", operation = "instant") 380 CASE ("grid_scalar") 381 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 382 scalar_ref = "grid_scalar", operation = "instant") 383 END SELECT 384 IF(lwp) WRITE(numout,*) 'XIOS read: ', TRIM(rst_rfields(i)%vname), ' enabled in ', TRIM(rst_file) 385 ENDIF 386 ENDIF 387 END DO 388 #endif 389 END SUBROUTINE iom_set_rstr_active 390 391 SUBROUTINE iom_set_rstw_core(cdmdl) 392 !!--------------------------------------------------------------------- 393 !! *** SUBROUTINE iom_set_rstw_core *** 394 !! 395 !! ** Purpose : set variables which are always in restart file 396 !!--------------------------------------------------------------------- 397 CHARACTER (len=*), INTENT (IN) :: cdmdl ! model OPA or SAS 398 CHARACTER(LEN=256) :: clinfo ! info character 399 #if defined key_iomput 400 IF(cdmdl == "OPA") THEN 401 !from restart.F90 402 CALL iom_set_rstw_var_active("rn_Dt") 403 IF ( .NOT. ln_diurnal_only ) THEN 404 CALL iom_set_rstw_var_active('ub' ) 405 CALL iom_set_rstw_var_active('vb' ) 406 CALL iom_set_rstw_var_active('tb' ) 407 CALL iom_set_rstw_var_active('sb' ) 408 CALL iom_set_rstw_var_active('sshb') 409 ! 410 CALL iom_set_rstw_var_active('un' ) 411 CALL iom_set_rstw_var_active('vn' ) 412 CALL iom_set_rstw_var_active('tn' ) 413 CALL iom_set_rstw_var_active('sn' ) 414 CALL iom_set_rstw_var_active('sshn') 415 CALL iom_set_rstw_var_active('rhop') 416 ENDIF 417 IF(ln_diurnal) CALL iom_set_rstw_var_active('Dsst') 418 !from trasbc.F90 419 CALL iom_set_rstw_var_active('sbc_hc_b') 420 CALL iom_set_rstw_var_active('sbc_sc_b') 421 ENDIF 422 #else 423 clinfo = 'iom_set_rstw_core: key_iomput is needed to use XIOS restart read/write functionality' 424 CALL ctl_stop('STOP', TRIM(clinfo)) 425 #endif 426 END SUBROUTINE iom_set_rstw_core 427 428 SUBROUTINE iom_set_rst_vars(fields) 429 !!--------------------------------------------------------------------- 430 !! *** SUBROUTINE iom_set_rst_vars *** 431 !! 432 !! ** Purpose : Fill array fields with the information about all 433 !! possible variables and corresponding grids definition 434 !! for reading/writing restart with XIOS 435 !!--------------------------------------------------------------------- 436 TYPE(RST_FIELD), INTENT(INOUT) :: fields(max_rst_fields) 437 INTEGER :: i 438 439 i = 0 440 i = i + 1; fields(i)%vname="rn_Dt"; fields(i)%grid="grid_scalar" 441 i = i + 1; fields(i)%vname="un"; fields(i)%grid="grid_N_3D" 442 i = i + 1; fields(i)%vname="ub"; fields(i)%grid="grid_N_3D" 443 i = i + 1; fields(i)%vname="vn"; fields(i)%grid="grid_N_3D" 444 i = i + 1; fields(i)%vname="vb"; fields(i)%grid="grid_N_3D" 445 i = i + 1; fields(i)%vname="tn"; fields(i)%grid="grid_N_3D" 446 i = i + 1; fields(i)%vname="tb"; fields(i)%grid="grid_N_3D" 447 i = i + 1; fields(i)%vname="sn"; fields(i)%grid="grid_N_3D" 448 i = i + 1; fields(i)%vname="sb"; fields(i)%grid="grid_N_3D" 449 i = i + 1; fields(i)%vname="sshn"; fields(i)%grid="grid_N" 450 i = i + 1; fields(i)%vname="sshb"; fields(i)%grid="grid_N" 451 i = i + 1; fields(i)%vname="rhop"; fields(i)%grid="grid_N_3D" 452 i = i + 1; fields(i)%vname="kt"; fields(i)%grid="grid_scalar" 453 i = i + 1; fields(i)%vname="ndastp"; fields(i)%grid="grid_scalar" 454 i = i + 1; fields(i)%vname="adatrj"; fields(i)%grid="grid_scalar" 455 i = i + 1; fields(i)%vname="utau_b"; fields(i)%grid="grid_N" 456 i = i + 1; fields(i)%vname="vtau_b"; fields(i)%grid="grid_N" 457 i = i + 1; fields(i)%vname="qns_b"; fields(i)%grid="grid_N" 458 i = i + 1; fields(i)%vname="emp_b"; fields(i)%grid="grid_N" 459 i = i + 1; fields(i)%vname="sfx_b"; fields(i)%grid="grid_N" 460 i = i + 1; fields(i)%vname="en" ; fields(i)%grid="grid_N_3D" 461 i = i + 1; fields(i)%vname="avt_k"; fields(i)%grid="grid_N_3D" 462 i = i + 1; fields(i)%vname="avm_k"; fields(i)%grid="grid_N_3D" 463 i = i + 1; fields(i)%vname="dissl"; fields(i)%grid="grid_N_3D" 464 i = i + 1; fields(i)%vname="sbc_hc_b"; fields(i)%grid="grid_N" 465 i = i + 1; fields(i)%vname="sbc_sc_b"; fields(i)%grid="grid_N" 466 i = i + 1; fields(i)%vname="qsr_hc_b"; fields(i)%grid="grid_N_3D" 467 i = i + 1; fields(i)%vname="fraqsr_1lev"; fields(i)%grid="grid_N" 468 i = i + 1; fields(i)%vname="greenland_icesheet_mass" 469 fields(i)%grid="grid_scalar" 470 i = i + 1; fields(i)%vname="greenland_icesheet_timelapsed" 471 fields(i)%grid="grid_scalar" 472 i = i + 1; fields(i)%vname="greenland_icesheet_mass_roc" 473 fields(i)%grid="grid_scalar" 474 i = i + 1; fields(i)%vname="antarctica_icesheet_mass" 475 fields(i)%grid="grid_scalar" 476 i = i + 1; fields(i)%vname="antarctica_icesheet_timelapsed" 477 fields(i)%grid="grid_scalar" 478 i = i + 1; fields(i)%vname="antarctica_icesheet_mass_roc" 479 fields(i)%grid="grid_scalar" 480 i = i + 1; fields(i)%vname="frc_v"; fields(i)%grid="grid_scalar" 481 i = i + 1; fields(i)%vname="frc_t"; fields(i)%grid="grid_scalar" 482 i = i + 1; fields(i)%vname="frc_s"; fields(i)%grid="grid_scalar" 483 i = i + 1; fields(i)%vname="frc_wn_t"; fields(i)%grid="grid_scalar" 484 i = i + 1; fields(i)%vname="frc_wn_s"; fields(i)%grid="grid_scalar" 485 i = i + 1; fields(i)%vname="ssh_ini"; fields(i)%grid="grid_N" 486 i = i + 1; fields(i)%vname="e3t_ini"; fields(i)%grid="grid_N_3D" 487 i = i + 1; fields(i)%vname="hc_loc_ini"; fields(i)%grid="grid_N_3D" 488 i = i + 1; fields(i)%vname="sc_loc_ini"; fields(i)%grid="grid_N_3D" 489 i = i + 1; fields(i)%vname="ssh_hc_loc_ini"; fields(i)%grid="grid_N" 490 i = i + 1; fields(i)%vname="ssh_sc_loc_ini"; fields(i)%grid="grid_N" 491 i = i + 1; fields(i)%vname="tilde_e3t_b"; fields(i)%grid="grid_N" 492 i = i + 1; fields(i)%vname="tilde_e3t_n"; fields(i)%grid="grid_N" 493 i = i + 1; fields(i)%vname="hdiv_lf"; fields(i)%grid="grid_N" 494 i = i + 1; fields(i)%vname="ub2_b"; fields(i)%grid="grid_N" 495 i = i + 1; fields(i)%vname="vb2_b"; fields(i)%grid="grid_N" 496 i = i + 1; fields(i)%vname="sshbb_e"; fields(i)%grid="grid_N" 497 i = i + 1; fields(i)%vname="ubb_e"; fields(i)%grid="grid_N" 498 i = i + 1; fields(i)%vname="vbb_e"; fields(i)%grid="grid_N" 499 i = i + 1; fields(i)%vname="sshb_e"; fields(i)%grid="grid_N" 500 i = i + 1; fields(i)%vname="ub_e"; fields(i)%grid="grid_N" 501 i = i + 1; fields(i)%vname="vb_e"; fields(i)%grid="grid_N" 502 i = i + 1; fields(i)%vname="fwf_isf_b"; fields(i)%grid="grid_N" 503 i = i + 1; fields(i)%vname="isf_sc_b"; fields(i)%grid="grid_N" 504 i = i + 1; fields(i)%vname="isf_hc_b"; fields(i)%grid="grid_N" 505 i = i + 1; fields(i)%vname="ssh_ibb"; fields(i)%grid="grid_N" 506 i = i + 1; fields(i)%vname="rnf_b"; fields(i)%grid="grid_N" 507 i = i + 1; fields(i)%vname="rnf_hc_b"; fields(i)%grid="grid_N" 508 i = i + 1; fields(i)%vname="rnf_sc_b"; fields(i)%grid="grid_N" 509 i = i + 1; fields(i)%vname="nn_fsbc"; fields(i)%grid="grid_scalar" 510 i = i + 1; fields(i)%vname="ssu_m"; fields(i)%grid="grid_N" 511 i = i + 1; fields(i)%vname="ssv_m"; fields(i)%grid="grid_N" 512 i = i + 1; fields(i)%vname="sst_m"; fields(i)%grid="grid_N" 513 i = i + 1; fields(i)%vname="sss_m"; fields(i)%grid="grid_N" 514 i = i + 1; fields(i)%vname="ssh_m"; fields(i)%grid="grid_N" 515 i = i + 1; fields(i)%vname="e3t_m"; fields(i)%grid="grid_N" 516 i = i + 1; fields(i)%vname="frq_m"; fields(i)%grid="grid_N" 517 i = i + 1; fields(i)%vname="avmb"; fields(i)%grid="grid_vector" 518 i = i + 1; fields(i)%vname="avtb"; fields(i)%grid="grid_vector" 519 i = i + 1; fields(i)%vname="ub2_i_b"; fields(i)%grid="grid_N" 520 i = i + 1; fields(i)%vname="vb2_i_b"; fields(i)%grid="grid_N" 521 i = i + 1; fields(i)%vname="ntime"; fields(i)%grid="grid_scalar" 522 i = i + 1; fields(i)%vname="Dsst"; fields(i)%grid="grid_scalar" 523 i = i + 1; fields(i)%vname="tmask"; fields(i)%grid="grid_N_3D" 524 i = i + 1; fields(i)%vname="umask"; fields(i)%grid="grid_N_3D" 525 i = i + 1; fields(i)%vname="vmask"; fields(i)%grid="grid_N_3D" 526 i = i + 1; fields(i)%vname="smask"; fields(i)%grid="grid_N_3D" 527 i = i + 1; fields(i)%vname="gdepw_n"; fields(i)%grid="grid_N_3D" 528 i = i + 1; fields(i)%vname="e3t_n"; fields(i)%grid="grid_N_3D" 529 i = i + 1; fields(i)%vname="e3u_n"; fields(i)%grid="grid_N_3D" 530 i = i + 1; fields(i)%vname="e3v_n"; fields(i)%grid="grid_N_3D" 531 i = i + 1; fields(i)%vname="surf_ini"; fields(i)%grid="grid_N" 532 i = i + 1; fields(i)%vname="e3t_b"; fields(i)%grid="grid_N_3D" 533 i = i + 1; fields(i)%vname="hmxl_n"; fields(i)%grid="grid_N_3D" 534 i = i + 1; fields(i)%vname="un_bf"; fields(i)%grid="grid_N" 535 i = i + 1; fields(i)%vname="vn_bf"; fields(i)%grid="grid_N" 536 i = i + 1; fields(i)%vname="hbl"; fields(i)%grid="grid_N" 537 i = i + 1; fields(i)%vname="hbli"; fields(i)%grid="grid_N" 538 i = i + 1; fields(i)%vname="wn"; fields(i)%grid="grid_N_3D" 539 540 IF( i-1 > max_rst_fields) THEN 541 WRITE(ctmp1,*) 'E R R O R : iom_set_rst_vars SIZE of RST_FIELD array is too small' 542 CALL ctl_stop( 'iom_set_rst_vars:', ctmp1 ) 543 ENDIF 544 END SUBROUTINE iom_set_rst_vars 545 546 547 SUBROUTINE iom_set_rstw_active(cdrst_file) 451 IF(lwp) WRITE(numout,*) 'Setting restart filename (for XIOS write) to: ', TRIM(cdrst_file) 452 CALL xios_get_handle("file_definition", filegroup_hdl ) 453 CALL xios_add_child(filegroup_hdl, file_hdl, 'wrestart') 454 IF(nxioso.eq.1) THEN 455 CALL xios_set_file_attr( "wrestart", type="one_file", enabled=.TRUE.,& 456 mode="write", output_freq=xios_timestep) 457 IF(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in one_file mode' 458 ELSE 459 CALL xios_set_file_attr( "wrestart", type="multiple_file", enabled=.TRUE.,& 460 mode="write", output_freq=xios_timestep) 461 IF(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in multiple_file mode' 462 ENDIF 463 CALL xios_set_file_attr( "wrestart", name=trim(cdrst_file)) 464 #endif 465 END SUBROUTINE iom_set_rstw_file 466 467 468 SUBROUTINE iom_set_rstw_active(sdfield, rd0, rs0, rd1, rs1, rd2, rs2, rd3, rs3) 548 469 !!--------------------------------------------------------------------- 549 470 !! *** SUBROUTINE iom_set_rstw_active *** … … 553 474 !!--------------------------------------------------------------------- 554 475 !sets enabled = .TRUE. for each field in restart file 555 CHARACTER(len=*) :: cdrst_file 476 CHARACTER(len = *), INTENT(IN) :: sdfield 477 REAL(dp), OPTIONAL, INTENT(IN) :: rd0 478 REAL(sp), OPTIONAL, INTENT(IN) :: rs0 479 REAL(dp), OPTIONAL, INTENT(IN), DIMENSION(:) :: rd1 480 REAL(sp), OPTIONAL, INTENT(IN), DIMENSION(:) :: rs1 481 REAL(dp), OPTIONAL, INTENT(IN), DIMENSION(:, :) :: rd2 482 REAL(sp), OPTIONAL, INTENT(IN), DIMENSION(:, :) :: rs2 483 REAL(dp), OPTIONAL, INTENT(IN), DIMENSION(:, :, :) :: rd3 484 REAL(sp), OPTIONAL, INTENT(IN), DIMENSION(:, :, :) :: rs3 556 485 #if defined key_iomput 557 TYPE(xios_field) :: field_hdl 558 TYPE(xios_file) :: file_hdl 559 TYPE(xios_filegroup) :: filegroup_hdl 560 INTEGER :: i 561 CHARACTER(lc) :: clpath 562 563 !set name of the restart file and enable available fields 564 IF(lwp) WRITE(numout,*) 'Setting restart filename (for XIOS write) to: ',cdrst_file 565 CALL xios_get_handle("file_definition", filegroup_hdl ) 566 CALL xios_add_child(filegroup_hdl, file_hdl, 'wrestart') 567 IF(nxioso.eq.1) THEN 568 CALL xios_set_file_attr( "wrestart", type="one_file", enabled=.TRUE.,& 569 mode="write", output_freq=xios_timestep) 570 if(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in one_file mode' 571 ELSE 572 CALL xios_set_file_attr( "wrestart", type="multiple_file", enabled=.TRUE.,& 573 mode="write", output_freq=xios_timestep) 574 if(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in multiple_file mode' 575 ENDIF 576 CALL xios_set_file_attr( "wrestart", name=trim(cdrst_file)) 486 TYPE(xios_field) :: field_hdl 487 TYPE(xios_file) :: file_hdl 488 489 CALL xios_get_handle("wrestart", file_hdl) 577 490 !define fields for restart context 578 DO i = 1, max_rst_fields 579 IF( rst_wfields(i)%active ) THEN 580 CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_wfields(i)%vname)) 581 SELECT CASE (TRIM(rst_wfields(i)%grid)) 582 CASE ("grid_N_3D") 583 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 584 domain_ref="grid_N", axis_ref="nav_lev", prec = 8, operation = "instant") 585 CASE ("grid_N") 586 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 587 domain_ref="grid_N", prec = 8, operation = "instant") 588 CASE ("grid_vector") 589 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 590 axis_ref="nav_lev", prec = 8, operation = "instant") 591 CASE ("grid_scalar") 592 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 593 scalar_ref = "grid_scalar", prec = 8, operation = "instant") 594 END SELECT 595 ENDIF 596 END DO 491 CALL xios_add_child(file_hdl, field_hdl, sdfield) 492 493 IF(PRESENT(rd3)) THEN 494 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & 495 domain_ref = "grid_N", & 496 axis_ref = iom_axis(size(rd3, 3)), & 497 prec = 8, operation = "instant" ) 498 ELSEIF(PRESENT(rs3)) THEN 499 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & 500 domain_ref = "grid_N", & 501 axis_ref = iom_axis(size(rd3, 3)), & 502 prec = 4, operation = "instant" ) 503 ELSEIF(PRESENT(rd2)) THEN 504 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & 505 domain_ref = "grid_N", prec = 8, & 506 operation = "instant" ) 507 ELSEIF(PRESENT(rs2)) THEN 508 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & 509 domain_ref = "grid_N", prec = 4, & 510 operation = "instant" ) 511 ELSEIF(PRESENT(rd1)) THEN 512 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & 513 axis_ref = iom_axis(size(rd1, 1)), & 514 prec = 8, operation = "instant" ) 515 ELSEIF(PRESENT(rs1)) THEN 516 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & 517 axis_ref = iom_axis(size(rd1, 1)), & 518 prec = 4, operation = "instant" ) 519 ELSEIF(PRESENT(rd0)) THEN 520 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & 521 scalar_ref = "grid_scalar", prec = 8, & 522 operation = "instant" ) 523 ELSEIF(PRESENT(rs0)) THEN 524 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & 525 scalar_ref = "grid_scalar", prec = 4, & 526 operation = "instant" ) 527 ENDIF 597 528 #endif 598 529 END SUBROUTINE iom_set_rstw_active 599 530 531 FUNCTION iom_axis(idlev) result(axis_ref) 532 !!--------------------------------------------------------------------- 533 !! *** FUNCTION iom_axis *** 534 !! 535 !! ** Purpose : Used for grid definition when XIOS is used to read/write 536 !! restart. Returns axis corresponding to the number of levels 537 !! given as an input variable. Axes are defined in routine 538 !! iom_set_rst_context 539 !!--------------------------------------------------------------------- 540 INTEGER, INTENT(IN) :: idlev 541 CHARACTER(len=lc) :: axis_ref 542 CHARACTER(len=12) :: str 543 IF(idlev == jpk) THEN 544 axis_ref="nav_lev" 545 #if defined key_si3 546 ELSEIF(idlev == jpl) THEN 547 axis_ref="numcat" 548 #endif 549 ELSE 550 write(str, *) idlev 551 CALL ctl_stop( 'iom_axis', 'Definition for axis with '//TRIM(ADJUSTL(str))//' levels missing') 552 ENDIF 553 END FUNCTION iom_axis 554 555 FUNCTION iom_xios_setid(cdname) result(kid) 556 !!--------------------------------------------------------------------- 557 !! *** FUNCTION *** 558 !! 559 !! ** Purpose : this function returns first available id to keep information about file 560 !! sets filename in iom_file structure and sets name 561 !! of XIOS context depending on cdcomp 562 !! corresponds to iom_nf90_open 563 !!--------------------------------------------------------------------- 564 CHARACTER(len=*), INTENT(in ) :: cdname ! File name 565 INTEGER :: kid ! identifier of the opened file 566 INTEGER :: jl 567 568 kid = 0 569 DO jl = jpmax_files, 1, -1 570 IF( iom_file(jl)%nfid == 0 ) kid = jl 571 ENDDO 572 573 iom_file(kid)%name = TRIM(cdname) 574 iom_file(kid)%nfid = 1 575 iom_file(kid)%nvars = 0 576 iom_file(kid)%irec = -1 577 578 END FUNCTION iom_xios_setid 579 600 580 SUBROUTINE iom_set_rst_context(ld_rstr) 601 !!---------------------------------------------------------------------581 !!--------------------------------------------------------------------- 602 582 !! *** SUBROUTINE iom_set_rst_context *** 603 583 !! … … 606 586 !! 607 587 !!--------------------------------------------------------------------- 608 LOGICAL, INTENT(IN) :: ld_rstr 609 !ld_rstr is true for restart context. There is no need to define grid for 610 !restart read, because it's read from file 588 LOGICAL, INTENT(IN) :: ld_rstr 589 INTEGER :: ji 611 590 #if defined key_iomput 612 TYPE(xios_domaingroup) :: domaingroup_hdl613 TYPE(xios_domain) :: domain_hdl614 TYPE(xios_axisgroup) :: axisgroup_hdl615 TYPE(xios_axis) :: axis_hdl616 TYPE(xios_scalar) :: scalar_hdl617 TYPE(xios_scalargroup) :: scalargroup_hdl618 619 CALL xios_get_handle("domain_definition",domaingroup_hdl)620 CALL xios_add_child(domaingroup_hdl, domain_hdl, "grid_N")621 CALL set_grid("N", glamt, gphit, .TRUE., ld_rstr)591 TYPE(xios_domaingroup) :: domaingroup_hdl 592 TYPE(xios_domain) :: domain_hdl 593 TYPE(xios_axisgroup) :: axisgroup_hdl 594 TYPE(xios_axis) :: axis_hdl 595 TYPE(xios_scalar) :: scalar_hdl 596 TYPE(xios_scalargroup) :: scalargroup_hdl 597 598 CALL xios_get_handle("domain_definition",domaingroup_hdl) 599 CALL xios_add_child(domaingroup_hdl, domain_hdl, "grid_N") 600 CALL set_grid("N", glamt, gphit, .TRUE., ld_rstr) 622 601 623 CALL xios_get_handle("axis_definition",axisgroup_hdl)624 CALL xios_add_child(axisgroup_hdl, axis_hdl, "nav_lev")602 CALL xios_get_handle("axis_definition",axisgroup_hdl) 603 CALL xios_add_child(axisgroup_hdl, axis_hdl, "nav_lev") 625 604 !AGRIF fails to compile when unit= is in call to xios_set_axis_attr 626 ! CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels", unit="m", positive="down") 627 CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels in meters", positive="down") 628 CALL iom_set_axis_attr( "nav_lev", paxis = gdept_1d ) 629 630 CALL xios_get_handle("scalar_definition", scalargroup_hdl) 631 CALL xios_add_child(scalargroup_hdl, scalar_hdl, "grid_scalar") 605 ! CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels", unit="m", positive="down") 606 CALL xios_set_axis_attr( "nav_lev", long_name = "Vertical levels in meters", positive = "down") 607 CALL iom_set_axis_attr( "nav_lev", paxis = gdept_1d ) 608 #if defined key_si3 609 CALL xios_add_child(axisgroup_hdl, axis_hdl, "numcat") 610 CALL iom_set_axis_attr( "numcat", (/ (REAL(ji,wp), ji=1,jpl) /) ) 611 #endif 612 CALL xios_get_handle("scalar_definition", scalargroup_hdl) 613 CALL xios_add_child(scalargroup_hdl, scalar_hdl, "grid_scalar") 632 614 #endif 633 615 END SUBROUTINE iom_set_rst_context 616 617 618 SUBROUTINE set_xios_context(kdid, cdcont) 619 !!--------------------------------------------------------------------- 620 !! *** SUBROUTINE iom_set_rst_context *** 621 !! 622 !! ** Purpose : set correct XIOS context based on kdid 623 !! 624 !!--------------------------------------------------------------------- 625 INTEGER, INTENT(IN) :: kdid ! Identifier of the file 626 CHARACTER(LEN=lc), INTENT(OUT) :: cdcont ! name of the context for XIOS read/write 627 628 cdcont = "NONE" 629 630 IF(lrxios) THEN 631 IF(kdid == numror) THEN 632 cdcont = cr_ocerst_cxt 633 ELSEIF(kdid == numrir) THEN 634 cdcont = cr_icerst_cxt 635 ELSEIF(kdid == numrtr) THEN 636 cdcont = cr_toprst_cxt 637 ELSEIF(kdid == numrsr) THEN 638 cdcont = cr_sedrst_cxt 639 ENDIF 640 ENDIF 641 642 IF(lwxios) THEN 643 IF(kdid == numrow) THEN 644 cdcont = cw_ocerst_cxt 645 ELSEIF(kdid == numriw) THEN 646 cdcont = cw_icerst_cxt 647 ELSEIF(kdid == numrtw) THEN 648 cdcont = cw_toprst_cxt 649 ELSEIF(kdid == numrsw) THEN 650 cdcont = cw_sedrst_cxt 651 ENDIF 652 ENDIF 653 END SUBROUTINE set_xios_context 654 634 655 635 656 SUBROUTINE iom_swap( cdname ) … … 642 663 #if defined key_iomput 643 664 TYPE(xios_context) :: nemo_hdl 644 645 665 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 646 666 CALL xios_get_handle(TRIM(cdname),nemo_hdl) … … 892 912 !! INTERFACE iom_get 893 913 !!---------------------------------------------------------------------- 894 SUBROUTINE iom_g0d_sp( kiomid, cdvar, pvar, ktime , ldxios)914 SUBROUTINE iom_g0d_sp( kiomid, cdvar, pvar, ktime ) 895 915 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 896 916 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable … … 898 918 REAL(dp) :: ztmp_pvar ! tmp var to read field 899 919 INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number 900 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use xios to read restart901 920 ! 902 921 INTEGER :: idvar ! variable id … … 906 925 CHARACTER(LEN=100) :: clname ! file name 907 926 CHARACTER(LEN=1) :: cldmspc ! 908 LOGICAL :: llxios 909 ! 910 llxios = .FALSE. 911 IF( PRESENT(ldxios) ) llxios = ldxios 912 913 IF(.NOT.llxios) THEN ! read data using default library 927 CHARACTER(LEN=lc) :: context 928 ! 929 CALL set_xios_context(kiomid, context) 930 931 IF(context == "NONE") THEN ! read data using default library 914 932 itime = 1 915 933 IF( PRESENT(ktime) ) itime = ktime … … 934 952 #if defined key_iomput 935 953 IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', trim(cdvar) 936 CALL iom_swap( TRIM(crxios_context))954 CALL iom_swap(context) 937 955 CALL xios_recv_field( trim(cdvar), pvar) 938 CALL iom_swap( TRIM(cxios_context))956 CALL iom_swap(cxios_context) 939 957 #else 940 958 WRITE(ctmp1,*) 'Can not use XIOS in iom_g0d, file: '//trim(clname)//', var:'//trim(cdvar) … … 944 962 END SUBROUTINE iom_g0d_sp 945 963 946 SUBROUTINE iom_g0d_dp( kiomid, cdvar, pvar, ktime , ldxios)964 SUBROUTINE iom_g0d_dp( kiomid, cdvar, pvar, ktime ) 947 965 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 948 966 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 949 967 REAL(dp) , INTENT( out) :: pvar ! read field 950 968 INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number 951 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use xios to read restart952 969 ! 953 970 INTEGER :: idvar ! variable id … … 957 974 CHARACTER(LEN=100) :: clname ! file name 958 975 CHARACTER(LEN=1) :: cldmspc ! 959 LOGICAL :: llxios 960 ! 961 llxios = .FALSE. 962 IF( PRESENT(ldxios) ) llxios = ldxios 963 964 IF(.NOT.llxios) THEN ! read data using default library 976 CHARACTER(LEN=lc) :: context 977 ! 978 CALL set_xios_context(kiomid, context) 979 980 IF(context == "NONE") THEN ! read data using default library 965 981 itime = 1 966 982 IF( PRESENT(ktime) ) itime = ktime … … 984 1000 #if defined key_iomput 985 1001 IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', trim(cdvar) 986 CALL iom_swap( TRIM(crxios_context))1002 CALL iom_swap(context) 987 1003 CALL xios_recv_field( trim(cdvar), pvar) 988 CALL iom_swap( TRIM(cxios_context))1004 CALL iom_swap(cxios_context) 989 1005 #else 990 1006 WRITE(ctmp1,*) 'Can not use XIOS in iom_g0d, file: '//trim(clname)//', var:'//trim(cdvar) … … 994 1010 END SUBROUTINE iom_g0d_dp 995 1011 996 SUBROUTINE iom_g1d_sp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount , ldxios)1012 SUBROUTINE iom_g1d_sp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount ) 997 1013 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 998 1014 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 1003 1019 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading 1004 1020 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kcount ! number of points in each axis 1005 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS1006 1021 ! 1007 1022 IF( kiomid > 0 ) THEN … … 1009 1024 ALLOCATE(ztmp_pvar(size(pvar,1))) 1010 1025 CALL iom_get_123d( kiomid, kdom , cdvar , pv_r1d=ztmp_pvar, & 1011 & ktime=ktime, kstart=kstart, kcount=kcount, & 1012 & ldxios=ldxios ) 1026 & ktime=ktime, kstart=kstart, kcount=kcount ) 1013 1027 pvar = ztmp_pvar 1014 1028 DEALLOCATE(ztmp_pvar) … … 1018 1032 1019 1033 1020 SUBROUTINE iom_g1d_dp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount , ldxios)1034 SUBROUTINE iom_g1d_dp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount ) 1021 1035 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1022 1036 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 1026 1040 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading 1027 1041 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kcount ! number of points in each axis 1028 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS1029 1042 ! 1030 1043 IF( kiomid > 0 ) THEN 1031 1044 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r1d=pvar, & 1032 & ktime=ktime, kstart=kstart, kcount=kcount, & 1033 & ldxios=ldxios ) 1045 & ktime=ktime, kstart=kstart, kcount=kcount) 1034 1046 ENDIF 1035 1047 END SUBROUTINE iom_g1d_dp 1036 1048 1037 SUBROUTINE iom_g2d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount , ldxios)1049 SUBROUTINE iom_g2d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount) 1038 1050 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1039 1051 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 1047 1059 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kstart ! start axis position of the reading 1048 1060 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kcount ! number of points in each axis 1049 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS1050 1061 ! 1051 1062 IF( kiomid > 0 ) THEN … … 1054 1065 CALL iom_get_123d( kiomid, kdom, cdvar , pv_r2d = ztmp_pvar , ktime = ktime, & 1055 1066 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 1056 & kstart = kstart , kcount = kcount , ldxios=ldxios)1067 & kstart = kstart , kcount = kcount ) 1057 1068 pvar = ztmp_pvar 1058 1069 DEALLOCATE(ztmp_pvar) … … 1061 1072 END SUBROUTINE iom_g2d_sp 1062 1073 1063 SUBROUTINE iom_g2d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount , ldxios)1074 SUBROUTINE iom_g2d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount) 1064 1075 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1065 1076 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 1072 1083 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kstart ! start axis position of the reading 1073 1084 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kcount ! number of points in each axis 1074 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS1075 1085 ! 1076 1086 IF( kiomid > 0 ) THEN 1077 1087 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom, cdvar , pv_r2d = pvar , ktime = ktime, & 1078 1088 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 1079 & kstart = kstart , kcount = kcount , ldxios=ldxios)1089 & kstart = kstart , kcount = kcount ) 1080 1090 ENDIF 1081 1091 END SUBROUTINE iom_g2d_dp 1082 1092 1083 SUBROUTINE iom_g3d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount , ldxios)1093 SUBROUTINE iom_g3d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount ) 1084 1094 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1085 1095 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 1093 1103 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kstart ! start axis position of the reading 1094 1104 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kcount ! number of points in each axis 1095 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS1096 1105 ! 1097 1106 IF( kiomid > 0 ) THEN … … 1100 1109 CALL iom_get_123d( kiomid, kdom, cdvar , pv_r3d = ztmp_pvar , ktime = ktime, & 1101 1110 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 1102 & kstart = kstart , kcount = kcount , ldxios=ldxios)1111 & kstart = kstart , kcount = kcount ) 1103 1112 pvar = ztmp_pvar 1104 1113 DEALLOCATE(ztmp_pvar) … … 1107 1116 END SUBROUTINE iom_g3d_sp 1108 1117 1109 SUBROUTINE iom_g3d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount , ldxios)1118 SUBROUTINE iom_g3d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount ) 1110 1119 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1111 1120 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 1118 1127 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kstart ! start axis position of the reading 1119 1128 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kcount ! number of points in each axis 1120 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS1121 1129 ! 1122 1130 IF( kiomid > 0 ) THEN … … 1124 1132 CALL iom_get_123d( kiomid, kdom, cdvar , pv_r3d = pvar , ktime = ktime, & 1125 1133 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 1126 & kstart = kstart , kcount = kcount , ldxios=ldxios)1134 & kstart = kstart , kcount = kcount ) 1127 1135 END IF 1128 1136 ENDIF … … 1132 1140 1133 1141 SUBROUTINE iom_get_123d( kiomid , kdom, cdvar, pv_r1d, pv_r2d, pv_r3d, ktime , & 1134 & cd_type, psgn, kfill, kstart, kcount , ldxios)1142 & cd_type, psgn, kfill, kstart, kcount ) 1135 1143 !!----------------------------------------------------------------------- 1136 1144 !! *** ROUTINE iom_get_123d *** … … 1152 1160 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kstart ! start position of the reading in each axis 1153 1161 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kcount ! number of points to be read in each axis 1154 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use XIOS to read restart1155 1162 ! 1156 1163 LOGICAL :: llok ! true if ok! 1157 LOGICAL :: llxios ! local definition for XIOS read1158 1164 INTEGER :: jl ! loop on number of dimension 1159 1165 INTEGER :: idom ! type of domain … … 1182 1188 REAL(dp) :: gma, gmi 1183 1189 !--------------------------------------------------------------------- 1184 ! 1190 CHARACTER(LEN=lc) :: context 1191 ! 1192 CALL set_xios_context(kiomid, context) 1185 1193 inlev = -1 1186 1194 IF( PRESENT(pv_r3d) ) inlev = SIZE(pv_r3d, 3) 1187 1195 ! 1188 llxios = .FALSE.1189 IF( PRESENT(ldxios) ) llxios = ldxios1190 !1191 1196 idom = kdom 1192 1197 istop = nstop 1193 1198 ! 1194 IF( .NOT.llxios) THEN1199 IF(context == "NONE") THEN 1195 1200 clname = iom_file(kiomid)%name ! esier to read 1196 1201 clinfo = ' iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar) … … 1359 1364 #if defined key_iomput 1360 1365 !would be good to be able to check which context is active and swap only if current is not restart 1361 CALL iom_swap( TRIM(crxios_context) ) 1366 idvar = iom_varid( kiomid, cdvar ) 1367 CALL iom_swap(context) 1368 zsgn = 1._wp 1369 IF( PRESENT(psgn ) ) zsgn = psgn 1370 cl_type = 'T' 1371 IF( PRESENT(cd_type) ) cl_type = cd_type 1372 1362 1373 IF( PRESENT(pv_r3d) ) THEN 1363 1374 IF(lwp) WRITE(numout,*) 'XIOS RST READ (3D): ',TRIM(cdvar) 1364 CALL xios_recv_field( trim(cdvar), pv_r3d) 1365 IF(idom /= jpdom_unknown ) CALL lbc_lnk( 'iom', pv_r3d,'Z', -999., kfillmode = jpfillnothing) 1375 CALL xios_recv_field( trim(cdvar), pv_r3d(:, :, :)) 1376 IF(idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN 1377 CALL lbc_lnk( 'iom', pv_r3d, cl_type, zsgn, kfillmode = kfill) 1378 ENDIF 1366 1379 ELSEIF( PRESENT(pv_r2d) ) THEN 1367 1380 IF(lwp) WRITE(numout,*) 'XIOS RST READ (2D): ', TRIM(cdvar) 1368 CALL xios_recv_field( trim(cdvar), pv_r2d) 1369 IF(idom /= jpdom_unknown ) CALL lbc_lnk('iom', pv_r2d,'Z',-999., kfillmode = jpfillnothing) 1381 CALL xios_recv_field( trim(cdvar), pv_r2d(:, :)) 1382 IF(idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN 1383 CALL lbc_lnk('iom', pv_r2d, cl_type, zsgn, kfillmode = kfill) 1384 ENDIF 1370 1385 ELSEIF( PRESENT(pv_r1d) ) THEN 1371 1386 IF(lwp) WRITE(numout,*) 'XIOS RST READ (1D): ', TRIM(cdvar) 1372 1387 CALL xios_recv_field( trim(cdvar), pv_r1d) 1373 1388 ENDIF 1374 CALL iom_swap( TRIM(cxios_context))1389 CALL iom_swap(cxios_context) 1375 1390 #else 1376 1391 istop = istop + 1 … … 1387 1402 zofs = iom_file(kiomid)%ofs(idvar) ! offset 1388 1403 IF( PRESENT(pv_r1d) ) THEN 1389 IF( zscf /= 1. ) pv_r1d(:) = pv_r1d(:) * zscf1390 IF( zofs /= 0. ) pv_r1d(:) = pv_r1d(:) + zofs1404 IF( zscf /= 1._wp ) pv_r1d(:) = pv_r1d(:) * zscf 1405 IF( zofs /= 0._wp ) pv_r1d(:) = pv_r1d(:) + zofs 1391 1406 ELSEIF( PRESENT(pv_r2d) ) THEN 1392 IF( zscf /= 1. ) pv_r2d(:,:) = pv_r2d(:,:) * zscf1393 IF( zofs /= 0. ) pv_r2d(:,:) = pv_r2d(:,:) + zofs1407 IF( zscf /= 1._wp) pv_r2d(:,:) = pv_r2d(:,:) * zscf 1408 IF( zofs /= 0._wp) pv_r2d(:,:) = pv_r2d(:,:) + zofs 1394 1409 ELSEIF( PRESENT(pv_r3d) ) THEN 1395 IF( zscf /= 1. ) pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf1396 IF( zofs /= 0. ) pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs1410 IF( zscf /= 1._wp) pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf 1411 IF( zofs /= 0._wp) pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs 1397 1412 ENDIF 1398 1413 ! … … 1568 1583 !! INTERFACE iom_rstput 1569 1584 !!---------------------------------------------------------------------- 1570 SUBROUTINE iom_rp0d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1585 SUBROUTINE iom_rp0d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1571 1586 INTEGER , INTENT(in) :: kt ! ocean time-step 1572 1587 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1575 1590 REAL(sp) , INTENT(in) :: pvar ! written field 1576 1591 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1577 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1578 LOGICAL :: llx ! local xios write flag 1579 INTEGER :: ivid ! variable id 1580 1581 llx = .FALSE. 1582 IF(PRESENT(ldxios)) llx = ldxios 1592 ! 1593 LOGICAL :: llx ! local xios write flag 1594 INTEGER :: ivid ! variable id 1595 CHARACTER(LEN=lc) :: context 1596 ! 1597 CALL set_xios_context(kiomid, context) 1598 1599 llx = .NOT. (context == "NONE") 1600 1583 1601 IF( llx ) THEN 1584 1602 #ifdef key_iomput 1585 IF( kt == kwrite ) THEN 1586 IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar) 1587 CALL xios_send_field(trim(cdvar), pvar) 1588 ENDIF 1603 IF( kt == kwrite ) THEN 1604 IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar) 1605 CALL iom_swap(context) 1606 CALL iom_put(trim(cdvar), pvar) 1607 CALL iom_swap(cxios_context) 1608 ELSE 1609 IF(lwp) write(numout,*) 'RESTART: define (XIOS 0D) ',trim(cdvar) 1610 CALL iom_swap(context) 1611 CALL iom_set_rstw_active( trim(cdvar), rs0 = pvar ) 1612 CALL iom_swap(cxios_context) 1613 ENDIF 1589 1614 #endif 1590 1615 ELSE … … 1598 1623 END SUBROUTINE iom_rp0d_sp 1599 1624 1600 SUBROUTINE iom_rp0d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1625 SUBROUTINE iom_rp0d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1601 1626 INTEGER , INTENT(in) :: kt ! ocean time-step 1602 1627 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1605 1630 REAL(dp) , INTENT(in) :: pvar ! written field 1606 1631 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1607 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1608 LOGICAL :: llx ! local xios write flag 1609 INTEGER :: ivid ! variable id 1610 1611 llx = .FALSE. 1612 IF(PRESENT(ldxios)) llx = ldxios 1632 ! 1633 LOGICAL :: llx ! local xios write flag 1634 INTEGER :: ivid ! variable id 1635 CHARACTER(LEN=lc) :: context 1636 ! 1637 CALL set_xios_context(kiomid, context) 1638 1639 llx = .NOT. (context == "NONE") 1640 1613 1641 IF( llx ) THEN 1614 1642 #ifdef key_iomput 1615 IF( kt == kwrite ) THEN 1616 IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar) 1617 CALL xios_send_field(trim(cdvar), pvar) 1618 ENDIF 1643 IF( kt == kwrite ) THEN 1644 IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar) 1645 CALL iom_swap(context) 1646 CALL iom_put(trim(cdvar), pvar) 1647 CALL iom_swap(cxios_context) 1648 ELSE 1649 IF(lwp) write(numout,*) 'RESTART: define (XIOS 0D) ',trim(cdvar) 1650 CALL iom_swap(context) 1651 CALL iom_set_rstw_active( trim(cdvar), rd0 = pvar ) 1652 CALL iom_swap(cxios_context) 1653 ENDIF 1619 1654 #endif 1620 1655 ELSE … … 1629 1664 1630 1665 1631 SUBROUTINE iom_rp1d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1666 SUBROUTINE iom_rp1d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1632 1667 INTEGER , INTENT(in) :: kt ! ocean time-step 1633 1668 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1636 1671 REAL(sp) , INTENT(in), DIMENSION( :) :: pvar ! written field 1637 1672 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1638 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1639 LOGICAL :: llx ! local xios write flag 1640 INTEGER :: ivid ! variable id 1641 1642 llx = .FALSE. 1643 IF(PRESENT(ldxios)) llx = ldxios 1673 ! 1674 LOGICAL :: llx ! local xios write flag 1675 INTEGER :: ivid ! variable id 1676 CHARACTER(LEN=lc) :: context 1677 ! 1678 CALL set_xios_context(kiomid, context) 1679 1680 llx = .NOT. (context == "NONE") 1681 1644 1682 IF( llx ) THEN 1645 1683 #ifdef key_iomput 1646 IF( kt == kwrite ) THEN 1647 IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar) 1648 CALL xios_send_field(trim(cdvar), pvar) 1649 ENDIF 1684 IF( kt == kwrite ) THEN 1685 IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar) 1686 CALL iom_swap(context) 1687 CALL iom_put(trim(cdvar), pvar) 1688 CALL iom_swap(cxios_context) 1689 ELSE 1690 IF(lwp) write(numout,*) 'RESTART: define (XIOS 1D)',trim(cdvar) 1691 CALL iom_swap(context) 1692 CALL iom_set_rstw_active( trim(cdvar), rs1 = pvar ) 1693 CALL iom_swap(cxios_context) 1694 ENDIF 1650 1695 #endif 1651 1696 ELSE … … 1659 1704 END SUBROUTINE iom_rp1d_sp 1660 1705 1661 SUBROUTINE iom_rp1d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1706 SUBROUTINE iom_rp1d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1662 1707 INTEGER , INTENT(in) :: kt ! ocean time-step 1663 1708 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1666 1711 REAL(dp) , INTENT(in), DIMENSION( :) :: pvar ! written field 1667 1712 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1668 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1669 LOGICAL :: llx ! local xios write flag 1670 INTEGER :: ivid ! variable id 1671 1672 llx = .FALSE. 1673 IF(PRESENT(ldxios)) llx = ldxios 1713 ! 1714 LOGICAL :: llx ! local xios write flag 1715 INTEGER :: ivid ! variable id 1716 CHARACTER(LEN=lc) :: context 1717 ! 1718 CALL set_xios_context(kiomid, context) 1719 1720 llx = .NOT. (context == "NONE") 1721 1674 1722 IF( llx ) THEN 1675 1723 #ifdef key_iomput 1676 IF( kt == kwrite ) THEN 1677 IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar) 1678 CALL xios_send_field(trim(cdvar), pvar) 1679 ENDIF 1724 IF( kt == kwrite ) THEN 1725 IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar) 1726 CALL iom_swap(context) 1727 CALL iom_put(trim(cdvar), pvar) 1728 CALL iom_swap(cxios_context) 1729 ELSE 1730 IF(lwp) write(numout,*) 'RESTART: define (XIOS 1D)',trim(cdvar) 1731 CALL iom_swap(context) 1732 CALL iom_set_rstw_active( trim(cdvar), rd1 = pvar ) 1733 CALL iom_swap(cxios_context) 1734 ENDIF 1680 1735 #endif 1681 1736 ELSE … … 1690 1745 1691 1746 1692 SUBROUTINE iom_rp2d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1747 SUBROUTINE iom_rp2d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1693 1748 INTEGER , INTENT(in) :: kt ! ocean time-step 1694 1749 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1697 1752 REAL(sp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field 1698 1753 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1699 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1700 LOGICAL :: llx 1701 INTEGER :: ivid ! variable id 1702 1703 llx = .FALSE. 1704 IF(PRESENT(ldxios)) llx = ldxios 1754 ! 1755 LOGICAL :: llx 1756 INTEGER :: ivid ! variable id 1757 CHARACTER(LEN=lc) :: context 1758 ! 1759 CALL set_xios_context(kiomid, context) 1760 1761 llx = .NOT. (context == "NONE") 1762 1705 1763 IF( llx ) THEN 1706 1764 #ifdef key_iomput 1707 IF( kt == kwrite ) THEN 1708 IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar) 1709 CALL xios_send_field(trim(cdvar), pvar) 1710 ENDIF 1765 IF( kt == kwrite ) THEN 1766 IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar) 1767 CALL iom_swap(context) 1768 CALL iom_put(trim(cdvar), pvar) 1769 CALL iom_swap(cxios_context) 1770 ELSE 1771 IF(lwp) write(numout,*) 'RESTART: define (XIOS 2D)',trim(cdvar) 1772 CALL iom_swap(context) 1773 CALL iom_set_rstw_active( trim(cdvar), rs2 = pvar ) 1774 CALL iom_swap(cxios_context) 1775 ENDIF 1711 1776 #endif 1712 1777 ELSE … … 1720 1785 END SUBROUTINE iom_rp2d_sp 1721 1786 1722 SUBROUTINE iom_rp2d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1787 SUBROUTINE iom_rp2d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1723 1788 INTEGER , INTENT(in) :: kt ! ocean time-step 1724 1789 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1727 1792 REAL(dp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field 1728 1793 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1729 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1730 LOGICAL :: llx 1731 INTEGER :: ivid ! variable id 1732 1733 llx = .FALSE. 1734 IF(PRESENT(ldxios)) llx = ldxios 1794 ! 1795 LOGICAL :: llx 1796 INTEGER :: ivid ! variable id 1797 CHARACTER(LEN=lc) :: context 1798 ! 1799 CALL set_xios_context(kiomid, context) 1800 1801 llx = .NOT. (context == "NONE") 1802 1735 1803 IF( llx ) THEN 1736 1804 #ifdef key_iomput 1737 IF( kt == kwrite ) THEN 1738 IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar) 1739 CALL xios_send_field(trim(cdvar), pvar) 1740 ENDIF 1805 IF( kt == kwrite ) THEN 1806 IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar) 1807 CALL iom_swap(context) 1808 CALL iom_put(trim(cdvar), pvar) 1809 CALL iom_swap(cxios_context) 1810 ELSE 1811 IF(lwp) write(numout,*) 'RESTART: define (XIOS 2D)',trim(cdvar) 1812 CALL iom_swap(context) 1813 CALL iom_set_rstw_active( trim(cdvar), rd2 = pvar ) 1814 CALL iom_swap(cxios_context) 1815 ENDIF 1741 1816 #endif 1742 1817 ELSE … … 1751 1826 1752 1827 1753 SUBROUTINE iom_rp3d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1828 SUBROUTINE iom_rp3d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1754 1829 INTEGER , INTENT(in) :: kt ! ocean time-step 1755 1830 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1758 1833 REAL(sp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field 1759 1834 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1760 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1761 LOGICAL :: llx ! local xios write flag 1762 INTEGER :: ivid ! variable id 1763 1764 llx = .FALSE. 1765 IF(PRESENT(ldxios)) llx = ldxios 1835 ! 1836 LOGICAL :: llx ! local xios write flag 1837 INTEGER :: ivid ! variable id 1838 CHARACTER(LEN=lc) :: context 1839 ! 1840 CALL set_xios_context(kiomid, context) 1841 1842 llx = .NOT. (context == "NONE") 1843 1766 1844 IF( llx ) THEN 1767 1845 #ifdef key_iomput 1768 IF( kt == kwrite ) THEN 1769 IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar) 1770 CALL xios_send_field(trim(cdvar), pvar) 1771 ENDIF 1846 IF( kt == kwrite ) THEN 1847 IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar) 1848 CALL iom_swap(context) 1849 CALL iom_put(trim(cdvar), pvar) 1850 CALL iom_swap(cxios_context) 1851 ELSE 1852 IF(lwp) write(numout,*) 'RESTART: define (XIOS 3D)',trim(cdvar) 1853 CALL iom_swap(context) 1854 CALL iom_set_rstw_active( trim(cdvar), rs3 = pvar ) 1855 CALL iom_swap(cxios_context) 1856 ENDIF 1772 1857 #endif 1773 1858 ELSE … … 1781 1866 END SUBROUTINE iom_rp3d_sp 1782 1867 1783 SUBROUTINE iom_rp3d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1868 SUBROUTINE iom_rp3d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1784 1869 INTEGER , INTENT(in) :: kt ! ocean time-step 1785 1870 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1788 1873 REAL(dp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field 1789 1874 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1790 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1791 LOGICAL :: llx ! local xios write flag 1792 INTEGER :: ivid ! variable id 1793 1794 llx = .FALSE. 1795 IF(PRESENT(ldxios)) llx = ldxios 1875 ! 1876 LOGICAL :: llx ! local xios write flag 1877 INTEGER :: ivid ! variable id 1878 CHARACTER(LEN=lc) :: context 1879 ! 1880 CALL set_xios_context(kiomid, context) 1881 1882 llx = .NOT. (context == "NONE") 1883 1796 1884 IF( llx ) THEN 1797 1885 #ifdef key_iomput 1798 IF( kt == kwrite ) THEN 1799 IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar) 1800 CALL xios_send_field(trim(cdvar), pvar) 1801 ENDIF 1886 IF( kt == kwrite ) THEN 1887 IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar) 1888 CALL iom_swap(context) 1889 CALL iom_put(trim(cdvar), pvar) 1890 CALL iom_swap(cxios_context) 1891 ELSE 1892 IF(lwp) write(numout,*) 'RESTART: define (XIOS 3D)',trim(cdvar) 1893 CALL iom_swap(context) 1894 CALL iom_set_rstw_active( trim(cdvar), rd3 = pvar ) 1895 CALL iom_swap(cxios_context) 1896 ENDIF 1802 1897 #endif 1803 1898 ELSE … … 1865 1960 CHARACTER(LEN=*), INTENT(in) :: cdname 1866 1961 REAL(sp) , INTENT(in) :: pfield0d 1867 !! REAL(wp) , DIMENSION(jpi,jpj) :: zz ! masson1962 !! REAL(wp) , DIMENSION(jpi,jpj) :: zz ! masson 1868 1963 #if defined key_iomput 1869 1964 !!clem zz(:,:)=pfield0d … … 2145 2240 CALL iom_swap( cdname ) ! swap to cdname context 2146 2241 CALL xios_update_calendar(kt) 2147 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context)) ! return back to nemo context2242 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( cxios_context ) ! return back to nemo context 2148 2243 END SUBROUTINE iom_setkt 2149 2244 … … 2159 2254 CALL iom_swap( cdname ) ! swap to cdname context 2160 2255 CALL xios_context_finalize() ! finalize the context 2161 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context)) ! return back to nemo context2256 IF( cdname /= cxios_context ) CALL iom_swap( cxios_context ) ! return back to nemo context 2162 2257 ENDIF 2163 2258 ! -
NEMO/branches/2020/dev_r13787_SI3-10_EAP/src/OCE/IOM/iom_def.F90
r13558 r13991 9 9 !!---------------------------------------------------------------------- 10 10 USE par_kind 11 USE netcdf 11 12 12 13 IMPLICIT NONE … … 36 37 INTEGER, PUBLIC :: nxioso = 0 !: type of restart file when writing using XIOS 1 - single, 2 - multiple 37 38 !XIOS read restart 38 LOGICAL, PUBLIC :: lrxios = .FALSE. !: read single file restart using XIOS 39 LOGICAL, PUBLIC :: lrxios = .FALSE. !: read single file restart using XIOS main switch 39 40 LOGICAL, PUBLIC :: lxios_sini = .FALSE. ! is restart in a single file 40 LOGICAL, PUBLIC :: lxios_set = .FALSE. 41 42 41 43 42 44 TYPE, PUBLIC :: file_descriptor … … 59 61 END TYPE file_descriptor 60 62 TYPE(file_descriptor), DIMENSION(jpmax_files), PUBLIC :: iom_file !: array containing the info for all opened files 61 INTEGER, PARAMETER, PUBLIC :: max_rst_fields = 95 !: maximum number of restart variables defined in iom_set_rst_vars62 TYPE, PUBLIC :: RST_FIELD63 CHARACTER(len=30) :: vname = "NO_NAME" ! names of variables in restart file64 CHARACTER(len=30) :: grid = "NO_GRID"65 LOGICAL :: active =.FALSE. ! for restart write only: true - write field, false do not write field66 END TYPE RST_FIELD67 63 !$AGRIF_END_DO_NOT_TREAT 68 !69 TYPE(RST_FIELD), PUBLIC, SAVE :: rst_wfields(max_rst_fields), rst_rfields(max_rst_fields)70 64 ! 71 65 !! * Substitutions -
NEMO/branches/2020/dev_r13787_SI3-10_EAP/src/OCE/IOM/iom_nf90.F90
r13286 r13991 31 31 PUBLIC iom_nf90_open , iom_nf90_close, iom_nf90_varid, iom_nf90_get, iom_nf90_rstput 32 32 PUBLIC iom_nf90_chkatt, iom_nf90_getatt, iom_nf90_putatt 33 PUBLIC iom_nf90_check 33 34 34 35 INTERFACE iom_nf90_get -
NEMO/branches/2020/dev_r13787_SI3-10_EAP/src/OCE/IOM/prtctl.F90
r13286 r13991 8 8 !!---------------------------------------------------------------------- 9 9 USE dom_oce ! ocean space and time domain variables 10 USE domutl, ONLY : is_tile 10 11 USE in_out_manager ! I/O manager 11 12 USE mppini ! distributed memory computing … … 26 27 PUBLIC prt_ctl_init ! called by nemogcm.F90 and prt_ctl_trc_init 27 28 29 !! * Substitutions 30 # include "do_loop_substitute.h90" 28 31 !!---------------------------------------------------------------------- 29 32 !! NEMO/OCE 4.0 , NEMO Consortium (2018)