diff --git a/MNH/get_halo.f90 b/MNH/get_halo.f90
index 427622c6e151a0c0fadb5eddd69363b90d1d17f2..53ef6b4a3b8adefd2a0e2c5f65b50bf3d0942910 100644
--- a/MNH/get_halo.f90
+++ b/MNH/get_halo.f90
@@ -157,7 +157,7 @@ INTEGER :: IS_WEST=1 , IS_EAST=2, IS_SOUTH=3, IS_NORTH=4
!LOGICAL, SAVE :: GFIRST_GET_HALO_D = .TRUE.
!
-IF (GSMONOPROC) RETURN
+!JUANCHECK3D IF (GSMONOPROC) RETURN
!
NULLIFY( TZ_PSRC_ll)
!
diff --git a/MNH/ppm.f90 b/MNH/ppm.f90
index b1900ba100ccf66a403f14168260a2153f04e257..60d661d79e77b7006a6a5dcba6f39b242e63bd4a 100644
--- a/MNH/ppm.f90
+++ b/MNH/ppm.f90
@@ -1802,11 +1802,11 @@ REAL, DIMENSION(SIZE(PCR,2),SIZE(PCR,3)) :: ZPSRC_HALO2_WEST
!!$ STOP
!!$ENDIF
!
-IF ( .NOT. GSMONOPROC ) THEN
+!JUANCHECK3D IF ( .NOT. GSMONOPROC ) THEN
CALL GET_HALO2(PSRC,TZ_PSRC_HALO2_ll)
ZPSRC_HALO2_WEST(:,:) = TZ_PSRC_HALO2_ll%HALO2%WEST(:,:)
!$acc update device (ZPSRC_HALO2_WEST)
-END IF
+!JUANCHECK3D END IF
!
#define JUAN_ACC_S0_X
@@ -2163,11 +2163,11 @@ IF ( L2D ) THEN
RETURN
END IF
!
-IF ( .NOT. GSMONOPROC ) THEN
+!JUANCHECK3D IF ( .NOT. GSMONOPROC ) THEN
CALL GET_HALO2(PSRC,TZ_PSRC_HALO2_ll)
ZPSRC_HALO2_SOUTH(:,:) = TZ_PSRC_HALO2_ll%HALO2%SOUTH(:,:)
!$acc update device (ZPSRC_HALO2_SOUTH)
-END IF
+!JUANCHECK3D END IF
!
! Initialize with relalistic value all work array
!
diff --git a/SURCOUCHE/mode_mppdb.f90 b/SURCOUCHE/mode_mppdb.f90
index 543c6f9f12f3128cb3cc594868facfab31a53ed5..f75294638f2abdd1fbc1db5fc97223b0b1156b77 100644
--- a/SURCOUCHE/mode_mppdb.f90
+++ b/SURCOUCHE/mode_mppdb.f90
@@ -1,3 +1,7 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
MODULE MODE_MPPDB
!
! Modifs :
@@ -16,7 +20,7 @@ MODULE MODE_MPPDB
CHARACTER(LEN=chlg) :: MPPDB_HOST = "localhost"
CHARACTER(LEN=chlg) :: MPPDB_WDIR = "."
INTEGER :: MPPDB_NBSON = 1
- CHARACTER(LEN=chlg) :: MPPDB_COMMAND = " sleep " // " 20 "
+ CHARACTER(LEN=chlg) :: MPPDB_COMMAND = " sleep " // " 30 "
INTEGER :: MPPDB_INTER_COMM,MPPDB_INTRA_COMM
INTEGER :: MPPDB_IRANK_WORLD,MPPDB_IRANK_INTRA
@@ -91,6 +95,7 @@ CONTAINS
!
! NO Father !
MPPDB_FATHER_WORLD = .TRUE.
+ CALL MPI_BARRIER(NMNH_COMM_WORLD,ierr)
!
! if no config file , inactive MPPDB routines
!
@@ -150,10 +155,13 @@ CONTAINS
! clone the son
!
ALLOCATE(info_error(MPPDB_NBSON))
+ CALL MPI_BARRIER(NMNH_COMM_WORLD,ierr)
!
CALL MPI_COMM_SPAWN(MPPDB_EXEC, MPI_ARGV_NULL,MPPDB_NBSON,INFO_SPAWN, &
RANK_FATHER, NMNH_COMM_WORLD,MPPDB_INTER_COMM ,info_error, ierr)
!
+ CALL MPI_BARRIER(NMNH_COMM_WORLD,ierr)
+ !
DEALLOCATE(info_error)
!
! merge the communicator
@@ -166,9 +174,12 @@ CONTAINS
!
!... My rank in MPPDB_INTRA_COMM
CALL MPI_COMM_RANK(MPPDB_INTRA_COMM, mppdb_irank_intra, ierr)
- IF (MPPDB_DEBUG) print*,"MPPDB_INIT :: FATHER mppdb_irank_intra=", mppdb_irank_intra &
+ IF (MPPDB_IRANK_WORLD.EQ.0) THEN
+ ! I'm the first father
+ IF (MPPDB_DEBUG) print*,"MPPDB_INIT :: FIRST FATHER mppdb_irank_intra=", mppdb_irank_intra &
,"mppdb_nbproc_intra=",mppdb_nbproc_intra
call flush(6)
+ endif
!
! Wait the sons
!
@@ -183,9 +194,11 @@ CONTAINS
! !
!-------------------------------------------------------------------------!
!
+ CALL MPI_BARRIER(NMNH_COMM_WORLD,ierr)
+ !
! merge the communicator
!
- drapeau=.FALSE.
+ drapeau=.TRUE.
CALL MPI_INTERCOMM_MERGE(MPPDB_INTER_COMM, drapeau, MPPDB_INTRA_COMM, ierr)
!
!... Numbre of processus in MPPDB_INTRA_COMM.
@@ -203,7 +216,7 @@ CONTAINS
call system(MPPDB_COMMAND)
!
MPPDB_DEBUG = .TRUE.
- IF (MPPDB_DEBUG) write(200,*) "MPPDB_INIT :: FIRSTSON mppdb_irank_intra=", mppdb_irank_intra &
+ IF (MPPDB_DEBUG) write(200,*) "MPPDB_INIT :: FIRST SON mppdb_irank_intra=", mppdb_irank_intra &
,"MPPDB_IRANK_WORLD=",MPPDB_IRANK_WORLD
!
IF (MPPDB_IRANK_WORLD.EQ.0) THEN
@@ -269,7 +282,7 @@ CONTAINS
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
#ifdef MNH_SP4
@@ -289,7 +302,7 @@ CONTAINS
!!$ !$acc end data
!!$ PTAB=ZTAB
- ZTAB = PTAB
+!!$ ZTAB = PTAB
!
IF(MPPDB_FATHER_WORLD) THEN
!
@@ -301,7 +314,7 @@ CONTAINS
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',ZTAB,TAB_ll,IINFO_ll)
+ CALL GATHERALL_FIELD_ll('XY',PTAB,TAB_ll,IINFO_ll)
IF (MPPDB_IRANK_WORLD.EQ.0) THEN
!
@@ -350,7 +363,7 @@ CONTAINS
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',ZTAB,TAB_ll,IINFO_ll)
+ CALL GATHERALL_FIELD_ll('XY',PTAB,TAB_ll,IINFO_ll)
!
! SON WORLD
!
@@ -361,8 +374,6 @@ CONTAINS
I_FIRST_FATHER = 0
CALL MPI_BSEND(TAB_ll,SIZE(TAB_ll),MPI_PRECISION,I_FIRST_FATHER, &
ITAG, MPPDB_INTRA_COMM, IINFO_ll)
- !CALL MPI_BSEND(ZTAB,SIZE(ZTAB),MPI_PRECISION,I_FIRST_FATHER, &
- ! ITAG, MPPDB_INTRA_COMM, IINFO_ll)
END IF
END IF
@@ -490,9 +501,9 @@ CONTAINS
MAX_DIFF = MAXVAL( TAB_ll(IIB_ll:IIE_ll,IIB_ll:IJE_ll) / MAX_VAL )
TAB_INTERIOR_ll => TAB_ll(IIB_ll:IIE_ll,IIB_ll:IJE_ll)
IF (MAX_DIFF > PRECISION ) THEN
- write(6, '(" MPPDB_CHECK2D :: PB MPPDB_CHECK3D =",A40," ERROR=",e15.8," MAXVAL=",e15.8)' ) MESSAGE,MAX_DIFF , MAX_VAL
+ write(6, '(" MPPDB_CHECK2D :: PB MPPDB_CHECK2D =",A40," ERROR=",e15.8," MAXVAL=",e15.8)' ) MESSAGE,MAX_DIFF , MAX_VAL
ELSE
- write(6, '(" MPPDB_CHECK2D :: OK MPPDB_CHECK3D =",A40," ERROR=",e15.8," MAXVAL=",e15.8)' ) MESSAGE,MAX_DIFF , MAX_VAL
+ write(6, '(" MPPDB_CHECK2D :: OK MPPDB_CHECK2D =",A40," ERROR=",e15.8," MAXVAL=",e15.8)' ) MESSAGE,MAX_DIFF , MAX_VAL
END IF
call flush(6)
!