diff --git a/.github/workflows/intel.yml b/.github/workflows/intel.yml index 1159e8599..f5de65dcd 100644 --- a/.github/workflows/intel.yml +++ b/.github/workflows/intel.yml @@ -13,7 +13,7 @@ concurrency: # Set I_MPI_CC/F90 so Intel MPI wrapper uses icc/ifort instead of gcc/gfortran env: - cache_key: intel12 + cache_key: intel10-3 CC: icc FC: ifort CXX: icpc diff --git a/.github/workflows/io_gnu_yml.old b/.github/workflows/io_gnu_yml.old new file mode 100644 index 000000000..def5a1402 --- /dev/null +++ b/.github/workflows/io_gnu_yml.old @@ -0,0 +1,122 @@ +name: io_gnu +on: [push, pull_request, workflow_dispatch] + +# Cancel in-progress workflows when pushing to a branch +concurrency: + group: ${{ github.workflow }}-${{ github.event.pull_request.number || github.ref }} + cancel-in-progress: true + +env: + cache_key: gnu11-1 + CC: gcc-10 + FC: gfortran-10 + CXX: g++-10 + + +# Split into a steup step, and a WW3 build step which +# builds multiple switches in a matrix. The setup is run once and +# the environment is cached so each build of WW3 can share the dependencies. + +jobs: + setup: + runs-on: ubuntu-latest + + steps: + - name: checkout-ww3 + if: steps.cache-env.outputs.cache-hit != 'true' + uses: actions/checkout@v3 + with: + path: ww3 + # Cache spack, OASIS, and compiler + # No way to flush Action cache, so key may have # appended + - name: cache-env + id: cache-env + uses: actions/cache@v3 + with: + path: | + spack + ~/.spack + work_oasis3-mct + key: spack-${{ runner.os }}-${{ env.cache_key }}-${{ hashFiles('ww3/model/ci/spack_gnu.yaml') }} + + # Build WW3 spack environment + - name: install-dependencies-with-spack + if: steps.cache-env.outputs.cache-hit != 'true' + run: | + # Install NetCDF, ESMF, g2, etc using Spack + sudo apt install cmake + git clone -c feature.manyFiles=true https://github.com/JCSDA/spack.git + source spack/share/spack/setup-env.sh + spack env create ww3-gnu ww3/model/ci/spack_gnu.yaml + spack env activate ww3-gnu + spack compiler find + spack external find cmake + spack add mpich@3.4.2 + spack concretize + spack install --dirty -v + + - name: build-oasis + if: steps.cache-env.outputs.cache-hit != 'true' + run: | + source spack/share/spack/setup-env.sh + spack env activate ww3-gnu + export WWATCH3_DIR=${GITHUB_WORKSPACE}/ww3/model + export OASIS_INPUT_PATH=${GITHUB_WORKSPACE}/ww3/regtests/ww3_tp2.14/input/oasis3-mct + export OASIS_WORK_PATH=${GITHUB_WORKSPACE}/ww3/regtests/ww3_tp2.14/input/work_oasis3-mct + cd ww3/regtests/ww3_tp2.14/input/oasis3-mct/util/make_dir + cmake . + make VERBOSE=1 + cp -r ${GITHUB_WORKSPACE}/ww3/regtests/ww3_tp2.14/input/work_oasis3-mct ${GITHUB_WORKSPACE} + + io_gnu: + needs: setup + runs-on: ubuntu-latest + + steps: + - name: install-dependencies + run: | + sudo apt-get update + sudo apt-get install doxygen gcovr valgrind + + - name: checkout-ww3 + uses: actions/checkout@v3 + with: + path: ww3 + + - name: cache-env + id: cache-env + uses: actions/cache@v3 + with: + path: | + spack + ~/.spack + work_oasis3-mct + key: spack-${{ runner.os }}-${{ env.cache_key }}-${{ hashFiles('ww3/model/ci/spack_gnu.yaml') }} + + - name: build-ww3 + run: | + source spack/share/spack/setup-env.sh + spack env activate ww3-gnu + set -x + cd ww3 + export CC=mpicc + export FC=mpif90 + export OASISDIR=${GITHUB_WORKSPACE}/work_oasis3-mct + mkdir build && cd build + export LD_LIBRARY_PATH="/home/runner/work/WW3/WW3/spack/var/spack/environments/ww3-gnu/.spack-env/view/:$LD_LIBRARY_PATH" + cmake -DSWITCH=${GITHUB_WORKSPACE}/ww3/regtests/unittests/data/switch.io -DCMAKE_BUILD_TYPE=Debug -DCMAKE_Fortran_FLAGS="-g -fprofile-abs-path -fprofile-arcs -ftest-coverage -O0 -Wall -fno-omit-frame-pointer -fsanitize=address" -DCMAKE_C_FLAGS="-g -fprofile-abs-path -fprofile-arcs -ftest-coverage -O0 -Wall -fno-omit-frame-pointer -fsanitize=address" .. + make -j2 VERBOSE=1 + ./bin/ww3_grid + mv mod_def.ww3 regtests/unittests + ctest --verbose --output-on-failure --rerun-failed + gcovr --root .. -v --html-details --exclude ../regtests/unittests --exclude CMakeFiles --print-summary -o test-coverage.html &> /dev/null + + - name: upload-test-coverage + uses: actions/upload-artifact@v3 + with: + name: ww3-test-coverage + path: | + ww3/build/*.html + ww3/build/*.css + + diff --git a/CMakeLists.txt b/CMakeLists.txt index e4f424606..c82effe98 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -67,3 +67,9 @@ if(NOT CMAKE_BUILD_TYPE MATCHES "^(Debug|Release|RelWithDebInfo|MinSizeRel)$") endif() add_subdirectory(model) + +# Turn on unit testing. +include(CTest) +if(BUILD_TESTING) + add_subdirectory(regtests/unittests) +endif() diff --git a/manual/defs.tex b/manual/defs.tex index 1f67da7e7..5b8963fa5 100644 --- a/manual/defs.tex +++ b/manual/defs.tex @@ -94,6 +94,9 @@ \newcommand{\cR}{{\cal R}} \newcommand{\cS}{{\cal S}} +\newcommand{\rd}{{\mathrm d}} + + \newcommand{\marbox}[1]{\marginpar{\fbox{{\small #1}}}} \newcommand{\proddefH}[3]{ diff --git a/manual/eqs/NL1.tex b/manual/eqs/NL1.tex index a6539dbe5..c45e9294d 100644 --- a/manual/eqs/NL1.tex +++ b/manual/eqs/NL1.tex @@ -1,65 +1,92 @@ -\vsssub -\subsubsection{~$S_{nl}$: Discrete Interaction Approximation (\dia)} \label{sec:NL1} -\vsssub - -\opthead{NL1}{\wam\ model}{H. L. Tolman} \noindent -Nonlinear wave-wave interactions can be modeled using the discrete interaction -approximation \citep[\dia,][]{art:Hea85b}. This parameterization was + + +Resonant nonlinear interactions occur between four wave components +(quadruplets) with wavenumber vector $\bk$, $\bk_1$, $\bk_2$ and $\bk_3$ are such that +% eq:resonance +\begin{equation} \left . +\begin{array}{ccc} + \bk + \bk_1 & = & \bk_2 + \bk_3 \\ + f_r + f_{r,1}& =& f_{r,2} + f_{r,3} +\end{array} \:\:\: \right \rbrace \:\:\: , \label{eq:resonance} +\end{equation} + +Nonlinear 4-wave interaction theories were originally developed for the spectrum $F(f_r ,\theta)$. To assure the conservative nature of $S_{nl}$ for this spectrum (which can be considered as the "final product" of the model), this source term is calculated for $F(f_r,\theta)$ instead of $N(k,\theta)$, using the conversion (\ref{eq:jac_fr}). -Resonant nonlinear interactions occur between four wave components -(quadruplets) with wavenumber vector $\bk_1$ through $\bk_4$. In the \dia, it -is assumed that $\bk_1 = \bk_2$. Resonance conditions then require that -%--------------------------% -% Resonance conditions DIA % -%--------------------------% +\vsssub +\subsubsection{~$S_{nl}$: Discrete Interaction Approximation (\dia)} \label{sec:NL1} +\vsssub + +\opthead{NL1}{\wam\ model}{H. L. Tolman} + + + + In the \dia, for each component $\bk$, only 2 quadruplets configuration are +used, while there should be thousands for the full integral, and the interaction caused by these 2 quadruplets +is scaled so that it gives the right order of magnitude for the flux of energy towards low frequencies. + +Both quadruplets used the DIA use % eq:resonance \begin{equation} \left . \begin{array}{ccc} - \bk_1 + \bk_2 & = & \bk_3 + \bk_4 \\ - \sigma_2 & = & \sigma_1 \\ - \sigma_3 & = & (1+\lambda_{nl})\sigma_1 \\ - \sigma_4 & = & (1-\lambda_{nl})\sigma_1 -\end{array} \:\:\: \right \rbrace \:\:\: , \label{eq:resonance} + \bk_1 & = & \bk\\ + f_{r,2} & = & (1+\lambda)f_{r} \\ + f_{r,3} & = & (1-\lambda)f_{r} +\end{array} \:\:\: \right \rbrace \:\:\: , \label{eq:DIAchoice} +\end{equation} +where $\lambda$ is a constant, usually 0.25, and they only differ by the choice of the interacting angles +taking either a plus sign or a minus sign in the following +\begin{equation} \left . +\begin{array}{ccc} + \theta_{2,\pm} & = & \theta \pm \delta_{\theta,2} \\ + \theta_{3,\pm} & = & \theta \mp \delta_{\theta,3} \\ + \end{array} \:\:\: \right \rbrace \:\:\: , \label{eq:DIAangles} \end{equation} -where $\lambda_{nl}$ is a constant. For these quadruplets, the contribution -$\delta S_{nl}$ to the interaction for each discrete $(f_r,\theta)$ -combination of the spectrum corresponding to $\bk_1$ is calculated as +where $\delta_{\theta,2}$ and $\delta_{\theta,3}$ are only a function of $\lambda$ given by the geometry of +the interacting wavenumbers along the "figure of 8", namely +\begin{eqnarray} +\cos(\delta_{\theta,2})&=&(1-\lambda)^4+4-(1+\lambda)^4)/[4(1-\lambda)^2], \\ +\sin(\delta_{\theta,3})&=&\sin(\delta_{\theta,2}) (1-\lambda)^2/(1+\lambda)^2. +\end{eqnarray} + +Hence for any $\bk$ one quadruplet selects $\bk_{2,+}$ and $\bk_{3,+}$, and the other quadruplet selects its mirror image +$\bk_{2,-}$, $\bk_{2,-}$. Because there are 3 different components interacting in the two DIA-selected quadruplets, any discrete spectral component $(f_r,\theta)$ is actually involved in 6 quadruplets and directly exchanges energy with 12 other components $(f_r',\theta')$. Because the values of $f'_r$ and $\theta'$ do not fall exacly on other discrete components, the spectral density is interpolated using a bilinear interpolation, so that each source term value +$S_{nl}(\bk)$ contains the direct exchange of energy with 48 other discrete components. +we compute the three contributions that correspond to the situation in which $\bk$ takes the role of $\bk$,$\bk_{2,+}$, $\bk_{2,-}$, $\bk_{3,+}$ and $\bk_{3,-}$ in the quadruplet, namely the full source term is, without making explicit that bilinear interpolation, +\begin{eqnarray} +S_{\mathrm{nl}}(\bk) &=& -2 \left[\delta S_{\mathrm{nl}}(\bk,\bk_{2,+},\bk_{3,+})+\delta S_{\mathrm{nl}}(\bk,\bk_{2,-},\bk_{3,-})\right] \nonumber \\ + & & + \delta S_{\mathrm{nl}}(\bk_4,\bk,\bk_5) + \delta S_{\mathrm{nl}}(\bk_6,\bk,\bk_7) \\ + & & + \delta S_{\mathrm{nl}}(\bk_8,\bk_9,\bk) + \delta S_{\mathrm{nl}}(\bk_{10},\bk_{11},\bk) . \label{eq:diasum} +\end{eqnarray} +where the geometry of the quadruplet $(\bk_4,\bk_4,\bk,\bk_5)$ is obtained from that of $(\bk,\bk,\bk_{2,+},\bk_{3,+})$ by a dilation by a factor $(1+\lambda)^2$ and rotation by the angle $\delta_{\theta,2}$; $(\bk_6,\bk_6,\bk,\bk_7)$ has the same dilation but the opposite rotation; $(\bk_8,\bk_8,\bk_9,\bk)$ is dilated by a factor $(1-\lambda)^2$ and rotated by the angle $-\delta_{\theta,3}$: and $(\bk_{10},\bk_{10},\bk_{11},\bk)$ is dilated by the same factor and rotated by the opposite angle. + + +The elementary contributions $\delta S_{\mathrm{nl}}(\bk_l,\bk_m,\bk_n)$ are given by %----------------------------% % Nonlinear interactions DIA % %----------------------------% % eq:snl_dia -\begin{eqnarray} -\left ( \begin{array}{c} - \delta S_{nl,1} \\ \delta S_{nl,3} \\ \delta S_{nl,4} -\end{array} \right ) & = & D -\left ( \begin{array}{r} -2 \\ 1 \\ 1 \end{array} \right ) -C g^{-4} f_{r,1}^{11} \times \nonumber \\ -& & \left [ F_1^2 -\left ( \frac{F_3}{(1+\lambda_{nl})^4} + - \frac{F_4}{(1-\lambda_{nl})^4} \right ) - -\frac{2 F_1 F_3 F_4}{(1-\lambda_{nl}^2)^4} -\right ] \: , \label{eq:snl_dia} -\end{eqnarray} -where $F_1 = F(f_{r,1} ,\theta_1 )$ etc. and $\delta S_{nl,1} = \delta -S_{nl}(f_{r,1} ,\theta_1 )$ etc., $C$ is a proportionality constant. The -nonlinear interactions are calculated by considering a limited number of -combinations $(\lambda_{nl},C)$. In practice, only one combination is -used. Default values for different source term packages are presented in -Table~\ref{tab:snl_par}. + +\begin{equation} +\delta S_{\mathrm{nl}}(\bk_l,\bk_m,\bk_n) = \frac{C}{g^4} f_{r,l}^{11} \left [ F_l^2 \left ( \frac{F_m}{(1+\lambda)^4} + + \frac{F_n}{(1-\lambda)^4} \right ) - \frac{2 F_l F_m F_n}{(1-\lambda^2)^4} \right] , + \label{eq:snl_dia} +\end{equation} +where the spectral densities are $F_l = F(f_{r,l} ,\theta_l)$, etc. + $C$ is a proportionality constant that was tuned to reproduce the inverse energy cascade. Default values for different source term packages are presented in Table~\ref{tab:snl_par}. % tab:snl_par \begin{table} \begin{center} \begin{tabular}{|l|c|c|} \hline - & $\lambda_{nl}$ & $C$ \\ \hline + & $\lambda$ & $C$ \\ \hline ST6 & 0.25 & $3.00 \; 10^7$ \\ \hline \wam-3 & 0.25 & $2.78 \; 10^7$ \\ \hline ST4 (Ardhuin et al.)& 0.25 & $2.50 \; 10^7$ \\ \hline @@ -68,7 +95,7 @@ \subsubsection{~$S_{nl}$: Discrete Interaction Approximation (\dia)} \label{sec: \caption{Default constants in \dia\ for input-dissipation packages.} \label{tab:snl_par} \botline \end{table} -This source term is developed for deep water, using the appropriate dispersion +This parameterization was developed for deep water, using the appropriate dispersion relation in the resonance conditions. For shallow water the expression is scaled by the factor $D$ (still using the deep-water dispersion relation, however) @@ -132,3 +159,37 @@ \subsubsection{~$S_{nl}$: Discrete Interaction Approximation (\dia)} \label{sec: above constants can be reset by the user in the input files of the model (see \para\ref{sub:ww3grid}). +\vsssub +\subsubsection{~$S_{nl}$: Gaussian Quadrature Method (\dia)} \label{sec:GQM} +\vsssub + +\opthead{NL1 , but with a negative IQTYPE}{TOMAWAC model, M. Benoit}{adaptation to WW3 by S. Siadatmousavi \& F. Ardhuin} + +\noindent +Changing the namelist parameter IQTYPE to a negative value replaces the +DIA parameterization with the possibility to perform an exact but fast cal- +culation of $S_{\mathrm{nl}}$ using the Gaussian Quadrature Method of \cite{Lavrenov2001}. +More details can be found in \cite{Gagnaire-Renou2009}. + + +The quadruplet configurations that are used correspond to the three integrals over $f_1$, $f_2$ and $\theta_1$, with all other frequencies and directions given by the resonance conditions (\ref{eq:resonance}) with only one ambiguity on the angle $\theta_2$ which can be defined by a sign index $s$, as in the DIA. Starting from eq. (A4) in \cite{Lavrenov2001} as writen in (2.25) of \cite{Gagnaire-Renou2009}, the source term is +\begin{equation} +S_{\mathrm{nl}}(\sigma,\theta) = 8 \sum_s \int_{\sigma_1=0}^\infty \int_{\theta_1=0}^{2 \pi} \int_{\sigma_2=0}^{(\sigma+\sigma_1)/2} T \frac{F_2 F_3 (F \sigma_1^4 + F_1 \sigma^4) - F F_1 (F_2 \sigma_3^4 + F_3 \sigma_2^4)}{\sqrt{B}\sqrt{((\left| \bk+\bk_1 \right|/g- \sigma_3^2)^2-\sigma_2^4} } {\mathrm d}\sigma_1 {\mathrm d}\theta_1 {\mathrm d}\sigma_2 , + \label{eq:snl_gqm} +\end{equation} +where $B$ is given by eq. (A5) of Lavrenov (2001) and +\begin{equation} +T(\bk,\bk_1,\bk_2,\bk_3) = \frac{\pi g^2 D^2(\bk,\bk_1,\bk_2,\bk_3) }{4 \sigma \sigma_1 \sigma_2 \sigma_3} +\end{equation} +where $ D(\bk,\bk_1,\bk_2,\bk_3)$ is given by \cite{Webb1978} in his eq. (A1). + +This triple integral is performed using quadrature functions to best resolve the effect of the singularities in the denominator. It is thus replaced with weighted sums over the 3 dimensions. + +Compared to the DIA, there is no bilinear interpolation and the nearest neighbor is used in frequency and direction. Also, +the source term is computed by a loop over the quadruplet configuration, which allows for filtering based on +both the value of the coupling coefficient and the energy level at the frequency corresponding to $\bk$. Within +that loop, the source term contribution is computed for all 4 interacting components, so that any filtering still +conserves energy, action, momentum ... (One may argue that this multiplies by 4 the number of calculations, but it may have the benefit of properly dealing with the high frequency boundary... this is to be verified. The same question arises for the DIA: why have the wavenumber $\bk$ play the role of the other members of the quadruplets when this will also be computed as we loop on the spectral components?). + +If a very aggressive filtering is performed, the source may need to be rescaled. + diff --git a/manual/eqs/output.tex b/manual/eqs/output.tex index 1f512b16a..bfa7e0b5a 100644 --- a/manual/eqs/output.tex +++ b/manual/eqs/output.tex @@ -12,9 +12,9 @@ \subsection{~Output parameters} \label{sub:outpars} in \para\ref{sec:ww3shel}. That input file also provides a list of flags indicating if output parameters are available in different field output file types (ASCII, grib, igrads, NetCDF). -For any details on how these parameters are computed, the user may read the code of the {\code w3iogo} routine, in the {\code w3iogomd.ftn} module. +For any details on how these parameters are computed, the user may read the code of the {\code w3iogo} routine, in the {\code w3iogomd.F90} module. -Selection of field outputs in {\code ww3\_shel.inp} is most easily performed by providing a list of the +Selection of field outputs in {\code ww3\_shel.nml} or {\code ww3\_shel.inp} is most easily performed by providing a list of the requested parameters, for example, {\textbf HS DIR SPR} will request the calculation of significant wave height, mean direction and directional spread. These will thus be stored in the {\code out\_grd.XX} file and can be post-processed, for example in NetCDF using {\code ww3\_ouf}. Examples are given in \para\ref{sec:ww3multi} and \para\ref{sec:ww3ounf}. The names for these namelists are the bold names below, for example \textbf{HS}. @@ -26,6 +26,9 @@ \subsection{~Output parameters} \label{sub:outpars} file extensions, NetCDF variable names and namelist-based selection (see also \para\ref{sec:ww3ounf}), and the long parameter name/definition. +When the result is not overly sensitive to the contribution of the unresolved part of the spectrum (for $f @file +!> @brief Generate GrADS input files from raw WAVEWATCH data file. +!> +!> @author H. L. Tolman +!> @author A. Chawla +!> @author J.H.G.M. Alves +!> @date 22-Mar-2021 +!> #include "w3macros.h" + !/ ------------------------------------------------------------------- / +!> +!> @brief Generate GrADS input files from raw WAVEWATCH data file. +!> +!> @details +!> Data is read from the grid output file out_grd.ww3 (raw data) +!> and from the file gx_outf.inp ( NDSI, output requests ). +!> Model definition and raw data files are read using WAVEWATCH III +!> subroutines. +!> +!> Output files are ww3.ctl and ww3.grads. The output files +!> contains a land-sea map, followed by requested fields. See the +!> control file for the names of the fields. +!> +!> @author H. L. Tolman +!> @author A. Chawla +!> @author J.H.G.M. Alves +!> @date 22-Mar-2021 +!> +!> @copyright Copyright 2009-2022 National Weather Service (NWS), +!> National Oceanic and Atmospheric Administration. All rights +!> reserved. WAVEWATCH III is a trademark of the NWS. +!> No unauthorized use without permission. +!> PROGRAM GXOUTF !/ !/ +-----------------------------------+ @@ -740,6 +772,16 @@ PROGRAM GXOUTF !/ CONTAINS !/ ------------------------------------------------------------------- / + !> + !> @brief Perform actual output for GrADS postprocessing. + !> + !> @param[in] NX Grid dimensions. + !> @param[in] NY Grid dimensions. + !> @param[in] NSEA Number of sea points. + !> + !> @author H. L. Tolman + !> @date 22-Mar-2021 + !> SUBROUTINE GXEXGO ( NX, NY, NSEA ) !/ !/ +-----------------------------------+ diff --git a/model/src/gx_outp.F90 b/model/src/gx_outp.F90 index 63b525485..d34fdbaa7 100644 --- a/model/src/gx_outp.F90 +++ b/model/src/gx_outp.F90 @@ -1,5 +1,27 @@ +!> @file +!> @brief Post-processing of point output for GrADS post-processing. +!> +!> @author H. L. Tolman +!> @author J.H. Alves +!> @author F. Ardhuin +!> @date 27-Aug-2015 +!> + #include "w3macros.h" !/ ------------------------------------------------------------------- / +!> +!> @brief Post-processing of point output for GrADS post-processing. +!> +!> @author H. L. Tolman +!> @author J.H. Alves +!> @author F. Ardhuin +!> @date 27-Aug-2015 +!> +!> @copyright Copyright 2009-2022 National Weather Service (NWS), +!> National Oceanic and Atmospheric Administration. All rights +!> reserved. WAVEWATCH III is a trademark of the NWS. +!> No unauthorized use without permission. +!> PROGRAM GXOUTP !/ !/ +-----------------------------------+ @@ -539,6 +561,12 @@ PROGRAM GXOUTP !/ CONTAINS !/ ------------------------------------------------------------------- / + !> + !> @brief Perform actual point output. + !> + !> @author H. L. Tolman + !> @date 16-Jul-2012 + !> SUBROUTINE GXEXPO !/ !/ +-----------------------------------+ diff --git a/model/src/w3adatmd.F90 b/model/src/w3adatmd.F90 index a48af3199..7e09ca02a 100644 --- a/model/src/w3adatmd.F90 +++ b/model/src/w3adatmd.F90 @@ -189,6 +189,7 @@ MODULE W3ADATMD ! MSSD R.A. Public Direction of MSSX ! MSCD R.A. Public Direction of MSCX ! QP R.A. Public Goda peakedness parameter. + ! QKK R.A. Public Spectral bandwidth (De Carlo et al. 2023) ! ! DTDYN R.A. Public Mean dynamic time step (raw). ! FCUT R.A. Public Cut-off frequency for tail. @@ -477,9 +478,9 @@ MODULE W3ADATMD ! Output fields group 8) ! REAL, POINTER :: MSSX(:), MSSY(:), MSSD(:), & - MSCX(:), MSCY(:), MSCD(:) + MSCX(:), MSCY(:), MSCD(:), QKK(:) REAL, POINTER :: XMSSX(:), XMSSY(:), XMSSD(:), & - XMSCX(:), XMSCY(:), XMSCD(:) + XMSCX(:), XMSCY(:), XMSCD(:), XQKK(:) ! ! Output fields group 9) ! @@ -619,7 +620,7 @@ MODULE W3ADATMD BEDFORMS(:,:), PHIBBL(:), TAUBBL(:,:) ! REAL, POINTER :: MSSX(:), MSSY(:), MSSD(:), & - MSCX(:), MSCY(:), MSCD(:) + MSCX(:), MSCY(:), MSCD(:), QKK(:) ! REAL, POINTER :: DTDYN(:), FCUT(:), CFLXYMAX(:), & CFLTHMAX(:), CFLKMAX(:) @@ -1276,7 +1277,7 @@ SUBROUTINE W3DIMA ( IMOD, NDSE, NDST, D_ONLY ) ALLOCATE ( WADATS(IMOD)%MSSX(NSEALM), WADATS(IMOD)%MSSY(NSEALM), & WADATS(IMOD)%MSCX(NSEALM), WADATS(IMOD)%MSCY(NSEALM), & WADATS(IMOD)%MSSD(NSEALM), WADATS(IMOD)%MSCD(NSEALM), & - STAT=ISTAT ) + WADATS(IMOD)%QKK(NSEALM), STAT=ISTAT ) CHECK_ALLOC_STATUS ( ISTAT ) ! WADATS(IMOD)%MSSX = UNDEF @@ -1285,6 +1286,7 @@ SUBROUTINE W3DIMA ( IMOD, NDSE, NDST, D_ONLY ) WADATS(IMOD)%MSCX = UNDEF WADATS(IMOD)%MSCY = UNDEF WADATS(IMOD)%MSCD = UNDEF + WADATS(IMOD)%QKK = UNDEF call print_memcheck(memunit, 'memcheck_____:'//' W3DIMA 8') ! ! 9) Numerical diagnostics @@ -2298,6 +2300,12 @@ SUBROUTINE W3XDMA ( IMOD, NDSE, NDST, OUTFLAGS ) ALLOCATE ( WADATS(IMOD)%XQP(1) ) END IF ! + IF ( OUTFLAGS( 8, 6) ) THEN + ALLOCATE ( WADATS(IMOD)%XQKK(NXXX) ) + ELSE + ALLOCATE ( WADATS(IMOD)%XQKK(1) ) + END IF + ! WADATS(IMOD)%XMSSX = UNDEF WADATS(IMOD)%XMSSY = UNDEF WADATS(IMOD)%XMSSD = UNDEF @@ -2305,6 +2313,7 @@ SUBROUTINE W3XDMA ( IMOD, NDSE, NDST, OUTFLAGS ) WADATS(IMOD)%XMSCY = UNDEF WADATS(IMOD)%XMSCD = UNDEF WADATS(IMOD)%XQP(1) = UNDEF + WADATS(IMOD)%XQKK = UNDEF ! IF ( OUTFLAGS( 9, 1) ) THEN ALLOCATE ( WADATS(IMOD)%XDTDYN(NXXX), STAT=ISTAT ) @@ -2918,6 +2927,7 @@ SUBROUTINE W3SETA ( IMOD, NDSE, NDST ) MSCX => WADATS(IMOD)%MSCX MSCY => WADATS(IMOD)%MSCY MSCD => WADATS(IMOD)%MSCD + QKK => WADATS(IMOD)%QKK ! DTDYN => WADATS(IMOD)%DTDYN FCUT => WADATS(IMOD)%FCUT @@ -3258,6 +3268,7 @@ SUBROUTINE W3XETA ( IMOD, NDSE, NDST ) MSCX => WADATS(IMOD)%XMSCX MSCY => WADATS(IMOD)%XMSCY MSCD => WADATS(IMOD)%XMSCD + QKK => WADATS(IMOD)%XQKK ! DTDYN => WADATS(IMOD)%XDTDYN FCUT => WADATS(IMOD)%XFCUT diff --git a/model/src/w3canomd.F90 b/model/src/w3canomd.F90 index de287eb85..5395853f2 100644 --- a/model/src/w3canomd.F90 +++ b/model/src/w3canomd.F90 @@ -1,5 +1,25 @@ +!> @file +!> @brief Calculation of the second order correction to the surface +!> gravity wave spectrum. +!> +!> @author P.A.E.M. Janssen +!> @date 21-Aug-2014 +!> + #include "w3macros.h" !/ ------------------------------------------------------------------- / +!> +!> @brief Calculation of the second order correction to the surface +!> gravity wave spectrum. +!> +!> @author P.A.E.M. Janssen +!> @date 21-Aug-2014 +!> +!> @copyright Copyright 2009-2022 National Weather Service (NWS), +!> National Oceanic and Atmospheric Administration. All rights +!> reserved. WAVEWATCH III is a trademark of the NWS. +!> No unauthorized use without permission. +!> MODULE W3CANOMD !/ !/ +-----------------------------------+ @@ -117,6 +137,18 @@ MODULE W3CANOMD !/ CONTAINS !/ ------------------------------------------------------------------- / + !> + !> @brief Adds second order spectrum on top of first order spectrum. + !> + !> @param[inout] E Energy density spectrum (1-D), f-theta. + !> @param[in] DEPTH Mean water depth. + !> @param[in] WN Wavenumbers. + !> @param[in] CG Group velocities. + !> @param[in] IACTION Action density spectrum (1-D). + !> + !> @author F. Ardhuin + !> @date 19-Oct-2012 + !> SUBROUTINE W3ADD2NDORDER(E,DEPTH,WN,CG,IACTION) !/ !/ +-----------------------------------+ @@ -313,6 +345,25 @@ END SUBROUTINE W3ADD2NDORDER !----------------------------------------------------------------------- ! + !> + !> @brief Determines second order spectrum. + !> + !> @param[in] F1 2-D free wave spectrum + !> @param[out] F3 2-D spectrum including 2nd-order correction + !> @param[in] NFRE number of frequencies + !> @param[in] NANG number of directions + !> @param[in] FR frequencies + !> @param[in] DFIM frequency increment + !> @param[in] TH directional array + !> @param[in] DELTH directional increment + !> @param[in] DPTH depth array + !> @param[in] SIGM mapping indicator + !> @param[in] NFREH + !> @param[in] NANGH + !> + !> @author Peter Janssen + !> @date NA + !> SUBROUTINE CAL_SEC_ORDER_SPEC(F1,F3,NFRE,NANG,FR,DFIM,TH,DELTH, & DPTH,SIGM, NFREH, NANGH) ! @@ -649,6 +700,23 @@ END SUBROUTINE CAL_SEC_ORDER_SPEC ! !-------------------------------------------------------------------- ! + !> + !> @brief Computes tables for second order spectrum in frequency space. + !> + !> @param NFRE number of frequencies + !> @param NANG number of directions + !> @param NDEPTH number of entries in the depth table + !> @param DEPTHA + !> @param OMSTART start frequency + !> @param FRAC fractional increase in frequency space + !> @param XMR inverse of thinning factor in frequency space + !> @param DFDTH product of increment in frequency and direction + !> @param OMEGA angular frequency array + !> @param TH direction array + !> + !> @author NA + !> @date NA + !> SUBROUTINE TABLES_2ND(NFRE,NANG,NDEPTH,DEPTHA,OMSTART,FRAC,XMR,& DFDTH,OMEGA,TH) ! @@ -821,6 +889,35 @@ END SUBROUTINE TABLES_2ND ! !-------------------------------------------------------------------- ! + !> + !> @brief Computes second order spectrum in frequency space. + !> + !> @param F1 2D free wave spectrum (input) + !> @param F3 bound waves spectrum (output) + !> @param NFRE number of frequencies + !> @param NANG number of directions + !> @param NMAX maximum index corresponds to twice the cut-off frequency + !> + !> @param NDEPTH number of entries in depth table + !> @param DEPTHA start value depth array + !> @param DEPTHD increment depth array + !> @param OMSTART start value angular frequency array + !> @param FRAC fractional increase in frequency space + !> @param MR thinning factor in frequency space + !> @param OMEGA angular frequency array + !> @param DEPTH depth array + !> @param AKMEAN mean wavenumber array + !> @param TA table for minus interactions + !> @param TB table for plus interactions + !> @param TC_QL table for quasi-linear interactions + !> @param TT_4M table for stokes frequency correction + !> @param TT_4P table for stokes frequency correction + !> @param IM_P table for wavenumber m2 plus + !> @param IM_M table for wavenumber m2 min + !> + !> @author NA + !> @date NA + !> SUBROUTINE SECSPOM(F1,F3,NFRE,NANG,NMAX,NDEPTH,& DEPTHA,DEPTHD,OMSTART,FRAC,MR,DFDTH,OMEGA,& DEPTH,AKMEAN,TA,TB,TC_QL,TT_4M,TT_4P,& @@ -1035,14 +1132,28 @@ SUBROUTINE SECSPOM(F1,F3,NFRE,NANG,NMAX,NDEPTH,& ! RETURN END SUBROUTINE SECSPOM + ! - ! - !----------------------------------------------------------------------- - ! - !*** *REAL FUNCTION* *A(XI,XJ,THI,THJ) - ! - !----------------------------------------------------------------------- + !> + !> @brief Gives nonlinear transfer coefficient for three wave interactions + !> interactions of gravity waves in the ideal case of no current. Determines + !> the minus interaction coefficients. + !> + !> @param XI wave number + !> @param XJ wave number + !> @param THI + !> @param THJ + !> @returns A + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION A(XI,XJ,THI,THJ) + !----------------------------------------------------------------------- + ! + !*** *REAL FUNCTION* *A(XI,XJ,THI,THJ) + ! + !----------------------------------------------------------------------- ! !*** *A* DETERMINES THE MINUS INTERACTIONS. ! @@ -1100,10 +1211,24 @@ REAL FUNCTION A(XI,XJ,THI,THJ) RETURN END FUNCTION A ! - !*** *REAL FUNCTION* *B(XI,XJ,THI,THJ) - ! - !----------------------------------------------------------------------- + !> + !> @brief Gives nonlinear transfer coefficient for three wave interactions + !> interactions of gravity waves in the ideal case of no current. Determines + !> the plus interaction coefficients. + !> + !> @param XI wave number + !> @param XJ wave number + !> @param THI + !> @param THJ + !> @returns B + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION B(XI,XJ,THI,THJ) + !*** *REAL FUNCTION* *B(XI,XJ,THI,THJ) + ! + !----------------------------------------------------------------------- ! !*** *B* DETERMINES THE PLUS INTERACTION COEFFICIENTS. ! @@ -1160,12 +1285,24 @@ REAL FUNCTION B(XI,XJ,THI,THJ) RETURN END FUNCTION B ! - !----------------------------------------------------------------------- - ! - !*** *REAL FUNCTION* *C_QL(XK0,XK1,TH0,TH1) - ! - !----------------------------------------------------------------------- + !> + !> @brief Determine contribution by quasi-linear terms. + !> + !> @param XK0 + !> @param XK1 + !> @param TH0 + !> @param TH1 + !> @returns C_QL + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION C_QL(XK0,XK1,TH0,TH1) + !----------------------------------------------------------------------- + ! + !*** *REAL FUNCTION* *C_QL(XK0,XK1,TH0,TH1) + ! + !----------------------------------------------------------------------- ! !*** *A* DETERMINES THE QUASI-LINEAR TERM. ! @@ -1212,12 +1349,27 @@ END FUNCTION C_QL ! ! - !----------------------------------------------------------------------- - ! - !*** *REAL FUNCTION* *VPLUS(XI,XJ,XK,THI,THJ,THK) - ! - !----------------------------------------------------------------------- + !> + !> @brief Determines the second-order transfer coefficient + !> for three wave interactions of gravity waves. + !> + !> @param XI wave numbers + !> @param XJ wave numbers + !> @param XK wave numbers + !> @param THI wave direction + !> @param THJ wave direction + !> @param THK wave direction + !> @returns VPLUS + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION VPLUS(XI,XJ,XK,THI,THJ,THK) + !----------------------------------------------------------------------- + ! + !*** *REAL FUNCTION* *VPLUS(XI,XJ,XK,THI,THJ,THK) + ! + !----------------------------------------------------------------------- ! !*** *VPLUS* DETERMINES THE SECOND-ORDER TRANSFER COEFFICIENT ! FOR THREE WAVE INTERACTIONS OF GRAVITY WAVES. @@ -1288,12 +1440,27 @@ REAL FUNCTION VPLUS(XI,XJ,XK,THI,THJ,THK) RETURN END FUNCTION VPLUS ! - !----------------------------------------------------------------------- - ! - !*** *REAL FUNCTION* *VMIN(XI,XJ,XK,THI,THJ,THK) - ! - !----------------------------------------------------------------------- + !> + !> @brief Determines the second-order transfer coefficient for + !> three wave interactions of gravity waves. + !> + !> @param XI wave number + !> @param XJ wave number + !> @param XK wave number + !> @param THI wave direction + !> @param THJ wave direction + !> @param THK wave direction + !> @returns VMIN + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION VMIN(XI,XJ,XK,THI,THJ,THK) + !----------------------------------------------------------------------- + ! + !*** *REAL FUNCTION* *VMIN(XI,XJ,XK,THI,THJ,THK) + ! + !----------------------------------------------------------------------- ! !*** *VMIN* DETERMINES THE SECOND-ORDER TRANSFER COEFFICIENT FOR ! THREE WAVE INTERACTIONS OF GRAVITY WAVES. @@ -1364,12 +1531,29 @@ REAL FUNCTION VMIN(XI,XJ,XK,THI,THJ,THK) RETURN END FUNCTION VMIN ! - !----------------------------------------------------------------------- - ! - !*** *REAL FUNCTION* *U(XI,XJ,XK,XL,THI,THJ,THK,THL) - ! - !----------------------------------------------------------------------- + !> + !> @brief Determines the third-order transfer coefficient for four + !> wave interactions of gravity waves. + !> + !> @param XI wave number + !> @param XJ wave number + !> @param XK wave number + !> @param XL wave number + !> @param THI + !> @param THJ + !> @param THK + !> @param THL + !> @returns U + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION U(XI,XJ,XK,XL,THI,THJ,THK,THL) + !----------------------------------------------------------------------- + ! + !*** *REAL FUNCTION* *U(XI,XJ,XK,XL,THI,THJ,THK,THL) + ! + !----------------------------------------------------------------------- ! !*** *U* DETERMINES THE THIRD-ORDER TRANSFER COEFFICIENT FOR FOUR ! WAVE INTERACTIONS OF GRAVITY WAVES. @@ -1438,12 +1622,29 @@ REAL FUNCTION U(XI,XJ,XK,XL,THI,THJ,THK,THL) RETURN END FUNCTION U ! - !----------------------------------------------------------------------- - ! - !*** *REAL FUNCTION* *W2(XI,XJ,XK,XL,THI,THJ,THK,THL) - ! - !----------------------------------------------------------------------- + !> + !> @brief Determines the contribution of the direct four-wave + !> interactions of gravity waves of the type A_2^*A_3A_4. + !> + !> @param XI Wave number + !> @param XJ Wave number + !> @param XK Wave number + !> @param XL Wave number + !> @param THI + !> @param THJ + !> @param THK + !> @param THL + !> @returns W2 + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION W2(XI,XJ,XK,XL,THI,THJ,THK,THL) + !----------------------------------------------------------------------- + ! + !*** *REAL FUNCTION* *W2(XI,XJ,XK,XL,THI,THJ,THK,THL) + ! + !----------------------------------------------------------------------- ! !*** *W2* DETERMINES THE CONTRIBUTION OF THE DIRECT FOUR-WAVE ! INTERACTIONS OF GRAVITY WAVES OF THE TYPE @@ -1490,12 +1691,29 @@ REAL FUNCTION W2(XI,XJ,XK,XL,THI,THJ,THK,THL) RETURN END FUNCTION W2 ! - !----------------------------------------------------------------------- - ! - !*** *REAL FUNCTION* *V2(XI,XJ,XK,XL,THI,THJ,THK,THL) - ! - !----------------------------------------------------------------------- + !> + !> @brief Determines the contribution of the virtual + !> four-wave interactions of gravity waves. + !> + !> @param XI Wave number + !> @param XJ Wave number + !> @param XK Wave number + !> @param XL Wave number + !> @param THI + !> @param THJ + !> @param THK + !> @param THL + !> @returns V2 + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION V2(XI,XJ,XK,XL,THI,THJ,THK,THL) + !----------------------------------------------------------------------- + ! + !*** *REAL FUNCTION* *V2(XI,XJ,XK,XL,THI,THJ,THK,THL) + ! + !----------------------------------------------------------------------- ! !*** *V2* DETERMINES THE CONTRIBUTION OF THE VIRTUAL ! FOUR-WAVE INTERACTIONS OF GRAVITY WAVES. @@ -1624,12 +1842,29 @@ REAL FUNCTION V2(XI,XJ,XK,XL,THI,THJ,THK,THL) RETURN END FUNCTION V2 ! - !----------------------------------------------------------------------- - ! - !*** *REAL FUNCTION* *W1(XI,XJ,XK,XL,THI,THJ,THK,THL) - ! - !----------------------------------------------------------------------- + !> + !> @brief Determines the nonlinear transfer coefficient for four wave + !> interactions of gravity waves of the type A_2A_3A_4. + !> + !> @param XI Wave number + !> @param XJ Wave number + !> @param XK Wave number + !> @param XL Wave number + !> @param THI + !> @param THJ + !> @param THK + !> @param THL + !> @returns W1 + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION W1(XI,XJ,XK,XL,THI,THJ,THK,THL) + !----------------------------------------------------------------------- + ! + !*** *REAL FUNCTION* *W1(XI,XJ,XK,XL,THI,THJ,THK,THL) + ! + !----------------------------------------------------------------------- ! !*** *W1* DETERMINES THE NONLINEAR TRANSFER COEFFICIENT FOR FOUR ! WAVE INTERACTIONS OF GRAVITY WAVES OF THE TYPE @@ -1683,10 +1918,29 @@ REAL FUNCTION W1(XI,XJ,XK,XL,THI,THJ,THK,THL) RETURN END FUNCTION W1 ! - !*** *REAL FUNCTION* *W4(XI,XJ,XK,XL,THI,THJ,THK,THL) - ! - !----------------------------------------------------------------------- + !> + !> @brief Determines the nonlinear transfer coefficient for four wave + !> interactions of gravity waves of the type A_^*A_3^*A_4^*. + !> + !> @param XI Wave number + !> @param XJ Wave number + !> @param XK Wave number + !> @param XL Wave number + !> @param THI + !> @param THJ + !> @param THK + !> @param THL + !> @returns W4 + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION W4(XI,XJ,XK,XL,THI,THJ,THK,THL) + !----------------------------------------------------------------------- + ! + !*** *REAL FUNCTION* *W4(XI,XJ,XK,XL,THI,THJ,THK,THL) + ! + !----------------------------------------------------------------------- ! !*** *W4* DETERMINES THE NONLINEAR TRANSFER COEFFICIENT FOR FOUR ! WAVE INTERACTIONS OF GRAVITY WAVES of the type @@ -1741,13 +1995,29 @@ REAL FUNCTION W4(XI,XJ,XK,XL,THI,THJ,THK,THL) RETURN END FUNCTION W4 - ! - !----------------------------------------------------------------------- - ! - !*** *REAL FUNCTION* *B3(XI,XJ,XK,XL,THI,THJ,THK,THL) - ! - !----------------------------------------------------------------------- + + !> + !> @brief Weights of the A_2^*A_3^*A_4 part of the canonical transformation. + !> + !> @param XI Wave number + !> @param XJ Wave number + !> @param XK Wave number + !> @param XL Wave number + !> @param THI + !> @param THJ + !> @param THK + !> @param THL + !> @returns B3 + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION B3(XI,XJ,XK,XL,THI,THJ,THK,THL) + !----------------------------------------------------------------------- + ! + !*** *REAL FUNCTION* *B3(XI,XJ,XK,XL,THI,THJ,THK,THL) + ! + !----------------------------------------------------------------------- ! !*** *B3* WEIGHTS OF THE A_2^*A_3^*A_4 PART OF THE ! CANONICAL TRANSFORMATION. @@ -1858,12 +2128,29 @@ REAL FUNCTION B3(XI,XJ,XK,XL,THI,THJ,THK,THL) RETURN END FUNCTION B3 ! - !----------------------------------------------------------------------- - ! - !*** *REAL FUNCTION* *B4(XI,XJ,XK,XL,THI,THJ,THK,THL) - ! - !----------------------------------------------------------------------- + !> + !> @brief Weights of the A_2^*A_3^*A_4^* part of the canonical + !> transformation. + !> + !> @param XI Wave number + !> @param XJ Wave number + !> @param XK Wave number + !> @param XL Wave number + !> @param THI + !> @param THJ + !> @param THK + !> @param THL + !> @returns B4 + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION B4(XI,XJ,XK,XL,THI,THJ,THK,THL) + !----------------------------------------------------------------------- + ! + !*** *REAL FUNCTION* *B4(XI,XJ,XK,XL,THI,THJ,THK,THL) + ! + !----------------------------------------------------------------------- ! !*** *B4* WEIGHTS OF THE A_2^*A_3^*A_4^* PART OF THE CANONICAL ! TRANSFORMATION. @@ -1954,12 +2241,29 @@ REAL FUNCTION B4(XI,XJ,XK,XL,THI,THJ,THK,THL) RETURN END FUNCTION B4 ! - !----------------------------------------------------------------------- - ! - !*** *REAL FUNCTION* *B1(XI,XJ,XK,XL,THI,THJ,THK,THL) - ! - !----------------------------------------------------------------------- + !> + !> @brief Weights of the A_2A_3A_4 part of the canonical + !> transformation. + !> + !> @param XI Wave number + !> @param XJ Wave number + !> @param XK Wave number + !> @param XL Wave number + !> @param THI + !> @param THJ + !> @param THK + !> @param THL + !> @returns B1 + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION B1(XI,XJ,XK,XL,THI,THJ,THK,THL) + !----------------------------------------------------------------------- + ! + !*** *REAL FUNCTION* *B1(XI,XJ,XK,XL,THI,THJ,THK,THL) + ! + !----------------------------------------------------------------------- ! !*** *B1* WEIGHTS OF THE A_2A_3A_4 PART OF THE CANONICAL ! TRANSFORMATION. @@ -2055,15 +2359,30 @@ REAL FUNCTION B1(XI,XJ,XK,XL,THI,THJ,THK,THL) ) +W1(RI,RJ,RK,RL,THI,THJ,THK,THL) ) RETURN END FUNCTION B1 - ! - !----------------------------------------------------------------------- - ! - !*** *REAL FUNCTION* *B2(XI,XJ,XK,XL,THI,THJ,THK,THL) - ! - !----------------------------------------------------------------------- + !> + !> @brief Weights of the A_2^*A_3A_4 part of the canonical + !> transformation. + !> + !> @param XI Wave number + !> @param XJ Wave number + !> @param XK Wave number + !> @param XL Wave number + !> @param THI + !> @param THJ + !> @param THK + !> @param THL + !> @returns B2 + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION B2(XI,XJ,XK,XL,THI,THJ,THK,THL) + !----------------------------------------------------------------------- ! + !*** *REAL FUNCTION* *B2(XI,XJ,XK,XL,THI,THJ,THK,THL) + ! + !----------------------------------------------------------------------- ! !*** *B2* WEIGHTS OF THE A_2^*A_3A_4 PART OF THE CANONICAL ! TRANSFORMATION. @@ -2155,12 +2474,26 @@ REAL FUNCTION B2(XI,XJ,XK,XL,THI,THJ,THK,THL) RETURN END FUNCTION B2 ! - !----------------------------------------------------------------------- - ! - !*** *REAL FUNCTION* *A1(XI,XJ,XK,THI,THJ,THK) - ! - !----------------------------------------------------------------------- + !> + !> @brief Auxiliary second-order coefficient. + !> + !> @param XI Wave number + !> @param XJ Wave number + !> @param XK Wave number + !> @param THI + !> @param THJ + !> @param THK + !> @returns A1 + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION A1(XI,XJ,XK,THI,THJ,THK) + !----------------------------------------------------------------------- + ! + !*** *REAL FUNCTION* *A1(XI,XJ,XK,THI,THJ,THK) + ! + !----------------------------------------------------------------------- ! !*** *A1* AUXILIARY SECOND-ORDER COEFFICIENT. ! @@ -2215,12 +2548,26 @@ REAL FUNCTION A1(XI,XJ,XK,THI,THJ,THK) RETURN END FUNCTION A1 ! - !----------------------------------------------------------------------- - ! - !*** *REAL FUNCTION* *A2(XI,XJ,XK,THI,THJ,THK) - ! - !----------------------------------------------------------------------- + !> + !> @brief Auxiliary second-order function. + !> + !> @param XI Wave number + !> @param XJ Wave number + !> @param XK Wave number + !> @param THI + !> @param THJ + !> @param THK + !> @returns A2 + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION A2(XI,XJ,XK,THI,THJ,THK) + !----------------------------------------------------------------------- + ! + !*** *REAL FUNCTION* *A2(XI,XJ,XK,THI,THJ,THK) + ! + !----------------------------------------------------------------------- ! !*** *A2* AUXILIARY SECOND-ORDER FUNCTION. ! @@ -2259,12 +2606,26 @@ REAL FUNCTION A2(XI,XJ,XK,THI,THJ,THK) RETURN END FUNCTION A2 ! - !----------------------------------------------------------------------- - ! - !*** *REAL FUNCTION* *A3(XI,XJ,XK,THI,THJ,THK) - ! - !----------------------------------------------------------------------- + !> + !> @brief Auxiliary second-order function. + !> + !> @param XI Wave number + !> @param XJ Wave number + !> @param XK Wave number + !> @param THI + !> @param THJ + !> @param THK + !> @returns A3 + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION A3(XI,XJ,XK,THI,THJ,THK) + !----------------------------------------------------------------------- + ! + !*** *REAL FUNCTION* *A3(XI,XJ,XK,THI,THJ,THK) + ! + !----------------------------------------------------------------------- ! !*** *A3* AUXILIARY SECOND-ORDER FUNCTION. ! @@ -2317,14 +2678,23 @@ REAL FUNCTION A3(XI,XJ,XK,THI,THJ,THK) END FUNCTION A3 ! - !----------------------------------------------------------------------- - ! - ! - !*** *REAL FUNCTION* *OMEG(X)* - ! - !----------------------------------------------------------------------- - ! + !> + !> @brief Determines the dispersion relation for gravity + !> waves. + !> + !> @param X Wave number + !> @returns OMEG + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION OMEG(X) + !----------------------------------------------------------------------- + ! + !*** *REAL FUNCTION* *OMEG(X)* + ! + !----------------------------------------------------------------------- + ! ! !*** *OMEG* DETERMINES THE DISPERSION RELATION FOR GRAVITY ! WAVES. @@ -2366,15 +2736,21 @@ REAL FUNCTION OMEG(X) RETURN END FUNCTION OMEG ! - ! - !----------------------------------------------------------------------- - ! - ! - !*** *REAL FUNCTION* *VG(X)* - ! - !----------------------------------------------------------------------- - ! + !> + !> @brief Determines the group velocity for gravity- waves. + !> + !> @param X Wave number + !> @returns VG + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION VG(X) + !----------------------------------------------------------------------- + ! + !*** *REAL FUNCTION* *VG(X)* + ! + !----------------------------------------------------------------------- ! !*** *VG* DETERMINES THE GROUP VELOCITY FOR GRAVITY- WAVES. ! @@ -2416,6 +2792,16 @@ REAL FUNCTION VG(X) RETURN END FUNCTION VG !--------------------------------------------------------------------- + !> + !> @brief Gives the wavenumber. + !> + !> @param OM + !> @param BETA + !> @returns AKI + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION AKI(OM,BETA) ! This function gives the wavenumber ... !--------------------------------------------------------------------- @@ -2444,6 +2830,18 @@ REAL FUNCTION AKI(OM,BETA) RETURN END FUNCTION AKI ! + !> + !> @brief NA. + !> + !> @param XI + !> @param XJ + !> @param THI + !> @param THJ + !> @returns VABS + !> + !> @author NA + !> @date NA + !> REAL FUNCTION VABS(XI,XJ,THI,THJ) ! !--------------------------------------------------------------------- @@ -2462,6 +2860,18 @@ REAL FUNCTION VABS(XI,XJ,THI,THJ) RETURN END FUNCTION VABS ! + !> + !> @brief NA. + !> + !> @param XI + !> @param XJ + !> @param THI + !> @param THJ + !> @returns VDIR + !> + !> @author NA + !> @date NA + !> REAL FUNCTION VDIR(XI,XJ,THI,THJ) ! !--------------------------------------------------------------------- diff --git a/model/src/w3gdatmd.F90 b/model/src/w3gdatmd.F90 index add5db979..0ac1e0ed4 100644 --- a/model/src/w3gdatmd.F90 +++ b/model/src/w3gdatmd.F90 @@ -429,6 +429,17 @@ MODULE W3GDATMD ! KDCON Real Public Conversion factor for relative depth. ! KDMN Real Public Minimum relative depth. ! SNLSn Real Public Constants in shallow water factor. + ! IQTPE Int. Public Type of depth treatment + ! -2 : Deep water GQM with scaling + ! 1 : Deep water DIA + ! 2 : Deep water DIA with scaling + ! 3 : Finite water depth DIA + ! GQNF1 Int. Public Gaussian quadrature resolution + ! GQNT1 Int. Public Gaussian quadrature resolution + ! GQNNQ_OM2 Int. Public Gaussian quadrature resolution + ! GQTHRSAT Real Public Threshold on saturation for SNL calculation + ! GQTHRCOU Real Public Threshold for filter on coupling coefficient + ! GQAMP R.A. Public Amplification factors ! (!/NL2) ! IQTPE Int. Public Type of depth treatment ! 1 : Deep water @@ -913,6 +924,8 @@ MODULE W3GDATMD #ifdef W3_NL1 REAL :: SNLC1, LAM, KDCON, KDMN, & SNLS1, SNLS2, SNLS3 + INTEGER :: IQTPE, GQNF1, GQNT1, GQNQ_OM2 + REAL :: NLTAIL, GQTHRSAT, GQTHRCOU, GQAMP(4) #endif #ifdef W3_NL2 INTEGER :: IQTPE, NDPTHS @@ -1326,6 +1339,8 @@ MODULE W3GDATMD !/ Data aliasses for structure SNLP(S) !/ #ifdef W3_NL1 + INTEGER, POINTER :: IQTPE, GQNF1, GQNT1, GQNQ_OM2 + REAL, POINTER :: NLTAIL, GQTHRSAT, GQTHRCOU, GQAMP(:) REAL, POINTER :: SNLC1, LAM, KDCON, KDMN, & SNLS1, SNLS2, SNLS3 #endif @@ -2701,6 +2716,14 @@ SUBROUTINE W3SETG ( IMOD, NDSE, NDST ) SNLS1 => MPARS(IMOD)%SNLPS%SNLS1 SNLS2 => MPARS(IMOD)%SNLPS%SNLS2 SNLS3 => MPARS(IMOD)%SNLPS%SNLS3 + IQTPE => MPARS(IMOD)%SNLPS%IQTPE + GQNF1 => MPARS(IMOD)%SNLPS%GQNF1 + GQNT1 => MPARS(IMOD)%SNLPS%GQNT1 + GQNQ_OM2 => MPARS(IMOD)%SNLPS%GQNQ_OM2 + NLTAIL => MPARS(IMOD)%SNLPS%NLTAIL + GQTHRSAT => MPARS(IMOD)%SNLPS%GQTHRSAT + GQTHRCOU=> MPARS(IMOD)%SNLPS%GQTHRCOU + GQAMP=> MPARS(IMOD)%SNLPS%GQAMP #endif #ifdef W3_NL2 IQTPE => MPARS(IMOD)%SNLPS%IQTPE diff --git a/model/src/w3gridmd.F90 b/model/src/w3gridmd.F90 index 052b1f2c9..8982785de 100644 --- a/model/src/w3gridmd.F90 +++ b/model/src/w3gridmd.F90 @@ -113,6 +113,7 @@ MODULE W3GRIDMD !/ 27-May-2021 : Moved to a subroutine ( version 7.13 ) !/ 07-Jun-2021 : S_{nl} GKE NL5 (Q. Liu) ( version 7.13 ) !/ 19-Jul-2021 : Momentum and air density support ( version 7.14 ) + !/ 28-Feb-2023 : GQM as an alternative for NL1 ( version 7.15 ) !/ !/ Copyright 2009-2013 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -439,7 +440,7 @@ MODULE W3GRIDMD ! (2006) input and Babanin et al. (2001,2010) dissipation. ! ! !/NL0 No nonlinear interactions. - ! !/NL1 Discrete interaction approximation (DIA). + ! !/NL1 Discrete interaction approximation (DIA or GQM). ! !/NL2 Exact interactions (WRT). ! !/NL3 Generalized Multiple DIA (GMD). ! !/NL4 Two Scale Approximation @@ -586,6 +587,9 @@ MODULE W3GRIDMD IY2, J, JJ, IXR(4), IYR(4), ISEAI(4),& IST, NKI, NTHI, NRIC, NRIS, I, IDFT, & NSTAT, NBT, NLAND, NOSW, NMAPB, IMAPB +#ifdef W3_ASCII + INTEGER :: NDSMA +#endif #ifdef W3_NL2 INTEGER :: IDEPTH #endif @@ -836,7 +840,7 @@ MODULE W3GRIDMD ! #ifdef W3_ST4 INTEGER :: SWELLFPAR, SDSISO, SDSBRFDF - REAL :: SDSBCHOICE + REAL :: SDSBCHOICE REAL :: ZWND, ALPHA0, Z0MAX, BETAMAX, SINTHP,& ZALP, Z0RAT, TAUWSHELTER, SWELLF, & SWELLF2,SWELLF3,SWELLF4, SWELLF5, & @@ -864,6 +868,8 @@ MODULE W3GRIDMD #ifdef W3_NL1 REAL :: LAMBDA, KDCONV, KDMIN, & SNLCS1, SNLCS2, SNLCS3 + INTEGER :: IQTYPE, GQMNF1, GQMNT1, GQMNQ_OM2 + REAL :: TAILNL, GQMTHRSAT, GQMTHRCOU, GQAMP1, GQAMP2, GQAMP3, GQAMP4 #endif #ifdef W3_NL2 INTEGER :: IQTYPE, NDEPTH @@ -995,7 +1001,9 @@ MODULE W3GRIDMD #endif #ifdef W3_NL1 NAMELIST /SNL1/ LAMBDA, NLPROP, KDCONV, KDMIN, & - SNLCS1, SNLCS2, SNLCS3 + SNLCS1, SNLCS2, SNLCS3, & + IQTYPE, TAILNL, GQMNF1, GQMNT1, & + GQMNQ_OM2, GQMTHRSAT, GQMTHRCOU, GQAMP1, GQAMP2, GQAMP3, GQAMP4 #endif #ifdef W3_NL2 NAMELIST /SNL2/ IQTYPE, TAILNL, NDEPTH @@ -1829,6 +1837,18 @@ SUBROUTINE W3GRID() SNLCS1 = 5.5 SNLCS2 = 0.833 SNLCS3 = -1.25 + ! Additional parameters for GQM + IQTYPE = 1 + TAILNL = -FACHF + GQMNF1 = 14 + GQMNT1 = 8 + GQMNQ_OM2=8 + GQMTHRSAT=0. + GQMTHRCOU=0.015 + GQAMP1=1. + GQAMP2=0.002 + GQAMP3=1. + GQAMP4=1. CALL READNL ( NDSS, 'SNL1', STATUS ) WRITE (NDSO,922) STATUS WRITE (NDSO,923) LAMBDA, NLPROP, KDCONV, KDMIN, & @@ -1840,6 +1860,18 @@ SUBROUTINE W3GRID() SNLS1 = SNLCS1 SNLS2 = SNLCS2 SNLS3 = SNLCS3 + ! Additional parameters for GQM + IQTPE = IQTYPE + GQNF1 = GQMNF1 + GQNT1 = GQMNT1 + GQNQ_OM2 = GQMNQ_OM2 + GQTHRSAT = GQMTHRSAT + GQTHRCOU = GQMTHRCOU + GQAMP(1) = GQAMP1 + GQAMP(2) = GQAMP2 + GQAMP(3) = GQAMP3 + GQAMP(4) = GQAMP4 + NLTAIL = TAILNL #endif ! #ifdef W3_ST0 @@ -3182,7 +3214,10 @@ SUBROUTINE W3GRID() #endif #ifdef W3_NL1 WRITE (NDSO,2922) LAMBDA, NLPROP, KDCONV, KDMIN, & - SNLCS1, SNLCS2, SNLCS3 + SNLCS1, SNLCS2, SNLCS3, & + IQTYPE, TAILNL, GQMNF1, & + GQMNT1, GQMNQ_OM2, GQMTHRSAT, GQMTHRCOU,& + GQAMP1, GQAMP2, GQAMP3, GQAMP4 #endif #ifdef W3_NL2 WRITE (NDSO,2922) IQTYPE, TAILNL, NDEPTH @@ -3280,7 +3315,7 @@ SUBROUTINE W3GRID() JGS_TERMINATE_DIFFERENCE, & JGS_TERMINATE_NORM, & JGS_LIMITER, & - JGS_LIMITER_FUNC, & + JGS_LIMITER_FUNC, & JGS_USE_JACOBI, & JGS_BLOCK_GAUSS_SEIDEL, & JGS_MAXITER, & @@ -3617,7 +3652,7 @@ SUBROUTINE W3GRID() END SELECT IF (FSTOTALIMP .or. FSTOTALEXP) THEN - LPDLIB = .TRUE. + LPDLIB = .TRUE. ENDIF ! IF (SUM(UNSTSCHEMES).GT.1) WRITE(NDSO,1035) @@ -5917,9 +5952,16 @@ SUBROUTINE W3GRID() !10. Write model definition file. ! WRITE (NDSO,999) - CALL W3IOGR ( 'WRITE', NDSM ) + CALL W3IOGR ( 'WRITE', NDSM & +#ifdef W3_ASCII + ,NDSA=NDSMA & +#endif + ) ! CLOSE (NDSM) +#ifdef W3_ASCII + CLOSE (NDSMA) +#endif ! GOTO 2222 ! @@ -6230,7 +6272,11 @@ SUBROUTINE W3GRID() 2922 FORMAT ( ' &SNL1 LAMBDA =',F7.3,', NLPROP =',E10.3, & ', KDCONV =',F7.3,', KDMIN =',F7.3,','/ & ' SNLCS1 =',F7.3,', SNLCS2 =',F7.3, & - ', SNLCS3 = ',F7.3,' /') + ', SNLCS3 = ',F7.3','/ & + ' IQTYPE =',I2,', TAILNL =',F5.1,','/ & + ' GQMNF1 =',I2,', GQMNT1 =',I2,',', & + ' GQMNQ_OM2 =',I2,', GQMTHRSAT =',E11.4,', GQMTHRCOU =',F4.3,','/ & + ' GQAMP1 =',F5.3,', GQAMP2 =',F5.3,', GQAMP3 =',F5.3,', GQAMP4 =',F5.3,' /') #endif ! #ifdef W3_NL2 diff --git a/model/src/w3initmd.F90 b/model/src/w3initmd.F90 index 9f7c62de8..2389539f1 100644 --- a/model/src/w3initmd.F90 +++ b/model/src/w3initmd.F90 @@ -239,6 +239,9 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, ! (first). ! 11: Track information file unit number. ! 12: Track output file unit number. + ! 13: Wave separation output file unit number. + ! 14: Grid output file unit number. + ! 15: Point output file unit number. ascii ! MTRACE I.A. I Array with subroutine tracing information. ! 1: Output unit number for trace. ! 2: Maximum number of trace prints. @@ -444,6 +447,12 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, #endif #ifdef W3_UOST USE W3UOSTMD, ONLY: UOST_SETGRID +#endif + use w3timemd, only : set_user_timestring + use w3odatmd, only : runtype, restart_from_binary, use_restartnc, user_restfname + use w3odatmd, only : logfile_is_assigned +#ifdef W3_PIO + use wav_restart_mod, only : read_restart #endif !/ #ifdef W3_MPI @@ -453,7 +462,7 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, !/ ------------------------------------------------------------------- / !/ Parameter list !/ - INTEGER, INTENT(IN) :: IMOD, MDS(13), MTRACE(2), & + INTEGER, INTENT(IN) :: IMOD, MDS(15), MTRACE(2), & ODAT(40),NPT, IPRT(6),& MPI_COMM LOGICAL, INTENT(IN) :: IsMulti @@ -512,7 +521,10 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, #ifdef W3_PDLIB INTEGER :: IScal(1), IPROC #endif + logical :: exists integer :: memunit + character(len=16) :: user_timestring !YYYY-MM-DD-SSSSS + character(len=1024) :: fname !/ !/ ------------------------------------------------------------------- / ! @@ -639,53 +651,53 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, IF (FSTOTALIMP .and. .NOT. LPDLIB) THEN WRITE(NDSE,*) 'IMPTOTAL is selected' WRITE(NDSE,*) 'But PDLIB is not' - CALL FLUSH(NDSE) - STOP + CALL FLUSH(NDSE) + STOP ELSE IF (FSTOTALEXP .and. .NOT. LPDLIB) THEN WRITE(NDSE,*) 'EXPTOTAL is selected' WRITE(NDSE,*) 'But PDLIB is not' - CALL FLUSH(NDSE) - STOP + CALL FLUSH(NDSE) + STOP END IF #ifdef W3_PDLIB IF (B_JGS_BLOCK_GAUSS_SEIDEL .AND. .NOT. B_JGS_USE_JACOBI) THEN WRITE(NDSE,*) 'B_JGS_BLOCK_GAUSS_SEIDEL is used but the Jacobi solver is not choosen' WRITE(NDSE,*) 'Please set JGS_USE_JACOBI .eqv. .true.' - CALL FLUSH(NDSE) - STOP + CALL FLUSH(NDSE) + STOP ENDIF #endif - + ! ! 1.c Open files without unpacking MDS ,,, ! - IE = LEN_TRIM(FEXT) - LFILE = 'log.' // FEXT(:IE) - IFL = LEN_TRIM(LFILE) + if (.not. logfile_is_assigned) then + IE = LEN_TRIM(FEXT) + LFILE = 'log.' // FEXT(:IE) + IFL = LEN_TRIM(LFILE) #ifdef W3_SHRD - TFILE = 'test.' // FEXT(:IE) + TFILE = 'test.' // FEXT(:IE) #endif #ifdef W3_DIST - IW = 1 + INT ( LOG10 ( REAL(NAPROC) + 0.5 ) ) - IW = MAX ( 3 , MIN ( 9 , IW ) ) - WRITE (FORMAT,'(A5,I1.1,A1,I1.1,A4)') & - '(A4,I', IW, '.', IW, ',2A)' - WRITE (TFILE,FORMAT) 'test', & - OUTPTS(IMOD)%IAPROC, '.', FEXT(:IE) -#endif - IFT = LEN_TRIM(TFILE) - J = LEN_TRIM(FNMPRE) - ! -#ifndef W3_CESMCOUPLED - IF ( OUTPTS(IMOD)%IAPROC .EQ. OUTPTS(IMOD)%NAPLOG ) & - OPEN (MDS(1),FILE=FNMPRE(:J)//LFILE(:IFL),ERR=888,IOSTAT=IERR) -#endif - ! - IF ( MDS(3).NE.MDS(1) .AND. MDS(3).NE.MDS(4) .AND. TSTOUT ) THEN - INQUIRE (MDS(3),OPENED=OPENED) - IF ( .NOT. OPENED ) OPEN (MDS(3),FILE=FNMPRE(:J)//TFILE(:IFT), ERR=889, & - IOSTAT=IERR) - END IF + IW = 1 + INT ( LOG10 ( REAL(NAPROC) + 0.5 ) ) + IW = MAX ( 3 , MIN ( 9 , IW ) ) + WRITE (FORMAT,'(A5,I1.1,A1,I1.1,A4)') & + '(A4,I', IW, '.', IW, ',2A)' + WRITE (TFILE,FORMAT) 'test', & + OUTPTS(IMOD)%IAPROC, '.', FEXT(:IE) +#endif + IFT = LEN_TRIM(TFILE) + J = LEN_TRIM(FNMPRE) + ! + IF ( OUTPTS(IMOD)%IAPROC .EQ. OUTPTS(IMOD)%NAPLOG ) & + OPEN (MDS(1),FILE=FNMPRE(:J)//LFILE(:IFL),ERR=888,IOSTAT=IERR) + ! + IF ( MDS(3).NE.MDS(1) .AND. MDS(3).NE.MDS(4) .AND. TSTOUT ) THEN + INQUIRE (MDS(3),OPENED=OPENED) + IF ( .NOT. OPENED ) OPEN (MDS(3),FILE=FNMPRE(:J)//TFILE(:IFT), ERR=889, & + IOSTAT=IERR) + END IF + end if ! if (.not. logfile_is_assigned) ! ! 1.d Dataset unit numbers ! @@ -725,6 +737,7 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, ! 2.a Read model definition file ! CALL W3IOGR ( 'READ', NDS(5), IMOD, FEXT ) + IF (GTYPE .eq. UNGTYPE) THEN CALL SPATIAL_GRID CALL NVECTRI @@ -952,40 +965,69 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, ! 3.a Read restart file ! VA(:,:) = 0. +#ifdef W3_PIO + if (use_restartnc) then + if (runtype == 'continue' )then + call set_user_timestring(time,user_timestring) + if (restart_from_binary) then + fname = trim(user_restfname)//trim(user_timestring) + else + fname = trim(user_restfname)//trim(user_timestring)//'.nc' + endif + inquire(file=trim(fname), exist=exists) + if (exists) then + if (restart_from_binary) then + call w3iors('READ', nds(6), sig(nk), imod, filename=trim(fname)) + else + call read_restart(trim(fname), va=va, mapsta=mapsta, mapst2=mapst2) + end if + else + call extcde (60, msg="required restart file " // trim(fname) // " does not exist") + end if + else + call read_restart('none') + ! mapst2 is module variable defined in read of mod_def; maptst is from 2.b above + flcold = .true. + end if + else +#endif + #ifdef W3_DEBUGCOH - CALL ALL_VA_INTEGRAL_PRINT(IMOD, "Before W3IORS call", 1) + CALL ALL_VA_INTEGRAL_PRINT(IMOD, "Before W3IORS call", 1) #endif #ifdef W3_TIMINGS - CALL PRINT_MY_TIME("Before W3IORS") + CALL PRINT_MY_TIME("Before W3IORS") #endif - CALL W3IORS ( 'READ', NDS(6), SIG(NK), IMOD) + CALL W3IORS ( 'READ', NDS(6), SIG(NK), IMOD) #ifdef W3_TIMINGS - CALL PRINT_MY_TIME("After W3IORS") + CALL PRINT_MY_TIME("After W3IORS") #endif - call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 3a') + call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 3a') #ifdef W3_DEBUGCOH - CALL ALL_VA_INTEGRAL_PRINT(IMOD, "After W3IORS call", 1) -#endif - FLCOLD = RSTYPE.LE.1 .OR. RSTYPE.EQ.4 - IF ( IAPROC .EQ. NAPLOG ) THEN - IF (RSTYPE.EQ.0) THEN - WRITE (NDSO,930) 'cold start (idealized).' - ELSE IF ( RSTYPE .EQ. 1 ) THEN - WRITE (NDSO,930) 'cold start (wind).' - ELSE IF ( RSTYPE .EQ. 4 ) THEN - WRITE (NDSO,930) 'cold start (calm).' - ELSE - WRITE (NDSO,930) 'full restart.' + CALL ALL_VA_INTEGRAL_PRINT(IMOD, "After W3IORS call", 1) +#endif + FLCOLD = RSTYPE.LE.1 .OR. RSTYPE.EQ.4 + IF ( IAPROC .EQ. NAPLOG ) THEN + IF (RSTYPE.EQ.0) THEN + WRITE (NDSO,930) 'cold start (idealized).' + ELSE IF ( RSTYPE .EQ. 1 ) THEN + WRITE (NDSO,930) 'cold start (wind).' + ELSE IF ( RSTYPE .EQ. 4 ) THEN + WRITE (NDSO,930) 'cold start (calm).' + ELSE + WRITE (NDSO,930) 'full restart.' + END IF END IF - END IF #ifdef W3_DEBUGCOH - CALL ALL_VA_INTEGRAL_PRINT(IMOD, "W3INIT, step 4.2", 1) + CALL ALL_VA_INTEGRAL_PRINT(IMOD, "W3INIT, step 4.2", 1) #endif #ifdef W3_TIMINGS - CALL PRINT_MY_TIME("After restart inits") + CALL PRINT_MY_TIME("After restart inits") +#endif +#ifdef W3_PIO + end if ! if (use_restartnc) #endif - ! ! 3.b Compare MAPSTA from grid and restart ! @@ -1263,7 +1305,6 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, ! MAPTST = MOD(MAPST2/2,2) MAPST2 = MAPST2 - 2*MAPTST - ! !Li For multi-resolution SMC grid, these 1-NX and 1-NY nested loops !Li may miss the refined cells as they are not 1-1 corresponding to @@ -1305,10 +1346,10 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, END DO !Li END DO #ifdef W3_DEBUGSTP - WRITE(740+IAPROC,*) 'w3initmd 1: max/min(WLVeff)=', max_val, min_val - FLUSH(740+IAPROC) - max_val = 0 - min_val = 0 + WRITE(740+IAPROC,*) 'w3initmd 1: max/min(WLVeff)=', max_val, min_val + FLUSH(740+IAPROC) + max_val = 0 + min_val = 0 #endif DO JSEA=1, NSEAL CALL INIT_GET_ISEA(ISEA, JSEA) @@ -1337,12 +1378,10 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, CALL SET_IOBDP_PDLIB ENDIF #endif - ! #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "W3INIT, step 8.2", 1) #endif - ! MAPST2 = MAPST2 + 2*MAPTST ! @@ -1396,7 +1435,6 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, ! END DO END DO - ! ! 6. Initialize arrays ---------------------------------------------- / ! Some initialized in W3IORS @@ -1413,7 +1451,7 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, ! ! 7. Write info to log file ----------------------------------------- / ! - IF ( IAPROC .EQ. NAPLOG ) THEN + IF ( IAPROC .EQ. NAPLOG) THEN ! WRITE (NDSO,970) GNAME IF ( FLLEV ) WRITE (NDSO,971) 'Prescribed' @@ -1500,7 +1538,9 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, WRITE (NDSO,990) DTME21 END IF ! - WRITE (NDSO,984) + if (.not. logfile_is_assigned) then + WRITE (NDSO,984) + end if ! END IF ! @@ -2149,7 +2189,7 @@ SUBROUTINE W3MPIO ( IMOD ) STMAXE, STMAXD, HMAXE, HCMAXE, HMAXD, & HCMAXD, QP, PTHP0, PQP, PPE, PGW, PSW, & PTM1, PT1, PT2, PEP, WBT, CX, CY, & - TAUOCX, TAUOCY, WNMEAN + TAUOCX, TAUOCY, WNMEAN, QKK #endif USE W3ADATMD, ONLY: USSHX, USSHY @@ -2171,6 +2211,7 @@ SUBROUTINE W3MPIO ( IMOD ) #endif USE W3GDATMD, ONLY: GTYPE, UNGTYPE USE CONSTANTS, ONLY: LPDLIB + use w3odatmd, only : restart_from_binary, use_restartnc, use_historync !/ #ifdef W3_MPI INCLUDE "mpif.h" @@ -2202,6 +2243,7 @@ SUBROUTINE W3MPIO ( IMOD ) #ifdef W3_MPIT CHARACTER(LEN=5) :: STRING #endif + logical :: do_rstsetup !/ !/ ------------------------------------------------------------------- / !/ @@ -2225,7 +2267,7 @@ SUBROUTINE W3MPIO ( IMOD ) IROOT = NAPFLD - 1 ! ! - IF ((FLOUT(1) .OR. FLOUT(7)) .and. (.not. LPDLIB)) THEN + IF ((FLOUT(1) .OR. FLOUT(7)) .and. (.not. LPDLIB) .and. (.not. use_historync)) THEN ! ! NRQMAX is the maximum number of output fields that require MPI communication, ! aimed to gather field values stored in each processor into one processor in @@ -3415,6 +3457,20 @@ SUBROUTINE W3MPIO ( IMOD ) #ifdef W3_MPI END IF ! + IF ( FLGRDALL( 8, 6) ) THEN + IH = IH + 1 + IT = IT + 1 + CALL MPI_SEND_INIT (QKK (1),NSEALM , MPI_REAL, IROOT, & + IT, MPI_COMM_WAVE, IRQGO(IH), IERR) +#endif +#ifdef W3_MPIT + WRITE (NDST,9011) IH, ' 8/06', IROOT, IT, IRQGO(IH), IERR +#endif +#ifdef W3_MPI + END IF +#endif + ! +#ifdef W3_MPI IF ( FLGRDALL( 9, 1) ) THEN IH = IH + 1 IT = IT + 1 @@ -4665,6 +4721,20 @@ SUBROUTINE W3MPIO ( IMOD ) #ifdef W3_MPI END IF ! + IF ( FLGRDALL( 8, 6) ) THEN + IH = IH + 1 + IT = IT + 1 + CALL MPI_RECV_INIT (QKK (I0),1,WW3_FIELD_VEC, IFROM, IT, & + MPI_COMM_WAVE, IRQGO2(IH), IERR ) +#endif +#ifdef W3_MPIT + WRITE (NDST,9011) IH, ' 8/06', IFROM, IT, IRQGO2(IH), IERR +#endif +#ifdef W3_MPI + END IF +#endif + ! +#ifdef W3_MPI IF ( FLGRDALL( 9, 1) ) THEN IH = IH + 1 IT = IT + 1 @@ -4760,7 +4830,7 @@ SUBROUTINE W3MPIO ( IMOD ) CALL EXTCDE (11) END IF ! - END IF ! IF ((FLOUT(1) .OR. FLOUT(7)) .and. (.not. LPDLIB)) THEN + END IF ! IF ((FLOUT(1) .OR. FLOUT(7)) .and. (.not. LPDLIB) .and. (.not. use_historync)) THEN ! ! 2. Set-up for W3IORS ---------------------------------------------- / ! 2.a General preparations @@ -4769,7 +4839,17 @@ SUBROUTINE W3MPIO ( IMOD ) IH = 0 IROOT = NAPRST - 1 ! - IF ((FLOUT(4) .OR. FLOUT(8)) .and. (.not. LPDLIB)) THEN + if (use_restartnc) then + if (restart_from_binary) then + do_rstsetup = .true. + else + do_rstsetup = .false. + end if + else + do_rstsetup = .true. + end if + ! + IF ((FLOUT(4) .OR. FLOUT(8)) .and. (.not. LPDLIB) .and. do_rstsetup) THEN IF (OARST) THEN ALLOCATE ( OUTPTS(IMOD)%OUT4%IRQRS(34*NAPROC) ) ELSE @@ -5647,7 +5727,7 @@ SUBROUTINE W3MPIO ( IMOD ) ! END IF ! - END IF ! IF ((FLOUT(4) .OR. FLOUT(8)) .and. (.not. LPDLIB)) THEN + END IF ! IF ((FLOUT(4) .OR. FLOUT(8)) .and. (.not. LPDLIB) .and. do_rstsetup) THEN #endif ! ! 3. Set-up for W3IOBC ( SENDs ) ------------------------------------ / diff --git a/model/src/w3iogomd.F90 b/model/src/w3iogomd.F90 index 61495a6fe..a6406c93a 100644 --- a/model/src/w3iogomd.F90 +++ b/model/src/w3iogomd.F90 @@ -1123,6 +1123,9 @@ SUBROUTINE W3FLDTOIJ(FLD, I, J, IAPROC, NAPOUT, NDSEN) CASE('QP') I = 8 J = 5 + CASE('QKK') + I = 8 + J = 6 ! ! Group 9 ! @@ -1294,7 +1297,7 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) TH2M, STH2M, HSIG, STMAXE, STMAXD, & HCMAXE, HMAXE, HCMAXD, HMAXD, USSP, QP, PQP,& PTHP0, PPE, PGW, PSW, PTM1, PT1, PT2, PEP, & - WBT + WBT, QKK USE W3ODATMD, ONLY: NDST, UNDEF, IAPROC, NAPROC, NAPFLD, & ICPRT, DTPRT, WSCUT, NOSWLL, FLOGRD, FLOGR2,& NOGRP, NGRPP @@ -1357,7 +1360,8 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) STMAXDL(NSEAL), TLPHI(NSEAL), & WL02X(NSEAL), WL02Y(NSEAL), & ALPXT(NSEAL), ALPYT(NSEAL), & - ALPXY(NSEAL), SCREST(NSEAL) + ALPXY(NSEAL), SCREST(NSEAL), & + QK1(NSEAL), QK2(NSEAL) REAL USSCO, FT1 REAL, SAVE :: HSMIN = 0.01 LOGICAL :: FLOLOC(NOGRP,NGRPP) @@ -1439,6 +1443,7 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) TLPHI = 0. STMAXEL = 0. STMAXDL = 0. + QK2 = 0. ! HS = UNDEF WLM = UNDEF @@ -1455,6 +1460,7 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) ALPXY = UNDEF ALPXT = UNDEF ALPYT = UNDEF + QKK = UNDEF THMP = UNDEF T02P = UNDEF SCREST = UNDEF @@ -1496,6 +1502,7 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) ABXY = 0. ABYX = 0. ABST = 0. + QK1 = 0. ! ! 2.b Integrate energy in band ! @@ -1521,6 +1528,7 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) IF (ITH.LE.NTH/2) THEN ABST(JSEA) = ABST(JSEA) + & A(ITH,IK,JSEA)*A(ITH+NTH/2,IK,JSEA) + QK1 (JSEA) = QK1(JSEA) + (A(ITH,IK,JSEA)+A(ITH+NTH/2,IK,JSEA))**2 END IF CALL INIT_GET_ISEA(ISEA, JSEA) FACTOR = MAX ( 0.5 , CG(IK,ISEA)/SIG(IK)*WN(IK,ISEA) ) @@ -1547,8 +1555,8 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) DO JSEA=1, NSEAL CALL INIT_GET_ISEA(ISEA, JSEA) FACTOR = DDEN(IK) / CG(IK,ISEA) - EBD(IK,JSEA) = AB(JSEA) * FACTOR - ET(JSEA) = ET(JSEA) + EBD(IK,JSEA) + EBD(IK,JSEA) = AB(JSEA) * FACTOR ! this is E(f)*df + ET (JSEA) = ET (JSEA) + EBD(IK,JSEA) #ifdef W3_IG1 IF (IK.EQ.NINT(IGPARS(5))) HSIG(JSEA) = 4*SQRT(ET(JSEA)) #endif @@ -1556,7 +1564,8 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) EWN(JSEA) = EWN(JSEA) + EBD(IK,JSEA) / WN(IK,ISEA) ETR(JSEA) = ETR(JSEA) + EBD(IK,JSEA) / SIG(IK) ET1(JSEA) = ET1(JSEA) + EBD(IK,JSEA) * SIG(IK) - EET1(JSEA) = EET1(JSEA)+ EBD(IK,JSEA)**2 * SIG(IK) + ! EET1(JSEA) = EET1(JSEA)+ EBD(IK,JSEA)**2 * SIG(IK) + EET1(JSEA) = EET1(JSEA)+ EBD(IK,JSEA)**2 * SIG(IK)/DSII(IK) ET02(JSEA) = ET02(JSEA)+ EBD(IK,JSEA) * SIG(IK)**2 ETX(JSEA) = ETX(JSEA) + ABX(JSEA) * FACTOR ETY(JSEA) = ETY(JSEA) + ABY(JSEA) * FACTOR @@ -1565,6 +1574,8 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) TUSY(JSEA) = TUSY(JSEA) + ABY(JSEA)*FACTOR & *GRAV*WN(IK,ISEA)/SIG(IK) ETXX(JSEA) = ETXX(JSEA) + ABX2(JSEA) * FACTOR* WN(IK,ISEA)**2 + ! NB: QK1 (JSEA) = QK1(JSEA) + A(ITH,IK,JSEA)**2 + QK2 (JSEA) = QK2 (JSEA) + QK1(JSEA) * FACTOR* SIG(IK) /WN(IK,ISEA) ETYY(JSEA) = ETYY(JSEA) + ABY2(JSEA) * FACTOR* WN(IK,ISEA)**2 ETXY(JSEA) = ETXY(JSEA) + ABYX(JSEA) * FACTOR* WN(IK,ISEA)**2 IF (SIG(IK)*0.5*(1+XFR).LT.0.4*TPI) THEN @@ -1979,13 +1990,13 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) ! 3.b Add tail ! ( DTH * SIG absorbed in FTxx ) - EBAND = AB(JSEA) / CG(NK,ISEA) + EBAND = AB(JSEA) / CG(NK,ISEA) ! EBAND is E(sigma)/sigma for the last frequency band ET (JSEA) = ET (JSEA) + FTE * EBAND EWN(JSEA) = EWN(JSEA) + FTWL * EBAND ETF(JSEA) = ETF(JSEA) + GRAV * FTTR * EBAND ! this is the integral of CgE in deep water ETR(JSEA) = ETR(JSEA) + FTTR * EBAND ET1(JSEA) = ET1(JSEA) + FT1 * EBAND - EET1(JSEA)= ET1(JSEA) + FT1 * EBAND**2 + ! EET1(JSEA)= EET1(JSEA) + FT1 * EBAND**2 : this was not correct. Actually tail may not be needed for Qp. ET02(JSEA)= ET02(JSEA)+ EBAND* 0.5 * SIG(NK)**4 * DTH ETX(JSEA) = ETX(JSEA) + FTE * ABX(JSEA) / CG(NK,ISEA) ETY(JSEA) = ETY(JSEA) + FTE * ABY(JSEA) / CG(NK,ISEA) @@ -2039,12 +2050,15 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) END IF #endif IF ( ET(JSEA) .GT. 1.E-7 ) THEN - QP(JSEA) = ( 2. / ET(JSEA)**2 ) * EET1(JSEA) * TPIINV**2 + QP(JSEA) = ( 2. / ET(JSEA)**2 ) * EET1(JSEA) WLM(JSEA) = EWN(JSEA) / ET(JSEA) * TPI T0M1(JSEA) = ETR(JSEA) / ET(JSEA) * TPI THS(JSEA) = RADE * SQRT ( MAX ( 0. , 2. * ( 1. - SQRT ( & MAX(0.,(ETX(JSEA)**2+ETY(JSEA)**2)/ET(JSEA)**2) ) ) ) ) IF ( THS(JSEA) .LT. 0.01*RADE*DTH ) THS(JSEA) = 0. + ! NB: QK1 (JSEA) = QK1(JSEA) + A(ITH,IK,JSEA)**2 + ! QK2 (JSEA) = QK2 (JSEA) + QK1(JSEA) * FACTOR* SIG(IK) /WN(IK,ISEA) + QKK (JSEA) = SQRT(0.5*QK2 (JSEA))/ET(JSEA) ELSE WLM(JSEA) = 0. T0M1(JSEA) = TPI / SIG(NK) @@ -2421,7 +2435,11 @@ END SUBROUTINE W3OUTG !> !> @author H. L. Tolman @date 22-Mar-2021 !> - SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) + SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & +#ifdef W3_ASCII + ,NDSOA & +#endif + ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | @@ -2554,7 +2572,7 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) CFLXYMAX, CFLTHMAX, CFLKMAX, P2SMS, US3D, & TH1M, STH1M, TH2M, STH2M, HSIG, PHICE, TAUICE,& STMAXE, STMAXD, HMAXE, HCMAXE, HMAXD, HCMAXD,& - USSP, TAUOCX, TAUOCY + USSP, TAUOCX, TAUOCY, QKK USE W3ADATMD, ONLY: USSHX, USSHY !/ USE W3ODATMD, ONLY: NOGRP, NGRPP, IDOUT, UNDEF, NDST, NDSE, & @@ -2570,8 +2588,6 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif - use w3timemd , only: set_user_timestring - use w3odatmd , only: use_user_histname, user_histfname ! !/ !/ ------------------------------------------------------------------- / @@ -2582,6 +2598,9 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) INTEGER, INTENT(IN), OPTIONAL :: IMOD CHARACTER, INTENT(IN) :: INXOUT*(*) CHARACTER(LEN=15) :: TIMETAG +#ifdef W3_ASCII + INTEGER, INTENT(IN), OPTIONAL :: NDSOA +#endif !/ !/ ------------------------------------------------------------------- / !/ Local parameters @@ -2600,8 +2619,6 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) #endif CHARACTER(LEN=30) :: IDTST, TNAME CHARACTER(LEN=10) :: VERTST - CHARACTER(len=512) :: FNAME - character(len=16) :: user_timestring !YYYY-MM-DD-SSSSS !/ !/ ------------------------------------------------------------------- / !/ @@ -2653,25 +2670,19 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) IF ( IPASS.EQ.1 .AND. OFILES(1) .EQ. 0) THEN I = LEN_TRIM(FILEXT) J = LEN_TRIM(FNMPRE) - if (use_user_histname) then - if (len_trim(user_histfname) == 0 ) then - call extcde (60, MSG="user history filename requested"// & - " but not provided") - end if - call set_user_timestring(time,user_timestring) - fname = trim(user_histfname)//trim(user_timestring) - else - fname = 'out_grd.'//FILEXT(:I) - end if ! #ifdef W3_T - WRITE (NDST,9001) FNMPRE(:J)//trim(fname) + WRITE (NDST,9001) FNMPRE(:J)//'out_grd.'//FILEXT(:I) #endif IF ( WRITE ) THEN - OPEN (NDSOG,FILE=FNMPRE(:J)//trim(fname), & - form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR) + OPEN (NDSOG,FILE=FNMPRE(:J)//'out_grd.'//FILEXT(:I), & + form ='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR) +#ifdef W3_ASCII + OPEN (NDSOA,FILE=FNMPRE(:J)//'out_grd.'//FILEXT(:I)//'.txt', & + form ='FORMATTED',ERR=800,IOSTAT=IERR) +#endif ELSE - OPEN (NDSOG,FILE=FNMPRE(:J)//trim(fname), & + OPEN (NDSOG,FILE=FNMPRE(:J)//'out_grd.'//FILEXT(:I), & form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR,STATUS='OLD') END IF ! @@ -2684,6 +2695,13 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) WRITE (NDSOG) & IDSTR, VEROGR, GNAME, NOGRP, NGRPP, NSEA, NX, NY, & UNDEF, NOSWLL +#ifdef W3_ASCII + WRITE (NDSOA,*) & + 'IDSTR, VEROGR, GNAME, NOGRP, NGRPP, NSEA, NX, NY, & + UNDEF, NOSWLL:', & + IDSTR, VEROGR, GNAME, NOGRP, NGRPP, NSEA, NX, NY, & + UNDEF, NOSWLL +#endif ELSE READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & IDTST, VERTST, TNAME, MOGRP, MGRPP, NSEA, NX, NY, & @@ -2730,30 +2748,23 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) CALL EXTCDE ( 2 ) END IF END IF - ! IF ( IPASS.GE.1 .AND. OFILES(1) .EQ. 1) THEN I = LEN_TRIM(FILEXT) J = LEN_TRIM(FNMPRE) - if (use_user_histname) then - if (len_trim(user_histfname) == 0 ) then - call extcde (60, MSG="user history filename requested"// & - " but not provided") - end if - call set_user_timestring(time,user_timestring) - fname = trim(user_histfname)//trim(user_timestring) - else - ! - ! Create TIMETAG for file name using YYYYMMDD.HHMMS prefix - WRITE(TIMETAG,"(i8.8,'.'i6.6)")TIME(1),TIME(2) + ! + ! Create TIMETAG for file name using YYYYMMDD.HHMMS prefix + WRITE(TIMETAG,"(i8.8,'.'i6.6)")TIME(1),TIME(2) #ifdef W3_T - WRITE (NDST,9001) FNMPRE(:J)//TIMETAG//'.out_grd.'//FILEXT(:I) + WRITE (NDST,9001) FNMPRE(:J)//TIMETAG//'.out_grd.'//FILEXT(:I) #endif - fname = TIMETAG//'.out_grd.'//FILEXT(:I) - end if IF ( WRITE ) THEN - OPEN (NDSOG,FILE=FNMPRE(:J)//trim(fname), & - form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR) + OPEN (NDSOG,FILE=FNMPRE(:J)//TIMETAG//'.out_grd.' & + //FILEXT(:I),form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR) +#ifdef W3_ASCII + OPEN (NDSOA,FILE=FNMPRE(:J)//TIMETAG//'.out_grd.' & + //FILEXT(:I)//'.txt',form='FORMATTED',ERR=800,IOSTAT=IERR) +#endif ELSE OPEN (NDSOG,FILE=FNMPRE(:J)//'out_grd.'//FILEXT(:I), & form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR,STATUS='OLD') @@ -2768,6 +2779,13 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) WRITE (NDSOG) & IDSTR, VEROGR, GNAME, NOGRP, NGRPP, NSEA, NX, NY, & UNDEF, NOSWLL +#ifdef W3_ASCII + WRITE (NDSOA,*) & + 'IDSTR, VEROGR, GNAME, NOGRP, NGRPP, NSEA, NX, NY, & + UNDEF, NOSWLL:', & + IDSTR, VEROGR, GNAME, NOGRP, NGRPP, NSEA, NX, NY, & + UNDEF, NOSWLL +#endif ELSE READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & IDTST, VERTST, TNAME, MOGRP, MGRPP, NSEA, NX, NY, & @@ -2806,6 +2824,10 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) ! IF ( WRITE ) THEN WRITE (NDSOG) TIME, FLOGRD +#ifdef W3_ASCII + WRITE (NDSOA,*) 'TIME, FLOGRD:', & + TIME, FLOGRD +#endif ELSE READ (NDSOG,END=803,ERR=802,IOSTAT=IERR) TIME, FLOGRD END IF @@ -2821,6 +2843,10 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) MAPTMP = MAPSTA + 8*MAPST2 WRITE (NDSOG) & ((MAPTMP(IY,IX),IX=1,NX),IY=1,NY) +#ifdef W3_ASCII + WRITE (NDSOA,*) 'MAPSTA:', & + ((MAPTMP(IY,IX),IX=1,NX),IY=1,NY) +#endif ELSE READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & ((MAPTMP(IY,IX),IX=1,NX),IY=1,NY) @@ -2958,6 +2984,7 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) IF ( FLOGRD( 8, 3) ) MSSD (ISEA) = UNDEF IF ( FLOGRD( 8, 4) ) MSCD (ISEA) = UNDEF IF ( FLOGRD( 8, 5) ) QP (ISEA) = UNDEF + IF ( FLOGRD( 8, 6) ) QKK (ISEA) = UNDEF ! IF ( FLOGRD( 9, 1) ) DTDYN (ISEA) = UNDEF IF ( FLOGRD( 9, 2) ) FCUT (ISEA) = UNDEF @@ -3018,9 +3045,18 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) ! IF ( IFI .EQ. 1 .AND. IFJ .EQ. 1 ) THEN WRITE ( NDSOG ) DW(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'DW:', DW(1:NSEA) +#endif ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 2 ) THEN WRITE ( NDSOG ) CX(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'CX:', CX(1:NSEA) +#endif WRITE ( NDSOG ) CY(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'CY:', CY(1:NSEA) +#endif ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 3 ) THEN DO ISEA=1, NSEA #ifdef W3_SMC @@ -3039,15 +3075,33 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) END IF END DO WRITE ( NDSOG ) AUX1 +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'AUX1 (UA*cos(UD)):', AUX1 +#endif WRITE ( NDSOG ) AUX2 +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'AUX2 (UA*sin(UD)):', AUX2 +#endif ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 4 ) THEN WRITE ( NDSOG ) AS(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'AS:', AS(1:NSEA) +#endif ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 5 ) THEN WRITE ( NDSOG ) WLV(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'WLV:', WLV(1:NSEA) +#endif ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 6 ) THEN WRITE ( NDSOG ) ICE(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'ICE:', ICE(1:NSEA) +#endif ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 7 ) THEN WRITE ( NDSOG ) BERG(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'BERG:', BERG(1:NSEA) +#endif ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 8 ) THEN DO ISEA=1, NSEA #ifdef W3_SMC @@ -3066,22 +3120,43 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) END IF END DO WRITE ( NDSOG ) AUX1 +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'AUX1 (TAUA*cos(TAUADIR)):', AUX1 +#endif WRITE ( NDSOG ) AUX2 +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'AUX2 (TAUA*sin(TAUADIR)):', AUX2 +#endif ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 9 ) THEN WRITE ( NDSOG ) RHOAIR(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'RHOAIR:', RHOAIR(1:NSEA) +#endif #ifdef W3_BT4 ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 10 ) THEN WRITE ( NDSOG ) SED_D50(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'SED_D50:', SED_D50(1:NSEA) +#endif #endif #ifdef W3_IS2 ELSE IF (IFI .EQ. 1 .AND. IFJ .EQ. 11 ) THEN WRITE (NDSOG ) ICEH(1:NSEA) +#ifdef W3_ASCII + WRITE (NDSOA,* ) 'ICEH:', ICEH(1:NSEA) +#endif ELSE IF (IFI .EQ. 1 .AND. IFJ .EQ. 12 ) THEN WRITE (NDSOG ) ICEF(1:NSEA) +#ifdef W3_ASCII + WRITE (NDSOA,* ) 'ICEF:', ICEF(1:NSEA) +#endif #endif #ifdef W3_SETUP ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 13 ) THEN WRITE ( NDSOG ) ZETA_SETUP(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'ZETA_SETUP:', ZETA_SETUP(1:NSEA) +#endif #endif ! @@ -3089,94 +3164,217 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) ! ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 1 ) THEN WRITE ( NDSOG ) HS(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'HS:', HS(1:NSEA) +#endif ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 2 ) THEN WRITE ( NDSOG ) WLM(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'WLM:', WLM(1:NSEA) +#endif ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 3 ) THEN WRITE ( NDSOG ) T02(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'T02:', T02(1:NSEA) +#endif ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 4 ) THEN WRITE ( NDSOG ) T0M1(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'T0M1:', T0M1(1:NSEA) +#endif ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 5 ) THEN WRITE ( NDSOG ) T01(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'T01:', T01(1:NSEA) +#endif ELSE IF ( (IFI .EQ. 2 .AND. IFJ .EQ. 6) .OR. & (IFI .EQ. 2 .AND. IFJ .EQ. 18) ) THEN ! Note: TP output is derived from FP field. WRITE ( NDSOG ) FP0(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'FP0:', FP0(1:NSEA) +#endif ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 7 ) THEN WRITE ( NDSOG ) THM(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'THM:', THM(1:NSEA) +#endif ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 8 ) THEN WRITE ( NDSOG ) THS(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'THS:', THS(1:NSEA) +#endif ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 9 ) THEN WRITE ( NDSOG ) THP0(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'THP0:', THP0(1:NSEA) +#endif ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 10 ) THEN WRITE ( NDSOG ) HSIG(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'HSIG:', HSIG(1:NSEA) +#endif ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 11 ) THEN WRITE ( NDSOG ) STMAXE(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'STMAXE:', STMAXE(1:NSEA) +#endif ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 12 ) THEN WRITE ( NDSOG ) STMAXD(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'STMAXD:', STMAXD(1:NSEA) +#endif ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 13 ) THEN WRITE ( NDSOG ) HMAXE(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'HMAXE:', HMAXE(1:NSEA) +#endif ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 14 ) THEN WRITE ( NDSOG ) HCMAXE(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'HCMAXE:', HCMAXE(1:NSEA) +#endif ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 15 ) THEN WRITE ( NDSOG ) HMAXD(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'HMAXD:', HMAXD(1:NSEA) +#endif ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 16 ) THEN WRITE ( NDSOG ) HCMAXD(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'HCMAXD:', HCMAXD(1:NSEA) +#endif ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 17 ) THEN WRITE ( NDSOG ) WBT(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'WBT:', WBT(1:NSEA) +#endif ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 19 ) THEN WRITE ( NDSOG ) WNMEAN(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'WNMEAN:', WNMEAN(1:NSEA) +#endif ! ! Section 3) ! ELSE IF ( IFI .EQ. 3 .AND. IFJ .EQ. 1 ) THEN WRITE ( NDSOG ) EF(1:NSEA,E3DF(2,1):E3DF(3,1)) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'EF:', EF(1:NSEA,E3DF(2,1):E3DF(3,1)) +#endif ELSE IF ( IFI .EQ. 3 .AND. IFJ .EQ. 2 ) THEN WRITE ( NDSOG ) TH1M(1:NSEA,E3DF(2,2):E3DF(3,2)) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TH1M:', TH1M(1:NSEA,E3DF(2,2):E3DF(3,2)) +#endif ELSE IF ( IFI .EQ. 3 .AND. IFJ .EQ. 3 ) THEN WRITE ( NDSOG ) STH1M(1:NSEA,E3DF(2,3):E3DF(3,3)) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'STH1M:', STH1M(1:NSEA,E3DF(2,3):E3DF(3,3)) +#endif ELSE IF ( IFI .EQ. 3 .AND. IFJ .EQ. 4 ) THEN WRITE ( NDSOG ) TH2M(1:NSEA,E3DF(2,4):E3DF(3,4)) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TH2M:', TH2M(1:NSEA,E3DF(2,4):E3DF(3,4)) +#endif ELSE IF ( IFI .EQ. 3 .AND. IFJ .EQ. 5 ) THEN WRITE ( NDSOG ) STH2M(1:NSEA,E3DF(2,5):E3DF(3,5)) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'STH2M:', STH2M(1:NSEA,E3DF(2,5):E3DF(3,5)) +#endif ELSE IF ( IFI .EQ. 3 .AND. IFJ .EQ. 6) THEN WRITE ( NDSOG ) WN(1:NK,1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'WN:', WN(1:NK,1:NSEA) +#endif ! ! Section 4) ! ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 1 ) THEN WRITE ( NDSOG ) PHS(1:NSEA,0:NOSWLL) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PHS:', PHS(1:NSEA,0:NOSWLL) +#endif ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 2 ) THEN WRITE ( NDSOG ) PTP(1:NSEA,0:NOSWLL) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PTP:', PTP(1:NSEA,0:NOSWLL) +#endif ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 3 ) THEN WRITE ( NDSOG ) PLP(1:NSEA,0:NOSWLL) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PLP:', PLP(1:NSEA,0:NOSWLL) +#endif ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 4 ) THEN WRITE ( NDSOG ) PDIR(1:NSEA,0:NOSWLL) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PDIR:', PDIR(1:NSEA,0:NOSWLL) +#endif ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 5 ) THEN WRITE ( NDSOG ) PSI(1:NSEA,0:NOSWLL) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PSI:', PSI(1:NSEA,0:NOSWLL) +#endif ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 6 ) THEN WRITE ( NDSOG ) PWS(1:NSEA,0:NOSWLL) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PWS:', PWS(1:NSEA,0:NOSWLL) +#endif ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 7 ) THEN WRITE ( NDSOG ) PTHP0(1:NSEA,0:NOSWLL) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PTHP0:', PTHP0(1:NSEA,0:NOSWLL) +#endif ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 8 ) THEN WRITE ( NDSOG ) PQP(1:NSEA,0:NOSWLL) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PQP:', PQP(1:NSEA,0:NOSWLL) +#endif ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 9 ) THEN WRITE ( NDSOG ) PPE(1:NSEA,0:NOSWLL) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PPE:', PPE(1:NSEA,0:NOSWLL) +#endif ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 10 ) THEN WRITE ( NDSOG ) PGW(1:NSEA,0:NOSWLL) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PGW:', PGW(1:NSEA,0:NOSWLL) +#endif ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 11 ) THEN WRITE ( NDSOG ) PSW(1:NSEA,0:NOSWLL) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PSW:', PSW(1:NSEA,0:NOSWLL) +#endif ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 12 ) THEN WRITE ( NDSOG ) PTM1(1:NSEA,0:NOSWLL) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PTM1:', PTM1(1:NSEA,0:NOSWLL) +#endif ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 13 ) THEN WRITE ( NDSOG ) PT1(1:NSEA,0:NOSWLL) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PT1:', PT1(1:NSEA,0:NOSWLL) +#endif ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 14 ) THEN WRITE ( NDSOG ) PT2(1:NSEA,0:NOSWLL) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PT2:', PT2(1:NSEA,0:NOSWLL) +#endif ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 15 ) THEN WRITE ( NDSOG ) PEP(1:NSEA,0:NOSWLL) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PEP:', PEP(1:NSEA,0:NOSWLL) +#endif ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 16 ) THEN WRITE ( NDSOG ) PWST(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PWST:', PWST(1:NSEA) +#endif ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 17 ) THEN WRITE ( NDSOG ) PNR(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PNR:', PNR(1:NSEA) +#endif ! ! Section 5) ! @@ -3195,71 +3393,186 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) END IF END DO WRITE ( NDSOG ) AUX1 +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'AUX1 (UST*ASF*cos(USTDIR)):', AUX1 +#endif WRITE ( NDSOG ) AUX2 +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'AUX2 (UST*ASF*sin(USTDIR)):', AUX2 +#endif ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 2 ) THEN WRITE ( NDSOG ) CHARN(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'CHARN:', CHARN(1:NSEA) +#endif ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 3 ) THEN WRITE ( NDSOG ) CGE(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'CGE:', CGE(1:NSEA) +#endif ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 4 ) THEN WRITE ( NDSOG ) PHIAW(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PHIAW:', PHIAW(1:NSEA) +#endif ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 5 ) THEN WRITE ( NDSOG ) TAUWIX(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TAUWIX:', TAUWIX(1:NSEA) +#endif WRITE ( NDSOG ) TAUWIY(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TAUWIY:', TAUWIY(1:NSEA) +#endif ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 6 ) THEN WRITE ( NDSOG ) TAUWNX(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TAUWNX:', TAUWNX(1:NSEA) +#endif WRITE ( NDSOG ) TAUWNY(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TAUWNY:', TAUWNY(1:NSEA) +#endif ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 7 ) THEN WRITE ( NDSOG ) WHITECAP(1:NSEA,1) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'WHITECAP(1):', WHITECAP(1:NSEA,1) +#endif ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 8 ) THEN WRITE ( NDSOG ) WHITECAP(1:NSEA,2) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'WHITECAP(2):', WHITECAP(1:NSEA,2) +#endif ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 9 ) THEN WRITE ( NDSOG ) WHITECAP(1:NSEA,3) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'WHITECAP(3):', WHITECAP(1:NSEA,3) +#endif ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 10 ) THEN WRITE ( NDSOG ) WHITECAP(1:NSEA,4) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'WHITECAP(4):', WHITECAP(1:NSEA,4) +#endif ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 11 ) THEN WRITE ( NDSOG ) TWS(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TWS:', TWS(1:NSEA) +#endif ! ! Section 6) ! ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 1 ) THEN WRITE ( NDSOG ) SXX(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'SXX:', SXX(1:NSEA) +#endif WRITE ( NDSOG ) SYY(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'SYY:', SYY(1:NSEA) +#endif WRITE ( NDSOG ) SXY(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'SXY:', SXY(1:NSEA) +#endif ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 2 ) THEN WRITE ( NDSOG ) TAUOX(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TAUOX:', TAUOX(1:NSEA) +#endif WRITE ( NDSOG ) TAUOY(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TAUOY:', TAUOY(1:NSEA) +#endif ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 3 ) THEN WRITE ( NDSOG ) BHD(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'BHD:', BHD(1:NSEA) +#endif ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 4 ) THEN WRITE ( NDSOG ) PHIOC(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PHIOC:', PHIOC(1:NSEA) +#endif ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 5 ) THEN WRITE ( NDSOG ) TUSX(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TUSX:', TUSX(1:NSEA) +#endif WRITE ( NDSOG ) TUSY(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TUSY:', TUSY(1:NSEA) +#endif ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 6 ) THEN WRITE ( NDSOG ) USSX(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'USSX:', USSX(1:NSEA) +#endif WRITE ( NDSOG ) USSY(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'USSY:', USSY(1:NSEA) +#endif ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 7 ) THEN WRITE ( NDSOG ) PRMS(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PRMS:', PRMS(1:NSEA) +#endif WRITE ( NDSOG ) TPMS(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TPMS:', TPMS(1:NSEA) +#endif ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 8 ) THEN WRITE ( NDSOG ) US3D(1:NSEA, US3DF(2):US3DF(3)) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'US3D:', US3D(1:NSEA, US3DF(2):US3DF(3)) +#endif WRITE ( NDSOG ) US3D(1:NSEA,NK+US3DF(2):NK+US3DF(3)) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'US3D+NK:', US3D(1:NSEA,NK+US3DF(2):NK+US3DF(3)) +#endif ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 9 ) THEN WRITE ( NDSOG ) P2SMS(1:NSEA,P2MSF(2):P2MSF(3)) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'P2SMS:', P2SMS(1:NSEA,P2MSF(2):P2MSF(3)) +#endif ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 10 ) THEN WRITE ( NDSOG ) TAUICE(1:NSEA,1) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TAUICE(1):', TAUICE(1:NSEA,1) +#endif WRITE ( NDSOG ) TAUICE(1:NSEA,2) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TAUICE(2):', TAUICE(1:NSEA,2) +#endif ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 11 ) THEN WRITE ( NDSOG ) PHICE(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PHICE:', PHICE(1:NSEA) +#endif ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 12 ) THEN WRITE ( NDSOG ) USSP(1:NSEA, 1:USSPF(2)) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'USSP:', USSP(1:NSEA, 1:USSPF(2)) +#endif WRITE ( NDSOG ) USSP(1:NSEA,NK+1:NK+USSPF(2)) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'USSP:', USSP(1:NSEA,NK+1:NK+USSPF(2)) +#endif ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 13 ) THEN WRITE ( NDSOG ) TAUOCX(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TAUOCX:', TAUOCX(1:NSEA) +#endif WRITE ( NDSOG ) TAUOCY(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TAUOCY:', TAUOCY(1:NSEA) +#endif ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 14 ) THEN WRITE ( NDSOG ) USSHX(1:NSEA) WRITE ( NDSOG ) USSHY(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'USSHX:', USSHX(1:NSEA) + WRITE ( NDSOA,* ) 'USSHY:', USSHY(1:NSEA) +#endif ! ! Section 7) ! @@ -3274,7 +3587,13 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) END IF END DO WRITE ( NDSOG ) AUX1 +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'AUX1 (ABA*cos(ABD)):', AUX1 +#endif WRITE ( NDSOG ) AUX2 +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'AUX2 (ABA*sin(ABD)):', AUX2 +#endif !WRITE ( NDSOG ) ABA(1:NSEA) !WRITE ( NDSOG ) ABD(1:NSEA) ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 2 ) THEN @@ -3288,51 +3607,119 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) END IF END DO WRITE ( NDSOG ) AUX1 +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'AUX1 (UBA*cos(UBD)):', AUX1 +#endif WRITE ( NDSOG ) AUX2 +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'AUX2 (UBA*sin(UBD)):', AUX2 +#endif ! WRITE ( NDSOG ) UBA(1:NSEA) ! WRITE ( NDSOG ) UBD(1:NSEA) ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 3 ) THEN WRITE ( NDSOG ) BEDFORMS(1:NSEA,1) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'BEDFORMS(1):', BEDFORMS(1:NSEA,1) +#endif WRITE ( NDSOG ) BEDFORMS(1:NSEA,2) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'BEDFORMS(2):', BEDFORMS(1:NSEA,2) +#endif WRITE ( NDSOG ) BEDFORMS(1:NSEA,3) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'BEDFORMS(3):', BEDFORMS(1:NSEA,3) +#endif ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 4 ) THEN WRITE ( NDSOG ) PHIBBL(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PHIBBL:', PHIBBL(1:NSEA) +#endif ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 5 ) THEN WRITE ( NDSOG ) TAUBBL(1:NSEA,1) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TAUBBL(1):', TAUBBL(1:NSEA,1) +#endif WRITE ( NDSOG ) TAUBBL(1:NSEA,2) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TAUBBL(2):', TAUBBL(1:NSEA,2) +#endif ! ! Section 8) ! ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 1 ) THEN WRITE ( NDSOG ) MSSX(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'MSSX:', MSSX(1:NSEA) +#endif WRITE ( NDSOG ) MSSY(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'MSSY:', MSSY(1:NSEA) +#endif ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 2 ) THEN WRITE ( NDSOG ) MSCX(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'MSCX:', MSCX(1:NSEA) +#endif WRITE ( NDSOG ) MSCY(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'MSCY:', MSCY(1:NSEA) +#endif ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 3 ) THEN WRITE ( NDSOG ) MSSD(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'MSSD:', MSSD(1:NSEA) +#endif ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 4 ) THEN WRITE ( NDSOG ) MSCD(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'MSCD:', MSCD(1:NSEA) +#endif ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 5 ) THEN WRITE ( NDSOG ) QP(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'QP:', QP(1:NSEA) +#endif + ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 6 ) THEN + WRITE ( NDSOG ) QKK(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'QKK:', QKK(1:NSEA) +#endif ! ! Section 9) ! ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 1 ) THEN WRITE ( NDSOG ) DTDYN(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'DTDYN:', DTDYN(1:NSEA) +#endif ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 2 ) THEN WRITE ( NDSOG ) FCUT(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'FCUT:', FCUT(1:NSEA) +#endif ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 3 ) THEN WRITE ( NDSOG ) CFLXYMAX(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'CFLXYMAX:', CFLXYMAX(1:NSEA) +#endif ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 4 ) THEN WRITE ( NDSOG ) CFLTHMAX(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'CFLTHMAX:', CFLTHMAX(1:NSEA) +#endif ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 5 ) THEN WRITE ( NDSOG ) CFLKMAX(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'CFLMAX:', CFLKMAX(1:NSEA) +#endif ! ! Section 10) ! ELSE IF ( IFI .EQ. 10 ) THEN WRITE ( NDSOG ) USERO(1:NSEA,IFJ) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'USER0:', USERO(1:NSEA,IFJ) +#endif ! END IF ! @@ -3652,6 +4039,8 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) MSCD(1:NSEA) ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 5 ) THEN READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) QP(1:NSEA) + ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 6 ) THEN + READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) QKK(1:NSEA) ! ! Section 9) ! diff --git a/model/src/w3iogoncdmd.F90 b/model/src/w3iogoncdmd.F90 deleted file mode 100644 index 813aa28d2..000000000 --- a/model/src/w3iogoncdmd.F90 +++ /dev/null @@ -1,538 +0,0 @@ -!> @file w3iogoncmd -!! -!> @brief Write gridded model output as netCDF -!! -!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov -!> @date 01-05-2022 -#include "w3macros.h" - -module w3iogoncdmd - - use w3gdatmd , only : nk, nx, ny, mapsf, mapsta, nsea - use w3odatmd , only : noswll, undef - use w3odatmd , only : nds, iaproc, napout - use netcdf - - implicit none - - private - - public :: w3iogoncd - - ! used/reused in module - - integer :: isea, ierr, ncid, varid - integer :: len_s, len_m, len_p, len_k - character(len=1024) :: fname - - real, allocatable, target :: var3ds(:,:,:) - real, allocatable, target :: var3dm(:,:,:) - real, allocatable, target :: var3dp(:,:,:) - real, allocatable, target :: var3dk(:,:,:) - - real, pointer :: var3d(:,:,:) - - !=============================================================================== -contains - !=============================================================================== - - subroutine w3iogoncd () - - use w3odatmd , only : fnmpre - use w3gdatmd , only : filext, trigp, ntri, ungtype, gtype - use w3servmd , only : extcde - use w3wdatmd , only : w3setw, w3dimw, time, wlv, ice, icef, iceh, berg, ust, ustdir, asf, rhoair - use w3gdatmd , only : xgrd, ygrd - use w3gdatmd , only : e3df, p2msf, us3df, usspf, w3setg - use w3odatmd , only : nogrp, ngrpp, idout, ndst, ndse, noswll, w3seto - use w3adatmd , only : w3seta, w3dima, w3xeta - use w3adatmd , only : ainit, dw, ua, ud, as, cx, cy, wn, taua, tauadir - use w3adatmd , only : hs, wlm, t02, t0m1, t01, fp0, thm, ths, thp0, wbt, wnmean - use w3adatmd , only : dtdyn - use w3adatmd , only : fcut, aba, abd, uba, ubd, sxx, syy, sxy - use w3adatmd , only : phs, ptp, plp, pdir, psi, pws, pwst, pnr - use w3adatmd , only : pthp0, pqp, ppe, pgw, psw, ptm1, pt1, pt2 - use w3adatmd , only : pep, usero, tauox, tauoy, tauwix, tauwiy - use w3adatmd , only : phiaw, phioc, tusx, tusy, prms, tpms - use w3adatmd , only : ussx, ussy, mssx, mssy, mssd, mscx, mscy - use w3adatmd , only : mscd, qp, tauwnx, tauwny, charn, tws, bhd - use w3adatmd , only : phibbl, taubbl, whitecap, bedforms, cge, ef - use w3adatmd , only : cflxymax, cflthmax, cflkmax, p2sms, us3d - use w3adatmd , only : th1m, sth1m, th2m, sth2m, hsig, phice, tauice - use w3adatmd , only : stmaxe, stmaxd, hmaxe, hcmaxe, hmaxd, hcmaxd, ussp, tauocx, tauocy - use w3adatmd , only : usshx, usshy - use wav_grdout , only : varatts, outvars - use w3timemd , only : set_user_timestring - use w3odatmd , only : time_origin, calendar_name, elapsed_secs - use w3odatmd , only : use_user_histname, user_histfname - !TODO: use unstr_mesh from wav_shr_mod; currently fails due to CI - !use wav_shr_mod, only : unstr_mesh - - ! local variables - integer :: igrd - integer ,target :: dimid3(3) - integer ,target :: dimid4(4) - integer ,pointer :: dimid(:) - character(len=12) :: vname - character(len=16) :: user_timestring !YYYY-MM-DD-SSSSS - - integer :: n, xtid, ytid, xeid, ztid, stid, mtid, ptid, ktid, timid, varid - logical :: s_axis = .false., m_axis = .false., p_axis = .false., k_axis = .false. - - !------------------------------------------------------------------------------- - - igrd = 1 - call w3seto ( igrd, ndse, ndst ) - call w3setg ( igrd, ndse, ndst ) - call w3seta ( igrd, ndse, ndst ) ! sets pointers into wadats in w3adatmd - call w3xeta ( igrd, ndse, ndst ) ! sets pointers into wadats in w3adatmd - call w3setw ( igrd, ndse, ndst ) ! sets pointers into wdatas in w3wdatmd - - ! ------------------------------------------------------------- - ! create the netcdf file - ! ------------------------------------------------------------- - - if (use_user_histname) then - if (len_trim(user_histfname) == 0 ) then - call extcde (60, msg="user history filename requested but not provided") - end if - call set_user_timestring(time,user_timestring) - fname = trim(user_histfname)//trim(user_timestring)//'.nc' - else - write(fname,'(a,i8.8,a1,i6.6,a)')trim(fnmpre),time(1),'.',time(2),'.out_grd.'//trim(filext)//'.nc' - end if - - len_s = noswll + 1 ! 0:noswll - len_m = p2msf(3)-p2msf(2) + 1 ! ? - len_p = usspf(2) ! partitions - len_k = e3df(3,1) - e3df(2,1) + 1 ! frequencies - - ! define the dimensions required for the requested gridded fields - do n = 1,size(outvars) - if (outvars(n)%validout) then - if(trim(outvars(n)%dims) == 's')s_axis = .true. - if(trim(outvars(n)%dims) == 'm')m_axis = .true. - if(trim(outvars(n)%dims) == 'p')p_axis = .true. - if(trim(outvars(n)%dims) == 'k')k_axis = .true. - end if - end do - - ! allocate arrays if needed - if (s_axis) allocate(var3ds(1:nx,1:ny,len_s)) - if (m_axis) allocate(var3dm(1:nx,1:ny,len_m)) - if (p_axis) allocate(var3dp(1:nx,1:ny,len_p)) - if (k_axis) allocate(var3dk(1:nx,1:ny,len_k)) - - ! create the netcdf file - ierr = nf90_create(trim(fname), nf90_clobber, ncid) - call handle_err(ierr, 'nf90_create') - ierr = nf90_def_dim(ncid, 'nx', nx, xtid) - ierr = nf90_def_dim(ncid, 'ny', ny, ytid) - ierr = nf90_def_dim(ncid, 'time', nf90_unlimited, timid) - - if (s_axis) ierr = nf90_def_dim(ncid, 'noswll', len_s, stid) - if (m_axis) ierr = nf90_def_dim(ncid, 'nm' , len_m, mtid) - if (p_axis) ierr = nf90_def_dim(ncid, 'np' , len_p, ptid) - if (k_axis) ierr = nf90_def_dim(ncid, 'freq' , len_k, ktid) - if (gtype .eq. ungtype) then - ierr = nf90_def_dim(ncid, 'ne' , ntri, xeid) - ierr = nf90_def_dim(ncid, 'nn' , 3, ztid) - end if - - ! define the time variable - ierr = nf90_def_var(ncid, 'time', nf90_double, timid, varid) - call handle_err(ierr,'def_timevar') - ierr = nf90_put_att(ncid, varid, 'units', trim(time_origin)) - call handle_err(ierr,'def_time_units') - ierr = nf90_put_att(ncid, varid, 'calendar', trim(calendar_name)) - call handle_err(ierr,'def_time_calendar') - - ! define the spatial axis variables (lat,lon) - ierr = nf90_def_var(ncid, 'lon', nf90_double, (/xtid,ytid/), varid) - call handle_err(ierr,'def_lonvar') - ierr = nf90_put_att(ncid, varid, 'units', 'degrees_east') - ierr = nf90_def_var(ncid, 'lat', nf90_double, (/xtid,ytid/), varid) - call handle_err(ierr,'def_latvar') - ierr = nf90_put_att(ncid, varid, 'units', 'degrees_north') - - ! add mapsta - ierr = nf90_def_var(ncid, 'mapsta', nf90_int, (/xtid, ytid, timid/), varid) - call handle_err(ierr, 'def_mapsta') - ierr = nf90_put_att(ncid, varid, 'units', 'unitless') - ierr = nf90_put_att(ncid, varid, 'long_name', 'map status') - - if (gtype .eq. ungtype) then - ierr = nf90_def_var(ncid, 'nconn', nf90_int, (/ztid,xeid/), varid) - call handle_err(ierr,'def_nodeconnections') - ierr = nf90_put_att(ncid, varid, 'units', 'unitless') - ierr = nf90_put_att(ncid, varid, 'long_name', 'node connectivity') - end if - - ! define the variables - dimid3(1:2) = (/xtid, ytid/) - dimid4(1:2) = (/xtid, ytid/) - do n = 1,size(outvars) - if (trim(outvars(n)%dims) == 's') then - dimid4(3:4) = (/stid, timid/) - dimid => dimid4 - else if (trim(outvars(n)%dims) == 'm') then - dimid4(3:4) = (/mtid, timid/) - dimid => dimid4 - else if (trim(outvars(n)%dims) == 'p') then - dimid4(3:4) = (/ptid, timid/) - dimid => dimid4 - else if (trim(outvars(n)%dims) == 'k') then - dimid4(3:4) = (/ktid, timid/) - dimid => dimid4 - else - dimid3(3) = timid - dimid => dimid3 - end if - - ierr = nf90_def_var(ncid, trim(outvars(n)%var_name), nf90_float, dimid, varid) - call handle_err(ierr, 'define variable '//trim((outvars(n)%var_name))) - ierr = nf90_put_att(ncid, varid, 'units' , trim(outvars(n)%unit_name)) - ierr = nf90_put_att(ncid, varid, 'long_name' , trim(outvars(n)%long_name)) - ierr = nf90_put_att(ncid, varid, '_FillValue', undef) - end do - ! end variable definitions - ierr = nf90_enddef(ncid) - call handle_err(ierr, 'end variable definition') - - ! write the time and spatial axis values (lat,lon,time) - ierr = nf90_inq_varid(ncid, 'lat', varid) - call handle_err(ierr, 'inquire variable lat ') - ierr = nf90_put_var(ncid, varid, transpose(ygrd)) - call handle_err(ierr, 'put lat') - - ierr = nf90_inq_varid(ncid, 'lon', varid) - call handle_err(ierr, 'inquire variable lon ') - ierr = nf90_put_var(ncid, varid, transpose(xgrd)) - call handle_err(ierr, 'put lon') - - ierr = nf90_inq_varid(ncid, 'time', varid) - call handle_err(ierr, 'inquire variable time ') - ierr = nf90_put_var(ncid, varid, elapsed_secs) - call handle_err(ierr, 'put time') - - if (gtype .eq. ungtype) then - ierr = nf90_inq_varid(ncid, 'nconn', varid) - call handle_err(ierr, 'inquire variable nconn ') - ierr = nf90_put_var(ncid, varid, trigp) - call handle_err(ierr, 'put trigp') - end if - - !maps - ierr = nf90_inq_varid(ncid, 'mapsta', varid) - call handle_err(ierr, 'inquire variable mapsta ') - ierr = nf90_put_var(ncid, varid, transpose(mapsta)) - call handle_err(ierr, 'put mapsta') - - ! close the file - ierr = nf90_close(ncid) - - ! write the requested variables - do n = 1,size(outvars) - vname = trim(outvars(n)%var_name) - if (trim(outvars(n)%dims) == 's') then - var3d => var3ds - ! Group 4 - if(vname .eq. 'PHS') call write_var3d(vname, phs (1:nsea,0:noswll) ) - if(vname .eq. 'PTP') call write_var3d(vname, ptp (1:nsea,0:noswll) ) - if(vname .eq. 'PLP') call write_var3d(vname, plp (1:nsea,0:noswll) ) - if(vname .eq. 'PDIR') call write_var3d(vname, pdir (1:nsea,0:noswll) ) - if(vname .eq. 'PSI') call write_var3d(vname, psi (1:nsea,0:noswll) ) - if(vname .eq. 'PWS') call write_var3d(vname, pws (1:nsea,0:noswll) ) - if(vname .eq. 'PDP') call write_var3d(vname, pthp0 (1:nsea,0:noswll) ) - if(vname .eq. 'PQP') call write_var3d(vname, pqp (1:nsea,0:noswll) ) - if(vname .eq. 'PPE') call write_var3d(vname, ppe (1:nsea,0:noswll) ) - if(vname .eq. 'PGW') call write_var3d(vname, pgw (1:nsea,0:noswll) ) - if(vname .eq. 'PSW') call write_var3d(vname, psw (1:nsea,0:noswll) ) - if(vname .eq. 'PTM1') call write_var3d(vname, ptm1 (1:nsea,0:noswll) ) - if(vname .eq. 'PT1') call write_var3d(vname, pt1 (1:nsea,0:noswll) ) - if(vname .eq. 'PT2') call write_var3d(vname, pt2 (1:nsea,0:noswll) ) - if(vname .eq. 'PEP') call write_var3d(vname, pep (1:nsea,0:noswll) ) - - else if (trim(outvars(n)%dims) == 'm') then ! m axis - var3d => var3dm - ! Group 6 - if (vname .eq. 'P2SMS') call write_var3d(vname, p2sms (1:nsea,p2msf(2):p2msf(3)) ) - - else if (trim(outvars(n)%dims) == 'p') then ! partition axis - var3d => var3dp - ! Group 6 - if (vname .eq. 'USSPX') call write_var3d(vname, ussp (1:nsea, 1:usspf(2)) ) - if (vname .eq. 'USSPY') call write_var3d(vname, ussp (1:nsea,nk+1:nk+usspf(2)) ) - - else if (trim(outvars(n)%dims) == 'k') then ! freq axis - var3d => var3dk - ! Group 3 - if(vname .eq. 'EF') call write_var3d(vname, ef (1:nsea,e3df(2,1):e3df(3,1)) ) - if(vname .eq. 'TH1M') call write_var3d(vname, ef (1:nsea,e3df(2,2):e3df(3,2)) ) - if(vname .eq. 'STH1M') call write_var3d(vname, ef (1:nsea,e3df(2,3):e3df(3,3)) ) - if(vname .eq. 'TH2M') call write_var3d(vname, ef (1:nsea,e3df(2,4):e3df(3,4)) ) - if(vname .eq. 'STH2M') call write_var3d(vname, ef (1:nsea,e3df(2,5):e3df(3,5)) ) - !TODO: wn has reversed indices (1:nk, 1:nsea) - ! Group 6 - if (vname .eq. 'US3DX') call write_var3d(vname, us3d (1:nsea, us3df(2):us3df(3)) ) - if (vname .eq. 'US3DY') call write_var3d(vname, us3d (1:nsea,nk+us3df(2):nk+us3df(3)) ) - - else - ! Group 1 - if (vname .eq. 'DW') call write_var2d(vname, dw (1:nsea), init0='false') - if (vname .eq. 'CX') call write_var2d(vname, cx (1:nsea), init0='false') - if (vname .eq. 'CY') call write_var2d(vname, cy (1:nsea), init0='false') - if (vname .eq. 'UAX') call write_var2d(vname, ua (1:nsea), dir=cos(ud(1:nsea)), init0='false') - if (vname .eq. 'UAY') call write_var2d(vname, ua (1:nsea), dir=sin(ud(1:nsea)), init0='false') - if (vname .eq. 'AS') call write_var2d(vname, as (1:nsea), init0='false') - if (vname .eq. 'WLV') call write_var2d(vname, wlv (1:nsea), init0='false') - if (vname .eq. 'ICE') call write_var2d(vname, ice (1:nsea), init0='false') - if (vname .eq. 'BERG') call write_var2d(vname, berg (1:nsea), init0='false') - if (vname .eq. 'TAUX') call write_var2d(vname, taua (1:nsea), dir=cos(tauadir(1:nsea)), init0='false') - if (vname .eq. 'TAUY') call write_var2d(vname, taua (1:nsea), dir=sin(tauadir(1:nsea)), init0='false') - if (vname .eq. 'RHOAIR') call write_var2d(vname, rhoair (1:nsea), init0='false') - if (vname .eq. 'ICEH') call write_var2d(vname, iceh (1:nsea), init0='false') - if (vname .eq. 'ICEF') call write_var2d(vname, icef (1:nsea), init0='false') - - ! Group 2 - if (vname .eq. 'HS') call write_var2d(vname, hs (1:nsea) ) - if (vname .eq. 'WLM') call write_var2d(vname, wlm (1:nsea) ) - if (vname .eq. 'T02') call write_var2d(vname, t02 (1:nsea) ) - if (vname .eq. 'T0M1') call write_var2d(vname, t0m1 (1:nsea) ) - if (vname .eq. 'T01') call write_var2d(vname, t01 (1:nsea) ) - if (vname .eq. 'FP0') call write_var2d(vname, fp0 (1:nsea) ) - if (vname .eq. 'THM') call write_var2d(vname, thm (1:nsea) ) - if (vname .eq. 'THS') call write_var2d(vname, ths (1:nsea) ) - if (vname .eq. 'THP0') call write_var2d(vname, thp0 (1:nsea) ) - if (vname .eq. 'HSIG') call write_var2d(vname, hsig (1:nsea) ) - if (vname .eq. 'STMAXE') call write_var2d(vname, stmaxe (1:nsea) ) - if (vname .eq. 'STMAXD') call write_var2d(vname, stmaxd (1:nsea) ) - if (vname .eq. 'HMAXE') call write_var2d(vname, hmaxe (1:nsea) ) - if (vname .eq. 'HCMAXE') call write_var2d(vname, hcmaxe (1:nsea) ) - if (vname .eq. 'HMAXD') call write_var2d(vname, hmaxd (1:nsea) ) - if (vname .eq. 'HCMAXD') call write_var2d(vname, hcmaxd (1:nsea) ) - if (vname .eq. 'WBT') call write_var2d(vname, wbt (1:nsea) ) - if (vname .eq. 'WNMEAN') call write_var2d(vname, wnmean (1:nsea), init0='false') - - ! Group 4 - if(vname .eq. 'PWST') call write_var2d(vname, pwst (1:nsea) ) - if(vname .eq. 'PNR') call write_var2d(vname, pnr (1:nsea) ) - - ! Group 5 - if (vname .eq. 'USTX') call write_var2d(vname, ust (1:nsea)*asf(1:nsea), dir=cos(ustdir(1:nsea)), usemask='true') - if (vname .eq. 'USTY') call write_var2d(vname, ust (1:nsea)*asf(1:nsea), dir=sin(ustdir(1:nsea)), usemask='true') - if (vname .eq. 'CHARN') call write_var2d(vname, charn (1:nsea) ) - if (vname .eq. 'CGE') call write_var2d(vname, cge (1:nsea) ) - if (vname .eq. 'PHIAW') call write_var2d(vname, phiaw (1:nsea), init2='true') - if (vname .eq. 'TAUWIX') call write_var2d(vname, tauwix (1:nsea), init2='true') - if (vname .eq. 'TAUWIY') call write_var2d(vname, tauwiy (1:nsea), init2='true') - if (vname .eq. 'TAUWNX') call write_var2d(vname, tauwnx (1:nsea), init2='true') - if (vname .eq. 'TAUWNY') call write_var2d(vname, tauwny (1:nsea), init2='true') - if (vname .eq. 'WCC') call write_var2d(vname, whitecap (1:nsea,1), init2='true') - if (vname .eq. 'WCF') call write_var2d(vname, whitecap (1:nsea,2), init2='true') - if (vname .eq. 'WCH') call write_var2d(vname, whitecap (1:nsea,3), init2='true') - if (vname .eq. 'WCM') call write_var2d(vname, whitecap (1:nsea,4), init2='true') - if (vname .eq. 'TWS') call write_var2d(vname, tws (1:nsea) ) - - ! Group 6 - if (vname .eq. 'SXX') call write_var2d(vname, sxx (1:nsea) ) - if (vname .eq. 'SYY') call write_var2d(vname, syy (1:nsea) ) - if (vname .eq. 'SXY') call write_var2d(vname, sxy (1:nsea) ) - if (vname .eq. 'TAUOX') call write_var2d(vname, tauox (1:nsea), init2='true') - if (vname .eq. 'TAUOY') call write_var2d(vname, tauoy (1:nsea), init2='true') - if (vname .eq. 'BHD') call write_var2d(vname, bhd (1:nsea) ) - if (vname .eq. 'PHIOC') call write_var2d(vname, phioc (1:nsea), init2='true') - if (vname .eq. 'TUSX') call write_var2d(vname, tusx (1:nsea) ) - if (vname .eq. 'TUSY') call write_var2d(vname, tusy (1:nsea) ) - if (vname .eq. 'USSX') call write_var2d(vname, ussx (1:nsea) ) - if (vname .eq. 'USSY') call write_var2d(vname, ussy (1:nsea) ) - if (vname .eq. 'PRMS') call write_var2d(vname, prms (1:nsea) ) - if (vname .eq. 'TPMS') call write_var2d(vname, tpms (1:nsea) ) - if (vname .eq. 'TAUICEX') call write_var2d(vname, tauice (1:nsea,1) ) - if (vname .eq. 'TAUICEY') call write_var2d(vname, tauice (1:nsea,2) ) - if (vname .eq. 'PHICE') call write_var2d(vname, phice (1:nsea) ) - if (vname .eq. 'TAUOCX') call write_var2d(vname, tauocx (1:nsea) ) - if (vname .eq. 'TAUOCY') call write_var2d(vname, tauocy (1:nsea) ) - if (vname .eq. 'USSHX') call write_var2d(vname, usshx (1:nsea) ) - if (vname .eq. 'USSHY') call write_var2d(vname, usshy (1:nsea) ) - ! Group 7 - if (vname .eq. 'ABAX') call write_var2d(vname, aba (1:nsea), dir=cos(abd(1:nsea)) ) - if (vname .eq. 'ABAY') call write_var2d(vname, aba (1:nsea), dir=sin(abd(1:nsea)) ) - if (vname .eq. 'UBAX') call write_var2d(vname, uba (1:nsea), dir=cos(ubd(1:nsea)) ) - if (vname .eq. 'UBAY') call write_var2d(vname, uba (1:nsea), dir=sin(ubd(1:nsea)) ) - if (vname .eq. 'BED') call write_var2d(vname, bedforms (1:nsea,1), init2='true') - if (vname .eq. 'RIPPLEX') call write_var2d(vname, bedforms (1:nsea,2), init2='true') - if (vname .eq. 'RIPPLEY') call write_var2d(vname, bedforms (1:nsea,3), init2='true') - if (vname .eq. 'PHIBBL') call write_var2d(vname, phibbl (1:nsea), init2='true') - if (vname .eq. 'TAUBBLX') call write_var2d(vname, taubbl (1:nsea,1), init2='true') - if (vname .eq. 'TAUBBLY') call write_var2d(vname, taubbl (1:nsea,2), init2='true') - - ! Group 8 - if (vname .eq. 'MSSX') call write_var2d(vname, mssx (1:nsea) ) - if (vname .eq. 'MSSY') call write_var2d(vname, mssy (1:nsea) ) - if (vname .eq. 'MSCX') call write_var2d(vname, mscx (1:nsea) ) - if (vname .eq. 'MSCY') call write_var2d(vname, mscy (1:nsea) ) - !TODO: remaining variables have inconsistency between shel_inp listing and iogo code - - ! Group 9 - if (vname .eq. 'DTDYN') call write_var2d(vname, dtdyn (1:nsea) ) - if (vname .eq. 'FCUT') call write_var2d(vname, fcut (1:nsea) ) - if (vname .eq.'CFLXYMAX') call write_var2d(vname, cflxymax (1:nsea) ) - if (vname .eq.'CFLTHMAX') call write_var2d(vname, cflthmax (1:nsea) ) - if (vname .eq. 'CFLKMAX') call write_var2d(vname, cflkmax (1:nsea) ) - - ! Group 10 - end if - end do - - if (s_axis) deallocate(var3ds) - if (m_axis) deallocate(var3dm) - if (p_axis) deallocate(var3dp) - if (k_axis) deallocate(var3dk) - - ! Flush the buffers for write - call w3seta ( igrd, ndse, ndst ) - - end subroutine w3iogoncd - - !=============================================================================== - subroutine write_var2d(vname, var, dir, usemask, init0, init2) - ! write (nsea) array as (nx,ny) - ! if dir is present, write x or y component of (nsea) array as (nx,ny) - ! if mask is present and true, use mapsta=1 to mask values - ! if init0 is present and false, do not initialize values - ! for mapsta<0. this prevents group 1 variables being set undef over - ! ice. if init2 is present and true, apply a second initialization to - ! a subset of variables for where mapsta==2 - - character(len=*), intent(in) :: vname - real , intent(in) :: var(:) - real, optional , intent(in) :: dir(:) - character(len=*), optional, intent(in) :: usemask - character(len=*), optional, intent(in) :: init0 - character(len=*), optional, intent(in) :: init2 - - ! local variables - real, dimension(nx,ny) :: var2d - logical :: lmask, linit0, linit2 - real :: varloc - - lmask = .false. - if (present(usemask)) then - lmask = (trim(usemask) == "true") - end if - linit0 = .true. - if (present(init0)) then - linit0 = (trim(init0) == "true") - end if - linit2 = .false. - if (present(init2)) then - linit2 = (trim(init2) == "true") - end if - - ! DEBUG - ! write(nds(1),'(a)')' writing variable ' //trim(vname)//' to history file '//trim(fname) - - var2d = undef - do isea = 1,nsea - - ! initialization - varloc = var(isea) - if (linit0) then - if (mapsta(mapsf(isea,2),mapsf(isea,1)) < 0) varloc = undef - end if - if (linit2) then - if (mapsta(mapsf(isea,2),mapsf(isea,1)) == 2) varloc = undef - end if - - if (present(dir)) then - if (varloc .ne. undef) then - if (lmask) then - if (mapsta(mapsf(isea,2),mapsf(isea,1)) == 1) then - var2d(mapsf(isea,1),mapsf(isea,2)) = varloc*dir(isea) - end if - else - var2d(mapsf(isea,1),mapsf(isea,2)) = varloc*dir(isea) - end if - end if - else - var2d(mapsf(isea,1),mapsf(isea,2)) = varloc - end if - end do - - ierr = nf90_open(trim(fname), nf90_write, ncid) - call handle_err(ierr, 'open '//trim(fname)//' for writing') - ierr = nf90_inq_varid(ncid, trim(vname), varid) - call handle_err(ierr, 'inquire variable '//trim(vname)) - ierr = nf90_put_var(ncid, varid, var2d) - call handle_err(ierr, 'put variable '//trim(vname)) - ierr = nf90_close(ncid) - - end subroutine write_var2d - - !=============================================================================== - subroutine write_var3d(vname, var, init2) - ! write (nsea,:) array as (nx,ny,:) - ! if init2 is present and true, apply a second initialization to - ! a subset of variables for where mapsta==2 - - character(len=*), intent(in) :: vname - real , intent(in) :: var(:,:) - character(len=*), optional, intent(in) :: init2 - - ! local variables - real, allocatable, dimension(:) :: varloc - logical :: linit2 - integer :: lb, ub - - linit2 = .false. - if (present(init2)) then - linit2 = (trim(init2) == "true") - end if - - lb = lbound(var,2) - ub = ubound(var,2) - allocate(varloc(lb:ub)) - - ! DEBUG - ! write(nds(1),'(a,2i6)')' writing variable ' //trim(vname)//' to history file ' & - ! //trim(fname)//' with bounds ',lb,ub - - var3d = undef - do isea = 1,nsea - ! initialization - varloc(:) = var(isea,:) - if (mapsta(mapsf(isea,2),mapsf(isea,1)) < 0) varloc(:) = undef - if (linit2) then - if (mapsta(mapsf(isea,2),mapsf(isea,1)) == 2) varloc(:) = undef - end if - var3d(mapsf(isea,1),mapsf(isea,2),:) = varloc(:) - end do - - ierr = nf90_open(trim(fname), nf90_write, ncid) - call handle_err(ierr, 'open '//trim(fname)//' for writing') - ierr = nf90_inq_varid(ncid, trim(vname), varid) - call handle_err(ierr, 'inquire variable '//trim(vname)) - ierr = nf90_put_var(ncid, varid, var3d) - call handle_err(ierr, 'put variable '//trim(vname)) - ierr = nf90_close(ncid) - - deallocate(varloc) - end subroutine write_var3d - - !=============================================================================== - subroutine handle_err(ierr,string) - use w3odatmd , only : ndse - use w3servmd , only : extcde - - ! input/output variables - integer , intent(in) :: ierr - character(len=*), intent(in) :: string - - if (ierr /= nf90_noerr) then - write(ndse,*) "*** WAVEWATCH III netcdf error: ",trim(string),':',trim(nf90_strerror(ierr)) - call extcde ( 49 ) - end if - end subroutine handle_err - -end module w3iogoncdmd diff --git a/model/src/w3iogrmd.F90 b/model/src/w3iogrmd.F90 index 417428591..f7beab466 100644 --- a/model/src/w3iogrmd.F90 +++ b/model/src/w3iogrmd.F90 @@ -112,7 +112,11 @@ MODULE W3IOGRMD !> @author F. Ardhuin !> @date 19-Oct-2020 - SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) + SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & +#ifdef W3_ASCII + ,NDSA & +#endif + ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | @@ -209,6 +213,7 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) ! INXOUT C*(*) I Test string for read/write, valid are: ! 'READ', 'WRITE' and 'GRID'. ! NDSM Int. I File unit number. + ! NDSA Int. I File unit number. ascii ! IMOD Int. I Model number for W3GDAT etc. ! FEXT C*(*) I File extension to be used. ! ---------------------------------------------------------------- @@ -279,7 +284,7 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) DIKCUMUL #endif #ifdef W3_NL1 - USE W3SNL1MD, ONLY: INSNL1 + USE W3SNL1MD, ONLY: INSNL1, INSNLGQM #endif #ifdef W3_NL2 USE W3SNL2MD, ONLY: INSNL2 @@ -317,6 +322,9 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) INTEGER, INTENT(IN), OPTIONAL :: IMOD CHARACTER, INTENT(IN) :: INXOUT*(*) CHARACTER, INTENT(IN), OPTIONAL :: FEXT*(*) +#ifdef W3_ASCII + INTEGER, INTENT(IN), OPTIONAL :: NDSA +#endif !/ !/ ------------------------------------------------------------------- / !/ Local parameters @@ -563,6 +571,10 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) IF ( WRITE ) THEN OPEN (NDSM,FILE=FNMPRE(:IPRE)//'mod_def.'//FILEXT(:IEXT), & form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR) +#ifdef W3_ASCII + OPEN (NDSA,FILE=FNMPRE(:IPRE)//'mod_def.'//FILEXT(:IEXT)//'.txt', & + form='FORMATTED',ERR=800,IOSTAT=IERR) +#endif ELSE OPEN (NDSM,FILE=FNMPRE(:IPRE)//'mod_def.'//FILEXT(:IEXT), & form='UNFORMATTED', convert=file_endian,STATUS='OLD',ERR=800,IOSTAT=IERR) @@ -578,14 +590,38 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) NBI, NFBPO, GNAME, FNAME0, FNAME1, FNAME2, FNAME3, & FNAME4, FNAME5, FNAME6, FNAMEP, FNAMEG, & FNAMEF, FNAMEI +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'IDSTR, VERGRD, NX, NY, NSEA, NTH, NK, & + NBI, NFBPO, GNAME, FNAME0, FNAME1, FNAME2, FNAME3, & + FNAME4, FNAME5, FNAME6, FNAMEP, FNAMEG, & + FNAMEF, FNAMEI:', & + IDSTR, VERGRD, NX, NY, NSEA, NTH, NK, & + NBI, NFBPO, GNAME, FNAME0, FNAME1, FNAME2, FNAME3, & + FNAME4, FNAME5, FNAME6, FNAMEP, FNAMEG, & + FNAMEF, FNAMEI +#endif ! #ifdef W3_SMC WRITE (NDSM) NCel, NUFc, NVFc, NRLv, MRFct +#ifdef W3_ASCII + WRITE (NDSA,*) 'NCel, NUFc, NVFc, NRLv, MRFct:', & + NCel, NUFc, NVFc, NRLv, MRFct +#endif WRITE (NDSM) NGLO, NARC, NBGL, NBAC, NBSMC +#ifdef W3_ASCII + WRITE (NDSA,*) 'NGLO, NARC, NBGL, NBAC, NBSMC:', & + NGLO, NARC, NBGL, NBAC, NBSMC +#endif #endif ! WRITE (NDSM) & (NBO(I),I=0,NFBPO), (NBO2(I),I=0,NFBPO) +#ifdef W3_ASCII + WRITE (NDSA,*) & + '(NBO(I),I=0,NFBPO), (NBO2(I),I=0,NFBPO):', & + (NBO(I),I=0,NFBPO), (NBO2(I),I=0,NFBPO) +#endif #ifdef W3_T WRITE (NDST,9001) IDSTR, VERGRD, NX, NY, NSEA, NTH, NK, & NBI, NFBPO, 9, GNAME, FNAME0, FNAME1, FNAME2, FNAME3, & @@ -717,6 +753,11 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) MAPTMP = MAPSTA + 8*MAPST2 WRITE (NDSM) & GTYPE, FLAGLL, ICLOSE +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'GTYPE, FLAGLL, ICLOSE:', & + GTYPE, FLAGLL, ICLOSE +#endif ! ! Writes different kind of information depending on grid type ! @@ -725,9 +766,19 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) CASE ( RLGTYPE, SMCTYPE ) WRITE (NDSM) & SX, SY, X0, Y0 +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'SX, SY, X0, Y0:', & + SX, SY, X0, Y0 +#endif CASE ( CLGTYPE ) WRITE (NDSM) & REAL(XGRD), REAL(YGRD) +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'REAL(XGRD), REAL(YGRD):', & + REAL(XGRD), REAL(YGRD) +#endif CASE (UNGTYPE) WRITE (NDSM) & FSN, FSPSI,FSFCT,FSNIMP,FSTOTALIMP,FSTOTALEXP, & @@ -746,6 +797,41 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) B_JGS_NORM_THR, & B_JGS_NLEVEL, & B_JGS_SOURCE_NONLINEAR +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'FSN, FSPSI,FSFCT,FSNIMP,FSTOTALIMP,FSTOTALEXP, & + FSBCCFL, FSREFRACTION, FSFREQSHIFT, FSSOURCE, & + DO_CHANGE_WLV, SOLVERTHR_STP, CRIT_DEP_STP, & + NTRI,COUNTOT, COUNTRI, NNZ, & + B_JGS_TERMINATE_MAXITER, & + B_JGS_TERMINATE_DIFFERENCE, & + B_JGS_TERMINATE_NORM, & + B_JGS_LIMITER, & + B_JGS_BLOCK_GAUSS_SEIDEL, & + B_JGS_USE_JACOBI, & + B_JGS_MAXITER, & + B_JGS_PMIN, & + B_JGS_DIFF_THR, & + B_JGS_NORM_THR, & + B_JGS_NLEVEL, & + B_JGS_SOURCE_NONLINEAR:', & + FSN, FSPSI,FSFCT,FSNIMP,FSTOTALIMP,FSTOTALEXP, & + FSBCCFL, FSREFRACTION, FSFREQSHIFT, FSSOURCE, & + DO_CHANGE_WLV, SOLVERTHR_STP, CRIT_DEP_STP, & + NTRI,COUNTOT, COUNTRI, NNZ, & + B_JGS_TERMINATE_MAXITER, & + B_JGS_TERMINATE_DIFFERENCE, & + B_JGS_TERMINATE_NORM, & + B_JGS_LIMITER, & + B_JGS_BLOCK_GAUSS_SEIDEL, & + B_JGS_USE_JACOBI, & + B_JGS_MAXITER, & + B_JGS_PMIN, & + B_JGS_DIFF_THR, & + B_JGS_NORM_THR, & + B_JGS_NLEVEL, & + B_JGS_SOURCE_NONLINEAR +#endif !Init COUNTCON and IOBDP to zero, it needs to be set somewhere or !removed COUNTCON=0 @@ -755,10 +841,26 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) LEN, IEN, ANGLE0, ANGLE, SI, MAXX, MAXY, & DXYMAX, INDEX_CELL, CCON, COUNTCON, IE_CELL, & POS_CELL, IOBP, IOBPA, IOBDP, IOBPD, IAA, JAA, POSI +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'X0, Y0, SX, SY, DXYMAX, XGRD, YGRD, TRIGP, TRIA, & + LEN, IEN, ANGLE0, ANGLE, SI, MAXX, MAXY, & + DXYMAX, INDEX_CELL, CCON, COUNTCON, IE_CELL, & + POS_CELL, IOBP, IOBPA, IOBDP, IOBPD, IAA, JAA, POSI:', & + X0, Y0, SX, SY, DXYMAX, XGRD, YGRD, TRIGP, TRIA, & + LEN, IEN, ANGLE0, ANGLE, SI, MAXX, MAXY, & + DXYMAX, INDEX_CELL, CCON, COUNTCON, IE_CELL, & + POS_CELL, IOBP, IOBPA, IOBDP, IOBPD, IAA, JAA, POSI +#endif END SELECT !GTYPE ! WRITE (NDSM) & ZB, MAPTMP, MAPFS, MAPSF, TRFLAG +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'ZB, MAPTMP, MAPFS, MAPSF, TRFLAG:', & + ZB, MAPTMP, MAPFS, MAPSF, TRFLAG +#endif ! #ifdef W3_SMC IF( GTYPE .EQ. SMCTYPE ) THEN @@ -767,6 +869,18 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) WRITE (NDSM) ICLBAC WRITE (NDSM) ANGARC WRITE (NDSM) CTRNX, CTRNY, CLATF +#ifdef W3_ASCII + WRITE (NDSA,*) 'NLvCel, NLvUFc, NLvVFc:', & + NLvCel, NLvUFc, NLvVFc + WRITE (NDSA,*) 'IJKCel, IJKUFc, IJKVFc, ISMCBP:', & + IJKCel, IJKUFc, IJKVFc, ISMCBP + WRITE (NDSA,*) 'ICLBAC:', & + ICLBAC + WRITE (NDSA,*) 'ANGARC:', & + ANGARC + WRITE (NDSA,*) 'CTRNX, CTRNY, CLATF:', & + CTRNX, CTRNY, CLATF +#endif IF ( FLTEST ) THEN WRITE (NDSE,"(' NRLv, MRFct and NBSMC values are',3I9)") NRLv, MRFct, NBSMC WRITE (NDSE,"(' IJKCel, IJKUFc, IJKVFc Write for',3I9)") NCel, NUFc, NVFc @@ -776,6 +890,9 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) #endif ! IF ( TRFLAG .NE. 0 ) WRITE (NDSM) TRNX, TRNY +#ifdef W3_ASCII + IF ( TRFLAG .NE. 0 ) WRITE (NDSA,*) 'TRNX, TRNY:', TRNX, TRNY +#endif WRITE (NDSM) & DTCFL, DTCFLI, DTMAX, DTMIN, DMIN, CTMAX, & FICE0, FICEN, FICEL, PFMOVE, FLDRY, FLCX, FLCY, FLCTH, & @@ -784,14 +901,43 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) ICESCALES(1:4), CALTYPE, CMPRTRCK, IICEHFAC, IICEHDISP,& IICEDDISP, IICEFDISP, BTBETA, & AAIRCMIN, AAIRGB +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'DTCFL, DTCFLI, DTMAX, DTMIN, DMIN, CTMAX, & + FICE0, FICEN, FICEL, PFMOVE, FLDRY, FLCX, FLCY, FLCTH, & + FLCK, FLSOU, FLBPI, FLBPO, CLATS, CLATIS, CTHG0S, & + STEXU, STEYU, STEDU, IICEHMIN, IICEHINIT, IICEDISP, & + ICESCALES(1:4), CALTYPE, CMPRTRCK, IICEHFAC, IICEHDISP,& + IICEDDISP, IICEFDISP, BTBETA, & + AAIRCMIN, AAIRGB:', & + DTCFL, DTCFLI, DTMAX, DTMIN, DMIN, CTMAX, & + FICE0, FICEN, FICEL, PFMOVE, FLDRY, FLCX, FLCY, FLCTH, & + FLCK, FLSOU, FLBPI, FLBPO, CLATS, CLATIS, CTHG0S, & + STEXU, STEYU, STEDU, IICEHMIN, IICEHINIT, IICEDISP, & + ICESCALES(1:4), CALTYPE, CMPRTRCK, IICEHFAC, IICEHDISP,& + IICEDDISP, IICEFDISP, BTBETA, & + AAIRCMIN, AAIRGB +#endif WRITE(NDSM)GRIDSHIFT +#ifdef W3_ASCII + WRITE(NDSA,*)'GRIDSHIFT:', & + GRIDSHIFT +#endif #ifdef W3_SEC1 WRITE (NDSM) NITERSEC1 +#ifdef W3_ASCII + WRITE (NDSA,*) 'NITERSEC1:', & + NITERSEC1 +#endif #endif #ifdef W3_RTD !! Add rotated Polat/lon and AnglD to mod_def JGLi12Jun2012 WRITE (NDSM) PoLat, PoLon, AnglD, FLAGUNR +#ifdef W3_ASCII + WRITE (NDSA,*) 'PoLat, PoLon, AnglD, FLAGUNR:', & + PoLat, PoLon, AnglD, FLAGUNR +#endif #endif !! WRITE(NDSM) & @@ -977,6 +1123,15 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) MAPWN, MAPTH, DTH, TH, ESIN, ECOS, ES2, ESC, EC2, & XFR, FR1, SIG, SIG2, DSIP, DSII, DDEN, DDEN2, FTE, & FTF, FTWN, FTTR, FTWL, FACTI1, FACTI2, FACHFA, FACHFE +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'MAPWN, MAPTH, DTH, TH, ESIN, ECOS, ES2, ESC, EC2, & + XFR, FR1, SIG, SIG2, DSIP, DSII, DDEN, DDEN2, FTE, & + FTF, FTWN, FTTR, FTWL, FACTI1, FACTI2, FACHFA, FACHFE:', & + MAPWN, MAPTH, DTH, TH, ESIN, ECOS, ES2, ESC, EC2, & + XFR, FR1, SIG, SIG2, DSIP, DSII, DDEN, DDEN2, FTE, & + FTF, FTWN, FTTR, FTWL, FACTI1, FACTI2, FACHFA, FACHFE +#endif ELSE IF (.NOT.SINIT) CALL W3DIMS ( IGRD, NK, NTH, NDSE, NDST ) READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & @@ -1009,6 +1164,11 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) IF ( WRITE ) THEN WRITE (NDSM) & E3DF, P2MSF, US3DF,USSPF, USSP_WN +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'E3DF, P2MSF, US3DF,USSPF, USSP_WN:', & + E3DF, P2MSF, US3DF,USSPF, USSP_WN +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & E3DF, P2MSF, US3DF,USSPF, USSP_WN @@ -1025,6 +1185,11 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) IF ( WRITE ) THEN WRITE (NDSM) & XBPO, YBPO, RDBPO, IPBPO, ISBPO +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'XBPO, YBPO, RDBPO, IPBPO, ISBPO:', & + XBPO, YBPO, RDBPO, IPBPO, ISBPO +#endif ELSE CALL W3DMO5 ( IGRD, NDSE, NDST, 2 ) READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & @@ -1050,6 +1215,13 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) WRITE (NDSM) & IHMAX, HSPMIN, WSMULT, WSCUT, FLCOMB, NOSWLL, & PTMETH, PTFCUT +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'IHMAX, HSPMIN, WSMULT, WSCUT, FLCOMB, NOSWLL, & + PTMETH, PTFCUT:', & + IHMAX, HSPMIN, WSMULT, WSCUT, FLCOMB, NOSWLL, & + PTMETH, PTFCUT +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & IHMAX, HSPMIN, WSMULT, WSCUT, FLCOMB, NOSWLL, & @@ -1067,37 +1239,84 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) WRITE (NDSM) & FACP, XREL, XFLT, FXFM, FXPM, XFT, XFC, FACSD, FHMAX, & FFACBERG, DELAB, FWTABLE +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'FACP, XREL, XFLT, FXFM, FXPM, XFT, XFC, FACSD, FHMAX, & + FFACBERG, DELAB, FWTABLE:', & + FACP, XREL, XFLT, FXFM, FXPM, XFT, XFC, FACSD, FHMAX, & + FFACBERG, DELAB, FWTABLE +#endif #ifdef W3_RWND WRITE (NDSM) & RWINDC +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'RWINDC:', & + RWINDC +#endif #endif #ifdef W3_WCOR WRITE (NDSM) & WWCOR +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'WWCOR:', & + WWCOR +#endif #endif #ifdef W3_REF1 WRITE (NDSM) & RREF, REFPARS, REFLC, REFLD +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'RREF, REFPARS, REFLC, REFLD:', & + RREF, REFPARS, REFLC, REFLD +#endif #endif #ifdef W3_IG1 WRITE (NDSM) & IGPARS(1:12) +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'IGPARS(1:12):', & + IGPARS(1:12) +#endif #endif #ifdef W3_IC2 WRITE (NDSM) & IC2PARS(1:8) +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'IC2PARS(1:8):', & + IC2PARS(1:8) +#endif #endif #ifdef W3_IC3 WRITE (NDSM) & IC3PARS +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'IC3PARS:', & + IC3PARS +#endif #endif #ifdef W3_IC4 WRITE (NDSM) & IC4PARS,IC4_KI,IC4_FC +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'IC4PARS,IC4_KI,IC4_FC:', & + IC4PARS,IC4_KI,IC4_FC +#endif #endif #ifdef W3_IC5 WRITE (NDSM) & IC5PARS +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'IC5PARS:', & + IC5PARS +#endif #endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & @@ -1152,6 +1371,10 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) #ifdef W3_FLX2 IF ( WRITE ) THEN WRITE (NDSM) NITTIN, CINXSI +#ifdef W3_ASCII + WRITE (NDSA,*)' NITTIN, CINXSI:', & + NITTIN, CINXSI +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) NITTIN, CINXSI END IF @@ -1162,6 +1385,11 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) IF ( WRITE ) THEN WRITE (NDSM) & NITTIN, CINXSI, CD_MAX, CAP_ID +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'NITTIN, CINXSI, CD_MAX, CAP_ID:', & + NITTIN, CINXSI, CD_MAX, CAP_ID +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & NITTIN, CINXSI, CD_MAX, CAP_ID @@ -1172,6 +1400,10 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) #ifdef W3_FLX4 IF ( WRITE ) THEN WRITE (NDSM) FLX4A0 +#ifdef W3_ASCII + WRITE (NDSA,*)' FLX4A0:', & + FLX4A0 +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) FLX4A0 END IF @@ -1181,6 +1413,10 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) #ifdef W3_LN1 IF ( WRITE ) THEN WRITE (NDSM) SLNC1, FSPM, FSHF +#ifdef W3_ASCII + WRITE (NDSA,*)' SLNC1, FSPM, FSHF:', & + SLNC1, FSPM, FSHF +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) SLNC1, FSPM, FSHF END IF @@ -1190,6 +1426,10 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) #ifdef W3_ST1 IF ( WRITE ) THEN WRITE (NDSM) SINC1, SDSC1 +#ifdef W3_ASCII + WRITE (NDSA,*)' SINC1, SDSC1:', & + SINC1, SDSC1 +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) SINC1, SDSC1 END IF @@ -1203,6 +1443,17 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) SHSTAB, OFSTAB, CCNG, CCPS, FFNG, FFPS, & CDSA0, CDSA1, CDSA2, SDSALN, & CDSB0, CDSB1, CDSB2, CDSB3, FPIMIN, XFH, XF1, XF2 +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'ZWIND, FSWELL, & + SHSTAB, OFSTAB, CCNG, CCPS, FFNG, FFPS, & + CDSA0, CDSA1, CDSA2, SDSALN, & + CDSB0, CDSB1, CDSB2, CDSB3, FPIMIN, XFH, XF1, XF2:',& + ZWIND, FSWELL, & + SHSTAB, OFSTAB, CCNG, CCPS, FFNG, FFPS, & + CDSA0, CDSA1, CDSA2, SDSALN, & + CDSB0, CDSB1, CDSB2, CDSB3, FPIMIN, XFH, XF1, XF2 +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & ZWIND, FSWELL, & @@ -1226,6 +1477,19 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) SSTXFTFTAIL, SSTXFTWN, & DDELTA1, DDELTA2, SSTXFTF, SSTXFTWN, & FFXPM, FFXFM +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'ZZWND, AALPHA, ZZ0MAX, BBETA, SSINTHP, ZZALP, & + SSWELLF, SSDSC1, WWNMEANP, WWNMEANPTAIL, SSTXFTF, & + SSTXFTFTAIL, SSTXFTWN, & + DDELTA1, DDELTA2, SSTXFTF, SSTXFTWN, & + FFXPM, FFXFM:', & + ZZWND, AALPHA, ZZ0MAX, BBETA, SSINTHP, ZZALP, & + SSWELLF, SSDSC1, WWNMEANP, WWNMEANPTAIL, SSTXFTF, & + SSTXFTFTAIL, SSTXFTWN, & + DDELTA1, DDELTA2, SSTXFTF, SSTXFTWN, & + FFXPM, FFXFM +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & ZZWND, AALPHA, ZZ0MAX, BBETA, SSINTHP, ZZALP, & @@ -1256,6 +1520,33 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) DELU, DELALP, TAUT, TAUHFT, TAUHFT2, & IKTAB, DCKI, QBI, SATINDICES, SATWEIGHTS, & DIKCUMUL, CUMULW +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'ZZWND, AALPHA, ZZ0MAX, BBETA, SSINTHP, ZZALP, & + TTAUWSHELTER, SSWELLFPAR, SSWELLF, SSINBR, & + ZZ0RAT, SSDSC, & + SSDSISO, SSDSBR, SSDSBT, SSDSBM, SSDSP, & + SSDSCOS, SSDSDTH, WWNMEANP, WWNMEANPTAIL,SSTXFTF, & + SSTXFTFTAIL, SSTXFTWN, SSTXFTF, SSTXFTWN, & + SSDSBRF1, SSDSBRF2, SSDSBRFDF,SSDSBCK, SSDSABK, & + SSDSPBK, SSDSBINT, FFXPM, FFXFM, FFXFA, & + SSDSHCK, DELUST, DELTAIL, DELTAUW, & + DELU, DELALP, TAUT, TAUHFT, TAUHFT2, & + IKTAB, DCKI, QBI, SATINDICES, SATWEIGHTS, & + DIKCUMUL, CUMULW:', & + ZZWND, AALPHA, ZZ0MAX, BBETA, SSINTHP, ZZALP, & + TTAUWSHELTER, SSWELLFPAR, SSWELLF, SSINBR, & + ZZ0RAT, SSDSC, & + SSDSISO, SSDSBR, SSDSBT, SSDSBM, SSDSP, & + SSDSCOS, SSDSDTH, WWNMEANP, WWNMEANPTAIL,SSTXFTF, & + SSTXFTFTAIL, SSTXFTWN, SSTXFTF, SSTXFTWN, & + SSDSBRF1, SSDSBRF2, SSDSBRFDF,SSDSBCK, SSDSABK, & + SSDSPBK, SSDSBINT, FFXPM, FFXFM, FFXFA, & + SSDSHCK, DELUST, DELTAIL, DELTAUW, & + DELU, DELALP, TAUT, TAUHFT, TAUHFT2, & + IKTAB, DCKI, QBI, SATINDICES, SATWEIGHTS, & + DIKCUMUL, CUMULW +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & ZZWND, AALPHA, ZZ0MAX, BBETA, SSINTHP, ZZALP, & @@ -1278,6 +1569,14 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) WRITE (NDSM) SIN6A0, SDS6ET, SDS6A1, SDS6A2, & SDS6P1, SDS6P2, SWL6S6, SWL6B1, SWL6CSTB1, & SIN6WS, SIN6FC +#ifdef W3_ASCII + WRITE (NDSA,*) 'SIN6A0, SDS6ET, SDS6A1, SDS6A2, & + SDS6P1, SDS6P2, SWL6S6, SWL6B1, SWL6CSTB1, & + SIN6WS, SIN6FC:', & + SIN6A0, SDS6ET, SDS6A1, SDS6A2, & + SDS6P1, SDS6P2, SWL6S6, SWL6B1, SWL6CSTB1, & + SIN6WS, SIN6FC +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & SIN6A0, SDS6ET, SDS6A1, SDS6A2, & @@ -1291,19 +1590,40 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) #ifdef W3_NL1 IF ( WRITE ) THEN WRITE (NDSM) & - SNLC1, LAM, KDCON, KDMN, SNLS1, SNLS2, SNLS3 + SNLC1, LAM, KDCON, KDMN, SNLS1, SNLS2, SNLS3, & + IQTPE, NLTAIL, GQNF1, GQNT1, & + GQNQ_OM2, GQTHRSAT, GQTHRCOU, GQAMP +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'SNLC1, LAM, KDCON, KDMN, SNLS1, SNLS2, SNLS3, & + IQTPE, NLTAIL, GQNF1, GQNT1, & + GQNQ_OM2, GQTHRSAT, GQTHRCOU, GQAMP:', & + SNLC1, LAM, KDCON, KDMN, SNLS1, SNLS2, SNLS3, & + IQTPE, NLTAIL, GQNF1, GQNT1, & + GQNQ_OM2, GQTHRSAT, GQTHRCOU, GQAMP +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & - SNLC1, LAM, KDCON, KDMN, SNLS1, SNLS2, SNLS3 + SNLC1, LAM, KDCON, KDMN, SNLS1, SNLS2, SNLS3, & + IQTPE, NLTAIL, GQNF1, GQNT1, & + GQNQ_OM2, GQTHRSAT, GQTHRCOU, GQAMP END IF IF ( FLTEST ) WRITE (NDST,9051) SNLC1, LAM, & - KDCON, KDMN, SNLS1, SNLS2, SNLS3 + KDCON, KDMN, SNLS1, SNLS2, SNLS3, & + IQTPE, NLTAIL, GQNF1, GQNT1, GQNQ_OM2, & + GQTHRSAT, GQTHRCOU, GQAMP #endif ! #ifdef W3_NL2 IF ( WRITE ) THEN WRITE (NDSM) IQTPE, NLTAIL, NDPTHS WRITE (NDSM) DPTHNL +#ifdef W3_ASCII + WRITE (NDSA,*) 'IQTPE, NLTAIL, NDPTHS:', & + IQTPE, NLTAIL, NDPTHS + WRITE (NDSA,*) 'DPTHNL:', & + DPTHNL +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & IQTPE, NLTAIL, NDPTHS @@ -1322,6 +1642,16 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) WRITE (NDSM) SNLL(1:SNLNQ), SNLM(1:SNLNQ), & SNLT(1:SNLNQ), SNLCD(1:SNLNQ), & SNLCS(1:SNLNQ) +#ifdef W3_ASCII + WRITE (NDSA,*) 'SNLNQ, SNLMSC, SNLNSC, SNLSFD, SNLSFS:',& + SNLNQ, SNLMSC, SNLNSC, SNLSFD, SNLSFS + WRITE (NDSA,*) 'SNLL(1:SNLNQ), SNLM(1:SNLNQ), & + SNLT(1:SNLNQ), SNLCD(1:SNLNQ), & + SNLCS(1:SNLNQ):', & + SNLL(1:SNLNQ), SNLM(1:SNLNQ), & + SNLT(1:SNLNQ), SNLCD(1:SNLNQ), & + SNLCS(1:SNLNQ) +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & SNLNQ, SNLMSC, SNLNSC, SNLSFD, SNLSFS @@ -1352,6 +1682,10 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) #ifdef W3_NL4 IF ( WRITE ) THEN WRITE (NDSM) ITSA, IALT +#ifdef W3_ASCII + WRITE (NDSA,*) 'ITSA, IALT:', & + ITSA, IALT +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & ITSA, IALT @@ -1365,6 +1699,12 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) CALL INSNL5 WRITE (NDSM) QR5DPT, QR5OML, QI5DIS, QI5KEV, & QI5NNZ, QI5IPL, QI5PMX +#ifdef W3_ASCII + WRITE (NDSA,*) 'QR5DPT, QR5OML, QI5DIS, QI5KEV, & + QI5NNZ, QI5IPL, QI5PMX:', & + QR5DPT, QR5OML, QI5DIS, QI5KEV, & + QI5NNZ, QI5IPL, QI5PMX +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & QR5DPT, QR5OML, QI5DIS, QI5KEV, & @@ -1379,6 +1719,11 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) IF ( WRITE ) THEN WRITE (NDSM) & CNLSA, CNLSC, CNLSFM, CNLSC1, CNLSC2, CNLSC3 +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'CNLSA, CNLSC, CNLSFM, CNLSC1, CNLSC2, CNLSC3:', & + CNLSA, CNLSC, CNLSFM, CNLSC1, CNLSC2, CNLSC3 +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & CNLSA, CNLSC, CNLSFM, CNLSC1, CNLSC2, CNLSC3 @@ -1388,7 +1733,13 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) #endif ! #ifdef W3_NL1 - IF ( .NOT. WRITE ) CALL INSNL1 ( IGRD ) + IF ( .NOT. WRITE ) THEN + IF (IQTPE.GT.0) THEN + CALL INSNL1 ( IGRD ) + ELSE + CALL INSNLGQM + END IF + END IF #endif #ifdef W3_NL3 IF ( .NOT. WRITE ) CALL INSNL3 @@ -1422,6 +1773,9 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) #ifdef W3_BT1 IF ( WRITE ) THEN WRITE (NDSM) SBTC1 +#ifdef W3_ASCII + WRITE (NDSA,*) 'SBTC1:', SBTC1 +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) SBTC1 END IF @@ -1433,6 +1787,11 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) IF ( WRITE ) THEN WRITE (NDSM) & SBTCX, SED_D50, SED_PSIC +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'SBTCX, SED_D50, SED_PSIC:', & + SBTCX, SED_D50, SED_PSIC +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & SBTCX, SED_D50, SED_PSIC @@ -1446,6 +1805,11 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) IF ( WRITE ) THEN WRITE (NDSM) & SDBC1, SDBC2, FDONLY +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'SDBC1, SDBC2, FDONLY:', & + SDBC1, SDBC2, FDONLY +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & SDBC1, SDBC2, FDONLY @@ -1458,6 +1822,12 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) IF ( WRITE ) THEN WRITE (NDSM) UOSTFILELOCAL, UOSTFILESHADOW, & UOSTFACTORLOCAL, UOSTFACTORSHADOW +#ifdef W3_ASCII + WRITE (NDSA,*) 'UOSTFILELOCAL, UOSTFILESHADOW, & + UOSTFACTORLOCAL, UOSTFACTORSHADOW:', & + UOSTFILELOCAL, UOSTFILESHADOW, & + UOSTFACTORLOCAL, UOSTFACTORSHADOW +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & UOSTFILELOCAL, UOSTFILESHADOW, & @@ -1474,6 +1844,9 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) #ifdef W3_IS1 IF ( WRITE ) THEN WRITE (NDSM) IS1C1, IS1C2 +#ifdef W3_ASCII + WRITE (NDSA,*) 'IS1C1, IS1C2:', IS1C1, IS1C2 +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) IS1C1, IS1C2 END IF @@ -1482,6 +1855,9 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) #ifdef W3_IS2 IF ( WRITE ) THEN WRITE (NDSM) IS2PARS +#ifdef W3_ASCII + WRITE (NDSA,*) 'IS3PARS:', IS2PARS +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) IS2PARS IF ( .NOT. FLIS ) THEN @@ -1497,6 +1873,9 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) #ifdef W3_PR2 IF ( WRITE ) THEN WRITE (NDSM) DTME, CLATMN +#ifdef W3_ASCII + WRITE (NDSA,*) 'DTME, CLATMN:', DTME, CLATMN +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & DTME, CLATMN @@ -1508,6 +1887,9 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) #ifdef W3_PR3 IF ( WRITE ) THEN WRITE (NDSM) WDCG, WDTH +#ifdef W3_ASCII + WRITE (NDSA,*) 'WDCG, WDTH:', WDCG, WDTH +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & WDCG, WDTH @@ -1519,6 +1901,10 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) #ifdef W3_SMC IF ( WRITE ) THEN WRITE(NDSM) DTMS, Refran, FUNO3, FVERG, FSWND, ARCTC +#ifdef W3_ASCII + WRITE(NDSA,*) 'DTMS, Refran, FUNO3, FVERG, FSWND, ARCTC:', & + DTMS, Refran, FUNO3, FVERG, FSWND, ARCTC +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & DTMS, Refran, FUNO3, FVERG, FSWND, ARCTC @@ -1530,6 +1916,10 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) #ifdef W3_FLD1 IF ( WRITE ) THEN WRITE (NDSM) TAIL_ID, TAIL_LEV, TAIL_TRAN1, TAIL_TRAN2 +#ifdef W3_ASCII + WRITE (NDSA,*) 'TAIL_ID, TAIL_LEV, TAIL_TRAN1, TAIL_TRAN2:', & + TAIL_ID, TAIL_LEV, TAIL_TRAN1, TAIL_TRAN2 +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & TAIL_ID, TAIL_LEV, TAIL_TRAN1, TAIL_TRAN2 @@ -1538,6 +1928,10 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) #ifdef W3_FLD2 IF ( WRITE ) THEN WRITE (NDSM) TAIL_ID, TAIL_LEV, TAIL_TRAN1, TAIL_TRAN2 +#ifdef W3_ASCII + WRITE (NDSA,*) 'TAIL_ID, TAIL_LEV, TAIL_TRAN1, TAIL_TRAN2:', & + TAIL_ID, TAIL_LEV, TAIL_TRAN1, TAIL_TRAN2 +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & TAIL_ID, TAIL_LEV, TAIL_TRAN1, TAIL_TRAN2 @@ -1556,6 +1950,11 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) END IF ! CLOSE ( NDSM ) +#ifdef W3_ASCII + IF ( WRITE ) THEN + CLOSE ( NDSA ) + END IF +#endif call print_memcheck(memunit, 'memcheck_____:'//' WIOGR SECTION 9') ! RETURN diff --git a/model/src/w3iopomd.F90 b/model/src/w3iopomd.F90 index 802685869..0c15ea8c6 100644 --- a/model/src/w3iopomd.F90 +++ b/model/src/w3iopomd.F90 @@ -1023,18 +1023,86 @@ SUBROUTINE W3IOPE ( A ) !/ End of W3IOPE ----------------------------------------------------- / !/ END SUBROUTINE W3IOPE - !/ ------------------------------------------------------------------- / + + !> Read or write point output. !> - !> @brief Read/write point output. + !> This subroutine can either read or write the point output file, + !> depending on the value of the first parameter. !> - !> @param[in] INXOUT Test string for read/write. - !> @param[in] NDSOP File unit number. - !> @param[out] IOTST Test indictor for reading. - !> @param[in] IMOD Model number for W3GDAT etc. + !> When reading, the entire file is read with one call to this + !> subroutine. !> - !> @author H. L. Tolman @date 25-Jul-2006 + !> When writing, this subroutine can either write one timestep or + !> the whole model run. This is an option in the input file. If the + !> entire model run is to be written, then OFILES(2) is 0. If only + !> one timestep is to be written, then OFILES(2) is 1. + !> + !> If OFILES(2) is 0, the output file is names out_pnt.ww3. If + !> OFILES(2) is 1, the output file is named TIMETAG.out_pnt.ww3. + !> + !> The format of the point output file is: + !> Size (bytes) | Type | Variable | Meaning + !> -------------|------|----------|-------- + !> 40 | character*40 | IDTST | ID string + !> 4 | integer | VERTST | Model definition file version number + !> 4 | integer | NK | Dimension of frequency + !> 4 | integer | MTH | Directionality of the frequency + !> 4 | integer | NOPTS | Number of output points. + !> 8*NOPTS | integer(2,NOPTS) | PTLOC | Point locations + !> 7*NOPTS | character*7 | PTNME | Point names + !> 8 | integer(2) | TIME | Time + !> reclen*NOPTS | * | * | records + !> + !> Each record contains: + !> Size (bytes) | Type | Variable | Meaning + !> -------------|------|----------|-------- + !> 4 | integer | IW | Number of water points in interpolation box for output point. + !> 4 | integer | II | Number of ice points in interpolation box for output point. + !> 4 | integer | IL | Number of land points in interpolation box for output point. + !> 4 | real | DPO | Interpolated depths. + !> 4 | real | WAO | Interpolated wind speeds. + !> 4 | real | WDO | Interpolated wind directions. + !> 4 | real | TAUAO | (W3_FLX5 only) Interpolated atmospheric stresses. + !> 4 | real | TAUDO | (W3_FLX5 only) Interpolated atmospheric stress directions. + !> 4 | real | DAIRO | (W3_FLX5 only) Interpolated rho atmosphere. + !> 4 | real | ZET_SETO | (W3_SETUP only) Used for wave setup. + !> 4 | real | ASO | Interpolated air-sea temperature difference + !> 4 | real | CAO | Interpolated current speeds. + !> 4 | real | CDO | Interpolated current directions. + !> 4 | real | ICEO | Interpolated ice concentration. + !> 4 | real | ICEHO | Interpolated ice thickness. + !> 4 | real | ICEFO | Interpolated ice floe. + !> 13 | char | GRDID | Originating grid ID + !> 4 | real | SPCO(J,I),J=1,NSPEC | Output spectra + !> + !> In the event of error, EXTCDE() will be called with the following exit codes: + !> - 1 INXOUT must be 'READ' or 'WRITE'. + !> - 2 Unexpectedly changed from WRITE to READ in subsequent call. + !> - 10 Unexpected IDSTR + !> - 11 Unexpected VEROPT + !> - 12 Unexpected MK or MTH + !> - 20 Error opening file. + !> - 21 Unexpected end of file during read. + !> - 22 Error reading file. + !> - 23 Unexpected end of file during read. + !> + !> @param[in] INXOUT String indicating read/write. Must be 'READ' or + !> 'WRITE'. + !> @param[in] NDSOP File unit number. + !> @param[out] IOTST Error code: + !> - 0 No error. + !> - -1 Unexpected end of file when reading. + !> @param[in] IMOD Model number for W3GDAT etc. +#ifdef W3_ASCII + !> @param[in] NDSOA File unit number for ASCII output. +#endif !> - SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD ) + !> @author H. L. Tolman @date 25-Jul-2006 + SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD & +#ifdef W3_ASCII + ,NDSOA & +#endif + ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | @@ -1062,7 +1130,8 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD ) ! ---------------------------------------------------------------- ! INXOUT C*(*) I Test string for read/write, valid are: ! 'READ' and 'WRITE'. - ! NDSOP Int. I File unit number. + ! NDSOP Int. I File unit number. for binary + ! NDSOA Int. I File unit number. for ASCII ! IOTST Int. O Test indictor for reading. ! 0 : Data read. ! -1 : Past end of file. @@ -1140,6 +1209,9 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD ) !/ Parameter list !/ INTEGER, INTENT(IN) :: NDSOP +#ifdef W3_ASCII + INTEGER, INTENT(IN), OPTIONAL :: NDSOA +#endif INTEGER, INTENT(OUT) :: IOTST INTEGER, INTENT(IN), OPTIONAL :: IMOD CHARACTER, INTENT(IN) :: INXOUT*(*) @@ -1205,6 +1277,10 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD ) IF ( WRITE ) THEN OPEN (NDSOP,FILE=FNMPRE(:J)//'out_pnt.'//FILEXT(:I), & form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR) +#ifdef W3_ASCII + OPEN (NDSOA,FILE=FNMPRE(:J)//'out_pnt.'//FILEXT(:I)//'.txt', & + form='FORMATTED', ERR=800,IOSTAT=IERR) +#endif ELSE OPEN (NDSOP,FILE=FNMPRE(:J)//'out_pnt.'//FILEXT(:I), & form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR,STATUS='OLD') @@ -1218,6 +1294,11 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD ) IF ( WRITE ) THEN WRITE (NDSOP) & IDSTR, VEROPT, NK, NTH, NOPTS +#ifdef W3_ASCII + WRITE (NDSOA,*) & + 'IDSTR, VEROPT, NK, NTH, NOPTS:', & + IDSTR, VEROPT, NK, NTH, NOPTS +#endif ELSE READ (NDSOP,END=801,ERR=802,IOSTAT=IERR) & IDTST, VERTST, MK, MTH, NOPTS @@ -1248,6 +1329,11 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD ) IF ( WRITE ) THEN WRITE (NDSOP) & ((PTLOC(J,I),J=1,2),I=1,NOPTS), (PTNME(I),I=1,NOPTS) +#ifdef W3_ASCII + WRITE (NDSOA,*) & + '((PTLOC(J,I),J=1,2),I=1,NOPTS), (PTNME(I),I=1,NOPTS):', & + ((PTLOC(J,I),J=1,2),I=1,NOPTS), (PTNME(I),I=1,NOPTS) +#endif ELSE READ (NDSOP,END=801,ERR=802,IOSTAT=IERR) & ((PTLOC(J,I),J=1,2),I=1,NOPTS), (PTNME(I),I=1,NOPTS) @@ -1289,6 +1375,10 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD ) IF ( WRITE ) THEN OPEN (NDSOP,FILE=FNMPRE(:J)//TIMETAG//'.out_pnt.' & //FILEXT(:I),form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR) +#ifdef W3_ASCII + OPEN (NDSOA,FILE=FNMPRE(:J)//TIMETAG//'.out_pnt.' & + //FILEXT(:I)//'.txt',form='FORMATTED', ERR=800,IOSTAT=IERR) +#endif END IF ! REWIND ( NDSOP ) @@ -1300,6 +1390,11 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD ) IF ( WRITE ) THEN WRITE (NDSOP) & IDSTR, VEROPT, NK, NTH, NOPTS +#ifdef W3_ASCII + WRITE (NDSOA,*) & + 'IDSTR, VEROPT, NK, NTH, NOPTS:', & + IDSTR, VEROPT, NK, NTH, NOPTS +#endif ELSE READ (NDSOP,END=801,ERR=802,IOSTAT=IERR) & IDTST, VERTST, MK, MTH, NOPTS @@ -1330,6 +1425,11 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD ) IF ( WRITE ) THEN WRITE (NDSOP) & ((PTLOC(J,I),J=1,2),I=1,NOPTS), (PTNME(I),I=1,NOPTS) +#ifdef W3_ASCII + WRITE (NDSOA,*) & + '((PTLOC(J,I),J=1,2),I=1,NOPTS), (PTNME(I),I=1,NOPTS):', & + ((PTLOC(J,I),J=1,2),I=1,NOPTS), (PTNME(I),I=1,NOPTS) +#endif ELSE READ (NDSOP,END=801,ERR=802,IOSTAT=IERR) & ((PTLOC(J,I),J=1,2),I=1,NOPTS), (PTNME(I),I=1,NOPTS) @@ -1349,6 +1449,9 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD ) ! IF ( WRITE ) THEN WRITE (NDSOP) TIME +#ifdef W3_ASCII + WRITE (NDSOA,*) 'TIME:', TIME +#endif ELSE READ (NDSOP,END=803,ERR=802,IOSTAT=IERR) TIME END IF @@ -1378,6 +1481,23 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD ) #endif ASO(I), CAO(I), CDO(I), ICEO(I), ICEHO(I), & ICEFO(I), GRDID(I), (SPCO(J,I),J=1,NSPEC) +#ifdef W3_ASCII + WRITE (NDSOA,*) & + 'IW(I), II(I), IL(I), DPO(I), WAO(I), WDO(I):', & + IW(I), II(I), IL(I), DPO(I), WAO(I), WDO(I), & +#ifdef W3_FLX5 + 'TAUAO(I), TAUDO(I), DAIRO(I):', & + TAUAO(I), TAUDO(I), DAIRO(I), & +#endif +#ifdef W3_SETUP + 'ZET_SETO(I):', & + ZET_SETO(I), & +#endif + 'ASO(I), CAO(I), CDO(I), ICEO(I), ICEHO(I):', & + ASO(I), CAO(I), CDO(I), ICEO(I), ICEHO(I), & + 'ICEFO(I), GRDID(I), (SPCO(J,I),J=1,NSPEC):', & + ICEFO(I), GRDID(I), (SPCO(J,I),J=1,NSPEC) +#endif ELSE READ (NDSOP,END=801,ERR=802,IOSTAT=IERR) & IW(I), II(I), IL(I), DPO(I), WAO(I), WDO(I), & diff --git a/model/src/w3iorsmd.F90 b/model/src/w3iorsmd.F90 index 24d9a280c..352a34215 100644 --- a/model/src/w3iorsmd.F90 +++ b/model/src/w3iorsmd.F90 @@ -111,7 +111,7 @@ MODULE W3IORSMD !> !> @author H. L. Tolman @date 22-Mar-2021 !> - SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) + SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT , filename) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | @@ -327,7 +327,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) #ifdef W3_TIMINGS USE W3PARALL, ONLY: PRINT_MY_TIME #endif - USE w3odatmd, ONLY : RUNTYPE, INITFILE + USE w3odatmd, ONLY : RUNTYPE USE w3adatmd, ONLY : USSHX, USSHY #ifdef W3_PDLIB USE PDLIB_FIELD_VEC @@ -336,9 +336,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) USE W3SERVMD, ONLY: STRACE #endif ! - use w3timemd, only: set_user_timestring - use w3odatmd, only: use_user_restname, user_restfname, ndso - ! #ifdef W3_MPI INCLUDE "mpif.h" #endif @@ -352,6 +349,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) REAL, INTENT(INOUT) :: DUMFPI CHARACTER, INTENT(IN) :: INXOUT*(*) LOGICAL, INTENT(IN),OPTIONAL :: FLRSTRT + character(len=*), intent(in), optional :: filename !/ !/ ------------------------------------------------------------------- / !/ Local parameters @@ -382,12 +380,10 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) LOGICAL :: NDSROPN CHARACTER(LEN=4) :: TYPE CHARACTER(LEN=10) :: VERTST - CHARACTER(LEN=512) :: FNAME + CHARACTER(LEN=40) :: FNAME CHARACTER(LEN=26) :: IDTST CHARACTER(LEN=30) :: TNAME CHARACTER(LEN=15) :: TIMETAG - character(len=16) :: user_timestring !YYYY-MM-DD-SSSSS - logical :: exists !/ !/ ------------------------------------------------------------------- / !/ @@ -465,46 +461,9 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ! ! open file ---------------------------------------------------------- * ! - if (use_user_restname) then - ierr = -99 - if (.not. write) then - if (runtype == 'initial') then - if (len_trim(initfile) == 0) then - ! no IC file, use startup option - goto 800 - else - ! IC file exists - use it - fname = trim(initfile) - end if - else - call set_user_timestring(time,user_timestring) - fname = trim(user_restfname)//trim(user_timestring) - inquire( file=trim(fname), exist=exists) - if (.not. exists) then - call extcde (60, msg="required initial/restart file " // trim(fname) // " does not exist") - end if - end if - else - call set_user_timestring(time,user_timestring) - fname = trim(user_restfname)//trim(user_timestring) - end if - ! write out filename - if (iaproc == naprst) then - IF ( WRITE ) THEN - write (ndso,'(a)') 'WW3: writing restart file '//trim(fname) - else - write (ndso,'(a)') 'WW3: reading initial/restart file '//trim(fname) - end if - end if - if ( write ) then - IF ( .NOT.IOSFLG .OR. IAPROC.EQ.NAPRST ) & - open (ndsr,file=trim(fname), form='unformatted', convert=file_endian, & - ACCESS='STREAM',ERR=800,IOSTAT=IERR) - ELSE ! READ - open (ndsr, file=trim(fname), form='unformatted', convert=file_endian, & - ACCESS='STREAM',ERR=800,IOSTAT=IERR, & - STATUS='OLD',ACTION='READ') - END IF + if (present(filename)) then ! only when restart_nc and restart_from_binary=true + open (ndsr,file=trim(filename),form='unformatted', convert=file_endian, & + access='stream',err=800,iostat=ierr, status='old',action='read') else I = LEN_TRIM(FILEXT) J = LEN_TRIM(FNMPRE) @@ -530,10 +489,9 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) IFILE = IFILE + 1 ! #ifdef W3_T - WRITE (NDST,9001) trim(FNAME), LRECL + WRITE (NDST,9001) FNAME, LRECL #endif ! - IF(NDST.EQ.NDSR)THEN IF ( IAPROC .EQ. NAPERR ) & WRITE(NDSE,'(A,I8)')'UNIT NUMBERS OF RESTART FILE AND '& @@ -543,14 +501,14 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) IF ( WRITE ) THEN IF ( .NOT.IOSFLG .OR. IAPROC.EQ.NAPRST ) & - OPEN (NDSR,FILE=FNMPRE(:J)//trim(FNAME),form='UNFORMATTED', convert=file_endian, & + OPEN (NDSR,FILE=FNMPRE(:J)//FNAME,form='UNFORMATTED', convert=file_endian, & ACCESS='STREAM',ERR=800,IOSTAT=IERR) ELSE - OPEN (NDSR,FILE=FNMPRE(:J)//trim(FNAME),form='UNFORMATTED', convert=file_endian, & + OPEN (NDSR,FILE=FNMPRE(:J)//FNAME,form='UNFORMATTED', convert=file_endian, & ACCESS='STREAM',ERR=800,IOSTAT=IERR, & STATUS='OLD',ACTION='READ') END IF - end if + end if ! if (present(filename)) ! ! test info ---------------------------------------------------------- * ! @@ -638,21 +596,11 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) END IF ELSE READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) TTIME -#ifdef W3_CESMCOUPLED - if (runtype == 'branch' .or. runtype == 'continue') then - IF (TIME(1).NE.TTIME(1) .OR. TIME(2).NE.TTIME(2)) THEN - IF ( IAPROC .EQ. NAPERR ) & - WRITE (NDSE,906) TTIME, TIME - CALL EXTCDE ( 20 ) - END IF - end if -#else IF (TIME(1).NE.TTIME(1) .OR. TIME(2).NE.TTIME(2)) THEN IF ( IAPROC .EQ. NAPERR ) & WRITE (NDSE,906) TTIME, TIME CALL EXTCDE ( 20 ) END IF -#endif END IF ! #ifdef W3_T @@ -687,7 +635,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ! Original non-server version writing of spectra ! IF ( .NOT.IOSFLG .OR. (NAPROC.EQ.1.AND.NAPRST.EQ.1) ) THEN -#ifdef W3_MPI +#ifdef W3_MPI DO JSEA=1, NSEAL CALL INIT_GET_ISEA(ISEA, JSEA) NREC = ISEA + 2 @@ -696,7 +644,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) WRITEBUFF(1:NSPEC) = VA(1:NSPEC,JSEA) WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF END DO -#else +#else DO JSEA=1, NSEA ISEA = JSEA NREC = ISEA + 2 @@ -705,7 +653,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) WRITEBUFF(1:NSPEC) = VA(1:NSPEC,JSEA) WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF END DO -#endif +#endif ! ! I/O server version writing of spectra ( !/MPI ) ! @@ -1376,6 +1324,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) TICE(1) = -1 TICE(2) = 0 TRHO(1) = -1 + TRHO(2) = 0 TIC1(1) = -1 TIC1(2) = 0 TIC5(1) = -1 diff --git a/model/src/w3odatmd.F90 b/model/src/w3odatmd.F90 index 5c1c7d239..09a28d725 100644 --- a/model/src/w3odatmd.F90 +++ b/model/src/w3odatmd.F90 @@ -440,7 +440,7 @@ MODULE W3ODATMD INTEGER :: TOSNL5(2) #endif INTEGER :: TOFRST(2), TONEXT(2,8), TOLAST(2,8), & - TBPI0(2), TBPIN(2), NDS(13), OFILES(7) + TBPI0(2), TBPIN(2), NDS(15), OFILES(7) REAL :: DTOUT(8) LOGICAL :: FLOUT(8) TYPE(OTYPE1) :: OUT1 @@ -558,24 +558,36 @@ MODULE W3ODATMD LOGICAL, POINTER :: FLFORM, FLCOMB, O6INIT INTEGER, POINTER :: PTMETH ! C. Bunney; Partitioning method REAL, POINTER :: PTFCUT ! C. Bunney; Part. 5 freq cut - character(len=8) :: runtype = '' !< @public the run type (startup,branch,continue) - character(len=256) :: initfile = '' !< @public name of wave initial condition file - !! if runtype is startup or branch run, then initfile is used - logical :: use_user_histname = .false. !<@public logical flag for user set history filenames - logical :: use_user_restname = .false. !<@public logical flag for user set restart filenames - character(len=512) :: user_histfname = '' !<@public user history filename prefix, timestring - !! YYYY-MM-DD-SSSSS will be appended - character(len=512) :: user_restfname = '' !<@public user restart filename prefix, timestring - !! YYYY-MM-DD-SSSSS will be appended - logical :: histwr = .false. !<@public logical to trigger history write - !! if true => write history file (snapshot) - logical :: rstwr = .false. !<@public logical to trigger restart write - !! if true => write restart - logical :: user_netcdf_grdout = .false. !<@public logical flag to use netCDF for gridded - !! field output - character(len= 36) :: time_origin = '' !< @public the time_origin used for netCDF output - character(len= 36) :: calendar_name = '' !< @public the calendar used for netCDF output - integer(kind=8) :: elapsed_secs = 0 !< @public the time in seconds from the time_origin + + character(len=8) :: runtype = '' !< @public the run type (startup,branch,continue) + character(len=256) :: initfile = '' !< @public name of wave initial condition file + !! if runtype is startup or branch run, then initfile is used + character(len=512) :: user_histfname = '' !< @public user history filename prefix, timestring + !! YYYY-MM-DD-SSSSS will be appended + character(len=512) :: user_restfname = '' !< @public user restart filename prefix, timestring + !! YYYY-MM-DD-SSSSS will be appended + logical :: histwr = .false. !< @public logical to trigger history write + !! if true => write history file (snapshot) + logical :: rstwr = .false. !< @public logical to trigger restart write + !! if true => write restart + logical :: use_historync = .false. !< @public logical flag to use netCDF for gridded + !! field output + logical :: use_restartnc = .false. !< @public logical flag to read and write netCDF restarts + logical :: restart_from_binary = .false. !< @public logical flag for restarting from binary restart + ! when use_restartnc is true + logical :: logfile_is_assigned = .false. !< @public logical flag for assignment of nds(1) to specified + !! log file in mesh cap + logical :: verboselog = .true. !< @public logical flag to enable verbose WW3 native logging + logical :: addrstflds = .false. !< @public logical flag for additional restart fields + integer :: rstfldcnt = 0 !< @public the actual number of additional restart fields + character(len=10), dimension(10) :: rstfldlist = '' !< @public a list of additional fields for the restart file, + !! currently set to a maximum of 10. Additional restart fields + !! are required only when waves are in the slow loop and ice + !! is present. Note that waves should not be in the slow loop + !! if coupling to CICE is set + character(len=36) :: time_origin = '' !< @public the time_origin used for netCDF output + character(len=36) :: calendar_name = '' !< @public the calendar used for netCDF output + integer(kind=8) :: elapsed_secs = 0 !< @public the time in seconds from the time_origin !/ CONTAINS !/ ------------------------------------------------------------------- / @@ -909,13 +921,14 @@ SUBROUTINE W3NOUT ( NDSERR, NDSTST ) ! ! 8) Spectrum parameters ! - NOGE(8) = 5 + NOGE(8) = 6 ! IDOUT( 8, 1) = 'Mean square slopes ' IDOUT( 8, 2) = 'Phillips tail const' IDOUT( 8, 3) = 'Slope direction ' IDOUT( 8, 4) = 'Tail slope direction' IDOUT( 8, 5) = 'Goda peakedness parm' + IDOUT( 8, 6) = 'kxky-peakdness ' ! IDOUT( 8, 3) = 'Lx-Ly mean wvlength' ! IDOUT( 8, 4) = 'Surf grad correl XT' ! IDOUT( 8, 5) = 'Surf grad correl YT' diff --git a/model/src/w3ounfmetamd.F90 b/model/src/w3ounfmetamd.F90 index 03e8e1b62..4e35e5a82 100644 --- a/model/src/w3ounfmetamd.F90 +++ b/model/src/w3ounfmetamd.F90 @@ -3291,7 +3291,7 @@ SUBROUTINE DEFAULT_META() ! IFI=5, IFJ=1, UST META => GROUP(5)%FIELD(1)%META ! First component - META(1)%FSC = 0.01 + META(1)%FSC = 0.001 META(1)%ENAME = '.ust' META(1)%UNITS = 'm s-1' META(1)%VARNM='uust' @@ -3980,7 +3980,19 @@ SUBROUTINE DEFAULT_META() META(1)%VARNC='Goda wave peakedness parameter' META(1)%VMIN = 0 META(1)%VMAX = 32 - + ! IFI=8, IFJ=6, QKK + META => GROUP(8)%FIELD(6)%META + META(1)%FSC = 0.05 + META(1)%UNITS = 'm/rad' + META(1)%ENAME = '.qkk' + META(1)%VARNM='qkk' + META(1)%VARNL='k-peakedness' + !META(1)%VARNS='sea_surface_wave_peakedness' + META(1)%VARNS='' + META(1)%VARNG='wavenumber_peakedness' + META(1)%VARNC='2D wavenumber peakedness' + META(1)%VMIN = 0 + META(1)%VMAX = 1600 ! !---------- GROUP 9 ---------------- ! diff --git a/model/src/w3parall.F90 b/model/src/w3parall.F90 index 798e989cb..e2aba9b52 100644 --- a/model/src/w3parall.F90 +++ b/model/src/w3parall.F90 @@ -1,3 +1,24 @@ +!> @file +!> @brief Parallel routines for implicit solver. +!> +!> @author Aron Roland +!> @author Mathieu Dutour-Sikiric +!> @date 01-Jun-2018 +!> + +!/ ------------------------------------------------------------------- / +!> +!> @brief Parallel routines for implicit solver. +!> +!> @author Aron Roland +!> @author Mathieu Dutour-Sikiric +!> @date 01-Jun-2018 +!> +!> @copyright Copyright 2009-2022 National Weather Service (NWS), +!> National Oceanic and Atmospheric Administration. All rights +!> reserved. WAVEWATCH III is a trademark of the NWS. +!> No unauthorized use without permission. +!> MODULE W3PARALL !/ !/ +-----------------------------------+ @@ -76,6 +97,15 @@ MODULE W3PARALL REAL, PARAMETER :: THR = TINY(1.0) CONTAINS !/ ------------------------------------------------------------------- / + !> + !> @brief NA + !> + !> @param[out] eTime + !> + !> @author Aron Roland + !> @author Mathieu Dutour-Sikiric + !> @date 01-Jun-2018 + !> SUBROUTINE WAV_MY_WTIME(eTime) !/ ------------------------------------------------------------------- / !/ @@ -157,6 +187,15 @@ SUBROUTINE WAV_MY_WTIME(eTime) !/ END SUBROUTINE WAV_MY_WTIME !/ ------------------------------------------------------------------- / + !> + !> @brief Print timings. + !> + !> @param[in] string + !> + !> @author Aron Roland + !> @author Mathieu Dutour-Sikiric + !> @date 01-Jun-2018 + !> SUBROUTINE PRINT_MY_TIME(string) !/ !/ +-----------------------------------+ @@ -232,6 +271,17 @@ SUBROUTINE PRINT_MY_TIME(string) !/ END SUBROUTINE PRINT_MY_TIME !/ ------------------------------------------------------------------- / + !> + !> @brief Compute refraction part in matrix. + !> + !> @param[in] ISEA + !> @param[in] DTG + !> @param[out] CAD + !> + !> @author Aron Roland + !> @author Mathieu Dutour-Sikiric + !> @date 01-Jun-2018 + !> SUBROUTINE PROP_REFRACTION_PR1(ISEA,DTG, CAD) !/ !/ +-----------------------------------+ @@ -382,6 +432,19 @@ SUBROUTINE PROP_REFRACTION_PR1(ISEA,DTG, CAD) END SUBROUTINE PROP_REFRACTION_PR1 !/ ------------------------------------------------------------------- / ! + !> + !> @brief Compute refraction part in matrix alternative approach. + !> + !> @param[in] IP + !> @param[in] ISEA + !> @param[in] DTG + !> @param[out] CAD + !> @param[in] DoLimiter + !> + !> @author Aron Roland + !> @author Mathieu Dutour-Sikiric + !> @date 01-Jun-2018 + !> SUBROUTINE PROP_REFRACTION_PR3(IP, ISEA, DTG, CAD, DoLimiter) !/ !/ +-----------------------------------+ @@ -529,6 +592,19 @@ SUBROUTINE PROP_REFRACTION_PR3(IP, ISEA, DTG, CAD, DoLimiter) !/ END SUBROUTINE PROP_REFRACTION_PR3 !/ ------------------------------------------------------------------- / + !> + !> @brief Compute frequency shift in matrix. + !> + !> @param[in] IP + !> @param[in] ISEA + !> @param[out] CAS + !> @param[out] DMM + !> @param[in] DTG + !> + !> @author Aron Roland + !> @author Mathieu Dutour-Sikiric + !> @date 01-Jun-2018 + !> SUBROUTINE PROP_FREQ_SHIFT(IP, ISEA, CAS, DMM, DTG) !/ !/ +-----------------------------------+ @@ -668,6 +744,19 @@ SUBROUTINE PROP_FREQ_SHIFT(IP, ISEA, CAS, DMM, DTG) !/ END SUBROUTINE PROP_FREQ_SHIFT !/ ------------------------------------------------------------------- / + !> + !> @brief Compute frequency shift alternative approach. + !> + !> @param[in] IP + !> @param[in] ISEA + !> @param[out] CWNB_M2 + !> @param[out] DWNI_M2 + !> @param[in] DTG + !> + !> @author Aron Roland + !> @author Mathieu Dutour-Sikiric + !> @date 01-Jun-2018 + !> SUBROUTINE PROP_FREQ_SHIFT_M2(IP, ISEA, CWNB_M2, DWNI_M2, DTG) !/ !/ +-----------------------------------+ @@ -813,6 +902,16 @@ SUBROUTINE PROP_FREQ_SHIFT_M2(IP, ISEA, CWNB_M2, DWNI_M2, DTG) !/ END SUBROUTINE PROP_FREQ_SHIFT_M2 !/ ------------------------------------------------------------------- / + !> + !> @brief Sync global local arrays. + !> + !> @param[in] IMOD + !> @param[in] IsMulti + !> + !> @author Aron Roland + !> @author Mathieu Dutour-Sikiric + !> @date 01-Jun-2018 + !> SUBROUTINE SYNCHRONIZE_IPGL_ETC_ARRAY(IMOD, IsMulti) !/ !/ +-----------------------------------+ @@ -927,6 +1026,16 @@ SUBROUTINE SYNCHRONIZE_IPGL_ETC_ARRAY(IMOD, IsMulti) !/ END SUBROUTINE SYNCHRONIZE_IPGL_ETC_ARRAY !/ ....................----------------------------------------------- / + !> + !> @brief Setup NSEAL, NSEALM in context of PDLIB. + !> + !> @param[out] NSEALout + !> @param[out] NSEALMout + !> + !> @author Aron Roland + !> @author Mathieu Dutour-Sikiric + !> @date 01-Jun-2018 + !> SUBROUTINE SET_UP_NSEAL_NSEALM(NSEALout, NSEALMout) !/ !/ +-----------------------------------+ @@ -1039,6 +1148,17 @@ SUBROUTINE SET_UP_NSEAL_NSEALM(NSEALout, NSEALMout) !/ END SUBROUTINE SET_UP_NSEAL_NSEALM !/ ------------------------------------------------------------------- / + !> + !> @brief Set JSEA for all schemes. + !> + !> @param[in] ISEA + !> @param[out] JSEA + !> @param[out] ISPROC + !> + !> @author Aron Roland + !> @author Mathieu Dutour-Sikiric + !> @date 01-Jun-2018 + !> SUBROUTINE INIT_GET_JSEA_ISPROC(ISEA, JSEA, ISPROC) !/ ------------------------------------------------------------------- / !/ @@ -1136,6 +1256,17 @@ SUBROUTINE INIT_GET_JSEA_ISPROC(ISEA, JSEA, ISPROC) !/ END SUBROUTINE INIT_GET_JSEA_ISPROC !/ ------------------------------------------------------------------- / + !> + !> @brief Set belongings of JSEA in context of PDLIB. + !> + !> @param[in] ISEA + !> @param[out] JSEA + !> @param[out] IBELONG + !> + !> @author Aron Roland + !> @author Mathieu Dutour-Sikiric + !> @date 01-Jun-2018 + !> SUBROUTINE GET_JSEA_IBELONG(ISEA, JSEA, IBELONG) !/ ------------------------------------------------------------------- / !/ @@ -1253,6 +1384,16 @@ SUBROUTINE GET_JSEA_IBELONG(ISEA, JSEA, IBELONG) !/ END SUBROUTINE GET_JSEA_IBELONG !/ ------------------------------------------------------------------- / + !> + !> @brief Set ISEA for all schemes. + !> + !> @param[out] ISEA + !> @param[in] JSEA + !> + !> @author Aron Roland + !> @author Mathieu Dutour-Sikiric + !> @date 01-Jun-2018 + !> SUBROUTINE INIT_GET_ISEA(ISEA, JSEA) !/ ------------------------------------------------------------------- / !/ @@ -1359,12 +1500,25 @@ SUBROUTINE INIT_GET_ISEA(ISEA, JSEA) !/ End of INIT_GET_ISEA ------------------------------------------------ / !/ END SUBROUTINE INIT_GET_ISEA - !********************************************************************** - !* An array of size (NSEA) is send but only the (1:NSEAL) values * - !* are correct. The program synchonizes everything on all nodes. * - !********************************************************************** + + !> + !> @brief Sync global array in context of PDLIB. + !> + !> @details An array of size (NSEA) is send but only the (1:NSEAL) values + !> are correct. The program synchonizes everything on all nodes. + !> + !> @param[inout] TheVar + !> + !> @author Aron Roland + !> @author Mathieu Dutour-Sikiric + !> @date 01-Jun-2018 + !> SUBROUTINE SYNCHRONIZE_GLOBAL_ARRAY(TheVar) !/ ------------------------------------------------------------------- / + !********************************************************************** + !* An array of size (NSEA) is send but only the (1:NSEAL) values * + !* are correct. The program synchonizes everything on all nodes. * + !********************************************************************** !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | diff --git a/model/src/w3pro1md.F90 b/model/src/w3pro1md.F90 index 16db90356..f8b498833 100644 --- a/model/src/w3pro1md.F90 +++ b/model/src/w3pro1md.F90 @@ -1,5 +1,25 @@ +!> @file +!> @brief Bundles routines for first order propagation scheme in single +!> module. +!> +!> @author H. L. Tolman +!> @date 05-Jun-2018 +!> + #include "w3macros.h" !/ ------------------------------------------------------------------- / +!> +!> @brief Bundles routines for first order propagation scheme in single +!> module. +!> +!> @author H. L. Tolman +!> @date 05-Jun-2018 +!> +!> @copyright Copyright 2009-2022 National Weather Service (NWS), +!> National Oceanic and Atmospheric Administration. All rights +!> reserved. WAVEWATCH III is a trademark of the NWS. +!> No unauthorized use without permission. +!> MODULE W3PRO1MD !/ !/ +-----------------------------------+ @@ -76,6 +96,14 @@ MODULE W3PRO1MD !/ ------------------------------------------------------------------- / CONTAINS !/ ------------------------------------------------------------------- / + !> + !> @brief Generate 'map' arrays for the first order upstream scheme. + !> + !> @param MAPSTA Status map + !> + !> @author H. L. Tolman + !> @date 06-Dec-2010 + !> SUBROUTINE W3MAP1 ( MAPSTA ) !/ !/ +-----------------------------------+ @@ -258,6 +286,19 @@ SUBROUTINE W3MAP1 ( MAPSTA ) !/ END SUBROUTINE W3MAP1 !/ ------------------------------------------------------------------- / + !> + !> @brief Propagation in physical space for a given spectral component. + !> + !> @param[in] ISP Number of spectral bin (IK-1)*NTH+ITH + !> @param[in] DTG Total time step. + !> @param[in] MAPSTA Grid point status map. + !> @param[inout] FIELD Wave action spectral densities on full grid. + !> @param[in] VGX Speed of grid. + !> @param[in] VGY Speed of grid. + !> + !> @author H. L. Tolman + !> @date 29-May-2014 + !> SUBROUTINE W3XYP1 ( ISP, DTG, MAPSTA, FIELD, VGX, VGY ) !/ !/ +-----------------------------------+ @@ -828,6 +869,31 @@ SUBROUTINE W3XYP1 ( ISP, DTG, MAPSTA, FIELD, VGX, VGY ) !/ END SUBROUTINE W3XYP1 !/ ------------------------------------------------------------------- / + !> + !> @brief Propagation in spectral space. + !> + !> @param[inout] ISEA Number of sea points. + !> @param[inout] FACTH Factor in propagation velocity. + !> @param[inout] FACK Factor in propagation velocity. + !> @param[inout] CTHG0 Factor in great circle refracftion term. + !> @param[inout] CG Local group velocities. + !> @param[inout] WN Local wavenumbers. + !> @param[inout] DEPTH Depth. + !> @param[inout] DDDX Depth gradients. + !> @param[inout] DDDY Depth gradients. + !> @param[inout] CX Local group velocities. + !> @param[inout] CY Local group velocities. + !> @param[inout] DCXDX Current gradients. + !> @param[inout] DCXDY Current gradients. + !> @param[inout] DCYDX Current gradients. + !> @param[inout] DCYDY Current gradients. + !> @param[inout] DCDX Phase speed gradients. + !> @param[inout] DCDY Phase speed gradients. + !> @param[inout] VA Spectrum. + !> + !> @author H. L. Tolman + !> @date 20-Dec-2004 + !> SUBROUTINE W3KTP1 ( ISEA, FACTH, FACK, CTHG0, CG, WN, DEPTH, & DDDX, DDDY, CX, CY, DCXDX, DCXDY, DCYDX, & DCYDY, DCDX, DCDY, VA ) diff --git a/model/src/w3pro2md.F90 b/model/src/w3pro2md.F90 index 4ae31f242..a23f893ef 100644 --- a/model/src/w3pro2md.F90 +++ b/model/src/w3pro2md.F90 @@ -1,5 +1,26 @@ +!> @file +!> @brief Bundles routines for third order porpagation scheme in single +!> module. +!> +!> @author H. L. Tolman +!> @date 29-May-2014 +!> + #include "w3macros.h" !/ ------------------------------------------------------------------- / + +!> +!> @brief Bundles routines for third order porpagation scheme in single +!> module. +!> +!> @author H. L. Tolman +!> @date 29-May-2014 +!> +!> @copyright Copyright 2009-2022 National Weather Service (NWS), +!> National Oceanic and Atmospheric Administration. All rights +!> reserved. WAVEWATCH III is a trademark of the NWS. +!> No unauthorized use without permission. +!> MODULE W3PRO2MD !/ !/ +-----------------------------------+ @@ -105,6 +126,12 @@ MODULE W3PRO2MD !/ CONTAINS !/ ------------------------------------------------------------------- / + !> + !> @brief Generate 'map' arrays for the ULTIMATE QUICKEST scheme. + !> + !> @author H. L. Tolman + !> @date 09-Nov-2005 + !> SUBROUTINE W3MAP2 !/ !/ @@ -464,6 +491,20 @@ SUBROUTINE W3MAP2 !/ END SUBROUTINE W3MAP2 !/ ------------------------------------------------------------------- / + !> + !> @brief Propagation in physical space for a given spectral component. + !> + !> @param[in] ISP Number of spectral bin (IK-1)*NTH+ITH. + !> @param[in] DTG Total time step. + !> @param[in] MAPSTA Grid point status map. + !> @param[in] MAPFS Storage map. + !> @param[inout] VQ Field to propagate. + !> @param[in] VGX + !> @param[in] VGY + !> + !> @author H. L. Tolman + !> @date 29-May-2014 + !> SUBROUTINE W3XYP2 ( ISP, DTG, MAPSTA, MAPFS, VQ, VGX, VGY ) !/ !/ +-----------------------------------+ @@ -1219,6 +1260,45 @@ SUBROUTINE W3XYP2 ( ISP, DTG, MAPSTA, MAPFS, VQ, VGX, VGY ) END SUBROUTINE W3XYP2 !/ !/ ------------------------------------------------------------------- / + !> + !> @brief Propagation in spectral space. + !> + !> @details Third order QUICKEST scheme with ULTIMATE limiter. + !> + !> + !> As with the spatial propagation, the two spaces are considered + !> independently, but the propagation is performed in a 2-D space. + !> Compared to the propagation in physical space, the directions + !> represent a closed space and are therefore comparable to the + !> longitudinal or 'X' propagation. The wavenumber space has to be + !> extended to allow for boundary treatment. Using a simple first + !> order boundary treatment at both sided, two points need to + !> be added. This implies that the spectrum needs to be extended, + !> shifted and rotated, as is performed using MAPTH2 as set + !> in W3MAP3. + !> + !> @param[in] ISEA Number of sea point. + !> @param[in] FACTH Factor in propagation velocity. + !> @param[in] FACK Factor in propagation velocity. + !> @param[in] CTHG0 Factor in great circle refracftion term. + !> @param[in] CG Local group velocities. + !> @param[in] WN Local wavenumbers. + !> @param[in] DEPTH Depth. + !> @param[in] DDDX Depth gradient. + !> @param[in] DDDY Depth gradient. + !> @param[in] CX Current component. + !> @param[in] CY Current component. + !> @param[in] DCXDX Current gradients. + !> @param[in] DCXDY Current gradients. + !> @param[in] DCYDX Current gradients. + !> @param[in] DCYDY Current gradients. + !> @param[in] DCDX Phase speed gradient. + !> @param[in] DCDY Phase speed gradient. + !> @param[inout] VA Spectrum. + !> + !> @author H. L. Tolman + !> @date 01-Jul-2013 + !> SUBROUTINE W3KTP2 ( ISEA, FACTH, FACK, CTHG0, CG, WN, DEPTH, & DDDX, DDDY, CX, CY, DCXDX, DCXDY, & DCYDX, DCYDY, DCDX, DCDY, VA ) diff --git a/model/src/w3pro3md.F90 b/model/src/w3pro3md.F90 index 157b9be09..96396a7a4 100644 --- a/model/src/w3pro3md.F90 +++ b/model/src/w3pro3md.F90 @@ -1,5 +1,25 @@ +!> @file +!> @brief Bundles routines for third order propagation scheme in single +!> module. +!> +!> @author H. L. Tolman +!> @date 27-May-2014 +!> + #include "w3macros.h" !/ ------------------------------------------------------------------- / +!> +!> @brief Bundles routines for third order propagation scheme in single +!> module. +!> +!> @author H. L. Tolman +!> @date 27-May-2014 +!> +!> @copyright Copyright 2009-2022 National Weather Service (NWS), +!> National Oceanic and Atmospheric Administration. All rights +!> reserved. WAVEWATCH III is a trademark of the NWS. +!> No unauthorized use without permission. +!> MODULE W3PRO3MD !/ !/ +-----------------------------------+ @@ -110,6 +130,12 @@ MODULE W3PRO3MD !/ CONTAINS !/ ------------------------------------------------------------------- / + !> + !> @brief Generate 'map' arrays for the ULTIMATE QUICKEST scheme. + !> + !> @author H. L. Tolman + !> @date 01-Apr-2008 + !> SUBROUTINE W3MAP3 !/ !/ +-----------------------------------+ @@ -488,6 +514,13 @@ SUBROUTINE W3MAP3 !/ END SUBROUTINE W3MAP3 !/ ------------------------------------------------------------------- / + !> + !> @brief Generate 'map' arrays for the ULTIMATE QUICKEST scheme to combine + !> GSE alleviation with obstructions. + !> + !> @author H. L. Tolman + !> @date 17-Dec-2004 + !> SUBROUTINE W3MAPT !/ !/ +-----------------------------------+ @@ -588,6 +621,20 @@ SUBROUTINE W3MAPT !/ END SUBROUTINE W3MAPT !/ ------------------------------------------------------------------- / + !> + !> @brief Propagation in phyiscal space for a given spectral component. + !> + !> @param[in] ISP Number of spectral bin (IK-1)*NTH+ITH. + !> @param[in] DTG Total time step. + !> @param[in] MAPSTA Grid point status map. + !> @param[in] MAPFS Storage map. + !> @param[inout] VQ Field to propagate. + !> @param[in] VGX Speed of grid. + !> @param[in] VGY Speed of grid. + !> + !> @author H. L. Tolman + !> @date 27-May-2014 + !> SUBROUTINE W3XYP3 ( ISP, DTG, MAPSTA, MAPFS, VQ, VGX, VGY ) !/ !/ +-----------------------------------+ @@ -1419,6 +1466,46 @@ SUBROUTINE W3XYP3 ( ISP, DTG, MAPSTA, MAPFS, VQ, VGX, VGY ) !/ END SUBROUTINE W3XYP3 !/ ------------------------------------------------------------------- / +!> +!> @brief Propagation in spectral space. +!> +!> @details Third order QUICKEST scheme with ULTIMATE limiter. +!> +!> As with the spatial propagation, the two spaces are considered +!> independently, but the propagation is performed in a 2-D space. +!> Compared to the propagation in physical space, the directions +!> represent a closed space and are therefore comparable to the +!> longitudinal or 'X' propagation. The wavenumber space has to be +!> extended to allow for boundary treatment. Using a simple first +!> order boundary treatment at both sided, two points need to +!> be added. This implies that the spectrum needs to be extended, +!> shifted and rotated, as is performed using MAPTH2 as set +!> in W3MAP3. +!> +!> @param[in] ISEA Number of sea point. +!> @param[in] FACTH Factor in propagation velocity. +!> @param[in] FACK Factor in propagation velocity. +!> @param[in] CTHG0 Factor in great circle refracftion term. +!> @param[in] CG Local group velocities. +!> @param[in] WN Local wavenumbers. +!> @param[in] DW Depth. +!> @param[in] DDDX Depth gradients. +!> @param[in] DDDY Depth gradients. +!> @param[in] CX Current components. +!> @param[in] CY Current components. +!> @param[in] DCXDX Current gradients. +!> @param[in] DCXDY Current gradients. +!> @param[in] DCYDX Current gradients. +!> @param[in] DCYDY Current gradients. +!> @param[in] DCDX Phase speed gradients. +!> @param[in] DCDY Phase speed gradients. +!> @param[inout] VA Spectrum. +!> @param[out] CFLTHMAX +!> @param[out] CFLKMAX +!> +!> @author H. L. Tolman +!> @date 01-Jul-2013 +!> SUBROUTINE W3KTP3 ( ISEA, FACTH, FACK, CTHG0, CG, WN, DW, & DDDX, DDDY, CX, CY, DCXDX, DCXDY, & DCYDX, DCYDY, DCDX, DCDY, VA, CFLTHMAX, CFLKMAX ) @@ -1863,6 +1950,23 @@ SUBROUTINE W3KTP3 ( ISEA, FACTH, FACK, CTHG0, CG, WN, DW, & !/ END SUBROUTINE W3KTP3 !/ ------------------------------------------------------------------- / + !> + !> @brief Computes the maximum CFL number for spatial advection. + !> + !> @details Used for diagnostic purposes (Could be used to define a + !> local time step ...). + !> + !> @param[in] ISEA Index of grid point. + !> @param[in] DTG Total time step. + !> @param[in] MAPSTA Grid point status map. + !> @param[in] MAPFS Storage map. + !> @param[inout] CFLXYMAX Maximum CFL number for XY propagation. + !> @param[in] VGX Speed of grid. + !> @param[in] VGY Speed of grid. + !> + !> @author F. Ardhuin + !> @date 31-Oct-2010 + !> SUBROUTINE W3CFLXY ( ISEA, DTG, MAPSTA, MAPFS, CFLXYMAX, VGX, VGY ) !/ !/ +-----------------------------------+ diff --git a/model/src/w3ref1md.F90 b/model/src/w3ref1md.F90 index 795bdce20..df184faf1 100644 --- a/model/src/w3ref1md.F90 +++ b/model/src/w3ref1md.F90 @@ -1,4 +1,24 @@ +!> @file +!> @brief This module computes shoreline reflection, and +!> unresolved islands and iceberg reflections. +!> +!> @author F. Ardhuin +!> @date 27-Jun-2014 +!> + !/ ------------------------------------------------------------------- / +!> +!> @brief This module computes shoreline reflection, and +!> unresolved islands and iceberg reflections. +!> +!> @author F. Ardhuin +!> @date 27-Jun-2014 +!> +!> @copyright Copyright 2009-2022 National Weather Service (NWS), +!> National Oceanic and Atmospheric Administration. All rights +!> reserved. WAVEWATCH III is a trademark of the NWS. +!> No unauthorized use without permission. +!> MODULE W3REF1MD !/ !/ +-----------------------------------+ @@ -64,6 +84,30 @@ MODULE W3REF1MD !/ CONTAINS !/ ------------------------------------------------------------------- / + !> + !> @brief Computes coastal and iceberg/island reflections and adds free IG energy. + !> + !> @param[inout] A Action density spectrum (1-D). + !> @param[in] CG Group velocities. + !> @param[in] WN Wavenumbers. + !> @param[in] EMEAN + !> @param[in] FMEAN + !> @param[in] DEPTH Mean water depth. + !> @param[in] CX1 + !> @param[in] CY1 + !> @param[in] REFLC + !> @param[in] REFLD + !> @param[in] TRNX + !> @param[in] TRNY + !> @param[in] BERG + !> @param[in] DT + !> @param[in] IX + !> @param[in] IY + !> @param[out] S Source term (1-D version). + !> + !> @author F. Ardhuin + !> @date 11-Jun-2014 + !> SUBROUTINE W3SREF(A, CG, WN, EMEAN, FMEAN, DEPTH, CX1, CY1, REFLC, REFLD, & TRNX, TRNY, BERG, DT, IX, IY, JSEA, S) !/ @@ -104,7 +148,7 @@ SUBROUTINE W3SREF(A, CG, WN, EMEAN, FMEAN, DEPTH, CX1, CY1, REFLC, REFLD, & ! ! Parameter list ! ---------------------------------------------------------------- - ! A R.A. I Action density spectrum (1-D) + ! A R.A. I Action density spectrum (1-D) ! CG R.A. I Group velocities. ! WN R.A. I Wavenumbers. ! DEPTH Real I Mean water depth. diff --git a/model/src/w3sbt1md.F90 b/model/src/w3sbt1md.F90 index fdc675ff3..bf17eafa1 100644 --- a/model/src/w3sbt1md.F90 +++ b/model/src/w3sbt1md.F90 @@ -1,5 +1,23 @@ +!> @file +!> @brief JONSWAP bottom friction routine. +!> +!> @author H. L. Tolman +!> @date 29-May-2009 +!> + #include "w3macros.h" !/ ------------------------------------------------------------------- / +!> +!> @brief JONSWAP bottom friction routine. +!> +!> @author H. L. Tolman +!> @date 29-May-2009 +!> +!> @copyright Copyright 2009-2022 National Weather Service (NWS), +!> National Oceanic and Atmospheric Administration. All rights +!> reserved. WAVEWATCH III is a trademark of the NWS. +!> No unauthorized use without permission. +!> MODULE W3SBT1MD !/ !/ +-----------------------------------+ @@ -42,6 +60,31 @@ MODULE W3SBT1MD !/ CONTAINS !/ ------------------------------------------------------------------- / + !> + !> @brief Bottom friction source term according to the empirical JONSWAP + !> formulation. + !> + !> @verbatim + !> 2 GAMMA / CG \ SBTC1 / \ . + !> Sbt = ---------- | ------- - 0.5 | E = ----- | ... | E (1) + !> GRAV DEPTH \ SI/WN / DEPTH \ / + !> + !> Where GAMMA = -0.038 m2/s3 (JONSWAP) + !> = -0.067 m2/s3 (Bouws and Komen 1983) + !> + !> In the routine, the constant 2 GAMMA / GRAV = SBTC1. + !> @endverbatim + !> + !> @param[in] A Action density spectrum (1-D). + !> @param[in] CG Group velocities. + !> @param[in] WN Wavenumbers. + !> @param[in] DEPTH Mean water depth. + !> @param[out] S Source term (1-D version). + !> @param[out] D Diagonal term of derivative (1-D version). + !> + !> @author H. L. Tolman + !> @date 29-May-2009 + !> SUBROUTINE W3SBT1 (A, CG, WN, DEPTH, S, D) !/ !/ +-----------------------------------+ diff --git a/model/src/w3sbt4md.F90 b/model/src/w3sbt4md.F90 index 3291930f1..1d0e3a8d7 100644 --- a/model/src/w3sbt4md.F90 +++ b/model/src/w3sbt4md.F90 @@ -1,5 +1,27 @@ +!> @file +!> @brief SHOWEX bottom friction source term (Ardhuin et al 2003). +!> +!> @author F. Ardhuin +!> @author J. Lepesqueur +!> @date 14-Mar-2012 +!> + #include "w3macros.h" !/ ------------------------------------------------------------------- / +!> +!> @brief SHOWEX bottom friction source term (Ardhuin et al. 2003). +!> +!> @details Using a subgrid depth parameterization based on Tolman (CE 1995). +!> +!> @author F. Ardhuin +!> @author J. Lepesqueur +!> @date 14-Mar-2012 +!> +!> @copyright Copyright 2009-2022 National Weather Service (NWS), +!> National Oceanic and Atmospheric Administration. All rights +!> reserved. WAVEWATCH III is a trademark of the NWS. +!> No unauthorized use without permission. +!> MODULE W3SBT4MD !/ !/ +-----------------------------------+ @@ -114,6 +136,12 @@ MODULE W3SBT4MD !/ ------------------------------------------------------------------- / + !> + !> @brief Initialization for bottom friction source term routine. + !> + !> @author F. Ardhuin + !> @date 14-Mar-2012 + !> SUBROUTINE INSBT4 !/ !/ +-----------------------------------+ @@ -202,6 +230,15 @@ SUBROUTINE INSBT4 !/ END SUBROUTINE INSBT4 ! ---------------------------------------------------------------------- + + !> + !> @brief Tabulation of ERF function, which is used in bottom friction subgrid modeling. + !> + !> @details Initialization for source term routine. + !> + !> @author J. Lepesqueur + !> @date 14-Mar-2012 + !> SUBROUTINE TABU_ERF !/ !/ +-----------------------------------+ @@ -276,6 +313,30 @@ END SUBROUTINE TABU_ERF !/ ------------------------------------------------------------------- / !/ ------------------------------------------------------------------- / + !> + !> @brief Computes the SHOWEX bottom friction with movable bed effects. + !> + !> @details Uses a Gaussian distribution for friction factors, and estimates + !> the contribution of rippled and non-rippled fractions based on the + !> bayesian approach of Tolman (1995). + !> + !> @param[in] A Action density spectrum. + !> @param[in] CG Group velocities. + !> @param[in] WN Wavenumbers. + !> @param[in] DEPTH Water depth. + !> @param[in] D50 Median grain size. + !> @param[in] PSIC Critical Shields parameter. + !> @param[out] TAUBBL Components of stress leaking to the bottom. + !> @param[inout] BEDFORM Ripple parameters (roughness and wavelength). + !> @param[out] S Source term (1-D version). + !> @param[out] D Diagonal term of derivative. + !> @param[in] IX Spatial grid index. + !> @param[in] IY Spatial grid index. + !> + !> @author F. Ardhuin + !> @author J. Lepesqueur + !> @date 15-Mar-2012 + !> SUBROUTINE W3SBT4 (A, CG, WN, DEPTH, D50, PSIC, TAUBBL, BEDFORM, S, D, IX, IY ) !/ !/ +-----------------------------------+ diff --git a/model/src/w3sbt8md.F90 b/model/src/w3sbt8md.F90 index f598c2fbe..c56b57f0e 100644 --- a/model/src/w3sbt8md.F90 +++ b/model/src/w3sbt8md.F90 @@ -1,5 +1,27 @@ +!> @file +!> @brief Contains routines for computing dissipation by viscous fluid mud using +!> Dalrymple and Liu (1978) "Thin Model". +!> +!> @author M. Orzech +!> @author W. E. Rogers +!> @date 21-Nov-2013 +!> + #include "w3macros.h" !/ ------------------------------------------------------------------- / +!> +!> @brief Contains routines for computing dissipation by viscous fluid mud using +!> Dalrymple and Liu (1978) "Thin Model". +!> +!> @author M. Orzech +!> @author W. E. Rogers +!> @date 21-Nov-2013 +!> +!> @copyright Copyright 2009-2022 National Weather Service (NWS), +!> National Oceanic and Atmospheric Administration. All rights +!> reserved. WAVEWATCH III is a trademark of the NWS. +!> No unauthorized use without permission. +!> MODULE W3SBT8MD !/ !/ +-----------------------------------+ @@ -70,6 +92,22 @@ MODULE W3SBT8MD !/ CONTAINS !/ ------------------------------------------------------------------- / + !> + !> @brief Compute dissipation by viscous fluid mud using Dalrymple and Liu (1978). + !> + !> @details "Thin Model" (adapted from Erick Rogers code by Mark Orzech, NRL). + !> + !> @param[in] AC Action density spectrum (1-D). + !> @param[in] H_WDEPTH Mean water depth. + !> @param[out] S Source term (1-D version). + !> @param[out] D Diagonal term of derivative (1-D version). + !> @param[in] IX + !> @param[in] IY + !> + !> @author M. Orzech + !> @author W. E. Rogers + !> @date 21-Nov-2013 + !> SUBROUTINE W3SBT8(AC,H_WDEPTH,S,D,IX,IY) !/ !/ +-----------------------------------+ @@ -454,7 +492,15 @@ SUBROUTINE W3SBT8(AC,H_WDEPTH,S,D,IX,IY) END SUBROUTINE W3SBT8 !/ ------------------------------------------------------------------- / - + !> + !> @brief Complex hyperbolic sin (sinh). + !> + !> @param[in] C + !> @param[out] CS + !> + !> @author NA + !> @date NA + !> SUBROUTINE CSINH(C,CS) COMPLEX, INTENT(IN) :: C COMPLEX, INTENT(OUT) :: CS @@ -465,7 +511,15 @@ SUBROUTINE CSINH(C,CS) END SUBROUTINE CSINH !/ ------------------------------------------------------------------- / - + !> + !> @brief Complex hyperbolic cos (cosh). + !> + !> @param[in] C + !> @param[out] CC + !> + !> @author NA + !> @date NA + !> SUBROUTINE CCOSH(C,CC) COMPLEX, INTENT(IN) :: C COMPLEX, INTENT(OUT) :: CC diff --git a/model/src/w3sbt9md.F90 b/model/src/w3sbt9md.F90 index 217a54977..9ad6fd345 100644 --- a/model/src/w3sbt9md.F90 +++ b/model/src/w3sbt9md.F90 @@ -1,5 +1,27 @@ +!> @file +!> @brief Contains routines for computing dissipation by viscous fluid mud using +!> Ng (2000). +!> +!> @author M. Orzech +!> @author W. E. Rogers +!> @date 21-Nov-2013 +!> + #include "w3macros.h" !/ ------------------------------------------------------------------- / +!> +!> @brief Contains routines for computing dissipation by viscous fluid +!> mud using Ng (2000). +!> +!> @author M. Orzech +!> @author W. E. Rogers +!> @date 21-Nov-2013 +!> +!> @copyright Copyright 2009-2022 National Weather Service (NWS), +!> National Oceanic and Atmospheric Administration. All rights +!> reserved. WAVEWATCH III is a trademark of the NWS. +!> No unauthorized use without permission. +!> MODULE W3SBT9MD !/ !/ +-----------------------------------+ @@ -78,6 +100,21 @@ MODULE W3SBT9MD !/ CONTAINS !/ ------------------------------------------------------------------- / + !> + !> @brief Compute dissipation by viscous fluid mud using Ng (2000) + !> (adapted from Erick Rogers code by Mark Orzech, NRL). + !> + !> @param[in] AC Action density. + !> @param[in] H_WDEPTH Mean water depth. + !> @param[out] S Source term (1-D version). + !> @param[out] D Diagonal term of derivative (1-D version). + !> @param[in] IX + !> @param[in] IY + !> + !> @author M. Orzech + !> @author W. E. Rogers + !> @date 21-Nov-2013 + !> SUBROUTINE W3SBT9(AC,H_WDEPTH,S,D,IX,IY) !/ !/ +-----------------------------------+ @@ -369,6 +406,26 @@ SUBROUTINE W3SBT9(AC,H_WDEPTH,S,D,IX,IY) END SUBROUTINE W3SBT9 !/ ------------------------------------------------------------------- / + !> + !> @brief Compute dissipation by viscous fluid mud using Ng (2000). + !> + !> @details Adapted from Erick Rogers code by Mark Orzech, NRL. + !> + !> @param[in] SIGMA Radian frequency (rad). + !> @param[in] H_WDEPTH Water depth, denoted "h" in Ng (m). + !> @param[in] DTILDE Normalized mud depth. + !> @param[in] ZETA The ratio of stokes' boundary layer. + !> @param[in] SBLTM Sbltm is what you get if you calculate sblt using + !> the viscosity of the mud + !> @param[in] GAMMA The gamma used in Ng page 238, density(water)/density(mud). + !> @param[in] WK Unmuddy wavenumber. + !> @param[out] WKDR Muddy wavenumber. + !> @param[out] DISS Dissipation rate. + !> + !> @author E. Rogers + !> @author M. Orzech + !> @date 21-Nov-2013 + !> SUBROUTINE NG(SIGMA,H_WDEPTH,DTILDE,ZETA,SBLTM,GAMMA,WK,WKDR,DISS) !/ !/ +-----------------------------------+ @@ -500,6 +557,17 @@ SUBROUTINE NG(SIGMA,H_WDEPTH,DTILDE,ZETA,SBLTM,GAMMA,WK,WKDR,DISS) END SUBROUTINE NG !/ ------------------------------------------------------------------- / + !> + !> @brief NA + !> + !> @param[in] KWAVE + !> @param[in] H_WDEPTH + !> @param[in] SND2 + !> @param[out] ND + !> + !> @author NA + !> @date NA + !> SUBROUTINE CALC_ND(KWAVE,H_WDEPTH,SND2,ND) !/ ------------------------------------------------------------------- / diff --git a/model/src/w3sdb1md.F90 b/model/src/w3sdb1md.F90 index af3e65c7a..34c7ec3bf 100644 --- a/model/src/w3sdb1md.F90 +++ b/model/src/w3sdb1md.F90 @@ -1,5 +1,26 @@ +!> @file +!> @brief Dummy slot for bottom friction source term. +!> +!> @author J. H. Alves +!> @author H. L. Tolman +!> @date 29-May-2009 +!> + #include "w3macros.h" !/ ------------------------------------------------------------------- / +!> +!> @brief Dummy slot for bottom friction source term. +!> +!> @author J. H. Alves +!> @author H. L. Tolman +!> @date 29-May-2009 +!> +!> +!> @copyright Copyright 2009-2022 National Weather Service (NWS), +!> National Oceanic and Atmospheric Administration. All rights +!> reserved. WAVEWATCH III is a trademark of the NWS. +!> No unauthorized use without permission. +!> MODULE W3SDB1MD !/ !/ +-----------------------------------+ @@ -50,6 +71,28 @@ MODULE W3SDB1MD !/ CONTAINS !/ ------------------------------------------------------------------- / + !> + !> @brief Compute depth-induced breaking using Battjes and Janssen bore + !> model approach. + !> + !> @details Note that the Miche criterion can influence wave growth. + !> + !> @param[in] IX Local grid number + !> @param[in] A Action density spectrum (1-D). + !> @param[inout] DEPTH Mean water depth. + !> @param[inout] EMEAN Mean wave energy. + !> @param[inout] FMEAN Mean wave frequency. + !> @param[inout] WNMEAN Mean wave number. + !> @param[in] CG + !> @param[out] LBREAK + !> @param[out] S Source term (1-D version). + !> @param[out] D Diagonal term of derivative (1-D version). + !> + !> @author J. H. Alves + !> @author H. L. Tolman + !> @author A. Roland + !> @date 08-Jun-2018 + !> SUBROUTINE W3SDB1 (IX, A, DEPTH, EMEAN, FMEAN, WNMEAN, CG, LBREAK, S, D ) !/ !/ +-----------------------------------+ @@ -189,12 +232,12 @@ SUBROUTINE W3SDB1 (IX, A, DEPTH, EMEAN, FMEAN, WNMEAN, CG, LBREAK, S, D ) ! ! 0. Initialzations ------------------------------------------------- / ! Never touch this 4 lines below ... otherwise my exceptionhandling will not work. + S = 0. + D = 0. THR = DBLE(1.E-15) IF (SUM(A) .LT. THR) RETURN - S = 0. - D = 0. IWB = 1 ! #ifdef W3_T diff --git a/model/src/w3snl1md.F90 b/model/src/w3snl1md.F90 index e21349ede..09c096d2b 100644 --- a/model/src/w3snl1md.F90 +++ b/model/src/w3snl1md.F90 @@ -28,7 +28,7 @@ MODULE W3SNL1MD !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | - !/ | Last update : 03-Sep-2012 | + !/ | Last update : 28-Feb-2023 | !/ +-----------------------------------+ !/ !/ 04-Feb-2000 : Origination. ( version 2.00 ) @@ -36,6 +36,7 @@ MODULE W3SNL1MD !/ 24-Dec-2004 : Multiple grid version. ( version 3.06 ) !/ 29-May-2009 : Preparing distribution version. ( version 3.14 ) !/ 03-Sep-2012 : Clean up of test output T0, T1 ( version 4.07 ) + !/ 28-Feb-2023 : Adds GQM separate routines ( version 7.07 ) !/ !/ Copyright 2009 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -77,8 +78,22 @@ MODULE W3SNL1MD ! !/ ------------------------------------------------------------------- / !/ + !/ PUBLIC !/ + !/ These are the arrays and variables used for GQM method + !/ + INTEGER :: NCONF + INTEGER, ALLOCATABLE :: K_IF2 (:,:,:) , K_IF3 (:,:,:) , K_1P2P(:,:,:) , & + K_1P3M(:,:,:) , K_1P2M(:,:,:) , K_1P3P(:,:,:) , & + K_1M2P(:,:,:) , K_1M3M(:,:,:) , K_1M2M(:,:,:) , & + K_1M3P(:,:,:) + INTEGER, ALLOCATABLE :: F_POIN(:) , T_POIN(:) , K_IF1(:) , K_1P(:,:) , & + K_1M(:,:) , IDCONF(:,:) + DOUBLE PRECISION, ALLOCATABLE :: F_COEF(:) , F_PROJ(:) , TB_SCA(:) , TB_V14(:) + DOUBLE PRECISION, ALLOCATABLE :: TB_V24(:,:,:) , TB_V34(:,:,:) , & + TB_TPM(:,:,:) , TB_TMP(:,:,:) , TB_FAC(:,:,:) + !/ CONTAINS !/ ------------------------------------------------------------------- / @@ -768,6 +783,1359 @@ SUBROUTINE INSNL1 ( IMOD ) !/ End of INSNL1 ----------------------------------------------------- / !/ END SUBROUTINE INSNL1 + + !/ ------------------------------------------------------------------- / + SUBROUTINE W3SNLGQM(A,CG,WN,DEPTH,TSTOTn,TSDERn) + ! This and the following routines are adapted to WW3 from TOMAWAC qnlin3.f + !*********************************************************************** + ! TOMAWAC V6P1 24/06/2011 + !*********************************************************************** + ! + !brief COMPUTES THE CONTRIBUTION OF THE NON-LINEAR INTERACTIONS + !+ SOURCE TERM BETWEEN QUADRUPLETS USING THE GQM METHOD + !+ ("GAUSSIAN QUADRATURE METHOD") PROPOSED BY LAVRENOV + !+ (2001) + !+ + !+ PROCEDURE SPECIFIC TO THE CASE WHERE THE FREQUENCIES + !+ FOLLOW A GEOMETRICAL PROGRESSION AND THE DIRECTIONS + !+ ARE EVENLY DISTRIBUTED OVER [0;2.PI]. + ! + !note THIS SUBROUTINE USES THE OUTPUT FROM 'PRENL3' TO OPTIMISE + !+ THE COMPUTATIONS FOR DIA. + ! + !reference LAVRENOV, I.V. (2001): + !+ "EFFECT OF WIND WAVE PARAMETER FLUCTUATION ON THE NONLINEAR + !+ SPECTRUM EVOLUTION". J. PHYS. OCEANOGR. 31, 861-873. + ! + !history E. GAGNAIRE-RENOU + !+ 04/2011 + !+ V6P1 + !+ CREATED + ! + !history G.MATTAROLO (EDF - LNHE) + !+ 24/06/2011 + !+ V6P1 + !+ Translation of French names of the variables in argument + + ! + !/ Warning, contrary to the DIA routine, there is no extension to frequencies below IK=1 + !/ as a result the first two frequencies are not fully treated. + !================================================================================== + ! This subroutine is same as qnlin3 in TOMWAC + USE CONSTANTS, ONLY: TPI + USE W3GDATMD, ONLY: SIG, NK , NTH , DTH, XFR, FR1, GQTHRSAT, GQAMP + + IMPLICIT NONE + + REAL, intent(in) :: A(NTH,NK), CG(NK), WN(NK) + REAL, intent(in) :: DEPTH + REAL, intent(out) :: TSTOTn(NTH,NK), TSDERn(NTH,NK) + + INTEGER :: ITH,IK,NT,NF + REAL :: q_dfac, SATVAL(NK), SUME, ACCVAL, ACCMAX, AMPFAC + DOUBLE PRECISION :: RAISF, FREQ(NK) + DOUBLE PRECISION :: TSTOT(NTH,NK) , TSDER(NTH,NK), F(NTH,NK) + DOUBLE PRECISION :: TEMP + + !.....LOCAL VARIABLES + INTEGER JF , JT , JF1 , JT1 , IQ_OM2 & + , JFM0 , JFM1 , JFM2 , JFM3 , IXF1 , IXF2 & + , IXF3 , JFMIN , JFMAX , ICONF , LBUF + INTEGER KT1P , KT1M , JT1P , JT1M , KT1P2P, KT1P2M & + , KT1P3P, KT1P3M, KT1M2P, KT1M2M, KT1M3P, KT1M3M & + , JT1P2P, JT1P2M, JT1P3P, JT1P3M, JT1M2P, JT1M2M & + , JT1M3P, JT1M3M + DOUBLE PRECISION V1_4 , V2_4 , V3_4 , Q_2P3M, Q_2M3P, FACTOR & + , T_2P3M, T_2M3P, S_2P3M, S_2M3P, SCAL_T, T2P3M & + , T2M3P , SP0 , SP1P , SP1M , SP1P2P, SP1P2M & + , SP1P3P, SP1P3M, SP1M2P, SP1M2M, SP1M3P, SP1M3M & + , CF0 , CP0 , CF1 , CP1 , CF2 , CP2 & + , CF3 , CP3 , Q2PD0 , Q2PD1 , Q2PD2P, Q2PD3M & + , Q2MD0 , Q2MD1 , Q2MD2M, Q2MD3P ,AUX00 , AUX01 & + , AUX02 , AUX03 , AUX04 , AUX05 , SEUIL & + , AUX06 , AUX07 , AUX08 , AUX09 , AUX10 , FSEUIL + + NT = NTH + NF = NK + LBUF = 500 + SEUIL = 0. + RAISF = XFR + + DO IK = 1,NK + FREQ(IK) = FR1*RAISF**(IK-1) + ENDDO + + DO ITH = 1,NTH + DO IK = 1,NK + ! F is the E(f,theta) spectrum ... + F(ITH,IK) = DBLE(A(ITH,IK)*SIG(IK))*DBLE(TPI)/DBLE(CG(IK)) + ENDDO + ENDDO + ! CALL INSNLGQM + ! it returns: F_POIN , T_POIN , F_COEF , F_PROJ, TB_SCA , K_IF1, K_1P, k_1M , K_IF2 + ! K_IF3, K_1P2P , K_1P3M , K_1P2M , K_1P3P , K_1M2P , K_1M3M , K_1M2M + ! K_1M3P , TB_V14 , TB_FAC , TB_V24 , TB_V34 , TB_TMP , TB_TPM , IDCONF, NCONF + !======================================================================= + ! COMPUTES THE GENERALIZED MIN AND MAX FREQUENCIES : INSTEAD OF GOING + ! FROM 1 TO NF IN FREQ(JF) FOR THE MAIN FREQUENCY, IT GOES FROM JFMIN + ! TO JFMAX + ! JFMIN IS GIVEN BY Fmin=FREQ(1) /Gamma_min + ! JFMAX IS GIVEN BY Fmax=FREQ(NF)*Gamma_max + ! TESTS HAVE SHOWN THAT IT CAN BE ASSUMED Gamma_min=1. (JFMIN=1) AND + ! Gamma_max=1.3 (JFMAX>NF) TO OBTAIN IMPROVED RESULTS + ! Note by Fabrice Ardhuin: this appears to give the difference in tail benaviour with Gerbrant's WRT + !======================================================================= + JFMIN=MAX(1-INT(LOG(1.0D0)/LOG(RAISF)),1) + JFMAX=MIN(NF+INT(LOG(1.3D0)/LOG(RAISF)),NK) + ! + !======================================================================= + ! COMPUTES THE SPECTRUM THRESHOLD VALUES (BELOW WHICH QNL4 IS NOT + ! CALCULATED). THE THRESHOLD IS SET WITHIN 0 AND 1. + ! This was commented by FA + !======================================================================= + ! AUX00=0.0D0 + ! DO JF=1,NF + ! DO JT=1,NT + ! IF (F(JT,JF).GT.AUX00) AUX00=F(JT,JF) + ! ENDDO + ! ENDDO + ! FSEUIL=AUX00*SEUIL + + TSTOT = 0. + TSDER = 0. + !======================================================================= + ACCMAX=0. + DO JF=JFMIN,JFMAX + SUME=SUM(F(:,JF))*DTH + SATVAL(JF) = SUME*FREQ(JF)**5 + ACCVAL = SUME*FREQ(JF)**4 + IF (ACCVAL.GT.ACCMAX) ACCMAX=ACCVAL + END DO + + + ! ================================================== + ! STARTS LOOP 1 OVER THE SELECTED CONFIGURATIONS + ! ================================================== + DO ICONF=1,NCONF + ! ---------selected configuration characteristics + JF1 =IDCONF(ICONF,1) + JT1 =IDCONF(ICONF,2) + IQ_OM2=IDCONF(ICONF,3) + ! + ! ---------Recovers V1**4=(f1/f0)**4 + V1_4 =TB_V14(JF1) + ! ---------Recovers the shift of the frequency index on f1 + IXF1 =K_IF1(JF1) + ! ---------Recovers the direction indexes for Delat1 + KT1P =K_1P(JT1,JF1) + KT1M =K_1M(JT1,JF1) + ! ---------Recovers V2**4=(f2/f0)**4 and V3**4=(f3/f0)**4 + V2_4 =TB_V24(IQ_OM2,JT1,JF1) + V3_4 =TB_V34(IQ_OM2,JT1,JF1) + ! ---------Recovers the frequency indexes shift on f2 and f3 + IXF2 =K_IF2 (IQ_OM2,JT1,JF1) + IXF3 =K_IF3 (IQ_OM2,JT1,JF1) + ! ---------Recovers the direction indexes shift + KT1P2P=K_1P2P(IQ_OM2,JT1,JF1) + KT1P2M=K_1P2M(IQ_OM2,JT1,JF1) + KT1P3P=K_1P3P(IQ_OM2,JT1,JF1) + KT1P3M=K_1P3M(IQ_OM2,JT1,JF1) + KT1M2P=K_1M2P(IQ_OM2,JT1,JF1) + KT1M2M=K_1M2M(IQ_OM2,JT1,JF1) + KT1M3P=K_1M3P(IQ_OM2,JT1,JF1) + KT1M3M=K_1M3M(IQ_OM2,JT1,JF1) + ! ---------Recovers the coupling coefficients + T2P3M =TB_TPM(IQ_OM2,JT1,JF1) + T2M3P =TB_TMP(IQ_OM2,JT1,JF1) + ! ---------Recovers the multiplicative factor of QNL4 + FACTOR=TB_FAC(IQ_OM2,JT1,JF1) + + ! = = = = = = = = = = = = = = = = = = = = = = = = = + ! STARTS LOOP 2 OVER THE SPECTRUM FREQUENCIES + ! = = = = = = = = = = = = = = = = = = = = = = = = = + DO JF=JFMIN,JFMAX + IF (SATVAL(JF).GT.GQTHRSAT) THEN + ! + !.........Recovers the coefficient for the coupling factor + !.........Computes the coupling coefficients for the case +Delta1 (SIG=1) + SCAL_T=TB_SCA(LBUF+JF)*FACTOR + T_2P3M=T2P3M*SCAL_T + T_2M3P=T2M3P*SCAL_T + ! + !.........Frequency indexes and coefficients + JFM0=F_POIN(JF+LBUF) + CF0 =F_COEF(JF+LBUF) + CP0 =F_PROJ(JF+LBUF) + JFM1=F_POIN(JF+IXF1) + CF1 =F_COEF(JF+IXF1) + CP1 =F_PROJ(JF+IXF1) + JFM2=F_POIN(JF+IXF2) + CF2 =F_COEF(JF+IXF2) + CP2 =F_PROJ(JF+IXF2) + JFM3=F_POIN(JF+IXF3) + CF3 =F_COEF(JF+IXF3) + CP3 =F_PROJ(JF+IXF3) + ! + ! ------------------------------------------------- + ! STARTS LOOP 3 OVER THE SPECTRUM DIRECTIONS + ! ------------------------------------------------- + DO JT=1,NT + ! + !...........Direction indexes + ! direct config (+delta1) (sig =1) + JT1P =T_POIN(JT+KT1P) + JT1P2P=T_POIN(JT+KT1P2P) + JT1P2M=T_POIN(JT+KT1P2M) + JT1P3P=T_POIN(JT+KT1P3P) + JT1P3M=T_POIN(JT+KT1P3M) + ! image config (-delta1) + JT1M =T_POIN(JT+KT1M) + JT1M2P=T_POIN(JT+KT1M2P) + JT1M2M=T_POIN(JT+KT1M2M) + JT1M3P=T_POIN(JT+KT1M3P) + JT1M3M=T_POIN(JT+KT1M3M) + ! + ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + ! STARTS LOOP 4 OVER THE MESH NODES + ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + ! + SP0=F(JT,JFM0)*CF0 + ! + ! IF (SP0.GT.FSEUIL) THEN + ! + ! Config. +Delta1 (SIG=1) + ! ======================= + !...............Computes the spectrum values in 1, 2, 3 + SP1P =F(JT1P ,JFM1)*CF1 + SP1P2P=F(JT1P2P,JFM2)*CF2 + SP1P3M=F(JT1P3M,JFM3)*CF3 + SP1P2M=F(JT1P2M,JFM2)*CF2 + SP1P3P=F(JT1P3P,JFM3)*CF3 + ! + !...............Computes auxiliary products and variables + AUX01=SP0*V1_4+SP1P + AUX02=SP0*SP1P + AUX03=SP1P2P*SP1P3M + AUX04=SP1P2P*V3_4+SP1P3M*V2_4 + AUX05=SP1P2M*SP1P3P + AUX06=SP1P2M*V3_4+SP1P3P*V2_4 + AUX07=AUX02*V3_4 + AUX08=AUX02*V2_4 + ! + !...............Computes the components of the transfer term + S_2P3M=AUX03*AUX01-AUX02*AUX04 + S_2M3P=AUX05*AUX01-AUX02*AUX06 + Q_2P3M=T_2P3M*S_2P3M + Q_2M3P=T_2M3P*S_2M3P + AUX00 =Q_2P3M+Q_2M3P + ! + !...............Computes the components of the derived terms (dQ/dF) + Q2PD0 =T_2P3M*(AUX03*V1_4 - SP1P*AUX04)*CF0 + Q2PD1 =T_2P3M*(AUX03 - SP0 *AUX04)*CF1 + Q2PD2P=T_2P3M*(AUX01*SP1P3M - AUX07 )*CF2 + Q2PD3M=T_2P3M*(AUX01*SP1P2P - AUX08 )*CF3 + Q2MD0 =T_2M3P*(AUX05*V1_4 - SP1P*AUX06)*CF0 + Q2MD1 =T_2M3P*(AUX03 - SP0 *AUX06)*CF1 + Q2MD2M=T_2M3P*(AUX01*SP1P3P - AUX07 )*CF2 + Q2MD3P=T_2M3P*(AUX01*SP1P2M - AUX08 )*CF3 + AUX09=Q2PD0+Q2MD0 + AUX10=Q2PD1+Q2MD1 + ! + !...............Sum of Qnl4 term in the table TSTOT + TSTOT(JT,JFM0 )=TSTOT(JT,JFM0 )+AUX00 *CP0 + TSTOT(JT1P,JFM1 )=TSTOT(JT1P,JFM1 )+AUX00 *CP1 + TSTOT(JT1P2P,JFM2)=TSTOT(JT1P2P,JFM2)-Q_2P3M*CP2 + TSTOT(JT1P2M,JFM2)=TSTOT(JT1P2M,JFM2)-Q_2M3P*CP2 + TSTOT(JT1P3M,JFM3)=TSTOT(JT1P3M,JFM3)-Q_2P3M*CP3 + TSTOT(JT1P3P,JFM3)=TSTOT(JT1P3P,JFM3)-Q_2M3P*CP3 + ! + !...............Sum of the term dQnl4/dF in the table TSDER + TSDER(JT,JFM0)=TSDER(JT,JFM0)+AUX09 *CP0 + TSDER(JT1P,JFM1)=TSDER(JT1P,JFM1)+AUX10 *CP1 + TSDER(JT1P2P,JFM2)=TSDER(JT1P2P,JFM2)-Q2PD2P*CP2 + TSDER(JT1P2M,JFM2)=TSDER(JT1P2M,JFM2)-Q2MD2M*CP2 + TSDER(JT1P3M,JFM3)=TSDER(JT1P3M,JFM3)-Q2PD3M*CP3 + TSDER(JT1P3P,JFM3)=TSDER(JT1P3P,JFM3)-Q2MD3P*CP3 +#ifdef W3_TGQM + ! Test output to set up triplet method ... + WRITE(994,'(5I3,3E12.3)') ICONF,JF,JT,JT, JFM0,AUX00 *CP0, F(JT,JFM0),TSTOT(JT ,JFM0) + WRITE(994,'(5I3,3E12.3)') ICONF,JF,JT,JT1P, JFM1,AUX00 *CP1, F(JT1P,JFM1),TSTOT(JT1P,JFM1) + WRITE(994,'(5I3,3E12.3)') ICONF,JF,JT,JT1P2P,JFM2,-Q_2P3M*CP2,F(JT1P2P,JFM2),TSTOT(JT1P2P,JFM2) + WRITE(994,'(5I3,3E12.3)') ICONF,JF,JT,JT1P2M,JFM2,-Q_2M3P*CP2,F(JT1P2M,JFM2),TSTOT(JT1P2M,JFM2) + WRITE(994,'(5I3,3E12.3)') ICONF,JF,JT,JT1P3M,JFM2,-Q_2P3M*CP3,F(JT1P3M,JFM3),TSTOT(JT1P3M,JFM3) + WRITE(994,'(5I3,3E12.3)') ICONF,JF,JT,JT1P3P,JFM2,-Q_2M3P*CP3,F(JT1P3P,JFM3),TSTOT(JT1P3P,JFM3) + TEMP=(TB_TPM(IQ_OM2,JT1,JF1)*(( F(JT1P2P,JFM2)*CF2 *F(JT1P3M,JFM3)*CF3)* & + (F(JT,JFM0 )*CF0*TB_V14(JF1)+F(JT1P ,JFM1)*CF1) & + -SP0*SP1P*(SP1P2P*V3_4+SP1P3M*V2_4))+T_2M3P*(AUX05*AUX01-AUX02*AUX06)) *CP0 + WRITE(995,'(3I3,3E12.3)') ICONF,JF,JT, F(JT,JFM0) + TEMP=(Q_2P3M+Q_2M3P) *CP1 + WRITE(995,'(5I3,3E12.3)') ICONF,JF,JT,JT1P, JFM1,AUX00 *CP1, F(JT1P,JFM1),TSTOT(JT1P,JFM1) + WRITE(995,'(5I3,3E12.3)') ICONF,JF,JT,JT1P2P,JFM2,-Q_2P3M*CP2,F(JT1P2P,JFM2),TSTOT(JT1P2P,JFM2) + WRITE(995,'(5I3,3E12.3)') ICONF,JF,JT,JT1P2M,JFM2,-Q_2M3P*CP2,F(JT1P2M,JFM2),TSTOT(JT1P2M,JFM2) + WRITE(995,'(5I3,3E12.3)') ICONF,JF,JT,JT1P3M,JFM2,-Q_2P3M*CP3,F(JT1P3M,JFM3),TSTOT(JT1P3M,JFM3) + WRITE(995,'(5I3,3E12.3)') ICONF,JF,JT,JT1P3P,JFM2,-Q_2M3P*CP3,F(JT1P3P,JFM3),TSTOT(JT1P3P,JFM3) +#endif + ! + ! Config. -Delta1 (SIG=-1) + ! ======================== + !...............Computes the spectrum values in 1, 2, 3 + SP1M =F(JT1M ,JFM1)*CF1 + SP1M2P=F(JT1M2P,JFM2)*CF2 + SP1M3M=F(JT1M3M,JFM3)*CF3 + SP1M2M=F(JT1M2M,JFM2)*CF2 + SP1M3P=F(JT1M3P,JFM3)*CF3 + ! + !...............Computes auxiliary products and variables + AUX01=SP0*V1_4+SP1M + AUX02=SP0*SP1M + AUX03=SP1M2P*SP1M3M + AUX04=SP1M2P*V3_4+SP1M3M*V2_4 + AUX05=SP1M2M*SP1M3P + AUX06=SP1M2M*V3_4+SP1M3P*V2_4 + AUX07=AUX02*V3_4 + AUX08=AUX02*V2_4 + ! + !...............Computes the transfer term components + S_2P3M=AUX03*AUX01-AUX02*AUX04 + S_2M3P=AUX05*AUX01-AUX02*AUX06 + Q_2P3M=T_2M3P*S_2P3M + Q_2M3P=T_2P3M*S_2M3P + AUX00 =Q_2P3M+Q_2M3P ! Same as in +Delta1, can be commented out + ! + !...............Computes the derived terms components (dQ/dF) + Q2PD0 =T_2P3M*(AUX03*V1_4 - SP1M*AUX04)*CF0 + Q2PD1 =T_2P3M*(AUX03 - SP0 *AUX04)*CF1 + Q2PD2P=T_2P3M*(AUX01*SP1M3M - AUX07 )*CF2 + Q2PD3M=T_2P3M*(AUX01*SP1M2P - AUX08 )*CF3 + Q2MD0 =T_2M3P*(AUX05*V1_4 - SP1M*AUX06)*CF0 + Q2MD1 =T_2M3P*(AUX03 - SP0 *AUX06)*CF1 + Q2MD2M=T_2M3P*(AUX01*SP1M3P - AUX07 )*CF2 + Q2MD3P=T_2M3P*(AUX01*SP1M2M - AUX08 )*CF3 + AUX09=Q2PD0+Q2MD0 + AUX10=Q2PD1+Q2MD1 + ! + !...............Sum of Qnl4 term in the table TSTOT + TSTOT(JT ,JFM0)=TSTOT(JT ,JFM0)+AUX00 *CP0 + TSTOT(JT1M ,JFM1)=TSTOT(JT1M ,JFM1)+AUX00 *CP1 + TSTOT(JT1M2P,JFM2)=TSTOT(JT1M2P,JFM2)-Q_2P3M*CP2 + TSTOT(JT1M2M,JFM2)=TSTOT(JT1M2M,JFM2)-Q_2M3P*CP2 + TSTOT(JT1M3M,JFM3)=TSTOT(JT1M3M,JFM3)-Q_2P3M*CP3 + TSTOT(JT1M3P,JFM3)=TSTOT(JT1M3P,JFM3)-Q_2M3P*CP3 + ! + !...............Sum of the term dQnl4/dF in the table TSDER + TSDER(JT ,JFM0)=TSDER(JT ,JFM0)+AUX09 *CP0 + TSDER(JT1M ,JFM1)=TSDER(JT1M ,JFM1)+AUX10 *CP1 + TSDER(JT1M2P,JFM2)=TSDER(JT1M2P,JFM2)-Q2PD2P*CP2 + TSDER(JT1M2M,JFM2)=TSDER(JT1M2M,JFM2)-Q2MD2M*CP2 + TSDER(JT1M3M,JFM3)=TSDER(JT1M3M,JFM3)-Q2PD3M*CP3 + TSDER(JT1M3P,JFM3)=TSDER(JT1M3P,JFM3)-Q2MD3P*CP3 + ! +#ifdef W3_TGQM + WRITE(994,'(5I3,3E12.3)') ICONF,JF,JT,JT, JFM0,AUX00 *CP0, F(JT,JFM0),TSTOT(JT ,JFM0) + WRITE(994,'(5I3,3E12.3)') ICONF,JF,JT,JT1M, JFM1,AUX00 *CP1, F(JT1M,JFM1),TSTOT(JT1M,JFM1) + WRITE(994,'(5I3,3E12.3)') ICONF,JF,JT,JT1M2P,JFM2,-Q_2P3M*CP2,F(JT1M2P,JFM2),TSTOT(JT1M2P,JFM2) + WRITE(994,'(5I3,3E12.3)') ICONF,JF,JT,JT1M2M,JFM2,-Q_2M3P*CP2,F(JT1M2M,JFM2),TSTOT(JT1M2M,JFM2) + WRITE(994,'(5I3,3E12.3)') ICONF,JF,JT,JT1M3M,JFM2,-Q_2P3M*CP3,F(JT1M3M,JFM3),TSTOT(JT1M3M,JFM3) + WRITE(994,'(5I3,3E12.3)') ICONF,JF,JT,JT1M3P,JFM2,-Q_2M3P*CP3,F(JT1M3P,JFM3),TSTOT(JT1M3P,JFM3) +#endif + ! + ! ENDIF ! this was the test on SEUIL + ! + ENDDO + ! ------------------------------------------------- + ! END OF LOOP 3 OVER THE SPECTRUM DIRECTIONS + ! ------------------------------------------------- + ! + ENDIF ! End of test on saturation level + ENDDO + ! = = = = = = = = = = = = = = = = = = = = = = = = = + ! END OF LOOP 2 OVER THE SPECTRUM FREQUENCIES + ! = = = = = = = = = = = = = = = = = = = = = = = = = + ! + ENDDO + ! ================================================== + ! END OF LOOP 1 OVER THE SELECTED CONFIGURATIONS + ! ================================================== + ! Applying WAM DEPTH SCALING ! to be added later ... + ! CALL q_dscale(F,WN,SIG,DTH,NK,NTH,DEPTH,q_dfac) + q_dfac=1 + + ! Amplification inspired by Lavrenov 2001, eq 10. + AMPFAC=GQAMP(4)*MIN(MAX(ACCMAX/GQAMP(2),1.)**GQAMP(1),GQAMP(3)) + !WRITE(991,*) ACCMAX,q_dfac,AMPFAC,GQAMP(1:3),SATVAL(10),SATVAL(30) + + ! Replacing Double Precision with Simple Real and scaling + TSTOTn = TSTOT*q_dfac*AMPFAC + TSDERn = TSDER*q_dfac*AMPFAC + + + ! Converting Snl(theta,f) to Snl(theta,k)/sigma + DO ITH = 1,NT + DO IK = 1,NF + TSTOTn(ITH,IK) = TSTOTn(ITH,IK)*CG(IK)/(TPI*SIG(IK)) + ENDDO + ENDDO + !CLOSE(994) + !STOP + END SUBROUTINE W3SNLGQM + + !/ ------------------------------------------------------------------- / + FUNCTION COUPLE(XK1 ,YK1 ,XK2 ,YK2 ,XK3 ,YK3 ,XK4 ,YK4) + !/ + !/ +-----------------------------------+ + !/ | WAVEWATCH III NOAA/NCEP | + !/ | M. Benoit & E. Gagnaire-Renou | + !/ | Last update : 20-Nov-2022 | + !/ +-----------------------------------+ + !/ + !/ 19-Nov-2022 : Transfer from TOMAWAC code ( version 7.xx ) + !/ + ! 1. Purpose : + ! + ! Computes the 4-wave coupling coefficient used in Snl4 + ! + ! 2. Method : + ! + ! Uses theoretical expression by Webb (1978) + ! + ! 3. Parameters : + ! + ! Parameter list + ! ---------------------------------------------------------------- + ! XK1 Real I x component of k1 wavenumber ... + ! ---------------------------------------------------------------- + ! + ! 5. Called by : + ! + ! Name Type Module Description + ! ---------------------------------------------------------------- + ! INNSLGQM Subr. W3SNL2 Prepares source term integration. + ! ---------------------------------------------------------------- + ! + ! 6. Error messages : + ! + ! None. + ! + ! 10. Source code : + ! + !/ ------------------------------------------------------------------- / + USE CONSTANTS, ONLY: GRAV + ! + IMPLICIT NONE + + DOUBLE PRECISION, INTENT(IN) :: XK1 , YK1 , XK2 , YK2 + DOUBLE PRECISION, INTENT(IN) :: XK3 , YK3 + DOUBLE PRECISION, INTENT(IN) :: XK4 , YK4 + DOUBLE PRECISION COUPLE + ! + !.....LOCAL VARIABLES + ! """""""""""""""""" + DOUBLE PRECISION RK1 , RK2 , RK3 , RK4 , WK1 , WK2 + DOUBLE PRECISION WK3 , WK4 , S12 , S13 , S14 , S23 + DOUBLE PRECISION S24 , S34 , W1P2 , Q12 , W1M3 , Q13 + DOUBLE PRECISION W1M4 , Q14 , DDD , COEF , DENO13, NUME13 + DOUBLE PRECISION DENO14, NUME14, ZERO, PI + + ! + PI = ACOS(-1.) + COEF=PI*GRAV*GRAV/4.D0 + ZERO=1.D-10 + ! + RK1=SQRT(XK1*XK1+YK1*YK1) + RK2=SQRT(XK2*XK2+YK2*YK2) + RK3=SQRT(XK3*XK3+YK3*YK3) + RK4=SQRT(XK4*XK4+YK4*YK4) + ! + WK1=SQRT(RK1) + WK2=SQRT(RK2) + WK3=SQRT(RK3) + WK4=SQRT(RK4) + ! + S12=XK1*XK2+YK1*YK2 + S13=XK1*XK3+YK1*YK3 + S14=XK1*XK4+YK1*YK4 + S23=XK2*XK3+YK2*YK3 + S24=XK2*XK4+YK2*YK4 + S34=XK3*XK4+YK3*YK4 + ! + W1P2=SQRT((XK1+XK2)*(XK1+XK2)+(YK1+YK2)*(YK1+YK2)) + W1M3=SQRT((XK1-XK3)*(XK1-XK3)+(YK1-YK3)*(YK1-YK3)) + W1M4=SQRT((XK1-XK4)*(XK1-XK4)+(YK1-YK4)*(YK1-YK4)) + Q12=(WK1+WK2)*(WK1+WK2) + Q13=(WK1-WK3)*(WK1-WK3) + Q14=(WK1-WK4)*(WK1-WK4) + ! + !.....COMPUTES THE D COEFFICIENT OF WEBB (1978) + ! """""""""""""""""""""""""""""""""""""" + DDD=2.00D0*Q12*(RK1*RK2-S12)*(RK3*RK4-S34)/(W1P2-Q12) & + +0.50D0*(S12*S34+S13*S24+S14*S23) & + +0.25D0*(S13+S24)*Q13*Q13 & + -0.25D0*(S12+S34)*Q12*Q12 & + +0.25D0*(S14+S23)*Q14*Q14 & + +2.50D0*RK1*RK2*RK3*RK4 & + +Q12*Q13*Q14*(RK1+RK2+RK3+RK4) + + DENO13=W1M3-Q13 + NUME13=2.00D0*Q13*(RK1*RK3+S13)*(RK2*RK4+S24) + IF (ABS(DENO13).LT.ZERO) THEN + IF (ABS(NUME13).LT.ZERO) THEN + WRITE(*,*) 'W3SNL2 error for coupling coefficient : (1-3) 0/0 !' + ELSE + WRITE(*,*) 'W3SNL2 error for coupling coefficient : (1-3) inifinte value' + ENDIF + WRITE(*,*) 'W3SNL2 error for coupling coefficient : (1-3) term not used' + ELSE + DDD=DDD+NUME13/DENO13 + ENDIF + DENO14=W1M4-Q14 + NUME14=2.00D0*Q14*(RK1*RK4+S14)*(RK2*RK3+S23) + IF (ABS(DENO14).LT.ZERO) THEN + IF (ABS(NUME14).LT.ZERO) THEN + WRITE(*,*) 'W3SNL2 error for coupling coefficient : (1-4) 0/0 !' + ELSE + WRITE(*,*) 'W3SNL2 error for coupling coefficient : (1-4) inifinte value' + ENDIF + WRITE(*,*) 'W3SNL2 error for coupling coefficient : (1-4) term not used' + ELSE + DDD=DDD+NUME14/DENO14 + ENDIF + + COUPLE=COEF*DDD*DDD/(WK1*WK2*WK3*WK4) + ! RETURN + END FUNCTION COUPLE + + !/ ------------------------------------------------------------------- / + SUBROUTINE GAULEG (W_LEG ,X_LEG ,NPOIN) + !/ ------------------------------------------------------------------- / + !.....VARIABLES IN ARGUMENT + ! """""""""""""""""""" + IMPLICIT NONE + INTEGER , INTENT(IN) :: NPOIN + DOUBLE PRECISION ,INTENT(INOUT) :: W_LEG(NPOIN) , X_LEG(NPOIN) + ! + !.....LOCAL VARIABLES + ! """"""""""""""""" + INTEGER I, M, J + DOUBLE PRECISION EPS, Z, P1, P2, P3, PP, Z1, PI + PARAMETER (EPS=3.D-14) + ! + PI = ACOS(-1.) + M=(NPOIN+1)/2 + DO I=1,M + Z=COS(PI*(DBLE(I)-0.25D0)/(DBLE(NPOIN)+0.5D0)) +1 CONTINUE + P1=1.0D0 + P2=0.0D0 + DO J=1,NPOIN + P3=P2 + P2=P1 + P1=((2.D0*DBLE(J)-1.D0)*Z*P2-(DBLE(J)-1.D0)*P3)/DBLE(J) + ENDDO + PP=DBLE(NPOIN)*(Z*P1-P2)/(Z*Z-1.D0) + Z1=Z + Z=Z-P1/PP + IF (ABS(Z-Z1).GT.EPS) GOTO 1 + X_LEG(I)=-Z + X_LEG(NPOIN+1-I)=Z + W_LEG(I)=2.D0/((1.D0-Z**2)*PP**2) + W_LEG(NPOIN+1-I)=W_LEG(I) + ENDDO + END SUBROUTINE GAULEG + + !/ ------------------------------------------------------------------- / + SUBROUTINE F1F1F1(F1SF,NF1,IQ_OM1) + ! TOMAWAC V6P3 15/06/2011 + !*********************************************************************** + ! + !brief SUBROUTINE CALLED BY PRENL3 + !+ COMPUTES VALUES OF RATIO F1/F AS FUNCTION OF THE IQ_OM1 + !+ INDICATOR + ! + !history E. GAGNAIRE-RENOU + !+ 04/2011 + !+ V6P1 + !+ CREATED + ! + !history G.MATTAROLO (EDF - LNHE) + !+ 15/06/2011 + !+ V6P1 + !+ Translation of French names of the variables in argument + ! + !history E. GAGNAIRE-RENOU + !+ 12/03/2013 + !+ V6P3 + !+ Better formatted: WRITE(LU,*), etc. + !/ ------------------------------------------------------------------- / + IMPLICIT NONE + INTEGER, INTENT(IN) :: IQ_OM1 + INTEGER, INTENT(INOUT) :: NF1 + DOUBLE PRECISION, INTENT(INOUT) :: F1SF(*) + ! + INTEGER I,M + DOUBLE PRECISION RAISON + ! + IF(IQ_OM1.EQ.1) THEN + IF(NF1.NE.14) THEN + WRITE(*,*) '#1 Incorrect value for NF1',NF1 + ENDIF + F1SF( 1)=0.30D0 + F1SF( 2)=0.40D0 + F1SF( 3)=0.50D0 + F1SF( 4)=0.60D0 + F1SF( 5)=0.70D0 + F1SF( 6)=0.80D0 + F1SF( 7)=0.90D0 + F1SF( 8)=1.00D0 + F1SF( 9)=1.11D0 + F1SF(10)=1.25D0 + F1SF(11)=1.42D0 + F1SF(12)=1.67D0 + F1SF(13)=2.00D0 + F1SF(14)=2.50D0 + F1SF(15)=3.30D0 + ELSEIF(IQ_OM1.EQ.2) THEN + IF (NF1.NE.26) THEN + WRITE(*,*) '#2 Incorrect value for NF1', NF1 + ENDIF + F1SF( 1)=0.32D0 + F1SF( 2)=0.35D0 + F1SF( 3)=0.39D0 + F1SF( 4)=0.44D0 + F1SF( 5)=0.50D0 + F1SF( 6)=0.56D0 + F1SF( 7)=0.63D0 + F1SF( 8)=0.70D0 + F1SF( 9)=0.78D0 + F1SF(10)=0.86D0 + F1SF(11)=0.92D0 + F1SF(12)=0.97D0 + F1SF(13)=1.00D0 + F1SF(14)=1.03D0 + F1SF(15)=1.08D0 + F1SF(16)=1.13D0 + F1SF(17)=1.20D0 + F1SF(18)=1.28D0 + F1SF(19)=1.37D0 + F1SF(20)=1.48D0 + F1SF(21)=1.50D0 + F1SF(22)=1.65D0 + F1SF(23)=1.85D0 + F1SF(24)=2.10D0 + F1SF(25)=2.40D0 + F1SF(26)=2.70D0 + F1SF(27)=3.20D0 + ELSEIF(IQ_OM1.EQ.3) THEN + IF(NF1.NE.11) THEN + WRITE(*,*) 'Incorrect value for NF1', NF1 + ENDIF + F1SF( 1)=0.30D0 + F1SF( 2)=0.48D0 + F1SF( 3)=0.64D0 + F1SF( 4)=0.78D0 + F1SF( 5)=0.90D0 + F1SF( 6)=1.00D0 + F1SF( 7)=1.12D0 + F1SF( 8)=1.28D0 + F1SF( 9)=1.50D0 + F1SF(10)=1.80D0 + F1SF(11)=2.40D0 + F1SF(12)=3.40D0 + ELSEIF(IQ_OM1.EQ.4) THEN + IF(NF1.NE.40) THEN + WRITE(*,*) 'Incorrect value for NF1', NF1 + ENDIF + NF1=20 + M=10 + RAISON=9.D0**(1.D0/DBLE(NF1)) + F1SF(M+1)=1.0D0/3.0D0 + NF1=2*M+NF1 + DO I=M+2,NF1+1 + F1SF(I)=F1SF(I-1)*RAISON + ENDDO + DO I=M,1,-1 + F1SF(I)=F1SF(I+1)/RAISON + ENDDO + ELSEIF(IQ_OM1.EQ.5) THEN + RAISON=9.D0**(1.D0/DBLE(NF1)) + F1SF(1)=1.D0/3.D0 + DO I=2,NF1+1 + F1SF(I)=F1SF(I-1)*RAISON + ENDDO + ELSEIF(IQ_OM1.EQ.6) THEN + RAISON=(3.D0-1.D0/3.D0)/DBLE(NF1) + F1SF(1)=1.D0/3.D0 + DO I=2,NF1+1 + F1SF(I)=F1SF(I-1)+RAISON + ENDDO + ELSEIF(IQ_OM1.EQ.7) THEN + IF(NF1.NE.20) THEN + WRITE(*,*) 'Incorrect value for NF1', NF1 + ENDIF + F1SF( 1)=1.D0/3.D0 + F1SF( 2)=0.40D0 + F1SF( 3)=0.46D0 + F1SF( 4)=0.52D0 + F1SF( 5)=0.60D0 + F1SF( 6)=0.70D0 + F1SF( 7)=0.79D0 + F1SF( 8)=0.86D0 + F1SF( 9)=0.92D0 + F1SF(10)=0.97D0 + F1SF(11)=1.00D0 + F1SF(12)=1.04D0 + F1SF(13)=1.10D0 + F1SF(14)=1.18D0 + F1SF(15)=1.28D0 + F1SF(16)=1.42D0 + F1SF(17)=1.60D0 + F1SF(18)=1.84D0 + F1SF(19)=2.14D0 + F1SF(20)=2.52D0 + F1SF(21)=3.00D0 + ENDIF + ! + END SUBROUTINE F1F1F1 + !/ ------------------------------------------------------------------- / + SUBROUTINE INSNLGQM + !/ + !/ +-----------------------------------+ + !/ | WAVEWATCH III NOAA/NCEP | + !/ | E. Gagnaire-Renou & | + !/ | M. Benoit | + !/ | S. Mostafa Siadatamousavi | + !/ | M. Beyramzadeh | + !/ | FORTRAN 90 | + !/ | Last update : 20-Nov-2022 | + !/ +-----------------------------------+ + !/ + !/ 20-Nov-2022 : Merging with NL2 in WW3. ( version 7.00 ) + !/ + ! 1. Purpose : + ! + ! Preprocessing for nonlinear interactions (Xnl). + ! + ! 2. Method : + ! + ! See Xnl documentation. + ! + ! 3. Parameters : + ! + ! 4. Subroutines used : + ! + ! Name Type Module Description + ! ---------------------------------------------------------------- + ! STRACE Subr. W3SERVMD Subroutine tracing. + ! Subr. GAULEG Gauss-Legendre weights + ! xnl_init Subr. m_constants Xnl initialization routine. + ! ---------------------------------------------------------------- + ! + ! 5. Called by : + ! + ! Name Type Module Description + ! ---------------------------------------------------------------- + ! W3IOGR Subr. W3IOGRMD Model definition file management. + ! ---------------------------------------------------------------- + ! + ! 6. Error messages : + ! + ! 7. Remarks : + ! + ! 8. Structure : + ! + ! - See source code. + ! + ! 9. Switches : + ! + ! !/S Enable subroutine tracing. + ! + ! 10. Source code : + ! + !/ ------------------------------------------------------------------- / + USE CONSTANTS, ONLY: GRAV + USE W3GDATMD, ONLY: NK , NTH , XFR , FR1, GQNF1, GQNT1, GQNQ_OM2, NLTAIL, GQTHRCOU + +#ifdef W3_S + CALL STRACE (IENT, 'INSNLGQM') +#endif + IMPLICIT NONE + !.....LOCAL VARIABLES + INTEGER JF , JT , JF1 , JT1 , NF1P1 , IAUX , NT , NF , IK + INTEGER IQ_TE1 , IQ_OM2 , LBUF , DIMBUF , IQ_OM1 , NQ_TE1 , NCONFM + + DOUBLE PRECISION EPSI_A, AUX , CCC , DENO , AAA , DP2SG , TAILF + DOUBLE PRECISION V1 , V1_4 , DV1 , DTETAR , ELIM , RAISF + DOUBLE PRECISION V2 , V2_4 , V3 , V3_4 + DOUBLE PRECISION W2 , W2_M , W2_1 , W_MIL , W_RAD + DOUBLE PRECISION RK0 , XK0 , YK0 , RK1 , XK1 , YK1 + DOUBLE PRECISION RK2 , XK2P , YK2P , XK2M , YK2M + DOUBLE PRECISION RK3 , XK3P , YK3P , XK3M , YK3M + DOUBLE PRECISION D01P , C_D01P, S_D01P, D0AP , C_D0AP, S_D0AP + DOUBLE PRECISION GA2P , C_GA2P, S_GA2P, GA3P , C_GA3P, S_GA3P, TWOPI, PI, SEUIL1 , SEUIL2 , SEUIL + ! + !.....Variables related to the Gaussian quadratures + DOUBLE PRECISION W_CHE_TE1, W_CHE_OM2, C_LEG_OM2 + ! + !.....Variables related to the configuration selection + DOUBLE PRECISION TEST1 , TEST2 + DOUBLE PRECISION :: FREQ(NK) + DOUBLE PRECISION, ALLOCATABLE :: F1SF(:) , X_CHE_TE1(:) , X_CHE_OM2(:) , X_LEG_OM2(:) , W_LEG_OM2(:) & + , MAXCLA(:) + + PI = Acos(-1.) + LBUF = 500 + DIMBUF = 2*LBUF+200 + TWOPI = 2.*PI + ! + ! Defines some threshold values for filtering (See Gagnaire-Renou Thesis, p 52) + ! + SEUIL1 = 1E10 + SEUIL2 = GQTHRCOU + + IF(GQNF1.EQ.14) IQ_OM1=1 + IF(GQNF1.EQ.26) IQ_OM1=2 + IF(GQNF1.EQ.11) IQ_OM1=3 + IF(GQNF1.EQ.40) IQ_OM1=4 + IF(GQNF1.EQ.11) IQ_OM1=3 + IF(GQNF1.EQ.40) IQ_OM1=4 + IF(GQNF1.EQ.20) IQ_OM1=7 + ! + ! Note by FA: not sure what the 5 and 6 cases correspond to + ! + NQ_TE1 = GQNT1/2 + NCONFM = GQNF1*GQNT1*GQNQ_OM2 + + RAISF = XFR + NT = NTH + NF = NK + DTETAR = TWOPI/DBLE(NT) + + DO IK = 1,NK + FREQ(IK) = FR1*RAISF**(IK-1) + ENDDO + + TAILF = -NLTAIL + + !===============ALLOCATE MATRICES============================================= + if (Allocated(K_IF2) ) then + deallocate(K_IF2) + endif + ALLOCATE(K_IF2(GQNQ_OM2,GQNT1,GQNF1)) + + if (Allocated(K_IF3) ) then + deallocate(K_IF3) + endif + ALLOCATE(K_IF3(GQNQ_OM2,GQNT1,GQNF1)) + + if (Allocated(K_1P2P) ) then + deallocate(K_1P2P) + endif + ALLOCATE(K_1P2P(GQNQ_OM2,GQNT1,GQNF1)) + + if (Allocated(K_1P3M) ) then + deallocate(K_1P3M) + endif + ALLOCATE(K_1P3M(GQNQ_OM2,GQNT1,GQNF1)) + + if (Allocated(K_1P2M) ) then + deallocate(K_1P2M) + endif + ALLOCATE(K_1P2M(GQNQ_OM2,GQNT1,GQNF1)) + + if (Allocated(K_1P3P) ) then + deallocate(K_1P3P) + endif + ALLOCATE(K_1P3P(GQNQ_OM2,GQNT1,GQNF1)) + + if (Allocated(K_1M2P) ) then + deallocate(K_1M2P) + endif + ALLOCATE(K_1M2P(GQNQ_OM2,GQNT1,GQNF1)) + + if (Allocated(K_1M3M) ) then + deallocate(K_1M3M) + endif + ALLOCATE(K_1M3M(GQNQ_OM2,GQNT1,GQNF1)) + + if (Allocated(K_1M2M) ) then + deallocate(K_1M2M) + endif + ALLOCATE(K_1M2M(GQNQ_OM2,GQNT1,GQNF1)) + + if (Allocated(K_1M3P) ) then + deallocate(K_1M3P) + endif + ALLOCATE(K_1M3P(GQNQ_OM2,GQNT1,GQNF1)) + + if (Allocated(TB_V24) ) then + deallocate(TB_V24) + endif + ALLOCATE(TB_V24(GQNQ_OM2,GQNT1,GQNF1)) + + if (Allocated(TB_V34) ) then + deallocate(TB_V34) + endif + ALLOCATE(TB_V34(GQNQ_OM2,GQNT1,GQNF1)) + + if (Allocated(TB_TPM) ) then + deallocate(TB_TPM) + endif + ALLOCATE(TB_TPM(GQNQ_OM2,GQNT1,GQNF1)) + + if (Allocated(TB_TMP) ) then + deallocate(TB_TMP) + endif + ALLOCATE(TB_TMP(GQNQ_OM2,GQNT1,GQNF1)) + + if (Allocated(TB_FAC) ) then + deallocate(TB_FAC) + endif + ALLOCATE(TB_FAC(GQNQ_OM2,GQNT1,GQNF1)) + + if (Allocated(K_IF1) ) then + deallocate(K_IF1) + endif + ALLOCATE(K_IF1(GQNF1)) + + if (Allocated(K_1P) ) then + deallocate(K_1P) + endif + ALLOCATE(K_1P(GQNT1,GQNF1)) + + if (Allocated(K_1M) ) then + deallocate(K_1M) + endif + ALLOCATE(K_1M(GQNT1,GQNF1)) + + if (Allocated(TB_V14) ) then + deallocate(TB_V14) + endif + ALLOCATE(TB_V14(GQNF1)) + + if (Allocated(IDCONF) ) then + deallocate(IDCONF) + endif + ALLOCATE(IDCONF(NCONFM,3)) + + !======================================================================= + ! INITIALISATION OF AUXILIAIRY TABLES FOR SPECTRUM INTERPOLATION + !======================================================================= + if (Allocated(F_POIN) ) then + deallocate(F_POIN) + endif + ALLOCATE(F_POIN(DIMBUF)) + + if (Allocated(T_POIN) ) then + deallocate(T_POIN) + endif + ALLOCATE(T_POIN(DIMBUF)) + + if (Allocated(F_COEF) ) then + deallocate(F_COEF) + endif + ALLOCATE(F_COEF(DIMBUF)) + + if (Allocated(F_PROJ) ) then + deallocate(F_PROJ) + endif + ALLOCATE(F_PROJ(DIMBUF)) + + if (Allocated(TB_SCA) ) then + deallocate(TB_SCA) + endif + ALLOCATE(TB_SCA(DIMBUF)) + + + F_POIN(:)=0 + T_POIN(:)=0 + F_COEF(:)=0.D0 + F_PROJ(:)=0.D0 + TB_SCA(:)=0.0D0 + + DO JF=1,LBUF + F_POIN(JF)=1 + F_COEF(JF)=0.0D0 + F_PROJ(JF)=0.0D0 + ENDDO + DO JF=1,NF + IAUX=LBUF+JF + F_POIN(IAUX)=JF + F_COEF(IAUX)=1.0D0 + F_PROJ(IAUX)=1.0D0 + ENDDO + AUX=1.D0/RAISF**TAILF + DO JF=1,LBUF + IAUX=LBUF+NF+JF + F_POIN(IAUX)=NF + F_COEF(IAUX)=AUX**JF + F_PROJ(IAUX)=0.0D0 + ENDDO + ! + DO JT=LBUF,1,-1 + T_POIN(JT)=NT-MOD(LBUF-JT,NT) + ENDDO + DO JT=1,NT + T_POIN(LBUF+JT)=JT + ENDDO + DO JT=1,LBUF + T_POIN(LBUF+NT+JT)=MOD(JT-1,NT)+1 + ENDDO + !====================================================================== + ! + !======================================================================= + ! COMPUTES SCALE COEFFICIENTS FOR THE COUPLING COEFFICIENT + ! Would be easier to pass these on from W3SRCE ??? + !======================================================================= + DP2SG=TWOPI*TWOPI/GRAV + DO JF=1,LBUF + AUX=FREQ(1)/RAISF**(LBUF-JF+1) + TB_SCA(JF)=(DP2SG*AUX**2)**6/(TWOPI**3*AUX) + ENDDO + DO JF=1,NF + TB_SCA(LBUF+JF)=(DP2SG*FREQ(JF)**2)**6/(TWOPI**3*FREQ(JF)) + ENDDO + DO JF=1,LBUF + IAUX=LBUF+NF+JF + AUX=FREQ(NF)*RAISF**JF + TB_SCA(IAUX)=(DP2SG*AUX**2)**6/(TWOPI**3*AUX) + ENDDO + !======================================================================= + ! + !======================================================================= + ! COMPUTES VALUES FOR GAUSSIAN QUADRATURES + !======================================================================= + if (Allocated(X_CHE_TE1) ) then + deallocate(X_CHE_TE1) + endif + ALLOCATE(X_CHE_TE1(1:NQ_TE1),X_CHE_OM2(1:GQNQ_OM2)) + + if (Allocated(X_LEG_OM2) ) then + deallocate(X_LEG_OM2) + endif + ALLOCATE(X_LEG_OM2(1:GQNQ_OM2),W_LEG_OM2(1:GQNQ_OM2)) + ! + !.....Abscissa and weight (constant) for Gauss-Chebyshev + DO IQ_TE1=1,NQ_TE1 + X_CHE_TE1(IQ_TE1)=COS(PI*(DBLE(IQ_TE1)-0.5D0)/DBLE(NQ_TE1)) + ENDDO + W_CHE_TE1=PI/DBLE(NQ_TE1) + DO IQ_OM2=1,GQNQ_OM2 + X_CHE_OM2(IQ_OM2)=COS(PI*(DBLE(IQ_OM2)-0.5D0)/DBLE(GQNQ_OM2)) + ENDDO + W_CHE_OM2=PI/DBLE(GQNQ_OM2) + ! + !.....Abscissa et weight for Gauss-Legendre + CALL GAULEG( W_LEG_OM2 , X_LEG_OM2 , GQNQ_OM2 ) + DO IQ_OM2=1,GQNQ_OM2 + X_LEG_OM2(IQ_OM2)=0.25D0*(1.D0+X_LEG_OM2(IQ_OM2))**2 + ENDDO + !======================================================================= + ! + ! + !======================================================================= + ! COMPUTES VALUES OF RATIO F1/F AS FUNCTION OF THE IQ_OM1 INDICATOR + !======================================================================= + NF1P1=GQNF1+1 + if (Allocated(F1SF) ) then + deallocate(F1SF) + endif + ALLOCATE(F1SF(1:NF1P1)) + + CALL F1F1F1 ( F1SF , GQNF1 , IQ_OM1) + !======================================================================= + ! + ! ================================================== + ! STARTS LOOP 1 OVER THE RATIOS F1/F0 + ! ================================================== + DO JF1=1,GQNF1 + ! ---------Computes and stores v1=f1/f0 and v1**4 + V1=(F1SF(JF1+1)+F1SF(JF1))/2.D0 + K_IF1(JF1)=NINT(DBLE(LBUF)+LOG(V1)/LOG(RAISF)) + V1_4=V1**4 + TB_V14(JF1)=V1_4 + ! ---------Computes and stores dv1=df1/f0 + DV1=F1SF(JF1+1)-F1SF(JF1) + ! ---------Computes the A parameter + AAA=((1.D0+V1)**4-4.D0*(1.D0+V1_4))/(8.D0*V1**2) + ! + ! ================================================= + ! STARTS LOOP 2 OVER THE DELTA_1+ VALUES + ! ================================================= + DO JT1=1,GQNT1 + ! + !......Computes the Delta1+ values (=Theta_1-Theta_0) between 0 and Pi. + IF (JT1.LE.NQ_TE1) THEN + ! ---------First interval : X from -1 to A + IQ_TE1=JT1 + C_D01P=(-1.D0+AAA)/2.D0+(1.D0+AAA)/2.D0*X_CHE_TE1(IQ_TE1) + CCC=DV1*SQRT((AAA-C_D01P)/(1.D0-C_D01P))*W_CHE_TE1 + ELSE + ! ---------Second interval : X from A to 1 + IQ_TE1=JT1-NQ_TE1 + C_D01P=( 1.D0+AAA)/2.D0+(1.D0-AAA)/2.D0*X_CHE_TE1(IQ_TE1) + CCC=DV1*SQRT((C_D01P-AAA)/(1.D0+C_D01P))*W_CHE_TE1 + ENDIF + S_D01P=SQRT(1.D0-C_D01P*C_D01P) + D01P =ACOS(C_D01P) + K_1P(JT1,JF1)=LBUF+NINT(D01P/DTETAR) + K_1M(JT1,JF1)=LBUF-NINT(D01P/DTETAR) + ! + ! ---------Computes Epsilon_a + EPSI_A=2.D0*SQRT(1.D0+V1_4+2.D0*V1*V1*C_D01P)/(1.D0+V1)**2 + ! ---------Computes Delta_A+ and its cosinus + C_D0AP=(1.D0-V1_4+0.25D0*EPSI_A**2*(1.D0+V1)**4) & + /(EPSI_A*(1.D0+V1)**2) + S_D0AP=SQRT(1.0D0-C_D0AP*C_D0AP) + D0AP = ACOS(C_D0AP) + ! + !.......Integration over OMEGA2 depending on EPS_A + IF (EPSI_A.LT.1.D0) THEN + ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - + !........Case of a single singularity (in OMEGA2-) + ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - + W2_M=0.5D0*(1.D0-EPSI_A/2.D0) + W2_1=0.5D0 + ! + W_RAD=W2_1-W2_M + C_LEG_OM2=SQRT(W_RAD) + ! + ! ---------------------------------------------------- + !........STARTS LOOP 3 OVER OMEGA_2 (CASE Epsilon_A < 1) + !........Case of a single singularity (in OMEGA2-) + !........Integration over OMEGA2 via GAUSS-LEGENDRE quadrature + ! ---------------------------------------------------- + DO IQ_OM2=1,GQNQ_OM2 + ! ---------Computes W2, V2, and V3 + W2=W2_M+W_RAD*X_LEG_OM2(IQ_OM2) + V2=W2*(1.D0+V1) + V2_4=V2**4 + TB_V24(IQ_OM2,JT1,JF1)=V2_4 + K_IF2 (IQ_OM2,JT1,JF1) = NINT(DBLE(LBUF) & + + LOG(V2)/LOG(RAISF)) + V3=1.D0+V1-V2 + V3_4=V3**4 + TB_V34(IQ_OM2,JT1,JF1)=V3_4 + K_IF3 (IQ_OM2,JT1,JF1) = NINT(DBLE(LBUF) & + + LOG(V3)/LOG(RAISF)) + ! ---------Computes Gamma_2+ et Gamma_3+ angles + C_GA2P=(EPSI_A**2/4.D0+W2**4-(1.D0-W2)**4)/(EPSI_A*W2*W2) + C_GA2P=MAX(MIN(C_GA2P,1.D0),-1.D0) + S_GA2P=SQRT(1.D0-C_GA2P*C_GA2P) + GA2P =ACOS(C_GA2P) + C_GA3P=(EPSI_A**2/4.D0-W2**4+(1.D0-W2)**4)/EPSI_A & + /(1.D0-W2)**2 + C_GA3P=MAX(MIN(C_GA3P,1.D0),-1.D0) + S_GA3P=SQRT(1.D0-C_GA3P*C_GA3P) + GA3P =ACOS(C_GA3P) + ! Shifting of the direction indexes - Config. +Delta1 (SIG=1) + K_1P2P(IQ_OM2,JT1,JF1)=NINT(( D0AP+GA2P)/DTETAR & + +DBLE(LBUF)) + K_1P3M(IQ_OM2,JT1,JF1)=NINT(( D0AP-GA3P)/DTETAR & + +DBLE(LBUF)) + K_1P2M(IQ_OM2,JT1,JF1)=NINT(( D0AP-GA2P)/DTETAR & + +DBLE(LBUF)) + K_1P3P(IQ_OM2,JT1,JF1)=NINT(( D0AP+GA3P)/DTETAR & + +DBLE(LBUF)) + ! Shifting of the direction indexes - Config. -Delta1 (SIG=-1) + K_1M2P(IQ_OM2,JT1,JF1)=NINT((-D0AP+GA2P)/DTETAR & + +DBLE(LBUF)) + K_1M3M(IQ_OM2,JT1,JF1)=NINT((-D0AP-GA3P)/DTETAR & + +DBLE(LBUF)) + K_1M2M(IQ_OM2,JT1,JF1)=NINT((-D0AP-GA2P)/DTETAR & + +DBLE(LBUF)) + K_1M3P(IQ_OM2,JT1,JF1)=NINT((-D0AP+GA3P)/DTETAR & + +DBLE(LBUF)) + ! + !.........Computes the coupling coefficients (only for Delta_1+ ) + RK0=1.D0 + RK1=V1*V1 + RK2=V2*V2 + RK3=(1.D0+V1-V2)**2 + XK0 = RK0 + YK0 = 0.0D0 + XK1 = RK1*C_D01P + YK1 = RK1*S_D01P + XK2P = RK2*(C_D0AP*C_GA2P-S_D0AP*S_GA2P) + YK2P = RK2*(S_D0AP*C_GA2P+C_D0AP*S_GA2P) + XK2M = RK2*(C_D0AP*C_GA2P+S_D0AP*S_GA2P) + YK2M = RK2*(S_D0AP*C_GA2P-C_D0AP*S_GA2P) + XK3P = RK3*(C_D0AP*C_GA3P-S_D0AP*S_GA3P) + YK3P = RK3*(S_D0AP*C_GA3P+C_D0AP*S_GA3P) + XK3M = RK3*(C_D0AP*C_GA3P+S_D0AP*S_GA3P) + YK3M = RK3*(S_D0AP*C_GA3P-C_D0AP*S_GA3P) + TB_TPM(IQ_OM2,JT1,JF1)=COUPLE( XK0 , YK0 , XK1 , YK1 , XK2P , YK2P , XK3M , YK3M) + TB_TMP(IQ_OM2,JT1,JF1)=COUPLE( XK0 , YK0 , XK1 , YK1 , XK2M , YK2M , XK3P , YK3P) + ! + !.........Computes the multiplicative coefficient for QNL4 + DENO=2.D0*SQRT( (0.5D0*(1.D0+EPSI_A/2.D0)-W2) & + *((W2-0.5D0)**2+0.25D0*(1.D0+EPSI_A)) & + *((W2-0.5D0)**2+0.25D0*(1.D0-EPSI_A)) ) + TB_FAC(IQ_OM2,JT1,JF1)=1.D0/(DENO*V1*W2*(1.D0-W2)) & + /(1.D0+V1)**5 * W_LEG_OM2(IQ_OM2)*C_LEG_OM2* CCC + ENDDO + ! ----------------------------------------------- + !........END OF THE LOOP 3 OVER OMEGA_2 (CASE Epsilon_A < 1) + ! ----------------------------------------------- + ! + ELSE + ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - + !........STARTS LOOP 3 OVER OMEGA_2 (CASE Epsilon_A > 1) + !........Case of two singularities (in OMEGA2- and OMEGA2_1) + !........Integration over OMEGA2 via GAUSS-CHEBYSCHEV quadrature + ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - + W2_M=0.5D0*(1.D0-EPSI_A/2.D0) + W2_1=0.5D0*(1.D0-SQRT(EPSI_A-1.D0)) + ! + W_MIL=(W2_M+W2_1)/2.D0 + W_RAD=(W2_1-W2_M)/2.D0 + ! + DO IQ_OM2=1,GQNQ_OM2 + ! ---------Computes W2, V2, and V3 + W2=W_MIL+W_RAD*X_CHE_OM2(IQ_OM2) + V2=W2*(1.D0+V1) + V2_4=V2**4 + TB_V24(IQ_OM2,JT1,JF1)=V2_4 + K_IF2 (IQ_OM2,JT1,JF1)=NINT(DBLE(LBUF) & + +LOG(V2)/LOG(RAISF)) + V3=1.D0+V1-V2 + V3_4=V3**4 + TB_V34(IQ_OM2,JT1,JF1)=V3_4 + K_IF3 (IQ_OM2,JT1,JF1)=NINT(DBLE(LBUF) & + +LOG(V3)/LOG(RAISF)) + ! ---------Computes Gamma_2+ et Gamma_3+ angles + C_GA2P=(EPSI_A**2/4.D0+W2**4-(1.D0-W2)**4)/(EPSI_A*W2*W2) + C_GA2P=MAX(MIN(C_GA2P,1.D0),-1.D0) + S_GA2P=SQRT(1.D0-C_GA2P*C_GA2P) + GA2P =ACOS(C_GA2P) + C_GA3P=(EPSI_A**2/4.D0-W2**4+(1.D0-W2)**4)/EPSI_A & + /(1.D0-W2)**2 + C_GA3P=MAX(MIN(C_GA3P,1.D0),-1.D0) + S_GA3P=SQRT(1.D0-C_GA3P*C_GA3P) + GA3P =ACOS(C_GA3P) + ! Shifts the direction indexes - Config. +Delta1 (SIG=1) + K_1P2P(IQ_OM2,JT1,JF1)=NINT(( D0AP+GA2P)/DTETAR & + +DBLE(LBUF)) + K_1P3M(IQ_OM2,JT1,JF1)=NINT(( D0AP-GA3P)/DTETAR & + +DBLE(LBUF)) + K_1P2M(IQ_OM2,JT1,JF1)=NINT(( D0AP-GA2P)/DTETAR & + +DBLE(LBUF)) + K_1P3P(IQ_OM2,JT1,JF1)=NINT(( D0AP+GA3P)/DTETAR & + +DBLE(LBUF)) + ! Shifts the direction indexes - Config. -Delta1 (SIG=-1) + K_1M2P(IQ_OM2,JT1,JF1)=NINT((-D0AP+GA2P)/DTETAR & + +DBLE(LBUF)) + K_1M3M(IQ_OM2,JT1,JF1)=NINT((-D0AP-GA3P)/DTETAR & + +DBLE(LBUF)) + K_1M2M(IQ_OM2,JT1,JF1)=NINT((-D0AP-GA2P)/DTETAR & + +DBLE(LBUF)) + K_1M3P(IQ_OM2,JT1,JF1)=NINT((-D0AP+GA3P)/DTETAR & + +DBLE(LBUF)) + ! + !.........Computes the coupling coefficients (only for Delta_1+ ) + RK0=1.D0 + RK1=V1*V1 + RK2=V2*V2 + RK3=(1.D0+V1-V2)**2 + XK0 = RK0 + YK0 = 0.0D0 + XK1 = RK1*C_D01P + YK1 = RK1*S_D01P + XK2P = RK2*(C_D0AP*C_GA2P-S_D0AP*S_GA2P) + YK2P = RK2*(S_D0AP*C_GA2P+C_D0AP*S_GA2P) + XK2M = RK2*(C_D0AP*C_GA2P+S_D0AP*S_GA2P) + YK2M = RK2*(S_D0AP*C_GA2P-C_D0AP*S_GA2P) + XK3P = RK3*(C_D0AP*C_GA3P-S_D0AP*S_GA3P) + YK3P = RK3*(S_D0AP*C_GA3P+C_D0AP*S_GA3P) + XK3M = RK3*(C_D0AP*C_GA3P+S_D0AP*S_GA3P) + YK3M = RK3*(S_D0AP*C_GA3P-C_D0AP*S_GA3P) + TB_TPM(IQ_OM2,JT1,JF1)=COUPLE( XK0 , YK0 , XK1 , YK1 , XK2P , YK2P , XK3M , YK3M) + TB_TMP(IQ_OM2,JT1,JF1)=COUPLE( XK0 , YK0 , XK1 , YK1 , XK2M , YK2M , XK3P , YK3P) + ! + !.........Computes the multiplicative coefficient for QNL4 + DENO=2.D0*SQRT( (0.5D0*(1.D0+EPSI_A/2.D0)-W2) & + *((W2-0.5D0)**2+0.25D0*(1.D0+EPSI_A)) & + *(0.5D0*(1.D0+SQRT(EPSI_A-1.D0))-W2) ) + TB_FAC(IQ_OM2,JT1,JF1)=1.D0/(DENO*V1*W2*(1.D0-W2)) & + /(1.D0+V1)**5 * W_CHE_OM2* CCC + ! + ENDDO + ! ----------------------------------------------- + !........END OF LOOP 3 OVER OMEGA_2 (CASE Epsilon_A > 1) + ! ----------------------------------------------- + ! + ENDIF + ENDDO + ! ================================================= + ! END OF LOOP 2 OVER THE DELTA_1+ VALUES + ! ================================================= + ! + ENDDO + ! ================================================== + ! END OF LOOP 1 OVER THE F1/F0 RATIOS + ! ================================================== + DEALLOCATE(F1SF) + DEALLOCATE(X_CHE_TE1) + DEALLOCATE(X_CHE_OM2) + DEALLOCATE(X_LEG_OM2) + DEALLOCATE(W_LEG_OM2) + + ! =========================================================== + ! POST-PROCESSING TO ELIMINATE PART OF THE CONFIGURATIONS + ! =========================================================== + ! + !.....It looks, for every value of the ratio V1, for the maximum value + !.....of FACTOR*COUPLING : it is stored in the local table NAXCLA(.) + ! """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" + ALLOCATE(MAXCLA(1:GQNF1)) + DO JF1=1,GQNF1 + AUX=0.0D0 + DO JT1=1,GQNT1 + DO IQ_OM2=1,GQNQ_OM2 + AUX=MAX(AUX,TB_FAC(IQ_OM2,JT1,JF1)*TB_TPM(IQ_OM2,JT1,JF1),TB_FAC(IQ_OM2,JT1,JF1)*TB_TMP(IQ_OM2,JT1,JF1)) + ENDDO + ENDDO + MAXCLA(JF1)=AUX + ENDDO + ! + !.....It looks for the max V1 value + ! """""""""""""""""""""""""""""""""""""""""""""""""""""""""""" + AUX=0.0D0 + DO JF1=1,GQNF1 + IF (MAXCLA(JF1).GT.AUX) AUX=MAXCLA(JF1) + ENDDO + + TEST1=SEUIL1*AUX + ! + !.....Set to zero the coupling coefficients not used + ! """"""""""""""""""""""""""""""""""""""""""""""""""""" + NCONF=0 + DO JF1=1,GQNF1 + TEST2 =SEUIL2*MAXCLA(JF1) + DO JT1=1,GQNT1 + DO IQ_OM2=1,GQNQ_OM2 + AAA=TB_FAC(IQ_OM2,JT1,JF1)*TB_TPM(IQ_OM2,JT1,JF1) + CCC=TB_FAC(IQ_OM2,JT1,JF1)*TB_TMP(IQ_OM2,JT1,JF1) + IF ((AAA.GT.TEST1.OR.AAA.GT.TEST2).OR. & + (CCC.GT.TEST1.OR.CCC.GT.TEST2)) THEN + NCONF=NCONF+1 + IDCONF(NCONF,1)=JF1 + IDCONF(NCONF,2)=JT1 + IDCONF(NCONF,3)=IQ_OM2 + ENDIF +#ifdef W3_TGQM + WRITE(993,*) NCONF,JF1,JT1,IQ_OM2,AAA,CCC,(AAA.GT.TEST1.OR.AAA.GT.TEST2), & + (CCC.GT.TEST1.OR.CCC.GT.TEST2) +#endif + ENDDO + ENDDO + ENDDO + DEALLOCATE(MAXCLA) + ! + !..... counts the fraction of the eliminated configurations + ELIM=(1.D0-DBLE(NCONF)/DBLE(NCONFM))*100.D0 +#ifdef W3_TGQM + WRITE(994,*) 'NCONF, ELIM FRACTION:',NCONF,ELIM +#endif + END SUBROUTINE INSNLGQM !/ !/ End of module W3SNL1MD -------------------------------------------- / !/ diff --git a/model/src/w3src4md.F90 b/model/src/w3src4md.F90 index e2bf12c9a..a1d4423bf 100644 --- a/model/src/w3src4md.F90 +++ b/model/src/w3src4md.F90 @@ -2520,7 +2520,7 @@ SUBROUTINE W3SDS4 (A, K, CG, USTAR, USDIR, DEPTH, DAIR, SRHS, & RETURN END IF ! - WHITECAP(1:2) = 0. + WHITECAP(1:4) = 0. ! ! precomputes integration of Lambda over direction ! times wavelength times a (a=5 in Reul&Chapron JGR 2003) times dk diff --git a/model/src/w3srcemd.F90 b/model/src/w3srcemd.F90 index 6aa708bb8..a846605d8 100644 --- a/model/src/w3srcemd.F90 +++ b/model/src/w3srcemd.F90 @@ -564,6 +564,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & #endif #ifdef W3_NL1 USE W3SNL1MD + USE W3GDATMD, ONLY: IQTPE #endif #ifdef W3_NL2 USE W3SNL2MD @@ -1215,7 +1216,11 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & ! 2.b Nonlinear interactions. ! #ifdef W3_NL1 - CALL W3SNL1 ( SPEC, CG1, WNMEAN*DEPTH, VSNL, VDNL ) + IF (IQTPE.GT.0) THEN + CALL W3SNL1 ( SPEC, CG1, WNMEAN*DEPTH, VSNL, VDNL ) + ELSE + CALL W3SNLGQM ( SPEC, CG1, WN1, DEPTH, VSNL, VDNL ) + END IF #endif #ifdef W3_NL2 CALL W3SNL2 ( SPEC, CG1, DEPTH, VSNL, VDNL ) diff --git a/model/src/w3triamd.F90 b/model/src/w3triamd.F90 index 9fac503b6..a97bed7e4 100644 --- a/model/src/w3triamd.F90 +++ b/model/src/w3triamd.F90 @@ -578,12 +578,18 @@ SUBROUTINE GET_BOUNDARY_STATUS(STATUS) !/ ! integer*2, intent(out) :: STATUS(NX) - INTEGER :: COLLECTED(NX), NEXTVERT(NX), PREVVERT(NX) + integer, allocatable :: collected(:), nextvert(:), prevvert(:) INTEGER :: ISFINISHED, INEXT, IPREV INTEGER :: IPNEXT, IPPREV, ZNEXT, IP, I, IE #ifdef W3_S CALL STRACE (IENT, 'VA_SETUP_IOBPD') #endif + allocate(collected(nx)) + allocate(nextvert(nx)) + allocate(prevvert(nx)) + nextvert = 0 + prevvert = 0 + STATUS(:) = 0 DO IE=1,NTRI DO I=1,3 @@ -650,6 +656,11 @@ SUBROUTINE GET_BOUNDARY_STATUS(STATUS) EXIT END IF END DO + + deallocate(collected) + deallocate(nextvert) + deallocate(prevvert) + END SUBROUTINE GET_BOUNDARY_STATUS !/ -------------------------------------------------------------------/ @@ -852,9 +863,10 @@ SUBROUTINE UG_GETOPENBOUNDARY(TMPSTA,ZBIN,ZLIM) !/ Local parameters !/ INTEGER :: IBC, IX - INTEGER :: MASK(NX) + integer, allocatable :: mask(:) INTEGER*2 :: STATUS(NX) ! + allocate(mask(nx)) MASK(:)=1 CALL SET_IOBP (MASK, STATUS) ! @@ -870,6 +882,8 @@ SUBROUTINE UG_GETOPENBOUNDARY(TMPSTA,ZBIN,ZLIM) IF ( (TMPSTA(1,IX).EQ.1) .AND. (STATUS(IX).EQ.0) .AND. (ZBIN(1,IX) .LT. ZLIM)) TMPSTA(1,IX) = 2 END IF END DO + + deallocate(mask) ! END SUBROUTINE UG_GETOPENBOUNDARY !/ ------------------------------------------------------------------- / @@ -964,14 +978,14 @@ SUBROUTINE SPATIAL_GRID I2 = TRIGP(2,K) I3 = TRIGP(3,K) -!AR: todo call this only for global grid +!AR: todo call this only for global grid CALL FIX_PERIODCITY(I1,I2,I3,XGRD,YGRD,PT) ! ! cross product of edge-vector (orientated anticlockwise) ! - TRIA(K) = REAL( (PT(2,2)-PT(1,2)) & - *(PT(1,1)-PT(3,1)) & - +(PT(3,2)-PT(1,2)) & + TRIA(K) = REAL( (PT(2,2)-PT(1,2)) & + *(PT(1,1)-PT(3,1)) & + +(PT(3,2)-PT(1,2)) & *(PT(2,1)-PT(1,1)) )*0.5 ! ! test on negative triangle area, which means that the orientiation is not as assumed to be anticw. @@ -1193,8 +1207,8 @@ SUBROUTINE COUNT(TRIGPTEMP) !/ ------------------------------------------------------------------- / !/ local parameter - INTEGER :: CONN(NX) - INTEGER :: COUNTER, IP, IE, I, J, N(3) + integer, allocatable :: conn(:) + INTEGER :: COUNTER, IP, IE, I, J, N(3) #ifdef W3_S INTEGER :: IENT = 0 #endif @@ -1203,7 +1217,7 @@ SUBROUTINE COUNT(TRIGPTEMP) #ifdef W3_S CALL STRACE (IENT, 'COUNT') #endif - + allocate(conn(nx)) COUNTRI=0 COUNTOT=0 CONN(:)= 0 @@ -1234,6 +1248,7 @@ SUBROUTINE COUNT(TRIGPTEMP) ENDDO COUNTOT=J + deallocate(conn) END SUBROUTINE COUNT !/---------------------------------------------------------------------------- @@ -1395,12 +1410,11 @@ SUBROUTINE AREA_SI(IMOD) INTEGER :: COUNTER,ifound,alreadyfound INTEGER :: I, J, K, II INTEGER :: IP, IE, POS, POS_I, POS_J, POS_K, IP_I, IP_J, IP_K - INTEGER :: I1, I2, I3, IP2, CHILF(NX) - INTEGER :: TMP(NX), CELLVERTEX(NX,COUNTRI,2) + INTEGER :: I1, I2, I3, IP2 INTEGER :: COUNT_MAX DOUBLE PRECISION :: TRIA03 INTEGER, ALLOCATABLE :: PTABLE(:,:) - + integer, allocatable :: cellvertex(:,:,:), tmp(:) #ifdef W3_S INTEGER :: IENT = 0 #endif @@ -1425,18 +1439,20 @@ SUBROUTINE AREA_SI(IMOD) SI(I2) = SI(I2) + TRIA03 SI(I3) = SI(I3) + TRIA03 ENDDO + allocate(cellvertex(nx,countri,2)) + allocate(tmp(nx)) CELLVERTEX(:,:,:) = 0 ! Stores for each node the Elementnumbers of the connected Elements ! and the Position of the Node in the Element Index - CHILF = 0 + tmp = 0 DO IE = 1, NTRI DO J=1,3 I = TRIGP(J,IE)!INE(J,IE) - CHILF(I) = CHILF(I)+1 - CELLVERTEX(I,CHILF(I),1) = IE - CELLVERTEX(I,CHILF(I),2) = J + TMP(I) = TMP(I)+1 + CELLVERTEX(I,TMP(I),1) = IE + CELLVERTEX(I,TMP(I),2) = J END DO ENDDO ! @@ -1454,6 +1470,7 @@ SUBROUTINE AREA_SI(IMOD) END DO INDEX_CELL(IP+1)=J+1 END DO + deallocate(cellvertex) IF (.NOT. FSNIMP) RETURN @@ -1573,6 +1590,7 @@ SUBROUTINE AREA_SI(IMOD) END DO END DO + deallocate(tmp) DEALLOCATE(PTABLE) END SUBROUTINE AREA_SI @@ -2105,9 +2123,11 @@ SUBROUTINE UG_GRADIENTS (PARAM, DIFFX, DIFFY) REAL :: DIFFXTMP, DIFFYTMP REAL :: DEDX(3), DEDY(3) REAL :: DVDXIE, DVDYIE - REAL :: WEI(NX), WEI_LOCAL(NSEAL) + REAL :: WEI_LOCAL(NSEAL) + real, allocatable :: wei(:) REAL*8 :: RTMP(NSEAL) + allocate(wei(nx)) DIFFX = 0. DIFFY = 0. ! @@ -2166,6 +2186,7 @@ SUBROUTINE UG_GRADIENTS (PARAM, DIFFX, DIFFY) CALL PDLIB_exchange1Dreal(DIFFX(1,:)) CALL PDLIB_exchange1Dreal(DIFFY(1,:)) #endif + deallocate(wei) ! END SUBROUTINE UG_GRADIENTS !/ ------------------------------------------------------------------- / @@ -2382,14 +2403,21 @@ SUBROUTINE SET_IOBP (MASK, STATUS) INTEGER, INTENT(IN) :: MASK(NX) INTEGER*2, INTENT(OUT) :: STATUS(NX) ! - INTEGER :: COLLECTED(NX), NEXTVERT(NX), PREVVERT(NX) - INTEGER :: ISFINISHED !, INEXT, IPREV - INTEGER :: INEXT(3), IPREV(3) - INTEGER :: ZNEXT, IP, I, IE, IPNEXT, IPPREV, COUNT + integer, allocatable :: collected(:), nextvert(:), prevvert(:) + INTEGER :: ISFINISHED !, INEXT, IPREV + INTEGER :: INEXT(3), IPREV(3) + INTEGER :: ZNEXT, IP, I, IE, IPNEXT, IPPREV, COUNT integer nb0, nb1, nbM1 STATUS = -1 INEXT=(/ 2, 3, 1 /) !IPREV=1+MOD(I+1,3) IPREV=(/ 3, 1, 2 /) !INEXT=1+MOD(I,3) + + allocate(collected(nx)) + allocate(nextvert(nx)) + allocate(prevvert(nx)) + nextvert = 0 + prevvert = 0 + DO IE=1,NTRI ! If one of the points of the triangle is masked out (land) then do as if triangle does not exist... ! IF ((MASK(TRIGP(1,IE)).GT.0).AND.(MASK(TRIGP(2,IE)).GT.0).AND.(MASK(TRIGP(3,IE)).GT.0)) THEN @@ -2456,6 +2484,9 @@ SUBROUTINE SET_IOBP (MASK, STATUS) STATUS = 1 CALL GET_BOUNDARY(NX, NTRI, TRIGP, STATUS, PREVVERT, NEXTVERT) + deallocate(collected) + deallocate(nextvert) + deallocate(prevvert) !#ifdef MPI_PARALL_GRID ! CALL exchange_p2di(STATUS) !#endif @@ -2796,7 +2827,7 @@ SUBROUTINE TRIANG_INDEXES(I, INEXT, IPREV) END SUBROUTINE TRIANG_INDEXES !/ ------------------------------------------------------------------- / - + !> !> @brief Redefines the values of the boundary points and angle pointers !> based on the MAPSTA array. @@ -2903,7 +2934,7 @@ SUBROUTINE SET_UG_IOBP() REAL (KIND = 8) :: DYP1, DYP2, DYP3, eDet1, eDet2, EVX, EVY REAL(KIND=8), PARAMETER :: THR = TINY(1.) INTEGER :: I1, I2, I3 - INTEGER :: ITMP(NX), NEXTVERT(NX), PREVVERT(NX) + integer, allocatable :: itmp(:), nextvert(:), prevvert(:) CHARACTER(60) :: FNAME #ifdef W3_S INTEGER, SAVE :: IENT = 0 @@ -2916,6 +2947,11 @@ SUBROUTINE SET_UG_IOBP() #ifdef W3_S CALL STRACE (IENT, 'SETUGIOBP') #endif + allocate(itmp(nx)) + allocate(nextvert(nx)) + allocate(prevvert(nx)) + nextvert = 0 + prevvert = 0 ! !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 2. Searches for boundary points @@ -3029,6 +3065,9 @@ SUBROUTINE SET_UG_IOBP() END IF END DO #endif + deallocate(itmp) + deallocate(nextvert) + deallocate(prevvert) ! ! Recomputes the angles used in the gradients estimation ! diff --git a/model/src/w3wavemd.F90 b/model/src/w3wavemd.F90 index b11aeb3b2..ef3e20d75 100644 --- a/model/src/w3wavemd.F90 +++ b/model/src/w3wavemd.F90 @@ -491,8 +491,13 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #ifdef W3_TIMINGS USE W3PARALL, only : PRINT_MY_TIME #endif - use w3iogoncdmd , only : w3iogoncd - use w3odatmd , only : histwr, rstwr, user_netcdf_grdout +#ifdef W3_PIO + use wav_restart_mod , only : write_restart + use wav_history_mod , only : write_history +#endif + use w3odatmd , only : histwr, rstwr, use_historync, use_restartnc, user_restfname + use w3odatmd , only : verboselog + use w3timemd , only : set_user_timestring ! #ifdef W3_MPI INCLUDE "mpif.h" @@ -501,7 +506,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & !/ ------------------------------------------------------------------- / !/ Parameter list !/ - INTEGER, INTENT(IN) :: IMOD, TEND(2),ODAT(35) + INTEGER, INTENT(IN) :: IMOD, TEND(2),ODAT(40) LOGICAL, INTENT(IN), OPTIONAL :: STAMP, NO_OUT #ifdef W3_OASIS INTEGER, INTENT(IN), OPTIONAL :: ID_LCOMM @@ -511,6 +516,9 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & !/ ------------------------------------------------------------------- / !/ Local parameters : !/ +#ifdef W3_T + INTEGER :: ILEN +#endif #ifdef W3_S INTEGER, SAVE :: IENT = 0 #endif @@ -523,12 +531,15 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & INTEGER :: TTEST(2),DTTEST REAL :: ICEDAVE ! +#ifdef W3_MPI LOGICAL :: SBSED - LOGICAL :: CPLWRTFLG +#endif #ifdef W3_SEC1 INTEGER :: ISEC1 #endif +#ifdef W3_SBS INTEGER :: JJ, NDSOFLG +#endif #ifdef W3_MPI INTEGER :: IERR_MPI, NRQMAX INTEGER, ALLOCATABLE :: STATCO(:,:), STATIO(:,:) @@ -561,8 +572,8 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! LOGICAL :: FLACT, FLZERO, FLFRST, FLMAP, TSTAMP,& SKIP_O, FLAG_O, FLDDIR, READBC, & - FLAG0 = .FALSE., FLOUTG, FLPFLD, & - FLPART, LOCAL, FLOUTG2 + FLAG0 = .FALSE., FLOUTG = .false., FLPFLD, & + FLPART, LOCAL, FLOUTG2 = .false. ! #ifdef W3_MPI LOGICAL :: FLGMPI(0:8) @@ -583,7 +594,9 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & REAL :: VD_SPEC(NSPEC) #endif ! +#ifdef W3_SBS CHARACTER(LEN=30) :: FOUTNAME +#endif ! #ifdef W3_T REAL :: INDSORT(NSEA), DTCFL1(NSEA) @@ -594,28 +607,9 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & REAL, ALLOCATABLE :: BACSPEC(:) REAL :: BACANGL #endif - ! locally defined flags -#ifdef W3_SBS - logical, parameter :: w3_sbs_flag = .true. -#else - logical, parameter :: w3_sbs_flag = .false. -#endif -#ifdef W3_CESMCOUPLED - logical, parameter :: w3_cesmcoupled_flag = .true. -#else - logical, parameter :: w3_cesmcoupled_flag = .false. -#endif - integer :: memunit - logical :: do_gridded_output - logical :: do_point_output - logical :: do_track_output - logical :: do_restart_output - logical :: do_sf_output - logical :: do_coupler_output - logical :: do_wavefield_separation_output - logical :: do_startall - logical :: do_w3outg - + integer :: memunit + character(len=16) :: user_timestring !YYYY-MM-DD-SSSSS + character(len=256) :: fname !/ ------------------------------------------------------------------- / ! 0. Initializations ! @@ -707,12 +701,15 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & FACX = 1. END IF ! +#ifdef W3_SBS + NDSOFLG = 99 +#endif +#ifdef W3_MPI SBSED = .FALSE. - if (w3_sbs_flag) then - NDSOFLG = 99 - SBSED = .TRUE. - end if - +#endif +#ifdef W3_SBS + SBSED = .TRUE. +#endif ! TAUWX = 0. TAUWY = 0. @@ -720,7 +717,8 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! 0.d Test output ! #ifdef W3_T - WRITE (NDST,9000) IMOD, trim(FILEXT), TEND + ILEN = LEN_TRIM(FILEXT) + WRITE (NDST,9000) IMOD, FILEXT(:ILEN), TEND #endif ! ! 1. Check the consistency of the input ----------------------------- / @@ -2305,10 +2303,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & END DO IF (IT.GT.0) DTG=DTGTEMP #endif - - - - ! ! ! 3.8 Update global time step. @@ -2321,7 +2315,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & DTG = DTTST / REAL(NT-IT) END IF ! - IF ( FLACT .AND. IT.NE.NT .AND. IAPROC.EQ.NAPLOG ) THEN + IF ( FLACT .AND. IT.NE.NT .AND. IAPROC.EQ.NAPLOG .and. verboselog) THEN CALL STME21 ( TIME , IDTIME ) IF ( IDLAST .NE. TIME(1) ) THEN WRITE (NDSO,900) ITIME, IPASS, IDTIME(01:19), IDACT, OUTID @@ -2341,7 +2335,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #endif ! ! - END DO + END DO ! DO IT = IT0, NT #ifdef W3_TIMINGS CALL PRINT_MY_TIME("W3WAVE, step 6.21.1") @@ -2362,6 +2356,31 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! Delay if data assimilation time. ! ! +#ifdef W3_PIO + if (dsec21(time,tend) == 0.0) then ! req'd in case waves are running in slow loop + + if (use_historync) then + floutg = .false. + floutg2 = .false. + if (histwr) then + call w3cprt (imod) + call w3outg (va, flpfld, .true., .false. ) + call write_history(tend) + end if + end if + + if (use_restartnc) then + if (rstwr) then + call set_user_timestring(tend,user_timestring) + fname = trim(user_restfname)//trim(user_timestring)//'.nc' + call write_restart(trim(fname), va, mapsta+8*mapst2) + end if + end if + + end if +#endif + + IF ( TOFRST(1) .EQ. -1 ) THEN DTTST = 1. ELSE @@ -2389,88 +2408,82 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! ! 4.b Processing and MPP preparations ! - IF ( FLOUT(1) ) THEN - FLOUTG = DSEC21(TIME,TONEXT(:,1)).EQ.0. - ELSE - FLOUTG = .FALSE. - END IF - ! - IF ( FLOUT(7) ) THEN - FLOUTG2 = DSEC21(TIME,TONEXT(:,7)).EQ.0. - ELSE - FLOUTG2 = .FALSE. - END IF - ! - FLPART = .FALSE. - IF ( FLOUT(1) .AND. FLPFLD ) FLPART = FLPART .OR. DSEC21(TIME,TONEXT(:,1)).EQ.0. - IF ( FLOUT(6) ) FLPART = FLPART .OR. DSEC21(TIME,TONEXT(:,6)).EQ.0. - ! + if (.not. use_historync) then + IF ( FLOUT(1) ) THEN + FLOUTG = DSEC21(TIME,TONEXT(:,1)).EQ.0. + ELSE + FLOUTG = .FALSE. + END IF + ! + IF ( FLOUT(7) ) THEN + FLOUTG2 = DSEC21(TIME,TONEXT(:,7)).EQ.0. + ELSE + FLOUTG2 = .FALSE. + END IF + ! + FLPART = .FALSE. + IF ( FLOUT(1) .AND. FLPFLD ) FLPART = FLPART .OR. DSEC21(TIME,TONEXT(:,1)).EQ.0. + IF ( FLOUT(6) ) FLPART = FLPART .OR. DSEC21(TIME,TONEXT(:,6)).EQ.0. + ! #ifdef W3_T - WRITE (NDST,9042) LOCAL, FLPART, FLOUTG + WRITE (NDST,9042) LOCAL, FLPART, FLOUTG #endif + ! + IF ( LOCAL .AND. FLPART ) CALL W3CPRT ( IMOD ) + IF ( LOCAL .AND. (FLOUTG .OR. FLOUTG2) ) then + CALL W3OUTG ( VA, FLPFLD, FLOUTG, FLOUTG2 ) + end if + end if ! if (.not. use_historync) then ! - IF ( LOCAL .AND. FLPART ) then - CALL W3CPRT ( IMOD ) - end IF - - do_w3outg = .false. - if (w3_cesmcoupled_flag .and. histwr) then - do_w3outg = .true. - else if ( LOCAL .AND. (FLOUTG .OR. FLOUTG2) ) then - do_w3outg = .true. - end if - if (do_w3outg) then - CALL W3OUTG ( VA, FLPFLD, FLOUTG, FLOUTG2 ) - end if ! #ifdef W3_MPI FLGMPI = .FALSE. NRQMAX = 0 +#endif ! - do_startall = .false. - if (w3_cesmcoupled_flag .and. histwr) then - IF ( FLOUT(1) .OR. FLOUT(7) ) THEN - do_startall = .true. - end IF - else - CPLWRTFLG=.FALSE. - IF ( FLOUT(7) .AND. SBSED ) THEN - IF (DSEC21(TIME,TONEXT(:,7)).EQ.0.) THEN - CPLWRTFLG=.TRUE. - END IF - END IF - IF ( ( (DSEC21(TIME,TONEXT(:,1)).EQ.0.) .AND. FLOUT(1) ) .OR. & - ( CPLWRTFLG ) ) THEN - do_startall = .true. - end IF - end if - if (do_startall) then +#ifdef W3_MPI + IF ( (FLOUTG) .OR. (FLOUTG2 .AND. SBSED) ) THEN IF (.NOT. LPDLIB) THEN IF (NRQGO.NE.0 ) THEN +#endif +#ifdef W3_MPI CALL MPI_STARTALL ( NRQGO, IRQGO , IERR_MPI ) +#endif +#ifdef W3_MPI FLGMPI(0) = .TRUE. NRQMAX = MAX ( NRQMAX , NRQGO ) +#endif #ifdef W3_MPIT WRITE (NDST,9043) '1a', NRQGO, NRQMAX, NAPFLD #endif +#ifdef W3_MPI END IF +#endif ! +#ifdef W3_MPI IF (NRQGO2.NE.0 ) THEN +#endif +#ifdef W3_MPI CALL MPI_STARTALL ( NRQGO2, IRQGO2, IERR_MPI ) - +#endif +#ifdef W3_MPI FLGMPI(1) = .TRUE. NRQMAX = MAX ( NRQMAX , NRQGO2 ) +#endif #ifdef W3_MPIT WRITE (NDST,9043) '1b', NRQGO2, NRQMAX, NAPFLD #endif +#ifdef W3_MPI END IF ELSE +#endif #ifdef W3_PDLIB CALL DO_OUTPUT_EXCHANGES(IMOD) #endif +#ifdef W3_MPI END IF ! IF (.NOT. LPDLIB) THEN - END IF ! if (do_startall) + END IF #endif call print_memcheck(memunit, 'memcheck_____:'//' WW3_WAVE AFTER TIME LOOP 1') ! @@ -2490,33 +2503,35 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #endif ! #ifdef W3_MPI - IF ( FLOUT(4) .AND. NRQRS.NE.0 ) THEN - IF ( DSEC21(TIME,TONEXT(:,4)).EQ.0. ) THEN - CALL MPI_STARTALL ( NRQRS, IRQRS , IERR_MPI ) - FLGMPI(4) = .TRUE. - NRQMAX = MAX ( NRQMAX , NRQRS ) + if (.not. use_restartnc) then + IF ( FLOUT(4) .AND. NRQRS.NE.0 ) THEN + IF ( DSEC21(TIME,TONEXT(:,4)).EQ.0. ) THEN + CALL MPI_STARTALL ( NRQRS, IRQRS , IERR_MPI ) + FLGMPI(4) = .TRUE. + NRQMAX = MAX ( NRQMAX , NRQRS ) #endif #ifdef W3_MPIT - WRITE (NDST,9043) '4 ', NRQRS, NRQMAX, NAPRST + WRITE (NDST,9043) '4 ', NRQRS, NRQMAX, NAPRST #endif #ifdef W3_MPI + END IF END IF - END IF #endif - ! + ! #ifdef W3_MPI - IF ( FLOUT(8) .AND. NRQRS.NE.0 ) THEN - IF ( DSEC21(TIME,TONEXT(:,8)).EQ.0. ) THEN - CALL MPI_STARTALL ( NRQRS, IRQRS , IERR_MPI ) - FLGMPI(8) = .TRUE. - NRQMAX = MAX ( NRQMAX , NRQRS ) + IF ( FLOUT(8) .AND. NRQRS.NE.0 ) THEN + IF ( DSEC21(TIME,TONEXT(:,8)).EQ.0. ) THEN + CALL MPI_STARTALL ( NRQRS, IRQRS , IERR_MPI ) + FLGMPI(8) = .TRUE. + NRQMAX = MAX ( NRQMAX , NRQRS ) #endif #ifdef W3_MPIT - WRITE (NDST,9043) '8 ', NRQRS, NRQMAX, NAPRST + WRITE (NDST,9043) '8 ', NRQRS, NRQMAX, NAPRST #endif #ifdef W3_MPI + END IF END IF - END IF + end if ! if (.not. use_restartnc) #endif ! #ifdef W3_MPI @@ -2554,7 +2569,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & call print_memcheck(memunit, 'memcheck_____:'//' WW3_WAVE AFTER TIME LOOP 2') ! ! 4.c Reset next output time - ! TOFRST(1) = -1 TOFRST(2) = 0 @@ -2562,29 +2576,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & DO J=1, NOTYPE IF ( FLOUT(J) ) THEN - ! - ! - ! Determine output flags - ! - if (w3_sbs_flag) then - do_gridded_output = ( j .eq. 1 ) .or. ( j .eq. 7 ) - else - if (w3_cesmcoupled_flag) then - do_gridded_output = ( j .eq. 1 ) .and. histwr - else - do_gridded_output = ( j .eq. 1 ) - end if - end if - do_point_output = (j .eq. 2) - do_track_output = (j .eq. 3) - if (w3_cesmcoupled_flag) then - do_restart_output = (j .eq. 4) .and. rstwr - else - do_restart_output = (j .eq. 4) - end if - do_wavefield_separation_output = (j .eq. 5) - do_sf_output = (j .eq. 6) - do_coupler_output = (j .eq. 7) ! ! 4.d Perform output ! @@ -2595,75 +2586,90 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & DTTST = DSEC21 ( TIME, TOUT ) ! IF ( DTTST .EQ. 0. ) THEN - if (do_gridded_output) then - if (user_netcdf_grdout) then -#ifdef W3_MPI - IF ( FLGMPI(0) )CALL MPI_WAITALL( NRQGO, IRQGO, STATIO, IERR_MPI ) - FLGMPI(0) = .FALSE. + IF ( ( J .EQ. 1 ) & +#ifdef W3_SBS + .OR. ( J .EQ. 7 ) & #endif - IF ( IAPROC .EQ. NAPFLD ) THEN + .and. .not. use_historync) THEN + IF ( IAPROC .EQ. NAPFLD ) THEN #ifdef W3_MPI - IF ( FLGMPI(1) ) CALL MPI_WAITALL( NRQGO2, IRQGO2, STATIO, IERR_MPI ) - FLGMPI(1) = .FALSE. + IF ( FLGMPI(1) ) CALL MPI_WAITALL ( NRQGO2, IRQGO2, STATIO, IERR_MPI ) + FLGMPI(1) = .FALSE. #endif - CALL W3IOGONCD () - END IF - else - ! default (binary) output - IF ( IAPROC .EQ. NAPFLD ) THEN -#ifdef W3_MPI - IF ( FLGMPI(1) ) CALL MPI_WAITALL( NRQGO2, IRQGO2, STATIO, IERR_MPI ) - FLGMPI(1) = .FALSE. -#endif - if (w3_sbs_flag) then - IF ( J .EQ. 1 ) THEN - CALL W3IOGO( 'WRITE', NDS(7), ITEST, IMOD ) - ENDIF - - ! Generate output flag file for fields and SBS coupling. - CALL STME21 ( TIME, IDTIME ) - FOUTNAME = 'Field_done.' // IDTIME(1:4) & - // IDTIME(6:7) // IDTIME(9:10) & - // IDTIME(12:13) // '.' // TRIM(FILEXT) - OPEN( UNIT=NDSOFLG, FILE=FOUTNAME) - CLOSE( NDSOFLG ) - else - CALL W3IOGO( 'WRITE', NDS(7), ITEST, IMOD ) - endif - end if - end if ! user_netcdf_grdout - - ELSE IF ( do_point_output ) THEN + ! +#ifdef W3_SBS + IF ( J .EQ. 1 ) THEN +#endif + CALL W3IOGO( 'WRITE', NDS(7), ITEST, IMOD & +#ifdef W3_ASCII + ,NDS(14) & +#endif + ) +#ifdef W3_SBS + ENDIF +#endif + ! +#ifdef W3_SBS + ! + ! Generate output flag file for fields and SBS coupling. + ! + JJ = LEN_TRIM ( FILEXT ) + CALL STME21 ( TIME, IDTIME ) + FOUTNAME = 'Field_done.' // IDTIME(1:4) & + // IDTIME(6:7) // IDTIME(9:10) & + // IDTIME(12:13) // '.' // FILEXT(1:JJ) +#endif + ! +#ifdef W3_SBS + OPEN( UNIT=NDSOFLG, FILE=FOUTNAME) + CLOSE( NDSOFLG ) +#endif + END IF + ! + ELSE IF ( J .EQ. 2 ) THEN + ! + ! Point output + ! IF ( IAPROC .EQ. NAPPNT ) THEN + ! + ! Gets the necessary spectral data + ! CALL W3IOPE ( VA ) - CALL W3IOPO ( 'WRITE', NDS(8), ITEST, IMOD ) + CALL W3IOPO ( 'WRITE', NDS(8), ITEST, IMOD & +#ifdef W3_ASCII + ,NDS(15) & +#endif + ) END IF - - ELSE IF ( do_track_output ) THEN + ! + ELSE IF ( J .EQ. 3 ) THEN + ! + ! Track output + ! CALL W3IOTR ( NDS(11), NDS(12), VA, IMOD ) - - ELSE IF ( do_restart_output ) THEN + ELSE IF ( J .EQ. 4 .and. .not. use_restartnc) THEN CALL W3IORS ('HOT', NDS(6), XXX, IMOD, FLOUT(8) ) ITEST = RSTYPE - - ELSE IF ( do_wavefield_separation_output ) THEN + ELSE IF ( J .EQ. 5 ) THEN IF ( IAPROC .EQ. NAPBPT ) THEN #ifdef W3_MPI IF (NRQBP2.NE.0) CALL MPI_WAITALL ( NRQBP2, IRQBP2,STATIO, IERR_MPI ) #endif - CALL W3IOBC ( 'WRITE', NDS(10), TIME, TIME, ITEST, IMOD ) + CALL W3IOBC ( 'WRITE', NDS(10), & + TIME, TIME, ITEST, IMOD ) END IF - ELSE IF ( do_sf_output ) THEN + ELSE IF ( J .EQ. 6 ) THEN CALL W3IOSF ( NDS(13), IMOD ) #ifdef W3_OASIS - ELSE IF ( do_coupler_output ) THEN + ELSE IF ( J .EQ. 7 ) THEN ! ! Send variables to atmospheric or ocean circulation or ice model ! IF (DTOUT(7).NE.0) THEN IF ( (MOD(ID_OASIS_TIME,NINT(DTOUT(7))) .EQ. 0 ) .AND. & (DSEC21 (TIME00, TIME) .GT. 0.0) ) THEN - IF ( (CPLT0 .AND. (DSEC21 (TIME, TIMEN) .GT. 0.0)) .OR. .NOT. CPLT0 ) THEN + IF ( (CPLT0 .AND. (DSEC21 (TIME, TIMEN) .GT. 0.0)) .OR. & + .NOT. CPLT0 ) THEN IF (CPLT0) ID_OASIS_TIME = NINT(DSEC21 ( TIME00 , TIME )) #endif @@ -2722,7 +2728,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! If there is a second stream of restart files then J=8 and FLOUT(8)=.TRUE. J=8 - IF ( FLOUT(J) ) THEN + IF ( FLOUT(J) .and. .not. use_restartnc) THEN ! ! 4.d Perform output ! @@ -2767,11 +2773,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! #ifdef W3_MPI IF ( FLGMPI(0) ) CALL MPI_WAITALL ( NRQGO, IRQGO , STATIO, IERR_MPI ) - if (user_netcdf_grdout) then - IF ( FLGMPI(1) .and. ( IAPROC .EQ. NAPFLD ) ) then - CALL MPI_WAITALL ( NRQGO2, IRQGO2 , STATIO, IERR_MPI ) - end if - end if IF ( FLGMPI(2) ) CALL MPI_WAITALL ( NRQPO, IRQPO1, STATIO, IERR_MPI ) IF ( FLGMPI(4) ) CALL MPI_WAITALL ( NRQRS, IRQRS , STATIO, IERR_MPI ) IF ( FLGMPI(8) ) CALL MPI_WAITALL ( NRQRS, IRQRS , STATIO, IERR_MPI ) @@ -2790,7 +2791,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! ! 5. Update log file ------------------------------------------------ / ! - IF ( IAPROC.EQ.NAPLOG ) THEN + IF ( IAPROC.EQ.NAPLOG .and. verboselog) THEN ! CALL STME21 ( TIME , IDTIME ) IF ( FLCUR ) THEN @@ -2843,7 +2844,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & WRITE (SCREEN,951) STTIME END IF - IF ( IAPROC .EQ. NAPLOG ) WRITE (NDSO,902) + IF ( IAPROC .EQ. NAPLOG .and. verboselog) WRITE (NDSO,902) ! DEALLOCATE(FIELD) DEALLOCATE(TAUWX, TAUWY) diff --git a/model/src/wav_comp_nuopc.F90 b/model/src/wav_comp_nuopc.F90 index 14bc4cb9b..fadabb10a 100644 --- a/model/src/wav_comp_nuopc.F90 +++ b/model/src/wav_comp_nuopc.F90 @@ -44,8 +44,8 @@ module wav_comp_nuopc use wav_shr_mod , only : wav_coupling_to_cice, nwav_elev_spectrum use wav_shr_mod , only : merge_import, dbug_flag use w3odatmd , only : nds, iaproc, napout - use w3odatmd , only : runtype, use_user_histname, user_histfname, use_user_restname, user_restfname - use w3odatmd , only : user_netcdf_grdout + use w3odatmd , only : runtype, user_histfname, user_restfname, verboselog + use w3odatmd , only : use_historync, use_restartnc, restart_from_binary, logfile_is_assigned use w3odatmd , only : time_origin, calendar_name, elapsed_secs use wav_shr_mod , only : casename, multigrid, inst_suffix, inst_index, unstr_mesh, standalone use wav_wrapper_mod , only : ufs_settimer, ufs_logtimer, ufs_file_setlogunit, wtime @@ -56,6 +56,7 @@ module wav_comp_nuopc use wmmdatmd , only : nmpscr use w3updtmd , only : w3uini use w3adatmd , only : flcold, fliwnd + use shr_is_restart_fh_mod , only : init_is_restart_fh, is_restart_fh, is_restart_fh_type #endif use constants , only : is_esmf_component @@ -89,17 +90,10 @@ module wav_comp_nuopc logical :: cesmcoupled = .true. !< logical to indicate CESM use case #else logical :: cesmcoupled = .false. !< logical to indicate non-CESM use case + type(is_restart_fh_type) :: restartfh_info ! For flexible restarts in UFS #endif integer, allocatable :: tend(:,:) !< the ending time of ModelAdvance when !! run with multigrid=true - logical :: user_histalarm = .false. !< logical flag for user to set history alarms - !! using ESMF. If history_option is present as config - !! option, user_histalarm will be true and will be - !! set using history_option, history_n and history_ymd - logical :: user_restalarm = .false. !< logical flag for user to set restart alarms - !! using ESMF. If restart_option is present as config - !! option, user_restalarm will be true and will be - !! set using restart_option, restart_n and restart_ymd integer :: ymd !< current year-month-day integer :: tod !< current time of day (sec) integer :: time0(2) !< start time stored as yyyymmdd,hhmmss @@ -229,6 +223,7 @@ end subroutine InitializeP0 subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) use wav_shr_flags, only : w3_pdlib_flag + ! input/output arguments type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState @@ -395,6 +390,13 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) write(logmsg,'(A,l)') trim(subname)//': Standalone setting is ', standalone call ESMF_LogWrite(trim(logmsg), ESMF_LOGMSG_INFO) + ! Determine verbose native WW3 logging + call NUOPC_CompAttributeGet(gcomp, name="verboselog", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) verboselog=(trim(cvalue)=="true") + write(logmsg,*) verboselog + call ESMF_LogWrite('WW3_cap: Verbose WW3 native logging is = '//trim(logmsg), ESMF_LOGMSG_INFO) + call advertise_fields(importState, exportState, flds_scalar_name, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -427,23 +429,24 @@ end subroutine InitializeAdvertise !> @date 01-05-2022 subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) - use w3odatmd , only : w3nout, w3seto, naproc, iaproc, naperr, napout - use w3timemd , only : stme21 - use w3adatmd , only : w3naux, w3seta - use w3idatmd , only : w3seti, w3ninp - use w3gdatmd , only : nk, nseal, nsea, nx, ny, mapsf, w3nmod, w3setg - use w3gdatmd , only : rlgtype, ungtype, gtype - use w3wdatmd , only : va, time, w3ndat, w3dimw, w3setw - use w3parall , only : init_get_isea + use w3odatmd , only : w3nout, w3seto, naproc, naperr + use w3timemd , only : stme21 + use w3adatmd , only : w3naux, w3seta + use w3idatmd , only : w3seti, w3ninp + use w3gdatmd , only : nk, nseal, nsea, nx, ny, mapsf, w3nmod, w3setg + use w3gdatmd , only : rlgtype, ungtype, gtype + use w3wdatmd , only : va, time, w3ndat, w3dimw, w3setw + use w3parall , only : init_get_isea #ifndef W3_CESMCOUPLED - use wminitmd , only : wminit, wminitnml - use wmunitmd , only : wmuget, wmuset + use wminitmd , only : wminit, wminitnml + use wmunitmd , only : wmuget, wmuset #endif - use wav_shel_inp , only : set_shel_io - use wav_grdout , only : wavinit_grdout - use wav_shr_mod , only : diagnose_mesh, write_meshdecomp + use wav_shel_inp , only : set_shel_io + use wav_history_mod , only : wav_history_init + use wav_pio_mod , only : wav_pio_init + use wav_shr_mod , only : diagnose_mesh, write_meshdecomp, wav_loginit #ifdef W3_PDLIB - use yowNodepool , only : ng + use yowNodepool , only : ng #endif ! input/output variables @@ -462,6 +465,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) type(ESMF_TimeInterval) :: TimeOffset type(ESMF_TimeInterval) :: TimeStep type(ESMF_Calendar) :: calendar + type(ESMF_Info) :: info character(CL) :: cvalue integer :: shrlogunit integer :: yy,mm,dd,hh,ss @@ -483,16 +487,17 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer(i4) :: maskmin integer(i4), pointer :: meshmask(:) character(23) :: dtme21 - integer :: iam, mpi_comm + integer :: iam, mpi_comm, num_threads character(ESMF_MAXSTR) :: msgString character(ESMF_MAXSTR) :: diro character(CL) :: logfile logical :: local integer :: imod, idsi, idso, idss, idst, idse - integer :: mds(13) ! Note that nds is set to this in w3initmod + integer :: mds(15) ! Note that nds is set to this in w3initmod integer :: stdout integer :: petcount real(r8) :: toff + logical :: isPresent, isSet character(ESMF_MAXSTR) :: preamb = './' character(ESMF_MAXSTR) :: ifname = 'ww3_multi.inp' character(len=*), parameter :: subname = '(wav_comp_nuopc:InitializeRealize)' @@ -529,6 +534,12 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_VMGet(vm, mpiCommunicator=mpi_comm, peCount=petcount, localPet=iam, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_InfoGetFromHost(gcomp, info=info, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_InfoGet(info, key="/NUOPC/Hint/PePerPet/MaxCount", value=num_threads, default=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + #ifndef W3_CESMCOUPLED nmproc = petcount #else @@ -567,11 +578,17 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return open (newunit=stdout, file=trim(diro)//"/"//trim(logfile)) + logfile_is_assigned = .true. else stdout = 6 endif else - stdout = 6 + if ( root_task ) then + open (newunit=stdout, file='log.ww3') + logfile_is_assigned = .true. + else + stdout = 6 + end if end if if (.not. multigrid) call set_shel_io(stdout,mds,ntrace) @@ -579,6 +596,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if ( root_task ) then write(stdout,'(a)')' *** WAVEWATCH III Program shell *** ' write(stdout,'(a)')'===============================================' + write(stdout,'(/)') write(stdout,'(a,l)')' Wave wav_coupling_to_cice setting is ',wav_coupling_to_cice end if @@ -596,7 +614,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) runtype = "branch" end if if ( root_task ) then - write(stdout,*) 'WW3 runtype is '//trim(runtype) + write(stdout,'(a)') ' WW3 runtype is '//trim(runtype) end if call ESMF_LogWrite('WW3 runtype is '//trim(runtype), ESMF_LOGMSG_INFO) @@ -635,7 +653,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Determine time attributes for history output - call ESMF_TimeGet( esmfTime, timeString=time_origin, calendar=calendar, rc=rc ) + call ESMF_TimeGet( startTime, timeString=time_origin, calendar=calendar, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return time_origin = 'seconds since '//time_origin(1:10)//' '//time_origin(12:19) !call ESMF_ClockGet(clock, calendar=calendar) @@ -671,13 +689,82 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call stme21 ( time0 , dtme21 ) if ( root_task ) then write (stdout,'(a)')' Starting time : '//trim(dtme21) - write (stdout,'(a,i8,2x,i8)') 'start_ymd, stop_ymd = ',start_ymd, stop_ymd + write (stdout,'(a,i8,2x,i8)') ' start_ymd, stop_ymd = ',start_ymd, stop_ymd end if #ifndef W3_CESMCOUPLED stime = time0 etime = timen #endif + !-------------------------------------------------------------------- + ! Initialize PIO. This needs to be done prior to the call to w3init + ! in order to read the restart file. The filename strings must also + ! be available + !-------------------------------------------------------------------- + + if (cesmcoupled) then + if (len_trim(inst_suffix) > 0) then + user_restfname = trim(casename)//'.ww3'//trim(inst_suffix)//'.r.' + user_histfname = trim(casename)//'.ww3'//trim(inst_suffix)//'.hi.' + else + user_restfname = trim(casename)//'.ww3.r.' + user_histfname = trim(casename)//'.ww3.hi.' + endif + + ! netcdf is used for CESM history and restart + use_historync = .true. + use_restartnc = .true. + else + call NUOPC_CompAttributeGet(gcomp, name='use_restartnc', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + use_restartnc=(trim(cvalue)=="true") + end if + if (root_task) write(stdout,'(a,l4)') trim(subname)//': Wave use_restartnc setting is ',use_restartnc + + ! user filenaming is required with netcdf restarts or restart_from_binary. If netcdf restarts are not used, + ! only native WW3 file naming is possible + if (use_restartnc) then + user_restfname = trim(casename)//'.ww3.r.' + if (root_task) write(stdout,'(a)') trim(subname)//': Custom restart prefix is '//trim(user_restfname) + end if + + call NUOPC_CompAttributeGet(gcomp, name='use_historync', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + use_historync=(trim(cvalue)=="true") + end if + if (root_task) write(stdout,'(a,l4)') trim(subname)//': Wave use_historync setting is ',use_historync + + ! user filenaming is optional with netcdf output. If netcdf history is not used, only native WW3 + ! naming is possible + if (use_historync) then + call NUOPC_CompAttributeGet(gcomp, name='user_histname', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(cvalue)=="true") then + user_histfname = trim(casename)//'.ww3.hi.' + if (root_task) write(stdout,'(a)') trim(subname)//': Custom history prefix is '//trim(user_histfname) + else + user_histfname = '' + end if + end if + end if ! if (cesmcoupled) + + ! allow startup from binary restarts as special case + if (use_restartnc) then + call NUOPC_CompAttributeGet(gcomp, name='restart_from_binary', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + restart_from_binary=(trim(cvalue)=="true") + end if + if (root_task) write(stdout,'(a,l4)') trim(subname)//': Wave restart_from_binary setting is ',restart_from_binary + end if + + if (use_restartnc .or. use_historync) then + call wav_pio_init(gcomp, mpi_comm, stdout, naproc/num_threads, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + !-------------------------------------------------------------------- ! Wave model initialization !-------------------------------------------------------------------- @@ -706,7 +793,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end do call ESMF_LogWrite(trim(subname)//' done = wminit', ESMF_LOGMSG_INFO) else - call waveinit_ufs(gcomp, ntrace, mpi_comm, mds, rc) + call waveinit_ufs(gcomp, stdout, ntrace, mpi_comm, mds, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if #else @@ -716,11 +803,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call waveinit_cesm(gcomp, ntrace, mpi_comm, mds, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return #endif - - ! call mpi_barrier ( mpi_comm, ierr ) + !call mpi_barrier ( mpi_comm, ierr ) if ( root_task ) then - inquire(unit=nds(1), name=logfile) - print *,'WW3 log written to '//trim(logfile) + inquire(unit=stdout, name=logfile) + write(*,'(a)')'WW3 log written to '//trim(logfile) end if if (wav_coupling_to_cice) then @@ -730,14 +816,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end if end if - !-------------------------------------------------------------------- - ! Intialize the list of requested output variables for netCDF output - !-------------------------------------------------------------------- - - if (user_netcdf_grdout) then - call wavinit_grdout - end if - !-------------------------------------------------------------------- ! Mesh initialization !-------------------------------------------------------------------- @@ -773,7 +851,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! create distGrid from global index array of sea points with no ghost points DistGrid = ESMF_DistGridCreate(arbSeqIndexList=gindex_sea, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - deallocate(gindex_sea) else ! create a global index array for non-sea (i.e. land points) allocate(mask_global(nx*ny), mask_local(nx*ny)) @@ -819,8 +896,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) gindex(ncnt) = gindex_lnd(ncnt-nseal_cpl) end if end do - deallocate(gindex_sea) - deallocate(gindex_lnd) ! create distGrid from global index array DistGrid = ESMF_DistGridCreate(arbSeqIndexList=gindex, rc=rc) @@ -830,14 +905,23 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! get the mesh file name call NUOPC_CompAttributeGet(gcomp, name='mesh_wav', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! read in the mesh with the above DistGrid + ! read in the mesh with the the DistGrid EMesh = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, & elementDistgrid=Distgrid,rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then - call diagnose_mesh(EMesh, size(gindex), 'EMesh', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (unstr_mesh) then + call diagnose_mesh(EMesh, size(gindex_sea), 'EMesh', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + deallocate(gindex_sea) + else + call diagnose_mesh(EMesh, size(gindex), 'EMesh', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + deallocate(gindex) + deallocate(gindex_sea) + deallocate(gindex_lnd) + end if end if if (.not. unstr_mesh) then @@ -869,7 +953,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if deallocate(meshmask) - deallocate(gindex) end if if (dbug_flag > 5) then @@ -899,6 +982,24 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) enddo end if #endif + !-------------------------------------------------------------------- + ! Intialize the list of requested output variables for netCDF output. + ! This needs to occur after mod_def has been read in w3init since + ! some variables are available only if they are defined in the mod_def + !-------------------------------------------------------------------- + + if (use_historync) then + call wav_history_init(stdout) + end if + + !-------------------------------------------------------------------- + ! Write the header string for WW3 native logging + !-------------------------------------------------------------------- + + if (root_task) then + if (verboselog) call wav_loginit(stdout) + end if + if (root_task) call ufs_logtimer(nu_timer,time,start_tod,'InitializeRealize time: ',runtimelog,wtime) if (dbug_flag > 5) call ESMF_LogWrite(trim(subname)//' done', ESMF_LOGMSG_INFO) @@ -1038,7 +1139,8 @@ subroutine ModelAdvance(gcomp, rc) type(ESMF_Time) :: currTime, nextTime, startTime, stopTime integer :: yy,mm,dd,hh,ss integer :: imod - integer :: shrlogunit ! original log unit and level + logical :: write_restartfh + !integer :: shrlogunit ! original log unit and level character(ESMF_MAXSTR) :: msgString character(len=*),parameter :: subname = '(wav_comp_nuopc:ModelAdvance) ' !------------------------------------------------------- @@ -1074,8 +1176,8 @@ subroutine ModelAdvance(gcomp, rc) ss = tod - (hh*3600) - (mm*60) time0(1) = ymd time0(2) = hh*10000 + mm*100 + ss - if ( root_task ) then - write(nds(1),'(a,3i4,i10)') 'ymd2date currTime wav_comp_nuopc hh,mm,ss,ymd', hh,mm,ss,ymd + if (dbug_flag > 5) then + if ( root_task ) write(nds(1),'(a,3i4,i10)') 'ymd2date currTime wav_comp_nuopc hh,mm,ss,ymd', hh,mm,ss,ymd end if if (root_task) call ufs_logtimer(nu_timer,time,tod,'ModelAdvance time since last step: ',runtimelog,wtime) call ufs_settimer(wtime) @@ -1120,41 +1222,33 @@ subroutine ModelAdvance(gcomp, rc) !------------ if(profile_memory) call ESMF_VMLogMemInfo("Entering WW3 Run : ") - if (user_restalarm) then - ! Determine if time to write ww3 restart files - call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) + ! Determine if time to write ww3 restart files + call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then + if (ChkErr(rc,__LINE__,u_FILE_u)) return + rstwr = .true. + call ESMF_AlarmRingerOff( alarm, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (ESMF_AlarmIsRinging(alarm, rc=rc)) then - if (ChkErr(rc,__LINE__,u_FILE_u)) return - rstwr = .true. - call ESMF_AlarmRingerOff( alarm, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - rstwr = .false. - endif else rstwr = .false. - end if + endif +#ifndef W3_CESMCOUPLED + call is_restart_fh(clock, restartfh_info, write_restartfh) + if (write_restartfh) rstwr = .true. +#endif - if (user_histalarm) then - ! Determine if time to write ww3 history files - call ESMF_ClockGetAlarm(clock, alarmname='alarm_history', alarm=alarm, rc=rc) + ! Determine if time to write ww3 history files + call ESMF_ClockGetAlarm(clock, alarmname='alarm_history', alarm=alarm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then + if (ChkErr(rc,__LINE__,u_FILE_u)) return + histwr = .true. + call ESMF_AlarmRingerOff( alarm, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (ESMF_AlarmIsRinging(alarm, rc=rc)) then - if (ChkErr(rc,__LINE__,u_FILE_u)) return - histwr = .true. - call ESMF_AlarmRingerOff( alarm, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - histwr = .false. - endif else histwr = .false. - end if - if ( root_task ) then - ! write(nds(1),*) 'wav_comp_nuopc time', time, timen - ! write(nds(1),*) 'ww3 hist flag ', histwr, hh - end if + endif ! Advance the wave model #ifndef W3_CESMCOUPLED @@ -1191,6 +1285,7 @@ end subroutine ModelAdvance !> @date 01-05-2022 subroutine ModelSetRunClock(gcomp, rc) + use wav_shel_inp , only : odat ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -1201,6 +1296,7 @@ subroutine ModelSetRunClock(gcomp, rc) type(ESMF_Time) :: mstoptime type(ESMF_Time) :: mstarttime type(ESMF_TimeInterval) :: mtimestep, dtimestep + character(ESMF_MAXSTR) :: msgString logical :: isPresent logical :: isSet character(len=256) :: cvalue @@ -1217,7 +1313,7 @@ subroutine ModelSetRunClock(gcomp, rc) integer :: history_ymd ! History date (YYYYMMDD) type(ESMF_ALARM) :: history_alarm character(len=128) :: name - integer :: alarmcount + integer :: alarmcount, dt_cpl character(len=*),parameter :: subname=trim(modName)//':(ModelSetRunClock) ' !------------------------------------------------------------------------------- @@ -1285,12 +1381,12 @@ subroutine ModelSetRunClock(gcomp, rc) call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - user_restalarm = .true. - else - ! If attribute is not present - write restarts at native WW3 freq - restart_option = 'none' - restart_n = -999 - user_restalarm = .false. +#ifndef W3_CESMCOUPLED + call ESMF_TimeIntervalGet( dtimestep, s=dt_cpl, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call init_is_restart_fh(mcurrTime, dt_cpl, root_task, restartfh_info) +#endif + end if !---------------- @@ -1343,14 +1439,22 @@ subroutine ModelSetRunClock(gcomp, rc) call ESMF_AlarmSet(history_alarm, clock=mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - user_histalarm = .true. else - ! If attribute is not present - write history output at native WW3 frequency - history_option = 'none' - history_n = -999 - user_histalarm = .false. + ! If attribute is not present - write history output at stride frequency + history_option = 'nseconds' + history_n = odat(3) + history_ymd = -999 + call alarmInit(mclock, history_alarm, history_option, & + opt_n = history_n, & + opt_ymd = history_ymd, & + RefTime = mStartTime, & + alarmname = 'alarm_history', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_AlarmSet(history_alarm, clock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(msgString,'(a,i10)')' History will be written at field%stride freq ',history_n + call ESMF_LogWrite(trim(subname)//trim(msgString), ESMF_LOGMSG_INFO) end if - end if !-------------------------------- @@ -1440,7 +1544,7 @@ subroutine waveinit_cesm(gcomp, ntrace, mpi_comm, mds, rc) ! local variables integer :: ierr integer :: unitn ! namelist unit number - integer :: shrlogunit + !integer :: shrlogunit logical :: isPresent, isSet real(r8) :: dtmax_in ! Maximum overall time step. real(r8) :: dtmin_in ! Minimum dynamic time step for source @@ -1557,23 +1661,6 @@ subroutine waveinit_cesm(gcomp, ntrace, mpi_comm, mds, rc) inflags2(-3) = .false. ! ice floe size end if - ! custom restart and history file names are used for CESM - use_user_histname = .true. - use_user_restname = .true. - - ! if runtype=initial, the initfile will be read in w3iorsmd - if (len_trim(inst_suffix) > 0) then - user_restfname = trim(casename)//'.ww3'//trim(inst_suffix)//'.r.' - user_histfname = trim(casename)//'.ww3'//trim(inst_suffix)//'.hi.' - else - user_restfname = trim(casename)//'.ww3.r.' - user_histfname = trim(casename)//'.ww3.hi.' - endif - - ! netcdf gridded output is used for CESM - user_netcdf_grdout = .true. - ! restart and history alarms are set for CESM by default through config - ! Read in initial/restart data and initialize the model ! ww3 read initialization occurs in w3iors (which is called by initmd in module w3initmd) ! ww3 always starts up from a 'restart' file type @@ -1604,6 +1691,7 @@ end subroutine waveinit_cesm !! ww3_shel.nml file. Calls w3init to initialize the wave model !! !! @param[in] gcomp an ESMF_GridComp object + !! @param[in] stdout the logfile unit on the root task !! @param[in] ntrace unit numbers for trace !! @param[in] mpi_comm an mpi communicator !! @param[in] mds unit numbers @@ -1611,78 +1699,62 @@ end subroutine waveinit_cesm !! !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov !> @date 01-05-2022 - subroutine waveinit_ufs( gcomp, ntrace, mpi_comm, mds, rc) + subroutine waveinit_ufs( gcomp, stdout, ntrace, mpi_comm, mds, rc) ! Initialize ww3 for ufs (called from InitializeRealize) - use w3odatmd , only : fnmpre + use w3odatmd , only : fnmpre, addrstflds, rstfldlist, rstfldcnt use w3gdatmd , only : dtcfl, dtcfli, dtmax, dtmin use w3initmd , only : w3init + use w3servmd , only : strsplit + use w3timemd , only : set_user_timestring use wav_shel_inp , only : read_shel_config use wav_shel_inp , only : npts, odat, iprt, x, y, pnames, prtfrm use wav_shel_inp , only : flgrd, flgd, flgr2, flg2 ! input/output variables type(ESMF_GridComp) :: gcomp + integer, intent(in) :: stdout integer, intent(in) :: ntrace(:) integer, intent(in) :: mpi_comm integer, intent(in) :: mds(:) integer, intent(out) :: rc ! local variables - character(len=CL) :: logmsg - logical :: isPresent, isSet - character(len=CL) :: cvalue - integer :: dt_in(4) + logical :: isPresent, isSet + character(len=CL) :: cvalue + character(len=CL) :: logmsg + character(len=CL) :: fldrst = '' + character(len=100) :: tmplist(100) = '' + integer :: dt_in(4) + integer :: i, cnt character(len=*), parameter :: subname = '(wav_comp_nuopc:wavinit_ufs)' ! ------------------------------------------------------------------- rc = ESMF_SUCCESS if (dbug_flag > 5) call ESMF_LogWrite(trim(subname)//' called', ESMF_LOGMSG_INFO) - ! restart and history alarms are optional for UFS and used via allcomp config settings - call NUOPC_CompAttributeGet(gcomp, name='user_sets_histname', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - use_user_histname=(trim(cvalue)=="true") - end if - write(logmsg,'(A,l)') trim(subname)//': Custom history names in use ',use_user_histname - call ESMF_LogWrite(trim(logmsg), ESMF_LOGMSG_INFO) - - call NUOPC_CompAttributeGet(gcomp, name='user_sets_restname', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - use_user_restname=(trim(cvalue)=="true") - end if - write(logmsg,'(A,l)') trim(subname)//': Custom restart names in use ',use_user_restname - call ESMF_LogWrite(trim(logmsg), ESMF_LOGMSG_INFO) - - call NUOPC_CompAttributeGet(gcomp, name='gridded_netcdfout', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - user_netcdf_grdout=(trim(cvalue)=="true") - end if - write(logmsg,'(A,l)') trim(subname)//': Gridded netcdf output is requested ',user_netcdf_grdout - call ESMF_LogWrite(trim(logmsg), ESMF_LOGMSG_INFO) - - if (use_user_histname) then - user_histfname = trim(casename)//'.ww3.hi.' - end if - if (use_user_restname) then - user_restfname = trim(casename)//'.ww3.r.' - end if - fnmpre = './' + if (root_task) write(stdout,'(a)') trim(subname)//' call read_shel_config' + call read_shel_config(mpi_comm, mds, time0_overwrite=time0, timen_overwrite=timen, rstfldlist=fldrst) + + ! Define any additional restart fields + if(len_trim(fldrst) > 0) then + addrstflds = .true. + call strsplit(fldrst, tmplist) + do i = 1,size(rstfldlist) + rstfldlist(i) = trim(tmplist(i)) + if (len_trim(rstfldlist(i)) > 0) rstfldcnt = rstfldcnt + 1 + end do + end if - call ESMF_LogWrite(trim(subname)//' call read_shel_config', ESMF_LOGMSG_INFO) - call read_shel_config(mpi_comm, mds, time0_overwrite=time0, timen_overwrite=timen) - - call ESMF_LogWrite(trim(subname)//' call w3init', ESMF_LOGMSG_INFO) + if (root_task) write(stdout,'(a,/)') trim(subname)//' call w3init' call w3init ( 1, .false., 'ww3', mds, ntrace, odat, flgrd, flgr2, flgd, flg2, & npts, x, y, pnames, iprt, prtfrm, mpi_comm ) - write(logmsg,'(A,4f10.2)') trim(subname)//': mod_def timesteps file ',dtmax,dtcfl,dtcfli,dtmin - call ESMF_LogWrite(trim(logmsg), ESMF_LOGMSG_INFO) + write(cvalue,'(4f10.1)')dtmax,dtcfl,dtcfli,dtmin + write(logmsg,'(a)')trim(subname)//': WW3 timesteps from mod_def '//trim(cvalue) + call NUOPC_CompAttributeGet(gcomp, name='dt_in', isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then @@ -1693,9 +1765,23 @@ subroutine waveinit_ufs( gcomp, ntrace, mpi_comm, mds, rc) dtcfl = real(dt_in(2),4) dtcfli = real(dt_in(3),4) dtmin = real(dt_in(4),4) - write(logmsg,'(A,4f10.2)') trim(subname)//': mod_def timesteps reset ',dtmax,dtcfl,dtcfli,dtmin - call ESMF_LogWrite(trim(logmsg), ESMF_LOGMSG_INFO) end if + + ! log info + if (root_task) then + write(stdout,'(a)') trim(logmsg) + write(cvalue,'(4f10.1)')dtmax,dtcfl,dtcfli,dtmin + write(stdout,'(a)') trim(subname)//': WW3 timesteps '//trim(cvalue) + + if (addrstflds) then + do i = 1,rstfldcnt + write(stdout,'(a,i3,a)') trim(subname)//': WW3 additional restart field : ',i,' '//trim(rstfldlist(i)) + end do + else + write(stdout,'(/,a)') trim(subname)//': WW3 NO additional restart fields will be written ' + end if + end if + if (dbug_flag > 5) call ESMF_LogWrite(trim(subname)//' done', ESMF_LOGMSG_INFO) end subroutine waveinit_ufs diff --git a/model/src/wav_grdout.F90 b/model/src/wav_grdout.F90 deleted file mode 100644 index 4583070d7..000000000 --- a/model/src/wav_grdout.F90 +++ /dev/null @@ -1,295 +0,0 @@ -module wav_grdout - - use w3odatmd , only: nogrp, ngrpp - - implicit none - - integer, parameter :: maxvars = 25 ! maximum number of variables/group - - private ! except - - public :: varatts - public :: outvars - public :: wavinit_grdout - - ! tag read from inp file and is used to set flogrd flags - ! var_name is the name of the variable - type :: varatts - character(len= 5) :: tag - character(len=10) :: var_name - character(len=48) :: long_name - character(len=10) :: unit_name - character(len= 2) :: dims - logical :: validout - end type varatts - - type(varatts), dimension(nogrp,maxvars) :: gridoutdefs - - type(varatts), dimension(:), allocatable :: outvars - - !=============================================================================== -contains - !=============================================================================== - - !==================================================================================== - subroutine wavinit_grdout - - use w3gdatmd , only: e3df, p2msf, us3df, usspf - use w3odatmd , only: nds, iaproc, napout - use w3iogomd , only: fldout - use w3servmd , only: strsplit - - ! local variables - character(len=100) :: inptags(100) = '' - integer :: j,k,n,nout - character(len= 12) :: ttag - - ! obtain all possible output variable tags and attributes - call initialize_gridout - - ! obtain the tags for the requested output variables - call strsplit(fldout,inptags) - - ! determine which variables are tagged for output - do k = 1,nogrp - do j = 1,maxvars - if (len_trim(gridoutdefs(k,j)%tag) > 0) then - do n = 1,len(inptags) - if (len_trim(inptags(n)) > 0) then - if (trim(inptags(n)) == trim(gridoutdefs(k,j)%tag)) gridoutdefs(k,j)%validout = .true. - end if - end do - end if - end do - end do - - ! remove requested variables which are only allocated if specific - ! options are set in mod_def (see w3adatmd, '3D arrays') - do k = 1,nogrp - do j = 1,maxvars - if (gridoutdefs(k,j)%validout) then - ttag = trim(gridoutdefs(k,j)%tag) - if (ttag == 'EF' .and. e3df(1,1) == 0) gridoutdefs(k,j)%validout = .false. - if (ttag == 'TH1M' .and. e3df(1,2) == 0) gridoutdefs(k,j)%validout = .false. - if (ttag == 'STH1M' .and. e3df(1,3) == 0) gridoutdefs(k,j)%validout = .false. - if (ttag == 'TH2M' .and. e3df(1,4) == 0) gridoutdefs(k,j)%validout = .false. - if (ttag == 'STH2M' .and. e3df(1,5) == 0) gridoutdefs(k,j)%validout = .false. - - if (ttag == 'P2L' .and. p2msf(1) == 0) gridoutdefs(k,j)%validout = .false. - if (ttag == 'USF' .and. us3df(1) == 0) gridoutdefs(k,j)%validout = .false. - if (ttag == 'USP' .and. usspf(1) == 0) gridoutdefs(k,j)%validout = .false. - end if - end do - end do - - ! determine number of output variables (not the same as the number of tags) - n = 0 - do k = 1,nogrp - do j = 1,maxvars - if (gridoutdefs(k,j)%validout) n = n+1 - end do - end do - nout = n - allocate(outvars(1:nout)) - - ! subset variables requested - n = 0 - do k = 1,nogrp - do j = 1,maxvars - if (gridoutdefs(k,j)%validout) then - n = n+1 - outvars(n) = gridoutdefs(k,j) - end if - enddo - end do - - ! check - if ( iaproc == napout ) then - write(nds(1),*) - write(nds(1),'(a)')' --------------------------------------------------' - write(nds(1),'(a)')' Requested gridded output variables : ' - write(nds(1),'(a)')' --------------------------------------------------' - write(nds(1),*) - do n = 1,nout - write(nds(1),'(i5,2a12,a50)')n,' '//trim(outvars(n)%tag), & - ' '//trim(outvars(n)%var_name), & - ' '//trim(outvars(n)%long_name) - end do - write(nds(1),*) - end if - - end subroutine wavinit_grdout - - !==================================================================================== - subroutine initialize_gridout - - gridoutdefs(:,:)%tag = "" - gridoutdefs(:,:)%var_name = "" - gridoutdefs(:,:)%long_name = "" - gridoutdefs(:,:)%unit_name = "" - gridoutdefs(:,:)%dims = "" - gridoutdefs(:,:)%validout = .false. - - ! TODO: confirm unit values - ! 1 Forcing Fields - gridoutdefs(1,1:14) = [ & - varatts( "DPT ", "DW ", "Water depth ", "m ", " ", .false.) , & - varatts( "CUR ", "CX ", "Mean current, x-component ", "m s-1 ", " ", .false.) , & - varatts( "CUR ", "CY ", "Mean current, y-component ", "m s-1 ", " ", .false.) , & - varatts( "WND ", "UAX ", "Mean wind, x-component ", "m s-1 ", " ", .false.) , & - varatts( "WND ", "UAY ", "Mean wind, y-component ", "m s-1 ", " ", .false.) , & - varatts( "AST ", "AS ", "Air-sea temperature difference ", "K ", " ", .false.) , & - varatts( "WLV ", "WLV ", "Water levels ", "m ", " ", .false.) , & - varatts( "ICE ", "ICE ", "Ice coverage ", "nd ", " ", .false.) , & - varatts( "IBG ", "BERG ", "Iceberg-induced damping ", "km-1 ", " ", .false.) , & - varatts( "TAUA ", "TAUAX ", "Atm momentum x ", "Pa ", " ", .false.) , & - varatts( "TAUA ", "TAUAY ", "Atm momentum y ", "Pa ", " ", .false.) , & - varatts( "RHO ", "RHOAIR ", "Air density ", "kg m-3 ", " ", .false.) , & - varatts( "IC1 ", "ICEH ", "Ice thickness ", "m ", " ", .false.) , & - varatts( "IC5 ", "ICEF ", "Ice floe diameter ", "m ", " ", .false.) & - ] - - ! 2 Standard mean wave Parameters - gridoutdefs(2,1:18) = [ & - varatts( "HS ", "HS ", "Significant wave height ", "m ", " ", .false.) , & - varatts( "LM ", "WLM ", "Mean wave length ", "m ", " ", .false.) , & - varatts( "T02 ", "T02 ", "Mean wave period (Tm0,2) ", "s ", " ", .false.) , & - varatts( "T0M1 ", "T0M1 ", "Mean wave period (Tm0,-1) ", "s ", " ", .false.) , & - varatts( "T01 ", "T01 ", "Mean wave period (Tm0,1) ", "s ", " ", .false.) , & - varatts( "FP ", "FP0 ", "Peak frequency ", "s-1 ", " ", .false.) , & - varatts( "DIR ", "THM ", "Mean wave direction ", "rad ", " ", .false.) , & - varatts( "SPR ", "THS ", "Mean directional spread ", "rad ", " ", .false.) , & - varatts( "DP ", "THP0 ", "Peak direction ", "rad ", " ", .false.) , & - varatts( "HIG ", "HSIG ", "Infragravity height ", "m ", " ", .false.) , & - varatts( "MXE ", "STMAXE ", "Max surface elev (STE) ", "m ", " ", .false.) , & - varatts( "MXES ", "STMAXD ", "St Dev Max surface elev (STE) ", "m ", " ", .false.) , & - varatts( "MXH ", "HMAXE ", "Max wave height (S.) ", "m ", " ", .false.) , & - varatts( "MXHC ", "HCMAXE ", "Max wave height from crest (STE) ", "m ", " ", .false.) , & - varatts( "SDMH ", "HMAXD ", "St Dev of MXC (STE) ", "m ", " ", .false.) , & - varatts( "SDMHC", "HCMAXD ", "St Dev of MXHC (STE) ", "m ", " ", .false.) , & - varatts( "WBT ", "WBT ", "Dominant wave breaking probability (b_T) ", "nd ", " ", .false.) , & - varatts( "WNM ", "WNMEAN ", "Mean wave number ", "m-1 ", " ", .false.) & - ] - - ! 3 Spectral Parameters - gridoutdefs(3,1:6) = [ & - varatts( "EF ", "EF ", "1D spectral density ", "m2 s ", "k ", .false.) , & - varatts( "TH1M ", "TH1M ", "Mean wave direction from a1,b2 ", "deg ", "k ", .false.) , & - varatts( "STH1M", "STH1M ", "Directional spreading from a1,b2 ", "deg ", "k ", .false.) , & - varatts( "TH2M ", "TH2M ", "Mean wave direction from a2,b2 ", "deg ", "k ", .false.) , & - varatts( "STH2M", "STH2M ", "Directional spreading from a2,b2 ", "deg ", "k ", .false.) , & - !TODO: has reverse indices (nk,nsea) - varatts( "WN ", "WN ", "Wavenumber array ", "m-1 ", "k ", .false.) & - ] - - ! 4 Spectral Partition Parameters - gridoutdefs(4,1:17) = [ & - varatts( "PHS ", "PHS ", "Partitioned wave heights ", "m ", "s ", .false.) , & - varatts( "PTP ", "PTP ", "Partitioned peak period ", "s ", "s ", .false.) , & - varatts( "PLP ", "PLP ", "Partitioned peak wave length ", "m ", "s ", .false.) , & - varatts( "PDIR ", "PDIR ", "Partitioned mean direction ", "deg ", "s ", .false.) , & - varatts( "PSPR ", "PSI ", "Partitioned mean directional spread ", "deg ", "s ", .false.) , & - varatts( "PWS ", "PWS ", "Partitioned wind sea fraction ", "nd ", "s ", .false.) , & - varatts( "PDP ", "PTHP0 ", "Peak wave direction of partition ", "deg ", "s ", .false.) , & - varatts( "PQP ", "PQP ", "Goda peakdedness parameter of partition ", "nd ", "s ", .false.) , & - varatts( "PPE ", "PPE ", "JONSWAP peak enhancement factor of partition ", "s-1 ", "s ", .false.) , & - varatts( "PGW ", "PGW ", "Gaussian frequency width of partition ", "nd ", "s ", .false.) , & - varatts( "PSW ", "PSW ", "Spectral width of partition ", "nd ", "s ", .false.) , & - varatts( "PTM10", "PTM1 ", "Mean wave period (m-1,0) of partition ", "s ", "s ", .false.) , & - varatts( "PT01 ", "PT1 ", "Mean wave period (m0,1) of partition ", "s ", "s ", .false.) , & - varatts( "PT02 ", "PT2 ", "Mean wave period (m0,2) of partition ", "s ", "s ", .false.) , & - varatts( "PEP ", "PEP ", "Peak spectral density of partition ", "m2 s rad-1", "s ", .false.) , & - varatts( "TWS ", "PWST ", "Total wind sea fraction ", "nd ", " ", .false.) , & - varatts( "PNR ", "PNR ", "Number of partitions ", "nd ", " ", .false.) & - ] - - ! 5 Atmosphere-waves layer - gridoutdefs(5,1:14) = [ & - varatts( "UST ", "USTX ", "Friction velocity x ", "m s-1 ", " ", .false.) , & - varatts( "UST ", "USTY ", "Friction velocity y ", "m s-1 ", " ", .false.) , & - varatts( "CHA ", "CHARN ", "Charnock parameter ", "nd ", " ", .false.) , & - varatts( "CGE ", "CGE ", "Energy flux ", "kW m-1 ", " ", .false.) , & - varatts( "FAW ", "PHIAW ", "Air-sea energy flux ", "W m-2 ", " ", .false.) , & - varatts( "TAW ", "TAUWIX ", "Net wave-supported stress x ", "m2 s-2 ", " ", .false.) , & - varatts( "TAW ", "TAUWIY ", "Net wave-supported stress y ", "m2 s-2 ", " ", .false.) , & - varatts( "TWA ", "TAUWNX ", "Negative part of the wave-supported stress x ", "m2 s-2 ", " ", .false.) , & - varatts( "TWA ", "TAUWNY ", "Negative part of the wave-supported stress y ", "m2 s-2 ", " ", .false.) , & - varatts( "WCC ", "WCC ", "Whitecap coverage ", "nd ", " ", .false.) , & - varatts( "WCF ", "WCF ", "Whitecap foam thickness ", "m ", " ", .false.) , & - varatts( "WCH ", "WCH ", "Mean breaking wave heigh ", "m ", " ", .false.) , & - varatts( "WCM ", "WCM ", "Whitecap moment ", "nd ", " ", .false.) , & - varatts( "FWS ", "TWS ", "Wind sea mean period ", "s ", " ", .false.) & - ] - - ! 6 Wave-ocean layer - gridoutdefs(6,1:25) = [ & - varatts( "SXY ", "SXX ", "Radiation stresses xx ", "N m-1 ", " ", .false.) , & - varatts( "SXY ", "SYY ", "Radiation stresses yy ", "N m-1 ", " ", .false.) , & - varatts( "SXY ", "SXY ", "Radiation stresses xy ", "N m-1 ", " ", .false.) , & - varatts( "TWO ", "TAUOX ", "Wave to ocean momentum flux x ", "m2 s-2 ", " ", .false.) , & - varatts( "TWO ", "TAUOY ", "Wave to ocean momentum flux y ", "m2 s-2 ", " ", .false.) , & - varatts( "BHD ", "BHD ", "Bernoulli head (J term) ", "m2 s-2 ", " ", .false.) , & - varatts( "FOC ", "PHIOC ", "Wave to ocean energy flux ", "W m-2 ", " ", .false.) , & - varatts( "TUS ", "TUSX ", "Stokes transport x ", "m2 s-1 ", " ", .false.) , & - varatts( "TUS ", "TUSY ", "Stokes transport y ", "m2 s-1 ", " ", .false.) , & - varatts( "USS ", "USSX ", "Surface Stokes drift x ", "m s-1 ", " ", .false.) , & - varatts( "USS ", "USSY ", "Surface Stokes drift y ", "m s-1 ", " ", .false.) , & - varatts( "P2S ", "PRMS ", "Second-order sum pressure ", "m4 ", " ", .false.) , & - varatts( "P2S ", "TPMS ", "Second-order sum pressure ", "s-1 ", " ", .false.) , & - varatts( "USF ", "US3DX ", "Spectrum of surface Stokes drift x ", "m s-1 Hz-1", "k ", .false.) , & - varatts( "USF ", "US3DY ", "Spectrum of surface Stokes drift y ", "m s-1 Hz-1", "k ", .false.) , & - varatts( "P2L ", "P2SMS ", "Micro seism source term ", "Pa2 m2 s ", "m ", .false.) , & - varatts( "TWI ", "TAUICEX ", "Wave to sea ice stress x ", "m2 s-2 ", " ", .false.) , & - varatts( "TWI ", "TAUICEY ", "Wave to sea ice stress y ", "m2 s-2 ", " ", .false.) , & - varatts( "FIC ", "PHICE ", "Wave to sea ice energy flux ", "W m-2 ", " ", .false.) , & - varatts( "USP ", "USSPX ", "Partitioned surface Stokes drift x ", "m s-1 ", "p ", .false.) , & - varatts( "USP ", "USSPY ", "Partitioned surface Stokes drift y ", "m s-1 ", "p ", .false.) , & - varatts( "TWC ", "TAUOCX ", "Total wave to ocean stress x ", "Pa ", " ", .false.) , & - varatts( "TWC ", "TAUOCY ", "Total wave to ocean stress y ", "Pa ", " ", .false.) , & - varatts( "USSH ", "USSHX ", "Surface layer averaged Stokes drift x ", "m s-1 ", " ", .false.) , & - varatts( "USSH ", "USSHY ", "Surface layer averaged Stokes drift y ", "m s-1 ", " ", .false.) & - ] - - ! 7 Wave-bottom layer - gridoutdefs(7,1:10) = [ & - varatts( "ABR ", "ABAX ", "Near bottom rms wave excursion amplitudes x ", "m ", " ", .false.) , & - varatts( "ABR ", "ABAY ", "Near bottom rms wave excursion amplitudes y ", "m ", " ", .false.) , & - varatts( "UBR ", "UBAX ", "Near bottom rms wave velocities x ", "m s-1 ", " ", .false.) , & - varatts( "UBR ", "UBAY ", "Near bottom rms wave velocities y ", "m s-1 ", " ", .false.) , & - varatts( "BED ", "BED ", "Bottom roughness ", "m ", " ", .false.) , & - varatts( "BED ", "RIPPLEX ", "Sea bottom ripple wavelength x ", "m ", " ", .false.) , & - varatts( "BED ", "RIPPLEY ", "Sea bottom ripple wavelength y ", "m ", " ", .false.) , & - varatts( "FBB ", "PHIBBL ", "Energy flux due to bottom friction ", "W m-2 ", " ", .false.) , & - varatts( "TBB ", "TAUBBLX ", "Momentum flux due to bottom friction x ", "m2 s-2 ", " ", .false.) , & - varatts( "TBB ", "TAUBBLY ", "Momentum flux due to bottom friction y ", "m2 s-2 ", " ", .false.) & - ] - - ! 8 Spectrum parameters - gridoutdefs(8,1:9) = [ & - varatts( "MSS ", "MSSX ", "Surface mean square slope x ", "nd ", " ", .false.) , & - varatts( "MSS ", "MSSY ", "Surface mean square slope y ", "nd ", " ", .false.) , & - varatts( "MSC ", "MSCX ", "Spectral level at high frequency tail x ", "nd ", " ", .false.) , & - varatts( "MSC ", "MSCY ", "Spectral level at high frequency tail y ", "nd ", " ", .false.) , & - varatts( "WL02 ", "WL02X ", "East/X North/Y mean wavelength component ", "nd ", " ", .false.) , & - varatts( "WL02 ", "WL02Y ", "East/X North/Y mean wavelength component ", "nd ", " ", .false.) , & - varatts( "AXT ", "ALPXT ", "Correl sea surface gradients (x,t) ", "nd ", " ", .false.) , & - varatts( "AYT ", "ALPYT ", "Correl sea surface gradients (y,t) ", "nd ", " ", .false.) , & - varatts( "AXY ", "ALPXY ", "Correl sea surface gradients (x,y) ", "nd ", " ", .false.) & - ] - - ! 9 Numerical diagnostics - gridoutdefs(9,1:5) = [ & - varatts( "DTD ", "DTDYN ", "Average time step in integration ", "min ", " ", .false.) , & - varatts( "FC ", "FCUT ", "Cut-off frequency ", "s-1 ", " ", .false.) , & - varatts( "CFX ", "CFLXYMAX ", "Max. CFL number for spatial advection ", "nd ", " ", .false.) , & - varatts( "CFD ", "CFLTHMAX ", "Max. CFL number for theta-advection ", "nd ", " ", .false.) , & - varatts( "CFK ", "CFLKMAX ", "Max. CFL number for k-advection ", "nd ", " ", .false.) & - ] - - ! 10 User defined - gridoutdefs(10,1:2) = [ & - varatts( "U1 ", "U1 ", "User defined 1 ", "nd ", " ", .false.) , & - varatts( "U2 ", "U2 ", "User defined 2 ", "nd ", " ", .false.) & - ] - end subroutine initialize_gridout -end module wav_grdout diff --git a/model/src/wav_history_mod.F90 b/model/src/wav_history_mod.F90 new file mode 100644 index 000000000..e7a3e71a9 --- /dev/null +++ b/model/src/wav_history_mod.F90 @@ -0,0 +1,914 @@ +!> @file wav_history_mod +!! +!> @brief Manage gridded model output as netCDF using PIO +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 +module wav_history_mod + + use constants , only : rade + use w3parall , only : init_get_isea + use w3gdatmd , only : xgrd, ygrd + use w3gdatmd , only : nk, nx, ny, mapsf, mapsta, nsea + use w3odatmd , only : undef + use w3adatmd , only : mpi_comm_wave + use wav_import_export , only : nseal_cpl + use wav_pio_mod , only : pio_iotype, pio_ioformat, wav_pio_subsystem + use wav_pio_mod , only : handle_err, wav_pio_initdecomp + use pio + use netcdf + + implicit none + + private + + public :: wav_history_init + public :: write_history + public :: varatts + public :: outvars + + ! used/reused in module + integer :: isea, jsea, ix, iy, ierr + + real, allocatable, target :: var3ds(:,:) + real, allocatable, target :: var3dm(:,:) + real, allocatable, target :: var3dp(:,:) + real, allocatable, target :: var3dk(:,:) + + ! output variable for (nx,ny,nz) fields + real, pointer :: var3d(:,:) + + type(file_desc_t) :: pioid + type(var_desc_t) :: varid + type(io_desc_t) :: iodesc2d !2d only + type(io_desc_t) :: iodesc2dint !2d only, integer + type(io_desc_t) :: iodesc3ds !s-axis variables + type(io_desc_t) :: iodesc3dm !m-axis variables + type(io_desc_t) :: iodesc3dp !p-axis variables + type(io_desc_t) :: iodesc3dk !k-axis variables + + ! variable attributes + type :: varatts + character(len= 5) :: tag + character(len=10) :: var_name + character(len=48) :: long_name + character(len=10) :: unit_name + character(len= 2) :: dims + logical :: validout + end type varatts + + type(varatts), dimension(:), allocatable :: outvars + + !=============================================================================== +contains + !=============================================================================== + !> Write the requested list of fields using parallel netCDF via PIO + !! + !! @param[in] timen the timestamp for the file + !! + !> author DeniseWorthen@noaa.gov + !> @date 08-26-2024 + subroutine write_history ( timen ) + + use w3odatmd , only : fnmpre + use w3gdatmd , only : filext, trigp, ntri, ungtype, gtype + use w3servmd , only : extcde + use w3wdatmd , only : wlv, ice, icef, iceh, berg, ust, ustdir, asf, rhoair + use w3gdatmd , only : e3df, p2msf, us3df, usspf + use w3odatmd , only : noswll + use w3odatmd , only : ndso, iaproc + use w3adatmd , only : dw, ua, ud, as, cx, cy, taua, tauadir + use w3adatmd , only : hs, wlm, t02, t0m1, t01, fp0, thm, ths, thp0, wbt, wnmean + use w3adatmd , only : dtdyn + use w3adatmd , only : fcut, aba, abd, uba, ubd, sxx, syy, sxy + use w3adatmd , only : phs, ptp, plp, pdir, psi, pws, pwst, pnr + use w3adatmd , only : pthp0, pqp, ppe, pgw, psw, ptm1, pt1, pt2 + use w3adatmd , only : pep, tauox, tauoy, tauwix, tauwiy + use w3adatmd , only : phiaw, phioc, tusx, tusy, prms, tpms + use w3adatmd , only : ussx, ussy, mssx, mssy, mscx, mscy + use w3adatmd , only : tauwnx, tauwny, charn, tws, bhd + use w3adatmd , only : phibbl, taubbl, whitecap, bedforms, cge, ef + use w3adatmd , only : cflxymax, cflthmax, cflkmax, p2sms, us3d + use w3adatmd , only : hsig, phice, tauice + use w3adatmd , only : stmaxe, stmaxd, hmaxe, hcmaxe, hmaxd, hcmaxd, ussp, tauocx, tauocy + use w3adatmd , only : usshx, usshy + + use w3timemd , only : set_user_timestring + use w3odatmd , only : time_origin, calendar_name, elapsed_secs + use w3odatmd , only : user_histfname + !TODO: use unstr_mesh from wav_shr_mod; currently fails due to CI + !use wav_shr_mod , only : unstr_mesh + + integer, intent(in) :: timen(2) + + ! local variables + integer ,target :: dimid3(3) + integer ,target :: dimid4(4) + integer ,pointer :: dimid(:) + character(len=1024) :: fname + character(len=12) :: vname + character(len=16) :: user_timestring !YYYY-MM-DD-SSSSS + + integer :: n, xtid, ytid, xeid, ztid, stid, mtid, ptid, ktid, timid, nmode + integer :: len_s, len_m, len_p, len_k + logical :: s_axis = .false., m_axis = .false., p_axis = .false., k_axis = .false. + + integer :: lmap(nseal_cpl) + + ! ------------------------------------------------------------- + ! create the netcdf file + ! ------------------------------------------------------------- + + ! native WW3 file naming + if (len_trim(user_histfname) == 0) then + write(fname,'(a,i8.8,a1,i6.6,a)')trim(fnmpre),timen(1),'.',timen(2),'.out_grd.ww3.nc' + else + call set_user_timestring(timen,user_timestring) + fname = trim(user_histfname)//trim(user_timestring)//'.nc' + end if + + pioid%fh = -1 + nmode = pio_clobber + ! only applies to classic NETCDF files. + if (pio_iotype == PIO_IOTYPE_NETCDF .or. pio_iotype == PIO_IOTYPE_PNETCDF) then + nmode = ior(nmode,pio_ioformat) + endif + ierr = pio_createfile(wav_pio_subsystem, pioid, pio_iotype, trim(fname), nmode) + call handle_err(ierr, 'pio_create') + if (iaproc == 1) write(ndso,'(a)')' Writing history file '//trim(fname) + + len_s = noswll + 1 ! 0:noswll + len_m = p2msf(3)-p2msf(2) + 1 ! ? + len_p = usspf(2) ! partitions + len_k = e3df(3,1) - e3df(2,1) + 1 ! frequencies + + ! define the dimensions required for the requested gridded fields + do n = 1,size(outvars) + if (outvars(n)%validout) then + if(trim(outvars(n)%dims) == 's')s_axis = .true. + if(trim(outvars(n)%dims) == 'm')m_axis = .true. + if(trim(outvars(n)%dims) == 'p')p_axis = .true. + if(trim(outvars(n)%dims) == 'k')k_axis = .true. + end if + end do + + ! allocate arrays if needed + if (s_axis) allocate(var3ds(1:nseal_cpl,len_s)) + if (m_axis) allocate(var3dm(1:nseal_cpl,len_m)) + if (p_axis) allocate(var3dp(1:nseal_cpl,len_p)) + if (k_axis) allocate(var3dk(1:nseal_cpl,len_k)) + + ierr = pio_def_dim(pioid, 'nx', nx, xtid) + ierr = pio_def_dim(pioid, 'ny', ny, ytid) + ierr = pio_def_dim(pioid, 'time', PIO_UNLIMITED, timid) + + if (s_axis) ierr = pio_def_dim(pioid, 'noswll', len_s, stid) + if (m_axis) ierr = pio_def_dim(pioid, 'nm' , len_m, mtid) + if (p_axis) ierr = pio_def_dim(pioid, 'np' , len_p, ptid) + if (k_axis) ierr = pio_def_dim(pioid, 'freq' , len_k, ktid) + if (gtype .eq. ungtype) then + ierr = pio_def_dim(pioid, 'ne' , ntri, xeid) + ierr = pio_def_dim(pioid, 'nn' , 3, ztid) + end if + + ! define the time variable + ierr = pio_def_var(pioid, 'time', PIO_DOUBLE, (/timid/), varid) + call handle_err(ierr,'def_timevar') + ierr = pio_put_att(pioid, varid, 'units', trim(time_origin)) + call handle_err(ierr,'def_time_units') + ierr = pio_put_att(pioid, varid, 'calendar', trim(calendar_name)) + call handle_err(ierr,'def_time_calendar') + + ! define the spatial axis variables (lat,lon) + ierr = pio_def_var(pioid, 'lon', PIO_DOUBLE, (/xtid,ytid/), varid) + call handle_err(ierr,'def_lonvar') + ierr = pio_put_att(pioid, varid, 'units', 'degrees_east') + ierr = pio_def_var(pioid, 'lat', PIO_DOUBLE, (/xtid,ytid/), varid) + call handle_err(ierr,'def_latvar') + ierr = pio_put_att(pioid, varid, 'units', 'degrees_north') + + ! add mapsta + ierr = pio_def_var(pioid, 'mapsta', PIO_INT, (/xtid, ytid, timid/), varid) + call handle_err(ierr, 'def_mapsta') + ierr = pio_put_att(pioid, varid, 'units', 'unitless') + ierr = pio_put_att(pioid, varid, 'long_name', 'map status') + ierr = pio_put_att(pioid, varid, '_FillValue', nf90_fill_int) + + if (gtype .eq. ungtype) then + ierr = pio_def_var(pioid, 'nconn', PIO_INT, (/ztid,xeid/), varid) + call handle_err(ierr,'def_nodeconnections') + ierr = pio_put_att(pioid, varid, 'units', 'unitless') + ierr = pio_put_att(pioid, varid, 'long_name', 'node connectivity') + end if + + ! define the variables + dimid3(1:2) = (/xtid, ytid/) + dimid4(1:2) = (/xtid, ytid/) + do n = 1,size(outvars) + if (trim(outvars(n)%dims) == 's') then + dimid4(3:4) = (/stid, timid/) + dimid => dimid4 + else if (trim(outvars(n)%dims) == 'm') then + dimid4(3:4) = (/mtid, timid/) + dimid => dimid4 + else if (trim(outvars(n)%dims) == 'p') then + dimid4(3:4) = (/ptid, timid/) + dimid => dimid4 + else if (trim(outvars(n)%dims) == 'k') then + dimid4(3:4) = (/ktid, timid/) + dimid => dimid4 + else + dimid3(3) = timid + dimid => dimid3 + end if + + ierr = pio_def_var(pioid, trim(outvars(n)%var_name), PIO_REAL, dimid, varid) + call handle_err(ierr, 'define variable '//trim((outvars(n)%var_name))) + ierr = pio_put_att(pioid, varid, 'units' , trim(outvars(n)%unit_name)) + ierr = pio_put_att(pioid, varid, 'long_name' , trim(outvars(n)%long_name)) + ierr = pio_put_att(pioid, varid, '_FillValue', undef) + end do + ! end variable definitions + ierr = pio_enddef(pioid) + call handle_err(ierr, 'end variable definition') + + call wav_pio_initdecomp(iodesc2d) + call wav_pio_initdecomp(iodesc2dint, use_int=.true.) + if (s_axis)call wav_pio_initdecomp(len_s, iodesc3ds) + if (m_axis)call wav_pio_initdecomp(len_m, iodesc3dm) + if (p_axis)call wav_pio_initdecomp(len_p, iodesc3dp) + if (k_axis)call wav_pio_initdecomp(len_k, iodesc3dk) + + ! write the time and spatial axis values (lat,lon,time) + ierr = pio_inq_varid(pioid, 'lat', varid) + call handle_err(ierr, 'inquire variable lat ') + ierr = pio_put_var(pioid, varid, transpose(ygrd)) + call handle_err(ierr, 'put lat') + + ierr = pio_inq_varid(pioid, 'lon', varid) + call handle_err(ierr, 'inquire variable lon ') + ierr = pio_put_var(pioid, varid, transpose(xgrd)) + call handle_err(ierr, 'put lon') + + ierr = pio_inq_varid(pioid, 'time', varid) + call handle_err(ierr, 'inquire variable time ') + ierr = pio_put_var(pioid, varid, (/1/), real(elapsed_secs,8)) + call handle_err(ierr, 'put time') + + if (gtype .eq. ungtype) then + ierr = pio_inq_varid(pioid, 'nconn', varid) + call handle_err(ierr, 'inquire variable nconn ') + ierr = pio_put_var(pioid, varid, trigp) + call handle_err(ierr, 'put trigp') + end if + + ! TODO: tried init decomp w/ use_int=.true. but getting garbage + ! land values....sea values OK + ! mapsta is global + lmap(:) = 0 + do jsea = 1,nseal_cpl + call init_get_isea(isea, jsea) + ix = mapsf(isea,1) + iy = mapsf(isea,2) + lmap(jsea) = mapsta(iy,ix) + end do + ierr = pio_inq_varid(pioid, 'mapsta', varid) + call handle_err(ierr, 'inquire variable mapsta ') + call pio_setframe(pioid, varid, int(1,kind=Pio_Offset_Kind)) + call pio_write_darray(pioid, varid, iodesc2dint, lmap, ierr) + call handle_err(ierr, 'put variable mapsta') + + ! write the requested variables + do n = 1,size(outvars) + vname = trim(outvars(n)%var_name) + if (trim(outvars(n)%dims) == 's') then + var3d => var3ds + ! Group 4 + if(vname .eq. 'PHS') call write_var3d(iodesc3ds, vname, phs (1:nseal_cpl,0:noswll) ) + if(vname .eq. 'PTP') call write_var3d(iodesc3ds, vname, ptp (1:nseal_cpl,0:noswll) ) + if(vname .eq. 'PLP') call write_var3d(iodesc3ds, vname, plp (1:nseal_cpl,0:noswll) ) + if(vname .eq. 'PDIR') call write_var3d(iodesc3ds, vname, pdir (1:nseal_cpl,0:noswll), fldir='true' ) + if(vname .eq. 'PSI') call write_var3d(iodesc3ds, vname, psi (1:nseal_cpl,0:noswll), fldir='true' ) + if(vname .eq. 'PWS') call write_var3d(iodesc3ds, vname, pws (1:nseal_cpl,0:noswll) ) + if(vname .eq. 'PDP') call write_var3d(iodesc3ds, vname, pthp0 (1:nseal_cpl,0:noswll), fldir='true' ) + if(vname .eq. 'PQP') call write_var3d(iodesc3ds, vname, pqp (1:nseal_cpl,0:noswll) ) + if(vname .eq. 'PPE') call write_var3d(iodesc3ds, vname, ppe (1:nseal_cpl,0:noswll) ) + if(vname .eq. 'PGW') call write_var3d(iodesc3ds, vname, pgw (1:nseal_cpl,0:noswll) ) + if(vname .eq. 'PSW') call write_var3d(iodesc3ds, vname, psw (1:nseal_cpl,0:noswll) ) + if(vname .eq. 'PTM1') call write_var3d(iodesc3ds, vname, ptm1 (1:nseal_cpl,0:noswll) ) + if(vname .eq. 'PT1') call write_var3d(iodesc3ds, vname, pt1 (1:nseal_cpl,0:noswll) ) + if(vname .eq. 'PT2') call write_var3d(iodesc3ds, vname, pt2 (1:nseal_cpl,0:noswll) ) + if(vname .eq. 'PEP') call write_var3d(iodesc3ds, vname, pep (1:nseal_cpl,0:noswll) ) + + else if (trim(outvars(n)%dims) == 'm') then ! m axis + var3d => var3dm + ! Group 6 + if (vname .eq. 'P2SMS') call write_var3d(iodesc3dm, vname, p2sms (1:nseal_cpl,p2msf(2):p2msf(3)) ) + + else if (trim(outvars(n)%dims) == 'p') then ! partition axis + var3d => var3dp + ! Group 6 + if (vname .eq. 'USSPX') call write_var3d(iodesc3dp, vname, ussp (1:nseal_cpl, 1:usspf(2)) ) + if (vname .eq. 'USSPY') call write_var3d(iodesc3dp, vname, ussp (1:nseal_cpl,nk+1:nk+usspf(2)) ) + + else if (trim(outvars(n)%dims) == 'k') then ! freq axis + var3d => var3dk + ! Group 3 + if(vname .eq. 'EF') call write_var3d(iodesc3dk, vname, ef (1:nseal_cpl,e3df(2,1):e3df(3,1)) ) + if(vname .eq. 'TH1M') call write_var3d(iodesc3dk, vname, ef (1:nseal_cpl,e3df(2,2):e3df(3,2)) ) + if(vname .eq. 'STH1M') call write_var3d(iodesc3dk, vname, ef (1:nseal_cpl,e3df(2,3):e3df(3,3)) ) + if(vname .eq. 'TH2M') call write_var3d(iodesc3dk, vname, ef (1:nseal_cpl,e3df(2,4):e3df(3,4)) ) + if(vname .eq. 'STH2M') call write_var3d(iodesc3dk, vname, ef (1:nseal_cpl,e3df(2,5):e3df(3,5)) ) + !TODO: wn has reversed indices (1:nk, 1:nseal_cpl) + ! Group 6 + if (vname .eq. 'US3DX') call write_var3d(iodesc3dk, vname, us3d (1:nseal_cpl, us3df(2):us3df(3)) ) + if (vname .eq. 'US3DY') call write_var3d(iodesc3dk, vname, us3d (1:nseal_cpl,nk+us3df(2):nk+us3df(3)) ) + + else + ! Group 1 + if (vname .eq. 'DW') call write_var2d(vname, dw (1:nsea), init0='false', global='true') + if (vname .eq. 'CX') call write_var2d(vname, cx (1:nsea), init0='false', global='true') + if (vname .eq. 'CY') call write_var2d(vname, cy (1:nsea), init0='false', global='true') + if (vname .eq. 'UAX') call write_var2d(vname, ua (1:nsea), dir=cos(ud(1:nsea)), init0='false', global='true') + if (vname .eq. 'UAY') call write_var2d(vname, ua (1:nsea), dir=sin(ud(1:nsea)), init0='false', global='true') + if (vname .eq. 'AS') call write_var2d(vname, as (1:nsea), init0='false', global='true') + if (vname .eq. 'WLV') call write_var2d(vname, wlv (1:nsea), init0='false', global='true') + if (vname .eq. 'ICE') call write_var2d(vname, ice (1:nsea), init0='false', global='true') + if (vname .eq. 'IBG') call write_var2d(vname, berg (1:nsea), init0='false', global='true') + if (vname .eq. 'TAUX') call write_var2d(vname, taua (1:nsea), dir=cos(tauadir(1:nsea)), init0='false', global='true') + if (vname .eq. 'TAUY') call write_var2d(vname, taua (1:nsea), dir=sin(tauadir(1:nsea)), init0='false', global='true') + if (vname .eq. 'RHOAIR') call write_var2d(vname, rhoair (1:nsea), init0='false', global='true') + if (vname .eq. 'ICEH') call write_var2d(vname, iceh (1:nsea), init0='false', global='true') + if (vname .eq. 'ICEF') call write_var2d(vname, icef (1:nsea), init0='false', global='true') + + ! Group 2 + if (vname .eq. 'HS') call write_var2d(vname, hs (1:nseal_cpl) ) + if (vname .eq. 'WLM') call write_var2d(vname, wlm (1:nseal_cpl) ) + if (vname .eq. 'T02') call write_var2d(vname, t02 (1:nseal_cpl) ) + if (vname .eq. 'T0M1') call write_var2d(vname, t0m1 (1:nseal_cpl) ) + if (vname .eq. 'T01') call write_var2d(vname, t01 (1:nseal_cpl) ) + if (vname .eq. 'FP0') call write_var2d(vname, fp0 (1:nseal_cpl) ) + if (vname .eq. 'THM') call write_var2d(vname, thm (1:nseal_cpl), fldir='true' ) + if (vname .eq. 'THS') call write_var2d(vname, ths (1:nseal_cpl), fldir='true' ) + if (vname .eq. 'THP0') call write_var2d(vname, thp0 (1:nseal_cpl), fldir='true' ) + if (vname .eq. 'HSIG') call write_var2d(vname, hsig (1:nseal_cpl) ) + if (vname .eq. 'STMAXE') call write_var2d(vname, stmaxe (1:nseal_cpl) ) + if (vname .eq. 'STMAXD') call write_var2d(vname, stmaxd (1:nseal_cpl) ) + if (vname .eq. 'HMAXE') call write_var2d(vname, hmaxe (1:nseal_cpl) ) + if (vname .eq. 'HCMAXE') call write_var2d(vname, hcmaxe (1:nseal_cpl) ) + if (vname .eq. 'HMAXD') call write_var2d(vname, hmaxd (1:nseal_cpl) ) + if (vname .eq. 'HCMAXD') call write_var2d(vname, hcmaxd (1:nseal_cpl) ) + if (vname .eq. 'WBT') call write_var2d(vname, wbt (1:nseal_cpl) ) + if (vname .eq. 'WNMEAN') call write_var2d(vname, wnmean (1:nseal_cpl), init0='false') + + ! Group 4 + if(vname .eq. 'PWST') call write_var2d(vname, pwst (1:nseal_cpl) ) + if(vname .eq. 'PNR') call write_var2d(vname, pnr (1:nseal_cpl) ) + + ! Group 5 + if (vname .eq. 'USTX') call write_var2d(vname, ust (1:nseal_cpl)*asf(1:nseal_cpl), dir=cos(ustdir(1:nseal_cpl)), usemask='true') + if (vname .eq. 'USTY') call write_var2d(vname, ust (1:nseal_cpl)*asf(1:nseal_cpl), dir=sin(ustdir(1:nseal_cpl)), usemask='true') + if (vname .eq. 'CHARN') call write_var2d(vname, charn (1:nseal_cpl) ) + if (vname .eq. 'CGE') call write_var2d(vname, cge (1:nseal_cpl) ) + if (vname .eq. 'PHIAW') call write_var2d(vname, phiaw (1:nseal_cpl), init2='true') + if (vname .eq. 'TAUWIX') call write_var2d(vname, tauwix (1:nseal_cpl), init2='true') + if (vname .eq. 'TAUWIY') call write_var2d(vname, tauwiy (1:nseal_cpl), init2='true') + if (vname .eq. 'TAUWNX') call write_var2d(vname, tauwnx (1:nseal_cpl), init2='true') + if (vname .eq. 'TAUWNY') call write_var2d(vname, tauwny (1:nseal_cpl), init2='true') + if (vname .eq. 'WCC') call write_var2d(vname, whitecap (1:nseal_cpl,1), init2='true') + if (vname .eq. 'WCF') call write_var2d(vname, whitecap (1:nseal_cpl,2), init2='true') + if (vname .eq. 'WCH') call write_var2d(vname, whitecap (1:nseal_cpl,3), init2='true') + if (vname .eq. 'WCM') call write_var2d(vname, whitecap (1:nseal_cpl,4), init2='true') + if (vname .eq. 'TWS') call write_var2d(vname, tws (1:nseal_cpl) ) + + ! Group 6 + if (vname .eq. 'SXX') call write_var2d(vname, sxx (1:nseal_cpl) ) + if (vname .eq. 'SYY') call write_var2d(vname, syy (1:nseal_cpl) ) + if (vname .eq. 'SXY') call write_var2d(vname, sxy (1:nseal_cpl) ) + if (vname .eq. 'TAUOX') call write_var2d(vname, tauox (1:nseal_cpl), init2='true') + if (vname .eq. 'TAUOY') call write_var2d(vname, tauoy (1:nseal_cpl), init2='true') + if (vname .eq. 'BHD') call write_var2d(vname, bhd (1:nseal_cpl) ) + if (vname .eq. 'PHIOC') call write_var2d(vname, phioc (1:nseal_cpl), init2='true') + if (vname .eq. 'TUSX') call write_var2d(vname, tusx (1:nseal_cpl) ) + if (vname .eq. 'TUSY') call write_var2d(vname, tusy (1:nseal_cpl) ) + if (vname .eq. 'USSX') call write_var2d(vname, ussx (1:nseal_cpl) ) + if (vname .eq. 'USSY') call write_var2d(vname, ussy (1:nseal_cpl) ) + if (vname .eq. 'PRMS') call write_var2d(vname, prms (1:nseal_cpl) ) + if (vname .eq. 'TPMS') call write_var2d(vname, tpms (1:nseal_cpl) ) + if (vname .eq. 'TAUICEX') call write_var2d(vname, tauice (1:nseal_cpl,1) ) + if (vname .eq. 'TAUICEY') call write_var2d(vname, tauice (1:nseal_cpl,2) ) + if (vname .eq. 'PHICE') call write_var2d(vname, phice (1:nseal_cpl) ) + if (vname .eq. 'TAUOCX') call write_var2d(vname, tauocx (1:nseal_cpl) ) + if (vname .eq. 'TAUOCY') call write_var2d(vname, tauocy (1:nseal_cpl) ) + if (vname .eq. 'USSHX') call write_var2d(vname, usshx (1:nseal_cpl) ) + if (vname .eq. 'USSHY') call write_var2d(vname, usshy (1:nseal_cpl) ) + ! Group 7 + if (vname .eq. 'ABAX') call write_var2d(vname, aba (1:nseal_cpl), dir=cos(abd(1:nseal_cpl)) ) + if (vname .eq. 'ABAY') call write_var2d(vname, aba (1:nseal_cpl), dir=sin(abd(1:nseal_cpl)) ) + if (vname .eq. 'UBAX') call write_var2d(vname, uba (1:nseal_cpl), dir=cos(ubd(1:nseal_cpl)) ) + if (vname .eq. 'UBAY') call write_var2d(vname, uba (1:nseal_cpl), dir=sin(ubd(1:nseal_cpl)) ) + if (vname .eq. 'BED') call write_var2d(vname, bedforms (1:nseal_cpl,1), init2='true') + if (vname .eq. 'RIPPLEX') call write_var2d(vname, bedforms (1:nseal_cpl,2), init2='true') + if (vname .eq. 'RIPPLEY') call write_var2d(vname, bedforms (1:nseal_cpl,3), init2='true') + if (vname .eq. 'PHIBBL') call write_var2d(vname, phibbl (1:nseal_cpl), init2='true') + if (vname .eq. 'TAUBBLX') call write_var2d(vname, taubbl (1:nseal_cpl,1), init2='true') + if (vname .eq. 'TAUBBLY') call write_var2d(vname, taubbl (1:nseal_cpl,2), init2='true') + + ! Group 8 + if (vname .eq. 'MSSX') call write_var2d(vname, mssx (1:nseal_cpl) ) + if (vname .eq. 'MSSY') call write_var2d(vname, mssy (1:nseal_cpl) ) + if (vname .eq. 'MSCX') call write_var2d(vname, mscx (1:nseal_cpl) ) + if (vname .eq. 'MSCY') call write_var2d(vname, mscy (1:nseal_cpl) ) + !TODO: remaining variables have inconsistency between shel_inp listing and iogo code + + ! Group 9 + if (vname .eq. 'DTDYN') call write_var2d(vname, dtdyn (1:nseal_cpl) ) + if (vname .eq. 'FCUT') call write_var2d(vname, fcut (1:nseal_cpl) ) + if (vname .eq.'CFLXYMAX') call write_var2d(vname, cflxymax (1:nseal_cpl) ) + if (vname .eq.'CFLTHMAX') call write_var2d(vname, cflthmax (1:nseal_cpl) ) + if (vname .eq. 'CFLKMAX') call write_var2d(vname, cflkmax (1:nseal_cpl) ) + + ! Group 10 + end if + end do + + if (s_axis) deallocate(var3ds) + if (m_axis) deallocate(var3dm) + if (p_axis) deallocate(var3dp) + if (k_axis) deallocate(var3dk) + + call pio_freedecomp(pioid,iodesc2d) + call pio_freedecomp(pioid,iodesc2dint) + if (s_axis) call pio_freedecomp(pioid, iodesc3ds) + if (m_axis) call pio_freedecomp(pioid, iodesc3dm) + if (p_axis) call pio_freedecomp(pioid, iodesc3dp) + if (k_axis) call pio_freedecomp(pioid, iodesc3dk) + + call pio_closefile(pioid) + + end subroutine write_history + + !=============================================================================== + !> Write an array of (nseal) points as (nx,ny) + !! + !! @details If dir is present, the written variable will represent either the X + !! or Y component of the variable. If mask is present and true, use mapsta=1 to + !! mask values. If init0 is present and false, do not initialize values for mapsta<0. + !! This prevents group 1 variables being set undef over ice. If init2 is present and + !! true, apply a second initialization where mapsta==2. If fldir is present and true + !! then the directions will be converted to degrees. If global is present and true, + !! write pe-local copy of global field + !! + !! @param[in] vname the variable name + !! @param[in] var the variable array + !! @param[in] dir the direction array, optional + !! @param[in] usemask a flag for variable masking, optional + !! @param[in] init0 a flag for variable initialization, optional + !! @param[in] init2 a flag for a second initialization type, optional + !! @param[in] fldir a flag for unit conversion for direction, optional + !! @param[in] global a flag for a global variable, optional + !! + !> author DeniseWorthen@noaa.gov + !> @date 08-26-2024 + subroutine write_var2d(vname, var, dir, usemask, init0, init2, fldir, global) + + character(len=*), intent(in) :: vname + real , intent(in) :: var(:) + real, optional , intent(in) :: dir(:) + character(len=*), optional, intent(in) :: usemask + character(len=*), optional, intent(in) :: init0 + character(len=*), optional, intent(in) :: init2 + character(len=*), optional, intent(in) :: fldir + character(len=*), optional, intent(in) :: global + + ! local variables + real, dimension(nseal_cpl) :: varout + logical :: lmask, linit0, linit2, lfldir, lglobal + real :: varloc + + lmask = .false. + if (present(usemask)) then + lmask = (trim(usemask) == "true") + end if + linit0 = .true. + if (present(init0)) then + linit0 = (trim(init0) == "true") + end if + linit2 = .false. + if (present(init2)) then + linit2 = (trim(init2) == "true") + end if + lfldir = .false. + if (present(fldir)) then + lfldir = (trim(fldir) == "true") + end if + lglobal = .false. + if (present(global)) then + lglobal = (trim(global) == "true") + end if + + varout = undef + do jsea = 1,nseal_cpl + call init_get_isea(isea, jsea) + if (lglobal) then + varloc = var(isea) + else + varloc = var(jsea) + end if + + if (linit0) then + if (mapsta(mapsf(isea,2),mapsf(isea,1)) < 0) varloc = undef + end if + if (linit2) then + if (mapsta(mapsf(isea,2),mapsf(isea,1)) == 2) varloc = undef + end if + + if (lfldir) then + if (varloc .ne. undef) then + varloc = mod(630. - rade*varloc, 360.) + end if + end if + if (present(dir)) then + if (varloc .ne. undef) then + if (lmask) then + if (mapsta(mapsf(isea,2),mapsf(isea,1)) == 1) then + if (lglobal) then + varout(jsea) = varloc*dir(isea) + else + varout(jsea) = varloc*dir(jsea) + end if + end if + else + if (lglobal) then + varout(jsea) = varloc*dir(isea) + else + varout(jsea) = varloc*dir(jsea) + end if + end if + end if + else + varout(jsea) = varloc + end if + end do + + ierr = pio_inq_varid(pioid, trim(vname), varid) + call handle_err(ierr, 'inquire variable '//trim(vname)) + call pio_setframe(pioid, varid, int(1,kind=Pio_Offset_Kind)) + call pio_write_darray(pioid, varid, iodesc2d, varout, ierr) + call handle_err(ierr, 'put variable '//trim(vname)) + + end subroutine write_var2d + + !=============================================================================== + !> Write an array of (nseal,:) points as (nx,ny,:) + !! + !! @details If init2 is present and true, apply a second initialization to a + !! subset of variables for where mapsta==2. If fldir is present and true then + !! the directions will be converted to degrees. + !! + !! @param[in] iodesc the PIO decomposition handle + !! @param[in] vname the variable name + !! @param[in] var the variable array + !! @param[in] init2 a flag for a second initialization type, optional + !! @param[in] fldir a flag for unit conversion for direction, optional + !! + !> author DeniseWorthen@noaa.gov + !> @date 08-26-2024 + subroutine write_var3d(iodesc, vname, var, init2, fldir) + + type(io_desc_t), intent(inout) :: iodesc + character(len=*), intent(in) :: vname + real , intent(in) :: var(:,:) + character(len=*), optional, intent(in) :: init2 + character(len=*), optional, intent(in) :: fldir + + ! local variables + real, allocatable, dimension(:) :: varloc + logical :: linit2, lfldir + integer :: lb, ub + + linit2 = .false. + if (present(init2)) then + linit2 = (trim(init2) == "true") + end if + lfldir = .false. + if (present(fldir)) then + lfldir = (trim(fldir) == "true") + end if + + lb = lbound(var,2) + ub = ubound(var,2) + allocate(varloc(lb:ub)) + + var3d = undef + do jsea = 1,nseal_cpl + call init_get_isea(isea, jsea) + ! initialization + varloc(:) = var(jsea,:) + if (mapsta(mapsf(isea,2),mapsf(isea,1)) < 0) varloc(:) = undef + if (linit2) then + if (mapsta(mapsf(isea,2),mapsf(isea,1)) == 2) varloc(:) = undef + end if + if (lfldir) then + if (mapsta(mapsf(isea,2),mapsf(isea,1)) > 0 ) then + varloc(:) = mod(630. - rade*varloc(:), 360.) + end if + end if + var3d(jsea,:) = varloc(:) + end do + + ierr = pio_inq_varid(pioid, trim(vname), varid) + call handle_err(ierr, 'inquire variable '//trim(vname)) + call pio_setframe(pioid, varid, int(1,kind=PIO_OFFSET_KIND)) + call pio_write_darray(pioid, varid, iodesc, var3d, ierr) + + deallocate(varloc) + end subroutine write_var3d + + !=============================================================================== + !> Scan through all possible fields to determine a list of requested variables + !! + !> @details Utilizes the list of variables specified via WW3's flout array + !! to define the variables written to the file. The elements of the flout + !! array are here referred to as "tags". Tags are not 1:1 with output fields. + !! For example, the tag "CUR" means that the ocean currents, comprising two + !! directional values are requested. They will both be requested via the single + !! CUR tag. The tag "SXY" means that three components of radiation stresses + !! are requested (XX,YY,XY). + !! + !! @param[in] stdout the logfile unit on the root_task + !! + !> @author Denise.Worthen@noaa.gov + !> @date 09-19-2022 + subroutine wav_history_init(stdout) + + use w3gdatmd, only: e3df, p2msf, us3df, usspf + use w3odatmd, only: iaproc, nogrp, ngrpp + use w3iogomd, only: fldout + use w3servmd, only: strsplit + + integer, intent(in) :: stdout + + ! local variables + integer, parameter :: maxvars = 25 ! maximum number of variables/group + type(varatts), dimension(nogrp,maxvars) :: gridoutdefs + + character(len=100) :: inptags(100) = '' + integer :: j,k,n,nout + character(len= 12) :: ttag + + ! obtain all possible output variable tags and attributes + call define_fields(gridoutdefs) + + ! obtain the tags for the requested output variables + call strsplit(fldout,inptags) + + ! determine which variables are tagged for output + do k = 1,nogrp + do j = 1,maxvars + if (len_trim(gridoutdefs(k,j)%tag) > 0) then + do n = 1,len(inptags) + if (len_trim(inptags(n)) > 0) then + if (trim(inptags(n)) == trim(gridoutdefs(k,j)%tag)) gridoutdefs(k,j)%validout = .true. + end if + end do + end if + end do + end do + + ! remove requested variables which are only allocated if specific + ! options are set in mod_def (see w3adatmd, '3D arrays') + do k = 1,nogrp + do j = 1,maxvars + if (gridoutdefs(k,j)%validout) then + ttag = trim(gridoutdefs(k,j)%tag) + if (ttag == 'EF' .and. e3df(1,1) == 0) gridoutdefs(k,j)%validout = .false. + if (ttag == 'TH1M' .and. e3df(1,2) == 0) gridoutdefs(k,j)%validout = .false. + if (ttag == 'STH1M' .and. e3df(1,3) == 0) gridoutdefs(k,j)%validout = .false. + if (ttag == 'TH2M' .and. e3df(1,4) == 0) gridoutdefs(k,j)%validout = .false. + if (ttag == 'STH2M' .and. e3df(1,5) == 0) gridoutdefs(k,j)%validout = .false. + + if (ttag == 'P2L' .and. p2msf(1) == 0) gridoutdefs(k,j)%validout = .false. + if (ttag == 'USF' .and. us3df(1) == 0) gridoutdefs(k,j)%validout = .false. + if (ttag == 'USP' .and. usspf(1) == 0) gridoutdefs(k,j)%validout = .false. + end if + end do + end do + + ! determine number of output variables (not the same as the number of tags) + n = 0 + do k = 1,nogrp + do j = 1,maxvars + if (gridoutdefs(k,j)%validout) n = n+1 + end do + end do + nout = n + allocate(outvars(1:nout)) + + ! subset variables requested + n = 0 + do k = 1,nogrp + do j = 1,maxvars + if (gridoutdefs(k,j)%validout) then + n = n+1 + outvars(n) = gridoutdefs(k,j) + end if + enddo + end do + + ! check + if ( iaproc == 1 ) then + write(stdout,*) + write(stdout,'(a)')' --------------------------------------------------' + write(stdout,'(a)')' Requested gridded output variables : ' + write(stdout,'(a)')' --------------------------------------------------' + write(stdout,*) + do n = 1,nout + write(stdout,'(i5,2a12,a50)')n,' '//trim(outvars(n)%tag), & + ' '//trim(outvars(n)%var_name), & + ' '//trim(outvars(n)%long_name) + end do + write(stdout,*) + call flush (stdout) + end if + + end subroutine wav_history_init + + !==================================================================================== + !> Define the available output fields and their attributes + !! + !> @author Denise.Worthen@noaa.gov + !> @date 09-19-2022 + subroutine define_fields (gridoutdefs) + + type(varatts), dimension(:,:), intent(inout) :: gridoutdefs + + gridoutdefs(:,:)%tag = "" + gridoutdefs(:,:)%var_name = "" + gridoutdefs(:,:)%long_name = "" + gridoutdefs(:,:)%unit_name = "" + gridoutdefs(:,:)%dims = "" + gridoutdefs(:,:)%validout = .false. + + ! 1 Forcing Fields + gridoutdefs(1,1:14) = [ & + varatts( "DPT ", "DW ", "Water depth ", "m ", " ", .false.) , & + varatts( "CUR ", "CX ", "Mean current, x-component ", "m s-1 ", " ", .false.) , & + varatts( "CUR ", "CY ", "Mean current, y-component ", "m s-1 ", " ", .false.) , & + varatts( "WND ", "UAX ", "Mean wind, x-component ", "m s-1 ", " ", .false.) , & + varatts( "WND ", "UAY ", "Mean wind, y-component ", "m s-1 ", " ", .false.) , & + varatts( "AST ", "AS ", "Air-sea temperature difference ", "K ", " ", .false.) , & + varatts( "WLV ", "WLV ", "Water levels ", "m ", " ", .false.) , & + varatts( "ICE ", "ICE ", "Ice coverage ", "nd ", " ", .false.) , & + varatts( "IBG ", "BERG ", "Iceberg-induced damping ", "km-1 ", " ", .false.) , & + varatts( "TAUA ", "TAUAX ", "Atm momentum x ", "Pa ", " ", .false.) , & + varatts( "TAUA ", "TAUAY ", "Atm momentum y ", "Pa ", " ", .false.) , & + varatts( "RHO ", "RHOAIR ", "Air density ", "kg m-3 ", " ", .false.) , & + varatts( "IC1 ", "ICEH ", "Ice thickness ", "m ", " ", .false.) , & + varatts( "IC5 ", "ICEF ", "Ice floe diameter ", "m ", " ", .false.) & + ] + + ! 2 Standard mean wave Parameters + gridoutdefs(2,1:18) = [ & + varatts( "HS ", "HS ", "Significant wave height ", "m ", " ", .false.) , & + varatts( "LM ", "WLM ", "Mean wave length ", "m ", " ", .false.) , & + varatts( "T02 ", "T02 ", "Mean wave period (Tm0,2) ", "s ", " ", .false.) , & + varatts( "T0M1 ", "T0M1 ", "Mean wave period (Tm0,-1) ", "s ", " ", .false.) , & + varatts( "T01 ", "T01 ", "Mean wave period (Tm0,1) ", "s ", " ", .false.) , & + varatts( "FP ", "FP0 ", "Peak frequency ", "s-1 ", " ", .false.) , & + varatts( "DIR ", "THM ", "Mean wave direction ", "rad ", " ", .false.) , & + varatts( "SPR ", "THS ", "Mean directional spread ", "rad ", " ", .false.) , & + varatts( "DP ", "THP0 ", "Peak direction ", "rad ", " ", .false.) , & + varatts( "HIG ", "HSIG ", "Infragravity height ", "m ", " ", .false.) , & + varatts( "MXE ", "STMAXE ", "Max surface elev (STE) ", "m ", " ", .false.) , & + varatts( "MXES ", "STMAXD ", "St Dev Max surface elev (STE) ", "m ", " ", .false.) , & + varatts( "MXH ", "HMAXE ", "Max wave height (S.) ", "m ", " ", .false.) , & + varatts( "MXHC ", "HCMAXE ", "Max wave height from crest (STE) ", "m ", " ", .false.) , & + varatts( "SDMH ", "HMAXD ", "St Dev of MXC (STE) ", "m ", " ", .false.) , & + varatts( "SDMHC", "HCMAXD ", "St Dev of MXHC (STE) ", "m ", " ", .false.) , & + varatts( "WBT ", "WBT ", "Dominant wave breaking probability (b_T) ", "nd ", " ", .false.) , & + varatts( "WNM ", "WNMEAN ", "Mean wave number ", "m-1 ", " ", .false.) & + ] + + ! 3 Spectral Parameters + gridoutdefs(3,1:6) = [ & + varatts( "EF ", "EF ", "1D spectral density ", "m2 s ", "k ", .false.) , & + varatts( "TH1M ", "TH1M ", "Mean wave direction from a1,b2 ", "deg ", "k ", .false.) , & + varatts( "STH1M", "STH1M ", "Directional spreading from a1,b2 ", "deg ", "k ", .false.) , & + varatts( "TH2M ", "TH2M ", "Mean wave direction from a2,b2 ", "deg ", "k ", .false.) , & + varatts( "STH2M", "STH2M ", "Directional spreading from a2,b2 ", "deg ", "k ", .false.) , & + !TODO: has reverse indices (nk,nsea) + varatts( "WN ", "WN ", "Wavenumber array ", "m-1 ", "k ", .false.) & + ] + + ! 4 Spectral Partition Parameters + gridoutdefs(4,1:17) = [ & + varatts( "PHS ", "PHS ", "Partitioned wave heights ", "m ", "s ", .false.) , & + varatts( "PTP ", "PTP ", "Partitioned peak period ", "s ", "s ", .false.) , & + varatts( "PLP ", "PLP ", "Partitioned peak wave length ", "m ", "s ", .false.) , & + varatts( "PDIR ", "PDIR ", "Partitioned mean direction ", "deg ", "s ", .false.) , & + varatts( "PSPR ", "PSI ", "Partitioned mean directional spread ", "deg ", "s ", .false.) , & + varatts( "PWS ", "PWS ", "Partitioned wind sea fraction ", "nd ", "s ", .false.) , & + varatts( "PDP ", "PTHP0 ", "Peak wave direction of partition ", "deg ", "s ", .false.) , & + varatts( "PQP ", "PQP ", "Goda peakdedness parameter of partition ", "nd ", "s ", .false.) , & + varatts( "PPE ", "PPE ", "JONSWAP peak enhancement factor of partition ", "s-1 ", "s ", .false.) , & + varatts( "PGW ", "PGW ", "Gaussian frequency width of partition ", "nd ", "s ", .false.) , & + varatts( "PSW ", "PSW ", "Spectral width of partition ", "nd ", "s ", .false.) , & + varatts( "PTM10", "PTM1 ", "Mean wave period (m-1,0) of partition ", "s ", "s ", .false.) , & + varatts( "PT01 ", "PT1 ", "Mean wave period (m0,1) of partition ", "s ", "s ", .false.) , & + varatts( "PT02 ", "PT2 ", "Mean wave period (m0,2) of partition ", "s ", "s ", .false.) , & + varatts( "PEP ", "PEP ", "Peak spectral density of partition ", "m2 s rad-1", "s ", .false.) , & + varatts( "TWS ", "PWST ", "Total wind sea fraction ", "nd ", " ", .false.) , & + varatts( "PNR ", "PNR ", "Number of partitions ", "nd ", " ", .false.) & + ] + + ! 5 Atmosphere-waves layer + gridoutdefs(5,1:14) = [ & + varatts( "UST ", "USTX ", "Friction velocity x ", "m s-1 ", " ", .false.) , & + varatts( "UST ", "USTY ", "Friction velocity y ", "m s-1 ", " ", .false.) , & + varatts( "CHA ", "CHARN ", "Charnock parameter ", "nd ", " ", .false.) , & + varatts( "CGE ", "CGE ", "Energy flux ", "kW m-1 ", " ", .false.) , & + varatts( "FAW ", "PHIAW ", "Air-sea energy flux ", "W m-2 ", " ", .false.) , & + varatts( "TAW ", "TAUWIX ", "Net wave-supported stress x ", "m2 s-2 ", " ", .false.) , & + varatts( "TAW ", "TAUWIY ", "Net wave-supported stress y ", "m2 s-2 ", " ", .false.) , & + varatts( "TWA ", "TAUWNX ", "Negative part of the wave-supported stress x ", "m2 s-2 ", " ", .false.) , & + varatts( "TWA ", "TAUWNY ", "Negative part of the wave-supported stress y ", "m2 s-2 ", " ", .false.) , & + varatts( "WCC ", "WCC ", "Whitecap coverage ", "nd ", " ", .false.) , & + varatts( "WCF ", "WCF ", "Whitecap foam thickness ", "m ", " ", .false.) , & + varatts( "WCH ", "WCH ", "Mean breaking wave heigh ", "m ", " ", .false.) , & + varatts( "WCM ", "WCM ", "Whitecap moment ", "nd ", " ", .false.) , & + varatts( "FWS ", "TWS ", "Wind sea mean period ", "s ", " ", .false.) & + ] + + ! 6 Wave-ocean layer + gridoutdefs(6,1:25) = [ & + varatts( "SXY ", "SXX ", "Radiation stresses xx ", "N m-1 ", " ", .false.) , & + varatts( "SXY ", "SYY ", "Radiation stresses yy ", "N m-1 ", " ", .false.) , & + varatts( "SXY ", "SXY ", "Radiation stresses xy ", "N m-1 ", " ", .false.) , & + varatts( "TWO ", "TAUOX ", "Wave to ocean momentum flux x ", "m2 s-2 ", " ", .false.) , & + varatts( "TWO ", "TAUOY ", "Wave to ocean momentum flux y ", "m2 s-2 ", " ", .false.) , & + varatts( "BHD ", "BHD ", "Bernoulli head (J term) ", "m2 s-2 ", " ", .false.) , & + varatts( "FOC ", "PHIOC ", "Wave to ocean energy flux ", "W m-2 ", " ", .false.) , & + varatts( "TUS ", "TUSX ", "Stokes transport x ", "m2 s-1 ", " ", .false.) , & + varatts( "TUS ", "TUSY ", "Stokes transport y ", "m2 s-1 ", " ", .false.) , & + varatts( "USS ", "USSX ", "Surface Stokes drift x ", "m s-1 ", " ", .false.) , & + varatts( "USS ", "USSY ", "Surface Stokes drift y ", "m s-1 ", " ", .false.) , & + varatts( "P2S ", "PRMS ", "Second-order sum pressure ", "m4 ", " ", .false.) , & + varatts( "P2S ", "TPMS ", "Second-order sum pressure ", "s-1 ", " ", .false.) , & + varatts( "USF ", "US3DX ", "Spectrum of surface Stokes drift x ", "m s-1 Hz-1", "k ", .false.) , & + varatts( "USF ", "US3DY ", "Spectrum of surface Stokes drift y ", "m s-1 Hz-1", "k ", .false.) , & + varatts( "P2L ", "P2SMS ", "Micro seism source term ", "Pa2 m2 s ", "m ", .false.) , & + varatts( "TWI ", "TAUICEX ", "Wave to sea ice stress x ", "m2 s-2 ", " ", .false.) , & + varatts( "TWI ", "TAUICEY ", "Wave to sea ice stress y ", "m2 s-2 ", " ", .false.) , & + varatts( "FIC ", "PHICE ", "Wave to sea ice energy flux ", "W m-2 ", " ", .false.) , & + varatts( "USP ", "USSPX ", "Partitioned surface Stokes drift x ", "m s-1 ", "p ", .false.) , & + varatts( "USP ", "USSPY ", "Partitioned surface Stokes drift y ", "m s-1 ", "p ", .false.) , & + varatts( "TWC ", "TAUOCX ", "Total wave to ocean stress x ", "Pa ", " ", .false.) , & + varatts( "TWC ", "TAUOCY ", "Total wave to ocean stress y ", "Pa ", " ", .false.) , & + varatts( "USSH ", "USSHX ", "Surface layer averaged Stokes drift x ", "m s-1 ", " ", .false.) , & + varatts( "USSH ", "USSHY ", "Surface layer averaged Stokes drift y ", "m s-1 ", " ", .false.) & + ] + + ! 7 Wave-bottom layer + gridoutdefs(7,1:10) = [ & + varatts( "ABR ", "ABAX ", "Near bottom rms wave excursion amplitudes x ", "m ", " ", .false.) , & + varatts( "ABR ", "ABAY ", "Near bottom rms wave excursion amplitudes y ", "m ", " ", .false.) , & + varatts( "UBR ", "UBAX ", "Near bottom rms wave velocities x ", "m s-1 ", " ", .false.) , & + varatts( "UBR ", "UBAY ", "Near bottom rms wave velocities y ", "m s-1 ", " ", .false.) , & + varatts( "BED ", "BED ", "Bottom roughness ", "m ", " ", .false.) , & + varatts( "BED ", "RIPPLEX ", "Sea bottom ripple wavelength x ", "m ", " ", .false.) , & + varatts( "BED ", "RIPPLEY ", "Sea bottom ripple wavelength y ", "m ", " ", .false.) , & + varatts( "FBB ", "PHIBBL ", "Energy flux due to bottom friction ", "W m-2 ", " ", .false.) , & + varatts( "TBB ", "TAUBBLX ", "Momentum flux due to bottom friction x ", "m2 s-2 ", " ", .false.) , & + varatts( "TBB ", "TAUBBLY ", "Momentum flux due to bottom friction y ", "m2 s-2 ", " ", .false.) & + ] + + ! 8 Spectrum parameters + gridoutdefs(8,1:9) = [ & + varatts( "MSS ", "MSSX ", "Surface mean square slope x ", "nd ", " ", .false.) , & + varatts( "MSS ", "MSSY ", "Surface mean square slope y ", "nd ", " ", .false.) , & + varatts( "MSC ", "MSCX ", "Spectral level at high frequency tail x ", "nd ", " ", .false.) , & + varatts( "MSC ", "MSCY ", "Spectral level at high frequency tail y ", "nd ", " ", .false.) , & + varatts( "WL02 ", "WL02X ", "East/X North/Y mean wavelength component ", "nd ", " ", .false.) , & + varatts( "WL02 ", "WL02Y ", "East/X North/Y mean wavelength component ", "nd ", " ", .false.) , & + varatts( "AXT ", "ALPXT ", "Correl sea surface gradients (x,t) ", "nd ", " ", .false.) , & + varatts( "AYT ", "ALPYT ", "Correl sea surface gradients (y,t) ", "nd ", " ", .false.) , & + varatts( "AXY ", "ALPXY ", "Correl sea surface gradients (x,y) ", "nd ", " ", .false.) & + ] + + ! 9 Numerical diagnostics + gridoutdefs(9,1:5) = [ & + varatts( "DTD ", "DTDYN ", "Average time step in integration ", "min ", " ", .false.) , & + varatts( "FC ", "FCUT ", "Cut-off frequency ", "s-1 ", " ", .false.) , & + varatts( "CFX ", "CFLXYMAX ", "Max. CFL number for spatial advection ", "nd ", " ", .false.) , & + varatts( "CFD ", "CFLTHMAX ", "Max. CFL number for theta-advection ", "nd ", " ", .false.) , & + varatts( "CFK ", "CFLKMAX ", "Max. CFL number for k-advection ", "nd ", " ", .false.) & + ] + + ! 10 User defined + gridoutdefs(10,1:2) = [ & + varatts( "U1 ", "U1 ", "User defined 1 ", "nd ", " ", .false.) , & + varatts( "U2 ", "U2 ", "User defined 2 ", "nd ", " ", .false.) & + ] + end subroutine define_fields +end module wav_history_mod diff --git a/model/src/wav_import_export.F90 b/model/src/wav_import_export.F90 index a91c8c0d7..0d7c280ad 100644 --- a/model/src/wav_import_export.F90 +++ b/model/src/wav_import_export.F90 @@ -95,8 +95,7 @@ subroutine advertise_fields(importState, ExportState, flds_scalar_name, rc) integer , intent(out) :: rc ! local variables - integer :: n, num - character(len=2) :: fvalue + integer :: n character(len=*), parameter :: subname='(wav_import_export:advertise_fields)' !------------------------------------------------------------------------------- @@ -107,7 +106,7 @@ subroutine advertise_fields(importState, ExportState, flds_scalar_name, rc) ! Advertise import fields !-------------------------------- - !call fldlist_add(fldsToWav_num, fldsToWav, 'So_h' ) + call fldlist_add(fldsToWav_num, fldsToWav, 'So_h' ) call fldlist_add(fldsToWav_num, fldsToWav, 'Si_ifrac' ) call fldlist_add(fldsToWav_num, fldsToWav, 'So_u' ) call fldlist_add(fldsToWav_num, fldsToWav, 'So_v' ) @@ -139,16 +138,29 @@ subroutine advertise_fields(importState, ExportState, flds_scalar_name, rc) if (.not. unstr_mesh) then call fldlist_add(fldsFrWav_num, fldsFrWav, trim(flds_scalar_name)) end if + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_ustokes') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_vstokes') + if (cesmcoupled) then call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_lamult' ) call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_lasl' ) - call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_ustokes') - call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_vstokes') else call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_z0') + ! coastal coupling call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_wavsuu') call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_wavsuv') call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_wavsvv') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_hs') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_bhd') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_tauox') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_tauoy') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_taubblx') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_taubbly') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_ubrx') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_ubry') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_thm') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_t0m1') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_wnmean') end if call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_pstokes_x', ungridded_lbound=1, ungridded_ubound=3) call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_pstokes_y', ungridded_lbound=1, ungridded_ubound=3) @@ -263,13 +275,13 @@ subroutine import_fields( gcomp, time0, timen, rc ) ! Obtain the wave input from the mediator !--------------------------------------------------------------------------- - use w3gdatmd , only: nsea, nseal, MAPSTA, NX, NY, w3setg + use w3gdatmd , only: nsea, NX, NY, w3setg use w3idatmd , only: CX0, CY0, CXN, CYN, DT0, DTN, ICEI, WLEV, INFLAGS1, ICEP1, ICEP5 use w3idatmd , only: TC0, TCN, TLN, TIN, TI1, TI5, TW0, TWN, WX0, WY0, WXN, WYN use w3idatmd , only: UX0, UY0, UXN, UYN, TU0, TUN use w3idatmd , only: tfn, w3seti use w3odatmd , only: w3seto - use w3wdatmd , only: time, w3setw + use w3wdatmd , only: w3setw #ifdef W3_CESMCOUPLED use w3idatmd , only: HSL #else @@ -299,7 +311,6 @@ subroutine import_fields( gcomp, time0, timen, rc ) integer :: mpi_comm_null = -1 real(r4), allocatable :: wxdata(:) ! only needed if merge_import real(r4), allocatable :: wydata(:) ! only needed if merge_import - character(len=CL) :: msgString character(len=*), parameter :: subname='(wav_import_export:import_fields)' !--------------------------------------------------------------------------- @@ -600,16 +611,16 @@ subroutine export_fields (gcomp, rc) !--------------------------------------------------------------------------- use wav_kind_mod, only : R8 => SHR_KIND_R8 - use w3adatmd , only : USSX, USSY, USSP + use w3adatmd , only : USSX, USSY, USSP, HS, tauox, tauoy, wnmean, taubbl use w3adatmd , only : w3seta use w3idatmd , only : w3seti use w3wdatmd , only : va, w3setw - use w3odatmd , only : w3seto, naproc, iaproc - use w3gdatmd , only : nseal, mapsf, MAPSTA, USSPF, NK, w3setg + use w3odatmd , only : w3seto + use w3gdatmd , only : mapsf, MAPSTA, USSPF, NK, w3setg use w3iogomd , only : CALC_U3STOKES #ifdef W3_CESMCOUPLED use w3wdatmd , only : ASF, UST - use w3adatmd , only : USSHX, USSHY, UD, HS + use w3adatmd , only : USSHX, USSHY, UD use w3idatmd , only : HSL #else use wmmdatmd , only : mdse, mdst, wmsetm @@ -627,22 +638,30 @@ subroutine export_fields (gcomp, rc) real(R8) :: fillvalue = zero ! special missing value #endif type(ESMF_State) :: exportState - integer :: n, jsea, isea, ix, iy, ib + integer :: jsea, isea, ix, iy, ib real(r8), pointer :: z0rlen(:) real(r8), pointer :: charno(:) - real(r8), pointer :: wbcuru(:) - real(r8), pointer :: wbcurv(:) - real(r8), pointer :: wbcurp(:) - real(r8), pointer :: sxxn(:) - real(r8), pointer :: sxyn(:) - real(r8), pointer :: syyn(:) - real(r8), pointer :: sw_lamult(:) real(r8), pointer :: sw_lasl(:) real(r8), pointer :: sw_ustokes(:) real(r8), pointer :: sw_vstokes(:) + real(r8), pointer :: sxxn(:) + real(r8), pointer :: sxyn(:) + real(r8), pointer :: syyn(:) + real(r8), pointer :: sw_hs(:) + real(r8), pointer :: sw_bhd(:) + real(r8), pointer :: sw_tauox(:) + real(r8), pointer :: sw_tauoy(:) + real(r8), pointer :: sw_taubblx(:) + real(r8), pointer :: sw_taubbly(:) + real(r8), pointer :: sw_ubrx(:) + real(r8), pointer :: sw_ubry(:) + real(r8), pointer :: sw_thm(:) + real(r8), pointer :: sw_t0m1(:) + real(r8), pointer :: sw_wnmean(:) + ! d2 is location, d1 is frequency - nwav_elev_spectrum frequencies will be used real(r8), pointer :: wave_elevation_spectrum(:,:) @@ -668,7 +687,8 @@ subroutine export_fields (gcomp, rc) if (multigrid) then call wmsetm ( 1, mdse, mdst ) end if -#else +#endif +#ifdef W3_CESMCOUPLED if (state_fldchk(exportState, 'Sw_lamult')) then call state_getfldptr(exportState, 'Sw_lamult', sw_lamult, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -716,8 +736,8 @@ subroutine export_fields (gcomp, rc) endif enddo end if -#endif - ! surface stokes drift + + ! surface stokes drift at history frequency if (state_fldchk(exportState, 'Sw_ustokes')) then call state_getfldptr(exportState, 'Sw_ustokes', sw_ustokes, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -748,6 +768,18 @@ subroutine export_fields (gcomp, rc) endif enddo end if +#else + ! surface stokes drift at coupling frequency + if ( state_fldchk(exportState, 'Sw_ustokes') .and. & + state_fldchk(exportState, 'Sw_vstokes') )then + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getfldptr(exportState, 'Sw_ustokes', sw_ustokes, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getfldptr(exportState, 'Sw_vstokes', sw_vstokes, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call CalcStokes(va, sw_ustokes, sw_vstokes, fillvalue) + end if +#endif if (state_fldchk(exportState, 'Sw_ch')) then call state_getfldptr(exportState, 'charno', charno, rc=rc) @@ -761,18 +793,6 @@ subroutine export_fields (gcomp, rc) call CalcRoughl(z0rlen) endif - if ( state_fldchk(exportState, 'wbcuru') .and. & - state_fldchk(exportState, 'wbcurv') .and. & - state_fldchk(exportState, 'wbcurp')) then - call state_getfldptr(exportState, 'wbcuru', wbcuru, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getfldptr(exportState, 'wbcurv', wbcurv, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getfldptr(exportState, 'wbcurp', wbcurp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call CalcBotcur( va, wbcuru, wbcurv, wbcurp) - end if - if ( state_fldchk(exportState, 'Sw_wavsuu') .and. & state_fldchk(exportState, 'Sw_wavsuv') .and. & state_fldchk(exportState, 'Sw_wavsvv')) then @@ -782,8 +802,9 @@ subroutine export_fields (gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call state_getfldptr(exportState, 'Sw_wavsvv', syyn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call CalcRadstr2D( va, sxxn, sxyn, syyn) + call CalcRadstr2D( va, sxxn, sxyn, syyn, fillvalue) end if + if (wav_coupling_to_cice) then call state_getfldptr(exportState, 'Sw_elevation_spectrum', wave_elevation_spectrum, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -815,6 +836,96 @@ subroutine export_fields (gcomp, rc) end if endif + if (state_fldchk(exportState, 'Sw_hs')) then + call state_getfldptr(exportState, 'Sw_hs', sw_hs, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + sw_hs(:) = fillvalue + call CalcHS(va, sw_hs, fillvalue) + end if + + if (state_fldchk(exportState, 'Sw_bhd')) then + call state_getfldptr(exportState, 'Sw_bhd', sw_bhd, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + sw_bhd(:) = fillvalue + call CalcBHD(va, sw_bhd, fillvalue) + end if + + if ( state_fldchk(exportState, 'Sw_tauox') .and. & + state_fldchk(exportState, 'Sw_tauoy') )then + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getfldptr(exportState, 'Sw_tauox', sw_tauox, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getfldptr(exportState, 'Sw_tauoy', sw_tauoy, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + sw_tauox(:) = fillvalue + sw_tauoy(:) = fillvalue + do jsea=1, nseal_cpl + call init_get_isea(isea, jsea) + ix = mapsf(isea,1) + iy = mapsf(isea,2) + if (mapsta(iy,ix) == 1) then + sw_tauox(jsea) = tauox(jsea) + sw_tauoy(jsea) = tauoy(jsea) + endif + enddo + end if + + if ( state_fldchk(exportState, 'Sw_ubrx') .and. & + state_fldchk(exportState, 'Sw_ubry') )then + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getfldptr(exportState, 'Sw_ubrx', sw_ubrx, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getfldptr(exportState, 'Sw_ubry', sw_ubry, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call CalcUVBed(va, sw_ubrx, sw_ubry, fillvalue) + end if + + if (state_fldchk(exportState, 'Sw_thm')) then + call state_getfldptr(exportState, 'Sw_thm', sw_thm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call CalcTHM(va, sw_thm, fillvalue) + end if + + if (state_fldchk(exportState, 'Sw_t0m1')) then + call state_getfldptr(exportState, 'Sw_t0m1', sw_t0m1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call CalcT0M1(va, sw_t0m1, fillvalue) + end if + + if (state_fldchk(exportState, 'Sw_wnmean')) then + call state_getfldptr(exportState, 'Sw_wnmean', sw_wnmean, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + sw_wnmean(:) = fillvalue + do jsea=1, nseal_cpl + call init_get_isea(isea, jsea) + ix = mapsf(isea,1) + iy = mapsf(isea,2) + if (mapsta(iy,ix) == 1) then + sw_wnmean(jsea) = wnmean(jsea) + endif + enddo + end if + + if ( state_fldchk(exportState, 'Sw_taubblx') .and. & + state_fldchk(exportState, 'Sw_taubbly') )then + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getfldptr(exportState, 'Sw_taubblx', sw_taubblx, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getfldptr(exportState, 'Sw_taubbly', sw_taubbly, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + sw_taubblx(:) = fillvalue + sw_taubbly(:) = fillvalue + do jsea=1, nseal_cpl + call init_get_isea(isea, jsea) + ix = mapsf(isea,1) + iy = mapsf(isea,2) + if (mapsta(iy,ix) == 1) then + sw_taubblx(jsea) = taubbl(jsea,1) + sw_taubbly(jsea) = taubbl(jsea,2) + endif + enddo + end if + if (dbug_flag > 5) then call state_diagnose(exportState, 'at export ', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1003,26 +1114,24 @@ subroutine CalcCharnk ( chkn ) ! Calculate Charnok for export - use w3gdatmd, only : nseal, nk, nth, sig, mapsf, mapsta, nspec + use w3gdatmd, only : nk, nspec use w3adatmd, only : cg, wn, charn, u10, u10d use w3wdatmd, only : va - use w3odatmd, only : naproc, iaproc #ifdef W3_ST3 use w3src3md, only : w3spr3 #endif #ifdef W3_ST4 use w3src4md, only : w3spr4 #endif - ! input/output variables - real(ESMF_KIND_R8), pointer :: chkn(:) ! 1D Charnock export field pointer + real(r8), pointer :: chkn(:) ! 1D Charnock export field pointer ! local variables - integer :: isea, jsea, ix, iy - real :: emean, fmean, fmean1, wnmean, amax, ustar, ustdr - real :: tauwx, tauwy, cd, z0, fmeanws, dlwmean - logical :: llws(nspec) - logical, save :: firstCall = .true. + integer :: isea, jsea + real :: emean, fmean, fmean1, wnmean, amax, ustar, ustdr + real :: tauwx, tauwy, cd, z0, fmeanws, dlwmean + logical :: llws(nspec) + logical, save :: firstCall = .true. !---------------------------------------------------------------------- !TODO: fix firstCall like for Roughl @@ -1063,11 +1172,10 @@ end subroutine CalcCharnk subroutine CalcRoughl ( wrln) ! Calculate wave roughness length for export - - use w3gdatmd, only : nseal, nk, nth, sig, dmin, ecos, esin, dden, mapsf, mapsta, nspec - use w3adatmd, only : dw, cg, wn, charn, u10, u10d + use w3gdatmd, only : nk, mapsf, mapsta, nspec + use w3adatmd, only : cg, wn, charn, u10, u10d use w3wdatmd, only : va, ust - use w3odatmd, only : naproc, iaproc, runtype + use w3odatmd, only : runtype #ifdef W3_ST3 use w3src3md, only : w3spr3 #endif @@ -1119,154 +1227,77 @@ subroutine CalcRoughl ( wrln) end subroutine CalcRoughl - !=============================================================================== - !> Calculate wave-bottom currents for export - !! - !> @details TODO: - !! - !! @param[in] a input spectra - !! @param wbxn a 1-D pointer to a field on a mesh - !! @param wbyn a 1-D pointer to a field on a mesh - !! @param wbpn a 1-D pointer to a field on a mesh - !! - !> @author T. J. Campbell, NRL - !> @date 09-Aug-2017 - subroutine CalcBotcur ( a, wbxn, wbyn, wbpn ) - - ! Calculate wave-bottom currents for export - - use w3gdatmd, only : nseal, nk, nth, sig, dmin, ecos, esin, dden, mapsf, mapsta, nspec - use w3adatmd, only : dw, cg, wn - use w3odatmd, only : naproc, iaproc - - ! input/output variables - real, intent(in) :: a(nth,nk,0:nseal) ! Input spectra (in par list to change shape) - real(ESMF_KIND_R8), pointer :: wbxn(:) ! eastward-component export field pointer - real(ESMF_KIND_R8), pointer :: wbyn(:) ! northward-component export field pointer - real(ESMF_KIND_R8), pointer :: wbpn(:) ! period export field pointer - - ! local variables - real(8), parameter :: half = 0.5_r8 - real(8), parameter :: one = 1.0_r8 - real(8), parameter :: two = 2.0_r8 - real(8), parameter :: kdmin = 1e-7_r8 - real(8), parameter :: kdmax = 18.0_r8 - integer :: isea, jsea, ik, ith - real(8) :: depth - real(8) :: kd, fack, fkd, aka, akx, aky, abr, ubr, ubx, uby, dir - real(8), allocatable :: sig2(:) - !---------------------------------------------------------------------- - - allocate( sig2(1:nk) ) - sig2(1:nk) = sig(1:nk)**2 - - wbxn(:) = zero - wbyn(:) = zero - wbpn(:) = zero - - jsea_loop: do jsea = 1,nseal_cpl - call init_get_isea(isea, jsea) - if ( dw(isea).le.zero ) cycle jsea_loop - depth = max(dmin,dw(isea)) - abr = zero - ubr = zero - ubx = zero - uby = zero - ik_loop: do ik = 1,nk - aka = zero - akx = zero - aky = zero - ith_loop: do ith = 1,nth - aka = aka + a(ith,ik,jsea) - akx = akx + a(ith,ik,jsea)*ecos(ith) - aky = aky + a(ith,ik,jsea)*esin(ith) - enddo ith_loop - fack = dden(ik)/cg(ik,isea) - kd = max(kdmin,min(kdmax,wn(ik,isea)*depth)) - fkd = fack/sinh(kd)**2 - abr = abr + aka*fkd - ubr = ubr + aka*sig2(ik)*fkd - ubx = ubx + akx*sig2(ik)*fkd - uby = uby + aky*sig2(ik)*fkd - enddo ik_loop - if ( abr.le.zero .or. ubr.le.zero ) cycle jsea_loop - abr = sqrt(two*abr) - ubr = sqrt(two*ubr) - dir = atan2(uby,ubx) - wbxn(jsea) = ubr*cos(dir) - wbyn(jsea) = ubr*sin(dir) - wbpn(jsea) = tpi*abr/ubr - enddo jsea_loop - - deallocate( sig2 ) - - end subroutine CalcBotcur - !=============================================================================== !> Calculate radiation stresses for export !! - !> @details TODO: + !> @details Calculates radiation stresses independently of w3iogomd to ensure + !! that export fields are updated at the coupling frequency !! !! @param[in] a input spectra !! @param sxxn a 1-D pointer to a field on a mesh !! @param sxyn a 1-D pointer to a field on a mesh !! @param syyn a 1-D pointer to a field on a mesh - !! - !> @author T. J. Campbell, NRL - !> @date 09-Aug-2017 - subroutine CalcRadstr2D ( a, sxxn, sxyn, syyn ) - - ! Calculate radiation stresses for export + !! @param[in] fval fill value + !> @author Denise.Worthen@noaa.gov + !> @date 08-05-2024 + subroutine CalcRadstr2D ( a, sxxn, sxyn, syyn, fval) - use w3gdatmd, only : nseal, nk, nth, sig, es2, esc, ec2, fte, dden - use w3adatmd, only : dw, cg, wn - use w3odatmd, only : naproc, iaproc + use w3gdatmd, only : nseal, nk, nth, sig, es2, esc, ec2, fte, dden, mapsf, mapsta + use w3adatmd, only : cg, wn ! input/output variables - real, intent(in) :: a(nth,nk,0:nseal) ! Input spectra (in par list to change shape) - real(ESMF_KIND_R8), pointer :: sxxn(:) ! eastward-component export field - real(ESMF_KIND_R8), pointer :: sxyn(:) ! eastward-northward-component export field - real(ESMF_KIND_R8), pointer :: syyn(:) ! northward-component export field + real, intent(in) :: a(nth,nk,0:nseal) ! Input spectra (in par list to change shape) + real(ESMF_KIND_R8), intent(in) :: fval + real(ESMF_KIND_R8), pointer, intent(inout) :: sxxn(:) ! eastward-component export field + real(ESMF_KIND_R8), pointer, intent(inout) :: sxyn(:) ! eastward-northward-component export field + real(ESMF_KIND_R8), pointer, intent(inout) :: syyn(:) ! northward-component export field ! local variables - character(ESMF_MAXSTR) :: cname - character(128) :: msg - real(8), parameter :: half = 0.5 - real(8), parameter :: one = 1.0 - real(8), parameter :: two = 2.0 - integer :: isea, jsea, ik, ith - real(8) :: sxxs, sxys, syys - real(8) :: akxx, akxy, akyy, cgoc, facd, fack, facs - !---------------------------------------------------------------------- + integer :: isea, jsea, ik, ith, ix, iy + real :: factor, abxx, abyy, abxy, sxx1, syy1, sxy1 - facd = dwat*grav - jsea_loop: do jsea = 1,nseal_cpl + do jsea = 1,nseal_cpl call init_get_isea(isea, jsea) - if ( dw(isea).le.zero ) cycle jsea_loop - sxxs = zero - sxys = zero - syys = zero - ik_loop: do ik = 1,nk - akxx = zero - akxy = zero - akyy = zero - cgoc = cg(ik,isea)*wn(ik,isea)/sig(ik) - cgoc = min(one,max(half,cgoc)) - ith_loop: do ith = 1,nth - akxx = akxx + (cgoc*(ec2(ith)+one)-half)*a(ith,ik,jsea) - akxy = akxy + cgoc*esc(ith)*a(ith,ik,jsea) - akyy = akyy + (cgoc*(es2(ith)+one)-half)*a(ith,ik,jsea) - enddo ith_loop - fack = dden(ik)/cg(ik,isea) - sxxs = sxxs + akxx*fack - sxys = sxys + akxy*fack - syys = syys + akyy*fack - enddo ik_loop - facs = (one+fte/cg(nk,isea))*facd - sxxn(jsea) = sxxs*facs - sxyn(jsea) = sxys*facs - syyn(jsea) = syys*facs - enddo jsea_loop + ix = mapsf(isea,1) ! global ix + iy = mapsf(isea,2) ! global iy + if (mapsta(iy,ix) == 1) then ! active sea point + sxx1 = 0.0 + syy1 = 0.0 + sxy1 = 0.0 + do ik = 1,nk + factor = max ( 0.5, cg(ik,isea)/sig(ik)*wn(ik,isea) ) + abxx = 0.0 + abyy = 0.0 + abxy = 0.0 + do ith = 1,nth + abxx = abxx + ((1.0 + ec2(ith))*factor-0.5) * a(ith,ik,jsea) + abyy = abyy + ((1.0 + es2(ith))*factor-0.5) * a(ith,ik,jsea) + abxy = abxy + esc(ith)* factor * a(ith,ik,jsea) + end do + + factor = dden(ik) / cg(ik,isea) + abxx = max ( 0.0, abxx ) * factor + abyy = max ( 0.0, abyy ) * factor + abxy = abxy * factor + + sxx1 = sxx1 + abxx + syy1 = syy1 + abyy + sxy1 = sxy1 + abxy + end do !ik + sxx1 = sxx1 + fte * abxx/cg(nk,isea) + syy1 = syy1 + fte * abyy/cg(nk,isea) + sxy1 = sxy1 + fte * abxy/cg(nk,isea) + end if + if (mapsta(iy,ix) == 1) then ! active sea point + sxxn(jsea) = sxx1*dwat*grav + syyn(jsea) = syy1*dwat*grav + sxyn(jsea) = sxy1*dwat*grav + else + sxxn(jsea) = fval + syyn(jsea) = fval + sxyn(jsea) = fval + end if + end do end subroutine CalcRadstr2D @@ -1285,12 +1316,12 @@ subroutine CalcEF (a, wave_elevation_spectrum) use constants, only : tpi use w3gdatmd, only : nth, nk, nseal, mapsf, mapsta, dden, dsii - use w3adatmd, only : nsealm, cg + use w3adatmd, only : cg use w3parall, only : init_get_isea ! input/output variables - real, intent(in) :: a(nth,nk,0:nseal) - real(r8), pointer :: wave_elevation_spectrum(:,:) + real, intent(in) :: a(nth,nk,0:nseal) + real(ESMF_KIND_R8), pointer :: wave_elevation_spectrum(:,:) ! local variables real :: ab(nseal) @@ -1322,6 +1353,374 @@ subroutine CalcEF (a, wave_elevation_spectrum) end subroutine CalcEF + !=============================================================================== + !> Calculate significant wave height for export + !! + !> @details Calculates significant wave height independently of w3iogomd to ensure + !! that exported HS field is updated at the coupling frequency + !! + !! @param[in] a input spectra + !! @param[inout] hs a 1-D pointer to a field on a mesh + !! + !> @author Denise.Worthen@noaa.gov + !> @date 8-02-2024 + subroutine CalcHS (a, hs, fval) + + use constants, only : tpi + use w3gdatmd, only : nth, nk, nseal, mapsf, mapsta, dden, fte + use w3adatmd, only : cg + use w3parall, only : init_get_isea + + ! input/output variables + real, intent(in) :: a(nth,nk,0:nseal) + real(ESMF_KIND_R8), intent(in) :: fval + real(ESMF_KIND_R8), pointer, intent(inout) :: hs(:) + + ! local variables + real :: factor, eband, ab, et + integer :: ik, ith, isea, jsea, ix, iy + + do jsea = 1,nseal_cpl + call init_get_isea(isea, jsea) + ix = mapsf(isea,1) ! global ix + iy = mapsf(isea,2) ! global iy + if (mapsta(iy,ix) == 1) then ! active sea point + et = 0.0 + do ik = 1,nk + factor = dden(ik) / cg(ik,isea) + ab = 0.0 + do ith = 1,nth + ab = ab + a(ith,ik,jsea) + end do + et = et + ab*factor + end do !ik + eband = ab/cg(nk,isea) + et = et + fte*eband +#ifdef W3_O9 + if ( et .ge. 0.0 ) then + hs(jsea) = 4.0*sqrt ( et ) + else + hs(jsea) = -4.0*sqrt ( -et ) + end if +#else + hs(jsea) = 4.0*sqrt ( et ) +#endif + else + hs(jsea) = fval + end if + end do + end subroutine CalcHS + + !=============================================================================== + !> Calculate Bernoulli head pressure for export + !! + !> @details Calculates Bernoulli head pressure independently of w3iogomd to ensure + !! that exported BHD field is updated at the coupling frequency + !! + !! @param[in] a input spectra + !! @param[in] fval fillvalue + !! @param[inout] bhd a 1-D pointer to a field on a mesh + !! + !> @author Denise.Worthen@noaa.gov + !> @date 8-02-2024 + subroutine CalcBHD (a, bhd, fval) + + use w3gdatmd, only : nth, nk, nseal, mapsf, mapsta, dden + use w3adatmd, only : dw, cg, wn + use w3parall, only : init_get_isea + + ! input/output variables + real, intent(in) :: a(nth,nk,0:nseal) + real(ESMF_KIND_R8), intent(in) :: fval + real(ESMF_KIND_R8), pointer, intent(inout) :: bhd(:) + + ! local variables + real :: factor, kd, ab, ebd, bhd1 + integer :: ik, ith, isea, jsea, ix, iy + + do jsea = 1,nseal_cpl + call init_get_isea(isea, jsea) + ix = mapsf(isea,1) ! global ix + iy = mapsf(isea,2) ! global iy + if (mapsta(iy,ix) == 1) then ! active sea point + ebd = 0.0 + bhd1 = 0.0 + do ik = 1,nk + factor = dden(ik) / cg(ik,isea) + ab = 0.0 + do ith = 1,nth + ab = ab + a(ith,ik,jsea) + end do + ebd = ab*factor + kd = max ( 0.001 , wn(ik,isea) * dw(isea) ) + if (kd .lt. 6.0) then + bhd1 = bhd1 + grav*wn(ik,isea) * ebd / (sinh(2.*kd)) + end if + end do !ik + bhd(jsea) = bhd1 + else + bhd(jsea) = fval + end if + end do + + end subroutine CalcBHD + + !==================================================================================== + !> Calculate Stokes drift for export + !! + !> @details Calculates Stokes drift independently of w3iogomd to ensure + !! that exported USSX and USSY fields are updated at the coupling frequency + !! + !! @param[in] a input spectra + !! @param[in] fval fill value + !! @param[inout] us a 1-D pointer to a field on a mesh + !! @param[inout] vs a 1-D pointer to a field on a mesh + !! + !> @author Denise.Worthen@noaa.gov + !> @date 8-02-2024 + subroutine CalcStokes(a, us, vs, fval) + + use w3gdatmd, only : nth, nk, nseal, mapsf, mapsta, dden, ecos, esin + use w3adatmd, only : dw, cg, wn + use w3gdatmd, only : sig + use w3parall, only : init_get_isea + + ! input/output variables + real, intent(in) :: a(nth,nk,0:nseal) + real(ESMF_KIND_R8), intent(in) :: fval + real(ESMF_KIND_R8), pointer, intent(inout) :: us(:), vs(:) + + ! local variables + real :: factor, kd, abx, aby, fkd, ussco, us1, vs1 + integer :: ik, ith, isea, jsea, ix, iy + + do jsea = 1,nseal_cpl + call init_get_isea(isea, jsea) + ix = mapsf(isea,1) ! global ix + iy = mapsf(isea,2) ! global iy + if (mapsta(iy,ix) == 1) then ! active sea point + us1 = 0.0 + vs1 = 0.0 + do ik = 1,nk + factor = dden(ik) / cg(ik,isea) + abx = 0.0 + aby = 0.0 + do ith = 1,nth + abx = abx + a(ith,ik,jsea)*ecos(ith) + aby = aby + a(ith,ik,jsea)*esin(ith) + end do + kd = max ( 0.001 , wn(ik,isea) * dw(isea) ) + if (kd .lt. 6.0) then + fkd = factor / sinh(kd)**2 + ussco = fkd*sig(ik)*wn(ik,isea)*cosh(2.0*kd) + else + ussco = factor*sig(ik)*2.0*wn(ik,isea) + end if + us1 = us1 + abx*ussco + vs1 = vs1 + aby*ussco + end do !ik + us(jsea) = us1 + vs(jsea) = vs1 + else + us(jsea) = fval + vs(jsea) = fval + end if + end do + + end subroutine CalcStokes + + !==================================================================================== + !> Calculate UVBed drift for export + !! + !> @details Calculates near bed orbital velocities independently of w3iogomd to + !! ensure that exported UBRX and UBRY fields are updated at the coupling frequency + !! + !! @param[in] a input spectra + !! @param[in] fval fill value + !! @param[inout] ubrx a 1-D pointer to a field on a mesh + !! @param[inout] vbry a 1-D pointer to a field on a mesh + !! + !> @author Denise.Worthen@noaa.gov + !> @date 8-02-2024 + subroutine CalcUVBed(a, ubrx, ubry, fval) + + use w3gdatmd, only : nth, nk, nseal, mapsf, mapsta, dden, ecos, esin + use w3adatmd, only : dw, cg, wn + use w3gdatmd, only : sig + use w3parall, only : init_get_isea + + ! input/output variables + real, intent(in) :: a(nth,nk,0:nseal) + real(ESMF_KIND_R8), intent(in) :: fval + real(ESMF_KIND_R8), pointer, intent(inout) :: ubrx(:), ubry(:) + + ! local variables + real :: factor, kd, ab, abx, aby, fkd, uba1, ubd1, ubr1 + integer :: ik, ith, isea, jsea, ix, iy + + do jsea = 1,nseal_cpl + call init_get_isea(isea, jsea) + ix = mapsf(isea,1) ! global ix + iy = mapsf(isea,2) ! global iy + if (mapsta(iy,ix) == 1) then ! active sea point + uba1 = 0.0 + ubd1 = 0.0 + ubr1 = 0.0 + do ik = 1,nk + factor = dden(ik) / cg(ik,isea) + ab = 0.0 + abx = 0.0 + aby = 0.0 + do ith = 1,nth + ab = ab + a(ith,ik,jsea) + abx = abx + a(ith,ik,jsea)*ecos(ith) + aby = aby + a(ith,ik,jsea)*esin(ith) + end do + kd = max ( 0.001 , wn(ik,isea) * dw(isea) ) + if (kd .lt. 6.0) then + fkd = factor / sinh(kd)**2 + ubr1 = ubr1 + ab*sig(ik)**2 * fkd + uba1 = uba1 + abx*sig(ik)**2 * fkd + ubd1 = ubd1 + aby*sig(ik)**2 * fkd + end if + end do !ik + ubr1 = sqrt(2.0*max(0.0,ubr1)) + if (ubr1 .ge. 1.0e-7) then + ubd1 = atan2(ubd1,uba1) + else + ubd1 = 0.0 + end if + uba1 = ubr1 + ubrx(jsea) = uba1*cos(ubd1) + ubry(jsea) = uba1*sin(ubd1) + else + ubrx(jsea) = fval + ubry(jsea) = fval + end if + end do + + end subroutine CalcUVBed + + !=============================================================================== + !> Calculate mean wave direction for export + !! + !> @details Calculates mean wave direction independently of w3iogomd to ensure + !! that exported THM field is updated at the coupling frequency + !! + !! @param[in] a input spectra + !! @param[inout] thm a 1-D pointer to a field on a mesh + !! + !> @author Denise.Worthen@noaa.gov + !> @date 8-02-2024 + subroutine CalcTHM (a, thm, fval) + + use constants, only : rade + use w3gdatmd, only : nth, nk, nseal, mapsf, mapsta, dden, fte, ecos, esin + use w3adatmd, only : cg + use w3parall, only : init_get_isea + + ! input/output variables + real, intent(in) :: a(nth,nk,0:nseal) + real(ESMF_KIND_R8), intent(in) :: fval + real(ESMF_KIND_R8), pointer, intent(inout) :: thm(:) + + ! local variables + real :: factor, abx, aby, etx, ety + integer :: ik, ith, isea, jsea, ix, iy + + do jsea = 1,nseal_cpl + call init_get_isea(isea, jsea) + ix = mapsf(isea,1) ! global ix + iy = mapsf(isea,2) ! global iy + if (mapsta(iy,ix) == 1) then ! active sea point + etx = 0.0 + ety = 0.0 + do ik = 1,nk + factor = dden(ik) / cg(ik,isea) + abx = 0.0 + aby = 0.0 + do ith = 1,nth + abx = abx + a(ith,ik,jsea)*ecos(ith) + aby = aby + a(ith,ik,jsea)*esin(ith) + end do + etx = etx + abx*factor + ety = ety + aby*factor + end do !ik + etx = etx + fte * abx/cg(nk,isea) + ety = ety + fte * aby/cg(nk,isea) + if ( abs(etx) + abs(ety) .gt. 1.e-7 ) then + thm(jsea) = atan2(ety,etx) + else + thm(jsea) = 0.0 + end if + ! convert to degrees + thm(jsea) = mod(630.0 - rade*thm(jsea), 360.0) + else + thm(jsea) = fval + end if + end do + + end subroutine CalcTHM + + !=============================================================================== + !> Calculate mean wave direction for export + !! + !> @details Calculates mean wave period independently of w3iogomd to ensure + !! that exported T0M1 field is updated at the coupling frequency + !! + !! @param[in] a input spectra + !! @param[inout] thm a 1-D pointer to a field on a mesh + !! + !> @author Denise.Worthen@noaa.gov + !> @date 8-02-2024 + subroutine CalcT0M1 (a, t0m1, fval) + + use constants, only : tpi + use w3gdatmd, only : nth, nk, nseal, mapsf, mapsta, dden, fte, fttr, sig + use w3adatmd, only : cg + use w3parall, only : init_get_isea + + ! input/output variables + real, intent(in) :: a(nth,nk,0:nseal) + real(ESMF_KIND_R8), intent(in) :: fval + real(ESMF_KIND_R8), pointer, intent(inout) :: t0m1(:) + + ! local variables + real :: factor, eband, ab, et, ebd, etr + integer :: ik, ith, isea, jsea, ix, iy + + do jsea = 1,nseal_cpl + call init_get_isea(isea, jsea) + ix = mapsf(isea,1) ! global ix + iy = mapsf(isea,2) ! global iy + if (mapsta(iy,ix) == 1) then ! active sea point + etr = 0.0 + et = 0.0 + do ik = 1,nk + factor = dden(ik) / cg(ik,isea) + ab = 0.0 + do ith = 1,nth + ab = ab + a(ith,ik,jsea) + end do + ebd = ab*factor + et = et + ebd + etr = etr + ebd/sig(ik) + end do !ik + eband = ab/cg(nk,isea) + et = et + fte*eband + etr = etr + fttr*eband + if (et .gt. 1.0e-7) then + t0m1(jsea) = etr/et * tpi + else + t0m1(jsea) = tpi/sig(nk) + end if + else + t0m1(jsea) = fval + end if + end do + + end subroutine CalcT0M1 + !==================================================================================== !> Create a global field across all PEs !! @@ -1338,8 +1737,7 @@ end subroutine CalcEF !> @date 01-05-2022 subroutine SetGlobalInput(importState, fldname, vm, global_output, rc) - use w3gdatmd, only: nsea, nseal, nx, ny - use w3odatmd, only: naproc, iaproc + use w3gdatmd, only: nsea ! input/output variables type(ESMF_State) , intent(in) :: importState @@ -1349,7 +1747,7 @@ subroutine SetGlobalInput(importState, fldname, vm, global_output, rc) integer , intent(out) :: rc ! local variables - integer :: jsea, isea, ix, iy + integer :: jsea, isea real(r4) :: global_input(nsea) real(r8), pointer :: dataptr(:) character(len=*), parameter :: subname = '(wav_import_export:setGlobalInput)' @@ -1457,7 +1855,7 @@ end subroutine fillglobal_with_merge_import !> @date 01-05-2022 subroutine set_importmask(importState, clock, fldname, vm, rc) - use w3gdatmd, only: nsea, nseal, nx, ny + use w3gdatmd, only: nsea, nseal use w3odatmd, only: naproc, iaproc ! input/output variables @@ -1472,7 +1870,7 @@ subroutine set_importmask(importState, clock, fldname, vm, rc) type(ESMF_TimeInterval) :: timeStep logical :: firstCall, secondCall real(r4) :: fillValue = 9.99e20 - integer :: isea, jsea, ix, iy + integer :: isea, jsea real(r8), pointer :: dataptr(:) real(r4) :: mask_local(nsea) character(len=CL) :: msgString @@ -1552,7 +1950,7 @@ end subroutine set_importmask !> @date 01-05-2022 subroutine check_globaldata(gcomp, fldname, global_data, nvals, rc) - use w3gdatmd, only: nseal, nsea, mapsf, nx, ny + use w3gdatmd, only: nseal, mapsf, nx, ny use w3odatmd, only: naproc, iaproc ! input/output variables @@ -1565,7 +1963,7 @@ subroutine check_globaldata(gcomp, fldname, global_data, nvals, rc) ! local variables type(ESMF_Clock) :: clock type(ESMF_State) :: importState - type(ESMF_Time) :: currtime, nexttime + type(ESMF_Time) :: nexttime type(ESMF_Field) :: lfield type(ESMF_Field) :: newfield type(ESMF_MeshLoc) :: meshloc @@ -1573,7 +1971,6 @@ subroutine check_globaldata(gcomp, fldname, global_data, nvals, rc) character(len=CS) :: timestr character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) integer :: fieldCount - integer :: lrank integer :: yr,mon,day,sec ! time units integer :: jsea, isea, ix, iy real(r8), pointer :: dataptr1d(:) diff --git a/model/src/wav_pio_mod.F90 b/model/src/wav_pio_mod.F90 new file mode 100644 index 000000000..4f9b637a4 --- /dev/null +++ b/model/src/wav_pio_mod.F90 @@ -0,0 +1,420 @@ +!> @file wav_pio +!! +!> @brief Manage PIO for WW3 +!! +!> @author Denise.Worthen@noaa.gov +!> @date 08-02-2024 +module wav_pio_mod + + use w3gdatmd , only : nk, nx, ny, mapsf + use w3parall , only : init_get_isea + use w3gdatmd , only : nseal + use pio + use netcdf +#ifdef W3_PDLIB + use yowNodepool , only : ng +#endif + implicit none + + private + + interface wav_pio_initdecomp + module procedure wav_pio_initdecomp_2d + module procedure wav_pio_initdecomp_3d + end interface wav_pio_initdecomp + + integer :: pio_iotype + integer :: pio_ioformat + type(iosystem_desc_t), pointer :: wav_pio_subsystem + + public :: wav_pio_init + public :: pio_iotype + public :: pio_ioformat + public :: wav_pio_subsystem + public :: wav_pio_initdecomp + public :: handle_err + + !=============================================================================== +contains + !=============================================================================== + !> Configure PIO for WW3 + !! + !> @details Use either CESM shr code or configuration variables to configure PIO. + !! This configuration code is lifted from CMEPS. + !! + !! @param gcomp an ESMF_GridComp object + !! @param mpi_comm the MPI communicator + !! @param[in] stdout the logfile unit on the root_task + !! @param[in] numprocs naproc/nthrds + !! @param[out] rc a return code + !! + !> @author Denise.Worthen@noaa.gov + !> @date 08-02-2024 + subroutine wav_pio_init(gcomp, mpi_comm, stdout, numprocs, rc) + +#ifdef CESMCOUPLED + use shr_pio_mod, only : shr_pio_getiosys, shr_pio_getiotype, shr_pio_getioformat +#endif + use ESMF , only : ESMF_GridComp, ESMF_UtilStringUpperCase, ESMF_VM, ESMF_FAILURE + use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_ERROR + use NUOPC , only : NUOPC_CompAttributeGet + use wav_kind_mod , only : CL=>SHR_KIND_CL, CS=>SHR_KIND_CS + use w3odatmd , only : iaproc + use wav_shr_mod , only : chkerr + + ! input/output arguments + type(ESMF_GridComp), intent(in) :: gcomp + integer , intent(in) :: mpi_comm + integer , intent(in) :: stdout + integer , intent(in) :: numprocs + integer , intent(out) :: rc + + integer :: pio_numiotasks + integer :: pio_stride + integer :: pio_rearranger + integer :: pio_root + integer :: pio_debug_level + character(len=CS) :: cvalue + logical :: isPresent, isSet + integer :: my_task, master_task + character(len=CS) :: subname='wav_pio_init' + character(*), parameter :: u_FILE_u = & !< a character string for an ESMF log message + __FILE__ + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + +#ifdef CESMCOUPLED + ! TODO: needs testing + wav_pio_subsystem => shr_pio_getiosys(inst_name) + pio_iotype = shr_pio_getiotype(inst_name) + if ((pio_iotype==PIO_IOTYPE_NETCDF).or.(pio_iotype==PIO_IOTYPE_PNETCDF)) then + nmode0 = shr_pio_getioformat(inst_name) + else + nmode0 = 0 + endif + + call pio_seterrorhandling(wav_pio_subsystem, PIO_RETURN_ERROR) +#else + my_task = iaproc - 1 + master_task = 0 + + ! code lifted from CMEPS med_io_mod.F90 + ! query component specific PIO attributes + ! pio_netcdf_format + call NUOPC_CompAttributeGet(gcomp, name='pio_netcdf_format', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (isPresent .and. isSet) then + cvalue = ESMF_UtilStringUpperCase(cvalue) + if (trim(cvalue) .eq. 'CLASSIC') then + pio_ioformat = 0 + else if (trim(cvalue) .eq. '64BIT_OFFSET') then + pio_ioformat = PIO_64BIT_OFFSET + else if (trim(cvalue) .eq. '64BIT_DATA') then + pio_ioformat = PIO_64BIT_DATA + else + call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_ioformat ' & + //'(CLASSIC|64BIT_OFFSET|64BIT_DATA)', ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + end if + else + cvalue = '64BIT_OFFSET' + pio_ioformat = PIO_64BIT_OFFSET + end if + if (my_task == 0) write(stdout,*) trim(subname), ' : pio_netcdf_format = ', trim(cvalue), pio_ioformat + + ! pio_typename + call NUOPC_CompAttributeGet(gcomp, name='pio_typename', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (isPresent .and. isSet) then + cvalue = ESMF_UtilStringUpperCase(cvalue) + if (trim(cvalue) .eq. 'NETCDF') then + pio_iotype = PIO_IOTYPE_NETCDF + else if (trim(cvalue) .eq. 'PNETCDF') then + pio_iotype = PIO_IOTYPE_PNETCDF + else if (trim(cvalue) .eq. 'NETCDF4C') then + pio_iotype = PIO_IOTYPE_NETCDF4C + else if (trim(cvalue) .eq. 'NETCDF4P') then + pio_iotype = PIO_IOTYPE_NETCDF4P + else + call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_typename ' & + //'(NETCDF|PNETCDF|NETCDF4C|NETCDF4P)', ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + end if + else + cvalue = 'NETCDF' + pio_iotype = PIO_IOTYPE_NETCDF + end if + if (my_task == 0) write(stdout,*) trim(subname), ' : pio_typename = ', trim(cvalue), pio_iotype + + ! pio_root + call NUOPC_CompAttributeGet(gcomp, name='pio_root', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (isPresent .and. isSet) then + read(cvalue,*) pio_root + if (pio_root < 0) then + pio_root = 1 + endif + pio_root = min(pio_root, numprocs-1) + else + pio_root = 1 + end if + if (my_task == 0) write(stdout,*) trim(subname), ' : pio_root = ', pio_root + + ! pio_stride + call NUOPC_CompAttributeGet(gcomp, name='pio_stride', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (isPresent .and. isSet) then + read(cvalue,*) pio_stride + else + pio_stride = -99 + end if + if (my_task == 0) write(stdout,*) trim(subname), ' : pio_stride = ', pio_stride + + ! pio_numiotasks + call NUOPC_CompAttributeGet(gcomp, name='pio_numiotasks', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (isPresent .and. isSet) then + read(cvalue,*) pio_numiotasks + else + pio_numiotasks = -99 + end if + if (my_task == 0) write(stdout,*) trim(subname), ' : pio_numiotasks = ', pio_numiotasks + + ! check for parallel IO, it requires at least two io pes + if (numprocs > 1 .and. pio_numiotasks == 1 .and. & + (pio_iotype .eq. PIO_IOTYPE_PNETCDF .or. pio_iotype .eq. PIO_IOTYPE_NETCDF4P)) then + pio_numiotasks = 2 + pio_stride = min(pio_stride, numprocs/2) + if (my_task == 0) then + write(stdout,*) ' parallel io requires at least two io pes - following parameters are updated:' + write(stdout,*) trim(subname), ' : pio_stride = ', pio_stride + write(stdout,*) trim(subname), ' : pio_numiotasks = ', pio_numiotasks + end if + endif + + ! check/set/correct io pio parameters + if (pio_stride > 0 .and. pio_numiotasks < 0) then + pio_numiotasks = max(1, numprocs/pio_stride) + if (my_task == 0) write(stdout,*) trim(subname), ' : update pio_numiotasks = ', pio_numiotasks + else if(pio_numiotasks > 0 .and. pio_stride < 0) then + pio_stride = max(1, numprocs/pio_numiotasks) + if (my_task == 0) write(stdout,*) trim(subname), ' : update pio_stride = ', pio_stride + else if(pio_numiotasks < 0 .and. pio_stride < 0) then + pio_stride = max(1,numprocs/4) + pio_numiotasks = max(1,numprocs/pio_stride) + if (my_task == 0) write(stdout,*) trim(subname), ' : update pio_numiotasks = ', pio_numiotasks + if (my_task == 0) write(stdout,*) trim(subname), ' : update pio_stride = ', pio_stride + end if + if (pio_stride == 1) then + pio_root = 0 + endif + + if (pio_root + (pio_stride)*(pio_numiotasks-1) >= numprocs .or. & + pio_stride <= 0 .or. pio_numiotasks <= 0 .or. pio_root < 0 .or. pio_root > numprocs-1) then + if (numprocs < 100) then + pio_stride = max(1, numprocs/4) + else if(numprocs < 1000) then + pio_stride = max(1, numprocs/8) + else + pio_stride = max(1, numprocs/16) + end if + if(pio_stride > 1) then + pio_numiotasks = numprocs/pio_stride + pio_root = min(1, numprocs-1) + else + pio_numiotasks = numprocs + pio_root = 0 + end if + if (my_task == 0) then + write(stdout,*) 'pio_stride, iotasks or root out of bounds - resetting to defaults:' + write(stdout,*) trim(subname), ' : pio_root = ', pio_root + write(stdout,*) trim(subname), ' : pio_stride = ', pio_stride + write(stdout,*) trim(subname), ' : pio_numiotasks = ', pio_numiotasks + end if + end if + + ! pio_rearranger + call NUOPC_CompAttributeGet(gcomp, name='pio_rearranger', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (isPresent .and. isSet) then + cvalue = ESMF_UtilStringUpperCase(cvalue) + if (trim(cvalue) .eq. 'BOX') then + pio_rearranger = PIO_REARR_BOX + else if (trim(cvalue) .eq. 'SUBSET') then + pio_rearranger = PIO_REARR_SUBSET + else + call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_rearranger (BOX|SUBSET)', ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + end if + else + cvalue = 'SUBSET' + pio_rearranger = PIO_REARR_SUBSET + end if + if (my_task == 0) write(stdout,*) trim(subname), ' : pio_rearranger = ', trim(cvalue), pio_rearranger + + ! init PIO + if (my_task == 0) then + write(stdout,*) trim(subname),' calling pio init' + write(stdout,*) trim(subname), ' : pio_root = ', pio_root + write(stdout,*) trim(subname), ' : pio_stride = ', pio_stride + write(stdout,*) trim(subname), ' : pio_numiotasks = ', pio_numiotasks + end if + + allocate(wav_pio_subsystem) + call pio_init(my_task, mpi_comm, pio_numiotasks, master_task, pio_stride, pio_rearranger, & + wav_pio_subsystem, base=pio_root) + + ! PIO debug related options + ! pio_debug_level + call NUOPC_CompAttributeGet(gcomp, name='pio_debug_level', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) pio_debug_level + if (pio_debug_level < 0 .or. pio_debug_level > 6) then + call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_debug_level (0-6)', ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + end if + else + pio_debug_level = 0 + end if + if (my_task == 0) write(stdout,*) trim(subname), ' : pio_debug_level = ', pio_debug_level + + ! set PIO debug level + call pio_setdebuglevel(pio_debug_level) + + call pio_seterrorhandling(wav_pio_subsystem, PIO_RETURN_ERROR) +#endif + end subroutine wav_pio_init + + !=============================================================================== + !> Define a decomposition for a 2d variable in WW3 + !! + !! @param[out] iodesc the PIO decomposition handle + !! @param[out] use_int define a decomposition for an integer array + !! + !> @author Denise.Worthen@noaa.gov + !> @date 08-02-2024 + subroutine wav_pio_initdecomp_2d(iodesc, use_int) + + type(io_desc_t), intent(out) :: iodesc + logical , optional, intent(in) :: use_int + + ! local variables + integer :: n, isea, jsea, ix, iy, nseal_cpl + logical :: luse_int + integer(kind=PIO_OFFSET_KIND) :: lnx,lny + integer(kind=PIO_OFFSET_KIND), allocatable :: dof2d(:) +#ifdef W3_PDLIB + nseal_cpl = nseal - ng +#else + nseal_cpl = nseal +#endif + luse_int = .false. + if (present(use_int)) luse_int = use_int + + allocate(dof2d(nseal_cpl)) + dof2d = 0 + lnx = int(nx,PIO_OFFSET_KIND) + lny = int(ny,PIO_OFFSET_KIND) + + n = 0 + do jsea = 1,nseal_cpl + call init_get_isea(isea, jsea) + ix = mapsf(isea,1) ! global ix + iy = mapsf(isea,2) ! global iy + n = n+1 + dof2d(n) = (iy-1)*lnx + ix ! local index : global index + end do + + if (luse_int) then + call pio_initdecomp(wav_pio_subsystem, PIO_INT, (/nx,ny/), dof2d, iodesc) + else + call pio_initdecomp(wav_pio_subsystem, PIO_REAL, (/nx,ny/), dof2d, iodesc) + end if + deallocate(dof2d) + + end subroutine wav_pio_initdecomp_2d + + !=============================================================================== + !> Define a decomposition for a 3d variable in WW3 + !! + !! @param[in] nz the non-spatial dimension + !! @param[out] iodesc the PIO decomposition handle + !! + !> @author Denise.Worthen@noaa.gov + !> @date 08-02-2024 + subroutine wav_pio_initdecomp_3d(nz, iodesc) + + integer , intent(in) :: nz + type(io_desc_t) , intent(out) :: iodesc + + ! local variables + integer :: n, k, isea, jsea, ix, iy, nseal_cpl + integer(kind=PIO_OFFSET_KIND) :: lnx,lny + integer(kind=PIO_OFFSET_KIND), allocatable :: dof3d(:) +#ifdef W3_PDLIB + nseal_cpl = nseal - ng +#else + nseal_cpl = nseal +#endif + allocate(dof3d(nz*nseal_cpl)) + + dof3d = 0 + lnx = int(nx,PIO_OFFSET_KIND) + lny = int(ny,PIO_OFFSET_KIND) + + n = 0 + do k = 1,nz + do jsea = 1,nseal_cpl + call init_get_isea(isea, jsea) + ix = mapsf(isea,1) ! global ix + iy = mapsf(isea,2) ! global iy + n = n+1 + dof3d(n) = ((iy-1)*lnx + ix) + (k-1)*lnx*lny ! local index : global index + end do + end do + + call pio_initdecomp(wav_pio_subsystem, PIO_REAL, (/nx,ny,nz/), dof3d, iodesc) + deallocate(dof3d) + + end subroutine wav_pio_initdecomp_3d + + !=============================================================================== + !> Handle errors + !! + !! @param[in] ierr the error code + !! @param[in] string the error message + !! + !> @author Denise.Worthen@noaa.gov + !> @date 08-02-2024 + subroutine handle_err(ierr,string) + + use w3odatmd , only : ndse + use w3servmd , only : extcde + + ! input/output variables + integer , intent(in) :: ierr + character(len=*), intent(in) :: string + + integer :: strerror_status + character(len=pio_max_name) :: err_msg + + if (ierr /= PIO_NOERR) then + strerror_status = pio_strerror(ierr, err_msg) + write(ndse,*) "*** WAVEWATCH III netcdf error: ",trim(string),':',trim(err_msg) + call extcde ( 49 ) + end if + end subroutine handle_err + +end module wav_pio_mod diff --git a/model/src/wav_restart_mod.F90 b/model/src/wav_restart_mod.F90 new file mode 100644 index 000000000..9d1c67780 --- /dev/null +++ b/model/src/wav_restart_mod.F90 @@ -0,0 +1,538 @@ +!> @file wav_restart_mod +!! +!> @brief Handle WW3 restart files as netCDF using PIO +!! +!> @author Denise.Worthen@noaa.gov +!> @date 08-26-2024 +module wav_restart_mod + + use w3parall , only : init_get_isea + use w3adatmd , only : nsealm + use w3gdatmd , only : nth, nk, nx, ny, mapsf, nspec, nseal, nsea + use w3odatmd , only : ndso, iaproc, addrstflds, rstfldlist, rstfldcnt + use w3wdatmd , only : ice + use wav_pio_mod , only : pio_iotype, pio_ioformat, wav_pio_subsystem + use wav_pio_mod , only : handle_err, wav_pio_initdecomp +#ifdef W3_PDLIB + use yowNodepool , only : ng +#endif + use pio + use netcdf + + implicit none + + private + + type(file_desc_t) :: pioid + type(var_desc_t) :: varid + type(io_desc_t) :: iodesc2dint + type(io_desc_t) :: iodesc2d + + integer(kind=Pio_Offset_Kind) :: frame + + public :: write_restart + public :: read_restart + + ! used/reused in module + character(len=4) :: cspec + character(len=12) :: vname + integer :: ik, ith, ix, iy, kk, isea, jsea, ierr, i + + !=============================================================================== +contains + !=============================================================================== + !> Write a WW3 restart file + !! + !! @details Called by w3wavemd to write a restart file at a given frequency or + !! time + !! + !! @param[in] fname the time-stamped file name + !! @param[in] va the va array + !! @param[in] mapsta the mapsta + 8*mapst2 array + !! + !> author DeniseWorthen@noaa.gov + !> @date 08-26-2024 + subroutine write_restart (fname, va, mapsta) + + use w3odatmd , only : time_origin, calendar_name, elapsed_secs + + real , intent(in) :: va(1:nspec,0:nsealm) + integer , intent(in) :: mapsta(ny,nx) + character(len=*), intent(in) :: fname + + ! local variables + integer :: timid, xtid, ytid + integer :: nseal_cpl, nmode + integer :: dimid(3) + real , allocatable :: lva(:,:) + integer, allocatable :: lmap(:) + !------------------------------------------------------------------------------- + +#ifdef W3_PDLIB + nseal_cpl = nseal - ng +#else + nseal_cpl = nseal +#endif + allocate(lva(1:nseal_cpl,1:nspec)) + allocate(lmap(1:nseal_cpl)) + lva(:,:) = 0.0 + lmap(:) = 0 + + ! create the netcdf file + frame = 1 + pioid%fh = -1 + nmode = pio_clobber + ! only applies to classic NETCDF files. + if (pio_iotype == PIO_IOTYPE_NETCDF .or. pio_iotype == PIO_IOTYPE_PNETCDF) then + nmode = ior(nmode,pio_ioformat) + endif + ierr = pio_createfile(wav_pio_subsystem, pioid, pio_iotype, trim(fname), nmode) + call handle_err(ierr, 'pio_create') + if (iaproc == 1) write(ndso,'(a)')' Writing restart file '//trim(fname) + + ierr = pio_def_dim(pioid, 'nx', nx, xtid) + ierr = pio_def_dim(pioid, 'ny', ny, ytid) + ierr = pio_def_dim(pioid, 'time', PIO_UNLIMITED, timid) + + ! define the time variable + ierr = pio_def_var(pioid, 'time', PIO_DOUBLE, (/timid/), varid) + call handle_err(ierr,'def_timevar') + ierr = pio_put_att(pioid, varid, 'units', trim(time_origin)) + call handle_err(ierr,'def_time_units') + ierr = pio_put_att(pioid, varid, 'calendar', trim(calendar_name)) + call handle_err(ierr,'def_time_calendar') + + ! define the nth,nk sizes + ierr = pio_def_var(pioid, 'nth', PIO_INT, varid) + call handle_err(ierr,'def_nth') + ierr = pio_put_att(pioid, varid, 'long_name', 'number of direction bins') + ierr = pio_def_var(pioid, 'nk', PIO_INT, varid) + call handle_err(ierr,'def_nk') + ierr = pio_put_att(pioid, varid, 'long_name', 'number of frequencies') + + ! write each nspec as separate variable + do kk = 1,nspec + write(cspec,'(i4.4)')kk + vname = 'va'//cspec + dimid = (/xtid, ytid, timid/) + ierr = pio_def_var(pioid, trim(vname), PIO_REAL, dimid, varid) + call handle_err(ierr, 'define variable '//trim(vname)) + ierr = pio_put_att(pioid, varid, '_FillValue', nf90_fill_float) + call handle_err(ierr, 'define _FillValue '//trim(vname)) + end do + + vname = 'mapsta' + ierr = pio_def_var(pioid, trim(vname), PIO_INT, (/xtid, ytid, timid/), varid) + call handle_err(ierr, 'define variable '//trim(vname)) + ierr = pio_put_att(pioid, varid, '_FillValue', nf90_fill_int) + call handle_err(ierr, 'define _FillValue '//trim(vname)) + + ! define any requested additional fields + if (addrstflds) then + do i = 1,rstfldcnt + vname = trim(rstfldlist(i)) + ierr = pio_def_var(pioid, trim(vname), PIO_REAL, (/xtid, ytid, timid/), varid) + call handle_err(ierr, 'define variable '//trim(vname)) + ierr = pio_put_att(pioid, varid, '_FillValue', nf90_fill_float) + call handle_err(ierr, 'define _FillValue '//trim(vname)) + end do + end if + ! end variable definitions + ierr = pio_enddef(pioid) + call handle_err(ierr, 'end variable definition') + + ! write the freq and direction sizes + ierr = pio_inq_varid(pioid, 'nth', varid) + call handle_err(ierr, 'inquire variable nth ') + ierr = pio_put_var(pioid, varid, nth) + call handle_err(ierr, 'put nth') + ierr = pio_inq_varid(pioid, 'nk', varid) + call handle_err(ierr, 'inquire variable nk ') + ierr = pio_put_var(pioid, varid, nk) + call handle_err(ierr, 'put nk') + + ! initialize the decomp + call wav_pio_initdecomp(iodesc2dint, use_int=.true.) + call wav_pio_initdecomp(iodesc2d) + + ! write the time + ierr = pio_inq_varid(pioid, 'time', varid) + call handle_err(ierr, 'inquire variable time ') + ierr = pio_put_var(pioid, varid, (/1/), real(elapsed_secs,8)) + call handle_err(ierr, 'put time') + + ! mapsta is global + do jsea = 1,nseal_cpl + call init_get_isea(isea, jsea) + ix = mapsf(isea,1) + iy = mapsf(isea,2) + lmap(jsea) = mapsta(iy,ix) + end do + + ! write PE local map + vname = 'mapsta' + ierr = pio_inq_varid(pioid, trim(vname), varid) + call handle_err(ierr, 'inquire variable '//trim(vname)) + call pio_setframe(pioid, varid, int(1,kind=Pio_Offset_Kind)) + call pio_write_darray(pioid, varid, iodesc2dint, lmap, ierr) + call handle_err(ierr, 'put variable '//trim(vname)) + + ! write va + do jsea = 1,nseal_cpl + kk = 0 + do ik = 1,nk + do ith = 1,nth + kk = kk + 1 + lva(jsea,kk) = va(kk,jsea) + end do + end do + end do + + do kk = 1,nspec + write(cspec,'(i4.4)')kk + vname = 'va'//cspec + ierr = pio_inq_varid(pioid, trim(vname), varid) + call handle_err(ierr, 'inquire variable '//trim(vname)) + call pio_setframe(pioid, varid, int(1,kind=PIO_OFFSET_KIND)) + call pio_write_darray(pioid, varid, iodesc2d, lva(:,kk), ierr) + call handle_err(ierr, 'put variable '//trim(vname)) + end do + + ! write requested additional global(nsea) fields + if (addrstflds) then + do i = 1,rstfldcnt + vname = trim(rstfldlist(i)) + if (vname == 'ice')call write_globalfield(vname, nseal_cpl, ice(1:nsea)) + end do + end if + + call pio_syncfile(pioid) + call pio_freedecomp(pioid, iodesc2d) + call pio_freedecomp(pioid, iodesc2dint) + call pio_closefile(pioid) + + end subroutine write_restart + + !=============================================================================== + !> Read a WW3 restart file + !! + !> @details Called by w3init to read a restart file which is known to exist or to + !! initialize a set of variables when the filename is "none". + !! + !! @param[in] fname the time-stamped file name + !! @param[out] va the va array, optional + !! @param[out] mapsta the mapsta array, optional + !! @param[inout] mapst2 the mapst2 array, optional + !! + !> author DeniseWorthen@noaa.gov + !> @date 08-26-2024 + subroutine read_restart (fname, va, mapsta, mapst2) + + use mpi_f08 + use w3adatmd , only : mpi_comm_wave + use w3gdatmd , only : sig + use w3idatmd , only : icei + use w3wdatmd , only : time, tlev, tice, trho, tic1, tic5, wlv, asf, fpis + + character(len=*) , intent(in) :: fname + real , optional , intent(out) :: va(1:nspec,0:nsealm) + integer, optional , intent(out) :: mapsta(ny,nx) + integer, optional , intent(inout) :: mapst2(ny,nx) + + ! local variables + type(MPI_Comm) :: wave_communicator ! needed for mpi_f08 + integer, allocatable :: global_input(:), global_output(:) + integer :: nseal_cpl + integer :: ifill + real :: rfill + real , allocatable :: lva(:,:) + integer, allocatable :: lmap(:) + integer, allocatable :: lmap2d(:,:) + integer, allocatable :: st2init(:,:) + !------------------------------------------------------------------------------- + + ! cold start, set initial values and return. + if (trim(fname) == 'none') then + tlev(1) = -1 + tlev(2) = 0 + tice(1) = -1 + tice(2) = 0 + trho(1) = -1 + trho(2) = 0 + tic1(1) = -1 + tic1(2) = 0 + tic5(1) = -1 + tic5(2) = 0 + wlv = 0. + ice = 0. + asf = 1. + fpis = sig(nk) + if (iaproc == 1) write(ndso,'(a)')' Initializing WW3 at rest ' + return + end if + + ! read a netcdf restart + wave_communicator%mpi_val = MPI_COMM_WAVE +#ifdef W3_PDLIB + nseal_cpl = nseal - ng +#else + nseal_cpl = nseal +#endif + allocate(lva(1:nseal_cpl,1:nspec)) + allocate(lmap(1:nseal_cpl)) + allocate(lmap2d(1:ny,1:nx)) + allocate(st2init(1:ny,1:nx)) + lva(:,:) = 0.0 + lmap(:) = 0 + lmap2d(:,:) = 0 + + ! save a copy of initial mapst2 from mod_def + st2init = mapst2 + + ! all times are restart times + tlev = time + tice = time + trho = time + tic1 = time + tic5 = time + frame = 1 + ierr = pio_openfile(wav_pio_subsystem, pioid, pio_iotype, trim(fname), pio_nowrite) + call handle_err(ierr, 'open file '//trim(fname)) + if (iaproc == 1) write(ndso,'(a)')' Reading restart file '//trim(fname) + + ! check the field dimensions and sizes against the current values + call checkfile() + + ! initialize the decomp + call wav_pio_initdecomp(iodesc2dint, use_int=.true.) + call wav_pio_initdecomp(iodesc2d) + + do kk = 1,nspec + write(cspec,'(i4.4)')kk + vname = 'va'//cspec + ierr = pio_inq_varid(pioid, trim(vname), varid) + call handle_err(ierr, 'inquire variable '//trim(vname)) + call pio_setframe(pioid, varid, frame) + ierr = pio_get_att(pioid, varid, "_FillValue", rfill) + call handle_err(ierr, 'get variable _FillValue'//trim(vname)) + call pio_read_darray(pioid, varid, iodesc2d, lva(:,kk), ierr) + call handle_err(ierr, 'get variable '//trim(vname)) + end do + + va = 0.0 + do jsea = 1,nseal_cpl + kk = 0 + do ik = 1,nk + do ith = 1,nth + kk = kk + 1 + if (lva(jsea,kk) .ne. rfill) then + va(kk,jsea) = lva(jsea,kk) + end if + end do + end do + end do + + vname = 'mapsta' + ierr = pio_inq_varid(pioid, trim(vname), varid) + call handle_err(ierr, 'inquire variable '//trim(vname)) + call pio_setframe(pioid, varid, frame) + call pio_read_darray(pioid, varid, iodesc2dint, lmap, ierr) + call handle_err(ierr, 'get variable '//trim(vname)) + ierr = pio_get_att(pioid, varid, "_FillValue", ifill) + call handle_err(ierr, 'get variable _FillValue'//trim(vname)) + + ! fill global array with PE local values + allocate(global_input(nsea)) + allocate(global_output(nsea)) + global_input = 0 + global_output = 0 + do jsea = 1,nseal_cpl + call init_get_isea(isea, jsea) + if (lmap(jsea) .ne. ifill) then + global_input(isea) = lmap(jsea) + end if + end do + ! reduce across all PEs to create global array + call MPI_AllReduce(global_input, global_output, nsea, MPI_INTEGER, MPI_SUM, wave_communicator, ierr) + + ! fill global array on each PE + do isea = 1,nsea + ix = mapsf(isea,1) + iy = mapsf(isea,2) + lmap2d(iy,ix) = global_output(isea) + end do + deallocate(global_input) + deallocate(global_output) + + mapsta = mod(lmap2d+2,8) - 2 + mapst2 = st2init + (lmap2d-mapsta)/8 + + ! read additional global(nsea) restart fields + if (addrstflds) then + do i = 1,rstfldcnt + vname = trim(rstfldlist(i)) + if (vname == 'ice')call read_globalfield(wave_communicator, vname, nseal_cpl, ice(1:nsea), icei) + end do + end if + + call pio_syncfile(pioid) + call pio_freedecomp(pioid, iodesc2d) + call pio_freedecomp(pioid, iodesc2dint) + call pio_closefile(pioid) + + end subroutine read_restart + + !=============================================================================== + !> Write a decomposed array of (nsea) global values + !! + !! @param[in] vname the variable name + !! @param[in] nseal_cpl the PE local dimension, disregarding halos + !! @param[in] global_input the global array + !! + !> author DeniseWorthen@noaa.gov + !> @date 09-22-2024 + subroutine write_globalfield(vname, nseal_cpl, global_input) + + character(len=*) , intent(in) :: vname + integer , intent(in) :: nseal_cpl + real , intent(in) :: global_input(:) + + ! local variable + real, allocatable :: lvar(:) + + allocate(lvar(1:nseal_cpl)) + + lvar(:) = 0.0 + do jsea = 1,nseal_cpl + call init_get_isea(isea, jsea) + lvar(jsea) = global_input(isea) + end do + + !write PE local field + ierr = pio_inq_varid(pioid, trim(vname), varid) + call handle_err(ierr, 'inquire variable '//trim(vname)) + call pio_setframe(pioid, varid, int(1,kind=Pio_Offset_Kind)) + call pio_write_darray(pioid, varid, iodesc2d, lvar, ierr) + call handle_err(ierr, 'put variable '//trim(vname)) + + end subroutine write_globalfield + + !=============================================================================== + !> Read a decomposed array of (nsea) global values and return a global field on + !! each DE + !! + !! @param[in] wave_communicator the MPI handle + !! @param[in] vname the variable name + !! @param[in] nseal_cpl the PE local dimension, disregarding halos + !! @param[out] global_output the global array, nsea points on each DE + !! @param[out] global_2d the global array, (nx,ny) points on each DE + !! + !> author DeniseWorthen@noaa.gov + !> @date 09-22-2024 + subroutine read_globalfield(wave_communicator, vname, nseal_cpl, global_output, global_2d) + + use mpi_f08 + + type(MPI_Comm) , intent(in) :: wave_communicator ! needed for mpi_f08 + character(len=*) , intent(in) :: vname + integer , intent(in) :: nseal_cpl + real , intent(out) :: global_output(:) + real , intent(out) :: global_2d(:,:) + + ! local variables + real, allocatable :: global_input(:) + real :: rfill + real, allocatable :: lvar(:) + + allocate(lvar(1:nseal_cpl)) + lvar(:) = 0.0 + + ierr = pio_inq_varid(pioid, trim(vname), varid) + call handle_err(ierr, 'inquire variable '//trim(vname)) + call pio_setframe(pioid, varid, frame) + call pio_read_darray(pioid, varid, iodesc2d, lvar, ierr) + call handle_err(ierr, 'get variable '//trim(vname)) + ierr = pio_get_att(pioid, varid, "_FillValue", rfill) + call handle_err(ierr, 'get variable _FillValue'//trim(vname)) + + ! fill global array with PE local values + allocate(global_input(nsea)) + global_input = 0.0 + global_output = 0.0 + do jsea = 1,nseal_cpl + call init_get_isea(isea, jsea) + if (lvar(jsea) .ne. rfill) then + global_input(isea) = lvar(jsea) + end if + end do + ! reduce across all PEs to create global array + call MPI_AllReduce(global_input, global_output, nsea, MPI_REAL, MPI_SUM, wave_communicator, ierr) + deallocate(global_input) + + global_2d = 0.0 + do isea = 1,nsea + ix = mapsf(isea,1) + iy = mapsf(isea,2) + global_2d(ix,iy) = global_output(isea) + end do + + end subroutine read_globalfield + + !=============================================================================== + !> Check that a restart file has the expected dimensions and sizes + !! + !> author DeniseWorthen@noaa.gov + !> @date 10-15-2024 + subroutine checkfile() + + use w3odatmd , only : ndse + use w3servmd , only : extcde + + integer :: dimid, ivar + integer(kind=PIO_OFFSET_KIND) :: dimlen + + ! check dimension nx + vname = 'nx' + ierr = pio_inq_dimid(pioid, vname, dimid) + call handle_err(ierr, 'inquire dimension '//trim(vname)) + ierr = pio_inq_dimlen(pioid, dimid, dimlen) + if (dimlen /= int(nx,PIO_OFFSET_KIND)) then + write(ndse,*) '*** WAVEWATCH III restart error: '//trim(vname)//' does not match expected value' + call extcde ( 49 ) + end if + + ! check dimension ny + vname = 'ny' + ierr = pio_inq_dimid(pioid, vname, dimid) + call handle_err(ierr, 'inquire dimension '//trim(vname)) + ierr = pio_inq_dimlen(pioid, dimid, dimlen) + if (dimlen /= int(ny,PIO_OFFSET_KIND)) then + write(ndse,*) '*** WAVEWATCH III restart error: '//trim(vname)//' does not match expected value' + call extcde ( 49 ) + end if + + ! check number of directions + vname = 'nth' + ierr = pio_inq_varid(pioid, vname, varid) + call handle_err(ierr, 'inquire variable '//trim(vname)) + ierr = pio_get_var(pioid, varid, ivar) + call handle_err(ierr, 'get variable '//trim(vname)) + if (ivar .ne. nth) then + write(ndse,*) '*** WAVEWATCH III restart error: '//trim(vname)//' does not match expected value' + call extcde ( 49 ) + end if + + ! check number of frequencies + vname = 'nk' + ierr = pio_inq_varid(pioid, vname, varid) + call handle_err(ierr, 'inquire variable '//trim(vname)) + ierr = pio_get_var(pioid, varid, ivar) + call handle_err(ierr, 'get variable '//trim(vname)) + if (ivar .ne. nk) then + write(ndse,*) '*** WAVEWATCH III restart error: '//trim(vname)//' does not match expected value' + call extcde ( 49 ) + end if + + end subroutine checkfile + +end module wav_restart_mod diff --git a/model/src/wav_shel_inp.F90 b/model/src/wav_shel_inp.F90 index 1590b3b38..923d3c3ad 100644 --- a/model/src/wav_shel_inp.F90 +++ b/model/src/wav_shel_inp.F90 @@ -50,7 +50,10 @@ subroutine set_shel_io(stdout,mds,ntrace) ! Input parameter integer , intent(in) :: stdout - integer , intent(out) :: mds(13), ntrace(2) + integer , intent(out) :: mds(15), ntrace(2) + + ! local variables + integer :: i ! Note that nds is set to mds in w3initmd.F90 - mds is a local array ! The following units are referenced in module w3initmd @@ -80,17 +83,13 @@ subroutine set_shel_io(stdout,mds,ntrace) ! By default, unit numbers between 50 and 99 are scanned to find an ! unopened unit number - call ESMF_UtilIOUnitGet(mds(5)) ; open(unit=mds(5) , status='scratch') - call ESMF_UtilIOUnitGet(mds(6)) ; open(unit=mds(6) , status='scratch') - call ESMF_UtilIOUnitGet(mds(7)) ; open(unit=mds(7) , status='scratch') - call ESMF_UtilIOUnitGet(mds(8)) ; open(unit=mds(8) , status='scratch') - call ESMF_UtilIOUnitGet(mds(9)) ; open(unit=mds(9) , status='scratch') - call ESMF_UtilIOUnitGet(mds(10)); open(unit=mds(10) , status='scratch') - call ESMF_UtilIOUnitGet(mds(11)); open(unit=mds(11) , status='scratch') - call ESMF_UtilIOUnitGet(mds(12)); open(unit=mds(12) , status='scratch') - call ESMF_UtilIOUnitGet(mds(13)); open(unit=mds(13) , status='scratch') - close(mds(5)); close(mds(6)); close(mds(7)); close(mds(8)); close(mds(9)); close(mds(10)) - close(mds(11)); close(mds(12)); close(mds(13)) + do i = 5,size(mds) + call ESMF_UtilIOUnitGet(mds(i)) + open(unit=mds(i), status='scratch') + end do + do i = 5,size(mds) + close(mds(i)) + end do ntrace(1) = mds(3) ntrace(2) = 10 @@ -101,10 +100,14 @@ end subroutine set_shel_io !> Read ww3_shel.inp Or ww3_shel.nml !! !! @param[in] mpi_comm mpi communicator + !! @param[in] mds an array of unit numbers + !! @param[in] time0_overwrite the initial time for overwriting the nml file, optional + !! @param[in] timen_overwrite the endding time for overwriting the nml file, optional + !! @param[out] rstfldlist a list of additional restart fields, optional !! !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov !> @date 01-05-2022 - subroutine read_shel_config(mpi_comm, mds, time0_overwrite, timen_overwrite) + subroutine read_shel_config(mpi_comm, mds, time0_overwrite, timen_overwrite, rstfldlist) use wav_shr_flags use w3nmlshelmd , only : nml_domain_t, nml_input_t, nml_output_type_t @@ -128,12 +131,14 @@ subroutine read_shel_config(mpi_comm, mds, time0_overwrite, timen_overwrite) #ifdef W3_NL5 use w3wdatmd , only : qi5tbeg #endif + use wav_kind_mod , only : CL => shr_kind_cl ! input/output parameters - integer, intent(in) :: mpi_comm - integer, intent(in) :: mds(:) - integer, intent(in), optional :: time0_overwrite(2) - integer, intent(in), optional :: timen_overwrite(2) + integer, intent(in) :: mpi_comm + integer, intent(in) :: mds(:) + integer, intent(in), optional :: time0_overwrite(2) + integer, intent(in), optional :: timen_overwrite(2) + character(len=CL), intent(out), optional :: rstfldlist ! local parameters integer, parameter :: nhmax = 200 @@ -204,8 +209,9 @@ subroutine read_shel_config(mpi_comm, mds, time0_overwrite, timen_overwrite) memunit = 740+IAPROC call print_logmsg(740+IAPROC, 'read_shel_config, step 1', w3_debuginit_flag) - ! ndso, ndse, ndst are set in w3initmd using mds; w3initmd is called by either - ! cesm_init or uwm_int after calling the read_shel_config routine + ! module variables ndso, ndse, ndst are set in w3initmd using mds; w3initmd is + ! called by either cesm_init or uwm_int after calling the read_shel_config routine. + ! these nd units are local variables here ndso = mds(1) ndse = mds(1) ndst = mds(1) @@ -639,6 +645,13 @@ subroutine read_shel_config(mpi_comm, mds, time0_overwrite, timen_overwrite) ! Extra fields to be written in the restart fldrst = nml_output_type%restart%extra call w3flgrdflag ( ndso, ndso, ndse, fldrst, flogr, flogrr, iaproc, napout, ierr ) + if (present(rstfldlist)) then + if (trim(fldrst) .ne. 'unset')then + rstfldlist = trim(fldrst) + else + rstfldlist = ' ' + end if + end if if ( ierr .ne. 0 ) goto 2222 ! force minimal allocation to avoid memory seg fault diff --git a/model/src/wav_shr_mod.F90 b/model/src/wav_shr_mod.F90 index 2d4c1149f..4f9fe99e2 100644 --- a/model/src/wav_shr_mod.F90 +++ b/model/src/wav_shr_mod.F90 @@ -48,6 +48,7 @@ module wav_shr_mod private :: field_getfldptr !< @private obtain a pointer to a field public :: diagnose_mesh !< @public write out info about mesh public :: write_meshdecomp !< @public write the mesh decomposition to a file + public :: wav_loginit !< @public write the verbose WW3 log header interface state_getfldptr module procedure state_getfldptr_1d @@ -1352,6 +1353,28 @@ subroutine ymd2date_long(year,month,day,date) if (year < 0) date = -date end subroutine ymd2date_long + !=============================================================================== + !> Write the verbose WW3 log header + !! + !! @param[in] stdout the logfile unit on the root task + !! + !> @author Denise.Worthen@noaa.gov + !> @date 09-14-2024 + + subroutine wav_loginit(stdout) + + integer, intent(in) :: stdout + + write(stdout,984) +984 format (// & + 37x,'| input | output |'/ & + 37x,'|-----------------------|------------------|'/ & + 2x,' step | pass | date time | b w l c t r i i1 i5 d | g p t r b f c r2 |'/ & + 2x,'--------|------|---------------------|-----------------------|------------------|'/ & + 2x,'--------+------+---------------------+---------------------------+--------------+') + + end subroutine wav_loginit + !=============================================================================== !> Return a logical true if ESMF_LogFoundError detects an error !! diff --git a/model/src/wminitmd.F90 b/model/src/wminitmd.F90 index 293b74848..956490b5e 100644 --- a/model/src/wminitmd.F90 +++ b/model/src/wminitmd.F90 @@ -426,6 +426,9 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & #endif #ifdef W3_MPRF USE WMMDATMD, ONLY: MDSP +#endif +#ifdef W3_ASCII + USE WMMDATMD, ONLY: MDSUPA #endif USE W3INITMD, ONLY: WWVER USE W3ODATMD, ONLY: OFILES @@ -740,7 +743,7 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! ! 2.c Set up I/O for individual models (initial) ! - ALLOCATE ( MDS(13,NRGRD), NTRACE(2,NRGRD), ODAT(40,0:NRGRD), & + ALLOCATE ( MDS(15,NRGRD), NTRACE(2,NRGRD), ODAT(40,0:NRGRD), & FLGRD(NOGRP,NGRPP,NRGRD), OT2(0:NRGRD), FLGD(NOGRP,NRGRD), & MDSF(-NRINP:NRGRD,JFIRST:9), IPRT(6,NRGRD), LPRT(NRGRD), & FLGR2(NOGRP,NGRPP,NRGRD),FLG2D(NOGRP,NGRPP), FLG1D(NOGRP), & @@ -1897,6 +1900,12 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & CALL WMUSET ( MDSS, MDST, MDSUP, .TRUE., 'OUT', & TRIM(FNMPRE)//'out_pnt.'//MNAMES(0)(1:II), & 'Unified point output') +#ifdef W3_ASCII + CALL WMUGET ( MDSS, MDST, MDSUPA, 'OUA' ) + CALL WMUSET ( MDSS, MDST, MDSUPA, .TRUE., 'OUA', & + TRIM(FNMPRE)//'out_pnt.'//MNAMES(0)(1:II)//'.txt', & + 'Unified point output ascii') +#endif END IF END IF ! @@ -2294,8 +2303,20 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & SELECT CASE (J) CASE (1) MDS(7,I) = NDSFND +#ifdef W3_ASCII + CALL WMUGET ( MDSE, MDST, NDSFND, 'OUT' ) + CALL WMUSET ( MDSE, MDST, NDSFND, .TRUE., & + DESC='ASCII output file' ) + MDS(14,I) = NDSFND ! ASCII +#endif CASE (2) MDS(8,I) = NDSFND +#ifdef W3_ASCII + CALL WMUGET ( MDSE, MDST, NDSFND, 'OUT' ) + CALL WMUSET ( MDSE, MDST, NDSFND, .TRUE., & + DESC='ASCII output file' ) + MDS(15,I) = NDSFND ! ASCII +#endif CASE (3) MDS(12,I) = NDSFND CALL WMUGET ( MDSE, MDST, NDSFND, 'INP' ) @@ -2413,6 +2434,28 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & END IF END IF ! +#ifdef W3_ASCII + IF ( MDS(14,I) .NE. -1 ) THEN ! Grid output (ASCII) + IF ( IAPROC .EQ. NAPFLD ) THEN + TNAME = TRIM(FNMPRE)//'out_grd.' // FILEXT(:II) // '.txt' + CALL WMUSET ( MDSE,MDST, MDS(14,I), .TRUE., NAME=TNAME ) + ELSE + CALL WMUSET ( MDSE,MDST, MDS(14,I), .FALSE. ) + MDS(14,I) = -1 + END IF + END IF + ! + IF ( MDS(15,I) .NE. -1 ) THEN ! Point output (ASCII) + IF ( IAPROC .EQ. NAPPNT ) THEN + TNAME = TRIM(FNMPRE)//'out_pnt.' // FILEXT(:II) // '.txt' + CALL WMUSET ( MDSE,MDST, MDS(15,I), .TRUE., NAME=TNAME ) + ELSE + CALL WMUSET ( MDSE,MDST, MDS(15,I), .FALSE. ) + MDS(15,I) = -1 + END IF + END IF +#endif +! #ifdef W3_T WRITE (MDST,9081) I, TIME #endif @@ -3380,7 +3423,7 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! #ifdef W3_T 9020 FORMAT ( ' TEST WMINIT : UNIT NUMBERS FOR GRIDS (',A,')'/ & - 15X,'GRID MDS(1-13)',43X,'NTRACE') + 15X,'GRID MDS(1-15)',43X,'NTRACE') 9021 FORMAT (14X,16I4) 9022 FORMAT ( ' TEST WMINIT : UNIT NUMBERS FOR INTPUT FILES'/ & 15X,'GRID MDSF(JFIRST-9)') @@ -3499,6 +3542,7 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & !/ Add ESMF override for STIME & ETIME ( version 6.02 ) !/ (T. J. Campbell, NRL) !/ 15-May-2018 : Update namelist ( version 6.05 ) + !/ 28-Oct-2020 : Add SMCTYPE for SMC sub-grid. JGLi ( version 7.13 ) !/ 22-Mar-2021 : Add momentum and air density input ( version 7.13 ) !/ ! 1. Purpose : @@ -3518,8 +3562,8 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! IDST Int. I Unit number for test output. ! IDSE Int. I Unit number for error output. ! IFNAME Char I File name for input file. - ! MPI_COMM Int. I MPI communicator to be used. - ! PREAMB Char I File name preamble (optiona). + ! MPI_COMM Int. I MPI communicator to be used. + ! PREAMB Char I File name preamble (optional). ! ---------------------------------------------------------------- ! ! 4. Subroutines used : @@ -3726,11 +3770,11 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & #endif USE W3WDATMD, ONLY: TIME USE W3ADATMD, ONLY: WADATS - USE W3IDATMD, ONLY: INFLAGS1, INPUTS, IINIT, & - JFIRST, INFLAGS2 + USE W3IDATMD, ONLY: INFLAGS1, INFLAGS2, INPUTS, IINIT, & + JFIRST USE W3ODATMD, ONLY: NOGRP, NGRPP, FLOUT, TONEXT, FLBPI, & FLBPO, NFBPO, NBI, NDS, IAPROC, & - NAPFLD, NAPPNT, NAPTRK, NAPBPT, & + NAPFLD, NAPPNT, NAPTRK, NAPBPT, & NAPPRT, NAPROC, FNMPRE, OUTPTS, NDST, NDSE, & NOPTS, IOSTYP, UNIPTS, UPPROC, DTOUT, & TOLAST, NOTYPE @@ -3749,6 +3793,9 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & #endif #ifdef W3_MPRF USE WMMDATMD, ONLY: MDSP +#endif +#ifdef W3_ASCII + USE WMMDATMD, ONLY: MDSUPA #endif USE W3INITMD, ONLY: WWVER USE W3NMLMULTIMD @@ -4095,16 +4142,17 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! ! 2.c Set up I/O for individual models (initial) ! - ALLOCATE ( MDS(13,NRGRD), NTRACE(2,NRGRD), ODAT(40,0:NRGRD), & + ALLOCATE ( MDS(15,NRGRD), NTRACE(2,NRGRD), ODAT(40,0:NRGRD), & FLGRD(NOGRP,NGRPP,NRGRD), OT2(0:NRGRD), FLGD(NOGRP,NRGRD), & MDSF(-NRINP:NRGRD,JFIRST:9), IPRT(6,NRGRD), LPRT(NRGRD), & FLGR2(NOGRP,NGRPP,NRGRD),FLG2D(NOGRP,NGRPP), FLG1D(NOGRP), & - FLG2(NOGRP,NRGRD) & - ,OUTFF(7,0:NRGRD)) + FLG2(NOGRP,NRGRD),OUTFF(7,0:NRGRD)) ! MDS = -1 MDSF = -1 FLGR2 = .FALSE. + FLG2 = .FALSE. + LPRT = .FALSE. IPRT = 0 ! ! ... Fixed and recycleable unit numbers. @@ -4148,9 +4196,9 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! sources, and from communication rather than ! files. ! - ALLOCATE ( INAMES(2*NRGRD,-7:9), MNAMES(-NRINP:2*NRGRD), & - TMPRNK(2*NRGRD), TMPGRP(2*NRGRD), NINGRP(2*NRGRD), & - RP1(2*NRGRD), RPN(2*NRGRD), BCDTMP(NRGRD+1:2*NRGRD)) + ALLOCATE ( INAMES(2*NRGRD,-7:9), MNAMES(-NRINP:2*NRGRD), & + TMPRNK(2*NRGRD), TMPGRP(2*NRGRD), NINGRP(2*NRGRD), & + RP1(2*NRGRD), RPN(2*NRGRD), BCDTMP(NRGRD+1:2*NRGRD) ) ALLOCATE ( GRANK(NRGRD), GRGRP(NRGRD), USEINP(NRINP) ) ALLOCATE ( CPLINP(NRINP) ) GRANK = -1 @@ -4615,31 +4663,39 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! DO I=1, NRGRD IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) WRITE (MDSS,950) TRIM(MNAMES(NRGRD+I)) - NOTYPE = 6 - + NOTYPE = 8 + ! OTYPE 1 READ(NML_OUTPUT_DATE(I)%FIELD%START, *) ODAT(1,I), ODAT(2,I) READ(NML_OUTPUT_DATE(I)%FIELD%STRIDE, *) ODAT(3,I) READ(NML_OUTPUT_DATE(I)%FIELD%STOP, *) ODAT(4,I), ODAT(5,I) READ(NML_OUTPUT_DATE(I)%FIELD%OUTFFILE, *) OUTFF(1,I) + ! OTYPE 2 READ(NML_OUTPUT_DATE(I)%POINT%START, *) ODAT(6,I), ODAT(7,I) READ(NML_OUTPUT_DATE(I)%POINT%STRIDE, *) ODAT(8,I) READ(NML_OUTPUT_DATE(I)%POINT%STOP, *) ODAT(9,I), ODAT(10,I) READ(NML_OUTPUT_DATE(I)%POINT%OUTFFILE, *) OUTFF(2,I) + ! OTYPE 3 READ(NML_OUTPUT_DATE(I)%TRACK%START, *) ODAT(11,I), ODAT(12,I) READ(NML_OUTPUT_DATE(I)%TRACK%STRIDE, *) ODAT(13,I) READ(NML_OUTPUT_DATE(I)%TRACK%STOP, *) ODAT(14,I), ODAT(15,I) + ! OTYPE 4 READ(NML_OUTPUT_DATE(I)%RESTART%START, *) ODAT(16,I), ODAT(17,I) READ(NML_OUTPUT_DATE(I)%RESTART%STRIDE, *) ODAT(18,I) READ(NML_OUTPUT_DATE(I)%RESTART%STOP, *) ODAT(19,I), ODAT(20,I) - READ(NML_OUTPUT_DATE(I)%RESTART2%START, *) ODAT(36,I), ODAT(37,I) - READ(NML_OUTPUT_DATE(I)%RESTART2%STRIDE, *) ODAT(38,I) - READ(NML_OUTPUT_DATE(I)%RESTART2%STOP, *) ODAT(39,I), ODAT(40,I) + !OTYPE 5 READ(NML_OUTPUT_DATE(I)%BOUNDARY%START, *) ODAT(21,I), ODAT(22,I) READ(NML_OUTPUT_DATE(I)%BOUNDARY%STRIDE, *) ODAT(23,I) READ(NML_OUTPUT_DATE(I)%BOUNDARY%STOP, *) ODAT(24,I), ODAT(25,I) + !OTYPE 6 READ(NML_OUTPUT_DATE(I)%PARTITION%START, *) ODAT(26,I), ODAT(27,I) READ(NML_OUTPUT_DATE(I)%PARTITION%STRIDE, *) ODAT(28,I) READ(NML_OUTPUT_DATE(I)%PARTITION%STOP, *) ODAT(29,I), ODAT(30,I) + !OTYPE 7 + ! for coupling but not implemented yet + !OTYPE 8 + READ(NML_OUTPUT_DATE(I)%RESTART2%START, *) ODAT(36,I), ODAT(37,I) + READ(NML_OUTPUT_DATE(I)%RESTART2%STRIDE, *) ODAT(38,I) + READ(NML_OUTPUT_DATE(I)%RESTART2%STOP, *) ODAT(39,I), ODAT(40,I) ! set the time stride at 0 or more ODAT(3,I) = MAX ( 0 , ODAT(3,I) ) @@ -4852,6 +4908,10 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! ! ... End of output type selecttion ELSE IF ! + ELSE IF ( J .EQ. 8 ) THEN + ! + ! 5.i Type 8: checkpoint files (no additional data) + ! END IF ! ! ... End of IF in 5.b @@ -4861,45 +4921,6 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! ... End of loop J on NOTYPE in 5.a ! END DO - !xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx - ! Checkpoint - J=8 - !OUTPTS(I)%FLOUT(8)=.FALSE. - IF ( ODAT(5*(J-1)+3,I) .NE. 0 ) THEN - !OUTPTS(I)%FLOUT(8)=.TRUE. - IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) & - WRITE (MDSS,951) J, IDOTYP(J) - TTIME(1) = ODAT(5*(J-1)+1,I) - TTIME(2) = ODAT(5*(J-1)+2,I) - CALL STME21 ( TTIME , DTME21 ) - IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) & - WRITE (MDSS,952) DTME21 - TTIME(1) = ODAT(5*(J-1)+4,I) - TTIME(2) = ODAT(5*(J-1)+5,I) - CALL STME21 ( TTIME , DTME21 ) - IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) & - WRITE (MDSS,953) DTME21 - TTIME(1) = 0 - TTIME(2) = 0 - DTTST = REAL ( ODAT(5*(J-1)+3,I) ) - CALL TICK21 ( TTIME , DTTST ) - CALL STME21 ( TTIME , DTME21 ) - IF ( ( ODAT(5*(J-1)+1,I) .NE. ODAT(5*(J-1)+4,I) .OR. & - ODAT(5*(J-1)+2,I) .NE. ODAT(5*(J-1)+5,I) ) .AND. & - MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) THEN - DO II=1, 18 - IF ( DTME21(II:II).NE.'0' .AND. & - DTME21(II:II).NE.'/' .AND. & - DTME21(II:II).NE.' ' .AND. & - DTME21(II:II).NE.':' ) EXIT - DTME21(II:II) = ' ' - END DO - WRITE (MDSS,954) DTME21(1:19) - END IF - !ELSE - !OUTPTS(I)%FLOUT(8) = .FALSE. - END IF - !xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx ! ! ... End of loop I on NRGRD in 5.a ! @@ -5002,6 +5023,12 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & CALL WMUSET ( MDSS, MDST, MDSUP, .TRUE., 'OUT', & TRIM(FNMPRE)//'out_pnt.'//MNAMES(0)(1:II), & 'Unified point output') +#ifdef W3_ASCII + CALL WMUGET ( MDSS, MDST, MDSUPA, 'OUA' ) + CALL WMUSET ( MDSS, MDST, MDSUPA, .TRUE., 'OUA', & + TRIM(FNMPRE)//'out_pnt.'//MNAMES(0)(1:II)//'.txt', & + 'Unified point output ascii') +#endif END IF END IF ! @@ -5015,16 +5042,17 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! IF ( IOSTYP .GT. 1 ) THEN DO I=1, NRGRD + ! FIELD IF ( ODAT( 3,I) .GT. 0 ) NDPOUT(I) = NDPOUT(I) + 1 + ! TRACK IF ( ODAT(13,I) .GT. 0 ) NDPOUT(I) = NDPOUT(I) + 1 + ! PARTITION IF ( ODAT(28,I) .GT. 0 ) NDPOUT(I) = NDPOUT(I) + 1 - !xxx - ! Checkpoint - IF ( ODAT(38,I) .GT. 0 ) NDPOUT(I) = NDPOUT(I) + 1 - !xxx + ! POINT .OR. RESTART .OR. BOUNDARY IF ( ODAT( 8,I) .GT. 0 .OR. ODAT(18,I) .GT. 0 .OR. & - ODAT(23,I) .GT. 0 ) & - NDPOUT(I) = NDPOUT(I) + 1 + ODAT(23,I) .GT. 0 ) NDPOUT(I) = NDPOUT(I) + 1 + ! RESTART2 + IF ( ODAT(38,I) .GT. 0 ) NDPOUT(I) = NDPOUT(I) + 1 IF ( IOSTYP .EQ. 2 ) NDPOUT(I) = MIN ( 1 , NDPOUT(I) ) END DO END IF @@ -5406,8 +5434,20 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & SELECT CASE (J) CASE (1) MDS(7,I) = NDSFND +#ifdef W3_ASCII + CALL WMUGET ( MDSE, MDST, NDSFND, 'OUT' ) + CALL WMUSET ( MDSE, MDST, NDSFND, .TRUE., & + DESC='ASCII output file' ) + MDS(14,I) = NDSFND ! ASCII +#endif CASE (2) MDS(8,I) = NDSFND +#ifdef W3_ASCII + CALL WMUGET ( MDSE, MDST, NDSFND, 'OUT' ) + CALL WMUSET ( MDSE, MDST, NDSFND, .TRUE., & + DESC='ASCII output file' ) + MDS(15,I) = NDSFND ! ASCII +#endif CASE (3) MDS(12,I) = NDSFND CALL WMUGET ( MDSE, MDST, NDSFND, 'INP' ) @@ -5437,11 +5477,12 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! ..... Model initialization ! IF ( MDSS.NE.MDSO .AND. NMPSC2.EQ.IMPROC ) WRITE (MDSS,982) - ! - CALL W3INIT ( I, .TRUE., MNAMES(I), MDS(:,I), NTRACE(:,I), ODAT(:,I), & + + CALL W3INIT ( I, .TRUE., MNAMES(I), MDS(:,I), NTRACE(:,I), & + ODAT(:,I), & FLGRD(:,:,I),FLGR2(:,:,I),FLGD(:,I),FLG2(:,I), & OT2(I)%NPTS, OT2(I)%X, OT2(I)%Y, OT2(I)%PNAMES, & - IPRT(:,I), LPRT(I), MPI_COMM_LOC ) + IPRT(:,I), LPRT(I), MPI_COMM_LOC) ! ! ..... Finalize I/O file hook up ! @@ -5524,6 +5565,28 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & END IF END IF ! +#ifdef W3_ASCII + IF ( MDS(14,I) .NE. -1 ) THEN ! Grid output (ASCII) + IF ( IAPROC .EQ. NAPFLD ) THEN + TNAME = TRIM(FNMPRE)//'out_grd.' // FILEXT(:II) // '.txt' + CALL WMUSET ( MDSE,MDST, MDS(14,I), .TRUE., NAME=TNAME ) + ELSE + CALL WMUSET ( MDSE,MDST, MDS(14,I), .FALSE. ) + MDS(14,I) = -1 + END IF + END IF + ! + IF ( MDS(15,I) .NE. -1 ) THEN ! Point output (ASCII) + IF ( IAPROC .EQ. NAPPNT ) THEN + TNAME = TRIM(FNMPRE)//'out_pnt.' // FILEXT(:II) // '.txt' + CALL WMUSET ( MDSE,MDST, MDS(15,I), .TRUE., NAME=TNAME ) + ELSE + CALL WMUSET ( MDSE,MDST, MDS(15,I), .FALSE. ) + MDS(15,I) = -1 + END IF + END IF +#endif +! #ifdef W3_T WRITE (MDST,9081) I, TIME #endif @@ -5533,6 +5596,9 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & IF ( MDSS.NE.MDSO .AND. NMPSC2.EQ.IMPROC ) WRITE (MDSS,983) CALL W3SETI ( I, MDSE, MDST ) ! + !!Li Stop modifying GTYPE from input forcing file. JGLi08Apr2021. + JJJ = GTYPE + ! ! ..... regular input files ! DO J=JFIRST, 6 @@ -5540,9 +5606,16 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & IDINP(I,J) = IDSTR(J) IF ( INPMAP(I,J) .LT. 0 ) CYCLE CALL W3FLDO ('READ', IDINP(I,J), MDSF(I,J), MDST, MDSE2,& - NX, NY, GTYPE, IERR, MNAMES(I), & + !!Li NX, NY, GTYPE, IERR, MNAMES(I), & + NX, NY, JJJ, IERR, MNAMES(I), & TRIM(FNMPRE) ) IF ( IERR .NE. 0 ) GOTO 2080 + ! + !!Li Print a warning message when GTYPE not matching forcing field one. + IF ( (JJJ .NE. GTYPE) .AND. (IMPROC .EQ. NMPSC2) ) & + WRITE (MDSE, *) ' *** Warning: grid', I, ' GTYPE=', & + GTYPE, ' not matching field', J, ' grid type', JJJ + ! IF ( MDSS.NE.MDSO .AND. NMPSC2.EQ.IMPROC ) & WRITE (MDSS,985) IDFLDS(J) ELSE @@ -5606,8 +5679,8 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & IF ( J.EQ.6 ) ALLOCATE ( WADATS(I)%RA0(NSEA) , & WADATS(I)%RAI(NSEA) ) ! - END IF - END DO + END IF ! IF ( INPMAP(I,J) .NE. 0 ) THEN + END DO ! DO J=JFIRST, 9 ! INFLAGS1 = TFLAGS CALL W3SETI ( I, MDSE, MDST ) @@ -5626,34 +5699,20 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & END IF END DO ! - ! Checkpoint - J=8 - OUTPTS(I)%FLOUT(8)=.FALSE. - IF ( ODAT(5*(J-1)+3,I) .NE. 0 ) THEN - OUTPTS(I)%FLOUT(8)=.TRUE. - ELSE - OUTPTS(I)%FLOUT(8)=.FALSE. - ENDIF - - IF ( FLOUT(J) ) THEN - IF ( TOUTP(1,I) .EQ. -1 ) THEN - TOUTP(:,I) = TONEXT(:,J) - ELSE - DTTST = DSEC21 ( TOUTP(:,I), TONEXT(:,J) ) - IF ( DTTST .LT. 0. ) TOUTP(:,I) = TONEXT(:,J) - ENDIF - END IF - ! - ! GRSTAT(I) = 0 TSYNC(:,I) = TIME(:) ! +#ifdef W3_SMC + ! Check GTYPE values after initialization + IF ( IMPROC .EQ. NMPERR ) WRITE(MDSE,*) "GRID IMPROC GTYPE", & + I, IMPROC, GRIDS(I)%GTYPE +#endif + ! #ifdef W3_T WRITE (MDST,9082) GRSTAT(I), TOUTP(:,I), TSYNC(:,I) #endif ! - END DO ! DO I=1, NRGRD - + END DO !! 8.a I-NRGRD loop ! #ifdef W3_MPI CALL MPI_BARRIER (MPI_COMM_MWAVE,IERR_MPI) @@ -5725,7 +5784,7 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & MPI_COMM_BCT, IERR_MPI ) IF ( MPI_COMM_GRD .EQ. MPI_COMM_NULL ) & GSU = W3GSUC( .FALSE., FLAGLL, ICLOSE, & - XGRD, YGRD) + XGRD, YGRD ) CALL MPI_BCAST ( DXDP, NX*NY, MPI_REAL, 0, & MPI_COMM_BCT, IERR_MPI ) CALL MPI_BCAST ( DXDQ, NX*NY, MPI_REAL, 0, & @@ -5854,7 +5913,8 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! DO I=1, NRGRD DO J=JFIRST, 9 - IF ( INPMAP(I,J) .LT. 0 ) IDINP(I,J) = IDINP( INPMAP(I,J),J) + IF ( INPMAP(I,J).LT.0 .AND. INPMAP(I,J).NE.-999) IDINP(I,J) = IDINP( INPMAP(I,J),J) + !IF ( INPMAP(I,J) .LT. 0 ) IDINP(I,J) = IDINP( INPMAP(I,J),J) IF ( INPMAP(I,J) .GT. 0 ) IDINP(I,J) = IDINP(-INPMAP(I,J),J) END DO END DO @@ -5983,7 +6043,7 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! 8.c.3 Relation to same ranked grids ! #ifdef W3_SMC - !! Check whether there is a SMC grid group. JGLi12Apr2021 + !! Check whether there is a SMC grid group. JGLi12Apr2021 NGRPSMC = 0 DO JJ=1, NRGRP J = 0 @@ -6173,7 +6233,8 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & IF ( TSTOUT ) CALL WMUDMP ( MDST, 0 ) ! DEALLOCATE ( MDS, NTRACE, ODAT, FLGRD, FLGR2, FLGD, FLG2, INAMES,& - MNAMES ) + MNAMES & + ,OUTFF ) ! #ifdef W3_MPI CALL MPI_BARRIER ( MPI_COMM_MWAVE, IERR_MPI ) @@ -6500,7 +6561,7 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! #ifdef W3_T 9020 FORMAT ( ' TEST WMINITNML : UNIT NUMBERS FOR GRIDS (',A,')'/ & - 15X,'GRID MDS(1-13)',43X,'NTRACE') + 15X,'GRID MDS(1-15)',43X,'NTRACE') 9021 FORMAT (14X,16I4) 9022 FORMAT ( ' TEST WMINITNML : UNIT NUMBERS FOR INTPUT FILES'/ & 15X,'GRID MDSF(JFIRST-9)') diff --git a/model/src/wmiopomd.F90 b/model/src/wmiopomd.F90 index 071f7e051..73e036535 100644 --- a/model/src/wmiopomd.F90 +++ b/model/src/wmiopomd.F90 @@ -723,6 +723,9 @@ SUBROUTINE WMIOPO ( TOUT ) ICEO,ICEHO,ICEFO USE WMMDATMD, ONLY: MDST, MDSE, IMPROC, NMPROC, NMPUPT, NRGRD, & RESPEC, UPTMAP, MDSUP +#ifdef W3_ASCII + USE WMMDATMD, ONLY: MDSUPA +#endif #ifdef W3_MPI USE WMMDATMD, ONLY: MPI_COMM_MWAVE, MPI_COMM_GRD, ALLPRC, & MTAG0 @@ -1173,7 +1176,11 @@ SUBROUTINE WMIOPO ( TOUT ) ! TIME = TOUT ! - CALL W3IOPO ( 'WRITE', MDSUP, II, 0 ) + CALL W3IOPO ( 'WRITE', MDSUP, II, 0 & +#ifdef W3_ASCII + ,MDSUPA & +#endif + ) ! RETURN ! diff --git a/model/src/wmmdatmd.F90 b/model/src/wmmdatmd.F90 index e93c2cfb9..94aa7a7a9 100644 --- a/model/src/wmmdatmd.F90 +++ b/model/src/wmmdatmd.F90 @@ -74,6 +74,8 @@ MODULE WMMDATMD ! only. ! MDSP Int. Public Unit number for profiling. ! MDSUP Int. Public Unit number for unified point output. + ! MDSUPA Int. Public Unit number for unified point output. + ! ASCII ! MDSF I.A. Public Unit numbers for input files. ! ! NMPROC Int. Public Number of processors (for total multi- @@ -313,6 +315,9 @@ MODULE WMMDATMD INTEGER :: MDST = 6 !< MDST INTEGER :: MDSE = 6 !< MDSE INTEGER :: MDSUP !< MDSUP +#ifdef W3_ASCII + INTEGER :: MDSUPA !< MDSUPA +#endif INTEGER :: NMPROC = 1 !< NMPROC INTEGER :: IMPROC = 1 !< IMPROC INTEGER :: NMPLOG = 1 !< NMPLOG diff --git a/model/src/wmwavemd.F90 b/model/src/wmwavemd.F90 index 99eec5eca..6dffa68b2 100644 --- a/model/src/wmwavemd.F90 +++ b/model/src/wmwavemd.F90 @@ -267,7 +267,7 @@ SUBROUTINE WMWAVE ( TEND ) !/ INTEGER :: J, JJ, I, JO, TPRNT(2), TAUX(2), & II, JJJ, IX, IY, UPNEXT(2), UPLAST(2) - INTEGER :: DUMMY2(35)=0 + INTEGER :: DUMMY2(40)=0 #ifdef W3_T INTEGER :: ILOOP #endif diff --git a/model/src/ww3_gint.F90 b/model/src/ww3_gint.F90 index ee1150485..bfd2dd467 100644 --- a/model/src/ww3_gint.F90 +++ b/model/src/ww3_gint.F90 @@ -1302,19 +1302,11 @@ SUBROUTINE W3EXGI ( NGRD, NSEA, NOSWLL_MIN, INTMETHOD, OUTorRESTflag, & ! IX = MAPSF(ISEA,1) IY = MAPSF(ISEA,2) - MAPICE = MOD(MAPST2(IY,IX),2) - MAPDRY = MOD(MAPST2(IY,IX)/2,2) - MAPLND = MOD(MAPST2(IY,IX)/4,2) - MAPMSK = MOD(MAPST2(IY,IX)/8,2) MAPINT = MOD(MAPST2(IY,IX)/16,2) - MAPST2(IY,IX) = MAPST2(IY,IX) - MAPICE - 2*MAPDRY - 4*MAPLND & - - 8*MAPMSK - ACTIVE = (MAPICE .NE. 1 .AND. MAPDRY .NE. 1) ! IF ( MAPINT .EQ. 0 ) THEN ! ! Initial loop to determine status map - ! Initialize by setting it to be ice free and wet ! MAPICE = 0 MAPDRY = 0 @@ -1361,8 +1353,8 @@ SUBROUTINE W3EXGI ( NGRD, NSEA, NOSWLL_MIN, INTMETHOD, OUTorRESTflag, & IF ( NMAPDRY .GT. 50 ) MAPDRYT = 1 IF ( NMAPLND .GT. 50 ) MAPLNDT = 1 IF ( NMAPMSK .GT. 50 ) MAPMSKT = 1 - ACTIVE = (MAPICET .NE. 1 .AND. MAPDRYT .NE. 1 .AND. & - MAPLNDT .NE. 1 .AND. MAPMSKT .NE. 1) + ! Allow use of grid with ice or dry point. Allow merge of group 1 output + ACTIVE = (MAPLNDT .NE. 1 .AND. MAPMSKT .NE. 1) IF ( ACTIVE ) THEN USEGRID(IG) = .TRUE. SUMGRD = SUMGRD+1 @@ -1572,7 +1564,7 @@ SUBROUTINE W3EXGI ( NGRD, NSEA, NOSWLL_MIN, INTMETHOD, OUTorRESTflag, & ! ! Group 1 variables ! - IF ( FLOGRD(1,1) .AND. ACTIVE ) THEN + IF ( FLOGRD(1,1) ) THEN IF ( WADATS(IGRID)%DW(GSEA) .NE. UNDEF ) THEN SUMWT1(1) = SUMWT1(1) + WT IF ( DWAUX .EQ. UNDEF ) THEN @@ -1583,7 +1575,7 @@ SUBROUTINE W3EXGI ( NGRD, NSEA, NOSWLL_MIN, INTMETHOD, OUTorRESTflag, & END IF END IF ! - IF ( FLOGRD(1,2) .AND. ACTIVE ) THEN + IF ( FLOGRD(1,2) ) THEN IF ( WADATS(IGRID)%CX(GSEA) .NE. UNDEF ) THEN SUMWT1(2) = SUMWT1(2) + WT IF ( CXAUX .EQ. UNDEF ) THEN @@ -1609,7 +1601,7 @@ SUBROUTINE W3EXGI ( NGRD, NSEA, NOSWLL_MIN, INTMETHOD, OUTorRESTflag, & END IF END IF ! - IF ( FLOGRD(1,4) .AND. ACTIVE ) THEN + IF ( FLOGRD(1,4) ) THEN IF ( WADATS(IGRID)%AS(GSEA) .NE. UNDEF ) THEN SUMWT1(4) = SUMWT1(4) + WT IF ( ASAUX .EQ. UNDEF ) THEN @@ -1620,7 +1612,7 @@ SUBROUTINE W3EXGI ( NGRD, NSEA, NOSWLL_MIN, INTMETHOD, OUTorRESTflag, & END IF END IF ! - IF ( FLOGRD(1,5) .AND. ACTIVE ) THEN + IF ( FLOGRD(1,5) ) THEN IF ( WDATAS(IGRID)%WLV(GSEA) .NE. UNDEF ) THEN SUMWT1(5) = SUMWT1(5) + WT IF ( WLVAUX .EQ. UNDEF ) THEN @@ -1642,7 +1634,7 @@ SUBROUTINE W3EXGI ( NGRD, NSEA, NOSWLL_MIN, INTMETHOD, OUTorRESTflag, & END IF END IF ! - IF ( FLOGRD(1,7) .AND. ACTIVE ) THEN + IF ( FLOGRD(1,7) ) THEN IF ( WDATAS(IGRID)%BERG(GSEA) .NE. UNDEF ) THEN SUMWT1(7) = SUMWT1(7) + WT IF ( BERGAUX .EQ. UNDEF ) THEN @@ -1666,7 +1658,7 @@ SUBROUTINE W3EXGI ( NGRD, NSEA, NOSWLL_MIN, INTMETHOD, OUTorRESTflag, & END IF END IF ! - IF ( FLOGRD(1,9) .AND. ACTIVE ) THEN + IF ( FLOGRD(1,9) ) THEN IF ( WDATAS(IGRID)%RHOAIR(GSEA) .NE. UNDEF ) THEN SUMWT1(9) = SUMWT1(9) + WT IF ( RHOAIRAUX .EQ. UNDEF ) THEN diff --git a/model/src/ww3_ounf.F90 b/model/src/ww3_ounf.F90 index 3c8ebb4ec..10b1043a5 100644 --- a/model/src/ww3_ounf.F90 +++ b/model/src/ww3_ounf.F90 @@ -65,6 +65,7 @@ PROGRAM W3OUNF !/ 02-Feb-2021 : Make default global meta optional ( version 7.12 ) !/ 22-Mar-2021 : New coupling fields output ( version 7.12 ) !/ 02-Sep-2021 : Added coordinates attribute ( version 7.12 ) + !/ 14-Feb-2023 : Added QKK output ( version 7.12 ) !/ !/ Copyright 2009-2013 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -192,7 +193,7 @@ PROGRAM W3OUNF CFLTHMAX, CFLXYMAX, CFLKMAX, TAUICE, PHICE, & STMAXE, STMAXD, HMAXE, HCMAXE, HMAXD, HCMAXD,& P2SMS, EF, US3D, TH1M, STH1M, TH2M, STH2M, & - WN, USSP, WBT, WNMEAN + WN, USSP, WBT, WNMEAN, QKK USE W3ODATMD, ONLY: NDSO, NDSE, SCREEN, NOGRP, NGRPP, IDOUT, & UNDEF, FLOGRD, FNMPRE, NOSWLL, NOGE ! @@ -1596,7 +1597,10 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & ! ! Wave energy flux ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 3 ) THEN - CGE=CGE*0.001 ! from W / m to kW / m + DO ISEA=1, NSEA + IF ( CGE(ISEA) .NE. UNDEF ) & + CGE(ISEA) = 0.001 * CGE(ISEA) ! from W / m to kW / m + END DO CALL S2GRID(CGE(1:NSEA), X1) ! ! Wind to wave energy flux @@ -1811,9 +1815,6 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & ! Wave to sea ice energy flux ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 11 ) THEN IF (NCVARTYPEI.EQ.3) NCVARTYPE=4 - DO ISEA=1, NSEA - PHIOC(ISEA)=MIN(3000.,PHIOC(ISEA)) - END DO CALL S2GRID(PHICE(1:NSEA), X1) ! ! Partitioned surface stokes drift @@ -1972,6 +1973,10 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 5 ) THEN CALL S2GRID(QP, X1) ! + ! k bandwidth + ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 6 ) THEN + CALL S2GRID(QKK, X1) + ! ! Dynamic time step ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 1 ) THEN DO ISEA=1, NSEA @@ -1987,14 +1992,17 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & ! ! Maximum CFL for spatial advection ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 3 ) THEN + IF (NCVARTYPEI.EQ.3) NCVARTYPE=4 CALL S2GRID(CFLXYMAX, X1) ! ! Maximum CFL for direction advection ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 4 ) THEN + IF (NCVARTYPEI.EQ.3) NCVARTYPE=4 CALL S2GRID(CFLTHMAX, X1) ! ! Maximum CFL for frequency advection ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 5 ) THEN + IF (NCVARTYPEI.EQ.3) NCVARTYPE=4 CALL S2GRID(CFLKMAX, X1) ! ! User defined... @@ -2568,39 +2576,31 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & IVAR=IVAR1+I IF (COORDTYPE.EQ.1) THEN IF (NCVARTYPE.EQ.2) THEN - IF( SMCGRD ) THEN #ifdef W3_SMC - IF( SMCOTYPE .EQ. 1 ) THEN - ! SMC Flat file - IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_SHORT, (/DIMID(2), DIMID(4+EXTRADIM)/), VARID(IVAR)) - ELSE - ! SMC Regridded file - IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_SHORT, DIMID(2:4+EXTRADIM), VARID(IVAR)) - ENDIF - CALL CHECK_ERR(IRET) + IF( SMCGRD .AND. SMCOTYPE .EQ. 1 ) THEN + ! SMC Flat file + IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_SHORT, (/DIMID(2), DIMID(4+EXTRADIM)/), VARID(IVAR)) + ELSE #endif - ELSE ! SMCGRD - IRET=NF90_DEF_VAR(NCID,META(I)%VARNM, NF90_SHORT, DIMID(2:4+EXTRADIM), VARID(IVAR)) - CALL CHECK_ERR(IRET) - ENDIF ! SMCGRD + IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_SHORT, DIMID(2:4+EXTRADIM), VARID(IVAR)) +#ifdef W3_SMC + ENDIF +#endif + CALL CHECK_ERR(IRET) IF (NCTYPE.EQ.4) IRET = NF90_DEF_VAR_DEFLATE(NCID, VARID(IVAR), 1, 1, DEFLATE) IF (NCTYPE.EQ.4) CALL CHECK_ERR(IRET) ELSE - IF( SMCGRD ) THEN #ifdef W3_SMC - IF( SMCOTYPE .EQ. 1 ) THEN - ! SMC Flat file - IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_FLOAT, (/DIMID(2), DIMID(4+EXTRADIM)/), VARID(IVAR)) - ELSE - ! SMC Regridded file - IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_FLOAT, DIMID(2:4+EXTRADIM), VARID(IVAR)) - ENDIF - CALL CHECK_ERR(IRET) + IF( SMCGRD .AND. SMCOTYPE .EQ. 1 ) THEN + ! SMC Flat file + IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_FLOAT, (/DIMID(2), DIMID(4+EXTRADIM)/), VARID(IVAR)) + ELSE #endif - ELSE ! SMCGRD - IRET=NF90_DEF_VAR(NCID,META(I)%VARNM, NF90_FLOAT, DIMID(2:4+EXTRADIM), VARID(IVAR)) - CALL CHECK_ERR(IRET) - ENDIF ! SMCGRD + IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_FLOAT, DIMID(2:4+EXTRADIM), VARID(IVAR)) +#ifdef W3_SMC + ENDIF +#endif + CALL CHECK_ERR(IRET) IF (NCTYPE.EQ.4) IRET = NF90_DEF_VAR_DEFLATE(NCID, VARID(IVAR), 1, 1, DEFLATE) IF (NCTYPE.EQ.4) CALL CHECK_ERR(IRET) END IF @@ -2665,19 +2665,16 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & ELSE ! If it is spherical coordinate IF (FLAGLL) THEN - IF(SMCGRD) THEN #ifdef W3_SMC - IF(SMCOTYPE .EQ. 1) THEN - IRET=NF90_INQ_DIMID (NCID, 'seapoint', DIMID(2)) - ELSE - IRET=NF90_INQ_DIMID (NCID, 'longitude', DIMID(2)) - IRET=NF90_INQ_DIMID (NCID, 'latitude', DIMID(3)) - ENDIF -#endif + IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN + IRET=NF90_INQ_DIMID (NCID, 'seapoint', DIMID(2)) ELSE +#endif IRET=NF90_INQ_DIMID (NCID, 'longitude', DIMID(2)) IRET=NF90_INQ_DIMID (NCID, 'latitude', DIMID(3)) - ENDIF ! SMCGRD +#ifdef W3_SMC + ENDIF +#endif IRET=NF90_INQ_VARID (NCID, 'longitude', VARID(1)) IRET=NF90_INQ_VARID (NCID, 'latitude', VARID(2)) ! If it is cartesian coordinate @@ -2722,36 +2719,30 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & IVAR=IVAR1+I IF (COORDTYPE.EQ.1) THEN IF (NCVARTYPE.EQ.2) THEN - IF( SMCGRD ) THEN #ifdef W3_SMC - IF( SMCOTYPE .EQ. 1 ) THEN - ! SMC Flat file - IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_SHORT, (/DIMID(2), DIMID(4+EXTRADIM)/), VARID(IVAR)) - ELSE - ! SMC Regridded file - IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_SHORT, DIMID(2:4+EXTRADIM), VARID(IVAR)) - ENDIF -#endif + IF( SMCGRD .AND. SMCOTYPE .EQ. 1 ) THEN + ! SMC Flat file + IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_SHORT, (/DIMID(2), DIMID(4+EXTRADIM)/), VARID(IVAR)) ELSE +#endif IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_SHORT, DIMID(2:4+EXTRADIM), VARID(IVAR)) - CALL CHECK_ERR(IRET) - ENDIF ! SMCGRD +#ifdef W3_SMC + ENDIF +#endif + CALL CHECK_ERR(IRET) IF (NCTYPE.EQ.4) IRET = NF90_DEF_VAR_DEFLATE(NCID, VARID(IVAR), 1, 1, DEFLATE) ELSE - IF( SMCGRD ) THEN #ifdef W3_SMC - IF( SMCOTYPE .EQ. 1 ) THEN - ! SMC Flat file - IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_FLOAT, (/DIMID(2), DIMID(4+EXTRADIM)/), VARID(IVAR)) - ELSE - ! SMC Regridded file - IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_FLOAT, DIMID(2:4+EXTRADIM), VARID(IVAR)) - ENDIF -#endif + IF( SMCGRD .AND. SMCOTYPE .EQ. 1 ) THEN + ! SMC Flat file + IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_FLOAT, (/DIMID(2), DIMID(4+EXTRADIM)/), VARID(IVAR)) ELSE +#endif IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_FLOAT, DIMID(2:4+EXTRADIM), VARID(IVAR)) - CALL CHECK_ERR(IRET) - ENDIF ! SMCGRD +#ifdef W3_SMC + ENDIF +#endif + CALL CHECK_ERR(IRET) IF (NCTYPE.EQ.4) IRET = NF90_DEF_VAR_DEFLATE(NCID, VARID(IVAR), 1, 1, DEFLATE) IF (NCTYPE.EQ.4) CALL CHECK_ERR(IRET) END IF @@ -2866,263 +2857,171 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & ! NFIELD=3 IF (NCVARTYPE.EQ.2) THEN IF ( NFIELD.EQ.3 ) THEN - IF (SMCGRD) THEN + DO IX=IX1, IXN + DO IY=IY1, IYN + IF ( X1(IX,IY) .EQ. UNDEF ) THEN + MXX(IX,IY) = MFILL + MYY(IX,IY) = MFILL + MXY(IX,IY) = MFILL + ELSE + MXX(IX,IY) = NINT(X1(IX,IY)/META(1)%FSC) + MYY(IX,IY) = NINT(X2(IX,IY)/META(2)%FSC) + MXY(IX,IY) = NINT(XY(IX,IY)/META(3)%FSC) + END IF + END DO + END DO +#ifdef W3_SMC + IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MXX(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) + call CHECK_ERR(IRET) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & + MYY(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) + call CHECK_ERR(IRET) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+3), & + MXY(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) + call CHECK_ERR(IRET) + ELSE +#endif + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MXX(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) + call CHECK_ERR(IRET) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & + MYY(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) + call CHECK_ERR(IRET) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+3), & + MXY(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) + call CHECK_ERR(IRET) #ifdef W3_SMC + ENDIF +#endif + ! NFIELD=2 + ELSE IF (NFIELD.EQ.2 ) THEN + ! EXTRADIM=0 + IF (EXTRADIM.EQ.0) THEN DO IX=IX1, IXN DO IY=IY1, IYN - ! TODO: Find some other way to access MAPSTA - IF ( X1(IX,IY) .EQ. UNDEF ) THEN + IF ( XX(IX,IY) .EQ. UNDEF ) THEN MXX(IX,IY) = MFILL MYY(IX,IY) = MFILL - MXY(IX,IY) = MFILL ELSE - MXX(IX,IY) = NINT(X1(IX,IY)/META(1)%FSC) - MYY(IX,IY) = NINT(X2(IX,IY)/META(2)%FSC) - MXY(IX,IY) = NINT(XY(IX,IY)/META(3)%FSC) + MXX(IX,IY) = NINT(XX(IX,IY)/META(1)%FSC) + MYY(IX,IY) = NINT(XY(IX,IY)/META(2)%FSC) END IF END DO END DO - IF(SMCOTYPE .EQ. 1) THEN +#ifdef W3_SMC + IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & MXX(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) call CHECK_ERR(IRET) IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & MYY(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) call CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+3), & - MXY(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) - call CHECK_ERR(IRET) ELSE +#endif IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & MXX(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) call CHECK_ERR(IRET) IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & MYY(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) call CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+3), & - MXY(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - call CHECK_ERR(IRET) +#ifdef W3_SMC ENDIF #endif - ELSE ! IF(SMCGRD) - DO IX=IX1, IXN - DO IY=IY1, IYN - IF ( MAPSTA(IY,IX) .LE. 0 .OR. X1(IX,IY) .EQ. UNDEF ) THEN - MXX(IX,IY) = MFILL - MYY(IX,IY) = MFILL - MXY(IX,IY) = MFILL - ELSE - MXX(IX,IY) = NINT(X1(IX,IY)/META(1)%FSC) - MYY(IX,IY) = NINT(X2(IX,IY)/META(2)%FSC) - MXY(IX,IY) = NINT(XY(IX,IY)/META(3)%FSC) - END IF - END DO - END DO - - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXX(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - CALL CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & - MYY(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - CALL CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+3), & - MXY(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - CALL CHECK_ERR(IRET) - ENDIF ! SMCGRD - ! NFIELD=2 - ELSE IF (NFIELD.EQ.2 ) THEN - ! EXTRADIM=0 - IF (EXTRADIM.EQ.0) THEN - IF (SMCGRD) THEN -#ifdef W3_SMC + ! EXTRADIM=1 + ELSE + START(3+1-COORDTYPE)=0 + DO IK=I1F,I2F + START(3+1-COORDTYPE)=START(3+1-COORDTYPE)+1 DO IX=IX1, IXN DO IY=IY1, IYN - ! TODO: Find some other way to access MAPSTA - IF ( XX(IX,IY) .EQ. UNDEF ) THEN + IF ( XXK(IX,IY,IK) .EQ. UNDEF ) THEN MXX(IX,IY) = MFILL MYY(IX,IY) = MFILL ELSE - MXX(IX,IY) = NINT(XX(IX,IY)/META(1)%FSC) - MYY(IX,IY) = NINT(XY(IX,IY)/META(2)%FSC) + MXX(IX,IY) = NINT(XXK(IX,IY,IK)/META(1)%FSC) + MYY(IX,IY) = NINT(XYK(IX,IY,IK)/META(2)%FSC) END IF END DO END DO - IF(SMCOTYPE .EQ. 1) THEN - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXX(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) +#ifdef W3_SMC + IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MXX(IX1:IXN,IY1:IYN),(/START(1), START(3), START(4)/), & + (/COUNT(1), COUNT(3), COUNT(4)/)) call CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & - MYY(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & + MXY(IX1:IXN,IY1:IYN),(/START(1), START(3), START(4)/), & + (/COUNT(1), COUNT(3), COUNT(4)/)) call CHECK_ERR(IRET) ELSE +#endif IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXX(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) + MXX(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) call CHECK_ERR(IRET) IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & - MYY(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) + MXX(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) call CHECK_ERR(IRET) - ENDIF -#endif - ELSE ! IF(SMCGRD) - DO IX=IX1, IXN - DO IY=IY1, IYN - IF ( MAPSTA(IY,IX) .LE. 0 .OR. XX(IX,IY) .EQ. UNDEF ) THEN - MXX(IX,IY) = MFILL - MYY(IX,IY) = MFILL - ELSE - !PRINT*,XX(IX,IY),XY(IX,IY) - !STOP - MXX(IX,IY) = NINT(XX(IX,IY)/META(1)%FSC) - MYY(IX,IY) = NINT(XY(IX,IY)/META(2)%FSC) - END IF - END DO - END DO - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXX(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - CALL CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & - MYY(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - CALL CHECK_ERR(IRET) - ENDIF ! SMCGRD - ! EXTRADIM=1 - ELSE - START(3+1-COORDTYPE)=0 - DO IK=I1F,I2F - START(3+1-COORDTYPE)=START(3+1-COORDTYPE)+1 - - IF (SMCGRD) THEN #ifdef W3_SMC - DO IX=IX1, IXN - DO IY=IY1, IYN - ! TODO: Find some other way to access MAPSTA - IF ( XXK(IX,IY,IK) .EQ. UNDEF ) THEN - MXX(IX,IY) = MFILL - MYY(IX,IY) = MFILL - ELSE - MXX(IX,IY) = NINT(XXK(IX,IY,IK)/META(1)%FSC) - MYY(IX,IY) = NINT(XYK(IX,IY,IK)/META(2)%FSC) - END IF - END DO - END DO - IF(SMCOTYPE .EQ. 1) THEN - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXX(IX1:IXN,IY1:IYN),(/START(1), START(3), START(4)/), & - (/COUNT(1), COUNT(3), COUNT(4)/)) - call CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & - MXY(IX1:IXN,IY1:IYN),(/START(1), START(3), START(4)/), & - (/COUNT(1), COUNT(3), COUNT(4)/)) - call CHECK_ERR(IRET) - ELSE - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXX(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) - call CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXX(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) - call CHECK_ERR(IRET) - ENDIF + ENDIF #endif - ELSE ! IF(SMCGRD) - DO IX=IX1, IXN - DO IY=IY1, IYN - IF ( MAPSTA(IY,IX) .LE. 0 .OR.XXK(IX,IY,IK) .EQ. UNDEF ) THEN - MXX(IX,IY) = MFILL - MYY(IX,IY) = MFILL - ELSE - MXX(IX,IY) = NINT(XXK(IX,IY,IK)/META(1)%FSC) - MYY(IX,IY) = NINT(XYK(IX,IY,IK)/META(2)%FSC) - END IF - END DO - END DO - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXX(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & - MYY(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) - ENDIF ! SMCGRD END DO END IF ! EXTRADIM ! NFIELD=1 ELSE ! EXTRADIM=0 IF (EXTRADIM.EQ.0) THEN - IF (SMCGRD) THEN + DO IX=IX1, IXN + DO IY=IY1, IYN + IF ( X1(IX,IY) .EQ. UNDEF ) THEN + MX1(IX,IY) = MFILL + ELSE + MX1(IX,IY) = NINT(X1(IX,IY)/META(1)%FSC) + END IF + END DO + END DO #ifdef W3_SMC + IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MX1(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) + call CHECK_ERR(IRET) + ELSE +#endif + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MX1(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) + call CHECK_ERR(IRET) +#ifdef W3_SMC + ENDIF +#endif + ! EXTRADIM=1 + ELSE + START(3+1-COORDTYPE)=0 + DO IK=I1F,I2F + START(3+1-COORDTYPE)=START(3+1-COORDTYPE)+1 DO IX=IX1, IXN DO IY=IY1, IYN - ! TODO: Find some other way to access MAPSTA - IF ( X1(IX,IY) .EQ. UNDEF ) THEN + IF ( XK(IX,IY,IK) .EQ. UNDEF ) THEN MX1(IX,IY) = MFILL ELSE - MX1(IX,IY) = NINT(X1(IX,IY)/META(1)%FSC) + MX1(IX,IY) = NINT(XK(IX,IY,IK)/META(1)%FSC) END IF END DO END DO - IF(SMCOTYPE .EQ. 1) THEN - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MX1(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) +#ifdef W3_SMC + IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MX1(IX1:IXN,IY1:IYN),(/START(1), START(3), START(4)/), & + (/COUNT(1), COUNT(3), COUNT(4)/)) call CHECK_ERR(IRET) ELSE +#endif IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MX1(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) + MX1(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) call CHECK_ERR(IRET) - ENDIF -#endif - ELSE ! IF(SMCGRD) - DO IX=IX1, IXN - DO IY=IY1, IYN - IF ( MAPSTA(IY,IX) .LE. 0 .OR.X1(IX,IY) .EQ. UNDEF ) THEN - MX1(IX,IY) = MFILL - ELSE - MX1(IX,IY) = NINT(X1(IX,IY)/META(1)%FSC) - END IF - END DO - END DO - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MX1(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - CALL CHECK_ERR(IRET) - ENDIF ! SMCGRD - ! EXTRADIM=1 - ELSE - START(3+1-COORDTYPE)=0 - DO IK=I1F,I2F - START(3+1-COORDTYPE)=START(3+1-COORDTYPE)+1 - - IF (SMCGRD) THEN #ifdef W3_SMC - DO IX=IX1, IXN - DO IY=IY1, IYN - ! TODO: Find some other way to access MAPSTA - IF ( XK(IX,IY,IK) .EQ. UNDEF ) THEN - MX1(IX,IY) = MFILL - ELSE - MX1(IX,IY) = NINT(XK(IX,IY,IK)/META(1)%FSC) - END IF - END DO - END DO - IF(SMCOTYPE .EQ. 1) THEN - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MX1(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) - call CHECK_ERR(IRET) - ELSE - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MX1(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - call CHECK_ERR(IRET) - ENDIF + ENDIF #endif - ELSE ! IF(SMCGRD) - DO IX=IX1, IXN - DO IY=IY1, IYN - IF ( MAPSTA(IY,IX) .LE. 0 .OR.XK(IX,IY,IK) .EQ. UNDEF ) THEN - MX1(IX,IY) = MFILL - ELSE - MX1(IX,IY) = NINT(XK(IX,IY,IK)/META(1)%FSC) - END IF - END DO - END DO - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MX1(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) - CALL CHECK_ERR(IRET) - ENDIF ! SMCGRD END DO END IF ! EXTRADIM END IF ! NFIELD @@ -3131,258 +3030,171 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & ! ELSE IF ( NFIELD.EQ.3 ) THEN - IF (SMCGRD) THEN + DO IX=IX1, IXN + DO IY=IY1, IYN + IF ( X1(IX,IY) .EQ. UNDEF ) THEN + MXXR(IX,IY) = MFILLR + MYYR(IX,IY) = MFILLR + MXYR(IX,IY) = MFILLR + ELSE + MXXR(IX,IY) = X1(IX,IY) + MYYR(IX,IY) = X2(IX,IY) + MXYR(IX,IY) = XY(IX,IY) + END IF + END DO + END DO #ifdef W3_SMC + IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MXXR(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) + call CHECK_ERR(IRET) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & + MYYR(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) + call CHECK_ERR(IRET) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+3), & + MXYR(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) + call CHECK_ERR(IRET) + ELSE +#endif + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MXXR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) + call CHECK_ERR(IRET) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & + MYYR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) + call CHECK_ERR(IRET) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+3), & + MXYR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) + call CHECK_ERR(IRET) +#ifdef W3_SMC + ENDIF +#endif + ! NFIELD=2 + ELSE IF (NFIELD.EQ.2 ) THEN + ! EXTRADIM=0 + IF (EXTRADIM.EQ.0) THEN DO IX=IX1, IXN DO IY=IY1, IYN - ! TODO: Find some other way to access MAPSTA - IF ( X1(IX,IY) .EQ. UNDEF ) THEN + IF ( XX(IX,IY) .EQ. UNDEF ) THEN MXXR(IX,IY) = MFILLR MYYR(IX,IY) = MFILLR - MXYR(IX,IY) = MFILLR ELSE - MXXR(IX,IY) = X1(IX,IY) - MYYR(IX,IY) = X2(IX,IY) - MXYR(IX,IY) = XY(IX,IY) + MXXR(IX,IY) = XX(IX,IY) + MYYR(IX,IY) = XY(IX,IY) END IF END DO END DO - IF(SMCOTYPE .EQ. 1) THEN +#ifdef W3_SMC + IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & MXXR(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) call CHECK_ERR(IRET) IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & MYYR(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) call CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+3), & - MXYR(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) - call CHECK_ERR(IRET) ELSE +#endif IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & MXXR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) call CHECK_ERR(IRET) IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & MYYR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) call CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+3), & - MXYR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - call CHECK_ERR(IRET) +#ifdef W3_SMC ENDIF #endif - ELSE ! IF(SMCGRD) - DO IX=IX1, IXN - DO IY=IY1, IYN - IF ( MAPSTA(IY,IX) .LE. 0 .OR. X1(IX,IY) .EQ. UNDEF ) THEN - MXXR(IX,IY) = MFILLR - MYYR(IX,IY) = MFILLR - MXYR(IX,IY) = MFILLR - ELSE - MXXR(IX,IY) = X1(IX,IY) - MYYR(IX,IY) = X2(IX,IY) - MXYR(IX,IY) = XY(IX,IY) - END IF - END DO - END DO - - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXXR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - CALL CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & - MYYR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - CALL CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+3), & - MXYR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - CALL CHECK_ERR(IRET) - ENDIF ! SMCGRD - ! NFIELD=2 - ELSE IF (NFIELD.EQ.2 ) THEN - ! EXTRADIM=0 - IF (EXTRADIM.EQ.0) THEN - IF (SMCGRD) THEN -#ifdef W3_SMC + ! EXTRADIM=1 + ELSE + START(4-COORDTYPE)=0 + DO IK=I1F,I2F + START(4-COORDTYPE)=START(4-COORDTYPE)+1 DO IX=IX1, IXN DO IY=IY1, IYN - ! TODO: Find some other way to access MAPSTA - IF ( XX(IX,IY) .EQ. UNDEF ) THEN + IF ( XXK(IX,IY,IK) .EQ. UNDEF ) THEN MXXR(IX,IY) = MFILLR MYYR(IX,IY) = MFILLR ELSE - MXXR(IX,IY) = XX(IX,IY) - MYYR(IX,IY) = XY(IX,IY) + MXXR(IX,IY) = XXK(IX,IY,IK) + MYYR(IX,IY) = XYK(IX,IY,IK) END IF END DO END DO - IF(SMCOTYPE .EQ. 1) THEN - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXXR(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) +#ifdef W3_SMC + IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MXXR(IX1:IXN,IY1:IYN),(/START(1), START(3), START(4)/), & + (/COUNT(1), COUNT(3), COUNT(4)/)) call CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & - MYYR(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & + MYYR(IX1:IXN,IY1:IYN),(/START(1), START(3), START(4)/), & + (/COUNT(1), COUNT(3), COUNT(4)/)) call CHECK_ERR(IRET) ELSE +#endif IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXXR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) + MXXR(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) call CHECK_ERR(IRET) IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & - MYYR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) + MYYR(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) call CHECK_ERR(IRET) - ENDIF -#endif - ELSE ! IF SMCGRD - DO IX=IX1, IXN - DO IY=IY1, IYN - IF ( MAPSTA(IY,IX) .LE. 0 .OR. XX(IX,IY) .EQ. UNDEF ) THEN - MXXR(IX,IY) = MFILLR - MYYR(IX,IY) = MFILLR - ELSE - MXXR(IX,IY) = XX(IX,IY) - MYYR(IX,IY) = XY(IX,IY) - END IF - END DO - END DO - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXXR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - CALL CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & - MYYR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - CALL CHECK_ERR(IRET) - ENDIF ! SMCGRD - ! EXTRADIM=1 - ELSE - START(4-COORDTYPE)=0 - DO IK=I1F,I2F - START(4-COORDTYPE)=START(4-COORDTYPE)+1 - - IF (SMCGRD) THEN #ifdef W3_SMC - DO IX=IX1, IXN - DO IY=IY1, IYN - ! TODO: Find some other way to access MAPSTA - IF ( XXK(IX,IY,IK) .EQ. UNDEF ) THEN - MXXR(IX,IY) = MFILLR - MYYR(IX,IY) = MFILLR - ELSE - MXXR(IX,IY) = XXK(IX,IY,IK) - MYYR(IX,IY) = XYK(IX,IY,IK) - END IF - END DO - END DO - IF(SMCOTYPE .EQ. 1) THEN - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXXR(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) - call CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & - MYYR(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) - call CHECK_ERR(IRET) - ELSE - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXXR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - call CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & - MYYR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - call CHECK_ERR(IRET) - ENDIF + ENDIF #endif - ELSE ! IF SMCGRD - DO IX=IX1, IXN - DO IY=IY1, IYN - IF ( MAPSTA(IY,IX) .LE. 0 .OR.XXK(IX,IY,IK) .EQ. UNDEF ) THEN - MXXR(IX,IY) = MFILLR - MYYR(IX,IY) = MFILLR - ELSE - MXXR(IX,IY) = XXK(IX,IY,IK) - MYYR(IX,IY) = XYK(IX,IY,IK) - END IF - END DO - END DO - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXXR(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & - MYYR(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) - ENDIF ! SMCGRD END DO END IF ! EXTRADIM ! NFIELD=1 ELSE ! EXTRADIM=0 IF (EXTRADIM.EQ.0) THEN - IF (SMCGRD) THEN + DO IX=IX1, IXN + DO IY=IY1, IYN + IF ( X1(IX,IY) .EQ. UNDEF ) THEN + MX1R(IX,IY) = MFILLR + ELSE + MX1R(IX,IY) = X1(IX,IY) + END IF + END DO + END DO #ifdef W3_SMC + IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MX1R(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) + call CHECK_ERR(IRET) + ELSE +#endif + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MX1R(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) + call CHECK_ERR(IRET) +#ifdef W3_SMC + ENDIF +#endif + ! EXTRADIM=1 + ELSE + START(4-COORDTYPE)=0 + DO IK=I1F,I2F + START(4-COORDTYPE)=START(4-COORDTYPE)+1 DO IX=IX1, IXN DO IY=IY1, IYN - ! TODO: Find some other way to access MAPSTA - IF ( X1(IX,IY) .EQ. UNDEF ) THEN + IF ( XK(IX,IY,IK) .EQ. UNDEF ) THEN MX1R(IX,IY) = MFILLR ELSE - MX1R(IX,IY) = X1(IX,IY) + MX1R(IX,IY) = XK(IX,IY,IK) END IF END DO END DO - IF(SMCOTYPE .EQ. 1) THEN - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MX1R(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) +#ifdef W3_SMC + IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MX1R(IX1:IXN,IY1:IYN),(/START(1), START(3), START(4)/), & + (/COUNT(1), COUNT(3), COUNT(4)/)) call CHECK_ERR(IRET) ELSE +#endif IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MX1R(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) + MX1R(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) call CHECK_ERR(IRET) - ENDIF -#endif - ELSE ! IF SMCGRD - DO IX=IX1, IXN - DO IY=IY1, IYN - IF ( MAPSTA(IY,IX) .LE. 0 .OR.X1(IX,IY) .EQ. UNDEF ) THEN - MX1R(IX,IY) = MFILLR - ELSE - MX1R(IX,IY) = X1(IX,IY) - END IF - END DO - END DO - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MX1R(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - CALL CHECK_ERR(IRET) - ENDIF ! SMCGRD - ! EXTRADIM=1 - ELSE - START(4-COORDTYPE)=0 - DO IK=I1F,I2F - START(4-COORDTYPE)=START(4-COORDTYPE)+1 - IF (SMCGRD) THEN #ifdef W3_SMC - DO IX=IX1, IXN - DO IY=IY1, IYN - ! TODO: Find some other way to access MAPSTA - IF ( XK(IX,IY,IK) .EQ. UNDEF ) THEN - MX1R(IX,IY) = MFILLR - ELSE - MX1R(IX,IY) = XK(IX,IY,IK) - END IF - END DO - END DO - IF(SMCOTYPE .EQ. 1) THEN - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MX1R(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) - call CHECK_ERR(IRET) - ELSE - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MX1R(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - call CHECK_ERR(IRET) - ENDIF + ENDIF #endif - ELSE ! IF SMCGRD - DO IX=IX1, IXN - DO IY=IY1, IYN - IF ( MAPSTA(IY,IX) .LE. 0 .OR.XK(IX,IY,IK) .EQ. UNDEF ) THEN - MX1R(IX,IY) = MFILLR - ELSE - MX1R(IX,IY) = XK(IX,IY,IK) - END IF - END DO - END DO - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MX1R(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) - CALL CHECK_ERR(IRET) - END IF ! SMCGRD END DO END IF ! EXTRADIM END IF ! NFIELD @@ -3527,21 +3339,18 @@ SUBROUTINE W3CRNC (NCFILE, NCID, DIMID, DIMLN, VARID, & ! IF (GTYPE.NE.UNGTYPE) THEN IF (FLAGLL) THEN - IF (SMCGRD) THEN #ifdef W3_SMC - IF(SMCOTYPE .EQ. 1) THEN - ! Flat seapoints file - IRET = NF90_DEF_DIM(NCID, 'seapoint', dimln(2), DIMID(2)) - ELSE - ! Regular gridded file: - IRET = NF90_DEF_DIM(NCID, 'longitude', dimln(2), DIMID(2)) - IRET = NF90_DEF_DIM(NCID, 'latitude', dimln(3), DIMID(3)) - ENDIF -#endif + IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN + ! Flat seapoints file + IRET = NF90_DEF_DIM(NCID, 'seapoint', dimln(2), DIMID(2)) ELSE - IRET = NF90_DEF_DIM(NCID, 'longitude', DIMLN(2), DIMID(2)) - IRET = NF90_DEF_DIM(NCID, 'latitude', DIMLN(3), DIMID(3)) - ENDIF ! SMCGRD +#endif + ! Regular gridded file: + IRET = NF90_DEF_DIM(NCID, 'longitude', dimln(2), DIMID(2)) + IRET = NF90_DEF_DIM(NCID, 'latitude', dimln(3), DIMID(3)) +#ifdef W3_SMC + ENDIF +#endif ELSE IRET = NF90_DEF_DIM(NCID, 'x', DIMLN(2), DIMID(2)) IRET = NF90_DEF_DIM(NCID, 'y', DIMLN(3), DIMID(3)) diff --git a/model/src/ww3_ounp.F90 b/model/src/ww3_ounp.F90 index 409888da1..499e0371f 100644 --- a/model/src/ww3_ounp.F90 +++ b/model/src/ww3_ounp.F90 @@ -1547,6 +1547,7 @@ SUBROUTINE W3EXNC(I,NCID,NREQ,INDREQ,ORDER) #endif #ifdef W3_NL1 USE W3SNL1MD + USE W3GDATMD, ONLY: IQTPE #endif #ifdef W3_NL2 USE W3SNL2MD @@ -2421,7 +2422,11 @@ SUBROUTINE W3EXNC(I,NCID,NREQ,INDREQ,ORDER) END IF IF ( FLSRCE(3) ) THEN #ifdef W3_NL1 - CALL W3SNL1 ( A, CG, WNMEAN*DEPTH, XNL, DIA ) + IF (IQTPE.GT.0) THEN + CALL W3SNL1 ( A, CG, WNMEAN*DEPTH, XNL, DIA ) + ELSE + CALL W3SNLGQM ( A, CG, WN, DEPTH, XNL, DIA ) + END IF #endif #ifdef W3_NL2 CALL W3SNL2 ( A, CG, DEPTH, XNL, DIA ) @@ -3203,7 +3208,7 @@ SUBROUTINE W3CRNC (ITYPE, OTYPE, NCTYPE, NCFILE, NCID, DIMID, DIMLN, VARID, ONE, IRET=NF90_PUT_ATT(NCID,VARID(4),'long_name','x') IRET=NF90_PUT_ATT(NCID,VARID(4),'standard_name','x') IRET=NF90_PUT_ATT(NCID,VARID(4),'globwave_name','x') - IRET=NF90_PUT_ATT(NCID,VARID(4),'units','m') + IRET=NF90_PUT_ATT(NCID,VARID(4),'units','km') IRET=NF90_PUT_ATT(NCID,VARID(4),'scale_factor',1.) IRET=NF90_PUT_ATT(NCID,VARID(4),'add_offset',0.) IRET=NF90_PUT_ATT(NCID,VARID(4),'valid_min',0.) @@ -3220,7 +3225,7 @@ SUBROUTINE W3CRNC (ITYPE, OTYPE, NCTYPE, NCFILE, NCID, DIMID, DIMLN, VARID, ONE, IRET=NF90_PUT_ATT(NCID,VARID(5),'long_name','y') IRET=NF90_PUT_ATT(NCID,VARID(5),'standard_name','y') IRET=NF90_PUT_ATT(NCID,VARID(5),'globwave_name','y') - IRET=NF90_PUT_ATT(NCID,VARID(5),'units','m') + IRET=NF90_PUT_ATT(NCID,VARID(5),'units','km') IRET=NF90_PUT_ATT(NCID,VARID(5),'scale_factor',1.) IRET=NF90_PUT_ATT(NCID,VARID(5),'add_offset',0.) IRET=NF90_PUT_ATT(NCID,VARID(5),'valid_min',0.) diff --git a/model/src/ww3_outf.F90 b/model/src/ww3_outf.F90 index 12f0a0f06..7bcafdb0f 100644 --- a/model/src/ww3_outf.F90 +++ b/model/src/ww3_outf.F90 @@ -159,7 +159,7 @@ PROGRAM W3OUTF ABA, ABD, UBA, UBD, SXX, SYY, SXY, USERO, & PHS, PTP, PLP, PDIR, PSI, PWS, PWST, PNR, & PTM1, PT1, PT2, PEP, TAUOCX, TAUOCY, & - PTHP0, PQP, PSW, PPE, PGW, QP, & + PTHP0, PQP, PSW, PPE, PGW, QP, QKK, & TAUOX, TAUOY, TAUWIX,BHD, & TAUWIY, PHIAW, PHIOC, TUSX, TUSY, PRMS, TPMS,& USSX, USSY, MSSX, MSSY, MSCX, MSCY, CHARN, & @@ -2247,7 +2247,7 @@ SUBROUTINE W3EXGO ( NX, NY, NSEA ) ! ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 5 ) THEN FLONE = .TRUE. - FSC = 0.01 + FSC = 0.001 UNITS = '1' ENAME = '.qp' IF ( ITYPE .EQ. 4 ) THEN @@ -2256,6 +2256,17 @@ SUBROUTINE W3EXGO ( NX, NY, NSEA ) CALL W3S2XY ( NSEA, NSEA, NX+1, NY, QP, MAPSF, X1 ) ENDIF ! + ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 6 ) THEN + FLONE = .TRUE. + FSC = 0.05 + UNITS = '1' + ENAME = '.qkk' + IF ( ITYPE .EQ. 4 ) THEN + XS1 = QKK + ELSE + CALL W3S2XY ( NSEA, NSEA, NX+1, NY, QKK, MAPSF, X1 ) + ENDIF + ! ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 1 ) THEN FLONE = .TRUE. FSC = 0.1 @@ -2416,8 +2427,7 @@ SUBROUTINE W3EXGO ( NX, NY, NSEA ) ! DO IX=IX1, IXN DO IY=IY1, IYN - IF ( MAPSTA(IY,IX) .GT. 0 .AND. & - X1(IX,IY) .NE. UNDEF ) THEN + IF ( X1(IX,IY) .NE. UNDEF ) THEN NINGRD = NINGRD + 1 XMIN = MIN ( XMIN , X1(IX,IY) ) XMAX = MAX ( XMAX , X1(IX,IY) ) @@ -2506,8 +2516,7 @@ SUBROUTINE W3EXGO ( NX, NY, NSEA ) IF ( FLTRI ) THEN DO IX=IX1, IXN DO IY=IY1, IYN - IF ( MAPSTA(IY,IX) .LE. 0 .OR. & - XX(IX,IY) .EQ. UNDEF ) THEN + IF ( XX(IX,IY) .EQ. UNDEF ) THEN MXX(IX,IY) = MFILL MYY(IX,IY) = MFILL MXY(IX,IY) = MFILL @@ -2546,8 +2555,7 @@ SUBROUTINE W3EXGO ( NX, NY, NSEA ) IF ( FLTWO .OR. FLDIR ) THEN DO IX=IX1, IXN DO IY=IY1, IYN - IF ( MAPSTA(IY,IX) .LE. 0 .OR. & - XX(IX,IY) .EQ. UNDEF ) THEN + IF ( XX(IX,IY) .EQ. UNDEF ) THEN MXX(IX,IY) = MFILL MYY(IX,IY) = MFILL ELSE @@ -2586,8 +2594,7 @@ SUBROUTINE W3EXGO ( NX, NY, NSEA ) ELSE DO IX=IX1, IXN DO IY=IY1, IYN - IF ( MAPSTA(IY,IX) .LE. 0 .OR. & - X1(IX,IY) .EQ. UNDEF ) THEN + IF ( X1(IX,IY) .EQ. UNDEF ) THEN MX1(IX,IY) = MFILL ELSE MX1(IX,IY) = NINT(X1(IX,IY)/FSC) diff --git a/model/src/ww3_outp.F90 b/model/src/ww3_outp.F90 index a95ec2e93..6d750687a 100644 --- a/model/src/ww3_outp.F90 +++ b/model/src/ww3_outp.F90 @@ -1983,7 +1983,11 @@ SUBROUTINE W3EXPO END IF IF ( FLSRCE(3) ) THEN #ifdef W3_NL1 - CALL W3SNL1 ( A, CG, WNMEAN*DEPTH, XNL, DIA ) + IF (IQTPE.GT.0) THEN + CALL W3SNL1 ( A, CG, WNMEAN*DEPTH, XNL, DIA ) + ELSE + CALL W3SNLGQM ( A, CG, WN, DEPTH, XNL, DIA ) + END IF #endif #ifdef W3_NL2 CALL W3SNL2 ( A, CG, DEPTH, XNL, DIA ) diff --git a/model/src/ww3_shel.F90 b/model/src/ww3_shel.F90 index d7e9790bb..ee3464f44 100644 --- a/model/src/ww3_shel.F90 +++ b/model/src/ww3_shel.F90 @@ -329,7 +329,7 @@ PROGRAM W3SHEL NDSEN, IERR, J, I, ILOOP, IPTS, NPTS, & NDTNEW, MPI_COMM = -99, & FLAGTIDE, COUPL_COMM, IH, N_TOT - INTEGER :: NDSF(-7:9), NDS(13), NTRACE(2), NDT(7:9), & + INTEGER :: NDSF(-7:9), NDS(15), NTRACE(2), NDT(7:9), & TIME0(2), TIMEN(2), TTIME(2), TTT(2), & NH(-7:10), THO(2,-7:10,NHMAX), RCLD(7:9), & NODATA(7:9), ODAT(40), IPRT(6) = 0, & @@ -600,6 +600,9 @@ PROGRAM W3SHEL NDS(11) = 22 NDS(12) = 23 NDS(13) = 34 + NDS(14) = 36 + NDS(15) = 37 + ! NTRACE(1) = NDS(3) NTRACE(2) = 10 diff --git a/model/src/ww3_trnc.F90 b/model/src/ww3_trnc.F90 index b26d0d642..ec69db4dc 100644 --- a/model/src/ww3_trnc.F90 +++ b/model/src/ww3_trnc.F90 @@ -47,6 +47,7 @@ PROGRAM W3TRNC ! ---------------------------------------------------------------- ! W3NMOD Subr. W3GDATMD Set number of model. ! W3NOUT Subr. W3ODATMD Set number of model for output. + ! W3IOGR Subr. W3IOGRMD Reading/writing model definition file. ! ---------------------------------------------------------------- ! ! 5. Called by : @@ -70,13 +71,17 @@ PROGRAM W3TRNC !/ ------------------------------------------------------------------- / USE CONSTANTS - USE W3GDATMD, ONLY : W3NMOD, W3SETG, FLAGLL, XFR +#ifdef W3_NL1 + USE W3ADATMD, ONLY : W3NAUX, W3SETA +#endif + USE W3GDATMD, ONLY : W3NMOD, W3SETG, FLAGLL, XFR, GNAME USE W3ODATMD, ONLY : W3NOUT, W3SETO, FNMPRE USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE #ifdef W3_S USE W3SERVMD, ONLY : STRACE #endif USE W3TIMEMD + USE W3IOGRMD, ONLY: W3IOGR ! USE W3ODATMD, ONLY: NDSO, NDSE ! @@ -91,7 +96,7 @@ PROGRAM W3TRNC TYPE(NML_TRACK_T) :: NML_TRACK TYPE(NML_FILE_T) :: NML_FILE ! - INTEGER :: NDSI, NDSINP, & + INTEGER :: NDSI, NDSINP, NDSM, & NDSOUT, NDSTRC, NTRACE, & NSPEC, IERR, MK, MTH, IT, & ILOC, ISPEC, S3, IOUT, & @@ -129,12 +134,17 @@ PROGRAM W3TRNC ! CALL W3NMOD ( 1, 6, 6 ) CALL W3SETG ( 1, 6, 6 ) +#ifdef W3_NL1 + CALL W3NAUX ( 6, 6 ) + CALL W3SETA ( 1, 6, 6 ) +#endif CALL W3NOUT ( 6, 6 ) CALL W3SETO ( 1, 6, 6 ) ! ! 1. IO set-up. ! NDSI = 10 + NDSM = 20 NDSINP = 11 NDSOUT = 51 ! @@ -148,11 +158,16 @@ PROGRAM W3TRNC ! WRITE (NDSO,900) ! + !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + ! 2. Read model definition file. + ! + CALL W3IOGR ( 'READ', NDSM ) + WRITE (NDSO,920) GNAME ! !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 2. Read requests from input file. + ! 3. Read requests from input file. ! ! @@ -163,13 +178,13 @@ PROGRAM W3TRNC ! Read namelist CALL W3NMLTRNC (NDSI, TRIM(FNMPRE)//'ww3_trnc.nml', NML_TRACK, NML_FILE, IERR) - ! 2.1 Time setup IDTIME, DTREQ, NOUT + ! 3.1 Time setup IDTIME, DTREQ, NOUT READ(NML_TRACK%TIMESTRIDE, *) DTREQ READ(NML_TRACK%TIMECOUNT, *) NOUT READ(NML_TRACK%TIMESTART, *) TOUT(1), TOUT(2) - ! 2.2 Output type + ! 3.2 Output type NCTYPE = NML_FILE%NETCDF FILEPREFIX = NML_FILE%PREFIX S3 = NML_TRACK%TIMESPLIT @@ -189,12 +204,12 @@ PROGRAM W3TRNC WRITE (NDSO,901) COMSTR - ! 2.1 Time setup IDTIME, DTREQ, NOUT + ! 3.1 Time setup IDTIME, DTREQ, NOUT CALL NEXTLN ( COMSTR , NDSI , NDSE ) READ (NDSI,*,END=806,ERR=807) TOUT, DTREQ, NOUT - ! 2.2 Output type + ! 3.2 Output type CALL NEXTLN ( COMSTR , NDSI , NDSE ) READ (NDSI,*,END=806,ERR=807) NCTYPE CALL NEXTLN ( COMSTR , NDSI , NDSE ) @@ -208,7 +223,7 @@ PROGRAM W3TRNC - ! 2.1 Time setup IDTIME, DTREQ, NOUT + ! 3.3 Time setup IDTIME, DTREQ, NOUT DTREQ = MAX ( 0. , DTREQ ) IF ( DTREQ.EQ.0. ) NOUT = 1 NOUT = MAX ( 1 , NOUT ) @@ -227,7 +242,7 @@ PROGRAM W3TRNC WRITE (NDSO,941) IDTIME, NOUT - ! 2.2 Output type + ! 3.4 Output type IF ( NCTYPE.LT.3 .OR. NCTYPE.GT.4 ) THEN WRITE (NDSE,1010) NCTYPE CALL EXTCDE ( 1 ) @@ -239,7 +254,7 @@ PROGRAM W3TRNC ! !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 3. Check consistency with input file and track_o.ww3 + ! 4. Check consistency with input file and track_o.ww3 ! OPEN (NDSINP,FILE=TRIM(FNMPRE)//'track_o.ww3',form='UNFORMATTED', convert=file_endian, & STATUS='OLD',ERR=800,IOSTAT=IERR) @@ -262,7 +277,7 @@ PROGRAM W3TRNC ! !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 4. Time management. + ! 5. Time management. ! IOUT = 0 NCID = 0 @@ -271,7 +286,7 @@ PROGRAM W3TRNC BACKSPACE (NDSINP) - ! 4.1 Loops on track_o.ww3 to read the time and data + ! 5.1 Loops on track_o.ww3 to read the time and data DO DTEST = DSEC21 ( TIME , TOUT ) @@ -310,17 +325,17 @@ PROGRAM W3TRNC END IF - ! 4.1.1 Increments the global time counter IOUT + ! 5.1.1 Increments the global time counter IOUT IOUT = IOUT + 1 CALL STME21 ( TOUT , IDTIME ) WRITE (NDSO,971) IDTIME - ! 4.1.2 Processes the variable value for the time step IOUT + ! 5.1.2 Processes the variable value for the time step IOUT CALL W3EXNC ( FILEPREFIX, NCTYPE, NCID, S3, STRSTOPDATE, MK, MTH ) - ! 4.1.3 Defines the stop date + ! 5.1.3 Defines the stop date CALL T2D(TOUT,STOPDATE,IERR) WRITE(STRSTOPDATE,'(I4.4,A,4(I2.2,A),I2.2)') STOPDATE(1),'-',STOPDATE(2), & '-',STOPDATE(3),' ',STOPDATE(5),':',STOPDATE(6),':',STOPDATE(7) @@ -331,7 +346,7 @@ PROGRAM W3TRNC 444 CONTINUE - ! 4.2 Closes the netCDF file + ! 5.2 Closes the netCDF file IF (NCID.NE.0) THEN IRET = NF90_REDEF(NCID) CALL CHECK_ERR(IRET) @@ -383,6 +398,8 @@ PROGRAM W3TRNC 902 FORMAT ( ' Spectral grid size : ',I3,' by ',I3// & ' Opening file : '/ & ' -----------------------------------------------') +920 FORMAT ( ' Grid name : ',A/) + ! 940 FORMAT (/' Output time data : '/ & ' --------------------------------------------------'/ & ' First time : ',A) diff --git a/model/tools/bash/ww3_multi_inp2nml.sh b/model/tools/bash/ww3_multi_inp2nml.sh index aa9afd497..c616282d3 100755 --- a/model/tools/bash/ww3_multi_inp2nml.sh +++ b/model/tools/bash/ww3_multi_inp2nml.sh @@ -705,13 +705,13 @@ cat >> $nmlfile << EOF ! ! * the detailed list of field names is given in model/nml/ww3_shel.nml : ! DPT CUR WND AST WLV ICE IBG D50 IC1 IC5 -! HS LM T02 T0M1 T01 FP DIR SPR DP HIG +! HS LM T02 T0M1 T01 FP DIR SPR DP HIG MXE MXES MXH MXHC SDMH SDMHC WBT TP WNM ! EF TH1M STH1M TH2M STH2M WN ! PHS PTP PLP PDIR PSPR PWS PDP PQP PPE PGW PSW PTM10 PT01 PT02 PEP TWS PNR ! UST CHA CGE FAW TAW TWA WCC WCF WCH WCM FWS ! SXY TWO BHD FOC TUS USS P2S USF P2L TWI FIC USP TOC ! ABR UBR BED FBB TBB -! MSS MSC WL02 AXT AYT AXY +! MSS MSC MSD MCD QP QKK ! DTD FC CFX CFD CFK ! U1 U2 ! diff --git a/model/tools/bash/ww3_shel_inp2nml.sh b/model/tools/bash/ww3_shel_inp2nml.sh index 7798abf20..619002aa8 100755 --- a/model/tools/bash/ww3_shel_inp2nml.sh +++ b/model/tools/bash/ww3_shel_inp2nml.sh @@ -878,7 +878,7 @@ cat >> $nmlfile << EOF ! T T 2 1 HS HS Wave height. ! T T 2 2 WLM LM Mean wave length. ! T T 2 3 T02 T02 Mean wave period (Tm0,2). -! T T 2 4 TM10 TM10 Mean wave period (Tm-1,0). +! T T 2 4 TM10 T0M1 Mean wave period (Tm-1,0). ! T T 2 5 T01 T01 Mean wave period (Tm0,1). ! T T 2 6 FP0 FP Peak frequency. ! T T 2 7 THM DIR Mean wave direction. @@ -893,6 +893,7 @@ cat >> $nmlfile << EOF ! T T 2 16 HCMAXD SDMHC St Dev of MXHC (STE) ! F T 2 17 WBT WBT Domiant wave breaking probability bT ! F F 2 18 FP0 TP Peak period (from peak freq) +! F F 2 19 WNMEAN WNM Mean wavenumber ! ------------------------------------------------- ! 3 Spectral Parameters (first 5) ! ------------------------------------------------- @@ -912,7 +913,7 @@ cat >> $nmlfile << EOF ! T T 4 5 PSI PSPR Partitioned mean directional spread. ! T T 4 6 PWS PWS Partitioned wind sea fraction. ! T T 4 7 PTHP0 PDP Peak wave direction of partition. -! T T 4 8 PQP PQP Goda peakdedness parameter of partition. +! T T 4 8 PQP PQP Goda peakedness parameter of partition. ! T T 4 9 PPE PPE JONSWAP peak enhancement factor of partition. ! T T 4 10 PGW PGW Gaussian frequency width of partition. ! T T 4 11 PSW PSW Spectral width of partition. @@ -965,10 +966,10 @@ cat >> $nmlfile << EOF ! ------------------------------------------------- ! F F 8 1 MSS[X,Y] MSS Mean square slopes ! F F 8 2 MSC[X,Y] MSC Spectral level at high frequency tail -! F F 8 3 WL02[X,Y] WL02 East/X North/Y mean wavelength compon -! F F 8 4 ALPXT AXT Correl sea surface gradients (x,t) -! F F 8 5 ALPYT AYT Correl sea surface gradients (y,t) -! F F 8 6 ALPXY AXY Correl sea surface gradients (x,y) +! F F 8 3 MSSD MSD Slope direction +! F F 8 4 MSCD MCD Tail slope direction +! F F 8 5 QP QP Goda peakedness parameter +! F F 8 6 QKK QKK Wavenumber peakedness ! ------------------------------------------------- ! 9 Numerical diagnostics ! ------------------------------------------------- diff --git a/regtests/bin/matrix.base b/regtests/bin/matrix.base index 28d78634a..23f8385b1 100755 --- a/regtests/bin/matrix.base +++ b/regtests/bin/matrix.base @@ -690,6 +690,7 @@ echo "$rtst -s ST0 -w work_ST0 $ww3 ww3_tp2.6" >> matrix.body echo "$rtst -s ST0 -w work_ST0 $ww3 ww3_tp2.7" >> matrix.body echo "$rtst -s ST4 -w work_ST4 $ww3 ww3_tp2.6" >> matrix.body + echo "$rtst -s ST4_ASCII -w work_ST4_ASCII $ww3 ww3_tp2.6" >> matrix.body fi if [ "$prop1D" = 'y' ] @@ -919,6 +920,8 @@ echo "$rtst -s ST4_TSA -w work_ST4_TSA $ww3 ww3_ts1" >> matrix.body echo "$rtst -s ST6 -w work_ST6 $ww3 ww3_ts1" >> matrix.body echo "$rtst -w work_NL5 -i input_nl5_matrix $ww3 ww3_ts1" >> matrix.body + echo "$rtst -g ST4_T707 -w work_T707GQM -i input_10ms -N $ww3 ww3_ts1" >> matrix.body + echo "$rtst -g ST4_T713 -w work_T713GQM -i input_10ms -N $ww3 ww3_ts1" >> matrix.body fi # fetch limited growth, no switch sharing here @@ -1893,6 +1896,7 @@ then echo ' ' >> matrix.body echo "$rtst -s MPI -w work_MPI -m grdset_a -f -p $mpi -n $np $ww3 mww3_test_09" >> matrix.body + echo "$rtst -s MPI_ASCII -w work_MPI_ASCII -m grdset_a -f -p $mpi -n $np $ww3 mww3_test_09" >> matrix.body fi # Rotated pole grid cases, (ww3_tp2.11 MPI only if requested) @@ -2163,11 +2167,13 @@ # Global unstr case # Domain Decomposition Explicit fi + if [ "$ufs" = 'y' ] && [ "$pdlib" = 'y' ] && [ "$dist" = 'y' ]; then echo "$rtst -s MPI -s PDLIB -i input_unstr -w work_unstr_a -g a -f -p $mpi -n $np $ww3 ww3_ufs1.1" >> matrix.body # Domain Decomposition Block Explicit echo "$rtst -s MPI -s PDLIB -i input_unstr -w work_unstr_b -g b -f -p $mpi -n $np $ww3 ww3_ufs1.1" >> matrix.body # Domain Decomposition Implicit echo "$rtst -s MPI -s PDLIB -i input_unstr -w work_unstr_c -g c -f -p $mpi -n $np $ww3 ww3_ufs1.1" >> matrix.body + fi #Test of UFS applications with ww3_multi_esmf and grib2 output if [ "$ufs" = 'y' ] && [ "$esmf" = 'y' ] && [ "$grib" = 'y' ] diff --git a/regtests/bin/matrix_cmake_datarmor b/regtests/bin/matrix_cmake_datarmor index a197d3a03..7728f6e1f 100755 --- a/regtests/bin/matrix_cmake_datarmor +++ b/regtests/bin/matrix_cmake_datarmor @@ -112,6 +112,7 @@ main_dir="`cd $main_dir 1>/dev/null 2>&1 && pwd`" echo " export NETCDF_CONFIG=/home/datawork-wave/NETCDF2019/${COMP}/bin/nc-config" >> matrix.head echo " export NetCDF_ROOT=/home/datawork-wave/NETCDF2019/${COMP}" >> matrix.head echo " export METIS_PATH=/home/datawork-wave/PARMETIS2019/${COMP}" >> matrix.head + echo " export SCOTCH_PATH=/home/datawork-wave/LIB/SCOTCH/v7.0.3/${COMP}" >> matrix.head echo " export WW3_PARCOMPN=4" >> matrix.head echo " export G2_LIB4=/home/datawork-wave/NCEPLIBS/${COMP}/g2-3.4.5/lib64/libg2_4.a" >> matrix.head echo " export BACIO_LIB4=/home/datawork-wave/NCEPLIBS/${COMP}/bacio-2.4.1/lib/libbacio_4.a" >> matrix.head @@ -128,7 +129,7 @@ main_dir="`cd $main_dir 1>/dev/null 2>&1 && pwd`" export mpi='$MPI_LAUNCH' # Compile option - opt="-f -N -S -T" + opt="-f -N -S -T -o both" # Base run_test command line export rtst="./bin/run_cmake_test $opt" diff --git a/regtests/bin/matrix_cmake_ncep b/regtests/bin/matrix_cmake_ncep index 8d1ca00e5..4e2b3504d 100755 --- a/regtests/bin/matrix_cmake_ncep +++ b/regtests/bin/matrix_cmake_ncep @@ -41,16 +41,18 @@ EOF # Convert main_dir to absolute path main_dir="`cd $main_dir 1>/dev/null 2>&1 && pwd`" -# Module Versions from HPC-Stack that are common for all platforms - modnetcdf='netcdf/4.7.4' - modjasper='jasper/2.0.25' - modzlib='zlib/1.2.11' +# Module Versions from spack-stack that are common for all platforms + modnetcdfc='netcdf-c/4.9.2' + modnetcdff='netcdf-fortran/4.6.0' + modjasper='jasper/2.0.32' + modzlib='zlib/1.2.13' modpng='libpng/1.6.37' - modhdf5='hdf5/1.10.6' + modhdf5='hdf5/1.14.0' modbacio='bacio/2.4.1' modg2='g2/3.4.5' - modw3emc='w3emc/2.9.2' - modesmf='esmf/8.3.0b09' + modw3emc='w3emc/2.10.0' + modesmf='esmf/8.4.2' + modscotch='scotch/7.0.4' # Set batchq queue, choose modules and other custom variables to fit system and # to define headers etc (default to original version if empty) @@ -60,27 +62,19 @@ EOF then # If no other h, assuming Hera batchq='slurm' - basemodcomp='intel/2022.1.2' - basemodmpi='impi/2022.1.2' - hpcstackpath='/scratch1/NCEPDEV/nems/role.epic/hpc-stack/libs/intel-2022.1.2/modulefiles/stack' - hpcstackversion='hpc/1.2.0' - modcomp='hpc-intel/2022.1.2' - modmpi='hpc-impi/2022.1.2' - scotchpath='/scratch1/NCEPDEV/climate/Matthew.Masarik/waves/opt/hpc-stack/scotch-v7.0.3/install' - metispath='/scratch1/NCEPDEV/climate/Matthew.Masarik/waves/opt/hpc-stack/parmetis-4.0.3/install' - modcmake='cmake/3.20.1' + spackstackpath='/scratch1/NCEPDEV/nems/role.epic/spack-stack/spack-stack-1.5.0/envs/unified-env-noavx512/install/modulefiles/Core' + modcomp='stack-intel/2021.5.0' + modmpi='stack-intel-oneapi-mpi/2021.5.1' + metispath='/scratch1/NCEPDEV/climate/Matthew.Masarik/waves/opt/spack-stack/1.5.0/parmetis-4.0.3/install' + modcmake='cmake/3.23.1' elif [ $isorion ] then batchq='slurm' - basemodcomp='intel/2022.1.2' - basemodmpi='impi/2022.1.2' - hpcstackpath='/work/noaa/epic-ps/role-epic-ps/hpc-stack/libs/intel-2022.1.2/modulefiles/stack' - hpcstackversion='hpc/1.2.0' - modcomp='hpc-intel/2022.1.2' - modmpi='hpc-impi/2022.1.2' - scotchpath='/work2/noaa/marine/mmasarik/waves/opt/hpc-stack/scotch-v7.0.3/install' - metispath='/work2/noaa/marine/mmasarik/waves/opt/hpc-stack/parmetis-4.0.3/install' - modcmake='cmake/3.22.1' + spackstackpath='/work/noaa/epic/role-epic/spack-stack/orion/spack-stack-1.5.0/envs/unified-env/install/modulefiles/Core' + modcomp='stack-intel/2022.0.2' + modmpi='stack-intel-oneapi-mpi/2021.5.1' + metispath='/work/noaa/marine/Matthew.Masarik/waves/opt/spack-stack/1.5.0/parmetis-4.0.3/install' + modcmake='cmake/3.23.1' else batchq= fi @@ -96,7 +90,7 @@ EOF # 1.a Computer/ user dependent set up - echo '#!/bin/sh --login' > matrix.head + echo '#!/bin/sh' > matrix.head echo ' ' >> matrix.head if [ $batchq = "slurm" ] && [ $isorion ] then @@ -139,29 +133,28 @@ EOF # Netcdf, Parmetis and SCOTCH modules & variables echo " module purge" >> matrix.head - echo " module load $modcmake" >> matrix.head if [ ! -z $basemodcomp ]; then echo " module load $basemodcomp" >> matrix.head fi if [ ! -z $basemodmpi ]; then echo " module load $basemodmpi" >> matrix.head fi - echo " module use $hpcstackpath" >> matrix.head - echo " module load $hpcstackversion" >> matrix.head + echo " module use $spackstackpath" >> matrix.head echo " module load $modcomp" >> matrix.head echo " module load $modmpi" >> matrix.head + echo " module load $modcmake" >> matrix.head echo " module load $modpng" >> matrix.head echo " module load $modzlib" >> matrix.head echo " module load $modjasper" >> matrix.head echo " module load $modhdf5" >> matrix.head - echo " module load $modnetcdf" >> matrix.head + echo " module load $modnetcdfc" >> matrix.head + echo " module load $modnetcdff" >> matrix.head echo " module load $modbacio" >> matrix.head echo " module load $modg2" >> matrix.head echo " module load $modw3emc" >> matrix.head echo " module load $modesmf" >> matrix.head - + echo " module load $modscotch" >> matrix.head echo " export METIS_PATH=${metispath}" >> matrix.head - echo " export SCOTCH_PATH=${scotchpath}" >> matrix.head echo " export path_build_root=$(dirname $main_dir)/regtests/buildmatrix" >> matrix.head echo ' [[ -d ${path_build_root} ]] && rm -rf ${path_build_root}' >> matrix.head echo ' ' diff --git a/regtests/bin/run_cmake_test b/regtests/bin/run_cmake_test index e114cd72a..86248bb4e 100755 --- a/regtests/bin/run_cmake_test +++ b/regtests/bin/run_cmake_test @@ -491,7 +491,9 @@ then cp $path_build/install/bin/ww3_shel $path_e/ cp $path_build/install/bin/ww3_multi $path_e/ cp $path_build/install/bin/ww3_systrk $path_e/ - cp $path_build/install/bin/ww3_prtide $path_e/ + if [ -e $path_build/install/bin/ww3_prtide ]; then + cp $path_build/install/bin/ww3_prtide $path_e/ + fi fi else path_build=${path_build_root} @@ -626,7 +628,7 @@ then fi # link conf file - if [ $nml_input ] && [ ! -z "`echo ${ifile} | grep -o nml`" ] + if [ $nml_input ] && [ ! -z "`basename ${ifile} | grep -o nml`" ] then \rm -f $prog.nml \ln -s $ifile $prog.nml @@ -652,7 +654,11 @@ then if [ $multi -eq 2 ] then mv mod_def.ww3 mod_def.$g - if [ $nml_input ] && [ ! -z "`echo ${ifile} | grep -o nml`" ] + if [ -e mod_def.ww3.txt ] + then + mv mod_def.ww3.txt mod_def.${g}.txt + fi + if [ $nml_input ] && [ ! -z "`basename ${ifile} | grep -o nml`" ] then mv $prog.nml.log ${prog}_$g.nml.log fi @@ -750,7 +756,7 @@ then then mv restart.ww3 restart.$g \rm -f mod_def.ww3 - if [ $nml_input ] && [ ! -z "`echo ${ifile} | grep -o nml`" ] + if [ $nml_input ] && [ ! -z "`basename ${ifile} | grep -o nml`" ] then mv $prog.nml.log ${prog}_$g.nml.log fi @@ -849,7 +855,7 @@ then then mv nest.ww3 nest.$g \rm -f mod_def.ww3 - if [ $nml_input ] && [ ! -z "`echo ${ifile} | grep -o nml`" ] + if [ $nml_input ] && [ ! -z "`basename ${ifile} | grep -o nml`" ] then mv $prog.nml.log ${prog}_$g.nml.log fi @@ -948,7 +954,7 @@ then then mv nest.ww3 nest.$g \rm -f mod_def.ww3 - if [ $nml_input ] && [ ! -z "`echo ${ifile} | grep -o nml`" ] + if [ $nml_input ] && [ ! -z "`basename ${ifile} | grep -o nml`" ] then mv $prog.nml.log ${prog}_$g.nml.log fi @@ -1052,7 +1058,7 @@ then then \rm -f mod_def.ww3 mv $otype.ww3 $otype.$g - if [ $nml_input ] && [ ! -z "`echo ${ifile} | grep -o nml`" ] + if [ $nml_input ] && [ ! -z "`basename ${ifile} | grep -o nml`" ] then mv $prog.nml.log ${prog}_$g.nml.log fi @@ -1127,9 +1133,9 @@ then if [ $nml_input ] && [ ! -z "`ls ${path_i}/${prog}*.nml 2>/dev/null`" ] then - inputs_tmp=`( ls ${path_i}/${prog}${gu}*nml)` + inputs_tmp="`ls ${path_i}/${prog}${gu}*nml 2>/dev/null`" else - inputs_tmp=`( ls ${path_i}/${prog}${gu}*inp)` + inputs_tmp="`ls ${path_i}/${prog}${gu}*inp 2>/dev/null`" fi if [ ! -z "$inputs_tmp" ];then @@ -1176,7 +1182,7 @@ then then \rm -f mod_def.ww3 mv $otype.ww3 $otype.$g - if [ $nml_input ] && [ ! -z "`echo ${ifile} | grep -o nml`" ] + if [ $nml_input ] && [ ! -z "`basename ${ifile} | grep -o nml`" ] then mv $prog.nml.log ${prog}_$g.nml.log fi @@ -1299,7 +1305,7 @@ then then \rm -f mod_def.ww3 mv $otype.ww3 $otype.$g - if [ $nml_input ] && [ ! -z "`echo ${ifile} | grep -o nml`" ] + if [ $nml_input ] && [ ! -z "`basename ${ifile} | grep -o nml`" ] then mv $prog.nml.log ${prog}_$g.nml.log fi @@ -1443,7 +1449,7 @@ then \rm -f PET*.ESMF_LogFile \rm -f ww3_esmf.rc \cp -f ${path_i}/ww3_esmf.rc ww3_esmf.rc - if [ ! -z "`echo ${ifile} | grep -o nml`" ] + if [ ! -z "`basename ${ifile} | grep -o nml`" ] then echo "WAV_input_file_name: $prog.nml" >> ww3_esmf.rc fi @@ -1752,7 +1758,7 @@ do then \rm -f mod_def.ww3 \rm -f out_grd.ww3 - if [ $nml_input ] && [ ! -z "`echo ${ifile} | grep -o nml`" ] + if [ $nml_input ] && [ ! -z "`basename ${ifile} | grep -o nml`" ] then mv $prog.nml.log ${prog}_$g.nml.log fi @@ -1819,7 +1825,7 @@ do then \rm -f mod_def.ww3 \rm -f out_grd.ww3 - if [ $nml_input ] && [ ! -z "`echo ${ifile} | grep -o nml`" ] + if [ $nml_input ] && [ ! -z "`basename ${ifile} | grep -o nml`" ] then mv $prog.nml.log ${prog}_$g.nml.log fi @@ -1987,7 +1993,7 @@ do then \rm -f mod_def.ww3 \rm -f out_pnt.ww3 - if [ $nml_input ] && [ ! -z "`echo ${ifile} | grep -o nml`" ] + if [ $nml_input ] && [ ! -z "`basename ${ifile} | grep -o nml`" ] then mv $prog.nml.log ${prog}_$g.nml.log fi @@ -2025,7 +2031,7 @@ done # end of loop on progs case $outopt in native) out_progs="ww3_trck" ;; netcdf) out_progs="ww3_trnc" ;; - both) out_progs="ww3_trck ww3_trnc" ;; + both|all) out_progs="ww3_trck ww3_trnc" ;; *) out_progs="" ;; esac @@ -2068,6 +2074,9 @@ do then continue fi + + \ln -s mod_def.$g mod_def.ww3 + gu="_$g" fileconf="$prog${gu}" else @@ -2122,8 +2131,9 @@ do \rm -f $prog.nml if [ $multi -eq 2 ] then + \rm -f mod_def.ww3 \rm -f track_o.ww3 - if [ $nml_input ] && [ ! -z "`echo ${ifile} | grep -o nml`" ] + if [ $nml_input ] && [ ! -z "`basename ${ifile} | grep -o nml`" ] then mv $prog.nml.log ${prog}_$g.nml.log fi diff --git a/regtests/bin/run_test b/regtests/bin/run_test index 7ed5ce40e..560ab0725 100755 --- a/regtests/bin/run_test +++ b/regtests/bin/run_test @@ -2368,7 +2368,7 @@ done # end of loop on progs case $outopt in native) out_progs="ww3_trck" ;; netcdf) out_progs="ww3_trnc" ;; - both) out_progs="ww3_trck ww3_trnc" ;; + both|all) out_progs="ww3_trck ww3_trnc" ;; *) out_progs="" ;; esac @@ -2448,6 +2448,9 @@ do then continue fi + + \ln -s mod_def.$g mod_def.ww3 + gu="_$g" fileconf="$prog${gu}" else @@ -2502,6 +2505,7 @@ do \rm -f $prog.nml if [ $multi -eq 2 ] then + \rm -f mod_def.ww3 \rm -f track_o.ww3 if [ $nml_input ] && [ ! -z "`echo ${ifile} | grep -o nml`" ] then diff --git a/regtests/mww3_test_01/input/ww3_ounf.inp b/regtests/mww3_test_01/input/ww3_ounf.inp index 55b74a100..f78b0e667 100644 --- a/regtests/mww3_test_01/input/ww3_ounf.inp +++ b/regtests/mww3_test_01/input/ww3_ounf.inp @@ -11,7 +11,7 @@ $ file for a full documentation of field output options. Namelist type $ selection is used here (for alternative F/T flags, see ww3_shel.inp). $ N - HS + HS ICE $ $--------------------------------------------------------------------- $ $ Output type 4 [3,4] (version netCDF) diff --git a/regtests/mww3_test_01/input/ww3_ounf.nml b/regtests/mww3_test_01/input/ww3_ounf.nml index 5a92a0cb5..b6a115a7f 100644 --- a/regtests/mww3_test_01/input/ww3_ounf.nml +++ b/regtests/mww3_test_01/input/ww3_ounf.nml @@ -9,7 +9,7 @@ FIELD%TIMESTART = '19680606 000000' FIELD%TIMESTRIDE = '3600' FIELD%TIMECOUNT = '999' - FIELD%LIST = 'HS' + FIELD%LIST = 'HS ICE' FIELD%PARTITION = '0 1 2' FIELD%TYPE = 4 / diff --git a/regtests/mww3_test_01/input/ww3_outf_file.inp b/regtests/mww3_test_01/input/ww3_outf_file.inp index 6d909ff53..db8c14716 100644 --- a/regtests/mww3_test_01/input/ww3_outf_file.inp +++ b/regtests/mww3_test_01/input/ww3_outf_file.inp @@ -6,7 +6,7 @@ $ 19680606 000000 3600 999 $ N - HS + HS ICE $ 3 0 1 999 1 999 1 1 diff --git a/regtests/mww3_test_01/input/ww3_shel.inp b/regtests/mww3_test_01/input/ww3_shel.inp index 1585f747e..ecc511800 100644 --- a/regtests/mww3_test_01/input/ww3_shel.inp +++ b/regtests/mww3_test_01/input/ww3_shel.inp @@ -18,7 +18,7 @@ $ 19680606 000000 450 19680607 000000 $ N - HS FP DP + HS FP DP ICE $ 19680606 000000 450 19680607 000000 100.E3 100.E3 'point_A' diff --git a/regtests/mww3_test_01/input/ww3_shel.nml b/regtests/mww3_test_01/input/ww3_shel.nml index f9a586f53..903cef0c8 100644 --- a/regtests/mww3_test_01/input/ww3_shel.nml +++ b/regtests/mww3_test_01/input/ww3_shel.nml @@ -22,7 +22,7 @@ ! Define the output types point parameters via OUTPUT_TYPE_NML namelist ! -------------------------------------------------------------------- ! &OUTPUT_TYPE_NML - TYPE%FIELD%LIST = 'HS FP DP' + TYPE%FIELD%LIST = 'HS FP DP ICE' TYPE%POINT%FILE = '../input/points.list' / diff --git a/regtests/mww3_test_09/input/switch_MPI_ASCII b/regtests/mww3_test_09/input/switch_MPI_ASCII new file mode 100644 index 000000000..e3d9628f0 --- /dev/null +++ b/regtests/mww3_test_09/input/switch_MPI_ASCII @@ -0,0 +1 @@ +ASCII NOGRB MPI DIST PR2 UNO SMC FLX2 LN0 ST0 NL0 BT0 DB0 TR0 BS0 IC0 IS0 REF0 WNT1 WNX1 CRT1 CRX1 O0 O1 O2 O3 O4 O5 O6 O7 O10 O11 diff --git a/regtests/unittests/CMakeLists.txt b/regtests/unittests/CMakeLists.txt new file mode 100644 index 000000000..69445bfb7 --- /dev/null +++ b/regtests/unittests/CMakeLists.txt @@ -0,0 +1,39 @@ +# This is the CMake file for the model/tests directory in the WW3 +# project. +# +# Ed Hartnett, 10/14/23 + +# Some very small test files may be committed to the repo. This +# function copies such a data file to the build directory. +function(copy_test_data name) + message(STATUS "Copying ${name} to ${CMAKE_CURRENT_BINARY_DIR}") + file(COPY "${CMAKE_CURRENT_SOURCE_DIR}/data/${name}" + DESTINATION ${CMAKE_CURRENT_BINARY_DIR} + FILE_PERMISSIONS OWNER_READ OWNER_WRITE GROUP_READ WORLD_READ) +endfunction() + +# Some very small test files may be committed to the repo. This +# function copies such a data file to the build directory. +function(copy_test_data_2 srcname destname) + message(STATUS "Copying ${srcname} to ${CMAKE_CURRENT_BINARY_DIR}/${destname}") + file(COPY "${CMAKE_CURRENT_SOURCE_DIR}/data/${srcname}" + DESTINATION "${CMAKE_BINARY_DIR}" + FILE_PERMISSIONS OWNER_READ OWNER_WRITE GROUP_READ WORLD_READ) + file(RENAME "${CMAKE_BINARY_DIR}/${srcname}" "${CMAKE_BINARY_DIR}/${destname}") +endfunction() + +# Function to build and run a test. +function(unit_test name) + add_executable(${name} ${name}.F90) + target_link_libraries(${name} PRIVATE ww3_lib) + add_test(NAME ${name} COMMAND ${name}) +endfunction() + +# Copy test data files that are in the repo to the build directory. +copy_test_data(switch.io) +copy_test_data_2(ww3_grid.inp ww3_grid.inp) + +# Build and run the tests. +unit_test(test_io_points_bin) + + diff --git a/regtests/unittests/data/switch.io b/regtests/unittests/data/switch.io new file mode 100644 index 000000000..c97e44765 --- /dev/null +++ b/regtests/unittests/data/switch.io @@ -0,0 +1 @@ +NOGRB SHRD PR1 FLX2 LN0 ST0 NL0 BT0 DB0 TR0 BS0 IC0 IS0 REF0 WNT1 WNX1 CRT1 CRX1 O0 O1 O2 O3 O4 O5 O6 O7 O10 O11 \ No newline at end of file diff --git a/regtests/unittests/data/ww3_grid.inp b/regtests/unittests/data/ww3_grid.inp new file mode 100644 index 000000000..6f45604f3 --- /dev/null +++ b/regtests/unittests/data/ww3_grid.inp @@ -0,0 +1,48 @@ +$ WAVEWATCH III Grid preprocessor input file +$ ------------------------------------------ + '1-D REFRACTION X ' +$ + 1.25 0.08 3 24 0. +$ + F T F T F F + 300. 300. 150. 300. +$ + &PRO1 CFLTM = 0.75 / + &PRO2 CFLTM = 0.75 / + &PRO3 CFLTM = 0.75, WDTHCG = 0., WDTHTH = 0. / + &PRO4 CFLTM = 0.75, RNFAC = 0., RSFAC = 0. / +END OF NAMELISTS +$ + 'RECT' F 'NONE' + 13 3 + 5.E3 5.E3 1. + -5.E3 -5.E3 1. +$ + -1. 1. 10 -1. 2 1 '(....)' 'UNIT' 'input' +$ +$ First grid +$ + 50 50 50 45 40 35 30 25 20 15 10 5 0 + 50 50 50 45 40 35 30 25 20 15 10 5 0 + 50 50 50 45 40 35 30 25 20 15 10 5 0 +$ +$ Second grid +$ +$ 0 5 10 15 20 25 30 35 40 45 50 50 50 +$ 0 5 10 15 20 25 30 35 40 45 50 50 50 +$ 0 5 10 15 20 25 30 35 40 45 50 50 50 +$ + 10 1 1 '(....)' 'PART' 'input' +$ +$ First grid +$ + 2 2 F +$ +$ Second grid +$ +$ 12 2 F + 0 0 F + 0 0 F + 0 0 +$ + 0. 0. 0. 0. 0 diff --git a/regtests/unittests/data/ww3_outp.inp b/regtests/unittests/data/ww3_outp.inp new file mode 100644 index 000000000..dd728819f --- /dev/null +++ b/regtests/unittests/data/ww3_outp.inp @@ -0,0 +1,8 @@ +$ + 20100101 000000 3600 1 +$ + 1 + -1 +$ + 4 + 2 30 20100101 000000 'UTC' diff --git a/regtests/unittests/test_io_points_bin.F90 b/regtests/unittests/test_io_points_bin.F90 new file mode 100644 index 000000000..69c197bce --- /dev/null +++ b/regtests/unittests/test_io_points_bin.F90 @@ -0,0 +1,152 @@ +! This is a test for model IO for WW3. This tests the legacy (binary) +! output of points data, done by function W3IOPO(). +! +! Ed Hartnett 10/14/23 +program test_io_points_bin + use w3iopomd + use w3gdatmd + use w3wdatmd + use w3odatmd + use w3iogrmd + use w3adatmd + implicit none + + integer, target :: i + integer :: ndsop, iotest, ndsbul, ndsm + integer :: ndstrc, ntrace + character*7 expected_ptnme + character*6 my_fmt + real :: expected_loc_1 + integer :: write_test_file + + print *, 'Testing WW3 binary point file code.' + + ! These are mysterious but have to be called or else the IPASS + ! variable does not exist and w3iopo() crashes. + call w3nmod(1, 6, 6) + call w3setg(1, 6, 6) + call w3ndat(6, 6) + call w3setw(1, 6, 6) + call w3nout(6, 6) + call w3seto(1, 6, 6) + + ndsm = 20 + ndsop = 20 + ndsbul = 0 + ndstrc = 6 + ntrace = 10 + + ! Create a point output file needed for this test. + if (write_test_file() .ne. 0) stop 1 + + write (ndso,900) +900 FORMAT (/15X,' *** WAVEWATCH III Point output post.*** '/ & + 15X,'==============================================='/) + + ! 2. Read model definition file. + CALL W3IOGR('READ', NDSM) + WRITE (NDSO,920) GNAME +920 FORMAT (' Grid name : ',A/) + + ! This will not work. But cannot be tested because it will change the value of IPASS, +! call w3iopo('EAD', ndsop, iotest) +! if (iotest .ne. 1) stop 7 + + ! Read the file out_pnt.ww3 from the model/tests/data directory. + call w3iopo('READ', ndsop, iotest) + if (iotest .ne. 0) stop 10 + close(ndsop) + + ! Make sure we got the values we expected. + if (nopts .ne. 11) stop 11 + expected_loc_1 = 0.0 + do i = 1, nopts + ! Check ptnme and ptloc arrays. + print *, ptnme(i), ptloc(1, i), ptloc(2, i) + if (i .lt. 10) then + my_fmt = '(a,i1)' + else + my_fmt = '(a,i2)' + endif + write(fmt = my_fmt, unit=expected_ptnme) 'Point', i + if (ptnme(i) .ne. expected_ptnme) stop 20 + print *, expected_loc_1 + if (ptloc(1, i) .ne. expected_loc_1) stop 21 + expected_loc_1 = expected_loc_1 + 5000.0 + if (ptloc(2, i) .ne. 0) stop 22 + end do + + print *, 'OK!' + print *, 'SUCCESS!' +end program test_io_points_bin + +integer function write_test_file() + implicit none + + integer :: ntlu, nk, nth, nopts + character(len=10), parameter :: veropt = '2021-04-06' + character(len=31), parameter :: idstr = 'WAVEWATCH III POINT OUTPUT FILE' + real :: ptloc(2,11) = reshape((/ 0., 0., 5000., 0., 10000., 0., 15000., 0., & + 20000., 0., 25000., 0., 30000., 0., 35000., 0., 40000., 0., 45000., 0., 50000., 0. /), & + (/ 2, 11 /)) + character*40 ptnme(11) + integer :: time(2) = (/ 19680606, 0 /) + integer :: nspec = 72 + integer :: iw(11) = (/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /) + integer :: ii(11) = (/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /) + integer :: il(11) = (/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /) + real :: iceo(11) = (/ 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. /) + real :: iceho(11) = (/ 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. /) + real :: icefo(11) = (/ 1000., 1000., 1000., 1000., 1000., 1000., 1000., 1000., 1000., 1000., 1000. /) + real :: dpo(11) = (/ 50., 50., 45., 40., 35., 30., 25., 20., 15., 10., 5. /) + real :: wao(11) = (/ 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. /) + real :: wdo(11) = (/ 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. /) + real :: aso(11) = (/ -999.900024, -999.900024, -999.900024, -999.900024, -999.900024, & + -999.900024, -999.900024, -999.900024, -999.900024, -999.900024, -999.900024 /) + real :: cao(11) = (/ 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. /) + real :: cdo(11) = (/ 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. /) + character*13 :: grdid(11) + real :: spco(72, 11) + integer :: i, j + integer :: ierr + + ! Initialize some values. + ntlu = 21 + nk = 3 + nth = 24 + nopts = 11 + do i = 1, nopts + if (i .le. 9) then + write(ptnme(i), '(a,i1)') 'Point', i + else + write(ptnme(i), '(a,i2)') 'Point', i + endif + grdid(i) = 'ww3 ' + end do + + ! Open the file. + open(ntlu, file="out_pnt.ww3", form="unformatted", status="replace", & + action="write", convert="big_endian", iostat=ierr) + if (ierr .ne. 0) stop 111 + + ! Write our values. + write (ntlu, iostat=ierr) idstr, veropt, nk, nth, nopts + if (ierr .ne. 0) stop 112 + write (ntlu, iostat=ierr) ((ptloc(j,i),j=1,2),i=1,nopts), (ptnme(i),i=1,nopts) + if (ierr .ne. 0) stop 113 + write (ntlu, iostat=ierr) time + if (ierr .ne. 0) stop 114 + do i=1, nopts + write (ntlu, iostat=ierr) iw(i), ii(i), il(i), dpo(i), wao(i), wdo(i), & + aso(i), cao(i), cdo(i), iceo(i), iceho(i), & + icefo(i), grdid(i), (spco(j,i),j=1,nspec) + if (ierr .ne. 0) stop 115 + enddo + + ! Close the file. + close(ntlu) + + ! We're done! + write_test_file = 0 +end function write_test_file + diff --git a/regtests/ww3_tp2.12/info b/regtests/ww3_tp2.12/info index e39ade75b..622e6f523 100644 --- a/regtests/ww3_tp2.12/info +++ b/regtests/ww3_tp2.12/info @@ -29,7 +29,7 @@ # * ww3_grid.inp (dummy grid input file, with assoc .bot, .mask, .obst) # # * partition.ww3 (raw fields of partition data, 4 time steps) # # * ww3_systrk.inp (instruction file) # -# * ww3_systrk will ABORT if endianess is incompatible with binary file! # +# * ww3_systrk will stop if endianess is incompatible with binary file! # # # # Sample run_test commands : # # (Note: mpirun commands differ by local system) # diff --git a/regtests/ww3_tp2.15/input_rho/ww3_ounf.inp b/regtests/ww3_tp2.15/input_rho/ww3_ounf.inp index 9e9b2c300..564610663 100644 --- a/regtests/ww3_tp2.15/input_rho/ww3_ounf.inp +++ b/regtests/ww3_tp2.15/input_rho/ww3_ounf.inp @@ -3,7 +3,7 @@ $ ----------------------------------------- 20140309 000000 900. 9999 $ N -HS WND RHO TAU T02 DP DIR FP MXE MXES MXH MXHC SDMH SDMHC +HS WND RHO TAU T02 DP DIR FP MXE MXES MXH MXHC SDMH SDMHC QP QKK $ $ 3 4 diff --git a/regtests/ww3_tp2.15/input_rho/ww3_ounf.nml b/regtests/ww3_tp2.15/input_rho/ww3_ounf.nml index 848d2ec92..d4e8c9151 100644 --- a/regtests/ww3_tp2.15/input_rho/ww3_ounf.nml +++ b/regtests/ww3_tp2.15/input_rho/ww3_ounf.nml @@ -9,7 +9,7 @@ FIELD%TIMESTART = '20140309 000000' FIELD%TIMESTRIDE = '900.' FIELD%TIMECOUNT = '9999' - FIELD%LIST = 'HS WND RHO TAU T02 DP DIR FP MXE MXES MXH MXHC SDMH SDMHC' + FIELD%LIST = 'HS WND RHO TAU T02 DP DIR FP MXE MXES MXH MXHC SDMH SDMHC QP QKK' FIELD%PARTITION = '0 1 2' FIELD%TYPE = 4 / diff --git a/regtests/ww3_tp2.15/input_rho/ww3_outf.inp b/regtests/ww3_tp2.15/input_rho/ww3_outf.inp index 666f36966..05e04c291 100644 --- a/regtests/ww3_tp2.15/input_rho/ww3_outf.inp +++ b/regtests/ww3_tp2.15/input_rho/ww3_outf.inp @@ -3,7 +3,7 @@ $ ----------------------------------------- 20140309 000000 3600. 37 $ N -HS DIR DP T02 FP STMAXE STMAXD HMAXE HCMAXE HMAXD HCMAXD +HS DIR DP T02 FP STMAXE STMAXD HMAXE HCMAXE HMAXD HCMAXD QP QKK $ 3 0 1 43 1 42 1 1 diff --git a/regtests/ww3_tp2.15/input_rho/ww3_shel.inp b/regtests/ww3_tp2.15/input_rho/ww3_shel.inp index c436305e8..ce4d90011 100644 --- a/regtests/ww3_tp2.15/input_rho/ww3_shel.inp +++ b/regtests/ww3_tp2.15/input_rho/ww3_shel.inp @@ -31,7 +31,7 @@ $ A A W C C C C B B E B B X W O U S S S 2 S S $ W W A C F H M R R D B B Y O C S S S C S 1 2 $ --------------------------------------------------------------- N - HS WND RHO TAU T02 DP DIR FP MXE MXES MXH MXHC SDMH SDMHC + HS WND RHO TAU T02 DP DIR FP MXE MXES MXH MXHC SDMH SDMHC QP QKK 20140310 000000 3600 20140310 060000 12.5088 45.3138 'AA ' 0.0 0.0 'STOPSTRING' diff --git a/regtests/ww3_tp2.15/input_rho/ww3_shel.nml b/regtests/ww3_tp2.15/input_rho/ww3_shel.nml index 5fb0fd0a2..fc0277a12 100644 --- a/regtests/ww3_tp2.15/input_rho/ww3_shel.nml +++ b/regtests/ww3_tp2.15/input_rho/ww3_shel.nml @@ -24,7 +24,7 @@ ! Define the output types point parameters via OUTPUT_TYPE_NML namelist ! -------------------------------------------------------------------- ! &OUTPUT_TYPE_NML - TYPE%FIELD%LIST = 'HS WND RHO TAU T02 DP DIR FP MXE MXES MXH MXHC SDMH SDMHC' + TYPE%FIELD%LIST = 'HS WND RHO TAU T02 DP DIR FP MXE MXES MXH MXHC SDMH SDMHC QP QKK' TYPE%POINT%FILE = '../input_rho/points.list' / diff --git a/regtests/ww3_tp2.19/input_Case1A/switch_PDLIB b/regtests/ww3_tp2.19/input_Case1A/switch_PDLIB index 173947fdd..0ffd8565f 100644 --- a/regtests/ww3_tp2.19/input_Case1A/switch_PDLIB +++ b/regtests/ww3_tp2.19/input_Case1A/switch_PDLIB @@ -1 +1 @@ -F90 PDLIB METIS NOGRB NC4 DIST MPI PR3 UQ FLX0 LN0 ST0 NL0 BT0 DB1 TR1 BS0 IC0 IS0 REF0 XX0 WNT1 WNX1 CRT1 CRX1 SEC1 O0 O1 O2 O3 O4 O5 O6 O7 + PDLIB METIS NOGRB DIST MPI PR3 UQ FLX0 LN0 ST0 NL0 BT0 DB1 TR1 BS0 IC0 IS0 REF0 WNT1 WNX1 CRT1 CRX1 SEC1 O0 O1 O2 O3 O4 O5 O6 O7 diff --git a/regtests/ww3_tp2.19/input_Case1B/switch_PDLIB b/regtests/ww3_tp2.19/input_Case1B/switch_PDLIB index 173947fdd..0ffd8565f 100644 --- a/regtests/ww3_tp2.19/input_Case1B/switch_PDLIB +++ b/regtests/ww3_tp2.19/input_Case1B/switch_PDLIB @@ -1 +1 @@ -F90 PDLIB METIS NOGRB NC4 DIST MPI PR3 UQ FLX0 LN0 ST0 NL0 BT0 DB1 TR1 BS0 IC0 IS0 REF0 XX0 WNT1 WNX1 CRT1 CRX1 SEC1 O0 O1 O2 O3 O4 O5 O6 O7 + PDLIB METIS NOGRB DIST MPI PR3 UQ FLX0 LN0 ST0 NL0 BT0 DB1 TR1 BS0 IC0 IS0 REF0 WNT1 WNX1 CRT1 CRX1 SEC1 O0 O1 O2 O3 O4 O5 O6 O7 diff --git a/regtests/ww3_tp2.19/input_Case1C/switch_PDLIB b/regtests/ww3_tp2.19/input_Case1C/switch_PDLIB index ec5c35288..20fbedfed 100644 --- a/regtests/ww3_tp2.19/input_Case1C/switch_PDLIB +++ b/regtests/ww3_tp2.19/input_Case1C/switch_PDLIB @@ -1 +1 @@ -F90 PDLIB METIS NOGRB NC4 DIST MPI PR3 UQ FLX0 LN0 ST0 NL0 BT0 DB1 TR1 BS0 IC0 IS0 REF0 XX0 WNT1 WNX1 CRT1 CRX1 SEC1 O0 O1 O2 O3 O4 O5 O6 O7 + PDLIB METIS NOGRB DIST MPI PR3 UQ FLX0 LN0 ST0 NL0 BT0 DB1 TR1 BS0 IC0 IS0 REF0 WNT1 WNX1 CRT1 CRX1 SEC1 O0 O1 O2 O3 O4 O5 O6 O7 diff --git a/regtests/ww3_tp2.2/input/track_i.ww3 b/regtests/ww3_tp2.2/input/track_i.ww3 index ae2154a44..e4e7fbf61 100644 --- a/regtests/ww3_tp2.2/input/track_i.ww3 +++ b/regtests/ww3_tp2.2/input/track_i.ww3 @@ -1,6 +1,6 @@ WAVEWATCH III TRACK LOCATIONS DATA -19680606 000000 0 0 S1A -19680606 040000 1 0 S1B -19680606 060000 1 0 S1C -19680606 080000 2 0 S1D -19680606 120000 0.5 0 S1E +20220606 000000 0 0 S1A +20220606 040000 1 0 S1B +20220606 060000 1 0 S1C +20220606 080000 2 0 S1D +20220606 120000 0.5 0 S1E diff --git a/regtests/ww3_tp2.2/input/ww3_multi.inp b/regtests/ww3_tp2.2/input/ww3_multi.inp index 4d5d699e6..62f187b20 100644 --- a/regtests/ww3_tp2.2/input/ww3_multi.inp +++ b/regtests/ww3_tp2.2/input/ww3_multi.inp @@ -4,25 +4,25 @@ $ ------------------------------ $ 'ww3' 'no' 'no' 'no' 'no' 'no' 'no' 'no' 'no' 'no' 1 1 0.00 1.00 F $ - 19680606 000000 19680618 000000 + 20220606 000000 20220618 000000 $ T T $ - 19680606 000000 86400 19680618 000000 + 20220606 000000 86400 20220618 000000 $ N HS T0M1 DIR SPR $ - 19680606 000000 21600 19680618 000000 + 20220606 000000 21600 20220618 000000 0.0 0.0 'LEFT' 90.0 0.0 'CENTER' 180.0 0.0 'RIGHT' 0.0 0.0 'STOPSTRING' - 19680606 000000 3600 19680618 000000 + 20220606 000000 3600 20220618 000000 T - 19680612 000000 0 19680612 000000 - 19680606 000000 3600 19680618 000000 - 19680612 000000 0 19680612 000000 + 20220612 000000 0 20220612 000000 + 20220606 000000 3600 20220618 000000 + 20220612 000000 0 20220612 000000 $ 'the_end' 0 $ diff --git a/regtests/ww3_tp2.2/input/ww3_multi.nml b/regtests/ww3_tp2.2/input/ww3_multi.nml index 95c0f379c..6736ed229 100644 --- a/regtests/ww3_tp2.2/input/ww3_multi.nml +++ b/regtests/ww3_tp2.2/input/ww3_multi.nml @@ -9,7 +9,8 @@ &DOMAIN_NML DOMAIN%FLGHG1 = T DOMAIN%FLGHG2 = T - DOMAIN%STOP = '19680618 000000' + DOMAIN%START = '20220606 000000' + DOMAIN%STOP = '20220618 000000' / ! -------------------------------------------------------------------- ! @@ -37,10 +38,10 @@ ! Define output dates via OUTPUT_DATE_NML namelist ! -------------------------------------------------------------------- ! &OUTPUT_DATE_NML - ALLDATE%FIELD = '19680606 000000' '86400' '19680618 000000' - ALLDATE%POINT = '19680606 000000' '21600' '19680618 000000' - ALLDATE%TRACK = '19680606 000000' '3600' '19680618 000000' - ALLDATE%BOUNDARY = '19680606 000000' '3600' '19680618 000000' + ALLDATE%FIELD = '20220606 000000' '86400' '20220618 000000' + ALLDATE%POINT = '20220606 000000' '21600' '20220618 000000' + ALLDATE%TRACK = '20220606 000000' '3600' '20220618 000000' + ALLDATE%BOUNDARY = '20220606 000000' '3600' '20220618 000000' / ! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_tp2.2/input/ww3_ounf.inp b/regtests/ww3_tp2.2/input/ww3_ounf.inp index 1d901574c..120b78d3d 100644 --- a/regtests/ww3_tp2.2/input/ww3_ounf.inp +++ b/regtests/ww3_tp2.2/input/ww3_ounf.inp @@ -4,7 +4,7 @@ $--------------------------------------------------------------------- $ $ First output time (yyyymmdd hhmmss), increment of output (s), $ and number of output times. $ - 19680606 000000 10800. 100 + 20220606 000000 10800. 100 $ $ Fields requested --------------------------------------------------- $ $ diff --git a/regtests/ww3_tp2.2/input/ww3_ounf.nml b/regtests/ww3_tp2.2/input/ww3_ounf.nml index 44db63521..07dcdd2c2 100644 --- a/regtests/ww3_tp2.2/input/ww3_ounf.nml +++ b/regtests/ww3_tp2.2/input/ww3_ounf.nml @@ -6,7 +6,7 @@ ! Define the output fields to postprocess via FIELD_NML namelist ! -------------------------------------------------------------------- ! &FIELD_NML - FIELD%TIMESTART = '19680606 000000' + FIELD%TIMESTART = '20220606 000000' FIELD%TIMESTRIDE = '10800.' FIELD%TIMECOUNT = '100' FIELD%LIST = 'HS T01 DIR SPR' diff --git a/regtests/ww3_tp2.2/input/ww3_ounp.inp b/regtests/ww3_tp2.2/input/ww3_ounp.inp index 4816a3a7e..2c6a2f8d2 100644 --- a/regtests/ww3_tp2.2/input/ww3_ounp.inp +++ b/regtests/ww3_tp2.2/input/ww3_ounp.inp @@ -4,7 +4,7 @@ $--------------------------------------------------------------------- $ $ First output time (yyyymmdd hhmmss), increment of output (s), $ and number of output times. $ - 19680606 000000 21600. 1000 + 20220606 000000 21600. 1000 $ $ Points requested --------------------------------------------------- $ $ diff --git a/regtests/ww3_tp2.2/input/ww3_ounp.nml b/regtests/ww3_tp2.2/input/ww3_ounp.nml index 29fa1897d..e97fc6b22 100644 --- a/regtests/ww3_tp2.2/input/ww3_ounp.nml +++ b/regtests/ww3_tp2.2/input/ww3_ounp.nml @@ -6,7 +6,7 @@ ! Define the output fields to postprocess via POINT_NML namelist ! -------------------------------------------------------------------- ! &POINT_NML - POINT%TIMESTART = '19680606 000000' + POINT%TIMESTART = '20220606 000000' POINT%TIMESTRIDE = '21600.' POINT%TIMECOUNT = '1000' POINT%LIST = '1 2 3' diff --git a/regtests/ww3_tp2.2/input/ww3_outf.inp b/regtests/ww3_tp2.2/input/ww3_outf.inp index 4b062a870..d49b283c9 100644 --- a/regtests/ww3_tp2.2/input/ww3_outf.inp +++ b/regtests/ww3_tp2.2/input/ww3_outf.inp @@ -1,6 +1,6 @@ $ WAVEWATCH III Grid output post-processing $ ----------------------------------------- - 19680612 000000 518400. 2 + 20220612 000000 518400. 2 $ N HS T01 DIR SPR diff --git a/regtests/ww3_tp2.2/input/ww3_outp_spec.inp b/regtests/ww3_tp2.2/input/ww3_outp_spec.inp index d4c452b1f..cb7c2ba52 100644 --- a/regtests/ww3_tp2.2/input/ww3_outp_spec.inp +++ b/regtests/ww3_tp2.2/input/ww3_outp_spec.inp @@ -1,6 +1,6 @@ $ WAVEWATCH III Point output post-processing $ ------------------------------------------ - 19680606 000000 43200. 25 + 20220606 000000 43200. 25 $ 1 2 diff --git a/regtests/ww3_tp2.2/input/ww3_outp_tab51.inp b/regtests/ww3_tp2.2/input/ww3_outp_tab51.inp index d40f4a55d..9e4c288b6 100644 --- a/regtests/ww3_tp2.2/input/ww3_outp_tab51.inp +++ b/regtests/ww3_tp2.2/input/ww3_outp_tab51.inp @@ -1,6 +1,6 @@ $ WAVEWATCH III Point output post-processing $ ------------------------------------------ - 19680606 000000 43200. 25 + 20220606 000000 43200. 25 $ 1 -1 diff --git a/regtests/ww3_tp2.2/input/ww3_outp_tab52.inp b/regtests/ww3_tp2.2/input/ww3_outp_tab52.inp index 06431db5d..3ded7db46 100644 --- a/regtests/ww3_tp2.2/input/ww3_outp_tab52.inp +++ b/regtests/ww3_tp2.2/input/ww3_outp_tab52.inp @@ -1,6 +1,6 @@ $ WAVEWATCH III Point output post-processing $ ------------------------------------------ - 19680606 000000 43200. 25 + 20220606 000000 43200. 25 $ 2 -1 diff --git a/regtests/ww3_tp2.2/input/ww3_outp_tab53.inp b/regtests/ww3_tp2.2/input/ww3_outp_tab53.inp index 209a605b0..0e57f1322 100644 --- a/regtests/ww3_tp2.2/input/ww3_outp_tab53.inp +++ b/regtests/ww3_tp2.2/input/ww3_outp_tab53.inp @@ -1,6 +1,6 @@ $ WAVEWATCH III Point output post-processing $ ------------------------------------------ - 19680606 000000 43200. 25 + 20220606 000000 43200. 25 $ 3 -1 diff --git a/regtests/ww3_tp2.2/input/ww3_shel.inp b/regtests/ww3_tp2.2/input/ww3_shel.inp index aba7af3e4..37d914fad 100644 --- a/regtests/ww3_tp2.2/input/ww3_shel.inp +++ b/regtests/ww3_tp2.2/input/ww3_shel.inp @@ -10,31 +10,31 @@ $ ------------------------------ F F $ - 19680606 000000 - 19680606 120000 + 20220606 000000 + 20220606 120000 $ 1 $ - 19680606 000000 10800 19680608 000000 + 20220606 000000 10800 20220608 000000 $ N HS EF T01 DIR SPR $ - 19680606 000000 21600 19680608 000000 + 20220606 000000 21600 20220608 000000 0.0 0.0 'LEFT' 90.0 0.0 'CENTER' 180.0 0.0 'RIGHT' 0.0 0.0 'STOPSTRING' - 19680606 000000 14400 19680608 000000 + 20220606 000000 14400 20220608 000000 T - 19680606 000000 0 19680608 000000 - 19680606 000000 0 19680608 000000 - 19680606 000000 0 19680608 000000 + 20220606 000000 0 20220608 000000 + 20220606 000000 0 20220608 000000 + 20220606 000000 0 20220608 000000 $ - 'CUR' 19680606 030000 2.0 45. - 'WND' 19680606 000000 20.0 180. 2. - 'WND' 19680606 040000 15.0 130. 1. - 'WND' 19680606 080000 25.0 90. 3. + 'CUR' 20220606 030000 2.0 45. + 'WND' 20220606 000000 20.0 180. 2. + 'WND' 20220606 040000 15.0 130. 1. + 'WND' 20220606 080000 25.0 90. 3. 'STP' $ $ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.2/input/ww3_shel.nml b/regtests/ww3_tp2.2/input/ww3_shel.nml index 578f05f93..32205bc57 100644 --- a/regtests/ww3_tp2.2/input/ww3_shel.nml +++ b/regtests/ww3_tp2.2/input/ww3_shel.nml @@ -7,7 +7,8 @@ ! Define top-level model parameters via DOMAIN_NML namelist ! -------------------------------------------------------------------- ! &DOMAIN_NML - DOMAIN%STOP = '19680606 120000' + DOMAIN%START = '20220606 000000' + DOMAIN%STOP = '20220606 120000' / ! -------------------------------------------------------------------- ! @@ -30,9 +31,9 @@ ! Define output dates via OUTPUT_DATE_NML namelist ! -------------------------------------------------------------------- ! &OUTPUT_DATE_NML - DATE%FIELD = '19680606 000000' '10800' '19680608 000000' - DATE%POINT = '19680606 000000' '21600' '19680608 000000' - DATE%TRACK = '19680606 000000' '14400' '19680608 000000' + DATE%FIELD = '20220606 000000' '10800' '20220608 000000' + DATE%POINT = '20220606 000000' '21600' '20220608 000000' + DATE%TRACK = '20220606 000000' '14400' '20220608 000000' / ! -------------------------------------------------------------------- ! @@ -45,23 +46,24 @@ &HOMOG_INPUT_NML HOMOG_INPUT(1)%NAME = 'CUR' - HOMOG_INPUT(1)%DATE = '19680606 030000' + HOMOG_INPUT(1)%DATE = '20220606 030000' HOMOG_INPUT(1)%VALUE1 = 2.0 HOMOG_INPUT(1)%VALUE2 = 45. HOMOG_INPUT(2)%NAME = 'WND' + HOMOG_INPUT(2)%DATE = '20220606 000000' HOMOG_INPUT(2)%VALUE1 = 20.0 HOMOG_INPUT(2)%VALUE2 = 180. HOMOG_INPUT(2)%VALUE3 = 2. HOMOG_INPUT(3)%NAME = 'WND' - HOMOG_INPUT(3)%DATE = '19680606 040000' + HOMOG_INPUT(3)%DATE = '20220606 040000' HOMOG_INPUT(3)%VALUE1 = 15.0 HOMOG_INPUT(3)%VALUE2 = 130. HOMOG_INPUT(3)%VALUE3 = 1. HOMOG_INPUT(4)%NAME = 'WND' - HOMOG_INPUT(4)%DATE = '19680606 080000' + HOMOG_INPUT(4)%DATE = '20220606 080000' HOMOG_INPUT(4)%VALUE1 = 25.0 HOMOG_INPUT(4)%VALUE2 = 90. HOMOG_INPUT(4)%VALUE3 = 3. diff --git a/regtests/ww3_tp2.2/input/ww3_trnc.inp b/regtests/ww3_tp2.2/input/ww3_trnc.inp index df60800b8..ddfd4f403 100755 --- a/regtests/ww3_tp2.2/input/ww3_trnc.inp +++ b/regtests/ww3_tp2.2/input/ww3_trnc.inp @@ -4,7 +4,7 @@ $--------------------------------------------------------------------- $ $ First output time (yyyymmdd hhmmss), increment of output (s), $ and number of output times. $ - 19680606 000000 3600. 100000 + 20220606 000000 3600. 100000 $ $ Output type -------------------------------------------------------- $ $ netCDF version [3,4] diff --git a/regtests/ww3_tp2.2/input/ww3_trnc.nml b/regtests/ww3_tp2.2/input/ww3_trnc.nml index e4ae8ceab..e6847f529 100644 --- a/regtests/ww3_tp2.2/input/ww3_trnc.nml +++ b/regtests/ww3_tp2.2/input/ww3_trnc.nml @@ -6,7 +6,7 @@ ! Define the output fields to postprocess via TRACK_NML namelist ! -------------------------------------------------------------------- ! &TRACK_NML - TRACK%TIMESTART = '19680606 000000' + TRACK%TIMESTART = '20220606 000000' TRACK%TIMESTRIDE = '3600.' / diff --git a/regtests/ww3_tp2.3/input/namelists_GARDEN.nml b/regtests/ww3_tp2.3/input/namelists_GARDEN.nml index 04b929ca1..b8533ddda 100644 --- a/regtests/ww3_tp2.3/input/namelists_GARDEN.nml +++ b/regtests/ww3_tp2.3/input/namelists_GARDEN.nml @@ -1,4 +1,4 @@ -&OUTS E3D=1 / +&OUTS E3D=1, TH1MF=1, STH1MF=1 / &PRO2 DTIME=345600. / &PRO3 WDTHTH=1.50, WDTHCG=1.50 / END OF NAMELISTS diff --git a/regtests/ww3_tp2.3/input/ww3_grid.inp b/regtests/ww3_tp2.3/input/ww3_grid.inp index 9be443dbb..3a4271307 100644 --- a/regtests/ww3_tp2.3/input/ww3_grid.inp +++ b/regtests/ww3_tp2.3/input/ww3_grid.inp @@ -16,7 +16,7 @@ $ $ $ Activated up to one line per namelist !! $ - &OUTS E3D=1 / + &OUTS E3D=1, TH1MF=1, STH1MF=1 / $ &PRO2 DTIME= 0. / $ &PRO2 DTIME=172800. / &PRO2 DTIME=345600. / diff --git a/regtests/ww3_tp2.6/input/switch_ST4_ASCII b/regtests/ww3_tp2.6/input/switch_ST4_ASCII new file mode 100644 index 000000000..db1b70b66 --- /dev/null +++ b/regtests/ww3_tp2.6/input/switch_ST4_ASCII @@ -0,0 +1 @@ +ASCII NOGRB SHRD PR3 UQ FLX0 LN0 ST4 NL1 BT1 DB1 MLIM TR0 BS0 IC0 IS0 REF0 WNT1 WNX1 CRT1 CRX1 O0 O1 O2 O3 O4 O5 O6 O7 O10 O11 diff --git a/regtests/ww3_tp2.6/input/ww3_ounf.inp b/regtests/ww3_tp2.6/input/ww3_ounf.inp index c4d51a66c..d2bde30b6 100644 --- a/regtests/ww3_tp2.6/input/ww3_ounf.inp +++ b/regtests/ww3_tp2.6/input/ww3_ounf.inp @@ -13,7 +13,7 @@ $ file for a full documentation of field output options. Namelist type $ selection is used here (for alternative F/T flags, see ww3_shel.inp). $ N - HS LM T02 T01 T0M1 UST CHA CGE DTD FC CFX CFD + HS LM T02 T01 T0M1 UST CHA CGE DTD FC CFX CFD QP QKK $ $--------------------------------------------------------------------- $ $ netCDF version [3,4] diff --git a/regtests/ww3_tp2.6/input/ww3_ounf.nml b/regtests/ww3_tp2.6/input/ww3_ounf.nml index 658dd2525..7b344cc1c 100644 --- a/regtests/ww3_tp2.6/input/ww3_ounf.nml +++ b/regtests/ww3_tp2.6/input/ww3_ounf.nml @@ -9,7 +9,7 @@ FIELD%TIMESTART = '20100801 000000' FIELD%TIMESTRIDE = '10' FIELD%TIMECOUNT = '3600' - FIELD%LIST = 'HS LM T02 T01 T0M1 UST CHA CGE DTD FC CFX CFD' + FIELD%LIST = 'HS LM T02 T01 T0M1 UST CHA CGE DTD FC CFX CFD QP QKK' FIELD%PARTITION = '0 1 2' FIELD%SAMEFILE = F FIELD%TYPE = 4 diff --git a/regtests/ww3_tp2.6/input/ww3_outf.inp b/regtests/ww3_tp2.6/input/ww3_outf.inp index 70dc9974c..86c1115ff 100644 --- a/regtests/ww3_tp2.6/input/ww3_outf.inp +++ b/regtests/ww3_tp2.6/input/ww3_outf.inp @@ -7,7 +7,7 @@ $ $ $ Request flags identifying fields as in ww3_shel input and section 2.4 fo the manual. N -HS LM T02 T01 T0M1 UST CHA CGE DTD FC CFX CFD +HS LM T02 T01 T0M1 UST CHA CGE DTD FC CFX CFD QP QKK $ $ Output type ITYPE [0,1,2,3] $ diff --git a/regtests/ww3_tp2.6/input/ww3_shel.inp b/regtests/ww3_tp2.6/input/ww3_shel.inp index ecdf1bc3a..2bd59dc2c 100644 --- a/regtests/ww3_tp2.6/input/ww3_shel.inp +++ b/regtests/ww3_tp2.6/input/ww3_shel.inp @@ -60,7 +60,7 @@ $ Output request flags identifying fields as in ww3_shel input and $ section 2.4 of the manual. $ N -HS LM T02 T01 T0M1 UST CHA CGE DTD FC CFX CFD +HS LM T02 T01 T0M1 UST CHA CGE DTD FC CFX CFD QP QKK $ $---------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.6/input/ww3_shel.nml b/regtests/ww3_tp2.6/input/ww3_shel.nml index f27f0b161..3518049f2 100644 --- a/regtests/ww3_tp2.6/input/ww3_shel.nml +++ b/regtests/ww3_tp2.6/input/ww3_shel.nml @@ -22,7 +22,7 @@ ! Define the output types point parameters via OUTPUT_TYPE_NML namelist ! -------------------------------------------------------------------- ! &OUTPUT_TYPE_NML - TYPE%FIELD%LIST = 'HS LM T02 T01 T0M1 UST CHA CGE DTD FC CFX CFD' + TYPE%FIELD%LIST = 'HS LM T02 T01 T0M1 UST CHA CGE DTD FC CFX CFD QP QKK' TYPE%POINT%FILE = '../input/points.list' / diff --git a/regtests/ww3_ts1/input/namelists_ST4_T475.nml b/regtests/ww3_ts1/input/namelists_ST4_T475.nml new file mode 100644 index 000000000..e104247aa --- /dev/null +++ b/regtests/ww3_ts1/input/namelists_ST4_T475.nml @@ -0,0 +1,7 @@ +&SIN4 BETAMAX = 1.75, SWELLF = 0.66, TAUWSHELTER = 0.3, + SWELLF3 = 0.022, SWELLF4 = 115000.0, SWELLF7 = 432000.00 / +&SDS4 FXFM3 = 2.5 / +&SIC2 IC2ROUGH = 0.001000, IC2VISC = 2.000, IC2DMAX =0.300 / +&SIS2 ISC1 =0.200E+00, IS2BREAK = T, IS2DUPDATE = F, IS2CREEPB = 0.200E+08 / + +END OF NAMELISTS diff --git a/regtests/ww3_ts1/input/namelists_ST4_T700.nml b/regtests/ww3_ts1/input/namelists_ST4_T700.nml index aa6ecdf70..b47cc70d0 100644 --- a/regtests/ww3_ts1/input/namelists_ST4_T700.nml +++ b/regtests/ww3_ts1/input/namelists_ST4_T700.nml @@ -1,4 +1,4 @@ &SDS4 SDSBCHOICE=3, SDSC2 = -3.8, SDSBR = 0.005, - SDSSTRAIN =0., SDSSTRAIN2 = 0., FXFM3 = 20., SDSFACMTF = 400., + FXFM3 = 20., SDSFACMTF = 400., SDSCUM=0., SDSC5 =0. / END OF NAMELISTS diff --git a/regtests/ww3_ts1/input/namelists_ST4_T702.nml b/regtests/ww3_ts1/input/namelists_ST4_T702.nml new file mode 100644 index 000000000..444c02e29 --- /dev/null +++ b/regtests/ww3_ts1/input/namelists_ST4_T702.nml @@ -0,0 +1,12 @@ +&SIN4 BETAMAX = 1.7, SWELLF = 0.60, TAUWSHELTER = 0.2, + SWELLF3 = 0.022, SWELLF4 = 115000.0, SWELLF7 = 432000.00 / +&SDS4 SDSBCHOICE = 3, SDSC2 = -3.80, FXFM3 = 20.00, + SDSBR = 0.005, SDSBT = 0.0011, SDSCUM = 0.300, SDSC5 = 1.0, + SDSMWD = 0.00, SDSFACMTF = 400 / +&SNL1 NLPROP = 25000000.0 / +&SIC2 IC2ROUGH = 0.001000, IC2VISC = 2.000, IC2DMAX =0.300 / +&SIS2 ISC1 =0.200E+00, IS2BREAK = T, IS2DUPDATE = F, IS2CREEPB = 0.200E+08 / +&MISC ICEHINIT = 0.5, ICEHMIN = 0.1, CICE0 = 0.25, NOSW =6, + CICEN = 2.00, LICE = 40000., FLAGTR = 4, FACBERG = 0.2 , + WCOR1=21., WCOR2=0.5 / +END OF NAMELISTS diff --git a/regtests/ww3_ts1/input/namelists_ST4_T707.nml b/regtests/ww3_ts1/input/namelists_ST4_T707.nml new file mode 100644 index 000000000..16f81517d --- /dev/null +++ b/regtests/ww3_ts1/input/namelists_ST4_T707.nml @@ -0,0 +1,13 @@ + &SNL1 IQTYPE = -2, GQMNF1 = 11, GQMNT1 = 6, GQMNQ_OM2 = 6, + TAILNL=-5.0, GQMTHRSAT=5E-5, GQMTHRCOU = 0.05, GQAMP1=1., + GQAMP2=0.0022, GQAMP3=1., GQAMP4=1.0 / + &SIN4 BETAMAX = 1.6, TAUWSHELTER = 0.0 / + &SDS4 SDSBCHOICE=3, SDSC2 = -2.3, SDSBR = 0.005, + FXFM3 = 20, SDSFACMTF = 400., + SDSMWD = 2., SDSCUM = 0.35, SDSNUW =0, SDSC5=1., SDSBRF1=0.5 / +&SIC2 IC2ROUGH = 0.001000, IC2VISC = 2.000, IC2DMAX =0.300 / +&SIS2 ISC1 =0.200E+00, IS2BREAK = T, IS2DUPDATE = F, IS2CREEPB = 0.200E+08 / +&MISC ICEHINIT = 0.5, ICEHMIN = 0.1, CICE0 = 0.25, NOSW =6, + CICEN = 2.00, LICE = 40000., FLAGTR = 4, FACBERG = 0.2 , + WCOR1=21., WCOR2=0.5 / +END OF NAMELISTS diff --git a/regtests/ww3_ts1/input/ww3_grid_ST4_T475.nml b/regtests/ww3_ts1/input/ww3_grid_ST4_T475.nml new file mode 100644 index 000000000..7987e9528 --- /dev/null +++ b/regtests/ww3_ts1/input/ww3_grid_ST4_T475.nml @@ -0,0 +1,225 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_grid.nml - Grid pre-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the spectrum parameterization via SPECTRUM_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! SPECTRUM%XFR = 0. ! frequency increment +! SPECTRUM%FREQ1 = 0. ! first frequency (Hz) +! SPECTRUM%NK = 0 ! number of frequencies (wavenumbers) +! SPECTRUM%NTH = 0 ! number of direction bins +! SPECTRUM%THOFF = 0. ! relative offset of first direction [-0.5,0.5] +! -------------------------------------------------------------------- ! +&SPECTRUM_NML + SPECTRUM%XFR = 1.10 + SPECTRUM%FREQ1 = 0.0485 + SPECTRUM%NK = 36 + SPECTRUM%NTH = 24 +/ + +! -------------------------------------------------------------------- ! +! Define the run parameterization via RUN_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! RUN%FLDRY = F ! dry run (I/O only, no calculation) +! RUN%FLCX = F ! x-component of propagation +! RUN%FLCY = F ! y-component of propagation +! RUN%FLCTH = F ! direction shift +! RUN%FLCK = F ! wavenumber shift +! RUN%FLSOU = F ! source terms +! -------------------------------------------------------------------- ! +&RUN_NML + RUN%FLSOU = T +/ + +! -------------------------------------------------------------------- ! +! Define the timesteps parameterization via TIMESTEPS_NML namelist +! +! * It is highly recommended to set up time steps which are multiple +! between them. +! +! * The first time step to calculate is the maximum CFL time step +! which depend on the lowest frequency FREQ1 previously set up and the +! lowest spatial grid resolution in meters DXY. +! reminder : 1 degree=60minutes // 1minute=1mile // 1mile=1.852km +! The formula for the CFL time is : +! Tcfl = DXY / (G / (FREQ1*4*Pi) ) with the constants Pi=3,14 and G=9.8m/s²; +! DTXY ~= 90% Tcfl +! DTMAX ~= 3 * DTXY (maximum global time step limit) +! +! * The refraction time step depends on how strong can be the current velocities +! on your grid : +! DTKTH ~= DTMAX / 2 ! in case of no or light current velocities +! DTKTH ~= DTMAX / 10 ! in case of strong current velocities +! +! * The source terms time step is usually defined between 5s and 60s. +! A common value is 10s. +! DTMIN ~= 10 +! +! * namelist must be terminated with / +! * definitions & defaults: +! TIMESTEPS%DTMAX = 0. ! maximum global time step (s) +! TIMESTEPS%DTXY = 0. ! maximum CFL time step for x-y (s) +! TIMESTEPS%DTKTH = 0. ! maximum CFL time step for k-th (s) +! TIMESTEPS%DTMIN = 0. ! minimum source term time step (s) +! -------------------------------------------------------------------- ! +&TIMESTEPS_NML + TIMESTEPS%DTMAX = 900. + TIMESTEPS%DTXY = 900. + TIMESTEPS%DTKTH = 900. + TIMESTEPS%DTMIN = 15. +/ + +! -------------------------------------------------------------------- ! +! Define the grid to preprocess via GRID_NML namelist +! +! * the tunable parameters for source terms, propagation schemes, and +! numerics are read using namelists. +! * Any namelist found in the folowing sections is temporarily written +! to param.scratch, and read from there if necessary. +! * The order of the namelists is immaterial. +! * Namelists not needed for the given switch settings will be skipped +! automatically +! +! * grid type can be : +! 'RECT' : rectilinear +! 'CURV' : curvilinear +! 'UNST' : unstructured (triangle-based) +! +! * coordinate system can be : +! 'SPHE' : Spherical (degrees) +! 'CART' : Cartesian (meters) +! +! * grid closure can only be applied in spherical coordinates +! +! * grid closure can be : +! 'NONE' : No closure is applied +! 'SMPL' : Simple grid closure. Grid is periodic in the +! : i-index and wraps at i=NX+1. In other words, +! : (NX+1,J) => (1,J). A grid with simple closure +! : may be rectilinear or curvilinear. +! 'TRPL' : Tripole grid closure : Grid is periodic in the +! : i-index and wraps at i=NX+1 and has closure at +! : j=NY+1. In other words, (NX+1,J<=NY) => (1,J) +! : and (I,NY+1) => (NX-I+1,NY). Tripole +! : grid closure requires that NX be even. A grid +! : with tripole closure must be curvilinear. +! +! * The coastline limit depth is the value which distinguish the sea +! points to the land points. All the points with depth values (ZBIN) +! greater than this limit (ZLIM) will be considered as excluded points +! and will never be wet points, even if the water level grows over. +! It can only overwrite the status of a sea point to a land point. +! The value must have a negative value under the mean sea level +! +! * The minimum water depth allowed to compute the model is the absolute +! depth value (DMIN) used in the model if the input depth is lower to +! avoid the model to blow up. +! +! * namelist must be terminated with / +! * definitions & defaults: +! GRID%NAME = 'unset' ! grid name (30 char) +! GRID%NML = 'namelists.nml' ! namelists filename +! GRID%TYPE = 'unset' ! grid type +! GRID%COORD = 'unset' ! coordinate system +! GRID%CLOS = 'unset' ! grid closure +! +! GRID%ZLIM = 0. ! coastline limit depth (m) +! GRID%DMIN = 0. ! abs. minimum water depth (m) +! -------------------------------------------------------------------- ! +&GRID_NML + GRID%NAME = 'HOMOGENEOUS SOURCE TERM TEST' + GRID%NML = '../input/namelists_ST4_T475.nml' + GRID%TYPE = 'RECT' + GRID%COORD = 'SPHE' + GRID%CLOS = 'NONE' + GRID%ZLIM = -5. + GRID%DMIN = 5.75 +/ + +! -------------------------------------------------------------------- ! +! Define the rectilinear grid type via RECT_NML namelist +! - only for RECT grids - +! +! * The minimum grid size is 3x3. +! +! * If the grid increments SX and SY are given in minutes of arc, the scaling +! factor SF must be set to 60. to provide an increment factor in degree. +! +! * If CSTRG='SMPL', then SX is forced to 360/NX. +! +! * value <= value_read / scale_fac +! +! * namelist must be terminated with / +! * definitions & defaults: +! RECT%NX = 0 ! number of points along x-axis +! RECT%NY = 0 ! number of points along y-axis +! +! RECT%SX = 0. ! grid increment along x-axis +! RECT%SY = 0. ! grid increment along y-axis +! RECT%SF = 1. ! scaling division factor for x-y axis +! +! RECT%X0 = 0. ! x-coordinate of lower-left corner (deg) +! RECT%Y0 = 0. ! y-coordinate of lower-left corner (deg) +! RECT%SF0 = 1. ! scaling division factor for x0,y0 coord +! -------------------------------------------------------------------- ! +&RECT_NML + RECT%NX = 3 + RECT%NY = 3 + RECT%SX = 1. + RECT%SY = 1. + RECT%SF = 1.E-2 + RECT%X0 = -1. + RECT%Y0 = -1. + RECT%SF0 = 1.E-2 +/ + +! -------------------------------------------------------------------- ! +! Define the depth to preprocess via DEPTH_NML namelist +! - for RECT and CURV grids - +! +! * if no obstruction subgrid, need to set &MISC FLAGTR = 0 +! +! * The depth value must have negative values under the mean sea level +! +! * value <= value_read * scale_fac +! +! * IDLA : Layout indicator : +! 1 : Read line-by-line bottom to top. (default) +! 2 : Like 1, single read statement. +! 3 : Read line-by-line top to bottom. +! 4 : Like 3, single read statement. +! * IDFM : format indicator : +! 1 : Free format. (default) +! 2 : Fixed format. +! 3 : Unformatted. +! * FORMAT : element format to read : +! '(....)' : auto detected (default) +! '(f10.6)' : float type +! +! * Example : +! IDF SF IDLA IDFM FORMAT FILENAME +! 50 0.001 1 1 '(....)' 'GLOB-30M.bot' +! +! * namelist must be terminated with / +! * definitions & defaults: +! DEPTH%SF = 1. ! scale factor +! DEPTH%FILENAME = 'unset' ! filename +! DEPTH%IDF = 50 ! file unit number +! DEPTH%IDLA = 1 ! layout indicator +! DEPTH%IDFM = 1 ! format indicator +! DEPTH%FORMAT = '(....)' ! formatted read format +! -------------------------------------------------------------------- ! +&DEPTH_NML + DEPTH%SF = -2500. + DEPTH%FILENAME = '../input/HOMOGENEOUS.depth' + DEPTH%IDLA = 3 +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ts1/input/ww3_grid_ST4_T702.nml b/regtests/ww3_ts1/input/ww3_grid_ST4_T702.nml new file mode 100644 index 000000000..48135e1d9 --- /dev/null +++ b/regtests/ww3_ts1/input/ww3_grid_ST4_T702.nml @@ -0,0 +1,225 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_grid.nml - Grid pre-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the spectrum parameterization via SPECTRUM_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! SPECTRUM%XFR = 0. ! frequency increment +! SPECTRUM%FREQ1 = 0. ! first frequency (Hz) +! SPECTRUM%NK = 0 ! number of frequencies (wavenumbers) +! SPECTRUM%NTH = 0 ! number of direction bins +! SPECTRUM%THOFF = 0. ! relative offset of first direction [-0.5,0.5] +! -------------------------------------------------------------------- ! +&SPECTRUM_NML + SPECTRUM%XFR = 1.10 + SPECTRUM%FREQ1 = 0.0485 + SPECTRUM%NK = 36 + SPECTRUM%NTH = 24 +/ + +! -------------------------------------------------------------------- ! +! Define the run parameterization via RUN_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! RUN%FLDRY = F ! dry run (I/O only, no calculation) +! RUN%FLCX = F ! x-component of propagation +! RUN%FLCY = F ! y-component of propagation +! RUN%FLCTH = F ! direction shift +! RUN%FLCK = F ! wavenumber shift +! RUN%FLSOU = F ! source terms +! -------------------------------------------------------------------- ! +&RUN_NML + RUN%FLSOU = T +/ + +! -------------------------------------------------------------------- ! +! Define the timesteps parameterization via TIMESTEPS_NML namelist +! +! * It is highly recommended to set up time steps which are multiple +! between them. +! +! * The first time step to calculate is the maximum CFL time step +! which depend on the lowest frequency FREQ1 previously set up and the +! lowest spatial grid resolution in meters DXY. +! reminder : 1 degree=60minutes // 1minute=1mile // 1mile=1.852km +! The formula for the CFL time is : +! Tcfl = DXY / (G / (FREQ1*4*Pi) ) with the constants Pi=3,14 and G=9.8m/s²; +! DTXY ~= 90% Tcfl +! DTMAX ~= 3 * DTXY (maximum global time step limit) +! +! * The refraction time step depends on how strong can be the current velocities +! on your grid : +! DTKTH ~= DTMAX / 2 ! in case of no or light current velocities +! DTKTH ~= DTMAX / 10 ! in case of strong current velocities +! +! * The source terms time step is usually defined between 5s and 60s. +! A common value is 10s. +! DTMIN ~= 10 +! +! * namelist must be terminated with / +! * definitions & defaults: +! TIMESTEPS%DTMAX = 0. ! maximum global time step (s) +! TIMESTEPS%DTXY = 0. ! maximum CFL time step for x-y (s) +! TIMESTEPS%DTKTH = 0. ! maximum CFL time step for k-th (s) +! TIMESTEPS%DTMIN = 0. ! minimum source term time step (s) +! -------------------------------------------------------------------- ! +&TIMESTEPS_NML + TIMESTEPS%DTMAX = 900. + TIMESTEPS%DTXY = 900. + TIMESTEPS%DTKTH = 900. + TIMESTEPS%DTMIN = 15. +/ + +! -------------------------------------------------------------------- ! +! Define the grid to preprocess via GRID_NML namelist +! +! * the tunable parameters for source terms, propagation schemes, and +! numerics are read using namelists. +! * Any namelist found in the folowing sections is temporarily written +! to param.scratch, and read from there if necessary. +! * The order of the namelists is immaterial. +! * Namelists not needed for the given switch settings will be skipped +! automatically +! +! * grid type can be : +! 'RECT' : rectilinear +! 'CURV' : curvilinear +! 'UNST' : unstructured (triangle-based) +! +! * coordinate system can be : +! 'SPHE' : Spherical (degrees) +! 'CART' : Cartesian (meters) +! +! * grid closure can only be applied in spherical coordinates +! +! * grid closure can be : +! 'NONE' : No closure is applied +! 'SMPL' : Simple grid closure. Grid is periodic in the +! : i-index and wraps at i=NX+1. In other words, +! : (NX+1,J) => (1,J). A grid with simple closure +! : may be rectilinear or curvilinear. +! 'TRPL' : Tripole grid closure : Grid is periodic in the +! : i-index and wraps at i=NX+1 and has closure at +! : j=NY+1. In other words, (NX+1,J<=NY) => (1,J) +! : and (I,NY+1) => (NX-I+1,NY). Tripole +! : grid closure requires that NX be even. A grid +! : with tripole closure must be curvilinear. +! +! * The coastline limit depth is the value which distinguish the sea +! points to the land points. All the points with depth values (ZBIN) +! greater than this limit (ZLIM) will be considered as excluded points +! and will never be wet points, even if the water level grows over. +! It can only overwrite the status of a sea point to a land point. +! The value must have a negative value under the mean sea level +! +! * The minimum water depth allowed to compute the model is the absolute +! depth value (DMIN) used in the model if the input depth is lower to +! avoid the model to blow up. +! +! * namelist must be terminated with / +! * definitions & defaults: +! GRID%NAME = 'unset' ! grid name (30 char) +! GRID%NML = 'namelists.nml' ! namelists filename +! GRID%TYPE = 'unset' ! grid type +! GRID%COORD = 'unset' ! coordinate system +! GRID%CLOS = 'unset' ! grid closure +! +! GRID%ZLIM = 0. ! coastline limit depth (m) +! GRID%DMIN = 0. ! abs. minimum water depth (m) +! -------------------------------------------------------------------- ! +&GRID_NML + GRID%NAME = 'HOMOGENEOUS SOURCE TERM TEST' + GRID%NML = '../input/namelists_ST4_T702.nml' + GRID%TYPE = 'RECT' + GRID%COORD = 'SPHE' + GRID%CLOS = 'NONE' + GRID%ZLIM = -5. + GRID%DMIN = 5.75 +/ + +! -------------------------------------------------------------------- ! +! Define the rectilinear grid type via RECT_NML namelist +! - only for RECT grids - +! +! * The minimum grid size is 3x3. +! +! * If the grid increments SX and SY are given in minutes of arc, the scaling +! factor SF must be set to 60. to provide an increment factor in degree. +! +! * If CSTRG='SMPL', then SX is forced to 360/NX. +! +! * value <= value_read / scale_fac +! +! * namelist must be terminated with / +! * definitions & defaults: +! RECT%NX = 0 ! number of points along x-axis +! RECT%NY = 0 ! number of points along y-axis +! +! RECT%SX = 0. ! grid increment along x-axis +! RECT%SY = 0. ! grid increment along y-axis +! RECT%SF = 1. ! scaling division factor for x-y axis +! +! RECT%X0 = 0. ! x-coordinate of lower-left corner (deg) +! RECT%Y0 = 0. ! y-coordinate of lower-left corner (deg) +! RECT%SF0 = 1. ! scaling division factor for x0,y0 coord +! -------------------------------------------------------------------- ! +&RECT_NML + RECT%NX = 3 + RECT%NY = 3 + RECT%SX = 1. + RECT%SY = 1. + RECT%SF = 1.E-2 + RECT%X0 = -1. + RECT%Y0 = -1. + RECT%SF0 = 1.E-2 +/ + +! -------------------------------------------------------------------- ! +! Define the depth to preprocess via DEPTH_NML namelist +! - for RECT and CURV grids - +! +! * if no obstruction subgrid, need to set &MISC FLAGTR = 0 +! +! * The depth value must have negative values under the mean sea level +! +! * value <= value_read * scale_fac +! +! * IDLA : Layout indicator : +! 1 : Read line-by-line bottom to top. (default) +! 2 : Like 1, single read statement. +! 3 : Read line-by-line top to bottom. +! 4 : Like 3, single read statement. +! * IDFM : format indicator : +! 1 : Free format. (default) +! 2 : Fixed format. +! 3 : Unformatted. +! * FORMAT : element format to read : +! '(....)' : auto detected (default) +! '(f10.6)' : float type +! +! * Example : +! IDF SF IDLA IDFM FORMAT FILENAME +! 50 0.001 1 1 '(....)' 'GLOB-30M.bot' +! +! * namelist must be terminated with / +! * definitions & defaults: +! DEPTH%SF = 1. ! scale factor +! DEPTH%FILENAME = 'unset' ! filename +! DEPTH%IDF = 50 ! file unit number +! DEPTH%IDLA = 1 ! layout indicator +! DEPTH%IDFM = 1 ! format indicator +! DEPTH%FORMAT = '(....)' ! formatted read format +! -------------------------------------------------------------------- ! +&DEPTH_NML + DEPTH%SF = -2500. + DEPTH%FILENAME = '../input/HOMOGENEOUS.depth' + DEPTH%IDLA = 3 +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ts1/input/ww3_grid_ST4_T707.nml b/regtests/ww3_ts1/input/ww3_grid_ST4_T707.nml new file mode 100644 index 000000000..e6ef84a56 --- /dev/null +++ b/regtests/ww3_ts1/input/ww3_grid_ST4_T707.nml @@ -0,0 +1,225 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_grid.nml - Grid pre-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the spectrum parameterization via SPECTRUM_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! SPECTRUM%XFR = 0. ! frequency increment +! SPECTRUM%FREQ1 = 0. ! first frequency (Hz) +! SPECTRUM%NK = 0 ! number of frequencies (wavenumbers) +! SPECTRUM%NTH = 0 ! number of direction bins +! SPECTRUM%THOFF = 0. ! relative offset of first direction [-0.5,0.5] +! -------------------------------------------------------------------- ! +&SPECTRUM_NML + SPECTRUM%XFR = 1.10 + SPECTRUM%FREQ1 = 0.0485 + SPECTRUM%NK = 36 + SPECTRUM%NTH = 24 +/ + +! -------------------------------------------------------------------- ! +! Define the run parameterization via RUN_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! RUN%FLDRY = F ! dry run (I/O only, no calculation) +! RUN%FLCX = F ! x-component of propagation +! RUN%FLCY = F ! y-component of propagation +! RUN%FLCTH = F ! direction shift +! RUN%FLCK = F ! wavenumber shift +! RUN%FLSOU = F ! source terms +! -------------------------------------------------------------------- ! +&RUN_NML + RUN%FLSOU = T +/ + +! -------------------------------------------------------------------- ! +! Define the timesteps parameterization via TIMESTEPS_NML namelist +! +! * It is highly recommended to set up time steps which are multiple +! between them. +! +! * The first time step to calculate is the maximum CFL time step +! which depend on the lowest frequency FREQ1 previously set up and the +! lowest spatial grid resolution in meters DXY. +! reminder : 1 degree=60minutes // 1minute=1mile // 1mile=1.852km +! The formula for the CFL time is : +! Tcfl = DXY / (G / (FREQ1*4*Pi) ) with the constants Pi=3,14 and G=9.8m/s²; +! DTXY ~= 90% Tcfl +! DTMAX ~= 3 * DTXY (maximum global time step limit) +! +! * The refraction time step depends on how strong can be the current velocities +! on your grid : +! DTKTH ~= DTMAX / 2 ! in case of no or light current velocities +! DTKTH ~= DTMAX / 10 ! in case of strong current velocities +! +! * The source terms time step is usually defined between 5s and 60s. +! A common value is 10s. +! DTMIN ~= 10 +! +! * namelist must be terminated with / +! * definitions & defaults: +! TIMESTEPS%DTMAX = 0. ! maximum global time step (s) +! TIMESTEPS%DTXY = 0. ! maximum CFL time step for x-y (s) +! TIMESTEPS%DTKTH = 0. ! maximum CFL time step for k-th (s) +! TIMESTEPS%DTMIN = 0. ! minimum source term time step (s) +! -------------------------------------------------------------------- ! +&TIMESTEPS_NML + TIMESTEPS%DTMAX = 900. + TIMESTEPS%DTXY = 900. + TIMESTEPS%DTKTH = 900. + TIMESTEPS%DTMIN = 15. +/ + +! -------------------------------------------------------------------- ! +! Define the grid to preprocess via GRID_NML namelist +! +! * the tunable parameters for source terms, propagation schemes, and +! numerics are read using namelists. +! * Any namelist found in the folowing sections is temporarily written +! to param.scratch, and read from there if necessary. +! * The order of the namelists is immaterial. +! * Namelists not needed for the given switch settings will be skipped +! automatically +! +! * grid type can be : +! 'RECT' : rectilinear +! 'CURV' : curvilinear +! 'UNST' : unstructured (triangle-based) +! +! * coordinate system can be : +! 'SPHE' : Spherical (degrees) +! 'CART' : Cartesian (meters) +! +! * grid closure can only be applied in spherical coordinates +! +! * grid closure can be : +! 'NONE' : No closure is applied +! 'SMPL' : Simple grid closure. Grid is periodic in the +! : i-index and wraps at i=NX+1. In other words, +! : (NX+1,J) => (1,J). A grid with simple closure +! : may be rectilinear or curvilinear. +! 'TRPL' : Tripole grid closure : Grid is periodic in the +! : i-index and wraps at i=NX+1 and has closure at +! : j=NY+1. In other words, (NX+1,J<=NY) => (1,J) +! : and (I,NY+1) => (NX-I+1,NY). Tripole +! : grid closure requires that NX be even. A grid +! : with tripole closure must be curvilinear. +! +! * The coastline limit depth is the value which distinguish the sea +! points to the land points. All the points with depth values (ZBIN) +! greater than this limit (ZLIM) will be considered as excluded points +! and will never be wet points, even if the water level grows over. +! It can only overwrite the status of a sea point to a land point. +! The value must have a negative value under the mean sea level +! +! * The minimum water depth allowed to compute the model is the absolute +! depth value (DMIN) used in the model if the input depth is lower to +! avoid the model to blow up. +! +! * namelist must be terminated with / +! * definitions & defaults: +! GRID%NAME = 'unset' ! grid name (30 char) +! GRID%NML = 'namelists.nml' ! namelists filename +! GRID%TYPE = 'unset' ! grid type +! GRID%COORD = 'unset' ! coordinate system +! GRID%CLOS = 'unset' ! grid closure +! +! GRID%ZLIM = 0. ! coastline limit depth (m) +! GRID%DMIN = 0. ! abs. minimum water depth (m) +! -------------------------------------------------------------------- ! +&GRID_NML + GRID%NAME = 'HOMOGENEOUS SOURCE TERM TEST' + GRID%NML = '../input/namelists_ST4_T707.nml' + GRID%TYPE = 'RECT' + GRID%COORD = 'SPHE' + GRID%CLOS = 'NONE' + GRID%ZLIM = -5. + GRID%DMIN = 5.75 +/ + +! -------------------------------------------------------------------- ! +! Define the rectilinear grid type via RECT_NML namelist +! - only for RECT grids - +! +! * The minimum grid size is 3x3. +! +! * If the grid increments SX and SY are given in minutes of arc, the scaling +! factor SF must be set to 60. to provide an increment factor in degree. +! +! * If CSTRG='SMPL', then SX is forced to 360/NX. +! +! * value <= value_read / scale_fac +! +! * namelist must be terminated with / +! * definitions & defaults: +! RECT%NX = 0 ! number of points along x-axis +! RECT%NY = 0 ! number of points along y-axis +! +! RECT%SX = 0. ! grid increment along x-axis +! RECT%SY = 0. ! grid increment along y-axis +! RECT%SF = 1. ! scaling division factor for x-y axis +! +! RECT%X0 = 0. ! x-coordinate of lower-left corner (deg) +! RECT%Y0 = 0. ! y-coordinate of lower-left corner (deg) +! RECT%SF0 = 1. ! scaling division factor for x0,y0 coord +! -------------------------------------------------------------------- ! +&RECT_NML + RECT%NX = 3 + RECT%NY = 3 + RECT%SX = 1. + RECT%SY = 1. + RECT%SF = 1.E-2 + RECT%X0 = -1. + RECT%Y0 = -1. + RECT%SF0 = 1.E-2 +/ + +! -------------------------------------------------------------------- ! +! Define the depth to preprocess via DEPTH_NML namelist +! - for RECT and CURV grids - +! +! * if no obstruction subgrid, need to set &MISC FLAGTR = 0 +! +! * The depth value must have negative values under the mean sea level +! +! * value <= value_read * scale_fac +! +! * IDLA : Layout indicator : +! 1 : Read line-by-line bottom to top. (default) +! 2 : Like 1, single read statement. +! 3 : Read line-by-line top to bottom. +! 4 : Like 3, single read statement. +! * IDFM : format indicator : +! 1 : Free format. (default) +! 2 : Fixed format. +! 3 : Unformatted. +! * FORMAT : element format to read : +! '(....)' : auto detected (default) +! '(f10.6)' : float type +! +! * Example : +! IDF SF IDLA IDFM FORMAT FILENAME +! 50 0.001 1 1 '(....)' 'GLOB-30M.bot' +! +! * namelist must be terminated with / +! * definitions & defaults: +! DEPTH%SF = 1. ! scale factor +! DEPTH%FILENAME = 'unset' ! filename +! DEPTH%IDF = 50 ! file unit number +! DEPTH%IDLA = 1 ! layout indicator +! DEPTH%IDFM = 1 ! format indicator +! DEPTH%FORMAT = '(....)' ! formatted read format +! -------------------------------------------------------------------- ! +&DEPTH_NML + DEPTH%SF = -2500. + DEPTH%FILENAME = '../input/HOMOGENEOUS.depth' + DEPTH%IDLA = 3 +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ts1/input_10ms/namelists_ST4_T707.nml b/regtests/ww3_ts1/input_10ms/namelists_ST4_T707.nml new file mode 100644 index 000000000..0458cd775 --- /dev/null +++ b/regtests/ww3_ts1/input_10ms/namelists_ST4_T707.nml @@ -0,0 +1,14 @@ + &SNL1 IQTYPE = -2, GQMNF1 = 11, GQMNT1 = 6, GQMNQ_OM2 = 6, + TAILNL=-5.0, GQMTHRSAT=5E-5, GQMTHRCOU = 0.05, GQAMP1=1., + GQAMP2=0.0022, GQAMP3=1., GQAMP4=1.0 / + &SIN4 BETAMAX = 1.6, TAUWSHELTER = 0.0 / + &SDS4 SDSBCHOICE=3, SDSC2 = -2.3, SDSBR = 0.005, + FXFM3 = 20, SDSFACMTF = 400., + SDSMWD = 2., SDSCUM = 0.35, SDSNUW =0, SDSC5=1., SDSBRF1=0.5 / +&SIC2 IC2ROUGH = 0.001000, IC2VISC = 2.000, IC2DMAX =0.300 / +&SIS2 ISC1 =0.200E+00, IS2BREAK = T, IS2DUPDATE = F, IS2CREEPB = 0.200E+08 / +! DO NOT FORGET TO ADD FLAGTR = 4 for real life runs ... +&MISC ICEHINIT = 0.5, ICEHMIN = 0.1, CICE0 = 0.25, NOSW =6, + CICEN = 2.00, LICE = 40000., FACBERG = 0.2 , + WCOR1=21., WCOR2=0.5 / +END OF NAMELISTS diff --git a/regtests/ww3_ts1/input_10ms/namelists_ST4_T713.nml b/regtests/ww3_ts1/input_10ms/namelists_ST4_T713.nml new file mode 100644 index 000000000..878604430 --- /dev/null +++ b/regtests/ww3_ts1/input_10ms/namelists_ST4_T713.nml @@ -0,0 +1,14 @@ + &SNL1 IQTYPE = -2, GQMNF1 = 11, GQMNT1 = 6, GQMNQ_OM2 = 6, + TAILNL=-5.0, GQMTHRSAT=5E-5, GQMTHRCOU = 0.05, GQAMP1=1., + GQAMP2=0.0022, GQAMP3=2. / +&SIN4 BETAMAX = 1.1, TAUWSHELTER = 0.0 / +&SDS4 SDSBCHOICE=3, SDSC2 = -2.5, SDSBR = 0.005, + SDSSTRAIN2 =1.,SDSCUMP=1., FXFM3 = 20, SDSFACMTF = 200., + SDSMWD = 0.9, SDSCUM = 0.3, SDSNUW =0, SDSC5=0.5, SDSBRF1=0.5 / +&SIC2 IC2ROUGH = 0.001000, IC2VISC = 2.000, IC2DMAX =0.300 / +&SIS2 ISC1 =0.200E+00, IS2BREAK = T, IS2DUPDATE = F, IS2CREEPB = 0.200E+08 / +! DO NOT FORGET TO ADD FLAGTR = 4 for real life runs ... +&MISC ICEHINIT = 0.5, ICEHMIN = 0.1, CICE0 = 0.25, NOSW =6, + CICEN = 2.00, LICE = 40000., FACBERG = 0.2 , + WCOR1=21., WCOR2=0.5 / +END OF NAMELISTS diff --git a/regtests/ww3_ts1/input_10ms/points.list b/regtests/ww3_ts1/input_10ms/points.list new file mode 100644 index 000000000..5ad8fde50 --- /dev/null +++ b/regtests/ww3_ts1/input_10ms/points.list @@ -0,0 +1 @@ +0.0 0.0 'The_point' diff --git a/regtests/ww3_ts1/input_10ms/switch b/regtests/ww3_ts1/input_10ms/switch new file mode 100644 index 000000000..c3b8938ee --- /dev/null +++ b/regtests/ww3_ts1/input_10ms/switch @@ -0,0 +1 @@ +NOGRB SHRD PR0 FLX0 LN1 ST4 NL1 BT1 DB1 TR0 BS0 IC0 IS0 REF0 WNT1 WNX1 CRT1 CRX1 O0 O1 O2 O3 O4 O5 O6 O7 O10 O11 diff --git a/regtests/ww3_ts1/input_10ms/switch_ST4 b/regtests/ww3_ts1/input_10ms/switch_ST4 new file mode 100644 index 000000000..c3b8938ee --- /dev/null +++ b/regtests/ww3_ts1/input_10ms/switch_ST4 @@ -0,0 +1 @@ +NOGRB SHRD PR0 FLX0 LN1 ST4 NL1 BT1 DB1 TR0 BS0 IC0 IS0 REF0 WNT1 WNX1 CRT1 CRX1 O0 O1 O2 O3 O4 O5 O6 O7 O10 O11 diff --git a/regtests/ww3_ts1/input_10ms/ww3_grid_ST4_T707.nml b/regtests/ww3_ts1/input_10ms/ww3_grid_ST4_T707.nml new file mode 100644 index 000000000..5378ebec3 --- /dev/null +++ b/regtests/ww3_ts1/input_10ms/ww3_grid_ST4_T707.nml @@ -0,0 +1,225 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_grid.nml - Grid pre-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the spectrum parameterization via SPECTRUM_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! SPECTRUM%XFR = 0. ! frequency increment +! SPECTRUM%FREQ1 = 0. ! first frequency (Hz) +! SPECTRUM%NK = 0 ! number of frequencies (wavenumbers) +! SPECTRUM%NTH = 0 ! number of direction bins +! SPECTRUM%THOFF = 0. ! relative offset of first direction [-0.5,0.5] +! -------------------------------------------------------------------- ! +&SPECTRUM_NML + SPECTRUM%XFR = 1.10 + SPECTRUM%FREQ1 = 0.034 + SPECTRUM%NK = 36 + SPECTRUM%NTH = 36 +/ + +! -------------------------------------------------------------------- ! +! Define the run parameterization via RUN_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! RUN%FLDRY = F ! dry run (I/O only, no calculation) +! RUN%FLCX = F ! x-component of propagation +! RUN%FLCY = F ! y-component of propagation +! RUN%FLCTH = F ! direction shift +! RUN%FLCK = F ! wavenumber shift +! RUN%FLSOU = F ! source terms +! -------------------------------------------------------------------- ! +&RUN_NML + RUN%FLSOU = T +/ + +! -------------------------------------------------------------------- ! +! Define the timesteps parameterization via TIMESTEPS_NML namelist +! +! * It is highly recommended to set up time steps which are multiple +! between them. +! +! * The first time step to calculate is the maximum CFL time step +! which depend on the lowest frequency FREQ1 previously set up and the +! lowest spatial grid resolution in meters DXY. +! reminder : 1 degree=60minutes // 1minute=1mile // 1mile=1.852km +! The formula for the CFL time is : +! Tcfl = DXY / (G / (FREQ1*4*Pi) ) with the constants Pi=3,14 and G=9.8m/s²; +! DTXY ~= 90% Tcfl +! DTMAX ~= 3 * DTXY (maximum global time step limit) +! +! * The refraction time step depends on how strong can be the current velocities +! on your grid : +! DTKTH ~= DTMAX / 2 ! in case of no or light current velocities +! DTKTH ~= DTMAX / 10 ! in case of strong current velocities +! +! * The source terms time step is usually defined between 5s and 60s. +! A common value is 10s. +! DTMIN = 10 +! +! * namelist must be terminated with / +! * definitions & defaults: +! TIMESTEPS%DTMAX = 0. ! maximum global time step (s) +! TIMESTEPS%DTXY = 0. ! maximum CFL time step for x-y (s) +! TIMESTEPS%DTKTH = 0. ! maximum CFL time step for k-th (s) +! TIMESTEPS%DTMIN = 0. ! minimum source term time step (s) +! -------------------------------------------------------------------- ! +&TIMESTEPS_NML + TIMESTEPS%DTMAX = 900. + TIMESTEPS%DTXY = 900. + TIMESTEPS%DTKTH = 900. + TIMESTEPS%DTMIN = 5. +/ + +! -------------------------------------------------------------------- ! +! Define the grid to preprocess via GRID_NML namelist +! +! * the tunable parameters for source terms, propagation schemes, and +! numerics are read using namelists. +! * Any namelist found in the folowing sections is temporarily written +! to param.scratch, and read from there if necessary. +! * The order of the namelists is immaterial. +! * Namelists not needed for the given switch settings will be skipped +! automatically +! +! * grid type can be : +! 'RECT' : rectilinear +! 'CURV' : curvilinear +! 'UNST' : unstructured (triangle-based) +! +! * coordinate system can be : +! 'SPHE' : Spherical (degrees) +! 'CART' : Cartesian (meters) +! +! * grid closure can only be applied in spherical coordinates +! +! * grid closure can be : +! 'NONE' : No closure is applied +! 'SMPL' : Simple grid closure. Grid is periodic in the +! : i-index and wraps at i=NX+1. In other words, +! : (NX+1,J) => (1,J). A grid with simple closure +! : may be rectilinear or curvilinear. +! 'TRPL' : Tripole grid closure : Grid is periodic in the +! : i-index and wraps at i=NX+1 and has closure at +! : j=NY+1. In other words, (NX+1,J<=NY) => (1,J) +! : and (I,NY+1) => (NX-I+1,NY). Tripole +! : grid closure requires that NX be even. A grid +! : with tripole closure must be curvilinear. +! +! * The coastline limit depth is the value which distinguish the sea +! points to the land points. All the points with depth values (ZBIN) +! greater than this limit (ZLIM) will be considered as excluded points +! and will never be wet points, even if the water level grows over. +! It can only overwrite the status of a sea point to a land point. +! The value must have a negative value under the mean sea level +! +! * The minimum water depth allowed to compute the model is the absolute +! depth value (DMIN) used in the model if the input depth is lower to +! avoid the model to blow up. +! +! * namelist must be terminated with / +! * definitions & defaults: +! GRID%NAME = 'unset' ! grid name (30 char) +! GRID%NML = 'namelists.nml' ! namelists filename +! GRID%TYPE = 'unset' ! grid type +! GRID%COORD = 'unset' ! coordinate system +! GRID%CLOS = 'unset' ! grid closure +! +! GRID%ZLIM = 0. ! coastline limit depth (m) +! GRID%DMIN = 0. ! abs. minimum water depth (m) +! -------------------------------------------------------------------- ! +&GRID_NML + GRID%NAME = 'HOMOGENEOUS SOURCE TERM TEST' + GRID%NML = '../input_10ms/namelists_ST4_T707.nml' + GRID%TYPE = 'RECT' + GRID%COORD = 'SPHE' + GRID%CLOS = 'NONE' + GRID%ZLIM = -5. + GRID%DMIN = 5.75 +/ + +! -------------------------------------------------------------------- ! +! Define the rectilinear grid type via RECT_NML namelist +! - only for RECT grids - +! +! * The minimum grid size is 3x3. +! +! * If the grid increments SX and SY are given in minutes of arc, the scaling +! factor SF must be set to 60. to provide an increment factor in degree. +! +! * If CSTRG='SMPL', then SX is forced to 360/NX. +! +! * value <= value_read / scale_fac +! +! * namelist must be terminated with / +! * definitions & defaults: +! RECT%NX = 0 ! number of points along x-axis +! RECT%NY = 0 ! number of points along y-axis +! +! RECT%SX = 0. ! grid increment along x-axis +! RECT%SY = 0. ! grid increment along y-axis +! RECT%SF = 1. ! scaling division factor for x-y axis +! +! RECT%X0 = 0. ! x-coordinate of lower-left corner (deg) +! RECT%Y0 = 0. ! y-coordinate of lower-left corner (deg) +! RECT%SF0 = 1. ! scaling division factor for x0,y0 coord +! -------------------------------------------------------------------- ! +&RECT_NML + RECT%NX = 3 + RECT%NY = 3 + RECT%SX = 1. + RECT%SY = 1. + RECT%SF = 1.E-2 + RECT%X0 = -1. + RECT%Y0 = -1. + RECT%SF0 = 1.E-2 +/ + +! -------------------------------------------------------------------- ! +! Define the depth to preprocess via DEPTH_NML namelist +! - for RECT and CURV grids - +! +! * if no obstruction subgrid, need to set &MISC FLAGTR = 0 +! +! * The depth value must have negative values under the mean sea level +! +! * value <= value_read * scale_fac +! +! * IDLA : Layout indicator : +! 1 : Read line-by-line bottom to top. (default) +! 2 : Like 1, single read statement. +! 3 : Read line-by-line top to bottom. +! 4 : Like 3, single read statement. +! * IDFM : format indicator : +! 1 : Free format. (default) +! 2 : Fixed format. +! 3 : Unformatted. +! * FORMAT : element format to read : +! '(....)' : auto detected (default) +! '(f10.6)' : float type +! +! * Example : +! IDF SF IDLA IDFM FORMAT FILENAME +! 50 0.001 1 1 '(....)' 'GLOB-30M.bot' +! +! * namelist must be terminated with / +! * definitions & defaults: +! DEPTH%SF = 1. ! scale factor +! DEPTH%FILENAME = 'unset' ! filename +! DEPTH%IDF = 50 ! file unit number +! DEPTH%IDLA = 1 ! layout indicator +! DEPTH%IDFM = 1 ! format indicator +! DEPTH%FORMAT = '(....)' ! formatted read format +! -------------------------------------------------------------------- ! +&DEPTH_NML + DEPTH%SF = -2500. + DEPTH%FILENAME = '../input/HOMOGENEOUS.depth' + DEPTH%IDLA = 3 +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ts1/input_10ms/ww3_grid_ST4_T713.nml b/regtests/ww3_ts1/input_10ms/ww3_grid_ST4_T713.nml new file mode 100644 index 000000000..3efd65adf --- /dev/null +++ b/regtests/ww3_ts1/input_10ms/ww3_grid_ST4_T713.nml @@ -0,0 +1,225 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_grid.nml - Grid pre-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the spectrum parameterization via SPECTRUM_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! SPECTRUM%XFR = 0. ! frequency increment +! SPECTRUM%FREQ1 = 0. ! first frequency (Hz) +! SPECTRUM%NK = 0 ! number of frequencies (wavenumbers) +! SPECTRUM%NTH = 0 ! number of direction bins +! SPECTRUM%THOFF = 0. ! relative offset of first direction [-0.5,0.5] +! -------------------------------------------------------------------- ! +&SPECTRUM_NML + SPECTRUM%XFR = 1.10 + SPECTRUM%FREQ1 = 0.034 + SPECTRUM%NK = 36 + SPECTRUM%NTH = 36 +/ + +! -------------------------------------------------------------------- ! +! Define the run parameterization via RUN_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! RUN%FLDRY = F ! dry run (I/O only, no calculation) +! RUN%FLCX = F ! x-component of propagation +! RUN%FLCY = F ! y-component of propagation +! RUN%FLCTH = F ! direction shift +! RUN%FLCK = F ! wavenumber shift +! RUN%FLSOU = F ! source terms +! -------------------------------------------------------------------- ! +&RUN_NML + RUN%FLSOU = T +/ + +! -------------------------------------------------------------------- ! +! Define the timesteps parameterization via TIMESTEPS_NML namelist +! +! * It is highly recommended to set up time steps which are multiple +! between them. +! +! * The first time step to calculate is the maximum CFL time step +! which depend on the lowest frequency FREQ1 previously set up and the +! lowest spatial grid resolution in meters DXY. +! reminder : 1 degree=60minutes // 1minute=1mile // 1mile=1.852km +! The formula for the CFL time is : +! Tcfl = DXY / (G / (FREQ1*4*Pi) ) with the constants Pi=3,14 and G=9.8m/s²; +! DTXY ~= 90% Tcfl +! DTMAX ~= 3 * DTXY (maximum global time step limit) +! +! * The refraction time step depends on how strong can be the current velocities +! on your grid : +! DTKTH ~= DTMAX / 2 ! in case of no or light current velocities +! DTKTH ~= DTMAX / 10 ! in case of strong current velocities +! +! * The source terms time step is usually defined between 5s and 60s. +! A common value is 10s. +! DTMIN = 10 +! +! * namelist must be terminated with / +! * definitions & defaults: +! TIMESTEPS%DTMAX = 0. ! maximum global time step (s) +! TIMESTEPS%DTXY = 0. ! maximum CFL time step for x-y (s) +! TIMESTEPS%DTKTH = 0. ! maximum CFL time step for k-th (s) +! TIMESTEPS%DTMIN = 0. ! minimum source term time step (s) +! -------------------------------------------------------------------- ! +&TIMESTEPS_NML + TIMESTEPS%DTMAX = 900. + TIMESTEPS%DTXY = 900. + TIMESTEPS%DTKTH = 900. + TIMESTEPS%DTMIN = 5. +/ + +! -------------------------------------------------------------------- ! +! Define the grid to preprocess via GRID_NML namelist +! +! * the tunable parameters for source terms, propagation schemes, and +! numerics are read using namelists. +! * Any namelist found in the folowing sections is temporarily written +! to param.scratch, and read from there if necessary. +! * The order of the namelists is immaterial. +! * Namelists not needed for the given switch settings will be skipped +! automatically +! +! * grid type can be : +! 'RECT' : rectilinear +! 'CURV' : curvilinear +! 'UNST' : unstructured (triangle-based) +! +! * coordinate system can be : +! 'SPHE' : Spherical (degrees) +! 'CART' : Cartesian (meters) +! +! * grid closure can only be applied in spherical coordinates +! +! * grid closure can be : +! 'NONE' : No closure is applied +! 'SMPL' : Simple grid closure. Grid is periodic in the +! : i-index and wraps at i=NX+1. In other words, +! : (NX+1,J) => (1,J). A grid with simple closure +! : may be rectilinear or curvilinear. +! 'TRPL' : Tripole grid closure : Grid is periodic in the +! : i-index and wraps at i=NX+1 and has closure at +! : j=NY+1. In other words, (NX+1,J<=NY) => (1,J) +! : and (I,NY+1) => (NX-I+1,NY). Tripole +! : grid closure requires that NX be even. A grid +! : with tripole closure must be curvilinear. +! +! * The coastline limit depth is the value which distinguish the sea +! points to the land points. All the points with depth values (ZBIN) +! greater than this limit (ZLIM) will be considered as excluded points +! and will never be wet points, even if the water level grows over. +! It can only overwrite the status of a sea point to a land point. +! The value must have a negative value under the mean sea level +! +! * The minimum water depth allowed to compute the model is the absolute +! depth value (DMIN) used in the model if the input depth is lower to +! avoid the model to blow up. +! +! * namelist must be terminated with / +! * definitions & defaults: +! GRID%NAME = 'unset' ! grid name (30 char) +! GRID%NML = 'namelists.nml' ! namelists filename +! GRID%TYPE = 'unset' ! grid type +! GRID%COORD = 'unset' ! coordinate system +! GRID%CLOS = 'unset' ! grid closure +! +! GRID%ZLIM = 0. ! coastline limit depth (m) +! GRID%DMIN = 0. ! abs. minimum water depth (m) +! -------------------------------------------------------------------- ! +&GRID_NML + GRID%NAME = 'HOMOGENEOUS SOURCE TERM TEST' + GRID%NML = '../input_10ms/namelists_ST4_T713.nml' + GRID%TYPE = 'RECT' + GRID%COORD = 'SPHE' + GRID%CLOS = 'NONE' + GRID%ZLIM = -5. + GRID%DMIN = 5.75 +/ + +! -------------------------------------------------------------------- ! +! Define the rectilinear grid type via RECT_NML namelist +! - only for RECT grids - +! +! * The minimum grid size is 3x3. +! +! * If the grid increments SX and SY are given in minutes of arc, the scaling +! factor SF must be set to 60. to provide an increment factor in degree. +! +! * If CSTRG='SMPL', then SX is forced to 360/NX. +! +! * value <= value_read / scale_fac +! +! * namelist must be terminated with / +! * definitions & defaults: +! RECT%NX = 0 ! number of points along x-axis +! RECT%NY = 0 ! number of points along y-axis +! +! RECT%SX = 0. ! grid increment along x-axis +! RECT%SY = 0. ! grid increment along y-axis +! RECT%SF = 1. ! scaling division factor for x-y axis +! +! RECT%X0 = 0. ! x-coordinate of lower-left corner (deg) +! RECT%Y0 = 0. ! y-coordinate of lower-left corner (deg) +! RECT%SF0 = 1. ! scaling division factor for x0,y0 coord +! -------------------------------------------------------------------- ! +&RECT_NML + RECT%NX = 3 + RECT%NY = 3 + RECT%SX = 1. + RECT%SY = 1. + RECT%SF = 1.E-2 + RECT%X0 = -1. + RECT%Y0 = -1. + RECT%SF0 = 1.E-2 +/ + +! -------------------------------------------------------------------- ! +! Define the depth to preprocess via DEPTH_NML namelist +! - for RECT and CURV grids - +! +! * if no obstruction subgrid, need to set &MISC FLAGTR = 0 +! +! * The depth value must have negative values under the mean sea level +! +! * value <= value_read * scale_fac +! +! * IDLA : Layout indicator : +! 1 : Read line-by-line bottom to top. (default) +! 2 : Like 1, single read statement. +! 3 : Read line-by-line top to bottom. +! 4 : Like 3, single read statement. +! * IDFM : format indicator : +! 1 : Free format. (default) +! 2 : Fixed format. +! 3 : Unformatted. +! * FORMAT : element format to read : +! '(....)' : auto detected (default) +! '(f10.6)' : float type +! +! * Example : +! IDF SF IDLA IDFM FORMAT FILENAME +! 50 0.001 1 1 '(....)' 'GLOB-30M.bot' +! +! * namelist must be terminated with / +! * definitions & defaults: +! DEPTH%SF = 1. ! scale factor +! DEPTH%FILENAME = 'unset' ! filename +! DEPTH%IDF = 50 ! file unit number +! DEPTH%IDLA = 1 ! layout indicator +! DEPTH%IDFM = 1 ! format indicator +! DEPTH%FORMAT = '(....)' ! formatted read format +! -------------------------------------------------------------------- ! +&DEPTH_NML + DEPTH%SF = -2500. + DEPTH%FILENAME = '../input/HOMOGENEOUS.depth' + DEPTH%IDLA = 3 +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ts1/input_10ms/ww3_ounf.nml b/regtests/ww3_ts1/input_10ms/ww3_ounf.nml new file mode 100644 index 000000000..716f1df4b --- /dev/null +++ b/regtests/ww3_ts1/input_10ms/ww3_ounf.nml @@ -0,0 +1,29 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III ww3_ounf.nml - Grid output post-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the output fields to postprocess via FIELD_NML namelist +! -------------------------------------------------------------------- ! +&FIELD_NML + FIELD%TIMESTART = '20000101 000000' + FIELD%TIMESTRIDE = '10' + FIELD%TIMECOUNT = '8000' + FIELD%LIST = 'DPT QP QKK WND ICE HS MSS MSD FAW WCC WCF WCH WCM FOC TAW CHA UST' + FIELD%PARTITION = '0 1 2' + FIELD%TYPE = 4 +/ + +! -------------------------------------------------------------------- ! +! Define the content of the output file via FILE_NML namelist +! -------------------------------------------------------------------- ! +&FILE_NML + FILE%IX0 = 2 + FILE%IXN = 2 + FILE%IY0 = 2 + FILE%IYN = 2 +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ts1/input_10ms/ww3_ounp_spec.nml b/regtests/ww3_ts1/input_10ms/ww3_ounp_spec.nml new file mode 100644 index 000000000..34bac9764 --- /dev/null +++ b/regtests/ww3_ts1/input_10ms/ww3_ounp_spec.nml @@ -0,0 +1,48 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III ww3_ounp.nml - Point output post-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the output fields to postprocess via POINT_NML namelist +! -------------------------------------------------------------------- ! +&POINT_NML + POINT%TIMESTART = '20000101 000000' + POINT%TIMESTRIDE = '1800.' + POINT%TIMECOUNT = '1000' + POINT%TIMESPLIT = 4 + POINT%BUFFER = 100 + POINT%TYPE = 3 +/ + +! -------------------------------------------------------------------- ! +! Define the content of the output file via FILE_NML namelist +! -------------------------------------------------------------------- ! +&FILE_NML +/ + +! -------------------------------------------------------------------- ! +! Define the type 0, inventory of file +! -------------------------------------------------------------------- ! + + +! -------------------------------------------------------------------- ! +! Define the type 1, spectra via SPECTRA_NML namelist +! -------------------------------------------------------------------- ! +&SPECTRA_NML +/ + +! -------------------------------------------------------------------- ! +! Define the type 2, mean parameter via PARAM_NML namelist +! -------------------------------------------------------------------- ! +&PARAM_NML +/ + +! -------------------------------------------------------------------- ! +! Define the type 3, source terms via SOURCE_NML namelist +! -------------------------------------------------------------------- ! +&SOURCE_NML +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ts1/input_10ms/ww3_shel.nml b/regtests/ww3_ts1/input_10ms/ww3_shel.nml new file mode 100644 index 000000000..d83106ed1 --- /dev/null +++ b/regtests/ww3_ts1/input_10ms/ww3_shel.nml @@ -0,0 +1,54 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III ww3_shel.nml - single-grid model ! +! -------------------------------------------------------------------- ! + + +! -------------------------------------------------------------------- ! +! Define top-level model parameters via DOMAIN_NML namelist +! -------------------------------------------------------------------- ! +&DOMAIN_NML + DOMAIN%START = '20000101 000000' + DOMAIN%STOP = '20000106 000000' +/ + +! -------------------------------------------------------------------- ! +! Define each forcing via the INPUT_NML namelist +! -------------------------------------------------------------------- ! +&INPUT_NML + INPUT%FORCING%WINDS = 'H' +/ + +! -------------------------------------------------------------------- ! +! Define the output types point parameters via OUTPUT_TYPE_NML namelist +! -------------------------------------------------------------------- ! +&OUTPUT_TYPE_NML + TYPE%FIELD%LIST = 'DPT QP QKK WND ICE HS MSS MSD FAW WCC WCF WCH WCM FOC TAW CHA UST' + TYPE%POINT%FILE = '../input_10ms/points.list' +/ + +! -------------------------------------------------------------------- ! +! Define output dates via OUTPUT_DATE_NML namelist +! -------------------------------------------------------------------- ! +&OUTPUT_DATE_NML + DATE%FIELD = '19680606 000000' '1800' '20230618 000000' + DATE%POINT = '19680606 000000' '1800' '20230618 000000' +/ + +! -------------------------------------------------------------------- ! +! Define homogeneous input via HOMOG_COUNT_NML and HOMOG_INPUT_NML namelist +! -------------------------------------------------------------------- ! +&HOMOG_COUNT_NML + HOMOG_COUNT%N_CUR = 0 + HOMOG_COUNT%N_WND = 1 +/ + +&HOMOG_INPUT_NML + HOMOG_INPUT(1)%NAME = 'WND' + HOMOG_INPUT(1)%VALUE1 = 10. + HOMOG_INPUT(1)%VALUE2 = 270. + HOMOG_INPUT(1)%VALUE3 = 0. +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ufs1.1/input_unstr/namelists_a.nml b/regtests/ww3_ufs1.1/input_unstr/namelists_a.nml index 584405f2f..e28a03245 100644 --- a/regtests/ww3_ufs1.1/input_unstr/namelists_a.nml +++ b/regtests/ww3_ufs1.1/input_unstr/namelists_a.nml @@ -31,7 +31,7 @@ SDSHCK = 1.50, SDSBR = 0.9000E-03, SDSSTRAIN = 0.000, SDSP = 2.00, SDSISO = 2, SDSCOS =2.0, SDSDTH = 80.0, SDSBRF1 = 0.50, SDSBRFDF = 0, SDSBM0 = 1.00, SDSBM1 = 0.00, SDSBM2 = 0.00, SDSBM3 = 0.00, SDSBM4 = 0.00, -, WHITECAPWIDTH = 0.30/ +WHITECAPWIDTH = 0.30/ &SBT1 GAMMA = -0.6700E-01 / &SDB1 BJALFA = 1.000, BJGAM = 0.730, BJFLAG = .TRUE. / &PRO3 CFLTM = 0.70, WDTHCG = 1.50, WDTHTH = 1.50 / diff --git a/regtests/ww3_ufs1.1/input_unstr/namelists_b.nml b/regtests/ww3_ufs1.1/input_unstr/namelists_b.nml index 292ffc5f7..8d1c72eda 100644 --- a/regtests/ww3_ufs1.1/input_unstr/namelists_b.nml +++ b/regtests/ww3_ufs1.1/input_unstr/namelists_b.nml @@ -51,7 +51,7 @@ SDSHCK = 1.50, SDSBR = 0.9000E-03, SDSSTRAIN = 0.000, SDSP = 2.00, SDSISO = 2, SDSCOS =2.0, SDSDTH = 80.0, SDSBRF1 = 0.50, SDSBRFDF = 0, SDSBM0 = 1.00, SDSBM1 = 0.00, SDSBM2 = 0.00, SDSBM3 = 0.00, SDSBM4 = 0.00, -, WHITECAPWIDTH = 0.30/ +WHITECAPWIDTH = 0.30/ &SBT1 GAMMA = -0.6700E-01 / &SDB1 BJALFA = 1.000, BJGAM = 0.730, BJFLAG = .TRUE. / &PRO3 CFLTM = 0.70, WDTHCG = 1.50, WDTHTH = 1.50 /