From f6110f577cd6ab785b94048e5d2208ec14a299c8 Mon Sep 17 00:00:00 2001 From: Aron Roland Date: Tue, 7 Nov 2023 11:08:14 +0100 Subject: [PATCH] ww3_diffraction: merge develop and fix conflicts --- model/src/w3gdatmd.F90 | 13 ++-- model/src/w3gridmd.F90 | 8 ++- model/src/w3initmd.F90 | 2 +- model/src/w3iorsmd.F90 | 2 +- model/src/w3oacpmd.F90 | 110 +++++++--------------------------- model/src/w3parall.F90 | 21 +++---- model/src/w3profsmd_pdlib.F90 | 2 +- model/src/w3sln1md.F90 | 104 ++++++++++++++++++++++++++++++++ model/src/w3snl1md.F90 | 2 +- model/src/w3srcemd.F90 | 16 +---- model/src/w3updtmd.F90 | 1 + model/src/w3wavemd.F90 | 4 +- model/src/ww3_shel.F90 | 1 + 13 files changed, 157 insertions(+), 129 deletions(-) diff --git a/model/src/w3gdatmd.F90 b/model/src/w3gdatmd.F90 index 5c4a978d4..907e69c09 100644 --- a/model/src/w3gdatmd.F90 +++ b/model/src/w3gdatmd.F90 @@ -1394,11 +1394,11 @@ MODULE W3GDATMD #endif !/ !/ Data aliasing for structure SCHM(S) - LOGICAL, POINTER :: FSN,FSPSI,FSFCT,FSNIMP,FSTOTALIMP,FSTOTALEXP - LOGICAL, POINTER :: FSREFRACTION, FSFREQSHIFT, FSSOURCE, FSBCCFL - LOGICAL, POINTER :: DO_CHANGE_WLV - REAL(8), POINTER :: SOLVERTHR_STP - REAL(8), POINTER :: CRIT_DEP_STP + LOGICAL, POINTER :: FSN,FSPSI,FSFCT,FSNIMP,FSTOTALIMP,FSTOTALEXP + LOGICAL, POINTER :: FSREFRACTION, FSFREQSHIFT, FSSOURCE, FSBCCFL + LOGICAL, POINTER :: DO_CHANGE_WLV + REAL(8), POINTER :: SOLVERTHR_STP + REAL(8), POINTER :: CRIT_DEP_STP LOGICAL, POINTER :: B_JGS_TERMINATE_MAXITER LOGICAL, POINTER :: B_JGS_TERMINATE_DIFFERENCE LOGICAL, POINTER :: B_JGS_TERMINATE_NORM @@ -2834,6 +2834,9 @@ 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_LDIFR => MPARS(IMOD)%SCHMS%B_JGS_LDIFR + B_JGS_IDIFR => MPARS(IMOD)%SCHMS%B_JGS_IDIFR 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 98ba3fbcd..fd0eceef2 100644 --- a/model/src/w3gridmd.F90 +++ b/model/src/w3gridmd.F90 @@ -928,6 +928,8 @@ MODULE W3GRIDMD INTEGER :: UNSTSCHEMES(6) INTEGER :: UNSTSCHEME INTEGER :: JGS_NLEVEL + LOGICAL :: JGS_LDIFR + INTEGER :: JGS_IDIFR REAL*8 :: JGS_PMIN REAL*8 :: JGS_DIFF_THR REAL*8 :: JGS_NORM_THR @@ -1097,8 +1099,8 @@ MODULE W3GRIDMD JGS_NLEVEL, & JGS_SOURCE_NONLINEAR, & SETUP_APPLY_WLV, SOLVERTHR_SETUP, & - CRIT_DEP_SETUP, & - JGS_LDIFR, JGS_IDIFR + CRIT_DEP_SETUP, JGS_LDIFR, JGS_IDIFR + NAMELIST /MISC/ CICE0, CICEN, LICE, XSEED, FLAGTR, XP, XR, & XFILT, PMOVE, IHM, HSPM, WSM, WSC, FLC, FMICHE, & RWNDC, FACBERG, NOSW, GSHIFT, WCOR1, WCOR2, & @@ -2441,7 +2443,7 @@ SUBROUTINE W3GRID() JGS_NORM_THR = 1.E-20 JGS_NLEVEL = 0 JGS_SOURCE_NONLINEAR = .FALSE. - JGS_LDIFR = .FALSE. + JGS_LDIFR = .FALSE. JGS_IDIFR = 1 ! read data from the unstructured devoted namelist CALL READNL ( NDSS, 'UNST', STATUS ) diff --git a/model/src/w3initmd.F90 b/model/src/w3initmd.F90 index 00aa570a1..a86bf9b20 100644 --- a/model/src/w3initmd.F90 +++ b/model/src/w3initmd.F90 @@ -499,7 +499,7 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, #endif REAL :: DTTST, DEPTH, FRACOS REAL :: FACTOR - REAL :: WLVeff + REAL :: WLVeff, CTMP #ifdef W3_T REAL, ALLOCATABLE :: XOUT(:,:) #endif diff --git a/model/src/w3iorsmd.F90 b/model/src/w3iorsmd.F90 index 888fe66b6..05f7e9163 100644 --- a/model/src/w3iorsmd.F90 +++ b/model/src/w3iorsmd.F90 @@ -780,7 +780,7 @@ 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 + 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/w3oacpmd.F90 b/model/src/w3oacpmd.F90 index d3b6053f4..72e48e4e1 100644 --- a/model/src/w3oacpmd.F90 +++ b/model/src/w3oacpmd.F90 @@ -58,13 +58,6 @@ MODULE W3OACPMD ! USE MOD_OASIS ! OASIS3-MCT module ! - USE W3ODATMD, ONLY: NAPROC, IAPROC, UNDEF - USE MPI, ONLY : MPI_SUM, MPI_INT - USE W3PARALL, ONLY : INIT_GET_ISEA -#ifdef W3_PDLIB - USE YOWNODEPOOL, ONLY: NPA, NP, IPLG -#endif - IMPLICIT NONE PRIVATE ! @@ -338,7 +331,7 @@ SUBROUTINE CPL_OASIS_GRID(LD_MASTER,ID_LCOMM) ! ! 1.3. Unstructured grids ! ---------------------------------- - WRITE(*,*) 'TO BE IMPLEMENT FOR UNSTRUCTURED GRIDS CPL_OASIS_GRID' + WRITE(*,*) 'TO BE IMPLEMENT FOR UNSTRUCTURED GRIDS' STOP END IF ! @@ -374,10 +367,8 @@ SUBROUTINE CPL_OASIS_DEFINE(NDSO,RCV_STR,SND_STR) !/ | A. Thevenin | !/ | V. Garnier | !/ | M. Accensi | - !/ ! A. Roland | - !/ ! H. Michaud | !/ | FORTRAN 90 | - !/ | Last update : 22-Feb-2023 | + !/ | Last update : 08-Jun-2018 | !/ +-----------------------------------+ !/ !/ Jul-2013 : Origination. ( version 4.18 ) @@ -385,8 +376,6 @@ SUBROUTINE CPL_OASIS_DEFINE(NDSO,RCV_STR,SND_STR) !/ (R. Baraille & J. Pianezze) !/ April-2016 : Add comments (J. Pianezze) ( version 5.07 ) !/ 08-Jun-2018 : use INIT_GET_ISEA ( version 6.04 ) - !/ 22-Feb-2023 : Extend to domain decomposition ( version 7.xx ) - !/ 01-Mar-2023 : More work ... !/ ! 1. Purpose : ! @@ -427,11 +416,7 @@ SUBROUTINE CPL_OASIS_DEFINE(NDSO,RCV_STR,SND_STR) USE W3GDATMD, ONLY: NSEAL,NSEA, NX, NY, MAPSTA, MAPSF, GTYPE, & & UNGTYPE, RLGTYPE, CLGTYPE, SMCTYPE USE W3ODATMD, ONLY: NAPROC, IAPROC -#ifdef W3_PDLIB - USE W3PARALL, ONLY : INIT_GET_ISEA - USE YOWNODEPOOL, ONLY: NPA, NP, IPLG -#endif - IMPLICIT NONE + USE W3PARALL, ONLY : INIT_GET_ISEA ! !/ ------------------------------------------------------------------- / !/ Parameter list @@ -442,7 +427,7 @@ SUBROUTINE CPL_OASIS_DEFINE(NDSO,RCV_STR,SND_STR) !/ ------------------------------------------------------------------- / !/ Local parameters !/ - INTEGER :: IB_I,I,IPART,IERR_MPI + INTEGER :: IB_I,I INTEGER :: IL_PART_ID ! PartitionID INTEGER, ALLOCATABLE, DIMENSION(:) :: ILA_PARAL ! Description of the local partition in the global index space INTEGER, DIMENSION(4) :: ILA_SHAPE ! Vector giving the min & max index for each dim of the fields @@ -503,81 +488,31 @@ SUBROUTINE CPL_OASIS_DEFINE(NDSO,RCV_STR,SND_STR) ! ! 1.3. Unstructured grids ! ---------------------------------- -#ifdef W3_PDLIB - IPART = 4 ! USING POINT PARTITION FOR UNSTRUCTURED DD - IF (IPART == 3) THEN - ! * allocate : OASIS ORANGE partition - ALLOCATE(ILA_PARAL(2+NP*2)) - ! * Define the partition : OASIS ORANGE partition - ILA_PARAL(1) = 3 - ! * total number of segments of the global domain - ILA_PARAL(2) = NP - DO JSEA = 1, NP - CALL INIT_GET_ISEA(ILA_PARAL(JSEA*2+1),JSEA) - ILA_PARAL(JSEA*2+2) = 1 - END DO - ELSE IF (IPART == 4) THEN - ! * allocate : OASIS POINT partition - ALLOCATE(ILA_PARAL(2+NP)) - ! * Define the partition : OASIS POINTS partition - ILA_PARAL(1) = 4 - ! * total number of segments of the global domain - ILA_PARAL(2) = NP - DO JSEA = 1, NP - CALL INIT_GET_ISEA(ILA_PARAL(JSEA+2),JSEA) - ENDDO - ENDIF -#else - IPART = 4 - IF (IPART == 3) THEN - ! * allocate : OASIS ORANGE partition - ALLOCATE(ILA_PARAL(2+NSEAL*2)) - ! * Define the partition : OASIS ORANGE partition - ILA_PARAL(1) = 3 - ! * total number of segments of the global domain - ILA_PARAL(2) = NSEAL - DO JSEA = 1, NSEAL - CALL INIT_GET_ISEA(ILA_PARAL(JSEA*2+1),JSEA) - ILA_PARAL(JSEA*2+2) = 1 - END DO - ELSE IF (IPART == 4) THEN - ! * allocate : OASIS POINT partition - ALLOCATE(ILA_PARAL(2+NSEAL)) - ! * Define the partition : OASIS POINTS partition - ILA_PARAL(1) = 4 - ! * total number of segments of the global domain - ILA_PARAL(2) = NSEAL - DO JSEA = 1, NSEAL - CALL INIT_GET_ISEA(ILA_PARAL(JSEA+2),JSEA) - ENDDO - ENDIF -#endif + WRITE(*,*) 'TO BE VERIFIED FOR UNSTRUCTURED GRIDS' + STOP + ! + DO JSEA=1,NSEAL + ILA_PARAL(JSEA*2+1) = (IAPROC-1) + (JSEA-1)*NAPROC + ILA_PARAL(JSEA*2+2) = 1 + END DO ! ENDIF - ! ! 2. Partition definition ! ---------------------------------- - CALL OASIS_DEF_PARTITION(IL_PART_ID, ILA_PARAL,IL_ERR,NSEA) + CALL OASIS_DEF_PARTITION(IL_PART_ID, ILA_PARAL,IL_ERR,NNODES) IF(IL_ERR /= 0) THEN CALL OASIS_ABORT(IL_COMPID, 'CPL_OASIS_DEFINE', 'Problem during oasis_def_partition') ENDIF - - ! ! 3. Coupling fields declaration ! ---------------------------------- -#ifdef W3_PDLIB - ILA_SHAPE(:) = (/1, NP, 1, 1 /) -#else ILA_SHAPE(:) = (/1, NSEAL, 1, 1 /) -#endif ! ILA_VAR_NODIMS(1) = 2 ! rank of fields array ILA_VAR_NODIMS(2) = 1 ! always 1 with OASIS3-MCT 2.0 ! CALL GET_LIST_EXCH_FIELD(NDSO, RCV_FLD, SND_FLD, IL_NB_RCV, IL_NB_SND, RCV_STR, SND_STR) - ! ! 3.1 Send coupling fields ! ---------------------------------- @@ -595,8 +530,6 @@ SUBROUTINE CPL_OASIS_DEFINE(NDSO,RCV_STR,SND_STR) CALL OASIS_ABORT(IL_COMPID, 'CPL_OASIS_DEFINE', 'Problem during oasis_def_var') ENDIF ENDDO - - ! ! 3.2 Received coupling fields ! ---------------------------------- @@ -614,14 +547,11 @@ SUBROUTINE CPL_OASIS_DEFINE(NDSO,RCV_STR,SND_STR) CALL OASIS_ABORT(IL_COMPID, 'CPL_OASIS_DEFINE', 'Problem during oasis_def_var') ENDIF ENDDO - - ! ! 4. End of definition phase ! ---------------------------------- CALL OASIS_ENDDEF(IL_ERR) - IF (IL_ERR /= 0) THEN CALL OASIS_ABORT(IL_COMPID, 'CPL_OASIS_DEFINE', 'Problem during oasis_enddef') ENDIF @@ -746,9 +676,6 @@ SUBROUTINE CPL_OASIS_RCV(ID_NB, ID_TIME, RDA_FIELD, LD_ACTION) !/ ------------------------------------------------------------------- / !/ Parameter list !/ - USE W3ODATMD, ONLY: NAPROC, IAPROC, UNDEF - USE W3GDATMD, ONLY: NSEAL, NSEA, NX - IMPLICIT NONE INTEGER, INTENT(IN) :: ID_NB ! Number of the field to be received INTEGER, INTENT(IN) :: ID_TIME ! Ocean time-step in seconds REAL(KIND=8), DIMENSION(:,:), INTENT(OUT) :: RDA_FIELD ! Coupling field array to be received @@ -758,18 +685,15 @@ SUBROUTINE CPL_OASIS_RCV(ID_NB, ID_TIME, RDA_FIELD, LD_ACTION) !/ Local parameters !/ INTEGER :: IL_INFO ! OASIS3-MCT info argument - INTEGER :: IERR_MPI, NPSUM !/ !/ ------------------------------------------------------------------- / !/ Executable part !/ - CALL OASIS_GET ( RCV_fld(ID_NB)%IL_FIELD_ID & & , ID_TIME & & , RDA_FIELD & & , IL_INFO & & ) - ! LD_ACTION = IL_INFO == OASIS_RECVD .OR. IL_INFO == OASIS_FROMREST .OR. & & IL_INFO == OASIS_RECVOUT .OR. IL_INFO == OASIS_FROMRESTOUT @@ -918,6 +842,14 @@ SUBROUTINE GET_LIST_EXCH_FIELD(NDSO, RCV, SND, ID_NB_RCV, ID_NB_SND, RCV_STR, SN ID_NB_RCV=ID_NB_RCV+1 RCV(ID_NB_RCV)%CL_FIELD_NAME='WW3_OWDH' ! + ! wet-drying at u-location + ID_NB_RCV=ID_NB_RCV+1 + RCV(ID_NB_RCV)%CL_FIELD_NAME='WW3_OWDU' + ! + ! wet-drying at v-location + ID_NB_RCV=ID_NB_RCV+1 + RCV(ID_NB_RCV)%CL_FIELD_NAME='WW3_OWDV' + ! CASE('SSH') ! ssh : sea surface height (m) ID_NB_RCV=ID_NB_RCV+1 @@ -933,6 +865,7 @@ SUBROUTINE GET_LIST_EXCH_FIELD(NDSO, RCV, SND, ID_NB_RCV, ID_NB_SND, RCV_STR, SN RCV(ID_NB_RCV)%CL_FIELD_NAME='WW3_OSSV' #endif ! + ! ! ATMOSPHERE MODEL VARIABLES ! @@ -1211,3 +1144,4 @@ END SUBROUTINE GET_LIST_EXCH_FIELD !/ END MODULE W3OACPMD !/ +!/ ------------------------------------------------------------------- / diff --git a/model/src/w3parall.F90 b/model/src/w3parall.F90 index ff148dbdc..e06e7c28e 100644 --- a/model/src/w3parall.F90 +++ b/model/src/w3parall.F90 @@ -102,7 +102,7 @@ MODULE W3PARALL REAL*8, PARAMETER :: KDMAX = 200.d0 - REAL*8, ALLOCATABLE :: DIFRX(:), DIFRY(:), DIFRM(:) !AR: todo, allocate! + REAL*8, ALLOCATABLE :: DIFRX(:), DIFRY(:), DIFRM(:) CONTAINS !/ ------------------------------------------------------------------- / !> @@ -542,7 +542,7 @@ SUBROUTINE PROP_REFRACTION_PR3(IP, ISEA, DTG, CAD, DoLimiter) FACTH = 1.0 / DTH ! FDG = FACTH * eCTHG0 - DEPTH = MAX ( DMIN , DW(ISEA) ) ! This results in bathemtry modification and it used all over the code! + DEPTH = MAX ( DMIN , DW(ISEA) ) DO IK=0, NK+1 IF ( DEPTH*WN(IK,ISEA) .LT. 5. ) THEN DSDD(IK) = MAX ( 0. , CG(IK,ISEA)*WN(IK,ISEA)-0.5*SIG(IK) ) / DEPTH @@ -566,7 +566,7 @@ SUBROUTINE PROP_REFRACTION_PR3(IP, ISEA, DTG, CAD, DoLimiter) VCFLT(ISP) = ES2(ISP)*DCYX + ESC(ISP)*DCXXYY - EC2(ISP)*DCXY END DO ELSE - VCFLT = 0 + VCFLT=0 END IF ! #ifdef W3_REFRX @@ -592,9 +592,8 @@ SUBROUTINE PROP_REFRACTION_PR3(IP, ISEA, DTG, CAD, DoLimiter) VCFLT(ISP)=VELNOFILT END IF END DO - - DO ISP = 1, NSPEC - CAD(ISP) = DBLE(VCFLT(ISP)) + DO ISP=1,NSPEC + CAD(ISP)=DBLE(VCFLT(ISP)) END DO IF (B_JGS_LDIFR) THEN @@ -700,7 +699,6 @@ SUBROUTINE PROP_FREQ_SHIFT(IP, ISEA, CAS, DMM, DTG) CALL STRACE (IENT, 'PROP_FREQ_SHIFT') #endif ! - IF (LPDLIB) THEN eDCXDX = DCXDX(1,IP) eDCXDY = DCXDY(1,IP) @@ -718,14 +716,13 @@ SUBROUTINE PROP_FREQ_SHIFT(IP, ISEA, CAS, DMM, DTG) eDDDX=DDDX(IY,IX) eDDDY=DDDY(IY,IX) ENDIF - - eCX = CX(ISEA) - eCY = CY(ISEA) + eCX=CX(ISEA) + eCY=CY(ISEA) DCXX = - eDCXDX DCXYYX = - ( eDCXDY + eDCYDX ) DCYY = - eDCYDY FKD = ( eCX*eDDDX + eCY*eDDDY ) - FACK = DTG + FACK = DTG DO ITH=1, NTH FKC(ITH) = EC2(ITH)*DCXX + ESC(ITH)*DCXYYX + ES2(ITH)*DCYY END DO @@ -899,7 +896,7 @@ SUBROUTINE PROP_FREQ_SHIFT_M2(IP, ISEA, CWNB_M2, DWNI_M2, DTG) ! DEPTH = MAX ( DMIN , DW(ISEA) ) DO IK=0, NK+1 - IF ( DEPTH*WN(IK,ISEA) .LT. 5. ) THEN + IF ( DEPTH*WN(IK,ISEA) .LT. 5. ) THEN IF (B_JGS_LDIFR) THEN DSDD(IK) = MAX ( 0. , DIFRM(IP)*CG(IK,ISEA)*WN(IK,ISEA)-0.5*SIG(IK) ) / DEPTH ELSE diff --git a/model/src/w3profsmd_pdlib.F90 b/model/src/w3profsmd_pdlib.F90 index 4ceea486c..98277ff6a 100644 --- a/model/src/w3profsmd_pdlib.F90 +++ b/model/src/w3profsmd_pdlib.F90 @@ -119,7 +119,7 @@ MODULE PDLIB_W3PROFSMD REAL*8, ALLOCATABLE :: FLALL1(:,:,:), KELEM1(:,:,:) REAL*8, ALLOCATABLE :: FLALL2(:,:,:), KELEM2(:,:,:) REAL*8, ALLOCATABLE :: FLALL3(:,:,:), KELEM3(:,:,:) - REAL*8, ALLOCATABLE :: DIFRX(:), DIFRY(:), DIFRM(:) !AR: todo, allocate! + REAL*8, ALLOCATABLE :: DIFRX(:), DIFRY(:), DIFRM(:) REAL*8, ALLOCATABLE :: NM(:,:,:), DTSI(:) INTEGER, ALLOCATABLE :: ITER(:) INTEGER, ALLOCATABLE :: IS0_pdlib(:) diff --git a/model/src/w3sln1md.F90 b/model/src/w3sln1md.F90 index 8bba66716..15b8b6228 100644 --- a/model/src/w3sln1md.F90 +++ b/model/src/w3sln1md.F90 @@ -54,11 +54,94 @@ MODULE W3SLN1MD CONTAINS !/ ------------------------------------------------------------------- / SUBROUTINE W3SLN1 (K, FHIGH, USTAR, USDIR, S) + !/ + !/ +-----------------------------------+ + !/ | WAVEWATCH III NOAA/NCEP | + !/ | H. L. Tolman | + !/ | FORTRAN 90 | + !/ | Last update : 23-Jun-2006 | + !/ +-----------------------------------+ + !/ + !/ 23-Jun-2006 : Origination. ( version 3.09 ) + !/ + ! 1. Purpose : + ! + ! Linear wind input according to Cavaleri and Melanotte-Rizzoli + ! (1982) filtered for low frequencies according to Tolman (1992). + ! + ! 2. Method : + ! + ! The expression of Cavaleri and Melanotte-Rizzoli, converted to + ! action spectra defined in terms of wavenumber and direction + ! becomes + ! + ! -1 / / \ \ 4 + ! Sln = SLNC1 * k * max | 0., | U* cos(Dtheta) | | (1) + ! \ \ / / + ! + ! 2 -2 + ! SLNC1 = 80 RHOr GRAV FILT (2) + ! + ! Where : + ! + ! RHOr Density of air dev. by density of water. + ! U* Wind friction velocity. + ! Dtheta Difference in wind and wave direction. + ! FILT Filter based on PM and cut-off frequencies. + ! + ! 3. Parameters : + ! + ! Parameter list + ! ---------------------------------------------------------------- + ! K R.A. I Wavenumber for entire spectrum. + ! FHIGH R.A. I Cut-off frequency in integration (rad/s) + ! USTAR Real I Friction velocity. + ! USDIR Real I Direction of USTAR. + ! S R.A. O Source term. + ! ---------------------------------------------------------------- + ! *) Stored as 1-D array with dimension NTH*NK + ! + ! 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 : + ! + ! See source code. + ! + ! 9. Switches : + ! + ! !/S Enable subroutine tracing. + ! !/T Test output. + ! + ! 10. Source code : + ! !/ ------------------------------------------------------------------- / USE CONSTANTS USE W3GDATMD, ONLY: NTH, NK, ECOS, ESIN, SIG, SLNC1, FSPM, FSHF USE W3ODATMD, ONLY: NDSE, NDST USE W3SERVMD, ONLY: EXTCDE +#ifdef W3_S + USE W3SERVMD, ONLY: STRACE +#endif !/ IMPLICIT NONE !/ @@ -72,9 +155,23 @@ SUBROUTINE W3SLN1 (K, FHIGH, USTAR, USDIR, S) !/ Local parameters !/ INTEGER :: ITH, IK +#ifdef W3_S + INTEGER, SAVE :: IENT = 0 +#endif REAL :: COSU, SINU, DIRF(NTH), FAC, FF1, FF2, & FFILT, RFR, WNF(NK) !/ + !/ ------------------------------------------------------------------- / + !/ +#ifdef W3_S + CALL STRACE (IENT, 'W3SLN1') +#endif + ! + ! 1. Set up factors ------------------------------------------------- * + ! +#ifdef W3_T + WRITE (NDST,900) USTAR, USDIR*RADE +#endif ! COSU = COS(USDIR) SINU = SIN(USDIR) @@ -104,6 +201,13 @@ SUBROUTINE W3SLN1 (K, FHIGH, USTAR, USDIR, S) ! RETURN ! + ! Formats + ! +#ifdef W3_T +900 FORMAT ( ' TEST W3SLN1 : USTAR, DIR :',F6.3, F6.1) +#endif + !/ + !/ End of W3SLN1 ----------------------------------------------------- / !/ END SUBROUTINE W3SLN1 !/ diff --git a/model/src/w3snl1md.F90 b/model/src/w3snl1md.F90 index ea6d0dbcc..598b627ea 100644 --- a/model/src/w3snl1md.F90 +++ b/model/src/w3snl1md.F90 @@ -443,7 +443,7 @@ SUBROUTINE W3SNL1 (A, CG, KDMEAN, S, D) #ifdef W3_T0 DO IFR=1, NFR DO ITH=1, NTH - ISP = ITH + (IFR-1)*NTH + ISP = ITH + (IFR-1)*NTH SOUT(IFR,ITH) = S(ISP) * TPI * SIG(IFR) / CG(IFR) DOUT(IFR,ITH) = D(ISP) END DO diff --git a/model/src/w3srcemd.F90 b/model/src/w3srcemd.F90 index a27e71bbd..c6bba7e21 100644 --- a/model/src/w3srcemd.F90 +++ b/model/src/w3srcemd.F90 @@ -820,21 +820,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & #ifdef W3_ST6 REAL :: VSWL(NSPEC), VDWL(NSPEC) #endif - LOGICAL, SAVE :: FLTEST = .FALSE., FLAGNN = .TRUE. -#ifdef W3_OMPG - !$omp threadprivate( FLTEST, FLAGNN ) -#endif - LOGICAL :: SHAVE - LOGICAL :: LBREAK - LOGICAL, SAVE :: FIRST = .TRUE. -#ifdef W3_OMPG - !$omp threadprivate( FIRST ) -#endif - LOGICAL :: PrintDeltaSmDA - REAL :: eInc1, eInc2, eVS, eVD, JAC - REAL :: DeltaSRC(NSPEC) - REAL, PARAMETER :: DTMINTOT = 0.01 - LOGICAL :: LNEWLIMITER = .FALSE. + #ifdef W3_PDLIB REAL :: PreVS, DVS, SIDT, FAKS, MAXDAC #endif diff --git a/model/src/w3updtmd.F90 b/model/src/w3updtmd.F90 index 10387781d..2f7a830c6 100644 --- a/model/src/w3updtmd.F90 +++ b/model/src/w3updtmd.F90 @@ -2151,6 +2151,7 @@ SUBROUTINE W3ULEV ( A, VA ) #endif LOGICAL :: LOCAL INTEGER :: IBELONG + REAL :: CTMP ! #ifdef W3_TIDE INTEGER :: J diff --git a/model/src/w3wavemd.F90 b/model/src/w3wavemd.F90 index 94dffa8fc..5b83b4ada 100644 --- a/model/src/w3wavemd.F90 +++ b/model/src/w3wavemd.F90 @@ -447,10 +447,10 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & USE W3IOBCMD USE W3IOSFMD #ifdef W3_PDLIB - USE PDLIB_W3PROFSMD, only : APPLY_BOUNDARY_CONDITION_VA + USE PDLIB_W3PROFSMD, only : APPLY_BOUNDARY_CONDITION_VA, COMPUTE_DIFFRACTION USE PDLIB_W3PROFSMD, only : PDLIB_W3XYPUG, PDLIB_W3XYPUG_BLOCK_IMPLICIT, PDLIB_W3XYPUG_BLOCK_EXPLICIT USE PDLIB_W3PROFSMD, only : ALL_VA_INTEGRAL_PRINT, ALL_VAOLD_INTEGRAL_PRINT, ALL_FIELD_INTEGRAL_PRINT - USE W3PARALL, only : PDLIB_NSEAL, PDLIB_NSEALM + USE W3PARALL, only : PDLIB_NSEAL, PDLIB_NSEALM, DIFRX, DIFRY, DIFRM USE yowNodepool, only: npa, iplg, np #endif !/ diff --git a/model/src/ww3_shel.F90 b/model/src/ww3_shel.F90 index 3f22a395a..ee3464f44 100644 --- a/model/src/ww3_shel.F90 +++ b/model/src/ww3_shel.F90 @@ -1948,6 +1948,7 @@ PROGRAM W3SHEL ENDIF ! Estimate the weights for the spatial interpolation IF (DTOUT(7).NE.0) THEN + CALL CPL_OASIS_GRID(L_MASTER,MPI_COMM) CALL CPL_OASIS_DEFINE(NDSO, FLDIN, FLDOUT) END IF #endif