diff --git a/SURCOUCHE/mode_mppdb.f90 b/SURCOUCHE/mode_mppdb.f90
index f75294638f2abdd1fbc1db5fc97223b0b1156b77..8a31afd52664753c319c5ebfb82f119a7452d021 100644
--- a/SURCOUCHE/mode_mppdb.f90
+++ b/SURCOUCHE/mode_mppdb.f90
@@ -257,7 +257,9 @@ CONTAINS
USE MODD_PARAMETERS, ONLY : JPHEXT
USE MODI_GATHER_ll
USE MODD_VAR_ll , ONLY : MPI_PRECISION
+ USE MODD_MPIF , ONLY : MPI_INTEGER, MPI_STATUS_IGNORE, MPI_MAX
+ USE MODE_DEVICE
IMPLICIT NONE
@@ -275,15 +277,16 @@ CONTAINS
INTEGER,PARAMETER :: ITAG = 12345
- INTEGER :: I_FIRST_SON, IRECVSTATUS
+ INTEGER :: I_FIRST_SON
INTEGER :: I_FIRST_FATHER
- REAL :: MAX_DIFF , MAX_VAL
+ REAL :: MAX_DIFF , MAX_VAL , MAX_DIFF_ll
INTEGER :: IIB_ll,IIE_ll,IJB_ll,IJE_ll
REAL,POINTER, DIMENSION(:,:,:) :: TAB_INTERIOR_ll ! for easy debug
-!!$ REAL, DIMENSION(size(ptab,1),size(ptab,2),size(ptab,3)) :: ZTAB
-
+ REAL, DIMENSION(size(ptab,1),size(ptab,2),size(ptab,3)) :: ZTAB
+ LOGICAL :: G_PTAB_ON_DEVICE
+ INTEGER :: IPAS,NPAS,NPAS_ll
#ifdef MNH_SP4
!pas de mpi_spawn sur IBM-SP ni MPI_ARGV_NULL etc ...
@@ -292,95 +295,100 @@ CONTAINS
IF ( ( .NOT. MPPDB_INITIALIZED ) .OR. (SIZE(PTAB) == 0 ) ) RETURN
!
CALL MPPDB_BARRIER()
-!!$ !$acc data create(ZTAB)
-!!$ !$acc data pcopyin(PTAB)
-!!$ !$acc kernels pcopyin(PTAB)
-!!$ ZTAB=PTAB
-!!$ !$acc end kernels
-!!$ !$acc end data
-!!$ !$acc update host(ZTAB)
-!!$ !$acc end data
-!!$ PTAB=ZTAB
-
-!!$ ZTAB = PTAB
- !
- IF(MPPDB_FATHER_WORLD) THEN
- !
- ! Reconstruct the all PTAB in TAB_ll
- !
- CALL GET_GLOBALDIMS_ll (IIMAX_ll,IJMAX_ll)
- IIU_ll = IIMAX_ll+2*JPHEXT
- IJU_ll = IJMAX_ll+2*JPHEXT
- IKU_ll = SIZE(PTAB,3)
- ALLOCATE(TAB_ll(IIU_ll,IJU_ll,IKU_ll))
- ALLOCATE(TAB_SAVE_ll(IIU_ll,IJU_ll,IKU_ll))
- CALL GATHERALL_FIELD_ll('XY',PTAB,TAB_ll,IINFO_ll)
- IF (MPPDB_IRANK_WORLD.EQ.0) THEN
- !
- ! I'm the first FATHER => recieve the correct globale ARRAY from first son
- !
- ALLOCATE(TAB_SON_ll(IIU_ll,IJU_ll,IKU_ll))
- !
- ! the first son , is the next processus after this 'world' so
- !
- I_FIRST_SON = MPPDB_NBPROC_WORLD
- !
- CALL MPI_RECV(TAB_SON_ll,SIZE(TAB_SON_ll),MPI_PRECISION,I_FIRST_SON, &
- ITAG, MPPDB_INTRA_COMM, IRECVSTATUS, IINFO_ll)
- !
- TAB_SAVE_ll = TAB_ll
- TAB_ll = ABS ( TAB_ll - TAB_SON_ll )
- !
- IF (MPPDB_CHECK_LB) THEN
- IIB_ll = 1 ; IJB_ll = 1
- IIE_ll = IIU_ll ; IJE_ll = IJU_ll
- ELSE
- IIB_ll = 1 + JPHEXT ; IJB_ll = 1 + JPHEXT
- IIE_ll = IIU_ll-JPHEXT ; IJE_ll = IJU_ll-JPHEXT
- END IF
- MAX_VAL = MAXVAL( ABS (TAB_SON_ll) )
- IF ( MAX_VAL .EQ. 0.0 ) MAX_VAL = 1.0
- MAX_DIFF = MAXVAL( TAB_ll(IIB_ll:IIE_ll,IIB_ll:IJE_ll,1:IKU_ll) / MAX_VAL)
- TAB_INTERIOR_ll => TAB_ll(IIB_ll:IIE_ll,IIB_ll:IJE_ll,1:IKU_ll)
- !
- IF (MAX_DIFF > PRECISION ) THEN
- write(6, '(" MPPDB_CHECK3D :: PB MPPDB_CHECK3D =",A40," ERROR=",e15.8," MAXVAL=",e15.8)' ) MESSAGE,MAX_DIFF , MAX_VAL
- ELSE
- write(6, '(" MPPDB_CHECK3D :: OK MPPDB_CHECK3D =",A40," ERROR=",e15.8," MAXVAL=",e15.8)' ) MESSAGE,MAX_DIFF , MAX_VAL
+ CALL GET_FROM_DEVICE(PTAB,ZTAB,G_PTAB_ON_DEVICE)
+
+ NPAS = 1
+ IF (G_PTAB_ON_DEVICE) NPAS=2
+ CALL MPI_ALLREDUCE(NPAS,NPAS_ll,1,MPI_INTEGER,MPI_MAX,MPPDB_INTRA_COMM,IINFO_ll)
+
+ MAX_DIFF = 0.0
+
+ DO IPAS=1,NPAS_ll
+ IF ((IPAS.EQ.2) .AND. G_PTAB_ON_DEVICE ) ZTAB = PTAB ! the 2 time test the value on host
+ !
+ IF(MPPDB_FATHER_WORLD) THEN
+ !
+ ! Reconstruct the all PTAB in TAB_ll
+ !
+ CALL GET_GLOBALDIMS_ll (IIMAX_ll,IJMAX_ll)
+ IIU_ll = IIMAX_ll+2*JPHEXT
+ IJU_ll = IJMAX_ll+2*JPHEXT
+ IKU_ll = SIZE(PTAB,3)
+ IF (.NOT. ALLOCATED(TAB_ll)) ALLOCATE(TAB_ll(IIU_ll,IJU_ll,IKU_ll))
+ IF (.NOT. ALLOCATED(TAB_SAVE_ll)) ALLOCATE(TAB_SAVE_ll(IIU_ll,IJU_ll,IKU_ll))
+ CALL GATHERALL_FIELD_ll('XY',ZTAB,TAB_ll,IINFO_ll)
+
+ IF (MPPDB_IRANK_WORLD.EQ.0) THEN
+ !
+ ! I'm the first FATHER => recieve the correct globale ARRAY from first son
+ !
+ IF (.NOT. ALLOCATED(TAB_SON_ll)) ALLOCATE(TAB_SON_ll(IIU_ll,IJU_ll,IKU_ll))
+ !
+ ! the first son , is the next processus after this 'world' so
+ !
+ I_FIRST_SON = MPPDB_NBPROC_WORLD
+ !
+ CALL MPI_RECV(TAB_SON_ll,SIZE(TAB_SON_ll),MPI_PRECISION,I_FIRST_SON, &
+ ITAG,MPPDB_INTRA_COMM,MPI_STATUS_IGNORE,IINFO_ll)
+ !
+ TAB_SAVE_ll = TAB_ll
+ TAB_ll = ABS ( TAB_ll - TAB_SON_ll )
+ !
+ IF (MPPDB_CHECK_LB) THEN
+ IIB_ll = 1 ; IJB_ll = 1
+ IIE_ll = IIU_ll ; IJE_ll = IJU_ll
+ ELSE
+ IIB_ll = 1 + JPHEXT ; IJB_ll = 1 + JPHEXT
+ IIE_ll = IIU_ll-JPHEXT ; IJE_ll = IJU_ll-JPHEXT
+ END IF
+ MAX_VAL = MAXVAL( ABS (TAB_SON_ll) )
+ IF ( MAX_VAL .EQ. 0.0 ) MAX_VAL = 1.0
+ MAX_DIFF = MAXVAL( TAB_ll(IIB_ll:IIE_ll,IIB_ll:IJE_ll,1:IKU_ll) / MAX_VAL)
+ TAB_INTERIOR_ll => TAB_ll(IIB_ll:IIE_ll,IIB_ll:IJE_ll,1:IKU_ll)
+ !
+ IF (MAX_DIFF > PRECISION ) THEN
+ write(6, '(" MPPDB_CHECK3D :: PB MPPDB_CHECK3D =",A40," ERROR=",e15.8," MAXVAL=",e15.8," PTAB_ON_DEVICE=",l1," IPAS=",I1)' ) MESSAGE,MAX_DIFF,MAX_VAL,G_PTAB_ON_DEVICE,IPAS
+ ELSE
+ write(6, '(" MPPDB_CHECK3D :: OK MPPDB_CHECK3D =",A40," ERROR=",e15.8," MAXVAL=",e15.8," PTAB_ON_DEVICE=",l1," IPAS=",I1)' ) MESSAGE,MAX_DIFF,MAX_VAL,G_PTAB_ON_DEVICE,IPAS
+ END IF
+ call flush(6)
+ !
+ DEALLOCATE(TAB_ll,TAB_SON_ll)
+ !
END IF
- call flush(6)
+ ELSE
!
- DEALLOCATE(TAB_ll,TAB_SON_ll)
+ ! Reconstruct the all PTAB in TAB_ll
!
- END IF
- ELSE
- !
- ! Reconstruct the all PTAB in TAB_ll
- !
- CALL GET_GLOBALDIMS_ll (IIMAX_ll,IJMAX_ll)
- IIU_ll = IIMAX_ll+2*JPHEXT
- IJU_ll = IJMAX_ll+2*JPHEXT
- IKU_ll = SIZE(PTAB,3)
- ALLOCATE(TAB_ll(IIU_ll,IJU_ll,IKU_ll))
- CALL GATHERALL_FIELD_ll('XY',PTAB,TAB_ll,IINFO_ll)
- !
- ! SON WORLD
- !
- IF (MPPDB_IRANK_WORLD.EQ.0) THEN
+ CALL GET_GLOBALDIMS_ll (IIMAX_ll,IJMAX_ll)
+ IIU_ll = IIMAX_ll+2*JPHEXT
+ IJU_ll = IJMAX_ll+2*JPHEXT
+ IKU_ll = SIZE(PTAB,3)
+ IF (.NOT. ALLOCATED(TAB_ll)) ALLOCATE(TAB_ll(IIU_ll,IJU_ll,IKU_ll))
+ CALL GATHERALL_FIELD_ll('XY',ZTAB,TAB_ll,IINFO_ll)
!
- ! first son --> send the good array to the first father
+ ! SON WORLD
!
- I_FIRST_FATHER = 0
- CALL MPI_BSEND(TAB_ll,SIZE(TAB_ll),MPI_PRECISION,I_FIRST_FATHER, &
- ITAG, MPPDB_INTRA_COMM, IINFO_ll)
+ IF (MPPDB_IRANK_WORLD.EQ.0) THEN
+ !
+ ! first son --> send the good array to the first father
+ !
+ I_FIRST_FATHER = 0
+ CALL MPI_BSEND(TAB_ll,SIZE(TAB_ll),MPI_PRECISION,I_FIRST_FATHER, &
+ ITAG, MPPDB_INTRA_COMM, IINFO_ll)
+ END IF
END IF
- END IF
+
+ CALL MPPDB_BARRIER()
- CALL MPPDB_BARRIER()
+ CALL MPI_ALLREDUCE(MAX_DIFF,MAX_DIFF_ll,1,MPI_PRECISION,MPI_MAX,MPPDB_INTRA_COMM,IINFO_ll)
+ !IF ( MAX_DIFF_ll .EQ. 0.0 ) EXIT
+
+ END DO
#endif
END SUBROUTINE MPPDB_CHECK3D
-
+
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -431,7 +439,7 @@ CONTAINS
USE MODD_PARAMETERS, ONLY : JPHEXT
USE MODI_GATHER_ll
USE MODD_VAR_ll , ONLY : MPI_PRECISION
-
+ USE MODD_MPIF , ONLY : MPI_INTEGER, MPI_STATUS_IGNORE
IMPLICIT NONE
@@ -449,7 +457,7 @@ CONTAINS
INTEGER,PARAMETER :: ITAG = 12345
- INTEGER :: I_FIRST_SON, IRECVSTATUS
+ INTEGER :: I_FIRST_SON
INTEGER :: I_FIRST_FATHER
REAL :: MAX_DIFF , MAX_VAL
INTEGER :: IIB_ll,IIE_ll,IJB_ll,IJE_ll
@@ -485,7 +493,7 @@ CONTAINS
I_FIRST_SON = MPPDB_NBPROC_WORLD
!
CALL MPI_RECV(TAB_SON_ll,SIZE(TAB_SON_ll),MPI_PRECISION,I_FIRST_SON, &
- ITAG, MPPDB_INTRA_COMM, IRECVSTATUS, IINFO_ll)
+ ITAG, MPPDB_INTRA_COMM,MPI_STATUS_IGNORE,IINFO_ll)
!
TAB_ll = ABS(TAB_ll - TAB_SON_ll)
!
@@ -574,13 +582,12 @@ CONTAINS
INTEGER,PARAMETER :: ITAG = 12345
- INTEGER :: I_FIRST_SON, IRECVSTATUS
+ INTEGER :: I_FIRST_SON
INTEGER :: I_FIRST_FATHER
REAL :: MAX_DIFF , MAX_VAL
INTEGER :: IIB_ll,IIE_ll,IJB_ll,IJE_ll
INTEGER :: JI
INTEGER :: IIB,IIE,IJB,IJE
- INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
#ifdef MNH_SP4
!pas de mpi_spawn sur IBM-SP ni MPI_ARGV_NULL etc ...
@@ -612,7 +619,7 @@ CONTAINS
IF (IIB /= 0) THEN
TX3DP=>Z3D(IIB:IIE,IJB:IJE,:)
IF (ISP /= JI) THEN
- CALL MPI_RECV(TX3DP,SIZE(TX3DP),MPI_PRECISION,JI-1,99,NMNH_COMM_WORLD,STATUS,IINFO_ll)
+ CALL MPI_RECV(TX3DP,SIZE(TX3DP),MPI_PRECISION,JI-1,99,NMNH_COMM_WORLD,MPI_STATUS_IGNORE,IINFO_ll)
ELSE
CALL GET_DISTRIB_LB(HLBTYPE,JI,'LOC','WRITE',KRIM,IIB,IIE,IJB,IJE)
TX3DP = PLB(IIB:IIE,IJB:IJE,:)
@@ -643,7 +650,7 @@ CONTAINS
I_FIRST_SON = MPPDB_NBPROC_WORLD
!
CALL MPI_RECV(TAB_SON_ll,SIZE(TAB_SON_ll),MPI_PRECISION,I_FIRST_SON, &
- ITAG, MPPDB_INTRA_COMM, IRECVSTATUS, IINFO_ll)
+ ITAG, MPPDB_INTRA_COMM,MPI_STATUS_IGNORE, IINFO_ll)
!
ALLOCATE(TAB_SAVE_ll(SIZE(Z3D,1),SIZE(Z3D,2),SIZE(Z3D,3)))
@@ -685,3 +692,4 @@ CONTAINS
END MODULE MODE_MPPDB
+