diff --git a/MNH/get_halo.f90 b/MNH/get_halo.f90
index 48dcc0e05208005ec9c34e21720af50208bdf28b..2a2ccc43d7a0f7cfb2d1b530d2a7a57863f2c2db 100644
--- a/MNH/get_halo.f90
+++ b/MNH/get_halo.f90
@@ -18,9 +18,10 @@ TYPE(HALO2LIST_ll), POINTER :: TP_PSRC_HALO2_ll ! halo2 for SRC
!
END SUBROUTINE GET_HALO2
!
-SUBROUTINE GET_HALO(PSRC)
+SUBROUTINE GET_HALO(PSRC,HDIR)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable at t
+CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
!
END SUBROUTINE GET_HALO
!
@@ -70,7 +71,7 @@ END SUBROUTINE GET_HALO2
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
! #########################
- SUBROUTINE GET_HALO(PSRC)
+ SUBROUTINE GET_HALO(PSRC,HDIR)
! #########################
!
USE MODE_ll
@@ -79,6 +80,7 @@ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
IMPLICIT NONE
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable at t
+CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
!
TYPE(LIST_ll) , POINTER :: TZ_PSRC_ll ! halo
INTEGER :: IERROR ! error return code
@@ -86,7 +88,7 @@ INTEGER :: IERROR ! error return code
NULLIFY( TZ_PSRC_ll)
!
CALL ADD3DFIELD_ll(TZ_PSRC_ll,PSRC)
-CALL UPDATE_HALO_ll(TZ_PSRC_ll,IERROR)
+CALL UPDATE_HALO_ll(TZ_PSRC_ll,IERROR, HDIR=HDIR )
CALL CLEANLIST_ll(TZ_PSRC_ll)
!
END SUBROUTINE GET_HALO
diff --git a/MNH/ppm.f90 b/MNH/ppm.f90
index ba517e6a5c745dfe58e65b751525bfbb2528ab37..7761f294fc2c64abba1187303fbb12d7e1ad3ae8 100644
--- a/MNH/ppm.f90
+++ b/MNH/ppm.f90
@@ -197,6 +197,7 @@ USE MODD_CONF
!BEG JUAN PPM_LL
USE MODD_LUNIT
!END JUAN PPM_LL
+USE MODE_MPPDB
!
IMPLICIT NONE
!
@@ -257,7 +258,9 @@ IF(NHALO /= 1) THEN
CALL ABORT
STOP
ENDIF
-CALL GET_HALO(PSRC)
+!
+CALL GET_HALO(PSRC,HDIR="01_X")
+!
PR=PSRC
ZQL=PSRC
ZQR=PSRC
@@ -279,7 +282,7 @@ SELECT CASE ( HLBCX(1) ) ! X direction LBC type: (1) for left side
!
CASE ('CYCL','WALL') ! In that case one must have HLBCX(1) == HLBCX(2)
!
-! calculate dmq
+! calculate dmq ZDMQ(i) = Fct[ PSRC(i-1),PSRC(i+1) ]
ZDMQ = DIF2X(PSRC)
!
! monotonize the difference followinq eq. 5 in Lin94
@@ -312,7 +315,8 @@ CASE ('CYCL','WALL') ! In that case one must have HLBCX(1) == HLBCX(2)
!
! update ZDMQ HALO before next/further utilisation
!
- CALL GET_HALO(ZDMQ)
+ CALL GET_HALO(ZDMQ,HDIR="01_X") ! PB AVEC HDIR="X1"
+ CALL MPPDB_CHECK3DM("PPM::PPM_01_X CYCL ::ZDMQ",PRECISION,ZDMQ)
!
! calculate qL and qR with the modified dmq
!
@@ -321,7 +325,7 @@ CASE ('CYCL','WALL') ! In that case one must have HLBCX(1) == HLBCX(2)
ZQL0(IIB:IIE+1,IJS:IJN,:) = 0.5*(PSRC(IIB:IIE+1,IJS:IJN,:) + PSRC(IIB-1:IIE,IJS:IJN,:)) - &
(ZDMQ(IIB:IIE+1,IJS:IJN,:) - ZDMQ(IIB-1:IIE,IJS:IJN,:))/6.0
!
- CALL GET_HALO(ZQL0)
+ CALL GET_HALO(ZQL0,HDIR="01_X")
!
! WEST BOUND
!
@@ -329,7 +333,7 @@ CASE ('CYCL','WALL') ! In that case one must have HLBCX(1) == HLBCX(2)
!
ZQR0(IIB-1:IIE,IJS:IJN,:) = ZQL0(IIB:IIE+1,IJS:IJN,:)
!
- CALL GET_HALO(ZQR0)
+ CALL GET_HALO(ZQR0,HDIR="01_X")
!
! EAST BOUND
!
@@ -374,7 +378,7 @@ CASE ('CYCL','WALL') ! In that case one must have HLBCX(1) == HLBCX(2)
(ZDQ(IIB-1:IIE,IJS:IJN,:) - (1.0 - 2.0*ZCR(IIB:IIE+1,IJS:IJN,:)/3.0) &
* ZQ6(IIB-1:IIE,IJS:IJN,:))
!
- CALL GET_HALO(ZFPOS)
+ CALL GET_HALO(ZFPOS,HDIR="Z1_X")
!
! WEST BOUND
!
@@ -385,13 +389,14 @@ CASE ('CYCL','WALL') ! In that case one must have HLBCX(1) == HLBCX(2)
ZFNEG(:,IJS:IJN,:) = ZQL(:,IJS:IJN,:) - 0.5*ZCR(:,IJS:IJN,:) * &
( ZDQ(:,IJS:IJN,:) + (1.0 + 2.0*ZCR(:,IJS:IJN,:)/3.0) * ZQ6(:,IJS:IJN,:) )
!
- CALL GET_HALO(ZFNEG)
+ CALL GET_HALO(ZFNEG,HDIR="Z1_X")
!
! advect the actual field in X direction by U*dt
!
PR = DXF( ZCR*MXM(PRHO)*( ZFPOS*(0.5+SIGN(0.5,ZCR)) + &
ZFNEG*(0.5-SIGN(0.5,ZCR)) ) )
- CALL GET_HALO(PR)
+ CALL GET_HALO(PR,HDIR="01_X")
+ CALL MPPDB_CHECK3DM("PPM::PPM_01_X CYCL ::PR",PRECISION,PR)
!
!
!* 1.2 NON-CYCLIC BOUNDARY CONDITIONS IN THE X DIRECTION
@@ -447,7 +452,8 @@ CASE('OPEN')
!
! update ZDMQ HALO before next/further utilisation
!
- CALL GET_HALO(ZDMQ)
+ CALL GET_HALO(ZDMQ,HDIR="01_X")
+ CALL MPPDB_CHECK3DM("PPM::PPM_01_X OPEN ::ZDMQ",PRECISION,ZDMQ)
!
! calculate qL and qR
!
@@ -456,7 +462,7 @@ CASE('OPEN')
ZQL0(IIB:IIE+1,IJS:IJN,:) = 0.5*(PSRC(IIB:IIE+1,IJS:IJN,:) + PSRC(IIB-1:IIE,IJS:IJN,:)) - &
(ZDMQ(IIB:IIE+1,IJS:IJN,:) - ZDMQ(IIB-1:IIE,IJS:IJN,:))/6.0
!
- CALL GET_HALO(ZQL0)
+ CALL GET_HALO(ZQL0,HDIR="01_X")
!
! WEST BOUND
!
@@ -466,7 +472,7 @@ CASE('OPEN')
!
ZQR0(IIB-1:IIE,IJS:IJN,:) = ZQL0(IIB:IIE+1,IJS:IJN,:)
!
- CALL GET_HALO(ZQR0)
+ CALL GET_HALO(ZQR0,HDIR="01_X")
!
! EAST BOUND
!
@@ -517,7 +523,7 @@ CASE('OPEN')
(ZDQ(IIB-1:IIE,IJS:IJN,:) - (1.0 - 2.0*ZCR(IIB:IIE+1,IJS:IJN,:)/3.0) &
* ZQ6(IIB-1:IIE,IJS:IJN,:))
!
- CALL GET_HALO(ZFPOS)
+ CALL GET_HALO(ZFPOS,HDIR="01_X")
!
!
! WEST BOUND
@@ -538,7 +544,7 @@ CASE('OPEN')
ZFNEG(:,IJS:IJN,:) = ZQL(:,IJS:IJN,:) - 0.5*ZCR(:,IJS:IJN,:) * &
( ZDQ(:,IJS:IJN,:) + (1.0 + 2.0*ZCR(:,IJS:IJN,:)/3.0) * ZQ6(:,IJS:IJN,:) )
!
- CALL GET_HALO(ZFNEG)
+ CALL GET_HALO(ZFNEG,HDIR="01_X")
!
! EAST BOUND
!
@@ -552,7 +558,7 @@ CASE('OPEN')
!
PR = DXF( ZCR*MXM(PRHO)*( ZFPOS*(0.5+SIGN(0.5,ZCR)) + &
ZFNEG*(0.5-SIGN(0.5,ZCR)) ) )
- CALL GET_HALO(PR)
+ CALL GET_HALO(PR,HDIR="01_X")
!
!
END SELECT
@@ -644,6 +650,7 @@ USE MODD_CONF
!BEG JUAN PPM_LL
USE MODD_LUNIT
!END JUAN PPM_LL
+USE MODE_MPPDB
!
IMPLICIT NONE
!
@@ -699,8 +706,9 @@ IF(NHALO /= 1) THEN
CALL ABORT
STOP
ENDIF
-CALL GET_HALO(PSRC)
-
+!
+CALL GET_HALO(PSRC,HDIR="01_Y")
+!
!
!-------------------------------------------------------------------------------
!
@@ -756,14 +764,15 @@ CASE ('CYCL','WALL') ! In that case one must have HLBCY(1) == HLBCY(2)
!
! update ZDMQ HALO before next/further utilisation
!
- CALL GET_HALO(ZDMQ)
+ CALL GET_HALO(ZDMQ,HDIR="01_Y")
+ CALL MPPDB_CHECK3DM("PPM::PPM_01_Y CYCL ::ZDMQ",PRECISION,ZDMQ)
!
! calculate qL and qR with the modified dmq
!
ZQL0(IIW:IIA,IJB:IJE+1,:) = 0.5*(PSRC(IIW:IIA,IJB:IJE+1,:) + PSRC(IIW:IIA,IJB-1:IJE,:)) - &
(ZDMQ(IIW:IIA,IJB:IJE+1,:) - ZDMQ(IIW:IIA,IJB-1:IJE,:))/6.0
!
- CALL GET_HALO(ZQL0)
+ CALL GET_HALO(ZQL0,HDIR="01_Y")
!
! SOUTH BOUND
!
@@ -771,7 +780,7 @@ CASE ('CYCL','WALL') ! In that case one must have HLBCY(1) == HLBCY(2)
!
ZQR0(IIW:IIA,IJB-1:IJE,:) = ZQL0(IIW:IIA,IJB:IJE+1,:)
!
- CALL GET_HALO(ZQR0)
+ CALL GET_HALO(ZQR0,HDIR="01_Y")
!
! NORTH BOUND
!
@@ -816,7 +825,7 @@ CASE ('CYCL','WALL') ! In that case one must have HLBCY(1) == HLBCY(2)
(ZDQ(IIW:IIA,IJB-1:IJE,:) - (1.0 - 2.0*ZCR(IIW:IIA,IJB:IJE+1,:)/3.0) &
* ZQ6(IIW:IIA,IJB-1:IJE,:))
!
- CALL GET_HALO(ZFPOS)
+ CALL GET_HALO(ZFPOS,HDIR="01_Y")
!
! SOUTH BOUND
!
@@ -827,13 +836,14 @@ CASE ('CYCL','WALL') ! In that case one must have HLBCY(1) == HLBCY(2)
ZFNEG(IIW:IIA,:,:) = ZQL(IIW:IIA,:,:) - 0.5*ZCR(IIW:IIA,:,:) * &
( ZDQ(IIW:IIA,:,:) + (1.0 + 2.0*ZCR(IIW:IIA,:,:)/3.0) * ZQ6(IIW:IIA,:,:) )
!
- CALL GET_HALO(ZFNEG)
+ CALL GET_HALO(ZFNEG,HDIR="01_Y")
!
! advect the actual field in Y direction by V*dt
!
PR = DYF( ZCR*MYM(PRHO)*( ZFPOS*(0.5+SIGN(0.5,ZCR)) + &
ZFNEG*(0.5-SIGN(0.5,ZCR)) ) )
- CALL GET_HALO(PR)
+ CALL GET_HALO(PR,HDIR="01_Y")
+ CALL MPPDB_CHECK3DM("PPM::PPM_01_Y CYCL ::PR",PRECISION,PR)
!
!* 2.2 NON-CYCLIC BOUNDARY CONDITIONS IN THE Y DIRECTION
! -------------------------------------------------
@@ -876,14 +886,14 @@ CASE('OPEN')
!
! update ZDMQ HALO before next/further utilisation
!
- CALL GET_HALO(ZDMQ)
+ CALL GET_HALO(ZDMQ,HDIR="01_Y")
!
! calculate qL and qR with the modified dmq
!
ZQL0(IIW:IIA,IJB:IJE+1,:) = 0.5*(PSRC(IIW:IIA,IJB:IJE+1,:) + PSRC(IIW:IIA,IJB-1:IJE,:)) - &
(ZDMQ(IIW:IIA,IJB:IJE+1,:) - ZDMQ(IIW:IIA,IJB-1:IJE,:))/6.0
!
- CALL GET_HALO(ZQL0)
+ CALL GET_HALO(ZQL0,HDIR="01_Y")
!
! SOUTH BOUND
!
@@ -938,7 +948,7 @@ CASE('OPEN')
(ZDQ(IIW:IIA,IJB-1:IJE,:) - (1.0 - 2.0*ZCR(IIW:IIA,IJB:IJE+1,:)/3.0) &
* ZQ6(IIW:IIA,IJB-1:IJE,:))
!
- CALL GET_HALO(ZFPOS)
+ CALL GET_HALO(ZFPOS,HDIR="01_Y")
!
!
! advection flux at open boundary when u(IJB) > 0
@@ -960,7 +970,7 @@ CASE('OPEN')
ZFNEG(IIW:IIA,:,:) = ZQL(IIW:IIA,:,:) - 0.5*ZCR(IIW:IIA,:,:) * &
( ZDQ(IIW:IIA,:,:) + (1.0 + 2.0*ZCR(IIW:IIA,:,:)/3.0) * ZQ6(IIW:IIA,:,:) )
!
- CALL GET_HALO(ZFNEG)
+ CALL GET_HALO(ZFNEG,HDIR="01_Y")
!
! advection flux at open boundary when u(IJE+1) < 0
!
@@ -976,7 +986,7 @@ CASE('OPEN')
PR = DYF( ZCR*MYM(PRHO)*( ZFPOS*(0.5+SIGN(0.5,ZCR)) + &
ZFNEG*(0.5-SIGN(0.5,ZCR)) ) )
!
- CALL GET_HALO(PR)
+ CALL GET_HALO(PR,HDIR="01_Y")
!
!
END SELECT
@@ -1066,6 +1076,7 @@ USE MODI_GET_HALO
USE MODD_CONF
USE MODD_PARAMETERS
!USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+USE MODE_MPPDB
!
IMPLICIT NONE
!
@@ -1200,6 +1211,7 @@ ZFNEG(:,:,IKE+1) = (ZQR(:,:,IKE)-PSRC(:,:,IKE+1))*ZCR(:,:,IKE+1) + &
PR = DZF( ZCR*MZM(PRHO)*( ZFPOS*(0.5+SIGN(0.5,ZCR)) + &
ZFNEG*(0.5-SIGN(0.5,ZCR)) ) )
CALL GET_HALO(PR)
+CALL MPPDB_CHECK3DM("PPM::PPM_01_Z ::PR",PRECISION,PR)
!
CONTAINS
!
@@ -1293,6 +1305,7 @@ USE MODD_CONF
USE MODD_LUNIT
USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
!END JUAN PPM_LL
+USE MODE_MPPDB
!
IMPLICIT NONE
!
@@ -1366,9 +1379,11 @@ PR=PSRC
!
!BEG JUAN PPM_LL
!
-! ZPATH(i) = Fct[ PSRC(i),PSRC(i-1),PSRC(i+1),PSRC(i-2)]
+! i=IIB+1:IIE ( inner domain IIB exclude )
+! ZPATH(i) = Fct[ PSRC(i) ,PSRC(i-1),PSRC(i+1),PSRC(i-2) ]
!
-! inner domain
+! doc MNH ZPATH(i+1) = Fct[ PSRC(i+1),PSRC(i) ,PSRC(i+2),PSRC(i-1) ]
+!
!
ZPHAT(IIB+1:IIE,IJS:IJN,:) = ( 7.0 * &
( PSRC(IIB+1:IIE ,IJS:IJN,:) + PSRC(IIB :IIE-1,IJS:IJN,:) ) - &
@@ -1386,6 +1401,8 @@ CASE ('CYCL','WALL') ! In that case one must have HLBCX(1) == HLBCX(2
!!$ ZPHAT(IIB-1,:,:) = ZPHAT(IIE,:,:)
!
! WEST BOUND
+! i=IIB ( need halo2 psrc(iib-2) )
+! ZPATH(IIB) = Fct[ PSRC(IIB),PSRC(IIB-1),PSRC(IIB+1),PSRC(IIB-2) ]
!
ZPHAT(IIB ,IJS:IJN,:) = ( 7.0 * &
( PSRC(IIB ,IJS:IJN,:) + PSRC(IIB-1,IJS:IJN,:) ) - &
@@ -1394,7 +1411,7 @@ CASE ('CYCL','WALL') ! In that case one must have HLBCX(1) == HLBCX(2
!
! The ZPHAT(IIB-1,:,:) doesn't matter only define an realistic value
!
-!!$ ZPHAT(IIB-1,:,:) = ZPHAT(IIB,:,:) ! JUANTEST1
+!!$ ZPHAT(IIB-1,:,:) = ZPHAT(IIB,:,:) ! JUANTEST1 already done at init by ZPHAT = PSRC
!
! EAST BOUND
!
@@ -1402,35 +1419,50 @@ CASE ('CYCL','WALL') ! In that case one must have HLBCX(1) == HLBCX(2
!
!!$ ZPHAT(IIE+1,:,:) = ZPHAT(IIE,:,:) ! JUANTEST1
!
-!
! update ZPHAT HALO before next/further utilisation
!
-CALL GET_HALO(ZPHAT)
+! /!\ not needed if ZPHAT(IIB-1) & ZPHAT(IIE+1) doen't matter ???
!
- ZFPOS(IIB:IIE+1,IJS:IJN,:) = ZPHAT(IIB:IIE+1,IJS:IJN,:) - &
- ZCR(IIB:IIE+1,IJS:IJN,:)*(ZPHAT(IIB:IIE+1,IJS:IJN,:) - PSRC(IIB-1:IIE,IJS:IJN,:)) - &
- ZCR(IIB:IIE+1,IJS:IJN,:)*(1.0 - ZCR(IIB:IIE+1,IJS:IJN,:)) * &
- (ZPHAT(IIB-1:IIE,IJS:IJN,:) - 2.0*PSRC(IIB-1:IIE,IJS:IJN,:) + ZPHAT(IIB:IIE+1,IJS:IJN,:))
+CALL GET_HALO(ZPHAT,HDIR="Z0_X")
+!
+!!$ ZFPOS(IIB:IIE+1,IJS:IJN,:) = ZPHAT(IIB:IIE+1,IJS:IJN,:) - &
+!!$ ZCR(IIB:IIE+1,IJS:IJN,:)*(ZPHAT(IIB:IIE+1,IJS:IJN,:) - PSRC(IIB-1:IIE,IJS:IJN,:)) - &
+!!$ ZCR(IIB:IIE+1,IJS:IJN,:)*(1.0 - ZCR(IIB:IIE+1,IJS:IJN,:)) * &
+!!$ (ZPHAT(IIB-1:IIE,IJS:IJN,:) - 2.0*PSRC(IIB-1:IIE,IJS:IJN,:) + ZPHAT(IIB:IIE+1,IJS:IJN,:))
+!
+ ZFPOS(IIB:IIE,IJS:IJN,:) = ZPHAT(IIB:IIE,IJS:IJN,:) - &
+ ZCR(IIB:IIE,IJS:IJN,:)*(ZPHAT(IIB:IIE,IJS:IJN,:) - PSRC(IIB-1:IIE-1,IJS:IJN,:)) - &
+ ZCR(IIB:IIE,IJS:IJN,:)*(1.0 - ZCR(IIB:IIE,IJS:IJN,:)) * &
+ (ZPHAT(IIB-1:IIE-1,IJS:IJN,:) - 2.0*PSRC(IIB-1:IIE-1,IJS:IJN,:) + ZPHAT(IIB:IIE,IJS:IJN,:))
!
!!$ ZFPOS(IIB-1,:,:) = ZFPOS(IIE,:,:) !JUAN
-CALL GET_HALO(ZFPOS) ! JUAN
!
- ZFNEG(IIB-1:IIE,IJS:IJN,:) = ZPHAT(IIB-1:IIE,IJS:IJN,:) + &
- ZCR(IIB-1:IIE,IJS:IJN,:)*(ZPHAT(IIB-1:IIE,IJS:IJN,:) - PSRC(IIB-1:IIE,IJS:IJN,:)) + &
- ZCR(IIB-1:IIE,IJS:IJN,:)*(1.0 + ZCR(IIB-1:IIE,IJS:IJN,:)) * &
- (ZPHAT(IIB-1:IIE,IJS:IJN,:) - 2.0*PSRC(IIB-1:IIE,IJS:IJN,:) + ZPHAT(IIB:IIE+1,IJS:IJN,:))
+CALL GET_HALO(ZFPOS,HDIR="Z0_X") ! JUAN
+!
+!!$ ZFNEG(IIB-1:IIE,IJS:IJN,:) = ZPHAT(IIB-1:IIE,IJS:IJN,:) + &
+!!$ ZCR(IIB-1:IIE,IJS:IJN,:)*(ZPHAT(IIB-1:IIE,IJS:IJN,:) - PSRC(IIB-1:IIE,IJS:IJN,:)) + &
+!!$ ZCR(IIB-1:IIE,IJS:IJN,:)*(1.0 + ZCR(IIB-1:IIE,IJS:IJN,:)) * &
+!!$ (ZPHAT(IIB-1:IIE,IJS:IJN,:) - 2.0*PSRC(IIB-1:IIE,IJS:IJN,:) + ZPHAT(IIB:IIE+1,IJS:IJN,:))
+!
+ ZFNEG(IIB:IIE,IJS:IJN,:) = ZPHAT(IIB:IIE,IJS:IJN,:) + &
+ ZCR(IIB:IIE,IJS:IJN,:)*(ZPHAT(IIB:IIE,IJS:IJN,:) - PSRC(IIB:IIE,IJS:IJN,:)) + &
+ ZCR(IIB:IIE,IJS:IJN,:)*(1.0 + ZCR(IIB:IIE,IJS:IJN,:)) * &
+ (ZPHAT(IIB:IIE,IJS:IJN,:) - 2.0*PSRC(IIB:IIE,IJS:IJN,:) + ZPHAT(IIB+1:IIE+1,IJS:IJN,:))
+!
!
! define fluxes for CYCL BC outside physical domain
!!$ ZFNEG(IIE+1,:,:) = ZFNEG(IIB,:,:) !JUAN
-CALL GET_HALO(ZFNEG) ! JUAN
-
+!
+CALL GET_HALO(ZFNEG,HDIR="Z0_X") ! JUAN
!
! calculate the advection
!
PR = PSRC * PRHO - &
DXF( ZCR*MXM(PRHO)*( ZFPOS*(0.5+SIGN(0.5,ZCR)) + &
ZFNEG*(0.5-SIGN(0.5,ZCR)) ) )
- CALL GET_HALO(PR) ! JUAN
+!
+ CALL GET_HALO(PR,HDIR="S0_X")
+ CALL MPPDB_CHECK3DM("PPM::PPM_S0_X CYCL ::PR",PRECISION,PR)
!
CASE ('OPEN')
!
@@ -1447,7 +1479,7 @@ CASE ('OPEN')
! <=> WEST BOUND ( PSRC(IIB+1,IJS:IJN,:) + PSRC(IIB-2,IJS:IJN,:) ) ) / 12.0
ENDIF
!
-CALL GET_HALO(ZPHAT)
+CALL GET_HALO(ZPHAT,HDIR="Z0_X")
!
IF (LWEST_ll()) THEN
ZPHAT(IIB ,IJS:IJN,:) = 0.5*(PSRC(IIB-1,IJS:IJN,:) + PSRC(IIB,IJS:IJN,:))
@@ -1468,12 +1500,18 @@ CALL GET_HALO(ZPHAT)
!!$ ZCR(IIB+1:IIE+1,:,:)*(ZPHAT(IIB+1:IIE+1,:,:) - PSRC(IIB:IIE,:,:)) - &
!!$ ZCR(IIB+1:IIE+1,:,:)*(1.0 - ZCR(IIB+1:IIE+1,:,:)) * &
!!$ (ZPHAT(IIB:IIE,:,:) - 2.0*PSRC(IIB:IIE,:,:) + ZPHAT(IIB+1:IIE+1,:,:))
- ZFPOS(IIB:IIE+1,IJS:IJN,:) = ZPHAT(IIB:IIE+1,IJS:IJN,:) - &
- ZCR(IIB:IIE+1,IJS:IJN,:)*(ZPHAT(IIB:IIE+1,IJS:IJN,:) - PSRC(IIB-1:IIE,IJS:IJN,:)) - &
- ZCR(IIB:IIE+1,IJS:IJN,:)*(1.0 - ZCR(IIB:IIE+1,IJS:IJN,:)) * &
- (ZPHAT(IIB-1:IIE,IJS:IJN,:) - 2.0*PSRC(IIB-1:IIE,IJS:IJN,:) + ZPHAT(IIB:IIE+1,IJS:IJN,:))
!
-CALL GET_HALO(ZFPOS) ! JUAN
+!!$ ZFPOS(IIB:IIE+1,IJS:IJN,:) = ZPHAT(IIB:IIE+1,IJS:IJN,:) - &
+!!$ ZCR(IIB:IIE+1,IJS:IJN,:)*(ZPHAT(IIB:IIE+1,IJS:IJN,:) - PSRC(IIB-1:IIE,IJS:IJN,:)) - &
+!!$ ZCR(IIB:IIE+1,IJS:IJN,:)*(1.0 - ZCR(IIB:IIE+1,IJS:IJN,:)) * &
+!!$ (ZPHAT(IIB-1:IIE,IJS:IJN,:) - 2.0*PSRC(IIB-1:IIE,IJS:IJN,:) + ZPHAT(IIB:IIE+1,IJS:IJN,:))
+!!$!
+ ZFPOS(IIB:IIE,IJS:IJN,:) = ZPHAT(IIB:IIE,IJS:IJN,:) - &
+ ZCR(IIB:IIE,IJS:IJN,:)*(ZPHAT(IIB:IIE,IJS:IJN,:) - PSRC(IIB-1:IIE-1,IJS:IJN,:)) - &
+ ZCR(IIB:IIE,IJS:IJN,:)*(1.0 - ZCR(IIB:IIE,IJS:IJN,:)) * &
+ (ZPHAT(IIB-1:IIE-1,IJS:IJN,:) - 2.0*PSRC(IIB-1:IIE-1,IJS:IJN,:) + ZPHAT(IIB:IIE,IJS:IJN,:))
+!
+CALL GET_HALO(ZFPOS,HDIR="Z0_X") ! JUAN
!
! positive flux on the WEST boundary
IF (LWEST_ll()) THEN
@@ -1488,12 +1526,19 @@ CALL GET_HALO(ZFPOS) ! JUAN
!!$ ZCR(IIB:IIE,:,:)*(ZPHAT(IIB:IIE,:,:) - PSRC(IIB:IIE,:,:)) + &
!!$ ZCR(IIB:IIE,:,:)*(1.0 + ZCR(IIB:IIE,:,:)) * &
!!$ (ZPHAT(IIB:IIE,:,:) - 2.0*PSRC(IIB:IIE,:,:) + ZPHAT(IIB+1:IIE+1,:,:))
- ZFNEG(IIB-1:IIE,IJS:IJN,:) = ZPHAT(IIB-1:IIE,IJS:IJN,:) + &
- ZCR(IIB-1:IIE,IJS:IJN,:)*(ZPHAT(IIB-1:IIE,IJS:IJN,:) - PSRC(IIB-1:IIE,IJS:IJN,:)) + &
- ZCR(IIB-1:IIE,IJS:IJN,:)*(1.0 + ZCR(IIB-1:IIE,IJS:IJN,:)) * &
- (ZPHAT(IIB-1:IIE,IJS:IJN,:) - 2.0*PSRC(IIB-1:IIE,IJS:IJN,:) + ZPHAT(IIB:IIE+1,IJS:IJN,:))
!
- CALL GET_HALO(ZFNEG) ! JUAN
+!!$ ZFNEG(IIB-1:IIE,IJS:IJN,:) = ZPHAT(IIB-1:IIE,IJS:IJN,:) + &
+!!$ ZCR(IIB-1:IIE,IJS:IJN,:)*(ZPHAT(IIB-1:IIE,IJS:IJN,:) - PSRC(IIB-1:IIE,IJS:IJN,:)) + &
+!!$ ZCR(IIB-1:IIE,IJS:IJN,:)*(1.0 + ZCR(IIB-1:IIE,IJS:IJN,:)) * &
+!!$ (ZPHAT(IIB-1:IIE,IJS:IJN,:) - 2.0*PSRC(IIB-1:IIE,IJS:IJN,:) + ZPHAT(IIB:IIE+1,IJS:IJN,:))
+!
+ ZFNEG(IIB:IIE,IJS:IJN,:) = ZPHAT(IIB:IIE,IJS:IJN,:) + &
+ ZCR(IIB:IIE,IJS:IJN,:)*(ZPHAT(IIB:IIE,IJS:IJN,:) - PSRC(IIB:IIE,IJS:IJN,:)) + &
+ ZCR(IIB:IIE,IJS:IJN,:)*(1.0 + ZCR(IIB:IIE,IJS:IJN,:)) * &
+ (ZPHAT(IIB:IIE,IJS:IJN,:) - 2.0*PSRC(IIB:IIE,IJS:IJN,:) + ZPHAT(IIB+1:IIE+1,IJS:IJN,:))
+!
+!
+ CALL GET_HALO(ZFNEG,HDIR="Z0_X") ! JUAN
!
IF (LEAST_ll()) THEN
!
@@ -1532,11 +1577,11 @@ CALL GET_HALO(ZFPOS) ! JUAN
END WHERE
ENDIF
!
+CALL GET_HALO(PR,HDIR="S0_X")
+CALL MPPDB_CHECK3DM("PPM::PPM_S0_X OPEN ::PR",PRECISION,PR)
!
END SELECT
!
-CALL GET_HALO(PR)
-!
!-------------------------------------------------------------------------------
CALL DEL_HALO2_ll(TZ_PSRC_HALO2_ll)
!
@@ -1568,6 +1613,7 @@ USE MODI_GET_HALO
USE MODD_LUNIT
USE MODD_CONF
!USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+USE MODE_MPPDB
!
IMPLICIT NONE
!
@@ -1668,34 +1714,45 @@ CASE ('CYCL','WALL') ! In that case one must have HLBCY(1) == HLBCY(2
!
! update ZPHAT HALO before next/further utilisation
!
-CALL GET_HALO(ZPHAT)
+CALL GET_HALO(ZPHAT,HDIR="Z0_Y")
!
! calculate the fluxes:
!
- ZFPOS(IIW:IIA,IJB:IJE+1,:) = ZPHAT(IIW:IIA,IJB:IJE+1,:) - &
- ZCR(IIW:IIA,IJB:IJE+1,:)*(ZPHAT(IIW:IIA,IJB:IJE+1,:) - PSRC(IIW:IIA,IJB-1:IJE,:)) - &
- ZCR(IIW:IIA,IJB:IJE+1,:)*(1.0 - ZCR(IIW:IIA,IJB:IJE+1,:)) * &
- (ZPHAT(IIW:IIA,IJB-1:IJE,:) - 2.0*PSRC(IIW:IIA,IJB-1:IJE,:) + ZPHAT(IIW:IIA,IJB:IJE+1,:))
+!!$ ZFPOS(IIW:IIA,IJB:IJE+1,:) = ZPHAT(IIW:IIA,IJB:IJE+1,:) - &
+!!$ ZCR(IIW:IIA,IJB:IJE+1,:)*(ZPHAT(IIW:IIA,IJB:IJE+1,:) - PSRC(IIW:IIA,IJB-1:IJE,:)) - &
+!!$ ZCR(IIW:IIA,IJB:IJE+1,:)*(1.0 - ZCR(IIW:IIA,IJB:IJE+1,:)) * &
+!!$ (ZPHAT(IIW:IIA,IJB-1:IJE,:) - 2.0*PSRC(IIW:IIA,IJB-1:IJE,:) + ZPHAT(IIW:IIA,IJB:IJE+1,:))
+!
+ ZFPOS(IIW:IIA,IJB:IJE,:) = ZPHAT(IIW:IIA,IJB:IJE,:) - &
+ ZCR(IIW:IIA,IJB:IJE,:)*(ZPHAT(IIW:IIA,IJB:IJE,:) - PSRC(IIW:IIA,IJB-1:IJE-1,:)) - &
+ ZCR(IIW:IIA,IJB:IJE,:)*(1.0 - ZCR(IIW:IIA,IJB:IJE,:)) * &
+ (ZPHAT(IIW:IIA,IJB-1:IJE-1,:) - 2.0*PSRC(IIW:IIA,IJB-1:IJE-1,:) + ZPHAT(IIW:IIA,IJB:IJE,:))
!
!!$ ZFPOS(:,IJB-1,:) = ZFPOS(:,IJE,:)
-CALL GET_HALO(ZFPOS) ! JUAN
+CALL GET_HALO(ZFPOS,HDIR="Z0_Y") ! JUAN
!
- ZFNEG(IIW:IIA,IJB-1:IJE,:) = ZPHAT(IIW:IIA,IJB-1:IJE,:) + &
- ZCR(IIW:IIA,IJB-1:IJE,:)*(ZPHAT(IIW:IIA,IJB-1:IJE,:) - PSRC(IIW:IIA,IJB-1:IJE,:)) + &
- ZCR(IIW:IIA,IJB-1:IJE,:)*(1.0 + ZCR(IIW:IIA,IJB-1:IJE,:)) * &
- (ZPHAT(IIW:IIA,IJB-1:IJE,:) - 2.0*PSRC(IIW:IIA,IJB-1:IJE,:) +ZPHAT(IIW:IIA,IJB:IJE+1,:))
+!!$ ZFNEG(IIW:IIA,IJB-1:IJE,:) = ZPHAT(IIW:IIA,IJB-1:IJE,:) + &
+!!$ ZCR(IIW:IIA,IJB-1:IJE,:)*(ZPHAT(IIW:IIA,IJB-1:IJE,:) - PSRC(IIW:IIA,IJB-1:IJE,:)) + &
+!!$ ZCR(IIW:IIA,IJB-1:IJE,:)*(1.0 + ZCR(IIW:IIA,IJB-1:IJE,:)) * &
+!!$ (ZPHAT(IIW:IIA,IJB-1:IJE,:) - 2.0*PSRC(IIW:IIA,IJB-1:IJE,:) +ZPHAT(IIW:IIA,IJB:IJE+1,:))
+!
+ ZFNEG(IIW:IIA,IJB:IJE,:) = ZPHAT(IIW:IIA,IJB:IJE,:) + &
+ ZCR(IIW:IIA,IJB:IJE,:)*(ZPHAT(IIW:IIA,IJB:IJE,:) - PSRC(IIW:IIA,IJB:IJE,:)) + &
+ ZCR(IIW:IIA,IJB:IJE,:)*(1.0 + ZCR(IIW:IIA,IJB:IJE,:)) * &
+ (ZPHAT(IIW:IIA,IJB:IJE,:) - 2.0*PSRC(IIW:IIA,IJB:IJE,:) +ZPHAT(IIW:IIA,IJB+1:IJE+1,:))
!
-
!
! define fluxes for CYCL BC outside physical domain
!!$ ZFNEG(:,IJE+1,:) = ZFNEG(:,IJB,:)
-CALL GET_HALO(ZFNEG) ! JUAN
+CALL GET_HALO(ZFNEG,HDIR="Z0_Y") ! JUAN
!
! calculate the advection
!
PR = PSRC * PRHO - &
DYF( ZCR*MYM(PRHO)*( ZFPOS*(0.5+SIGN(0.5,ZCR)) + &
ZFNEG*(0.5-SIGN(0.5,ZCR)) ) )
+ CALL GET_HALO(PR,HDIR="S0_Y")
+ CALL MPPDB_CHECK3DM("PPM::PPM_S0_Y CYCL ::PR",PRECISION,PR)
!
CASE ('OPEN')
!
@@ -1713,7 +1770,7 @@ CASE ('OPEN')
! <=> SOUTH BOUND (PSRC(IIW:IIA,IJB+1,:) + PSRC(IIW:IIA,IJB-2,:) )) / 12.0
ENDIF
!
-CALL GET_HALO(ZPHAT)
+CALL GET_HALO(ZPHAT,HDIR="Z0_Y")
!
IF (LSOUTH_ll()) THEN
ZPHAT(IIW:IIA,IJB ,:) = 0.5*(PSRC(IIW:IIA,IJB-1,:) + PSRC(IIW:IIA,IJB,:))
@@ -1729,7 +1786,7 @@ CALL GET_HALO(ZPHAT)
!
! update ZPHAT HALO before next/further utilisation
!
-!!$CALL GET_HALO(ZPHAT)
+!!$CALL GET_HALO(ZPHAT,HDIR="Z0_Y")
!
! calculate the fluxes:
! positive fluxes
@@ -1737,12 +1794,18 @@ CALL GET_HALO(ZPHAT)
!!$ ZCR(:,IJB+1:IJE+1,:)*(ZPHAT(:,IJB+1:IJE+1,:) - PSRC(:,IJB:IJE,:)) - &
!!$ ZCR(:,IJB+1:IJE+1,:)*(1.0 - ZCR(:,IJB+1:IJE+1,:)) * &
!!$ (ZPHAT(:,IJB:IJE,:) - 2.0*PSRC(:,IJB:IJE,:) + ZPHAT(:,IJB+1:IJE+1,:))
-ZFPOS(IIW:IIA,IJB:IJE+1,:) = ZPHAT(IIW:IIA,IJB:IJE+1,:) - &
- ZCR(IIW:IIA,IJB:IJE+1,:)*( ZPHAT(IIW:IIA,IJB:IJE+1,:) - PSRC(IIW:IIA,IJB-1:IJE ,:) ) - &
- ZCR(IIW:IIA,IJB:IJE+1,:)*( 1.0 - ZCR(IIW:IIA,IJB :IJE+1,:) ) * &
- (ZPHAT(IIW:IIA,IJB-1:IJE,:) - 2.0*PSRC(IIW:IIA,IJB-1:IJE,:) + ZPHAT(IIW:IIA,IJB:IJE+1,:))
!
-CALL GET_HALO(ZFPOS) ! JUAN
+!!$ZFPOS(IIW:IIA,IJB:IJE+1,:) = ZPHAT(IIW:IIA,IJB:IJE+1,:) - &
+!!$ ZCR(IIW:IIA,IJB:IJE+1,:)*( ZPHAT(IIW:IIA,IJB:IJE+1,:) - PSRC(IIW:IIA,IJB-1:IJE ,:) ) - &
+!!$ ZCR(IIW:IIA,IJB:IJE+1,:)*( 1.0 - ZCR(IIW:IIA,IJB :IJE+1,:) ) * &
+!!$ (ZPHAT(IIW:IIA,IJB-1:IJE,:) - 2.0*PSRC(IIW:IIA,IJB-1:IJE,:) + ZPHAT(IIW:IIA,IJB:IJE+1,:))
+!
+ ZFPOS(IIW:IIA,IJB:IJE,:) = ZPHAT(IIW:IIA,IJB:IJE,:) - &
+ ZCR(IIW:IIA,IJB:IJE,:)*(ZPHAT(IIW:IIA,IJB:IJE,:) - PSRC(IIW:IIA,IJB-1:IJE-1,:)) - &
+ ZCR(IIW:IIA,IJB:IJE,:)*(1.0 - ZCR(IIW:IIA,IJB:IJE,:)) * &
+ (ZPHAT(IIW:IIA,IJB-1:IJE-1,:) - 2.0*PSRC(IIW:IIA,IJB-1:IJE-1,:) + ZPHAT(IIW:IIA,IJB:IJE,:))
+!
+CALL GET_HALO(ZFPOS,HDIR="Z0_Y") ! JUAN
!
! positive flux on the SOUTH boundary
IF (LSOUTH_ll()) THEN
@@ -1758,12 +1821,18 @@ CALL GET_HALO(ZFPOS) ! JUAN
!!$ ZCR(:,IJB:IJE,:)*(ZPHAT(:,IJB:IJE,:) - PSRC(:,IJB:IJE,:)) + &
!!$ ZCR(:,IJB:IJE,:)*(1.0 + ZCR(:,IJB:IJE,:)) * &
!!$ (ZPHAT(:,IJB:IJE,:) - 2.0*PSRC(:,IJB:IJE,:) +ZPHAT(:,IJB+1:IJE+1,:))
- ZFNEG(IIW:IIA,IJB-1:IJE,:) = ZPHAT(IIW:IIA,IJB-1:IJE,:) + &
- ZCR(IIW:IIA,IJB-1:IJE,:)*(ZPHAT(IIW:IIA,IJB-1:IJE,:) - PSRC(IIW:IIA,IJB-1:IJE,:)) + &
- ZCR(IIW:IIA,IJB-1:IJE,:)*(1.0 + ZCR(IIW:IIA,IJB-1:IJE,:)) * &
- (ZPHAT(IIW:IIA,IJB-1:IJE,:) - 2.0*PSRC(IIW:IIA,IJB-1:IJE,:) +ZPHAT(IIW:IIA,IJB:IJE+1,:))
!
- CALL GET_HALO(ZFNEG) ! JUAN
+!!$ ZFNEG(IIW:IIA,IJB-1:IJE,:) = ZPHAT(IIW:IIA,IJB-1:IJE,:) + &
+!!$ ZCR(IIW:IIA,IJB-1:IJE,:)*(ZPHAT(IIW:IIA,IJB-1:IJE,:) - PSRC(IIW:IIA,IJB-1:IJE,:)) + &
+!!$ ZCR(IIW:IIA,IJB-1:IJE,:)*(1.0 + ZCR(IIW:IIA,IJB-1:IJE,:)) * &
+!!$ (ZPHAT(IIW:IIA,IJB-1:IJE,:) - 2.0*PSRC(IIW:IIA,IJB-1:IJE,:) +ZPHAT(IIW:IIA,IJB:IJE+1,:))
+!
+ ZFNEG(IIW:IIA,IJB:IJE,:) = ZPHAT(IIW:IIA,IJB:IJE,:) + &
+ ZCR(IIW:IIA,IJB:IJE,:)*(ZPHAT(IIW:IIA,IJB:IJE,:) - PSRC(IIW:IIA,IJB:IJE,:)) + &
+ ZCR(IIW:IIA,IJB:IJE,:)*(1.0 + ZCR(IIW:IIA,IJB:IJE,:)) * &
+ (ZPHAT(IIW:IIA,IJB:IJE,:) - 2.0*PSRC(IIW:IIA,IJB:IJE,:) +ZPHAT(IIW:IIA,IJB+1:IJE+1,:))
+!
+ CALL GET_HALO(ZFNEG,HDIR="Z0_Y") ! JUAN
!
IF (LNORTH_ll()) THEN
! this is not used
@@ -1798,11 +1867,13 @@ CALL GET_HALO(ZFPOS) ! JUAN
END WHERE
ENDIF
!
+ CALL GET_HALO(PR,HDIR="S0_Y")
+ CALL MPPDB_CHECK3DM("PPM::PPM_S0_Y OPEN ::PR",PRECISION,PR)
!
!
END SELECT
!
-CALL GET_HALO(PR)
+!!$CALL GET_HALO(PR)
!
CALL DEL_HALO2_ll(TZ_PSRC_HALO2_ll)
!
@@ -1834,6 +1905,7 @@ USE MODI_GET_HALO
USE MODD_CONF
USE MODD_PARAMETERS
!USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+USE MODE_MPPDB
!
IMPLICIT NONE
!
@@ -1875,7 +1947,6 @@ IKE = SIZE(PSRC,3) - JPVEXT
!
CALL GET_HALO(PSRC)
!
-!
ZPHAT(:,:,IKB+1:IKE) = (7.0 * &
(PSRC(:,:,IKB+1:IKE) + PSRC(:,:,IKB:IKE-1)) - &
(PSRC(:,:,IKB+2:IKE+1) + PSRC(:,:,IKB-1:IKE-2))) / 12.0
@@ -1932,6 +2003,7 @@ PR = PSRC * PRHO - &
PR(:,:,IKE+1) = PR(:,:,IKE)
!
CALL GET_HALO(PR) ! JUAN
+ CALL MPPDB_CHECK3DM("PPM::PPM_S0_Z ::PR",PRECISION,PR)
!
END FUNCTION PPM_S0_Z
!
diff --git a/SURCOUCHE/extern_usersurc_ll.f90 b/SURCOUCHE/extern_usersurc_ll.f90
index 7ec65f30d84ddcd2d852dcbba88fe6357c81b593..a9567a1220dabac587479c06417ba2681c660f60 100644
--- a/SURCOUCHE/extern_usersurc_ll.f90
+++ b/SURCOUCHE/extern_usersurc_ll.f90
@@ -1228,60 +1228,7 @@
END SUBROUTINE REDUCE_SUM_3D_ll
!
!! ##########################################
- SUBROUTINE REDUCE_SUM_I0D_ll( PRES, KINFO )
-!! ##########################################
-!
- USE MODE_SUM_ll, ONLY : E_REDUCE_SUM_I0D_ll => REDUCE_SUM_I0D_ll
-!
- INTEGER, INTENT(INOUT) :: PRES
- INTEGER, INTENT(OUT) :: KINFO
-!
- CALL E_REDUCE_SUM_I0D_ll(PRES, KINFO)
-!
- END SUBROUTINE REDUCE_SUM_I0D_ll
-!
-!! ##########################################
- SUBROUTINE REDUCE_SUM_I1D_ll( PRES, KINFO )
-!! ##########################################
-!
- USE MODE_SUM_ll, ONLY : E_REDUCE_SUM_I1D_ll => REDUCE_SUM_I1D_ll
-!
- INTEGER, DIMENSION(:), INTENT(INOUT) :: PRES
- INTEGER, INTENT(OUT) :: KINFO
-!
- CALL E_REDUCE_SUM_I1D_ll( PRES, KINFO )
-!
- END SUBROUTINE REDUCE_SUM_I1D_ll
-!
-!! ##########################################
- SUBROUTINE REDUCE_SUM_I2D_ll( PRES, KINFO )
-!! ##########################################
-!
- USE MODE_SUM_ll, ONLY : E_REDUCE_SUM_I2D_ll => REDUCE_SUM_I2D_ll
-!
- INTEGER, DIMENSION(:,:), INTENT(INOUT) :: PRES
- INTEGER, INTENT(OUT) :: KINFO
-!
- CALL E_REDUCE_SUM_I2D_ll( PRES, KINFO )
-!
- END SUBROUTINE REDUCE_SUM_I2D_ll
-!
-!! ##########################################
- SUBROUTINE REDUCE_SUM_I3D_ll( PRES, KINFO )
-!! ##########################################
-!
- USE MODE_SUM_ll, ONLY : E_REDUCE_SUM_I3D_ll => REDUCE_SUM_I3D_ll
-!
- INTEGER, DIMENSION(:,:,:), INTENT(INOUT) :: PRES
- INTEGER, INTENT(OUT) :: KINFO
-!
- CALL E_REDUCE_SUM_I3D_ll(PRES, KINFO)
-!
- END SUBROUTINE REDUCE_SUM_I3D_ll
-!
-
-!! ##########################################
- SUBROUTINE UPDATE_HALO_ll( TPLIST, KINFO )
+ SUBROUTINE UPDATE_HALO_ll( TPLIST, KINFO, HDIR )
!! ##########################################
!
USE MODE_EXCHANGE_ll, ONLY : E_UPDATE_HALO_ll => UPDATE_HALO_ll
@@ -1290,8 +1237,9 @@
!
TYPE(LIST_ll), POINTER :: TPLIST
INTEGER :: KINFO
+ CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
!
- CALL E_UPDATE_HALO_ll( TPLIST, KINFO )
+ CALL E_UPDATE_HALO_ll( TPLIST, KINFO, HDIR=HDIR )
!
END SUBROUTINE UPDATE_HALO_ll
!
diff --git a/SURCOUCHE/mode_exchange_ll.f90 b/SURCOUCHE/mode_exchange_ll.f90
index c2d1a7cb281eb7c5b5462941df41a31ed825a34e..bf72f12ad3c61883ec9d876ca064db939dd1478c 100644
--- a/SURCOUCHE/mode_exchange_ll.f90
+++ b/SURCOUCHE/mode_exchange_ll.f90
@@ -87,7 +87,7 @@
CONTAINS
!
! ########################################
- SUBROUTINE UPDATE_HALO_ll(TPLIST, KINFO)
+ SUBROUTINE UPDATE_HALO_ll(TPLIST, KINFO, HDIR )
! ########################################
!
!!**** *UPDATE_HALO_ll* - routine to update halo
@@ -148,6 +148,7 @@
!
TYPE(LIST_ll), POINTER :: TPLIST ! pointer to the list of fields to be updated
INTEGER :: KINFO ! return status
+ CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
!
!* 0.2 declarations of local variables
!
@@ -157,7 +158,7 @@
! -------------------------------------------------------------
!
CALL SEND_RECV_CRSPD(TCRRT_COMDATA%TSEND_HALO1, TCRRT_COMDATA%TRECV_HALO1, &
- TPLIST, TPLIST, NHALO_COM, KINFO)
+ TPLIST, TPLIST, NHALO_COM, KINFO, HDIR=HDIR )
!
!* 2. UPDATE THE ZONES THE PROCESSOR SENDS OR RECEIVED FROM ITSELF
! ------------------------------------------------------------
@@ -2111,7 +2112,7 @@ INTEGER :: NB_REQ,NFIRST_REQ_RECV
! ##############################################################
SUBROUTINE SEND_RECV_CRSPD(TPCRSPDSEND, TPCRSPDRECV, &
TPFIELDLISTSEND, TPFIELDLISTRECV, &
- KMPI_COMM, KINFO, KBARRIER)
+ KMPI_COMM, KINFO, KBARRIER, HDIR )
! ##############################################################
!
!!**** *SEND_RECV_CRSPD*-
@@ -2208,6 +2209,8 @@ INTEGER :: NB_REQ,NFIRST_REQ_RECV
INTEGER :: KMPI_COMM
INTEGER :: KINFO
INTEGER, OPTIONAL :: KBARRIER
+ CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
+
!
!* 0.2 declarations of local variables
!
@@ -2241,6 +2244,10 @@ INTEGER,SAVE,DIMENSION(MPI_MAX_REQ) :: REQ_TAB
INTEGER,SAVE,DIMENSION(MPI_STATUS_SIZE,MPI_MAX_REQ) :: STATUS_TAB
INTEGER :: NB_REQ,NFIRST_REQ_RECV
!endif
+INTEGER :: IERR
+!
+LOGICAL :: GDIR_ALL , GLX , GLY
+INTEGER :: INX , INY
! JUAN
!
!-------------------------------------------------------------------------------
@@ -2252,6 +2259,10 @@ INTEGER :: NB_REQ,NFIRST_REQ_RECV
.OR.(.NOT.ASSOCIATED(TPFIELDLISTRECV))) THEN
RETURN
ENDIF
+!
+! init test if only halo in some direction are need
+!
+CALL INIT_GOOD_DIR(HDIR)
!
IF (.NOT.ASSOCIATED(TPCRSPDSEND)) THEN
ISENDNB = 0
@@ -2315,29 +2326,31 @@ endif
! Build the send buffer
TZZONESEND => TPMAILSEND%TELT
IF (TZZONESEND%NUMBER /= IP) THEN
- JINC = 0
-! JUAN
-!if defined (MNH_MPI_ISEND)
- IF ( .NOT. LMNH_MPI_BSEND) THEN
- NB_REQ = NB_REQ + 1
- CALL FILLIN_BUFFERS(TZFIELDLISTSEND, TZZONESEND, TZBUFFER(:,NB_REQ), JINC)
- else
- CALL FILLIN_BUFFERS(TZFIELDLISTSEND, TZZONESEND, TZBUFFER(:,1), JINC)
- endif
- ! JUAN
-!if defined(MNH_MPI_BSEND)
- IF (LMNH_MPI_BSEND) THEN
- CALL MPI_BSEND(TZBUFFER, JINC, MPI_PRECISION, TZZONESEND%NUMBER - 1, &
- TZZONESEND%MSSGTAG + ITAGOFFSET, KMPI_COMM, KERROR)
- else
+ IF ( GOOD_DIR(TPMAILSEND) ) THEN
+ JINC = 0
! JUAN
!if defined (MNH_MPI_ISEND)
- CALL MPI_ISEND(TZBUFFER(1,NB_REQ), JINC, MPI_PRECISION, TZZONESEND%NUMBER - 1, &
- TZZONESEND%MSSGTAG + ITAGOFFSET, KMPI_COMM, REQ_TAB(NB_REQ), KERROR)
+ IF ( .NOT. LMNH_MPI_BSEND) THEN
+ NB_REQ = NB_REQ + 1
+ CALL FILLIN_BUFFERS(TZFIELDLISTSEND, TZZONESEND, TZBUFFER(:,NB_REQ), JINC)
+ else
+ CALL FILLIN_BUFFERS(TZFIELDLISTSEND, TZZONESEND, TZBUFFER(:,1), JINC)
+ endif
+ ! JUAN
+ !if defined(MNH_MPI_BSEND)
+ IF (LMNH_MPI_BSEND) THEN
+ CALL MPI_BSEND(TZBUFFER, JINC, MPI_PRECISION, TZZONESEND%NUMBER - 1, &
+ TZZONESEND%MSSGTAG + ITAGOFFSET, KMPI_COMM, KERROR)
+ else
+ ! JUAN
+ !if defined (MNH_MPI_ISEND)
+ CALL MPI_ISEND(TZBUFFER(1,NB_REQ), JINC, MPI_PRECISION, TZZONESEND%NUMBER - 1, &
+ TZZONESEND%MSSGTAG + ITAGOFFSET, KMPI_COMM, REQ_TAB(NB_REQ), KERROR)
+
+ endif
- endif
-
- ENDIF
+ ENDIF
+ ENDIF
TPMAILSEND => TPMAILSEND%TNEXT
ENDIF
ENDDO
@@ -2355,24 +2368,26 @@ endif
IF (TPMAILRECV%TELT%NUMBER == IP) THEN
TPMAILRECV => TPMAILRECV%TNEXT
ELSE
-!if defined (MNH_MPI_ISEND)
- IF ( .NOT. LMNH_MPI_BSEND) THEN
- NB_REQ = NB_REQ + 1
- CALL MPI_IRECV(TZBUFFER(1,NB_REQ), IBUFFSIZE, MPI_PRECISION, &
- TPMAILRECV%TELT%NUMBER -1 , &
- TPMAILRECV%TELT%MSSGTAG + ITAGOFFSET, &
- KMPI_COMM, REQ_TAB(NB_REQ), KERROR)
- else
- CALL MPI_RECV(TZBUFFER, IBUFFSIZE, MPI_PRECISION, &
- TPMAILRECV%TELT%NUMBER -1 , &
- TPMAILRECV%TELT%MSSGTAG + ITAGOFFSET, &
- KMPI_COMM, IRECVSTATUS, KERROR)
- JINC = 0
- CALL FILLOUT_BUFFERS(TZFIELDLISTRECV, TPMAILRECV%TELT, TZBUFFER(:,1), JINC)
- endif
- ! JUAN
- TPMAILRECV => TPMAILRECV%TNEXT
- !
+ IF ( GOOD_DIR(TPMAILRECV) ) THEN
+ !if defined (MNH_MPI_ISEND)
+ IF ( .NOT. LMNH_MPI_BSEND) THEN
+ NB_REQ = NB_REQ + 1
+ CALL MPI_IRECV(TZBUFFER(1,NB_REQ), IBUFFSIZE, MPI_PRECISION, &
+ TPMAILRECV%TELT%NUMBER -1 , &
+ TPMAILRECV%TELT%MSSGTAG + ITAGOFFSET, &
+ KMPI_COMM, REQ_TAB(NB_REQ), KERROR)
+ else
+ CALL MPI_RECV(TZBUFFER, IBUFFSIZE, MPI_PRECISION, &
+ TPMAILRECV%TELT%NUMBER -1 , &
+ TPMAILRECV%TELT%MSSGTAG + ITAGOFFSET, &
+ KMPI_COMM, IRECVSTATUS, KERROR)
+ JINC = 0
+ CALL FILLOUT_BUFFERS(TZFIELDLISTRECV, TPMAILRECV%TELT, TZBUFFER(:,1), JINC)
+ endif
+ ! JUAN
+ TPMAILRECV => TPMAILRECV%TNEXT
+ !
+ END IF
ENDIF
!
@@ -2390,14 +2405,15 @@ endif
IF (TPMAILRECV%TELT%NUMBER == IP) THEN
TPMAILRECV => TPMAILRECV%TNEXT
ELSE
- !
- NB_REQ = NB_REQ + 1
- JINC = 0
- CALL FILLOUT_BUFFERS(TZFIELDLISTRECV, TPMAILRECV%TELT, TZBUFFER(:,NB_REQ), JINC)
- TPMAILRECV => TPMAILRECV%TNEXT
- !
- ENDIF
-
+ IF ( GOOD_DIR(TPMAILRECV) ) THEN
+ !
+ NB_REQ = NB_REQ + 1
+ JINC = 0
+ CALL FILLOUT_BUFFERS(TZFIELDLISTRECV, TPMAILRECV%TELT, TZBUFFER(:,NB_REQ), JINC)
+ TPMAILRECV => TPMAILRECV%TNEXT
+ !
+ END IF
+ ENDIF
!
ENDDO
endif
@@ -2415,6 +2431,82 @@ endif
!
!-------------------------------------------------------------------------------
!
- END SUBROUTINE SEND_RECV_CRSPD
-!
+ CONTAINS
+ SUBROUTINE INIT_GOOD_DIR(HDIR)
+ !
+ ! init the direction of halo if needed
+ !
+ IMPLICIT NONE
+ CHARACTER(len=4), OPTIONAL :: HDIR
+ !
+
+ IF (.NOT. PRESENT(HDIR)) THEN
+ GDIR_ALL = .TRUE.
+ ELSE
+ !print*,"GOOD_DIR HDIR=",HDIR,"####"
+ GDIR_ALL = .FALSE.
+ INX = 0
+ INY = 0
+ GLX = .FALSE.
+ GLY = .FALSE.
+ IF ( HDIR == "Z0_X" ) THEN
+ !print*,"ZZZZZ0000_XXXXXXXXXXXXXXXX"
+ !GDIR_ALL = .TRUE.
+ INX = -100 ! -100 also OK so not really needed !!!
+ GLX = .TRUE.
+ ELSEIF ( HDIR == "S0_X" ) THEN
+ !print*,"SSSSS0000_XXXXXXXXXXXXXXXX"
+ GDIR_ALL = .TRUE.
+ INX = 1
+ GLX = .TRUE.
+ ELSEIF ( HDIR == "Z0_Y" ) THEN
+ !print*,"ZZZZZ0000_YYYYYYYYYYYYYYY"
+ !GDIR_ALL = .TRUE.
+ INY = -100 ! -100 also OK so not really needed !!!
+ GLY = .TRUE.
+ ELSEIF ( HDIR == "S0_Y" ) THEN
+ !print*,"SSSS0000_YYYYYYYYYYYYYYY"
+ GDIR_ALL = .TRUE.
+ INY = 1
+ GLY = .TRUE.
+ ELSEIF ( HDIR == "01_X" ) THEN
+ !print*,"01_X"
+ !GDIR_ALL = .TRUE.
+ INX = 1
+ GLX = .TRUE.
+ ELSEIF ( HDIR == "Z1_X" ) THEN
+ !print*,"ZZZZZZZZZZZZZZZZ1_X"
+ !GDIR_ALL = .TRUE.
+ INX = -100
+ GLX = .TRUE.
+ ELSEIF ( HDIR == "01_Y" ) THEN
+ !print*,"01_YYYYYYYYYYYYY"
+ !GDIR_ALL = .TRUE.
+ INY = 1
+ GLY = .TRUE.
+ ELSE
+ print*,"GOOD_DIR DEFAULT :: SOMETHING WRONG !!! HDIR=",HDIR,"####"
+ STOP "INIT_GOOD_DIR :: SOMETHING WRONG !!! "
+ END IF
+ END IF
+ END SUBROUTINE INIT_GOOD_DIR
+ !
+ LOGICAL FUNCTION GOOD_DIR(TP)
+ IMPLICIT NONE
+ type(crspd_ll) :: TP
+ !
+ GOOD_DIR = .FALSE.
+ ! RETURN
+ IF (GDIR_ALL) THEN
+ GOOD_DIR = .TRUE.
+ ELSEIF ( GLX ) THEN
+ GOOD_DIR = ( (TP%TELT%NXEND - TP%TELT%NXOR + 1 ) == INX ) .AND. ( (TP%TELT%NYEND - TP%TELT%NYOR + 1 ) /= INX )
+ ELSEIF ( GLY ) THEN
+ GOOD_DIR = ( (TP%TELT%NYEND - TP%TELT%NYOR + 1 ) == INY ) .AND. ( (TP%TELT%NXEND - TP%TELT%NXOR + 1 ) /= INY )
+ END IF
+ !
+ END FUNCTION GOOD_DIR
+ !
+ END SUBROUTINE SEND_RECV_CRSPD
+ !
END MODULE MODE_EXCHANGE_ll
diff --git a/SURCOUCHE/modi_update_ll.f90 b/SURCOUCHE/modi_update_ll.f90
index e7c23116f84fa786e505abf5fc6c7edf8b69f875..73a6ce87ab021c87848d1687d5e4430db98cae3b 100644
--- a/SURCOUCHE/modi_update_ll.f90
+++ b/SURCOUCHE/modi_update_ll.f90
@@ -15,13 +15,14 @@
INTERFACE
!
!! ##########################################
- SUBROUTINE UPDATE_HALO_ll( TPLIST, KINFO )
+ SUBROUTINE UPDATE_HALO_ll( TPLIST, KINFO, HDIR )
!! ##########################################
!
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
!
TYPE(LIST_ll), POINTER :: TPLIST ! pointer to the list of fields to be updated
INTEGER :: KINFO ! return status
+ CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
!
END SUBROUTINE UPDATE_HALO_ll
!