diff --git a/.github/workflows/gnu.yml b/.github/workflows/gnu.yml index f44498d0ce..df920ec4fd 100644 --- a/.github/workflows/gnu.yml +++ b/.github/workflows/gnu.yml @@ -1,14 +1,20 @@ name: GNU Linux Build on: [push, pull_request] +# 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: gnu4 + cache_key: gnu5 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 +# 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: @@ -16,6 +22,11 @@ jobs: runs-on: ubuntu-20.04 steps: + - name: checkout-ww3 + if: steps.cache-env.outputs.cache-hit != 'true' + uses: actions/checkout@v2 + with: + path: ww3 # Cache spack, OASIS, and compiler # No way to flush Action cache, so key may have # appended - name: cache-env @@ -26,13 +37,7 @@ jobs: spack ~/.spack work_oasis3-mct - key: spack-${{ runner.os }}-${{ env.cache_key }} - - - name: checkout-ww3 - if: steps.cache-env.outputs.cache-hit != 'true' - uses: actions/checkout@v2 - with: - path: ww3 + key: spack-${{ runner.os }}-${{ env.cache_key }}-${{ hashFiles('ww3/model/ci/spack.yaml') }} # Build WW3 spack environment - name: install-dependencies-with-spack @@ -72,7 +77,7 @@ jobs: steps: - name: checkout-ww3 uses: actions/checkout@v2 - with: + with: path: ww3 - name: cache-env @@ -83,7 +88,7 @@ jobs: spack ~/.spack work_oasis3-mct - key: spack-${{ runner.os }}-${{ env.cache_key }} + key: spack-${{ runner.os }}-${{ env.cache_key }}-${{ hashFiles('ww3/model/ci/spack.yaml') }} - name: build-ww3 run: | @@ -102,5 +107,3 @@ jobs: cmake .. -DSWITCH=${{ matrix.switch }} fi make -j2 VERBOSE=1 - - diff --git a/.github/workflows/intel.yml b/.github/workflows/intel.yml index 7c63d28c32..eec7697aea 100644 --- a/.github/workflows/intel.yml +++ b/.github/workflows/intel.yml @@ -1,6 +1,11 @@ name: Intel Linux Build on: [push, pull_request] +# Cancel in-progress workflows when pushing to a branch +concurrency: + group: ${{ github.workflow }}-${{ github.event.pull_request.number || github.ref }} + cancel-in-progress: true + # Use custom shell with -l so .bash_profile is sourced which loads intel/oneapi/setvars.sh # without having to do it in manually every step defaults: @@ -9,7 +14,7 @@ defaults: # Set I_MPI_CC/F90 so Intel MPI wrapper uses icc/ifort instead of gcc/gfortran env: - cache_key: intel5 + cache_key: intel6 CC: icc FC: ifort CXX: icpc @@ -17,7 +22,7 @@ env: I_MPI_F90: ifort # Split into a dependency build step, and a WW3 build step which -# builds multiple switches in a matrix. The setup is run once and +# 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: @@ -25,6 +30,13 @@ jobs: runs-on: ubuntu-latest steps: + + - name: checkout-ww3 + if: steps.cache-env.outputs.cache-hit != 'true' + uses: actions/checkout@v2 + with: + path: ww3 + # Cache spack, OASIS, and compiler # No way to flush Action cache, so key may have # appended - name: cache-env @@ -36,7 +48,7 @@ jobs: ~/.spack work_oasis3-mct /opt/intel - key: spack-${{ runner.os }}-${{ env.cache_key }} + key: spack-${{ runner.os }}-${{ env.cache_key }}-${{ hashFiles('ww3/model/ci/spack.yaml') }} - name: install-intel-compilers if: steps.cache-env.outputs.cache-hit != 'true' @@ -48,12 +60,6 @@ jobs: sudo apt-get install intel-oneapi-dev-utilities intel-oneapi-mpi-devel intel-oneapi-openmp intel-oneapi-compiler-fortran intel-oneapi-compiler-dpcpp-cpp-and-cpp-classic echo "source /opt/intel/oneapi/setvars.sh" >> ~/.bash_profile - - name: checkout-ww3 - if: steps.cache-env.outputs.cache-hit != 'true' - uses: actions/checkout@v2 - with: - path: ww3 - # Build WW3 spack environment - name: install-dependencies-with-spack if: steps.cache-env.outputs.cache-hit != 'true' @@ -92,7 +98,7 @@ jobs: steps: - name: checkout-ww3 uses: actions/checkout@v2 - with: + with: path: ww3 - name: install-intel @@ -108,7 +114,7 @@ jobs: ~/.spack work_oasis3-mct /opt/intel - key: spack-${{ runner.os }}-${{ env.cache_key }} + key: spack-${{ runner.os }}-${{ env.cache_key }}-${{ hashFiles('ww3/model/ci/spack.yaml') }} - name: build-ww3 run: | @@ -127,5 +133,3 @@ jobs: cmake .. -DSWITCH=${{ matrix.switch }} fi make -j2 VERBOSE=1 - - diff --git a/model/src/cmake/src_list.cmake b/model/src/cmake/src_list.cmake index 5c011508f6..051529c127 100644 --- a/model/src/cmake/src_list.cmake +++ b/model/src/cmake/src_list.cmake @@ -55,6 +55,9 @@ set(ftn_src wmupdtmd.F90 wmwavemd.F90 w3tidemd.F90 + wav_grdout.F90 + w3iogoncdmd.F90 + wav_shr_flags.F90 ) set(nuopc_mesh_cap_src @@ -63,7 +66,6 @@ set(nuopc_mesh_cap_src wav_shel_inp.F90 wav_comp_nuopc.F90 wav_import_export.F90 - w3iogoncdmd.F90 ) set(esmf_multi_cap_src diff --git a/model/src/w3initmd.F90 b/model/src/w3initmd.F90 index b19f2bc66c..214c6162c3 100644 --- a/model/src/w3initmd.F90 +++ b/model/src/w3initmd.F90 @@ -109,7 +109,10 @@ MODULE W3INITMD ! 7. Source code : ! !/ ------------------------------------------------------------------- / - PUBLIC + ! module default + IMPLICIT NONE + + PUBLIC !/ REAL, PARAMETER :: CRITOS = 15. CHARACTER(LEN=10), PARAMETER :: WWVER = '7.14 ' @@ -118,8 +121,7 @@ MODULE W3INITMD !/ CONTAINS !/ ------------------------------------------------------------------- / - SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT & - , FLGRD, & + SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT , FLGRD, & FLGR2, FLGD, FLG2, NPT, XPT, YPT, PNAMES, & IPRT, PRTFRM, MPI_COMM, FLAGSTIDEIN) @@ -414,8 +416,6 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT & USE W3UOSTMD, ONLY: UOST_SETGRID #endif !/ - IMPLICIT NONE -! #ifdef W3_MPI INCLUDE "mpif.h" #endif @@ -743,8 +743,8 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT & WRITE (NDST,9003) LFILE(:IFL), TFILE(:IFT) #endif ! -! 2. Model defintition ---------------------------------------------- / -! 2.a Read model defintition file +! 2. Model definition ---------------------------------------------- / +! 2.a Read model definition file ! !!/DEBUGMPI CALL TEST_MPI_STATUS("Case 8") CALL W3IOGR ( 'READ', NDS(5), IMOD, FEXT ) @@ -2151,7 +2151,6 @@ SUBROUTINE W3MPII ( IMOD ) #endif USE W3ODATMD, ONLY: NDST, NAPROC, IAPROC !/ - IMPLICIT NONE ! #ifdef W3_MPI INCLUDE "mpif.h" @@ -2189,16 +2188,14 @@ SUBROUTINE W3MPII ( IMOD ) NXXXX = NSEALM * NAPROC ! #ifdef W3_MPI - CALL MPI_TYPE_VECTOR ( NSEALM, 1, NAPROC, MPI_REAL, & - WW3_FIELD_VEC, IERR_MPI ) + CALL MPI_TYPE_VECTOR ( NSEALM, 1, NAPROC, MPI_REAL, WW3_FIELD_VEC, IERR_MPI ) #endif #ifdef W3_DEBUGINIT WRITE(740+IAPROC,*) 'W3MPII, step 1' FLUSH(740+IAPROC) #endif #ifdef W3_MPI - CALL MPI_TYPE_VECTOR ( NSEALM, 1, NSPEC, MPI_REAL, & - WW3_SPEC_VEC, IERR_MPI ) + CALL MPI_TYPE_VECTOR ( NSEALM, 1, NSPEC, MPI_REAL, WW3_SPEC_VEC, IERR_MPI ) #endif #ifdef W3_DEBUGINIT WRITE(740+IAPROC,*) 'W3MPII, step 1' @@ -2284,14 +2281,11 @@ SUBROUTINE W3MPII ( IMOD ) IF ( IAPPRO(ISP) .NE. IAPROC ) THEN ITARG = IAPPRO(ISP) - 1 IH = IH + 1 - CALL MPI_SEND_INIT ( VA(ISP,1), 1, WW3_SPEC_VEC, & - ITARG, ISP, MPI_COMM_WAVE, IRQSG1(IH,1), IERR1 ) - CALL MPI_RECV_INIT ( VA(ISP,1), 1, WW3_SPEC_VEC, & - ITARG, ISP, MPI_COMM_WAVE, IRQSG1(IH,2), IERR2 ) + CALL MPI_SEND_INIT ( VA(ISP,1), 1, WW3_SPEC_VEC, ITARG, ISP, MPI_COMM_WAVE, IRQSG1(IH,1), IERR1 ) + CALL MPI_RECV_INIT ( VA(ISP,1), 1, WW3_SPEC_VEC, ITARG, ISP, MPI_COMM_WAVE, IRQSG1(IH,2), IERR2 ) #endif #ifdef W3_MPIT - WRITE (NDST,9022) IH, ISP, ITARG+1, & - IRQSG1(IH,1), IERR1, IRQSG1(IH,2), IERR2 + WRITE (NDST,9022) IH, ISP, ITARG+1, IRQSG1(IH,1), IERR1, IRQSG1(IH,2), IERR2 #endif #ifdef W3_MPI END IF @@ -2364,18 +2358,14 @@ SUBROUTINE W3MPII ( IMOD ) #endif ! #ifdef W3_MPI - CALL MPI_RECV_INIT & - ( WADATS(IMOD)%GSTORE(IP,IBFLOC), 1, & - WW3_FIELD_VEC, ITARG, ISP, MPI_COMM_WAVE, & - IRQSG2(IH,1), IERR2 ) - CALL MPI_SEND_INIT & - ( WADATS(IMOD)%SSTORE(IP,IBFLOC), 1, & - WW3_FIELD_VEC, ITARG, ISP, MPI_COMM_WAVE, & - IRQSG2(IH,2), IERR2 ) + CALL MPI_RECV_INIT ( WADATS(IMOD)%GSTORE(IP,IBFLOC), 1, & + WW3_FIELD_VEC, ITARG, ISP, MPI_COMM_WAVE, IRQSG2(IH,1), IERR2 ) + CALL MPI_SEND_INIT ( WADATS(IMOD)%SSTORE(IP,IBFLOC), 1, & + WW3_FIELD_VEC, ITARG, ISP, MPI_COMM_WAVE, IRQSG2(IH,2), IERR2 ) #endif #ifdef W3_MPIT - WRITE (NDST,9032) IH, ISP, ITARG+1, IBFLOC, & - IRQSG2(IH,1), IERR1, IRQSG2(IH,2), IERR2 + WRITE (NDST,9032) IH, ISP, ITARG+1, IBFLOC, & + IRQSG2(IH,1), IERR1, IRQSG2(IH,2), IERR2 #endif ! ! ... End of loops @@ -2602,7 +2592,6 @@ SUBROUTINE W3MPIO ( IMOD ) USE W3GDATMD, ONLY: GTYPE, UNGTYPE USE CONSTANTS, ONLY: LPDLIB !/ - IMPLICIT NONE ! #ifdef W3_MPI INCLUDE "mpif.h" @@ -3789,23 +3778,23 @@ SUBROUTINE W3MPIO ( IMOD ) #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/13', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_CESMCOUPLED #ifdef W3_MPI + END IF +#endif +! +#ifdef W3_MPI +#ifdef W3_CESMCOUPLED IF ( FLGRDALL( 6, 14) ) THEN IH = IH + 1 IT = IT + 1 - CALL MPI_SEND_INIT (LANGMT (1),NSEALM , MPI_REAL, IROOT, & + CALL MPI_SEND_INIT (LANGMT(1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) - END IF -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/14', IROOT, IT, IRQGO(IH), IERR #endif -#endif - -#ifdef W3_MPI - END IF -#endif + END IF +#endif !W3_CESMCOUPLED +#endif !W3_MPI ! #ifdef W3_MPI IF ( FLGRDALL( 7, 1) ) THEN @@ -5210,22 +5199,23 @@ SUBROUTINE W3MPIO ( IMOD ) #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/13', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_CESMCOUPLED #ifdef W3_MPI + END IF +#endif +! +#ifdef W3_MPI +#ifdef W3_CESMCOUPLED IF ( FLGRDALL( 6, 14) ) THEN IH = IH + 1 IT = IT + 1 - CALL MPI_RECV_INIT (LANGMT (1),NSEALM , MPI_REAL, IROOT, & - IT, MPI_COMM_WAVE, IRQGO(IH), IERR) - END IF -#endif + CALL MPI_RECV_INIT (LANGMT(I0),1,WW3_FIELD_VEC, IFROM, IT, & + MPI_COMM_WAVE, IRQGO2(IH), IERR) #ifdef W3_MPIT - WRITE (NDST,9011) IH, ' 6/14', IROOT, IT, IRQGO(IH), IERR + WRITE (NDST,9011) IH, ' 6/14', IFROM, IT, IRQGO2(IH), IERR #endif -#endif -#ifdef W3_MPI END IF -#endif +#endif ! W3_CESMCOUPLED +#endif ! W3_MPI ! #ifdef W3_MPI IF ( FLGRDALL( 7, 1) ) THEN @@ -6952,7 +6942,6 @@ SUBROUTINE W3MPIP ( IMOD ) USE W3PARALL, ONLY: INIT_GET_JSEA_ISPROC #endif !/ - IMPLICIT NONE ! #ifdef W3_MPI INCLUDE "mpif.h" diff --git a/model/src/w3iogomd.F90 b/model/src/w3iogomd.F90 index 84fe9f9c01..2f736e1065 100644 --- a/model/src/w3iogomd.F90 +++ b/model/src/w3iogomd.F90 @@ -134,6 +134,8 @@ MODULE W3IOGOMD #ifdef W3_S USE W3SERVMD, ONLY : STRACE #endif + !module default + IMPLICIT NONE !/ PUBLIC CHARACTER(LEN=1024) :: FLDOUT @@ -207,8 +209,6 @@ SUBROUTINE W3FLGRDUPDT ( NDSO, NDSEN, FLGRD, FLGR2, FLGD, FLG2 ) #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif -! - IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -362,7 +362,6 @@ SUBROUTINE W3READFLGRD ( NDSI , NDSO, NDSS, NDSEN, COMSTR, & USE W3SERVMD, ONLY: STRACE #endif ! - IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -597,7 +596,6 @@ SUBROUTINE W3FLGRDFLAG ( NDSO, NDSS, NDSEN, FLDOUT, & USE W3SERVMD, ONLY: STRACE #endif ! - IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -716,7 +714,6 @@ SUBROUTINE W3FLDTOIJ(FLD, I, J, IAPROC, NAPOUT, NDSEN) ! !/ ------------------------------------------------------------------- / USE W3GDATMD, ONLY: US3DF, USSPF - IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Local parameters @@ -1241,7 +1238,6 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) #endif ! USE W3PARALL, ONLY : INIT_GET_ISEA - IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -2783,8 +2779,9 @@ 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 ! - IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -2812,6 +2809,8 @@ 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 !/ !/ ------------------------------------------------------------------- / !/ @@ -2863,16 +2862,26 @@ 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)//'out_grd.'//FILEXT(:I) + WRITE (NDST,9001) FNMPRE(:J)//trim(fname) #endif IF ( WRITE ) THEN - OPEN (NDSOG,FILE=FNMPRE(:J)//'out_grd.'//FILEXT(:I), & - form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR) + OPEN (NDSOG,FILE=FNMPRE(:J)//trim(fname), & + form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR) ELSE - OPEN (NDSOG,FILE=FNMPRE(:J)//'out_grd.'//FILEXT(:I), & - form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR,STATUS='OLD') + OPEN (NDSOG,FILE=FNMPRE(:J)//trim(fname), & + form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR,STATUS='OLD') END IF ! REWIND ( NDSOG ) @@ -2935,15 +2944,25 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) 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) #ifdef W3_T 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)//TIMETAG//'.out_grd.' & - //FILEXT(:I),form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR) + OPEN (NDSOG,FILE=FNMPRE(:J)//trim(fname), & + form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR) ELSE OPEN (NDSOG,FILE=FNMPRE(:J)//'out_grd.'//FILEXT(:I), & form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR,STATUS='OLD') @@ -4052,7 +4071,6 @@ SUBROUTINE CALC_U3STOKES ( A , USS_SWITCH ) USE W3SERVMD, ONLY: STRACE #endif ! - IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -4277,7 +4295,6 @@ SUBROUTINE CALC_WBT (A) USE W3SERVMD, ONLY: STRACE #endif ! - IMPLICIT NONE ! !/ ------------------------------------------------------------------- / !/ Parameter list diff --git a/model/src/w3iogoncdmd.F90 b/model/src/w3iogoncdmd.F90 index 53d0c0b2a0..a164151bad 100644 --- a/model/src/w3iogoncdmd.F90 +++ b/model/src/w3iogoncdmd.F90 @@ -6,760 +6,503 @@ !> @date 01-05-2022 #include "w3macros.h" -module W3IOGONCDMD +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 () - - ! Write netcdf ww3 history output - - USE CONSTANTS - USE W3WDATMD, ONLY: W3SETW, W3DIMW, TIME, WLV, ICE, ICEF, ICEH, BERG, UST, USTDIR, ASF - USE W3GDATMD, ONLY: NX, NY, E3DF, MAPSF, MAPSTA, NSEA, W3SETG - USE W3ODATMD, ONLY: NOGRP, NGRPP, IDOUT, UNDEF, NDST, NDSE, FLOGRD, NOSWLL, W3SETO - USE W3ADATMD, ONLY: W3SETA, W3DIMA, W3XETA - USE W3ADATMD, ONLY: AINIT, DW, UA, UD, AS, CX, CY, WN - USE W3ADATMD, ONLY: HS, WLM, T02, T0M1, T01, FP0, THM, THS, THP0, WBT - USE W3ADATMD, ONLY: FP1, THP1, 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 + subroutine w3iogoncd () + + use w3odatmd , only : fnmpre + use w3gdatmd , only : filext + 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 : fp1, thp1, 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 #ifdef W3_CESMCOUPLED - USE W3ADATMD, ONLY: LANGMT + use w3adatmd , only : langmt #endif - use wav_shr_mod, only: time_origin, calendar_name, elapsed_secs - USE NETCDF - - IMPLICIT NONE -!/ -!/ ------------------------------------------------------------------- / -!/ Local parameters -!/ - INTEGER :: IGRD, IERR, I, J, IX, IY, ISEA, IFI, IFJ - REAL :: AUX1(NSEA), AUX2(NSEA), AUX3(NSEA), AUX4(NSEA) - REAL :: AUXE(NSEA,0:NOSWLL), AUXEF(NSEA,E3DF(2,1):E3DF(3,1)) - REAL, ALLOCATABLE :: AUX2D1(:,:), AUX2D2(:,:), AUX2D3(:,:) - REAL, ALLOCATABLE :: AUX3DEF(:,:,:), AUX3DE(:,:,:) - LOGICAL :: WAUX1, WAUX2, WAUX3, WAUXE, WAUXEF - INTEGER :: VARID, NCLOOP - CHARACTER(LEN=16) :: FLDSTR1, FLDSTR2, FLDSTR3, FLDSTRE - CHARACTER(LEN=16) :: UNITSTR1, UNITSTR2, UNITSTR3, UNITSTRE - CHARACTER(LEN=128) :: LNSTR1, LNSTR2, LNSTR3, LNSTRE - INTEGER :: EF_LEN - INTEGER :: NCID, DIMID(5) - CHARACTER(len=1024) :: FNAME - LOGICAL :: EXISTS -!/ -!/ ------------------------------------------------------------------- / -!/ -! - 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 + 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 - ! ------------------------------------------------------------- - ! Allocate fields needed for write - ! ------------------------------------------------------------- + ! 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, 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 - ALLOCATE ( AUX2D1(NX,NY), AUX2D2(NX,NY), AUX2D3(NX,NY), AUX3DE(NX,NY,0:NOSWLL) ) - ALLOCATE ( AUX3DEF(NX,NY,E3DF(2,1):E3DF(3,1)) ) - ! ! ------------------------------------------------------------- - ! Create the netcdf file and return the ncid and dimid + ! create the netcdf file ! ------------------------------------------------------------- - call hist_filename(fname) - - ef_len = e3df(3,1) - e3df(2,1) + 1 - inquire(file=trim(fname),exist=exists) - if (.not. exists) then - ierr = nf90_create(trim(fname),nf90_clobber,ncid) - call handle_err(ierr,'create') - ierr = nf90_def_dim(ncid,'nx',nx,dimid(1)) - call handle_err(ierr,'def_dimid1') - ierr = nf90_def_dim(ncid,'ny',ny,dimid(2)) - call handle_err(ierr,'def_dimid2') - ierr = nf90_def_dim(ncid,'noswll',noswll+1,dimid(3)) - call handle_err(ierr,'def_dimid3') - ierr = nf90_def_dim(ncid,'freq', ef_len, dimid(4)) !ef_len=25 - call handle_err(ierr,'def_dimid4') - ierr = nf90_def_dim(ncid,'time', nf90_unlimited, dimid(5)) - call handle_err(ierr,'def_dimid5') - ! define time axis - ierr = nf90_def_var(ncid, 'time', nf90_double, (/dimid(5)/), 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') + + 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 - ierr = nf90_open(trim(fname),nf90_write,ncid) - call handle_err(ierr,'open') - endif + write(fname,'(a,i8.8,a1,i6.6,a)')trim(fnmpre),time(1),'.',time(2),'.out_grd.'//trim(filext)//'.nc' + end if - ! ------------------------------------------------------------- - ! Initialization - ! ------------------------------------------------------------- + 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 - DO ISEA=1, NSEA - IF ( MAPSTA(MAPSF(ISEA,2),MAPSF(ISEA,1)) .LT. 0 ) THEN - ! - IF ( FLOGRD( 2, 2) ) WLM (ISEA) = UNDEF - IF ( FLOGRD( 2, 3) ) T02 (ISEA) = UNDEF - IF ( FLOGRD( 2, 4) ) T0M1 (ISEA) = UNDEF - IF ( FLOGRD( 2, 5) ) T01 (ISEA) = UNDEF - IF ( FLOGRD( 2, 6) ) FP0 (ISEA) = UNDEF - IF ( FLOGRD( 2, 7) ) THM (ISEA) = UNDEF - IF ( FLOGRD( 2, 8) ) THS (ISEA) = UNDEF - IF ( FLOGRD( 2, 9) ) THP0 (ISEA) = UNDEF - UST (ISEA) = UNDEF - USTDIR(ISEA) = UNDEF - IF ( FLOGRD( 2,10) ) HSIG (ISEA) = UNDEF - IF ( FLOGRD( 2,11) ) STMAXE(ISEA) = UNDEF - IF ( FLOGRD( 2,12) ) STMAXD(ISEA) = UNDEF - IF ( FLOGRD( 2,13) ) HMAXE (ISEA) = UNDEF - IF ( FLOGRD( 2,14) ) HCMAXE(ISEA) = UNDEF - IF ( FLOGRD( 2,15) ) HMAXD (ISEA) = UNDEF - IF ( FLOGRD( 2,16) ) HCMAXD(ISEA) = UNDEF - IF ( FLOGRD( 2,17) ) WBT (ISEA) = UNDEF - ! - IF ( FLOGRD( 3, 1) ) EF (ISEA,:) = UNDEF - IF ( FLOGRD( 3, 2) ) TH1M (ISEA,:) = UNDEF - IF ( FLOGRD( 3, 3) ) STH1M(ISEA,:) = UNDEF - IF ( FLOGRD( 3, 4) ) TH2M (ISEA,:) = UNDEF - IF ( FLOGRD( 3, 5) ) STH2M(ISEA,:) = UNDEF - ! - IF ( FLOGRD( 4, 1) ) PHS (ISEA,:) = UNDEF - IF ( FLOGRD( 4, 2) ) PTP (ISEA,:) = UNDEF - IF ( FLOGRD( 4, 3) ) PLP (ISEA,:) = UNDEF - IF ( FLOGRD( 4, 4) ) PDIR (ISEA,:) = UNDEF - IF ( FLOGRD( 4, 5) ) PSI (ISEA,:) = UNDEF - IF ( FLOGRD( 4, 6) ) PWS (ISEA,:) = UNDEF - IF ( FLOGRD( 4, 7) ) PTHP0(ISEA,:) = UNDEF - IF ( FLOGRD( 4, 8) ) PQP (ISEA,:) = UNDEF - IF ( FLOGRD( 4, 9) ) PPE(ISEA,:) = UNDEF - IF ( FLOGRD( 4,10) ) PGW(ISEA,:) = UNDEF - IF ( FLOGRD( 4,11) ) PSW (ISEA,:) = UNDEF - IF ( FLOGRD( 4,12) ) PTM1(ISEA,:) = UNDEF - IF ( FLOGRD( 4,13) ) PT1 (ISEA,:) = UNDEF - IF ( FLOGRD( 4,14) ) PT2 (ISEA,:) = UNDEF - IF ( FLOGRD( 4,15) ) PEP (ISEA,:) = UNDEF - IF ( FLOGRD( 4,16) ) PWST(ISEA ) = UNDEF - IF ( FLOGRD( 4,17) ) PNR (ISEA ) = UNDEF - ! - IF ( FLOGRD( 5, 2) ) CHARN (ISEA) = UNDEF - IF ( FLOGRD( 5, 3) ) CGE (ISEA) = UNDEF - IF ( FLOGRD( 5, 4) ) PHIAW (ISEA) = UNDEF - IF ( FLOGRD( 5, 5) ) THEN - TAUWIX(ISEA) = UNDEF - TAUWIY(ISEA) = UNDEF - END IF - IF ( FLOGRD( 5, 6) ) THEN - TAUWNX(ISEA) = UNDEF - TAUWNY(ISEA) = UNDEF - END IF - IF ( FLOGRD( 5, 7) ) WHITECAP(ISEA,1) = UNDEF - IF ( FLOGRD( 5, 8) ) WHITECAP(ISEA,2) = UNDEF - IF ( FLOGRD( 5, 9) ) WHITECAP(ISEA,3) = UNDEF - IF ( FLOGRD( 5,10) ) WHITECAP(ISEA,4) = UNDEF - ! - IF ( FLOGRD( 6, 1) ) THEN - SXX (ISEA) = UNDEF - SYY (ISEA) = UNDEF - SXY (ISEA) = UNDEF - END IF - IF ( FLOGRD( 6, 2) ) THEN - TAUOX (ISEA) = UNDEF - TAUOY (ISEA) = UNDEF - END IF - IF ( FLOGRD( 6, 3) ) BHD(ISEA) = UNDEF - IF ( FLOGRD( 6, 4) ) PHIOC (ISEA) = UNDEF - IF ( FLOGRD( 6, 5) ) THEN - TUSX (ISEA) = UNDEF - TUSY (ISEA) = UNDEF - END IF - IF ( FLOGRD( 6, 6) ) THEN - USSX (ISEA) = UNDEF - USSY (ISEA) = UNDEF - END IF - IF ( FLOGRD( 6, 7) ) THEN - PRMS (ISEA) = UNDEF - TPMS (ISEA) = UNDEF - END IF - IF ( FLOGRD( 6, 8) ) US3D(ISEA,:) = UNDEF - IF ( FLOGRD( 6, 9) ) P2SMS(ISEA,:) = UNDEF - IF ( FLOGRD( 6, 10) ) TAUICE(ISEA,:) = UNDEF - IF ( FLOGRD( 6, 11) ) PHICE(ISEA) = UNDEF - IF ( FLOGRD( 6, 12) ) USSP(ISEA,:) = UNDEF -#ifdef W3_CESMCOUPLED - IF ( FLOGRD( 6, 14) ) LANGMT(ISEA) = UNDEF !cesm specific -#endif - ! - IF ( FLOGRD( 7, 1) ) THEN - ABA (ISEA) = UNDEF - ABD (ISEA) = UNDEF - END IF - IF ( FLOGRD( 7, 2) ) THEN - UBA (ISEA) = UNDEF - UBD (ISEA) = UNDEF - END IF - IF ( FLOGRD( 7, 3) ) BEDFORMS(ISEA,:) = UNDEF - IF ( FLOGRD( 7, 4) ) PHIBBL(ISEA) = UNDEF - IF ( FLOGRD( 7, 5) ) TAUBBL(ISEA,:) = UNDEF - ! - IF ( FLOGRD( 8, 1) ) THEN - MSSX (ISEA) = UNDEF - MSSY (ISEA) = UNDEF - END IF - IF ( FLOGRD( 8, 2) ) THEN - MSCX (ISEA) = UNDEF - MSCY (ISEA) = UNDEF - END IF - IF ( FLOGRD( 8, 3) ) MSSD (ISEA) = UNDEF - IF ( FLOGRD( 8, 4) ) MSCD (ISEA) = UNDEF - IF ( FLOGRD( 8, 5) ) QP (ISEA) = UNDEF - ! - IF ( FLOGRD( 9, 1) ) DTDYN (ISEA) = UNDEF - IF ( FLOGRD( 9, 2) ) FCUT (ISEA) = UNDEF - IF ( FLOGRD( 9, 3) ) CFLXYMAX(ISEA) = UNDEF - IF ( FLOGRD( 9, 4) ) CFLTHMAX(ISEA) = UNDEF - IF ( FLOGRD( 9, 5) ) CFLKMAX(ISEA) = UNDEF - ! - END IF - ! - IF ( MAPSTA(MAPSF(ISEA,2),MAPSF(ISEA,1)) == 2 ) THEN - ! - IF ( FLOGRD( 5, 4) ) PHIAW (ISEA) = UNDEF - IF ( FLOGRD( 5, 5) ) THEN - TAUWIX(ISEA) = UNDEF - TAUWIY(ISEA) = UNDEF - END IF - IF ( FLOGRD( 5, 6) ) THEN - TAUWNX(ISEA) = UNDEF - TAUWNY(ISEA) = UNDEF - END IF - IF ( FLOGRD( 5, 7) ) WHITECAP(ISEA,1) = UNDEF - IF ( FLOGRD( 5, 8) ) WHITECAP(ISEA,2) = UNDEF - IF ( FLOGRD( 5, 9) ) WHITECAP(ISEA,3) = UNDEF - IF ( FLOGRD( 5,10) ) WHITECAP(ISEA,4) = UNDEF - ! - IF ( FLOGRD( 6, 2) ) THEN - TAUOX (ISEA) = UNDEF - TAUOY (ISEA) = UNDEF - END IF - IF ( FLOGRD( 6, 4) ) PHIOC (ISEA) = UNDEF - ! - IF ( FLOGRD( 7, 3) ) BEDFORMS(ISEA,:) = UNDEF - IF ( FLOGRD( 7, 4) ) PHIBBL(ISEA) = UNDEF - IF ( FLOGRD( 7, 5) ) TAUBBL(ISEA,:) = UNDEF - end IF - END DO - ! - ! ------------------------------------------------------------- - ! Actual output - ! ------------------------------------------------------------- - ! - ! 1st loop step define the netcdf variables and attributes - ! 2nd loop step, write the variables - - NC_LOOP: do NCLOOP = 1,2 - if (NCLOOP == 1) then - IERR = NF90_REDEF(NCID) - else if (NCLOOP == 2) then - IERR = NF90_ENDDEF(NCID) - endif - IFI_LOOP: do IFI=1, NOGRP - IFJ_LOOP: do IFJ=1, NGRPP - if ( FLOGRD(IFI,IFJ) ) then - WAUX1 = .false. ! vars with dims (nx,ny) shoved into AUX1 - WAUX2 = .false. ! y-component of vars with dims (nx,ny) shoved into AUX2 - WAUX3 = .false. ! unused - WAUXE = .false. ! wave height of partition vars with dims of NOSWLL, a mess - WAUXEF = .false. ! for vars with dims of (Freq,nx,ny) shoved into AUXEF - ! - ! Section 1) - ! - if ( IFI .eq. 1 .and. IFJ .eq. 1 ) then - AUX1(1:NSEA) = DW(1:NSEA) - WAUX1 = .true. - FLDSTR1 = 'DW' - UNITSTR1 = 'm' - LNSTR1 = 'Water depth' !CMB should use IDOUT here, see w3odatmd - else if ( IFI .eq. 1 .and. IFJ .eq. 2 ) then - AUX1(1:NSEA) = CX(1:NSEA) - AUX2(1:NSEA) = CY(1:NSEA) - WAUX1 = .true. - WAUX2 = .true. - FLDSTR1 = 'CX' - FLDSTR2 = 'CY' - UNITSTR1 = 'm/s' - UNITSTR2 = 'm/s' - LNSTR1 = 'Mean current, x-component' - LNSTR2 = 'Mean current, y-component' - else if ( IFI .eq. 1 .and. IFJ .eq. 3 ) then - do ISEA=1, NSEA - if (UA(ISEA) .ne.UNDEF) then - AUX1(ISEA) = UA(ISEA)*cos(UD(ISEA)) - AUX2(ISEA) = UA(ISEA)*sin(UD(ISEA)) - else - AUX1(ISEA) = UNDEF - AUX2(ISEA) = UNDEF - end if - end do - WAUX1 = .true. - WAUX2 = .true. - FLDSTR1 = 'UAX' - FLDSTR2 = 'UAY' - UNITSTR1 = 'm/s' - UNITSTR2 = 'm/s' - LNSTR1 = 'Mean wind, x-component' - LNSTR2 = 'Mean wind, y-component' - else if ( IFI .eq. 1 .and. IFJ .eq. 4 ) then - AUX1(1:NSEA) = AS(1:NSEA) - WAUX1 = .true. - FLDSTR1 = 'AS' - UNITSTR1 = 'deg C' - LNSTR1 = 'Air-sea temperature difference' - else if ( IFI .eq. 1 .and. IFJ .eq. 5 ) then - AUX1(1:NSEA) = WLV(1:NSEA) - WAUX1 = .true. - FLDSTR1 = 'WLV' - UNITSTR1 = 'm' - LNSTR1 = 'Water levels' - else if ( IFI .eq. 1 .and. IFJ .eq. 6 ) then - AUX1(1:NSEA) = ICE(1:NSEA) - WAUX1 = .true. - FLDSTR1 = 'ICE' - UNITSTR1 = '1' - LNSTR1 = 'Ice coverage' - else if ( IFI .eq. 1 .and. IFJ .eq. 7 ) then - AUX1(1:NSEA) = BERG(1:NSEA) - WAUX1 = .true. - FLDSTR1 = 'BERG' - UNITSTR1 = '1' - LNSTR1 = '' - ! - ! Section 2) - ! - else if ( IFI .eq. 2 .and. IFJ .eq. 1 ) then - AUX1(1:NSEA) = HS(1:NSEA) - WAUX1 = .true. - FLDSTR1 = 'HS' - UNITSTR1 = 'm' - LNSTR1 = 'Significant wave height' - else if ( IFI .eq. 2 .and. IFJ .eq. 2 ) then - WAUX1 = .true. - FLDSTR1 = 'WLM' - UNITSTR1 = 'm' - LNSTR1 = 'Mean wave length' - else if ( IFI .eq. 2 .and. IFJ .eq. 3 ) then - AUX1(1:NSEA) = T02(1:NSEA) - WAUX1 = .true. - FLDSTR1 = 'T02' - UNITSTR1 = 's' - LNSTR1 = 'Mean wave period' - else if ( IFI .eq. 2 .and. IFJ .eq. 4 ) then - AUX1(1:NSEA) = T0M1(1:NSEA) - WAUX1 = .true. - FLDSTR1 = 'T0M1' - UNITSTR1 = 's' - LNSTR1 = 'Mean wave period' - else if ( IFI .eq. 2 .and. IFJ .eq. 5 ) then - AUX1(1:NSEA) = T01(1:NSEA) - WAUX1 = .true. - FLDSTR1 = 'T01' - UNITSTR1 = 's' - LNSTR1 = 'Mean wave period' - else if ( IFI .eq. 2 .and. IFJ .eq. 6 ) then - AUX1(1:NSEA) = FP0(1:NSEA) - WAUX1 = .true. - FLDSTR1 = 'FP0' - UNITSTR1 = 'Hz' - LNSTR1 = 'Peak frequency' - else if ( IFI .eq. 2 .and. IFJ .eq. 7 ) then - AUX1(1:NSEA) = THM(1:NSEA) - WAUX1 = .true. - FLDSTR1 = 'THM' - UNITSTR1 = 'rad' - LNSTR1 = 'Mean wave direction' - else if ( IFI .eq. 2 .and. IFJ .eq. 8 ) then - AUX1(1:NSEA) = THS(1:NSEA) - WAUX1 = .true. - FLDSTR1 = 'THS' - UNITSTR1 = 'rad' - LNSTR1 = 'Mean directional spread' - else if ( IFI .eq. 2 .and. IFJ .eq. 9 ) then - AUX1(1:NSEA) = THP0(1:NSEA) - WAUX1 = .true. - FLDSTR1 = 'THP0' - UNITSTR1 = 'rad' - LNSTR1 = 'Peak direction' - else if ( IFI .eq. 2 .and. IFJ .eq. 10 ) then - AUX1(1:NSEA) = HSIG(1:NSEA) - WAUX1 = .true. - FLDSTR1 = 'HSIG' - UNITSTR1 = '1' - LNSTR1 = '' - else if ( IFI .eq. 2 .and. IFJ .eq. 11 ) then - AUX1(1:NSEA) = STMAXE(1:NSEA) - WAUX1 = .true. - FLDSTR1 = 'STMAXE' - UNITSTR1 = 'm' - LNSTR1 = 'Max surface elev STE' - else if ( IFI .eq. 2 .and. IFJ .eq. 12 ) then - AUX1(1:NSEA) = STMAXD(1:NSEA) - WAUX1 = .true. - FLDSTR1 = 'STMAXD' - UNITSTR1 = 'm' - LNSTR1 = 'St Dev Max surface elev STE' - else if ( IFI .eq. 2 .and. IFJ .eq. 13 ) then - AUX1(1:NSEA) = HMAXE(1:NSEA) - WAUX1 = .true. - FLDSTR1 = 'HMAXE' - UNITSTR1 = 'm' - LNSTR1 = 'Max wave height STE' - else if ( IFI .eq. 2 .and. IFJ .eq. 14 ) then - AUX1(1:NSEA) = HCMAXE(1:NSEA) - WAUX1 = .true. - FLDSTR1 = 'HCMAXE' - UNITSTR1 = 'm' - LNSTR1 = 'Max wave height from crest STE' - else if ( IFI .eq. 2 .and. IFJ .eq. 15 ) then - AUX1(1:NSEA) = HMAXD(1:NSEA) - WAUX1 = .true. - FLDSTR1 = 'HMAXD' - UNITSTR1 = 'm' - LNSTR1 = 'St Dev of MXC (STE)' - else if ( IFI .eq. 2 .and. IFJ .eq. 16 ) then - AUX1(1:NSEA) = HCMAXD(1:NSEA) - WAUX1 = .true. - FLDSTR1 = 'HCMAXD' - UNITSTR1 = 'm' - LNSTR1 = 'St Dev of MXHC (STE)' - else if ( IFI .eq. 2 .and. IFJ .eq. 17 ) then - AUX1(1:NSEA) = WBT(1:NSEA) - WAUX1 = .true. - FLDSTR1 = 'WBT' - UNITSTR1 = 'm' - LNSTR1 = 'Dominant wave breaking probability b' - ! - ! Section 3) - ! - else if ( IFI .eq. 3 .and. IFJ .eq. 1 ) then - AUXEF(1:NSEA,E3DF(2,1):E3DF(3,1)) = EF(1:NSEA,E3DF(2,1):E3DF(3,1)) - WAUXEF = .true. - FLDSTRE = 'EF' - UNITSTRE = '1' - LNSTRE = '1D spectral density' - ! - ! Section 4) - ! - else if ( IFI .eq. 4 .and. IFJ .eq. 1 ) then - AUXE(1:NSEA,0:NOSWLL) = PHS(1:NSEA,0:NOSWLL) - WAUXE = .true. - FLDSTRE = 'PHS' - UNITSTRE = 'm' - LNSTRE = 'Wave height of partitions' - else if ( IFI .eq. 4 .and. IFJ .eq. 2 ) then - AUXE(1:NSEA,0:NOSWLL) = PTP(1:NSEA,0:NOSWLL) - WAUXE = .true. - FLDSTRE = 'PTP' - UNITSTRE = 's' - LNSTRE = 'Peak wave period of partitions' - else if ( IFI .eq. 4 .and. IFJ .eq. 3 ) then - AUXE(1:NSEA,0:NOSWLL) = PLP(1:NSEA,0:NOSWLL) - WAUXE = .true. - FLDSTRE = 'PLP' - UNITSTRE = 'm' - LNSTRE = 'Peak wave length of partitions' - ! - ! Section 5) - ! - else if ( IFI .eq. 5 .and. IFJ .eq. 1 ) then - do ISEA=1, NSEA - IX = MAPSF(ISEA,1) - IY = MAPSF(ISEA,2) - if ( MAPSTA(IY,IX) .eq. 1 ) then - AUX1(ISEA) = UST(ISEA) * ASF(ISEA) * & - cos(USTDIR(ISEA)) - AUX2(ISEA) = UST(ISEA) * ASF(ISEA) * & - sin(USTDIR(ISEA)) - else - AUX1(ISEA) = UNDEF - AUX2(ISEA) = UNDEF - end if - end do - WAUX1 = .true. - WAUX2 = .true. - FLDSTR1 = 'ASFX' - FLDSTR2 = 'ASFY' - UNITSTR1 = 'm/s' - UNITSTR2 = 'm/s' - LNSTR1 = 'Skin friction velocity, x-component' - LNSTR2 = 'Skin friction velocity, y-component' - ! - ! Section 6) - ! - else if ( IFI .eq. 6 .and. IFJ .eq. 6 ) then - AUX1(1:NSEA) = USSX(1:NSEA) - AUX2(1:NSEA) = USSY(1:NSEA) - WAUX1 = .true. - WAUX2 = .true. - FLDSTR1 = 'USSX' - FLDSTR2 = 'USSY' - UNITSTR1 = 'm/s' - UNITSTR2 = 'm/s' - LNSTR1 = 'Stokes drift at z=0' - LNSTR2 = 'Stokes drift at z=0' + ! 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) + + ! 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') + + ! 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') + ! 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. 'CHA') 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) ) #ifdef W3_CESMCOUPLED - else if ( IFI .eq. 6 .and. IFJ .eq. 14 ) then - write(6,*)'DEBUG: nsea = ',nsea - write(6,*)'DEBUG: size(langmt) = ',size(langmt) - AUX1(1:NSEA) = LANGMT(1:NSEA) - WAUX1 = .true. - FLDSTR1 = 'LANGMT' - UNITSTR1 = '' - LNSTR1 = 'Turbulent Langmuir number (La_t)' + if (vname .eq. 'LANGMT') call write_var2d(vname, langmt (1:nsea) ) #endif - ! - ! Section 7) - ! - else if ( IFI .eq. 7 .and. IFJ .eq. 1 ) then - do ISEA=1, NSEA - if ( ABA(ISEA) .ne. UNDEF ) then - AUX1(ISEA) = ABA(ISEA)*cos(ABD(ISEA)) - AUX2(ISEA) = ABA(ISEA)*sin(ABD(ISEA)) - else - AUX1(ISEA) = UNDEF - AUX2(ISEA) = UNDEF - end if - end do - WAUX1 = .true. - WAUX2 = .true. - FLDSTR1 = 'ABAX' - FLDSTR2 = 'ABAY' - UNITSTR1 = 'm' - UNITSTR2 = 'm' - LNSTR1 = 'Near bottom rms wave excursion amplitude, x-component' - LNSTR2 = 'Near bottom rms wave excursion amplitude, y-component' - else if ( IFI .eq. 7 .and. IFJ .eq. 2 ) then - do ISEA=1, NSEA - if ( UBA(ISEA) .ne. UNDEF ) then - AUX1(ISEA) = UBA(ISEA)*cos(UBD(ISEA)) - AUX2(ISEA) = UBA(ISEA)*sin(UBD(ISEA)) - else - AUX1(ISEA) = UNDEF - AUX2(ISEA) = UNDEF - end if - end do - WAUX1 = .true. - WAUX2 = .true. - FLDSTR1 = 'UBAX' - FLDSTR2 = 'UBAY' - UNITSTR1 = 'm/s' - UNITSTR2 = 'm/s' - LNSTR1 = 'Near bottom rms wave velocity, x-component' - LNSTR2 = 'Near bottom rms wave velocity, y-component' - ! - ! Section 8) - ! - ! - ! Section 9) - ! - ! - ! Section 10) - ! - else if ( IFI .eq. 10 ) then - AUX1(1:NSEA) = USERO(1:NSEA,2) - WAUX1 = .true. - FLDSTR1 = 'USERO' - UNITSTR1 = '1' - LNSTR1 = 'User defined variable' - end if + ! 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 - ! netcdf history - if (NCLOOP == 1) then - ! write(ndse,*) 'w3iogo NCLOOP=',NCLOOP, WAUX1, WAUX2, WAUX3,WAUXE,WAUXEF - !--- no error checking here in case file/vars exists already --- - if (WAUX1) then - ! write(ndse,*) ' w3iogo NCLOOP=1, WAUX1=T, FLDSTR1, VARID', TRIM(FLDSTR1), VARID - IERR = NF90_DEF_VAR(NCID,trim(FLDSTR1),NF90_FLOAT,(/DIMID(1),DIMID(2),dimid(5)/),VARID) - IERR = NF90_PUT_ATT(NCID,VARID,"_FillValue",UNDEF) - IERR = NF90_PUT_ATT(NCID,VARID,"units",UNITSTR1) - IERR = NF90_PUT_ATT(NCID,VARID,"long_name",LNSTR1) - endif - if (WAUX2) then - ! write(ndse,*) ' w3iogo NCLOOP=1, WAUX2=T, FLDSTR2, VARID', TRIM(FLDSTR2), VARID - IERR = NF90_DEF_VAR(NCID,trim(FLDSTR2),NF90_FLOAT,(/DIMID(1),DIMID(2),dimid(5)/),VARID) - IERR = NF90_PUT_ATT(NCID,VARID,"_FillValue",UNDEF) - IERR = NF90_PUT_ATT(NCID,VARID,"units",UNITSTR2) - IERR = NF90_PUT_ATT(NCID,VARID,"long_name",LNSTR2) - endif - if (WAUX3) then - ! write(ndse,*) ' w3iogo NCLOOP=1, WAUX3=T, FLDSTR3, VARID ', TRIM(FLDSTR3), VARID - IERR = NF90_DEF_VAR(NCID,trim(FLDSTR3),NF90_FLOAT,(/DIMID(1),DIMID(2),dimid(5)/),VARID) - IERR = NF90_PUT_ATT(NCID,VARID,"_FillValue",UNDEF) - IERR = NF90_PUT_ATT(NCID,VARID,"units",UNITSTR3) - IERR = NF90_PUT_ATT(NCID,VARID,"long_name",LNSTR3) - endif - if (WAUXE) then - ! write(ndse,*) ' w3iogo NCLOOP=1, WAUXE=T, FLDSTRE, VARID ', TRIM(FLDSTRE), VARID - IERR = NF90_DEF_VAR(NCID,trim(FLDSTRE),NF90_FLOAT,(/DIMID(1),DIMID(2),DIMID(3),dimid(5)/),VARID) - IERR = NF90_PUT_ATT(NCID,VARID,"_FillValue",UNDEF) - IERR = NF90_PUT_ATT(NCID,VARID,"units",UNITSTRE) - IERR = NF90_PUT_ATT(NCID,VARID,"long_name",LNSTRE) - endif - if (WAUXEF) then - ! write(ndse,*) ' w3iogo NCLOOP=1, WAUXEF=T, FLDSTRE, VARID', TRIM(FLDSTRE), VARID - IERR = NF90_DEF_VAR(NCID,trim(FLDSTRE),NF90_FLOAT,(/DIMID(1),DIMID(2),DIMID(4),dimid(5)/),VARID) - IERR = NF90_PUT_ATT(NCID,VARID,"_FillValue",UNDEF) - IERR = NF90_PUT_ATT(NCID,VARID,"units",UNITSTRE) - IERR = NF90_PUT_ATT(NCID,VARID,"long_name",LNSTRE) - endif - - elseif (NCLOOP == 2) then - IERR = nf90_inq_varid(ncid, 'time', varid) - call HANDLE_ERR(IERR,'INQ_VARID_TIME'//trim('time')) - IERR = nf90_put_var(ncid, varid, elapsed_secs) - call HANDLE_ERR(IERR,'PUT_VAR_TIME'//trim('time')) - ! write(ndse,*) ' w3iogo write NCLOOP=',NCLOOP, WAUX1, WAUX2, WAUX3,WAUXE,WAUXEF - if (WAUX1) then - ! write(ndse,*) 'w3iogo write ',trim(fldstr1) - AUX2D1 = UNDEF - do ISEA=1, NSEA - AUX2D1(MAPSF(ISEA,1),MAPSF(ISEA,2)) = AUX1(ISEA) - enddo - IERR = NF90_INQ_VARID(NCID,trim(FLDSTR1),VARID) - call HANDLE_ERR(IERR,'INQ_VARID_AUX2D1_'//trim(FLDSTR1)) - IERR = NF90_PUT_VAR(NCID,VARID,AUX2D1) - call HANDLE_ERR(IERR,'PUT_VAR_AUX2D1_'//trim(FLDSTR1)) - endif - if (WAUX2) then - ! write(ndse,*) 'w3iogo write ',trim(fldstr2) - AUX2D2 = UNDEF - do ISEA=1, NSEA - AUX2D2(MAPSF(ISEA,1),MAPSF(ISEA,2)) = AUX2(ISEA) - enddo - IERR = NF90_INQ_VARID(NCID,trim(FLDSTR2),VARID) - call HANDLE_ERR(IERR,'INQ_VARID_AUX2D2_'//trim(FLDSTR2)) - IERR = NF90_PUT_VAR(NCID,VARID,AUX2D2) - call HANDLE_ERR(IERR,'PUT_VAR_AUX2D2_'//trim(FLDSTR2)) - endif - if (WAUX3) then - ! write(ndse,*) 'w3iogo write ',trim(fldstr3) - AUX2D3 = UNDEF - do ISEA=1, NSEA - AUX2D3(MAPSF(ISEA,1),MAPSF(ISEA,2)) = AUX3(ISEA) - enddo - IERR = NF90_INQ_VARID(NCID,trim(FLDSTR3),VARID) - call HANDLE_ERR(IERR,'INQ_VARID_AUX2D3_'//trim(FLDSTR3)) - IERR = NF90_PUT_VAR(NCID,VARID,AUX2D3) - call HANDLE_ERR(IERR,'PUT_VAR_AUX2D3_'//trim(FLDSTR3)) - endif - if (WAUXE) then - ! write(ndse,*) 'w3iogo write ',trim(fldstre) - AUX3DE = UNDEF - do ISEA=1, NSEA - AUX3DE(MAPSF(ISEA,1),MAPSF(ISEA,2),0:NOSWLL) = AUXE(ISEA,0:NOSWLL) - enddo - IERR = NF90_INQ_VARID(NCID,trim(FLDSTRE),VARID) - call HANDLE_ERR(IERR,'INQ_VARID_AUX2D1_'//trim(FLDSTRE)) - IERR = NF90_PUT_VAR(NCID,VARID,AUX3DE) - call HANDLE_ERR(IERR,'PUT_VAR_AUX3DE_'//trim(FLDSTRE)) - endif - if (WAUXEF) then - ! write(ndse,*) 'w3iogo write ',trim(fldstre) - AUX3DEF = UNDEF - do ISEA=1, NSEA - AUX3DEF(MAPSF(ISEA,1),MAPSF(ISEA,2),E3DF(2,1):E3DF(3,1)) = AUXEF(ISEA,E3DF(2,1):E3DF(3,1)) - enddo - IERR = NF90_INQ_VARID(NCID,trim(FLDSTRE),VARID) - call HANDLE_ERR(IERR,'INQ_VARID_AUX2D1_'//trim(FLDSTRE)) - IERR = NF90_PUT_VAR(NCID,VARID,AUX3DEF) - call HANDLE_ERR(IERR,'PUT_VAR_AUX3DE_'//trim(FLDSTRE)) - endif - endif !NC - - end if ! end of if ( FLOGRD(IFI,IFJ) ) - end do IFJ_LOOP - end do IFI_LOOP - end do NC_LOOP - - ierr = NF90_CLOSE(NCID) - call handle_err(IERR,'CLOSE') - deallocate(AUX2D1,AUX2D2,AUX2D3,AUX3DE,AUX3DEF) + 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 ) + call w3seta ( igrd, ndse, ndst ) - end subroutine W3IOGONCD + end subroutine w3iogoncd -!/ ------------------------------------------------------------------- / - subroutine hist_filename(fname) + !=============================================================================== + 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 - USE WAV_SHR_MOD , ONLY : CASENAME, INST_SUFFIX - USE W3WDATMD , ONLY : TIME - USE W3ODATMD , ONLY : NDS, IAPROC, NAPOUT + 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 - implicit none + ! local variables + real, dimension(nx,ny) :: var2d + logical :: lmask, linit0, linit2 + real :: varloc - ! input/output variables - character(len=*), intent(out) :: fname + 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 - integer :: yy,mm,dd,hh,mn,ss,totsec - !---------------------------------------------- - - yy = time(1)/10000 - mm = (time(1)-yy*10000)/100 - dd = (time(1)-yy*10000-mm*100) - hh = time(2)/10000 - mn = (time(2)-hh*10000)/100 - ss = (time(2)-hh*10000-mn*100) - totsec = hh*3600+mn*60+ss - - if (len_trim(inst_suffix) > 0) then - write(fname,'(a,i4.4,a,i2.2,a,i2.2,a,i5.5,a)') & - trim(casename)//'.ww3'//trim(inst_suffix)//'.hi.',yy,'-',mm,'-',dd,'-',totsec,'.nc' - else - write(fname,'(a,i4.4,a,i2.2,a,i2.2,a,i5.5,a)') & - trim(casename)//'.ww3.hi.',yy,'-',mm,'-',dd,'-',totsec,'.nc' - endif + 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 - if (iaproc == napout) then - write(nds(1),'(a)') 'w3iogomdncd: writing history '//trim(fname) - end if + 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 - end subroutine hist_filename + 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) -!/ ------------------------------------------------------------------- / - SUBROUTINE HANDLE_ERR(IERR,STRING) - USE W3ODATMD, ONLY: NDSE - USE W3SERVMD, ONLY: EXTCDE - USE NETCDF + deallocate(varloc) + end subroutine write_var3d - IMPLICIT NONE + !=============================================================================== + 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 , 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 + 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 +end module w3iogoncdmd diff --git a/model/src/w3iorsmd.F90 b/model/src/w3iorsmd.F90 index 1f2815dda8..313c0e11a2 100644 --- a/model/src/w3iorsmd.F90 +++ b/model/src/w3iorsmd.F90 @@ -51,6 +51,8 @@ MODULE W3IORSMD ! 7. Source code : ! !/ ------------------------------------------------------------------- / + !module default + IMPLICIT NONE PUBLIC !/ ! Add fields needed for OASIS coupling in restart @@ -247,6 +249,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) !/ ------------------------------------------------------------------- / USE W3GDATMD, ONLY: W3SETG, W3SETREF, RSTYPE USE W3ODATMD, ONLY: W3SETO + USE W3WDATMD, only: W3SETW, W3DIMW USE W3ADATMD, ONLY: W3SETA, W3XETA, NSEALM USE W3ADATMD, ONLY: CX, CY, HS, WLM, T0M1, T01, FP0, THM, CHARN,& TAUWIX, TAUWIY, TWS, TAUOX, TAUOY, BHD, & @@ -257,7 +260,8 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) USE W3GDATMD, ONLY: NX, NY, NSEA, NSEAL, NSPEC, MAPSTA, MAPST2, & GNAME, FILEXT, GTYPE, UNGTYPE USE W3TRIAMD, ONLY: SET_UG_IOBP - USE W3WDATMD + USE W3WDATMD, only : DINIT, VA, TIME, TLEV, TICE, TRHO, ICE, UST + USE W3WDATMD, only : USTDIR, ASF, FPIS, ICEF, TIC1, TIC5, WLV #ifdef W3_WRST USE W3IDATMD, ONLY: WXN, WYN, W3SETI USE W3IDATMD, ONLY: WXNwrst, WYNwrst @@ -278,10 +282,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) #ifdef W3_TIMINGS USE W3PARALL, ONLY: PRINT_MY_TIME #endif -#ifdef W3_CESMCOUPLED - USE W3ADATMD , ONLY : LAMULT - USE WAV_SHR_MOD, ONLY : RUNTYPE -#endif + USE w3odatmd, ONLY : RUNTYPE, INITFILE !!!!!/PDLIB USE PDLIB_FIELD_VEC!, only : UNST_PDLIB_READ_FROM_FILE, UNST_PDLIB_WRITE_TO_FILE #ifdef W3_PDLIB USE PDLIB_FIELD_VEC @@ -290,7 +291,8 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) USE W3SERVMD, ONLY: STRACE #endif ! - IMPLICIT NONE + use w3timemd, only: set_user_timestring + use w3odatmd, only: use_user_restname, user_restfname, ndso ! #ifdef W3_MPI INCLUDE "mpif.h" @@ -335,15 +337,12 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) LOGICAL :: NDSROPN CHARACTER(LEN=4) :: TYPE CHARACTER(LEN=10) :: VERTST -#ifdef W3_CESMCOUPLED - CHARACTER(LEN=512) :: FNAME -#else -! CHARACTER(LEN=21) :: FNAME - CHARACTER(LEN=40) :: FNAME -#endif + CHARACTER(LEN=512) :: FNAME CHARACTER(LEN=26) :: IDTST CHARACTER(LEN=30) :: TNAME CHARACTER(LEN=15) :: TIMETAG + character(len=16) :: user_timestring !YYYY-MM-DD-SSSSS + logical :: exists !/ !/ ------------------------------------------------------------------- / !/ @@ -438,20 +437,47 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ! ! open file ---------------------------------------------------------- * ! -#ifdef W3_CESMCOUPLED - call CESM_REST_FILENAME(WRITE, FNAME) - IFILE = IFILE + 1 - + 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=FNAME,FORM='UNFORMATTED', & + open (ndsr,file=trim(fname), form='unformatted', convert=file_endian, & ACCESS='STREAM',ERR=800,IOSTAT=IERR) ELSE ! READ - OPEN (NDSR, FILE=FNAME, FORM='UNFORMATTED', & + open (ndsr, file=trim(fname), form='unformatted', convert=file_endian, & ACCESS='STREAM',ERR=800,IOSTAT=IERR, & STATUS='OLD',ACTION='READ') END IF -#else + else I = LEN_TRIM(FILEXT) J = LEN_TRIM(FNMPRE) ! @@ -476,7 +502,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) IFILE = IFILE + 1 ! #ifdef W3_T - WRITE (NDST,9001) FNAME, LRECL + WRITE (NDST,9001) trim(FNAME), LRECL #endif ! @@ -493,14 +519,14 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) IF ( WRITE ) THEN IF ( .NOT.IOSFLG .OR. IAPROC.EQ.NAPRST ) & - OPEN (NDSR,FILE=FNMPRE(:J)//FNAME,form='UNFORMATTED', convert=file_endian, & + OPEN (NDSR,FILE=FNMPRE(:J)//trim(FNAME),form='UNFORMATTED', convert=file_endian, & ACCESS='STREAM',ERR=800,IOSTAT=IERR) ELSE - OPEN (NDSR,FILE=FNMPRE(:J)//FNAME,form='UNFORMATTED', convert=file_endian, & + OPEN (NDSR,FILE=FNMPRE(:J)//trim(FNAME),form='UNFORMATTED', convert=file_endian, & ACCESS='STREAM',ERR=800,IOSTAT=IERR, & STATUS='OLD',ACTION='READ') END IF -#endif + end if ! ! test info ---------------------------------------------------------- * ! @@ -1162,7 +1188,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ! Updates reflections maps: ! IF (GTYPE.EQ.UNGTYPE) THEN -!AR: not needed since already initialized on w3iogr CALL SET_UG_IOBP #ifdef W3_REF1 ELSE CALL W3SETREF @@ -1640,71 +1665,15 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) !/ End of W3IORS ----------------------------------------------------- / !/ END SUBROUTINE W3IORS -#ifdef W3_CESMCOUPLED - SUBROUTINE CESM_REST_FILENAME(LWRITE, FNAME) - USE WAV_SHR_MOD , ONLY : CASENAME, INITFILE, INST_SUFFIX, RUNTYPE - USE W3WDATMD , ONLY : TIME - USE W3SERVMD , ONLY : EXTCDE - USE W3ODATMD , ONLY : NDS, IAPROC, NAPOUT - ! input/output variables - logical, intent(in) :: lwrite - character(len=*), intent(out) :: fname - ! local variables - integer :: yy,mm,dd,hh,mn,ss,totsec - logical :: exists - logical :: lread - !---------------------------------------------- - ! create local lread logical for clarity - if (lwrite) then - lread = .false. - else - lread = .true. - end if - ! determine restart filename - if (lread .and. runtype /= 'continue') then - fname = initfile - else - yy = time(1)/10000 - mm = (time(1)-yy*10000)/100 - dd = (time(1)-yy*10000-mm*100) - hh = time(2)/10000 - mn = (time(2)-hh*10000)/100 - ss = (time(2)-hh*10000-mn*100) - totsec = hh*3600+mn*60+ss - if (len_trim(inst_suffix) > 0) then - write(fname,'(a,i4.4,a,i2.2,a,i2.2,a,i5.5)') & - trim(casename)//'.ww3'//trim(inst_suffix)//'.r.',yy,'-',mm,'-',dd,'-',totsec - else - write(fname,'(a,i4.4,a,i2.2,a,i2.2,a,i5.5)') & - trim(casename)//'.ww3.r.',yy,'-',mm,'-',dd,'-',totsec - endif - end if - ! check that if read the file exists - if (lread) then - inquire( file=fname, exist=exists) - if (.not. exists ) then - CALL EXTCDE (60, MSG="required initial/restart file " // trim(fname) // "does not exist") - end if - end if - ! write out filename - if (iaproc == napout) then - if (lwrite) then - write (nds(1),'(a)') ' writing restart file '//trim(fname) - else - write (nds(1),'(a)') ' reading initial/restart file '//trim(fname) - end if - end if - end subroutine cesm_rest_filename -#endif !/ !/ End of module W3IORSMD -------------------------------------------- / !/ diff --git a/model/src/w3nmlshelmd.F90 b/model/src/w3nmlshelmd.F90 index 91df4b6833..d552776056 100644 --- a/model/src/w3nmlshelmd.F90 +++ b/model/src/w3nmlshelmd.F90 @@ -1,4 +1,4 @@ -#include "w3macros.h" +#include "w3macros.h" !/ ------------------------------------------------------------------- / MODULE W3NMLSHELMD !/ @@ -111,7 +111,7 @@ MODULE W3NMLSHELMD ! output date structure - TYPE NML_OUTPUT_TIME_T + TYPE NML_OUTPUT_TIME_T CHARACTER(15) :: START CHARACTER(15) :: STRIDE CHARACTER(15) :: STOP @@ -274,6 +274,7 @@ SUBROUTINE W3NMLSHEL (MPI_COMM, NDSI, INFILE, NML_DOMAIN, & #ifdef W3_S INTEGER, SAVE :: IENT = 0 #endif + logical :: is_open IERR = 0 #ifdef W3_S @@ -288,20 +289,22 @@ SUBROUTINE W3NMLSHEL (MPI_COMM, NDSI, INFILE, NML_DOMAIN, & ! open namelist log file IF ( NMPLOG .EQ. IMPROC ) THEN - NDSN = 3 - OPEN (NDSN, file=TRIM(INFILE)//'.log', form='formatted', iostat=IERR) + OPEN (newunit=NDSN, file=TRIM(INFILE)//'.log', form='formatted', iostat=IERR) IF (IERR.NE.0) THEN WRITE (MDSE,'(A)') 'ERROR: open full nml file '//TRIM(INFILE)//'.log failed' RETURN END IF END IF + inquire (unit=ndsi, opened=is_open) + if (.not. is_open) then ! open input file - open (NDSI, FILE=TRIM(INFILE), form='formatted', status='old', iostat=IERR) - IF (IERR.NE.0) THEN - WRITE (MDSE,'(A)') 'ERROR: open input file '//TRIM(INFILE)//' failed' - RETURN - END IF + open (NDSI, FILE=TRIM(INFILE), form='formatted', status='old', iostat=IERR) + IF (IERR.NE.0) THEN + WRITE (MDSE,'(A)') 'ERROR: open input file '//TRIM(INFILE)//' failed' + RETURN + END IF + end if ! read domain namelist CALL READ_DOMAIN_NML (NDSI, NML_DOMAIN) @@ -987,7 +990,7 @@ SUBROUTINE READ_HOMOGENEOUS_NML (NDSI, NML_HOMOG_COUNT, NML_HOMOG_INPUT) NML_HOMOG_COUNT = HOMOG_COUNT NML_HOMOG_INPUT = HOMOG_INPUT - + END SUBROUTINE READ_HOMOGENEOUS_NML !/ ------------------------------------------------------------------- / diff --git a/model/src/w3odatmd.F90 b/model/src/w3odatmd.F90 index 075b3118a5..c6da30d71a 100644 --- a/model/src/w3odatmd.F90 +++ b/model/src/w3odatmd.F90 @@ -310,6 +310,10 @@ MODULE W3ODATMD ! !/ ------------------------------------------------------------------- / USE CONSTANTS, ONLY : UNDEF + + ! module default + IMPLICIT NONE + PUBLIC !/ !/ Module private variable for checking error returns @@ -554,6 +558,24 @@ 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 !/ CONTAINS !/ ------------------------------------------------------------------- / @@ -624,7 +646,6 @@ SUBROUTINE W3NOUT ( NDSERR, NDSTST ) USE W3SERVMD, ONLY: STRACE #endif ! - IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -1023,7 +1044,6 @@ SUBROUTINE W3DMO2 ( IMOD, NDSE, NDST, NPT ) USE W3SERVMD, ONLY: STRACE #endif ! - IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -1221,7 +1241,6 @@ SUBROUTINE W3DMO3 ( IMOD, NDSE, NDST ) USE W3SERVMD, ONLY: STRACE #endif ! - IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -1393,7 +1412,6 @@ SUBROUTINE W3DMO5 ( IMOD, NDSE, NDST, IBLOCK ) USE W3SERVMD, ONLY: STRACE #endif ! - IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -1598,7 +1616,6 @@ SUBROUTINE W3SETO ( IMOD, NDSERR, NDSTST ) USE W3SERVMD, ONLY: STRACE #endif ! - IMPLICIT NONE ! !/ !/ ------------------------------------------------------------------- / diff --git a/model/src/w3profsmd_pdlib.F90 b/model/src/w3profsmd_pdlib.F90 index 5e41d62336..f5256496d6 100644 --- a/model/src/w3profsmd_pdlib.F90 +++ b/model/src/w3profsmd_pdlib.F90 @@ -5623,10 +5623,7 @@ SUBROUTINE ADD_SOURCE_TERMS_NONLINEAR(DTG) #endif #ifdef W3_TR1 - CALL W3STR1 ( SPEC_VA, SPEC_VA, CG1, WN1, DEPTH, IX,VSTR, VDTR ) -#endif -#ifdef W3_TRX - CALL W3STRX + CALL W3STR1 ( SPEC_VA, CG1, WN1, DEPTH, IX,VSTR, VDTR ) #endif #ifdef W3_TRX CALL W3STRX diff --git a/model/src/w3sic4md.F90 b/model/src/w3sic4md.F90 index 9f9347de29..632d71fa38 100644 --- a/model/src/w3sic4md.F90 +++ b/model/src/w3sic4md.F90 @@ -292,9 +292,6 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) #ifdef W3_T1 USE W3ARRYMD, ONLY: OUTMAT #endif -#ifdef W3_CESMCOUPLED - USE W3IDATMD, ONLY: ICEI -#endif ! IMPLICIT NONE !/ @@ -319,10 +316,10 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) REAL :: ICECOEF1, ICECOEF2, ICECOEF3, & ICECOEF4, ICECOEF5, ICECOEF6, & ICECOEF7, ICECOEF8 -#ifdef W3_CESMCOUPLED - REAL :: x1,x2,x3,x1sqr,x2sqr,x3sqr - REAL :: perfour,amhb,bmhb,iceconc -#endif + + REAL :: x1,x2,x3,x1sqr,x2sqr,x3sqr !case 8 + REAL :: perfour,amhb,bmhb !case 8 + REAL :: KI1,KI2,KI3,KI4,FC5,FC6,FC7,FREQ REAL :: HS, EMEAN, HICE REAL, ALLOCATABLE :: WN_I(:) ! exponential decay rate for amplitude @@ -354,9 +351,6 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) KARG2 = 0.0 KARG3 = 0.0 WN_I = 0.0 -#ifdef W3_CESMCOUPLED - iceconc = 0.0 -#endif ALPHA = 0.0 ICECOEF1 = 0.0 ICECOEF2 = 0.0 @@ -385,9 +379,6 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) IF (INFLAGS2(-5)) ICECOEF3 = ICEP3(IX,IY) IF (INFLAGS2(-4)) ICECOEF4 = ICEP4(IX,IY) IF (INFLAGS2(-3)) ICECOEF5 = ICEP5(IX,IY) -#ifdef W3_CESMCOUPLED - IF (INFLAGS2(4)) iceconc = ICEI(IX,IY) -#endif ! Borrow from Smud (error if BT8 or BT9) #ifdef W3_BT8 @@ -526,7 +517,6 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) END DO WN_I= 0.5 * ALPHA -#ifdef W3_CESMCOUPLED CASE (8) !CMB added option of cubic fit to Meylan, Horvat & Bitz in prep ! ICECOEF1 is thickness @@ -538,8 +528,6 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) x2=max(2.5,x2) x2sqr=x2*x2 x3sqr=x3*x3 - ! write(*,*) 'floe size', x2 - ! write(*,*) 'sic',iceconc amhb = 2.12e-3 bmhb = 4.59e-2 @@ -547,19 +535,16 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) x1=TPI/SIG(IK) ! period x1sqr=x1*x1 KARG1(ik)=-0.26982 + 1.5043*x3 - 0.70112*x3sqr + 0.011037*x2 + & - -0.0073178*x2*x3 + 0.00036604*x2*x3sqr + & - -0.00045789*x2sqr + 1.8034e-05*x2sqr*x3 + & - -0.7246*x1 + 0.12068*x1*x3 + & - -0.0051311*x1*x3sqr + 0.0059241*x1*x2 + & + (-0.0073178)*x2*x3 + 0.00036604*x2*x3sqr + & + (-0.00045789)*x2sqr + 1.8034e-05*x2sqr*x3 + & + (-0.7246)*x1 + 0.12068*x1*x3 + & + (-0.0051311)*x1*x3sqr + 0.0059241*x1*x2 + & 0.00010771*x1*x2*x3 - 1.0171e-05*x1*x2sqr + & 0.0035412*x1sqr - 0.0031893*x1sqr*x3 + & - -0.00010791*x1sqr*x2 + & + (-0.00010791)*x1sqr*x2 + & 0.00031073*x1**3 + 1.5996e-06*x2**3 + 0.090994*x3**3 KARG1(ik)=min(karg1(ik),0.0) WN_I(ik) = 10.0**KARG1(ik) - ! if (WN_I(ik).gt.0.9) then - ! write(*,*) 'whacky',WN_I(ik),x1,x2,x3 - ! endif perfour=x1sqr*x1sqr if ((x1.gt.5.0) .and. (x1.lt.20.0)) then WN_I(IK) = WN_I(IK) + amhb/x1sqr+bmhb/perfour @@ -567,9 +552,6 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) WN_I(IK) = amhb/x1sqr+bmhb/perfour endif end do - ! write(*,*) 'Attena',(10.0**KARG1(IK),IK=1,5) - ! write(*,*) 'Attenb',(WN_I(IK),IK=1,5) -#endif CASE DEFAULT WN_I = ICECOEF1 !Default to IC1: Uniform in k diff --git a/model/src/w3str2md.F90 b/model/src/w3str2md.F90 index b66688b8b1..4e0095035d 100644 --- a/model/src/w3str2md.F90 +++ b/model/src/w3str2md.F90 @@ -407,4 +407,4 @@ SUBROUTINE W3STR2 (A, CG, WN, DEPTH, IX, S, D) END SUBROUTINE W3STR2 !/ ------------------------------------------------------------------- / !/ - END MODULE W3STR1MD + END MODULE W3STR2MD diff --git a/model/src/w3timemd.F90 b/model/src/w3timemd.F90 index 73aee83993..42bca707a4 100644 --- a/model/src/w3timemd.F90 +++ b/model/src/w3timemd.F90 @@ -72,6 +72,9 @@ MODULE W3TIMEMD USE W3SERVMD, ONLY: STRACE #endif ! + ! module default + implicit none + PUBLIC ! INTEGER, PRIVATE :: PRFTB(8) @@ -130,8 +133,6 @@ SUBROUTINE TICK21 ( TIME, DTIME ) ! 10. Source code : ! !/ ------------------------------------------------------------------- / -!/ - IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -244,7 +245,6 @@ INTEGER FUNCTION IYMD21 ( NYMD ,M ) ! !/ ------------------------------------------------------------------- / !/ - IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -383,7 +383,6 @@ REAL FUNCTION DSEC21 ( TIME1, TIME2 ) ! !/ ------------------------------------------------------------------- / !/ - IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -505,7 +504,6 @@ INTEGER FUNCTION MYMD21 ( NYMD ) ! !/ ------------------------------------------------------------------- / !/ - IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -634,7 +632,6 @@ REAL FUNCTION TDIFF ( T1, T2 ) ! !/ ------------------------------------------------------------------- / !/ - IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -714,7 +711,6 @@ SUBROUTINE STME21 ( TIME , DTME21 ) ! !/ ------------------------------------------------------------------- / !/ - IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -765,7 +761,6 @@ INTEGER FUNCTION JULDAY(id,mm,iyyy) ! !/ ------------------------------------------------------------------- / !/ - IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / INTEGER(KIND=4), INTENT(in) :: id,mm,iyyy @@ -2017,7 +2012,27 @@ SUBROUTINE T2ISO(TIME,ISODT) !/ End of T2ISO ------------------------------------------------------ / !/ END SUBROUTINE T2ISO +!> Create a timestring for custom user filenames +!! @details Creates a character string of form YYYY-MM-DD-SSSSS +!! @param[in] time(2) YYYYMMDD HHMMSS +!! @param[out] user_timestring YYYY-MM-DD-SSSSS +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 + subroutine set_user_timestring(time, user_timestring) + integer , intent(in) :: time(2) + character(len=16), intent(out) :: user_timestring + ! local variables + integer :: yy,mm,dd,hh,mn,ss,totsec + yy = time(1)/10000 + mm = (time(1)-yy*10000)/100 + dd = (time(1)-yy*10000-mm*100) + hh = time(2)/10000 + mn = (time(2)-hh*10000)/100 + ss = (time(2)-hh*10000-mn*100) + totsec = hh*3600+mn*60+ss + write(user_timestring,'(i4.4,a,i2.2,a,i2.2,a,i5.5)')yy,'-',mm,'-',dd,'-',totsec + end subroutine set_user_timestring !/ End of module W3TIMEMD -------------------------------------------- / !/ END MODULE W3TIMEMD diff --git a/model/src/w3wavemd.F90 b/model/src/w3wavemd.F90 index ddc78ddae6..847e9f15ce 100644 --- a/model/src/w3wavemd.F90 +++ b/model/src/w3wavemd.F90 @@ -176,6 +176,8 @@ MODULE W3WAVEMD #ifdef W3_MPI USE W3ADATMD, ONLY: MPIBUF #endif + ! module default + IMPLICIT NONE ! PUBLIC !/ @@ -450,13 +452,9 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #ifdef W3_TIMINGS USE W3PARALL, only : PRINT_MY_TIME #endif -#if defined(W3_UWMNCOUT) || defined(W3_CESMCOUPLED) - ! flags for restart and history writes - USE WAV_SHR_MOD , only : RSTWR, HISTWR - USE W3IOGONCDMD , ONLY : W3IOGONCD -#endif + use w3iogoncdmd , only : w3iogoncd + use w3odatmd , only : histwr, rstwr, user_netcdf_grdout ! - IMPLICIT NONE ! #ifdef W3_MPI INCLUDE "mpif.h" @@ -475,9 +473,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & !/ ------------------------------------------------------------------- / !/ Local parameters : !/ -#ifdef W3_T - INTEGER :: ILEN -#endif #ifdef W3_S INTEGER, SAVE :: IENT = 0 #endif @@ -490,15 +485,11 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & INTEGER :: TTEST(2),DTTEST REAL :: ICEDAVE ! -#ifdef W3_MPI LOGICAL :: SBSED -#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(:,:) @@ -554,9 +545,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #endif ! -#ifdef W3_SBS CHARACTER(LEN=30) :: FOUTNAME -#endif ! #ifdef W3_T REAL :: INDSORT(NSEA), DTCFL1(NSEA) @@ -568,12 +557,33 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & 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 !/ ------------------------------------------------------------------- / ! 0. Initializations ! -! 0.a Set pointers to data structure -! + XXX = undef + memunit = 40000+iaproc #ifdef W3_COU SCREEN = 333 #endif @@ -664,8 +674,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & OUTID = ' ' FLACT = ITIME .EQ. 0 FLMAP = ITIME .EQ. 0 - FLDDIR = ITIME .EQ. 0 .AND. ( FLCTH .OR. FSREFRACTION & - .OR. FLCK .OR. FSFREQSHIFT ) + FLDDIR = ITIME .EQ. 0 .AND. ( FLCTH .OR. FSREFRACTION .OR. FLCK .OR. FSFREQSHIFT ) ! FLPFLD = .FALSE. DO J=1,NOGE(4) @@ -697,15 +706,12 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & FACX = 1. END IF ! -#ifdef W3_SBS - NDSOFLG = 99 -#endif -#ifdef W3_MPI SBSED = .FALSE. -#endif -#ifdef W3_SBS - SBSED = .TRUE. -#endif + if (w3_sbs_flag) then + NDSOFLG = 99 + SBSED = .TRUE. + end if + ! TAUWX = 0. TAUWY = 0. @@ -713,8 +719,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! 0.d Test output ! #ifdef W3_T - ILEN = LEN_TRIM(FILEXT) - WRITE (NDST,9000) IMOD, FILEXT(:ILEN), TEND + WRITE (NDST,9000) IMOD, trim(FILEXT), TEND #endif ! ! 1. Check the consistency of the input ----------------------------- / @@ -959,8 +964,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & FIXEDVISC=IC3PARS(14) FIXEDDENS=IC3PARS(15) FIXEDELAS=IC3PARS(16) - IF ( (FIXEDVISC.LT.0.0).OR.(FIXEDDENS.LT.0.0) .OR. & - (FIXEDELAS.LT.0.0) ) THEN + IF ( (FIXEDVISC.LT.0.0).OR.(FIXEDDENS.LT.0.0) .OR. (FIXEDELAS.LT.0.0) ) THEN IF ( IAPROC .EQ. NAPERR ) & WRITE(NDSE,*)'Cheng method requires stationary', & ' and uniform rheology from namelist.' @@ -1213,8 +1217,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #endif ! #ifdef W3_T - WRITE (NDST,9021) ITIME, IT, TIME, FLMAP, FLDDIR, & - VGX, VGY, DTG, DTRES + WRITE (NDST,9021) ITIME, IT, TIME, FLMAP, FLDDIR, VGX, VGY, DTG, DTRES #endif #ifdef W3_DEBUGSRC WRITE(740+IAPROC,*) 'DTG 2 : DTG=', DTG @@ -1420,8 +1423,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & WRITE(740+IAPROC,*) 'Before call to W3IOBC' FLUSH(740+IAPROC) #endif - CALL W3IOBC ( 'READ', NDS(9), TBPI0, TBPIN, & - ITEST, IMOD ) + CALL W3IOBC ( 'READ', NDS(9), TBPI0, TBPIN, ITEST, IMOD ) #ifdef W3_DEBUGIOBC WRITE(740+IAPROC,*) 'After call to W3IOBC' WRITE(740+IAPROC,*) 'ITEST=', ITEST @@ -1621,8 +1623,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & DTL0 = 0. FLACT = .TRUE. FLMAP = .TRUE. - FLDDIR = FLDDIR .OR. FLCTH .OR. FSREFRACTION & - .OR. FLCK .OR. FSFREQSHIFT + FLDDIR = FLDDIR .OR. FLCTH .OR. FSREFRACTION .OR. FLCK .OR. FSFREQSHIFT END IF #ifdef W3_DEBUGRUN WRITE(740+IAPROC,*) 'After IDACT if test' @@ -1674,8 +1675,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & CALL W3MAPT #endif END IF !! GTYPE - CALL W3NMIN ( MAPSTA, FLAG0 ) - IF ( FLAG0 .AND. IAPROC.EQ.NAPERR ) WRITE (NDSE,1030) IMOD FLMAP = .FALSE. END IF ! @@ -1831,15 +1830,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & D50=SED_D50(ISEA) PSIC=SED_PSIC(ISEA) #endif -#ifdef W3_REF1 - REFLEC=REFLC(:,ISEA) - REFLEC(4)=BERG(ISEA)*REFLEC(4) - REFLED=REFLD(:,ISEA) -#endif -#ifdef W3_BT4 - D50=SED_D50(ISEA) - PSIC=SED_PSIC(ISEA) -#endif ! #ifdef W3_DEBUGRUN DO IS = 1, NSPEC @@ -1873,7 +1863,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & VSioDummy, VDioDummy, SHAVETOT(JSEA), & ALPHA(1:NK,JSEA), WN(1:NK,ISEA), & CG(1:NK,ISEA), CLATS(ISEA), DW(ISEA), U10(ISEA), & - U10D(ISEA), & + U10D(ISEA), & #ifdef W3_FLX5 TAUA(ISEA), TAUADIR(ISEA), & #endif @@ -1910,8 +1900,8 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & DTDYN (JSEA) = UNDEF FCUT (JSEA) = UNDEF END IF - END DO ! JSEA - END IF ! PDLIB + END DO ! JSEA + END IF ! PDLIB #endif @@ -2001,8 +1991,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & IF (.NOT. LPDLIB) THEN #endif #ifdef W3_PR3 - CALL W3CFLUG ( ISEA, NKCFL, FACX, FACX, DTG, & - MAPFS, CFLXYMAX(JSEA), VGX, VGY ) + CALL W3CFLUG ( ISEA, NKCFL, FACX, FACX, DTG, MAPFS, CFLXYMAX(JSEA), VGX, VGY ) #endif #ifdef W3_PDLIB ENDIF @@ -2010,8 +1999,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #ifdef W3_PR3 END IF ELSE - CALL W3CFLXY ( ISEA, DTG, MAPSTA, MAPFS, & - CFLXYMAX(JSEA), VGX, VGY ) + CALL W3CFLXY ( ISEA, DTG, MAPSTA, MAPFS, CFLXYMAX(JSEA), VGX, VGY ) END IF #endif END DO @@ -2065,9 +2053,10 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & DO JSEA = 1, MIN(NSEAL,200) ISEA = NINT(INDSORT(JSEA)) ! will not work with MPI IX = MAPSF(ISEA,1) - IF (JSEA.EQ.1) & + IF (JSEA.EQ.1) then WRITE(995,*) ' IP dtmax_exp(ip) x-coord y-coord z-coord' - WRITE(995,'(I10,F10.2,3F10.4)') IX, DTCFL1(JSEA), XGRD(1,IX), YGRD(2,IX), ZB(IX) + end IF + WRITE(995,'(I10,F10.2,3F10.4)') IX, DTCFL1(JSEA), XGRD(1,IX), YGRD(2,IX), ZB(IX) END DO ! JSEA CLOSE(995) END IF @@ -2270,8 +2259,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #endif #ifdef W3_PDLIB DO ISPEC=1,NSPEC - CALL PDLIB_W3XYPUG ( ISPEC, FACX, FACX, DTG, & - VGX, VGY, UGDTUPDATE ) + CALL PDLIB_W3XYPUG ( ISPEC, FACX, FACX, DTG, VGX, VGY, UGDTUPDATE ) END DO #endif #ifdef W3_DEBUGRUN @@ -2365,16 +2353,13 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & IF (.NOT. LPDLIB) THEN #endif #ifdef W3_PR1 - CALL W3XYPUG ( ISPEC, FACX, FACX, DTG, & - FIELD, VGX, VGY, UGDTUPDATE ) + CALL W3XYPUG ( ISPEC, FACX, FACX, DTG, FIELD, VGX, VGY, UGDTUPDATE ) #endif #ifdef W3_PR2 - CALL W3XYPUG ( ISPEC, FACX, FACX, DTG, & - FIELD, VGX, VGY, UGDTUPDATE ) + CALL W3XYPUG ( ISPEC, FACX, FACX, DTG, FIELD, VGX, VGY, UGDTUPDATE ) #endif #ifdef W3_PR3 - CALL W3XYPUG ( ISPEC, FACX, FACX, DTG, & - FIELD, VGX, VGY, UGDTUPDATE ) + CALL W3XYPUG ( ISPEC, FACX, FACX, DTG, FIELD, VGX, VGY, UGDTUPDATE ) #endif #ifdef W3_MPI END IF @@ -2410,10 +2395,8 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #ifdef W3_MPI IF ( NRQSG1 .GT. 0 ) THEN ALLOCATE ( STATCO(MPI_STATUS_SIZE,NRQSG1) ) - CALL MPI_WAITALL (NRQSG1, IRQSG1(1,1), STATCO, & - IERR_MPI) - CALL MPI_WAITALL (NRQSG1, IRQSG1(1,2), STATCO, & - IERR_MPI) + CALL MPI_WAITALL (NRQSG1, IRQSG1(1,1), STATCO, IERR_MPI) + CALL MPI_WAITALL (NRQSG1, IRQSG1(1,2), STATCO, IERR_MPI) DEALLOCATE ( STATCO ) END IF #endif @@ -2445,11 +2428,11 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & JSEA = 1 + (IY - ISPEC - 1)/NAPROC #endif #ifdef W3_SHRD - ISPEC = 0 - JSEA = IY + ISPEC = 0 + JSEA = IY +#endif #endif -#endif -! W3_SMC ... +! W3_SMC ... ! #ifdef W3_SMC !!Li Assign boundary cell spectra. @@ -3009,98 +2992,79 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & WRITE (NDST,9042) LOCAL, FLPART, FLOUTG #endif ! - IF ( LOCAL .AND. FLPART ) CALL W3CPRT ( IMOD ) - IF ( LOCAL .AND. (FLOUTG .OR. FLOUTG2) ) & - CALL W3OUTG ( VA, FLPFLD, FLOUTG, FLOUTG2 ) + 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 -! -#ifdef W3_MPI -#if defined(W3_UWMNCOUT) || defined(W3_CESMCOUPLED) - ! CMB: dsec21 computes the difference between time1, time2 in sec - ! pretty sure tonext always equal to time on the hour - ! so this is getting called every hour - ! seems like it only needs to be done when histwr=T though - ! so am chaning - IF ( histwr .and. & - (FLOUT(1) .OR. FLOUT(7)) ) THEN -#else - IF ( ( (DSEC21(TIME,TONEXT(:,1)).EQ.0.) .AND. FLOUT(1) ) .OR. & - ( (DSEC21(TIME,TONEXT(:,7)).EQ.0.) .AND. FLOUT(7) .AND. & - SBSED ) ) THEN -#endif - IF (.NOT. LPDLIB .or. (GTYPE.ne.UNGTYPE)) THEN - IF (NRQGO.NE.0 ) THEN -#endif + ! + do_startall = .false. + if (w3_cesmcoupled_flag .and. histwr) then + IF ( FLOUT(1) .OR. FLOUT(7) ) THEN + do_startall = .true. + end IF + else + IF ( ( (DSEC21(TIME,TONEXT(:,1)).EQ.0.) .AND. FLOUT(1) ) .OR. & + ( (DSEC21(TIME,TONEXT(:,7)).EQ.0.) .AND. FLOUT(7) .AND. SBSED ) ) THEN + do_startall = .true. + end IF + end if + if (do_startall) then + IF (.NOT. LPDLIB .or. (GTYPE.ne.UNGTYPE)) THEN + IF (NRQGO.NE.0 ) THEN #ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'BEFORE STARTALL NRQGO.NE.0 , step 0', & - NRQGO, IRQGO, GTYPE, UNGTYPE, .NOT. LPDLIB .or. (GTYPE.ne.UNGTYPE) - FLUSH(740+IAPROC) -#endif -#ifdef W3_MPI - CALL MPI_STARTALL ( NRQGO, IRQGO , IERR_MPI ) -#if defined(W3_UWMNCOUT) || defined(W3_CESMCOUPLED) - write(*,*) 'UWM/CESM histwr mpi_startall', histwr, NRQGO, IERR_MPI -#endif + WRITE(740+IAPROC,*) 'BEFORE STARTALL NRQGO.NE.0 , step 0', & + NRQGO, IRQGO, GTYPE, UNGTYPE, .NOT. LPDLIB .or. (GTYPE.ne.UNGTYPE) #endif + CALL MPI_STARTALL ( NRQGO, IRQGO , IERR_MPI ) #ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'AFTER STARTALL NRQGO.NE.0, step 0' - FLUSH(740+IAPROC) + WRITE(740+IAPROC,*) 'AFTER STARTALL NRQGO.NE.0, step 0' #endif -#ifdef W3_MPI - FLGMPI(0) = .TRUE. - NRQMAX = MAX ( NRQMAX , NRQGO ) -#endif + FLGMPI(0) = .TRUE. + NRQMAX = MAX ( NRQMAX , NRQGO ) #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 + WRITE (NDST,9043) '1a', NRQGO, NRQMAX, NAPFLD #endif + END IF + ! + IF (NRQGO2.NE.0 ) THEN #ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'BEFORE STARTALL NRQGO2.NE.0, step 0', & - NRQGO2, IRQGO2, GTYPE, UNGTYPE, .NOT. LPDLIB .or. (GTYPE.ne.UNGTYPE) - FLUSH(740+IAPROC) -#endif -#ifdef W3_MPI - CALL MPI_STARTALL ( NRQGO2, IRQGO2, IERR_MPI ) -#if defined(W3_UWMNCOUT) || defined(W3_CESMCOUPLED) - write(*,*) 'UWM/CESM: histwr mpi_startall', histwr, NRQGO, IERR_MPI -#endif + WRITE(740+IAPROC,*) 'BEFORE STARTALL NRQGO2.NE.0, step 0', & + NRQGO2, IRQGO2, GTYPE, UNGTYPE, .NOT. LPDLIB .or. (GTYPE.ne.UNGTYPE) #endif + CALL MPI_STARTALL ( NRQGO2, IRQGO2, IERR_MPI ) + #ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'AFTER STARTALL NRQGO2.NE.0, step 0' - FLUSH(740+IAPROC) -#endif -#ifdef W3_MPI - FLGMPI(1) = .TRUE. - NRQMAX = MAX ( NRQMAX , NRQGO2 ) + WRITE(740+IAPROC,*) 'AFTER STARTALL NRQGO2.NE.0, step 0' #endif + FLGMPI(1) = .TRUE. + NRQMAX = MAX ( NRQMAX , NRQGO2 ) #ifdef W3_MPIT - WRITE (NDST,9043) '1b', NRQGO2, NRQMAX, NAPFLD -#endif -#ifdef W3_MPI - END IF - ELSE + WRITE (NDST,9043) '1b', NRQGO2, NRQMAX, NAPFLD #endif + END IF + ELSE #ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'BEFORE DO_OUTPUT_EXCHANGES, step 0' - FLUSH(740+IAPROC) + WRITE(740+IAPROC,*) 'BEFORE DO_OUTPUT_EXCHANGES, step 0' #endif #ifdef W3_PDLIB - CALL DO_OUTPUT_EXCHANGES(IMOD) + CALL DO_OUTPUT_EXCHANGES(IMOD) #endif -#ifdef W3_MPI - END IF - END IF + END IF ! IF (.NOT. LPDLIB .or. (GTYPE.ne.UNGTYPE)) + END IF ! if (do_startall) #endif #ifdef W3_MEMCHECK @@ -3191,8 +3155,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & FLUSH(740+IAPROC) #endif #ifdef W3_MPI - IF ( FLOUT(5) .AND. NRQBP2.NE.0 .AND. & - IAPROC.EQ.NAPBPT) THEN + IF ( FLOUT(5) .AND. NRQBP2.NE.0 .AND. IAPROC.EQ.NAPBPT) THEN IF ( DSEC21(TIME,TONEXT(:,5)).EQ.0. ) THEN CALL MPI_STARTALL (NRQBP2,IRQBP2,IERR_MPI) NRQMAX = MAX ( NRQMAX , NRQBP2 ) @@ -3210,8 +3173,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & FLUSH(740+IAPROC) #endif #ifdef W3_MPI - IF ( NRQMAX .NE. 0 ) ALLOCATE & - ( STATIO(MPI_STATUS_SIZE,NRQMAX) ) + IF ( NRQMAX .NE. 0 ) ALLOCATE ( STATIO(MPI_STATUS_SIZE,NRQMAX) ) #endif #ifdef W3_MEMCHECK @@ -3251,6 +3213,28 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & WRITE(740+IAPROC,*) 'Matching FLOUT(J)' FLUSH(740+IAPROC) #endif + ! + ! 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 ! @@ -3261,102 +3245,75 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & DTTST = DSEC21 ( TIME, TOUT ) ! IF ( DTTST .EQ. 0. ) THEN -#if defined(W3_UWMNCOUT) || defined(W3_CESMCOUPLED) - ! This assumes that W3_SBS is not defined - IF ( ( J .EQ. 1 ) .AND. histwr) THEN - CALL MPI_WAITALL( NRQGO, IRQGO, STATIO, IERR_MPI ) - FLGMPI(0) = .FALSE. - write(*,*) 'CESM w3wavemd: hist flag 1', j, histwr, time, IERR_MPI - IF ( IAPROC .EQ. NAPFLD ) THEN - IF ( FLGMPI(1) ) CALL MPI_WAITALL & - ( NRQGO2, IRQGO2, STATIO, IERR_MPI ) - FLGMPI(1) = .FALSE. - write(*,*) 'CESM w3wavemd: hist flag 2', j, histwr, time, IERR_MPI - CALL W3IOGONCD () - END IF -#else - IF ( ( J .EQ. 1 ) & -#ifdef W3_SBS - .OR. ( J .EQ. 7 ) & + if (do_gridded_output) then + if (user_netcdf_grdout) then +#ifdef W3_MPI + CALL MPI_WAITALL( NRQGO, IRQGO, STATIO, IERR_MPI ) + FLGMPI(0) = .FALSE. #endif - ) THEN - IF ( IAPROC .EQ. NAPFLD ) THEN + IF ( IAPROC .EQ. NAPFLD ) THEN #ifdef W3_MPI - IF ( FLGMPI(1) ) CALL MPI_WAITALL & - ( NRQGO2, IRQGO2, STATIO, IERR_MPI ) + IF ( FLGMPI(1) ) CALL MPI_WAITALL( NRQGO2, IRQGO2, STATIO, IERR_MPI ) FLGMPI(1) = .FALSE. #endif -! -#ifdef W3_SBS - IF ( J .EQ. 1 ) THEN -#endif - CALL W3IOGO( 'WRITE', NDS(7), ITEST, IMOD ) -#ifdef W3_SBS - ENDIF - ! - ! - ! 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) -! - OPEN( UNIT=NDSOFLG, FILE=FOUTNAME) - CLOSE( NDSOFLG ) -#endif - END IF -! -! end of UWMNCOUT/W3_CESMCOUPLED cppif-block + 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 - ELSE IF ( J .EQ. 2 ) THEN -! -! Point output -! + 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 IF ( IAPROC .EQ. NAPPNT ) THEN -! -! Gets the necessary spectral data -! CALL W3IOPE ( VA ) CALL W3IOPO ( 'WRITE', NDS(8), ITEST, IMOD ) END IF -! - ELSE IF ( J .EQ. 3 ) THEN -! -! Track output -! + + ELSE IF ( do_track_output ) THEN CALL W3IOTR ( NDS(11), NDS(12), VA, IMOD ) -#ifdef W3_CESMCOUPLED - ! add restart flag - ELSE IF ( J .EQ. 4 .AND. rstwr ) THEN - CALL W3IORS ('HOT', NDS(6), XXX, IMOD, FLOUT(8) ) -#else - ELSE IF ( J .EQ. 4 ) THEN + + ELSE IF ( do_restart_output ) THEN CALL W3IORS ('HOT', NDS(6), XXX, IMOD, FLOUT(8) ) -#endif ITEST = RSTYPE - ELSE IF ( J .EQ. 5 ) THEN + + ELSE IF ( do_wavefield_separation_output ) THEN IF ( IAPROC .EQ. NAPBPT ) THEN #ifdef W3_MPI - IF (NRQBP2.NE.0) CALL MPI_WAITALL & - ( NRQBP2, IRQBP2,STATIO, IERR_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 ( J .EQ. 6 ) THEN + ELSE IF ( do_sf_output ) THEN CALL W3IOSF ( NDS(13), IMOD ) #ifdef W3_OASIS - ELSE IF ( J .EQ. 7 ) THEN + ELSE IF ( do_coupler_output ) 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 @@ -3473,20 +3430,16 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! #ifdef W3_MPI - IF ( FLGMPI(0) ) CALL MPI_WAITALL & - ( NRQGO, IRQGO , STATIO, IERR_MPI ) -#if defined(W3_UWMNCOUT) || defined(W3_CESMCOUPLED) - IF ( FLGMPI(1) .and. ( IAPROC .EQ. NAPFLD ) ) CALL MPI_WAITALL & - ( NRQGO2, IRQGO2 , STATIO, IERR_MPI ) -#endif - 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 ) - IF ( FLGMPI(5) ) CALL MPI_WAITALL & - ( NRQBP, IRQBP1, STATIO, IERR_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 ) + IF ( FLGMPI(5) ) CALL MPI_WAITALL ( NRQBP, IRQBP1, STATIO, IERR_MPI ) IF ( NRQMAX .NE. 0 ) DEALLOCATE ( STATIO ) #endif ! @@ -3774,7 +3727,6 @@ SUBROUTINE W3GATH ( ISPEC, FIELD ) USE W3ODATMD, ONLY: NDST, IAPROC, NAPROC, NOTYPE #endif !/ - IMPLICIT NONE ! #ifdef W3_MPI INCLUDE "mpif.h" @@ -3869,8 +3821,7 @@ SUBROUTINE W3GATH ( ISPEC, FIELD ) BSTAT(IBFLOC) = 1 BISPL(IBFLOC) = ISPLOC IOFF = 1 + (ISPLOC-1)*NRQSG2 - IF ( NRQSG2 .GT. 0 ) CALL & - MPI_STARTALL ( NRQSG2, IRQSG2(IOFF,1), IERR_MPI ) + IF ( NRQSG2 .GT. 0 ) CALL MPI_STARTALL ( NRQSG2, IRQSG2(IOFF,1), IERR_MPI ) #endif #ifdef W3_MPIT STRT(10:10) = 'g' @@ -3892,8 +3843,7 @@ SUBROUTINE W3GATH ( ISPEC, FIELD ) ! #ifdef W3_MPI IOFF = 1 + (BISPL(IBFLOC)-1)*NRQSG2 - IF ( NRQSG2 .GT. 0 ) CALL & - MPI_WAITALL ( NRQSG2, IRQSG2(IOFF,1), STATUS, IERR_MPI ) + IF ( NRQSG2 .GT. 0 ) CALL MPI_WAITALL ( NRQSG2, IRQSG2(IOFF,1), STATUS, IERR_MPI ) #endif ! #ifdef W3_MPIT @@ -4082,7 +4032,6 @@ SUBROUTINE W3SCAT ( ISPEC, MAPSTA, FIELD ) USE CONSTANTS, ONLY : LPDLIB USE W3PARALL, only: INIT_GET_ISEA !/ - IMPLICIT NONE ! #ifdef W3_MPI INCLUDE "mpif.h" @@ -4161,8 +4110,7 @@ SUBROUTINE W3SCAT ( ISPEC, MAPSTA, FIELD ) ! #ifdef W3_MPI IOFF = 1 + (ISPLOC-1)*NRQSG2 - IF ( NRQSG2 .GT. 0 ) CALL & - MPI_STARTALL ( NRQSG2, IRQSG2(IOFF,2), IERR_MPI ) + IF ( NRQSG2 .GT. 0 ) CALL MPI_STARTALL ( NRQSG2, IRQSG2(IOFF,2), IERR_MPI ) BSTAT(IBFLOC) = 2 #endif #ifdef W3_MPIT @@ -4193,14 +4141,13 @@ SUBROUTINE W3SCAT ( ISPEC, MAPSTA, FIELD ) IF ( BSTAT(IB0) .EQ. 2 ) THEN IOFF = 1 + (BISPL(IB0)-1)*NRQSG2 IF ( NRQSG2 .GT. 0 ) THEN - CALL MPI_TESTALL ( NRQSG2, IRQSG2(IOFF,2), DONE, & - STATUS, IERR_MPI ) + CALL MPI_TESTALL ( NRQSG2, IRQSG2(IOFF,2), DONE, STATUS, IERR_MPI ) ELSE DONE = .TRUE. END IF - IF ( DONE .AND. NRQSG2.GT.0 ) CALL & - MPI_WAITALL ( NRQSG2, IRQSG2(IOFF,2), & - STATUS, IERR_MPI ) + IF ( DONE .AND. NRQSG2.GT.0 ) THEN + CALL MPI_WAITALL ( NRQSG2, IRQSG2(IOFF,2), STATUS, IERR_MPI ) + END IF IF ( DONE ) THEN BSTAT(IB0) = 0 #endif @@ -4365,7 +4312,6 @@ SUBROUTINE W3NMIN ( MAPSTA, FLAG0 ) USE W3ODATMD, ONLY: NDST, NAPROC USE W3PARALL, ONLY: INIT_GET_JSEA_ISPROC !/ - IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list diff --git a/model/src/wav_comp_nuopc.F90 b/model/src/wav_comp_nuopc.F90 index 4109ac05af..4ab470f3cb 100644 --- a/model/src/wav_comp_nuopc.F90 +++ b/model/src/wav_comp_nuopc.F90 @@ -41,10 +41,13 @@ module wav_comp_nuopc use wav_import_export , only : advertise_fields, realize_fields use wav_shr_mod , only : state_diagnose, state_getfldptr, state_fldchk use wav_shr_mod , only : chkerr, state_setscalar, state_getscalar, alarmInit, ymd2date - use wav_shr_mod , only : runtype, merge_import, dbug_flag + use wav_shr_mod , only : wav_coupling_to_cice + 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 : time_origin, calendar_name, elapsed_secs use wav_shr_mod , only : casename, multigrid, inst_suffix, inst_index - use wav_shr_mod , only : time_origin, calendar_name, elapsed_secs #ifndef W3_CESMCOUPLED use wmwavemd , only : wmwave use wmupdtmd , only : wmupd2 @@ -73,39 +76,47 @@ module wav_comp_nuopc ! Private module data !-------------------------------------------------------------------------- - character(len=CL) :: flds_scalar_name = '' !< the default scalar field name - integer :: flds_scalar_num = 0 !< the default number of scalar fields - integer :: flds_scalar_index_nx = 0 !< the default size of the scalar field nx - integer :: flds_scalar_index_ny = 0 !< the default size of the scalar field ny - logical :: profile_memory = .false. !< default logical to control use of ESMF - !! memory profiling + character(len=CL) :: flds_scalar_name = '' !< the default scalar field name + integer :: flds_scalar_num = 0 !< the default number of scalar fields + integer :: flds_scalar_index_nx = 0 !< the default size of the scalar field nx + integer :: flds_scalar_index_ny = 0 !< the default size of the scalar field ny + logical :: profile_memory = .false. !< default logical to control use of ESMF + !! memory profiling - logical :: histwr_is_active = .false. !< default logical to control use of ESMF - !! alarms for writing history files - logical :: root_task = .false. !< logical to indicate root task + logical :: root_task = .false. !< logical to indicate root task #ifdef W3_CESMCOUPLED - logical :: cesmcoupled = .true. !< logical to indicate CESM use case + logical :: cesmcoupled = .true. !< logical to indicate CESM use case #else - logical :: cesmcoupled = .false. !< logical to indicate non-CESM use case - integer, allocatable :: tend(:,:) !< the ending time of ModelAdvance when - !! run with multigrid=true + logical :: cesmcoupled = .false. !< logical to indicate non-CESM use case #endif - - character(*), parameter :: modName = "(wav_comp_nuopc)" !< the name of this module - character(*), parameter :: u_FILE_u = & !< a character string for an ESMF log message + 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 :: time0(2) + integer :: timen(2) + + character(*), parameter :: modName = "(wav_comp_nuopc)" !< the name of this module + character(*), parameter :: u_FILE_u = & !< a character string for an ESMF log message __FILE__ -!=============================================================================== + !=============================================================================== contains -!=============================================================================== -!> The public entry point. The NUOPC SetService method registers all of the -!! user-provided subroutines in the module with the NUOPC layer -!! -!! @param[in] gcomp an ESMF_GridComp object -!! @param[out] rc return code -!! -!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov -!> @date 01-05-2022 + !=============================================================================== + !> The public entry point. The NUOPC SetService method registers all of the + !! user-provided subroutines in the module with the NUOPC layer + !! + !! @param[in] gcomp an ESMF_GridComp object + !! @param[out] rc return code + !! + !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov + !> @date 01-05-2022 subroutine SetServices(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -158,19 +169,19 @@ subroutine SetServices(gcomp, rc) end subroutine SetServices !=============================================================================== -!> Switch to IPDv01 by filtering all other phaseMap entries -!! -!> @details Called by NUOPC to set the version of the Initialize Phase Definition -!! (IPD) to use. -!! -!! @param[in] gcomp an ESMF_GridComp object -!! @param[in] importState an ESMF_State object for import fields -!! @param[in] exportState an ESMF_State object for export fields -!! @param[in] clock an ESMF_Clock object -!! @param[out] rc return code -!! -!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov -!> @date 01-05-2022 + !> Switch to IPDv01 by filtering all other phaseMap entries + !! + !> @details Called by NUOPC to set the version of the Initialize Phase Definition + !! (IPD) to use. + !! + !! @param[in] gcomp an ESMF_GridComp object + !! @param[in] importState an ESMF_State object for import fields + !! @param[in] exportState an ESMF_State object for export fields + !! @param[in] clock an ESMF_Clock object + !! @param[out] rc return code + !! + !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov + !> @date 01-05-2022 subroutine InitializeP0(gcomp, importState, exportState, clock, rc) type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState @@ -188,29 +199,29 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) end subroutine InitializeP0 !=============================================================================== -!> Read configuration attributes and advertise the import/export fields - -!> @details Called by NUOPC to read configuration attributes and to advertise the -!! import and export fields. The configuration attributes are used to control run -!! time settings, such as ESMF memory profiling, additional debug logging, multigrid -!! mode and character strings for specific use cases. A set of configuration attributes -!! is also read to describe any scalar fields to be added to a state. For coupling -!! with the wave model, only a scalar field for the dimensions of the wave model -!! is required. The scalar field is added to the export state to communicate to the -!! CMEPS mediator the domain dimensions of the wave model in order to write -!! mediator history and restart files. The attribute ScalarFieldName sets the name -!! of the scalar field in the export state, the ScalarFieldCount sets the -!! dimensionality of the scalar field and the ScalarFieldIdxGridNX (NY) set the -!! index of the NX or NY dimension in the scalar field. -!! -!! @param[in] gcomp an ESMF_GridComp object -!! @param[in] importState an ESMF_State object for import fields -!! @param[in] exportState an ESMF_State object for export fields -!! @param[in] clock an ESMF_Clock object -!! @param[out] rc return code -!! -!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov -!> @date 01-05-2022 + !> Read configuration attributes and advertise the import/export fields + + !> @details Called by NUOPC to read configuration attributes and to advertise the + !! import and export fields. The configuration attributes are used to control run + !! time settings, such as ESMF memory profiling, additional debug logging, multigrid + !! mode and character strings for specific use cases. A set of configuration attributes + !! is also read to describe any scalar fields to be added to a state. For coupling + !! with the wave model, only a scalar field for the dimensions of the wave model + !! is required. The scalar field is added to the export state to communicate to the + !! CMEPS mediator the domain dimensions of the wave model in order to write + !! mediator history and restart files. The attribute ScalarFieldName sets the name + !! of the scalar field in the export state, the ScalarFieldCount sets the + !! dimensionality of the scalar field and the ScalarFieldIdxGridNX (NY) set the + !! index of the NX or NY dimension in the scalar field. + !! + !! @param[in] gcomp an ESMF_GridComp object + !! @param[in] importState an ESMF_State object for import fields + !! @param[in] exportState an ESMF_State object for export fields + !! @param[in] clock an ESMF_Clock object + !! @param[out] rc return code + !! + !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov + !> @date 01-05-2022 subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! input/output arguments @@ -306,7 +317,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call NUOPC_CompAttributeGet(gcomp, name='dbug_flag', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then - read(cvalue,*) dbug_flag + read(cvalue,*) dbug_flag end if write(logmsg,'(A,i6)') trim(subname)//': Wave cap dbug_flag is ',dbug_flag call ESMF_LogWrite(trim(logmsg), ESMF_LOGMSG_INFO) @@ -330,13 +341,27 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) inst_index=1 endif + ! Get Multigrid setting multigrid = .false. call NUOPC_CompAttributeGet(gcomp, name='multigrid', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) multigrid=(trim(cvalue)=="true") + if (isPresent .and. isSet) then + multigrid=(trim(cvalue)=="true") + end if write(logmsg,'(A,l)') trim(subname)//': Wave multigrid setting is ',multigrid call ESMF_LogWrite(trim(logmsg), ESMF_LOGMSG_INFO) + ! Determine wave-ice coupling + wav_coupling_to_cice = .false. + call NUOPC_CompAttributeGet(gcomp, name='wav_coupling_to_cice', value=cvalue, isPresent=isPresent, & + isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + wav_coupling_to_cice=(trim(cvalue)=="true") + end if + write(logmsg,'(A,l)') trim(subname)//': Wave wav_coupling_to_cice setting is ',wav_coupling_to_cice + call ESMF_LogWrite(trim(logmsg), ESMF_LOGMSG_INFO) + call advertise_fields(importState, exportState, flds_scalar_name, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -345,28 +370,28 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) end subroutine InitializeAdvertise !======================================================================== -!> Realize the import and export fields. - -!> @details Called by NUOPC to realize the import and export fields -!! for the wave model. After the wave model initializes, the global index -!! for all sea points is retrieved using the WW3 mapsf array. A global index -!! array is then constructed which contains both land and sea points, with -!! the land points at the end of the array. An ESMF Distgrid object is created -!! using this global index array. The distgrid is then transfered to the ESMF -!! Mesh provided for the wave model domain. If the provided Mesh does not contain -!! a grid mask, then the internal WW3 mask is transfered to the Mesh, otherwise -!! the mask provided with the mesh file will be used. This mask is used by -!! CMEPS to map to and from the wave model. Once the mesh has been created, the -!! advertised fields are realized on the mesh. -!! -!! @param[in] gcomp an ESMF_GridComp object -!! @param[in] importState an ESMF_State object for import fields -!! @param[in] exportState an ESMF_State object for export fields -!! @param[in] clock an ESMF_Clock object -!! @param[out] rc return code -!! -!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov -!> @date 01-05-2022 + !> Realize the import and export fields. + + !> @details Called by NUOPC to realize the import and export fields + !! for the wave model. After the wave model initializes, the global index + !! for all sea points is retrieved using the WW3 mapsf array. A global index + !! array is then constructed which contains both land and sea points, with + !! the land points at the end of the array. An ESMF Distgrid object is created + !! using this global index array. The distgrid is then transfered to the ESMF + !! Mesh provided for the wave model domain. If the provided Mesh does not contain + !! a grid mask, then the internal WW3 mask is transfered to the Mesh, otherwise + !! the mask provided with the mesh file will be used. This mask is used by + !! CMEPS to map to and from the wave model. Once the mesh has been created, the + !! advertised fields are realized on the mesh. + !! + !! @param[in] gcomp an ESMF_GridComp object + !! @param[in] importState an ESMF_State object for import fields + !! @param[in] exportState an ESMF_State object for export fields + !! @param[in] clock an ESMF_Clock object + !! @param[out] rc return code + !! + !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov + !> @date 01-05-2022 subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) use w3odatmd , only : w3nout, w3seto, naproc, iaproc, naperr, napout @@ -380,6 +405,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) use wmunitmd , only : wmuget, wmuset #endif use wav_shel_inp , only : set_shel_io + use wav_grdout , only : wavinit_grdout ! input/output variables type(ESMF_GridComp) :: gcomp @@ -399,15 +425,13 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) character(CL) :: cvalue integer :: shrlogunit integer :: yy,mm,dd,hh,ss - integer :: dtime_sync ! integer timestep size integer :: start_ymd ! start date (yyyymmdd) integer :: start_tod ! start time of day (sec) integer :: stop_ymd ! stop date (yyyymmdd) integer :: stop_tod ! stop time of day (sec) integer :: ix, iy character(CL) :: starttype - integer :: time0(2), ntrace(2) - integer :: timen(2) + integer :: ntrace(2) integer :: i,j integer :: ierr integer :: n, jsea,isea, ncnt @@ -616,11 +640,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) close(idsi); close(idso); close(idss); close(idst); close(idse) if ( trim(ifname) == 'ww3_multi.nml' ) then - call wminitnml ( idsi, idso, idss, idst, idse, trim(ifname), & - mpi_comm, preamb=preamb ) + call wminitnml ( idsi, idso, idss, idst, idse, trim(ifname), & + mpi_comm, preamb=preamb ) else - call wminit ( idsi, idso, idss, idst, idse, trim(ifname), & - mpi_comm, preamb=preamb ) + call wminit ( idsi, idso, idss, idst, idse, trim(ifname), & + mpi_comm, preamb=preamb ) endif allocate(tend(2,nrgrd)) @@ -637,13 +661,23 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) time = time0 call ESMF_ClockGet( clock, timeStep=timeStep, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeIntervalGet( timeStep, s=dtime_sync, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call waveinit_cesm(gcomp, ntrace, mpi_comm, dtime_sync, mds, 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 ) + if ( root_task ) then + inquire(unit=nds(1), name=logfile) + print *,'WW3 log written to '//trim(logfile) + end if + + !-------------------------------------------------------------------- + ! Intialize the list of requested output variables for netCDF output + !-------------------------------------------------------------------- + + if (user_netcdf_grdout) then + call wavinit_grdout + end if !-------------------------------------------------------------------- ! Mesh initialization @@ -720,7 +754,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) EMeshTemp = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if ( root_task ) then - write(stdout,*)'mesh file for domain is ',trim(cvalue) + write(nds(1),*)'mesh file for domain is ',trim(cvalue) end if ! recreate the mesh using the above distGrid @@ -766,14 +800,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !TODO: when is this required? if (multigrid) then do imod = 1,nrgrd - call w3setg ( imod, mdse, mdst ) - call w3setw ( imod, mdse, mdst ) - call w3seta ( imod, mdse, mdst ) - call w3seti ( imod, mdse, mdst ) - call w3seto ( imod, mdse, mdst ) - call wmsetm ( imod, mdse, mdst ) - local = iaproc .gt. 0 .and. iaproc .le. naproc - if ( local .and. flcold .and. fliwnd ) call w3uini( va ) + call w3setg ( imod, mdse, mdst ) + call w3setw ( imod, mdse, mdst ) + call w3seta ( imod, mdse, mdst ) + call w3seti ( imod, mdse, mdst ) + call w3seto ( imod, mdse, mdst ) + call wmsetm ( imod, mdse, mdst ) + local = iaproc .gt. 0 .and. iaproc .le. naproc + if ( local .and. flcold .and. fliwnd ) call w3uini( va ) enddo end if #endif @@ -783,21 +817,20 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end subroutine InitializeRealize !=============================================================================== -!> Initialize the field values in the export state -!! -!! @details Called by NUOPC to initialize the field values in the export state and -!! the values for the scalar field which describes the wave model global domain -!! size. -!! -!! @param gcomp an ESMF_GridComp object -!! @param[out] rc return code -!! -!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov -!> @date 01-05-2022 + !> Initialize the field values in the export state + !! + !> @details Called by NUOPC to initialize the field values in the export state and + !! the values for the scalar field which describes the wave model global domain + !! size. + !! + !! @param gcomp an ESMF_GridComp object + !! @param[out] rc return code + !! + !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov + !> @date 01-05-2022 subroutine DataInitialize(gcomp, rc) use wav_import_export, only : calcRoughl - use wav_shr_mod , only : wav_coupling_to_cice use w3gdatmd , only : nx, ny ! input/output variables @@ -811,8 +844,6 @@ subroutine DataInitialize(gcomp, rc) real(r8), pointer :: sw_lamult(:) real(r8), pointer :: sw_ustokes(:) real(r8), pointer :: sw_vstokes(:) - real(r8), pointer :: wav_tauice1(:) - real(r8), pointer :: wav_tauice2(:) real(r8), pointer :: wave_elevation_spectrum(:,:) character(len=*),parameter :: subname = '(wav_comp_nuopc:DataInitialize)' ! ------------------------------------------------------------------- @@ -828,36 +859,28 @@ subroutine DataInitialize(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return 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 - sw_lamult (:) = 1. + call state_getfldptr(exportState, 'Sw_lamult', sw_lamult, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + sw_lamult (:) = 1. endif 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 - sw_ustokes(:) = 0. + call state_getfldptr(exportState, 'Sw_ustokes', sw_ustokes, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + sw_ustokes(:) = 0. endif if (state_fldchk(exportState, 'Sw_vstokes')) then - call state_getfldptr(exportState, 'Sw_vstokes', sw_vstokes, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_vstokes(:) = 0. + call state_getfldptr(exportState, 'Sw_vstokes', sw_vstokes, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + sw_vstokes(:) = 0. endif if (state_fldchk(exportState, 'Sw_z0')) then call state_getfldptr(exportState, 'Sw_z0', z0rlen, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call CalcRoughl(z0rlen) endif - if (wav_coupling_to_cice) then - call state_getfldptr(exportState, 'wav_tauice1', wav_tauice1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getfldptr(exportState, 'wav_tauice2', wav_tauice2, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getfldptr(exportState, 'wave_elevation_spectrum', wave_elevation_spectrum, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - wav_tauice1(:) = 0. - wav_tauice2(:) = 0. + call state_getfldptr(exportState, 'wave_elevation_spectrum', wave_elevation_spectrum, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return wave_elevation_spectrum(:,:) = 0. endif @@ -877,20 +900,20 @@ subroutine DataInitialize(gcomp, rc) end subroutine DataInitialize !===================================================================== -!> Called by NUOPC to advance the model a single timestep -!! -!! @details At each model advance, the call to import_fields fills the -!! import state with the updated values. If a history alarm is present -!! and ringing, a logical to write a wave history file is set true. The -!! wave model itself is then advanced during which a history file will -!! be written via a call to w3iogonc in place of w3iogo. The export -!! fields at the current model Advance are filled in export_fields -!! -!! @param gcomp an ESMF_GridComp object -!! @param[out] rc return code -!! -!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov -!> @date 01-05-2022 + !> Called by NUOPC to advance the model a single timestep + !! + !> @details At each model advance, the call to import_fields fills the + !! import state with the updated values. If a history alarm is present + !! and ringing, a logical to write a wave history file is set true. The + !! wave model itself is then advanced during which a history file will + !! be written via a call to w3iogonc in place of w3iogo. The export + !! fields at the current model Advance are filled in export_fields + !! + !! @param gcomp an ESMF_GridComp object + !! @param[out] rc return code + !! + !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov + !> @date 01-05-2022 subroutine ModelAdvance(gcomp, rc) !------------------------ @@ -901,7 +924,7 @@ subroutine ModelAdvance(gcomp, rc) use w3wdatmd , only : time, w3setw use wav_import_export , only : import_fields, export_fields use wav_shel_inp , only : odat - use wav_shr_mod , only : rstwr, histwr, outfreq ! only used by cesm + use w3odatmd , only : rstwr, histwr ! arguments: type(ESMF_GridComp) :: gcomp @@ -918,8 +941,6 @@ subroutine ModelAdvance(gcomp, rc) integer :: imod integer :: ymd ! current year-month-day integer :: tod ! current time of day (sec) - integer :: time0(2) - integer :: timen(2) integer :: shrlogunit ! original log unit and level character(ESMF_MAXSTR) :: msgString character(len=*),parameter :: subname = '(wav_comp_nuopc:ModelAdvance) ' @@ -935,11 +956,11 @@ subroutine ModelAdvance(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockPrint(clock, options="currTime", preString="------>Advancing WAV from: ", & - unit=msgString, rc=rc) + unit=msgString, rc=rc) call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) call ESMF_ClockGet(clock, startTime=startTime, currTime=currTime, timeStep=timeStep, rc=rc) call ESMF_TimePrint(currTime + timeStep, preString="--------------------------------> to: ", & - unit=msgString, rc=rc) + unit=msgString, rc=rc) call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) !------------ @@ -1000,9 +1021,8 @@ subroutine ModelAdvance(gcomp, rc) !------------ if(profile_memory) call ESMF_VMLogMemInfo("Entering WW3 Run : ") - if (cesmcoupled) then - ! Determine if time to write cesm ww3 restart files - ! rstwr is set in wav_shr_mod and used in w3wavmd to determine if restart should be written + if (user_restalarm) then + ! 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 @@ -1017,34 +1037,24 @@ subroutine ModelAdvance(gcomp, rc) rstwr = .false. end if - !TODO: what is outfreq used for if an alarm is created with history_n,history_option? - ! Determine if time to write ww3 history files - ! histwr is set in wav_shr_mod and used in w3wavmd to determine if history should be written - ! if history alarms are not active, control of WW3 grd output remains with WW3 - histwr = .false. - if (outfreq .gt. 0) then - ! output every outfreq hours if appropriate - if( mod(hh, outfreq) == 0 ) then + if (user_histalarm) then + ! 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. - endif - endif - if (.not. histwr) then - if (histwr_is_active) then - call ESMF_ClockGetAlarm(clock, alarmname='alarm_history', alarm=alarm, rc=rc) + 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 - end if - if ( root_task ) then - ! write(nds(1),*) 'wav_comp_nuopc time', time, timen - ! write(nds(1),*) 'ww3 hist flag ', histwr, outfreq, hh, mod(hh, outfreq) - end if + 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 ! Advance the wave model @@ -1071,13 +1081,13 @@ subroutine ModelAdvance(gcomp, rc) end subroutine ModelAdvance !=============================================================================== -!> Called by NUOPC to manage the model clock -!! -!! @param[in] gcomp an ESMF_GridComp object -!! @param[out] rc return code -!! -!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov -!> @date 01-05-2022 + !> Called by NUOPC to manage the model clock + !! + !! @param[in] gcomp an ESMF_GridComp object + !! @param[out] rc return code + !! + !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov + !> @date 01-05-2022 subroutine ModelSetRunClock(gcomp, rc) ! input/output variables @@ -1151,26 +1161,36 @@ subroutine ModelSetRunClock(gcomp, rc) !---------------- ! Restart alarm !---------------- - call NUOPC_CompAttributeGet(gcomp, name="restart_option", value=restart_option, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name="restart_option", isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + call NUOPC_CompAttributeGet(gcomp, name="restart_option", value=restart_option, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) restart_n + call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) restart_n - call NUOPC_CompAttributeGet(gcomp, name="restart_ymd", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) restart_ymd + call NUOPC_CompAttributeGet(gcomp, name="restart_ymd", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) restart_ymd - call alarmInit(mclock, restart_alarm, restart_option, & - opt_n = restart_n, & - opt_ymd = restart_ymd, & - RefTime = mCurrTime, & - alarmname = 'alarm_restart', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call alarmInit(mclock, restart_alarm, restart_option, & + opt_n = restart_n, & + opt_ymd = restart_ymd, & + RefTime = mCurrTime, & + alarmname = 'alarm_restart', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + 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. + end if !---------------- ! Stop alarm @@ -1196,9 +1216,9 @@ subroutine ModelSetRunClock(gcomp, rc) call ESMF_AlarmSet(stop_alarm, clock=mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !---------------- - ! History alarm - !---------------- + !---------------- + ! History alarm + !---------------- call NUOPC_CompAttributeGet(gcomp, name="history_option", isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then @@ -1208,6 +1228,7 @@ subroutine ModelSetRunClock(gcomp, rc) call NUOPC_CompAttributeGet(gcomp, name="history_n", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) history_n + call NUOPC_CompAttributeGet(gcomp, name="history_ymd", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) history_ymd @@ -1221,12 +1242,12 @@ subroutine ModelSetRunClock(gcomp, rc) call ESMF_AlarmSet(history_alarm, clock=mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - histwr_is_active = .true. + user_histalarm = .true. else - ! If attribute is not present - write history native WW3 output if requested + ! If attribute is not present - write history output at native WW3 frequency history_option = 'none' history_n = -999 - histwr_is_active = .false. + user_histalarm = .false. end if end if @@ -1246,13 +1267,13 @@ subroutine ModelSetRunClock(gcomp, rc) end subroutine ModelSetRunClock !=============================================================================== -!> Called by NUOPC at the end of the run to clean up. -!! -!! @param[in] gcomp an ESMF_GridComp object -!! @param[out] rc return code -!! -!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov -!> @date 01-05-2022 + !> Called by NUOPC at the end of the run to clean up. + !! + !! @param[in] gcomp an ESMF_GridComp object + !! @param[out] rc return code + !! + !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov + !> @date 01-05-2022 subroutine ModelFinalize(gcomp, rc) ! input/output variables @@ -1279,26 +1300,31 @@ subroutine ModelFinalize(gcomp, rc) end subroutine ModelFinalize !=============================================================================== -!> Initialize the wave model for the CESM use case -!! -!! @param[in] gcomp an ESMF_GridComp object -!! @param[in] ntrace unit numbers for trace -!! @param[in] mpi_comm an mpi communicator -!! @param[in] dtime_sync the coupling interval -!! @param[in] mds unit numbers -!! @param[out] rc return code -!! -!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov -!> @date 01-05-2022 - subroutine waveinit_cesm(gcomp, ntrace, mpi_comm, dtime_sync, mds, rc) + !> Initialize the wave model for the CESM use case + !! + !> @details Calls public routine read_shel_config to read the ww3_shel.inp or + !! ww3_shel.nml file. Calls w3init to initialize the wave model + !! + !! @param[in] gcomp an ESMF_GridComp object + !! @param[in] ntrace unit numbers for trace + !! @param[in] mpi_comm an mpi communicator + !! @param[in] mds unit numbers + !! @param[out] rc return code + !! + !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov + !> @date 01-05-2022 + subroutine waveinit_cesm(gcomp, ntrace, mpi_comm, mds, rc) ! Initialize ww3 for cesm (called from InitializeRealize) use w3initmd , only : w3init use w3gdatmd , only : dtcfl, dtcfli, dtmax, dtmin - use wav_shr_mod , only : casename, initfile, outfreq + use w3idatmd , only : inflags1, inflags2 + use w3odatmd , only : initfile + use wav_shr_mod , only : casename use wav_shr_mod , only : inst_index, inst_name, inst_suffix - use wav_shel_inp , only : set_shel_inp + use wav_shr_mod , only : wav_coupling_to_cice + 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 @@ -1306,7 +1332,6 @@ subroutine waveinit_cesm(gcomp, ntrace, mpi_comm, dtime_sync, mds, rc) type(ESMF_GridComp) :: gcomp integer , intent(in) :: ntrace(:) integer , intent(in) :: mpi_comm - integer , intent(in) :: dtime_sync integer , intent(in) :: mds(:) integer , intent(out) :: rc @@ -1324,13 +1349,13 @@ subroutine waveinit_cesm(gcomp, ntrace, mpi_comm, dtime_sync, mds, rc) character(len=*), parameter :: subname = '(wav_comp_nuopc:wavinit_cesm)' ! ------------------------------------------------------------------- - namelist /ww3_inparm/ initfile, outfreq, dtcfl, dtcfli, dtmax, dtmin + namelist /ww3_inparm/ initfile, dtcfl, dtcfli, dtmax, dtmin rc = ESMF_SUCCESS if (dbug_flag > 5) call ESMF_LogWrite(trim(subname)//' called', ESMF_LOGMSG_INFO) inst_name = "WAV"//trim(inst_suffix) - ! Read namelist (set initfile in wav_shr_mod) + ! Read namelist (set initfile in w3odatmd) if ( root_task ) then open (newunit=unitn, file='wav_in'//trim(inst_suffix), status='old') read (unitn, ww3_inparm, iostat=ierr) @@ -1358,25 +1383,17 @@ subroutine waveinit_cesm(gcomp, ntrace, mpi_comm, dtime_sync, mds, rc) write(stdout,'(a, 2x, f10.3)')' dtcfli = ',dtcfli write(stdout,'(a, 2x, f10.3)')' dtmax = ',dtmax write(stdout,'(a, 2x, f10.3)')' dtmin = ',dtmin - write(stdout,'(a, 2x, i8)' )' outfreq = ',outfreq write(stdout,*) end if ! ESMF does not have a broadcast for chars - call mpi_bcast(initfile, len_trim(initfile), MPI_CHARACTER, 0, mpi_comm, ierr) + call mpi_bcast(initfile, len(initfile), MPI_CHARACTER, 0, mpi_comm, ierr) if (ierr /= MPI_SUCCESS) then call ESMF_LogWrite(trim(subname)//' error in mpi broadcast for initfile ', & ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return end if - call mpi_bcast(outfreq, 1, MPI_INTEGER, 0, mpi_comm, ierr) - if (ierr /= MPI_SUCCESS) then - call ESMF_LogWrite(trim(subname)//' error in mpi broadcast for outfreq ', & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return - end if call mpi_bcast(dtcfl, 1, MPI_INTEGER, 0, mpi_comm, ierr) if (ierr /= MPI_SUCCESS) then call ESMF_LogWrite(trim(subname)//' error in mpi broadcast for dtcfl ',& @@ -1410,8 +1427,51 @@ subroutine waveinit_cesm(gcomp, ntrace, mpi_comm, dtime_sync, mds, rc) dtcfli_in = dtcfli dtmin_in = dtmin - ! Determine module variables in wav_shel_inp that are used for call to w3init - call set_shel_inp(dtime_sync) + ! Read the namelist settings in ww3_shel.nml + 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) + + ! NOTE: that wavice_coupling must be set BEFORE the call to advertise_fields + ! So the current mechanism is to force the inflags1(-7) and inflags1(-3) be set to true + ! if wavice coupling is active + ! NOTE: + ! inflags1(-7) = nml_input%forcing%ice_param1 + ! inflags1(-3) = nml_input%forcing%ice_param5 + + ! Force inflags2 to be false - otherwise inflags2 will be set to inflags1 and answers will change + ! Need to set this to .false. to avoid scaling of ice in section 4. of w3srcemed. + ! inflags2(4) is true if ice concentration was ever read during this simulation + ! Currently IC4 is used in cesm + inflags2(:) = .false. + if (wav_coupling_to_cice) then + inflags2(4) = .true. ! inflags2(4) is true if ice concentration was read during initialization + inflags1(-7) = .true. ! ice thickness + inflags2(-7) = .true. ! ice thickness + inflags1(-3) = .true. ! ice floe size + inflags2(-3) = .true. ! ice floe size + else + inflags1(-7) = .false. ! ice thickness + inflags2(-7) = .false. ! ice thickness + inflags1(-3) = .false. ! ice floe size + 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) @@ -1422,6 +1482,7 @@ subroutine waveinit_cesm(gcomp, ntrace, mpi_comm, dtime_sync, mds, rc) ! 1 is model number ! IsMulti does not appear to be used, setting to .false. + call ESMF_LogWrite(trim(subname)//' call w3init', ESMF_LOGMSG_INFO) call w3init ( 1, .false., 'ww3', mds, ntrace, odat, flgrd, flgr2, flgd, flg2, & npts, x, y, pnames, iprt, prtfrm, mpi_comm ) @@ -1436,27 +1497,26 @@ subroutine waveinit_cesm(gcomp, ntrace, mpi_comm, dtime_sync, mds, rc) end subroutine waveinit_cesm !=============================================================================== -!> Initialize the wave model for the UWM use case -!! -!> @details Calls public routine read_shel_inp to read the ww3_shel.inp file. Calls -!! w3init to initialize the wave model -!! -!! @param[in] gcomp an ESMF_GridComp object -!! @param[in] ntrace unit numbers for trace -!! @param[in] mpi_comm an mpi communicator -!! @param[in] mds unit numbers -!! @param[out] rc return code -!! -!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov -!> @date 01-05-2022 + !> Initialize the wave model for the UWM use case + !! + !> @details Calls public routine read_shel_config to read the ww3_shel.inp or + !! ww3_shel.nml file. Calls w3init to initialize the wave model + !! + !! @param[in] gcomp an ESMF_GridComp object + !! @param[in] ntrace unit numbers for trace + !! @param[in] mpi_comm an mpi communicator + !! @param[in] mds unit numbers + !! @param[out] rc return code + !! + !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov + !> @date 01-05-2022 subroutine waveinit_ufs( gcomp, ntrace, mpi_comm, mds, rc) ! Initialize ww3 for ufs (called from InitializeRealize) use w3odatmd , only : fnmpre use w3initmd , only : w3init - use wav_shr_mod , only : outfreq - use wav_shel_inp , only : read_shel_inp + 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 @@ -1468,17 +1528,51 @@ subroutine waveinit_ufs( gcomp, ntrace, mpi_comm, mds, rc) integer, intent(out) :: rc ! local variables + character(len=CL) :: logmsg + logical :: isPresent, isSet + character(len=CL) :: cvalue 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) - outfreq = 0 + ! 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 = './' - call ESMF_LogWrite(trim(subname)//' call read_shel_inp', ESMF_LOGMSG_INFO) - call read_shel_inp(mpi_comm) + 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) call w3init ( 1, .false., 'ww3', mds, ntrace, odat, flgrd, flgr2, flgd, flg2, & diff --git a/model/src/wav_grdout.F90 b/model/src/wav_grdout.F90 new file mode 100644 index 0000000000..166802ad6b --- /dev/null +++ b/model/src/wav_grdout.F90 @@ -0,0 +1,294 @@ +module wav_grdout + + use w3odatmd , only: nogrp, ngrpp + + implicit none + + integer, parameter :: maxvars = 24 ! 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 + + 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:24) = [ & + 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( "LAN ", "LANGMT ", "Turbulent Langmuir number (La_t) ", "nd ", " ", .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_import_export.F90 b/model/src/wav_import_export.F90 index 7a2c33b2dc..068627acbe 100644 --- a/model/src/wav_import_export.F90 +++ b/model/src/wav_import_export.F90 @@ -13,6 +13,7 @@ module wav_import_export use ESMF use NUOPC use NUOPC_Model + use wav_shr_flags use wav_kind_mod , only : r8 => shr_kind_r8, r4 => shr_kind_r4, i4 => shr_kind_i4 use wav_kind_mod , only : CL => shr_kind_cl, CS => shr_kind_cs use wav_shr_mod , only : ymd2date @@ -119,7 +120,6 @@ subroutine advertise_fields(importState, ExportState, flds_scalar_name, rc) call fldlist_add(fldsToWav_num, fldsToWav, 'Sa_u10m' ) call fldlist_add(fldsToWav_num, fldsToWav, 'Sa_v10m' ) end if - if (wav_coupling_to_cice) then call fldlist_add(fldsToWav_num, fldsToWav, 'Si_thick' ) call fldlist_add(fldsToWav_num, fldsToWav, 'Si_floediam') @@ -157,10 +157,7 @@ subroutine advertise_fields(importState, ExportState, flds_scalar_name, rc) ! is not initialized yet. It is set during w3init which gets called at a later phase (realize). A permanent solution ! will be implemented soon based on receiving USSP and USSPF from the coupler instead of the mod_def file. This will ! also ensure compatibility with the ocean component since ocean will also receive these from the coupler. - if (wav_coupling_to_cice) then - call fldlist_add(fldsFrWav_num, fldsFrWav, 'wav_tauice1') - call fldlist_add(fldsFrWav_num, fldsFrWav, 'wav_tauice2') call fldlist_add(fldsFrWav_num, fldsFrWav, 'wave_elevation_spectrum', & ungridded_lbound=1, ungridded_ubound=nwav_elev_spectrum) end if @@ -277,8 +274,11 @@ subroutine import_fields( gcomp, time0, timen, rc ) use w3idatmd , only: HML #else use wmupdtmd , only: wmupd2 - use wmmdatmd , only: wmsetm, mpi_comm_grd + use wmmdatmd , only: wmsetm use wmmdatmd , only: mdse, mdst, nrgrd, inpmap +#ifdef W3_MPI + use wmmdatmd , only: mpi_comm_grd +#endif #endif ! input/output variables @@ -584,7 +584,7 @@ subroutine export_fields (gcomp, rc) !--------------------------------------------------------------------------- use wav_kind_mod, only : R8 => SHR_KIND_R8 - use w3adatmd , only : USSX, USSY, EF, TAUICE, USSP + use w3adatmd , only : USSX, USSY, EF, USSP use w3adatmd , only : w3seta use w3idatmd , only : w3seti use w3wdatmd , only : va, w3setw @@ -620,8 +620,6 @@ subroutine export_fields (gcomp, rc) real(r8), pointer :: sw_lamult(:) real(r8), pointer :: sw_ustokes(:) real(r8), pointer :: sw_vstokes(:) - real(r8), pointer :: wav_tauice1(:) - real(r8), pointer :: wav_tauice2(:) ! d2 is location, d1 is frequency - nwav_elev_spectrum frequencies will be used real(r8), pointer :: wave_elevation_spectrum(:,:) @@ -752,19 +750,11 @@ subroutine export_fields (gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call CalcRadstr2D( va, sxxn, sxyn, syyn) end if - if (wav_coupling_to_cice) then - call state_getfldptr(exportState, 'wav_tauice1', wav_tauice1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getfldptr(exportState, 'wav_tauice2', wav_tauice2, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return call state_getfldptr(exportState, 'wave_elevation_spectrum', wave_elevation_spectrum, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Initialize wave elevation spectrum - wav_tauice1(:) = fillvalue - wav_tauice2(:) = fillvalue wave_elevation_spectrum(:,:) = fillvalue do jsea=1, nseal ! jsea is local @@ -772,15 +762,10 @@ subroutine export_fields (gcomp, rc) ix = mapsf(isea,1) ! global ix iy = mapsf(isea,2) ! global iy if (mapsta(iy,ix) .eq. 1) then ! active sea point - wav_tauice1(jsea) = TAUICE(jsea,1) ! tau ice is 2D - wav_tauice2(jsea) = TAUICE(jsea,2) ! tau ice is 2D - ! If wave_elevation_spectrum is UNDEF - needs ouput flag to be turned on ! wave_elevation_spectrum as 25 variables wave_elevation_spectrum(1:nwav_elev_spectrum,jsea) = EF(jsea,1:nwav_elev_spectrum) else - wav_tauice1(jsea) = 0. - wav_tauice2(jsea) = 0. wave_elevation_spectrum(:,jsea) = 0. endif enddo @@ -1092,14 +1077,13 @@ subroutine CalcRoughl ( wrln) use w3gdatmd, only : nseal, nk, nth, sig, dmin, ecos, esin, dden, mapsf, mapsta, nspec use w3adatmd, only : dw, cg, wn, charn, u10, u10d use w3wdatmd, only : va, ust - use w3odatmd, only : naproc, iaproc + use w3odatmd, only : naproc, iaproc, runtype #ifdef W3_ST3 use w3src3md, only : w3spr3 #endif #ifdef W3_ST4 use w3src4md, only : w3spr4 #endif - use wav_shr_mod, only : runtype ! input/output variables real(r8), pointer :: wrln(:) ! 1D roughness length export field ponter @@ -1417,7 +1401,7 @@ end subroutine fillglobal_with_merge_import !> Obtain the import mask used to merge a field from the import state with values from !! a file !! -!! @details Set the import mask for merging an import state field with values from +!> @details Set the import mask for merging an import state field with values from !! a file. The import mask is set 0 where the field from the import state has a value !! of fillValue due to non-overlapping model domains. The field values read from a !! file will be used to provide the values in these regions. The values of the import @@ -1518,7 +1502,7 @@ end subroutine set_importmask !==================================================================================== !> Write a netCDF file containing the global field values for debugging !! -!! @details Write a time-stamped netCDF file containing the values of a global field, +!> @details Write a time-stamped netCDF file containing the values of a global field, !! where the global_field is provided on either on all points or only nsea points. In !! either case, the field will be written to the file on the mesh. !! diff --git a/model/src/wav_shel_inp.F90 b/model/src/wav_shel_inp.F90 index 12c955aec7..229e65bb00 100644 --- a/model/src/wav_shel_inp.F90 +++ b/model/src/wav_shel_inp.F90 @@ -3,8 +3,7 @@ !> Set up for running in shel mode !! !> @details Contains public routines to sets up IO unit numbers and to -!! either reads a shel.inp file (UWM) or set the required values directly -!! (CESM). +!! either reads a shel configuration file (either ww3_shel.inp or ww3_shel.nml) !! !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov !> @date 01-05-2022 @@ -15,9 +14,9 @@ module wav_shel_inp implicit none private ! except - public :: set_shel_io !< @public set the IO unit numbers - public :: set_shel_inp !< @public directly set required input variabls (CESM) - public :: read_shel_inp !< @public read ww3_shel.inp (UWM) + public :: set_shel_io !< @public set the IO unit numbers + public :: read_shel_config !< @public reads ww3_shel.nml if present, otherwise + !! read ww3_shel.inp integer, public :: odat(40) !< @public output dates character(len=40), allocatable, public :: pnames(:) !< @public point names @@ -34,17 +33,17 @@ module wav_shel_inp include "mpif.h" -!=============================================================================== + !=============================================================================== contains -!=============================================================================== -!> Set IO unit numbers -!! -!! @param[in] stdout unit number for stdout -!! @param[out] mds an array of 13 unit numbers -!! @param[out] ntrace an array of 2 unit numbers used for trace output -!! -!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov -!> @date 01-05-2022 + !=============================================================================== + !> Set IO unit numbers + !! + !! @param[in] stdout unit number for stdout + !! @param[out] mds an array of 13 unit numbers + !! @param[out] ntrace an array of 2 unit numbers used for trace output + !! + !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov + !> @date 01-05-2022 subroutine set_shel_io(stdout,mds,ntrace) use ESMF, only : ESMF_UtilIOUnitGet @@ -97,877 +96,1328 @@ subroutine set_shel_io(stdout,mds,ntrace) ntrace(2) = 10 end subroutine set_shel_io -!> Set up variables used in shel mode directly (CESM) -!! -!! @param[in] dtime_sync coupling interval in s -!! -!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov -!> @date 01-05-2022 - subroutine set_shel_inp(dtime_sync) - use w3idatmd , only : inflags1, inflags2 - use w3odatmd , only : noge, idout, nds, notype, iaproc, napout - use w3wdatmd , only : time - use wav_shr_mod , only : wav_coupling_to_cice - - ! Input parameter - integer , intent(in) :: dtime_sync + !=============================================================================== + !> Read ww3_shel.inp Or ww3_shel.nml + !! + !! @param[in] mpi_comm mpi communicator + !! + !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov + !> @date 01-05-2022 + subroutine read_shel_config(mpi_comm, mds, time0_overwrite, timen_overwrite) + + use wav_shr_flags + use w3nmlshelmd , only : nml_domain_t, nml_input_t, nml_output_type_t + use w3nmlshelmd , only : nml_output_date_t, nml_homog_count_t, nml_homog_input_t + use w3nmlshelmd , only : w3nmlshel + use w3gdatmd , only : flagll, dtmax, nx, ny, gtype + use w3wdatmd , only : time, w3ndat, w3dimw, w3setw + use w3adatmd , only : w3naux, w3dima, w3seta + use w3idatmd , only : inflags1, inflags2, flagsc + use w3odatmd , only : w3nout, w3seto, nds + use w3odatmd , only : naproc, iaproc, napout, naperr + use w3odatmd , only : idout, fnmpre, iostyp, notype + use w3odatmd , only : flogrr, flogr, ofiles + use w3iogrmd , only : w3iogr + use w3iogomd , only : w3readflgrd, fldout, w3flgrdflag + use w3servmd , only : nextln, extcde + use w3timemd , only : dsec21, stme21, tick21, t2d, d2j +#ifdef W3_OASIS + use w3wdatmd , only : time00, timeend +#endif +#ifdef W3_NL5 + use w3wdatmd , only : qi5tbeg +#endif - ! Local parameters - logical :: flt - integer :: i,j,j0 + ! 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) + + ! local parameters + integer, parameter :: nhmax = 200 + + type(nml_domain_t) :: nml_domain + type(nml_input_t) :: nml_input + type(nml_output_type_t) :: nml_output_type + type(nml_output_date_t) :: nml_output_date + type(nml_homog_count_t) :: nml_homog_count + type(nml_homog_input_t), allocatable :: nml_homog_input(:) + + integer :: ndsi, ndsi2, ndss, ndso, ndse, ndst, ndsl + integer :: ndsm, ndsen, ierr, j, i, iloop, ipts + integer :: nh(-7:10), tho(2,-7:10,nhmax), rcld(7:9) + integer :: nodata(7:9), startdate(8), stopdate(8), ihh(-7:10) + integer :: jfirst, ierr_mpi, flagtide, ih, n_tot + real :: factor, dttst, xx, yy, ha(nhmax,-7:10) + real :: hd(nhmax,-7:10), hs(nhmax,-7:10) + double precision :: startjulday, stopjulday + character(len=1) :: comstr, flagtfc(-7:10) + character(len=3) :: idstr(-7:10), idtst + character(len=6) :: yesxno + character(len=40) :: pn + character(len=13) :: idflds(-7:10) + character(len=20) :: strng + character(len=23) :: dtme21 + character(len=30) :: idotyp(8) + character(len=80) :: line + character(len=256) :: tmpline, test + character(len=1024) :: fldrst='' + character(len=80) :: linein + character(len=30) :: ofile ! w3_cou only + character(len=8) :: words(7)='' + logical :: flflg, flhom, tflagi, prtfrm, flgnml, flh(-7:10) + integer :: thrlev = 1 + integer :: time0(2), timen(2), ttime(2) + character(len=80) :: msg1 + logical :: is_open + + data idflds / 'ice param. 1 ' , 'ice param. 2 ' , & + 'ice param. 3 ' , 'ice param. 4 ' , & + 'ice param. 5 ' , & + 'mud density ' , 'mud thkness ' , & + 'mud viscos. ' , & + 'water levels ' , 'currents ' , & + 'winds ' , 'ice fields ' , & + 'momentum ' , 'air density ' , & + 'mean param. ' , '1D spectra ' , & + '2D spectra ' , 'moving grid ' / + data idotyp / 'Fields of mean wave parameters' , & + 'Point output ' , & + 'Track point output ' , & + 'Restart files ' , & + 'Nesting data ' , & + 'Partitioned wave field data ' , & + 'Fields for coupling ' , & + 'Restart files second request '/ + data idstr / 'IC1', 'IC2', 'IC3', 'IC4', 'IC5', 'MDN', 'MTH', & + 'MVS', 'LEV', 'CUR', 'WND', 'ICE', 'TAU', 'RHO', & + 'DT0', 'DT1', 'DT2', 'MOV' / + !--------------------------------------------------- + ! !--------------------------------------------------- - !-------------------------------------------------------------------- - ! Define input fields inflags1 and inflags2 settings - !-------------------------------------------------------------------- - - ! fllev inflags1(1) flag for water level input. - ! flcur inflags1(2) flag for current input. - ! flwind inflags1(3) flag for wind input. - ! flice inflags1(4) flag for ice input (ice fraction) - - ! inflags1 array consolidating the above flags, as well as four additional data flags. - ! inflags2 like inflags1 but does *not* get changed when model reads last record of ice.ww3 - ! inflags2 is just "initial value of INFLAGS1" - - ! flags for passing variables from coupler to ww3, lev, curr, wind, ice and mixing layer depth - ! ice params : inflags1(-7) => inflags1(-3) - ! mud density : inflags1(-2) - ! mud thickness : inflags1(-1) - ! muc viscos : inflags1(0) - ! water levels : inflags1(1) - ! currents : inflags1(2) - ! winds : inflags1(3) - ! ice fields : inflags1(4) - ! momentum fluxes : inflags1(5) - - inflags1(:) = .false. - inflags1(1:4) = .true. - inflags2(:) = .false. - if (wav_coupling_to_cice) then - inflags1(-7) = .true. ! ice thickness - inflags1(-3) = .true. ! ice floe size - inflags2(-7) = .true. ! thickness - inflags2(-3) = .true. ! floe size - inflags2( 4) = .true. ! inflags2(4) is true if ice concentration was read during initialization + flgr2 = .false. + flh(:) = .false. + iprt(:) = 0 + 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 + ndso = mds(1) + ndse = mds(1) + ndst = mds(1) + ! set a unit number passed to w3iogr routine for reading mod_def file; this unit + ! is closed at the end of w3iogr + ndsm = 17 + inquire(unit=ndsm, opened=is_open) + if (is_open) then + call extcde (60, msg='unit ndsm is already in use ') + end if + ndss = 90 + inquire(unit=ndss, opened=is_open) + if (is_open) then + call extcde (60, msg='unit ndss is already in use ') end if + ! naperr is set in InitializeRealize + if ( iaproc .eq. naperr ) then + ndsen = ndse + else + ndsen = -1 + end if +#ifdef W3_OMPH + if ( iaproc .eq. napout ) write (ndso,905) MPI_THREAD_FUNNELED, thrlev +#endif - !-------------------------------------------------------------------- - ! Define output type and fields - !-------------------------------------------------------------------- + ! 1.c Local parameters - ! Set number of output types. This is nomally set in w3_shel, CMB made 7. - notype = 7 + ! Default COMSTR to "$" (for when using nml input files) + COMSTR = "$" + call print_logmsg(740+IAPROC, 'read_shel_config, step 2', w3_debuginit_flag) - if (iaproc == napout) then - write(nds(1),'(a)') ' Output requests : ' - write(nds(1),'(a)')'--------------------------------------------------' - write(nds(1),'(a)')' no dedicated output process on any file system ' - end if + ! If using experimental mud or ice physics, additional lines will + ! be read in from read_shel_config.inp and applied, so JFIRST is + ! changed from its initialization setting "JFIRST=1" to some + ! lower value. + jfirst=1 + if (w3_ic1_flag) jfirst = -7 + if (w3_ic2_flag) jfirst = -7 + if (w3_is2_flag) jfirst = -7 + if (w3_ic3_flag) jfirst = -7 + if (w3_bt8_flag) jfirst = -7 + if (w3_bt9_flag) jfirst = -7 + if (w3_ic4_flag) jfirst = -7 + if (w3_ic5_flag) jfirst = -7 + + write(msg1,*)'JFIRST=', JFIRST + call print_logmsg(740+IAPROC, 'read_shel_config, step 4', trim(msg1), w3_debuginit_flag) + + !-------------------- + ! Read nml file if available + !-------------------- + + inquire(file=trim(fnmpre)//"ww3_shel.nml", exist=flgnml) + + if (flgnml) then + open(newunit=ndsi, file=trim(fnmpre)//"ww3_shel.nml", status='old', iostat=ierr) + + !-------------------- + ! Read namelist + !-------------------- + + call w3nmlshel (mpi_comm, ndsi, trim(fnmpre)//'ww3_shel.nml', & + nml_domain, nml_input, nml_output_type, & + nml_output_date, nml_homog_count, & + nml_homog_input, ierr) + + !-------------------- + ! 2.1 forcing flags + !-------------------- + + flh(-7:10) = .false. + flagtfc(-7) = trim(nml_input%forcing%ice_param1) + flagtfc(-6) = trim(nml_input%forcing%ice_param2) + flagtfc(-5) = trim(nml_input%forcing%ice_param3) + flagtfc(-4) = trim(nml_input%forcing%ice_param4) + flagtfc(-3) = trim(nml_input%forcing%ice_param5) + flagtfc(-2) = trim(nml_input%forcing%mud_density) + flagtfc(-1) = trim(nml_input%forcing%mud_thickness) + flagtfc(0) = trim(nml_input%forcing%mud_viscosity) + flagtfc(1) = trim(nml_input%forcing%water_levels) + flagtfc(2) = trim(nml_input%forcing%currents) + flagtfc(3) = trim(nml_input%forcing%winds) + flagtfc(4) = trim(nml_input%forcing%ice_conc) + flagtfc(5) = trim(nml_input%forcing%atm_momentum) + flagtfc(6) = trim(nml_input%forcing%air_density) + flagtfc(7) = trim(nml_input%assim%mean) + flagtfc(8) = trim(nml_input%assim%spec1d) + flagtfc(9) = trim(nml_input%assim%spec2d) + + if (trim(nml_input%forcing%ice_param1) .eq. 'H') then + flagtfc(-7)='T' + flh(-7)=.true. + end if + if (trim(nml_input%forcing%ice_param2) .eq. 'H') THEN + flagtfc(-6)='T' + flh(-6)=.true. + end if + if (trim(nml_input%forcing%ice_param3) .eq. 'H') THEN + flagtfc(-5)='T' + flh(-5)=.true. + end if + if (trim(nml_input%forcing%ice_param4) .eq. 'H') THEN + flagtfc(-4)='T' + flh(-4)=.true. + end if + if (trim(nml_input%forcing%ice_param5) .eq. 'H') THEN + flagtfc(-3)='T' + flh(-3)=.true. + end if + if (trim(nml_input%forcing%mud_density) .eq. 'H') THEN + flagtfc(-2)='T' + flh(-2)=.true. + end if + if (trim(nml_input%forcing%mud_thickness) .eq. 'H') THEN + flagtfc(-1)='T' + flh(-1)=.true. + end if + if (trim(nml_input%forcing%mud_viscosity) .eq. 'H') THEN + flagtfc(0)='T' + flh(0)=.true. + end if + if (trim(nml_input%forcing%water_levels) .eq. 'H') THEN + flagtfc(1)='T' + flh(1)=.true. + end if + if (trim(nml_input%forcing%currents) .eq. 'H') THEN + flagtfc(2)='T' + flh(2)=.true. + end if + if (trim(nml_input%forcing%winds) .eq. 'H') THEN + flagtfc(3)='T' + flh(3)=.true. + end if + if (trim(nml_input%forcing%ice_conc) .eq. 'H') THEN + flagtfc(4)='T' + flh(4)=.true. + end if + if (trim(nml_input%forcing%atm_momentum) .eq. 'H') THEN + flagtfc(5)='T' + flh(5)=.true. + end if + if (trim(nml_input%forcing%air_density) .eq. 'H') THEN + flagtfc(6)='T' + flh(6)=.true. + end if - ! Initialize ODAT. Normally set in w3_shel. - ! ODAT is initializated in w3initmd - ! Output data, five parameters per output type - ! 1 YYYMMDD for first output. - ! 2 HHMMSS for first output. - ! 3 Output interval in seconds. - ! 4 YYYMMDD for last output. - ! 5 HHMMSS for last output. - ! 1-5 Data for OTYPE = 1; gridded fields. - ! 6-10 Id. for OTYPE = 2; point output. - ! 11-15 Id. for OTYPE = 3; track point output. - ! 16-20 Id. for OTYPE = 4; restart files. - ! 21-25 Id. for OTYPE = 5; boundary data. - ! 26-30 Id. for OTYPE = 6; ? - ! 31-35 Id. for OTYPE = 7; coupled fields - ! Hardwire gridded output for now - ! - first output time stamp is now read from file - ! - 1-5 for history files, 16-20 for restart files - ! - restart output interval is set to the total time of run, restart is taken over by rstwr - ! - output interval is set to coupling interval, so that variables calculated in W3IOGO - ! could be updated at every coupling interval - ! - changed odat so all 35 values are set, only permitting one frequency controlled by histwr - do j=1,7 - J0 = (j-1)*5 - odat(J0+1) = time(1) ! YYYYMMDD for first output - odat(J0+2) = time(2) ! HHMMSS for first output - odat(J0+3) = dtime_sync ! output interval in sec - odat(J0+4) = 99990101 ! YYYYMMDD for last output - odat(J0+5) = 0 ! HHMMSS for last output - end do + if ( iaproc .eq. napout ) write (ndso, 920) + DO J=JFIRST, 9 + if (flagtfc(j).eq.'T') THEN + inflags1(j)=.true. + flagsc(j)=.false. + end if + if (flagtfc(j).eq.'F') THEN + inflags1(j)=.false. + flagsc(j)=.false. + end if + if (flagtfc(j).eq.'C') THEN + inflags1(j)=.true. + flagsc(j)=.true. + end if + if ( j .le. 6 ) then + flh(j) = flh(j) .and. inflags1(j) + end if + if ( inflags1(j) ) then + yesxno = 'YES/--' + else + yesxno = '---/NO' + end IF + if ( flh(j) ) then + strng = '(homogeneous field) ' + else if ( flagsc(j) ) then + strng = '(coupling field) ' + else + strng = ' ' + end if + if ( iaproc .eq. napout ) write (ndso,921) idflds(j), yesxno, strng + end do + if (w3_cou_flag) then + if (flagsc(1) .and. inflags1(2) .and. .not. flagsc(2)) goto 2102 + if (flagsc(2) .and. inflags1(1) .and. .not. flagsc(1)) goto 2102 + end if - ! FLGRD L.A. I Flags for gridded output. - ! NPT Int. I Number of output points - ! X/YPT R.A. I Coordinates of output points. - ! PNAMES C.A. I Output point names. - ! output index is now a in a 2D array - - flgrd(:,:) = .false. ! gridded fields - flgr2(:,:) = .false. ! coupled fields, w3init w3iog are not ready to deal with these yet - - ! 1) Forcing fields - flgrd( 1, 1) = .false. ! Water depth - flgrd( 1, 2) = .false. ! Current vel. - flgrd( 1, 3) = .true. ! Wind speed - flgrd( 1, 4) = .false. ! Air-sea temp. dif. - flgrd( 1, 5) = .false. ! Water level - flgrd( 1, 6) = .true. ! Ice concentration - flgrd( 1, 7) = .false. ! Iceberg damp coeffic - - ! 2) Standard mean wave parameters - flgrd( 2, 1) = .true. ! Wave height - flgrd( 2, 2) = .false. ! Mean wave length - flgrd( 2, 3) = .true. ! Mean wave period(+2) - flgrd( 2, 4) = .true. ! Mean wave period(-1) - flgrd( 2, 5) = .true. ! Mean wave period(+1) - flgrd( 2, 6) = .true. ! Peak frequency - flgrd( 2, 7) = .true. ! Mean wave dir. a1b1 - flgrd( 2, 8) = .false. ! Mean dir. spr. a1b1 - flgrd( 2, 9) = .false. ! Peak direction - flgrd( 2, 10) = .false. ! Infragravity height - flgrd( 2, 11) = .false. ! Space-Time Max E - flgrd( 2, 12) = .false. ! Space-Time Max Std - flgrd( 2, 13) = .false. ! Space-Time Hmax - flgrd( 2, 14) = .false. ! Spc-Time Hmax^crest - flgrd( 2, 15) = .false. ! STD Space-Time Hmax - flgrd( 2, 16) = .false. ! STD ST Hmax^crest - flgrd( 2, 17) = .false. ! Dominant wave bT - - ! 3) Frequency-dependent standard parameters - ! Whether the 1D Freq. Spectrum gets allocated is decided in the grid_inp file - ! ~/ww3_toolbox/grids/grid_inp/ww3_grid.inp.ww3a namelist section: &OUTS E3D = 1 / - flgrd( 3, 1) = .true. ! 1D Freq. Spectrum - flgrd( 3, 2) = .false. ! Mean wave dir. a1b1 - flgrd( 3, 3) = .false. ! Mean dir. spr. a1b1 - flgrd( 3, 4) = .false. ! Mean wave dir. a2b2 - flgrd( 3, 5) = .false. ! Mean dir. spr. a2b2 - flgrd( 3, 6) = .false. ! Wavenumber array ' - - ! 4) Spectral Partitions parameters - flgrd( 4, 1) = .false. ! Part. wave height ' - flgrd( 4, 2) = .false. ! Part. peak period ' - flgrd( 4, 3) = .false. ! Part. peak wave len.' - flgrd( 4, 4) = .false. ! Part. mean direction' - flgrd( 4, 5) = .false. ! Part. dir. spread ' - flgrd( 4, 6) = .false. ! Part. wind sea frac.' - flgrd( 4, 7) = .false. ! Part. peak direction' - flgrd( 4, 8) = .false. ! Part. peakedness ' - flgrd( 4, 9) = .false. ! Part. peak enh. fac.' - flgrd( 4,10) = .false. ! Part. gaussian width' - flgrd( 4,11) = .false. ! Part. spectral width' - flgrd( 4,12) = .false. ! Part. mean per. (-1)' - flgrd( 4,13) = .false. ! Part. mean per. (+1)' - flgrd( 4,14) = .false. ! Part. mean per. (+2)' - flgrd( 4,15) = .false. ! Part. peak density ' - flgrd( 4,16) = .false. ! Total wind sea frac.' - flgrd( 4,17) = .false. ! Number of partitions' - - ! 5) Atmosphere-waves layer - flgrd( 5, 1) = .false. ! Friction velocity ' - flgrd( 5, 2) = .false. ! Charnock parameter ' - flgrd( 5, 3) = .false. ! Energy flux ' - flgrd( 5, 4) = .false. ! Wind-wave enrgy flux' - flgrd( 5, 5) = .false. ! Wind-wave net mom. f' - flgrd( 5, 6) = .false. ! Wind-wave neg.mom.f.' - flgrd( 5, 7) = .false. ! Whitecap coverage ' - flgrd( 5, 8) = .false. ! Whitecap mean thick.' - flgrd( 5, 9) = .false. ! Mean breaking height' - flgrd( 5,10) = .false. ! Dominant break prob ' - flgrd( 5,11) = .false. ! Breaker passage rate' - - ! 6) Wave-ocean layer - flgrd( 6, 1) = .false. ! 'Radiation stresses ' - flgrd( 6, 2) = .false. ! 'Wave-ocean mom. flux' - flgrd( 6, 3) = .false. ! 'wave ind p Bern Head' - flgrd( 6, 4) = .false. ! 'Wave-ocean TKE flux' - flgrd( 6, 5) = .false. ! 'Stokes transport ' - flgrd( 6, 6) = .true. ! 'Stokes drift at z=0 ' - flgrd( 6, 7) = .false. ! '2nd order pressure ' - flgrd( 6, 8) = .false. ! 'Stokes drft spectrum' - flgrd( 6, 9) = .false. ! '2nd ord press spectr' - flgrd( 6,10) = .false. ! 'Wave-ice mom. flux ' - flgrd( 6,11) = .false. ! 'Wave-ice energy flux' - flgrd( 6,12) = .false. ! 'Split Surface Stokes' - flgrd( 6,13) = .false. ! 'Tot wav-ocn mom flux' - flgrd( 6,13) = .true. ! 'Turbulent Langmuir number (La_t)' - - ! 7) Wave-bottom layer - flgrd( 7, 1) = .false. ! 'Bottom rms ampl. ' - flgrd( 7, 2) = .false. ! 'Bottom rms velocity ' - flgrd( 7, 3) = .false. ! 'Bedform parameters ' - flgrd( 7, 4) = .false. ! 'Energy diss. in WBBL' - flgrd( 7, 5) = .false. ! 'Moment. loss in WBBL' - - ! 8) Spectrum parameters - flgrd( 8, 1) = .false. ! 'Mean square slopes ' - flgrd( 8, 2) = .false. ! 'Phillips tail const' - flgrd( 8, 3) = .false. ! 'Slope direction ' - flgrd( 8, 4) = .false. ! 'Tail slope direction' - flgrd( 8, 5) = .false. ! 'Goda peakedness parm' - - ! 9) Numerical diagnostics - flgrd( 9, 1) = .false. ! 'Avg. time step. ' - flgrd( 9, 2) = .false. ! 'Cut-off freq. ' - flgrd( 9, 3) = .false. ! 'Maximum spatial CFL ' - flgrd( 9, 4) = .false. ! 'Maximum angular CFL ' - flgrd( 9, 5) = .false. ! 'Maximum k advect CFL' - - ! 10) is user defined - - ! write out which fields will be output to first hist file - ! IDOUT(NOGRP,NGRPP) - ! NOGRP = number of output field groups - ! NGRPP = Max num of parameters per output - ! NOGE(NOGRP) = number of output group elements - if (iaproc == napout) then - flt = .true. - do i=1, nogrp - do j=1, noge(i) - if ( flgrd(i,j) ) then - if ( flt ) then - write (nds(1),'(a)') ' Fields : '//trim(idout(i,j)) - flt = .false. - else - write (nds(1),'(a)')' '//trim(idout(i,j)) - end if + inflags1(10) = .false. + if (w3_mgw_flag .or. w3_mgp_flag) then + inflags1(10) = .true. + flh(10) = .true. + end if + if ( inflags1(10) .and. iaproc.eq.napout ) & + write (ndso,921) idflds(10), 'yes/--', ' ' + + flflg = inflags1(-7) .or. inflags1(-6) .or. inflags1(-5) .or. inflags1(-4) & + .or. inflags1(-3) .or. inflags1(-2) .or. inflags1(-1) & + .or. inflags1(0) .or. inflags1(1) .or. inflags1(2) & + .or. inflags1(3) .or. inflags1(4) .or. inflags1(5) & + .or. inflags1(6) .or. inflags1(7) .or. inflags1(8) & + .or. inflags1(9) + flhom = flh(-7) .or. flh(-6) .or. flh(-5) .or. flh(-4) & + .or. flh(-3) .or. flh(-2) .or. flh(-1) .or. flh(0) & + .or. flh(1) .or. flh(2) .or. flh(3) .or. flh(4) & + .or. flh(5) .or. flh(6) .or. flh(10) + + if ( iaproc .eq. napout ) write (ndso,922) + ! inflags2 is just "initial value of inflags1", i.e. does *not* get + ! changed when model reads last record of ice.ww3 + inflags2=inflags1 + if (w3_t_flag) then + write (ndst,9020) flflg, inflags1, flhom, flh + end if + + !-------------------- + ! 2.2 Time setup + !-------------------- + + read (nml_domain%start,*) time0 + call t2d(time0,startdate,ierr) + call d2j(startdate,startjulday,ierr) + read(nml_domain%stop,*) timen + call t2d(timen,stopdate,ierr) + call d2j(stopdate,stopjulday,ierr) + + !-------------------- + ! 2.3 Domain setup + !-------------------- + + iostyp = nml_domain%iostyp + if (w3_pdlib_flag) then + if (iostyp .gt. 1) then + write(*,*) 'iostyp not supported in domain decomposition mode' + call extcde ( 6666 ) + endif + end if + + call w3iogr ( 'GRID', ndsm ) + if ( flagll ) then + factor = 1. + else + factor = 1.e-3 + end if + + !-------------------- + ! 2.4 Output dates + !-------------------- + + read(nml_output_date%field%start, *) odat(1), odat(2) + read(nml_output_date%field%stride, *) odat(3) + read(nml_output_date%field%stop, *) odat(4), odat(5) + + read(nml_output_date%field%outffile, *) ofiles(1) + ! outpts(i)%outstride(1)=odat(3,i) + + read(nml_output_date%point%start, *) odat(6), odat(7) + read(nml_output_date%point%stride, *) odat(8) + read(nml_output_date%point%stop, *) odat(9), odat(10) + + read(nml_output_date%point%outffile, *) ofiles(2) + ! outpts(i)%outstride(2)=odat(8,i) + + read(nml_output_date%track%start, *) odat(11), odat(12) + read(nml_output_date%track%stride, *) odat(13) + read(nml_output_date%track%stop, *) odat(14), odat(15) + + read(nml_output_date%restart%start, *) odat(16), odat(17) + read(nml_output_date%restart%stride, *) odat(18) + read(nml_output_date%restart%stop, *) odat(19), odat(20) + + read(nml_output_date%restart2%start, *) odat(36), odat(37) + read(nml_output_date%restart2%stride, *) odat(38) + read(nml_output_date%restart2%stop, *) odat(39), odat(40) + + read(nml_output_date%boundary%start, *) odat(21), odat(22) + read(nml_output_date%boundary%stride, *) odat(23) + read(nml_output_date%boundary%stop, *) odat(24), odat(25) + + read(nml_output_date%partition%start, *) odat(26), odat(27) + read(nml_output_date%partition%stride, *) odat(28) + read(nml_output_date%partition%stop, *) odat(29), odat(30) + + read(nml_output_date%coupling%start, *) odat(31), odat(32) + read(nml_output_date%coupling%stride, *) odat(33) + read(nml_output_date%coupling%stop, *) odat(34), odat(35) + + ! set the time stride at 0 or more + odat(3) = max ( 0 , odat(3) ) + odat(8) = max ( 0 , odat(8) ) + odat(13) = max ( 0 , odat(13) ) + odat(18) = max ( 0 , odat(18) ) + odat(23) = max ( 0 , odat(23) ) + odat(28) = max ( 0 , odat(28) ) + odat(33) = max ( 0 , odat(33) ) + odat(38) = max ( 0 , odat(38) ) + + if (w3_cou_flag) then + ! test the validity of the coupling time step + if (odat(33) == 0) then + if ( iaproc .eq. napout ) then + write(ndso,1010) odat(33), int(dtmax) end if + odat(33) = int(dtmax) + else if (mod(odat(33),int(dtmax)) .ne. 0) then + goto 2009 + end if + end if + + !-------------------- + ! 2.5 Output types + !-------------------- + + npts = 0 + notype = 6 + if (w3_cou_flag) then + notype = 7 + end if + do j = 1, notype + + ! outpts(i)%ofiles(j)=ofiles(j) + if ( odat(5*(j-1)+3) .ne. 0 ) then + + if ( j .eq. 1 ) then + + ! type 1: fields of mean wave parameters + fldout = nml_output_type%field%list + call w3flgrdflag ( ndso, ndso, ndse, fldout, flgd, flgrd, iaproc, napout, ierr ) + if ( ierr .ne. 0 ) goto 2222 + + else if ( j .eq. 2 ) then + + ! type 2: point output + open (newunit=ndsl, file=trim(fnmpre)//trim(nml_output_type%point%file), & + form='formatted', status='old', err=2104, iostat=ierr) + + ! first loop to count the number of points + ! second loop to allocate the array and store the points + ipts = 0 + do iloop=1,2 + rewind (ndsl) + + if ( iloop.eq.2) then + npts = ipts + if ( npts.gt.0 ) then + allocate ( x(npts), y(npts), pnames(npts) ) + ipts = 0 ! reset counter to be reused for next do loop + else + allocate ( x(1), y(1), pnames(1) ) + goto 2054 + end if + end if + + do + read (ndsl,*,err=2004,iostat=ierr) tmpline + ! if end of file or stopstring, then exit + if ( ierr.ne.0 .or. index(tmpline,"STOPSTRING").ne.0 ) exit + + ! leading blanks removed and placed on the right + test = adjustl ( tmpline ) + if ( test(1:1).eq.comstr .or. len_trim(test).eq.0 ) then + ! if comment or blank line, then skip + cycle + else + ! otherwise, backup to beginning of line + backspace ( ndsl, err=2004, iostat=ierr) + read (ndsl,*,err=2004,iostat=ierr) xx, yy, pn + end if + ipts = ipts + 1 + if ( iloop .eq. 1 ) cycle + if ( iloop .eq. 2 ) then + x(ipts) = xx + y(ipts) = yy + pnames(ipts) = pn + if ( iaproc .eq. napout ) then + if ( flagll ) then + if ( ipts .eq. 1 ) then + write (ndso,2945) factor*xx, factor*yy, pn + else + write (ndso,2946) ipts, factor*xx, factor*yy, pn + end if + else + if ( ipts .eq. 1 ) then + write (ndso,2955) factor*xx, factor*yy, pn + else + write (ndso,2956) ipts, factor*xx, factor*yy, pn + end if + end if + end if + end if ! iloop.eq.2 + end do ! end of file + end do ! iloop + close(ndsl) + + else if ( j .eq. 3 ) then + + ! Type 3: track output + tflagi = nml_output_type%track%format + if ( .not. tflagi ) nds(11) = -nds(11) + if ( iaproc .eq. napout ) then + if ( .not. tflagi ) then + write (ndso,3945) 'input', 'unformatted' + else + write (ndso,3945) 'input', 'formatted' + end if + end if + + else if ( j .eq. 6 ) then + + ! Type 6: partitioning + iprt(1) = nml_output_type%partition%x0 + iprt(2) = nml_output_type%partition%xn + iprt(3) = nml_output_type%partition%nx + iprt(4) = nml_output_type%partition%y0 + iprt(5) = nml_output_type%partition%yn + iprt(6) = nml_output_type%partition%ny + prtfrm = nml_output_type%partition%format + + if ( iaproc .eq. napout ) then + if ( prtfrm ) then + yesxno = 'YES/--' + else + yesxno = '---/NO' + end if + write (ndso,6945) iprt, yesxno + end if + + else if ( j .eq. 7 ) then +#ifdef W3_COU + ! Type 7: coupling + fldout = nml_output_type%coupling%sent + call w3flgrdflag ( ndso, ndso, ndse, fldout, flg2, flgr2, iaproc, napout, ierr ) + if ( ierr .ne. 0 ) goto 2222 + fldin = nml_output_type%coupling%received + cplt0 = nml_output_type%coupling%couplet0 +#endif + + end if ! j + end if ! odat + end do ! j + + ! 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 ( ierr .ne. 0 ) goto 2222 + + ! force minimal allocation to avoid memory seg fault + if ( .not.allocated(x) .and. npts.eq.0 ) allocate ( x(1), y(1), pnames(1) ) + + !-------------------- + ! 2.6 Homogeneous field data + !-------------------- + + if ( flhom ) then + if ( iaproc .eq. napout ) write (ndso,951) & + 'Homogeneous field data (and moving grid) ...' + + nh(-7) = nml_homog_count%n_ic1 + nh(-6) = nml_homog_count%n_ic2 + nh(-5) = nml_homog_count%n_ic3 + nh(-4) = nml_homog_count%n_ic4 + nh(-3) = nml_homog_count%n_ic5 + nh(-2) = nml_homog_count%n_mdn + nh(-1) = nml_homog_count%n_mth + nh(0) = nml_homog_count%n_mvs + nh(1) = nml_homog_count%n_lev + nh(2) = nml_homog_count%n_cur + nh(3) = nml_homog_count%n_wnd + nh(4) = nml_homog_count%n_ice + nh(5) = nml_homog_count%n_tau + nh(6) = nml_homog_count%n_rho + nh(10) = nml_homog_count%n_mov + + n_tot = nml_homog_count%n_tot + + do j=jfirst,10 + if ( nh(j) .gt. nhmax ) goto 2006 end do + + ! Store homogeneous fields + if ( n_tot .gt. 0 ) then + ihh(:)=0 + do ih=1,n_tot + read(nml_homog_input(ih)%name,*) idtst + select case (idtst) + case ('IC1') + j=-7 + case ('IC2') + j=-6 + case ('IC3') + j=-5 + case ('IC4') + j=-4 + case ('IC5') + j=-3 + case ('MDN') + j=-2 + case ('MTH') + j=-1 + case ('MVS') + j=0 + case ('LEV') + j=1 + case ('CUR') + j=2 + case ('WND') + j=3 + case ('ICE') + j=4 + case ('TAU') + j=5 + case ('RHO') + j=6 + case ('MOV') + j=10 + case DEFAULT + goto 2062 + end SELECT + ihh(j)=ihh(j)+1 + read(nml_homog_input(ih)%date,*) tho(:,j,ihh(j)) + ha(ihh(j),j) = nml_homog_input(ih)%value1 + hd(ihh(j),j) = nml_homog_input(ih)%value2 + hs(ihh(j),j) = nml_homog_input(ih)%value3 + end do + end if + + if (w3_o7_flag) then + do j=jfirst, 10 + if ( flh(j) .and. iaproc.eq.napout ) then + write (ndso,952) nh(j), idflds(j) + do i=1, nh(j) + if ( ( j .le. 1 ) .or. ( j .eq. 4 ) .or. ( j .eq. 6 ) ) then + write (ndso,953) i, tho(1,j,i), tho(2,j,i), ha(i,j) + else if ( ( j .eq. 2 ) .or. ( j .eq. 5 ) .or. ( j .eq. 10 ) ) then + write (ndso,953) i, tho(1,j,i), tho(2,j,i), ha(i,j), hd(i,j) + else if ( j .eq. 3 ) then + write (ndso,953) i, tho(1,j,i), tho(2,j,i), ha(i,j), hd(i,j), hs(i,j) + end if + end do + end if + end do + end if + + if ( ( flh(-7) .and. (nh(-7).eq.0) ) .or. & + ( flh(-6) .and. (nh(-6).eq.0) ) .or. & + ( flh(-5) .and. (nh(-5).eq.0) ) .or. & + ( flh(-4) .and. (nh(-4).eq.0) ) .or. & + ( flh(-3) .and. (nh(-3).eq.0) ) .or. & + ( flh(-2) .and. (nh(-2).eq.0) ) .or. & + ( flh(-1) .and. (nh(-1).eq.0) ) .or. & + ( flh(0) .and. (nh(0).eq.0) ) .or. & + ( flh(1) .and. (nh(1).eq.0) ) .or. & + ( flh(2) .and. (nh(2).eq.0) ) .or. & + ( flh(3) .and. (nh(3).eq.0) ) .or. & + ( flh(4) .and. (nh(4).eq.0) ) .or. & + ( flh(5) .and. (nh(5).eq.0) ) .or. & + ( flh(6) .and. (nh(6).eq.0) ) .or. & + ( flh(10) .and. (nh(10).eq.0) ) ) goto 2007 + + end if ! flhom + + end if ! flgnml + + ! + ! =============================================================== + ! process old read_shel_config.inp format + ! =============================================================== + ! + if (.not. flgnml) then + + call print_logmsg(740+IAPROC, ' fnmpre'//trim(fnmpre), w3_debuginit_flag) + open (newunit=ndsi,file=trim(fnmpre)//'ww3_shel.inp',status='old',iostat=ierr) + rewind (ndsi) + + read (ndsi,'(a)') comstr + if (comstr.eq.' ') comstr = '$' + if ( iaproc .eq. napout ) write (ndso,901) comstr + + !-------------------- + ! 2.1 forcing flags + !-------------------- + + call print_logmsg(740+IAPROC, '2.1 Forcing flags', w3_debuginit_flag) + flh(-7:10) = .false. + do j=jfirst, 9 + call nextln ( comstr , ndsi , ndsen ) + if ( j .le. 6 ) then + read (ndsi,*) flagtfc(j), flh(j) + else + read (ndsi,*) flagtfc(j) + end if + write(msg1,*)' J=', j, ' FLAGTFC=', flagtfc(j), ' FLH=', flh(j) + call print_logmsg(740+IAPROC, trim(msg1), w3_debuginit_flag) end do - if ( flt ) then - write (nds(1),'(a)') ' Fields : '//'no fields defined' + + if ( iaproc .eq. napout ) write (ndso,920) + do j=jfirst, 9 + if (flagtfc(j).eq.'T') then + inflags1(j)=.true. + flagsc(j)=.false. + end if + if (flagtfc(j).eq.'F') then + inflags1(j)=.false. + flagsc(j)=.false. + end if + if (flagtfc(j).eq.'C') then + inflags1(j)=.true. + flagsc(j)=.true. + end if + if ( j .le. 6 ) then + flh(j) = flh(j) .and. inflags1(j) + end if + if ( inflags1(j) ) then + yesxno = 'YES/--' + else + yesxno = '---/NO' + end if + if ( flh(j) ) then + strng = '(homogeneous field) ' + else if ( flagsc(j) ) then + strng = '(coupling field) ' + else + strng = ' ' + end if + if ( iaproc .eq. napout ) write (ndso,921) idflds(j), yesxno, strng + end do + if (w3_cou_flag) then + if (flagsc(1) .and. inflags1(2) .and. .not. flagsc(2)) goto 2102 + if (flagsc(2) .and. inflags1(1) .and. .not. flagsc(1)) goto 2102 end if - end if - ! npts, pnames are fpr point output - allocate ( x(1), y(1), pnames(1) ) - npts = 0 - pnames(1) = ' ' - prtfrm = .false. + call print_memcheck(740+IAPROC, 'memcheck_____:'//'read_shel_config SECTION 2b') - end subroutine set_shel_inp + inflags1(10) = .false. + if (w3_mgw_flag .or. w3_mgp_flag) then + inflags1(10) = .true. + flh(10) = .true. + end if + if ( inflags1(10) .and. iaproc.eq.napout ) & + write (ndso,921) idflds(10), 'yes/--', ' ' + + flflg = inflags1(-7) .or. inflags1(-6) .or. inflags1(-5) .or. inflags1(-4) & + .or. inflags1(-3) .or. inflags1(-2) .or. inflags1(-1) & + .or. inflags1(0) .or. inflags1(1) .or. inflags1(2) & + .or. inflags1(3) .or. inflags1(4) .or. inflags1(5) & + .or. inflags1(6) .or. inflags1(7) .or. inflags1(8) & + .or. inflags1(9) + flhom = flh(-7) .or. flh(-6) .or. flh(-5) .or. flh(-4) & + .or. flh(-3) .or. flh(-2) .or. flh(-1) .or. flh(0) & + .or. flh(1) .or. flh(2) .or. flh(3) .or. flh(4) & + .or. flh(5) .or. flh(6) .or. flh(10) + + if ( iaproc .eq. napout ) write (ndso,922) + ! inflags2 is just "initial value of inflags1", i.e. does *not* get + ! changed when model reads last record of ice.ww3 + inflags2=inflags1 + + if (w3_t_flag) then + write (ndst,9020) flflg, inflags1, flhom, flh + end if - !=============================================================================== -!> Read ww3_shel.inp (UWM) -!! -!! @param[in] mpi_comm mpi communicator -!! -!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov -!> @date 01-05-2022 - subroutine read_shel_inp(mpi_comm) - - USE W3GDATMD, ONLY: FLAGLL - USE W3WDATMD, ONLY: TIME, VA, W3NDAT, W3DIMW, W3SETW - USE W3ADATMD, ONLY: W3NAUX, W3DIMA, W3SETA - USE W3IDATMD, ONLY: INFLAGS1, INFLAGS2, FLAGSC - USE W3ODATMD, ONLY: W3NOUT, W3SETO, NDS - USE W3ODATMD, ONLY: NAPROC, IAPROC, NAPOUT, NAPERR - USE W3ODATMD, ONLY: IDOUT, FNMPRE, IOSTYP, NOTYPE - USE W3ODATMD, ONLY: FLOGRR, FLOGR, OFILES - USE W3IOGRMD, ONLY: W3IOGR - USE W3IOGOMD, ONLY: W3READFLGRD, W3FLGRDFLAG - USE W3SERVMD, ONLY: NEXTLN, EXTCDE - USE W3TIMEMD, ONLY: DSEC21, STME21, TICK21 - - INTEGER, INTENT(IN) :: MPI_COMM - - ! Local parameters - INTEGER, PARAMETER :: NHMAX = 200 - - INTEGER :: NDSI, NDSI2, NDSS, NDSO, NDSE, NDST, NDSL,& - NDSEN, IERR, J, I, ILOOP, IPTS - INTEGER :: NDSF(-7:9), & - NH(-7:10), THO(2,-7:10,NHMAX) - INTEGER :: jfirst, IERR_MPI - REAL :: FACTOR, DTTST, XX, YY, HA(NHMAX,-7:10), & - HD(NHMAX,-7:10), HS(NHMAX,-7:10) - - CHARACTER(LEN=1) :: COMSTR, FLAGTFC(-7:10) - CHARACTER(LEN=3) :: IDSTR(-7:10), IDTST - CHARACTER(LEN=6) :: YESXNO - CHARACTER(LEN=40) :: PN - CHARACTER(LEN=13) :: IDFLDS(-7:10) - CHARACTER(LEN=20) :: STRNG - CHARACTER(LEN=23) :: DTME21 - CHARACTER(LEN=30) :: IDOTYP(8) - CHARACTER(LEN=80) :: LINE - CHARACTER(LEN=1024) :: FLDRST='' - CHARACTER(LEN=80) :: LINEIN - CHARACTER(LEN=8) :: WORDS(7)='' - LOGICAL :: FLFLG, FLHOM, TFLAGI, FLH(-7:10) - INTEGER :: THRLEV = 1 - INTEGER :: TIME0(2), TIMEN(2), TTIME(2) - - DATA IDFLDS / 'ice param. 1 ' , 'ice param. 2 ' , & - 'ice param. 3 ' , 'ice param. 4 ' , & - 'ice param. 5 ' , & - 'mud density ' , 'mud thkness ' , & - 'mud viscos. ' , & - 'water levels ' , 'currents ' , & - 'winds ' , 'ice fields ' , & - 'momentum ' , 'air density ' , & - 'mean param. ' , '1D spectra ' , & - '2D spectra ' , 'moving grid ' / - DATA IDOTYP / 'Fields of mean wave parameters' , & - 'Point output ' , & - 'Track point output ' , & - 'Restart files ' , & - 'Nesting data ' , & - 'Partitioned wave field data ' , & - 'Fields for coupling ' , & - 'Restart files second request '/ - DATA IDSTR / 'IC1', 'IC2', 'IC3', 'IC4', 'IC5', 'MDN', 'MTH', & - 'MVS', 'LEV', 'CUR', 'WND', 'ICE', 'TAU', 'RHO', & - 'DT0', 'DT1', 'DT2', 'MOV' / - !--------------------------------------------------- - ! - FLGR2 = .FALSE. - FLH(:) = .FALSE. - iprt(:) = 0 + !-------------------- + ! 2.2 Time setup + !-------------------- + call print_logmsg(740+IAPROC, '2.2 Time setup ', w3_debuginit_flag) + call nextln ( comstr , ndsi , ndsen ) + read (ndsi,*) time0 + + call print_memcheck(740+IAPROC, 'memcheck_____:'//'read_shel_config SECTION 2c') + + call nextln ( comstr , ndsi , ndsen ) + read (ndsi,*) timen + call print_memcheck(740+IAPROC, 'memcheck_____:'//'read_shel_config SECTION 2d') + + !-------------------- + ! 2.3 Domain setup + !-------------------- + + call print_logmsg(740+IAPROC, '2.3 Domain setup ', w3_debuginit_flag) + call nextln ( COMSTR , NDSI , NDSEN ) + read (ndsi,*) iostyp + if (w3_pdlib_flag) then + if (iostyp .gt. 1) then + write(*,*) 'iostyp not supported in domain decomposition mode' + call extcde ( 6666 ) + endif + end if + call w3iogr ( 'GRID', ndsm ) + if ( flagll ) then + factor = 1. + else + factor = 1.e-3 + end if - ! IO setup comes next---do we want to move it from initreal? - - NDSI = 10 - NDSS = 90 - NDSO = 6 - NDSE = 6 - NDST = 6 - NDSL = 50 - - IF ( IAPROC .EQ. NAPERR ) THEN - NDSEN = NDSE - ELSE - NDSEN = -1 - END IF - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,905) & - MPI_THREAD_FUNNELED, THRLEV - NDSF(-7) = 1008 - NDSF(-6) = 1009 - NDSF(-5) = 1010 - NDSF(-4) = 1011 - NDSF(-3) = 1012 - NDSF(-2) = 1013 - NDSF(-1) = 1014 - NDSF(0) = 1015 - - NDSF(1) = 11 - NDSF(2) = 12 - NDSF(3) = 13 - NDSF(4) = 14 - NDSF(5) = 15 - NDSF(6) = 16 - NDSF(7) = 17 - NDSF(8) = 18 - NDSF(9) = 19 - ! 1.c Local parameters + !-------------------- + ! 2.4 Output dates + !-------------------- - ! Default COMSTR to "$" (for when using nml input files) - COMSTR = "$" - ! If using experimental mud or ice physics, additional lines will - ! be read in from ww3_shel.inp and applied, so JFIRST is changed from - ! its initialization setting "JFIRST=1" to some lower value. - JFIRST=1 - - ! process old ww3_shel.inp format - OPEN (NDSI,FILE=TRIM(FNMPRE)//'ww3_shel.inp',STATUS='OLD',IOSTAT=IERR) - REWIND (NDSI) - READ (NDSI,'(A)') COMSTR - IF (COMSTR.EQ.' ') COMSTR = '$' - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,901) COMSTR - - ! 2.1 forcing flags - - FLH(-7:10) = .FALSE. - DO J=JFIRST, 9 - CALL NEXTLN ( COMSTR , NDSI , NDSEN ) - IF ( J .LE. 6 ) THEN - READ (NDSI,*) FLAGTFC(J), FLH(J) - ELSE - READ (NDSI,*) FLAGTFC(J) - END IF - END DO - - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,920) - DO J=JFIRST, 9 - IF (FLAGTFC(J).EQ.'T') THEN - INFLAGS1(J)=.TRUE. - FLAGSC(J)=.FALSE. - END IF - IF (FLAGTFC(J).EQ.'F') THEN - INFLAGS1(J)=.FALSE. - FLAGSC(J)=.FALSE. - END IF - IF (FLAGTFC(J).EQ.'C') THEN - INFLAGS1(J)=.TRUE. - FLAGSC(J)=.TRUE. - END IF - IF ( J .LE. 6 ) THEN - FLH(J) = FLH(J) .AND. INFLAGS1(J) - END IF - IF ( INFLAGS1(J) ) THEN - YESXNO = 'YES/--' - ELSE - YESXNO = '---/NO' - END IF - IF ( FLH(J) ) THEN - STRNG = '(homogeneous field) ' - ELSE IF ( FLAGSC(J) ) THEN - STRNG = '(coupling field) ' - ELSE - STRNG = ' ' - END IF - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,921) IDFLDS(J), YESXNO, STRNG - END DO - - INFLAGS1(10) = .FALSE. - IF ( INFLAGS1(10) .AND. IAPROC.EQ.NAPOUT ) & - WRITE (NDSO,921) IDFLDS(10), 'YES/--', ' ' - FLFLG = INFLAGS1(-7) .OR. INFLAGS1(-6) .OR. INFLAGS1(-5) .OR. INFLAGS1(-4) & - .OR. INFLAGS1(-3) .OR. INFLAGS1(-2) .OR. INFLAGS1(-1) & - .OR. INFLAGS1(0) .OR. INFLAGS1(1) .OR. INFLAGS1(2) & - .OR. INFLAGS1(3) .OR. INFLAGS1(4) .OR. INFLAGS1(5) & - .OR. INFLAGS1(6) .OR. INFLAGS1(7) .OR. INFLAGS1(8) & - .OR. INFLAGS1(9) - FLHOM = FLH(-7) .OR. FLH(-6) .OR. FLH(-5) .OR. FLH(-4) & - .OR. FLH(-3) .OR. FLH(-2) .OR. FLH(-1) .OR. FLH(0) & - .OR. FLH(1) .OR. FLH(2) .OR. FLH(3) .OR. FLH(4) & - .OR. FLH(5) .OR. FLH(6) .OR. FLH(10) - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,922) - ! - ! INFLAGS2 is just "initial value of INFLAGS1", i.e. does *not* get - ! changed when model reads last record of ice.ww3 - INFLAGS2=INFLAGS1 - ! 2.2 Time setup + call print_logmsg(740+IAPROC, '2.4 Output dates ', w3_debuginit_flag) + npts = 0 + notype = 6 + if (w3_cou_flag) then + notype = 7 + end if + do j = 1, notype + write(msg1,*)'J=', J, '/ NOTYPE=', NOTYPE + call nextln ( comstr , ndsi , ndsen ) + + ! checkpoint + if (j .eq. 4) then + odat(38)=0 + words(1:7)='' + read (ndsi,'(a)') linein + read(linein,*,iostat=ierr) words + read(words( 1 ), * ) odat(16) + read(words( 2 ), * ) odat(17) + read(words( 3 ), * ) odat(18) + read(words( 4 ), * ) odat(19) + read(words( 5 ), * ) odat(20) + if (words(6) .eq. 'T') then + call nextln ( comstr , ndsi , ndsen ) + read (ndsi,*,end=2001,err=2002)(odat(i),i=5*(8-1)+1,5*8) + if(iaproc .eq. naproc) write(*,*)'odat(j=4): ',(odat(i),i=5*(8-1)+1,5*8) + end if + if (words(7) .eq. 'T') then + call nextln ( comstr , ndsi , ndsen ) + read (ndsi,'(a)',end=2001,err=2002) fldrst + end if + call w3flgrdflag ( ndso, ndso, ndse, fldrst, flogr, flogrr, iaproc, napout, ierr ) + if ( ierr .ne. 0 ) goto 2222 + else + + !inline new variable to read if present ofiles(j), if not ==0 + ! read (ndsi,*) (odat(i),i=5*(j-1)+1,5*j) + ! read (ndsi,*,iostat=ierr) (odat(i),i=5*(j-1)+1,5*j),ofiles(j) + if(j .le. 2) then + words(1:6)='' + ! read (ndsi,*,end=2001,err=2002)(odat(i),i=5*(j-1)+1,5*j),ofiles(j) + read (ndsi,'(a)') linein + read(linein,*,iostat=ierr) words + + if(j .eq. 1) then + read(words( 1 ), * ) odat(1) + read(words( 2 ), * ) odat(2) + read(words( 3 ), * ) odat(3) + read(words( 4 ), * ) odat(4) + read(words( 5 ), * ) odat(5) + else + read(words( 1 ), * ) odat(6) + read(words( 2 ), * ) odat(7) + read(words( 3 ), * ) odat(8) + read(words( 4 ), * ) odat(9) + read(words( 5 ), * ) odat(10) + end if - CALL NEXTLN ( COMSTR , NDSI , NDSEN ) - READ (NDSI,*) TIME0 - CALL NEXTLN ( COMSTR , NDSI , NDSEN ) - READ (NDSI,*) TIMEN + if (words(6) .ne. '0' .and. words(6) .ne. '1') then + ofiles(j)=0 + else + read(words( 6 ), * ) ofiles(j) + end if - ! 2.3 Domain setup + else if(j .eq. 7) then - CALL NEXTLN ( COMSTR , NDSI , NDSEN ) - READ (NDSI,*) IOSTYP - CALL W3IOGR ( 'GRID', NDSF(7) ) - IF ( FLAGLL ) THEN - FACTOR = 1. - ELSE - FACTOR = 1.E-3 - END IF +#ifdef W3_COU + words(1:6)='' + read (ndsi,'(a)') linein + read(linein,*,iostat=ierr) words - ! 2.4 Output dates + read(words( 1 ), * ) odat(31) + read(words( 2 ), * ) odat(32) + read(words( 3 ), * ) odat(33) + read(words( 4 ), * ) odat(34) + read(words( 5 ), * ) odat(35) - NPTS = 0 - NOTYPE = 6 - DO J = 1, NOTYPE - CALL NEXTLN ( COMSTR , NDSI , NDSEN ) - ! CHECKPOINT - IF(J .EQ. 4) THEN - ODAT(38)=0 - WORDS(1:7)='' - READ (NDSI,'(A)') LINEIN - READ(LINEIN,*,iostat=ierr) WORDS - READ(WORDS( 1 ), * ) ODAT(16) - READ(WORDS( 2 ), * ) ODAT(17) - READ(WORDS( 3 ), * ) ODAT(18) - READ(WORDS( 4 ), * ) ODAT(19) - READ(WORDS( 5 ), * ) ODAT(20) - IF (WORDS(6) .EQ. 'T') THEN - CALL NEXTLN ( COMSTR , NDSI , NDSEN ) - READ (NDSI,*,END=2001,ERR=2002)(ODAT(I),I=5*(8-1)+1,5*8) - if(iaproc .eq. naproc) WRITE(*,*)'odat(j=4): ',(ODAT(I),I=5*(8-1)+1,5*8) - END IF - IF (WORDS(7) .EQ. 'T') THEN - CALL NEXTLN ( COMSTR , NDSI , NDSEN ) - READ (NDSI,'(A)',END=2001,ERR=2002) FLDRST - END IF - CALL W3FLGRDFLAG ( NDSO, NDSO, NDSE, FLDRST, FLOGR, & - FLOGRR, IAPROC, NAPOUT, IERR ) - IF ( IERR .NE. 0 ) GOTO 2222 - ELSE - !INLINE NEW VARIABLE TO READ IF PRESENT OFILES(J), IF NOT ==0 - ! READ (NDSI,*) (ODAT(I),I=5*(J-1)+1,5*J) - ! READ (NDSI,*,IOSTAT=IERR) (ODAT(I),I=5*(J-1)+1,5*J),OFILES(J) - IF(J .LE. 2) THEN - WORDS(1:6)='' - ! READ (NDSI,*,END=2001,ERR=2002)(ODAT(I),I=5*(J-1)+1,5*J),OFILES(J) - READ (NDSI,'(A)') LINEIN - READ(LINEIN,*,iostat=ierr) WORDS - IF(J .EQ. 1) THEN - READ(WORDS( 1 ), * ) ODAT(1) - READ(WORDS( 2 ), * ) ODAT(2) - READ(WORDS( 3 ), * ) ODAT(3) - READ(WORDS( 4 ), * ) ODAT(4) - READ(WORDS( 5 ), * ) ODAT(5) - ELSE - READ(WORDS( 1 ), * ) ODAT(6) - READ(WORDS( 2 ), * ) ODAT(7) - READ(WORDS( 3 ), * ) ODAT(8) - READ(WORDS( 4 ), * ) ODAT(9) - READ(WORDS( 5 ), * ) ODAT(10) - END IF - - IF (WORDS(6) .NE. '0' .AND. WORDS(6) .NE. '1') THEN - OFILES(J)=0 - ELSE - READ(WORDS( 6 ), * ) OFILES(J) - END IF - ELSE - OFILES(J)=0 - READ (NDSI,*,END=2001,ERR=2002)(ODAT(I),I=5*(J-1)+1,5*J) - END IF - ODAT(5*(J-1)+3) = MAX ( 0 , ODAT(5*(J-1)+3) ) - ! 2.5 Output types - - IF ( ODAT(5*(J-1)+3) .NE. 0 ) THEN - - ! Type 1: fields of mean wave parameters - IF ( J .EQ. 1 ) THEN - CALL W3READFLGRD ( NDSI, NDSO, 9, NDSEN, COMSTR, FLGD, & - FLGRD, IAPROC, NAPOUT, IERR ) - IF ( IERR .NE. 0 ) GOTO 2222 - ! Type 2: point output - ELSE IF ( J .EQ. 2 ) THEN - DO ILOOP=1,2 - IF ( ILOOP .EQ. 1 ) THEN - NDSI2 = NDSI - IF ( IAPROC .EQ. 1 ) OPEN & - (NDSS,FILE=TRIM(FNMPRE)//'ww3_shel.scratch') - ELSE - NDSI2 = NDSS - CALL MPI_BARRIER (MPI_COMM,IERR_MPI) - OPEN (NDSS,FILE=TRIM(FNMPRE)//'ww3_shel.scratch') - REWIND (NDSS) - - IF ( .NOT.ALLOCATED(X) ) THEN - IF ( NPTS.GT.0 ) THEN - ALLOCATE ( X(NPTS), Y(NPTS), PNAMES(NPTS) ) - ELSE - ALLOCATE ( X(1), Y(1), PNAMES(1) ) - GOTO 2054 - END IF - END IF - END IF + if (words(6) .eq. 'T') then + cplt0 = .true. + else + cplt0 = .false. + end if +#endif - NPTS = 0 - DO - CALL NEXTLN ( COMSTR , NDSI , NDSEN ) - READ (NDSI2,*) XX, YY, PN - IF ( ILOOP.EQ.1 .AND. IAPROC.EQ.1 ) THEN - BACKSPACE (NDSI) - READ (NDSI,'(A)') LINE - WRITE (NDSS,'(A)') LINE - END IF - IF ( INDEX(PN,"STOPSTRING").NE.0 ) EXIT - NPTS = NPTS + 1 - IF ( ILOOP .EQ. 1 ) CYCLE - X(NPTS) = XX - Y(NPTS) = YY - PNAMES(NPTS) = PN - IF ( IAPROC .EQ. NAPOUT ) THEN - IF ( FLAGLL ) THEN - IF ( NPTS .EQ. 1 ) THEN - WRITE (NDSO,2945) & - FACTOR*XX, FACTOR*YY, PN - ELSE - WRITE (NDSO,2946) NPTS, & - FACTOR*XX, FACTOR*YY, PN - END IF - ELSE - IF ( NPTS .EQ. 1 ) THEN - WRITE (NDSO,2955) & - FACTOR*XX, FACTOR*YY, PN - ELSE - WRITE (NDSO,2956) NPTS, & - FACTOR*XX, FACTOR*YY, PN - END IF - END IF - END IF - END DO - IF ( IAPROC.EQ.1 .AND. ILOOP.EQ.1 ) CLOSE (NDSS) - END DO - IF ( NPTS.EQ.0 .AND. IAPROC.EQ.NAPOUT ) & - WRITE (NDSO,2947) - IF ( IAPROC .EQ. 1 ) THEN - CALL MPI_BARRIER ( MPI_COMM, IERR_MPI ) - CLOSE (NDSS,STATUS='DELETE') - ELSE - CLOSE (NDSS) - CALL MPI_BARRIER ( MPI_COMM, IERR_MPI ) - END IF + else - ! Type 3: track output - ELSE IF ( J .EQ. 3 ) THEN - CALL NEXTLN ( COMSTR , NDSI , NDSEN ) - READ (NDSI,*) TFLAGI - IF ( .NOT. TFLAGI ) NDS(11) = -NDS(11) - IF ( IAPROC .EQ. NAPOUT ) THEN - IF ( .NOT. TFLAGI ) THEN - WRITE (NDSO,3945) 'input', 'UNFORMATTED' - ELSE - WRITE (NDSO,3945) 'input', 'FORMATTED' - END IF - END IF + ofiles(j)=0 + read (ndsi,*,end=2001,err=2002)(odat(i),i=5*(j-1)+1,5*j) - ! Type 6: partitioning - ELSE IF ( J .EQ. 6 ) THEN - ! IPRT: IX0, IXN, IXS, IY0, IYN, IYS - CALL NEXTLN ( COMSTR , NDSI , NDSEN ) - READ (NDSI,*) IPRT, PRTFRM - IF ( IAPROC .EQ. NAPOUT ) THEN - IF ( PRTFRM ) THEN - YESXNO = 'YES/--' - ELSE - YESXNO = '---/NO' - END IF - WRITE (NDSO,6945) IPRT, YESXNO - END IF - END IF ! J - END IF ! ODAT - END IF ! IF J=4 - END DO ! J - - ! force minimal allocation to avoid memory seg fault - IF ( .NOT.ALLOCATED(X) .AND. NPTS.EQ.0 ) ALLOCATE ( X(1), Y(1), PNAMES(1) ) - - ! 2.6 Homogeneous field data - - IF ( FLHOM ) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,951) & - 'Homogeneous field data (and moving grid) ...' - NH = 0 - ! Start of loop - DO - CALL NEXTLN ( COMSTR , NDSI , NDSEN ) - READ (NDSI,*) IDTST - - ! Exit if illegal id - IF ( IDTST.NE.IDSTR(-7) .AND. IDTST.NE.IDSTR(-6) .AND. & - IDTST.NE.IDSTR(-5) .AND. IDTST.NE.IDSTR(-4) .AND. & - IDTST.NE.IDSTR(-3) .AND. IDTST.NE.IDSTR(-2) .AND. & - IDTST.NE.IDSTR(-1) .AND. IDTST.NE.IDSTR(0) .AND. & - IDTST.NE.IDSTR(1) .AND. IDTST.NE.IDSTR(2) .AND. & - IDTST.NE.IDSTR(3) .AND. IDTST.NE.IDSTR(4) .AND. & - IDTST.NE.IDSTR(5) .AND. IDTST.NE.IDSTR(6) .AND. & - IDTST.NE.IDSTR(10) .AND. IDTST.NE.'STP' ) GOTO 2005 - - ! Stop conditions - IF ( IDTST .EQ. 'STP' ) THEN - EXIT - ELSE - BACKSPACE ( NDSI ) - END IF - - ! Store data - DO J=LBOUND(IDSTR,1), 10 - IF ( IDTST .EQ. IDSTR(J) ) THEN - NH(J) = NH(J) + 1 - IF ( NH(J) .GT. NHMAX ) GOTO 2006 - IF ( J .LE. 1 ) THEN ! water levels, etc. : get HA - READ (NDSI,*) IDTST, & - THO(1,J,NH(J)), THO(2,J,NH(J)), & - HA(NH(J),J) - ELSE IF ( J .EQ. 2 ) THEN ! currents: get HA and HD - READ (NDSI,*) IDTST, & - THO(1,J,NH(J)), THO(2,J,NH(J)), & - HA(NH(J),J), HD(NH(J),J) - ELSE IF ( J .EQ. 3 ) THEN ! wind: get HA HD and HS - READ (NDSI,*) IDTST, & - THO(1,J,NH(J)), THO(2,J,NH(J)), & - HA(NH(J),J), HD(NH(J),J), HS(NH(J),J) - ELSE IF ( J .EQ. 4 ) THEN ! ice - READ (NDSI,*) IDTST, & - THO(1,J,NH(J)), THO(2,J,NH(J)), & - HA(NH(J),J) - ELSE IF ( J .EQ. 5 ) THEN ! atmospheric momentum - READ (NDSI,*) IDTST, & - THO(1,J,NH(J)), THO(2,J,NH(J)), & - HA(NH(J),J), HD(NH(J),j) - ELSE IF ( J .EQ. 6 ) THEN ! air density - READ (NDSI,*) IDTST, & - THO(1,J,NH(J)), THO(2,J,NH(J)), & - HA(NH(J),J) - ELSE IF ( J .EQ. 10 ) THEN ! mov: HA and HD - READ (NDSI,*) IDTST, & - THO(1,J,NH(J)), THO(2,J,NH(J)), & - HA(NH(J),J), HD(NH(J),J) - END IF - END IF - END DO - END DO -#ifdef W3_O7 - DO J=JFIRST, 10 - IF ( FLH(J) .AND. IAPROC.EQ.NAPOUT ) THEN - WRITE (NDSO,952) NH(J), IDFLDS(J) - DO I=1, NH(J) - IF ( ( J .LE. 1 ) .OR. ( J .EQ. 4 ) .OR. & - ( J .EQ. 6 ) ) THEN - WRITE (NDSO,953) I, THO(1,J,I), THO(2,J,I), & - HA(I,J) - ELSE IF ( ( J .EQ. 2 ) .OR. ( J .EQ. 5 ) .OR. & - ( J .EQ. 10 ) ) THEN - WRITE (NDSO,953) I, THO(1,J,I), THO(2,J,I), & - HA(I,J), HD(I,J) - ELSE IF ( J .EQ. 3 ) THEN - WRITE (NDSO,953) I, THO(1,J,I), THO(2,J,I), & - HA(I,J), HD(I,J), HS(I,J) - END IF - END DO - END IF - END DO + end if !j le 2 + odat(5*(j-1)+3) = max ( 0 , odat(5*(j-1)+3) ) + write(msg1, *) 'read_shel_config NOTTYPE', J + call print_memcheck(740+IAPROC, 'memcheck_____:'//trim(msg1)) + + !-------------------- + ! 2.5 Output types + !-------------------- + + call print_logmsg(740+IAPROC, ' 2.5 Output types ', w3_debuginit_flag) + if ( odat(5*(j-1)+3) .ne. 0 ) then + if ( j .eq. 1 ) then + + ! type 1: fields of mean wave parameters + call w3readflgrd ( ndsi, ndso, 9, ndsen, comstr, flgd, flgrd, iaproc, napout, ierr ) + if ( ierr .ne. 0 ) goto 2222 + + else if ( j .eq. 2 ) then + + ! type 2: point output + do iloop=1,2 + if ( iloop .eq. 1 ) then + ndsi2 = ndsi + if ( iaproc .eq. 1 ) open (ndss,file=trim(fnmpre)//'ww3_shel.scratch') + else + ndsi2 = ndss +#ifdef W3_MPI + call mpi_barrier (mpi_comm,ierr_mpi) #endif - IF ( ( FLH(-7) .AND. (NH(-7).EQ.0) ) .OR. & - ( FLH(-6) .AND. (NH(-6).EQ.0) ) .OR. & - ( FLH(-5) .AND. (NH(-5).EQ.0) ) .OR. & - ( FLH(-4) .AND. (NH(-4).EQ.0) ) .OR. & - ( FLH(-3) .AND. (NH(-3).EQ.0) ) .OR. & - ( FLH(-2) .AND. (NH(-2).EQ.0) ) .OR. & - ( FLH(-1) .AND. (NH(-1).EQ.0) ) .OR. & - ( FLH(0) .AND. (NH(0).EQ.0) ) .OR. & - ( FLH(1) .AND. (NH(1).EQ.0) ) .OR. & - ( FLH(2) .AND. (NH(2).EQ.0) ) .OR. & - ( FLH(3) .AND. (NH(3).EQ.0) ) .OR. & - ( FLH(4) .AND. (NH(4).EQ.0) ) .OR. & - ( FLH(5) .AND. (NH(5).EQ.0) ) .OR. & - ( FLH(6) .AND. (NH(6).EQ.0) ) .OR. & - ( FLH(10) .AND. (NH(10).EQ.0) ) ) GOTO 2007 - END IF ! FLHOM - - ! END IF ! if not flgnml + open (ndss,file=trim(fnmpre)//'ww3_shel.scratch') + rewind (ndss) + + if ( .not.allocated(x) ) then + if ( npts.gt.0 ) then + allocate ( x(npts), y(npts), pnames(npts) ) + else + allocate ( x(1), y(1), pnames(1) ) + goto 2054 + end if + end if + end if + + npts = 0 + do + call nextln ( comstr , ndsi , ndsen ) + read (ndsi2,*) xx, yy, pn + if ( iloop.eq.1 .and. iaproc.eq.1 ) then + backspace (ndsi) + read (ndsi,'(a)') line + write (ndss,'(a)') line + end if + if ( index(pn,"STOPSTRING").ne.0 ) exit + npts = npts + 1 + if ( iloop .eq. 1 ) cycle + x(npts) = xx + y(npts) = yy + pnames(npts) = pn + if ( iaproc .eq. napout ) then + if ( flagll ) then + if ( npts .eq. 1 ) then + write (ndso,2945) factor*xx, factor*yy, pn + else + write (ndso,2946) npts, factor*xx, factor*yy, pn + end if + else + if ( npts .eq. 1 ) then + write (ndso,2955) factor*xx, factor*yy, pn + else + write (ndso,2956) npts, factor*xx, factor*yy, pn + end if + end if + end if + end do + + if ( iaproc.eq.1 .and. iloop.eq.1 ) close (ndss) + end do + + if ( npts.eq.0 .and. iaproc.eq.napout ) write (ndso,2947) + if ( iaproc .eq. 1 ) then +#ifdef W3_MPI + call mpi_barrier ( mpi_comm, ierr_mpi ) +#endif + close (ndss,status='delete') + else +#ifdef W3_MPI + call mpi_barrier ( mpi_comm, ierr_mpi ) +#endif + close (ndss) + end if + + else if ( j .eq. 3 ) then + call print_logmsg(740+IAPROC, ' 2.5 Track output ', w3_debuginit_flag) + ! Type 3: track output + call nextln ( comstr , ndsi , ndsen ) + read (ndsi,*) tflagi + if ( .not. tflagi ) nds(11) = -nds(11) + if ( iaproc .eq. napout ) then + if ( .not. tflagi ) then + write (ndso,3945) 'input', 'UNFORMATTED' + else + write (ndso,3945) 'input', 'FORMATTED' + end if + end if + + else if ( j .eq. 6 ) then + call print_logmsg(740+IAPROC, ' 2.6 Partitioning output ', w3_debuginit_flag) + ! Type 6: partitioning + ! IPRT: IX0, IXN, IXS, IY0, IYN, IYS + call nextln ( comstr , ndsi , ndsen ) + read (ndsi,*) iprt, prtfrm + + if ( iaproc .eq. napout ) then + if ( prtfrm ) then + yesxno = 'YES/--' + else + yesxno = '---/NO' + end if + write (ndso,6945) iprt, yesxno + end if + + else if ( j .eq. 7 ) then + + ! Type 7: coupling +#ifdef W3_COU + call w3readflgrd ( ndsi, ndso, ndss, ndsen, comstr, flg2, flgr2, iaproc, napout, ierr ) + if ( ierr .ne. 0 ) goto 2222 + call nextln ( comstr , ndsi , ndsen ) + read (ndsi,'(a)',end=2001,err=2002,iostat=ierr) fldin +#endif + + end if ! j + + end if ! odat + end if ! if j=4 + end do ! j + + ! force minimal allocation to avoid memory seg fault + if ( .not.allocated(x) .and. npts.eq.0 ) allocate ( x(1), y(1), pnames(1) ) + + !-------------------- + ! 2.6 Homogeneous field data + !-------------------- + + call print_logmsg(740+IAPROC, ' 2.6 Homogeneous field data ', w3_debuginit_flag) + if ( flhom ) then + if ( iaproc .eq. napout ) write (ndso,951) 'homogeneous field data (and moving grid) ...' + nh = 0 + + ! Start of loop + do + call nextln ( comstr , ndsi , ndsen ) + read (ndsi,*) idtst + ! Exit if illegal id + if ( idtst.ne.idstr(-7) .and. idtst.ne.idstr(-6) .and. & + idtst.ne.idstr(-5) .and. idtst.ne.idstr(-4) .and. & + idtst.ne.idstr(-3) .and. idtst.ne.idstr(-2) .and. & + idtst.ne.idstr(-1) .and. idtst.ne.idstr(0) .and. & + idtst.ne.idstr(1) .and. idtst.ne.idstr(2) .and. & + idtst.ne.idstr(3) .and. idtst.ne.idstr(4) .and. & + idtst.ne.idstr(5) .and. idtst.ne.idstr(6) .and. & + idtst.ne.idstr(10) .and. idtst.ne.'STP' ) goto 2005 + + ! Stop conditions + if ( idtst .eq. 'STP' ) then + exit + else + backspace ( ndsi ) + end if + call print_logmsg(740+IAPROC, ' 2.6 Store data ', w3_debuginit_flag) + ! Store data + do j=lbound(idstr,1), 10 + if ( idtst .eq. idstr(j) ) then + nh(j) = nh(j) + 1 + if ( nh(j) .gt. nhmax ) goto 2006 + IF ( J .LE. 1 ) THEN ! water levels, etc. : get HA + read (ndsi,*) idtst, & + tho(1,j,nh(j)), tho(2,j,nh(j)), & + ha(nh(j),j) + ELSE IF ( J .EQ. 2 ) THEN ! currents: get HA and HD + read (ndsi,*) idtst, & + tho(1,j,nh(j)), tho(2,j,nh(j)), & + ha(nh(j),j), hd(nh(j),j) + ELSE IF ( J .EQ. 3 ) THEN ! wind: get HA HD and HS + read (ndsi,*) idtst, & + tho(1,j,nh(j)), tho(2,j,nh(j)), & + ha(nh(j),j), hd(nh(j),j), hs(nh(j),j) + ELSE IF ( J .EQ. 4 ) THEN ! ice + read (ndsi,*) idtst, & + tho(1,j,nh(j)), tho(2,j,nh(j)), & + ha(nh(j),j) + ELSE IF ( J .EQ. 5 ) THEN ! atmospheric momentum + read (ndsi,*) idtst, & + tho(1,j,nh(j)), tho(2,j,nh(j)), & + ha(nh(j),j), hd(nh(j),j) + ELSE IF ( J .EQ. 6 ) THEN ! air density + read (ndsi,*) idtst, & + tho(1,j,nh(j)), tho(2,j,nh(j)), & + ha(nh(j),j) + ELSE IF ( J .EQ. 10 ) THEN ! mov: HA and HD + read (ndsi,*) idtst, & + tho(1,j,nh(j)), tho(2,j,nh(j)), & + ha(nh(j),j), hd(nh(j),j) + END IF + end if + end do + end do + call print_memcheck(740+IAPROC, 'memcheck_____:'//'read_shel_config SECTION 3') + + if (w3_o7_flag) then + do j=jfirst, 10 + if ( flh(j) .and. iaproc.eq.napout ) then + write (ndso,952) nh(j), idflds(j) + do i=1, nh(j) + if ( ( j .le. 1 ) .or. ( j .eq. 4 ) .or. ( j .eq. 6 ) ) then + write (ndso,953) i, tho(1,j,i), tho(2,j,i), ha(i,j) + else if ( ( j .eq. 2 ) .or. ( j .eq. 5 ) .or. ( j .eq. 10 ) ) then + write (ndso,953) i, tho(1,j,i), tho(2,j,i), ha(i,j), hd(i,j) + else if ( j .eq. 3 ) then + write (ndso,953) i, tho(1,j,i), tho(2,j,i), ha(i,j), hd(i,j), hs(i,j) + end if + end do + end if + end do + end if + + if ( ( flh(-7) .and. (nh(-7).eq.0) ) .or. & + ( flh(-6) .and. (nh(-6).eq.0) ) .or. & + ( flh(-5) .and. (nh(-5).eq.0) ) .or. & + ( flh(-4) .and. (nh(-4).eq.0) ) .or. & + ( flh(-3) .and. (nh(-3).eq.0) ) .or. & + ( flh(-2) .and. (nh(-2).eq.0) ) .or. & + ( flh(-1) .and. (nh(-1).eq.0) ) .or. & + ( flh(0) .and. (nh(0).eq.0) ) .or. & + ( flh(1) .and. (nh(1).eq.0) ) .or. & + ( flh(2) .and. (nh(2).eq.0) ) .or. & + ( flh(3) .and. (nh(3).eq.0) ) .or. & + ( flh(4) .and. (nh(4).eq.0) ) .or. & + ( flh(5) .and. (nh(5).eq.0) ) .or. & + ( flh(6) .and. (nh(6).eq.0) ) .or. & + ( flh(10) .and. (nh(10).eq.0) ) ) goto 2007 + + end if ! flhom + close(ndsi) + end if ! .not. flgnml + + call print_memcheck(740+IAPROC, 'memcheck_____:'//'read_shel_config SECTION 4') + + !-------------------- ! 2.2 Time setup + !-------------------- + + if (present(time0_overwrite) .and. present(timen_overwrite)) then + time0(:) = time0_overwrite(:) + timen(:) = timen_overwrite(:) + do j = 1,notype + if (odat(5*(j-1)+3) .ne. 0 ) then ! non-zero stride + odat(5*(j-1)+1) = time0(1) + odat(5*(j-1)+2) = time0(2) + odat(5*(j-1)+4) = timen(1) + odat(5*(j-1)+5) = timen(2) + end if + end do + j=8 + if (odat(5*(j-1)+3) .ne. 0) then ! non-zero stride + odat(5*(j-1)+1) = time0(1) + odat(5*(j-1)+2) = time0(2) + odat(5*(j-1)+4) = timen(1) + odat(5*(j-1)+5) = timen(2) + end if + end if + + if ( iaproc .eq. napout ) write (ndso,930) + call stme21 ( time0 , dtme21 ) + if ( iaproc .eq. napout ) write (ndso,931) dtme21 + time = time0 + call stme21 ( timen , dtme21 ) + if ( iaproc .eq. napout ) write (ndso,932) dtme21 +#ifdef W3_OASIS + time00 = time0 + timeend = timen +#endif +#ifdef W3_NL5 + qi5tbeg = time0 +#endif - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,930) - CALL STME21 ( TIME0 , DTME21 ) - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,931) DTME21 - TIME = TIME0 - CALL STME21 ( TIMEN , DTME21 ) - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,932) DTME21 - DTTST = DSEC21 ( TIME0 , TIMEN ) - IF ( DTTST .LE. 0. ) GOTO 2003 + dttst = dsec21 ( time0 , timen ) + if ( dttst .le. 0. ) goto 2003 + !-------------------- ! 2.3 Domain setup + !-------------------- + + iostyp = max ( 0 , min ( 3 , iostyp ) ) + if (w3_pdlib_flag) then + if (iostyp .gt. 1) then + write(*,*) 'iostyp not supported in domain decomposition mode' + call extcde ( 6666 ) + end if + endif + + if ( iaproc .eq. napout ) then + if ( iostyp .eq. 0 ) then + write (ndso,940) 'No dedicated output process, parallel file system required.' + else if ( iostyp .eq. 1 ) then + write (ndso,940) 'No dedicated output process, any file system.' + else if ( iostyp .eq. 2 ) then + write (ndso,940) 'Single dedicated output process.' + else if ( iostyp .eq. 3 ) then + write (ndso,940) 'Multiple dedicated output processes.' + else + write (ndso,940) 'IOSTYP NOT RECOGNIZED' + end if + end if - IOSTYP = MAX ( 0 , MIN ( 3 , IOSTYP ) ) - IF ( IAPROC .EQ. NAPOUT ) THEN - IF ( IOSTYP .EQ. 0 ) THEN - WRITE (NDSO,940) 'No dedicated output process, ' // & - 'parallel file system required.' - ELSE IF ( IOSTYP .EQ. 1 ) THEN - WRITE (NDSO,940) 'No dedicated output process, ' // & - 'any file system.' - ELSE IF ( IOSTYP .EQ. 2 ) THEN - WRITE (NDSO,940) 'Single dedicated output process.' - ELSE IF ( IOSTYP .EQ. 3 ) THEN - WRITE (NDSO,940) 'Multiple dedicated output processes.' - ELSE - WRITE (NDSO,940) 'IOSTYP NOT RECOGNIZED' - END IF - END IF + ! TODO: the following documents the output dates according to + ! the nml/inp files. Check if it be removed if user controls + ! output w/ alarms ! 2.4 Output dates - DO J = 1, NOTYPE - IF ( ODAT(5*(J-1)+3) .NE. 0 ) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,941) J, IDOTYP(J) - TTIME(1) = ODAT(5*(J-1)+1) - TTIME(2) = ODAT(5*(J-1)+2) - CALL STME21 ( TTIME , DTME21 ) - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,942) DTME21 - TTIME(1) = ODAT(5*(J-1)+4) - TTIME(2) = ODAT(5*(J-1)+5) - CALL STME21 ( TTIME , DTME21 ) - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,943) DTME21 - TTIME(1) = 0 - TTIME(2) = 0 - DTTST = REAL ( ODAT(5*(J-1)+3) ) - CALL TICK21 ( TTIME , DTTST ) - CALL STME21 ( TTIME , DTME21 ) - IF ( ( ODAT(5*(J-1)+1) .NE. ODAT(5*(J-1)+4) .OR. & - ODAT(5*(J-1)+2) .NE. ODAT(5*(J-1)+5) ) .AND. & - IAPROC .EQ. NAPOUT ) THEN - IF ( DTME21(9:9) .NE. '0' ) THEN - WRITE (NDSO,1944) DTME21( 9:19) - ELSE IF ( DTME21(10:10) .NE. '0' ) THEN - WRITE (NDSO,2944) DTME21(10:19) - ELSE - WRITE (NDSO,3944) DTME21(12:19) - END IF - END IF - END IF - END DO + do j = 1, notype + if ( odat(5*(j-1)+3) .ne. 0 ) then + if ( iaproc .eq. napout ) write (ndso,941) j, idotyp(j) + ttime(1) = odat(5*(j-1)+1) + ttime(2) = odat(5*(j-1)+2) + call stme21 ( ttime , dtme21 ) + if ( iaproc .eq. napout ) write (ndso,942) dtme21 + ttime(1) = odat(5*(j-1)+4) + ttime(2) = odat(5*(j-1)+5) + call stme21 ( ttime , dtme21 ) + if ( iaproc .eq. napout ) write (ndso,943) dtme21 + ttime(1) = 0 + ttime(2) = 0 + dttst = real ( odat(5*(j-1)+3) ) + call tick21 ( ttime , dttst ) + call stme21 ( ttime , dtme21 ) + if ( ( odat(5*(j-1)+1) .ne. odat(5*(j-1)+4) .or. odat(5*(j-1)+2) .ne. odat(5*(j-1)+5) ) & + .and. iaproc .eq. napout ) then + if ( dtme21(9:9) .ne. '0' ) then + write (ndso,1944) dtme21( 9:19) + else if ( dtme21(10:10) .ne. '0' ) then + write (ndso,2944) dtme21(10:19) + else + write (ndso,3944) dtme21(12:19) + end if + end if + end if + end do ! CHECKPOINT - J=8 - IF (ODAT(38) .NE. 0) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,941) J, IDOTYP(J) - TTIME(1) = ODAT(5*(J-1)+1) - TTIME(2) = ODAT(5*(J-1)+2) - CALL STME21 ( TTIME , DTME21 ) - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,942) DTME21 - TTIME(1) = ODAT(5*(J-1)+4) - TTIME(2) = ODAT(5*(J-1)+5) - CALL STME21 ( TTIME , DTME21 ) - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,943) DTME21 - TTIME(1) = 0 - TTIME(2) = 0 - DTTST = REAL ( ODAT(5*(J-1)+3) ) - CALL TICK21 ( TTIME , DTTST ) - CALL STME21 ( TTIME , DTME21 ) - IF ( ( ODAT(5*(J-1)+1) .NE. ODAT(5*(J-1)+4) .OR. & - ODAT(5*(J-1)+2) .NE. ODAT(5*(J-1)+5) ) .AND. & - IAPROC .EQ. NAPOUT ) THEN - IF ( DTME21(9:9) .NE. '0' ) THEN - WRITE (NDSO,1944) DTME21( 9:19) - ELSE IF ( DTME21(10:10) .NE. '0' ) THEN - WRITE (NDSO,2944) DTME21(10:19) - ELSE - WRITE (NDSO,3944) DTME21(12:19) - END IF - END IF - END IF + j=8 + if (odat(5*(j-1)+3) .ne. 0) then + if ( iaproc .eq. napout ) write (ndso,941) j, idotyp(j) + ttime(1) = odat(5*(j-1)+1) + ttime(2) = odat(5*(j-1)+2) + call stme21 ( ttime , dtme21 ) + if ( iaproc .eq. napout ) write (ndso,942) dtme21 + ttime(1) = odat(5*(j-1)+4) + ttime(2) = odat(5*(j-1)+5) + call stme21 ( ttime , dtme21 ) + if ( iaproc .eq. napout ) write (ndso,943) dtme21 + ttime(1) = 0 + ttime(2) = 0 + dttst = real ( odat(5*(j-1)+3) ) + call tick21 ( ttime , dttst ) + call stme21 ( ttime , dtme21 ) + if ( ( odat(5*(j-1)+1) .ne. odat(5*(j-1)+4) .or. & + odat(5*(j-1)+2) .ne. odat(5*(j-1)+5) ) .and. & + iaproc .eq. napout ) then + if ( dtme21(9:9) .ne. '0' ) then + write (ndso,1944) dtme21( 9:19) + else if ( dtme21(10:10) .ne. '0' ) then + write (ndso,2944) dtme21(10:19) + else + write (ndso,3944) dtme21(12:19) + end if + end if + end if ! 2.5 Output types - ! For outputs with non-zero time step, check dates : - ! If output ends before run start OR output starts after run end, - ! deactivate output cleanly with output time step = 0 - ! This is usefull for IOSTYP=3 (Multiple dedicated output processes) - ! to avoid the definition of dedicated proc. for unused output. + + if (w3_t_flag) then + write (ndst,9040) odat + write (ndst,9041) flgrd + write (ndst,9042) iprt, prtfrm + end if + if (.not. present(time0_overwrite) .and. .not. present(timen_overwrite)) then + ! + ! For outputs with non-zero time step, check dates : + ! If output ends before run start OR output starts after run end, + ! deactivate output cleanly with output time step = 0 + ! This is usefull for IOSTYP=3 (Multiple dedicated output processes) + ! to avoid the definition of dedicated proc. for unused output. + ! + do j = 1, notype + dttst = dsec21 ( time0 , odat(5*(j-1)+4:5*(j-1)+5) ) + if ( dttst .lt. 0 ) then + odat(5*(j-1)+3) = 0 + if ( iaproc .eq. napout ) write (ndso,8945) trim(idotyp(j)) + continue + end if + dttst = dsec21 ( odat(5*(j-1)+1:5*(j-1)+2), timen ) + if ( dttst .lt. 0 ) then + odat(5*(j-1)+3) = 0 + if ( iaproc .eq. napout ) write (ndso,8945) trim(idotyp(j)) + continue + end if + end do + end if + + ! checkpoint + j = 8 + dttst = dsec21 ( time0 , odat(5*(j-1)+4:5*(j-1)+5) ) + if ( dttst .lt. 0 ) then + odat(5*(j-1)+3) = 0 + if ( iaproc .eq. napout ) write (ndso,8945) trim(idotyp(j)) + continue + end if + dttst = dsec21 ( odat(5*(j-1)+1:5*(j-1)+2), timen ) + if ( dttst .lt. 0 ) then + odat(5*(j-1)+3) = 0 + if ( iaproc .eq. napout ) write (ndso,8945) trim(idotyp(j)) + continue + end if ! - DO J = 1, NOTYPE - DTTST = DSEC21 ( TIME0 , ODAT(5*(J-1)+4:5*(J-1)+5) ) - IF ( DTTST .LT. 0 ) THEN - ODAT(5*(J-1)+3) = 0 - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,8945) TRIM(IDOTYP(J)) - CONTINUE - END IF - DTTST = DSEC21 ( ODAT(5*(J-1)+1:5*(J-1)+2), TIMEN ) - IF ( DTTST .LT. 0 ) THEN - ODAT(5*(J-1)+3) = 0 - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,8945) TRIM(IDOTYP(J)) - CONTINUE - END IF - END DO - ! CHECKPOINT - J = 8 - DTTST = DSEC21 ( TIME0 , ODAT(5*(J-1)+4:5*(J-1)+5) ) - IF ( DTTST .LT. 0 ) THEN - ODAT(5*(J-1)+3) = 0 - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,8945) TRIM(IDOTYP(J)) - CONTINUE - END IF - DTTST = DSEC21 ( ODAT(5*(J-1)+1:5*(J-1)+2), TIMEN ) - IF ( DTTST .LT. 0 ) THEN - ODAT(5*(J-1)+3) = 0 - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,8945) TRIM(IDOTYP(J)) - CONTINUE - END IF + + call print_memcheck(740+IAPROC, 'memcheck_____:'//'read_shel_config SECTION 5') !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 5. Initializations - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,951) 'Wave model ...' - GOTO 2222 + if ( iaproc .eq. napout ) write (ndso,951) 'Wave model ...' + goto 2222 ! Error escape locations 2001 CONTINUE @@ -976,9 +1426,18 @@ subroutine read_shel_inp(mpi_comm) 2002 CONTINUE IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1002) IERR CALL EXTCDE ( 1002 ) +2102 CONTINUE + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1102) + CALL EXTCDE ( 1102 ) 2003 CONTINUE IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1003) CALL EXTCDE ( 1003 ) +2104 CONTINUE + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1104) IERR + CALL EXTCDE ( 1104 ) +2004 CONTINUE + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1004) IERR + CALL EXTCDE ( 1004 ) 2005 CONTINUE IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1005) IDTST CALL EXTCDE ( 1005 ) @@ -988,10 +1447,15 @@ subroutine read_shel_inp(mpi_comm) 2006 CONTINUE IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1006) IDTST, NH(J) CALL EXTCDE ( 1006 ) +2062 CONTINUE + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1062) IDTST + CALL EXTCDE ( 1062 ) 2007 CONTINUE IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1007) CALL EXTCDE ( 1007 ) - +2009 CONTINUE + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1009) ODAT(33), NINT(DTMAX) + CALL EXTCDE ( 1009 ) 2222 CONTINUE ! Formats @@ -999,25 +1463,30 @@ subroutine read_shel_inp(mpi_comm) 15X,'==============================================='/) 901 FORMAT ( ' Comment character is ''',A,''''/) 905 FORMAT ( ' Hybrid MPI/OMP thread support level:'/ & - ' Requested: ', I2/ & - ' Provided: ', I2/ ) + ' Requested: ', I2/ & + ' Provided: ', I2/ ) 920 FORMAT (/' Input fields : '/ & - ' --------------------------------------------------') + ' --------------------------------------------------') 921 FORMAT ( ' ',A,2X,A,2X,A) 922 FORMAT ( ' ' ) 930 FORMAT (/' Time interval : '/ & - ' --------------------------------------------------') + ' --------------------------------------------------') 931 FORMAT ( ' Starting time : ',A) 932 FORMAT ( ' Ending time : ',A/) 940 FORMAT (/' Output requests : '/ & - ' --------------------------------------------------'/ & - ' ',A) + ' --------------------------------------------------'/ & + ' ',A) 941 FORMAT (/' Type',I2,' : ',A/ & - ' -----------------------------------------') + ' -----------------------------------------') 942 FORMAT ( ' From : ',A) 943 FORMAT ( ' To : ',A) +954 FORMAT ( ' ',A,': file not needed') +955 FORMAT ( ' ',A,': file OK') +956 FORMAT ( ' ',A,': file OK, recl =',I3, & + ' undef = ',E10.3) 1944 FORMAT ( ' Interval : ', 8X,A11/) 2944 FORMAT ( ' Interval : ', 9X,A10/) +3944 FORMAT ( ' Interval : ',11X,A8/) 2945 FORMAT ( ' Point 1 : ',2F8.2,2X,A) 2955 FORMAT ( ' Point 1 : ',2(F8.1,'E3'),2X,A) 2946 FORMAT ( ' ',I6,' : ',2F8.2,2X,A) @@ -1025,33 +1494,59 @@ subroutine read_shel_inp(mpi_comm) 2947 FORMAT ( ' No points defined') 3945 FORMAT ( ' The file with ',A,' data is ',A,'.') 6945 FORMAT ( ' IX first,last,inc :',3I5/ & - ' IY first,last,inc :',3I5/ & - ' Formatted file : ',A) -3944 FORMAT ( ' Interval : ',11X,A8/) - + ' IY first,last,inc :',3I5/ & + ' Formatted file : ',A) 8945 FORMAT ( ' output dates out of run dates : ', A, & ' deactivated') +950 FORMAT (/' Initializations :'/ & + ' --------------------------------------------------') 951 FORMAT ( ' ',A) 952 FORMAT ( ' ',I6,2X,A) 953 FORMAT ( ' ',I6,I11.8,I7.6,3E12.4) 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : *** '/ & - ' PREMATURE END OF INPUT FILE'/) + ' PREMATURE END OF INPUT FILE'/) 1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : *** '/ & - ' ERROR IN READING FROM INPUT FILE'/ & - ' IOSTAT =',I5/) + ' ERROR IN READING FROM INPUT FILE'/ & + ' IOSTAT =',I5/) +1102 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : *** '/ & + ' LEVEL AND CURRENT ARE MIXING COUPLED AND FORCED'/& + ' IT MUST BE FULLY COUPLED OR DISABLED '/) 1003 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : *** '/ & - ' ILLEGAL TIME INTERVAL'/) + ' ILLEGAL TIME INTERVAL'/) +1104 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : *** '/ & + ' ERROR IN OPENING POINT FILE'/ & + ' IOSTAT =',I5/) +1004 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : *** '/ & + ' ERROR IN READING FROM POINT FILE'/ & + ' IOSTAT =',I5/) 1005 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : *** '/ & - ' ILLEGAL ID STRING HOMOGENEOUS FIELD : ',A/) + ' ILLEGAL ID STRING HOMOGENEOUS FIELD : ',A/) 1006 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : *** '/ & - ' TOO MANY HOMOGENEOUS FIELDS : ',A,1X,I4/) + ' TOO MANY HOMOGENEOUS FIELDS : ',A,1X,I4/) +1062 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : ***'/ & + ' HOMOGENEOUS NAME NOT RECOGNIZED : ', A/) 1007 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : *** '/ & - ' INSUFFICIENT DATA FOR HOMOGENEOUS FIELDS'/) + ' INSUFFICIENT DATA FOR HOMOGENEOUS FIELDS'/) 1008 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : *** '/ & - ' ERROR IN OPENING OUTPUT FILE'/ & - ' IOSTAT =',I5/) + ' ERROR IN OPENING OUTPUT FILE'/ & + ' IOSTAT =',I5/) +1009 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : *** '/ & + ' COUPLING TIME STEP NOT MULTIPLE OF'/ & + ' MODEL TIME STEP: ',I6, I6/) +1010 FORMAT (/' *** WAVEWATCH III WARNING IN W3SHEL : *** '/ & + ' COUPLING TIME STEP NOT DEFINED, '/ & + ' IT WILL BE OVERRIDEN TO DEFAULT VALUE'/ & + ' FROM ',I6, ' TO ',I6/) 1054 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : *** '/ & - ' POINT OUTPUT ACTIVATED BUT NO POINTS DEFINED'/) - end subroutine read_shel_inp + ' POINT OUTPUT ACTIVATED BUT NO POINTS DEFINED'/) +9000 FORMAT ( ' TEST W3SHEL : UNIT NUMBERS :',12I4) +9001 FORMAT ( ' TEST W3SHEL : SUBR. TRACING :',2I4) +9020 FORMAT ( ' TEST W3SHEL : FLAGS DEF / HOM : ',9L2,2X,9L2) +9040 FORMAT ( ' TEST W3SHEL : ODAT : ',I9.8,I7.6,I7,I9.8,I7.6, & + 4(/24X,I9.8,I7.6,I7,I9.8,I7.6) ) +9041 FORMAT ( ' TEST W3SHEL : FLGRD : ',20L2) +9042 FORMAT ( ' TEST W3SHEL : IPR, PRFRM : ',6I6,1X,L1) + + end subroutine read_shel_config end module wav_shel_inp diff --git a/model/src/wav_shr_flags.F90 b/model/src/wav_shr_flags.F90 new file mode 100644 index 0000000000..704c16893e --- /dev/null +++ b/model/src/wav_shr_flags.F90 @@ -0,0 +1,1201 @@ +!> @file wav_shr_flags +!! +!> Shared flags matching compile time options +!! +!> @details Sets logical flags to according to compile time +!! options +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 07-01-2022 +module wav_shr_flags + + implicit none + public + +#ifdef W3_DIST + logical, parameter :: w3_dist_flag = .true. !< @public a flag for "W3_DIST" +#else + logical, parameter :: w3_dist_flag = .false. !< @public a flag for "W3_DIST" +#endif +#ifdef W3_SHRD + logical, parameter :: w3_shrd_flag = .true. !< @public a flag for "W3_SHRD" +#else + logical, parameter :: w3_shrd_flag = .false. !< @public a flag for "W3_SHRD" +#endif + ! debug/logging +#ifdef W3_DEBUG + logical, parameter :: w3_debug_flag = .true. !< @public a flag for "W3_DEBUG" +#else + logical, parameter :: w3_debug_flag = .false. !< @public a flag for "W3_DEBUG" +#endif +#ifdef W3_DEBUGGRID + logical, parameter :: w3_debuggrid_flag = .true. !< @public a flag for "W3_DEBUGGRID" +#else + logical, parameter :: w3_debuggrid_flag = .false. !< @public a flag for "W3_DEBUGGRID" +#endif + +#ifdef W3_DEBUGSTP + logical, parameter :: w3_debugstp_flag = .true. !< @public a flag for "W3_DEBUGSTP" +#else + logical, parameter :: w3_debugstp_flag = .false. !< @public a flag for "W3_DEBUGSTP" +#endif + +#ifdef W3_DEBUGFLS + logical, parameter :: w3_debugfls_flag = .true. !< @public a flag for "W3_DEBUGFLS" +#else + logical, parameter :: w3_debugfls_flag = .false. !< @public a flag for "W3_DEBUGFLS" +#endif + +#ifdef W3_DEBUGCOH + logical, parameter :: w3_debugcoh_flag = .true. !< @public a flag for "W3_DEBUGCOH" +#else + logical, parameter :: w3_debugcoh_flag = .false. !< @public a flag for "W3_DEBUGCOH" +#endif + +#ifdef W3_DEBUGIOBP + logical, parameter :: w3_debugiobp_flag = .true. !< @public a flag for "W3_DEBUGIOBP" +#else + logical, parameter :: w3_debugiobp_flag = .false. !< @public a flag for "W3_DEBUGIOBP" +#endif + +#ifdef W3_DEBUGIOGR + logical, parameter :: w3_debugiogr_flag = .true. !< @public a flag for "W3_DEBUGIOGR" +#else + logical, parameter :: w3_debugiogr_flag = .false. !< @public a flag for "W3_DEBUGIOGR" +#endif + +#ifdef W3_DEBUGIOBC + logical, parameter :: w3_debugiobc_flag = .true. !< @public a flag for "W3_DEBUGIOBC" +#else + logical, parameter :: w3_debugiobc_flag = .false. !< @public a flag for "W3_DEBUGIOBC" +#endif +#ifdef W3_DEBUGDCXDX + logical, parameter :: w3_debugdcxdx_flag = .true. !< @public a flag for "W3_DEBUGDCXDX" +#else + logical, parameter :: w3_debugdcxdx_flag = .false. !< @public a flag for "W3_DEBUGDCXDX" +#endif + +#ifdef W3_DEBUSETIOBP + logical, parameter :: w3_debugsetiobp_flag = .true. !< @public a flag for "W3_DEBUSETIOBP" +#else + logical, parameter :: w3_debugsetiobp_flag = .false. !< @public a flag for "W3_DEBUSETIOBP" +#endif + +#ifdef W3_DEBUSETUGIOBP + logical, parameter :: w3_debugsetugiobp_flag = .true. !< @public a flag for "W3_DEBUSETUGIOBP" +#else + logical, parameter :: w3_debugsetugiobp_flag = .false. !< @public a flag for "W3_DEBUSETUGIOBP" +#endif + +#ifdef W3_DEBUGSRC + logical, parameter :: w3_debugsrc_flag = .true. !< @public a flag for "W3_DEBUGSRC" +#else + logical, parameter :: w3_debugsrc_flag = .false. !< @public a flag for "W3_DEBUGSRC" +#endif + +#ifdef W3_DEBUGINIT + logical, parameter :: w3_debuginit_flag = .true. !< @public a flag for "W3_DEBUGINIT" +#else + logical, parameter :: w3_debuginit_flag = .false. !< @public a flag for "W3_DEBUGINIT" +#endif + +#ifdef W3_DEBUGRUN + logical, parameter :: w3_debugrun_flag = .true. !< @public a flag for "W3_DEBUGRUN" +#else + logical, parameter :: w3_debugrun_flag = .false. !< @public a flag for "W3_DEBUGRUN" +#endif + +#ifdef W3_DEBUGIO + logical, parameter :: w3_debugio_flag = .true. !< @public a flag for "W3_DEBUGIO" +#else + logical, parameter :: w3_debugio_flag = .false. !< @public a flag for "W3_DEBUGIO" +#endif +#ifdef W3_DEBUGW3ULEV + logical, parameter :: w3_debugw3ulev_flag = .true. !< @public a flag for "W3_DEBUGW3ULEV" +#else + logical, parameter :: w3_debugw3ulev_flag = .false. !< @public a flag for "W3_DEBUGW3ULEV" +#endif + +#ifdef W3_TIMINGS + logical, parameter :: w3_timings_flag = .true. !< @public a flag for "W3_TIMINGS" +#else + logical, parameter :: w3_timings_flag = .false. !< @public a flag for "W3_TIMINGS" +#endif +#ifdef W3_TS + logical, parameter :: w3_ts_flag = .true. !< @public a flag for "W3_TS" +#else + logical, parameter :: w3_ts_flag = .false. !< @public a flag for "W3_TS" +#endif + + ! propagation/gse + +#ifdef W3_PR0 + logical, parameter :: w3_pr0_flag = .true. !< @public a flag for "W3_PR0" +#else + logical, parameter :: w3_pr0_flag = .false. !< @public a flag for "W3_PR0" +#endif + +#ifdef W3_PR1 + logical, parameter :: w3_pr1_flag = .true. !< @public a flag for "W3_PR1" +#else + logical, parameter :: w3_pr1_flag = .false. !< @public a flag for "W3_PR1" +#endif + +#ifdef W3_PR2 + logical, parameter :: w3_pr2_flag = .true. !< @public a flag for "W3_PR2" +#else + logical, parameter :: w3_pr2_flag = .false. !< @public a flag for "W3_PR2" +#endif + +#ifdef W3_PR3 + logical, parameter :: w3_pr3_flag = .true. !< @public a flag for "W3_PR3" +#else + logical, parameter :: w3_pr3_flag = .false. !< @public a flag for "W3_PR3" +#endif + +#ifdef W3_UNO + logical, parameter :: w3_uno_flag = .true. !< @public a flag for "W3_UNO" +#else + logical, parameter :: w3_uno_flag = .false. !< @public a flag for "W3_UNO" +#endif + +#ifdef W3_UQ + logical, parameter :: w3_uq_flag = .true. !< @public a flag for "W3_UQ" +#else + logical, parameter :: w3_uq_flag = .false. !< @public a flag for "W3_UQ" +#endif + + ! flux scheme + +#ifdef W3_FLX0 + logical, parameter :: w3_flx0_flag = .true. !< @public a flag for "W3_FLX0" +#else + logical, parameter :: w3_flx0_flag = .false. !< @public a flag for "W3_FLX0" +#endif + +#ifdef W3_FLX1 + logical, parameter :: w3_flx1_flag = .true. !< @public a flag for "W3_FLX1" +#else + logical, parameter :: w3_flx1_flag = .false. !< @public a flag for "W3_FLX1" +#endif + +#ifdef W3_FLX2 + logical, parameter :: w3_flx2_flag = .true. !< @public a flag for "W3_FLX2" +#else + logical, parameter :: w3_flx2_flag = .false. !< @public a flag for "W3_FLX2" +#endif + +#ifdef W3_FLX3 + logical, parameter :: w3_flx3_flag = .true. !< @public a flag for "W3_FLX3" +#else + logical, parameter :: w3_flx3_flag = .false. !< @public a flag for "W3_FLX3" +#endif + +#ifdef W3_FLX4 + logical, parameter :: w3_flx4_flag = .true. !< @public a flag for "W3_FLX4" +#else + logical, parameter :: w3_flx4_flag = .false. !< @public a flag for "W3_FLX4" +#endif + +#ifdef W3_FLX5 + logical, parameter :: w3_flx5_flag = .true. !< @public a flag for "W3_FLX5" +#else + logical, parameter :: w3_flx5_flag = .false. !< @public a flag for "W3_FLX5" +#endif + + ! linear input + +#ifdef W3_LN0 + logical, parameter :: w3_ln0_flag = .true. !< @public a flag for "W3_LN0" +#else + logical, parameter :: w3_ln0_flag = .false. !< @public a flag for "W3_LN0" +#endif + +#ifdef W3_SEED + logical, parameter :: w3_seed_flag = .true. !< @public a flag for "W3_SEED" +#else + logical, parameter :: w3_seed_flag = .false. !< @public a flag for "W3_SEED" +#endif + +#ifdef W3_LN1 + logical, parameter :: w3_ln1_flag = .true. !< @public a flag for "W3_LN1" +#else + logical, parameter :: w3_ln1_flag = .false. !< @public a flag for "W3_LN1" +#endif + + ! input/dissipation + +#ifdef W3_ST0 + logical, parameter :: w3_st0_flag = .true. !< @public a flag for "W3_ST0" +#else + logical, parameter :: w3_st0_flag = .false. !< @public a flag for "W3_ST0" +#endif + +#ifdef W3_ST1 + logical, parameter :: w3_st1_flag = .true. !< @public a flag for "W3_ST1" +#else + logical, parameter :: w3_st1_flag = .false. !< @public a flag for "W3_ST1" +#endif + +#ifdef W3_ST2 + logical, parameter :: w3_st2_flag = .true. !< @public a flag for "W3_ST2" +#else + logical, parameter :: w3_st2_flag = .false. !< @public a flag for "W3_ST2" +#endif + +#ifdef W3_STAB0 + logical, parameter :: w3_stab0_flag = .true. !< @public a flag for "W3_STAB0" +#else + logical, parameter :: w3_stab0_flag = .false. !< @public a flag for "W3_STAB0" +#endif + +#ifdef W3_STAB2 + logical, parameter :: w3_stab2_flag = .true. !< @public a flag for "W3_STAB2" +#else + logical, parameter :: w3_stab2_flag = .false. !< @public a flag for "W3_STAB2" +#endif + +#ifdef W3_ST3 + logical, parameter :: w3_st3_flag = .true. !< @public a flag for "W3_ST3" +#else + logical, parameter :: w3_st3_flag = .false. !< @public a flag for "W3_ST3" +#endif + +#ifdef W3_STAB3 + logical, parameter :: w3_stab3_flag = .true. !< @public a flag for "W3_STAB3" +#else + logical, parameter :: w3_stab3_flag = .false. !< @public a flag for "W3_STAB3" +#endif + +#ifdef W3_ST4 + logical, parameter :: w3_st4_flag = .true. !< @public a flag for "W3_ST4" +#else + logical, parameter :: w3_st4_flag = .false. !< @public a flag for "W3_ST4" +#endif + +#ifdef W3_ST6 + logical, parameter :: w3_st6_flag = .true. !< @public a flag for "W3_ST6" +#else + logical, parameter :: w3_st6_flag = .false. !< @public a flag for "W3_ST6" +#endif + + ! non-linear interaction + +#ifdef W3_NL0 + logical, parameter :: w3_nl0_flag = .true. !< @public a flag for "W3_NL0" +#else + logical, parameter :: w3_nl0_flag = .false. !< @public a flag for "W3_NL0" +#endif + +#ifdef W3_NL1 + logical, parameter :: w3_nl1_flag = .true. !< @public a flag for "W3_NL1" +#else + logical, parameter :: w3_nl1_flag = .false. !< @public a flag for "W3_NL1" +#endif + +#ifdef W3_NL2 + logical, parameter :: w3_nl2_flag = .true. !< @public a flag for "W3_NL2" +#else + logical, parameter :: w3_nl2_flag = .false. !< @public a flag for "W3_NL2" +#endif + +#ifdef W3_NL3 + logical, parameter :: w3_nl3_flag = .true. !< @public a flag for "W3_NL3" +#else + logical, parameter :: w3_nl3_flag = .false. !< @public a flag for "W3_NL3" +#endif + +#ifdef W3_NL4 + logical, parameter :: w3_nl4_flag = .true. !< @public a flag for "W3_NL4" +#else + logical, parameter :: w3_nl4_flag = .false. !< @public a flag for "W3_NL4" +#endif + +#ifdef W3_NL5 + logical, parameter :: w3_nl5_flag = .true. !< @public a flag for "W3_NL5" +#else + logical, parameter :: w3_nl5_flag = .false. !< @public a flag for "W3_NL5" +#endif + + ! bottom friction + +#ifdef W3_BT0 + logical, parameter :: w3_bt0_flag = .true. !< @public a flag for "W3_BT0" +#else + logical, parameter :: w3_bt0_flag = .false. !< @public a flag for "W3_BT0" +#endif + +#ifdef W3_BT1 + logical, parameter :: w3_bt1_flag = .true. !< @public a flag for "W3_BT1" +#else + logical, parameter :: w3_bt1_flag = .false. !< @public a flag for "W3_BT1" +#endif + +#ifdef W3_B24 + logical, parameter :: w3_b24_flag = .true. !< @public a flag for "W3_B24" +#else + logical, parameter :: w3_b24_flag = .false. !< @public a flag for "W3_B24" +#endif + +#ifdef W3_BT8 + logical, parameter :: w3_bt8_flag = .true. !< @public a flag for "W3_BT8" +#else + logical, parameter :: w3_bt8_flag = .false. !< @public a flag for "W3_BT8" +#endif + +#ifdef W3_BT9 + logical, parameter :: w3_bt9_flag = .true. !< @public a flag for "W3_BT9" +#else + logical, parameter :: w3_bt9_flag = .false. !< @public a flag for "W3_BT9" +#endif + + ! damping by sea ice + +#ifdef W3_IC0 + logical, parameter :: w3_ic0_flag = .true. !< @public a flag for "W3_IC0" +#else + logical, parameter :: w3_ic0_flag = .false. !< @public a flag for "W3_IC0" +#endif + +#ifdef W3_IC1 + logical, parameter :: w3_ic1_flag = .true. !< @public a flag for "W3_IC1" +#else + logical, parameter :: w3_ic1_flag = .false. !< @public a flag for "W3_IC1" +#endif + +#ifdef W3_IC2 + logical, parameter :: w3_ic2_flag = .true. !< @public a flag for "W3_IC2" +#else + logical, parameter :: w3_ic2_flag = .false. !< @public a flag for "W3_IC2" +#endif + +#ifdef W3_IC3 + logical, parameter :: w3_ic3_flag = .true. !< @public a flag for "W3_IC3" +#else + logical, parameter :: w3_ic3_flag = .false. !< @public a flag for "W3_IC3" +#endif + +#ifdef W3_IC4 + logical, parameter :: w3_ic4_flag = .true. !< @public a flag for "W3_IC4" +#else + logical, parameter :: w3_ic4_flag = .false. !< @public a flag for "W3_IC4" +#endif + +#ifdef W3_IC5 + logical, parameter :: w3_ic5_flag = .true. !< @public a flag for "W3_IC5" +#else + logical, parameter :: w3_ic5_flag = .false. !< @public a flag for "W3_IC5" +#endif + + ! scattering by seaice + +#ifdef W3_IS0 + logical, parameter :: w3_is0_flag = .true. !< @public a flag for "W3_IS0" +#else + logical, parameter :: w3_is0_flag = .false. !< @public a flag for "W3_IS0" +#endif + +#ifdef W3_IS1 + logical, parameter :: w3_is1_flag = .true. !< @public a flag for "W3_IS1" +#else + logical, parameter :: w3_is1_flag = .false. !< @public a flag for "W3_IS1" +#endif + +#ifdef W3_IS2 + logical, parameter :: w3_is2_flag = .true. !< @public a flag for "W3_IS2" +#else + logical, parameter :: w3_is2_flag = .false. !< @public a flag for "W3_IS2" +#endif + + ! reflection + +#ifdef W3_REF0 + logical, parameter :: w3_ref0_flag = .true. !< @public a flag for "W3_REF0" +#else + logical, parameter :: w3_ref0_flag = .false. !< @public a flag for "W3_REF0" +#endif + +#ifdef W3_REF1 + logical, parameter :: w3_ref1_flag = .true. !< @public a flag for "W3_REF1" +#else + logical, parameter :: w3_ref1_flag = .false. !< @public a flag for "W3_REF1" +#endif + + ! depth induced breaking + +#ifdef W3_DB0 + logical, parameter :: w3_db0_flag = .true. !< @public a flag for "W3_DB0" +#else + logical, parameter :: w3_db0_flag = .false. !< @public a flag for "W3_DB0" +#endif + +#ifdef W3_DB1 + logical, parameter :: w3_db1_flag = .true. !< @public a flag for "W3_DB1" +#else + logical, parameter :: w3_db1_flag = .false. !< @public a flag for "W3_DB1" +#endif + + ! tidal interaction + +#ifdef W3_TR0 + logical, parameter :: w3_tr0_flag = .true. !< @public a flag for "W3_TR0" +#else + logical, parameter :: w3_tr0_flag = .false. !< @public a flag for "W3_TR0" +#endif + +#ifdef W3_TR1 + logical, parameter :: w3_tr1_flag = .true. !< @public a flag for "W3_TR1" +#else + logical, parameter :: w3_tr1_flag = .false. !< @public a flag for "W3_TR1" +#endif + + ! bottom scattering + +#ifdef W3_BS0 + logical, parameter :: w3_bs0_flag = .true. !< @public a flag for "W3_BS0" +#else + logical, parameter :: w3_bs0_flag = .false. !< @public a flag for "W3_BS0" +#endif + +#ifdef W3_BS1 + logical, parameter :: w3_bs1_flag = .true. !< @public a flag for "W3_BS1" +#else + logical, parameter :: w3_bs1_flag = .false. !< @public a flag for "W3_BS1" +#endif + + ! wind interpolation in time + +#ifdef W3_WNT0 + logical, parameter :: w3_wnt0_flag = .true. !< @public a flag for "W3_WNT0" +#else + logical, parameter :: w3_wnt0_flag = .false. !< @public a flag for "W3_WNT0" +#endif + +#ifdef W3_WNT1 + logical, parameter :: w3_wnt1_flag = .true. !< @public a flag for "W3_WNT1" +#else + logical, parameter :: w3_wnt1_flag = .false. !< @public a flag for "W3_WNT1" +#endif + +#ifdef W3_WNT2 + logical, parameter :: w3_wnt2_flag = .true. !< @public a flag for "W3_WNT2" +#else + logical, parameter :: w3_wnt2_flag = .false. !< @public a flag for "W3_WNT2" +#endif + + ! wind interpolation in space + +#ifdef W3_WNX0 + logical, parameter :: w3_wnx0_flag = .true. !< @public a flag for "W3_WNX0" +#else + logical, parameter :: w3_wnx0_flag = .false. !< @public a flag for "W3_WNX0" +#endif + +#ifdef W3_WNX1 + logical, parameter :: w3_wnx1_flag = .true. !< @public a flag for "W3_WNX1" +#else + logical, parameter :: w3_wnx1_flag = .false. !< @public a flag for "W3_WNX1" +#endif + +#ifdef W3_WNX2 + logical, parameter :: w3_wnx2_flag = .true. !< @public a flag for "W3_WNX2" +#else + logical, parameter :: w3_wnx2_flag = .false. !< @public a flag for "W3_WNX2" +#endif + + ! current interpolation in time + +#ifdef W3_CRT0 + logical, parameter :: w3_crt0_flag = .true. !< @public a flag for "W3_CRT0" +#else + logical, parameter :: w3_crt0_flag = .false. !< @public a flag for "W3_CRT0" +#endif + +#ifdef W3_CRT1 + logical, parameter :: w3_crt1_flag = .true. !< @public a flag for "W3_CRT1" +#else + logical, parameter :: w3_crt1_flag = .false. !< @public a flag for "W3_CRT1" +#endif + +#ifdef W3_CRT2 + logical, parameter :: w3_crt2_flag = .true. !< @public a flag for "W3_CRT2" +#else + logical, parameter :: w3_crt2_flag = .false. !< @public a flag for "W3_CRT2" +#endif + + ! current interpolation in space + +#ifdef W3_CRX0 + logical, parameter :: w3_crx0_flag = .true. !< @public a flag for "W3_CRX0" +#else + logical, parameter :: w3_crx0_flag = .false. !< @public a flag for "W3_CRX0" +#endif + +#ifdef W3_CRX1 + logical, parameter :: w3_crx1_flag = .true. !< @public a flag for "W3_CRX1" +#else + logical, parameter :: w3_crx1_flag = .false. !< @public a flag for "W3_CRX1" +#endif + +#ifdef W3_CRX2 + logical, parameter :: w3_crx2_flag = .true. !< @public a flag for "W3_CRX2" +#else + logical, parameter :: w3_crx2_flag = .false. !< @public a flag for "W3_CRX2" +#endif + + ! grib + +#ifdef W3_NOGRB + logical, parameter :: w3_nogrb_flag = .true. !< @public a flag for "W3_NOGRB" +#else + logical, parameter :: w3_nogrb_flag = .false. !< @public a flag for "W3_NOGRB" +#endif + +#ifdef W3_NCEP1 + logical, parameter :: w3_ncep1_flag = .true. !< @public a flag for "W3_NCEP1" +#else + logical, parameter :: w3_ncep1_flag = .false. !< @public a flag for "W3_NCEP1" +#endif + +#ifdef W3_NCEP2 + logical, parameter :: w3_ncep2_flag = .true. !< @public a flag for "W3_NCEP2" +#else + logical, parameter :: w3_ncep2_flag = .false. !< @public a flag for "W3_NCEP2" +#endif + + ! optional output + +#ifdef W3_O0 + logical, parameter :: w3_o0_flag = .true. !< @public a flag for "W3_O0" +#else + logical, parameter :: w3_o0_flag = .false. !< @public a flag for "W3_O0" +#endif + +#ifdef W3_O1 + logical, parameter :: w3_o1_flag = .true. !< @public a flag for "W3_O1" +#else + logical, parameter :: w3_o1_flag = .false. !< @public a flag for "W3_O1" +#endif + +#ifdef W3_O2 + logical, parameter :: w3_o2_flag = .true. !< @public a flag for "W3_O2" +#else + logical, parameter :: w3_o2_flag = .false. !< @public a flag for "W3_O2" +#endif + +#ifdef W3_O3 + logical, parameter :: w3_o3_flag = .true. !< @public a flag for "W3_O3" +#else + logical, parameter :: w3_o3_flag = .false. !< @public a flag for "W3_O3" +#endif + +#ifdef W3_O4 + logical, parameter :: w3_o4_flag = .true. !< @public a flag for "W3_O4" +#else + logical, parameter :: w3_o4_flag = .false. !< @public a flag for "W3_O4" +#endif + +#ifdef W3_O5 + logical, parameter :: w3_o5_flag = .true. !< @public a flag for "W3_O5" +#else + logical, parameter :: w3_o5_flag = .false. !< @public a flag for "W3_O5" +#endif + +#ifdef W3_O6 + logical, parameter :: w3_o6_flag = .true. !< @public a flag for "W3_O6" +#else + logical, parameter :: w3_o6_flag = .false. !< @public a flag for "W3_O6" +#endif + +#ifdef W3_O7 + logical, parameter :: w3_o7_flag = .true. !< @public a flag for "W3_O7" +#else + logical, parameter :: w3_o7_flag = .false. !< @public a flag for "W3_O7" +#endif + +#ifdef W3_O8 + logical, parameter :: w3_o8_flag = .true. !< @public a flag for "W3_O8" +#else + logical, parameter :: w3_o8_flag = .false. !< @public a flag for "W3_O8" +#endif + +#ifdef W3_O9 + logical, parameter :: w3_o9_flag = .true. !< @public a flag for "W3_O9" +#else + logical, parameter :: w3_o9_flag = .false. !< @public a flag for "W3_O9" +#endif + +#ifdef W3_O10 + logical, parameter :: w3_o10_flag = .true. !< @public a flag for "W3_O10" +#else + logical, parameter :: w3_o10_flag = .false. !< @public a flag for "W3_O10" +#endif + +#ifdef W3_O11 + logical, parameter :: w3_o11_flag = .true. !< @public a flag for "W3_O11" +#else + logical, parameter :: w3_o11_flag = .false. !< @public a flag for "W3_O11" +#endif + +#ifdef W3_O12 + logical, parameter :: w3_o12_flag = .true. !< @public a flag for "W3_O12" +#else + logical, parameter :: w3_o12_flag = .false. !< @public a flag for "W3_O12" +#endif + +#ifdef W3_O13 + logical, parameter :: w3_o13_flag = .true. !< @public a flag for "W3_O13" +#else + logical, parameter :: w3_o13_flag = .false. !< @public a flag for "W3_O13" +#endif + +#ifdef W3_O14 + logical, parameter :: w3_o14_flag = .true. !< @public a flag for "W3_O14" +#else + logical, parameter :: w3_o14_flag = .false. !< @public a flag for "W3_O14" +#endif + +#ifdef W3_O15 + logical, parameter :: w3_o15_flag = .true. !< @public a flag for "W3_O15" +#else + logical, parameter :: w3_o15_flag = .false. !< @public a flag for "W3_O15" +#endif + +#ifdef W3_O16 + logical, parameter :: w3_o16_flag = .true. !< @public a flag for "W3_O16" +#else + logical, parameter :: w3_o16_flag = .false. !< @public a flag for "W3_O16" +#endif + + ! threading + +#ifdef W3_OMPG + logical, parameter :: w3_ompg_flag = .true. !< @public a flag for "W3_OMPG" +#else + logical, parameter :: w3_ompg_flag = .false. !< @public a flag for "W3_OMPG" +#endif + +#ifdef W3_OMPH + logical, parameter :: w3_omph_flag = .true. !< @public a flag for "W3_OMPH" +#else + logical, parameter :: w3_omph_flag = .false. !< @public a flag for "W3_OMPH" +#endif + +#ifdef W3_PDLIB + logical, parameter :: w3_pdlib_flag = .true. !< @public a flag for "W3_PDLIB" +#else + logical, parameter :: w3_pdlib_flag = .false. !< @public a flag for "W3_PDLIB" +#endif + +#ifdef W3_B4B + logical, parameter :: w3_b4b_flag = .true. !< @public a flag for "W3_B4B" +#else + logical, parameter :: w3_b4b_flag = .false. !< @public a flag for "W3_B4B" +#endif + + ! moving grids + +#ifdef W3_MGP + logical, parameter :: w3_mgp_flag = .true. !< @public a flag for "W3_MGP" +#else + logical, parameter :: w3_mgp_flag = .false. !< @public a flag for "W3_MGP" +#endif + +#ifdef W3_MGW + logical, parameter :: w3_mgw_flag = .true. !< @public a flag for "W3_MGW" +#else + logical, parameter :: w3_mgw_flag = .false. !< @public a flag for "W3_MGW" +#endif + +#ifdef W3_MGG + logical, parameter :: w3_mgg_flag = .true. !< @public a flag for "W3_MGG" +#else + logical, parameter :: w3_mgg_flag = .false. !< @public a flag for "W3_MGG" +#endif + + ! misc + +#ifdef W3_COU + logical, parameter :: w3_cou_flag = .true. !< @public a flag for "W3_COU" +#else + logical, parameter :: w3_cou_flag = .false. !< @public a flag for "W3_COU" +#endif + +#ifdef W3_DSS0 + logical, parameter :: w3_dss0_flag = .true. !< @public a flag for "W3_DSS0" +#else + logical, parameter :: w3_dss0_flag = .false. !< @public a flag for "W3_DSS0" +#endif + +#ifdef W3_FLD1 + logical, parameter :: w3_fld1_flag = .true. !< @public a flag for "W3_FLD1" +#else + logical, parameter :: w3_fld1_flag = .false. !< @public a flag for "W3_FLD1" +#endif + +#ifdef W3_FLD2 + logical, parameter :: w3_fld2_flag = .true. !< @public a flag for "W3_FLD2" +#else + logical, parameter :: w3_fld2_flag = .false. !< @public a flag for "W3_FLD2" +#endif + +#ifdef W3_IG1 + logical, parameter :: w3_ig1_flag = .true. !< @public a flag for "W3_IG1" +#else + logical, parameter :: w3_ig1_flag = .false. !< @public a flag for "W3_IG1" +#endif + +#ifdef W3_MLIM + logical, parameter :: w3_mlim_flag = .true. !< @public a flag for "W3_MLIM" +#else + logical, parameter :: w3_mlim_flag = .false. !< @public a flag for "W3_MLIM" +#endif + +#ifdef W3_MPI + logical, parameter :: w3_mpi_flag = .true. !< @public a flag for "W3_MPI" +#else + logical, parameter :: w3_mpi_flag = .false. !< @public a flag for "W3_MPI" +#endif + +#ifdef W3_MPIBDI + logical, parameter :: w3_mpibdi_flag = .true. !< @public a flag for "W3_MPIBDI" +#else + logical, parameter :: w3_mpibdi_flag = .false. !< @public a flag for "W3_MPIBDI" +#endif + +#ifdef W3_MPIT + logical, parameter :: w3_mpit_flag = .true. !< @public a flag for "W3_MPIT" +#else + logical, parameter :: w3_mpit_flag = .false. !< @public a flag for "W3_MPIT" +#endif + +#ifdef W3_MPRF + logical, parameter :: w3_mprf_flag = .true. !< @public a flag for "W3_MPRF" +#else + logical, parameter :: w3_mprf_flag = .false. !< @public a flag for "W3_MPRF" +#endif + +#ifdef W3_NCO + logical, parameter :: w3_nco_flag = .true. !< @public a flag for "W3_NCO" +#else + logical, parameter :: w3_nco_flag = .false. !< @public a flag for "W3_NCO" +#endif + +#ifdef W3_NLS + logical, parameter :: w3_nls_flag = .true. !< @public a flag for "W3_NLS" +#else + logical, parameter :: w3_nls_flag = .false. !< @public a flag for "W3_NLS" +#endif + +#ifdef W3_NNT + logical, parameter :: w3_nnt_flag = .true. !< @public a flag for "W3_NNT" +#else + logical, parameter :: w3_nnt_flag = .false. !< @public a flag for "W3_NNT" +#endif + +#ifdef W3_OASIS + logical, parameter :: w3_oasis_flag = .true. !< @public a flag for "W3_OASIS" +#else + logical, parameter :: w3_oasis_flag = .false. !< @public a flag for "W3_OASIS" +#endif + +#ifdef W3_OASACM + logical, parameter :: w3_oasacm_flag = .true. !< @public a flag for "W3_OASACM" +#else + logical, parameter :: w3_oasacm_flag = .false. !< @public a flag for "W3_OASACM" +#endif + +#ifdef W3_OASOCM + logical, parameter :: w3_oasocm_flag = .true. !< @public a flag for "W3_OASOCM" +#else + logical, parameter :: w3_oasocm_flag = .false. !< @public a flag for "W3_OASOCM" +#endif + +#ifdef W3_OASICM + logical, parameter :: w3_oasicm_flag = .true. !< @public a flag for "W3_OASICM" +#else + logical, parameter :: w3_oasicm_flag = .false. !< @public a flag for "W3_OASICM" +#endif + +#ifdef W3_REFRX + logical, parameter :: w3_refrx_flag = .true. !< @public a flag for "W3_REFRX" +#else + logical, parameter :: w3_refrx_flag = .false. !< @public a flag for "W3_REFRX" +#endif + +#ifdef W3_REFT + logical, parameter :: w3_reft_flag = .true. !< @public a flag for "W3_REFT" +#else + logical, parameter :: w3_reft_flag = .false. !< @public a flag for "W3_REFT" +#endif + +#ifdef W3_RTD + logical, parameter :: w3_rtd_flag = .true. !< @public a flag for "W3_RTD" +#else + logical, parameter :: w3_rtd_flag = .false. !< @public a flag for "W3_RTD" +#endif + +#ifdef W3_RWND + logical, parameter :: w3_rwnd_flag = .true. !< @public a flag for "W3_RWND" +#else + logical, parameter :: w3_rwnd_flag = .false. !< @public a flag for "W3_RWND" +#endif + +#ifdef W3_S + logical, parameter :: w3_s_flag = .true. !< @public a flag for "W3_S" +#else + logical, parameter :: w3_s_flag = .false. !< @public a flag for "W3_S" +#endif + +#ifdef W3_SCRIP + logical, parameter :: w3_scrip_flag = .true. !< @public a flag for "W3_SCRIP" +#else + logical, parameter :: w3_scrip_flag = .false. !< @public a flag for "W3_SCRIP" +#endif + +#ifdef W3_SCRIPNC + logical, parameter :: w3_scripnc_flag = .true. !< @public a flag for "W3_SCRIPNC" +#else + logical, parameter :: w3_scripnc_flag = .false. !< @public a flag for "W3_SCRIPNC" +#endif + +#ifdef W3_SEC1 + logical, parameter :: w3_sec1_flag = .true. !< @public a flag for "W3_SEC1" +#else + logical, parameter :: w3_sec1_flag = .false. !< @public a flag for "W3_SEC1" +#endif + +#ifdef W3_SMC + logical, parameter :: w3_smc_flag = .true. !< @public a flag for "W3_SMC" +#else + logical, parameter :: w3_smc_flag = .false. !< @public a flag for "W3_SMC" +#endif + +#ifdef W3_T + logical, parameter :: w3_t_flag = .true. !< @public a flag for "W3_T" +#else + logical, parameter :: w3_t_flag = .false. !< @public a flag for "W3_T" +#endif +#ifdef W3_T0 + logical, parameter :: w3_t0_flag = .true. !< @public a flag for "W3_T0" +#else + logical, parameter :: w3_t0_flag = .false. !< @public a flag for "W3_T0" +#endif + +#ifdef W3_T1 + logical, parameter :: w3_t1_flag = .true. !< @public a flag for "W3_T1" +#else + logical, parameter :: w3_t1_flag = .false. !< @public a flag for "W3_T1" +#endif + +#ifdef W3_T2 + logical, parameter :: w3_t2_flag = .true. !< @public a flag for "W3_T2" +#else + logical, parameter :: w3_t2_flag = .false. !< @public a flag for "W3_T2" +#endif +#ifdef W3_T3 + logical, parameter :: w3_t3_flag = .true. !< @public a flag for "W3_T3" +#else + logical, parameter :: w3_t3_flag = .false. !< @public a flag for "W3_T3" +#endif +#ifdef W3_T4 + logical, parameter :: w3_t4_flag = .true. !< @public a flag for "W3_T4" +#else + logical, parameter :: w3_t4_flag = .false. !< @public a flag for "W3_T4" +#endif +#ifdef W3_T5 + logical, parameter :: w3_t5_flag = .true. !< @public a flag for "W3_T5" +#else + logical, parameter :: w3_t5_flag = .false. !< @public a flag for "W3_T5" +#endif +#ifdef W3_T6 + logical, parameter :: w3_t6_flag = .true. !< @public a flag for "W3_T6" +#else + logical, parameter :: w3_t6_flag = .false. !< @public a flag for "W3_T6" +#endif +#ifdef W3_T7 + logical, parameter :: w3_t7_flag = .true. !< @public a flag for "W3_T7" +#else + logical, parameter :: w3_t7_flag = .false. !< @public a flag for "W3_T7" +#endif +#ifdef W3_T8 + logical, parameter :: w3_t8_flag = .true. !< @public a flag for "W3_T8" +#else + logical, parameter :: w3_t8_flag = .false. !< @public a flag for "W3_T8" +#endif +#ifdef W3_T9 + logical, parameter :: w3_t9_flag = .true. !< @public a flag for "W3_T9" +#else + logical, parameter :: w3_t9_flag = .false. !< @public a flag for "W3_T9" +#endif +#ifdef W3_T38 + logical, parameter :: w3_t38_flag = .true. !< @public a flag for "W3_T38" +#else + logical, parameter :: w3_t38_flag = .false. !< @public a flag for "W3_T38" +#endif +#ifdef W3_TDYN + logical, parameter :: w3_tdyn_flag = .true. !< @public a flag for "W3_TDYN" +#else + logical, parameter :: w3_tdyn_flag = .false. !< @public a flag for "W3_TDYN" +#endif + +#ifdef W3_TIDE + logical, parameter :: w3_tide_flag = .true. !< @public a flag for "W3_TIDE" +#else + logical, parameter :: w3_tide_flag = .false. !< @public a flag for "W3_TIDE" +#endif + +#ifdef W3_TIDET + logical, parameter :: w3_tidet_flag = .true. !< @public a flag for "W3_TIDET" +#else + logical, parameter :: w3_tidet_flag = .false. !< @public a flag for "W3_TIDET" +#endif + +#ifdef W3_TRKNC + logical, parameter :: w3_trknc_flag = .true. !< @public a flag for "W3_TRKNC" +#else + logical, parameter :: w3_trknc_flag = .false. !< @public a flag for "W3_TRKNC" +#endif + +#ifdef W3_UOST + logical, parameter :: w3_uost_flag = .true. !< @public a flag for "W3_UOST" +#else + logical, parameter :: w3_uost_flag = .false. !< @public a flag for "W3_UOST" +#endif + +#ifdef W3_WRST + logical, parameter :: w3_wrst_flag = .true. !< @public a flag for "W3_WRST" +#else + logical, parameter :: w3_wrst_flag = .false. !< @public a flag for "W3_WRST" +#endif + +#ifdef W3_XW0 + logical, parameter :: w3_xw0_flag = .true. !< @public a flag for "W3_XW0" +#else + logical, parameter :: w3_xw0_flag = .false. !< @public a flag for "W3_XW0" +#endif + +#ifdef W3_XW1 + logical, parameter :: w3_xw1_flag = .true. !< @public a flag for "W3_XW1" +#else + logical, parameter :: w3_xw1_flag = .false. !< @public a flag for "W3_XW1" +#endif + +#ifdef W3_CESMCOUPLED + logical, parameter :: w3_cesmcoupled_flag = .true. !< @public a flag for "W3_CESMCOUPLED" +#else + logical, parameter :: w3_cesmcoupled_flag = .false. !< @public a flag for "W3_CESMCOUPLED" +#endif + +#ifdef W3_UWM + logical, parameter :: w3_uwm_flag = .true. !< @public a flag for "W3_UWM" +#else + logical, parameter :: w3_uwm_flag = .false. !< @public a flag for "W3_UWM" +#endif + +#ifdef W3_SBS + logical, parameter :: w3_sbs_flag = .true. !< @public a flag for "W3_SBS" +#else + logical, parameter :: w3_sbs_flag = .false. !< @public a flag for "W3_SBS" +#endif + +#ifdef W3_BT4 + logical, parameter :: w3_bt4_flag = .true. !< @public a flag for "W3_BT4" +#else + logical, parameter :: w3_bt4_flag = .false. !< @public a flag for "W3_BT4" +#endif + +#ifdef W3_WCOR + logical, parameter :: w3_wcor_flag = .true. !< @public a flag for "W3_WCOR" +#else + logical, parameter :: w3_wcor_flag = .false. !< @public a flag for "W3_WCOR" +#endif + +#ifdef W3_SETUP + logical, parameter :: w3_setup_flag = .true. !< @public a flag for "W3_SETUP" +#else + logical, parameter :: w3_setup_flag = .false. !< @public a flag for "W3_SETUP" +#endif + +#ifdef W3_O2A + logical, parameter :: w3_O2a_flag = .true. !< @public a flag for "W3_O2A" +#else + logical, parameter :: w3_O2a_flag = .false. !< @public a flag for "W3_O2A" +#endif + +#ifdef W3_O2B + logical, parameter :: w3_O2b_flag = .true. !< @public a flag for "W3_O2B" +#else + logical, parameter :: w3_O2b_flag = .false. !< @public a flag for "W3_O2B" +#endif +#ifdef W3_O2C + logical, parameter :: w3_O2c_flag = .true. !< @public a flag for "W3_O2C" +#else + logical, parameter :: w3_O2c_flag = .false. !< @public a flag for "W3_O2C" +#endif +#ifdef W3_O7A + logical, parameter :: w3_O7a_flag = .true. !< @public a flag for "W3_O7A" +#else + logical, parameter :: w3_O7a_flag = .false. !< @public a flag for "W3_O7A" +#endif +#ifdef W3_O7B + logical, parameter :: w3_O7b_flag = .true. !< @public a flag for "W3_O7B" +#else + logical, parameter :: w3_O7b_flag = .false. !< @public a flag for "W3_O7B" +#endif +#ifdef W3_01 + logical, parameter :: w3_01_flag = .true. !< @public a flag for "W3_01" +#else + logical, parameter :: w3_01_flag = .false. !< @public a flag for "W3_01" +#endif + + interface print_logmsg + module procedure print_logmsg_1line + module procedure print_logmsg_2line + module procedure print_logmsg_3line + module procedure print_logmsg_4line + end interface print_logmsg + +contains + + !======================================================================== + !> Write a 1 line message if requested + !! + !> @details Writes a one line message + !! + !! @param[in] unum unit number + !! @param[in] msg1 one line message + !! @param[in] lwrite logical to control message writing + !! + !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov + !> @date 06-01-2022 + subroutine print_logmsg_1line(unum, msg1, lwrite) + + integer , intent(in) :: unum + character(len=*), intent(in) :: msg1 + logical , intent(in) :: lwrite + + if (.not. lwrite) return + + write(unum,'(a)') trim(msg1) + flush(unum) + + end subroutine print_logmsg_1line + + !======================================================================== + !> Write a 2 line message if requested + !! + !> @details Writes a two line message + !! + !! @param[in] unum unit number + !! @param[in] msg1 first line of message + !! @param[in] msg2 second line of message + !! @param[in] lwrite logical to control message writing + !! + !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov + !> @date 06-01-2022 + subroutine print_logmsg_2line(unum, msg1, msg2, lwrite) + + integer , intent(in) :: unum + character(len=*), intent(in) :: msg1 + character(len=*), intent(in) :: msg2 + logical , intent(in) :: lwrite + + if (.not. lwrite) return + + write(unum,'(a)') trim(msg1) + write(unum,'(a)') trim(msg2) + flush(unum) + + end subroutine print_logmsg_2line + + !======================================================================== + !> Write a 3 line message if requested + !! + !> @details Writes a three line message + !! + !! @param[in] unum unit number + !! @param[in] msg1 first line of message + !! @param[in] msg2 second line of message + !! @param[in] msg3 third line of message + !! @param[in] lwrite logical to control message writing + !! + !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov + !> @date 06-01-2022 + subroutine print_logmsg_3line(unum, msg1, msg2, msg3, lwrite) + + integer , intent(in) :: unum + character(len=*), intent(in) :: msg1 + character(len=*), intent(in) :: msg2 + character(len=*), intent(in) :: msg3 + logical , intent(in) :: lwrite + + if (.not. lwrite) return + + write(unum,'(a)') trim(msg1) + write(unum,'(a)') trim(msg2) + write(unum,'(a)') trim(msg3) + flush(unum) + + end subroutine print_logmsg_3line + + !======================================================================== + !> Write a 4 line message if requested + !! + !> @details Writes a four line message + !! + !! @param[in] unum unit number + !! @param[in] msg1 first line of message + !! @param[in] msg2 second line of message + !! @param[in] msg3 third line of message + !! @param[in] msg4 forth line of message + !! @param[in] lwrite logical to control message writing + !! + !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov + !> @date 06-01-2022 + + subroutine print_logmsg_4line(unum, msg1, msg2, msg3, msg4, lwrite) + + integer , intent(in) :: unum + character(len=*), intent(in) :: msg1 + character(len=*), intent(in) :: msg2 + character(len=*), intent(in) :: msg3 + character(len=*), intent(in) :: msg4 + logical , intent(in) :: lwrite + + if (.not. lwrite) return + + write(unum,'(a)') trim(msg1) + write(unum,'(a)') trim(msg2) + write(unum,'(a)') trim(msg3) + write(unum,'(a)') trim(msg4) + flush(unum) + + end subroutine print_logmsg_4line + + !======================================================================== + !> Write memory statistics if requested + !! + !> @details Writes a single line of memory statistics + !! + !! @param[in] iun unit number + !! @param[in] msg message + !! + !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov + !> @date 06-01-2022 + + subroutine print_memcheck(iun, msg) +#if W3_MEMCHECK + USE MallocInfo_m +#endif + integer , intent(in) :: iun + character(len=*) , intent(in) :: msg + +#if W3_MEMCHECK + write(iun,*) trim(msg) + call getMallocInfo(mallinfos) + call printMallInfo(iun, mallInfos) +#endif + end subroutine print_memcheck + +end module wav_shr_flags diff --git a/model/src/wav_shr_mod.F90 b/model/src/wav_shr_mod.F90 index 1afd0706ef..7ae58a5d2d 100644 --- a/model/src/wav_shr_mod.F90 +++ b/model/src/wav_shr_mod.F90 @@ -51,25 +51,15 @@ module wav_shr_mod end interface state_getfldptr ! used by both CESM and UFS - ! runtype is used by W3SRCE (values are startup, branch, continue) - character(len=cs) , public :: runtype !< @public the run type (startup,branch,continue) logical , public :: wav_coupling_to_cice = .false. !< @public flag to specify additional wave export !! fields for coupling to CICE (TODO: generalize) integer , public :: dbug_flag = 0 !< @public flag used to produce additional output - character(len=256) , public :: casename !< @public the name pre-prended to an output file - character(len= 36) , public :: time_origin !< @public the time_origin used for netCDF output - character(len= 36) , public :: calendar_name !< @public the calendar used for netCDF output - integer(i8) , public :: elapsed_secs !< @public the time in seconds from the time_origin + character(len=256) , public :: casename = '' !< @public the name pre-prended to an output file - ! Only used by cesm - ! if a run is a startup or branch run, then initfile is used + ! Only used by cesm and optionally by uwm ! to construct the initial file and used in W3IORSMD ! if a run is a continue run, then casename is used to construct ! the restart filename in W3IORSMD - character(len=256) , public :: initfile !< @public name of wave initial condition file - logical , public :: rstwr !< @public logical to control restart write. if true => write restart - logical , public :: histwr !< @public logical to control history write. if true => write history file (snapshot) - integer , public :: outfreq !< @public output frequency in hours (TODO: not used?) integer , public :: inst_index !< @public number of current instance (ie 1) character(len=16) , public :: inst_name !< @public fullname of current instance (ie "wav_0001") character(len=16) , public :: inst_suffix !< @public char string associated with instance @@ -117,7 +107,7 @@ module wav_shr_mod !=============================================================================== !> Get scalar data from a state !! -!! @details Obtain the field flds_scalar_name from a State and broadcast and +!> @details Obtain the field flds_scalar_name from a State and broadcast and !! it to all PEs !! !! @param[in] State an ESMF_State @@ -185,7 +175,7 @@ end subroutine state_getscalar !! Called by fldlist_realize to set the required scalar data into a state. The !! scalar_value will be set into a field with name flds_scalar_name. The scalar_id !! identifies which dimension in the scalar field is given by the scalar_value. The -!! number of scalars is used to ensure that the scalar_id is within the bounds of +!! number of scalars is used to ensure that the scalar_id is within the bounds of !! the scalar field !! !! @param[inout] State an ESMF_State @@ -625,7 +615,7 @@ end subroutine field_getfldptr !=============================================================================== !> Set up an alarm in a clock !! -!! @details Create an ESMF_Alarm according to the desired frequency, where the +!> @details Create an ESMF_Alarm according to the desired frequency, where the !! frequency is relative to a time frequency of seconds, days, hours etc. !! !! @param[inout] clock an ESMF_Clock