Remove blocking comms from dist_grid in CPU code path (IFS-2748)

src/trans/cpu/internal/dist_grid_ctl_mod.F90

@@ -1,5 +1,5 @@
 ! (C) Copyright 2000- ECMWF.
-! (C) Copyright 2000- Meteo-France.
+! (C) Copyright 2013- Meteo-France.
 ! 
 ! This software is licensed under the terms of the Apache Licence Version 2.0
 ! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
@@ -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
@@ -136,7 +136,6 @@ SUBROUTINE DIST_GRID_CTL(PGPG,KFDISTG,KPROMA,KFROM,PGP,KSORT)
 !$OMP PARALLEL DO SCHEDULE(DYNAMIC,1)&
 !$OMP&PRIVATE(JFLD,JA,JB,ISND,IGLOFF,IGL1,IGL2,IOFF,ILAST,J,&
 !$OMP&ILOFF,JGL,JLON)
-! This OMP directive may need to be disabled for amdflang (cfr. Andreas Mueller)
     DO JFLD=1,IMYFIELDS
       DO JA=1,N_REGIONS_NS
         DO JB=1,N_REGIONS(JA)
@@ -177,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
@@ -202,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)