From d359f7df956f8e1a2be26684e9fdd55ffdcf3817 Mon Sep 17 00:00:00 2001 From: Mathieu Dutour Sikiric Date: Wed, 7 Sep 2022 15:08:09 +0200 Subject: [PATCH 01/17] Big elimination of print statements. --- model/src/w3fldsmd.F90 | 41 ----------------------- model/src/w3gridmd.F90 | 76 ------------------------------------------ 2 files changed, 117 deletions(-) diff --git a/model/src/w3fldsmd.F90 b/model/src/w3fldsmd.F90 index 17e834be6d..40484358c7 100644 --- a/model/src/w3fldsmd.F90 +++ b/model/src/w3fldsmd.F90 @@ -200,9 +200,7 @@ SUBROUTINE W3FLDO ( INXOUT, IDFLD, NDS, NDST, NDSE, NX, NY, & USE W3SERVMD, ONLY: STRACE #endif ! -#ifdef W3_DEBUGFLS USE W3ODATMD, only : IAPROC -#endif USE CONSTANTS, ONLY: file_endian IMPLICIT NONE @@ -350,37 +348,19 @@ SUBROUTINE W3FLDO ( INXOUT, IDFLD, NDS, NDST, NDSE, NX, NY, & ! ! Open file ---------------------------------------------------------- * ! -#ifdef W3_DEBUGFLS - WRITE(740+IAPROC,*) 'W3FLDSMD 1 : WRITE=', WRITE -#endif IF ( WRITE ) THEN -#ifdef W3_DEBUGFLS - WRITE(740+IAPROC,*) 'W3FLDSMD 2 : WRITE=', WRITE -#endif IF ( PRESENT(FPRE) ) THEN -#ifdef W3_DEBUGFLS - WRITE(740+IAPROC,*) '1 : W3FLDSMD FNAME=', FNAME(:I) -#endif OPEN (NDS,FILE=FPRE//FNAME(:I),FORM=FORM, convert=file_endian, & ERR=803, IOSTAT=IERR) ELSE -#ifdef W3_DEBUGFLS - WRITE(740+IAPROC,*) '2 : W3FLDSMD FNAME=', FNAME(:I) -#endif OPEN (NDS,FILE=FNAME(:I),FORM=FORM,convert=file_endian, & ERR=803,IOSTAT=IERR) END IF ELSE IF ( PRESENT(FPRE) ) THEN -#ifdef W3_DEBUGFLS - WRITE(740+IAPROC,*) '3 : W3FLDSMD FNAME=', FNAME(:I) -#endif OPEN (NDS,FILE=FPRE//FNAME(:I),FORM=FORM,convert=file_endian, & STATUS='OLD',ERR=803,IOSTAT=IERR) ELSE -#ifdef W3_DEBUGFLS - WRITE(740+IAPROC,*) '4 : W3FLDSMD FNAME=', FNAME(:I) -#endif OPEN (NDS,FILE=FNAME(:I),FORM=FORM,convert=file_endian, & STATUS='OLD',ERR=803,IOSTAT=IERR) END IF @@ -388,9 +368,6 @@ SUBROUTINE W3FLDO ( INXOUT, IDFLD, NDS, NDST, NDSE, NX, NY, & ! ! Process test data -------------------------------------------------- * ! -#ifdef W3_DEBUGFLS - WRITE(740+IAPROC,*) 'WRITE=', WRITE -#endif IF ( WRITE ) THEN IF ( FDHDR ) THEN IF ( FORM .EQ. 'UNFORMATTED' ) THEN @@ -409,22 +386,9 @@ SUBROUTINE W3FLDO ( INXOUT, IDFLD, NDS, NDST, NDSE, NX, NY, & IF ( FORM .EQ. 'UNFORMATTED' ) THEN READ (NDS,END=806,ERR=805,IOSTAT=IERR) & TSSTR, TSFLD, NXT, NYT, GTYPET, FILLER(1:2), TIDEFLAG -#ifdef W3_DEBUGFLS - WRITE(740+IAPROC,*) '1: NXT=', NXT, ' NYT=', NYT - WRITE(740+IAPROC,*) '1: TSSTR=', TSSTR - WRITE(740+IAPROC,*) '1: TSFLD=', TSFLD - WRITE(740+IAPROC,*) '1: NXT=', NXT, ' NYT=', NYT - WRITE(740+IAPROC,*) '1: GTYPET=', GTYPET - WRITE(740+IAPROC,*) '1: FILLER=', FILLER - WRITE(740+IAPROC,*) '1: TIDEFLAG=', TIDEFLAG -#endif ELSE READ (NDS,900,END=806,ERR=805,IOSTAT=IERR) & TSSTR, TSFLD, NXT, NYT, GTYPET, FILLER(1:2), TIDEFLAG -#ifdef W3_DEBUGFLS - WRITE(740+IAPROC,*) '2: NXT=', NXT, ' NYT=', NYT - WRITE(740+IAPROC,*) '2: NXT=', NXT, ' NYT=', NYT -#endif END IF IF ((FILLER(1).NE.0.OR.FILLER(2).NE.0).AND.TIDEFLAG.GE.0) TIDEFLAG=0 IF (TIDEFLAG.NE.0.AND.(.NOT.TIDEOK)) THEN @@ -442,11 +406,6 @@ SUBROUTINE W3FLDO ( INXOUT, IDFLD, NDS, NDST, NDSE, NX, NY, & IF ( IDFLD .NE. TSFLD ) GOTO 808 IF ( IDFLD(1:2) .NE. 'DT' ) THEN IF ( NX.NE.NXT .OR. NY.NE.NYT ) THEN -#ifdef W3_DEBUGFLS - WRITE(740+IAPROC,*) 'Dimension error' - WRITE(740+IAPROC,*) 'NX =', NX , ' NY =', NY - WRITE(740+IAPROC,*) 'NXT=', NXT, ' NYT=', NYT -#endif GOTO 809 ELSE NX = NXT diff --git a/model/src/w3gridmd.F90 b/model/src/w3gridmd.F90 index ab0f5d97b5..302c586850 100644 --- a/model/src/w3gridmd.F90 +++ b/model/src/w3gridmd.F90 @@ -643,13 +643,6 @@ MODULE W3GRIDMD ! STK_WN are the decays for Stokes drift partitions REAL :: STK_WN(25) -#ifdef W3_DEBUGGRID - INTEGER :: nbCase1, nbCase2, nbCase3, & - nbCase4, nbCase5, nbCase6, & - nbCase7, nbCase8 - INTEGER :: nbTMPSTA0, nbTMPSTA1, nbTMPSTA2 - INTEGER :: IAPROC -#endif ! #ifdef W3_LN1 REAL :: CLIN, RFPM, RFHF @@ -1160,9 +1153,6 @@ SUBROUTINE W3GRID() !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 2. IO set-up. ! -#ifdef W3_DEBUGGRID - IAPROC = 1 -#endif NDSI = 10 NDSS = 99 NDSM = 20 @@ -4468,9 +4458,6 @@ SUBROUTINE W3GRID() ! ! ... Data to be read in parts ! -#ifdef W3_DEBUGGRID - WRITE(740+IAPROC,*) 'FROM=', TRIM(FROM) -#endif IF ( FROM .EQ. 'PART' ) THEN ! ! 8.b Update TMPSTA with input boundary data (ILOOP=1) @@ -4482,16 +4469,6 @@ SUBROUTINE W3GRID() 'TO READ DATA IN PARTS. STOPPING NOW (107).' CALL EXTCDE ( 107 ) END IF -#ifdef W3_DEBUGGRID - nbCase1=0 - nbCase2=0 - nbCase3=0 - nbCase4=0 - nbCase5=0 - nbCase6=0 - nbCase7=0 - nbCase8=0 -#endif DO ILOOP=1, 2 ! I = 1 @@ -4531,12 +4508,6 @@ SUBROUTINE W3GRID() CALL NEXTLN ( COMSTR , NDSI , NDSE ) READ (NDSI,*,END=2001,ERR=2002) IX, IY, CONNCT END IF -#ifdef W3_DEBUGGRID - WRITE(740+IAPROC,*) 'read IX=', IX - WRITE(740+IAPROC,*) 'read IY=', IY - WRITE(740+IAPROC,*) 'read CONNCT=', CONNCT -#endif - ! ! ... Check if last point reached. ! @@ -4553,10 +4524,6 @@ SUBROUTINE W3GRID() ! ! ... Check if intermediate points are to be added. ! -#ifdef W3_DEBUGGRID - WRITE(740+IAPROC,*) 'CONNCT=', CONNCT - WRITE(740+IAPROC,*) 'FIRST=', FIRST -#endif IF ( CONNCT .AND. .NOT.FIRST ) THEN IDX = IX - IXO IDY = IY - IYO @@ -4589,9 +4556,6 @@ SUBROUTINE W3GRID() ! ... Check if point itself is to be added ! IF ( TMPSTA(IY,IX).EQ.1 .OR. J.EQ.2 ) THEN -#ifdef W3_DEBUGGRID - nbCase2=nbCase2+1 -#endif TMPSTA(IY,IX) = NSTAT END IF ! @@ -4653,9 +4617,6 @@ SUBROUTINE W3GRID() IY1 = IY ! JJ = TMPSTA(IY,IX) -#ifdef W3_DEBUGGRID - nbCase3=nbCase3 + 1 -#endif TMPSTA(IY,IX) = NSTAT DO NBT = 0 @@ -4665,36 +4626,24 @@ SUBROUTINE W3GRID() IF (IX.GT.1) THEN IF (TMPSTA(IY ,IX-1).EQ.NSTAT & .AND. TMPMAP(IY ,IX-1).EQ.JJ ) THEN -#ifdef W3_DEBUGGRID - nbCase4=nbCase4 + 1 -#endif TMPSTA(IY,IX) = NSTAT END IF END IF IF (IX.LT.NX) THEN IF (TMPSTA(IY ,IX+1).EQ.NSTAT & .AND. TMPMAP(IY ,IX+1).EQ.JJ ) THEN -#ifdef W3_DEBUGGRID - nbCase5=nbCase5 + 1 -#endif TMPSTA(IY,IX) = NSTAT END IF END IF IF (IY.LT.NY) THEN IF (TMPSTA(IY+1,IX ).EQ.NSTAT & .AND. TMPMAP(IY+1,IX ).EQ.JJ ) THEN -#ifdef W3_DEBUGGRID - nbCase6=nbCase6 + 1 -#endif TMPSTA(IY,IX) = NSTAT END IF END IF IF (IY.GT.1) THEN IF (TMPSTA(IY-1,IX ).EQ.NSTAT & .AND. TMPMAP(IY-1,IX ).EQ.JJ ) THEN -#ifdef W3_DEBUGGRID - nbCase7=nbCase7 + 1 -#endif TMPSTA(IY,IX) = NSTAT END IF END IF @@ -4734,31 +4683,6 @@ SUBROUTINE W3GRID() ! ... Branch back input / excluded points ( ILOOP in 8.b ) ! END DO -#ifdef W3_DEBUGGRID - WRITE(740+IAPROC,*) 'nbCase1=', nbCase1 - WRITE(740+IAPROC,*) 'nbCase2=', nbCase2 - WRITE(740+IAPROC,*) 'nbCase3=', nbCase3 - WRITE(740+IAPROC,*) 'nbCase4=', nbCase4 - WRITE(740+IAPROC,*) 'nbCase5=', nbCase5 - WRITE(740+IAPROC,*) 'nbCase6=', nbCase6 - WRITE(740+IAPROC,*) 'nbCase7=', nbCase7 - WRITE(740+IAPROC,*) 'nbCase8=', nbCase8 - nbTMPSTA0=0 - nbTMPSTA1=0 - nbTMPSTA2=0 - DO IX=1,NX - DO IY=1,NY - WRITE(740+IAPROC,*) 'IX/IY/TMPSTA=', IX, IY, TMPSTA(IY,IX) - IF (TMPSTA(IY,IX) .eq. 0) nbTMPSTA0=nbTMPSTA0+1 - IF (TMPSTA(IY,IX) .eq. 1) nbTMPSTA1=nbTMPSTA1+1 - IF (TMPSTA(IY,IX) .eq. 2) nbTMPSTA2=nbTMPSTA2+1 - END DO - END DO - WRITE(740+IAPROC,*) 'nbTMPSTA0=', nbTMPSTA0 - WRITE(740+IAPROC,*) 'nbTMPSTA1=', nbTMPSTA1 - WRITE(740+IAPROC,*) 'nbTMPSTA2=', nbTMPSTA2 - FLUSH(740+IAPROC) -#endif ! ELSE ! FROM .EQ. PART ! From a13801e589da5912c9b6dc9f645447be7bf45d95 Mon Sep 17 00:00:00 2001 From: Mathieu Dutour Sikiric Date: Wed, 7 Sep 2022 15:45:16 +0200 Subject: [PATCH 02/17] More cleanups. --- model/src/w3wavemd.F90 | 469 ----------------------------------------- model/src/w3wdatmd.F90 | 107 ---------- model/src/ww3_ounf.F90 | 8 - model/src/ww3_shel.F90 | 174 --------------- model/src/ww3_strt.F90 | 33 --- 5 files changed, 791 deletions(-) diff --git a/model/src/w3wavemd.F90 b/model/src/w3wavemd.F90 index ad522f02b3..48f4165820 100644 --- a/model/src/w3wavemd.F90 +++ b/model/src/w3wavemd.F90 @@ -627,31 +627,12 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & CALL UOST_SETGRID(IMOD) #endif -#ifdef W3_DEBUGRUN - DO JSEA = 1, NSEAL - DO IS = 1, NSPEC - IF (VA(IS, JSEA) .LT. 0.) THEN - WRITE(740+IAPROC,*) 'NEGATIVE ACTION 1', IS, JSEA, VA(IS,JSEA) - CALL FLUSH(740+IAPROC) - CALL EXTCDE(666) - ENDIF - ENDDO - ENDDO - IF (SUM(VA) .NE. SUM(VA)) THEN - WRITE(740+IAPROC,*) 'NAN in ACTION 1', SUM(VA) - CALL FLUSH(740+IAPROC) - CALL EXTCDE(666) - ENDIF -#endif #ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "W3WAVEMD, step 1", 1) #endif -#ifdef W3_DEBUGIOBP - IF (NX .ge. 10210) WRITE(*,*) 'CRIT 1:', MAPSTA(1,10210), IOBP(10210) -#endif #endif ! @@ -752,9 +733,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! 1.a Ending time versus initial time ! DTTST = DSEC21 ( TIME , TEND ) -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) '1 : DTTST=', DTTST, TIME, TEND -#endif FLZERO = DTTST .EQ. 0. #ifdef W3_T WRITE (NDST,9010) DTTST, FLZERO @@ -950,17 +928,9 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! FLFRST = .TRUE. DO -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'First entry in the TIME LOOP' - FLUSH(740+IAPROC) -#endif #ifdef W3_TIMINGS CALL PRINT_MY_TIME("First entry in the TIME LOOP") #endif -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.1' - FLUSH(740+IAPROC) -#endif ! DO JSEA = 1, NSEAL ! DO IS = 1, NSPEC ! IF (VA(IS, JSEA) .LT. 0.) THEN @@ -1088,9 +1058,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ELSE DTTST = 0. ENDIF -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) '2 : DTTST=', DTTST, TEND, TOFRST -#endif ! IF ( DTTST.GE.0. ) THEN TCALC = TEND @@ -1099,14 +1066,8 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & END IF ! DTTST = DSEC21 ( TIME , TCALC ) -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) '3 : DTTST=', DTTST, TEND, TOFRST -#endif NT = 1 + INT ( DTTST / DTMAX - 0.001 ) DTGA = DTTST / REAL(NT) -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'DTTST=', DTTST, ' NT=', NT -#endif IF ( DTTST .EQ. 0. ) THEN IT0 = 0 IF ( .NOT.FLZERO ) ITIME = ITIME - 1 @@ -1132,23 +1093,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! DTRES = 0. -#ifdef W3_DEBUGRUN - DO JSEA = 1, NSEAL - DO IS = 1, NSPEC - IF (VA(IS, JSEA) .LT. 0.) THEN - WRITE(740+IAPROC,*) 'TEST W3WAVE 3', VA(IS,JSEA) - CALL FLUSH(740+IAPROC) - ENDIF - ENDDO - ENDDO - IF (SUM(VA) .NE. SUM(VA)) THEN - WRITE(740+IAPROC,*) 'NAN in ACTION 3', IX, IY, SUM(VA) - CALL FLUSH(740+IAPROC) - STOP - ENDIF - WRITE(740+IAPROC,*) 'IT0=', IT0, ' NT=', NT - FLUSH(740+IAPROC) -#endif ! DO IT = IT0, NT #ifdef W3_TIMINGS @@ -1188,12 +1132,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & IF ( ABS(DTRES) .LT. 0.001 ) DTRES = 0. CALL TICK21 ( TIME , DTG ) ! -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'DTGA=', DTGA, ' DTRES=', DTRES - WRITE(740+IAPROC,*) 'DTG 1 : DTG=', DTG - FLUSH(740+IAPROC) -#endif -! #ifdef W3_MEMCHECK write(40000+IAPROC,*) 'memcheck_____:', 'WW3_WAVE TIME LOOP 1' call getMallocInfo(mallinfos) @@ -1212,21 +1150,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & call printMallInfo(IAPROC+40000,mallInfos) #endif -#ifdef W3_DEBUGRUN - DO JSEA = 1, NSEAL - DO IS = 1, NSPEC - IF (VA(IS, JSEA) .LT. 0.) THEN - WRITE(740+IAPROC,*) 'TEST W3WAVE 4', VA(IS,JSEA) - CALL FLUSH(740+IAPROC) - ENDIF - ENDDO - ENDDO - IF (SUM(VA) .NE. SUM(VA)) THEN - WRITE(740+IAPROC,*) 'NAN in ACTION 4', IX, IY, SUM(VA) - CALL FLUSH(740+IAPROC) - STOP - ENDIF -#endif ! VGX = 0. VGY = 0. @@ -1256,10 +1179,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! 3.1 Interpolate winds, currents, and momentum. ! (Initialize wave fields with winds) ! -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'FLCUR=', FLCUR - FLUSH(740+IAPROC) -#endif #ifdef W3_DEBUGDCXDX WRITE(740+IAPROC,*) 'Debug DCXDX FLCUR=', FLCUR #endif @@ -1270,32 +1189,16 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #endif IF ( FLCUR ) THEN -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.4' - FLUSH(740+IAPROC) -#endif #ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "Before UCUR", 1) #endif #endif -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.4.1' - FLUSH(740+IAPROC) -#endif #ifdef W3_TIMINGS CALL PRINT_MY_TIME("W3WAVE, step 6.4.1") #endif -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.4.2 before W3UCUR' - FLUSH(740+IAPROC) -#endif CALL W3UCUR ( FLFRST ) -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.4.1 after W3UCUR' - FLUSH(740+IAPROC) -#endif #ifdef W3_MEMCHECK write(40000+IAPROC,*) 'memcheck_____:', 'WW3_WAVE TIME LOOP 3b ' @@ -1377,10 +1280,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & CALL PRINT_MY_TIME("After U10, etc. assignation") #endif ! -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.5' - FLUSH(740+IAPROC) -#endif #ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "Before call to W3UINI", 1) @@ -1390,10 +1289,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & CALL PRINT_MY_TIME("Before call W3UINI") #endif IF ( FLIWND .AND. LOCAL ) CALL W3UINI ( VA ) -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.5.1 DTG=', DTG - FLUSH(740+IAPROC) -#endif ! IF ( FLTAUA ) THEN CALL W3UTAU ( FLFRST ) @@ -1418,11 +1313,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #ifdef W3_TIMINGS CALL PRINT_MY_TIME("Before boundary update") #endif -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'FLBPI=', FLBPI - WRITE(740+IAPROC,*) 'LOCAL=', LOCAL - FLUSH(740+IAPROC) -#endif #ifdef W3_MEMCHECK write(40000+IAPROC,*) 'memcheck_____:', 'WW3_WAVE TIME LOOP 7' @@ -1495,11 +1385,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! 3.3.1 Update ice coverage (if new ice map). ! Need to be run on output nodes too, to update MAPSTx ! -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'FLICE=', FLICE - WRITE(740+IAPROC,*) 'DTI0=', DTI0 - FLUSH(740+IAPROC) -#endif IF ( FLICE .AND. DTI0.NE.0. ) THEN ! IF ( TICE(1).GE.0 ) THEN @@ -1528,15 +1413,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #ifdef W3_TIMINGS CALL PRINT_MY_TIME("After FLICE and DTI0") #endif -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.7 DTG=', DTG - FLUSH(740+IAPROC) -#endif -#ifdef W3_PDLIB -#ifdef W3_DEBUGIOBP - IF (NX .ge. 10210) WRITE(*,*) 'Before W3ULEV:', MAPSTA(1,10210), IOBP(10210) -#endif -#endif #ifdef W3_MEMCHECK write(40000+IAPROC,*) 'memcheck_____:', 'WW3_WAVE TIME LOOP 9' @@ -1616,16 +1492,8 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! ! 3.4 Transform grid (if new water level). ! -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'FLLEV=', FLLEV, ' DTL0=', DTL0 - FLUSH(740+IAPROC) -#endif IF ( FLLEV .AND. DTL0 .NE.0. ) THEN ! -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'Before time works' - FLUSH(740+IAPROC) -#endif IF ( TLEV(1) .GE. 0 ) THEN IF ( DTL0 .LT. 0. ) THEN IDACT(5:5) = 'B' @@ -1636,22 +1504,10 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ELSE IDACT(5:5) = 'I' END IF -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'After time works' - FLUSH(740+IAPROC) -#endif ! IF ( IDACT(5:5).NE.' ' ) THEN -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'Before W3ULEV' - FLUSH(740+IAPROC) -#endif CALL W3ULEV ( VA, VA ) -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'After W3ULEV' - FLUSH(740+IAPROC) -#endif UGDTUPDATE=.TRUE. CFLXYMAX = 0. @@ -1661,30 +1517,15 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & FLDDIR = FLDDIR .OR. FLCTH .OR. FSREFRACTION & .OR. FLCK .OR. FSFREQSHIFT END IF -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'After IDACT if test' - FLUSH(740+IAPROC) -#endif END IF -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'After FLLEV test' - FLUSH(740+IAPROC) -#endif #ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "After FFLEV and DTL0", 1) #endif -#ifdef W3_DEBUGIOBP - IF (NX .ge. 10210) WRITE(*,*) ' After W3ULEV:', MAPSTA(1,10210), IOBP(10210) -#endif #endif #ifdef W3_TIMINGS CALL PRINT_MY_TIME("After FFLEV and DTL0") #endif -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'FLMAP=', FLMAP - FLUSH(740+IAPROC) -#endif #ifdef W3_MEMCHECK write(40000+IAPROC,*) 'memcheck_____:', 'WW3_WAVE TIME LOOP 11b' @@ -1716,16 +1557,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & FLMAP = .FALSE. END IF ! -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.8.1 DTG=', DTG - FLUSH(740+IAPROC) -#endif ! -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.8.2 DTG=', DTG - WRITE(740+IAPROC,*) 'FLDDIR=', FLDDIR - FLUSH(740+IAPROC) -#endif IF ( FLDDIR ) THEN IF (GTYPE .EQ. SMCTYPE) THEN IX = 1 @@ -1747,10 +1579,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & call printMallInfo(IAPROC+40000,mallInfos) #endif -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.8.3 DTG=', DTG - FLUSH(740+IAPROC) -#endif ! ! Calculate PHASE SPEED GRADIENT. DCDX = 0. @@ -1770,10 +1598,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & END IF #endif ! -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.8.4' - FLUSH(740+IAPROC) -#endif ! FLIWND = .FALSE. FLFRST = .FALSE. @@ -1877,16 +1701,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & D50=SED_D50(ISEA) PSIC=SED_PSIC(ISEA) #endif -! -#ifdef W3_DEBUGRUN - DO IS = 1, NSPEC - IF (VA(IS, JSEA) .LT. 0.) THEN - WRITE(740+IAPROC,*) 'TEST W3WAVE 7', VA(IS,JSEA) - CALL FLUSH(740+IAPROC) - ENDIF - ENDDO -#endif - ! #ifdef W3_PDLIB IF ((IOBP_LOC(JSEA) .eq. 1 .or. IOBP_LOC(JSEA) .eq. 3) & @@ -1984,18 +1798,9 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! DTG = 60. GOTO 370 END IF -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.8.5' - WRITE(740+IAPROC,*) 'FLDRY=', FLDRY - FLUSH(740+IAPROC) -#endif IF ( FLDRY .OR. IAPROC.GT.NAPROC ) THEN #ifdef W3_T WRITE (NDST,9023) -#endif -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'Jump to 380' - FLUSH(740+IAPROC) #endif GOTO 380 END IF @@ -2004,17 +1809,8 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! #ifdef W3_T WRITE(NDSE,*) 'Computing CFLs .... ',NSEAL -#endif -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'FLOGRD(9,3) = ', FLOGRD(9,3) - WRITE(740+IAPROC,*) 'UGDTUPDATE=', UGDTUPDATE - FLUSH(740+IAPROC) #endif IF ( FLOGRD(9,3).AND. UGDTUPDATE ) THEN -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.8.6' - FLUSH(740+IAPROC) -#endif IF (FSTOTALIMP .eqv. .FALSE.) THEN NKCFL=NK #ifdef W3_T @@ -2059,10 +1855,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! END IF END IF -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.8.7' - FLUSH(740+IAPROC) -#endif #ifdef W3_MEMCHECK write(40000+IAPROC,*) 'memcheck_____:', 'WW3_WAVE TIME LOOP 15' @@ -2070,21 +1862,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & call printMallInfo(IAPROC+40000,mallInfos) #endif ! -#ifdef W3_DEBUGRUN - DO JSEA = 1, NSEAL - DO IS = 1, NSPEC - IF (VA(IS, JSEA) .LT. 0.) THEN - WRITE(740+IAPROC,*) 'TEST W3WAVE 8', VA(IS,JSEA) - CALL FLUSH(740+IAPROC) - ENDIF - ENDDO - ENDDO - IF (SUM(VA) .NE. SUM(VA)) THEN - WRITE(740+IAPROC,*) 'NAN in ACTION 6 ', IX, IY, SUM(VA) - CALL FLUSH(740+IAPROC) - STOP - ENDIF -#endif ! #ifdef W3_T @@ -2126,13 +1903,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #endif ! FACTH = DTG / (DTH*REAL(NTLOC)) -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, DTCFLI=', DTCFLI - WRITE(740+IAPROC,*) 'W3WAVE, DTG=', DTG - WRITE(740+IAPROC,*) 'W3WAVE, DTH=', DTH - WRITE(740+IAPROC,*) 'W3WAVE, NTLOC=', NTLOC - FLUSH(740+IAPROC) -#endif FACK = DTG / REAL(NTLOC) TTEST(1) = TIME(1) @@ -2149,11 +1919,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #endif #ifdef W3_TIMINGS CALL PRINT_MY_TIME("Before intraspectral") -#endif -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.10' - WRITE(740+IAPROC,*) 'FLCTH=', FLCTH, ' FLCK=', FLCK - FLUSH(740+IAPROC) #endif IF ( FLCTH .OR. FLCK ) THEN DO ITLOC=1, ITLOCH @@ -2163,18 +1928,11 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & !$OMP DO SCHEDULE (DYNAMIC,1) #endif ! -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) ' ITLOC=', ITLOC - WRITE(740+IAPROC,*) ' 1: Before call to W3KTP1 / W3KTP2 / W3KTP3' -#endif DO JSEA=1, NSEAL CALL INIT_GET_ISEA(ISEA, JSEA) IX = MAPSF(ISEA,1) IY = MAPSF(ISEA,2) -#ifdef W3_DEBUGRUN - IF (JSEA == DEBUG_NODE) WRITE(*,*) 'W3WAVE TEST', SUM(VA(:,JSEA)) -#endif IF ( GTYPE .EQ. UNGTYPE ) THEN IF (LPDLIB) THEN @@ -2265,29 +2023,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! ! 3.6.3 Longitude-latitude ! (time step correction in routine) -! -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.12' - WRITE(740+IAPROC,*) 'FSN=', FSN - WRITE(740+IAPROC,*) 'FSPSI=', FSPSI - WRITE(740+IAPROC,*) 'FSFCT=', FSFCT - WRITE(740+IAPROC,*) 'FSNIMP=', FSNIMP - WRITE(740+IAPROC,*) 'FLCTH=', FLCTH - WRITE(740+IAPROC,*) 'FSREFRACTION=', FSREFRACTION - WRITE(740+IAPROC,*) 'FLCK=', FLCK - WRITE(740+IAPROC,*) 'FSFREQSHIFT=', FSFREQSHIFT - WRITE(740+IAPROC,*) 'FLSOU=', FLSOU - WRITE(740+IAPROC,*) 'FSSOURCE=', FSSOURCE - WRITE(740+IAPROC,*) 'FSTOTALIMP=', FSTOTALIMP - WRITE(740+IAPROC,*) 'FSTOTALEXP=', FSTOTALEXP - WRITE(740+IAPROC,*) 'FLCUR=', FLCUR - WRITE(740+IAPROC,*) 'PDLIB=', LPDLIB - WRITE(740+IAPROC,*) 'GTYPE=', GTYPE - WRITE(740+IAPROC,*) 'UNGTYPE=', UNGTYPE - WRITE(740+IAPROC,*) 'NAPROC=', NAPROC, 'NTPROC=', NTPROC - WRITE(740+IAPROC,*) 'FLCX=', FLCX, ' FLCY=', FLCY - FLUSH(740+IAPROC) -#endif ! IF (GTYPE .EQ. UNGTYPE) THEN IF (FLAGLL) THEN @@ -2301,20 +2036,12 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #ifdef W3_PDLIB IF ((FSTOTALIMP .eqv. .FALSE.).and.(FLCX .or. FLCY)) THEN #endif -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.12.1' - FLUSH(740+IAPROC) -#endif #ifdef W3_PDLIB DO ISPEC=1,NSPEC CALL PDLIB_W3XYPUG ( ISPEC, FACX, FACX, DTG, & VGX, VGY, UGDTUPDATE ) END DO #endif -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.12.2' - FLUSH(740+IAPROC) -#endif #ifdef W3_PDLIB END IF #endif @@ -2322,11 +2049,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #ifdef W3_PDLIB IF (FSTOTALIMP .and. (IT .ne. 0)) THEN #endif -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.12.3A' - WRITE(*,*), 'W3WAVE, step 6.12.3A' - FLUSH(740+IAPROC) -#endif #ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "Before Block implicit", 1) @@ -2335,36 +2057,17 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #ifdef W3_PDLIB CALL PDLIB_W3XYPUG_BLOCK_IMPLICIT(IMOD, FACX, FACX, DTG, VGX, VGY) #endif -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.12.4A' - WRITE(*,*), 'W3WAVE, step 6.12.4A' - FLUSH(740+IAPROC) -#endif #ifdef W3_PDLIB ELSE IF(FSTOTALEXP .and. (IT .ne. 0)) THEN #endif -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.12.3B' - WRITE(*,*), 'W3WAVE, step 6.12.3B' - FLUSH(740+IAPROC) -#endif #ifdef W3_PDLIB CALL PDLIB_W3XYPUG_BLOCK_EXPLICIT(IMOD, FACX, FACX, DTG, VGX, VGY) #endif -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.12.4B' - WRITE(*,*), 'W3WAVE, step 6.12.4B' - FLUSH(740+IAPROC) -#endif #ifdef W3_PDLIB ENDIF #endif ELSE IF (FLCX .or. FLCY) THEN -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.13' - FLUSH(740+IAPROC) -#endif ! #ifdef W3_MPI IF ( NRQSG1 .GT. 0 ) THEN @@ -2373,10 +2076,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & END IF #endif ! -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.14' - FLUSH(740+IAPROC) -#endif ! ! Initialize FIELD variable FIELD = 0. @@ -2564,12 +2263,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #ifdef W3_TIMINGS CALL PRINT_MY_TIME("After spatial advection") #endif -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.16' - WRITE(740+IAPROC,*) 'NTLOC=', NTLOC - WRITE(740+IAPROC,*) 'ITLOCH=', ITLOCH - FLUSH(740+IAPROC) -#endif ! ! 3.6.4 Intra-spectral part 2 ! @@ -2581,18 +2274,11 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & !$OMP DO SCHEDULE (DYNAMIC,1) #endif ! -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) ' ITLOC=', ITLOC - WRITE(740+IAPROC,*) ' 2: Before call to W3KTP1 / W3KTP2 / W3KTP3' -#endif DO JSEA = 1, NSEAL CALL INIT_GET_ISEA(ISEA, JSEA) IX = MAPSF(ISEA,1) IY = MAPSF(ISEA,2) -#ifdef W3_DEBUGRUN - IF (JSEA == DEBUG_NODE) WRITE(*,*) 'W3WAVE TEST', SUM(VA(:,JSEA)) -#endif DEPTH = MAX ( DMIN , DW(ISEA) ) IF ( GTYPE .EQ. UNGTYPE ) THEN @@ -2674,11 +2360,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #endif ! UGDTUPDATE = .FALSE. -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.17' - WRITE(740+IAPROC,*) 'FSSOURCE=', FSSOURCE - FLUSH(740+IAPROC) -#endif ! ! 3.6 End propapgation = = = = = = = = = = = = = = = = = = = = = = = = @@ -2743,9 +2424,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & PSIC=SED_PSIC(ISEA) #endif -#ifdef W3_DEBUGRUN - IF (JSEA == DEBUG_NODE) WRITE(*,*) 'W3WAVE TEST', ISEA, JSEA, SUM(VA(:,JSEA)) -#endif IF ( MAPSTA(IY,IX) .EQ. 1 .AND. FLAGST(ISEA)) THEN TMP1 = WHITECAP(JSEA,1:4) @@ -2818,30 +2496,8 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & FCUT (JSEA) = UNDEF ! VA(:,JSEA) = 0. END IF -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'RET: min/max/sum(VA)=',minval(VA(:,JSEA)),maxval(VA(:,JSEA)),sum(VA(:,JSEA)) -#endif END DO -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'min/max/sum(VAtot)=', minval(VA), maxval(VA), sum(VA) - FLUSH(740+IAPROC) -#endif -#ifdef W3_DEBUGRUN - DO JSEA = 1, NSEAL - DO IS = 1, NSPEC - IF (VA(IS, JSEA) .LT. 0.) THEN - WRITE(740+IAPROC,*) 'TEST W3WAVE 9', VA(IS,JSEA) - CALL FLUSH(740+IAPROC) - ENDIF - ENDDO - ENDDO - IF (SUM(VA) .NE. SUM(VA)) THEN - WRITE(740+IAPROC,*) 'NAN in ACTION 7', IX, IY, SUM(VA) - CALL FLUSH(740+IAPROC) - STOP - ENDIF -#endif ! #ifdef W3_OMPG @@ -2871,10 +2527,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & !!/MPI CALL MPI_BARRIER (MPI_COMM_WCMP,IERR_MPI) ! END IF -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.18' - FLUSH(740+IAPROC) -#endif #ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "After source terms", 1) @@ -2893,33 +2545,12 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #endif ! -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.19' - FLUSH(740+IAPROC) - DO JSEA = 1, NSEAL - DO IS = 1, NSPEC - IF (VA(IS, JSEA) .LT. 0.) THEN - WRITE(740+IAPROC,*) 'TEST W3WAVE 10', VA(IS,JSEA) - CALL FLUSH(740+IAPROC) - ENDIF - ENDDO - ENDDO - IF (SUM(VA) .NE. SUM(VA)) THEN - WRITE(740+IAPROC,*) 'NAN in ACTION 8', IX, IY, SUM(VA) - CALL FLUSH(740+IAPROC) - STOP - ENDIF -#endif ! ! 3.8 Update global time step. ! (Branch point FLDRY, IT=0) ! 380 CONTINUE ! -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.20' - FLUSH(740+IAPROC) -#endif IF (IT.NE.NT) THEN DTTST = DSEC21 ( TIME , TCALC ) DTG = DTTST / REAL(NT-IT) @@ -2938,10 +2569,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & FLACT = .FALSE. IDACT = ' ' END IF -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.21' - FLUSH(740+IAPROC) -#endif ! #ifdef W3_PDLIB #ifdef W3_DEBUGCOH @@ -2955,10 +2582,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! END DO -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.21.1' - FLUSH(740+IAPROC) -#endif #ifdef W3_TIMINGS CALL PRINT_MY_TIME("W3WAVE, step 6.21.1") #endif @@ -2981,10 +2604,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! 4.a Check if time is output time ! Delay if data assimilation time. ! -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.21.2' - FLUSH(740+IAPROC) -#endif ! IF ( TOFRST(1) .EQ. -1 ) THEN DTTST = 1. @@ -3005,15 +2624,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & WRITE (NDST,9040) TOFRST, TDN, DTTST, DTTST1, FLAG_O #endif ! -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.21.3' - FLUSH(740+IAPROC) -#endif IF ( DTTST.LE.0. .AND. DTTST1.NE.0. .AND. FLAG_O ) THEN -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.21.4' - FLUSH(740+IAPROC) -#endif ! #ifdef W3_T WRITE (NDST,9041) @@ -3036,16 +2647,8 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & FLPART = .FALSE. IF ( FLOUT(1) .AND. FLPFLD ) & FLPART = FLPART .OR. DSEC21(TIME,TONEXT(:,1)).EQ.0. -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.21.7' - FLUSH(740+IAPROC) -#endif IF ( FLOUT(6) ) & FLPART = FLPART .OR. DSEC21(TIME,TONEXT(:,6)).EQ.0. -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'W3WAVE, step 6.21.8' - FLUSH(740+IAPROC) -#endif ! #ifdef W3_T WRITE (NDST,9042) LOCAL, FLPART, FLOUTG @@ -3067,18 +2670,9 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & IF (.NOT. LPDLIB .or. (GTYPE.ne.UNGTYPE)) THEN IF (NRQGO.NE.0 ) THEN #endif -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'BEFORE STARTALL NRQGO.NE.0 , step 0', & - NRQGO, IRQGO, GTYPE, UNGTYPE, .NOT. LPDLIB .or. (GTYPE.ne.UNGTYPE) - FLUSH(740+IAPROC) -#endif #ifdef W3_MPI CALL MPI_STARTALL ( NRQGO, IRQGO , IERR_MPI ) #endif -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'AFTER STARTALL NRQGO.NE.0, step 0' - FLUSH(740+IAPROC) -#endif #ifdef W3_MPI FLGMPI(0) = .TRUE. @@ -3094,18 +2688,9 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #ifdef W3_MPI IF (NRQGO2.NE.0 ) THEN #endif -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'BEFORE STARTALL NRQGO2.NE.0, step 0', & - NRQGO2, IRQGO2, GTYPE, UNGTYPE, .NOT. LPDLIB .or. (GTYPE.ne.UNGTYPE) - FLUSH(740+IAPROC) -#endif #ifdef W3_MPI CALL MPI_STARTALL ( NRQGO2, IRQGO2, IERR_MPI ) #endif -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'AFTER STARTALL NRQGO2.NE.0, step 0' - FLUSH(740+IAPROC) -#endif #ifdef W3_MPI FLGMPI(1) = .TRUE. NRQMAX = MAX ( NRQMAX , NRQGO2 ) @@ -3117,10 +2702,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & END IF ELSE #endif -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'BEFORE DO_OUTPUT_EXCHANGES, step 0' - FLUSH(740+IAPROC) -#endif #ifdef W3_PDLIB CALL DO_OUTPUT_EXCHANGES(IMOD) #endif @@ -3136,10 +2717,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #endif ! -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'After DO_OUTPUT_EXCHANGES, step 1' - FLUSH(740+IAPROC) -#endif #ifdef W3_MPI IF ( FLOUT(2) .AND. NRQPO.NE.0 ) THEN IF ( DSEC21(TIME,TONEXT(:,2)).EQ.0. ) THEN @@ -3155,10 +2732,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & END IF #endif ! -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'After DO_OUTPUT_EXCHANGES, step 2' - FLUSH(740+IAPROC) -#endif #ifdef W3_MPI IF ( FLOUT(4) .AND. NRQRS.NE.0 ) THEN IF ( DSEC21(TIME,TONEXT(:,4)).EQ.0. ) THEN @@ -3174,10 +2747,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & END IF #endif ! -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'After DO_OUTPUT_EXCHANGES, step 2' - FLUSH(740+IAPROC) -#endif #ifdef W3_MPI IF ( FLOUT(8) .AND. NRQRS.NE.0 ) THEN IF ( DSEC21(TIME,TONEXT(:,8)).EQ.0. ) THEN @@ -3193,10 +2762,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & END IF #endif ! -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'After DO_OUTPUT_EXCHANGES, step 3' - FLUSH(740+IAPROC) -#endif #ifdef W3_MPI IF ( FLOUT(5) .AND. NRQBP.NE.0 ) THEN IF ( DSEC21(TIME,TONEXT(:,5)).EQ.0. ) THEN @@ -3212,10 +2777,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & END IF #endif ! -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'After DO_OUTPUT_EXCHANGES, step 4' - FLUSH(740+IAPROC) -#endif #ifdef W3_MPI IF ( FLOUT(5) .AND. NRQBP2.NE.0 .AND. & IAPROC.EQ.NAPBPT) THEN @@ -3231,10 +2792,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & END IF #endif ! -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'After DO_OUTPUT_EXCHANGES, step 5' - FLUSH(740+IAPROC) -#endif #ifdef W3_MPI IF ( NRQMAX .NE. 0 ) ALLOCATE & ( STATIO(MPI_STATUS_SIZE,NRQMAX) ) @@ -3249,35 +2806,14 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! ! 4.c Reset next output time -#ifdef W3_DEBUGRUN - IF (MINVAL(VA) .LT. 0.) THEN - WRITE(740+IAPROC,*) 'TEST W3WAVE 12', SUM(VA), MINVAL(VA), MAXVAL(VA) - CALL FLUSH(740+IAPROC) - STOP - ENDIF - IF (SUM(VA) .NE. SUM(VA)) THEN - WRITE(740+IAPROC,*) 'NAN in ACTION 9', IX, IY, SUM(VA) - CALL FLUSH(740+IAPROC) - STOP - ENDIF -#endif ! TOFRST(1) = -1 TOFRST(2) = 0 ! DO J=1, NOTYPE -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'NOTYPE, J=', J - FLUSH(740+IAPROC) -#endif IF ( FLOUT(J) ) THEN ! -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'Matching FLOUT(J)' - FLUSH(740+IAPROC) -#endif -! ! 4.d Perform output ! #ifdef W3_NL5 @@ -3429,11 +2965,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & J=8 IF ( FLOUT(J) ) THEN ! -#ifdef W3_DEBUGRUN - WRITE(740+IAPROC,*) 'Matching FLOUT(J)' - FLUSH(740+IAPROC) -#endif -! ! 4.d Perform output ! TOUT(:) = TONEXT(:,J) diff --git a/model/src/w3wdatmd.F90 b/model/src/w3wdatmd.F90 index 05432b6181..c29677fed5 100644 --- a/model/src/w3wdatmd.F90 +++ b/model/src/w3wdatmd.F90 @@ -455,10 +455,6 @@ SUBROUTINE W3DIMW ( IMOD, NDSE, NDST, F_ONLY ) #ifdef W3_S CALL STRACE (IENT, 'W3DIMW') #endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3DIMW, step 1' - FLUSH(740+IAPROC) -#endif ! ! -------------------------------------------------------------------- / @@ -469,37 +465,21 @@ SUBROUTINE W3DIMW ( IMOD, NDSE, NDST, F_ONLY ) ELSE FL_ALL = .TRUE. END IF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3DIMW, step 2' - FLUSH(740+IAPROC) -#endif ! IF ( NGRIDS .EQ. -1 ) THEN WRITE (NDSE,1001) CALL EXTCDE (1) END IF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3DIMW, step 3' - FLUSH(740+IAPROC) -#endif ! IF ( IMOD.LT.1 .OR. IMOD.GT.NWDATA ) THEN WRITE (NDSE,1002) IMOD, NWDATA CALL EXTCDE (2) END IF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3DIMW, step 4' - FLUSH(740+IAPROC) -#endif ! IF ( WDATAS(IMOD)%DINIT ) THEN WRITE (NDSE,1003) CALL EXTCDE (3) END IF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3DIMW, step 5' - FLUSH(740+IAPROC) -#endif ! #ifdef W3_T WRITE (NDST,9000) IMOD @@ -507,100 +487,41 @@ SUBROUTINE W3DIMW ( IMOD, NDSE, NDST, F_ONLY ) ! JGRID = IGRID IF ( JGRID .NE. IMOD ) CALL W3SETG ( IMOD, NDSE, NDST ) -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3DIMW, step 6' - FLUSH(740+IAPROC) -#endif ! ! -------------------------------------------------------------------- / ! 2. Allocate arrays ! CALL SET_UP_NSEAL_NSEALM(NSEAL_DUMMY, NSEALM) -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3DIMW, step 7' - FLUSH(740+IAPROC) -#endif NSEATM = NSEALM * NAPROC -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3DIMW, step 8' - FLUSH(740+IAPROC) -#endif ! IF ( FL_ALL ) THEN -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3DIMW, step 8' - FLUSH(740+IAPROC) -#endif ALLOCATE ( WDATAS(IMOD)%VA(NSPEC,0:NSEALM), STAT=ISTAT ); WDATAS(IMOD)%VA = 0. -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3DIMW, step 8.1' - FLUSH(740+IAPROC) -#endif CHECK_ALLOC_STATUS ( ISTAT ) -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3DIMW, step 8.2' - FLUSH(740+IAPROC) -#endif -!!/PDLIB ALLOCATE ( WDATAS(IMOD)%VAOLD(NSPEC,0:NSEALM) ) -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3DIMW, step 8.3' - FLUSH(740+IAPROC) -#endif #ifdef W3_PDLIB ALLOCATE ( WDATAS(IMOD)%SHAVETOT(NSEAL), stat=istat ) #endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3DIMW, step 8.4, stat=', istat - FLUSH(740+IAPROC) -#endif #ifdef W3_PDLIB IF (.not. LSLOC) THEN ALLOCATE ( WDATAS(IMOD)%VSTOT(NSPEC,NSEAL), stat=istat ) #endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3DIMW, step 8.5, stat=', istat - FLUSH(740+IAPROC) -#endif #ifdef W3_PDLIB ALLOCATE ( WDATAS(IMOD)%VDTOT(NSPEC,NSEAL), stat=istat ) #endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3DIMW, step 8.6, stat=', istat - FLUSH(740+IAPROC) -#endif #ifdef W3_PDLIB ENDIF ! LSLOC ALLOCATE ( WDATAS(IMOD)%VAOLD(NSPEC,NSEAL), stat=istat ) #endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3DIMW, step 8.7, stat=', istat - FLUSH(740+IAPROC) -#endif #ifdef W3_PDLIB IF (.not. LSLOC) THEN WDATAS(IMOD)%VSTOT=0 #endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3DIMW, step 8.8' - FLUSH(740+IAPROC) -#endif #ifdef W3_PDLIB WDATAS(IMOD)%VDTOT=0 #endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3DIMW, step 8.9' - FLUSH(740+IAPROC) -#endif #ifdef W3_PDLIB ENDIF ! LSLOC WDATAS(IMOD)%SHAVETOT=.FALSE. #endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3DIMW, step 8.10' - FLUSH(740+IAPROC) - WRITE(740+IAPROC,*) 'NSEAL=', NSEAL, ' NSEALM=', NSEALM - FLUSH(740+IAPROC) -#endif ! ! * Four arrays for NL5 (QL) ! * AFAIK, the set up of QR5TIM0, QR5CVK0, QC5INT0 should be similar @@ -629,15 +550,7 @@ SUBROUTINE W3DIMW ( IMOD, NDSE, NDST, F_ONLY ) #endif ! IF ( NSEAL .NE. NSEALM ) THEN -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before settings to ZERO' - FLUSH(740+IAPROC) -#endif DO ISEA=NSEAL+1,NSEALM -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'ISEA=', ISEA - FLUSH(740+IAPROC) -#endif WDATAS(IMOD)%VA(:,ISEA) = 0. ! #ifdef W3_NL5 @@ -648,16 +561,8 @@ SUBROUTINE W3DIMW ( IMOD, NDSE, NDST, F_ONLY ) #endif END DO END IF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3DIMW, step 8.11' - FLUSH(740+IAPROC) -#endif END IF ! -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3DIMW, step 9' - FLUSH(740+IAPROC) -#endif ! ICE, ICEH, ICEF must be defined from 0:NSEA ALLOCATE ( WDATAS(IMOD)%WLV(NSEA), & WDATAS(IMOD)%ICE(0:NSEA), & @@ -674,10 +579,6 @@ SUBROUTINE W3DIMW ( IMOD, NDSE, NDST, F_ONLY ) WDATAS(IMOD)%ASF(NSEATM), & WDATAS(IMOD)%FPIS(NSEATM), STAT=ISTAT ) CHECK_ALLOC_STATUS ( ISTAT ) -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3DIMW, step 10' - FLUSH(740+IAPROC) -#endif WDATAS(IMOD)%WLV (:) = 0. WDATAS(IMOD)%ICE (0:NSEA) = 0. @@ -694,10 +595,6 @@ SUBROUTINE W3DIMW ( IMOD, NDSE, NDST, F_ONLY ) WDATAS(IMOD)%ASF (:) = 0. WDATAS(IMOD)%FPIS (:) = 0. WDATAS(IMOD)%DINIT = .TRUE. -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3DIMW, step 11' - FLUSH(740+IAPROC) -#endif CALL W3SETW ( IMOD, NDSE, NDST ) ! #ifdef W3_T @@ -709,10 +606,6 @@ SUBROUTINE W3DIMW ( IMOD, NDSE, NDST, F_ONLY ) ! IF ( JGRID .NE. IMOD ) CALL W3SETG ( JGRID, NDSE, NDST ) ! -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3DIMW, step 12' - FLUSH(740+IAPROC) -#endif RETURN ! ! Formats diff --git a/model/src/ww3_ounf.F90 b/model/src/ww3_ounf.F90 index c6766b803f..a325f9f761 100644 --- a/model/src/ww3_ounf.F90 +++ b/model/src/ww3_ounf.F90 @@ -169,9 +169,7 @@ PROGRAM W3OUNF USE W3IOGOMD, ONLY: W3IOGO, W3READFLGRD, W3FLGRDFLAG USE W3INITMD, ONLY: WWVER, SWITCHES USE W3ODATMD, ONLY: NAPROC, NOSWLL, PTMETH, PTFCUT -#ifdef W3_DEBUG USE W3ODATMD, only : IAPROC -#endif !/ USE W3GDATMD USE W3WDATMD, ONLY: TIME, WLV, ICE, ICEH, ICEF, BERG, & @@ -305,12 +303,6 @@ PROGRAM W3OUNF !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 3. Read general data and first fields from file ! -#ifdef W3_DEBUG - WRITE (NDSO,*) 'Before FLOGRD(2,1)=', FLOGRD(2,1) - WRITE (NDSO,*) 'IAPROC=', IAPROC - WRITE(740+IAPROC,*) 'Calling W3IOGO from ww3_ounf' - FLUSH(740+IAPROC) -#endif CALL W3IOGO ( 'READ', NDSOG, IOTEST ) ! WRITE (NDSO,930) diff --git a/model/src/ww3_shel.F90 b/model/src/ww3_shel.F90 index f809dedd6a..89e0293579 100644 --- a/model/src/ww3_shel.F90 +++ b/model/src/ww3_shel.F90 @@ -473,9 +473,6 @@ PROGRAM W3SHEL CALL CPL_OASIS_INIT(MPI_COMM) ELSE #endif -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), 'Before MPI_INIT, ww3_shel' -#endif #ifdef W3_OMPH ! For hybrid MPI-OpenMP specify required thread level. JGLi06Sep2019 IF( FLHYBR ) THEN @@ -488,9 +485,6 @@ PROGRAM W3SHEL #ifdef W3_OMPH ENDIF #endif -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), 'After MPI_INIT, ww3_shel' -#endif #ifdef W3_MPI MPI_COMM = MPI_COMM_WORLD #endif @@ -502,9 +496,6 @@ PROGRAM W3SHEL #ifdef W3_MPI CALL MPI_COMM_SIZE ( MPI_COMM, NAPROC, IERR_MPI ) #endif -#ifdef W3_DEBUGINIT - write(740+IAPROC,*) 'After MPI_COMM_SIZE, NAPROC=', NAPROC -#endif #ifdef W3_MPI CALL MPI_COMM_RANK ( MPI_COMM, IAPROC, IERR_MPI ) IAPROC = IAPROC + 1 @@ -525,10 +516,6 @@ PROGRAM W3SHEL ! 1. IO set-up ! 1.a For shell ! -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'ww3_shel, step 1' - FLUSH(740+IAPROC) -#endif NDSI = 10 NDSS = 90 NDSO = 6 @@ -560,10 +547,6 @@ PROGRAM W3SHEL NDSF(7) = 17 NDSF(8) = 18 NDSF(9) = 19 -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'ww3_shel, step 2' - FLUSH(740+IAPROC) -#endif ! #ifdef W3_NCO ! @@ -665,10 +648,6 @@ PROGRAM W3SHEL FLLSTI = .FALSE. ! This is associated with J.EQ.4 (ice) FLLSTR = .FALSE. ! This is associated with J.EQ.6 (rhoa) FLLST_ALL = .FALSE. ! For all -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'ww3_shel, step 3' - FLUSH(740+IAPROC) -#endif ! If using experimental mud or ice physics, additional lines will ! be read in from ww3_shel.inp and applied, so JFIRST is changed from @@ -698,11 +677,6 @@ PROGRAM W3SHEL JFIRST=-7 #endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'ww3_shel, step 4' - WRITE(740+IAPROC,*) 'JFIRST=', JFIRST - FLUSH(740+IAPROC) -#endif #ifdef W3_MEMCHECK write(740+IAPROC,*) 'memcheck_____:', 'WW3_SHEL SECTION 2a' @@ -1229,23 +1203,10 @@ PROGRAM W3SHEL ! IF (.NOT. FLGNML) THEN -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) ' FNMPRE=', TRIM(FNMPRE) - FLUSH(740+IAPROC) -#endif OPEN (NDSI,FILE=TRIM(FNMPRE)//'ww3_shel.inp',STATUS='OLD',IOSTAT=IERR) REWIND (NDSI) -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before read 2002, case 1' - FLUSH(740+IAPROC) -#endif !AR: I changed the error handling for err=2002, see commit message ... READ (NDSI,'(A)') COMSTR -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) ' COMSTR=', COMSTR - WRITE(740+IAPROC,*) ' After read 2002, case 1' - FLUSH(740+IAPROC) -#endif IF (COMSTR.EQ.' ') COMSTR = '$' IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,901) COMSTR @@ -1255,27 +1216,9 @@ PROGRAM W3SHEL DO J=JFIRST, 9 CALL NEXTLN ( COMSTR , NDSI , NDSEN ) IF ( J .LE. 6 ) THEN -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before read 2002, case 2' - FLUSH(740+IAPROC) -#endif READ (NDSI,*) FLAGTFC(J), FLH(J) -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) ' J=', J, ' FLAGTFC=', FLAGTFC(J), ' FLH=', FLH(J) - WRITE(740+IAPROC,*) ' After read 2002, case 2' - FLUSH(740+IAPROC) -#endif ELSE -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before read 2002, case 3' - FLUSH(740+IAPROC) -#endif READ (NDSI,*) FLAGTFC(J) -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) ' J=', J, ' FLAGTFC=', FLAGTFC(J) - WRITE(740+IAPROC,*) ' After read 2002, case 3' - FLUSH(740+IAPROC) -#endif END IF END DO @@ -1321,10 +1264,6 @@ PROGRAM W3SHEL call printMallInfo(IAPROC,mallInfos) #endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'ww3_shel, step 5' - FLUSH(740+IAPROC) -#endif ! INFLAGS1(10) = .FALSE. #ifdef W3_MGW @@ -1367,13 +1306,7 @@ PROGRAM W3SHEL ! 2.2 Time setup CALL NEXTLN ( COMSTR , NDSI , NDSEN ) -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), 'Before read 2002, case 4' -#endif READ (NDSI,*) TIME0 -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), ' After read 2002, case 4' -#endif #ifdef W3_MEMCHECK write(740+IAPROC,*) 'memcheck_____:', 'WW3_SHEL SECTION 2c' @@ -1382,17 +1315,7 @@ PROGRAM W3SHEL #endif CALL NEXTLN ( COMSTR , NDSI , NDSEN ) -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), 'Before read 2002, case 5' -#endif READ (NDSI,*) TIMEN -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), ' After read 2002, case 5' -#endif - -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), 'ww3_shel, step 6' -#endif ! #ifdef W3_MEMCHECK write(740+IAPROC,*) 'memcheck_____:', 'WW3_SHEL SECTION 2d' @@ -1402,22 +1325,13 @@ PROGRAM W3SHEL ! 2.3 Domain setup -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), 'ww3_shel, step 7' -#endif CALL NEXTLN ( COMSTR , NDSI , NDSEN ) -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), 'Before read 2002, case 6' -#endif READ (NDSI,*) IOSTYP #ifdef W3_PDLIB IF (IOSTYP .gt. 1) THEN WRITE(*,*) 'IOSTYP not supported in domain decomposition mode' CALL EXTCDE ( 6666 ) ENDIF -#endif -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), ' After read 2002, case 6' #endif CALL W3IOGR ( 'GRID', NDSF(7) ) IF ( FLAGLL ) THEN @@ -1426,9 +1340,6 @@ PROGRAM W3SHEL FACTOR = 1.E-3 END IF -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), 'ww3_shel, step 8' -#endif ! 2.4 Output dates @@ -1436,18 +1347,9 @@ PROGRAM W3SHEL NOTYPE = 6 #ifdef W3_COU NOTYPE = 7 -#endif -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), 'Before NOTYPE loop' #endif DO J = 1, NOTYPE -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), 'J=', J, '/ NOTYPE=', NOTYPE -#endif CALL NEXTLN ( COMSTR , NDSI , NDSEN ) -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), 'Before read 2002, case 7' -#endif ! ! CHECKPOINT IF(J .EQ. 4) THEN @@ -1528,9 +1430,6 @@ PROGRAM W3SHEL END IF ! WRITE(*,*) 'OFILES(J)= ', OFILES(J),J ! -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), ' After read 2002, case 7' -#endif ODAT(5*(J-1)+3) = MAX ( 0 , ODAT(5*(J-1)+3) ) ! #ifdef W3_MEMCHECK @@ -1545,9 +1444,6 @@ PROGRAM W3SHEL IF ( ODAT(5*(J-1)+3) .NE. 0 ) THEN ! Type 1: fields of mean wave parameters -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), 'Case analysis' -#endif IF ( J .EQ. 1 ) THEN CALL W3READFLGRD ( NDSI, NDSO, 9, NDSEN, COMSTR, FLGD, & FLGRD, IAPROC, NAPOUT, IERR ) @@ -1583,13 +1479,7 @@ PROGRAM W3SHEL NPTS = 0 DO CALL NEXTLN ( COMSTR , NDSI , NDSEN ) -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), 'Before read 2002, case 8' -#endif READ (NDSI2,*) XX, YY, PN -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), ' After read 2002, case 8' -#endif IF ( ILOOP.EQ.1 .AND. IAPROC.EQ.1 ) THEN BACKSPACE (NDSI) READ (NDSI,'(A)') LINE @@ -1644,13 +1534,7 @@ PROGRAM W3SHEL ! Type 3: track output ELSE IF ( J .EQ. 3 ) THEN CALL NEXTLN ( COMSTR , NDSI , NDSEN ) -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), 'Before read 2002, case 9' -#endif READ (NDSI,*) TFLAGI -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), ' After read 2002, case 9' -#endif ! IF ( .NOT. TFLAGI ) NDS(11) = -NDS(11) IF ( IAPROC .EQ. NAPOUT ) THEN @@ -1666,14 +1550,7 @@ PROGRAM W3SHEL ELSE IF ( J .EQ. 6 ) THEN ! IPRT: IX0, IXN, IXS, IY0, IYN, IYS CALL NEXTLN ( COMSTR , NDSI , NDSEN ) -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), 'Before reading IPRT' - write(740+IAPROC,*), 'Before read 2002, case 10' -#endif READ (NDSI,*) IPRT, PRTFRM -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), ' After read 2002, case 10' -#endif ! IF ( IAPROC .EQ. NAPOUT ) THEN IF ( PRTFRM ) THEN @@ -1713,13 +1590,7 @@ PROGRAM W3SHEL ! Start of loop DO CALL NEXTLN ( COMSTR , NDSI , NDSEN ) -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), 'Before read 2002, case 11' -#endif READ (NDSI,*) IDTST -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), ' After read 2002, case 11' -#endif ! Exit if illegal id @@ -1745,75 +1616,33 @@ PROGRAM W3SHEL NH(J) = NH(J) + 1 IF ( NH(J) .GT. NHMAX ) GOTO 2006 IF ( J .LE. 1 ) THEN ! water levels, etc. : get HA -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), 'Before read 2002, case 12' -#endif READ (NDSI,*) IDTST, & THO(1,J,NH(J)), THO(2,J,NH(J)), & HA(NH(J),J) -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), ' After read 2002, case 12' -#endif ELSE IF ( J .EQ. 2 ) THEN ! currents: get HA and HD -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), 'Before read 2002, case 13' -#endif READ (NDSI,*) IDTST, & THO(1,J,NH(J)), THO(2,J,NH(J)), & HA(NH(J),J), HD(NH(J),J) -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), ' After read 2002, case 13' -#endif ELSE IF ( J .EQ. 3 ) THEN ! wind: get HA HD and HS -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), 'Before read 2002, case 14' -#endif READ (NDSI,*) IDTST, & THO(1,J,NH(J)), THO(2,J,NH(J)), & HA(NH(J),J), HD(NH(J),J), HS(NH(J),J) -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), ' After read 2002, case 14' -#endif ELSE IF ( J .EQ. 4 ) THEN ! ice -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), 'Before read 2002, case 15' -#endif READ (NDSI,*) IDTST, & THO(1,J,NH(J)), THO(2,J,NH(J)), & HA(NH(J),J) -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), ' After read 2002, case 15' -#endif ELSE IF ( J .EQ. 5 ) THEN ! atmospheric momentum -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), 'Before read 2002, case 16' -#endif READ (NDSI,*) IDTST, & THO(1,J,NH(J)), THO(2,J,NH(J)), & HA(NH(J),J), HD(NH(J),j) -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), ' After read 2002, case 16' -#endif ELSE IF ( J .EQ. 6 ) THEN ! air density -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), 'Before read 2002, case 17' -#endif READ (NDSI,*) IDTST, & THO(1,J,NH(J)), THO(2,J,NH(J)), & HA(NH(J),J) -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), ' After read 2002, case 16' -#endif ELSE IF ( J .EQ. 10 ) THEN ! mov: HA and HD -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), 'Before read 2002, case 18' -#endif READ (NDSI,*) IDTST, & THO(1,J,NH(J)), THO(2,J,NH(J)), & HA(NH(J),J), HD(NH(J),J) -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), ' After read 2002, case 18' -#endif END IF END IF END DO @@ -1888,9 +1717,6 @@ PROGRAM W3SHEL ! DO J=JFIRST, 6 -#ifdef W3_DEBUGINIT - write(740+IAPROC,*), 'J=',J,'INFLAGS1(J)=',INFLAGS1(J), 'FLAGSC(J)=', FLAGSC(J) -#endif IF ( INFLAGS1(J) .AND. .NOT. FLAGSC(J)) THEN IF ( FLH(J) ) THEN IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,954) IDFLDS(J) diff --git a/model/src/ww3_strt.F90 b/model/src/ww3_strt.F90 index 9f9ea35177..631fcc0a9c 100644 --- a/model/src/ww3_strt.F90 +++ b/model/src/ww3_strt.F90 @@ -578,11 +578,6 @@ PROGRAM W3STRT FACTOR = 1. #endif VA(:,JSEA) = FACTOR * E21 -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'JSEA=', JSEA, ' FACTOR=', FACTOR - WRITE(740+IAPROC,*) ' sum(E21)=', sum(E21) - WRITE(740+IAPROC,*) ' sum(VA)=', sum(VA(:,JSEA)) -#endif ! ! @@ -830,9 +825,6 @@ PROGRAM W3STRT !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 9. Convert E(sigma) to N(k) ! -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'ITYPE=', ITYPE -#endif IF ( ITYPE.NE.3 .AND. ITYPE.NE.5 ) THEN IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,990) ! @@ -841,18 +833,12 @@ PROGRAM W3STRT HSIG = 0. #endif ! -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Doing rescaling operation' -#endif DO JSEA=1, NSEAL #ifdef W3_DIST ISEA = IAPROC + (JSEA-1)*NAPROC #endif #ifdef W3_SHRD ISEA = JSEA -#endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) ' rescal ISEA=', ISEA, ' JSEA=', JSEA #endif DEPTH = MAX ( DMIN , -ZB(ISEA) ) #ifdef W3_O6 @@ -907,15 +893,9 @@ PROGRAM W3STRT #ifdef W3_O6 NSX = 1 + NX/35 NSY = 1 + NY/35 -#ifdef W3_DEBUGINIT - Print *, 'Before call to PRTBLK' -#endif IF ( IAPROC .EQ. NAPOUT ) CALL PRTBLK & (NDSO, NX, NY, NX, HSIG, MAPO, 0, 0., & 1, NX, NSX, 1, NY, NSY, 'Hs', 'm') -#ifdef W3_DEBUGINIT - Print *, 'After call to PRTBLK' -#endif #endif #ifdef W3_MPI END IF @@ -927,20 +907,7 @@ PROGRAM W3STRT !10. Write restart file. ! IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,995) -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before call to W3IORS' - WRITE(740+IAPROC,*) 'min/max/sum(VA)=', minval(VA), maxval(VA), sum(VA) - FLUSH(740+IAPROC) -#endif CALL W3IORS ( INXOUT, NDSR, SIG(NK) ) -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before call to W3IORS' - WRITE(740+IAPROC,*) 'min/max/sum(VA)=', minval(VA), maxval(VA), sum(VA) - DO ISEA=1,NSEA - WRITE(740+IAPROC,*) 'ISEA=', ISEA, ' sum(VA)=', sum(VA(:,ISEA)) - END DO - FLUSH(740+IAPROC) -#endif ! GOTO 888 ! From 6ef0d4085e7d35b73bbf096a4d72726c68cf1beb Mon Sep 17 00:00:00 2001 From: Mathieu Dutour Sikiric Date: Wed, 7 Sep 2022 15:48:56 +0200 Subject: [PATCH 03/17] Another simplification. --- model/src/w3wavemd.F90 | 68 ------------------------------------------ 1 file changed, 68 deletions(-) diff --git a/model/src/w3wavemd.F90 b/model/src/w3wavemd.F90 index 48f4165820..1bad3c4622 100644 --- a/model/src/w3wavemd.F90 +++ b/model/src/w3wavemd.F90 @@ -609,15 +609,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & SCREEN = 333 #endif ! -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3WAVE, step 1' -#endif -#ifdef W3_DEBUGSRC - WRITE(740+IAPROC,*) 'Step 1 : max(UST)=', maxval(UST) -#endif -#ifdef W3_DEBUGINIT - FLUSH(740+IAPROC) -#endif IF ( IOUTP .NE. IMOD ) CALL W3SETO ( IMOD, NDSE, NDST ) IF ( IGRID .NE. IMOD ) CALL W3SETG ( IMOD, NDSE, NDST ) IF ( IWDATA .NE. IMOD ) CALL W3SETW ( IMOD, NDSE, NDST ) @@ -629,11 +620,9 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & -#ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "W3WAVEMD, step 1", 1) #endif -#endif ! ALLOCATE(TAUWX(NSEAL), TAUWY(NSEAL)) @@ -652,15 +641,9 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ELSE SKIP_O = .FALSE. END IF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3WAVE, step 2' - FLUSH(740+IAPROC) -#endif -#ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "W3WAVEMD, step 2", 1) #endif -#endif ! ! 0.b Subroutine tracing ! @@ -760,15 +743,9 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ELSE DTL0 = 0. END IF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3WAVE, step 4' - FLUSH(740+IAPROC) -#endif -#ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "W3WAVEMD, step 4", 1) #endif -#endif ! ! 1.c Current interval ! @@ -807,15 +784,9 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & TOFRST = TIME END IF END IF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3WAVE, step 5' - FLUSH(740+IAPROC) -#endif -#ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "W3WAVEMD, step 5", 1) #endif -#endif ! ! 1.e Ice concentration interval ! @@ -835,15 +806,9 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ELSE DTI0 = 0. END IF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3WAVE, step 6' - FLUSH(740+IAPROC) -#endif -#ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "W3WAVEMD, step 6", 1) #endif -#endif ! ! 1.f Momentum interval ! @@ -946,11 +911,9 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! ENDIF -#ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "W3WAVEMD, step 6.1", 1) #endif -#endif ! ! ! 2.a Pre-calculate table for IC3 ------------------------------------ / @@ -1110,11 +1073,9 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & END DO #endif ! -#ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "Beginning time loop", 1) #endif -#endif #ifdef W3_TIMINGS CALL PRINT_MY_TIME("After assigning VAOLD") #endif @@ -1170,11 +1131,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & WRITE (NDST,9021) ITIME, IT, TIME, FLMAP, FLDDIR, & VGX, VGY, DTG, DTRES #endif -#ifdef W3_DEBUGSRC - WRITE(740+IAPROC,*) 'DTG 2 : DTG=', DTG - WRITE(740+IAPROC,*) 'max(UST)=', maxval(UST) - FLUSH(740+IAPROC) -#endif ! ! 3.1 Interpolate winds, currents, and momentum. ! (Initialize wave fields with winds) @@ -1189,11 +1145,9 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #endif IF ( FLCUR ) THEN -#ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "Before UCUR", 1) #endif -#endif #ifdef W3_TIMINGS CALL PRINT_MY_TIME("W3WAVE, step 6.4.1") #endif @@ -1280,11 +1234,9 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & CALL PRINT_MY_TIME("After U10, etc. assignation") #endif ! -#ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "Before call to W3UINI", 1) #endif -#endif #ifdef W3_TIMINGS CALL PRINT_MY_TIME("Before call W3UINI") #endif @@ -1305,11 +1257,9 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! ! 3.2 Update boundary conditions if boundary flag is true (FLBPI) ! -#ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "Before boundary update", 1) #endif -#endif #ifdef W3_TIMINGS CALL PRINT_MY_TIME("Before boundary update") #endif @@ -1405,11 +1355,9 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & FLMAP = .TRUE. END IF END IF -#ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "After FLICE and DTI0", 1) #endif -#endif #ifdef W3_TIMINGS CALL PRINT_MY_TIME("After FLICE and DTI0") #endif @@ -1518,11 +1466,9 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & .OR. FLCK .OR. FSFREQSHIFT END IF END IF -#ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "After FFLEV and DTL0", 1) #endif -#endif #ifdef W3_TIMINGS CALL PRINT_MY_TIME("After FFLEV and DTL0") #endif @@ -1912,11 +1858,9 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! ! 3.6.2 Intra-spectral part 1 ! -#ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "Before intraspectral part 1", 1) #endif -#endif #ifdef W3_TIMINGS CALL PRINT_MY_TIME("Before intraspectral") #endif @@ -2012,11 +1956,9 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & call printMallInfo(IAPROC+40000,mallInfos) #endif -#ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "Before spatial advection", 1) #endif -#endif #ifdef W3_TIMINGS CALL PRINT_MY_TIME("Before spatial advection") #endif @@ -2049,11 +1991,9 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #ifdef W3_PDLIB IF (FSTOTALIMP .and. (IT .ne. 0)) THEN #endif -#ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "Before Block implicit", 1) #endif -#endif #ifdef W3_PDLIB CALL PDLIB_W3XYPUG_BLOCK_IMPLICIT(IMOD, FACX, FACX, DTG, VGX, VGY) #endif @@ -2255,11 +2195,9 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! END IF -#ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "After spatial advection", 1) #endif -#endif #ifdef W3_TIMINGS CALL PRINT_MY_TIME("After spatial advection") #endif @@ -2350,11 +2288,9 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! END DO END IF -#ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "After intraspectral adv.", 1) #endif -#endif #ifdef W3_TIMINGS CALL PRINT_MY_TIME("fter intraspectral adv.") #endif @@ -2527,11 +2463,9 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & !!/MPI CALL MPI_BARRIER (MPI_COMM_WCMP,IERR_MPI) ! END IF -#ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "After source terms", 1) #endif -#endif #ifdef W3_TIMINGS CALL PRINT_MY_TIME("After source terms") #endif @@ -2570,11 +2504,9 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & IDACT = ' ' END IF ! -#ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "end of time loop", 1) #endif -#endif #ifdef W3_TIMINGS CALL PRINT_MY_TIME("end of time loop") #endif From b438a6e399a3e4a23557df5806f228a2863992fb Mon Sep 17 00:00:00 2001 From: Mathieu Dutour Sikiric Date: Wed, 7 Sep 2022 15:51:44 +0200 Subject: [PATCH 04/17] More cleanup. --- model/src/w3updtmd.F90 | 57 ------------------------------------------ model/src/w3wavemd.F90 | 13 ---------- model/src/wminiomd.F90 | 8 ------ 3 files changed, 78 deletions(-) diff --git a/model/src/w3updtmd.F90 b/model/src/w3updtmd.F90 index b549d8144c..1ee8b81955 100644 --- a/model/src/w3updtmd.F90 +++ b/model/src/w3updtmd.F90 @@ -1335,10 +1335,6 @@ SUBROUTINE W3UBPT ! 1. Process BBPI0 -------------------------------------------------- * ! 1.a First intialization -#ifdef W3_DEBUGIOBC - WRITE(740+IAPROC,*) 'Beginning of W3UBPT' - FLUSH(740+IAPROC) -#endif ! IF ( BBPI0(1,0) .EQ. -1. ) THEN @@ -1410,14 +1406,6 @@ SUBROUTINE W3UBPT END DO #endif ! -#ifdef W3_DEBUGIOBC - WRITE(740+IAPROC,*) 'sum(abs(ABPI0))=', sum(abs(ABPI0)) - WRITE(740+IAPROC,*) 'sum(abs(ABPIN))=', sum(abs(ABPIN)) - WRITE(740+IAPROC,*) 'sum(abs(BBPI0))=', sum(abs(BBPI0)) - WRITE(740+IAPROC,*) 'sum(abs(BBPIN))=', sum(abs(BBPIN)) - WRITE(740+IAPROC,*) 'End of W3UBPT' - FLUSH(740+IAPROC) -#endif RETURN ! ! Formats @@ -2036,11 +2024,6 @@ SUBROUTINE W3ULEV ( A, VA ) REAL(KIND=8) :: d1,h,TIDE_HOUR,HH,pp,s,p,enp,dh,dpp,ds,dp,dnp,tau REAL :: FX(44),UX(44),VX(44) #endif -#ifdef W3_DEBUGW3ULEV - WRITE(740+IAPROC,*) 'Beginning of W3ULEV, step 1' - FLUSH(740+IAPROC) -#endif - !/ !/ ------------------------------------------------------------------- / !/ @@ -2049,10 +2032,6 @@ SUBROUTINE W3ULEV ( A, VA ) #endif ! LOCAL = IAPROC .LE. NAPROC -#ifdef W3_DEBUGW3ULEV - WRITE(740+IAPROC,*) 'Beginning of W3ULEV, step 2' - FLUSH(740+IAPROC) -#endif ! #ifdef W3_T WRITE (NDST,9000) KDMAX, RDKMIN @@ -2061,10 +2040,6 @@ SUBROUTINE W3ULEV ( A, VA ) ! 1. Preparations --------------------------------------------------- * ! 1.a Check NK ! -#ifdef W3_DEBUGW3ULEV - WRITE(740+IAPROC,*) 'Beginning of W3ULEV, step 3' - FLUSH(740+IAPROC) -#endif IF ( NK .LT. 2 ) THEN IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1000) CALL EXTCDE ( 1 ) @@ -2084,10 +2059,6 @@ SUBROUTINE W3ULEV ( A, VA ) ! MAPDRY = MOD(MAPST2/2,2) MAPST2 = MAPST2 - 2*MAPDRY -#ifdef W3_DEBUGW3ULEV - WRITE(740+IAPROC,*) 'Beginning of W3ULEV, step 4' - FLUSH(740+IAPROC) -#endif ! ! 1.d Update water levels and save old ! @@ -2111,10 +2082,6 @@ SUBROUTINE W3ULEV ( A, VA ) ! ONLY THE FRACTIONAL PART OF A SOLAR DAY NEED BE RETAINED FOR COMPU- ! TING THE LUNAR TIME TAU. ! -#endif -#ifdef W3_DEBUGW3ULEV - WRITE(740+IAPROC,*) 'Beginning of W3ULEV, step 5' - FLUSH(740+IAPROC) #endif DO ISEA=1, NSEA IX = MAPSF(ISEA,1) @@ -2173,10 +2140,6 @@ SUBROUTINE W3ULEV ( A, VA ) END DO ! NSEA -#ifdef W3_DEBUGW3ULEV - WRITE(740+IAPROC,*) 'Beginning of W3ULEV, step 6' - FLUSH(740+IAPROC) -#endif ! ! 2. Loop over all sea points --------------------------------------- * ! @@ -2390,10 +2353,6 @@ SUBROUTINE W3ULEV ( A, VA ) END IF ! END DO ! NSEA -#ifdef W3_DEBUGW3ULEV - WRITE(740+IAPROC,*) 'Beginning of W3ULEV, step 7' - FLUSH(740+IAPROC) -#endif ! ! 3. Reconstruct new MAPST2 ----------------------------------------- * ! @@ -2401,32 +2360,16 @@ SUBROUTINE W3ULEV ( A, VA ) ! ! 4. Re-generates the boundary data ---------------------------------- * ! -#ifdef W3_DEBUGW3ULEV - WRITE(740+IAPROC,*) 'Beginning of W3ULEV, step 8' - FLUSH(740+IAPROC) -#endif IF (GTYPE.EQ.UNGTYPE) THEN -#ifdef W3_DEBUGW3ULEV - WRITE(740+IAPROC,*) 'Beginning of W3ULEV, step 9' - FLUSH(740+IAPROC) -#endif !CALL SET_UG_IOBP #ifdef W3_PDLIB CALL SET_IOBDP_PDLIB #endif -#ifdef W3_DEBUGW3ULEV - WRITE(740+IAPROC,*) 'Beginning of W3ULEV, step 10' - FLUSH(740+IAPROC) -#endif #ifdef W3_REF1 ELSE CALL W3SETREF #endif ENDIF -#ifdef W3_DEBUGW3ULEV - WRITE(740+IAPROC,*) 'Beginning of W3ULEV, step 11' - FLUSH(740+IAPROC) -#endif ! RETURN ! diff --git a/model/src/w3wavemd.F90 b/model/src/w3wavemd.F90 index 1bad3c4622..3356bf4ca9 100644 --- a/model/src/w3wavemd.F90 +++ b/model/src/w3wavemd.F90 @@ -1281,23 +1281,10 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & IF (READBC.AND.IDACT(1:1).EQ.' ') IDACT(1:1) = 'X' END IF FLACT = READBC .OR. FLACT -#ifdef W3_DEBUGIOBC - WRITE(740+IAPROC,*) 'READBC=', READBC - FLUSH(740+IAPROC) -#endif IF ( READBC ) THEN -#ifdef W3_DEBUGIOBC - WRITE(740+IAPROC,*) 'Before call to W3IOBC' - FLUSH(740+IAPROC) -#endif CALL W3IOBC ( 'READ', NDS(9), TBPI0, TBPIN, & ITEST, IMOD ) -#ifdef W3_DEBUGIOBC - WRITE(740+IAPROC,*) 'After call to W3IOBC' - WRITE(740+IAPROC,*) 'ITEST=', ITEST - FLUSH(740+IAPROC) -#endif IF ( ITEST .NE. 1 ) CALL W3UBPT ELSE ITEST = 0 diff --git a/model/src/wminiomd.F90 b/model/src/wminiomd.F90 index 73e90b63a7..c1e61461d6 100644 --- a/model/src/wminiomd.F90 +++ b/model/src/wminiomd.F90 @@ -640,10 +640,6 @@ SUBROUTINE WMIOBG ( IMOD, DONE ) #ifdef W3_S CALL STRACE (IENT, 'WMIOBG') #endif -#ifdef W3_DEBUGIOBC - WRITE(740+IAPROC,*) 'Begin of W3IOBG' - FLUSH(740+IAPROC) -#endif ! @@ -1136,10 +1132,6 @@ SUBROUTINE WMIOBG ( IMOD, DONE ) ! 5. Successful update ! IF ( PRESENT(DONE) ) DONE = .TRUE. -#ifdef W3_DEBUGIOBC - WRITE(740+IAPROC,*) 'End of W3IOBG' - FLUSH(740+IAPROC) -#endif ! RETURN ! From 6b848dc6a886a7b81bfeae8a459d28d61128f0f3 Mon Sep 17 00:00:00 2001 From: Mathieu Dutour Sikiric Date: Wed, 7 Sep 2022 15:59:22 +0200 Subject: [PATCH 05/17] Simplification of debug. --- model/src/w3initmd.F90 | 294 ----------------------------------------- 1 file changed, 294 deletions(-) diff --git a/model/src/w3initmd.F90 b/model/src/w3initmd.F90 index ad621097a6..7ba3684db4 100644 --- a/model/src/w3initmd.F90 +++ b/model/src/w3initmd.F90 @@ -532,12 +532,6 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT & #ifdef W3_UOST CALL UOST_SETGRID(IMOD) #endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Beginning of W3INIT' - WRITE(740+IAPROC,*) ' FLGR2(10,1)=', FLGR2(10,1) - WRITE(740+IAPROC,*) ' FLGR2(10,2)=', FLGR2(10,2) - FLUSH(740+IAPROC) -#endif #ifdef W3_TIMINGS CALL PRINT_MY_TIME("Case 2") #endif @@ -679,16 +673,10 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT & J = LEN_TRIM(FNMPRE) ! IF ( OUTPTS(IMOD)%IAPROC .EQ. OUTPTS(IMOD)%NAPLOG ) & -#ifdef W3_DEBUGINIT - WRITE(*,*) '1: w3initmd f=', TRIM(FNMPRE(:J)//LFILE(:IFL)) -#endif OPEN (MDS(1),FILE=FNMPRE(:J)//LFILE(:IFL),ERR=888,IOSTAT=IERR) ! IF ( MDS(3).NE.MDS(1) .AND. MDS(3).NE.MDS(4) .AND. TSTOUT ) THEN INQUIRE (MDS(3),OPENED=OPENED) -#ifdef W3_DEBUGINIT - WRITE(*,*) '2: w3initmd f=', TRIM(FNMPRE(:J)//TFILE(:IFT)) -#endif IF ( .NOT. OPENED ) OPEN & (MDS(3),FILE=FNMPRE(:J)//TFILE(:IFT),ERR=889,IOSTAT=IERR) END IF @@ -772,12 +760,6 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT & ELSE #endif -#ifdef W3_PDLIB -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before PDLIB_INIT' -#endif -#endif - #ifdef W3_PDLIB CALL PDLIB_INIT(IMOD) #endif @@ -788,15 +770,6 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT & call printMallInfo(10000+IAPROC,mallInfos) #endif -#ifdef W3_PDLIB -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'After set up of NSEAL, NSEALM=', NSEALM - WRITE(740+IAPROC,*) 'After PDLIB_INIT' - WRITE(740+IAPROC,*) 'allocated(ISEA_TO_JSEA)=', allocated(ISEA_TO_JSEA) - FLUSH(740+IAPROC) -#endif -#endif - #ifdef W3_TIMINGS CALL PRINT_MY_TIME("After PDLIB_INIT") #endif @@ -823,11 +796,6 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT & ! Update of output parameter flags based on mod_def parameters (for 3D arrays) -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before W3FLGRDUPDT' - FLUSH(740+IAPROC) -#endif - CALL W3FLGRDUPDT ( NDSO, NDSE, FLGRD, FLGR2, FLGD, FLG2 ) !!/DEBUGMPI CALL TEST_MPI_STATUS("Case 9") @@ -867,16 +835,6 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT & call getMallocInfo(mallinfos) call printMallInfo(10000+IAPROC,mallInfos) #endif -! -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'After set up of NSEAL, NSEAL=', NSEAL - WRITE(740+IAPROC,*) 'After set up of NSEAL, NSEALM=', NSEALM - WRITE(740+IAPROC,*) 'NSEA=', NSEA, ' NSPEC=', NSPEC - FLUSH(740+IAPROC) -#endif -#ifdef W3_DEBUGMPI - CALL TEST_MPI_STATUS("Case 11") -#endif #ifdef W3_DIST IF ( NSEA .LT. NAPROC ) GOTO 820 @@ -885,33 +843,16 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT & END IF #endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before PDLIB related allocations' - FLUSH(740+IAPROC) -#endif - #ifdef W3_PDLIB IF ((IAPROC .LE. NAPROC).and.(GTYPE .eq. UNGTYPE)) THEN #endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'After test 1' - FLUSH(740+IAPROC) - WRITE(740+IAPROC,*) 'Before BLOCK_SOLVER_INIT' - FLUSH(740+IAPROC) -#endif - #ifdef W3_PDLIB CALL BLOCK_SOLVER_INIT(IMOD) CALL PDLIB_IOBP_INIT(IMOD) CALL SET_IOBPA_PDLIB #endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'After BLOCK_SOLVER_INIT' - FLUSH(740+IAPROC) -#endif - #ifdef W3_PDLIB ELSE IF (FSTOTALEXP) THEN !AR: To do here the blocksolver ... @@ -927,19 +868,11 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT & call getMallocInfo(mallinfos) call printMallInfo(10000+IAPROC,mallInfos) #endif - -#ifdef W3_DEBUGMPI - CALL TEST_MPI_STATUS("Case 12") -#endif ! ! ! 2.c.2 Allocate arrays ! IF ( IAPROC .LE. NAPROC ) THEN -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Calling W3DIMW at W3INIT, case 1' - FLUSH(740+IAPROC) -#endif CALL W3DIMW ( IMOD, NDSE, NDST ) #ifdef W3_MEMCHECK WRITE(10000+IAPROC,*) 'memcheck_____:', 'WW3_INIT SECTION 2h' @@ -947,10 +880,6 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT & call printMallInfo(10000+IAPROC,mallInfos) #endif ELSE -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Calling W3DIMW at W3INIT, case 2' - FLUSH(740+IAPROC) -#endif CALL W3DIMW ( IMOD, NDSE, NDST, .FALSE. ) #ifdef W3_MEMCHECK WRITE(10000+IAPROC,*) 'memcheck_____:', 'WW3_INIT SECTION 2i' @@ -958,11 +887,6 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT & call printMallInfo(10000+IAPROC,mallInfos) #endif END IF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) ' 1: NSEAL=', NSEAL - WRITE(740+IAPROC,*) ' maxval(UST)=', maxval(UST) - FLUSH(740+IAPROC) -#endif #ifdef W3_TIMINGS CALL PRINT_MY_TIME("After W3DIMW") #endif @@ -1102,11 +1026,6 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT & IF ( IAPPRO(ISP) .EQ. -1. ) GOTO 829 END DO END IF -#endif -! -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3INIT, aft BLOCK_SOLVER_INIT, step 4' - FLUSH(740+IAPROC) #endif DEALLOCATE ( NT ) ! @@ -1114,24 +1033,9 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT & ! 3.a Read restart file ! VA(:,:) = 0. -#ifdef W3_DEBUGMPI - CALL TEST_MPI_STATUS("Case 15") -#endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3INIT, aft BLOCK_SOLVER_INIT, step 4.0' - WRITE(740+IAPROC,*) ' 1: min/max/sum(VA)=', minval(VA), maxval(VA), sum(VA) - WRITE(740+IAPROC,*) ' 1: NSEAL=', NSEAL - FLUSH(740+IAPROC) -#endif -#ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "Before W3IORS call", 1) #endif -#endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) ' After ALL_VA_INTEGRAL_PRINT' - FLUSH(740+IAPROC) -#endif #ifdef W3_TIMINGS CALL PRINT_MY_TIME("Before W3IORS") #endif @@ -1145,20 +1049,8 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT & call printMallInfo(10000+IAPROC,mallInfos) #endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) ' 2: min/max/sum(VA)=', minval(VA), maxval(VA), sum(VA) - WRITE(740+IAPROC,*) ' 2: NSEAL=', NSEAL - FLUSH(740+IAPROC) -#endif -#ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "After W3IORS call", 1) -#endif -#endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3INIT, aft BLOCK_SOLVER_INIT, step 4.1' - WRITE(740+IAPROC,*) ' sum(VA)=', sum(VA) - FLUSH(740+IAPROC) #endif FLCOLD = RSTYPE.LE.1 .OR. RSTYPE.EQ.4 IF ( IAPROC .EQ. NAPLOG ) THEN @@ -1172,15 +1064,9 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT & WRITE (NDSO,930) 'full restart.' END IF END IF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3INIT, aft BLOCK_SOLVER_INIT, step 4.2' - FLUSH(740+IAPROC) -#endif -#ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "W3INIT, step 4.2", 1) #endif -#endif #ifdef W3_TIMINGS CALL PRINT_MY_TIME("After restart inits") #endif @@ -1203,15 +1089,9 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT & call printMallInfo(10000+IAPROC,mallInfos) #endif ! -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3INIT, aft BLOCK_SOLVER_INIT, step 4.3' - FLUSH(740+IAPROC) -#endif -#ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "W3INIT, step 4.3", 1) #endif -#endif ! ! 3.b2 Set MAPSTA associated to PDLIB ! @@ -1230,14 +1110,8 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT & ! ! 3.d Initialization with calm conditions ! -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3INIT, aft BLOCK_SOLVER_INIT, step 5' - FLUSH(740+IAPROC) -#endif -#ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "W3INIT, step 5", 1) -#endif #endif IF ( RSTYPE .EQ. 4 ) THEN VA(:,:) = 0. @@ -1256,22 +1130,12 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT & ! IF ( .NOT. FLCUR ) FLCK = .FALSE. #ifdef W3_PDLIB -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3INIT definition of FSREFR and FRFREQ' - WRITE(740+IAPROC,*) 'FSTOTALIMP=', FSTOTALIMP - WRITE(740+IAPROC,*) 'FSREFRACTION=', FSREFRACTION - WRITE(740+IAPROC,*) 'FSFREQSHIFT=', FSFREQSHIFT - WRITE(740+IAPROC,*) 'Before FLCTH=', FLCTH, 'FLCK=', FLCK -#endif IF (FSTOTALIMP .and. FSREFRACTION) THEN FLCTH = .FALSE. END IF IF (FSTOTALIMP .and. FSFREQSHIFT) THEN FLCK = .FALSE. END IF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) ' After FLCTH=', FLCTH, 'FLCK=', FLCK -#endif #endif ! ! 4. Set-up output times -------------------------------------------- * @@ -1310,15 +1174,9 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT & FLOUT(1) = FLOUT(1) .OR. FLOGRD(J,K) END DO END DO -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3INIT, aft BLOCK_SOLVER_INIT, step 6' - FLUSH(740+IAPROC) -#endif -#ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "W3INIT, step 6", 1) #endif -#endif ! FLOUT(7) = .FALSE. FLOGR2 = FLGR2 @@ -1358,18 +1216,9 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT & ! ! WRITE(*,*) 'We set NOTYPE=0 just for DEBUGGING' ! NOTYPE=0 ! ONLY FOR DEBUGGING PURPOSE -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3INIT, aft BLOCK_SOLVER_INIT, step 7' - FLUSH(740+IAPROC) -#endif -#ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "W3INIT, step 7", 1) #endif -#endif -#ifdef W3_DEBUGINIT - WRITE(*,*) 'Starting the NOTYPE loop, takes time' -#endif #ifdef W3_TIMINGS CALL PRINT_MY_TIME("Before NOTYPE loop") #endif @@ -1485,21 +1334,12 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT & call printMallInfo(10000+IAPROC,mallInfos) #endif -#ifdef W3_DEBUGINIT - WRITE(*,*) 'Ending the NOTYPE loop, takes time' -#endif #ifdef W3_TIMINGS CALL PRINT_MY_TIME("After NOTYPE loop") #endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3INIT, aft BLOCK_SOLVER_INIT, step 8' - FLUSH(740+IAPROC) -#endif -#ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "W3INIT, step 8.1", 1) #endif -#endif ! ! 4.d Preprocessing for point output. ! @@ -1527,14 +1367,6 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT & ! MAPTST = MOD(MAPST2/2,2) MAPST2 = MAPST2 - 2*MAPTST -#ifdef W3_PDLIB -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before INIT_GET_JSEA_ISPROC call' - WRITE(740+IAPROC,*) 'allocated(ISEA_TO_JSEA)=', allocated(ISEA_TO_JSEA) - WRITE(740+IAPROC,*) 'NAPROC=', NAPROC - FLUSH(740+IAPROC) -#endif -#endif ! !Li For multi-resolution SMC grid, these 1-NX and 1-NY nested loops @@ -1544,13 +1376,7 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT & !Li DO IY=1, NY !Li DO IX=1, NX !Li ISEA = MAPFS(IY,IX) -#ifdef W3_DEBUGSTP - WRITE(740+IAPROC,*) 'Debugging the SETUP / WLV' -#endif DO ISEA=1, NSEA -#ifdef W3_DEBUGSTP - WRITE(740+IAPROC,*) 'ISEA/WLV/ZB=', ISEA, WLV(ISEA), ZB(ISEA) -#endif IX = MAPSF(ISEA,1) IY = MAPSF(ISEA,2) #ifdef W3_T @@ -1603,48 +1429,20 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT & #endif ! -#ifdef W3_DEBUGSTP - FLUSH(740+IAPROC) -#endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3INIT, aft BLOCK_SOLVER_INIT, step 9' - FLUSH(740+IAPROC) -#endif -#ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "W3INIT, step 8.2", 1) #endif -#endif ! -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3INIT, aft BLOCK_SOLVER_INIT, step 9.1' - WRITE(740+IAPROC,*) ' allocated(MAPTST)=', allocated(MAPTST) - WRITE(740+IAPROC,*) 'NY=', NY, ' NX=', NX - FLUSH(740+IAPROC) -#endif MAPST2 = MAPST2 + 2*MAPTST -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3INIT, aft BLOCK_SOLVER_INIT, step 9.2' - FLUSH(740+IAPROC) -#endif ! DEALLOCATE ( MAPTST ) -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3INIT, aft BLOCK_SOLVER_INIT, step 9.3' - FLUSH(740+IAPROC) -#endif - #ifdef W3_MEMCHECK WRITE(10000+IAPROC,*) 'memcheck_____:', 'WW3_INIT SECTION 6' call getMallocInfo(mallinfos) call printMallInfo(10000+IAPROC,mallInfos) #endif ! -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3INIT, aft BLOCK_SOLVER_INIT, step 9.4' - FLUSH(740+IAPROC) -#endif #ifdef W3_T WRITE (NDST,9050) NX0 = 1 @@ -1666,15 +1464,7 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT & ! ! 5.b Fill wavenumber and group velocity arrays. ! -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3INIT, aft BLOCK_SOLVER_INIT, step 9.5' - FLUSH(740+IAPROC) -#endif DO IS=0, NSEA -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'IS=', IS - FLUSH(740+IAPROC) -#endif IF (IS.GT.0) THEN DEPTH = MAX ( DMIN , DW(IS) ) ELSE @@ -1697,10 +1487,6 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT & END DO END DO -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3INIT, aft BLOCK_SOLVER_INIT, step 9.6' - FLUSH(740+IAPROC) -#endif ! ! 6. Initialize arrays ---------------------------------------------- / ! Some initialized in W3IORS @@ -1714,10 +1500,6 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT & ! AS (0) = 0. DW (0) = 0. -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3INIT, aft BLOCK_SOLVER_INIT, step 9.7' - FLUSH(740+IAPROC) -#endif ! ! 7. Write info to log file ----------------------------------------- / ! @@ -1813,10 +1595,6 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT & WRITE (NDSO,984) ! END IF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3INIT, aft BLOCK_SOLVER_INIT, step 9.8' - FLUSH(740+IAPROC) -#endif ! IF ( NOPTS .EQ. 0 ) FLOUT(2) = .FALSE. @@ -1825,58 +1603,32 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT & call getMallocInfo(mallinfos) call printMallInfo(10000+IAPROC,mallInfos) #endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3INIT, aft BLOCK_SOLVER_INIT, step 9.9' - FLUSH(740+IAPROC) -#endif ! ! Boundary set up for the directions ! -#ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "W3INIT, step 8.3", 1) #endif -#endif !!/PDLIB CALL VA_SETUP_IOBPD -#ifdef W3_PDLIB #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "W3INIT, step 8.4", 1) #endif -#endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3INIT, aft BLOCK_SOLVER_INIT, step 9.10' - FLUSH(740+IAPROC) -#endif ! ! 8. Final MPI set up ----------------------------------------------- / ! #ifdef W3_MPI CALL W3MPII ( IMOD ) #endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'After W3MPII' - FLUSH(740+IAPROC) -#endif #ifdef W3_MPI CALL W3MPIO ( IMOD ) #endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'After W3MPIO' - FLUSH(740+IAPROC) -#endif #ifdef W3_MPI IF ( FLOUT(2) ) CALL W3MPIP ( IMOD ) #endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'After W3MPIP' - FLUSH(740+IAPROC) -#endif ! -#ifdef W3_PDLIB #ifdef W3_DEBUGINIT CALL PRINT_WN_STATISTIC("W3INIT leaving") #endif -#endif #ifdef W3_TIMINGS CALL PRINT_MY_TIME("Leaving W3INIT") #endif @@ -2178,50 +1930,26 @@ SUBROUTINE W3MPII ( IMOD ) ! ! 1. Set up derived data types -------------------------------------- / ! -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3MPII, step 1' - FLUSH(740+IAPROC) -#endif NXXXX = NSEALM * NAPROC ! #ifdef W3_MPI CALL MPI_TYPE_VECTOR ( NSEALM, 1, NAPROC, MPI_REAL, & WW3_FIELD_VEC, IERR_MPI ) #endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3MPII, step 1' - FLUSH(740+IAPROC) -#endif #ifdef W3_MPI CALL MPI_TYPE_VECTOR ( NSEALM, 1, NSPEC, MPI_REAL, & WW3_SPEC_VEC, IERR_MPI ) #endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3MPII, step 1' - FLUSH(740+IAPROC) -#endif #ifdef W3_MPI CALL MPI_TYPE_COMMIT ( WW3_FIELD_VEC, IERR_MPI ) #endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3MPII, step 1' - FLUSH(740+IAPROC) -#endif #ifdef W3_MPI CALL MPI_TYPE_COMMIT ( WW3_SPEC_VEC, IERR_MPI ) #endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3MPII, step 1' - FLUSH(740+IAPROC) -#endif ! #ifdef W3_MPIT WRITE (NDST,9010) WW3_FIELD_VEC, WW3_SPEC_VEC #endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3MPII, step 1' - FLUSH(740+IAPROC) -#endif ! #ifdef W3_MPI IF( IAPROC .GT. NAPROC ) THEN @@ -2236,10 +1964,6 @@ SUBROUTINE W3MPII ( IMOD ) RETURN END IF #endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3MPII, step 1' - FLUSH(740+IAPROC) -#endif ! ! 2. Set up scatters and gathers for W3WAVE ------------------------- / ! ( persistent communication calls ) @@ -2253,10 +1977,6 @@ SUBROUTINE W3MPII ( IMOD ) IF ( IAPPRO(ISP) .EQ. IAPROC ) NSPLOC = NSPLOC + 1 END DO #endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3MPII, step 1' - FLUSH(740+IAPROC) -#endif ! #ifdef W3_MPI NRQSG1 = NSPEC - NSPLOC @@ -2264,17 +1984,10 @@ SUBROUTINE W3MPII ( IMOD ) IRQSG1 => WADATS(IMOD)%IRQSG1 IH = 0 #endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3MPII, step 1' - FLUSH(740+IAPROC) -#endif ! #ifdef W3_MPIT WRITE (NDST,9021) #endif -#ifdef W3_DEBUGINIT - WRITE(*,*) 'Before VA MPI_SEND/RECV_INIT inits' -#endif #ifdef W3_MPI DO ISP=1, NSPEC IF ( IAPPRO(ISP) .NE. IAPROC ) THEN @@ -2293,17 +2006,10 @@ SUBROUTINE W3MPII ( IMOD ) END IF END DO #endif -#ifdef W3_DEBUGINIT - WRITE(*,*) 'After VA MPI_SEND/RECV_INIT inits' -#endif #ifdef W3_MPIT WRITE (NDST,9023) WRITE (NDST,9020) NRQSG1 #endif -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'W3MPII, step 1' - FLUSH(740+IAPROC) -#endif ! ! 3. Set up scatters and gathers for W3SCAT and W3GATH -------------- / ! Also set up buffering of data. From 4a6b595fa03b8c45213dc06a75d6347cd59c04da Mon Sep 17 00:00:00 2001 From: Mathieu Dutour Sikiric Date: Wed, 7 Sep 2022 16:02:21 +0200 Subject: [PATCH 06/17] More dead code elimination. --- model/src/w3iogrmd.F90 | 176 ----------------------------------------- 1 file changed, 176 deletions(-) diff --git a/model/src/w3iogrmd.F90 b/model/src/w3iogrmd.F90 index b44aa6fcb6..3f1fe0e73d 100644 --- a/model/src/w3iogrmd.F90 +++ b/model/src/w3iogrmd.F90 @@ -328,10 +328,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) CALL STRACE (IENT, 'W3IOGR') #endif ! -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 1' - FLUSH(740+IAPROC) -#endif #ifdef W3_MEMCHECK write(740+IAPROC,*) 'memcheck_____:', 'WIOGR SECTION 1' call getMallocInfo(mallinfos) @@ -489,10 +485,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) FNAMEP = TNAMEP FNAMEG = TNAMEG FNAMEI = TNAMEI -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 2' - FLUSH(740+IAPROC) -#endif ! #ifdef W3_T FLTEST = .TRUE. @@ -521,10 +513,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) CALL EXTCDE ( 1 ) END IF ! -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 3' - FLUSH(740+IAPROC) -#endif WRITE = INXOUT .EQ. 'WRITE' ! #ifdef W3_T @@ -534,10 +522,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) CALL W3SETO ( IGRD, NDSE, NDST ) CALL W3SETG ( IGRD, NDSE, NDST ) FILEXT = TEMPXT -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 4' - FLUSH(740+IAPROC) -#endif #ifdef W3_MEMCHECK write(740+IAPROC,*) 'memcheck_____:', 'WIOGR SECTION 2' call getMallocInfo(mallinfos) @@ -559,10 +543,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) ENDIF ! REWIND ( NDSM ) -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 5, WRITE=', WRITE - FLUSH(740+IAPROC) -#endif ! ! Dimensions and test information -------------------------------------- ! @@ -700,10 +680,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) #endif ! ENDIF -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 6' - FLUSH(740+IAPROC) -#endif #ifdef W3_MEMCHECK write(740+IAPROC,*) 'memcheck_____:', 'WIOGR SECTION 3' call getMallocInfo(mallinfos) @@ -715,10 +691,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) ! Module W3GDAT GRID ! ALLOCATE ( MAPTMP(NY,NX) ) -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 7' - FLUSH(740+IAPROC) -#endif ! IF ( WRITE ) THEN MAPTMP = MAPSTA + 8*MAPST2 @@ -803,10 +775,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) !! WRITE(NDSM) & !! COUG_2D, COUG_RAD3D, COUG_US3D ELSE -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 7.1' - FLUSH(740+IAPROC) -#endif #ifdef W3_MEMCHECK write(740+IAPROC,*) 'memcheck_____:', 'WIOGR SECTION 4' call getMallocInfo(mallinfos) @@ -815,10 +783,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & GTYPE, FLAGLL, ICLOSE -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 7.2' - FLUSH(740+IAPROC) -#endif !!Li IF (.NOT.GINIT) CALL W3DIMX ( IGRD, NX, NY, NSEA, NDSE, NDST ) IF (.NOT.GINIT) CALL W3DIMX ( IGRD, NX, NY, NSEA, NDSE, NDST & #ifdef W3_SMC @@ -826,10 +790,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) , NARC, NBAC, NSPEC & #endif ) -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 7.3' - FLUSH(740+IAPROC) -#endif ! ! Reads different kind of information depending on grid type ! @@ -855,10 +815,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) X0 = HUGE(X0); Y0 = HUGE(Y0) SX = HUGE(SX); SY = HUGE(SY) CASE (UNGTYPE) -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 7.4' - FLUSH(740+IAPROC) -#endif READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & FSN, FSPSI,FSFCT,FSNIMP,FSTOTALIMP,FSTOTALEXP, & FSBCCFL, FSREFRACTION, FSFREQSHIFT, FSSOURCE, & @@ -876,25 +832,13 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) B_JGS_NORM_THR, & B_JGS_NLEVEL, & B_JGS_SOURCE_NONLINEAR -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 7.5, GUGINIT=', GUGINIT - FLUSH(740+IAPROC) -#endif IF (.NOT. GUGINIT) THEN -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'Before call to W3DIMUG from W3IOGR' - FLUSH(740+IAPROC) -#endif CALL W3DIMUG ( IGRD, NTRI, NX, COUNTOT, NNZ, NDSE, NDST ) END IF #ifdef W3_MEMCHECK write(740+IAPROC,*) 'memcheck_____:', 'WIOGR SECTION 5' call getMallocInfo(mallinfos) call printMallInfo(IAPROC,mallInfos) -#endif -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 7.6' - FLUSH(740+IAPROC) #endif READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & X0, Y0, SX, SY, DXYMAX, XGRD, YGRD, TRIGP, TRIA, & @@ -902,10 +846,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) DXYMAX, INDEX_CELL, CCON, COUNTCON, IE_CELL, & POS_CELL, IOBP, IOBPA, IOBDP, IOBPD, IAA, JAA, POSI -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 7.6.4' - FLUSH(740+IAPROC) -#endif #ifdef W3_MEMCHECK write(740+IAPROC,*) 'memcheck_____:', 'WIOGR SECTION 6' call getMallocInfo(mallinfos) @@ -913,27 +853,11 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) #endif -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 7.7' - FLUSH(740+IAPROC) -#endif END SELECT !GTYPE ! -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 7.8' - FLUSH(740+IAPROC) -#endif IF (GTYPE.NE.UNGTYPE) CALL W3GNTX ( IGRD, NDSE, NDST ) -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 7.9' - FLUSH(740+IAPROC) -#endif READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & ZB, MAPTMP, MAPFS, MAPSF, TRFLAG -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 7.10' - FLUSH(740+IAPROC) -#endif ! #ifdef W3_SMC IF( GTYPE .EQ. SMCTYPE ) THEN @@ -962,17 +886,9 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) ENDIF #endif ! -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 7.11' - FLUSH(740+IAPROC) -#endif MAPSTA = MOD(MAPTMP+2,8) - 2 MAPST2 = (MAPTMP-MAPSTA) / 8 MAPSF(:,3) = MAPSF(:,2) + (MAPSF(:,1)-1)*NY -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 7.12' - FLUSH(740+IAPROC) -#endif IF ( TRFLAG .NE. 0 ) THEN READ (NDSM,END=801,ERR=802,IOSTAT=IERR) TRNX, TRNY END IF @@ -983,10 +899,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) TRNY = 1 #endif -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 7.13' - FLUSH(740+IAPROC) -#endif READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & DTCFL, DTCFLI, DTMAX, DTMIN, DMIN, CTMAX, & FICE0, FICEN, FICEL, PFMOVE, FLDRY, FLCX, FLCY, & @@ -995,23 +907,11 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) IICEDISP, ICESCALES(1:4), CALTYPE, CMPRTRCK, IICEHFAC, & IICEDDISP, IICEHDISP, IICEFDISP, BTBETA, & AAIRCMIN, AAIRGB -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 7.14' - FLUSH(740+IAPROC) -#endif READ(NDSM,END=801,ERR=802,IOSTAT=IERR)GRIDSHIFT -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 7.15' - FLUSH(740+IAPROC) -#endif #ifdef W3_SEC1 READ (NDSM) NITERSEC1 #endif -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 7.16' - FLUSH(740+IAPROC) -#endif ! #ifdef W3_RTD !! Read rotated Polat/lon and AnglD from mod_def JGLi12Jun2012 @@ -1019,10 +919,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) #endif ! -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 7.17' - FLUSH(740+IAPROC) -#endif END IF #ifdef W3_MEMCHECK @@ -1032,10 +928,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) #endif -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 8' - FLUSH(740+IAPROC) -#endif ! #ifdef W3_T WRITE (NDST,9010) GTYPE, FLAGLL, ICLOSE, SX, SY, X0, Y0, TRFLAG @@ -1063,10 +955,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) END IF #endif ! -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 9' - FLUSH(740+IAPROC) -#endif DEALLOCATE ( MAPTMP ) ! #ifdef W3_T @@ -1095,10 +983,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) FTF, FTWN, FTTR, FTWL, FACTI1, FACTI2, FACHFA, FACHFE END IF -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 10' - FLUSH(740+IAPROC) -#endif ! #ifdef W3_T WRITE (NDST,9030) (MAPWN(I),I=1,8), (MAPTH(I),I=1,8), DTH*RADE, & @@ -1122,10 +1006,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) CLOSE (NDSM) RETURN END IF -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 11' - FLUSH(740+IAPROC) -#endif ! ! Parameters for output boundary points ------------------------------ * ! Module W3ODATMD OUT5 @@ -1138,10 +1018,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & XBPO, YBPO, RDBPO, IPBPO, ISBPO END IF -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 12' - FLUSH(740+IAPROC) -#endif ! #ifdef W3_T WRITE (NDST,9020) @@ -1167,10 +1043,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) IHMAX, HSPMIN, WSMULT, WSCUT, FLCOMB, NOSWLL, & PTMETH, PTFCUT END IF -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 13' - FLUSH(740+IAPROC) -#endif ! #ifdef W3_T WRITE (NDST,9025) IHMAX, HSPMIN, WSMULT, WSCUT, FLCOMB, NOSWLL @@ -1252,10 +1124,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) IC5PARS #endif END IF -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 14' - FLUSH(740+IAPROC) -#endif ! #ifdef W3_T WRITE (NDST,9040) FACP, XREL, XFLT, FXFM, FXPM, XFT, XFC, & @@ -1295,10 +1163,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) IF ( FLTEST ) WRITE (NDST,9048) NITTIN, CAP_ID, CINXSI, CD_MAX #endif ! -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 15' - FLUSH(740+IAPROC) -#endif #ifdef W3_FLX4 IF ( WRITE ) THEN WRITE (NDSM) FLX4A0 @@ -1350,10 +1214,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) END IF #endif ! -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 16' - FLUSH(740+IAPROC) -#endif #ifdef W3_ST2 IF ( FLTEST ) WRITE (NDST,9050) & ZWIND, FSWELL, CDSA0, CDSA1, CDSA2, & @@ -1383,10 +1243,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) END IF #endif ! -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 17' - FLUSH(740+IAPROC) -#endif #ifdef W3_ST4 IF ( WRITE ) THEN CALL INSIN4(.TRUE.) @@ -1420,10 +1276,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) END IF #endif ! -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 18' - FLUSH(740+IAPROC) -#endif #ifdef W3_ST6 IF ( WRITE ) THEN WRITE (NDSM) SIN6A0, SDS6ET, SDS6A1, SDS6A2, & @@ -1439,10 +1291,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) ! ! ... Nonlinear interactions ! -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 19' - FLUSH(740+IAPROC) -#endif #ifdef W3_NL1 IF ( WRITE ) THEN WRITE (NDSM) & @@ -1472,10 +1320,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) END IF #endif ! -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 20' - FLUSH(740+IAPROC) -#endif #ifdef W3_NL2 IF ( FLTEST ) WRITE (NDST,9051) IQTPE, NLTAIL, NDPTHS IF ( FLTEST ) WRITE (NDST,9151) DPTHNL @@ -1506,10 +1350,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) END IF #endif ! -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 21' - FLUSH(740+IAPROC) -#endif #ifdef W3_NL3 IF ( FLTEST ) WRITE (NDST,9051) SNLNQ, SNLMSC, SNLNSC, & SNLSFD, SNLSFS @@ -1577,10 +1417,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) ! ! Layered barriers needed for file management in xnl_init ! -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 22' - FLUSH(740+IAPROC) -#endif #ifdef W3_MPI IF ( FLSNL2 .AND. .NOT.WRITE ) THEN DO IP=1, IAPROC-1 @@ -1626,10 +1462,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) ! ! ... Depth induced breaking ... ! -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 23' - FLUSH(740+IAPROC) -#endif #ifdef W3_MEMCHECK write(740+IAPROC,*) 'memcheck_____:', 'WIOGR SECTION 8' call getMallocInfo(mallinfos) @@ -1689,10 +1521,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) ! ! Propagation scheme ------------------------------------------------- * ! Module W3GDATMD PROP -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 24' - FLUSH(740+IAPROC) -#endif ! #ifdef W3_PR2 IF ( WRITE ) THEN @@ -1753,10 +1581,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) ! Interpolation tables ( fill locally ) ----------------------------- * ! Module W3DISPMD ! -#ifdef W3_DEBUGIOGR - WRITE(740+IAPROC,*) 'W3IOGR, step 25' - FLUSH(740+IAPROC) -#endif IF ( .NOT.WRITE .AND. .NOT.FLDISP ) THEN #ifdef W3_T WRITE (NDST,9070) From b2e18c7e134ff99fedf61cb6f0500f1433d8ea65 Mon Sep 17 00:00:00 2001 From: Mathieu Dutour Sikiric Date: Wed, 7 Sep 2022 16:06:00 +0200 Subject: [PATCH 07/17] More cleanup. --- model/src/w3iorsmd.F90 | 170 ----------------------------------------- 1 file changed, 170 deletions(-) diff --git a/model/src/w3iorsmd.F90 b/model/src/w3iorsmd.F90 index 05371ed163..cc9e59c8ef 100644 --- a/model/src/w3iorsmd.F90 +++ b/model/src/w3iorsmd.F90 @@ -349,11 +349,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ! UNFORMATTED files in OPEN ! ! NDSR = 525 -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'Beginning of W3IORS subroutine' - WRITE(740+IAPROC,*) 'W3IORS, step 1' - FLUSH(740+IAPROC) -#endif IOSFLG = IOSTYP .GT. 0 ! @@ -392,10 +387,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ! ! initializations ---------------------------------------------------- * ! -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'W3IORS, step 2' - FLUSH(740+IAPROC) -#endif IF ( .NOT.DINIT ) THEN IF ( IAPROC .LE. NAPROC ) THEN CALL W3DIMW ( IMOD, NDSE, NDST ) @@ -403,20 +394,12 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) CALL W3DIMW ( IMOD, NDSE, NDST, .FALSE. ) END IF END IF -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'W3IORS, step 3' - FLUSH(740+IAPROC) -#endif ! IF ( IAPROC .LE. NAPROC ) VA(:,0) = 0. ! LRECL = MAX ( LRB*NSPEC , & LRB*(6+(25/LRB)+(9/LRB)+(29/LRB)+(3/LRB)) ) NSIZE = LRECL / LRB -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'W3IORS, LRECL=', LRECL, ' NSIZE=', NSIZE - FLUSH(740+IAPROC) -#endif ! --- Allocate buffer array with zeros (used to ! fill bytes up to size LRECL). --- ALLOCATE(WRITEBUFF(NSIZE)) @@ -465,10 +448,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) //'TEST OUTPUT ARE THE SAME : ',NDST CALL EXTCDE ( 15 ) ENDIF -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'W3IORS, step 4' - FLUSH(740+IAPROC) -#endif IF ( WRITE ) THEN IF ( .NOT.IOSFLG .OR. IAPROC.EQ.NAPRST ) & @@ -556,10 +535,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ! ! TIME if required --------------------------------------------------- * ! -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'W3IORS, step 5' - FLUSH(740+IAPROC) -#endif IF (TYPE.EQ.'FULL') THEN RPOS = 1_8 + LRECL*(2-1_8) IF ( WRITE ) THEN @@ -588,18 +563,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ! Spectra ------------------------------------------------------------ * ! ( Bail out if write for TYPE.EQ.'WIND' ) ! -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'W3IORS, step 6' - FLUSH(740+IAPROC) -#endif IF ( WRITE ) THEN -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'W3IORS, Matching WRITE statement' - FLUSH(740+IAPROC) - WRITE(740+IAPROC,*) 'W3IORS, TYPE=', TYPE, ' IOSFLG=', IOSFLG - WRITE(740+IAPROC,*) 'W3IORS, NAPROC=', NAPROC, ' NAPRST=', NAPRST - FLUSH(740+IAPROC) -#endif IF ( TYPE.EQ.'WIND' .OR. TYPE.EQ.'CALM' ) THEN IF ( .NOT.IOSFLG .OR. IAPROC.EQ.NAPRST ) THEN CLOSE ( NDSR ) @@ -616,18 +580,10 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) RETURN ELSE IF ( IAPROC.LE.NAPROC .OR. IAPROC.EQ. NAPRST ) THEN -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'W3IORS, Need to match 1' - FLUSH(740+IAPROC) -#endif ! ! Original non-server version writing of spectra ! IF ( .NOT.IOSFLG .OR. (NAPROC.EQ.1.AND.NAPRST.EQ.1) ) THEN -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'W3IORS, Need to match 2' - FLUSH(740+IAPROC) -#endif DO JSEA=1, NSEAL CALL INIT_GET_ISEA(ISEA, JSEA) NREC = ISEA + 2 @@ -643,19 +599,9 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ELSE #endif ! -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'W3IORS, Before test for UNST_PDLIB_WRITE_TO_FILE' - WRITE(740+IAPROC,*) 'W3IORS, GTPYPE=', GTYPE, ' UNGTYPE=', UNGTYPE - WRITE(740+IAPROC,*) 'W3IORS, PDLIB=', LPDLIB - FLUSH(740+IAPROC) -#endif #ifdef W3_MPI IF (LPDLIB .and. (GTYPE.eq.UNGTYPE)) THEN #endif -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'W3IORS, Directly before call for UNST_PDLIB_WRITE_TO_FILE, NDSR=', NDSR - FLUSH(740+IAPROC) -#endif #ifdef W3_TIMINGS CALL PRINT_MY_TIME("Before UNST_PDLIB_WRITE_TO_FILE") #endif @@ -748,10 +694,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ! END IF ELSE -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'W3IORS, step 7' - FLUSH(740+IAPROC) -#endif ! ! Reading spectra ! @@ -761,12 +703,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) #endif ELSE IF (LPDLIB .and. (GTYPE.eq.UNGTYPE)) THEN -#ifdef W3_PDLIB -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before call to UNST_PDLIB_READ_FROM_FILE' - FLUSH(740+IAPROC) -#endif -#endif #ifdef W3_TIMINGS CALL PRINT_MY_TIME("Before UNST_PDLIB_READ_FROM_FILE") #endif @@ -775,16 +711,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) #endif #ifdef W3_TIMINGS CALL PRINT_MY_TIME("After UNST_PDLIB_READ_FROM_FILE") -#endif -#ifdef W3_PDLIB -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) ' After call to UNST_PDLIB_READ_FROM_FILE' - WRITE(740+IAPROC,*) ' min/max(VA)=', minval(VA), maxval(VA) - DO JSEA=1,NSEAL - WRITE(740+IAPROC,*) ' JSEA=', JSEA, ' sum(VA)=', sum(VA(:,JSEA)) - END DO - FLUSH(740+IAPROC) -#endif #endif ELSE #ifdef W3_MPI @@ -867,10 +793,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) NPRTX2 = 1 + (NX-1)/NSIZE NPRTY2 = 1 + (NY-1)/NSIZE ! -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'W3IORS, step 8' - FLUSH(740+IAPROC) -#endif IF ( WRITE ) THEN ! IF (TYPE.EQ.'FULL') THEN @@ -1070,9 +992,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) RPOS = 1_8 + LRECL*(NREC-1_8) READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) & TLEV, TICE, TRHO -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before reading WLV' -#endif DO IPART=1,NPART NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) @@ -1080,9 +999,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) (WLV(ISEA),ISEA=1+(IPART-1)*NSIZE, & MIN(NSEA,IPART*NSIZE)) END DO -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before reading ICE' -#endif DO IPART=1,NPART NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) @@ -1111,9 +1027,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) END DO #endif ALLOCATE ( MAPTMP(NY,NX) ) -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before reading MAPTMP' -#endif DO IY=1, NY DO IPART=1,NPRTX2 NREC = NREC + 1 @@ -1137,9 +1050,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) #endif ENDIF ! -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before reading UST' -#endif DO IPART=1,NPART NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) @@ -1147,9 +1057,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) (UST(ISEA),ISEA=1+(IPART-1)*NSIZE, & MIN(NSEA,IPART*NSIZE)) END DO -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before reading USTDIR' -#endif DO IPART=1,NPART NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) @@ -1157,9 +1064,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) (USTDIR(ISEA),ISEA=1+(IPART-1)*NSIZE, & MIN(NSEA,IPART*NSIZE)) END DO -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before reading ASF' -#endif DO IPART=1,NPART NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) @@ -1167,9 +1071,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) (ASF(ISEA),ISEA=1+(IPART-1)*NSIZE, & MIN(NSEA,IPART*NSIZE)) END DO -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before reading FPIS' -#endif DO IPART=1,NPART NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) @@ -1178,22 +1079,13 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) MIN(NSEA,IPART*NSIZE)) END DO IF (OARST) THEN -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before reading CUR' -#endif IF ( FLOGOA(1,2) ) THEN READ (NDSR,ERR=802,IOSTAT=IERR) CX(1:NSEA) READ (NDSR,ERR=802,IOSTAT=IERR) CY(1:NSEA) ENDIF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before reading ICEF' -#endif IF ( FLOGOA(1,12) ) THEN READ (NDSR,ERR=802,IOSTAT=IERR) ICEF(1:NSEA) ENDIF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before reading HS' -#endif IF ( FLOGOA(2,1) ) THEN READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) DO I=1, NSEALM @@ -1201,9 +1093,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) IF (J .LE. NSEA) HS(I) = TMP(J) ENDDO ENDIF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before reading WLM' -#endif IF ( FLOGOA(2,2) ) THEN READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) DO I=1, NSEALM @@ -1211,9 +1100,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) IF (J .LE. NSEA) WLM(I) = TMP(J) ENDDO ENDIF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before reading T0M1' -#endif IF ( FLOGOA(2,4) ) THEN READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) DO I=1, NSEALM @@ -1221,9 +1107,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) IF (J .LE. NSEA) T0M1(I) = TMP(J) ENDDO ENDIF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before reading T01' -#endif IF ( FLOGOA(2,5) ) THEN READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) DO I=1, NSEALM @@ -1231,9 +1114,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) IF (J .LE. NSEA) T01(I) = TMP(J) ENDDO ENDIF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before reading FP0' -#endif IF ( FLOGOA(2,6) ) THEN READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) DO I=1, NSEALM @@ -1241,9 +1121,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) IF (J .LE. NSEA) FP0(I) = TMP(J) ENDDO ENDIF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before reading THM' -#endif IF ( FLOGOA(2,7) ) THEN READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) DO I=1, NSEALM @@ -1251,9 +1128,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) IF (J .LE. NSEA) THM(I) = TMP(J) ENDDO ENDIF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before reading WNMEAN' -#endif IF ( FLOGOA(2,19) ) THEN READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) DO I=1, NSEALM @@ -1261,9 +1135,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) IF (J .LE. NSEA) WNMEAN(I) = TMP(J) ENDDO ENDIF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before reading CHARN' -#endif IF ( FLOGOA(5,2) ) THEN READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) DO I=1, NSEALM @@ -1271,9 +1142,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) IF (J .LE. NSEA) CHARN(I) = TMP(J) ENDDO ENDIF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before reading TAUWI' -#endif IF ( FLOGOA(5,5) ) THEN READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) READ (NDSR,ERR=802,IOSTAT=IERR) TMP2(1:NSEA) @@ -1285,9 +1153,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ENDIF ENDDO ENDIF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before reading TWS' -#endif IF ( FLOGOA(5,11) ) THEN READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) DO I=1, NSEALM @@ -1295,9 +1160,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) IF (J .LE. NSEA) TWS(I) = TMP(J) ENDDO ENDIF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before reading TAUO' -#endif IF ( FLOGOA(6,2) ) THEN READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) READ (NDSR,ERR=802,IOSTAT=IERR) TMP2(1:NSEA) @@ -1309,9 +1171,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ENDIF ENDDO ENDIF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before reading BHD' -#endif IF ( FLOGOA(6,3) ) THEN READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) DO I=1, NSEALM @@ -1319,9 +1178,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) IF (J .LE. NSEA) BHD(I) = TMP(J) ENDDO ENDIF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before reading PHIOC' -#endif IF ( FLOGOA(6,4) ) THEN READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) DO I=1, NSEALM @@ -1329,9 +1185,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) IF (J .LE. NSEA) PHIOC(I) = TMP(J) ENDDO ENDIF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before reading TUS' -#endif IF ( FLOGOA(6,5) ) THEN READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) READ (NDSR,ERR=802,IOSTAT=IERR) TMP2(1:NSEA) @@ -1343,9 +1196,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ENDIF ENDDO ENDIF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before reading USS' -#endif IF ( FLOGOA(6,6) ) THEN READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) READ (NDSR,ERR=802,IOSTAT=IERR) TMP2(1:NSEA) @@ -1357,9 +1207,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ENDIF ENDDO ENDIF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before reading TAUICE' -#endif IF ( FLOGOA(6,10) ) THEN READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) READ (NDSR,ERR=802,IOSTAT=IERR) TMP2(1:NSEA) @@ -1371,9 +1218,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ENDIF ENDDO ENDIF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before reading TAUOC' -#endif IF ( FLOGOA(6,13) ) THEN READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) READ (NDSR,ERR=802,IOSTAT=IERR) TMP2(1:NSEA) @@ -1385,9 +1229,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ENDIF ENDDO ENDIF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before reading UB' -#endif IF ( FLOGOA(7,2) ) THEN READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) READ (NDSR,ERR=802,IOSTAT=IERR) TMP2(1:NSEA) @@ -1399,9 +1240,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ENDIF ENDDO ENDIF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before reading PHIBBL' -#endif IF ( FLOGOA(7,4) ) THEN READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) DO I=1, NSEALM @@ -1409,9 +1247,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) IF (J .LE. NSEA) PHIBBL(I) = TMP(J) ENDDO ENDIF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before reading TAUBBL' -#endif IF ( FLOGOA(7,5) ) THEN READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) READ (NDSR,ERR=802,IOSTAT=IERR) TMP2(1:NSEA) @@ -1493,11 +1328,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ELSE CLOSE ( NDSR ) END IF -! -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'W3IORS, step 9' - FLUSH(740+IAPROC) -#endif ! IF (ALLOCATED(WRITEBUFF)) DEALLOCATE(WRITEBUFF) IF (ALLOCATED(TMP)) DEALLOCATE(TMP) From 920a188f38bca0c6f21d18a00fe20e8a3c4b3ec5 Mon Sep 17 00:00:00 2001 From: Mathieu Dutour Sikiric Date: Wed, 7 Sep 2022 16:08:08 +0200 Subject: [PATCH 08/17] More cleanup. --- model/src/w3triamd.F90 | 95 +----------------------------------------- 1 file changed, 1 insertion(+), 94 deletions(-) diff --git a/model/src/w3triamd.F90 b/model/src/w3triamd.F90 index a6b7afff7c..bd40d98777 100644 --- a/model/src/w3triamd.F90 +++ b/model/src/w3triamd.F90 @@ -200,10 +200,6 @@ SUBROUTINE READMSH(NDS,FNAME) INTEGER(KIND=4),ALLOCATABLE :: IFOUND(:), VERTEX(:), BOUNDTMP(:) DOUBLE PRECISION, ALLOCATABLE :: XYBTMP1(:,:),XYBTMP2(:,:) REAL :: z -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Beginning of READMSH routine' - FLUSH(740+IAPROC) -#endif OPEN(NDS,FILE = FNAME,STATUS='old') READ (NDS,'(A)') COMSTR @@ -312,11 +308,6 @@ SUBROUTINE READMSH(NDS,FNAME) !count points connections to allocate array in W3DIMUG ! CALL COUNT(TRIGPTMP2) -#ifdef W3_DEBUGINIT - WRITE(*,*) 'Call W3DIMUG from READMSH' - WRITE(740+IAPROC,*) 'Call W3DIMUG from READMSH' - FLUSH(740+IAPROC) -#endif CALL W3DIMUG ( 1, NTRI, NX, COUNTOT, NNZ, NDSE, NDST ) ! ! fills arrays @@ -326,14 +317,6 @@ SUBROUTINE READMSH(NDS,FNAME) YGRD(1,I) = XYBTMP2(2,I) ZB(I) = XYBTMP2(3,I) END DO -! -#ifdef W3_DEBUGSTP - WRITE(740,*) 'Writing XYB(3,:)' - DO I=1,NX - WRITE(740,*) 'I,XYB(3,I)=', I, XYB(3,I) - END DO - FLUSH(740) -#endif ! DO I=1, NTRI ITMP = TRIGPTMP2(:,I) @@ -449,10 +432,6 @@ SUBROUTINE READMSH_IOBP(NDS,FNAME) LOGICAL :: lfile_exists CHARACTER :: COMSTR*1, SPACE*1 = ' ', CELS*64 DOUBLE PRECISION, ALLOCATABLE :: XYBTMP1(:,:) -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Beginning of READMSH routine' - FLUSH(740+IAPROC) -#endif INQUIRE(FILE=FNAME, EXIST=lfile_exists) IF (.NOT. lfile_exists) RETURN @@ -2198,17 +2177,9 @@ SUBROUTINE SET_IOBP (MASK, STATUS) INTEGER :: INEXT(3), IPREV(3) INTEGER :: ZNEXT, IP, I, IE, IPNEXT, IPPREV, COUNT integer nb0, nb1, nbM1 -#ifdef W3_DEBUGSETIOBP - WRITE(740+IAPROC,*) 'Calling SETIOBP, step 1' - FLUSH(740+IAPROC) -#endif STATUS = -1 INEXT=(/ 2, 3, 1 /) !IPREV=1+MOD(I+1,3) IPREV=(/ 3, 1, 2 /) !INEXT=1+MOD(I,3) -#ifdef W3_DEBUGSETIOBP - WRITE(740+IAPROC,*) 'Calling SETIOBP, step 2' - FLUSH(740+IAPROC) -#endif DO IE=1,NTRI ! If one of the points of the triangle is masked out (land) then do as if triangle does not exist... ! IF ((MASK(TRIGP(1,IE)).GT.0).AND.(MASK(TRIGP(2,IE)).GT.0).AND.(MASK(TRIGP(3,IE)).GT.0)) THEN @@ -2271,32 +2242,13 @@ SUBROUTINE SET_IOBP (MASK, STATUS) EXIT END IF END DO -#ifdef W3_DEBUGSETIOBP - WRITE(740+IAPROC,*) 'Calling SETIOBP, step 3' - FLUSH(740+IAPROC) -#endif STATUS = 1 CALL GET_BOUNDARY(NX, NTRI, TRIGP, STATUS, PREVVERT, NEXTVERT) -#ifdef W3_DEBUGSETIOBP - WRITE(740+IAPROC,*) 'Calling SETIOBP, step 4' - FLUSH(740+IAPROC) -#endif -! DO IP= 1, NX -! WRITE(12000,*) IP, STATUS(IP) -! ENDDO -#ifdef W3_DEBUGSETIOBP - WRITE(740+IAPROC,*) 'Calling SETIOBP, step 5' - FLUSH(740+IAPROC) -#endif !#ifdef MPI_PARALL_GRID ! CALL exchange_p2di(STATUS) !#endif -#ifdef W3_DEBUGSETIOBP - WRITE(740+IAPROC,*) 'Calling SETIOBP, step 6' - FLUSH(740+IAPROC) -#endif END SUBROUTINE SET_IOBP !/ ------------------------------------------------------------------- / @@ -2820,12 +2772,7 @@ SUBROUTINE SET_UG_IOBP() ! ! 1. Preparations --------------------------------------------------- * ! 1.a Set constants -! -#ifdef W3_DEBUGSETUGIOBP - WRITE(740+IAPROC,*) 'Calling SETUGIOBP, step 1' - FLUSH(740+IAPROC) -#endif - +! #ifdef W3_S CALL STRACE (IENT, 'SETUGIOBP') #endif @@ -2833,18 +2780,10 @@ SUBROUTINE SET_UG_IOBP() !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 2. Searches for boundary points ! -#ifdef W3_DEBUGSETUGIOBP - WRITE(740+IAPROC,*) 'Calling SETUGIOBP, step 2' - FLUSH(740+IAPROC) -#endif ITMP = MAPSTA(1,:) CALL SET_IOBP(ITMP, IOBP) FNAME = 'meshbnd.msh' CALL READMSH_IOBP(23456,FNAME) -#ifdef W3_DEBUGSETUGIOBP - WRITE(740+IAPROC,*) 'Calling SETUGIOBP, step 3' - FLUSH(740+IAPROC) -#endif ! !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 3. Defines directions pointing into land or sea @@ -2858,10 +2797,6 @@ SUBROUTINE SET_UG_IOBP() IOBP(IP) = 2 ENDIF END DO -#ifdef W3_DEBUGSETUGIOBP - WRITE(740+IAPROC,*) 'Calling SETUGIOBP, step 4' - FLUSH(740+IAPROC) -#endif DO IE = 1,NTRI I1 = TRIGP(1,IE) @@ -2911,10 +2846,6 @@ SUBROUTINE SET_UG_IOBP() END DO END DO END DO -#ifdef W3_DEBUGSETUGIOBP - WRITE(740+IAPROC,*) 'Calling SETUGIOBP, step 5' - FLUSH(740+IAPROC) -#endif DO IP = 1, NX IF ( IOBPA(IP) .eq. 1 .OR. IOBP(IP) .eq. 3 .OR. IOBP(IP) .eq. 4) IOBPD(:,IP) = 1 END DO @@ -2932,10 +2863,6 @@ SUBROUTINE SET_UG_IOBP() ! IOBPD(ID,:) = iwild ! ENDDO !#endif -#ifdef W3_DEBUGSETUGIOBP - WRITE(740+IAPROC,*) 'Calling SETUGIOBP, step 7' - FLUSH(740+IAPROC) -#endif !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 3. Updates the reflection direction and sharp / flat shoreline angle @@ -2962,29 +2889,9 @@ SUBROUTINE SET_UG_IOBP() END IF END DO #endif -#ifdef W3_DEBUGSETUGIOBP - WRITE(740+IAPROC,*) 'Calling SETUGIOBP, step 8' - FLUSH(740+IAPROC) -#endif - - -!DO IX=1,NX -!DO ITH=1,NTH -! WRITE(500+IAPROC,*) IX,ITH,IOBP(IX),IOBPA(IX),IOBPD(ITH,IX) !,REFLD(1:2,MAPFS(1,IX)) -!ENDDO -!ENDDO - -#ifdef W3_DEBUGSETUGIOBP - WRITE(740+IAPROC,*) 'Calling SETUGIOBP, step 9' - FLUSH(740+IAPROC) -#endif ! ! Recomputes the angles used in the gradients estimation ! -#ifdef W3_DEBUGSETUGIOBP - WRITE(740+IAPROC,*) 'Calling SETUGIOBP, step 10' - FLUSH(740+IAPROC) -#endif ! RETURN END SUBROUTINE SET_UG_IOBP From 748417494417b58d3a904f46f1c6fd98aa74a06d Mon Sep 17 00:00:00 2001 From: Mathieu Dutour Sikiric Date: Wed, 7 Sep 2022 16:16:08 +0200 Subject: [PATCH 09/17] More cleanup. --- model/src/pdlib_field_vec.F90 | 233 ---------------------------------- model/src/w3adatmd.F90 | 10 -- model/src/w3gridmd.F90 | 31 ----- model/src/w3iogomd.F90 | 12 -- model/src/w3parall.F90 | 89 ------------- model/src/w3psmcmd.F90 | 7 - model/src/w3sdb1md.F90 | 10 -- 7 files changed, 392 deletions(-) diff --git a/model/src/pdlib_field_vec.F90 b/model/src/pdlib_field_vec.F90 index 3435cc1b0a..68760f6b4a 100644 --- a/model/src/pdlib_field_vec.F90 +++ b/model/src/pdlib_field_vec.F90 @@ -486,21 +486,9 @@ SUBROUTINE UNST_PDLIB_READ_FROM_FILE(NDREAD) CALL STRACE (IENT, 'VA_SETUP_IOBPD') #endif ! -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'UNST_PDLIB_READ, Beginning of function' - FLUSH(740+IAPROC) -#endif LRECL = MAX ( LRB*NSPEC , & LRB*(6+(25/LRB)+(9/LRB)+(29/LRB)+(3/LRB)) ) -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'UNST_PDLIB_READ, LRB=', LRB, ' LRECL=', LRECL - FLUSH(740+IAPROC) -#endif IF (IAPROC .gt. NAPROC) THEN -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'Leaving bc rank IAPROC > NAPROC=', NAPROC - FLUSH(740+IAPROC) -#endif RETURN END IF ListFirst(1)=0 @@ -528,10 +516,6 @@ SUBROUTINE UNST_PDLIB_READ_FROM_FILE(NDREAD) CALL PRINT_MY_TIME("Beginning of iBlock value treatment") #endif -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'R : iBlock=', iBlock, '/', nbBlock, 'iFirst=', iFirst, 'iEnd=', iEnd - FLUSH(740+IAPROC) -#endif ! Let's try to get the indexes right. ! We have 1 <= IB <= len = iEnd + 1 - iFirst ! We have iFirst - 1 = (iBlock - 1)*BlockSize @@ -552,11 +536,6 @@ SUBROUTINE UNST_PDLIB_READ_FROM_FILE(NDREAD) END DO #ifdef W3_TIMINGS CALL PRINT_MY_TIME("After data reading") -#endif -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'After the block of reads' - WRITE(740+IAPROC,*) 'iBlock=', iBlock, '/', nbBlock, ' sum(DATAread)=', sum(DATAread) - FLUSH(740+IAPROC) #endif DO iProc=2,NAPROC NbMatch=0 @@ -566,10 +545,6 @@ SUBROUTINE UNST_PDLIB_READ_FROM_FILE(NDREAD) NbMatch = NbMatch+1 END IF END DO -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'Sending to iProc=', iProc, ' NbMatch=', NbMatch - FLUSH(740+IAPROC) -#endif IF (NbMatch .gt. 0) THEN allocate(ArrSend(NSPEC,NbMatch), stat=istat) ArrSend = 0. @@ -604,10 +579,6 @@ SUBROUTINE UNST_PDLIB_READ_FROM_FILE(NDREAD) NbMatch = NbMatch+1 END IF END DO -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'Receiving NbMatch=', NbMatch - FLUSH(740+IAPROC) -#endif IF (NbMatch .gt. 0) THEN allocate(ArrSend(NSPEC,NbMatch), stat=istat) CALL MPI_RECV(ArrSend,NSPEC*NbMatch,MPI_REAL, 0, 37, MPI_COMM_WAVE, istatus, ierr) @@ -629,14 +600,6 @@ SUBROUTINE UNST_PDLIB_READ_FROM_FILE(NDREAD) IF (IAPROC .eq. 1) THEN deallocate(DATAread) END IF -#ifdef W3_DEBUGIO - IF (IAPROC .le. NAPROC) THEN - WRITE(740+IAPROC,*) 'iBlock=', iBlock, '/', nbBlock, ' sum(VA)=', sum(VA) - FLUSH(740+IAPROC) - END IF - WRITE(740+IAPROC,*) 'Exiting READ_FROM_FILE' - FLUSH(740+IAPROC) -#endif END SUBROUTINE !/ ------------------------------------------------------------------- / SUBROUTINE UNST_PDLIB_WRITE_TO_FILE(NDWRITE) @@ -732,51 +695,21 @@ SUBROUTINE UNST_PDLIB_WRITE_TO_FILE(NDWRITE) REAL, allocatable :: DATAsend(:,:) #ifdef W3_S CALL STRACE (IENT, 'VA_SETUP_IOBPD') -#endif -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'Beginning of UNST_PDLIB_WRITE_TO_FILE IAPROC=', IAPROC, 'NAPRST=', NAPRST - FLUSH(740+IAPROC) - WRITE(740+IAPROC,*) 'sum(VA)=', sum(VA) - FLUSH(740+IAPROC) #endif ListFirst(1) = 0 DO IPROC=2,NAPROC ListFirst(iProc)=ListFirst(iProc-1) + ListNPA(iProc-1) END DO ! -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'NX=', NX, ' NY=', NY, ' NSEA=', NSEA - WRITE(740+IAPROC,*) 'NAPROC=', NAPROC, ' NTPROC=', NTPROC -#endif LRECL = MAX ( LRB*NSPEC , & LRB*(6+(25/LRB)+(9/LRB)+(29/LRB)+(3/LRB)) ) -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'UNST_PDLIB_WRITE, LRB=', LRB, ' LRECL=', LRECL - WRITE(740+IAPROC,*) 'NDWRITE=', NDWRITE, 'NAPROC=', NAPROC, 'NTPROC=', NTPROC - FLUSH(740+IAPROC) -#endif nbBlock=NSEA / BlockSize + 1 -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'NSEA=', NSEA, ' BlockSize=', BlockSize -#endif DO iBlock=1,nbBlock iFirst= 1 + (iBlock - 1)*BlockSize iEnd= MIN(iBlock * BlockSize, NSEA) len=iEnd + 1 - iFirst -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'W : iBlock=', iBlock, '/', nbBlock, 'iFirst=', iFirst, 'iEnd=', iEnd, ' len=', len - FLUSH(740+IAPROC) -#endif IF (IAPROC .eq. NAPRST) THEN -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'The Node is a restart writing node' - FLUSH(740+IAPROC) -#endif IF (IAPROC .le. NAPROC) THEN -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'It is also a running node' - FLUSH(740+IAPROC) -#endif DO JSEA=1,NSEAL CALL INIT_GET_ISEA(ISEA, JSEA) IF ((iFirst .le. ISEA).and.(ISEA .le. iEnd)) THEN @@ -785,21 +718,9 @@ SUBROUTINE UNST_PDLIB_WRITE_TO_FILE(NDWRITE) END IF END DO END IF -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'Now iterating over all the nodes for RECV' - FLUSH(740+IAPROC) -#endif DO iProc=1,NAPROC -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'iProc=', iProc, ' / ', NAPROC - FLUSH(740+IAPROC) -#endif IF (iProc .ne. IAPROC) THEN NPAloc=ListNPA(iProc) -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'We found NPAloc=', NPAloc - FLUSH(740+IAPROC) -#endif NbMatch=0 DO IPloc=1,NPAloc IPglob = ListIPLG(ListFirst(iProc) + IPloc) @@ -809,15 +730,7 @@ SUBROUTINE UNST_PDLIB_WRITE_TO_FILE(NDWRITE) END DO IF (NbMatch .gt. 0) THEN allocate(DATArecv(NSPEC, NbMatch), stat=istat) -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'After allocation and before reception, istat=', istat - FLUSH(740+IAPROC) -#endif CALL MPI_RECV(DATArecv,NSPEC*NbMatch,MPI_REAL, iProc-1, 101, MPI_COMM_WAVE, istatus, ierr) -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'After reception, ierr=', ierr - FLUSH(740+IAPROC) -#endif idx=0 DO IPloc=1,NPAloc IPglob = ListIPLG(IPloc + ListFirst(iProc)) @@ -828,23 +741,10 @@ SUBROUTINE UNST_PDLIB_WRITE_TO_FILE(NDWRITE) DATAwrite(:, pos) = DATArecv(:, idx) END IF END DO -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'After assignation' - FLUSH(740+IAPROC) -#endif deallocate(DATArecv, stat=istat) -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'After assignation istat=', istat - FLUSH(740+IAPROC) -#endif END IF END IF END DO -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'Before the actual write down' - WRITE(740+IAPROC,*) 'iBlock=', iBlock, '/', nbBlock, 'Sum DATAwrite=', sum(DATAwrite) - FLUSH(740+IAPROC) -#endif DO ISEA=iFirst,iEnd idx = ISEA - iFirst + 1 NREC = ISEA + 2 @@ -855,20 +755,8 @@ SUBROUTINE UNST_PDLIB_WRITE_TO_FILE(NDWRITE) WRITEBUFF(1:NSPEC) = DATAwrite(1:NSPEC, idx) WRITE(NDWRITE, POS=RPOS) WRITEBUFF END DO -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'After the write down' - FLUSH(740+IAPROC) -#endif ELSE -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'We are a node different from NAPRST' - FLUSH(740+IAPROC) -#endif IF (IAPROC .le. NAPROC) THEN -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'We are a computing node' - FLUSH(740+IAPROC) -#endif NbMatch=0 DO IPloc=1,ListNPA(IAPROC) IPglob = ListIPLG(ListFirst(IAPROC) + IPloc) @@ -876,21 +764,8 @@ SUBROUTINE UNST_PDLIB_WRITE_TO_FILE(NDWRITE) NbMatch=NbMatch+1 END IF END DO -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'NbMatch=', NbMatch - FLUSH(740+IAPROC) -#endif IF (NbMatch .gt. 0) THEN -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'We are actually a computing node so we have something to send' - WRITE(740+IAPROC,*) 'Sending message of length NSEAL=', NSEAL - FLUSH(740+IAPROC) -#endif allocate(DATAsend(NSPEC,NbMatch), stat=istat) -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'After allocation of DATAsend, istat=', istat - FLUSH(740+IAPROC) -#endif idx=0 DO IPloc=1,ListNPA(IAPROC) IPglob = ListIPLG(ListFirst(IAPROC) + IPloc) @@ -899,35 +774,12 @@ SUBROUTINE UNST_PDLIB_WRITE_TO_FILE(NDWRITE) DATAsend(:,idx)=VA(:,IPloc) END IF END DO -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'After assignation of DATAsend' - FLUSH(740+IAPROC) -#endif CALL MPI_SEND(DATAsend,NSPEC*NbMatch,MPI_REAL, NAPRST-1, 101, MPI_COMM_WAVE, ierr) -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'After sending of DATAsend, ierr=', ierr - FLUSH(740+IAPROC) -#endif deallocate(DATAsend, stat=istat) -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'After deallocation of DATAsend, istat=', istat - FLUSH(740+IAPROC) -#endif END IF END IF -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'After the IAPROC test' - FLUSH(740+IAPROC) -#endif END IF END DO -!!/DEBUGIO WRITE(740+IAPROC,*) 'Before the MPI_BARRIER' -!!/DEBUGIO FLUSH(740+IAPROC) -! CALL MPI_BARRIER(MPI_COMM_WAVE, IERR_MPI) -#ifdef W3_DEBUGIO - WRITE(740+IAPROC,*) 'Exiting the UNST_PDLIB_WRITE_TO_FILE' - FLUSH(740+IAPROC) -#endif END SUBROUTINE !/ ------------------------------------------------------------------- / SUBROUTINE DO_OUTPUT_EXCHANGES(IMOD) @@ -1023,11 +875,6 @@ SUBROUTINE DO_OUTPUT_EXCHANGES(IMOD) INTEGER :: eEnt(1), IPROC INTEGER :: TheSize, NSEAL_loc INTEGER, SAVE :: indexOutput -#ifdef W3_DEBUGOUTPUT - WRITE(740+IAPROC,*) 'Beginning of output, indexOutput=', indexOutput - WRITE(740+IAPROC,*) 'NAPROC=', NAPROC, ' NAPFLD=', NAPFLD - FLUSH(740+IAPROC) -#endif !/ !/ ------------------------------------------------------------------- / !/ @@ -1040,17 +887,9 @@ SUBROUTINE DO_OUTPUT_EXCHANGES(IMOD) NRQGO2 = 0 IT0 = NSPEC IROOT = NAPFLD - 1 -#ifdef W3_DEBUGOUTPUT - WRITE(740+IAPROC,*) 'Entering DO_OUTPUT_EXCHANGES' - FLUSH(740+IAPROC) -#endif IF ( FLOUT(1) .OR. FLOUT(7) ) THEN CALL GET_ARRAY_SIZE(TheSize) IF ( IAPROC .LE. NAPROC ) THEN -#ifdef W3_DEBUGOUTPUT - WRITE(740+IAPROC,*) 'Allocating and filling' - FLUSH(740+IAPROC) -#endif allocate(ARRexch(TheSize, NSEAL), ARRpos(NSEAL)) DO JSEA=1,NSEAL CALL INIT_GET_ISEA(ISEA, JSEA) @@ -1454,10 +1293,6 @@ SUBROUTINE DO_OUTPUT_EXCHANGES(IMOD) END DO END DO END IF -#ifdef W3_DEBUGOUTPUT - WRITE(740+IAPROC,*) 'Before assigning field values' - FLUSH(740+IAPROC) -#endif ! ! Now synchronizing the data ! It must be possible to ensure that the output @@ -1471,71 +1306,21 @@ SUBROUTINE DO_OUTPUT_EXCHANGES(IMOD) END DO END IF END IF -#ifdef W3_DEBUGOUTPUT - WRITE(740+IAPROC,*) 'Before ARRexch operations' - FLUSH(740+IAPROC) -#endif IF ((IAPROC .le. NAPROC).and.(IAPROC.ne.NAPFLD)) THEN -#ifdef W3_DEBUGOUTPUT - WRITE(740+IAPROC,*) 'Case 1' - WRITE(740+IAPROC,*) 'NSEAL=', NSEAL - WRITE(740+IAPROC,*) 'IAPROC=', IAPROC, ' NAPFLD=', NAPFLD - FLUSH(740+IAPROC) -#endif eEnt(1)=NSEAL CALL MPI_SEND(eEnt,1,MPI_INTEGER, NAPFLD-1, 23, MPI_COMM_WAVE, ierr) -#ifdef W3_DEBUGOUTPUT - WRITE(740+IAPROC,*) 'After MPI_SEND 1' - FLUSH(740+IAPROC) -#endif CALL MPI_SEND(ARRpos,NSEAL,MPI_INTEGER, NAPFLD-1, 29, MPI_COMM_WAVE, ierr) -#ifdef W3_DEBUGOUTPUT - WRITE(740+IAPROC,*) 'After MPI_SEND 2' - FLUSH(740+IAPROC) -#endif CALL MPI_SEND(ARRexch,NSEAL*TheSize,MPI_REAL, NAPFLD-1, 37, MPI_COMM_WAVE, ierr) -#ifdef W3_DEBUGOUTPUT - WRITE(740+IAPROC,*) 'After MPI_SEND 3' - FLUSH(740+IAPROC) -#endif deallocate(ARRpos, ARRexch) END IF -#ifdef W3_DEBUGOUTPUT - WRITE(740+IAPROC,*) 'Case 2' - FLUSH(740+IAPROC) -#endif IF (IAPROC .eq. NAPFLD) THEN -#ifdef W3_DEBUGOUTPUT - WRITE(740+IAPROC,*) 'Case 2a' - FLUSH(740+IAPROC) -#endif DO IPROC=1,NAPROC IF (IPROC .ne. IAPROC) THEN -#ifdef W3_DEBUGOUTPUT - WRITE(740+IAPROC,*) 'IPROC=', IPROC - FLUSH(740+IAPROC) -#endif CALL MPI_RECV(eEnt,1,MPI_INTEGER, IPROC-1, 23, MPI_COMM_WAVE, istatus, ierr) -#ifdef W3_DEBUGOUTPUT - WRITE(740+IAPROC,*) 'After MPI_RECV 1' - FLUSH(740+IAPROC) -#endif NSEAL_loc=eEnt(1) -#ifdef W3_DEBUGOUTPUT - WRITE(740+IAPROC,*) 'NSEAL_loc=', NSEAL_loc - FLUSH(740+IAPROC) -#endif allocate(ARRpos_loc(NSEAL_loc), ARRexch_loc(TheSize, NSEAL_loc)) CALL MPI_RECV(ARRpos_loc,NSEAL_loc,MPI_INTEGER, IPROC-1, 29, MPI_COMM_WAVE, istatus, ierr) -#ifdef W3_DEBUGOUTPUT - WRITE(740+IAPROC,*) 'After MPI_RECV 2' - FLUSH(740+IAPROC) -#endif CALL MPI_RECV(ARRexch_loc,NSEAL_loc*TheSize,MPI_INTEGER, IPROC-1, 37, MPI_COMM_WAVE, istatus, ierr) -#ifdef W3_DEBUGOUTPUT - WRITE(740+IAPROC,*) 'After MPI_RECV 3' - FLUSH(740+IAPROC) -#endif DO I=1,NSEAL_loc ARRtotal(:,ARRpos_loc(I)) = ARRexch_loc(:,I) END DO @@ -1543,18 +1328,8 @@ SUBROUTINE DO_OUTPUT_EXCHANGES(IMOD) END IF END DO END IF -#ifdef W3_DEBUGOUTPUT - WRITE(740+IAPROC,*) 'After ARRexch operations' - FLUSH(740+IAPROC) - WRITE(740+IAPROC,*) 'NAPFLD=', NAPFLD - FLUSH(740+IAPROC) -#endif IF ( IAPROC .EQ. NAPFLD ) THEN ! CALL W3XDMA ( IMOD, NDSE, NDST, FLGRDALL ) -#ifdef W3_DEBUGOUTPUT - WRITE(740+IAPROC,*) 'Call W3XETA from DO_OUTPUT_EXCHANGES' - FLUSH(740+IAPROC) -#endif CALL W3XETA ( IMOD, NDSE, NDST ) IH = 0 IF ( FLGRDALL( 2, 1) ) THEN @@ -1955,15 +1730,7 @@ SUBROUTINE DO_OUTPUT_EXCHANGES(IMOD) END DO CALL W3SETA ( IMOD, NDSE, NDST ) END IF -#ifdef W3_DEBUGOUTPUT - WRITE(740+IAPROC,*) 'After IAPROC = NAPFLD test' - FLUSH(740+IAPROC) -#endif END IF -#ifdef W3_DEBUGOUTPUT - WRITE(740+IAPROC,*) 'Ending of output, indexOutput=', indexOutput - FLUSH(740+IAPROC) -#endif indexOutput=indexOutput+1 END SUBROUTINE DO_OUTPUT_EXCHANGES !/ ------------------------------------------------------------------- / diff --git a/model/src/w3adatmd.F90 b/model/src/w3adatmd.F90 index 3c0a70591f..9e5936c772 100644 --- a/model/src/w3adatmd.F90 +++ b/model/src/w3adatmd.F90 @@ -1061,21 +1061,11 @@ SUBROUTINE W3DIMA ( IMOD, NDSE, NDST, D_ONLY ) ! For the 3D arrays: the allocation is performed only if these arrays are allowed ! by specific variables defined through the mod_def file ! and read by w3iogr, which is called before W3DIMA. -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before the EF allocation' - WRITE(740+IAPROC,*) 'E3DF=', E3DF(1,1) -#endif IF ( E3DF(1,1).GT.0 ) THEN -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Now the allocation' -#endif ALLOCATE(WADATS(IMOD)%EF(NSEALM,E3DF(2,1):E3DF(3,1)), & STAT=ISTAT ) CHECK_ALLOC_STATUS ( ISTAT ) END IF -#ifdef W3_DEBUGINIT - FLUSH(740+IAPROC) -#endif IF ( E3DF(1,2).GT.0 ) THEN ALLOCATE(WADATS(IMOD)%TH1M(NSEALM,E3DF(2,2):E3DF(3,2)), & STAT=ISTAT ) diff --git a/model/src/w3gridmd.F90 b/model/src/w3gridmd.F90 index 302c586850..1dbf8a90ae 100644 --- a/model/src/w3gridmd.F90 +++ b/model/src/w3gridmd.F90 @@ -3978,13 +3978,6 @@ SUBROUTINE W3GRID() CALL READMSH(NDSG,FNAME) ALLOCATE(ZBIN(NX, NY),OBSX(NX,NY),OBSY(NX,NY)) ZBIN(:,1) = VSC * ZB(:) -#ifdef W3_DEBUGSTP - WRITE(740,*) 'VSC=', VSC - WRITE(740,*) 'Printing ZBIN 1' - DO IX=1,NX - WRITE(740,*) 'IX/ZBIN=', IX, ZBIN(IX,1) - END DO -#endif ! ! subgrid obstructions are not yet handled in unstructured grids ! @@ -3998,12 +3991,6 @@ SUBROUTINE W3GRID() ALLOCATE ( TMPSTA(NY,NX), TMPMAP(NY,NX) ) TMPSTA = 0 ! -#ifdef W3_DEBUGSTP - WRITE(740,*) 'Printing ZBIN 2' - DO IX=1,NX - WRITE(740,*) 'IX/ZBIN=', IX, ZBIN(IX,1) - END DO -#endif IF (GTYPE .EQ. UNGTYPE) THEN TMPSTA = 1 ELSE @@ -4433,12 +4420,6 @@ SUBROUTINE W3GRID() CALL READMSHOBC(NDSG,UGOBCFILE,TMPSTA,UGOBCOK) IF ((GTYPE.EQ.UNGTYPE).AND.UGOBCAUTO.AND.(.NOT.UGOBCOK)) & CALL UG_GETOPENBOUNDARY(TMPSTA,ZBIN,UGOBCDEPTH) -#ifdef W3_DEBUGSTP - WRITE(740,*) 'Printing ZBIN 4' - DO IX=1,NX - WRITE(740,*) 'IX/ZBIN=', IX, ZBIN(IX,1) - END DO -#endif ! ! 8.b Determine where to get the data ! @@ -4898,12 +4879,6 @@ SUBROUTINE W3GRID() 1, NX, IX3, 1, NY, IY3, 'Zb', 'm') #endif ! -#ifdef W3_DEBUGSTP - WRITE(740,*) 'Printing ZBIN 5' - DO IX=1,NX - WRITE(740,*) 'IX/ZBIN=', IX, ZBIN(IX,1) - END DO -#endif TRNX = 0. TRNY = 0. ! @@ -4954,12 +4929,6 @@ SUBROUTINE W3GRID() END DO END DO -#ifdef W3_DEBUGSTP - DO ISEA=1,NSEA - WRITE(740,*) 'ISEA,ZB=', ISEA, ZB(ISEA) - END DO - FLUSH(740) -#endif ! #ifdef W3_SMC !!Li SMC grid definition of mapping arrays. diff --git a/model/src/w3iogomd.F90 b/model/src/w3iogomd.F90 index 82f0e4a974..eac0451438 100644 --- a/model/src/w3iogomd.F90 +++ b/model/src/w3iogomd.F90 @@ -1283,18 +1283,6 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) !/ #ifdef W3_S CALL STRACE (IENT, 'W3OUTG') -#endif -! -#ifdef W3_DEBUGSTP - WRITE(740+IAPROC,*) 'NTH=', NTH - WRITE(740+IAPROC,*) 'NK=', NK - WRITE(740+IAPROC,*) 'NSPEC=', NSPEC - WRITE(740+IAPROC,*) 'NSEAL=', NSEAL - WRITE(740+IAPROC,*) 'W3OUTG, initial A printing' - WRITE(740+IAPROC,*) 'size(A,1)=', size(A,1) - WRITE(740+IAPROC,*) 'size(A,2)=', size(A,2) - WRITE(740+IAPROC,*) 'size(A,3)=', size(A,3) - FLUSH(740+IAPROC) #endif DO I=1,NOGRP DO J=1,NGRPP diff --git a/model/src/w3parall.F90 b/model/src/w3parall.F90 index 311d09a1a7..2b48dd323b 100644 --- a/model/src/w3parall.F90 +++ b/model/src/w3parall.F90 @@ -338,11 +338,6 @@ SUBROUTINE PROP_REFRACTION_PR1(ISEA,DTG, CAD) DO ITH=1, NTH FDDMAX = MAX ( FDDMAX , ABS(ESIN(ITH)*eDDDX - ECOS(ITH)*eDDDY ) ) END DO -#ifdef W3_DEBUG - WRITE(740+IAPROC,*) 'eDDDX=', eDDDX, ' Y=', eDDDY - WRITE(740+IAPROC,*) 'FDDMAX=', FDDMAX - FLUSH(740+IAPROC) -#endif DO IK=1, NK FRK(IK) = FACTH * DSDD(IK) / WN(IK,ISEA) !FRK(IK) = FRK(IK) / MAX ( 1. , FRK(IK)*FDDMAX/CTMAX ) @@ -352,17 +347,6 @@ SUBROUTINE PROP_REFRACTION_PR1(ISEA,DTG, CAD) VCFLT(ISP) = FRG(MAPWN(ISP)) * ECOS(ISP) + & FRK(MAPWN(ISP)) * ( ESIN(ISP)*eDDDX - ECOS(ISP)*eDDDY ) END DO -#ifdef W3_DEBUG - WRITE(740+IAPROC,*) 'pdlib: FACTH=', FACTH - WRITE(740+IAPROC,*) 'pdlib: CTHG0=', eCTHG0 - WRITE(740+IAPROC,*) 'pdlib: FDG=', FDG - WRITE(740+IAPROC,*) 'pdlib: FDDMAX=', FDDMAX - WRITE(740+IAPROC,*) 'pdlib: sum(FRK)=', sum(FRK) - WRITE(740+IAPROC,*) 'pdlib: sum(FRG)=', sum(FRG) - WRITE(740+IAPROC,*) 'pdlib: sum(DSDD)=', sum(DSDD) - WRITE(740+IAPROC,*) 'ISEA=', ISEA, ' sum(VCTH)=', sum(VCFLT) - FLUSH(740+IAPROC) -#endif ! #ifdef W3_REFRX ! 3.c @C/@x refraction and great-circle propagation @@ -647,12 +631,6 @@ SUBROUTINE PROP_FREQ_SHIFT(IP, ISEA, CAS, DMM, DTG) DCYY = - eDCYDY FKD = ( eCX*eDDDX + eCY*eDDDY ) FACK = DTG -#ifdef W3_DEBUG - WRITE(740+IAPROC,*) 'DCXX=', DCXX, ' DCXYYX=', DCXYYX - WRITE(740+IAPROC,*) 'DCYY=', DCYY, ' FKD=', FKD - WRITE(740+IAPROC,*) 'DTG=', DTG - FLUSH(740+IAPROC) -#endif DO ITH=1, NTH FKC(ITH) = EC2(ITH)*DCXX + ESC(ITH)*DCXYYX + ES2(ITH)*DCYY END DO @@ -672,10 +650,6 @@ SUBROUTINE PROP_FREQ_SHIFT(IP, ISEA, CAS, DMM, DTG) DSDD(IK) = 0. END IF END DO -#ifdef W3_DEBUG - WRITE(740+IAPROC,*) 'DSDD(min/max)=', minval(DSDD), maxval(DSDD) - FLUSH(740+IAPROC) -#endif DO IK=0, NK+1 FKD0 = FKD / CG(IK,ISEA) * DSDD(IK) VELFAC = FACK/DB(IK+1) @@ -684,20 +658,12 @@ SUBROUTINE PROP_FREQ_SHIFT(IP, ISEA, CAS, DMM, DTG) CFLK(IK+1,ITH) = VELNOFILT/VELFAC END DO END DO -#ifdef W3_DEBUG - WRITE(740+IAPROC,*) 'sum(CFLK)=', sum(CFLK) - FLUSH(740+IAPROC) -#endif DO IK=1,NK DO ITH=1,NTH ISP=ITH + (IK-1)*NTH CAS(ISP)=DBLE(CFLK(IK,ITH)) END DO END DO -#ifdef W3_DEBUG - WRITE(740+IAPROC,*) 'sum(abs(CAS))=', sum(abs(CAS)) - FLUSH(740+IAPROC) -#endif !/ !/ End of JACOBI_INIT ------------------------------------------------ / !/ @@ -788,10 +754,6 @@ SUBROUTINE PROP_FREQ_SHIFT_M2(IP, ISEA, CWNB_M2, DWNI_M2, DTG) CALL STRACE (IENT, 'PROP_FREQ_SHIFT_M2') #endif -#ifdef W3_DEBUGDCXDX - WRITE(740+IAPROC,*) 'Now we use DCXDX array in PROP_FREQ_SHIFT_M2' -#endif - IF (LPDLIB) THEN eDCXDX = DCXDX(1,IP) eDCXDY = DCXDY(1,IP) @@ -818,33 +780,9 @@ SUBROUTINE PROP_FREQ_SHIFT_M2(IP, ISEA, CWNB_M2, DWNI_M2, DTG) DCYY = - FACK * eDCYDY FKD = FACK * ( eCX*eDDDX + eCY*eDDDY ) -#ifdef W3_DEBUGDCXDX - sumDiff0=0 - sumDiff1=0 - sumDiff2=0 - sumDiff3=0 - sumDiff4=0 - sumDiff5=0 -#endif DO ITH=1, NTH FKC(ITH) = EC2(ITH)*DCXX + ESC(ITH)*DCXYYX + ES2(ITH)*DCYY -#ifdef W3_DEBUGDCXDX - sumDiff0 = sumDiff0 + MIN(EC2(ITH), ZERO) - sumDiff1 = sumDiff1 + MIN(DCXX, ZERO) - sumDiff2 = sumDiff2 + MIN(ESC(ITH), ZERO) - sumDiff3 = sumDiff3 + MIN(DCXYYX, ZERO) - sumDiff4 = sumDiff4 + MIN(ES2(ITH), ZERO) - sumDiff5 = sumDiff5 + MIN(DCYY, ZERO) -#endif END DO -#ifdef W3_DEBUGDCXDX - WRITE(740+IAPROC,*) 'sumDiff0=', sumDiff0 - WRITE(740+IAPROC,*) 'sumDiff1=', sumDiff1 - WRITE(740+IAPROC,*) 'sumDiff2=', sumDiff2 - WRITE(740+IAPROC,*) 'sumDiff3=', sumDiff3 - WRITE(740+IAPROC,*) 'sumDiff4=', sumDiff4 - WRITE(740+IAPROC,*) 'sumDiff5=', sumDiff5 -#endif ! DEPTH = MAX ( DMIN , DW(ISEA) ) DO IK=0, NK+1 @@ -855,40 +793,19 @@ SUBROUTINE PROP_FREQ_SHIFT_M2(IP, ISEA, CWNB_M2, DWNI_M2, DTG) END IF END DO ISP = -NTH -#ifdef W3_DEBUGDCXDX - sumDiff=0 - sumDiff1=0 - sumDiff2=0 - sumDiff3=0 -#endif DO IK=0, NK+1 FKD0 = FKD / CG(IK,ISEA) * DSDD(IK) DO ITH=1, NTH ISP = ISP + 1 VCWN(ISP) = FKD0 + WN(IK,ISEA)*FKC(ITH) -#ifdef W3_DEBUGDCXDX - sumDiff = sumDiff + MAX(VCWN(ISP),ZERO) - sumDiff1 = sumDiff1 + MAX(FKD0,ZERO) - sumDiff2 = sumDiff2 + MAX(WN(IK,ISEA),ZERO) - sumDiff3 = sumDiff3 + MAX(FKC(ITH),ZERO) -#endif END DO END DO -#ifdef W3_DEBUGDCXDX - WRITE(740+IAPROC,*) 'sumDiff=', sumDiff - WRITE(740+IAPROC,*) 'sumDiff1=', sumDiff1 - WRITE(740+IAPROC,*) 'sumDiff2=', sumDiff2 - WRITE(740+IAPROC,*) 'sumDiff3=', sumDiff3 -#endif sumDiff=0 DO ISP=1-NTH,NSPEC CWNB_M2(ISP) = DBLE(0.5 * ( VCWN(ISP) + VCWN(ISP+NTH) )) sumDiff = sumDiff + MAX(CWNB_M2(ISP), ZERO) END DO -#ifdef W3_DEBUGDCXDX - WRITE(740+IAPROC,*) 'sumDiff=', sumDiff -#endif DO IK=1,NK DWNI_M2(IK) = DBLE( CG(IK,ISEA) / DSIP(IK) ) END DO @@ -1086,12 +1003,6 @@ SUBROUTINE SET_UP_NSEAL_NSEALM(NSEALout, NSEALMout) #ifdef W3_S CALL STRACE (IENT, 'SET_UP_NSEAL_NSEALM') #endif -!!/PDLIB WRITE(*,*) 'LPDLIB=', LPDLIB -!!/PDLIB WRITE(*,*) 'GTYPE=', GTYPE, ' UNGTYPE=', UNGTYPE -#ifdef W3_DEBUG - WRITE(740+IAPROC,*) 'SET_UP, PDLIB=', LPDLIB - FLUSH(740+IAPROC) -#endif #ifdef W3_SHRD NSEALout = NSEA diff --git a/model/src/w3psmcmd.F90 b/model/src/w3psmcmd.F90 index ff75846bd4..419e9ef9f1 100644 --- a/model/src/w3psmcmd.F90 +++ b/model/src/w3psmcmd.F90 @@ -3160,9 +3160,6 @@ SUBROUTINE SMCDCXY CXCY(1:NSEA)= CX(1:NSEA) !! Initialize full grid gradient arrays -#ifdef W3_DEBUGDCXDX - WRITE(740+IAPROC,*) 'Before assigning DCXDX to ZERO' -#endif DCXDX = 0.0 DCXDY = 0.0 @@ -3202,10 +3199,6 @@ SUBROUTINE SMCDCXY !$OMP END Parallel DO #endif -#ifdef W3_DEBUGDCXDX - WRITE(740+IAPROC,*) 'After non-trivial assination to DCXDX array' -#endif - !! Assign current CY speed to CXCY and set negative cells. ! CXCY(-9:0) = 0.0 !! Use zero-gradient boundary condition or L0r1 > 0 diff --git a/model/src/w3sdb1md.F90 b/model/src/w3sdb1md.F90 index 99d8446165..1ad971fc4c 100644 --- a/model/src/w3sdb1md.F90 +++ b/model/src/w3sdb1md.F90 @@ -228,11 +228,6 @@ SUBROUTINE W3SDB1 (IX, A, DEPTH, EMEAN, FMEAN, WNMEAN, CG, LBREAK, S, D ) ! 1.a. Maximum wave height ! 1.a.1. Simple limit ! -#ifdef W3_DEBUGDB1 - WRITE(740+IAPROC,*) 'FDONLY=', FDONLY - WRITE(740+IAPROC,*) 'FSSOURCE=', FSSOURCE - FLUSH(740+IAPROC) -#endif IF ( FDONLY ) THEN HM = DBLE(SDBC2) * DBLE(DEPTH) ELSE @@ -316,11 +311,6 @@ SUBROUTINE W3SDB1 (IX, A, DEPTH, EMEAN, FMEAN, WNMEAN, CG, LBREAK, S, D ) WRITE(*,'(I10,20F20.10)') IX, DEPTH, CBJ, BB, QB, SDBC1, SDBC2, FMEAN, FMEAN2, 4*SQRT(ETOT) ENDIF #endif - -#ifdef W3_DEBUGDB1 - WRITE(740+IAPROC,*) 'CBJ=', CBJ - FLUSH(740+IAPROC) -#endif ! ! ... Test output of arrays ! From da806513aaa107378d6a321e4fb23e49d3f9a535 Mon Sep 17 00:00:00 2001 From: Mathieu Dutour Sikiric Date: Tue, 20 Sep 2022 11:57:57 +0200 Subject: [PATCH 10/17] Some further cleanup. --- model/src/w3profsmd_pdlib.F90 | 134 ++++------------------------------ 1 file changed, 13 insertions(+), 121 deletions(-) diff --git a/model/src/w3profsmd_pdlib.F90 b/model/src/w3profsmd_pdlib.F90 index 9ccb29ea6b..29d1b5c6df 100644 --- a/model/src/w3profsmd_pdlib.F90 +++ b/model/src/w3profsmd_pdlib.F90 @@ -799,13 +799,6 @@ SUBROUTINE PDLIB_W3XYPUG ( ISP, FACX, FACY, DTG, VGX, VGY, LCALC ) C(:,1) = VLCFLX(:) * IOBDP_LOC C(:,2) = VLCFLY(:) * IOBDP_LOC -!!/DEBUGSOLVER WRITE(740+IAPROC,*) 'CCURXY=', CCURX, CCURY -!!/DEBUGSOLVER WRITE(740+IAPROC,*) 'max(CX)=', maxval(CX) -!!/DEBUGSOLVER WRITE(740+IAPROC,*) 'max(CY)=', maxval(CY) -!!/DEBUGSOLVER WRITE(740+IAPROC,*) 'min(CLATS)=', minval(CLATS) -!!/DEBUGSOLVER WRITE(740+IAPROC,*) '2: maxval(VLCFLX)=', maxval(VLCFLX) -!!/DEBUGSOLVER WRITE(740+IAPROC,*) '2: maxval(VLCFLY)=', maxval(VLCFLY) -!!/DEBUGSOLVER FLUSH(740+IAPROC) ! ! 4. Prepares boundary update ! @@ -1512,91 +1505,6 @@ SUBROUTINE TEST_MPI_STATUS(string) WRITE(740+IAPROC,*) 'Leaving the TEST_MPI_STATUS' FLUSH(740+IAPROC) END SUBROUTINE -!/ ------------------------------------------------------------------- / - SUBROUTINE HACK_CHECK(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 : 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 : -! -!/ ------------------------------------------------------------------- / -#ifdef W3_S - USE W3SERVMD, only: STRACE -#endif - USE W3GDATMD, only : NK, NTH - USE W3WDATMD, only : VA - USE W3GDATMD, only : NSPEC, NX, NY, NSEAL - USE W3ODATMD, only : IAPROC, NAPROC, NTPROC - IMPLICIT NONE - CHARACTER(*), INTENT(in) :: string - INTEGER ITH_F, IK - INTEGER ITH, ISP, JSEA - REAL eVal, eErr - ITH_F=4 - WRITE(740+IAPROC,*) 'HACK_CHECK, begin' - DO ITH=1,NTH - IF (ITH .eq. ITH_F) THEN - eVal=0.1 - ELSE - eVal=0 - END IF - DO IK=1,NK - ISP=ITH + (IK-1)*NTH - DO JSEA=1,NSEAL - eErr=abs(VA(ISP,JSEA) - eVal) - IF (eErr .gt. 0.01) THEN - WRITE(740+IAPROC,*) 'HACK CHECK, str=', string - WRITE(740+IAPROC,*) 'ITH=', ITH - WRITE(740+IAPROC,*) 'IK=', IK - WRITE(740+IAPROC,*) 'ISP=', ISP - WRITE(740+IAPROC,*) 'JSEA=', JSEA - WRITE(740+IAPROC,*) 'eVal=', eVal - WRITE(740+IAPROC,*) 'VA(ISP,JSEA)=', VA(ISP,JSEA) - FLUSH(740+IAPROC) - END IF - END DO - END DO - END DO - WRITE(740+IAPROC,*) 'HACK_CHECK, end' - END SUBROUTINE !/ ------------------------------------------------------------------- / !/ ------------ SCALAR FUNCTIONALITY --------------------------------- / !/ --------------- REAL V(NSEAL) ------------------------------------- / @@ -1935,6 +1843,8 @@ SUBROUTINE ALL_VAOLD_INTEGRAL_PRINT(string, choice) INTEGER, INTENT(in) :: choice REAL :: FIELD(NSPEC,NSEAL) INTEGER ISPEC, JSEA, maxidx + LOGICAL PrintMinISP = .FALSE. + LOGICAL LocalizeMaximum = .FALSE. DO JSEA=1,NSEAL DO ISPEC=1,NSPEC FIELD(ISPEC,JSEA) = VAOLD(ISPEC,JSEA) @@ -1946,7 +1856,7 @@ SUBROUTINE ALL_VAOLD_INTEGRAL_PRINT(string, choice) maxidx = np END IF ! CALL ALL_FIELD_INTEGRAL_PRINT_GENERAL(FIELD, string) - CALL CHECK_ARRAY_INTEGRAL_NX_R8_MaxFunct(FIELD, string, maxidx, .FALSE. , .FALSE.) + CALL CHECK_ARRAY_INTEGRAL_NX_R8_MaxFunct(FIELD, string, maxidx, PrintMinISP, LocalizeMaximum) END SUBROUTINE !/ ------------------------------------------------------------------- / SUBROUTINE ALL_VA_INTEGRAL_PRINT(IMOD, string, choice) @@ -2006,6 +1916,8 @@ SUBROUTINE ALL_VA_INTEGRAL_PRINT(IMOD, string, choice) INTEGER, INTENT(in) :: choice REAL :: FIELD(NSPEC,NSEAL) INTEGER ISPEC, JSEA, IP_glob, maxidx + LOGICAL PrintMinISP = .FALSE. + LOGICAL LocalizeMaximum = .FALSE. INTEGER :: TEST_IP = 46 INTEGER :: TEST_ISP = 370 IF (GRIDS(IMOD)%GTYPE .ne. UNGTYPE) THEN @@ -2038,7 +1950,7 @@ SUBROUTINE ALL_VA_INTEGRAL_PRINT(IMOD, string, choice) maxidx = np END IF ! CALL ALL_FIELD_INTEGRAL_PRINT_GENERAL(FIELD, string) - CALL CHECK_ARRAY_INTEGRAL_NX_R8_MaxFunct(FIELD, string, maxidx, .FALSE. , .FALSE.) + CALL CHECK_ARRAY_INTEGRAL_NX_R8_MaxFunct(FIELD, string, maxidx, PrintMinISP, LocalizeMaximum) WRITE(740+IAPROC,*) 'After call to ALL_FIELD_INTEGRAL' FLUSH(740+IAPROC) ! IF (NSEAL >= 40) THEN @@ -2101,8 +2013,10 @@ SUBROUTINE ALL_FIELD_INTEGRAL_PRINT(FIELD, string) INTEGER maxidx REAL, INTENT(in) :: FIELD(NSPEC,NSEAL) CHARACTER(*), INTENT(in) :: string + LOGICAL PrintMinISP = .FALSE. + LOGICAL LocalizeMaximum = .FALSE. maxidx = NSEAL - CALL CHECK_ARRAY_INTEGRAL_NX_R8_MaxFunct(FIELD, string, maxidx, .FALSE. , .FALSE.) + CALL CHECK_ARRAY_INTEGRAL_NX_R8_MaxFunct(FIELD, string, maxidx, PrintMinISP, LocalizeMaximum) END SUBROUTINE !/ ------------------------------------------------------------------- / !/ ------- Coherency info for TheARR(NSPEC,npa) ---------------------- / @@ -2381,8 +2295,6 @@ SUBROUTINE CHECK_ARRAY_INTEGRAL_NX_R8(TheARR, string, maxidx) LOGICAL :: LocalizeMaximum = .TRUE. LOGICAL :: CheckUncovered = .TRUE. LOGICAL :: PrintFullValue = .TRUE. - - IF (FULL_NSPEC) THEN CALL CHECK_ARRAY_INTEGRAL_NX_R8_MaxFunct(TheARR, string, maxidx, PrintMinISP, LocalizeMaximum) ELSE @@ -4742,13 +4654,12 @@ SUBROUTINE calcARRAY_JACOBI_SPECTRAL_1(DTG) ! IF (FSREFRACTION) THEN ! -!!/DEBUGSOLVER WRITE(740+IAPROC,*) 'refraction IP=', IP !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 -!!/PR1 CALL PROP_REFRACTION_PR1(ISEA,DTG,CAD) !AR: Is this working? -!!/PR3 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 @@ -4764,7 +4675,6 @@ SUBROUTINE calcARRAY_JACOBI_SPECTRAL_1(DTG) ASPAR_JAC(:,PDLIB_I_DIAG(IP))=ASPAR_JAC(:,PDLIB_I_DIAG(IP)) + B_THE(:)*eSI END IF END DO -!!/DEBUGSOLVER CALL PrintTotalOffContrib("Offdiag after the refraction") END SUBROUTINE !/ ------------------------------------------------------------------- / SUBROUTINE calcARRAY_JACOBI_SPECTRAL_2(DTG,ASPAR_DIAG_LOCAL) @@ -4906,13 +4816,12 @@ SUBROUTINE calcARRAY_JACOBI_SPECTRAL_2(DTG,ASPAR_DIAG_LOCAL) END IF ! IF (FSREFRACTION) THEN -!!/DEBUGSOLVER WRITE(740+IAPROC,*) 'refraction IP=', IP !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 -!!/PR1 CALL PROP_REFRACTION_PR1(ISEA,DTG,CAD) !AR: Is this working? -!!/PR3 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 @@ -4929,7 +4838,6 @@ SUBROUTINE calcARRAY_JACOBI_SPECTRAL_2(DTG,ASPAR_DIAG_LOCAL) END IF END DO -!!/DEBUGSOLVER CALL PrintTotalOffContrib("Offdiag after the refraction") END SUBROUTINE !/ ------------------------------------------------------------------- / SUBROUTINE CALCARRAY_JACOBI_SOURCE_1(DTG) @@ -5098,9 +5006,6 @@ SUBROUTINE CALCARRAY_JACOBI_SOURCE_1(DTG) !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 -!!/DEBUGSOLVER CALL PrintTotalOffContrib("Offdiag after the source terms") !AR: Need to rewrite for IMEM == 2 -!!/DEBUGSOLVER WRITE(740+IAPROC,*) 'Before frequency shifting business' -!!/DEBUGSOLVER FLUSH(740+IAPROC) END SUBROUTINE !/ ------------------------------------------------------------------- / SUBROUTINE CALCARRAY_JACOBI_SOURCE_2(DTG,ASPAR_DIAG_LOCAL) @@ -5263,9 +5168,6 @@ SUBROUTINE CALCARRAY_JACOBI_SOURCE_2(DTG,ASPAR_DIAG_LOCAL) END DO END IF END DO -!!/DEBUGSOLVER CALL PrintTotalOffContrib("Offdiag after the source terms") !AR: Need to rewrite for IMEM == 2 -!!/DEBUGSOLVER WRITE(740+IAPROC,*) 'Before frequency shifting business' -!!/DEBUGSOLVER FLUSH(740+IAPROC) END SUBROUTINE !/ ------------------------------------------------------------------- / SUBROUTINE ADD_SOURCE_TERMS_NONLINEAR(DTG) @@ -6177,7 +6079,6 @@ SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY) IP = JSEA IP_glob = iplg(IP) ISEA = MAPFS(1,IP_glob) -!!/DEBUGSRC WRITE(740+IAPROC,*) 'IP =', IP, 'IP_glob =', IP_glob, 'ISEA =', ISEA DO ISP=1,NSPEC ITH = 1 + MOD(ISP-1,NTH) IK = 1 + (ISP-1)/NTH @@ -6390,11 +6291,6 @@ SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY) END DO WRITE(740+IAPROC,*) 'sum(VAold/VAinput/VAacloc)=', sum(VAold), sum(VAinput), sum(VAacloc) #endif -!!/DEBUGFREQSHIFT DO ISP=1,NSPEC -!!/DEBUGFREQSHIFT eVal1 = eSI * VA(ISP,IP) -!!/DEBUGFREQSHIFT eVal2 = B_JAC(ISP,IP) -!!/DEBUGFREQSHIFT WRITE(740+IAPROC,*) 'eVal12=', eVal1, eVal2 -!!/DEBUGFREQSHIFT END DO Sum_Prev = sum(ACLOC) @@ -7089,10 +6985,6 @@ SUBROUTINE PDLIB_EXPLICIT_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY) IP = JSEA IP_glob=iplg(IP) ISEA=MAPFS(1,IP_glob) - -!!/DEBUGSRC WRITE(740+IAPROC,*) 'IP =', IP -!!/DEBUGSRC WRITE(740+IAPROC,*) 'IP_glob =', IP_glob -!!/DEBUGSRC WRITE(740+IAPROC,*) 'ISEA =', ISEA DO ISP=1,NSPEC ITH = 1 + MOD(ISP-1,NTH) IK = 1 + (ISP-1)/NTH From 447e18fa983aa711945ed107ea53bfda2e20f14d Mon Sep 17 00:00:00 2001 From: Mathieu Dutour Sikiric Date: Tue, 20 Sep 2022 12:00:54 +0200 Subject: [PATCH 11/17] Revert "Some further cleanup." This reverts commit da806513aaa107378d6a321e4fb23e49d3f9a535. --- model/src/w3profsmd_pdlib.F90 | 134 ++++++++++++++++++++++++++++++---- 1 file changed, 121 insertions(+), 13 deletions(-) diff --git a/model/src/w3profsmd_pdlib.F90 b/model/src/w3profsmd_pdlib.F90 index 29d1b5c6df..9ccb29ea6b 100644 --- a/model/src/w3profsmd_pdlib.F90 +++ b/model/src/w3profsmd_pdlib.F90 @@ -799,6 +799,13 @@ SUBROUTINE PDLIB_W3XYPUG ( ISP, FACX, FACY, DTG, VGX, VGY, LCALC ) C(:,1) = VLCFLX(:) * IOBDP_LOC C(:,2) = VLCFLY(:) * IOBDP_LOC +!!/DEBUGSOLVER WRITE(740+IAPROC,*) 'CCURXY=', CCURX, CCURY +!!/DEBUGSOLVER WRITE(740+IAPROC,*) 'max(CX)=', maxval(CX) +!!/DEBUGSOLVER WRITE(740+IAPROC,*) 'max(CY)=', maxval(CY) +!!/DEBUGSOLVER WRITE(740+IAPROC,*) 'min(CLATS)=', minval(CLATS) +!!/DEBUGSOLVER WRITE(740+IAPROC,*) '2: maxval(VLCFLX)=', maxval(VLCFLX) +!!/DEBUGSOLVER WRITE(740+IAPROC,*) '2: maxval(VLCFLY)=', maxval(VLCFLY) +!!/DEBUGSOLVER FLUSH(740+IAPROC) ! ! 4. Prepares boundary update ! @@ -1505,6 +1512,91 @@ SUBROUTINE TEST_MPI_STATUS(string) WRITE(740+IAPROC,*) 'Leaving the TEST_MPI_STATUS' FLUSH(740+IAPROC) END SUBROUTINE +!/ ------------------------------------------------------------------- / + SUBROUTINE HACK_CHECK(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 : 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 : +! +!/ ------------------------------------------------------------------- / +#ifdef W3_S + USE W3SERVMD, only: STRACE +#endif + USE W3GDATMD, only : NK, NTH + USE W3WDATMD, only : VA + USE W3GDATMD, only : NSPEC, NX, NY, NSEAL + USE W3ODATMD, only : IAPROC, NAPROC, NTPROC + IMPLICIT NONE + CHARACTER(*), INTENT(in) :: string + INTEGER ITH_F, IK + INTEGER ITH, ISP, JSEA + REAL eVal, eErr + ITH_F=4 + WRITE(740+IAPROC,*) 'HACK_CHECK, begin' + DO ITH=1,NTH + IF (ITH .eq. ITH_F) THEN + eVal=0.1 + ELSE + eVal=0 + END IF + DO IK=1,NK + ISP=ITH + (IK-1)*NTH + DO JSEA=1,NSEAL + eErr=abs(VA(ISP,JSEA) - eVal) + IF (eErr .gt. 0.01) THEN + WRITE(740+IAPROC,*) 'HACK CHECK, str=', string + WRITE(740+IAPROC,*) 'ITH=', ITH + WRITE(740+IAPROC,*) 'IK=', IK + WRITE(740+IAPROC,*) 'ISP=', ISP + WRITE(740+IAPROC,*) 'JSEA=', JSEA + WRITE(740+IAPROC,*) 'eVal=', eVal + WRITE(740+IAPROC,*) 'VA(ISP,JSEA)=', VA(ISP,JSEA) + FLUSH(740+IAPROC) + END IF + END DO + END DO + END DO + WRITE(740+IAPROC,*) 'HACK_CHECK, end' + END SUBROUTINE !/ ------------------------------------------------------------------- / !/ ------------ SCALAR FUNCTIONALITY --------------------------------- / !/ --------------- REAL V(NSEAL) ------------------------------------- / @@ -1843,8 +1935,6 @@ SUBROUTINE ALL_VAOLD_INTEGRAL_PRINT(string, choice) INTEGER, INTENT(in) :: choice REAL :: FIELD(NSPEC,NSEAL) INTEGER ISPEC, JSEA, maxidx - LOGICAL PrintMinISP = .FALSE. - LOGICAL LocalizeMaximum = .FALSE. DO JSEA=1,NSEAL DO ISPEC=1,NSPEC FIELD(ISPEC,JSEA) = VAOLD(ISPEC,JSEA) @@ -1856,7 +1946,7 @@ SUBROUTINE ALL_VAOLD_INTEGRAL_PRINT(string, choice) maxidx = np END IF ! CALL ALL_FIELD_INTEGRAL_PRINT_GENERAL(FIELD, string) - CALL CHECK_ARRAY_INTEGRAL_NX_R8_MaxFunct(FIELD, string, maxidx, PrintMinISP, LocalizeMaximum) + CALL CHECK_ARRAY_INTEGRAL_NX_R8_MaxFunct(FIELD, string, maxidx, .FALSE. , .FALSE.) END SUBROUTINE !/ ------------------------------------------------------------------- / SUBROUTINE ALL_VA_INTEGRAL_PRINT(IMOD, string, choice) @@ -1916,8 +2006,6 @@ SUBROUTINE ALL_VA_INTEGRAL_PRINT(IMOD, string, choice) INTEGER, INTENT(in) :: choice REAL :: FIELD(NSPEC,NSEAL) INTEGER ISPEC, JSEA, IP_glob, maxidx - LOGICAL PrintMinISP = .FALSE. - LOGICAL LocalizeMaximum = .FALSE. INTEGER :: TEST_IP = 46 INTEGER :: TEST_ISP = 370 IF (GRIDS(IMOD)%GTYPE .ne. UNGTYPE) THEN @@ -1950,7 +2038,7 @@ SUBROUTINE ALL_VA_INTEGRAL_PRINT(IMOD, string, choice) maxidx = np END IF ! CALL ALL_FIELD_INTEGRAL_PRINT_GENERAL(FIELD, string) - CALL CHECK_ARRAY_INTEGRAL_NX_R8_MaxFunct(FIELD, string, maxidx, PrintMinISP, LocalizeMaximum) + CALL CHECK_ARRAY_INTEGRAL_NX_R8_MaxFunct(FIELD, string, maxidx, .FALSE. , .FALSE.) WRITE(740+IAPROC,*) 'After call to ALL_FIELD_INTEGRAL' FLUSH(740+IAPROC) ! IF (NSEAL >= 40) THEN @@ -2013,10 +2101,8 @@ SUBROUTINE ALL_FIELD_INTEGRAL_PRINT(FIELD, string) INTEGER maxidx REAL, INTENT(in) :: FIELD(NSPEC,NSEAL) CHARACTER(*), INTENT(in) :: string - LOGICAL PrintMinISP = .FALSE. - LOGICAL LocalizeMaximum = .FALSE. maxidx = NSEAL - CALL CHECK_ARRAY_INTEGRAL_NX_R8_MaxFunct(FIELD, string, maxidx, PrintMinISP, LocalizeMaximum) + CALL CHECK_ARRAY_INTEGRAL_NX_R8_MaxFunct(FIELD, string, maxidx, .FALSE. , .FALSE.) END SUBROUTINE !/ ------------------------------------------------------------------- / !/ ------- Coherency info for TheARR(NSPEC,npa) ---------------------- / @@ -2295,6 +2381,8 @@ SUBROUTINE CHECK_ARRAY_INTEGRAL_NX_R8(TheARR, string, maxidx) LOGICAL :: LocalizeMaximum = .TRUE. LOGICAL :: CheckUncovered = .TRUE. LOGICAL :: PrintFullValue = .TRUE. + + IF (FULL_NSPEC) THEN CALL CHECK_ARRAY_INTEGRAL_NX_R8_MaxFunct(TheARR, string, maxidx, PrintMinISP, LocalizeMaximum) ELSE @@ -4654,12 +4742,13 @@ SUBROUTINE calcARRAY_JACOBI_SPECTRAL_1(DTG) ! IF (FSREFRACTION) THEN ! +!!/DEBUGSOLVER WRITE(740+IAPROC,*) 'refraction IP=', IP !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) +!!/PR1 CALL PROP_REFRACTION_PR1(ISEA,DTG,CAD) !AR: Is this working? +!!/PR3 CALL PROP_REFRACTION_PR3(ISEA,DTG,CAD, DoLimiterRefraction) CALL PROP_REFRACTION_PR3(IP,ISEA,DTG,CAD,DoLimiterRefraction) ELSE CAD=ZERO @@ -4675,6 +4764,7 @@ SUBROUTINE calcARRAY_JACOBI_SPECTRAL_1(DTG) ASPAR_JAC(:,PDLIB_I_DIAG(IP))=ASPAR_JAC(:,PDLIB_I_DIAG(IP)) + B_THE(:)*eSI END IF END DO +!!/DEBUGSOLVER CALL PrintTotalOffContrib("Offdiag after the refraction") END SUBROUTINE !/ ------------------------------------------------------------------- / SUBROUTINE calcARRAY_JACOBI_SPECTRAL_2(DTG,ASPAR_DIAG_LOCAL) @@ -4816,12 +4906,13 @@ SUBROUTINE calcARRAY_JACOBI_SPECTRAL_2(DTG,ASPAR_DIAG_LOCAL) END IF ! IF (FSREFRACTION) THEN +!!/DEBUGSOLVER WRITE(740+IAPROC,*) 'refraction IP=', IP !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) +!!/PR1 CALL PROP_REFRACTION_PR1(ISEA,DTG,CAD) !AR: Is this working? +!!/PR3 CALL PROP_REFRACTION_PR3(ISEA,DTG,CAD, DoLimiterRefraction) CALL PROP_REFRACTION_PR3(IP,ISEA,DTG,CAD,DoLimiterRefraction) ELSE CAD=ZERO @@ -4838,6 +4929,7 @@ SUBROUTINE calcARRAY_JACOBI_SPECTRAL_2(DTG,ASPAR_DIAG_LOCAL) END IF END DO +!!/DEBUGSOLVER CALL PrintTotalOffContrib("Offdiag after the refraction") END SUBROUTINE !/ ------------------------------------------------------------------- / SUBROUTINE CALCARRAY_JACOBI_SOURCE_1(DTG) @@ -5006,6 +5098,9 @@ SUBROUTINE CALCARRAY_JACOBI_SOURCE_1(DTG) !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 +!!/DEBUGSOLVER CALL PrintTotalOffContrib("Offdiag after the source terms") !AR: Need to rewrite for IMEM == 2 +!!/DEBUGSOLVER WRITE(740+IAPROC,*) 'Before frequency shifting business' +!!/DEBUGSOLVER FLUSH(740+IAPROC) END SUBROUTINE !/ ------------------------------------------------------------------- / SUBROUTINE CALCARRAY_JACOBI_SOURCE_2(DTG,ASPAR_DIAG_LOCAL) @@ -5168,6 +5263,9 @@ SUBROUTINE CALCARRAY_JACOBI_SOURCE_2(DTG,ASPAR_DIAG_LOCAL) END DO END IF END DO +!!/DEBUGSOLVER CALL PrintTotalOffContrib("Offdiag after the source terms") !AR: Need to rewrite for IMEM == 2 +!!/DEBUGSOLVER WRITE(740+IAPROC,*) 'Before frequency shifting business' +!!/DEBUGSOLVER FLUSH(740+IAPROC) END SUBROUTINE !/ ------------------------------------------------------------------- / SUBROUTINE ADD_SOURCE_TERMS_NONLINEAR(DTG) @@ -6079,6 +6177,7 @@ SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY) IP = JSEA IP_glob = iplg(IP) ISEA = MAPFS(1,IP_glob) +!!/DEBUGSRC WRITE(740+IAPROC,*) 'IP =', IP, 'IP_glob =', IP_glob, 'ISEA =', ISEA DO ISP=1,NSPEC ITH = 1 + MOD(ISP-1,NTH) IK = 1 + (ISP-1)/NTH @@ -6291,6 +6390,11 @@ SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY) END DO WRITE(740+IAPROC,*) 'sum(VAold/VAinput/VAacloc)=', sum(VAold), sum(VAinput), sum(VAacloc) #endif +!!/DEBUGFREQSHIFT DO ISP=1,NSPEC +!!/DEBUGFREQSHIFT eVal1 = eSI * VA(ISP,IP) +!!/DEBUGFREQSHIFT eVal2 = B_JAC(ISP,IP) +!!/DEBUGFREQSHIFT WRITE(740+IAPROC,*) 'eVal12=', eVal1, eVal2 +!!/DEBUGFREQSHIFT END DO Sum_Prev = sum(ACLOC) @@ -6985,6 +7089,10 @@ SUBROUTINE PDLIB_EXPLICIT_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY) IP = JSEA IP_glob=iplg(IP) ISEA=MAPFS(1,IP_glob) + +!!/DEBUGSRC WRITE(740+IAPROC,*) 'IP =', IP +!!/DEBUGSRC WRITE(740+IAPROC,*) 'IP_glob =', IP_glob +!!/DEBUGSRC WRITE(740+IAPROC,*) 'ISEA =', ISEA DO ISP=1,NSPEC ITH = 1 + MOD(ISP-1,NTH) IK = 1 + (ISP-1)/NTH From 72d78e74ca01d753aef54b9cc4a393cd1b699b39 Mon Sep 17 00:00:00 2001 From: Mathieu Dutour Sikiric Date: Tue, 20 Sep 2022 12:04:16 +0200 Subject: [PATCH 12/17] Cleanup one file. --- model/src/w3profsmd_pdlib.F90 | 134 ++++------------------------------ 1 file changed, 13 insertions(+), 121 deletions(-) diff --git a/model/src/w3profsmd_pdlib.F90 b/model/src/w3profsmd_pdlib.F90 index 9ccb29ea6b..29d1b5c6df 100644 --- a/model/src/w3profsmd_pdlib.F90 +++ b/model/src/w3profsmd_pdlib.F90 @@ -799,13 +799,6 @@ SUBROUTINE PDLIB_W3XYPUG ( ISP, FACX, FACY, DTG, VGX, VGY, LCALC ) C(:,1) = VLCFLX(:) * IOBDP_LOC C(:,2) = VLCFLY(:) * IOBDP_LOC -!!/DEBUGSOLVER WRITE(740+IAPROC,*) 'CCURXY=', CCURX, CCURY -!!/DEBUGSOLVER WRITE(740+IAPROC,*) 'max(CX)=', maxval(CX) -!!/DEBUGSOLVER WRITE(740+IAPROC,*) 'max(CY)=', maxval(CY) -!!/DEBUGSOLVER WRITE(740+IAPROC,*) 'min(CLATS)=', minval(CLATS) -!!/DEBUGSOLVER WRITE(740+IAPROC,*) '2: maxval(VLCFLX)=', maxval(VLCFLX) -!!/DEBUGSOLVER WRITE(740+IAPROC,*) '2: maxval(VLCFLY)=', maxval(VLCFLY) -!!/DEBUGSOLVER FLUSH(740+IAPROC) ! ! 4. Prepares boundary update ! @@ -1512,91 +1505,6 @@ SUBROUTINE TEST_MPI_STATUS(string) WRITE(740+IAPROC,*) 'Leaving the TEST_MPI_STATUS' FLUSH(740+IAPROC) END SUBROUTINE -!/ ------------------------------------------------------------------- / - SUBROUTINE HACK_CHECK(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 : 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 : -! -!/ ------------------------------------------------------------------- / -#ifdef W3_S - USE W3SERVMD, only: STRACE -#endif - USE W3GDATMD, only : NK, NTH - USE W3WDATMD, only : VA - USE W3GDATMD, only : NSPEC, NX, NY, NSEAL - USE W3ODATMD, only : IAPROC, NAPROC, NTPROC - IMPLICIT NONE - CHARACTER(*), INTENT(in) :: string - INTEGER ITH_F, IK - INTEGER ITH, ISP, JSEA - REAL eVal, eErr - ITH_F=4 - WRITE(740+IAPROC,*) 'HACK_CHECK, begin' - DO ITH=1,NTH - IF (ITH .eq. ITH_F) THEN - eVal=0.1 - ELSE - eVal=0 - END IF - DO IK=1,NK - ISP=ITH + (IK-1)*NTH - DO JSEA=1,NSEAL - eErr=abs(VA(ISP,JSEA) - eVal) - IF (eErr .gt. 0.01) THEN - WRITE(740+IAPROC,*) 'HACK CHECK, str=', string - WRITE(740+IAPROC,*) 'ITH=', ITH - WRITE(740+IAPROC,*) 'IK=', IK - WRITE(740+IAPROC,*) 'ISP=', ISP - WRITE(740+IAPROC,*) 'JSEA=', JSEA - WRITE(740+IAPROC,*) 'eVal=', eVal - WRITE(740+IAPROC,*) 'VA(ISP,JSEA)=', VA(ISP,JSEA) - FLUSH(740+IAPROC) - END IF - END DO - END DO - END DO - WRITE(740+IAPROC,*) 'HACK_CHECK, end' - END SUBROUTINE !/ ------------------------------------------------------------------- / !/ ------------ SCALAR FUNCTIONALITY --------------------------------- / !/ --------------- REAL V(NSEAL) ------------------------------------- / @@ -1935,6 +1843,8 @@ SUBROUTINE ALL_VAOLD_INTEGRAL_PRINT(string, choice) INTEGER, INTENT(in) :: choice REAL :: FIELD(NSPEC,NSEAL) INTEGER ISPEC, JSEA, maxidx + LOGICAL PrintMinISP = .FALSE. + LOGICAL LocalizeMaximum = .FALSE. DO JSEA=1,NSEAL DO ISPEC=1,NSPEC FIELD(ISPEC,JSEA) = VAOLD(ISPEC,JSEA) @@ -1946,7 +1856,7 @@ SUBROUTINE ALL_VAOLD_INTEGRAL_PRINT(string, choice) maxidx = np END IF ! CALL ALL_FIELD_INTEGRAL_PRINT_GENERAL(FIELD, string) - CALL CHECK_ARRAY_INTEGRAL_NX_R8_MaxFunct(FIELD, string, maxidx, .FALSE. , .FALSE.) + CALL CHECK_ARRAY_INTEGRAL_NX_R8_MaxFunct(FIELD, string, maxidx, PrintMinISP, LocalizeMaximum) END SUBROUTINE !/ ------------------------------------------------------------------- / SUBROUTINE ALL_VA_INTEGRAL_PRINT(IMOD, string, choice) @@ -2006,6 +1916,8 @@ SUBROUTINE ALL_VA_INTEGRAL_PRINT(IMOD, string, choice) INTEGER, INTENT(in) :: choice REAL :: FIELD(NSPEC,NSEAL) INTEGER ISPEC, JSEA, IP_glob, maxidx + LOGICAL PrintMinISP = .FALSE. + LOGICAL LocalizeMaximum = .FALSE. INTEGER :: TEST_IP = 46 INTEGER :: TEST_ISP = 370 IF (GRIDS(IMOD)%GTYPE .ne. UNGTYPE) THEN @@ -2038,7 +1950,7 @@ SUBROUTINE ALL_VA_INTEGRAL_PRINT(IMOD, string, choice) maxidx = np END IF ! CALL ALL_FIELD_INTEGRAL_PRINT_GENERAL(FIELD, string) - CALL CHECK_ARRAY_INTEGRAL_NX_R8_MaxFunct(FIELD, string, maxidx, .FALSE. , .FALSE.) + CALL CHECK_ARRAY_INTEGRAL_NX_R8_MaxFunct(FIELD, string, maxidx, PrintMinISP, LocalizeMaximum) WRITE(740+IAPROC,*) 'After call to ALL_FIELD_INTEGRAL' FLUSH(740+IAPROC) ! IF (NSEAL >= 40) THEN @@ -2101,8 +2013,10 @@ SUBROUTINE ALL_FIELD_INTEGRAL_PRINT(FIELD, string) INTEGER maxidx REAL, INTENT(in) :: FIELD(NSPEC,NSEAL) CHARACTER(*), INTENT(in) :: string + LOGICAL PrintMinISP = .FALSE. + LOGICAL LocalizeMaximum = .FALSE. maxidx = NSEAL - CALL CHECK_ARRAY_INTEGRAL_NX_R8_MaxFunct(FIELD, string, maxidx, .FALSE. , .FALSE.) + CALL CHECK_ARRAY_INTEGRAL_NX_R8_MaxFunct(FIELD, string, maxidx, PrintMinISP, LocalizeMaximum) END SUBROUTINE !/ ------------------------------------------------------------------- / !/ ------- Coherency info for TheARR(NSPEC,npa) ---------------------- / @@ -2381,8 +2295,6 @@ SUBROUTINE CHECK_ARRAY_INTEGRAL_NX_R8(TheARR, string, maxidx) LOGICAL :: LocalizeMaximum = .TRUE. LOGICAL :: CheckUncovered = .TRUE. LOGICAL :: PrintFullValue = .TRUE. - - IF (FULL_NSPEC) THEN CALL CHECK_ARRAY_INTEGRAL_NX_R8_MaxFunct(TheARR, string, maxidx, PrintMinISP, LocalizeMaximum) ELSE @@ -4742,13 +4654,12 @@ SUBROUTINE calcARRAY_JACOBI_SPECTRAL_1(DTG) ! IF (FSREFRACTION) THEN ! -!!/DEBUGSOLVER WRITE(740+IAPROC,*) 'refraction IP=', IP !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 -!!/PR1 CALL PROP_REFRACTION_PR1(ISEA,DTG,CAD) !AR: Is this working? -!!/PR3 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 @@ -4764,7 +4675,6 @@ SUBROUTINE calcARRAY_JACOBI_SPECTRAL_1(DTG) ASPAR_JAC(:,PDLIB_I_DIAG(IP))=ASPAR_JAC(:,PDLIB_I_DIAG(IP)) + B_THE(:)*eSI END IF END DO -!!/DEBUGSOLVER CALL PrintTotalOffContrib("Offdiag after the refraction") END SUBROUTINE !/ ------------------------------------------------------------------- / SUBROUTINE calcARRAY_JACOBI_SPECTRAL_2(DTG,ASPAR_DIAG_LOCAL) @@ -4906,13 +4816,12 @@ SUBROUTINE calcARRAY_JACOBI_SPECTRAL_2(DTG,ASPAR_DIAG_LOCAL) END IF ! IF (FSREFRACTION) THEN -!!/DEBUGSOLVER WRITE(740+IAPROC,*) 'refraction IP=', IP !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 -!!/PR1 CALL PROP_REFRACTION_PR1(ISEA,DTG,CAD) !AR: Is this working? -!!/PR3 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 @@ -4929,7 +4838,6 @@ SUBROUTINE calcARRAY_JACOBI_SPECTRAL_2(DTG,ASPAR_DIAG_LOCAL) END IF END DO -!!/DEBUGSOLVER CALL PrintTotalOffContrib("Offdiag after the refraction") END SUBROUTINE !/ ------------------------------------------------------------------- / SUBROUTINE CALCARRAY_JACOBI_SOURCE_1(DTG) @@ -5098,9 +5006,6 @@ SUBROUTINE CALCARRAY_JACOBI_SOURCE_1(DTG) !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 -!!/DEBUGSOLVER CALL PrintTotalOffContrib("Offdiag after the source terms") !AR: Need to rewrite for IMEM == 2 -!!/DEBUGSOLVER WRITE(740+IAPROC,*) 'Before frequency shifting business' -!!/DEBUGSOLVER FLUSH(740+IAPROC) END SUBROUTINE !/ ------------------------------------------------------------------- / SUBROUTINE CALCARRAY_JACOBI_SOURCE_2(DTG,ASPAR_DIAG_LOCAL) @@ -5263,9 +5168,6 @@ SUBROUTINE CALCARRAY_JACOBI_SOURCE_2(DTG,ASPAR_DIAG_LOCAL) END DO END IF END DO -!!/DEBUGSOLVER CALL PrintTotalOffContrib("Offdiag after the source terms") !AR: Need to rewrite for IMEM == 2 -!!/DEBUGSOLVER WRITE(740+IAPROC,*) 'Before frequency shifting business' -!!/DEBUGSOLVER FLUSH(740+IAPROC) END SUBROUTINE !/ ------------------------------------------------------------------- / SUBROUTINE ADD_SOURCE_TERMS_NONLINEAR(DTG) @@ -6177,7 +6079,6 @@ SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY) IP = JSEA IP_glob = iplg(IP) ISEA = MAPFS(1,IP_glob) -!!/DEBUGSRC WRITE(740+IAPROC,*) 'IP =', IP, 'IP_glob =', IP_glob, 'ISEA =', ISEA DO ISP=1,NSPEC ITH = 1 + MOD(ISP-1,NTH) IK = 1 + (ISP-1)/NTH @@ -6390,11 +6291,6 @@ SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY) END DO WRITE(740+IAPROC,*) 'sum(VAold/VAinput/VAacloc)=', sum(VAold), sum(VAinput), sum(VAacloc) #endif -!!/DEBUGFREQSHIFT DO ISP=1,NSPEC -!!/DEBUGFREQSHIFT eVal1 = eSI * VA(ISP,IP) -!!/DEBUGFREQSHIFT eVal2 = B_JAC(ISP,IP) -!!/DEBUGFREQSHIFT WRITE(740+IAPROC,*) 'eVal12=', eVal1, eVal2 -!!/DEBUGFREQSHIFT END DO Sum_Prev = sum(ACLOC) @@ -7089,10 +6985,6 @@ SUBROUTINE PDLIB_EXPLICIT_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY) IP = JSEA IP_glob=iplg(IP) ISEA=MAPFS(1,IP_glob) - -!!/DEBUGSRC WRITE(740+IAPROC,*) 'IP =', IP -!!/DEBUGSRC WRITE(740+IAPROC,*) 'IP_glob =', IP_glob -!!/DEBUGSRC WRITE(740+IAPROC,*) 'ISEA =', ISEA DO ISP=1,NSPEC ITH = 1 + MOD(ISP-1,NTH) IK = 1 + (ISP-1)/NTH From 80d3ef557c0aa94e908b8a4ea6e53f638a6281d5 Mon Sep 17 00:00:00 2001 From: Mathieu Dutour Sikiric Date: Tue, 20 Sep 2022 12:09:31 +0200 Subject: [PATCH 13/17] Further cleaning. --- model/src/w3profsmd_pdlib.F90 | 280 +--------------------------------- 1 file changed, 1 insertion(+), 279 deletions(-) diff --git a/model/src/w3profsmd_pdlib.F90 b/model/src/w3profsmd_pdlib.F90 index 29d1b5c6df..4dbd951343 100644 --- a/model/src/w3profsmd_pdlib.F90 +++ b/model/src/w3profsmd_pdlib.F90 @@ -5169,282 +5169,6 @@ SUBROUTINE CALCARRAY_JACOBI_SOURCE_2(DTG,ASPAR_DIAG_LOCAL) END IF END DO END SUBROUTINE -!/ ------------------------------------------------------------------- / - SUBROUTINE ADD_SOURCE_TERMS_NONLINEAR(DTG) -!/ -!/ +-----------------------------------+ -!/ | 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 : Add source terms nonlinera- -! 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 W3ODATMD, only : IAPROC - USE YOWNODEPOOL, only: iplg, PDLIB_SI, PDLIB_I_DIAG - USE W3ADATMD, only: CG, DW, WN, BEDFORMS, TAUBBL - USE W3GDATMD, only: NK, NTH, NSPEC, MAPFS, optionCall, DMIN - USE W3GDATMD, only: IOBP, MAPSTA, IOBDP, IOBPA -#ifdef W3_BT4 - USE W3GDATMD, only: SED_D50, SED_PSIC -#endif - USE W3GDATMD, only: NSEAL, CLATS - USE W3WDATMD, only: VA, VSTOT, VDTOT, SHAVETOT -#ifdef W3_DB1 - USE W3SDB1MD - USE W3GDATMD, only: SDBSC -#endif -#ifdef W3_DB2 - USE W3SDB2MD -#endif -#ifdef W3_DBX - USE W3SDBXMD -#endif -#ifdef W3_TR1 - USE W3STR1MD -#endif -#ifdef W3_TRX - USE W3STRXMD -#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_BTX - USE W3SBTXMD -#endif -#ifdef W3_BS1 - USE W3SBS1MD -#endif -#ifdef W3_BSX - USE W3SBSXMD -#endif -!/ - IMPLICIT NONE -!/ -!/ ------------------------------------------------------------------- / -!/ Parameter list -!/ -!/ ------------------------------------------------------------------- / -!/ Local PARAMETERs -!/ -#ifdef W3_S - INTEGER, SAVE :: IENT = 0 -#endif -!/ -!/ ------------------------------------------------------------------- / -!/ - REAL, INTENT(in) :: DTG - INTEGER IP, IP_glob, ISEA, IX, IY, JSEA - REAL :: SPEC_VA(NSPEC) - REAL :: CG1(NK), WN1(NK) - REAL :: eSI, eVS, eVD, SIDT - REAL :: DEPTH - INTEGER :: ITH, IK, ISP - REAL :: PreVS, AMAX, EMEAN, FMEAN, WNMEAN, D50, PSIC, TMP1(2), TMP2(3) - LOGICAL :: LBREAK -#ifdef W3_DB1 - REAL :: VSDB(NSPEC), VDDB(NSPEC) -#endif -#ifdef W3_DB2 - REAL :: VSDB(NSPEC), VDDB(NSPEC) -#endif -#ifdef W3_TR1 - REAL :: VSTR(NSPEC), VDTR(NSPEC) -#endif -#ifdef W3_BT1 - REAL :: VSBT(NSPEC), VDBT(NSPEC) -#endif -#ifdef W3_BT4 - REAL :: VSBT(NSPEC), VDBT(NSPEC) -#endif -#ifdef W3_BS1 - REAL :: VSBS(NSPEC), VDBS(NSPEC) -#endif -#ifdef W3_S - CALL STRACE (IENT, 'ADD_SOURCE_TERMS_NONLINEAR') -#endif - DO JSEA=1,NSEAL - IP = JSEA - IP_glob = iplg(IP) - ISEA=MAPFS(1,IP_glob) - eSI=PDLIB_SI(IP) - SIDT = eSI * DTG - DEPTH = DW(ISEA) - CG1 = CG(1:NK,ISEA) - WN1 = WN(1:NK,ISEA) - SPEC_VA = VA(:,JSEA) - - CALL COMPUTE_MEAN_PARAM(SPEC_VA, CG1, WN1, EMEAN, FMEAN, WNMEAN, AMAX) - -#ifdef W3_DB1 - VSDB = 0. -#endif -#ifdef W3_DB2 - VSDB = 0. -#endif -#ifdef W3_TR1 - VSTR = 0. -#endif -#ifdef W3_BT1 - VSBT = 0. -#endif -#ifdef W3_DB1 - VDDB = 0. -#endif -#ifdef W3_DB2 - VDDB = 0. -#endif -#ifdef W3_TR1 - VDTR = 0. -#endif -#ifdef W3_BT1 - VDBT = 0. -#endif - -#ifdef W3_TR1 - CALL W3STR1 ( SPEC_VA, CG1, WN1, DEPTH, IX,VSTR, VDTR ) -#endif -#ifdef W3_TRX - CALL W3STRX -#endif - -#ifdef W3_DB1 - SELECT CASE (NINT(SDBSC)) - CASE(1) - CALL W3SDB1 ( JSEA, SPEC_VA, DEPTH, EMEAN, FMEAN, WNMEAN, CG1, LBREAK, VSDB, VDDB ) - CASE(2) - !CALL W3SDB2 ( JSEA, SPEC_VA, DEPTH, EMEAN, FMEAN, CG1, LBREAK, VSDB, VDDB ) - END SELECT -#endif -#ifdef W3_DB2 - CALL W3SDB2 ( JSEA, SPEC_VA, DEPTH, EMEAN, FMEAN, CG1, LBREAK, VSDB, VDDB ) -#endif -#ifdef W3_BT1 - CALL W3SBT1 ( SPEC_VA, CG1, WN1, DEPTH, VSBT, VDBT ) -#endif - -#ifdef W3_BT4 - D50=SED_D50(ISEA) - PSIC=SED_PSIC(ISEA) - TMP1=TAUBBL(JSEA,1:2) - TMP2=BEDFORMS(JSEA,1:3) - CALL W3SBT4 ( SPEC_VA, CG1, WN1, DEPTH, D50, PSIC, TMP1,TMP2, VSBT, VDBT, IX, IY ) -#endif - -#ifdef W3_BT8 - CALL W3SBT8 ( SPEC_VA, DEPTH, VSBT, VDBT, IX, IY ) -#endif -#ifdef W3_BT9 - CALL W3SBT9 ( SPEC_VA, DEPTH, VSBT, VDBT, IX, IY ) -#endif -#ifdef W3_BTX - CALL W3SBTX -#endif -! -#ifdef W3_BS1 - CALL W3SBS1 ( SPEC_VA, CG1, WN1, DEPTH, CX, CY,TAUSCX, TAUSCY, VSBS, VDBS ) -#endif -#ifdef W3_BSX - CALL W3SBSX -#endif - - DO IK=1,NK - DO ITH=1,NTH - ISP=ITH + (IK-1)*NTH - PreVS=0 - eVD=0 -#ifdef W3_DB1 - PreVS = PreVS + VSDB(ISP) -#endif -#ifdef W3_DB2 - PreVS = PreVS + VSDB(ISP) -#endif -#ifdef W3_TR1 - PreVS = PreVS + VSTR(ISP) -#endif -#ifdef W3_BT1 - PreVS = PreVS + VSBT(ISP) -#endif -#ifdef W3_BS1 - PreVS = PreVS + VSBS(ISP) -#endif - eVS=DBLE(PreVS) / CG(IK,ISEA) * CLATS(ISEA) -#ifdef W3_DB1 - eVD=eVD+DBLE(MIN(0., VDDB(ISP))) -#endif -#ifdef W3_DB2 - eVD=eVD+DBLE(MIN(0., VDDB(ISP))) -#endif -#ifdef W3_TR1 - eVD=eVD+DBLE(MIN(0., VDTR(ISP))) -#endif -#ifdef W3_BT1 - eVD=eVD+DBLE(MIN(0., VDBT(ISP))) -#endif -#ifdef W3_BS1 - eVD=eVD+DBLE(MIN(0., VDBS(ISP))) -#endif - IF (optionCall .eq. 1) THEN - B_JAC(ISP,IP) = B_JAC(ISP,IP) + SIDT * eVS - ASPAR_JAC(ISP,PDLIB_I_DIAG(IP)) = ASPAR_JAC(ISP,PDLIB_I_DIAG(IP)) - SIDT * eVD - ELSE IF (optionCall .eq. 2) THEN - B_JAC(ISP,IP) = B_JAC(ISP,IP) + SIDT * (eVS - eVD*VA(ISP,IP)) - ASPAR_JAC(ISP,PDLIB_I_DIAG(IP)) = ASPAR_JAC(ISP,PDLIB_I_DIAG(IP)) - SIDT * eVD - ELSE IF (optionCall .eq. 3) THEN ! All source terms go with the REAL +- sign. E.g. dissipation is negative - B_JAC(ISP,IP) = B_JAC(ISP,IP) + SIDT * (eVS - eVD*VA(ISP,IP)) - ASPAR_JAC(ISP,PDLIB_I_DIAG(IP)) = ASPAR_JAC(ISP,PDLIB_I_DIAG(IP)) - SIDT * eVD - END IF - ENDDO - ENDDO - ENDDO - END SUBROUTINE !/ ------------------------------------------------------------------- / SUBROUTINE APPLY_BOUNDARY_CONDITION_VA !/ @@ -7754,8 +7478,6 @@ SUBROUTINE SET_UG_IOBP_PDLIB_INIT() WRITE(740+IAPROC,*) 'Calling SETUGIOBP, step 10' FLUSH(740+IAPROC) #endif -! - RETURN END SUBROUTINE SET_UG_IOBP_PDLIB_INIT !/ ------------------------------------------------------------------- / !/ ------------------------------------------------------------------- / @@ -7936,7 +7658,7 @@ SUBROUTINE DEALLOCATE_PDLIB_GLOBAL(IMOD) !/ END SUBROUTINE DEALLOCATE_PDLIB_GLOBAL - SUBROUTINE JACOBI_INIT(IMOD) + SUBROUTINE JACOBI_INIT(IMOD) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | From 5d01896e59710201001b9d744da65c55084c41a9 Mon Sep 17 00:00:00 2001 From: Mathieu Dutour Sikiric Date: Tue, 20 Sep 2022 12:14:06 +0200 Subject: [PATCH 14/17] Correct the END SUBROUTINE. --- model/src/w3profsmd_pdlib.F90 | 82 +++++++++++++++++------------------ 1 file changed, 41 insertions(+), 41 deletions(-) diff --git a/model/src/w3profsmd_pdlib.F90 b/model/src/w3profsmd_pdlib.F90 index 4dbd951343..f3d7088102 100644 --- a/model/src/w3profsmd_pdlib.F90 +++ b/model/src/w3profsmd_pdlib.F90 @@ -501,7 +501,7 @@ SUBROUTINE PDLIB_MAPSTA_INIT(IMOD) !/ !/ End of W3SPR4 ----------------------------------------------------- / !/ - END SUBROUTINE + END SUBROUTINE PDLIB_MAPSTA_INIT !/ ------------------------------------------------------------------- / SUBROUTINE PDLIB_IOBP_INIT(IMOD) !/ @@ -620,7 +620,7 @@ SUBROUTINE PDLIB_IOBP_INIT(IMOD) !/ !/ End of W3SPR4 ----------------------------------------------------- / !/ - END SUBROUTINE + END SUBROUTINE PDLIB_IOBP_INIT !/ ------------------------------------------------------------------- / SUBROUTINE PDLIB_W3XYPUG ( ISP, FACX, FACY, DTG, VGX, VGY, LCALC ) !/ @@ -861,7 +861,7 @@ SUBROUTINE PDLIB_W3XYPUG ( ISP, FACX, FACY, DTG, VGX, VGY, LCALC ) !/ !/ End of W3SPR4 ----------------------------------------------------- / !/ - END SUBROUTINE + END SUBROUTINE PDLIB_W3XYPUG !/ ------------------------------------------------------------------- / SUBROUTINE PDLIB_W3XYPFSN2(ISP, C, LCALC, RD10, RD20, DT, AC) !/ @@ -1190,10 +1190,10 @@ SUBROUTINE PDLIB_W3XYPFSN2(ISP, C, LCALC, RD10, RD20, DT, AC) #endif END DO #ifdef W3_DEBUGSOLVER - WRITE(740+IAPROC,*) 'PDLIB_W3XYPFSN2, step 6' - FLUSH(740+IAPROC) + WRITE(740+IAPROC,*) 'PDLIB_W3XYPFSN2, step 6' + FLUSH(740+IAPROC) #endif - END SUBROUTINE + END SUBROUTINE PDLIB_W3XYPFSN2 !/ ------------------------------------------------------------------- / SUBROUTINE PDLIB_W3XYPFSPSI2 ( ISP, C, LCALC, RD10, RD20, DT, AC) !/ @@ -1427,7 +1427,7 @@ SUBROUTINE PDLIB_W3XYPFSPSI2 ( ISP, C, LCALC, RD10, RD20, DT, AC) END IF CALL PDLIB_exchange1DREAL(AC) END DO ! IT - END SUBROUTINE + END SUBROUTINE PDLIB_W3XYPFSPSI2 !/ ------------------------------------------------------------------- / SUBROUTINE TEST_MPI_STATUS(string) !/ @@ -1504,7 +1504,7 @@ SUBROUTINE TEST_MPI_STATUS(string) END IF WRITE(740+IAPROC,*) 'Leaving the TEST_MPI_STATUS' FLUSH(740+IAPROC) - END SUBROUTINE + END SUBROUTINE TEST_MPI_STATUS !/ ------------------------------------------------------------------- / !/ ------------ SCALAR FUNCTIONALITY --------------------------------- / !/ --------------- REAL V(NSEAL) ------------------------------------- / @@ -1671,7 +1671,7 @@ SUBROUTINE SCAL_INTEGRAL_PRINT_GENERAL(V, string, maxidx, CheckUncovered, PrintF CALL MPI_SEND(ListIdx, NSEAL, MPI_INTEGER, 0, 430, MPI_COMM_WCMP, ierr) deallocate(ListVal, ListIdx) END IF - END SUBROUTINE + END SUBROUTINE SCAL_INTEGRAL_PRINT_GENERAL !/ ------------------------------------------------------------------- / SUBROUTINE SCAL_INTEGRAL_PRINT_R8(V, string) !/ @@ -1728,7 +1728,7 @@ SUBROUTINE SCAL_INTEGRAL_PRINT_R8(V, string) LOGICAL :: PrintFullValue = .FALSE. V8 = V CALL SCAL_INTEGRAL_PRINT_GENERAL(V8, string, NSEAL, CheckUncovered, PrintFullValue) - END SUBROUTINE + END SUBROUTINE SCAL_INTEGRAL_PRINT_R8 !/ ------------------------------------------------------------------- / SUBROUTINE SCAL_INTEGRAL_PRINT_R4(V, string) !/ @@ -1785,7 +1785,7 @@ SUBROUTINE SCAL_INTEGRAL_PRINT_R4(V, string) REAL*8 V8(NSEAL) V8 = DBLE(V) CALL SCAL_INTEGRAL_PRINT_GENERAL(V8, string, NSEAL, CheckUncovered, PrintFullValue) - END SUBROUTINE + END SUBROUTINE SCAL_INTEGRAL_PRINT_R4 !/ ------------------------------------------------------------------- / SUBROUTINE ALL_VAOLD_INTEGRAL_PRINT(string, choice) !/ @@ -1857,7 +1857,7 @@ SUBROUTINE ALL_VAOLD_INTEGRAL_PRINT(string, choice) END IF ! CALL ALL_FIELD_INTEGRAL_PRINT_GENERAL(FIELD, string) CALL CHECK_ARRAY_INTEGRAL_NX_R8_MaxFunct(FIELD, string, maxidx, PrintMinISP, LocalizeMaximum) - END SUBROUTINE + END SUBROUTINE ALL_VAOLD_INTEGRAL_PRINT !/ ------------------------------------------------------------------- / SUBROUTINE ALL_VA_INTEGRAL_PRINT(IMOD, string, choice) !/ @@ -1957,7 +1957,7 @@ SUBROUTINE ALL_VA_INTEGRAL_PRINT(IMOD, string, choice) ! WRITE(740+IAPROC,*) 'min/max/sum(VA(:,TESTNODE))=', minval(VA(:,TESTNODE)), maxval(VA(:,TESTNODE)), sum(VA(:,TESTNODE)) ! FLUSH(740+IAPROC) ! END IF - END SUBROUTINE + END SUBROUTINE ALL_VA_INTEGRAL_PRINT !/ ------------------------------------------------------------------- / SUBROUTINE ALL_FIELD_INTEGRAL_PRINT(FIELD, string) !/ @@ -2017,7 +2017,7 @@ SUBROUTINE ALL_FIELD_INTEGRAL_PRINT(FIELD, string) LOGICAL LocalizeMaximum = .FALSE. maxidx = NSEAL CALL CHECK_ARRAY_INTEGRAL_NX_R8_MaxFunct(FIELD, string, maxidx, PrintMinISP, LocalizeMaximum) - END SUBROUTINE + END SUBROUTINE ALL_FIELD_INTEGRAL_PRINT !/ ------------------------------------------------------------------- / !/ ------- Coherency info for TheARR(NSPEC,npa) ---------------------- / !/ ----------- maxidx is np or npa ----------------------------------- / @@ -2303,7 +2303,7 @@ SUBROUTINE CHECK_ARRAY_INTEGRAL_NX_R8(TheARR, string, maxidx) END DO CALL SCAL_INTEGRAL_PRINT_GENERAL(TheARR_red, string, maxidx, CheckUncovered, PrintFullValue) END IF - END SUBROUTINE + END SUBROUTINE CHECK_ARRAY_INTEGRAL_NX_R8 !/ ------------------------------------------------------------------- / SUBROUTINE PDLIB_W3XYPFSFCT2 ( ISP, C, LCALC, RD10, RD20, DT, AC) !/ @@ -2662,7 +2662,7 @@ SUBROUTINE PDLIB_W3XYPUG_BLOCK_IMPLICIT(IMOD, FACX, FACY, DTG, VGX, VGY) !/ !/ End of W3XYPFSN --------------------------------------------------- / !/ - END SUBROUTINE + END SUBROUTINE PDLIB_W3XYPUG_BLOCK_IMPLICIT !/ ------------------------------------------------------------------- / SUBROUTINE PDLIB_W3XYPUG_BLOCK_EXPLICIT(IMOD, FACX, FACY, DTG, VGX, VGY) !/ @@ -2723,7 +2723,7 @@ SUBROUTINE PDLIB_W3XYPUG_BLOCK_EXPLICIT(IMOD, FACX, FACY, DTG, VGX, VGY) !/ !/ End of W3XYPFSN ----------------------------------------------------- / !/ - END SUBROUTINE + END SUBROUTINE PDLIB_W3XYPUG_BLOCK_EXPLICIT !/ --------------------------------------------------------------------- / SUBROUTINE PRINT_WN_STATISTIC(string) !/ @@ -2804,7 +2804,7 @@ SUBROUTINE PRINT_WN_STATISTIC(string) !/ !/ End of W3XYPFSN --------------------------------------------------- / !/ - END SUBROUTINE + END SUBROUTINE PRINT_WN_STATISTIC !/ ------------------------------------------------------------------- / SUBROUTINE WRITE_VAR_TO_TEXT_FILE(TheArr, eFile) !/ @@ -2937,7 +2937,7 @@ SUBROUTINE WRITE_VAR_TO_TEXT_FILE(TheArr, eFile) !/ !/ End of W3XYPFSN ----------------------------------------------------- / !/ - END SUBROUTINE + END SUBROUTINE WRITE_VAR_TO_TEXT_FILE !/ ------------------------------------------------------------------- / SUBROUTINE PrintTotalOffContrib(string) !/ @@ -3024,7 +3024,7 @@ SUBROUTINE PrintTotalOffContrib(string) !/ !/ End of W3XYPFSN --------------------------------------------------- / !/ - END SUBROUTINE + END SUBROUTINE PrintTotalOffContrib !/ ------------------------------------------------------------------- / SUBROUTINE COMPUTE_MEAN_PARAM (A, CG, WN, EMEAN, FMEAN, WNMEAN, AMAX) !/ @@ -3147,7 +3147,7 @@ SUBROUTINE COMPUTE_MEAN_PARAM (A, CG, WN, EMEAN, FMEAN, WNMEAN, AMAX) !/ !/ End of W3SPR0 ----------------------------------------------------- / !/ - END SUBROUTINE + END SUBROUTINE COMPUTE_MEAN_PARAM !/ ------------------------------------------------------------------- / SUBROUTINE calcARRAY_JACOBI(DTG,FACX,FACY,VGX,VGY) !/ @@ -3385,7 +3385,7 @@ SUBROUTINE calcARRAY_JACOBI(DTG,FACX,FACY,VGX,VGY) !/ !/ End of W3XYPFSN ----------------------------------------------------- / !/ - END SUBROUTINE + END SUBROUTINE calcARRAY_JACOBI !/ ------------------------------------------------------------------- / SUBROUTINE calcARRAY_JACOBI_VEC(DTG,FACX,FACY,VGX,VGY) !/ @@ -3642,7 +3642,7 @@ SUBROUTINE calcARRAY_JACOBI_VEC(DTG,FACX,FACY,VGX,VGY) !/ !/ End of W3XYPFSN ----------------------------------------------------- / !/ - END SUBROUTINE + END SUBROUTINE calcARRAY_JACOBI_VEC !/ ------------------------------------------------------------------- / SUBROUTINE calcARRAY_JACOBI2(DTG,FACX,FACY,VGX,VGY) !/ @@ -3857,7 +3857,7 @@ SUBROUTINE calcARRAY_JACOBI2(DTG,FACX,FACY,VGX,VGY) !/ !/ End of W3XYPFSN ----------------------------------------------------- / !/ - END SUBROUTINE + END SUBROUTINE calcARRAY_JACOBI2 !/ ------------------------------------------------------------------- / SUBROUTINE calcARRAY_JACOBI3(IP,J,DTG,FACX,FACY,VGX,VGY,ASPAR_DIAG_LOCAL,ASPAR_OFF_DIAG_LOCAL,B_JAC_LOCAL) !/ @@ -4067,7 +4067,7 @@ SUBROUTINE calcARRAY_JACOBI3(IP,J,DTG,FACX,FACY,VGX,VGY,ASPAR_DIAG_LOCAL,ASPAR_O !/ !/ End of W3XYPFSN --------------------------------------------------- / !/ - END SUBROUTINE + END SUBROUTINE calcARRAY_JACOBI3 !/ ------------------------------------------------------------------- / SUBROUTINE calcARRAY_JACOBI4(IP,DTG,FACX,FACY,VGX,VGY,ASPAR_DIAG_LOCAL,ASPAR_OFF_DIAG_LOCAL,B_JAC_LOCAL) !/ @@ -4310,7 +4310,7 @@ SUBROUTINE calcARRAY_JACOBI4(IP,DTG,FACX,FACY,VGX,VGY,ASPAR_DIAG_LOCAL,ASPAR_OFF B_JAC_LOCAL(ISP) = B_JAC_LOCAL(ISP) + TRIA03 * VAOLD(ISP,IP) * IOBPTH2(ITH)!IOBDP(IP_glob) * IOBPD(ITH,IP_glob) END DO END DO - END SUBROUTINE + END SUBROUTINE calcARRAY_JACOBI4 !/ ------------------------------------------------------------------- / SUBROUTINE calcARRAY_JACOBI5(IE,DTG,FACX,FACY,VGX,VGY) !/ @@ -4524,7 +4524,7 @@ SUBROUTINE calcARRAY_JACOBI5(IE,DTG,FACX,FACY,VGX,VGY) !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 + END SUBROUTINE calcARRAY_JACOBI5 !/ ------------------------------------------------------------------- / SUBROUTINE calcARRAY_JACOBI_SPECTRAL_1(DTG) !/ @@ -4675,7 +4675,7 @@ SUBROUTINE calcARRAY_JACOBI_SPECTRAL_1(DTG) ASPAR_JAC(:,PDLIB_I_DIAG(IP))=ASPAR_JAC(:,PDLIB_I_DIAG(IP)) + B_THE(:)*eSI END IF END DO - END SUBROUTINE + END SUBROUTINE calcARRAY_JACOBI_SPECTRAL_1 !/ ------------------------------------------------------------------- / SUBROUTINE calcARRAY_JACOBI_SPECTRAL_2(DTG,ASPAR_DIAG_LOCAL) !/ @@ -4838,7 +4838,7 @@ SUBROUTINE calcARRAY_JACOBI_SPECTRAL_2(DTG,ASPAR_DIAG_LOCAL) END IF END DO - END SUBROUTINE + END SUBROUTINE calcARRAY_JACOBI_SPECTRAL_2 !/ ------------------------------------------------------------------- / SUBROUTINE CALCARRAY_JACOBI_SOURCE_1(DTG) !/ @@ -5006,7 +5006,7 @@ SUBROUTINE CALCARRAY_JACOBI_SOURCE_1(DTG) !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 + END SUBROUTINE CALCARRAY_JACOBI_SOURCE_1 !/ ------------------------------------------------------------------- / SUBROUTINE CALCARRAY_JACOBI_SOURCE_2(DTG,ASPAR_DIAG_LOCAL) !/ @@ -5168,7 +5168,7 @@ SUBROUTINE CALCARRAY_JACOBI_SOURCE_2(DTG,ASPAR_DIAG_LOCAL) END DO END IF END DO - END SUBROUTINE + END SUBROUTINE CALCARRAY_JACOBI_SOURCE_2 !/ ------------------------------------------------------------------- / SUBROUTINE APPLY_BOUNDARY_CONDITION_VA !/ @@ -5284,7 +5284,7 @@ SUBROUTINE APPLY_BOUNDARY_CONDITION_VA END DO END IF END IF - END SUBROUTINE + END SUBROUTINE APPLY_BOUNDARY_CONDITION_VA !/ ------------------------------------------------------------------- / SUBROUTINE APPLY_BOUNDARY_CONDITION(IMOD) !/ @@ -5465,7 +5465,7 @@ SUBROUTINE APPLY_BOUNDARY_CONDITION(IMOD) CALL ALL_VA_INTEGRAL_PRINT(IMOD, "VA(npa) after boundary", 1) #endif END IF - END SUBROUTINE + END SUBROUTINE APPLY_BOUNDARY_CONDITION !/ ------------------------------------------------------------------- / SUBROUTINE ACTION_LIMITER_LOCAL(IP,ACLOC,ACOLD, DTG) !/ @@ -5591,7 +5591,7 @@ SUBROUTINE ACTION_LIMITER_LOCAL(IP,ACLOC,ACOLD, DTG) END DO END DO ENDIF - END SUBROUTINE + END SUBROUTINE ACTION_LIMITER_LOCAL !/ ------------------------------------------------------------------- / SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY) !/ @@ -6549,10 +6549,10 @@ SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY) #ifdef W3_DEBUGSOLVER - WRITE(740+IAPROC,*) 'PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK, end' - FLUSH(740+IAPROC) + WRITE(740+IAPROC,*) 'PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK, end' + FLUSH(740+IAPROC) #endif - END SUBROUTINE + END SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK !/ ------------------------------------------------------------------- / SUBROUTINE PDLIB_EXPLICIT_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY) !/ @@ -6908,10 +6908,10 @@ SUBROUTINE PDLIB_EXPLICIT_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY) #ifdef W3_DEBUGSOLVER - WRITE(740+IAPROC,*) 'PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK, end' - FLUSH(740+IAPROC) + WRITE(740+IAPROC,*) 'PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK, end' + FLUSH(740+IAPROC) #endif - END SUBROUTINE + END SUBROUTINE PDLIB_EXPLICIT_BLOCK !/ ------------------------------------------------------------------- / SUBROUTINE BLOCK_SOLVER_INIT(IMOD) !/ @@ -7052,7 +7052,7 @@ SUBROUTINE BLOCK_SOLVER_INIT(IMOD) WRITE(740+IAPROC,*) 'BLOCK_SOLVER_INIT, step 6' FLUSH(740+IAPROC) #endif - END SUBROUTINE + END SUBROUTINE BLOCK_SOLVER_INIT !/ ------------------------------------------------------------------ / SUBROUTINE SET_IOBDP_PDLIB !/ From 1fc3fdd430f5cba34b82127a59fdff3724093693 Mon Sep 17 00:00:00 2001 From: Mathieu Dutour Sikiric Date: Tue, 20 Sep 2022 12:25:43 +0200 Subject: [PATCH 15/17] Further cleaning of the file. --- model/src/w3profsmd_pdlib.F90 | 95 ++++++++--------------------------- 1 file changed, 20 insertions(+), 75 deletions(-) diff --git a/model/src/w3profsmd_pdlib.F90 b/model/src/w3profsmd_pdlib.F90 index f3d7088102..ac55b25194 100644 --- a/model/src/w3profsmd_pdlib.F90 +++ b/model/src/w3profsmd_pdlib.F90 @@ -610,13 +610,10 @@ SUBROUTINE PDLIB_IOBP_INIT(IMOD) END DO IOBDP_loc = 0 - !DEALLOCATE(IOBP,IOBPD) IOBP => NULL() IOBPD => NULL() DEALLOCATE(GRIDS(IMOD)%IOBP,GRIDS(IMOD)%IOBPD) -! - CALL SET_IOBPA_PDLIB - + CALL SET_IOBPA_PDLIB !/ !/ End of W3SPR4 ----------------------------------------------------- / !/ @@ -1655,6 +1652,7 @@ SUBROUTINE SCAL_INTEGRAL_PRINT_GENERAL(V, string, maxidx, CheckUncovered, PrintF END DO END IF FLUSH(740+IAPROC) + deallocate(Vcoll, Status) ELSE singV(1) = NSEAL singV(2) = maxidx @@ -7459,25 +7457,6 @@ SUBROUTINE SET_UG_IOBP_PDLIB_INIT() WRITE(740+IAPROC,*) 'Calling SETUGIOBP, step 8' FLUSH(740+IAPROC) #endif - - -!DO IX=1,NX -!DO ITH=1,NTH -! WRITE(500+IAPROC,*) IX,ITH,IOBP(IX),IOBPA(IX),IOBPD(ITH,IX) !,REFLD(1:2,MAPFS(1,IX)) -!ENDDO -!ENDDO - -#ifdef W3_DEBUGSETUGIOBP - WRITE(740+IAPROC,*) 'Calling SETUGIOBP, step 9' - FLUSH(740+IAPROC) -#endif -! -! Recomputes the angles used in the gradients estimation -! -#ifdef W3_DEBUGSETUGIOBP - WRITE(740+IAPROC,*) 'Calling SETUGIOBP, step 10' - FLUSH(740+IAPROC) -#endif END SUBROUTINE SET_UG_IOBP_PDLIB_INIT !/ ------------------------------------------------------------------- / !/ ------------------------------------------------------------------- / @@ -7729,79 +7708,31 @@ SUBROUTINE JACOBI_INIT(IMOD) !/ !/ ------------------------------------------------------------------- / !/ - INTEGER, INTENT(IN) :: IMOD + INTEGER, INTENT(IN) :: IMOD INTEGER istat -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'JACOBI_INIT, step 1' - FLUSH(740+IAPROC) -#endif IF (IMEM == 1) THEN ALLOCATE(ASPAR_JAC(NSPEC, PDLIB_NNZ), stat=istat) - !ASPAR_JAC = 0. if(istat /= 0) CALL PDLIB_ABORT(9) ELSE IF (IMEM == 2) THEN ALLOCATE(ASPAR_DIAG_ALL(NSPEC, npa), stat=istat) - !ASPAR_DIAG_ALL = 0. if(istat /= 0) CALL PDLIB_ABORT(9) ENDIF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'JACOBI_INIT, step 2' - FLUSH(740+IAPROC) -#endif ALLOCATE(B_JAC(NSPEC,NSEAL), stat=istat) - !B_JAC = 0. if(istat /= 0) CALL PDLIB_ABORT(10) -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'JACOBI_INIT, step 3' - FLUSH(740+IAPROC) -#endif ALLOCATE(CAD_THE(NSPEC,NSEAL), stat=istat) - !CAD_THE = 0. if(istat /= 0) CALL PDLIB_ABORT(11) -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'JACOBI_INIT, step 4' - FLUSH(740+IAPROC) -#endif IF (FreqShiftMethod .eq. 1) THEN ALLOCATE(CAS_SIG(NSPEC,NSEAL), stat=istat) - !CAS_SIG = 0. if(istat /= 0) CALL PDLIB_ABORT(11) -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'JACOBI_INIT, step 5, FreqShiftMethod=', FreqShiftMethod - FLUSH(740+IAPROC) -#endif ELSE IF (FreqShiftMethod .eq. 2) THEN -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'Before CWNB_SIG_M2 allocation, NTH=', NTH - FLUSH(740+IAPROC) -#endif - ALLOCATE(CWNB_SIG_M2(1-NTH:NSPEC,NSEAL), stat=istat) -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'After CWNB_SIG_M2 allocation, istat=', istat - FLUSH(740+IAPROC) -#endif - !CWNB_SIG_M2 = 0. - if(istat /= 0) CALL PDLIB_ABORT(11) -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'After istat test' - FLUSH(740+IAPROC) - WRITE(740+IAPROC,*) 'After CWNB_SIG_M2 setting to zero' - FLUSH(740+IAPROC) -#endif + ALLOCATE(CWNB_SIG_M2(1-NTH:NSPEC,NSEAL), stat=istat) + if(istat /= 0) CALL PDLIB_ABORT(11) END IF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'JACOBI_INIT, step 6' - FLUSH(740+IAPROC) -#endif IF (.NOT. B_JGS_BLOCK_GAUSS_SEIDEL) THEN ALLOCATE(U_JAC(NSPEC,npa), stat=istat) if(istat /= 0) CALL PDLIB_ABORT(12) END IF -#ifdef W3_DEBUGINIT - WRITE(740+IAPROC,*) 'JACOBI_INIT, step 7' - FLUSH(740+IAPROC) -#endif !/ !/ End of JACOBI_INIT ------------------------------------------------ / !/ @@ -7873,7 +7804,21 @@ SUBROUTINE JACOBI_FINALIZE #ifdef W3_S CALL STRACE (IENT, 'JACOBI_FINALIZE') #endif - DEALLOCATE(ASPAR_JAC, B_JAC) + IF (IMEM == 1) THEN + DEALLOCATE(ASPAR_JAC) + ELSE IF (IMEM == 2) THEN + DEALLOCATE(ASPAR_DIAG_ALL) + ENDIF + DEALLOCATE(B_JAC) + DEALLOCATE(CAD_THE) + IF (FreqShiftMethod .eq. 1) THEN + DEALLOCATE(CAS_SIG) + ELSE IF (FreqShiftMethod .eq. 2) THEN + ALLOCATE(CWNB_SIG_M2) + END IF + IF (.NOT. B_JGS_BLOCK_GAUSS_SEIDEL) THEN + DEALLOCATE(U_JAC) + END IF !/ !/ End of JACOBI_FINALIZE -------------------------------------------- / !/ From fdbcb03faa6350be63094d18239ef9a480bf3ef7 Mon Sep 17 00:00:00 2001 From: Mathieu Dutour Sikiric Date: Tue, 20 Sep 2022 12:39:58 +0200 Subject: [PATCH 16/17] Some further cleaning. --- model/src/w3profsmd_pdlib.F90 | 80 ++++++----------------------------- 1 file changed, 12 insertions(+), 68 deletions(-) diff --git a/model/src/w3profsmd_pdlib.F90 b/model/src/w3profsmd_pdlib.F90 index ac55b25194..c4f1b30453 100644 --- a/model/src/w3profsmd_pdlib.F90 +++ b/model/src/w3profsmd_pdlib.F90 @@ -439,7 +439,6 @@ SUBROUTINE PDLIB_MAPSTA_INIT(IMOD) USE W3GDATMD, only : MAPSTA_LOC, NBND_MAP, INDEX_MAP USE W3ODATMD, only : IAPROC, NAPROC USE YOWNODEPOOL, only: iplg, npa - use yowExchangeModule, only : PDLIB_exchange1DREAL USE yowfunction, only: pdlib_abort USE W3ODATMD, only: IAPROC !/ @@ -557,7 +556,6 @@ SUBROUTINE PDLIB_IOBP_INIT(IMOD) USE W3GDATMD, only : IOBP_LOC, IOBPD_LOC, IOBDP_LOC, IOBPA_LOC USE W3ODATMD, only : IAPROC, NAPROC USE YOWNODEPOOL, only: iplg, npa - use yowExchangeModule, only : PDLIB_exchange1DREAL USE yowfunction, only: pdlib_abort USE W3ODATMD, only: IAPROC !/ @@ -727,10 +725,9 @@ SUBROUTINE PDLIB_W3XYPUG ( ISP, FACX, FACY, DTG, VGX, VGY, LCALC ) ! ! 1. Preparations --------------------------------------------------- * ! 1.a Set constants -! - +! #ifdef W3_S - CALL STRACE (IENT, 'W3XYPUG') + CALL STRACE (IENT, 'W3XYPUG') #endif #ifdef W3_DEBUGSOLVER WRITE(740+IAPROC,*) 'Begin of PDLIB_W3XYPUG' @@ -738,7 +735,6 @@ SUBROUTINE PDLIB_W3XYPUG ( ISP, FACX, FACY, DTG, VGX, VGY, LCALC ) #endif ITH = 1 + MOD(ISP-1,NTH) IK = 1 + (ISP-1)/NTH - CCOS = FACX * ECOS(ITH) CSIN = FACY * ESIN(ITH) CCURX = FACX @@ -1261,8 +1257,7 @@ SUBROUTINE PDLIB_W3XYPFSPSI2 ( ISP, C, LCALC, RD10, RD20, DT, AC) USE W3PARALL, only : INIT_GET_JSEA_ISPROC USE W3PARALL, only : ONESIXTH, THR, ZERO USE yowRankModule, only : IPGL_npa - IMPLICIT NONE - + IMPLICIT NONE INTEGER, INTENT(IN) :: ISP ! Actual Frequency/Wavenumber, ! actual Wave Direction REAL, INTENT(IN) :: DT ! Time interval for which the @@ -1947,14 +1942,9 @@ SUBROUTINE ALL_VA_INTEGRAL_PRINT(IMOD, string, choice) ELSE maxidx = np END IF -! CALL ALL_FIELD_INTEGRAL_PRINT_GENERAL(FIELD, string) CALL CHECK_ARRAY_INTEGRAL_NX_R8_MaxFunct(FIELD, string, maxidx, PrintMinISP, LocalizeMaximum) WRITE(740+IAPROC,*) 'After call to ALL_FIELD_INTEGRAL' FLUSH(740+IAPROC) -! IF (NSEAL >= 40) THEN -! WRITE(740+IAPROC,*) 'min/max/sum(VA(:,TESTNODE))=', minval(VA(:,TESTNODE)), maxval(VA(:,TESTNODE)), sum(VA(:,TESTNODE)) -! FLUSH(740+IAPROC) -! END IF END SUBROUTINE ALL_VA_INTEGRAL_PRINT !/ ------------------------------------------------------------------- / SUBROUTINE ALL_FIELD_INTEGRAL_PRINT(FIELD, string) @@ -2373,8 +2363,7 @@ SUBROUTINE PDLIB_W3XYPFSFCT2 ( ISP, C, LCALC, RD10, RD20, DT, AC) USE W3PARALL, only : THR use yowExchangeModule, only : PDLIB_exchange1DREAL USE yowRankModule, only : IPGL_npa - IMPLICIT NONE - + IMPLICIT NONE INTEGER, INTENT(IN) :: ISP ! Actual Frequency/Wavenumber, ! actual Wave Direction REAL, INTENT(IN) :: DT ! Time intervall for which the @@ -2643,20 +2632,16 @@ SUBROUTINE PDLIB_W3XYPUG_BLOCK_IMPLICIT(IMOD, FACX, FACY, DTG, VGX, VGY) IMPLICIT NONE INTEGER, INTENT(IN) :: IMOD REAL, INTENT(IN) :: FACX, FACY, DTG, VGX, VGY - INTEGER DoSomething #ifdef W3_DEBUGSOLVER - WRITE(740+IAPROC,*) 'B_JGS_USE_JACOBI=', B_JGS_USE_JACOBI - FLUSH(740+IAPROC) + WRITE(740+IAPROC,*) 'B_JGS_USE_JACOBI=', B_JGS_USE_JACOBI + FLUSH(740+IAPROC) #endif - DoSomething=0 IF (B_JGS_USE_JACOBI) THEN - CALL PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY) - DoSomething=1 - END IF - IF (DoSomething .eq. 0) THEN - WRITE(*,*) 'Error: You need to use with JGS_USE_JACOBI' - STOP 'Correct your implicit solver options' + CALL PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY) + RETURN END IF + WRITE(*,*) 'Error: You need to use with JGS_USE_JACOBI' + STOP 'Correct your implicit solver options' !/ !/ End of W3XYPFSN --------------------------------------------------- / !/ @@ -4281,8 +4266,6 @@ SUBROUTINE calcARRAY_JACOBI4(IP,DTG,FACX,FACY,VGX,VGY,ASPAR_DIAG_LOCAL,ASPAR_OFF DO ISP = 1, NSPEC ITH = 1 + MOD(ISP-1,NTH) IK = 1 + (ISP-1)/NTH -! CCOS = FACX * ECOS(ITH) -! CSIN = FACY * ESIN(ITH) K(1) = K_X(1,IK) * CCOSA(ITH) + K_Y(1,IK) * CSINA(ITH) + K_U(1) K(2) = K_X(2,IK) * CCOSA(ITH) + K_Y(2,IK) * CSINA(ITH) + K_U(2) K(3) = K_X(3,IK) * CCOSA(ITH) + K_Y(3,IK) * CSINA(ITH) + K_U(3) @@ -4442,8 +4425,7 @@ SUBROUTINE calcARRAY_JACOBI5(IE,DTG,FACX,FACY,VGX,VGY) IEN_LOCAL = PDLIB_IEN(:,IE) NI = INE(:,IE) NI_GLOB = iplg(NI) - NI_ISEA = MAPFS(1,NI_GLOB) - + NI_ISEA = MAPFS(1,NI_GLOB) CRFS_U = ZERO K_U = ZERO @@ -5850,10 +5832,6 @@ SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY) ENDIF B_JAC = ZERO ENDIF -! -#ifdef W3_DEBUGSOLVER - !WRITE(740+IAPROC,'(A20,20E20.10)') 'SUM BJAC INIT', sum(B_JAC), SUM(ASPAR_JAC) -#endif #ifdef W3_MEMCHECK write(50000+IAPROC,*) 'memcheck_____:', 'WW3_PROP SECTION 3' @@ -5917,17 +5895,7 @@ SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY) call calcARRAY_JACOBI_SPECTRAL_2(DTG,ASPAR_DIAG_ALL) ENDIF END IF - -#ifdef W3_DEBUGSOLVER - !WRITE(740+IAPROC,'(A20,20E20.10)') 'SUM BJAC 2', sum(B_JAC), SUM(ASPAR_JAC) -#endif -! CALL APPLY_BOUNDARY_CONDITION(IMOD) - -#ifdef W3_DEBUGSOLVER - !WRITE(740+IAPROC,'(A20,20E20.10)') 'SUM BJAC 3', sum(B_JAC), SUM(ASPAR_JAC) -#endif - #ifdef W3_MEMCHECK write(50000+IAPROC,*) 'memcheck_____:', 'WW3_PROP SECTION 6' call getMallocInfo(mallinfos) @@ -5941,11 +5909,6 @@ SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY) END DO CALL CHECK_ARRAY_INTEGRAL_NX_R8(TheArr, "ASPAR diag after calArr", np) #endif - -#ifdef W3_DEBUGSOLVER - !WRITE(740+IAPROC,'(A20,20E20.10)') 'SUM BJAC 4', sum(B_JAC), SUM(ASPAR_JAC) -#endif - nbIter=0 do ip = 1, np Lconverged(ip) = .false. @@ -6207,32 +6170,13 @@ SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY) ELSE esum = VA(1:NSPEC,IP) ENDIF ! LCONVERGED -! - !write(50000+IAPROC,*) 'SOLVER ITER', ISEA, JSEA, nbiter, & - ! & SUM(B_JAC(:,IP)), sum(ASPAR_DIAG), sum(ACLOC), sum(esum), - !if (isea == testknoten) then - ! write(740+IAPROC,*) p_is_converged, sum(ASPAR_DIAG), SUM(B_JAC(:,IP)), & - ! & sum(ACLOC), sum(esum), iobp_loc(jsea), iobpa_loc(jsea), iobdp_loc(jsea) - !endif - !write(740+IAPROC,*) isea, jsea, ip, sum(ASPAR_DIAG), SUM(B_JAC(:,IP)), sum(ACLOC), & - ! & sum(esum), iobp_loc(ip), iobpd_loc(ith,ip), iobpa_loc(ip), iobdp_loc(ip) IF (B_JGS_TERMINATE_DIFFERENCE) THEN Sum_New = sum(eSum) if (Sum_new .gt. 0.d0) then - !DiffNew = 0.d0 - !Sum_prev = 0.d0 - !DO ISP =1, NSPEC - ! if (eSum(isp) .gt. 0.d0) then - ! DiffNew = DiffNew + abs(eSum(isp) - acloc(isp)) - ! Sum_prev = Sum_prev + eSum(isp) - ! endif - !ENDDO DiffNew = abs(sum(ACLOC-eSum))/Sum_new - !DiffNew = DiffNew / Sum_prev - ! write(*,'(I10,4F20.10)') jsea, Sum_new, Sum_prev, DiffNew #ifdef W3_DEBUGFREQSHIFT - WRITE(740+IAPROC,*) 'DiffNew=', DiffNew, ' Sum_new=', Sum_new + WRITE(740+IAPROC,*) 'DiffNew=', DiffNew, ' Sum_new=', Sum_new #endif p_is_converged = DiffNew else From a5a1430f8b5ce0d2de23df5247d833bb6db8e757 Mon Sep 17 00:00:00 2001 From: Mathieu Dutour Sikiric Date: Tue, 20 Sep 2022 12:49:53 +0200 Subject: [PATCH 17/17] Error after compilation problems. --- model/src/w3profsmd_pdlib.F90 | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/model/src/w3profsmd_pdlib.F90 b/model/src/w3profsmd_pdlib.F90 index c4f1b30453..81757788d8 100644 --- a/model/src/w3profsmd_pdlib.F90 +++ b/model/src/w3profsmd_pdlib.F90 @@ -1836,8 +1836,8 @@ SUBROUTINE ALL_VAOLD_INTEGRAL_PRINT(string, choice) INTEGER, INTENT(in) :: choice REAL :: FIELD(NSPEC,NSEAL) INTEGER ISPEC, JSEA, maxidx - LOGICAL PrintMinISP = .FALSE. - LOGICAL LocalizeMaximum = .FALSE. + LOGICAL :: PrintMinISP = .FALSE. + LOGICAL :: LocalizeMaximum = .FALSE. DO JSEA=1,NSEAL DO ISPEC=1,NSPEC FIELD(ISPEC,JSEA) = VAOLD(ISPEC,JSEA) @@ -1909,8 +1909,8 @@ SUBROUTINE ALL_VA_INTEGRAL_PRINT(IMOD, string, choice) INTEGER, INTENT(in) :: choice REAL :: FIELD(NSPEC,NSEAL) INTEGER ISPEC, JSEA, IP_glob, maxidx - LOGICAL PrintMinISP = .FALSE. - LOGICAL LocalizeMaximum = .FALSE. + LOGICAL :: PrintMinISP = .FALSE. + LOGICAL :: LocalizeMaximum = .FALSE. INTEGER :: TEST_IP = 46 INTEGER :: TEST_ISP = 370 IF (GRIDS(IMOD)%GTYPE .ne. UNGTYPE) THEN @@ -2001,8 +2001,8 @@ SUBROUTINE ALL_FIELD_INTEGRAL_PRINT(FIELD, string) INTEGER maxidx REAL, INTENT(in) :: FIELD(NSPEC,NSEAL) CHARACTER(*), INTENT(in) :: string - LOGICAL PrintMinISP = .FALSE. - LOGICAL LocalizeMaximum = .FALSE. + LOGICAL :: PrintMinISP = .FALSE. + LOGICAL :: LocalizeMaximum = .FALSE. maxidx = NSEAL CALL CHECK_ARRAY_INTEGRAL_NX_R8_MaxFunct(FIELD, string, maxidx, PrintMinISP, LocalizeMaximum) END SUBROUTINE ALL_FIELD_INTEGRAL_PRINT @@ -7727,9 +7727,8 @@ SUBROUTINE JACOBI_FINALIZE ! 10. Source code : ! !/ ------------------------------------------------------------------- / -#ifdef W3_S - USE W3SERVMD, only: STRACE -#endif + USE W3GDATMD, only: B_JGS_BLOCK_GAUSS_SEIDEL + USE W3PARALL, only: IMEM !/ IMPLICIT NONE !/ @@ -7758,7 +7757,7 @@ SUBROUTINE JACOBI_FINALIZE IF (FreqShiftMethod .eq. 1) THEN DEALLOCATE(CAS_SIG) ELSE IF (FreqShiftMethod .eq. 2) THEN - ALLOCATE(CWNB_SIG_M2) + DEALLOCATE(CWNB_SIG_M2) END IF IF (.NOT. B_JGS_BLOCK_GAUSS_SEIDEL) THEN DEALLOCATE(U_JAC)