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

Juan 22/09/2012: OK HALO_IN/OUT , mirror OK by deactive for PGI BUG on host part

parent 1c063160
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
Showing
with 64 additions and 61 deletions
MNH/get_halo.f90
+ 64
− 61
View file @ b85f81ed
......@@ -64,7 +64,7 @@ TYPE(HALO2LIST_ll), POINTER :: TP_PSRC_HALO2_ll ! halo2 for SRC
INTEGER :: IIU,IJU,IKU ! domain sizes
TYPE(LIST_ll) , POINTER :: TZ_PSRC_ll ! halo
INTEGER :: IERROR ! error return code
!
IIU = SIZE(PSRC,1)
IJU = SIZE(PSRC,2)
IKU = SIZE(PSRC,3)
......@@ -106,11 +106,19 @@ CALL CLEANLIST_ll(TZ_PSRC_ll)
!
END SUBROUTINE GET_HALO
!-----------------------------------------------------------------------
MODULE MODD_HALO_D
REAL, SAVE , ALLOCATABLE, DIMENSION(:,:,:) :: ZNORTH_IN, ZSOUTH_IN, ZWEST_IN, ZEAST_IN
! acc declare mirror (ZNORTH_IN, ZSOUTH_IN, ZWEST_IN, ZEAST_IN)
REAL, SAVE , ALLOCATABLE, DIMENSION(:,:,:) :: ZNORTH_OUT, ZSOUTH_OUT, ZWEST_OUT, ZEAST_OUT
! acc declare mirror (ZNORTH_OUT, ZSOUTH_OUT, ZWEST_OUT, ZEAST_OUT)
END MODULE MODD_HALO_D
!-------------------------------------------------------------------------------
! #########################
SUBROUTINE GET_HALO_D(PSRC,HDIR)
! #########################
!
USE MODD_HALO_D
USE MODE_ll
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
USE MODD_PARAMETERS, ONLY : JPHEXT
......@@ -128,8 +136,10 @@ INTEGER, SAVE :: IIE,IJE ! End useful area in x,y,z directions
INTEGER,SAVE :: IIU,IJU,IKU
!
REAL, SAVE , ALLOCATABLE, DIMENSION(:,:,:) :: ZNORTH_IN, ZSOUTH_IN, ZWEST_IN, ZEAST_IN
REAL, SAVE , ALLOCATABLE, DIMENSION(:,:,:) :: ZNORTH_OUT, ZSOUTH_OUT, ZWEST_OUT, ZEAST_OUT
!!$REAL, SAVE , ALLOCATABLE, DIMENSION(:,:,:) :: ZPSRC
!!$INTEGER :: IBB,IBE,JBB,JBE
!
!
LOGICAL, SAVE :: GFIRST_GET_HALO_D = .TRUE.
!
......@@ -142,79 +152,72 @@ IF (GFIRST_GET_HALO_D ) THEN
IJU=size(psrc,2)
IKU=size(psrc,3)
!
ALLOCATE ( ZSOUTH_IN ( IIU , 1 :IJB-1 , IKU ) )
ALLOCATE ( ZNORTH_IN ( IIU , IJE+1:IJU , IKU ) )
ALLOCATE ( ZWEST_IN ( 1 :IIB-1 , IJU , IKU ) )
ALLOCATE ( ZEAST_IN ( IIE+1:IIU , IJU , IKU ) )
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 ) )
!
ALLOCATE ( ZSOUTH_OUT ( IIU , 1 :IJB-1 , IKU ) )
ALLOCATE ( ZNORTH_OUT ( IIU , IJE+1:IJU , IKU ) )
ALLOCATE ( ZWEST_OUT ( 1 :IIB-1 , IJU , IKU ) )
ALLOCATE ( ZEAST_OUT ( IIE+1:IIU , IJU , 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 ( ZPSRC ( IIU, IJU ,IKU ) )
GFIRST_GET_HALO_D = .FALSE.
END IF
!$acc update host (PSRC)
! acc update host (PSRC( : , :IJB , : ))
! acc update host (PSRC( : , IJE: , : ))
! acc update host (PSRC( :IIB , IJB:IJE , : ))
! acc update host (PSRC( IIE: , IJB:IJE , : ))
!$acc kernels copyout (ZNORTH_IN,ZSOUTH_IN,ZWEST_IN,ZEAST_IN)
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
! acc update host (ZNORTH_IN,ZSOUTH_IN,ZWEST_IN,ZEAST_IN)
!!$
!!$!$acc kernels copyout (ZNORTH_IN,ZSOUTH_IN,ZWEST_IN,ZEAST_IN)
!!$ZNORTH_IN = PSRC( : , IJE: , : )
!!$ZSOUTH_IN = PSRC( : , :IJB , : )
!!$ZWEST_IN = PSRC( :IIB , : , : )
!!$ZEAST_IN = PSRC( IIE: , : , : )
!!$!$acc end kernels
!!$
!!$PSRC( : , IJE: , : ) = ZNORTH_OUT
!!$PSRC( : , :IJB , : ) = ZSOUTH_OUT
!!$PSRC( :IIB , : , : ) = ZWEST_OUT
!!$PSRC( IIE: , : , : ) = ZEAST_OUT
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
CALL ADD3DFIELD_ll(TZ_PSRC_ll,PSRC)
CALL UPDATE_HALO_ll(TZ_PSRC_ll,IERROR, HDIR=HDIR )
CALL CLEANLIST_ll(TZ_PSRC_ll)
!!$! acc update device (PSRC)
!!$! acc update device (PSRC( : , : IJB-1 , : ))
!!$! acc update device (PSRC( : , IJE+1: , : ))
!!$! acc update device (PSRC( :IIB-1 , : , : ))
!!$! acc update device (PSRC( IIE+1: , : , : ))
!!$
ZSOUTH_OUT = PSRC( : , :IJB-1 , : )
ZNORTH_OUT = PSRC( : , IJE+1: , : )
ZWEST_OUT = PSRC( :IIB-1 , : , : )
ZEAST_OUT = PSRC( IIE+1: , : , : )
ZSOUTH_OUT = PSRC( IIB:IIE , IJB-1:IJB-1 , : )
ZNORTH_OUT = PSRC( IIB:IIE , IJE+1:IJE+1 , : )
ZWEST_OUT = PSRC( IIB-1:IIB-1 , IJB:IJE , : )
ZEAST_OUT = PSRC( IIE+1:IIE+1 , IJB:IJE , : )
!!$!$acc kernels copyin (ZNORTH_OUT,ZSOUTH_OUT,ZWEST_OUT,ZEAST_OUT)
!!$PSRC( : , :IJB-1 , : ) = ZSOUTH_OUT
!!$PSRC( : , IJE+1: , : ) = ZNORTH_OUT
!!$PSRC( :IIB-1 , : , : ) = ZWEST_OUT
!!$PSRC( IIE+1: , : , : ) = ZEAST_OUT
!!$!$acc end kernels
!$acc kernels copyin (ZSOUTH_OUT) async(1)
PSRC( : , :IJB-1 , : ) = ZSOUTH_OUT
!$acc end kernels
!$acc kernels copyin (ZNORTH_OUT) async(2)
PSRC( : , IJE+1: , : ) = ZNORTH_OUT
!$acc end kernels
!$acc kernels copyin (ZWEST_OUT) async(3)
PSRC( :IIB-1 , : , : ) = ZWEST_OUT
!$acc end kernels
!$acc kernels copyin (ZEAST_OUT) async(4)
PSRC( IIE+1: , : , : ) = ZEAST_OUT
! acc update device (ZNORTH_OUT,ZSOUTH_OUT,ZWEST_OUT,ZEAST_OUT)
!$acc kernels copyin (ZNORTH_OUT,ZSOUTH_OUT,ZWEST_OUT,ZEAST_OUT)
PSRC( IIB:IIE , IJB-1:IJB-1 , : ) = ZSOUTH_OUT
PSRC( IIB:IIE , IJE+1:IJE+1 , : ) = ZNORTH_OUT
PSRC( IIB-1:IIB-1 , IJB:IJE , : ) = ZWEST_OUT
PSRC( IIE+1:IIE+1 , IJB:IJE , : ) = ZEAST_OUT
!$acc end kernels
!$acc wait
!!$!$acc update device (ZSOUTH_OUT) async(1)
!!$!$acc kernels async(1)
!!$PSRC( IIB:IIE , IJB-1:IJB-1 , : ) = ZSOUTH_OUT
!!$!$acc end kernels
!!$
!!$!$acc update device (ZNORTH_OUT) async(2)
!!$!$acc kernels async(2)
!!$PSRC( IIB:IIE , IJE+1:IJE+1 , : ) = ZNORTH_OUT
!!$!$acc end kernels
!!$
!!$!$acc update device (ZWEST_OUT) async(3)
!!$!$acc kernels async(3)
!!$PSRC( IIB-1:IIB-1 , IJB:IJE , : ) = ZWEST_OUT
!!$!$acc end kernels
!!$
!!$!$acc update device (ZEAST_OUT) async(4)
!!$!$acc kernels async(4)
!!$PSRC( IIE+1:IIE+1 , IJB:IJE , : ) = ZEAST_OUT
!!$!$acc end kernels
!!$
!!$!$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