diff --git a/model/aux/w3adc.f b/model/aux/w3adc.f index f83f6bc40..aa312b656 100644 --- a/model/aux/w3adc.f +++ b/model/aux/w3adc.f @@ -3,9 +3,12 @@ PROGRAM W3ADC C/ +-----------------------------------+ C/ | H. L. Tolman | C/ | FORTRAN 77 | -C/ | Last update : 05-Jan-2001 | +C/ | Last update : 03-Feb-2020 | C/ +-----------------------------------+ C/ +C/ 03-Feb-2020 : Added ability to process multiple ( version 7.00 ) +C/ switches on a single line. Chris Bunney, UKMO +C/ C/ Version to preprocess FORTRAN 90 free format code. C/ C 1. Purpose : @@ -77,7 +80,11 @@ PROGRAM W3ADC C 7. Remarks : C C - Switches are case-sensitive -C - Switch in code has to be followed by space. +C - Switch in code has to be followed by space, forward slash (/) or +C exclamation mark (!) +C - Multiple switches can appear on a single line, seperated by +C a forward slash or exclamation mark. In this case all switches +C need to be present in switch file for the line to be included. C - Switches can be used in include files, since include files are C are pre-processed before the actual file is processed. Includes C in include files, however, are not accepted. @@ -134,7 +141,7 @@ PROGRAM W3ADC CHARACTER*20 TEST0, TSTSTR CHARACTER*500 FNAMEI, FNAMEO, FNAMER CHARACTER*72 INSTR - CHARACTER*143 NEWLNE, OLDLNE + CHARACTER*176 NEWLNE, OLDLNE CHARACTER*200 SWTCHS CHARACTER*33 NOLINE CHARACTER SWITCH*8, SW0*8 @@ -253,30 +260,52 @@ PROGRAM W3ADC FLKEEP = .TRUE. FLSWTC = .FALSE. * - IF ( NEWLNE(1:2).EQ.'!/' ) THEN + ! Rewrite for multiple switches on single line + ! Chris Bunney, Feb 2020. + DO 140 + IF(NEWLNE(1:2) .EQ. '!/') THEN + ! Potential switch + FLSWTC = .FALSE. FLKEEP = .FALSE. +* + ! Check if just a comment IF ( NEWLNE(3:3) .EQ. ' ' ) THEN - FLSWTC = .TRUE. - GOTO 141 - ENDIF - DO 140, I=1, NSWTCH - SW0 = SWITCH(I) - J = LS(I) - IF ( NEWLNE( 3 :2+J) .EQ. SW0(1:J) ) THEN - IF ( NEWLNE(3+J:3+J) .EQ. ' ' ) THEN - NEWLNE(1:MMLOUT) = NEWLNE(3+J:MMLOUT+3+J-1) - FLSWTC = .TRUE. - GOTO 141 - ENDIF - IF ( NEWLNE(3+J:3+J) .EQ. '/' ) THEN - NEWLNE(1:MMLOUT) = NEWLNE(4+J:MMLOUT+4+J-1) - FLSWTC = .TRUE. - GOTO 141 - ENDIF + FLSWTC = .TRUE. + GOTO 142 ! Assumes no more switches + ENDIF +* + ! Check if is an activated switch: + DO 141, I=1, NSWTCH + SW0 = SWITCH(I) + J = LS(I) + IF(NEWLNE(3:2+J) .EQ. SW0(1:J)) THEN +* + IF(NEWLNE(3+J:3+J) .EQ. ' ' .OR. + & NEWLNE(3+J:3+J) .EQ. '!') THEN + NEWLNE(1:MMLOUT) = NEWLNE(3+J:MMLOUT+3+J-1) + FLSWTC = .TRUE. + GOTO 140 ENDIF - 140 CONTINUE - 141 CONTINUE +* + IF(NEWLNE(3+J:3+J) .EQ. '/' ) THEN + NEWLNE(1:MMLOUT) = NEWLNE(4+J:MMLOUT+4+J-1) + FLSWTC = .TRUE. + GOTO 140 + ENDIF +* + ENDIF + 141 CONTINUE ! ENDDO +* + ! No match found for switch - don't include line + FLSWTC = .FALSE. + GOTO 142 + ELSE + ! No more switches, break out of do loop + GOTO 142 ENDIF +* + 140 CONTINUE ! ENDDO + 142 CONTINUE ! ESCAPE * * keep line ... * @@ -368,30 +397,52 @@ PROGRAM W3ADC FLKEEP = .TRUE. FLSWTC = .FALSE. * - IF ( NEWLNE(1:2).EQ.'!/' ) THEN + ! Rewrite for multiple switches on single line + ! Chris Bunney, Feb 2020. + DO 310 + IF(NEWLNE(1:2) .EQ. '!/') THEN + ! Potential switch + FLSWTC = .FALSE. FLKEEP = .FALSE. +* + ! Check if just a comment IF ( NEWLNE(3:3) .EQ. ' ' ) THEN - FLSWTC = .TRUE. - GOTO 311 - ENDIF - DO 310, I=1, NSWTCH - SW0 = SWITCH(I) - J = LS(I) - IF ( NEWLNE( 3 :2+J) .EQ. SW0(1:J) ) THEN - IF ( NEWLNE(3+J:3+J) .EQ. ' ' ) THEN - NEWLNE(1:MMLOUT) = NEWLNE(3+J:MMLOUT+3+J-1) - FLSWTC = .TRUE. - GOTO 311 - ENDIF - IF ( NEWLNE(3+J:3+J) .EQ. '/' ) THEN - NEWLNE(1:MMLOUT) = NEWLNE(4+J:MMLOUT+4+J-1) - FLSWTC = .TRUE. - GOTO 311 - ENDIF + FLSWTC = .TRUE. + GOTO 312 ! Assumes no more switches + ENDIF +* + ! Check if is an activated switch: + DO 311, I=1, NSWTCH + SW0 = SWITCH(I) + J = LS(I) + IF(NEWLNE(3:2+J) .EQ. SW0(1:J)) THEN +* + IF(NEWLNE(3+J:3+J) .EQ. ' ' .OR. + & NEWLNE(3+J:3+J) .EQ. '!') THEN + NEWLNE(1:MMLOUT) = NEWLNE(3+J:MMLOUT+3+J-1) + FLSWTC = .TRUE. + GOTO 310 + ENDIF +* + IF(NEWLNE(3+J:3+J) .EQ. '/' ) THEN + NEWLNE(1:MMLOUT) = NEWLNE(4+J:MMLOUT+4+J-1) + FLSWTC = .TRUE. + GOTO 310 ENDIF - 310 CONTINUE - 311 CONTINUE +* + ENDIF + 311 CONTINUE ! ENDDO +* + ! No match found for switch - don't include line + FLSWTC = .FALSE. + GOTO 312 + ELSE + ! No more switches, break out of do loop + GOTO 312 ENDIF +* + 310 CONTINUE ! ENDDO + 312 CONTINUE ! ESCAPE * * include ??? * diff --git a/model/ftn/w3iogomd.ftn b/model/ftn/w3iogomd.ftn index 6e04ada22..5fccb8c03 100644 --- a/model/ftn/w3iogomd.ftn +++ b/model/ftn/w3iogomd.ftn @@ -1462,7 +1462,7 @@ ! 2.c Finalize integration over band and update mean arrays ! ! -!/OMPG/!$OMP PARALLEL DO PRIVATE(JSEA,ISEA,FACTOR,FACTOR2,KD,FKD,USSCO,M1) +!/OMPG/!$OMP PARALLEL DO PRIVATE(JSEA,ISEA,FACTOR,FACTOR2,MA,MC,MB,KD,FKD,USSCO,M1,M2) ! DO JSEA=1, NSEAL CALL INIT_GET_ISEA(ISEA, JSEA) @@ -1680,7 +1680,7 @@ ! END DO -!/OMPG/!$OMP PARALLEL DO PRIVATE(JSEA,ISEA) +!/OMPG/!$OMP PARALLEL DO PRIVATE(JSEA,ISEA,IX,IY,STEX,STEY,STED,ITL,IK) ! DO JSEA=1, NSEAL !/DIST ISEA = IAPROC + (JSEA-1)*NAPROC @@ -2239,7 +2239,7 @@ ! ! 6.b Loop over local sea points ! -!/OMPG/!$OMP PARALLEL DO PRIVATE(ISEA,JSEA,IX,IY,I) +!/OMPG/!$OMP PARALLEL DO PRIVATE(ISEA,JSEA,IX,IY,I,J) ! DO JSEA=1, NSEAL CALL INIT_GET_ISEA(ISEA, JSEA) @@ -3679,8 +3679,7 @@ !/ Local parameters !/ INTEGER :: IK, ITH, ISEA, JSEA - INTEGER :: IKST, IKFI, IB, NB - INTEGER :: STKBND_INDEX + INTEGER :: IKST, IKFI, IB !/S INTEGER, SAVE :: IENT = 0 REAL :: FACTOR, FKD,KD REAL :: ABX(NSEAL), ABY(NSEAL), USSCO @@ -3730,7 +3729,7 @@ ! DO ITH=1, NTH ! -!/OMPG/!$OMP PARALLEL DO PRIVATE(JSEA,ISEA,FACTOR) +!/OMPG/!$OMP PARALLEL DO PRIVATE(JSEA,ISEA) ! DO JSEA=1, NSEAL !/DIST ISEA = IAPROC + (JSEA-1)*NAPROC @@ -3746,8 +3745,7 @@ ! 2.c Finalize integration over band and update mean arrays ! ! -!/OMPG/!$OMP PARALLEL DO -!PRIVATE(JSEA,ISEA,FACTOR,FACTOR2,KD,FKD,USSCO,M1) +!/OMPG/!$OMP PARALLEL DO PRIVATE(JSEA,ISEA,FACTOR,KD,FKD,USSCO,MINDIFF,IB) ! DO JSEA=1, NSEAL !/DIST ISEA = IAPROC + (JSEA-1)*NAPROC @@ -3786,11 +3784,11 @@ ENDDO MINDIFF=1.e8 !Put spectral energey into whichever band central wavenumber fits in - NB=NK!allocated to size2*NK! STKBND_IN(NK) USSP(JSEA,Spc2Bnd(IK)) = USSP(JSEA,Spc2Bnd(IK)) + ABX(JSEA)*USSCO USSP(JSEA,NK+Spc2BND(IK)) = USSP(JSEA,NK+Spc2Bnd(IK)) + ABY(JSEA)*USSCO ENDIF END DO +!/OMPG/!$OMP END PARALLEL DO END DO ! RETURN diff --git a/model/ftn/w3pro1md.ftn b/model/ftn/w3pro1md.ftn index 26dd80525..0365be5f2 100644 --- a/model/ftn/w3pro1md.ftn +++ b/model/ftn/w3pro1md.ftn @@ -583,7 +583,7 @@ NYMAX=NY-1 IF ( ICLOSE.EQ.ICLOSE_TRPL ) NYMAX=NY ! -!/OMPH/!$OMP PARALLEL DO PRIVATE (IX, IY, IXY) +!/OMPH/!$OMP PARALLEL DO PRIVATE (IX, IY, IXY, VCB) ! DO IX=1, NX DO IY=1, NYMAX @@ -627,7 +627,7 @@ IF ( ICLOSE.EQ.ICLOSE_TRPL ) THEN IY=NY ! -!/OMPH/!$OMP PARALLEL DO PRIVATE (IXY, VCB, IX, IY) +!/OMPH/!$OMP PARALLEL DO PRIVATE (IXY, VCB, IX) ! DO IX=1, NX IXY = IY +(IX-1)*NY diff --git a/model/ftn/w3pro3md.ftn b/model/ftn/w3pro3md.ftn index cc46dc526..1295e94c1 100644 --- a/model/ftn/w3pro3md.ftn +++ b/model/ftn/w3pro3md.ftn @@ -960,7 +960,7 @@ IF ( FLCUR ) THEN !/T WRITE (NDST,9022) ! -!/OMPH/!$OMP PARALLEL DO PRIVATE (IXY) +!/OMPH/!$OMP PARALLEL DO PRIVATE (ISEA,IXY) ! DO ISEA=1, NSEA IXY = MAPSF(ISEA,3) @@ -974,7 +974,7 @@ ! END IF ! -!/OMPH/!$OMP PARALLEL DO PRIVATE (IX, IY, IXY, CP, CQ) +!/OMPH/!$OMP PARALLEL DO PRIVATE (ISEA,IX, IY, IXY, CP, CQ) ! DO ISEA=1, NSEA IX = MAPSF(ISEA,1) diff --git a/model/ftn/w3uno2md.ftn b/model/ftn/w3uno2md.ftn index 4462e8583..ce2f1944f 100644 --- a/model/ftn/w3uno2md.ftn +++ b/model/ftn/w3uno2md.ftn @@ -815,7 +815,9 @@ !/T1 WRITE (NDST,9010) !/T1 WRITE (NDST,9011) NB0, 'CENTRAL' ! -!/OMPH/!$OMP PARALLEL DO PRIVATE (IP, IXY, CFL, IXYC, IXYD, QB) +!/OMPH/!$OMP PARALLEL DO PRIVATE (IP, IXY, CFL, & +!/OMPH/!/T1!$OMP QBO, IX, IY, IY2, IX2, QN & +!/OMPH/!$OMP IXYC, IXYD, QB) ! DO IP=1, NB0 ! @@ -910,7 +912,7 @@ !/C90/!DIR$ IVDEP !/NEC/!CDIR NODEP ! -!/OMPH/!$OMP PARALLEL DO PRIVATE (IP, IXY, JN, JP ) +!/OMPH/!$OMP PARALLEL DO PRIVATE (IP, IXY, JN, JP, QOLD ) ! DO IP=1, NACT ! diff --git a/model/ftn/w3uqckmd.ftn b/model/ftn/w3uqckmd.ftn index a1a9c7770..2512e3ba9 100644 --- a/model/ftn/w3uqckmd.ftn +++ b/model/ftn/w3uqckmd.ftn @@ -1,3 +1,4 @@ + #include "w3macros.h" !/ ------------------------------------------------------------------- / MODULE W3UQCKMD @@ -877,6 +878,7 @@ !/T1 WRITE (NDST,9011) NB0, 'CENTRAL' ! !/OMPH/!$OMP PARALLEL DO PRIVATE (IP, IXY, CFL, IXYC, QB, IXYU, IXYD, & +!/OMPH/!/T1!$OMP QBO, QN, IX, IY, IX2, IY2, & !/OMPH/!$OMP& DQ, DQNZ, QCN, QBN, QBR, CFAC ) ! DO IP=1, NB0 diff --git a/model/ftn/w3wavemd.ftn b/model/ftn/w3wavemd.ftn index 92783b73d..f85ed5aa3 100644 --- a/model/ftn/w3wavemd.ftn +++ b/model/ftn/w3wavemd.ftn @@ -1490,7 +1490,7 @@ NKCFL=NK !/T NKCFL=1 ! -!/OMPG/!$OMP PARALLEL DO PRIVATE (JSEA,ISEA,IX,IY) SCHEDULE (DYNAMIC,1) +!/OMPG/!$OMP PARALLEL DO PRIVATE (JSEA,ISEA) SCHEDULE (DYNAMIC,1) ! DO JSEA=1, NSEAL CALL INIT_GET_ISEA(ISEA, JSEA) @@ -1585,7 +1585,7 @@ IF ( FLCTH .OR. FLCK ) THEN DO ITLOC=1, ITLOCH ! -!/OMPG/!$OMP PARALLEL PRIVATE (JSEA,ISEA,IX,IY,DEPTH) +!/OMPG/!$OMP PARALLEL PRIVATE (JSEA,ISEA,IX,IY,DEPTH,IXrel) !/OMPG/!$OMP DO SCHEDULE (DYNAMIC,1) ! !/DEBUGRUN WRITE(740+IAPROC,*) ' ITLOC=', ITLOC @@ -1725,14 +1725,14 @@ !/MPI CALL MPI_STARTALL (NRQSG1, IRQSG1(1,2), IERR_MPI) !/MPI END IF ! -!/OMPX/!$OMP PARALLEL PRIVATE (ISPEC,FIELD) +!!/OMPX/!$OMP PARALLEL PRIVATE (ISPEC,FIELD) ! !/DEBUGRUN WRITE(740+IAPROC,*) 'W3WAVE, step 6.14' !/DEBUGRUN FLUSH(740+IAPROC) IF ( FLOMP ) ALLOCATE ( FIELD(1-NY:NY*(NX+2)) ) ! -!/OMPX/!$OMP DO SCHEDULE (DYNAMIC,1) +!!/OMPX/!$OMP DO SCHEDULE (DYNAMIC,1) ! DO ISPEC=1, NSPEC IF ( IAPPRO(ISPEC) .EQ. IAPROC ) THEN @@ -1781,11 +1781,11 @@ !/MEMCHECK call printMallInfo(IAPROC,mallInfos) -!/OMPX/!$OMP END DO +!!/OMPX/!$OMP END DO IF ( FLOMP ) DEALLOCATE ( FIELD ) -!/OMPX/!$OMP END PARALLEL +!!/OMPX/!$OMP END PARALLEL !Li Initialise IK IX IY in case ARC option is not used to avoid warnings. IK=1 @@ -1873,7 +1873,7 @@ IF ( FLCTH .OR. FLCK ) THEN DO ITLOC=ITLOCH+1, NTLOC ! -!/OMPG/!$OMP PARALLEL PRIVATE (JSEA,ISEA,IX,IY,DEPTH) +!/OMPG/!$OMP PARALLEL PRIVATE (JSEA,ISEA,IX,IY,DEPTH,IXrel) !/OMPG/!$OMP DO SCHEDULE (DYNAMIC,1) ! !/DEBUGRUN WRITE(740+IAPROC,*) ' ITLOC=', ITLOC @@ -1964,7 +1964,7 @@ !/PDLIB!/DEBUGSRC END IF ! !/OMPG/!$OMP PARALLEL PRIVATE (JSEA,ISEA,IX,IY,DELA,DELX,DELY, & -!/OMPG/!$OMP& REFLEC,REFLED,D50,PSIC,TMP1,TMP2,TMP3) +!/OMPG/!$OMP& REFLEC,REFLED,D50,PSIC,TMP1,TMP2,TMP3,TMP4) !/OMPG/!$OMP DO SCHEDULE (DYNAMIC,1) ! DO JSEA=1, NSEAL diff --git a/regtests/bin/matrix_ncep b/regtests/bin/matrix_ncep index 60e0bfbd6..3c4f23b7e 100755 --- a/regtests/bin/matrix_ncep +++ b/regtests/bin/matrix_ncep @@ -121,7 +121,7 @@ fi export shrd='y' # Do shared architecture tests export dist='y' # Do distributed architecture (MPI) tests export omp='y' # Threaded (OpenMP) tests - export hybd='n' # Hybrid options + export hybd='y' # Hybrid options export prop1D='y' # 1-D propagation tests (ww3_tp1.X) export prop2D='y' # 2-D propagation tests (ww3_tp2.X)