diff --git a/src/trans/cpu/internal/dist_grid_ctl_mod.F90 b/src/trans/cpu/internal/dist_grid_ctl_mod.F90 index 0d378804..184a7184 100644 --- a/src/trans/cpu/internal/dist_grid_ctl_mod.F90 +++ b/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)