Remove blocking comms from dist_grid (IFS-2748)

ecmwf-ifs · Aug 6, 2023 · 36e81b5 · 36e81b5
1 parent c0ad11d
commit 36e81b5
Showing 1 changed file with 27 additions and 26 deletions.
diff --git a/src/trans/internal/dist_grid_ctl_mod.F90 b/src/trans/internal/dist_grid_ctl_mod.F90
@@ -78,7 +78,7 @@ SUBROUTINE DIST_GRID_CTL(PGPG,KFDISTG,KPROMA,KFROM,PGP,KSORT)
 INTEGER(KIND=JPIM) :: JFLD,JB,JA,IGLOFF,IGL1,IGL2,IOFF,ILAST,ILOFF,ILENR
 INTEGER(KIND=JPIM) :: JGL,JLON,ISND,ITAG,J,IRCV
 INTEGER(KIND=JPIM) :: JKGLO,IEND,JROF,IBL,JROC
-INTEGER(KIND=JPIM) :: ISENDREQ(NPROC,KFDISTG),ILEN(NPROC,KFDISTG)
+INTEGER(KIND=JPIM) :: ISENDREQ(NPROC,KFDISTG),ILEN(NPROC,KFDISTG), IRECVREQ(KFDISTG)
 INTEGER(KIND=JPIM) :: IFROM,IMYFIELDS,IFLD
 INTEGER(KIND=JPIM), POINTER :: ISORT (:)
 LOGICAL :: LLSAME
@@ -176,6 +176,25 @@ SUBROUTINE DIST_GRID_CTL(PGPG,KFDISTG,KPROMA,KFROM,PGP,KSORT)
   ! Message passing
   CALL GSTATS_BARRIER(791)
   CALL GSTATS(811,0)
+  ! Receive
+
+  ALLOCATE(ZRCV(D%NGPTOTMX,KFDISTG))
+
+  IF( LLSAME )THEN
+    IRCV = KFROM(1)
+    ITAG = MTAGDISTGP
+    CALL MPL_RECV(ZRCV,KSOURCE=NPRCIDS(IRCV),KTAG=ITAG,&
+     &KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=IRECVREQ(1),CDSTRING='DIST_GRID_CTL:')
+  ELSE
+    DO JFLD=1,KFDISTG
+      IRCV = KFROM(JFLD)
+      ITAG = MTAGDISTGP+JFLD
+      CALL MPL_RECV(ZRCV(:,JFLD),KSOURCE=NPRCIDS(IRCV),KTAG=ITAG,&
+       &KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=IRECVREQ(JFLD),CDSTRING='DIST_GRID_CTL:')
+    ENDDO
+  ENDIF
+
+
   ! Send
   IF( LLSAME )THEN
     IF(KFROM(1) == MYPROC) THEN
@@ -201,45 +220,27 @@ SUBROUTINE DIST_GRID_CTL(PGPG,KFDISTG,KPROMA,KFROM,PGP,KSORT)
     ENDDO
   ENDIF
 
-    ! Receive
 
-  ALLOCATE(ZRCV(D%NGPTOTMX,KFDISTG))
-
-  IF( LLSAME )THEN
-    IRCV = KFROM(1)
-    ITAG = MTAGDISTGP
-    CALL MPL_RECV(ZRCV,KSOURCE=NPRCIDS(IRCV),KTAG=ITAG,&
-     &KMP_TYPE=JP_BLOCKING_STANDARD,KOUNT=ILENR,CDSTRING='DIST_GRID_CTL:')
-    IF( ILENR /= D%NGPTOTMX*KFDISTG )THEN
-      CALL ABORT_TRANS(' DIST_GRID_CTL: INVALID RECEIVE MESSAGE LENGTH 1')
-    ENDIF
-  ELSE
-    DO JFLD=1,KFDISTG
-      IRCV = KFROM(JFLD)
-      ITAG = MTAGDISTGP+JFLD
-      CALL MPL_RECV(ZRCV(:,JFLD),KSOURCE=NPRCIDS(IRCV),KTAG=ITAG,&
-       &KMP_TYPE=JP_BLOCKING_STANDARD,KOUNT=ILENR,CDSTRING='DIST_GRID_CTL:')
-      IF( ILENR /= D%NGPTOT )THEN
-        CALL ABORT_TRANS(' DIST_GRID_CTL: INVALID RECEIVE MESSAGE LENGTH 2')
-      ENDIF
-    ENDDO
-  ENDIF
-
-! Wait for send to complete
+! Wait for sends and receives to complete
 
   IF( LLSAME )THEN
     IF(KFROM(1) == MYPROC) THEN
       CALL MPL_WAIT(KREQUEST=ISENDREQ(:,1), &
        & CDSTRING='DIST_GRID_CTL: WAIT 1')
     ENDIF
+    CALL MPL_WAIT(KREQUEST=IRECVREQ(1), &
+       & CDSTRING='DIST_GRID_CTL: WAIT 2')
   ELSE
     DO JFLD=1,KFDISTG
       IF(KFROM(JFLD) == MYPROC) THEN
         CALL MPL_WAIT(KREQUEST=ISENDREQ(:,JFLD), &
-         & CDSTRING='DIST_GRID_CTL: WAIT 2')
+         & CDSTRING='DIST_GRID_CTL: WAIT 3')
       ENDIF
+      CALL MPL_WAIT(KREQUEST=IRECVREQ(JFLD), &
+         & CDSTRING='DIST_GRID_CTL: WAIT 4')
     ENDDO
   ENDIF
+
   CALL GSTATS(811,1)
   CALL GSTATS_BARRIER2(791)