diff --git a/src/MNH/ice4_fast_rg.f90 b/src/MNH/ice4_fast_rg.f90
index 25af952d6fd5f6d524afd113e92653b2651af20b..6119ca323c8a52c4bb171178e8ba44ebfcf69b36 100644
--- a/src/MNH/ice4_fast_rg.f90
+++ b/src/MNH/ice4_fast_rg.f90
@@ -241,8 +241,11 @@ GCRFLIMIT = LCRFLIMIT
GEVLIMIT = LEVLIMIT
GNULLWETG = LNULLWETG
GWETGPOST = LWETGPOST
-!$acc kernels
+! !$acc kernels
+!PW: bug?: for the moment I take the value from the CPU as OK. GPU value seems to be lost when this subroutine is called
GDSOFT = LDSOFT
+! !$acc end kernels
+!$acc kernels
IRR = KRR
!$acc end kernels
!
diff --git a/src/MNH/ice4_fast_rh.f90 b/src/MNH/ice4_fast_rh.f90
index 255d719d66635df53cc8b2d56034018487138a17..c12d3b9c62487d149d5d26b06773fb67af7419c7 100644
--- a/src/MNH/ice4_fast_rh.f90
+++ b/src/MNH/ice4_fast_rh.f90
@@ -223,9 +223,10 @@ GCONVHG = LCONVHG
GEVLIMIT = LEVLIMIT
GNULLWETH = LNULLWETH
GWETHPOST = LWETHPOST
-!$acc kernels
+! !$acc kernels
+!PW: bug?: for the moment I take the value from the CPU as OK. GPU value seems to be lost when this subroutine is called
GDSOFT = LDSOFT
-!$acc end kernels
+! !$acc end kernels
!
!* 7.2 compute the Wet and Dry growth of hail
!
diff --git a/src/MNH/ice4_fast_ri.f90 b/src/MNH/ice4_fast_ri.f90
index d5c969a0bf86564c51812c171a11583b6c7c3724..931283342851d24713615dae827bc5a7f37b5197 100644
--- a/src/MNH/ice4_fast_ri.f90
+++ b/src/MNH/ice4_fast_ri.f90
@@ -127,9 +127,10 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK1D(PA_RI,"ICE4_FAST_RI beg:PA_RI",PRECISION)
END IF
!
-!$acc kernels
+! !$acc kernels
+!PW: bug?: for the moment I take the value from the CPU as OK. GPU value seems to be lost when this subroutine is called
GDSOFT = LDSOFT !Workaround of PGI bug with OpenACC (at least up to 18.10 version)
-!$acc end kernels
+! !$acc end kernels
!
!* 7.2 Bergeron-Findeisen effect: RCBERI
!
diff --git a/src/MNH/ice4_fast_rs.f90 b/src/MNH/ice4_fast_rs.f90
index 6094f023666ab8ad98129614356d88590e424c6a..849fa061f902b362b4f81f4911553b1ab8c7fe8d 100644
--- a/src/MNH/ice4_fast_rs.f90
+++ b/src/MNH/ice4_fast_rs.f90
@@ -190,9 +190,10 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK1D(PA_RG,"ICE4_FAST_RS beg:PA_RG",PRECISION)
END IF
!
-!$acc kernels
+! !$acc kernels
+!PW: bug?: for the moment I take the value from the CPU as OK. GPU value seems to be lost when this subroutine is called
GDSOFT = LDSOFT;GEVLIMIT = LEVLIMIT !Workaround of PGI bug with OpenACC (at least up to 18.10 version)
-!$acc end kernels
+! !$acc end kernels
!
!* 5.0 maximum freezing rate
!
diff --git a/src/MNH/ice4_nucleation.f90 b/src/MNH/ice4_nucleation.f90
index d0098d3fdc10ed9df2d4a985f56e88d856596bc8..214d676166468d797cc93e3a025139bb2f6dd76f 100644
--- a/src/MNH/ice4_nucleation.f90
+++ b/src/MNH/ice4_nucleation.f90
@@ -1,17 +1,17 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
MODULE MODI_ICE4_NUCLEATION
INTERFACE
-SUBROUTINE ICE4_NUCLEATION(KSIZE, LDSOFT, LDCOMPUTE, &
+SUBROUTINE ICE4_NUCLEATION(KSIZE, ODSOFT, ODCOMPUTE, &
PTHT, PPABST, PRHODREF, PEXN, PLSFACT, PT, &
PRVT, &
PCIT, PRVHENI_MR, PB_TH, PB_RV, PB_RI)
IMPLICIT NONE
INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE),INTENT(IN) :: LDCOMPUTE
+LOGICAL, INTENT(IN) :: ODSOFT
+LOGICAL, DIMENSION(KSIZE),INTENT(IN) :: ODCOMPUTE
REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at t
REAL, DIMENSION(KSIZE), INTENT(IN) :: PPABST ! absolute pressure at t
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF! Reference density
@@ -27,7 +27,7 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RI
END SUBROUTINE ICE4_NUCLEATION
END INTERFACE
END MODULE MODI_ICE4_NUCLEATION
-SUBROUTINE ICE4_NUCLEATION(KSIZE, LDSOFT, LDCOMPUTE, &
+SUBROUTINE ICE4_NUCLEATION(KSIZE, ODSOFT, ODCOMPUTE, &
PTHT, PPABST, PRHODREF, PEXN, PLSFACT, PT, &
PRVT, &
PCIT, PRVHENI_MR, PB_TH, PB_RV, PB_RI)
@@ -64,8 +64,8 @@ IMPLICIT NONE
!* 0.1 Declarations of dummy arguments :
!
INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE),INTENT(IN) :: LDCOMPUTE
+LOGICAL, INTENT(IN) :: ODSOFT
+LOGICAL, DIMENSION(KSIZE),INTENT(IN) :: ODCOMPUTE
REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at t
REAL, DIMENSION(KSIZE), INTENT(IN) :: PPABST ! absolute pressure at t
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF! Reference density
@@ -79,7 +79,7 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_TH
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RV
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RI
!
-!$acc declare present(KSIZE,LDSOFT,LDCOMPUTE,PTHT,PPABST,PRHODREF,PEXN,PLSFACT,PT,PRVT,PCIT,PRVHENI_MR,PB_TH,PB_RV,PB_RI)
+!$acc declare present(KSIZE,ODSOFT,ODCOMPUTE,PTHT,PPABST,PRHODREF,PEXN,PLSFACT,PT,PRVT,PCIT,PRVHENI_MR,PB_TH,PB_RV,PB_RI)
!
!* 0.2 declaration of local variables
!
@@ -100,32 +100,34 @@ REAL, DIMENSION(KSIZE) :: ZZW, & ! Work array
!$acc& XRTMIN)
!
!-------------------------------------------------------------------------------
+!
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
- CALL MPPDB_CHECK1D(PTHT,"ICE4_NUCLEATION beg:PTHT",PRECISION)
- CALL MPPDB_CHECK1D(PPABST,"ICE4_NUCLEATION beg:PPABST",PRECISION)
- CALL MPPDB_CHECK1D(PRHODREF,"ICE4_NUCLEATION beg:PRHODREF",PRECISION)
- CALL MPPDB_CHECK1D(PEXN,"ICE4_NUCLEATION beg:PEXN",PRECISION)
- CALL MPPDB_CHECK1D(PLSFACT,"ICE4_NUCLEATION beg:PLSFACT",PRECISION)
- CALL MPPDB_CHECK1D(PT,"ICE4_NUCLEATION beg:PT",PRECISION)
- CALL MPPDB_CHECK1D(PRVT,"ICE4_NUCLEATION beg:PRVT",PRECISION)
+ CALL MPPDB_CHECK(PTHT,"ICE4_NUCLEATION beg:PTHT")
+ CALL MPPDB_CHECK(PPABST,"ICE4_NUCLEATION beg:PPABST")
+ CALL MPPDB_CHECK(PRHODREF,"ICE4_NUCLEATION beg:PRHODREF")
+ CALL MPPDB_CHECK(PEXN,"ICE4_NUCLEATION beg:PEXN")
+ CALL MPPDB_CHECK(PLSFACT,"ICE4_NUCLEATION beg:PLSFACT")
+ CALL MPPDB_CHECK(PT,"ICE4_NUCLEATION beg:PT")
+ CALL MPPDB_CHECK(PRVT,"ICE4_NUCLEATION beg:PRVT")
!Check all INOUT arrays
- CALL MPPDB_CHECK1D(PCIT,"ICE4_NUCLEATION beg:PCIT",PRECISION)
- CALL MPPDB_CHECK1D(PB_TH,"ICE4_NUCLEATION beg:PB_TH",PRECISION)
- CALL MPPDB_CHECK1D(PB_RV,"ICE4_NUCLEATION beg:PB_RV",PRECISION)
- CALL MPPDB_CHECK1D(PB_RI,"ICE4_NUCLEATION beg:PB_RI",PRECISION)
+ CALL MPPDB_CHECK(PCIT,"ICE4_NUCLEATION beg:PCIT")
+ CALL MPPDB_CHECK(PB_TH,"ICE4_NUCLEATION beg:PB_TH")
+ CALL MPPDB_CHECK(PB_RV,"ICE4_NUCLEATION beg:PB_RV")
+ CALL MPPDB_CHECK(PB_RI,"ICE4_NUCLEATION beg:PB_RI")
END IF
!
!Workaround of PGI bug with OpenACC (at least up to 18.10 version)
GFEEDBACKT = LFEEDBACKT
-!$acc kernels
-GDSOFT = LDSOFT
-!$acc end kernels
+! !$acc kernels
+!PW: bug?: for the moment I take the value from the CPU as OK. GPU value seems to be lost when this subroutine is called
+GDSOFT = ODSOFT
+! !$acc end kernels
!
!$acc kernels
PRVHENI_MR(:)=0.
IF(.NOT. GDSOFT) THEN
- GNEGT(:)=PT(:)<XTT .AND. PRVT>XRTMIN(1) .AND. LDCOMPUTE(:)
+ GNEGT(:)=PT(:)<XTT .AND. PRVT>XRTMIN(1) .AND. ODCOMPUTE(:)
PRVHENI_MR(:)=0.
ZSSI(:)=0.
ZUSW(:)=0.
@@ -228,12 +230,12 @@ ENDIF
!
IF (MPPDB_INITIALIZED) THEN
!Check all OUT arrays
- CALL MPPDB_CHECK1D(PRVHENI_MR,"ICE4_NUCLEATION end:PRVHENI_MR",PRECISION)
+ CALL MPPDB_CHECK(PRVHENI_MR,"ICE4_NUCLEATION end:PRVHENI_MR")
!Check all INOUT arrays
- CALL MPPDB_CHECK1D(PCIT,"ICE4_NUCLEATION end:PCIT",PRECISION)
- CALL MPPDB_CHECK1D(PB_TH,"ICE4_NUCLEATION end:PB_TH",PRECISION)
- CALL MPPDB_CHECK1D(PB_RV,"ICE4_NUCLEATION end:PB_RV",PRECISION)
- CALL MPPDB_CHECK1D(PB_RI,"ICE4_NUCLEATION end:PB_RI",PRECISION)
+ CALL MPPDB_CHECK(PCIT,"ICE4_NUCLEATION end:PCIT")
+ CALL MPPDB_CHECK(PB_TH,"ICE4_NUCLEATION end:PB_TH")
+ CALL MPPDB_CHECK(PB_RV,"ICE4_NUCLEATION end:PB_RV")
+ CALL MPPDB_CHECK(PB_RI,"ICE4_NUCLEATION end:PB_RI")
END IF
!
END SUBROUTINE ICE4_NUCLEATION
diff --git a/src/MNH/ice4_nucleation_wrapper.f90 b/src/MNH/ice4_nucleation_wrapper.f90
index 7961112de55ca03da1aa2a92f1a47d874ec63aa2..bcbb255a4e923966dfdcdd18aef8d672e1774557 100644
--- a/src/MNH/ice4_nucleation_wrapper.f90
+++ b/src/MNH/ice4_nucleation_wrapper.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -68,24 +68,25 @@ REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRVHENI_MR ! Mixing ratio chang
!
!* 0.2 declaration of local variables
!
-INTEGER :: JL ! and PACK intrinsics
-LOGICAL :: GDSOFT
-LOGICAL, DIMENSION(:),ALLOCATABLE :: GLDCOMPUTE
-LOGICAL, DIMENSION(SIZE(PRVT,1),SIZE(PRVT,2),SIZE(PRVT,3)) :: GNEGT ! Test where to compute the HEN process
-INTEGER :: INEGT, INEGT_TMP
-INTEGER, DIMENSION(:),ALLOCATABLE :: I1,I2,I3 ! Used to replace the COUNT
-REAL, DIMENSION(:),ALLOCATABLE :: ZZT, & ! Temperature
- ZPRES, & ! Pressure
- ZRVT, & ! Water vapor m.r. at t
- ZCIT, & ! Pristine ice conc. at t
- ZTHT, & ! Theta at t
- ZRHODREF, &
- ZEXN, &
- ZLSFACT, &
- ZRVHENI_MR, &
- ZB_TH, ZB_RV, ZB_RI
-!
-!$acc declare create(JL,GDSOFT,GLDCOMPUTE,GNEGT,INEGT,INEGT_TMP,I1,I2,I3,ZZT,ZPRES,ZRVT,ZCIT,ZTHT, &
+INTEGER :: IDX, JI, JJ, JK
+INTEGER :: JL
+INTEGER :: INEGT, INEGT_TMP
+INTEGER, DIMENSION(:), ALLOCATABLE :: I1,I2,I3
+LOGICAL :: GDSOFT
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GLDCOMPUTE
+LOGICAL, DIMENSION(KIT,KJT,KKT) :: GNEGT ! Test where to compute the HEN process
+REAL, DIMENSION(:), ALLOCATABLE :: ZZT, & ! Temperature
+ ZPRES, & ! Pressure
+ ZRVT, & ! Water vapor m.r. at t
+ ZCIT, & ! Pristine ice conc. at t
+ ZTHT, & ! Theta at t
+ ZRHODREF, &
+ ZEXN, &
+ ZLSFACT, &
+ ZRVHENI_MR, &
+ ZB_TH, ZB_RV, ZB_RI
+!
+!$acc declare create(IDX,JI,JJ,JK,JL,GDSOFT,GLDCOMPUTE,GNEGT,INEGT,INEGT_TMP,I1,I2,I3,ZZT,ZPRES,ZRVT,ZCIT,ZTHT, &
!$acc& ZRHODREF,ZEXN,ZLSFACT,ZRVHENI_MR,ZB_TH,ZB_RV,ZB_RI)
!
!$acc declare copyin(XTT)
@@ -93,23 +94,26 @@ REAL, DIMENSION(:),ALLOCATABLE :: ZZT, & ! Temperature
!
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
- CALL MPPDB_CHECK3D_LOG(LDMASK,"ICE4_NUCLEATION_WRAPPER beg:LDMASK")
- CALL MPPDB_CHECK3D(PTHT,"ICE4_NUCLEATION_WRAPPER beg:PTHT",PRECISION)
- CALL MPPDB_CHECK3D(PPABST,"ICE4_NUCLEATION_WRAPPER beg:PPABST",PRECISION)
- CALL MPPDB_CHECK3D(PRHODREF,"ICE4_NUCLEATION_WRAPPER beg:PRHODREF",PRECISION)
- CALL MPPDB_CHECK3D(PEXN,"ICE4_NUCLEATION_WRAPPER beg:PEXN",PRECISION)
- CALL MPPDB_CHECK3D(PLSFACT,"ICE4_NUCLEATION_WRAPPER beg:PLSFACT",PRECISION)
- CALL MPPDB_CHECK3D(PT,"ICE4_NUCLEATION_WRAPPER beg:PT",PRECISION)
- CALL MPPDB_CHECK3D(PRVT,"ICE4_NUCLEATION_WRAPPER beg:PRVT",PRECISION)
+ CALL MPPDB_CHECK(LDMASK,"ICE4_NUCLEATION_WRAPPER beg:LDMASK")
+ CALL MPPDB_CHECK(PTHT,"ICE4_NUCLEATION_WRAPPER beg:PTHT")
+ CALL MPPDB_CHECK(PPABST,"ICE4_NUCLEATION_WRAPPER beg:PPABST")
+ CALL MPPDB_CHECK(PRHODREF,"ICE4_NUCLEATION_WRAPPER beg:PRHODREF")
+ CALL MPPDB_CHECK(PEXN,"ICE4_NUCLEATION_WRAPPER beg:PEXN")
+ CALL MPPDB_CHECK(PLSFACT,"ICE4_NUCLEATION_WRAPPER beg:PLSFACT")
+ CALL MPPDB_CHECK(PT,"ICE4_NUCLEATION_WRAPPER beg:PT")
+ CALL MPPDB_CHECK(PRVT,"ICE4_NUCLEATION_WRAPPER beg:PRVT")
!Check all INOUT arrays
- CALL MPPDB_CHECK3D(PCIT,"ICE4_NUCLEATION_WRAPPER beg:PCIT",PRECISION)
+ CALL MPPDB_CHECK(PCIT,"ICE4_NUCLEATION_WRAPPER beg:PCIT")
END IF
!
! optimization by looking for locations where
! the temperature is negative only !!!
!
+!$acc kernels
GNEGT(:,:,:)=PT(:,:,:)<XTT .AND. LDMASK
INEGT = COUNT(GNEGT(:,:,:))
+!$acc end kernels
+!$acc update self(INEGT)
!
ALLOCATE(GLDCOMPUTE(INEGT))
ALLOCATE(I1(INEGT),I2(INEGT),I3(INEGT))
@@ -126,14 +130,23 @@ ALLOCATE(ZB_TH(INEGT))
ALLOCATE(ZB_RV(INEGT))
ALLOCATE(ZB_RI(INEGT))
!
+!$acc kernels
ZB_TH(:) = 0.
ZB_RV(:) = 0.
ZB_RI(:) = 0.
+!$acc end kernels
!
+#ifndef _OPENACC
IF(INEGT>0) INEGT_TMP=ICE4_NUCLEATION_COUNTJV(GNEGT(:,:,:), KIT, KJT, KKT, SIZE(I1), I1(:), I2(:), I3(:))
+#else
+IF(INEGT>0) CALL ICE4_NUCLEATION_COUNTJVD_DEVICE(GNEGT(:,:,:),I1(:),I2(:),I3(:),INEGT_TMP)
+#endif
!
+!$acc kernels
PRVHENI_MR(:,:,:)=0.
+!$acc end kernels
IF(INEGT>0) THEN
+!$acc kernels
DO JL=1, INEGT
ZRVT(JL)=PRVT(I1(JL), I2(JL), I3(JL))
ZCIT(JL)=PCIT(I1(JL), I2(JL), I3(JL))
@@ -146,12 +159,33 @@ IF(INEGT>0) THEN
ENDDO
GDSOFT = .FALSE.
GLDCOMPUTE(:) = ZZT(:)<XTT
+!$acc end kernels
CALL ICE4_NUCLEATION(INEGT, GDSOFT, GLDCOMPUTE, &
ZTHT, ZPRES, ZRHODREF, ZEXN, ZLSFACT, ZZT, &
ZRVT, &
ZCIT, ZRVHENI_MR, ZB_TH, ZB_RV, ZB_RI)
+#ifndef _OPENACC
PRVHENI_MR(:,:,:)=UNPACK(ZRVHENI_MR(:), MASK=GNEGT(:,:,:), FIELD=0.0)
- PCIT(:,:,:)=UNPACK(ZCIT(:), MASK=GNEGT(:,:,:), FIELD=PCIT(:,:,:))
+ PCIT(:,:,:) =UNPACK(ZCIT(:), MASK=GNEGT(:,:,:), FIELD=PCIT(:,:,:))
+#else
+!$acc kernels
+ IDX = 0
+ DO JK=1,KKT
+ DO JJ=1,KJT
+ DO JI=1,KIT
+ IF (GNEGT(JI,JJ,JK)) THEN
+ IDX = IDX+1
+ PRVHENI_MR(JI,JJ,JK) = ZRVHENI_MR(IDX)
+ PCIT(JI,JJ,JK) = ZCIT(IDX)
+ ELSE
+ PRVHENI_MR(JI,JJ,JK) = 0.
+ !PCIT(JI,JJ,JK) = PCIT(IDX) !trivial
+ END IF
+ END DO
+ END DO
+ END DO
+!$acc end kernels
+#endif
END IF
!
DEALLOCATE(GLDCOMPUTE)
@@ -160,9 +194,9 @@ DEALLOCATE(ZZT,ZPRES,ZRVT,ZCIT,ZTHT,ZRHODREF,ZEXN,ZLSFACT,ZRVHENI_MR,ZB_TH,ZB_RV
!
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
- CALL MPPDB_CHECK3D(PCIT,"ICE4_NUCLEATION_WRAPPER end:PCIT",PRECISION)
+ CALL MPPDB_CHECK(PCIT,"ICE4_NUCLEATION_WRAPPER end:PCIT")
!Check all OUT arrays
- CALL MPPDB_CHECK3D(PRVHENI_MR,"ICE4_NUCLEATION_WRAPPER end:PRVHENI_MR",PRECISION)
+ CALL MPPDB_CHECK(PRVHENI_MR,"ICE4_NUCLEATION_WRAPPER end:PRVHENI_MR")
END IF
!
CONTAINS
@@ -188,4 +222,53 @@ CONTAINS
END DO
END FUNCTION ICE4_NUCLEATION_COUNTJV
!
+#ifdef _OPENACC
+ SUBROUTINE ICE4_NUCLEATION_COUNTJVD_DEVICE(LTAB,I1,I2,I3,IC)
+ !
+ IMPLICIT NONE
+ !
+ LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: LTAB ! Mask
+ INTEGER, DIMENSION(:), INTENT(OUT) :: I1,I2,I3 ! Used to replace the COUNT and PACK
+ INTEGER, INTENT(OUT) :: IC ! Count
+!$acc declare present(LTAB,I1,I2,I3,IC)
+ !
+ INTEGER :: JI,JJ,JK,IDX
+ !
+ !-------------------------------------------------------------------------------
+ !
+!$acc kernels present(LTAB,I1,I2,I3)
+
+ !To allow comparisons... (I1/I2/I3 are not fully used)
+ !Can be removed in production
+ ! I1(:) = -999
+ ! I2(:) = -999
+ ! I3(:) = -999
+
+
+ IC = 0
+ !Warning: if "independent" is set, content of I1, I2 and I3 can vary between 2
+ ! different runs of this subroutine BUT final result should be the same
+ !Comment the following line + atomic directives to have consistent values for debugging
+ !Warning: huge impact on performance
+ !acc loop collapse(3) private(IDX) independent
+ DO JK = 1,SIZE(LTAB,3)
+ DO JJ = 1,SIZE(LTAB,2)
+ DO JI = 1,SIZE(LTAB,1)
+ IF( LTAB(JI,JJ,JK) ) THEN
+!acc atomic capture
+ IC = IC +1
+ IDX = IC
+!acc end atomic
+ I1(IDX) = JI
+ I2(IDX) = JJ
+ I3(IDX) = JK
+ END IF
+ END DO
+ END DO
+ END DO
+!$acc end kernels
+!
+ END SUBROUTINE ICE4_NUCLEATION_COUNTJVD_DEVICE
+#endif
+ !
END SUBROUTINE ICE4_NUCLEATION_WRAPPER
diff --git a/src/MNH/ice4_rimltc.f90 b/src/MNH/ice4_rimltc.f90
index 0f6baa117764080c4563b3d0169f5f1c4e128d19..65968cf75b4134a1324525800126d25e1b4dd456 100644
--- a/src/MNH/ice4_rimltc.f90
+++ b/src/MNH/ice4_rimltc.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
MODULE MODI_ICE4_RIMLTC
INTERFACE
@@ -84,23 +84,25 @@ LOGICAL, DIMENSION(KSIZE) :: GMASK
!-------------------------------------------------------------------------------
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
- CALL MPPDB_CHECK1D(PEXN,"ICE4_RIMLTC beg:PEXN",PRECISION)
- CALL MPPDB_CHECK1D(PLVFACT,"ICE4_RIMLTC beg:PLVFACT",PRECISION)
- CALL MPPDB_CHECK1D(PLSFACT,"ICE4_RIMLTC beg:PLSFACT",PRECISION)
- CALL MPPDB_CHECK1D(PT,"ICE4_RIMLTC beg:PT",PRECISION)
- CALL MPPDB_CHECK1D(PTHT,"ICE4_RIMLTC beg:PTHT",PRECISION)
- CALL MPPDB_CHECK1D(PRIT,"ICE4_RIMLTC beg:PRIT",PRECISION)
+ CALL MPPDB_CHECK(PEXN,"ICE4_RIMLTC beg:PEXN")
+ CALL MPPDB_CHECK(PLVFACT,"ICE4_RIMLTC beg:PLVFACT")
+ CALL MPPDB_CHECK(PLSFACT,"ICE4_RIMLTC beg:PLSFACT")
+ CALL MPPDB_CHECK(PT,"ICE4_RIMLTC beg:PT")
+ CALL MPPDB_CHECK(PTHT,"ICE4_RIMLTC beg:PTHT")
+ CALL MPPDB_CHECK(PRIT,"ICE4_RIMLTC beg:PRIT")
!Check all INOUT arrays
- CALL MPPDB_CHECK1D(PB_TH,"ICE4_RIMLTC beg:PB_TH",PRECISION)
- CALL MPPDB_CHECK1D(PB_RC,"ICE4_RIMLTC beg:PB_RC",PRECISION)
- CALL MPPDB_CHECK1D(PB_RI,"ICE4_RIMLTC beg:PB_RI",PRECISION)
+ CALL MPPDB_CHECK(PB_TH,"ICE4_RIMLTC beg:PB_TH")
+ CALL MPPDB_CHECK(PB_RC,"ICE4_RIMLTC beg:PB_RC")
+ CALL MPPDB_CHECK(PB_RI,"ICE4_RIMLTC beg:PB_RI")
END IF
!
!* 7.1 cloud ice melting
!
-!$acc kernels
-GDSOFT=LDSOFT;GFEEDBACKT=LFEEDBACKT !Workaround of PGI bug with OpenACC (at least up to 18.10 version)
-!$acc end kernels
+! !$acc kernels
+!PW: bug?: for the moment I take the value from the CPU as OK. GPU value seems to be lost when this subroutine is called
+GDSOFT=LDSOFT
+GFEEDBACKT=LFEEDBACKT !Workaround of PGI bug with OpenACC (at least up to 18.10 version)
+! !$acc end kernels
!$acc kernels
PRIMLTC_MR(:)=0.
IF(.NOT. GDSOFT) THEN
@@ -123,11 +125,11 @@ PB_TH(:) = PB_TH(:) - PRIMLTC_MR(:)*(PLSFACT(:)-PLVFACT(:))
!
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
- CALL MPPDB_CHECK1D(PB_TH,"ICE4_RIMLTC end:PB_TH",PRECISION)
- CALL MPPDB_CHECK1D(PB_RC,"ICE4_RIMLTC end:PB_RC",PRECISION)
- CALL MPPDB_CHECK1D(PB_RI,"ICE4_RIMLTC end:PB_RI",PRECISION)
+ CALL MPPDB_CHECK(PB_TH,"ICE4_RIMLTC end:PB_TH")
+ CALL MPPDB_CHECK(PB_RC,"ICE4_RIMLTC end:PB_RC")
+ CALL MPPDB_CHECK(PB_RI,"ICE4_RIMLTC end:PB_RI")
!Check all OUT arrays
- CALL MPPDB_CHECK1D(PRIMLTC_MR,"ICE4_RIMLTC end:PRIMLTC_MR",PRECISION)
+ CALL MPPDB_CHECK(PRIMLTC_MR,"ICE4_RIMLTC end:PRIMLTC_MR")
END IF
!
END SUBROUTINE ICE4_RIMLTC
diff --git a/src/MNH/ice4_rrhong.f90 b/src/MNH/ice4_rrhong.f90
index be585493a6c439a51a43f15b70af956219408679..92eff5e436c5d27326256e68118de7c75ca8525b 100644
--- a/src/MNH/ice4_rrhong.f90
+++ b/src/MNH/ice4_rrhong.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
MODULE MODI_ICE4_RRHONG
INTERFACE
@@ -86,23 +86,25 @@ LOGICAL, DIMENSION(SIZE(PRRT)) :: GMASK
!-------------------------------------------------------------------------------
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
- CALL MPPDB_CHECK1D(PEXN,"ICE4_RRHONG beg:PEXN",PRECISION)
- CALL MPPDB_CHECK1D(PLVFACT,"ICE4_RRHONG beg:PLVFACT",PRECISION)
- CALL MPPDB_CHECK1D(PLSFACT,"ICE4_RRHONG beg:PLSFACT",PRECISION)
- CALL MPPDB_CHECK1D(PT,"ICE4_RRHONG beg:PT",PRECISION)
- CALL MPPDB_CHECK1D(PRRT,"ICE4_RRHONG beg:PRRT",PRECISION)
- CALL MPPDB_CHECK1D(PTHT,"ICE4_RRHONG beg:PTHT",PRECISION)
+ CALL MPPDB_CHECK(PEXN,"ICE4_RRHONG beg:PEXN")
+ CALL MPPDB_CHECK(PLVFACT,"ICE4_RRHONG beg:PLVFACT")
+ CALL MPPDB_CHECK(PLSFACT,"ICE4_RRHONG beg:PLSFACT")
+ CALL MPPDB_CHECK(PT,"ICE4_RRHONG beg:PT")
+ CALL MPPDB_CHECK(PRRT,"ICE4_RRHONG beg:PRRT")
+ CALL MPPDB_CHECK(PTHT,"ICE4_RRHONG beg:PTHT")
!Check all INOUT arrays
- CALL MPPDB_CHECK1D(PB_TH,"ICE4_RRHONG beg:PB_TH",PRECISION)
- CALL MPPDB_CHECK1D(PB_RR,"ICE4_RRHONG beg:PB_RR",PRECISION)
- CALL MPPDB_CHECK1D(PB_RG,"ICE4_RRHONG beg:PB_RG",PRECISION)
+ CALL MPPDB_CHECK(PB_TH,"ICE4_RRHONG beg:PB_TH")
+ CALL MPPDB_CHECK(PB_RR,"ICE4_RRHONG beg:PB_RR")
+ CALL MPPDB_CHECK(PB_RG,"ICE4_RRHONG beg:PB_RG")
END IF
!
!* 3.3 compute the spontaneous freezing source: RRHONG
!
-!$acc kernels
-GDSOFT=LDSOFT;GFEEDBACKT=LFEEDBACKT !Workaround of PGI bug with OpenACC (at least up to 18.10 version)
-!$acc end kernels
+! !$acc kernels
+!PW: bug?: for the moment I take the value from the CPU as OK. GPU value seems to be lost when this subroutine is called
+GDSOFT=LDSOFT
+GFEEDBACKT=LFEEDBACKT !Workaround of PGI bug with OpenACC (at least up to 18.10 version)
+! !$acc end kernels
!$acc kernels
PRRHONG_MR(:) = 0.
IF(GDSOFT) THEN
@@ -124,11 +126,11 @@ PB_TH(:) = PB_TH(:) + PRRHONG_MR(:)*(PLSFACT(:)-PLVFACT(:))
!
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
- CALL MPPDB_CHECK1D(PB_TH,"ICE4_RRHONG end:PB_TH",PRECISION)
- CALL MPPDB_CHECK1D(PB_RR,"ICE4_RRHONG end:PB_RR",PRECISION)
- CALL MPPDB_CHECK1D(PB_RG,"ICE4_RRHONG end:PB_RG",PRECISION)
+ CALL MPPDB_CHECK(PB_TH,"ICE4_RRHONG end:PB_TH")
+ CALL MPPDB_CHECK(PB_RR,"ICE4_RRHONG end:PB_RR")
+ CALL MPPDB_CHECK(PB_RG,"ICE4_RRHONG end:PB_RG")
!Check all OUT arrays
- CALL MPPDB_CHECK1D(PRRHONG_MR,"ICE4_RRHONG end:PRRHONG_MR",PRECISION)
+ CALL MPPDB_CHECK(PRRHONG_MR,"ICE4_RRHONG end:PRRHONG_MR")
END IF
!
END SUBROUTINE ICE4_RRHONG
diff --git a/src/MNH/ice4_rsrimcg_old.f90 b/src/MNH/ice4_rsrimcg_old.f90
index c568907eb32c318c837e60b921fc931352db25b5..df0b3ed6d1e3d56afa4b4950ce43f210f1422d18 100644
--- a/src/MNH/ice4_rsrimcg_old.f90
+++ b/src/MNH/ice4_rsrimcg_old.f90
@@ -1,18 +1,18 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
MODULE MODI_ICE4_RSRIMCG_OLD
INTERFACE
-SUBROUTINE ICE4_RSRIMCG_OLD(KSIZE, LDSOFT, LDCOMPUTE, &
+SUBROUTINE ICE4_RSRIMCG_OLD(KSIZE, ODSOFT, ODCOMPUTE, &
&PRHODREF, &
&PLBDAS, &
&PT, PRCT, PRST, &
&PRSRIMCG_MR, PB_RS, PB_RG)
IMPLICIT NONE
INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE
+LOGICAL, INTENT(IN) :: ODSOFT
+LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: ODCOMPUTE
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
@@ -24,7 +24,7 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RG
END SUBROUTINE ICE4_RSRIMCG_OLD
END INTERFACE
END MODULE MODI_ICE4_RSRIMCG_OLD
-SUBROUTINE ICE4_RSRIMCG_OLD(KSIZE, LDSOFT, LDCOMPUTE, &
+SUBROUTINE ICE4_RSRIMCG_OLD(KSIZE, ODSOFT, ODCOMPUTE, &
&PRHODREF, &
&PLBDAS, &
&PT, PRCT, PRST, &
@@ -62,8 +62,8 @@ IMPLICIT NONE
!* 0.1 Declarations of dummy arguments :
!
INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE
+LOGICAL, INTENT(IN) :: ODSOFT
+LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: ODCOMPUTE
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the aggregate distribution
REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
@@ -73,7 +73,7 @@ REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSRIMCG_MR ! Mr change due to cl
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RS
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RG
!
-!$acc declare present(KSIZE,LDSOFT,LDCOMPUTE,PRHODREF,PLBDAS, &
+!$acc declare present(KSIZE,ODSOFT,ODCOMPUTE,PRHODREF,PLBDAS, &
!$acc& PT,PRCT,PRST,PRSRIMCG_MR,PB_RS,PB_RG)
!
!* 0.2 declaration of local variables
@@ -94,15 +94,15 @@ REAL, DIMENSION(SIZE(PRHODREF)) :: ZZW
!
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
- CALL MPPDB_CHECK1D_LOG(LDCOMPUTE,"ICE4_RSRIMCG_OLD beg:LDCOMPUTE")
- CALL MPPDB_CHECK1D(PRHODREF,"ICE4_RSRIMCG_OLD beg:PRHODREF",PRECISION)
- CALL MPPDB_CHECK1D(PLBDAS,"ICE4_RSRIMCG_OLD beg:PLBDAS",PRECISION)
- CALL MPPDB_CHECK1D(PT,"ICE4_RSRIMCG_OLD beg:PT",PRECISION)
- CALL MPPDB_CHECK1D(PRCT,"ICE4_RSRIMCG_OLD beg:PRCT",PRECISION)
- CALL MPPDB_CHECK1D(PRST,"ICE4_RSRIMCG_OLD beg:PRST",PRECISION)
+ CALL MPPDB_CHECK(ODCOMPUTE,"ICE4_RSRIMCG_OLD beg:ODCOMPUTE")
+ CALL MPPDB_CHECK(PRHODREF,"ICE4_RSRIMCG_OLD beg:PRHODREF")
+ CALL MPPDB_CHECK(PLBDAS,"ICE4_RSRIMCG_OLD beg:PLBDAS")
+ CALL MPPDB_CHECK(PT,"ICE4_RSRIMCG_OLD beg:PT")
+ CALL MPPDB_CHECK(PRCT,"ICE4_RSRIMCG_OLD beg:PRCT")
+ CALL MPPDB_CHECK(PRST,"ICE4_RSRIMCG_OLD beg:PRST")
!Check all INOUT arrays
- CALL MPPDB_CHECK1D(PB_RS,"ICE4_RSRIMCG_OLD beg:PB_RS",PRECISION)
- CALL MPPDB_CHECK1D(PB_RG,"ICE4_RSRIMCG_OLD beg:PB_RG",PRECISION)
+ CALL MPPDB_CHECK(PB_RS,"ICE4_RSRIMCG_OLD beg:PB_RS")
+ CALL MPPDB_CHECK(PB_RG,"ICE4_RSRIMCG_OLD beg:PB_RG")
END IF
!
!-------------------------------------------------------------------------------
@@ -110,13 +110,16 @@ END IF
!* 5.1 cloud droplet riming of the aggregates
!
!$acc kernels
-GDSOFT=LDSOFT !Workaround of PGI bug with OpenACC (at least up to 18.10 version)
+!PW: bug?: for the moment I take the value from the CPU as OK. GPU value seems to be lost when this subroutine is called
+GDSOFT=ODSOFT !Workaround of PGI bug with OpenACC (at least up to 18.10 version)
+!$acc end kernels
+!$acc kernels
PRSRIMCG_MR(:)=0.
!$acc end kernels
!
IF(.NOT. GDSOFT) THEN
!$acc kernels
- GRIM(:) = PRCT(:)>XRTMIN(2) .AND. PRST(:)>XRTMIN(5) .AND. LDCOMPUTE(:) .AND. PT(:)<XTT
+ GRIM(:) = PRCT(:)>XRTMIN(2) .AND. PRST(:)>XRTMIN(5) .AND. ODCOMPUTE(:) .AND. PT(:)<XTT
IGRIM = COUNT(GRIM(:))
!$acc end kernels
!$acc update self(IGRIM)
@@ -193,10 +196,10 @@ PB_RG(:) = PB_RG(:) + PRSRIMCG_MR(:)
!
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
- CALL MPPDB_CHECK1D(PB_RS,"ICE4_RSRIMCG_OLD end:PB_RS",PRECISION)
- CALL MPPDB_CHECK1D(PB_RG,"ICE4_RSRIMCG_OLD end:PB_RG",PRECISION)
+ CALL MPPDB_CHECK(PB_RS,"ICE4_RSRIMCG_OLD end:PB_RS")
+ CALL MPPDB_CHECK(PB_RG,"ICE4_RSRIMCG_OLD end:PB_RG")
!Check all OUT arrays
- CALL MPPDB_CHECK1D(PRSRIMCG_MR,"ICE4_RSRIMCG_OLD end:PRSRIMCG_MR",PRECISION)
+ CALL MPPDB_CHECK(PRSRIMCG_MR,"ICE4_RSRIMCG_OLD end:PRSRIMCG_MR")
END IF
!
END SUBROUTINE ICE4_RSRIMCG_OLD
diff --git a/src/MNH/ice4_sedimentation_split.f90 b/src/MNH/ice4_sedimentation_split.f90
index a60f53083f9dce9a8f1a716f799bd187717149d6..b9a867132b51c514928f0d4759c3e0c3cf8f1391 100644
--- a/src/MNH/ice4_sedimentation_split.f90
+++ b/src/MNH/ice4_sedimentation_split.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -164,26 +164,26 @@ REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZCONC3D,
!
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
- CALL MPPDB_CHECK3D(PDZZ,"ICE4_SEDIMENTATION_SPLIT beg:PDZZ",PRECISION)
- CALL MPPDB_CHECK3D(PRHODREF,"ICE4_SEDIMENTATION_SPLIT beg:PRHODREF",PRECISION)
- CALL MPPDB_CHECK3D(PPABST,"ICE4_SEDIMENTATION_SPLIT beg:PPABST",PRECISION)
- CALL MPPDB_CHECK3D(PTHT,"ICE4_SEDIMENTATION_SPLIT beg:PTHT",PRECISION)
- CALL MPPDB_CHECK3D(PRHODJ,"ICE4_SEDIMENTATION_SPLIT beg:PRHODJ",PRECISION)
- CALL MPPDB_CHECK3D(PRCT,"ICE4_SEDIMENTATION_SPLIT beg:PRCT",PRECISION)
- CALL MPPDB_CHECK3D(PRRT,"ICE4_SEDIMENTATION_SPLIT beg:PRRT",PRECISION)
- CALL MPPDB_CHECK3D(PRIT,"ICE4_SEDIMENTATION_SPLIT beg:PRIT",PRECISION)
- CALL MPPDB_CHECK3D(PRST,"ICE4_SEDIMENTATION_SPLIT beg:PRST",PRECISION)
- CALL MPPDB_CHECK3D(PRGT,"ICE4_SEDIMENTATION_SPLIT beg:PRGT",PRECISION)
- IF (PRESENT(PSEA)) CALL MPPDB_CHECK2D(PSEA,"ICE4_SEDIMENTATION_SPLIT beg:PSEA",PRECISION)
- IF (PRESENT(PTOWN)) CALL MPPDB_CHECK2D(PTOWN,"ICE4_SEDIMENTATION_SPLIT beg:PTOWN",PRECISION)
- IF (PRESENT(PRHT)) CALL MPPDB_CHECK3D(PRHT,"ICE4_SEDIMENTATION_SPLIT beg:PRHT",PRECISION)
+ CALL MPPDB_CHECK(PDZZ,"ICE4_SEDIMENTATION_SPLIT beg:PDZZ")
+ CALL MPPDB_CHECK(PRHODREF,"ICE4_SEDIMENTATION_SPLIT beg:PRHODREF")
+ CALL MPPDB_CHECK(PPABST,"ICE4_SEDIMENTATION_SPLIT beg:PPABST")
+ CALL MPPDB_CHECK(PTHT,"ICE4_SEDIMENTATION_SPLIT beg:PTHT")
+ CALL MPPDB_CHECK(PRHODJ,"ICE4_SEDIMENTATION_SPLIT beg:PRHODJ")
+ CALL MPPDB_CHECK(PRCT,"ICE4_SEDIMENTATION_SPLIT beg:PRCT")
+ CALL MPPDB_CHECK(PRRT,"ICE4_SEDIMENTATION_SPLIT beg:PRRT")
+ CALL MPPDB_CHECK(PRIT,"ICE4_SEDIMENTATION_SPLIT beg:PRIT")
+ CALL MPPDB_CHECK(PRST,"ICE4_SEDIMENTATION_SPLIT beg:PRST")
+ CALL MPPDB_CHECK(PRGT,"ICE4_SEDIMENTATION_SPLIT beg:PRGT")
+ IF (PRESENT(PSEA)) CALL MPPDB_CHECK(PSEA,"ICE4_SEDIMENTATION_SPLIT beg:PSEA")
+ IF (PRESENT(PTOWN)) CALL MPPDB_CHECK(PTOWN,"ICE4_SEDIMENTATION_SPLIT beg:PTOWN")
+ IF (PRESENT(PRHT)) CALL MPPDB_CHECK(PRHT,"ICE4_SEDIMENTATION_SPLIT beg:PRHT")
!Check all INOUT arrays
- CALL MPPDB_CHECK3D(PRCS,"ICE4_SEDIMENTATION_SPLIT beg:PRCS",PRECISION)
- CALL MPPDB_CHECK3D(PRRS,"ICE4_SEDIMENTATION_SPLIT beg:PRRS",PRECISION)
- CALL MPPDB_CHECK3D(PRIS,"ICE4_SEDIMENTATION_SPLIT beg:PRIS",PRECISION)
- CALL MPPDB_CHECK3D(PRSS,"ICE4_SEDIMENTATION_SPLIT beg:PRSS",PRECISION)
- CALL MPPDB_CHECK3D(PRGS,"ICE4_SEDIMENTATION_SPLIT beg:PRGS",PRECISION)
- IF (PRESENT(PRHS)) CALL MPPDB_CHECK3D(PRHS,"ICE4_SEDIMENTATION_SPLIT beg:PRHS",PRECISION)
+ CALL MPPDB_CHECK(PRCS,"ICE4_SEDIMENTATION_SPLIT beg:PRCS")
+ CALL MPPDB_CHECK(PRRS,"ICE4_SEDIMENTATION_SPLIT beg:PRRS")
+ CALL MPPDB_CHECK(PRIS,"ICE4_SEDIMENTATION_SPLIT beg:PRIS")
+ CALL MPPDB_CHECK(PRSS,"ICE4_SEDIMENTATION_SPLIT beg:PRSS")
+ CALL MPPDB_CHECK(PRGS,"ICE4_SEDIMENTATION_SPLIT beg:PRGS")
+ IF (PRESENT(PRHS)) CALL MPPDB_CHECK(PRHS,"ICE4_SEDIMENTATION_SPLIT beg:PRHS")
END IF
!
!$acc kernels
@@ -242,7 +242,6 @@ IF (GSEDIC) THEN
ZRAY(:,:,:) = MAX(1.,ZRAY(:,:,:))
ZLBC(:,:,:) = MAX(MIN(XLBC(1),XLBC(2)),ZLBC(:,:,:))
ENDIF
-!$acc end kernels
!
!* 2. compute the fluxes
!
@@ -251,7 +250,6 @@ ENDIF
! For optimization we consider each variable separately
!
! External tendecies
-!$acc kernels
IF (GSEDIC) THEN
ZPRCS(:,:,:) = PRCS(:,:,:)-PRCT(:,:,:)*ZINVTSTEP
ENDIF
@@ -262,10 +260,8 @@ ZPRGS(:,:,:) = PRGS(:,:,:)-PRGT(:,:,:)*ZINVTSTEP
IF ( IRR == 7 ) THEN
ZPRHS(:,:,:) = PRHS(:,:,:)-PRHT(:,:,:)*ZINVTSTEP
END IF
-!$acc end kernels
!
! mr values inside the time-splitting loop
-!$acc kernels
ZRCT(:,:,:) = PRCT(:,:,:)
ZRRT(:,:,:) = PRRT(:,:,:)
ZRIT(:,:,:) = PRIT(:,:,:)
@@ -274,9 +270,7 @@ ZRGT(:,:,:) = PRGT(:,:,:)
IF (IRR==7) THEN
ZRHT(:,:,:) = PRHT(:,:,:)
END IF
-!$acc end kernels
!
-!$acc kernels
ZW(:,:,KKTB:KKTE) =1./(PRHODREF(:,:,KKTB:KKTE)* PDZZ(:,:,KKTB:KKTE))
!$acc end kernels
!
@@ -358,28 +352,25 @@ IF (IRR==7) THEN
PFPR=PFPR)
ENDIF
!
-!PW:TODO: to remove when everything on GPU in rain_ice_red
-!$acc update self(PRCS,PRRS,PRIS,PRSS,PRGS,PRHS,PINPRC,PINDEP,PINPRR,PINPRI,PINPRS,PINPRG,PINPRH,PFPR)
-!
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
- CALL MPPDB_CHECK3D(PRCS,"ICE4_SEDIMENTATION_SPLIT end:PRCS",PRECISION)
- CALL MPPDB_CHECK3D(PRRS,"ICE4_SEDIMENTATION_SPLIT end:PRRS",PRECISION)
- CALL MPPDB_CHECK3D(PRIS,"ICE4_SEDIMENTATION_SPLIT end:PRIS",PRECISION)
- CALL MPPDB_CHECK3D(PRSS,"ICE4_SEDIMENTATION_SPLIT end:PRSS",PRECISION)
- CALL MPPDB_CHECK3D(PRGS,"ICE4_SEDIMENTATION_SPLIT end:PRGS",PRECISION)
- IF (PRESENT(PRHS)) CALL MPPDB_CHECK3D(PRHS,"ICE4_SEDIMENTATION_SPLIT end:PRHS",PRECISION)
+ CALL MPPDB_CHECK(PRCS,"ICE4_SEDIMENTATION_SPLIT end:PRCS")
+ CALL MPPDB_CHECK(PRRS,"ICE4_SEDIMENTATION_SPLIT end:PRRS")
+ CALL MPPDB_CHECK(PRIS,"ICE4_SEDIMENTATION_SPLIT end:PRIS")
+ CALL MPPDB_CHECK(PRSS,"ICE4_SEDIMENTATION_SPLIT end:PRSS")
+ CALL MPPDB_CHECK(PRGS,"ICE4_SEDIMENTATION_SPLIT end:PRGS")
+ IF (PRESENT(PRHS)) CALL MPPDB_CHECK(PRHS,"ICE4_SEDIMENTATION_SPLIT end:PRHS")
!Check all OUT arrays
- CALL MPPDB_CHECK2D(PINPRC,"ICE4_SEDIMENTATION_SPLIT end:PINPRC",PRECISION)
- CALL MPPDB_CHECK2D(PINDEP,"ICE4_SEDIMENTATION_SPLIT end:PINDEP",PRECISION)
- CALL MPPDB_CHECK2D(PINPRR,"ICE4_SEDIMENTATION_SPLIT end:PINPRR",PRECISION)
- CALL MPPDB_CHECK2D(PINPRI,"ICE4_SEDIMENTATION_SPLIT end:PINPRI",PRECISION)
- CALL MPPDB_CHECK2D(PINPRS,"ICE4_SEDIMENTATION_SPLIT end:PINPRS",PRECISION)
- CALL MPPDB_CHECK2D(PINPRG,"ICE4_SEDIMENTATION_SPLIT end:PINPRG",PRECISION)
- IF (PRESENT(PINPRH)) CALL MPPDB_CHECK2D(PINPRH,"ICE4_SEDIMENTATION_SPLIT end:PINPRH",PRECISION)
+ CALL MPPDB_CHECK(PINPRC,"ICE4_SEDIMENTATION_SPLIT end:PINPRC")
+ CALL MPPDB_CHECK(PINDEP,"ICE4_SEDIMENTATION_SPLIT end:PINDEP")
+ CALL MPPDB_CHECK(PINPRR,"ICE4_SEDIMENTATION_SPLIT end:PINPRR")
+ CALL MPPDB_CHECK(PINPRI,"ICE4_SEDIMENTATION_SPLIT end:PINPRI")
+ CALL MPPDB_CHECK(PINPRS,"ICE4_SEDIMENTATION_SPLIT end:PINPRS")
+ CALL MPPDB_CHECK(PINPRG,"ICE4_SEDIMENTATION_SPLIT end:PINPRG")
+ IF (PRESENT(PINPRH)) CALL MPPDB_CHECK(PINPRH,"ICE4_SEDIMENTATION_SPLIT end:PINPRH")
IF (PRESENT(PFPR)) THEN
DO JK=1,SIZE(PFPR,4)
- CALL MPPDB_CHECK3D(PFPR(:,:,:,JK),"ICE4_SEDIMENTATION_SPLIT end:PFPR(:,:,:,JK)",PRECISION)
+ CALL MPPDB_CHECK(PFPR(:,:,:,JK),"ICE4_SEDIMENTATION_SPLIT end:PFPR(:,:,:,JK)")
END DO
END IF
END IF
@@ -456,22 +447,22 @@ REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),0:SIZE(PRHODREF,3)+1) :: ZWSED
!
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
- CALL MPPDB_CHECK3D(PRHODREF,"INTERNAL_SEDIM_SPLI beg:PRHODREF",PRECISION)
- CALL MPPDB_CHECK3D(POORHODZ,"INTERNAL_SEDIM_SPLI beg:POORHODZ",PRECISION)
- CALL MPPDB_CHECK3D(PDZZ,"INTERNAL_SEDIM_SPLI beg:PDZZ",PRECISION)
- CALL MPPDB_CHECK3D(PPABST,"INTERNAL_SEDIM_SPLI beg:PPABST",PRECISION)
- CALL MPPDB_CHECK3D(PTHT,"INTERNAL_SEDIM_SPLI beg:PTHT",PRECISION)
- CALL MPPDB_CHECK3D(PPRXS,"INTERNAL_SEDIM_SPLI beg:PPRXS",PRECISION)
- IF (PRESENT(PRAY)) CALL MPPDB_CHECK3D(PRAY,"INTERNAL_SEDIM_SPLI beg:PRAY",PRECISION)
- IF (PRESENT(PLBC)) CALL MPPDB_CHECK3D(PLBC,"INTERNAL_SEDIM_SPLI beg:PLBC",PRECISION)
- IF (PRESENT(PFSEDC)) CALL MPPDB_CHECK3D(PFSEDC,"INTERNAL_SEDIM_SPLI beg:PFSEDC",PRECISION)
- IF (PRESENT(PCONC3D)) CALL MPPDB_CHECK3D(PCONC3D,"INTERNAL_SEDIM_SPLI beg:PCONC3D",PRECISION)
+ CALL MPPDB_CHECK(PRHODREF,"INTERNAL_SEDIM_SPLI beg:PRHODREF")
+ CALL MPPDB_CHECK(POORHODZ,"INTERNAL_SEDIM_SPLI beg:POORHODZ")
+ CALL MPPDB_CHECK(PDZZ,"INTERNAL_SEDIM_SPLI beg:PDZZ")
+ CALL MPPDB_CHECK(PPABST,"INTERNAL_SEDIM_SPLI beg:PPABST")
+ CALL MPPDB_CHECK(PTHT,"INTERNAL_SEDIM_SPLI beg:PTHT")
+ CALL MPPDB_CHECK(PPRXS,"INTERNAL_SEDIM_SPLI beg:PPRXS")
+ IF (PRESENT(PRAY)) CALL MPPDB_CHECK(PRAY,"INTERNAL_SEDIM_SPLI beg:PRAY")
+ IF (PRESENT(PLBC)) CALL MPPDB_CHECK(PLBC,"INTERNAL_SEDIM_SPLI beg:PLBC")
+ IF (PRESENT(PFSEDC)) CALL MPPDB_CHECK(PFSEDC,"INTERNAL_SEDIM_SPLI beg:PFSEDC")
+ IF (PRESENT(PCONC3D)) CALL MPPDB_CHECK(PCONC3D,"INTERNAL_SEDIM_SPLI beg:PCONC3D")
!Check all INOUT arrays
- CALL MPPDB_CHECK3D(PRXT,"INTERNAL_SEDIM_SPLI beg:PRXT",PRECISION)
- CALL MPPDB_CHECK3D(PRXS,"INTERNAL_SEDIM_SPLI beg:PRXS",PRECISION)
+ CALL MPPDB_CHECK(PRXT,"INTERNAL_SEDIM_SPLI beg:PRXT")
+ CALL MPPDB_CHECK(PRXS,"INTERNAL_SEDIM_SPLI beg:PRXS")
IF (PRESENT(PFPR)) THEN
DO JI=1,KRR
- CALL MPPDB_CHECK3D(PFPR(:,:,:,JI),"INTERNAL_SEDIM_SPLI beg:",PRECISION)
+ CALL MPPDB_CHECK(PFPR(:,:,:,JI),"INTERNAL_SEDIM_SPLI beg:")
END DO
END IF
END IF
@@ -652,15 +643,15 @@ END DO
!
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
- CALL MPPDB_CHECK3D(PRXT,"INTERNAL_SEDIM_SPLI end:PRXT",PRECISION)
- CALL MPPDB_CHECK3D(PRXS,"INTERNAL_SEDIM_SPLI end:PRXS",PRECISION)
+ CALL MPPDB_CHECK(PRXT,"INTERNAL_SEDIM_SPLI end:PRXT")
+ CALL MPPDB_CHECK(PRXS,"INTERNAL_SEDIM_SPLI end:PRXS")
IF (PRESENT(PFPR)) THEN
DO JI=1,KRR
- CALL MPPDB_CHECK3D(PFPR(:,:,:,JI),"INTERNAL_SEDIM_SPLI beg:",PRECISION)
+ CALL MPPDB_CHECK(PFPR(:,:,:,JI),"INTERNAL_SEDIM_SPLI beg:")
END DO
END IF
!Check all OUT arrays
- CALL MPPDB_CHECK2D(PINPRX,"INTERNAL_SEDIM_SPLI end:PINPRX",PRECISION)
+ CALL MPPDB_CHECK(PINPRX,"INTERNAL_SEDIM_SPLI end:PINPRX")
END IF
!
END SUBROUTINE INTERNAL_SEDIM_SPLI
diff --git a/src/MNH/ice4_slow.f90 b/src/MNH/ice4_slow.f90
index c106a610795e1db9b4c35fa8c89c531df49a079d..5459558e3a479ab075b4be0737e0aa6ee6a8a7d1 100644
--- a/src/MNH/ice4_slow.f90
+++ b/src/MNH/ice4_slow.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -134,38 +134,39 @@ REAL :: ZTIMAUTIC
!
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
- CALL MPPDB_CHECK1D_LOG(LDCOMPUTE,"ICE4_SLOW beg:LDCOMPUTE")
- CALL MPPDB_CHECK1D(PRHODREF,"ICE4_SLOW beg:PRHODREF",PRECISION)
- CALL MPPDB_CHECK1D(PT,"ICE4_SLOW beg:PT",PRECISION)
- CALL MPPDB_CHECK1D(PSSI,"ICE4_SLOW beg:PSSI",PRECISION)
- CALL MPPDB_CHECK1D(PLVFACT,"ICE4_SLOW beg:PLVFACT",PRECISION)
- CALL MPPDB_CHECK1D(PLSFACT,"ICE4_SLOW beg:PLSFACT",PRECISION)
- CALL MPPDB_CHECK1D(PRVT,"ICE4_SLOW beg:PRVT",PRECISION)
- CALL MPPDB_CHECK1D(PRCT,"ICE4_SLOW beg:PRCT",PRECISION)
- CALL MPPDB_CHECK1D(PRIT,"ICE4_SLOW beg:PRIT",PRECISION)
- CALL MPPDB_CHECK1D(PRST,"ICE4_SLOW beg:PRST",PRECISION)
- CALL MPPDB_CHECK1D(PRGT,"ICE4_SLOW beg:PRGT",PRECISION)
- CALL MPPDB_CHECK1D(PLBDAS,"ICE4_SLOW beg:PLBDAS",PRECISION)
- CALL MPPDB_CHECK1D(PLBDAG,"ICE4_SLOW beg:PLBDAG",PRECISION)
- CALL MPPDB_CHECK1D(PAI,"ICE4_SLOW beg:PAI",PRECISION)
- CALL MPPDB_CHECK1D(PCJ,"ICE4_SLOW beg:PCJ",PRECISION)
+ CALL MPPDB_CHECK(LDCOMPUTE,"ICE4_SLOW beg:LDCOMPUTE")
+ CALL MPPDB_CHECK(PRHODREF,"ICE4_SLOW beg:PRHODREF")
+ CALL MPPDB_CHECK(PT,"ICE4_SLOW beg:PT")
+ CALL MPPDB_CHECK(PSSI,"ICE4_SLOW beg:PSSI")
+ CALL MPPDB_CHECK(PLVFACT,"ICE4_SLOW beg:PLVFACT")
+ CALL MPPDB_CHECK(PLSFACT,"ICE4_SLOW beg:PLSFACT")
+ CALL MPPDB_CHECK(PRVT,"ICE4_SLOW beg:PRVT")
+ CALL MPPDB_CHECK(PRCT,"ICE4_SLOW beg:PRCT")
+ CALL MPPDB_CHECK(PRIT,"ICE4_SLOW beg:PRIT")
+ CALL MPPDB_CHECK(PRST,"ICE4_SLOW beg:PRST")
+ CALL MPPDB_CHECK(PRGT,"ICE4_SLOW beg:PRGT")
+ CALL MPPDB_CHECK(PLBDAS,"ICE4_SLOW beg:PLBDAS")
+ CALL MPPDB_CHECK(PLBDAG,"ICE4_SLOW beg:PLBDAG")
+ CALL MPPDB_CHECK(PAI,"ICE4_SLOW beg:PAI")
+ CALL MPPDB_CHECK(PCJ,"ICE4_SLOW beg:PCJ")
!Check all INOUT arrays
- CALL MPPDB_CHECK1D(PRCHONI,"ICE4_SLOW beg:PRCHONI",PRECISION)
- CALL MPPDB_CHECK1D(PRVDEPS,"ICE4_SLOW beg:PRVDEPS",PRECISION)
- CALL MPPDB_CHECK1D(PRIAGGS,"ICE4_SLOW beg:PRIAGGS",PRECISION)
- CALL MPPDB_CHECK1D(PRIAUTS,"ICE4_SLOW beg:PRIAUTS",PRECISION)
- CALL MPPDB_CHECK1D(PRVDEPG,"ICE4_SLOW beg:PRVDEPG",PRECISION)
- CALL MPPDB_CHECK1D(PA_TH,"ICE4_SLOW beg:PA_TH",PRECISION)
- CALL MPPDB_CHECK1D(PA_RV,"ICE4_SLOW beg:PA_RV",PRECISION)
- CALL MPPDB_CHECK1D(PA_RC,"ICE4_SLOW beg:PA_RC",PRECISION)
- CALL MPPDB_CHECK1D(PA_RI,"ICE4_SLOW beg:PA_RI",PRECISION)
- CALL MPPDB_CHECK1D(PA_RS,"ICE4_SLOW beg:PA_RS",PRECISION)
- CALL MPPDB_CHECK1D(PA_RG,"ICE4_SLOW beg:PA_RG",PRECISION)
+ CALL MPPDB_CHECK(PRCHONI,"ICE4_SLOW beg:PRCHONI")
+ CALL MPPDB_CHECK(PRVDEPS,"ICE4_SLOW beg:PRVDEPS")
+ CALL MPPDB_CHECK(PRIAGGS,"ICE4_SLOW beg:PRIAGGS")
+ CALL MPPDB_CHECK(PRIAUTS,"ICE4_SLOW beg:PRIAUTS")
+ CALL MPPDB_CHECK(PRVDEPG,"ICE4_SLOW beg:PRVDEPG")
+ CALL MPPDB_CHECK(PA_TH,"ICE4_SLOW beg:PA_TH")
+ CALL MPPDB_CHECK(PA_RV,"ICE4_SLOW beg:PA_RV")
+ CALL MPPDB_CHECK(PA_RC,"ICE4_SLOW beg:PA_RC")
+ CALL MPPDB_CHECK(PA_RI,"ICE4_SLOW beg:PA_RI")
+ CALL MPPDB_CHECK(PA_RS,"ICE4_SLOW beg:PA_RS")
+ CALL MPPDB_CHECK(PA_RG,"ICE4_SLOW beg:PA_RG")
END IF
!
-!$acc kernels
+! !$acc kernels
+!PW: bug?: for the moment I take the value from the CPU as OK. GPU value seems to be lost when this subroutine is called
GDSOFT = LDSOFT !Workaround of PGI bug with OpenACC (at least up to 18.10 version)
-!$acc end kernels
+! !$acc end kernels
!
!* 3.2 compute the homogeneous nucleation source: RCHONI
!
@@ -186,6 +187,7 @@ ELSE
#endif
ENDWHERE
ENDIF
+!
PA_RI(:) = PA_RI(:) + PRCHONI(:)
PA_RC(:) = PA_RC(:) - PRCHONI(:)
PA_TH(:) = PA_TH(:) + PRCHONI(:)*(PLSFACT(:)-PLVFACT(:))
@@ -305,17 +307,17 @@ PA_TH(:) = PA_TH(:) + PRVDEPG(:)*PLSFACT(:)
!
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
- CALL MPPDB_CHECK1D(PRCHONI,"ICE4_SLOW end:PRCHONI",PRECISION)
- CALL MPPDB_CHECK1D(PRVDEPS,"ICE4_SLOW end:PRVDEPS",PRECISION)
- CALL MPPDB_CHECK1D(PRIAGGS,"ICE4_SLOW end:PRIAGGS",PRECISION)
- CALL MPPDB_CHECK1D(PRIAUTS,"ICE4_SLOW end:PRIAUTS",PRECISION)
- CALL MPPDB_CHECK1D(PRVDEPG,"ICE4_SLOW end:PRVDEPG",PRECISION)
- CALL MPPDB_CHECK1D(PA_TH,"ICE4_SLOW end:PA_TH",PRECISION)
- CALL MPPDB_CHECK1D(PA_RV,"ICE4_SLOW end:PA_RV",PRECISION)
- CALL MPPDB_CHECK1D(PA_RC,"ICE4_SLOW end:PA_RC",PRECISION)
- CALL MPPDB_CHECK1D(PA_RI,"ICE4_SLOW end:PA_RI",PRECISION)
- CALL MPPDB_CHECK1D(PA_RS,"ICE4_SLOW end:PA_RS",PRECISION)
- CALL MPPDB_CHECK1D(PA_RG,"ICE4_SLOW end:PA_RG",PRECISION)
+ CALL MPPDB_CHECK(PRCHONI,"ICE4_SLOW end:PRCHONI")
+ CALL MPPDB_CHECK(PRVDEPS,"ICE4_SLOW end:PRVDEPS")
+ CALL MPPDB_CHECK(PRIAGGS,"ICE4_SLOW end:PRIAGGS")
+ CALL MPPDB_CHECK(PRIAUTS,"ICE4_SLOW end:PRIAUTS")
+ CALL MPPDB_CHECK(PRVDEPG,"ICE4_SLOW end:PRVDEPG")
+ CALL MPPDB_CHECK(PA_TH,"ICE4_SLOW end:PA_TH")
+ CALL MPPDB_CHECK(PA_RV,"ICE4_SLOW end:PA_RV")
+ CALL MPPDB_CHECK(PA_RC,"ICE4_SLOW end:PA_RC")
+ CALL MPPDB_CHECK(PA_RI,"ICE4_SLOW end:PA_RI")
+ CALL MPPDB_CHECK(PA_RS,"ICE4_SLOW end:PA_RS")
+ CALL MPPDB_CHECK(PA_RG,"ICE4_SLOW end:PA_RG")
END IF
!
END SUBROUTINE ICE4_SLOW
diff --git a/src/MNH/ice4_tendencies.f90 b/src/MNH/ice4_tendencies.f90
index 915afbca2f7cbef6aebbebe5b62fcd4353477e6e..f70dce72ba6f2488591f3ecb93a214bf872c35bd 100644
--- a/src/MNH/ice4_tendencies.f90
+++ b/src/MNH/ice4_tendencies.f90
@@ -1,11 +1,11 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
MODULE MODI_ICE4_TENDENCIES
INTERFACE
SUBROUTINE ICE4_TENDENCIES(KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, &
- &KRR, LDSOFT, LDCOMPUTE, &
+ &KRR, OLDSOFT, ODCOMPUTE, &
&OWARM, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, HSUBG_AUCV_RC, HSUBG_PR_PDF, &
&PEXN, PRHODREF, PLVFACT, PLSFACT, LDMICRO, K1, K2, K3, &
&PPRES, PCF, PSIGMA_RC, &
@@ -28,8 +28,8 @@ SUBROUTINE ICE4_TENDENCIES(KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, K
IMPLICIT NONE
INTEGER, INTENT(IN) :: KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL
INTEGER, INTENT(IN) :: KRR
-LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE
+LOGICAL, INTENT(IN) :: OLDSOFT
+LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: ODCOMPUTE
LOGICAL, INTENT(IN) :: OWARM
CHARACTER*80, INTENT(IN) :: HSUBG_RC_RR_ACCR
CHARACTER*80, INTENT(IN) :: HSUBG_RR_EVAP
@@ -132,7 +132,7 @@ END SUBROUTINE ICE4_TENDENCIES
END INTERFACE
END MODULE MODI_ICE4_TENDENCIES
SUBROUTINE ICE4_TENDENCIES(KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, &
- &KRR, LDSOFT, LDCOMPUTE, &
+ &KRR, OLDSOFT, ODCOMPUTE, &
&OWARM, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, HSUBG_AUCV_RC, HSUBG_PR_PDF, &
&PEXN, PRHODREF, PLVFACT, PLSFACT, LDMICRO, K1, K2, K3, &
&PPRES, PCF, PSIGMA_RC, &
@@ -198,8 +198,8 @@ IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL
INTEGER, INTENT(IN) :: KRR
-LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE
+LOGICAL, INTENT(IN) :: OLDSOFT
+LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: ODCOMPUTE
LOGICAL, INTENT(IN) :: OWARM
CHARACTER*80, INTENT(IN) :: HSUBG_RC_RR_ACCR
CHARACTER*80, INTENT(IN) :: HSUBG_RR_EVAP
@@ -299,9 +299,9 @@ REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HRC
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LRC
REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRAINFR ! Rain fraction
!
-!$acc declare present(KSIZE,KIB,KIE,KIT,KJB,KJE,KJT,KKB,KKE,KKT,KKL,KRR,LDSOFT, &
+!$acc declare present(KSIZE,KIB,KIE,KIT,KJB,KJE,KJT,KKB,KKE,KKT,KKL,KRR,OLDSOFT, &
!$acc& OWARM,HSUBG_RC_RR_ACCR,HSUBG_RR_EVAP,HSUBG_AUCV_RC,HSUBG_PR_PDF)
-!$acc declare present(LDCOMPUTE,PEXN,PRHODREF,PLVFACT,PLSFACT,LDMICRO,K1,K2,K3,PPRES,PCF,PCIT,PT,PTHT, &
+!$acc declare present(ODCOMPUTE,PEXN,PRHODREF,PLVFACT,PLSFACT,LDMICRO,K1,K2,K3,PPRES,PCF,PCIT,PT,PTHT, &
!$acc& PRVT,PRCT,PRRT,PRIT,PRST,PRGT,PRHT,PRRT3D,PSIGMA_RC,PRVHENI_MR,PRRHONG_MR,PRIMLTC_MR, &
!$acc& PRSRIMCG_MR,PRCHONI,PRVDEPS,PRIAGGS,PRIAUTS,PRVDEPG,PRCAUTR,PRCACCR,PRREVAV, &
!$acc& PRCRIMSS,PRCRIMSG,PRSRIMCG,PRRACCSS,PRRACCSG,PRSACCRG,PRSMLTG,PRCMLTSR,PRICFRRG,PRRCFRIG, &
@@ -324,6 +324,7 @@ REAL, DIMENSION(KSIZE) :: ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
& ZLBDAR, ZLBDAS, ZLBDAG, ZLBDAH, ZLBDAR_RF, &
& ZRGSI, ZRGSI_MR
REAL, DIMENSION(KIT,KJT,KKT) :: ZRRT3D
+LOGICAL :: GDSOFT, GWARM !Workaround of PGI bug with OpenACC (at least up to 18.10 version)
!
!$acc declare create(ZRVT,ZRCT,ZRRT,ZRIT,ZRST,ZRGT,ZT,ZTHT,ZZW,ZSSI,ZKA,ZDV,ZAI,ZCJ,ZRF, &
!$acc& ZLBDAR,ZLBDAS,ZLBDAG,ZLBDAH,ZLBDAR_RF,ZRGSI,ZRGSI_MR,ZRRT3D,IDX,JI,JJ,JK,JL,LLWETG)
@@ -334,50 +335,58 @@ REAL, DIMENSION(KIT,KJT,KKT) :: ZRRT3D
!
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
- CALL MPPDB_CHECK1D(PEXN,"ICE4_TENDENCIES beg:PEXN",PRECISION)
- CALL MPPDB_CHECK1D(PRHODREF,"ICE4_TENDENCIES begPRHODREF:",PRECISION)
- CALL MPPDB_CHECK1D(PLVFACT,"ICE4_TENDENCIES beg:PLVFACT",PRECISION)
- CALL MPPDB_CHECK1D(PLSFACT,"ICE4_TENDENCIES beg:PLSFACT",PRECISION)
- CALL MPPDB_CHECK3D_LOG(LDMICRO,"ICE4_TENDENCIES beg:LDMICRO")
- CALL MPPDB_CHECK1D_INT(K1,"ICE4_TENDENCIES beg:K1")
- CALL MPPDB_CHECK1D_INT(K2,"ICE4_TENDENCIES beg:K2")
- CALL MPPDB_CHECK1D_INT(K3,"ICE4_TENDENCIES beg:K3")
- CALL MPPDB_CHECK1D(PPRES,"ICE4_TENDENCIES beg:PPRES",PRECISION)
- CALL MPPDB_CHECK1D(PCF,"ICE4_TENDENCIES beg:PCF",PRECISION)
- CALL MPPDB_CHECK1D(PT,"ICE4_TENDENCIES beg:PT",PRECISION)
- CALL MPPDB_CHECK1D(PTHT,"ICE4_TENDENCIES beg:PTHT",PRECISION)
- CALL MPPDB_CHECK1D(PRVT,"ICE4_TENDENCIES beg:PRVT",PRECISION)
- CALL MPPDB_CHECK1D(PRCT,"ICE4_TENDENCIES beg:PRCT",PRECISION)
- CALL MPPDB_CHECK1D(PRRT,"ICE4_TENDENCIES beg:PRRT",PRECISION)
- CALL MPPDB_CHECK1D(PRIT,"ICE4_TENDENCIES beg:PRIT",PRECISION)
- CALL MPPDB_CHECK1D(PRST,"ICE4_TENDENCIES beg:PRST",PRECISION)
- CALL MPPDB_CHECK1D(PRGT,"ICE4_TENDENCIES beg:PRGT",PRECISION)
- CALL MPPDB_CHECK1D(PRHT,"ICE4_TENDENCIES beg:PRHT",PRECISION)
- CALL MPPDB_CHECK3D(PRRT3D,"ICE4_TENDENCIES beg:PRRT3D",PRECISION)
- CALL MPPDB_CHECK1D(PSIGMA_RC,"ICE4_TENDENCIES beg:PSIGMA_RC",PRECISION)
+ CALL MPPDB_CHECK(PEXN,"ICE4_TENDENCIES beg:PEXN")
+ CALL MPPDB_CHECK(PRHODREF,"ICE4_TENDENCIES beg: PRHODREF:")
+ CALL MPPDB_CHECK(PLVFACT,"ICE4_TENDENCIES beg:PLVFACT")
+ CALL MPPDB_CHECK(PLSFACT,"ICE4_TENDENCIES beg:PLSFACT")
+ CALL MPPDB_CHECK(LDMICRO,"ICE4_TENDENCIES beg:LDMICRO")
+ CALL MPPDB_CHECK(K1,"ICE4_TENDENCIES beg:K1")
+ CALL MPPDB_CHECK(K2,"ICE4_TENDENCIES beg:K2")
+ CALL MPPDB_CHECK(K3,"ICE4_TENDENCIES beg:K3")
+ CALL MPPDB_CHECK(PPRES,"ICE4_TENDENCIES beg:PPRES")
+ CALL MPPDB_CHECK(PCF,"ICE4_TENDENCIES beg:PCF")
+ CALL MPPDB_CHECK(PT,"ICE4_TENDENCIES beg:PT")
+ CALL MPPDB_CHECK(PTHT,"ICE4_TENDENCIES beg:PTHT")
+ CALL MPPDB_CHECK(PRVT,"ICE4_TENDENCIES beg:PRVT")
+ CALL MPPDB_CHECK(PRCT,"ICE4_TENDENCIES beg:PRCT")
+ CALL MPPDB_CHECK(PRRT,"ICE4_TENDENCIES beg:PRRT")
+ CALL MPPDB_CHECK(PRIT,"ICE4_TENDENCIES beg:PRIT")
+ CALL MPPDB_CHECK(PRST,"ICE4_TENDENCIES beg:PRST")
+ CALL MPPDB_CHECK(PRGT,"ICE4_TENDENCIES beg:PRGT")
+ CALL MPPDB_CHECK(PRHT,"ICE4_TENDENCIES beg:PRHT")
+ CALL MPPDB_CHECK(PRRT3D,"ICE4_TENDENCIES beg:PRRT3D")
+ CALL MPPDB_CHECK(PSIGMA_RC,"ICE4_TENDENCIES beg:PSIGMA_RC")
!Check all INOUT arrays
- CALL MPPDB_CHECK1D(PCIT,"ICE4_TENDENCIES beg:PCIT",PRECISION)
- CALL MPPDB_CHECK1D(PRCHONI,"ICE4_TENDENCIES beg:PRCHONI",PRECISION)
- CALL MPPDB_CHECK1D(PRVDEPS,"ICE4_TENDENCIES beg:PRVDEPS",PRECISION)
- CALL MPPDB_CHECK1D(PRIAGGS,"ICE4_TENDENCIES beg:PRIAGGS",PRECISION)
- CALL MPPDB_CHECK1D(PRIAUTS,"ICE4_TENDENCIES beg:PRIAUTS",PRECISION)
- CALL MPPDB_CHECK1D(PRVDEPG,"ICE4_TENDENCIES beg:PRVDEPG",PRECISION)
- CALL MPPDB_CHECK1D(PRCAUTR,"ICE4_TENDENCIES beg:PRCAUTR",PRECISION)
- CALL MPPDB_CHECK1D(PRCACCR,"ICE4_TENDENCIES beg:PRCACCR",PRECISION)
- CALL MPPDB_CHECK1D(PRREVAV,"ICE4_TENDENCIES beg:PRREVAV",PRECISION)
- CALL MPPDB_CHECK1D(PRSMLTG,"ICE4_TENDENCIES beg:PRSMLTG",PRECISION)
- CALL MPPDB_CHECK1D(PRCMLTSR,"ICE4_TENDENCIES beg:PRCMLTSR",PRECISION)
- CALL MPPDB_CHECK1D(PRICFRRG,"ICE4_TENDENCIES beg:PRICFRRG",PRECISION)
- CALL MPPDB_CHECK1D(PRRCFRIG,"ICE4_TENDENCIES beg:PRRCFRIG",PRECISION)
- CALL MPPDB_CHECK1D(PRICFRR,"ICE4_TENDENCIES beg:PRICFRR",PRECISION)
- CALL MPPDB_CHECK1D(PRGMLTR,"ICE4_TENDENCIES beg:PRGMLTR",PRECISION)
- CALL MPPDB_CHECK1D(PRHMLTR,"ICE4_TENDENCIES beg:PRHMLTR",PRECISION)
- CALL MPPDB_CHECK1D(PRCBERI,"ICE4_TENDENCIES beg:PRCBERI",PRECISION)
- CALL MPPDB_CHECK2D(PRS_TEND,"ICE4_TENDENCIES beg:PRS_TEND",PRECISION)
- CALL MPPDB_CHECK2D(PRG_TEND,"ICE4_TENDENCIES beg:PRG_TEND",PRECISION)
- CALL MPPDB_CHECK2D(PRH_TEND,"ICE4_TENDENCIES beg:PRH_TEND",PRECISION)
+ CALL MPPDB_CHECK(PCIT,"ICE4_TENDENCIES beg:PCIT")
+ CALL MPPDB_CHECK(PRCHONI,"ICE4_TENDENCIES beg:PRCHONI")
+ CALL MPPDB_CHECK(PRVDEPS,"ICE4_TENDENCIES beg:PRVDEPS")
+ CALL MPPDB_CHECK(PRIAGGS,"ICE4_TENDENCIES beg:PRIAGGS")
+ CALL MPPDB_CHECK(PRIAUTS,"ICE4_TENDENCIES beg:PRIAUTS")
+ CALL MPPDB_CHECK(PRVDEPG,"ICE4_TENDENCIES beg:PRVDEPG")
+ CALL MPPDB_CHECK(PRCAUTR,"ICE4_TENDENCIES beg:PRCAUTR")
+ CALL MPPDB_CHECK(PRCACCR,"ICE4_TENDENCIES beg:PRCACCR")
+ CALL MPPDB_CHECK(PRREVAV,"ICE4_TENDENCIES beg:PRREVAV")
+ CALL MPPDB_CHECK(PRSMLTG,"ICE4_TENDENCIES beg:PRSMLTG")
+ CALL MPPDB_CHECK(PRCMLTSR,"ICE4_TENDENCIES beg:PRCMLTSR")
+ CALL MPPDB_CHECK(PRICFRRG,"ICE4_TENDENCIES beg:PRICFRRG")
+ CALL MPPDB_CHECK(PRRCFRIG,"ICE4_TENDENCIES beg:PRRCFRIG")
+ CALL MPPDB_CHECK(PRICFRR,"ICE4_TENDENCIES beg:PRICFRR")
+ CALL MPPDB_CHECK(PRGMLTR,"ICE4_TENDENCIES beg:PRGMLTR")
+ CALL MPPDB_CHECK(PRHMLTR,"ICE4_TENDENCIES beg:PRHMLTR")
+ CALL MPPDB_CHECK(PRCBERI,"ICE4_TENDENCIES beg:PRCBERI")
+ CALL MPPDB_CHECK(PRS_TEND,"ICE4_TENDENCIES beg:PRS_TEND")
+ CALL MPPDB_CHECK(PRG_TEND,"ICE4_TENDENCIES beg:PRG_TEND")
+ CALL MPPDB_CHECK(PRH_TEND,"ICE4_TENDENCIES beg:PRH_TEND")
END IF
!
+!Workaround of PGI bug with OpenACC (at least up to 18.10 version)
+!$acc kernels
+GDSOFT = OLDSOFT
+GWARM = OWARM
+!$acc end kernels
+!
+!$acc data copyin(GDSOFT)
+!
!$acc kernels
IRR = KRR
ISIZE = KSIZE
@@ -422,7 +431,7 @@ ZT(:)=PT(:)
!
!* 2. COMPUTES THE SLOW COLD PROCESS SOURCES
! --------------------------------------
-CALL ICE4_NUCLEATION(KSIZE, LDSOFT, LDCOMPUTE, &
+CALL ICE4_NUCLEATION(KSIZE, GDSOFT, ODCOMPUTE, &
ZTHT, PPRES, PRHODREF, PEXN, PLSFACT, ZT, &
ZRVT, &
PCIT, PRVHENI_MR, PB_TH, PB_RV, PB_RI)
@@ -435,7 +444,7 @@ ZT(:) = ZTHT(:) * PEXN(:)
!
!* 3.3 compute the spontaneous freezing source: RRHONG
!
-CALL ICE4_RRHONG(KSIZE, LDSOFT, LDCOMPUTE, &
+CALL ICE4_RRHONG(KSIZE, GDSOFT, ODCOMPUTE, &
&PEXN, PLVFACT, PLSFACT, &
&ZT, ZRRT, &
&ZTHT, &
@@ -449,7 +458,7 @@ ZT(:) = ZTHT(:) * PEXN(:)
!
!* 7.1 cloud ice melting
!
-CALL ICE4_RIMLTC(KSIZE, LDSOFT, LDCOMPUTE, &
+CALL ICE4_RIMLTC(KSIZE, GDSOFT, ODCOMPUTE, &
&PEXN, PLVFACT, PLSFACT, &
&ZT, &
&ZTHT, ZRIT, &
@@ -471,7 +480,7 @@ WHERE(ZRST(:)>0.)
#endif
END WHERE
!$acc end kernels
-CALL ICE4_RSRIMCG_OLD(KSIZE, LDSOFT, LDCOMPUTE, &
+CALL ICE4_RSRIMCG_OLD(KSIZE, GDSOFT, ODCOMPUTE, &
&PRHODREF, &
&ZLBDAS, &
&ZT, ZRCT, ZRST, &
@@ -591,7 +600,9 @@ IF(KSIZE>0) THEN
ENDIF
!
!
-CALL ICE4_SLOW(KSIZE, LDSOFT, LDCOMPUTE, PRHODREF, ZT, &
+!PW:BUG: the following line is necessary for correct computation (at least for PGI 18.10)
+if(irr==-1) print *,'PW: ICE4_TENDENCIES: GDSOFT (cpu)=',GDSOFT
+CALL ICE4_SLOW(KSIZE, GDSOFT, ODCOMPUTE, PRHODREF, ZT, &
&ZSSI, PLVFACT, PLSFACT, &
&ZRVT, ZRCT, ZRIT, ZRST, ZRGT, &
&ZLBDAS, ZLBDAG, &
@@ -606,9 +617,9 @@ CALL ICE4_SLOW(KSIZE, LDSOFT, LDCOMPUTE, PRHODREF, ZT, &
! --------------------------------------
!
!
-IF(OWARM) THEN ! Check if the formation of the raindrops by the slow
+IF(GWARM) THEN ! Check if the formation of the raindrops by the slow
! warm processes is allowed
- CALL ICE4_WARM(KSIZE, LDSOFT, LDCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
+ CALL ICE4_WARM(KSIZE, GDSOFT, ODCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
&PRHODREF, PLVFACT, ZT, PPRES, ZTHT,&
&ZLBDAR, ZLBDAR_RF, ZKA, ZDV, ZCJ, &
&PHLC_LCF, PHLC_HCF, PHLC_LRC, PHLC_HRC, &
@@ -630,7 +641,7 @@ END IF
!* 4. COMPUTES THE FAST COLD PROCESS SOURCES FOR r_s
! ----------------------------------------------
!
-CALL ICE4_FAST_RS(KSIZE, LDSOFT, LDCOMPUTE, &
+CALL ICE4_FAST_RS(KSIZE, GDSOFT, ODCOMPUTE, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&ZDV, ZKA, ZCJ, &
&ZLBDAR, ZLBDAS, &
@@ -652,7 +663,7 @@ CALL ICE4_FAST_RS(KSIZE, LDSOFT, LDCOMPUTE, &
ZRGSI(:) = PRVDEPG(:) + PRSMLTG(:) + PRRACCSG(:) + PRSACCRG(:) + PRCRIMSG(:) + PRSRIMCG(:)
ZRGSI_MR(:) = PRRHONG_MR(:) + PRSRIMCG_MR(:)
!$acc end kernels
-CALL ICE4_FAST_RG(KSIZE, LDSOFT, LDCOMPUTE, KRR, &
+CALL ICE4_FAST_RG(KSIZE, GDSOFT, ODCOMPUTE, KRR, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&ZDV, ZKA, ZCJ, PCIT, &
&ZLBDAR, ZLBDAS, ZLBDAG, &
@@ -671,7 +682,7 @@ CALL ICE4_FAST_RG(KSIZE, LDSOFT, LDCOMPUTE, KRR, &
! ----------------------------------------------
!
IF (KRR==7) THEN
- CALL ICE4_FAST_RH(KSIZE, LDSOFT, LDCOMPUTE, LLWETG, &
+ CALL ICE4_FAST_RH(KSIZE, GDSOFT, ODCOMPUTE, LLWETG, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&ZDV, ZKA, ZCJ, &
&ZLBDAS, ZLBDAG, ZLBDAR, ZLBDAH, &
@@ -703,89 +714,90 @@ END IF
!* 7. COMPUTES SPECIFIC SOURCES OF THE WARM AND COLD CLOUDY SPECIES
! -------------------------------------------------------------
!
-CALL ICE4_FAST_RI(KSIZE, LDSOFT, LDCOMPUTE, &
+CALL ICE4_FAST_RI(KSIZE, GDSOFT, ODCOMPUTE, &
&PRHODREF, PLVFACT, PLSFACT, &
&ZAI, ZCJ, PCIT, &
&ZSSI, &
&ZRCT, ZRIT, &
&PRCBERI, PA_TH, PA_RC, PA_RI)
!
+!$acc end data
!
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
- CALL MPPDB_CHECK1D(PCIT,"ICE4_TENDENCIES end:PCIT",PRECISION)
- CALL MPPDB_CHECK1D(PRCHONI,"ICE4_TENDENCIES end:PRCHONI",PRECISION)
- CALL MPPDB_CHECK1D(PRVDEPS,"ICE4_TENDENCIES end:PRVDEPS",PRECISION)
- CALL MPPDB_CHECK1D(PRIAGGS,"ICE4_TENDENCIES end:PRIAGGS",PRECISION)
- CALL MPPDB_CHECK1D(PRIAUTS,"ICE4_TENDENCIES end:PRIAUTS",PRECISION)
- CALL MPPDB_CHECK1D(PRVDEPG,"ICE4_TENDENCIES end:PRVDEPG",PRECISION)
- CALL MPPDB_CHECK1D(PRCAUTR,"ICE4_TENDENCIES end:PRCAUTR",PRECISION)
- CALL MPPDB_CHECK1D(PRCACCR,"ICE4_TENDENCIES end:PRCACCR",PRECISION)
- CALL MPPDB_CHECK1D(PRREVAV,"ICE4_TENDENCIES end:PRREVAV",PRECISION)
- CALL MPPDB_CHECK1D(PRSMLTG,"ICE4_TENDENCIES end:PRSMLTG",PRECISION)
- CALL MPPDB_CHECK1D(PRCMLTSR,"ICE4_TENDENCIES end:PRCMLTSR",PRECISION)
- CALL MPPDB_CHECK1D(PRICFRRG,"ICE4_TENDENCIES end:PRICFRRG",PRECISION)
- CALL MPPDB_CHECK1D(PRRCFRIG,"ICE4_TENDENCIES end:PRRCFRIG",PRECISION)
- CALL MPPDB_CHECK1D(PRICFRR,"ICE4_TENDENCIES end:PRICFRR",PRECISION)
- CALL MPPDB_CHECK1D(PRGMLTR,"ICE4_TENDENCIES end:PRGMLTR",PRECISION)
- CALL MPPDB_CHECK1D(PRHMLTR,"ICE4_TENDENCIES end:PRHMLTR",PRECISION)
- CALL MPPDB_CHECK1D(PRCBERI,"ICE4_TENDENCIES end:PRCBERI",PRECISION)
- CALL MPPDB_CHECK2D(PRS_TEND,"ICE4_TENDENCIES end:PRS_TEND",PRECISION)
- CALL MPPDB_CHECK2D(PRG_TEND,"ICE4_TENDENCIES end:PRG_TEND",PRECISION)
- CALL MPPDB_CHECK2D(PRH_TEND,"ICE4_TENDENCIES end:PRH_TEND",PRECISION)
+ CALL MPPDB_CHECK(PCIT,"ICE4_TENDENCIES end:PCIT")
+ CALL MPPDB_CHECK(PRCHONI,"ICE4_TENDENCIES end:PRCHONI")
+ CALL MPPDB_CHECK(PRVDEPS,"ICE4_TENDENCIES end:PRVDEPS")
+ CALL MPPDB_CHECK(PRIAGGS,"ICE4_TENDENCIES end:PRIAGGS")
+ CALL MPPDB_CHECK(PRIAUTS,"ICE4_TENDENCIES end:PRIAUTS")
+ CALL MPPDB_CHECK(PRVDEPG,"ICE4_TENDENCIES end:PRVDEPG")
+ CALL MPPDB_CHECK(PRCAUTR,"ICE4_TENDENCIES end:PRCAUTR")
+ CALL MPPDB_CHECK(PRCACCR,"ICE4_TENDENCIES end:PRCACCR")
+ CALL MPPDB_CHECK(PRREVAV,"ICE4_TENDENCIES end:PRREVAV")
+ CALL MPPDB_CHECK(PRSMLTG,"ICE4_TENDENCIES end:PRSMLTG")
+ CALL MPPDB_CHECK(PRCMLTSR,"ICE4_TENDENCIES end:PRCMLTSR")
+ CALL MPPDB_CHECK(PRICFRRG,"ICE4_TENDENCIES end:PRICFRRG")
+ CALL MPPDB_CHECK(PRRCFRIG,"ICE4_TENDENCIES end:PRRCFRIG")
+ CALL MPPDB_CHECK(PRICFRR,"ICE4_TENDENCIES end:PRICFRR")
+ CALL MPPDB_CHECK(PRGMLTR,"ICE4_TENDENCIES end:PRGMLTR")
+ CALL MPPDB_CHECK(PRHMLTR,"ICE4_TENDENCIES end:PRHMLTR")
+ CALL MPPDB_CHECK(PRCBERI,"ICE4_TENDENCIES end:PRCBERI")
+ CALL MPPDB_CHECK(PRS_TEND,"ICE4_TENDENCIES end:PRS_TEND")
+ CALL MPPDB_CHECK(PRG_TEND,"ICE4_TENDENCIES end:PRG_TEND")
+ CALL MPPDB_CHECK(PRH_TEND,"ICE4_TENDENCIES end:PRH_TEND")
!Check all OUT arrays
- CALL MPPDB_CHECK1D(PRCRIMSS,"ICE4_TENDENCIES end:PRCRIMSS",PRECISION)
- CALL MPPDB_CHECK1D(PRCRIMSG,"ICE4_TENDENCIES end:PRCRIMSG",PRECISION)
- CALL MPPDB_CHECK1D(PRSRIMCG,"ICE4_TENDENCIES end:PRSRIMCG",PRECISION)
- CALL MPPDB_CHECK1D(PRRACCSS,"ICE4_TENDENCIES end:PRRACCSS",PRECISION)
- CALL MPPDB_CHECK1D(PRRACCSG,"ICE4_TENDENCIES end:PRRACCSG",PRECISION)
- CALL MPPDB_CHECK1D(PRSACCRG,"ICE4_TENDENCIES end:PRSACCRG",PRECISION)
- CALL MPPDB_CHECK1D(PRVHENI_MR,"ICE4_TENDENCIES end:PRVHENI_MR",PRECISION)
- CALL MPPDB_CHECK1D(PRRHONG_MR,"ICE4_TENDENCIES end:PRRHONG_MR",PRECISION)
- CALL MPPDB_CHECK1D(PRIMLTC_MR,"ICE4_TENDENCIES end:PRIMLTC_MR",PRECISION)
- CALL MPPDB_CHECK1D(PRSRIMCG_MR,"ICE4_TENDENCIES end:PRSRIMCG_MR",PRECISION)
- CALL MPPDB_CHECK1D(PRCWETG,"ICE4_TENDENCIES end:PRCWETG",PRECISION)
- CALL MPPDB_CHECK1D(PRIWETG,"ICE4_TENDENCIES end:PRIWETG",PRECISION)
- CALL MPPDB_CHECK1D(PRRWETG,"ICE4_TENDENCIES end:PRRWETG",PRECISION)
- CALL MPPDB_CHECK1D(PRSWETG,"ICE4_TENDENCIES end:PRSWETG",PRECISION)
- CALL MPPDB_CHECK1D(PRCDRYG,"ICE4_TENDENCIES end:PRCDRYG",PRECISION)
- CALL MPPDB_CHECK1D(PRIDRYG,"ICE4_TENDENCIES end:PRIDRYG",PRECISION)
- CALL MPPDB_CHECK1D(PRRDRYG,"ICE4_TENDENCIES end:PRRDRYG",PRECISION)
- CALL MPPDB_CHECK1D(PRSDRYG,"ICE4_TENDENCIES end:PRSDRYG",PRECISION)
- CALL MPPDB_CHECK1D(PRWETGH,"ICE4_TENDENCIES end:PRWETGH",PRECISION)
- CALL MPPDB_CHECK1D(PRWETGH_MR,"ICE4_TENDENCIES end:PRWETGH_MR",PRECISION)
- CALL MPPDB_CHECK1D(PRCWETH,"ICE4_TENDENCIES end:PRCWETH",PRECISION)
- CALL MPPDB_CHECK1D(PRIWETH,"ICE4_TENDENCIES end:PRIWETH",PRECISION)
- CALL MPPDB_CHECK1D(PRSWETH,"ICE4_TENDENCIES end:PRSWETH",PRECISION)
- CALL MPPDB_CHECK1D(PRGWETH,"ICE4_TENDENCIES end:PRGWETH",PRECISION)
- CALL MPPDB_CHECK1D(PRRWETH,"ICE4_TENDENCIES end:PRRWETH",PRECISION)
- CALL MPPDB_CHECK1D(PRCDRYH,"ICE4_TENDENCIES end:PRCDRYH",PRECISION)
- CALL MPPDB_CHECK1D(PRIDRYH,"ICE4_TENDENCIES end:PRIDRYH",PRECISION)
- CALL MPPDB_CHECK1D(PRSDRYH,"ICE4_TENDENCIES end:PRSDRYH",PRECISION)
- CALL MPPDB_CHECK1D(PRRDRYH,"ICE4_TENDENCIES end:PRRDRYH",PRECISION)
- CALL MPPDB_CHECK1D(PRGDRYH,"ICE4_TENDENCIES end:PRGDRYH",PRECISION)
- CALL MPPDB_CHECK1D(PRDRYHG,"ICE4_TENDENCIES end:PRDRYHG",PRECISION)
- CALL MPPDB_CHECK1D(PA_TH,"ICE4_TENDENCIES end:PA_TH",PRECISION)
- CALL MPPDB_CHECK1D(PA_RV,"ICE4_TENDENCIES end:PA_RV",PRECISION)
- CALL MPPDB_CHECK1D(PA_RC,"ICE4_TENDENCIES end:PA_RC",PRECISION)
- CALL MPPDB_CHECK1D(PA_RR,"ICE4_TENDENCIES end:PA_RR",PRECISION)
- CALL MPPDB_CHECK1D(PA_RI,"ICE4_TENDENCIES end:PA_RI",PRECISION)
- CALL MPPDB_CHECK1D(PA_RS,"ICE4_TENDENCIES end:PA_RS",PRECISION)
- CALL MPPDB_CHECK1D(PA_RG,"ICE4_TENDENCIES end:PA_RG",PRECISION)
- CALL MPPDB_CHECK1D(PA_RH,"ICE4_TENDENCIES end:PA_RH",PRECISION)
- CALL MPPDB_CHECK1D(PB_TH,"ICE4_TENDENCIES end:PB_TH",PRECISION)
- CALL MPPDB_CHECK1D(PB_RV,"ICE4_TENDENCIES end:PB_RV",PRECISION)
- CALL MPPDB_CHECK1D(PB_RC,"ICE4_TENDENCIES end:PB_RC",PRECISION)
- CALL MPPDB_CHECK1D(PB_RR,"ICE4_TENDENCIES end:PB_RR",PRECISION)
- CALL MPPDB_CHECK1D(PB_RI,"ICE4_TENDENCIES end:PB_RI",PRECISION)
- CALL MPPDB_CHECK1D(PB_RS,"ICE4_TENDENCIES end:PB_RS",PRECISION)
- CALL MPPDB_CHECK1D(PB_RG,"ICE4_TENDENCIES end:PB_RG",PRECISION)
- CALL MPPDB_CHECK1D(PB_RH,"ICE4_TENDENCIES end:PB_RH",PRECISION)
- CALL MPPDB_CHECK1D(PHLC_HCF,"ICE4_TENDENCIES end:PHLC_HCF",PRECISION)
- CALL MPPDB_CHECK1D(PHLC_LCF,"ICE4_TENDENCIES end:PHLC_LCF",PRECISION)
- CALL MPPDB_CHECK1D(PHLC_HRC,"ICE4_TENDENCIES end:PHLC_HRC",PRECISION)
- CALL MPPDB_CHECK1D(PHLC_LRC,"ICE4_TENDENCIES end:PHLC_LRC",PRECISION)
- CALL MPPDB_CHECK3D(PRAINFR,"ICE4_TENDENCIES end:PRAINFR",PRECISION)
+ CALL MPPDB_CHECK(PRCRIMSS,"ICE4_TENDENCIES end:PRCRIMSS")
+ CALL MPPDB_CHECK(PRCRIMSG,"ICE4_TENDENCIES end:PRCRIMSG")
+ CALL MPPDB_CHECK(PRSRIMCG,"ICE4_TENDENCIES end:PRSRIMCG")
+ CALL MPPDB_CHECK(PRRACCSS,"ICE4_TENDENCIES end:PRRACCSS")
+ CALL MPPDB_CHECK(PRRACCSG,"ICE4_TENDENCIES end:PRRACCSG")
+ CALL MPPDB_CHECK(PRSACCRG,"ICE4_TENDENCIES end:PRSACCRG")
+ CALL MPPDB_CHECK(PRVHENI_MR,"ICE4_TENDENCIES end:PRVHENI_MR")
+ CALL MPPDB_CHECK(PRRHONG_MR,"ICE4_TENDENCIES end:PRRHONG_MR")
+ CALL MPPDB_CHECK(PRIMLTC_MR,"ICE4_TENDENCIES end:PRIMLTC_MR")
+ CALL MPPDB_CHECK(PRSRIMCG_MR,"ICE4_TENDENCIES end:PRSRIMCG_MR")
+ CALL MPPDB_CHECK(PRCWETG,"ICE4_TENDENCIES end:PRCWETG")
+ CALL MPPDB_CHECK(PRIWETG,"ICE4_TENDENCIES end:PRIWETG")
+ CALL MPPDB_CHECK(PRRWETG,"ICE4_TENDENCIES end:PRRWETG")
+ CALL MPPDB_CHECK(PRSWETG,"ICE4_TENDENCIES end:PRSWETG")
+ CALL MPPDB_CHECK(PRCDRYG,"ICE4_TENDENCIES end:PRCDRYG")
+ CALL MPPDB_CHECK(PRIDRYG,"ICE4_TENDENCIES end:PRIDRYG")
+ CALL MPPDB_CHECK(PRRDRYG,"ICE4_TENDENCIES end:PRRDRYG")
+ CALL MPPDB_CHECK(PRSDRYG,"ICE4_TENDENCIES end:PRSDRYG")
+ CALL MPPDB_CHECK(PRWETGH,"ICE4_TENDENCIES end:PRWETGH")
+ CALL MPPDB_CHECK(PRWETGH_MR,"ICE4_TENDENCIES end:PRWETGH_MR")
+ CALL MPPDB_CHECK(PRCWETH,"ICE4_TENDENCIES end:PRCWETH")
+ CALL MPPDB_CHECK(PRIWETH,"ICE4_TENDENCIES end:PRIWETH")
+ CALL MPPDB_CHECK(PRSWETH,"ICE4_TENDENCIES end:PRSWETH")
+ CALL MPPDB_CHECK(PRGWETH,"ICE4_TENDENCIES end:PRGWETH")
+ CALL MPPDB_CHECK(PRRWETH,"ICE4_TENDENCIES end:PRRWETH")
+ CALL MPPDB_CHECK(PRCDRYH,"ICE4_TENDENCIES end:PRCDRYH")
+ CALL MPPDB_CHECK(PRIDRYH,"ICE4_TENDENCIES end:PRIDRYH")
+ CALL MPPDB_CHECK(PRSDRYH,"ICE4_TENDENCIES end:PRSDRYH")
+ CALL MPPDB_CHECK(PRRDRYH,"ICE4_TENDENCIES end:PRRDRYH")
+ CALL MPPDB_CHECK(PRGDRYH,"ICE4_TENDENCIES end:PRGDRYH")
+ CALL MPPDB_CHECK(PRDRYHG,"ICE4_TENDENCIES end:PRDRYHG")
+ CALL MPPDB_CHECK(PA_TH,"ICE4_TENDENCIES end:PA_TH")
+ CALL MPPDB_CHECK(PA_RV,"ICE4_TENDENCIES end:PA_RV")
+ CALL MPPDB_CHECK(PA_RC,"ICE4_TENDENCIES end:PA_RC")
+ CALL MPPDB_CHECK(PA_RR,"ICE4_TENDENCIES end:PA_RR")
+ CALL MPPDB_CHECK(PA_RI,"ICE4_TENDENCIES end:PA_RI")
+ CALL MPPDB_CHECK(PA_RS,"ICE4_TENDENCIES end:PA_RS")
+ CALL MPPDB_CHECK(PA_RG,"ICE4_TENDENCIES end:PA_RG")
+ CALL MPPDB_CHECK(PA_RH,"ICE4_TENDENCIES end:PA_RH")
+ CALL MPPDB_CHECK(PB_TH,"ICE4_TENDENCIES end:PB_TH")
+ CALL MPPDB_CHECK(PB_RV,"ICE4_TENDENCIES end:PB_RV")
+ CALL MPPDB_CHECK(PB_RC,"ICE4_TENDENCIES end:PB_RC")
+ CALL MPPDB_CHECK(PB_RR,"ICE4_TENDENCIES end:PB_RR")
+ CALL MPPDB_CHECK(PB_RI,"ICE4_TENDENCIES end:PB_RI")
+ CALL MPPDB_CHECK(PB_RS,"ICE4_TENDENCIES end:PB_RS")
+ CALL MPPDB_CHECK(PB_RG,"ICE4_TENDENCIES end:PB_RG")
+ CALL MPPDB_CHECK(PB_RH,"ICE4_TENDENCIES end:PB_RH")
+ CALL MPPDB_CHECK(PHLC_HCF,"ICE4_TENDENCIES end:PHLC_HCF")
+ CALL MPPDB_CHECK(PHLC_LCF,"ICE4_TENDENCIES end:PHLC_LCF")
+ CALL MPPDB_CHECK(PHLC_HRC,"ICE4_TENDENCIES end:PHLC_HRC")
+ CALL MPPDB_CHECK(PHLC_LRC,"ICE4_TENDENCIES end:PHLC_LRC")
+ CALL MPPDB_CHECK(PRAINFR,"ICE4_TENDENCIES end:PRAINFR")
END IF
!
END SUBROUTINE ICE4_TENDENCIES
diff --git a/src/MNH/ice4_warm.f90 b/src/MNH/ice4_warm.f90
index a0e5d366333cb1fb1733e03cc32b1773618b0e24..74728719dd07f7cde2d9f858bff14e0ef0a37588 100644
--- a/src/MNH/ice4_warm.f90
+++ b/src/MNH/ice4_warm.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -168,9 +168,10 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK1D(PA_RR,"ICE4_WARM beg:PA_RR",PRECISION)
END IF
!
-!$acc kernels
+! !$acc kernels
+!PW: bug?: for the moment I take the value from the CPU as OK. GPU value seems to be lost when this subroutine is called
GDSOFT = LDSOFT !Workaround of PGI bug with OpenACC (at least up to 18.10 version)
-!$acc end kernels
+! !$acc end kernels
!
!* 4.2 compute the autoconversion of r_c for r_r production: RCAUTR
!
diff --git a/src/MNH/ice_adjust.f90 b/src/MNH/ice_adjust.f90
index e09adabe22b14b69e287eac8a46a4154ec94eb38..37e4c6493c2d6b5944c3222992b8e09702891082 100644
--- a/src/MNH/ice_adjust.f90
+++ b/src/MNH/ice_adjust.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1996-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1996-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -391,6 +391,8 @@ DO JITER =1,ITERMAX
!
!CALL ADJUST_LANGLOIS(IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, KKL, &
! PPABST, ZT, ZRV, ZRC, ZRI, ZLV, ZLS, ZCPH) HFRAC_ICE must be implemented in Langlois before using it again
+!PW: TODO: ZSRCS not used !!! (OUT variable from CONDENSATION)
+!PW:TODO: autres optis: ZSIGS=0 and PSIGQSAT=0 -> less computation...
!$acc kernels
ZSIGS=0.
!$acc end kernels
diff --git a/src/MNH/modeln.f90 b/src/MNH/modeln.f90
index 80c72a9c3702613161e685bb1a534a9a3a048437..86434c439fbb373376eb8714df6e1995742689b6 100644
--- a/src/MNH/modeln.f90
+++ b/src/MNH/modeln.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ###################
@@ -905,8 +905,6 @@ ZTIME1=ZTIME2
IF( LLG .AND. IMI==1 ) CALL SETLB_LG
!
IF (CCONF == "START" .OR. (CCONF == "RESTA" .AND. KTCOUNT /= 1 )) THEN
-CALL MPPDB_CHECK3DM("before BOUNDARIES:XU/V/W/TH/TKET",PRECISION,&
- & XUT, XVT, XWT, XTHT, XTKET)
CALL BOUNDARIES ( &
XTSTEP,CLBCX,CLBCY,NRR,NSV,KTCOUNT, &
XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM, &
@@ -915,8 +913,6 @@ CALL BOUNDARIES ( &
XLBYUS,XLBYVS,XLBYWS,XLBYTHS,XLBYTKES,XLBYRS,XLBYSVS, &
XRHODJ, &
XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT )
-CALL MPPDB_CHECK3DM("after BOUNDARIES:XU/V/W/TH/TKET",PRECISION,&
- & XUT, XVT, XWT, XTHT, XTKET)
END IF
!
CALL SECOND_MNH2(ZTIME2)
@@ -1522,8 +1518,6 @@ XTIME_LES_BU_PROCESS = 0.
!
!
!
-CALL MPPDB_CHECK3DM("before ADVEC_METSV:XU/V/W/TH/TKE/T,XRHODJ",PRECISION,&
- & XUT, XVT, XWT, XTHT, XTKET,XRHODJ)
CALL ADVECTION_METSV ( TZBAKFILE, GCLOSE_OUT,CUVW_ADV_SCHEME, &
CMET_ADV_SCHEME, CSV_ADV_SCHEME, CCLOUD, NSPLIT, &
LSPLIT_CFL, XSPLIT_CFL, LCFL_WRIT, &
@@ -1532,8 +1526,6 @@ CALL MPPDB_CHECK3DM("before ADVEC_METSV:XU/V/W/TH/TKE/T,XRHODJ",PRECISION,&
XTHVREF, XRHODJ, XDXX, XDYY, XDZZ, XDZX, XDZY, &
XRTHS, XRRS, XRTKES, XRSVS, &
XRTHS_CLD, XRRS_CLD, XRSVS_CLD, XRTKEMS )
-CALL MPPDB_CHECK3DM("after ADVEC_METSV:XU/V/W/TH/TKE/T,XRHODJ ",PRECISION,&
- & XUT, XVT, XWT, XTHT, XTKET,XRHODJ)
!
CALL SECOND_MNH2(ZTIME2)
!
@@ -1564,9 +1556,6 @@ ZTIME1 = ZTIME2
XTIME_BU_PROCESS = 0.
XTIME_LES_BU_PROCESS = 0.
!
-!MPPDB_CHECK_LB=.TRUE.
-CALL MPPDB_CHECK3DM("before ADVEC_UVW:XU/V/W/TH/TKE/T,XRHODJ,XRU/V/Ws",PRECISION,&
- & XUT, XVT, XWT, XTHT, XTKET,XRHODJ,XRUS,XRVS,XRWS)
IF ((CUVW_ADV_SCHEME(1:3)=='CEN') .AND. (CTEMP_SCHEME == 'LEFR')) THEN
IF (CUVW_ADV_SCHEME=='CEN4TH') THEN
NULLIFY(TZFIELDC_ll)
@@ -1603,9 +1592,6 @@ ELSE
XRUS_PRES, XRVS_PRES, XRWS_PRES )
END IF
!
-CALL MPPDB_CHECK3DM("after ADVEC_UVW:XU/V/W/TH/TKE/T,XRHODJ,XRU/V/Ws",PRECISION,&
- & XUT, XVT, XWT, XTHT, XTKET,XRHODJ,XRUS,XRVS,XRWS)
-!MPPDB_CHECK_LB=.FALSE.
!
CALL SECOND_MNH2(ZTIME2)
!
@@ -1627,7 +1613,6 @@ END IF
!
ZTIME1 = ZTIME2
!
-CALL MPPDB_CHECK3DM("before RAD_BOUND :XRU/V/WS",PRECISION,XRUS,XRVS,XRWS)
ZRUS=XRUS
ZRVS=XRVS
ZRWS=XRWS
@@ -1660,7 +1645,6 @@ ZPABST = XPABST
!
IF(.NOT. L1D) THEN
!
-CALL MPPDB_CHECK3DM("before pressurez:XRU/V/WS",PRECISION,XRUS,XRVS,XRWS)
XRUS_PRES = XRUS
XRVS_PRES = XRVS
XRWS_PRES = XRWS
diff --git a/src/MNH/rain_ice.f90 b/src/MNH/rain_ice.f90
index 230db2358df08ff79635002ad8e1832a455ea86a..e17604093c027c6bfeff73c78a2efe8ec00ea844 100644
--- a/src/MNH/rain_ice.f90
+++ b/src/MNH/rain_ice.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -529,41 +529,41 @@ LOGICAL :: GPRESENT_PFPR,GPRESENT_PSEA
!
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
- CALL MPPDB_CHECK3D(PDZZ,"RAIN_ICE beg:PDZZ",PRECISION)
- CALL MPPDB_CHECK3D(PRHODJ,"RAIN_ICE beg:PRHODJ",PRECISION)
- CALL MPPDB_CHECK3D(PRHODREF,"RAIN_ICE beg:PRHODREF",PRECISION)
- CALL MPPDB_CHECK3D(PEXNREF,"RAIN_ICE beg:PEXNREF",PRECISION)
- CALL MPPDB_CHECK3D(PPABST,"RAIN_ICE beg:PPABST",PRECISION)
- CALL MPPDB_CHECK3D(PCLDFR,"RAIN_ICE beg:PCLDFR",PRECISION)
- CALL MPPDB_CHECK3D(PTHT,"RAIN_ICE beg:PTHT",PRECISION)
- CALL MPPDB_CHECK3D(PRVT,"RAIN_ICE beg:PRVT",PRECISION)
- CALL MPPDB_CHECK3D(PRCT,"RAIN_ICE beg:PRCT",PRECISION)
- CALL MPPDB_CHECK3D(PRRT,"RAIN_ICE beg:PRRT",PRECISION)
- CALL MPPDB_CHECK3D(PRIT,"RAIN_ICE beg:PRIT",PRECISION)
- CALL MPPDB_CHECK3D(PRST,"RAIN_ICE beg:PRST",PRECISION)
- CALL MPPDB_CHECK3D(PRGT,"RAIN_ICE beg:PRGT",PRECISION)
- CALL MPPDB_CHECK3D(PSIGS,"RAIN_ICE beg:PSIGS",PRECISION)
- IF (PRESENT(PSEA)) CALL MPPDB_CHECK2D(PSEA,"RAIN_ICE beg:PSEA",PRECISION)
- IF (PRESENT(PTOWN)) CALL MPPDB_CHECK2D(PTOWN,"RAIN_ICE beg:PTOWN",PRECISION)
- IF (PRESENT(PRHT)) CALL MPPDB_CHECK3D(PRHT,"RAIN_ICE beg:PRHT",PRECISION)
+ CALL MPPDB_CHECK(PDZZ,"RAIN_ICE beg:PDZZ")
+ CALL MPPDB_CHECK(PRHODJ,"RAIN_ICE beg:PRHODJ")
+ CALL MPPDB_CHECK(PRHODREF,"RAIN_ICE beg:PRHODREF")
+ CALL MPPDB_CHECK(PEXNREF,"RAIN_ICE beg:PEXNREF")
+ CALL MPPDB_CHECK(PPABST,"RAIN_ICE beg:PPABST")
+ CALL MPPDB_CHECK(PCLDFR,"RAIN_ICE beg:PCLDFR")
+ CALL MPPDB_CHECK(PTHT,"RAIN_ICE beg:PTHT")
+ CALL MPPDB_CHECK(PRVT,"RAIN_ICE beg:PRVT")
+ CALL MPPDB_CHECK(PRCT,"RAIN_ICE beg:PRCT")
+ CALL MPPDB_CHECK(PRRT,"RAIN_ICE beg:PRRT")
+ CALL MPPDB_CHECK(PRIT,"RAIN_ICE beg:PRIT")
+ CALL MPPDB_CHECK(PRST,"RAIN_ICE beg:PRST")
+ CALL MPPDB_CHECK(PRGT,"RAIN_ICE beg:PRGT")
+ CALL MPPDB_CHECK(PSIGS,"RAIN_ICE beg:PSIGS")
+ IF (PRESENT(PSEA)) CALL MPPDB_CHECK(PSEA,"RAIN_ICE beg:PSEA")
+ IF (PRESENT(PTOWN)) CALL MPPDB_CHECK(PTOWN,"RAIN_ICE beg:PTOWN")
+ IF (PRESENT(PRHT)) CALL MPPDB_CHECK(PRHT,"RAIN_ICE beg:PRHT")
!Check all INOUT arrays
- CALL MPPDB_CHECK3D(PCIT,"RAIN_ICE beg:PCIT",PRECISION)
- CALL MPPDB_CHECK3D(PTHS,"RAIN_ICE beg:PTHS",PRECISION)
- CALL MPPDB_CHECK3D(PRVS,"RAIN_ICE beg:PRVS",PRECISION)
- CALL MPPDB_CHECK3D(PRCS,"RAIN_ICE beg:PRCS",PRECISION)
- CALL MPPDB_CHECK3D(PRRS,"RAIN_ICE beg:PRRS",PRECISION)
- CALL MPPDB_CHECK3D(PRIS,"RAIN_ICE beg:PRIS",PRECISION)
- CALL MPPDB_CHECK3D(PRSS,"RAIN_ICE beg:PRSS",PRECISION)
- CALL MPPDB_CHECK3D(PRGS,"RAIN_ICE beg:PRGS",PRECISION)
- CALL MPPDB_CHECK2D(PINPRC,"RAIN_ICE beg:PINPRC",PRECISION)
- CALL MPPDB_CHECK2D(PINDEP,"RAIN_ICE beg:PINDEP",PRECISION)
- CALL MPPDB_CHECK2D(PINPRR,"RAIN_ICE beg:PINPRR",PRECISION)
- CALL MPPDB_CHECK3D(PINPRR3D,"RAIN_ICE beg:PINPRR3D",PRECISION)
- CALL MPPDB_CHECK3D(PEVAP3D,"RAIN_ICE beg:PEVAP3D",PRECISION)
- CALL MPPDB_CHECK2D(PINPRS,"RAIN_ICE beg:PINPRS",PRECISION)
- CALL MPPDB_CHECK2D(PINPRG,"RAIN_ICE beg:PINPRG",PRECISION)
- IF (PRESENT(PRHS)) CALL MPPDB_CHECK3D(PRHS,"RAIN_ICE beg:PRHS",PRECISION)
- IF (PRESENT(PINPRH)) CALL MPPDB_CHECK2D(PINPRH,"RAIN_ICE beg:PINPRH",PRECISION)
+ CALL MPPDB_CHECK(PCIT,"RAIN_ICE beg:PCIT")
+ CALL MPPDB_CHECK(PTHS,"RAIN_ICE beg:PTHS")
+ CALL MPPDB_CHECK(PRVS,"RAIN_ICE beg:PRVS")
+ CALL MPPDB_CHECK(PRCS,"RAIN_ICE beg:PRCS")
+ CALL MPPDB_CHECK(PRRS,"RAIN_ICE beg:PRRS")
+ CALL MPPDB_CHECK(PRIS,"RAIN_ICE beg:PRIS")
+ CALL MPPDB_CHECK(PRSS,"RAIN_ICE beg:PRSS")
+ CALL MPPDB_CHECK(PRGS,"RAIN_ICE beg:PRGS")
+ CALL MPPDB_CHECK(PINPRC,"RAIN_ICE beg:PINPRC")
+ CALL MPPDB_CHECK(PINDEP,"RAIN_ICE beg:PINDEP")
+ CALL MPPDB_CHECK(PINPRR,"RAIN_ICE beg:PINPRR")
+ CALL MPPDB_CHECK(PINPRR3D,"RAIN_ICE beg:PINPRR3D")
+ CALL MPPDB_CHECK(PEVAP3D,"RAIN_ICE beg:PEVAP3D")
+ CALL MPPDB_CHECK(PINPRS,"RAIN_ICE beg:PINPRS")
+ CALL MPPDB_CHECK(PINPRG,"RAIN_ICE beg:PINPRG")
+ IF (PRESENT(PRHS)) CALL MPPDB_CHECK(PRHS,"RAIN_ICE beg:PRHS")
+ IF (PRESENT(PINPRH)) CALL MPPDB_CHECK(PINPRH,"RAIN_ICE beg:PINPRH")
END IF
!
#ifdef _OPENACC
@@ -629,7 +629,6 @@ GMICRO(:,:,:) = .FALSE.
PRGT(IIB:IIE,IJB:IJE,IKTB:IKTE)>XRTMIN(6)
END IF
!$acc end kernels
-!$acc update self(GMICRO) !used in BUDGET
#ifndef _OPENACC
IMICRO = COUNTJV3D( GMICRO(:,:,:),I1(:),I2(:),I3(:))
@@ -1338,33 +1337,32 @@ END IF
ZW(:,:,:)=PRRS(:,:,:)*PTSTEP
!$acc end kernels
CALL RAINFR_VERT(ZRAINFR,ZW)
-
!
!$acc end data
!
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
- CALL MPPDB_CHECK3D(PCIT,"RAIN_ICE end:PCIT",PRECISION)
- CALL MPPDB_CHECK3D(PTHS,"RAIN_ICE end:PTHS",PRECISION)
- CALL MPPDB_CHECK3D(PRVS,"RAIN_ICE end:PRVS",PRECISION)
- CALL MPPDB_CHECK3D(PRCS,"RAIN_ICE end:PRCS",PRECISION)
- CALL MPPDB_CHECK3D(PRRS,"RAIN_ICE end:PRRS",PRECISION)
- CALL MPPDB_CHECK3D(PRIS,"RAIN_ICE end:PRIS",PRECISION)
- CALL MPPDB_CHECK3D(PRSS,"RAIN_ICE end:PRSS",PRECISION)
- CALL MPPDB_CHECK3D(PRGS,"RAIN_ICE end:PRGS",PRECISION)
- CALL MPPDB_CHECK2D(PINPRC,"RAIN_ICE end:PINPRC",PRECISION)
- CALL MPPDB_CHECK2D(PINDEP,"RAIN_ICE end:PINDEP",PRECISION)
- CALL MPPDB_CHECK2D(PINPRR,"RAIN_ICE end:PINPRR",PRECISION)
- CALL MPPDB_CHECK3D(PINPRR3D,"RAIN_ICE end:PINPRR3D",PRECISION)
- CALL MPPDB_CHECK3D(PEVAP3D,"RAIN_ICE end:PEVAP3D",PRECISION)
- CALL MPPDB_CHECK2D(PINPRS,"RAIN_ICE end:PINPRS",PRECISION)
- CALL MPPDB_CHECK2D(PINPRG,"RAIN_ICE end:PINPRG",PRECISION)
- IF (PRESENT(PRHS)) CALL MPPDB_CHECK3D(PRHS,"RAIN_ICE end:PRHS",PRECISION)
- IF (PRESENT(PINPRH)) CALL MPPDB_CHECK2D(PINPRH,"RAIN_ICE end:PINPRH",PRECISION)
+ CALL MPPDB_CHECK(PCIT,"RAIN_ICE end:PCIT")
+ CALL MPPDB_CHECK(PTHS,"RAIN_ICE end:PTHS")
+ CALL MPPDB_CHECK(PRVS,"RAIN_ICE end:PRVS")
+ CALL MPPDB_CHECK(PRCS,"RAIN_ICE end:PRCS")
+ CALL MPPDB_CHECK(PRRS,"RAIN_ICE end:PRRS")
+ CALL MPPDB_CHECK(PRIS,"RAIN_ICE end:PRIS")
+ CALL MPPDB_CHECK(PRSS,"RAIN_ICE end:PRSS")
+ CALL MPPDB_CHECK(PRGS,"RAIN_ICE end:PRGS")
+ CALL MPPDB_CHECK(PINPRC,"RAIN_ICE end:PINPRC")
+ CALL MPPDB_CHECK(PINDEP,"RAIN_ICE end:PINDEP")
+ CALL MPPDB_CHECK(PINPRR,"RAIN_ICE end:PINPRR")
+ CALL MPPDB_CHECK(PINPRR3D,"RAIN_ICE end:PINPRR3D")
+ CALL MPPDB_CHECK(PEVAP3D,"RAIN_ICE end:PEVAP3D")
+ CALL MPPDB_CHECK(PINPRS,"RAIN_ICE end:PINPRS")
+ CALL MPPDB_CHECK(PINPRG,"RAIN_ICE end:PINPRG")
+ IF (PRESENT(PRHS)) CALL MPPDB_CHECK(PRHS,"RAIN_ICE end:PRHS")
+ IF (PRESENT(PINPRH)) CALL MPPDB_CHECK(PINPRH,"RAIN_ICE end:PINPRH")
!Check all OUT arrays
IF (PRESENT(PFPR)) THEN
DO JL=1,SIZE(PFPR,4)
- CALL MPPDB_CHECK3D(PFPR(:,:,:,JL),"RAIN_ICE end:PFPR(:,:,:,JL)",PRECISION)
+ CALL MPPDB_CHECK(PFPR(:,:,:,JL),"RAIN_ICE end:PFPR(:,:,:,JL)")
END DO
END IF
END IF
@@ -1514,7 +1512,6 @@ IF ( KRR == 7 ) PINPRH (:,:) = 0.
! optimization by looking for locations where
! the precipitating fields are larger than a minimal value only !!!
! For optimization we consider each variable separately
-
!$acc kernels present(GSEDIMR,GSEDIMC,GSEDIMI,GSEDIMS,GSEDIMG,GSEDIMH, &
!$acc & PRCS,PRCT,PRGS,PRGT,PRHS,PRHT,PRRS,PRRT,PRSS,PRST,ZPRCS,ZPRGS,ZPRHS,ZPRRS,ZPRSS,ZRTMIN,XRTMIN)
ZRTMIN(:) = XRTMIN(:) * ZINVTSTEP
@@ -2586,7 +2583,6 @@ INEGT = COUNTJV3D( GNEGT(:,:,:),I1(:),I2(:),I3(:))
#else
CALL COUNTJV3D_DEVICE(GNEGT(:,:,:),I1(:),I2(:),I3(:),INEGT)
#endif
-
IF( INEGT >= 1 ) THEN
ALLOCATE(ZRVT(INEGT)) ;
ALLOCATE(ZCIT(INEGT)) ;
@@ -3107,7 +3103,6 @@ CALL ABORT
ZTHS(1:IMICRO) = ZTHS(1:IMICRO) - ZZW(1:IMICRO)*ZLVFACT(1:IMICRO)
END WHERE
!$acc end kernels
-
ELSEIF (CSUBG_RR_EVAP=='CLFR' .OR. CSUBG_RR_EVAP=='PRFR') THEN
#ifdef _OPENACC
PRINT *,'OPENACC: RAIN_ICE_WARM::CSUBG_RR_EVAP==CLFR or PRFR not yet implemented'
@@ -4582,6 +4577,9 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: ZRR !Rain field
!-------------------------------------------------------------------------------
INTEGER :: JI, JJ, JK
!
+CALL MPPDB_CHECK(ZPRFR,"RAINFR_VERT beg:ZPRFR")
+CALL MPPDB_CHECK(ZRR,"RAINFR_VERT beg:ZRR")
+!
!$acc kernels present(ZPRFR,ZRR,XRTMIN)
DO JI = IIB,IIE
DO JJ = IJB, IJE
@@ -4600,6 +4598,7 @@ DO JI = IIB,IIE
END DO
!$acc end kernels
!
+CALL MPPDB_CHECK(ZPRFR,"RAINFR_VERT end:ZPRFR")
!
END SUBROUTINE RAINFR_VERT
!
@@ -4660,6 +4659,14 @@ INTEGER :: JI,JJ,JK,IDX
!-------------------------------------------------------------------------------
!
!$acc kernels present(LTAB,I1,I2,I3)
+
+!To allow comparisons... (I1/I2/I3 are not fully used)
+!Can be removed in production
+! I1(:) = -999
+! I2(:) = -999
+! I3(:) = -999
+
+
IC = 0
!Warning: if "independent" is set, content of I1, I2 and I3 can vary between 2
! different runs of this subroutine BUT final result should be the same
diff --git a/src/MNH/rain_ice_red.f90 b/src/MNH/rain_ice_red.f90
index 22037c94acd9664aae4c1eb7f3e0496fbb5de93a..4ab3f17802978ccb9ac46207f3f944b896a52347 100644
--- a/src/MNH/rain_ice_red.f90
+++ b/src/MNH/rain_ice_red.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
! ######spl
MODULE MODI_RAIN_ICE_RED
@@ -8,11 +8,11 @@
!
INTERFACE
SUBROUTINE RAIN_ICE_RED ( OSEDIC,HSEDIM, HSUBG_AUCV_RC, OWARM, KKA, KKU, KKL, &
- PTSTEP, KRR, LDMICRO, PEXN, &
+ PTSTEP, KRR, ODMICRO, PEXN, &
PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
- PINPRC,PINPRR, PINPRR3D, PEVAP3D, &
+ PINPRC,PINPRR, PEVAP3D, &
PINPRS, PINPRG, PSIGS, PINDEP, PSEA, PTOWN, &
PRHT, PRHS, PINPRH, PFPR )
!
@@ -31,7 +31,7 @@ INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
REAL, INTENT(IN) :: PTSTEP ! Double Time step
! (single if cold start)
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
-LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: LDMICRO ! mask to limit computation
+LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: ODMICRO ! mask to limit computation
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXN ! Exner function
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Layer thikness (m)
@@ -65,7 +65,6 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel m.r. source
REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC! Cloud instant precip
REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud instant deposition
REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRR! Rain instant precip
-REAL, DIMENSION(:,:,:),INTENT(OUT) :: PINPRR3D! Rain inst precip 3D
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEVAP3D! Rain evap profile
REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRS! Snow instant precip
REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRG! Graupel instant precip
@@ -81,11 +80,11 @@ END INTERFACE
END MODULE MODI_RAIN_ICE_RED
! ######spl
SUBROUTINE RAIN_ICE_RED ( OSEDIC,HSEDIM, HSUBG_AUCV_RC, OWARM, KKA, KKU, KKL, &
- PTSTEP, KRR, LDMICRO, PEXN, &
+ PTSTEP, KRR, ODMICRO, PEXN, &
PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
- PINPRC,PINPRR, PINPRR3D, PEVAP3D, &
+ PINPRC,PINPRR, PEVAP3D, &
PINPRS, PINPRG, PSIGS, PINDEP, PSEA, PTOWN, &
PRHT, PRHS, PINPRH, PFPR )
! ######################################################################
@@ -247,6 +246,7 @@ USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
USE MODD_PARAM_ICE, ONLY: CSUBG_PR_PDF,CSUBG_RC_RR_ACCR,CSUBG_RR_EVAP,LDEPOSC,LFEEDBACKT,LSEDIM_AFTER, &
NMAXITER,XMRSTEP,XTSTEP_TS,XVDEPOSC
USE MODD_BUDGET, ONLY: LBU_ENABLE,LBUDGET_RC,LBUDGET_RR,LBUDGET_RI,LBUDGET_RS,LBUDGET_RG,LBUDGET_RH,LBUDGET_RV,LBUDGET_TH
+USE MODD_VAR_ll, ONLY: IP
!
USE MODI_BUDGET
USE MODI_ICE4_NUCLEATION_WRAPPER
@@ -281,7 +281,7 @@ INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
-LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: LDMICRO ! mask to limit computation
+LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: ODMICRO ! mask to limit computation
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXN ! Exner function
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Layer thikness (m)
@@ -312,7 +312,6 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel m.r. source
REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC! Cloud instant precip
REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud instant deposition
REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRR! Rain instant precip
-REAL, DIMENSION(:,:,:),INTENT(OUT) :: PINPRR3D! Rain inst precip 3D
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEVAP3D! Rain evap profile
REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRS! Snow instant precip
REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRG! Graupel instant precip
@@ -324,9 +323,9 @@ REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PINPRH! Hail instant precip
REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
!
!$acc declare present(OSEDIC,HSEDIM,HSUBG_AUCV_RC,OWARM,KKA,KKU,KKL,PTSTEP,KRR)
-!$acc declare present(LDMICRO,PEXN,PDZZ,PRHODJ,PRHODREF,PEXNREF,PPABST,PCIT,PCLDFR,PTHT,PRVT, &
+!$acc declare present(ODMICRO,PEXN,PDZZ,PRHODJ,PRHODREF,PEXNREF,PPABST,PCIT,PCLDFR,PTHT,PRVT, &
!$acc & PRCT,PRRT,PRIT,PRST,PRGT,PSIGS,PTHS,PRVS,PRCS,PRRS,PRIS,PRSS,PRGS, &
-!$acc & PINPRC,PINDEP,PINPRR,PINPRR3D,PEVAP3D,PINPRS,PINPRG) &
+!$acc & PINPRC,PINDEP,PINPRR,PEVAP3D,PINPRS,PINPRG) &
!$acc & present(PSEA,PTOWN,PRHT,PRHS,PINPRH,PFPR)
!
!* 0.2 Declarations of local variables :
@@ -341,13 +340,18 @@ INTEGER :: IKB, IKTB, IKT!
INTEGER :: IKE, IKTE !
!
!For packing
+INTEGER :: IDX, JI, JJ, JK
INTEGER :: IMICRO ! Case r_x>0 locations
-INTEGER, DIMENSION(COUNT(LDMICRO)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER, DIMENSION(COUNT(ODMICRO)) :: I1,I2,I3 ! Used to replace the COUNT
INTEGER :: JL ! and PACK intrinsics
!
-!$acc declare create(IIB,IIE,IIT,IJB,IJE,IJT,IKB,IKTB,IKT,IKE,IKTE,IMICRO,I1,I2,I3,JL)
+!acc declare create(IIB,IIE,IIT,IJB,IJE,IJT,IKB,IKTB,IKT,IKE,IKTE,IMICRO,I1,I2,I3,JL)
+!$acc declare create(I1,I2,I3)
!
-!Arrays for nucleation call outisde of LDMICRO points
+LOGICAL, DIMENSION(COUNT(ODMICRO)) :: GWORK
+!acc declare create(GWORK)
+!
+!Arrays for nucleation call outisde of ODMICRO points
REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) :: ZW ! work array
REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) :: ZT ! Temperature
REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: &
@@ -356,18 +360,14 @@ REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: &
REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZZ_LVFACT, ZZ_LSFACT, ZLSFACT3D
!
!Diagnostics
-REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZRAINFR, &
- & ZHLC_HCF3D,& ! HLCLOUDS cloud fraction in high water content part
- & ZHLC_LCF3D,& ! HLCLOUDS cloud fraction in low water content part
- & ZHLC_HRC3D,& ! HLCLOUDS cloud water content in high water content
- & ZHLC_LRC3D ! HLCLOUDS cloud water content in low water content
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZRAINFR
REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2)) :: ZINPRI ! Pristine ice instant precip
!
!$acc declare create(ZW,ZT,ZZ_RVHENI_MR,ZZ_RVHENI,ZZ_LVFACT,ZZ_LSFACT,ZLSFACT3D, &
-!$acc & ZRAINFR,ZHLC_HCF3D,ZHLC_LCF3D,ZHLC_HRC3D,ZHLC_LRC3D,ZINPRI)
+!$acc & ZRAINFR,ZINPRI)
!
!Packed variables
-REAL, DIMENSION(COUNT(LDMICRO)) :: ZRVT, & ! Water vapor m.r. at t
+REAL, DIMENSION(COUNT(ODMICRO)) :: ZRVT, & ! Water vapor m.r. at t
& ZRCT, & ! Cloud water m.r. at t
& ZRRT, & ! Rain water m.r. at t
& ZRIT, & ! Pristine ice m.r. at t
@@ -395,7 +395,7 @@ REAL, DIMENSION(COUNT(LDMICRO)) :: ZRVT, & ! Water vapor m.r. at t
!$acc& ZLSFACT,ZLVFACT,ZSIGMA_RC,ZCF,ZHLC_HCF,ZHLC_LCF,ZHLC_HRC,ZHLC_LRC)
!
!Output packed tendencies (for budgets only)
-REAL, DIMENSION(COUNT(LDMICRO)) :: ZRVHENI_MR, & ! heterogeneous nucleation mixing ratio change
+REAL, DIMENSION(COUNT(ODMICRO)) :: ZRVHENI_MR, & ! heterogeneous nucleation mixing ratio change
& ZRCHONI, & ! Homogeneous nucleation
& ZRRHONG_MR, & ! Spontaneous freezing mixing ratio change
& ZRVDEPS, & ! Deposition on r_s,
@@ -428,7 +428,7 @@ REAL, DIMENSION(COUNT(LDMICRO)) :: ZRVHENI_MR, & ! heterogeneous nucleation mixi
!$acc& ZRWETGH_MR,ZRGMLTR,ZRCWETH,ZRIWETH,ZRSWETH,ZRGWETH,ZRRWETH,ZRCDRYH,ZRIDRYH,ZRSDRYH,ZRRDRYH,ZRGDRYH,ZRDRYHG)
!
!Output packed total mixing ratio change (for budgets only)
-REAL, DIMENSION(COUNT(LDMICRO)) :: ZTOT_RVHENI, & ! heterogeneous nucleation mixing ratio change
+REAL, DIMENSION(COUNT(ODMICRO)) :: ZTOT_RVHENI, & ! heterogeneous nucleation mixing ratio change
& ZTOT_RCHONI, & ! Homogeneous nucleation
& ZTOT_RRHONG, & ! Spontaneous freezing mixing ratio change
& ZTOT_RVDEPS, & ! Deposition on r_s,
@@ -462,7 +462,7 @@ REAL, DIMENSION(COUNT(LDMICRO)) :: ZTOT_RVHENI, & ! heterogeneous nucleation mix
!$acc& ZTOT_RCDRYH,ZTOT_RIDRYH,ZTOT_RSDRYH,ZTOT_RRDRYH,ZTOT_RGDRYH,ZTOT_RDRYHG)
!
!For time- or mixing-ratio- splitting
-REAL, DIMENSION(COUNT(LDMICRO)) :: Z0RVT, & ! Water vapor m.r. at the beginig of the current loop
+REAL, DIMENSION(COUNT(ODMICRO)) :: Z0RVT, & ! Water vapor m.r. at the beginig of the current loop
& Z0RCT, & ! Cloud water m.r. at the beginig of the current loop
& Z0RRT, & ! Rain water m.r. at the beginig of the current loop
& Z0RIT, & ! Pristine ice m.r. at the beginig of the current loop
@@ -477,7 +477,7 @@ REAL, DIMENSION(COUNT(LDMICRO)) :: Z0RVT, & ! Water vapor m.r. at the begi
!$acc& ZB_TH,ZB_RV,ZB_RC,ZB_RR,ZB_RI,ZB_RS,ZB_RG,ZB_RH )
!
!To take into acount external tendencies inside the splitting
-REAL, DIMENSION(COUNT(LDMICRO)) :: ZEXT_RV, & ! External tendencie for rv
+REAL, DIMENSION(COUNT(ODMICRO)) :: ZEXT_RV, & ! External tendencie for rv
ZEXT_RC, & ! External tendencie for rc
ZEXT_RR, & ! External tendencie for rr
ZEXT_RI, & ! External tendencie for ri
@@ -485,31 +485,36 @@ REAL, DIMENSION(COUNT(LDMICRO)) :: ZEXT_RV, & ! External tendencie for rv
ZEXT_RG, & ! External tendencie for rg
ZEXT_RH, & ! External tendencie for rh
ZEXT_TH ! External tendencie for th
-LOGICAL :: LEXT_TEND
+LOGICAL :: GEXT_TEND
!
-!$acc declare create(ZEXT_RV,ZEXT_RC,ZEXT_RR,ZEXT_RI,ZEXT_RS,ZEXT_RG,ZEXT_RH,ZEXT_TH,LEXT_TEND)
+!acc declare create(GEXT_TEND)
+!$acc declare create(ZEXT_RV,ZEXT_RC,ZEXT_RR,ZEXT_RI,ZEXT_RS,ZEXT_RG,ZEXT_RH,ZEXT_TH)
!
-INTEGER, DIMENSION(COUNT(LDMICRO)) :: IITER ! Number of iterations done (with real tendencies computation)
+INTEGER, DIMENSION(COUNT(ODMICRO)) :: IITER ! Number of iterations done (with real tendencies computation)
INTEGER :: INB_ITER_MAX ! Maximum number of iterations (with real tendencies computation)
-REAL, DIMENSION(COUNT(LDMICRO)) :: ZTIME, & ! Current integration time (starts with 0 and ends with PTSTEP)
+REAL, DIMENSION(COUNT(ODMICRO)) :: ZTIME, & ! Current integration time (starts with 0 and ends with PTSTEP)
& ZMAXTIME, & ! Time on which we can apply the current tendencies
& ZTIME_THRESHOLD, & ! Time to reach threshold
& ZTIME_LASTCALL ! Integration time when last tendecies call has been done
-LOGICAL, DIMENSION(COUNT(LDMICRO)) :: LLCOMPUTE ! Points where we must compute tendenceis
-LOGICAL :: LSOFT ! Must we really compute tendencies or only adjust them to new T variables
-LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)):: GDEP
-LOGICAL, DIMENSION(SIZE(LDMICRO,1),SIZE(LDMICRO,2),SIZE(LDMICRO,3)) :: GDNOTMICRO ! = .NOT.LDMICRO
+LOGICAL, DIMENSION(COUNT(ODMICRO)) :: LLCOMPUTE ! Points where we must compute tendenceis
+INTEGER :: IKA, IKU, IKL, IRR !Workaround of PGI bug with OpenACC (at least up to 18.10 version)
+LOGICAL :: GFEEDBACKT, GBU_ENABLE, GBUDGET_RC, GBUDGET_RR, GBUDGET_RI, GBUDGET_RS, GBUDGET_RG, &
+ GBUDGET_RH, GBUDGET_RV, GBUDGET_TH, GWARM !Workaround of PGI bug with OpenACC (at least up to 18.10 version)
+LOGICAL :: GSOFT ! Must we really compute tendencies or only adjust them to new T variables
+LOGICAL, DIMENSION(SIZE(ODMICRO,1),SIZE(ODMICRO,2),SIZE(ODMICRO,3)) :: GDNOTMICRO ! = .NOT.ODMICRO
REAL :: ZTSTEP ! length of sub-timestep in case of time splitting
REAL :: ZINV_TSTEP ! Inverse ov PTSTEP
-REAL, DIMENSION(COUNT(LDMICRO), 6) :: ZRS_TEND
-REAL, DIMENSION(COUNT(LDMICRO), 6) :: ZRG_TEND
-REAL, DIMENSION(COUNT(LDMICRO), 8) :: ZRH_TEND
+REAL, DIMENSION(COUNT(ODMICRO), 6) :: ZRS_TEND
+REAL, DIMENSION(COUNT(ODMICRO), 6) :: ZRG_TEND
+REAL, DIMENSION(COUNT(ODMICRO), 8) :: ZRH_TEND
!
!For total tendencies computation
REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: &
&ZW_RVS, ZW_RCS, ZW_RRS, ZW_RIS, ZW_RSS, ZW_RGS, ZW_RHS, ZW_THS
!
-!$acc declare create(IITER,INB_ITER_MAX,ZTIME,ZMAXTIME,ZTIME_THRESHOLD,ZTIME_LASTCALL,LLCOMPUTE,LSOFT,GDEP,GDNOTMICRO,ZTSTEP, &
+! !$acc declare create(GSOFT)
+!acc declare create(IITER,INB_ITER_MAX,ZTIME,ZMAXTIME,ZTIME_THRESHOLD,ZTIME_LASTCALL,LLCOMPUTE,GDNOTMICRO,ZTSTEP, &
+!$acc declare create(IITER,ZTIME,ZMAXTIME,ZTIME_THRESHOLD,ZTIME_LASTCALL,LLCOMPUTE,GDNOTMICRO,ZTSTEP, &
!$acc & ZINV_TSTEP,ZRS_TEND,ZRG_TEND,ZRH_TEND,ZW_RVS,ZW_RCS,ZW_RRS,ZW_RIS,ZW_RSS,ZW_RGS,ZW_RHS,ZW_THS)
!
!acc declare copyin(JPVEXT,XUNDEF) !These are parameters
@@ -521,63 +526,77 @@ REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: &
!
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
- CALL MPPDB_CHECK3D_LOG(LDMICRO,"RAIN_ICE_RED beg:LDMICRO")
- CALL MPPDB_CHECK3D(PEXN,"RAIN_ICE_RED beg:PEXN",PRECISION)
- CALL MPPDB_CHECK3D(PDZZ,"RAIN_ICE_RED beg:PDZZ",PRECISION)
- CALL MPPDB_CHECK3D(PRHODJ,"RAIN_ICE_RED beg:PRHODJ",PRECISION)
- CALL MPPDB_CHECK3D(PRHODREF,"RAIN_ICE_RED beg:PRHODREF",PRECISION)
- CALL MPPDB_CHECK3D(PEXNREF,"RAIN_ICE_RED beg:PEXNREF",PRECISION)
- CALL MPPDB_CHECK3D(PPABST,"RAIN_ICE_RED beg:PPABST",PRECISION)
- CALL MPPDB_CHECK3D(PCLDFR,"RAIN_ICE_RED beg:PCLDFR",PRECISION)
- CALL MPPDB_CHECK3D(PTHT,"RAIN_ICE_RED beg:PTHT",PRECISION)
- CALL MPPDB_CHECK3D(PRVT,"RAIN_ICE_RED beg:PRVT",PRECISION)
- CALL MPPDB_CHECK3D(PRCT,"RAIN_ICE_RED beg:PRCT",PRECISION)
- CALL MPPDB_CHECK3D(PRRT,"RAIN_ICE_RED beg:PRRT",PRECISION)
- CALL MPPDB_CHECK3D(PRIT,"RAIN_ICE_RED beg:PRIT",PRECISION)
- CALL MPPDB_CHECK3D(PRST,"RAIN_ICE_RED beg:PRST",PRECISION)
- CALL MPPDB_CHECK3D(PRGT,"RAIN_ICE_RED beg:PRGT",PRECISION)
- CALL MPPDB_CHECK3D(PSIGS,"RAIN_ICE_RED beg:PSIGS",PRECISION)
- IF (PRESENT(PSEA)) CALL MPPDB_CHECK2D(PSEA,"RAIN_ICE_RED beg:PSEA",PRECISION)
- IF (PRESENT(PTOWN)) CALL MPPDB_CHECK2D(PTOWN,"RAIN_ICE_RED beg:PTOWN",PRECISION)
- IF (PRESENT(PRHT)) CALL MPPDB_CHECK3D(PRHT,"RAIN_ICE_RED beg:PRHT",PRECISION)
+ CALL MPPDB_CHECK(ODMICRO,"RAIN_ICE_RED beg:ODMICRO")
+ CALL MPPDB_CHECK(PEXN,"RAIN_ICE_RED beg:PEXN")
+ CALL MPPDB_CHECK(PDZZ,"RAIN_ICE_RED beg:PDZZ")
+ CALL MPPDB_CHECK(PRHODJ,"RAIN_ICE_RED beg:PRHODJ")
+ CALL MPPDB_CHECK(PRHODREF,"RAIN_ICE_RED beg:PRHODREF")
+ CALL MPPDB_CHECK(PEXNREF,"RAIN_ICE_RED beg:PEXNREF")
+ CALL MPPDB_CHECK(PPABST,"RAIN_ICE_RED beg:PPABST")
+ CALL MPPDB_CHECK(PCLDFR,"RAIN_ICE_RED beg:PCLDFR")
+ CALL MPPDB_CHECK(PTHT,"RAIN_ICE_RED beg:PTHT")
+ CALL MPPDB_CHECK(PRVT,"RAIN_ICE_RED beg:PRVT")
+ CALL MPPDB_CHECK(PRCT,"RAIN_ICE_RED beg:PRCT")
+ CALL MPPDB_CHECK(PRRT,"RAIN_ICE_RED beg:PRRT")
+ CALL MPPDB_CHECK(PRIT,"RAIN_ICE_RED beg:PRIT")
+ CALL MPPDB_CHECK(PRST,"RAIN_ICE_RED beg:PRST")
+ CALL MPPDB_CHECK(PRGT,"RAIN_ICE_RED beg:PRGT")
+ CALL MPPDB_CHECK(PSIGS,"RAIN_ICE_RED beg:PSIGS")
+ IF (PRESENT(PSEA)) CALL MPPDB_CHECK(PSEA,"RAIN_ICE_RED beg:PSEA")
+ IF (PRESENT(PTOWN)) CALL MPPDB_CHECK(PTOWN,"RAIN_ICE_RED beg:PTOWN")
+ IF (PRESENT(PRHT)) CALL MPPDB_CHECK(PRHT,"RAIN_ICE_RED beg:PRHT")
!Check all INOUT arrays
- CALL MPPDB_CHECK3D(PCIT,"RAIN_ICE_RED beg:PCIT",PRECISION)
- CALL MPPDB_CHECK3D(PTHS,"RAIN_ICE_RED beg:PTHS",PRECISION)
- CALL MPPDB_CHECK3D(PRVS,"RAIN_ICE_RED beg:PRVS",PRECISION)
- CALL MPPDB_CHECK3D(PRCS,"RAIN_ICE_RED beg:PRCS",PRECISION)
- CALL MPPDB_CHECK3D(PRRS,"RAIN_ICE_RED beg:PRRS",PRECISION)
- CALL MPPDB_CHECK3D(PRIS,"RAIN_ICE_RED beg:PRIS",PRECISION)
- CALL MPPDB_CHECK3D(PRSS,"RAIN_ICE_RED beg:PRSS",PRECISION)
- CALL MPPDB_CHECK3D(PRGS,"RAIN_ICE_RED beg:PRGS",PRECISION)
- CALL MPPDB_CHECK2D(PINDEP,"RAIN_ICE_RED beg:PINDEP",PRECISION)
- IF (PRESENT(PRHS)) CALL MPPDB_CHECK3D(PRHS,"RAIN_ICE_RED beg:PRHS",PRECISION)
+ CALL MPPDB_CHECK(PCIT,"RAIN_ICE_RED beg:PCIT")
+ CALL MPPDB_CHECK(PTHS,"RAIN_ICE_RED beg:PTHS")
+ CALL MPPDB_CHECK(PRVS,"RAIN_ICE_RED beg:PRVS")
+ CALL MPPDB_CHECK(PRCS,"RAIN_ICE_RED beg:PRCS")
+ CALL MPPDB_CHECK(PRRS,"RAIN_ICE_RED beg:PRRS")
+ CALL MPPDB_CHECK(PRIS,"RAIN_ICE_RED beg:PRIS")
+ CALL MPPDB_CHECK(PRSS,"RAIN_ICE_RED beg:PRSS")
+ CALL MPPDB_CHECK(PRGS,"RAIN_ICE_RED beg:PRGS")
+ CALL MPPDB_CHECK(PINDEP,"RAIN_ICE_RED beg:PINDEP")
+ IF (PRESENT(PRHS)) CALL MPPDB_CHECK(PRHS,"RAIN_ICE_RED beg:PRHS")
END IF
!
!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
+!Workaround of PGI bug with OpenACC (at least up to 18.10 version)
+GFEEDBACKT = LFEEDBACKT
+GBU_ENABLE = LBU_ENABLE
+GBUDGET_RC = LBUDGET_RC
+GBUDGET_RR = LBUDGET_RR
+GBUDGET_RI = LBUDGET_RI
+GBUDGET_RS = LBUDGET_RS
+GBUDGET_RG = LBUDGET_RG
+GBUDGET_RH = LBUDGET_RH
+GBUDGET_RV = LBUDGET_RV
+GBUDGET_TH = LBUDGET_TH
+GWARM = OWARM
+!$acc kernels
+IKA = KKA
+IKU = KKU
+IKL = KKL
+IRR = KRR
+!$acc end kernels
!
!* 1. COMPUTE THE LOOP BOUNDS
! -----------------------
!
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-!$acc update device(IIB,IJB,IIE,IJE)
!$acc kernels
IIT=SIZE(PDZZ,1)
IJT=SIZE(PDZZ,2)
-IKB=KKA+JPVEXT*KKL
-IKE=KKU-JPVEXT*KKL
+IKB=IKA+JPVEXT*IKL
+IKE=IKU-JPVEXT*IKL
IKT=SIZE(PDZZ,3)
IKTB=1+JPVEXT
IKTE=IKT-JPVEXT
-!$acc end kernels
-!$acc update self(IIT,IJT,IKB,IKE,IKT,IKTB,IKTE)
!
-!$acc kernels
ZINV_TSTEP=1./PTSTEP
-LEXT_TEND=.TRUE.
+GEXT_TEND=.TRUE.
!
-!Not necessary (done in ICE4_TENDENCIES when LSOFT=.FALSE.)
+!Not necessary (done in ICE4_TENDENCIES when GSOFT=.FALSE.)
!but useful for calls to MPPDB_CHECK
ZRS_TEND(:,:) = 0.
ZRG_TEND(:,:) = 0.
@@ -598,32 +617,25 @@ ZRICFRR(:) = 0.
ZRGMLTR(:) = 0.
ZRHMLTR(:) = 0.
ZRCBERI(:) = 0.
-!$acc end kernels
-!$acc update self(LEXT_TEND)
!
-!$acc kernels
ZT(:,:,:) = PTHT(:,:,:) * PEXN(:,:,:)
! LSFACT and LVFACT without exner
-!$acc end kernels
-IF(KRR==7) THEN
-!$acc kernels
+IF(IRR==7) THEN
ZZ_LSFACT(:,:,:)=(XLSTT+(XCPV-XCI)*(ZT(:,:,:)-XTT)) &
/( XCPD + XCPV*PRVT(:,:,:) + XCL*(PRCT(:,:,:)+PRRT(:,:,:)) &
+ XCI*(PRIT(:,:,:)+PRST(:,:,:)+PRGT(:,:,:)+PRHT(:,:,:)))
ZZ_LVFACT(:,:,:)=(XLVTT+(XCPV-XCL)*(ZT(:,:,:)-XTT)) &
/( XCPD + XCPV*PRVT(:,:,:) + XCL*(PRCT(:,:,:)+PRRT(:,:,:)) &
+ XCI*(PRIT(:,:,:)+PRST(:,:,:)+PRGT(:,:,:)+PRHT(:,:,:)))
-!$acc end kernels
ELSE
-!$acc kernels
ZZ_LSFACT(:,:,:)=(XLSTT+(XCPV-XCI)*(ZT(:,:,:)-XTT)) &
/( XCPD + XCPV*PRVT(:,:,:) + XCL*(PRCT(:,:,:)+PRRT(:,:,:)) &
+ XCI*(PRIT(:,:,:)+PRST(:,:,:)+PRGT(:,:,:)))
ZZ_LVFACT(:,:,:)=(XLVTT+(XCPV-XCL)*(ZT(:,:,:)-XTT)) &
/( XCPD + XCPV*PRVT(:,:,:) + XCL*(PRCT(:,:,:)+PRRT(:,:,:)) &
+ XCI*(PRIT(:,:,:)+PRST(:,:,:)+PRGT(:,:,:)))
-!$acc end kernels
ENDIF
+!$acc end kernels
!
!-------------------------------------------------------------------------------
!
@@ -639,8 +651,8 @@ IF(.NOT. LSEDIM_AFTER) THEN
CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE_RED','OpenACC: HSEDIM=STAT not yet implemented')
#endif
!SR: It *seems* that we must have two separate calls for ifort
- IF(KRR==7) THEN
- CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
+ IF(IRR==7) THEN
+ CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, IKL, &
&PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,&
@@ -649,7 +661,7 @@ IF(.NOT. LSEDIM_AFTER) THEN
&PSEA, PTOWN, &
&PINPRH=PINPRH, PRHT=PRHS*PTSTEP, PRHS=PRHS, PFPR=PFPR)
ELSE
- CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
+ CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, IKL, &
&PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,&
@@ -658,16 +670,15 @@ IF(.NOT. LSEDIM_AFTER) THEN
&PSEA, PTOWN, &
&PFPR=PFPR)
ENDIF
-!$acc update self(ZINPRI)
+!$acc kernels
PINPRS(:,:) = PINPRS(:,:) + ZINPRI(:,:)
+!$acc end kernels
!No negativity correction here as we apply sedimentation on PR.S*PTSTEP variables
ELSEIF(HSEDIM=='SPLI') THEN
-#ifdef _OPENACC
-PRINT *,'OPENACC: RAIN_ICE_RED::HSEDIM=SPLI being implemented'
-#endif
+!$acc data copyin(IIB,IIE,IIT,IJB,IJE,IJT,IKB,IKE,IKTB,IKTE,IKT,IKL)
!SR: It *seems* that we must have two separate calls for ifort
- IF(KRR==7) THEN
- CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
+ IF(IRR==7) THEN
+ CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, IKL, &
&PTSTEP, KRR, OSEDIC, LDEPOSC,XVDEPOSC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
@@ -675,7 +686,7 @@ PRINT *,'OPENACC: RAIN_ICE_RED::HSEDIM=SPLI being implemented'
&PSEA, PTOWN, &
&PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR)
ELSE
- CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
+ CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, IKL, &
&PTSTEP, KRR, OSEDIC, LDEPOSC,XVDEPOSC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
@@ -683,6 +694,7 @@ PRINT *,'OPENACC: RAIN_ICE_RED::HSEDIM=SPLI being implemented'
&PSEA, PTOWN, &
&PFPR=PFPR)
ENDIF
+!$acc end data
!$acc kernels
PINPRS(:,:) = PINPRS(:,:) + ZINPRI(:,:)
!$acc end kernels
@@ -705,15 +717,15 @@ PRINT *,'OPENACC: RAIN_ICE_RED::HSEDIM=SPLI being implemented'
!
!* 2.2 budget storage
!
- IF (LBUDGET_RC .AND. OSEDIC) &
+ IF (GBUDGET_RC .AND. OSEDIC) &
CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'SEDI_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'SEDI_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'SEDI_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:), 10, 'SEDI_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:), 11, 'SEDI_BU_RRG')
- IF ( KRR == 7 .AND. LBUDGET_RH) &
+ IF (GBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'SEDI_BU_RRR')
+ IF (GBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'SEDI_BU_RRI')
+ IF (GBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:), 10, 'SEDI_BU_RRS')
+ IF (GBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:), 11, 'SEDI_BU_RRG')
+ IF ( IRR == 7 .AND. GBUDGET_RH) &
CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:), 12, 'SEDI_BU_RRH')
- IF ( LBUDGET_RC .AND. LDEPOSC ) &
+ IF ( GBUDGET_RC .AND. LDEPOSC ) &
CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'DEPO_BU_RRC')
ENDIF
!
@@ -726,14 +738,15 @@ ENDIF
!
#ifndef _OPENACC
IMICRO=0
-IF(COUNT(LDMICRO)/=0) IMICRO=RAIN_ICE_COUNTJV(LDMICRO(:,:,:), IIT, IJT, IKT, SIZE(I1), I1(:), I2(:), I3(:))
+IF(COUNT(ODMICRO)/=0) IMICRO=RAIN_ICE_COUNTJV(ODMICRO(:,:,:), IIT, IJT, IKT, SIZE(I1), I1(:), I2(:), I3(:))
#else
-CALL RAIN_ICE_COUNTJV3D_DEVICE(LDMICRO(:,:,:),I1(:),I2(:),I3(:),IMICRO)
-!$acc update self(I1,I2,I3,IMICRO)
+!$acc data copyout(IMICRO)
+CALL RAIN_ICE_COUNTJV3D_DEVICE(ODMICRO(:,:,:),I1(:),I2(:),I3(:),IMICRO)
+!$acc end data
#endif
!Packing
-IF(IMICRO>0) THEN
!$acc kernels
+IF(IMICRO>0) THEN
DO JL=1, IMICRO
ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
@@ -748,9 +761,7 @@ IF(IMICRO>0) THEN
ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
ZEXN(JL) = PEXN(I1(JL),I2(JL),I3(JL))
ENDDO
-!$acc end kernels
-!$acc kernels
- IF(LEXT_TEND) THEN
+ IF(GEXT_TEND) THEN
DO JL=1, IMICRO
ZEXT_RV(JL) = PRVS(I1(JL),I2(JL),I3(JL)) - ZRVT(JL)*ZINV_TSTEP
ZEXT_RC(JL) = PRCS(I1(JL),I2(JL),I3(JL)) - ZRCT(JL)*ZINV_TSTEP
@@ -762,8 +773,6 @@ IF(IMICRO>0) THEN
!The th tendency is not related to a mixing ratio change, there is no exn/exnref issue here
ENDDO
ENDIF
-!$acc end kernels
-!$acc kernels
IF(HSUBG_AUCV_RC=='PDF ' .AND. CSUBG_PR_PDF=='SIGM') THEN
DO JL=1, IMICRO
ZSIGMA_RC(JL) = PSIGS(I1(JL),I2(JL),I3(JL))*2.
@@ -772,26 +781,20 @@ IF(IMICRO>0) THEN
ELSE !useful when doing calls to MPPDB_CHECK
ZSIGMA_RC(:) = XUNDEF
ENDIF
-!$acc end kernels
- IF(KRR==7) THEN
-!$acc kernels
+ IF(IRR==7) THEN
DO JL=1, IMICRO
ZRHT(JL) = PRHT(I1(JL),I2(JL),I3(JL))
ENDDO
- IF(LEXT_TEND) THEN
+ IF(GEXT_TEND) THEN
DO JL=1, IMICRO
ZEXT_RH(JL) = PRHS(I1(JL),I2(JL),I3(JL)) - ZRHT(JL)*ZINV_TSTEP
ENDDO
ENDIF
-!$acc end kernels
ELSE
-!$acc kernels
ZRHT(:)=0.
- IF(LEXT_TEND) ZEXT_RH(:)=0.
-!$acc end kernels
+ IF(GEXT_TEND) ZEXT_RH(:)=0.
ENDIF
- IF(LBU_ENABLE) THEN
-!$acc kernels
+ IF(GBU_ENABLE) THEN
ZTOT_RVHENI(:)=0.
ZTOT_RCHONI(:)=0.
ZTOT_RRHONG(:)=0.
@@ -837,9 +840,9 @@ IF(IMICRO>0) THEN
ZTOT_RRDRYH(:)=0.
ZTOT_RGDRYH(:)=0.
ZTOT_RDRYHG(:)=0.
-!$acc end kernels
ENDIF
ENDIF
+!$acc end kernels
!-------------------------------------------------------------------------------
!
!* 4. LOOP
@@ -847,19 +850,19 @@ ENDIF
!
!Maximum number of iterations
!We only count real iterations (those for which we *compute* tendencies)
-!$acc kernels
+!acc kernels
INB_ITER_MAX=NMAXITER
IF(XTSTEP_TS/=0.)THEN
INB_ITER_MAX=MAX(1, INT(PTSTEP/XTSTEP_TS)) !At least the number of iterations needed for the time-splitting
ZTSTEP=PTSTEP/INB_ITER_MAX
INB_ITER_MAX=MAX(NMAXITER, INB_ITER_MAX) !For the case XMRSTEP/=0. at the same time
ENDIF
+!acc end kernels
+!$acc kernels
IITER(:)=0
ZTIME(:)=0. ! Current integration time (all points may have a different integration time)
!$acc end kernels
-
-!$acc update self(INB_ITER_MAX,ZTSTEP,IITER,ZTIME)
-
+!$acc update self(ZTIME)
DO WHILE(ANY(ZTIME(:)<PTSTEP)) ! Loop to *really* compute tendencies
IF(XMRSTEP/=0.) THEN
!$acc kernels
@@ -883,48 +886,40 @@ DO WHILE(ANY(ZTIME(:)<PTSTEP)) ! Loop to *really* compute tendencies
ENDIF
!$acc kernels
LLCOMPUTE(:)=ZTIME(:)<PTSTEP ! Compuation only for points for which integration time has not reached the timestep
- LSOFT=.FALSE. ! We *really* compute the tendencies
-!$acc end kernels
-!$acc kernels
+ GSOFT=.FALSE. ! We *really* compute the tendencies
WHERE(LLCOMPUTE(:))
IITER(:)=IITER(:)+1
END WHERE
!$acc end kernels
-
-
!$acc update self(LLCOMPUTE)
-
DO WHILE(ANY(LLCOMPUTE(:))) ! Loop to adjust tendencies when we cross the 0°C or when a specie disappears
!$acc kernels
ZZT(:) = ZTHT(:) * ZEXN(:)
-!$acc end kernels
- IF(KRR==7) THEN
-!$acc kernels
+ IF(IRR==7) THEN
ZLSFACT(:)=(XLSTT+(XCPV-XCI)*(ZZT(:)-XTT)) &
/( (XCPD + XCPV*ZRVT(:) + XCL*(ZRCT(:)+ZRRT(:)) &
+ XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)+ZRHT(:)))*ZEXN(:) )
ZLVFACT(:)=(XLVTT+(XCPV-XCL)*(ZZT(:)-XTT)) &
/( (XCPD + XCPV*ZRVT(:) + XCL*(ZRCT(:)+ZRRT(:)) &
+ XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)+ZRHT(:)))*ZEXN(:) )
-!$acc end kernels
ELSE
-!$acc kernels
ZLSFACT(:)=(XLSTT+(XCPV-XCI)*(ZZT(:)-XTT)) &
/( (XCPD + XCPV*ZRVT(:) + XCL*(ZRCT(:)+ZRRT(:)) &
+ XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)))*ZEXN(:) )
ZLVFACT(:)=(XLVTT+(XCPV-XCL)*(ZZT(:)-XTT)) &
/( (XCPD + XCPV*ZRVT(:) + XCL*(ZRCT(:)+ZRRT(:)) &
+ XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)))*ZEXN(:) )
-!$acc end kernels
ENDIF
+!$acc end kernels
!
!*** 4.1 Tendecies computation
!
- ! Tendencies are *really* computed when LSOFT==.FALSE. and only adjusted otherwise
- CALL ICE4_TENDENCIES(IMICRO, IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL, &
- &KRR, LSOFT, LLCOMPUTE, &
+ ! Tendencies are *really* computed when GSOFT==.FALSE. and only adjusted otherwise
+!$acc data copyin(IMICRO,IIB,IIE,IIT,IJB,IJE,IJT,IKB,IKE,IKT,IKL,GSOFT)
+ CALL ICE4_TENDENCIES(IMICRO, IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, IKL, &
+ &KRR, GSOFT, LLCOMPUTE, &
&OWARM, CSUBG_RC_RR_ACCR, CSUBG_RR_EVAP, HSUBG_AUCV_RC, CSUBG_PR_PDF, &
- &ZEXN, ZRHODREF, ZLVFACT, ZLSFACT, LDMICRO, I1, I2, I3, &
+ &ZEXN, ZRHODREF, ZLVFACT, ZLSFACT, ODMICRO, I1, I2, I3, &
&ZPRES, ZCF, ZSIGMA_RC, &
&ZCIT, &
&ZZT, ZTHT, &
@@ -942,8 +937,10 @@ DO WHILE(ANY(ZTIME(:)<PTSTEP)) ! Loop to *really* compute tendencies
&ZA_TH, ZA_RV, ZA_RC, ZA_RR, ZA_RI, ZA_RS, ZA_RG, ZA_RH, &
&ZB_TH, ZB_RV, ZB_RC, ZB_RR, ZB_RI, ZB_RS, ZB_RG, ZB_RH, &
&ZHLC_HCF, ZHLC_LCF, ZHLC_HRC, ZHLC_LRC, ZRAINFR)
+!$acc end data
! External tendencies
- IF(LEXT_TEND) THEN
+!$acc kernels
+ IF(GEXT_TEND) THEN
ZA_TH(:) = ZA_TH(:) + ZEXT_TH(:)
ZA_RV(:) = ZA_RV(:) + ZEXT_RV(:)
ZA_RC(:) = ZA_RC(:) + ZEXT_RC(:)
@@ -961,144 +958,171 @@ DO WHILE(ANY(ZTIME(:)<PTSTEP)) ! Loop to *really* compute tendencies
WHERE(LLCOMPUTE(:))
ZMAXTIME(:)=PTSTEP-ZTIME(:) ! Remaining time until the end of the timestep
ENDWHERE
-
!We need to adjust tendencies when temperature reaches 0
- IF(LFEEDBACKT) THEN
+ IF(GFEEDBACKT) THEN
!Is ZB_TH enough to change temperature sign?
- WHERE( (ZTHT(:) - XTT/ZEXN(:)) * (ZTHT(:) + ZB_TH(:) - XTT/ZEXN(:)) < 0. )
+ GWORK(:) = (ZTHT(:) - XTT/ZEXN(:)) * (ZTHT(:) + ZB_TH(:) - XTT/ZEXN(:)) < 0.
+ WHERE( GWORK(:) )
ZMAXTIME(:)=0.
ENDWHERE
!Can ZA_TH make temperature change of sign?
ZTIME_THRESHOLD(:)=-1.
- WHERE(ABS(ZA_TH(:))>1.E-20)
+ GWORK(:) = ABS(ZA_TH(:))>1.E-20
+ WHERE( GWORK(:) )
ZTIME_THRESHOLD(:)=(XTT/ZEXN(:) - ZB_TH(:) - ZTHT(:))/ZA_TH(:)
ENDWHERE
- WHERE(ZTIME_THRESHOLD(:)>0.)
+ WHERE( ZTIME_THRESHOLD(:)>0. )
ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
ENDWHERE
ENDIF
-
!We need to adjust tendencies when a specy disappears
- !When a specy is missing, only the external tendencies can be negative (and we must keep track of it)
- WHERE(ZA_RV(:)<-1.E-20 .AND. ZRVT(:)>XRTMIN(1))
+ !When a species is missing, only the external tendencies can be negative (and we must keep track of it)
+ GWORK(:) = ZA_RV(:)<-1.E-20 .AND. ZRVT(:)>XRTMIN(1)
+ WHERE( GWORK(:) )
ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RV(:)+ZRVT(:))/ZA_RV(:))
END WHERE
- WHERE(ZA_RC(:)<-1.E-20 .AND. ZRCT(:)>XRTMIN(2))
+ GWORK(:) = ZA_RC(:)<-1.E-20 .AND. ZRCT(:)>XRTMIN(2)
+ WHERE( GWORK(:) )
ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RC(:)+ZRCT(:))/ZA_RC(:))
END WHERE
- WHERE(ZA_RR(:)<-1.E-20 .AND. ZRRT(:)>XRTMIN(3))
+ GWORK(:) = ZA_RR(:)<-1.E-20 .AND. ZRRT(:)>XRTMIN(3)
+ WHERE( GWORK(:) )
ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RR(:)+ZRRT(:))/ZA_RR(:))
END WHERE
- WHERE(ZA_RI(:)<-1.E-20 .AND. ZRIT(:)>XRTMIN(4))
+ GWORK(:) = ZA_RI(:)<-1.E-20 .AND. ZRIT(:)>XRTMIN(4)
+ WHERE( GWORK(:) )
ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RI(:)+ZRIT(:))/ZA_RI(:))
END WHERE
- WHERE(ZA_RS(:)<-1.E-20 .AND. ZRST(:)>XRTMIN(5))
+ GWORK(:) = ZA_RS(:)<-1.E-20 .AND. ZRST(:)>XRTMIN(5)
+ WHERE( GWORK(:) )
ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RS(:)+ZRST(:))/ZA_RS(:))
END WHERE
- WHERE(ZA_RG(:)<-1.E-20 .AND. ZRGT(:)>XRTMIN(6))
+ GWORK(:) = ZA_RG(:)<-1.E-20 .AND. ZRGT(:)>XRTMIN(6)
+ WHERE( GWORK(:) )
ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RG(:)+ZRGT(:))/ZA_RG(:))
END WHERE
- IF(KRR==7) THEN
- WHERE(ZA_RH(:)<-1.E-20 .AND. ZRHT(:)>XRTMIN(7))
+ IF(IRR==7) THEN
+ GWORK(:) = ZA_RH(:)<-1.E-20 .AND. ZRHT(:)>XRTMIN(7)
+ WHERE( GWORK(:) )
ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RH(:)+ZRHT(:))/ZA_RH(:))
END WHERE
ENDIF
-
!We stop when the end of the timestep is reached
- WHERE(PTSTEP-ZTIME(:)-ZMAXTIME(:)<=0.)
+ GWORK(:) = PTSTEP-ZTIME(:)-ZMAXTIME(:)<=0.
+ WHERE( GWORK(:) )
LLCOMPUTE(:)=.FALSE.
ENDWHERE
-
+!$acc end kernels
!We must recompute tendencies when the end of the sub-timestep is reached
IF(XTSTEP_TS/=0.) THEN
- WHERE(IITER(:)<INB_ITER_MAX .AND. ZTIME(:)+ZMAXTIME(:)>ZTIME_LASTCALL(:)+ZTSTEP)
+!$acc kernels
+ GWORK(:) = IITER(:)<INB_ITER_MAX .AND. ZTIME(:)+ZMAXTIME(:)>ZTIME_LASTCALL(:)+ZTSTEP
+ WHERE( GWORK(:) )
ZMAXTIME(:)=ZTIME_LASTCALL(:)-ZTIME(:)+ZTSTEP
LLCOMPUTE(:)=.FALSE.
ENDWHERE
+!$acc end kernels
ENDIF
-
!We must recompute tendencies when the maximum allowed change is reached
!When a specy is missing, only the external tendencies can be active and we do not want to recompute
!the microphysical tendencies when external tendencies are negative (results won't change because specy was already missing)
IF(XMRSTEP/=0.) THEN
+!$acc kernels
ZTIME_THRESHOLD(:)=-1.
- WHERE(IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RV(:))>1.E-20)
+ GWORK(:) = IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RV(:))>1.E-20
+ WHERE( GWORK(:) )
ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RV(:))*XMRSTEP+Z0RVT(:)-ZRVT(:)-ZB_RV(:))/ZA_RV(:)
ENDWHERE
- WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- &(ZRVT(:)>XRTMIN(1) .OR. ZA_RV(:)>0.))
+ GWORK(:) = ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
+ (ZRVT(:)>XRTMIN(1) .OR. ZA_RV(:)>0.)
+ WHERE( GWORK(:) )
ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
LLCOMPUTE(:)=.FALSE.
ENDWHERE
ZTIME_THRESHOLD(:)=-1.
- WHERE(IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RC(:))>1.E-20)
+ GWORK(:) = IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RC(:))>1.E-20
+ WHERE( GWORK(:) )
ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RC(:))*XMRSTEP+Z0RCT(:)-ZRCT(:)-ZB_RC(:))/ZA_RC(:)
ENDWHERE
- WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- &(ZRCT(:)>XRTMIN(2) .OR. ZA_RC(:)>0.))
+ GWORK(:) = ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
+ (ZRCT(:)>XRTMIN(2) .OR. ZA_RC(:)>0.)
+ WHERE( GWORK(:) )
ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
LLCOMPUTE(:)=.FALSE.
ENDWHERE
ZTIME_THRESHOLD(:)=-1.
- WHERE(IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RR(:))>1.E-20)
+ GWORK(:) = IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RR(:))>1.E-20
+ WHERE( GWORK(:) )
ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RR(:))*XMRSTEP+Z0RRT(:)-ZRRT(:)-ZB_RR(:))/ZA_RR(:)
ENDWHERE
- WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- &(ZRRT(:)>XRTMIN(3) .OR. ZA_RR(:)>0.))
+ GWORK(:) = ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
+ (ZRRT(:)>XRTMIN(3) .OR. ZA_RR(:)>0.)
+ WHERE( GWORK(:) )
ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
LLCOMPUTE(:)=.FALSE.
ENDWHERE
ZTIME_THRESHOLD(:)=-1.
- WHERE(IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RI(:))>1.E-20)
+ GWORK(:) = IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RI(:))>1.E-20
+ WHERE( GWORK(:) )
ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RI(:))*XMRSTEP+Z0RIT(:)-ZRIT(:)-ZB_RI(:))/ZA_RI(:)
ENDWHERE
- WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- &(ZRIT(:)>XRTMIN(4) .OR. ZA_RI(:)>0.))
+ GWORK(:) = ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
+ (ZRIT(:)>XRTMIN(4) .OR. ZA_RI(:)>0.)
+ WHERE( GWORK(:) )
ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
LLCOMPUTE(:)=.FALSE.
ENDWHERE
ZTIME_THRESHOLD(:)=-1.
- WHERE(IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RS(:))>1.E-20)
+ GWORK(:) = IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RS(:))>1.E-20
+ WHERE( GWORK(:) )
ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RS(:))*XMRSTEP+Z0RST(:)-ZRST(:)-ZB_RS(:))/ZA_RS(:)
ENDWHERE
- WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- &(ZRST(:)>XRTMIN(5) .OR. ZA_RS(:)>0.))
+ GWORK(:) = ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
+ (ZRST(:)>XRTMIN(5) .OR. ZA_RS(:)>0.)
+ WHERE( GWORK(:) )
ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
LLCOMPUTE(:)=.FALSE.
ENDWHERE
ZTIME_THRESHOLD(:)=-1.
- WHERE(IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RG(:))>1.E-20)
+ GWORK(:) = IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RG(:))>1.E-20
+ WHERE( GWORK(:) )
ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RG(:))*XMRSTEP+Z0RGT(:)-ZRGT(:)-ZB_RG(:))/ZA_RG(:)
ENDWHERE
- WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- &(ZRGT(:)>XRTMIN(6) .OR. ZA_RG(:)>0.))
+ GWORK(:) = ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
+ (ZRGT(:)>XRTMIN(6) .OR. ZA_RG(:)>0.)
+ WHERE( GWORK(:) )
ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
LLCOMPUTE(:)=.FALSE.
ENDWHERE
- IF(KRR==7) THEN
+ IF(IRR==7) THEN
ZTIME_THRESHOLD(:)=-1.
- WHERE(IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RH(:))>1.E-20)
+ GWORK(:) = IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RH(:))>1.E-20
+ WHERE( GWORK(:) )
ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RH(:))*XMRSTEP+Z0RHT(:)-ZRHT(:)-ZB_RH(:))/ZA_RH(:)
ENDWHERE
- WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- &(ZRHT(:)>XRTMIN(7) .OR. ZA_RH(:)>0.))
+ GWORK(:) = ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
+ (ZRHT(:)>XRTMIN(7) .OR. ZA_RH(:)>0.)
+ WHERE( GWORK(:) )
ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
LLCOMPUTE(:)=.FALSE.
ENDWHERE
ENDIF
- WHERE(IITER(:)<INB_ITER_MAX .AND. MAX(ABS(ZB_RV(:)), ABS(ZB_RC(:)), ABS(ZB_RR(:)), ABS(ZB_RI(:)), &
- ABS(ZB_RS(:)), ABS(ZB_RG(:)), ABS(ZB_RH(:)))>XMRSTEP)
+ GWORK(:) = IITER(:)<INB_ITER_MAX .AND. MAX(ABS(ZB_RV(:)), ABS(ZB_RC(:)), ABS(ZB_RR(:)), ABS(ZB_RI(:)), &
+ ABS(ZB_RS(:)), ABS(ZB_RG(:)), ABS(ZB_RH(:)))>XMRSTEP
+ WHERE( GWORK(:) )
ZMAXTIME(:)=0.
LLCOMPUTE(:)=.FALSE.
ENDWHERE
+!$acc end kernels
ENDIF
+!$acc kernels
!
!*** 4.3 New values of variables for next iteration
!
@@ -1109,14 +1133,14 @@ DO WHILE(ANY(ZTIME(:)<PTSTEP)) ! Loop to *really* compute tendencies
ZRIT=ZRIT+ZA_RI(:)*ZMAXTIME(:)+ZB_RI(:)
ZRST=ZRST+ZA_RS(:)*ZMAXTIME(:)+ZB_RS(:)
ZRGT=ZRGT+ZA_RG(:)*ZMAXTIME(:)+ZB_RG(:)
- IF(KRR==7) ZRHT=ZRHT+ZA_RH(:)*ZMAXTIME(:)+ZB_RH(:)
+ IF(IRR==7) ZRHT=ZRHT+ZA_RH(:)*ZMAXTIME(:)+ZB_RH(:)
WHERE(ZRIT(:)==0.)
ZCIT(:) = 0.
END WHERE
!
!*** 4.4 Mixing ratio change due to each process
!
- IF(LBU_ENABLE) THEN
+ IF(GBU_ENABLE) THEN
ZTOT_RVHENI(:)= ZTOT_RVHENI(:) +ZRVHENI_MR(:)
ZTOT_RCHONI(:)= ZTOT_RCHONI(:) +ZRCHONI(:) *ZMAXTIME(:)
ZTOT_RRHONG(:)= ZTOT_RRHONG(:) +ZRRHONG_MR(:)
@@ -1166,59 +1190,88 @@ DO WHILE(ANY(ZTIME(:)<PTSTEP)) ! Loop to *really* compute tendencies
!
!*** 4.5 Next loop
!
- LSOFT=.TRUE. ! We try to adjust tendencies (inner while loop)
+ GSOFT=.TRUE. ! We try to adjust tendencies (inner while loop)
ZTIME(:)=ZTIME(:)+ZMAXTIME(:)
+!$acc end kernels
+!$acc update self(LLCOMPUTE)
ENDDO
+!$acc update self(ZTIME)
ENDDO
-
-
-
-
-
-
-
-
-
!-------------------------------------------------------------------------------
!
!* 5. UNPACKING DIAGNOSTICS
! ---------------------
!
+! !$acc kernels
IF(IMICRO>0) THEN
- ZW(:,:,:) = 0.
- ZHLC_HCF3D(:,:,:) = UNPACK(ZHLC_HCF(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))
- ZW(:,:,:) = 0.
- ZHLC_LCF3D(:,:,:) = UNPACK(ZHLC_LCF(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))
- ZW(:,:,:) = 0.
- ZHLC_HRC3D(:,:,:) = UNPACK(ZHLC_HRC(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))
- ZW(:,:,:) = 0.
- ZHLC_LRC3D(:,:,:) = UNPACK(ZHLC_LRC(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))
- PCIT(:,:,:) = UNPACK(ZCIT(:), MASK=LDMICRO(:,:,:), FIELD=PCIT(:,:,:))
+#ifndef _OPENACC
+ PCIT(:,:,:) = UNPACK(ZCIT(:), MASK=ODMICRO(:,:,:), FIELD=PCIT(:,:,:))
+#else
+#if 0
+!$acc kernels
+ IDX = 0
+ DO JK=1,SIZE(ODMICRO,3)
+ DO JJ=1,SIZE(ODMICRO,2)
+ DO JI=1,SIZE(ODMICRO,1)
+ IF (ODMICRO(JI,JJ,JK)) THEN
+ IDX = IDX+1
+ PCIT(JI,JJ,JK) = ZCIT(IDX)
+ ELSE
+ !PCIT(JI,JJ,JK) = PCIT(JI,JJ,JK) !trivial
+ END IF
+ END DO
+ END DO
+ END DO
+!$acc end kernels
+#else
+!PW: bug: Workaround to get correct results for PCIT
+!$acc update self(ZCIT)
+ PCIT(:,:,:) = UNPACK(ZCIT(:), MASK=ODMICRO(:,:,:), FIELD=PCIT(:,:,:))
+!$acc update device(PCIT)
+#endif
+#endif
ELSE
-! ZRAINFR(:,:,:)=0.
- ZHLC_HCF3D(:,:,:)=0.
- ZHLC_LCF3D(:,:,:)=0.
- ZHLC_HRC3D(:,:,:)=0.
- ZHLC_LRC3D(:,:,:)=0.
+!$acc kernels
PCIT(:,:,:) = 0.
+!$acc end kernels
ENDIF
-IF(OWARM) THEN
- ZW(:,:,:)=0.
- PEVAP3D(:,:,:)=UNPACK(ZRREVAV(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))
+!$acc kernels
+IF(GWARM) THEN
+#ifndef _OPENACC
+ PEVAP3D(:,:,:)=UNPACK(ZRREVAV(:), MASK=ODMICRO(:,:,:), FIELD=0.)
+#else
+ IDX = 0
+ DO JK=1,SIZE(ODMICRO,3)
+ DO JJ=1,SIZE(ODMICRO,2)
+ DO JI=1,SIZE(ODMICRO,1)
+ IF (ODMICRO(JI,JJ,JK)) THEN
+ IDX = IDX+1
+ PEVAP3D(JI,JJ,JK) = ZRREVAV(IDX)
+ ELSE
+ PEVAP3D(JI,JJ,JK) = 0.
+ END IF
+ END DO
+ END DO
+ END DO
+#endif
ENDIF
+! !$acc end kernels
!
!
-!* 6. COMPUTES THE SLOW COLD PROCESS SOURCES OUTSIDE OF LDMICRO POINTS
+!* 6. COMPUTES THE SLOW COLD PROCESS SOURCES OUTSIDE OF ODMICRO POINTS
! ----------------------------------------------------------------
!
-GDNOTMICRO = .NOT.LDMICRO
+! !$acc kernels
+GDNOTMICRO = .NOT.ODMICRO
ZLSFACT3D(:,:,:) = ZZ_LSFACT(:,:,:)/PEXN(:,:,:)
+!$acc end kernels
+!$acc data copyin(IIT,IJT,IKT)
CALL ICE4_NUCLEATION_WRAPPER(IIT, IJT, IKT, GDNOTMICRO, &
PTHT, PPABST, PRHODREF, PEXN, ZLSFACT3D, ZT, &
PRVT, &
PCIT, ZZ_RVHENI_MR)
-!$acc update device(PRIS,PRVS,PTHS)
-!$acc kernels present(PEXNREF,PRIS,PRVS,PTHS)
+!$acc end data
+!$acc kernels
ZZ_LSFACT(:,:,:)=ZZ_LSFACT(:,:,:)/PEXNREF(:,:,:)
ZZ_LVFACT(:,:,:)=ZZ_LVFACT(:,:,:)/PEXNREF(:,:,:)
ZZ_RVHENI(:,:,:) = MIN(PRVS(:,:,:), ZZ_RVHENI_MR(:,:,:)/PTSTEP)
@@ -1237,7 +1290,8 @@ PTHS(:,:,:)=PTHS(:,:,:) + ZZ_RVHENI(:,:,:)*ZZ_LSFACT(:,:,:)
!
! ZW_??S variables will contain the new S variables values
!
-IF(LEXT_TEND) THEN
+!$acc kernels
+IF(GEXT_TEND) THEN
!Z..T variables contain the exeternal tendency, we substract it
ZRVT(:) = ZRVT(:) - ZEXT_RV(:) * PTSTEP
ZRCT(:) = ZRCT(:) - ZEXT_RC(:) * PTSTEP
@@ -1245,33 +1299,157 @@ IF(LEXT_TEND) THEN
ZRIT(:) = ZRIT(:) - ZEXT_RI(:) * PTSTEP
ZRST(:) = ZRST(:) - ZEXT_RS(:) * PTSTEP
ZRGT(:) = ZRGT(:) - ZEXT_RG(:) * PTSTEP
- IF (KRR==7) ZRHT(:) = ZRHT(:) - ZEXT_RH(:) * PTSTEP
+ IF (IRR==7) ZRHT(:) = ZRHT(:) - ZEXT_RH(:) * PTSTEP
ZTHT(:) = ZTHT(:) - ZEXT_TH(:) * PTSTEP
ENDIF
+!$acc end kernels
+!$acc update self(ZRVT)
!Tendencies computed from difference between old state and new state (can be negative)
-ZW_RVS(:,:,:) = (UNPACK(ZRVT(:), MASK=LDMICRO(:,:,:), FIELD=PRVT(:,:,:)) - PRVT(:,:,:))*ZINV_TSTEP
-ZW_RCS(:,:,:) = (UNPACK(ZRCT(:), MASK=LDMICRO(:,:,:), FIELD=PRCT(:,:,:)) - PRCT(:,:,:))*ZINV_TSTEP
-ZW_RRS(:,:,:) = (UNPACK(ZRRT(:), MASK=LDMICRO(:,:,:), FIELD=PRRT(:,:,:)) - PRRT(:,:,:))*ZINV_TSTEP
-ZW_RIS(:,:,:) = (UNPACK(ZRIT(:), MASK=LDMICRO(:,:,:), FIELD=PRIT(:,:,:)) - PRIT(:,:,:))*ZINV_TSTEP
-ZW_RSS(:,:,:) = (UNPACK(ZRST(:), MASK=LDMICRO(:,:,:), FIELD=PRST(:,:,:)) - PRST(:,:,:))*ZINV_TSTEP
-ZW_RGS(:,:,:) = (UNPACK(ZRGT(:), MASK=LDMICRO(:,:,:), FIELD=PRGT(:,:,:)) - PRGT(:,:,:))*ZINV_TSTEP
-IF(KRR==7) THEN
- ZW_RHS(:,:,:) = (UNPACK(ZRHT(:), MASK=LDMICRO(:,:,:), FIELD=PRHT(:,:,:)) - PRHT(:,:,:))*ZINV_TSTEP
+#ifndef _OPENACC
+ZW_RVS(:,:,:) = (UNPACK(ZRVT(:), MASK=ODMICRO(:,:,:), FIELD=PRVT(:,:,:)) - PRVT(:,:,:))*ZINV_TSTEP
+ZW_RCS(:,:,:) = (UNPACK(ZRCT(:), MASK=ODMICRO(:,:,:), FIELD=PRCT(:,:,:)) - PRCT(:,:,:))*ZINV_TSTEP
+ZW_RRS(:,:,:) = (UNPACK(ZRRT(:), MASK=ODMICRO(:,:,:), FIELD=PRRT(:,:,:)) - PRRT(:,:,:))*ZINV_TSTEP
+ZW_RIS(:,:,:) = (UNPACK(ZRIT(:), MASK=ODMICRO(:,:,:), FIELD=PRIT(:,:,:)) - PRIT(:,:,:))*ZINV_TSTEP
+ZW_RSS(:,:,:) = (UNPACK(ZRST(:), MASK=ODMICRO(:,:,:), FIELD=PRST(:,:,:)) - PRST(:,:,:))*ZINV_TSTEP
+ZW_RGS(:,:,:) = (UNPACK(ZRGT(:), MASK=ODMICRO(:,:,:), FIELD=PRGT(:,:,:)) - PRGT(:,:,:))*ZINV_TSTEP
+IF(IRR==7) THEN
+ ZW_RHS(:,:,:) = (UNPACK(ZRHT(:), MASK=ODMICRO(:,:,:), FIELD=PRHT(:,:,:)) - PRHT(:,:,:))*ZINV_TSTEP
ELSE
ZW_RHS(:,:,:) = 0.
ENDIF
+#else
+IF (IRR==7) THEN
+!PW: probably not working (see ELSE branch)
+ CALL PRINT_MSG(NVERB_ERROR,'GEN','RAIN_ICE_RED','OpenACC: IRR=7 not yet tested')
+!$acc kernels
+ IDX = 0
+ DO JK=1,SIZE(ODMICRO,3)
+ DO JJ=1,SIZE(ODMICRO,2)
+ DO JI=1,SIZE(ODMICRO,1)
+ IF (ODMICRO(JI,JJ,JK)) THEN
+ IDX = IDX+1
+ ZW_RVS(JI,JJ,JK) = ( ZRVT(IDX) - PRVT(JI,JJ,JK) ) * ZINV_TSTEP
+ ZW_RCS(JI,JJ,JK) = ( ZRCT(IDX) - PRCT(JI,JJ,JK) ) * ZINV_TSTEP
+ ZW_RRS(JI,JJ,JK) = ( ZRRT(IDX) - PRRT(JI,JJ,JK) ) * ZINV_TSTEP
+ ZW_RIS(JI,JJ,JK) = ( ZRIT(IDX) - PRIT(JI,JJ,JK) ) * ZINV_TSTEP
+ ZW_RSS(JI,JJ,JK) = ( ZRST(IDX) - PRST(JI,JJ,JK) ) * ZINV_TSTEP
+ ZW_RGS(JI,JJ,JK) = ( ZRGT(IDX) - PRGT(JI,JJ,JK) ) * ZINV_TSTEP
+ ZW_RHS(JI,JJ,JK) = ( ZRHT(IDX) - PRHT(JI,JJ,JK) ) * ZINV_TSTEP
+ ELSE
+ ZW_RVS(JI,JJ,JK) = 0.
+ ZW_RCS(JI,JJ,JK) = 0.
+ ZW_RRS(JI,JJ,JK) = 0.
+ ZW_RIS(JI,JJ,JK) = 0.
+ ZW_RSS(JI,JJ,JK) = 0.
+ ZW_RGS(JI,JJ,JK) = 0.
+ ZW_RHS(JI,JJ,JK) = 0.
+ END IF
+ END DO
+ END DO
+ END DO
+!$acc end kernels
+ELSE
+#if 0
+!$acc kernels
+ IDX = 0
+ DO JK=1,SIZE(ODMICRO,3)
+ DO JJ=1,SIZE(ODMICRO,2)
+ DO JI=1,SIZE(ODMICRO,1)
+ IF (ODMICRO(JI,JJ,JK)) THEN
+ IDX = IDX+1
+ ZW_RVS(JI,JJ,JK) = ( ZRVT(IDX) - PRVT(JI,JJ,JK) ) * ZINV_TSTEP
+ ZW_RCS(JI,JJ,JK) = ( ZRCT(IDX) - PRCT(JI,JJ,JK) ) * ZINV_TSTEP
+ ZW_RRS(JI,JJ,JK) = ( ZRRT(IDX) - PRRT(JI,JJ,JK) ) * ZINV_TSTEP
+ ZW_RIS(JI,JJ,JK) = ( ZRIT(IDX) - PRIT(JI,JJ,JK) ) * ZINV_TSTEP
+ ZW_RSS(JI,JJ,JK) = ( ZRST(IDX) - PRST(JI,JJ,JK) ) * ZINV_TSTEP
+ ZW_RGS(JI,JJ,JK) = ( ZRGT(IDX) - PRGT(JI,JJ,JK) ) * ZINV_TSTEP
+ ELSE
+ ZW_RVS(JI,JJ,JK) = 0.
+ ZW_RCS(JI,JJ,JK) = 0.
+ ZW_RRS(JI,JJ,JK) = 0.
+ ZW_RIS(JI,JJ,JK) = 0.
+ ZW_RSS(JI,JJ,JK) = 0.
+ ZW_RGS(JI,JJ,JK) = 0.
+ END IF
+ END DO
+ END DO
+ END DO
+ !
+ ZW_RHS(:,:,:) = 0.
+!$acc end kernels
+#else
+!$acc kernels
+ IDX = 0
+ DO JK=1,SIZE(ODMICRO,3)
+ DO JJ=1,SIZE(ODMICRO,2)
+ DO JI=1,SIZE(ODMICRO,1)
+ IF (ODMICRO(JI,JJ,JK)) THEN
+ IDX = IDX+1
+ ZW_RVS(JI,JJ,JK) = ZRVT(IDX)
+ ZW_RCS(JI,JJ,JK) = ZRCT(IDX)
+ ZW_RRS(JI,JJ,JK) = ZRRT(IDX)
+ ZW_RIS(JI,JJ,JK) = ZRIT(IDX)
+ ZW_RSS(JI,JJ,JK) = ZRST(IDX)
+ ZW_RGS(JI,JJ,JK) = ZRGT(IDX)
+ ELSE
+ ZW_RVS(JI,JJ,JK) = PRVT(JI,JJ,JK)
+ ZW_RCS(JI,JJ,JK) = PRCT(JI,JJ,JK)
+ ZW_RRS(JI,JJ,JK) = PRRT(JI,JJ,JK)
+ ZW_RIS(JI,JJ,JK) = PRIT(JI,JJ,JK)
+ ZW_RSS(JI,JJ,JK) = PRST(JI,JJ,JK)
+ ZW_RGS(JI,JJ,JK) = PRGT(JI,JJ,JK)
+ END IF
+ END DO
+ END DO
+ END DO
+!$acc end kernels
+!
+!PW: bug: the following dummy IF is necessary for this subroutine to work... (PGI 18.10)
+IF (IP==0) THEN
+ print *,'PW: IDX=',IDX;flush(6)
+!$acc update self(ODMICRO,ZW_RVS,ZRVT)
+ idx=0
+ DO JK=1,SIZE(ODMICRO,3)
+ DO JJ=1,SIZE(ODMICRO,2)
+ DO JI=1,SIZE(ODMICRO,1)
+ if(odmicro(ji,jj,jk)) then
+ idx=idx+1
+ write(*,"( 'PW:',I4,I4,I4,I6,3E16.8 )") JI,JJ,JK,IDX,ZW_RVS(JI,JJ,JK),ZRVT(IDX),PRVT(JI,JJ,JK)
+ else
+ if( abs( ZW_RVS(JI,JJ,JK)-PRVT(JI,JJ,JK) ) > 1e-14 ) print *,'PW: aie: ',JI,JJ,JK,ZW_RVS(JI,JJ,JK)
+ end if
+ end do
+ end do
+ end do
+print *,'PW: IDX=',IDX;flush(6)
+END IF
+!
+!$acc kernels
+ ZW_RVS(:,:,:) = ( ZW_RVS(:,:,:) - PRVT(:,:,:) ) * ZINV_TSTEP
+ ZW_RCS(:,:,:) = ( ZW_RCS(:,:,:) - PRCT(:,:,:) ) * ZINV_TSTEP
+ ZW_RRS(:,:,:) = ( ZW_RRS(:,:,:) - PRRT(:,:,:) ) * ZINV_TSTEP
+ ZW_RIS(:,:,:) = ( ZW_RIS(:,:,:) - PRIT(:,:,:) ) * ZINV_TSTEP
+ ZW_RSS(:,:,:) = ( ZW_RSS(:,:,:) - PRST(:,:,:) ) * ZINV_TSTEP
+ ZW_RGS(:,:,:) = ( ZW_RGS(:,:,:) - PRGT(:,:,:) ) * ZINV_TSTEP
+ !
+ ZW_RHS(:,:,:) = 0.
+!$acc end kernels
+#endif
+ENDIF
+#endif
+!$acc kernels
ZW_THS(:,:,:) = (ZW_RCS(:,:,:)+ZW_RRS(:,:,:) )*ZZ_LVFACT(:,:,:) + &
& (ZW_RIS(:,:,:)+ZW_RSS(:,:,:)+ZW_RGS(:,:,:)+ZW_RHS(:,:,:))*ZZ_LSFACT(:,:,:)
!We apply these tendencies to the S variables
-!$acc update device(PRVS,PRCS,PRRS,PRIS,PRSS,PRGS,PRHS,PTHS)
ZW_RVS(:,:,:) = PRVS(:,:,:) + ZW_RVS(:,:,:)
ZW_RCS(:,:,:) = PRCS(:,:,:) + ZW_RCS(:,:,:)
ZW_RRS(:,:,:) = PRRS(:,:,:) + ZW_RRS(:,:,:)
ZW_RIS(:,:,:) = PRIS(:,:,:) + ZW_RIS(:,:,:)
ZW_RSS(:,:,:) = PRSS(:,:,:) + ZW_RSS(:,:,:)
ZW_RGS(:,:,:) = PRGS(:,:,:) + ZW_RGS(:,:,:)
-IF(KRR==7) ZW_RHS(:,:,:) = PRHS(:,:,:) + ZW_RHS(:,:,:)
+IF(IRR==7) ZW_RHS(:,:,:) = PRHS(:,:,:) + ZW_RHS(:,:,:)
ZW_THS(:,:,:) = PTHS(:,:,:) + ZW_THS(:,:,:)
+!$acc end kernels
!We correct negativities with conservation
CALL CORRECT_NEGATIVITIES(KRR, ZW_RVS, ZW_RCS, ZW_RRS, &
&ZW_RIS, ZW_RSS, ZW_RGS, &
@@ -1279,350 +1457,356 @@ CALL CORRECT_NEGATIVITIES(KRR, ZW_RVS, ZW_RCS, ZW_RRS, &
!
!*** 7.2 LBU_ENABLE case
!
-IF(LBU_ENABLE) THEN
+IF(GBU_ENABLE) THEN
+#ifdef _OPENACC
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE_RED','OpenACC: GBU_ENABLE=.true. not yet implemented')
+#endif
+!$acc update self(ZINV_TSTEP)
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RVHENI(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RVHENI(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRIS(:,:,:) = PRIS(:,:,:) + ZW(:,:,:)
PRVS(:,:,:) = PRVS(:,:,:) - ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*ZZ_LSFACT(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'HENU_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET(PRVS(:,:,:)*PRHODJ(:,:,:), 6, 'HENU_BU_RRV')
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'HENU_BU_RRI')
+ IF (GBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'HENU_BU_RTH')
+ IF (GBUDGET_RV) CALL BUDGET(PRVS(:,:,:)*PRHODJ(:,:,:), 6, 'HENU_BU_RRV')
+ IF (GBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'HENU_BU_RRI')
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RCHONI(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RCHONI(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRIS(:,:,:) = PRIS(:,:,:) + ZW(:,:,:)
PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'HON_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'HON_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'HON_BU_RRI')
+ IF (GBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'HON_BU_RTH')
+ IF (GBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'HON_BU_RRC')
+ IF (GBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'HON_BU_RRI')
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RRHONG(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RRHONG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'SFR_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'SFR_BU_RRR')
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'SFR_BU_RRG')
+ IF (GBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'SFR_BU_RTH')
+ IF (GBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'SFR_BU_RRR')
+ IF (GBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'SFR_BU_RRG')
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RVDEPS(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RVDEPS(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRSS(:,:,:) = PRSS(:,:,:) + ZW(:,:,:)
PRVS(:,:,:) = PRVS(:,:,:) - ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*ZZ_LSFACT(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'DEPS_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET(PRVS(:,:,:)*PRHODJ(:,:,:), 6, 'DEPS_BU_RRV')
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'DEPS_BU_RRS')
+ IF (GBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'DEPS_BU_RTH')
+ IF (GBUDGET_RV) CALL BUDGET(PRVS(:,:,:)*PRHODJ(:,:,:), 6, 'DEPS_BU_RRV')
+ IF (GBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'DEPS_BU_RRS')
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RIAGGS(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RIAGGS(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRSS(:,:,:) = PRSS(:,:,:) + ZW(:,:,:)
PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'AGGS_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'AGGS_BU_RRS')
+ IF (GBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'AGGS_BU_RRI')
+ IF (GBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'AGGS_BU_RRS')
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RIAUTS(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RIAUTS(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRSS(:,:,:) = PRSS(:,:,:) + ZW(:,:,:)
PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'AUTS_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'AUTS_BU_RRS')
+ IF (GBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'AUTS_BU_RRI')
+ IF (GBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'AUTS_BU_RRS')
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RVDEPG(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RVDEPG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
PRVS(:,:,:) = PRVS(:,:,:) - ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*ZZ_LSFACT(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'DEPG_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET(PRVS(:,:,:)*PRHODJ(:,:,:), 6, 'DEPG_BU_RRV')
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'DEPG_BU_RRG')
+ IF (GBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'DEPG_BU_RTH')
+ IF (GBUDGET_RV) CALL BUDGET(PRVS(:,:,:)*PRHODJ(:,:,:), 6, 'DEPG_BU_RRV')
+ IF (GBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'DEPG_BU_RRG')
- IF(OWARM) THEN
+ IF(GWARM) THEN
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RCAUTR(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RCAUTR(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
PRRS(:,:,:) = PRRS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'AUTO_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'AUTO_BU_RRR')
+ IF (GBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'AUTO_BU_RRC')
+ IF (GBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'AUTO_BU_RRR')
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RCACCR(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RCACCR(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
PRRS(:,:,:) = PRRS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'ACCR_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'ACCR_BU_RRR')
+ IF (GBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'ACCR_BU_RRC')
+ IF (GBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'ACCR_BU_RRR')
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RREVAV(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RREVAV(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
PRVS(:,:,:) = PRVS(:,:,:) + ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) - ZW(:,:,:)*ZZ_LVFACT(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'REVA_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET(PRVS(:,:,:)*PRHODJ(:,:,:), 6, 'REVA_BU_RRV')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'REVA_BU_RRR')
+ IF (GBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'REVA_BU_RTH')
+ IF (GBUDGET_RV) CALL BUDGET(PRVS(:,:,:)*PRHODJ(:,:,:), 6, 'REVA_BU_RRV')
+ IF (GBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'REVA_BU_RRR')
ENDIF
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RCRIMSS(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RCRIMSS(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
PRSS(:,:,:) = PRSS(:,:,:) + ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RCRIMSG(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RCRIMSG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RSRIMCG(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RSRIMCG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'RIM_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'RIM_BU_RRC')
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'RIM_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'RIM_BU_RRG')
+ IF (GBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'RIM_BU_RTH')
+ IF (GBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'RIM_BU_RRC')
+ IF (GBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'RIM_BU_RRS')
+ IF (GBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'RIM_BU_RRG')
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RRACCSS(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RRACCSS(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
PRSS(:,:,:) = PRSS(:,:,:) + ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RRACCSG(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RRACCSG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RSACCRG(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RSACCRG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'ACC_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'ACC_BU_RRR')
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'ACC_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'ACC_BU_RRG')
+ IF (GBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'ACC_BU_RTH')
+ IF (GBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'ACC_BU_RRR')
+ IF (GBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'ACC_BU_RRS')
+ IF (GBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'ACC_BU_RRG')
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RSMLTG(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RSMLTG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RCMLTSR, MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RCMLTSR, MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
PRRS(:,:,:) = PRRS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'CMEL_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'CMEL_BU_RRG')
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'CMEL_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'CMEL_BU_RRR')
+ IF (GBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'CMEL_BU_RRS')
+ IF (GBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'CMEL_BU_RRG')
+ IF (GBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'CMEL_BU_RRC')
+ IF (GBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'CMEL_BU_RRR')
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RICFRRG(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RICFRRG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RRCFRIG(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RRCFRIG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RICFRR(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RICFRR(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
PRRS(:,:,:) = PRRS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'CFRZ_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'CFRZ_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'CFRZ_BU_RRI')
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'CFRZ_BU_RRG')
+ IF (GBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'CFRZ_BU_RTH')
+ IF (GBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'CFRZ_BU_RRR')
+ IF (GBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'CFRZ_BU_RRI')
+ IF (GBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'CFRZ_BU_RRG')
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RCWETG(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RCWETG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RRWETG(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RRWETG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RIWETG(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RIWETG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RSWETG(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RSWETG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'WETG_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'WETG_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'WETG_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'WETG_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'WETG_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'WETG_BU_RRG')
+ IF (GBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'WETG_BU_RTH')
+ IF (GBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'WETG_BU_RRC')
+ IF (GBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'WETG_BU_RRR')
+ IF (GBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'WETG_BU_RRI')
+ IF (GBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'WETG_BU_RRS')
+ IF (GBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'WETG_BU_RRG')
- IF(KRR==7) THEN
+ IF(IRR==7) THEN
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RWETGH(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RWETGH(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRGS(:,:,:) = PRGS(:,:,:) - ZW(:,:,:)
PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'GHCV_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), 12,'GHCV_BU_RRH')
+ IF (GBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'GHCV_BU_RRG')
+ IF (GBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), 12,'GHCV_BU_RRH')
END IF
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RCDRYG(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RCDRYG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RRDRYG(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RRDRYG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RIDRYG(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RIDRYG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RSDRYG(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RSDRYG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'DRYG_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'DRYG_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'DRYG_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'DRYG_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'DRYG_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'DRYG_BU_RRG')
+ IF (GBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'DRYG_BU_RTH')
+ IF (GBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'DRYG_BU_RRC')
+ IF (GBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'DRYG_BU_RRR')
+ IF (GBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'DRYG_BU_RRI')
+ IF (GBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'DRYG_BU_RRS')
+ IF (GBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'DRYG_BU_RRG')
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RGMLTR(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RGMLTR(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRRS(:,:,:) = PRRS(:,:,:) + ZW(:,:,:)
PRGS(:,:,:) = PRGS(:,:,:) - ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) - ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'GMLT_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'GMLT_BU_RRR')
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'GMLT_BU_RRG')
+ IF (GBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'GMLT_BU_RTH')
+ IF (GBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'GMLT_BU_RRR')
+ IF (GBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'GMLT_BU_RRG')
- IF(KRR==7) THEN
+ IF(IRR==7) THEN
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RCWETH(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RCWETH(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RRWETH(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RRWETH(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RIWETH(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RIWETH(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RSWETH(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RSWETH(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RGWETH(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RGWETH(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRGS(:,:,:) = PRGS(:,:,:) - ZW(:,:,:)
PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'WETH_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'WETH_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'WETH_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'WETH_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'WETH_BU_RRS')
- IF (LBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), 12,'WETH_BU_RRH')
+ IF (GBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'WETH_BU_RTH')
+ IF (GBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'WETH_BU_RRC')
+ IF (GBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'WETH_BU_RRR')
+ IF (GBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'WETH_BU_RRI')
+ IF (GBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'WETH_BU_RRS')
+ IF (GBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), 12,'WETH_BU_RRH')
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RGWETH(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RGWETH(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRGS(:,:,:) = PRGS(:,:,:) - ZW(:,:,:)
PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'HGCV_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), 12,'HGCV_BU_RRH')
+ IF (GBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'HGCV_BU_RRG')
+ IF (GBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), 12,'HGCV_BU_RRH')
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RCDRYH(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RCDRYH(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RRDRYH(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RRDRYH(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RIDRYH(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RIDRYH(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RSDRYH(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RSDRYH(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RGDRYH(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RGDRYH(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRGS(:,:,:) = PRGS(:,:,:) - ZW(:,:,:)
PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RDRYHG(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RDRYHG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRHS(:,:,:) = PRHS(:,:,:) - ZW(:,:,:)
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'DRYH_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'DRYH_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'DRYH_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'DRYH_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'DRYH_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'DRYH_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), 12,'DRYH_BU_RRH')
+ IF (GBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'DRYH_BU_RTH')
+ IF (GBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'DRYH_BU_RRC')
+ IF (GBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'DRYH_BU_RRR')
+ IF (GBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'DRYH_BU_RRI')
+ IF (GBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'DRYH_BU_RRS')
+ IF (GBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'DRYH_BU_RRG')
+ IF (GBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), 12,'DRYH_BU_RRH')
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RHMLTR(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RHMLTR(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRRS(:,:,:) = PRRS(:,:,:) + ZW(:,:,:)
PRHS(:,:,:) = PRHS(:,:,:) - ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) - ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'HMLT_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'HMLT_BU_RRR')
- IF (LBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), 12,'HMLT_BU_RRH')
+ IF (GBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'HMLT_BU_RTH')
+ IF (GBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'HMLT_BU_RRR')
+ IF (GBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), 12,'HMLT_BU_RRH')
ENDIF
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RIMLTC(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RIMLTC(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
PRCS(:,:,:) = PRCS(:,:,:) + ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) - ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'IMLT_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'IMLT_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'IMLT_BU_RRI')
+ IF (GBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'IMLT_BU_RTH')
+ IF (GBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'IMLT_BU_RRC')
+ IF (GBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'IMLT_BU_RRI')
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RCBERI(:), MASK=LDMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ ZW(:,:,:)=UNPACK(ZTOT_RCBERI(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
PRIS(:,:,:) = PRIS(:,:,:) + ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'BERFI_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'BERFI_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'BERFI_BU_RRI')
+ IF (GBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'BERFI_BU_RTH')
+ IF (GBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'BERFI_BU_RRC')
+ IF (GBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'BERFI_BU_RRI')
ENDIF
!
!*** 7.3 Final tendencies
!
+!$acc kernels
PRVS(:,:,:) = ZW_RVS(:,:,:)
PRCS(:,:,:) = ZW_RCS(:,:,:)
PRRS(:,:,:) = ZW_RRS(:,:,:)
PRIS(:,:,:) = ZW_RIS(:,:,:)
PRSS(:,:,:) = ZW_RSS(:,:,:)
PRGS(:,:,:) = ZW_RGS(:,:,:)
-IF (KRR==7) THEN
+IF (IRR==7) THEN
PRHS(:,:,:) = ZW_RHS(:,:,:)
ENDIF
PTHS(:,:,:) = ZW_THS(:,:,:)
-IF(LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'CORR_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET(PRVS(:,:,:)*PRHODJ(:,:,:), 6, 'CORR_BU_RRV')
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'CORR_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'CORR_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'CORR_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'CORR_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'CORR_BU_RRG')
- IF (KRR==7) THEN
- IF (LBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), 12,'CORR_BU_RRH')
+!$acc end kernels
+IF(GBU_ENABLE) THEN
+ IF (GBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'CORR_BU_RTH')
+ IF (GBUDGET_RV) CALL BUDGET(PRVS(:,:,:)*PRHODJ(:,:,:), 6, 'CORR_BU_RRV')
+ IF (GBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'CORR_BU_RRC')
+ IF (GBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'CORR_BU_RRR')
+ IF (GBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'CORR_BU_RRI')
+ IF (GBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'CORR_BU_RRS')
+ IF (GBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'CORR_BU_RRG')
+ IF (IRR==7) THEN
+ IF (GBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), 12,'CORR_BU_RRH')
ENDIF
ENDIF
!
@@ -1637,8 +1821,8 @@ IF(LSEDIM_AFTER) THEN
!
IF(HSEDIM=='STAT') THEN
!SR: It *seems* that we must have two separate calls for ifort
- IF(KRR==7) THEN
- CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
+ IF(IRR==7) THEN
+ CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, IKL, &
&PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,&
@@ -1647,7 +1831,7 @@ IF(LSEDIM_AFTER) THEN
&PSEA, PTOWN, &
&PINPRH=PINPRH, PRHT=PRHS*PTSTEP, PRHS=PRHS, PFPR=PFPR)
ELSE
- CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
+ CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, IKL, &
&PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ,&
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,&
@@ -1656,13 +1840,15 @@ IF(LSEDIM_AFTER) THEN
&PSEA, PTOWN, &
&PFPR=PFPR)
ENDIF
-!$acc update self(ZINPRI)
+!$acc kernels
PINPRS(:,:) = PINPRS(:,:) + ZINPRI(:,:)
+!$acc end kernels
!No negativity correction here as we apply sedimentation on PR.S*PTSTEP variables
ELSEIF(HSEDIM=='SPLI') THEN
+!$acc data copyin(IIB,IIE,IIT,IJB,IJE,IJT,IKB,IKE,IKTB,IKTE,IKT,IKL)
!SR: It *seems* that we must have two separate calls for ifort
- IF(KRR==7) THEN
- CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
+ IF(IRR==7) THEN
+ CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, IKL, &
&PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
@@ -1670,7 +1856,7 @@ IF(LSEDIM_AFTER) THEN
&PSEA, PTOWN, &
&PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR)
ELSE
- CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
+ CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, IKL, &
&PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
@@ -1678,8 +1864,10 @@ IF(LSEDIM_AFTER) THEN
&PSEA, PTOWN, &
&PFPR=PFPR)
ENDIF
-!$acc update self(ZINPRI)
+!$acc end data
+!$acc kernels
PINPRS(:,:) = PINPRS(:,:) + ZINPRI(:,:)
+!$acc end kernels
!We correct negativities with conservation
!SPLI algorith uses a time-splitting. Inside the loop a temporary m.r. is used.
! It is initialized with the m.r. at T and is modified by two tendencies:
@@ -1699,53 +1887,39 @@ IF(LSEDIM_AFTER) THEN
!
!* 8.2 budget storage
!
- IF (LBUDGET_RC .AND. OSEDIC) &
+ IF (GBUDGET_RC .AND. OSEDIC) &
CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'SEDI_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'SEDI_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'SEDI_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:), 10, 'SEDI_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:), 11, 'SEDI_BU_RRG')
- IF ( KRR == 7 .AND. LBUDGET_RH) &
+ IF (GBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'SEDI_BU_RRR')
+ IF (GBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'SEDI_BU_RRI')
+ IF (GBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:), 10, 'SEDI_BU_RRS')
+ IF (GBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:), 11, 'SEDI_BU_RRG')
+ IF ( IRR == 7 .AND. GBUDGET_RH) &
CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:), 12, 'SEDI_BU_RRH')
!
-!PW: ZRAINFR (only (IN)OUT variable) not used after
-! !sedimentation of rain fraction
-! CALL ICE4_RAINFR_VERT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL, ZRAINFR, PRRS(:,:,:)*PTSTEP)
ENDIF
!
-
-
-!PW:to remove when all on GPU
-!$acc update device(PCIT,PTHS,PRVS,PRCS,PRRS,PRIS,PRSS,PRGS,PINDEP,PINPRC,PINPRR,PINPRR3D,PEVAP3D,PINPRS,PINPRG)
-IF (PRESENT(PINPRH)) THEN
-!$acc update device(PINPRH)
-END IF
-IF (PRESENT(PFPR)) THEN
-!$acc update device(PFPR)
-END IF
!
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
- CALL MPPDB_CHECK3D(PCIT,"RAIN_ICE_RED end:PCIT",PRECISION)
- CALL MPPDB_CHECK3D(PTHS,"RAIN_ICE_RED end:PTHS",PRECISION)
- CALL MPPDB_CHECK3D(PRVS,"RAIN_ICE_RED end:PRVS",PRECISION)
- CALL MPPDB_CHECK3D(PRCS,"RAIN_ICE_RED end:PRCS",PRECISION)
- CALL MPPDB_CHECK3D(PRRS,"RAIN_ICE_RED end:PRRS",PRECISION)
- CALL MPPDB_CHECK3D(PRIS,"RAIN_ICE_RED end:PRIS",PRECISION)
- CALL MPPDB_CHECK3D(PRSS,"RAIN_ICE_RED end:PRSS",PRECISION)
- CALL MPPDB_CHECK3D(PRGS,"RAIN_ICE_RED end:PRGS",PRECISION)
- CALL MPPDB_CHECK2D(PINDEP,"RAIN_ICE_RED end:PINDEP",PRECISION)
+ CALL MPPDB_CHECK(PCIT,"RAIN_ICE_RED end:PCIT")
+ CALL MPPDB_CHECK(PTHS,"RAIN_ICE_RED end:PTHS")
+ CALL MPPDB_CHECK(PRVS,"RAIN_ICE_RED end:PRVS")
+ CALL MPPDB_CHECK(PRCS,"RAIN_ICE_RED end:PRCS")
+ CALL MPPDB_CHECK(PRRS,"RAIN_ICE_RED end:PRRS")
+ CALL MPPDB_CHECK(PRIS,"RAIN_ICE_RED end:PRIS")
+ CALL MPPDB_CHECK(PRSS,"RAIN_ICE_RED end:PRSS")
+ CALL MPPDB_CHECK(PRGS,"RAIN_ICE_RED end:PRGS")
+ CALL MPPDB_CHECK(PINDEP,"RAIN_ICE_RED end:PINDEP")
!Check all OUT arrays
- CALL MPPDB_CHECK2D(PINPRC,"RAIN_ICE_RED end:PINPRC",PRECISION)
- CALL MPPDB_CHECK2D(PINPRR,"RAIN_ICE_RED end:PINPRR",PRECISION)
- CALL MPPDB_CHECK3D(PINPRR3D,"RAIN_ICE_RED end:PINPRR3D",PRECISION)
- CALL MPPDB_CHECK3D(PEVAP3D,"RAIN_ICE_RED end:PEVAP3D",PRECISION)
- CALL MPPDB_CHECK2D(PINPRS,"RAIN_ICE_RED end:PINPRS",PRECISION)
- CALL MPPDB_CHECK2D(PINPRG,"RAIN_ICE_RED end:PINPRG",PRECISION)
- IF (PRESENT(PINPRH)) CALL MPPDB_CHECK2D(PINPRH,"RAIN_ICE_RED end:PINPRH",PRECISION)
+ CALL MPPDB_CHECK(PINPRC,"RAIN_ICE_RED end:PINPRC")
+ CALL MPPDB_CHECK(PINPRR,"RAIN_ICE_RED end:PINPRR")
+ CALL MPPDB_CHECK(PEVAP3D,"RAIN_ICE_RED end:PEVAP3D")
+ CALL MPPDB_CHECK(PINPRS,"RAIN_ICE_RED end:PINPRS")
+ CALL MPPDB_CHECK(PINPRG,"RAIN_ICE_RED end:PINPRG")
+ IF (PRESENT(PINPRH)) CALL MPPDB_CHECK(PINPRH,"RAIN_ICE_RED end:PINPRH")
IF (PRESENT(PFPR)) THEN
DO JL=1,SIZE(PFPR,4)
- CALL MPPDB_CHECK3D(PFPR(:,:,:,JL),"RAIN_ICE_RED end:PFPR(:,:,:,JL)",PRECISION)
+ CALL MPPDB_CHECK(PFPR(:,:,:,JL),"RAIN_ICE_RED end:PFPR(:,:,:,JL)")
END DO
END IF
END IF
@@ -1835,7 +2009,6 @@ DO JK = 1,SIZE(LTAB,3)
END DO
END DO
!$acc end kernels
-! print *,'PW: RAIN_ICE_COUNTJV3D_DEVICE: IC=',IC
!
END SUBROUTINE RAIN_ICE_COUNTJV3D_DEVICE
#endif
@@ -1857,23 +2030,30 @@ END SUBROUTINE RAIN_ICE_COUNTJV3D_DEVICE
LOGICAL, DIMENSION(SIZE(PRV,1), SIZE(PRV,2), SIZE(PRV,3)) :: GW
REAL, DIMENSION(SIZE(PRV,1), SIZE(PRV,2), SIZE(PRV,3)) :: ZW
!$acc declare create(GW,ZW)
+ !
+ INTEGER :: IRR !Workaround of PGI bug with OpenACC (at least up to 18.10 version)
!
!
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
- CALL MPPDB_CHECK3D(PLVFACT,"CORRECT_NEGATIVITIES beg:PLVFACT",PRECISION)
- CALL MPPDB_CHECK3D(PLSFACT,"CORRECT_NEGATIVITIES beg:PLSFACT",PRECISION)
+ CALL MPPDB_CHECK(PLVFACT,"CORRECT_NEGATIVITIES beg:PLVFACT")
+ CALL MPPDB_CHECK(PLSFACT,"CORRECT_NEGATIVITIES beg:PLSFACT")
!Check all INOUT arrays
- CALL MPPDB_CHECK3D(PRV,"CORRECT_NEGATIVITIES beg:PRV",PRECISION)
- CALL MPPDB_CHECK3D(PRC,"CORRECT_NEGATIVITIES beg:PRC",PRECISION)
- CALL MPPDB_CHECK3D(PRR,"CORRECT_NEGATIVITIES beg:PRR",PRECISION)
- CALL MPPDB_CHECK3D(PRI,"CORRECT_NEGATIVITIES beg:PRI",PRECISION)
- CALL MPPDB_CHECK3D(PRS,"CORRECT_NEGATIVITIES beg:PRS",PRECISION)
- CALL MPPDB_CHECK3D(PRG,"CORRECT_NEGATIVITIES beg:PRG",PRECISION)
- IF(PRESENT(PRH)) CALL MPPDB_CHECK3D(PRH,"CORRECT_NEGATIVITIES beg:PRH",PRECISION)
- CALL MPPDB_CHECK3D(PTH,"CORRECT_NEGATIVITIES beg:PTH",PRECISION)
+ CALL MPPDB_CHECK(PRV,"CORRECT_NEGATIVITIES beg:PRV")
+ CALL MPPDB_CHECK(PRC,"CORRECT_NEGATIVITIES beg:PRC")
+ CALL MPPDB_CHECK(PRR,"CORRECT_NEGATIVITIES beg:PRR")
+ CALL MPPDB_CHECK(PRI,"CORRECT_NEGATIVITIES beg:PRI")
+ CALL MPPDB_CHECK(PRS,"CORRECT_NEGATIVITIES beg:PRS")
+ CALL MPPDB_CHECK(PRG,"CORRECT_NEGATIVITIES beg:PRG")
+ IF(PRESENT(PRH)) CALL MPPDB_CHECK(PRH,"CORRECT_NEGATIVITIES beg:PRH")
+ CALL MPPDB_CHECK(PTH,"CORRECT_NEGATIVITIES beg:PTH")
END IF
!
+!Workaround of PGI bug with OpenACC (at least up to 18.10 version)
+!$acc kernels
+ IRR = KRR
+!$acc end kernels
+ !
!$acc kernels
!We correct negativities with conservation
! 1) deal with negative values for mixing ratio, except for vapor
@@ -1907,18 +2087,14 @@ END SUBROUTINE RAIN_ICE_COUNTJV3D_DEVICE
PTH(:,:,:)=PTH(:,:,:)-PRG(:,:,:)*PLSFACT(:,:,:)
PRG(:,:,:)=0.
ENDWHERE
-!$acc end kernels
- IF(KRR==7) THEN
-!$acc kernels
+ IF(IRR==7) THEN
GW(:,:,:) = PRH(:,:,:)<0.
WHERE(GW(:,:,:))
PRV(:,:,:)=PRV(:,:,:)+PRH(:,:,:)
PTH(:,:,:)=PTH(:,:,:)-PRH(:,:,:)*PLSFACT(:,:,:)
PRH(:,:,:)=0.
ENDWHERE
-!$acc end kernels
ENDIF
-!$acc kernels
! 2) deal with negative vapor mixing ratio
GW(:,:,:) = PRV(:,:,:)<0. .AND. PRC(:,:,:)+PRI(:,:,:)>0.
WHERE(GW(:,:,:))
@@ -1950,9 +2126,7 @@ END SUBROUTINE RAIN_ICE_COUNTJV3D_DEVICE
PRG(:,:,:)=PRG(:,:,:)-ZW(:,:,:)
PTH(:,:,:)=PTH(:,:,:)-ZW(:,:,:)*PLSFACT(:,:,:)
ENDWHERE
-!$acc end kernels
- IF(KRR==7) THEN
-!$acc kernels
+ IF(IRR==7) THEN
GW(:,:,:) = PRV(:,:,:)<0. .AND. PRH(:,:,:)>0.
WHERE(GW(:,:,:))
ZW(:,:,:)=MIN(PRH(:,:,:), -PRV(:,:,:)) ! Quantity of rh to convert into rv
@@ -1960,19 +2134,19 @@ END SUBROUTINE RAIN_ICE_COUNTJV3D_DEVICE
PRH(:,:,:)=PRH(:,:,:)-ZW(:,:,:)
PTH(:,:,:)=PTH(:,:,:)-ZW(:,:,:)*PLSFACT(:,:,:)
ENDWHERE
-!$acc end kernels
ENDIF
+!$acc end kernels
!
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
- CALL MPPDB_CHECK3D(PRV,"CORRECT_NEGATIVITIES end:PRV",PRECISION)
- CALL MPPDB_CHECK3D(PRC,"CORRECT_NEGATIVITIES end:PRC",PRECISION)
- CALL MPPDB_CHECK3D(PRR,"CORRECT_NEGATIVITIES end:PRR",PRECISION)
- CALL MPPDB_CHECK3D(PRI,"CORRECT_NEGATIVITIES end:PRI",PRECISION)
- CALL MPPDB_CHECK3D(PRS,"CORRECT_NEGATIVITIES end:PRS",PRECISION)
- CALL MPPDB_CHECK3D(PRG,"CORRECT_NEGATIVITIES end:PRG",PRECISION)
- IF(PRESENT(PRH)) CALL MPPDB_CHECK3D(PRH,"CORRECT_NEGATIVITIES end:PRH",PRECISION)
- CALL MPPDB_CHECK3D(PTH,"CORRECT_NEGATIVITIES end:PTH",PRECISION)
+ CALL MPPDB_CHECK(PRV,"CORRECT_NEGATIVITIES end:PRV")
+ CALL MPPDB_CHECK(PRC,"CORRECT_NEGATIVITIES end:PRC")
+ CALL MPPDB_CHECK(PRR,"CORRECT_NEGATIVITIES end:PRR")
+ CALL MPPDB_CHECK(PRI,"CORRECT_NEGATIVITIES end:PRI")
+ CALL MPPDB_CHECK(PRS,"CORRECT_NEGATIVITIES end:PRS")
+ CALL MPPDB_CHECK(PRG,"CORRECT_NEGATIVITIES end:PRG")
+ IF(PRESENT(PRH)) CALL MPPDB_CHECK(PRH,"CORRECT_NEGATIVITIES end:PRH")
+ CALL MPPDB_CHECK(PTH,"CORRECT_NEGATIVITIES end:PTH")
END IF
!
!
diff --git a/src/MNH/resolved_cloud.f90 b/src/MNH/resolved_cloud.f90
index 318f3fb4ba1aa101ca035f6e7678dd7c8d93f27e..20d3e650e54aaa606b2b0e3a5e27688cc075d180 100644
--- a/src/MNH/resolved_cloud.f90
+++ b/src/MNH/resolved_cloud.f90
@@ -1,8 +1,7 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-! $Source: /srv/cvsroot/MNH-VX-Y-Z/src/MNH/resolved_cloud.f90,v $
!-----------------------------------------------------------------
! ##########################
MODULE MODI_RESOLVED_CLOUD
@@ -512,6 +511,13 @@ REAL,DIMENSION(SIZE(PRS,1),SIZE(PRS,2),SIZE(PRS,3),SIZE(PRS,4)) :: ZRSSTEP
!$acc & create(ZTHSSTEP,ZRSSTEP,LLMICRO) &
!$acc & copyin(XRTMIN)
!
+!
+! INOUT variables
+!
+!$acc update device(PTHS,PRT,PRS,PSVT,PSVS,PCLDFR,PCIT,&
+!$acc & PINPRC,PINPRR,PINPRR3D,PEVAP3D,PINPRS,PINPRG,PINPRH,PINDEP,&
+!$acc & PSUPSAT,PNACT,PNPRO,PSSPRO)
+!
!------------------------------------------------------------------------------
!
!* 1. PRELIMINARY COMPUTATIONS
@@ -519,66 +525,66 @@ REAL,DIMENSION(SIZE(PRS,1),SIZE(PRS,2),SIZE(PRS,3),SIZE(PRS,4)) :: ZRSSTEP
!
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
- CALL MPPDB_CHECK3D(PZZ,"RESOLVED_CLOUD beg:PZZ",PRECISION)
- CALL MPPDB_CHECK3D(PRHODJ,"RESOLVED_CLOUD beg:PRHODJ",PRECISION)
- CALL MPPDB_CHECK3D(PRHODREF,"RESOLVED_CLOUD beg:PRHODREF",PRECISION)
- CALL MPPDB_CHECK3D(PEXNREF,"RESOLVED_CLOUD beg:PEXNREF",PRECISION)
- CALL MPPDB_CHECK3D(PPABST,"RESOLVED_CLOUD beg:PPABST",PRECISION)
- CALL MPPDB_CHECK3D(PTHT,"RESOLVED_CLOUD beg:PTHT",PRECISION)
- CALL MPPDB_CHECK3D(PSIGS,"RESOLVED_CLOUD beg:PSIGS",PRECISION)
- CALL MPPDB_CHECK3D(PMFCONV,"RESOLVED_CLOUD beg:PMFCONV",PRECISION)
- CALL MPPDB_CHECK3D(PTHM,"RESOLVED_CLOUD beg:PTHM",PRECISION)
- CALL MPPDB_CHECK3D(PPABSM,"RESOLVED_CLOUD beg:PPABSM",PRECISION)
- CALL MPPDB_CHECK3D(PRCM,"RESOLVED_CLOUD beg:PRCM",PRECISION)
- CALL MPPDB_CHECK3D(PW_ACT,"RESOLVED_CLOUD beg:PW_ACT",PRECISION)
- CALL MPPDB_CHECK3D(PDTHRAD,"RESOLVED_CLOUD beg:PDTHRAD",PRECISION)
- CALL MPPDB_CHECK3D(PCF_MF,"RESOLVED_CLOUD beg:PCF_MF",PRECISION)
- CALL MPPDB_CHECK3D(PRC_MF,"RESOLVED_CLOUD beg:PRC_MF",PRECISION)
- CALL MPPDB_CHECK3D(PRI_MF,"RESOLVED_CLOUD beg:PRI_MF",PRECISION)
+ CALL MPPDB_CHECK(PZZ,"RESOLVED_CLOUD beg:PZZ")
+ CALL MPPDB_CHECK(PRHODJ,"RESOLVED_CLOUD beg:PRHODJ")
+ CALL MPPDB_CHECK(PRHODREF,"RESOLVED_CLOUD beg:PRHODREF")
+ CALL MPPDB_CHECK(PEXNREF,"RESOLVED_CLOUD beg:PEXNREF")
+ CALL MPPDB_CHECK(PPABST,"RESOLVED_CLOUD beg:PPABST")
+ CALL MPPDB_CHECK(PTHT,"RESOLVED_CLOUD beg:PTHT")
+ CALL MPPDB_CHECK(PSIGS,"RESOLVED_CLOUD beg:PSIGS")
+ CALL MPPDB_CHECK(PMFCONV,"RESOLVED_CLOUD beg:PMFCONV")
+ CALL MPPDB_CHECK(PTHM,"RESOLVED_CLOUD beg:PTHM")
+ CALL MPPDB_CHECK(PPABSM,"RESOLVED_CLOUD beg:PPABSM")
+ CALL MPPDB_CHECK(PRCM,"RESOLVED_CLOUD beg:PRCM")
+ CALL MPPDB_CHECK(PW_ACT,"RESOLVED_CLOUD beg:PW_ACT")
+ CALL MPPDB_CHECK(PDTHRAD,"RESOLVED_CLOUD beg:PDTHRAD")
+ CALL MPPDB_CHECK(PCF_MF,"RESOLVED_CLOUD beg:PCF_MF")
+ CALL MPPDB_CHECK(PRC_MF,"RESOLVED_CLOUD beg:PRC_MF")
+ CALL MPPDB_CHECK(PRI_MF,"RESOLVED_CLOUD beg:PRI_MF")
! DO JI=1,SIZE(PSOLORG,4)
- ! CALL MPPDB_CHECK3D(PSOLORG(:,:,:,JI),"RESOLVED_CLOUD beg:PSOLORG(:,:,:,JI)",PRECISION)
+ ! CALL MPPDB_CHECK(PSOLORG(:,:,:,JI),"RESOLVED_CLOUD beg:PSOLORG(:,:,:,JI)")
! END DO
! DO JI=1,SIZE(PMI,4)
- ! CALL MPPDB_CHECK3D(PMI(:,:,:,JI),"RESOLVED_CLOUD beg:PMI(:,:,:,JI)",PRECISION)
+ ! CALL MPPDB_CHECK(PMI(:,:,:,JI),"RESOLVED_CLOUD beg:PMI(:,:,:,JI)")
! END DO
- IF (PRESENT(PSEA)) CALL MPPDB_CHECK2D(PSEA,"RESOLVED_CLOUD beg:PSEA",PRECISION)
- IF (PRESENT(PTOWN)) CALL MPPDB_CHECK2D(PTOWN,"RESOLVED_CLOUD beg:PTOWN",PRECISION)
+ IF (PRESENT(PSEA)) CALL MPPDB_CHECK(PSEA,"RESOLVED_CLOUD beg:PSEA")
+ IF (PRESENT(PTOWN)) CALL MPPDB_CHECK(PTOWN,"RESOLVED_CLOUD beg:PTOWN")
!Check all INOUT arrays
- CALL MPPDB_CHECK3D(PRT(:,:,:,1),"RESOLVED_CLOUD beg:PRT(:,:,:,1)",PRECISION)
- CALL MPPDB_CHECK3D(PRT(:,:,:,2),"RESOLVED_CLOUD beg:PRT(:,:,:,2)",PRECISION)
- CALL MPPDB_CHECK3D(PRT(:,:,:,3),"RESOLVED_CLOUD beg:PRT(:,:,:,3)",PRECISION)
- CALL MPPDB_CHECK3D(PRT(:,:,:,4),"RESOLVED_CLOUD beg:PRT(:,:,:,4)",PRECISION)
- CALL MPPDB_CHECK3D(PRT(:,:,:,5),"RESOLVED_CLOUD beg:PRT(:,:,:,5)",PRECISION)
- CALL MPPDB_CHECK3D(PRT(:,:,:,6),"RESOLVED_CLOUD beg:PRT(:,:,:,6)",PRECISION)
- IF(SIZE(PRT,4)>6) CALL MPPDB_CHECK3D(PRT(:,:,:,7),"RESOLVED_CLOUD beg:PRT(:,:,:,7)",PRECISION)
- CALL MPPDB_CHECK3D(PTHS,"RESOLVED_CLOUD beg:PTHS",PRECISION)
- CALL MPPDB_CHECK3D(PRS(:,:,:,1),"RESOLVED_CLOUD beg:PRS(:,:,:,1)",PRECISION)
- CALL MPPDB_CHECK3D(PRS(:,:,:,2),"RESOLVED_CLOUD beg:PRS(:,:,:,2)",PRECISION)
- CALL MPPDB_CHECK3D(PRS(:,:,:,3),"RESOLVED_CLOUD beg:PRS(:,:,:,3)",PRECISION)
- CALL MPPDB_CHECK3D(PRS(:,:,:,4),"RESOLVED_CLOUD beg:PRS(:,:,:,4)",PRECISION)
- CALL MPPDB_CHECK3D(PRS(:,:,:,5),"RESOLVED_CLOUD beg:PRS(:,:,:,5)",PRECISION)
- CALL MPPDB_CHECK3D(PRS(:,:,:,6),"RESOLVED_CLOUD beg:PRS(:,:,:,6)",PRECISION)
- IF(SIZE(PRS,4)>6) CALL MPPDB_CHECK3D(PRS(:,:,:,7),"RESOLVED_CLOUD beg:PRS(:,:,:,7)",PRECISION)
+ CALL MPPDB_CHECK(PRT(:,:,:,1),"RESOLVED_CLOUD beg:PRT(:,:,:,1)")
+ CALL MPPDB_CHECK(PRT(:,:,:,2),"RESOLVED_CLOUD beg:PRT(:,:,:,2)")
+ CALL MPPDB_CHECK(PRT(:,:,:,3),"RESOLVED_CLOUD beg:PRT(:,:,:,3)")
+ CALL MPPDB_CHECK(PRT(:,:,:,4),"RESOLVED_CLOUD beg:PRT(:,:,:,4)")
+ CALL MPPDB_CHECK(PRT(:,:,:,5),"RESOLVED_CLOUD beg:PRT(:,:,:,5)")
+ CALL MPPDB_CHECK(PRT(:,:,:,6),"RESOLVED_CLOUD beg:PRT(:,:,:,6)")
+ IF(SIZE(PRT,4)>6) CALL MPPDB_CHECK(PRT(:,:,:,7),"RESOLVED_CLOUD beg:PRT(:,:,:,7)")
+ CALL MPPDB_CHECK(PTHS,"RESOLVED_CLOUD beg:PTHS")
+ CALL MPPDB_CHECK(PRS(:,:,:,1),"RESOLVED_CLOUD beg:PRS(:,:,:,1)")
+ CALL MPPDB_CHECK(PRS(:,:,:,2),"RESOLVED_CLOUD beg:PRS(:,:,:,2)")
+ CALL MPPDB_CHECK(PRS(:,:,:,3),"RESOLVED_CLOUD beg:PRS(:,:,:,3)")
+ CALL MPPDB_CHECK(PRS(:,:,:,4),"RESOLVED_CLOUD beg:PRS(:,:,:,4)")
+ CALL MPPDB_CHECK(PRS(:,:,:,5),"RESOLVED_CLOUD beg:PRS(:,:,:,5)")
+ CALL MPPDB_CHECK(PRS(:,:,:,6),"RESOLVED_CLOUD beg:PRS(:,:,:,6)")
+ IF(SIZE(PRS,4)>6) CALL MPPDB_CHECK(PRS(:,:,:,7),"RESOLVED_CLOUD beg:PRS(:,:,:,7)")
DO JI=1,SIZE(PSVT,4)
- CALL MPPDB_CHECK3D(PSVT(:,:,:,JI),"RESOLVED_CLOUD beg:PSVT(:,:,:,JI)",PRECISION)
+ CALL MPPDB_CHECK(PSVT(:,:,:,JI),"RESOLVED_CLOUD beg:PSVT(:,:,:,JI)")
END DO
DO JI=1,SIZE(PSVS,4)
- CALL MPPDB_CHECK3D(PSVS(:,:,:,JI),"RESOLVED_CLOUD beg:PSVS(:,:,:,JI)",PRECISION)
+ CALL MPPDB_CHECK(PSVS(:,:,:,JI),"RESOLVED_CLOUD beg:PSVS(:,:,:,JI)")
END DO
- CALL MPPDB_CHECK3D(PCLDFR,"RESOLVED_CLOUD beg:PCLDFR",PRECISION)
- CALL MPPDB_CHECK3D(PCIT,"RESOLVED_CLOUD beg:PCIT",PRECISION)
- CALL MPPDB_CHECK2D(PINPRC,"RESOLVED_CLOUD beg:PINPRC",PRECISION)
- CALL MPPDB_CHECK2D(PINPRR,"RESOLVED_CLOUD beg:PINPRR",PRECISION)
- CALL MPPDB_CHECK3D(PINPRR3D,"RESOLVED_CLOUD beg:PINPRR3D",PRECISION)
- CALL MPPDB_CHECK3D(PEVAP3D,"RESOLVED_CLOUD beg:PEVAP3D",PRECISION)
- CALL MPPDB_CHECK2D(PINPRS,"RESOLVED_CLOUD beg:PINPRS",PRECISION)
- CALL MPPDB_CHECK2D(PINPRG,"RESOLVED_CLOUD beg:PINPRG",PRECISION)
- CALL MPPDB_CHECK2D(PINPRH,"RESOLVED_CLOUD beg:PINPRH",PRECISION)
- CALL MPPDB_CHECK2D(PINDEP,"RESOLVED_CLOUD beg:PINDEP",PRECISION)
- CALL MPPDB_CHECK3D(PSUPSAT,"RESOLVED_CLOUD beg:PSUPSAT",PRECISION)
- CALL MPPDB_CHECK3D(PNACT,"RESOLVED_CLOUD beg:PNACT",PRECISION)
- CALL MPPDB_CHECK3D(PNPRO,"RESOLVED_CLOUD beg:PNPRO",PRECISION)
- CALL MPPDB_CHECK3D(PSSPRO,"RESOLVED_CLOUD beg:PSSPRO",PRECISION)
+ CALL MPPDB_CHECK(PCLDFR,"RESOLVED_CLOUD beg:PCLDFR")
+ CALL MPPDB_CHECK(PCIT,"RESOLVED_CLOUD beg:PCIT")
+ CALL MPPDB_CHECK(PINPRC,"RESOLVED_CLOUD beg:PINPRC")
+ CALL MPPDB_CHECK(PINPRR,"RESOLVED_CLOUD beg:PINPRR")
+ CALL MPPDB_CHECK(PINPRR3D,"RESOLVED_CLOUD beg:PINPRR3D")
+ CALL MPPDB_CHECK(PEVAP3D,"RESOLVED_CLOUD beg:PEVAP3D")
+ CALL MPPDB_CHECK(PINPRS,"RESOLVED_CLOUD beg:PINPRS")
+ CALL MPPDB_CHECK(PINPRG,"RESOLVED_CLOUD beg:PINPRG")
+ CALL MPPDB_CHECK(PINPRH,"RESOLVED_CLOUD beg:PINPRH")
+ CALL MPPDB_CHECK(PINDEP,"RESOLVED_CLOUD beg:PINDEP")
+ CALL MPPDB_CHECK(PSUPSAT,"RESOLVED_CLOUD beg:PSUPSAT")
+ CALL MPPDB_CHECK(PNACT,"RESOLVED_CLOUD beg:PNACT")
+ CALL MPPDB_CHECK(PNPRO,"RESOLVED_CLOUD beg:PNPRO")
+ CALL MPPDB_CHECK(PSSPRO,"RESOLVED_CLOUD beg:PSSPRO")
END IF
!
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
@@ -761,8 +767,7 @@ END IF
SELECT CASE ( HCLOUD )
CASE('KESS')
#ifdef _OPENACC
-PRINT *,'OPENACC: RESOLVED_CLOUD::KESS not yet implemented'
-CALL ABORT
+CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','KESS not yet implemented')
#endif
WHERE (PRS(:,:,:,2) < 0.)
PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,2)
@@ -913,8 +918,7 @@ CALL ABORT
!
CASE('C3R5')
#ifdef _OPENACC
-PRINT *,'OPENACC: RESOLVED_CLOUD::C3R5 not yet implemented'
-CALL ABORT
+CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','C3R5 not yet implemented')
#endif
WHERE (PRS(:,:,:,2) < 0. .OR. ZSVS(:,:,:,2) < 0.)
ZSVS(:,:,:,1) = 0.0
@@ -949,7 +953,7 @@ CALL ABORT
!
CASE('LIMA')
#ifdef _OPENACC
-PRINT *,'OPENACC: RESOLVED_CLOUD::LIMA not yet implemented'
+CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','LIMA not yet implemented')
#endif
! Correction where rc<0 or Nc<0
IF (OWARM) THEN
@@ -1040,8 +1044,7 @@ END IF
SELECT CASE ( HCLOUD )
CASE ('REVE')
#ifdef _OPENACC
-PRINT *,'OPENACC: RESOLVED_CLOUD::REVE not yet implemented'
-CALL ABORT
+CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','REVE not yet implemented')
#endif
!
!* 4. REVERSIBLE MICROPHYSICAL SCHEME
@@ -1057,8 +1060,7 @@ CALL ABORT
!
CASE ('KESS')
#ifdef _OPENACC
-PRINT *,'OPENACC: RESOLVED_CLOUD::KESS not yet implemented'
-CALL ABORT
+CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','KESS not yet implemented')
#endif
!
!* 5. KESSLER MICROPHYSICAL SCHEME
@@ -1086,8 +1088,7 @@ CALL ABORT
!
CASE ('C2R2','KHKO')
#ifdef _OPENACC
-PRINT *,'OPENACC: RESOLVED_CLOUD::C2R2//KHKO not yet implemented'
-CALL ABORT
+CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','C2R2//KHKO not yet implemented')
#endif
!
!* 7. 2-MOMENT WARM MICROPHYSICAL SCHEME C2R2 or KHKO
@@ -1148,9 +1149,11 @@ CALL ABORT
ZTHSSTEP = PTHS * PTSTEP
ZRSSTEP = PRS * PTSTEP
!
+ ZDZZ(:,:,1:IKB-1) = 0.
DO JK=IKB,IKE
ZDZZ(:,:,JK)=PZZ(:,:,JK+1)-PZZ(:,:,JK)
ENDDO
+ ZDZZ(:,:,IKE+1:) = 0.
!$acc end kernels
#ifndef _OPENACC
ZZZ = MZF(1,IKU,1, PZZ )
@@ -1158,10 +1161,6 @@ CALL ABORT
CALL MZF_DEVICE(1,IKU,1,PZZ,ZZZ)
#endif
IF(LRED .AND. LADJ_BEFORE) THEN
-#ifdef _OPENACC
-PRINT *,'OPENACC: RESOLVED_CLOUD::LRED .AND. LADJ_BEFORE not yet implemented'
-! CALL ABORT
-#endif
!$acc data present(ZRSSTEP,ZTHSSTEP)
CALL ICE_ADJUST (1,IKU,1, KRR, CFRAC_ICE_ADJUST, 'ADJU', &
OSUBG_COND, OSIGMAS, PTSTEP,PSIGQSAT, &
@@ -1177,10 +1176,6 @@ PRINT *,'OPENACC: RESOLVED_CLOUD::LRED .AND. LADJ_BEFORE not yet implemented'
!$acc end data
ENDIF
IF (LRED) THEN
-#ifdef _OPENACC
-PRINT *,'OPENACC: RESOLVED_CLOUD::LRED not yet implemented'
-! CALL ABORT
-#endif
!$acc kernels present(LLMICRO,PRT,XRTMIN,ZRSMIN)
LLMICRO(:,:,:)=PRT(:,:,:,2)>XRTMIN(2) .OR. &
PRT(:,:,:,3)>XRTMIN(3) .OR. &
@@ -1208,7 +1203,7 @@ PRINT *,'OPENACC: RESOLVED_CLOUD::LRED not yet implemented'
PRT(:,:,:,5), PRT(:,:,:,6), &
PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
- PINPRC,PINPRR, PINPRR3D, PEVAP3D, &
+ PINPRC,PINPRR, PEVAP3D, &
! PINPRS, PINPRG, PSIGS, PINDEP, PSEA,PTOWN, PFPR=ZFPR)
PINPRS, PINPRG, PSIGS, PINDEP, PSEA=PSEA,PTOWN=PTOWN)
!$acc end data
@@ -1255,13 +1250,13 @@ PRINT *,'OPENACC: RESOLVED_CLOUD::LRED not yet implemented'
!$acc end data
!$acc update self(PCLDFR,PSRCS)
END IF
+ !
! DEALLOCATE(ZRSSTEP)
! DEALLOCATE(ZTHSSTEP)
!
CASE ('ICE4')
#ifdef _OPENACC
-PRINT *,'OPENACC: RESOLVED_CLOUD::ICE4 not yet implemented'
-CALL ABORT
+CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','ICE4 not yet implemented')
#endif
!
!* 10. MIXED-PHASE MICROPHYSICAL SCHEME (WITH 4 ICE SPECIES)
@@ -1314,7 +1309,7 @@ CALL ABORT
PRT(:,:,:,5), PRT(:,:,:,6), &
PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
- PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
+ PINPRC, PINPRR, PEVAP3D, &
PINPRS, PINPRG, PSIGS, PINDEP, PSEA, PTOWN, &
! PRT(:,:,:,7), PRS(:,:,:,7), PINPRH, PFPR=ZFPR )
PRT(:,:,:,7), PRS(:,:,:,7), PINPRH )
@@ -1366,8 +1361,7 @@ CALL ABORT
!
CASE ('LIMA')
#ifdef _OPENACC
-PRINT *,'OPENACC: RESOLVED_CLOUD::LIMA not yet implemented'
-CALL ABORT
+CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','LIMA not yet implemented')
#endif
!
IF (LPTSPLIT) THEN
@@ -1486,47 +1480,55 @@ IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA')
DEALLOCATE(ZSVT)
ENDIF
!
+! INOUT variables
+!
+!$acc update self(PTHS,PRT,PRS,PSVT,PSVS,PCLDFR,PCIT,&
+!$acc & PINPRC,PINPRR,PINPRR3D,PEVAP3D,PINPRS,PINPRG,PINPRH,PINDEP,&
+!$acc & PSUPSAT,PNACT,PNPRO,PSSPRO)
+!
+! OUT variables
+!
+!$acc update self(PSRCS)
+!
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
- CALL MPPDB_CHECK3D(PRT(:,:,:,1),"RESOLVED_CLOUD end:PRT(:,:,:,1)",PRECISION)
- CALL MPPDB_CHECK3D(PRT(:,:,:,2),"RESOLVED_CLOUD end:PRT(:,:,:,2)",PRECISION)
- CALL MPPDB_CHECK3D(PRT(:,:,:,3),"RESOLVED_CLOUD end:PRT(:,:,:,3)",PRECISION)
- CALL MPPDB_CHECK3D(PRT(:,:,:,4),"RESOLVED_CLOUD end:PRT(:,:,:,4)",PRECISION)
- CALL MPPDB_CHECK3D(PRT(:,:,:,5),"RESOLVED_CLOUD end:PRT(:,:,:,5)",PRECISION)
- CALL MPPDB_CHECK3D(PRT(:,:,:,6),"RESOLVED_CLOUD end:PRT(:,:,:,6)",PRECISION)
- IF(SIZE(PRT,4)>6) CALL MPPDB_CHECK3D(PRT(:,:,:,7),"RESOLVED_CLOUD end:PRT(:,:,:,7)",PRECISION)
- CALL MPPDB_CHECK3D(PTHS,"RESOLVED_CLOUD end:PTHS",PRECISION)
- CALL MPPDB_CHECK3D(PRS(:,:,:,1),"RESOLVED_CLOUD end:PRS(:,:,:,1)",PRECISION)
- CALL MPPDB_CHECK3D(PRS(:,:,:,2),"RESOLVED_CLOUD end:PRS(:,:,:,2)",PRECISION)
- CALL MPPDB_CHECK3D(PRS(:,:,:,3),"RESOLVED_CLOUD end:PRS(:,:,:,3)",PRECISION)
- CALL MPPDB_CHECK3D(PRS(:,:,:,4),"RESOLVED_CLOUD end:PRS(:,:,:,4)",PRECISION)
- CALL MPPDB_CHECK3D(PRS(:,:,:,5),"RESOLVED_CLOUD end:PRS(:,:,:,5)",PRECISION)
- CALL MPPDB_CHECK3D(PRS(:,:,:,6),"RESOLVED_CLOUD end:PRS(:,:,:,6)",PRECISION)
- IF(SIZE(PRS,4)>6) CALL MPPDB_CHECK3D(PRS(:,:,:,7),"RESOLVED_CLOUD end:PRS(:,:,:,7)",PRECISION)
+ CALL MPPDB_CHECK(PRT(:,:,:,1),"RESOLVED_CLOUD end:PRT(:,:,:,1)")
+ CALL MPPDB_CHECK(PRT(:,:,:,2),"RESOLVED_CLOUD end:PRT(:,:,:,2)")
+ CALL MPPDB_CHECK(PRT(:,:,:,3),"RESOLVED_CLOUD end:PRT(:,:,:,3)")
+ CALL MPPDB_CHECK(PRT(:,:,:,4),"RESOLVED_CLOUD end:PRT(:,:,:,4)")
+ CALL MPPDB_CHECK(PRT(:,:,:,5),"RESOLVED_CLOUD end:PRT(:,:,:,5)")
+ CALL MPPDB_CHECK(PRT(:,:,:,6),"RESOLVED_CLOUD end:PRT(:,:,:,6)")
+ IF(SIZE(PRT,4)>6) CALL MPPDB_CHECK(PRT(:,:,:,7),"RESOLVED_CLOUD end:PRT(:,:,:,7)")
+ CALL MPPDB_CHECK(PTHS,"RESOLVED_CLOUD end:PTHS")
+ CALL MPPDB_CHECK(PRS(:,:,:,1),"RESOLVED_CLOUD end:PRS(:,:,:,1)")
+ CALL MPPDB_CHECK(PRS(:,:,:,2),"RESOLVED_CLOUD end:PRS(:,:,:,2)")
+ CALL MPPDB_CHECK(PRS(:,:,:,3),"RESOLVED_CLOUD end:PRS(:,:,:,3)")
+ CALL MPPDB_CHECK(PRS(:,:,:,4),"RESOLVED_CLOUD end:PRS(:,:,:,4)")
+ CALL MPPDB_CHECK(PRS(:,:,:,5),"RESOLVED_CLOUD end:PRS(:,:,:,5)")
+ CALL MPPDB_CHECK(PRS(:,:,:,6),"RESOLVED_CLOUD end:PRS(:,:,:,6)")
+ IF(SIZE(PRS,4)>6) CALL MPPDB_CHECK(PRS(:,:,:,7),"RESOLVED_CLOUD end:PRS(:,:,:,7)")
DO JI=1,SIZE(PSVT,4)
- CALL MPPDB_CHECK3D(PSVT(:,:,:,JI),"RESOLVED_CLOUD end:PSVT(:,:,:,JI)",PRECISION)
+ CALL MPPDB_CHECK(PSVT(:,:,:,JI),"RESOLVED_CLOUD end:PSVT(:,:,:,JI)")
END DO
DO JI=1,SIZE(PSVS,4)
- CALL MPPDB_CHECK3D(PSVS(:,:,:,JI),"RESOLVED_CLOUD end:PSVS(:,:,:,JI)",PRECISION)
+ CALL MPPDB_CHECK(PSVS(:,:,:,JI),"RESOLVED_CLOUD end:PSVS(:,:,:,JI)")
END DO
- CALL MPPDB_CHECK3D(PCLDFR,"RESOLVED_CLOUD end:PCLDFR",PRECISION)
- CALL MPPDB_CHECK3D(PCIT,"RESOLVED_CLOUD end:PCIT",PRECISION)
- CALL MPPDB_CHECK2D(PINPRC,"RESOLVED_CLOUD end:PINPRC",PRECISION)
- CALL MPPDB_CHECK2D(PINPRR,"RESOLVED_CLOUD end:PINPRR",PRECISION)
- CALL MPPDB_CHECK3D(PINPRR3D,"RESOLVED_CLOUD end:PINPRR3D",PRECISION)
- CALL MPPDB_CHECK3D(PEVAP3D,"RESOLVED_CLOUD end:PEVAP3D",PRECISION)
- CALL MPPDB_CHECK2D(PINPRS,"RESOLVED_CLOUD end:PINPRS",PRECISION)
- CALL MPPDB_CHECK2D(PINPRG,"RESOLVED_CLOUD end:PINPRG",PRECISION)
- CALL MPPDB_CHECK2D(PINPRH,"RESOLVED_CLOUD end:PINPRH",PRECISION)
- CALL MPPDB_CHECK2D(PINDEP,"RESOLVED_CLOUD end:PINDEP",PRECISION)
- CALL MPPDB_CHECK3D(PSUPSAT,"RESOLVED_CLOUD end:PSUPSAT",PRECISION)
- CALL MPPDB_CHECK3D(PNACT,"RESOLVED_CLOUD end:PNACT",PRECISION)
- CALL MPPDB_CHECK3D(PNPRO,"RESOLVED_CLOUD end:PNPRO",PRECISION)
- CALL MPPDB_CHECK3D(PSSPRO,"RESOLVED_CLOUD end:PSSPRO",PRECISION)
+ CALL MPPDB_CHECK(PCLDFR,"RESOLVED_CLOUD end:PCLDFR")
+ CALL MPPDB_CHECK(PCIT,"RESOLVED_CLOUD end:PCIT")
+ CALL MPPDB_CHECK(PINPRC,"RESOLVED_CLOUD end:PINPRC")
+ CALL MPPDB_CHECK(PINPRR,"RESOLVED_CLOUD end:PINPRR")
+ CALL MPPDB_CHECK(PINPRR3D,"RESOLVED_CLOUD end:PINPRR3D")
+ CALL MPPDB_CHECK(PEVAP3D,"RESOLVED_CLOUD end:PEVAP3D")
+ CALL MPPDB_CHECK(PINPRS,"RESOLVED_CLOUD end:PINPRS")
+ CALL MPPDB_CHECK(PINPRG,"RESOLVED_CLOUD end:PINPRG")
+ CALL MPPDB_CHECK(PINPRH,"RESOLVED_CLOUD end:PINPRH")
+ CALL MPPDB_CHECK(PINDEP,"RESOLVED_CLOUD end:PINDEP")
+ CALL MPPDB_CHECK(PSUPSAT,"RESOLVED_CLOUD end:PSUPSAT")
+ CALL MPPDB_CHECK(PNACT,"RESOLVED_CLOUD end:PNACT")
+ CALL MPPDB_CHECK(PNPRO,"RESOLVED_CLOUD end:PNPRO")
+ CALL MPPDB_CHECK(PSSPRO,"RESOLVED_CLOUD end:PSSPRO")
!Check all OUT arrays
- CALL MPPDB_CHECK3D(PSRCS,"RESOLVED_CLOUD end:PSRCS",PRECISION)
- ! CALL MPPDB_CHECK3DM("RESOLVED_CLOUD: 99: PRS(1:6)",PRECISION,&
- ! & PRS(:,:,:,1),PRS(:,:,:,2),PRS(:,:,:,3),PRS(:,:,:,4),PRS(:,:,:,5),PRS(:,:,:,6))
+ CALL MPPDB_CHECK(PSRCS,"RESOLVED_CLOUD end:PSRCS")
END IF
!-------------------------------------------------------------------------------
!