Skip to content
Snippets Groups Projects
Commit 9f71dc0f authored by WAUTELET Philippe's avatar WAUTELET Philippe
Browse files

Philippe 24/05/2022: OpenACC Cray: add present_cr + move present for optional argument

parent ee1cba5b
No related branches found
No related tags found
No related merge requests found
......@@ -370,6 +370,7 @@ INTEGER :: IKE, IKTE !
!
INTEGER :: IDX, JI, JJ, JK
INTEGER :: IMICRO ! Case r_x>0 locations
INTEGER :: JIU,JJU,JKU
#ifndef MNH_OPENACC
INTEGER, DIMENSION(:), allocatable :: I1,I2,I3 ! Used to replace the COUNT
INTEGER :: JL ! and PACK intrinsics
......@@ -729,6 +730,10 @@ END IF
imicro = count(odmicro)
!$acc end kernels
JIU = SIZE( ptht, 1 )
JJU = SIZE( ptht, 2 )
JKU = SIZE( ptht, 3 )
#ifndef MNH_OPENACC
allocate( i1(imicro ) )
allocate( i2(imicro ) )
......@@ -737,22 +742,22 @@ allocate( i3(imicro ) )
allocate( zw(size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
allocate( zt(size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
allocate( zz_rvheni_mr(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
allocate( zz_rvheni (size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
allocate( zz_lvfact (size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
allocate( zz_lsfact (size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
allocate( zlsfact3d (size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
allocate( zz_rvheni_mr(jiu, jju, jku ) )
allocate( zz_rvheni (jiu, jju, jku ) )
allocate( zz_lvfact (jiu, jju, jku ) )
allocate( zz_lsfact (jiu, jju, jku ) )
allocate( zlsfact3d (jiu, jju, jku ) )
allocate( ZHLC_HCF3D(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
allocate( ZHLC_LCF3D(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
allocate( ZHLC_HRC3D(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
allocate( ZHLC_LRC3D(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
allocate( ZHLI_HCF3D(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
allocate( ZHLI_LCF3D(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
allocate( ZHLI_HRI3D(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
allocate( ZHLI_LRI3D(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
allocate( ZHLC_HCF3D(jiu, jju, jku ) )
allocate( ZHLC_LCF3D(jiu, jju, jku ) )
allocate( ZHLC_HRC3D(jiu, jju, jku ) )
allocate( ZHLC_LRC3D(jiu, jju, jku ) )
allocate( ZHLI_HCF3D(jiu, jju, jku ) )
allocate( ZHLI_LCF3D(jiu, jju, jku ) )
allocate( ZHLI_HRI3D(jiu, jju, jku ) )
allocate( ZHLI_LRI3D(jiu, jju, jku ) )
allocate( zinpri(size( ptht, 1 ), size( ptht, 2 ) ) )
allocate( zinpri(jiu, jju ) )
allocate( zrvt (imicro ) )
allocate( zrct (imicro ) )
......@@ -925,14 +930,14 @@ allocate( zrh_tend(imicro, 10 ) )
allocate( zssi(imicro ) )
allocate( zw_rvs(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
allocate( zw_rcs(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
allocate( zw_rrs(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
allocate( zw_ris(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
allocate( zw_rss(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
allocate( zw_rgs(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
allocate( zw_rhs(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
allocate( zw_ths(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
allocate( zw_rvs(jiu, jju, jku ) )
allocate( zw_rcs(jiu, jju, jku ) )
allocate( zw_rrs(jiu, jju, jku ) )
allocate( zw_ris(jiu, jju, jku ) )
allocate( zw_rss(jiu, jju, jku ) )
allocate( zw_rgs(jiu, jju, jku ) )
allocate( zw_rhs(jiu, jju, jku ) )
allocate( zw_ths(jiu, jju, jku ) )
#else
!Pin positions in the pools of MNH memory
CALL MNH_MEM_POSITION_PIN()
......@@ -944,22 +949,22 @@ CALL MNH_MEM_GET( i3, imicro )
CALL MNH_MEM_GET( zw, size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) )
CALL MNH_MEM_GET( zt, size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) )
CALL MNH_MEM_GET( zz_rvheni_mr, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
CALL MNH_MEM_GET( zz_rvheni, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
CALL MNH_MEM_GET( zz_lvfact, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
CALL MNH_MEM_GET( zz_lsfact, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
CALL MNH_MEM_GET( zlsfact3d, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
CALL MNH_MEM_GET( zz_rvheni_mr, jiu, jju, jku )
CALL MNH_MEM_GET( zz_rvheni, jiu, jju, jku )
CALL MNH_MEM_GET( zz_lvfact, jiu, jju, jku )
CALL MNH_MEM_GET( zz_lsfact, jiu, jju, jku )
CALL MNH_MEM_GET( zlsfact3d, jiu, jju, jku )
CALL MNH_MEM_GET( ZHLC_HCF3D, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
CALL MNH_MEM_GET( ZHLC_LCF3D, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
CALL MNH_MEM_GET( ZHLC_HRC3D, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
CALL MNH_MEM_GET( ZHLC_LRC3D, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
CALL MNH_MEM_GET( ZHLI_HCF3D, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
CALL MNH_MEM_GET( ZHLI_LCF3D, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
CALL MNH_MEM_GET( ZHLI_HRI3D, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
CALL MNH_MEM_GET( ZHLI_LRI3D, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
CALL MNH_MEM_GET( ZHLC_HCF3D, jiu, jju, jku )
CALL MNH_MEM_GET( ZHLC_LCF3D, jiu, jju, jku )
CALL MNH_MEM_GET( ZHLC_HRC3D, jiu, jju, jku )
CALL MNH_MEM_GET( ZHLC_LRC3D, jiu, jju, jku )
CALL MNH_MEM_GET( ZHLI_HCF3D, jiu, jju, jku )
CALL MNH_MEM_GET( ZHLI_LCF3D, jiu, jju, jku )
CALL MNH_MEM_GET( ZHLI_HRI3D, jiu, jju, jku )
CALL MNH_MEM_GET( ZHLI_LRI3D, jiu, jju, jku )
CALL MNH_MEM_GET( zinpri, size( ptht, 1 ), size( ptht, 2 ) )
CALL MNH_MEM_GET( zinpri, jiu, jju )
CALL MNH_MEM_GET( zrvt , imicro )
CALL MNH_MEM_GET( zrct , imicro )
......@@ -1132,14 +1137,14 @@ CALL MNH_MEM_GET( zrh_tend, imicro, 10 )
CALL MNH_MEM_GET( zssi, imicro )
CALL MNH_MEM_GET( zw_rvs, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
CALL MNH_MEM_GET( zw_rcs, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
CALL MNH_MEM_GET( zw_rrs, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
CALL MNH_MEM_GET( zw_ris, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
CALL MNH_MEM_GET( zw_rss, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
CALL MNH_MEM_GET( zw_rgs, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
CALL MNH_MEM_GET( zw_rhs, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
CALL MNH_MEM_GET( zw_ths, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
CALL MNH_MEM_GET( zw_rvs, jiu, jju, jku )
CALL MNH_MEM_GET( zw_rcs, jiu, jju, jku )
CALL MNH_MEM_GET( zw_rrs, jiu, jju, jku )
CALL MNH_MEM_GET( zw_ris, jiu, jju, jku )
CALL MNH_MEM_GET( zw_rss, jiu, jju, jku )
CALL MNH_MEM_GET( zw_rgs, jiu, jju, jku )
CALL MNH_MEM_GET( zw_rhs, jiu, jju, jku )
CALL MNH_MEM_GET( zw_ths, jiu, jju, jku )
!$acc data present( I1, I2, I3, &
!$acc & ZW, ZT, ZZ_RVHENI_MR, ZZ_RVHENI, ZZ_LVFACT, ZZ_LSFACT, ZLSFACT3D, ZINPRI, &
......@@ -1163,8 +1168,8 @@ CALL MNH_MEM_GET( zw_ths, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
!$acc & ZA_TH, ZA_RV, ZA_RC, ZA_RR, ZA_RI, ZA_RS, ZA_RG, ZA_RH, &
!$acc & ZB_TH, ZB_RV, ZB_RC, ZB_RR, ZB_RI, ZB_RS, ZB_RG, ZB_RH, &
!$acc & ZEXT_RV, ZEXT_RC, ZEXT_RR, ZEXT_RI, ZEXT_RS, ZEXT_RG, ZEXT_RH, ZEXT_TH, &
!$acc & IITER, ZTIME, ZMAXTIME, ZTIME_THRESHOLD, ZTIME_LASTCALL, ZW1D, ZCOMPUTE, GDNOTMICRO, &
!$acc & ZRS_TEND, ZRG_TEND, ZRH_TEND, ZSSI, ZW_RVS, ZW_RCS, ZW_RRS, ZW_RIS, ZW_RSS, ZW_RGS, ZW_RHS, ZW_THS )
!$acc & IITER, ZTIME, ZMAXTIME, ZTIME_THRESHOLD, ZTIME_LASTCALL, ZW1D, ZCOMPUTE, GDNOTMICRO, &
!$acc & ZRS_TEND, ZRG_TEND, ZRH_TEND, ZSSI, ZW_RVS, ZW_RCS, ZW_RRS, ZW_RIS, ZW_RSS, ZW_RGS, ZW_RHS, ZW_THS )
#endif
!-------------------------------------------------------------------------------
......@@ -1178,7 +1183,8 @@ end if
! -----------------------
!
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
!$acc kernels
!$acc kernels present_cr( ZRS_TEND, ZRG_TEND, ZRH_TEND, ZRCHONI, ZRVDEPS, ZRIAGGS, ZRIAUTS, ZRVDEPG, ZRCAUTR, ZRCACCR, ZRREVAV, &
!$acc & ZRSMLTG, ZRCMLTSR, ZRICFRRG, ZRRCFRIG, ZRICFRR, ZRGMLTR, ZRHMLTR, ZRCBERI )
IKB=KKA+JPVEXT*KKL
IKE=KKU-JPVEXT*KKL
IKTB=1+JPVEXT
......@@ -1363,7 +1369,14 @@ CALL COUNTJV_DEVICE(ODMICRO(:,:,:),I1(:),I2(:),I3(:),IMICRO)
!Packing
GTEST=.false.
IF(HSUBG_AUCV_RC=='PDF ' .AND. CSUBG_PR_PDF=='SIGM') GTEST=.true.
!$acc kernels
!$acc kernels present_cr( ZSIGMA_RC, ZRHT, ZEXT_RH, &
!$acc & ZTOT_RVHENI, ZTOT_RCHONI, ZTOT_RRHONG, ZTOT_RVDEPS, ZTOT_RIAGGS, ZTOT_RIAUTS, ZTOT_RVDEPG, ZTOT_RCAUTR, &
!$acc & ZTOT_RCACCR, ZTOT_RREVAV, ZTOT_RCRIMSS, ZTOT_RCRIMSG, ZTOT_RSRIMCG, ZTOT_RIMLTC, ZTOT_RCBERI, ZTOT_RHMLTR, &
!$acc & ZTOT_RSMLTG, ZTOT_RCMLTSR, ZTOT_RRACCSS, ZTOT_RRACCSG, ZTOT_RSACCRG, ZTOT_RICFRRG, ZTOT_RRCFRIG, &
!$acc & ZTOT_RICFRR, ZTOT_RCWETG, ZTOT_RIWETG, ZTOT_RRWETG, ZTOT_RSWETG, ZTOT_RCDRYG, ZTOT_RIDRYG, ZTOT_RRDRYG, &
!$acc & ZTOT_RSDRYG, ZTOT_RWETGH, ZTOT_RGMLTR, ZTOT_RCWETH, ZTOT_RIWETH, ZTOT_RSWETH, ZTOT_RGWETH, ZTOT_RRWETH, &
!$acc & ZTOT_RCDRYH, ZTOT_RIDRYH, ZTOT_RSDRYH, ZTOT_RRDRYH, ZTOT_RGDRYH, ZTOT_RDRYHG )
IF(IMICRO>0) THEN
!$acc loop independent
DO JL=1, IMICRO
......@@ -1497,7 +1510,7 @@ IF(XTSTEP_TS/=0.)THEN
INB_ITER_MAX=MAX(NMAXITER, INB_ITER_MAX) !For the case XMRSTEP/=0. at the same time
ENDIF
!acc end kernels
!$acc kernels
!$acc kernels present_cr( IITER, ZTIME )
IITER(:)=0
ZTIME(:)=0. ! Current integration time (all points may have a different integration time)
!$acc end kernels
......@@ -1798,6 +1811,7 @@ DO WHILE(ANY(ZTIME(:)<PTSTEP)) ! Loop to *really* compute tendencies
!
!*** 4.3 New values of variables for next iteration
!
!$acc loop independent
DO JL=1, IMICRO
ZTHT(JL)=ZTHT(JL)+ZA_TH(JL)*ZMAXTIME(JL)+ZB_TH(JL)
ZRVT(JL)=ZRVT(JL)+ZA_RV(JL)*ZMAXTIME(JL)+ZB_RV(JL)
......@@ -1876,7 +1890,7 @@ ENDDO
!
! !$acc kernels
IF(IMICRO>0) THEN
!$acc kernels
!$acc kernels present_cr( ZHLC_HCF3D, ZHLC_LCF3D, ZHLC_HRC3D, ZHLC_LRC3D, ZHLI_HCF3D, ZHLI_LCF3D, ZHLI_HRI3D, ZHLI_LRI3D )
ZHLC_HCF3D(:,:,:)=0.
ZHLC_LCF3D(:,:,:)=0.
ZHLC_HRC3D(:,:,:)=0.
......@@ -1899,7 +1913,7 @@ IF(IMICRO>0) THEN
END DO
!$acc end kernels
ELSE
!$acc kernels
!$acc kernels present_cr( PRAINFR, ZHLC_HCF3D, ZHLC_LCF3D, ZHLC_HRC3D, ZHLC_LRC3D, ZHLI_HCF3D, ZHLI_LCF3D, ZHLI_HRI3D, ZHLI_LRI3D, PCIT )
PRAINFR(:,:,:)=0.
ZHLC_HCF3D(:,:,:)=0.
ZHLC_LCF3D(:,:,:)=0.
......@@ -1912,7 +1926,7 @@ ELSE
PCIT(:,:,:) = 0.
!$acc end kernels
ENDIF
!$acc kernels
!$acc kernels present_cr( PEVAP3D )
IF(OWARM) THEN
PEVAP3D(:,:,:) = 0.
!$acc loop independent
......@@ -2685,7 +2699,6 @@ CONTAINS
REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZW
#endif
!
!$acc data present( PRV, PRC, PRR, PRI, PRS, PRG, PTH, PLVFACT, PLSFACT, PRH )
!
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
......@@ -2702,6 +2715,8 @@ CONTAINS
CALL MPPDB_CHECK(PTH,"CORRECT_NEGATIVITIES beg:PTH")
END IF
!$acc data present( PRV, PRC, PRR, PRI, PRS, PRG, PTH, PLVFACT, PLSFACT )
#ifndef MNH_OPENACC
allocate( gw(size( prv, 1 ), size( prv, 2 ), size( prv, 3 ) ) )
allocate( zw(size( prv, 1 ), size( prv, 2 ), size( prv, 3 ) ) )
......@@ -2750,6 +2765,7 @@ CONTAINS
ENDDO
IF(KRR==7) THEN
!$acc data present( PRH )
DO JK = 1, KKT
DO JJ = 1, KJT
DO JI = 1, KIT
......@@ -2760,6 +2776,7 @@ CONTAINS
ENDDO
ENDDO
ENDDO
!$acc end data
ENDIF
! 2) deal with negative vapor mixing ratio
......@@ -2797,6 +2814,7 @@ CONTAINS
ENDDO
IF(KRR==7) THEN
!$acc data present( PRH )
DO JK = 1, KKT
DO JJ = 1, KJT
DO JI = 1, KIT
......@@ -2808,6 +2826,7 @@ CONTAINS
ENDDO
ENDDO
ENDDO
!$acc end data
ENDIF
!$acc end kernels
......@@ -2818,6 +2837,8 @@ CONTAINS
CALL MNH_MEM_RELEASE()
#endif
!$acc end data
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
CALL MPPDB_CHECK(PRV,"CORRECT_NEGATIVITIES end:PRV")
......@@ -2830,8 +2851,6 @@ CONTAINS
CALL MPPDB_CHECK(PTH,"CORRECT_NEGATIVITIES end:PTH")
END IF
!$acc end data
END SUBROUTINE CORRECT_NEGATIVITIES
!
END SUBROUTINE RAIN_ICE_RED
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment