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

Juan 12/11/2014: manage correctly NHALO<>1 in get_halo_d

parent 24b05162
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
Showing
with 66 additions and 63 deletions
MNH/get_halo.f90
+ 66
− 63
View file @ 96f4148f
......@@ -133,9 +133,10 @@ USE MODE_ll
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
USE MODD_PARAMETERS, ONLY : JPHEXT
!
USE MODD_IO_ll, ONLY : GSMONOPROC
USE MODE_MNH_ZWORK, ONLY : GWEST , GEAST, GSOUTH , GNORTH
USE MODD_IO_ll, ONLY : GSMONOPROC
USE MODE_MNH_ZWORK, ONLY : GWEST , GEAST, GSOUTH , GNORTH
!
USE MODD_CONF, ONLY : NHALO
!
IMPLICIT NONE
!
......@@ -148,11 +149,12 @@ INTEGER :: IERROR ! error return code
INTEGER, SAVE :: IIB,IJB ! Begining useful area in x,y,z directions
INTEGER, SAVE :: IIE,IJE ! End useful area in x,y,z directions
INTEGER,SAVE :: IIU,IJU,IKU
INTEGER,SAVE :: IIU,IJU,IKU
INTEGER,SAVE :: IHALO_1
INTEGER,PARAMETER :: IS_WEST=1 , IS_EAST=2, IS_SOUTH=3, IS_NORTH=4
LOGICAL :: LX , LY
INTEGER :: IIBB,IIEE,IJBB,IJEE
INTEGER :: IS_WEST=1 , IS_EAST=2, IS_SOUTH=3, IS_NORTH=4
!
!LOGICAL, SAVE :: GFIRST_GET_HALO_D = .TRUE.
!
......@@ -164,44 +166,27 @@ NULLIFY( TZ_PSRC_ll)
IF (GFIRST_GET_HALO_D ) THEN
CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
!
!
IIU=size(psrc,1)
IJU=size(psrc,2)
IKU=size(psrc,3)
!
ALLOCATE ( ZSOUTH_IN ( 1:IIU , 1:IJB , IKU ) )
ALLOCATE ( ZNORTH_IN ( 1:IIU , IJE:IJU , IKU ) )
ALLOCATE ( ZWEST_IN ( 1:IIB , 1:IJU , IKU ) )
ALLOCATE ( ZEAST_IN ( IIE:IIU , 1:IJU , IKU ) )
IHALO_1 = NHALO-1
!
ALLOCATE ( ZSOUTH_IN ( IIB:IIE , IJB:IJB+IHALO_1 , IKU ) )
ALLOCATE ( ZNORTH_IN ( IIB:IIE , IJE-IHALO_1:IJE , IKU ) )
ALLOCATE ( ZWEST_IN ( IIB:IIB+IHALO_1 , IJB:IJE , IKU ) )
ALLOCATE ( ZEAST_IN ( IIE-IHALO_1:IIE , IJB:IJE , IKU ) )
!
ALLOCATE ( ZSOUTH_OUT ( IIB:IIE , IJB-1:IJB-1 , IKU ) )
ALLOCATE ( ZNORTH_OUT ( IIB:IIE , IJE+1:IJE+1 , IKU ) )
ALLOCATE ( ZWEST_OUT ( IIB-1:IIB-1 , IJB:IJE , IKU ) )
ALLOCATE ( ZEAST_OUT ( IIE+1:IIE+1 , IJB:IJE , IKU ) )
ALLOCATE ( ZSOUTH_OUT ( IIB:IIE , 1:IJB-1 , IKU ) )
ALLOCATE ( ZNORTH_OUT ( IIB:IIE , IJE+1:IJU , IKU ) )
ALLOCATE ( ZWEST_OUT ( 1:IIB-1 , IJB:IJE , IKU ) )
ALLOCATE ( ZEAST_OUT ( IIE+1:IIU , IJB:IJE , IKU ) )
GFIRST_GET_HALO_D = .FALSE.
END IF
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!$#ifdef ACC_MIRROR
!!$!$acc kernels
!!$#else
!!$!$acc kernels copyout (ZNORTH_IN,ZSOUTH_IN,ZWEST_IN,ZEAST_IN)
!!$#endif
!!$ZSOUTH_IN = PSRC( 1:IIU , 1:IJB , : )
!!$ZNORTH_IN = PSRC( 1:IIU , IJE:IJU , : )
!!$ZWEST_IN = PSRC( 1:IIB , 1:IJU , : )
!!$ZEAST_IN = PSRC( IIE:IIU , 1:IJU , : )
!!$!$acc end kernels
!!$#ifdef ACC_MIRROR
!!$!$acc update host (ZNORTH_IN,ZSOUTH_IN,ZWEST_IN,ZEAST_IN)
!!$#endif
!!$PSRC( 1:IIU , 1:IJB , : ) = ZSOUTH_IN
!!$PSRC( 1:IIU , IJE:IJU , : ) = ZNORTH_IN
!!$PSRC( 1:IIB , 1:IJU , : ) = ZWEST_IN
!!$PSRC( IIE:IIU , 1:IJU , : ) = ZEAST_IN
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
LX = .FALSE.
......@@ -216,42 +201,46 @@ LY = ( HDIR == "01_Y" )
!!$print *,"IIB=",IIB," HDIR=",HDIR," LX=",LX," LY=",LY ; call flush(6)
END IF
!!$LX = .TRUE.
!!$LY = .TRUE.
IIBB=IIB ; IIEE = IIE
IJBB=IJB ; IJEE = IJE
IF ( GWEST ) IIBB = 1
IF ( GEAST ) IIEE = IIU
IF ( GSOUTH ) IJBB = 1
IF ( GNORTH ) IJEE = IJU
IF (LX) THEN
IF (.NOT. GWEST) THEN
!$acc kernels updateout(ZWEST_IN) async(IS_WEST)
ZWEST_IN ( IIBB:IIB , IJB:IJE , : ) = PSRC( IIBB:IIB , IJB:IJE , : )
ZWEST_IN ( IIB:IIB+IHALO_1 , IJB:IJE , : ) = PSRC( IIB:IIB+IHALO_1 , IJB:IJE , : )
!$acc end kernels
END IF
IF (.NOT.GEAST) THEN
!$acc kernels updateout(ZEAST_IN) async(IS_EAST)
ZEAST_IN ( IIE:IIEE , IJB:IJE , : ) = PSRC( IIE:IIEE , IJB:IJE , : )
ZEAST_IN ( IIE-IHALO_1:IIE , IJB:IJE , : ) = PSRC( IIE-IHALO_1:IIE , IJB:IJE , : )
!$acc end kernels
ENDIF
END IF
IF (LY) THEN
IF (.NOT.GSOUTH) THEN
!$acc kernels updateout (ZSOUTH_IN) async(IS_SOUTH)
ZSOUTH_IN ( IIB:IIE , IJBB:IJB , : ) = PSRC( IIB:IIE , IJBB:IJB , : )
ZSOUTH_IN ( IIB:IIE , IJB:IJB+IHALO_1 , : ) = PSRC( IIB:IIE , IJB:IJB+IHALO_1 , : )
!$acc end kernels
ENDIF
IF (.NOT.GNORTH) THEN
!$acc kernels updateout (ZNORTH_IN) async(IS_NORTH)
ZNORTH_IN ( IIB:IIE , IJE:IJEE , : ) = PSRC( IIB:IIE , IJE:IJEE , : )
ZNORTH_IN ( IIB:IIE , IJE-IHALO_1:IJE , : ) = PSRC( IIB:IIE , IJE-IHALO_1:IJE , : )
!$acc end kernels
ENDIF
ENDIF
!$acc wait
IF (LX) THEN
PSRC( IIBB:IIB , IJB:IJE , : ) = ZWEST_IN ( IIBB:IIB , IJB:IJE , : )
PSRC( IIE:IIEE , IJB:IJE , : ) = ZEAST_IN ( IIE:IIEE , IJB:IJE , : )
IF (.NOT. GWEST) THEN
PSRC( IIB:IIB+IHALO_1 , IJB:IJE , : ) = ZWEST_IN ( IIB:IIB+IHALO_1 , IJB:IJE , : )
ENDIF
IF (.NOT.GEAST) THEN
PSRC( IIE-IHALO_1:IIE , IJB:IJE , : ) = ZEAST_IN ( IIE-IHALO_1:IIE , IJB:IJE , : )
ENDIF
END IF
IF (LY) THEN
PSRC( IIB:IIE , IJBB:IJB , : ) = ZSOUTH_IN ( IIB:IIE , IJBB:IJB , : )
PSRC( IIB:IIE , IJE:IJEE , : ) = ZNORTH_IN ( IIB:IIE , IJE:IJEE , : )
IF (.NOT.GSOUTH) THEN
PSRC( IIB:IIE , IJB:IJB+IHALO_1 , : ) = ZSOUTH_IN ( IIB:IIE , IJB:IJB+IHALO_1 , : )
ENDIF
IF (.NOT.GNORTH) THEN
PSRC( IIB:IIE , IJE-IHALO_1:IJE , : ) = ZNORTH_IN ( IIB:IIE , IJE-IHALO_1:IJE , : )
ENDIF
ENDIF
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
......@@ -260,31 +249,45 @@ CALL UPDATE_HALO_ll(TZ_PSRC_ll,IERROR, HDIR=HDIR )
CALL CLEANLIST_ll(TZ_PSRC_ll)
IF (LX) THEN
ZWEST_OUT( IIB-1:IIB-1 , IJB:IJE , : ) = PSRC( IIB-1:IIB-1 , IJB:IJE , : )
ZEAST_OUT( IIE+1:IIE+1 , IJB:IJE , : ) = PSRC( IIE+1:IIE+1 , IJB:IJE , : )
IF (.NOT.GWEST) THEN
ZWEST_OUT( 1:IIB-1 , IJB:IJE , : ) = PSRC( 1:IIB-1 , IJB:IJE , : )
ENDIF
IF (.NOT.GEAST) THEN
ZEAST_OUT( IIE+1:IIU , IJB:IJE , : ) = PSRC( IIE+1:IIU , IJB:IJE , : )
ENDIF
END IF
IF (LY) THEN
ZSOUTH_OUT ( IIB:IIE , IJB-1:IJB-1 , : ) = PSRC( IIB:IIE , IJB-1:IJB-1 , : )
ZNORTH_OUT ( IIB:IIE , IJE+1:IJE+1 , : ) = PSRC( IIB:IIE , IJE+1:IJE+1 , : )
IF (.NOT.GSOUTH) THEN
ZSOUTH_OUT ( IIB:IIE , 1:IJB-1 , : ) = PSRC( IIB:IIE , 1:IJB-1 , : )
ENDIF
IF (.NOT.GNORTH) THEN
ZNORTH_OUT ( IIB:IIE , IJE+1:IJU , : ) = PSRC( IIB:IIE , IJE+1:IJU , : )
ENDIF
END IF
IF (LX) THEN
IF (.NOT.GWEST) THEN
!$acc kernels updatein (ZWEST_OUT) async(IS_WEST)
PSRC( IIB-1:IIB-1 , IJB:IJE , : ) = ZWEST_OUT( IIB-1:IIB-1 , IJB:IJE , : )
PSRC( 1:IIB-1 , IJB:IJE , : ) = ZWEST_OUT( 1:IIB-1 , IJB:IJE , : )
!$acc end kernels
ENDIF
IF (.NOT.GEAST) THEN
!$acc kernels updatein (ZEAST_OUT) async(IS_EAST)
PSRC( IIE+1:IIE+1 , IJB:IJE , : ) = ZEAST_OUT( IIE+1:IIE+1 , IJB:IJE , : )
PSRC( IIE+1:IIU , IJB:IJE , : ) = ZEAST_OUT( IIE+1:IIU , IJB:IJE , : )
!$acc end kernels
ENDIF
END IF
IF (LY) THEN
IF (.NOT.GSOUTH) THEN
!$acc kernels updatein (ZSOUTH_OUT) async(IS_SOUTH)
PSRC( IIB:IIE , IJB-1:IJB-1 , : ) = ZSOUTH_OUT( IIB:IIE , IJB-1:IJB-1 , : )
PSRC( IIB:IIE , 1:IJB-1 , : ) = ZSOUTH_OUT( IIB:IIE , 1:IJB-1 , : )
!$acc end kernels
ENDIF
IF (.NOT.GNORTH) THEN
!$acc kernels updatein (ZNORTH_OUT) async(IS_NORTH)
PSRC( IIB:IIE , IJE+1:IJE+1 , : ) = ZNORTH_OUT ( IIB:IIE , IJE+1:IJE+1 , : )
PSRC( IIB:IIE , IJE+1:IJU , : ) = ZNORTH_OUT ( IIB:IIE , IJE+1:IJU , : )
!$acc end kernels
ENDIF
END IF
!$acc wait
!
END SUBROUTINE GET_HALO_D
......
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