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

Juan 14/09/2020 : resolved_cloud.f90 , more PGI BUG correction -> use MNH_ALLOCATE

parent a243fff2
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
src/MNH/resolved_cloud.f90
+ 110
− 40
View file @ a84e32c8
...@@ -325,6 +325,10 @@ USE MODI_SHUMAN ...@@ -325,6 +325,10 @@ USE MODI_SHUMAN
USE MODI_SHUMAN_DEVICE USE MODI_SHUMAN_DEVICE
#endif #endif
USE MODI_SLOW_TERMS USE MODI_SLOW_TERMS
#ifdef MNH_OPENACC
USE MODE_MNH_ZWORK , ONLY : MNH_ALLOCATE_ZT3D , MNH_REL_ZT3D, MNH_ALLOCATE_ZT4D , MNH_REL_ZT4D , MNH_ALLOCATE_ZT2D , &
MNH_ALLOCATE_GT3D , MNH_REL_GT3D
#endif
! !
IMPLICIT NONE IMPLICIT NONE
! !
...@@ -454,11 +458,18 @@ INTEGER :: IKL ...@@ -454,11 +458,18 @@ INTEGER :: IKL
INTEGER :: IINFO_ll ! return code of parallel routine INTEGER :: IINFO_ll ! return code of parallel routine
INTEGER :: JI,JJ,JK,JL INTEGER :: JI,JJ,JK,JL
! !
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDZZ REAL, DIMENSION(:,:,:), POINTER , CONTIGUOUS :: ZDZZ
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZT,ZEXN,ZLV,ZLS,ZCPH REAL, DIMENSION(:,:,:), POINTER , CONTIGUOUS :: ZT
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCOR REAL, DIMENSION(:,:,:), POINTER , CONTIGUOUS :: ZEXN
REAL, DIMENSION(:,:,:), POINTER , CONTIGUOUS :: ZLV
REAL, DIMENSION(:,:,:), POINTER , CONTIGUOUS :: ZLS
REAL, DIMENSION(:,:,:), POINTER , CONTIGUOUS :: ZCPH
REAL, DIMENSION(:,:,:), POINTER , CONTIGUOUS :: ZCOR
INTEGER :: IZDZZ,IZT,IZEXN,IZLV,IZLS,IZCPH,IZCOR
!
! for the correction of negative rv ! for the correction of negative rv
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZZZ REAL, DIMENSION(:,:,:), POINTER , CONTIGUOUS :: ZZZ
INTEGER :: IZZZ
! model layer height ! model layer height
REAL :: ZMASSTOT ! total mass for one water category REAL :: ZMASSTOT ! total mass for one water category
! including the negative values ! including the negative values
...@@ -468,18 +479,22 @@ REAL :: ZRATIO ! ZMASSTOT / ZMASSCOR ...@@ -468,18 +479,22 @@ REAL :: ZRATIO ! ZMASSTOT / ZMASSCOR
! !
INTEGER :: ISVBEG ! first scalar index for microphysics INTEGER :: ISVBEG ! first scalar index for microphysics
INTEGER :: ISVEND ! last scalar index for microphysics INTEGER :: ISVEND ! last scalar index for microphysics
REAL, DIMENSION(:), ALLOCATABLE :: ZRSMIN ! Minimum value for tendencies REAL, DIMENSION(:), ALLOCATABLE :: ZRSMIN ! Minimum value for tendencies
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSVT ! scalar variable for microphysics only REAL, DIMENSION(:,:,:,:), POINTER , CONTIGUOUS :: ZSVT ! scalar variable for microphysics only
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSVS ! scalar tendency for microphysics only REAL, DIMENSION(:,:,:,:), POINTER , CONTIGUOUS :: ZSVS ! scalar tendency for microphysics only
LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: LLMICRO ! mask to limit computation LOGICAL, DIMENSION(:,:,:), POINTER , CONTIGUOUS :: LLMICRO ! mask to limit computation
INTEGER :: IZSVT,IZSVS,ILLMICRO
! REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3), KRR) :: ZFPR ! REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3), KRR) :: ZFPR
! !
INTEGER :: JMOD, JMOD_IFN INTEGER :: JMOD, JMOD_IFN
LOGICAL :: GWEST,GEAST,GNORTH,GSOUTH LOGICAL :: GWEST,GEAST,GNORTH,GSOUTH
! BVIE work array waiting for PINPRI ! BVIE work array waiting for PINPRI
REAL, DIMENSION(:,:), ALLOCATABLE :: ZINPRI REAL, DIMENSION(:,:), POINTER , CONTIGUOUS :: ZINPRI
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHSSTEP REAL, DIMENSION(:,:,:), POINTER , CONTIGUOUS :: ZTHSSTEP
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZRSSTEP REAL, DIMENSION(:,:,:,:), POINTER , CONTIGUOUS :: ZRSSTEP
INTEGER :: IZINPRI,IZTHSSTEP,IZRSSTEP
!
INTEGER :: JIU,JJU,JKU
! !
!------------------------------------------------------------------------------ !------------------------------------------------------------------------------
! !
...@@ -549,20 +564,40 @@ IF (MPPDB_INITIALIZED) THEN ...@@ -549,20 +564,40 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PSSPRO,"RESOLVED_CLOUD beg:PSSPRO") CALL MPPDB_CHECK(PSSPRO,"RESOLVED_CLOUD beg:PSSPRO")
END IF END IF
! !
allocate ( LLMICRO ( SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3) ) ) JIU = size(PZZ, 1 )
allocate ( ZDZZ ( SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3) ) ) JJU = size(PZZ, 2 )
allocate ( ZT ( SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3) ) ) JKU = size(PZZ, 3 )
allocate ( ZEXN ( SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3) ) ) !
allocate ( ZLV ( SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3) ) ) #ifndef MNH_OPENACC
allocate ( ZLS ( SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3) ) ) allocate ( LLMICRO ( JIU,JJU,JKU ) )
allocate ( ZCPH ( SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3) ) ) allocate ( ZDZZ ( JIU,JJU,JKU ) )
allocate ( ZCOR ( SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3) ) ) allocate ( ZT ( JIU,JJU,JKU ) )
allocate ( ZZZ ( SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3) ) ) allocate ( ZEXN ( JIU,JJU,JKU ) )
allocate ( ZINPRI ( SIZE(PZZ,1), SIZE(PZZ,2) ) ) allocate ( ZLV ( JIU,JJU,JKU ) )
allocate ( ZLS ( JIU,JJU,JKU ) )
allocate ( ZCPH ( JIU,JJU,JKU ) )
allocate ( ZCOR ( JIU,JJU,JKU ) )
allocate ( ZZZ ( JIU,JJU,JKU ) )
allocate ( ZINPRI ( JIU,JJU ) )
allocate ( ZTHSSTEP ( SIZE(PTHS,1), SIZE(PTHS,2), SIZE(PTHS,3) ) ) allocate ( ZTHSSTEP ( SIZE(PTHS,1), SIZE(PTHS,2), SIZE(PTHS,3) ) )
allocate ( ZRSSTEP ( SIZE(PRS,1), SIZE(PRS,2), SIZE(PRS,3), SIZE(PRS,4) ) ) allocate ( ZRSSTEP ( SIZE(PRS,1), SIZE(PRS,2), SIZE(PRS,3), SIZE(PRS,4) ) )
#else
ILLMICRO = MNH_ALLOCATE_GT3D ( LLMICRO ,JIU,JJU,JKU )
IZDZZ = MNH_ALLOCATE_ZT3D ( ZDZZ ,JIU,JJU,JKU )
IZT = MNH_ALLOCATE_ZT3D ( ZT ,JIU,JJU,JKU )
IZEXN = MNH_ALLOCATE_ZT3D ( ZEXN ,JIU,JJU,JKU )
IZLV = MNH_ALLOCATE_ZT3D ( ZLV ,JIU,JJU,JKU )
IZLS = MNH_ALLOCATE_ZT3D ( ZLS ,JIU,JJU,JKU )
IZCPH = MNH_ALLOCATE_ZT3D ( ZCPH ,JIU,JJU,JKU )
IZCOR = MNH_ALLOCATE_ZT3D ( ZCOR ,JIU,JJU,JKU )
IZZZ = MNH_ALLOCATE_ZT3D ( ZZZ ,JIU,JJU,JKU )
IZINPRI = MNH_ALLOCATE_ZT2D ( ZINPRI ,JIU,JJU )
IZTHSSTEP = MNH_ALLOCATE_ZT3D ( ZTHSSTEP , SIZE(PTHS,1), SIZE(PTHS,2), SIZE(PTHS,3) )
IZRSSTEP = MNH_ALLOCATE_ZT4D ( ZRSSTEP , SIZE(PRS,1), SIZE(PRS,2), SIZE(PRS,3), SIZE(PRS,4) )
#endif
!$acc data create(LLMICRO,ZDZZ,ZT,ZEXN,ZLV,ZLS,ZCPH,ZCOR,ZZZ,ZINPRI,ZTHSSTEP,ZRSSTEP) !$acc data present(LLMICRO,ZDZZ,ZT,ZEXN,ZLV,ZLS,ZCPH,ZCOR,ZZZ,ZINPRI,ZTHSSTEP,ZRSSTEP)
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE) CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
IKA=1 IKA=1
...@@ -592,9 +627,14 @@ ELSE ...@@ -592,9 +627,14 @@ ELSE
END IF END IF
! !
IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA') THEN IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA') THEN
#ifndef MNH_OPENACC
ALLOCATE(ZSVT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3),ISVEND - ISVBEG + 1)) ALLOCATE(ZSVT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3),ISVEND - ISVBEG + 1))
ALLOCATE(ZSVS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3),ISVEND - ISVBEG + 1)) ALLOCATE(ZSVS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3),ISVEND - ISVBEG + 1))
!$acc enter data create(ZSVT,ZSVS) #else
IZSVT = MNH_ALLOCATE_ZT4D(ZSVT ,SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3),ISVEND - ISVBEG + 1 )
IZSVS = MNH_ALLOCATE_ZT4D(ZSVS ,SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3),ISVEND - ISVBEG + 1 )
! acc enter data create(ZSVT,ZSVS)
#endif
ZSVT(:,:,:,:) = PSVT(:,:,:,ISVBEG:ISVEND) ZSVT(:,:,:,:) = PSVT(:,:,:,ISVBEG:ISVEND)
ZSVS(:,:,:,:) = PSVS(:,:,:,ISVBEG:ISVEND) ZSVS(:,:,:,:) = PSVS(:,:,:,ISVBEG:ISVEND)
END IF END IF
...@@ -609,11 +649,12 @@ END IF ...@@ -609,11 +649,12 @@ END IF
!* 2. TRANSFORMATION INTO PHYSICAL TENDENCIES !* 2. TRANSFORMATION INTO PHYSICAL TENDENCIES
! --------------------------------------- ! ---------------------------------------
! !
!$acc kernels present(PTHS,PRS,PRHODJ,PPABST,ZEXN,ZLV,ZLS,ZCPH,ZSVS) !$acc kernels ! present(PTHS,PRS,PRHODJ,PPABST,ZEXN,ZLV,ZLS,ZCPH,ZSVS)
PTHS(:,:,:) = PTHS(:,:,:) / PRHODJ(:,:,:) PTHS(:,:,:) = PTHS(:,:,:) / PRHODJ(:,:,:)
DO JRR = 1,KRR !
PRS(:,:,:,JRR) = PRS(:,:,:,JRR) / PRHODJ(:,:,:) DO CONCURRENT ( JI=1:JIU,JJ=1:JJU,JK=1:JKU ,JRR = 1:KRR )
END DO PRS(JI,JJ,JK,JRR) = PRS(JI,JJ,JK,JRR) / PRHODJ(JI,JJ,JK)
END DO ! CONCURRENT
! !
IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA') THEN IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA') THEN
DO JSV = 1,SIZE(ZSVS,4) DO JSV = 1,SIZE(ZSVS,4)
...@@ -681,15 +722,17 @@ ENDIF ...@@ -681,15 +722,17 @@ ENDIF
! microphysical routines would save ! microphysical routines would save
! computing time ! computing time
! !
DO CONCURRENT ( JI=1:JIU,JJ=1:JJU,JK=1:JKU)
#ifndef MNH_BITREP #ifndef MNH_BITREP
ZEXN(:,:,:) = (PPABST(:,:,:)/XP00) ** (XRD/XCPD) ZEXN(JI,JJ,JK) = (PPABST(JI,JJ,JK)/XP00) ** (XRD/XCPD)
#else #else
ZEXN(:,:,:) = BR_POW(PPABST(:,:,:)/XP00,XRD/XCPD) ZEXN(JI,JJ,JK) = BR_POW(PPABST(JI,JJ,JK)/XP00,XRD/XCPD)
#endif #endif
ZT(:,:,:)= PTHT(:,:,:)*ZEXN(:,:,:) ZT(JI,JJ,JK)= PTHT(JI,JJ,JK)*ZEXN(JI,JJ,JK)
ZLV(:,:,:)=XLVTT +(XCPV-XCL) *(ZT(:,:,:)-XTT) ZLV(JI,JJ,JK)=XLVTT +(XCPV-XCL) *(ZT(JI,JJ,JK)-XTT)
ZLS(:,:,:)=XLSTT +(XCPV-XCI) *(ZT(:,:,:)-XTT) ZLS(JI,JJ,JK)=XLSTT +(XCPV-XCI) *(ZT(JI,JJ,JK)-XTT)
ZCPH(:,:,:)=XCPD +XCPV*PRT(:,:,:,1) ZCPH(JI,JJ,JK)=XCPD +XCPV*PRT(JI,JJ,JK,1)
END DO ! CONCURRENT
!$acc end kernels !$acc end kernels
! !
! !
...@@ -835,7 +878,7 @@ CALL PRINT_MSG(NVERB_WARNING,'GEN','RESOLVED_CLOUD','KESS being implemented') ...@@ -835,7 +878,7 @@ CALL PRINT_MSG(NVERB_WARNING,'GEN','RESOLVED_CLOUD','KESS being implemented')
END IF END IF
#else #else
#if 1 #if 1
!$acc kernels present(PTHS,PRS,PEXNREF) present(ZLV,ZLS,ZCPH,ZCOR) !$acc kernels ! present(PTHS,PRS,PEXNREF) present(ZLV,ZLS,ZCPH,ZCOR)
!$acc loop independent collapse(3) !$acc loop independent collapse(3)
DO JK=1,SIZE(PZZ,3) DO JK=1,SIZE(PZZ,3)
DO JJ=1,SIZE(PZZ,2) DO JJ=1,SIZE(PZZ,2)
...@@ -874,7 +917,7 @@ CALL PRINT_MSG(NVERB_WARNING,'GEN','RESOLVED_CLOUD','KESS being implemented') ...@@ -874,7 +917,7 @@ CALL PRINT_MSG(NVERB_WARNING,'GEN','RESOLVED_CLOUD','KESS being implemented')
END DO END DO
!$acc end kernels !$acc end kernels
#else #else
!$acc kernels present(PTHS,PRS,PEXNREF) present(ZLV,ZLS,ZCPH,ZCOR) !$acc kernels ! present(PTHS,PRS,PEXNREF) present(ZLV,ZLS,ZCPH,ZCOR)
DO JK=1,SIZE(PZZ,3) DO JK=1,SIZE(PZZ,3)
DO JJ=1,SIZE(PZZ,2) DO JJ=1,SIZE(PZZ,2)
DO JI=1,SIZE(PZZ,1) DO JI=1,SIZE(PZZ,1)
...@@ -1474,10 +1517,17 @@ END IF ...@@ -1474,10 +1517,17 @@ END IF
! --------------------------------------- ! ---------------------------------------
! !
!$acc kernels !$acc kernels
PTHS(:,:,:) = PTHS(:,:,:) * PRHODJ(:,:,:) DO CONCURRENT ( JI=1:JIU,JJ=1:JJU,JK=1:JKU)
PTHS(JI,JJ,JK) = PTHS(JI,JJ,JK) * PRHODJ(JI,JJ,JK)
END DO ! CONCURRENT
!$acc end kernels
! !
DO JRR = 1,KRR !$acc kernels
PRS(:,:,:,JRR) = PRS(:,:,:,JRR) * PRHODJ(:,:,:) !$acc loop seq
DO JRR=1,KRR
DO CONCURRENT ( JI=1:JIU,JJ=1:JJU,JK=1:JKU )
PRS(JI,JJ,JK,JRR) = PRS(JI,JJ,JK,JRR) * PRHODJ(JI,JJ,JK)
END DO ! CONCURRENT
END DO END DO
!$acc end kernels !$acc end kernels
! !
...@@ -1487,8 +1537,14 @@ IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA') ...@@ -1487,8 +1537,14 @@ IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA')
ENDDO ENDDO
DO JSV = 1,SIZE(ZSVT,4) DO JSV = 1,SIZE(ZSVT,4)
PSVT(:,:,:,JSV+ISVBEG-1) = ZSVT(:,:,:,JSV) PSVT(:,:,:,JSV+ISVBEG-1) = ZSVT(:,:,:,JSV)
ENDDO ENDDO
!$acc exit data delete(ZSVT,ZSVS) #ifndef MNH_OPENACC
deallocate(ZSVT,ZSVS)
#else
CALL MNH_REL_ZT4D( ISVEND - ISVBEG + 1 , IZSVS)
CALL MNH_REL_ZT4D( ISVEND - ISVBEG + 1 , IZSVT)
! acc exit data delete(ZSVT,ZSVS)
#endif
ENDIF ENDIF
! !
IF (MPPDB_INITIALIZED) THEN IF (MPPDB_INITIALIZED) THEN
...@@ -1521,6 +1577,20 @@ END IF ...@@ -1521,6 +1577,20 @@ END IF
!$acc end data !$acc end data
#ifndef MNH_OPENACC
deallocate (LLMICRO)
deallocate (ZDZZ,ZT,ZEXN,ZLV,ZLS,ZCPH,ZCOR,ZZZ)
deallocate (ZINPRI)
deallocate (ZTHSSTEP)
deallocate (ZRSSTEP)
#else
CALL MNH_REL_ZT4D(SIZE(PRS,4) , IZRSSTEP )
CALL MNH_REL_ZT3D ( IZTHSSTEP )
CALL MNH_REL_ZT3D ( IZINPRI )
CALL MNH_REL_ZT3D ( IZDZZ,IZT,IZEXN,IZLV,IZLS,IZCPH,IZCOR,IZZZ)
CALL MNH_REL_GT3D ( ILLMICRO )
#endif
!$acc end data !$acc end data
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
......
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