From 2bf204eb781daf4122a3b50095b79ec45a4d3e21 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Tue, 14 Mar 2023 15:39:53 -0400 Subject: [PATCH 1/4] Fixes output of ust,ustdir and asf and adds USSP when running with domain decomposition. (#943) --- model/src/pdlib_field_vec.F90 | 25 +++++++++++++++++++++---- 1 file changed, 21 insertions(+), 4 deletions(-) diff --git a/model/src/pdlib_field_vec.F90 b/model/src/pdlib_field_vec.F90 index 95c817d97..da864cad4 100644 --- a/model/src/pdlib_field_vec.F90 +++ b/model/src/pdlib_field_vec.F90 @@ -323,6 +323,11 @@ SUBROUTINE GET_ARRAY_SIZE(TheSize) IF ( FLGRDALL( 6, 11) ) THEN IH = IH + 1 END IF + IF ( FLGRDALL( 6, 12) ) THEN + DO IK=1,2*NK + IH = IH + 1 + END DO + END IF IF ( FLGRDALL( 6, 13) ) THEN IH = IH + 1 IH = IH + 1 @@ -825,7 +830,7 @@ SUBROUTINE DO_OUTPUT_EXCHANGES(IMOD) STH2M, HSIG, TAUICE, PHICE, PTHP0, PQP,& PPE, PGW, PSW, PTM1, PT1, PT2, PEP, & QP, MSSD, MSCD, STMAXE, STMAXD, HMAXE, & - HCMAXE, HMAXD, HCMAXD, WBT + HCMAXE, HMAXD, HCMAXD, WBT, USSP USE W3GDATMD, ONLY: NK, NSEAL USE W3ODATMD, ONLY: NDST, IAPROC, NAPROC, NTPROC, FLOUT, & NAPFLD, NAPPNT, NAPRST, NAPBPT, NAPTRK,& @@ -1093,11 +1098,11 @@ SUBROUTINE DO_OUTPUT_EXCHANGES(IMOD) END IF IF ( FLGRDALL( 5, 1) ) THEN IH = IH + 1 - Arrexch(IH,JSEA)=UST(JSEA) + Arrexch(IH,JSEA)=UST(ISEA) IH = IH + 1 - Arrexch(IH,JSEA)=USTDIR(JSEA) + Arrexch(IH,JSEA)=USTDIR(ISEA) IH = IH + 1 - Arrexch(IH,JSEA)=ASF(JSEA) + Arrexch(IH,JSEA)=ASF(ISEA) END IF IF ( FLGRDALL( 5, 2) ) THEN IH = IH + 1 @@ -1201,6 +1206,12 @@ SUBROUTINE DO_OUTPUT_EXCHANGES(IMOD) IH = IH + 1 Arrexch(IH,JSEA)=PHICE(JSEA) END IF + IF ( FLGRDALL( 6, 12) ) THEN + DO IK=1,2*NK + IH = IH + 1 + Arrexch(IH,JSEA)=USSP(JSEA,IK) + END DO + END IF IF ( FLGRDALL( 6, 13) ) THEN IH = IH + 1 Arrexch(IH,JSEA)=TAUOCX(JSEA) @@ -1638,6 +1649,12 @@ SUBROUTINE DO_OUTPUT_EXCHANGES(IMOD) IH = IH + 1 PHICE(1:NSEA) = ARRtotal(IH,:) END IF + IF ( FLGRDALL( 6, 12) ) THEN + DO IK=1,2*NK + IH = IH + 1 + USSP(1:NSEA,IK) = ARRtotal(IH,:) + END DO + END IF IF ( FLGRDALL( 6, 13) ) THEN IH = IH + 1 TAUOCX(1:NSEA) = ARRtotal(IH,:) From 047f481553dc124587ae8d99c2870b0c9fad4f2f Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Tue, 21 Mar 2023 11:57:07 -0400 Subject: [PATCH 2/4] Clarify allowed grid type logic when running with domain decomposition. By-pass mpi send/recv set-up in w3initmd when using domain decomposition. (#949) --- model/src/pdlib_field_vec.F90 | 4 +- model/src/w3initmd.F90 | 109 +++++++++++++++++----------------- model/src/w3iorsmd.F90 | 4 +- model/src/w3parall.F90 | 2 +- model/src/w3wavemd.F90 | 6 +- 5 files changed, 61 insertions(+), 64 deletions(-) diff --git a/model/src/pdlib_field_vec.F90 b/model/src/pdlib_field_vec.F90 index da864cad4..b386b8786 100644 --- a/model/src/pdlib_field_vec.F90 +++ b/model/src/pdlib_field_vec.F90 @@ -808,7 +808,7 @@ SUBROUTINE DO_OUTPUT_EXCHANGES(IMOD) ! ! 4. Subroutines used : ! - USE W3ADATMD, ONLY: W3XDMA, W3SETA, W3XETA + USE W3ADATMD, ONLY: W3XDMA, W3SETA, W3XETA, WADATS USE W3SERVMD, ONLY: EXTCDE USE W3GDATMD, ONLY: NSEA USE W3GDATMD, ONLY: NX, NSPEC, MAPFS, E3DF, P2MSF, US3DF @@ -1336,7 +1336,7 @@ SUBROUTINE DO_OUTPUT_EXCHANGES(IMOD) END DO END IF IF ( IAPROC .EQ. NAPFLD ) THEN - ! CALL W3XDMA ( IMOD, NDSE, NDST, FLGRDALL ) + IF (.not. WADATS(IMOD)%AINIT2) CALL W3XDMA ( IMOD, NDSE, NDST, FLGRDALL ) CALL W3XETA ( IMOD, NDSE, NDST ) IH = 0 IF ( FLGRDALL( 2, 1) ) THEN diff --git a/model/src/w3initmd.F90 b/model/src/w3initmd.F90 index f2a794323..223034033 100644 --- a/model/src/w3initmd.F90 +++ b/model/src/w3initmd.F90 @@ -738,7 +738,7 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, #ifdef W3_PDLIB CALL PDLIB_INIT(IMOD) #endif - call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 2c') + call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 2c') #ifdef W3_TIMINGS CALL PRINT_MY_TIME("After PDLIB_INIT") @@ -747,7 +747,7 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, #ifdef W3_PDLIB CALL SYNCHRONIZE_IPGL_ETC_ARRAY(IMOD, IsMulti) #endif - call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 2cc') + call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 2cc') #ifdef W3_PDLIB END IF @@ -785,7 +785,7 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 2f') #ifdef W3_DIST IF ( NSEA .LT. NAPROC ) GOTO 820 - IF ((LPDLIB .eqv. .FALSE.).or.(GTYPE .NE. UNGTYPE)) THEN + IF (LPDLIB .eqv. .FALSE.) THEN IF ( NSPEC .LT. NAPROC ) GOTO 821 END IF #endif @@ -850,7 +850,7 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, ALLOCATE ( NT(NSPEC) ) NT = NTTOT #ifdef W3_DIST - IF ((LPDLIB .eqv. .FALSE.).or.(GTYPE .NE. UNGTYPE)) THEN + IF (LPDLIB .eqv. .FALSE.) THEN ! DO ! @@ -932,7 +932,7 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, ! 2.c.9 Test if any spectral points are left out ! #ifdef W3_DIST - IF ((LPDLIB .eqv. .FALSE.).or.(GTYPE .NE. UNGTYPE)) THEN + IF (LPDLIB .eqv. .FALSE.) THEN DO ISP=1, NSPEC IF ( IAPPRO(ISP) .EQ. -1. ) GOTO 829 END DO @@ -1820,7 +1820,7 @@ SUBROUTINE W3MPII ( IMOD ) ! ( persistent communication calls ) ! #ifdef W3_DIST - IF ((LPDLIB .eqv. .FALSE.).or.(GTYPE .NE. UNGTYPE)) THEN + IF (LPDLIB .eqv. .FALSE.) THEN #endif #ifdef W3_MPI NSPLOC = 0 @@ -2189,8 +2189,7 @@ SUBROUTINE W3MPIO ( IMOD ) IROOT = NAPFLD - 1 ! ! - IF ((FLOUT(1) .OR. FLOUT(7)).and.(.not. LPDLIB .or. & - (GTYPE .ne. UNGTYPE).or. .TRUE.)) THEN + IF ((FLOUT(1) .OR. FLOUT(7)) .and. (.not. LPDLIB)) THEN ! ! NRQMAX is the maximum number of output fields that require MPI communication, ! aimed to gather field values stored in each processor into one processor in @@ -3446,7 +3445,7 @@ SUBROUTINE W3MPIO ( IMOD ) #endif ! #ifdef W3_MPI - END IF + END IF !IF ( IAPROC .LE. NAPROC ) THEN ! IF ( NRQGO .GT. NRQMAX ) THEN WRITE (NDSE,1010) NRQGO, NRQMAX @@ -4684,14 +4683,14 @@ SUBROUTINE W3MPIO ( IMOD ) #ifdef W3_MPI CALL W3SETA ( IMOD, NDSE, NDST ) ! - END IF + END IF ! IF ( IAPROC .EQ. NAPFLD ) THEN ! IF ( NRQGO2 .GT. NRQMAX*NAPROC ) THEN WRITE (NDSE,1011) NRQGO2, NRQMAX*NAPROC CALL EXTCDE (11) END IF ! - END IF + END IF ! IF ((FLOUT(1) .OR. FLOUT(7)) .and. (.not. LPDLIB)) THEN ! ! 2. Set-up for W3IORS ---------------------------------------------- / ! 2.a General preparations @@ -4700,7 +4699,7 @@ SUBROUTINE W3MPIO ( IMOD ) IH = 0 IROOT = NAPRST - 1 ! - IF ( FLOUT(4) .OR. FLOUT(8) ) THEN + IF ((FLOUT(4) .OR. FLOUT(8)) .and. (.not. LPDLIB)) THEN IF (OARST) THEN ALLOCATE ( OUTPTS(IMOD)%OUT4%IRQRS(34*NAPROC) ) ELSE @@ -5485,8 +5484,8 @@ SUBROUTINE W3MPIO ( IMOD ) END DO ! CALL W3SETA ( IMOD, NDSE, NDST ) - END IF - END IF + END IF ! IF ( IAPROC .EQ. NAPRST ) THEN + END IF ! IF (OARST) THEN ! NRQRS = IH IF (OARST) THEN @@ -5518,56 +5517,54 @@ SUBROUTINE W3MPIO ( IMOD ) #ifdef W3_MPI IH = 0 ! - IF ((.NOT. LPDLIB).OR.(GTYPE .NE. UNGTYPE)) THEN - IF ( IAPROC .NE. NAPRST ) THEN - ! - ALLOCATE ( OUTPTS(IMOD)%OUT4%IRQRSS(NBLKRS) ) - IRQRSS => OUTPTS(IMOD)%OUT4%IRQRSS - ! - DO IB=1, NBLKRS - IH = IH + 1 - IT = IT0 + 3 + IB - JSEA0 = 1 + (IB-1)*RSBLKS - JSEAN = MIN ( NSEALM , IB*RSBLKS ) - NSEAB = 1 + JSEAN - JSEA0 - CALL MPI_SEND_INIT (VA(1,JSEA0), NSPEC*NSEAB, MPI_REAL, IROOT, IT, & - MPI_COMM_WAVE, IRQRSS(IH), IERR ) + IF ( IAPROC .NE. NAPRST ) THEN + ! + ALLOCATE ( OUTPTS(IMOD)%OUT4%IRQRSS(NBLKRS) ) + IRQRSS => OUTPTS(IMOD)%OUT4%IRQRSS + ! + DO IB=1, NBLKRS + IH = IH + 1 + IT = IT0 + 3 + IB + JSEA0 = 1 + (IB-1)*RSBLKS + JSEAN = MIN ( NSEALM , IB*RSBLKS ) + NSEAB = 1 + JSEAN - JSEA0 + CALL MPI_SEND_INIT (VA(1,JSEA0), NSPEC*NSEAB, MPI_REAL, IROOT, IT, & + MPI_COMM_WAVE, IRQRSS(IH), IERR ) #endif #ifdef W3_MPIT - WRITE (NDST,9026) IH, 'S', IB, IROOT, IT, IRQRSS(IH), IERR, NSEAB + WRITE (NDST,9026) IH, 'S', IB, IROOT, IT, IRQRSS(IH), IERR, NSEAB #endif #ifdef W3_MPI - END DO - ! - ELSE - ! - ALLOCATE ( OUTPTS(IMOD)%OUT4%IRQRSS(NAPROC*NBLKRS) , & - OUTPTS(IMOD)%OUT4%VAAUX(NSPEC,2*RSBLKS,NAPROC) ) - ! - IRQRSS => OUTPTS(IMOD)%OUT4%IRQRSS - VAAUX => OUTPTS(IMOD)%OUT4%VAAUX - DO IB=1, NBLKRS - IT = IT0 + 3 + IB - JSEA0 = 1 + (IB-1)*RSBLKS - JSEAN = MIN ( NSEALM , IB*RSBLKS ) - NSEAB = 1 + JSEAN - JSEA0 - DO I0=1, NAPROC - IF ( I0 .NE. NAPRST ) THEN - IH = IH + 1 - IFROM = I0 - 1 - IBOFF = MOD(IB-1,2)*RSBLKS - CALL MPI_RECV_INIT (VAAUX(1,1+IBOFF,I0), NSPEC*NSEAB, MPI_REAL, & - IFROM, IT, MPI_COMM_WAVE, IRQRSS(IH), IERR ) + END DO + ! + ELSE + ! + ALLOCATE ( OUTPTS(IMOD)%OUT4%IRQRSS(NAPROC*NBLKRS) , & + OUTPTS(IMOD)%OUT4%VAAUX(NSPEC,2*RSBLKS,NAPROC) ) + ! + IRQRSS => OUTPTS(IMOD)%OUT4%IRQRSS + VAAUX => OUTPTS(IMOD)%OUT4%VAAUX + DO IB=1, NBLKRS + IT = IT0 + 3 + IB + JSEA0 = 1 + (IB-1)*RSBLKS + JSEAN = MIN ( NSEALM , IB*RSBLKS ) + NSEAB = 1 + JSEAN - JSEA0 + DO I0=1, NAPROC + IF ( I0 .NE. NAPRST ) THEN + IH = IH + 1 + IFROM = I0 - 1 + IBOFF = MOD(IB-1,2)*RSBLKS + CALL MPI_RECV_INIT (VAAUX(1,1+IBOFF,I0), NSPEC*NSEAB, MPI_REAL, & + IFROM, IT, MPI_COMM_WAVE, IRQRSS(IH), IERR ) #endif #ifdef W3_MPIT - WRITE (NDST,9026) IH, 'R', IB, IFROM, IT, IRQRSS(IH), IERR, NSEAB + WRITE (NDST,9026) IH, 'R', IB, IFROM, IT, IRQRSS(IH), IERR, NSEAB #endif #ifdef W3_MPI - END IF - END DO + END IF END DO - ! - END IF + END DO + ! END IF #endif ! @@ -5580,7 +5577,7 @@ SUBROUTINE W3MPIO ( IMOD ) ! END IF ! - END IF + END IF ! IF ((FLOUT(4) .OR. FLOUT(8)) .and. (.not. LPDLIB)) THEN #endif ! ! 3. Set-up for W3IOBC ( SENDs ) ------------------------------------ / diff --git a/model/src/w3iorsmd.F90 b/model/src/w3iorsmd.F90 index 1feb267f3..b8b657a61 100644 --- a/model/src/w3iorsmd.F90 +++ b/model/src/w3iorsmd.F90 @@ -642,7 +642,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) #ifdef W3_MPI ELSE ! - IF (LPDLIB .and. (GTYPE.eq.UNGTYPE)) THEN + IF (LPDLIB) THEN #endif #ifdef W3_TIMINGS CALL PRINT_MY_TIME("Before UNST_PDLIB_WRITE_TO_FILE") @@ -724,7 +724,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) WRITE (NDST,9020) TYPE #endif ELSE - IF (LPDLIB .and. (GTYPE.eq.UNGTYPE)) THEN + IF (LPDLIB) THEN #ifdef W3_TIMINGS CALL PRINT_MY_TIME("Before UNST_PDLIB_READ_FROM_FILE") #endif diff --git a/model/src/w3parall.F90 b/model/src/w3parall.F90 index 789f807c5..e9f5a95ca 100644 --- a/model/src/w3parall.F90 +++ b/model/src/w3parall.F90 @@ -1116,7 +1116,7 @@ SUBROUTINE INIT_GET_JSEA_ISPROC(ISEA, JSEA, ISPROC) #endif #ifdef W3_PDLIB - IF ((.NOT. LPDLIB ).or.(GTYPE .ne. UNGTYPE)) THEN + IF (.NOT. LPDLIB) THEN #endif JSEA = 1 + (ISEA-1)/NAPROC ISPROC = ISEA - (JSEA-1)*NAPROC diff --git a/model/src/w3wavemd.F90 b/model/src/w3wavemd.F90 index e31790c1a..f13c8e234 100644 --- a/model/src/w3wavemd.F90 +++ b/model/src/w3wavemd.F90 @@ -1840,7 +1840,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & FACX = 1. END IF END IF - IF ((GTYPE .EQ. UNGTYPE) .and. LPDLIB) THEN + IF (LPDLIB) THEN ! #ifdef W3_PDLIB IF ((FSTOTALIMP .eqv. .FALSE.).and.(FLCX .or. FLCY)) THEN @@ -2438,7 +2438,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #ifdef W3_MPI IF ( ( (DSEC21(TIME,TONEXT(:,1)).EQ.0.) .AND. FLOUT(1) ) .OR. & ( (DSEC21(TIME,TONEXT(:,7)).EQ.0.) .AND. FLOUT(7) .AND. SBSED ) ) THEN - IF (.NOT. LPDLIB .or. (GTYPE.ne.UNGTYPE)) THEN + IF (.NOT. LPDLIB) THEN IF (NRQGO.NE.0 ) THEN #endif #ifdef W3_MPI @@ -2477,7 +2477,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & CALL DO_OUTPUT_EXCHANGES(IMOD) #endif #ifdef W3_MPI - END IF + END IF ! IF (.NOT. LPDLIB) THEN END IF #endif call print_memcheck(memunit, 'memcheck_____:'//' WW3_WAVE AFTER TIME LOOP 1') From f1f6c21d95573d50d9e95f8ffcf0b65e60e1b91b Mon Sep 17 00:00:00 2001 From: Mathieu Dutour Sikiric Date: Tue, 21 Mar 2023 17:02:26 +0100 Subject: [PATCH 3/4] Correction of some typographic errors. (#951) --- model/src/w3odatmd.F90 | 4 ++-- model/src/ww3_prnc.F90 | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/model/src/w3odatmd.F90 b/model/src/w3odatmd.F90 index fa894a7a7..408f36fe6 100644 --- a/model/src/w3odatmd.F90 +++ b/model/src/w3odatmd.F90 @@ -171,7 +171,7 @@ MODULE W3ODATMD ! IW I.A. Public Id. water. ! II I.A. Public Id. ice. ! IRQPO1/2 I.A. Public Array with MPI handles. (!/MPI) - ! PTLOC R.A. Public Name of output locations. + ! PTLOC R.A. Public Output locations. ! PTIFAC R.A. Public Interpolation weights. ! DPO R.A. Public Interpolated depths. ! WAO R.A. Public Interpolated wind speeds. @@ -186,7 +186,7 @@ MODULE W3ODATMD ! ICEO R.A. Public Interpolated ice concentration. ! ICEHO R.A. Public Interpolated ice thickness. ! ICEFO R.A. Public Interpolated ice floe. - ! PTNME C.A. Public Output locations. + ! PTNME C.A. Public Name of output locations. ! GRDID C.A. Public Originating grid ID. ! O2INIT Log. Public Flag for array initialization. ! O2IRQI Log. Public Flag for array initialization. diff --git a/model/src/ww3_prnc.F90 b/model/src/ww3_prnc.F90 index 1d54c7432..980b7553a 100644 --- a/model/src/ww3_prnc.F90 +++ b/model/src/ww3_prnc.F90 @@ -2696,7 +2696,7 @@ SUBROUTINE CHECK_ERROR(IRET, ILINE) INTEGER IRET, ILINE IF (IRET .NE. NF90_NOERR) THEN - WRITE(NDSE,*) ' *** WAVEWATCH III ERROR IN OUNF :' + WRITE(NDSE,*) ' *** WAVEWATCH III ERROR IN PRNC :' WRITE(NDSE,*) ' LINE NUMBER ', ILINE WRITE(NDSE,*) ' NETCDF ERROR MESSAGE: ' WRITE(NDSE,*) NF90_STRERROR(IRET) From 446a09255562f963715b3d96362280d37490f6d5 Mon Sep 17 00:00:00 2001 From: Aron Roland Date: Wed, 22 Mar 2023 14:08:23 +0100 Subject: [PATCH 4/4] Work related to the down-scaling capabilities of the unstructured grid approach. (#888) * Consolidation and performance improvements of wave setup computation on structured and unstructured grids. * Performance and memory improvement of the unstructured framework. * Introduction of a new limiter (mixture of Hersbach & Janssen + Komen etal.) * Alternative computations of the group velocity for unstructured grids * Introduce under-relaxation for triads and wave breaking * Improve shallow-water source term integration for explicit source terms within the unstructured down-scaling approach. * Bug fixes for wetting & drying for both implicit and explicit schemes. * Bug fix for the wave triad interaction. * Introduce coastline reflection for the implicit scheme, and homogenization within the new wetting & drying scheme. * Introduction of Block Explicit Solver as an option for unstructured meshes. * Consolidation of the implicit solver in terms of memory usage, coherence. * debug output and further work on the Jacobi solver towards CPU coherency of the Jacobi solver. * Fix bugs and clean & test 2nd order time-space LAX-FCT-CRD scheme. Co-authored-by: aliabdolali Co-authored-by: Ty Hesser --- model/bin/ww3_from_ftp.sh | 2 + model/inp/ww3_grid.inp | 26 +- model/nml/namelists.nml | 27 +- model/src/PDLIB/yowexchangeModule.F90 | 3 + model/src/PDLIB/yowpdlibmain.F90 | 6 +- model/src/w3gdatmd.F90 | 3 + model/src/w3gridmd.F90 | 16 +- model/src/w3initmd.F90 | 58 +- model/src/w3iogomd.F90 | 2 +- model/src/w3iorsmd.F90 | 3 +- model/src/w3parall.F90 | 10 +- model/src/w3profsmd.F90 | 7 +- model/src/w3profsmd_pdlib.F90 | 3749 +++++----- model/src/w3ref1md.F90 | 12 +- model/src/w3snl3md.F90 | 8 +- model/src/w3srcemd.F90 | 86 +- model/src/w3str1md.F90 | 257 +- model/src/w3str2md.F90 | 449 -- model/src/w3triamd.F90 | 132 +- model/src/w3updtmd.F90 | 21 +- model/src/w3wavemd.F90 | 101 +- model/src/w3wavset.F90 | 6159 ++++++++--------- regtests/bin/matrix.base | 18 + regtests/bin/matrix_cmake_milhydro | 153 + regtests/bin/matrix_ncep | 40 +- regtests/ww3_tp2.19/input/points.list | 80 + .../ww3_tp2.19/input_Case1A/namelists_a.nml | 34 + .../ww3_tp2.19/input_Case1A/namelists_b.nml | 33 + regtests/ww3_tp2.19/input_Case1A/spec.list | 1 + regtests/ww3_tp2.19/input_Case1A/switch_PDLIB | 1 + .../ww3_tp2.19/input_Case1A/ww3_bounc.inp | 25 + .../ww3_tp2.19/input_Case1A/ww3_bounc.nml | 21 + regtests/ww3_tp2.19/input_Case1A/ww3_grid.inp | 302 + .../ww3_tp2.19/input_Case1A/ww3_grid_a.inp | 302 + .../ww3_tp2.19/input_Case1A/ww3_grid_a.nml | 265 + .../ww3_tp2.19/input_Case1A/ww3_grid_b.inp | 302 + .../ww3_tp2.19/input_Case1A/ww3_grid_b.nml | 265 + regtests/ww3_tp2.19/input_Case1A/ww3_ounf.inp | 82 + regtests/ww3_tp2.19/input_Case1A/ww3_ounf.nml | 87 + regtests/ww3_tp2.19/input_Case1A/ww3_ounp.inp | 119 + regtests/ww3_tp2.19/input_Case1A/ww3_ounp.nml | 193 + regtests/ww3_tp2.19/input_Case1A/ww3_shel.inp | 115 + regtests/ww3_tp2.19/input_Case1A/ww3_shel.nml | 337 + .../ww3_tp2.19/input_Case1B/namelists_a.nml | 34 + .../ww3_tp2.19/input_Case1B/namelists_b.nml | 33 + regtests/ww3_tp2.19/input_Case1B/spec.list | 1 + regtests/ww3_tp2.19/input_Case1B/switch_PDLIB | 1 + .../ww3_tp2.19/input_Case1B/ww3_bounc.inp | 25 + .../ww3_tp2.19/input_Case1B/ww3_bounc.nml | 21 + regtests/ww3_tp2.19/input_Case1B/ww3_grid.inp | 302 + .../ww3_tp2.19/input_Case1B/ww3_grid_a.inp | 302 + .../ww3_tp2.19/input_Case1B/ww3_grid_a.nml | 265 + .../ww3_tp2.19/input_Case1B/ww3_grid_b.inp | 302 + .../ww3_tp2.19/input_Case1B/ww3_grid_b.nml | 265 + regtests/ww3_tp2.19/input_Case1B/ww3_ounf.inp | 82 + regtests/ww3_tp2.19/input_Case1B/ww3_ounf.nml | 87 + regtests/ww3_tp2.19/input_Case1B/ww3_ounp.inp | 119 + regtests/ww3_tp2.19/input_Case1B/ww3_ounp.nml | 193 + regtests/ww3_tp2.19/input_Case1B/ww3_shel.inp | 115 + regtests/ww3_tp2.19/input_Case1B/ww3_shel.nml | 337 + .../ww3_tp2.19/input_Case1C/namelists_a.nml | 34 + .../ww3_tp2.19/input_Case1C/namelists_b.nml | 33 + regtests/ww3_tp2.19/input_Case1C/spec.list | 1 + regtests/ww3_tp2.19/input_Case1C/switch_PDLIB | 1 + .../ww3_tp2.19/input_Case1C/ww3_bounc.inp | 25 + .../ww3_tp2.19/input_Case1C/ww3_bounc.nml | 21 + regtests/ww3_tp2.19/input_Case1C/ww3_grid.inp | 302 + .../ww3_tp2.19/input_Case1C/ww3_grid_a.inp | 302 + .../ww3_tp2.19/input_Case1C/ww3_grid_a.nml | 265 + .../ww3_tp2.19/input_Case1C/ww3_grid_b.inp | 302 + .../ww3_tp2.19/input_Case1C/ww3_grid_b.nml | 265 + regtests/ww3_tp2.19/input_Case1C/ww3_ounf.inp | 82 + regtests/ww3_tp2.19/input_Case1C/ww3_ounf.nml | 87 + regtests/ww3_tp2.19/input_Case1C/ww3_ounp.inp | 119 + regtests/ww3_tp2.19/input_Case1C/ww3_ounp.nml | 193 + regtests/ww3_tp2.19/input_Case1C/ww3_shel.inp | 115 + regtests/ww3_tp2.19/input_Case1C/ww3_shel.nml | 337 + regtests/ww3_tp2.7/input/ww3_ounf.nml | 1 + regtests/ww3_ufs1.1/info | 14 +- .../ww3_ufs1.1/input_unstr/namelists_a.nml | 53 + .../ww3_ufs1.1/input_unstr/namelists_b.nml | 73 + .../ww3_ufs1.1/input_unstr/namelists_c.nml | 72 + regtests/ww3_ufs1.1/input_unstr/switch_PDLIB | 1 + .../ww3_ufs1.1/input_unstr/ww3_grid_a.inp | 307 + .../ww3_ufs1.1/input_unstr/ww3_grid_a.nml | 61 + .../ww3_ufs1.1/input_unstr/ww3_grid_b.inp | 327 + .../ww3_ufs1.1/input_unstr/ww3_grid_b.nml | 61 + .../ww3_ufs1.1/input_unstr/ww3_grid_c.inp | 326 + .../ww3_ufs1.1/input_unstr/ww3_grid_c.nml | 61 + regtests/ww3_ufs1.1/input_unstr/ww3_ounf.inp | 88 + regtests/ww3_ufs1.1/input_unstr/ww3_ounf.nml | 37 + regtests/ww3_ufs1.1/input_unstr/ww3_ounp.inp | 118 + regtests/ww3_ufs1.1/input_unstr/ww3_ounp.nml | 24 + .../ww3_ufs1.1/input_unstr/ww3_points.list | 240 + .../input_unstr/ww3_prnc_current.inp | 51 + .../input_unstr/ww3_prnc_current.nml | 27 + .../ww3_ufs1.1/input_unstr/ww3_prnc_ice.inp | 51 + .../ww3_ufs1.1/input_unstr/ww3_prnc_ice.nml | 26 + .../ww3_ufs1.1/input_unstr/ww3_prnc_wind.inp | 51 + .../ww3_ufs1.1/input_unstr/ww3_prnc_wind.nml | 27 + regtests/ww3_ufs1.1/input_unstr/ww3_shel.inp | 301 + regtests/ww3_ufs1.1/input_unstr/ww3_shel.nml | 52 + 102 files changed, 15484 insertions(+), 5846 deletions(-) delete mode 100644 model/src/w3str2md.F90 create mode 100755 regtests/bin/matrix_cmake_milhydro create mode 100644 regtests/ww3_tp2.19/input/points.list create mode 100644 regtests/ww3_tp2.19/input_Case1A/namelists_a.nml create mode 100644 regtests/ww3_tp2.19/input_Case1A/namelists_b.nml create mode 100644 regtests/ww3_tp2.19/input_Case1A/spec.list create mode 100644 regtests/ww3_tp2.19/input_Case1A/switch_PDLIB create mode 100644 regtests/ww3_tp2.19/input_Case1A/ww3_bounc.inp create mode 100644 regtests/ww3_tp2.19/input_Case1A/ww3_bounc.nml create mode 100644 regtests/ww3_tp2.19/input_Case1A/ww3_grid.inp create mode 100644 regtests/ww3_tp2.19/input_Case1A/ww3_grid_a.inp create mode 100644 regtests/ww3_tp2.19/input_Case1A/ww3_grid_a.nml create mode 100644 regtests/ww3_tp2.19/input_Case1A/ww3_grid_b.inp create mode 100644 regtests/ww3_tp2.19/input_Case1A/ww3_grid_b.nml create mode 100644 regtests/ww3_tp2.19/input_Case1A/ww3_ounf.inp create mode 100644 regtests/ww3_tp2.19/input_Case1A/ww3_ounf.nml create mode 100644 regtests/ww3_tp2.19/input_Case1A/ww3_ounp.inp create mode 100644 regtests/ww3_tp2.19/input_Case1A/ww3_ounp.nml create mode 100644 regtests/ww3_tp2.19/input_Case1A/ww3_shel.inp create mode 100644 regtests/ww3_tp2.19/input_Case1A/ww3_shel.nml create mode 100644 regtests/ww3_tp2.19/input_Case1B/namelists_a.nml create mode 100644 regtests/ww3_tp2.19/input_Case1B/namelists_b.nml create mode 100644 regtests/ww3_tp2.19/input_Case1B/spec.list create mode 100644 regtests/ww3_tp2.19/input_Case1B/switch_PDLIB create mode 100644 regtests/ww3_tp2.19/input_Case1B/ww3_bounc.inp create mode 100644 regtests/ww3_tp2.19/input_Case1B/ww3_bounc.nml create mode 100644 regtests/ww3_tp2.19/input_Case1B/ww3_grid.inp create mode 100644 regtests/ww3_tp2.19/input_Case1B/ww3_grid_a.inp create mode 100644 regtests/ww3_tp2.19/input_Case1B/ww3_grid_a.nml create mode 100644 regtests/ww3_tp2.19/input_Case1B/ww3_grid_b.inp create mode 100644 regtests/ww3_tp2.19/input_Case1B/ww3_grid_b.nml create mode 100644 regtests/ww3_tp2.19/input_Case1B/ww3_ounf.inp create mode 100644 regtests/ww3_tp2.19/input_Case1B/ww3_ounf.nml create mode 100644 regtests/ww3_tp2.19/input_Case1B/ww3_ounp.inp create mode 100644 regtests/ww3_tp2.19/input_Case1B/ww3_ounp.nml create mode 100644 regtests/ww3_tp2.19/input_Case1B/ww3_shel.inp create mode 100644 regtests/ww3_tp2.19/input_Case1B/ww3_shel.nml create mode 100644 regtests/ww3_tp2.19/input_Case1C/namelists_a.nml create mode 100644 regtests/ww3_tp2.19/input_Case1C/namelists_b.nml create mode 100644 regtests/ww3_tp2.19/input_Case1C/spec.list create mode 100644 regtests/ww3_tp2.19/input_Case1C/switch_PDLIB create mode 100644 regtests/ww3_tp2.19/input_Case1C/ww3_bounc.inp create mode 100644 regtests/ww3_tp2.19/input_Case1C/ww3_bounc.nml create mode 100644 regtests/ww3_tp2.19/input_Case1C/ww3_grid.inp create mode 100644 regtests/ww3_tp2.19/input_Case1C/ww3_grid_a.inp create mode 100644 regtests/ww3_tp2.19/input_Case1C/ww3_grid_a.nml create mode 100644 regtests/ww3_tp2.19/input_Case1C/ww3_grid_b.inp create mode 100644 regtests/ww3_tp2.19/input_Case1C/ww3_grid_b.nml create mode 100644 regtests/ww3_tp2.19/input_Case1C/ww3_ounf.inp create mode 100644 regtests/ww3_tp2.19/input_Case1C/ww3_ounf.nml create mode 100644 regtests/ww3_tp2.19/input_Case1C/ww3_ounp.inp create mode 100644 regtests/ww3_tp2.19/input_Case1C/ww3_ounp.nml create mode 100644 regtests/ww3_tp2.19/input_Case1C/ww3_shel.inp create mode 100644 regtests/ww3_tp2.19/input_Case1C/ww3_shel.nml create mode 100644 regtests/ww3_ufs1.1/input_unstr/namelists_a.nml create mode 100644 regtests/ww3_ufs1.1/input_unstr/namelists_b.nml create mode 100644 regtests/ww3_ufs1.1/input_unstr/namelists_c.nml create mode 100644 regtests/ww3_ufs1.1/input_unstr/switch_PDLIB create mode 100644 regtests/ww3_ufs1.1/input_unstr/ww3_grid_a.inp create mode 100644 regtests/ww3_ufs1.1/input_unstr/ww3_grid_a.nml create mode 100644 regtests/ww3_ufs1.1/input_unstr/ww3_grid_b.inp create mode 100644 regtests/ww3_ufs1.1/input_unstr/ww3_grid_b.nml create mode 100644 regtests/ww3_ufs1.1/input_unstr/ww3_grid_c.inp create mode 100644 regtests/ww3_ufs1.1/input_unstr/ww3_grid_c.nml create mode 100644 regtests/ww3_ufs1.1/input_unstr/ww3_ounf.inp create mode 100644 regtests/ww3_ufs1.1/input_unstr/ww3_ounf.nml create mode 100755 regtests/ww3_ufs1.1/input_unstr/ww3_ounp.inp create mode 100644 regtests/ww3_ufs1.1/input_unstr/ww3_ounp.nml create mode 100644 regtests/ww3_ufs1.1/input_unstr/ww3_points.list create mode 100755 regtests/ww3_ufs1.1/input_unstr/ww3_prnc_current.inp create mode 100644 regtests/ww3_ufs1.1/input_unstr/ww3_prnc_current.nml create mode 100755 regtests/ww3_ufs1.1/input_unstr/ww3_prnc_ice.inp create mode 100644 regtests/ww3_ufs1.1/input_unstr/ww3_prnc_ice.nml create mode 100755 regtests/ww3_ufs1.1/input_unstr/ww3_prnc_wind.inp create mode 100644 regtests/ww3_ufs1.1/input_unstr/ww3_prnc_wind.nml create mode 100644 regtests/ww3_ufs1.1/input_unstr/ww3_shel.inp create mode 100644 regtests/ww3_ufs1.1/input_unstr/ww3_shel.nml diff --git a/model/bin/ww3_from_ftp.sh b/model/bin/ww3_from_ftp.sh index 466a81dcf..b2baec676 100755 --- a/model/bin/ww3_from_ftp.sh +++ b/model/bin/ww3_from_ftp.sh @@ -102,9 +102,11 @@ cp -r data_regtests/ww3_tp2.14/input/toy/toy_coupled_field.nc.OASACM regtests/ww cp -r data_regtests/ww3_tp2.14/input/toy/toy_coupled_field.nc.OASACM regtests/ww3_tp2.14/input/toy/toy_coupled_field.nc.OASACM6 cp -r data_regtests/ww3_tp2.14/input/toy/*.nc regtests/ww3_tp2.14/input/toy/ cp -r data_regtests/ww3_tp2.17/input/* regtests/ww3_tp2.17/input/ +cp -r data_regtests/ww3_tp2.19/input/* regtests/ww3_tp2.19/input/ cp -r data_regtests/ww3_tp2.21/input/* regtests/ww3_tp2.21/input/ cp -r data_regtests/mww3_test_09/input/* regtests/mww3_test_09/input/ cp -r data_regtests/ww3_ufs1.1/input/* regtests/ww3_ufs1.1/input/ +cp -r data_regtests/ww3_ufs1.1/input_unstr/* regtests/ww3_ufs1.1/input_unstr/ cp -r data_regtests/ww3_ufs1.1/input/*.nc regtests/ww3_ufs1.2/input/ cp -r data_regtests/ww3_ufs1.2/input/* regtests/ww3_ufs1.2/input/ cp -r data_regtests/ww3_ufs1.3/input/*nc regtests/ww3_ufs1.3/input/ diff --git a/model/inp/ww3_grid.inp b/model/inp/ww3_grid.inp index 61f9e0e01..ef6121974 100644 --- a/model/inp/ww3_grid.inp +++ b/model/inp/ww3_grid.inp @@ -305,30 +305,34 @@ $ limitation and the GSE alleviation. $ $ Unstructured grids ------------------------------------------------ $ $ UNST parameters : Namelist UNST -$ UGOBCAUTO : TRUE: OBC points are taken from type 15 elements +$ UGOBCAUTO : TRUE: OBC points are taken from type 15 elements $ FALSE: OBC points must be listed in ww3_grid.inp -$ UGOBCDEPTH: Threshold ( < 0) depth for OBC points if UGOBCAUTO is TRUE -$ EXPFSN : Activation of N scheme +$ UGOBCDEPTH : Threshold ( < 0) depth for OBC points if UGOBCAUTO is TRUE +$ UGOBCFILE : Reading boundary files from a file +$ EXPFSN : Activation of N scheme (only one of the below 4, True - Active, False - not active) $ EXPFSPSI : Activation of PSI scheme $ EXPFSFCT : Activation of FCT scheme -$ IMPFSN : Activation of N implicit scheme +$ IMPFSN : Activation of N implicit scheme +$ EXPTOTAL : Activation of the Block explicit N scheme solver $ IMPTOTAL : Activation of fully implicit scheme | Non splitting -$ EXPTOTAL : Turn on implicit refraction (only with imptotal) -$ IMPREFRACTION : Turn on implicit freq. shift (only with imptotal) +$ IMPREFRACTION : Turn on implicit freq. shift (only with imptotal) $ IMPFREQSHIFT : Turn on implicit freq. shift terms (only with imptotal) -$ IMPSOURCE : Turn on implicit source terms (only with imptotal) +$ IMPSOURCE : Turn on implicit source terms (only with imptotal) $ JGS_TERMINATE_MAXITER : max. Number of iterations -$ JGS_TERMINATE_DIFFERENCE : terminate based on the total change of wave action -$ JGS_TERMINATE_NORM : terminate based on the norm of the solution -$ JGS_USE_JACOBI : Use Jacobi solver for imptotal -$ JGS_BLOCK_GAUSS_SEIDEL : Use Block Gauss Seidel method for imptotal +$ JGS_TERMINATE_DIFFERENCE : Terminate based on the total change of the unweightet sum of wave action +$ JGS_TERMINATE_NORM : Terminate based on the norm of the solution +$ JGS_USE_JACOBI : Use Jacobi solver family +$ JGS_BLOCK_GAUSS_SEIDEL : Use Block Gauss Seidel method for imptotal instead of the conservative jacobi iterator. $ JGS_MAXITER : max. Number of solver iterations $ JGS_PMIN : % of grid points that do not need to converge during solver iteration. $ JGS_DIFF_THR : implicit solver threshold for JGS_TERMINATE_DIFFERENCE $ JGS_NORM_THR : terminate based on the norm of the solution +$ JGS_LIMITER : use total (quasi-steady: limits whole equation) instead of local limiter (un-steady: limits only source terms) +$ JGS_LIMITER_FUNC : 1 - old limiter; 2 - alternatnive limiter $ SETUP_APPLY_WLV : Compute wave setup (experimental) $ SOLVERTHR_SETUP : Solver threshold for setup computations $ CRIT_DEP_SETUP : Critical depths for setup computations + $ $ SMC grid propagation : Namelist PSMC and default values $ CFLSM : Maximum CFL no. for propagation, 0.7 diff --git a/model/nml/namelists.nml b/model/nml/namelists.nml index d376a045a..7b373c71e 100644 --- a/model/nml/namelists.nml +++ b/model/nml/namelists.nml @@ -224,7 +224,7 @@ $ w3sic4md.ftn $ $ Triad nonlinear interactions - - - - - - - - - - - - - - - - - - - - $ Lumped Triad Interaction (LTA) : Namelist STR1 (To be implemented) -$ PTRIAD1 : Proportionality coefficient (default 0.05) +$ PTRIAD1 : Proportionality coefficient (default 1.) $ PTRIAD2 : Multiple of Tm01 up to which interaction $ is computed (2.5) $ PTRIAD3 : Ursell upper limit for computing @@ -284,27 +284,30 @@ $ limitation and the GSE alleviation. $ $ Unstructured grids ------------------------------------------------ $ $ UNST parameters : Namelist UNST -$ UGOBCAUTO : TRUE: OBC points are taken from type 15 elements +$ UGOBCAUTO : TRUE: OBC points are taken from type 15 elements $ FALSE: OBC points must be listed in ww3_grid.inp -$ UGOBCDEPTH: Threshold ( < 0) depth for OBC points if UGOBCAUTO is TRUE -$ EXPFSN : Activation of N scheme +$ UGOBCDEPTH : Threshold ( < 0) depth for OBC points if UGOBCAUTO is TRUE +$ UGOBCFILE : Reading boundary files from a file +$ EXPFSN : Activation of N scheme (only one of the below 4, True - Active, False - not active) $ EXPFSPSI : Activation of PSI scheme $ EXPFSFCT : Activation of FCT scheme -$ IMPFSN : Activation of N implicit scheme +$ IMPFSN : Activation of N implicit scheme +$ EXPTOTAL : Activation of the Block explicit N scheme solver $ IMPTOTAL : Activation of fully implicit scheme | Non splitting -$ EXPTOTAL : Turn on implicit refraction (only with imptotal) -$ IMPREFRACTION : Turn on implicit freq. shift (only with imptotal) +$ IMPREFRACTION : Turn on implicit freq. shift (only with imptotal) $ IMPFREQSHIFT : Turn on implicit freq. shift terms (only with imptotal) -$ IMPSOURCE : Turn on implicit source terms (only with imptotal) +$ IMPSOURCE : Turn on implicit source terms (only with imptotal) $ JGS_TERMINATE_MAXITER : max. Number of iterations -$ JGS_TERMINATE_DIFFERENCE : terminate based on the total change of wave action -$ JGS_TERMINATE_NORM : terminate based on the norm of the solution -$ JGS_USE_JACOBI : Use Jacobi solver for imptotal -$ JGS_BLOCK_GAUSS_SEIDEL : Use Block Gauss Seidel method for imptotal +$ JGS_TERMINATE_DIFFERENCE : Terminate based on the total change of the unweightet sum of wave action +$ JGS_TERMINATE_NORM : Terminate based on the norm of the solution +$ JGS_USE_JACOBI : Use Jacobi solver family +$ JGS_BLOCK_GAUSS_SEIDEL : Use Block Gauss Seidel method for imptotal instead of the conservative jacobi iterator. $ JGS_MAXITER : max. Number of solver iterations $ JGS_PMIN : % of grid points that do not need to converge during solver iteration. $ JGS_DIFF_THR : implicit solver threshold for JGS_TERMINATE_DIFFERENCE $ JGS_NORM_THR : terminate based on the norm of the solution +$ JGS_LIMITER : use total (quasi-steady: limits whole equation) instead of local limiter (un-steady: limits only source terms) +$ JGS_LIMITER_FUNC : 1 - old limiter; 2 - alternatnive limiter $ SETUP_APPLY_WLV : Compute wave setup (experimental) $ SOLVERTHR_SETUP : Solver threshold for setup computations $ CRIT_DEP_SETUP : Critical depths for setup computations diff --git a/model/src/PDLIB/yowexchangeModule.F90 b/model/src/PDLIB/yowexchangeModule.F90 index c6d620ba3..64a37bd54 100644 --- a/model/src/PDLIB/yowexchangeModule.F90 +++ b/model/src/PDLIB/yowexchangeModule.F90 @@ -107,6 +107,9 @@ module yowExchangeModule !> number of the second dimension for exchange integer, public :: n2ndDim = 1 + !> number of the second dimension for exchange (nth only for wave model) + integer, public :: nnthDim = 1 + contains diff --git a/model/src/PDLIB/yowpdlibmain.F90 b/model/src/PDLIB/yowpdlibmain.F90 index 83b828064..cc72b97fd 100644 --- a/model/src/PDLIB/yowpdlibmain.F90 +++ b/model/src/PDLIB/yowpdlibmain.F90 @@ -1309,8 +1309,8 @@ subroutine ComputeTRIA_IEN_SI_CCON use yowNodepool, only: x, y, z, PDLIB_SI, PDLIB_IEN, PDLIB_TRIA, PDLIB_CCON, PDLIB_TRIA03 integer I1, I2, I3, stat, IE, NI(3) - real(rkind) :: DXP1, DXP2, DXP3, DYP1, DYP2, DYP3, DBLTMP, TRIA03 - logical :: CROSSES_DATELINE + real :: DXP1, DXP2, DXP3, DYP1, DYP2, DYP3, DBLTMP, TRIA03 + logical :: CROSSES_DATELINE allocate(PDLIB_SI(npa), PDLIB_CCON(npa), PDLIB_IEN(6,ne), PDLIB_TRIA(ne), PDLIB_TRIA03(ne), stat=stat) if(stat/=0) call parallel_abort('SI allocation failure') @@ -1354,7 +1354,7 @@ subroutine ComputeTRIA_IEN_SI_CCON PDLIB_CCON(I1) = PDLIB_CCON(I1) + 1 PDLIB_CCON(I2) = PDLIB_CCON(I2) + 1 PDLIB_CCON(I3) = PDLIB_CCON(I3) + 1 - TRIA03 = PDLIB_TRIA(IE)/3.d0 + TRIA03 = PDLIB_TRIA(IE)/3.d0 PDLIB_SI(I1) = PDLIB_SI(I1) + TRIA03 PDLIB_SI(I2) = PDLIB_SI(I2) + TRIA03 PDLIB_SI(I3) = PDLIB_SI(I3) + TRIA03 diff --git a/model/src/w3gdatmd.F90 b/model/src/w3gdatmd.F90 index 95a6726d2..6cd6e91d8 100644 --- a/model/src/w3gdatmd.F90 +++ b/model/src/w3gdatmd.F90 @@ -1034,6 +1034,7 @@ MODULE W3GDATMD LOGICAL :: B_JGS_USE_JACOBI LOGICAL :: B_JGS_BLOCK_GAUSS_SEIDEL INTEGER :: B_JGS_MAXITER + INTEGER :: B_JGS_LIMITER_FUNC REAL*8 :: B_JGS_PMIN REAL*8 :: B_JGS_DIFF_THR REAL*8 :: B_JGS_NORM_THR @@ -1388,6 +1389,7 @@ MODULE W3GDATMD LOGICAL, POINTER :: B_JGS_USE_JACOBI LOGICAL, POINTER :: B_JGS_BLOCK_GAUSS_SEIDEL INTEGER, POINTER :: B_JGS_MAXITER + INTEGER, POINTER :: B_JGS_LIMITER_FUNC REAL(8), POINTER :: B_JGS_PMIN REAL(8), POINTER :: B_JGS_DIFF_THR REAL(8), POINTER :: B_JGS_NORM_THR @@ -2805,6 +2807,7 @@ SUBROUTINE W3SETG ( IMOD, NDSE, NDST ) B_JGS_USE_JACOBI => MPARS(IMOD)%SCHMS%B_JGS_USE_JACOBI B_JGS_BLOCK_GAUSS_SEIDEL => MPARS(IMOD)%SCHMS%B_JGS_BLOCK_GAUSS_SEIDEL B_JGS_MAXITER => MPARS(IMOD)%SCHMS%B_JGS_MAXITER + B_JGS_LIMITER_FUNC => MPARS(IMOD)%SCHMS%B_JGS_LIMITER_FUNC B_JGS_PMIN => MPARS(IMOD)%SCHMS%B_JGS_PMIN B_JGS_DIFF_THR => MPARS(IMOD)%SCHMS%B_JGS_DIFF_THR B_JGS_NORM_THR => MPARS(IMOD)%SCHMS%B_JGS_NORM_THR diff --git a/model/src/w3gridmd.F90 b/model/src/w3gridmd.F90 index ec6ebbde2..f0da46318 100644 --- a/model/src/w3gridmd.F90 +++ b/model/src/w3gridmd.F90 @@ -901,6 +901,7 @@ MODULE W3GRIDMD LOGICAL :: JGS_TERMINATE_DIFFERENCE = .TRUE. LOGICAL :: JGS_TERMINATE_NORM = .TRUE. LOGICAL :: JGS_LIMITER = .FALSE. + INTEGER :: JGS_LIMITER_FUNC = 1 LOGICAL :: JGS_BLOCK_GAUSS_SEIDEL = .TRUE. LOGICAL :: JGS_USE_JACOBI = .TRUE. LOGICAL :: JGS_SOURCE_NONLINEAR = .FALSE. @@ -1078,6 +1079,7 @@ MODULE W3GRIDMD JGS_TERMINATE_DIFFERENCE, & JGS_TERMINATE_NORM, & JGS_LIMITER, & + JGS_LIMITER_FUNC, & JGS_USE_JACOBI, & JGS_BLOCK_GAUSS_SEIDEL, & JGS_MAXITER, & @@ -2390,13 +2392,14 @@ SUBROUTINE W3GRID() IMPREFRACTION = .FALSE. IMPFREQSHIFT = .FALSE. IMPSOURCE = .FALSE. - SETUP_APPLY_WLV = .FALSE. - SOLVERTHR_SETUP=1E-14 + SETUP_APPLY_WLV = .TRUE. + SOLVERTHR_SETUP=1E-6 CRIT_DEP_SETUP=0.1 JGS_TERMINATE_MAXITER = .TRUE. JGS_TERMINATE_DIFFERENCE = .TRUE. JGS_TERMINATE_NORM = .FALSE. JGS_LIMITER = .FALSE. + JGS_LIMITER_FUNC = 1 JGS_BLOCK_GAUSS_SEIDEL = .TRUE. JGS_USE_JACOBI = .TRUE. JGS_MAXITER=100 @@ -2413,6 +2416,7 @@ SUBROUTINE W3GRID() B_JGS_TERMINATE_DIFFERENCE = JGS_TERMINATE_DIFFERENCE B_JGS_TERMINATE_NORM = JGS_TERMINATE_NORM B_JGS_LIMITER = JGS_LIMITER + B_JGS_LIMITER_FUNC = JGS_LIMITER_FUNC B_JGS_BLOCK_GAUSS_SEIDEL = JGS_BLOCK_GAUSS_SEIDEL B_JGS_MAXITER = JGS_MAXITER B_JGS_PMIN = JGS_PMIN @@ -3266,6 +3270,7 @@ SUBROUTINE W3GRID() JGS_TERMINATE_DIFFERENCE, & JGS_TERMINATE_NORM, & JGS_LIMITER, & + JGS_LIMITER_FUNC, & JGS_USE_JACOBI, & JGS_BLOCK_GAUSS_SEIDEL, & JGS_MAXITER, & @@ -3600,6 +3605,10 @@ SUBROUTINE W3GRID() FSTOTALEXP = EXPTOTAL PNAME2 = 'N Explicit (Fluctuation Splitting) for one exchange explicit DC HPCF ' END SELECT + + IF (FSTOTALIMP .or. FSTOTALEXP) THEN + LPDLIB = .TRUE. + ENDIF ! IF (SUM(UNSTSCHEMES).GT.1) WRITE(NDSO,1035) WRITE (NDSO,2951) PNAME2 @@ -3628,7 +3637,7 @@ SUBROUTINE W3GRID() END IF IF (SETUP_APPLY_WLV) THEN DO_CHANGE_WLV = SETUP_APPLY_WLV - PNAME2 = ' we change WLV' + PNAME2 = 'Wave setup is added to the WLV' WRITE (NDSO,2952) PNAME2 END IF SOLVERTHR_STP = SOLVERTHR_SETUP @@ -6571,6 +6580,7 @@ SUBROUTINE W3GRID() ', JGS_TERMINATE_DIFFERENCE=', L3, & ', JGS_TERMINATE_NORM=', L3, & ', JGS_LIMITER=', L3, & + ', JGS_LIMITER_FUNC=', I3, & ', JGS_USE_JACOBI=', L3, & ', JGS_BLOCK_GAUSS_SEIDEL=', L3, & ', JGS_MAXITER=', I5, & diff --git a/model/src/w3initmd.F90 b/model/src/w3initmd.F90 index 223034033..3c6907f51 100644 --- a/model/src/w3initmd.F90 +++ b/model/src/w3initmd.F90 @@ -388,7 +388,7 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, ICLOSE, ZB, TRNX, TRNY, DMIN, DTCFL, DTMAX, & FLCK, NK, NTH, NSPEC, SIG, GNAME #ifdef W3_PDLIB - USE W3GDATMD, ONLY : FLCTH + USE W3GDATMD, ONLY : FLCTH, B_JGS_BLOCK_GAUSS_SEIDEL, B_JGS_USE_JACOBI #endif USE W3WDATMD, ONLY: TIME, TLEV, TICE, TRHO, WLV, UST, USTDIR, VA USE W3ODATMD, ONLY: NDSO, NDSE, NDST, SCREEN, NDS, NTPROC, & @@ -421,7 +421,7 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, USE W3GDATMD, ONLY: GTYPE, UNGTYPE #ifdef W3_PDLIB USE PDLIB_W3PROFSMD, ONLY : PDLIB_MAPSTA_INIT, SET_IOBDP_PDLIB, PDLIB_IOBP_INIT, SET_IOBPA_PDLIB - USE PDLIB_W3PROFSMD, ONLY : BLOCK_SOLVER_INIT, PDLIB_INIT, DEALLOCATE_PDLIB_GLOBAL + USE PDLIB_W3PROFSMD, ONLY : BLOCK_SOLVER_INIT, BLOCK_SOLVER_EXPLICIT_INIT, PDLIB_INIT, DEALLOCATE_PDLIB_GLOBAL use yowDatapool, only: istatus #endif #ifdef W3_SETUP @@ -639,12 +639,23 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, IF (FSTOTALIMP .and. .NOT. LPDLIB) THEN WRITE(NDSE,*) 'IMPTOTAL is selected' WRITE(NDSE,*) 'But PDLIB is not' - STOP 'Stop, case 1' + CALL FLUSH(NDSE) + STOP ELSE IF (FSTOTALEXP .and. .NOT. LPDLIB) THEN WRITE(NDSE,*) 'EXPTOTAL is selected' WRITE(NDSE,*) 'But PDLIB is not' - STOP 'Stop, case 1' + CALL FLUSH(NDSE) + STOP END IF +#ifdef W3_PDLIB + IF (B_JGS_BLOCK_GAUSS_SEIDEL .AND. .NOT. B_JGS_USE_JACOBI) THEN + WRITE(NDSE,*) 'B_JGS_BLOCK_GAUSS_SEIDEL is used but the Jacobi solver is not choosen' + WRITE(NDSE,*) 'Please set JGS_USE_JACOBI .eqv. .true.' + CALL FLUSH(NDSE) + STOP + ENDIF +#endif + ! ! 1.c Open files without unpacking MDS ,,, ! @@ -792,17 +803,12 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, #ifdef W3_PDLIB IF ((IAPROC .LE. NAPROC).and.(GTYPE .eq. UNGTYPE)) THEN -#endif - -#ifdef W3_PDLIB CALL BLOCK_SOLVER_INIT(IMOD) CALL PDLIB_IOBP_INIT(IMOD) CALL SET_IOBPA_PDLIB -#endif - -#ifdef W3_PDLIB - ELSE IF (FSTOTALEXP) THEN - !AR: To do here the blocksolver ... + IF (FSTOTALEXP) THEN + CALL BLOCK_SOLVER_EXPLICIT_INIT() + ENDIF ENDIF #endif @@ -1264,6 +1270,10 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, !Li DO IY=1, NY !Li DO IX=1, NX !Li ISEA = MAPFS(IY,IX) +#ifdef W3_DEBUGSTP + max_val = 0 + min_val = 0 +#endif DO ISEA=1, NSEA IX = MAPSF(ISEA,1) IY = MAPSF(ISEA,2) @@ -1276,6 +1286,10 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, IF (DO_CHANGE_WLV) THEN WLVeff=WLVeff + ZETA_SETUP(ISEA) END IF +#endif +#ifdef W3_DEBUGSTP + max_val = MAX(max_val, WLVeff) + min_val = MIN(min_val, WLVeff) #endif DW(ISEA) = MAX ( 0. , WLVeff-ZB(ISEA) ) #ifdef W3_T @@ -1288,6 +1302,12 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, !Li END IF END DO !Li END DO +#ifdef W3_DEBUGSTP + WRITE(740+IAPROC,*) 'w3initmd 1: max/min(WLVeff)=', max_val, min_val + FLUSH(740+IAPROC) + max_val = 0 + min_val = 0 +#endif DO JSEA=1, NSEAL CALL INIT_GET_ISEA(ISEA, JSEA) WLVeff=WLV(ISEA) @@ -1295,12 +1315,20 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, IF (DO_CHANGE_WLV) THEN WLVeff=WLVeff + ZETA_SETUP(ISEA) END IF +#endif +#ifdef W3_DEBUGSTP + max_val = MAX(max_val, WLVeff) + min_val = MIN(min_val, WLVeff) #endif DW(ISEA) = MAX ( 0. , WLVeff-ZB(ISEA) ) IF ( WLVeff-ZB(ISEA) .LE.0. ) THEN VA(:,JSEA) = 0. END IF END DO +#ifdef W3_DEBUGSTP + WRITE(740+IAPROC,*) 'w3initmd 2: max/min(WLVeff)=', max_val, min_val + FLUSH(740+IAPROC) +#endif ! #ifdef W3_PDLIB IF ( IAPROC .LE. NAPROC ) THEN @@ -1353,8 +1381,12 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, ! DO IK=0, NK+1 ! - ! Calculate wavenumbers and group velocities. + ! Calculate wavenumbers and group velocities. +#ifdef W3_PDLIB + CALL WAVNU3(SIG(IK),DEPTH,WN(IK,IS),CG(IK,IS)) +#else CALL WAVNU1(SIG(IK),DEPTH,WN(IK,IS),CG(IK,IS)) +#endif ! #ifdef W3_T1 WRITE (NDST,9052) IK, TPI/SIG(IK), WN(IK,IS), CG(IK,IS) diff --git a/model/src/w3iogomd.F90 b/model/src/w3iogomd.F90 index c8b4b8a04..451192d53 100644 --- a/model/src/w3iogomd.F90 +++ b/model/src/w3iogomd.F90 @@ -1533,7 +1533,7 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) CALL INIT_GET_ISEA(ISEA, JSEA) FACTOR = DDEN(IK) / CG(IK,ISEA) EBD(IK,JSEA) = AB(JSEA) * FACTOR - ET (JSEA) = ET (JSEA) + EBD(IK,JSEA) + ET(JSEA) = ET(JSEA) + EBD(IK,JSEA) #ifdef W3_IG1 IF (IK.EQ.NINT(IGPARS(5))) HSIG(JSEA) = 4*SQRT(ET(JSEA)) #endif diff --git a/model/src/w3iorsmd.F90 b/model/src/w3iorsmd.F90 index b8b657a61..76c2a5cb8 100644 --- a/model/src/w3iorsmd.F90 +++ b/model/src/w3iorsmd.F90 @@ -769,7 +769,8 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ! Include remainder values (switch to record format) ---- * JSEA = NSEAL_MIN + 1 IF ( JSEA.EQ.NSEAL ) THEN - ISEA = IAPROC + (JSEA - 1) * NAPROC + !ISEA = IAPROC + (JSEA - 1) * NAPROC + CALL INIT_GET_ISEA(ISEA, JSEA) NREC = ISEA + 2 RPOS = 1_8 + LRECL*(NREC-1_8) READ (NDSR, POS=RPOS, ERR=802, IOSTAT=IERR) & diff --git a/model/src/w3parall.F90 b/model/src/w3parall.F90 index e9f5a95ca..798e989cb 100644 --- a/model/src/w3parall.F90 +++ b/model/src/w3parall.F90 @@ -1422,6 +1422,7 @@ SUBROUTINE SYNCHRONIZE_GLOBAL_ARRAY(TheVar) use yowDatapool, only: rtype, istatus USE yowNodepool, only: npa use yowNodepool, only: iplg + use yowDatapool, only: rkind #endif IMPLICIT NONE !/ ------------------------------------------------------------------- / @@ -1441,8 +1442,13 @@ SUBROUTINE SYNCHRONIZE_GLOBAL_ARRAY(TheVar) #endif INTEGER ISEA, JSEA, Status(NX), rStatus(NX) INTEGER IPROC, I, ierr, IP, IX, IP_glob - REAL*8, intent(inout) :: TheVar(NX) - REAL*8 rVect(NX) +#ifdef W3_PDLIB + REAL(rkind), intent(inout) :: TheVar(NX) + REAL(rkind) :: rVect(NX) +#else + DOUBLE PRECISION, intent(inout) :: TheVar(NX) + DOUBLE PRECISION :: rVect(NX) +#endif Status=0 #ifdef W3_S CALL STRACE (IENT, 'SYNCHRONIZE_GLOBAL_ARRAY') diff --git a/model/src/w3profsmd.F90 b/model/src/w3profsmd.F90 index ed61eb1c1..b3f004d44 100644 --- a/model/src/w3profsmd.F90 +++ b/model/src/w3profsmd.F90 @@ -677,8 +677,11 @@ SUBROUTINE W3XYPFSN2 ( ISP, C, LCALC, RD10, RD20, DT, AC) U(IP) = MAX(0.d0,U(IP)-DTSI(IP)*ST(IP)*(1-IOBPA(IP)))*DBLE(IOBPD(ITH,IP)) #ifdef W3_REF1 - IF (REFPARS(3).LT.0.5.AND.IOBPD(ITH,IP).EQ.0.AND.IOBPA(IP).EQ.0) U(IP)= AC(IP) ! restores reflected boundary values -#endif + WRITE(10111,*) REFPARS(3), IOBPD(ITH,IP), IOBPA(IP), U(IP), AC(IP) + IF (REFPARS(3).LT.0.5.AND.IOBPD(ITH,IP).EQ.0.AND.IOBPA(IP).EQ.0) THEN + U(IP) = AC(IP) ! restores reflected boundary values + ENDIF +#endif^ END DO ! update spectrum AC = U diff --git a/model/src/w3profsmd_pdlib.F90 b/model/src/w3profsmd_pdlib.F90 index 31558126b..144ace494 100644 --- a/model/src/w3profsmd_pdlib.F90 +++ b/model/src/w3profsmd_pdlib.F90 @@ -116,9 +116,16 @@ MODULE PDLIB_W3PROFSMD REAL, ALLOCATABLE :: CWNB_SIG_M2(:,:) REAL, ALLOCATABLE :: U_JAC(:,:) REAL, ALLOCATABLE :: COFRM4(:) + REAL*8, ALLOCATABLE :: FLALL1(:,:,:), KELEM1(:,:,:) + REAL*8, ALLOCATABLE :: FLALL2(:,:,:), KELEM2(:,:,:) + REAL*8, ALLOCATABLE :: FLALL3(:,:,:), KELEM3(:,:,:) + REAL*8, ALLOCATABLE :: NM(:,:,:), DTSI(:) + INTEGER, ALLOCATABLE :: ITER(:) INTEGER, ALLOCATABLE :: IS0_pdlib(:) INTEGER :: FreqShiftMethod = 2 LOGICAL :: FSGEOADVECT + LOGICAL, SAVE :: LINIT_OUTPUT = .TRUE. + REAL, SAVE :: RTIME = 0.d0 INTEGER :: POS_TRICK(3,2) #ifdef W3_DEBUGSRC @@ -198,6 +205,9 @@ SUBROUTINE PDLIB_INIT(IMOD) USE W3PARALL, only : PDLIB_NSEAL, PDLIB_NSEALM USE W3PARALL, only : JX_TO_JSEA, ISEA_TO_JSEA USE yowfunction, only : ComputeListNP_ListNPA_ListIPLG, pdlib_abort + USE W3GDATMD, only: FSTOTALIMP, FSTOTALEXP, FSNIMP, FSN, FSPSI, FSFCT + USE W3GDATMD, only: FSREFRACTION, FSFREQSHIFT, FSSOURCE + !/ INCLUDE "mpif.h" !/ @@ -235,7 +245,7 @@ SUBROUTINE PDLIB_INIT(IMOD) WRITE(740+IAPROC,*) 'NTPROC=', NTPROC FLUSH(740+IAPROC) #endif - + PDLIB_NSEAL = 0 IF (IAPROC .le. NAPROC) THEN @@ -249,7 +259,11 @@ SUBROUTINE PDLIB_INIT(IMOD) FLUSH(740+IAPROC) #endif ! - CALL initFromGridDim(NX,NTRI,TRIGP,NSPEC,MPI_COMM_WCMP) + IF (FSTOTALEXP) THEN + CALL initFromGridDim(NX,NTRI,TRIGP,NTH,MPI_COMM_WCMP) + ELSE + CALL initFromGridDim(NX,NTRI,TRIGP,NSPEC,MPI_COMM_WCMP) + ENDIF ! #ifdef W3_DEBUGSOLVER WRITE(740+IAPROC,*) 'After initFromGridDim' @@ -748,12 +762,11 @@ SUBROUTINE PDLIB_W3XYPUG ( ISP, FACX, FACY, DTG, VGX, VGY, LCALC ) IP = JSEA IP_glob = iplg(IP) ISEA = MAPFS(1,IP_glob) - !write(*,*) 'IP TEST', JSEA, ISEA, IP, IP_glob #ifdef NOCGTABLE CALL WAVNU_LOCAL(SIG(IK),DW(ISEA),WN1,CG1) AC(IP) = VA(ISP,JSEA) / CG1 * CLATS(ISEA) VLCFLX(IP) = CCOS * CG1 / CLATS(ISEA) - VLCFLY(IP) = CSIN * CG(IK,ISEA) + VLCFLY(IP) = CSIN * CG1 #else AC(IP) = VA(ISP,JSEA) / CG(IK,ISEA) * CLATS(ISEA) VLCFLX(IP) = CCOS * CG(IK,ISEA) / CLATS(ISEA) @@ -764,6 +777,7 @@ SUBROUTINE PDLIB_W3XYPUG ( ISP, FACX, FACY, DTG, VGX, VGY, LCALC ) VLCFLY(IP) = VLCFLY(IP) - CCURY*VGY #endif END DO + #ifdef W3_DEBUGSOLVER WRITE(740+IAPROC,*) 'ISP=', ISP, ' ITH=', ITH, ' IK=', IK WRITE(740+IAPROC,*) '1: maxval(VLCFLX)=', maxval(VLCFLX) @@ -979,6 +993,7 @@ SUBROUTINE PDLIB_W3XYPFSN2(ISP, C, LCALC, RD10, RD20, DT, AC) ITH = 1 + MOD(ISP-1,NTH) IK = 1 + (ISP-1)/NTH DTMAX = DBLE(10.E10) + ! #ifdef W3_REF1 IOBPDR(:)=(1-IOBP_LOC(:))*(1-IOBPD_LOC(ITH,:)) @@ -1053,6 +1068,7 @@ SUBROUTINE PDLIB_W3XYPFSN2(ISP, C, LCALC, RD10, RD20, DT, AC) ITER(IK,ITH) = ABS(NINT(CFLXY)) END IF END IF ! LCALC + #ifdef W3_DEBUGSOLVER WRITE(740+IAPROC,*) 'PDLIB_W3XYPFSN2, step 4' FLUSH(740+IAPROC) @@ -1072,6 +1088,8 @@ SUBROUTINE PDLIB_W3XYPFSN2(ISP, C, LCALC, RD10, RD20, DT, AC) WRITE(740+IAPROC,*) 'ITER=', ITER(IK,ITH) FLUSH(740+IAPROC) #endif + + DO IT = 1, ITER(IK,ITH) #ifdef W3_DEBUGSOLVER WRITE(740+IAPROC,*) 'IK=', IK, ' ITH=', ITH @@ -1223,50 +1241,48 @@ SUBROUTINE PDLIB_W3XYPFSPSI2 ( ISP, C, LCALC, RD10, RD20, DT, AC) ! 10. Source code : ! !/ ------------------------------------------------------------------- / -#ifdef W3_S - USE W3SERVMD, only: STRACE -#endif - ! - USE W3GDATMD, only : NK, NTH, NX, IEN, CLATS, MAPSF, IOBPA, NNZ - USE W3GDATMD, only: IOBP_LOC, IOBPD_LOC, IOBPA_LOC, IOBDP_LOC + + + USE W3GDATMD, only: NK, NTH, NX, IEN, CLATS, MAPSF + USE W3GDATMD, only: IOBPD_LOC, IOBP_LOC, IOBDP_LOC, IOBPA_LOC, FSBCCFL USE W3WDATMD, only: TIME - USE W3ADATMD, only: CG, ITER, CFLXYMAX - USE W3ODATMD, only: NDSE, NDST, FLBPI, NBI, ISBPI, BBPI0, BBPIN + USE W3ADATMD, only: CG, ITER, DW , CFLXYMAX, NSEALM + USE W3ODATMD, only: NDSE, NDST, FLBPI, NBI, TBPIN, ISBPI, BBPI0, BBPIN USE W3TIMEMD, only: DSEC21 - USE W3GDATMD, only: NSEAL, DMIN + USE W3ADATMD, only: MPI_COMM_WCMP + USE W3GDATMD, only: NSEAL, DMIN, NSEA #ifdef W3_REF1 USE W3GDATMD, only: REFPARS #endif - USE W3ADATMD, only: MPI_COMM_WCMP + USE YOWNODEPOOL, only: PDLIB_SI, PDLIB_IEN, PDLIB_TRIA, ipgl, iplg, npa, np use yowElementpool, only: ne, INE - use YOWNODEPOOL, only: PDLIB_IEN, PDLIB_TRIA, PDLIB_SI, iplg, npa - USE W3ODATMD, only : IAPROC use yowDatapool, only: rtype use yowExchangeModule, only : PDLIB_exchange1DREAL + USE W3ODATMD, only : IAPROC USE MPI, only : MPI_MIN USE W3PARALL, only : INIT_GET_JSEA_ISPROC - USE W3PARALL, only : ONESIXTH, THR, ZERO + USE W3PARALL, only : ONESIXTH, ZERO, THR USE yowRankModule, only : IPGL_npa - + IMPLICIT NONE INTEGER, INTENT(IN) :: ISP ! Actual Frequency/Wavenumber, ! actual Wave Direction - REAL, INTENT(IN) :: DT ! Time interval for which the + REAL, INTENT(IN) :: DT ! Time intervall for which the ! advection should be computed ! for the given velocity field - REAL, INTENT(IN) :: C(npa,2) ! Velocity field in its + REAL, INTENT(IN) :: C(npa,2) ! Velocity field in it's ! X- and Y- Components, REAL, INTENT(INOUT) :: AC(npa) ! Wave Action before and ! after advection - REAL, INTENT(IN) :: RD10, RD20 ! Time interpolation + REAL, INTENT(IN) :: RD10, RD20 ! Time interpolation ! coefficients for boundary ! conditions LOGICAL, INTENT(IN) :: LCALC ! Switch for the calculation of ! the max. Global Time step -#ifdef W3_REF1 - INTEGER(KIND=1) :: IOBPDR_LOC(NPA) -#endif #ifdef W3_S INTEGER, SAVE :: IENT = 0 +#endif +#ifdef W3_REF1 + INTEGER(KIND=1) :: IOBPDR(NX) #endif INTEGER :: IP, IE, POS, IT, I1, I2, I3, I, J, ITH, IK INTEGER :: IBI, NI(3), JX @@ -1284,16 +1300,34 @@ SUBROUTINE PDLIB_W3XYPFSPSI2 ( ISP, C, LCALC, RD10, RD20, DT, AC) REAL :: THETA_L(3), BET1(3), BETAHAT(3) REAL :: KELEM(3,NE), FLALL(3,NE) REAL :: KKSUM(npa), ST(npa) - REAL :: NM(NE) + REAL :: NM(NE), FIN(1), FOUT(1) #ifdef W3_S CALL STRACE (IENT, 'W3XYPFSN') #endif +#ifdef W3_DEBUGSOLVER + WRITE(740+IAPROC,*) 'PDLIB_W3XYPFSN2, step 1' + FLUSH(740+IAPROC) + CALL SCAL_INTEGRAL_PRINT_R4(AC, "AC in input") +#endif + ITH = 1 + MOD(ISP-1,NTH) IK = 1 + (ISP-1)/NTH - DTMAX = DBLE(10.E10) + DTMAX = DBLE(10.E10) + ! #ifdef W3_REF1 - IOBPDR_LOC(:)=(1-IOBP_LOC(:))*(1-IOBPD_LOC(ITH,:)) + IOBPDR(:)=(1-IOBP_LOC(:))*(1-IOBPD_LOC(ITH,:)) +#endif + +#ifdef W3_DEBUGSOLVER + WRITE(740+IAPROC,*) 'NX=', NX + WRITE(740+IAPROC,*) 'PDLIB_W3XYPFSN2, step 2' + FLUSH(740+IAPROC) #endif + ! + !2 Propagation + !2.a Calculate K-Values and contour based quantities ... + ! + DO IE = 1, NE I1 = INE(1,IE) I2 = INE(2,IE) @@ -1322,18 +1356,25 @@ SUBROUTINE PDLIB_W3XYPFSPSI2 ( ISP, C, LCALC, RD10, RD20, DT, AC) FLALL(2,IE) = (FL111 + FL312)! * ONESIXTH + KELEM(2,IE) FLALL(3,IE) = (FL211 + FL112)! * ONESIXTH + KELEM(3,IE) END DO + IF (LCALC) THEN KKSUM = ZERO DO IE = 1, NE NI = INE(:,IE) KKSUM(NI) = KKSUM(NI) + KELEM(:,IE) END DO + DTMAXEXP = 1.E10 DO IP = 1, npa - DTMAXEXP = PDLIB_SI(IP)/MAX(DBLE(10.E-10),KKSUM(IP)*IOBDP_LOC(IP)) - DTMAX = MIN( DTMAX, DTMAXEXP) + IP_glob = iplg(IP) + IF (IOBP_LOC(IP) .EQ. 1 .OR. FSBCCFL) THEN + DTMAXEXP = PDLIB_SI(IP)/MAX(DBLE(10.E-10),KKSUM(IP)*IOBDP_LOC(IP)) + DTMAX = MIN( DTMAX, DTMAXEXP) + ENDIF CFLXYMAX(IP) = MAX(CFLXYMAX(IP),DBLE(DT)/DTMAXEXP) - END DO ! IP - CALL MPI_ALLREDUCE(DTMAX,DTMAX_GL,1,rtype,MPI_MIN,MPI_COMM_WCMP,ierr) + END DO + FIN(1)=DTMAX + CALL MPI_ALLREDUCE(FIN,FOUT,1,rtype,MPI_MIN,MPI_COMM_WCMP,ierr) + DTMAX_GL=FOUT(1) CFLXY = DBLE(DT)/DTMAX_GL REST = ABS(MOD(CFLXY,1.0d0)) IF (REST .LT. THR) THEN @@ -1343,16 +1384,20 @@ SUBROUTINE PDLIB_W3XYPFSPSI2 ( ISP, C, LCALC, RD10, RD20, DT, AC) ELSE ITER(IK,ITH) = ABS(NINT(CFLXY)) END IF - END IF + END IF ! LCALC + DO IP = 1, npa DTSI(IP) = DBLE(DT)/DBLE(ITER(IK,ITH))/PDLIB_SI(IP) ! Some precalculations for the time integration. END DO + DO IT = 1, ITER(IK,ITH) - U = DBLE(AC) + + U = DBLE(AC) ST = ZERO + DO IE = 1, NE NI = INE(:,IE) - FT = -ONESIXTH*DOT_PRODUCT(U(NI),FLALL(:,IE)) + FT = - ONESIXTH*DOT_PRODUCT(U(NI),FLALL(:,IE)) UTILDE = NM(IE) * ( DOT_PRODUCT(KELEM(:,IE),U(NI)) - FT ) THETA_L(:) = KELEM(:,IE) * (U(NI) - UTILDE) IF (ABS(FT) .GT. 0.0d0) THEN @@ -1372,6 +1417,12 @@ SUBROUTINE PDLIB_W3XYPFSPSI2 ( ISP, C, LCALC, RD10, RD20, DT, AC) ST(NI) = ST(NI) + THETA_L ! the 2nd term are the theta values of each node ... END DO +#ifdef W3_DEBUGSOLVER + IF (testWrite) THEN + CALL SCAL_INTEGRAL_PRINT_R4(ST, "ST in loop") + END IF +#endif + ! DO IP = 1, npa U(IP) = MAX(ZERO,U(IP)-DTSI(IP)*ST(IP)*(1-IOBPA_LOC(IP)))*IOBPD_LOC(ITH,IP)*IOBDP_LOC(IP) #ifdef W3_REF1 @@ -1404,14 +1455,44 @@ SUBROUTINE PDLIB_W3XYPFSPSI2 ( ISP, C, LCALC, RD10, RD20, DT, AC) IF (JX .gt. 0) THEN AC(JX) = ( RD1*BBPI0(ISP,IBI) + RD2*BBPIN(ISP,IBI) ) & / CG(IK,ISBPI(IBI)) * CLATS(ISBPI(IBI)) +#ifdef W3_DEBUGSOLVER + sumAC=sumAC + AC(JX) + sumBPI0=sumBPI0 + BBPI0(ISP,IBI) + sumBPIN=sumBPIN + BBPIN(ISP,IBI) + sumCG=sumCG + CG(IK,ISBPI(IBI)) + sumCLATS=sumCLATS + CLATS(ISBPI(IBI)) +#endif END IF ENDDO END IF + +#ifdef W3_DEBUGSOLVER + WRITE(740+IAPROC,*) 'NBI=', NBI + WRITE(740+IAPROC,*) 'RD1=', RD1, ' RD2=', RD2 + WRITE(740+IAPROC,*) 'ISP=', ISP, 'sumAC=', sumAC + WRITE(740+IAPROC,*) 'ISP=', ISP, 'sumBPI0=', sumBPI0 + WRITE(740+IAPROC,*) 'ISP=', ISP, 'sumBPIN=', sumBPIN + WRITE(740+IAPROC,*) 'ISP=', ISP, 'sumCG=', sumCG + WRITE(740+IAPROC,*) 'ISP=', ISP, 'sumCLATS=', sumCLATS + FLUSH(740+IAPROC) +#endif CALL PDLIB_exchange1DREAL(AC) + +#ifdef W3_DEBUGSOLVER + IF (testWrite) THEN + CALL SCAL_INTEGRAL_PRINT_R4(AC, "AC after FLBPI") + END IF +#endif END DO ! IT + +#ifdef W3_DEBUGSOLVER + WRITE(740+IAPROC,*) 'PDLIB_W3XYPFSN2, step 6' + FLUSH(740+IAPROC) +#endif + END SUBROUTINE PDLIB_W3XYPFSPSI2 !/ ------------------------------------------------------------------- / - SUBROUTINE TEST_MPI_STATUS(string) + SUBROUTINE PDLIB_W3XYPFSFCT2 ( ISP, C, LCALC, RD10, RD20, DT, AC) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | @@ -1425,7 +1506,7 @@ SUBROUTINE TEST_MPI_STATUS(string) !/ !/ 01-June-2018 : Origination. ( version 6.04 ) !/ - ! 1. Purpose : Check mpi status + ! 1. Purpose : Explicit PSI-Scheme ! 2. Method : ! 3. Parameters : ! @@ -1457,193 +1538,558 @@ SUBROUTINE TEST_MPI_STATUS(string) ! !/ ------------------------------------------------------------------- / - USE W3ADATMD, only : MPI_COMM_WCMP - USE W3GDATMD, only : GTYPE, UNGTYPE - USE W3ODATMD, only : IAPROC, NAPROC, NTPROC - use yowDatapool, only: rtype, istatus - INCLUDE "mpif.h" - CHARACTER(*), INTENT(in) :: string - REAL VcollExp(1) - REAL rVect(1) - INTEGER iProc, ierr - WRITE(740+IAPROC,*) 'TEST_MPI_STATUS, at string=', string - FLUSH(740+IAPROC) - IF (IAPROC .gt. NAPROC) THEN - RETURN - END IF - WRITE(740+IAPROC,*) 'After status settings' - FLUSH(740+IAPROC) - ! - ! Now find global arrays - ! - IF (IAPROC .eq. 1) THEN - DO iProc=2,NAPROC - CALL MPI_RECV(rVect,1,MPI_REAL, iProc-1, 37, MPI_COMM_WCMP, istatus, ierr) - END DO - ELSE - CALL MPI_SEND(VcollExp,1,MPI_REAL, 0, 37, MPI_COMM_WCMP, ierr) - END IF - WRITE(740+IAPROC,*) 'Leaving the TEST_MPI_STATUS' - FLUSH(740+IAPROC) - END SUBROUTINE TEST_MPI_STATUS - !/ ------------------------------------------------------------------- / - !/ ------------ SCALAR FUNCTIONALITY --------------------------------- / - !/ --------------- REAL V(NSEAL) ------------------------------------- / - !/ --------------- NSEAL = npa --------------------------------------- / - !/ ------- maxidx = npa or np for arrays that have been -------------- / - !/ ------- synchronized or not --------------------------------------- / - !/ ------- CheckUncovered is because some the triangulation ---------- / - !/ ------- may not cover all nodes ----------------------------------- / - !/ ------------------------------------------------------------------- / - SUBROUTINE SCAL_INTEGRAL_PRINT_GENERAL(V, string, maxidx, CheckUncovered, PrintFullValue) - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | | - !/ | Aron Roland (BGS IT&E GmbH) | - !/ | Mathieu Dutour-Sikiric (IRB) | - !/ | | - !/ | FORTRAN 90 | - !/ | Last update : 01-June-2018 | - !/ +-----------------------------------+ - !/ - !/ 01-June-2018 : Origination. ( version 6.04 ) - !/ - ! 1. Purpose : Source code for parallel debugging - ! 2. Method : - ! 3. Parameters : - ! - ! Parameter list - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- + USE W3GDATMD, only: NK, NTH, NX, IEN, CLATS, MAPSF + USE W3GDATMD, only: IOBPD_LOC, IOBP_LOC, IOBDP_LOC, IOBPA_LOC, FSBCCFL + USE W3WDATMD, only: TIME + USE W3ADATMD, only: CG, ITER, DW , CFLXYMAX, NSEALM + USE W3ODATMD, only: NDSE, NDST, FLBPI, NBI, TBPIN, ISBPI, BBPI0, BBPIN + USE W3TIMEMD, only: DSEC21 + USE W3ADATMD, only: MPI_COMM_WCMP + USE W3GDATMD, only: NSEAL, DMIN, NSEA +#ifdef W3_REF1 + USE W3GDATMD, only: REFPARS +#endif + USE YOWNODEPOOL, only: PDLIB_SI, PDLIB_IEN, PDLIB_TRIA, PDLIB_CCON, PDLIB_IE_CELL2, ipgl, iplg, npa, np + use yowElementpool, only: ne, INE + use yowDatapool, only: rtype + use yowExchangeModule, only : PDLIB_exchange1DREAL + USE W3ODATMD, only : IAPROC + USE MPI, only : MPI_MIN + USE W3PARALL, only : INIT_GET_JSEA_ISPROC + USE W3PARALL, only : ONESIXTH, ZERO, THR + USE yowRankModule, only : IPGL_npa + + IMPLICIT NONE + INTEGER, INTENT(IN) :: ISP ! Actual Frequency/Wavenumber, + ! actual Wave Direction + REAL, INTENT(IN) :: DT ! Time intervall for which the + ! advection should be computed + ! for the given velocity field + REAL, INTENT(IN) :: C(npa,2) ! Velocity field in it's + ! X- and Y- Components, + REAL, INTENT(INOUT) :: AC(npa) ! Wave Action before and + ! after advection + REAL, INTENT(IN) :: RD10, RD20 ! Time interpolation + ! coefficients for boundary + ! conditions + LOGICAL, INTENT(IN) :: LCALC ! Switch for the calculation of + ! the max. Global Time step +#ifdef W3_S + INTEGER, SAVE :: IENT = 0 +#endif +#ifdef W3_REF1 + INTEGER(KIND=1) :: IOBPDR(NX) +#endif + INTEGER :: IP, IE, POS, IT, I1, I2, I3, I, J, ITH, IK + INTEGER :: IBI, NI(3) + INTEGER :: JX ! - ! 4. Subroutines used : + ! local REAL ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! STRACE Subr. W3SERVMD Subroutine tracing. - ! ---------------------------------------------------------------- + REAL :: RD1, RD2 + !: + ! local double ! - ! 5. Called by : + REAL :: SUMTHETA, CFLXY + REAL*8 :: FT, UTILDE + REAL*8 :: FL11, FL12, FL21, FL22, FL31, FL32 + REAL*8 :: FL111, FL112, FL211, FL212, FL311, FL312 + REAL :: DTSI(npa), U(npa), UL(npa) + REAL :: DTMAX_GL, DTMAX, DTMAXEXP, REST + REAL*8 :: LAMBDA(2), KTMP(3) + REAL*8 :: KELEM(3,NE), FLALL(3,NE) + REAL*8 :: KKSUM(npa), ST(npa) + REAL*8 :: NM(NE), BET1(3), BETAHAT(3), TMP(3), TMP1 + INTEGER :: ISPROC, JSEA, IP_glob, ierr, IX + REAL :: eSumAC, sumAC, sumBPI0, sumBPIN, sumCG, sumCLATS + LOGICAL :: testWrite + REAL :: FIN(1), FOUT(1) + REAL :: UIP(NE), UIPIP(NPA), UIMIP(NPA), U3(3) + REAL*8 :: THETA_H(3), THETA_ACE(3,NE), THETA_L(3,NE) + REAL*8 :: PM(NPA), PP(NPA), UIM(NE), WII(2,NPA) + REAL :: USTARI(2,NPA) + +#ifdef W3_S + CALL STRACE (IENT, 'W3XYPFSN') +#endif +#ifdef W3_DEBUGSOLVER + WRITE(740+IAPROC,*) 'PDLIB_W3XYPFSN2, step 1' + FLUSH(740+IAPROC) + CALL SCAL_INTEGRAL_PRINT_R4(AC, "AC in input") +#endif + + ITH = 1 + MOD(ISP-1,NTH) + IK = 1 + (ISP-1)/NTH + DTMAX = DBLE(10.E10) ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- +#ifdef W3_REF1 + IOBPDR(:)=(1-IOBP_LOC(:))*(1-IOBPD_LOC(ITH,:)) +#endif + +#ifdef W3_DEBUGSOLVER + WRITE(740+IAPROC,*) 'NX=', NX + WRITE(740+IAPROC,*) 'PDLIB_W3XYPFSN2, step 2' + FLUSH(740+IAPROC) +#endif ! - ! 6. Error messages : - ! 7. Remarks - ! 8. Structure : - ! 9. Switches : + !2 Propagation + !2.a Calculate K-Values and contour based quantities ... ! - ! !/S Enable subroutine tracing. - ! - ! 10. Source code : - ! - !/ ------------------------------------------------------------------- / - ! - USE W3GDATMD, only : NK, NTH, FTE - USE W3GDATMD, only : NSPEC, NX, NY, NSEAL, MAPFS - USE W3ADATMD, only : MPI_COMM_WCMP - USE W3GDATMD, only : GTYPE, UNGTYPE - USE W3ODATMD, only : IAPROC, NAPROC, NTPROC - use yowDatapool, only: rtype, istatus - USE YOWNODEPOOL, only: npa, iplg - USE W3PARALL, only: INIT_GET_ISEA - INCLUDE "mpif.h" - ! - REAL*8, INTENT(in) :: V(NSEAL) - CHARACTER(*), INTENT(in) :: string - INTEGER, INTENT(IN) :: maxidx - LOGICAL, INTENT(in) :: CheckUncovered - LOGICAL, INTENT(in) :: PrintFullValue - ! - REAL*8, allocatable :: Vcoll(:) - INTEGER, allocatable :: Status(:) - REAL*8, allocatable :: ListVal(:) - INTEGER, allocatable :: ListIdx(:) - INTEGER singV(2) - REAL CoherencyError, eVal1, eVal2, eErr - INTEGER NSEAL_dist, maxidx_dist - INTEGER JSEA, ISEA, iProc, I, IX, ierr, ISP, IP, IP_glob - INTEGER nbIncorr, idx - INTEGER ITH, IK + DO IE = 1, ne + I1 = INE(1,IE) + I2 = INE(2,IE) + I3 = INE(3,IE) + LAMBDA(1) = ONESIXTH *(C(I1,1)+C(I2,1)+C(I3,1)) ! Linearized advection speed in X and Y direction + LAMBDA(2) = ONESIXTH *(C(I1,2)+C(I2,2)+C(I3,2)) + KELEM(1,IE) = LAMBDA(1) * PDLIB_IEN(1,IE) + LAMBDA(2) * PDLIB_IEN(2,IE) ! K-Values - so called Flux Jacobians + KELEM(2,IE) = LAMBDA(1) * PDLIB_IEN(3,IE) + LAMBDA(2) * PDLIB_IEN(4,IE) + KELEM(3,IE) = LAMBDA(1) * PDLIB_IEN(5,IE) + LAMBDA(2) * PDLIB_IEN(6,IE) + KTMP = KELEM(:,IE) ! Copy + NM(IE) = - 1.D0/MIN(-THR,SUM(MIN(ZERO,KTMP))) ! N-Values + KELEM(:,IE) = MAX(ZERO,KTMP) + FL11 = C(I2,1) * PDLIB_IEN(1,IE) + C(I2,2) * PDLIB_IEN(2,IE) ! Weights for Simpson Integration + FL12 = C(I3,1) * PDLIB_IEN(1,IE) + C(I3,2) * PDLIB_IEN(2,IE) + FL21 = C(I3,1) * PDLIB_IEN(3,IE) + C(I3,2) * PDLIB_IEN(4,IE) + FL22 = C(I1,1) * PDLIB_IEN(3,IE) + C(I1,2) * PDLIB_IEN(4,IE) + FL31 = C(I1,1) * PDLIB_IEN(5,IE) + C(I1,2) * PDLIB_IEN(6,IE) + FL32 = C(I2,1) * PDLIB_IEN(5,IE) + C(I2,2) * PDLIB_IEN(6,IE) + FL111 = 2.d0*FL11+FL12 + FL112 = 2.d0*FL12+FL11 + FL211 = 2.d0*FL21+FL22 + FL212 = 2.d0*FL22+FL21 + FL311 = 2.d0*FL31+FL32 + FL312 = 2.d0*FL32+FL31 + FLALL(1,IE) = (FL311 + FL212)! * ONESIXTH + KELEM(1,IE) + FLALL(2,IE) = (FL111 + FL312)! * ONESIXTH + KELEM(2,IE) + FLALL(3,IE) = (FL211 + FL112)! * ONESIXTH + KELEM(3,IE) + END DO - IF (IAPROC .gt. NAPROC) THEN - RETURN - END IF - IF (GTYPE .ne. UNGTYPE) THEN - RETURN - END IF - ! - ! Now find global arrays - ! - IF (IAPROC .eq. 1) THEN - CoherencyError=0 - allocate(Vcoll(NX), Status(NX)) - Vcoll=0 - Status=0 - DO JSEA=1,maxidx - IP = JSEA - IP_glob = iplg(IP) - ISEA=MAPFS(1,IP_glob) - Vcoll(IP_glob)=V(JSEA) - Status(IP_glob)=1 + IF (LCALC) THEN + KKSUM = ZERO + DO IE = 1, NE + NI = INE(:,IE) + KKSUM(NI) = KKSUM(NI) + KELEM(:,IE) END DO - DO iProc=2,NAPROC - CALL MPI_RECV(singV,2,MPI_INTEGER, iProc-1, 360, MPI_COMM_WCMP, istatus, ierr) - NSEAL_dist = singV(1) - maxidx_dist = singV(2) - allocate(ListVal(NSEAL_dist), ListIdx(NSEAL_dist)) - CALL MPI_RECV(ListVal, NSEAL_dist, MPI_REAL8, iProc-1, 370, MPI_COMM_WCMP, istatus, ierr) - CALL MPI_RECV(ListIdx, NSEAL_dist, MPI_INTEGER, iProc-1, 430, MPI_COMM_WCMP, istatus, ierr) - DO idx=1,maxidx_dist - IP_glob = ListIdx(idx) - eVal1 = Vcoll(IP_glob) - eVal2 = ListVal(idx) - Vcoll(IP_glob) = eVal2 - IF (Status(IP_glob) .eq. 1) THEN - eErr=abs(eVal1 - eVal2) - CoherencyError = CoherencyError + eErr - END IF - Status(IP_glob) = 1 - END DO - deallocate(ListVal, ListIdx) + DTMAXEXP = 1.E10 + DO IP = 1, np + IP_glob = iplg(IP) + IF (IOBP_LOC(IP) .EQ. 1 .OR. FSBCCFL) THEN + DTMAXEXP = PDLIB_SI(IP)/MAX(DBLE(10.E-10),KKSUM(IP)*IOBDP_LOC(IP)) + DTMAX = MIN( DTMAX, DTMAXEXP) + ENDIF + CFLXYMAX(IP) = MAX(CFLXYMAX(IP),DBLE(DT)/DTMAXEXP) END DO - WRITE(740+IAPROC,'(a,f14.7,f14.7,a,a)') 'sum,coh=', sum(Vcoll), CoherencyError, ' ', TRIM(string) - nbIncorr=0 - DO IX=1,NX - ISEA=MAPFS(1,IX) - IF (ISEA .gt. 0) THEN - IF (Status(IX) .eq. 0) THEN - nbIncorr=nbIncorr+1 + FIN(1)=DTMAX + CALL MPI_ALLREDUCE(FIN,FOUT,1,rtype,MPI_MIN,MPI_COMM_WCMP,ierr) + DTMAX_GL=FOUT(1) + CFLXY = DBLE(DT)/DTMAX_GL + REST = ABS(MOD(CFLXY,1.0d0)) + IF (REST .LT. THR) THEN + ITER(IK,ITH) = ABS(NINT(CFLXY)) + ELSE IF (REST .GT. THR .AND. REST .LT. 0.5d0) THEN + ITER(IK,ITH) = ABS(NINT(CFLXY)) + 1 + ELSE + ITER(IK,ITH) = ABS(NINT(CFLXY)) + END IF + END IF ! LCALC + + DO IP = 1, npa + DTSI(IP) = DBLE(DT)/DBLE(ITER(IK,ITH))/PDLIB_SI(IP) ! Some precalculations for the time integration. + END DO + + DO IT = 1, ITER(IK,ITH) + + U = DBLE(AC) + ST = ZERO + PM = ZERO + PP = ZERO + DO IE = 1, NE + NI = INE(:,IE) + FT = - ONESIXTH*DOT_PRODUCT(U(NI),FLALL(:,IE)) + UTILDE = NM(IE) * ( DOT_PRODUCT(KELEM(:,IE),U(NI)) - FT ) + THETA_L(:,IE) = KELEM(:,IE) * (U(NI) - UTILDE) + IF (ABS(FT) .GT. 0.0d0) THEN + BET1(:) = THETA_L(:,IE)/FT + IF (ANY( BET1 .LT. 0.0d0) ) THEN + BETAHAT(1) = BET1(1) + 0.5d0 * BET1(2) + BETAHAT(2) = BET1(2) + 0.5d0 * BET1(3) + BETAHAT(3) = BET1(3) + 0.5d0 * BET1(1) + BET1(1) = MAX(ZERO,MIN(BETAHAT(1),1.d0-BETAHAT(2),1.d0)) + BET1(2) = MAX(ZERO,MIN(BETAHAT(2),1.d0-BETAHAT(3),1.d0)) + BET1(3) = MAX(ZERO,MIN(BETAHAT(3),1.d0-BETAHAT(1),1.d0)) + THETA_L(:,IE) = FT * BET1 END IF END IF + ST(NI) = ST(NI) + THETA_L(:,IE) ! the 2nd term are the theta values of each node ... + THETA_H = (1./3.+DT/(2.*PDLIB_TRIA(IE)) * KELEM(:,IE) ) * FT ! LAX +! THETA_H = (1./3.+2./3.*KELEM(:,IE)/SUM(MAX(ZERO,KELEM(:,IE))))*FT ! CENTRAL ... can be tested as well a bit more dispersive then LAX + THETA_ACE(:,IE) = THETA_H-THETA_L(:,IE) + PP(NI) = PP(NI) + MAX(ZERO, -THETA_ACE(:,IE)) * DTSI(NI) + PM(NI) = PM(NI) + MIN(ZERO, -THETA_ACE(:,IE)) * DTSI(NI) END DO - IF (CheckUncovered) THEN - IF (nbIncorr .gt. 0) THEN - WRITE(*,*) ' nbIncorr=', nbIncorr - WRITE(*,*) ' NX=', NX - WRITE(*,*) ' NSEAL=', NSEAL - WRITE(*,*) ' npa=', npa - STOP + +#ifdef W3_DEBUGSOLVER + IF (testWrite) THEN + CALL SCAL_INTEGRAL_PRINT_R4(ST, "ST in loop") + END IF +#endif + + DO IP = 1, npa + UL(IP) = MAX(ZERO,U(IP)-DTSI(IP)*ST(IP)*(1-IOBPA_LOC(IP)))*DBLE(IOBPD_LOC(ITH,IP))*IOBDP_LOC(IP) + END DO + +#ifdef MPI_PARALL_GRID + CALL PDLIB_exchange1DREAL(UL) +#endif + + USTARI(1,:) = MAX(UL,U) + USTARI(2,:) = MIN(UL,U) + + UIP = 0. + UIM = 0. + DO IE = 1, NE + NI = INE(:,IE) + UIP(NI) = MAX (UIP(NI), MAXVAL( USTARI(1,NI) )) + UIM(NI) = MIN (UIM(NI), MINVAL( USTARI(2,NI) )) + END DO + + WII(1,:) = MIN(1.0d0,(UIP-UL)/MAX( THR,PP)) + WII(2,:) = MIN(1.0d0,(UIM-UL)/MIN(-THR,PM)) + + ST = ZERO + DO IE = 1, NE + I1 = INE(1,IE) + I2 = INE(2,IE) + I3 = INE(3,IE) + IF (THETA_ACE(1,IE) .LT. ZERO) THEN + TMP(1) = WII(1,I1) + ELSE + TMP(1) = WII(2,I1) + END IF + IF (THETA_ACE(2,IE) .LT. ZERO) THEN + TMP(2) = WII(1,I2) + ELSE + TMP(2) = WII(2,I2) + END IF + IF (THETA_ACE(3,IE) .LT. ZERO) THEN + TMP(3) = WII(1,I3) + ELSE + TMP(3) = WII(2,I3) END IF + TMP1 = MINVAL(TMP) + ST(I1) = ST(I1) + THETA_ACE(1,IE) * TMP1! * (ONE - BL) + BL * THETA_L(1,IE) + ST(I2) = ST(I2) + THETA_ACE(2,IE) * TMP1! * (ONE - BL) + BL * THETA_L(2,IE) + ST(I3) = ST(I3) + THETA_ACE(3,IE) * TMP1! * (ONE - BL) + BL * THETA_L(3,IE) + END DO + + DO IP = 1, npa + U(IP) = MAX(ZERO,UL(IP)-DTSI(IP)*ST(IP)*(1-IOBPA_LOC(IP)))*DBLE(IOBPD_LOC(ITH,IP))*IOBDP_LOC(IP) +#ifdef W3_REF1 + IF (REFPARS(3).LT.0.5.AND.IOBPD_LOC(ITH,IP).EQ.0.AND.IOBPA_LOC(IP).EQ.0) U(IP) = AC(IP) ! restores reflected boundary values +#endif + END DO + + AC = REAL(U) + +#ifdef W3_DEBUGSOLVER + IF (testWrite) THEN + CALL SCAL_INTEGRAL_PRINT_R4(AC, "AC in loop") END IF - IF (PrintFullValue) THEN - WRITE(740+IAPROC,*) 'Value of V at nodes' - DO IX=1,NX - WRITE(740+IAPROC,*) 'IX=', IX, ' V=', Vcoll(IX) +#endif + ! + ! 5 Update boundaries ... would be better to omit any if clause in this loop ... + ! a possibility would be to use NBI = 0 when FLBPI is FALSE and loop on IBI whatever the value of NBI + ! + IF ( FLBPI ) THEN + RD1=RD10 - DT * REAL(ITER(IK,ITH)-IT)/REAL(ITER(IK,ITH)) + RD2=RD20 + IF ( RD2 .GT. 0.001 ) THEN + RD2 = MIN(1.,MAX(0.,RD1/RD2)) + RD1 = 1. - RD2 + ELSE + RD1 = 0. + RD2 = 1. + END IF +#ifdef W3_DEBUGSOLVER + sumAC=0 + sumBPI0=0 + sumBPIN=0 + sumCG=0 + sumCLATS=0 +#endif + DO IBI = 1, NBI + IP_glob = MAPSF(ISBPI(IBI),1) + JX=IPGL_npa(IP_glob) + IF (JX .gt. 0) THEN + AC(JX) = ( RD1*BBPI0(ISP,IBI) + RD2*BBPIN(ISP,IBI) ) & + / CG(IK,ISBPI(IBI)) * CLATS(ISBPI(IBI)) +#ifdef W3_DEBUGSOLVER + sumAC=sumAC + AC(JX) + sumBPI0=sumBPI0 + BBPI0(ISP,IBI) + sumBPIN=sumBPIN + BBPIN(ISP,IBI) + sumCG=sumCG + CG(IK,ISBPI(IBI)) + sumCLATS=sumCLATS + CLATS(ISBPI(IBI)) +#endif + END IF END DO END IF + +#ifdef W3_DEBUGSOLVER + WRITE(740+IAPROC,*) 'NBI=', NBI + WRITE(740+IAPROC,*) 'RD1=', RD1, ' RD2=', RD2 + WRITE(740+IAPROC,*) 'ISP=', ISP, 'sumAC=', sumAC + WRITE(740+IAPROC,*) 'ISP=', ISP, 'sumBPI0=', sumBPI0 + WRITE(740+IAPROC,*) 'ISP=', ISP, 'sumBPIN=', sumBPIN + WRITE(740+IAPROC,*) 'ISP=', ISP, 'sumCG=', sumCG + WRITE(740+IAPROC,*) 'ISP=', ISP, 'sumCLATS=', sumCLATS FLUSH(740+IAPROC) - deallocate(Vcoll, Status) - ELSE - singV(1) = NSEAL - singV(2) = maxidx - CALL MPI_SEND(singV,2,MPI_INTEGER, 0, 360, MPI_COMM_WCMP, ierr) - allocate(ListVal(NSEAL), ListIdx(NSEAL)) - DO JSEA=1,NSEAL +#endif + CALL PDLIB_exchange1DREAL(AC) + +#ifdef W3_DEBUGSOLVER + IF (testWrite) THEN + CALL SCAL_INTEGRAL_PRINT_R4(AC, "AC after FLBPI") + END IF +#endif + END DO ! IT + +#ifdef W3_DEBUGSOLVER + WRITE(740+IAPROC,*) 'PDLIB_W3XYPFSN2, step 6' + FLUSH(740+IAPROC) +#endif + + END SUBROUTINE PDLIB_W3XYPFSFCT2 +!/ ------------------------------------------------------------------- / + + SUBROUTINE TEST_MPI_STATUS(string) + !/ + !/ +-----------------------------------+ + !/ | WAVEWATCH III NOAA/NCEP | + !/ | | + !/ | Aron Roland (BGS IT&E GmbH) | + !/ | Mathieu Dutour-Sikiric (IRB) | + !/ | | + !/ | FORTRAN 90 | + !/ | Last update : 01-June-2018 | + !/ +-----------------------------------+ + !/ + !/ 01-June-2018 : Origination. ( version 6.04 ) + !/ + ! 1. Purpose : Check mpi status + ! 2. Method : + ! 3. Parameters : + ! + ! Parameter list + ! ---------------------------------------------------------------- + ! ---------------------------------------------------------------- + ! + ! 4. Subroutines used : + ! + ! Name Type Module Description + ! ---------------------------------------------------------------- + ! STRACE Subr. W3SERVMD Subroutine tracing. + ! ---------------------------------------------------------------- + ! + ! 5. Called by : + ! + ! Name Type Module Description + ! ---------------------------------------------------------------- + ! ---------------------------------------------------------------- + ! + ! 6. Error messages : + ! 7. Remarks + ! 8. Structure : + ! 9. Switches : + ! + ! !/S Enable subroutine tracing. + ! + ! 10. Source code : + ! + !/ ------------------------------------------------------------------- / + + USE W3ADATMD, only : MPI_COMM_WCMP + USE W3GDATMD, only : GTYPE, UNGTYPE + USE W3ODATMD, only : IAPROC, NAPROC, NTPROC + use yowDatapool, only: rtype, istatus + + INCLUDE "mpif.h" + CHARACTER(*), INTENT(in) :: string + REAL VcollExp(1) + REAL rVect(1) + INTEGER iProc, ierr + WRITE(740+IAPROC,*) 'TEST_MPI_STATUS, at string=', string + FLUSH(740+IAPROC) + IF (IAPROC .gt. NAPROC) THEN + RETURN + END IF + WRITE(740+IAPROC,*) 'After status settings' + FLUSH(740+IAPROC) + ! + ! Now find global arrays + ! + IF (IAPROC .eq. 1) THEN + DO iProc=2,NAPROC + CALL MPI_RECV(rVect,1,MPI_REAL, iProc-1, 37, MPI_COMM_WCMP, istatus, ierr) + END DO + ELSE + CALL MPI_SEND(VcollExp,1,MPI_REAL, 0, 37, MPI_COMM_WCMP, ierr) + END IF + WRITE(740+IAPROC,*) 'Leaving the TEST_MPI_STATUS' + FLUSH(740+IAPROC) + END SUBROUTINE TEST_MPI_STATUS +!/ ------------------------------------------------------------------- / + + SUBROUTINE SCAL_INTEGRAL_PRINT_GENERAL(V, string, maxidx, CheckUncovered, PrintFullValue) + !/ + !/ +-----------------------------------+ + !/ | WAVEWATCH III NOAA/NCEP | + !/ | | + !/ | Aron Roland (BGS IT&E GmbH) | + !/ | Mathieu Dutour-Sikiric (IRB) | + !/ | | + !/ | FORTRAN 90 | + !/ | Last update : 01-June-2018 | + !/ +-----------------------------------+ + !/ + !/ 01-June-2018 : Origination. ( version 6.04 ) + !/ + ! 1. Purpose : Source code for parallel debugging + ! 2. Method : maxidx = npa or np for arrays that have been synchronized or not + ! CheckUncovered is because some the triangulation may not cover all nodes + ! 3. Parameters : + ! + ! Parameter list + ! ---------------------------------------------------------------- + ! ---------------------------------------------------------------- + ! + ! 4. Subroutines used : + ! + ! Name Type Module Description + ! ---------------------------------------------------------------- + ! STRACE Subr. W3SERVMD Subroutine tracing. + ! ---------------------------------------------------------------- + ! + ! 5. Called by : + ! + ! Name Type Module Description + ! ---------------------------------------------------------------- + ! ---------------------------------------------------------------- + ! + ! 6. Error messages : + ! 7. Remarks + ! 8. Structure : + ! 9. Switches : + ! + ! !/S Enable subroutine tracing. + ! + ! 10. Source code : + ! + !/ ------------------------------------------------------------------- / + ! + USE W3GDATMD, only : NK, NTH, FTE + USE W3GDATMD, only : NSPEC, NX, NY, NSEAL, MAPFS + USE W3ADATMD, only : MPI_COMM_WCMP + USE W3GDATMD, only : GTYPE, UNGTYPE + USE W3ODATMD, only : IAPROC, NAPROC, NTPROC + use yowDatapool, only: rtype, istatus + USE YOWNODEPOOL, only: npa, iplg + USE W3PARALL, only: INIT_GET_ISEA + + INCLUDE "mpif.h" + ! + REAL*8, INTENT(in) :: V(NSEAL) + CHARACTER(*), INTENT(in) :: string + INTEGER, INTENT(IN) :: maxidx + LOGICAL, INTENT(in) :: CheckUncovered + LOGICAL, INTENT(in) :: PrintFullValue + ! + REAL*8, allocatable :: Vcoll(:) + INTEGER, allocatable :: Status(:) + REAL*8, allocatable :: ListVal(:) + INTEGER, allocatable :: ListIdx(:) + INTEGER singV(2) + REAL CoherencyError, eVal1, eVal2, eErr + INTEGER NSEAL_dist, maxidx_dist + INTEGER JSEA, ISEA, iProc, I, IX, ierr, ISP, IP, IP_glob + INTEGER nbIncorr, idx + INTEGER ITH, IK + + IF (IAPROC .gt. NAPROC) THEN + RETURN + END IF + IF (GTYPE .ne. UNGTYPE) THEN + RETURN + END IF + ! + ! Now find global arrays + ! + IF (IAPROC .eq. 1) THEN + CoherencyError=0 + allocate(Vcoll(NX), Status(NX)) + Vcoll=0 + Status=0 + DO JSEA=1,maxidx + IP = JSEA + IP_glob = iplg(IP) + ISEA=MAPFS(1,IP_glob) + Vcoll(IP_glob)=V(JSEA) + Status(IP_glob)=1 + END DO + DO iProc=2,NAPROC + CALL MPI_RECV(singV,2,MPI_INTEGER, iProc-1, 360, MPI_COMM_WCMP, istatus, ierr) + NSEAL_dist = singV(1) + maxidx_dist = singV(2) + allocate(ListVal(NSEAL_dist), ListIdx(NSEAL_dist)) + CALL MPI_RECV(ListVal, NSEAL_dist, MPI_REAL8, iProc-1, 370, MPI_COMM_WCMP, istatus, ierr) + CALL MPI_RECV(ListIdx, NSEAL_dist, MPI_INTEGER, iProc-1, 430, MPI_COMM_WCMP, istatus, ierr) + DO idx=1,maxidx_dist + IP_glob = ListIdx(idx) + eVal1 = Vcoll(IP_glob) + eVal2 = ListVal(idx) + Vcoll(IP_glob) = eVal2 + IF (Status(IP_glob) .eq. 1) THEN + eErr=abs(eVal1 - eVal2) + CoherencyError = CoherencyError + eErr + END IF + Status(IP_glob) = 1 + END DO + deallocate(ListVal, ListIdx) + END DO + WRITE(740+IAPROC,'(a,f14.7,f14.7,a,a)') 'sum,coh=', sum(Vcoll), CoherencyError, ' ', TRIM(string) + nbIncorr=0 + DO IX=1,NX + ISEA=MAPFS(1,IX) + IF (ISEA .gt. 0) THEN + IF (Status(IX) .eq. 0) THEN + nbIncorr=nbIncorr+1 + END IF + END IF + END DO + IF (CheckUncovered) THEN + IF (nbIncorr .gt. 0) THEN + WRITE(*,*) ' nbIncorr=', nbIncorr + WRITE(*,*) ' NX=', NX + WRITE(*,*) ' NSEAL=', NSEAL + WRITE(*,*) ' npa=', npa + STOP + END IF + END IF + IF (PrintFullValue) THEN + WRITE(740+IAPROC,*) 'Value of V at nodes' + DO IX=1,NX + WRITE(740+IAPROC,*) 'IX=', IX, ' V=', Vcoll(IX) + END DO + END IF + FLUSH(740+IAPROC) + deallocate(Vcoll, Status) + ELSE + singV(1) = NSEAL + singV(2) = maxidx + CALL MPI_SEND(singV,2,MPI_INTEGER, 0, 360, MPI_COMM_WCMP, ierr) + allocate(ListVal(NSEAL), ListIdx(NSEAL)) + DO JSEA=1,NSEAL IP = JSEA IP_glob = iplg(IP) ISEA=MAPFS(1,IP_glob) @@ -2201,375 +2647,92 @@ SUBROUTINE CHECK_ARRAY_INTEGRAL_NX_R8_MaxFunct(TheARR, string, maxidx, PrintMinI DO ISP=1,NSPEC eVal = abs(Vcoll(ISP, IP)) IF (eVal .gt. Threshold) THEN - WRITE(740+IAPROC,*) 'ISP/IP/val=', ISP, IP, eVal - END IF - END DO - END DO - FLUSH(740+IAPROC) - END IF - END IF - END SUBROUTINE CHECK_ARRAY_INTEGRAL_NX_R8_MaxFunct - !/ ------------------------------------------------------------------- / - !* maxidx should be "np" or "npa" * - SUBROUTINE CHECK_ARRAY_INTEGRAL_NX_R8(TheARR, string, maxidx) - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | | - !/ | Aron Roland (BGS IT&E GmbH) | - !/ | Mathieu Dutour-Sikiric (IRB) | - !/ | | - !/ | FORTRAN 90 | - !/ | Last update : 01-June-2018 | - !/ +-----------------------------------+ - !/ - !/ 01-June-2018 : Origination. ( version 6.04 ) - !/ - ! 1. Purpose : Source code for parallel debugging - ! 2. Method : - ! 3. Parameters : - ! - ! Parameter list - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 4. Subroutines used : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! STRACE Subr. W3SERVMD Subroutine tracing. - ! ---------------------------------------------------------------- - ! - ! 5. Called by : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 6. Error messages : - ! 7. Remarks - ! 8. Structure : - ! 9. Switches : - ! - ! !/S Enable subroutine tracing. - ! - ! 10. Source code : - ! - !/ ------------------------------------------------------------------- / - - USE W3GDATMD, only : NSPEC - USE YOWNODEPOOL, only: npa - CHARACTER(*), INTENT(in) :: string - INTEGER, INTENT(in) :: maxidx - REAL, INTENT(in) :: TheARR(NSPEC, npa) - REAL*8 :: TheARR_red(npa) - ! LOGICAL :: FULL_NSPEC = .FALSE. - ! LOGICAL :: PrintMinISP = .FALSE. - ! LOGICAL :: LocalizeMaximum = .FALSE. - ! LOGICAL :: CheckUncovered = .FALSE. - ! LOGICAL :: PrintFullValue = .FALSE. - LOGICAL :: FULL_NSPEC = .TRUE. - LOGICAL :: PrintMinISP = .TRUE. - LOGICAL :: LocalizeMaximum = .TRUE. - LOGICAL :: CheckUncovered = .TRUE. - LOGICAL :: PrintFullValue = .TRUE. - integer :: ip - - IF (FULL_NSPEC) THEN - CALL CHECK_ARRAY_INTEGRAL_NX_R8_MaxFunct(TheARR, string, maxidx, PrintMinISP, LocalizeMaximum) - ELSE - DO IP=1,npa - TheARR_red(IP) = SUM(ABS(TheArr(:,IP))) - END DO - CALL SCAL_INTEGRAL_PRINT_GENERAL(TheARR_red, string, maxidx, CheckUncovered, PrintFullValue) - END IF - END SUBROUTINE CHECK_ARRAY_INTEGRAL_NX_R8 - !/ ------------------------------------------------------------------- / - SUBROUTINE PDLIB_W3XYPFSFCT2 ( ISP, C, LCALC, RD10, RD20, DT, AC) - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | | - !/ | Aron Roland (BGS IT&E GmbH) | - !/ | Mathieu Dutour-Sikiric (IRB) | - !/ | | - !/ | FORTRAN 90 | - !/ | Last update : 01-June-2018 | - !/ +-----------------------------------+ - !/ - !/ 01-June-2018 : Origination. ( version 6.04 ) - !/ - ! 1. Purpose : Explicit LF-FCT scheme - ! 2. Method : - ! 3. Parameters : - ! - ! Parameter list - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 4. Subroutines used : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! STRACE Subr. W3SERVMD Subroutine tracing. - ! ---------------------------------------------------------------- - ! - ! 5. Called by : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 6. Error messages : - ! 7. Remarks - ! 8. Structure : - ! 9. Switches : - ! - ! !/S Enable subroutine tracing. - ! - ! 10. Source code : - ! - !/ ------------------------------------------------------------------- / -#ifdef W3_S - USE W3SERVMD, only: STRACE -#endif - ! - USE W3GDATMD, only :NK, NTH, NX, IEN, CLATS, MAPSF, TRIA - USE W3GDATMD, only: IOBP_LOC, IOBPD_LOC, IOBPA_LOC, IOBDP_LOC - USE W3WDATMD, only: TIME - USE W3ADATMD, only: CG, ITER, CFLXYMAX - USE W3ODATMD, only: NDSE, NDST, FLBPI, NBI, ISBPI, BBPI0, BBPIN - USE W3TIMEMD, only: DSEC21 - USE W3GDATMD, only: NSEAL, IOBPA -#ifdef W3_REF1 - USE W3GDATMD, only: REFPARS -#endif - USE W3ADATMD, only: MPI_COMM_WCMP - use yowElementpool, only: ne, INE - use YOWNODEPOOL, only: PDLIB_SI, PDLIB_IEN, PDLIB_TRIA - use YOWNODEPOOL, only: iplg, npa - use yowDatapool, only: rtype - USE W3ODATMD, only : IAPROC - USE MPI, only : MPI_MIN - USE W3PARALL, only : INIT_GET_JSEA_ISPROC, ONESIXTH, ZERO - USE W3PARALL, only : THR - use yowExchangeModule, only : PDLIB_exchange1DREAL - USE yowRankModule, only : IPGL_npa - - INTEGER, INTENT(IN) :: ISP ! Actual Frequency/Wavenumber, - ! actual Wave Direction - REAL, INTENT(IN) :: DT ! Time intervall for which the - ! advection should be computed - ! for the given velocity field - REAL, INTENT(IN) :: C(npa,2) ! Velocity field in its - ! X- and Y- Components, - REAL, INTENT(INOUT) :: AC(npa) ! Wave Action before and after - ! advection - REAL, INTENT(IN) :: RD10, RD20 ! Time interpolation - ! coefficients for boundary - ! condition - LOGICAL, INTENT(IN) :: LCALC ! Switch for the calculation of - ! the max. Global Time step - INTEGER :: IP, IE, POS, IT, I1, I2, I3, I, J, ITH, IK - INTEGER :: IBI, NI(3), JX - REAL :: RD1, RD2 - REAL :: UTILDE - REAL :: SUMTHETA - REAL :: FL1, FL2, FL3 - REAL :: FT, CFLXY - REAL :: FL11, FL12, FL21, FL22, FL31, FL32 - REAL :: FL111, FL112, FL211, FL212, FL311, FL312 - REAL :: DTSI(npa), U(npa), DT4AI, TMP1 - REAL :: DTMAX_GL, DTMAX, DTMAXEXP, REST - REAL :: LAMBDA(2), KTMP(3), TMP(3) - REAL :: BET1(3), BETAHAT(3) - REAL :: THETA_L(3,NE), THETA_H(3,NE), THETA_ACE(3,NE), UTMP(3) - REAL :: WII(2,npa), UL(npa), USTARI(2,npa) - REAL :: PM(npa), PP(npa), UIM(npa), UIP(npa) - REAL :: KELEM(3,NE), FLALL(3,NE) - REAL :: KKSUM(npa), ST(npa), BETA - REAL :: NM(NE) - INTEGER :: ISproc, IP_glob, JSEA, ierr - REAL :: eScal -#ifdef W3_REF1 - INTEGER(KIND=1) :: IOBPDR_LOC(NPA) -#endif - ITH = 1 + MOD(ISP-1,NTH) - IK = 1 + (ISP-1)/NTH - DTMAX = DBLE(10.E10) -#ifdef W3_REF1 - IOBPDR_LOC(:)=(1-IOBP_LOC(:))*(1-IOBPD_LOC(ITH,:)) -#endif - DO IE = 1, NE - I1 = INE(1,IE) ! Index of the Element Nodes - I2 = INE(2,IE) - I3 = INE(3,IE) - LAMBDA(1) = ONESIXTH *(C(I1,1)+C(I2,1)+C(I3,1)) ! Linearized advection speed in X and Y direction - LAMBDA(2) = ONESIXTH *(C(I1,2)+C(I2,2)+C(I3,2)) - KELEM(1,IE) = LAMBDA(1) * PDLIB_IEN(1,IE) + LAMBDA(2) * PDLIB_IEN(2,IE) ! K-Values - so called Flux Jacobians - KELEM(2,IE) = LAMBDA(1) * PDLIB_IEN(3,IE) + LAMBDA(2) * PDLIB_IEN(4,IE) - KELEM(3,IE) = LAMBDA(1) * PDLIB_IEN(5,IE) + LAMBDA(2) * PDLIB_IEN(6,IE) - KTMP = KELEM(:,IE) ! Copy - NM(IE) = - 1.D0/MIN(-THR,SUM(MIN(ZERO,KTMP))) ! N-Values - FL11 = C(I2,1) * PDLIB_IEN(1,IE) + C(I2,2) * PDLIB_IEN(2,IE) ! Weights for Simpson Integration - FL12 = C(I3,1) * PDLIB_IEN(1,IE) + C(I3,2) * PDLIB_IEN(2,IE) - FL21 = C(I3,1) * PDLIB_IEN(3,IE) + C(I3,2) * PDLIB_IEN(4,IE) - FL22 = C(I1,1) * PDLIB_IEN(3,IE) + C(I1,2) * PDLIB_IEN(4,IE) - FL31 = C(I1,1) * PDLIB_IEN(5,IE) + C(I1,2) * PDLIB_IEN(6,IE) - FL32 = C(I2,1) * PDLIB_IEN(5,IE) + C(I2,2) * PDLIB_IEN(6,IE) - FL111 = 2.d0*FL11+FL12 - FL112 = 2.d0*FL12+FL11 - FL211 = 2.d0*FL21+FL22 - FL212 = 2.d0*FL22+FL21 - FL311 = 2.d0*FL31+FL32 - FL312 = 2.d0*FL32+FL31 - FLALL(1,IE) = (FL311 + FL212)! * ONESIXTH + KELEM(1,IE) - FLALL(2,IE) = (FL111 + FL312)! * ONESIXTH + KELEM(2,IE) - FLALL(3,IE) = (FL211 + FL112)! * ONESIXTH + KELEM(3,IE) - END DO - ! If the current field or water level changes estimate the iteration - ! number based on the new flow field and the CFL number of the scheme - IF (LCALC) THEN - KKSUM = ZERO - DO IE = 1, NE - NI = INE(:,IE) - KKSUM(NI) = KKSUM(NI) + KELEM(:,IE) - END DO ! IE - DO IP = 1, npa - DTMAXEXP = PDLIB_SI(IP)/MAX(DBLE(10.E-10),KKSUM(IP)*IOBDP_LOC(IP)) - DTMAX = MIN( DTMAX, DTMAXEXP) - CFLXYMAX(IP) = MAX(CFLXYMAX(IP),DBLE(DT)/DTMAXEXP) - END DO - CALL MPI_ALLREDUCE(DTMAX,DTMAX_GL,1,rtype,MPI_MIN,MPI_COMM_WCMP,ierr) - CFLXY = DBLE(DT)/DTMAX_GL - REST = ABS(MOD(CFLXY,1.0d0)) - IF (REST .LT. THR) THEN - ITER(IK,ITH) = ABS(NINT(CFLXY)) - ELSE IF (REST .GT. THR .AND. REST .LT. 0.5d0) THEN - ITER(IK,ITH) = ABS(NINT(CFLXY)) + 1 - ELSE - ITER(IK,ITH) = ABS(NINT(CFLXY)) - END IF - END IF ! LCALC - DT4AI = DBLE(DT)/DBLE(ITER(IK,ITH)) - DTSI(:) = DT4AI/PDLIB_SI(:) ! Some precalculations for the time integration. - - U = DBLE(AC) ! correct - UL = U - DO IT = 1, ITER(IK,ITH) - ST = ZERO - DO IE = 1, NE - NI = INE(:,IE) - UTMP = U(NI) - FT = - ONESIXTH*DOT_PRODUCT(UTMP,FLALL(:,IE)) - TMP = MAX(ZERO,KELEM(:,IE)) - UTILDE = NM(IE) * ( DOT_PRODUCT(TMP,UTMP) - FT ) - THETA_L(:,IE) = TMP * ( UTMP - UTILDE ) - IF (ABS(FT) .GT. THR) THEN - BET1(:) = THETA_L(:,IE)/FT - IF (ANY( BET1 .LT. 0.0d0) ) THEN - BETAHAT(1) = BET1(1) + 0.5d0 * BET1(2) - BETAHAT(2) = BET1(2) + 0.5d0 * BET1(3) - BETAHAT(3) = BET1(3) + 0.5d0 * BET1(1) - BET1(1) = MAX(ZERO,MIN(BETAHAT(1),1.d0-BETAHAT(2),1.d0)) - BET1(2) = MAX(ZERO,MIN(BETAHAT(2),1.d0-BETAHAT(3),1.d0)) - BET1(3) = MAX(ZERO,MIN(BETAHAT(3),1.d0-BETAHAT(1),1.d0)) - THETA_L(:,IE) = FT * BET1 - END IF - ELSE - THETA_L(:,IE) = ZERO - END IF - ! THETA_H(:,IE) = (ONETHIRD+DT4AI/(2.d0*PDLIB_TRIA(IE)) * KELEM(:,IE))*FT ! LAX-WENDROFF - THETA_H(:,IE) = (1./3.+2./3.* KELEM(:,IE)/SUM(ABS(KELEM(:,IE))) )*FT ! CENTRAL SCHEME - ! Antidiffusive residual according to the higher order nonmonotone scheme - THETA_ACE(:,IE) = ((THETA_H(:,IE) - THETA_L(:,IE))) * DT4AI/PDLIB_SI(NI) - ST(NI) = ST(NI) + THETA_L(:,IE)*DT4AI/PDLIB_SI(NI) - END DO - - DO IP = 1, npa - UL(IP) = MAX(ZERO,U(IP)-DTSI(IP)*ST(IP)*(1-IOBPA_LOC(IP)))*IOBPD_LOC(ITH,IP)*IOBDP_LOC(IP) -#ifdef W3_REF1 - IF (REFPARS(3).LT.0.5.AND.IOBPD_LOC(ITH,IP).EQ.0.AND.IOBPA(IP).EQ.0) U(IP) = AC(IP) ! restores reflected boundary values -#endif - END DO - - USTARI(1,:) = MAX(UL,U) - USTARI(2,:) = MIN(UL,U) - UIP = -THR - UIM = THR - PP = ZERO - PM = ZERO - DO IE = 1, NE - NI = INE(:,IE) - PP(NI) = PP(NI) + MAX( THR, -THETA_ACE(:,IE)) - PM(NI) = PM(NI) + MIN( -THR, -THETA_ACE(:,IE)) - UIP(NI) = MAX (UIP(NI), MAXVAL( USTARI(1,NI) )) - UIM(NI) = MIN (UIM(NI), MINVAL( USTARI(2,NI) )) - END DO - WII(1,:) = MIN(1.0d0,(UIP-UL) / PP) - WII(2,:) = MIN(1.0d0,(UIM-UL) / PM) - ST = ZERO - DO IE = 1, NE - DO I = 1, 3 - IP = INE(I,IE) - IF (-THETA_ACE(I,IE) .GE. 0.) THEN - TMP(I) = WII(1,IP) - ELSE - TMP(I) = WII(2,IP) - END IF - END DO - BETA = MINVAL(TMP) - NI = INE(:,IE) - ST(NI) = ST(NI) + BETA * THETA_ACE(:,IE) - END DO - ! - ! IOBPD is the switch for removing energy coming from the shoreline - ! - DO IP = 1,npa - U(IP) = MAX(ZERO,U(IP)-DTSI(IP)*ST(IP)*(1-IOBPA_LOC(IP)))*IOBPD_LOC(ITH,IP)*IOBDP_LOC(IP) -#ifdef W3_REF1 - IF (REFPARS(3).LT.0.5.AND.IOBPD_LOC(ITH,IP).EQ.0.AND.IOBPA_LOC(IP).EQ.0) U(IP) = AC(IP) ! restores reflected boundary values -#endif - END DO - AC = REAL(U) - ! - ! 5 Update open boundaries ... this should be implemented differently ... it is better to omit any if clause in this loop ... - ! - IF ( FLBPI ) THEN - RD1=RD10 - DT * REAL(ITER(IK,ITH)-IT)/REAL(ITER(IK,ITH)) - RD2=RD20 - IF ( RD2 .GT. 0.001 ) THEN - RD2 = MIN(1.,MAX(0.,RD1/RD2)) - RD1 = 1. - RD2 - ELSE - RD1 = 0. - RD2 = 1. - END IF - ! - ! NB: this treatment of the open boundary (time interpolation) is different from - ! the constant boundary in the structured grids ... which restores the boundary - ! to the initial value: IF ( MAPSTA(IXY).EQ.2 ) VQ(IXY) = AQ(IXY) - ! Why this difference ? - ! - DO IBI=1, NBI - IP_glob = MAPSF(ISBPI(IBI),1) - JX=IPGL_npa(IP_glob) - IF (JX .gt. 0) THEN - AC(JX) = ( RD1*BBPI0(ISP,IBI) + RD2*BBPIN(ISP,IBI) ) & - / CG(IK,ISBPI(IBI)) * CLATS(ISBPI(IBI)) - END IF - ENDDO + WRITE(740+IAPROC,*) 'ISP/IP/val=', ISP, IP, eVal + END IF + END DO + END DO + FLUSH(740+IAPROC) END IF - CALL PDLIB_exchange1DREAL(AC) - U = DBLE(AC) - END DO ! IT - ! CALL EXTCDE ( 99 ) + END IF + END SUBROUTINE CHECK_ARRAY_INTEGRAL_NX_R8_MaxFunct + !/ ------------------------------------------------------------------- / + !* maxidx should be "np" or "npa" * + SUBROUTINE CHECK_ARRAY_INTEGRAL_NX_R8(TheARR, string, maxidx) !/ - !/ End of W3XYPFSN --------------------------------------------------- / + !/ +-----------------------------------+ + !/ | WAVEWATCH III NOAA/NCEP | + !/ | | + !/ | Aron Roland (BGS IT&E GmbH) | + !/ | Mathieu Dutour-Sikiric (IRB) | + !/ | | + !/ | FORTRAN 90 | + !/ | Last update : 01-June-2018 | + !/ +-----------------------------------+ !/ - END SUBROUTINE PDLIB_W3XYPFSFCT2 + !/ 01-June-2018 : Origination. ( version 6.04 ) + !/ + ! 1. Purpose : Source code for parallel debugging + ! 2. Method : + ! 3. Parameters : + ! + ! Parameter list + ! ---------------------------------------------------------------- + ! ---------------------------------------------------------------- + ! + ! 4. Subroutines used : + ! + ! Name Type Module Description + ! ---------------------------------------------------------------- + ! STRACE Subr. W3SERVMD Subroutine tracing. + ! ---------------------------------------------------------------- + ! + ! 5. Called by : + ! + ! Name Type Module Description + ! ---------------------------------------------------------------- + ! ---------------------------------------------------------------- + ! + ! 6. Error messages : + ! 7. Remarks + ! 8. Structure : + ! 9. Switches : + ! + ! !/S Enable subroutine tracing. + ! + ! 10. Source code : + ! + !/ ------------------------------------------------------------------- / + + USE W3GDATMD, only : NSPEC + USE YOWNODEPOOL, only: npa + CHARACTER(*), INTENT(in) :: string + INTEGER, INTENT(in) :: maxidx + REAL, INTENT(in) :: TheARR(NSPEC, npa) + REAL*8 :: TheARR_red(npa) + ! LOGICAL :: FULL_NSPEC = .FALSE. + ! LOGICAL :: PrintMinISP = .FALSE. + ! LOGICAL :: LocalizeMaximum = .FALSE. + ! LOGICAL :: CheckUncovered = .FALSE. + ! LOGICAL :: PrintFullValue = .FALSE. + LOGICAL :: FULL_NSPEC = .TRUE. + LOGICAL :: PrintMinISP = .TRUE. + LOGICAL :: LocalizeMaximum = .TRUE. + LOGICAL :: CheckUncovered = .TRUE. + LOGICAL :: PrintFullValue = .TRUE. + integer :: ip + + IF (FULL_NSPEC) THEN + CALL CHECK_ARRAY_INTEGRAL_NX_R8_MaxFunct(TheARR, string, maxidx, PrintMinISP, LocalizeMaximum) + ELSE + DO IP=1,npa + TheARR_red(IP) = SUM(ABS(TheArr(:,IP))) + END DO + CALL SCAL_INTEGRAL_PRINT_GENERAL(TheARR_red, string, maxidx, CheckUncovered, PrintFullValue) + END IF + END SUBROUTINE CHECK_ARRAY_INTEGRAL_NX_R8 + !/ ------------------------------------------------------------------- / !/ ------------------------------------------------------------------- / - SUBROUTINE PDLIB_W3XYPUG_BLOCK_IMPLICIT(IMOD, FACX, FACY, DTG, VGX, VGY) + SUBROUTINE PDLIB_W3XYPUG_BLOCK_IMPLICIT(IMOD, FACX, FACY, DTG, VGX, VGY, LCALC ) !/ ------------------------------------------------------------------- / !/ !/ +-----------------------------------+ @@ -2622,6 +2785,7 @@ SUBROUTINE PDLIB_W3XYPUG_BLOCK_IMPLICIT(IMOD, FACX, FACY, DTG, VGX, VGY) USE W3ODATMD, only: IAPROC USE W3GDATMD, only: B_JGS_USE_JACOBI + LOGICAL, INTENT(IN) :: LCALC INTEGER, INTENT(IN) :: IMOD REAL, INTENT(IN) :: FACX, FACY, DTG, VGX, VGY #ifdef W3_DEBUGSOLVER @@ -2629,7 +2793,7 @@ SUBROUTINE PDLIB_W3XYPUG_BLOCK_IMPLICIT(IMOD, FACX, FACY, DTG, VGX, VGY) FLUSH(740+IAPROC) #endif IF (B_JGS_USE_JACOBI) THEN - CALL PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY) + CALL PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY, LCALC) RETURN END IF WRITE(*,*) 'Error: You need to use with JGS_USE_JACOBI' @@ -2639,7 +2803,7 @@ SUBROUTINE PDLIB_W3XYPUG_BLOCK_IMPLICIT(IMOD, FACX, FACY, DTG, VGX, VGY) !/ END SUBROUTINE PDLIB_W3XYPUG_BLOCK_IMPLICIT !/ ------------------------------------------------------------------- / - SUBROUTINE PDLIB_W3XYPUG_BLOCK_EXPLICIT(IMOD, FACX, FACY, DTG, VGX, VGY) + SUBROUTINE PDLIB_W3XYPUG_BLOCK_EXPLICIT(IMOD, FACX, FACY, DTG, VGX, VGY, LCALC) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | @@ -2691,10 +2855,11 @@ SUBROUTINE PDLIB_W3XYPUG_BLOCK_EXPLICIT(IMOD, FACX, FACY, DTG, VGX, VGY) USE W3ODATMD, only: IAPROC USE W3GDATMD, only: B_JGS_USE_JACOBI + LOGICAL, INTENT(IN) :: LCALC INTEGER, INTENT(IN) :: IMOD REAL, INTENT(IN) :: FACX, FACY, DTG, VGX, VGY - Print *, 'Before PDLIB_EXPLICIT_BLOCK' - CALL PDLIB_EXPLICIT_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY) + + CALL PDLIB_EXPLICIT_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY, LCALC) !/ !/ End of W3XYPFSN ----------------------------------------------------- / !/ @@ -3227,19 +3392,19 @@ SUBROUTINE calcARRAY_JACOBI(DTG,FACX,FACY,VGX,VGY) INTEGER :: eIOBPDR #endif REAL :: DTK, TMP3 - REAL :: LAMBDA(2) - REAL :: FL11, FL12 - REAL :: FL21, FL22 - REAL :: FL31, FL32 - REAL :: CRFS(3), K(3) - REAL :: KP(3,NSPEC,NE) - REAL :: KM(3), CXY(3,2) - REAL :: K1, eSI, eVS, eVD - REAL :: eVal1, eVal2, eVal3 - REAL :: DELTAL(3,NSPEC,NE) - REAL :: NM(NSPEC,NE) - REAL :: TRIA03, SIDT, CCOS, CSIN - REAL :: SPEC(NSPEC), DEPTH + REAL :: LAMBDA(2) + REAL :: FL11, FL12 + REAL :: FL21, FL22 + REAL :: FL31, FL32 + REAL :: CRFS(3), CXY(3,2) + REAL :: KP(3,NSPEC,NE) + REAL :: KM(3), K(3) + REAL :: K1, eSI, eVS, eVD + REAL :: eVal1, eVal2, eVal3 + REAL :: DELTAL(3,NSPEC,NE) + REAL :: NM(NSPEC,NE) + REAL :: TRIA03, SIDT, CCOS, CSIN + REAL :: SPEC(NSPEC), DEPTH #ifdef W3_DEBUGSOLVER WRITE(740+IAPROC,*) 'calcARRAY_JACOBI, begin' @@ -3446,21 +3611,18 @@ SUBROUTINE calcARRAY_JACOBI_VEC(DTG,FACX,FACY,VGX,VGY) INTEGER :: I, J, ITH, IK, J2 INTEGER :: IE, POS, JSEA INTEGER :: I1, I2, I3, NI(3) - INTEGER :: counter, IB1, IB2 -#ifdef W3_REF1 - INTEGER :: eIOBPDR -#endif + INTEGER :: counter, IB1, IB2, IBR REAL :: DTK, TMP3 - REAL :: LAMBDA(2) + REAL :: LAMBDA(2), CXYY(2,3), CXY(2,NPA) REAL :: FL11, FL12 REAL :: FL21, FL22 REAL :: FL31, FL32 REAL :: CRFS(3), K(3) - REAL :: KP(3,NE), CXYY(2,3) - REAL :: KM(3), CXY(2,NPA) + REAL :: KP(3,NE) + REAL :: KM(3), DELTAL(3,NE) REAL :: K1, eSI, eVS, eVD REAL :: eVal1, eVal2, eVal3 - REAL :: DELTAL(3,NE), CG1, WN1 + REAL :: CG1, WN1 REAL :: TRIA03, SIDT, CCOS, CSIN REAL :: SPEC(NSPEC), DEPTH, CCOSA(NTH), CSINA(NTH) INTEGER :: IOBPTH1(NTH), IOBPTH2(NTH) @@ -3502,8 +3664,8 @@ SUBROUTINE calcARRAY_JACOBI_VEC(DTG,FACX,FACY,VGX,VGY) CXY(1,IP) = CCOS * CG1/CLATS(IP_GLOB) CXY(2,IP) = CSIN * CG1 IF (FLCUR) THEN - CXY(1,IP) = CXY(1,IP) + FACX * CX(IP_GLOB)/CLATS(IP_GLOB) - CXY(2,IP) = CXY(2,IP) + FACY * CY(IP_GLOB) + CXY(1,IP) = CXY(1,IP) + FACX * CX(IP_GLOB)/CLATS(IP_GLOB)*IOBDP_LOC(IP) + CXY(2,IP) = CXY(2,IP) + FACY * CY(IP_GLOB)*IOBDP_LOC(IP) ENDIF #ifdef W3_MGP CXY(1,IP) = CXY(1,IP) - CCURX*VGX/CLATS(ISEA) @@ -3537,6 +3699,9 @@ SUBROUTINE calcARRAY_JACOBI_VEC(DTG,FACX,FACY,VGX,VGY) DO IP = 1, np IB1 = (1-IOBPA_LOC(IP)) * IOBPD_LOC(ITH,IP) IB2 = IOBPD_LOC(ITH,IP) +#ifdef W3_REF1 + IBR = (1-IOBP_LOC(IP)) * (1-IOBPD_LOC(ITH,IP)) * (1-IOBPA_LOC(IP)) +#endif IF (IOBDP_LOC(IP) .eq. 1) THEN DO I = 1, PDLIB_CCON(IP) J = J + 1 @@ -3545,20 +3710,23 @@ SUBROUTINE calcARRAY_JACOBI_VEC(DTG,FACX,FACY,VGX,VGY) #ifdef W3_DEBUGSRC WRITE(740+IAPROC,*) 'I1=', I1, ' PDLIB_I_DIAG=', PDLIB_I_DIAG(IP) #endif -#ifdef W3_REF1 - eIOBPDR=(1-IOBP_LOC(IP))*(1-IOBPD_LOC(ITH,IP)) - IF (eIOBPDR .eq. 1) THEN - K1=ZERO - END IF -#endif + +#ifdef W3_REF1 + IF (IBR == 1) THEN + DTK = KP(POS,IE) * DTG + B_JAC(ISP,IP) = B_JAC(ISP,IP) + PDLIB_TRIA03(IE) * VA(ISP,IP) + ELSE + DTK = KP(POS,IE) * DTG * IB1 + B_JAC(ISP,IP) = B_JAC(ISP,IP) + PDLIB_TRIA03(IE) * VA(ISP,IP) * IB2 + ENDIF +#else DTK = KP(POS,IE) * DTG * IB1 - - I1 = PDLIB_POSI(1,J) - I2 = PDLIB_POSI(2,J) - I3 = PDLIB_POSI(3,J) - B_JAC(ISP,IP) = B_JAC(ISP,IP) + PDLIB_TRIA03(IE) * VA(ISP,IP) * IB2 +#endif + I1 = PDLIB_POSI(1,J) + I2 = PDLIB_POSI(2,J) + I3 = PDLIB_POSI(3,J) IF (FSGEOADVECT) THEN ASPAR_JAC(ISP,I1) = ASPAR_JAC(ISP,I1) + PDLIB_TRIA03(IE) + DTK - DTK * DELTAL(POS,IE) ASPAR_JAC(ISP,I2) = ASPAR_JAC(ISP,I2) - DTK * DELTAL(POS_TRICK(POS,1),IE) @@ -3570,8 +3738,8 @@ SUBROUTINE calcARRAY_JACOBI_VEC(DTG,FACX,FACY,VGX,VGY) ELSE DO I = 1, PDLIB_CCON(IP) J = J + 1 - I1 = PDLIB_POSI(1,J) - IE = PDLIB_IE_CELL2(I,IP) + I1 = PDLIB_POSI(1,J) + IE = PDLIB_IE_CELL2(I,IP) ASPAR_JAC(ISP,I1) = ASPAR_JAC(ISP,I1) + PDLIB_TRIA03(IE) END DO B_JAC(ISP,IP) = 0. @@ -3704,10 +3872,10 @@ SUBROUTINE calcARRAY_JACOBI2(DTG,FACX,FACY,VGX,VGY) REAL :: K1, eSI, eVS, eVD REAL :: eVal1, eVal2, eVal3 REAL :: DELTAL(3) - REAL :: NM + REAL :: NM, TRIA03, SIDT REAL :: IEN_LOCAL(6), CG2(NK,NTH) - REAL :: TRIA03, SIDT, CCOS, CSIN - REAL :: SPEC(NSPEC), DEPTH + REAL :: CCOS, CSIN + REAL :: SPEC(NSPEC), DEPTH memunit = 50000+IAPROC @@ -3898,21 +4066,21 @@ SUBROUTINE calcARRAY_JACOBI3(IP,J,DTG,FACX,FACY,VGX,VGY,ASPAR_DIAG_LOCAL,ASPAR_O #ifdef W3_REF1 INTEGER :: eIOBPDR #endif - REAL*8 :: DTK, TMP3 - REAL*8 :: LAMBDA(2) - REAL*8 :: FL11, FL12 - REAL*8 :: FL21, FL22 - REAL*8 :: FL31, FL32 - REAL*8 :: CRFS(3), K(3) - REAL*8 :: KP(3) - REAL*8 :: KM(3), CXY(3,2) - REAL*8 :: K1, eSI, eVS, eVD - REAL*8 :: eVal1, eVal2, eVal3 - REAL*8 :: ien_local(6) - REAL*8 :: DELTAL(3) - REAL*8 :: NM - REAL*8 :: TRIA03, SIDT, CCOS, CSIN - REAL*8 :: DEPTH + REAL :: DTK, TMP3 + REAL :: LAMBDA(2) + REAL :: FL11, FL12 + REAL :: FL21, FL22 + REAL :: FL31, FL32 + REAL :: CRFS(3), K(3) + REAL :: KP(3) + REAL :: KM(3), CXY(3,2) + REAL :: K1, eSI, eVS, eVD + REAL :: eVal1, eVal2, eVal3 + REAL :: ien_local(6) + REAL :: DELTAL(3) + REAL :: NM + REAL :: TRIA03, SIDT, CCOS, CSIN + REAL :: DEPTH ASPAR_DIAG_LOCAL = 0.d0 B_JAC_LOCAL = 0.d0 @@ -3978,7 +4146,6 @@ SUBROUTINE calcARRAY_JACOBI3(IP,J,DTG,FACX,FACY,VGX,VGY,ASPAR_DIAG_LOCAL,ASPAR_O TRIA03 = ONETHIRD * PDLIB_TRIA(IE) DTK = KP(POS) * DBLE(DTG) * IOBDP_LOC(IP) * IOBPD_LOC(ITH,IP) * (1-IOBPA_LOC(IP)) TMP3 = DTK * NM - ! IF (IP == 224 .AND. ISP == 121) WRITE(10006,'(I10,20F20.15)') ISP, KP(POS), DTK, TMP3, DELTAL(POS) IF (FSGEOADVECT) THEN ASPAR_DIAG_LOCAL(ISP) = ASPAR_DIAG_LOCAL(ISP) + TRIA03 + DTK - TMP3*DELTAL(POS) ASPAR_OFF_DIAG_LOCAL(ISP) = ASPAR_OFF_DIAG_LOCAL(ISP) - TMP3*DELTAL(IPP1)*VA(ISP,IP1) @@ -3986,7 +4153,6 @@ SUBROUTINE calcARRAY_JACOBI3(IP,J,DTG,FACX,FACY,VGX,VGY,ASPAR_DIAG_LOCAL,ASPAR_O ELSE ASPAR_DIAG_LOCAL(ISP) = ASPAR_DIAG_LOCAL(ISP) + TRIA03 END IF - !IF (IP == 2) WRITE(10005,'(2I10,10G20.10)') ISP, IP, VAOLD(ISP,IP) B_JAC_LOCAL(ISP) = B_JAC_LOCAL(ISP) + TRIA03 * VAOLD(ISP,IP) * IOBDP_LOC(IP) * IOBPD_LOC(ITH,IP) END DO END DO @@ -4100,21 +4266,21 @@ SUBROUTINE calcARRAY_JACOBI4(IP,DTG,FACX,FACY,VGX,VGY,ASPAR_DIAG_LOCAL,ASPAR_OFF #ifdef W3_REF1 INTEGER :: eIOBPDR #endif - REAL*8 :: DTK, TMP3, D1, D2 - REAL*8 :: LAMBDA(2) - REAL*8 :: CRFS(3), K(3) - REAL*8 :: KP(3), UV_CUR(3,2) - REAL*8 :: KM(3), CSX(3), CSY(3) - REAL*8 :: K1, eSI, eVS, eVD - REAL*8 :: eVal1, eVal2, eVal3 - REAL*8 :: ien_local(6) - REAL*8 :: DELTAL(3), K_X(3,NK), K_Y(3,NK), K_U(3) - REAL*8 :: CRFS_X(3,NK), CRFS_Y(3,NK), CRFS_U(3) - REAL*8 :: NM, CGFAK(3,NK), CSINA(NTH), CCOSA(NTH) - REAL*8 :: TRIA03, SIDT, CCOS, CSIN - REAL*8 :: FL11_X, FL12_X, FL21_X, FL22_X, FL31_X, FL32_X - REAL*8 :: FL11_Y, FL12_Y, FL21_Y, FL22_Y, FL31_Y, FL32_Y - REAL*8 :: FL11_U, FL12_U, FL21_U, FL22_U, FL31_U, FL32_U + REAL :: DTK, TMP3, D1, D2 + REAL :: LAMBDA(2) + REAL :: CRFS(3), K(3) + REAL :: KP(3), UV_CUR(3,2) + REAL :: KM(3), CSX(3), CSY(3) + REAL :: K1, eSI, eVS, eVD + REAL :: eVal1, eVal2, eVal3 + REAL :: ien_local(6) + REAL :: DELTAL(3), K_X(3,NK), K_Y(3,NK), K_U(3) + REAL :: CRFS_X(3,NK), CRFS_Y(3,NK), CRFS_U(3) + REAL :: NM, CGFAK(3,NK), CSINA(NTH), CCOSA(NTH) + REAL :: TRIA03, SIDT, CCOS, CSIN + REAL :: FL11_X, FL12_X, FL21_X, FL22_X, FL31_X, FL32_X + REAL :: FL11_Y, FL12_Y, FL21_Y, FL22_Y, FL31_Y, FL32_Y + REAL :: FL11_U, FL12_U, FL21_U, FL22_U, FL31_U, FL32_U IP_glob = iplg(IP) ASPAR_DIAG_LOCAL = ZERO @@ -4213,7 +4379,6 @@ SUBROUTINE calcARRAY_JACOBI4(IP,DTG,FACX,FACY,VGX,VGY,ASPAR_DIAG_LOCAL,ASPAR_OFF DELTAL(1:3) = CRFS(1:3) - KP(1:3) !NM = 1.d0/MIN(-THR,SUM(MIN(ZERO,K))) DTK = KP(POS) * DTG * IOBPTH1(ITH)!IOBDP(IP_glob) * (1-IOBPA(IP_glob)) * IOBPD(ITH,IP_glob) - !write(*,*) IOBDP(IP_glob) , (1-IOBPA(IP_glob)), IOBPD(ITH,IP_glob) TMP3 = DTK * 1.d0/MIN(-THR,SUM(MIN(ZERO,K(1:3)))) IF (FSGEOADVECT) THEN ASPAR_DIAG_LOCAL(ISP) = ASPAR_DIAG_LOCAL(ISP) + TRIA03 + DTK - TMP3*DELTAL(POS) @@ -4229,212 +4394,6 @@ SUBROUTINE calcARRAY_JACOBI4(IP,DTG,FACX,FACY,VGX,VGY,ASPAR_DIAG_LOCAL,ASPAR_OFF END DO END SUBROUTINE calcARRAY_JACOBI4 !/ ------------------------------------------------------------------- / - SUBROUTINE calcARRAY_JACOBI5(IE,DTG,FACX,FACY,VGX,VGY) - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | | - !/ | Aron Roland (BGS IT&E GmbH) | - !/ | Mathieu Dutour-Sikiric (IRB) | - !/ | | - !/ | FORTRAN 90 | - !/ | Last update : 01-June-2018 | - !/ +-----------------------------------+ - !/ - !/ 01-June-2018 : Origination. ( version 6.04 ) - !/ - ! 1. Purpose : Compute matrix coefficients for advection part - ! 2. Method : - ! 3. Parameters : - ! - ! Parameter list - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 4. Subroutines used : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! STRACE Subr. W3SERVMD Subroutine tracing. - ! ---------------------------------------------------------------- - ! - ! 5. Called by : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 6. Error messages : - ! 7. Remarks - ! 8. Structure : - ! 9. Switches : - ! - ! !/S Enable subroutine tracing. - ! - ! 10. Source code : - ! - !/ ------------------------------------------------------------------- / -#ifdef W3_S - USE W3SERVMD, only: STRACE -#endif - ! - - USE W3GDATMD, only: NK, NK2, NTH, NSPEC, FACHFA, DMIN - USE W3GDATMD, only: IOBP_LOC, IOBPD_LOC, IOBPA_LOC, IOBDP_LOC - USE W3GDATMD, only: NSEAL, CLATS - USE W3GDATMD, only: MAPSTA, NK - USE W3WDATMD, only: VA, VAOLD - USE W3ADATMD, only: CG, DW, WN, CX, CY - USE W3IDATMD, only: FLCUR, FLLEV - USE W3GDATMD, only: ECOS, ESIN, MAPFS - USE W3PARALL, only : ONESIXTH, ZERO, THR, ONETHIRD - use yowElementpool, only: ne, INE - USE YOWNODEPOOL, only: PDLIB_IEN, PDLIB_TRIA, & - PDLIB_CCON, NP, NPA, & - PDLIB_IA_P, PDLIB_POSI, PDLIB_IA, PDLIB_NNZ, iplg, & - PDLIB_I_DIAG, PDLIB_JA - USE W3ODATMD, only : IAPROC -#ifdef W3_DB1 - USE W3SDB1MD - USE W3GDATMD, only: SDBSC -#endif -#ifdef W3_BT1 - USE W3SBT1MD -#endif -#ifdef W3_BT4 - USE W3SBT4MD -#endif -#ifdef W3_BT8 - USE W3SBT8MD -#endif -#ifdef W3_BT9 - USE W3SBT9MD -#endif -#ifdef W3_IC1 - USE W3SIC1MD -#endif -#ifdef W3_IC2 - USE W3SIC2MD -#endif -#ifdef W3_IC3 - USE W3SIC3MD -#endif -#ifdef W3_TR1 - USE W3STR1MD -#endif - INTEGER, INTENT(IN) :: IE - REAL, INTENT(in) :: DTG, FACX, FACY, VGX, VGY - ! - INTEGER :: IP, IP1, IP2 - INTEGER :: ITH, IK - INTEGER :: POS, JSEA - INTEGER :: I, I1, I2, I3, NI(3), NI_GLOB(3), NI_ISEA(3) - INTEGER :: ISP, IP_glob, IPP1, IPP2 - INTEGER :: counter -#ifdef W3_REF1 - INTEGER :: eIOBPDR -#endif - REAL :: DTK(3), TMP3(NSPEC,3) - REAL :: LAMBDA(2) - REAL :: CRFS(3), K(3) - REAL :: KP(3), UV_CUR(3,2) - REAL :: KM(3), CSX(3), CSY(3) - REAL :: K1, eSI, eVS, eVD - REAL :: eVal1, eVal2, eVal3 - REAL :: ien_local(6) - REAL :: DELTAL(NSPEC,3), K_X(3,NK), K_Y(3,NK), K_U(3) - REAL :: CRFS_X(3,NK), CRFS_Y(3,NK), CRFS_U(3) - REAL :: NM, CGFAK(3,NK) - REAL :: TRIA03, SIDT, CCOS, CSIN - REAL :: FL11_X, FL12_X, FL21_X, FL22_X, FL31_X, FL32_X - REAL :: FL11_Y, FL12_Y, FL21_Y, FL22_Y, FL31_Y, FL32_Y - REAL :: FL11_U, FL12_U, FL21_U, FL22_U, FL31_U, FL32_U - - TRIA03 = ONETHIRD * PDLIB_TRIA(IE) - IEN_LOCAL = PDLIB_IEN(:,IE) - NI = INE(:,IE) - NI_GLOB = iplg(NI) - NI_ISEA = MAPFS(1,NI_GLOB) - CRFS_U = ZERO - K_U = ZERO - - IF (FLCUR) THEN - UV_CUR(:,1) = CX(NI_ISEA) / CLATS(NI_ISEA) - UV_CUR(:,2) = CY(NI_ISEA) - LAMBDA(1)=ONESIXTH*(UV_CUR(1,1)+UV_CUR(2,1)+UV_CUR(3,1)) - LAMBDA(2)=ONESIXTH*(UV_CUR(1,2)+UV_CUR(2,2)+UV_CUR(3,2)) - K_U(1) = LAMBDA(1) * IEN_LOCAL(1) + LAMBDA(2) * IEN_LOCAL(2) - K_U(2) = LAMBDA(1) * IEN_LOCAL(3) + LAMBDA(2) * IEN_LOCAL(4) - K_U(3) = LAMBDA(1) * IEN_LOCAL(5) + LAMBDA(2) * IEN_LOCAL(6) - FL11_U = UV_CUR(2,1)*IEN_LOCAL(1)+UV_CUR(2,2)*IEN_LOCAL(2) - FL12_U = UV_CUR(3,1)*IEN_LOCAL(1)+UV_CUR(3,2)*IEN_LOCAL(2) - FL21_U = UV_CUR(3,1)*IEN_LOCAL(3)+UV_CUR(3,2)*IEN_LOCAL(4) - FL22_U = UV_CUR(1,1)*IEN_LOCAL(3)+UV_CUR(1,2)*IEN_LOCAL(4) - FL31_U = UV_CUR(1,1)*IEN_LOCAL(5)+UV_CUR(1,2)*IEN_LOCAL(6) - FL32_U = UV_CUR(2,1)*IEN_LOCAL(5)+UV_CUR(2,2)*IEN_LOCAL(6) - CRFS_U(1) = - ONESIXTH*(2.d0 *FL31_U + FL32_U + FL21_U + 2.d0 * FL22_U) - CRFS_U(2) = - ONESIXTH*(2.d0 *FL32_U + 2.d0 * FL11_U + FL12_U + FL31_U) - CRFS_U(3) = - ONESIXTH*(2.d0 *FL12_U + 2.d0 * FL21_U + FL22_U + FL11_U) - ENDIF - - DO IK = 1, NK - CSX = CG(IK,NI_ISEA) / CLATS(NI_ISEA) - CSY = CG(IK,NI_ISEA) - LAMBDA(1) = ONESIXTH * (CSX(1) + CSX(2) + CSX(3)) - LAMBDA(2) = ONESIXTH * (CSY(1) + CSY(2) + CSY(3)) - K_X(1,IK) = LAMBDA(1) * IEN_LOCAL(1) - K_X(2,IK) = LAMBDA(1) * IEN_LOCAL(3) - K_X(3,IK) = LAMBDA(1) * IEN_LOCAL(5) - K_Y(1,IK) = LAMBDA(2) * IEN_LOCAL(2) - K_Y(2,IK) = LAMBDA(2) * IEN_LOCAL(4) - K_Y(3,IK) = LAMBDA(2) * IEN_LOCAL(6) - FL11_X = CSX(2) * IEN_LOCAL(1) - FL12_X = CSX(3) * IEN_LOCAL(1) - FL21_X = CSX(3) * IEN_LOCAL(3) - FL22_X = CSX(1) * IEN_LOCAL(3) - FL31_X = CSX(1) * IEN_LOCAL(5) - FL32_X = CSX(2) * IEN_LOCAL(5) - FL11_Y = CSY(2) * IEN_LOCAL(2) - FL12_Y = CSY(3) * IEN_LOCAL(2) - FL21_Y = CSY(3) * IEN_LOCAL(4) - FL22_Y = CSY(1) * IEN_LOCAL(4) - FL31_Y = CSY(1) * IEN_LOCAL(6) - FL32_Y = CSY(2) * IEN_LOCAL(6) - CRFS_X(1,IK) = - ONESIXTH * (2.d0*FL31_X + FL32_X + FL21_X + 2.d0 * FL22_X) - CRFS_X(2,IK) = - ONESIXTH * (2.d0*FL32_X + 2.d0 * FL11_X + FL12_X + FL31_X) - CRFS_X(3,IK) = - ONESIXTH * (2.d0*FL12_X + 2.d0 * FL21_X + FL22_X + FL11_X) - CRFS_Y(1,IK) = - ONESIXTH * (2.d0*FL31_Y + FL32_Y + FL21_Y + 2.d0 * FL22_Y) - CRFS_Y(2,IK) = - ONESIXTH * (2.d0*FL32_Y + 2.d0 * FL11_Y + FL12_Y + FL31_Y) - CRFS_Y(3,IK) = - ONESIXTH * (2.d0*FL12_Y + 2.d0 * FL21_Y + FL22_Y + FL11_Y) - ENDDO - - DO ISP=1,NSPEC - ITH = 1 + MOD(ISP-1,NTH) - IK = 1 + (ISP-1)/NTH - CCOS = FACX * ECOS(ITH) - CSIN = FACY * ESIN(ITH) - K = K_X(:,IK) * CCOS + K_Y(:,IK) * CSIN + K_U - CRFS = CRFS_X(:,IK) * CCOS + CRFS_Y(:,IK) * CSIN + CRFS_U - KM = MIN(ZERO,K) - KP = MAX(ZERO,K) - DELTAL(ISP,:) = CRFS - KP - NM = 1.d0/MIN(-THR,SUM(KM)) - DTK = KP * DTG * IOBDP_LOC(NI) * IOBPD_LOC(ITH,NI) * (1-IOBPA_LOC(NI)) - TMP3(ISP,:) = DTK * NM - ENDDO - - DO I = 1, 3 - IP = NI(I) - IP1 = INE(POS_TRICK(I,1),IE) - IP2 = INE(POS_TRICK(I,2),IE) - IPP1 = POS_TRICK(I,1) - IPP2 = POS_TRICK(I,2) - !ASPAR_DIAG(:,IP) = ASPAR_DIAG(:,IP) + TRIA03 + DTK(I) - TMP3(:,I) * DELTAL - !ASPAR_OFF_DIAG(:,IP1) = ASPAR_OFF_DIAG(:,IP1) - TMP3(:,IPP1) * DELTAL(:,IPP1) * VA(:,IP1) - !ASPAR_OFF_DIAG(:,IP2) = ASPAR_OFF_DIAG(:,IP2) - TMP3(:,IPP2) * DELTAL(:,IPP2) * VA(:,IP2) - ENDDO - END SUBROUTINE calcARRAY_JACOBI5 - !/ ------------------------------------------------------------------- / SUBROUTINE calcARRAY_JACOBI_SPECTRAL_1(DTG) !/ !/ +-----------------------------------+ @@ -4508,8 +4467,7 @@ SUBROUTINE calcARRAY_JACOBI_SPECTRAL_1(DTG) INTEGER :: ITH0 LOGICAL :: LSIG = .FALSE. - - !AR: this is missing in init ... but there is a design error in ww3_grid with FLCUR and FLLEV + !AR: TODO: check&report if needed ... LSIG = FLCUR .OR. FLLEV DO IP = 1, np @@ -4537,8 +4495,8 @@ SUBROUTINE calcARRAY_JACOBI_SPECTRAL_1(DTG) END IF CAS_SIG(:,IP) = CAS ELSE IF (FreqShiftMethod .eq. 2) THEN - IF (IOBP_LOC(IP).eq.1) THEN - CALL PROP_FREQ_SHIFT_M2(IP, ISEA, CWNB_M2, DWNI_M2, DTG) + IF (IOBP_LOC(IP).eq.1.and.IOBDP_LOC(IP).eq.1.and.IOBPA_LOC(IP).eq.0) THEN + CALL PROP_FREQ_SHIFT_M2(IP, ISEA, CWNB_M2, DWNI_M2, DTG) #ifdef W3_DEBUGFREQSHIFT WRITE(740+IAPROC,*) 'sum(CWNB_M2)=', sum(CWNB_M2) #endif @@ -4562,13 +4520,9 @@ SUBROUTINE calcARRAY_JACOBI_SPECTRAL_1(DTG) ! The refraction ! IF (FSREFRACTION) THEN - ! - !IF ((MAPSTA(1,IP_glob) .eq. 1).and.(SUM(IOBPD(:,IP_glob)) .EQ. NTH)) THEN - !IF (MAPSTA(1,IP_glob) .eq. 1) THEN - !IF (IOBP(IP_glob) .eq. 1) THEN IF (IOBP_LOC(IP) .eq. 1 .and. IOBDP_LOC(IP).eq.1.and.IOBPA_LOC(IP).eq.0) THEN - ! CALL PROP_REFRACTION_PR1(ISEA,DTG,CAD) !AR: Is this working? - ! CALL PROP_REFRACTION_PR3(ISEA,DTG,CAD, DoLimiterRefraction) + ! CALL PROP_REFRACTION_PR1(ISEA,DTG,CAD) !AR: Check statuts ... + ! CALL PROP_REFRACTION_PR3(ISEA,DTG,CAD, DoLimiterRefraction) CALL PROP_REFRACTION_PR3(IP,ISEA,DTG,CAD,DoLimiterRefraction) ELSE CAD=ZERO @@ -4663,8 +4617,6 @@ SUBROUTINE calcARRAY_JACOBI_SPECTRAL_2(DTG,ASPAR_DIAG_LOCAL) INTEGER :: ITH0 LOGICAL :: LSIG = .FALSE. - - !AR: this is missing in init ... but there is a design error in ww3_grid with FLCUR and FLLEV LSIG = FLCUR .OR. FLLEV DO IP = 1, np @@ -4692,7 +4644,7 @@ SUBROUTINE calcARRAY_JACOBI_SPECTRAL_2(DTG,ASPAR_DIAG_LOCAL) END DO ASPAR_DIAG_LOCAL(:,IP) = ASPAR_DIAG_LOCAL(:,IP) + B_SIG * eSI ELSE - CAS=0 + CAS = 0 END IF CAS_SIG(:,IP) = CAS END IF @@ -4725,12 +4677,9 @@ SUBROUTINE calcARRAY_JACOBI_SPECTRAL_2(DTG,ASPAR_DIAG_LOCAL) END IF ! IF (FSREFRACTION) THEN - !IF ((MAPSTA(1,IP_glob) .eq. 1).and.(SUM(IOBPD(:,IP_glob)) .EQ. NTH)) THEN - !IF (MAPSTA(1,IP_glob) .eq. 1) THEN - !IF (IOBP(IP_glob) .eq. 1) THEN IF (IOBP_LOC(IP) .eq. 1.and.IOBDP_LOC(IP).eq.1.and.IOBPA_LOC(IP).eq.0) THEN - ! CALL PROP_REFRACTION_PR1(ISEA,DTG,CAD) !AR: Is this working? - ! CALL PROP_REFRACTION_PR3(ISEA,DTG,CAD, DoLimiterRefraction) + ! CALL PROP_REFRACTION_PR1(ISEA,DTG,CAD) !AR: Is this working? + ! CALL PROP_REFRACTION_PR3(ISEA,DTG,CAD, DoLimiterRefraction) CALL PROP_REFRACTION_PR3(IP,ISEA,DTG,CAD,DoLimiterRefraction) ELSE CAD=ZERO @@ -4882,7 +4831,6 @@ SUBROUTINE CALCARRAY_JACOBI_SOURCE_1(DTG) CALL COMPUTE_MEAN_PARAM(SPEC_VA, CG1, WN1, EMEAN, FMEAN, WNMEAN, AMAX) CALL W3SDB2 ( JSEA, SPEC_VA, DEPTH, EMEAN, FMEAN, CG1, LBREAK, VSDB, VDDB ) #endif - ! IF (JSEA == 10000) WRITE(*,'(2I20,10F20.10)') JSEA, ISEA, SUM(VSTOT(:,JSEA)), SUM(VDTOT(:,JSEA)), SUM(VSDB),SUM(VDDB), DEPTH, EMEAN, FMEAN, WNMEAN DO IK=1,NK DO ITH=1,NTH ISP=ITH + (IK-1)*NTH @@ -4907,12 +4855,8 @@ SUBROUTINE CALCARRAY_JACOBI_SOURCE_1(DTG) #endif B_JAC(ISP,IP) = B_JAC(ISP,IP) + SIDT * (eVS - eVD*VA(ISP,JSEA)) ASPAR_JAC(ISP,PDLIB_I_DIAG(IP)) = ASPAR_JAC(ISP,PDLIB_I_DIAG(IP)) - SIDT * eVD - !IF (ISEA .eq. 100) THEN - ! WRITE(*,*) ' A and B', ISP, eVS, eVD, VA(ISP,JSEA), B_JAC(ISP,IP), ASPAR_JAC(ISP,PDLIB_I_DIAG(IP)) - !ENDIF END DO END DO - !IF (IP .eq. 100) WRITE(*,*) 'SUM A and B', IP, SUM(B_JAC(:,IP)), SUM(ASPAR_JAC(:,PDLIB_I_DIAG(IP))) END IF END DO END SUBROUTINE CALCARRAY_JACOBI_SOURCE_1 @@ -5048,7 +4992,6 @@ SUBROUTINE CALCARRAY_JACOBI_SOURCE_2(DTG,ASPAR_DIAG_LOCAL) CALL COMPUTE_MEAN_PARAM(SPEC_VA, CG1, WN1, EMEAN, FMEAN, WNMEAN, AMAX) CALL W3SDB2 ( JSEA, SPEC_VA, DEPTH, EMEAN, FMEAN, CG1, LBREAK, VSDB, VDDB ) #endif - ! IF (JSEA == 10000) WRITE(*,'(2I20,10F20.10)') JSEA, ISEA, SUM(VSTOT(:,JSEA)), SUM(VDTOT(:,JSEA)), SUM(VSDB),SUM(VDDB), DEPTH, EMEAN, FMEAN, WNMEAN DO IK=1,NK DO ITH=1,NTH ISP=ITH + (IK-1)*NTH @@ -5499,7 +5442,7 @@ SUBROUTINE ACTION_LIMITER_LOCAL(IP,ACLOC,ACOLD, DTG) ENDIF END SUBROUTINE ACTION_LIMITER_LOCAL !/ ------------------------------------------------------------------- / - SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY) + SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY, LCALC) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | @@ -5549,6 +5492,7 @@ SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY) USE W3SERVMD, only: STRACE #endif !/ + USE CONSTANTS, only : TPI, TPIINV, GRAV USE W3GDATMD, only: MAPSTA USE W3GDATMD, only: FSREFRACTION, FSFREQSHIFT, FSSOURCE, NX, DSIP USE W3GDATMD, only: B_JGS_NORM_THR, B_JGS_TERMINATE_NORM, B_JGS_PMIN @@ -5566,7 +5510,7 @@ SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY) use yowExchangeModule, only : PDLIB_exchange2Dreal_zero, PDLIB_exchange2Dreal USE MPI, only : MPI_SUM, MPI_INT USE W3ADATMD, only: MPI_COMM_WCMP - USE W3GDATMD, only: NSEA, SIG + USE W3GDATMD, only: NSEA, SIG, FACP, FLSOU USE W3GDATMD, only: IOBP_LOC, IOBPD_LOC, IOBDP_LOC, IOBPA_LOC USE W3GDATMD, only: NK, NK2, NTH, ECOS, ESIN, NSPEC, MAPFS, NSEA, SIG USE W3WDATMD, only: TIME @@ -5574,7 +5518,7 @@ SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY) USE W3TIMEMD, only: DSEC21 USE W3GDATMD, only: NSEAL, CLATS, FACHFA USE W3IDATMD, only: FLCUR, FLLEV - USE W3WDATMD, only: VA, VAOLD, VSTOT, VDTOT + USE W3WDATMD, only: VA, VAOLD, VSTOT, VDTOT, UST USE W3ADATMD, only: CG, CX, CY, WN, DW USE W3ODATMD, only: TBPIN, FLBPI, IAPROC USE W3PARALL, only : IMEM @@ -5585,1055 +5529,645 @@ SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY) USE yowfunction, only : pdlib_abort USE yowNodepool, only: np_global USE W3DISPMD, only : WAVNU_LOCAL - + USE W3ADATMD, ONLY: U10, U10D +#ifdef W3_ST4 + USE W3SRC4MD, only: W3SPR4 +#endif +#ifdef W3_REF1 + USE W3GDATMD, only: REFPARS +#endif + implicit none + LOGICAL, INTENT(IN) :: LCALC INTEGER, INTENT(IN) :: IMOD REAL, INTENT(IN) :: FACX, FACY, DTG, VGX, VGY ! - INTEGER :: IP, ISP, ITH, IK, JSEA, ISEA, IP_glob + INTEGER :: IP, ISP, ITH, IK, JSEA, ISEA, IP_glob, IS0 INTEGER :: myrank INTEGER :: nbIter, ISPnextDir, ISPprevDir INTEGER :: ISPp1, ISPm1, JP, ICOUNT1, ICOUNT2 ! for the exchange - REAL :: CCOS, CSIN, CCURX, CCURY - REAL :: eSum(NSPEC) - REAL :: eA_THE, eC_THE, eA_SIG, eC_SIG, eSI - REAL :: CAD(NSPEC), CAS(NSPEC), ACLOC(NSPEC) - REAL :: CP_SIG(NSPEC), CM_SIG(NSPEC) - REAL :: eFactM1, eFactP1 + REAL*8 :: CCOS, CSIN, CCURX, CCURY + REAL*8 :: eSum(NSPEC), FRLOCAL + REAL*8 :: eA_THE, eC_THE, eA_SIG, eC_SIG, eSI + REAL*8 :: CAD(NSPEC), CAS(NSPEC), ACLOC(NSPEC) + REAL*8 :: CP_SIG(NSPEC), CM_SIG(NSPEC) + REAL*8 :: eFactM1, eFactP1 REAL*8 :: Sum_Prev, Sum_New, p_is_converged, DiffNew, prop_conv - REAL :: Sum_L2, Sum_L2_GL - REAL :: DMM(0:NK2) - REAL :: eDiff(NSPEC), eProd(NSPEC) - REAL :: DWNI_M2(NK), CWNB_M2(1-NTH:NSPEC) - REAL :: VAnew(NSPEC), VFLWN(1-NTH:NSPEC) + REAL*8 :: Sum_L2, Sum_L2_GL + REAL :: DMM(0:NK2), DAM(NSPEC), DAM2(NSPEC), SPEC(NSPEC) + REAL*8 :: eDiff(NSPEC), eProd(NSPEC), eDiffB(NSPEC) + REAL*8 :: DWNI_M2(NK), CWNB_M2(1-NTH:NSPEC) + REAL :: VAnew(NSPEC), VFLWN(1-NTH:NSPEC), JAC, JAC2 REAL :: VAAnew(1-NTH:NSPEC+NTH), VAAacloc(1-NTH:NSPEC+NTH) - REAL :: VAinput(NSPEC), VAacloc(NSPEC), eDiffB(NSPEC),ASPAR_DIAG(NSPEC) - REAL :: aspar_diag_local(nspec), aspar_off_diag_local(nspec), b_jac_local(nspec) - REAL :: eDiffSing, eSumPart - REAL :: eVal1, eVal2!, extmp(nspec,nseal) - REAL :: eVA, CG2 - REAL :: CG1(0:NK+1), WN1(0:NK+1) - LOGICAL :: LCONVERGED(NSEAL), lexist -#ifdef WEIGHTS - INTEGER :: ipiter(nseal), ipitergl(np_global), ipiterout(np_global) -#endif -#ifdef W3_DEBUGSRC - REAL :: IntDiff, eVA_w3srce, eVAsolve, SumACout - REAL :: SumVAin, SumVAout, SumVAw3srce, SumVS, SumVD, VS_w3srce - REAL :: VAsolve(NSPEC) - REAL*8 :: ACsolve - REAL :: eB -#endif -#ifdef W3_DEBUGSOLVERCOH - REAL :: TheARR(NSPEC, npa) - REAL :: PRE_VA(NSPEC, npa) - REAL :: OffDIAG(NSPEC, npa) - REAL*8 :: eOff(NSPEC) - REAL*8 :: eSum1(NSPEC), eSum2(NSPEC) -#endif - CHARACTER(len=128) eFile - INTEGER ierr, i - INTEGER JP_glob - INTEGER is_converged, itmp - - integer :: testknoten = 923 - - LOGICAL :: LSIG = .FALSE. - - memunit = 50000+IAPROC - !AR: this is missing in init ... but there is a design error in ww3_grid with FLCUR and FLLEV - LSIG = FLCUR .OR. FLLEV -#ifdef W3_DEBUGSOLVERCOH - OffDIAG = ZERO -#endif - call print_memcheck(memunit, 'memcheck_____:'//' WW3_PROP SECTION 0') - - !DO JSEA = 1, NSEAL - ! WRITE(70000+IAPROC,*) 'SUM VA ENTRY SOLVER', JSEA, SUM(VA(:,JSEA)) - !ENDDO - - CCURX = FACX - CCURY = FACY - CALL MPI_COMM_RANK(MPI_COMM_WCMP, myrank, ierr) - ! -#ifdef W3_DEBUGSOLVER - WRITE(740+IAPROC,*) 'PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK, begin' - WRITE(740+IAPROC,*) 'NX=', NX - WRITE(740+IAPROC,*) 'NP=', NP - WRITE(740+IAPROC,*) 'NPA=', NPA - WRITE(740+IAPROC,*) 'NSEA=', NSEA - WRITE(740+IAPROC,*) 'NSEAL=', NSEAL - WRITE(740+IAPROC,*) 'NBI=', NBI - WRITE(740+IAPROC,*) 'B_JGS_TERMINATE_NORM=', B_JGS_TERMINATE_NORM - WRITE(740+IAPROC,*) 'B_JGS_TERMINATE_DIFFERENCE=', B_JGS_TERMINATE_DIFFERENCE - WRITE(740+IAPROC,*) 'B_JGS_TERMINATE_MAXITER=', B_JGS_TERMINATE_MAXITER - WRITE(740+IAPROC,*) 'B_JGS_MAXITER=', B_JGS_MAXITER - WRITE(740+IAPROC,*) 'B_JGS_BLOCK_GAUSS_SEIDEL=', B_JGS_BLOCK_GAUSS_SEIDEL - WRITE(740+IAPROC,*) 'FSREFRACTION=', FSREFRACTION - WRITE(740+IAPROC,*) 'FSFREQSHIFT=', FSFREQSHIFT - WRITE(740+IAPROC,*) 'B_JGS_LIMITER=', B_JGS_LIMITER - WRITE(740+IAPROC,*) 'B_JGS_BLOCK_GAUSS_SEIDEL=', B_JGS_BLOCK_GAUSS_SEIDEL - FLUSH(740+IAPROC) -#endif -#ifdef W3_DEBUGSRC - WRITE(740+IAPROC,*) 'optionCall=', optionCall - FLUSH(740+IAPROC) -#endif - call print_memcheck(memunit, 'memcheck_____:'//' WW3_PROP SECTION 1') - ! - ! 2. Convert to Wave Action ---------------- * - ! -#ifdef W3_DEBUGSRC - WRITE(740+IAPROC,*) 'NSEAL =', NSEAL, 'NP =', NP, 'NPA =', NPA -#endif -#ifdef W3_DEBUGSOLVERCOH - CALL ALL_VA_INTEGRAL_PRINT(IMOD, "VA(np) before transform", 0) - CALL ALL_VA_INTEGRAL_PRINT(IMOD, "VA(npa) before transform", 1) -#endif - ! We have NSEAL = NPA so the whole field is assigned - DO JSEA=1,NSEAL - IP = JSEA - IP_glob = iplg(IP) - ISEA = MAPFS(1,IP_glob) - DO ISP=1,NSPEC - ITH = 1 + MOD(ISP-1,NTH) - IK = 1 + (ISP-1)/NTH -#ifdef NOCGTABLE - CALL WAVNU_LOCAL(SIG(IK),DW(ISEA),WN1(IK),CG1(IK)) -#else - CG1(IK) = CG(IK,ISEA) -#endif - VA(ISP,JSEA) = VA(ISP,JSEA) / CG1(IK) * CLATS(ISEA) - END DO - END DO - VAOLD = VA(1:NSPEC,1:NSEAL) - -#ifdef W3_DEBUGSRC - DO JSEA=1,NSEAL - WRITE(740+IAPROC,*) 'JSEA=', JSEA - WRITE(740+IAPROC,*) 'min/max/sum(VA)=', minval(VA(:,JSEA)), maxval(VA(:,JSEA)), sum(VA(:,JSEA)) - END DO -#endif -#ifdef W3_DEBUGSOLVERCOH - CALL ALL_VA_INTEGRAL_PRINT(IMOD, "VA(np) just defined", 0) - CALL ALL_VA_INTEGRAL_PRINT(IMOD, "VA(npa) just defined", 1) -#endif -#ifdef W3_DEBUGSOLVER - FLUSH(740+IAPROC) - WRITE(740+IAPROC,*) 'JACOBI_SOLVER, step 4' - WRITE(740+IAPROC,*) 'FSSOURCE=', FSSOURCE - WRITE(740+IAPROC,*) 'FSREFRACTION=', FSREFRACTION - WRITE(740+IAPROC,*) 'FSFREQSHIFT=', FSFREQSHIFT - WRITE(740+IAPROC,*) 'FSGEOADVECT=', FSGEOADVECT - WRITE(740+IAPROC,*) 'DTG=', DTG -#endif - ! - ! init matrix and right hand side - ! - call print_memcheck(memunit, 'memcheck_____:'//' WW3_PROP SECTION 2') - ! - IF (.not. LSLOC) THEN - IF (IMEM == 1) THEN - ASPAR_JAC = ZERO - ELSE IF (IMEM == 2) THEN - ASPAR_DIAG_ALL = ZERO - ENDIF - B_JAC = ZERO - ENDIF - call print_memcheck(memunit, 'memcheck_____:'//' WW3_PROP SECTION 3') - ! - ! source terms - ! - IF (FSSOURCE) THEN - IF (.not. LSLOC) THEN - IF (IMEM == 1) THEN - call CALCARRAY_JACOBI_SOURCE_1(DTG) - ELSE IF (IMEM == 2) THEN - call CALCARRAY_JACOBI_SOURCE_2(DTG,ASPAR_DIAG_ALL) - ENDIF - ENDIF - END IF - call print_memcheck(memunit, 'memcheck_____:'//' WW3_PROP SECTION 4') - ! - ! geographical advection - ! - IF (IMEM == 1) call calcARRAY_JACOBI_VEC(DTG,FACX,FACY,VGX,VGY) - - do ip = 1, np - IP_glob =iplg(IP) - ISEA = MAPFS(1,IP_glob) - JSEA = JX_TO_JSEA(IP) - ! IF (ISEA == 28447) write(740+IAPROC,*) 'SOLVER ENTRY', ISEA, JSEA, SUM(B_JAC(:,JSEA)), & - ! SUM(ASPAR_JAC(:,PDLIB_I_DIAG(JSEA))), PDLIB_I_DIAG(JSEA) - enddo - - -#ifdef W3_DEBUGSOLVER - !WRITE(740+IAPROC,'(A20,20E20.10)') 'SUM BJAC 1', sum(B_JAC), SUM(ASPAR_JAC) -#endif - call print_memcheck(memunit, 'memcheck_____:'//' WW3_PROP SECTION 5') - ! -#ifdef W3_DEBUGSOLVER - !WRITE(740+IAPROC,'(A20,20E20.10)') 'SUM BJAC 1', sum(B_JAC), SUM(ASPAR_JAC) -#endif - - ! - ! spectral advection - ! - IF (FSFREQSHIFT .or. FSREFRACTION) THEN - IF (IMEM == 1) THEN - call calcARRAY_JACOBI_SPECTRAL_1(DTG) - ELSE IF (IMEM == 2) THEN - call calcARRAY_JACOBI_SPECTRAL_2(DTG,ASPAR_DIAG_ALL) - ENDIF - END IF - CALL APPLY_BOUNDARY_CONDITION(IMOD) - call print_memcheck(memunit, 'memcheck_____:'//' WW3_PROP SECTION 6') - ! -#ifdef W3_DEBUGSOLVERCOH - CALL CHECK_ARRAY_INTEGRAL_NX_R8(B_JAC, "B_JAC after calcARRAY", np) - DO IP=1,npa - TheArr(:, IP)=REAL(ASPAR_JAC(:, PDLIB_I_DIAG(IP))) - END DO - CALL CHECK_ARRAY_INTEGRAL_NX_R8(TheArr, "ASPAR diag after calArr", np) -#endif - nbIter=0 - do ip = 1, np - Lconverged(ip) = .false. -#ifdef WEIGHTS - ipiter(ip) = 0 -#endif - enddo - ! - DO - - is_converged = 0 - - ! WRITE(740+IAPROC,*) myrank, 'start solver', nbiter - call print_memcheck(memunit, 'memcheck_____:'//' WW3_PROP SECTION SOLVER LOOP 1') - - DO IP = 1, np - - IP_glob = iplg(IP) - ISEA = MAPFS(1,IP_glob) - - !WRITE(*,*) 'TEST VA 1', IP, SUM(VA(:,IP)), lconverged(ip) - - IF (IOBDP_LOC(IP) .eq. 0) THEN - is_converged = is_converged + 1 - lconverged(ip) = .true. - CYCLE - ENDIF - - DO IK = 0, NK + 1 -#ifdef NOCGTABLE - CALL WAVNU_LOCAL(SIG(IK),DW(ISEA),WN1(IK),CG1(IK)) -#else - CG1(IK) = CG(IK,ISEA) - WN1(IK) = WN(IK,ISEA) -#endif - ENDDO - - JSEA = JX_TO_JSEA(IP) - ISEA = MAPFS(1,IP_glob) - eSI = PDLIB_SI(IP) - ACLOC = VA(:,JSEA) - - IF (.NOT. LCONVERGED(IP)) THEN -#ifdef WEIGHTS - ipiter(ip) = ipiter(ip) + 1 -#endif -#ifdef W3_DEBUGFREQSHIFT - WRITE(740+IAPROC,*) 'Begin loop' - WRITE(740+IAPROC,*) 'IP/IP_glob/ISEA/JSEA=', IP, IP_glob, ISEA, JSEA -#endif -#ifdef W3_DEBUGSRC - WRITE(740+IAPROC,*) 'IP=', IP, ' IP_glob=', IP_glob - WRITE(740+IAPROC,*) 'sum(VA)in=', sum(VA(:,IP)) -#endif -#ifdef W3_DEBUGFREQSHIFT - DO ISP=1,NSPEC - VAold(ISP) = VA(ISP,JSEA) - IK=MAPWN(ISP) - VAinput(ISP) = DBLE(CG(IK,ISEA)/CLATS(ISEA)) * VA(ISP, IP) - VAacloc(ISP) = DBLE(CG(IK,ISEA)/CLATS(ISEA)) * ACLOC(ISP) - END DO - WRITE(740+IAPROC,*) 'sum(VAold/VAinput/VAacloc)=', sum(VAold), sum(VAinput), sum(VAacloc) -#endif - - Sum_Prev = sum(ACLOC) - - IF (IMEM == 2) THEN - CALL calcARRAY_JACOBI4(IP,DTG,FACX,FACY,VGX,VGY,ASPAR_DIAG_LOCAL,ASPAR_OFF_DIAG_LOCAL,B_JAC_LOCAL) - !WRITE(*,'(A10,10F20.10)') 'JAC4', SUM(ASPAR_DIAG_LOCAL), SUM(ASPAR_OFF_DIAG_LOCAL), SUM(B_JAC_LOCAL) - !CALL calcARRAY_JACOBI3(IP,DTG,FACX,FACY,VGX,VGY,ASPAR_DIAG_LOCAL,ASPAR_OFF_DIAG_LOCAL,B_JAC_LOCAL) - !WRITE(*,'(A10,10F20.10)') 'JAC3', SUM(ASPAR_DIAG_LOCAL), SUM(ASPAR_OFF_DIAG_LOCAL), SUM(B_JAC_LOCAL) - ASPAR_DIAG(1:NSPEC) = ASPAR_DIAG_LOCAL(1:NSPEC) + ASPAR_DIAG_ALL(1:NSPEC,IP) - !IF (ANY(ABS(ASPAR_DIAG) .LT. TINY(1.))) THEN - ! WRITE(*,'(8I10,4F20.10)') IP, JSEA, ISEA, NSEA, NSEAL, np, npa, IP_glob, SUM(ASPAR_DIAG), SUM(ASPAR_DIAG_LOCAL), SUM(ASPAR_DIAG_ALL(:,IP)), SUM(B_JAC(:,IP)) - ! CALL PDLIB_ABORT(25) - !ENDIF - esum = B_JAC_LOCAL - ASPAR_OFF_DIAG_LOCAL + B_JAC(1:NSPEC,IP) - ELSEIF (IMEM == 1) THEN - !CALL calcARRAY_JACOBI4(IP,ICOUNT2,DTG,FACX,FACY,VGX,VGY,ASPAR_DIAG_LOCAL,ASPAR_OFF_DIAG_LOCAL,B_JAC_LOCAL) - !WRITE(*,'(A10,10F20.10)') 'JAC4', SUM(ASPAR_DIAG_LOCAL), SUM(ASPAR_OFF_DIAG_LOCAL), SUM(B_JAC_LOCAL) - !CALL calcARRAY_JACOBI3(IP,ICOUNT1,DTG,FACX,FACY,VGX,VGY,ASPAR_DIAG_LOCAL,ASPAR_OFF_DIAG_LOCAL,B_JAC_LOCAL) - !WRITE(*,'(A10,10F20.10)') 'JAC3', SUM(ASPAR_DIAG_LOCAL), SUM(ASPAR_OFF_DIAG_LOCAL), SUM(B_JAC_LOCAL) - eSum(1:NSPEC) = B_JAC(1:NSPEC,IP) - ASPAR_DIAG(1:NSPEC) = ASPAR_JAC(1:NSPEC,PDLIB_I_DIAG(IP)) - !IF (IP_glob == 64058) WRITE(740+IAPROC,*) 'TEST ASPAR B_JAC', IP, SUM(B_JAC(1:NSPEC,IP)), SUM(ASPAR_DIAG) -#ifdef W3_DEBUGFREQSHIFT - WRITE(740+IAPROC,*) 'eSI=', eSI - WRITE(740+IAPROC,*) 'sum(ASPAR_DIAG)=', sum(ASPAR_DIAG) + REAL :: VAinput(NSPEC), VAacloc(NSPEC), ASPAR_DIAG(NSPEC) + REAL :: aspar_diag_local(nspec), aspar_off_diag_local(nspec), b_jac_local(nspec) + REAL*8 :: eDiffSing, eSumPart + REAL :: EMEAN, FMEAN, FMEAN1, WNMEAN, AMAX, U10ABS, U10DIR, TAUA, TAUADIR + REAL :: USTAR, USTDIR, TAUWX, TAUWY, CD, Z0, CHARN, FMEANWS, DLWMEAN + REAL*8 :: eVal1, eVal2 + REAL*8 :: eVA, eVO, CG2, NEWDAC, NEWAC, OLDAC, MAXDAC + REAL :: CG1(0:NK+1), WN1(0:NK+1) + LOGICAL :: LCONVERGED(NSEAL), lexist, LLWS(NSPEC) +#ifdef WEIGHTS + INTEGER :: ipiter(nseal), ipitergl(np_global), ipiterout(np_global) #endif #ifdef W3_DEBUGSRC - WRITE(740+IAPROC,*) 'Step 1: sum(eSum)=', sum(eSum) -#endif -#ifdef W3_DEBUGSOLVERCOH - eOff=ZERO -#endif - DO i = PDLIB_IA_P(IP)+1, PDLIB_IA_P(IP+1) - JP = PDLIB_JA(I) - IF (JP .ne. IP) THEN - eProd = ASPAR_JAC(1:NSPEC,i) * VA(1:NSPEC,JP) - eSum = eSum - eProd -#ifdef W3_DEBUGSOLVERALL - WRITE(740+IAPROC,'(A20,3I10,20E20.10)') 'OFF DIAGONAL', IP, i, jp, sum(B_JAC(:,IP)), sum(eSum), SUM(ASPAR_JAC(:,i)), SUM(VA(:,JP)) + REAL :: IntDiff, eVA_w3srce, eVAsolve, SumACout + REAL :: SumVAin, SumVAout, SumVAw3srce, SumVS, SumVD, VS_w3srce + REAL :: VAsolve(NSPEC) + REAL*8 :: ACsolve + REAL :: eB #endif #ifdef W3_DEBUGSOLVERCOH - eOff=eOff + abs(ASPAR_JAC(:,i)) + REAL :: TheARR(NSPEC, npa) + REAL :: PRE_VA(NSPEC, npa) + REAL :: OffDIAG(NSPEC, npa) + REAL*8 :: eOff(NSPEC) + REAL*8 :: eSum1(NSPEC), eSum2(NSPEC) #endif - END IF - END DO - ENDIF ! IMEM + CHARACTER(len=128) eFile + INTEGER ierr, i + INTEGER JP_glob + INTEGER is_converged, itmp + INTEGER :: TESTNODE = 923 + + LOGICAL :: LSIG = .FALSE. + + memunit = 50000+IAPROC + !AR: this is missing in init ... but there is a design error in ww3_grid with FLCUR and FLLEV + LSIG = FLCUR .OR. FLLEV #ifdef W3_DEBUGSOLVERCOH - OffDiag(:, IP)=REAL(eOff) -#endif -#ifdef W3_DEBUGSOLVERCOHALL - WRITE(740+IAPROC,*) 'Step 2: sum(eSum)=', sum(eSum), ' eOff=', sum(eOff) + OffDIAG = ZERO #endif - IF (FSREFRACTION) THEN -#ifdef W3_DEBUGREFRACTION - WRITE(740+IAPROC,*) 'Adding refraction terms to eSum' + call print_memcheck(memunit, 'memcheck_____:'//' WW3_PROP SECTION 0') + + + CCURX = FACX + CCURY = FACY + CALL MPI_COMM_RANK(MPI_COMM_WCMP, myrank, ierr) + ! +#ifdef W3_DEBUGSOLVER + WRITE(740+IAPROC,*) 'PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK, begin' + WRITE(740+IAPROC,*) 'NX=', NX + WRITE(740+IAPROC,*) 'NP=', NP + WRITE(740+IAPROC,*) 'NPA=', NPA + WRITE(740+IAPROC,*) 'NSEA=', NSEA + WRITE(740+IAPROC,*) 'NSEAL=', NSEAL + WRITE(740+IAPROC,*) 'NBI=', NBI + WRITE(740+IAPROC,*) 'B_JGS_TERMINATE_NORM=', B_JGS_TERMINATE_NORM + WRITE(740+IAPROC,*) 'B_JGS_TERMINATE_DIFFERENCE=', B_JGS_TERMINATE_DIFFERENCE + WRITE(740+IAPROC,*) 'B_JGS_TERMINATE_MAXITER=', B_JGS_TERMINATE_MAXITER + WRITE(740+IAPROC,*) 'B_JGS_MAXITER=', B_JGS_MAXITER + WRITE(740+IAPROC,*) 'B_JGS_BLOCK_GAUSS_SEIDEL=', B_JGS_BLOCK_GAUSS_SEIDEL + WRITE(740+IAPROC,*) 'FSREFRACTION=', FSREFRACTION + WRITE(740+IAPROC,*) 'FSFREQSHIFT=', FSFREQSHIFT + WRITE(740+IAPROC,*) 'B_JGS_LIMITER=', B_JGS_LIMITER + WRITE(740+IAPROC,*) 'B_JGS_BLOCK_GAUSS_SEIDEL=', B_JGS_BLOCK_GAUSS_SEIDEL + FLUSH(740+IAPROC) #endif - CAD = CAD_THE(:,IP) - DO ISP=1,NSPEC - ISPprevDir=ListISPprevDir(ISP) - ISPnextDir=ListISPnextDir(ISP) - eA_THE = - DTG*eSI*MAX(ZERO,CAD(ISPprevDir)) - eC_THE = DTG*eSI*MIN(ZERO,CAD(ISPnextDir)) - eSum(ISP) = eSum(ISP) - eA_THE * VA(ISPprevDir,IP) - eSum(ISP) = eSum(ISP) - eC_THE * VA(ISPnextDir,IP) - END DO - END IF #ifdef W3_DEBUGSRC - WRITE(740+IAPROC,*) 'Step 3: sum(eSum)=', sum(eSum) -#endif - IF (FSFREQSHIFT .and. LSIG) THEN - IF (FreqShiftMethod .eq. 1) THEN - CAS = CAS_SIG(:,IP) - CP_SIG = MAX(ZERO,CAS) - CM_SIG = MIN(ZERO,CAS) - DO IK=0, NK - DMM(IK+1) = DBLE(WN1(IK+1) - WN1(IK)) - END DO - DMM(NK+2) = ZERO - DMM(0)=DMM(1) - DO ITH=1,NTH - DO IK=2,NK - ISP = ITH + (IK -1)*NTH - ISPm1 = ITH + (IK-1 -1)*NTH - eFactM1 = CG1(IK-1) / CG1(IK) - eA_SIG = - eSI * CP_SIG(ISPm1)/DMM(IK-1) * eFactM1 - eSum(ISP) = eSum(ISP) - eA_SIG*VA(ISPm1,IP) - END DO - DO IK=1,NK-1 - ISP = ITH + (IK -1)*NTH - ISPp1 = ITH + (IK+1 -1)*NTH - eFactP1 = CG1(IK+1) / CG1(IK) - eC_SIG = eSI * CM_SIG(ISPp1)/DMM(IK) * eFactP1 - eSum(ISP) = eSum(ISP) - eC_SIG*VA(ISPp1,IP) - END DO - END DO - ELSE IF (FreqShiftMethod .eq. 2) THEN - CWNB_M2=CWNB_SIG_M2(:,IP) - DO IK=1, NK - DWNI_M2(IK) = DBLE( CG1(IK) / DSIP(IK) ) - END DO -#ifdef W3_DEBUGFREQSHIFT - WRITE(740+IAPROC,*) 'Before FreqShift oper eSum=', sum(abs(eSum)) -#endif - DO ITH=1,NTH - DO IK=2,NK - ISP = ITH + (IK -1)*NTH - ISPm1 = ITH + (IK-1 -1)*NTH - eFactM1 = DBLE( CG1(IK-1) / CG1(IK) ) - eA_SIG = - eSI * DWNI_M2(IK) * MAX(CWNB_M2(ISPm1),ZERO) *eFactM1 - eSum(ISP) = eSum(ISP) - eA_SIG*VA(ISPm1,IP) - END DO - DO IK=1,NK-1 - ISP = ITH + (IK -1)*NTH - ISPp1 = ITH + (IK+1 -1)*NTH - eFactP1 = DBLE( CG1(IK+1) / CG1(IK) ) - eC_SIG = eSI * DWNI_M2(IK) * MIN(CWNB_M2(ISP),ZERO) * eFactP1 - eSum(ISP) = eSum(ISP) - eC_SIG*VA(ISPp1,IP) - END DO - END DO -#ifdef W3_DEBUGFREQSHIFT - WRITE(740+IAPROC,*) ' after FreqShift oper eSum=', sum(abs(eSum)) + WRITE(740+IAPROC,*) 'optionCall=', optionCall + FLUSH(740+IAPROC) #endif - END IF - END IF + call print_memcheck(memunit, 'memcheck_____:'//' WW3_PROP SECTION 1') + ! + ! 2. Convert to Wave Action ---------------- * + ! #ifdef W3_DEBUGSRC - WRITE(740+IAPROC,*) 'Step 4: sum(eSum)=', sum(eSum) + WRITE(740+IAPROC,*) 'NSEAL =', NSEAL, 'NP =', NP, 'NPA =', NPA #endif #ifdef W3_DEBUGSOLVERCOH - PRE_VA(:, IP)=REAL(eSum) + CALL ALL_VA_INTEGRAL_PRINT(IMOD, "VA(np) before transform", 0) + CALL ALL_VA_INTEGRAL_PRINT(IMOD, "VA(npa) before transform", 1) #endif - eSum(1:NSPEC) = eSum(1:NSPEC) / ASPAR_DIAG(1:NSPEC) -#ifdef W3_DEBUGFREQSHIFT - WRITE(740+IAPROC,*) 'JSEA=', JSEA, ' nbIter=', nbIter - DO ISP=1,NSPEC - IK=MAPWN(ISP) - VAnew(ISP) = DBLE(CG(IK,ISEA)/CLATS(ISEA)) * eSum(ISP) - END DO - DO ISP=1,NSPEC - VAAnew(ISP) = VAnew(ISP) - VAAacloc(ISP) = VAacloc(ISP) - END DO - DO ITH=1,NTH - VAAnew(ITH + NSPEC) = FACHFA * VAAnew(ITH + NSPEC - NTH) - VAAnew(ITH - NTH ) = 0. - VAAacloc(ITH + NSPEC) = FACHFA * VAAacloc(ITH + NSPEC - NTH) - VAAacloc(ITH - NTH ) = 0. - END DO - DO ISP=1-NTH,NSPEC - VFLWN(ISP) = MAX(CWNB_M2(ISP),0.) * VAAnew(ISP) + MIN(CWNB_M2(ISP),0.) * VAAnew(ISP + NTH) - END DO - DO ISP=1,NSPEC - eDiff(ISP) = VAnew(ISP) - VAold(ISP) - DWNI_M2(MAPWN(ISP)) * (VFLWN(ISP-NTH) - VFLWN(ISP) ) - eVal1=MAX(CWNB_M2(ISP-NTH),0.) * VAAacloc(ISP-NTH) + MIN(CWNB_M2(ISP-NTH),0.) * VAAnew(ISP) - eVal2=MAX(CWNB_M2(ISP),0.) * VAAnew(ISP) + MIN(CWNB_M2(ISP),0.) * VAAacloc(ISP + NTH) - eDiffB(ISP) = VAnew(ISP) - VAold(ISP) - DWNI_M2(MAPWN(ISP)) * (eVal1 - eVal2) - END DO - IF (ISEA .eq. 190) THEN - DO IK=1,NK - DO ITH=1,NTH - ISP = ITH + (IK-1)*NTH - WRITE(740+IAPROC,*) 'ISP/ITH/IK=', ISP, ITH, IK - WRITE(740+IAPROC,*) 'eDiff(A/B)=', eDiff(ISP), eDiffB(ISP) - END DO - END DO - END IF - WRITE(740+IAPROC,*) 'NK=', NK, ' NTH=', NTH - eSumPart=0 - DO IK=1,NK - DO ITH=1,NTH - ISP = ITH + (IK-1)*NTH - eSumPart = eSumPart + abs(eDiff(ISP)) - END DO - IF (ISEA .eq. 190) THEN - WRITE(740+IAPROC,*) 'IK=', IK, ' eSumDiff=', eSumPart - END IF - END DO - WRITE(740+IAPROC,*) 'sum(eDiff/VAnew/VAold)=', sum(abs(eDiff)), sum(abs(VAnew)), sum(abs(VAold)) + DO JSEA=1,NSEAL + IP = JSEA + IP_glob = iplg(IP) + ISEA = MAPFS(1,IP_glob) + DO ISP=1,NSPEC + ITH = 1 + MOD(ISP-1,NTH) + IK = 1 + (ISP-1)/NTH +#ifdef NOCGTABLE + CALL WAVNU_LOCAL(SIG(IK),DW(ISEA),WN1(IK),CG1(IK)) +#else + CG1(IK) = CG(IK,ISEA) #endif + VA(ISP,JSEA) = VA(ISP,JSEA) / CG1(IK) * CLATS(ISEA) + END DO + END DO + VAOLD = VA(1:NSPEC,1:NSEAL) - !AR: Must go outside of the iterative loop ... - !IF (B_JGS_LIMITER) THEN - ! CALL ACTION_LIMITER_LOCAL(IP, eSum, ACLOC, DTG) - !END IF - - IF (B_JGS_BLOCK_GAUSS_SEIDEL) THEN - VA(1:NSPEC,IP) = eSum !* IOBDP_LOC(IP)*DBLE(IOBPD_LOC(ITH,IP)) - !IF (IP_glob == 64058) WRITE(740+IAPROC,*) 'TEST SUM VA', IP, SUM(VA(1:NSPEC,IP)), DW(ISEA) - ELSE - U_JAC(1:NSPEC,IP) = eSum - END IF - ELSE - esum = VA(1:NSPEC,IP) - ENDIF ! LCONVERGED - - IF (B_JGS_TERMINATE_DIFFERENCE) THEN - Sum_New = sum(eSum) - if (Sum_new .gt. 0.d0) then - DiffNew = abs(sum(ACLOC-eSum))/Sum_new -#ifdef W3_DEBUGFREQSHIFT - WRITE(740+IAPROC,*) 'DiffNew=', DiffNew, ' Sum_new=', Sum_new +#ifdef W3_DEBUGSRC + DO JSEA=1,NSEAL + WRITE(740+IAPROC,*) 'JSEA=', JSEA + WRITE(740+IAPROC,*) 'min/max/sum(VA)=', minval(VA(:,JSEA)), maxval(VA(:,JSEA)), sum(VA(:,JSEA)) + END DO #endif - p_is_converged = DiffNew - else - p_is_converged = zero - endif -#ifdef W3_DEBUGFREQSHIFT - WRITE(740+IAPROC,*) 'p_is_converged=', p_is_converged + +#ifdef W3_DEBUGSOLVERCOH + CALL ALL_VA_INTEGRAL_PRINT(IMOD, "VA(np) just defined", 0) + CALL ALL_VA_INTEGRAL_PRINT(IMOD, "VA(npa) just defined", 1) #endif - IF (p_is_converged .lt. B_JGS_DIFF_THR .and. nbiter .gt. 1) then - is_converged = is_converged + 1 - lconverged(ip) = .true. - ELSE - lconverged(ip) = .false. - !write(*,*) ip, is_converged, p_is_converged, iobp_loc(ip), iobdp_loc(ip) - ENDIF - END IF - !IF (IP == 2) STOP -#ifdef W3_DEBUGSRC - WRITE(740+IAPROC,*) 'sum(VA)out=', sum(VA(:,IP)) + +#ifdef W3_DEBUGSOLVER + FLUSH(740+IAPROC) + WRITE(740+IAPROC,*) 'JACOBI_SOLVER, step 4' + WRITE(740+IAPROC,*) 'FSSOURCE=', FSSOURCE + WRITE(740+IAPROC,*) 'FSREFRACTION=', FSREFRACTION + WRITE(740+IAPROC,*) 'FSFREQSHIFT=', FSFREQSHIFT + WRITE(740+IAPROC,*) 'FSGEOADVECT=', FSGEOADVECT + WRITE(740+IAPROC,*) 'DTG=', DTG #endif - !WRITE(*,*) 'TEST VA 2', IP, SUM(VA(:,IP)), IOBDP_LOC(IP), IOBPA_LOC(IP) - END DO ! IP - - ! WRITE(740+IAPROC,*) myrank, 'afer vertex loop', nbiter - call print_memcheck(memunit, 'memcheck_____:'//' WW3_PROP SECTION SOLVER LOOP 2') + ! + ! init matrix and right hand side + ! + call print_memcheck(memunit, 'memcheck_____:'//' WW3_PROP SECTION 2') + ! + IF (.not. LSLOC) THEN + IF (IMEM == 1) THEN + ASPAR_JAC = ZERO + ELSE IF (IMEM == 2) THEN + ASPAR_DIAG_ALL = ZERO + ENDIF + B_JAC = ZERO + ENDIF + call print_memcheck(memunit, 'memcheck_____:'//' WW3_PROP SECTION 3') + ! + ! source terms + ! + IF (FSSOURCE) THEN + IF (.not. LSLOC) THEN + IF (IMEM == 1) THEN + call CALCARRAY_JACOBI_SOURCE_1(DTG) + ELSE IF (IMEM == 2) THEN + call CALCARRAY_JACOBI_SOURCE_2(DTG,ASPAR_DIAG_ALL) + ENDIF + ENDIF + END IF + call print_memcheck(memunit, 'memcheck_____:'//' WW3_PROP SECTION 4') + ! + ! geographical advection + ! + IF (IMEM == 1) THEN + call calcARRAY_JACOBI_VEC(DTG,FACX,FACY,VGX,VGY) + ENDIF -#ifdef W3_DEBUGSOLVERCOH - WRITE (eFile,40) nbIter -40 FORMAT ('PRE_VA_',i4.4,'.txt') - CALL CHECK_ARRAY_INTEGRAL_NX_R8(OffDiag, "OffDiag(np) just check", np) - ! CALL WRITE_VAR_TO_TEXT_FILE(PRE_VA, eFile) - CALL CHECK_ARRAY_INTEGRAL_NX_R8(PRE_VA, "PRE_VA(np) just check", np) - CALL ALL_VA_INTEGRAL_PRINT(IMOD, "VA(np) before exchanges", 0) -#endif - IF (B_JGS_BLOCK_GAUSS_SEIDEL) THEN - CALL PDLIB_exchange2DREAL_zero(VA) - ELSE - CALL PDLIB_exchange2DREAL(U_JAC) - VA(:,1:NPA) = U_JAC - END IF - call print_memcheck(memunit, 'memcheck_____:'//' WW3_PROP SECTION SOLVER LOOP 3') - ! - ! Terminate via number of iteration - ! - IF (B_JGS_TERMINATE_MAXITER) THEN - IF (nbIter .gt. B_JGS_MAXITER) THEN #ifdef W3_DEBUGSOLVER - WRITE(740+IAPROC,*) 'Exiting by TERMINATE_MAXITER' + WRITE(740+IAPROC,'(A20,20E20.10)') 'SUM BJAC 1', sum(B_JAC), SUM(ASPAR_JAC) #endif - EXIT - END IF - END IF - call print_memcheck(memunit, 'memcheck_____:'//' WW3_PROP SECTION SOLVER LOOP 4') - ! - ! Terminate via differences - ! - IF (B_JGS_TERMINATE_DIFFERENCE) THEN - !WRITE(740+IAPROC,*) myrank, 'solver before', nbiter, is_converged, prop_conv, B_JGS_PMIN - CALL MPI_ALLREDUCE(is_converged, itmp, 1, MPI_INT, MPI_SUM, MPI_COMM_WCMP, ierr) - is_converged = itmp - prop_conv = (DBLE(NX) - DBLE(is_converged))/DBLE(NX) * 100. - !write(*,*) prop_conv, nbIter, is_converged - !WRITE(740+IAPROC,*) myrank, 'solver', nbiter, is_converged, prop_conv, B_JGS_PMIN + call print_memcheck(memunit, 'memcheck_____:'//' WW3_PROP SECTION 5') + ! #ifdef W3_DEBUGSOLVER - WRITE(740+IAPROC,*) 'solver', nbiter, is_converged, prop_conv, B_JGS_PMIN - FLUSH(740+IAPROC) + WRITE(740+IAPROC,'(A20,20E20.10)') 'SUM BJAC 1', sum(B_JAC), SUM(ASPAR_JAC) #endif - IF (myrank == 0) WRITE(*,*) 'No. of solver iterations', nbiter, is_converged, prop_conv, B_JGS_PMIN - IF (prop_conv .le. B_JGS_PMIN + TINY(1.)) THEN -#ifdef W3_DEBUGFREQSHIFT - WRITE(740+IAPROC,*) 'prop_conv=', prop_conv - WRITE(740+IAPROC,*) 'NX=', NX - WRITE(740+IAPROC,*) 'is_converged=', is_converged - WRITE(740+IAPROC,*) 'Exiting by TERMINATE_DIFFERENCE' + ! + ! spectral advection + ! + IF (FSFREQSHIFT .or. FSREFRACTION) THEN + IF (IMEM == 1) THEN + call calcARRAY_JACOBI_SPECTRAL_1(DTG) + ELSE IF (IMEM == 2) THEN + call calcARRAY_JACOBI_SPECTRAL_2(DTG,ASPAR_DIAG_ALL) + ENDIF + END IF + CALL APPLY_BOUNDARY_CONDITION(IMOD) + call print_memcheck(memunit, 'memcheck_____:'//' WW3_PROP SECTION 6') + ! +#ifdef W3_DEBUGSOLVERCOH + CALL CHECK_ARRAY_INTEGRAL_NX_R8(B_JAC, "B_JAC after calcARRAY", np) + DO IP=1,npa + TheArr(:, IP)=REAL(ASPAR_JAC(:, PDLIB_I_DIAG(IP))) + END DO + CALL CHECK_ARRAY_INTEGRAL_NX_R8(TheArr, "ASPAR diag after calArr", np) #endif - EXIT - END IF - END IF - call print_memcheck(memunit, 'memcheck_____:'//' WW3_PROP SECTION SOLVER LOOP 5') - ! - ! Terminate via norm - ! - IF (B_JGS_TERMINATE_NORM) THEN - Sum_L2 =0 - DO IP = 1, np - IP_glob=iplg(IP) - IF (IOBP_LOC(IP).eq.1) THEN - JSEA=JX_TO_JSEA(IP) - eSI=PDLIB_SI(IP) - eSum=B_JAC(:,IP) - ACLOC=VA(:,IP) - ISEA= MAPFS(1,IP_glob) - eSum(:) = eSum(:) - ASPAR_DIAG(:)*ACLOC - DO I = PDLIB_IA_P(IP)+1, PDLIB_IA_P(IP+1) - JP=PDLIB_JA(I) - eSum(:) = eSum(:) - ASPAR_JAC(:,i)*VA(:,JP) - END DO - IF (FSREFRACTION) THEN - CAD=CAD_THE(:,IP) - DO ISP=1,NSPEC - ISPprevDir=ListISPprevDir(ISP) - ISPnextDir=ListISPnextDir(ISP) - eA_THE = - DTG*eSI*MAX(ZERO,CAD(ISPprevDir)) - eC_THE = DTG*eSI*MIN(ZERO,CAD(ISPnextDir)) - eSum(ISP) = eSum(ISP) - eA_THE*VA(ISPprevDir,IP) - eSum(ISP) = eSum(ISP) - eC_THE*VA(ISPnextDir,IP) - END DO - END IF - IF (FSFREQSHIFT) THEN - CAS=CAS_SIG(:,IP) - CP_SIG = MAX(ZERO,CAS) - CM_SIG = MIN(ZERO,CAS) - DO IK = 0, NK + 1 + nbIter=0 + do ip = 1, np + Lconverged(ip) = .false. +#ifdef WEIGHTS + ipiter(ip) = 0 +#endif + enddo + ! + DO + + is_converged = 0 + + call print_memcheck(memunit, 'memcheck_____:'//' WW3_PROP SECTION SOLVER LOOP 1') + + DO IP = 1, np + + IP_glob = iplg(IP) + ISEA = MAPFS(1,IP_glob) + IF (IOBDP_LOC(IP) .eq. 0) THEN + is_converged = is_converged + 1 + lconverged(ip) = .true. + CYCLE + ENDIF + + DO IK = 0, NK + 1 #ifdef NOCGTABLE - CALL WAVNU_LOCAL(SIG(IK),DW(ISEA),WN1(IK),CG1(IK)) + CALL WAVNU_LOCAL(SIG(IK),DW(ISEA),WN1(IK),CG1(IK)) #else - CG1(IK) = CG(IK,ISEA) - WN1(IK) = WN(IK,ISEA) + CG1(IK) = CG(IK,ISEA) + WN1(IK) = WN(IK,ISEA) #endif - ENDDO - DO ITH=1,NTH - IF (IOBPD_LOC(ITH,IP) .NE. 0) THEN - DO IK=2,NK - ISP =ITH + (IK -1)*NTH - ISPm1=ITH + (IK-1-1)*NTH - eFactM1=CG(IK-1,ISEA) / CG1(IK) - eA_SIG= - eSI*CP_SIG(ISPm1)/DMM(IK-1) * eFactM1 - eSum(ISP) = eSum(ISP) - eA_SIG*VA(ISPm1,IP) - END DO - DO IK=1,NK-1 - ISP =ITH + (IK -1)*NTH - ISPp1=ITH + (IK+1-1)*NTH - eFactP1=CG(IK+1,ISEA) / CG1(IK) - eC_SIG= eSI*CM_SIG(ISPp1)/DMM(IK) * eFactP1 - eSum(ISP) = eSum(ISP) - eC_SIG*VA(ISPp1,IP) - END DO - END IF - END DO - END IF - Sum_L2 = Sum_L2 + sum(eSum*eSum) - END IF - END DO - CALL MPI_ALLREDUCE(Sum_L2, Sum_L2_GL, 1, rtype, MPI_SUM, MPI_COMM_WCMP, ierr) - !WRITE(*,*) 'Sum_L2_gl=', Sum_L2_gl -#ifdef W3_DEBUGSOLVER - WRITE(740+IAPROC,*) 'Sum_L2_gl=', Sum_L2_gl - FLUSH(740+IAPROC) + ENDDO + + JSEA = JX_TO_JSEA(IP) + ISEA = MAPFS(1,IP_glob) + eSI = PDLIB_SI(IP) + ACLOC = VA(:,JSEA) + + IF (.NOT. LCONVERGED(IP)) THEN +#ifdef WEIGHTS + ipiter(ip) = ipiter(ip) + 1 #endif - IF (Sum_L2_gl .le. B_JGS_NORM_THR) THEN #ifdef W3_DEBUGFREQSHIFT - WRITE(740+IAPROC,*) 'Exiting by TERMINATE_NORM' + WRITE(740+IAPROC,*) 'Begin loop' + WRITE(740+IAPROC,*) 'IP/IP_glob/ISEA/JSEA=', IP, IP_glob, ISEA, JSEA +#endif +#ifdef W3_DEBUGSRC + WRITE(740+IAPROC,*) 'IP=', IP, ' IP_glob=', IP_glob + WRITE(740+IAPROC,*) 'sum(VA)in=', sum(VA(:,IP)) +#endif +#ifdef W3_DEBUGFREQSHIFT + DO ISP=1,NSPEC + VAold(ISP) = VA(ISP,JSEA) + IK=MAPWN(ISP) + VAinput(ISP) = DBLE(CG(IK,ISEA)/CLATS(ISEA)) * VA(ISP, IP) + VAacloc(ISP) = DBLE(CG(IK,ISEA)/CLATS(ISEA)) * ACLOC(ISP) + END DO + WRITE(740+IAPROC,*) 'sum(VAold/VAinput/VAacloc)=', sum(VAold), sum(VAinput), sum(VAacloc) #endif - EXIT - END IF - END IF - call print_memcheck(memunit, 'memcheck_____:'//' WW3_PROP SECTION SOLVER LOOP 6') - - nbiter = nbiter + 1 - END DO ! Open Do Loop ... End of Time Interval + Sum_Prev = sum(ACLOC) -#ifdef W3_DEBUGSOLVER - WRITE(740+IAPROC,*) 'nbIter=', nbIter, ' B_JGS_MAXITER=', B_JGS_MAXITER - FLUSH(740+IAPROC) + IF (IMEM == 2) THEN + CALL calcARRAY_JACOBI4(IP,DTG,FACX,FACY,VGX,VGY,ASPAR_DIAG_LOCAL,ASPAR_OFF_DIAG_LOCAL,B_JAC_LOCAL) + ASPAR_DIAG(1:NSPEC) = ASPAR_DIAG_LOCAL(1:NSPEC) + ASPAR_DIAG_ALL(1:NSPEC,IP) + esum = B_JAC_LOCAL - ASPAR_OFF_DIAG_LOCAL + B_JAC(1:NSPEC,IP) + ELSEIF (IMEM == 1) THEN + eSum(1:NSPEC) = B_JAC(1:NSPEC,IP) + ASPAR_DIAG(1:NSPEC) = ASPAR_JAC(1:NSPEC,PDLIB_I_DIAG(IP)) +#ifdef W3_DEBUGFREQSHIFT + WRITE(740+IAPROC,*) 'eSI=', eSI + WRITE(740+IAPROC,*) 'sum(ASPAR_DIAG)=', sum(ASPAR_DIAG) #endif - ! Tihs is below also goes into the matrix ... like the wave boundary ... - DO IP = 1, npa #ifdef W3_DEBUGSRC - WRITE(740+IAPROC,*) 'IOBPD loop, Before, sum(VA)=', sum(VA(:,IP)) + WRITE(740+IAPROC,*) 'Step 1: sum(eSum)=', sum(eSum) #endif - DO ISP=1,NSPEC - ITH = 1 + MOD(ISP-1,NTH) - !IF (IOBPD_LOC(ITH,IP) .ne. IOBPD(ITH,IP_glob)) STOP 'ERROR IN BOUNDARY' - VA(ISP,IP)=MAX(ZERO, VA(ISP,IP))*IOBDP_LOC(IP)*DBLE(IOBPD_LOC(ITH,IP)) - END DO - !WRITE(*,'(4I10,A20)') IP, IOBDP_LOC(IP), IOBP_LOC(IP), IOBPA_LOC(IP), 'IOBP TEST' -#ifdef W3_DEBUGSRC - WRITE(740+IAPROC,*) 'IOBPD loop, After, sum(VA)=', sum(VA(:,IP)) +#ifdef W3_DEBUGSOLVERCOH + eOff=ZERO +#endif + DO i = PDLIB_IA_P(IP)+1, PDLIB_IA_P(IP+1) + JP = PDLIB_JA(I) + IF (JP .ne. IP) THEN + eProd(1:NSPEC) = ASPAR_JAC(1:NSPEC,i) * VA(1:NSPEC,JP) + eSum(1:NSPEC) = eSum(1:NSPEC) - eProd(1:NSPEC) +#ifdef W3_DEBUGSOLVERALL + WRITE(740+IAPROC,'(A20,3I10,20E20.10)') 'OFF DIAGONAL', IP, i, jp, sum(B_JAC(:,IP)), sum(eSum), SUM(ASPAR_JAC(:,i)), SUM(VA(:,JP)) #endif - END DO #ifdef W3_DEBUGSOLVERCOH - CALL ALL_VA_INTEGRAL_PRINT(IMOD, "VA(npa) after loop", 1) -#endif -#ifdef W3_DEBUGSOLVER - WRITE(740+IAPROC,*) 'FLBPI=', FLBPI - FLUSH(740+IAPROC) + eOff=eOff + abs(ASPAR_JAC(:,i)) #endif + END IF + END DO + ENDIF ! IMEM - DO JSEA=1, NSEAL - - IP = JSEA - IP_glob = iplg(IP) - ISEA = MAPFS(1,IP_glob) - ! -#ifdef W3_DEBUGSRC - IntDiff=0 - SumVS=0 - SumVD=0 - SumVAin=0 - SumVAout=0 - SumVAw3srce=0 - SumACout=0 +#ifdef W3_DEBUGSOLVERCOH + OffDiag(:, IP)=REAL(eOff) #endif - ! - DO ISP=1,NSPEC - - IK = 1 + (ISP-1)/NTH -#ifdef NOCGTABLE - CALL WAVNU_LOCAL(SIG(IK),DW(ISEA),WN1(IK),CG1(IK)) -#else - CG1(IK) = CG(IK,ISEA) +#ifdef W3_DEBUGSOLVERCOHALL + WRITE(740+IAPROC,*) 'Step 2: sum(eSum)=', sum(eSum), ' eOff=', sum(eOff) #endif - eVA = MAX ( ZERO ,CG1(IK)/CLATS(ISEA)*REAL(VA(ISP,IP)) ) -#ifdef W3_DEBUGSRC - SumACout=SumACout + REAL(VA(ISP,IP)) - VS_w3srce = VSTOT(ISP,JSEA) * DTG / MAX(1., (1. - DTG*VDTOT(ISP,JSEA))) - eVA_w3srce = MAX(0., VA(ISP,JSEA) + VS_w3srce) - IntDiff = IntDiff + abs(eVA - eVA_w3srce) - ACsolve=B_JAC(ISP,IP)/ASPAR_JAC(ISP,PDLIB_I_DIAG(IP)) - eB=VA(ISP,JSEA) + DTG*(VSTOT(ISP,JSEA) - VDTOT(ISP,JSEA)*VA(ISP,JSEA)) - eVAsolve=MAX(0., CG(IK,ISEA)/CLATS(ISEA)*ACsolve) - VAsolve(ISP)=eVAsolve - SumVS = SumVS + abs(VSTOT(ISP,JSEA)) - SumVD = SumVD + abs(VDTOT(ISP,JSEA)) - SumVAin = SumVAin + abs(VA(ISP,JSEA)) - SumVAout = SumVAout + abs(eVA) - SumVAw3srce = SumVAw3srce + abs(eVA_w3srce) + IF (FSREFRACTION) THEN +#ifdef W3_DEBUGREFRACTION + WRITE(740+IAPROC,*) 'Adding refraction terms to eSum' #endif - VA(ISP,JSEA) = eVA - END DO + CAD = CAD_THE(:,IP) + DO ISP=1,NSPEC + ISPprevDir=ListISPprevDir(ISP) + ISPnextDir=ListISPnextDir(ISP) + eA_THE = - DTG*eSI*MAX(ZERO,CAD(ISPprevDir)) + eC_THE = DTG*eSI*MIN(ZERO,CAD(ISPnextDir)) + eSum(ISP) = eSum(ISP) - eA_THE * VA(ISPprevDir,IP) + eSum(ISP) = eSum(ISP) - eC_THE * VA(ISPnextDir,IP) + END DO + END IF #ifdef W3_DEBUGSRC - WRITE(740+IAPROC,*) 'ISEA=', ISEA, ' IntDiff=', IntDiff, ' DTG=', DTG - IF (ISEA .eq. TESTNODE) THEN - DO ISP=1,NSPEC - WRITE(740+IAPROC,*) 'ISP=', ISP, 'VA/VAsolve=', VA(ISP,JSEA), VAsolve(ISP) - END DO - END IF - WRITE(740+IAPROC,*) 'SHAVE=', SHAVETOT(JSEA) - WRITE(740+IAPROC,*) 'Sum(VS/VD)=', SumVS, SumVD - WRITE(740+IAPROC,*) 'min/max/sum(VS)=', minval(VSTOT(:,JSEA)), maxval(VSTOT(:,JSEA)), sum(VSTOT(:,JSEA)) - WRITE(740+IAPROC,*) 'min/max/sum(VD)=', minval(VDTOT(:,JSEA)), maxval(VDTOT(:,JSEA)), sum(VDTOT(:,JSEA)) - WRITE(740+IAPROC,*) 'min/max/sum(VA)=', minval(VA(:,JSEA)), maxval(VA(:,JSEA)), sum(VA(:,JSEA)) - WRITE(740+IAPROC,*) 'min/max/sum(VAsolve)=', minval(VAsolve), maxval(VAsolve), sum(VAsolve) - WRITE(740+IAPROC,*) 'SumVA(in/out/w3srce)=', SumVAin, SumVAout, SumVAw3srce - WRITE(740+IAPROC,*) 'SumACout=', SumACout + WRITE(740+IAPROC,*) 'Step 3: sum(eSum)=', sum(eSum) #endif - END DO ! JSEA - -#ifdef WEIGHTS - INQUIRE ( FILE='weights.ww3', EXIST = lexist ) - if (.not. lexist) then - ipitergl = 0 - ipiterout = 0 - DO IP = 1, np - ipitergl(iplg(IP)) = ipiter(ip) - END DO - call mpi_reduce(ipitergl,ipiterout,NP_GLOBAL,MPI_INT,MPI_SUM,0,MPI_COMM_WCMP,ierr) - if (myrank == 0) tHEN - OPEN(100001,FILE='weights.ww3',FORM='FORMATTED',STATUS='unknown') - do ip = 1, np_global - write(100001,*) ipiterout(ip) - enddo - CLOSE(100001) - endif - endif + IF (FSFREQSHIFT .and. LSIG) THEN + IF (FreqShiftMethod .eq. 1) THEN + CAS = CAS_SIG(:,IP) + CP_SIG = MAX(ZERO,CAS) + CM_SIG = MIN(ZERO,CAS) + DO IK=0, NK + DMM(IK+1) = DBLE(WN1(IK+1) - WN1(IK)) + END DO + DMM(NK+2) = ZERO + DMM(0)=DMM(1) + DO ITH=1,NTH + DO IK=2,NK + ISP = ITH + (IK -1)*NTH + ISPm1 = ITH + (IK-1 -1)*NTH + eFactM1 = CG1(IK-1) / CG1(IK) + eA_SIG = - eSI * CP_SIG(ISPm1)/DMM(IK-1) * eFactM1 + eSum(ISP) = eSum(ISP) - eA_SIG*VA(ISPm1,IP) + END DO + DO IK=1,NK-1 + ISP = ITH + (IK -1)*NTH + ISPp1 = ITH + (IK+1 -1)*NTH + eFactP1 = CG1(IK+1) / CG1(IK) + eC_SIG = eSI * CM_SIG(ISPp1)/DMM(IK) * eFactP1 + eSum(ISP) = eSum(ISP) - eC_SIG*VA(ISPp1,IP) + END DO + END DO + ELSE IF (FreqShiftMethod .eq. 2) THEN + CWNB_M2=CWNB_SIG_M2(:,IP) + DO IK=1, NK + DWNI_M2(IK) = DBLE( CG1(IK) / DSIP(IK) ) + END DO +#ifdef W3_DEBUGFREQSHIFT + WRITE(740+IAPROC,*) 'Before FreqShift oper eSum=', sum(abs(eSum)) #endif - - !B_JAC = 0. - !ASPAR_JAC = 0. - - !DO JSEA = 1, NP - ! WRITE(70000+IAPROC,*) 'SUM VA EXIT SOLVER', JSEA, SUM(VA(:,JSEA)) - !ENDDO - ! - call print_memcheck(memunit, 'memcheck_____:'//' WW3_PROP SECTION LOOP 7') - ! + DO ITH=1,NTH + DO IK=2,NK + ISP = ITH + (IK -1)*NTH + ISPm1 = ITH + (IK-1 -1)*NTH + eFactM1 = DBLE( CG1(IK-1) / CG1(IK) ) + eA_SIG = - eSI * DWNI_M2(IK) * MAX(CWNB_M2(ISPm1),ZERO) *eFactM1 + eSum(ISP) = eSum(ISP) - eA_SIG*VA(ISPm1,IP) + END DO + DO IK=1,NK-1 + ISP = ITH + (IK -1)*NTH + ISPp1 = ITH + (IK+1 -1)*NTH + eFactP1 = DBLE( CG1(IK+1) / CG1(IK) ) + eC_SIG = eSI * DWNI_M2(IK) * MIN(CWNB_M2(ISP),ZERO) * eFactP1 + eSum(ISP) = eSum(ISP) - eC_SIG*VA(ISPp1,IP) + END DO + END DO +#ifdef W3_DEBUGFREQSHIFT + WRITE(740+IAPROC,*) ' after FreqShift oper eSum=', sum(abs(eSum)) +#endif + END IF + END IF #ifdef W3_DEBUGSRC - DO JSEA=1,NSEAL - WRITE(740+IAPROC,*) 'JSEA=', JSEA - WRITE(740+IAPROC,*) 'min/max/sum(VA)=', minval(VA(:,JSEA)), maxval(VA(:,JSEA)), sum(VA(:,JSEA)) - END DO - WRITE(740+IAPROC,*) 'min/max/sum(VAtot)=', minval(VA), maxval(VA), sum(VA) + WRITE(740+IAPROC,*) 'Step 4: sum(eSum)=', sum(eSum) #endif - - -#ifdef W3_DEBUGSOLVER - WRITE(740+IAPROC,*) 'PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK, end' - FLUSH(740+IAPROC) +#ifdef W3_DEBUGSOLVERCOH + PRE_VA(:, IP)=REAL(eSum) #endif - END SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK - !/ ------------------------------------------------------------------- / - SUBROUTINE PDLIB_EXPLICIT_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY) - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | | - !/ | Aron Roland (BGS IT&E GmbH) | - !/ | Mathieu Dutour-Sikiric (IRB) | - !/ | | - !/ | FORTRAN 90 | - !/ | Last update : 01-June-2018 | - !/ +-----------------------------------+ - !/ - !/ 01-June-2018 : Origination. ( version 6.04 ) - !/ - ! 1. Purpose : Explicit block solver - ! 2. Method : - ! 3. Parameters : - ! - ! Parameter list - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 4. Subroutines used : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! STRACE Subr. W3SERVMD Subroutine tracing. - ! ---------------------------------------------------------------- - ! - ! 5. Called by : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 6. Error messages : - ! 7. Remarks - ! 8. Structure : - ! 9. Switches : - ! - ! !/S Enable subroutine tracing. - ! - ! 10. Source code : - ! - !/ ------------------------------------------------------------------- / - ! -#ifdef W3_S - USE W3SERVMD, only: STRACE + eSum(1:NSPEC) = eSum(1:NSPEC) / ASPAR_DIAG(1:NSPEC) +#ifdef W3_DEBUGFREQSHIFT + WRITE(740+IAPROC,*) 'JSEA=', JSEA, ' nbIter=', nbIter + DO ISP=1,NSPEC + IK=MAPWN(ISP) + VAnew(ISP) = DBLE(CG(IK,ISEA)/CLATS(ISEA)) * eSum(ISP) + END DO + DO ISP=1,NSPEC + VAAnew(ISP) = VAnew(ISP) + VAAacloc(ISP) = VAacloc(ISP) + END DO + DO ITH=1,NTH + VAAnew(ITH + NSPEC) = FACHFA * VAAnew(ITH + NSPEC - NTH) + VAAnew(ITH - NTH ) = 0. + VAAacloc(ITH + NSPEC) = FACHFA * VAAacloc(ITH + NSPEC - NTH) + VAAacloc(ITH - NTH ) = 0. + END DO + DO ISP=1-NTH,NSPEC + VFLWN(ISP) = MAX(CWNB_M2(ISP),0.) * VAAnew(ISP) + MIN(CWNB_M2(ISP),0.) * VAAnew(ISP + NTH) + END DO + DO ISP=1,NSPEC + eDiff(ISP) = VAnew(ISP) - VAold(ISP) - DWNI_M2(MAPWN(ISP)) * (VFLWN(ISP-NTH) - VFLWN(ISP) ) + eVal1=MAX(CWNB_M2(ISP-NTH),0.) * VAAacloc(ISP-NTH) + MIN(CWNB_M2(ISP-NTH),0.) * VAAnew(ISP) + eVal2=MAX(CWNB_M2(ISP),0.) * VAAnew(ISP) + MIN(CWNB_M2(ISP),0.) * VAAacloc(ISP + NTH) + eDiffB(ISP) = VAnew(ISP) - VAold(ISP) - DWNI_M2(MAPWN(ISP)) * (eVal1 - eVal2) + END DO + IF (ISEA .eq. 190) THEN + DO IK=1,NK + DO ITH=1,NTH + ISP = ITH + (IK-1)*NTH + WRITE(740+IAPROC,*) 'ISP/ITH/IK=', ISP, ITH, IK + WRITE(740+IAPROC,*) 'eDiff(A/B)=', eDiff(ISP), eDiffB(ISP) + END DO + END DO + END IF + WRITE(740+IAPROC,*) 'NK=', NK, ' NTH=', NTH + eSumPart=0 + DO IK=1,NK + DO ITH=1,NTH + ISP = ITH + (IK-1)*NTH + eSumPart = eSumPart + abs(eDiff(ISP)) + END DO + IF (ISEA .eq. 190) THEN + WRITE(740+IAPROC,*) 'IK=', IK, ' eSumDiff=', eSumPart + END IF + END DO + WRITE(740+IAPROC,*) 'sum(eDiff/VAnew/VAold)=', sum(abs(eDiff)), sum(abs(VAnew)), sum(abs(VAold)) #endif - !/ - !USE W3GDATMD, only: MAPSTA - USE W3GDATMD, only: FSREFRACTION, FSFREQSHIFT, FSSOURCE, NX, DSIP - USE W3GDATMD, only: IOBP_LOC, IOBPD_LOC, IOBPA_LOC, IOBDP_LOC - USE W3GDATMD, only: B_JGS_NORM_THR, B_JGS_TERMINATE_NORM, B_JGS_PMIN, NTRI - USE W3GDATMD, only: B_JGS_TERMINATE_DIFFERENCE, B_JGS_MAXITER, B_JGS_LIMITER - USE W3GDATMD, only: B_JGS_TERMINATE_MAXITER, B_JGS_BLOCK_GAUSS_SEIDEL, B_JGS_DIFF_THR - USE W3GDATMD, only: MAPWN - USE MPI, only : MPI_MIN - use yowElementpool, only: ne, INE - USE YOWNODEPOOL, only: PDLIB_I_DIAG, PDLIB_IA_P, PDLIB_JA, np - USE YOWNODEPOOL, only: PDLIB_SI, PDLIB_IEN, PDLIB_CCON, NPA, PDLIB_IE_CELL2, PDLIB_POS_CELL2 - use yowDatapool, only: rtype - use YOWNODEPOOL, only: npa, iplg - use yowExchangeModule, only : PDLIB_exchange2Dreal_zero - USE W3ADATMD, only: WN - USE MPI, only : MPI_SUM, MPI_INT - USE W3ADATMD, only: MPI_COMM_WCMP, CFLXYMAX - USE W3GDATMD, only: IOBP, IOBPD, NSEA, SIG, IOBDP - USE W3GDATMD, only: NK, NK2, NTH, ECOS, ESIN, NSPEC, MAPFS - USE W3WDATMD, only: TIME - USE W3TIMEMD, only: DSEC21 - USE W3GDATMD, only: NSEAL, CLATS, FACHFA - USE W3IDATMD, only: FLCUR -#ifdef W3_DEBUGSRC - USE W3WDATMD, only: SHAVETOT + + IF (B_JGS_BLOCK_GAUSS_SEIDEL) THEN + VA(1:NSPEC,IP) = REAL(eSum) * IOBDP_LOC(IP) +#ifdef W3_REF1 + DO IK=1,NK + DO ITH=1,NTH + ISP = ITH + (IK-1)*NTH + IF (REFPARS(3) .LT. 0.5 .AND. IOBPD_LOC(ITH,IP) .EQ. 0 .AND. IOBPA_LOC(IP) .EQ. 0) THEN + VA(ISP,IP) = VAOLD(ISP,IP) * IOBDP_LOC(IP) ! Restores reflected action spectra ... + ENDIF + ENDDO + ENDDO #endif - USE W3WDATMD, only: VA, VSTOT, VDTOT - USE W3ADATMD, only: CG, CX, CY, MPI_COMM_WCMP - USE W3ODATMD, only: TBPIN, FLBPI, IAPROC - USE W3PARALL, only : INIT_GET_JSEA_ISPROC, ZERO, THR8 - USE W3PARALL, only : ListISPprevDir, ListISPnextDir - USE W3PARALL, only : JX_TO_JSEA - USE W3GDATMD, only: B_JGS_NLEVEL - ! - INTEGER, INTENT(IN) :: IMOD - REAL, INTENT(IN) :: FACX, FACY, DTG, VGX, VGY - ! - INTEGER :: IP, ISP, ITH, IK, JSEA, ISEA, IP_glob, IE, IPOS - ! for the exchange - REAL :: CCOS, CSIN, CCURX, CCURY - REAL :: eSum(NSPEC) - INTEGER :: ITER_EXP(nspec) - INTEGER :: ISPp1, ISPm1, JP, I1, I2, I3, NI(3), IT - INTEGER, SAVE :: ITER_MAX - REAL :: eFactM1, eFactP1 - REAL :: Sum_Prev, Sum_New - REAL :: prop_conv, eSI, p_is_converged - REAL :: Sum_L2, Sum_L2_GL - REAL :: DMM(0:NK2) - REAL :: DiffNew, DTMAX_GLOBAL_EXP, DTMAX_EXP - REAL :: eDiff(NSPEC), eProd(NSPEC), u33(nspec,3) - REAL :: DWNI_M2(NK), CWNB_M2(1-NTH:NSPEC), LAMBDA(NSPEC,3) - REAL :: VAnew(NSPEC), VAold(NSPEC), REST, CFLXY, DT4AI - REAL :: VAinput(NSPEC), VAacloc(NSPEC), eDiffB(NSPEC), KTMP(nspec,3), TMP(nspec) - REAL :: eDiffSing, eSumPart, N(nspec,ntri), kksum(nspec,npa), ST3(nspec), utilde33(nspec) - REAL :: FL11(NSPEC),FL12(NSPEC),FL21(NSPEC),FL22(NSPEC),FL31(NSPEC),FL32(NSPEC) - REAL :: FL111(NSPEC), FL112(NSPEC), FL211(NSPEC), FL212(NSPEC), FL311(NSPEC), FL312(NSPEC) - REAL :: KELEMGL(NSPEC,3,NTRI), FLALLGL(NSPEC,3,NTRI) - REAL :: eVal1, eVal2,thr - REAL :: eVA + ELSE + U_JAC(1:NSPEC,IP) = eSum + END IF + ELSE + esum = VA(1:NSPEC,IP) + ENDIF ! .NOT. LCONVERGED + + IF (B_JGS_TERMINATE_DIFFERENCE) THEN + Sum_New = sum(eSum) + if (Sum_new .gt. 0.d0) then + DiffNew = abs(sum(ACLOC-eSum))/Sum_new +#ifdef W3_DEBUGFREQSHIFT + WRITE(740+IAPROC,*) 'DiffNew=', DiffNew, ' Sum_new=', Sum_new +#endif + p_is_converged = DiffNew + else + p_is_converged = zero + endif +#ifdef W3_DEBUGFREQSHIFT + WRITE(740+IAPROC,*) 'p_is_converged=', p_is_converged +#endif + IF (p_is_converged .lt. B_JGS_DIFF_THR .and. nbiter .gt. 1) then + is_converged = is_converged + 1 + lconverged(ip) = .true. + ELSE + lconverged(ip) = .false. + ENDIF + END IF #ifdef W3_DEBUGSRC - REAL :: IntDiff, eVA_w3srce, eVAsolve, SumACout - REAL :: SumVAin, SumVAout, SumVAw3srce, SumVS, SumVD, VS_w3srce - REAL :: VAsolve(NSPEC) - REAL*8 :: ACsolve - REAL :: eB + WRITE(740+IAPROC,*) 'sum(VA)out=', sum(VA(:,IP)) #endif - REAL :: ASPAR_DIAG(NSPEC) + END DO ! IP + + call print_memcheck(memunit, 'memcheck_____:'//' WW3_PROP SECTION SOLVER LOOP 2') + #ifdef W3_DEBUGSOLVERCOH - REAL*8 :: PRE_VA(NSPEC, npa) - REAL*8 :: OffDIAG(NSPEC, npa) - REAL*8 :: eOff(NSPEC) - REAL*8 :: eSum1(NSPEC), eSum2(NSPEC) + WRITE (eFile,40) nbIter +40 FORMAT ('PRE_VA_',i4.4,'.txt') + CALL CHECK_ARRAY_INTEGRAL_NX_R8(OffDiag, "OffDiag(np) just check", np) + ! CALL WRITE_VAR_TO_TEXT_FILE(PRE_VA, eFile) + CALL CHECK_ARRAY_INTEGRAL_NX_R8(PRE_VA, "PRE_VA(np) just check", np) + CALL ALL_VA_INTEGRAL_PRINT(IMOD, "VA(np) before exchanges", 0) #endif - CHARACTER(len=128) eFile - INTEGER ierr, i - INTEGER JP_glob - INTEGER is_converged, itmp - thr = dble(tiny(1.)) - CCURX = FACX - CCURY = FACY + IF (B_JGS_BLOCK_GAUSS_SEIDEL) THEN + CALL PDLIB_exchange2DREAL_zero(VA) + ELSE + CALL PDLIB_exchange2DREAL(U_JAC) + VA(:,1:NPA) = U_JAC + END IF + call print_memcheck(memunit, 'memcheck_____:'//' WW3_PROP SECTION SOLVER LOOP 3') + ! + ! Terminate via number of iteration + ! + IF (B_JGS_TERMINATE_MAXITER) THEN + IF (nbIter .gt. B_JGS_MAXITER) THEN #ifdef W3_DEBUGSOLVER - WRITE(740+IAPROC,*) 'EXPLICIT BLOCK SOLVER, begin' - WRITE(740+IAPROC,*) 'NX=', NX - WRITE(740+IAPROC,*) 'NP=', NP - WRITE(740+IAPROC,*) 'NPA=', NPA - WRITE(740+IAPROC,*) 'NSEA=', NSEA - WRITE(740+IAPROC,*) 'NSEAL=', NSEAL - FLUSH(740+IAPROC) -#endif - ! - ! 1.b Initialize arrays - ! - ! 2. Calculate velocities ---------------- * - ! -#ifdef W3_DEBUGSRC - WRITE(740+IAPROC,*) 'NSEAL =', NSEAL - WRITE(740+IAPROC,*) 'NP =', NP - WRITE(740+IAPROC,*) 'NPA =', NPA + WRITE(740+IAPROC,*) 'Exiting by TERMINATE_MAXITER' #endif - DO JSEA=1,NSEAL - IP = JSEA - IP_glob=iplg(IP) - ISEA=MAPFS(1,IP_glob) - DO ISP=1,NSPEC - ITH = 1 + MOD(ISP-1,NTH) - IK = 1 + (ISP-1)/NTH - CCOS = FACX * ECOS(ITH) - CSIN = FACY * ESIN(ITH) - VA(ISP,IP) = DBLE(VA(ISP,JSEA) / CG(IK,ISEA) * CLATS(ISEA)) -#ifdef W3_MGP - VLCFLX(ISP,IP) = VLCFLX(ISP,IP) - CCURX*VGX/CLATS(ISEA) - VLCFLY(ISP,IP) = VLCFLY(ISP,IP) - CCURY*VGY + EXIT + END IF + END IF + call print_memcheck(memunit, 'memcheck_____:'//' WW3_PROP SECTION SOLVER LOOP 4') + ! + ! Terminate via differences + ! + IF (B_JGS_TERMINATE_DIFFERENCE .and. INT(MOD(NBITER,10)) == 0) THEN ! Every 10th step check conv. + CALL MPI_ALLREDUCE(is_converged, itmp, 1, MPI_INT, MPI_SUM, MPI_COMM_WCMP, ierr) + is_converged = itmp + prop_conv = (DBLE(NX) - DBLE(is_converged))/DBLE(NX) * 100. +#ifdef W3_DEBUGSOLVER + WRITE(740+IAPROC,*) 'solver', nbiter, is_converged, prop_conv, B_JGS_PMIN + FLUSH(740+IAPROC) #endif - END DO - END DO -#ifdef W3_DEBUGSRC - DO IP=1,NP - WRITE(740+IAPROC,*) 'IP=', IP - WRITE(740+IAPROC,*) 'min/max/sum(VA)=', minval(VA(:,IP)), maxval(VA(:,IP)), sum(VA(:,IP)) - END DO + IF (myrank == 0) WRITE(*,*) 'No. of solver iterations', nbiter, is_converged, prop_conv, B_JGS_PMIN + IF (prop_conv .le. B_JGS_PMIN + TINY(1.)) THEN +#ifdef W3_DEBUGFREQSHIFT + WRITE(740+IAPROC,*) 'prop_conv=', prop_conv + WRITE(740+IAPROC,*) 'NX=', NX + WRITE(740+IAPROC,*) 'is_converged=', is_converged + WRITE(740+IAPROC,*) 'Exiting by TERMINATE_DIFFERENCE' #endif - -#ifdef W3_DEBUGSOLVERCOH - CALL ALL_VA_INTEGRAL_PRINT(IMOD, "VA(np) just defined", 0) - CALL ALL_VA_INTEGRAL_PRINT(IMOD, "VA(npa) just defined", 1) + EXIT + END IF + END IF + call print_memcheck(memunit, 'memcheck_____:'//' WW3_PROP SECTION SOLVER LOOP 5') + ! + ! Terminate via norm + ! + IF (B_JGS_TERMINATE_NORM) THEN + Sum_L2 =0 + DO IP = 1, np + IP_glob=iplg(IP) + IF (IOBP_LOC(IP).eq.1) THEN + JSEA=JX_TO_JSEA(IP) + eSI=PDLIB_SI(IP) + eSum=B_JAC(:,IP) + ACLOC=VA(:,IP) + ISEA= MAPFS(1,IP_glob) + eSum(:) = eSum(:) - ASPAR_DIAG(:)*ACLOC + DO I = PDLIB_IA_P(IP)+1, PDLIB_IA_P(IP+1) + JP=PDLIB_JA(I) + eSum(:) = eSum(:) - ASPAR_JAC(:,i)*VA(:,JP) + END DO + IF (FSREFRACTION) THEN + CAD=CAD_THE(:,IP) + DO ISP=1,NSPEC + ISPprevDir=ListISPprevDir(ISP) + ISPnextDir=ListISPnextDir(ISP) + eA_THE = - DTG*eSI*MAX(ZERO,CAD(ISPprevDir)) + eC_THE = DTG*eSI*MIN(ZERO,CAD(ISPnextDir)) + eSum(ISP) = eSum(ISP) - eA_THE*VA(ISPprevDir,IP) + eSum(ISP) = eSum(ISP) - eC_THE*VA(ISPnextDir,IP) + END DO + END IF + IF (FSFREQSHIFT) THEN + CAS=CAS_SIG(:,IP) + CP_SIG = MAX(ZERO,CAS) + CM_SIG = MIN(ZERO,CAS) + DO IK = 0, NK + 1 +#ifdef NOCGTABLE + CALL WAVNU_LOCAL(SIG(IK),DW(ISEA),WN1(IK),CG1(IK)) +#else + CG1(IK) = CG(IK,ISEA) + WN1(IK) = WN(IK,ISEA) #endif + ENDDO + DO ITH=1,NTH + IF (IOBPD_LOC(ITH,IP) .NE. 0) THEN + DO IK=2,NK + ISP =ITH + (IK -1)*NTH + ISPm1=ITH + (IK-1-1)*NTH + eFactM1=CG(IK-1,ISEA) / CG1(IK) + eA_SIG= - eSI*CP_SIG(ISPm1)/DMM(IK-1) * eFactM1 + eSum(ISP) = eSum(ISP) - eA_SIG*VA(ISPm1,IP) + END DO + DO IK=1,NK-1 + ISP =ITH + (IK -1)*NTH + ISPp1=ITH + (IK+1-1)*NTH + eFactP1=CG(IK+1,ISEA) / CG1(IK) + eC_SIG= eSI*CM_SIG(ISPp1)/DMM(IK) * eFactP1 + eSum(ISP) = eSum(ISP) - eC_SIG*VA(ISPp1,IP) + END DO + END IF + END DO + END IF + Sum_L2 = Sum_L2 + sum(eSum*eSum) + END IF + END DO + CALL MPI_ALLREDUCE(Sum_L2, Sum_L2_GL, 1, rtype, MPI_SUM, MPI_COMM_WCMP, ierr) #ifdef W3_DEBUGSOLVER - WRITE(740+IAPROC,*) 'JACOBI_SOLVER, step 3' - WRITE(740+IAPROC,*) 'FLCUR=', FLCUR - FLUSH(740+IAPROC) - WRITE(740+IAPROC,*) 'EXPLICIT BLOCK SOLVER, step 4' - WRITE(740+IAPROC,*) 'min,max(0)=', 0 - WRITE(740+IAPROC,*) 'min,max(0)=', 0 - FLUSH(740+IAPROC) + WRITE(740+IAPROC,*) 'Sum_L2_gl=', Sum_L2_gl + FLUSH(740+IAPROC) #endif + IF (Sum_L2_gl .le. B_JGS_NORM_THR) THEN +#ifdef W3_DEBUGFREQSHIFT + WRITE(740+IAPROC,*) 'Exiting by TERMINATE_NORM' +#endif + EXIT + END IF + END IF + call print_memcheck(memunit, 'memcheck_____:'//' WW3_PROP SECTION SOLVER LOOP 6') - DO IE = 1, NE - I1 = INE(1,IE) - I2 = INE(2,IE) - I3 = INE(3,IE) - !LAMBDA(:,1) = 1./6. *(C(:,I1,1)+C(:,I2,1)+C(:,I3,1)) - !LAMBDA(:,2) = 1./6. *(C(:,I1,2)+C(:,I2,2)+C(:,I3,2)) - KELEMGL(:,1,IE) = LAMBDA(:,1) * PDLIB_IEN(1,IE) + LAMBDA(:,2) * PDLIB_IEN(2,IE) - KELEMGL(:,2,IE) = LAMBDA(:,1) * PDLIB_IEN(3,IE) + LAMBDA(:,2) * PDLIB_IEN(4,IE) - KELEMGL(:,3,IE) = LAMBDA(:,1) * PDLIB_IEN(5,IE) + LAMBDA(:,2) * PDLIB_IEN(6,IE) - KTMP(:,1) = KELEMGL(:,1,IE) - KTMP(:,2) = KELEMGL(:,2,IE) - KTMP(:,3) = KELEMGL(:,3,IE) - TMP(:) = SUM(MIN(ZERO,KTMP(:,:)),DIM=2) - N(:,IE) = -1.d0/MIN(-THR,TMP(:)) - KELEMGL(:,1,IE) = MAX(ZERO,KTMP(:,1)) - KELEMGL(:,2,IE) = MAX(ZERO,KTMP(:,2)) - KELEMGL(:,3,IE) = MAX(ZERO,KTMP(:,3)) - ! FL11 = C(:,I2,1) * PDLIB_IEN(1,IE) + C(:,I2,2) * PDLIB_IEN(2,IE) - ! FL12 = C(:,I3,1) * PDLIB_IEN(1,IE) + C(:,I3,2) * PDLIB_IEN(2,IE) - ! FL21 = C(:,I3,1) * PDLIB_IEN(3,IE) + C(:,I3,2) * PDLIB_IEN(4,IE) - ! FL22 = C(:,I1,1) * PDLIB_IEN(3,IE) + C(:,I1,2) * PDLIB_IEN(4,IE) - ! FL31 = C(:,I1,1) * PDLIB_IEN(5,IE) + C(:,I1,2) * PDLIB_IEN(6,IE) - ! FL32 = C(:,I2,1) * PDLIB_IEN(5,IE) + C(:,I2,2) * PDLIB_IEN(6,IE) - FL111 = 2*FL11+FL12 - FL112 = 2*FL12+FL11 - FL211 = 2*FL21+FL22 - FL212 = 2*FL22+FL21 - FL311 = 2*FL31+FL32 - FL312 = 2*FL32+FL31 - FLALLGL(:,1,IE) = (FL311 + FL212) * 1./6. + KELEMGL(:,1,IE) - FLALLGL(:,2,IE) = (FL111 + FL312) * 1./6. + KELEMGL(:,2,IE) - FLALLGL(:,3,IE) = (FL211 + FL112) * 1./6. + KELEMGL(:,3,IE) - END DO - - KKSUM = 0.d0 - DO IE = 1, NE - NI = INE(:,IE) - KKSUM(:,NI) = KKSUM(:,NI) + KELEMGL(:,:,IE) - END DO - DTMAX_GLOBAL_EXP = 1.d0/THR - DO IP = 1, NP - DTMAX_EXP = PDLIB_SI(IP)/MAX(THR,MAXVAL(KKSUM(:,IP))) - DTMAX_GLOBAL_EXP = MIN ( DTMAX_GLOBAL_EXP, DTMAX_EXP) - CFLXYMAX(IP) = DBLE(DTG)/DTMAX_EXP - END DO - rest = CFLXYMAX(1) - DO IP = 2, NP - if (rest .lt. CFLXYMAX(IP)) then - rest = CFLXYMAX(IP) - iter_max = ip - endif - END DO - - DTMAX_EXP=DTMAX_GLOBAL_EXP - call mpi_allreduce(DTMAX_EXP,DTMAX_GLOBAL_EXP,1,rtype,MPI_MIN,MPI_COMM_WCMP,ierr) - CFLXY = DTG/DTMAX_GLOBAL_EXP - REST = ABS(MOD(CFLXY,1.d0)) - IF (REST .LT. THR) THEN - ITER_MAX = ABS(NINT(CFLXY)) - ELSE IF (REST .GT. THR .AND. REST .LT. 0.5d0) THEN - ITER_MAX = ABS(NINT(CFLXY)) + 1 - ELSE - ITER_MAX = ABS(NINT(CFLXY)) - END IF + nbiter = nbiter + 1 - DT4AI = DTG/ITER_MAX - DO IT = 1, ITER_MAX - DO IP = 1, NPA - ST3 = ZERO - DO I = 1, PDLIB_CCON(IP) - IE = PDLIB_IE_CELL2(IP,I) - U33 = VA(:,INE(:,IE)) - UTILDE33 = N(:,IE)*(FLALLGL(:,1,IE)*U33(:,1)+FLALLGL(:,2,IE)*U33(:,2)+FLALLGL(:,3,IE)*U33(:,3)) - IPOS = PDLIB_POS_CELL2(I,IP) - ST3 = ST3 + KELEMGL(:,IPOS,IE)*(U33(:,IPOS)-UTILDE33) - END DO - VA(:,IP) = MAX(ZERO,VA(:,IP)-DT4AI/PDLIB_SI(IP)*ST3) - END DO !IP - CALL PDLIB_exchange2DREAL_ZERO(VA) - END DO !IT + END DO ! Open Do Loop ... End of Time Interval +#ifdef W3_DEBUGSOLVER + WRITE(740+IAPROC,*) 'nbIter=', nbIter, ' B_JGS_MAXITER=', B_JGS_MAXITER + FLUSH(740+IAPROC) +#endif + ! Tihs is below also goes into the matrix ... like the wave boundary ... DO IP = 1, npa - IP_glob=iplg(IP) #ifdef W3_DEBUGSRC WRITE(740+IAPROC,*) 'IOBPD loop, Before, sum(VA)=', sum(VA(:,IP)) #endif DO ISP=1,NSPEC ITH = 1 + MOD(ISP-1,NTH) - VA(ISP,IP)=MAX(ZERO, VA(ISP,IP))*IOBDP(IP_glob)*DBLE(IOBPD(ITH,IP_glob)) + VA(ISP,IP)=MAX(ZERO, VA(ISP,IP))*IOBDP_LOC(IP)*DBLE(IOBPD_LOC(ITH,IP)) +#ifdef W3_REF1 + IF (REFPARS(3).LT.0.5.AND.IOBPD_LOC(ITH,IP).EQ.0.AND.IOBPA_LOC(IP).EQ.0) THEN + VA(ISP,IP) = VAOLD(ISP,IP) ! restores reflected boundary values + ENDIF +#endif END DO #ifdef W3_DEBUGSRC WRITE(740+IAPROC,*) 'IOBPD loop, After, sum(VA)=', sum(VA(:,IP)) #endif END DO - #ifdef W3_DEBUGSOLVERCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "VA(npa) after loop", 1) #endif @@ -6643,9 +6177,10 @@ SUBROUTINE PDLIB_EXPLICIT_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY) #endif DO JSEA=1, NSEAL - IP=JSEA - IP_glob=iplg(IP) - ISEA=MAPFS(1,IP_glob) + + IP = JSEA + IP_glob = iplg(IP) + ISEA = MAPFS(1,IP_glob) ! #ifdef W3_DEBUGSRC IntDiff=0 @@ -6658,8 +6193,15 @@ SUBROUTINE PDLIB_EXPLICIT_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY) #endif ! DO ISP=1,NSPEC + IK = 1 + (ISP-1)/NTH - eVA = MAX ( 0. ,CG(IK,ISEA)/CLATS(ISEA)*REAL(VA(ISP,IP)) ) +#ifdef NOCGTABLE + CALL WAVNU_LOCAL(SIG(IK),DW(ISEA),WN1(IK),CG1(IK)) +#else + CG1(IK) = CG(IK,ISEA) +#endif + eVA = MAX ( ZERO ,CG1(IK)/CLATS(ISEA)*REAL(VA(ISP,IP)) ) + eVO = MAX ( ZERO ,CG1(IK)/CLATS(ISEA)*REAL(VAOLD(ISP,JSEA)) ) #ifdef W3_DEBUGSRC SumACout=SumACout + REAL(VA(ISP,IP)) VS_w3srce = VSTOT(ISP,JSEA) * DTG / MAX(1., (1. - DTG*VDTOT(ISP,JSEA))) @@ -6675,9 +6217,9 @@ SUBROUTINE PDLIB_EXPLICIT_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY) SumVAout = SumVAout + abs(eVA) SumVAw3srce = SumVAw3srce + abs(eVA_w3srce) #endif + VAOLD(ISP,JSEA) = eVO VA(ISP,JSEA) = eVA END DO - #ifdef W3_DEBUGSRC WRITE(740+IAPROC,*) 'ISEA=', ISEA, ' IntDiff=', IntDiff, ' DTG=', DTG IF (ISEA .eq. TESTNODE) THEN @@ -6694,11 +6236,87 @@ SUBROUTINE PDLIB_EXPLICIT_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY) WRITE(740+IAPROC,*) 'SumVA(in/out/w3srce)=', SumVAin, SumVAout, SumVAw3srce WRITE(740+IAPROC,*) 'SumACout=', SumACout #endif - END DO + + IF (FLSOU) THEN + IF (B_JGS_LIMITER) THEN + + DO ISP=1,NSPEC + IK = 1 + (ISP-1)/NTH + SPEC(ISP) = VAOLD(ISP,JSEA) + ENDDO +#ifdef W3_ST4 + CALL W3SPR4 (SPEC, CG1, WN1, EMEAN, FMEAN, FMEAN1, WNMEAN, & + AMAX, U10(ISEA), U10D(ISEA), & +#ifdef W3_FLX5 + TAUA, TAUADIR, DAIR, & +#endif + USTAR, USTDIR, & + TAUWX, TAUWY, CD, Z0, CHARN, LLWS, FMEANWS, DLWMEAN) +#endif + + DAM = 0. + DO IK=1, NK + DAM(1+(IK-1)*NTH) = 0.0081*0.1 / ( 2 * SIG(IK) * WN(IK,ISEA)**3 * CG(IK,ISEA)) * CG1(IK) / CLATS(ISEA) + END DO +! + DO IK=1, NK + IS0 = (IK-1)*NTH + DO ITH=2, NTH + DAM(ITH+IS0) = DAM(1+IS0) + END DO + END DO + + DAM2 = 0. + DO IK=1, NK + JAC2 = 1./TPI/SIG(IK) + FRLOCAL = SIG(IK)*TPIINV + DAM2(1+(IK-1)*NTH) = 1E-06 * GRAV/FRLOCAL**4 * USTAR * MAX(FMEANWS,FMEAN) * DTG * JAC2 * CG1(IK) / CLATS(ISEA) + END DO + DO IK=1, NK + IS0 = (IK-1)*NTH + DO ITH=2, NTH + DAM2(ITH+IS0) = DAM2(1+IS0) + END DO + END DO + + DO IK = 1, NK + DO ITH = 1, NTH + ISP = ITH + (IK-1)*NTH + newdac = VA(ISP,IP) - VAOLD(ISP,JSEA) + maxdac = max(DAM(ISP),DAM2(ISP)) + NEWDAC = SIGN(MIN(MAXDAC,ABS(NEWDAC)), NEWDAC) + VA(ISP,IP) = max(0., VAOLD(ISP,IP) + NEWDAC) + ENDDO + ENDDO + ENDIF ! B_JGS_LIMITER + ENDIF ! FLSOU + END DO ! JSEA + +#ifdef WEIGHTS + INQUIRE ( FILE='weights.ww3', EXIST = lexist ) + if (.not. lexist) then + ipitergl = 0 + ipiterout = 0 + DO IP = 1, np + ipitergl(iplg(IP)) = ipiter(ip) + END DO + call mpi_reduce(ipitergl,ipiterout,NP_GLOBAL,MPI_INT,MPI_SUM,0,MPI_COMM_WCMP,ierr) + if (myrank == 0) tHEN + OPEN(100001,FILE='weights.ww3',FORM='FORMATTED',STATUS='unknown') + do ip = 1, np_global + write(100001,*) ipiterout(ip) + enddo + CLOSE(100001) + endif + endif +#endif + ! + call print_memcheck(memunit, 'memcheck_____:'//' WW3_PROP SECTION LOOP 7') + ! #ifdef W3_DEBUGSRC - DO IP=1,NP - WRITE(740+IAPROC,*) 'IP=', IP - WRITE(740+IAPROC,*) 'min/max/sum(VA)=', minval(VA(:,IP)), maxval(VA(:,IP)), sum(VA(:,IP)) + DO JSEA=1,NSEAL + WRITE(740+IAPROC,*) 'JSEA=', JSEA + WRITE(740+IAPROC,*) 'min/max/sum(VA)=', minval(VA(:,JSEA)), maxval(VA(:,JSEA)), sum(VA(:,JSEA)) END DO WRITE(740+IAPROC,*) 'min/max/sum(VAtot)=', minval(VA), maxval(VA), sum(VA) #endif @@ -6708,8 +6326,350 @@ SUBROUTINE PDLIB_EXPLICIT_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY) WRITE(740+IAPROC,*) 'PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK, end' FLUSH(740+IAPROC) #endif + END SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK + !/ ------------------------------------------------------------------- / + SUBROUTINE PDLIB_EXPLICIT_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY, LCALC) + !/ + !/ +-----------------------------------+ + !/ | WAVEWATCH III NOAA/NCEP | + !/ | | + !/ | Aron Roland (BGS IT&E GmbH) | + !/ | Mathieu Dutour-Sikiric (IRB) | + !/ | | + !/ | FORTRAN 90 | + !/ | Last update : 01-June-2018 | + !/ +-----------------------------------+ + !/ + !/ 01-June-2018 : Origination. ( version 6.04 ) + !/ + ! 1. Purpose : Explicit block solver + ! 2. Method : It uses the n-scheme and the idea is to reduce latency due + ! to DD communication and increase vectorization level on the + ! single core + ! 3. Parameters : + ! + ! Parameter list + ! ---------------------------------------------------------------- + ! ---------------------------------------------------------------- + ! + ! 4. Subroutines used : + ! + ! Name Type Module Description + ! ---------------------------------------------------------------- + ! + ! 5. Called by : + ! + ! Name Type Module Description + ! ---------------------------------------------------------------- + ! + ! 6. Error messages : + ! 7. Remarks + ! 8. Structure : + ! 9. Switches : + ! + ! !/S Enable subroutine tracing. + ! + ! 10. Source code : + ! + !/ ------------------------------------------------------------------- / + ! +#ifdef W3_S + USE W3SERVMD, only: STRACE +#endif + USE W3GDATMD, ONLY: NK, NTH, NSPEC, SIG, DTH, ESIN, ECOS, NSEAL, FSBCCFL, CLATS, MAPFS + USE W3GDATMD, ONLY: IOBP_LOC, IOBPD_LOC, IOBPA_LOC, IOBDP_LOC, MAPSF, NSEA + USE W3ODATMD, ONLY: NDSE, NDST, FLBPI, NBI, TBPI0, TBPIN, ISBPI, BBPI0, BBPIN + USE W3ADATMD, ONLY: DW, CX, CY, MPI_COMM_WCMP + USE W3IDATMD, ONLY: FLCUR, FLLEV + USE W3WDATMD, ONLY: VA + USE W3DISPMD, ONLY: WAVNU3 + USE W3ODATMD, ONLY : IAPROC +#ifdef W3_PDLIB + USE yowElementpool, only: ne, ine + USE yowNodepool, only: np, npa, pdlib_ien, pdlib_si, iplg + use yowDatapool, only: rtype + use yowExchangeModule, only: PDLIB_exchange2Dreal_zero, PDLIB_exchange2Dreal + use yowRankModule, only: ipgl_npa + USE MPI, only : MPI_MIN +#endif +#ifdef W3_REF1 + USE W3GDATMD, only: REFPARS +#endif + + IMPLICIT NONE + + LOGICAL, INTENT(IN) :: LCALC + + INTEGER, INTENT(IN) :: IMOD + + REAL, INTENT(IN) :: FACX, FACY, DTG, VGX, VGY + + REAL :: KTMP(3), UTILDE(NTH), ST(NTH,NPA) + REAL :: FL11(NTH), FL12(NTH), FL21(NTH), FL22(NTH), FL31(NTH), FL32(NTH), KKSUM(NTH,NPA) + REAL :: FL111(NTH), FL112(NTH), FL211(NTH), FL212(NTH), FL311(NTH), FL312(NTH) + + REAL :: KSIG(NPA), CGSIG(NPA), CXX(NTH,NPA), CYY(NTH,NPA) + REAL :: LAMBDAX(NTH), LAMBDAY(NTH) + REAL :: DTMAX(NTH), DTMAXEXP(NTH), DTMAXOUT, DTMAXGL + REAL :: FIN(1), FOUT(1), REST, CFLXY, RD1, RD2, RD10, RD20 + REAL :: UOLD(NTH,NPA), U(NTH,NPA) + + REAL, PARAMETER :: ONESIXTH = 1.0/6.0 + REAL, PARAMETER :: ZERO = 0.0 + REAL, PARAMETER :: THR = 1E-12 + + INTEGER :: IK, ISP, ITH, IE, IP, IT, IBI, NI(3), I1, I2, I3, JX, IERR, IP_GLOB, ISEA + ! + ! 1.b Initialize arrays + ! + ! 2. Calculate velocities ---------------- * + ! + ! 2a. Vectorized for all points looping over each wave number (maybe do a dirty save will be nice!) + ! + + DO IK = 1, NK + + IF (LCALC) THEN + + DO IP = 1, NPA + CALL WAVNU3 (SIG(IK), DW(iplg(IP)), KSIG(IP), CGSIG(IP)) + ENDDO + + DO ITH = 1, NTH + DO IP = 1, NPA + ISEA = IPLG(IP) + CXX(ITH,IP) = CGSIG(IP) * FACX * ECOS(ITH) / CLATS(ISEA) + CYY(ITH,IP) = CGSIG(IP) * FACY * ESIN(ITH) + ENDDO + IF (FLCUR) THEN + DO IP = 1, NPA + ISEA = IPLG(IP) + IF (IOBP_LOC(IP) .GT. 0) THEN + CXX(ITH,IP) = CXX(ITH,IP) + FACX * CX(ISEA)/CLATS(ISEA) + CYY(ITH,IP) = CYY(ITH,IP) + FACY * CY(ISEA) + ENDIF + ENDDO + ENDIF + ENDDO + + DO IE = 1, NE + + NI = INE(:,IE) + + I1 = NI(1) + I2 = NI(2) + I3 = NI(3) + + DO ITH = 1, NTH + LAMBDAX(ITH) = ONESIXTH *(CXX(ITH,I1)+CXX(ITH,I2)+CXX(ITH,I3)) ! Linearized advection speed in X and Y direction + LAMBDAY(ITH) = ONESIXTH *(CYY(ITH,I1)+CYY(ITH,I2)+CYY(ITH,I3)) + KELEM1(ITH,IE,IK) = LAMBDAX(ITH) * PDLIB_IEN(1,IE) + LAMBDAY(ITH) * PDLIB_IEN(2,IE) ! K-Values - so called Flux Jacobians + KELEM2(ITH,IE,IK) = LAMBDAX(ITH) * PDLIB_IEN(3,IE) + LAMBDAY(ITH) * PDLIB_IEN(4,IE) + KELEM3(ITH,IE,IK) = LAMBDAX(ITH) * PDLIB_IEN(5,IE) + LAMBDAY(ITH) * PDLIB_IEN(6,IE) + KTMP(1) = KELEM1(ITH,IE,IK) ! Extract + KTMP(2) = KELEM2(ITH,IE,IK) + KTMP(3) = KELEM3(ITH,IE,IK) + NM(ITH,IE,IK) = - 1.D0/MIN(-THR,SUM(MIN(ZERO,KTMP))) ! N-Values + KELEM1(ITH,IE,IK) = MAX(ZERO,KTMP(1)) + KELEM2(ITH,IE,IK) = MAX(ZERO,KTMP(2)) + KELEM3(ITH,IE,IK) = MAX(ZERO,KTMP(3)) + ENDDO + + FL11 = CXX(:,I2) * PDLIB_IEN(1,IE) + CYY(:,I2) * PDLIB_IEN(2,IE) ! Weights for Simpson Integration + FL12 = CXX(:,I3) * PDLIB_IEN(1,IE) + CYY(:,I3) * PDLIB_IEN(2,IE) + FL21 = CXX(:,I3) * PDLIB_IEN(3,IE) + CYY(:,I3) * PDLIB_IEN(4,IE) + FL22 = CXX(:,I1) * PDLIB_IEN(3,IE) + CYY(:,I1) * PDLIB_IEN(4,IE) + FL31 = CXX(:,I1) * PDLIB_IEN(5,IE) + CYY(:,I1) * PDLIB_IEN(6,IE) + FL32 = CXX(:,I2) * PDLIB_IEN(5,IE) + CYY(:,I2) * PDLIB_IEN(6,IE) + + FL111 = 2.d0 * FL11 + FL12 + FL112 = 2.d0 * FL12 + FL11 + FL211 = 2.d0 * FL21 + FL22 + FL212 = 2.d0 * FL22 + FL21 + FL311 = 2.d0 * FL31 + FL32 + FL312 = 2.d0 * FL32 + FL31 + + FLALL1(:,IE,IK) = (FL311 + FL212) * ONESIXTH + KELEM1(:,IE,IK) + FLALL2(:,IE,IK) = (FL111 + FL312) * ONESIXTH + KELEM2(:,IE,IK) + FLALL3(:,IE,IK) = (FL211 + FL112) * ONESIXTH + KELEM3(:,IE,IK) + + ENDDO ! IE + + KKSUM = ZERO + DO IE = 1, NE + NI = INE(:,IE) + DO ITH = 1, NTH + KKSUM(ITH,NI(1)) = KKSUM(ITH,NI(1)) + KELEM1(ITH,IE,IK) + KKSUM(ITH,NI(2)) = KKSUM(ITH,NI(2)) + KELEM2(ITH,IE,IK) + KKSUM(ITH,NI(3)) = KKSUM(ITH,NI(3)) + KELEM3(ITH,IE,IK) + ENDDO + END DO + + DTMAXEXP = 1.E10 + DTMAX = 1.E10 + DO IP = 1, np + IF (IOBP_LOC(IP) .EQ. 1 .OR. FSBCCFL) THEN + DO ITH = 1, NTH + DTMAXEXP(ITH) = PDLIB_SI(IP)/MAX(THR,KKSUM(ITH,IP)*IOBDP_LOC(IP)) + DTMAX(ITH) = MIN(DTMAX(ITH),DTMAXEXP(ITH)) + ENDDO + DTMAXOUT = MINVAL(DTMAX) + ENDIF + END DO + + FIN(1) = DTMAXOUT + CALL MPI_ALLREDUCE(FIN,FOUT,1,rtype,MPI_MIN,MPI_COMM_WCMP,ierr) + DTMAXGL = FOUT(1) + + CFLXY = DBLE(DTG)/DTMAXGL + REST = ABS(MOD(CFLXY,1.0d0)) + IF (REST .LT. THR) THEN + ITER(IK) = ABS(NINT(CFLXY)) + ELSE IF (REST .GT. THR .AND. REST .LT. 0.5d0) THEN + ITER(IK) = ABS(NINT(CFLXY)) + 1 + ELSE + ITER(IK) = ABS(NINT(CFLXY)) + END IF + + DO IP = 1, np + DTSI(IP) = DBLE(DTMAXGL)/DBLE(ITER(IK))/PDLIB_SI(IP) ! Some precalculations for the time integration. + END DO + + END IF ! LCALC + +! Exact and convert Wave Action - should be some subroutine function or whatever + DO ITH = 1, NTH + ISP = ITH + (IK-1) * NTH + DO IP = 1, NPA + U(ITH,IP) = VA(ISP,IP) / CGSIG(IP) * CLATS(IPLG(IP)) + ENDDO + ENDDO + UOLD = U + + DO IT = 1, ITER(IK) + ST = ZERO + DO IE = 1, NE + NI = INE(:,IE) + DO ITH = 1, NTH + UTILDE(ITH) = NM(ITH,IE,IK) * (FLALL1(ITH,IE,IK)*U(ITH,NI(1)) + FLALL2(ITH,IE,IK)*U(ITH,NI(2)) + FLALL3(ITH,IE,IK)*U(ITH,NI(3))) + ST(ITH,NI(1)) = ST(ITH,NI(1)) + KELEM1(ITH,IE,IK) * (U(ITH,NI(1)) - UTILDE(ITH)) ! the 2nd term are the theta values of each node ... + ST(ITH,NI(2)) = ST(ITH,NI(2)) + KELEM2(ITH,IE,IK) * (U(ITH,NI(2)) - UTILDE(ITH)) ! the 2nd term are the theta values of each node ... + ST(ITH,NI(3)) = ST(ITH,NI(3)) + KELEM3(ITH,IE,IK) * (U(ITH,NI(3)) - UTILDE(ITH)) ! the 2nd term are the theta values of each node ... + ENDDO + END DO ! IE + DO IP = 1, NP + DO ITH = 1, NTH + ISP = ITH + (IK-1) * NTH + U(ITH,IP) = MAX(ZERO,U(ITH,IP)-DTSI(IP)*ST(ITH,IP)*(1-IOBPA_LOC(IP)))*IOBPD_LOC(ITH,IP)*IOBDP_LOC(IP) +#ifdef W3_REF1 + IF (REFPARS(3).LT.0.5.AND.IOBPD_LOC(ITH,IP).EQ.0.AND.IOBPA_LOC(IP).EQ.0) U(ITH,IP) = UOLD(ITH,IP) ! restores reflected boundary values +#endif + ENDDO + ENDDO ! IE + + IF ( FLBPI ) THEN + DO ITH = 1, NTH + ISP = ITH + (IK-1) * NTH + RD1 = RD10 - DTG * REAL(ITER(IK)-IT)/REAL(ITER(IK)) + RD2 = RD20 + IF ( RD2 .GT. 0.001 ) THEN + RD2 = MIN(1.,MAX(0.,RD1/RD2)) + RD1 = 1. - RD2 + ELSE + RD1 = 0. + RD2 = 1. + END IF + DO IBI = 1, NBI + IP_glob = MAPSF(ISBPI(IBI),1) + JX = IPGL_npa(IP_glob) + IF (JX .gt. 0) THEN + U(ITH,JX) = ( RD1*BBPI0(ISP,IBI) + RD2*BBPIN(ISP,IBI) ) / CGSIG(ISBPI(IBI)) * CLATS(ISBPI(IBI)) + END IF + END DO + ENDDO + ENDIF ! FLBPI + + CALL PDLIB_exchange2DREAL(U) + + ENDDO ! IT + +! Exact and convert Wave Action + DO ITH = 1, NTH + ISP = ITH + (IK-1) * NTH + DO IP = 1, NP + VA(ISP,IP) = U(ITH,IP) * CGSIG(IP) / CLATS(IPLG(IP)) + ENDDO + ENDDO + + ENDDO ! IK + END SUBROUTINE PDLIB_EXPLICIT_BLOCK !/ ------------------------------------------------------------------- / + SUBROUTINE BLOCK_SOLVER_EXPLICIT_INIT() + !/ + !/ +-----------------------------------+ + !/ | WAVEWATCH III NOAA/NCEP | + !/ | | + !/ | Aron Roland (BGS IT&E GmbH) | + !/ | Mathieu Dutour-Sikiric (IRB) | + !/ | | + !/ | FORTRAN 90 | + !/ | Last update : 01-June-2018 | + !/ +-----------------------------------+ + !/ + !/ 01-June-2018 : Origination. ( version 6.04 ) + !/ + ! 1. Purpose : Initialization of the block solver + ! 2. Method : + ! 3. Parameters : + ! + ! Parameter list + ! ---------------------------------------------------------------- + ! ---------------------------------------------------------------- + ! + ! 4. Subroutines used : + ! + ! Name Type Module Description + ! ---------------------------------------------------------------- + ! STRACE Subr. W3SERVMD Subroutine tracing. + ! ---------------------------------------------------------------- + ! + ! 5. Called by : + ! + ! Name Type Module Description + ! ---------------------------------------------------------------- + ! ---------------------------------------------------------------- + ! + ! 6. Error messages : + ! 7. Remarks + ! 8. Structure : + ! 9. Switches : + ! + ! !/S Enable subroutine tracing. + ! + ! 10. Source code : + ! + !/ ------------------------------------------------------------------- / +#ifdef W3_S + USE W3SERVMD, only: STRACE +#endif + USE W3GDATMD, only: NTH, NK +#ifdef W3_PDLIB + USE YOWNODEPOOL, only: np + USE YOWELEMENTPOOL, only: ne +#endif + IMPLICIT NONE + !/ + + ALLOCATE(FLALL1(NTH,NE,NK), FLALL2(NTH,NE,NK), FLALL3(NTH,NE,NK)) + ALLOCATE(KELEM1(NTH,NE,NK), KELEM2(NTH,NE,NK), KELEM3(NTH,NE,NK)) + ALLOCATE(NM(NTH,NE,NK), DTSI(NP)) + ALLOCATE(ITER(NK)) + + !/ ------------------------------------------------------------------- / + !/ + END SUBROUTINE BLOCK_SOLVER_EXPLICIT_INIT + !/ ------------------------------------------------------------------- / SUBROUTINE BLOCK_SOLVER_INIT(IMOD) !/ !/ +-----------------------------------+ @@ -6759,7 +6719,7 @@ SUBROUTINE BLOCK_SOLVER_INIT(IMOD) USE W3SERVMD, only: STRACE #endif ! - USE CONSTANTS, only : LPDLIB + USE CONSTANTS, only : LPDLIB, TPI, TPIINV USE W3GDATMD, only: MAPSF, NSEAL, DMIN, IOBDP, MAPSTA, IOBP, MAPFS, NX USE W3ADATMD, only: DW USE W3PARALL, only: INIT_GET_ISEA @@ -6931,7 +6891,6 @@ SUBROUTINE SET_IOBDP_PDLIB ELSE IOBDP_LOC(IP) = 1 ENDIF - !WRITE(*,*) ip, ip_glob, IOBDP_LOC(IP), DW(IP_glob), DMIN END DO !/ !/ End of SETDEPTH_PDLIB --------------------------------------------- / @@ -7202,20 +7161,6 @@ SUBROUTINE SET_UG_IOBP_PDLIB_INIT() DO IP = 1, NPA IF ( IOBPA_LOC(IP) .eq. 1 .OR. IOBP_LOC(IP) .eq. 3 .OR. IOBP_LOC(IP) .eq. 4) IOBPD_LOC(:,IP) = 1 END DO - !2do: recode for mpi - ! IF (LBCWA .OR. LBCSP) THEN - ! IF (.NOT. ANY(IOBP .EQ. 2)) THEN - ! CALL WWM_ABORT('YOU IMPOSED BOUNDARY CONDITIONS BUT IN THE BOUNDARY FILE ARE NO NODES WITH FLAG = 2') - ! ENDIF - ! ENDIF - !#ifdef MPI_PARALL_GRID - ! CALL exchange_p2di(IOBWB) - ! DO ID = 1, MDC - ! iwild = IOBPD(ID,:) - ! CALL exchange_p2di(iwild) - ! IOBPD(ID,:) = iwild - ! ENDDO - !#endif #ifdef W3_DEBUGSETUGIOBP WRITE(740+IAPROC,*) 'Calling SETUGIOBP, step 7' FLUSH(740+IAPROC) @@ -7428,6 +7373,78 @@ SUBROUTINE DEALLOCATE_PDLIB_GLOBAL(IMOD) !/ END SUBROUTINE DEALLOCATE_PDLIB_GLOBAL + SUBROUTINE ERGOUT(FHNDL, ERGNAME) + !/ + !/ +-----------------------------------+ + !/ | WAVEWATCH III NOAA/NCEP | + !/ | | + !/ | Aron Roland (BGS IT&E GmbH) | + !/ | | + !/ | FORTRAN 90 | + !/ | Last update : 01-Januar-2023 | + !/ +-----------------------------------+ + !/ + !/ 01-June-2018 : Origination. ( version 7.xx ) + !/ + ! 1. Purpose : write spatial out for xfn + ! 2. Method : + ! 3. Parameters : + ! + ! Parameter list + ! ---------------------------------------------------------------- + ! ---------------------------------------------------------------- + ! + ! 4. Subroutines used : + ! + ! Name Type Module Description + ! ---------------------------------------------------------------- + ! STRACE Subr. W3SERVMD Subroutine tracing. + ! ---------------------------------------------------------------- + ! + ! 5. Called by : + ! + ! Name Type Module Description + ! ---------------------------------------------------------------- + ! ---------------------------------------------------------------- + ! + ! 6. Error messages : + ! 7. Remarks + ! 8. Structure : + ! 9. Switches : + ! + ! !/S Enable subroutine tracing. + ! + ! 10. Source code : + ! + !/ ------------------------------------------------------------------- / +#ifdef W3_S + USE W3SERVMD, only: STRACE +#endif + USE W3GDATMD, only: NSPEC, NTH, NK, NSEAL + USE W3WDATMD, only: VA, VAOLD + IMPLICIT NONE + + INTEGER, INTENT(IN) :: FHNDL + CHARACTER(LEN=*), INTENT(IN) :: ERGNAME + REAL :: SUMVA(NSEAL) + INTEGER :: JSEA + + IF (LINIT_OUTPUT) THEN + OPEN(FHNDL, FILE = TRIM(ERGNAME), FORM = 'UNFORMATTED') + LINIT_OUTPUT = .false. + ENDIF + + RTIME = RTIME + 1. + + DO JSEA = 1, NSEAL + SUMVA(JSEA) = SUM(VA(:,JSEA)) + ENDDO + + WRITE(FHNDL) RTIME + WRITE(FHNDL) (SUMVA(JSEA), SUMVA(JSEA), SUMVA(JSEA), JSEA = 1, NSEAL) + + END SUBROUTINE + !/ ------------------------------------------------------------------- / SUBROUTINE JACOBI_INIT(IMOD) !/ !/ +-----------------------------------+ diff --git a/model/src/w3ref1md.F90 b/model/src/w3ref1md.F90 index 11f4f8961..795bdce20 100644 --- a/model/src/w3ref1md.F90 +++ b/model/src/w3ref1md.F90 @@ -65,7 +65,7 @@ MODULE W3REF1MD CONTAINS !/ ------------------------------------------------------------------- / SUBROUTINE W3SREF(A, CG, WN, EMEAN, FMEAN, DEPTH, CX1, CY1, REFLC, REFLD, & - TRNX, TRNY, BERG, DT, IX, IY,S) + TRNX, TRNY, BERG, DT, IX, IY, JSEA, S) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | @@ -173,7 +173,7 @@ SUBROUTINE W3SREF(A, CG, WN, EMEAN, FMEAN, DEPTH, CX1, CY1, REFLC, REFLD, & REAL, INTENT(IN) :: CG(NK), WN(NK), DEPTH, EMEAN, FMEAN REAL, INTENT(INOUT) :: A(NSPEC) REAL, INTENT(IN) :: CX1, CY1, DT - INTEGER, INTENT(IN) :: REFLD(6), IX, IY + INTEGER, INTENT(IN) :: REFLD(6), IX, IY, JSEA REAL, INTENT(IN) :: REFLC(4), TRNX, & TRNY, BERG REAL, INTENT(OUT) :: S(NSPEC) @@ -240,8 +240,8 @@ SUBROUTINE W3SREF(A, CG, WN, EMEAN, FMEAN, DEPTH, CX1, CY1, REFLC, REFLD, & IF (GTYPE.EQ.UNGTYPE) THEN IF (LPDLIB) THEN #ifdef W3_PDLIB - DELX=5.*SQRT(PDLIB_SI(IX))*(DERA * RADIUS) ! first approximation ... - DELY=5.*SQRT(PDLIB_SI(IX))*(DERA * RADIUS) ! first approximation ... + DELX=5.*SQRT(PDLIB_SI(JSEA))*(DERA * RADIUS) ! first approximation ... + DELY=5.*SQRT(PDLIB_SI(JSEA))*(DERA * RADIUS) ! first approximation ... #endif ELSE DELX=5.*SQRT(SI(IX))*(DERA * RADIUS) ! first approximation ... @@ -281,7 +281,7 @@ SUBROUTINE W3SREF(A, CG, WN, EMEAN, FMEAN, DEPTH, CX1, CY1, REFLC, REFLD, & ATMP2(:)=A(:) ! this is really to keep in memory the original spectrum IF (IGBCOVERWRITE.AND.REFLC(1).GT.0) THEN IGFAC1 = 1. - ATMP2(1:NSPECIGSTART)=0. + ATMP2(1:NSPECIGSTART) = 0. END IF ! ! resets IG band energy to zero @@ -439,7 +439,7 @@ SUBROUTINE W3SREF(A, CG, WN, EMEAN, FMEAN, DEPTH, CX1, CY1, REFLC, REFLD, & IF (GTYPE.EQ.UNGTYPE.AND.REFPARS(3).LT.0.5) THEN IF (LPDLIB) THEN #ifdef W3_PDLIB - IOBPDIP = IOBPD_LOC(:,IX) + IOBPDIP = IOBPD_LOC(:,JSEA) #endif ELSE IOBPDIP = IOBPD(:,IX) diff --git a/model/src/w3snl3md.F90 b/model/src/w3snl3md.F90 index 9869a60f6..d737cacd0 100644 --- a/model/src/w3snl3md.F90 +++ b/model/src/w3snl3md.F90 @@ -336,7 +336,7 @@ SUBROUTINE W3SNL3 ( A, CG, WN, DEPTH, S, D ) USE W3ODATMD, ONLY: NDSE, NDST ! USE W3SERVMD, ONLY: EXTCDE - USE W3DISPMD, ONLY: WAVNU1 + USE W3DISPMD, ONLY: WAVNU1, WAVNU3 #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -393,7 +393,11 @@ SUBROUTINE W3SNL3 ( A, CG, WN, DEPTH, S, D ) XCG(1:NFR) = CG ! DO IFR = NFR+1, NFRMAX - CALL WAVNU1 ( XSI(IFR), DEPTH, XWN(IFR), XCG(IFR) ) +#ifdef W3_PDLIB + CALL WAVNU3(XSI(IFR), DEPTH, XWN(IFR), XCG(IFR)) +#else + CALL WAVNU1(XSI(IFR), DEPTH, XWN(IFR), XCG(IFR)) +#endif END DO ! ! 1.b Expanded pseudo spetrum diff --git a/model/src/w3srcemd.F90 b/model/src/w3srcemd.F90 index 3df4b7a06..12ff81291 100644 --- a/model/src/w3srcemd.F90 +++ b/model/src/w3srcemd.F90 @@ -504,7 +504,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & FTE, FTF, FHMAX, ECOS, ESIN, IICEDISP, & ICESCALES, IICESMOOTH USE W3GDATMD, ONLY: FSSOURCE, optionCall - USE W3GDATMD, ONLY: B_JGS_NLEVEL, B_JGS_SOURCE_NONLINEAR + USE W3GDATMD, ONLY: B_JGS_NLEVEL, B_JGS_SOURCE_NONLINEAR, B_JGS_LIMITER #ifdef W3_REF1 USE W3GDATMD, ONLY: IOBP, IOBPD, IOBDP, GTYPE, UNGTYPE, REFPARS #endif @@ -644,7 +644,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & #ifdef W3_PDLIB USE PDLIB_W3PROFSMD, ONLY : B_JAC, ASPAR_JAC, ASPAR_DIAG_SOURCES, ASPAR_DIAG_ALL USE yowNodepool, ONLY: PDLIB_CCON, NPA, PDLIB_I_DIAG, PDLIB_JA, PDLIB_IA_P, PDLIB_SI - USE W3GDATMD, ONLY: IOBP_LOC, IOBPD_LOC, IOBPA_LOC, IOBDP_LOC + USE W3GDATMD, ONLY: IOBP_LOC, IOBPD_LOC, IOBPA_LOC, IOBDP_LOC, B_JGS_LIMITER_FUNC USE W3WDATMD, ONLY: VA USE W3PARALL, ONLY: ONESIXTH, ZERO, THR, IMEM, LSLOC #endif @@ -811,7 +811,6 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & REAL :: eInc1, eInc2, eVS, eVD, JAC REAL :: DeltaSRC(NSPEC) REAL, PARAMETER :: DTMINTOT = 0.01 - LOGICAL :: LNEWLIMITER = .FALSE. #ifdef W3_PDLIB REAL :: PreVS, FAK, DVS, SIDT, FAKS, MAXDAC #endif @@ -1275,7 +1274,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & IF (.NOT. FSSOURCE .or. LSLOC) THEN #endif #ifdef W3_TR1 - CALL W3STR1 ( SPEC, CG1, WN1, DEPTH, IX, VSTR, VDTR ) + CALL W3STR1 ( SPEC, SPECOLD, CG1, WN1, DEPTH, IX, VSTR, VDTR ) #endif #ifdef W3_PDLIB ENDIF @@ -1421,18 +1420,40 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & VSDS(1:NSPECH) = ICESCALEDS * VSDS(1:NSPECH) VDDS(1:NSPECH) = ICESCALEDS * VDDS(1:NSPECH) END IF + +#ifdef W3_PDLIB + IF (B_JGS_LIMITER_FUNC == 2) THEN + DO IK=1, NK + JAC = CG1(IK)/CLATSL + JAC2 = 1./TPI/SIG(IK) + FRLOCAL = SIG(IK)*TPIINV +#ifdef W3_ST6 + DAM2(1+(IK-1)*NTH) = 5E-7 * GRAV/FRLOCAL**4 * USTAR * FMEAN * DTMIN * JAC * JAC2 +#else + DAM2(1+(IK-1)*NTH) = 5E-7 * GRAV/FRLOCAL**4 * USTAR * MAX(FMEANWS,FMEAN) * DTMIN * JAC * JAC2 +#endif + !FROM WWM: 5E-7 * GRAV/FR(IS)**4 * USTAR * MAX(FMEANWS(IP),FMEAN(IP)) * DT4S/PI2/SPSIG(IS) + END DO + DO IK=1, NK + IS0 = (IK-1)*NTH + DO ITH=2, NTH + DAM2(ITH+IS0) = DAM2(1+IS0) + END DO + END DO + ENDIF +#endif ! - VS = 0 - VD = 0 DO IS=IS1, NSPECH VS(IS) = VSLN(IS) + VSIN(IS) + VSNL(IS) & + VSDS(IS) + VSBT(IS) #ifdef W3_ST6 VS(IS) = VS(IS) + VSWL(IS) #endif +#ifndef W3_PDLIB #ifdef W3_TR1 VS(IS) = VS(IS) + VSTR(IS) #endif +#endif #ifdef W3_BS1 VS(IS) = VS(IS) + VSBS(IS) #endif @@ -1444,9 +1465,11 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & #ifdef W3_ST6 VD(IS) = VD(IS) + VDWL(IS) #endif +#ifndef W3_PDLIB #ifdef W3_TR1 VD(IS) = VD(IS) + VDTR(IS) #endif +#endif #ifdef W3_BS1 VD(IS) = VD(IS) + VDBS(IS) #endif @@ -1467,6 +1490,9 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & ENDIF #endif END DO ! end of loop on IS + + !VD = 0 + !VS = 0 ! DT = MAX ( 0.5, DT ) ! The hardcoded min. dt is a problem for certain cases e.g. laborotary scale problems. ! @@ -1538,14 +1564,16 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & DO ITH = 1, NTH ISP = ITH + (IK-1)*NTH VD(ISP) = MIN(0., VD(ISP)) - IF (LNEWLIMITER) THEN + IF (B_JGS_LIMITER_FUNC == 2) THEN MAXDAC = MAX(DAM(ISP),DAM2(ISP)) ELSE MAXDAC = DAM(ISP) ENDIF FAKS = DTG / MAX ( 1. , (1.-DTG*VD(ISP))) DVS = VS(ISP) * FAKS - DVS = SIGN(MIN(MAXDAC,ABS(DVS)),DVS) + IF (.NOT. B_JGS_LIMITER) THEN + DVS = SIGN(MIN(MAXDAC,ABS(DVS)),DVS) + ENDIF PreVS = DVS / FAKS eVS = PreVS / CG1(IK) * CLATSL eVD = MIN(0.,VD(ISP)) @@ -1589,23 +1617,25 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & DO ITH=1,NTH ISP=ITH + (IK-1)*NTH VD(ISP) = MIN(0., VD(ISP)) - IF (LNEWLIMITER) THEN + IF (B_JGS_LIMITER_FUNC == 2) THEN MAXDAC = MAX(DAM(ISP),DAM2(ISP)) ELSE MAXDAC = DAM(ISP) ENDIF FAKS = DTG / MAX ( 1. , (1.-DTG*VD(ISP))) DVS = VS(ISP) * FAKS - DVS = SIGN(MIN(MAXDAC,ABS(DVS)),DVS) + IF (.NOT. B_JGS_LIMITER) THEN + DVS = SIGN(MIN(MAXDAC,ABS(DVS)),DVS) + ENDIF PreVS = DVS / FAKS eVS = PreVS / CG1(IK) * CLATSL eVD = VD(ISP) #ifdef W3_DB1 eVS = eVS + DBLE(VSDB(ISP)) * JAC eVD = evD + MIN(0.,DBLE(VDDB(ISP))) -#endif B_JAC(ISP,JSEA) = B_JAC(ISP,JSEA) + SIDT * (eVS - eVD*VA(ISP,JSEA)) ASPAR_DIAG_ALL(ISP,JSEA) = ASPAR_DIAG_ALL(ISP,JSEA) - SIDT * eVD +#endif END DO END DO ENDIF @@ -1672,7 +1702,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & RETURN ! return everything is done for the implicit ... END IF ! srce_imp_pre -#endif W3_PDLIB +#endif !W3_PDLIB ! #ifdef W3_T WRITE (NDST,9040) DTRAW, DT, SHAVE @@ -1701,6 +1731,12 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & SPEC(IS) = MAX ( 0. , SPEC(IS)+eInc1 ) END DO #endif +#ifdef W3_TR1 + DO IS=IS1, NSPECH + eInc1 = VDTR(IS) * DT / MAX ( 1. , (1.-HDT*VDTR(IS))) + SPEC(IS) = MAX ( 0. , SPEC(IS)+eInc1 ) + END DO +#endif #ifdef W3_DEBUGSRC IF (IX == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VSIN) @@ -1944,7 +1980,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & ! IF (IX == DEBUG_NODE) WRITE(*,*) 'DTTOT, DTG', DTTOT, DTG EXIT ENDIF - END DO ! INTEGRATIN LOOP + END DO ! INTEGRATION LOOP #ifdef W3_DEBUGSRC IF (IX .eq. DEBUG_NODE) THEN WRITE(740+IAPROC,*) 'NSTEPS=', NSTEPS @@ -2221,32 +2257,38 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & IF (IX .eq. DEBUG_NODE) THEN WRITE(740+IAPROC,*) '5 : sum(SPEC)=', sum(SPEC) END IF -#endif +#endif + #ifdef W3_REF1 IF (REFLEC(1).GT.0.OR.REFLEC(2).GT.0.OR.(REFLEC(4).GT.0.AND.BERG.GT.0)) THEN CALL W3SREF ( SPEC, CG1, WN1, EMEAN, FMEAN, DEPTH, CX, CY, & REFLEC, REFLED, TRNX, TRNY, & - BERG, DTG, IX, IY, VREF ) + BERG, DTG, IX, IY, JSEA, VREF ) IF (GTYPE.EQ.UNGTYPE.AND.REFPARS(3).LT.0.5) THEN -#endif - !AR: this can be further simplified let's do some simple tests 1st ... -#ifdef W3_REF1 +#ifdef W3_PDLIB + IF (IOBP_LOC(JSEA).EQ.0) THEN +#else IF (IOBP(IX).EQ.0) THEN +#endif DO IK=1, NK DO ITH=1, NTH - IF (IOBPD(ITH,IX).EQ.0) SPEC(ITH+(IK-1)*NTH) = DTG*VREF(ITH+(IK-1)*NTH) + ISP = ITH+(IK-1)*NTH +#ifdef W3_PDLIB + IF (IOBPD_LOC(ITH,JSEA).EQ.0) SPEC(ISP) = DTG*VREF(ISP) +#else + IF (IOBPD(ITH,IX).EQ.0) SPEC(ISP) = DTG*VREF(ISP) +#endif END DO END DO ELSE - IF (IOBDP(IX) .EQ. -1) THEN - SPEC(:) = SPEC(:) + DTG * VREF(:) - ENDIF + SPEC(:) = SPEC(:) + DTG * VREF(:) ENDIF ELSE SPEC(:) = SPEC(:) + DTG * VREF(:) END IF END IF #endif + ! #ifdef W3_DEBUGSRC IF (IX .eq. DEBUG_NODE) THEN diff --git a/model/src/w3str1md.F90 b/model/src/w3str1md.F90 index 99ded2892..d8067abd7 100644 --- a/model/src/w3str1md.F90 +++ b/model/src/w3str1md.F90 @@ -2,6 +2,7 @@ !> @brief Contains module W3STR1MD. !> !> @author A. J. van der Westhuysen @date 13-Jan-2013 +!> @author A. Roland @date 22-Feb-2023 !> #include "w3macros.h" @@ -179,17 +180,19 @@ MODULE W3STR1MD !> !> @author A. J. van der Westhuysen @date 13-Jan-2013 !> - SUBROUTINE W3STR1 (A, CG, WN, DEPTH, IX, S, D) + SUBROUTINE W3STR1 (A, AOLD, CG, WN, DEPTH, IX, S, D) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | A. J. van der Westhuysen | + !/ | A. Roland | !/ | FORTRAN 90 | !/ | Last update : 13-Jan-2013 | !/ +-----------------------------------+ !/ !/ 13 Jan-2013 : Origination, based on SWAN v40.91 code ( version 4.08 ) !/ 05 Oct-2016 : Avoiding divide by zero for EMEAN ( version 5.15 ) + !/ 28 Feb-2023 : Improvement of efficiency and stability ( version 7.xx) !/ ! 1. Purpose : ! @@ -317,7 +320,7 @@ SUBROUTINE W3STR1 (A, CG, WN, DEPTH, IX, S, D) !/ ------------------------------------------------------------------- / !/ Parameter list !/ - REAL, INTENT(IN) :: CG(NK), WN(NK), DEPTH, A(NSPEC) + REAL, INTENT(IN) :: CG(NK), WN(NK), DEPTH, A(NSPEC), AOLD(NSPEC) INTEGER, INTENT(IN) :: IX REAL, INTENT(OUT) :: S(NSPEC), D(NSPEC) !/ @@ -368,92 +371,84 @@ SUBROUTINE W3STR1 (A, CG, WN, DEPTH, IX, S, D) ! XISLN : log of XIS ! #ifdef W3_S - INTEGER, SAVE :: IENT = 0 + INTEGER, SAVE :: IENT = 0 #endif - INTEGER I1, I2, ID, IDDUM, II, IS, ISM, ISM1, ISMAX, & - ISP, ISP1, ITH, IK - REAL AUX1, AUX2, BIPH, C0, CM, DEP, DEP_2, DEP_3, E0, EM, HS, & - FT, RINT, SIGPICG, SINBPH, STRI, WISM, WISM1, WISP, & - WISP1, W0, WM, WN0, WNM, XIS, XISLN - REAL, ALLOCATABLE :: E(:), SA(:,:) - REAL :: EB(NK), EBAND, EMEAN, SIGM01 - !----- Temp (to be moved) ----- - REAL, ALLOCATABLE :: EF(:),SF(:) + INTEGER :: I1, I2, ID, IDDUM, II, IS, ISM, ISM1, ISMAX + INTEGER :: ISP, ISP1, ITH, IK + REAL :: AUX1, AUX2, BIPH, C0, CM, DEP, DEP_2, DEP_3, E0, EM, HS + REAL :: FT, RINT, SIGPICG, SINBPH, STRI, WISM, WISM1, WISP + REAL :: WISP1, W0, WM, WN0, WNM, XIS, XISLN, EDM, ED0, G9DEP, STRI2 + REAL :: E(NK), SA(NTH,100), SA2(NTH,100), A2(NSPEC), A3(NSPEC), HMAX + REAL :: EB(NK), EBAND, EMEAN, SIGM01, ED(NK) +!----- Temp (to be moved) ----- + REAL :: EF(NK), JACEPS, DIFFSTR REAL :: PTRIAD(5) - REAL :: URSELL - !------------------------------ - !/ - !/ ------------------------------------------------------------------- / - !/ + REAL :: URSELL, ALPHAR +!------------------------------ +!/ +!/ ------------------------------------------------------------------- / +!/ #ifdef W3_S CALL STRACE (IENT, 'W3STR1') #endif - ! - ! 0. Initializations ------------------------------------------------ * - ! - ! ********************************************************** - ! *** The initialization routine should include all *** - ! *** initialization, including reading data from files. *** - ! ********************************************************** - ! - !> IF ( FIRST ) THEN - !> CALL INSTR1 - !> FIRST = .FALSE. - !> END IF - ! - ! 1. .... ----------------------------------------------------------- * - ! - !---- Compute SIGM01 (= 2pi/Tm01) for use in source term - ! - ! 1. Integral over directions - ! + +!AR: todo: check all PRX routines for differences, check original thesis of elderberky. +! +! 1. Integral over directions +! SIGM01 = 0. EMEAN = 0. - ! FMEAN = 0. + JACEPS = 1E-12 + + HMAX = DEPTH * 0.73 DO IK=1, NK EB(IK) = 0. + ED(IK) = 0. DO ITH=1, NTH EB(IK) = EB(IK) + A(ITH+(IK-1)*NTH) + ED(IK) = ED(IK) + A(ITH+(IK-1)*NTH) * DDEN(IK) / CG(IK) END DO END DO - ! - ! 2. Integrate over directions - ! +! +! 2. Integrate over frequencies. +! DO IK=1, NK EB(IK) = EB(IK) * DDEN(IK) / CG(IK) EMEAN = EMEAN + EB(IK) SIGM01 = SIGM01 + EB(IK)*SIG(IK) END DO - ! - ! 3. Add tail beyond discrete spectrum - ! ( DTH * SIG(NK) absorbed in FTxx ) - ! +! +! 3. Add tail beyond discrete spectrum +! ( DTH * SIG(NK) absorbed in FTxx ) +! EBAND = EB(NK) / DDEN(NK) EMEAN = EMEAN + EBAND * FTE SIGM01 = SIGM01 + EBAND * FTF - ! - ! 4. Final processing - ! - SIGM01 = MAX ( 1.E-7 , SIGM01 ) / MAX(EMEAN,0.001) +! +! 4. Final processing +! + SIGM01 = SIGM01 / EMEAN + +!---- Temporary parameters (to be replaced by namelists) ----- - !---- Temporary parameters (to be replaced by namelists) ----- - PTRIAD(1) = 0.05 - PTRIAD(2) = 2.5 - PTRIAD(3) = 10. + PTRIAD(1) = 1. + PTRIAD(2) = 10. + PTRIAD(3) = 10. ! not used PTRIAD(4) = 0.2 PTRIAD(5) = 0.01 HS = 4.*SQRT( MAX(0.,EMEAN) ) URSELL = (GRAV*HS)/(2.*SQRT(2.)*SIGM01**2*DEPTH**2) - !--------------------------------------------- +!--------------------------------------------- DEP = DEPTH DEP_2 = DEP**2 DEP_3 = DEP**3 - ! - ! --- compute some indices in sigma space - ! + G9DEP = GRAV * DEP +! +! --- compute some indices in sigma space +! I2 = INT (FLOAT(NK) / 2.) I1 = I2 - 1 XIS = SIG(I2) / SIG(I1) @@ -469,107 +464,79 @@ SUBROUTINE W3STR1 (A, CG, WN, DEPTH, IX, S, D) WISM = (XIS**ISM -0.5) / (XIS**ISM - XIS**ISM1) WISM1 = 1. - WISM - ALLOCATE (E (1:NK)) - ALLOCATE (SA(1:NTH,1:NK+ISP1)) E = 0. SA = 0. - - ! - ! --- compute maximum frequency for which interactions are calculated - ! +! +! --- compute maximum frequency for which interactions are calculated +! ISMAX = 1 DO IK = 1, NK - IF ( SIG(IK) .LT. ( PTRIAD(2) * SIGM01) ) THEN + IF ( SIG(IK) .LT. ( PTRIAD(2) * SIGM01) ) THEN ISMAX = IK - ENDIF + ENDIF ENDDO ISMAX = MAX ( ISMAX , ISP1 ) - ! - ! --- compute 3-wave interactions - ! - IF ( URSELL.GE.PTRIAD(5) ) THEN - ! - ! --- calculate biphase - ! - BIPH = (0.5*PI)*(TANH(PTRIAD(4)/URSELL)-1.) - SINBPH = ABS( SIN(BIPH) ) - ! - ALLOCATE (EF (1:NK)) - EF = 0. - DO ITH = 1, NTH - ! - ! --- initialize array with E(f) for the direction considered - ! --- (convert from N(k) to E(f) using proper Jacobian) - ! - DO IK = 1, NK - E(IK) = A(ITH+(IK-1)*NTH) * TPI * SIG(IK) / CG(IK) - !------------ Test ------------------------------------------ - EF(IK) = EF(IK) + E(IK) - !------------------------------------------------------------ - END DO - ! - DO IK = 1, ISMAX +! +! --- compute 3-wave interactions +! + IF (URSELL.GE.PTRIAD(5) ) THEN ! AR: No need for switching it off from my point of view! +! +! --- calculate biphase +! + BIPH = (0.5*PI)*(TANH(PTRIAD(4)/URSELL)-1.) + SINBPH = ABS(SIN(BIPH) ) + EF = 0. - E0 = E(IK) - W0 = SIG(IK) - WN0 = WN(IK) - C0 = W0 / WN0 - - IF ( IK.GT.-ISM1 ) THEN - EM = WISM * E(IK+ISM1) + WISM1 * E(IK+ISM) - WM = WISM * SIG(IK+ISM1) + WISM1 * SIG(IK+ISM) - WNM = WISM * WN(IK+ISM1) + WISM1 * WN(IK+ISM) - CM = WM / WNM - ELSE - EM = 0. - WM = 0. - WNM = 0. - CM = 0. - END IF - - AUX1 = WNM**2 * ( GRAV * DEP + 2.*CM**2 ) - AUX2 = WN0 * DEP * ( GRAV * DEP + & - (2./15.) * GRAV * DEP_3 * WN0**2 - & - (2./ 5.) * W0**2 * DEP_2 ) - RINT = AUX1 / AUX2 - FT = PTRIAD(1) * C0 * CG(IK) * RINT**2 * SINBPH - - SA(ITH,IK) = MAX(0., FT * ( EM * EM - 2. * EM * E0 )) - - END DO - END DO - DEALLOCATE(EF) - ! - ! --- put source and diagonal terms together - ! (using Jacobian for S(f) -> S(k)) - ! - ALLOCATE (SF (1:NK)) - SF = 0. - DO IK = 1, NK - SIGPICG = SIG(IK) * 2. * PI / CG(IK) DO ITH = 1, NTH - ! --- Source term - S(ITH+(IK-1)*NTH) = 2.*( SA(ITH,IK) - & - 2.*(WISP * SA(ITH,IK+ISP1) + & - WISP1 * SA(ITH,IK+ISP )) ) / & - SIGPICG - SF(IK) = 2.*( SA(ITH,IK) - & - 2.*(WISP * SA(ITH,IK+ISP1) + & - WISP1 * SA(ITH,IK+ISP )) ) + SF(IK) - ! --- Diagonal term - D = 0. + DO IK = 1, NK + E(IK) = A(ITH+(IK-1)*NTH) * TPI * SIG(IK) / CG(IK) + EF(IK) = EF(IK) + E(IK) + END DO + DO IK = 1, ISMAX + E0 = E(IK) + ED0 = EB(IK) + W0 = SIG(IK) + WN0 = WN(IK) + C0 = W0 / WN0 + IF ( IK.GT.-ISM1 ) THEN + EM = WISM * E(IK+ISM1) + WISM1 * E(IK+ISM) + EDM = WISM * EB(IK+ISM1) + WISM1 * EB(IK+ISM) + WM = WISM * SIG(IK+ISM1) + WISM1 * SIG(IK+ISM) + WNM = WISM * WN(IK+ISM1) + WISM1 * WN(IK+ISM) + CM = WM / WNM + ELSE + EM = 0. + EDM = 0. + WM = 0. + WNM = 0. + CM = 0. + END IF + AUX1 = WNM**2 * ( G9DEP + 2*CM**2 ) + AUX2 = WN0*DEP* (G9DEP+(2./15.)*GRAV*DEP_3*WN0**2-(2./5.)*W0**2*DEP_2) + RINT = AUX1 / AUX2 + FT = PTRIAD(1) * C0 * CG(IK) * RINT**2 * SINBPH + SA(ITH,IK) = MAX(0.,FT * ( EM * EM - 2. * EM * E0)) ! 1/(m²*s²) * m4 = m²/s² !!! [m²/s] + END DO END DO - END DO - DEALLOCATE(SF) - ELSE - D = 0. - S = 0. - END IF - - DEALLOCATE(E,SA) + DO IK = 1, NK - 1 + SIGPICG = SIG(IK)*TPI/CG(IK) ! 1/s * s/m = 1/m + DO ITH = 1, NTH + STRI = SA(ITH,IK) - 2 * (WISP * SA(ITH,IK+ISP1) + WISP1 * SA(ITH,IK+ISP)) + IF (A(ITH+(IK-1)*NTH) .gt. JACEPS) THEN + D(ITH+(IK-1)*NTH) = STRI / ((A(ITH+(IK-1)*NTH)) * SIGPICG) + S(ITH+(IK-1)*NTH) = STRI / SIGPICG + ELSE + D(ITH+(IK-1)*NTH) = 0. + S(ITH+(IK-1)*NTH) = 0. + ENDIF + END DO + END DO + ELSE + D = 0. + S = 0. + END IF - RETURN !/ !/ End of W3STR1 ----------------------------------------------------- / !/ diff --git a/model/src/w3str2md.F90 b/model/src/w3str2md.F90 deleted file mode 100644 index 4efc63429..000000000 --- a/model/src/w3str2md.F90 +++ /dev/null @@ -1,449 +0,0 @@ -!> @file -!> @brief Contains module W3STR2MD. -!> -!> @author A. Roland @date 29-May-2012 -!> - -!/ ------------------------------------------------------------------- / -!> -!> @brief This piece of code computes the triad interaction term in -!> the same way as done in the SWAN model. -!> -!> @details The approach is truncated version of the work of Elderberky. -!> In SWAN the wave spectra is treated as one-dimensional and the -!> transfer to the higher harmoics is taken into account for this -!> no justification is given and it has to be further investigated. -!> The approximation of Elderberky is for a flat bottom (actually -!> bragg-0 resonance). The biggest problem is that it is not -!> conservative, which is the biggest limitation factor. Moreover it -!> is questionable if it was taken into account the in spectral -!> wave models the freq. bandwidths are exponentially distributed in -!> freq. space, which leads to the problem that it is possible that -!> some jacobian transformation is missing the derivation of the -!> discrete form, I am now looking into this and I hope that I can -!> give some closure soon. -!> -!> @author A. Roland @date 29-May-2012 -!> -MODULE W3STR2MD - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | A. Roland (IT&E) | - !/ | FORTRAN 90 | - !/ | Last update : 29-May-2012 | - !/ +-----------------------------------+ - !/ - !/ 15-Jul-2005 : Origination. ( version 3.07 ) - !/ 23-Jun-2006 : Formatted for submitting code for ( version 3.09 ) - !/ inclusion in WAVEWATCH III. - !/ 29-May-2009 : Preparing distribution version. ( version 3.14 ) - !/ - !/ Copyright 2009 National Weather Service (NWS), - !/ National Oceanic and Atmospheric Administration. All rights - !/ reserved. WAVEWATCH III is a trademark of the NWS. - !/ No unauthorized use without permission. - !/ - ! 1. Purpose : - ! - ! This peace of code computes the triad interaction term in the same way - ! as done in the SWAN model. - ! - ! 2. Variables and types : - ! - ! Name Type Scope Description - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 3. Subroutines and functions : - ! - ! Name Type Scope Description - ! ---------------------------------------------------------------- - ! W3STR2 Subr. Public User supplied triad interactions. - ! INSTR2 Subr. Public Corresponding initialization routine. - ! ---------------------------------------------------------------- - ! - ! 4. Subroutines and functions used : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! STRACE Subr. W3SERVMD Subroutine tracing. - ! ---------------------------------------------------------------- - ! - ! 5. Remarks : The approach is truncated version of the work of Elderberky. - ! In SWAN the wave spectra is treated as one-dimensional and - ! only the transfer to the higher harmoics is taken into account - ! for this no justification is given and it has to be further investigated. - ! The approximation of Elderberky is for a flat bottom (actually bragg-0 resonance) - ! The biggest problem is that it is not conservative, which is the biggest limitation factor. - ! Moreover it is questionable if it was taken into account the in spectral wave models the - ! freq. bandwidths are exponentially distributed in freq. space, which leads to the problem that - ! it is possible that some jacobian transformation is missing the derivation of hte discrete form, - ! I am now looking into this and I hope that I can give some closure soon. - ! - ! - ! See notes in the file below where to add these elements. - ! - ! 6. Switches : - ! - ! !/S Enable subroutine tracing. - ! - ! 7. Source code : - !/ - !/ ------------------------------------------------------------------- / - !/ - ! ***************************************** - ! *** Declare saved variables here *** - ! *** public or private as appropriate *** - ! ***************************************** - ! - PUBLIC - !/ -CONTAINS - !/ ------------------------------------------------------------------- / - !> - !> @brief Slot for user-supplied triad interaction source term. - !> - !> @param[in] A - !> @param[in] CG - !> @param[in] WN - !> @param[in] DEPTH - !> @param[in] IX - !> @param[out] S - !> @param[out] D - !> - !> @author A. Roland @date 02-Feb-2014 - !> - SUBROUTINE W3STR2 (A, CG, WN, DEPTH, IX, S, D) - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | A. Roland | - !/ | FORTRAN 90 | - !/ | Last update : 2-Feb-2014 | - !/ +-----------------------------------+ - !/ - !/ 15-Jul-2005 : Origination. ( version 3.07 ) - !/ 23-Jun-2006 : Formatted for submitting code for ( version 3.09 ) - !/ inclusion in WAVEWATCH III. - !/ - ! 1. Purpose : - ! - ! Slot for user-supplied triad interaction source term. - ! - ! 2. Method : - ! - ! 3. Parameters : - ! - ! Parameter list - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 4. Subroutines used : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! STRACE Subr. W3SERVMD Subroutine tracing. - ! ---------------------------------------------------------------- - ! - ! 5. Called by : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! W3SRCE Subr. W3SRCEMD Source term integration. - ! W3EXPO Subr. N/A Point output post-processor. - ! GXEXPO Subr. N/A GrADS point output post-processor. - ! ---------------------------------------------------------------- - ! - ! 6. Error messages : - ! - ! None. - ! - ! 7. Remarks : - ! - ! 8. Structure : - ! - ! Determine resonance condition and the maximum discrete freq. - ! for which the interactions are calculated. - ! - ! If Ursell number larger than prescribed value compute interactions - ! Check resolution - ! Calculate biphase - ! Do for each direction - ! Convert action density to energy density - ! Do for all frequencies - ! Calculate interaction coefficient and interaction factor - ! Compute interactions and store results in matrix - ! - ! 9. Switches : - ! - ! !/S Enable subroutine tracing. - ! - ! 10. Source code : - ! - !/ ------------------------------------------------------------------- / - USE CONSTANTS, ONLY: GRAV, PI, TPI - USE W3GDATMD, ONLY: NK, NTH, NSPEC, DTH, SIG, DDEN, FTE, FTF, PPTRIAD - USE W3ODATMD, ONLY: NDSE - USE W3SERVMD, ONLY: EXTCDE -#ifdef W3_S - USE W3SERVMD, ONLY: STRACE -#endif - !/ - IMPLICIT NONE - !/ - !/ ------------------------------------------------------------------- / - !/ Parameter list - !/ - REAL, INTENT(IN) :: CG(NK), WN(NK), DEPTH, A(NSPEC) - INTEGER, INTENT(IN) :: IX - REAL, INTENT(OUT) :: S(NSPEC), D(NSPEC) - !/ - !/ ------------------------------------------------------------------- / - !/ Local parameters - !/ - ! AUX1 : auxiliary real - ! AUX2 : auxiliary real - ! BIPH : parameterized biphase of the spectrum - ! C0 : phase velocity at central bin - ! CM : phase velocity at interacting bin - ! DEP : water depth - ! DEP_2 : water depth to power 2 - ! DEP_3 : water depth to power 3 - ! E : energy density as function of frequency - ! E0 : energy density at central bin - ! EM : energy density at interacting bin - ! HS : significant wave height - ! FT : auxiliary real indicating multiplication factor - ! for triad contribution - ! I1 : auxiliary integer - ! I2 : auxiliary integer - ! ID : counter - ! IDDUM : loop counter in direction space - ! IENT : number of entries - ! II : loop counter - ! IS : loop counter in frequency space - ! ISM : negative range for IS - ! ISM1 : negative range for IS - ! ISMAX : maximum of the counter in frequency space for - ! which the triad interactions are calculated (cut-off) - ! ISP : positive range for IS - ! ISP1 : positive range for IS - ! RINT : interaction coefficient - ! SA : interaction contribution of triad - ! SIGPICG : sigma times 2pi/Cg (a Jacobian for E(f) -> E(k)) - ! SINBPH: absolute sine of biphase - ! STRI : total triad contribution - ! WISM : interpolation weight factor corresponding to lower harmonic - ! WISM1 : interpolation weight factor corresponding to lower harmonic - ! WISP : interpolation weight factor corresponding to higher harmonic - ! WISP1 : interpolation weight factor corresponding to higher harmonic - ! W0 : radian frequency of central bin - ! WM : radian frequency of interacting bin - ! WN0 : wave number at central bin - ! WNM : wave number at interacting bin - ! XIS : rate between two succeeding frequency counters - ! XISLN : log of XIS - ! -#ifdef W3_S - INTEGER, SAVE :: IENT = 0 -#endif - INTEGER I1, I2, ID, IDDUM, IENT, II, IS, ISM, ISM1, ISMAX, & - ISP, ISP1, ITH, IK - REAL AUX1, AUX2, BIPH, C0, CM, DEP, DEP_2, DEP_3, E0, EM, HS, & - FT, RINT, SIGPICG, SINBPH, STRI, WISM, WISM1, WISP, & - WISP1, W0, WM, WN0, WNM, XIS, XISLN - REAL, ALLOCATABLE :: E(:), SA(:,:) - REAL :: EB(NK), EBAND, EMEAN, SIGM01 - !----- Temp (to be moved) ----- - REAL, ALLOCATABLE :: EF(:),SF(:) - REAL :: URSELL - !------------------------------ - !/ - !/ ------------------------------------------------------------------- / - !/ -#ifdef W3_S - CALL STRACE (IENT, 'W3STR2') -#endif - ! - ! 0. Initializations ------------------------------------------------ * - ! - ! ********************************************************** - ! *** The initialization routine should include all *** - ! *** initialization, including reading data from files. *** - ! ********************************************************** - ! - ! 1. .... ----------------------------------------------------------- * - ! - !---- Compute SIGM01 (= 2pi/Tm01) for use in source term - ! - ! 1. Integral over directions - ! - SIGM01 = 0. - EMEAN = 0. - ! FMEAN = 0. - - DO IK=1, NK - EB(IK) = 0. - DO ITH=1, NTH - EB(IK) = EB(IK) + A(ITH+(IK-1)*NTH) - END DO - END DO - ! - ! 2. Integrate over wave numbers - ! - DO IK=1, NK - EB(IK) = EB(IK) * DDEN(IK) / CG(IK) - EMEAN = EMEAN + EB(IK) - SIGM01 = SIGM01 + EB(IK)*SIG(IK) - END DO - ! - ! 3. Add tail beyond discrete spectrum - ! ( DTH * SIG(NK) absorbed in FTxx ) - ! - EBAND = EB(NK) / DDEN(NK) - EMEAN = EMEAN + EBAND * FTE - SIGM01 = SIGM01 + EBAND * FTF - ! - ! 4. Final processing - ! - SIGM01 = MAX ( 1.E-7 , SIGM01 ) / EMEAN - - IF (ABS(FACSCL-2.).GT.0.05) THEN - FACRES = 10.**( LOG10(2.) / FLOAT(IRES) ) - SIGLOW = SIG(NK) / ( FACRES**(FLOAT(NK-1) ) ) - ! WRITE (*,*) 'CHECK RESOLUTION', IRES, FACSCL, FACRES, SIGLOW - END IF - - HS = 4.*SQRT( MAX(0.,EMEAN) ) - URSELL = (GRAV*HS)/(2.*SQRT(2.)*SIGM01**2*DEPTH**2) - !--------------------------------------------- - - DEP = DEPTH - DEP_2 = DEP**2 - DEP_3 = DEP**3 - ! - ! --- compute some indices in sigma space - ! - I2 = INT (FLOAT(NK) / 2.) - I1 = I2 - 1 - XIS = SIG(I2) / SIG(I1) - XISLN = LOG( XIS ) - - ISP = INT( LOG(2.) / XISLN ) - ISP1 = ISP + 1 - WISP = (2. - XIS**ISP) / (XIS**ISP1 - XIS**ISP) - WISP1 = 1. - WISP - - ISM = INT( LOG(0.5) / XISLN ) - ISM1 = ISM - 1 - WISM = (XIS**ISM -0.5) / (XIS**ISM - XIS**ISM1) - WISM1 = 1. - WISM - - ALLOCATE (E (1:NK)) - ALLOCATE (SA(1:NTH,1:NK+ISP1)) - E = 0. - SA = 0. - - ! - ! --- compute maximum frequency for which interactions are calculated - ! - ISMAX = 1 - DO IK = 1, NK - IF ( SIG(IK) .LT. ( PPTRIAD(2) * SIGM01) ) THEN - ISMAX = IK - ENDIF - ENDDO - ISMAX = MAX ( ISMAX , ISP1 ) - ! - ! --- compute 3-wave interactions - ! - IF ( URSELL.GE.PPTRIAD(5) ) THEN - ! - ! --- calculate biphase - ! - BIPH = (0.5*PI)*(TANH(PPTRIAD(4)/URSELL)-1.) - SINBPH = ABS( SIN(BIPH) ) - ! - ALLOCATE (EF (1:NK)) - EF = 0. - DO ITH = 1, NTH - ! - ! --- initialize array with E(f) for the direction considered - ! --- (convert from N(k) to E(f) using proper Jacobian) - ! - DO IK = 1, NK - E(IK) = A(ITH+(IK-1)*NTH) * TPI * SIG(IK) / CG(IK) - EF(IK) = EF(IK) + E(IK) - END DO - ! - DO IK = 1, ISMAX - - E0 = E(IK) - W0 = SIG(IK) - WN0 = WN(IK) - C0 = W0 / WN0 - - IF ( IK.GT.-ISM1 ) THEN - EM = WISM * E(IK+ISM1) + WISM1 * E(IK+ISM) - WM = WISM * SIG(IK+ISM1) + WISM1 * SIG(IK+ISM) - WNM = WISM * WN(IK+ISM1) + WISM1 * WN(IK+ISM) - CM = WM / WNM - ELSE - EM = 0. - WM = 0. - WNM = 0. - CM = 0. - END IF - - AUX1 = WNM**2 * ( GRAV * DEP + 2.*CM**2 ) - AUX2 = WN0 * DEP * ( GRAV * DEP + & - (2./15.) * GRAV * DEP_3 * WN0**2 - & - (2./ 5.) * W0**2 * DEP_2 ) - RINT = AUX1 / AUX2 - FT = PPTRIAD(1) * C0 * CG(IK) * RINT**2 * SINBPH - - SA(ITH,IK) = MAX(0., FT * ( EM * EM - 2. * EM * E0 )) - - END DO - END DO - - DEALLOCATE(EF) - ! - ! --- put source and diagonal terms together - ! (using Jacobian for S(f) -> S(k)) - ! - ALLOCATE (SF (1:NK)) - SF = 0. - DO IK = 1, NK - SIGPICG = SIG(IK) * 2. * PI / CG(IK) - DO ITH = 1, NTH - ! --- Source term - S(ITH+(IK-1)*NTH) = 2.*( SA(ITH,IK) - & - 2.*(WISP * SA(ITH,IK+ISP1) + & - WISP1 * SA(ITH,IK+ISP )) ) / & - SIGPICG - ! --- Functional derivative - SF(IK) = 2.*( SA(ITH,IK) - & - 2.*(WISP * SA(ITH,IK+ISP1) + & - WISP1 * SA(ITH,IK+ISP )) ) + SF(IK) - D = 0. - END DO - END DO - DEALLOCATE(SF) - - ELSE - D = 0. - S = 0. - END IF - - DEALLOCATE(E,SA) - - RETURN - !/ - !/ End of W3STR2 ----------------------------------------------------- / - !/ - END SUBROUTINE W3STR2 - !/ ------------------------------------------------------------------- / - !/ -END MODULE W3STR2MD diff --git a/model/src/w3triamd.F90 b/model/src/w3triamd.F90 index f4f6f9133..9fac503b6 100644 --- a/model/src/w3triamd.F90 +++ b/model/src/w3triamd.F90 @@ -964,14 +964,14 @@ SUBROUTINE SPATIAL_GRID I2 = TRIGP(2,K) I3 = TRIGP(3,K) +!AR: todo call this only for global grid CALL FIX_PERIODCITY(I1,I2,I3,XGRD,YGRD,PT) ! ! cross product of edge-vector (orientated anticlockwise) ! - - TRIA(K) = REAL( (PT(2,2)-PT(1,2)) & ! (Y2-Y1) - *(PT(1,1)-PT(3,1)) & ! *(X1-X3) - +(PT(3,2)-PT(1,2)) & ! (Y3-Y1)*(X2-X1) + TRIA(K) = REAL( (PT(2,2)-PT(1,2)) & + *(PT(1,1)-PT(3,1)) & + +(PT(3,2)-PT(1,2)) & *(PT(2,1)-PT(1,1)) )*0.5 ! ! test on negative triangle area, which means that the orientiation is not as assumed to be anticw. @@ -984,9 +984,6 @@ SUBROUTINE SPATIAL_GRID I2 = TRIGP(2,K) I3 = TRIGP(3,K) TRIA(K) = -1.d0*TRIA(K) - !WRITE(NDSE,*) 'WRONG TRIANGLE',TRIA(K),K,I1,I2,I3, XYB(I2,2)-XYB(I1,2), & - ! XYB(I1,1)-XYB(I3,1),XYB(I3,2)-XYB(I1,2), XYB(I2,1)-XYB(I1,1) - !STOP END IF END DO END SUBROUTINE SPATIAL_GRID @@ -1413,8 +1410,6 @@ SUBROUTINE AREA_SI(IMOD) CALL STRACE (IENT, 'AREA_SI') #endif - WRITE(*,'("+TRACE......",A)') 'COMPUTE SI, TRIA und CCON' - SI(:) = 0.D0 ! CCON(:) = 0 ! Number of connected Elements @@ -1434,8 +1429,6 @@ SUBROUTINE AREA_SI(IMOD) CELLVERTEX(:,:,:) = 0 ! Stores for each node the Elementnumbers of the connected Elements ! and the Position of the Node in the Element Index - WRITE(*,'("+TRACE......",A)') 'COMPUTE CELLVERTEX' - CHILF = 0 DO IE = 1, NTRI @@ -1446,8 +1439,6 @@ SUBROUTINE AREA_SI(IMOD) CELLVERTEX(I,CHILF(I),2) = J END DO ENDDO - - WRITE(*,'("+TRACE......",A)') 'COMPUTE IE_CELL and POS_CELL' ! ! Second step in storage, the initial 3D array CELLVERTEX, is transformed in a 1D array ! the global index is J . From now, all the computation step based on these arrays must @@ -2805,120 +2796,7 @@ SUBROUTINE TRIANG_INDEXES(I, INEXT, IPREV) END SUBROUTINE TRIANG_INDEXES !/ ------------------------------------------------------------------- / - - !> - !> @brief Get interface nodes of the wetting and drying part. - !> - !> @author Aron Roland - !> @author Mathieu Dutour-Sikiric - !> @date 01-Jun-2018 - !> - SUBROUTINE GET_INTERFACE() - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | | - !/ | Aron Roland (BGS IT&E GmbH) | - !/ | Mathieu Dutour-Sikiric (IRB) | - !/ | | - !/ | FORTRAN 90 | - !/ | Last update : 01-June-2018 | - !/ +-----------------------------------+ - !/ - !/ 01-June-2018 : Origination. ( version 6.04 ) - !/ - ! 1. Purpose : get interface nodes of the wetting and drying part - ! 2. Method : - ! 3. Parameters : - ! - ! Parameter list - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 4. Subroutines used : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! STRACE Subr. W3SERVMD Subroutine tracing. - ! ---------------------------------------------------------------- - ! - ! 5. Called by : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 6. Error messages : - ! 7. Remarks - ! 8. Structure : - ! 9. Switches : - ! - ! !/S Enable subroutine tracing. - ! - ! 10. Source code : - ! - !/ ------------------------------------------------------------------- / -#ifdef W3_S - USE W3SERVMD, ONLY: STRACE -#endif - ! - USE CONSTANTS, ONLY : LPDLIB - USE W3GDATMD, ONLY : NX, IOBP, CCON, NSEAL, IOBDP, IE_CELL, IOBDP, TRIGP -#ifdef W3_PDLIB - USE yowNodepool, only: PDLIB_SI, PDLIB_IEN, PDLIB_CCON, NPA, PDLIB_IE_CELL2, PDLIB_POS_CELL2 - USE yowElementpool, only: INE -#endif - IMPLICIT NONE - !/ - !/ ------------------------------------------------------------------- / - !/ Parameter list - !/ - !/ ------------------------------------------------------------------- / - !/ Local PARAMETERs - !/ -#ifdef W3_S - INTEGER, SAVE :: IENT = 0 -#endif - !/ - !/ ------------------------------------------------------------------- / - !/ - INTEGER :: I, J, IP, IE -#ifdef W3_S - CALL STRACE (IENT, 'GET_INTERFACE') -#endif -#ifdef W3_PDLIB - IF (LPDLIB) THEN - DO IP = 1, NSEAL - IF (IOBP(IP) .NE. 0 .OR. IOBDP(IP) .EQ. 0) CYCLE - DO I = 1, PDLIB_CCON(IP) - IE = PDLIB_IE_CELL2(I,IP) - IF (ANY(IOBDP(TRIGP(:,IE)) .EQ. 0)) THEN - IOBDP(IP) = -1 - CYCLE - ENDIF - ENDDO - ENDDO - !CALL EXCHANGE_.... - ELSE -#endif - J = 0 - DO IP = 1, NSEAL - DO I = 1, CCON(IP) - J = J + 1 - IE = IE_CELL(J) - IF (ANY(IOBDP(TRIGP(:,IE)) .EQ. 0)) THEN - IOBDP(IP) = -1 ! Set this node as a wet node adjacent to a dry one ... now what's next? Here on this points we want to compute the reflection source term, yes? - EXIT - ENDIF - ENDDO - ENDDO -#ifdef W3_PDLIB - ENDIF -#endif - - END SUBROUTINE GET_INTERFACE - !/ ------------------------------------------------------------------- / - + !> !> @brief Redefines the values of the boundary points and angle pointers !> based on the MAPSTA array. diff --git a/model/src/w3updtmd.F90 b/model/src/w3updtmd.F90 index 05b0b62d9..4e517d50a 100644 --- a/model/src/w3updtmd.F90 +++ b/model/src/w3updtmd.F90 @@ -2099,15 +2099,15 @@ SUBROUTINE W3ULEV ( A, VA ) ZB, DMIN, NK, NTH, NSPEC, SIG, DSIP, & MAPWN, MAPTH, FACHFA, GTYPE, UNGTYPE, W3SETREF USE W3WDATMD, ONLY: TIME, TLEV, WLV, UST - USE W3ADATMD, ONLY: CG, WN, DW + USE W3ADATMD, ONLY: CG, WN, DW, HS USE W3IDATMD, ONLY: TLN, WLEV USE W3SERVMD, ONLY: EXTCDE USE W3DISPMD, ONLY: WAVNU1 USE W3TIMEMD USE W3PARALL, only : INIT_GET_JSEA_ISPROC, INIT_GET_ISEA USE W3PARALL, only : GET_JSEA_IBELONG - USE W3DISPMD, ONLY: WAVNU1 #ifdef W3_PDLIB + USE W3DISPMD, ONLY: WAVNU3 USE PDLIB_W3PROFSMD, ONLY : SET_IOBDP_PDLIB #endif #ifdef W3_TIDE @@ -2264,9 +2264,10 @@ SUBROUTINE W3ULEV ( A, VA ) WLVeff = WLV(ISEA) #ifdef W3_SETUP - IF (DO_CHANGE_WLV) THEN - WLVeff=WLVeff + ZETA_SETUP(ISEA) - END IF + IF (DO_CHANGE_WLV) THEN + WLVeff = WLVeff + ZETA_SETUP(ISEA) + WLV(ISEA) = WLVeff + END IF #endif #ifdef W3_TIDE ENDIF @@ -2300,9 +2301,12 @@ SUBROUTINE W3ULEV ( A, VA ) WNO(IK) = WN(IK,ISEA) CGO(IK) = CG(IK,ISEA) ! - ! Calculate wavenumbers and group velocities. - CALL WAVNU1(SIG(IK),DEPTH,WN(IK,ISEA),CG(IK,ISEA)) - ! + ! Calculate wavenumbers and group velocities. +#ifdef W3_PDLIB + CALL WAVNU3(SIG(IK),DEPTH,WN(IK,ISEA),CG(IK,ISEA)) +#else + CALL WAVNU1(SIG(IK),DEPTH,WN(IK,ISEA),CG(IK,ISEA)) +#endif END DO ! DO IK=1, NK @@ -2497,7 +2501,6 @@ SUBROUTINE W3ULEV ( A, VA ) ! 4. Re-generates the boundary data ---------------------------------- * ! IF (GTYPE.EQ.UNGTYPE) THEN - !CALL SET_UG_IOBP #ifdef W3_PDLIB CALL SET_IOBDP_PDLIB #endif diff --git a/model/src/w3wavemd.F90 b/model/src/w3wavemd.F90 index f13c8e234..fb29f9152 100644 --- a/model/src/w3wavemd.F90 +++ b/model/src/w3wavemd.F90 @@ -896,20 +896,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #ifdef W3_TIMINGS CALL PRINT_MY_TIME("First entry in the TIME LOOP") #endif - ! DO JSEA = 1, NSEAL - ! DO IS = 1, NSPEC - ! IF (VA(IS, JSEA) .LT. 0.) THEN - ! WRITE(740+IAPROC,*) 'TEST W3WAVE 2', VA(IS,JSEA) - ! CALL FLUSH(740+IAPROC) - ! ENDIF - ! ENDDO - ! ENDDO - ! IF (SUM(VA) .NE. SUM(VA)) THEN - ! WRITE(740+IAPROC,*) 'NAN in ACTION 2', IX, IY, SUM(VA) - ! CALL FLUSH(740+IAPROC) - ! STOP - ! ENDIF - #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "W3WAVEMD, step 6.1", 1) @@ -1169,19 +1155,21 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & USTDIR = 0.05 END IF - ! DO JSEA = 1, NSEAL - ! DO IS = 1, NSPEC - ! IF (VA(IS, JSEA) .LT. 0.) THEN - ! WRITE(740+IAPROC,*) 'TEST W3WAVE 5', VA(IS,JSEA) - ! CALL FLUSH(740+IAPROC) - ! ENDIF - ! ENDDO - ! ENDDO - ! IF (SUM(VA) .NE. SUM(VA)) THEN - ! WRITE(740+IAPROC,*) 'NAN in ACTION 5', IX, IY, SUM(VA) - ! CALL FLUSH(740+IAPROC) - ! STOP - ! ENDIF +#ifdef W3_DEBUGRUN + DO JSEA = 1, NSEAL + DO IS = 1, NSPEC + IF (VA(IS, JSEA) .LT. 0.) THEN + WRITE(740+IAPROC,*) 'TEST W3WAVE 5', VA(IS,JSEA) + CALL FLUSH(740+IAPROC) + ENDIF + ENDDO + ENDDO + IF (SUM(VA) .NE. SUM(VA)) THEN + WRITE(740+IAPROC,*) 'NAN in ACTION 5', IX, IY, SUM(VA) + CALL FLUSH(740+IAPROC) + STOP + ENDIF +#endif call print_memcheck(memunit, 'memcheck_____:'//' WW3_WAVE TIME LOOP 6') #ifdef W3_TIMINGS @@ -1465,7 +1453,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & call print_memcheck(memunit, 'memcheck_____:'//' WW3_WAVE TIME LOOP 13') ! #ifdef W3_PDLIB - IF ( FLSOU .and. LPDLIB .and. FSSOURCE) THEN + IF (LPDLIB .and. FLSOU .and. FSSOURCE) THEN #endif #ifdef W3_OMP0 @@ -1480,31 +1468,28 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #endif #ifdef W3_PDLIB - IF (.not. LSLOC) THEN - VSTOT = 0. - VDTOT = 0. - ENDIF IF (LSLOC) THEN B_JAC = 0. ASPAR_JAC = 0. + ELSE + VSTOT = 0. + VDTOT = 0. ENDIF #endif #ifdef W3_PDLIB + DO JSEA = 1, NP -#endif -#ifdef W3_PDLIB CALL INIT_GET_ISEA(ISEA, JSEA) -#endif -#ifdef W3_PDLIB IX = MAPSF(ISEA,1) IY = MAPSF(ISEA,2) DELA=1. DELX=1. DELY=1. + #ifdef W3_REF1 IF (GTYPE.EQ.RLGTYPE) THEN DELX=SX*CLATS(ISEA)/FACX @@ -1517,25 +1502,16 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & DELY=HQFAC(IY,IX)/ FACX DELA=DELX*DELY END IF -#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_PDLIB - IF ((IOBP_LOC(JSEA) .eq. 1 .or. IOBP_LOC(JSEA) .eq. 3) & - & .and. IOBDP_LOC(JSEA) .eq. 1 .and. IOBPA_LOC(JSEA) .eq. 0) THEN -#endif - - -#ifdef W3_PDLIB #ifdef W3_DEBUGSRC IF (IX .eq. DEBUG_NODE) THEN WRITE(740+IAPROC,*) 'NODE_SRCE_IMP_PRE : IX=', IX, ' JSEA=', JSEA @@ -1580,13 +1556,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & WRITE(740+IAPROC,*) ' SHAVETOT=', SHAVETOT(JSEA) FLUSH(740+IAPROC) #endif -#endif - ELSE - UST (ISEA) = UNDEF - USTDIR(ISEA) = UNDEF - DTDYN (JSEA) = UNDEF - FCUT (JSEA) = UNDEF - END IF END DO ! JSEA END IF ! PDLIB #endif @@ -1821,6 +1790,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! END DO END IF + call print_memcheck(memunit, 'memcheck_____:'//' WW3_WAVE TIME LOOP 16') #ifdef W3_DEBUGCOH @@ -1840,17 +1810,16 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & FACX = 1. END IF END IF + IF (LPDLIB) THEN ! #ifdef W3_PDLIB - IF ((FSTOTALIMP .eqv. .FALSE.).and.(FLCX .or. FLCY)) THEN -#endif -#ifdef W3_PDLIB - DO ISPEC=1,NSPEC - CALL PDLIB_W3XYPUG ( ISPEC, FACX, FACX, DTG, VGX, VGY, UGDTUPDATE ) - END DO -#endif -#ifdef W3_PDLIB + IF (FLCX .or. FLCY) THEN + IF (.NOT. FSTOTALIMP .AND. .NOT. FSTOTALEXP) THEN + DO ISPEC=1,NSPEC + CALL PDLIB_W3XYPUG ( ISPEC, FACX, FACX, DTG, VGX, VGY, UGDTUPDATE ) + END DO + END IF END IF #endif ! @@ -1861,13 +1830,13 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & CALL ALL_VA_INTEGRAL_PRINT(IMOD, "Before Block implicit", 1) #endif #ifdef W3_PDLIB - CALL PDLIB_W3XYPUG_BLOCK_IMPLICIT(IMOD, FACX, FACX, DTG, VGX, VGY) + CALL PDLIB_W3XYPUG_BLOCK_IMPLICIT(IMOD, FACX, FACX, DTG, VGX, VGY, UGDTUPDATE ) #endif #ifdef W3_PDLIB ELSE IF(FSTOTALEXP .and. (IT .ne. 0)) THEN #endif #ifdef W3_PDLIB - CALL PDLIB_W3XYPUG_BLOCK_EXPLICIT(IMOD, FACX, FACX, DTG, VGX, VGY) + CALL PDLIB_W3XYPUG_BLOCK_EXPLICIT(IMOD, FACX, FACX, DTG, VGX, VGY, UGDTUPDATE ) #endif #ifdef W3_PDLIB ENDIF @@ -2150,6 +2119,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #ifdef W3_TIMINGS CALL PRINT_MY_TIME("fter intraspectral adv.") #endif + ! UGDTUPDATE = .FALSE. ! @@ -2184,6 +2154,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & !$OMP& REFLEC,REFLED,D50,PSIC,TMP1,TMP2,TMP3,TMP4) !$OMP DO SCHEDULE (DYNAMIC,1) #endif + ! DO JSEA=1, NSEAL CALL INIT_GET_ISEA(ISEA, JSEA) @@ -2290,7 +2261,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & END IF END DO - ! #ifdef W3_OMPG !$OMP END DO @@ -2325,6 +2295,9 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & IF (IT.GT.0) DTG=DTGTEMP #endif + + + ! ! ! 3.8 Update global time step. diff --git a/model/src/w3wavset.F90 b/model/src/w3wavset.F90 index 4c46b95e1..2f77e8938 100644 --- a/model/src/w3wavset.F90 +++ b/model/src/w3wavset.F90 @@ -15,314 +15,181 @@ !> @author Mathieu Dutour-Sikiric !> @date 1-Jun-2018 !> -MODULE W3WAVSET - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | | - !/ | Aron Roland (BGS IT&E GmbH) | - !/ | Mathieu Dutour-Sikiric (IRB) | - !/ | | - !/ | FORTRAN 95 | - !/ | Last update : 1-June-2018 | - !/ +-----------------------------------+ - !/ - !/ 01-June-2016 : Origination ( version 6.04 ) - !/ - ! 1. Purpose : Implicit solution of wave setup problem following - ! Dingemans for structured and unstructured grids - ! - ! 2. Method : To be described - ! - ! 3. Parameters : - ! - ! Parameter list - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 4. Subroutines used : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! STRACE Subr. W3SERVMD Subroutine tracing. - ! ---------------------------------------------------------------- - ! - ! 5. Called by : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 6. Error messages : - ! 7. Remarks - ! 8. Structure : - ! 9. Switches : - ! - ! !/S Enable subroutine tracing. - ! - ! 10. Source code : - ! - !/ ------------------------------------------------------------------- / -#ifdef W3_S - USE W3SERVMD, ONLY: STRACE -#endif - !/ - !/ ------------------------------------------------------------------- / - !/ Parameter list - !/ - !/ ------------------------------------------------------------------- / - !/ Local PARAMETERs - !/ -#ifdef W3_S - INTEGER, SAVE :: IENT = 0 -#endif - !/ - IMPLICIT NONE - !/ - !/ ------------------------------------------------------------------- / - !/ Parameter list - !/ - !/ ------------------------------------------------------------------- / - !/ Local PARAMETERs - !/ -#ifdef W3_S - INTEGER, SAVE :: IENT = 0 -#endif - !/ - !/ ------------------------------------------------------------------- / - !/ -#ifdef W3_S - CALL STRACE (IENT, 'VA_SETUP_IOBPD') -#endif - ! - - LOGICAL :: DO_WAVE_SETUP = .TRUE. -CONTAINS - !/ ------------------------------------------------------------------- / - !> - !> @brief Differentiate xy, using linear shape function. - !> - !> @param[in] VAR - !> @param[out] DVDX - !> @param[out] DVDY - !> - !> @author Aron Roland - !> @author Mathieu Dutour-Sikiric - !> @date 1-May-2018 - !> - SUBROUTINE DIFFERENTIATE_XYDIR_NATIVE(VAR, DVDX, DVDY) - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | | - !/ | Aron Roland (BGS IT&E GmbH) | - !/ | Mathieu Dutour-Sikiric (IRB) | - !/ | | - !/ | FORTRAN 90 | - !/ | Last update : 01-Mai-2018 | - !/ +-----------------------------------+ - !/ - !/ 01-Mai-2018 : Origination. ( version 6.04 ) - !/ - ! 1. Purpose : differentiate xy - ! 2. Method : linear shape function - ! 3. Parameters : - ! - ! Parameter list - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 4. Subroutines used : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! STRACE Subr. W3SERVMD Subroutine tracing. - ! ---------------------------------------------------------------- - ! - ! 5. Called by : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 6. Error messages : - ! 7. Remarks - ! 8. Structure : - ! 9. Switches : - ! - ! !/S Enable subroutine tracing. - ! - ! 10. Source code : - ! - !/ ------------------------------------------------------------------- / -#ifdef W3_S - USE W3SERVMD, ONLY: STRACE -#endif - ! - use yowExchangeModule, only : PDLIB_exchange1Dreal - use yowNodepool, only : PDLIB_IEN, PDLIB_TRIA, npa - use yowElementpool, only : INE, NE - USE W3GDATMD, ONLY : MAPSTA - IMPLICIT NONE - !/ - !/ ------------------------------------------------------------------- / - !/ Parameter list - !/ - !/ ------------------------------------------------------------------- / - !/ Local PARAMETERs - !/ -#ifdef W3_S - INTEGER, SAVE :: IENT = 0 -#endif - !/ - !/ ------------------------------------------------------------------- / - !/ -#ifdef W3_S - CALL STRACE (IENT, 'VA_SETUP_IOBPD') -#endif - ! - REAL(8), INTENT(IN) :: VAR(npa) - REAL(8), INTENT(OUT) :: DVDX(npa), DVDY(npa) - INTEGER :: NI(3) - INTEGER :: IE, I1, I2, I3, IP - REAL(8) :: DEDY(3),DEDX(3) - REAL(8) :: DVDXIE, DVDYIE - REAL(8) :: WEI(npa), eW - INTEGER :: IX - WEI = 0.0 - DVDX = 0.0 - DVDY = 0.0 - - DO IE = 1, NE - NI = INE(:,IE) - I1 = INE(1,IE) - I2 = INE(2,IE) - I3 = INE(3,IE) - WEI(NI) = WEI(NI) + 2.*PDLIB_TRIA(IE) - DEDX(1) = PDLIB_IEN(1,IE) - DEDX(2) = PDLIB_IEN(3,IE) - DEDX(3) = PDLIB_IEN(5,IE) - DEDY(1) = PDLIB_IEN(2,IE) - DEDY(2) = PDLIB_IEN(4,IE) - DEDY(3) = PDLIB_IEN(6,IE) - DVDXIE = DOT_PRODUCT( VAR(NI),DEDX) - DVDYIE = DOT_PRODUCT( VAR(NI),DEDY) - DVDX(NI) = DVDX(NI) + DVDXIE - DVDY(NI) = DVDY(NI) + DVDYIE - END DO - DO IX=1,npa - eW=WEI(IX) - DVDX(IX)=DVDX(IX) / eW - DVDY(IX)=DVDY(IX) / eW - END DO - CALL PDLIB_exchange1Dreal(DVDX) - CALL PDLIB_exchange1Dreal(DVDY) - END SUBROUTINE DIFFERENTIATE_XYDIR_NATIVE - !/ ------------------------------------------------------------------- / - !> - !> @brief Differentiate xy based on mapsta, using linear shape function. - !> - !> @param[in] VAR - !> @param[out] DVDX - !> @param[out] DVDY - !> - !> @author Aron Roland - !> @author Mathieu Dutour-Sikiric - !> @date 1-May-2018 - !> - SUBROUTINE DIFFERENTIATE_XYDIR_MAPSTA(VAR, DVDX, DVDY) - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | | - !/ | Aron Roland (BGS IT&E GmbH) | - !/ | Mathieu Dutour-Sikiric (IRB) | - !/ | | - !/ | FORTRAN 90 | - !/ | Last update : 01-Mai-2018 | - !/ +-----------------------------------+ - !/ - !/ 01-Mai-2018 : Origination. ( version 6.04 ) - !/ - ! 1. Purpose : differentiate xy based on mapsta - ! 2. Method : linear shape function - ! 3. Parameters : - ! - ! Parameter list - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 4. Subroutines used : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! STRACE Subr. W3SERVMD Subroutine tracing. - ! ---------------------------------------------------------------- - ! - ! 5. Called by : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 6. Error messages : - ! 7. Remarks - ! 8. Structure : - ! 9. Switches : - ! - ! !/S Enable subroutine tracing. - ! - ! 10. Source code : - ! - !/ ------------------------------------------------------------------- / -#ifdef W3_S - USE W3SERVMD, ONLY: STRACE -#endif - ! - use yowExchangeModule, only : PDLIB_exchange1Dreal - use yowNodepool, only : PDLIB_IEN, PDLIB_TRIA, npa, iplg - use yowElementpool, only : INE, NE - USE W3GDATMD, ONLY : MAPSTA - USE W3PARALL, only: INIT_GET_ISEA - IMPLICIT NONE - !/ - !/ ------------------------------------------------------------------- / - !/ Parameter list - !/ - !/ ------------------------------------------------------------------- / - !/ Local PARAMETERs - !/ -#ifdef W3_S - INTEGER, SAVE :: IENT = 0 -#endif - !/ - !/ ------------------------------------------------------------------- / - !/ -#ifdef W3_S - CALL STRACE (IENT, 'VA_SETUP_IOBPD') -#endif - ! + MODULE W3WAVSET +!/ +-----------------------------------+ +!/ | WAVEWATCH III NOAA/NCEP | +!/ | | +!/ | Aron Roland (BGS IT&E GmbH) | +!/ | Mathieu Dutour-Sikiric (IRB) | +!/ | | +!/ | FORTRAN 95 | +!/ | Last update : 1-June-2018 | +!/ +-----------------------------------+ +!/ +!/ 01-June-2016 : Origination ( version 6.04 ) +!/ +! 1. Purpose : Implicit solution of wave setup problem following +! Dingemans for structured and unstructured grids +! +! 2. Method : To be described +! +! 3. Parameters : +! +! Parameter list +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 4. Subroutines used : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! STRACE Subr. W3SERVMD Subroutine tracing. +! ---------------------------------------------------------------- +! +! 5. Called by : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 6. Error messages : +! 7. Remarks +! 8. Structure : +! 9. Switches : +! +! !/S Enable subroutine tracing. +! +! 10. Source code : +! +!/ ------------------------------------------------------------------- / +#ifdef W3_S + USE W3SERVMD, ONLY: STRACE +#endif + use yowDatapool, only: rkind +!/ +!/ ------------------------------------------------------------------- / +!/ Parameter list +!/ +!/ ------------------------------------------------------------------- / +!/ Local PARAMETERs +!/ + IMPLICIT NONE +!/ +!/ ------------------------------------------------------------------- / +!/ Parameter list +!/ +!/ ------------------------------------------------------------------- / +!/ Local PARAMETERs +!/ +#ifdef W3_S + INTEGER, SAVE :: IENT = 0 +#endif +!/ +!/ ------------------------------------------------------------------- / +!/ - REAL(8), INTENT(IN) :: VAR(npa) - REAL(8), INTENT(OUT) :: DVDX(npa), DVDY(npa) - INTEGER :: NI(3) - INTEGER :: IE, I1, I2, I3, IP, IX - REAL(8) :: DEDY(3),DEDX(3) - REAL(8) :: DVDXIE, DVDYIE - REAL(8) :: WEI(npa), eW - INTEGER :: IX1, IX2, IX3, ISEA - WEI = 0.0 - DVDX = 0.0 - DVDY = 0.0 + LOGICAL :: DO_WAVE_SETUP = .TRUE. + CONTAINS +!/ ------------------------------------------------------------------- / +!> +!> @brief Differentiate xy, using linear shape function. +!> +!> @param[in] VAR +!> @param[out] DVDX +!> @param[out] DVDY +!> +!> @author Aron Roland +!> @author Mathieu Dutour-Sikiric +!> @date 1-May-2018 +!> + SUBROUTINE DIFFERENTIATE_XYDIR_NATIVE(VAR, DVDX, DVDY) +!/ +!/ +-----------------------------------+ +!/ | WAVEWATCH III NOAA/NCEP | +!/ | | +!/ | Aron Roland (BGS IT&E GmbH) | +!/ | Mathieu Dutour-Sikiric (IRB) | +!/ | | +!/ | FORTRAN 90 | +!/ | Last update : 01-Mai-2018 | +!/ +-----------------------------------+ +!/ +!/ 01-Mai-2018 : Origination. ( version 6.04 ) +!/ +! 1. Purpose : differentiate xy +! 2. Method : linear shape function +! 3. Parameters : +! +! Parameter list +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 4. Subroutines used : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! STRACE Subr. W3SERVMD Subroutine tracing. +! ---------------------------------------------------------------- +! +! 5. Called by : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 6. Error messages : +! 7. Remarks +! 8. Structure : +! 9. Switches : +! +! !/S Enable subroutine tracing. +! +! 10. Source code : +! +!/ ------------------------------------------------------------------- / +#ifdef W3_S + USE W3SERVMD, ONLY: STRACE +#endif +! + use yowExchangeModule, only : PDLIB_exchange1Dreal + use yowNodepool, only : PDLIB_IEN, PDLIB_TRIA, npa + use yowElementpool, only : INE, NE + USE W3GDATMD, ONLY : MAPSTA + IMPLICIT NONE +!/ +!/ ------------------------------------------------------------------- / +!/ Parameter list +!/ +!/ ------------------------------------------------------------------- / +!/ Local PARAMETERs +!/ +#ifdef W3_S + INTEGER, SAVE :: IENT = 0 +#endif +!/ +!/ ------------------------------------------------------------------- / +!/ +! + REAL(rkind), INTENT(IN) :: VAR(npa) + REAL(rkind), INTENT(OUT) :: DVDX(npa), DVDY(npa) + INTEGER :: NI(3) + INTEGER :: IE, I1, I2, I3, IP + REAL(rkind) :: DEDY(3),DEDX(3) + REAL(rkind) :: DVDXIE, DVDYIE + REAL(rkind) :: WEI(npa), eW + INTEGER :: IX +#ifdef W3_S + CALL STRACE (IENT, 'VA_SETUP_IOBPD') +#endif + WEI = 0.0 + DVDX = 0.0 + DVDY = 0.0 - DO IE = 1, NE - NI = INE(:,IE) - I1 = INE(1,IE) - I2 = INE(2,IE) - I3 = INE(3,IE) - IX1=iplg(I1) - IX2=iplg(I2) - IX3=iplg(I3) - IF ((MAPSTA(1,IX1) .gt. 0).and.(MAPSTA(1,IX2) .gt. 0).and.(MAPSTA(1,IX3) .gt. 0)) THEN + DO IE = 1, NE + NI = INE(:,IE) + I1 = INE(1,IE) + I2 = INE(2,IE) + I3 = INE(3,IE) WEI(NI) = WEI(NI) + 2.*PDLIB_TRIA(IE) DEDX(1) = PDLIB_IEN(1,IE) DEDX(2) = PDLIB_IEN(3,IE) @@ -334,2864 +201,2970 @@ SUBROUTINE DIFFERENTIATE_XYDIR_MAPSTA(VAR, DVDX, DVDY) DVDYIE = DOT_PRODUCT( VAR(NI),DEDY) DVDX(NI) = DVDX(NI) + DVDXIE DVDY(NI) = DVDY(NI) + DVDYIE - END IF - END DO - DO IP=1,npa - IX=iplg(IP) - eW=WEI(IP) - IF (eW .gt. 0 .and. MAPSTA(1,IX) .gt. 0) THEN - DVDX(IP)=DVDX(IP) / eW - DVDY(IP)=DVDY(IP) / eW - ELSE - DVDX(IP)=0. - DVDY(IP)=0. - ENDIF - END DO - DO IP=1,npa - IX=iplg(IP) - IF (MAPSTA(1,IX) .lt. 0) THEN - DVDX(IP)=0. - DVDY(IP)=0. - END IF - END DO - CALL PDLIB_exchange1Dreal(DVDX) - CALL PDLIB_exchange1Dreal(DVDY) - END SUBROUTINE DIFFERENTIATE_XYDIR_MAPSTA - !/ ------------------------------------------------------------------- / - !> - !> @brief Driver routine for xydir. - !> - !> @param[in] VAR - !> @param[out] DVDX - !> @param[out] DVDY - !> - !> @author Mathieu Dutour-Sikiric - !> @author Aron Roland - !> @date 1-May-2018 - !> - SUBROUTINE DIFFERENTIATE_XYDIR(VAR, DVDX, DVDY) - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | | - !/ | Mathieu Dutour-Sikiric (IRB) | - !/ | Aron Roland (BGS IT&E GmbH) | - !/ | FORTRAN 90 | - !/ | Last update : 01-Mai-2018 | - !/ +-----------------------------------+ - !/ - !/ 01-Mai-2018 : Origination. ( version 6.04 ) - !/ - ! 1. Purpose : Driver routine for xydir - ! 2. Method : - ! 3. Parameters : - ! - ! Parameter list - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 4. Subroutines used : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! STRACE Subr. W3SERVMD Subroutine tracing. - ! ---------------------------------------------------------------- - ! - ! 5. Called by : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 6. Error messages : - ! 7. Remarks - ! 8. Structure : - ! 9. Switches : - ! - ! !/S Enable subroutine tracing. - ! - ! 10. Source code : - ! - !/ ------------------------------------------------------------------- / -#ifdef W3_S - USE W3SERVMD, ONLY: STRACE -#endif - ! - use yowNodepool, only: npa - IMPLICIT NONE - !/ - !/ ------------------------------------------------------------------- / - !/ Parameter list - !/ - !/ ------------------------------------------------------------------- / - !/ Local PARAMETERs - !/ -#ifdef W3_S - INTEGER, SAVE :: IENT = 0 -#endif - !/ - !/ ------------------------------------------------------------------- / - !/ -#ifdef W3_S - CALL STRACE (IENT, 'VA_SETUP_IOBPD') -#endif - ! - - REAL(8), INTENT(IN) :: VAR(npa) - REAL(8), INTENT(OUT) :: DVDX(npa), DVDY(npa) - CALL DIFFERENTIATE_XYDIR_MAPSTA(VAR, DVDX, DVDY) - ! CALL DIFFERENTIATE_XYDIR_NATIVE(VAR, DVDX, DVDY) - END SUBROUTINE DIFFERENTIATE_XYDIR - !/ ------------------------------------------------------------------- / - !> - !> @brief Setup boundary pointer. - !> - !> @param[out] F_X - !> @param[out] F_Y - !> @param[out] DWNX - !> - !> @author Aron Roland - !> @author Mathieu Dutour-Sikiric - !> @date 1-May-2018 - !> - SUBROUTINE TRIG_COMPUTE_LH_STRESS(F_X, F_Y, DWNX) - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | | - !/ | Aron Roland (BGS IT&E GmbH) | - !/ | Mathieu Dutour-Sikiric (IRB) | - !/ | | - !/ | FORTRAN 90 | - !/ | Last update : 01-Mai-2018 | - !/ +-----------------------------------+ - !/ - !/ 01-Mai-2018 : Origination. ( version 6.04 ) - !/ - ! 1. Purpose : Setup boundary pointer - ! 2. Method : - ! 3. Parameters : - ! - ! Parameter list - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 4. Subroutines used : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! STRACE Subr. W3SERVMD Subroutine tracing. - ! ---------------------------------------------------------------- - ! - ! 5. Called by : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 6. Error messages : - ! 7. Remarks - ! 8. Structure : - ! 9. Switches : - ! - ! !/S Enable subroutine tracing. - ! - ! 10. Source code : - ! - !/ ------------------------------------------------------------------- / -#ifdef W3_S - USE W3SERVMD, ONLY: STRACE -#endif - ! - USE CONSTANTS, ONLY: GRAV, DWAT - use yowNodepool, only: npa, iplg - USE W3GDATMD, only : MAPFS - USE W3ADATMD, ONLY: SXX, SXY, SYY, WN, CG - USE W3PARALL, only: INIT_GET_ISEA - USE W3ODATMD, only : IAPROC - USE W3GDATMD, ONLY : NSEAL, MAPSTA - USE W3ADATMD, ONLY: DW - IMPLICIT NONE - !/ - !/ ------------------------------------------------------------------- / - !/ Parameter list - !/ - !/ ------------------------------------------------------------------- / - !/ Local PARAMETERs - !/ -#ifdef W3_S - INTEGER, SAVE :: IENT = 0 -#endif - !/ - !/ ------------------------------------------------------------------- / - !/ -#ifdef W3_S - CALL STRACE (IENT, 'VA_SETUP_IOBPD') -#endif - ! - real(8), intent(out) :: F_X(npa), F_Y(npa), DWNX(npa) - REAL(8) :: h - REAL(8) :: SXX_X, SXX_Y - REAL(8) :: SXY_X, SXY_Y - REAL(8) :: SYY_X, SYY_Y - INTEGER I, IP, IX - INTEGER JSEA, ISEA - real(8) :: U_X1(npa), U_Y1(npa) - real(8) :: U_X2(npa), U_Y2(npa) - real(8) :: SXX_p(npa), SXY_p(npa), SYY_p(npa) - real(8) :: eSXX, eSXY, eSYY - integer :: SXXmethod = 1 - SXX_p=0 - SXY_p=0 - SYY_p=0 - DWNX=0 - DO JSEA=1,NSEAL - IP = JSEA ! We remove the Z_status because now NX = NSEA - IX=iplg(IP) - ISEA=MAPFS(1,IX) - IF (SXXmethod .eq. 1) THEN - eSXX=SXX(JSEA)/(DWAT*GRAV) - eSXY=SXY(JSEA)/(DWAT*GRAV) - eSYY=SYY(JSEA)/(DWAT*GRAV) - END IF - SXX_p(IP)=DBLE(eSXX) - SXY_p(IP)=DBLE(eSXY) - SYY_p(IP)=DBLE(eSYY) - DWNX(IP)=DW(ISEA) - END DO - ! -#ifdef W3_DEBUGSTP - WRITE(740+IAPROC,*) 'min/max(DEP)=', minval(DWNX), maxval(DWNX) + END DO + DO IX=1,npa + eW=WEI(IX) + DVDX(IX)=DVDX(IX) / eW + DVDY(IX)=DVDY(IX) / eW + END DO + CALL PDLIB_exchange1Dreal(DVDX) + CALL PDLIB_exchange1Dreal(DVDY) + END SUBROUTINE +!/ ------------------------------------------------------------------- / +!> +!> @brief Differentiate xy based on mapsta, using linear shape function. +!> +!> @param[in] VAR +!> @param[out] DVDX +!> @param[out] DVDY +!> +!> @author Aron Roland +!> @author Mathieu Dutour-Sikiric +!> @date 1-May-2018 +!> + SUBROUTINE DIFFERENTIATE_XYDIR_MAPSTA(VAR, DVDX, DVDY) +!/ +!/ +-----------------------------------+ +!/ | WAVEWATCH III NOAA/NCEP | +!/ | | +!/ | Aron Roland (BGS IT&E GmbH) | +!/ | Mathieu Dutour-Sikiric (IRB) | +!/ | | +!/ | FORTRAN 90 | +!/ | Last update : 01-Mai-2018 | +!/ +-----------------------------------+ +!/ +!/ 01-Mai-2018 : Origination. ( version 6.04 ) +!/ +! 1. Purpose : differentiate xy based on mapsta +! 2. Method : linear shape function +! 3. Parameters : +! +! Parameter list +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 4. Subroutines used : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! STRACE Subr. W3SERVMD Subroutine tracing. +! ---------------------------------------------------------------- +! +! 5. Called by : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 6. Error messages : +! 7. Remarks +! 8. Structure : +! 9. Switches : +! +! !/S Enable subroutine tracing. +! +! 10. Source code : +! +!/ ------------------------------------------------------------------- / +#ifdef W3_S + USE W3SERVMD, ONLY: STRACE #endif - -#ifdef W3_DEBUGSTP - WRITE(740+IAPROC,*) 'sum(abs(SXX))=', sum(abs(SXX_p)) - WRITE(740+IAPROC,*) 'sum(abs(SXY))=', sum(abs(SXY_p)) - WRITE(740+IAPROC,*) 'sum(abs(SYY))=', sum(abs(SYY_p)) - FLUSH(740+IAPROC) +! + use yowExchangeModule, only : PDLIB_exchange1Dreal + use yowNodepool, only : PDLIB_IEN, PDLIB_TRIA, npa, iplg + use yowElementpool, only : INE, NE + USE W3GDATMD, ONLY : MAPSTA + USE W3PARALL, only: INIT_GET_ISEA + IMPLICIT NONE +!/ +!/ ------------------------------------------------------------------- / +!/ Parameter list +!/ +!/ ------------------------------------------------------------------- / +!/ Local PARAMETERs +!/ +#ifdef W3_S + INTEGER, SAVE :: IENT = 0 #endif +!/ +!/ ------------------------------------------------------------------- / +!/ + REAL(rkind), INTENT(IN) :: VAR(npa) + REAL(rkind), INTENT(OUT) :: DVDX(npa), DVDY(npa) + INTEGER :: NI(3) + INTEGER :: IE, I1, I2, I3, IP, IX + REAL(rkind) :: DEDY(3),DEDX(3) + REAL(rkind) :: DVDXIE, DVDYIE + REAL(rkind) :: WEI(npa), eW + INTEGER :: IX1, IX2, IX3, ISEA +#ifdef W3_S + CALL STRACE (IENT, 'VA_SETUP_IOBPD') +#endif + WEI = 0.0 + DVDX = 0.0 + DVDY = 0.0 - CALL DIFFERENTIATE_XYDIR(SXX_p, U_X1, U_Y1) -#ifdef W3_DEBUGSTP - WRITE(740+IAPROC,*) 'sum(absU_XY1)=', sum(abs(U_X1)), sum(abs(U_Y1)) - FLUSH(740+IAPROC) -#endif - CALL DIFFERENTIATE_XYDIR(SXY_p, U_X2, U_Y2) -#ifdef W3_DEBUGSTP - WRITE(740+IAPROC,*) 'sum(absU_XY2)=', sum(abs(U_X2)), sum(abs(U_Y2)) - FLUSH(740+IAPROC) -#endif - F_X = -U_X1 - U_Y2 - ! - CALL DIFFERENTIATE_XYDIR(SYY_p, U_X1, U_Y1) -#ifdef W3_DEBUGSTP - WRITE(740+IAPROC,*) 'sum(absU_XY1)=', sum(abs(U_X1)), sum(abs(U_Y1)) - FLUSH(740+IAPROC) -#endif - F_Y = -U_Y1 - U_X2 -#ifdef W3_DEBUGSTP - WRITE(740+IAPROC,*) 'sum(F_X)=', sum(F_X) - WRITE(740+IAPROC,*) 'sum(F_Y)=', sum(F_Y) - FLUSH(740+IAPROC) -#endif - END SUBROUTINE TRIG_COMPUTE_LH_STRESS - !/ ------------------------------------------------------------------- / - !> - !> @brief Differentiate other way around. - !> - !> @param[in] IE - !> @param[in] I1 - !> @param[inout] UGRAD - !> @param[inout] VGRAD - !> - !> @author Mathieu Dutour-Sikiric - !> @author Aron Roland - !> @date 1-May-2018 - !> - SUBROUTINE TRIG_COMPUTE_DIFF(IE, I1, UGRAD, VGRAD) - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | | - !/ | Mathieu Dutour-Sikiric (IRB) | - !/ | Aron Roland (BGS IT&E GmbH) | - !/ | | - !/ | FORTRAN 90 | - !/ | Last update : 01-Mai-2018 | - !/ +-----------------------------------+ - !/ - !/ 01-Mai-2018 : Origination. ( version 6.04 ) - !/ - ! 1. Purpose : differentiate other way around ... - ! 2. Method : - ! 3. Parameters : - ! - ! Parameter list - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 4. Subroutines used : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! STRACE Subr. W3SERVMD Subroutine tracing. - ! ---------------------------------------------------------------- - ! - ! 5. Called by : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 6. Error messages : - ! 7. Remarks - ! 8. Structure : - ! 9. Switches : - ! - ! !/S Enable subroutine tracing. - ! - ! 10. Source code : - ! - !/ ------------------------------------------------------------------- / -#ifdef W3_S - USE W3SERVMD, ONLY: STRACE -#endif - ! - use yowElementpool, only: INE - use yowNodepool, only: x, y, PDLIB_TRIA - IMPLICIT NONE - !/ - !/ ------------------------------------------------------------------- / - !/ Parameter list - !/ - !/ ------------------------------------------------------------------- / - !/ Local PARAMETERs - !/ -#ifdef W3_S - INTEGER, SAVE :: IENT = 0 -#endif - !/ - !/ ------------------------------------------------------------------- / - !/ -#ifdef W3_S - CALL STRACE (IENT, 'VA_SETUP_IOBPD') -#endif - ! - INTEGER, intent(in) :: IE, I1 - REAL(8), intent(inout) :: UGRAD, VGRAD - REAL(8) :: h - integer I2, I3, IP1, IP2, IP3 - INTEGER :: POS_TRICK(3,2) - POS_TRICK(1,1) = 2 - POS_TRICK(1,2) = 3 - POS_TRICK(2,1) = 3 - POS_TRICK(2,2) = 1 - POS_TRICK(3,1) = 1 - POS_TRICK(3,2) = 2 - I2=POS_TRICK(I1, 1) - I3=POS_TRICK(I1, 2) - IP1=INE(I1, IE) - IP2=INE(I2, IE) - IP3=INE(I3, IE) - h=2.0*PDLIB_TRIA(IE) - UGRAD=-(y(IP3) - y(IP2))/h - VGRAD= (x(IP3) - x(IP2))/h - END SUBROUTINE TRIG_COMPUTE_DIFF - !/ ------------------------------------------------------------------- / - !> - !> @brief Setup system matrix for solutions of wave setup eq. - !> - !> @param[in] FX - !> @param[in] FY - !> @param[in] DWNX - !> @param[out] ASPAR - !> @param[out] B - !> @param[in] ACTIVE - !> @param[out] ACTIVESEC - !> - !> @author Mathieu Dutour-Sikiric - !> @author Aron Roland - !> @date 1-May-2018 - !> - SUBROUTINE TRIG_WAVE_SETUP_COMPUTE_SYSTEM(ASPAR, B, FX, FY, DWNX, ACTIVE, ACTIVESEC) - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | | - !/ | Mathieu Dutour-Sikiric (IRB) | - !/ | Aron Roland (BGS IT&E GmbH) | - !/ | | - !/ | FORTRAN 90 | - !/ | Last update : 01-Mai-2018 | - !/ +-----------------------------------+ - !/ - !/ 01-Mai-2018 : Origination. ( version 6.04 ) - !/ - ! 1. Purpose : Setup system matrix for solutions of wave setup eq. - ! 2. Method : - ! 3. Parameters : - ! - ! Parameter list - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 4. Subroutines used : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! STRACE Subr. W3SERVMD Subroutine tracing. - ! ---------------------------------------------------------------- - ! - ! 5. Called by : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 6. Error messages : - ! 7. Remarks - ! 8. Structure : - ! 9. Switches : - ! - ! !/S Enable subroutine tracing. - ! - ! 10. Source code : - ! - !/ ------------------------------------------------------------------- / -#ifdef W3_S - USE W3SERVMD, ONLY: STRACE -#endif - ! - use yowElementpool, only: INE, NE - use yowNodepool, only: PDLIB_NNZ, PDLIB_JA_IE, PDLIB_TRIA, npa, np - USE yowNodepool, only: iplg - IMPLICIT NONE - !/ - !/ ------------------------------------------------------------------- / - !/ Parameter list - !/ - !/ ------------------------------------------------------------------- / - !/ Local PARAMETERs - !/ -#ifdef W3_S - INTEGER, SAVE :: IENT = 0 -#endif - !/ - !/ ------------------------------------------------------------------- / - !/ -#ifdef W3_S - CALL STRACE (IENT, 'VA_SETUP_IOBPD') -#endif - ! - real(8), intent(in) :: FX(npa), FY(npa), DWNX(npa) - real(8), intent(out) :: ASPAR(PDLIB_NNZ) - real(8), intent(out) :: B(npa) - integer, intent(in) :: ACTIVE(npa) - integer, intent(out) :: ACTIVESEC(npa) - INTEGER :: POS_TRICK(3,2), POS_SHIFT(3,3) - integer I1, I2, I3, IP1, IP2, IP3 - integer IDX, IDX1, IDX2, IDX3 - INTEGER IE, IP, I, J, K, IPp, JPp - real(8) :: eDep, eFX, eFY, eScal, eFact, eArea - real(8) :: UGRAD, VGRAD, UGRAD1, VGRAD1 - real(8) :: eOff - logical DoPrintOut - INTEGER sumActive - INTEGER LIDX(2), KIDX(2), jdx - INTEGER IPglob1, IPglob2, IPglob3 - POS_TRICK(1,1) = 2 - POS_TRICK(1,2) = 3 - POS_TRICK(2,1) = 3 - POS_TRICK(2,2) = 1 - POS_TRICK(3,1) = 1 - POS_TRICK(3,2) = 2 - ASPAR=0 - B=0 - DO I=1,3 - DO J=1,3 - K= I-J+1 - IF (K .le. 0) THEN - K=K+3 + DO IE = 1, NE + NI = INE(:,IE) + I1 = INE(1,IE) + I2 = INE(2,IE) + I3 = INE(3,IE) + IX1=iplg(I1) + IX2=iplg(I2) + IX3=iplg(I3) + IF ((MAPSTA(1,IX1) .gt. 0).and.(MAPSTA(1,IX2) .gt. 0).and.(MAPSTA(1,IX3) .gt. 0)) THEN + WEI(NI) = WEI(NI) + 2.*PDLIB_TRIA(IE) + DEDX(1) = PDLIB_IEN(1,IE) + DEDX(2) = PDLIB_IEN(3,IE) + DEDX(3) = PDLIB_IEN(5,IE) + DEDY(1) = PDLIB_IEN(2,IE) + DEDY(2) = PDLIB_IEN(4,IE) + DEDY(3) = PDLIB_IEN(6,IE) + DVDXIE = DOT_PRODUCT( VAR(NI),DEDX) + DVDYIE = DOT_PRODUCT( VAR(NI),DEDY) + DVDX(NI) = DVDX(NI) + DVDXIE + DVDY(NI) = DVDY(NI) + DVDYIE END IF - IF (K .ge. 4) THEN - K=K-3 - END IF - POS_SHIFT(I,J)=K - END DO - END DO - DO I=1,3 - jdx=0 - DO IDX=1,3 - K=POS_SHIFT(I,IDX) - IF (K .ne. I) THEN - jdx=jdx+1 - LIDX(jdx)=IDX - KIDX(jdx)=K - END IF - END DO - POS_SHIFT(I,LIDX(1))=KIDX(2) - POS_SHIFT(I,LIDX(2))=KIDX(1) - END DO - ACTIVESEC=0 - DO IE=1,ne - IP1=INE(1,IE) - IP2=INE(2,IE) - IP3=INE(3,IE) - eFX =(FX(IP1) + FX(IP2) + FX(IP3))/3 - eFY =(FY(IP1) + FY(IP2) + FY(IP3))/3 - sumActive=ACTIVE(IP1) + ACTIVE(IP2) + ACTIVE(IP3) - IF (sumActive .eq. 3) THEN - ACTIVESEC(IP1)=1 - ACTIVESEC(IP2)=1 - ACTIVESEC(IP3)=1 - eDep=(DWNX(IP1) + DWNX(IP2) + DWNX(IP3))/3.0 - eArea=PDLIB_TRIA(IE) - eFact=eDep*eArea - DO I1=1,3 - I2=POS_TRICK(I1,1) - I3=POS_TRICK(I1,2) - IP1=INE(I1,IE) - IP2=INE(I2,IE) - IP3=INE(I3,IE) - IDX1=PDLIB_JA_IE(I1,1,IE) - IDX2=PDLIB_JA_IE(I1,2,IE) - IDX3=PDLIB_JA_IE(I1,3,IE) - CALL TRIG_COMPUTE_DIFF(IE, I1, UGRAD1, VGRAD1) - eScal=UGRAD1*eFX + VGRAD1*eFY - B(IP1) = B(IP1) + eScal*eArea - ! - DO IDX=1,3 - K=POS_SHIFT(I1, IDX) - CALL TRIG_COMPUTE_DIFF(IE, K, UGRAD, VGRAD) - eScal=UGRAD*UGRAD1 + VGRAD*VGRAD1 - J=PDLIB_JA_IE(I1,IDX,IE) - ASPAR(J)=ASPAR(J) + eFact*eScal - END DO - END DO - END IF - END DO - DoPrintOut=.TRUE. - IF (DoPrintOut .eqv. .TRUE.) THEN - DO IP=1,NP - eOff=0 END DO - END IF - END SUBROUTINE TRIG_WAVE_SETUP_COMPUTE_SYSTEM - !/ ------------------------------------------------------------------- / - !> - !> @brief Preconditioner. - !> - !> @param[in] ASPAR - !> @param[in] TheIn - !> @param[out] TheOut - !> @param[in] ACTIVE - !> @param[in] ACTIVESEC - !> - !> @author Mathieu Dutour-Sikiric - !> @author Aron Roland - !> @date 1-May-2018 - !> - SUBROUTINE TRIG_WAVE_SETUP_APPLY_PRECOND(ASPAR, TheIn, TheOut, ACTIVE, ACTIVESEC) - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | | - !/ | Mathieu Dutour-Sikiric (IRB) | - !/ | Aron Roland (BGS IT&E GmbH) | - !/ | | - !/ | FORTRAN 90 | - !/ | Last update : 01-Mai-2018 | - !/ +-----------------------------------+ - !/ - !/ 01-Mai-2018 : Origination. ( version 6.04 ) - !/ - ! 1. Purpose : preconditioner - ! 2. Method : - ! 3. Parameters : - ! - ! Parameter list - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 4. Subroutines used : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! STRACE Subr. W3SERVMD Subroutine tracing. - ! ---------------------------------------------------------------- - ! - ! 5. Called by : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 6. Error messages : - ! 7. Remarks - ! 8. Structure : - ! 9. Switches : - ! - ! !/S Enable subroutine tracing. - ! - ! 10. Source code : - ! - !/ ------------------------------------------------------------------- / -#ifdef W3_S - USE W3SERVMD, ONLY: STRACE -#endif - ! - use yowExchangeModule, only : PDLIB_exchange1Dreal - use yowNodepool, only: PDLIB_NNZ, PDLIB_IA, PDLIB_JA, PDLIB_I_DIAG - use yowNodepool, only: npa - USE W3ODATMD, only : IAPROC - USE W3ODATMD, only : IAPROC - USE yowNodepool, only: iplg - IMPLICIT NONE - !/ - !/ ------------------------------------------------------------------- / - !/ Parameter list - !/ - !/ ------------------------------------------------------------------- / - !/ Local PARAMETERs - !/ -#ifdef W3_S - INTEGER, SAVE :: IENT = 0 -#endif - !/ - !/ ------------------------------------------------------------------- / - !/ -#ifdef W3_S - CALL STRACE (IENT, 'VA_SETUP_IOBPD') -#endif - ! - REAL(8), intent(in) :: ASPAR(PDLIB_NNZ) - REAL(8), intent(in) :: TheIn(npa) - REAL(8), intent(out) :: TheOut(npa) - INTEGER, intent(IN) :: ACTIVE(npa), ACTIVESEC(npa) - REAL(8) :: ListDiag(npa) - integer IP, J1, J, JP, J2 - REAL(8) :: eCoeff - INTEGER :: ThePrecond = 2 - IF (ThePrecond .eq. 0) THEN - TheOut=TheIn - END IF - IF (ThePrecond .eq. 1) THEN - TheOut=0 DO IP=1,npa - IF (ACTIVE(IP) .eq. 1) THEN - J1=PDLIB_I_DIAG(IP) - DO J=PDLIB_IA(IP),PDLIB_IA(IP+1)-1 - JP=PDLIB_JA(J) - IF (ACTIVESEC(JP) .eq. 1) THEN - IF (J .eq. J1) THEN - eCoeff=1.0/ASPAR(J) - ELSE - J2=PDLIB_I_DIAG(JP) - eCoeff=-ASPAR(J) /(ASPAR(J1)*ASPAR(J2)) - END IF - TheOut(IP)=TheOut(IP) + eCoeff*TheIn(JP) - END IF - END DO - END IF + IX=iplg(IP) + eW=WEI(IP) + IF (eW .gt. 0 .and. MAPSTA(1,IX) .gt. 0) THEN + DVDX(IP)=DVDX(IP) / eW + DVDY(IP)=DVDY(IP) / eW + ELSE + DVDX(IP)=0. + DVDY(IP)=0. + ENDIF END DO - END IF - IF (ThePrecond .eq. 2) THEN DO IP=1,npa - IF (ACTIVESEC(IP) .eq. 1) THEN - J=PDLIB_I_DIAG(IP) - ListDiag(IP)=ASPAR(J) - TheOut(IP)=TheIn(IP)/ASPAR(J) - ELSE - ListDiag(IP)=1 - TheOut(IP)=TheIn(IP) + IX=iplg(IP) + IF (MAPSTA(1,IX) .lt. 0) THEN + DVDX(IP)=0. + DVDY(IP)=0. END IF END DO - WRITE(740+IAPROC,*) 'Diag, min=', minval(ListDiag), ' max=', maxval(ListDiag) - WRITE(740+IAPROC,*) 'Diag, quot=', maxval(ListDiag)/minval(ListDiag) - END IF - CALL PDLIB_exchange1Dreal(TheOut) - END SUBROUTINE TRIG_WAVE_SETUP_APPLY_PRECOND - !/ ------------------------------------------------------------------- / - !> - !> @brief - !> - !> @param[in] ASPAR - !> @param[in] TheIn - !> @param[out] TheOut - !> @param[in] ACTIVE - !> @param[in] ACTIVESEC - !> - !> @author Mathieu Dutour-Sikiric - !> @author Aron Roland - !> @date 1-May-2018 - !> - SUBROUTINE TRIG_WAVE_SETUP_APPLY_FCT(ASPAR, TheIn, TheOut, ACTIVE, ACTIVESEC) - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | | - !/ | Mathieu Dutour-Sikiric (IRB) | - !/ | Aron Roland (BGS IT&E GmbH) | - !/ | | - !/ | FORTRAN 90 | - !/ | Last update : 01-Mai-2018 | - !/ +-----------------------------------+ - !/ - !/ 01-Mai-2018 : Origination. ( version 6.04 ) - !/ - ! 1. Purpose : compute off diagonal contr. - ! 2. Method : - ! 3. Parameters : - ! - ! Parameter list - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 4. Subroutines used : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! STRACE Subr. W3SERVMD Subroutine tracing. - ! ---------------------------------------------------------------- - ! - ! 5. Called by : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 6. Error messages : - ! 7. Remarks - ! 8. Structure : - ! 9. Switches : - ! - ! !/S Enable subroutine tracing. - ! - ! 10. Source code : - ! - !/ ------------------------------------------------------------------- / -#ifdef W3_S - USE W3SERVMD, ONLY: STRACE -#endif - ! - use yowExchangeModule, only : PDLIB_exchange1Dreal - USE yowNodepool, only: PDLIB_IA, PDLIB_JA, PDLIB_NNZ - use yowNodepool, only: np, npa - USE W3GDATMD, ONLY: NSEAL - IMPLICIT NONE - !/ - !/ ------------------------------------------------------------------- / - !/ Parameter list - !/ - !/ ------------------------------------------------------------------- / - !/ Local PARAMETERs - !/ -#ifdef W3_S - INTEGER, SAVE :: IENT = 0 -#endif - !/ - !/ ------------------------------------------------------------------- / - !/ -#ifdef W3_S - CALL STRACE (IENT, 'VA_SETUP_IOBPD') -#endif - ! - REAL(8), intent(in) :: ASPAR(PDLIB_NNZ) - REAL(8), intent(in) :: TheIn(npa) - REAL(8), intent(out) :: TheOut(npa) - INTEGER, intent(in) :: ACTIVE(npa), ACTIVESEC(npa) - integer IP, J, JP - REAL(8) :: eCoeff - TheOut=0 - DO IP=1,npa - IF (ACTIVESEC(IP) .eq. 1) THEN - DO J=PDLIB_IA(IP),PDLIB_IA(IP+1)-1 - JP=PDLIB_JA(J) - eCoeff=ASPAR(J) - TheOut(IP)=TheOut(IP) + eCoeff*TheIn(JP) - END DO - END IF - END DO - CALL PDLIB_exchange1Dreal(TheOut) - END SUBROUTINE TRIG_WAVE_SETUP_APPLY_FCT - !/ ------------------------------------------------------------------- / - !> - !> @brief Scalar product plus exchange. - !> - !> @param[in] V1 - !> @param[in] V2 - !> @param[inout] eScal - !> - !> @author Mathieu Dutour-Sikiric - !> @author Aron Roland - !> @date 1-May-2018 - !> - SUBROUTINE TRIG_WAVE_SETUP_SCALAR_PROD(V1, V2, eScal) - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | | - !/ | Mathieu Dutour-Sikiric (IRB) | - !/ | Aron Roland (BGS IT&E GmbH) | - !/ | | - !/ | FORTRAN 90 | - !/ | Last update : 01-Mai-2018 | - !/ +-----------------------------------+ - !/ - !/ 01-Mai-2018 : Origination. ( version 6.04 ) - !/ - ! 1. Purpose : scalar prod. + exchange - ! 2. Method : - ! 3. Parameters : - ! - ! Parameter list - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 4. Subroutines used : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! STRACE Subr. W3SERVMD Subroutine tracing. - ! ---------------------------------------------------------------- - ! - ! 5. Called by : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 6. Error messages : - ! 7. Remarks - ! 8. Structure : - ! 9. Switches : - ! - ! !/S Enable subroutine tracing. - ! - ! 10. Source code : - ! - !/ ------------------------------------------------------------------- / -#ifdef W3_S - USE W3SERVMD, ONLY: STRACE -#endif - ! - USE W3GDATMD, ONLY: NX - USE W3ADATMD, ONLY: MPI_COMM_WCMP - use yowDatapool, only: rtype, istatus - use yowNodepool, only: np, npa - USE W3ODATMD, only : IAPROC, NAPROC, NTPROC - USE W3GDATMD, ONLY: NSEAL - IMPLICIT NONE - !/ - !/ ------------------------------------------------------------------- / - !/ Parameter list - !/ - !/ ------------------------------------------------------------------- / - !/ Local PARAMETERs - !/ -#ifdef W3_S - INTEGER, SAVE :: IENT = 0 -#endif - !/ - !/ ------------------------------------------------------------------- / - !/ -#ifdef W3_S - CALL STRACE (IENT, 'VA_SETUP_IOBPD') -#endif - ! - real(8), intent(in) :: V1(npa), V2(npa) - real(8), intent(inout) :: eScal - integer :: IP, myrank, myproc - real(8) :: rScal(1), lScal(1) - integer iProc - integer ierr - CALL MPI_COMM_RANK(MPI_COMM_WCMP, myrank, ierr) - CALL MPI_COMM_SIZE(MPI_COMM_WCMP, myproc, ierr) - lScal=0 - DO IP=1,np - lScal(1)=lScal(1) + V1(IP)*V2(IP) - END DO - IF (IAPROC .eq. 1) THEN - DO iProc=2,NAPROC - CALL MPI_RECV(rScal,1,rtype, iProc-1, 19, MPI_COMM_WCMP, istatus, ierr) - lScal = lScal + rScal - END DO - DO iProc=2,NAPROC - CALL MPI_SEND(lScal,1,rtype, iProc-1, 23, MPI_COMM_WCMP, ierr) - END DO - ELSE - CALL MPI_SEND(lScal,1,rtype, 0, 19, MPI_COMM_WCMP, ierr) - CALL MPI_RECV(lScal,1,rtype, 0, 23, MPI_COMM_WCMP, istatus, ierr) - END IF - eScal=lScal(1) - END SUBROUTINE TRIG_WAVE_SETUP_SCALAR_PROD - !/ ------------------------------------------------------------------- / - !> - !> @brief Poisson equation solver. - !> - !> @param[in] ASPAR - !> @param[in] B - !> @param[out] TheOut - !> @param[in] ACTIVE - !> @param[in] ACTIVESEC - !> - !> @author Mathieu Dutour-Sikiric - !> @author Aron Roland - !> @date 1-May-2018 - !> - SUBROUTINE TRIG_WAVE_SETUP_SOLVE_POISSON_NEUMANN_DIR(ASPAR, B, TheOut, ACTIVE, ACTIVESEC) - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | | - !/ | Mathieu Dutour-Sikiric (IRB) | - !/ | Aron Roland (BGS IT&E GmbH) | - !/ | | - !/ | FORTRAN 90 | - !/ | Last update : 01-Mai-2018 | - !/ +-----------------------------------+ - !/ - !/ 01-Mai-2018 : Origination. ( version 6.04 ) - !/ - ! 1. Purpose : poisson eq. solver - ! 2. Method : - ! 3. Parameters : - ! - ! Parameter list - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 4. Subroutines used : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! STRACE Subr. W3SERVMD Subroutine tracing. - ! ---------------------------------------------------------------- - ! - ! 5. Called by : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 6. Error messages : - ! 7. Remarks - ! 8. Structure : - ! 9. Switches : - ! - ! !/S Enable subroutine tracing. - ! - ! 10. Source code : - ! - !/ ------------------------------------------------------------------- / -#ifdef W3_S - USE W3SERVMD, ONLY: STRACE -#endif - ! - USE yowNodepool, only: PDLIB_NNZ - USE W3GDATMD, ONLY: NSEAL, SOLVERTHR_STP - USE W3ODATMD, only : IAPROC - use yowNodepool, only: np, npa - IMPLICIT NONE - !/ - !/ ------------------------------------------------------------------- / - !/ Parameter list - !/ - !/ ------------------------------------------------------------------- / - !/ Local PARAMETERs - !/ -#ifdef W3_S - INTEGER, SAVE :: IENT = 0 -#endif - !/ - !/ ------------------------------------------------------------------- / - !/ -#ifdef W3_S - CALL STRACE (IENT, 'VA_SETUP_IOBPD') -#endif - ! - real(8), intent(in) :: ASPAR(PDLIB_NNZ) - real(8), intent(in) :: B(npa) - real(8), intent(out) :: TheOut(npa) - integer, intent(in) :: ACTIVE(npa), ACTIVESEC(npa) - real(8) :: V_X(npa), V_R(npa), V_Z(npa), V_P(npa), V_Y(npa) - real(8) :: uO, uN, alphaV, h1, h2 - real(8) :: eNorm, beta - real(8) :: SOLVERTHR - integer IP, nbIter - SOLVERTHR=SOLVERTHR_STP - -#ifdef W3_DEBUGSTP - WRITE(740+IAPROC,*) 'Begin TRIG_WAVE_SETUP_SOLVE ....' - FLUSH(740+IAPROC) -#endif - nbIter=0 - V_X=0 - V_R=B - CALL TRIG_WAVE_SETUP_APPLY_PRECOND(ASPAR, V_R, V_Z, ACTIVE, ACTIVESEC) - V_P=V_Z - CALL TRIG_WAVE_SETUP_SCALAR_PROD(V_Z, V_R, uO) -#ifdef W3_DEBUGSTP - WRITE(740+IAPROC,*) 'uO=', uO - FLUSH(740+IAPROC) -#endif - CALL TRIG_WAVE_SETUP_SCALAR_PROD(B, B, eNorm) -#ifdef W3_DEBUGSTP - WRITE(740+IAPROC,*) 'eNorm(B)=', eNorm - WRITE(740+IAPROC,*) 'SOLVERTHR=', SOLVERTHR - FLUSH(740+IAPROC) -#endif - WRITE(740+IAPROC,*) 'SOLVERTHR=', SOLVERTHR, ' eNorm(B)=', eNorm - IF (eNorm .le. SOLVERTHR) THEN -#ifdef W3_DEBUGSTP - WRITE(740+IAPROC,*) 'Leaving here, zero solution' - FLUSH(740+IAPROC) -#endif - TheOut=V_X - RETURN - END IF - DO - nbIter=nbIter + 1 -#ifdef W3_DEBUGSTP - WRITE(740+IAPROC,*) ' nbIter=', nbIter - FLUSH(740+IAPROC) + CALL PDLIB_exchange1Dreal(DVDX) + CALL PDLIB_exchange1Dreal(DVDY) + END SUBROUTINE +!/ ------------------------------------------------------------------- / +!> +!> @brief Driver routine for xydir. +!> +!> @param[in] VAR +!> @param[out] DVDX +!> @param[out] DVDY +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> + SUBROUTINE DIFFERENTIATE_XYDIR(VAR, DVDX, DVDY) +!/ +!/ +-----------------------------------+ +!/ | WAVEWATCH III NOAA/NCEP | +!/ | | +!/ | Mathieu Dutour-Sikiric (IRB) | +!/ | Aron Roland (BGS IT&E GmbH) | +!/ | FORTRAN 90 | +!/ | Last update : 01-Mai-2018 | +!/ +-----------------------------------+ +!/ +!/ 01-Mai-2018 : Origination. ( version 6.04 ) +!/ +! 1. Purpose : Driver routine for xydir +! 2. Method : +! 3. Parameters : +! +! Parameter list +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 4. Subroutines used : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! STRACE Subr. W3SERVMD Subroutine tracing. +! ---------------------------------------------------------------- +! +! 5. Called by : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 6. Error messages : +! 7. Remarks +! 8. Structure : +! 9. Switches : +! +! !/S Enable subroutine tracing. +! +! 10. Source code : +! +!/ ------------------------------------------------------------------- / +#ifdef W3_S + USE W3SERVMD, ONLY: STRACE #endif - CALL TRIG_WAVE_SETUP_APPLY_FCT(ASPAR, V_P, V_Y, ACTIVE, ACTIVESEC) - CALL TRIG_WAVE_SETUP_SCALAR_PROD(V_P, V_Y, h2) -#ifdef W3_DEBUGSTP - WRITE(740+IAPROC,*) ' h2=', h2 - FLUSH(740+IAPROC) +! + use yowNodepool, only: npa + IMPLICIT NONE +!/ +!/ ------------------------------------------------------------------- / +!/ Parameter list +!/ +!/ ------------------------------------------------------------------- / +!/ Local PARAMETERs +!/ +#ifdef W3_S + INTEGER, SAVE :: IENT = 0 #endif - alphaV=uO/h2 -#ifdef W3_DEBUGSTP - WRITE(740+IAPROC,*) ' alphaV=', alphaV - FLUSH(740+IAPROC) + REAL(rkind), INTENT(IN) :: VAR(npa) + REAL(rkind), INTENT(OUT) :: DVDX(npa), DVDY(npa) +!/ +!/ ------------------------------------------------------------------- / +!/ +#ifdef W3_S + CALL STRACE (IENT, 'VA_SETUP_IOBPD') #endif +! - ! - DO IP=1,npa - V_X(IP) = V_X(IP) + alphaV * V_P(IP) - V_R(IP) = V_R(IP) - alphaV * V_Y(IP) + CALL DIFFERENTIATE_XYDIR_MAPSTA(VAR, DVDX, DVDY) +! CALL DIFFERENTIATE_XYDIR_NATIVE(VAR, DVDX, DVDY) + END SUBROUTINE +!/ ------------------------------------------------------------------- / +!> +!> @brief Setup boundary pointer. +!> +!> @param[out] F_X +!> @param[out] F_Y +!> @param[out] DWNX +!> +!> @author Aron Roland +!> @author Mathieu Dutour-Sikiric +!> @date 1-May-2018 +!> + SUBROUTINE TRIG_COMPUTE_LH_STRESS(F_X, F_Y, DWNX) +!/ +!/ +-----------------------------------+ +!/ | WAVEWATCH III NOAA/NCEP | +!/ | | +!/ | Aron Roland (BGS IT&E GmbH) | +!/ | Mathieu Dutour-Sikiric (IRB) | +!/ | | +!/ | FORTRAN 90 | +!/ | Last update : 01-Mai-2018 | +!/ +-----------------------------------+ +!/ +!/ 01-Mai-2018 : Origination. ( version 6.04 ) +!/ +! 1. Purpose : Setup boundary pointer +! 2. Method : +! 3. Parameters : +! +! Parameter list +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 4. Subroutines used : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! STRACE Subr. W3SERVMD Subroutine tracing. +! ---------------------------------------------------------------- +! +! 5. Called by : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 6. Error messages : +! 7. Remarks +! 8. Structure : +! 9. Switches : +! +! !/S Enable subroutine tracing. +! +! 10. Source code : +! +!/ ------------------------------------------------------------------- / +#ifdef W3_S + USE W3SERVMD, ONLY: STRACE +#endif +! + USE CONSTANTS, ONLY: GRAV, DWAT + use yowNodepool, only: npa, iplg + USE W3GDATMD, only : MAPFS + USE W3ADATMD, ONLY: SXX, SXY, SYY, WN, CG + USE W3PARALL, only: INIT_GET_ISEA + USE W3ODATMD, only : IAPROC + USE W3GDATMD, ONLY : NSEAL, MAPSTA + USE W3ADATMD, ONLY: DW + IMPLICIT NONE +!/ +!/ ------------------------------------------------------------------- / +!/ Parameter list +!/ +!/ ------------------------------------------------------------------- / +!/ Local PARAMETERs +!/ +#ifdef W3_S + INTEGER, SAVE :: IENT = 0 +#endif +!/ +!/ ------------------------------------------------------------------- / +!/ + real(rkind), intent(out) :: F_X(npa), F_Y(npa), DWNX(npa) + REAL(rkind) :: h + REAL(rkind) :: SXX_X, SXX_Y + REAL(rkind) :: SXY_X, SXY_Y + REAL(rkind) :: SYY_X, SYY_Y + INTEGER I, IP, IX + INTEGER JSEA, ISEA + real(rkind) :: U_X1(npa), U_Y1(npa) + real(rkind) :: U_X2(npa), U_Y2(npa) + real(rkind) :: SXX_p(npa), SXY_p(npa), SYY_p(npa) + real(rkind) :: eSXX, eSXY, eSYY + integer :: SXXmethod = 1 +#ifdef W3_S + CALL STRACE (IENT, 'VA_SETUP_IOBPD') +#endif + SXX_p=0 + SXY_p=0 + SYY_p=0 + DWNX=0 + DO JSEA=1,NSEAL + IP = JSEA ! We remove the Z_status because now NX = NSEA + IX=iplg(IP) + ISEA=MAPFS(1,IX) + IF (SXXmethod .eq. 1) THEN + eSXX=SXX(JSEA)/(DWAT*GRAV) + eSXY=SXY(JSEA)/(DWAT*GRAV) + eSYY=SYY(JSEA)/(DWAT*GRAV) + END IF + SXX_p(IP)=DBLE(eSXX) + SXY_p(IP)=DBLE(eSXY) + SYY_p(IP)=DBLE(eSYY) + DWNX(IP)=DW(ISEA) END DO ! - CALL TRIG_WAVE_SETUP_SCALAR_PROD(V_R, V_R, eNorm) #ifdef W3_DEBUGSTP - WRITE(740+IAPROC,*) 'eNorm=', eNorm + WRITE(740+IAPROC,*) 'min/max(DEP)=', minval(DWNX), maxval(DWNX) + WRITE(740+IAPROC,*) 'sum(abs(SXX))=', sum(abs(SXX_p)) + WRITE(740+IAPROC,*) 'sum(abs(SXY))=', sum(abs(SXY_p)) + WRITE(740+IAPROC,*) 'sum(abs(SYY))=', sum(abs(SYY_p)) FLUSH(740+IAPROC) #endif - WRITE(740+IAPROC,*) 'nbIter=', nbIter, ' eNorm(res)=', eNorm - FLUSH(740+IAPROC) - IF (eNorm .le. SOLVERTHR) THEN - EXIT - END IF - ! - CALL TRIG_WAVE_SETUP_APPLY_PRECOND(ASPAR, V_R, V_Z, ACTIVE, ACTIVESEC) - CALL TRIG_WAVE_SETUP_SCALAR_PROD(V_Z, V_R, uN) + + CALL DIFFERENTIATE_XYDIR(SXX_p, U_X1, U_Y1) #ifdef W3_DEBUGSTP - WRITE(740+IAPROC,*) ' uN=', uN + WRITE(740+IAPROC,*) 'sum(absU_XY1)=', sum(abs(U_X1)), sum(abs(U_Y1)) FLUSH(740+IAPROC) #endif - ! - beta=uN/uO - uO=uN + CALL DIFFERENTIATE_XYDIR(SXY_p, U_X2, U_Y2) #ifdef W3_DEBUGSTP - WRITE(740+IAPROC,*) 'beta=', beta + WRITE(740+IAPROC,*) 'sum(absU_XY2)=', sum(abs(U_X2)), sum(abs(U_Y2)) FLUSH(740+IAPROC) #endif + F_X = -U_X1 - U_Y2 ! - DO IP=1,npa - V_P(IP)=V_Z(IP) + beta * V_P(IP) - END DO - END DO - TheOut=V_X - END SUBROUTINE TRIG_WAVE_SETUP_SOLVE_POISSON_NEUMANN_DIR - !/ ------------------------------------------------------------------- / - !> - !> @brief Set mean value. - !> - !> @param[inout] TheVar - !> - !> @author Mathieu Dutour-Sikiric - !> @author Aron Roland - !> @date 1-May-2018 - !> - SUBROUTINE TRIG_SET_MEANVALUE_TO_ZERO(TheVar) - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | | - !/ | Mathieu Dutour-Sikiric (IRB) | - !/ | Aron Roland (BGS IT&E GmbH) | - !/ | | - !/ | FORTRAN 90 | - !/ | Last update : 01-Mai-2018 | - !/ +-----------------------------------+ - !/ - !/ 01-Mai-2018 : Origination. ( version 6.04 ) - !/ - ! 1. Purpose : set. mean value - ! 2. Method : - ! 3. Parameters : - ! - ! Parameter list - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 4. Subroutines used : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! STRACE Subr. W3SERVMD Subroutine tracing. - ! ---------------------------------------------------------------- - ! - ! 5. Called by : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 6. Error messages : - ! 7. Remarks - ! 8. Structure : - ! 9. Switches : - ! - ! !/S Enable subroutine tracing. - ! - ! 10. Source code : - ! - !/ ------------------------------------------------------------------- / -#ifdef W3_S - USE W3SERVMD, ONLY: STRACE -#endif - ! - USE yowNodepool, only: PDLIB_SI - USE W3GDATMD, ONLY: NX, SI - USE W3GDATMD, ONLY: NSEAL - USE W3ADATMD, ONLY: MPI_COMM_WCMP - USE W3ODATMD, only : IAPROC, NAPROC, NTPROC - use yowDatapool, only: rtype, istatus - use yowNodepool, only: np, npa - IMPLICIT NONE - !/ - !/ ------------------------------------------------------------------- / - !/ Parameter list - !/ - !/ ------------------------------------------------------------------- / - !/ Local PARAMETERs - !/ -#ifdef W3_S - INTEGER, SAVE :: IENT = 0 -#endif - !/ - !/ ------------------------------------------------------------------- / - !/ -#ifdef W3_S - CALL STRACE (IENT, 'VA_SETUP_IOBPD') -#endif - ! - real(8), intent(inout) :: TheVar(npa) - real(8) :: SUM_SI_Var, SUM_SI, TheMean - INTEGER IP, ierr - real(8) :: eVect(2), rVect(2) - integer iProc - SUM_SI_Var=0 - SUM_SI=0 - DO IP=1,np - SUM_SI_Var = SUM_SI_Var + PDLIB_SI(IP)*TheVar(IP) - SUM_SI = SUM_SI + PDLIB_SI(IP) - END DO - eVect(1)=SUM_SI_Var - eVect(2)=SUM_SI -#ifdef W3_DEBUGSTP - WRITE(740+IAPROC,*) 'SUM_SI_Var=', SUM_SI_Var, 'SUM_SI=', SUM_SI - FLUSH(740+IAPROC) -#endif - IF (IAPROC .eq. 1) THEN - DO iProc=2,NAPROC - CALL MPI_RECV(rVect,2,rtype, iProc-1, 367, MPI_COMM_WCMP, istatus, ierr) - eVect=eVect + rVect - END DO - DO iProc=2,NAPROC - CALL MPI_SEND(eVect,2,rtype, iProc-1, 37, MPI_COMM_WCMP, ierr) - END DO - ELSE - CALL MPI_SEND(eVect,2,rtype, 0, 367, MPI_COMM_WCMP, ierr) - CALL MPI_RECV(eVect,2,rtype, 0, 37, MPI_COMM_WCMP, istatus, ierr) - END IF - SUM_SI_Var=eVect(1) - SUM_SI =eVect(2) - TheMean=SUM_SI_Var/SUM_SI -#ifdef W3_DEBUGSTP - WRITE(740+IAPROC,*) 'TheMean=', TheMean - FLUSH(740+IAPROC) -#endif - DO IP=1,npa - TheVar(IP)=TheVar(IP) - TheMean - END DO - END SUBROUTINE TRIG_SET_MEANVALUE_TO_ZERO - !/ ------------------------------------------------------------------- / - !> - !> @brief Compute active node for setup comp. - !> - !> @param[in] DWNX - !> @param[out] ACTIVE - !> - !> @author Aron Roland - !> @author Mathieu Dutour-Sikiric - !> @date 1-May-2018 - !> - SUBROUTINE COMPUTE_ACTIVE_NODE(DWNX, ACTIVE) - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | | - !/ | Aron Roland (BGS IT&E GmbH) | - !/ | Mathieu Dutour-Sikiric (IRB) | - !/ | | - !/ | FORTRAN 90 | - !/ | Last update : 01-Mai-2018 | - !/ +-----------------------------------+ - !/ - !/ 01-Mai-2018 : Origination. ( version 6.04 ) - !/ - ! 1. Purpose : Compute active node for setup comp. - ! 2. Method : - ! 3. Parameters : - ! - ! Parameter list - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 4. Subroutines used : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! STRACE Subr. W3SERVMD Subroutine tracing. - ! ---------------------------------------------------------------- - ! - ! 5. Called by : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 6. Error messages : - ! 7. Remarks - ! 8. Structure : - ! 9. Switches : - ! - ! !/S Enable subroutine tracing. - ! - ! 10. Source code : - ! - !/ ------------------------------------------------------------------- / -#ifdef W3_S - USE W3SERVMD, ONLY: STRACE -#endif - ! - USE W3GDATMD, ONLY : CRIT_DEP_STP - USE yowNodepool, only: PDLIB_NNZ, PDLIB_IA, PDLIB_JA, iplg, npa, np - USE W3ODATMD, only : IAPROC - IMPLICIT NONE - !/ - !/ ------------------------------------------------------------------- / - !/ Parameter list - !/ - !/ ------------------------------------------------------------------- / - !/ Local PARAMETERs - !/ -#ifdef W3_S - INTEGER, SAVE :: IENT = 0 -#endif - !/ - !/ ------------------------------------------------------------------- / - !/ -#ifdef W3_S - CALL STRACE (IENT, 'VA_SETUP_IOBPD') -#endif - ! - REAL*8, INTENT(in) :: DWNX(npa) - INTEGER, INTENT(out) :: ACTIVE(npa) - INTEGER IP, eAct -#ifdef W3_DEBUGSTP - INTEGER nbActive - nbActive=0 -#endif - DO IP=1,NPA - IF (DWNX(IP) .ge. CRIT_DEP_STP) THEN - eAct=1 - ELSE - eAct=0 - END IF + CALL DIFFERENTIATE_XYDIR(SYY_p, U_X1, U_Y1) #ifdef W3_DEBUGSTP - nbActive=nbActive + eAct + WRITE(740+IAPROC,*) 'sum(absU_XY1)=', sum(abs(U_X1)), sum(abs(U_Y1)) + FLUSH(740+IAPROC) #endif - ACTIVE(IP)=eAct - END DO + F_Y = -U_Y1 - U_X2 #ifdef W3_DEBUGSTP - WRITE(740+IAPROC,*) 'min/max(DWNX)=', minval(DWNX), maxval(DWNX) - WRITE(740+IAPROC,*) 'CRIT_DEP_STP=', CRIT_DEP_STP - WRITE(740+IAPROC,*) 'nbActive=', nbActive, ' npa=', npa - FLUSH(740+IAPROC) -#endif - END SUBROUTINE COMPUTE_ACTIVE_NODE - !/ ------------------------------------------------------------------- / - !> - !> @brief Setup computation. - !> - !> @author Mathieu Dutour-Sikiric - !> @author Aron Roland - !> @date 1-May-2018 - !> - SUBROUTINE TRIG_WAVE_SETUP_COMPUTATION - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | | - !/ | Mathieu Dutour-Sikiric (IRB) | - !/ | Aron Roland (BGS IT&E GmbH) | - !/ | | - !/ | FORTRAN 90 | - !/ | Last update : 01-Mai-2018 | - !/ +-----------------------------------+ - !/ - !/ 01-Mai-2018 : Origination. ( version 6.04 ) - !/ - ! 1. Purpose : Setup computation - ! 2. Method : - ! 3. Parameters : - ! - ! Parameter list - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 4. Subroutines used : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! STRACE Subr. W3SERVMD Subroutine tracing. - ! ---------------------------------------------------------------- - ! - ! 5. Called by : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 6. Error messages : - ! 7. Remarks - ! 8. Structure : - ! 9. Switches : - ! - ! !/S Enable subroutine tracing. - ! - ! 10. Source code : - ! - !/ ------------------------------------------------------------------- / -#ifdef W3_S - USE W3SERVMD, ONLY: STRACE -#endif - ! - USE yowNodepool, only: PDLIB_NNZ, PDLIB_IA, PDLIB_JA, iplg, npa, np - USE W3GDATMD, only : MAPFS - USE W3PARALL, only : SYNCHRONIZE_GLOBAL_ARRAY - USE W3ADATMD, ONLY: DW - USE W3GDATMD, ONLY: NSEAL, NSEA, NX - USE W3WDATMD, ONLY: ZETA_SETUP - USE W3ODATMD, only : IAPROC, NAPROC, NTPROC - USE W3PARALL, only: INIT_GET_ISEA - use yowExchangeModule, only : PDLIB_exchange1Dreal - IMPLICIT NONE - !/ - !/ ------------------------------------------------------------------- / - !/ Parameter list - !/ - !/ ------------------------------------------------------------------- / - !/ Local PARAMETERs - !/ -#ifdef W3_S - INTEGER, SAVE :: IENT = 0 -#endif - !/ - !/ ------------------------------------------------------------------- / - !/ -#ifdef W3_S - CALL STRACE (IENT, 'VA_SETUP_IOBPD') -#endif - ! - ! CALL W3SETG - REAL(8) :: ZETA_WORK(npa), ZETA_WORK_ALL(NX) - REAL(8) :: F_X(npa), F_Y(npa), DWNX(npa) - REAL(8) :: ASPAR(PDLIB_NNZ), B(npa) - INTEGER I, ISEA, JSEA, IX, IP, IP_glob - INTEGER :: ACTIVE(npa), ACTIVESEC(npa) - ! ZETA_SETUP is allocated on 1:NSEA - ! ZETA_WORK is on 1:npa -#ifdef W3_DEBUGSTP - WRITE(740+IAPROC,*) 'NAPROC=', NAPROC, ' NTPROC=', NTPROC - WRITE(740+IAPROC,*) 'NSEAL=', NSEAL - WRITE(740+IAPROC,*) 'npa=', npa, ' np=', np -#endif - FLUSH(740+IAPROC) - ZETA_WORK=0 - DO IP=1,npa - IX=iplg(IP) - ISEA=MAPFS(1,IX) - IF (ISEA .gt. 0) THEN - ZETA_WORK(IP)=ZETA_SETUP(ISEA) - END IF - END DO -#ifdef W3_DEBUGSTP - WRITE(740+IAPROC,*) 'Before TRIG_COMPUTE_LH_STRESS' - FLUSH(740+IAPROC) + WRITE(740+IAPROC,*) 'sum(F_X)=', sum(F_X) + WRITE(740+IAPROC,*) 'sum(F_Y)=', sum(F_Y) + FLUSH(740+IAPROC) #endif - - CALL TRIG_COMPUTE_LH_STRESS(F_X, F_Y, DWNX) -#ifdef W3_DEBUGSTP - WRITE(740+IAPROC,*) 'After TRIG_COMPUTE_LH_STRESS' - FLUSH(740+IAPROC) + END SUBROUTINE +!/ ------------------------------------------------------------------- / +!> +!> @brief Differentiate other way around. +!> +!> @param[in] IE +!> @param[in] I1 +!> @param[inout] UGRAD +!> @param[inout] VGRAD +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> + SUBROUTINE TRIG_COMPUTE_DIFF(IE, I1, UGRAD, VGRAD) +!/ +!/ +-----------------------------------+ +!/ | WAVEWATCH III NOAA/NCEP | +!/ | | +!/ | Mathieu Dutour-Sikiric (IRB) | +!/ | Aron Roland (BGS IT&E GmbH) | +!/ | | +!/ | FORTRAN 90 | +!/ | Last update : 01-Mai-2018 | +!/ +-----------------------------------+ +!/ +!/ 01-Mai-2018 : Origination. ( version 6.04 ) +!/ +! 1. Purpose : differentiate other way around ... +! 2. Method : +! 3. Parameters : +! +! Parameter list +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 4. Subroutines used : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! STRACE Subr. W3SERVMD Subroutine tracing. +! ---------------------------------------------------------------- +! +! 5. Called by : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 6. Error messages : +! 7. Remarks +! 8. Structure : +! 9. Switches : +! +! !/S Enable subroutine tracing. +! +! 10. Source code : +! +!/ ------------------------------------------------------------------- / +#ifdef W3_S + USE W3SERVMD, ONLY: STRACE #endif - CALL COMPUTE_ACTIVE_NODE(DWNX, ACTIVE) -#ifdef W3_DEBUGSTP - WRITE(740+IAPROC,*) 'After COMPUTE_ACTIVE_NODE' - FLUSH(740+IAPROC) +! + use yowElementpool, only: INE + use yowNodepool, only: x, y, PDLIB_TRIA + IMPLICIT NONE +!/ +!/ ------------------------------------------------------------------- / +!/ Parameter list +!/ +!/ ------------------------------------------------------------------- / +!/ Local PARAMETERs +!/ +#ifdef W3_S + INTEGER, SAVE :: IENT = 0 #endif - CALL TRIG_WAVE_SETUP_COMPUTE_SYSTEM(ASPAR, B, F_X, F_Y, DWNX, ACTIVE, ACTIVESEC) -#ifdef W3_DEBUGSTP - WRITE(740+IAPROC,*) 'Before,B,min=', minval(B), ' max=', maxval(B) - FLUSH(740+IAPROC) +!/ +!/ ------------------------------------------------------------------- / +!/ + INTEGER, intent(in) :: IE, I1 + REAL(rkind), intent(inout) :: UGRAD, VGRAD + REAL(rkind) :: h + integer I2, I3, IP1, IP2, IP3 + INTEGER :: POS_TRICK(3,2) +#ifdef W3_S + CALL STRACE (IENT, 'VA_SETUP_IOBPD') +#endif + POS_TRICK(1,1) = 2 + POS_TRICK(1,2) = 3 + POS_TRICK(2,1) = 3 + POS_TRICK(2,2) = 1 + POS_TRICK(3,1) = 1 + POS_TRICK(3,2) = 2 + I2=POS_TRICK(I1, 1) + I3=POS_TRICK(I1, 2) + IP1=INE(I1, IE) + IP2=INE(I2, IE) + IP3=INE(I3, IE) + h=2.0*PDLIB_TRIA(IE) + UGRAD=-(y(IP3) - y(IP2))/h + VGRAD= (x(IP3) - x(IP2))/h + END SUBROUTINE +!/ ------------------------------------------------------------------- / +!> +!> @brief Setup system matrix for solutions of wave setup eq. +!> +!> @param[in] FX +!> @param[in] FY +!> @param[in] DWNX +!> @param[out] ASPAR +!> @param[out] B +!> @param[in] ACTIVE +!> @param[out] ACTIVESEC +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> + SUBROUTINE TRIG_WAVE_SETUP_COMPUTE_SYSTEM(ASPAR, B, FX, FY, DWNX, ACTIVE, ACTIVESEC) +!/ +!/ +-----------------------------------+ +!/ | WAVEWATCH III NOAA/NCEP | +!/ | | +!/ | Mathieu Dutour-Sikiric (IRB) | +!/ | Aron Roland (BGS IT&E GmbH) | +!/ | | +!/ | FORTRAN 90 | +!/ | Last update : 01-Mai-2018 | +!/ +-----------------------------------+ +!/ +!/ 01-Mai-2018 : Origination. ( version 6.04 ) +!/ +! 1. Purpose : Setup system matrix for solutions of wave setup eq. +! 2. Method : +! 3. Parameters : +! +! Parameter list +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 4. Subroutines used : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! STRACE Subr. W3SERVMD Subroutine tracing. +! ---------------------------------------------------------------- +! +! 5. Called by : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 6. Error messages : +! 7. Remarks +! 8. Structure : +! 9. Switches : +! +! !/S Enable subroutine tracing. +! +! 10. Source code : +! +!/ ------------------------------------------------------------------- / +#ifdef W3_S + USE W3SERVMD, ONLY: STRACE #endif - - - ! CALL TRIG_SET_MEANVALUE_TO_ZERO(B) -#ifdef W3_DEBUGSTP - WRITE(740+IAPROC,*) 'After,B,min=', minval(B), ' max=', maxval(B) - FLUSH(740+IAPROC) +! + use yowElementpool, only: INE, NE + use yowNodepool, only: PDLIB_NNZ, PDLIB_JA_IE, PDLIB_TRIA, npa, np + use yowNodepool, only: PDLIB_I_DIAG + USE yowNodepool, only: iplg + USE W3ODATMD, only : IAPROC + IMPLICIT NONE +!/ +!/ ------------------------------------------------------------------- / +!/ Parameter list +!/ +!/ ------------------------------------------------------------------- / +!/ Local PARAMETERs +!/ +#ifdef W3_S + INTEGER, SAVE :: IENT = 0 #endif - - - CALL TRIG_WAVE_SETUP_SOLVE_POISSON_NEUMANN_DIR(ASPAR, B, ZETA_WORK, ACTIVE, ACTIVESEC) - - CALL TRIG_SET_MEANVALUE_TO_ZERO(ZETA_WORK) -#ifdef W3_DEBUGSTP - WRITE(740+IAPROC,*) 'After SET_MEAN min=', minval(ZETA_WORK), ' max=', maxval(ZETA_WORK) - FLUSH(740+IAPROC) -#endif - DO IP=1,npa - IX=iplg(IP) - ZETA_WORK_ALL(IX)=ZETA_WORK(IP) - END DO - CALL SYNCHRONIZE_GLOBAL_ARRAY(ZETA_WORK_ALL) - DO IX=1,NX - ISEA=MAPFS(1,IX) - IF (ISEA .gt. 0) THEN - ZETA_SETUP(ISEA) = ZETA_WORK_ALL(IX) - END IF - END DO +!/ +!/ ------------------------------------------------------------------- / +!/ + real(rkind), intent(in) :: FX(npa), FY(npa), DWNX(npa) + real(rkind), intent(out) :: ASPAR(PDLIB_NNZ) + real(rkind), intent(out) :: B(npa) + integer, intent(in) :: ACTIVE(npa) + integer, intent(out) :: ACTIVESEC(npa) + INTEGER :: POS_TRICK(3,2), POS_SHIFT(3,3) + integer I1, I2, I3, IP1, IP2, IP3 + integer IDX, IDX1, IDX2, IDX3 + INTEGER IE, IP, I, J, K, IPp, JPp + real(rkind) :: eDep, eFX, eFY, eScal, eFact, eArea + real(rkind) :: UGRAD, VGRAD, UGRAD1, VGRAD1 + real(rkind) :: eOff + logical DoPrintOut + INTEGER sumActive + INTEGER LIDX(2), KIDX(2), jdx + INTEGER IPglob1, IPglob2, IPglob3 #ifdef W3_DEBUGSTP - WRITE(740+IAPROC,*) 'Now exiting TRIG_WAVE_SETUP_COMPUTATION' - FLUSH(740+IAPROC) -#endif - END SUBROUTINE TRIG_WAVE_SETUP_COMPUTATION - !/ ------------------------------------------------------------------- / - !> - !> @brief Wave setup for FD grids. - !> - !> @param[in] IMOD - !> - !> @author Mathieu Dutour-Sikiric - !> @author Aron Roland - !> @date 1-May-2018 - !> - SUBROUTINE PREPARATION_FD_SCHEME(IMOD) - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | | - !/ | Mathieu Dutour-Sikiric (IRB) | - !/ | Aron Roland (BGS IT&E GmbH) | - !/ | | - !/ | FORTRAN 90 | - !/ | Last update : 01-Mai-2018 | - !/ +-----------------------------------+ - !/ - !/ 01-Mai-2018 : Origination. ( version 6.04 ) - !/ - ! 1. Purpose : Wave setup for FD grids - ! 2. Method : - ! 3. Parameters : - ! - ! Parameter list - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 4. Subroutines used : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! STRACE Subr. W3SERVMD Subroutine tracing. - ! ---------------------------------------------------------------- - ! - ! 5. Called by : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 6. Error messages : - ! 7. Remarks - ! 8. Structure : - ! 9. Switches : - ! - ! !/S Enable subroutine tracing. - ! - ! 10. Source code : - ! - !/ ------------------------------------------------------------------- / -#ifdef W3_S - USE W3SERVMD, ONLY: STRACE -#endif - ! - USE yowNodepool, only: PDLIB_NNZ, PDLIB_IA, PDLIB_JA, PDLIB_I_DIAG - USE W3GDATMD, ONLY: NX, NY, NSEA, MAPSF, GRIDS - IMPLICIT NONE - !/ - !/ ------------------------------------------------------------------- / - !/ Parameter list - !/ - !/ ------------------------------------------------------------------- / - !/ Local PARAMETERs - !/ -#ifdef W3_S - INTEGER, SAVE :: IENT = 0 -#endif - !/ - !/ ------------------------------------------------------------------- / - !/ -#ifdef W3_S - CALL STRACE (IENT, 'VA_SETUP_IOBPD') -#endif - ! - integer, intent(in) :: IMOD - integer IN, ISEA, nbEdge - integer IX, IY, idx - integer NeighMat(4,2) - integer, allocatable :: STAT_SeaLand(:,:) - integer, allocatable :: EDGES(:,:) - integer IXN, JXN, JSEA, J - ! - allocate(GRIDS(IMOD)%NEIGH(NSEA,4)) - GRIDS(IMOD)%NEIGH=0 - allocate(STAT_SeaLand(NX,NY)) - STAT_SeaLand=0 - DO ISEA=1,NSEA - IX=MAPSF(ISEA,1) - IY=MAPSF(ISEA,2) - STAT_SeaLand(IX,IY)=ISEA - END DO - NeighMat(1,1)=1 - NeighMat(1,2)=0 - NeighMat(2,1)=-1 - NeighMat(2,2)=0 - NeighMat(3,1)=0 - NeighMat(3,2)=1 - NeighMat(4,1)=0 - NeighMat(4,2)=-1 - nbEdge=0 - PDLIB_NNZ=0 - DO ISEA=1,NSEA - IX=MAPSF(ISEA,1) - IY=MAPSF(ISEA,2) - idx=0 - DO IN=1,4 - IXN=IX+NeighMat(IN,1) - JXN=IX+NeighMat(IN,2) - JSEA=STAT_SeaLand(IXN,JXN) - IF (JSEA .gt. 0) THEN - idx=idx+1 - GRIDS(IMOD)%NEIGH(ISEA,idx)=JSEA - IF (JSEA < ISEA) THEN - nbEdge=nbEdge+1 + REAL(rkind) :: ListDiag(npa) +#endif +#ifdef W3_S + CALL STRACE (IENT, 'VA_SETUP_IOBPD') +#endif + POS_TRICK(1,1) = 2 + POS_TRICK(1,2) = 3 + POS_TRICK(2,1) = 3 + POS_TRICK(2,2) = 1 + POS_TRICK(3,1) = 1 + POS_TRICK(3,2) = 2 + ASPAR=0 + B=0 + DO I=1,3 + DO J=1,3 + K= I-J+1 + IF (K .le. 0) THEN + K=K+3 END IF - PDLIB_NNZ=PDLIB_NNZ+1 - END IF + IF (K .ge. 4) THEN + K=K-3 + END IF + POS_SHIFT(I,J)=K + END DO END DO - PDLIB_NNZ=PDLIB_NNZ+1 - END DO - ! - GRIDS(IMOD)%NBEDGE=NBEDGE - ALLOCATE(GRIDS(IMOD)%EDGES(NBEDGE,2)) - idx=0 - DO ISEA=1,NSEA - IX=MAPSF(ISEA,1) - IY=MAPSF(ISEA,2) - DO IN=1,4 - IXN=IX+NeighMat(IN,1) - JXN=IX+NeighMat(IN,2) - JSEA=STAT_SeaLand(IXN,JXN) - IF (JSEA .gt. 0) THEN - IF (JSEA < ISEA) THEN - idx=idx+1 - GRIDS(IMOD)%EDGES(idx,1)=JSEA - GRIDS(IMOD)%EDGES(idx,2)=ISEA + DO I=1,3 + jdx=0 + DO IDX=1,3 + K=POS_SHIFT(I,IDX) + IF (K .ne. I) THEN + jdx=jdx+1 + LIDX(jdx)=IDX + KIDX(jdx)=K END IF - END IF + END DO + POS_SHIFT(I,LIDX(1))=KIDX(2) + POS_SHIFT(I,LIDX(2))=KIDX(1) END DO - END DO - ! - ALLOCATE(PDLIB_IA(NSEA+1)) - ALLOCATE(PDLIB_JA(PDLIB_NNZ)) - ALLOCATE(PDLIB_I_DIAG(NSEA)) - PDLIB_IA(1)=1 - J=0 - DO ISEA=1,NSEA - DO IN=1,4 - IXN=IX+NeighMat(IN,1) - JXN=IX+NeighMat(IN,2) - JSEA=STAT_SeaLand(IXN,JXN) - IF (JSEA .gt. 0) THEN - J=J+1 - PDLIB_JA(J)=JSEA + ACTIVESEC=0 + DO IE=1,ne + IP1=INE(1,IE) + IP2=INE(2,IE) + IP3=INE(3,IE) + eFX =(FX(IP1) + FX(IP2) + FX(IP3))/3 + eFY =(FY(IP1) + FY(IP2) + FY(IP3))/3 + sumActive=ACTIVE(IP1) + ACTIVE(IP2) + ACTIVE(IP3) + IF (sumActive .eq. 3) THEN + ACTIVESEC(IP1)=1 + ACTIVESEC(IP2)=1 + ACTIVESEC(IP3)=1 + eDep=(DWNX(IP1) + DWNX(IP2) + DWNX(IP3))/3.0 + eArea=PDLIB_TRIA(IE) + eFact=eDep*eArea + DO I1=1,3 + I2=POS_TRICK(I1,1) + I3=POS_TRICK(I1,2) + IP1=INE(I1,IE) + IP2=INE(I2,IE) + IP3=INE(I3,IE) + IDX1=PDLIB_JA_IE(I1,1,IE) + IDX2=PDLIB_JA_IE(I1,2,IE) + IDX3=PDLIB_JA_IE(I1,3,IE) + CALL TRIG_COMPUTE_DIFF(IE, I1, UGRAD1, VGRAD1) + eScal=UGRAD1*eFX + VGRAD1*eFY + B(IP1) = B(IP1) + eScal*eArea + ! + DO IDX=1,3 + K=POS_SHIFT(I1, IDX) + CALL TRIG_COMPUTE_DIFF(IE, K, UGRAD, VGRAD) + eScal=UGRAD*UGRAD1 + VGRAD*VGRAD1 + J=PDLIB_JA_IE(I1,IDX,IE) + ASPAR(J)=ASPAR(J) + eFact*eScal + END DO + END DO END IF END DO - J=J+1 - PDLIB_JA(J)=ISEA - PDLIB_I_DIAG(ISEA)=J - PDLIB_IA(ISEA+1)=J+1 - END DO - END SUBROUTINE PREPARATION_FD_SCHEME - !/ ------------------------------------------------------------------- / - !> - !> @brief Compute off diagonal for FD grids. - !> - !> @param[in] ASPAR - !> @param[in] TheIn - !> @param[out] TheOut - !> - !> @author Mathieu Dutour-Sikiric - !> @author Aron Roland - !> @date 1-May-2018 - !> - SUBROUTINE FD_WAVE_SETUP_APPLY_FCT(ASPAR, TheIn, TheOut) - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | | - !/ | Mathieu Dutour-Sikiric (IRB) | - !/ | Aron Roland (BGS IT&E GmbH) | - !/ | | - !/ | FORTRAN 90 | - !/ | Last update : 01-Mai-2018 | - !/ +-----------------------------------+ - !/ - !/ 01-Mai-2018 : Origination. ( version 6.04 ) - !/ - ! 1. Purpose : comp. off diagonal for FD grids - ! 2. Method : - ! 3. Parameters : - ! - ! Parameter list - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 4. Subroutines used : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! STRACE Subr. W3SERVMD Subroutine tracing. - ! ---------------------------------------------------------------- - ! - ! 5. Called by : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 6. Error messages : - ! 7. Remarks - ! 8. Structure : - ! 9. Switches : - ! - ! !/S Enable subroutine tracing. - ! - ! 10. Source code : - ! - !/ ------------------------------------------------------------------- / -#ifdef W3_S - USE W3SERVMD, ONLY: STRACE -#endif - ! - USE W3GDATMD, ONLY: NX, NNZ, IAA, JAA, NSEA - use yowNodepool, only: PDLIB_IA, PDLIB_JA - IMPLICIT NONE - !/ - !/ ------------------------------------------------------------------- / - !/ Parameter list - !/ - !/ ------------------------------------------------------------------- / - !/ Local PARAMETERs - !/ -#ifdef W3_S - INTEGER, SAVE :: IENT = 0 -#endif - !/ - !/ ------------------------------------------------------------------- / - !/ -#ifdef W3_S - CALL STRACE (IENT, 'VA_SETUP_IOBPD') -#endif - ! - REAL(8), intent(in) :: ASPAR(NNZ) - REAL(8), intent(in) :: TheIn(NSEA) - REAL(8), intent(out) :: TheOut(NSEA) - integer IP, J, JP - REAL(8) :: eCoeff - TheOut=0 - DO IP=1,NSEA - DO J=PDLIB_IA(IP),PDLIB_IA(IP+1)-1 - JP=PDLIB_JA(J) - eCoeff=ASPAR(J) - TheOut(IP)=TheOut(IP) + eCoeff*TheIn(JP) + DoPrintOut=.TRUE. + IF (DoPrintOut .eqv. .TRUE.) THEN + DO IP=1,NP + eOff=0 + END DO + END IF +#ifdef W3_DEBUGSTP + DO IP=1,npa + J=PDLIB_I_DIAG(IP) + ListDiag(IP)=ASPAR(J) END DO - END DO - END SUBROUTINE FD_WAVE_SETUP_APPLY_FCT - !/ ------------------------------------------------------------------- / - !> - !> @brief Preconditioning for FD grids. - !> - !> @param[in] ASPAR - !> @param[in] TheIn - !> @param[out] TheOut - !> - !> @author Mathieu Dutour-Sikiric - !> @author Aron Roland - !> @date 1-May-2018 - !> - SUBROUTINE FD_WAVE_SETUP_APPLY_PRECOND(ASPAR, TheIn, TheOut) - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | | - !/ | Mathieu Dutour-Sikiric (IRB) | - !/ | Aron Roland (BGS IT&E GmbH) | - !/ | | - !/ | FORTRAN 90 | - !/ | Last update : 01-Mai-2018 | - !/ +-----------------------------------+ - !/ - !/ 01-Mai-2018 : Origination. ( version 6.04 ) - !/ - ! 1. Purpose : Precond. for FD grids - ! 2. Method : - ! 3. Parameters : - ! - ! Parameter list - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 4. Subroutines used : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! STRACE Subr. W3SERVMD Subroutine tracing. - ! ---------------------------------------------------------------- - ! - ! 5. Called by : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 6. Error messages : - ! 7. Remarks - ! 8. Structure : - ! 9. Switches : - ! - ! !/S Enable subroutine tracing. - ! - ! 10. Source code : - ! - !/ ------------------------------------------------------------------- / -#ifdef W3_S - USE W3SERVMD, ONLY: STRACE -#endif - ! - USE yowNodepool, only: PDLIB_NNZ, PDLIB_IA, PDLIB_JA, PDLIB_I_DIAG - USE W3GDATMD, ONLY: NSEA - IMPLICIT NONE - !/ - !/ ------------------------------------------------------------------- / - !/ Parameter list - !/ - !/ ------------------------------------------------------------------- / - !/ Local PARAMETERs - !/ -#ifdef W3_S - INTEGER, SAVE :: IENT = 0 -#endif - !/ - !/ ------------------------------------------------------------------- / - !/ -#ifdef W3_S - CALL STRACE (IENT, 'VA_SETUP_IOBPD') -#endif - ! - REAL(8), intent(in) :: ASPAR(PDLIB_NNZ) - REAL(8), intent(in) :: TheIn(NSEA) - REAL(8), intent(out) :: TheOut(NSEA) - integer IP, J1, J, JP, J2 - REAL(8) :: eCoeff - INTEGER :: ThePrecond = 0 - IF (ThePrecond .eq. 0) THEN - TheOut=TheIn - END IF - IF (ThePrecond .eq. 1) THEN - TheOut=0 - DO IP=1,NSEA - J1=PDLIB_I_DIAG(IP) - DO J=PDLIB_IA(IP),PDLIB_IA(IP+1)-1 - JP=PDLIB_JA(J) - IF (J .eq. J1) THEN - eCoeff=1.0/ASPAR(J) + WRITE(740+IAPROC,*) 'Diag, min=', minval(ListDiag), ' max=', maxval(ListDiag) + WRITE(740+IAPROC,*) 'Diag, quot=', maxval(ListDiag)/minval(ListDiag) +#endif + END SUBROUTINE +!/ ------------------------------------------------------------------- / +!> +!> @brief Preconditioner. +!> +!> @param[in] ASPAR +!> @param[in] TheIn +!> @param[out] TheOut +!> @param[in] ACTIVE +!> @param[in] ACTIVESEC +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> + SUBROUTINE TRIG_WAVE_SETUP_APPLY_PRECOND(ASPAR, TheIn, TheOut, ACTIVE, ACTIVESEC) +!/ +!/ +-----------------------------------+ +!/ | WAVEWATCH III NOAA/NCEP | +!/ | | +!/ | Mathieu Dutour-Sikiric (IRB) | +!/ | Aron Roland (BGS IT&E GmbH) | +!/ | | +!/ | FORTRAN 90 | +!/ | Last update : 01-Mai-2018 | +!/ +-----------------------------------+ +!/ +!/ 01-Mai-2018 : Origination. ( version 6.04 ) +!/ +! 1. Purpose : preconditioner +! 2. Method : +! 3. Parameters : +! +! Parameter list +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 4. Subroutines used : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! STRACE Subr. W3SERVMD Subroutine tracing. +! ---------------------------------------------------------------- +! +! 5. Called by : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 6. Error messages : +! 7. Remarks +! 8. Structure : +! 9. Switches : +! +! !/S Enable subroutine tracing. +! +! 10. Source code : +! +!/ ------------------------------------------------------------------- / +#ifdef W3_S + USE W3SERVMD, ONLY: STRACE +#endif +! + use yowExchangeModule, only : PDLIB_exchange1Dreal + use yowNodepool, only: PDLIB_NNZ, PDLIB_IA, PDLIB_JA, PDLIB_I_DIAG + use yowNodepool, only: npa + USE W3ODATMD, only : IAPROC + USE W3ODATMD, only : IAPROC + USE yowNodepool, only: iplg + IMPLICIT NONE +!/ +!/ ------------------------------------------------------------------- / +!/ Parameter list +!/ +!/ ------------------------------------------------------------------- / +!/ Local PARAMETERs +!/ +#ifdef W3_S + INTEGER, SAVE :: IENT = 0 +#endif +!/ +!/ ------------------------------------------------------------------- / +!/ + REAL(rkind), intent(in) :: ASPAR(PDLIB_NNZ) + REAL(rkind), intent(in) :: TheIn(npa) + REAL(rkind), intent(out) :: TheOut(npa) + INTEGER, intent(IN) :: ACTIVE(npa), ACTIVESEC(npa) + integer IP, J1, J, JP, J2 + REAL(rkind) :: eCoeff + INTEGER :: ThePrecond = 2 +#ifdef W3_S + CALL STRACE (IENT, 'VA_SETUP_IOBPD') +#endif + IF (ThePrecond .eq. 0) THEN + TheOut=TheIn + END IF + IF (ThePrecond .eq. 1) THEN + TheOut=0 + DO IP=1,npa + IF (ACTIVE(IP) .eq. 1) THEN + J1=PDLIB_I_DIAG(IP) + DO J=PDLIB_IA(IP),PDLIB_IA(IP+1)-1 + JP=PDLIB_JA(J) + IF (ACTIVESEC(JP) .eq. 1) THEN + IF (J .eq. J1) THEN + eCoeff=1.0/ASPAR(J) + ELSE + J2=PDLIB_I_DIAG(JP) + eCoeff=-ASPAR(J) /(ASPAR(J1)*ASPAR(J2)) + END IF + TheOut(IP)=TheOut(IP) + eCoeff*TheIn(JP) + END IF + END DO + END IF + END DO + END IF + IF (ThePrecond .eq. 2) THEN + DO IP=1,npa + IF (ACTIVESEC(IP) .eq. 1) THEN + J=PDLIB_I_DIAG(IP) + TheOut(IP)=TheIn(IP)/ASPAR(J) ELSE - J2=PDLIB_I_DIAG(JP) - eCoeff=-ASPAR(J) /(ASPAR(J1)*ASPAR(J2)) + TheOut(IP)=TheIn(IP) END IF - TheOut(IP)=TheOut(IP) + eCoeff*TheIn(JP) END DO + END IF + CALL PDLIB_exchange1Dreal(TheOut) + END SUBROUTINE +!/ ------------------------------------------------------------------- / +!> +!> @brief +!> +!> @param[in] ASPAR +!> @param[in] TheIn +!> @param[out] TheOut +!> @param[in] ACTIVE +!> @param[in] ACTIVESEC +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> + SUBROUTINE TRIG_WAVE_SETUP_APPLY_FCT(ASPAR, TheIn, TheOut, ACTIVE, ACTIVESEC) +!/ +!/ +-----------------------------------+ +!/ | WAVEWATCH III NOAA/NCEP | +!/ | | +!/ | Mathieu Dutour-Sikiric (IRB) | +!/ | Aron Roland (BGS IT&E GmbH) | +!/ | | +!/ | FORTRAN 90 | +!/ | Last update : 01-Mai-2018 | +!/ +-----------------------------------+ +!/ +!/ 01-Mai-2018 : Origination. ( version 6.04 ) +!/ +! 1. Purpose : compute off diagonal contr. +! 2. Method : +! 3. Parameters : +! +! Parameter list +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 4. Subroutines used : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! STRACE Subr. W3SERVMD Subroutine tracing. +! ---------------------------------------------------------------- +! +! 5. Called by : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 6. Error messages : +! 7. Remarks +! 8. Structure : +! 9. Switches : +! +! !/S Enable subroutine tracing. +! +! 10. Source code : +! +!/ ------------------------------------------------------------------- / +#ifdef W3_S + USE W3SERVMD, ONLY: STRACE +#endif +! + use yowExchangeModule, only : PDLIB_exchange1Dreal + USE yowNodepool, only: PDLIB_IA, PDLIB_JA, PDLIB_NNZ + use yowNodepool, only: np, npa + USE W3GDATMD, ONLY: NSEAL + IMPLICIT NONE +!/ +!/ ------------------------------------------------------------------- / +!/ Parameter list +!/ +!/ ------------------------------------------------------------------- / +!/ Local PARAMETERs +!/ +#ifdef W3_S + INTEGER, SAVE :: IENT = 0 +#endif +!/ +!/ ------------------------------------------------------------------- / +!/ + REAL(rkind), intent(in) :: ASPAR(PDLIB_NNZ) + REAL(rkind), intent(in) :: TheIn(npa) + REAL(rkind), intent(out) :: TheOut(npa) + INTEGER, intent(in) :: ACTIVE(npa), ACTIVESEC(npa) + integer IP, J, JP + REAL(rkind) :: eCoeff +#ifdef W3_S + CALL STRACE (IENT, 'VA_SETUP_IOBPD') +#endif + TheOut=0 + DO IP=1,npa + IF (ACTIVESEC(IP) .eq. 1) THEN + DO J=PDLIB_IA(IP),PDLIB_IA(IP+1)-1 + JP=PDLIB_JA(J) + eCoeff=ASPAR(J) + TheOut(IP)=TheOut(IP) + eCoeff*TheIn(JP) + END DO + END IF END DO - END IF - IF (ThePrecond .eq. 2) THEN + CALL PDLIB_exchange1Dreal(TheOut) + END SUBROUTINE +!/ ------------------------------------------------------------------- / +!> +!> @brief Scalar product plus exchange. +!> +!> @param[in] V1 +!> @param[in] V2 +!> @param[inout] eScal +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> + SUBROUTINE TRIG_WAVE_SETUP_SCALAR_PROD(V1, V2, eScal) +!/ +!/ +-----------------------------------+ +!/ | WAVEWATCH III NOAA/NCEP | +!/ | | +!/ | Mathieu Dutour-Sikiric (IRB) | +!/ | Aron Roland (BGS IT&E GmbH) | +!/ | | +!/ | FORTRAN 90 | +!/ | Last update : 01-Mai-2018 | +!/ +-----------------------------------+ +!/ +!/ 01-Mai-2018 : Origination. ( version 6.04 ) +!/ +! 1. Purpose : scalar prod. + exchange +! 2. Method : +! 3. Parameters : +! +! Parameter list +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 4. Subroutines used : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! STRACE Subr. W3SERVMD Subroutine tracing. +! ---------------------------------------------------------------- +! +! 5. Called by : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 6. Error messages : +! 7. Remarks +! 8. Structure : +! 9. Switches : +! +! !/S Enable subroutine tracing. +! +! 10. Source code : +! +!/ ------------------------------------------------------------------- / +#ifdef W3_S + USE W3SERVMD, ONLY: STRACE +#endif +! + USE W3GDATMD, ONLY: NX + USE W3ADATMD, ONLY: MPI_COMM_WCMP + use yowDatapool, only: rtype, istatus + use yowNodepool, only: np, npa + USE W3ODATMD, only : IAPROC, NAPROC, NTPROC + USE W3GDATMD, ONLY: NSEAL + USE MPI, only : MPI_SUM + IMPLICIT NONE +!/ +!/ ------------------------------------------------------------------- / +!/ Parameter list +!/ +!/ ------------------------------------------------------------------- / +!/ Local PARAMETERs +!/ +#ifdef W3_S + INTEGER, SAVE :: IENT = 0 +#endif +!/ +!/ ------------------------------------------------------------------- / +!/ + real(rkind), intent(in) :: V1(npa), V2(npa) + real(rkind), intent(inout) :: eScal + integer IP + real(rkind) :: lScal_loc(1), lScal_gl(1) + integer ierr +#ifdef W3_S + CALL STRACE (IENT, 'VA_SETUP_IOBPD') +#endif + lScal_loc = 0 + DO IP=1,np + lScal_loc(1) = lScal_loc(1) + V1(IP)*V2(IP) + END DO + CALL MPI_ALLREDUCE(lScal_loc,lScal_gl,1,rtype,MPI_SUM,MPI_COMM_WCMP,ierr) + eScal = lScal_gl(1) + END SUBROUTINE +!/ ------------------------------------------------------------------- / +!> +!> @brief Poisson equation solver. +!> +!> @param[in] ASPAR +!> @param[in] B +!> @param[out] TheOut +!> @param[in] ACTIVE +!> @param[in] ACTIVESEC +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> + SUBROUTINE TRIG_WAVE_SETUP_SOLVE_POISSON_NEUMANN_DIR(ASPAR, B, TheOut, ACTIVE, ACTIVESEC) +!/ +!/ +-----------------------------------+ +!/ | WAVEWATCH III NOAA/NCEP | +!/ | | +!/ | Mathieu Dutour-Sikiric (IRB) | +!/ | Aron Roland (BGS IT&E GmbH) | +!/ | | +!/ | FORTRAN 90 | +!/ | Last update : 01-Mai-2018 | +!/ +-----------------------------------+ +!/ +!/ 01-Mai-2018 : Origination. ( version 6.04 ) +!/ +! 1. Purpose : poisson eq. solver +! 2. Method : +! 3. Parameters : +! +! Parameter list +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 4. Subroutines used : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! STRACE Subr. W3SERVMD Subroutine tracing. +! ---------------------------------------------------------------- +! +! 5. Called by : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 6. Error messages : +! 7. Remarks +! 8. Structure : +! 9. Switches : +! +! !/S Enable subroutine tracing. +! +! 10. Source code : +! +!/ ------------------------------------------------------------------- / +#ifdef W3_S + USE W3SERVMD, ONLY: STRACE +#endif +! + USE yowNodepool, only: PDLIB_NNZ + USE W3GDATMD, ONLY: NSEAL, SOLVERTHR_STP + USE W3ODATMD, only : IAPROC + use yowNodepool, only: np, npa + IMPLICIT NONE +!/ +!/ ------------------------------------------------------------------- / +!/ Parameter list +!/ +!/ ------------------------------------------------------------------- / +!/ Local PARAMETERs +!/ +#ifdef W3_S + INTEGER, SAVE :: IENT = 0 +#endif +!/ +!/ ------------------------------------------------------------------- / +!/ + real(rkind), intent(in) :: ASPAR(PDLIB_NNZ) + real(rkind), intent(in) :: B(npa) + real(rkind), intent(out) :: TheOut(npa) + integer, intent(in) :: ACTIVE(npa), ACTIVESEC(npa) + real(rkind) :: V_X(npa), V_R(npa), V_Z(npa), V_P(npa), V_Y(npa) + real(rkind) :: uO, uN, alphaV, h1, h2 + real(rkind) :: eNorm, beta + real(rkind) :: SOLVERTHR + integer IP, nbIter +#ifdef W3_S + CALL STRACE (IENT, 'VA_SETUP_IOBPD') +#endif + SOLVERTHR = SOLVERTHR_STP +#ifdef W3_DEBUGSTP + WRITE(740+IAPROC,*) 'Begin TRIG_WAVE_SETUP_SOLVE ....' + FLUSH(740+IAPROC) +#endif + nbIter=0 + V_X=0 + V_R=B + CALL TRIG_WAVE_SETUP_APPLY_PRECOND(ASPAR, V_R, V_Z, ACTIVE, ACTIVESEC) + V_P=V_Z + CALL TRIG_WAVE_SETUP_SCALAR_PROD(V_Z, V_R, uO) +#ifdef W3_DEBUGSTP + WRITE(740+IAPROC,*) 'uO=', uO + FLUSH(740+IAPROC) +#endif + CALL TRIG_WAVE_SETUP_SCALAR_PROD(B, B, eNorm) +#ifdef W3_DEBUGSTP + WRITE(740+IAPROC,*) 'eNorm(B)=', eNorm + WRITE(740+IAPROC,*) 'SOLVERTHR=', SOLVERTHR + WRITE(740+IAPROC,*) 'SOLVERTHR=', SOLVERTHR, ' eNorm(B)=', eNorm + FLUSH(740+IAPROC) +#endif + IF (eNorm .le. SOLVERTHR) THEN +#ifdef W3_DEBUGSTP + WRITE(740+IAPROC,*) 'Leaving here, zero solution' + FLUSH(740+IAPROC) +#endif + TheOut=V_X + RETURN + END IF + DO + nbIter=nbIter + 1 + CALL TRIG_WAVE_SETUP_APPLY_FCT(ASPAR, V_P, V_Y, ACTIVE, ACTIVESEC) + CALL TRIG_WAVE_SETUP_SCALAR_PROD(V_P, V_Y, h2) + alphaV=uO/h2 + ! + DO IP=1,npa + V_X(IP) = V_X(IP) + alphaV * V_P(IP) + V_R(IP) = V_R(IP) - alphaV * V_Y(IP) + END DO + ! + CALL TRIG_WAVE_SETUP_SCALAR_PROD(V_R, V_R, eNorm) +#ifdef W3_DEBUGSTP + WRITE(740+IAPROC,*) 'nbIter=', nbIter, ' eNorm(res)=', eNorm + FLUSH(740+IAPROC) +#endif + IF (eNorm .le. SOLVERTHR) THEN + EXIT + END IF + ! + CALL TRIG_WAVE_SETUP_APPLY_PRECOND(ASPAR, V_R, V_Z, ACTIVE, ACTIVESEC) + CALL TRIG_WAVE_SETUP_SCALAR_PROD(V_Z, V_R, uN) + ! + beta=uN/uO + uO=uN +#ifdef W3_DEBUGSTP + WRITE(740+IAPROC,*) ' beta=', beta, ' uN=', uN, ' alphaV=', alphaV, ' h2=', h2 + FLUSH(740+IAPROC) +#endif + ! + DO IP=1,npa + V_P(IP)=V_Z(IP) + beta * V_P(IP) + END DO + END DO + TheOut=V_X +#ifdef W3_DEBUGSTP + WRITE(740+IAPROC,*) 'TRIG_WAVE_SETUP_SOLVE_POISSON_NEUMANN_DIR, max/min=', maxval(TheOut), minval(TheOut) + FLUSH(740+IAPROC) +#endif + END SUBROUTINE +!/ ------------------------------------------------------------------- / +!> +!> @brief Set mean value. +!> +!> @param[inout] TheVar +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> + SUBROUTINE TRIG_SET_MEANVALUE_TO_ZERO(TheVar) +!/ +!/ +-----------------------------------+ +!/ | WAVEWATCH III NOAA/NCEP | +!/ | | +!/ | Mathieu Dutour-Sikiric (IRB) | +!/ | Aron Roland (BGS IT&E GmbH) | +!/ | | +!/ | FORTRAN 90 | +!/ | Last update : 01-Mai-2018 | +!/ +-----------------------------------+ +!/ +!/ 01-Mai-2018 : Origination. ( version 6.04 ) +!/ +! 1. Purpose : set. mean value +! 2. Method : +! 3. Parameters : +! +! Parameter list +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 4. Subroutines used : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! STRACE Subr. W3SERVMD Subroutine tracing. +! ---------------------------------------------------------------- +! +! 5. Called by : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 6. Error messages : +! 7. Remarks +! 8. Structure : +! 9. Switches : +! +! !/S Enable subroutine tracing. +! +! 10. Source code : +! +!/ ------------------------------------------------------------------- / +#ifdef W3_S + USE W3SERVMD, ONLY: STRACE +#endif +! + USE yowNodepool, only: PDLIB_SI + USE W3GDATMD, ONLY: NX, SI + USE W3GDATMD, ONLY: NSEAL + USE W3ADATMD, ONLY: MPI_COMM_WCMP + USE W3ODATMD, only : IAPROC, NAPROC, NTPROC + use yowDatapool, only: rtype, istatus + use yowNodepool, only: np, npa + USE MPI, only : MPI_SUM + IMPLICIT NONE +!/ +!/ ------------------------------------------------------------------- / +!/ Parameter list +!/ +!/ ------------------------------------------------------------------- / +!/ Local PARAMETERs +!/ +#ifdef W3_S + INTEGER, SAVE :: IENT = 0 +#endif +!/ +!/ ------------------------------------------------------------------- / +!/ + real(rkind), intent(inout) :: TheVar(npa) + real(rkind) :: SUM_SI_Var, SUM_SI, TheMean + INTEGER IP, ierr + real(rkind) :: eVect_loc(2), eVect_gl(2) + integer iProc +#ifdef W3_S + CALL STRACE (IENT, 'VA_SETUP_IOBPD') +#endif + SUM_SI_Var=0 + SUM_SI=0 + DO IP=1,np + SUM_SI_Var = SUM_SI_Var + PDLIB_SI(IP)*TheVar(IP) + SUM_SI = SUM_SI + PDLIB_SI(IP) + END DO + eVect_loc(1)=SUM_SI_Var + eVect_loc(2)=SUM_SI +#ifdef W3_DEBUGSTP + WRITE(740+IAPROC,*) 'SUM_SI_Var=', SUM_SI_Var, 'SUM_SI=', SUM_SI + FLUSH(740+IAPROC) +#endif + CALL MPI_ALLREDUCE(eVect_loc,eVect_gl,2,rtype,MPI_SUM,MPI_COMM_WCMP,ierr) + SUM_SI_Var=eVect_gl(1) + SUM_SI =eVect_gl(2) + TheMean=SUM_SI_Var/SUM_SI +#ifdef W3_DEBUGSTP + WRITE(740+IAPROC,*) 'TheMean=', TheMean + FLUSH(740+IAPROC) +#endif + DO IP=1,npa + TheVar(IP)=TheVar(IP) - TheMean + END DO + END SUBROUTINE +!/ ------------------------------------------------------------------- / +!> +!> @brief Compute active node for setup comp. +!> +!> @param[in] DWNX +!> @param[out] ACTIVE +!> +!> @author Aron Roland +!> @author Mathieu Dutour-Sikiric +!> @date 1-May-2018 +!> + SUBROUTINE COMPUTE_ACTIVE_NODE(DWNX, ACTIVE) +!/ +!/ +-----------------------------------+ +!/ | WAVEWATCH III NOAA/NCEP | +!/ | | +!/ | Aron Roland (BGS IT&E GmbH) | +!/ | Mathieu Dutour-Sikiric (IRB) | +!/ | | +!/ | FORTRAN 90 | +!/ | Last update : 01-Mai-2018 | +!/ +-----------------------------------+ +!/ +!/ 01-Mai-2018 : Origination. ( version 6.04 ) +!/ +! 1. Purpose : Compute active node for setup comp. +! 2. Method : +! 3. Parameters : +! +! Parameter list +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 4. Subroutines used : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! STRACE Subr. W3SERVMD Subroutine tracing. +! ---------------------------------------------------------------- +! +! 5. Called by : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 6. Error messages : +! 7. Remarks +! 8. Structure : +! 9. Switches : +! +! !/S Enable subroutine tracing. +! +! 10. Source code : +! +!/ ------------------------------------------------------------------- / +#ifdef W3_S + USE W3SERVMD, ONLY: STRACE +#endif +! + USE W3GDATMD, ONLY : CRIT_DEP_STP + USE yowNodepool, only: PDLIB_NNZ, PDLIB_IA, PDLIB_JA, iplg, npa, np + USE W3ODATMD, only : IAPROC + IMPLICIT NONE +!/ +!/ ------------------------------------------------------------------- / +!/ Parameter list +!/ +!/ ------------------------------------------------------------------- / +!/ Local PARAMETERs +!/ +#ifdef W3_S + INTEGER, SAVE :: IENT = 0 +#endif +!/ +!/ ------------------------------------------------------------------- / +!/ + REAL(rkind), INTENT(in) :: DWNX(npa) + INTEGER, INTENT(out) :: ACTIVE(npa) + INTEGER IP, eAct +#ifdef W3_DEBUGSTP + INTEGER nbActive +#endif +#ifdef W3_S + CALL STRACE (IENT, 'VA_SETUP_IOBPD') +#endif +#ifdef W3_DEBUGSTP + nbActive=0 +#endif + DO IP=1,NPA + IF (DWNX(IP) .ge. CRIT_DEP_STP) THEN + eAct=1 + ELSE + eAct=0 + END IF +#ifdef W3_DEBUGSTP + nbActive=nbActive + eAct +#endif + ACTIVE(IP)=eAct + END DO +#ifdef W3_DEBUGSTP + WRITE(740+IAPROC,*) 'min/max(DWNX)=', minval(DWNX), maxval(DWNX) + WRITE(740+IAPROC,*) 'CRIT_DEP_STP=', CRIT_DEP_STP + WRITE(740+IAPROC,*) 'nbActive=', nbActive, ' npa=', npa + FLUSH(740+IAPROC) +#endif + END SUBROUTINE +!/ ------------------------------------------------------------------- / +!> +!> @brief Setup computation. +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> + SUBROUTINE TRIG_WAVE_SETUP_COMPUTATION +!/ +!/ +-----------------------------------+ +!/ | WAVEWATCH III NOAA/NCEP | +!/ | | +!/ | Mathieu Dutour-Sikiric (IRB) | +!/ | Aron Roland (BGS IT&E GmbH) | +!/ | | +!/ | FORTRAN 90 | +!/ | Last update : 01-Mai-2018 | +!/ +-----------------------------------+ +!/ +!/ 01-Mai-2018 : Origination. ( version 6.04 ) +!/ +! 1. Purpose : Setup computation +! 2. Method : +! 3. Parameters : +! +! Parameter list +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 4. Subroutines used : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! STRACE Subr. W3SERVMD Subroutine tracing. +! ---------------------------------------------------------------- +! +! 5. Called by : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 6. Error messages : +! 7. Remarks +! 8. Structure : +! 9. Switches : +! +! !/S Enable subroutine tracing. +! +! 10. Source code : +! +!/ ------------------------------------------------------------------- / +#ifdef W3_S + USE W3SERVMD, ONLY: STRACE +#endif +! + USE yowNodepool, only: PDLIB_NNZ, PDLIB_IA, PDLIB_JA, iplg, npa, np + USE W3GDATMD, only : MAPFS + USE W3PARALL, only : SYNCHRONIZE_GLOBAL_ARRAY + USE W3ADATMD, ONLY: DW + USE W3GDATMD, ONLY: NSEAL, NSEA, NX + USE W3WDATMD, ONLY: ZETA_SETUP + USE W3ODATMD, only : IAPROC, NAPROC, NTPROC + USE W3PARALL, only: INIT_GET_ISEA + use yowExchangeModule, only : PDLIB_exchange1Dreal + IMPLICIT NONE +!/ +!/ ------------------------------------------------------------------- / +!/ Parameter list +!/ +!/ ------------------------------------------------------------------- / +!/ Local PARAMETERs +!/ +#ifdef W3_S + INTEGER, SAVE :: IENT = 0 +#endif +!/ +!/ ------------------------------------------------------------------- / +!/ +! +! CALL W3SETG + REAL(rkind) :: ZETA_WORK(npa) + REAL(rkind) :: ZETA_WORK_ALL(NX) + REAL(rkind) :: F_X(npa), F_Y(npa), DWNX(npa) + REAL(rkind) :: ASPAR(PDLIB_NNZ), B(npa) + INTEGER I, ISEA, JSEA, IX, IP, IP_glob + INTEGER :: ACTIVE(npa), ACTIVESEC(npa) + REAL(rkind) max_val, min_val +#ifdef W3_S + CALL STRACE (IENT, 'VA_SETUP_IOBPD') +#endif +! ZETA_SETUP is allocated on 1:NSEA +! ZETA_WORK is on 1:npa +#ifdef W3_DEBUGSTP + WRITE(740+IAPROC,*) 'NAPROC=', NAPROC, ' NTPROC=', NTPROC + WRITE(740+IAPROC,*) 'NSEAL=', NSEAL + WRITE(740+IAPROC,*) 'npa=', npa, ' np=', np + FLUSH(740+IAPROC) +#endif + ZETA_WORK=0 + DO IP=1,npa + IX=iplg(IP) + ISEA=MAPFS(1,IX) + IF (ISEA .gt. 0) THEN + ZETA_WORK(IP)=ZETA_SETUP(ISEA) + END IF + END DO +#ifdef W3_DEBUGSTP + WRITE(740+IAPROC,*) 'Before TRIG_COMPUTE_LH_STRESS' + FLUSH(740+IAPROC) +#endif + + CALL TRIG_COMPUTE_LH_STRESS(F_X, F_Y, DWNX) +#ifdef W3_DEBUGSTP + WRITE(740+IAPROC,*) 'After TRIG_COMPUTE_LH_STRESS' + FLUSH(740+IAPROC) +#endif + CALL COMPUTE_ACTIVE_NODE(DWNX, ACTIVE) +#ifdef W3_DEBUGSTP + WRITE(740+IAPROC,*) 'After COMPUTE_ACTIVE_NODE' + FLUSH(740+IAPROC) +#endif + CALL TRIG_WAVE_SETUP_COMPUTE_SYSTEM(ASPAR, B, F_X, F_Y, DWNX, ACTIVE, ACTIVESEC) +#ifdef W3_DEBUGSTP + WRITE(740+IAPROC,*) 'Before,B,min=', minval(B), ' max=', maxval(B) + FLUSH(740+IAPROC) +#endif + + +! CALL TRIG_SET_MEANVALUE_TO_ZERO(B) +#ifdef W3_DEBUGSTP + WRITE(740+IAPROC,*) 'After,B,min=', minval(B), ' max=', maxval(B) + FLUSH(740+IAPROC) +#endif + + + CALL TRIG_WAVE_SETUP_SOLVE_POISSON_NEUMANN_DIR(ASPAR, B, ZETA_WORK, ACTIVE, ACTIVESEC) + + CALL TRIG_SET_MEANVALUE_TO_ZERO(ZETA_WORK) +#ifdef W3_DEBUGSTP + WRITE(740+IAPROC,*) 'After SET_MEAN ZETA_WORK(min/max)=', minval(ZETA_WORK), maxval(ZETA_WORK) + FLUSH(740+IAPROC) +#endif + CALL PDLIB_exchange1Dreal(ZETA_WORK) + max_val = -100000000 + min_val = -100000000 + DO IP=1,npa + IX=iplg(IP) + ISEA=MAPFS(1,IX) + IF (ISEA .gt. 0) THEN + ZETA_SETUP(ISEA) = ZETA_WORK(IP) + max_val = MAX(max_Val, ZETA_WORK(IP)) + min_val = MAX(min_Val, ZETA_WORK(IP)) + END IF + END DO +#ifdef W3_DEBUGSTP + WRITE(740+IAPROC,*) 'TRIG_WAVE_SETUP_COMPUTATION, max/min=', max_val, min_val + FLUSH(740+IAPROC) +#endif + ZETA_WORK_ALL = 0. + DO IP = 1, npa + isea = iplg(IP) + ZETA_WORK_ALL(isea) = ZETA_WORK(IP) + END DO + CALL SYNCHRONIZE_GLOBAL_ARRAY(ZETA_WORK_ALL) + DO IX = 1, NX + ZETA_SETUP(IX) = ZETA_WORK_ALL(IX) + END DO + IF (IAPROC .EQ. 1) THEN + write(6666) 1. + write(6666) (ZETA_WORK_ALL(IX), ZETA_WORK_ALL(IX), ZETA_WORK_ALL(IX), IX = 1, NX) + ENDIF +#ifdef W3_DEBUGSTP + WRITE(740+IAPROC,*) 'Now exiting TRIG_WAVE_SETUP_COMPUTATION' + FLUSH(740+IAPROC) +#endif + END SUBROUTINE +!/ ------------------------------------------------------------------- / +!> +!> @brief Wave setup for FD grids. +!> +!> @param[in] IMOD +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> + SUBROUTINE PREPARATION_FD_SCHEME(IMOD) +!/ +!/ +-----------------------------------+ +!/ | WAVEWATCH III NOAA/NCEP | +!/ | | +!/ | Mathieu Dutour-Sikiric (IRB) | +!/ | Aron Roland (BGS IT&E GmbH) | +!/ | | +!/ | FORTRAN 90 | +!/ | Last update : 01-Mai-2018 | +!/ +-----------------------------------+ +!/ +!/ 01-Mai-2018 : Origination. ( version 6.04 ) +!/ +! 1. Purpose : Wave setup for FD grids +! 2. Method : +! 3. Parameters : +! +! Parameter list +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 4. Subroutines used : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! STRACE Subr. W3SERVMD Subroutine tracing. +! ---------------------------------------------------------------- +! +! 5. Called by : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 6. Error messages : +! 7. Remarks +! 8. Structure : +! 9. Switches : +! +! !/S Enable subroutine tracing. +! +! 10. Source code : +! +!/ ------------------------------------------------------------------- / +#ifdef W3_S + USE W3SERVMD, ONLY: STRACE +#endif +! + USE yowNodepool, only: PDLIB_NNZ, PDLIB_IA, PDLIB_JA, PDLIB_I_DIAG + USE W3GDATMD, ONLY: NX, NY, NSEA, MAPSF, GRIDS + IMPLICIT NONE +!/ +!/ ------------------------------------------------------------------- / +!/ Parameter list +!/ +!/ ------------------------------------------------------------------- / +!/ Local PARAMETERs +!/ +#ifdef W3_S + INTEGER, SAVE :: IENT = 0 +#endif +!/ +!/ ------------------------------------------------------------------- / +!/ + integer, intent(in) :: IMOD + integer IN, ISEA, nbEdge + integer IX, IY, idx + integer NeighMat(4,2) + integer, allocatable :: STAT_SeaLand(:,:) + integer, allocatable :: EDGES(:,:) + integer IXN, JXN, JSEA, J +#ifdef W3_S + CALL STRACE (IENT, 'VA_SETUP_IOBPD') +#endif + ! + allocate(GRIDS(IMOD)%NEIGH(NSEA,4)) + GRIDS(IMOD)%NEIGH=0 + allocate(STAT_SeaLand(NX,NY)) + STAT_SeaLand=0 + DO ISEA=1,NSEA + IX=MAPSF(ISEA,1) + IY=MAPSF(ISEA,2) + STAT_SeaLand(IX,IY)=ISEA + END DO + NeighMat(1,1)=1 + NeighMat(1,2)=0 + NeighMat(2,1)=-1 + NeighMat(2,2)=0 + NeighMat(3,1)=0 + NeighMat(3,2)=1 + NeighMat(4,1)=0 + NeighMat(4,2)=-1 + nbEdge=0 + PDLIB_NNZ=0 + DO ISEA=1,NSEA + IX=MAPSF(ISEA,1) + IY=MAPSF(ISEA,2) + idx=0 + DO IN=1,4 + IXN=IX+NeighMat(IN,1) + JXN=IX+NeighMat(IN,2) + JSEA=STAT_SeaLand(IXN,JXN) + IF (JSEA .gt. 0) THEN + idx=idx+1 + GRIDS(IMOD)%NEIGH(ISEA,idx)=JSEA + IF (JSEA < ISEA) THEN + nbEdge=nbEdge+1 + END IF + PDLIB_NNZ=PDLIB_NNZ+1 + END IF + END DO + PDLIB_NNZ=PDLIB_NNZ+1 + END DO + ! + GRIDS(IMOD)%NBEDGE=NBEDGE + ALLOCATE(GRIDS(IMOD)%EDGES(NBEDGE,2)) + idx=0 + DO ISEA=1,NSEA + IX=MAPSF(ISEA,1) + IY=MAPSF(ISEA,2) + DO IN=1,4 + IXN=IX+NeighMat(IN,1) + JXN=IX+NeighMat(IN,2) + JSEA=STAT_SeaLand(IXN,JXN) + IF (JSEA .gt. 0) THEN + IF (JSEA < ISEA) THEN + idx=idx+1 + GRIDS(IMOD)%EDGES(idx,1)=JSEA + GRIDS(IMOD)%EDGES(idx,2)=ISEA + END IF + END IF + END DO + END DO + ! + ALLOCATE(PDLIB_IA(NSEA+1)) + ALLOCATE(PDLIB_JA(PDLIB_NNZ)) + ALLOCATE(PDLIB_I_DIAG(NSEA)) + PDLIB_IA(1)=1 + J=0 + DO ISEA=1,NSEA + DO IN=1,4 + IXN=IX+NeighMat(IN,1) + JXN=IX+NeighMat(IN,2) + JSEA=STAT_SeaLand(IXN,JXN) + IF (JSEA .gt. 0) THEN + J=J+1 + PDLIB_JA(J)=JSEA + END IF + END DO + J=J+1 + PDLIB_JA(J)=ISEA + PDLIB_I_DIAG(ISEA)=J + PDLIB_IA(ISEA+1)=J+1 + END DO + END SUBROUTINE +!/ ------------------------------------------------------------------- / +!> +!> @brief Compute off diagonal for FD grids. +!> +!> @param[in] ASPAR +!> @param[in] TheIn +!> @param[out] TheOut +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> + SUBROUTINE FD_WAVE_SETUP_APPLY_FCT(ASPAR, TheIn, TheOut) +!/ +!/ +-----------------------------------+ +!/ | WAVEWATCH III NOAA/NCEP | +!/ | | +!/ | Mathieu Dutour-Sikiric (IRB) | +!/ | Aron Roland (BGS IT&E GmbH) | +!/ | | +!/ | FORTRAN 90 | +!/ | Last update : 01-Mai-2018 | +!/ +-----------------------------------+ +!/ +!/ 01-Mai-2018 : Origination. ( version 6.04 ) +!/ +! 1. Purpose : comp. off diagonal for FD grids +! 2. Method : +! 3. Parameters : +! +! Parameter list +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 4. Subroutines used : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! STRACE Subr. W3SERVMD Subroutine tracing. +! ---------------------------------------------------------------- +! +! 5. Called by : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 6. Error messages : +! 7. Remarks +! 8. Structure : +! 9. Switches : +! +! !/S Enable subroutine tracing. +! +! 10. Source code : +! +!/ ------------------------------------------------------------------- / +#ifdef W3_S + USE W3SERVMD, ONLY: STRACE +#endif +! + USE W3GDATMD, ONLY: NX, NNZ, IAA, JAA, NSEA + use yowNodepool, only: PDLIB_IA, PDLIB_JA + IMPLICIT NONE +!/ +!/ ------------------------------------------------------------------- / +!/ Parameter list +!/ +!/ ------------------------------------------------------------------- / +!/ Local PARAMETERs +!/ +#ifdef W3_S + INTEGER, SAVE :: IENT = 0 +#endif +!/ +!/ ------------------------------------------------------------------- / +!/ + REAL(rkind), intent(in) :: ASPAR(NNZ) + REAL(rkind), intent(in) :: TheIn(NSEA) + REAL(rkind), intent(out) :: TheOut(NSEA) + integer IP, J, JP + REAL(rkind) :: eCoeff +#ifdef W3_S + CALL STRACE (IENT, 'VA_SETUP_IOBPD') +#endif + TheOut=0 DO IP=1,NSEA - J=PDLIB_I_DIAG(IP) - TheOut(IP)=TheIn(IP)/ASPAR(J) + DO J=PDLIB_IA(IP),PDLIB_IA(IP+1)-1 + JP=PDLIB_JA(J) + eCoeff=ASPAR(J) + TheOut(IP)=TheOut(IP) + eCoeff*TheIn(JP) + END DO END DO - END IF - END SUBROUTINE FD_WAVE_SETUP_APPLY_PRECOND - !/ ------------------------------------------------------------------- / - !> - !> @brief Radiation stresses for FD grids. - !> - !> @param[out] SXX_t - !> @param[out] SXY_t - !> @param[out] SYY_t - !> - !> @author Mathieu Dutour-Sikiric - !> @author Aron Roland - !> @date 1-May-2018 - !> - SUBROUTINE FD_COLLECT_SXX_XY_YY(SXX_t, SXY_t, SYY_t) - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | | - !/ | Mathieu Dutour-Sikiric (IRB) | - !/ | Aron Roland (BGS IT&E GmbH) | - !/ | | - !/ | FORTRAN 90 | - !/ | Last update : 01-Mai-2018 | - !/ +-----------------------------------+ - !/ - !/ 01-Mai-2018 : Origination. ( version 6.04 ) - !/ - ! 1. Purpose : Rad. stresses for FD grids - ! 2. Method : - ! 3. Parameters : - ! - ! Parameter list - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 4. Subroutines used : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! STRACE Subr. W3SERVMD Subroutine tracing. - ! ---------------------------------------------------------------- - ! - ! 5. Called by : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 6. Error messages : - ! 7. Remarks - ! 8. Structure : - ! 9. Switches : - ! - ! !/S Enable subroutine tracing. - ! - ! 10. Source code : - ! - !/ ------------------------------------------------------------------- / -#ifdef W3_S - USE W3SERVMD, ONLY: STRACE -#endif - ! - USE W3ADATMD, ONLY: SXX, SXY, SYY - USE W3GDATMD, ONLY: NSEA, NSEAL - USE W3ODATMD, only : IAPROC, NAPROC - use yowDatapool, only: rtype, istatus - USE W3ADATMD, ONLY: MPI_COMM_WCMP - IMPLICIT NONE - !/ - !/ ------------------------------------------------------------------- / - !/ Parameter list - !/ - !/ ------------------------------------------------------------------- / - !/ Local PARAMETERs - !/ -#ifdef W3_S - INTEGER, SAVE :: IENT = 0 -#endif - !/ - !/ ------------------------------------------------------------------- / - !/ -#ifdef W3_S - CALL STRACE (IENT, 'VA_SETUP_IOBPD') -#endif - ! - integer ISEA, JSEA - integer ierr - real(8), intent(out) :: SXX_t(NSEA), SXY_t(NSEA), SYY_t(NSEA) - real(8) :: SXX_p(NSEAL), SXY_p(NSEAL), SYY_p(NSEAL) - real(8), allocatable :: rVect(:) - integer IPROC, NSEAL_loc - DO ISEA=1,NSEAL - SXX_p(ISEA)=SXX(ISEA) - SXY_p(ISEA)=SXY(ISEA) - SYY_p(ISEA)=SYY(ISEA) - END DO - IF (IAPROC .eq. 1) THEN - DO JSEA=1,NSEAL - ISEA=1 + (JSEA-1)*NAPROC - SXX_t(ISEA)=SXX_p(JSEA) - SXY_t(ISEA)=SXY_p(JSEA) - SYY_t(ISEA)=SYY_p(JSEA) + END SUBROUTINE +!/ ------------------------------------------------------------------- / +!> +!> @brief Preconditioning for FD grids. +!> +!> @param[in] ASPAR +!> @param[in] TheIn +!> @param[out] TheOut +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> + SUBROUTINE FD_WAVE_SETUP_APPLY_PRECOND(ASPAR, TheIn, TheOut) +!/ +!/ +-----------------------------------+ +!/ | WAVEWATCH III NOAA/NCEP | +!/ | | +!/ | Mathieu Dutour-Sikiric (IRB) | +!/ | Aron Roland (BGS IT&E GmbH) | +!/ | | +!/ | FORTRAN 90 | +!/ | Last update : 01-Mai-2018 | +!/ +-----------------------------------+ +!/ +!/ 01-Mai-2018 : Origination. ( version 6.04 ) +!/ +! 1. Purpose : Precond. for FD grids +! 2. Method : +! 3. Parameters : +! +! Parameter list +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 4. Subroutines used : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! STRACE Subr. W3SERVMD Subroutine tracing. +! ---------------------------------------------------------------- +! +! 5. Called by : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 6. Error messages : +! 7. Remarks +! 8. Structure : +! 9. Switches : +! +! !/S Enable subroutine tracing. +! +! 10. Source code : +! +!/ ------------------------------------------------------------------- / +#ifdef W3_S + USE W3SERVMD, ONLY: STRACE +#endif +! + USE yowNodepool, only: PDLIB_NNZ, PDLIB_IA, PDLIB_JA, PDLIB_I_DIAG + USE W3GDATMD, ONLY: NSEA + IMPLICIT NONE +!/ +!/ ------------------------------------------------------------------- / +!/ Parameter list +!/ +!/ ------------------------------------------------------------------- / +!/ Local PARAMETERs +!/ +#ifdef W3_S + INTEGER, SAVE :: IENT = 0 +#endif +!/ +!/ ------------------------------------------------------------------- / +!/ + REAL(rkind), intent(in) :: ASPAR(PDLIB_NNZ) + REAL(rkind), intent(in) :: TheIn(NSEA) + REAL(rkind), intent(out) :: TheOut(NSEA) + integer IP, J1, J, JP, J2 + REAL(rkind) :: eCoeff + INTEGER :: ThePrecond = 0 +#ifdef W3_S + CALL STRACE (IENT, 'VA_SETUP_IOBPD') +#endif + IF (ThePrecond .eq. 0) THEN + TheOut=TheIn + END IF + IF (ThePrecond .eq. 1) THEN + TheOut=0 + DO IP=1,NSEA + J1=PDLIB_I_DIAG(IP) + DO J=PDLIB_IA(IP),PDLIB_IA(IP+1)-1 + JP=PDLIB_JA(J) + IF (J .eq. J1) THEN + eCoeff=1.0/ASPAR(J) + ELSE + J2=PDLIB_I_DIAG(JP) + eCoeff=-ASPAR(J) /(ASPAR(J1)*ASPAR(J2)) + END IF + TheOut(IP)=TheOut(IP) + eCoeff*TheIn(JP) + END DO + END DO + END IF + IF (ThePrecond .eq. 2) THEN + + DO IP=1,NSEA + J=PDLIB_I_DIAG(IP) + TheOut(IP)=TheIn(IP)/ASPAR(J) + END DO + END IF + END SUBROUTINE +!/ ------------------------------------------------------------------- / +!> +!> @brief Radiation stresses for FD grids. +!> +!> @param[out] SXX_t +!> @param[out] SXY_t +!> @param[out] SYY_t +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> + SUBROUTINE FD_COLLECT_SXX_XY_YY(SXX_t, SXY_t, SYY_t) +!/ +!/ +-----------------------------------+ +!/ | WAVEWATCH III NOAA/NCEP | +!/ | | +!/ | Mathieu Dutour-Sikiric (IRB) | +!/ | Aron Roland (BGS IT&E GmbH) | +!/ | | +!/ | FORTRAN 90 | +!/ | Last update : 01-Mai-2018 | +!/ +-----------------------------------+ +!/ +!/ 01-Mai-2018 : Origination. ( version 6.04 ) +!/ +! 1. Purpose : Rad. stresses for FD grids +! 2. Method : +! 3. Parameters : +! +! Parameter list +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 4. Subroutines used : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! STRACE Subr. W3SERVMD Subroutine tracing. +! ---------------------------------------------------------------- +! +! 5. Called by : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 6. Error messages : +! 7. Remarks +! 8. Structure : +! 9. Switches : +! +! !/S Enable subroutine tracing. +! +! 10. Source code : +! +!/ ------------------------------------------------------------------- / +#ifdef W3_S + USE W3SERVMD, ONLY: STRACE +#endif +! + USE W3ADATMD, ONLY: SXX, SXY, SYY + USE W3GDATMD, ONLY: NSEA, NSEAL + USE W3ODATMD, only : IAPROC, NAPROC + use yowDatapool, only: rtype, istatus + USE W3ADATMD, ONLY: MPI_COMM_WCMP + IMPLICIT NONE +!/ +!/ ------------------------------------------------------------------- / +!/ Parameter list +!/ +!/ ------------------------------------------------------------------- / +!/ Local PARAMETERs +!/ +#ifdef W3_S + INTEGER, SAVE :: IENT = 0 +#endif +!/ +!/ ------------------------------------------------------------------- / +!/ + integer ISEA, JSEA + integer ierr + real(rkind), intent(out) :: SXX_t(NSEA), SXY_t(NSEA), SYY_t(NSEA) + real(rkind) :: SXX_p(NSEAL), SXY_p(NSEAL), SYY_p(NSEAL) + real(rkind), allocatable :: rVect(:) + integer IPROC, NSEAL_loc +#ifdef W3_S + CALL STRACE (IENT, 'VA_SETUP_IOBPD') +#endif + DO ISEA=1,NSEAL + SXX_p(ISEA)=SXX(ISEA) + SXY_p(ISEA)=SXY(ISEA) + SYY_p(ISEA)=SYY(ISEA) END DO - DO IPROC=2,NAPROC - NSEAL_loc=1 + (NSEA-IPROC)/NAPROC - allocate(rVect(NSEAL_loc)) - CALL MPI_RECV(rVect,NSEAL_loc,rtype, iProc-1, 83, MPI_COMM_WCMP, istatus, ierr) - DO JSEA=1,NSEAL_loc - ISEA = IPROC + (JSEA-1)*NAPROC - SXX_t(ISEA)=rVect(JSEA) + IF (IAPROC .eq. 1) THEN + DO JSEA=1,NSEAL + ISEA=1 + (JSEA-1)*NAPROC + SXX_t(ISEA)=SXX_p(JSEA) + SXY_t(ISEA)=SXY_p(JSEA) + SYY_t(ISEA)=SYY_p(JSEA) END DO - CALL MPI_RECV(rVect,NSEAL_loc,rtype, iProc-1, 89, MPI_COMM_WCMP, istatus, ierr) - DO JSEA=1,NSEAL_loc - ISEA = IPROC + (JSEA-1)*NAPROC - SXY_t(ISEA)=rVect(JSEA) - END DO - CALL MPI_RECV(rVect,NSEAL_loc,rtype, iProc-1, 97, MPI_COMM_WCMP, istatus, ierr) - DO JSEA=1,NSEAL_loc - ISEA = IPROC + (JSEA-1)*NAPROC - SYY_t(ISEA)=rVect(JSEA) + DO IPROC=2,NAPROC + NSEAL_loc=1 + (NSEA-IPROC)/NAPROC + allocate(rVect(NSEAL_loc)) + CALL MPI_RECV(rVect,NSEAL_loc,rtype, iProc-1, 83, MPI_COMM_WCMP, istatus, ierr) + DO JSEA=1,NSEAL_loc + ISEA = IPROC + (JSEA-1)*NAPROC + SXX_t(ISEA)=rVect(JSEA) + END DO + CALL MPI_RECV(rVect,NSEAL_loc,rtype, iProc-1, 89, MPI_COMM_WCMP, istatus, ierr) + DO JSEA=1,NSEAL_loc + ISEA = IPROC + (JSEA-1)*NAPROC + SXY_t(ISEA)=rVect(JSEA) + END DO + CALL MPI_RECV(rVect,NSEAL_loc,rtype, iProc-1, 97, MPI_COMM_WCMP, istatus, ierr) + DO JSEA=1,NSEAL_loc + ISEA = IPROC + (JSEA-1)*NAPROC + SYY_t(ISEA)=rVect(JSEA) + END DO + deallocate(rVect) END DO - deallocate(rVect) - END DO - ELSE - CALL MPI_SEND(SXX_p,NSEAL,rtype, 0, 83, MPI_COMM_WCMP, ierr) - CALL MPI_SEND(SXY_p,NSEAL,rtype, 0, 83, MPI_COMM_WCMP, ierr) - CALL MPI_SEND(SYY_p,NSEAL,rtype, 0, 83, MPI_COMM_WCMP, ierr) - END IF - END SUBROUTINE FD_COLLECT_SXX_XY_YY - !/ ------------------------------------------------------------------- / - !> - !> @brief Setup fluxes. - !> - !> @param[in] SXX_t - !> @param[in] SXY_t - !> @param[in] SYY_t - !> @param[out] FX - !> @param[out] FY - !> - !> @author Mathieu Dutour-Sikiric - !> @author Aron Roland - !> @date 1-May-2018 - !> - SUBROUTINE FD_COMPUTE_LH_STRESS(SXX_t, SXY_t, SYY_t, FX, FY) - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | | - !/ | Mathieu Dutour-Sikiric (IRB) | - !/ | Aron Roland (BGS IT&E GmbH) | - !/ | | - !/ | FORTRAN 90 | - !/ | Last update : 01-Mai-2018 | - !/ +-----------------------------------+ - !/ - !/ 01-Mai-2018 : Origination. ( version 6.04 ) - !/ - ! 1. Purpose : setup fluxes - ! 2. Method : - ! 3. Parameters : - ! - ! Parameter list - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 4. Subroutines used : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! STRACE Subr. W3SERVMD Subroutine tracing. - ! ---------------------------------------------------------------- - ! - ! 5. Called by : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 6. Error messages : - ! 7. Remarks - ! 8. Structure : - ! 9. Switches : - ! - ! !/S Enable subroutine tracing. - ! - ! 10. Source code : - ! - !/ ------------------------------------------------------------------- / -#ifdef W3_S - USE W3SERVMD, ONLY: STRACE -#endif - ! - USE W3GDATMD, ONLY: NX, NY, NSEA, NEIGH - USE W3ADATMD, ONLY: SXX, SXY, SYY - IMPLICIT NONE - !/ - !/ ------------------------------------------------------------------- / - !/ Parameter list - !/ - !/ ------------------------------------------------------------------- / - !/ Local PARAMETERs - !/ -#ifdef W3_S - INTEGER, SAVE :: IENT = 0 -#endif - !/ - !/ ------------------------------------------------------------------- / - !/ -#ifdef W3_S - CALL STRACE (IENT, 'VA_SETUP_IOBPD') -#endif - ! - real(8), intent(in) :: SXX_t(NSEA), SXY_t(NSEA), SYY_t(NSEA) - real(8), intent(out) :: FX(NSEA), FY(NSEA) - REAL(8) :: h - REAL(8) :: SXX_X, SXX_Y - REAL(8) :: SXY_X, SXY_Y - REAL(8) :: SYY_X, SYY_Y - REAL(8) :: eFX, eFY - REAL(8) :: UGRAD, VGRAD - INTEGER IE, I1, I2, I3, IP1, IP2, IP3 - integer ISEA, JSEA1, JSEA2, JSEA3, JSEA4 - integer NeighMat(4,2) - real(8) dist_X, dist_Y - ! - NeighMat(1,1)=1 - NeighMat(1,2)=0 - NeighMat(2,1)=-1 - NeighMat(2,2)=0 - NeighMat(3,1)=0 - NeighMat(3,2)=1 - NeighMat(4,1)=0 - NeighMat(4,2)=-1 - FX=0 - FY=0 - DO ISEA=1,NSEA - JSEA1=NEIGH(ISEA,1) - JSEA2=NEIGH(ISEA,2) - JSEA3=NEIGH(ISEA,3) - JSEA4=NEIGH(ISEA,4) - SXX_X=0 - SXX_Y=0 - SXY_X=0 - SXY_Y=0 - SYY_X=0 - SYY_Y=0 - IF ((JSEA1 .gt. 0).and.(JSEA2 .gt. 0)) THEN - SXX_X=(SXX(JSEA1) - SXX(JSEA2))/(2*dist_X) - SXY_X=(SXY(JSEA1) - SXY(JSEA2))/(2*dist_X) - SYY_X=(SXY(JSEA1) - SYY(JSEA2))/(2*dist_X) - END IF - IF ((JSEA1 .gt. 0).and.(JSEA2 .eq. 0)) THEN - SXX_X=(SXX(JSEA1) - SXX(ISEA ))/dist_X - SXY_X=(SXY(JSEA1) - SXY(ISEA ))/dist_X - SYY_X=(SXY(JSEA1) - SYY(ISEA ))/dist_X - END IF - IF ((JSEA1 .eq. 0).and.(JSEA2 .gt. 0)) THEN - SXX_X=(SXX(ISEA ) - SXX(JSEA2))/dist_X - SXY_X=(SXY(ISEA ) - SXY(JSEA2))/dist_X - SYY_X=(SXY(ISEA ) - SYY(JSEA2))/dist_X - END IF - IF ((JSEA3 .gt. 0).and.(JSEA4 .gt. 0)) THEN - SXX_X=(SXX(JSEA3) - SXX(JSEA4))/(2*dist_Y) - SXY_X=(SXY(JSEA3) - SXY(JSEA4))/(2*dist_Y) - SYY_X=(SXY(JSEA3) - SYY(JSEA4))/(2*dist_Y) - END IF - IF ((JSEA3 .eq. 0).and.(JSEA4 .gt. 0)) THEN - SXX_X=(SXX(ISEA ) - SXX(JSEA4))/dist_Y - SXY_X=(SXY(ISEA ) - SXY(JSEA4))/dist_Y - SYY_X=(SXY(ISEA ) - SYY(JSEA4))/dist_Y - END IF - IF ((JSEA3 .gt. 0).and.(JSEA4 .gt. 0)) THEN - SXX_X=(SXX(JSEA3) - SXX(ISEA ))/dist_Y - SXY_X=(SXY(JSEA3) - SXY(ISEA ))/dist_Y - SYY_X=(SXY(JSEA3) - SYY(ISEA ))/dist_Y + ELSE + CALL MPI_SEND(SXX_p,NSEAL,rtype, 0, 83, MPI_COMM_WCMP, ierr) + CALL MPI_SEND(SXY_p,NSEAL,rtype, 0, 83, MPI_COMM_WCMP, ierr) + CALL MPI_SEND(SYY_p,NSEAL,rtype, 0, 83, MPI_COMM_WCMP, ierr) END IF - eFX=-SXX_X - SXY_Y - eFY=-SYY_Y - SXY_X - FX(ISEA)=eFX - FY(ISEA)=eFY - END DO - END SUBROUTINE FD_COMPUTE_LH_STRESS - !/ ------------------------------------------------------------------- / - !> - !> @brief Differences on FD grids. - !> - !> @param[in] IEDGE - !> @param[in] ISEA - !> @param[inout] UGRAD - !> @param[inout] VGRAD - !> @param[inout] dist - !> - !> @author Mathieu Dutour-Sikiric - !> @author Aron Roland - !> @date 1-May-2018 - !> - SUBROUTINE FD_COMPUTE_DIFF(IEDGE, ISEA, UGRAD, VGRAD, dist) - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | | - !/ | Mathieu Dutour-Sikiric (IRB) | - !/ | Aron Roland (BGS IT&E GmbH) | - !/ | | - !/ | FORTRAN 90 | - !/ | Last update : 01-Mai-2018 | - !/ +-----------------------------------+ - !/ - !/ 01-Mai-2018 : Origination. ( version 6.04 ) - !/ - ! 1. Purpose : differences on FD grids - ! 2. Method : - ! 3. Parameters : - ! - ! Parameter list - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 4. Subroutines used : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! STRACE Subr. W3SERVMD Subroutine tracing. - ! ---------------------------------------------------------------- - ! - ! 5. Called by : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 6. Error messages : - ! 7. Remarks - ! 8. Structure : - ! 9. Switches : - ! - ! !/S Enable subroutine tracing. - ! - ! 10. Source code : - ! - !/ ------------------------------------------------------------------- / -#ifdef W3_S - USE W3SERVMD, ONLY: STRACE -#endif - ! - USE W3GDATMD, ONLY: MAPSF, EDGES - USE W3GDATMD, ONLY: XGRD, YGRD - IMPLICIT NONE - !/ - !/ ------------------------------------------------------------------- / - !/ Parameter list - !/ - !/ ------------------------------------------------------------------- / - !/ Local PARAMETERs - !/ -#ifdef W3_S - INTEGER, SAVE :: IENT = 0 -#endif - !/ - !/ ------------------------------------------------------------------- / - !/ -#ifdef W3_S - CALL STRACE (IENT, 'VA_SETUP_IOBPD') -#endif - ! - INTEGER, intent(in) :: IEDGE, ISEA - REAL(8), intent(inout) :: UGRAD, VGRAD, dist - REAL(8) :: h - integer I2, I3, IP1, IP2, IP3 - integer IX1, IY1, IX2, IY2 - integer ISEA1, ISEA2 - REAL(8) deltaX, deltaY - ! - ISEA1=EDGES(IEDGE,1) - ISEA2=EDGES(IEDGE,2) - IX1=MAPSF(ISEA1,1) - IY1=MAPSF(ISEA1,2) - IX2=MAPSF(ISEA2,1) - IY2=MAPSF(ISEA2,2) - deltaX=XGRD(IX1,IY1) - XGRD(IX2,IY2) - deltaY=YGRD(IX1,IY1) - YGRD(IX2,IY2) - dist=SQRT(deltaX*deltaX + deltaY*deltaY) - IF (ISEA .eq. ISEA1) THEN - UGRAD= deltaX/dist - VGRAD= deltaY/dist - ELSE - UGRAD=-deltaX/dist - VGRAD=-deltaY/dist - END IF - END SUBROUTINE FD_COMPUTE_DIFF - !/ ------------------------------------------------------------------- / - !> - !> @brief Setup matrix on FD grids. - !> - !> @param[out] ASPAR - !> @param[out] B - !> @param[in] FX - !> @param[in] FY - !> - !> @author Mathieu Dutour-Sikiric - !> @author Aron Roland - !> @date 1-May-2018 - !> - SUBROUTINE FD_WAVE_SETUP_COMPUTE_SYSTEM(ASPAR, B, FX, FY) - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | | - !/ | Mathieu Dutour-Sikiric (IRB) | - !/ | Aron Roland (BGS IT&E GmbH) | - !/ | | - !/ | FORTRAN 90 | - !/ | Last update : 01-Mai-2018 | - !/ +-----------------------------------+ - !/ - !/ 01-Mai-2018 : Origination. ( version 6.04 ) - !/ - ! 1. Purpose : Setup matrix on FD grids - ! 2. Method : - ! 3. Parameters : - ! - ! Parameter list - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 4. Subroutines used : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! STRACE Subr. W3SERVMD Subroutine tracing. - ! ---------------------------------------------------------------- - ! - ! 5. Called by : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 6. Error messages : - ! 7. Remarks - ! 8. Structure : - ! 9. Switches : - ! - ! !/S Enable subroutine tracing. - ! - ! 10. Source code : - ! - !/ ------------------------------------------------------------------- / -#ifdef W3_S - USE W3SERVMD, ONLY: STRACE -#endif - ! - USE yowNodepool, only: PDLIB_NNZ - USE W3GDATMD, ONLY: NX, NY, NSEA, NBEDGE, EDGES - USE W3ADATMD, ONLY: DW - IMPLICIT NONE - !/ - !/ ------------------------------------------------------------------- / - !/ Parameter list - !/ - !/ ------------------------------------------------------------------- / - !/ Local PARAMETERs - !/ -#ifdef W3_S - INTEGER, SAVE :: IENT = 0 -#endif - !/ - !/ ------------------------------------------------------------------- / - !/ -#ifdef W3_S - CALL STRACE (IENT, 'VA_SETUP_IOBPD') -#endif - ! - real(8), intent(in) :: FX(NSEA), FY(NSEA) - real(8), intent(out) :: ASPAR(PDLIB_NNZ) - real(8), intent(out) :: B(NX) - INTEGER :: POS_TRICK(3,2), POS_SHIFT(3,3) - integer I1, I2, I3, IP1, IP2, IP3 - integer IDX, IDX1, IDX2, IDX3 - INTEGER IE, IP, I, J, K, IPp, JPp - real(8) :: eDep, eFX, eFY, eScal, eFact, eLen - real(8) :: UGRAD, VGRAD, UGRAD1, VGRAD1, dist1, dist2 - INTEGER LIDX(2), KIDX(2), jdx - INTEGER ISEAREL, JSEAREL, ISEA, JSEA, IEDGE - ! - ASPAR=0 - B=0 - DO IEDGE=1,NBEDGE - ISEA=EDGES(IEDGE,1) - JSEA=EDGES(IEDGE,2) - eDep=(DW(ISEA) + DW(JSEA))/2.0 - eFX =(FX(ISEA) + FX(JSEA))/2.0 - eFY =(FY(ISEA) + FY(JSEA))/2.0 - DO I=1,2 - ISEAREL=EDGES(IEDGE,I) - CALL FD_COMPUTE_DIFF(IEDGE, ISEAREL, UGRAD1, VGRAD1, dist1) - eScal=UGRAD1*eFX + VGRAD1*eFY - B(ISEAREL) = B(ISEAREL) + eScal*dist1 - ! - DO J=1,2 - JSEAREL=EDGES(IEDGE,J) - CALL FD_COMPUTE_DIFF(IEDGE, JSEAREL, UGRAD, VGRAD, dist2) - eScal=UGRAD*UGRAD1 + VGRAD*VGRAD1 - ASPAR(J)=ASPAR(J)+eFact*eScal - END DO - END DO - END DO - END SUBROUTINE FD_WAVE_SETUP_COMPUTE_SYSTEM - !/ ------------------------------------------------------------------- / - !> - !> @brief Scalar product. - !> - !> @param[in] V1 - !> @param[in] V2 - !> @param[inout] eScal - !> - !> @author Mathieu Dutour-Sikiric - !> @author Aron Roland - !> @date 1-May-2018 - !> - SUBROUTINE FD_WAVE_SETUP_SCALAR_PROD(V1, V2, eScal) - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | | - !/ | Mathieu Dutour-Sikiric (IRB) | - !/ | Aron Roland (BGS IT&E GmbH) | - !/ | | - !/ | FORTRAN 90 | - !/ | Last update : 01-Mai-2018 | - !/ +-----------------------------------+ - !/ - !/ 01-Mai-2018 : Origination. ( version 6.04 ) - !/ - ! 1. Purpose : scalar prod. - ! 2. Method : - ! 3. Parameters : - ! - ! Parameter list - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 4. Subroutines used : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! STRACE Subr. W3SERVMD Subroutine tracing. - ! ---------------------------------------------------------------- - ! - ! 5. Called by : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 6. Error messages : - ! 7. Remarks - ! 8. Structure : - ! 9. Switches : - ! - ! !/S Enable subroutine tracing. - ! - ! 10. Source code : - ! - !/ ------------------------------------------------------------------- / -#ifdef W3_S - USE W3SERVMD, ONLY: STRACE -#endif - ! - USE W3GDATMD, ONLY: NX - IMPLICIT NONE - !/ - !/ ------------------------------------------------------------------- / - !/ Parameter list - !/ - !/ ------------------------------------------------------------------- / - !/ Local PARAMETERs - !/ -#ifdef W3_S - INTEGER, SAVE :: IENT = 0 -#endif - !/ - !/ ------------------------------------------------------------------- / - !/ -#ifdef W3_S - CALL STRACE (IENT, 'VA_SETUP_IOBPD') -#endif - ! - real(8), intent(in) :: V1(NX), V2(NX) - real(8), intent(inout) :: eScal - integer IP - eScal=0 - DO IP=1,NX - eScal=eScal + V1(IP)*V2(IP) - END DO - END SUBROUTINE FD_WAVE_SETUP_SCALAR_PROD - !/ ------------------------------------------------------------------- / - !> - !> @brief Poisson solver on FD grids. - !> - !> @param[in] ASPAR - !> @param[in] B - !> @param[out] TheOut - !> - !> @author Mathieu Dutour-Sikiric - !> @author Aron Roland - !> @date 1-May-2018 - !> - SUBROUTINE FD_WAVE_SETUP_SOLVE_POISSON_NEUMANN_DIR(ASPAR, B, TheOut) - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | | - !/ | Mathieu Dutour-Sikiric (IRB) | - !/ | Aron Roland (BGS IT&E GmbH) | - !/ | | - !/ | FORTRAN 90 | - !/ | Last update : 01-Mai-2018 | - !/ +-----------------------------------+ - !/ - !/ 01-Mai-2018 : Origination. ( version 6.04 ) - !/ - ! 1. Purpose : possoin solver on fd grids - ! 2. Method : - ! 3. Parameters : - ! - ! Parameter list - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 4. Subroutines used : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! STRACE Subr. W3SERVMD Subroutine tracing. - ! ---------------------------------------------------------------- - ! - ! 5. Called by : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 6. Error messages : - ! 7. Remarks - ! 8. Structure : - ! 9. Switches : - ! - ! !/S Enable subroutine tracing. - ! - ! 10. Source code : - ! - !/ ------------------------------------------------------------------- / -#ifdef W3_S - USE W3SERVMD, ONLY: STRACE -#endif - ! - USE yowNodepool, only: PDLIB_NNZ - USE W3GDATMD, ONLY: NX - IMPLICIT NONE - !/ - !/ ------------------------------------------------------------------- / - !/ Parameter list - !/ - !/ ------------------------------------------------------------------- / - !/ Local PARAMETERs - !/ -#ifdef W3_S - INTEGER, SAVE :: IENT = 0 -#endif - !/ - !/ ------------------------------------------------------------------- / - !/ -#ifdef W3_S - CALL STRACE (IENT, 'VA_SETUP_IOBPD') -#endif - ! - real(8), intent(in) :: ASPAR(PDLIB_NNZ) - real(8), intent(in) :: B(NX) - real(8), intent(out) :: TheOut(NX) - real(8) :: V_X(NX), V_R(NX), V_Z(NX), V_P(NX), V_Y(NX) - real(8) :: uO, uN, alphaV, h1, h2 - real(8) :: eNorm, beta - real(8) :: SOLVERTHR - integer IP, nbIter - SOLVERTHR=0.00000001 - nbIter=0 - V_X=0 - V_R=B - CALL FD_WAVE_SETUP_APPLY_PRECOND(ASPAR, V_R, V_Z) - V_P=V_Z - CALL FD_WAVE_SETUP_SCALAR_PROD(V_Z, V_R, uO) - DO - nbIter=nbIter + 1 - CALL FD_WAVE_SETUP_APPLY_FCT(ASPAR, V_P, V_Y) - CALL FD_WAVE_SETUP_SCALAR_PROD(V_P, V_Y, h2) - alphaV=uO/h2 + END SUBROUTINE +!/ ------------------------------------------------------------------- / +!> +!> @brief Setup fluxes. +!> +!> @param[in] SXX_t +!> @param[in] SXY_t +!> @param[in] SYY_t +!> @param[out] FX +!> @param[out] FY +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> + SUBROUTINE FD_COMPUTE_LH_STRESS(SXX_t, SXY_t, SYY_t, FX, FY) +!/ +!/ +-----------------------------------+ +!/ | WAVEWATCH III NOAA/NCEP | +!/ | | +!/ | Mathieu Dutour-Sikiric (IRB) | +!/ | Aron Roland (BGS IT&E GmbH) | +!/ | | +!/ | FORTRAN 90 | +!/ | Last update : 01-Mai-2018 | +!/ +-----------------------------------+ +!/ +!/ 01-Mai-2018 : Origination. ( version 6.04 ) +!/ +! 1. Purpose : setup fluxes +! 2. Method : +! 3. Parameters : +! +! Parameter list +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 4. Subroutines used : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! STRACE Subr. W3SERVMD Subroutine tracing. +! ---------------------------------------------------------------- +! +! 5. Called by : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 6. Error messages : +! 7. Remarks +! 8. Structure : +! 9. Switches : +! +! !/S Enable subroutine tracing. +! +! 10. Source code : +! +!/ ------------------------------------------------------------------- / +#ifdef W3_S + USE W3SERVMD, ONLY: STRACE +#endif +! + USE W3GDATMD, ONLY: NX, NY, NSEA, NEIGH + USE W3ADATMD, ONLY: SXX, SXY, SYY + IMPLICIT NONE +!/ +!/ ------------------------------------------------------------------- / +!/ Parameter list +!/ +!/ ------------------------------------------------------------------- / +!/ Local PARAMETERs +!/ +#ifdef W3_S + INTEGER, SAVE :: IENT = 0 +#endif +!/ +!/ ------------------------------------------------------------------- / +!/ + real(rkind), intent(in) :: SXX_t(NSEA), SXY_t(NSEA), SYY_t(NSEA) + real(rkind), intent(out) :: FX(NSEA), FY(NSEA) + REAL(rkind) :: h + REAL(rkind) :: SXX_X, SXX_Y + REAL(rkind) :: SXY_X, SXY_Y + REAL(rkind) :: SYY_X, SYY_Y + REAL(rkind) :: eFX, eFY + REAL(rkind) :: UGRAD, VGRAD + INTEGER IE, I1, I2, I3, IP1, IP2, IP3 + integer ISEA, JSEA1, JSEA2, JSEA3, JSEA4 + integer NeighMat(4,2) + real(rkind) dist_X, dist_Y +#ifdef W3_S + CALL STRACE (IENT, 'VA_SETUP_IOBPD') +#endif ! - DO IP=1,NX - V_X(IP) = V_X(IP) + alphaV * V_P(IP) - V_R(IP) = V_R(IP) - alphaV * V_Y(IP) + NeighMat(1,1)=1 + NeighMat(1,2)=0 + NeighMat(2,1)=-1 + NeighMat(2,2)=0 + NeighMat(3,1)=0 + NeighMat(3,2)=1 + NeighMat(4,1)=0 + NeighMat(4,2)=-1 + FX=0 + FY=0 + DO ISEA=1,NSEA + JSEA1=NEIGH(ISEA,1) + JSEA2=NEIGH(ISEA,2) + JSEA3=NEIGH(ISEA,3) + JSEA4=NEIGH(ISEA,4) + SXX_X=0 + SXX_Y=0 + SXY_X=0 + SXY_Y=0 + SYY_X=0 + SYY_Y=0 + IF ((JSEA1 .gt. 0).and.(JSEA2 .gt. 0)) THEN + SXX_X=(SXX(JSEA1) - SXX(JSEA2))/(2*dist_X) + SXY_X=(SXY(JSEA1) - SXY(JSEA2))/(2*dist_X) + SYY_X=(SXY(JSEA1) - SYY(JSEA2))/(2*dist_X) + END IF + IF ((JSEA1 .gt. 0).and.(JSEA2 .eq. 0)) THEN + SXX_X=(SXX(JSEA1) - SXX(ISEA ))/dist_X + SXY_X=(SXY(JSEA1) - SXY(ISEA ))/dist_X + SYY_X=(SXY(JSEA1) - SYY(ISEA ))/dist_X + END IF + IF ((JSEA1 .eq. 0).and.(JSEA2 .gt. 0)) THEN + SXX_X=(SXX(ISEA ) - SXX(JSEA2))/dist_X + SXY_X=(SXY(ISEA ) - SXY(JSEA2))/dist_X + SYY_X=(SXY(ISEA ) - SYY(JSEA2))/dist_X + END IF + IF ((JSEA3 .gt. 0).and.(JSEA4 .gt. 0)) THEN + SXX_X=(SXX(JSEA3) - SXX(JSEA4))/(2*dist_Y) + SXY_X=(SXY(JSEA3) - SXY(JSEA4))/(2*dist_Y) + SYY_X=(SXY(JSEA3) - SYY(JSEA4))/(2*dist_Y) + END IF + IF ((JSEA3 .eq. 0).and.(JSEA4 .gt. 0)) THEN + SXX_X=(SXX(ISEA ) - SXX(JSEA4))/dist_Y + SXY_X=(SXY(ISEA ) - SXY(JSEA4))/dist_Y + SYY_X=(SXY(ISEA ) - SYY(JSEA4))/dist_Y + END IF + IF ((JSEA3 .gt. 0).and.(JSEA4 .gt. 0)) THEN + SXX_X=(SXX(JSEA3) - SXX(ISEA ))/dist_Y + SXY_X=(SXY(JSEA3) - SXY(ISEA ))/dist_Y + SYY_X=(SXY(JSEA3) - SYY(ISEA ))/dist_Y + END IF + eFX=-SXX_X - SXY_Y + eFY=-SYY_Y - SXY_X + FX(ISEA)=eFX + FY(ISEA)=eFY END DO + END SUBROUTINE +!/ ------------------------------------------------------------------- / +!> +!> @brief Differences on FD grids. +!> +!> @param[in] IEDGE +!> @param[in] ISEA +!> @param[inout] UGRAD +!> @param[inout] VGRAD +!> @param[inout] dist +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> + SUBROUTINE FD_COMPUTE_DIFF(IEDGE, ISEA, UGRAD, VGRAD, dist) +!/ +!/ +-----------------------------------+ +!/ | WAVEWATCH III NOAA/NCEP | +!/ | | +!/ | Mathieu Dutour-Sikiric (IRB) | +!/ | Aron Roland (BGS IT&E GmbH) | +!/ | | +!/ | FORTRAN 90 | +!/ | Last update : 01-Mai-2018 | +!/ +-----------------------------------+ +!/ +!/ 01-Mai-2018 : Origination. ( version 6.04 ) +!/ +! 1. Purpose : differences on FD grids +! 2. Method : +! 3. Parameters : +! +! Parameter list +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 4. Subroutines used : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! STRACE Subr. W3SERVMD Subroutine tracing. +! ---------------------------------------------------------------- +! +! 5. Called by : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 6. Error messages : +! 7. Remarks +! 8. Structure : +! 9. Switches : +! +! !/S Enable subroutine tracing. +! +! 10. Source code : +! +!/ ------------------------------------------------------------------- / +#ifdef W3_S + USE W3SERVMD, ONLY: STRACE +#endif +! + USE W3GDATMD, ONLY: MAPSF, EDGES + USE W3GDATMD, ONLY: XGRD, YGRD + IMPLICIT NONE +!/ +!/ ------------------------------------------------------------------- / +!/ Parameter list +!/ +!/ ------------------------------------------------------------------- / +!/ Local PARAMETERs +!/ +#ifdef W3_S + INTEGER, SAVE :: IENT = 0 +#endif +!/ +!/ ------------------------------------------------------------------- / +!/ + INTEGER, intent(in) :: IEDGE, ISEA + REAL(rkind), intent(inout) :: UGRAD, VGRAD, dist + REAL(rkind) :: h + integer I2, I3, IP1, IP2, IP3 + integer IX1, IY1, IX2, IY2 + integer ISEA1, ISEA2 + REAL(rkind) deltaX, deltaY +#ifdef W3_S + CALL STRACE (IENT, 'VA_SETUP_IOBPD') +#endif ! - CALL FD_WAVE_SETUP_SCALAR_PROD(V_R, V_R, eNorm) - IF (eNorm .le. SOLVERTHR) THEN - EXIT + ISEA1=EDGES(IEDGE,1) + ISEA2=EDGES(IEDGE,2) + IX1=MAPSF(ISEA1,1) + IY1=MAPSF(ISEA1,2) + IX2=MAPSF(ISEA2,1) + IY2=MAPSF(ISEA2,2) + deltaX=XGRD(IX1,IY1) - XGRD(IX2,IY2) + deltaY=YGRD(IX1,IY1) - YGRD(IX2,IY2) + dist=SQRT(deltaX*deltaX + deltaY*deltaY) + IF (ISEA .eq. ISEA1) THEN + UGRAD= deltaX/dist + VGRAD= deltaY/dist + ELSE + UGRAD=-deltaX/dist + VGRAD=-deltaY/dist END IF + END SUBROUTINE +!/ ------------------------------------------------------------------- / +!> +!> @brief Setup matrix on FD grids. +!> +!> @param[out] ASPAR +!> @param[out] B +!> @param[in] FX +!> @param[in] FY +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> + SUBROUTINE FD_WAVE_SETUP_COMPUTE_SYSTEM(ASPAR, B, FX, FY) +!/ +!/ +-----------------------------------+ +!/ | WAVEWATCH III NOAA/NCEP | +!/ | | +!/ | Mathieu Dutour-Sikiric (IRB) | +!/ | Aron Roland (BGS IT&E GmbH) | +!/ | | +!/ | FORTRAN 90 | +!/ | Last update : 01-Mai-2018 | +!/ +-----------------------------------+ +!/ +!/ 01-Mai-2018 : Origination. ( version 6.04 ) +!/ +! 1. Purpose : Setup matrix on FD grids +! 2. Method : +! 3. Parameters : +! +! Parameter list +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 4. Subroutines used : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! STRACE Subr. W3SERVMD Subroutine tracing. +! ---------------------------------------------------------------- +! +! 5. Called by : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 6. Error messages : +! 7. Remarks +! 8. Structure : +! 9. Switches : +! +! !/S Enable subroutine tracing. +! +! 10. Source code : +! +!/ ------------------------------------------------------------------- / +#ifdef W3_S + USE W3SERVMD, ONLY: STRACE +#endif +! + USE yowNodepool, only: PDLIB_NNZ + USE W3GDATMD, ONLY: NX, NY, NSEA, NBEDGE, EDGES + USE W3ADATMD, ONLY: DW + IMPLICIT NONE +!/ +!/ ------------------------------------------------------------------- / +!/ Parameter list +!/ +!/ ------------------------------------------------------------------- / +!/ Local PARAMETERs +!/ +#ifdef W3_S + INTEGER, SAVE :: IENT = 0 +#endif +!/ +!/ ------------------------------------------------------------------- / +!/ + real(rkind), intent(in) :: FX(NSEA), FY(NSEA) + real(rkind), intent(out) :: ASPAR(PDLIB_NNZ) + real(rkind), intent(out) :: B(NX) + INTEGER :: POS_TRICK(3,2), POS_SHIFT(3,3) + integer I1, I2, I3, IP1, IP2, IP3 + integer IDX, IDX1, IDX2, IDX3 + INTEGER IE, IP, I, J, K, IPp, JPp + real(rkind) :: eDep, eFX, eFY, eScal, eFact, eLen + real(rkind) :: UGRAD, VGRAD, UGRAD1, VGRAD1, dist1, dist2 + INTEGER LIDX(2), KIDX(2), jdx + INTEGER ISEAREL, JSEAREL, ISEA, JSEA, IEDGE +#ifdef W3_S + CALL STRACE (IENT, 'VA_SETUP_IOBPD') +#endif ! + ASPAR=0 + B=0 + DO IEDGE=1,NBEDGE + ISEA=EDGES(IEDGE,1) + JSEA=EDGES(IEDGE,2) + eDep=(DW(ISEA) + DW(JSEA))/2.0 + eFX =(FX(ISEA) + FX(JSEA))/2.0 + eFY =(FY(ISEA) + FY(JSEA))/2.0 + DO I=1,2 + ISEAREL=EDGES(IEDGE,I) + CALL FD_COMPUTE_DIFF(IEDGE, ISEAREL, UGRAD1, VGRAD1, dist1) + eScal=UGRAD1*eFX + VGRAD1*eFY + B(ISEAREL) = B(ISEAREL) + eScal*dist1 + ! + DO J=1,2 + JSEAREL=EDGES(IEDGE,J) + CALL FD_COMPUTE_DIFF(IEDGE, JSEAREL, UGRAD, VGRAD, dist2) + eScal=UGRAD*UGRAD1 + VGRAD*VGRAD1 + ASPAR(J)=ASPAR(J)+eFact*eScal + END DO + END DO + END DO + END SUBROUTINE +!/ ------------------------------------------------------------------- / +!> +!> @brief Scalar product. +!> +!> @param[in] V1 +!> @param[in] V2 +!> @param[inout] eScal +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> + SUBROUTINE FD_WAVE_SETUP_SCALAR_PROD(V1, V2, eScal) +!/ +!/ +-----------------------------------+ +!/ | WAVEWATCH III NOAA/NCEP | +!/ | | +!/ | Mathieu Dutour-Sikiric (IRB) | +!/ | Aron Roland (BGS IT&E GmbH) | +!/ | | +!/ | FORTRAN 90 | +!/ | Last update : 01-Mai-2018 | +!/ +-----------------------------------+ +!/ +!/ 01-Mai-2018 : Origination. ( version 6.04 ) +!/ +! 1. Purpose : scalar prod. +! 2. Method : +! 3. Parameters : +! +! Parameter list +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 4. Subroutines used : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! STRACE Subr. W3SERVMD Subroutine tracing. +! ---------------------------------------------------------------- +! +! 5. Called by : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 6. Error messages : +! 7. Remarks +! 8. Structure : +! 9. Switches : +! +! !/S Enable subroutine tracing. +! +! 10. Source code : +! +!/ ------------------------------------------------------------------- / +#ifdef W3_S + USE W3SERVMD, ONLY: STRACE +#endif +! + USE W3GDATMD, ONLY: NX + IMPLICIT NONE +!/ +!/ ------------------------------------------------------------------- / +!/ Parameter list +!/ +!/ ------------------------------------------------------------------- / +!/ Local PARAMETERs +!/ +#ifdef W3_S + INTEGER, SAVE :: IENT = 0 +#endif +!/ +!/ ------------------------------------------------------------------- / +!/ + real(rkind), intent(in) :: V1(NX), V2(NX) + real(rkind), intent(inout) :: eScal + integer IP +#ifdef W3_S + CALL STRACE (IENT, 'VA_SETUP_IOBPD') +#endif + eScal=0 + DO IP=1,NX + eScal=eScal + V1(IP)*V2(IP) + END DO + END SUBROUTINE +!/ ------------------------------------------------------------------- / +!> +!> @brief Poisson solver on FD grids. +!> +!> @param[in] ASPAR +!> @param[in] B +!> @param[out] TheOut +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> + SUBROUTINE FD_WAVE_SETUP_SOLVE_POISSON_NEUMANN_DIR(ASPAR, B, TheOut) +!/ +!/ +-----------------------------------+ +!/ | WAVEWATCH III NOAA/NCEP | +!/ | | +!/ | Mathieu Dutour-Sikiric (IRB) | +!/ | Aron Roland (BGS IT&E GmbH) | +!/ | | +!/ | FORTRAN 90 | +!/ | Last update : 01-Mai-2018 | +!/ +-----------------------------------+ +!/ +!/ 01-Mai-2018 : Origination. ( version 6.04 ) +!/ +! 1. Purpose : possoin solver on fd grids +! 2. Method : +! 3. Parameters : +! +! Parameter list +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 4. Subroutines used : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! STRACE Subr. W3SERVMD Subroutine tracing. +! ---------------------------------------------------------------- +! +! 5. Called by : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 6. Error messages : +! 7. Remarks +! 8. Structure : +! 9. Switches : +! +! !/S Enable subroutine tracing. +! +! 10. Source code : +! +!/ ------------------------------------------------------------------- / +#ifdef W3_S + USE W3SERVMD, ONLY: STRACE +#endif +! + USE yowNodepool, only: PDLIB_NNZ + USE W3GDATMD, ONLY: NX + IMPLICIT NONE +!/ +!/ ------------------------------------------------------------------- / +!/ Parameter list +!/ +!/ ------------------------------------------------------------------- / +!/ Local PARAMETERs +!/ +#ifdef W3_S + INTEGER, SAVE :: IENT = 0 +#endif +!/ +!/ ------------------------------------------------------------------- / +!/ + real(rkind), intent(in) :: ASPAR(PDLIB_NNZ) + real(rkind), intent(in) :: B(NX) + real(rkind), intent(out) :: TheOut(NX) + real(rkind) :: V_X(NX), V_R(NX), V_Z(NX), V_P(NX), V_Y(NX) + real(rkind) :: uO, uN, alphaV, h1, h2 + real(rkind) :: eNorm, beta + real(rkind) :: SOLVERTHR + integer IP, nbIter +#ifdef W3_S + CALL STRACE (IENT, 'VA_SETUP_IOBPD') +#endif + SOLVERTHR=0.00000001 + nbIter=0 + V_X=0 + V_R=B CALL FD_WAVE_SETUP_APPLY_PRECOND(ASPAR, V_R, V_Z) - CALL FD_WAVE_SETUP_SCALAR_PROD(V_Z, V_R, uN) - ! - beta=uN/uO - uO=uN - ! + V_P=V_Z + CALL FD_WAVE_SETUP_SCALAR_PROD(V_Z, V_R, uO) + DO + nbIter=nbIter + 1 + CALL FD_WAVE_SETUP_APPLY_FCT(ASPAR, V_P, V_Y) + CALL FD_WAVE_SETUP_SCALAR_PROD(V_P, V_Y, h2) + alphaV=uO/h2 + ! + DO IP=1,NX + V_X(IP) = V_X(IP) + alphaV * V_P(IP) + V_R(IP) = V_R(IP) - alphaV * V_Y(IP) + END DO + ! + CALL FD_WAVE_SETUP_SCALAR_PROD(V_R, V_R, eNorm) + IF (eNorm .le. SOLVERTHR) THEN + EXIT + END IF + ! + CALL FD_WAVE_SETUP_APPLY_PRECOND(ASPAR, V_R, V_Z) + CALL FD_WAVE_SETUP_SCALAR_PROD(V_Z, V_R, uN) + ! + beta=uN/uO + uO=uN + ! + DO IP=1,NX + V_P(IP)=V_Z(IP) + beta * V_P(IP) + END DO + END DO + TheOut=V_X + END SUBROUTINE +!/ ------------------------------------------------------------------- / +!> +!> @brief Set mean value. +!> +!> @param[inout] TheVar +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> + SUBROUTINE FD_SET_MEANVALUE_TO_ZERO(TheVar) +!/ +!/ +-----------------------------------+ +!/ | WAVEWATCH III NOAA/NCEP | +!/ | | +!/ | Mathieu Dutour-Sikiric (IRB) | +!/ | Aron Roland (BGS IT&E GmbH) | +!/ | | +!/ | FORTRAN 90 | +!/ | Last update : 01-Mai-2018 | +!/ +-----------------------------------+ +!/ +!/ 01-Mai-2018 : Origination. ( version 6.04 ) +!/ +! 1. Purpose : set meanvalue +! 2. Method : +! 3. Parameters : +! +! Parameter list +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 4. Subroutines used : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! STRACE Subr. W3SERVMD Subroutine tracing. +! ---------------------------------------------------------------- +! +! 5. Called by : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 6. Error messages : +! 7. Remarks +! 8. Structure : +! 9. Switches : +! +! !/S Enable subroutine tracing. +! +! 10. Source code : +! +!/ ------------------------------------------------------------------- / +#ifdef W3_S + USE W3SERVMD, ONLY: STRACE +#endif +! + USE W3GDATMD, ONLY: NX, SI + IMPLICIT NONE +!/ +!/ ------------------------------------------------------------------- / +!/ Parameter list +!/ +!/ ------------------------------------------------------------------- / +!/ Local PARAMETERs +!/ +#ifdef W3_S + INTEGER, SAVE :: IENT = 0 +#endif +!/ +!/ ------------------------------------------------------------------- / +!/ + real(rkind), intent(inout) :: TheVar(NX) + real(rkind) :: SUM_SI_Var, SUM_SI, TheMean + INTEGER IP +#ifdef W3_S + CALL STRACE (IENT, 'VA_SETUP_IOBPD') +#endif + SUM_SI_Var=0 + SUM_SI=0 DO IP=1,NX - V_P(IP)=V_Z(IP) + beta * V_P(IP) + SUM_SI_Var = SUM_SI_Var + SI(IP)*TheVar(IP) + SUM_SI = SUM_SI + SI(IP) END DO - END DO - TheOut=V_X - END SUBROUTINE FD_WAVE_SETUP_SOLVE_POISSON_NEUMANN_DIR - !/ ------------------------------------------------------------------- / - !> - !> @brief Set mean value. - !> - !> @param[inout] TheVar - !> - !> @author Mathieu Dutour-Sikiric - !> @author Aron Roland - !> @date 1-May-2018 - !> - SUBROUTINE FD_SET_MEANVALUE_TO_ZERO(TheVar) - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | | - !/ | Mathieu Dutour-Sikiric (IRB) | - !/ | Aron Roland (BGS IT&E GmbH) | - !/ | | - !/ | FORTRAN 90 | - !/ | Last update : 01-Mai-2018 | - !/ +-----------------------------------+ - !/ - !/ 01-Mai-2018 : Origination. ( version 6.04 ) - !/ - ! 1. Purpose : set meanvalue - ! 2. Method : - ! 3. Parameters : - ! - ! Parameter list - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 4. Subroutines used : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! STRACE Subr. W3SERVMD Subroutine tracing. - ! ---------------------------------------------------------------- - ! - ! 5. Called by : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 6. Error messages : - ! 7. Remarks - ! 8. Structure : - ! 9. Switches : - ! - ! !/S Enable subroutine tracing. - ! - ! 10. Source code : - ! - !/ ------------------------------------------------------------------- / -#ifdef W3_S - USE W3SERVMD, ONLY: STRACE -#endif - ! - USE W3GDATMD, ONLY: NX, SI - IMPLICIT NONE - !/ - !/ ------------------------------------------------------------------- / - !/ Parameter list - !/ - !/ ------------------------------------------------------------------- / - !/ Local PARAMETERs - !/ -#ifdef W3_S - INTEGER, SAVE :: IENT = 0 -#endif - !/ - !/ ------------------------------------------------------------------- / - !/ -#ifdef W3_S - CALL STRACE (IENT, 'VA_SETUP_IOBPD') -#endif - ! - real(8), intent(inout) :: TheVar(NX) - real(8) :: SUM_SI_Var, SUM_SI, TheMean - INTEGER IP - SUM_SI_Var=0 - SUM_SI=0 - DO IP=1,NX - SUM_SI_Var = SUM_SI_Var + SI(IP)*TheVar(IP) - SUM_SI = SUM_SI + SI(IP) - END DO - TheMean=SUM_SI_Var/SUM_SI - DO IP=1,NX - TheVar(IP)=TheVar(IP) - TheMean - END DO - END SUBROUTINE FD_SET_MEANVALUE_TO_ZERO - !/ ------------------------------------------------------------------- / - !> - !> @brief Wave setup comp on FD grids. - !> - !> @param[inout] TheVar - !> - !> @author Mathieu Dutour-Sikiric - !> @author Aron Roland - !> @date 1-May-2018 - !> - SUBROUTINE FD_WAVE_SETUP_COMPUTATION - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | | - !/ | Mathieu Dutour-Sikiric (IRB) | - !/ | Aron Roland (BGS IT&E GmbH) | - !/ | | - !/ | FORTRAN 90 | - !/ | Last update : 01-Mai-2018 | - !/ +-----------------------------------+ - !/ - !/ 01-Mai-2018 : Origination. ( version 6.04 ) - !/ - ! 1. Purpose : wave setup comp. on fd grids - ! 2. Method : - ! 3. Parameters : - ! - ! Parameter list - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 4. Subroutines used : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! STRACE Subr. W3SERVMD Subroutine tracing. - ! ---------------------------------------------------------------- - ! - ! 5. Called by : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 6. Error messages : - ! 7. Remarks - ! 8. Structure : - ! 9. Switches : - ! - ! !/S Enable subroutine tracing. - ! - ! 10. Source code : - ! - !/ ------------------------------------------------------------------- / -#ifdef W3_S - USE W3SERVMD, ONLY: STRACE -#endif - ! - USE yowNodepool, only: PDLIB_NNZ - USE W3GDATMD, ONLY: NX, NSEA, NSEAL - USE W3WDATMD, ONLY: ZETA_SETUP - use yowDatapool, only: rtype, istatus - USE W3ADATMD, ONLY: MPI_COMM_WCMP - USE W3ODATMD, only : IAPROC, NAPROC - IMPLICIT NONE - !/ - !/ ------------------------------------------------------------------- / - !/ Parameter list - !/ - !/ ------------------------------------------------------------------- / - !/ Local PARAMETERs - !/ -#ifdef W3_S - INTEGER, SAVE :: IENT = 0 -#endif - !/ - !/ ------------------------------------------------------------------- / - !/ -#ifdef W3_S - CALL STRACE (IENT, 'VA_SETUP_IOBPD') -#endif - ! - ! CALL W3SETG - REAL(8) :: ZETA_WORK(NSEA) - REAL(8) :: F_X(NSEA), F_Y(NSEA) - REAL(8) :: ASPAR(PDLIB_NNZ), B(NX) - INTEGER ISEA, IPROC - real(8) :: SXX_t(NSEA), SXY_t(NSEA), SYY_t(NSEA) - integer ierr - CALL FD_COLLECT_SXX_XY_YY(SXX_t, SXY_t, SYY_t) - IF (IAPROC .eq. 1) THEN - CALL FD_COMPUTE_LH_STRESS(SXX_t, SXY_t, SYY_t, F_X, F_Y) - DO ISEA=1,NSEA - ZETA_WORK(ISEA)=ZETA_SETUP(ISEA) + TheMean=SUM_SI_Var/SUM_SI + DO IP=1,NX + TheVar(IP)=TheVar(IP) - TheMean END DO - CALL FD_WAVE_SETUP_COMPUTE_SYSTEM(ASPAR, B, F_X, F_Y) - CALL FD_WAVE_SETUP_SOLVE_POISSON_NEUMANN_DIR(ASPAR, B, ZETA_WORK) - CALL FD_SET_MEANVALUE_TO_ZERO(ZETA_WORK) - DO IPROC=2,NAPROC - CALL MPI_SEND(ZETA_WORK,NSEA,rtype, IPROC-1, 23, MPI_COMM_WCMP, ierr) + END SUBROUTINE +!/ ------------------------------------------------------------------- / +!> +!> @brief Wave setup comp on FD grids. +!> +!> @param[inout] TheVar +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> + SUBROUTINE FD_WAVE_SETUP_COMPUTATION +!/ +!/ +-----------------------------------+ +!/ | WAVEWATCH III NOAA/NCEP | +!/ | | +!/ | Mathieu Dutour-Sikiric (IRB) | +!/ | Aron Roland (BGS IT&E GmbH) | +!/ | | +!/ | FORTRAN 90 | +!/ | Last update : 01-Mai-2018 | +!/ +-----------------------------------+ +!/ +!/ 01-Mai-2018 : Origination. ( version 6.04 ) +!/ +! 1. Purpose : wave setup comp. on fd grids +! 2. Method : +! 3. Parameters : +! +! Parameter list +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 4. Subroutines used : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! STRACE Subr. W3SERVMD Subroutine tracing. +! ---------------------------------------------------------------- +! +! 5. Called by : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 6. Error messages : +! 7. Remarks +! 8. Structure : +! 9. Switches : +! +! !/S Enable subroutine tracing. +! +! 10. Source code : +! +!/ ------------------------------------------------------------------- / +#ifdef W3_S + USE W3SERVMD, ONLY: STRACE +#endif +! + USE yowNodepool, only: PDLIB_NNZ + USE W3GDATMD, ONLY: NX, NSEA, NSEAL + USE W3WDATMD, ONLY: ZETA_SETUP + use yowDatapool, only: rtype, istatus + USE W3ADATMD, ONLY: MPI_COMM_WCMP + USE W3ODATMD, only : IAPROC, NAPROC + IMPLICIT NONE +!/ +!/ ------------------------------------------------------------------- / +!/ Parameter list +!/ +!/ ------------------------------------------------------------------- / +!/ Local PARAMETERs +!/ +#ifdef W3_S + INTEGER, SAVE :: IENT = 0 +#endif +!/ +!/ ------------------------------------------------------------------- / +!/ + REAL(rkind) :: ZETA_WORK(NSEA) + REAL(rkind) :: F_X(NSEA), F_Y(NSEA) + REAL(rkind) :: ASPAR(PDLIB_NNZ), B(NX) + INTEGER ISEA, IPROC + real(rkind) :: SXX_t(NSEA), SXY_t(NSEA), SYY_t(NSEA) + integer ierr +#ifdef W3_DEBUGSTP + real(rkind) max_val, min_val +#endif +#ifdef W3_S + CALL STRACE (IENT, 'VA_SETUP_IOBPD') +#endif + CALL FD_COLLECT_SXX_XY_YY(SXX_t, SXY_t, SYY_t) + IF (IAPROC .eq. 1) THEN + CALL FD_COMPUTE_LH_STRESS(SXX_t, SXY_t, SYY_t, F_X, F_Y) + DO ISEA=1,NSEA + ZETA_WORK(ISEA)=ZETA_SETUP(ISEA) + END DO + CALL FD_WAVE_SETUP_COMPUTE_SYSTEM(ASPAR, B, F_X, F_Y) + CALL FD_WAVE_SETUP_SOLVE_POISSON_NEUMANN_DIR(ASPAR, B, ZETA_WORK) + CALL FD_SET_MEANVALUE_TO_ZERO(ZETA_WORK) + DO IPROC=2,NAPROC + CALL MPI_SEND(ZETA_WORK,NSEA,rtype, IPROC-1, 23, MPI_COMM_WCMP, ierr) + END DO + ELSE + CALL MPI_RECV(ZETA_WORK,NSEAL,rtype, 0, 23, MPI_COMM_WCMP, istatus, ierr) + END IF +#ifdef W3_DEBUGSTP + max_val = ZETA_WORK(ISEA) + min_val = ZETA_WORK(ISEA) +#endif + DO ISEA=1,NSEA + ZETA_SETUP(ISEA)=ZETA_WORK(ISEA) +#ifdef W3_DEBUGSTP + max_val = MAX(max_val, ZETA_WORK(ISEA)) + min_val = MIN(min_val, ZETA_WORK(ISEA)) +#endif END DO - ELSE - CALL MPI_RECV(ZETA_WORK,NSEAL,rtype, 0, 23, MPI_COMM_WCMP, istatus, ierr) - END IF - DO ISEA=1,NSEA - ZETA_SETUP(ISEA)=ZETA_WORK(ISEA) - END DO - END SUBROUTINE FD_WAVE_SETUP_COMPUTATION - !/ ------------------------------------------------------------------- / - !> - !> @brief General driver. - !> - !> @author Aron Roland - !> @author Mathieu Dutour-Sikiric - !> @date 1-May-2018 - !> - SUBROUTINE WAVE_SETUP_COMPUTATION - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | | - !/ | Aron Roland (BGS IT&E GmbH) | - !/ | Mathieu Dutour-Sikiric (IRB) | - !/ | | - !/ | FORTRAN 90 | - !/ | Last update : 01-Mai-2018 | - !/ +-----------------------------------+ - !/ - !/ 01-Mai-2018 : Origination. ( version 6.04 ) - !/ - ! 1. Purpose : general driver - ! 2. Method : - ! 3. Parameters : - ! - ! Parameter list - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 4. Subroutines used : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! STRACE Subr. W3SERVMD Subroutine tracing. - ! ---------------------------------------------------------------- - ! - ! 5. Called by : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! ---------------------------------------------------------------- - ! - ! 6. Error messages : - ! 7. Remarks - ! 8. Structure : - ! 9. Switches : - ! - ! !/S Enable subroutine tracing. - ! - ! 10. Source code : - ! - !/ ------------------------------------------------------------------- / -#ifdef W3_S - USE W3SERVMD, ONLY: STRACE -#endif - ! - USE W3GDATMD, ONLY: NSEA, NSEAL - USE W3GDATMD, ONLY: GTYPE, UNGTYPE - USE W3ODATMD, only : IAPROC, NAPROC, NTPROC - IMPLICIT NONE - !/ - !/ ------------------------------------------------------------------- / - !/ Parameter list - !/ - !/ ------------------------------------------------------------------- / - !/ Local PARAMETERs - !/ -#ifdef W3_S - INTEGER, SAVE :: IENT = 0 -#endif - !/ - !/ ------------------------------------------------------------------- / - !/ -#ifdef W3_S - CALL STRACE (IENT, 'VA_SETUP_IOBPD') -#endif - ! - INTEGER ISEA, JSEA - REAL*8, allocatable :: ZETA_WORK(:) #ifdef W3_DEBUGSTP - WRITE(740+IAPROC,*) 'NAPROC=', NAPROC - WRITE(740+IAPROC,*) 'NTPROC=', NTPROC - FLUSH(740+IAPROC) + WRITE(740+IAPROC,*) 'FD_WAVE_SETUP_COMPUTATION, max/min=', max_val, min_val + FLUSH(740+IAPROC) +#endif + END SUBROUTINE +!/ ------------------------------------------------------------------- / +!> +!> @brief General driver. +!> +!> @author Aron Roland +!> @author Mathieu Dutour-Sikiric +!> @date 1-May-2018 +!> + SUBROUTINE WAVE_SETUP_COMPUTATION +!/ +!/ +-----------------------------------+ +!/ | WAVEWATCH III NOAA/NCEP | +!/ | | +!/ | Aron Roland (BGS IT&E GmbH) | +!/ | Mathieu Dutour-Sikiric (IRB) | +!/ | | +!/ | FORTRAN 90 | +!/ | Last update : 01-Mai-2018 | +!/ +-----------------------------------+ +!/ +!/ 01-Mai-2018 : Origination. ( version 6.04 ) +!/ +! 1. Purpose : general driver +! 2. Method : +! 3. Parameters : +! +! Parameter list +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 4. Subroutines used : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! STRACE Subr. W3SERVMD Subroutine tracing. +! ---------------------------------------------------------------- +! +! 5. Called by : +! +! Name Type Module Description +! ---------------------------------------------------------------- +! ---------------------------------------------------------------- +! +! 6. Error messages : +! 7. Remarks +! 8. Structure : +! 9. Switches : +! +! !/S Enable subroutine tracing. +! +! 10. Source code : +! +!/ ------------------------------------------------------------------- / +#ifdef W3_S + USE W3SERVMD, ONLY: STRACE +#endif +! + USE W3GDATMD, ONLY: NSEA, NSEAL + USE W3GDATMD, ONLY: GTYPE, UNGTYPE + USE W3ODATMD, only : IAPROC, NAPROC, NTPROC + IMPLICIT NONE +!/ +!/ ------------------------------------------------------------------- / +!/ Parameter list +!/ +!/ ------------------------------------------------------------------- / +!/ Local PARAMETERs +!/ +#ifdef W3_S + INTEGER, SAVE :: IENT = 0 +#endif +!/ +!/ ------------------------------------------------------------------- / +!/ + INTEGER ISEA, JSEA + REAL(rkind), allocatable :: ZETA_WORK(:) +#ifdef W3_S + CALL STRACE (IENT, 'VA_SETUP_IOBPD') +#endif +#ifdef W3_DEBUGSTP + WRITE(740+IAPROC,*) 'NAPROC=', NAPROC + WRITE(740+IAPROC,*) 'NTPROC=', NTPROC + FLUSH(740+IAPROC) #endif - IF (IAPROC .le. NAPROC) THEN + IF (IAPROC .le. NAPROC) THEN #ifdef W3_DEBUGSTP WRITE(740+IAPROC,*) 'Begin WAVE_SETUP_COMPUTATION' FLUSH(740+IAPROC) #endif - IF (DO_WAVE_SETUP) THEN - IF (GTYPE .EQ. UNGTYPE) THEN - CALL TRIG_WAVE_SETUP_COMPUTATION - ELSE - CALL FD_WAVE_SETUP_COMPUTATION + IF (DO_WAVE_SETUP) THEN + IF (GTYPE .EQ. UNGTYPE) THEN + CALL TRIG_WAVE_SETUP_COMPUTATION + ELSE + CALL FD_WAVE_SETUP_COMPUTATION + END IF END IF END IF - END IF #ifdef W3_DEBUGSTP - WRITE(740+IAPROC,*) 'Begin WAVE_SETUP_COMPUTATION' - FLUSH(740+IAPROC) + WRITE(740+IAPROC,*) 'End WAVE_SETUP_COMPUTATION' + FLUSH(740+IAPROC) #endif - END SUBROUTINE WAVE_SETUP_COMPUTATION - !/ ------------------------------------------------------------------- / -END MODULE W3WAVSET + END SUBROUTINE +!/ ------------------------------------------------------------------- / + END MODULE !/ ------------------------------------------------------------------- / diff --git a/regtests/bin/matrix.base b/regtests/bin/matrix.base index f7457f218..e8d3e69dc 100755 --- a/regtests/bin/matrix.base +++ b/regtests/bin/matrix.base @@ -2022,6 +2022,16 @@ fi fi + # unstructured grid with PDLIB for domain decomposition and implicit solver, Neumann Bnd, depth breaking & triad interaction ST + if [ "$pdlib" = 'y' ] && [ "$dist" = 'y' ] + then + echo ' ' >> matrix.body + echo "$rtst -s MPI -s PDLIB -w work_1A_a -f -g a -p $mpi -n $np -o netcdf -i input_Case1A $ww3 ww3_tp2.19" >> matrix.body + echo "$rtst -s MPI -s PDLIB -w work_1B_a -f -g a -p $mpi -n $np -o netcdf -i input_Case1B $ww3 ww3_tp2.19" >> matrix.body + echo "$rtst -s MPI -s PDLIB -w work_1C_a -f -g a -p $mpi -n $np -o netcdf -i input_Case1C $ww3 ww3_tp2.19" >> matrix.body + fi + + #Unresolved Obstacles Source Term (UOST) if [ "$uost" = 'y' ] then @@ -2138,7 +2148,15 @@ echo "./bin/test.comp ww3_ufs1.1 work_a work_b" >> matrix.body fi fi + + # Global unstr case + # Domain Decomposition Explicit fi + echo "$rtst -s MPI -s PDLIB -i input_unstr -w work_unstr_a -g a -f -p $mpi -n $np $ww3 ww3_ufs1.1" >> matrix.body + # Domain Decomposition Block Explicit + echo "$rtst -s MPI -s PDLIB -i input_unstr -w work_unstr_b -g b -f -p $mpi -n $np $ww3 ww3_ufs1.1" >> matrix.body + # Domain Decomposition Implicit + echo "$rtst -s MPI -s PDLIB -i input_unstr -w work_unstr_c -g c -f -p $mpi -n $np $ww3 ww3_ufs1.1" >> matrix.body #Test of UFS applications with ww3_multi_esmf and grib2 output if [ "$ufs" = 'y' ] && [ "$esmf" = 'y' ] && [ "$grib" = 'y' ] diff --git a/regtests/bin/matrix_cmake_milhydro b/regtests/bin/matrix_cmake_milhydro new file mode 100755 index 000000000..8213b9b33 --- /dev/null +++ b/regtests/bin/matrix_cmake_milhydro @@ -0,0 +1,153 @@ +#!/bin/bash +# --------------------------------------------------------------------------- # +# matrix.go: Run matrix of regression tests on target machine. # +# # +# Remarks: # +# - This version is set up for automatic w3_setenv script and for the # +# NOAA RDHPC 'zeus' system. When using this for your own setup and # +# computer, please copy rather than modify. # +# # +# Hendrik L. Tolman # +# August 2013 # +# December 2013 # +# April 2018 # +# # +# Copyright 2013 National Weather Service (NWS), # +# National Oceanic and Atmospheric Administration. All rights # +# reserved. WAVEWATCH III is a trademark of the NWS. # +# No unauthorized use without permission. # +# # +# --------------------------------------------------------------------------- # +usage () +{ + cat 2>&1 << EOF + + Usage: $myname model_dir + Required: + model_dir : path to model dir of WW3 source +EOF +} + + +# Get required arguments + if [ ! $# = 0 ] + then + main_dir="$1" ; shift + else + usage + exit 1 + fi + +# Convert main_dir to absolute path + main_dir="`cd $main_dir 1>/dev/null 2>&1 && pwd`" + +# Set batchq queue, choose modules and other custom variables to fit system and +# to define headers etc (default to original version if empty) +# 1. Set up +# 1.a Computer/ user dependent set up + + echo '#!/bin/sh ' > matrix.head + echo ' ' >> matrix.head + echo " cd $(dirname $main_dir)/regtests" >> matrix.head + echo ' ' >> matrix.head + +# Netcdf and Parmetis modules & variables + echo " export NetCDF_ROOT=/home/thesser/tools/GNU " >> matrix.head + echo " export METIS_PATH=/home/thesser/public/parmetis " >> matrix.head + echo " export PATH=/home/thesser/tools/cmake/bin:$PATH" >> matrix.head +echo " export path_build_root=$(dirname $main_dir)/regtests/buildmatrix" >> matrix.head + echo ' [[ -d ${path_build_root} ]] && rm -rf ${path_build_root}' >> matrix.head + + echo ' ' + + if [ "$batchq" = 'slurm' ] + then + export mpi='mpirun' + else + export mpi='mpirun' + fi + export np='24' + export nr='0' + export nth='0' +# Compile option + opt="-o netcdf -S -T -N" +# Batch queue option + if [ "$batchq" = 'slurm' ] + then + opt="-b $batchq $opt" + fi + +# Base run_test command line + export rtst="./bin/run_cmake_test $opt" + + export ww3='../model' + +# 1.b Flags to do course selection - - - - - - - - - - - - - - - - - - - - - - +# Addition selection by commenting out lines as below + export shrd='y' # Do shared architecture tests + export dist='y' # Do distributed architecture (MPI) tests + export omp='y' # Threaded (OpenMP) tests + export hybd='y' # Hybrid options + + export prop1D='y' # 1-D propagation tests (ww3_tp1.X) + export prop2D='y' # 2-D propagation tests (ww3_tp2.X) + export time='y' # time linmited growth + export fetch='y' # fetch linmited growth + export hur1mg='y' # Hurricane with one moving grid + export shwtr='y' # shallow water tests + export unstr='y' # unstructured grid tests + export pdlib='y' # unstr with pdlib for domain decomposition and implicit solver + export smcgr='y' # SMC grid test + export rtd='y' # Rotated pole test + export mudice='y' # Mud/Ice and wave interaction tests + export infgrv='y' # Second harmonic generation tests + export uost='y' # ww3_ts4 Unresolved Obstacles Source Term (UOST) + export assim='y' # Restart spectra update + export oasis='y' # Atmosphere, ocean, and ice coupling using OASIS + export calendar='y' # Calendar type + export confignc='y' # Configurable netCDF meta data (ww3_ounf) + + export multi01='y' # mww3_test_01 (wetting and drying) + export multi02='y' # mww3_test_02 (basic two-way nesting test)) + export multi03='y' # mww3_test_03 (three high and three low res grids). + export multi04='y' # mww3_test_04 (swell on sea mount and/or current) + export multi05='y' # mww3_test_05 (three-grid moving hurricane) + export multi06='y' # mww3_test_06 (curvilinear grid tests) + export multi07='y' # mww3_test_07 (unstructured grid tests) + export multi08='y' # mww3_test_08 (wind and ice tests) + export multi09='y' # mww3_test_09 (SMC multi grid test) + + export ufs='n' # The Unified Forecast System + export ufscoarse='n' # Option for small PCs + export grib='n' # grib file field output + export rstrt_b4b='n' # Restart Reproducibility + export npl_b4b='n' # MPI task Reproducibility + export nth_b4b='n' # Thread Reproducibility + export esmf='n' # ESMF coupling + # The filter does a set of consecutinve greps on the + # command lines generated by filter.base with the above + # selected options. + +# --------------------------------------------------------------------------- # +# 2. Execute matrix.base ... # +# --------------------------------------------------------------------------- # + + + $main_dir/../regtests/bin/matrix.base + + $main_dir/../regtests/bin/matrix_divider_cmake.sh + + + echo "#submit all of the diveded matrix files" > msuball.sh + if [ $batchq = "slurm" ] + then + files=`ls matrix??` + for file in $files + do + echo "sbatch < $file" >> msuball.sh + done + fi + +# --------------------------------------------------------------------------- # +# End to the matrix # +# --------------------------------------------------------------------------- # diff --git a/regtests/bin/matrix_ncep b/regtests/bin/matrix_ncep index 8b9867a30..6d5dbf5da 100755 --- a/regtests/bin/matrix_ncep +++ b/regtests/bin/matrix_ncep @@ -47,40 +47,46 @@ # If no other h, assuming Hera cmplr='hera.intel' batchq='slurm' - hpcstackpath='/scratch2/NCEPDEV/nwprod/hpc-stack/libs/hpc-stack/modulefiles/stack' - hpcstackversion='hpc/1.1.0' - modcomp='hpc-intel/18.0.5.274' - modmpi='hpc-impi/2018.0.4' + hpcstackpath='/scratch1/NCEPDEV/nems/role.epic/hpc-stack/libs/intel-2022.1.2/modulefiles/stack' + hpcstackversion='hpc/1.2.0' + basemodcomp='intel/2022.1.2' + basemodmpi='impi/2022.1.2' + modcomp='hpc-intel/2022.1.2' + modmpi='hpc-impi/2022.1.2' modnetcdf='netcdf/4.7.4' metispath='/scratch2/STI/coastal/save/Ali.Abdolali/hpc-stack/parmetis-4.0.3' scotchpath='/scratch2/STI/coastal/save/Ali.Abdolali/hpc-stack/scotch/install' modjasper='jasper/2.0.25' modzlib='zlib/1.2.11' - modpng='png/1.6.35' + modpng='libpng/1.6.37' modhdf5='hdf5/1.10.6' modbacio='bacio/2.4.1' - modg2='g2/3.4.1' + modg2='g2/3.4.5' modw3emc='w3emc/2.9.2' - modesmf='esmf/8_1_1' + modesmf='esmf/8.3.0b09' + metispath='/scratch2/STI/coastal/save/Ali.Abdolali/hpc-stack/parmetis-4.0.3' + modcmake='cmake/3.20.1' elif [ $isorion ] then cmplr='orion.intel' batchq='slurm' - hpcstackpath='/apps/contrib/NCEP/libs/hpc-stack/modulefiles/stack' - hpcstackversion='hpc/1.1.0' - modcomp='hpc-intel/2018.4' - modmpi='hpc-impi/2018.4' + hpcstackpath='/work/noaa/epic-ps/hpc-stack/libs/intel/2022.1.2/modulefiles/stack' + hpcstackversion='hpc/1.2.0' + modcomp='hpc-intel/2022.1.2' + modmpi='hpc-impi/2022.1.2' modnetcdf='netcdf/4.7.4' metispath='/work/noaa/marine/ali.abdolali/Source/hpc-stack/parmetis-4.0.3' scotchpath='/work/noaa/marine/ali.abdolali/Source/hpc-stack/scotch/install' modjasper='jasper/2.0.25' modzlib='zlib/1.2.11' - modpng='png/1.6.35' + modpng='libpng/1.6.37' modhdf5='hdf5/1.10.6' modbacio='bacio/2.4.1' - modg2='g2/3.4.1' + modg2='g2/3.4.5' modw3emc='w3emc/2.9.2' - modesmf='esmf/8_1_1' + modesmf='esmf/8.3.0b09' + metispath='/work/noaa/marine/ali.abdolali/Source/hpc-stack/parmetis-4.0.3' + modcmake='cmake/3.22.1' else batchq= fi @@ -135,6 +141,12 @@ echo " module purge" >> matrix.head echo " module use $hpcstackpath" >> matrix.head echo " module load $hpcstackversion" >> matrix.head + if [ ! -z $basemodcomp ]; then + echo " module load $basemodcomp" >> matrix.head + fi + if [ ! -z $basemodmpi ]; then + echo " module load $basemodmpi" >> matrix.head + fi echo " module load $modcomp" >> matrix.head echo " module load $modmpi" >> matrix.head echo " module load $modnetcdf" >> matrix.head diff --git a/regtests/ww3_tp2.19/input/points.list b/regtests/ww3_tp2.19/input/points.list new file mode 100644 index 000000000..6d5a7fa75 --- /dev/null +++ b/regtests/ww3_tp2.19/input/points.list @@ -0,0 +1,80 @@ +0 0.0 a01 +1 0.0 a02 +2 0.0 a03 +3 0.0 a04 +4 0.0 a05 +5 0.0 a06 +6 0.0 a07 +7 0.0 a08 +8 0.0 a09 +9 0.0 a10 +10 0.0 a11 +11 0.0 a12 +12 0.0 a13 +13 0.0 a14 +14 0.0 a15 +15 0.0 a16 +15.5 0.0 a17 +16 0.0 a18 +16.5 0.0 a19 +17 0.0 a20 +17.5 0.0 a21 +18 0.0 a22 +18.5 0.0 a23 +19 0.0 a24 +19.2 0.0 a25 +19.4 0.0 a26 +19.6 0.0 a27 +19.8 0.0 a28 +20 0.0 a29 +20.2 0.0 a30 +20.4 0.0 a31 +20.6 0.0 a32 +20.8 0.0 a33 +21 0.0 a34 +21.2 0.0 a35 +21.4 0.0 a36 +21.6 0.0 a37 +21.8 0.0 a38 +22 0.0 a39 +22.2 0.0 a40 +22.4 0.0 a41 +22.6 0.0 a42 +22.8 0.0 a43 +23 0.0 a44 +23.2 0.0 a45 +23.4 0.0 a46 +23.6 0.0 a47 +23.8 0.0 a48 +24 0.0 a49 +24.2 0.0 a50 +24.4 0.0 a51 +24.6 0.0 a52 +24.8 0.0 a53 +25 0.0 a54 +25.2 0.0 a55 +25.4 0.0 a56 +25.6 0.0 a57 +25.8 0.0 a58 +26 0.0 a59 +26.2 0.0 a60 +26.4 0.0 a61 +26.56 0.0 a62 +26.8 0.0 a63 +27 0.0 a64 +27.25 0.0 a65 +27.5 0.0 a66 +27.75 0.0 a67 +28 0.0 a68 +28.25 0.0 a69 +28.5 0.0 a70 +28.75 0.0 a71 +29.00 0.0 a72 +29.25 0.0 a73 +29.50 0.0 a74 +29.75 0.0 a75 +30.00 0.0 a76 +30.25 0.0 a77 +30.50 0.0 a78 +30.75 0.0 a79 +31.00 0.0 a80 diff --git a/regtests/ww3_tp2.19/input_Case1A/namelists_a.nml b/regtests/ww3_tp2.19/input_Case1A/namelists_a.nml new file mode 100644 index 000000000..a371744c5 --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1A/namelists_a.nml @@ -0,0 +1,34 @@ +$ BAJ (adjusted) +$ +&SDB1 BJGAM = 0.64, BJALFA = 0.8 / +$ +&UNST +UGOBCAUTO = F +UGOBCDEPTH= -10. +EXPFSN = F, +EXPFSPSI = F, +EXPFSFCT = F, +IMPFSN = F, +IMPTOTAL = T, +IMPREFRACTION = T, +IMPFREQSHIFT = T, +IMPSOURCE = T, +SETUP_APPLY_WLV = F +SOLVERTHR_SETUP=1E-14 +CRIT_DEP_SETUP=0.1 +JGS_USE_JACOBI = T, +JGS_NLEVEL = 0 +JGS_SOURCE_NONLINEAR = F +JGS_BLOCK_GAUSS_SEIDEL = T, +JGS_TERMINATE_MAXITER = T, +JGS_MAXITER = 100000, +JGS_TERMINATE_NORM = F, +JGS_TERMINATE_DIFFERENCE = T, +JGS_DIFF_THR = 1.E-6, +JGS_PMIN = 3.0 +JGS_LIMITER = F, +JGS_BLOCK_GAUSS_SEIDEL = T, +JGS_NORM_THR = 1.E-6 +/ + +END OF NAMELISTS diff --git a/regtests/ww3_tp2.19/input_Case1A/namelists_b.nml b/regtests/ww3_tp2.19/input_Case1A/namelists_b.nml new file mode 100644 index 000000000..961a829de --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1A/namelists_b.nml @@ -0,0 +1,33 @@ +$ +&SDB1 BJGAM = 0.42, BJALFA = 1.0, DBFLAG=2 / +$ +&UNST +UGOBCAUTO = F +UGOBCDEPTH= -10. +EXPFSN = F, +EXPFSPSI = F, +EXPFSFCT = F, +IMPFSN = F, +IMPTOTAL = T, +IMPREFRACTION = T, +IMPFREQSHIFT = T, +IMPSOURCE = T, +SETUP_APPLY_WLV = F +SOLVERTHR_SETUP=1E-14 +CRIT_DEP_SETUP=0.1 +JGS_USE_JACOBI = T, +JGS_NLEVEL = 0 +JGS_SOURCE_NONLINEAR = F +JGS_BLOCK_GAUSS_SEIDEL = T, +JGS_TERMINATE_MAXITER = T, +JGS_MAXITER = 100000, +JGS_TERMINATE_NORM = F, +JGS_TERMINATE_DIFFERENCE = T, +JGS_DIFF_THR = 1.E-6, +JGS_PMIN = 3.0 +JGS_LIMITER = F, +JGS_BLOCK_GAUSS_SEIDEL = T +JGS_NORM_THR = 1.E-6 +/ + +END OF NAMELISTS diff --git a/regtests/ww3_tp2.19/input_Case1A/spec.list b/regtests/ww3_tp2.19/input_Case1A/spec.list new file mode 100644 index 000000000..05066d32f --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1A/spec.list @@ -0,0 +1 @@ +../input/boundary1A.nc diff --git a/regtests/ww3_tp2.19/input_Case1A/switch_PDLIB b/regtests/ww3_tp2.19/input_Case1A/switch_PDLIB new file mode 100644 index 000000000..173947fdd --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1A/switch_PDLIB @@ -0,0 +1 @@ +F90 PDLIB METIS NOGRB NC4 DIST MPI PR3 UQ FLX0 LN0 ST0 NL0 BT0 DB1 TR1 BS0 IC0 IS0 REF0 XX0 WNT1 WNX1 CRT1 CRX1 SEC1 O0 O1 O2 O3 O4 O5 O6 O7 diff --git a/regtests/ww3_tp2.19/input_Case1A/ww3_bounc.inp b/regtests/ww3_tp2.19/input_Case1A/ww3_bounc.inp new file mode 100644 index 000000000..2f396b33d --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1A/ww3_bounc.inp @@ -0,0 +1,25 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III NetCDF boundary input processing $ +$--------------------------------------------------------------------- $ +$ +$ Boundary option: READ or WRITE +$ + WRITE +$ +$ Interpolation method: 1: nearest +$ 2: linear interpolation + 2 +$ Verbose (0, 1, 2) +1 +$ +$ List of spectra files. These NetCDF files use the WAVEWATCH III +$ format as described in the ww3_ounp.inp file. The files are +$ defined relative to the directory in which the program is run. +$ +../input/boundary1A.nc +'STOPSTRING' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ + diff --git a/regtests/ww3_tp2.19/input_Case1A/ww3_bounc.nml b/regtests/ww3_tp2.19/input_Case1A/ww3_bounc.nml new file mode 100644 index 000000000..b3ceb583d --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1A/ww3_bounc.nml @@ -0,0 +1,21 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III ww3_bounc.nml - Boundary input post-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the input boundaries to preprocess via BOUND_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! BOUND%MODE = 'WRITE' ! ['WRITE'|'READ'] +! BOUND%INTERP = 2 ! interpolation [1(nearest),2(linear)] +! BOUND%VERBOSE = 1 ! [0|1|2] +! BOUND%FILE = 'spec.list' ! input _spec.nc listing file +! -------------------------------------------------------------------- ! +&BOUND_NML + BOUND%FILE = '../input_Case1A/spec.list' +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_tp2.19/input_Case1A/ww3_grid.inp b/regtests/ww3_tp2.19/input_Case1A/ww3_grid.inp new file mode 100644 index 000000000..8c229430e --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1A/ww3_grid.inp @@ -0,0 +1,302 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Grid preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Grid name (C*30, in quotes) +$ + 'Flume ERDC' +$ +$ Frequency increment factor and first frequency (Hz) ---------------- $ +$ number of frequencies (wavenumbers) and directions, relative offset +$ of first direction in terms of the directional increment [-0.5,0.5]. +$ In versions 1.18 and 2.22 of the model this value was by definiton 0, +$ it is added to mitigate the GSE for a first order scheme. Note that +$ this factor is IGNORED in the print plots in ww3_outp. +$ +1.1 0.0398 46 360 0. +$ +$ Set model flags ---------------------------------------------------- $ +$ - FLDRY Dry run (input/output only, no calculation). +$ - FLCX, FLCY Activate X and Y component of propagation. +$ - FLCTH, FLCK Activate direction and wavenumber shifts. +$ - FLSOU Activate source terms. +$ + F T T F F T +$ +$ Set time steps ----------------------------------------------------- $ +$ - Time step information (this information is always read) +$ maximum global time step, maximum CFL time step for x-y and +$ k-theta, minimum source term time step (all in seconds). +$ +$ + 1 1 1 1 +$ +$ Start of namelist input section ------------------------------------ $ +$ Starting with WAVEWATCH III version 2.00, the tunable parameters +$ for source terms, propagation schemes, and numerics are read using +$ namelists. Any namelist found in the folowing sections up to the +$ end-of-section identifier string (see below) is temporarily written +$ to ww3_grid.scratch, and read from there if necessary. Namelists +$ not needed for the given switch settings will be skipped +$ automatically, and the order of the namelists is immaterial. +$ As an example, namelist input to change SWELLF and ZWND in the +$ Tolman and Chalikov input would be +$ +$ &SIN2 SWELLF = 0.1, ZWND = 15. / +$ +$ Define constants in source terms ----------------------------------- $ +$ +$ Input - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +$ WAM-3 : Namelist SIN1 +$ CINP : Proportionality constant. +$ &SIN1 CINP= 0.25 / +$ +$ Tolman and Chalikov : Namelist SIN2 +$ ZWND : Height of wind (m). +$ SWELLF : swell factor in (2.48). +$ STABSH, STABOF, CNEG, CPOS, FNEG : +$ c0, ST0, c1, c2 and f1 in . (2.63) +$ through (2.65) for definition of +$ effective wind speed (!/STAB2). +$ +$ Nonlinear interactions - - - - - - - - - - - - - - - - - - - - - - - +$ Discrete I.A. : Namelist SNL1 +$ LAMBDA : Lambda in source term. +$ NLPROP : C in sourc term. NOTE : default +$ value depends on other source +$ terms selected. +$ KDCONV : Factor before kd in Eq. (2.24). +$ KDMIN, SNLCS1, SNLCS2, SNLCS3 : +$ Minimum kd, and constants c1-3 +$ in depth scaling function. +$ Exact interactions : Namelist SNL2 +$ IQTYPE : Type of depth treatment +$ 1 : Deep water +$ 2 : Deep water / WAM scaling +$ 3 : Shallow water +$ TAILNL : Parametric tail power. +$ NDEPTH : Number of depths in for which +$ integration space is established. +$ Used for IQTYPE = 3 only +$ Namelist ANL2 +$ DEPTHS : Array with depths for NDEPTH = 3 +$ +$ Dissipation - - - - - - - - - - - - - - - - - - - - - - - - - - - - +$ WAM-3 : Namelist SDS1 +$ CDIS, APM : As in source term. +$ +$ Tolman and Chalikov : Namelist SDS2 +$ SDSA0, SDSA1, SDSA2, SDSB0, SDSB1, PHIMIN : +$ Constants a0, a1, a2, b0, b1 and +$ PHImin. +$ +$ BAJ (adjusted) +$ +&SDB1 BJGAM = 0.64, BJALFA = 0.8, DBFLAG = 1.0 / +$ +$ +&UNST +UGOBCAUTO = F +UGOBCDEPTH= -10. +EXPFSN = F, +EXPFSPSI = F, +EXPFSFCT = F, +IMPFSN = F, +IMPTOTAL = T, +IMPREFRACTION = T, +IMPFREQSHIFT = T, +IMPSOURCE = T, +SETUP_APPLY_WLV = F +SOLVERTHR_SETUP=1E-14 +CRIT_DEP_SETUP=0.1 +JGS_USE_JACOBI = T, +JGS_NLEVEL = 0 +JGS_SOURCE_NONLINEAR = F +JGS_BLOCK_GAUSS_SEIDEL = T, +JGS_TERMINATE_MAXITER = T, +JGS_MAXITER = 100000, +JGS_TERMINATE_NORM = F, +JGS_TERMINATE_DIFFERENCE = T, +JGS_DIFF_THR = 1.E-6, +JGS_PMIN = 3.0 +JGS_LIMITER = F, +JGS_BLOCK_GAUSS_SEIDEL = T +JGS_NORM_THR = 1.E-6 +/ +$ +$ +$ Bottom friction - - - - - - - - - - - - - - - - - - - - - - - - - - +$ JONSWAP : Namelist SBT1 +$ GAMMA : As it says. +$ &SBT1 GAMMA = 0.15 / +$ +$ Propagation schemes ------------------------------------------------ $ +$ First order : Namelist PRO1 +$ CFLTM : Maximum CFL number for refraction. +$ +$ UQ with diffusion : Namelist PRO2 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ DTIME : Swell age (s) in garden sprinkler +$ correction. If 0., all diffusion +$ switched off. If small non-zero +$ (DEFAULT !!!) only wave growth +$ diffusion. +$ LATMIN : Maximum latitude used in calc. of +$ strength of diffusion for prop. +$ +$ UQ with averaging : Namelist PRO3 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ WDTHCG : Tuning factor propag. direction. +$ WDTHTH : Tuning factor normal direction. +$ +$ UQ with divergence : Namelist PRO4 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ QTFAC : Tuning factor Eq. (3.41). +$ RSFAC : Tuning factor Eq. (3.42). +$ RNFAC : Tuning factor Eq. (3.43). +$ +$ Miscellaneous ------------------------------------------------------ $ +$ Misc. parameters : Namelist MISC +$ CICE0 : Ice concentration cut-off. +$ CICEN : Ice concentration cut-off. +$ XSEED : Xseed in seeding alg. (!/SEED). +$ FLAGTR : Indicating presence and type of +$ subgrid information : +$ 0 : No subgrid information. +$ 1 : Transparancies at cell boun- +$ daries between grid points. +$ 2 : Transp. at cell centers. +$ 3 : Like 1 with cont. ice. +$ 4 : Like 2 with cont. ice. +$ XP, XR, XFILT +$ Xp, Xr and Xf for the dynamic +$ integration scheme. +$ +$ In the 'Out of the box' test setup we run with sub-grid obstacles +$ and with continuous ice treatment. +$ +$ &MISC CICE0 = 0.25, CICEN = 0.75, FLAGTR = 4 / +$ +$ Mandatory string to identify end of namelist input section. +$ +END OF NAMELISTS +$ +$ Define grid -------------------------------------------------------- $ +$ + 'UNST' F 'NONE' +$ + 4.0 0.03 20 -1. 4 1 '(20f10.2)' 'NAME' '../input/Boers.msh' +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed). +$ +$ 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +$ +$ If sub-grid information is avalaible as indicated by FLAGTR above, +$ additional input to define this is needed below. In such cases a +$ field of fractional obstructions at or between grid points needs to +$ be supplied. First the location and format of the data is defined +$ by (as above) : +$ - Unit number of file (can be 10, and/or identical to bottem depth +$ unit), scale factor for fractional obstruction, IDLA, IDFM, +$ format for formatted read, FROM and filename +$ +$ 10 0.2 3 1 '(....)' 'NAME' 'obstr.inp' +$ +$ *** NOTE if this unit number is the same as the previous bottom +$ depth unit number, it is assumed that this is the same file +$ without further checks. *** +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed, +$ except between the two fields). +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 5 5 5 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ *** NOTE size of fields is always NX * NY *** +$ + 85 3 1 '(....)' 'PART' 'mapsta.inp' +$ Input boundary points ---------------------------------------------- $ +$ An unlimited number of lines identifying points at which input +$ boundary conditions are to be defined. If the actual input data is +$ not defined in the actual wave model run, the initial conditions +$ will be applied as constant boundary conditions. Each line contains: +$ Discrete grid counters (IX,IY) of the active point and a +$ connect flag. If this flag is true, and the present and previous +$ point are on a grid line or diagonal, all intermediate points +$ are also defined as boundary points. +$ +1 1 F +2 1 F +9 1 F +17 1 F +25 1 F +33 1 F +41 1 F +45 1 F +37 1 F +29 1 F +21 1 F +13 1 F +5 1 F +$ +$ Close list by defining point (0,0) (mandatory) +$ + 0 0 F +$ +$ +$ +$ Excluded grid points from segment data ( FROM != PART ) +$ First defined as lines, identical to the definition of the input +$ boundary points, and closed the same way. +$ + 0 0 F +$ +$ Second, define a point in a closed body of sea points to remove +$ the entire body os sea points. Also close by point (0,0) +$ + 0 0 +$ +$ Output boundary points --------------------------------------------- $ +$ Output boundary points are defined as a number of straight lines, +$ defined by its starting point (X0,Y0), increments (DX,DY) and number +$ of points. A negative number of points starts a new output file. +$ Note that this data is only generated if requested by the actual +$ program. Example again for spherical grid in degrees. +$ +$ -2.5312 48.5 0.00 0.008738 102 +$ -2.5312 49.3850 0.013554 0.00 51 +$ +$ Close list by defining line with 0 points (mandatory) +$ + 0. 0. 0. 0. 0 +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.19/input_Case1A/ww3_grid_a.inp b/regtests/ww3_tp2.19/input_Case1A/ww3_grid_a.inp new file mode 100644 index 000000000..9d5a96c6f --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1A/ww3_grid_a.inp @@ -0,0 +1,302 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Grid preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Grid name (C*30, in quotes) +$ + 'Boers' +$ +$ Frequency increment factor and first frequency (Hz) ---------------- $ +$ number of frequencies (wavenumbers) and directions, relative offset +$ of first direction in terms of the directional increment [-0.5,0.5]. +$ In versions 1.18 and 2.22 of the model this value was by definiton 0, +$ it is added to mitigate the GSE for a first order scheme. Note that +$ this factor is IGNORED in the print plots in ww3_outp. +$ +1.1 0.0398 46 360 0. +$ +$ Set model flags ---------------------------------------------------- $ +$ - FLDRY Dry run (input/output only, no calculation). +$ - FLCX, FLCY Activate X and Y component of propagation. +$ - FLCTH, FLCK Activate direction and wavenumber shifts. +$ - FLSOU Activate source terms. +$ + F T T F F T +$ +$ Set time steps ----------------------------------------------------- $ +$ - Time step information (this information is always read) +$ maximum global time step, maximum CFL time step for x-y and +$ k-theta, minimum source term time step (all in seconds). +$ +$ + 2 2 2 2 +$ +$ Start of namelist input section ------------------------------------ $ +$ Starting with WAVEWATCH III version 2.00, the tunable parameters +$ for source terms, propagation schemes, and numerics are read using +$ namelists. Any namelist found in the folowing sections up to the +$ end-of-section identifier string (see below) is temporarily written +$ to ww3_grid.scratch, and read from there if necessary. Namelists +$ not needed for the given switch settings will be skipped +$ automatically, and the order of the namelists is immaterial. +$ As an example, namelist input to change SWELLF and ZWND in the +$ Tolman and Chalikov input would be +$ +$ &SIN2 SWELLF = 0.1, ZWND = 15. / +$ +$ Define constants in source terms ----------------------------------- $ +$ +$ Input - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +$ WAM-3 : Namelist SIN1 +$ CINP : Proportionality constant. +$ &SIN1 CINP= 0.25 / +$ +$ Tolman and Chalikov : Namelist SIN2 +$ ZWND : Height of wind (m). +$ SWELLF : swell factor in (2.48). +$ STABSH, STABOF, CNEG, CPOS, FNEG : +$ c0, ST0, c1, c2 and f1 in . (2.63) +$ through (2.65) for definition of +$ effective wind speed (!/STAB2). +$ +$ Nonlinear interactions - - - - - - - - - - - - - - - - - - - - - - - +$ Discrete I.A. : Namelist SNL1 +$ LAMBDA : Lambda in source term. +$ NLPROP : C in sourc term. NOTE : default +$ value depends on other source +$ terms selected. +$ KDCONV : Factor before kd in Eq. (2.24). +$ KDMIN, SNLCS1, SNLCS2, SNLCS3 : +$ Minimum kd, and constants c1-3 +$ in depth scaling function. +$ Exact interactions : Namelist SNL2 +$ IQTYPE : Type of depth treatment +$ 1 : Deep water +$ 2 : Deep water / WAM scaling +$ 3 : Shallow water +$ TAILNL : Parametric tail power. +$ NDEPTH : Number of depths in for which +$ integration space is established. +$ Used for IQTYPE = 3 only +$ Namelist ANL2 +$ DEPTHS : Array with depths for NDEPTH = 3 +$ +$ Dissipation - - - - - - - - - - - - - - - - - - - - - - - - - - - - +$ WAM-3 : Namelist SDS1 +$ CDIS, APM : As in source term. +$ +$ Tolman and Chalikov : Namelist SDS2 +$ SDSA0, SDSA1, SDSA2, SDSB0, SDSB1, PHIMIN : +$ Constants a0, a1, a2, b0, b1 and +$ PHImin. +$ +$ BAJ (adjusted) +$ +&SDB1 BJGAM = 0.64, BJALFA = 0.8 / +$ +$ +&UNST +UGOBCAUTO = F +UGOBCDEPTH= -10. +EXPFSN = F, +EXPFSPSI = F, +EXPFSFCT = F, +IMPFSN = F, +IMPTOTAL = T, +IMPREFRACTION = T, +IMPFREQSHIFT = T, +IMPSOURCE = T, +SETUP_APPLY_WLV = F +SOLVERTHR_SETUP=1E-14 +CRIT_DEP_SETUP=0.1 +JGS_USE_JACOBI = T, +JGS_NLEVEL = 0 +JGS_SOURCE_NONLINEAR = F +JGS_BLOCK_GAUSS_SEIDEL = T, +JGS_TERMINATE_MAXITER = T, +JGS_MAXITER = 100000, +JGS_TERMINATE_NORM = F, +JGS_TERMINATE_DIFFERENCE = T, +JGS_DIFF_THR = 1.E-6, +JGS_PMIN = 3.0 +JGS_LIMITER = F, +JGS_BLOCK_GAUSS_SEIDEL = T +JGS_NORM_THR = 1.E-6 +/ +$ +$ +$ Bottom friction - - - - - - - - - - - - - - - - - - - - - - - - - - +$ JONSWAP : Namelist SBT1 +$ GAMMA : As it says. +$ &SBT1 GAMMA = 0.15 / +$ +$ Propagation schemes ------------------------------------------------ $ +$ First order : Namelist PRO1 +$ CFLTM : Maximum CFL number for refraction. +$ +$ UQ with diffusion : Namelist PRO2 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ DTIME : Swell age (s) in garden sprinkler +$ correction. If 0., all diffusion +$ switched off. If small non-zero +$ (DEFAULT !!!) only wave growth +$ diffusion. +$ LATMIN : Maximum latitude used in calc. of +$ strength of diffusion for prop. +$ +$ UQ with averaging : Namelist PRO3 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ WDTHCG : Tuning factor propag. direction. +$ WDTHTH : Tuning factor normal direction. +$ +$ UQ with divergence : Namelist PRO4 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ QTFAC : Tuning factor Eq. (3.41). +$ RSFAC : Tuning factor Eq. (3.42). +$ RNFAC : Tuning factor Eq. (3.43). +$ +$ Miscellaneous ------------------------------------------------------ $ +$ Misc. parameters : Namelist MISC +$ CICE0 : Ice concentration cut-off. +$ CICEN : Ice concentration cut-off. +$ XSEED : Xseed in seeding alg. (!/SEED). +$ FLAGTR : Indicating presence and type of +$ subgrid information : +$ 0 : No subgrid information. +$ 1 : Transparancies at cell boun- +$ daries between grid points. +$ 2 : Transp. at cell centers. +$ 3 : Like 1 with cont. ice. +$ 4 : Like 2 with cont. ice. +$ XP, XR, XFILT +$ Xp, Xr and Xf for the dynamic +$ integration scheme. +$ +$ In the 'Out of the box' test setup we run with sub-grid obstacles +$ and with continuous ice treatment. +$ +$ &MISC CICE0 = 0.25, CICEN = 0.75, FLAGTR = 4 / +$ +$ Mandatory string to identify end of namelist input section. +$ +END OF NAMELISTS +$ +$ Define grid -------------------------------------------------------- $ +$ + 'UNST' F 'NONE' +$ + 4.0 0.03 20 -1. 4 1 '(20f10.2)' 'NAME' '../input/Boers.msh' +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed). +$ +$ 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +$ +$ If sub-grid information is avalaible as indicated by FLAGTR above, +$ additional input to define this is needed below. In such cases a +$ field of fractional obstructions at or between grid points needs to +$ be supplied. First the location and format of the data is defined +$ by (as above) : +$ - Unit number of file (can be 10, and/or identical to bottem depth +$ unit), scale factor for fractional obstruction, IDLA, IDFM, +$ format for formatted read, FROM and filename +$ +$ 10 0.2 3 1 '(....)' 'NAME' 'obstr.inp' +$ +$ *** NOTE if this unit number is the same as the previous bottom +$ depth unit number, it is assumed that this is the same file +$ without further checks. *** +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed, +$ except between the two fields). +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 5 5 5 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ *** NOTE size of fields is always NX * NY *** +$ + 85 3 1 '(....)' 'PART' 'mapsta.inp' +$ Input boundary points ---------------------------------------------- $ +$ An unlimited number of lines identifying points at which input +$ boundary conditions are to be defined. If the actual input data is +$ not defined in the actual wave model run, the initial conditions +$ will be applied as constant boundary conditions. Each line contains: +$ Discrete grid counters (IX,IY) of the active point and a +$ connect flag. If this flag is true, and the present and previous +$ point are on a grid line or diagonal, all intermediate points +$ are also defined as boundary points. +$ +1 1 F +2 1 F +9 1 F +17 1 F +25 1 F +33 1 F +41 1 F +45 1 F +37 1 F +29 1 F +21 1 F +13 1 F +5 1 F +$ +$ Close list by defining point (0,0) (mandatory) +$ + 0 0 F +$ +$ +$ +$ Excluded grid points from segment data ( FROM != PART ) +$ First defined as lines, identical to the definition of the input +$ boundary points, and closed the same way. +$ + 0 0 F +$ +$ Second, define a point in a closed body of sea points to remove +$ the entire body os sea points. Also close by point (0,0) +$ + 0 0 +$ +$ Output boundary points --------------------------------------------- $ +$ Output boundary points are defined as a number of straight lines, +$ defined by its starting point (X0,Y0), increments (DX,DY) and number +$ of points. A negative number of points starts a new output file. +$ Note that this data is only generated if requested by the actual +$ program. Example again for spherical grid in degrees. +$ +$ -2.5312 48.5 0.00 0.008738 102 +$ -2.5312 49.3850 0.013554 0.00 51 +$ +$ Close list by defining line with 0 points (mandatory) +$ + 0. 0. 0. 0. 0 +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.19/input_Case1A/ww3_grid_a.nml b/regtests/ww3_tp2.19/input_Case1A/ww3_grid_a.nml new file mode 100644 index 000000000..b184292b5 --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1A/ww3_grid_a.nml @@ -0,0 +1,265 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_grid.nml - Grid pre-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the spectrum parameterization via SPECTRUM_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! SPECTRUM%XFR = 0. ! frequency increment +! SPECTRUM%FREQ1 = 0. ! first frequency (Hz) +! SPECTRUM%NK = 0 ! number of frequencies (wavenumbers) +! SPECTRUM%NTH = 0 ! number of direction bins +! SPECTRUM%THOFF = 0. ! relative offset of first direction [-0.5,0.5] +! -------------------------------------------------------------------- ! +&SPECTRUM_NML + SPECTRUM%XFR = 1.10 + SPECTRUM%FREQ1 = 0.0398 + SPECTRUM%NK = 46 + SPECTRUM%NTH = 360 +/ + +! -------------------------------------------------------------------- ! +! Define the run parameterization via RUN_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! RUN%FLDRY = F ! dry run (I/O only, no calculation) +! RUN%FLCX = F ! x-component of propagation +! RUN%FLCY = F ! y-component of propagation +! RUN%FLCTH = F ! direction shift +! RUN%FLCK = F ! wavenumber shift +! RUN%FLSOU = F ! source terms +! -------------------------------------------------------------------- ! +&RUN_NML + RUN%FLCX = T + RUN%FLCY = T + RUN%FLSOU = T +/ + +! -------------------------------------------------------------------- ! +! Define the timesteps parameterization via TIMESTEPS_NML namelist +! +! * It is highly recommended to set up time steps which are multiple +! between them. +! +! * The first time step to calculate is the maximum CFL time step +! which depend on the lowest frequency FREQ1 previously set up and the +! lowest spatial grid resolution in meters DXY. +! reminder : 1 degree=60minutes // 1minute=1mile // 1mile=1.852km +! The formula for the CFL time is : +! Tcfl = DXY / (G / (FREQ1*4*Pi) ) with the constants Pi=3,14 and G=9.8m/s²; +! DTXY ~= 90% Tcfl +! DTMAX ~= 3 * DTXY (maximum global time step limit) +! +! * The refraction time step depends on how strong can be the current velocities +! on your grid : +! DTKTH ~= DTMAX / 2 ! in case of no or light current velocities +! DTKTH ~= DTMAX / 10 ! in case of strong current velocities +! +! * The source terms time step is usually defined between 5s and 60s. +! A common value is 10s. +! DTMIN ~= 10 +! +! * namelist must be terminated with / +! * definitions & defaults: +! TIMESTEPS%DTMAX = 0. ! maximum global time step (s) +! TIMESTEPS%DTXY = 0. ! maximum CFL time step for x-y (s) +! TIMESTEPS%DTKTH = 0. ! maximum CFL time step for k-th (s) +! TIMESTEPS%DTMIN = 0. ! minimum source term time step (s) +! -------------------------------------------------------------------- ! +&TIMESTEPS_NML + TIMESTEPS%DTMAX = 2. + TIMESTEPS%DTXY = 2. + TIMESTEPS%DTKTH = 2. + TIMESTEPS%DTMIN = 2. +/ + +! -------------------------------------------------------------------- ! +! Define the grid to preprocess via GRID_NML namelist +! +! * the tunable parameters for source terms, propagation schemes, and +! numerics are read using namelists. +! * Any namelist found in the folowing sections is temporarily written +! to param.scratch, and read from there if necessary. +! * The order of the namelists is immaterial. +! * Namelists not needed for the given switch settings will be skipped +! automatically +! +! * grid type can be : +! 'RECT' : rectilinear +! 'CURV' : curvilinear +! 'UNST' : unstructured (triangle-based) +! +! * coordinate system can be : +! 'SPHE' : Spherical (degrees) +! 'CART' : Cartesian (meters) +! +! * grid closure can only be applied in spherical coordinates +! +! * grid closure can be : +! 'NONE' : No closure is applied +! 'SMPL' : Simple grid closure. Grid is periodic in the +! : i-index and wraps at i=NX+1. In other words, +! : (NX+1,J) => (1,J). A grid with simple closure +! : may be rectilinear or curvilinear. +! 'TRPL' : Tripole grid closure : Grid is periodic in the +! : i-index and wraps at i=NX+1 and has closure at +! : j=NY+1. In other words, (NX+1,J<=NY) => (1,J) +! : and (I,NY+1) => (NX-I+1,NY). Tripole +! : grid closure requires that NX be even. A grid +! : with tripole closure must be curvilinear. +! +! * The coastline limit depth is the value which distinguish the sea +! points to the land points. All the points with depth values (ZBIN) +! greater than this limit (ZLIM) will be considered as excluded points +! and will never be wet points, even if the water level grows over. +! It can only overwrite the status of a sea point to a land point. +! The value must have a negative value under the mean sea level +! +! * The minimum water depth allowed to compute the model is the absolute +! depth value (DMIN) used in the model if the input depth is lower to +! avoid the model to blow up. +! +! * namelist must be terminated with / +! * definitions & defaults: +! GRID%NAME = 'unset' ! grid name (30 char) +! GRID%NML = 'namelists.nml' ! namelists filename +! GRID%TYPE = 'unset' ! grid type +! GRID%COORD = 'unset' ! coordinate system +! GRID%CLOS = 'unset' ! grid closure +! +! GRID%ZLIM = 0. ! coastline limit depth (m) +! GRID%DMIN = 0. ! abs. minimum water depth (m) +! -------------------------------------------------------------------- ! +&GRID_NML + GRID%NAME = 'Boers' + GRID%NML = '../input_Case1A/namelists_a.nml' + GRID%TYPE = 'UNST' + GRID%COORD = 'CART' + GRID%CLOS = 'F' + GRID%ZLIM = 4.0 + GRID%DMIN = 0.03 +/ + +! -------------------------------------------------------------------- ! +! Define the unstructured grid type via UNST_NML namelist +! - only for UNST grids - +! +! * The minimum grid size is 3x3. +! +! * &MISC namelist must be removed +! +! * The depth value must have negative values under the mean sea level +! +! * The map value must be set as : +! -2 : Excluded boundary point (covered by ice) +! -1 : Excluded sea point (covered by ice) +! 0 : Excluded land point +! 1 : Sea point +! 2 : Active boundary point +! 3 : Excluded grid point +! 7 : Ice point +! +! * the file must be a GMESH grid file containing node and element lists. +! +! * Extra open boundary list file with UGOBCFILE in namelist &UNST +! An example is given in regtest ww3_tp2.7 +! +! * value <= scale_fac * value_read +! +! * IDLA : Layout indicator : +! 1 : Read line-by-line bottom to top. (default) +! 2 : Like 1, single read statement. +! 3 : Read line-by-line top to bottom. +! 4 : Like 3, single read statement. +! * IDFM : format indicator : +! 1 : Free format. (default) +! 2 : Fixed format. +! 3 : Unformatted. +! * FORMAT : element format to read : +! '(....)' : auto detected (default) +! '(f10.6)' : float type +! +! * Example : +! IDF SF IDLA IDFM FORMAT FILENAME +! 20 -1. 4 2 '(20f10.2)' 'ngug.msh' +! +! * namelist must be terminated with / +! * definitions & defaults: +! UNST%SF = 1. ! unst scale factor +! UNST%FILENAME = 'unset' ! unst filename +! UNST%IDF = 20 ! unst file unit number +! UNST%IDLA = 1 ! unst layout indicator +! UNST%IDFM = 1 ! unst format indicator +! UNST%FORMAT = '(....)' ! unst formatted read format +! +! UNST%UGOBCFILE = 'unset' ! additional boundary list file +! -------------------------------------------------------------------- ! +&UNST_NML + UNST%SF = -1. + UNST%FILENAME = '../input/Boers.msh' + UNST%IDLA = 4 + UNST%FORMAT = '(20f10.2)' +/ + +! -------------------------------------------------------------------- ! +! Define the input boundary points via INBND_COUNT_NML and +! INBND_POINT_NML namelist +! - for RECT, CURV and UNST grids - +! +! * If no mask defined, INBOUND can be used +! +! * If the actual input data is not defined in the actual wave model run +! the initial conditions will be applied as constant boundary conditions. +! +! * The number of points is defined by INBND_COUNT +! +! * The points must start from index 1 to N +! +! * Each line contains: +! Discrete grid counters (IX,IY) of the active point and a +! connect flag. If this flag is true, and the present and previous +! point are on a grid line or diagonal, all intermediate points +! are also defined as boundary points. +! +! * Included point : +! grid points from segment data +! Defines as lines identifying points at which +! input boundary conditions are to be defined. +! +! * namelist must be terminated with / +! * definitions & defaults: +! INBND_COUNT%N_POINT = 0 ! number of segments +! +! INBND_POINT(I)%X_INDEX = 0 ! x index included point +! INBND_POINT(I)%Y_INDEX = 0 ! y index included point +! INBND_POINT(I)%CONNECT = F ! connect flag +! +! OR +! INBND_POINT(I) = 0 0 F ! included point +! -------------------------------------------------------------------- ! +&INBND_COUNT_NML + INBND_COUNT%N_POINT = 13 +/ + +&INBND_POINT_NML + INBND_POINT(1) = 1 1 F + INBND_POINT(2) = 2 1 F + INBND_POINT(3) = 9 1 F + INBND_POINT(4) = 17 1 F + INBND_POINT(5) = 25 1 F + INBND_POINT(6) = 33 1 F + INBND_POINT(7) = 41 1 F + INBND_POINT(8) = 45 1 F + INBND_POINT(9) = 37 1 F + INBND_POINT(10) = 29 1 F + INBND_POINT(11) = 21 1 F + INBND_POINT(12) = 13 1 F + INBND_POINT(13) = 5 1 F +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_tp2.19/input_Case1A/ww3_grid_b.inp b/regtests/ww3_tp2.19/input_Case1A/ww3_grid_b.inp new file mode 100644 index 000000000..245b7d56f --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1A/ww3_grid_b.inp @@ -0,0 +1,302 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Grid preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Grid name (C*30, in quotes) +$ + 'Flume ERDC' +$ +$ Frequency increment factor and first frequency (Hz) ---------------- $ +$ number of frequencies (wavenumbers) and directions, relative offset +$ of first direction in terms of the directional increment [-0.5,0.5]. +$ In versions 1.18 and 2.22 of the model this value was by definiton 0, +$ it is added to mitigate the GSE for a first order scheme. Note that +$ this factor is IGNORED in the print plots in ww3_outp. +$ +1.1 0.0398 46 360 0. +$ +$ Set model flags ---------------------------------------------------- $ +$ - FLDRY Dry run (input/output only, no calculation). +$ - FLCX, FLCY Activate X and Y component of propagation. +$ - FLCTH, FLCK Activate direction and wavenumber shifts. +$ - FLSOU Activate source terms. +$ + F T T F F T +$ +$ Set time steps ----------------------------------------------------- $ +$ - Time step information (this information is always read) +$ maximum global time step, maximum CFL time step for x-y and +$ k-theta, minimum source term time step (all in seconds). +$ +$ + 1 1 1 1 +$ +$ Start of namelist input section ------------------------------------ $ +$ Starting with WAVEWATCH III version 2.00, the tunable parameters +$ for source terms, propagation schemes, and numerics are read using +$ namelists. Any namelist found in the folowing sections up to the +$ end-of-section identifier string (see below) is temporarily written +$ to ww3_grid.scratch, and read from there if necessary. Namelists +$ not needed for the given switch settings will be skipped +$ automatically, and the order of the namelists is immaterial. +$ As an example, namelist input to change SWELLF and ZWND in the +$ Tolman and Chalikov input would be +$ +$ &SIN2 SWELLF = 0.1, ZWND = 15. / +$ +$ Define constants in source terms ----------------------------------- $ +$ +$ Input - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +$ WAM-3 : Namelist SIN1 +$ CINP : Proportionality constant. +$ &SIN1 CINP= 0.25 / +$ +$ Tolman and Chalikov : Namelist SIN2 +$ ZWND : Height of wind (m). +$ SWELLF : swell factor in (2.48). +$ STABSH, STABOF, CNEG, CPOS, FNEG : +$ c0, ST0, c1, c2 and f1 in . (2.63) +$ through (2.65) for definition of +$ effective wind speed (!/STAB2). +$ +$ Nonlinear interactions - - - - - - - - - - - - - - - - - - - - - - - +$ Discrete I.A. : Namelist SNL1 +$ LAMBDA : Lambda in source term. +$ NLPROP : C in sourc term. NOTE : default +$ value depends on other source +$ terms selected. +$ KDCONV : Factor before kd in Eq. (2.24). +$ KDMIN, SNLCS1, SNLCS2, SNLCS3 : +$ Minimum kd, and constants c1-3 +$ in depth scaling function. +$ Exact interactions : Namelist SNL2 +$ IQTYPE : Type of depth treatment +$ 1 : Deep water +$ 2 : Deep water / WAM scaling +$ 3 : Shallow water +$ TAILNL : Parametric tail power. +$ NDEPTH : Number of depths in for which +$ integration space is established. +$ Used for IQTYPE = 3 only +$ Namelist ANL2 +$ DEPTHS : Array with depths for NDEPTH = 3 +$ +$ Dissipation - - - - - - - - - - - - - - - - - - - - - - - - - - - - +$ WAM-3 : Namelist SDS1 +$ CDIS, APM : As in source term. +$ +$ Tolman and Chalikov : Namelist SDS2 +$ SDSA0, SDSA1, SDSA2, SDSB0, SDSB1, PHIMIN : +$ Constants a0, a1, a2, b0, b1 and +$ PHImin. +$ +$ BAJ (adjusted) +$ +&SDB1 BJGAM = 0.43, BJALFA = 1.0, DBFLAG = 2.0 / +$ +$ +&UNST +UGOBCAUTO = F +UGOBCDEPTH= -10. +EXPFSN = F, +EXPFSPSI = F, +EXPFSFCT = F, +IMPFSN = F, +IMPTOTAL = T, +IMPREFRACTION = T, +IMPFREQSHIFT = T, +IMPSOURCE = T, +SETUP_APPLY_WLV = F +SOLVERTHR_SETUP=1E-14 +CRIT_DEP_SETUP=0.1 +JGS_USE_JACOBI = T, +JGS_NLEVEL = 0 +JGS_SOURCE_NONLINEAR = F +JGS_BLOCK_GAUSS_SEIDEL = T, +JGS_TERMINATE_MAXITER = T, +JGS_MAXITER = 100000, +JGS_TERMINATE_NORM = F, +JGS_TERMINATE_DIFFERENCE = T, +JGS_DIFF_THR = 1.E-6, +JGS_PMIN = 3.0 +JGS_LIMITER = F, +JGS_BLOCK_GAUSS_SEIDEL = T +JGS_NORM_THR = 1.E-6 +/ +$ +$ +$ Bottom friction - - - - - - - - - - - - - - - - - - - - - - - - - - +$ JONSWAP : Namelist SBT1 +$ GAMMA : As it says. +$ &SBT1 GAMMA = 0.15 / +$ +$ Propagation schemes ------------------------------------------------ $ +$ First order : Namelist PRO1 +$ CFLTM : Maximum CFL number for refraction. +$ +$ UQ with diffusion : Namelist PRO2 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ DTIME : Swell age (s) in garden sprinkler +$ correction. If 0., all diffusion +$ switched off. If small non-zero +$ (DEFAULT !!!) only wave growth +$ diffusion. +$ LATMIN : Maximum latitude used in calc. of +$ strength of diffusion for prop. +$ +$ UQ with averaging : Namelist PRO3 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ WDTHCG : Tuning factor propag. direction. +$ WDTHTH : Tuning factor normal direction. +$ +$ UQ with divergence : Namelist PRO4 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ QTFAC : Tuning factor Eq. (3.41). +$ RSFAC : Tuning factor Eq. (3.42). +$ RNFAC : Tuning factor Eq. (3.43). +$ +$ Miscellaneous ------------------------------------------------------ $ +$ Misc. parameters : Namelist MISC +$ CICE0 : Ice concentration cut-off. +$ CICEN : Ice concentration cut-off. +$ XSEED : Xseed in seeding alg. (!/SEED). +$ FLAGTR : Indicating presence and type of +$ subgrid information : +$ 0 : No subgrid information. +$ 1 : Transparancies at cell boun- +$ daries between grid points. +$ 2 : Transp. at cell centers. +$ 3 : Like 1 with cont. ice. +$ 4 : Like 2 with cont. ice. +$ XP, XR, XFILT +$ Xp, Xr and Xf for the dynamic +$ integration scheme. +$ +$ In the 'Out of the box' test setup we run with sub-grid obstacles +$ and with continuous ice treatment. +$ +$ &MISC CICE0 = 0.25, CICEN = 0.75, FLAGTR = 4 / +$ +$ Mandatory string to identify end of namelist input section. +$ +END OF NAMELISTS +$ +$ Define grid -------------------------------------------------------- $ +$ + 'UNST' F 'NONE' +$ + 4.0 0.03 20 -1. 4 1 '(20f10.2)' 'NAME' '../input/Boers.msh' +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed). +$ +$ 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +$ +$ If sub-grid information is avalaible as indicated by FLAGTR above, +$ additional input to define this is needed below. In such cases a +$ field of fractional obstructions at or between grid points needs to +$ be supplied. First the location and format of the data is defined +$ by (as above) : +$ - Unit number of file (can be 10, and/or identical to bottem depth +$ unit), scale factor for fractional obstruction, IDLA, IDFM, +$ format for formatted read, FROM and filename +$ +$ 10 0.2 3 1 '(....)' 'NAME' 'obstr.inp' +$ +$ *** NOTE if this unit number is the same as the previous bottom +$ depth unit number, it is assumed that this is the same file +$ without further checks. *** +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed, +$ except between the two fields). +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 5 5 5 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ *** NOTE size of fields is always NX * NY *** +$ + 85 3 1 '(....)' 'PART' 'mapsta.inp' +$ Input boundary points ---------------------------------------------- $ +$ An unlimited number of lines identifying points at which input +$ boundary conditions are to be defined. If the actual input data is +$ not defined in the actual wave model run, the initial conditions +$ will be applied as constant boundary conditions. Each line contains: +$ Discrete grid counters (IX,IY) of the active point and a +$ connect flag. If this flag is true, and the present and previous +$ point are on a grid line or diagonal, all intermediate points +$ are also defined as boundary points. +$ +1 1 F +2 1 F +9 1 F +17 1 F +25 1 F +33 1 F +41 1 F +45 1 F +37 1 F +29 1 F +21 1 F +13 1 F +5 1 F +$ +$ Close list by defining point (0,0) (mandatory) +$ + 0 0 F +$ +$ +$ +$ Excluded grid points from segment data ( FROM != PART ) +$ First defined as lines, identical to the definition of the input +$ boundary points, and closed the same way. +$ + 0 0 F +$ +$ Second, define a point in a closed body of sea points to remove +$ the entire body os sea points. Also close by point (0,0) +$ + 0 0 +$ +$ Output boundary points --------------------------------------------- $ +$ Output boundary points are defined as a number of straight lines, +$ defined by its starting point (X0,Y0), increments (DX,DY) and number +$ of points. A negative number of points starts a new output file. +$ Note that this data is only generated if requested by the actual +$ program. Example again for spherical grid in degrees. +$ +$ -2.5312 48.5 0.00 0.008738 102 +$ -2.5312 49.3850 0.013554 0.00 51 +$ +$ Close list by defining line with 0 points (mandatory) +$ + 0. 0. 0. 0. 0 +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.19/input_Case1A/ww3_grid_b.nml b/regtests/ww3_tp2.19/input_Case1A/ww3_grid_b.nml new file mode 100644 index 000000000..67bb07eff --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1A/ww3_grid_b.nml @@ -0,0 +1,265 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_grid.nml - Grid pre-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the spectrum parameterization via SPECTRUM_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! SPECTRUM%XFR = 0. ! frequency increment +! SPECTRUM%FREQ1 = 0. ! first frequency (Hz) +! SPECTRUM%NK = 0 ! number of frequencies (wavenumbers) +! SPECTRUM%NTH = 0 ! number of direction bins +! SPECTRUM%THOFF = 0. ! relative offset of first direction [-0.5,0.5] +! -------------------------------------------------------------------- ! +&SPECTRUM_NML + SPECTRUM%XFR = 1.10 + SPECTRUM%FREQ1 = 0.0398 + SPECTRUM%NK = 46 + SPECTRUM%NTH = 360 +/ + +! -------------------------------------------------------------------- ! +! Define the run parameterization via RUN_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! RUN%FLDRY = F ! dry run (I/O only, no calculation) +! RUN%FLCX = F ! x-component of propagation +! RUN%FLCY = F ! y-component of propagation +! RUN%FLCTH = F ! direction shift +! RUN%FLCK = F ! wavenumber shift +! RUN%FLSOU = F ! source terms +! -------------------------------------------------------------------- ! +&RUN_NML + RUN%FLCX = T + RUN%FLCY = T + RUN%FLSOU = T +/ + +! -------------------------------------------------------------------- ! +! Define the timesteps parameterization via TIMESTEPS_NML namelist +! +! * It is highly recommended to set up time steps which are multiple +! between them. +! +! * The first time step to calculate is the maximum CFL time step +! which depend on the lowest frequency FREQ1 previously set up and the +! lowest spatial grid resolution in meters DXY. +! reminder : 1 degree=60minutes // 1minute=1mile // 1mile=1.852km +! The formula for the CFL time is : +! Tcfl = DXY / (G / (FREQ1*4*Pi) ) with the constants Pi=3,14 and G=9.8m/s²; +! DTXY ~= 90% Tcfl +! DTMAX ~= 3 * DTXY (maximum global time step limit) +! +! * The refraction time step depends on how strong can be the current velocities +! on your grid : +! DTKTH ~= DTMAX / 2 ! in case of no or light current velocities +! DTKTH ~= DTMAX / 10 ! in case of strong current velocities +! +! * The source terms time step is usually defined between 5s and 60s. +! A common value is 10s. +! DTMIN ~= 10 +! +! * namelist must be terminated with / +! * definitions & defaults: +! TIMESTEPS%DTMAX = 0. ! maximum global time step (s) +! TIMESTEPS%DTXY = 0. ! maximum CFL time step for x-y (s) +! TIMESTEPS%DTKTH = 0. ! maximum CFL time step for k-th (s) +! TIMESTEPS%DTMIN = 0. ! minimum source term time step (s) +! -------------------------------------------------------------------- ! +&TIMESTEPS_NML + TIMESTEPS%DTMAX = 1. + TIMESTEPS%DTXY = 1. + TIMESTEPS%DTKTH = 1. + TIMESTEPS%DTMIN = 1. +/ + +! -------------------------------------------------------------------- ! +! Define the grid to preprocess via GRID_NML namelist +! +! * the tunable parameters for source terms, propagation schemes, and +! numerics are read using namelists. +! * Any namelist found in the folowing sections is temporarily written +! to param.scratch, and read from there if necessary. +! * The order of the namelists is immaterial. +! * Namelists not needed for the given switch settings will be skipped +! automatically +! +! * grid type can be : +! 'RECT' : rectilinear +! 'CURV' : curvilinear +! 'UNST' : unstructured (triangle-based) +! +! * coordinate system can be : +! 'SPHE' : Spherical (degrees) +! 'CART' : Cartesian (meters) +! +! * grid closure can only be applied in spherical coordinates +! +! * grid closure can be : +! 'NONE' : No closure is applied +! 'SMPL' : Simple grid closure. Grid is periodic in the +! : i-index and wraps at i=NX+1. In other words, +! : (NX+1,J) => (1,J). A grid with simple closure +! : may be rectilinear or curvilinear. +! 'TRPL' : Tripole grid closure : Grid is periodic in the +! : i-index and wraps at i=NX+1 and has closure at +! : j=NY+1. In other words, (NX+1,J<=NY) => (1,J) +! : and (I,NY+1) => (NX-I+1,NY). Tripole +! : grid closure requires that NX be even. A grid +! : with tripole closure must be curvilinear. +! +! * The coastline limit depth is the value which distinguish the sea +! points to the land points. All the points with depth values (ZBIN) +! greater than this limit (ZLIM) will be considered as excluded points +! and will never be wet points, even if the water level grows over. +! It can only overwrite the status of a sea point to a land point. +! The value must have a negative value under the mean sea level +! +! * The minimum water depth allowed to compute the model is the absolute +! depth value (DMIN) used in the model if the input depth is lower to +! avoid the model to blow up. +! +! * namelist must be terminated with / +! * definitions & defaults: +! GRID%NAME = 'unset' ! grid name (30 char) +! GRID%NML = 'namelists.nml' ! namelists filename +! GRID%TYPE = 'unset' ! grid type +! GRID%COORD = 'unset' ! coordinate system +! GRID%CLOS = 'unset' ! grid closure +! +! GRID%ZLIM = 0. ! coastline limit depth (m) +! GRID%DMIN = 0. ! abs. minimum water depth (m) +! -------------------------------------------------------------------- ! +&GRID_NML + GRID%NAME = 'Boers' + GRID%NML = '../input_Case1A/namelists_b.nml' + GRID%TYPE = 'UNST' + GRID%COORD = 'CART' + GRID%CLOS = 'F' + GRID%ZLIM = 4.0 + GRID%DMIN = 0.03 +/ + +! -------------------------------------------------------------------- ! +! Define the unstructured grid type via UNST_NML namelist +! - only for UNST grids - +! +! * The minimum grid size is 3x3. +! +! * &MISC namelist must be removed +! +! * The depth value must have negative values under the mean sea level +! +! * The map value must be set as : +! -2 : Excluded boundary point (covered by ice) +! -1 : Excluded sea point (covered by ice) +! 0 : Excluded land point +! 1 : Sea point +! 2 : Active boundary point +! 3 : Excluded grid point +! 7 : Ice point +! +! * the file must be a GMESH grid file containing node and element lists. +! +! * Extra open boundary list file with UGOBCFILE in namelist &UNST +! An example is given in regtest ww3_tp2.7 +! +! * value <= scale_fac * value_read +! +! * IDLA : Layout indicator : +! 1 : Read line-by-line bottom to top. (default) +! 2 : Like 1, single read statement. +! 3 : Read line-by-line top to bottom. +! 4 : Like 3, single read statement. +! * IDFM : format indicator : +! 1 : Free format. (default) +! 2 : Fixed format. +! 3 : Unformatted. +! * FORMAT : element format to read : +! '(....)' : auto detected (default) +! '(f10.6)' : float type +! +! * Example : +! IDF SF IDLA IDFM FORMAT FILENAME +! 20 -1. 4 2 '(20f10.2)' 'ngug.msh' +! +! * namelist must be terminated with / +! * definitions & defaults: +! UNST%SF = 1. ! unst scale factor +! UNST%FILENAME = 'unset' ! unst filename +! UNST%IDF = 20 ! unst file unit number +! UNST%IDLA = 1 ! unst layout indicator +! UNST%IDFM = 1 ! unst format indicator +! UNST%FORMAT = '(....)' ! unst formatted read format +! +! UNST%UGOBCFILE = 'unset' ! additional boundary list file +! -------------------------------------------------------------------- ! +&UNST_NML + UNST%SF = -1. + UNST%FILENAME = '../input/Boers.msh' + UNST%IDLA = 4 + UNST%FORMAT = '(20f10.2)' +/ + +! -------------------------------------------------------------------- ! +! Define the input boundary points via INBND_COUNT_NML and +! INBND_POINT_NML namelist +! - for RECT, CURV and UNST grids - +! +! * If no mask defined, INBOUND can be used +! +! * If the actual input data is not defined in the actual wave model run +! the initial conditions will be applied as constant boundary conditions. +! +! * The number of points is defined by INBND_COUNT +! +! * The points must start from index 1 to N +! +! * Each line contains: +! Discrete grid counters (IX,IY) of the active point and a +! connect flag. If this flag is true, and the present and previous +! point are on a grid line or diagonal, all intermediate points +! are also defined as boundary points. +! +! * Included point : +! grid points from segment data +! Defines as lines identifying points at which +! input boundary conditions are to be defined. +! +! * namelist must be terminated with / +! * definitions & defaults: +! INBND_COUNT%N_POINT = 0 ! number of segments +! +! INBND_POINT(I)%X_INDEX = 0 ! x index included point +! INBND_POINT(I)%Y_INDEX = 0 ! y index included point +! INBND_POINT(I)%CONNECT = F ! connect flag +! +! OR +! INBND_POINT(I) = 0 0 F ! included point +! -------------------------------------------------------------------- ! +&INBND_COUNT_NML + INBND_COUNT%N_POINT = 13 +/ + +&INBND_POINT_NML + INBND_POINT(1) = 1 1 F + INBND_POINT(2) = 2 1 F + INBND_POINT(3) = 9 1 F + INBND_POINT(4) = 17 1 F + INBND_POINT(5) = 25 1 F + INBND_POINT(6) = 33 1 F + INBND_POINT(7) = 41 1 F + INBND_POINT(8) = 45 1 F + INBND_POINT(9) = 37 1 F + INBND_POINT(10) = 29 1 F + INBND_POINT(11) = 21 1 F + INBND_POINT(12) = 13 1 F + INBND_POINT(13) = 5 1 F +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_tp2.19/input_Case1A/ww3_ounf.inp b/regtests/ww3_tp2.19/input_Case1A/ww3_ounf.inp new file mode 100644 index 000000000..9593f72eb --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1A/ww3_ounf.inp @@ -0,0 +1,82 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Grid output post-processing $ +$--------------------------------------------------------------------- $ +$ Time, time increment and number of outputs (set to 4 days) +$ + 20180701 000000 1. 9999 +$ +$ Fields requested --------------------------------------------------- $ +$ +$ Output request flags identifying fields as in ww3_shel.inp. See that +$ file for a full documentation of field output options. Namelist type +$ selection is used here (for alternative F/T flags, see ww3_shel.inp). +$ +$ DPT CUR WND AST WLV ICE IBG D50 IC1 IC5 HS LM T02 T0M1 T01 FP DIR SPR +$ DP HIG EF TH1M STH1M TH2M STH2M WN PHS PTP PLP PDIR PSPR PWS TWS PNR +$ UST CHA CGE FAW TAW TWA WCC WCF WCH WCM SXY TWO BHD FOC TUS USS P2S +$ USF P2L TWI FIC ABR UBR BED FBB TBB MSS MSC DTD FC CFX CFD CFK U1 U2 +$ + N +WLV DPT T02 DIR CUR HS T0M1 FP SXX SXY SYY +$--------------------------------------------------------------------- $ +$ netCDF version [3,4] +$ and variable type 4 [2 = SHORT, 3 = it depends , 4 = REAL] +$ swell partitions [0 1 2 3 4 5] +$ variables in same file [T] or not [F] +$ + 4 4 + 0 1 2 + F +$ -------------------------------------------------------------------- $ +$ ITYPE = 0, inventory of file. +$ No additional input, the above time range is ignored. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 1, print plots. +$ IX,IY range and stride, flag for automatic scaling to +$ maximum value (otherwise fixed scaling), +$ vector component flag (dummy for scalar quantities). +$ +$ 1 12 1 1 12 1 F T +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 2, field statistics. +$ IX,IY range. +$ +$ 1 12 1 12 +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 3, transfer files. +$ IX, IY range, IDLA and IDFM as in ww3_grid.inp. +$ The additional option IDLA=5 gives ia longitude, lattitude +$ and parameter value(s) per record (defined points only). +$ +$1 12518 1 1 3 2 +$ +$ For each field and time a new file is generated with the file name +$ ww3.yymmddhh.xxx, where yymmddhh is a conventional time idicator, +$ and xxx is a field identifier. The first record of the file contains +$ a file ID (C*13), the time in yyyymmdd hhmmss format, the lowest, +$ highest and number of longitudes (2R,I), id. latitudes, the file +$ extension name (C*$), a scale factor (R), a unit identifier (C*10), +$ IDLA, IDFM, a format (C*11) and a number identifying undefined or +$ missing values (land, ice, etc.). The field follows as defined by +$ IDFM and IDLA, defined as in the grid proprocessor. IDLA=5 is added +$ and gives a set of records containing the longitude, latitude and +$ parameter value. Note that the actual data is written as an integers. +$ -------------------------------------------------------------------- $ +$ ITYPE = 4, Netcdf Files +$ S3: number of characters in date +$ IX, IY range +$ +ww3. +6 + 1 999999999 1 1 3 2 +$ For each field and time a new file is generated with the file name +$ ww3.date_xxx.nc , where date is a conventional time idicator with S3 +$ characters, +$ and xxx is a field identifier. +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.19/input_Case1A/ww3_ounf.nml b/regtests/ww3_tp2.19/input_Case1A/ww3_ounf.nml new file mode 100644 index 000000000..46d827bfe --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1A/ww3_ounf.nml @@ -0,0 +1,87 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_ounf.nml - Grid output post-processing ! +! -------------------------------------------------------------------- ! +! -------------------------------------------------------------------- ! +! Define the output fields to postprocess via FIELD_NML namelist +! +! * the detailed list of field names FIELD%LIST is given in ww3_shel.nml +! DPT CUR WND AST WLV ICE IBG D50 IC1 IC5 +! HS LM T02 T0M1 T01 FP DIR SPR DP HIG +! EF TH1M STH1M TH2M STH2M WN +! PHS PTP PLP PDIR PSPR PWS PDP PQP PPE PGW PSW PTM10 PT01 PT02 PEP TWS PNR +! UST CHA CGE FAW TAW TWA WCC WCF WCH WCM FWS +! SXY TWO BHD FOC TUS USS P2S USF P2L TWI FIC +! ABR UBR BED FBB TBB +! MSS MSC WL02 AXT AYT AXY +! DTD FC CFX CFD CFK +! U1 U2 +! +! * namelist must be terminated with / +! * definitions & defaults: +! FIELD%TIMESTART = '19000101 000000' ! Stop date for the output field +! FIELD%TIMESTRIDE = '0' ! Time stride for the output field +! FIELD%TIMECOUNT = '1000000000' ! Number of time steps +! FIELD%TIMESPLIT = 6 ! [0(nodate),4(yearly),6(monthly),8(daily),10(hourly)] +! FIELD%LIST = 'unset' ! List of output fields +! FIELD%PARTITION = '0 1 2 3' ! List of wave partitions ['0 1 2 3 4 5'] +! FIELD%SAMEFILE = T ! All the variables in the same file +! FIELD%TYPE = 3 ! [2 = SHORT, 3 = it depends , 4 = REAL] +! -------------------------------------------------------------------- ! +&FIELD_NML + FIELD%TIMESTART = '20180701 000000' + FIELD%TIMESTRIDE = '1' + FIELD%LIST = 'WLV DPT T02 DIR CUR HS T0M1 FP SXX SXY SYY' + FIELD%SAMEFILE = F + FIELD%TYPE = 4 +/ + + +! -------------------------------------------------------------------- ! +! Define the content of the output file via FILE_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! FILE%PREFIX = 'ww3.' ! Prefix for output file name +! FILE%NETCDF = 3 ! Netcdf version [3|4] +! FILE%IX0 = 1 ! First X-axis or node index +! FILE%IXN = 1000000000 ! Last X-axis or node index +! FILE%IY0 = 1 ! First Y-axis index +! FILE%IYN = 1000000000 ! Last Y-axis index +! -------------------------------------------------------------------- ! +&FILE_NML + FILE%NETCDF = 4 +/ + +! -------------------------------------------------------------------- ! +! Define the content of the output file via SMC_NML namelist +! +! * For SMC grids, IX0, IXN, IY0 and IYN from FILE_NML are not used. +! Two types of output are available: +! * TYPE=1: Flat 1D "seapoint" array of grid cells. +! * TYPE=2: Re-gridded regular grid with cell sizes being an integer +! * multiple of the smallest SMC grid cells size. +! +! * Note that the first/last longitudes and latitudes will be adjusted +! to snap to the underlying SMC grid edges. CELFAC is only used for +! type 2 output and defines the output cell sizes as an integer +! multiple of the smallest SMC Grid cell size. CELFAC should be a +! power of 2, e.g: 1,2,4,8,16, etc... +! +! * namelist must be terminated with / +! * definitions & defaults: +! SMC%TYPE = 1 ! SMC Grid type (1 or 2) +! SMC%SXO = -999.9 ! First longitude +! SMC%EXO = -999.9 ! Last longitude +! SMC%SYO = -999.9 ! First latitude +! SMC%EYO = -999.9 ! Last latitude +! SMC%CELFAC = 1 ! Cell size factor (SMCTYPE=2 only) +! SMC%NOVAL = UNDEF ! Fill value for wet cells with no data +! -------------------------------------------------------------------- ! +&SMC_NML +/ + + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! + diff --git a/regtests/ww3_tp2.19/input_Case1A/ww3_ounp.inp b/regtests/ww3_tp2.19/input_Case1A/ww3_ounp.inp new file mode 100644 index 000000000..c20417ad4 --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1A/ww3_ounp.inp @@ -0,0 +1,119 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III NETCDF Point output post-processing $ +$--------------------------------------------------------------------- $ +$ First output time (yyyymmdd hhmmss), increment of output (s), +$ and number of output times. +$ + 20180701 000000 1. 1000 +$ +$ Points requested --------------------------------------------------- $ +$ +$ Define points index for which output is to be generated. +$ If no one defined, all points are selected +$ One index number per line, negative number identifies end of list. +$ 1 +$ 2 +$ mandatory end of list + -1 +$ +$--------------------------------------------------------------------- $ +$ file prefix +$ number of characters in date [4(yearly),6(monthly),8(daily),10(hourly)] +$ netCDF version [3,4] +$ points in same file [T] or not [F] +$ and max number of points to be processed in one pass +$ output type ITYPE [0,1,2,3] +$ flag for global attributes WW3 [0] or variable version [1-2-3-4] +$ flag for dimensions order time,station [T] or station,time [F] +$ + ww3. + 6 + 4 + T 150 + 1 + 0 + T +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 0, inventory of file. +$ No additional input, the above time range is ignored. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 1, netCDF Spectra. +$ - Sub-type OTYPE : 1 : Print plots. +$ 2 : Table of 1-D spectra +$ 3 : Transfer file. +$ 4 : Spectral partitioning. +$ - Scaling factors for 1-D and 2-D spectra Negative factor +$ disables, output, factor = 0. gives normalized spectrum. +$ - Netcdf variable type [2=SHORT, 3=it depends, 4=REAL] +$ + 3 1 0 4 +$ +$ The transfer file contains records with the following contents. +$ +$ - File ID in quotes, number of frequencies, directions and points. +$ grid name in quotes (for unformatted file C*21,3I,C*30). +$ - Bin frequencies in Hz for all bins. +$ - Bin directions in radians for all bins (Oceanographic conv.). +$ -+ +$ - Time in yyyymmdd hhmmss format | loop +$ -+ | +$ - Point name (C*40), lat, lon, d, U10 and | loop | over +$ direction, current speed and direction | over | +$ - E(f,theta) | points | times +$ -+ -+ +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 2, netCDF Tables of (mean) parameter +$ - Sub-type OTYPE : 1 : Depth, current, wind +$ 2 : Mean wave pars. +$ 3 : Nondimensional pars. (U*) +$ 4 : Nondimensional pars. (U10) +$ 5 : 'Validation table' +$ 6 : WMO standard output +$ 4 +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 3, netCDF Source terms +$ - Sub-type OTYPE : 1 : Print plots. +$ 2 : Table of 1-D S(f). +$ 3 : Table of 1-D inverse time scales +$ (1/T = S/F). +$ 4 : Transfer file +$ - Scaling factors for 1-D and 2-D source terms. Negative +$ factor disables print plots, factor = 0. gives normalized +$ print plots. +$ - Flags for spectrum, input, interactions, dissipation, +$ bottom, ice and total source term. +$ - scale ISCALE for OTYPE=2,3 +$ 0 : Dimensional. +$ 1 : Nondimensional in terms of U10 +$ 2 : Nondimensional in terms of U* +$ 3-5: like 0-2 with f normalized with fp. +$ +$ 4 0 0 T T T T T T T 0 +$ +$ The transfer file contains records with the following contents. +$ +$ - File ID in quotes, number of frequencies, directions and points, +$ flags for spectrum and source terms (C*21, 3I, 6L) +$ - Bin frequencies in Hz for all bins. +$ - Bin directions in radians for all bins (Oceanographic conv.). +$ -+ +$ - Time in yyyymmdd hhmmss format | loop +$ -+ | +$ - Point name (C*40), depth, wind speed and | loop | over +$ direction, current speed and direction | over | +$ - E(f,theta) if requested | points | times +$ - Sin(f,theta) if requested | | +$ - Snl(f,theta) if requested | | +$ - Sds(f,theta) if requested | | +$ - Sbt(f,theta) if requested | | +$ - Sice(f,theta) if requested | | +$ - Stot(f,theta) if requested | | +$ -+ -+ +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.19/input_Case1A/ww3_ounp.nml b/regtests/ww3_tp2.19/input_Case1A/ww3_ounp.nml new file mode 100644 index 000000000..44807228a --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1A/ww3_ounp.nml @@ -0,0 +1,193 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_ounp.nml - Point output post-processing ! +! -------------------------------------------------------------------- ! + + +! -------------------------------------------------------------------- ! +! Define the output fields to postprocess via POINT_NML namelist +! +! +! * namelist must be terminated with / +! * definitions & defaults: +! POINT%TIMESTART = '19000101 000000' ! Stop date for the output field +! POINT%TIMESTRIDE = '0' ! Time stride for the output field +! POINT%TIMECOUNT = '1000000000' ! Number of time steps +! POINT%TIMESPLIT = 6 ! [4(yearly),6(monthly),8(daily),10(hourly)] +! POINT%LIST = 'all' ! List of points index ['all'|'1 2 3'] +! POINT%SAMEFILE = T ! All the points in the same file +! POINT%BUFFER = 150 ! Number of points to process per pass +! POINT%TYPE = 1 ! [0=inventory | 1=spectra | 2=mean param | 3=source terms] +! POINT%DIMORDER = T ! [time,station=T | station,time=F] +! -------------------------------------------------------------------- ! +&POINT_NML + POINT%TIMESTART = '20180701 000000' + POINT%TIMESTRIDE = '1' +/ + + +! -------------------------------------------------------------------- ! +! Define the content of the output file via FILE_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! FILE%PREFIX = 'ww3.' ! Prefix for output file name +! FILE%NETCDF = 3 ! Netcdf version [3|4] +! -------------------------------------------------------------------- ! +&FILE_NML + FILE%NETCDF = 4 +/ + + +! -------------------------------------------------------------------- ! +! Define the type 0, inventory of file +! +! * namelist must be terminated with / +! * definitions & defaults: +! No additional input, the above time range is ignored. +! -------------------------------------------------------------------- ! + + + +! -------------------------------------------------------------------- ! +! Define the type 1, spectra via SPECTRA_NML namelist +! +! Table of 1-D spectra content : +! - time, station id, station name, longitude, latitude +! - frequency : unit Hz, center band frequency - linear log scale (XFR factor) +! - ffp, f, th1m, sth1m, alpha : 1D spectral parameters +! - dpt, ust, wnd, wnddir : mean parameters +! +! Transfert file content : +! - time, station id, station name, longitude, latitude +! - frequency : unit Hz, center band frequency - linear log scale (XFR factor) +! - frequency1 : unit Hz, lower band frequency +! - frequency2 : unit Hz, upper band frequency +! - direction : unit degree, convention to, origin East, trigonometric order +! - efth(time,station,frequency,direction) : 2D spectral density +! - dpt, wnd, wnddir, cur, curdir : mean parameters +! +! Spectral partitioning content : +! - time, station id, station name, longitude, latitude +! - npart : number of partitions +! - hs, tp, lm, th1m, sth1m, ws, tm10, t01, t02 : partitioned parameters +! - dpt, wnd, wnddir, cur, curdir : mean parameters +! +! +! * namelist must be terminated with / +! * definitions & defaults: +! SPECTRA%OUTPUT = 3 ! 1: Print plots +! ! 2: Table of 1-D spectra +! ! 3: Transfer file +! ! 4: Spectral partitioning +! SPECTRA%SCALE_FAC = 1 ! Scale factor (-1=disabled) +! SPECTRA%OUTPUT_FAC = 0 ! Output factor (0=normalized) +! -------------------------------------------------------------------- ! +&SPECTRA_NML +/ + + +! -------------------------------------------------------------------- ! +! Define the type 2, mean parameter via PARAM_NML namelist +! +! Forcing parameters content : +! - dpt, wnd, wnddir, cur, curdir +! +! Mean wave parameters content : +! - hs, lm, tr, th1p, sth1p, fp, th1m, sth1m +! +! Nondimensional parameters (U*) content : +! - ust, efst, fpst, cd, alpha +! +! Nondimensional parameters (U10) content : +! - wnd, efst, fpst, cd, alpha +! +! Validation table content : +! - wnd, wnddir, hs, hsst, cpu, cmu, ast +! +! WMO stantdard output content : +! - wnd, wnddir, hs, tp +! +! * namelist must be terminated with / +! * definitions & defaults: +! PARAM%OUTPUT = 4 ! 1: Forcing parameters +! ! 2: Mean wave parameters +! ! 3: Nondimensional pars. (U*) +! ! 4: Nondimensional pars. (U10) +! ! 5: Validation table +! ! 6: WMO standard output +! -------------------------------------------------------------------- ! +&PARAM_NML +/ + + +! -------------------------------------------------------------------- ! +! Define the type 3, source terms via SOURCE_NML namelist +! +! Table of 1-D S(f) content : +! - time, station id, station name, longitude, latitude +! - frequency : unit Hz, center band frequency +! - ef(frequency) : 1D spectral density +! - Sin(frequency) : input source term +! - Snl(frequency) : non linear interactions source term +! - Sds(frequency) : dissipation source term +! - Sbt(frequency) : bottom source term +! - Sice(frequency) : ice source term +! - Stot(frequency) : total source term +! - dpt, ust, wnd : mean parameters +! +! Table of 1-D inverse time scales (1/T = S/F) content : +! - time, station id, station name, longitude, latitude +! - frequency : unit Hz, center band frequency +! - ef(frequency) : 1D spectral density +! - tini(frequency) : input inverse time scales source term +! - tnli(frequency) : non linear interactions inverse time scales source term +! - tdsi(frequency) : dissipation inverse time scales source term +! - tbti(frequency) : bottom inverse time scales source term +! - ticei(frequency) : ice inverse time scales source term +! - ttoti(frequency) : total inverse time scales source term +! - dpt, ust, wnd : mean parameters +! +! Transfert file content : +! - time, station id, station name, longitude, latitude +! - frequency : unit Hz, center band frequency - linear log scale (XFR factor) +! - frequency1 : unit Hz, lower band frequency +! - frequency2 : unit Hz, upper band frequency +! - direction : unit degree, convention to, origin East, trigonometric order +! - efth(frequency,direction) : 2D spectral density +! - Sin(frequency,direction) : input source term +! - Snl(frequency,direction) : non linear interactions source term +! - Sds(frequency,direction) : dissipation source term +! - Sbt(frequency,direction) : bottom source term +! - Sice(frequency,direction) : ice source term +! - Stot(frequency,direction) : total source term +! - dpt, wnd, wnddir, cur, curdir, ust : mean parameters +! +! +! * namelist must be terminated with / +! * definitions & defaults: +! SOURCE%OUTPUT = 4 ! 1: Print plots +! ! 2: Table of 1-D S(f) +! ! 3: Table of 1-D inverse time scales (1/T = S/F) +! ! 4: Transfer file +! SOURCE%SCALE_FAC = 0 ! Scale factor (-1=disabled) +! SOURCE%OUTPUT_FAC = 0 ! Output factor (0=normalized) +! SOURCE%TABLE_FAC = 0 ! Table factor +! 0 : Dimensional. +! 1 : Nondimensional in terms of U10 +! 2 : Nondimensional in terms of U* +! 3-5: like 0-2 with f normalized with fp. +! SOURCE%SPECTRUM = T ! [T|F] +! SOURCE%INPUT = T ! [T|F] +! SOURCE%INTERACTIONS = T ! [T|F] +! SOURCE%DISSIPATION = T ! [T|F] +! SOURCE%BOTTOM = T ! [T|F] +! SOURCE%ICE = T ! [T|F] +! SOURCE%TOTAL = T ! [T|F] +! -------------------------------------------------------------------- ! +&SOURCE_NML +/ + + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_tp2.19/input_Case1A/ww3_shel.inp b/regtests/ww3_tp2.19/input_Case1A/ww3_shel.inp new file mode 100644 index 000000000..6913cd556 --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1A/ww3_shel.inp @@ -0,0 +1,115 @@ +$ WAVEWATCH III shell input file +$ ------------------------------ + F F Water levels + F F Currents + F F Winds + F F Ice concentrations + F F Atmospheric momentum + F F Air density + F Assimilation data : Mean parameters + F Assimilation data : 1-D spectra + F Assimilation data : 2-D spectra. +$ + 20180701 000000 + 20180701 000130 +$ + 1 +$ + 20180701 000000 2 20180701 010000 +$ +N +WLV T02 DIR CUR HS T0M1 FP SXX SXY SYY DPT +$ + 20180701 000000 2 20180701 010000 +$ +$output points for Inlet +$ +$ +0 0.0 a01 +1 0.0 a02 +2 0.0 a03 +3 0.0 a04 +4 0.0 a05 +5 0.0 a06 +6 0.0 a07 +7 0.0 a08 +8 0.0 a09 +9 0.0 a10 +10 0.0 a11 +11 0.0 a12 +12 0.0 a13 +13 0.0 a14 +14 0.0 a15 +15 0.0 a16 +15.5 0.0 a17 +16 0.0 a18 +16.5 0.0 a19 +17 0.0 a20 +17.5 0.0 a21 +18 0.0 a22 +18.5 0.0 a23 +19 0.0 a24 +19.2 0.0 a25 +19.4 0.0 a26 +19.6 0.0 a27 +19.8 0.0 a28 +20 0.0 a29 +20.2 0.0 a30 +20.4 0.0 a31 +20.6 0.0 a32 +20.8 0.0 a33 +21 0.0 a34 +21.2 0.0 a35 +21.4 0.0 a36 +21.6 0.0 a37 +21.8 0.0 a38 +22 0.0 a39 +22.2 0.0 a40 +22.4 0.0 a41 +22.6 0.0 a42 +22.8 0.0 a43 +23 0.0 a44 +23.2 0.0 a45 +23.4 0.0 a46 +23.6 0.0 a47 +23.8 0.0 a48 +24 0.0 a49 +24.2 0.0 a50 +24.4 0.0 a51 +24.6 0.0 a52 +24.8 0.0 a53 +25 0.0 a54 +25.2 0.0 a55 +25.4 0.0 a56 +25.6 0.0 a57 +25.8 0.0 a58 +26 0.0 a59 +26.2 0.0 a60 +26.4 0.0 a61 +26.56 0.0 a62 +26.8 0.0 a63 +27 0.0 a64 +27.25 0.0 a65 +27.5 0.0 a66 +27.75 0.0 a67 +28 0.0 a68 +28.25 0.0 a69 +28.5 0.0 a70 +28.75 0.0 a71 +29.00 0.0 a72 +29.25 0.0 a73 +29.50 0.0 a74 +29.75 0.0 a75 +30.00 0.0 a76 +30.25 0.0 a77 +30.50 0.0 a78 +30.75 0.0 a79 +31.00 0.0 a80 +$ + 0.0 0.0 'STOPSTRING' +$ + 19680606 000000 0 19680608 000000 + 19680606 000000 0 19680608 000000 + 19680606 000000 0 19680608 000000 + 19680606 000000 0 19680608 000000 +$ diff --git a/regtests/ww3_tp2.19/input_Case1A/ww3_shel.nml b/regtests/ww3_tp2.19/input_Case1A/ww3_shel.nml new file mode 100644 index 000000000..030117c15 --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1A/ww3_shel.nml @@ -0,0 +1,337 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III ww3_shel.nml - single-grid model ! +! -------------------------------------------------------------------- ! + + +! -------------------------------------------------------------------- ! +! Define top-level model parameters via DOMAIN_NML namelist +! +! * IOSTYP defines the output server mode for parallel implementation. +! 0 : No data server processes, direct access output from +! each process (requires true parallel file system). +! 1 : No data server process. All output for each type +! performed by process that performs computations too. +! 2 : Last process is reserved for all output, and does no +! computing. +! 3 : Multiple dedicated output processes. +! +! * namelist must be terminated with / +! * definitions & defaults: +! DOMAIN%IOSTYP = 1 ! Output server type +! DOMAIN%START = '19680606 000000' ! Start date for the entire model +! DOMAIN%STOP = '19680607 000000' ! Stop date for the entire model +! -------------------------------------------------------------------- ! +&DOMAIN_NML + DOMAIN%IOSTYP = 1 + DOMAIN%START = '20180701 000000' + DOMAIN%STOP = '20180701 000130' +/ + +! -------------------------------------------------------------------- ! +! Define each forcing via the INPUT_NML namelist +! +! * The FORCING flag can be : 'F' for "no forcing" +! 'T' for "external forcing file" +! 'H' for "homogeneous forcing input" +! 'C' for "coupled forcing field" +! +! * homogeneous forcing is not available for ICE_CONC +! +! * The ASSIM flag can : 'F' for "no forcing" +! 'T' for "external forcing file" +! +! * namelist must be terminated with / +! * definitions & defaults: +! INPUT%FORCING%WATER_LEVELS = 'F' +! INPUT%FORCING%CURRENTS = 'F' +! INPUT%FORCING%WINDS = 'F' +! INPUT%FORCING%ICE_CONC = 'F' +! INPUT%FORCING%ICE_PARAM1 = 'F' +! INPUT%FORCING%ICE_PARAM2 = 'F' +! INPUT%FORCING%ICE_PARAM3 = 'F' +! INPUT%FORCING%ICE_PARAM4 = 'F' +! INPUT%FORCING%ICE_PARAM5 = 'F' +! INPUT%FORCING%MUD_DENSITY = 'F' +! INPUT%FORCING%MUD_THICKNESS = 'F' +! INPUT%FORCING%MUD_VISCOSITY = 'F' +! INPUT%ASSIM%MEAN = 'F' +! INPUT%ASSIM%SPEC1D = 'F' +! INPUT%ASSIM%SPEC2D = 'F' +! -------------------------------------------------------------------- ! +&INPUT_NML +INPUT%FORCING%WATER_LEVELS = 'F' +/ + +! -------------------------------------------------------------------- ! +! Define the output types point parameters via OUTPUT_TYPE_NML namelist +! +! * the point file is a space separated values per line : lon lat 'name' +! +! * the full list of field names is : +! All parameters listed below are available in output file of the types +! ASCII and NetCDF. If selected output file types are grads or grib, +! some parameters may not be available. The first two columns in the +! table below identify such cases by flags, cols 1 (GRB) and 2 (GXO) +! refer to grib (ww3_grib) and grads (gx_outf), respectively. +! +! Columns 3 and 4 provide group and parameter numbers per group. +! Columns 5, 6 and 7 provide: +! 5 - code name (internal) +! 6 - output tags (names used is ASCII file extensions, NetCDF +! variable names and namelist-based selection +! 7 - Long parameter name/definition +! +! G G +! R X Grp Param Code Output Parameter/Group +! B O Numb Numbr Name Tag Definition +! -------------------------------------------------- +! 1 Forcing Fields +! ------------------------------------------------- +! T T 1 1 DW DPT Water depth. +! T T 1 2 C[X,Y] CUR Current velocity. +! T T 1 3 UA WND Wind speed. +! T T 1 4 AS AST Air-sea temperature difference. +! T T 1 5 WLV WLV Water levels. +! T T 1 6 ICE ICE Ice concentration. +! T T 1 7 IBG IBG Iceberg-induced damping. +! T T 1 8 D50 D50 Median sediment grain size. +! T T 1 9 IC1 IC1 Ice thickness. +! T T 1 10 IC5 IC5 Ice flow diameter. +! ------------------------------------------------- +! 2 Standard mean wave Parameters +! ------------------------------------------------- +! T T 2 1 HS HS Wave height. +! T T 2 2 WLM LM Mean wave length. +! T T 2 3 T02 T02 Mean wave period (Tm0,2). +! T T 2 4 TM10 TM10 Mean wave period (Tm-1,0). +! T T 2 5 T01 T01 Mean wave period (Tm0,1). +! T T 2 6 FP0 FP Peak frequency. +! T T 2 7 THM DIR Mean wave direction. +! T T 2 8 THS SPR Mean directional spread. +! T T 2 9 THP0 DP Peak direction. +! T T 2 10 HIG HIG Infragravity height +! T T 2 11 STMAXE MXE Max surface elev (STE) +! T T 2 12 STMAXD MXES St Dev of max surface elev (STE) +! T T 2 13 HMAXE MXH Max wave height (STE) +! T T 2 14 HCMAXE MXHC Max wave height from crest (STE) +! T T 2 15 HMAXD SDMH St Dev of MXC (STE) +! T T 2 16 HCMAXD SDMHC St Dev of MXHC (STE) +! F T 2 17 WBT WBT Domiant wave breaking probability bT +! ------------------------------------------------- +! 3 Spectral Parameters (first 5) +! ------------------------------------------------- +! F F 3 1 EF EF Wave frequency spectrum +! F F 3 2 TH1M TH1M Mean wave direction from a1,b2 +! F F 3 3 STH1M STH1M Directional spreading from a1,b2 +! F F 3 4 TH2M TH2M Mean wave direction from a2,b2 +! F F 3 5 STH2M STH2M Directional spreading from a2,b2 +! F F 3 6 WN WN Wavenumber array +! ------------------------------------------------- +! 4 Spectral Partition Parameters +! ------------------------------------------------- +! T T 4 1 PHS PHS Partitioned wave heights. +! T T 4 2 PTP PTP Partitioned peak period. +! T T 4 3 PLP PLP Partitioned peak wave length. +! T T 4 4 PDIR PDIR Partitioned mean direction. +! T T 4 5 PSI PSPR Partitioned mean directional spread. +! T T 4 6 PWS PWS Partitioned wind sea fraction. +! T T 4 7 PTHP0 PDP Peak wave direction of partition. +! T T 4 8 PQP PQP Goda peakdedness parameter of partition. +! T T 4 9 PPE PPE JONSWAP peak enhancement factor of partition. +! T T 4 10 PGW PGW Gaussian frequency width of partition. +! T T 4 11 PSW PSW Spectral width of partition. +! T T 4 12 PTM1 PTM10 Mean wave period (Tm-1,0) of partition. +! T T 4 13 PT1 PT01 Mean wave period (Tm0,1) of partition. +! T T 4 14 PT2 PT02 Mean wave period (Tm0,2) of partition. +! T T 4 15 PEP PEP Peak spectral density of partition. +! T T 4 16 PWST TWS Total wind sea fraction. +! T T 4 17 PNR PNR Number of partitions. +! ------------------------------------------------- +! 5 Atmosphere-waves layer +! ------------------------------------------------- +! T T 5 1 UST UST Friction velocity. +! F T 5 2 CHARN CHA Charnock parameter +! F T 5 3 CGE CGE Energy flux +! F T 5 4 PHIAW FAW Air-sea energy flux +! F T 5 5 TAUWI[X,Y] TAW Net wave-supported stress +! F T 5 6 TAUWN[X,Y] TWA Negative part of the wave-supported stress +! F F 5 7 WHITECAP WCC Whitecap coverage +! F F 5 8 WHITECAP WCF Whitecap thickness +! F F 5 9 WHITECAP WCH Mean breaking height +! F F 5 10 WHITECAP WCM Whitecap moment +! F F 5 11 FWS FWS Wind sea mean period +! ------------------------------------------------- +! 6 Wave-ocean layer +! ------------------------------------------------- +! F F 6 1 S[XX,YY,XY] SXY Radiation stresses. +! F F 6 2 TAUO[X,Y] TWO Wave to ocean momentum flux +! F F 6 3 BHD BHD Bernoulli head (J term) +! F F 6 4 PHIOC FOC Wave to ocean energy flux +! F F 6 5 TUS[X,Y] TUS Stokes transport +! F F 6 6 USS[X,Y] USS Surface Stokes drift +! F F 6 7 [PR,TP]MS P2S Second-order sum pressure +! F F 6 8 US3D USF Spectrum of surface Stokes drift +! F F 6 9 P2SMS P2L Micro seism source term +! F F 6 10 TAUICE TWI Wave to sea ice stress +! F F 6 11 PHICE FIC Wave to sea ice energy flux +! ------------------------------------------------- +! 7 Wave-bottom layer +! ------------------------------------------------- +! F F 7 1 ABA ABR Near bottom rms amplitides. +! F F 7 2 UBA UBR Near bottom rms velocities. +! F F 7 3 BEDFORMS BED Bedforms +! F F 7 4 PHIBBL FBB Energy flux due to bottom friction +! F F 7 5 TAUBBL TBB Momentum flux due to bottom friction +! ------------------------------------------------- +! 8 Spectrum parameters +! ------------------------------------------------- +! F F 8 1 MSS[X,Y] MSS Mean square slopes +! F F 8 2 MSC[X,Y] MSC Spectral level at high frequency tail +! F F 8 3 WL02[X,Y] WL02 East/X North/Y mean wavelength compon +! F F 8 4 ALPXT AXT Correl sea surface gradients (x,t) +! F F 8 5 ALPYT AYT Correl sea surface gradients (y,t) +! F F 8 6 ALPXY AXY Correl sea surface gradients (x,y) +! ------------------------------------------------- +! 9 Numerical diagnostics +! ------------------------------------------------- +! T T 9 1 DTDYN DTD Average time step in integration. +! T T 9 2 FCUT FC Cut-off frequency. +! T T 9 3 CFLXYMAX CFX Max. CFL number for spatial advection. +! T T 9 4 CFLTHMAX CFD Max. CFL number for theta-advection. +! F F 9 5 CFLKMAX CFK Max. CFL number for k-advection. +! ------------------------------------------------- +! 10 User defined +! ------------------------------------------------- +! F F 10 1 U1 User defined #1. (requires coding ...) +! F F 10 2 U2 User defined #1. (requires coding ...) +! ------------------------------------------------- +! +! Section 4 consist of a set of fields, index 0 = wind sea, index +! 1:NOSWLL are first NOSWLL swell fields. +! +! +! * output track file formatted (T) or unformated (F) +! +! * coupling fields exchanged list is : +! - Sent fields by ww3: +! - Ocean model : T0M1 OCHA OHS DIR BHD TWO UBR FOC TAW TUS USS LM DRY +! - Atmospheric model : ACHA AHS TP (or FP) FWS +! - Ice model : IC5 TWI +! - Received fields by ww3: +! - Ocean model : SSH CUR +! - Atmospheric model : WND +! - Ice model : ICE IC1 IC5 +! +! * namelist must be terminated with / +! * definitions & defaults: +! TYPE%FIELD%LIST = 'unset' +! TYPE%POINT%FILE = 'points.list' +! TYPE%TRACK%FORMAT = T +! TYPE%PARTITION%X0 = 0 +! TYPE%PARTITION%XN = 0 +! TYPE%PARTITION%NX = 0 +! TYPE%PARTITION%Y0 = 0 +! TYPE%PARTITION%YN = 0 +! TYPE%PARTITION%NY = 0 +! TYPE%PARTITION%FORMAT = T +! TYPE%COUPLING%SENT = 'unset' +! TYPE%COUPLING%RECEIVED = 'unset' +! +! -------------------------------------------------------------------- ! +&OUTPUT_TYPE_NML + TYPE%FIELD%LIST = 'WLV T02 DIR CUR HS T0M1 FP SXX SXY SYY DPT' + TYPE%POINT%FILE = '../input/points.list' +/ + +! -------------------------------------------------------------------- ! +! Define output dates via OUTPUT_DATE_NML namelist +! +! * start and stop times are with format 'yyyymmdd hhmmss' +! * if time stride is equal '0', then output is disabled +! * time stride is given in seconds +! +! * namelist must be terminated with / +! * definitions & defaults: +! DATE%FIELD%START = '19680606 000000' +! DATE%FIELD%STRIDE = '0' +! DATE%FIELD%STOP = '19680607 000000' +! DATE%POINT%START = '19680606 000000' +! DATE%POINT%STRIDE = '0' +! DATE%POINT%STOP = '19680607 000000' +! DATE%TRACK%START = '19680606 000000' +! DATE%TRACK%STRIDE = '0' +! DATE%TRACK%STOP = '19680607 000000' +! DATE%RESTART%START = '19680606 000000' +! DATE%RESTART%STRIDE = '0' +! DATE%RESTART%STOP = '19680607 000000' +! DATE%BOUNDARY%START = '19680606 000000' +! DATE%BOUNDARY%STRIDE = '0' +! DATE%BOUNDARY%STOP = '19680607 000000' +! DATE%PARTITION%START = '19680606 000000' +! DATE%PARTITION%STRIDE = '0' +! DATE%PARTITION%STOP = '19680607 000000' +! DATE%COUPLING%START = '19680606 000000' +! DATE%COUPLING%STRIDE = '0' +! DATE%COUPLING%STOP = '19680607 000000' +! +! DATE%RESTART = '19680606 000000' '0' '19680607 000000' +! -------------------------------------------------------------------- ! +&OUTPUT_DATE_NML + DATE%FIELD = '20180701 000000' '2' '20180701 010000' + DATE%POINT = '20180701 000000' '2' '20180701 010000' +/ + +! -------------------------------------------------------------------- ! +! Define homogeneous input via HOMOG_COUNT_NML and HOMOG_INPUT_NML namelist +! +! * the number of each homogeneous input is defined by HOMOG_COUNT +! * the total number of homogeneous input is automatically calculated +! * the homogeneous input must start from index 1 to N +! * if VALUE1 is equal 0, then the homogeneous input is desactivated +! * NAME can be IC1, IC2, IC3, IC4, IC5, MDN, MTH, MVS, LEV, CUR, WND, ICE, MOV +! * each homogeneous input is defined over a maximum of 3 values detailled below : +! - IC1 is defined by thickness +! - IC2 is defined by viscosity +! - IC3 is defined by density +! - IC4 is defined by modulus +! - IC5 is defined by floe diameter +! - MDN is defined by density +! - MTH is defined by thickness +! - MVS is defined by viscosity +! - LEV is defined by height +! - CUR is defined by speed and direction +! - WND is defined by speed, direction and airseatemp +! - ICE is defined by concentration +! - MOV is defined by speed and direction +! +! * namelist must be terminated with / +! * definitions & defaults: +! HOMOG_COUNT%N_IC1 = 0 +! HOMOG_COUNT%N_IC2 = 0 +! HOMOG_COUNT%N_IC3 = 0 +! HOMOG_COUNT%N_IC4 = 0 +! HOMOG_COUNT%N_IC5 = 0 +! HOMOG_COUNT%N_MDN = 0 +! HOMOG_COUNT%N_MTH = 0 +! HOMOG_COUNT%N_MVS = 0 +! HOMOG_COUNT%N_LEV = 0 +! HOMOG_COUNT%N_CUR = 0 +! HOMOG_COUNT%N_WND = 0 +! HOMOG_COUNT%N_ICE = 0 +! HOMOG_COUNT%N_MOV = 0 +! +! HOMOG_INPUT(I)%NAME = 'unset' +! HOMOG_INPUT(I)%DATE = '19680606 000000' +! HOMOG_INPUT(I)%VALUE1 = 0 +! HOMOG_INPUT(I)%VALUE2 = 0 +! HOMOG_INPUT(I)%VALUE3 = 0 +! -------------------------------------------------------------------- ! +&HOMOG_COUNT_NML +/ + +&HOMOG_INPUT_NML +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_tp2.19/input_Case1B/namelists_a.nml b/regtests/ww3_tp2.19/input_Case1B/namelists_a.nml new file mode 100644 index 000000000..8d34000c3 --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1B/namelists_a.nml @@ -0,0 +1,34 @@ +$ BAJ (adjusted) +$ +&SDB1 BJGAM = 0.64, BJALFA = 0.8 / +$ +&UNST +UGOBCAUTO = F +UGOBCDEPTH= -10. +EXPFSN = F, +EXPFSPSI = F, +EXPFSFCT = F, +IMPFSN = F, +IMPTOTAL = T, +IMPREFRACTION = T, +IMPFREQSHIFT = T, +IMPSOURCE = T, +SETUP_APPLY_WLV = F +SOLVERTHR_SETUP=1E-14 +CRIT_DEP_SETUP=0.1 +JGS_USE_JACOBI = T, +JGS_NLEVEL = 0 +JGS_SOURCE_NONLINEAR = F +JGS_BLOCK_GAUSS_SEIDEL = T, +JGS_TERMINATE_MAXITER = T, +JGS_MAXITER = 100000, +JGS_TERMINATE_NORM = F, +JGS_TERMINATE_DIFFERENCE = T, +JGS_DIFF_THR = 1.E-6, +JGS_PMIN = 3.0 +JGS_LIMITER = F, +JGS_BLOCK_GAUSS_SEIDEL = T +JGS_NORM_THR = 1.E-6 +/ + +END OF NAMELISTS diff --git a/regtests/ww3_tp2.19/input_Case1B/namelists_b.nml b/regtests/ww3_tp2.19/input_Case1B/namelists_b.nml new file mode 100644 index 000000000..961a829de --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1B/namelists_b.nml @@ -0,0 +1,33 @@ +$ +&SDB1 BJGAM = 0.42, BJALFA = 1.0, DBFLAG=2 / +$ +&UNST +UGOBCAUTO = F +UGOBCDEPTH= -10. +EXPFSN = F, +EXPFSPSI = F, +EXPFSFCT = F, +IMPFSN = F, +IMPTOTAL = T, +IMPREFRACTION = T, +IMPFREQSHIFT = T, +IMPSOURCE = T, +SETUP_APPLY_WLV = F +SOLVERTHR_SETUP=1E-14 +CRIT_DEP_SETUP=0.1 +JGS_USE_JACOBI = T, +JGS_NLEVEL = 0 +JGS_SOURCE_NONLINEAR = F +JGS_BLOCK_GAUSS_SEIDEL = T, +JGS_TERMINATE_MAXITER = T, +JGS_MAXITER = 100000, +JGS_TERMINATE_NORM = F, +JGS_TERMINATE_DIFFERENCE = T, +JGS_DIFF_THR = 1.E-6, +JGS_PMIN = 3.0 +JGS_LIMITER = F, +JGS_BLOCK_GAUSS_SEIDEL = T +JGS_NORM_THR = 1.E-6 +/ + +END OF NAMELISTS diff --git a/regtests/ww3_tp2.19/input_Case1B/spec.list b/regtests/ww3_tp2.19/input_Case1B/spec.list new file mode 100644 index 000000000..07523d775 --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1B/spec.list @@ -0,0 +1 @@ +../input/boundary1B.nc diff --git a/regtests/ww3_tp2.19/input_Case1B/switch_PDLIB b/regtests/ww3_tp2.19/input_Case1B/switch_PDLIB new file mode 100644 index 000000000..173947fdd --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1B/switch_PDLIB @@ -0,0 +1 @@ +F90 PDLIB METIS NOGRB NC4 DIST MPI PR3 UQ FLX0 LN0 ST0 NL0 BT0 DB1 TR1 BS0 IC0 IS0 REF0 XX0 WNT1 WNX1 CRT1 CRX1 SEC1 O0 O1 O2 O3 O4 O5 O6 O7 diff --git a/regtests/ww3_tp2.19/input_Case1B/ww3_bounc.inp b/regtests/ww3_tp2.19/input_Case1B/ww3_bounc.inp new file mode 100644 index 000000000..a2a30dff1 --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1B/ww3_bounc.inp @@ -0,0 +1,25 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III NetCDF boundary input processing $ +$--------------------------------------------------------------------- $ +$ +$ Boundary option: READ or WRITE +$ + WRITE +$ +$ Interpolation method: 1: nearest +$ 2: linear interpolation + 2 +$ Verbose (0, 1, 2) +1 +$ +$ List of spectra files. These NetCDF files use the WAVEWATCH III +$ format as described in the ww3_ounp.inp file. The files are +$ defined relative to the directory in which the program is run. +$ +../input/boundary1B.nc +'STOPSTRING' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ + diff --git a/regtests/ww3_tp2.19/input_Case1B/ww3_bounc.nml b/regtests/ww3_tp2.19/input_Case1B/ww3_bounc.nml new file mode 100644 index 000000000..45546baf2 --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1B/ww3_bounc.nml @@ -0,0 +1,21 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III ww3_bounc.nml - Boundary input post-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the input boundaries to preprocess via BOUND_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! BOUND%MODE = 'WRITE' ! ['WRITE'|'READ'] +! BOUND%INTERP = 2 ! interpolation [1(nearest),2(linear)] +! BOUND%VERBOSE = 1 ! [0|1|2] +! BOUND%FILE = 'spec.list' ! input _spec.nc listing file +! -------------------------------------------------------------------- ! +&BOUND_NML + BOUND%FILE = '../input_Case1B/spec.list' +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_tp2.19/input_Case1B/ww3_grid.inp b/regtests/ww3_tp2.19/input_Case1B/ww3_grid.inp new file mode 100644 index 000000000..8c229430e --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1B/ww3_grid.inp @@ -0,0 +1,302 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Grid preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Grid name (C*30, in quotes) +$ + 'Flume ERDC' +$ +$ Frequency increment factor and first frequency (Hz) ---------------- $ +$ number of frequencies (wavenumbers) and directions, relative offset +$ of first direction in terms of the directional increment [-0.5,0.5]. +$ In versions 1.18 and 2.22 of the model this value was by definiton 0, +$ it is added to mitigate the GSE for a first order scheme. Note that +$ this factor is IGNORED in the print plots in ww3_outp. +$ +1.1 0.0398 46 360 0. +$ +$ Set model flags ---------------------------------------------------- $ +$ - FLDRY Dry run (input/output only, no calculation). +$ - FLCX, FLCY Activate X and Y component of propagation. +$ - FLCTH, FLCK Activate direction and wavenumber shifts. +$ - FLSOU Activate source terms. +$ + F T T F F T +$ +$ Set time steps ----------------------------------------------------- $ +$ - Time step information (this information is always read) +$ maximum global time step, maximum CFL time step for x-y and +$ k-theta, minimum source term time step (all in seconds). +$ +$ + 1 1 1 1 +$ +$ Start of namelist input section ------------------------------------ $ +$ Starting with WAVEWATCH III version 2.00, the tunable parameters +$ for source terms, propagation schemes, and numerics are read using +$ namelists. Any namelist found in the folowing sections up to the +$ end-of-section identifier string (see below) is temporarily written +$ to ww3_grid.scratch, and read from there if necessary. Namelists +$ not needed for the given switch settings will be skipped +$ automatically, and the order of the namelists is immaterial. +$ As an example, namelist input to change SWELLF and ZWND in the +$ Tolman and Chalikov input would be +$ +$ &SIN2 SWELLF = 0.1, ZWND = 15. / +$ +$ Define constants in source terms ----------------------------------- $ +$ +$ Input - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +$ WAM-3 : Namelist SIN1 +$ CINP : Proportionality constant. +$ &SIN1 CINP= 0.25 / +$ +$ Tolman and Chalikov : Namelist SIN2 +$ ZWND : Height of wind (m). +$ SWELLF : swell factor in (2.48). +$ STABSH, STABOF, CNEG, CPOS, FNEG : +$ c0, ST0, c1, c2 and f1 in . (2.63) +$ through (2.65) for definition of +$ effective wind speed (!/STAB2). +$ +$ Nonlinear interactions - - - - - - - - - - - - - - - - - - - - - - - +$ Discrete I.A. : Namelist SNL1 +$ LAMBDA : Lambda in source term. +$ NLPROP : C in sourc term. NOTE : default +$ value depends on other source +$ terms selected. +$ KDCONV : Factor before kd in Eq. (2.24). +$ KDMIN, SNLCS1, SNLCS2, SNLCS3 : +$ Minimum kd, and constants c1-3 +$ in depth scaling function. +$ Exact interactions : Namelist SNL2 +$ IQTYPE : Type of depth treatment +$ 1 : Deep water +$ 2 : Deep water / WAM scaling +$ 3 : Shallow water +$ TAILNL : Parametric tail power. +$ NDEPTH : Number of depths in for which +$ integration space is established. +$ Used for IQTYPE = 3 only +$ Namelist ANL2 +$ DEPTHS : Array with depths for NDEPTH = 3 +$ +$ Dissipation - - - - - - - - - - - - - - - - - - - - - - - - - - - - +$ WAM-3 : Namelist SDS1 +$ CDIS, APM : As in source term. +$ +$ Tolman and Chalikov : Namelist SDS2 +$ SDSA0, SDSA1, SDSA2, SDSB0, SDSB1, PHIMIN : +$ Constants a0, a1, a2, b0, b1 and +$ PHImin. +$ +$ BAJ (adjusted) +$ +&SDB1 BJGAM = 0.64, BJALFA = 0.8, DBFLAG = 1.0 / +$ +$ +&UNST +UGOBCAUTO = F +UGOBCDEPTH= -10. +EXPFSN = F, +EXPFSPSI = F, +EXPFSFCT = F, +IMPFSN = F, +IMPTOTAL = T, +IMPREFRACTION = T, +IMPFREQSHIFT = T, +IMPSOURCE = T, +SETUP_APPLY_WLV = F +SOLVERTHR_SETUP=1E-14 +CRIT_DEP_SETUP=0.1 +JGS_USE_JACOBI = T, +JGS_NLEVEL = 0 +JGS_SOURCE_NONLINEAR = F +JGS_BLOCK_GAUSS_SEIDEL = T, +JGS_TERMINATE_MAXITER = T, +JGS_MAXITER = 100000, +JGS_TERMINATE_NORM = F, +JGS_TERMINATE_DIFFERENCE = T, +JGS_DIFF_THR = 1.E-6, +JGS_PMIN = 3.0 +JGS_LIMITER = F, +JGS_BLOCK_GAUSS_SEIDEL = T +JGS_NORM_THR = 1.E-6 +/ +$ +$ +$ Bottom friction - - - - - - - - - - - - - - - - - - - - - - - - - - +$ JONSWAP : Namelist SBT1 +$ GAMMA : As it says. +$ &SBT1 GAMMA = 0.15 / +$ +$ Propagation schemes ------------------------------------------------ $ +$ First order : Namelist PRO1 +$ CFLTM : Maximum CFL number for refraction. +$ +$ UQ with diffusion : Namelist PRO2 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ DTIME : Swell age (s) in garden sprinkler +$ correction. If 0., all diffusion +$ switched off. If small non-zero +$ (DEFAULT !!!) only wave growth +$ diffusion. +$ LATMIN : Maximum latitude used in calc. of +$ strength of diffusion for prop. +$ +$ UQ with averaging : Namelist PRO3 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ WDTHCG : Tuning factor propag. direction. +$ WDTHTH : Tuning factor normal direction. +$ +$ UQ with divergence : Namelist PRO4 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ QTFAC : Tuning factor Eq. (3.41). +$ RSFAC : Tuning factor Eq. (3.42). +$ RNFAC : Tuning factor Eq. (3.43). +$ +$ Miscellaneous ------------------------------------------------------ $ +$ Misc. parameters : Namelist MISC +$ CICE0 : Ice concentration cut-off. +$ CICEN : Ice concentration cut-off. +$ XSEED : Xseed in seeding alg. (!/SEED). +$ FLAGTR : Indicating presence and type of +$ subgrid information : +$ 0 : No subgrid information. +$ 1 : Transparancies at cell boun- +$ daries between grid points. +$ 2 : Transp. at cell centers. +$ 3 : Like 1 with cont. ice. +$ 4 : Like 2 with cont. ice. +$ XP, XR, XFILT +$ Xp, Xr and Xf for the dynamic +$ integration scheme. +$ +$ In the 'Out of the box' test setup we run with sub-grid obstacles +$ and with continuous ice treatment. +$ +$ &MISC CICE0 = 0.25, CICEN = 0.75, FLAGTR = 4 / +$ +$ Mandatory string to identify end of namelist input section. +$ +END OF NAMELISTS +$ +$ Define grid -------------------------------------------------------- $ +$ + 'UNST' F 'NONE' +$ + 4.0 0.03 20 -1. 4 1 '(20f10.2)' 'NAME' '../input/Boers.msh' +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed). +$ +$ 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +$ +$ If sub-grid information is avalaible as indicated by FLAGTR above, +$ additional input to define this is needed below. In such cases a +$ field of fractional obstructions at or between grid points needs to +$ be supplied. First the location and format of the data is defined +$ by (as above) : +$ - Unit number of file (can be 10, and/or identical to bottem depth +$ unit), scale factor for fractional obstruction, IDLA, IDFM, +$ format for formatted read, FROM and filename +$ +$ 10 0.2 3 1 '(....)' 'NAME' 'obstr.inp' +$ +$ *** NOTE if this unit number is the same as the previous bottom +$ depth unit number, it is assumed that this is the same file +$ without further checks. *** +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed, +$ except between the two fields). +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 5 5 5 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ *** NOTE size of fields is always NX * NY *** +$ + 85 3 1 '(....)' 'PART' 'mapsta.inp' +$ Input boundary points ---------------------------------------------- $ +$ An unlimited number of lines identifying points at which input +$ boundary conditions are to be defined. If the actual input data is +$ not defined in the actual wave model run, the initial conditions +$ will be applied as constant boundary conditions. Each line contains: +$ Discrete grid counters (IX,IY) of the active point and a +$ connect flag. If this flag is true, and the present and previous +$ point are on a grid line or diagonal, all intermediate points +$ are also defined as boundary points. +$ +1 1 F +2 1 F +9 1 F +17 1 F +25 1 F +33 1 F +41 1 F +45 1 F +37 1 F +29 1 F +21 1 F +13 1 F +5 1 F +$ +$ Close list by defining point (0,0) (mandatory) +$ + 0 0 F +$ +$ +$ +$ Excluded grid points from segment data ( FROM != PART ) +$ First defined as lines, identical to the definition of the input +$ boundary points, and closed the same way. +$ + 0 0 F +$ +$ Second, define a point in a closed body of sea points to remove +$ the entire body os sea points. Also close by point (0,0) +$ + 0 0 +$ +$ Output boundary points --------------------------------------------- $ +$ Output boundary points are defined as a number of straight lines, +$ defined by its starting point (X0,Y0), increments (DX,DY) and number +$ of points. A negative number of points starts a new output file. +$ Note that this data is only generated if requested by the actual +$ program. Example again for spherical grid in degrees. +$ +$ -2.5312 48.5 0.00 0.008738 102 +$ -2.5312 49.3850 0.013554 0.00 51 +$ +$ Close list by defining line with 0 points (mandatory) +$ + 0. 0. 0. 0. 0 +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.19/input_Case1B/ww3_grid_a.inp b/regtests/ww3_tp2.19/input_Case1B/ww3_grid_a.inp new file mode 100644 index 000000000..9d5a96c6f --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1B/ww3_grid_a.inp @@ -0,0 +1,302 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Grid preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Grid name (C*30, in quotes) +$ + 'Boers' +$ +$ Frequency increment factor and first frequency (Hz) ---------------- $ +$ number of frequencies (wavenumbers) and directions, relative offset +$ of first direction in terms of the directional increment [-0.5,0.5]. +$ In versions 1.18 and 2.22 of the model this value was by definiton 0, +$ it is added to mitigate the GSE for a first order scheme. Note that +$ this factor is IGNORED in the print plots in ww3_outp. +$ +1.1 0.0398 46 360 0. +$ +$ Set model flags ---------------------------------------------------- $ +$ - FLDRY Dry run (input/output only, no calculation). +$ - FLCX, FLCY Activate X and Y component of propagation. +$ - FLCTH, FLCK Activate direction and wavenumber shifts. +$ - FLSOU Activate source terms. +$ + F T T F F T +$ +$ Set time steps ----------------------------------------------------- $ +$ - Time step information (this information is always read) +$ maximum global time step, maximum CFL time step for x-y and +$ k-theta, minimum source term time step (all in seconds). +$ +$ + 2 2 2 2 +$ +$ Start of namelist input section ------------------------------------ $ +$ Starting with WAVEWATCH III version 2.00, the tunable parameters +$ for source terms, propagation schemes, and numerics are read using +$ namelists. Any namelist found in the folowing sections up to the +$ end-of-section identifier string (see below) is temporarily written +$ to ww3_grid.scratch, and read from there if necessary. Namelists +$ not needed for the given switch settings will be skipped +$ automatically, and the order of the namelists is immaterial. +$ As an example, namelist input to change SWELLF and ZWND in the +$ Tolman and Chalikov input would be +$ +$ &SIN2 SWELLF = 0.1, ZWND = 15. / +$ +$ Define constants in source terms ----------------------------------- $ +$ +$ Input - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +$ WAM-3 : Namelist SIN1 +$ CINP : Proportionality constant. +$ &SIN1 CINP= 0.25 / +$ +$ Tolman and Chalikov : Namelist SIN2 +$ ZWND : Height of wind (m). +$ SWELLF : swell factor in (2.48). +$ STABSH, STABOF, CNEG, CPOS, FNEG : +$ c0, ST0, c1, c2 and f1 in . (2.63) +$ through (2.65) for definition of +$ effective wind speed (!/STAB2). +$ +$ Nonlinear interactions - - - - - - - - - - - - - - - - - - - - - - - +$ Discrete I.A. : Namelist SNL1 +$ LAMBDA : Lambda in source term. +$ NLPROP : C in sourc term. NOTE : default +$ value depends on other source +$ terms selected. +$ KDCONV : Factor before kd in Eq. (2.24). +$ KDMIN, SNLCS1, SNLCS2, SNLCS3 : +$ Minimum kd, and constants c1-3 +$ in depth scaling function. +$ Exact interactions : Namelist SNL2 +$ IQTYPE : Type of depth treatment +$ 1 : Deep water +$ 2 : Deep water / WAM scaling +$ 3 : Shallow water +$ TAILNL : Parametric tail power. +$ NDEPTH : Number of depths in for which +$ integration space is established. +$ Used for IQTYPE = 3 only +$ Namelist ANL2 +$ DEPTHS : Array with depths for NDEPTH = 3 +$ +$ Dissipation - - - - - - - - - - - - - - - - - - - - - - - - - - - - +$ WAM-3 : Namelist SDS1 +$ CDIS, APM : As in source term. +$ +$ Tolman and Chalikov : Namelist SDS2 +$ SDSA0, SDSA1, SDSA2, SDSB0, SDSB1, PHIMIN : +$ Constants a0, a1, a2, b0, b1 and +$ PHImin. +$ +$ BAJ (adjusted) +$ +&SDB1 BJGAM = 0.64, BJALFA = 0.8 / +$ +$ +&UNST +UGOBCAUTO = F +UGOBCDEPTH= -10. +EXPFSN = F, +EXPFSPSI = F, +EXPFSFCT = F, +IMPFSN = F, +IMPTOTAL = T, +IMPREFRACTION = T, +IMPFREQSHIFT = T, +IMPSOURCE = T, +SETUP_APPLY_WLV = F +SOLVERTHR_SETUP=1E-14 +CRIT_DEP_SETUP=0.1 +JGS_USE_JACOBI = T, +JGS_NLEVEL = 0 +JGS_SOURCE_NONLINEAR = F +JGS_BLOCK_GAUSS_SEIDEL = T, +JGS_TERMINATE_MAXITER = T, +JGS_MAXITER = 100000, +JGS_TERMINATE_NORM = F, +JGS_TERMINATE_DIFFERENCE = T, +JGS_DIFF_THR = 1.E-6, +JGS_PMIN = 3.0 +JGS_LIMITER = F, +JGS_BLOCK_GAUSS_SEIDEL = T +JGS_NORM_THR = 1.E-6 +/ +$ +$ +$ Bottom friction - - - - - - - - - - - - - - - - - - - - - - - - - - +$ JONSWAP : Namelist SBT1 +$ GAMMA : As it says. +$ &SBT1 GAMMA = 0.15 / +$ +$ Propagation schemes ------------------------------------------------ $ +$ First order : Namelist PRO1 +$ CFLTM : Maximum CFL number for refraction. +$ +$ UQ with diffusion : Namelist PRO2 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ DTIME : Swell age (s) in garden sprinkler +$ correction. If 0., all diffusion +$ switched off. If small non-zero +$ (DEFAULT !!!) only wave growth +$ diffusion. +$ LATMIN : Maximum latitude used in calc. of +$ strength of diffusion for prop. +$ +$ UQ with averaging : Namelist PRO3 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ WDTHCG : Tuning factor propag. direction. +$ WDTHTH : Tuning factor normal direction. +$ +$ UQ with divergence : Namelist PRO4 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ QTFAC : Tuning factor Eq. (3.41). +$ RSFAC : Tuning factor Eq. (3.42). +$ RNFAC : Tuning factor Eq. (3.43). +$ +$ Miscellaneous ------------------------------------------------------ $ +$ Misc. parameters : Namelist MISC +$ CICE0 : Ice concentration cut-off. +$ CICEN : Ice concentration cut-off. +$ XSEED : Xseed in seeding alg. (!/SEED). +$ FLAGTR : Indicating presence and type of +$ subgrid information : +$ 0 : No subgrid information. +$ 1 : Transparancies at cell boun- +$ daries between grid points. +$ 2 : Transp. at cell centers. +$ 3 : Like 1 with cont. ice. +$ 4 : Like 2 with cont. ice. +$ XP, XR, XFILT +$ Xp, Xr and Xf for the dynamic +$ integration scheme. +$ +$ In the 'Out of the box' test setup we run with sub-grid obstacles +$ and with continuous ice treatment. +$ +$ &MISC CICE0 = 0.25, CICEN = 0.75, FLAGTR = 4 / +$ +$ Mandatory string to identify end of namelist input section. +$ +END OF NAMELISTS +$ +$ Define grid -------------------------------------------------------- $ +$ + 'UNST' F 'NONE' +$ + 4.0 0.03 20 -1. 4 1 '(20f10.2)' 'NAME' '../input/Boers.msh' +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed). +$ +$ 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +$ +$ If sub-grid information is avalaible as indicated by FLAGTR above, +$ additional input to define this is needed below. In such cases a +$ field of fractional obstructions at or between grid points needs to +$ be supplied. First the location and format of the data is defined +$ by (as above) : +$ - Unit number of file (can be 10, and/or identical to bottem depth +$ unit), scale factor for fractional obstruction, IDLA, IDFM, +$ format for formatted read, FROM and filename +$ +$ 10 0.2 3 1 '(....)' 'NAME' 'obstr.inp' +$ +$ *** NOTE if this unit number is the same as the previous bottom +$ depth unit number, it is assumed that this is the same file +$ without further checks. *** +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed, +$ except between the two fields). +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 5 5 5 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ *** NOTE size of fields is always NX * NY *** +$ + 85 3 1 '(....)' 'PART' 'mapsta.inp' +$ Input boundary points ---------------------------------------------- $ +$ An unlimited number of lines identifying points at which input +$ boundary conditions are to be defined. If the actual input data is +$ not defined in the actual wave model run, the initial conditions +$ will be applied as constant boundary conditions. Each line contains: +$ Discrete grid counters (IX,IY) of the active point and a +$ connect flag. If this flag is true, and the present and previous +$ point are on a grid line or diagonal, all intermediate points +$ are also defined as boundary points. +$ +1 1 F +2 1 F +9 1 F +17 1 F +25 1 F +33 1 F +41 1 F +45 1 F +37 1 F +29 1 F +21 1 F +13 1 F +5 1 F +$ +$ Close list by defining point (0,0) (mandatory) +$ + 0 0 F +$ +$ +$ +$ Excluded grid points from segment data ( FROM != PART ) +$ First defined as lines, identical to the definition of the input +$ boundary points, and closed the same way. +$ + 0 0 F +$ +$ Second, define a point in a closed body of sea points to remove +$ the entire body os sea points. Also close by point (0,0) +$ + 0 0 +$ +$ Output boundary points --------------------------------------------- $ +$ Output boundary points are defined as a number of straight lines, +$ defined by its starting point (X0,Y0), increments (DX,DY) and number +$ of points. A negative number of points starts a new output file. +$ Note that this data is only generated if requested by the actual +$ program. Example again for spherical grid in degrees. +$ +$ -2.5312 48.5 0.00 0.008738 102 +$ -2.5312 49.3850 0.013554 0.00 51 +$ +$ Close list by defining line with 0 points (mandatory) +$ + 0. 0. 0. 0. 0 +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.19/input_Case1B/ww3_grid_a.nml b/regtests/ww3_tp2.19/input_Case1B/ww3_grid_a.nml new file mode 100644 index 000000000..b184292b5 --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1B/ww3_grid_a.nml @@ -0,0 +1,265 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_grid.nml - Grid pre-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the spectrum parameterization via SPECTRUM_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! SPECTRUM%XFR = 0. ! frequency increment +! SPECTRUM%FREQ1 = 0. ! first frequency (Hz) +! SPECTRUM%NK = 0 ! number of frequencies (wavenumbers) +! SPECTRUM%NTH = 0 ! number of direction bins +! SPECTRUM%THOFF = 0. ! relative offset of first direction [-0.5,0.5] +! -------------------------------------------------------------------- ! +&SPECTRUM_NML + SPECTRUM%XFR = 1.10 + SPECTRUM%FREQ1 = 0.0398 + SPECTRUM%NK = 46 + SPECTRUM%NTH = 360 +/ + +! -------------------------------------------------------------------- ! +! Define the run parameterization via RUN_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! RUN%FLDRY = F ! dry run (I/O only, no calculation) +! RUN%FLCX = F ! x-component of propagation +! RUN%FLCY = F ! y-component of propagation +! RUN%FLCTH = F ! direction shift +! RUN%FLCK = F ! wavenumber shift +! RUN%FLSOU = F ! source terms +! -------------------------------------------------------------------- ! +&RUN_NML + RUN%FLCX = T + RUN%FLCY = T + RUN%FLSOU = T +/ + +! -------------------------------------------------------------------- ! +! Define the timesteps parameterization via TIMESTEPS_NML namelist +! +! * It is highly recommended to set up time steps which are multiple +! between them. +! +! * The first time step to calculate is the maximum CFL time step +! which depend on the lowest frequency FREQ1 previously set up and the +! lowest spatial grid resolution in meters DXY. +! reminder : 1 degree=60minutes // 1minute=1mile // 1mile=1.852km +! The formula for the CFL time is : +! Tcfl = DXY / (G / (FREQ1*4*Pi) ) with the constants Pi=3,14 and G=9.8m/s²; +! DTXY ~= 90% Tcfl +! DTMAX ~= 3 * DTXY (maximum global time step limit) +! +! * The refraction time step depends on how strong can be the current velocities +! on your grid : +! DTKTH ~= DTMAX / 2 ! in case of no or light current velocities +! DTKTH ~= DTMAX / 10 ! in case of strong current velocities +! +! * The source terms time step is usually defined between 5s and 60s. +! A common value is 10s. +! DTMIN ~= 10 +! +! * namelist must be terminated with / +! * definitions & defaults: +! TIMESTEPS%DTMAX = 0. ! maximum global time step (s) +! TIMESTEPS%DTXY = 0. ! maximum CFL time step for x-y (s) +! TIMESTEPS%DTKTH = 0. ! maximum CFL time step for k-th (s) +! TIMESTEPS%DTMIN = 0. ! minimum source term time step (s) +! -------------------------------------------------------------------- ! +&TIMESTEPS_NML + TIMESTEPS%DTMAX = 2. + TIMESTEPS%DTXY = 2. + TIMESTEPS%DTKTH = 2. + TIMESTEPS%DTMIN = 2. +/ + +! -------------------------------------------------------------------- ! +! Define the grid to preprocess via GRID_NML namelist +! +! * the tunable parameters for source terms, propagation schemes, and +! numerics are read using namelists. +! * Any namelist found in the folowing sections is temporarily written +! to param.scratch, and read from there if necessary. +! * The order of the namelists is immaterial. +! * Namelists not needed for the given switch settings will be skipped +! automatically +! +! * grid type can be : +! 'RECT' : rectilinear +! 'CURV' : curvilinear +! 'UNST' : unstructured (triangle-based) +! +! * coordinate system can be : +! 'SPHE' : Spherical (degrees) +! 'CART' : Cartesian (meters) +! +! * grid closure can only be applied in spherical coordinates +! +! * grid closure can be : +! 'NONE' : No closure is applied +! 'SMPL' : Simple grid closure. Grid is periodic in the +! : i-index and wraps at i=NX+1. In other words, +! : (NX+1,J) => (1,J). A grid with simple closure +! : may be rectilinear or curvilinear. +! 'TRPL' : Tripole grid closure : Grid is periodic in the +! : i-index and wraps at i=NX+1 and has closure at +! : j=NY+1. In other words, (NX+1,J<=NY) => (1,J) +! : and (I,NY+1) => (NX-I+1,NY). Tripole +! : grid closure requires that NX be even. A grid +! : with tripole closure must be curvilinear. +! +! * The coastline limit depth is the value which distinguish the sea +! points to the land points. All the points with depth values (ZBIN) +! greater than this limit (ZLIM) will be considered as excluded points +! and will never be wet points, even if the water level grows over. +! It can only overwrite the status of a sea point to a land point. +! The value must have a negative value under the mean sea level +! +! * The minimum water depth allowed to compute the model is the absolute +! depth value (DMIN) used in the model if the input depth is lower to +! avoid the model to blow up. +! +! * namelist must be terminated with / +! * definitions & defaults: +! GRID%NAME = 'unset' ! grid name (30 char) +! GRID%NML = 'namelists.nml' ! namelists filename +! GRID%TYPE = 'unset' ! grid type +! GRID%COORD = 'unset' ! coordinate system +! GRID%CLOS = 'unset' ! grid closure +! +! GRID%ZLIM = 0. ! coastline limit depth (m) +! GRID%DMIN = 0. ! abs. minimum water depth (m) +! -------------------------------------------------------------------- ! +&GRID_NML + GRID%NAME = 'Boers' + GRID%NML = '../input_Case1A/namelists_a.nml' + GRID%TYPE = 'UNST' + GRID%COORD = 'CART' + GRID%CLOS = 'F' + GRID%ZLIM = 4.0 + GRID%DMIN = 0.03 +/ + +! -------------------------------------------------------------------- ! +! Define the unstructured grid type via UNST_NML namelist +! - only for UNST grids - +! +! * The minimum grid size is 3x3. +! +! * &MISC namelist must be removed +! +! * The depth value must have negative values under the mean sea level +! +! * The map value must be set as : +! -2 : Excluded boundary point (covered by ice) +! -1 : Excluded sea point (covered by ice) +! 0 : Excluded land point +! 1 : Sea point +! 2 : Active boundary point +! 3 : Excluded grid point +! 7 : Ice point +! +! * the file must be a GMESH grid file containing node and element lists. +! +! * Extra open boundary list file with UGOBCFILE in namelist &UNST +! An example is given in regtest ww3_tp2.7 +! +! * value <= scale_fac * value_read +! +! * IDLA : Layout indicator : +! 1 : Read line-by-line bottom to top. (default) +! 2 : Like 1, single read statement. +! 3 : Read line-by-line top to bottom. +! 4 : Like 3, single read statement. +! * IDFM : format indicator : +! 1 : Free format. (default) +! 2 : Fixed format. +! 3 : Unformatted. +! * FORMAT : element format to read : +! '(....)' : auto detected (default) +! '(f10.6)' : float type +! +! * Example : +! IDF SF IDLA IDFM FORMAT FILENAME +! 20 -1. 4 2 '(20f10.2)' 'ngug.msh' +! +! * namelist must be terminated with / +! * definitions & defaults: +! UNST%SF = 1. ! unst scale factor +! UNST%FILENAME = 'unset' ! unst filename +! UNST%IDF = 20 ! unst file unit number +! UNST%IDLA = 1 ! unst layout indicator +! UNST%IDFM = 1 ! unst format indicator +! UNST%FORMAT = '(....)' ! unst formatted read format +! +! UNST%UGOBCFILE = 'unset' ! additional boundary list file +! -------------------------------------------------------------------- ! +&UNST_NML + UNST%SF = -1. + UNST%FILENAME = '../input/Boers.msh' + UNST%IDLA = 4 + UNST%FORMAT = '(20f10.2)' +/ + +! -------------------------------------------------------------------- ! +! Define the input boundary points via INBND_COUNT_NML and +! INBND_POINT_NML namelist +! - for RECT, CURV and UNST grids - +! +! * If no mask defined, INBOUND can be used +! +! * If the actual input data is not defined in the actual wave model run +! the initial conditions will be applied as constant boundary conditions. +! +! * The number of points is defined by INBND_COUNT +! +! * The points must start from index 1 to N +! +! * Each line contains: +! Discrete grid counters (IX,IY) of the active point and a +! connect flag. If this flag is true, and the present and previous +! point are on a grid line or diagonal, all intermediate points +! are also defined as boundary points. +! +! * Included point : +! grid points from segment data +! Defines as lines identifying points at which +! input boundary conditions are to be defined. +! +! * namelist must be terminated with / +! * definitions & defaults: +! INBND_COUNT%N_POINT = 0 ! number of segments +! +! INBND_POINT(I)%X_INDEX = 0 ! x index included point +! INBND_POINT(I)%Y_INDEX = 0 ! y index included point +! INBND_POINT(I)%CONNECT = F ! connect flag +! +! OR +! INBND_POINT(I) = 0 0 F ! included point +! -------------------------------------------------------------------- ! +&INBND_COUNT_NML + INBND_COUNT%N_POINT = 13 +/ + +&INBND_POINT_NML + INBND_POINT(1) = 1 1 F + INBND_POINT(2) = 2 1 F + INBND_POINT(3) = 9 1 F + INBND_POINT(4) = 17 1 F + INBND_POINT(5) = 25 1 F + INBND_POINT(6) = 33 1 F + INBND_POINT(7) = 41 1 F + INBND_POINT(8) = 45 1 F + INBND_POINT(9) = 37 1 F + INBND_POINT(10) = 29 1 F + INBND_POINT(11) = 21 1 F + INBND_POINT(12) = 13 1 F + INBND_POINT(13) = 5 1 F +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_tp2.19/input_Case1B/ww3_grid_b.inp b/regtests/ww3_tp2.19/input_Case1B/ww3_grid_b.inp new file mode 100644 index 000000000..245b7d56f --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1B/ww3_grid_b.inp @@ -0,0 +1,302 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Grid preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Grid name (C*30, in quotes) +$ + 'Flume ERDC' +$ +$ Frequency increment factor and first frequency (Hz) ---------------- $ +$ number of frequencies (wavenumbers) and directions, relative offset +$ of first direction in terms of the directional increment [-0.5,0.5]. +$ In versions 1.18 and 2.22 of the model this value was by definiton 0, +$ it is added to mitigate the GSE for a first order scheme. Note that +$ this factor is IGNORED in the print plots in ww3_outp. +$ +1.1 0.0398 46 360 0. +$ +$ Set model flags ---------------------------------------------------- $ +$ - FLDRY Dry run (input/output only, no calculation). +$ - FLCX, FLCY Activate X and Y component of propagation. +$ - FLCTH, FLCK Activate direction and wavenumber shifts. +$ - FLSOU Activate source terms. +$ + F T T F F T +$ +$ Set time steps ----------------------------------------------------- $ +$ - Time step information (this information is always read) +$ maximum global time step, maximum CFL time step for x-y and +$ k-theta, minimum source term time step (all in seconds). +$ +$ + 1 1 1 1 +$ +$ Start of namelist input section ------------------------------------ $ +$ Starting with WAVEWATCH III version 2.00, the tunable parameters +$ for source terms, propagation schemes, and numerics are read using +$ namelists. Any namelist found in the folowing sections up to the +$ end-of-section identifier string (see below) is temporarily written +$ to ww3_grid.scratch, and read from there if necessary. Namelists +$ not needed for the given switch settings will be skipped +$ automatically, and the order of the namelists is immaterial. +$ As an example, namelist input to change SWELLF and ZWND in the +$ Tolman and Chalikov input would be +$ +$ &SIN2 SWELLF = 0.1, ZWND = 15. / +$ +$ Define constants in source terms ----------------------------------- $ +$ +$ Input - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +$ WAM-3 : Namelist SIN1 +$ CINP : Proportionality constant. +$ &SIN1 CINP= 0.25 / +$ +$ Tolman and Chalikov : Namelist SIN2 +$ ZWND : Height of wind (m). +$ SWELLF : swell factor in (2.48). +$ STABSH, STABOF, CNEG, CPOS, FNEG : +$ c0, ST0, c1, c2 and f1 in . (2.63) +$ through (2.65) for definition of +$ effective wind speed (!/STAB2). +$ +$ Nonlinear interactions - - - - - - - - - - - - - - - - - - - - - - - +$ Discrete I.A. : Namelist SNL1 +$ LAMBDA : Lambda in source term. +$ NLPROP : C in sourc term. NOTE : default +$ value depends on other source +$ terms selected. +$ KDCONV : Factor before kd in Eq. (2.24). +$ KDMIN, SNLCS1, SNLCS2, SNLCS3 : +$ Minimum kd, and constants c1-3 +$ in depth scaling function. +$ Exact interactions : Namelist SNL2 +$ IQTYPE : Type of depth treatment +$ 1 : Deep water +$ 2 : Deep water / WAM scaling +$ 3 : Shallow water +$ TAILNL : Parametric tail power. +$ NDEPTH : Number of depths in for which +$ integration space is established. +$ Used for IQTYPE = 3 only +$ Namelist ANL2 +$ DEPTHS : Array with depths for NDEPTH = 3 +$ +$ Dissipation - - - - - - - - - - - - - - - - - - - - - - - - - - - - +$ WAM-3 : Namelist SDS1 +$ CDIS, APM : As in source term. +$ +$ Tolman and Chalikov : Namelist SDS2 +$ SDSA0, SDSA1, SDSA2, SDSB0, SDSB1, PHIMIN : +$ Constants a0, a1, a2, b0, b1 and +$ PHImin. +$ +$ BAJ (adjusted) +$ +&SDB1 BJGAM = 0.43, BJALFA = 1.0, DBFLAG = 2.0 / +$ +$ +&UNST +UGOBCAUTO = F +UGOBCDEPTH= -10. +EXPFSN = F, +EXPFSPSI = F, +EXPFSFCT = F, +IMPFSN = F, +IMPTOTAL = T, +IMPREFRACTION = T, +IMPFREQSHIFT = T, +IMPSOURCE = T, +SETUP_APPLY_WLV = F +SOLVERTHR_SETUP=1E-14 +CRIT_DEP_SETUP=0.1 +JGS_USE_JACOBI = T, +JGS_NLEVEL = 0 +JGS_SOURCE_NONLINEAR = F +JGS_BLOCK_GAUSS_SEIDEL = T, +JGS_TERMINATE_MAXITER = T, +JGS_MAXITER = 100000, +JGS_TERMINATE_NORM = F, +JGS_TERMINATE_DIFFERENCE = T, +JGS_DIFF_THR = 1.E-6, +JGS_PMIN = 3.0 +JGS_LIMITER = F, +JGS_BLOCK_GAUSS_SEIDEL = T +JGS_NORM_THR = 1.E-6 +/ +$ +$ +$ Bottom friction - - - - - - - - - - - - - - - - - - - - - - - - - - +$ JONSWAP : Namelist SBT1 +$ GAMMA : As it says. +$ &SBT1 GAMMA = 0.15 / +$ +$ Propagation schemes ------------------------------------------------ $ +$ First order : Namelist PRO1 +$ CFLTM : Maximum CFL number for refraction. +$ +$ UQ with diffusion : Namelist PRO2 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ DTIME : Swell age (s) in garden sprinkler +$ correction. If 0., all diffusion +$ switched off. If small non-zero +$ (DEFAULT !!!) only wave growth +$ diffusion. +$ LATMIN : Maximum latitude used in calc. of +$ strength of diffusion for prop. +$ +$ UQ with averaging : Namelist PRO3 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ WDTHCG : Tuning factor propag. direction. +$ WDTHTH : Tuning factor normal direction. +$ +$ UQ with divergence : Namelist PRO4 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ QTFAC : Tuning factor Eq. (3.41). +$ RSFAC : Tuning factor Eq. (3.42). +$ RNFAC : Tuning factor Eq. (3.43). +$ +$ Miscellaneous ------------------------------------------------------ $ +$ Misc. parameters : Namelist MISC +$ CICE0 : Ice concentration cut-off. +$ CICEN : Ice concentration cut-off. +$ XSEED : Xseed in seeding alg. (!/SEED). +$ FLAGTR : Indicating presence and type of +$ subgrid information : +$ 0 : No subgrid information. +$ 1 : Transparancies at cell boun- +$ daries between grid points. +$ 2 : Transp. at cell centers. +$ 3 : Like 1 with cont. ice. +$ 4 : Like 2 with cont. ice. +$ XP, XR, XFILT +$ Xp, Xr and Xf for the dynamic +$ integration scheme. +$ +$ In the 'Out of the box' test setup we run with sub-grid obstacles +$ and with continuous ice treatment. +$ +$ &MISC CICE0 = 0.25, CICEN = 0.75, FLAGTR = 4 / +$ +$ Mandatory string to identify end of namelist input section. +$ +END OF NAMELISTS +$ +$ Define grid -------------------------------------------------------- $ +$ + 'UNST' F 'NONE' +$ + 4.0 0.03 20 -1. 4 1 '(20f10.2)' 'NAME' '../input/Boers.msh' +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed). +$ +$ 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +$ +$ If sub-grid information is avalaible as indicated by FLAGTR above, +$ additional input to define this is needed below. In such cases a +$ field of fractional obstructions at or between grid points needs to +$ be supplied. First the location and format of the data is defined +$ by (as above) : +$ - Unit number of file (can be 10, and/or identical to bottem depth +$ unit), scale factor for fractional obstruction, IDLA, IDFM, +$ format for formatted read, FROM and filename +$ +$ 10 0.2 3 1 '(....)' 'NAME' 'obstr.inp' +$ +$ *** NOTE if this unit number is the same as the previous bottom +$ depth unit number, it is assumed that this is the same file +$ without further checks. *** +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed, +$ except between the two fields). +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 5 5 5 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ *** NOTE size of fields is always NX * NY *** +$ + 85 3 1 '(....)' 'PART' 'mapsta.inp' +$ Input boundary points ---------------------------------------------- $ +$ An unlimited number of lines identifying points at which input +$ boundary conditions are to be defined. If the actual input data is +$ not defined in the actual wave model run, the initial conditions +$ will be applied as constant boundary conditions. Each line contains: +$ Discrete grid counters (IX,IY) of the active point and a +$ connect flag. If this flag is true, and the present and previous +$ point are on a grid line or diagonal, all intermediate points +$ are also defined as boundary points. +$ +1 1 F +2 1 F +9 1 F +17 1 F +25 1 F +33 1 F +41 1 F +45 1 F +37 1 F +29 1 F +21 1 F +13 1 F +5 1 F +$ +$ Close list by defining point (0,0) (mandatory) +$ + 0 0 F +$ +$ +$ +$ Excluded grid points from segment data ( FROM != PART ) +$ First defined as lines, identical to the definition of the input +$ boundary points, and closed the same way. +$ + 0 0 F +$ +$ Second, define a point in a closed body of sea points to remove +$ the entire body os sea points. Also close by point (0,0) +$ + 0 0 +$ +$ Output boundary points --------------------------------------------- $ +$ Output boundary points are defined as a number of straight lines, +$ defined by its starting point (X0,Y0), increments (DX,DY) and number +$ of points. A negative number of points starts a new output file. +$ Note that this data is only generated if requested by the actual +$ program. Example again for spherical grid in degrees. +$ +$ -2.5312 48.5 0.00 0.008738 102 +$ -2.5312 49.3850 0.013554 0.00 51 +$ +$ Close list by defining line with 0 points (mandatory) +$ + 0. 0. 0. 0. 0 +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.19/input_Case1B/ww3_grid_b.nml b/regtests/ww3_tp2.19/input_Case1B/ww3_grid_b.nml new file mode 100644 index 000000000..67bb07eff --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1B/ww3_grid_b.nml @@ -0,0 +1,265 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_grid.nml - Grid pre-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the spectrum parameterization via SPECTRUM_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! SPECTRUM%XFR = 0. ! frequency increment +! SPECTRUM%FREQ1 = 0. ! first frequency (Hz) +! SPECTRUM%NK = 0 ! number of frequencies (wavenumbers) +! SPECTRUM%NTH = 0 ! number of direction bins +! SPECTRUM%THOFF = 0. ! relative offset of first direction [-0.5,0.5] +! -------------------------------------------------------------------- ! +&SPECTRUM_NML + SPECTRUM%XFR = 1.10 + SPECTRUM%FREQ1 = 0.0398 + SPECTRUM%NK = 46 + SPECTRUM%NTH = 360 +/ + +! -------------------------------------------------------------------- ! +! Define the run parameterization via RUN_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! RUN%FLDRY = F ! dry run (I/O only, no calculation) +! RUN%FLCX = F ! x-component of propagation +! RUN%FLCY = F ! y-component of propagation +! RUN%FLCTH = F ! direction shift +! RUN%FLCK = F ! wavenumber shift +! RUN%FLSOU = F ! source terms +! -------------------------------------------------------------------- ! +&RUN_NML + RUN%FLCX = T + RUN%FLCY = T + RUN%FLSOU = T +/ + +! -------------------------------------------------------------------- ! +! Define the timesteps parameterization via TIMESTEPS_NML namelist +! +! * It is highly recommended to set up time steps which are multiple +! between them. +! +! * The first time step to calculate is the maximum CFL time step +! which depend on the lowest frequency FREQ1 previously set up and the +! lowest spatial grid resolution in meters DXY. +! reminder : 1 degree=60minutes // 1minute=1mile // 1mile=1.852km +! The formula for the CFL time is : +! Tcfl = DXY / (G / (FREQ1*4*Pi) ) with the constants Pi=3,14 and G=9.8m/s²; +! DTXY ~= 90% Tcfl +! DTMAX ~= 3 * DTXY (maximum global time step limit) +! +! * The refraction time step depends on how strong can be the current velocities +! on your grid : +! DTKTH ~= DTMAX / 2 ! in case of no or light current velocities +! DTKTH ~= DTMAX / 10 ! in case of strong current velocities +! +! * The source terms time step is usually defined between 5s and 60s. +! A common value is 10s. +! DTMIN ~= 10 +! +! * namelist must be terminated with / +! * definitions & defaults: +! TIMESTEPS%DTMAX = 0. ! maximum global time step (s) +! TIMESTEPS%DTXY = 0. ! maximum CFL time step for x-y (s) +! TIMESTEPS%DTKTH = 0. ! maximum CFL time step for k-th (s) +! TIMESTEPS%DTMIN = 0. ! minimum source term time step (s) +! -------------------------------------------------------------------- ! +&TIMESTEPS_NML + TIMESTEPS%DTMAX = 1. + TIMESTEPS%DTXY = 1. + TIMESTEPS%DTKTH = 1. + TIMESTEPS%DTMIN = 1. +/ + +! -------------------------------------------------------------------- ! +! Define the grid to preprocess via GRID_NML namelist +! +! * the tunable parameters for source terms, propagation schemes, and +! numerics are read using namelists. +! * Any namelist found in the folowing sections is temporarily written +! to param.scratch, and read from there if necessary. +! * The order of the namelists is immaterial. +! * Namelists not needed for the given switch settings will be skipped +! automatically +! +! * grid type can be : +! 'RECT' : rectilinear +! 'CURV' : curvilinear +! 'UNST' : unstructured (triangle-based) +! +! * coordinate system can be : +! 'SPHE' : Spherical (degrees) +! 'CART' : Cartesian (meters) +! +! * grid closure can only be applied in spherical coordinates +! +! * grid closure can be : +! 'NONE' : No closure is applied +! 'SMPL' : Simple grid closure. Grid is periodic in the +! : i-index and wraps at i=NX+1. In other words, +! : (NX+1,J) => (1,J). A grid with simple closure +! : may be rectilinear or curvilinear. +! 'TRPL' : Tripole grid closure : Grid is periodic in the +! : i-index and wraps at i=NX+1 and has closure at +! : j=NY+1. In other words, (NX+1,J<=NY) => (1,J) +! : and (I,NY+1) => (NX-I+1,NY). Tripole +! : grid closure requires that NX be even. A grid +! : with tripole closure must be curvilinear. +! +! * The coastline limit depth is the value which distinguish the sea +! points to the land points. All the points with depth values (ZBIN) +! greater than this limit (ZLIM) will be considered as excluded points +! and will never be wet points, even if the water level grows over. +! It can only overwrite the status of a sea point to a land point. +! The value must have a negative value under the mean sea level +! +! * The minimum water depth allowed to compute the model is the absolute +! depth value (DMIN) used in the model if the input depth is lower to +! avoid the model to blow up. +! +! * namelist must be terminated with / +! * definitions & defaults: +! GRID%NAME = 'unset' ! grid name (30 char) +! GRID%NML = 'namelists.nml' ! namelists filename +! GRID%TYPE = 'unset' ! grid type +! GRID%COORD = 'unset' ! coordinate system +! GRID%CLOS = 'unset' ! grid closure +! +! GRID%ZLIM = 0. ! coastline limit depth (m) +! GRID%DMIN = 0. ! abs. minimum water depth (m) +! -------------------------------------------------------------------- ! +&GRID_NML + GRID%NAME = 'Boers' + GRID%NML = '../input_Case1A/namelists_b.nml' + GRID%TYPE = 'UNST' + GRID%COORD = 'CART' + GRID%CLOS = 'F' + GRID%ZLIM = 4.0 + GRID%DMIN = 0.03 +/ + +! -------------------------------------------------------------------- ! +! Define the unstructured grid type via UNST_NML namelist +! - only for UNST grids - +! +! * The minimum grid size is 3x3. +! +! * &MISC namelist must be removed +! +! * The depth value must have negative values under the mean sea level +! +! * The map value must be set as : +! -2 : Excluded boundary point (covered by ice) +! -1 : Excluded sea point (covered by ice) +! 0 : Excluded land point +! 1 : Sea point +! 2 : Active boundary point +! 3 : Excluded grid point +! 7 : Ice point +! +! * the file must be a GMESH grid file containing node and element lists. +! +! * Extra open boundary list file with UGOBCFILE in namelist &UNST +! An example is given in regtest ww3_tp2.7 +! +! * value <= scale_fac * value_read +! +! * IDLA : Layout indicator : +! 1 : Read line-by-line bottom to top. (default) +! 2 : Like 1, single read statement. +! 3 : Read line-by-line top to bottom. +! 4 : Like 3, single read statement. +! * IDFM : format indicator : +! 1 : Free format. (default) +! 2 : Fixed format. +! 3 : Unformatted. +! * FORMAT : element format to read : +! '(....)' : auto detected (default) +! '(f10.6)' : float type +! +! * Example : +! IDF SF IDLA IDFM FORMAT FILENAME +! 20 -1. 4 2 '(20f10.2)' 'ngug.msh' +! +! * namelist must be terminated with / +! * definitions & defaults: +! UNST%SF = 1. ! unst scale factor +! UNST%FILENAME = 'unset' ! unst filename +! UNST%IDF = 20 ! unst file unit number +! UNST%IDLA = 1 ! unst layout indicator +! UNST%IDFM = 1 ! unst format indicator +! UNST%FORMAT = '(....)' ! unst formatted read format +! +! UNST%UGOBCFILE = 'unset' ! additional boundary list file +! -------------------------------------------------------------------- ! +&UNST_NML + UNST%SF = -1. + UNST%FILENAME = '../input/Boers.msh' + UNST%IDLA = 4 + UNST%FORMAT = '(20f10.2)' +/ + +! -------------------------------------------------------------------- ! +! Define the input boundary points via INBND_COUNT_NML and +! INBND_POINT_NML namelist +! - for RECT, CURV and UNST grids - +! +! * If no mask defined, INBOUND can be used +! +! * If the actual input data is not defined in the actual wave model run +! the initial conditions will be applied as constant boundary conditions. +! +! * The number of points is defined by INBND_COUNT +! +! * The points must start from index 1 to N +! +! * Each line contains: +! Discrete grid counters (IX,IY) of the active point and a +! connect flag. If this flag is true, and the present and previous +! point are on a grid line or diagonal, all intermediate points +! are also defined as boundary points. +! +! * Included point : +! grid points from segment data +! Defines as lines identifying points at which +! input boundary conditions are to be defined. +! +! * namelist must be terminated with / +! * definitions & defaults: +! INBND_COUNT%N_POINT = 0 ! number of segments +! +! INBND_POINT(I)%X_INDEX = 0 ! x index included point +! INBND_POINT(I)%Y_INDEX = 0 ! y index included point +! INBND_POINT(I)%CONNECT = F ! connect flag +! +! OR +! INBND_POINT(I) = 0 0 F ! included point +! -------------------------------------------------------------------- ! +&INBND_COUNT_NML + INBND_COUNT%N_POINT = 13 +/ + +&INBND_POINT_NML + INBND_POINT(1) = 1 1 F + INBND_POINT(2) = 2 1 F + INBND_POINT(3) = 9 1 F + INBND_POINT(4) = 17 1 F + INBND_POINT(5) = 25 1 F + INBND_POINT(6) = 33 1 F + INBND_POINT(7) = 41 1 F + INBND_POINT(8) = 45 1 F + INBND_POINT(9) = 37 1 F + INBND_POINT(10) = 29 1 F + INBND_POINT(11) = 21 1 F + INBND_POINT(12) = 13 1 F + INBND_POINT(13) = 5 1 F +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_tp2.19/input_Case1B/ww3_ounf.inp b/regtests/ww3_tp2.19/input_Case1B/ww3_ounf.inp new file mode 100644 index 000000000..9593f72eb --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1B/ww3_ounf.inp @@ -0,0 +1,82 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Grid output post-processing $ +$--------------------------------------------------------------------- $ +$ Time, time increment and number of outputs (set to 4 days) +$ + 20180701 000000 1. 9999 +$ +$ Fields requested --------------------------------------------------- $ +$ +$ Output request flags identifying fields as in ww3_shel.inp. See that +$ file for a full documentation of field output options. Namelist type +$ selection is used here (for alternative F/T flags, see ww3_shel.inp). +$ +$ DPT CUR WND AST WLV ICE IBG D50 IC1 IC5 HS LM T02 T0M1 T01 FP DIR SPR +$ DP HIG EF TH1M STH1M TH2M STH2M WN PHS PTP PLP PDIR PSPR PWS TWS PNR +$ UST CHA CGE FAW TAW TWA WCC WCF WCH WCM SXY TWO BHD FOC TUS USS P2S +$ USF P2L TWI FIC ABR UBR BED FBB TBB MSS MSC DTD FC CFX CFD CFK U1 U2 +$ + N +WLV DPT T02 DIR CUR HS T0M1 FP SXX SXY SYY +$--------------------------------------------------------------------- $ +$ netCDF version [3,4] +$ and variable type 4 [2 = SHORT, 3 = it depends , 4 = REAL] +$ swell partitions [0 1 2 3 4 5] +$ variables in same file [T] or not [F] +$ + 4 4 + 0 1 2 + F +$ -------------------------------------------------------------------- $ +$ ITYPE = 0, inventory of file. +$ No additional input, the above time range is ignored. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 1, print plots. +$ IX,IY range and stride, flag for automatic scaling to +$ maximum value (otherwise fixed scaling), +$ vector component flag (dummy for scalar quantities). +$ +$ 1 12 1 1 12 1 F T +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 2, field statistics. +$ IX,IY range. +$ +$ 1 12 1 12 +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 3, transfer files. +$ IX, IY range, IDLA and IDFM as in ww3_grid.inp. +$ The additional option IDLA=5 gives ia longitude, lattitude +$ and parameter value(s) per record (defined points only). +$ +$1 12518 1 1 3 2 +$ +$ For each field and time a new file is generated with the file name +$ ww3.yymmddhh.xxx, where yymmddhh is a conventional time idicator, +$ and xxx is a field identifier. The first record of the file contains +$ a file ID (C*13), the time in yyyymmdd hhmmss format, the lowest, +$ highest and number of longitudes (2R,I), id. latitudes, the file +$ extension name (C*$), a scale factor (R), a unit identifier (C*10), +$ IDLA, IDFM, a format (C*11) and a number identifying undefined or +$ missing values (land, ice, etc.). The field follows as defined by +$ IDFM and IDLA, defined as in the grid proprocessor. IDLA=5 is added +$ and gives a set of records containing the longitude, latitude and +$ parameter value. Note that the actual data is written as an integers. +$ -------------------------------------------------------------------- $ +$ ITYPE = 4, Netcdf Files +$ S3: number of characters in date +$ IX, IY range +$ +ww3. +6 + 1 999999999 1 1 3 2 +$ For each field and time a new file is generated with the file name +$ ww3.date_xxx.nc , where date is a conventional time idicator with S3 +$ characters, +$ and xxx is a field identifier. +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.19/input_Case1B/ww3_ounf.nml b/regtests/ww3_tp2.19/input_Case1B/ww3_ounf.nml new file mode 100644 index 000000000..46d827bfe --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1B/ww3_ounf.nml @@ -0,0 +1,87 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_ounf.nml - Grid output post-processing ! +! -------------------------------------------------------------------- ! +! -------------------------------------------------------------------- ! +! Define the output fields to postprocess via FIELD_NML namelist +! +! * the detailed list of field names FIELD%LIST is given in ww3_shel.nml +! DPT CUR WND AST WLV ICE IBG D50 IC1 IC5 +! HS LM T02 T0M1 T01 FP DIR SPR DP HIG +! EF TH1M STH1M TH2M STH2M WN +! PHS PTP PLP PDIR PSPR PWS PDP PQP PPE PGW PSW PTM10 PT01 PT02 PEP TWS PNR +! UST CHA CGE FAW TAW TWA WCC WCF WCH WCM FWS +! SXY TWO BHD FOC TUS USS P2S USF P2L TWI FIC +! ABR UBR BED FBB TBB +! MSS MSC WL02 AXT AYT AXY +! DTD FC CFX CFD CFK +! U1 U2 +! +! * namelist must be terminated with / +! * definitions & defaults: +! FIELD%TIMESTART = '19000101 000000' ! Stop date for the output field +! FIELD%TIMESTRIDE = '0' ! Time stride for the output field +! FIELD%TIMECOUNT = '1000000000' ! Number of time steps +! FIELD%TIMESPLIT = 6 ! [0(nodate),4(yearly),6(monthly),8(daily),10(hourly)] +! FIELD%LIST = 'unset' ! List of output fields +! FIELD%PARTITION = '0 1 2 3' ! List of wave partitions ['0 1 2 3 4 5'] +! FIELD%SAMEFILE = T ! All the variables in the same file +! FIELD%TYPE = 3 ! [2 = SHORT, 3 = it depends , 4 = REAL] +! -------------------------------------------------------------------- ! +&FIELD_NML + FIELD%TIMESTART = '20180701 000000' + FIELD%TIMESTRIDE = '1' + FIELD%LIST = 'WLV DPT T02 DIR CUR HS T0M1 FP SXX SXY SYY' + FIELD%SAMEFILE = F + FIELD%TYPE = 4 +/ + + +! -------------------------------------------------------------------- ! +! Define the content of the output file via FILE_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! FILE%PREFIX = 'ww3.' ! Prefix for output file name +! FILE%NETCDF = 3 ! Netcdf version [3|4] +! FILE%IX0 = 1 ! First X-axis or node index +! FILE%IXN = 1000000000 ! Last X-axis or node index +! FILE%IY0 = 1 ! First Y-axis index +! FILE%IYN = 1000000000 ! Last Y-axis index +! -------------------------------------------------------------------- ! +&FILE_NML + FILE%NETCDF = 4 +/ + +! -------------------------------------------------------------------- ! +! Define the content of the output file via SMC_NML namelist +! +! * For SMC grids, IX0, IXN, IY0 and IYN from FILE_NML are not used. +! Two types of output are available: +! * TYPE=1: Flat 1D "seapoint" array of grid cells. +! * TYPE=2: Re-gridded regular grid with cell sizes being an integer +! * multiple of the smallest SMC grid cells size. +! +! * Note that the first/last longitudes and latitudes will be adjusted +! to snap to the underlying SMC grid edges. CELFAC is only used for +! type 2 output and defines the output cell sizes as an integer +! multiple of the smallest SMC Grid cell size. CELFAC should be a +! power of 2, e.g: 1,2,4,8,16, etc... +! +! * namelist must be terminated with / +! * definitions & defaults: +! SMC%TYPE = 1 ! SMC Grid type (1 or 2) +! SMC%SXO = -999.9 ! First longitude +! SMC%EXO = -999.9 ! Last longitude +! SMC%SYO = -999.9 ! First latitude +! SMC%EYO = -999.9 ! Last latitude +! SMC%CELFAC = 1 ! Cell size factor (SMCTYPE=2 only) +! SMC%NOVAL = UNDEF ! Fill value for wet cells with no data +! -------------------------------------------------------------------- ! +&SMC_NML +/ + + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! + diff --git a/regtests/ww3_tp2.19/input_Case1B/ww3_ounp.inp b/regtests/ww3_tp2.19/input_Case1B/ww3_ounp.inp new file mode 100644 index 000000000..c20417ad4 --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1B/ww3_ounp.inp @@ -0,0 +1,119 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III NETCDF Point output post-processing $ +$--------------------------------------------------------------------- $ +$ First output time (yyyymmdd hhmmss), increment of output (s), +$ and number of output times. +$ + 20180701 000000 1. 1000 +$ +$ Points requested --------------------------------------------------- $ +$ +$ Define points index for which output is to be generated. +$ If no one defined, all points are selected +$ One index number per line, negative number identifies end of list. +$ 1 +$ 2 +$ mandatory end of list + -1 +$ +$--------------------------------------------------------------------- $ +$ file prefix +$ number of characters in date [4(yearly),6(monthly),8(daily),10(hourly)] +$ netCDF version [3,4] +$ points in same file [T] or not [F] +$ and max number of points to be processed in one pass +$ output type ITYPE [0,1,2,3] +$ flag for global attributes WW3 [0] or variable version [1-2-3-4] +$ flag for dimensions order time,station [T] or station,time [F] +$ + ww3. + 6 + 4 + T 150 + 1 + 0 + T +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 0, inventory of file. +$ No additional input, the above time range is ignored. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 1, netCDF Spectra. +$ - Sub-type OTYPE : 1 : Print plots. +$ 2 : Table of 1-D spectra +$ 3 : Transfer file. +$ 4 : Spectral partitioning. +$ - Scaling factors for 1-D and 2-D spectra Negative factor +$ disables, output, factor = 0. gives normalized spectrum. +$ - Netcdf variable type [2=SHORT, 3=it depends, 4=REAL] +$ + 3 1 0 4 +$ +$ The transfer file contains records with the following contents. +$ +$ - File ID in quotes, number of frequencies, directions and points. +$ grid name in quotes (for unformatted file C*21,3I,C*30). +$ - Bin frequencies in Hz for all bins. +$ - Bin directions in radians for all bins (Oceanographic conv.). +$ -+ +$ - Time in yyyymmdd hhmmss format | loop +$ -+ | +$ - Point name (C*40), lat, lon, d, U10 and | loop | over +$ direction, current speed and direction | over | +$ - E(f,theta) | points | times +$ -+ -+ +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 2, netCDF Tables of (mean) parameter +$ - Sub-type OTYPE : 1 : Depth, current, wind +$ 2 : Mean wave pars. +$ 3 : Nondimensional pars. (U*) +$ 4 : Nondimensional pars. (U10) +$ 5 : 'Validation table' +$ 6 : WMO standard output +$ 4 +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 3, netCDF Source terms +$ - Sub-type OTYPE : 1 : Print plots. +$ 2 : Table of 1-D S(f). +$ 3 : Table of 1-D inverse time scales +$ (1/T = S/F). +$ 4 : Transfer file +$ - Scaling factors for 1-D and 2-D source terms. Negative +$ factor disables print plots, factor = 0. gives normalized +$ print plots. +$ - Flags for spectrum, input, interactions, dissipation, +$ bottom, ice and total source term. +$ - scale ISCALE for OTYPE=2,3 +$ 0 : Dimensional. +$ 1 : Nondimensional in terms of U10 +$ 2 : Nondimensional in terms of U* +$ 3-5: like 0-2 with f normalized with fp. +$ +$ 4 0 0 T T T T T T T 0 +$ +$ The transfer file contains records with the following contents. +$ +$ - File ID in quotes, number of frequencies, directions and points, +$ flags for spectrum and source terms (C*21, 3I, 6L) +$ - Bin frequencies in Hz for all bins. +$ - Bin directions in radians for all bins (Oceanographic conv.). +$ -+ +$ - Time in yyyymmdd hhmmss format | loop +$ -+ | +$ - Point name (C*40), depth, wind speed and | loop | over +$ direction, current speed and direction | over | +$ - E(f,theta) if requested | points | times +$ - Sin(f,theta) if requested | | +$ - Snl(f,theta) if requested | | +$ - Sds(f,theta) if requested | | +$ - Sbt(f,theta) if requested | | +$ - Sice(f,theta) if requested | | +$ - Stot(f,theta) if requested | | +$ -+ -+ +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.19/input_Case1B/ww3_ounp.nml b/regtests/ww3_tp2.19/input_Case1B/ww3_ounp.nml new file mode 100644 index 000000000..44807228a --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1B/ww3_ounp.nml @@ -0,0 +1,193 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_ounp.nml - Point output post-processing ! +! -------------------------------------------------------------------- ! + + +! -------------------------------------------------------------------- ! +! Define the output fields to postprocess via POINT_NML namelist +! +! +! * namelist must be terminated with / +! * definitions & defaults: +! POINT%TIMESTART = '19000101 000000' ! Stop date for the output field +! POINT%TIMESTRIDE = '0' ! Time stride for the output field +! POINT%TIMECOUNT = '1000000000' ! Number of time steps +! POINT%TIMESPLIT = 6 ! [4(yearly),6(monthly),8(daily),10(hourly)] +! POINT%LIST = 'all' ! List of points index ['all'|'1 2 3'] +! POINT%SAMEFILE = T ! All the points in the same file +! POINT%BUFFER = 150 ! Number of points to process per pass +! POINT%TYPE = 1 ! [0=inventory | 1=spectra | 2=mean param | 3=source terms] +! POINT%DIMORDER = T ! [time,station=T | station,time=F] +! -------------------------------------------------------------------- ! +&POINT_NML + POINT%TIMESTART = '20180701 000000' + POINT%TIMESTRIDE = '1' +/ + + +! -------------------------------------------------------------------- ! +! Define the content of the output file via FILE_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! FILE%PREFIX = 'ww3.' ! Prefix for output file name +! FILE%NETCDF = 3 ! Netcdf version [3|4] +! -------------------------------------------------------------------- ! +&FILE_NML + FILE%NETCDF = 4 +/ + + +! -------------------------------------------------------------------- ! +! Define the type 0, inventory of file +! +! * namelist must be terminated with / +! * definitions & defaults: +! No additional input, the above time range is ignored. +! -------------------------------------------------------------------- ! + + + +! -------------------------------------------------------------------- ! +! Define the type 1, spectra via SPECTRA_NML namelist +! +! Table of 1-D spectra content : +! - time, station id, station name, longitude, latitude +! - frequency : unit Hz, center band frequency - linear log scale (XFR factor) +! - ffp, f, th1m, sth1m, alpha : 1D spectral parameters +! - dpt, ust, wnd, wnddir : mean parameters +! +! Transfert file content : +! - time, station id, station name, longitude, latitude +! - frequency : unit Hz, center band frequency - linear log scale (XFR factor) +! - frequency1 : unit Hz, lower band frequency +! - frequency2 : unit Hz, upper band frequency +! - direction : unit degree, convention to, origin East, trigonometric order +! - efth(time,station,frequency,direction) : 2D spectral density +! - dpt, wnd, wnddir, cur, curdir : mean parameters +! +! Spectral partitioning content : +! - time, station id, station name, longitude, latitude +! - npart : number of partitions +! - hs, tp, lm, th1m, sth1m, ws, tm10, t01, t02 : partitioned parameters +! - dpt, wnd, wnddir, cur, curdir : mean parameters +! +! +! * namelist must be terminated with / +! * definitions & defaults: +! SPECTRA%OUTPUT = 3 ! 1: Print plots +! ! 2: Table of 1-D spectra +! ! 3: Transfer file +! ! 4: Spectral partitioning +! SPECTRA%SCALE_FAC = 1 ! Scale factor (-1=disabled) +! SPECTRA%OUTPUT_FAC = 0 ! Output factor (0=normalized) +! -------------------------------------------------------------------- ! +&SPECTRA_NML +/ + + +! -------------------------------------------------------------------- ! +! Define the type 2, mean parameter via PARAM_NML namelist +! +! Forcing parameters content : +! - dpt, wnd, wnddir, cur, curdir +! +! Mean wave parameters content : +! - hs, lm, tr, th1p, sth1p, fp, th1m, sth1m +! +! Nondimensional parameters (U*) content : +! - ust, efst, fpst, cd, alpha +! +! Nondimensional parameters (U10) content : +! - wnd, efst, fpst, cd, alpha +! +! Validation table content : +! - wnd, wnddir, hs, hsst, cpu, cmu, ast +! +! WMO stantdard output content : +! - wnd, wnddir, hs, tp +! +! * namelist must be terminated with / +! * definitions & defaults: +! PARAM%OUTPUT = 4 ! 1: Forcing parameters +! ! 2: Mean wave parameters +! ! 3: Nondimensional pars. (U*) +! ! 4: Nondimensional pars. (U10) +! ! 5: Validation table +! ! 6: WMO standard output +! -------------------------------------------------------------------- ! +&PARAM_NML +/ + + +! -------------------------------------------------------------------- ! +! Define the type 3, source terms via SOURCE_NML namelist +! +! Table of 1-D S(f) content : +! - time, station id, station name, longitude, latitude +! - frequency : unit Hz, center band frequency +! - ef(frequency) : 1D spectral density +! - Sin(frequency) : input source term +! - Snl(frequency) : non linear interactions source term +! - Sds(frequency) : dissipation source term +! - Sbt(frequency) : bottom source term +! - Sice(frequency) : ice source term +! - Stot(frequency) : total source term +! - dpt, ust, wnd : mean parameters +! +! Table of 1-D inverse time scales (1/T = S/F) content : +! - time, station id, station name, longitude, latitude +! - frequency : unit Hz, center band frequency +! - ef(frequency) : 1D spectral density +! - tini(frequency) : input inverse time scales source term +! - tnli(frequency) : non linear interactions inverse time scales source term +! - tdsi(frequency) : dissipation inverse time scales source term +! - tbti(frequency) : bottom inverse time scales source term +! - ticei(frequency) : ice inverse time scales source term +! - ttoti(frequency) : total inverse time scales source term +! - dpt, ust, wnd : mean parameters +! +! Transfert file content : +! - time, station id, station name, longitude, latitude +! - frequency : unit Hz, center band frequency - linear log scale (XFR factor) +! - frequency1 : unit Hz, lower band frequency +! - frequency2 : unit Hz, upper band frequency +! - direction : unit degree, convention to, origin East, trigonometric order +! - efth(frequency,direction) : 2D spectral density +! - Sin(frequency,direction) : input source term +! - Snl(frequency,direction) : non linear interactions source term +! - Sds(frequency,direction) : dissipation source term +! - Sbt(frequency,direction) : bottom source term +! - Sice(frequency,direction) : ice source term +! - Stot(frequency,direction) : total source term +! - dpt, wnd, wnddir, cur, curdir, ust : mean parameters +! +! +! * namelist must be terminated with / +! * definitions & defaults: +! SOURCE%OUTPUT = 4 ! 1: Print plots +! ! 2: Table of 1-D S(f) +! ! 3: Table of 1-D inverse time scales (1/T = S/F) +! ! 4: Transfer file +! SOURCE%SCALE_FAC = 0 ! Scale factor (-1=disabled) +! SOURCE%OUTPUT_FAC = 0 ! Output factor (0=normalized) +! SOURCE%TABLE_FAC = 0 ! Table factor +! 0 : Dimensional. +! 1 : Nondimensional in terms of U10 +! 2 : Nondimensional in terms of U* +! 3-5: like 0-2 with f normalized with fp. +! SOURCE%SPECTRUM = T ! [T|F] +! SOURCE%INPUT = T ! [T|F] +! SOURCE%INTERACTIONS = T ! [T|F] +! SOURCE%DISSIPATION = T ! [T|F] +! SOURCE%BOTTOM = T ! [T|F] +! SOURCE%ICE = T ! [T|F] +! SOURCE%TOTAL = T ! [T|F] +! -------------------------------------------------------------------- ! +&SOURCE_NML +/ + + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_tp2.19/input_Case1B/ww3_shel.inp b/regtests/ww3_tp2.19/input_Case1B/ww3_shel.inp new file mode 100644 index 000000000..6913cd556 --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1B/ww3_shel.inp @@ -0,0 +1,115 @@ +$ WAVEWATCH III shell input file +$ ------------------------------ + F F Water levels + F F Currents + F F Winds + F F Ice concentrations + F F Atmospheric momentum + F F Air density + F Assimilation data : Mean parameters + F Assimilation data : 1-D spectra + F Assimilation data : 2-D spectra. +$ + 20180701 000000 + 20180701 000130 +$ + 1 +$ + 20180701 000000 2 20180701 010000 +$ +N +WLV T02 DIR CUR HS T0M1 FP SXX SXY SYY DPT +$ + 20180701 000000 2 20180701 010000 +$ +$output points for Inlet +$ +$ +0 0.0 a01 +1 0.0 a02 +2 0.0 a03 +3 0.0 a04 +4 0.0 a05 +5 0.0 a06 +6 0.0 a07 +7 0.0 a08 +8 0.0 a09 +9 0.0 a10 +10 0.0 a11 +11 0.0 a12 +12 0.0 a13 +13 0.0 a14 +14 0.0 a15 +15 0.0 a16 +15.5 0.0 a17 +16 0.0 a18 +16.5 0.0 a19 +17 0.0 a20 +17.5 0.0 a21 +18 0.0 a22 +18.5 0.0 a23 +19 0.0 a24 +19.2 0.0 a25 +19.4 0.0 a26 +19.6 0.0 a27 +19.8 0.0 a28 +20 0.0 a29 +20.2 0.0 a30 +20.4 0.0 a31 +20.6 0.0 a32 +20.8 0.0 a33 +21 0.0 a34 +21.2 0.0 a35 +21.4 0.0 a36 +21.6 0.0 a37 +21.8 0.0 a38 +22 0.0 a39 +22.2 0.0 a40 +22.4 0.0 a41 +22.6 0.0 a42 +22.8 0.0 a43 +23 0.0 a44 +23.2 0.0 a45 +23.4 0.0 a46 +23.6 0.0 a47 +23.8 0.0 a48 +24 0.0 a49 +24.2 0.0 a50 +24.4 0.0 a51 +24.6 0.0 a52 +24.8 0.0 a53 +25 0.0 a54 +25.2 0.0 a55 +25.4 0.0 a56 +25.6 0.0 a57 +25.8 0.0 a58 +26 0.0 a59 +26.2 0.0 a60 +26.4 0.0 a61 +26.56 0.0 a62 +26.8 0.0 a63 +27 0.0 a64 +27.25 0.0 a65 +27.5 0.0 a66 +27.75 0.0 a67 +28 0.0 a68 +28.25 0.0 a69 +28.5 0.0 a70 +28.75 0.0 a71 +29.00 0.0 a72 +29.25 0.0 a73 +29.50 0.0 a74 +29.75 0.0 a75 +30.00 0.0 a76 +30.25 0.0 a77 +30.50 0.0 a78 +30.75 0.0 a79 +31.00 0.0 a80 +$ + 0.0 0.0 'STOPSTRING' +$ + 19680606 000000 0 19680608 000000 + 19680606 000000 0 19680608 000000 + 19680606 000000 0 19680608 000000 + 19680606 000000 0 19680608 000000 +$ diff --git a/regtests/ww3_tp2.19/input_Case1B/ww3_shel.nml b/regtests/ww3_tp2.19/input_Case1B/ww3_shel.nml new file mode 100644 index 000000000..030117c15 --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1B/ww3_shel.nml @@ -0,0 +1,337 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III ww3_shel.nml - single-grid model ! +! -------------------------------------------------------------------- ! + + +! -------------------------------------------------------------------- ! +! Define top-level model parameters via DOMAIN_NML namelist +! +! * IOSTYP defines the output server mode for parallel implementation. +! 0 : No data server processes, direct access output from +! each process (requires true parallel file system). +! 1 : No data server process. All output for each type +! performed by process that performs computations too. +! 2 : Last process is reserved for all output, and does no +! computing. +! 3 : Multiple dedicated output processes. +! +! * namelist must be terminated with / +! * definitions & defaults: +! DOMAIN%IOSTYP = 1 ! Output server type +! DOMAIN%START = '19680606 000000' ! Start date for the entire model +! DOMAIN%STOP = '19680607 000000' ! Stop date for the entire model +! -------------------------------------------------------------------- ! +&DOMAIN_NML + DOMAIN%IOSTYP = 1 + DOMAIN%START = '20180701 000000' + DOMAIN%STOP = '20180701 000130' +/ + +! -------------------------------------------------------------------- ! +! Define each forcing via the INPUT_NML namelist +! +! * The FORCING flag can be : 'F' for "no forcing" +! 'T' for "external forcing file" +! 'H' for "homogeneous forcing input" +! 'C' for "coupled forcing field" +! +! * homogeneous forcing is not available for ICE_CONC +! +! * The ASSIM flag can : 'F' for "no forcing" +! 'T' for "external forcing file" +! +! * namelist must be terminated with / +! * definitions & defaults: +! INPUT%FORCING%WATER_LEVELS = 'F' +! INPUT%FORCING%CURRENTS = 'F' +! INPUT%FORCING%WINDS = 'F' +! INPUT%FORCING%ICE_CONC = 'F' +! INPUT%FORCING%ICE_PARAM1 = 'F' +! INPUT%FORCING%ICE_PARAM2 = 'F' +! INPUT%FORCING%ICE_PARAM3 = 'F' +! INPUT%FORCING%ICE_PARAM4 = 'F' +! INPUT%FORCING%ICE_PARAM5 = 'F' +! INPUT%FORCING%MUD_DENSITY = 'F' +! INPUT%FORCING%MUD_THICKNESS = 'F' +! INPUT%FORCING%MUD_VISCOSITY = 'F' +! INPUT%ASSIM%MEAN = 'F' +! INPUT%ASSIM%SPEC1D = 'F' +! INPUT%ASSIM%SPEC2D = 'F' +! -------------------------------------------------------------------- ! +&INPUT_NML +INPUT%FORCING%WATER_LEVELS = 'F' +/ + +! -------------------------------------------------------------------- ! +! Define the output types point parameters via OUTPUT_TYPE_NML namelist +! +! * the point file is a space separated values per line : lon lat 'name' +! +! * the full list of field names is : +! All parameters listed below are available in output file of the types +! ASCII and NetCDF. If selected output file types are grads or grib, +! some parameters may not be available. The first two columns in the +! table below identify such cases by flags, cols 1 (GRB) and 2 (GXO) +! refer to grib (ww3_grib) and grads (gx_outf), respectively. +! +! Columns 3 and 4 provide group and parameter numbers per group. +! Columns 5, 6 and 7 provide: +! 5 - code name (internal) +! 6 - output tags (names used is ASCII file extensions, NetCDF +! variable names and namelist-based selection +! 7 - Long parameter name/definition +! +! G G +! R X Grp Param Code Output Parameter/Group +! B O Numb Numbr Name Tag Definition +! -------------------------------------------------- +! 1 Forcing Fields +! ------------------------------------------------- +! T T 1 1 DW DPT Water depth. +! T T 1 2 C[X,Y] CUR Current velocity. +! T T 1 3 UA WND Wind speed. +! T T 1 4 AS AST Air-sea temperature difference. +! T T 1 5 WLV WLV Water levels. +! T T 1 6 ICE ICE Ice concentration. +! T T 1 7 IBG IBG Iceberg-induced damping. +! T T 1 8 D50 D50 Median sediment grain size. +! T T 1 9 IC1 IC1 Ice thickness. +! T T 1 10 IC5 IC5 Ice flow diameter. +! ------------------------------------------------- +! 2 Standard mean wave Parameters +! ------------------------------------------------- +! T T 2 1 HS HS Wave height. +! T T 2 2 WLM LM Mean wave length. +! T T 2 3 T02 T02 Mean wave period (Tm0,2). +! T T 2 4 TM10 TM10 Mean wave period (Tm-1,0). +! T T 2 5 T01 T01 Mean wave period (Tm0,1). +! T T 2 6 FP0 FP Peak frequency. +! T T 2 7 THM DIR Mean wave direction. +! T T 2 8 THS SPR Mean directional spread. +! T T 2 9 THP0 DP Peak direction. +! T T 2 10 HIG HIG Infragravity height +! T T 2 11 STMAXE MXE Max surface elev (STE) +! T T 2 12 STMAXD MXES St Dev of max surface elev (STE) +! T T 2 13 HMAXE MXH Max wave height (STE) +! T T 2 14 HCMAXE MXHC Max wave height from crest (STE) +! T T 2 15 HMAXD SDMH St Dev of MXC (STE) +! T T 2 16 HCMAXD SDMHC St Dev of MXHC (STE) +! F T 2 17 WBT WBT Domiant wave breaking probability bT +! ------------------------------------------------- +! 3 Spectral Parameters (first 5) +! ------------------------------------------------- +! F F 3 1 EF EF Wave frequency spectrum +! F F 3 2 TH1M TH1M Mean wave direction from a1,b2 +! F F 3 3 STH1M STH1M Directional spreading from a1,b2 +! F F 3 4 TH2M TH2M Mean wave direction from a2,b2 +! F F 3 5 STH2M STH2M Directional spreading from a2,b2 +! F F 3 6 WN WN Wavenumber array +! ------------------------------------------------- +! 4 Spectral Partition Parameters +! ------------------------------------------------- +! T T 4 1 PHS PHS Partitioned wave heights. +! T T 4 2 PTP PTP Partitioned peak period. +! T T 4 3 PLP PLP Partitioned peak wave length. +! T T 4 4 PDIR PDIR Partitioned mean direction. +! T T 4 5 PSI PSPR Partitioned mean directional spread. +! T T 4 6 PWS PWS Partitioned wind sea fraction. +! T T 4 7 PTHP0 PDP Peak wave direction of partition. +! T T 4 8 PQP PQP Goda peakdedness parameter of partition. +! T T 4 9 PPE PPE JONSWAP peak enhancement factor of partition. +! T T 4 10 PGW PGW Gaussian frequency width of partition. +! T T 4 11 PSW PSW Spectral width of partition. +! T T 4 12 PTM1 PTM10 Mean wave period (Tm-1,0) of partition. +! T T 4 13 PT1 PT01 Mean wave period (Tm0,1) of partition. +! T T 4 14 PT2 PT02 Mean wave period (Tm0,2) of partition. +! T T 4 15 PEP PEP Peak spectral density of partition. +! T T 4 16 PWST TWS Total wind sea fraction. +! T T 4 17 PNR PNR Number of partitions. +! ------------------------------------------------- +! 5 Atmosphere-waves layer +! ------------------------------------------------- +! T T 5 1 UST UST Friction velocity. +! F T 5 2 CHARN CHA Charnock parameter +! F T 5 3 CGE CGE Energy flux +! F T 5 4 PHIAW FAW Air-sea energy flux +! F T 5 5 TAUWI[X,Y] TAW Net wave-supported stress +! F T 5 6 TAUWN[X,Y] TWA Negative part of the wave-supported stress +! F F 5 7 WHITECAP WCC Whitecap coverage +! F F 5 8 WHITECAP WCF Whitecap thickness +! F F 5 9 WHITECAP WCH Mean breaking height +! F F 5 10 WHITECAP WCM Whitecap moment +! F F 5 11 FWS FWS Wind sea mean period +! ------------------------------------------------- +! 6 Wave-ocean layer +! ------------------------------------------------- +! F F 6 1 S[XX,YY,XY] SXY Radiation stresses. +! F F 6 2 TAUO[X,Y] TWO Wave to ocean momentum flux +! F F 6 3 BHD BHD Bernoulli head (J term) +! F F 6 4 PHIOC FOC Wave to ocean energy flux +! F F 6 5 TUS[X,Y] TUS Stokes transport +! F F 6 6 USS[X,Y] USS Surface Stokes drift +! F F 6 7 [PR,TP]MS P2S Second-order sum pressure +! F F 6 8 US3D USF Spectrum of surface Stokes drift +! F F 6 9 P2SMS P2L Micro seism source term +! F F 6 10 TAUICE TWI Wave to sea ice stress +! F F 6 11 PHICE FIC Wave to sea ice energy flux +! ------------------------------------------------- +! 7 Wave-bottom layer +! ------------------------------------------------- +! F F 7 1 ABA ABR Near bottom rms amplitides. +! F F 7 2 UBA UBR Near bottom rms velocities. +! F F 7 3 BEDFORMS BED Bedforms +! F F 7 4 PHIBBL FBB Energy flux due to bottom friction +! F F 7 5 TAUBBL TBB Momentum flux due to bottom friction +! ------------------------------------------------- +! 8 Spectrum parameters +! ------------------------------------------------- +! F F 8 1 MSS[X,Y] MSS Mean square slopes +! F F 8 2 MSC[X,Y] MSC Spectral level at high frequency tail +! F F 8 3 WL02[X,Y] WL02 East/X North/Y mean wavelength compon +! F F 8 4 ALPXT AXT Correl sea surface gradients (x,t) +! F F 8 5 ALPYT AYT Correl sea surface gradients (y,t) +! F F 8 6 ALPXY AXY Correl sea surface gradients (x,y) +! ------------------------------------------------- +! 9 Numerical diagnostics +! ------------------------------------------------- +! T T 9 1 DTDYN DTD Average time step in integration. +! T T 9 2 FCUT FC Cut-off frequency. +! T T 9 3 CFLXYMAX CFX Max. CFL number for spatial advection. +! T T 9 4 CFLTHMAX CFD Max. CFL number for theta-advection. +! F F 9 5 CFLKMAX CFK Max. CFL number for k-advection. +! ------------------------------------------------- +! 10 User defined +! ------------------------------------------------- +! F F 10 1 U1 User defined #1. (requires coding ...) +! F F 10 2 U2 User defined #1. (requires coding ...) +! ------------------------------------------------- +! +! Section 4 consist of a set of fields, index 0 = wind sea, index +! 1:NOSWLL are first NOSWLL swell fields. +! +! +! * output track file formatted (T) or unformated (F) +! +! * coupling fields exchanged list is : +! - Sent fields by ww3: +! - Ocean model : T0M1 OCHA OHS DIR BHD TWO UBR FOC TAW TUS USS LM DRY +! - Atmospheric model : ACHA AHS TP (or FP) FWS +! - Ice model : IC5 TWI +! - Received fields by ww3: +! - Ocean model : SSH CUR +! - Atmospheric model : WND +! - Ice model : ICE IC1 IC5 +! +! * namelist must be terminated with / +! * definitions & defaults: +! TYPE%FIELD%LIST = 'unset' +! TYPE%POINT%FILE = 'points.list' +! TYPE%TRACK%FORMAT = T +! TYPE%PARTITION%X0 = 0 +! TYPE%PARTITION%XN = 0 +! TYPE%PARTITION%NX = 0 +! TYPE%PARTITION%Y0 = 0 +! TYPE%PARTITION%YN = 0 +! TYPE%PARTITION%NY = 0 +! TYPE%PARTITION%FORMAT = T +! TYPE%COUPLING%SENT = 'unset' +! TYPE%COUPLING%RECEIVED = 'unset' +! +! -------------------------------------------------------------------- ! +&OUTPUT_TYPE_NML + TYPE%FIELD%LIST = 'WLV T02 DIR CUR HS T0M1 FP SXX SXY SYY DPT' + TYPE%POINT%FILE = '../input/points.list' +/ + +! -------------------------------------------------------------------- ! +! Define output dates via OUTPUT_DATE_NML namelist +! +! * start and stop times are with format 'yyyymmdd hhmmss' +! * if time stride is equal '0', then output is disabled +! * time stride is given in seconds +! +! * namelist must be terminated with / +! * definitions & defaults: +! DATE%FIELD%START = '19680606 000000' +! DATE%FIELD%STRIDE = '0' +! DATE%FIELD%STOP = '19680607 000000' +! DATE%POINT%START = '19680606 000000' +! DATE%POINT%STRIDE = '0' +! DATE%POINT%STOP = '19680607 000000' +! DATE%TRACK%START = '19680606 000000' +! DATE%TRACK%STRIDE = '0' +! DATE%TRACK%STOP = '19680607 000000' +! DATE%RESTART%START = '19680606 000000' +! DATE%RESTART%STRIDE = '0' +! DATE%RESTART%STOP = '19680607 000000' +! DATE%BOUNDARY%START = '19680606 000000' +! DATE%BOUNDARY%STRIDE = '0' +! DATE%BOUNDARY%STOP = '19680607 000000' +! DATE%PARTITION%START = '19680606 000000' +! DATE%PARTITION%STRIDE = '0' +! DATE%PARTITION%STOP = '19680607 000000' +! DATE%COUPLING%START = '19680606 000000' +! DATE%COUPLING%STRIDE = '0' +! DATE%COUPLING%STOP = '19680607 000000' +! +! DATE%RESTART = '19680606 000000' '0' '19680607 000000' +! -------------------------------------------------------------------- ! +&OUTPUT_DATE_NML + DATE%FIELD = '20180701 000000' '2' '20180701 010000' + DATE%POINT = '20180701 000000' '2' '20180701 010000' +/ + +! -------------------------------------------------------------------- ! +! Define homogeneous input via HOMOG_COUNT_NML and HOMOG_INPUT_NML namelist +! +! * the number of each homogeneous input is defined by HOMOG_COUNT +! * the total number of homogeneous input is automatically calculated +! * the homogeneous input must start from index 1 to N +! * if VALUE1 is equal 0, then the homogeneous input is desactivated +! * NAME can be IC1, IC2, IC3, IC4, IC5, MDN, MTH, MVS, LEV, CUR, WND, ICE, MOV +! * each homogeneous input is defined over a maximum of 3 values detailled below : +! - IC1 is defined by thickness +! - IC2 is defined by viscosity +! - IC3 is defined by density +! - IC4 is defined by modulus +! - IC5 is defined by floe diameter +! - MDN is defined by density +! - MTH is defined by thickness +! - MVS is defined by viscosity +! - LEV is defined by height +! - CUR is defined by speed and direction +! - WND is defined by speed, direction and airseatemp +! - ICE is defined by concentration +! - MOV is defined by speed and direction +! +! * namelist must be terminated with / +! * definitions & defaults: +! HOMOG_COUNT%N_IC1 = 0 +! HOMOG_COUNT%N_IC2 = 0 +! HOMOG_COUNT%N_IC3 = 0 +! HOMOG_COUNT%N_IC4 = 0 +! HOMOG_COUNT%N_IC5 = 0 +! HOMOG_COUNT%N_MDN = 0 +! HOMOG_COUNT%N_MTH = 0 +! HOMOG_COUNT%N_MVS = 0 +! HOMOG_COUNT%N_LEV = 0 +! HOMOG_COUNT%N_CUR = 0 +! HOMOG_COUNT%N_WND = 0 +! HOMOG_COUNT%N_ICE = 0 +! HOMOG_COUNT%N_MOV = 0 +! +! HOMOG_INPUT(I)%NAME = 'unset' +! HOMOG_INPUT(I)%DATE = '19680606 000000' +! HOMOG_INPUT(I)%VALUE1 = 0 +! HOMOG_INPUT(I)%VALUE2 = 0 +! HOMOG_INPUT(I)%VALUE3 = 0 +! -------------------------------------------------------------------- ! +&HOMOG_COUNT_NML +/ + +&HOMOG_INPUT_NML +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_tp2.19/input_Case1C/namelists_a.nml b/regtests/ww3_tp2.19/input_Case1C/namelists_a.nml new file mode 100644 index 000000000..8d34000c3 --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1C/namelists_a.nml @@ -0,0 +1,34 @@ +$ BAJ (adjusted) +$ +&SDB1 BJGAM = 0.64, BJALFA = 0.8 / +$ +&UNST +UGOBCAUTO = F +UGOBCDEPTH= -10. +EXPFSN = F, +EXPFSPSI = F, +EXPFSFCT = F, +IMPFSN = F, +IMPTOTAL = T, +IMPREFRACTION = T, +IMPFREQSHIFT = T, +IMPSOURCE = T, +SETUP_APPLY_WLV = F +SOLVERTHR_SETUP=1E-14 +CRIT_DEP_SETUP=0.1 +JGS_USE_JACOBI = T, +JGS_NLEVEL = 0 +JGS_SOURCE_NONLINEAR = F +JGS_BLOCK_GAUSS_SEIDEL = T, +JGS_TERMINATE_MAXITER = T, +JGS_MAXITER = 100000, +JGS_TERMINATE_NORM = F, +JGS_TERMINATE_DIFFERENCE = T, +JGS_DIFF_THR = 1.E-6, +JGS_PMIN = 3.0 +JGS_LIMITER = F, +JGS_BLOCK_GAUSS_SEIDEL = T +JGS_NORM_THR = 1.E-6 +/ + +END OF NAMELISTS diff --git a/regtests/ww3_tp2.19/input_Case1C/namelists_b.nml b/regtests/ww3_tp2.19/input_Case1C/namelists_b.nml new file mode 100644 index 000000000..961a829de --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1C/namelists_b.nml @@ -0,0 +1,33 @@ +$ +&SDB1 BJGAM = 0.42, BJALFA = 1.0, DBFLAG=2 / +$ +&UNST +UGOBCAUTO = F +UGOBCDEPTH= -10. +EXPFSN = F, +EXPFSPSI = F, +EXPFSFCT = F, +IMPFSN = F, +IMPTOTAL = T, +IMPREFRACTION = T, +IMPFREQSHIFT = T, +IMPSOURCE = T, +SETUP_APPLY_WLV = F +SOLVERTHR_SETUP=1E-14 +CRIT_DEP_SETUP=0.1 +JGS_USE_JACOBI = T, +JGS_NLEVEL = 0 +JGS_SOURCE_NONLINEAR = F +JGS_BLOCK_GAUSS_SEIDEL = T, +JGS_TERMINATE_MAXITER = T, +JGS_MAXITER = 100000, +JGS_TERMINATE_NORM = F, +JGS_TERMINATE_DIFFERENCE = T, +JGS_DIFF_THR = 1.E-6, +JGS_PMIN = 3.0 +JGS_LIMITER = F, +JGS_BLOCK_GAUSS_SEIDEL = T +JGS_NORM_THR = 1.E-6 +/ + +END OF NAMELISTS diff --git a/regtests/ww3_tp2.19/input_Case1C/spec.list b/regtests/ww3_tp2.19/input_Case1C/spec.list new file mode 100644 index 000000000..10061df24 --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1C/spec.list @@ -0,0 +1 @@ +../input/boundary1C.nc diff --git a/regtests/ww3_tp2.19/input_Case1C/switch_PDLIB b/regtests/ww3_tp2.19/input_Case1C/switch_PDLIB new file mode 100644 index 000000000..ec5c35288 --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1C/switch_PDLIB @@ -0,0 +1 @@ +F90 PDLIB METIS NOGRB NC4 DIST MPI PR3 UQ FLX0 LN0 ST0 NL0 BT0 DB1 TR1 BS0 IC0 IS0 REF0 XX0 WNT1 WNX1 CRT1 CRX1 SEC1 O0 O1 O2 O3 O4 O5 O6 O7 diff --git a/regtests/ww3_tp2.19/input_Case1C/ww3_bounc.inp b/regtests/ww3_tp2.19/input_Case1C/ww3_bounc.inp new file mode 100644 index 000000000..472d93898 --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1C/ww3_bounc.inp @@ -0,0 +1,25 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III NetCDF boundary input processing $ +$--------------------------------------------------------------------- $ +$ +$ Boundary option: READ or WRITE +$ + WRITE +$ +$ Interpolation method: 1: nearest +$ 2: linear interpolation + 2 +$ Verbose (0, 1, 2) +1 +$ +$ List of spectra files. These NetCDF files use the WAVEWATCH III +$ format as described in the ww3_ounp.inp file. The files are +$ defined relative to the directory in which the program is run. +$ +../input/boundary1C.nc +'STOPSTRING' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ + diff --git a/regtests/ww3_tp2.19/input_Case1C/ww3_bounc.nml b/regtests/ww3_tp2.19/input_Case1C/ww3_bounc.nml new file mode 100644 index 000000000..8cc003125 --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1C/ww3_bounc.nml @@ -0,0 +1,21 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III ww3_bounc.nml - Boundary input post-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the input boundaries to preprocess via BOUND_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! BOUND%MODE = 'WRITE' ! ['WRITE'|'READ'] +! BOUND%INTERP = 2 ! interpolation [1(nearest),2(linear)] +! BOUND%VERBOSE = 1 ! [0|1|2] +! BOUND%FILE = 'spec.list' ! input _spec.nc listing file +! -------------------------------------------------------------------- ! +&BOUND_NML + BOUND%FILE = '../input_Case1C/spec.list' +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_tp2.19/input_Case1C/ww3_grid.inp b/regtests/ww3_tp2.19/input_Case1C/ww3_grid.inp new file mode 100644 index 000000000..8c229430e --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1C/ww3_grid.inp @@ -0,0 +1,302 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Grid preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Grid name (C*30, in quotes) +$ + 'Flume ERDC' +$ +$ Frequency increment factor and first frequency (Hz) ---------------- $ +$ number of frequencies (wavenumbers) and directions, relative offset +$ of first direction in terms of the directional increment [-0.5,0.5]. +$ In versions 1.18 and 2.22 of the model this value was by definiton 0, +$ it is added to mitigate the GSE for a first order scheme. Note that +$ this factor is IGNORED in the print plots in ww3_outp. +$ +1.1 0.0398 46 360 0. +$ +$ Set model flags ---------------------------------------------------- $ +$ - FLDRY Dry run (input/output only, no calculation). +$ - FLCX, FLCY Activate X and Y component of propagation. +$ - FLCTH, FLCK Activate direction and wavenumber shifts. +$ - FLSOU Activate source terms. +$ + F T T F F T +$ +$ Set time steps ----------------------------------------------------- $ +$ - Time step information (this information is always read) +$ maximum global time step, maximum CFL time step for x-y and +$ k-theta, minimum source term time step (all in seconds). +$ +$ + 1 1 1 1 +$ +$ Start of namelist input section ------------------------------------ $ +$ Starting with WAVEWATCH III version 2.00, the tunable parameters +$ for source terms, propagation schemes, and numerics are read using +$ namelists. Any namelist found in the folowing sections up to the +$ end-of-section identifier string (see below) is temporarily written +$ to ww3_grid.scratch, and read from there if necessary. Namelists +$ not needed for the given switch settings will be skipped +$ automatically, and the order of the namelists is immaterial. +$ As an example, namelist input to change SWELLF and ZWND in the +$ Tolman and Chalikov input would be +$ +$ &SIN2 SWELLF = 0.1, ZWND = 15. / +$ +$ Define constants in source terms ----------------------------------- $ +$ +$ Input - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +$ WAM-3 : Namelist SIN1 +$ CINP : Proportionality constant. +$ &SIN1 CINP= 0.25 / +$ +$ Tolman and Chalikov : Namelist SIN2 +$ ZWND : Height of wind (m). +$ SWELLF : swell factor in (2.48). +$ STABSH, STABOF, CNEG, CPOS, FNEG : +$ c0, ST0, c1, c2 and f1 in . (2.63) +$ through (2.65) for definition of +$ effective wind speed (!/STAB2). +$ +$ Nonlinear interactions - - - - - - - - - - - - - - - - - - - - - - - +$ Discrete I.A. : Namelist SNL1 +$ LAMBDA : Lambda in source term. +$ NLPROP : C in sourc term. NOTE : default +$ value depends on other source +$ terms selected. +$ KDCONV : Factor before kd in Eq. (2.24). +$ KDMIN, SNLCS1, SNLCS2, SNLCS3 : +$ Minimum kd, and constants c1-3 +$ in depth scaling function. +$ Exact interactions : Namelist SNL2 +$ IQTYPE : Type of depth treatment +$ 1 : Deep water +$ 2 : Deep water / WAM scaling +$ 3 : Shallow water +$ TAILNL : Parametric tail power. +$ NDEPTH : Number of depths in for which +$ integration space is established. +$ Used for IQTYPE = 3 only +$ Namelist ANL2 +$ DEPTHS : Array with depths for NDEPTH = 3 +$ +$ Dissipation - - - - - - - - - - - - - - - - - - - - - - - - - - - - +$ WAM-3 : Namelist SDS1 +$ CDIS, APM : As in source term. +$ +$ Tolman and Chalikov : Namelist SDS2 +$ SDSA0, SDSA1, SDSA2, SDSB0, SDSB1, PHIMIN : +$ Constants a0, a1, a2, b0, b1 and +$ PHImin. +$ +$ BAJ (adjusted) +$ +&SDB1 BJGAM = 0.64, BJALFA = 0.8, DBFLAG = 1.0 / +$ +$ +&UNST +UGOBCAUTO = F +UGOBCDEPTH= -10. +EXPFSN = F, +EXPFSPSI = F, +EXPFSFCT = F, +IMPFSN = F, +IMPTOTAL = T, +IMPREFRACTION = T, +IMPFREQSHIFT = T, +IMPSOURCE = T, +SETUP_APPLY_WLV = F +SOLVERTHR_SETUP=1E-14 +CRIT_DEP_SETUP=0.1 +JGS_USE_JACOBI = T, +JGS_NLEVEL = 0 +JGS_SOURCE_NONLINEAR = F +JGS_BLOCK_GAUSS_SEIDEL = T, +JGS_TERMINATE_MAXITER = T, +JGS_MAXITER = 100000, +JGS_TERMINATE_NORM = F, +JGS_TERMINATE_DIFFERENCE = T, +JGS_DIFF_THR = 1.E-6, +JGS_PMIN = 3.0 +JGS_LIMITER = F, +JGS_BLOCK_GAUSS_SEIDEL = T +JGS_NORM_THR = 1.E-6 +/ +$ +$ +$ Bottom friction - - - - - - - - - - - - - - - - - - - - - - - - - - +$ JONSWAP : Namelist SBT1 +$ GAMMA : As it says. +$ &SBT1 GAMMA = 0.15 / +$ +$ Propagation schemes ------------------------------------------------ $ +$ First order : Namelist PRO1 +$ CFLTM : Maximum CFL number for refraction. +$ +$ UQ with diffusion : Namelist PRO2 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ DTIME : Swell age (s) in garden sprinkler +$ correction. If 0., all diffusion +$ switched off. If small non-zero +$ (DEFAULT !!!) only wave growth +$ diffusion. +$ LATMIN : Maximum latitude used in calc. of +$ strength of diffusion for prop. +$ +$ UQ with averaging : Namelist PRO3 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ WDTHCG : Tuning factor propag. direction. +$ WDTHTH : Tuning factor normal direction. +$ +$ UQ with divergence : Namelist PRO4 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ QTFAC : Tuning factor Eq. (3.41). +$ RSFAC : Tuning factor Eq. (3.42). +$ RNFAC : Tuning factor Eq. (3.43). +$ +$ Miscellaneous ------------------------------------------------------ $ +$ Misc. parameters : Namelist MISC +$ CICE0 : Ice concentration cut-off. +$ CICEN : Ice concentration cut-off. +$ XSEED : Xseed in seeding alg. (!/SEED). +$ FLAGTR : Indicating presence and type of +$ subgrid information : +$ 0 : No subgrid information. +$ 1 : Transparancies at cell boun- +$ daries between grid points. +$ 2 : Transp. at cell centers. +$ 3 : Like 1 with cont. ice. +$ 4 : Like 2 with cont. ice. +$ XP, XR, XFILT +$ Xp, Xr and Xf for the dynamic +$ integration scheme. +$ +$ In the 'Out of the box' test setup we run with sub-grid obstacles +$ and with continuous ice treatment. +$ +$ &MISC CICE0 = 0.25, CICEN = 0.75, FLAGTR = 4 / +$ +$ Mandatory string to identify end of namelist input section. +$ +END OF NAMELISTS +$ +$ Define grid -------------------------------------------------------- $ +$ + 'UNST' F 'NONE' +$ + 4.0 0.03 20 -1. 4 1 '(20f10.2)' 'NAME' '../input/Boers.msh' +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed). +$ +$ 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +$ +$ If sub-grid information is avalaible as indicated by FLAGTR above, +$ additional input to define this is needed below. In such cases a +$ field of fractional obstructions at or between grid points needs to +$ be supplied. First the location and format of the data is defined +$ by (as above) : +$ - Unit number of file (can be 10, and/or identical to bottem depth +$ unit), scale factor for fractional obstruction, IDLA, IDFM, +$ format for formatted read, FROM and filename +$ +$ 10 0.2 3 1 '(....)' 'NAME' 'obstr.inp' +$ +$ *** NOTE if this unit number is the same as the previous bottom +$ depth unit number, it is assumed that this is the same file +$ without further checks. *** +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed, +$ except between the two fields). +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 5 5 5 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ *** NOTE size of fields is always NX * NY *** +$ + 85 3 1 '(....)' 'PART' 'mapsta.inp' +$ Input boundary points ---------------------------------------------- $ +$ An unlimited number of lines identifying points at which input +$ boundary conditions are to be defined. If the actual input data is +$ not defined in the actual wave model run, the initial conditions +$ will be applied as constant boundary conditions. Each line contains: +$ Discrete grid counters (IX,IY) of the active point and a +$ connect flag. If this flag is true, and the present and previous +$ point are on a grid line or diagonal, all intermediate points +$ are also defined as boundary points. +$ +1 1 F +2 1 F +9 1 F +17 1 F +25 1 F +33 1 F +41 1 F +45 1 F +37 1 F +29 1 F +21 1 F +13 1 F +5 1 F +$ +$ Close list by defining point (0,0) (mandatory) +$ + 0 0 F +$ +$ +$ +$ Excluded grid points from segment data ( FROM != PART ) +$ First defined as lines, identical to the definition of the input +$ boundary points, and closed the same way. +$ + 0 0 F +$ +$ Second, define a point in a closed body of sea points to remove +$ the entire body os sea points. Also close by point (0,0) +$ + 0 0 +$ +$ Output boundary points --------------------------------------------- $ +$ Output boundary points are defined as a number of straight lines, +$ defined by its starting point (X0,Y0), increments (DX,DY) and number +$ of points. A negative number of points starts a new output file. +$ Note that this data is only generated if requested by the actual +$ program. Example again for spherical grid in degrees. +$ +$ -2.5312 48.5 0.00 0.008738 102 +$ -2.5312 49.3850 0.013554 0.00 51 +$ +$ Close list by defining line with 0 points (mandatory) +$ + 0. 0. 0. 0. 0 +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.19/input_Case1C/ww3_grid_a.inp b/regtests/ww3_tp2.19/input_Case1C/ww3_grid_a.inp new file mode 100644 index 000000000..d739d172a --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1C/ww3_grid_a.inp @@ -0,0 +1,302 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Grid preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Grid name (C*30, in quotes) +$ + 'Boers' +$ +$ Frequency increment factor and first frequency (Hz) ---------------- $ +$ number of frequencies (wavenumbers) and directions, relative offset +$ of first direction in terms of the directional increment [-0.5,0.5]. +$ In versions 1.18 and 2.22 of the model this value was by definiton 0, +$ it is added to mitigate the GSE for a first order scheme. Note that +$ this factor is IGNORED in the print plots in ww3_outp. +$ +1.1 0.0398 46 360 0. +$ +$ Set model flags ---------------------------------------------------- $ +$ - FLDRY Dry run (input/output only, no calculation). +$ - FLCX, FLCY Activate X and Y component of propagation. +$ - FLCTH, FLCK Activate direction and wavenumber shifts. +$ - FLSOU Activate source terms. +$ + F T T F F T +$ +$ Set time steps ----------------------------------------------------- $ +$ - Time step information (this information is always read) +$ maximum global time step, maximum CFL time step for x-y and +$ k-theta, minimum source term time step (all in seconds). +$ +$ + 2 2 2 2 +$ +$ Start of namelist input section ------------------------------------ $ +$ Starting with WAVEWATCH III version 2.00, the tunable parameters +$ for source terms, propagation schemes, and numerics are read using +$ namelists. Any namelist found in the folowing sections up to the +$ end-of-section identifier string (see below) is temporarily written +$ to ww3_grid.scratch, and read from there if necessary. Namelists +$ not needed for the given switch settings will be skipped +$ automatically, and the order of the namelists is immaterial. +$ As an example, namelist input to change SWELLF and ZWND in the +$ Tolman and Chalikov input would be +$ +$ &SIN2 SWELLF = 0.1, ZWND = 15. / +$ +$ Define constants in source terms ----------------------------------- $ +$ +$ Input - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +$ WAM-3 : Namelist SIN1 +$ CINP : Proportionality constant. +$ &SIN1 CINP= 0.25 / +$ +$ Tolman and Chalikov : Namelist SIN2 +$ ZWND : Height of wind (m). +$ SWELLF : swell factor in (2.48). +$ STABSH, STABOF, CNEG, CPOS, FNEG : +$ c0, ST0, c1, c2 and f1 in . (2.63) +$ through (2.65) for definition of +$ effective wind speed (!/STAB2). +$ +$ Nonlinear interactions - - - - - - - - - - - - - - - - - - - - - - - +$ Discrete I.A. : Namelist SNL1 +$ LAMBDA : Lambda in source term. +$ NLPROP : C in sourc term. NOTE : default +$ value depends on other source +$ terms selected. +$ KDCONV : Factor before kd in Eq. (2.24). +$ KDMIN, SNLCS1, SNLCS2, SNLCS3 : +$ Minimum kd, and constants c1-3 +$ in depth scaling function. +$ Exact interactions : Namelist SNL2 +$ IQTYPE : Type of depth treatment +$ 1 : Deep water +$ 2 : Deep water / WAM scaling +$ 3 : Shallow water +$ TAILNL : Parametric tail power. +$ NDEPTH : Number of depths in for which +$ integration space is established. +$ Used for IQTYPE = 3 only +$ Namelist ANL2 +$ DEPTHS : Array with depths for NDEPTH = 3 +$ +$ Dissipation - - - - - - - - - - - - - - - - - - - - - - - - - - - - +$ WAM-3 : Namelist SDS1 +$ CDIS, APM : As in source term. +$ +$ Tolman and Chalikov : Namelist SDS2 +$ SDSA0, SDSA1, SDSA2, SDSB0, SDSB1, PHIMIN : +$ Constants a0, a1, a2, b0, b1 and +$ PHImin. +$ +$ BAJ (adjusted) +$ +&SDB1 BJGAM = 0.64, BJALFA = 0.8 / +$ +$ +&UNST +UGOBCAUTO = F +UGOBCDEPTH= -10. +EXPFSN = F, +EXPFSPSI = F, +EXPFSFCT = F, +IMPFSN = F, +IMPTOTAL = T, +IMPREFRACTION = T, +IMPFREQSHIFT = T, +IMPSOURCE = T, +SETUP_APPLY_WLV = F +SOLVERTHR_SETUP=1E-14 +CRIT_DEP_SETUP=0.1 +JGS_USE_JACOBI = T, +JGS_NLEVEL = 0 +JGS_SOURCE_NONLINEAR = F +JGS_BLOCK_GAUSS_SEIDEL = T, +JGS_TERMINATE_MAXITER = T, +JGS_MAXITER = 100000, +JGS_TERMINATE_NORM = F, +JGS_TERMINATE_DIFFERENCE = T, +JGS_DIFF_THR = 1.E-6, +JGS_PMIN = 3.0 +JGS_LIMITER = F, +JGS_BLOCK_GAUSS_SEIDEL = T +JGS_NORM_THR = 1.E-6 +/ +$ +$ +$ Bottom friction - - - - - - - - - - - - - - - - - - - - - - - - - - +$ JONSWAP : Namelist SBT1 +$ GAMMA : As it says. +$ &SBT1 GAMMA = 0.15 / +$ +$ Propagation schemes ------------------------------------------------ $ +$ First order : Namelist PRO1 +$ CFLTM : Maximum CFL number for refraction. +$ +$ UQ with diffusion : Namelist PRO2 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ DTIME : Swell age (s) in garden sprinkler +$ correction. If 0., all diffusion +$ switched off. If small non-zero +$ (DEFAULT !!!) only wave growth +$ diffusion. +$ LATMIN : Maximum latitude used in calc. of +$ strength of diffusion for prop. +$ +$ UQ with averaging : Namelist PRO3 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ WDTHCG : Tuning factor propag. direction. +$ WDTHTH : Tuning factor normal direction. +$ +$ UQ with divergence : Namelist PRO4 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ QTFAC : Tuning factor Eq. (3.41). +$ RSFAC : Tuning factor Eq. (3.42). +$ RNFAC : Tuning factor Eq. (3.43). +$ +$ Miscellaneous ------------------------------------------------------ $ +$ Misc. parameters : Namelist MISC +$ CICE0 : Ice concentration cut-off. +$ CICEN : Ice concentration cut-off. +$ XSEED : Xseed in seeding alg. (!/SEED). +$ FLAGTR : Indicating presence and type of +$ subgrid information : +$ 0 : No subgrid information. +$ 1 : Transparancies at cell boun- +$ daries between grid points. +$ 2 : Transp. at cell centers. +$ 3 : Like 1 with cont. ice. +$ 4 : Like 2 with cont. ice. +$ XP, XR, XFILT +$ Xp, Xr and Xf for the dynamic +$ integration scheme. +$ +$ In the 'Out of the box' test setup we run with sub-grid obstacles +$ and with continuous ice treatment. +$ +$ &MISC CICE0 = 0.25, CICEN = 0.75, FLAGTR = 4 / +$ +$ Mandatory string to identify end of namelist input section. +$ +END OF NAMELISTS +$ +$ Define grid -------------------------------------------------------- $ +$ + 'UNST' F 'NONE' +$ + 4.0 0.03 20 -1. 4 1 '(20f10.2)' 'NAME' '../input/Boers.msh' +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed). +$ +$ 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +$ +$ If sub-grid information is avalaible as indicated by FLAGTR above, +$ additional input to define this is needed below. In such cases a +$ field of fractional obstructions at or between grid points needs to +$ be supplied. First the location and format of the data is defined +$ by (as above) : +$ - Unit number of file (can be 10, and/or identical to bottem depth +$ unit), scale factor for fractional obstruction, IDLA, IDFM, +$ format for formatted read, FROM and filename +$ +$ 10 0.2 3 1 '(....)' 'NAME' 'obstr.inp' +$ +$ *** NOTE if this unit number is the same as the previous bottom +$ depth unit number, it is assumed that this is the same file +$ without further checks. *** +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed, +$ except between the two fields). +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 5 5 5 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ *** NOTE size of fields is always NX * NY *** +$ + 85 3 1 '(....)' 'PART' 'mapsta.inp' +$ Input boundary points ---------------------------------------------- $ +$ An unlimited number of lines identifying points at which input +$ boundary conditions are to be defined. If the actual input data is +$ not defined in the actual wave model run, the initial conditions +$ will be applied as constant boundary conditions. Each line contains: +$ Discrete grid counters (IX,IY) of the active point and a +$ connect flag. If this flag is true, and the present and previous +$ point are on a grid line or diagonal, all intermediate points +$ are also defined as boundary points. +$ +1 1 F +2 1 F +9 1 F +17 1 F +25 1 F +33 1 F +41 1 F +45 1 F +37 1 F +29 1 F +21 1 F +13 1 F +5 1 F +$ +$ Close list by defining point (0,0) (mandatory) +$ + 0 0 F +$ +$ +$ +$ Excluded grid points from segment data ( FROM != PART ) +$ First defined as lines, identical to the definition of the input +$ boundary points, and closed the same way. +$ + 0 0 F +$ +$ Second, define a point in a closed body of sea points to remove +$ the entire body os sea points. Also close by point (0,0) +$ + 0 0 +$ +$ Output boundary points --------------------------------------------- $ +$ Output boundary points are defined as a number of straight lines, +$ defined by its starting point (X0,Y0), increments (DX,DY) and number +$ of points. A negative number of points starts a new output file. +$ Note that this data is only generated if requested by the actual +$ program. Example again for spherical grid in degrees. +$ +$ -2.5312 48.5 0.00 0.008738 102 +$ -2.5312 49.3850 0.013554 0.00 51 +$ +$ Close list by defining line with 0 points (mandatory) +$ + 0. 0. 0. 0. 0 +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.19/input_Case1C/ww3_grid_a.nml b/regtests/ww3_tp2.19/input_Case1C/ww3_grid_a.nml new file mode 100644 index 000000000..b184292b5 --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1C/ww3_grid_a.nml @@ -0,0 +1,265 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_grid.nml - Grid pre-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the spectrum parameterization via SPECTRUM_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! SPECTRUM%XFR = 0. ! frequency increment +! SPECTRUM%FREQ1 = 0. ! first frequency (Hz) +! SPECTRUM%NK = 0 ! number of frequencies (wavenumbers) +! SPECTRUM%NTH = 0 ! number of direction bins +! SPECTRUM%THOFF = 0. ! relative offset of first direction [-0.5,0.5] +! -------------------------------------------------------------------- ! +&SPECTRUM_NML + SPECTRUM%XFR = 1.10 + SPECTRUM%FREQ1 = 0.0398 + SPECTRUM%NK = 46 + SPECTRUM%NTH = 360 +/ + +! -------------------------------------------------------------------- ! +! Define the run parameterization via RUN_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! RUN%FLDRY = F ! dry run (I/O only, no calculation) +! RUN%FLCX = F ! x-component of propagation +! RUN%FLCY = F ! y-component of propagation +! RUN%FLCTH = F ! direction shift +! RUN%FLCK = F ! wavenumber shift +! RUN%FLSOU = F ! source terms +! -------------------------------------------------------------------- ! +&RUN_NML + RUN%FLCX = T + RUN%FLCY = T + RUN%FLSOU = T +/ + +! -------------------------------------------------------------------- ! +! Define the timesteps parameterization via TIMESTEPS_NML namelist +! +! * It is highly recommended to set up time steps which are multiple +! between them. +! +! * The first time step to calculate is the maximum CFL time step +! which depend on the lowest frequency FREQ1 previously set up and the +! lowest spatial grid resolution in meters DXY. +! reminder : 1 degree=60minutes // 1minute=1mile // 1mile=1.852km +! The formula for the CFL time is : +! Tcfl = DXY / (G / (FREQ1*4*Pi) ) with the constants Pi=3,14 and G=9.8m/s²; +! DTXY ~= 90% Tcfl +! DTMAX ~= 3 * DTXY (maximum global time step limit) +! +! * The refraction time step depends on how strong can be the current velocities +! on your grid : +! DTKTH ~= DTMAX / 2 ! in case of no or light current velocities +! DTKTH ~= DTMAX / 10 ! in case of strong current velocities +! +! * The source terms time step is usually defined between 5s and 60s. +! A common value is 10s. +! DTMIN ~= 10 +! +! * namelist must be terminated with / +! * definitions & defaults: +! TIMESTEPS%DTMAX = 0. ! maximum global time step (s) +! TIMESTEPS%DTXY = 0. ! maximum CFL time step for x-y (s) +! TIMESTEPS%DTKTH = 0. ! maximum CFL time step for k-th (s) +! TIMESTEPS%DTMIN = 0. ! minimum source term time step (s) +! -------------------------------------------------------------------- ! +&TIMESTEPS_NML + TIMESTEPS%DTMAX = 2. + TIMESTEPS%DTXY = 2. + TIMESTEPS%DTKTH = 2. + TIMESTEPS%DTMIN = 2. +/ + +! -------------------------------------------------------------------- ! +! Define the grid to preprocess via GRID_NML namelist +! +! * the tunable parameters for source terms, propagation schemes, and +! numerics are read using namelists. +! * Any namelist found in the folowing sections is temporarily written +! to param.scratch, and read from there if necessary. +! * The order of the namelists is immaterial. +! * Namelists not needed for the given switch settings will be skipped +! automatically +! +! * grid type can be : +! 'RECT' : rectilinear +! 'CURV' : curvilinear +! 'UNST' : unstructured (triangle-based) +! +! * coordinate system can be : +! 'SPHE' : Spherical (degrees) +! 'CART' : Cartesian (meters) +! +! * grid closure can only be applied in spherical coordinates +! +! * grid closure can be : +! 'NONE' : No closure is applied +! 'SMPL' : Simple grid closure. Grid is periodic in the +! : i-index and wraps at i=NX+1. In other words, +! : (NX+1,J) => (1,J). A grid with simple closure +! : may be rectilinear or curvilinear. +! 'TRPL' : Tripole grid closure : Grid is periodic in the +! : i-index and wraps at i=NX+1 and has closure at +! : j=NY+1. In other words, (NX+1,J<=NY) => (1,J) +! : and (I,NY+1) => (NX-I+1,NY). Tripole +! : grid closure requires that NX be even. A grid +! : with tripole closure must be curvilinear. +! +! * The coastline limit depth is the value which distinguish the sea +! points to the land points. All the points with depth values (ZBIN) +! greater than this limit (ZLIM) will be considered as excluded points +! and will never be wet points, even if the water level grows over. +! It can only overwrite the status of a sea point to a land point. +! The value must have a negative value under the mean sea level +! +! * The minimum water depth allowed to compute the model is the absolute +! depth value (DMIN) used in the model if the input depth is lower to +! avoid the model to blow up. +! +! * namelist must be terminated with / +! * definitions & defaults: +! GRID%NAME = 'unset' ! grid name (30 char) +! GRID%NML = 'namelists.nml' ! namelists filename +! GRID%TYPE = 'unset' ! grid type +! GRID%COORD = 'unset' ! coordinate system +! GRID%CLOS = 'unset' ! grid closure +! +! GRID%ZLIM = 0. ! coastline limit depth (m) +! GRID%DMIN = 0. ! abs. minimum water depth (m) +! -------------------------------------------------------------------- ! +&GRID_NML + GRID%NAME = 'Boers' + GRID%NML = '../input_Case1A/namelists_a.nml' + GRID%TYPE = 'UNST' + GRID%COORD = 'CART' + GRID%CLOS = 'F' + GRID%ZLIM = 4.0 + GRID%DMIN = 0.03 +/ + +! -------------------------------------------------------------------- ! +! Define the unstructured grid type via UNST_NML namelist +! - only for UNST grids - +! +! * The minimum grid size is 3x3. +! +! * &MISC namelist must be removed +! +! * The depth value must have negative values under the mean sea level +! +! * The map value must be set as : +! -2 : Excluded boundary point (covered by ice) +! -1 : Excluded sea point (covered by ice) +! 0 : Excluded land point +! 1 : Sea point +! 2 : Active boundary point +! 3 : Excluded grid point +! 7 : Ice point +! +! * the file must be a GMESH grid file containing node and element lists. +! +! * Extra open boundary list file with UGOBCFILE in namelist &UNST +! An example is given in regtest ww3_tp2.7 +! +! * value <= scale_fac * value_read +! +! * IDLA : Layout indicator : +! 1 : Read line-by-line bottom to top. (default) +! 2 : Like 1, single read statement. +! 3 : Read line-by-line top to bottom. +! 4 : Like 3, single read statement. +! * IDFM : format indicator : +! 1 : Free format. (default) +! 2 : Fixed format. +! 3 : Unformatted. +! * FORMAT : element format to read : +! '(....)' : auto detected (default) +! '(f10.6)' : float type +! +! * Example : +! IDF SF IDLA IDFM FORMAT FILENAME +! 20 -1. 4 2 '(20f10.2)' 'ngug.msh' +! +! * namelist must be terminated with / +! * definitions & defaults: +! UNST%SF = 1. ! unst scale factor +! UNST%FILENAME = 'unset' ! unst filename +! UNST%IDF = 20 ! unst file unit number +! UNST%IDLA = 1 ! unst layout indicator +! UNST%IDFM = 1 ! unst format indicator +! UNST%FORMAT = '(....)' ! unst formatted read format +! +! UNST%UGOBCFILE = 'unset' ! additional boundary list file +! -------------------------------------------------------------------- ! +&UNST_NML + UNST%SF = -1. + UNST%FILENAME = '../input/Boers.msh' + UNST%IDLA = 4 + UNST%FORMAT = '(20f10.2)' +/ + +! -------------------------------------------------------------------- ! +! Define the input boundary points via INBND_COUNT_NML and +! INBND_POINT_NML namelist +! - for RECT, CURV and UNST grids - +! +! * If no mask defined, INBOUND can be used +! +! * If the actual input data is not defined in the actual wave model run +! the initial conditions will be applied as constant boundary conditions. +! +! * The number of points is defined by INBND_COUNT +! +! * The points must start from index 1 to N +! +! * Each line contains: +! Discrete grid counters (IX,IY) of the active point and a +! connect flag. If this flag is true, and the present and previous +! point are on a grid line or diagonal, all intermediate points +! are also defined as boundary points. +! +! * Included point : +! grid points from segment data +! Defines as lines identifying points at which +! input boundary conditions are to be defined. +! +! * namelist must be terminated with / +! * definitions & defaults: +! INBND_COUNT%N_POINT = 0 ! number of segments +! +! INBND_POINT(I)%X_INDEX = 0 ! x index included point +! INBND_POINT(I)%Y_INDEX = 0 ! y index included point +! INBND_POINT(I)%CONNECT = F ! connect flag +! +! OR +! INBND_POINT(I) = 0 0 F ! included point +! -------------------------------------------------------------------- ! +&INBND_COUNT_NML + INBND_COUNT%N_POINT = 13 +/ + +&INBND_POINT_NML + INBND_POINT(1) = 1 1 F + INBND_POINT(2) = 2 1 F + INBND_POINT(3) = 9 1 F + INBND_POINT(4) = 17 1 F + INBND_POINT(5) = 25 1 F + INBND_POINT(6) = 33 1 F + INBND_POINT(7) = 41 1 F + INBND_POINT(8) = 45 1 F + INBND_POINT(9) = 37 1 F + INBND_POINT(10) = 29 1 F + INBND_POINT(11) = 21 1 F + INBND_POINT(12) = 13 1 F + INBND_POINT(13) = 5 1 F +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_tp2.19/input_Case1C/ww3_grid_b.inp b/regtests/ww3_tp2.19/input_Case1C/ww3_grid_b.inp new file mode 100644 index 000000000..245b7d56f --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1C/ww3_grid_b.inp @@ -0,0 +1,302 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Grid preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Grid name (C*30, in quotes) +$ + 'Flume ERDC' +$ +$ Frequency increment factor and first frequency (Hz) ---------------- $ +$ number of frequencies (wavenumbers) and directions, relative offset +$ of first direction in terms of the directional increment [-0.5,0.5]. +$ In versions 1.18 and 2.22 of the model this value was by definiton 0, +$ it is added to mitigate the GSE for a first order scheme. Note that +$ this factor is IGNORED in the print plots in ww3_outp. +$ +1.1 0.0398 46 360 0. +$ +$ Set model flags ---------------------------------------------------- $ +$ - FLDRY Dry run (input/output only, no calculation). +$ - FLCX, FLCY Activate X and Y component of propagation. +$ - FLCTH, FLCK Activate direction and wavenumber shifts. +$ - FLSOU Activate source terms. +$ + F T T F F T +$ +$ Set time steps ----------------------------------------------------- $ +$ - Time step information (this information is always read) +$ maximum global time step, maximum CFL time step for x-y and +$ k-theta, minimum source term time step (all in seconds). +$ +$ + 1 1 1 1 +$ +$ Start of namelist input section ------------------------------------ $ +$ Starting with WAVEWATCH III version 2.00, the tunable parameters +$ for source terms, propagation schemes, and numerics are read using +$ namelists. Any namelist found in the folowing sections up to the +$ end-of-section identifier string (see below) is temporarily written +$ to ww3_grid.scratch, and read from there if necessary. Namelists +$ not needed for the given switch settings will be skipped +$ automatically, and the order of the namelists is immaterial. +$ As an example, namelist input to change SWELLF and ZWND in the +$ Tolman and Chalikov input would be +$ +$ &SIN2 SWELLF = 0.1, ZWND = 15. / +$ +$ Define constants in source terms ----------------------------------- $ +$ +$ Input - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +$ WAM-3 : Namelist SIN1 +$ CINP : Proportionality constant. +$ &SIN1 CINP= 0.25 / +$ +$ Tolman and Chalikov : Namelist SIN2 +$ ZWND : Height of wind (m). +$ SWELLF : swell factor in (2.48). +$ STABSH, STABOF, CNEG, CPOS, FNEG : +$ c0, ST0, c1, c2 and f1 in . (2.63) +$ through (2.65) for definition of +$ effective wind speed (!/STAB2). +$ +$ Nonlinear interactions - - - - - - - - - - - - - - - - - - - - - - - +$ Discrete I.A. : Namelist SNL1 +$ LAMBDA : Lambda in source term. +$ NLPROP : C in sourc term. NOTE : default +$ value depends on other source +$ terms selected. +$ KDCONV : Factor before kd in Eq. (2.24). +$ KDMIN, SNLCS1, SNLCS2, SNLCS3 : +$ Minimum kd, and constants c1-3 +$ in depth scaling function. +$ Exact interactions : Namelist SNL2 +$ IQTYPE : Type of depth treatment +$ 1 : Deep water +$ 2 : Deep water / WAM scaling +$ 3 : Shallow water +$ TAILNL : Parametric tail power. +$ NDEPTH : Number of depths in for which +$ integration space is established. +$ Used for IQTYPE = 3 only +$ Namelist ANL2 +$ DEPTHS : Array with depths for NDEPTH = 3 +$ +$ Dissipation - - - - - - - - - - - - - - - - - - - - - - - - - - - - +$ WAM-3 : Namelist SDS1 +$ CDIS, APM : As in source term. +$ +$ Tolman and Chalikov : Namelist SDS2 +$ SDSA0, SDSA1, SDSA2, SDSB0, SDSB1, PHIMIN : +$ Constants a0, a1, a2, b0, b1 and +$ PHImin. +$ +$ BAJ (adjusted) +$ +&SDB1 BJGAM = 0.43, BJALFA = 1.0, DBFLAG = 2.0 / +$ +$ +&UNST +UGOBCAUTO = F +UGOBCDEPTH= -10. +EXPFSN = F, +EXPFSPSI = F, +EXPFSFCT = F, +IMPFSN = F, +IMPTOTAL = T, +IMPREFRACTION = T, +IMPFREQSHIFT = T, +IMPSOURCE = T, +SETUP_APPLY_WLV = F +SOLVERTHR_SETUP=1E-14 +CRIT_DEP_SETUP=0.1 +JGS_USE_JACOBI = T, +JGS_NLEVEL = 0 +JGS_SOURCE_NONLINEAR = F +JGS_BLOCK_GAUSS_SEIDEL = T, +JGS_TERMINATE_MAXITER = T, +JGS_MAXITER = 100000, +JGS_TERMINATE_NORM = F, +JGS_TERMINATE_DIFFERENCE = T, +JGS_DIFF_THR = 1.E-6, +JGS_PMIN = 3.0 +JGS_LIMITER = F, +JGS_BLOCK_GAUSS_SEIDEL = T +JGS_NORM_THR = 1.E-6 +/ +$ +$ +$ Bottom friction - - - - - - - - - - - - - - - - - - - - - - - - - - +$ JONSWAP : Namelist SBT1 +$ GAMMA : As it says. +$ &SBT1 GAMMA = 0.15 / +$ +$ Propagation schemes ------------------------------------------------ $ +$ First order : Namelist PRO1 +$ CFLTM : Maximum CFL number for refraction. +$ +$ UQ with diffusion : Namelist PRO2 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ DTIME : Swell age (s) in garden sprinkler +$ correction. If 0., all diffusion +$ switched off. If small non-zero +$ (DEFAULT !!!) only wave growth +$ diffusion. +$ LATMIN : Maximum latitude used in calc. of +$ strength of diffusion for prop. +$ +$ UQ with averaging : Namelist PRO3 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ WDTHCG : Tuning factor propag. direction. +$ WDTHTH : Tuning factor normal direction. +$ +$ UQ with divergence : Namelist PRO4 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ QTFAC : Tuning factor Eq. (3.41). +$ RSFAC : Tuning factor Eq. (3.42). +$ RNFAC : Tuning factor Eq. (3.43). +$ +$ Miscellaneous ------------------------------------------------------ $ +$ Misc. parameters : Namelist MISC +$ CICE0 : Ice concentration cut-off. +$ CICEN : Ice concentration cut-off. +$ XSEED : Xseed in seeding alg. (!/SEED). +$ FLAGTR : Indicating presence and type of +$ subgrid information : +$ 0 : No subgrid information. +$ 1 : Transparancies at cell boun- +$ daries between grid points. +$ 2 : Transp. at cell centers. +$ 3 : Like 1 with cont. ice. +$ 4 : Like 2 with cont. ice. +$ XP, XR, XFILT +$ Xp, Xr and Xf for the dynamic +$ integration scheme. +$ +$ In the 'Out of the box' test setup we run with sub-grid obstacles +$ and with continuous ice treatment. +$ +$ &MISC CICE0 = 0.25, CICEN = 0.75, FLAGTR = 4 / +$ +$ Mandatory string to identify end of namelist input section. +$ +END OF NAMELISTS +$ +$ Define grid -------------------------------------------------------- $ +$ + 'UNST' F 'NONE' +$ + 4.0 0.03 20 -1. 4 1 '(20f10.2)' 'NAME' '../input/Boers.msh' +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed). +$ +$ 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +$ +$ If sub-grid information is avalaible as indicated by FLAGTR above, +$ additional input to define this is needed below. In such cases a +$ field of fractional obstructions at or between grid points needs to +$ be supplied. First the location and format of the data is defined +$ by (as above) : +$ - Unit number of file (can be 10, and/or identical to bottem depth +$ unit), scale factor for fractional obstruction, IDLA, IDFM, +$ format for formatted read, FROM and filename +$ +$ 10 0.2 3 1 '(....)' 'NAME' 'obstr.inp' +$ +$ *** NOTE if this unit number is the same as the previous bottom +$ depth unit number, it is assumed that this is the same file +$ without further checks. *** +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed, +$ except between the two fields). +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 5 5 5 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ *** NOTE size of fields is always NX * NY *** +$ + 85 3 1 '(....)' 'PART' 'mapsta.inp' +$ Input boundary points ---------------------------------------------- $ +$ An unlimited number of lines identifying points at which input +$ boundary conditions are to be defined. If the actual input data is +$ not defined in the actual wave model run, the initial conditions +$ will be applied as constant boundary conditions. Each line contains: +$ Discrete grid counters (IX,IY) of the active point and a +$ connect flag. If this flag is true, and the present and previous +$ point are on a grid line or diagonal, all intermediate points +$ are also defined as boundary points. +$ +1 1 F +2 1 F +9 1 F +17 1 F +25 1 F +33 1 F +41 1 F +45 1 F +37 1 F +29 1 F +21 1 F +13 1 F +5 1 F +$ +$ Close list by defining point (0,0) (mandatory) +$ + 0 0 F +$ +$ +$ +$ Excluded grid points from segment data ( FROM != PART ) +$ First defined as lines, identical to the definition of the input +$ boundary points, and closed the same way. +$ + 0 0 F +$ +$ Second, define a point in a closed body of sea points to remove +$ the entire body os sea points. Also close by point (0,0) +$ + 0 0 +$ +$ Output boundary points --------------------------------------------- $ +$ Output boundary points are defined as a number of straight lines, +$ defined by its starting point (X0,Y0), increments (DX,DY) and number +$ of points. A negative number of points starts a new output file. +$ Note that this data is only generated if requested by the actual +$ program. Example again for spherical grid in degrees. +$ +$ -2.5312 48.5 0.00 0.008738 102 +$ -2.5312 49.3850 0.013554 0.00 51 +$ +$ Close list by defining line with 0 points (mandatory) +$ + 0. 0. 0. 0. 0 +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.19/input_Case1C/ww3_grid_b.nml b/regtests/ww3_tp2.19/input_Case1C/ww3_grid_b.nml new file mode 100644 index 000000000..67bb07eff --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1C/ww3_grid_b.nml @@ -0,0 +1,265 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_grid.nml - Grid pre-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the spectrum parameterization via SPECTRUM_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! SPECTRUM%XFR = 0. ! frequency increment +! SPECTRUM%FREQ1 = 0. ! first frequency (Hz) +! SPECTRUM%NK = 0 ! number of frequencies (wavenumbers) +! SPECTRUM%NTH = 0 ! number of direction bins +! SPECTRUM%THOFF = 0. ! relative offset of first direction [-0.5,0.5] +! -------------------------------------------------------------------- ! +&SPECTRUM_NML + SPECTRUM%XFR = 1.10 + SPECTRUM%FREQ1 = 0.0398 + SPECTRUM%NK = 46 + SPECTRUM%NTH = 360 +/ + +! -------------------------------------------------------------------- ! +! Define the run parameterization via RUN_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! RUN%FLDRY = F ! dry run (I/O only, no calculation) +! RUN%FLCX = F ! x-component of propagation +! RUN%FLCY = F ! y-component of propagation +! RUN%FLCTH = F ! direction shift +! RUN%FLCK = F ! wavenumber shift +! RUN%FLSOU = F ! source terms +! -------------------------------------------------------------------- ! +&RUN_NML + RUN%FLCX = T + RUN%FLCY = T + RUN%FLSOU = T +/ + +! -------------------------------------------------------------------- ! +! Define the timesteps parameterization via TIMESTEPS_NML namelist +! +! * It is highly recommended to set up time steps which are multiple +! between them. +! +! * The first time step to calculate is the maximum CFL time step +! which depend on the lowest frequency FREQ1 previously set up and the +! lowest spatial grid resolution in meters DXY. +! reminder : 1 degree=60minutes // 1minute=1mile // 1mile=1.852km +! The formula for the CFL time is : +! Tcfl = DXY / (G / (FREQ1*4*Pi) ) with the constants Pi=3,14 and G=9.8m/s²; +! DTXY ~= 90% Tcfl +! DTMAX ~= 3 * DTXY (maximum global time step limit) +! +! * The refraction time step depends on how strong can be the current velocities +! on your grid : +! DTKTH ~= DTMAX / 2 ! in case of no or light current velocities +! DTKTH ~= DTMAX / 10 ! in case of strong current velocities +! +! * The source terms time step is usually defined between 5s and 60s. +! A common value is 10s. +! DTMIN ~= 10 +! +! * namelist must be terminated with / +! * definitions & defaults: +! TIMESTEPS%DTMAX = 0. ! maximum global time step (s) +! TIMESTEPS%DTXY = 0. ! maximum CFL time step for x-y (s) +! TIMESTEPS%DTKTH = 0. ! maximum CFL time step for k-th (s) +! TIMESTEPS%DTMIN = 0. ! minimum source term time step (s) +! -------------------------------------------------------------------- ! +&TIMESTEPS_NML + TIMESTEPS%DTMAX = 1. + TIMESTEPS%DTXY = 1. + TIMESTEPS%DTKTH = 1. + TIMESTEPS%DTMIN = 1. +/ + +! -------------------------------------------------------------------- ! +! Define the grid to preprocess via GRID_NML namelist +! +! * the tunable parameters for source terms, propagation schemes, and +! numerics are read using namelists. +! * Any namelist found in the folowing sections is temporarily written +! to param.scratch, and read from there if necessary. +! * The order of the namelists is immaterial. +! * Namelists not needed for the given switch settings will be skipped +! automatically +! +! * grid type can be : +! 'RECT' : rectilinear +! 'CURV' : curvilinear +! 'UNST' : unstructured (triangle-based) +! +! * coordinate system can be : +! 'SPHE' : Spherical (degrees) +! 'CART' : Cartesian (meters) +! +! * grid closure can only be applied in spherical coordinates +! +! * grid closure can be : +! 'NONE' : No closure is applied +! 'SMPL' : Simple grid closure. Grid is periodic in the +! : i-index and wraps at i=NX+1. In other words, +! : (NX+1,J) => (1,J). A grid with simple closure +! : may be rectilinear or curvilinear. +! 'TRPL' : Tripole grid closure : Grid is periodic in the +! : i-index and wraps at i=NX+1 and has closure at +! : j=NY+1. In other words, (NX+1,J<=NY) => (1,J) +! : and (I,NY+1) => (NX-I+1,NY). Tripole +! : grid closure requires that NX be even. A grid +! : with tripole closure must be curvilinear. +! +! * The coastline limit depth is the value which distinguish the sea +! points to the land points. All the points with depth values (ZBIN) +! greater than this limit (ZLIM) will be considered as excluded points +! and will never be wet points, even if the water level grows over. +! It can only overwrite the status of a sea point to a land point. +! The value must have a negative value under the mean sea level +! +! * The minimum water depth allowed to compute the model is the absolute +! depth value (DMIN) used in the model if the input depth is lower to +! avoid the model to blow up. +! +! * namelist must be terminated with / +! * definitions & defaults: +! GRID%NAME = 'unset' ! grid name (30 char) +! GRID%NML = 'namelists.nml' ! namelists filename +! GRID%TYPE = 'unset' ! grid type +! GRID%COORD = 'unset' ! coordinate system +! GRID%CLOS = 'unset' ! grid closure +! +! GRID%ZLIM = 0. ! coastline limit depth (m) +! GRID%DMIN = 0. ! abs. minimum water depth (m) +! -------------------------------------------------------------------- ! +&GRID_NML + GRID%NAME = 'Boers' + GRID%NML = '../input_Case1A/namelists_b.nml' + GRID%TYPE = 'UNST' + GRID%COORD = 'CART' + GRID%CLOS = 'F' + GRID%ZLIM = 4.0 + GRID%DMIN = 0.03 +/ + +! -------------------------------------------------------------------- ! +! Define the unstructured grid type via UNST_NML namelist +! - only for UNST grids - +! +! * The minimum grid size is 3x3. +! +! * &MISC namelist must be removed +! +! * The depth value must have negative values under the mean sea level +! +! * The map value must be set as : +! -2 : Excluded boundary point (covered by ice) +! -1 : Excluded sea point (covered by ice) +! 0 : Excluded land point +! 1 : Sea point +! 2 : Active boundary point +! 3 : Excluded grid point +! 7 : Ice point +! +! * the file must be a GMESH grid file containing node and element lists. +! +! * Extra open boundary list file with UGOBCFILE in namelist &UNST +! An example is given in regtest ww3_tp2.7 +! +! * value <= scale_fac * value_read +! +! * IDLA : Layout indicator : +! 1 : Read line-by-line bottom to top. (default) +! 2 : Like 1, single read statement. +! 3 : Read line-by-line top to bottom. +! 4 : Like 3, single read statement. +! * IDFM : format indicator : +! 1 : Free format. (default) +! 2 : Fixed format. +! 3 : Unformatted. +! * FORMAT : element format to read : +! '(....)' : auto detected (default) +! '(f10.6)' : float type +! +! * Example : +! IDF SF IDLA IDFM FORMAT FILENAME +! 20 -1. 4 2 '(20f10.2)' 'ngug.msh' +! +! * namelist must be terminated with / +! * definitions & defaults: +! UNST%SF = 1. ! unst scale factor +! UNST%FILENAME = 'unset' ! unst filename +! UNST%IDF = 20 ! unst file unit number +! UNST%IDLA = 1 ! unst layout indicator +! UNST%IDFM = 1 ! unst format indicator +! UNST%FORMAT = '(....)' ! unst formatted read format +! +! UNST%UGOBCFILE = 'unset' ! additional boundary list file +! -------------------------------------------------------------------- ! +&UNST_NML + UNST%SF = -1. + UNST%FILENAME = '../input/Boers.msh' + UNST%IDLA = 4 + UNST%FORMAT = '(20f10.2)' +/ + +! -------------------------------------------------------------------- ! +! Define the input boundary points via INBND_COUNT_NML and +! INBND_POINT_NML namelist +! - for RECT, CURV and UNST grids - +! +! * If no mask defined, INBOUND can be used +! +! * If the actual input data is not defined in the actual wave model run +! the initial conditions will be applied as constant boundary conditions. +! +! * The number of points is defined by INBND_COUNT +! +! * The points must start from index 1 to N +! +! * Each line contains: +! Discrete grid counters (IX,IY) of the active point and a +! connect flag. If this flag is true, and the present and previous +! point are on a grid line or diagonal, all intermediate points +! are also defined as boundary points. +! +! * Included point : +! grid points from segment data +! Defines as lines identifying points at which +! input boundary conditions are to be defined. +! +! * namelist must be terminated with / +! * definitions & defaults: +! INBND_COUNT%N_POINT = 0 ! number of segments +! +! INBND_POINT(I)%X_INDEX = 0 ! x index included point +! INBND_POINT(I)%Y_INDEX = 0 ! y index included point +! INBND_POINT(I)%CONNECT = F ! connect flag +! +! OR +! INBND_POINT(I) = 0 0 F ! included point +! -------------------------------------------------------------------- ! +&INBND_COUNT_NML + INBND_COUNT%N_POINT = 13 +/ + +&INBND_POINT_NML + INBND_POINT(1) = 1 1 F + INBND_POINT(2) = 2 1 F + INBND_POINT(3) = 9 1 F + INBND_POINT(4) = 17 1 F + INBND_POINT(5) = 25 1 F + INBND_POINT(6) = 33 1 F + INBND_POINT(7) = 41 1 F + INBND_POINT(8) = 45 1 F + INBND_POINT(9) = 37 1 F + INBND_POINT(10) = 29 1 F + INBND_POINT(11) = 21 1 F + INBND_POINT(12) = 13 1 F + INBND_POINT(13) = 5 1 F +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_tp2.19/input_Case1C/ww3_ounf.inp b/regtests/ww3_tp2.19/input_Case1C/ww3_ounf.inp new file mode 100644 index 000000000..9593f72eb --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1C/ww3_ounf.inp @@ -0,0 +1,82 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Grid output post-processing $ +$--------------------------------------------------------------------- $ +$ Time, time increment and number of outputs (set to 4 days) +$ + 20180701 000000 1. 9999 +$ +$ Fields requested --------------------------------------------------- $ +$ +$ Output request flags identifying fields as in ww3_shel.inp. See that +$ file for a full documentation of field output options. Namelist type +$ selection is used here (for alternative F/T flags, see ww3_shel.inp). +$ +$ DPT CUR WND AST WLV ICE IBG D50 IC1 IC5 HS LM T02 T0M1 T01 FP DIR SPR +$ DP HIG EF TH1M STH1M TH2M STH2M WN PHS PTP PLP PDIR PSPR PWS TWS PNR +$ UST CHA CGE FAW TAW TWA WCC WCF WCH WCM SXY TWO BHD FOC TUS USS P2S +$ USF P2L TWI FIC ABR UBR BED FBB TBB MSS MSC DTD FC CFX CFD CFK U1 U2 +$ + N +WLV DPT T02 DIR CUR HS T0M1 FP SXX SXY SYY +$--------------------------------------------------------------------- $ +$ netCDF version [3,4] +$ and variable type 4 [2 = SHORT, 3 = it depends , 4 = REAL] +$ swell partitions [0 1 2 3 4 5] +$ variables in same file [T] or not [F] +$ + 4 4 + 0 1 2 + F +$ -------------------------------------------------------------------- $ +$ ITYPE = 0, inventory of file. +$ No additional input, the above time range is ignored. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 1, print plots. +$ IX,IY range and stride, flag for automatic scaling to +$ maximum value (otherwise fixed scaling), +$ vector component flag (dummy for scalar quantities). +$ +$ 1 12 1 1 12 1 F T +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 2, field statistics. +$ IX,IY range. +$ +$ 1 12 1 12 +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 3, transfer files. +$ IX, IY range, IDLA and IDFM as in ww3_grid.inp. +$ The additional option IDLA=5 gives ia longitude, lattitude +$ and parameter value(s) per record (defined points only). +$ +$1 12518 1 1 3 2 +$ +$ For each field and time a new file is generated with the file name +$ ww3.yymmddhh.xxx, where yymmddhh is a conventional time idicator, +$ and xxx is a field identifier. The first record of the file contains +$ a file ID (C*13), the time in yyyymmdd hhmmss format, the lowest, +$ highest and number of longitudes (2R,I), id. latitudes, the file +$ extension name (C*$), a scale factor (R), a unit identifier (C*10), +$ IDLA, IDFM, a format (C*11) and a number identifying undefined or +$ missing values (land, ice, etc.). The field follows as defined by +$ IDFM and IDLA, defined as in the grid proprocessor. IDLA=5 is added +$ and gives a set of records containing the longitude, latitude and +$ parameter value. Note that the actual data is written as an integers. +$ -------------------------------------------------------------------- $ +$ ITYPE = 4, Netcdf Files +$ S3: number of characters in date +$ IX, IY range +$ +ww3. +6 + 1 999999999 1 1 3 2 +$ For each field and time a new file is generated with the file name +$ ww3.date_xxx.nc , where date is a conventional time idicator with S3 +$ characters, +$ and xxx is a field identifier. +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.19/input_Case1C/ww3_ounf.nml b/regtests/ww3_tp2.19/input_Case1C/ww3_ounf.nml new file mode 100644 index 000000000..46d827bfe --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1C/ww3_ounf.nml @@ -0,0 +1,87 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_ounf.nml - Grid output post-processing ! +! -------------------------------------------------------------------- ! +! -------------------------------------------------------------------- ! +! Define the output fields to postprocess via FIELD_NML namelist +! +! * the detailed list of field names FIELD%LIST is given in ww3_shel.nml +! DPT CUR WND AST WLV ICE IBG D50 IC1 IC5 +! HS LM T02 T0M1 T01 FP DIR SPR DP HIG +! EF TH1M STH1M TH2M STH2M WN +! PHS PTP PLP PDIR PSPR PWS PDP PQP PPE PGW PSW PTM10 PT01 PT02 PEP TWS PNR +! UST CHA CGE FAW TAW TWA WCC WCF WCH WCM FWS +! SXY TWO BHD FOC TUS USS P2S USF P2L TWI FIC +! ABR UBR BED FBB TBB +! MSS MSC WL02 AXT AYT AXY +! DTD FC CFX CFD CFK +! U1 U2 +! +! * namelist must be terminated with / +! * definitions & defaults: +! FIELD%TIMESTART = '19000101 000000' ! Stop date for the output field +! FIELD%TIMESTRIDE = '0' ! Time stride for the output field +! FIELD%TIMECOUNT = '1000000000' ! Number of time steps +! FIELD%TIMESPLIT = 6 ! [0(nodate),4(yearly),6(monthly),8(daily),10(hourly)] +! FIELD%LIST = 'unset' ! List of output fields +! FIELD%PARTITION = '0 1 2 3' ! List of wave partitions ['0 1 2 3 4 5'] +! FIELD%SAMEFILE = T ! All the variables in the same file +! FIELD%TYPE = 3 ! [2 = SHORT, 3 = it depends , 4 = REAL] +! -------------------------------------------------------------------- ! +&FIELD_NML + FIELD%TIMESTART = '20180701 000000' + FIELD%TIMESTRIDE = '1' + FIELD%LIST = 'WLV DPT T02 DIR CUR HS T0M1 FP SXX SXY SYY' + FIELD%SAMEFILE = F + FIELD%TYPE = 4 +/ + + +! -------------------------------------------------------------------- ! +! Define the content of the output file via FILE_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! FILE%PREFIX = 'ww3.' ! Prefix for output file name +! FILE%NETCDF = 3 ! Netcdf version [3|4] +! FILE%IX0 = 1 ! First X-axis or node index +! FILE%IXN = 1000000000 ! Last X-axis or node index +! FILE%IY0 = 1 ! First Y-axis index +! FILE%IYN = 1000000000 ! Last Y-axis index +! -------------------------------------------------------------------- ! +&FILE_NML + FILE%NETCDF = 4 +/ + +! -------------------------------------------------------------------- ! +! Define the content of the output file via SMC_NML namelist +! +! * For SMC grids, IX0, IXN, IY0 and IYN from FILE_NML are not used. +! Two types of output are available: +! * TYPE=1: Flat 1D "seapoint" array of grid cells. +! * TYPE=2: Re-gridded regular grid with cell sizes being an integer +! * multiple of the smallest SMC grid cells size. +! +! * Note that the first/last longitudes and latitudes will be adjusted +! to snap to the underlying SMC grid edges. CELFAC is only used for +! type 2 output and defines the output cell sizes as an integer +! multiple of the smallest SMC Grid cell size. CELFAC should be a +! power of 2, e.g: 1,2,4,8,16, etc... +! +! * namelist must be terminated with / +! * definitions & defaults: +! SMC%TYPE = 1 ! SMC Grid type (1 or 2) +! SMC%SXO = -999.9 ! First longitude +! SMC%EXO = -999.9 ! Last longitude +! SMC%SYO = -999.9 ! First latitude +! SMC%EYO = -999.9 ! Last latitude +! SMC%CELFAC = 1 ! Cell size factor (SMCTYPE=2 only) +! SMC%NOVAL = UNDEF ! Fill value for wet cells with no data +! -------------------------------------------------------------------- ! +&SMC_NML +/ + + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! + diff --git a/regtests/ww3_tp2.19/input_Case1C/ww3_ounp.inp b/regtests/ww3_tp2.19/input_Case1C/ww3_ounp.inp new file mode 100644 index 000000000..c20417ad4 --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1C/ww3_ounp.inp @@ -0,0 +1,119 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III NETCDF Point output post-processing $ +$--------------------------------------------------------------------- $ +$ First output time (yyyymmdd hhmmss), increment of output (s), +$ and number of output times. +$ + 20180701 000000 1. 1000 +$ +$ Points requested --------------------------------------------------- $ +$ +$ Define points index for which output is to be generated. +$ If no one defined, all points are selected +$ One index number per line, negative number identifies end of list. +$ 1 +$ 2 +$ mandatory end of list + -1 +$ +$--------------------------------------------------------------------- $ +$ file prefix +$ number of characters in date [4(yearly),6(monthly),8(daily),10(hourly)] +$ netCDF version [3,4] +$ points in same file [T] or not [F] +$ and max number of points to be processed in one pass +$ output type ITYPE [0,1,2,3] +$ flag for global attributes WW3 [0] or variable version [1-2-3-4] +$ flag for dimensions order time,station [T] or station,time [F] +$ + ww3. + 6 + 4 + T 150 + 1 + 0 + T +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 0, inventory of file. +$ No additional input, the above time range is ignored. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 1, netCDF Spectra. +$ - Sub-type OTYPE : 1 : Print plots. +$ 2 : Table of 1-D spectra +$ 3 : Transfer file. +$ 4 : Spectral partitioning. +$ - Scaling factors for 1-D and 2-D spectra Negative factor +$ disables, output, factor = 0. gives normalized spectrum. +$ - Netcdf variable type [2=SHORT, 3=it depends, 4=REAL] +$ + 3 1 0 4 +$ +$ The transfer file contains records with the following contents. +$ +$ - File ID in quotes, number of frequencies, directions and points. +$ grid name in quotes (for unformatted file C*21,3I,C*30). +$ - Bin frequencies in Hz for all bins. +$ - Bin directions in radians for all bins (Oceanographic conv.). +$ -+ +$ - Time in yyyymmdd hhmmss format | loop +$ -+ | +$ - Point name (C*40), lat, lon, d, U10 and | loop | over +$ direction, current speed and direction | over | +$ - E(f,theta) | points | times +$ -+ -+ +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 2, netCDF Tables of (mean) parameter +$ - Sub-type OTYPE : 1 : Depth, current, wind +$ 2 : Mean wave pars. +$ 3 : Nondimensional pars. (U*) +$ 4 : Nondimensional pars. (U10) +$ 5 : 'Validation table' +$ 6 : WMO standard output +$ 4 +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 3, netCDF Source terms +$ - Sub-type OTYPE : 1 : Print plots. +$ 2 : Table of 1-D S(f). +$ 3 : Table of 1-D inverse time scales +$ (1/T = S/F). +$ 4 : Transfer file +$ - Scaling factors for 1-D and 2-D source terms. Negative +$ factor disables print plots, factor = 0. gives normalized +$ print plots. +$ - Flags for spectrum, input, interactions, dissipation, +$ bottom, ice and total source term. +$ - scale ISCALE for OTYPE=2,3 +$ 0 : Dimensional. +$ 1 : Nondimensional in terms of U10 +$ 2 : Nondimensional in terms of U* +$ 3-5: like 0-2 with f normalized with fp. +$ +$ 4 0 0 T T T T T T T 0 +$ +$ The transfer file contains records with the following contents. +$ +$ - File ID in quotes, number of frequencies, directions and points, +$ flags for spectrum and source terms (C*21, 3I, 6L) +$ - Bin frequencies in Hz for all bins. +$ - Bin directions in radians for all bins (Oceanographic conv.). +$ -+ +$ - Time in yyyymmdd hhmmss format | loop +$ -+ | +$ - Point name (C*40), depth, wind speed and | loop | over +$ direction, current speed and direction | over | +$ - E(f,theta) if requested | points | times +$ - Sin(f,theta) if requested | | +$ - Snl(f,theta) if requested | | +$ - Sds(f,theta) if requested | | +$ - Sbt(f,theta) if requested | | +$ - Sice(f,theta) if requested | | +$ - Stot(f,theta) if requested | | +$ -+ -+ +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.19/input_Case1C/ww3_ounp.nml b/regtests/ww3_tp2.19/input_Case1C/ww3_ounp.nml new file mode 100644 index 000000000..44807228a --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1C/ww3_ounp.nml @@ -0,0 +1,193 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_ounp.nml - Point output post-processing ! +! -------------------------------------------------------------------- ! + + +! -------------------------------------------------------------------- ! +! Define the output fields to postprocess via POINT_NML namelist +! +! +! * namelist must be terminated with / +! * definitions & defaults: +! POINT%TIMESTART = '19000101 000000' ! Stop date for the output field +! POINT%TIMESTRIDE = '0' ! Time stride for the output field +! POINT%TIMECOUNT = '1000000000' ! Number of time steps +! POINT%TIMESPLIT = 6 ! [4(yearly),6(monthly),8(daily),10(hourly)] +! POINT%LIST = 'all' ! List of points index ['all'|'1 2 3'] +! POINT%SAMEFILE = T ! All the points in the same file +! POINT%BUFFER = 150 ! Number of points to process per pass +! POINT%TYPE = 1 ! [0=inventory | 1=spectra | 2=mean param | 3=source terms] +! POINT%DIMORDER = T ! [time,station=T | station,time=F] +! -------------------------------------------------------------------- ! +&POINT_NML + POINT%TIMESTART = '20180701 000000' + POINT%TIMESTRIDE = '1' +/ + + +! -------------------------------------------------------------------- ! +! Define the content of the output file via FILE_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! FILE%PREFIX = 'ww3.' ! Prefix for output file name +! FILE%NETCDF = 3 ! Netcdf version [3|4] +! -------------------------------------------------------------------- ! +&FILE_NML + FILE%NETCDF = 4 +/ + + +! -------------------------------------------------------------------- ! +! Define the type 0, inventory of file +! +! * namelist must be terminated with / +! * definitions & defaults: +! No additional input, the above time range is ignored. +! -------------------------------------------------------------------- ! + + + +! -------------------------------------------------------------------- ! +! Define the type 1, spectra via SPECTRA_NML namelist +! +! Table of 1-D spectra content : +! - time, station id, station name, longitude, latitude +! - frequency : unit Hz, center band frequency - linear log scale (XFR factor) +! - ffp, f, th1m, sth1m, alpha : 1D spectral parameters +! - dpt, ust, wnd, wnddir : mean parameters +! +! Transfert file content : +! - time, station id, station name, longitude, latitude +! - frequency : unit Hz, center band frequency - linear log scale (XFR factor) +! - frequency1 : unit Hz, lower band frequency +! - frequency2 : unit Hz, upper band frequency +! - direction : unit degree, convention to, origin East, trigonometric order +! - efth(time,station,frequency,direction) : 2D spectral density +! - dpt, wnd, wnddir, cur, curdir : mean parameters +! +! Spectral partitioning content : +! - time, station id, station name, longitude, latitude +! - npart : number of partitions +! - hs, tp, lm, th1m, sth1m, ws, tm10, t01, t02 : partitioned parameters +! - dpt, wnd, wnddir, cur, curdir : mean parameters +! +! +! * namelist must be terminated with / +! * definitions & defaults: +! SPECTRA%OUTPUT = 3 ! 1: Print plots +! ! 2: Table of 1-D spectra +! ! 3: Transfer file +! ! 4: Spectral partitioning +! SPECTRA%SCALE_FAC = 1 ! Scale factor (-1=disabled) +! SPECTRA%OUTPUT_FAC = 0 ! Output factor (0=normalized) +! -------------------------------------------------------------------- ! +&SPECTRA_NML +/ + + +! -------------------------------------------------------------------- ! +! Define the type 2, mean parameter via PARAM_NML namelist +! +! Forcing parameters content : +! - dpt, wnd, wnddir, cur, curdir +! +! Mean wave parameters content : +! - hs, lm, tr, th1p, sth1p, fp, th1m, sth1m +! +! Nondimensional parameters (U*) content : +! - ust, efst, fpst, cd, alpha +! +! Nondimensional parameters (U10) content : +! - wnd, efst, fpst, cd, alpha +! +! Validation table content : +! - wnd, wnddir, hs, hsst, cpu, cmu, ast +! +! WMO stantdard output content : +! - wnd, wnddir, hs, tp +! +! * namelist must be terminated with / +! * definitions & defaults: +! PARAM%OUTPUT = 4 ! 1: Forcing parameters +! ! 2: Mean wave parameters +! ! 3: Nondimensional pars. (U*) +! ! 4: Nondimensional pars. (U10) +! ! 5: Validation table +! ! 6: WMO standard output +! -------------------------------------------------------------------- ! +&PARAM_NML +/ + + +! -------------------------------------------------------------------- ! +! Define the type 3, source terms via SOURCE_NML namelist +! +! Table of 1-D S(f) content : +! - time, station id, station name, longitude, latitude +! - frequency : unit Hz, center band frequency +! - ef(frequency) : 1D spectral density +! - Sin(frequency) : input source term +! - Snl(frequency) : non linear interactions source term +! - Sds(frequency) : dissipation source term +! - Sbt(frequency) : bottom source term +! - Sice(frequency) : ice source term +! - Stot(frequency) : total source term +! - dpt, ust, wnd : mean parameters +! +! Table of 1-D inverse time scales (1/T = S/F) content : +! - time, station id, station name, longitude, latitude +! - frequency : unit Hz, center band frequency +! - ef(frequency) : 1D spectral density +! - tini(frequency) : input inverse time scales source term +! - tnli(frequency) : non linear interactions inverse time scales source term +! - tdsi(frequency) : dissipation inverse time scales source term +! - tbti(frequency) : bottom inverse time scales source term +! - ticei(frequency) : ice inverse time scales source term +! - ttoti(frequency) : total inverse time scales source term +! - dpt, ust, wnd : mean parameters +! +! Transfert file content : +! - time, station id, station name, longitude, latitude +! - frequency : unit Hz, center band frequency - linear log scale (XFR factor) +! - frequency1 : unit Hz, lower band frequency +! - frequency2 : unit Hz, upper band frequency +! - direction : unit degree, convention to, origin East, trigonometric order +! - efth(frequency,direction) : 2D spectral density +! - Sin(frequency,direction) : input source term +! - Snl(frequency,direction) : non linear interactions source term +! - Sds(frequency,direction) : dissipation source term +! - Sbt(frequency,direction) : bottom source term +! - Sice(frequency,direction) : ice source term +! - Stot(frequency,direction) : total source term +! - dpt, wnd, wnddir, cur, curdir, ust : mean parameters +! +! +! * namelist must be terminated with / +! * definitions & defaults: +! SOURCE%OUTPUT = 4 ! 1: Print plots +! ! 2: Table of 1-D S(f) +! ! 3: Table of 1-D inverse time scales (1/T = S/F) +! ! 4: Transfer file +! SOURCE%SCALE_FAC = 0 ! Scale factor (-1=disabled) +! SOURCE%OUTPUT_FAC = 0 ! Output factor (0=normalized) +! SOURCE%TABLE_FAC = 0 ! Table factor +! 0 : Dimensional. +! 1 : Nondimensional in terms of U10 +! 2 : Nondimensional in terms of U* +! 3-5: like 0-2 with f normalized with fp. +! SOURCE%SPECTRUM = T ! [T|F] +! SOURCE%INPUT = T ! [T|F] +! SOURCE%INTERACTIONS = T ! [T|F] +! SOURCE%DISSIPATION = T ! [T|F] +! SOURCE%BOTTOM = T ! [T|F] +! SOURCE%ICE = T ! [T|F] +! SOURCE%TOTAL = T ! [T|F] +! -------------------------------------------------------------------- ! +&SOURCE_NML +/ + + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_tp2.19/input_Case1C/ww3_shel.inp b/regtests/ww3_tp2.19/input_Case1C/ww3_shel.inp new file mode 100644 index 000000000..6913cd556 --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1C/ww3_shel.inp @@ -0,0 +1,115 @@ +$ WAVEWATCH III shell input file +$ ------------------------------ + F F Water levels + F F Currents + F F Winds + F F Ice concentrations + F F Atmospheric momentum + F F Air density + F Assimilation data : Mean parameters + F Assimilation data : 1-D spectra + F Assimilation data : 2-D spectra. +$ + 20180701 000000 + 20180701 000130 +$ + 1 +$ + 20180701 000000 2 20180701 010000 +$ +N +WLV T02 DIR CUR HS T0M1 FP SXX SXY SYY DPT +$ + 20180701 000000 2 20180701 010000 +$ +$output points for Inlet +$ +$ +0 0.0 a01 +1 0.0 a02 +2 0.0 a03 +3 0.0 a04 +4 0.0 a05 +5 0.0 a06 +6 0.0 a07 +7 0.0 a08 +8 0.0 a09 +9 0.0 a10 +10 0.0 a11 +11 0.0 a12 +12 0.0 a13 +13 0.0 a14 +14 0.0 a15 +15 0.0 a16 +15.5 0.0 a17 +16 0.0 a18 +16.5 0.0 a19 +17 0.0 a20 +17.5 0.0 a21 +18 0.0 a22 +18.5 0.0 a23 +19 0.0 a24 +19.2 0.0 a25 +19.4 0.0 a26 +19.6 0.0 a27 +19.8 0.0 a28 +20 0.0 a29 +20.2 0.0 a30 +20.4 0.0 a31 +20.6 0.0 a32 +20.8 0.0 a33 +21 0.0 a34 +21.2 0.0 a35 +21.4 0.0 a36 +21.6 0.0 a37 +21.8 0.0 a38 +22 0.0 a39 +22.2 0.0 a40 +22.4 0.0 a41 +22.6 0.0 a42 +22.8 0.0 a43 +23 0.0 a44 +23.2 0.0 a45 +23.4 0.0 a46 +23.6 0.0 a47 +23.8 0.0 a48 +24 0.0 a49 +24.2 0.0 a50 +24.4 0.0 a51 +24.6 0.0 a52 +24.8 0.0 a53 +25 0.0 a54 +25.2 0.0 a55 +25.4 0.0 a56 +25.6 0.0 a57 +25.8 0.0 a58 +26 0.0 a59 +26.2 0.0 a60 +26.4 0.0 a61 +26.56 0.0 a62 +26.8 0.0 a63 +27 0.0 a64 +27.25 0.0 a65 +27.5 0.0 a66 +27.75 0.0 a67 +28 0.0 a68 +28.25 0.0 a69 +28.5 0.0 a70 +28.75 0.0 a71 +29.00 0.0 a72 +29.25 0.0 a73 +29.50 0.0 a74 +29.75 0.0 a75 +30.00 0.0 a76 +30.25 0.0 a77 +30.50 0.0 a78 +30.75 0.0 a79 +31.00 0.0 a80 +$ + 0.0 0.0 'STOPSTRING' +$ + 19680606 000000 0 19680608 000000 + 19680606 000000 0 19680608 000000 + 19680606 000000 0 19680608 000000 + 19680606 000000 0 19680608 000000 +$ diff --git a/regtests/ww3_tp2.19/input_Case1C/ww3_shel.nml b/regtests/ww3_tp2.19/input_Case1C/ww3_shel.nml new file mode 100644 index 000000000..030117c15 --- /dev/null +++ b/regtests/ww3_tp2.19/input_Case1C/ww3_shel.nml @@ -0,0 +1,337 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III ww3_shel.nml - single-grid model ! +! -------------------------------------------------------------------- ! + + +! -------------------------------------------------------------------- ! +! Define top-level model parameters via DOMAIN_NML namelist +! +! * IOSTYP defines the output server mode for parallel implementation. +! 0 : No data server processes, direct access output from +! each process (requires true parallel file system). +! 1 : No data server process. All output for each type +! performed by process that performs computations too. +! 2 : Last process is reserved for all output, and does no +! computing. +! 3 : Multiple dedicated output processes. +! +! * namelist must be terminated with / +! * definitions & defaults: +! DOMAIN%IOSTYP = 1 ! Output server type +! DOMAIN%START = '19680606 000000' ! Start date for the entire model +! DOMAIN%STOP = '19680607 000000' ! Stop date for the entire model +! -------------------------------------------------------------------- ! +&DOMAIN_NML + DOMAIN%IOSTYP = 1 + DOMAIN%START = '20180701 000000' + DOMAIN%STOP = '20180701 000130' +/ + +! -------------------------------------------------------------------- ! +! Define each forcing via the INPUT_NML namelist +! +! * The FORCING flag can be : 'F' for "no forcing" +! 'T' for "external forcing file" +! 'H' for "homogeneous forcing input" +! 'C' for "coupled forcing field" +! +! * homogeneous forcing is not available for ICE_CONC +! +! * The ASSIM flag can : 'F' for "no forcing" +! 'T' for "external forcing file" +! +! * namelist must be terminated with / +! * definitions & defaults: +! INPUT%FORCING%WATER_LEVELS = 'F' +! INPUT%FORCING%CURRENTS = 'F' +! INPUT%FORCING%WINDS = 'F' +! INPUT%FORCING%ICE_CONC = 'F' +! INPUT%FORCING%ICE_PARAM1 = 'F' +! INPUT%FORCING%ICE_PARAM2 = 'F' +! INPUT%FORCING%ICE_PARAM3 = 'F' +! INPUT%FORCING%ICE_PARAM4 = 'F' +! INPUT%FORCING%ICE_PARAM5 = 'F' +! INPUT%FORCING%MUD_DENSITY = 'F' +! INPUT%FORCING%MUD_THICKNESS = 'F' +! INPUT%FORCING%MUD_VISCOSITY = 'F' +! INPUT%ASSIM%MEAN = 'F' +! INPUT%ASSIM%SPEC1D = 'F' +! INPUT%ASSIM%SPEC2D = 'F' +! -------------------------------------------------------------------- ! +&INPUT_NML +INPUT%FORCING%WATER_LEVELS = 'F' +/ + +! -------------------------------------------------------------------- ! +! Define the output types point parameters via OUTPUT_TYPE_NML namelist +! +! * the point file is a space separated values per line : lon lat 'name' +! +! * the full list of field names is : +! All parameters listed below are available in output file of the types +! ASCII and NetCDF. If selected output file types are grads or grib, +! some parameters may not be available. The first two columns in the +! table below identify such cases by flags, cols 1 (GRB) and 2 (GXO) +! refer to grib (ww3_grib) and grads (gx_outf), respectively. +! +! Columns 3 and 4 provide group and parameter numbers per group. +! Columns 5, 6 and 7 provide: +! 5 - code name (internal) +! 6 - output tags (names used is ASCII file extensions, NetCDF +! variable names and namelist-based selection +! 7 - Long parameter name/definition +! +! G G +! R X Grp Param Code Output Parameter/Group +! B O Numb Numbr Name Tag Definition +! -------------------------------------------------- +! 1 Forcing Fields +! ------------------------------------------------- +! T T 1 1 DW DPT Water depth. +! T T 1 2 C[X,Y] CUR Current velocity. +! T T 1 3 UA WND Wind speed. +! T T 1 4 AS AST Air-sea temperature difference. +! T T 1 5 WLV WLV Water levels. +! T T 1 6 ICE ICE Ice concentration. +! T T 1 7 IBG IBG Iceberg-induced damping. +! T T 1 8 D50 D50 Median sediment grain size. +! T T 1 9 IC1 IC1 Ice thickness. +! T T 1 10 IC5 IC5 Ice flow diameter. +! ------------------------------------------------- +! 2 Standard mean wave Parameters +! ------------------------------------------------- +! T T 2 1 HS HS Wave height. +! T T 2 2 WLM LM Mean wave length. +! T T 2 3 T02 T02 Mean wave period (Tm0,2). +! T T 2 4 TM10 TM10 Mean wave period (Tm-1,0). +! T T 2 5 T01 T01 Mean wave period (Tm0,1). +! T T 2 6 FP0 FP Peak frequency. +! T T 2 7 THM DIR Mean wave direction. +! T T 2 8 THS SPR Mean directional spread. +! T T 2 9 THP0 DP Peak direction. +! T T 2 10 HIG HIG Infragravity height +! T T 2 11 STMAXE MXE Max surface elev (STE) +! T T 2 12 STMAXD MXES St Dev of max surface elev (STE) +! T T 2 13 HMAXE MXH Max wave height (STE) +! T T 2 14 HCMAXE MXHC Max wave height from crest (STE) +! T T 2 15 HMAXD SDMH St Dev of MXC (STE) +! T T 2 16 HCMAXD SDMHC St Dev of MXHC (STE) +! F T 2 17 WBT WBT Domiant wave breaking probability bT +! ------------------------------------------------- +! 3 Spectral Parameters (first 5) +! ------------------------------------------------- +! F F 3 1 EF EF Wave frequency spectrum +! F F 3 2 TH1M TH1M Mean wave direction from a1,b2 +! F F 3 3 STH1M STH1M Directional spreading from a1,b2 +! F F 3 4 TH2M TH2M Mean wave direction from a2,b2 +! F F 3 5 STH2M STH2M Directional spreading from a2,b2 +! F F 3 6 WN WN Wavenumber array +! ------------------------------------------------- +! 4 Spectral Partition Parameters +! ------------------------------------------------- +! T T 4 1 PHS PHS Partitioned wave heights. +! T T 4 2 PTP PTP Partitioned peak period. +! T T 4 3 PLP PLP Partitioned peak wave length. +! T T 4 4 PDIR PDIR Partitioned mean direction. +! T T 4 5 PSI PSPR Partitioned mean directional spread. +! T T 4 6 PWS PWS Partitioned wind sea fraction. +! T T 4 7 PTHP0 PDP Peak wave direction of partition. +! T T 4 8 PQP PQP Goda peakdedness parameter of partition. +! T T 4 9 PPE PPE JONSWAP peak enhancement factor of partition. +! T T 4 10 PGW PGW Gaussian frequency width of partition. +! T T 4 11 PSW PSW Spectral width of partition. +! T T 4 12 PTM1 PTM10 Mean wave period (Tm-1,0) of partition. +! T T 4 13 PT1 PT01 Mean wave period (Tm0,1) of partition. +! T T 4 14 PT2 PT02 Mean wave period (Tm0,2) of partition. +! T T 4 15 PEP PEP Peak spectral density of partition. +! T T 4 16 PWST TWS Total wind sea fraction. +! T T 4 17 PNR PNR Number of partitions. +! ------------------------------------------------- +! 5 Atmosphere-waves layer +! ------------------------------------------------- +! T T 5 1 UST UST Friction velocity. +! F T 5 2 CHARN CHA Charnock parameter +! F T 5 3 CGE CGE Energy flux +! F T 5 4 PHIAW FAW Air-sea energy flux +! F T 5 5 TAUWI[X,Y] TAW Net wave-supported stress +! F T 5 6 TAUWN[X,Y] TWA Negative part of the wave-supported stress +! F F 5 7 WHITECAP WCC Whitecap coverage +! F F 5 8 WHITECAP WCF Whitecap thickness +! F F 5 9 WHITECAP WCH Mean breaking height +! F F 5 10 WHITECAP WCM Whitecap moment +! F F 5 11 FWS FWS Wind sea mean period +! ------------------------------------------------- +! 6 Wave-ocean layer +! ------------------------------------------------- +! F F 6 1 S[XX,YY,XY] SXY Radiation stresses. +! F F 6 2 TAUO[X,Y] TWO Wave to ocean momentum flux +! F F 6 3 BHD BHD Bernoulli head (J term) +! F F 6 4 PHIOC FOC Wave to ocean energy flux +! F F 6 5 TUS[X,Y] TUS Stokes transport +! F F 6 6 USS[X,Y] USS Surface Stokes drift +! F F 6 7 [PR,TP]MS P2S Second-order sum pressure +! F F 6 8 US3D USF Spectrum of surface Stokes drift +! F F 6 9 P2SMS P2L Micro seism source term +! F F 6 10 TAUICE TWI Wave to sea ice stress +! F F 6 11 PHICE FIC Wave to sea ice energy flux +! ------------------------------------------------- +! 7 Wave-bottom layer +! ------------------------------------------------- +! F F 7 1 ABA ABR Near bottom rms amplitides. +! F F 7 2 UBA UBR Near bottom rms velocities. +! F F 7 3 BEDFORMS BED Bedforms +! F F 7 4 PHIBBL FBB Energy flux due to bottom friction +! F F 7 5 TAUBBL TBB Momentum flux due to bottom friction +! ------------------------------------------------- +! 8 Spectrum parameters +! ------------------------------------------------- +! F F 8 1 MSS[X,Y] MSS Mean square slopes +! F F 8 2 MSC[X,Y] MSC Spectral level at high frequency tail +! F F 8 3 WL02[X,Y] WL02 East/X North/Y mean wavelength compon +! F F 8 4 ALPXT AXT Correl sea surface gradients (x,t) +! F F 8 5 ALPYT AYT Correl sea surface gradients (y,t) +! F F 8 6 ALPXY AXY Correl sea surface gradients (x,y) +! ------------------------------------------------- +! 9 Numerical diagnostics +! ------------------------------------------------- +! T T 9 1 DTDYN DTD Average time step in integration. +! T T 9 2 FCUT FC Cut-off frequency. +! T T 9 3 CFLXYMAX CFX Max. CFL number for spatial advection. +! T T 9 4 CFLTHMAX CFD Max. CFL number for theta-advection. +! F F 9 5 CFLKMAX CFK Max. CFL number for k-advection. +! ------------------------------------------------- +! 10 User defined +! ------------------------------------------------- +! F F 10 1 U1 User defined #1. (requires coding ...) +! F F 10 2 U2 User defined #1. (requires coding ...) +! ------------------------------------------------- +! +! Section 4 consist of a set of fields, index 0 = wind sea, index +! 1:NOSWLL are first NOSWLL swell fields. +! +! +! * output track file formatted (T) or unformated (F) +! +! * coupling fields exchanged list is : +! - Sent fields by ww3: +! - Ocean model : T0M1 OCHA OHS DIR BHD TWO UBR FOC TAW TUS USS LM DRY +! - Atmospheric model : ACHA AHS TP (or FP) FWS +! - Ice model : IC5 TWI +! - Received fields by ww3: +! - Ocean model : SSH CUR +! - Atmospheric model : WND +! - Ice model : ICE IC1 IC5 +! +! * namelist must be terminated with / +! * definitions & defaults: +! TYPE%FIELD%LIST = 'unset' +! TYPE%POINT%FILE = 'points.list' +! TYPE%TRACK%FORMAT = T +! TYPE%PARTITION%X0 = 0 +! TYPE%PARTITION%XN = 0 +! TYPE%PARTITION%NX = 0 +! TYPE%PARTITION%Y0 = 0 +! TYPE%PARTITION%YN = 0 +! TYPE%PARTITION%NY = 0 +! TYPE%PARTITION%FORMAT = T +! TYPE%COUPLING%SENT = 'unset' +! TYPE%COUPLING%RECEIVED = 'unset' +! +! -------------------------------------------------------------------- ! +&OUTPUT_TYPE_NML + TYPE%FIELD%LIST = 'WLV T02 DIR CUR HS T0M1 FP SXX SXY SYY DPT' + TYPE%POINT%FILE = '../input/points.list' +/ + +! -------------------------------------------------------------------- ! +! Define output dates via OUTPUT_DATE_NML namelist +! +! * start and stop times are with format 'yyyymmdd hhmmss' +! * if time stride is equal '0', then output is disabled +! * time stride is given in seconds +! +! * namelist must be terminated with / +! * definitions & defaults: +! DATE%FIELD%START = '19680606 000000' +! DATE%FIELD%STRIDE = '0' +! DATE%FIELD%STOP = '19680607 000000' +! DATE%POINT%START = '19680606 000000' +! DATE%POINT%STRIDE = '0' +! DATE%POINT%STOP = '19680607 000000' +! DATE%TRACK%START = '19680606 000000' +! DATE%TRACK%STRIDE = '0' +! DATE%TRACK%STOP = '19680607 000000' +! DATE%RESTART%START = '19680606 000000' +! DATE%RESTART%STRIDE = '0' +! DATE%RESTART%STOP = '19680607 000000' +! DATE%BOUNDARY%START = '19680606 000000' +! DATE%BOUNDARY%STRIDE = '0' +! DATE%BOUNDARY%STOP = '19680607 000000' +! DATE%PARTITION%START = '19680606 000000' +! DATE%PARTITION%STRIDE = '0' +! DATE%PARTITION%STOP = '19680607 000000' +! DATE%COUPLING%START = '19680606 000000' +! DATE%COUPLING%STRIDE = '0' +! DATE%COUPLING%STOP = '19680607 000000' +! +! DATE%RESTART = '19680606 000000' '0' '19680607 000000' +! -------------------------------------------------------------------- ! +&OUTPUT_DATE_NML + DATE%FIELD = '20180701 000000' '2' '20180701 010000' + DATE%POINT = '20180701 000000' '2' '20180701 010000' +/ + +! -------------------------------------------------------------------- ! +! Define homogeneous input via HOMOG_COUNT_NML and HOMOG_INPUT_NML namelist +! +! * the number of each homogeneous input is defined by HOMOG_COUNT +! * the total number of homogeneous input is automatically calculated +! * the homogeneous input must start from index 1 to N +! * if VALUE1 is equal 0, then the homogeneous input is desactivated +! * NAME can be IC1, IC2, IC3, IC4, IC5, MDN, MTH, MVS, LEV, CUR, WND, ICE, MOV +! * each homogeneous input is defined over a maximum of 3 values detailled below : +! - IC1 is defined by thickness +! - IC2 is defined by viscosity +! - IC3 is defined by density +! - IC4 is defined by modulus +! - IC5 is defined by floe diameter +! - MDN is defined by density +! - MTH is defined by thickness +! - MVS is defined by viscosity +! - LEV is defined by height +! - CUR is defined by speed and direction +! - WND is defined by speed, direction and airseatemp +! - ICE is defined by concentration +! - MOV is defined by speed and direction +! +! * namelist must be terminated with / +! * definitions & defaults: +! HOMOG_COUNT%N_IC1 = 0 +! HOMOG_COUNT%N_IC2 = 0 +! HOMOG_COUNT%N_IC3 = 0 +! HOMOG_COUNT%N_IC4 = 0 +! HOMOG_COUNT%N_IC5 = 0 +! HOMOG_COUNT%N_MDN = 0 +! HOMOG_COUNT%N_MTH = 0 +! HOMOG_COUNT%N_MVS = 0 +! HOMOG_COUNT%N_LEV = 0 +! HOMOG_COUNT%N_CUR = 0 +! HOMOG_COUNT%N_WND = 0 +! HOMOG_COUNT%N_ICE = 0 +! HOMOG_COUNT%N_MOV = 0 +! +! HOMOG_INPUT(I)%NAME = 'unset' +! HOMOG_INPUT(I)%DATE = '19680606 000000' +! HOMOG_INPUT(I)%VALUE1 = 0 +! HOMOG_INPUT(I)%VALUE2 = 0 +! HOMOG_INPUT(I)%VALUE3 = 0 +! -------------------------------------------------------------------- ! +&HOMOG_COUNT_NML +/ + +&HOMOG_INPUT_NML +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_tp2.7/input/ww3_ounf.nml b/regtests/ww3_tp2.7/input/ww3_ounf.nml index 4fb86824e..fcc7f3e40 100644 --- a/regtests/ww3_tp2.7/input/ww3_ounf.nml +++ b/regtests/ww3_tp2.7/input/ww3_ounf.nml @@ -12,6 +12,7 @@ FIELD%LIST = 'HS T02 T01 ABR UBR' FIELD%PARTITION = '0 1 2' FIELD%TYPE = 4 + FIELD % SAMEFILE = F / ! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ufs1.1/info b/regtests/ww3_ufs1.1/info index 50329eb0b..66250d12d 100644 --- a/regtests/ww3_ufs1.1/info +++ b/regtests/ww3_ufs1.1/info @@ -3,6 +3,7 @@ # ww3_ufs1.1 Test script for WW-III, 1deg global structured. # # # # Grids: # +# input: # # grdset_a and grdset_b # # MODEL: glo_1deg with 1 deg resolution from 85S to 85N, 50 spectral and 36 # # directional bins. # @@ -11,6 +12,13 @@ # (current.nc). # # POINT: points. The unified point output grid is glo_1deg # # --------------------------------------------------------------------------# +# input_unstr (global unstr mesh with 1 deg resolution): # +# Mesh: global_1deg_unstr.msh # +# Options: # +# # grid_a: Domain Decomposition (PDLIB) and Explicit solver # +# # grid_b: Domain Decomposition (PDLIB) and Block Explicit solver # +# # grid_c: Domain Decomposition (PDLIB) and Implicit solver # +# --------------------------------------------------------------------------# # if "ufscoarse" option is selected in bin/matrix.base, a coarser grid with # # 5 deg. resolution is used for MODEL and INPUT grids. # # grdset_c and grdset_d # @@ -66,8 +74,12 @@ # ./bin/run_test -c intel -S -T -w work_a -m grdset_a —C ESMF f -p mpirun # # -n 440 -t 8 -o all ../model ww3_ufs1.1 # # --------------------------------------------------------------------------# +# global unstructured mesh: # +# ./bin/run_cmake_test -c intel -o all -S -T -s MPI -s PDLIB -i input_unstr # +# -w work_unstr_a -g a -f -p mpirun -n 24 ../model ww3_ufs1.1 # +# --------------------------------------------------------------------------# # # # Ali Abdolali, April 2021 # -# Last Mod : April 2021 # +# Last Mod : Feb 2023 # # # ############################################################################# diff --git a/regtests/ww3_ufs1.1/input_unstr/namelists_a.nml b/regtests/ww3_ufs1.1/input_unstr/namelists_a.nml new file mode 100644 index 000000000..584405f2f --- /dev/null +++ b/regtests/ww3_ufs1.1/input_unstr/namelists_a.nml @@ -0,0 +1,53 @@ +&SLN1 CLIN = 80.0, RFPM = 1.00, RFHF = 0.50 / +&SIN4 ALPHA0=0.0095, +BETAMAX=1.33, +SINTHP=2.00, +Z0MAX=0.00, +ZALP=0.006, +ZWND=10.00, +TAUWSHELTER =1.00, +SWELLFPAR = 1, +SWELLF= 0.800, +SWELLF2=-0.018, +SWELLF3 =0.015, +SWELLF4 =100000.0, +SWELLF5 =1.200, +SWELLF6 =0.000, +SWELLF7 =230000.000, +Z0RAT =0.0400 / +&UNST UGOBCAUTO = F, +UGOBCDEPTH= -10., +EXPFSN = T, +EXPFSPSI = F, +EXPFSFCT = F, +IMPFSN = F / +&SNL1 LAMBDA = 0.250, NLPROP = 0.250E+08, KDCONV = 0.750, KDMIN = 0.500, +SNLCS1 = 5.500, SNLCS2 = 0.833, SNLCS3 = -1.250 / +&SDS4 SDSBCHOICE = 1, SDSC2 = -0.2200E-04, SDSCUM = -0.4034E+00, +SDSC4 = 0.1000E+01, SDSC5 = 0.0000E+00, SDSC6 = 0.3000E+00, +WNMEANP =0.50, FXPM3 =4.00,FXFM3 =9.90, +SDSBINT = 0.3000E+00, SDSBCK = 0.0000E+00, SDSABK = 1.500, SDSPBK = 4.000, +SDSHCK = 1.50, SDSBR = 0.9000E-03, SDSSTRAIN = 0.000, +SDSP = 2.00, SDSISO = 2, SDSCOS =2.0, SDSDTH = 80.0, +SDSBRF1 = 0.50, SDSBRFDF = 0, +SDSBM0 = 1.00, SDSBM1 = 0.00, SDSBM2 = 0.00, SDSBM3 = 0.00, SDSBM4 = 0.00, +, WHITECAPWIDTH = 0.30/ +&SBT1 GAMMA = -0.6700E-01 / +&SDB1 BJALFA = 1.000, BJGAM = 0.730, BJFLAG = .TRUE. / +&PRO3 CFLTM = 0.70, WDTHCG = 1.50, WDTHTH = 1.50 / +&OUTS P2SF = 0, I1P2SF = 1, I2P2SF = 15, +US3D = 0, I1US3D = 1, I2US3D = 32, +E3D = 0, I1E3D = 1, I2E3D = 32, +TH1MF = 0, I1TH1M = 1, I2TH1M = 32, +STH1MF= 0, I1STH1M= 1, I2STH1M= 32, +TH2MF = 0, I1TH2M = 1, I2TH2M = 32, +STH2MF= 0, I1STH2M= 1, I2STH2M= 32, +E3D = 1, USSP = 1, IUSSP = 3, STK_WN = 0.04, 0.110, 0.3305 / +&REF1 REFCOAST=0.10, REFSLOPE=0.1, REFCOSP_STRAIGHT=4, REFFREQ=1., REFSUBGRID = 0.00 / +&SIN4 BETAMAX = 1.33 / +&MISC CICE0 = 0.250, CICEN = 0.750, LICE = 0.0, PMOVE = 0.500, +XSEED = 1.000, FLAGTR = 0, XP = 0.150, XR = 0.100, XFILT = 0.050 +IHM = 100, HSPM = 0.050, WSM = 1.700, WSC = 0.333, FLC = .TRUE. +NOSW = 3, FMICHE = 1.600, RWNDC = 1.000, +FACBERG = 1.0, GSHIFT = 0.000E+00 / +END OF NAMELISTS diff --git a/regtests/ww3_ufs1.1/input_unstr/namelists_b.nml b/regtests/ww3_ufs1.1/input_unstr/namelists_b.nml new file mode 100644 index 000000000..292ffc5f7 --- /dev/null +++ b/regtests/ww3_ufs1.1/input_unstr/namelists_b.nml @@ -0,0 +1,73 @@ +&SLN1 CLIN = 80.0, RFPM = 1.00, RFHF = 0.50 / +&SIN4 ALPHA0=0.0095, +BETAMAX=1.33, +SINTHP=2.00, +Z0MAX=0.00, +ZALP=0.006, +ZWND=10.00, +TAUWSHELTER =1.00, +SWELLFPAR = 1, +SWELLF= 0.800, +SWELLF2=-0.018, +SWELLF3 =0.015, +SWELLF4 =100000.0, +SWELLF5 =1.200, +SWELLF6 =0.000, +SWELLF7 =230000.000, +Z0RAT =0.0400 / +&UNST UGOBCAUTO = F, +UGOBCDEPTH= -10., +UGBCCFL= F, +EXPFSN = F, +EXPFSPSI = F, +EXPFSFCT = F, +IMPFSN = F, +EXPTOTAL = T, +IMPTOTAL = F, +IMPREFRACTION = F, +IMPFREQSHIFT = F, +IMPSOURCE = F, +SETUP_APPLY_WLV = F, +SOLVERTHR_SETUP=1E-14, +CRIT_DEP_SETUP=0.1, +JGS_NLEVEL = 0, +JGS_USE_JACOBI = F, +JGS_BLOCK_GAUSS_SEIDEL = F, +JGS_TERMINATE_MAXITER = F, +JGS_MAXITER = 1000, +JGS_TERMINATE_NORM = F, +JGS_TERMINATE_DIFFERENCE = F, +JGS_DIFF_THR = 1.E-8, +JGS_PMIN = 3.0, +JGS_LIMITER = F, +JGS_NORM_THR = 1.E-6 / +&SNL1 LAMBDA = 0.250, NLPROP = 0.250E+08, KDCONV = 0.750, KDMIN = 0.500, +SNLCS1 = 5.500, SNLCS2 = 0.833, SNLCS3 = -1.250 / +&SDS4 SDSBCHOICE = 1, SDSC2 = -0.2200E-04, SDSCUM = -0.4034E+00, +SDSC4 = 0.1000E+01, SDSC5 = 0.0000E+00, SDSC6 = 0.3000E+00, +WNMEANP =0.50, FXPM3 =4.00,FXFM3 =9.90, +SDSBINT = 0.3000E+00, SDSBCK = 0.0000E+00, SDSABK = 1.500, SDSPBK = 4.000, +SDSHCK = 1.50, SDSBR = 0.9000E-03, SDSSTRAIN = 0.000, +SDSP = 2.00, SDSISO = 2, SDSCOS =2.0, SDSDTH = 80.0, +SDSBRF1 = 0.50, SDSBRFDF = 0, +SDSBM0 = 1.00, SDSBM1 = 0.00, SDSBM2 = 0.00, SDSBM3 = 0.00, SDSBM4 = 0.00, +, WHITECAPWIDTH = 0.30/ +&SBT1 GAMMA = -0.6700E-01 / +&SDB1 BJALFA = 1.000, BJGAM = 0.730, BJFLAG = .TRUE. / +&PRO3 CFLTM = 0.70, WDTHCG = 1.50, WDTHTH = 1.50 / +&OUTS P2SF = 0, I1P2SF = 1, I2P2SF = 15, +US3D = 0, I1US3D = 1, I2US3D = 32, +E3D = 0, I1E3D = 1, I2E3D = 32, +TH1MF = 0, I1TH1M = 1, I2TH1M = 32, +STH1MF= 0, I1STH1M= 1, I2STH1M= 32, +TH2MF = 0, I1TH2M = 1, I2TH2M = 32, +STH2MF= 0, I1STH2M= 1, I2STH2M= 32, +E3D = 1, USSP = 1, IUSSP = 3, STK_WN = 0.04, 0.110, 0.3305 / +&REF1 REFCOAST=0.10, REFSLOPE=0.1, REFCOSP_STRAIGHT=4, REFFREQ=1., REFSUBGRID = 0.00 / +&SIN4 BETAMAX = 1.33 / +&MISC CICE0 = 0.250, CICEN = 0.750, LICE = 0.0, PMOVE = 0.500, +XSEED = 1.000, FLAGTR = 0, XP = 0.150, XR = 0.100, XFILT = 0.050 +IHM = 100, HSPM = 0.050, WSM = 1.700, WSC = 0.333, FLC = .TRUE. +NOSW = 3, FMICHE = 1.600, RWNDC = 1.000, +FACBERG = 1.0, GSHIFT = 0.000E+00 / +END OF NAMELISTS diff --git a/regtests/ww3_ufs1.1/input_unstr/namelists_c.nml b/regtests/ww3_ufs1.1/input_unstr/namelists_c.nml new file mode 100644 index 000000000..013ea40af --- /dev/null +++ b/regtests/ww3_ufs1.1/input_unstr/namelists_c.nml @@ -0,0 +1,72 @@ +&SLN1 CLIN = 80.0, RFPM = 1.00, RFHF = 0.50 / +&SIN4 ALPHA0=0.0095, +BETAMAX=1.33, +SINTHP=2.00, +Z0MAX=0.00, +ZALP=0.006, +ZWND=10.00, +TAUWSHELTER =1.00, +SWELLFPAR = 1, +SWELLF= 0.800, +SWELLF2=-0.018, +SWELLF3 =0.015, +SWELLF4 =100000.0, +SWELLF5 =1.200, +SWELLF6 =0.000, +SWELLF7 =230000.000, +Z0RAT =0.0400 / +&UNST +UGOBCAUTO = F +UGOBCDEPTH= -10. +EXPFSN = F, +EXPFSPSI = F, +EXPFSFCT = F, +IMPFSN = F, +EXPTOTAL = F, +IMPTOTAL = T, +IMPREFRACTION = T, +IMPFREQSHIFT = T, +IMPSOURCE = T, +SETUP_APPLY_WLV = F, +SOLVERTHR_SETUP=1E-14, +CRIT_DEP_SETUP=0.1, +JGS_USE_JACOBI = T, +JGS_BLOCK_GAUSS_SEIDEL = T, +JGS_TERMINATE_MAXITER = T, +JGS_MAXITER = 1000, +JGS_TERMINATE_NORM = F, +JGS_TERMINATE_DIFFERENCE = T, +JGS_DIFF_THR = 1.E-6, +JGS_PMIN = 3.0, +JGS_LIMITER = F, +JGS_NORM_THR = 1.E-6 / +&SNL1 LAMBDA = 0.250, NLPROP = 0.250E+08, KDCONV = 0.750, KDMIN = 0.500, +SNLCS1 = 5.500, SNLCS2 = 0.833, SNLCS3 = -1.250 / +&SDS4 SDSBCHOICE = 1, SDSC2 = -0.2200E-04, SDSCUM = -0.4034E+00, +SDSC4 = 0.1000E+01, SDSC5 = 0.0000E+00, SDSC6 = 0.3000E+00, +WNMEANP =0.50, FXPM3 =4.00,FXFM3 =9.90, +SDSBINT = 0.3000E+00, SDSBCK = 0.0000E+00, SDSABK = 1.500, SDSPBK = 4.000, +SDSHCK = 1.50, SDSBR = 0.9000E-03, SDSSTRAIN = 0.000, +SDSP = 2.00, SDSISO = 2, SDSCOS =2.0, SDSDTH = 80.0, +SDSBRF1 = 0.50, SDSBRFDF = 0, +SDSBM0 = 1.00, SDSBM1 = 0.00, SDSBM2 = 0.00, SDSBM3 = 0.00, SDSBM4 = 0.00, +, WHITECAPWIDTH = 0.30/ +&SBT1 GAMMA = -0.6700E-01 / +&SDB1 BJALFA = 1.000, BJGAM = 0.730, BJFLAG = .TRUE. / +&PRO3 CFLTM = 0.70, WDTHCG = 1.50, WDTHTH = 1.50 / +&OUTS P2SF = 0, I1P2SF = 1, I2P2SF = 15, +US3D = 0, I1US3D = 1, I2US3D = 32, +E3D = 0, I1E3D = 1, I2E3D = 32, +TH1MF = 0, I1TH1M = 1, I2TH1M = 32, +STH1MF= 0, I1STH1M= 1, I2STH1M= 32, +TH2MF = 0, I1TH2M = 1, I2TH2M = 32, +STH2MF= 0, I1STH2M= 1, I2STH2M= 32, +E3D = 1, USSP = 1, IUSSP = 3, STK_WN = 0.04, 0.110, 0.3305 / +&REF1 REFCOAST=0.10, REFSLOPE=0.1, REFCOSP_STRAIGHT=4, REFFREQ=1., REFSUBGRID = 0.00 / +&SIN4 BETAMAX = 1.33 / +&MISC CICE0 = 0.250, CICEN = 0.750, LICE = 0.0, PMOVE = 0.500, +XSEED = 1.000, FLAGTR = 0, XP = 0.150, XR = 0.100, XFILT = 0.050 +IHM = 100, HSPM = 0.050, WSM = 1.700, WSC = 0.333, FLC = .TRUE. +NOSW = 3, FMICHE = 1.600, RWNDC = 1.000, +FACBERG = 1.0, GSHIFT = 0.000E+00 / +END OF NAMELISTS diff --git a/regtests/ww3_ufs1.1/input_unstr/switch_PDLIB b/regtests/ww3_ufs1.1/input_unstr/switch_PDLIB new file mode 100644 index 000000000..ff569c11f --- /dev/null +++ b/regtests/ww3_ufs1.1/input_unstr/switch_PDLIB @@ -0,0 +1 @@ +PDLIB SCOTCH NOGRB DIST MPI PR3 UQ FLX0 SEED ST4 STAB0 NL1 BT1 DB1 MLIM FLD1 TR0 BS0 WNX1 WNT1 CRX1 CRT1 O0 O1 O2 O3 O4 O5 O6 O7 O14 O15 IC0 IS0 REF0 diff --git a/regtests/ww3_ufs1.1/input_unstr/ww3_grid_a.inp b/regtests/ww3_ufs1.1/input_unstr/ww3_grid_a.inp new file mode 100644 index 000000000..d2f508ac2 --- /dev/null +++ b/regtests/ww3_ufs1.1/input_unstr/ww3_grid_a.inp @@ -0,0 +1,307 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Grid preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Grid name (C*30, in quotes) +$ + 'GLOBAL' +$ +$ Frequency increment factor and first frequency (Hz) ---------------- $ +$ number of frequencies (wavenumbers) and directions, relative offset +$ of first direction in terms of the directional increment [-0.5,0.5]. +$ In versions 1.18 and 2.22 of the model this value was by definiton 0, +$ it is added to mitigate the GSE for a first order scheme. Note that +$ this factor is IGNORED in the print plots in ww3_outp. +$ + 1.07 0.035 50 36 0. +$ +$ Set model flags ---------------------------------------------------- $ +$ - FLDRY Dry run (input/output only, no calculation). +$ - FLCX, FLCY Activate X and Y component of propagation. +$ - FLCTH, FLCK Activate direction and wavenumber shifts. +$ - FLSOU Activate source terms. +$ + F T T T T T +$ +$ Set time steps ----------------------------------------------------- $ +$ - Time step information (this information is always read) +$ maximum global time step, maximum CFL time step for x-y and +$ k-theta, minimum source term time step (all in seconds). +$ +$ + 720. 360. 360. 30. +$ +$ Start of namelist input section ------------------------------------ $ +$ Starting with WAVEWATCH III version 2.00, the tunable parameters +$ for source terms, propagation schemes, and numerics are read using +$ namelists. Any namelist found in the folowing sections up to the +$ end-of-section identifier string (see below) is temporarily written +$ to ww3_grid.scratch, and read from there if necessary. Namelists +$ not needed for the given switch settings will be skipped +$ automatically, and the order of the namelists is immaterial. +$ +&SLN1 CLIN = 80.0, RFPM = 1.00, RFHF = 0.50 / +$ +&SIN4 ALPHA0=0.0095, + BETAMAX=1.33, + SINTHP=2.00, + Z0MAX=0.00, + ZALP=0.006, + ZWND=10.00, + TAUWSHELTER =1.00, + SWELLFPAR = 1, + SWELLF= 0.800, + SWELLF2=-0.018, + SWELLF3 =0.015, + SWELLF4 =100000.0, + SWELLF5 =1.200, + SWELLF6 =0.000, + SWELLF7 =230000.000, + Z0RAT =0.0400 / +$ +$ Implicit with ww3ifr code version +&UNST UGOBCAUTO = F, + UGOBCDEPTH= -10., + EXPFSN = T, + EXPFSPSI = F, + EXPFSFCT = F, + IMPFSN = F / +$ +$ Bottom friction - - - - - - - - - - - - - - - - - - - - - - - - - - +$ JONSWAP : Namelist SBT1 +$ GAMMA : As it says. +$ &SBT1 GAMMA = 0.15 / +$ +$ Propagation schemes ------------------------------------------------ $ +$ First order : Namelist PRO1 +$ CFLTM : Maximum CFL number for refraction. +$ +$ UQ with diffusion : Namelist PRO2 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ DTIME : Swell age (s) in garden sprinkler +$ correction. If 0., all diffusion +$ switched off. If small non-zero +$ (DEFAULT !!!) only wave growth +$ diffusion. +$ LATMIN : Maximum latitude used in calc. of +$ strength of diffusion for prop. +$ +$ UQ with averaging : Namelist PRO3 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ WDTHCG : Tuning factor propag. direction. +$ WDTHTH : Tuning factor normal direction. +$ +$ UQ with divergence : Namelist PRO4 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ QTFAC : Tuning factor Eq. (3.41). +$ RSFAC : Tuning factor Eq. (3.42). +$ RNFAC : Tuning factor Eq. (3.43). +$ +$ Miscellaneous ------------------------------------------------------ $ +$ Misc. parameters : Namelist MISC +$ CICE0 : Ice concentration cut-off. +$ CICEN : Ice concentration cut-off. +$ XSEED : Xseed in seeding alg. (!/SEED). +$ FLAGTR : Indicating presence and type of +$ subgrid information : +$ 0 : No subgrid information. +$ 1 : Transparancies at cell boun- +$ daries between grid points. +$ 2 : Transp. at cell centers. +$ 3 : Like 1 with cont. ice. +$ 4 : Like 2 with cont. ice. +$ XP, XR, XFILT +$ Xp, Xr and Xf for the dynamic +$ integration scheme. +$ +$ In the 'Out of the box' test setup we run with sub-grid obstacles +$ and with continuous ice treatment. +$ +$ +&SNL1 LAMBDA = 0.250, NLPROP = 0.250E+08, KDCONV = 0.750, KDMIN = 0.500, + SNLCS1 = 5.500, SNLCS2 = 0.833, SNLCS3 = -1.250 / +&SDS4 SDSBCHOICE = 1, SDSC2 = -0.2200E-04, SDSCUM = -0.4034E+00, + SDSC4 = 0.1000E+01, SDSC5 = 0.0000E+00, SDSC6 = 0.3000E+00, + WNMEANP =0.50, FXPM3 =4.00,FXFM3 =9.90, + SDSBINT = 0.3000E+00, SDSBCK = 0.0000E+00, SDSABK = 1.500, SDSPBK = 4.000, + SDSHCK = 1.50, SDSBR = 0.9000E-03, SDSSTRAIN = 0.000, + SDSP = 2.00, SDSISO = 2, SDSCOS =2.0, SDSDTH = 80.0, + SDSBRF1 = 0.50, SDSBRFDF = 0, + SDSBM0 = 1.00, SDSBM1 = 0.00, SDSBM2 = 0.00, SDSBM3 = 0.00, SDSBM4 = 0.00, +, WHITECAPWIDTH = 0.30/ +&SBT1 GAMMA = -0.6700E-01 / +&SDB1 BJALFA = 1.000, BJGAM = 0.730, BJFLAG = .TRUE. / +&PRO3 CFLTM = 0.70, WDTHCG = 1.50, WDTHTH = 1.50 / +&OUTS P2SF = 0, I1P2SF = 1, I2P2SF = 15, + US3D = 0, I1US3D = 1, I2US3D = 32, + E3D = 0, I1E3D = 1, I2E3D = 32, + TH1MF = 0, I1TH1M = 1, I2TH1M = 32, + STH1MF= 0, I1STH1M= 1, I2STH1M= 32, + TH2MF = 0, I1TH2M = 1, I2TH2M = 32, + STH2MF= 0, I1STH2M= 1, I2STH2M= 32, + E3D = 1, USSP = 1, IUSSP = 3, STK_WN = 0.04, 0.110, 0.3305 / +$ +$ +$AW021317 &MISC P2SF = 1 ,I1P2SF = 2, I2P2SF = 16 / +$&REF1 REFCOAST=0.1 / +$&REF1 REFCOAST=0.10, REFSLOPE=0.1, REFCOSP_STRAIGHT=4, REFFREQ=1., REFSUBGRID = 0.00 / +&REF1 REFCOAST=0.10, REFSLOPE=0.1, REFCOSP_STRAIGHT=4, REFFREQ=1., REFSUBGRID = 0.00 / +&SIN4 BETAMAX = 1.33 / +&MISC CICE0 = 0.250, CICEN = 0.750, LICE = 0.0, PMOVE = 0.500, + XSEED = 1.000, FLAGTR = 0, XP = 0.150, XR = 0.100, XFILT = 0.050 + IHM = 100, HSPM = 0.050, WSM = 1.700, WSC = 0.333, FLC = .TRUE. + NOSW = 3, FMICHE = 1.600, RWNDC = 1.000, + FACBERG = 1.0, GSHIFT = 0.000E+00 / +$&MISC CICE0 = 0.250, CICEN = 0.750, LICE = 0.0, PMOVE = 0.500, +$ XSEED = 1.000, FLAGTR = 4, XP = 0.150, XR = 0.100, XFILT = 0.050 +$ IHM = 100, HSPM = 0.050, WSM = 1.700, WSC = 0.333, FLC = .TRUE. +$ NOSW = 3, FMICHE = 1.600, RWNDC = 1.000, WCOR1 = 99.00, WCOR2 = 0.00, +$ FACBERG = 1.0, GSHIFT = 0.000E+00, STDX = -1.00, STDY = -1.00, +$ STDT = -1.00, ICEHMIN = 0.20, ICEHFAC = 1.00, +$ ICEHINIT = 0.50, ICEDISP = F, ICEHDISP = 0.60, +$ ICESLN = 1.00, ICEWIND = 1.00, ICESNL = 1.00, ICESDS = 1.00, +$ ICEDDISP = 80.00, ICEFDISP = 2.00, CALTYPE = standard , TRCKCMPR = T, +$ BTBET = 1.20 / +$ +$ Mandatory string to identify end of namelist input section. +$ +END OF NAMELISTS +$ +$ FLAG for grid features +$ 1 Type of grid 'UNST' 'RECT' 'CURV' +$ 2 Flag for geographical coordinates (LLG) +$ 3 Flag for periodic grid +$ +$ Define grid -------------------------------------------------------- $ +$ Four records containing : +$ 1 NX, NY. As the outer grid lines are always defined as land +$ points, the minimum size is 3x3. +$ 2 Grid increments SX, SY (degr.or m) and scaling (division) factor. +$ If NX*SX is 360., latitudinal closure is applied. +$ 3 Coordinates of (1,1) (degr.) and scaling (division) factor. +$ 4 Limiting bottom depth (m) to discriminate between land and sea +$ points, minimum water depth (m) as allowed in model, unit number +$ of file with bottom depths, scale factor for bottom depths (mult.), +$ IDLA, IDFM, format for formatted read, FROM and filename. +$ IDLA : Layout indicator : +$ 1 : Read line-by-line bottom to top. +$ 2 : Like 1, single read statement. +$ 3 : Read line-by-line top to bottom. +$ 4 : Like 3, single read statement. +$ IDFM : format indicator : +$ 1 : Free format. +$ 2 : Fixed format with above format descriptor. +$ 3 : Unformatted. +$ FROM : file type parameter +$ 'UNIT' : open file by unit number only. +$ 'NAME' : open file by name and assign to unit. +$ +$ Example for longitude-latitude grid (switch !/LLG), for Cartesian +$ grid the unit is meters (NOT km). +$ +$ + 'UNST' T T +$ + 4.0 0.30 20 -1. 4 1 '(20f10.2)' 'NAME' '../input_unstr/global_1deg_unstr.msh' +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed). +$ +$ 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +$ +$ If sub-grid information is avalaible as indicated by FLAGTR above, +$ additional input to define this is needed below. In such cases a +$ field of fractional obstructions at or between grid points needs to +$ be supplied. First the location and format of the data is defined +$ by (as above) : +$ - Unit number of file (can be 10, and/or identical to bottem depth +$ unit), scale factor for fractional obstruction, IDLA, IDFM, +$ format for formatted read, FROM and filename +$ +$ 10 0.2 3 1 '(....)' 'NAME' 'obstr.inp' +$ +$ *** NOTE if this unit number is the same as the previous bottom +$ depth unit number, it is assumed that this is the same file +$ without further checks. *** +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed, +$ except between the two fields). +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 5 5 5 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ *** NOTE size of fields is always NX * NY *** +$ + 10 3 1 '(....)' 'PART' 'mapsta.inp' +$ Input boundary points ---------------------------------------------- $ +$ An unlimited number of lines identifying points at which input +$ boundary conditions are to be defined. If the actual input data is +$ not defined in the actual wave model run, the initial conditions +$ will be applied as constant boundary conditions. Each line contains: +$ Discrete grid counters (IX,IY) of the active point and a +$ connect flag. If this flag is true, and the present and previous +$ point are on a grid line or diagonal, all intermediate points +$ are also defined as boundary points. +$ +$ are also defined as boundary points. +$ +$ Close list by defining point (0,0) (mandatory) +$ + 0 0 F +$ +$ +$ +$ Excluded grid points from segment data ( FROM != PART ) +$ First defined as lines, identical to the definition of the input +$ boundary points, and closed the same way. +$ + 0 0 F +$ +$ Second, define a point in a closed body of sea points to remove +$ the entire body os sea points. Also close by point (0,0) +$ + 0 0 +$ +$ Output boundary points --------------------------------------------- $ +$ Output boundary points are defined as a number of straight lines, +$ defined by its starting point (X0,Y0), increments (DX,DY) and number +$ of points. A negative number of points starts a new output file. +$ Note that this data is only generated if requested by the actual +$ program. Example again for spherical grid in degrees. +$ +$ -2.5312 48.5 0.00 0.008738 102 +$ -2.5312 49.3850 0.013554 0.00 51 +$ +$ Close list by defining line with 0 points (mandatory) +$ + 0. 0. 0. 0. 0 +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_ufs1.1/input_unstr/ww3_grid_a.nml b/regtests/ww3_ufs1.1/input_unstr/ww3_grid_a.nml new file mode 100644 index 000000000..0633097b7 --- /dev/null +++ b/regtests/ww3_ufs1.1/input_unstr/ww3_grid_a.nml @@ -0,0 +1,61 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_grid.nml - Grid pre-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the spectrum parameterization via SPECTRUM_NML namelist +! -------------------------------------------------------------------- ! +&SPECTRUM_NML + SPECTRUM%XFR = 1.07 + SPECTRUM%FREQ1 = 0.035 + SPECTRUM%NK = 50 + SPECTRUM%NTH = 36 +/ + +! -------------------------------------------------------------------- ! +! Define the run parameterization via RUN_NML namelist +! -------------------------------------------------------------------- ! +&RUN_NML + RUN%FLCX = T + RUN%FLCY = T + RUN%FLCTH = T + RUN%FLCK = T + RUN%FLSOU = T +/ + +! -------------------------------------------------------------------- ! +! Define the timesteps parameterization via TIMESTEPS_NML namelist +! -------------------------------------------------------------------- ! +&TIMESTEPS_NML + TIMESTEPS%DTMAX = 720. + TIMESTEPS%DTXY = 360. + TIMESTEPS%DTKTH = 360. + TIMESTEPS%DTMIN = 30. +/ + +! -------------------------------------------------------------------- ! +! Define the grid to preprocess via GRID_NML namelist +! -------------------------------------------------------------------- ! +&GRID_NML + GRID%NAME = 'GLOBAL' + GRID%NML = '../input_unstr/namelists_a.nml' + GRID%TYPE = 'UNST' + GRID%COORD = 'SPHE' + GRID%CLOS = 'T' + GRID%ZLIM = 4.0 + GRID%DMIN = 0.30 +/ + +! -------------------------------------------------------------------- ! +! Define the unstructured grid type via UNST_NML namelist +! -------------------------------------------------------------------- ! +&UNST_NML + UNST%SF = -1. + UNST%FILENAME = '../input_unstr/global_1deg_unstr.msh' + UNST%IDLA = 4 + UNST%FORMAT = '(20f10.2)' +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ufs1.1/input_unstr/ww3_grid_b.inp b/regtests/ww3_ufs1.1/input_unstr/ww3_grid_b.inp new file mode 100644 index 000000000..3474c9a86 --- /dev/null +++ b/regtests/ww3_ufs1.1/input_unstr/ww3_grid_b.inp @@ -0,0 +1,327 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Grid preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Grid name (C*30, in quotes) +$ + 'GLOBAL' +$ +$ Frequency increment factor and first frequency (Hz) ---------------- $ +$ number of frequencies (wavenumbers) and directions, relative offset +$ of first direction in terms of the directional increment [-0.5,0.5]. +$ In versions 1.18 and 2.22 of the model this value was by definiton 0, +$ it is added to mitigate the GSE for a first order scheme. Note that +$ this factor is IGNORED in the print plots in ww3_outp. +$ + 1.07 0.035 33 36 0. +$ +$ Set model flags ---------------------------------------------------- $ +$ - FLDRY Dry run (input/output only, no calculation). +$ - FLCX, FLCY Activate X and Y component of propagation. +$ - FLCTH, FLCK Activate direction and wavenumber shifts. +$ - FLSOU Activate source terms. +$ + F T T T T T +$ +$ Set time steps ----------------------------------------------------- $ +$ - Time step information (this information is always read) +$ maximum global time step, maximum CFL time step for x-y and +$ k-theta, minimum source term time step (all in seconds). +$ +$ + 720. 360. 360. 30. +$ +$ Start of namelist input section ------------------------------------ $ +$ Starting with WAVEWATCH III version 2.00, the tunable parameters +$ for source terms, propagation schemes, and numerics are read using +$ namelists. Any namelist found in the folowing sections up to the +$ end-of-section identifier string (see below) is temporarily written +$ to ww3_grid.scratch, and read from there if necessary. Namelists +$ not needed for the given switch settings will be skipped +$ automatically, and the order of the namelists is immaterial. +$ +&SLN1 CLIN = 80.0, RFPM = 1.00, RFHF = 0.50 / +$ +&SIN4 ALPHA0=0.0095, + BETAMAX=1.33, + SINTHP=2.00, + Z0MAX=0.00, + ZALP=0.006, + ZWND=10.00, + TAUWSHELTER =1.00, + SWELLFPAR = 1, + SWELLF= 0.800, + SWELLF2=-0.018, + SWELLF3 =0.015, + SWELLF4 =100000.0, + SWELLF5 =1.200, + SWELLF6 =0.000, + SWELLF7 =230000.000, + Z0RAT =0.0400 / +$ +$ Implicit with ww3ifr code version +&UNST UGOBCAUTO = F, + UGOBCDEPTH= -10., + UGBCCFL= F, + EXPFSN = F, + EXPFSPSI = F, + EXPFSFCT = F, + IMPFSN = F, + EXPTOTAL = T, + IMPTOTAL = F, + IMPREFRACTION = F, + IMPFREQSHIFT = F, + IMPSOURCE = F, + SETUP_APPLY_WLV = F, + SOLVERTHR_SETUP=1E-14, + CRIT_DEP_SETUP=0.1, + JGS_NLEVEL = 0, + JGS_USE_JACOBI = F, + JGS_BLOCK_GAUSS_SEIDEL = F, + JGS_TERMINATE_MAXITER = F, + JGS_MAXITER = 1000, + JGS_TERMINATE_NORM = F, + JGS_TERMINATE_DIFFERENCE = F, + JGS_DIFF_THR = 1.E-8, + JGS_PMIN = 3.0, + JGS_LIMITER = F, + JGS_NORM_THR = 1.E-6 / +$ +$ Bottom friction - - - - - - - - - - - - - - - - - - - - - - - - - - +$ JONSWAP : Namelist SBT1 +$ GAMMA : As it says. +$ &SBT1 GAMMA = 0.15 / +$ +$ Propagation schemes ------------------------------------------------ $ +$ First order : Namelist PRO1 +$ CFLTM : Maximum CFL number for refraction. +$ +$ UQ with diffusion : Namelist PRO2 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ DTIME : Swell age (s) in garden sprinkler +$ correction. If 0., all diffusion +$ switched off. If small non-zero +$ (DEFAULT !!!) only wave growth +$ diffusion. +$ LATMIN : Maximum latitude used in calc. of +$ strength of diffusion for prop. +$ +$ UQ with averaging : Namelist PRO3 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ WDTHCG : Tuning factor propag. direction. +$ WDTHTH : Tuning factor normal direction. +$ +$ UQ with divergence : Namelist PRO4 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ QTFAC : Tuning factor Eq. (3.41). +$ RSFAC : Tuning factor Eq. (3.42). +$ RNFAC : Tuning factor Eq. (3.43). +$ +$ Miscellaneous ------------------------------------------------------ $ +$ Misc. parameters : Namelist MISC +$ CICE0 : Ice concentration cut-off. +$ CICEN : Ice concentration cut-off. +$ XSEED : Xseed in seeding alg. (!/SEED). +$ FLAGTR : Indicating presence and type of +$ subgrid information : +$ 0 : No subgrid information. +$ 1 : Transparancies at cell boun- +$ daries between grid points. +$ 2 : Transp. at cell centers. +$ 3 : Like 1 with cont. ice. +$ 4 : Like 2 with cont. ice. +$ XP, XR, XFILT +$ Xp, Xr and Xf for the dynamic +$ integration scheme. +$ +$ In the 'Out of the box' test setup we run with sub-grid obstacles +$ and with continuous ice treatment. +$ +$ +&SNL1 LAMBDA = 0.250, NLPROP = 0.250E+08, KDCONV = 0.750, KDMIN = 0.500, + SNLCS1 = 5.500, SNLCS2 = 0.833, SNLCS3 = -1.250 / +&SDS4 SDSBCHOICE = 1, SDSC2 = -0.2200E-04, SDSCUM = -0.4034E+00, + SDSC4 = 0.1000E+01, SDSC5 = 0.0000E+00, SDSC6 = 0.3000E+00, + WNMEANP =0.50, FXPM3 =4.00,FXFM3 =9.90, + SDSBINT = 0.3000E+00, SDSBCK = 0.0000E+00, SDSABK = 1.500, SDSPBK = 4.000, + SDSHCK = 1.50, SDSBR = 0.9000E-03, SDSSTRAIN = 0.000, + SDSP = 2.00, SDSISO = 2, SDSCOS =2.0, SDSDTH = 80.0, + SDSBRF1 = 0.50, SDSBRFDF = 0, + SDSBM0 = 1.00, SDSBM1 = 0.00, SDSBM2 = 0.00, SDSBM3 = 0.00, SDSBM4 = 0.00, +, WHITECAPWIDTH = 0.30/ +&SBT1 GAMMA = -0.6700E-01 / +&SDB1 BJALFA = 1.000, BJGAM = 0.730, BJFLAG = .TRUE. / +&PRO3 CFLTM = 0.70, WDTHCG = 1.50, WDTHTH = 1.50 / +&OUTS P2SF = 0, I1P2SF = 1, I2P2SF = 15, + US3D = 0, I1US3D = 1, I2US3D = 32, + E3D = 0, I1E3D = 1, I2E3D = 32, + TH1MF = 0, I1TH1M = 1, I2TH1M = 32, + STH1MF= 0, I1STH1M= 1, I2STH1M= 32, + TH2MF = 0, I1TH2M = 1, I2TH2M = 32, + STH2MF= 0, I1STH2M= 1, I2STH2M= 32, + E3D = 1, USSP = 1, IUSSP = 3, STK_WN = 0.04, 0.110, 0.3305 / +$ +$ +$AW021317 &MISC P2SF = 1 ,I1P2SF = 2, I2P2SF = 16 / +$&REF1 REFCOAST=0.1 / +$&REF1 REFCOAST=0.10, REFSLOPE=0.1, REFCOSP_STRAIGHT=4, REFFREQ=1., REFSUBGRID = 0.00 / +&REF1 REFCOAST=0.10, REFSLOPE=0.1, REFCOSP_STRAIGHT=4, REFFREQ=1., REFSUBGRID = 0.00 / +&SIN4 BETAMAX = 1.33 / +&MISC CICE0 = 0.250, CICEN = 0.750, LICE = 0.0, PMOVE = 0.500, + XSEED = 1.000, FLAGTR = 0, XP = 0.150, XR = 0.100, XFILT = 0.050 + IHM = 100, HSPM = 0.050, WSM = 1.700, WSC = 0.333, FLC = .TRUE. + NOSW = 3, FMICHE = 1.600, RWNDC = 1.000, + FACBERG = 1.0, GSHIFT = 0.000E+00 / +$&MISC CICE0 = 0.250, CICEN = 0.750, LICE = 0.0, PMOVE = 0.500, +$ XSEED = 1.000, FLAGTR = 4, XP = 0.150, XR = 0.100, XFILT = 0.050 +$ IHM = 100, HSPM = 0.050, WSM = 1.700, WSC = 0.333, FLC = .TRUE. +$ NOSW = 3, FMICHE = 1.600, RWNDC = 1.000, WCOR1 = 99.00, WCOR2 = 0.00, +$ FACBERG = 1.0, GSHIFT = 0.000E+00, STDX = -1.00, STDY = -1.00, +$ STDT = -1.00, ICEHMIN = 0.20, ICEHFAC = 1.00, +$ ICEHINIT = 0.50, ICEDISP = F, ICEHDISP = 0.60, +$ ICESLN = 1.00, ICEWIND = 1.00, ICESNL = 1.00, ICESDS = 1.00, +$ ICEDDISP = 80.00, ICEFDISP = 2.00, CALTYPE = standard , TRCKCMPR = T, +$ BTBET = 1.20 / +$ +$ Mandatory string to identify end of namelist input section. +$ +END OF NAMELISTS +$ +$ FLAG for grid features +$ 1 Type of grid 'UNST' 'RECT' 'CURV' +$ 2 Flag for geographical coordinates (LLG) +$ 3 Flag for periodic grid +$ +$ Define grid -------------------------------------------------------- $ +$ Four records containing : +$ 1 NX, NY. As the outer grid lines are always defined as land +$ points, the minimum size is 3x3. +$ 2 Grid increments SX, SY (degr.or m) and scaling (division) factor. +$ If NX*SX is 360., latitudinal closure is applied. +$ 3 Coordinates of (1,1) (degr.) and scaling (division) factor. +$ 4 Limiting bottom depth (m) to discriminate between land and sea +$ points, minimum water depth (m) as allowed in model, unit number +$ of file with bottom depths, scale factor for bottom depths (mult.), +$ IDLA, IDFM, format for formatted read, FROM and filename. +$ IDLA : Layout indicator : +$ 1 : Read line-by-line bottom to top. +$ 2 : Like 1, single read statement. +$ 3 : Read line-by-line top to bottom. +$ 4 : Like 3, single read statement. +$ IDFM : format indicator : +$ 1 : Free format. +$ 2 : Fixed format with above format descriptor. +$ 3 : Unformatted. +$ FROM : file type parameter +$ 'UNIT' : open file by unit number only. +$ 'NAME' : open file by name and assign to unit. +$ +$ Example for longitude-latitude grid (switch !/LLG), for Cartesian +$ grid the unit is meters (NOT km). +$ +$ + 'UNST' T T +$ + 4.0 0.30 20 -1. 4 1 '(20f10.2)' 'NAME' '../input_unstr/global_1deg_unstr.msh' +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed). +$ +$ 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +$ +$ If sub-grid information is avalaible as indicated by FLAGTR above, +$ additional input to define this is needed below. In such cases a +$ field of fractional obstructions at or between grid points needs to +$ be supplied. First the location and format of the data is defined +$ by (as above) : +$ - Unit number of file (can be 10, and/or identical to bottem depth +$ unit), scale factor for fractional obstruction, IDLA, IDFM, +$ format for formatted read, FROM and filename +$ +$ 10 0.2 3 1 '(....)' 'NAME' 'obstr.inp' +$ +$ *** NOTE if this unit number is the same as the previous bottom +$ depth unit number, it is assumed that this is the same file +$ without further checks. *** +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed, +$ except between the two fields). +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 5 5 5 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ *** NOTE size of fields is always NX * NY *** +$ + 10 3 1 '(....)' 'PART' 'mapsta.inp' +$ Input boundary points ---------------------------------------------- $ +$ An unlimited number of lines identifying points at which input +$ boundary conditions are to be defined. If the actual input data is +$ not defined in the actual wave model run, the initial conditions +$ will be applied as constant boundary conditions. Each line contains: +$ Discrete grid counters (IX,IY) of the active point and a +$ connect flag. If this flag is true, and the present and previous +$ point are on a grid line or diagonal, all intermediate points +$ are also defined as boundary points. +$ +$ are also defined as boundary points. +$ +$ Close list by defining point (0,0) (mandatory) +$ + 0 0 F +$ +$ +$ +$ Excluded grid points from segment data ( FROM != PART ) +$ First defined as lines, identical to the definition of the input +$ boundary points, and closed the same way. +$ + 0 0 F +$ +$ Second, define a point in a closed body of sea points to remove +$ the entire body os sea points. Also close by point (0,0) +$ + 0 0 +$ +$ Output boundary points --------------------------------------------- $ +$ Output boundary points are defined as a number of straight lines, +$ defined by its starting point (X0,Y0), increments (DX,DY) and number +$ of points. A negative number of points starts a new output file. +$ Note that this data is only generated if requested by the actual +$ program. Example again for spherical grid in degrees. +$ +$ -2.5312 48.5 0.00 0.008738 102 +$ -2.5312 49.3850 0.013554 0.00 51 +$ +$ Close list by defining line with 0 points (mandatory) +$ + 0. 0. 0. 0. 0 +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_ufs1.1/input_unstr/ww3_grid_b.nml b/regtests/ww3_ufs1.1/input_unstr/ww3_grid_b.nml new file mode 100644 index 000000000..e31a4eabb --- /dev/null +++ b/regtests/ww3_ufs1.1/input_unstr/ww3_grid_b.nml @@ -0,0 +1,61 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_grid.nml - Grid pre-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the spectrum parameterization via SPECTRUM_NML namelist +! -------------------------------------------------------------------- ! +&SPECTRUM_NML + SPECTRUM%XFR = 1.07 + SPECTRUM%FREQ1 = 0.035 + SPECTRUM%NK = 33 + SPECTRUM%NTH = 36 +/ + +! -------------------------------------------------------------------- ! +! Define the run parameterization via RUN_NML namelist +! -------------------------------------------------------------------- ! +&RUN_NML + RUN%FLCX = T + RUN%FLCY = T + RUN%FLCTH = T + RUN%FLCK = T + RUN%FLSOU = T +/ + +! -------------------------------------------------------------------- ! +! Define the timesteps parameterization via TIMESTEPS_NML namelist +! -------------------------------------------------------------------- ! +&TIMESTEPS_NML + TIMESTEPS%DTMAX = 720. + TIMESTEPS%DTXY = 360. + TIMESTEPS%DTKTH = 360. + TIMESTEPS%DTMIN = 30. +/ + +! -------------------------------------------------------------------- ! +! Define the grid to preprocess via GRID_NML namelist +! -------------------------------------------------------------------- ! +&GRID_NML + GRID%NAME = 'GLOBAL' + GRID%NML = '../input_unstr/namelists_b.nml' + GRID%TYPE = 'UNST' + GRID%COORD = 'SPHE' + GRID%CLOS = 'T' + GRID%ZLIM = 4.0 + GRID%DMIN = 0.30 +/ + +! -------------------------------------------------------------------- ! +! Define the unstructured grid type via UNST_NML namelist +! -------------------------------------------------------------------- ! +&UNST_NML + UNST%SF = -1. + UNST%FILENAME = '../input_unstr/global_1deg_unstr.msh' + UNST%IDLA = 4 + UNST%FORMAT = '(20f10.2)' +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ufs1.1/input_unstr/ww3_grid_c.inp b/regtests/ww3_ufs1.1/input_unstr/ww3_grid_c.inp new file mode 100644 index 000000000..32db4238d --- /dev/null +++ b/regtests/ww3_ufs1.1/input_unstr/ww3_grid_c.inp @@ -0,0 +1,326 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Grid preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Grid name (C*30, in quotes) +$ + 'GLOBAL' +$ +$ Frequency increment factor and first frequency (Hz) ---------------- $ +$ number of frequencies (wavenumbers) and directions, relative offset +$ of first direction in terms of the directional increment [-0.5,0.5]. +$ In versions 1.18 and 2.22 of the model this value was by definiton 0, +$ it is added to mitigate the GSE for a first order scheme. Note that +$ this factor is IGNORED in the print plots in ww3_outp. +$ + 1.07 0.035 50 36 0. +$ +$ Set model flags ---------------------------------------------------- $ +$ - FLDRY Dry run (input/output only, no calculation). +$ - FLCX, FLCY Activate X and Y component of propagation. +$ - FLCTH, FLCK Activate direction and wavenumber shifts. +$ - FLSOU Activate source terms. +$ + F T T T T T +$ +$ Set time steps ----------------------------------------------------- $ +$ - Time step information (this information is always read) +$ maximum global time step, maximum CFL time step for x-y and +$ k-theta, minimum source term time step (all in seconds). +$ +$ + 900. 900. 900. 900. +$ +$ Start of namelist input section ------------------------------------ $ +$ Starting with WAVEWATCH III version 2.00, the tunable parameters +$ for source terms, propagation schemes, and numerics are read using +$ namelists. Any namelist found in the folowing sections up to the +$ end-of-section identifier string (see below) is temporarily written +$ to ww3_grid.scratch, and read from there if necessary. Namelists +$ not needed for the given switch settings will be skipped +$ automatically, and the order of the namelists is immaterial. +$ +&SLN1 CLIN = 80.0, RFPM = 1.00, RFHF = 0.50 / +$ +&SIN4 ALPHA0=0.0095, + BETAMAX=1.33, + SINTHP=2.00, + Z0MAX=0.00, + ZALP=0.006, + ZWND=10.00, + TAUWSHELTER =1.00, + SWELLFPAR = 1, + SWELLF= 0.800, + SWELLF2=-0.018, + SWELLF3 =0.015, + SWELLF4 =100000.0, + SWELLF5 =1.200, + SWELLF6 =0.000, + SWELLF7 =230000.000, + Z0RAT =0.0400 / +$ +$ +$ Implicit with ww3ifr code version +&UNST +UGOBCAUTO = F +UGOBCDEPTH= -10. +EXPFSN = F, +EXPFSPSI = F, +EXPFSFCT = F, +IMPFSN = F, +EXPTOTAL = F, +IMPTOTAL = T, +IMPREFRACTION = T, +IMPFREQSHIFT = T, +IMPSOURCE = T, +SETUP_APPLY_WLV = F, +SOLVERTHR_SETUP=1E-14, +CRIT_DEP_SETUP=0.1, +JGS_USE_JACOBI = T, +JGS_BLOCK_GAUSS_SEIDEL = T, +JGS_TERMINATE_MAXITER = T, +JGS_MAXITER = 1000, +JGS_TERMINATE_NORM = F, +JGS_TERMINATE_DIFFERENCE = T, +JGS_DIFF_THR = 1.E-6, +JGS_PMIN = 3.0, +JGS_LIMITER = F, +JGS_NORM_THR = 1.E-6 / +$ Bottom friction - - - - - - - - - - - - - - - - - - - - - - - - - - +$ JONSWAP : Namelist SBT1 +$ GAMMA : As it says. +$ &SBT1 GAMMA = 0.15 / +$ +$ Propagation schemes ------------------------------------------------ $ +$ First order : Namelist PRO1 +$ CFLTM : Maximum CFL number for refraction. +$ +$ UQ with diffusion : Namelist PRO2 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ DTIME : Swell age (s) in garden sprinkler +$ correction. If 0., all diffusion +$ switched off. If small non-zero +$ (DEFAULT !!!) only wave growth +$ diffusion. +$ LATMIN : Maximum latitude used in calc. of +$ strength of diffusion for prop. +$ +$ UQ with averaging : Namelist PRO3 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ WDTHCG : Tuning factor propag. direction. +$ WDTHTH : Tuning factor normal direction. +$ +$ UQ with divergence : Namelist PRO4 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ QTFAC : Tuning factor Eq. (3.41). +$ RSFAC : Tuning factor Eq. (3.42). +$ RNFAC : Tuning factor Eq. (3.43). +$ +$ Miscellaneous ------------------------------------------------------ $ +$ Misc. parameters : Namelist MISC +$ CICE0 : Ice concentration cut-off. +$ CICEN : Ice concentration cut-off. +$ XSEED : Xseed in seeding alg. (!/SEED). +$ FLAGTR : Indicating presence and type of +$ subgrid information : +$ 0 : No subgrid information. +$ 1 : Transparancies at cell boun- +$ daries between grid points. +$ 2 : Transp. at cell centers. +$ 3 : Like 1 with cont. ice. +$ 4 : Like 2 with cont. ice. +$ XP, XR, XFILT +$ Xp, Xr and Xf for the dynamic +$ integration scheme. +$ +$ In the 'Out of the box' test setup we run with sub-grid obstacles +$ and with continuous ice treatment. +$ +$ +&SNL1 LAMBDA = 0.250, NLPROP = 0.250E+08, KDCONV = 0.750, KDMIN = 0.500, + SNLCS1 = 5.500, SNLCS2 = 0.833, SNLCS3 = -1.250 / +&SDS4 SDSBCHOICE = 1, SDSC2 = -0.2200E-04, SDSCUM = -0.4034E+00, + SDSC4 = 0.1000E+01, SDSC5 = 0.0000E+00, SDSC6 = 0.3000E+00, + WNMEANP =0.50, FXPM3 =4.00,FXFM3 =9.90, + SDSBINT = 0.3000E+00, SDSBCK = 0.0000E+00, SDSABK = 1.500, SDSPBK = 4.000, + SDSHCK = 1.50, SDSBR = 0.9000E-03, SDSSTRAIN = 0.000, + SDSP = 2.00, SDSISO = 2, SDSCOS =2.0, SDSDTH = 80.0, + SDSBRF1 = 0.50, SDSBRFDF = 0, + SDSBM0 = 1.00, SDSBM1 = 0.00, SDSBM2 = 0.00, SDSBM3 = 0.00, SDSBM4 = 0.00, +, WHITECAPWIDTH = 0.30/ +&SBT1 GAMMA = -0.6700E-01 / +&SDB1 BJALFA = 1.000, BJGAM = 0.730, BJFLAG = .TRUE. / +&PRO3 CFLTM = 0.70, WDTHCG = 1.50, WDTHTH = 1.50 / +&OUTS P2SF = 0, I1P2SF = 1, I2P2SF = 15, + US3D = 0, I1US3D = 1, I2US3D = 32, + E3D = 0, I1E3D = 1, I2E3D = 32, + TH1MF = 0, I1TH1M = 1, I2TH1M = 32, + STH1MF= 0, I1STH1M= 1, I2STH1M= 32, + TH2MF = 0, I1TH2M = 1, I2TH2M = 32, + STH2MF= 0, I1STH2M= 1, I2STH2M= 32, + E3D = 1, USSP = 1, IUSSP = 3, STK_WN = 0.04, 0.110, 0.3305 / +$ +$ +$AW021317 &MISC P2SF = 1 ,I1P2SF = 2, I2P2SF = 16 / +$&REF1 REFCOAST=0.1 / +$&REF1 REFCOAST=0.10, REFSLOPE=0.1, REFCOSP_STRAIGHT=4, REFFREQ=1., REFSUBGRID = 0.00 / +&REF1 REFCOAST=0.10, REFSLOPE=0.1, REFCOSP_STRAIGHT=4, REFFREQ=1., REFSUBGRID = 0.00 / +&SIN4 BETAMAX = 1.33 / +&MISC CICE0 = 0.250, CICEN = 0.750, LICE = 0.0, PMOVE = 0.500, + XSEED = 1.000, FLAGTR = 0, XP = 0.150, XR = 0.100, XFILT = 0.050 + IHM = 100, HSPM = 0.050, WSM = 1.700, WSC = 0.333, FLC = .TRUE. + NOSW = 3, FMICHE = 1.600, RWNDC = 1.000, + FACBERG = 1.0, GSHIFT = 0.000E+00 / +$&MISC CICE0 = 0.250, CICEN = 0.750, LICE = 0.0, PMOVE = 0.500, +$ XSEED = 1.000, FLAGTR = 4, XP = 0.150, XR = 0.100, XFILT = 0.050 +$ IHM = 100, HSPM = 0.050, WSM = 1.700, WSC = 0.333, FLC = .TRUE. +$ NOSW = 3, FMICHE = 1.600, RWNDC = 1.000, WCOR1 = 99.00, WCOR2 = 0.00, +$ FACBERG = 1.0, GSHIFT = 0.000E+00, STDX = -1.00, STDY = -1.00, +$ STDT = -1.00, ICEHMIN = 0.20, ICEHFAC = 1.00, +$ ICEHINIT = 0.50, ICEDISP = F, ICEHDISP = 0.60, +$ ICESLN = 1.00, ICEWIND = 1.00, ICESNL = 1.00, ICESDS = 1.00, +$ ICEDDISP = 80.00, ICEFDISP = 2.00, CALTYPE = standard , TRCKCMPR = T, +$ BTBET = 1.20 / +$ +$ Mandatory string to identify end of namelist input section. +$ +END OF NAMELISTS +$ +$ FLAG for grid features +$ 1 Type of grid 'UNST' 'RECT' 'CURV' +$ 2 Flag for geographical coordinates (LLG) +$ 3 Flag for periodic grid +$ +$ Define grid -------------------------------------------------------- $ +$ Four records containing : +$ 1 NX, NY. As the outer grid lines are always defined as land +$ points, the minimum size is 3x3. +$ 2 Grid increments SX, SY (degr.or m) and scaling (division) factor. +$ If NX*SX is 360., latitudinal closure is applied. +$ 3 Coordinates of (1,1) (degr.) and scaling (division) factor. +$ 4 Limiting bottom depth (m) to discriminate between land and sea +$ points, minimum water depth (m) as allowed in model, unit number +$ of file with bottom depths, scale factor for bottom depths (mult.), +$ IDLA, IDFM, format for formatted read, FROM and filename. +$ IDLA : Layout indicator : +$ 1 : Read line-by-line bottom to top. +$ 2 : Like 1, single read statement. +$ 3 : Read line-by-line top to bottom. +$ 4 : Like 3, single read statement. +$ IDFM : format indicator : +$ 1 : Free format. +$ 2 : Fixed format with above format descriptor. +$ 3 : Unformatted. +$ FROM : file type parameter +$ 'UNIT' : open file by unit number only. +$ 'NAME' : open file by name and assign to unit. +$ +$ Example for longitude-latitude grid (switch !/LLG), for Cartesian +$ grid the unit is meters (NOT km). +$ +$ + 'UNST' T T +$ + 4.0 0.30 20 -1. 4 1 '(20f10.2)' 'NAME' '../input_unstr/global_1deg_unstr.msh' +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed). +$ +$ 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +$ +$ If sub-grid information is avalaible as indicated by FLAGTR above, +$ additional input to define this is needed below. In such cases a +$ field of fractional obstructions at or between grid points needs to +$ be supplied. First the location and format of the data is defined +$ by (as above) : +$ - Unit number of file (can be 10, and/or identical to bottem depth +$ unit), scale factor for fractional obstruction, IDLA, IDFM, +$ format for formatted read, FROM and filename +$ +$ 10 0.2 3 1 '(....)' 'NAME' 'obstr.inp' +$ +$ *** NOTE if this unit number is the same as the previous bottom +$ depth unit number, it is assumed that this is the same file +$ without further checks. *** +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed, +$ except between the two fields). +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 5 5 5 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ *** NOTE size of fields is always NX * NY *** +$ + 10 3 1 '(....)' 'PART' 'mapsta.inp' +$ Input boundary points ---------------------------------------------- $ +$ An unlimited number of lines identifying points at which input +$ boundary conditions are to be defined. If the actual input data is +$ not defined in the actual wave model run, the initial conditions +$ will be applied as constant boundary conditions. Each line contains: +$ Discrete grid counters (IX,IY) of the active point and a +$ connect flag. If this flag is true, and the present and previous +$ point are on a grid line or diagonal, all intermediate points +$ are also defined as boundary points. +$ +$ are also defined as boundary points. +$ +$ Close list by defining point (0,0) (mandatory) +$ + 0 0 F +$ +$ +$ +$ Excluded grid points from segment data ( FROM != PART ) +$ First defined as lines, identical to the definition of the input +$ boundary points, and closed the same way. +$ + 0 0 F +$ +$ Second, define a point in a closed body of sea points to remove +$ the entire body os sea points. Also close by point (0,0) +$ + 0 0 +$ +$ Output boundary points --------------------------------------------- $ +$ Output boundary points are defined as a number of straight lines, +$ defined by its starting point (X0,Y0), increments (DX,DY) and number +$ of points. A negative number of points starts a new output file. +$ Note that this data is only generated if requested by the actual +$ program. Example again for spherical grid in degrees. +$ +$ -2.5312 48.5 0.00 0.008738 102 +$ -2.5312 49.3850 0.013554 0.00 51 +$ +$ Close list by defining line with 0 points (mandatory) +$ + 0. 0. 0. 0. 0 +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_ufs1.1/input_unstr/ww3_grid_c.nml b/regtests/ww3_ufs1.1/input_unstr/ww3_grid_c.nml new file mode 100644 index 000000000..9c68a4e31 --- /dev/null +++ b/regtests/ww3_ufs1.1/input_unstr/ww3_grid_c.nml @@ -0,0 +1,61 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_grid.nml - Grid pre-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the spectrum parameterization via SPECTRUM_NML namelist +! -------------------------------------------------------------------- ! +&SPECTRUM_NML + SPECTRUM%XFR = 1.07 + SPECTRUM%FREQ1 = 0.035 + SPECTRUM%NK = 50 + SPECTRUM%NTH = 36 +/ + +! -------------------------------------------------------------------- ! +! Define the run parameterization via RUN_NML namelist +! -------------------------------------------------------------------- ! +&RUN_NML + RUN%FLCX = T + RUN%FLCY = T + RUN%FLCTH = T + RUN%FLCK = T + RUN%FLSOU = T +/ + +! -------------------------------------------------------------------- ! +! Define the timesteps parameterization via TIMESTEPS_NML namelist +! -------------------------------------------------------------------- ! +&TIMESTEPS_NML + TIMESTEPS%DTMAX = 900. + TIMESTEPS%DTXY = 900. + TIMESTEPS%DTKTH = 900. + TIMESTEPS%DTMIN = 900. +/ + +! -------------------------------------------------------------------- ! +! Define the grid to preprocess via GRID_NML namelist +! -------------------------------------------------------------------- ! +&GRID_NML + GRID%NAME = 'GLOBAL' + GRID%NML = '../input_unstr/namelists_c.nml' + GRID%TYPE = 'UNST' + GRID%COORD = 'SPHE' + GRID%CLOS = 'T' + GRID%ZLIM = 4.0 + GRID%DMIN = 0.30 +/ + +! -------------------------------------------------------------------- ! +! Define the unstructured grid type via UNST_NML namelist +! -------------------------------------------------------------------- ! +&UNST_NML + UNST%SF = -1. + UNST%FILENAME = '../input_unstr/global_1deg_unstr.msh' + UNST%IDLA = 4 + UNST%FORMAT = '(20f10.2)' +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ufs1.1/input_unstr/ww3_ounf.inp b/regtests/ww3_ufs1.1/input_unstr/ww3_ounf.inp new file mode 100644 index 000000000..c721aeffc --- /dev/null +++ b/regtests/ww3_ufs1.1/input_unstr/ww3_ounf.inp @@ -0,0 +1,88 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Grid output post-processing $ +$--------------------------------------------------------------------- $ +$ First output time (yyyymmdd hhmmss), increment of output (s), +$ and number of output times. +$ + 20210401 000000 3600. 100 +$ +$ Fields requested --------------------------------------------------- $ +$ +$ Output request flags identifying fields as in ww3_shel.inp. See that +$ file for a full documentation of field output options. Namelist type +$ selection is used here (for alternative F/T flags, see ww3_shel.inp). +$ +$ DPT CUR WND AST WLV ICE IBG D50 IC1 IC5 HS LM T02 T0M1 T01 FP DIR SPR +$ DP HIG EF TH1M STH1M TH2M STH2M WN PHS PTP PLP PDIR PSPR PWS PDP +$ PQP PPE PGW PSW PTM10 PT01 PT02 PEP TWS PNR UST CHA CGE FAW TAW TWA WCC +$ WCF WCH WCM SXY TWO BHD FOC TUS USS P2S USF P2L TWI FIC ABR UBR BED +$ FBB TBB MSS MSC DTD FC CFX CFD CFK U1 U2 +$ + N + WND CUR ICE HS T01 T02 DIR FP DP PHS PTP PDIR UST CHA +$ +$--------------------------------------------------------------------- $ +$ netCDF version [3,4] +$ and variable type 4 [2 = SHORT, 3 = it depends , 4 = REAL] +$ swell partitions [0 1 2 3 4 5] +$ variables in same file [T] or not [F] +$ + 4 4 + 0 1 2 + T +$ +$ -------------------------------------------------------------------- $ +$ File prefix +$ number of characters in date [0(nodate),4(yearly),6(monthly),8(daily),10(hourly)] +$ IX and IY ranges [regular:IX NX IY NY, unstructured:IP NP 1 1] +$ + ww3. + 4 +$ +$ ----------------- FOR SMC GRID ONLY ---------------------------------$ +$ SMC output type: +$ 1 = Flat points file (1D sea point array) +$ 2 = Regular gridded (2D lat/lon array over region) +$ +$ 1 +$ +$ For SMC output, the IX/IY range line is replaced with a domain +$ lat/lon range and `cellfac` parameter for SMC type 2 output. +$ First/Last lat/lon can be set to -999.9 to use edge of SMC grid. +$ +$ For SMC type 1 output, only those points within the specified +$ lat/lon ranges will be extracted: +$ +$ first_lon, first_lat, last_lon, last_lat +$ +$ For type 2 output, the range is used in conjunction with a fifth +$ integer `cellfac` parameter to specify the regular output grid +$ to area average the SMC grid to. In this case, the output grid will +$ be aligned to nearest largest SMC grid points within the selected +$ region. Therefore, the output grid start and end lat/lons may differ +$ slightly from what is requested. In order to obtain a fully populated +$ regular grid the extents specified should encompass the SW corner of +$ the bottom left cell, and NE corner of the top right cell required. +$ `cellfac` is an integer value that selects the target grid cell size +$ as multiple of the smallest SMC grid cell. It must be a power of 2. +$ e.g. 1 = highest resolution, 2 = half resolution of smallest cell, +$ 4 = 1/4 res of smallest cell, etc. +$ +$ first_lon, first_lat, last_lon, last_lat, cellfac +$ +$ Example: Extract high resolution data for U.K.: +$ +$ -13.50 46.85 5.50 61.0 1 +$ +$ +$ ---------------- FOR NON-SMC GRIDS --------------------------------- $ +$ IX, IY range: + 1 2000000 1 1 3 2 +$ +$ For each field and time a new file is generated with the file name +$ ww3.date_xxx.nc , where date is a conventional time indicator with S3 +$ characters, and xxx is a field identifier. +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_ufs1.1/input_unstr/ww3_ounf.nml b/regtests/ww3_ufs1.1/input_unstr/ww3_ounf.nml new file mode 100644 index 000000000..2995d5883 --- /dev/null +++ b/regtests/ww3_ufs1.1/input_unstr/ww3_ounf.nml @@ -0,0 +1,37 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III ww3_prnc.nml - Field preprocessor ! +! -------------------------------------------------------------------- ! + + +! -------------------------------------------------------------------- ! +! Define the forcing fields to preprocess via FORCING_NML namelist +! -------------------------------------------------------------------- ! +&FORCING_NML +/ + +! -------------------------------------------------------------------- ! +! Define the content of the input file via FILE_NML namelist +! -------------------------------------------------------------------- ! +&FILE_NML + FILE%FILENAME = 4 4 + FILE%LONGITUDE = 'N' + FILE%LATITUDE = '' + FILE%VAR(1) = 'WND' + FILE%VAR(2) = 'CUR' + FILE%VAR(3) = 'ICE' + FILE%VAR(4) = 'HS' + FILE%VAR(5) = 'T01' + FILE%VAR(6) = 'T02' + FILE%VAR(7) = 'DIR' + FILE%VAR(8) = 'FP' + FILE%VAR(9) = 'DP' + FILE%VAR(10) = 'PHS' + FILE%VAR(11) = 'PTP' + FILE%VAR(12) = 'PDIR' + FILE%VAR(13) = 'UST' + FILE%VAR(14) = 'CHA' +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ufs1.1/input_unstr/ww3_ounp.inp b/regtests/ww3_ufs1.1/input_unstr/ww3_ounp.inp new file mode 100755 index 000000000..73375cfad --- /dev/null +++ b/regtests/ww3_ufs1.1/input_unstr/ww3_ounp.inp @@ -0,0 +1,118 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III NETCDF Point output post-processing $ +$--------------------------------------------------------------------- $ +$ First output time (yyyymmdd hhmmss), increment of output (s), +$ and number of output times. +$ + 20210401 000000 3600. 100 +$ +$ Points requested --------------------------------------------------- $ +$ +$ Define points index for which output is to be generated. +$ If no one defined, all points are selected +$ One index number per line, negative number identifies end of list. +$ +$ mandatory end of list + -1 +$ +$--------------------------------------------------------------------- $ +$ file prefix +$ number of characters in date [4(yearly),6(monthly),8(daily),10(hourly)] +$ netCDF version [3,4] +$ points in same file [T] or not [F] +$ and max number of points to be processed in one pass +$ output type ITYPE [0,1,2,3] +$ flag for global attributes WW3 [0] or variable version [1-2-3-4] +$ flag for dimensions order time,station [T] or station,time [F] +$ + ww3. + 2 + 4 + T 1 + 2 + 0 + T +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 0, inventory of file. +$ No additional input, the above time range is ignored. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 1, netCDF Spectra. +$ - Sub-type OTYPE : 1 : Print plots. +$ 2 : Table of 1-D spectra +$ 3 : Transfer file. +$ 4 : Spectral partitioning. +$ - Scaling factors for 1-D and 2-D spectra Negative factor +$ disables, output, factor = 0. gives normalized spectrum. +$ - Netcdf variable type [2=SHORT, 3=it depends, 4=REAL] +$ +$ 3 1 0 4 +$ +$ The transfer file contains records with the following contents. +$ +$ - File ID in quotes, number of frequencies, directions and points. +$ grid name in quotes (for unformatted file C*21,3I,C*30). +$ - Bin frequencies in Hz for all bins. +$ - Bin directions in radians for all bins (Oceanographic conv.). +$ -+ +$ - Time in yyyymmdd hhmmss format | loop +$ -+ | +$ - Point name (C*40), lat, lon, d, U10 and | loop | over +$ direction, current speed and direction | over | +$ - E(f,theta) | points | times +$ -+ -+ +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 2, netCDF Tables of (mean) parameter +$ - Sub-type OTYPE : 1 : Depth, current, wind +$ 2 : Mean wave pars. +$ 3 : Nondimensional pars. (U*) +$ 4 : Nondimensional pars. (U10) +$ 5 : 'Validation table' +$ 6 : WMO standard output + 2 +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 3, netCDF Source terms +$ - Sub-type OTYPE : 1 : Print plots. +$ 2 : Table of 1-D S(f). +$ 3 : Table of 1-D inverse time scales +$ (1/T = S/F). +$ 4 : Transfer file +$ - Scaling factors for 1-D and 2-D source terms. Negative +$ factor disables print plots, factor = 0. gives normalized +$ print plots. +$ - Flags for spectrum, input, interactions, dissipation, +$ bottom, ice and total source term. +$ - scale ISCALE for OTYPE=2,3 +$ 0 : Dimensional. +$ 1 : Nondimensional in terms of U10 +$ 2 : Nondimensional in terms of U* +$ 3-5: like 0-2 with f normalized with fp. +$ +$ 4 0 0 T T T T T T T 0 +$ +$ The transfer file contains records with the following contents. +$ +$ - File ID in quotes, number of frequencies, directions and points, +$ flags for spectrum and source terms (C*21, 3I, 6L) +$ - Bin frequencies in Hz for all bins. +$ - Bin directions in radians for all bins (Oceanographic conv.). +$ -+ +$ - Time in yyyymmdd hhmmss format | loop +$ -+ | +$ - Point name (C*40), depth, wind speed and | loop | over +$ direction, current speed and direction | over | +$ - E(f,theta) if requested | points | times +$ - Sin(f,theta) if requested | | +$ - Snl(f,theta) if requested | | +$ - Sds(f,theta) if requested | | +$ - Sbt(f,theta) if requested | | +$ - Sice(f,theta) if requested | | +$ - Stot(f,theta) if requested | | +$ -+ -+ +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_ufs1.1/input_unstr/ww3_ounp.nml b/regtests/ww3_ufs1.1/input_unstr/ww3_ounp.nml new file mode 100644 index 000000000..4abd0cd4c --- /dev/null +++ b/regtests/ww3_ufs1.1/input_unstr/ww3_ounp.nml @@ -0,0 +1,24 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III ww3_prnc.nml - Field preprocessor ! +! -------------------------------------------------------------------- ! + + +! -------------------------------------------------------------------- ! +! Define the forcing fields to preprocess via FORCING_NML namelist +! -------------------------------------------------------------------- ! +&FORCING_NML +/ + +! -------------------------------------------------------------------- ! +! Define the content of the input file via FILE_NML namelist +! -------------------------------------------------------------------- ! +&FILE_NML + FILE%FILENAME = 2 + FILE%LONGITUDE = '-1' + FILE%LATITUDE = '' + FILE%VAR(1) = 'ww3.' +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ufs1.1/input_unstr/ww3_points.list b/regtests/ww3_ufs1.1/input_unstr/ww3_points.list new file mode 100644 index 000000000..62dfcd78b --- /dev/null +++ b/regtests/ww3_ufs1.1/input_unstr/ww3_points.list @@ -0,0 +1,240 @@ + -85.078 -19.425 '32012 ' -1 DAT WHOI 360 4534 + -90.000 -55.000 '34002 ' 6.2 DAT OCOBSI 360 4800 + -72.522 34.502 '41001 ' 4 DAT NDBC 360 4556 + -74.930 31.892 '41002 ' 4 DAT NDBC 360 3920 + -79.099 32.501 '41004 ' 4 DAT NDBC 360 39 + -80.868 31.400 '41008 ' 5 DAT NDBC 360 14.9 + -80.185 28.508 '41009 ' 4 DAT NDBC 360 42 + -78.485 28.878 '41010 ' 4 DAT NDBC 360 890 + -77.743 33.436 '41013 ' 4 DAT NDBC 360 23.5 + -78.477 33.837 '41024 ' 2.95 DAT CORMP 360 10 + -75.363 35.025 '41025 ' 4 DAT NDBC 360 59.4 + -79.624 32.803 '41029 ' 2.95 DAT CORMP 360 10 + -80.406 32.279 '41033 ' 2.95 DAT CORMP 360 10 + -77.362 33.988 '41037 ' 2.95 DAT CORMP 360 30 + -77.715 34.141 '41038 ' 2.95 DAT CORMP 360 18 + -53.045 14.554 '41040 ' 4 DAT NDBC 360 5112 + -46.093 14.311 '41041 ' 4 DAT NDBC 360 3595 + -64.830 21.124 '41043 ' 4 DAT NDBC 360 5271 + -58.630 21.582 '41044 ' 4 DAT NDBC 360 5419 + -68.384 23.822 '41046 ' 4 DAT NDBC 360 5549 + -71.494 27.514 '41047 ' 4 DAT NDBC 360 5321 + -69.585 31.838 '41048 ' 4 DAT NDBC 360 5340 + -62.938 27.490 '41049 ' 4 DAT NDBC 360 5459 + -65.004 18.257 '41051 ' 4 DAT CARICOOS 360 32 + -64.763 18.249 '41052 ' 4 DAT CARICOOS 360 44 + -65.464 18.261 '41056 ' 4 DAT CARICOOS 360 30 + -65.157 18.476 '41058 ' 4 DAT CARICOOS 360 40 + -51.017 14.824 '41060 ' -1 DAT WHOI 360 5021 + -75.095 35.778 '41062 ' 3.5 DAT UNC 360 36 + -75.941 34.782 '41063 ' 3.5 DAT UNC 360 30 + -76.949 34.207 '41064 ' 2.95 DAT CORMP 360 30 + -78.015 33.721 '41108 ' -1 DAT SIO 360 12.8 + -77.717 34.141 '41110 ' -1 DAT CORMP 360 17 + -81.292 30.709 '41112 ' -1 DAT SIO 360 15.54 + -80.534 28.400 '41113 ' -1 DAT SIO 360 9.8 + -80.188 28.523 '41116 ' -1 DAT SIO 360 41 + -81.080 30.000 '41117 ' -1 DAT USACE 360 24.4 + -80.590 28.609 '41118 ' -1 DAT SIO 360 7.3 + -78.483 33.842 '41119 ' -1 DAT CORMP 360 13 + -76.946 34.213 '41159 ' -1 DAT CORMP 360 30.5 + -89.650 25.961 '42001 ' 3.6 DAT NDBC 360 3334 + -93.758 26.091 '42002 ' 5 DAT NDBC 360 3125.1 + -85.615 25.925 '42003 ' 4 DAT NDBC 360 3265 + -87.551 30.064 '42012 ' 4 DAT NDBC 360 25.9 + -95.350 27.906 '42019 ' 5 DAT NDBC 360 82.2 + -96.693 26.968 '42020 ' 4 DAT NDBC 360 84.1 + -83.741 27.505 '42022 ' 3.1 DAT COMPS 360 50 + -83.086 26.010 '42023 ' 3.1 DAT COMPS 360 50 + -83.475 25.171 '42026 ' 3.2 DAT COMPS 360 70 + -94.413 29.232 '42035 ' 4 DAT NDBC 360 16.2 + -84.516 28.501 '42036 ' 4 DAT NDBC 360 49.7 + -86.008 28.788 '42039 ' 4 DAT NDBC 360 270 + -88.226 29.208 '42040 ' 4 DAT NDBC 360 183 + -94.899 28.982 '42043 ' 4 DAT TAMUNI 360 19 + -96.500 26.217 '42045 ' 4 DAT TAMUNI 360 62 + -94.037 27.890 '42046 ' 4 DAT TAMUNI 360 105 + -93.597 27.897 '42047 ' 4 DAT TAMUNI 360 89 + -93.941 22.124 '42055 ' 4 DAT NDBC 360 3624 + -84.946 19.812 '42056 ' 4 DAT NDBC 360 4565 + -81.422 16.908 '42057 ' 4 DAT NDBC 360 377 + -74.560 14.775 '42058 ' 4 DAT NDBC 360 4150 + -67.483 15.252 '42059 ' 4 DAT NDBC 360 4784 + -63.354 16.413 '42060 ' 4 DAT NDBC 360 1507 + -81.251 24.500 '42078 ' -1 DAT CDIP 360 170 + -81.242 24.535 '42079 ' -1 DAT CDIP 360 99 + -66.532 17.869 '42085 ' 4 DAT CARICOOS 360 18.9 + -60.848 11.185 '42087 ' 3.35 DAT ICON 360 1266 + -60.521 11.301 '42088 ' 3.35 DAT ICON 360 1266 + -80.061 19.699 '42089 ' 3.35 DAT ICON 360 5726 + -69.580 18.432 '42090 ' 3.35 DAT ICON 360 1188 + -81.967 24.407 '42095 ' -1 DAT USACE 360 100 + -83.650 25.700 '42097 ' -1 DAT USACE 360 81 + -84.275 27.345 '42099 ' -1 DAT SIO 360 93.9 + -90.459 26.689 '42360 ' 3 DAT MURPHY 360 2539.9 + -92.490 27.550 '42361 ' 122 DAT SHELL 360 871.7 + -90.648 27.795 '42362 ' 122 DAT ENVEN 360 910 + -89.220 28.160 '42363 ' 122 DAT SHELL 360 894 + -88.090 29.060 '42364 ' 122 DAT SHELL 360 980.2 + -90.283 27.207 '42369 ' 60.4 DAT BP 360 1371.9 + -88.289 28.521 '42375 ' 61 DAT BP 360 1920.2 + -94.898 26.129 '42390 ' -1 DAT SHELL 360 2382.6 + -90.027 27.196 '42392 ' -1 DAT BP 360 2156.16 + -89.240 28.157 '42394 ' 100 DAT SHELL 360 923.5 + -90.792 26.404 '42395 ' 3 DAT SHELL 360 2941.9 + -125.032 10.051 '43010 ' -1 DAT WHOI 360 4769 + -69.128 43.201 '44005 ' 5 DAT NDBC 360 180.7 + -70.141 43.525 '44007 ' 5 DAT NDBC 360 26.5 + -69.248 40.504 '44008 ' 4 DAT NDBC 360 74.7 + -74.702 38.457 '44009 ' 5 DAT NDBC 360 30 + -66.588 41.070 '44011 ' 4 DAT NDBC 360 88.4 + -70.651 42.346 '44013 ' 5 DAT NDBC 360 64 + -74.840 36.606 '44014 ' 5 DAT NDBC 360 47 + -72.049 40.693 '44017 ' 5 DAT NDBC 360 48 + -70.143 42.206 '44018 ' 5 DAT NDBC 360 41.5 + -70.279 41.493 '44020 ' 4 DAT NDBC 360 14.3 + -73.728 40.883 '44022 ' 3.5 DAT UCT 360 22.5 + -65.912 42.327 '44024 ' 4 DAT NRCOOS 360 225 + -73.164 40.251 '44025 ' 5 DAT NDBC 360 36.3 + -67.300 44.283 '44027 ' 5 DAT NDBC 360 185.3 + -70.566 42.523 '44029 ' 4 DAT NRCOOS 360 65 + -70.426 43.179 '44030 ' 4 DAT NRCOOS 360 62 + -69.355 43.715 '44032 ' 4 DAT NRCOOS 360 100 + -68.996 44.055 '44033 ' 4 DAT NRCOOS 360 110 + -68.112 44.103 '44034 ' 4 DAT NRCOOS 360 100 + -67.876 43.497 '44037 ' 4 DAT NRCOOS 360 285 + -73.580 40.956 '44040 ' 3.5 DAT UCT 360 18.3 + -75.715 36.199 '44056 ' -1 DAT USACE 360 17.4 + -73.703 40.369 '44065 ' 4 DAT NDBC 360 25 + -72.644 39.618 '44066 ' 4 DAT NDBC 360 78 + -73.087 40.699 '44069 ' 3 DAT SBROOKU 360 46 + -70.540 43.020 '44073 ' 2.6 DAT UNH 360 131 + -75.421 36.001 '44086 ' -1 DAT SIO 360 21 + -74.838 36.612 '44088 ' -1 DAT SIO 360 47 + -75.334 37.757 '44089 ' -1 DAT USACE 360 16.9 + -70.329 41.840 '44090 ' -1 DAT USGS 360 26 + -73.769 39.778 '44091 ' -1 DAT USACE 360 25.6 + -75.492 36.872 '44093 ' -1 DAT SIO 360 26.82 + -75.330 35.750 '44095 ' -1 DAT SIO 360 18.3 + -75.809 37.023 '44096 ' -1 DAT SIO 360 11.9 + -71.127 40.969 '44097 ' -1 DAT SIO 360 48.16 + -70.168 42.798 '44098 ' -1 DAT SIO 360 76.5 + -75.720 36.914 '44099 ' -1 DAT SIO 360 18.3 + -75.594 36.260 '44100 ' -1 DAT SIO 360 25.9 + -62.000 42.260 '44137 ' 5 DAT ENCAN 360 4000 + -57.100 44.240 '44139 ' 5 DAT ENCAN 360 1500 + -64.020 42.500 '44150 ' 5 DAT ENCAN 360 1300 + -63.400 44.500 '44258 ' 5 DAT ENCAN 360 58 + -147.949 56.232 '46001 ' 5 DAT NDBC 360 4054 + -130.537 42.612 '46002 ' 4 DAT NDBC 360 3413 + -136.100 50.930 '46004 ' 5 DAT ENCAN 360 3600 + -131.079 46.134 '46005 ' 4 DAT NDBC 360 2852 + -137.397 40.782 '46006 ' 4 DAT NDBC 360 4378 + -121.019 34.956 '46011 ' 5 DAT NDBC 360 464.8 + -160.000 57.700 '46021 ' -1 DAT NDBC 360 59 + -120.967 34.714 '46023 ' 10 DAT NDBC 360 384.1 + -119.200 33.000 '46024 ' -1 DAT NDBC 360 1213 + -119.053 33.763 '46025 ' 4 DAT NDBC 360 888 + -121.857 35.703 '46028 ' 5 DAT NDBC 360 1048 + -177.708 57.018 '46035 ' 5 DAT NDBC 360 3687 + -122.398 36.785 '46042 ' 5 DAT NDBC 360 1645.9 + -119.506 32.404 '46047 ' 4 DAT NDBC 360 1394 + -120.477 34.265 '46054 ' 4 DAT NDBC 360 469.4 + -129.951 38.094 '46059 ' 4 DAT NDBC 360 4628 + -146.805 60.584 '46060 ' 5 DAT NDBC 360 445 + -154.987 52.765 '46066 ' 5 DAT NDBC 360 4460 + -120.213 33.677 '46069 ' 4 DAT NDBC 360 977.8 + 175.153 55.082 '46070 ' 5 DAT NDBC 360 3835 + 179.012 51.125 '46071 ' 5 DAT NDBC 360 1681 + -172.088 51.672 '46072 ' 5 DAT NDBC 360 3572 + -172.001 55.031 '46073 ' 5 DAT NDBC 360 3051.5 + -160.817 53.983 '46075 ' 5 DAT NDBC 360 2392.7 + -147.990 59.502 '46076 ' 5 DAT NDBC 360 195.1 + -152.582 55.556 '46078 ' 5 DAT NDBC 360 5380 + -150.042 57.947 '46080 ' 5 DAT NDBC 360 254.5 + -143.372 59.681 '46082 ' 5 DAT NDBC 360 300 + -137.997 58.300 '46083 ' 5 DAT NDBC 360 136 + -136.102 56.622 '46084 ' 5 DAT NDBC 360 1158 + -142.882 55.883 '46085 ' 4 DAT NDBC 360 3721 + -118.052 32.499 '46086 ' 4 DAT NDBC 360 1844.7 + -125.771 45.925 '46089 ' 5 DAT NDBC 360 2293.3 + -122.029 36.751 '46092 ' 4 DAT MBARI 360 1000 + -122.351 36.723 '46114 ' -1 DAT SIO 360 1463 + -131.220 51.830 '46147 ' 5 DAT ENCAN 360 2000 + -131.100 53.620 '46183 ' 5 DAT ENCAN 360 65 + -138.850 53.910 '46184 ' 5 DAT ENCAN 360 3200 + -129.790 52.420 '46185 ' 5 DAT ENCAN 360 230 + -128.770 51.380 '46204 ' -1 DAT ENCAN 360 222 + -134.320 54.190 '46205 ' 5 DAT ENCAN 360 2675 + -126.000 48.840 '46206 ' 5 DAT ENCAN 360 72 + -129.920 50.870 '46207 ' 5 DAT ENCAN 360 2125 + -132.690 52.520 '46208 ' 5 DAT ENCAN 360 2950 + -123.472 37.950 '46214 ' -1 DAT SIO 360 550 + -120.783 34.454 '46218 ' -1 DAT SIO 360 548.6 + -119.882 33.225 '46219 ' -1 DAT SIO 360 274.3 + -118.634 33.855 '46221 ' -1 DAT SIO 360 370 + -118.317 33.618 '46222 ' -1 DAT SIO 360 457 + -117.391 32.933 '46225 ' -1 DAT SIO 360 549 + -117.370 32.747 '46231 ' -1 DAT SIO 360 201.17 + -117.421 32.530 '46232 ' -1 DAT SIO 360 1143 + -117.169 32.570 '46235 ' -1 DAT SIO 360 21 + -122.096 36.343 '46239 ' -1 DAT SIO 360 369 + -145.200 50.033 '46246 ' -1 DAT SIO 360 4252 + -119.559 33.761 '46251 ' -1 DAT SIO 360 1920 + -118.181 33.576 '46253 ' -1 DAT SIO 360 66 + -117.267 32.868 '46254 ' -1 DAT SIO 360 38.71 + -119.651 33.400 '46255 ' -1 DAT SIO 360 105 + -118.201 33.700 '46256 ' -1 DAT SIO 360 23.25 + -120.766 34.439 '46257 ' -1 DAT SIO 360 576.07 + -117.501 32.752 '46258 ' -1 DAT SIO 360 588.6 + -121.497 34.767 '46259 ' -1 DAT USACE 360 646.8 + -119.004 33.704 '46262 ' -1 DAT SIO 360 905 + -151.695 57.479 '46264 ' -1 DAT SIO 360 86 + -165.475 64.473 '46265 ' -1 DAT SIO 360 18.2 + -153.781 23.535 '51000 ' 5 DAT NDBC 360 4811 + -162.000 24.453 '51001 ' 4 DAT NDBC 360 4895 + -157.742 17.043 '51002 ' 4 DAT NDBC 360 4948 + -160.662 19.172 '51003 ' 4 DAT NDBC 360 4943.3 + -152.364 17.604 '51004 ' 4 DAT NDBC 360 4998 + -162.075 24.361 '51101 ' 4 DAT NDBC 360 4849 + -158.117 21.671 '51201 ' -1 DAT SIO 360 200 + -157.678 21.415 '51202 ' -1 DAT SIO 360 89 + -157.010 20.788 '51203 ' -1 DAT SIO 360 201 + -158.124 21.281 '51204 ' -1 DAT SIO 360 300 + -156.425 21.018 '51205 ' -1 DAT SIO 360 200 + -154.970 19.780 '51206 ' -1 DAT SIO 360 345 + -157.752 21.477 '51207 ' -1 DAT SIO 360 81 + -159.574 22.285 '51208 ' -1 DAT SIO 360 200 + -170.493 -14.264 '51209 ' -1 DAT SIO 360 82 + -157.756 21.477 '51210 ' -1 DAT SIO 360 80 + -157.959 21.297 '51211 ' -1 DAT SIO 360 35 + -158.149 21.323 '51212 ' -1 DAT SIO 360 280 + -157.003 20.750 '51213 ' -1 DAT SIO 360 235 + 144.788 13.354 '52200 ' -1 DAT SIO 360 200 + 171.392 7.083 '52201 ' -1 DAT SIO 360 540 + 144.812 13.684 '52202 ' -1 DAT SIO 360 510 + 145.662 15.268 '52211 ' -1 DAT SIO 360 487.68 + 134.667 7.630 '52212 ' -1 DAT SIO 360 97 + -5.000 45.230 '62001 ' 3 DAT UKMO 360 4556 + -12.430 48.720 '62029 ' 3 DAT UKMO 360 3575 + -4.400 50.000 '62050 ' -1 DAT UKMO 360 53 + -2.900 49.900 '62103 ' 14 DAT UKMO 360 18 + -12.570 55.420 '62105 ' 3 DAT UKMO 360 2899 + -6.100 50.102 '62107 ' 14 DAT UKMO 360 61 + 0.000 58.300 '62114 ' -1 DAT PRIVATE 360 142 + 0.700 54.000 '62127 ' -1 DAT PRIVATE 360 39 + 1.700 53.400 '62144 ' -1 DAT PRIVATE 360 16 + 2.800 53.102 '62145 ' -1 DAT PRIVATE 360 26 + 2.100 57.200 '62146 ' -1 DAT PRIVATE 360 98 + 1.500 53.600 '62148 ' -1 DAT PRIVATE 360 16 + 1.100 53.700 '62149 ' -1 DAT PRIVATE 360 16 + -8.470 47.550 '62163 ' 3 DAT UKMO 360 4000 + 1.100 54.000 '62165 ' -1 DAT PRIVATE 360 41 + 0.000 50.400 '62305 ' 14 DAT UKMO 360 39 + 1.500 59.500 '63110 ' -1 DAT PRIVATE 360 117 + 1.000 61.100 '63112 ' -1 DAT PRIVATE 360 156 + 1.708 61.000 '63113 ' -1 DAT PRIVATE 360 156 + 1.300 61.600 '63115 ' -1 DAT PRIVATE 360 156 + 1.100 61.400 '63117 ' -1 DAT PRIVATE 360 156 + -11.420 59.070 '64045 ' 3 DAT UKMO 360 1935 + -4.167 60.483 '64046 ' 3 DAT UKMO 360 230 diff --git a/regtests/ww3_ufs1.1/input_unstr/ww3_prnc_current.inp b/regtests/ww3_ufs1.1/input_unstr/ww3_prnc_current.inp new file mode 100755 index 000000000..eb1ce3e73 --- /dev/null +++ b/regtests/ww3_ufs1.1/input_unstr/ww3_prnc_current.inp @@ -0,0 +1,51 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Field preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Mayor types of field and time flag +$ Field types : ICE Ice concentrations. +$ LEV Water levels. +$ WND Winds. +$ WNS Winds (including air-sea temp. dif.) +$ CUR Currents. +$ DAT Data for assimilation. +$ +$ Format types : AI Transfer field 'as is'. (ITYPE 1) +$ LL Field defined on regular longitude-latitude +$ or Cartesian grid. (ITYPE 2) +$ Format types : AT Transfer field 'as is', performs tidal +$ analysis on the time series (ITYPE 6) +$ When using AT, another line should be added +$ with the choice ot tidal constituents: +$ ALL or FAST or VFAST or a list: e.g. 'M2 S2' +$ +$ - Format type not used for field type 'DAT'. +$ +$ Time flag : If true, time is included in file. +$ Header flag : If true, header is added to file. +$ (necessary for reading, FALSE is used only for +$ incremental generation of a data file.) +$ + 'CUR' 'LL' T T +$ +$ Name of dimensions ------------------------------------------------- $ +$ + longitude latitude time +$ +$ Variables to use --------------------------------------------------- $ +$ + ucur vcur +$ +$ Additional time input ---------------------------------------------- $ +$ If time flag is .FALSE., give time of field in yyyymmdd hhmmss format. +$ +$ 19680606 053000 +$ +$ Define data files -------------------------------------------------- $ +$ The input line identifies the filename using for the forcing field. +$ + '../input/current.nc' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ + diff --git a/regtests/ww3_ufs1.1/input_unstr/ww3_prnc_current.nml b/regtests/ww3_ufs1.1/input_unstr/ww3_prnc_current.nml new file mode 100644 index 000000000..b3e0b3009 --- /dev/null +++ b/regtests/ww3_ufs1.1/input_unstr/ww3_prnc_current.nml @@ -0,0 +1,27 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III ww3_prnc.nml - Field preprocessor ! +! -------------------------------------------------------------------- ! + + +! -------------------------------------------------------------------- ! +! Define the forcing fields to preprocess via FORCING_NML namelist +! -------------------------------------------------------------------- ! +&FORCING_NML + FORCING%FIELD%CURRENTS = T + FORCING%GRID%LATLON = T +/ + +! -------------------------------------------------------------------- ! +! Define the content of the input file via FILE_NML namelist +! -------------------------------------------------------------------- ! +&FILE_NML + FILE%FILENAME = '../input/current.nc' + FILE%LONGITUDE = 'longitude' + FILE%LATITUDE = 'latitude' + FILE%VAR(1) = 'ucur' + FILE%VAR(2) = 'vcur' +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ufs1.1/input_unstr/ww3_prnc_ice.inp b/regtests/ww3_ufs1.1/input_unstr/ww3_prnc_ice.inp new file mode 100755 index 000000000..a38e0d4b6 --- /dev/null +++ b/regtests/ww3_ufs1.1/input_unstr/ww3_prnc_ice.inp @@ -0,0 +1,51 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Field preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Mayor types of field and time flag +$ Field types : ICE Ice concentrations. +$ LEV Water levels. +$ WND Winds. +$ WNS Winds (including air-sea temp. dif.) +$ CUR Currents. +$ DAT Data for assimilation. +$ +$ Format types : AI Transfer field 'as is'. (ITYPE 1) +$ LL Field defined on regular longitude-latitude +$ or Cartesian grid. (ITYPE 2) +$ Format types : AT Transfer field 'as is', performs tidal +$ analysis on the time series (ITYPE 6) +$ When using AT, another line should be added +$ with the choice ot tidal constituents: +$ ALL or FAST or VFAST or a list: e.g. 'M2 S2' +$ +$ - Format type not used for field type 'DAT'. +$ +$ Time flag : If true, time is included in file. +$ Header flag : If true, header is added to file. +$ (necessary for reading, FALSE is used only for +$ incremental generation of a data file.) +$ + 'ICE' 'LL' T T +$ +$ Name of dimensions ------------------------------------------------- $ +$ + longitude latitude time +$ +$ Variables to use --------------------------------------------------- $ +$ + ice +$ +$ Additional time input ---------------------------------------------- $ +$ If time flag is .FALSE., give time of field in yyyymmdd hhmmss format. +$ +$ 19680606 053000 +$ +$ Define data files -------------------------------------------------- $ +$ The input line identifies the filename using for the forcing field. +$ + '../input/ice.nc' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ + diff --git a/regtests/ww3_ufs1.1/input_unstr/ww3_prnc_ice.nml b/regtests/ww3_ufs1.1/input_unstr/ww3_prnc_ice.nml new file mode 100644 index 000000000..7a0efea35 --- /dev/null +++ b/regtests/ww3_ufs1.1/input_unstr/ww3_prnc_ice.nml @@ -0,0 +1,26 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III ww3_prnc.nml - Field preprocessor ! +! -------------------------------------------------------------------- ! + + +! -------------------------------------------------------------------- ! +! Define the forcing fields to preprocess via FORCING_NML namelist +! -------------------------------------------------------------------- ! +&FORCING_NML + FORCING%FIELD%ICE_CONC = T + FORCING%GRID%LATLON = T +/ + +! -------------------------------------------------------------------- ! +! Define the content of the input file via FILE_NML namelist +! -------------------------------------------------------------------- ! +&FILE_NML + FILE%FILENAME = '../input/ice.nc' + FILE%LONGITUDE = 'longitude' + FILE%LATITUDE = 'latitude' + FILE%VAR(1) = 'ice' +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ufs1.1/input_unstr/ww3_prnc_wind.inp b/regtests/ww3_ufs1.1/input_unstr/ww3_prnc_wind.inp new file mode 100755 index 000000000..25d28f6d0 --- /dev/null +++ b/regtests/ww3_ufs1.1/input_unstr/ww3_prnc_wind.inp @@ -0,0 +1,51 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Field preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Mayor types of field and time flag +$ Field types : ICE Ice concentrations. +$ LEV Water levels. +$ WND Winds. +$ WNS Winds (including air-sea temp. dif.) +$ CUR Currents. +$ DAT Data for assimilation. +$ +$ Format types : AI Transfer field 'as is'. (ITYPE 1) +$ LL Field defined on regular longitude-latitude +$ or Cartesian grid. (ITYPE 2) +$ Format types : AT Transfer field 'as is', performs tidal +$ analysis on the time series (ITYPE 6) +$ When using AT, another line should be added +$ with the choice ot tidal constituents: +$ ALL or FAST or VFAST or a list: e.g. 'M2 S2' +$ +$ - Format type not used for field type 'DAT'. +$ +$ Time flag : If true, time is included in file. +$ Header flag : If true, header is added to file. +$ (necessary for reading, FALSE is used only for +$ incremental generation of a data file.) +$ + 'WND' 'LL' T T +$ +$ Name of dimensions ------------------------------------------------- $ +$ + longitude latitude time +$ +$ Variables to use --------------------------------------------------- $ +$ + uwnd vwnd +$ +$ Additional time input ---------------------------------------------- $ +$ If time flag is .FALSE., give time of field in yyyymmdd hhmmss format. +$ +$ 19680606 053000 +$ +$ Define data files -------------------------------------------------- $ +$ The input line identifies the filename using for the forcing field. +$ + '../input/gfs_wind.nc' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ + diff --git a/regtests/ww3_ufs1.1/input_unstr/ww3_prnc_wind.nml b/regtests/ww3_ufs1.1/input_unstr/ww3_prnc_wind.nml new file mode 100644 index 000000000..b2e7b5ec6 --- /dev/null +++ b/regtests/ww3_ufs1.1/input_unstr/ww3_prnc_wind.nml @@ -0,0 +1,27 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III ww3_prnc.nml - Field preprocessor ! +! -------------------------------------------------------------------- ! + + +! -------------------------------------------------------------------- ! +! Define the forcing fields to preprocess via FORCING_NML namelist +! -------------------------------------------------------------------- ! +&FORCING_NML + FORCING%FIELD%WINDS = T + FORCING%GRID%LATLON = T +/ + +! -------------------------------------------------------------------- ! +! Define the content of the input file via FILE_NML namelist +! -------------------------------------------------------------------- ! +&FILE_NML + FILE%FILENAME = '../input/gfs_wind.nc' + FILE%LONGITUDE = 'longitude' + FILE%LATITUDE = 'latitude' + FILE%VAR(1) = 'uwnd' + FILE%VAR(2) = 'vwnd' +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ufs1.1/input_unstr/ww3_shel.inp b/regtests/ww3_ufs1.1/input_unstr/ww3_shel.inp new file mode 100644 index 000000000..82293f7c6 --- /dev/null +++ b/regtests/ww3_ufs1.1/input_unstr/ww3_shel.inp @@ -0,0 +1,301 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III shell input file $ +$ -------------------------------------------------------------------- $ +$ +$ Define input to be used ---------------------------------------------$ +$ + F F Water levels + T F Currents + T F Winds + T F Ice concentrations + F F Atmospheric momentum + F F Air density + F Assimilation data : Mean parameters + F Assimilation data : 1-D spectra + F Assimilation data : 2-D spectra. +$ +$ Time frame of calculations ------------------------------------------$ +$ + 20210401 000000 + 20210402 000000 +$ +$ Define output data --------------------------------------------------$ +$ + 0 +$ +$ Fields of mean wave parameters +$ + 20210401 000000 3600 20210402 000000 + N +CHA EF UST WND HS FP DP PHS PTP PDIR CUR ICE +$ +$ Point output +$ + 20210401 000000 3600 20210402 000000 + -85.078 -19.425 '32012 ' -1 DAT WHOI 360 4534 + -90.000 -55.000 '34002 ' 6.2 DAT OCOBSI 360 4800 + -72.522 34.502 '41001 ' 4 DAT NDBC 360 4556 + -74.930 31.892 '41002 ' 4 DAT NDBC 360 3920 + -79.099 32.501 '41004 ' 4 DAT NDBC 360 39 + -80.868 31.400 '41008 ' 5 DAT NDBC 360 14.9 + -80.185 28.508 '41009 ' 4 DAT NDBC 360 42 + -78.485 28.878 '41010 ' 4 DAT NDBC 360 890 + -77.743 33.436 '41013 ' 4 DAT NDBC 360 23.5 + -78.477 33.837 '41024 ' 2.95 DAT CORMP 360 10 + -75.363 35.025 '41025 ' 4 DAT NDBC 360 59.4 + -79.624 32.803 '41029 ' 2.95 DAT CORMP 360 10 + -80.406 32.279 '41033 ' 2.95 DAT CORMP 360 10 + -77.362 33.988 '41037 ' 2.95 DAT CORMP 360 30 + -77.715 34.141 '41038 ' 2.95 DAT CORMP 360 18 + -53.045 14.554 '41040 ' 4 DAT NDBC 360 5112 + -46.093 14.311 '41041 ' 4 DAT NDBC 360 3595 + -64.830 21.124 '41043 ' 4 DAT NDBC 360 5271 + -58.630 21.582 '41044 ' 4 DAT NDBC 360 5419 + -68.384 23.822 '41046 ' 4 DAT NDBC 360 5549 + -71.494 27.514 '41047 ' 4 DAT NDBC 360 5321 + -69.585 31.838 '41048 ' 4 DAT NDBC 360 5340 + -62.938 27.490 '41049 ' 4 DAT NDBC 360 5459 + -65.004 18.257 '41051 ' 4 DAT CARICOOS 360 32 + -64.763 18.249 '41052 ' 4 DAT CARICOOS 360 44 + -65.464 18.261 '41056 ' 4 DAT CARICOOS 360 30 + -65.157 18.476 '41058 ' 4 DAT CARICOOS 360 40 + -51.017 14.824 '41060 ' -1 DAT WHOI 360 5021 + -75.095 35.778 '41062 ' 3.5 DAT UNC 360 36 + -75.941 34.782 '41063 ' 3.5 DAT UNC 360 30 + -76.949 34.207 '41064 ' 2.95 DAT CORMP 360 30 + -78.015 33.721 '41108 ' -1 DAT SIO 360 12.8 + -77.717 34.141 '41110 ' -1 DAT CORMP 360 17 + -81.292 30.709 '41112 ' -1 DAT SIO 360 15.54 + -80.534 28.400 '41113 ' -1 DAT SIO 360 9.8 + -80.188 28.523 '41116 ' -1 DAT SIO 360 41 + -81.080 30.000 '41117 ' -1 DAT USACE 360 24.4 + -80.590 28.609 '41118 ' -1 DAT SIO 360 7.3 + -78.483 33.842 '41119 ' -1 DAT CORMP 360 13 + -76.946 34.213 '41159 ' -1 DAT CORMP 360 30.5 + -89.650 25.961 '42001 ' 3.6 DAT NDBC 360 3334 + -93.758 26.091 '42002 ' 5 DAT NDBC 360 3125.1 + -85.615 25.925 '42003 ' 4 DAT NDBC 360 3265 + -87.551 30.064 '42012 ' 4 DAT NDBC 360 25.9 + -95.350 27.906 '42019 ' 5 DAT NDBC 360 82.2 + -96.693 26.968 '42020 ' 4 DAT NDBC 360 84.1 + -83.741 27.505 '42022 ' 3.1 DAT COMPS 360 50 + -83.086 26.010 '42023 ' 3.1 DAT COMPS 360 50 + -83.475 25.171 '42026 ' 3.2 DAT COMPS 360 70 + -94.413 29.232 '42035 ' 4 DAT NDBC 360 16.2 + -84.516 28.501 '42036 ' 4 DAT NDBC 360 49.7 + -86.008 28.788 '42039 ' 4 DAT NDBC 360 270 + -88.226 29.208 '42040 ' 4 DAT NDBC 360 183 + -94.899 28.982 '42043 ' 4 DAT TAMUNI 360 19 + -96.500 26.217 '42045 ' 4 DAT TAMUNI 360 62 + -94.037 27.890 '42046 ' 4 DAT TAMUNI 360 105 + -93.597 27.897 '42047 ' 4 DAT TAMUNI 360 89 + -93.941 22.124 '42055 ' 4 DAT NDBC 360 3624 + -84.946 19.812 '42056 ' 4 DAT NDBC 360 4565 + -81.422 16.908 '42057 ' 4 DAT NDBC 360 377 + -74.560 14.775 '42058 ' 4 DAT NDBC 360 4150 + -67.483 15.252 '42059 ' 4 DAT NDBC 360 4784 + -63.354 16.413 '42060 ' 4 DAT NDBC 360 1507 + -81.251 24.500 '42078 ' -1 DAT CDIP 360 170 + -81.242 24.535 '42079 ' -1 DAT CDIP 360 99 + -66.532 17.869 '42085 ' 4 DAT CARICOOS 360 18.9 + -60.848 11.185 '42087 ' 3.35 DAT ICON 360 1266 + -60.521 11.301 '42088 ' 3.35 DAT ICON 360 1266 + -80.061 19.699 '42089 ' 3.35 DAT ICON 360 5726 + -69.580 18.432 '42090 ' 3.35 DAT ICON 360 1188 + -81.967 24.407 '42095 ' -1 DAT USACE 360 100 + -83.650 25.700 '42097 ' -1 DAT USACE 360 81 + -84.275 27.345 '42099 ' -1 DAT SIO 360 93.9 + -90.459 26.689 '42360 ' 3 DAT MURPHY 360 2539.9 + -92.490 27.550 '42361 ' 122 DAT SHELL 360 871.7 + -90.648 27.795 '42362 ' 122 DAT ENVEN 360 910 + -89.220 28.160 '42363 ' 122 DAT SHELL 360 894 + -88.090 29.060 '42364 ' 122 DAT SHELL 360 980.2 + -90.283 27.207 '42369 ' 60.4 DAT BP 360 1371.9 + -88.289 28.521 '42375 ' 61 DAT BP 360 1920.2 + -94.898 26.129 '42390 ' -1 DAT SHELL 360 2382.6 + -90.027 27.196 '42392 ' -1 DAT BP 360 2156.16 + -89.240 28.157 '42394 ' 100 DAT SHELL 360 923.5 + -90.792 26.404 '42395 ' 3 DAT SHELL 360 2941.9 + -125.032 10.051 '43010 ' -1 DAT WHOI 360 4769 + -69.128 43.201 '44005 ' 5 DAT NDBC 360 180.7 + -70.141 43.525 '44007 ' 5 DAT NDBC 360 26.5 + -69.248 40.504 '44008 ' 4 DAT NDBC 360 74.7 + -74.702 38.457 '44009 ' 5 DAT NDBC 360 30 + -66.588 41.070 '44011 ' 4 DAT NDBC 360 88.4 + -70.651 42.346 '44013 ' 5 DAT NDBC 360 64 + -74.840 36.606 '44014 ' 5 DAT NDBC 360 47 + -72.049 40.693 '44017 ' 5 DAT NDBC 360 48 + -70.143 42.206 '44018 ' 5 DAT NDBC 360 41.5 + -70.279 41.493 '44020 ' 4 DAT NDBC 360 14.3 + -73.728 40.883 '44022 ' 3.5 DAT UCT 360 22.5 + -65.912 42.327 '44024 ' 4 DAT NRCOOS 360 225 + -73.164 40.251 '44025 ' 5 DAT NDBC 360 36.3 + -67.300 44.283 '44027 ' 5 DAT NDBC 360 185.3 + -70.566 42.523 '44029 ' 4 DAT NRCOOS 360 65 + -70.426 43.179 '44030 ' 4 DAT NRCOOS 360 62 + -69.355 43.715 '44032 ' 4 DAT NRCOOS 360 100 + -68.996 44.055 '44033 ' 4 DAT NRCOOS 360 110 + -68.112 44.103 '44034 ' 4 DAT NRCOOS 360 100 + -67.876 43.497 '44037 ' 4 DAT NRCOOS 360 285 + -73.580 40.956 '44040 ' 3.5 DAT UCT 360 18.3 + -75.715 36.199 '44056 ' -1 DAT USACE 360 17.4 + -73.703 40.369 '44065 ' 4 DAT NDBC 360 25 + -72.644 39.618 '44066 ' 4 DAT NDBC 360 78 + -73.087 40.699 '44069 ' 3 DAT SBROOKU 360 46 + -70.540 43.020 '44073 ' 2.6 DAT UNH 360 131 + -75.421 36.001 '44086 ' -1 DAT SIO 360 21 + -74.838 36.612 '44088 ' -1 DAT SIO 360 47 + -75.334 37.757 '44089 ' -1 DAT USACE 360 16.9 + -70.329 41.840 '44090 ' -1 DAT USGS 360 26 + -73.769 39.778 '44091 ' -1 DAT USACE 360 25.6 + -75.492 36.872 '44093 ' -1 DAT SIO 360 26.82 + -75.330 35.750 '44095 ' -1 DAT SIO 360 18.3 + -75.809 37.023 '44096 ' -1 DAT SIO 360 11.9 + -71.127 40.969 '44097 ' -1 DAT SIO 360 48.16 + -70.168 42.798 '44098 ' -1 DAT SIO 360 76.5 + -75.720 36.914 '44099 ' -1 DAT SIO 360 18.3 + -75.594 36.260 '44100 ' -1 DAT SIO 360 25.9 + -62.000 42.260 '44137 ' 5 DAT ENCAN 360 4000 + -57.100 44.240 '44139 ' 5 DAT ENCAN 360 1500 + -64.020 42.500 '44150 ' 5 DAT ENCAN 360 1300 + -63.400 44.500 '44258 ' 5 DAT ENCAN 360 58 + -147.949 56.232 '46001 ' 5 DAT NDBC 360 4054 + -130.537 42.612 '46002 ' 4 DAT NDBC 360 3413 + -136.100 50.930 '46004 ' 5 DAT ENCAN 360 3600 + -131.079 46.134 '46005 ' 4 DAT NDBC 360 2852 + -137.397 40.782 '46006 ' 4 DAT NDBC 360 4378 + -121.019 34.956 '46011 ' 5 DAT NDBC 360 464.8 + -160.000 57.700 '46021 ' -1 DAT NDBC 360 59 + -120.967 34.714 '46023 ' 10 DAT NDBC 360 384.1 + -119.200 33.000 '46024 ' -1 DAT NDBC 360 1213 + -119.053 33.763 '46025 ' 4 DAT NDBC 360 888 + -121.857 35.703 '46028 ' 5 DAT NDBC 360 1048 + -177.708 57.018 '46035 ' 5 DAT NDBC 360 3687 + -122.398 36.785 '46042 ' 5 DAT NDBC 360 1645.9 + -119.506 32.404 '46047 ' 4 DAT NDBC 360 1394 + -120.477 34.265 '46054 ' 4 DAT NDBC 360 469.4 + -129.951 38.094 '46059 ' 4 DAT NDBC 360 4628 + -146.805 60.584 '46060 ' 5 DAT NDBC 360 445 + -154.987 52.765 '46066 ' 5 DAT NDBC 360 4460 + -120.213 33.677 '46069 ' 4 DAT NDBC 360 977.8 + 175.153 55.082 '46070 ' 5 DAT NDBC 360 3835 + 179.012 51.125 '46071 ' 5 DAT NDBC 360 1681 + -172.088 51.672 '46072 ' 5 DAT NDBC 360 3572 + -172.001 55.031 '46073 ' 5 DAT NDBC 360 3051.5 + -160.817 53.983 '46075 ' 5 DAT NDBC 360 2392.7 + -147.990 59.502 '46076 ' 5 DAT NDBC 360 195.1 + -152.582 55.556 '46078 ' 5 DAT NDBC 360 5380 + -150.042 57.947 '46080 ' 5 DAT NDBC 360 254.5 + -143.372 59.681 '46082 ' 5 DAT NDBC 360 300 + -137.997 58.300 '46083 ' 5 DAT NDBC 360 136 + -136.102 56.622 '46084 ' 5 DAT NDBC 360 1158 + -142.882 55.883 '46085 ' 4 DAT NDBC 360 3721 + -118.052 32.499 '46086 ' 4 DAT NDBC 360 1844.7 + -125.771 45.925 '46089 ' 5 DAT NDBC 360 2293.3 + -122.029 36.751 '46092 ' 4 DAT MBARI 360 1000 + -122.351 36.723 '46114 ' -1 DAT SIO 360 1463 + -131.220 51.830 '46147 ' 5 DAT ENCAN 360 2000 + -131.100 53.620 '46183 ' 5 DAT ENCAN 360 65 + -138.850 53.910 '46184 ' 5 DAT ENCAN 360 3200 + -129.790 52.420 '46185 ' 5 DAT ENCAN 360 230 + -128.770 51.380 '46204 ' -1 DAT ENCAN 360 222 + -134.320 54.190 '46205 ' 5 DAT ENCAN 360 2675 + -126.000 48.840 '46206 ' 5 DAT ENCAN 360 72 + -129.920 50.870 '46207 ' 5 DAT ENCAN 360 2125 + -132.690 52.520 '46208 ' 5 DAT ENCAN 360 2950 + -123.472 37.950 '46214 ' -1 DAT SIO 360 550 + -120.783 34.454 '46218 ' -1 DAT SIO 360 548.6 + -119.882 33.225 '46219 ' -1 DAT SIO 360 274.3 + -118.634 33.855 '46221 ' -1 DAT SIO 360 370 + -118.317 33.618 '46222 ' -1 DAT SIO 360 457 + -117.391 32.933 '46225 ' -1 DAT SIO 360 549 + -117.370 32.747 '46231 ' -1 DAT SIO 360 201.17 + -117.421 32.530 '46232 ' -1 DAT SIO 360 1143 + -117.169 32.570 '46235 ' -1 DAT SIO 360 21 + -122.096 36.343 '46239 ' -1 DAT SIO 360 369 + -145.200 50.033 '46246 ' -1 DAT SIO 360 4252 + -119.559 33.761 '46251 ' -1 DAT SIO 360 1920 + -118.181 33.576 '46253 ' -1 DAT SIO 360 66 + -117.267 32.868 '46254 ' -1 DAT SIO 360 38.71 + -119.651 33.400 '46255 ' -1 DAT SIO 360 105 + -118.201 33.700 '46256 ' -1 DAT SIO 360 23.25 + -120.766 34.439 '46257 ' -1 DAT SIO 360 576.07 + -117.501 32.752 '46258 ' -1 DAT SIO 360 588.6 + -121.497 34.767 '46259 ' -1 DAT USACE 360 646.8 + -119.004 33.704 '46262 ' -1 DAT SIO 360 905 + -151.695 57.479 '46264 ' -1 DAT SIO 360 86 + -165.475 64.473 '46265 ' -1 DAT SIO 360 18.2 + -153.781 23.535 '51000 ' 5 DAT NDBC 360 4811 + -162.000 24.453 '51001 ' 4 DAT NDBC 360 4895 + -157.742 17.043 '51002 ' 4 DAT NDBC 360 4948 + -160.662 19.172 '51003 ' 4 DAT NDBC 360 4943.3 + -152.364 17.604 '51004 ' 4 DAT NDBC 360 4998 + -162.075 24.361 '51101 ' 4 DAT NDBC 360 4849 + -158.117 21.671 '51201 ' -1 DAT SIO 360 200 + -157.678 21.415 '51202 ' -1 DAT SIO 360 89 + -157.010 20.788 '51203 ' -1 DAT SIO 360 201 + -158.124 21.281 '51204 ' -1 DAT SIO 360 300 + -156.425 21.018 '51205 ' -1 DAT SIO 360 200 + -154.970 19.780 '51206 ' -1 DAT SIO 360 345 + -157.752 21.477 '51207 ' -1 DAT SIO 360 81 + -159.574 22.285 '51208 ' -1 DAT SIO 360 200 + -170.493 -14.264 '51209 ' -1 DAT SIO 360 82 + -157.756 21.477 '51210 ' -1 DAT SIO 360 80 + -157.959 21.297 '51211 ' -1 DAT SIO 360 35 + -158.149 21.323 '51212 ' -1 DAT SIO 360 280 + -157.003 20.750 '51213 ' -1 DAT SIO 360 235 + 144.788 13.354 '52200 ' -1 DAT SIO 360 200 + 171.392 7.083 '52201 ' -1 DAT SIO 360 540 + 144.812 13.684 '52202 ' -1 DAT SIO 360 510 + 145.662 15.268 '52211 ' -1 DAT SIO 360 487.68 + 134.667 7.630 '52212 ' -1 DAT SIO 360 97 + -5.000 45.230 '62001 ' 3 DAT UKMO 360 4556 + -12.430 48.720 '62029 ' 3 DAT UKMO 360 3575 + -4.400 50.000 '62050 ' -1 DAT UKMO 360 53 + -2.900 49.900 '62103 ' 14 DAT UKMO 360 18 + -12.570 55.420 '62105 ' 3 DAT UKMO 360 2899 + -6.100 50.102 '62107 ' 14 DAT UKMO 360 61 + 0.000 58.300 '62114 ' -1 DAT PRIVATE 360 142 + 0.700 54.000 '62127 ' -1 DAT PRIVATE 360 39 + 1.700 53.400 '62144 ' -1 DAT PRIVATE 360 16 + 2.800 53.102 '62145 ' -1 DAT PRIVATE 360 26 + 2.100 57.200 '62146 ' -1 DAT PRIVATE 360 98 + 1.500 53.600 '62148 ' -1 DAT PRIVATE 360 16 + 1.100 53.700 '62149 ' -1 DAT PRIVATE 360 16 + -8.470 47.550 '62163 ' 3 DAT UKMO 360 4000 + 1.100 54.000 '62165 ' -1 DAT PRIVATE 360 41 + 0.000 50.400 '62305 ' 14 DAT UKMO 360 39 + 1.500 59.500 '63110 ' -1 DAT PRIVATE 360 117 + 1.000 61.100 '63112 ' -1 DAT PRIVATE 360 156 + 1.708 61.000 '63113 ' -1 DAT PRIVATE 360 156 + 1.300 61.600 '63115 ' -1 DAT PRIVATE 360 156 + 1.100 61.400 '63117 ' -1 DAT PRIVATE 360 156 + -11.420 59.070 '64045 ' 3 DAT UKMO 360 1935 + -4.167 60.483 '64046 ' 3 DAT UKMO 360 230 + 0.0 0.0 'STOPSTRING' +$ +$ Output along track +$ + 20051001 000000 0 20051101 000000 +$ +$ Restart files +$ + 20210401 000000 86400 20210402 000000 +$ +$ Boundary data +$ + 20051001 000000 0 20051101 000000 +$ +$ Separated wave field data +$ + 20051001 000000 0 20051101 000000 +$ +$ Homogenous field data ----------------------------------------------$ +$ +$ 'WND' 20051001 000000 20. 145. 2.0 +$ 'WND' 20051002 000000 20. 245. 2.0 + 'the_end' 0 + 'STP' +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_ufs1.1/input_unstr/ww3_shel.nml b/regtests/ww3_ufs1.1/input_unstr/ww3_shel.nml new file mode 100644 index 000000000..c3ceb1056 --- /dev/null +++ b/regtests/ww3_ufs1.1/input_unstr/ww3_shel.nml @@ -0,0 +1,52 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III ww3_shel.nml - single-grid model ! +! -------------------------------------------------------------------- ! + + +! -------------------------------------------------------------------- ! +! Define top-level model parameters via DOMAIN_NML namelist +! -------------------------------------------------------------------- ! +&DOMAIN_NML + DOMAIN%IOSTYP = 0 + DOMAIN%START = '20210401 000000' + DOMAIN%STOP = '20210402 000000' +/ + +! -------------------------------------------------------------------- ! +! Define each forcing via the INPUT_NML namelist +! -------------------------------------------------------------------- ! +&INPUT_NML + INPUT%FORCING%ICE_CONC = 'T' + INPUT%FORCING%CURRENTS = 'T' + INPUT%FORCING%WINDS = 'T' +/ + +! -------------------------------------------------------------------- ! +! Define the output types point parameters via OUTPUT_TYPE_NML namelist +! -------------------------------------------------------------------- ! +&OUTPUT_TYPE_NML + TYPE%FIELD%LIST = 'CHA EF UST WND HS FP DP PHS PTP PDIR CUR ICE' + TYPE%POINT%FILE = '../input_unstr/ww3_points.list' +/ + +! -------------------------------------------------------------------- ! +! Define output dates via OUTPUT_DATE_NML namelist +! -------------------------------------------------------------------- ! +&OUTPUT_DATE_NML + DATE%FIELD = '20210401 000000' '3600' '20210402 000000' + DATE%POINT = '20210401 000000' '3600' '20210402 000000' +! DATE%RESTART = '20210401 000000' '86400' '20210402 000000' +/ + +! -------------------------------------------------------------------- ! +! Define homogeneous input via HOMOG_COUNT_NML and HOMOG_INPUT_NML namelist +! -------------------------------------------------------------------- ! +&HOMOG_COUNT_NML +/ + +&HOMOG_INPUT_NML +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- !