From 047f481553dc124587ae8d99c2870b0c9fad4f2f Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Tue, 21 Mar 2023 11:57:07 -0400 Subject: [PATCH] Clarify allowed grid type logic when running with domain decomposition. By-pass mpi send/recv set-up in w3initmd when using domain decomposition. (#949) --- model/src/pdlib_field_vec.F90 | 4 +- model/src/w3initmd.F90 | 109 +++++++++++++++++----------------- model/src/w3iorsmd.F90 | 4 +- model/src/w3parall.F90 | 2 +- model/src/w3wavemd.F90 | 6 +- 5 files changed, 61 insertions(+), 64 deletions(-) diff --git a/model/src/pdlib_field_vec.F90 b/model/src/pdlib_field_vec.F90 index da864cad4..b386b8786 100644 --- a/model/src/pdlib_field_vec.F90 +++ b/model/src/pdlib_field_vec.F90 @@ -808,7 +808,7 @@ SUBROUTINE DO_OUTPUT_EXCHANGES(IMOD) ! ! 4. Subroutines used : ! - USE W3ADATMD, ONLY: W3XDMA, W3SETA, W3XETA + USE W3ADATMD, ONLY: W3XDMA, W3SETA, W3XETA, WADATS USE W3SERVMD, ONLY: EXTCDE USE W3GDATMD, ONLY: NSEA USE W3GDATMD, ONLY: NX, NSPEC, MAPFS, E3DF, P2MSF, US3DF @@ -1336,7 +1336,7 @@ SUBROUTINE DO_OUTPUT_EXCHANGES(IMOD) END DO END IF IF ( IAPROC .EQ. NAPFLD ) THEN - ! CALL W3XDMA ( IMOD, NDSE, NDST, FLGRDALL ) + IF (.not. WADATS(IMOD)%AINIT2) CALL W3XDMA ( IMOD, NDSE, NDST, FLGRDALL ) CALL W3XETA ( IMOD, NDSE, NDST ) IH = 0 IF ( FLGRDALL( 2, 1) ) THEN diff --git a/model/src/w3initmd.F90 b/model/src/w3initmd.F90 index f2a794323..223034033 100644 --- a/model/src/w3initmd.F90 +++ b/model/src/w3initmd.F90 @@ -738,7 +738,7 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, #ifdef W3_PDLIB CALL PDLIB_INIT(IMOD) #endif - call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 2c') + call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 2c') #ifdef W3_TIMINGS CALL PRINT_MY_TIME("After PDLIB_INIT") @@ -747,7 +747,7 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, #ifdef W3_PDLIB CALL SYNCHRONIZE_IPGL_ETC_ARRAY(IMOD, IsMulti) #endif - call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 2cc') + call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 2cc') #ifdef W3_PDLIB END IF @@ -785,7 +785,7 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 2f') #ifdef W3_DIST IF ( NSEA .LT. NAPROC ) GOTO 820 - IF ((LPDLIB .eqv. .FALSE.).or.(GTYPE .NE. UNGTYPE)) THEN + IF (LPDLIB .eqv. .FALSE.) THEN IF ( NSPEC .LT. NAPROC ) GOTO 821 END IF #endif @@ -850,7 +850,7 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, ALLOCATE ( NT(NSPEC) ) NT = NTTOT #ifdef W3_DIST - IF ((LPDLIB .eqv. .FALSE.).or.(GTYPE .NE. UNGTYPE)) THEN + IF (LPDLIB .eqv. .FALSE.) THEN ! DO ! @@ -932,7 +932,7 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, ! 2.c.9 Test if any spectral points are left out ! #ifdef W3_DIST - IF ((LPDLIB .eqv. .FALSE.).or.(GTYPE .NE. UNGTYPE)) THEN + IF (LPDLIB .eqv. .FALSE.) THEN DO ISP=1, NSPEC IF ( IAPPRO(ISP) .EQ. -1. ) GOTO 829 END DO @@ -1820,7 +1820,7 @@ SUBROUTINE W3MPII ( IMOD ) ! ( persistent communication calls ) ! #ifdef W3_DIST - IF ((LPDLIB .eqv. .FALSE.).or.(GTYPE .NE. UNGTYPE)) THEN + IF (LPDLIB .eqv. .FALSE.) THEN #endif #ifdef W3_MPI NSPLOC = 0 @@ -2189,8 +2189,7 @@ SUBROUTINE W3MPIO ( IMOD ) IROOT = NAPFLD - 1 ! ! - IF ((FLOUT(1) .OR. FLOUT(7)).and.(.not. LPDLIB .or. & - (GTYPE .ne. UNGTYPE).or. .TRUE.)) THEN + IF ((FLOUT(1) .OR. FLOUT(7)) .and. (.not. LPDLIB)) THEN ! ! NRQMAX is the maximum number of output fields that require MPI communication, ! aimed to gather field values stored in each processor into one processor in @@ -3446,7 +3445,7 @@ SUBROUTINE W3MPIO ( IMOD ) #endif ! #ifdef W3_MPI - END IF + END IF !IF ( IAPROC .LE. NAPROC ) THEN ! IF ( NRQGO .GT. NRQMAX ) THEN WRITE (NDSE,1010) NRQGO, NRQMAX @@ -4684,14 +4683,14 @@ SUBROUTINE W3MPIO ( IMOD ) #ifdef W3_MPI CALL W3SETA ( IMOD, NDSE, NDST ) ! - END IF + END IF ! IF ( IAPROC .EQ. NAPFLD ) THEN ! IF ( NRQGO2 .GT. NRQMAX*NAPROC ) THEN WRITE (NDSE,1011) NRQGO2, NRQMAX*NAPROC CALL EXTCDE (11) END IF ! - END IF + END IF ! IF ((FLOUT(1) .OR. FLOUT(7)) .and. (.not. LPDLIB)) THEN ! ! 2. Set-up for W3IORS ---------------------------------------------- / ! 2.a General preparations @@ -4700,7 +4699,7 @@ SUBROUTINE W3MPIO ( IMOD ) IH = 0 IROOT = NAPRST - 1 ! - IF ( FLOUT(4) .OR. FLOUT(8) ) THEN + IF ((FLOUT(4) .OR. FLOUT(8)) .and. (.not. LPDLIB)) THEN IF (OARST) THEN ALLOCATE ( OUTPTS(IMOD)%OUT4%IRQRS(34*NAPROC) ) ELSE @@ -5485,8 +5484,8 @@ SUBROUTINE W3MPIO ( IMOD ) END DO ! CALL W3SETA ( IMOD, NDSE, NDST ) - END IF - END IF + END IF ! IF ( IAPROC .EQ. NAPRST ) THEN + END IF ! IF (OARST) THEN ! NRQRS = IH IF (OARST) THEN @@ -5518,56 +5517,54 @@ SUBROUTINE W3MPIO ( IMOD ) #ifdef W3_MPI IH = 0 ! - IF ((.NOT. LPDLIB).OR.(GTYPE .NE. UNGTYPE)) THEN - IF ( IAPROC .NE. NAPRST ) THEN - ! - ALLOCATE ( OUTPTS(IMOD)%OUT4%IRQRSS(NBLKRS) ) - IRQRSS => OUTPTS(IMOD)%OUT4%IRQRSS - ! - DO IB=1, NBLKRS - IH = IH + 1 - IT = IT0 + 3 + IB - JSEA0 = 1 + (IB-1)*RSBLKS - JSEAN = MIN ( NSEALM , IB*RSBLKS ) - NSEAB = 1 + JSEAN - JSEA0 - CALL MPI_SEND_INIT (VA(1,JSEA0), NSPEC*NSEAB, MPI_REAL, IROOT, IT, & - MPI_COMM_WAVE, IRQRSS(IH), IERR ) + IF ( IAPROC .NE. NAPRST ) THEN + ! + ALLOCATE ( OUTPTS(IMOD)%OUT4%IRQRSS(NBLKRS) ) + IRQRSS => OUTPTS(IMOD)%OUT4%IRQRSS + ! + DO IB=1, NBLKRS + IH = IH + 1 + IT = IT0 + 3 + IB + JSEA0 = 1 + (IB-1)*RSBLKS + JSEAN = MIN ( NSEALM , IB*RSBLKS ) + NSEAB = 1 + JSEAN - JSEA0 + CALL MPI_SEND_INIT (VA(1,JSEA0), NSPEC*NSEAB, MPI_REAL, IROOT, IT, & + MPI_COMM_WAVE, IRQRSS(IH), IERR ) #endif #ifdef W3_MPIT - WRITE (NDST,9026) IH, 'S', IB, IROOT, IT, IRQRSS(IH), IERR, NSEAB + WRITE (NDST,9026) IH, 'S', IB, IROOT, IT, IRQRSS(IH), IERR, NSEAB #endif #ifdef W3_MPI - END DO - ! - ELSE - ! - ALLOCATE ( OUTPTS(IMOD)%OUT4%IRQRSS(NAPROC*NBLKRS) , & - OUTPTS(IMOD)%OUT4%VAAUX(NSPEC,2*RSBLKS,NAPROC) ) - ! - IRQRSS => OUTPTS(IMOD)%OUT4%IRQRSS - VAAUX => OUTPTS(IMOD)%OUT4%VAAUX - DO IB=1, NBLKRS - IT = IT0 + 3 + IB - JSEA0 = 1 + (IB-1)*RSBLKS - JSEAN = MIN ( NSEALM , IB*RSBLKS ) - NSEAB = 1 + JSEAN - JSEA0 - DO I0=1, NAPROC - IF ( I0 .NE. NAPRST ) THEN - IH = IH + 1 - IFROM = I0 - 1 - IBOFF = MOD(IB-1,2)*RSBLKS - CALL MPI_RECV_INIT (VAAUX(1,1+IBOFF,I0), NSPEC*NSEAB, MPI_REAL, & - IFROM, IT, MPI_COMM_WAVE, IRQRSS(IH), IERR ) + END DO + ! + ELSE + ! + ALLOCATE ( OUTPTS(IMOD)%OUT4%IRQRSS(NAPROC*NBLKRS) , & + OUTPTS(IMOD)%OUT4%VAAUX(NSPEC,2*RSBLKS,NAPROC) ) + ! + IRQRSS => OUTPTS(IMOD)%OUT4%IRQRSS + VAAUX => OUTPTS(IMOD)%OUT4%VAAUX + DO IB=1, NBLKRS + IT = IT0 + 3 + IB + JSEA0 = 1 + (IB-1)*RSBLKS + JSEAN = MIN ( NSEALM , IB*RSBLKS ) + NSEAB = 1 + JSEAN - JSEA0 + DO I0=1, NAPROC + IF ( I0 .NE. NAPRST ) THEN + IH = IH + 1 + IFROM = I0 - 1 + IBOFF = MOD(IB-1,2)*RSBLKS + CALL MPI_RECV_INIT (VAAUX(1,1+IBOFF,I0), NSPEC*NSEAB, MPI_REAL, & + IFROM, IT, MPI_COMM_WAVE, IRQRSS(IH), IERR ) #endif #ifdef W3_MPIT - WRITE (NDST,9026) IH, 'R', IB, IFROM, IT, IRQRSS(IH), IERR, NSEAB + WRITE (NDST,9026) IH, 'R', IB, IFROM, IT, IRQRSS(IH), IERR, NSEAB #endif #ifdef W3_MPI - END IF - END DO + END IF END DO - ! - END IF + END DO + ! END IF #endif ! @@ -5580,7 +5577,7 @@ SUBROUTINE W3MPIO ( IMOD ) ! END IF ! - END IF + END IF ! IF ((FLOUT(4) .OR. FLOUT(8)) .and. (.not. LPDLIB)) THEN #endif ! ! 3. Set-up for W3IOBC ( SENDs ) ------------------------------------ / diff --git a/model/src/w3iorsmd.F90 b/model/src/w3iorsmd.F90 index 1feb267f3..b8b657a61 100644 --- a/model/src/w3iorsmd.F90 +++ b/model/src/w3iorsmd.F90 @@ -642,7 +642,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) #ifdef W3_MPI ELSE ! - IF (LPDLIB .and. (GTYPE.eq.UNGTYPE)) THEN + IF (LPDLIB) THEN #endif #ifdef W3_TIMINGS CALL PRINT_MY_TIME("Before UNST_PDLIB_WRITE_TO_FILE") @@ -724,7 +724,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) WRITE (NDST,9020) TYPE #endif ELSE - IF (LPDLIB .and. (GTYPE.eq.UNGTYPE)) THEN + IF (LPDLIB) THEN #ifdef W3_TIMINGS CALL PRINT_MY_TIME("Before UNST_PDLIB_READ_FROM_FILE") #endif diff --git a/model/src/w3parall.F90 b/model/src/w3parall.F90 index 789f807c5..e9f5a95ca 100644 --- a/model/src/w3parall.F90 +++ b/model/src/w3parall.F90 @@ -1116,7 +1116,7 @@ SUBROUTINE INIT_GET_JSEA_ISPROC(ISEA, JSEA, ISPROC) #endif #ifdef W3_PDLIB - IF ((.NOT. LPDLIB ).or.(GTYPE .ne. UNGTYPE)) THEN + IF (.NOT. LPDLIB) THEN #endif JSEA = 1 + (ISEA-1)/NAPROC ISPROC = ISEA - (JSEA-1)*NAPROC diff --git a/model/src/w3wavemd.F90 b/model/src/w3wavemd.F90 index e31790c1a..f13c8e234 100644 --- a/model/src/w3wavemd.F90 +++ b/model/src/w3wavemd.F90 @@ -1840,7 +1840,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & FACX = 1. END IF END IF - IF ((GTYPE .EQ. UNGTYPE) .and. LPDLIB) THEN + IF (LPDLIB) THEN ! #ifdef W3_PDLIB IF ((FSTOTALIMP .eqv. .FALSE.).and.(FLCX .or. FLCY)) THEN @@ -2438,7 +2438,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #ifdef W3_MPI IF ( ( (DSEC21(TIME,TONEXT(:,1)).EQ.0.) .AND. FLOUT(1) ) .OR. & ( (DSEC21(TIME,TONEXT(:,7)).EQ.0.) .AND. FLOUT(7) .AND. SBSED ) ) THEN - IF (.NOT. LPDLIB .or. (GTYPE.ne.UNGTYPE)) THEN + IF (.NOT. LPDLIB) THEN IF (NRQGO.NE.0 ) THEN #endif #ifdef W3_MPI @@ -2477,7 +2477,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & CALL DO_OUTPUT_EXCHANGES(IMOD) #endif #ifdef W3_MPI - END IF + END IF ! IF (.NOT. LPDLIB) THEN END IF #endif call print_memcheck(memunit, 'memcheck_____:'//' WW3_WAVE AFTER TIME LOOP 1')