Skip to content
Snippets Groups Projects
Commit b03407c1 authored by WAUTELET Philippe's avatar WAUTELET Philippe
Browse files

Philippe 29/07/2016: improved MPPDB 

* added option to CHECK_MPPDB3D: MPPDB_CHECK_LB_CORNERS to check or not the corners
* check that the message is the same on all processes to detect some mistakes
* some little cleaning
parent 314a716f
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
src/LIB/SURCOUCHE/src/mode_mppdb.f90
+ 44
− 14
View file @ b03407c1
......@@ -33,6 +33,7 @@ MODULE MODE_MPPDB
REAL :: PRECISION = 1e-8 * 0.0
LOGICAL :: MPPDB_CHECK_LB = .FALSE.
LOGICAL :: MPPDB_CHECK_LB_CORNERS = .FALSE.
CONTAINS
......@@ -57,7 +58,6 @@ CONTAINS
INTEGER :: IUNIT = 100
INTEGER :: IERR
INTEGER :: IRANK_WORLD,IRANK_INTRA
INTEGER :: NBPROC_WORLD,NBPROC_INTRA
LOGICAL :: GISINIT
......@@ -71,7 +71,7 @@ CONTAINS
NAMELIST /NAM_MPPDB/ MPPDB_DEBUG,MPPDB_EXEC,MPPDB_HOST,MPPDB_NBSON,MPPDB_WDIR,MPPDB_CHECK_LB
NAMELIST /NAM_MPPDB/ MPPDB_DEBUG,MPPDB_EXEC,MPPDB_HOST,MPPDB_NBSON,MPPDB_WDIR,MPPDB_CHECK_LB,MPPDB_CHECK_LB_CORNERS
!NMNH_COMM_WORLD = MPI_COMM_WORLD
......@@ -262,7 +262,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, MPI_MAX
USE MODD_MPIF , ONLY : MPI_CHARACTER, MPI_INTEGER, MPI_STATUS_IGNORE, MPI_MAX
USE MODE_DEVICE
......@@ -276,10 +276,11 @@ CONTAINS
! local var
!
INTEGER,PARAMETER :: MAXPAS = 2
INTEGER,PARAMETER :: MAXMSGLEN = 256
REAL,ALLOCATABLE,TARGET, DIMENSION(:,:,:) :: TAB_ll,TAB_SON_ll
REAL,ALLOCATABLE,TARGET, DIMENSION(:,:,:) :: TAB_ll,TAB_SON_ll,TAB_SAVE_ll
INTEGER :: IIMAX_ll,IJMAX_ll
INTEGER :: IIU,IJU,IIU_ll,IJU_ll,IKU_ll
INTEGER :: IIU_ll,IJU_ll,IKU_ll
INTEGER :: IINFO_ll
INTEGER,PARAMETER :: ITAG = 12345
......@@ -297,6 +298,8 @@ CONTAINS
LOGICAL,DIMENSION(MAXPAS) :: OK
CHARACTER(len=40) :: YMSG
REAL :: DIV
CHARACTER(len=MAXMSGLEN) :: MSG
CHARACTER(len=MAXMSGLEN),DIMENSION(:),ALLOCATABLE :: ALLMSG
#ifdef MNH_SP4
!pas de mpi_spawn sur IBM-SP ni MPI_ARGV_NULL etc ...
......@@ -306,6 +309,18 @@ CONTAINS
!
CALL MPPDB_BARRIER()
ALLOCATE(ALLMSG(MPPDB_NBPROC_INTRA))
MSG = MESSAGE
CALL MPI_ALLGATHER(MSG,LEN(MSG),MPI_CHARACTER,ALLMSG,LEN(MSG),MPI_CHARACTER,MPPDB_INTRA_COMM,IINFO_ll)
DO IPAS = 1, MPPDB_NBPROC_INTRA
IF ( ALLMSG(IPAS) /= MSG ) THEN
PRINT *,'Error in MPPDB_CHECK3D: message not similar on all processes'
print *,'**',trim(ALLMSG(IPAS)),'**',trim(msg),'**'
CALL MPI_ABORT(MPPDB_INTRA_COMM,123,IINFO_ll)
END IF
END DO
DEALLOCATE(ALLMSG)
CALL GET_FROM_DEVICE(PTAB,ZTAB,G_PTAB_ON_DEVICE)
NPAS = 1
......@@ -331,7 +346,6 @@ CONTAINS
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
......@@ -347,9 +361,28 @@ CONTAINS
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 )
!
! Set corners values to zero if we want to check the halos without the corners
IF ( MPPDB_CHECK_LB .AND. .NOT.MPPDB_CHECK_LB_CORNERS ) THEN
TAB_ll(1:JPHEXT, 1:JPHEXT, 1:IKU_ll) = 0d0
TAB_ll(1:JPHEXT, 1:JPHEXT, 1:IKU_ll) = 0d0
TAB_ll(1:JPHEXT, IJU_ll-JPHEXT:IJU_ll, 1:IKU_ll) = 0d0
TAB_ll(1:JPHEXT, IJU_ll-JPHEXT:IJU_ll, 1:IKU_ll) = 0d0
TAB_ll(IIU_ll-JPHEXT:IIU_ll, 1:JPHEXT, 1:IKU_ll) = 0d0
TAB_ll(IIU_ll-JPHEXT:IIU_ll, 1:JPHEXT, 1:IKU_ll) = 0d0
TAB_ll(IIU_ll-JPHEXT:IIU_ll, IJU_ll-JPHEXT:IJU_ll, 1:IKU_ll) = 0d0
TAB_ll(IIU_ll-JPHEXT:IIU_ll, IJU_ll-JPHEXT:IJU_ll, 1:IKU_ll) = 0d0
TAB_SON_ll(1:JPHEXT, 1:JPHEXT, 1:IKU_ll) = 0d0
TAB_SON_ll(1:JPHEXT, 1:JPHEXT, 1:IKU_ll) = 0d0
TAB_SON_ll(1:JPHEXT, IJU_ll-JPHEXT:IJU_ll, 1:IKU_ll) = 0d0
TAB_SON_ll(1:JPHEXT, IJU_ll-JPHEXT:IJU_ll, 1:IKU_ll) = 0d0
TAB_SON_ll(IIU_ll-JPHEXT:IIU_ll, 1:JPHEXT, 1:IKU_ll) = 0d0
TAB_SON_ll(IIU_ll-JPHEXT:IIU_ll, 1:JPHEXT, 1:IKU_ll) = 0d0
TAB_SON_ll(IIU_ll-JPHEXT:IIU_ll, IJU_ll-JPHEXT:IJU_ll, 1:IKU_ll) = 0d0
TAB_SON_ll(IIU_ll-JPHEXT:IIU_ll, IJU_ll-JPHEXT:IJU_ll, 1:IKU_ll) = 0d0
END IF
!
IF (MPPDB_CHECK_LB) THEN
IIB_ll = 1 ; IJB_ll = 1
IIE_ll = IIU_ll ; IJE_ll = IJU_ll
......@@ -357,9 +390,9 @@ CONTAINS
IIB_ll = 1 + JPHEXT ; IJB_ll = 1 + JPHEXT
IIE_ll = IIU_ll-JPHEXT ; IJE_ll = IJU_ll-JPHEXT
END IF
MAX_VAL(IPAS) = MAXVAL( ABS (TAB_SON_ll(IIB_ll:IIE_ll,IIB_ll:IJE_ll,1:IKU_ll)) )
MAX_DIFF(IPAS) = MAXVAL( TAB_ll(IIB_ll:IIE_ll,IIB_ll:IJE_ll,1:IKU_ll))
TAB_INTERIOR_ll => TAB_ll(IIB_ll:IIE_ll,IIB_ll:IJE_ll,1:IKU_ll)
MAX_VAL(IPAS) = MAXVAL( ABS (TAB_SON_ll(IIB_ll:IIE_ll,IJB_ll:IJE_ll,1:IKU_ll)) )
MAX_DIFF(IPAS) = MAXVAL( TAB_ll(IIB_ll:IIE_ll,IJB_ll:IJE_ll,1:IKU_ll))
TAB_INTERIOR_ll => TAB_ll(IIB_ll:IIE_ll,IJB_ll:IJE_ll,1:IKU_ll)
!
IF ( MAX_VAL(IPAS) .EQ. 0.0 ) THEN
DIV=1.0
......@@ -670,7 +703,7 @@ CONTAINS
!
! local var
!
REAL,ALLOCATABLE, DIMENSION(:,:,:) :: TAB_ll,TAB_SON_ll,TAB_SAVE_ll
REAL,ALLOCATABLE, DIMENSION(:,:,:) :: TAB_ll,TAB_SON_ll
REAL,DIMENSION(:,:,:),ALLOCATABLE,TARGET :: Z3D
REAL,DIMENSION(:,:,:), POINTER :: TX3DP
INTEGER :: IIMAX_ll,IJMAX_ll
......@@ -749,9 +782,6 @@ CONTAINS
CALL MPI_RECV(TAB_SON_ll,SIZE(TAB_SON_ll),MPI_PRECISION,I_FIRST_SON, &
ITAG, MPPDB_INTRA_COMM,MPI_STATUS_IGNORE, IINFO_ll)
!
ALLOCATE(TAB_SAVE_ll(SIZE(Z3D,1),SIZE(Z3D,2),SIZE(Z3D,3)))
TAB_SAVE_ll = Z3D
Z3D = ABS ( Z3D - TAB_SON_ll )
!
MAX_VAL = MAXVAL( ABS (TAB_SON_ll) )
......
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