From 75c2b3e098f6e8a21484405786d9790806a09f02 Mon Sep 17 00:00:00 2001
From: Juan ESCOBAR <juan.escobar@aero.obs-mip.fr>
Date: Fri, 10 Mar 2023 14:12:39 +0100
Subject: [PATCH] Juan 10/03/2023:ZSOLVER/get_halo.f90, Cray OPENACC Opt, pass
 ZTAB by arg + dims in GET_HALO2_DF

---
 src/ZSOLVER/get_halo.f90 | 160 ++++++++++++++++++++++++---------------
 1 file changed, 100 insertions(+), 60 deletions(-)

diff --git a/src/ZSOLVER/get_halo.f90 b/src/ZSOLVER/get_halo.f90
index 8d6119d7c..a8665d205 100644
--- a/src/ZSOLVER/get_halo.f90
+++ b/src/ZSOLVER/get_halo.f90
@@ -2302,33 +2302,74 @@ CALL MPPDB_CHECK(PSRC,"GET_HALO2_DD end:PSRC")
 END SUBROUTINE GET_HALO2_DD
 !-------------------------------------------------------------------------------
 !     ########################################
-      SUBROUTINE GET_HALO2_DF(PSRC, TP_PSRC_HALO2F_ll, HNAME)
+SUBROUTINE GET_HALO2_DF(PSRC, TP_PSRC_HALO2F_ll, HNAME)
 !     ########################################
 #define MNH_GPUDIRECT
+  !
+USE MODD_HALO_D  
+USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+USE MODE_MNH_ZWORK, ONLY : IIU,IJU,IKU
+USE MODE_MNH_ZWORK, ONLY : IIB,IJB ,IIE,IJE  
+IMPLICIT NONE
 !
-USE MODD_HALO_D
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC    ! variable at t
+TYPE(HALO2LIST_ll), POINTER  :: TP_PSRC_HALO2F_ll  ! halo2 for SRC
+character(len=*), optional, intent(in) :: HNAME ! Name of the field to be added
+!
+!  local var
+!
+REAL , DIMENSION(:,:) , POINTER , CONTIGUOUS :: ZH2F_EAST,ZH2F_WEST,ZH2F_NORTH,ZH2F_SOUTH
+!
+ZH2F_EAST => TP_PSRC_HALO2F_ll%HALO2%EAST
+ZH2F_WEST => TP_PSRC_HALO2F_ll%HALO2%WEST
+ZH2F_NORTH => TP_PSRC_HALO2F_ll%HALO2%NORTH
+ZH2F_SOUTH => TP_PSRC_HALO2F_ll%HALO2%SOUTH
+!
+CALL  GET_HALO2_DF_DIM(PSRC,&
+      ZSOUTH2F_IN, ZNORTH2F_IN, ZWEST2F_IN, ZEAST2F_IN,&
+      ZSOUTH2F_OUT, ZNORTH2F_OUT, ZWEST2F_OUT, ZEAST2F_OUT,&
+      ZH2F_EAST,ZH2F_WEST,ZH2F_NORTH,ZH2F_SOUTH,&
+      IIB,IIE,IJB,IJE,IIU,IJU,IKU,IHALO2_1,IHALO2,&
+      HNAME)
+!
+CONTAINS
+!
+SUBROUTINE GET_HALO2_DF_DIM(PSRC,&
+      PZSOUTH2F_IN, PZNORTH2F_IN, PZWEST2F_IN, PZEAST2F_IN,&
+      PZSOUTH2F_OUT, PZNORTH2F_OUT, PZWEST2F_OUT, PZEAST2F_OUT,&
+      PZH2F_EAST,PZH2F_WEST,PZH2F_NORTH,PZH2F_SOUTH,&
+      KIIB,KIIE,KIJB,KIJE,KIIU,KIJU,KIKU,KIHALO2_1,KIHALO2,&
+      HNAME)  
+!        
 USE MODE_ll
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-USE MODD_PARAMETERS, ONLY : JPHEXT
 !
-USE MODD_IO,        ONLY : GSMONOPROC
 USE MODE_MNH_ZWORK, ONLY : GWEST , GEAST, GSOUTH , GNORTH
-USE MODE_MNH_ZWORK, ONLY : IIU,IJU,IKU
-USE MODE_MNH_ZWORK, ONLY : IIB,IJB ,IIE,IJE
-!
-USE MODD_CONF, ONLY : NHALO
-USE MODE_DEVICE
+
 USE MODE_MPPDB
 !
-USE MODD_VAR_ll,     ONLY : IP,NPROC,NP1,NP2
+USE MODD_VAR_ll,     ONLY : NPROC
 USE MODD_VAR_ll,     ONLY : NMNH_COMM_WORLD
 USE MODD_MPIF,       ONLY : MPI_STATUSES_IGNORE
 USE MODD_PRECISION,  ONLY : MNHREAL_MPI
 !
 IMPLICIT NONE
 !
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC    ! variable at t
-TYPE(HALO2LIST_ll), POINTER  :: TP_PSRC_HALO2F_ll  ! halo2 for SRC
+REAL, DIMENSION(KIIU,KIJU,KIKU), INTENT(INOUT) :: PSRC    ! variable at t
+REAL :: PZSOUTH2F_IN ( KIIB:KIIE   , KIJB:KIJB+KIHALO2_1   , KIKU ) ,&
+        PZNORTH2F_IN ( KIIB:KIIE   , KIJE-KIHALO2_1:KIJE   , KIKU ) ,&
+        PZWEST2F_IN  ( KIIB:KIIB+KIHALO2_1   , KIJB:KIJE   , KIKU ) ,&
+        PZEAST2F_IN  ( KIIE-KIHALO2_1:KIIE   , KIJB:KIJE   , KIKU ) ,&
+        !
+        PZSOUTH2F_OUT (   KIIB:KIIE   , KIJB-KIHALO2:KIJB-1 , KIKU ) ,&
+        PZNORTH2F_OUT (   KIIB:KIIE   , KIJE+1:KIJE+KIHALO2 , KIKU ) ,&
+        PZWEST2F_OUT  ( KIIB-KIHALO2:KIIB-1 ,   KIJB:KIJE   , KIKU ) ,&
+        PZEAST2F_OUT  ( KIIE+1:KIIE+KIHALO2 ,   KIJB:KIJE   , KIKU ) ,&
+        !
+        PZH2F_EAST ( KIJU , KIKU ) ,&
+        PZH2F_WEST ( KIJU , KIKU ) ,&
+        PZH2F_NORTH( KIIU , KIKU ) ,&
+        PZH2F_SOUTH( KIIU , KIKU )
+INTEGER ::  KIIB,KIIE,KIJB,KIJE,KIIU,KIJU,KIKU,KIHALO2_1,KIHALO2
 character(len=*), optional, intent(in) :: HNAME ! Name of the field to be added
 !
 character(len=:), allocatable    :: yname
@@ -2341,7 +2382,7 @@ LOGICAL      :: LX , LY
 INTEGER      :: INB_REQ , IREQ(8)
 INTEGER      :: IERR
 
-REAL , DIMENSION(:,:) , POINTER , CONTIGUOUS :: ZH2F_EAST,ZH2F_WEST,ZH2F_NORTH,ZH2F_SOUTH
+!!$REAL , DIMENSION(:,:) , POINTER , CONTIGUOUS :: ZH2F_EAST,ZH2F_WEST,ZH2F_NORTH,ZH2F_SOUTH
 
 CALL MPPDB_CHECK(PSRC,"GET_HALO2_DF beg:PSRC")
 
@@ -2353,8 +2394,9 @@ end if
 CALL INIT_HALO_D()
 
 !$acc data present ( PSRC ) &
-!$acc present (ZNORTH2F_IN, ZSOUTH2F_IN, ZWEST2F_IN, ZEAST2F_IN) &
-!$acc present (ZNORTH2F_OUT, ZSOUTH2F_OUT, ZWEST2F_OUT, ZEAST2F_OUT)
+!$acc & present (PZNORTH2F_IN, PZSOUTH2F_IN, PZWEST2F_IN, PZEAST2F_IN) &
+!$acc & present (PZNORTH2F_OUT, PZSOUTH2F_OUT, PZWEST2F_OUT, PZEAST2F_OUT) &
+!$acc & present (PZH2F_EAST,PZH2F_WEST,PZH2F_NORTH,PZH2F_SOUTH)
 !
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -2372,10 +2414,10 @@ INB_REQ = 0
 IF (LX) THEN
    IF (.NOT. GWEST) THEN
 #ifdef MNH_GPUDIRECT
-      !$acc host_data use_device(ZWEST2F_OUT)
+      !$acc host_data use_device(PZWEST2F_OUT)
 #endif
       INB_REQ = INB_REQ + 1
-      CALL MPI_IRECV(ZWEST2F_OUT,SIZE(ZWEST2F_OUT),MNHREAL_MPI,NP_WEST-1,1000+IS_EAST,&
+      CALL MPI_IRECV(PZWEST2F_OUT,SIZE(PZWEST2F_OUT),MNHREAL_MPI,NP_WEST-1,1000+IS_EAST,&
                      NMNH_COMM_WORLD,IREQ(INB_REQ),IERR)
 #ifdef MNH_GPUDIRECT
       !$acc end host_data
@@ -2383,10 +2425,10 @@ IF (LX) THEN
    END IF
    IF (.NOT.GEAST) THEN 
 #ifdef MNH_GPUDIRECT
-      !$acc host_data use_device(ZEAST2F_OUT)
+      !$acc host_data use_device(PZEAST2F_OUT)
 #endif
       INB_REQ = INB_REQ + 1
-      CALL MPI_IRECV(ZEAST2F_OUT,SIZE(ZEAST2F_OUT),MNHREAL_MPI,NP_EAST-1,1000+IS_WEST,&
+      CALL MPI_IRECV(PZEAST2F_OUT,SIZE(PZEAST2F_OUT),MNHREAL_MPI,NP_EAST-1,1000+IS_WEST,&
                      NMNH_COMM_WORLD,IREQ(INB_REQ),IERR)
 #ifdef MNH_GPUDIRECT
       !$acc end host_data
@@ -2397,10 +2439,10 @@ END IF
 IF (LY) THEN
    IF (.NOT.GSOUTH) THEN
 #ifdef MNH_GPUDIRECT
-      !$acc host_data use_device(ZSOUTH2F_OUT)
+      !$acc host_data use_device(PZSOUTH2F_OUT)
 #endif
       INB_REQ = INB_REQ + 1
-      CALL MPI_IRECV(ZSOUTH2F_OUT,SIZE(ZSOUTH2F_OUT),MNHREAL_MPI,NP_SOUTH-1,1000+IS_NORTH,&
+      CALL MPI_IRECV(PZSOUTH2F_OUT,SIZE(PZSOUTH2F_OUT),MNHREAL_MPI,NP_SOUTH-1,1000+IS_NORTH,&
                      NMNH_COMM_WORLD,IREQ(INB_REQ),IERR)
 #ifdef MNH_GPUDIRECT
       !$acc end host_data
@@ -2408,10 +2450,10 @@ IF (LY) THEN
    ENDIF
    IF (.NOT.GNORTH) THEN
 #ifdef MNH_GPUDIRECT
-      !$acc host_data use_device(ZNORTH2F_OUT)
+      !$acc host_data use_device(PZNORTH2F_OUT)
 #endif
       INB_REQ = INB_REQ + 1
-      CALL MPI_IRECV(ZNORTH2F_OUT,SIZE(ZNORTH2F_OUT),MNHREAL_MPI,NP_NORTH-1,1000+IS_SOUTH,&
+      CALL MPI_IRECV(PZNORTH2F_OUT,SIZE(PZNORTH2F_OUT),MNHREAL_MPI,NP_NORTH-1,1000+IS_SOUTH,&
                      NMNH_COMM_WORLD,IREQ(INB_REQ),IERR)
 #ifdef MNH_GPUDIRECT
       !$acc end host_data
@@ -2426,28 +2468,28 @@ END IF
 IF (LX) THEN
    IF (.NOT. GWEST) THEN
    !$acc kernels async(IS_WEST)
-      ZWEST2F_IN ( IIB:IIB+IHALO2_1  ,    IJB:IJE  , : )  = PSRC( IIB:IIB+IHALO2_1  ,  IJB:IJE  , : )
-!!$      ZWEST2F_IN ( : , : )  = PSRC( IIB+1  , : , : )
+      PZWEST2F_IN ( KIIB:KIIB+KIHALO2_1  ,    KIJB:KIJE  , : )  = PSRC( KIIB:KIIB+KIHALO2_1  ,  KIJB:KIJE  , : )
+!!$      PZWEST2F_IN ( : , : )  = PSRC( KIIB+1  , : , : )
    !$acc end kernels
       END IF
    IF (.NOT.GEAST) THEN
    !$acc kernels async(IS_EAST)
-      ZEAST2F_IN ( IIE-IHALO2_1:IIE  ,    IJB:IJE  , : )  = PSRC( IIE-IHALO2_1:IIE  ,  IJB:IJE  , : )
-!!$      ZEAST2F_IN ( : , : )  = PSRC( IIE-1 ,  :  , : )
+      PZEAST2F_IN ( KIIE-KIHALO2_1:KIIE  ,    KIJB:KIJE  , : )  = PSRC( KIIE-KIHALO2_1:KIIE  ,  KIJB:KIJE  , : )
+!!$      PZEAST2F_IN ( : , : )  = PSRC( KIIE-1 ,  :  , : )
    !$acc end kernels
       ENDIF
 END IF
 IF (LY) THEN
    IF (.NOT.GSOUTH) THEN
    !$acc kernels async(IS_SOUTH)
-   ZSOUTH2F_IN ( IIB:IIE  ,    IJB:IJB+IHALO2_1  , : ) = PSRC( IIB:IIE  ,    IJB:IJB+IHALO2_1  , : )
-!!$      ZSOUTH2F_IN ( : , : ) = PSRC( : , IJB+1 , : )
+   PZSOUTH2F_IN ( KIIB:KIIE  ,    KIJB:KIJB+KIHALO2_1  , : ) = PSRC( KIIB:KIIE  ,    KIJB:KIJB+KIHALO2_1  , : )
+!!$      PZSOUTH2F_IN ( : , : ) = PSRC( : , KIJB+1 , : )
    !$acc end kernels
       ENDIF
    IF (.NOT.GNORTH) THEN
    !$acc kernels async(IS_NORTH)
-      ZNORTH2F_IN ( IIB:IIE  ,    IJE-IHALO2_1:IJE  , : ) = PSRC( IIB:IIE  ,    IJE-IHALO2_1:IJE  , : )
-!!$      ZNORTH2F_IN ( : , : ) = PSRC( : , IJE-1  , : )      
+      PZNORTH2F_IN ( KIIB:KIIE  ,    KIJE-KIHALO2_1:KIJE  , : ) = PSRC( KIIB:KIIE  ,    KIJE-KIHALO2_1:KIJE  , : )
+!!$      PZNORTH2F_IN ( : , : ) = PSRC( : , KIJE-1  , : )      
    !$acc end kernels
    ENDIF
 ENDIF
@@ -2460,12 +2502,12 @@ ENDIF
 IF (LX) THEN
    IF (.NOT. GWEST) THEN
 #ifdef MNH_GPUDIRECT
-      !$acc host_data use_device(ZWEST2F_IN)
+      !$acc host_data use_device(PZWEST2F_IN)
 #else
-      !$acc update host(ZWEST2F_IN)
+      !$acc update host(PZWEST2F_IN)
 #endif
       INB_REQ = INB_REQ + 1
-      CALL MPI_ISEND(ZWEST2F_IN,SIZE(ZWEST2F_IN)  ,MNHREAL_MPI,NP_WEST-1,1000+IS_WEST,&
+      CALL MPI_ISEND(PZWEST2F_IN,SIZE(PZWEST2F_IN)  ,MNHREAL_MPI,NP_WEST-1,1000+IS_WEST,&
                      NMNH_COMM_WORLD,IREQ(INB_REQ),IERR)
 #ifdef MNH_GPUDIRECT
       !$acc end host_data
@@ -2473,12 +2515,12 @@ IF (LX) THEN
    END IF
    IF (.NOT.GEAST) THEN
 #ifdef MNH_GPUDIRECT
-      !$acc host_data use_device(ZEAST2F_IN)
+      !$acc host_data use_device(PZEAST2F_IN)
 #else
-      !$acc update host(ZEAST2F_IN)
+      !$acc update host(PZEAST2F_IN)
 #endif
       INB_REQ = INB_REQ + 1
-      CALL MPI_ISEND(ZEAST2F_IN,SIZE(ZEAST2F_IN)  ,MNHREAL_MPI,NP_EAST-1,1000+IS_EAST,&
+      CALL MPI_ISEND(PZEAST2F_IN,SIZE(PZEAST2F_IN)  ,MNHREAL_MPI,NP_EAST-1,1000+IS_EAST,&
                      NMNH_COMM_WORLD,IREQ(INB_REQ),IERR)
 #ifdef MNH_GPUDIRECT
       !$acc end host_data
@@ -2489,12 +2531,12 @@ END IF
 IF (LY) THEN
    IF (.NOT.GSOUTH) THEN
 #ifdef MNH_GPUDIRECT
-      !$acc host_data use_device(ZSOUTH2F_IN)
+      !$acc host_data use_device(PZSOUTH2F_IN)
 #else
-      !$acc update host(ZSOUTH2F_IN)
+      !$acc update host(PZSOUTH2F_IN)
 #endif
       INB_REQ = INB_REQ + 1
-      CALL MPI_ISEND(ZSOUTH2F_IN,SIZE(ZSOUTH2F_IN)  ,MNHREAL_MPI,NP_SOUTH-1,1000+IS_SOUTH,&
+      CALL MPI_ISEND(PZSOUTH2F_IN,SIZE(PZSOUTH2F_IN)  ,MNHREAL_MPI,NP_SOUTH-1,1000+IS_SOUTH,&
                      NMNH_COMM_WORLD,IREQ(INB_REQ),IERR)
 #ifdef MNH_GPUDIRECT
       !$acc end host_data
@@ -2502,12 +2544,12 @@ IF (LY) THEN
    ENDIF
    IF (.NOT.GNORTH) THEN
 #ifdef MNH_GPUDIRECT
-      !$acc host_data use_device(ZNORTH2F_IN)
+      !$acc host_data use_device(PZNORTH2F_IN)
 #else
-      !$acc update host(ZNORTH2F_IN)
+      !$acc update host(PZNORTH2F_IN)
 #endif
       INB_REQ = INB_REQ + 1
-      CALL MPI_ISEND(ZNORTH2F_IN,SIZE(ZNORTH2F_IN)  ,MNHREAL_MPI,NP_NORTH-1,1000+IS_NORTH,&
+      CALL MPI_ISEND(PZNORTH2F_IN,SIZE(PZNORTH2F_IN)  ,MNHREAL_MPI,NP_NORTH-1,1000+IS_NORTH,&
                      NMNH_COMM_WORLD,IREQ(INB_REQ),IERR)
 #ifdef MNH_GPUDIRECT
       !$acc end host_data
@@ -2531,44 +2573,40 @@ END IF
 IF (LX) THEN
    IF (.NOT.GWEST) THEN
 #ifndef MNH_GPUDIRECT
-   !$acc update device(ZWEST2F_OUT) async(IS_WEST)
+   !$acc update device(PZWEST2F_OUT) async(IS_WEST)
 #endif
-   ZH2F_WEST => TP_PSRC_HALO2F_ll%HALO2%WEST  
    !$acc kernels async(IS_WEST)
-   PSRC( 1:IIB-1  ,      IJB:IJE      , : ) = ZWEST2F_OUT( 1:IIB-1  ,   IJB:IJE    , : )
-   ZH2F_WEST( IJB:IJE , : ) = ZWEST2F_OUT( IIB-2, IJB:IJE , : )      
+   PSRC( 1:KIIB-1  ,      KIJB:KIJE      , : ) = PZWEST2F_OUT( 1:KIIB-1  ,   KIJB:KIJE    , : )
+   PZH2F_WEST( KIJB:KIJE , : ) = PZWEST2F_OUT( KIIB-2, KIJB:KIJE , : )      
    !$acc end kernels
    ENDIF
    IF (.NOT.GEAST) THEN
 #ifndef MNH_GPUDIRECT
-   !$acc update device(ZEAST2F_OUT) async(IS_EAST)
+   !$acc update device(PZEAST2F_OUT) async(IS_EAST)
 #endif
-   ZH2F_EAST => TP_PSRC_HALO2F_ll%HALO2%EAST
    !$acc kernels async(IS_EAST)
-   PSRC( IIE+1:IIU  ,      IJB:IJE      , : ) = ZEAST2F_OUT( IIE+1:IIU  ,   IJB:IJE    , : )
-   ZH2F_EAST( IJB:IJE , : ) = ZEAST2F_OUT( IIE+2 , IJB:IJE , : )
+   PSRC( KIIE+1:KIIU  ,      KIJB:KIJE      , : ) = PZEAST2F_OUT( KIIE+1:KIIU  ,   KIJB:KIJE    , : )
+   PZH2F_EAST( KIJB:KIJE , : ) = PZEAST2F_OUT( KIIE+2 , KIJB:KIJE , : )
    !$acc end kernels
    ENDIF
 END IF
 IF (LY) THEN
    IF (.NOT.GSOUTH) THEN
 #ifndef MNH_GPUDIRECT
-   !$acc update device(ZSOUTH2F_OUT) async(IS_SOUTH)
+   !$acc update device(PZSOUTH2F_OUT) async(IS_SOUTH)
 #endif
-   ZH2F_SOUTH => TP_PSRC_HALO2F_ll%HALO2%SOUTH    
    !$acc kernels async(IS_SOUTH)
-   PSRC(      IIB:IIE       ,  1:IJB-1 , : ) = ZSOUTH2F_OUT(  IIB:IIE     , 1:IJB-1  , : )
-   ZH2F_SOUTH( IIB:IIE , : ) = ZSOUTH2F_OUT( IIB:IIE , IJB-2 , : )  
+   PSRC(      KIIB:KIIE       ,  1:KIJB-1 , : ) = PZSOUTH2F_OUT(  KIIB:KIIE     , 1:KIJB-1  , : )
+   PZH2F_SOUTH( KIIB:KIIE , : ) = PZSOUTH2F_OUT( KIIB:KIIE , KIJB-2 , : )  
    !$acc end kernels
    ENDIF
    IF (.NOT.GNORTH) THEN
 #ifndef MNH_GPUDIRECT
-   !$acc update device(ZNORTH2F_OUT) async(IS_NORTH)
+   !$acc update device(PZNORTH2F_OUT) async(IS_NORTH)
 #endif
-   ZH2F_NORTH => TP_PSRC_HALO2F_ll%HALO2%NORTH
    !$acc kernels async(IS_NORTH)
-   PSRC(      IIB:IIE       , IJE+1:IJU , : ) = ZNORTH2F_OUT (  IIB:IIE     , IJE+1:IJU  , : )
-   ZH2F_NORTH( IIB:IIE , : ) = ZNORTH2F_OUT ( IIB:IIE , IJE+2 , : )      
+   PSRC(      KIIB:KIIE       , KIJE+1:KIJU , : ) = PZNORTH2F_OUT (  KIIB:KIIE     , KIJE+1:KIJU  , : )
+   PZH2F_NORTH( KIIB:KIIE , : ) = PZNORTH2F_OUT ( KIIB:KIIE , KIJE+2 , : )      
    !$acc end kernels
    ENDIF
 END IF
@@ -2578,6 +2616,8 @@ END IF
 
 CALL MPPDB_CHECK(PSRC,"GET_HALO2_DF end:PSRC")
 
+END SUBROUTINE GET_HALO2_DF_DIM
+
 END SUBROUTINE GET_HALO2_DF
 !
 !     ###################################################
-- 
GitLab