diff --git a/.github/workflows/io_gnu_yml.old b/.github/workflows/io_gnu.yml similarity index 100% rename from .github/workflows/io_gnu_yml.old rename to .github/workflows/io_gnu.yml diff --git a/.github/workflows/regtest_gnu.yml b/.github/workflows/regtest_gnu.yml new file mode 100644 index 000000000..81d1317a3 --- /dev/null +++ b/.github/workflows/regtest_gnu.yml @@ -0,0 +1,133 @@ +name: regtest_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} + + regtest_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: spack2-${{ 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 .. +# make -j2 VERBOSE=1 + cd ${GITHUB_WORKSPACE}/ww3 + ls -l + ${GITHUB_WORKSPACE}/ww3/model/bin/ww3_from_ftp.sh -k + cd regtests + ./bin/run_cmake_test -o all -S -T -s PR1_MPI -w work_PR1_MPI -f -p mpirun -n 24 ../model ww3_tp2.5 + cd ww3_tp2.5 + ls -l + cd work_PR1_MPI + pwd + ls -l + ncdump -h out_pnt.ww3.nc > ncdump_out.txt + cat ncdump_out.txt + pwd + cat ${GITHUB_WORKSPACE}/ww3/regtests/ww3_tp2.5/out_pnt_ncdump.txt + cmp ${GITHUB_WORKSPACE}/ww3/regtests/ww3_tp2.5/out_pnt_ncdump.txt ncdump_out.txt + + - name: cache-data + id: cache-data + uses: actions/cache@v3 + with: + path: ww3/ww3_from_ftp.v7.14.1.tar.gz + key: ww3_from_ftp.v7.14.1 + + + diff --git a/model/bin/ww3_from_ftp.sh b/model/bin/ww3_from_ftp.sh index 67efc9284..4ab231e54 100755 --- a/model/bin/ww3_from_ftp.sh +++ b/model/bin/ww3_from_ftp.sh @@ -61,11 +61,14 @@ fi #Move to top level directory of ww3: cd $ww3dir -#Download from ftp and uptar: -echo -e "Downloading and untaring file from ftp:" -wget --no-check-certificate https://ftp.emc.ncep.noaa.gov/static_files/public/WW3/ww3_from_ftp.${ww3ver}.tar.gz +#Download from ftp (if not already present) and uptar: +echo -e "Downloading (or finding) and untaring file from ftp:" +if ! test -f ww3_from_ftp.${ww3ver}.tar.gz; then + wget --no-check-certificate https://ftp.emc.ncep.noaa.gov/static_files/public/WW3/ww3_from_ftp.${ww3ver}.tar.gz +fi tar -xvzf ww3_from_ftp.${ww3ver}.tar.gz + #Move regtest info from data_regtests to regtests: echo -e "Moving data from data_regtests to regtests" cp -r data_regtests/ww3_tp2.18/input/*.nc regtests/ww3_tp2.18/input/ diff --git a/model/src/gx_outp.F90 b/model/src/gx_outp.F90 index d34fdbaa7..dacfa69db 100644 --- a/model/src/gx_outp.F90 +++ b/model/src/gx_outp.F90 @@ -165,7 +165,11 @@ PROGRAM GXOUTP #endif USE W3ODATMD, ONLY: W3SETO, W3NOUT USE W3IOGRMD, ONLY: W3IOGR - USE W3IOPOMD, ONLY: W3IOPO + !!!MTM + !!!USE W3IOPOMD, ONLY: W3IOPO + USE W3IOPOMD + USE netcdf + USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE #ifdef W3_S USE W3SERVMD, ONLY : STRACE @@ -277,7 +281,7 @@ PROGRAM GXOUTP !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 3. Read general data and first fields from file ! - CALL W3IOPO ( 'READ', NDSOP, IOTEST ) + CALL W3IOPON ( 'READ', NDSOP, IOTEST ) ALLOCATE ( FLREQ(NOPTS) ) ! WRITE (NDSO,930) @@ -369,7 +373,7 @@ PROGRAM GXOUTP DO DTEST = DSEC21 ( TIME , TOUT ) IF ( DTEST .GT. 0. ) THEN - CALL W3IOPO ( 'READ', NDSOP, IOTEST ) + CALL W3IOPON ( 'READ', NDSOP, IOTEST ) IF ( IOTEST .EQ. -1 ) THEN WRITE (NDSO,998) EXIT diff --git a/model/src/w3iopomd.F90 b/model/src/w3iopomd.F90 index 0c15ea8c6..d16a1f7b3 100644 --- a/model/src/w3iopomd.F90 +++ b/model/src/w3iopomd.F90 @@ -5,6 +5,7 @@ !> #include "w3macros.h" +#define nf90_err(ncerr) nf90_err_check(ncerr, __LINE__) !/ ------------------------------------------------------------------- / !> !> @brief Process point output. @@ -65,7 +66,7 @@ MODULE W3IOPOMD ! Name Type Scope Description ! ---------------------------------------------------------------- ! VEROPT C*10 Private Point output file version number. - ! IDSTR C*32 Private Point output file ID string. + ! IDSTR C*31 Private Point output file ID string. ! ---------------------------------------------------------------- ! ! 3. Subroutines and functions : @@ -118,6 +119,90 @@ MODULE W3IOPOMD CHARACTER(LEN=10), PARAMETER, PRIVATE :: VEROPT = '2021-04-06' CHARACTER(LEN=31), PARAMETER, PRIVATE :: & IDSTR = 'WAVEWATCH III POINT OUTPUT FILE' + + !> Dimension name for the netCDF point output file, for NOPTS, the + !> Number of Output Points. + character(*), parameter, private :: DNAME_NOPTS = 'NOPTS' + + !> Dimension name for the netCDF point output file, for NSPEC. + character(*), parameter, private :: DNAME_NSPEC = 'NSPEC' + + !> Dimension name for the netCDF point output file, for VSIZE. This + !> is for the vector size for points, which is 2. + character(*), parameter, private :: DNAME_VSIZE = 'VSIZE' + + !> Dimension name for the netCDF point output file, for + !> NAMELEN. This is the length of the PTNME strings, which contains + !> the names of the points. + character(*), parameter, private :: DNAME_NAMELEN = 'NAMELEN' + + !> Dimension name for the netCDF point output file, for GRDIDLEN, + !> this is the length of the GRDID character array. + character(*), parameter, private :: DNAME_GRDIDLEN = 'GRDIDLEN' + + !> Dimension name for the netCDF point output file, for TIME. + character(*), parameter, private :: DNAME_TIME = 'TIME' + + !> Variable name for the netCDF point output file, for NK. + character(*), parameter, private :: VNAME_NK = 'NK' + + !> Variable name for the netCDF point output file, for MTH. + character(*), parameter, private :: VNAME_NTH = 'NTH' + + !> Variable name for the netCDF point output file, for PTLOC. + character(*), parameter, private :: VNAME_PTLOC = 'PTLOC' + + !> Variable name for the netCDF point output file, for PTNME. + character(*), parameter, private :: VNAME_PTNME = 'PTNME' + + !> Variable name for the netCDF point output file, for TIME. + character(*), parameter, private :: VNAME_TIME = 'TIME' + + !> Variable name for the netCDF point output file, for DPO. + character(*), parameter, private :: VNAME_DPO = 'DPO' + + !> Variable name for the netCDF point output file, for WAO. + character(*), parameter, private :: VNAME_WAO = 'WAO' + + !> Variable name for the netCDF point output file, for WDO. + character(*), parameter, private :: VNAME_WDO = 'WDO' + + !> Variable name for the netCDF point output file, for TAUAO. + character(*), parameter, private :: VNAME_TAUAO = 'TAUAO' + + !> Variable name for the netCDF point output file, for TAUDO. + character(*), parameter, private :: VNAME_TAUDO = 'TAUDO' + + !> Variable name for the netCDF point output file, for DAIRO. + character(*), parameter, private :: VNAME_DAIRO = 'DAIRO' + + !> Variable name for the netCDF point output file, for ZET_SETO. + character(*), parameter, private :: VNAME_ZET_SETO = 'ZET_SETO' + + !> Variable name for the netCDF point output file, for ASO. + character(*), parameter, private :: VNAME_ASO = 'ASO' + + !> Variable name for the netCDF point output file, for CAO. + character(*), parameter, private :: VNAME_CAO = 'CAO' + + !> Variable name for the netCDF point output file, for CDO. + character(*), parameter, private :: VNAME_CDO = 'CDO' + + !> Variable name for the netCDF point output file, for ICEO. + character(*), parameter, private :: VNAME_ICEO = 'ICEO' + + !> Variable name for the netCDF point output file, for ICEHO. + character(*), parameter, private :: VNAME_ICEHO = 'ICEHO' + + !> Variable name for the netCDF point output file, for ICEFO. + character(*), parameter, private :: VNAME_ICEFO = 'ICEFO' + + !> Variable name for the netCDF point output file, for GRDID. + character(*), parameter, private :: VNAME_GRDID = 'GRDID' + + !> Variable name for the netCDF point output file, for SPCO. + character(*), parameter, private :: VNAME_SPCO = 'SPCO' + !/ CONTAINS !/ ------------------------------------------------------------------- / @@ -1024,6 +1109,677 @@ SUBROUTINE W3IOPE ( A ) !/ END SUBROUTINE W3IOPE + !> Handle netCDF return code. + !> + !> @param errcode NetCDF error code. 0 for no error. + !> + !> @author Edward Hartnett @date 1-Nov-2023 + !> + integer function nf90_err_check(errcode, ILINE) + USE NetCDF + USE W3ODATMD, ONLY: NDSE + implicit none + integer, intent(in) :: errcode, ILINE + + nf90_err_check = errcode + if(errcode /= nf90_noerr) then + WRITE(NDSE,*) ' *** WAVEWATCH III ERROR IN W3IOPO :' + WRITE(NDSE,*) ' LINE NUMBER ', ILINE + WRITE(NDSE,*) ' NETCDF ERROR MESSAGE: ' + WRITE(NDSE,*) 'Error: ', trim(nf90_strerror(errcode)) + return + endif + end function nf90_err_check + + !> Read point output in netCDF format. + !> + !> @param[out] IOTST Test indictor for reading. + !> @param[in] IMOD_IN Model number for W3GDAT etc. + !> @param[in] filename Name of file to read. + !> @param[inout] ncerr Error code, 0 for success, netCDF error code + !> otherwise. + !> + !> @author Edward Hartnett @date 1-Nov-2023 + !> + SUBROUTINE W3IOPON_READ(IOTST, IMOD_IN, filename, ncerr) + USE NetCDF + USE W3ODATMD, ONLY: W3DMO2 + USE W3WDATMD, ONLY: TIME + USE W3GDATMD, ONLY: NTH, NK, NSPEC, FILEXT + USE W3ODATMD, ONLY: NDST, NDSE, IPASS => IPASS2, NOPTS, IPTINT, & + IL, IW, II, PTLOC, PTIFAC, DPO, WAO, WDO, & + ASO, CAO, CDO, SPCO, PTNME, O2INIT, FNMPRE, & + GRDID, ICEO, ICEHO, ICEFO, W3DMO2 + USE W3SERVMD, ONLY: EXTCDE +#ifdef W3_FLX5 + USE W3ODATMD, ONLY: TAUAO, TAUDO, DAIRO +#endif +#ifdef W3_SETUP + USE W3ODATMD, ONLY: ZET_SETO +#endif + IMPLICIT NONE + + INTEGER, INTENT(OUT) :: IOTST + INTEGER, INTENT(IN), OPTIONAL :: IMOD_IN + character(*), intent(in) :: filename + integer, intent(inout) :: ncerr + INTEGER :: IGRD,MK,MTH + integer :: fh + integer :: d_nopts, d_nspec, d_vsize, d_namelen, d_grdidlen, d_time + integer :: d_nopts_len, d_nspec_len, d_vsize_len, d_namelen_len, d_grdidlen_len, d_time_len + integer :: v_idtst, v_vertst, v_nk, v_nth, v_ptloc, v_ptnme, v_time + integer :: v_dpo, v_wao, v_wdo +#ifdef W3_FLX5 + integer :: v_tauao,v_taudo, v_dairo +#endif +#ifdef W3_SETUP + integer :: v_zet_seto +#endif + integer :: v_aso, v_cao, v_cdo, v_iceo + integer :: v_iceho, v_icefo, v_grdid, v_spco + CHARACTER(LEN=31) :: IDTST + CHARACTER(LEN=10) :: VERTST + + IOTST = 0 + + IF (PRESENT(IMOD_IN)) THEN + IGRD = IMOD_IN + ELSE + IGRD = 1 + END IF + + ! Open the netCDF file. + ncerr = nf90_open(filename, NF90_NOWRITE, fh) + if (nf90_err(ncerr) .ne. 0) return + + ! Read and check the version: + ncerr = nf90_get_att(fh, 'title', IDTST) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_put_att(fh, 'version', VERTST) + if (nf90_err(ncerr) .ne. 0) return + + IF ( IDTST .NE. IDSTR ) THEN + WRITE (NDSE,902) IDTST, IDSTR + CALL EXTCDE ( 10 ) + END IF + IF ( VERTST .NE. VEROPT ) THEN + WRITE (NDSE,903) VERTST, VEROPT + CALL EXTCDE ( 11 ) + END IF + + ! Read the dimension information for NOPTS. + ncerr = nf90_inq_dimid(fh, DNAME_NOPTS, d_nopts) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inquire_dimension(fh, d_nopts, len = d_nopts_len) + if (nf90_err(ncerr) .ne. 0) return + NOPTS=d_nopts_len + + ! Read the dimension information for NSPEC. + ncerr = nf90_inq_dimid(fh, DNAME_NSPEC, d_nspec) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inquire_dimension(fh, d_nspec, len = d_nspec_len) + if (nf90_err(ncerr) .ne. 0) return + + ! Read the dimension information for VSIZE. + ncerr = nf90_inq_dimid(fh, DNAME_VSIZE, d_vsize) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inquire_dimension(fh, d_vsize, len = d_vsize_len) + if (nf90_err(ncerr) .ne. 0) return + + ! Read the dimension information for NAMELEN. + ncerr = nf90_inq_dimid(fh, DNAME_NAMELEN, d_namelen) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inquire_dimension(fh, d_namelen, len = d_namelen_len) + if (nf90_err(ncerr) .ne. 0) return + + ! Read the dimension information for GRDIDLEN. + ncerr = nf90_inq_dimid(fh, DNAME_GRDIDLEN, d_grdidlen) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inquire_dimension(fh, d_grdidlen, len = d_grdidlen_len) + if (nf90_err(ncerr) .ne. 0) return + + ! Read the dimention information from time + ncerr = nf90_inq_dimid(fh, DNAME_TIME, d_time) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inquire_dimension(fh, d_time, len = d_time_len) + if (nf90_err(ncerr) .ne. 0) return + + IF ( IPASS .LE. d_time_len ) THEN + + IF ( IPASS.EQ.1 ) THEN + + ! Read scalar variables. + ncerr = nf90_inq_varid(fh, VNAME_NK, v_nk) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_nk, MK) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_NTH, v_nth) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_nth, MTH) + if (nf90_err(ncerr) .ne. 0) return + + !read in written variables NK, NTH as MK and MTH + !and ensure they match + IF (NK.NE.MK .OR. NTH.NE.MTH) THEN + WRITE (NDSE,904) MK, MTH, NK, NTH + CALL EXTCDE ( 12 ) + END IF + + ! Allocate variables: + IF ( .NOT. O2INIT ) & + CALL W3DMO2 ( IGRD, NDSE, NDST, NOPTS ) + + ! Read vars with nopts as a dimension. + ncerr = nf90_inq_varid(fh, VNAME_PTLOC, v_ptloc) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_ptloc, PTLOC, start = (/ 1, 1/), & + count = (/ d_vsize_len, d_nopts_len /)) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_PTNME, v_ptnme) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_ptnme, PTNME) + if (nf90_err(ncerr) .ne. 0) return + END IF + + !Variables read based on time (IPASS): + + ncerr = nf90_inq_varid(fh, VNAME_TIME, v_time) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_time, TIME, start = (/ 1, IPASS/), & + count = (/ d_vsize_len, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + + ! set IW, II and IL to 0, + ! These values are set to 0 in binary file and have been removed + ! from netcdf file. Possible can be completely removed. + IW = 0 + II = 0 + IL = 0 + + ncerr = nf90_inq_varid(fh, VNAME_DPO, v_dpo) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_dpo, DPO, start = (/ 1, IPASS/), & + count = (/ NOPTS, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_WAO, v_wao) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_wao, WAO, start = (/ 1, IPASS/), & + count = (/ NOPTS, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_WDO, v_wdo) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_wdo, WDO, start = (/ 1, IPASS/), & + count = (/ NOPTS, 1 /)) + if (nf90_err(ncerr) .ne. 0) return +#ifdef W3_FLX5 + ncerr = nf90_inq_varid(fh, VNAME_TAUAO, v_tauao) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_tauao, TAUAO, start = (/ 1, IPASS/), & + count = (/ NOPTS, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_TAUDO, v_taudo) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_taudo, TAUDO, start = (/ 1, IPASS/), & + count = (/ NOPTS, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_DAIRO, v_dairo) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_dairo, DAIRO, start = (/ 1, IPASS/), & + count = (/ NOPTS, 1 /)) + if (nf90_err(ncerr) .ne. 0) return +#endif +#ifdef W3_SETUP + ncerr = nf90_inq_varid(fh, ZET_SETO, v_zet_seto) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_zet_seto, ZET_SETO, start = (/ 1, IPASS/), & + count = (/ NOPTS, 1 /)) + if (nf90_err(ncerr) .ne. 0) return +#endif + ncerr = nf90_inq_varid(fh, VNAME_ASO, v_aso) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_aso, ASO, start = (/ 1, IPASS/), & + count = (/ NOPTS, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_CAO, v_cao) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_cao, CAO, start = (/ 1, IPASS/), & + count = (/ NOPTS, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_CDO, v_cdo) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_cdo, CDO, start = (/ 1, IPASS/), & + count = (/ NOPTS, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_ICEO, v_iceo) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_iceo, ICEO, start = (/ 1, IPASS/), & + count = (/ NOPTS, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_ICEHO, v_iceho) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_iceho, ICEHO, start = (/ 1, IPASS/), & + count = (/ NOPTS, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_ICEFO, v_icefo) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_icefo, ICEFO, start = (/ 1, IPASS/), & + count = (/ NOPTS, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_GRDID, v_grdid) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_grdid, GRDID, start = (/ 1, 1, IPASS/), & + count = (/ 13, nopts, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_SPCO, v_spco) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_spco, SPCO, start = (/ 1, 1, IPASS/), & + count = (/nspec, nopts, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + + ELSE + ! Set flag to indicate IPASS > d_time_len + ! and are at the end of the + IOTST = -1 + END IF + + ! Close the file. + ncerr = nf90_close(fh) + if (nf90_err(ncerr) .ne. 0) return + +902 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOPON :'/ & + ' ILEGAL IDSTR, READ : ',A/ & + ' CHECK : ',A/) +903 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOPON :'/ & + ' ILEGAL VEROPT, READ : ',A/ & + ' CHECK : ',A/) +904 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOPO :'/ & + ' ERROR IN SPECTRA, MK, MTH : ',2I8/ & + ' ARRAY DIMENSIONS : ',2I8/) + + + END SUBROUTINE W3IOPON_READ + + !/ ------------------------------------------------------------------- / + !> + !> @brief Write point output in netCDF format. + !> + !> @param[in] filename Name of file to write. + !> @param[in] timestep_only Will be 0 if whole model run should be + !> written, 1 if only one timestep should be written. + !> @param[inout] ncerr Error code, 0 for success, netCDF error code + !> otherwise. + !> + !> @author Edward Hartnett @date 1-Nov-2023 + !> + SUBROUTINE W3IOPON_WRITE(timestep_only,filename, ncerr) + USE NETCDF + USE W3GDATMD, ONLY: NTH, NK, NSPEC + USE W3WDATMD, ONLY: TIME + USE W3ODATMD, ONLY: NDST, NDSE, IPASS => IPASS2, NOPTS, IPTINT, & + PTLOC, PTIFAC, DPO, WAO, WDO, & + ASO, CAO, CDO, SPCO, PTNME, O2INIT, FNMPRE, & + GRDID, ICEO, ICEHO, ICEFO +#ifdef W3_FLX5 + USE W3ODATMD, ONLY: TAUAO, TAUDO, DAIRO +#endif +#ifdef W3_SETUP + USE W3ODATMD, ONLY: ZET_SETO +#endif + + IMPLICIT NONE + integer, intent(in) :: timestep_only ! 1 if only timestep should be written. + character(*), intent(in) :: filename + integer, intent(inout) :: ncerr + integer :: ndim, nvar, fmt, itime, fh + integer :: d_nopts, d_nspec, d_vsize, d_namelen, d_grdidlen, d_time + integer :: v_idtst, v_vertst, v_nk, v_nth, v_ptloc, v_ptnme, v_time + integer :: v_dpo, v_wao, v_wdo +#ifdef W3_FLX5 + integer :: v_tauao, v_taudo, v_dairo +#endif +#ifdef W3_SETUP + integer :: v_zet_seto +#endif + integer :: v_aso, v_cao, v_cdo, v_iceo + integer :: v_iceho, v_icefo, v_grdid, v_spco + + + !If first pass, or if you are writting a file for every time-step: + IF ( IPASS.EQ.1 .OR. timestep_only.EQ.1 ) THEN + ! Create the netCDF file. + ncerr = nf90_create(filename, NF90_NETCDF4, fh) + if (nf90_err(ncerr) .ne. 0) return + + ! Define dimensions. + ncerr = nf90_def_dim(fh, DNAME_NOPTS, NOPTS, d_nopts) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_dim(fh, DNAME_NSPEC, NSPEC, d_nspec) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_dim(fh, DNAME_VSIZE, 2, d_vsize) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_dim(fh, DNAME_NAMELEN, 40, d_namelen) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_dim(fh, DNAME_GRDIDLEN, 13, d_grdidlen) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_dim(fh, DNAME_TIME, NF90_UNLIMITED, d_time) + if (nf90_err(ncerr) .ne. 0) return + + ! Define global attributes. + ncerr = nf90_put_att(fh, NF90_GLOBAL, 'title', IDSTR) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_put_att(fh, NF90_GLOBAL, 'version', VEROPT) + if (nf90_err(ncerr) .ne. 0) return + + ! Define scalar variables. + ncerr = nf90_def_var(fh, VNAME_NK, NF90_INT, v_nk) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_var(fh, VNAME_NTH, NF90_INT, v_nth) + if (nf90_err(ncerr) .ne. 0) return + + ! Define vars with nopts as a dimension. Point location and name + ncerr = nf90_def_var(fh, VNAME_PTLOC, NF90_FLOAT, (/d_vsize, d_nopts/), v_ptloc) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_var(fh, VNAME_PTNME, NF90_CHAR, (/d_namelen, d_nopts/), v_ptnme) + if (nf90_err(ncerr) .ne. 0) return + + ! Define time for each time step + ncerr = nf90_def_var(fh, VNAME_TIME, NF90_INT, (/d_vsize, d_time/),v_time) + if (nf90_err(ncerr) .ne. 0) return + + ! Define vars with nopts and time as dimensions + ncerr = nf90_def_var(fh, VNAME_DPO, NF90_FLOAT, (/d_nopts, d_time/), v_dpo) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_var(fh, VNAME_WAO, NF90_FLOAT, (/d_nopts, d_time/), v_wao) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_var(fh, VNAME_WDO, NF90_FLOAT, (/d_nopts, d_time/), v_wdo) + if (nf90_err(ncerr) .ne. 0) return +#ifdef W3_FLX5 + ncerr = nf90_def_var(fh, VNAME_TAUAO, NF90_FLOAT, (/d_nopts, d_time/), v_tauao) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_var(fh, VNAME_TAUDO, NF90_FLOAT, (/d_nopts, d_time/), v_taudo) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_var(fh, VNAME_DAIRO, NF90_FLOAT, (/d_nopts, d_time/), v_dairo) + if (nf90_err(ncerr) .ne. 0) return +#endif +#ifdef W3_SETUP + ncerr = nf90_def_var(fh, VNAME_ZET_SETO, NF90_FLOAT, (/d_nopts, d_time/), v_zet_seto) + if (nf90_err(ncerr) .ne. 0) return +#endif + ncerr = nf90_def_var(fh, VNAME_ASO, NF90_FLOAT, (/d_nopts, d_time/), v_aso) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_var(fh, VNAME_CAO, NF90_FLOAT, (/d_nopts, d_time/), v_cao) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_var(fh, VNAME_CDO, NF90_FLOAT, (/d_nopts, d_time/), v_cdo) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_var(fh, VNAME_ICEO, NF90_FLOAT, (/d_nopts, d_time/), v_iceo) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_var(fh, VNAME_ICEHO, NF90_FLOAT, (/d_nopts, d_time/), v_iceho) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_var(fh, VNAME_ICEFO, NF90_FLOAT, (/d_nopts, d_time/), v_icefo) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_var(fh, VNAME_GRDID, NF90_CHAR, (/d_grdidlen, d_nopts, d_time/), v_grdid) + if (nf90_err(ncerr) .ne. 0) return + + ! Define spectral output with dimensions nspec, nopts and time + ncerr = nf90_def_var(fh, VNAME_SPCO, NF90_FLOAT, (/d_nspec, d_nopts, d_time/), v_spco) + if (nf90_err(ncerr) .ne. 0) return + + ! End of all variable definitions + ncerr = nf90_enddef(fh) + if (nf90_err(ncerr) .ne. 0) return + + ! Write the scalar data. + ncerr = nf90_put_var(fh, v_nk, NK) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_put_var(fh, v_nth, NTH) + if (nf90_err(ncerr) .ne. 0) return + + ! Write the data with NOPTS as a dimension. (no time dimension) + if (associated(PTLOC)) then + ncerr = nf90_put_var(fh, v_ptloc, PTLOC(:,1:NOPTS)) + if (nf90_err(ncerr) .ne. 0) return + endif + if (associated(PTNME)) then + ncerr = nf90_put_var(fh, v_ptnme, PTNME(1:NOPTS)) + if (nf90_err(ncerr) .ne. 0) return + endif + + ELSE + ! If we are writing to the same file, re-open the file + ncerr = nf90_open(filename, nf90_write, fh) + if (nf90_err(ncerr) .ne. 0) return + END IF + + !Determine the start for the time dimension + IF ( timestep_only.EQ.1 ) THEN + itime=1 + ELSE + itime=IPASS + END IF + + ! Write Time + IF ( itime > 1 ) THEN + ncerr = nf90_inq_varid(fh, VNAME_TIME, v_time) + if (nf90_err(ncerr) .ne. 0) return + END IF + ncerr = nf90_put_var(fh, v_time, TIME, start = (/ 1, itime/), & + count = (/ 2, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + + ! If itime > 1 need to inquire varid + IF ( itime > 1 ) THEN + ncerr = nf90_inq_varid(fh, VNAME_DPO, v_dpo) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_WAO, v_wao) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_WDO, v_wdo) + if (nf90_err(ncerr) .ne. 0) return +#ifdef W3_FLX5 + ncerr = nf90_inq_varid(fh, VNAME_TAUAO, v_tauao) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_TAUDO, v_taudo) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_DAIRO, v_dairo) + if (nf90_err(ncerr) .ne. 0) return +#endif +#ifdef W3_SETUP + ncerr = nf90_inq_varid(fh, VNAME_ZET_SETO, v_zet_seto) + if (nf90_err(ncerr) .ne. 0) return +#endif + ncerr = nf90_inq_varid(fh, VNAME_ASO, v_aso) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_CAO, v_cao) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_CDO, v_cdo) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_ICEO, v_iceo) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_ICEHO, v_iceho) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_ICEFO, v_icefo) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_GRDID, v_grdid) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_SPCO, v_spco) + if (nf90_err(ncerr) .ne. 0) return + END IF + + ncerr = nf90_put_var(fh, v_dpo, DPO, start = (/ 1, itime/), & + count = (/ nopts, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + + ncerr = nf90_put_var(fh, v_wao, WAO, start = (/ 1, itime/), & + count = (/ nopts, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + + ncerr = nf90_put_var(fh, v_wdo, WDO, start = (/ 1, itime/), & + count = (/ nopts, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + +#ifdef W3_FLX5 + ncerr = nf90_put_var(fh, v_tauao, TAUAO, start = (/ 1, itime/), & + count = (/ nopts, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + + ncerr = nf90_put_var(fh, v_taudo, TAUDO, start = (/ 1, itime/), & + count = (/ nopts, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + + ncerr = nf90_put_var(fh, v_dairo, DAIRO, start = (/ 1, itime/), & + count = (/ nopts, 1 /)) + if (nf90_err(ncerr) .ne. 0) return +#endif +#ifdef W3_SETUP + ncerr = nf90_put_var(fh, v_zet_seto, ZET_SETO, start = (/ 1, itime/), & + count = (/ nopts, 1 /)) + if (nf90_err(ncerr) .ne. 0) return +#endif + ncerr = nf90_put_var(fh, v_aso, ASO, start = (/ 1, itime/), & + count = (/ nopts, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + + ncerr = nf90_put_var(fh, v_cao, CAO, start = (/ 1, itime/), & + count = (/ nopts, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + + ncerr = nf90_put_var(fh, v_cdo, CDO, start = (/ 1, itime/), & + count = (/ nopts, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + + ncerr = nf90_put_var(fh, v_iceo, ICEO, start = (/ 1, itime/), & + count = (/ nopts, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + + ncerr = nf90_put_var(fh, v_iceho, ICEHO, start = (/ 1, itime/), & + count = (/ nopts, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + + ncerr = nf90_put_var(fh, v_icefo, ICEFO, start = (/ 1, itime/), & + count = (/ nopts, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + + ncerr = nf90_put_var(fh, v_grdid, GRDID, start = (/ 1, 1, itime/), & + count = (/ 13, nopts, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + + !write spectral output + ncerr = nf90_put_var(fh, v_spco, SPCO, start = (/ 1, 1, itime/), & + count = (/nspec, nopts, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + + ! Close the file. + ncerr = nf90_close(fh) + if (nf90_err(ncerr) .ne. 0) return + + END SUBROUTINE W3IOPON_WRITE + + !> Read or write the netCDF point output file, + !> depending on the value of the first parameter. + !> + !> When reading, the entire file is read with one call to this + !> subroutine. + !> + !> 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. + !> + !> @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. + !> + !> @author Edward Hartnett @date 1-Nov-2023 + SUBROUTINE W3IOPON ( INXOUT, NDSOP, IOTST, IMOD) + USE W3GDATMD, ONLY: W3SETG + USE W3WDATMD, ONLY: W3SETW + USE W3ODATMD, ONLY: W3SETO + USE W3GDATMD, ONLY: FILEXT + USE W3WDATMD, ONLY: TIME + USE W3ODATMD, ONLY: NDST, NDSE, IPASS => IPASS2, FNMPRE + USE W3ODATMD, ONLY: OFILES + USE W3SERVMD, ONLY: EXTCDE +#ifdef W3_S + USE W3SERVMD, ONLY: STRACE +#endif + use netcdf + IMPLICIT NONE + + CHARACTER, INTENT(IN) :: INXOUT*(*) + INTEGER, INTENT(IN) :: NDSOP + INTEGER, INTENT(OUT) :: IOTST + INTEGER, INTENT(IN), OPTIONAL :: IMOD + + CHARACTER(LEN=15) :: TIMETAG + INTEGER :: IGRD + character(len = 124) :: filename + integer :: ncerr + +#ifdef W3_S + CALL STRACE (IENT, 'W3IOPON') +#endif + + ! IPASS essentially is the time variable dimension + IPASS = IPASS + 1 + + ! Optimistically assume success. + IOTST = 0 + + ! Has a model number been specified? + IF (PRESENT(IMOD)) THEN + IGRD = IMOD + ELSE + IGRD = 1 + END IF + + CALL W3SETO(IGRD, NDSE, NDST) + CALL W3SETG(IGRD, NDSE, NDST) + CALL W3SETW(IGRD, NDSE, NDST) + + ! INXOUT must be 'READ' or 'WRITE'. + IF (INXOUT .NE. 'READ' .AND. INXOUT .NE. 'WRITE') THEN + WRITE (NDSE, 900) INXOUT + CALL EXTCDE(1) + END IF + + ! Determine filename. + filename = '' + IF ( OFILES(2) .EQ. 1 ) THEN + ! Create TIMETAG for file name using YYYYMMDD.HHMMS prefix + WRITE(TIMETAG,"(i8.8,'.'i6.6)")TIME(1),TIME(2) + filename = transfer(FNMPRE(:LEN_TRIM(FNMPRE))//TIMETAG//'out_pnt.'//FILEXT(:LEN_TRIM(FILEXT))//'.nc', filename) + ELSE + filename = transfer(FNMPRE(:LEN_TRIM(FNMPRE))//'out_pnt.'//FILEXT(:LEN_TRIM(FILEXT))//'.nc', filename) + END IF + + ! Do a read or a write of the point file. + IF (INXOUT .EQ. 'READ') THEN + CALL W3IOPON_READ(IOTST, IMOD, filename, ncerr) + ELSE + CALL W3IOPON_WRITE(OFILES(2), filename, ncerr) + ENDIF + if (nf90_err(ncerr) .ne. 0) then + WRITE(NDSE,*) ' *** WAVEWATCH III ERROR IN W3IOPO :' + WRITE(NDSE,*) 'Nonzero return at end of W3IOPON' + WRITE(NDSE,*) 'Error: ', trim(nf90_strerror(ncerr)) + CALL EXTCDE(21) + endif + + !/ + !/ End of W3IOPON ----------------------------------------------------- / + !/ + +900 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOPO :'/ & + ' ILEGAL INXOUT VALUE: ',A/) + END SUBROUTINE W3IOPON + + !/ ------------------------------------------------------------------- / !> Read or write point output. !> !> This subroutine can either read or write the point output file, @@ -1045,12 +1801,12 @@ END SUBROUTINE W3IOPE !> -------------|------|----------|-------- !> 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 | NK | Number of discrete wavenumbers + !> 4 | integer | NTH | Number of discrete directions. !> 4 | integer | NOPTS | Number of output points. - !> 8*NOPTS | integer(2,NOPTS) | PTLOC | Point locations + !> 8*NOPTS | real(2,NOPTS) | PTLOC | Point locations !> 7*NOPTS | character*7 | PTNME | Point names - !> 8 | integer(2) | TIME | Time + !> 8 | integer(2) | TIME | Valid time !> reclen*NOPTS | * | * | records !> !> Each record contains: @@ -1088,7 +1844,9 @@ END SUBROUTINE W3IOPE !> !> @param[in] INXOUT String indicating read/write. Must be 'READ' or !> 'WRITE'. - !> @param[in] NDSOP File unit number. + !> @param[in] NDSOP This is set by this subroutine to the netCDF + !> file ID (ncid) of the opened file. User does not have to + !> initialize this value, and should not change it. !> @param[out] IOTST Error code: !> - 0 No error. !> - -1 Unexpected end of file when reading. @@ -1254,7 +2012,7 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD & CALL EXTCDE ( 1 ) END IF ! - ! IF ( IPASS.EQ.1 ) THEN + ! First pass to this file and we are only writing 1 file for all time IF ( IPASS.EQ.1 .AND. OFILES(2) .EQ. 0) THEN WRITE = INXOUT.EQ.'WRITE' ELSE @@ -1267,10 +2025,10 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD & ! open file ---------------------------------------------------------- * ! IF ( IPASS.EQ.1 .AND. OFILES(2) .EQ. 0 ) THEN - ! + I = LEN_TRIM(FILEXT) J = LEN_TRIM(FNMPRE) - ! + #ifdef W3_T WRITE (NDST,9001) FNMPRE(:J)//'out_pnt.'//FILEXT(:I) #endif @@ -1389,7 +2147,7 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD & ! IF ( WRITE ) THEN WRITE (NDSOP) & - IDSTR, VEROPT, NK, NTH, NOPTS + IDSTR, VEROPT, NK, NTH, NOPTS #ifdef W3_ASCII WRITE (NDSOA,*) & 'IDSTR, VEROPT, NK, NTH, NOPTS:', & @@ -1495,7 +2253,7 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD & #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):', & ICEFO(I), GRDID(I), (SPCO(J,I),J=1,NSPEC) #endif ELSE diff --git a/model/src/w3wavemd.F90 b/model/src/w3wavemd.F90 index c144ab8d8..e8c7112e8 100644 --- a/model/src/w3wavemd.F90 +++ b/model/src/w3wavemd.F90 @@ -442,6 +442,8 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & USE W3IOGRMD USE W3IOGOMD USE W3IOPOMD + USE netcdf + !!!MTM USE W3IOTRMD USE W3IORSMD USE W3IOBCMD @@ -2601,10 +2603,10 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! Gets the necessary spectral data ! CALL W3IOPE ( VA ) - CALL W3IOPO ( 'WRITE', NDS(8), ITEST, IMOD & -#ifdef W3_ASCII - ,NDS(15) & -#endif + CALL W3IOPON ( 'WRITE', NDS(8), ITEST, IMOD & +!#ifdef W3_ASCII +! ,NDS(15) & +!#endif ) END IF ! diff --git a/model/src/wmiopomd.F90 b/model/src/wmiopomd.F90 index 73e036535..6de789165 100644 --- a/model/src/wmiopomd.F90 +++ b/model/src/wmiopomd.F90 @@ -714,7 +714,9 @@ SUBROUTINE WMIOPO ( TOUT ) USE W3ODATMD, ONLY: W3SETO USE WMMDATMD, ONLY: WMSETM USE W3CSPCMD, ONLY: W3CSPC - USE W3IOPOMD, ONLY: W3IOPO + USE W3IOPOMD + USE netcdf + !!! MTM ! USE W3GDATMD, ONLY: NK, NTH, NSPEC, XFR, FR1, TH, SGRDS USE W3WDATMD, ONLY: TIME @@ -1176,9 +1178,9 @@ SUBROUTINE WMIOPO ( TOUT ) ! TIME = TOUT ! - CALL W3IOPO ( 'WRITE', MDSUP, II, 0 & + CALL W3IOPON ( 'WRITE', MDSUP, II, 0 & #ifdef W3_ASCII - ,MDSUPA & + ,MDSUPA & #endif ) ! diff --git a/model/src/ww3_ounp.F90 b/model/src/ww3_ounp.F90 index c35ff6e98..68426d004 100644 --- a/model/src/ww3_ounp.F90 +++ b/model/src/ww3_ounp.F90 @@ -184,7 +184,9 @@ PROGRAM W3OUNP USE W3ODATMD, ONLY: W3SETO, W3NOUT USE W3ODATMD, ONLY: IAPROC, NAPROC, NAPERR, NAPOUT, DIMP USE W3IOGRMD, ONLY: W3IOGR - USE W3IOPOMD, ONLY: W3IOPO + USE W3IOPOMD + USE netcdf + !!!MTM USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE, STRSPLIT #ifdef W3_S USE W3SERVMD, ONLY : STRACE @@ -387,7 +389,7 @@ PROGRAM W3OUNP !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 3. Read general data and first fields from file ! - CALL W3IOPO ( 'READ', NDSOP, IOTEST ) + CALL W3IOPON ( 'READ', NDSOP, IOTEST ) ! IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,930) DO I=1, NOPTS @@ -604,7 +606,7 @@ PROGRAM W3OUNP DO WHILE (DTEST.NE.0) DTEST = DSEC21 ( TIME , TOUT ) IF ( DTEST .GT. 0. ) THEN - CALL W3IOPO ( 'READ', NDSOP, IOTEST ) + CALL W3IOPON ( 'READ', NDSOP, IOTEST ) IF ( IOTEST .EQ. -1 ) THEN IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,949) GOTO 888 @@ -1070,7 +1072,7 @@ PROGRAM W3OUNP DTEST = DSEC21 ( TIME , TOUT ) IF ( DTEST .GT. 0. ) THEN ! reads TIME from out_pnt.ww3 - CALL W3IOPO ( 'READ', NDSOP, IOTEST ) + CALL W3IOPON ( 'READ', NDSOP, IOTEST ) IF ( IOTEST .EQ. -1 ) THEN IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,949) GOTO 700 @@ -1215,7 +1217,7 @@ PROGRAM W3OUNP ! 7.3 Reinitiazes TIME (close open out_pnt.ww3) and TOUT to process a new bunch of stations CLOSE(NDSOP) ! closes binary file out_pnt* IPASS = 0 ! resets time counter for binary file out_pnt* - CALL W3IOPO ( 'READ', NDSOP, IOTEST ) + CALL W3IOPON ( 'READ', NDSOP, IOTEST ) #ifdef W3_T WRITE(NDSE,*) 'out_pnt* closed and reopened' #endif @@ -1228,7 +1230,7 @@ PROGRAM W3OUNP DO WHILE (DTEST.NE.0) DTEST = DSEC21 ( TIME , TOUT ) IF ( DTEST .GT. 0. ) THEN - CALL W3IOPO ( 'READ', NDSOP, IOTEST ) + CALL W3IOPON ( 'READ', NDSOP, IOTEST ) IF ( IOTEST .EQ. -1 ) THEN IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,949) GOTO 700 diff --git a/model/src/ww3_outp.F90 b/model/src/ww3_outp.F90 index 6d750687a..8313f3516 100644 --- a/model/src/ww3_outp.F90 +++ b/model/src/ww3_outp.F90 @@ -208,7 +208,11 @@ PROGRAM W3OUTP #endif USE W3ODATMD, ONLY: W3SETO, W3NOUT USE W3IOGRMD, ONLY: W3IOGR - USE W3IOPOMD, ONLY: W3IOPO + !!!MTM + !!! USE W3IOPOMD, ONLY: W3IOPO + USE W3IOPOMD, ONLY: W3IOPO, W3IOPON, W3IOPON_READ, W3IOPON_WRITE + USE netcdf + !!!MTM USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE #ifdef W3_S USE W3SERVMD, ONLY : STRACE @@ -359,7 +363,9 @@ PROGRAM W3OUTP !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 3. Read general data and first fields from file ! - CALL W3IOPO ( 'READ', NDSOP, IOTEST ) + !!!MTM + !!!CALL W3IOPO ( 'READ', NDSOP, IOTEST ) + CALL W3IOPON ( 'READ', NDSOP, IOTEST ) ! WRITE (NDSO,930) DO I=1, NOPTS @@ -457,7 +463,9 @@ PROGRAM W3OUTP DO CALL STME21 ( TIME , IDTIME ) WRITE (NDSO,948) IDTIME - CALL W3IOPO ( 'READ', NDSOP, IOTEST ) + !!!MTM + !!! CALL W3IOPO ( 'READ', NDSOP, IOTEST ) + CALL W3IOPON ( 'READ', NDSOP, IOTEST ) IF ( IOTEST .EQ. -1 ) THEN WRITE (NDSO,949) GOTO 888 @@ -777,7 +785,9 @@ PROGRAM W3OUTP DO DTEST = DSEC21 ( TIME , TOUT ) IF ( DTEST .GT. 0. ) THEN - CALL W3IOPO ( 'READ', NDSOP, IOTEST ) + !!!MTM + !!! CALL W3IOPO ( 'READ', NDSOP, IOTEST ) + CALL W3IOPON ( 'READ', NDSOP, IOTEST ) IF ( IOTEST .EQ. -1 ) THEN WRITE (NDSO,949) EXIT diff --git a/regtests/unittests/CMakeLists.txt b/regtests/unittests/CMakeLists.txt index 69445bfb7..1d3d81f60 100644 --- a/regtests/unittests/CMakeLists.txt +++ b/regtests/unittests/CMakeLists.txt @@ -24,16 +24,25 @@ endfunction() # Function to build and run a test. function(unit_test name) - add_executable(${name} ${name}.F90) + add_executable(${name} ${name}.F90 ww3_unittest_util.F90) target_link_libraries(${name} PRIVATE ww3_lib) add_test(NAME ${name} COMMAND ${name}) endfunction() +# The binary file mod_def.ww3 is needed for testing. It's created by +# the ww3_grid utility. +#add_custom_target(create_mod_def TEST ../../bin/ww3_grid +# COMMENT "Creating mod_def.ww3 file for testing") + # 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) +unit_test(test_io) +unit_test(test_io2) +unit_test(test_io3) +unit_test(test_io_restart_bin) diff --git a/regtests/unittests/test_io.F90 b/regtests/unittests/test_io.F90 new file mode 100644 index 000000000..ebe4e2385 --- /dev/null +++ b/regtests/unittests/test_io.F90 @@ -0,0 +1,117 @@ +! This is a test for model IO for WW3. +! +! Ed Hartnett 10/14/23 +program test_io + use w3iopomd + use w3gdatmd + use w3wdatmd + use w3odatmd + use w3iogrmd + use w3adatmd + implicit none + + integer, target :: i, j, k, l + integer :: ndsop, iotest, imod, ndstst, ierr, ndsbul, ndsm + integer :: ndstrc, ntrace + real :: m2km + character*7 expected_ptnme + character*6 my_fmt + real :: expected_loc_1 + integer :: write_test_file + + print *, 'Testing WW3 netCDF 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 + imod = 1 + + write (ndso,900) +900 FORMAT (/15X,' *** WAVEWATCH III Point output post.*** '/ & + 15X,'==============================================='/) + + ! Open the file with the output settings for WW3. It is not needed actually. + ! open(ndsi, file = 'ww3_outp.inp', status='old', iostat = ierr) + ! if (ierr .ne. 0) stop 10 + + ! Create a point output file needed for this test. + print *, 'Creating point output test file for this test...' + if (write_test_file() .ne. 0) stop 1 + + ! 2. Read model definition file. + CALL W3IOGR('READ', NDSM) + WRITE (NDSO,920) GNAME +920 FORMAT (' Grid name : ',A/) + + ! IF (FLAGLL) THEN + ! M2KM = 1. + ! ELSE + ! M2KM = 1.E-3 + ! END IF + + ! Read the file out_pnt.ww3 from the model/tests/data directory. + print *, 'OK!' + print *, 'Reading the point output test file for this test...' + 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 *, 'initializing some data...' + ipass2 = 0 + do i = 1, nopts + do j = 1, nspec + spco(j, i) = 0.0 + end do + end do + + print *, 'OK!' + print *, 'testing writing the WW3 binary point file in netCDF...' + + ! Write in netCDF. + call w3iopon('WRITE', ndsop, iotest, imod) + if (iotest .ne. 0) stop 100 + print *, 'OK!' + + print *, 'testing reading the WW3 binary point file in netCDF...' + ipass2 = 0 + call w3iopon('READ', ndsop, iotest, imod) + print *, iotest + if (iotest .ne. 0) stop 100 + print *, 'OK!' + + print *, 'OK!' + + print *, 'SUCCESS!' +end program test_io + diff --git a/regtests/unittests/test_io2.F90 b/regtests/unittests/test_io2.F90 new file mode 100644 index 000000000..b7fe5092d --- /dev/null +++ b/regtests/unittests/test_io2.F90 @@ -0,0 +1,123 @@ +! This is a test for model IO for WW3. +! +! Ed Hartnett 10/14/23 +program test_io2 + use w3iopomd + use w3gdatmd + use w3wdatmd + use w3odatmd + use w3iogrmd + use w3adatmd + implicit none + + integer, target :: i, j, k, l + integer :: ndsop, iotest, imod, ndstst, ierr, ndsbul, ndsm + integer :: ndstrc, ntrace + real :: m2km + character*7 expected_ptnme + character*6 my_fmt + real :: expected_loc_1 + integer :: write_test_file + + print *, 'Testing WW3 netCDF point file code some more.' + + ! 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 + imod = 1 + + write (ndso,900) +900 FORMAT (/15X,' *** WAVEWATCH III Point output post.*** '/ & + 15X,'==============================================='/) + + ! Open the file with the output settings for WW3. It is not needed actually. + ! open(ndsi, file = 'ww3_outp.inp', status='old', iostat = ierr) + ! if (ierr .ne. 0) stop 10 + + ! Create a point output file needed for this test. + print *, 'Creating point output test file for this test...' + if (write_test_file() .ne. 0) stop 1 + + ! 2. Read model definition file. + CALL W3IOGR('READ', NDSM) + WRITE (NDSO,920) GNAME +920 FORMAT (' Grid name : ',A/) + + ! IF (FLAGLL) THEN + ! M2KM = 1. + ! ELSE + ! M2KM = 1.E-3 + ! END IF + + ! Read the file out_pnt.ww3 from the model/tests/data directory. + print *, 'OK!' + print *, 'Reading the point output test file for this test...' + 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 *, 'initializing some data...' + ipass2 = 0 + do i = 1, nopts + do j = 1, nspec + spco(j, i) = 0.0 + end do + end do + + print *, 'OK!' + print *, 'testing writing the WW3 binary point file in netCDF...' + + ! Write in netCDF. + ofiles(2) = 1 + call w3iopon('WRITE', ndsop, iotest, imod) + if (iotest .ne. 0) stop 100 + print *, 'OK!' + + ! Another timestep in netCDF. + call w3iopon('WRITE', ndsop, iotest, imod) + if (iotest .ne. 0) stop 100 + print *, 'OK!' + + print *, 'testing reading the WW3 binary point file in netCDF...' + ipass2 = 0 + call w3iopon('READ', ndsop, iotest) + print *, iotest + if (iotest .ne. 0) stop 100 + print *, 'OK!' + + print *, 'OK!' + + print *, 'SUCCESS!' +end program test_io2 + diff --git a/regtests/unittests/test_io3.F90 b/regtests/unittests/test_io3.F90 new file mode 100644 index 000000000..b5f65849c --- /dev/null +++ b/regtests/unittests/test_io3.F90 @@ -0,0 +1,110 @@ +! This is a test for model IO for WW3. +! +! Ed Hartnett 10/14/23 +program test_io3 + use w3iopomd + use w3gdatmd + use w3wdatmd + use w3odatmd + use w3iogrmd + use w3adatmd + implicit none + + integer, target :: i, j, k, l + integer :: ndsop, iotest, imod, ndstst, ierr, ndsbul, ndsm + integer :: ndstrc, ntrace + real :: m2km + character*7 expected_ptnme + character*6 my_fmt + real :: expected_loc_1 + integer :: write_test_file + + print *, 'Testing WW3 netCDF point file code even more.' + + ! 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) + + nth = 4 + ndsm = 20 + ndsop = 20 + ndsbul = 0 + ndstrc = 6 + ntrace = 10 + imod = 1 + + ! 2. Read model definition file. + CALL W3IOGR('READ', NDSM) + WRITE (NDSO,920) GNAME +920 FORMAT (' Grid name : ',A/) + + ! Create a point output file needed for this test. + print *, 'Creating point output test file for this test...' + if (write_test_file() .ne. 0) stop 1 + + ! Read the file out_pnt.ww3 from the model/tests/data directory. + ! print *, 'OK!' + ! print *, 'Reading the point output test file for this test...' + 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 *, 'initializing some data...' + ipass2 = 0 + do i = 1, nopts + do j = 1, nspec + spco(j, i) = 0.0 + end do + end do + + print *, 'OK!' + print *, 'testing writing the WW3 binary point file in netCDF...' + + ! ! Write in netCDF. + ! ofiles(2) = 1 + ! call w3iopon('WRITE', ndsop, iotest, imod) + ! if (iotest .ne. 0) stop 100 + ! print *, 'OK!' + + ! ! Another timestep in netCDF. + ! call w3iopon('WRITE', ndsop, iotest, imod) + ! if (iotest .ne. 0) stop 100 + ! print *, 'OK!' + + print *, 'testing reading the WW3 binary point file in netCDF...' + ipass2 = 0 + call w3iopon('READ', ndsop, iotest) + print *, iotest + if (iotest .ne. 0) stop 100 + print *, 'OK!' + + print *, 'OK!' + + print *, 'SUCCESS!' +end program test_io3 + diff --git a/regtests/unittests/test_io_points_bin.F90 b/regtests/unittests/test_io_points_bin.F90 index 69c197bce..4093b24ba 100644 --- a/regtests/unittests/test_io_points_bin.F90 +++ b/regtests/unittests/test_io_points_bin.F90 @@ -79,74 +79,3 @@ program test_io_points_bin 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/unittests/test_io_restart_bin.F90 b/regtests/unittests/test_io_restart_bin.F90 new file mode 100644 index 000000000..026e8d3d2 --- /dev/null +++ b/regtests/unittests/test_io_restart_bin.F90 @@ -0,0 +1,59 @@ +! This is a test for model IO for WW3. This tests the legacy (binary) +! output of restart data, done by function W3IORS(). +! +! Ed Hartnett 1/13/24 +program test_io_restart_bin + use w3iorsmd + 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 :: ndsr = 11 +! real :: dumfpi = 99.9 + +! print *, 'Testing WW3 binary restart 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 + +! 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/) + +! ! Read the file out_pnt.ww3 from the model/tests/data directory. +! call w3iors('HOT', ndsr, dumfpi) +! if (iotest .ne. 0) stop 10 +! close(ndsop) + + + print *, 'OK!' + print *, 'SUCCESS!' +end program test_io_restart_bin + diff --git a/regtests/unittests/ww3_unittest_util.F90 b/regtests/unittests/ww3_unittest_util.F90 new file mode 100644 index 000000000..fe20ddb30 --- /dev/null +++ b/regtests/unittests/ww3_unittest_util.F90 @@ -0,0 +1,75 @@ +! This is test code for the WW3 I/O unit tests. +! +! This file holds a function used by multiple tests. +! +! Ed Hartnett, 1/11/24 +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 +