Philippe 21/11/2019: OpenACC: misc modifications

src/MNH/advecuvw_4th.f90

@@ -220,9 +220,9 @@ INTEGER :: IGRID ! localisation on the model grid
 #ifndef MNH_OPENACC
 REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZMEANX, ZMEANY ! fluxes
 #else
-REAL, DIMENSION(IIU,IJU,IKU) :: ZMEANX, ZMEANY ! fluxes
+REAL, DIMENSION(:,:,:) :: ZMEANX, ZMEANY ! fluxes
 !
-REAL, DIMENSION(IIU,IJU,IKU) :: ZTEMP1,ZTEMP2,ZTEMP3,ZTEMP4
+REAL, DIMENSION(:,:,:) :: ZTEMP1,ZTEMP2,ZTEMP3,ZTEMP4
 
 INTEGER                                              :: II
 #endif

src/MNH/ppm.f90

@@ -2536,25 +2536,29 @@ INTEGER:: IIE,IJE    ! End useful area in x,y,z directions
 INTEGER                          :: IJS,IJN
 !
 LOGICAL :: GWEST, GEAST
-#endif
+
 ! advection fluxes
 REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZFPOS, ZFNEG
 !
 ! variable at cell edges
 REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZPHAT
 !
-!BEG JUAN PPM_LL
-TYPE(HALO2LIST_ll), POINTER      :: TZ_PSRC_HALO2_ll         ! halo2 for PSRC
-!END JUAN PPM_LL
+REAL, DIMENSION(SIZE(PCR,2),SIZE(PCR,3))             :: ZPSRC_HALO2_WEST
+#else
+! advection fluxes
+REAL, DIMENSION(:,:,:) :: ZFPOS, ZFNEG
 !
-#ifdef _OPENACC
-!JUAN ACC
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZRHO_MXM, ZCR_MXM  , ZCR_DXF
-INTEGER                          :: I,J,K 
+! variable at cell edges
+REAL, DIMENSION(:,:,:) :: ZPHAT
 !
-!JUAN ACC
+REAL, DIMENSION(:,:,:) :: ZRHO_MXM, ZCR_MXM  , ZCR_DXF
+INTEGER                          :: I,J,K
+!
+REAL, DIMENSION(:,:)             :: ZPSRC_HALO2_WEST
 #endif
-REAL, DIMENSION(SIZE(PCR,2),SIZE(PCR,3))             :: ZPSRC_HALO2_WEST
+
+TYPE(HALO2LIST_ll), POINTER      :: TZ_PSRC_HALO2_ll         ! halo2 for PSRC
+
 !-------------------------------------------------------------------------------
 
 !$acc data present( PSRC, PCR, PRHO, PR , &
@@ -2968,7 +2972,6 @@ INTEGER                          :: IJS,IJN
 INTEGER                          :: IIW,IIA
 !
 LOGICAL :: GNORTH, GSOUTH
-#endif
 !
 ! advection fluxes
 REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZFPOS, ZFNEG
@@ -2976,18 +2979,27 @@ REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZFPOS, ZFNEG
 ! variable at cell edges
 REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZPHAT
 !
-!BEG JUAN PPM_LL
 TYPE(HALO2LIST_ll), POINTER      :: TZ_PSRC_HALO2_ll         ! halo2 for PSRC
 TYPE(HALO2LIST_ll), POINTER      :: TZ_PHAT_HALO2_ll         ! halo2 for ZPHAT
-!END JUAN PPM_LL
-#ifdef _OPENACC
 !
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZRHO_MYM , ZCR_MYM , ZCR_DYF
+REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,3))             :: ZPSRC_HALO2_SOUTH
+#else
+!
+! advection fluxes
+REAL, DIMENSION(:,:,:) :: ZFPOS, ZFNEG
+!
+! variable at cell edges
+REAL, DIMENSION(:,:,:) :: ZPHAT
+!
+TYPE(HALO2LIST_ll), POINTER      :: TZ_PSRC_HALO2_ll         ! halo2 for PSRC
+TYPE(HALO2LIST_ll), POINTER      :: TZ_PHAT_HALO2_ll         ! halo2 for ZPHAT
+!
+REAL, DIMENSION(:,:,:) :: ZRHO_MYM , ZCR_MYM , ZCR_DYF
 !
 INTEGER                          :: I,J,K
 !
+REAL, DIMENSION(:,:)             :: ZPSRC_HALO2_SOUTH
 #endif
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,3))             :: ZPSRC_HALO2_SOUTH
 !
 !-------------------------------------------------------------------------------
 

src/MNH/prandtl.f90

@@ -471,10 +471,6 @@ END DO
 !
 IF(HTURBDIM=='1DIM') THEN        ! 1D case
 !
-#ifdef MNH_OPENACC
-call Print_msg( NVERB_WARNING, 'GEN', 'PRANDTL', 'OpenACC: 1DIM not yet tested' )
-#endif
-!
 !$acc kernels async
 #ifndef MNH_BITREP
   PRED2TH3(:,:,:)  = PREDTH1(:,:,:)**2

src/MNH/resolved_cloud.f90

@@ -441,7 +441,7 @@ REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA  ! Land Sea mask
 REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
 !
 ! Variables from modules
-!$acc declare copyin(CSEDIM)
+! !$acc declare copyin(CSEDIM)
 !
 !*       0.2   Declarations of local variables :
 !
@@ -762,14 +762,32 @@ END IF
 SELECT CASE ( HCLOUD )
   CASE('KESS')
 #ifdef MNH_OPENACC
-CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','KESS not yet implemented')
+CALL PRINT_MSG(NVERB_WARNING,'GEN','RESOLVED_CLOUD','KESS being implemented')
 #endif
+#ifndef MNH_OPENACC
     WHERE (PRS(:,:,:,2) < 0.)
       PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,2)
       PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,2) * ZLV(:,:,:) /  &
            ZCPH(:,:,:) / PEXNREF(:,:,:)
       PRS(:,:,:,2) = 0.0
     END WHERE
+#else
+!$acc kernels
+!$acc loop independent collapse(3)
+    DO JK=1,SIZE(PRS,3)
+      DO JJ=1,SIZE(PRS,2)
+        DO JI=1,SIZE(PRS,1)
+          IF (PRS(JI,JJ,JK,2) < 0.) THEN
+            PRS(JI, JJ, JK , 1) = PRS(JI, JJ, JK , 1) + PRS(JI, JJ, JK , 2)
+            PTHS(JI, JJ, JK ) = PTHS(JI, JJ, JK ) - PRS(JI, JJ, JK , 2) * ZLV(JI, JJ, JK ) &
+                                / ZCPH(JI, JJ, JK ) / PEXNREF(JI, JJ, JK )
+            PRS(JI, JJ, JK , 2) = 0.0
+          END IF
+        END DO
+      END DO
+    END DO
+!$acc end kernels
+#endif
 !
 !
 ! CASE('C2R2','KHKO')                                 
@@ -1089,7 +1107,7 @@ CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','REVE not yet implemented')
 !
   CASE ('KESS')
 #ifdef MNH_OPENACC
-CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','KESS not yet implemented')
+CALL PRINT_MSG(NVERB_WARNING,'GEN','RESOLVED_CLOUD','KESS being implemented')
 #endif
 !
 !*       5.     KESSLER MICROPHYSICAL SCHEME

src/MNH/turb.f90

@@ -762,10 +762,9 @@ SELECT CASE (HTURBLEN)
 !           ------------------
 
   CASE ('BL89')
-#ifdef MNH_OPENACC
-    call Print_msg( NVERB_FATAL, 'GEN', 'TURB', 'OpenACC: HTURBLEN=BL89 not yet implemented' )
-#endif
+!$acc kernels
     ZSHEAR(:, :, : ) = 0.
+!$acc end kernels
     CALL BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,PLEM)
 !
 !*      3.2 RM17 mixing length
@@ -1248,7 +1247,6 @@ IF ((HCLOUD == 'KHKO') .OR. (HCLOUD == 'C2R2')) THEN
  ZEXNE(:,:,:)= (PPABST(:,:,:)/XP00)**(XRD/XCPD)
  ZTT(:,:,:)= PTHLT(:,:,:)*ZEXNE(:,:,:)
  ZLV(:,:,:)=XLVTT +(XCPV-XCL) *(ZTT(:,:,:)-XTT)
- ZLS(:,:,:)=XLSTT +(XCPV-XCI) *(ZTT(:,:,:)-XTT)
  ZCPH(:,:,:)=XCPD +XCPV*PRT(:,:,:,1)
 ! CALL GET_HALO(PRRS(:,:,:,2))
 ! CALL GET_HALO(PRSVS(:,:,:,2))
@@ -1461,6 +1459,7 @@ REAL, DIMENSION(:,:), INTENT(INOUT) :: PUSLOPE,PVSLOPE
 INTEGER             :: IIB,IIE,IJB,IJE ! index values for the physical subdomain
 TYPE(LIST_ll), POINTER :: TZFIELDS_ll  ! list of fields to exchange
 INTEGER                :: IINFO_ll     ! return code of parallel routine
+logical                :: gwest, geast, gnorth, gsouth
 !
 !*        1  PROLOGUE
 !
@@ -1489,20 +1488,25 @@ CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
 !
 !        3 Boundary conditions for non cyclic case
 !
+gwest  = HLBCX(1) /= "CYCL" .AND. LWEST_ll()
+geast  = HLBCX(2) /= "CYCL" .AND. LEAST_ll()
+gsouth = HLBCY(1) /= "CYCL" .AND. LSOUTH_ll()
+gnorth = HLBCY(2) /= "CYCL" .AND. LNORTH_ll()
+
 !$acc kernels
-IF ( HLBCX(1) /= "CYCL" .AND. LWEST_ll()) THEN
+IF ( gwest ) THEN
   PUSLOPE(IIB-1,:)=PUSLOPE(IIB,:)
   PVSLOPE(IIB-1,:)=PVSLOPE(IIB,:)
 END IF
-IF ( HLBCX(2) /= "CYCL" .AND. LEAST_ll()) THEN
+IF ( geast ) THEN
   PUSLOPE(IIE+1,:)=PUSLOPE(IIE,:)
   PVSLOPE(IIE+1,:)=PVSLOPE(IIE,:)
 END IF
-IF ( HLBCY(1) /= "CYCL" .AND. LSOUTH_ll()) THEN
+IF ( gsouth ) THEN
   PUSLOPE(:,IJB-1)=PUSLOPE(:,IJB)
   PVSLOPE(:,IJB-1)=PVSLOPE(:,IJB)
 END IF
-IF(  HLBCY(2) /= "CYCL" .AND. LNORTH_ll()) THEN
+IF ( gnorth ) THEN
   PUSLOPE(:,IJE+1)=PUSLOPE(:,IJE)
   PVSLOPE(:,IJE+1)=PVSLOPE(:,IJE)
 END IF
@@ -1742,7 +1746,9 @@ ELSE
 !*         3.1 BL89 mixing length
 !           ------------------
   CASE ('BL89','RM17')
+!$acc kernels
     ZSHEAR(:, :, : ) = 0.
+!$acc end kernels
     CALL BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,ZLM_CLOUD)
 !
 !*         3.2 Delta mixing length
@@ -2073,7 +2079,7 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTMP1_DEVICE,ZTMP2_DEVICE
 #endif
 !----------------------------------------------------------------------------
 
-!$acc data present( PDXX, PDYY, PDZZ, PZZ, PDIRCOSZW, PTHLT, PTHVREF, PTKET, PSRCT, PRT, PLOCPEXNM, PLM )
+!$acc data present( PDXX, PDYY, PDZZ, PZZ, PDIRCOSZW, PTHLT, PTHVREF, PTKET, PSRCT, PRT, PLOCPEXNM, PATHETA, PAMOIST, PLM )
 
 if ( mppdb_initialized ) then
   !Check all in arrays

src/MNH/ver_interp_lin.f90

@@ -259,15 +259,12 @@ IMPLICIT NONE
 !
 !*       0.1   Declaration of arguments
 !              ------------------------
-REAL,   DIMENSION(:,:,:), INTENT(IN) :: PVAR1    ! variable values on the initial
-!                                                ! grid
+REAL,   DIMENSION(:,:,:), INTENT(IN) :: PVAR1    ! variable values on the initial grid
 INTEGER,DIMENSION(:,:,:), INTENT(IN) :: KKLIN    ! lower interpolating level of
-!                                                ! grid 1 for each level of grid 2 
+!                                                ! grid 1 for each level of grid 2
 REAL,   DIMENSION(:,:,:), INTENT(IN) :: PCOEFLIN ! coefficient for level KKLIN
 !
-REAL,   DIMENSION(SIZE(KKLIN,1),SIZE(KKLIN,2),SIZE(KKLIN,3)), INTENT(OUT)   &
-                                     :: PVAR2 ! variable values on target
-!                                             ! grid 
+REAL,   DIMENSION(:,:,:), INTENT(OUT) :: PVAR2 ! variable values on target grid
 !
 !*       0.2   Declaration of local variables
 !              ------------------------------
@@ -276,6 +273,7 @@ INTEGER                                               :: JI,JJ,JK2
 !-------------------------------------------------------------------------------
 !
 call Print_msg( NVERB_WARNING, 'GEN', 'VER_INTERP_LIN3D_DEVICE', 'OpenACC: not yet tested' )
+
 !$acc data present(PVAR1,KKLIN,PCOEFLIN,PVAR2)
 !$acc kernels
 DO JK2=1,SIZE(KKLIN,3)
@@ -434,8 +432,7 @@ INTEGER,DIMENSION(:,:), INTENT(IN) :: KKLIN    ! lower interpolating level of
 !                                              ! grid 1 for each level of grid 2 
 REAL,   DIMENSION(:,:), INTENT(IN) :: PCOEFLIN ! coefficient for level KKLIN
 !
-REAL,   DIMENSION(SIZE(KKLIN,1),SIZE(KKLIN,2)), INTENT(OUT) :: PVAR2 ! variable values on
-!                                                                    ! target grid 
+REAL,   DIMENSION(:,:), INTENT(OUT) :: PVAR2 ! variable values on target grid
 !
 !*       0.2   Declaration of local variables
 !              ------------------------------
@@ -616,7 +613,7 @@ INTEGER,DIMENSION(:), INTENT(IN) :: KKLIN    ! lower interpolating level of
 !                                            ! grid 1 for each level of grid 2 
 REAL,   DIMENSION(:), INTENT(IN) :: PCOEFLIN ! coefficient for level KKLIN
 
-REAL,   DIMENSION(SIZE(KKLIN)), INTENT(OUT) :: PVAR2 ! variable values on target
+REAL,   DIMENSION(:), INTENT(OUT) :: PVAR2 ! variable values on target
 !                                                    ! grid 
 !
 !*       0.2   Declaration of local variables