Skip to content
Snippets Groups Projects
Commit b2da940c authored by ESCOBAR Juan's avatar ESCOBAR Juan
Browse files

Juan 10/11/2014: correctly manage array on device/host for MPPDB_CHECK3D

parent df89379b
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
SURCOUCHE/mode_mppdb.f90
+ 98
− 90
View file @ b2da940c
......@@ -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
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment

Documentation | Mentions légales | CGU | Accessibilité : non conforme