Skip to content
GitLab
Explore
Sign in
Primary navigation
Search or go to…
Project
M
Méso-NH code
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Package Registry
Model registry
Operate
Environments
Terraform modules
Monitor
Incidents
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
RODIER Quentin
Méso-NH code
Commits
a0d09d83
Commit
a0d09d83
authored
9 months ago
by
ESCOBAR Juan
Browse files
Options
Downloads
Patches
Plain Diff
Juan 31/05/2024:condensation.f90 , First GPU beta version with acc kernels inside JK loop
parent
667be2b4
No related branches found
Branches containing commit
No related tags found
No related merge requests found
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
src/PHYEX/micro/condensation.f90
+66
-7
66 additions, 7 deletions
src/PHYEX/micro/condensation.f90
with
66 additions
and
7 deletions
src/PHYEX/micro/condensation.f90
+
66
−
7
View file @
a0d09d83
...
...
@@ -192,6 +192,9 @@ REAL :: ZDZFACT,ZDZREF
REAL
(
KIND
=
JPRB
)
::
ZHOOK_HANDLE
INTEGER
::
IERR
!
LOGICAL
::
GPRESENT_PLV
,
GPRESENT_PLS
,
GPRESENT_PCPH
LOGICAL
::
GPRESENT_PHLC_HCF
,
GPRESENT_PHLC_HRC
,
GPRESENT_PHLI_HCF
,
GPRESENT_PHLI_HRI
LOGICAL
::
GHLAMBDA3_CB
!
!* 0.3 Definition of constants :
!
...
...
@@ -226,11 +229,23 @@ IKL=D%NKL
IIJB
=
D
%
NIJB
IIJE
=
D
%
NIJE
!
GPRESENT_PLV
=
PRESENT
(
PLV
)
GPRESENT_PLS
=
PRESENT
(
PLS
)
GPRESENT_PCPH
=
PRESENT
(
PCPH
)
GPRESENT_PHLC_HCF
=
PRESENT
(
PHLC_HCF
)
GPRESENT_PHLC_HRC
=
PRESENT
(
PHLC_HRC
)
GPRESENT_PHLI_HCF
=
PRESENT
(
PHLI_HCF
)
GPRESENT_PHLI_HRI
=
PRESENT
(
PHLI_HRI
)
!
GHLAMBDA3_CB
=
(
HLAMBDA3
==
'CB'
)
!
!$acc kernels present_cr(ZRT)
PCLDFR
(:,:)
=
0.
! Initialize values
PSIGRC
(:,:)
=
0.
! Initialize values
PRV_OUT
(:,:)
=
0.
! Initialize values
PRC_OUT
(:,:)
=
0.
! Initialize values
PRI_OUT
(:,:)
=
0.
! Initialize values
!$acc end kernels
ZPRIFACT
=
1.
! Initialize value
ZARDUM2
=
0.
! Initialize values
ZCLDINI
=
-1.
! Dummy Initialized cloud input to icecloud routine
...
...
@@ -243,18 +258,24 @@ IF(OCND2)ZPRIFACT = 0.
!
!-------------------------------------------------------------------------------
! store total water mixing ratio
!$acc kernels present_cr(ZRT)
DO
JK
=
IKTB
,
IKTE
DO
JIJ
=
IIJB
,
IIJE
ZRT
(
JIJ
,
JK
)
=
PRV_IN
(
JIJ
,
JK
)
+
PRC_IN
(
JIJ
,
JK
)
+
PRI_IN
(
JIJ
,
JK
)
*
ZPRIFACT
END
DO
END
DO
!$acc end kernels
!-------------------------------------------------------------------------------
! Preliminary calculations
! latent heat of vaporisation/sublimation
IF
(
PRESENT
(
PLV
)
.AND.
PRESENT
(
PLS
))
THEN
IF
(
GPRESENT_PLV
.AND.
GPRESENT_PLS
)
THEN
!$acc kernels present_cr(ZLV,ZLS)
ZLV
(:,:)
=
PLV
(:,:)
ZLS
(:,:)
=
PLS
(:,:)
!$acc end kernels
ELSE
!$acc kernels present_cr(ZLV, ZLS)
!$acc loop collapse(2) independent
DO
JK
=
IKTB
,
IKTE
DO
JIJ
=
IIJB
,
IIJE
! latent heat of vaporisation/sublimation
...
...
@@ -262,11 +283,15 @@ ELSE
ZLS
(
JIJ
,
JK
)
=
CST
%
XLSTT
+
(
CST
%
XCPV
-
CST
%
XCI
)
*
(
PT
(
JIJ
,
JK
)
-
CST
%
XTT
)
ENDDO
ENDDO
!$acc end kernels
ENDIF
IF
(
PRESENT
(
PCPH
))
THEN
IF
(
GPRESENT_PCPH
)
THEN
!$acc kernels present_cr(ZCPD)
ZCPD
(:,:)
=
PCPH
(:,:)
!$acc end kernels
ELSE
DO
JK
=
IKTB
,
IKTE
!$acc kernels present_cr(ZCPD)
DO
JK
=
IKTB
,
IKTE
DO
JIJ
=
IIJB
,
IIJE
ZCPD
(
JIJ
,
JK
)
=
CST
%
XCPD
+
CST
%
XCPV
*
PRV_IN
(
JIJ
,
JK
)
+
CST
%
XCL
*
PRC_IN
(
JIJ
,
JK
)
+
CST
%
XCI
*
PRI_IN
(
JIJ
,
JK
)
+
&
#if defined(REPRO48)
...
...
@@ -276,9 +301,12 @@ ELSE
CST
%
XCI
*
(
PRS
(
JIJ
,
JK
)
+
PRG
(
JIJ
,
JK
)
)
ENDDO
ENDDO
!$acc end kernels
ENDIF
! Preliminary calculations needed for computing the "turbulent part" of Sigma_s
IF
(
.NOT.
OSIGMAS
)
THEN
!$acc kernels present_cr(ZTLK,ITPL,ZTMIN,ZZZP)
!$acc loop collapse(2) independent
DO
JK
=
IKTB
,
IKTE
DO
JIJ
=
IIJB
,
IIJE
! store temperature at saturation
...
...
@@ -296,7 +324,9 @@ IF ( .NOT. OSIGMAS ) THEN
ITPL
(:)
=
IKB
+
IKL
#endif
ZTMIN
(:)
=
400.
!$acc loop seq
DO
JK
=
IKTB
+1
,
IKTE
-1
!$acc loop independent
DO
JIJ
=
IIJB
,
IIJE
IF
(
PT
(
JIJ
,
JK
)
<
ZTMIN
(
JIJ
)
)
THEN
ZTMIN
(
JIJ
)
=
PT
(
JIJ
,
JK
)
...
...
@@ -306,7 +336,9 @@ IF ( .NOT. OSIGMAS ) THEN
END
DO
! Set the mixing length scale
ZL
(:,
IKB
)
=
20.
!$acc loop seq
DO
JK
=
IKB
+
IKL
,
IKE
,
IKL
!$acc loop independent gang vector private(ZZZ,JKP)
DO
JIJ
=
IIJB
,
IIJE
! free troposphere
ZL
(
JIJ
,
JK
)
=
ZL0
...
...
@@ -319,6 +351,7 @@ IF ( .NOT. OSIGMAS ) THEN
ZL
(
JIJ
,
JK
)
=
.6
*
ZL
(
JIJ
,
JK
-
IKL
)
END
DO
END
DO
!$acc end kernels
END
IF
!-------------------------------------------------------------------------------
!
...
...
@@ -326,29 +359,38 @@ DO JK=IKTB,IKTE
JKP
=
MAX
(
MIN
(
JK
+
IKL
,
IKTE
),
IKTB
)
JKM
=
MAX
(
MIN
(
JK
-
IKL
,
IKTE
),
IKTB
)
IF
(
OCND2
)
THEN
!$acc kernels
DO
JIJ
=
IIJB
,
IIJE
ZDZ
(
JIJ
)
=
PZZ
(
JIJ
,
JKP
)
-
PZZ
(
JIJ
,
JKP
-
IKL
)
ENDDO
CALL
ICECLOUD
(
D
,
PPABS
(:,
JK
),
PZZ
(:,
JK
),
ZDZ
(:),
&
!$acc end kernels
CALL
ICECLOUD
(
D
,
PPABS
(:,
JK
),
PZZ
(:,
JK
),
ZDZ
(:),
&
&
PT
(:,
JK
),
PRV_IN
(:,
JK
),
1.
,
-1.
,
&
&
ZCLDINI
(:),
PIFR
(
IIJB
,
JK
),
PICLDFR
(:,
JK
),
&
&
PSSIO
(:,
JK
),
PSSIU
(:,
JK
),
ZARDUM2
(:),
ZARDUM
(:))
! latent heats
! saturated water vapor mixing ratio over liquid water and ice
!$acc kernels
!$acc loop independent
DO
JIJ
=
IIJB
,
IIJE
ESATW_T
(
JIJ
)
=
ESATW
(
PT
(
JIJ
,
JK
))
ZPV
(
JIJ
)
=
MIN
(
ESATW_T
(
JIJ
),
.99
*
PPABS
(
JIJ
,
JK
))
ZPIV
(
JIJ
)
=
MIN
(
ESATI
(
PT
(
JIJ
,
JK
)),
.99
*
PPABS
(
JIJ
,
JK
))
END
DO
!$acc end kernels
ELSE
! latent heats
! saturated water vapor mixing ratio over liquid water and ice
!$acc kernels
!$acc loop independent
DO
JIJ
=
IIJB
,
IIJE
ZPV
(
JIJ
)
=
MIN
(
EXP
(
CST
%
XALPW
-
CST
%
XBETAW
/
PT
(
JIJ
,
JK
)
-
CST
%
XGAMW
*
LOG
(
PT
(
JIJ
,
JK
)
)
),
.99
*
PPABS
(
JIJ
,
JK
))
ZPIV
(
JIJ
)
=
MIN
(
EXP
(
CST
%
XALPI
-
CST
%
XBETAI
/
PT
(
JIJ
,
JK
)
-
CST
%
XGAMI
*
LOG
(
PT
(
JIJ
,
JK
)
)
),
.99
*
PPABS
(
JIJ
,
JK
))
END
DO
!$acc end kernels
ENDIF
!Ice fraction
!$acc kernels
ZFRAC
(:)
=
0.
IF
(
OUSERI
.AND.
.NOT.
OCND2
)
THEN
DO
JIJ
=
IIJB
,
IIJE
...
...
@@ -356,10 +398,14 @@ DO JK=IKTB,IKTE
ZFRAC
(
JIJ
)
=
PRI_IN
(
JIJ
,
JK
)
/
(
PRC_IN
(
JIJ
,
JK
)
+
PRI_IN
(
JIJ
,
JK
))
ENDIF
END
DO
!$acc loop independent private(ierr)
DO
JIJ
=
IIJB
,
IIJE
CALL
COMPUTE_FRAC_ICE
(
HFRAC_ICE
,
NEB
,
ZFRAC
(
JIJ
),
PT
(
JIJ
,
JK
),
IERR
)
!error code IERR cannot be checked here to not break vectorization
ENDDO
ENDIF
!$acc end kernels
!$acc kernels
!$acc loop independent
DO
JIJ
=
IIJB
,
IIJE
ZQSL
(
JIJ
)
=
CST
%
XRD
/
CST
%
XRV
*
ZPV
(
JIJ
)
/
(
PPABS
(
JIJ
,
JK
)
-
ZPV
(
JIJ
)
)
ZQSI
(
JIJ
)
=
CST
%
XRD
/
CST
%
XRV
*
ZPIV
(
JIJ
)
/
(
PPABS
(
JIJ
,
JK
)
-
ZPIV
(
JIJ
)
)
...
...
@@ -376,9 +422,12 @@ DO JK=IKTB,IKTE
ZSBAR
(
JIJ
)
=
ZA
(
JIJ
)
*
(
ZRT
(
JIJ
,
JK
)
-
ZQSL
(
JIJ
)
+
&
&
ZAH
*
ZLVS
*
(
PRC_IN
(
JIJ
,
JK
)
+
PRI_IN
(
JIJ
,
JK
)
*
ZPRIFACT
)
/
ZCPD
(
JIJ
,
JK
))
END
DO
!$acc end kernels
! switch to take either present computed value of SIGMAS
! or that of Meso-NH turbulence scheme
!$acc kernels
IF
(
OSIGMAS
)
THEN
!$acc loop independent
DO
JIJ
=
IIJB
,
IIJE
IF
(
PSIGQSAT
(
JIJ
)/
=
0.
)
THEN
ZDZFACT
=
1.
...
...
@@ -401,6 +450,7 @@ DO JK=IKTB,IKTE
END
IF
END
DO
ELSE
!$acc loop independent
DO
JIJ
=
IIJB
,
IIJE
! parameterize Sigma_s with first_order closure
DZZ
=
PZZ
(
JIJ
,
JKP
)
-
PZZ
(
JIJ
,
JKM
)
...
...
@@ -416,6 +466,9 @@ DO JK=IKTB,IKTE
ZSIG_CONV
*
ZSIG_CONV
)
)
END
DO
END
IF
!$acc end kernels
!$acc kernels
!$acc loop independent
DO
JIJ
=
IIJB
,
IIJE
ZSIGMA
(
JIJ
)
=
MAX
(
1.E-10
,
ZSIGMA
(
JIJ
)
)
...
...
@@ -423,6 +476,7 @@ DO JK=IKTB,IKTE
ZQ1
(
JIJ
)
=
ZSBAR
(
JIJ
)/
ZSIGMA
(
JIJ
)
END
DO
IF
(
HCONDENS
==
'GAUS'
)
THEN
!$acc loop independent ! private(zgcond)
DO
JIJ
=
IIJB
,
IIJE
! Gaussian Probability Density Function around ZQ1
! Computation of ZG and ZGAM(=erf(ZG))
...
...
@@ -479,6 +533,7 @@ DO JK=IKTB,IKTE
ENDIF
ELSEIF
(
HCONDENS
==
'CB02'
)
THEN
!$acc loop independent
DO
JIJ
=
IIJB
,
IIJE
!Total condensate
IF
(
ZQ1
(
JIJ
)
>
0.
.AND.
ZQ1
(
JIJ
)
<=
2
)
THEN
...
...
@@ -514,7 +569,8 @@ DO JK=IKTB,IKTE
PHLI_HRI
(:,
JK
)
=
0.
ENDIF
END
IF
!HCONDENS
!$acc end kernels
!$acc kernels
IF
(
.NOT.
OCND2
)
THEN
DO
JIJ
=
IIJB
,
IIJE
PRC_OUT
(
JIJ
,
JK
)
=
(
1.
-
ZFRAC
(
JIJ
))
*
ZCOND
(
JIJ
)
! liquid condensate
...
...
@@ -575,7 +631,9 @@ DO JK=IKTB,IKTE
PRV_OUT
(
JIJ
,
JK
)
=
ZRT
(
JIJ
,
JK
)
-
PRC_OUT
(
JIJ
,
JK
)
-
PRI_OUT
(
JIJ
,
JK
)
*
ZPRIFACT
END
DO
END
IF
! End OCND2
IF
(
HLAMBDA3
==
'CB'
)
THEN
!$acc end kernels
!$acc kernels
IF
(
GHLAMBDA3_CB
)
THEN
DO
JIJ
=
IIJB
,
IIJE
! s r_c/ sig_s^2
! PSIGRC(JIJ,JK) = PCLDFR(JIJ,JK) ! use simple Gaussian relation
...
...
@@ -588,11 +646,12 @@ DO JK=IKTB,IKTE
PSIGRC
(
JIJ
,
JK
)
=
PSIGRC
(
JIJ
,
JK
)
*
MIN
(
3.
,
MAX
(
1.
,
1.
-
ZQ1
(
JIJ
))
)
END
DO
END
IF
!$acc end kernels
END
DO
!
IF
(
LHOOK
)
CALL
DR_HOOK
(
'CONDENSATION'
,
1
,
ZHOOK_HANDLE
)
!
CONTAINS
INCLUDE
"compute_frac_ice.func.h"
#include
"compute_frac_ice.func.h"
!
END
SUBROUTINE
CONDENSATION
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment