diff --git a/docs/Interfaces b/docs/Interfaces
index 058e4f878ce35ea769b9e2950372185e49d10de8..acaadbf12975c70e5f9999c1e8375c64062d514f 100644
--- a/docs/Interfaces
+++ b/docs/Interfaces
@@ -15,9 +15,22 @@ PHYEX interfaces:
- ini_...
Dependencies:
-- budget
+- mode_budget
- mode_msg, modd_io
- modd_precision
- yomhook, parkind1
+Specificities:
+- in AROME, BUDGET_SORE_INIT does nothing: it is impossible to compute a tendencie
+ from the difference of a temporary variable.
+ Invalid:
+ budget_store_init(tempo_s)
+ modification of tempo_s
+ budget_store_end(tempo_s)
+ Valid:
+ budget_store_init(pronostic_s) #useless but valid
+ modification of pronostic_s
+ budget_store_end(pronostic_s)
+ Also valid:
+ budget_store_add(delta tempo_s)
diff --git a/docs/TODO b/docs/TODO
index 02d50d4cc3829797d16c16f4493add307bfc8432..a6a30bb9b71b49ad63795052a009ae1da7ab2206 100644
--- a/docs/TODO
+++ b/docs/TODO
@@ -19,19 +19,29 @@ Merge pb:
- ice4_nucleation_wrapper:
Tableaux allocatable introduits par Philippe dans meso-nh.
Pas introduits (pour l'instant?) dans version common.
- Ryad doit faire des tests pour regarder impact des allaocatble sur CPU.
- si test OK, on passe en alloacatble
- si test KO, arbitrage entre Philippe et Riad
-- ice4_sedimentation_*:
- Philippe a déclaré PINPRC et PINDEP en (:,:) à la place de (KIT,KJT)
- En commentaire (version split), il met "dimensions of PINPRC and PINDEP not necessarily KIT,KJT"
- Comprendre pourquoi, comment ça peut marcher dans la sédimentation
- Code dans common en (KIT,KJT)
- repasser code en (:,:) si besoin, ou passer en arg les dimensions effectives
- ou modifier MNH pour toujours avoir KIT,KJT
- une partie du code est maintentant dans rain_ice (déposition)
+ Ryad a fait des tests pour regarder impact des allocatable sur CPU => temps * 2
+ Code à nettoyer quelque soit l'option retenue
Etape 2: array syntax -> loop
- en profiter pour supprimer args PA/PB des routines appelées depuis ice4_tendencies, comme pour nucleation
+- regarder si pcompute et llcompute sont toujours tous deux nécessaires dans les mode_ice4* avec le passage en do
- si possible, modifier ice4_sedimentation_split* dans le même esprit que stat
- transformer sedimentation_split_momentum comme sedimentation_split
+
+Pb identifiés à corriger plus tard:
+- deposition devrait être déplacée dans ice4_tendencies
+- non reproduction en changeant le nombre de procs
+- avec les optimisations de Ryad, les tableaux 3D de precip passés à ice4_tendencies
+ lorsque HSUBG_RC_RR_ACCR=='PRFR' ne sont pas utilisables puisque les K1, K2 et K3
+ sont relatifs à la boucle IMICRO et que les calculs faits en debut de routine ne
+ concernent qu'une partie des points
+ => Ã corriger
+- avec découpage en KPROMA, le code ne produit plus les memes resultats
+- seules les options oper ont été testées, il manque des test pour sedim_after, nmaxiter, xmrstep, xtstep, autoconv, rainfr
+
+Répertoire arome/ext contient les codes non PHYEX qu'il faut modifier dans le pack pour qu'il puisse être compilé.
+Ce répertoire devra être vidé à la fin du phasage, les modifications nécessaires ayant été fournies par ailleurs
+
+Budgets/DDH
+- Le code dans budget_DDH devra être transféré dans mode_budget
+- les routines arome specifiques aux budgets sont dans mpa/micro, il faudrait les mettre ailleurs
diff --git a/src/arome/aux/budget.F90 b/src/arome/aux/budget_DDH.F90
similarity index 72%
rename from src/arome/aux/budget.F90
rename to src/arome/aux/budget_DDH.F90
index 244a3a879b84bfbb6234a17d12d89302b200f22a..f934798c0b769d8f9ea4845f8144d585700a8def 100644
--- a/src/arome/aux/budget.F90
+++ b/src/arome/aux/budget_DDH.F90
@@ -1,6 +1,6 @@
! ######spl
! #####################################
- SUBROUTINE BUDGET(PVARS,KBUDN,HBUVAR,YDDDH, YDLDDH, YDMDDH)
+ SUBROUTINE BUDGET_DDH(PVARS,KBUDN,HBUVAR,YDDDH, YDLDDH, YDMDDH, LDISDIFF)
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! #####################################
@@ -52,6 +52,7 @@
!! MODIFICATIONS
!! -------------
!! F.Voitus 16/05/17 : Introduction of new DDH superstructure for budget
+!! S.Riette Jan 2022 : LDISDIFF case
!!
!-------------------------------------------------------------------------------
@@ -78,6 +79,7 @@ TYPE(TYP_DDH) , INTENT(INOUT) :: YDDDH
TYPE(TLDDH) , INTENT(IN) :: YDLDDH
TYPE(TMDDH) , INTENT(IN) :: YDMDDH
+LOGICAL, OPTIONAL , INTENT(IN) :: LDISDIFF ! PVARS contains the increment (default is .FALSE.)
!* 0.2 Declaration of local variables:
REAL,DIMENSION(NPROMADDH,NFLEVGDDH):: ZVARS
@@ -85,10 +87,16 @@ LOGICAL :: LINST,LDDH
INTEGER::IINCR,JLON,JLEV,IFDIA,IOFF
CHARACTER (LEN=4) :: CLPROC
CHARACTER (LEN=11) :: CLDDH
+LOGICAL :: LISDIFF
REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK('BUDGET',0,ZHOOK_HANDLE)
+IF (LHOOK) CALL DR_HOOK('BUDGET_DDH',0,ZHOOK_HANDLE)
+IF (PRESENT(LDISDIFF)) THEN
+ LISDIFF=LDISDIFF
+ELSE
+ LISDIFF=.FALSE.
+ENDIF
IFDIA=SIZE(PVARS,1)
ZVARS(:,:)=0.
@@ -98,7 +106,7 @@ ELSE
IOFF=0
ENDIF
-CLPROC=HBUVAR(1:4)
+CLPROC=HBUVAR(1:MIN(4, LEN(HBUVAR)))//REPEAT('_', MAX(0, 4-LEN(HBUVAR))) !if length is less than 4, fill with '_'
IF (YDLDDH%LDDH_OMP) THEN
CLDDH='T'//YDDDH%YVARMULT(KBUDN)%CNAME//CLPROC
ELSE
@@ -107,7 +115,7 @@ ENDIF
! depi not stored through call to budget but add_field
IF ((CLPROC=='DEPI').OR.(CLPROC=='CEDS')) THEN
- IF (LHOOK) CALL DR_HOOK('BUDGET',1,ZHOOK_HANDLE)
+ IF (LHOOK) CALL DR_HOOK('BUDGET_DDH',1,ZHOOK_HANDLE)
RETURN
ENDIF
@@ -122,12 +130,21 @@ IF (YDLDDH%LDDH_OMP) THEN
ENDDO
ENDDO
ELSE
- DO JLEV=1,NFLEVGDDH
- DO JLON=1,IFDIA
- ZVARS(JLON,JLEV)=PVARS(JLON,1,JLEV+IOFF)-YDDDH%RVARSM(JLON,1,JLEV,KBUDN)
- YDDDH%RVARSM(JLON,1,JLEV,KBUDN)=PVARS(JLON,1,JLEV+IOFF)
+ IF (LISDIFF) THEN
+ DO JLEV=1,NFLEVGDDH
+ DO JLON=1,IFDIA
+ ZVARS(JLON,JLEV)=PVARS(JLON,1,JLEV+IOFF)
+ YDDDH%RVARSM(JLON,1,JLEV,KBUDN)=YDDDH%RVARSM(JLON,1,JLEV,KBUDN)+PVARS(JLON,1,JLEV+IOFF)
+ ENDDO
ENDDO
- ENDDO
+ ELSE
+ DO JLEV=1,NFLEVGDDH
+ DO JLON=1,IFDIA
+ ZVARS(JLON,JLEV)=PVARS(JLON,1,JLEV+IOFF)-YDDDH%RVARSM(JLON,1,JLEV,KBUDN)
+ YDDDH%RVARSM(JLON,1,JLEV,KBUDN)=PVARS(JLON,1,JLEV+IOFF)
+ ENDDO
+ ENDDO
+ ENDIF
ENDIF
ELSE
IF (CLPROC=='INIF') THEN
@@ -138,12 +155,21 @@ ELSE
ENDDO
ENDDO
ELSE
- DO JLEV=1,NFLEVGDDH
- DO JLON=1,IFDIA
- ZVARS(JLON,JLEV)=PVARS(JLON,1,JLEV+IOFF)-TVARSM(JLON,1,JLEV,KBUDN)
- TVARSM(JLON,1,JLEV,KBUDN)=PVARS(JLON,1,JLEV+IOFF)
+ IF (LISDIFF) THEN
+ DO JLEV=1,NFLEVGDDH
+ DO JLON=1,IFDIA
+ ZVARS(JLON,JLEV)=PVARS(JLON,1,JLEV+IOFF)
+ TVARSM(JLON,1,JLEV,KBUDN)=TVARSM(JLON,1,JLEV,KBUDN)+PVARS(JLON,1,JLEV+IOFF)
+ ENDDO
ENDDO
- ENDDO
+ ELSE
+ DO JLEV=1,NFLEVGDDH
+ DO JLON=1,IFDIA
+ ZVARS(JLON,JLEV)=PVARS(JLON,1,JLEV+IOFF)-TVARSM(JLON,1,JLEV,KBUDN)
+ TVARSM(JLON,1,JLEV,KBUDN)=PVARS(JLON,1,JLEV+IOFF)
+ ENDDO
+ ENDDO
+ ENDIF
ENDIF
ENDIF
@@ -178,6 +204,6 @@ IF (CLPROC/='INIF') THEN
ENDIF
ENDIF
-IF (LHOOK) CALL DR_HOOK('BUDGET',1,ZHOOK_HANDLE)
-END SUBROUTINE BUDGET
+IF (LHOOK) CALL DR_HOOK('BUDGET_DDH',1,ZHOOK_HANDLE)
+END SUBROUTINE BUDGET_DDH
diff --git a/src/arome/micro/ini_budget.F90 b/src/arome/aux/ini_budget.F90
similarity index 100%
rename from src/arome/micro/ini_budget.F90
rename to src/arome/aux/ini_budget.F90
diff --git a/src/arome/micro/modd_budget.F90 b/src/arome/aux/modd_budget.F90
similarity index 94%
rename from src/arome/micro/modd_budget.F90
rename to src/arome/aux/modd_budget.F90
index 51d6efd753d84372dbb729413ab0e8a428564f31..1f033601270a4834d15609054afe5c6dd418449a 100644
--- a/src/arome/micro/modd_budget.F90
+++ b/src/arome/aux/modd_budget.F90
@@ -38,11 +38,36 @@
!* 0. DECLARATIONS
! ------------
USE MODD_PARAMETERS, ONLY :JPBUMAX, JPBUPROMAX
+USE DDH_MIX, ONLY : TYP_DDH
+USE YOMLDDH, ONLY : TLDDH
+USE YOMMDDH, ONLY : TMDDH
!
IMPLICIT NONE
SAVE
!
+INTEGER, PARAMETER:: NBUDGET_RHO = 0 ! Reference number for budget of RhoJ
+INTEGER, PARAMETER:: NBUDGET_U = 1 ! Reference number for budget of RhoJu and/or LES budgets with u
+INTEGER, PARAMETER:: NBUDGET_V = 2 ! Reference number for budget of RhoJv and/or LES budgets with u
+INTEGER, PARAMETER:: NBUDGET_W = 3 ! Reference number for budget of RhoJw and/or LES budgets with u
+INTEGER, PARAMETER:: NBUDGET_TH = 4 ! Reference number for budget of RhoJTh and/or LES budgets with th
+INTEGER, PARAMETER:: NBUDGET_TKE = 5 ! Reference number for budget of RhoJTke and/or LES budgets with Tke
+INTEGER, PARAMETER:: NBUDGET_RV = 6 ! Reference number for budget of RhoJrv and/or LES budgets with rv
+INTEGER, PARAMETER:: NBUDGET_RC = 7 ! Reference number for budget of RhoJrc and/or LES budgets with rc
+INTEGER, PARAMETER:: NBUDGET_RR = 8 ! Reference number for budget of RhoJrr and/or LES budgets with rr
+INTEGER, PARAMETER:: NBUDGET_RI = 9 ! Reference number for budget of RhoJri and/or LES budgets with ri
+INTEGER, PARAMETER:: NBUDGET_RS = 10 ! Reference number for budget of RhoJrs and/or LES budgets with rs
+INTEGER, PARAMETER:: NBUDGET_RG = 11 ! Reference number for budget of RhoJrg and/or LES budgets with rg
+INTEGER, PARAMETER:: NBUDGET_RH = 12 ! Reference number for budget of RhoJrh and/or LES budgets with rh
+INTEGER, PARAMETER:: NBUDGET_SV1 = 13 ! Reference number for 1st budget of RhoJsv and/or LES budgets with sv
+!
+TYPE TBUDGETDATA
+ INTEGER :: NBUDGET
+ TYPE(TYP_DDH), POINTER :: YDDDH=>NULL()
+ TYPE(TLDDH), POINTER :: YDLDDH=>NULL()
+ TYPE(TMDDH), POINTER :: YDMDDH=>NULL()
+ENDTYPE
+!
! General variables
LOGICAL :: LBU_ENABLE=.FALSE.
!
diff --git a/src/arome/aux/mode_budget.F90 b/src/arome/aux/mode_budget.F90
new file mode 100644
index 0000000000000000000000000000000000000000..bd59b9e97c988d013433b202c9428efdb58382ef
--- /dev/null
+++ b/src/arome/aux/mode_budget.F90
@@ -0,0 +1,52 @@
+MODULE MODE_BUDGET
+USE MODD_BUDGET, ONLY : TBUDGETDATA
+USE MODI_BUDGET_DDH, ONLY: BUDGET_DDH
+IMPLICIT NONE
+CONTAINS
+
+SUBROUTINE BUDGET_STORE_INIT(TPBUDGET, HSOURCE, PVARS)
+ TYPE(TBUDGETDATA), INTENT(INOUT) :: TPBUDGET ! Budget datastructure
+ CHARACTER(LEN=*), INTENT(IN) :: HSOURCE ! Name of the source term
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARS ! Current value to be stored
+END SUBROUTINE BUDGET_STORE_INIT
+
+SUBROUTINE BUDGET_STORE_END(TPBUDGET, HSOURCE, PVARS)
+ TYPE(TBUDGETDATA), INTENT(INOUT) :: TPBUDGET ! Budget datastructure
+ CHARACTER(LEN=*), INTENT(IN) :: HSOURCE ! Name of the source term
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARS ! Current value to be stored
+ CALL BUDGET_DDH(PVARS, TPBUDGET%NBUDGET, HSOURCE, TPBUDGET%YDDDH, TPBUDGET%YDLDDH, TPBUDGET%YDMDDH)
+END SUBROUTINE BUDGET_STORE_END
+
+SUBROUTINE BUDGET_STORE_ADD(TPBUDGET, HSOURCE, PVARS)
+#ifdef REPRO48
+USE DDH_MIX, ONLY:NFLEVGDDH
+USE MODDB_INTBUDGET, ONLY:TVARSM
+#endif
+ TYPE(TBUDGETDATA), INTENT(INOUT) :: TPBUDGET ! Budget datastructure
+ CHARACTER(LEN=*), INTENT(IN) :: HSOURCE ! Name of the source term
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARS ! Current value to be stored
+#ifdef REPRO48
+ REAL, DIMENSION(SIZE(PVARS, 1), SIZE(PVARS, 2), SIZE(PVARS, 3)) :: ZVARS
+ INTEGER :: JLON, JLEV, IOFF
+ IF (SIZE(PVARS,3)==NFLEVGDDH+2) THEN
+ IOFF=1
+ ELSE
+ IOFF=0
+ ENDIF
+ ZVARS=PVARS
+ DO JLEV=1, NFLEVGDDH
+ DO JLON=1, SIZE(PVARS,1)
+ IF (TPBUDGET%YDLDDH%LDDH_OMP) THEN
+ ZVARS(JLON,1,JLEV+IOFF)=TPBUDGET%YDDDH%RVARSM(JLON,1,JLEV,TPBUDGET%NBUDGET)+ZVARS(JLON,1,JLEV+IOFF)
+ ELSE
+ ZVARS(JLON,1,JLEV+IOFF)=TVARSM(JLON,1,JLEV,TPBUDGET%NBUDGET)+ZVARS(JLON,1,JLEV+IOFF)
+ ENDIF
+ ENDDO
+ ENDDO
+ CALL BUDGET_DDH(ZVARS, TPBUDGET%NBUDGET, HSOURCE, TPBUDGET%YDDDH, TPBUDGET%YDLDDH, TPBUDGET%YDMDDH)
+#else
+ CALL BUDGET_DDH(PVARS, TPBUDGET%NBUDGET, HSOURCE, TPBUDGET%YDDDH, TPBUDGET%YDLDDH, TPBUDGET%YDMDDH, &
+ &LDISDIFF=.TRUE.)
+#endif
+END SUBROUTINE BUDGET_STORE_ADD
+END MODULE MODE_BUDGET
diff --git a/src/arome/aux/mode_ll.F90 b/src/arome/aux/mode_ll.F90
new file mode 100644
index 0000000000000000000000000000000000000000..790a3acac9312351c098993143fe731baf8f60e7
--- /dev/null
+++ b/src/arome/aux/mode_ll.F90
@@ -0,0 +1,14 @@
+MODULE MODE_ll
+IMPLICIT NONE
+CONTAINS
+ SUBROUTINE GET_INDICE_ll(KXOR, KYOR, KXEND, KYEND, KSIZE1, KSIZE2)
+ USE MODD_PARAMETERS, ONLY : JPHEXT
+ IMPLICIT NONE
+ INTEGER, INTENT(IN) :: KSIZE1, KSIZE2
+ INTEGER, INTENT(OUT) :: KXOR, KYOR, KXEND, KYEND
+ KXOR=1+JPHEXT
+ KYOR=1+JPHEXT
+ KXEND=KSIZE1-JPHEXT
+ KYEND=KSIZE2-JPHEXT
+ END SUBROUTINE GET_INDICE_ll
+END MODULE MODE_ll
diff --git a/src/arome/micro/modi_budget.F90 b/src/arome/aux/modi_budget_DDH.F90
similarity index 70%
rename from src/arome/micro/modi_budget.F90
rename to src/arome/aux/modi_budget_DDH.F90
index 968ae2c198adfcf60bc4666d3a5a148e5c07a939..888d53d8e920075753245d64b5e6406d4eabce6a 100644
--- a/src/arome/micro/modi_budget.F90
+++ b/src/arome/aux/modi_budget_DDH.F90
@@ -1,10 +1,10 @@
! ######spl
- MODULE MODI_BUDGET
+ MODULE MODI_BUDGET_DDH
!##################
!
INTERFACE
!
-SUBROUTINE BUDGET(PVARS,KBUDN,HBUVAR,YDDDH, YDLDDH, YDMDDH)
+SUBROUTINE BUDGET_DDH(PVARS,KBUDN,HBUVAR,YDDDH, YDLDDH, YDMDDH, LDISDIFF)
!
USE DDH_MIX, ONLY : TYP_DDH
USE YOMLDDH, ONLY : TLDDH
@@ -17,9 +17,10 @@ CHARACTER (LEN=*) , INTENT(IN) :: HBUVAR ! Identifier of the Budget of the
TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
TYPE(TLDDH), INTENT(IN) :: YDLDDH
TYPE(TMDDH), INTENT(IN) :: YDMDDH
+LOGICAL, OPTIONAL, INTENT(IN) :: LDISDIFF ! PVARS contains the increment
!
-END SUBROUTINE BUDGET
+END SUBROUTINE BUDGET_DDH
!
END INTERFACE
!
-END MODULE MODI_BUDGET
+END MODULE MODI_BUDGET_DDH
diff --git a/src/arome/micro/modi_ini_budget.F90 b/src/arome/aux/modi_ini_budget.F90
similarity index 100%
rename from src/arome/micro/modi_ini_budget.F90
rename to src/arome/aux/modi_ini_budget.F90
diff --git a/src/arome/modset_Ryad/arpifs/phys_dmn/apl_arome.F90 b/src/arome/ext/apl_arome.F90
similarity index 99%
rename from src/arome/modset_Ryad/arpifs/phys_dmn/apl_arome.F90
rename to src/arome/ext/apl_arome.F90
index a1209595358fa3d8550fa78ee881b0c455aa6b76..0601ffe03abe1e2b001738fd7eb7ed1ac77fa6fe 100644
--- a/src/arome/modset_Ryad/arpifs/phys_dmn/apl_arome.F90
+++ b/src/arome/ext/apl_arome.F90
@@ -648,6 +648,9 @@ REAL(KIND=JPRB) :: ZUS__(KFDIA,0:KLEV+1), ZVS__(KFDIA,0:KLEV+1),
REAL(KIND=JPRB) :: ZTKES_OUT__(KFDIA,0:KLEV+1), ZMF_UP__(KFDIA,0:KLEV+1), ZTHVREFM__(KFDIA,0:KLEV+1) ! thetav de l etat
REAL(KIND=JPRB) :: ZTENDU_TURB__(KFDIA,0:KLEV+1), ZTENDV_TURB__(KFDIA,0:KLEV+1), ZTENDTHL_TURB__(KFDIA,0:KLEV+1)
REAL(KIND=JPRB) :: ZTENDRT_TURB__(KFDIA,0:KLEV+1), ZTKEM__(KFDIA,0:KLEV+1), ZSRCS__(KFDIA,0:KLEV+1)
+REAL(KIND=JPRB) :: ZHLC_HRC__(KFDIA,0:KLEV+1), ZHLC_HCF__(KFDIA,0:KLEV+1), &
+ & ZHLI_HRI__(KFDIA,0:KLEV+1), ZHLI_HCF__(KFDIA,0:KLEV+1)
+
REAL(KIND=JPRB) :: ZSIGS__(KFDIA,0:KLEV+1), ZEDR__(KFDIA,0:KLEV+1)
! THE DDH budgets
REAL(KIND=JPRB) :: ZDP__(KFDIA,0:KLEV+1), ZTP__(KFDIA,0:KLEV+1), ZTPMF__(KFDIA,0:KLEV+1)
@@ -1001,6 +1004,8 @@ ASSOCIATE(MINPRR=>YDPARAR%MINPRR, MINPRS=>YDPARAR%MINPRS, MVQS=>YDPARAR%MVQS, &
& MINPRG=>YDPARAR%MINPRG, LOTOWNC=>YDPARAR%LOTOWNC, LFPREC3D=>YDPARAR%LFPREC3D, &
& NGPAR=>YDPARAR%NGPAR, CSUBG_PR_PDF=>YDPARAR%CSUBG_PR_PDF, &
& NRRI=>YDPARAR%NRRI, NRRL=>YDPARAR%NRRL, CSUBG_AUCV_RC=>YDPARAR%CSUBG_AUCV_RC, &
+ & CSUBG_AUCV_RI=>YDPARAR%CSUBG_AUCV_RI, CCONDENS=>YDPARAR%CCONDENS, &
+ & CSUBG_MF_PDF=>YDPARAR%CSUBG_MF_PDF, &
& LTOTPREC=>YDPARAR%LTOTPREC, CSUBG_RC_RR_ACCR=>YDPARAR%CSUBG_RC_RR_ACCR, CSUBG_RR_EVAP=>YDPARAR%CSUBG_RR_EVAP, &
& NPRINTFR=>YDPARAR%NPRINTFR, CMF_CLOUD=>YDPARAR%CMF_CLOUD, &
& MALBDIR=>YDPARAR%MALBDIR, NSWB_MNH=>YDPARAR%NSWB_MNH, &
@@ -1010,7 +1015,7 @@ ASSOCIATE(MINPRR=>YDPARAR%MINPRR, MINPRS=>YDPARAR%MINPRS, MVQS=>YDPARAR%MVQS, &
& LSQUALL=>YDPARAR%LSQUALL, VSIGQSAT=>YDPARAR%VSIGQSAT, &
& MALBSCA=>YDPARAR%MALBSCA,&
& RADSN=>YDPARAR%RADSN, LOSEDIC=>YDPARAR%LOSEDIC, LDIAGWMAX=>YDPARAR%LDIAGWMAX, &
- & CSEDIM=>YDPARAR%CSEDIM, &
+ & CSEDIM=>YDPARAR%CSEDIM, CLAMBDA3=>YDPARAR%CLAMBDA3, &
& NPTP=>YDPARAR%NPTP, NSPLITR=>YDPARAR%NSPLITR, NSPLITG=>YDPARAR%NSPLITG, NSV=>YDPARAR%NSV, &
& CFRAC_ICE_SHALLOW_MF=>YDPARAR%CFRAC_ICE_SHALLOW_MF, CFRAC_ICE_ADJUST=>YDPARAR%CFRAC_ICE_ADJUST, &
& MVTS=>YDPARAR%MVTS, NREFROI2=>YDPARAR%NREFROI2, NREFROI1=>YDPARAR%NREFROI1, &
@@ -3285,8 +3290,10 @@ IF (LMICRO) THEN
& YDDDH, YDMODEL%YRML_DIAG%YRLDDH, YDMODEL%YRML_DIAG%YRMDDH )
ELSE
CALL ARO_RAIN_ICE (NPROMICRO,KLEV,IKU,IKL,KFDIA,KLEV,NRR,KSTEP+1,NSPLITR,NGFL_EZDIAG,&
- & LOSUBG_COND, CSUBG_AUCV_RC, LOSEDIC,CSEDIM, CMICRO, ZDT,ZDZZ_ ,&
+ & LOSUBG_COND, CSUBG_AUCV_RC, CSUBG_AUCV_RI, LOSEDIC,CSEDIM, CMICRO, ZDT,ZDZZ_ ,&
& ZRHODJM__(:,1:KLEV),ZRHODREFM__(:,1:KLEV), ZEXNREFM_, ZPABSM__(:,1:KLEV),&
+ & ZHLC_HRC__(:,1:KLEV), ZHLC_HCF__(KIDIA:KFDIA,1:KLEV),&
+ & ZHLI_HRI__(:,1:KLEV), ZHLI_HCF__(KIDIA:KFDIA,1:KLEV),&
& ZTHM__(:,1:KLEV),ZRM_, ZSIGS__(:,1:KLEV), ZNEBMNH_, ZTHS__(:,1:KLEV),ZRS_,&
& ZEVAP_, ZCIT_,LOWARM,ZSEA_,ZTOWN_, LOCND2,LGRSN,&
& ZINPRR_NOTINCR_, ZINPRS_NOTINCR_, ZINPRG_NOTINCR_, ZINPRH_NOTINCR_,ZPFPR_,&
diff --git a/src/arome/ext/aro_convbu.F90 b/src/arome/ext/aro_convbu.F90
new file mode 100644
index 0000000000000000000000000000000000000000..d6e320a50f83cb2b48fe5cb5567c1da76faf0c68
--- /dev/null
+++ b/src/arome/ext/aro_convbu.F90
@@ -0,0 +1,37 @@
+SUBROUTINE ARO_CONVBU(KFDIA,KLEV,KRR,PRHODJ,PRRS,PTHS,YDDDH, YDLDDH, YDMDDH)
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+
+USE MODD_BUDGET,ONLY: LBU_ENABLE, LBUDGET_TH, LBUDGET_RV, LBUDGET_RC, LBUDGET_RI
+USE MODI_BUDGET_DDH
+USE DDH_MIX, ONLY : TYP_DDH
+USE YOMLDDH, ONLY : TLDDH
+USE YOMMDDH, ONLY : TMDDH
+
+IMPLICIT NONE
+
+INTEGER, INTENT(IN) :: KFDIA
+INTEGER, INTENT(IN) :: KLEV
+INTEGER, INTENT(IN) :: KRR
+REAL, DIMENSION (KFDIA,1,KLEV), INTENT(IN) :: PRHODJ
+REAL, DIMENSION(KFDIA,1,KLEV), INTENT(IN) :: PTHS
+REAL, DIMENSION(KFDIA,1,KLEV,KRR), INTENT(IN) :: PRRS
+TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
+TYPE(TLDDH), INTENT(IN) :: YDLDDH
+TYPE(TMDDH), INTENT(IN) :: YDMDDH
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('ARO_CONVBU',0,ZHOOK_HANDLE)
+IF (LBU_ENABLE) THEN
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'DCONV_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RV) CALL BUDGET_DDH (PRRS(:,:,:,1)*PRHODJ(:,:,:),6,'DCONV_BU_RRV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RC) CALL BUDGET_DDH (PRRS(:,:,:,2)*PRHODJ(:,:,:),7,'DCONV_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RI) CALL BUDGET_DDH (PRRS(:,:,:,4)*PRHODJ(:,:,:),9,'DCONV_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ !IF (LCHTRANS .AND. LBUDGET_SV) THEN
+ ! DO JSV = 1, SIZE(PRSVS,4)
+ ! CALL BUDGET_DDH (PRSVS(:,:,:,JSV),JSV+12,'DCONV_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ ! END DO
+ !END IF
+END IF
+IF (LHOOK) CALL DR_HOOK('ARO_CONVBU',1,ZHOOK_HANDLE)
+END SUBROUTINE ARO_CONVBU
diff --git a/src/arome/ext/aro_lima.F90 b/src/arome/ext/aro_lima.F90
new file mode 100644
index 0000000000000000000000000000000000000000..2bcc226d32dac8816e267357c208a42bd61cd58f
--- /dev/null
+++ b/src/arome/ext/aro_lima.F90
@@ -0,0 +1,326 @@
+! ######spl
+ SUBROUTINE ARO_LIMA(KKA,KKU,KKL,KLON,KLEV, KRR, KSV, KTCOUNT, KSPLITR, KSPLITG, &
+ PTSTEP, PDZZ, PRHODJ, PRHODREF, PEXNREF,&
+ PPABSM, PW_NU, PTHT, PRT, PSVT, &
+ PTHS, PRS, PSVS, PEVAP, &
+ PINPRR,PINPRS, &
+ PINPRG,PINPRH,PFPR, &
+ YDDDH, YDLDDH, YDMDDH )
+
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+! ##########################################################################
+!
+!!**** * - compute the resolved clouds and precipitation
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the microphysical sources
+!! related to the resolved clouds and precipitation in LIMA
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Vie et al., 2015 GMD
+!!
+!! AUTHOR
+!! ------
+!! B. Vie
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 17/09/13
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!
+USE MODD_CONF
+USE MODD_CST
+USE MODD_PARAMETERS
+USE MODD_RAIN_ICE_DESCR
+!
+USE MODD_PARAM_ICE
+USE MODD_PARAM_LIMA
+USE MODD_NSV
+!
+USE MODD_BUDGET
+USE MODI_BUDGET_DDH
+!
+USE MODI_LIMA
+!
+USE MODI_LIMA_WARM
+USE MODI_LIMA_COLD
+USE MODI_LIMA_MIXED
+!
+USE DDH_MIX, ONLY : TYP_DDH
+USE YOMLDDH, ONLY : TLDDH
+USE YOMMDDH, ONLY : TMDDH
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+INTEGER, INTENT(IN) :: KLON !NPROMA under CPG
+INTEGER, INTENT(IN) :: KLEV !Number of vertical levels
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KSV ! Number of LIMA variables
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
+INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
+ ! integrations for rain sedimendation
+INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step
+ ! integrations for graupel/hail sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Time step
+!
+!
+REAL, DIMENSION(KLON,1,KLEV), INTENT(IN) :: PDZZ ! Height (z)
+REAL, DIMENSION(KLON,1,KLEV), INTENT(IN) :: PRHODJ !Dry density * Jacobian
+REAL, DIMENSION(KLON,1,KLEV), INTENT(IN) :: PRHODREF! Reference dry air density
+REAL, DIMENSION(KLON,1,KLEV), INTENT(IN) :: PEXNREF ! Reference Exner function
+!
+!
+REAL, DIMENSION(KLON,1,KLEV), INTENT(IN) :: PPABSM ! abs. pressure at time t-dt
+REAL, DIMENSION(KLON,1,KLEV), INTENT(IN) :: PW_NU ! w for CCN activation
+REAL, DIMENSION(KLON,1,KLEV), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(KLON,1,KLEV,KRR), INTENT(INOUT):: PRT ! Moist variables at time t
+REAL, DIMENSION(KLON,1,KLEV,KSV), INTENT(INOUT):: PSVT ! LIMA variables at time t
+!
+!
+REAL, DIMENSION(KLON,1,KLEV), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(KLON,1,KLEV,KRR), INTENT(INOUT) :: PRS ! Moist variable sources
+REAL, DIMENSION(KLON,1,KLEV,KSV), INTENT(INOUT) :: PSVS ! LIMA variable sources
+REAL, DIMENSION(KLON,1,KLEV), INTENT(INOUT) :: PEVAP ! Rain evap profile
+!
+!
+
+REAL, DIMENSION(KLON,1), INTENT(INOUT) :: PINPRR! Rain instant precip
+REAL, DIMENSION(KLON,1), INTENT(INOUT) :: PINPRS! Snow instant precip
+REAL, DIMENSION(KLON,1), INTENT(INOUT) :: PINPRG! Graupel instant precip
+REAL, DIMENSION(KLON,1), INTENT(INOUT) :: PINPRH! Hail instant precip
+REAL, DIMENSION(KLON,1,KLEV,KRR), INTENT(INOUT) :: PFPR ! upper-air precip
+!
+TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
+TYPE(TLDDH), INTENT(IN) :: YDLDDH
+TYPE(TMDDH), INTENT(IN) :: YDMDDH
+!
+!
+!* 0.2 Declarations of local variables :
+
+CHARACTER(LEN=4) :: HCLOUD ! kind of cloud
+ ! paramerization
+
+INTEGER :: KMI ! Model index
+
+!
+INTEGER :: JRR, JL ! Loop index for the moist and scalar variables
+!
+!
+!
+REAL, DIMENSION(KLON,1,KLEV):: ZT,ZLV,ZLS,ZCPH
+REAL, DIMENSION(KLON,1,KLEV):: ZCOR,ZDUM3DC,ZDUM3DR,ZDUM3DS,ZDUM3DG,ZDUM3DH
+REAL, DIMENSION(KLON,1,KLEV):: &
+ & ZRAINFR, ZHLC_HCF, ZHLC_LCF, ZHLC_HRC, ZHLC_LRC
+REAL, DIMENSION(KLON,1):: ZINPRC ! surf cloud sedimentation
+ ! for the correction of negative rv
+REAL, DIMENSION(KLON,1):: ZINPRI ! surf cloud ice sedimentation
+REAL :: ZMASSTOT ! total mass for one water category
+ ! including the negative values
+REAL :: ZMASSPOS ! total mass for one water category
+ ! after removing the negative values
+REAL :: ZRATIO ! ZMASSTOT / ZMASSCOR
+
+LOGICAL :: LL_RRR_BUDGET
+!
+!
+!------------------------------------------------------------------------------
+!
+!* 1. PRELIMINARY COMPUTATIONS
+! ------------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('ARO_LIMA',0,ZHOOK_HANDLE)
+
+HCLOUD='LIMA'
+KMI=1
+ZINPRC=0.
+ZDUM3DC=0.
+ZDUM3DR=0.
+ZDUM3DS=0.
+ZDUM3DG=0.
+ZDUM3DH=0.
+PINPRH=0.
+
+
+!
+!* 2. TRANSFORMATION INTO PHYSICAL TENDENCIES
+! ---------------------------------------
+!
+!
+! complete the vertical boundaries
+!
+!
+! personal comment: tranfering these variables to the
+! microphysical routines would save
+! computing time
+!
+ZT(:,:,:)= PTHT(:,:,:)*PEXNREF(:,:,:)
+ZLV(:,:,:)=XLVTT +(XCPV-XCL) *(ZT(:,:,:)-XTT)
+ZLS(:,:,:)=XLSTT +(XCPV-XCI) *(ZT(:,:,:)-XTT)
+ZCPH(:,:,:)=XCPD +XCPV*2.*PTSTEP*PRS(:,:,:,1)
+!
+
+!
+!* 3. REMOVE NEGATIVE VALUES
+! ----------------------
+!
+!* 3.1 Non local correction for 1-moment precipitating species (Rood 87)
+!
+DO JRR = 3,KRR
+ SELECT CASE (JRR)
+ CASE(5,6,7) ! snow, graupel and hail
+ WHERE (PRS(:,:,:,JRR) < 1.E-15 )
+ PRS(:,:,:,JRR) = 0.
+ END WHERE
+ END SELECT
+END DO
+
+!
+!* 3.2 Correct negative values
+!
+! Correction where rc<0
+ IF (LWARM_LIMA) THEN
+ WHERE (PRS(:,:,:,2) < 1.E-15 .OR. PSVS(:,:,:,NSV_LIMA_NC) < 1.E-15)
+ PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,2)
+ PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,2) * ZLV(:,:,:) / &
+ ZCPH(:,:,:) / PEXNREF(:,:,:)
+ PRS(:,:,:,2) = 0.0
+ PSVS(:,:,:,NSV_LIMA_NC) = 0.0
+ END WHERE
+ END IF
+! Correction where rr<0
+ IF (LWARM_LIMA .AND. LRAIN_LIMA) THEN
+ WHERE (PRS(:,:,:,3) < 1.E-15 .OR. PSVS(:,:,:,NSV_LIMA_NR) < 1.E-15)
+ PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,3)
+ PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,3) * ZLV(:,:,:) / &
+ ZCPH(:,:,:) / PEXNREF(:,:,:)
+ PRS(:,:,:,3) = 0.0
+ PSVS(:,:,:,NSV_LIMA_NR) = 0.0
+ END WHERE
+ END IF
+! Correction of IFN concentrations where ri<0 or Ni<0
+! IF (LCOLD_LIMA) THEN
+! DO JMOD = 1, NMOD_IFN
+! WHERE (PRS(:,:,:,4) < 0. .OR. PSVS(:,:,:,NSV_LIMA_NI) < 0.) ! ri or Ni < 0.
+! PSVS(:,:,:,NSV_LIMA_IFN_FREE+JMOD-1) = &
+! PSVS(:,:,:,NSV_LIMA_IFN_FREE+JMOD-1) + &
+! PSVS(:,:,:,NSV_LIMA_IFN_NUCL+JMOD-1) ! N_IF =N_IF+N_IN
+! PSVS(:,:,:,NSV_LIMA_IFN_NUCL+JMOD-1) = 0.0 ! N_IN =0.
+! END WHERE
+! ENDDO
+! END IF
+! Correction where ri<0
+ IF (LCOLD_LIMA) THEN
+ WHERE (PRS(:,:,:,4) < 1.E-15 .OR. PSVS(:,:,:,NSV_LIMA_NI) < 1.E-15)
+ PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,4)
+ PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,4) * ZLS(:,:,:) / &
+ ZCPH(:,:,:) / PEXNREF(:,:,:)
+ PRS(:,:,:,4) = 0.0
+ PSVS(:,:,:,NSV_LIMA_NI) = 0.0
+ END WHERE
+ END IF
+!
+ PSVS(:,:,:,:) = MAX( 0.0,PSVS(:,:,:,:) )
+!
+!
+!* 3.3 STORE THE BUDGET TERMS
+! ----------------------
+
+LL_RRR_BUDGET = (LBUDGET_RV).OR.(LBUDGET_RC).OR.(LBUDGET_RR).OR.(LBUDGET_RI) &
+ & .OR.(LBUDGET_RS).OR.(LBUDGET_RG).OR.(LBUDGET_RH)
+
+IF (LL_RRR_BUDGET) THEN
+ DO JRR=1,KRR
+ CALL BUDGET_DDH (PRS(:,:,:,JRR) * PRHODJ(:,:,:), JRR+5,'NEGA_BU_RRR',YDDDH,YDLDDH, YDMDDH)
+ END DO
+END IF
+IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:) * PRHODJ(:,:,:),4,'NEGA_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_SV) THEN
+ CALL BUDGET_DDH (PSVS(:,:,:,NSV_LIMA_NC)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'NEGA_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PSVS(:,:,:,NSV_LIMA_NR)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'NEGA_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PSVS(:,:,:,NSV_LIMA_NI)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'NEGA_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ IF (NMOD_CCN.GE.1) THEN
+ DO JL=1, NMOD_CCN
+ CALL BUDGET_DDH ( PSVS(:,:,:,NSV_LIMA_CCN_FREE+JL-1)* &
+ PRHODJ(:,:,:),12+NSV_LIMA_CCN_FREE+JL-1,'NEGA_BU_RSV',YDDDH,YDLDDH, YDMDDH)
+ END DO
+ END IF
+ IF (NMOD_IFN.GE.1) THEN
+ DO JL=1, NMOD_IFN
+ CALL BUDGET_DDH ( PSVS(:,:,:,NSV_LIMA_IFN_FREE+JL-1)* &
+ PRHODJ(:,:,:),12+NSV_LIMA_IFN_FREE+JL-1,'NEGA_BU_RSV',YDDDH,YDLDDH, YDMDDH)
+ END DO
+ END IF
+END IF
+
+
+!
+!
+!-------------------------------------------------------------------------------
+!
+
+!* 9. MIXED-PHASE MICROPHYSICAL SCHEME (WITH 3 ICE SPECIES)
+! -----------------------------------------------------
+!
+!* Compute the explicit microphysical sources
+!
+!
+!
+IF (LPTSPLIT) THEN
+ CALL LIMA (PTSTEP=2*PTSTEP, HFMFILE='DUMMY', OCLOSE_OUT=.FALSE., &
+ PRHODREF=PRHODREF, PEXNREF=PEXNREF, PZZ=PDZZ, &
+ PRHODJ=PRHODJ, PPABST=PPABSM, &
+ NCCN=NMOD_CCN, NIFN=NMOD_IFN, NIMM=NMOD_IMM, &
+ PTHM=PTHT, PTHT=PTHT, PRT=PRT, PSVT=PSVT, PW_NU=PW_NU, &
+ PTHS=PTHS, PRS=PRS, PSVS=PSVS, &
+ PINPRC=ZINPRC, PINPRR=PINPRR, PINPRI=ZINPRI, PINPRS=PINPRS, PINPRG=PINPRG, PINPRH=PINPRH, &
+ PEVAP3D=PEVAP, KSPLITR=KSPLITR, KSPLITG=KSPLITG, YDDDH=YDDDH, YDLDDH=YDLDDH, YDMDDH=YDMDDH )
+ELSE
+ IF (LWARM_LIMA) CALL LIMA_WARM(OACTIT=LACTIT_LIMA, OSEDC=LSEDC_LIMA, ORAIN=LRAIN_LIMA, KSPLITR=KSPLITR, PTSTEP=2*PTSTEP, KMI=KMI, &
+ HFMFILE='DUMMY', HLUOUT='DUMMY', OCLOSE_OUT=.FALSE., KRR=KRR, PZZ=PDZZ, PRHODJ=PRHODJ, &
+ PRHODREF=PRHODREF, PEXNREF=PEXNREF, PW_NU=PW_NU, PPABSM=PPABSM, PPABST=PPABSM, &
+ PTHM=PTHT, PRCM=PRT(:,:,:,2), &
+ PTHT=PTHT, PRT=PRT, PSVT=PSVT, &
+ PTHS=PTHS, PRS=PRS, PSVS=PSVS, &
+ PINPRC=ZINPRC,PINPRR=PINPRR, PINPRR3D=ZDUM3DR, PEVAP3D=PEVAP,YDDDH=YDDDH, YDLDDH=YDLDDH, YDMDDH=YDMDDH )
+ !
+ IF (LCOLD_LIMA) CALL LIMA_COLD(OSEDI=LSEDI_LIMA, OHHONI=LHHONI_LIMA, KSPLITG=KSPLITG, PTSTEP=2*PTSTEP, KMI=KMI, &
+ HFMFILE='DUMMY', HLUOUT='DUMMY', OCLOSE_OUT=.FALSE., KRR=KRR, PZZ=PDZZ, PRHODJ=PRHODJ, &
+ PRHODREF=PRHODREF, PEXNREF=PEXNREF, PPABST=PPABSM, PW_NU=PW_NU, &
+ PTHM=PTHT, PPABSM=PPABSM, &
+ PTHT=PTHT, PRT=PRT, PSVT=PSVT, &
+ PTHS=PTHS, PRS=PRS, PSVS=PSVS, &
+ PINPRS=PINPRS, PINPRG=PINPRG, PINPRH=PINPRH, YDDDH=YDDDH, YDLDDH=YDLDDH, YDMDDH=YDMDDH)
+ !
+ IF (LWARM_LIMA .AND. LCOLD_LIMA) CALL LIMA_MIXED(OSEDI=LSEDI_LIMA, OHHONI=LHHONI_LIMA, KSPLITG=KSPLITG, PTSTEP=2*PTSTEP, KMI=KMI, &
+ HFMFILE='DUMMY', HLUOUT='DUMMY', OCLOSE_OUT=.FALSE., KRR=KRR, PZZ=PDZZ, PRHODJ=PRHODJ, &
+ PRHODREF=PRHODREF, PEXNREF=PEXNREF, PPABST=PPABSM, PW_NU=PW_NU, &
+ PTHM=PTHT, PPABSM=PPABSM, &
+ PTHT=PTHT, PRT=PRT, PSVT=PSVT, &
+ PTHS=PTHS, PRS=PRS, PSVS=PSVS,YDDDH=YDDDH, YDLDDH=YDLDDH, YDMDDH=YDMDDH )
+
+ENDIF
+!add ZINPRC in PINPRR
+PINPRR=PINPRR+ZINPRC
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('ARO_LIMA',1,ZHOOK_HANDLE)
+END SUBROUTINE ARO_LIMA
diff --git a/src/arome/modset_Ryad/mpa/micro/externals/aro_rain_ice.F90 b/src/arome/ext/aro_rain_ice.F90
similarity index 86%
rename from src/arome/modset_Ryad/mpa/micro/externals/aro_rain_ice.F90
rename to src/arome/ext/aro_rain_ice.F90
index f47df9e0098c24df162fb15675495f75eaffa879..009de4a99e54c0888c2308aa7b623b7e83640cf0 100644
--- a/src/arome/modset_Ryad/mpa/micro/externals/aro_rain_ice.F90
+++ b/src/arome/ext/aro_rain_ice.F90
@@ -1,9 +1,9 @@
! ######spl
SUBROUTINE ARO_RAIN_ICE(KPROMA,KKA,KKU,KKL,KLON,KLEV, KRR, KTCOUNT, KSPLITR,&
KEZDIAG, &
- OSUBG_COND, CSUBG_AUCV_RC,OSEDIC, CSEDIM, CMICRO, &
+ OSUBG_COND, CSUBG_AUCV_RC, CSUBG_AUCV_RI,OSEDIC, CSEDIM, CMICRO, &
PTSTEP, PDZZ, PRHODJ, PRHODREF, PEXNREF,&
- PPABSM, PTHT, PRT, PSIGS,PCLDFR, &
+ PPABSM, PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, PTHT, PRT, PSIGS,PCLDFR, &
PTHS, PRS, PEVAP, &
PCIT, OWARM, PSEA, PTOWN, &
OCND2,LGRSN, &
@@ -91,8 +91,9 @@ USE MODD_PARAMETERS
USE MODD_RAIN_ICE_DESCR
USE MODD_SPP_TYPE
!
-USE MODD_BUDGET
-USE MODI_BUDGET
+USE MODD_BUDGET, ONLY: LBUDGET_RV, LBUDGET_RC, LBUDGET_RR, LBUDGET_RI, LBUDGET_RS, &
+ & LBUDGET_RG, LBUDGET_RH, LBUDGET_TH, TBUDGETDATA, NBUDGET_RH
+USE MODI_BUDGET_DDH
!
USE MODI_RAIN_ICE
!
@@ -125,6 +126,8 @@ INTEGER, INTENT(IN) :: KEZDIAG ! Size of diagnostics array
LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid Cond.
CHARACTER (LEN=4), INTENT(IN) :: CSUBG_AUCV_RC
! type of subgrid rc->rr autoconvertion scheme
+CHARACTER (LEN=80), INTENT(IN) :: CSUBG_AUCV_RI
+ ! type of subgrid ri->rs autoconvertion scheme
LOGICAL, INTENT(IN) :: OSEDIC ! Switch for cloud sedim.
CHARACTER (LEN=4), INTENT(IN) :: CSEDIM ! Sedimentation scheme
! (STAT or EULE)
@@ -139,6 +142,10 @@ REAL, DIMENSION(KLON,1,KLEV), INTENT(IN) :: PEXNREF ! Reference Exner functi
!
!
REAL, DIMENSION(KLON,1,KLEV), INTENT(IN) :: PPABSM ! abs. pressure at time t-dt
+REAL, DIMENSION(KLON,1,KLEV), INTENT(IN) :: PHLC_HRC
+REAL, DIMENSION(KLON,1,KLEV), INTENT(IN) :: PHLC_HCF
+REAL, DIMENSION(KLON,1,KLEV), INTENT(IN) :: PHLI_HRI
+REAL, DIMENSION(KLON,1,KLEV), INTENT(IN) :: PHLI_HCF
REAL, DIMENSION(KLON,1,KLEV), INTENT(IN) :: PTHT ! Theta at time t
REAL, DIMENSION(KLON,1,KLEV,KRR), INTENT(INOUT):: PRT ! Moist variables at time t
REAL, DIMENSION(KLON,1,KLEV), INTENT(IN) :: PSIGS ! Sigma_s at time t
@@ -168,9 +175,9 @@ REAL, DIMENSION(KLON,1,KLEV,KRR), INTENT(INOUT) :: PFPR ! upper-air precip
REAL, DIMENSION(KLON,YSPP%N2D), TARGET, INTENT(INOUT) :: PGP2DSPP
REAL, DIMENSION(KLON,KLEV,KEZDIAG), INTENT(INOUT) :: PEZDIAG
!
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
+TYPE(TYP_DDH), INTENT(INOUT), TARGET :: YDDDH
+TYPE(TLDDH), INTENT(IN), TARGET :: YDLDDH
+TYPE(TMDDH), INTENT(IN), TARGET :: YDMDDH
!
!
!* 0.2 Declarations of local variables :
@@ -180,6 +187,8 @@ INTEGER :: JRR ! Loop index for the moist and scalar variables
!
REAL, DIMENSION(KLON,1,KLEV):: ZT,ZLV,ZLS,ZCPH
REAL, DIMENSION(KLON,1,KLEV):: ZCOR
+REAL, DIMENSION(KLON,1):: ZINDEP ! surf cloud deposition (already contained in sedimentation)
+REAL, DIMENSION(KLON,1,KLEV):: ZRAINFR
REAL, DIMENSION(KLON,1):: ZINPRC ! surf cloud sedimentation
! for the correction of negative rv
REAL :: ZMASSTOT ! total mass for one water category
@@ -191,6 +200,8 @@ REAL :: ZRATIO ! ZMASSTOT / ZMASSCOR
TYPE(TSPP_CONFIG_MPA) :: YSPP_ICENU,YSPP_KGN_ACON,YSPP_KGN_SBGR
LOGICAL, DIMENSION(KLON, 1, KLEV) :: LLMICRO !mask to limit computation
+
+TYPE(TBUDGETDATA), DIMENSION(NBUDGET_RH) :: YLBUDGET !NBUDGET_RH is the one with the highest number
!
INTEGER :: IPROMA, ISIZE, IGPBLKS ! cache-blocking management
!
@@ -366,15 +377,21 @@ END SELECT
!
!* 3.3 STORE THE BUDGET TERMS
! ----------------------
-IF (LBUDGET_RV) CALL BUDGET (PRS(:,:,:,1) * PRHODJ(:,:,:), 6,'NEGA_BU_RRV',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_RC) CALL BUDGET (PRS(:,:,:,2) * PRHODJ(:,:,:), 7,'NEGA_BU_RRC',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_RR) CALL BUDGET (PRS(:,:,:,3) * PRHODJ(:,:,:), 8,'NEGA_BU_RRR',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_RI) CALL BUDGET (PRS(:,:,:,4) * PRHODJ(:,:,:) ,9,'NEGA_BU_RRI',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_RS) CALL BUDGET (PRS(:,:,:,5) * PRHODJ(:,:,:),10,'NEGA_BU_RRS',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_RG) CALL BUDGET (PRS(:,:,:,6) * PRHODJ(:,:,:),11,'NEGA_BU_RRG',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_RH) CALL BUDGET (PRS(:,:,:,7) * PRHODJ(:,:,:),12,'NEGA_BU_RRH',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:) * PRHODJ(:,:,:), 4,'NEGA_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_RV) CALL BUDGET_DDH (PRS(:,:,:,1) * PRHODJ(:,:,:), 6,'NEGA_BU_RRV',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_RC) CALL BUDGET_DDH (PRS(:,:,:,2) * PRHODJ(:,:,:), 7,'NEGA_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_RR) CALL BUDGET_DDH (PRS(:,:,:,3) * PRHODJ(:,:,:), 8,'NEGA_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_RI) CALL BUDGET_DDH (PRS(:,:,:,4) * PRHODJ(:,:,:) ,9,'NEGA_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_RS) CALL BUDGET_DDH (PRS(:,:,:,5) * PRHODJ(:,:,:),10,'NEGA_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_RG) CALL BUDGET_DDH (PRS(:,:,:,6) * PRHODJ(:,:,:),11,'NEGA_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_RH .AND. KRR==7) CALL BUDGET_DDH (PRS(:,:,:,7) * PRHODJ(:,:,:),12,'NEGA_BU_RRH',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:) * PRHODJ(:,:,:), 4,'NEGA_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+DO JRR=1, NBUDGET_RH
+ YLBUDGET(JRR)%NBUDGET=JRR
+ YLBUDGET(JRR)%YDDDH=>YDDDH
+ YLBUDGET(JRR)%YDLDDH=>YDLDDH
+ YLBUDGET(JRR)%YDMDDH=>YDMDDH
+ENDDO
!
!
!-------------------------------------------------------------------------------
@@ -399,12 +416,15 @@ ELSE
ENDIF
IF (CMICRO=='ICE4') THEN
CALL RAIN_ICE( IPROMA, KLON, 1, KLEV, ISIZE, &
- & OSEDIC=OSEDIC, OCND2=OCND2, HSEDIM=CSEDIM, HSUBG_AUCV_RC=CSUBG_AUCV_RC,&
+ & OSEDIC=OSEDIC, OCND2=OCND2, HSEDIM=CSEDIM, &
+ & HSUBG_AUCV_RC=CSUBG_AUCV_RC, HSUBG_AUCV_RI=CSUBG_AUCV_RI,&
& OWARM=OWARM,KKA=KKA,KKU=KKU,KKL=KKL, &
& PTSTEP=2*PTSTEP, &
& KRR=KRR, LDMICRO=LLMICRO, PEXN=PEXNREF, &
& PDZZ=PDZZ, PRHODJ=PRHODJ, PRHODREF=PRHODREF, PEXNREF=PEXNREF,&
& PPABST=PPABSM, PCIT=PCIT, PCLDFR=PCLDFR, &
+ & PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
+ & PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF, &
& PTHT=PTHT,PRVT= PRT(:,:,:,1),PRCT= PRT(:,:,:,2), &
& PRRT=PRT(:,:,:,3), &
& PRIT=PRT(:,:,:,4), PRST=PRT(:,:,:,5), &
@@ -413,18 +433,21 @@ IF (CMICRO=='ICE4') THEN
& PRRS=PRS(:,:,:,3),&
& PRIS=PRS(:,:,:,4),PRSS= PRS(:,:,:,5),PRGS= PRS(:,:,:,6),&
& PINPRC=ZINPRC,PINPRR=PINPRR,PEVAP3D=PEVAP,&
- & PINPRS=PINPRS, PINPRG=PINPRG, &
+ & PINPRS=PINPRS, PINPRG=PINPRG, PINDEP=ZINDEP, PRAINFR=ZRAINFR, &
& PSIGS=PSIGS, PSEA=PSEA, PTOWN=PTOWN, PRHT=PRT(:,:,:,7),&
& PRHS=PRS(:,:,:,7), PINPRH=PINPRH, PFPR=PFPR, &
- & YDDDH=YDDDH, YDLDDH=YDLDDH, YDMDDH=YDMDDH)
+ & TBUDGETS=YLBUDGET, KBUDGETS=SIZE(YLBUDGET))
ELSEIF (CMICRO=='ICE3') THEN
CALL RAIN_ICE( IPROMA, KLON, 1, KLEV, ISIZE, &
- & OSEDIC=OSEDIC, OCND2=OCND2, HSEDIM=CSEDIM, HSUBG_AUCV_RC=CSUBG_AUCV_RC, &
+ & OSEDIC=OSEDIC, OCND2=OCND2, HSEDIM=CSEDIM, &
+ & HSUBG_AUCV_RC=CSUBG_AUCV_RC, HSUBG_AUCV_RI=CSUBG_AUCV_RI,&
& OWARM=OWARM,KKA=KKA,KKU=KKU,KKL=KKL, &
& PTSTEP=2*PTSTEP, &
& KRR=KRR, LDMICRO=LLMICRO, PEXN=PEXNREF, &
& PDZZ=PDZZ, PRHODJ=PRHODJ, PRHODREF=PRHODREF,PEXNREF=PEXNREF,&
& PPABST=PPABSM, PCIT=PCIT, PCLDFR=PCLDFR, &
+ & PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
+ & PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF, &
& PTHT=PTHT,PRVT=PRT(:,:,:,1),PRCT=PRT(:,:,:,2), &
& PRRT=PRT(:,:,:,3), &
& PRIT=PRT(:,:,:,4), PRST=PRT(:,:,:,5), &
@@ -433,9 +456,9 @@ ELSEIF (CMICRO=='ICE3') THEN
& PRRS=PRS(:,:,:,3),&
& PRIS=PRS(:,:,:,4),PRSS= PRS(:,:,:,5),PRGS= PRS(:,:,:,6),&
& PINPRC=ZINPRC,PINPRR=PINPRR,PEVAP3D=PEVAP,&
- & PINPRS=PINPRS, PINPRG=PINPRG, &
+ & PINPRS=PINPRS, PINPRG=PINPRG, PINDEP=ZINDEP, PRAINFR=ZRAINFR, &
& PSIGS=PSIGS, PSEA=PSEA, PTOWN=PTOWN, PFPR=PFPR, &
- & YDDDH=YDDDH, YDLDDH=YDLDDH, YDMDDH=YDMDDH)
+ & TBUDGETS=YLBUDGET, KBUDGETS=SIZE(YLBUDGET))
ELSEIF (CMICRO=='OLD4') THEN
CALL RAIN_ICE_OLD( OSEDIC=OSEDIC, OCND2=OCND2, LGRSN=LGRSN, HSEDIM=CSEDIM, HSUBG_AUCV_RC=CSUBG_AUCV_RC,&
& OWARM=OWARM,KKA=KKA,KKU=KKU,KKL=KKL,KSPLITR=KSPLITR, &
diff --git a/src/arome/modset_Ryad/mpa/micro/interface/aro_rain_ice.h b/src/arome/ext/aro_rain_ice.h
similarity index 86%
rename from src/arome/modset_Ryad/mpa/micro/interface/aro_rain_ice.h
rename to src/arome/ext/aro_rain_ice.h
index 85dd58705cccaffe53894af222bb3b6631317acb..825705af01df59841ec6b148606cc092b1d09303 100644
--- a/src/arome/modset_Ryad/mpa/micro/interface/aro_rain_ice.h
+++ b/src/arome/ext/aro_rain_ice.h
@@ -1,9 +1,9 @@
INTERFACE
SUBROUTINE ARO_RAIN_ICE(KPROMA,KKA,KKU,KKL,KLON,KLEV, KRR, KTCOUNT, KSPLITR,&
& KEZDIAG, &
- & OSUBG_COND, CSUBG_AUCV_RC,OSEDIC,CSEDIM,CMICRO,&
+ & OSUBG_COND, CSUBG_AUCV_RC, CSUBG_AUCV_RI, OSEDIC,CSEDIM,CMICRO,&
& PTSTEP, PDZZ, PRHODJ, PRHODREF, PEXNREF,&
- & PPABSM, PTHT, PRT, PSIGS,PCLDFR,&
+ & PPABSM, PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, PTHT, PRT, PSIGS,PCLDFR,&
& PTHS, PRS, PEVAP,&
& PCIT, OWARM, PSEA, PTOWN, &
& OCND2, LGRSN, &
@@ -28,6 +28,7 @@ INTEGER(KIND=JPIM), INTENT(IN) :: KSPLITR
INTEGER(KIND=JPIM), INTENT(IN) :: KEZDIAG
LOGICAL, INTENT(IN) :: OSUBG_COND
CHARACTER(LEN=4), INTENT(IN) :: CSUBG_AUCV_RC
+CHARACTER(LEN=80), INTENT(IN) :: CSUBG_AUCV_RI
LOGICAL, INTENT(IN) :: OSEDIC
CHARACTER(LEN=4), INTENT(IN) :: CSEDIM
CHARACTER(LEN=4), INTENT(IN) :: CMICRO
@@ -37,6 +38,10 @@ REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(IN) :: PRHODJ
REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(IN) :: PRHODREF
REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(IN) :: PEXNREF
REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(IN) :: PPABSM
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(IN) :: PHLC_HRC
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(IN) :: PHLC_HCF
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(IN) :: PHLI_HRI
+REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(IN) :: PHLI_HCF
REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(IN) :: PTHT
REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV,KRR), INTENT(INOUT):: PRT
REAL(KIND=JPRB), DIMENSION(KLON,1,KLEV), INTENT(IN) :: PSIGS
diff --git a/src/arome/ext/aro_startbu.F90 b/src/arome/ext/aro_startbu.F90
new file mode 100644
index 0000000000000000000000000000000000000000..f3dd9f9dcd4e2e4e6e34403560d24d6579be9af6
--- /dev/null
+++ b/src/arome/ext/aro_startbu.F90
@@ -0,0 +1,107 @@
+! ######spl
+SUBROUTINE ARO_STARTBU( KIDIA, KFDIA, KLEV, KRR,KSV,PRHODJ,&
+ & PRUS,PRVS,PRWS,PRTHS,PRRS,PRTKES,YDDDH, YDLDDH, YDMDDH)
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+
+! Purpose.
+! --------
+! Prepare budget arrays at the start of budget calculations.
+
+!** Interface.
+! ----------
+! *CALL* *AROINI_BUDGET
+
+! Explicit arguments :
+! --------------------
+! None
+
+! Implicit arguments :
+! --------------------
+! None
+
+! Method.
+! -------
+
+! Externals.
+! ----------
+
+! Reference.
+! ----------
+!
+! Author.
+! -------
+! T. Kovacic
+
+! Modifications.
+! --------------
+! Original : 05-05-06
+! 19-Sept-08: O.Riviere Removal of unecessary part for new diagnostic data flow
+! 30-Janv-19: F.Voitus new DDH superstructure + RR budget correction
+! ------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_BUDGET
+USE MODI_BUDGET_DDH
+USE DDH_MIX , ONLY : TYP_DDH
+USE YOMLDDH , ONLY : TLDDH
+USE YOMMDDH , ONLY : TMDDH
+
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of argument
+!
+INTEGER, INTENT(IN) :: KIDIA
+INTEGER, INTENT(IN) :: KFDIA
+INTEGER, INTENT(IN) :: KLEV
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
+!
+REAL, DIMENSION(KFDIA,1,KLEV), INTENT(IN) :: PRHODJ ! (Rho) dry * Jacobian
+!
+REAL, DIMENSION(KFDIA,1,KLEV), INTENT(IN) :: PRUS, PRVS, PRWS ! Source
+REAL, DIMENSION(KFDIA,1,KLEV), INTENT(IN) :: PRTHS, PRTKES ! -
+REAL, DIMENSION(KFDIA,1,KLEV,KRR), INTENT(IN) :: PRRS ! terms
+
+TYPE(TYP_DDH) , INTENT(INOUT) :: YDDDH
+TYPE(TLDDH) , INTENT(IN) :: YDLDDH
+TYPE(TMDDH) , INTENT(IN) :: YDMDDH
+
+!
+!
+!* 0.2 Declarations of local variables :
+!
+
+LOGICAL :: LL_BUDGET_RR
+INTEGER :: JR
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+
+
+
+ LL_BUDGET_RR = (LBUDGET_RV).OR.(LBUDGET_RC).OR.(LBUDGET_RR) &
+ & .OR.(LBUDGET_RI).OR.(LBUDGET_RS) &
+ & .OR.(LBUDGET_RG).OR.(LBUDGET_RH)
+
+!
+ IF (LHOOK) CALL DR_HOOK('ARO_STARTBU',0,ZHOOK_HANDLE)
+
+ IF (LBUDGET_U) CALL BUDGET_DDH (PRUS(:,:,:)*PRHODJ(:,:,:),1,'INIF_BU_RU',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_V) CALL BUDGET_DDH (PRVS(:,:,:)*PRHODJ(:,:,:),2,'INIF_BU_RV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_W) CALL BUDGET_DDH (PRWS(:,:,:)*PRHODJ(:,:,:),3,'INIF_BU_RW',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PRTHS(:,:,:)*PRHODJ(:,:,:),4,'INIF_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TKE) CALL BUDGET_DDH (PRTKES(:,:,:)*PRHODJ(:,:,:),5,'INIF_BU_RTKE',YDDDH, YDLDDH, YDMDDH)
+
+ IF (LL_BUDGET_RR) THEN
+ DO JR = 1,KRR
+ CALL BUDGET_DDH (PRRS(:,:,:,JR)*PRHODJ(:,:,:),5+JR,'INIF_BU_RR',YDDDH, YDLDDH, YDMDDH)
+ END DO
+ END IF
+
+
+!
+IF (LHOOK) CALL DR_HOOK('ARO_STARTBU',1,ZHOOK_HANDLE)
+END SUBROUTINE ARO_STARTBU
diff --git a/src/arome/ext/aro_turb_mnh.F90 b/src/arome/ext/aro_turb_mnh.F90
new file mode 100644
index 0000000000000000000000000000000000000000..caee9cfa67fc6e614a16aedfdc3e32158d782230
--- /dev/null
+++ b/src/arome/ext/aro_turb_mnh.F90
@@ -0,0 +1,491 @@
+! ######spl
+ SUBROUTINE ARO_TURB_MNH( KKA,KKU,KKL,KLON,KLEV,KRR,KRRL,KRRI,KSV, &
+ KTCOUNT, KGRADIENTS, LDHARATU, PTSTEP, &
+ PZZ, PZZF, PZZTOP, &
+ PRHODJ, PTHVREF,PRHODREF,HINST_SFU,HMF_UPDRAFT, &
+ PSFTH,PSFRV,PSFSV,PSFU,PSFV, &
+ PPABSM,PUM,PVM,PWM,PTKEM,PEPSM,PSVM,PSRCM, &
+ PTHM,PRM, &
+ PRUS,PRVS,PRWS,PRTHS,PRRS,PRSVSIN,PRSVS,PRTKES,PRTKES_OUT,PREPSS, &
+ ZHGRAD,PSIGS,OSUBG_COND, &
+ PFLXZTHVMF,PLENGTHM,PLENGTHH,MFMOIST, &
+ PDRUS_TURB,PDRVS_TURB, &
+ PDRTHLS_TURB,PDRRTS_TURB,PDRSVS_TURB, &
+ PDP,PTP,PTPMF,PTDIFF,PTDISS,PEDR,YDDDH,YDLDDH,YDMDDH)
+
+
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+! ##########################################################################
+!
+!!**** * - compute the turbulence sources and the TKE evolution for Arome
+!!
+!!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the turbulence sources
+!! and the TKE evolution for the Arome model
+!!
+!!
+!!** METHOD
+!! ------
+!! This routine calls the mesoNH turbulence scheme
+!! in its 1DIM configutation.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! Subroutine TURB (routine de MesoNH)
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS : contains declarations of parameter variables
+!! JPHEXT : Horizontal external points number
+!! JPVEXT_TURB : Vertical external points number
+!! Module MODD_CST
+!! XP00 ! Reference pressure
+!! XRD ! Gaz constant for dry air
+!! XCPD ! Cpd (dry air)
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Documentation AROME
+!!
+!! AUTHOR
+!! ------
+!! S.Malardel and Y.Seity
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 10/03/03
+!! 2012-02 Y. Seity, add possibility to run with reversed vertical levels
+!! 2015-07 Wim de Rooy possibility to run with LHARATU=TRUE (Racmo turbulence scheme)
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CONF
+USE MODD_CST
+USE MODD_PARAMETERS
+
+!
+USE MODI_TURB
+!
+USE DDH_MIX, ONLY : TYP_DDH
+USE YOMLDDH, ONLY : TLDDH
+USE YOMMDDH, ONLY : TMDDH
+
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+!
+INTEGER, INTENT(IN) :: KLON !KFDIA under CPG
+INTEGER, INTENT(IN) :: KLEV !Number of vertical levels
+INTEGER, INTENT(IN) :: KKA !Index of point near ground
+INTEGER, INTENT(IN) :: KKU !Index of point near top
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KRRL ! Number of liquide water variables
+INTEGER, INTENT(IN) :: KRRI ! Number of ice variables
+INTEGER, INTENT(IN) :: KSV ! Number of passive scalar
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
+INTEGER, INTENT(IN) :: KGRADIENTS ! Number of stored horizontal gradients
+LOGICAL, INTENT(IN) :: LDHARATU ! HARATU scheme active
+
+CHARACTER (LEN=4), INTENT(IN) :: HMF_UPDRAFT ! Type of mass flux scheme
+REAL, INTENT(IN) :: PTSTEP ! Time step
+!
+!
+REAL, DIMENSION(KLON,1,KLEV), INTENT(IN) :: PZZ ! Height of layer boundaries
+REAL, DIMENSION(KLON,1,KLEV), INTENT(IN) :: PZZF ! Height of level
+REAL, DIMENSION(KLON), INTENT(IN) :: PZZTOP ! Height of highest level
+
+REAL, DIMENSION(KLON,1,KLEV+2), INTENT(INOUT) :: PRHODJ !Dry density * Jacobian
+! MFMOIST used in case LHARATU=TRUE
+REAL, DIMENSION(KLON,1,KLEV+2), INTENT(INOUT) :: MFMOIST !Moist mass flux from Dual scheme
+REAL, DIMENSION(KLON,1,KLEV+2), INTENT(INOUT) :: PTHVREF ! Virtual Potential
+ ! Temperature of the reference state
+REAL, DIMENSION(KLON,1,KLEV+2), INTENT(INOUT) :: PRHODREF ! dry density of the
+ ! reference state
+CHARACTER(LEN=1) , INTENT(IN) :: HINST_SFU ! temporal location of the
+ ! surface friction flux
+!
+REAL, DIMENSION(KLON,1), INTENT(INOUT) :: PSFTH,PSFRV
+! normal surface fluxes of theta and Rv
+REAL, DIMENSION(KLON,1), INTENT(INOUT) :: PSFU,PSFV
+! normal surface fluxes of (u,v) parallel to the orography
+REAL, DIMENSION(KLON,1,KSV), INTENT(INOUT) :: PSFSV
+! normal surface fluxes of Scalar var.
+!
+! prognostic variables at t- deltat
+REAL, DIMENSION(KLON,1,KLEV+2), INTENT(INOUT) :: PPABSM ! Pressure at time t-1
+REAL, DIMENSION(KLON,1,KLEV+2), INTENT(INOUT) :: PUM,PVM,PWM ! wind components
+REAL, DIMENSION(KLON,1,KLEV+2), INTENT(INOUT) :: PTKEM ! TKE
+REAL, DIMENSION(0,0,0), INTENT(INOUT) :: PEPSM ! dissipation of TKE
+REAL, DIMENSION(KLON,1,KLEV,KSV), INTENT(INOUT) :: PSVM ! passive scal. var.
+REAL, DIMENSION(KLON,1,KLEV+2), INTENT(INOUT) :: PSRCM ! Second-order flux
+ ! s'rc'/2Sigma_s2 at time t-1 multiplied by Lambda_3
+!
+! PLENGTHM, PLENGTH used in case LHARATU=true
+REAL, DIMENSION(KLON,1,KLEV+2), INTENT(INOUT) :: PLENGTHM, PLENGTHH ! length scales vdfexcu
+
+!
+! thermodynamical variables which are transformed in conservative var.
+REAL, DIMENSION(KLON,1,KLEV+2), INTENT(INOUT) :: PTHM ! pot. temp.
+REAL, DIMENSION(KLON,1,KLEV,KRR), INTENT(INOUT) :: PRM ! mixing ratio
+!
+! sources of momentum, conservative potential temperature, Turb. Kin. Energy,
+! TKE dissipation
+REAL, DIMENSION(KLON,1,KLEV+2), INTENT(INOUT) :: PRUS,PRVS,PRWS
+REAL, DIMENSION(KLON,1,KLEV+2), INTENT(INOUT) :: PRTHS
+REAL, DIMENSION(KLON,1,KLEV), INTENT(IN) :: PRTKES
+REAL, DIMENSION(KLON,1,KLEV+2), INTENT(OUT) :: PRTKES_OUT
+REAL, DIMENSION(0,0,0) , INTENT(INOUT) ::PREPSS
+! Source terms for all water kinds, PRRS(:,:,:,1) is used for the conservative
+! mixing ratio
+REAL, DIMENSION(KLON,1,KLEV,KRR), INTENT(INOUT) :: PRRS
+! Source terms for all passive scalar variables
+REAL, DIMENSION(KLON,1,KLEV,KSV), INTENT(IN) :: PRSVSIN
+REAL, DIMENSION(KLON,1,KLEV,KSV), INTENT(OUT) :: PRSVS
+! Sigma_s at time t+1 : square root of the variance of the deviation to the
+! saturation
+REAL, DIMENSION(KLON,1,KLEV+2), INTENT(OUT) :: PSIGS
+REAL, DIMENSION(KLON,1,KLEV+2), INTENT(OUT) :: PDRUS_TURB ! evolution of rhoJ*U by turbulence only
+REAL, DIMENSION(KLON,1,KLEV+2), INTENT(OUT) :: PDRVS_TURB ! evolution of rhoJ*V by turbulence only
+REAL, DIMENSION(KLON,1,KLEV+2), INTENT(OUT) :: PDRTHLS_TURB ! evolution of rhoJ*thl by turbulence only
+REAL, DIMENSION(KLON,1,KLEV+2), INTENT(OUT) :: PDRRTS_TURB ! evolution of rhoJ*rt by turbulence only
+REAL, DIMENSION(KLON,1,KLEV,KSV), INTENT(OUT) :: PDRSVS_TURB ! evolution of rhoJ*Sv by turbulence only
+REAL, DIMENSION(KLON,1,KLEV+2), INTENT(INOUT) :: PFLXZTHVMF
+REAL, DIMENSION(KLON,1,KLEV+2), INTENT(OUT) :: PEDR ! EDR
+!
+LOGICAL , INTENT(IN) :: OSUBG_COND ! switch
+! !for SUBGrid CONDensation
+REAL, DIMENSION(KLON,1,KLEV+2), INTENT(OUT) :: PDP, PTP, PTPMF, PTDIFF, PTDISS
+! !for TKE DDH budgets
+!
+TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
+TYPE(TLDDH), INTENT(IN) :: YDLDDH
+TYPE(TMDDH), INTENT(IN) :: YDMDDH
+!
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: JRR,JSV ! Loop index for the moist and scalar variables
+INTEGER :: IIB ! Define the physical domain
+INTEGER :: IIE !
+INTEGER :: IJB !
+INTEGER :: IJE !
+INTEGER :: IKB !
+INTEGER :: IKE !
+INTEGER :: IKTB !
+INTEGER :: IKTE !
+INTEGER :: IKT !
+INTEGER :: JL, JK, JLON
+!
+INTEGER ::II
+!
+!
+INTEGER :: IMI ! model index number
+
+CHARACTER(LEN=4),DIMENSION(2) :: HLBCX, HLBCY ! X- and Y-direc LBC
+
+INTEGER :: ISPLIT ! number of time-splitting
+
+LOGICAL :: OCLOSE_OUT ! Conditional closure of
+ ! the OUTPUT FM-file
+LOGICAL :: OTURB_FLX ! switch to write the
+ ! turbulent fluxes in the syncronous FM-file
+LOGICAL :: OTURB_DIAG ! switch to write some
+ ! diagnostic fields in the syncronous FM-file
+LOGICAL :: ORMC01 ! switch for RMC01 lengths in SBL
+
+CHARACTER(LEN=4) :: HTURBDIM ! dimensionality of the
+ ! turbulence scheme
+CHARACTER(LEN=4) :: HTURBLEN ! kind of mixing length
+
+REAL :: ZIMPL ! degree of implicitness
+
+CHARACTER(LEN=4) :: HFMFILE ! Name of the output
+ ! FM-file
+CHARACTER(LEN=4) :: HLUOUT ! Output-listing name for
+ ! model n
+!
+REAL, DIMENSION(KLON,1,KLEV+2) :: ZDXX,ZDYY,ZDZZ,ZDZX,ZDZY
+ ! metric coefficients
+REAL, POINTER :: ZDIRCOSXW(:,:), ZDIRCOSYW(:,:), ZDIRCOSZW(:,:)
+! Director Cosinus along x, y and z directions at surface w-point
+REAL, POINTER :: ZCOSSLOPE(:,:) ! cosinus of the anglebetween i and the slope vector
+REAL, POINTER :: ZSINSLOPE(:,:) ! sinus of the angle between i and the slope vector
+
+REAL,DIMENSION(KLON,1,KLEV+2) :: ZCEI
+REAL :: ZCEI_MIN,ZCEI_MAX,ZCOEF_AMPL_SAT
+REAL, DIMENSION(KLON,1) :: ZBL_DEPTH, ZSBL_DEPTH
+REAL,DIMENSION(KLON,1,KLEV+2) :: ZWTH ! heat flux
+REAL,DIMENSION(KLON,1,KLEV+2) :: ZWRC ! cloud water flux
+REAL,DIMENSION(KLON,1,KLEV+2,KSV) :: ZWSV,ZSVM,ZRSVS,ZDRSVS_TURB ! scalar flux
+REAL,DIMENSION(KLON,1,KLEV+2) :: ZZZ ! Local value of PZZ
+REAL,DIMENSION(KLON,1,KLEV+2,KRR) :: ZRM,ZRRS
+REAL,DIMENSION(KLON,1,KLEV+2,KGRADIENTS) :: ZHGRAD ! Horizontal Gradients
+!
+REAL, DIMENSION(KLON,1), TARGET :: ZERO, ZONE
+!
+CHARACTER(LEN=4) :: CL
+!------------------------------------------------------------------------------
+!
+!* 1. PRELIMINARY COMPUTATIONS
+! ------------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('ARO_TURB_MNH',0,ZHOOK_HANDLE)
+IIB=1+JPHEXT
+IIE=SIZE(PZZ,1) - JPHEXT
+IJB=1+JPHEXT
+IJE=SIZE(PZZ,2) - JPHEXT
+IKTB=1+JPVEXT_TURB
+IKT=SIZE(PZZ,3)+2*JPVEXT_TURB
+IKTE=IKT - JPVEXT_TURB
+IKB=KKA+JPVEXT_TURB*KKL
+IKE=KKU-JPVEXT_TURB*KKL
+
+!
+!
+!------------------------------------------------------------------------------
+!
+!* 2. INITIALISATION (CAS DU MODELE 1D)
+!
+! ---------------------------------
+! Numero du modele si grid nestind, toujours egal a 1
+IMI=1
+
+! Type de condition � la limite. En 1D, sans importance. A etudier en 3D.
+HLBCX(:)='CYCL'
+HLBCY(:)='CYCL'
+
+! en dur a 1 dans MNH
+ISPLIT=1
+
+! pour ecriture et diagnostic dans mesoNH, � priori les switches toujours � .F.
+OCLOSE_OUT=.FALSE.
+HFMFILE=' '
+HLUOUT= ' '
+OTURB_FLX=.FALSE.
+OTURB_DIAG=.FALSE.
+
+! a mettre en namelist
+ORMC01=.FALSE.
+
+HTURBDIM='1DIM'
+HTURBLEN='BL89'
+
+ZIMPL=1.
+
+
+! tableau a recalculer a chaque pas de temps
+! attention, ZDZZ est l'altitude entre deux niveaux (et pas l'�paisseur de la couche)
+
+!WRITE(20,*)'sous aro_turb_mnh PZZF', PZZF(1,1,58:60)
+!WRITE(20,*)'sous aro_turb_mnh PZZ', PZZ(1,1,58:60)
+
+
+
+ZZZ(IIB:IIE,1,2:KLEV+1)=PZZ(IIB:IIE,1,1:KLEV)
+ZZZ(IIB:IIE,1,1) = PZZTOP(IIB:IIE)
+ZDZZ(IIB:IIE,1,KLEV+2)=-999.
+
+DO JK = 2 , KLEV
+ DO JL = IIB,IIE
+ ZDZZ(JL,1,JK)=PZZF(JL,1,JK-1)-PZZF(JL,1,JK)
+ ENDDO
+ENDDO
+
+DO JL = IIB,IIE
+ ZZZ(JL,1,KLEV+2) = 2*PZZ(JL,1,KLEV)-PZZ(JL,1,KLEV-1)
+ ZDZZ(JL,1,1)=ZZZ(JL,1,KKU)-ZZZ(JL,1,IKE)
+ ZDZZ(JL,1,KLEV+1)=PZZF(JL,1,KLEV)-(1.5*ZZZ(JL,1,KLEV+1)-0.5*ZZZ(JL,1,KLEV))
+ENDDO
+
+! tableaux qui devront etre initialis�s plus en amont dans Aladin s'il
+! n'existent pas d�ja. Dans le cas du 1D, il n'y a pas de relief,
+! ils ont donc des valeurs triviales.
+
+ZERO(:,:) = 0.
+ZONE(:,:) = 1.
+
+ZDIRCOSXW=>ZONE(:,:)
+ZDIRCOSYW=>ZONE(:,:)
+ZDIRCOSZW=>ZONE(:,:)
+ZCOSSLOPE=>ZONE(:,:)
+ZSINSLOPE=>ZERO(:,:)
+
+!------------------------------------------------------------------------------
+!
+!
+!* 4. MULTIPLICATION PAR RHODJ
+! POUR OBTENIR LES TERMES SOURCES DE MESONH
+!
+! -----------------------------------------------
+
+! WRITE (15,*)'PRUS debut AC_TURB_MNH=',PRUS
+! WRITE (15,*)'PRVS debut AC_TURB_MNH=',PRVS
+! WRITE (15,*)'PRWS debut AC_TURB_MNH=',PRWS
+! WRITE (15,*)'PRTHS debut AC_TURB_MNH=',PRTHS
+! WRITE (15,*)'PRRS debut AC_TURB_MNH=',PRRS
+
+DO JK=2,KLEV+1
+ DO JL = 1,KLON
+ PRUS(JL,1,JK) = PRUS(JL,1,JK) *PRHODJ(JL,1,JK)
+ PRVS(JL,1,JK) = PRVS(JL,1,JK) *PRHODJ(JL,1,JK)
+ PRWS(JL,1,JK) = PRWS(JL,1,JK) *PRHODJ(JL,1,JK)
+ PRTHS(JL,1,JK) = PRTHS(JL,1,JK) *PRHODJ(JL,1,JK)
+ PRTKES_OUT(JL,1,JK) = PRTKES(JL,1,JK-1)*PRHODJ(JL,1,JK)
+ ENDDO
+ENDDO
+DO JRR=1,KRR
+ DO JK=2,KLEV+1
+ DO JL = 1,KLON
+ ZRRS(JL,1,JK,JRR) = PRRS(JL,1,JK-1,JRR)*PRHODJ(JL,1,JK)
+ ENDDO
+ ZRM(:,1,JK,JRR) = PRM(:,1,JK-1,JRR)
+ ENDDO
+ ZRRS(:,1,1,JRR )= ZRRS(:,1,2,JRR)
+ ZRRS(:,1,KLEV+2,JRR)= ZRRS(:,1,KLEV+1,JRR)
+ ZRM(:,1,1,JRR )= ZRM(:,1,2,JRR)
+ ZRM(:,1,KLEV+2,JRR)= ZRM(:,1,KLEV+1,JRR)
+ENDDO
+DO JSV=1,KSV
+ DO JK=2,KLEV+1
+ DO JL = 1,KLON
+ ZRSVS(JL,1,JK,JSV) = PRSVSIN(JL,1,JK-1,JSV)*PRHODJ(JL,1,JK)
+ ENDDO
+ ZSVM(:,1,JK,JSV) = PSVM(:,1,JK-1,JSV)
+ ENDDO
+ ZRSVS(:,1,1,JSV )= ZRSVS(:,1,2,JSV)
+ ZRSVS(:,1,KLEV+2,JSV)= ZRSVS(:,1,KLEV+1,JSV)
+ ZSVM(:,1,1,JSV )= ZSVM(:,1,2,JSV)
+ ZSVM(:,1,KLEV+2,JSV)= ZSVM(:,1,KLEV+1,JSV)
+ENDDO
+
+!------------------------------------------------------------------------------
+!
+!* 3. Add 2*JPVEXT_TURB values on the vertical
+!
+!
+CALL VERTICAL_EXTEND(PRHODJ)
+CALL VERTICAL_EXTEND(PTHVREF)
+CALL VERTICAL_EXTEND(PRHODREF)
+CALL VERTICAL_EXTEND(PPABSM)
+CALL VERTICAL_EXTEND(PUM)
+CALL VERTICAL_EXTEND(PVM)
+CALL VERTICAL_EXTEND(PWM)
+CALL VERTICAL_EXTEND(PTKEM)
+PSRCM(:,:,1)=0.
+PSRCM(:,:,KLEV+2)=0.
+CALL VERTICAL_EXTEND(PTHM)
+CALL VERTICAL_EXTEND(PFLXZTHVMF)
+IF (LDHARATU) THEN
+ CALL VERTICAL_EXTEND(PLENGTHM)
+ CALL VERTICAL_EXTEND(PLENGTHH)
+ENDIF
+CALL VERTICAL_EXTEND(MFMOIST)
+CALL VERTICAL_EXTEND(PRUS)
+CALL VERTICAL_EXTEND(PRVS)
+CALL VERTICAL_EXTEND(PRWS)
+CALL VERTICAL_EXTEND(PRTHS)
+CALL VERTICAL_EXTEND(PRTKES_OUT)
+
+!------------------------------------------------------------------------------
+!
+!
+!* 5. APPEL DE LA TURBULENCE MESONH
+!
+! ---------------------------------
+!pour AROME, on n'utilise pas les modifs de Mireille pour la turb au bord des nuages
+ZCEI_MAX=1.0
+ZCEI_MIN=0.0
+ZCEI=0.0
+ZCOEF_AMPL_SAT=0.0
+
+CL=HINST_SFU
+CALL TURB (KLEV+2,1,KKL,IMI, KRR, KRRL, KRRI, HLBCX, HLBCY, ISPLIT,IMI, &
+ & OCLOSE_OUT,OTURB_FLX,OTURB_DIAG,OSUBG_COND,ORMC01, &
+ & HTURBDIM,HTURBLEN,'NONE','NONE', CL, &
+ & HMF_UPDRAFT,ZIMPL, &
+ & 2*PTSTEP, 2*PTSTEP, 2*PTSTEP, &
+ & HFMFILE,HLUOUT,ZDXX,ZDYY,ZDZZ,ZDZX,ZDZY,ZZZ, &
+ & ZDIRCOSXW,ZDIRCOSYW,ZDIRCOSZW,ZCOSSLOPE,ZSINSLOPE, &
+ & PRHODJ,PTHVREF,PRHODREF, &
+ & PSFTH,PSFRV,PSFSV,PSFU,PSFV, &
+ & PPABSM,PUM,PVM,PWM,PTKEM,ZSVM,PSRCM, &
+ & PLENGTHM,PLENGTHH,MFMOIST, &
+ & ZBL_DEPTH,ZSBL_DEPTH, &
+ & PUM,PVM,PWM,ZCEI,ZCEI_MIN,ZCEI_MAX,ZCOEF_AMPL_SAT, &
+ & PTHM,ZRM, &
+ & PRUS,PRVS,PRWS,PRTHS,ZRRS,ZRSVS,PRTKES_OUT, &
+ & ZHGRAD,PSIGS, &
+ & PDRUS_TURB,PDRVS_TURB, &
+ & PDRTHLS_TURB,PDRRTS_TURB,ZDRSVS_TURB, &
+ & PFLXZTHVMF,ZWTH,ZWRC,ZWSV,PDP,PTP,PTPMF,PTDIFF, &
+ & PTDISS,PEDR,YDDDH,YDLDDH,YDMDDH)
+!
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 5. DIVISION PAR RHODJ DES TERMES SOURCES DE MESONH
+! (on obtient des termes homog�nes � des tendances)
+!
+! -----------------------------------------------
+
+DO JK=2,KLEV+1
+ DO JL = 1,KLON
+ PRUS(JL,1,JK) = PRUS(JL,1,JK) /PRHODJ(JL,1,JK)
+ PRVS(JL,1,JK) = PRVS(JL,1,JK) /PRHODJ(JL,1,JK)
+ PRTHS(JL,1,JK) = PRTHS(JL,1,JK) /PRHODJ(JL,1,JK)
+ PRTKES_OUT(JL,1,JK) = PRTKES_OUT(JL,1,JK) /PRHODJ(JL,1,JK)
+ PDRUS_TURB(JL,1,JK) = PDRUS_TURB(JL,1,JK) /PRHODJ(JL,1,JK)
+ PDRVS_TURB(JL,1,JK) = PDRVS_TURB(JL,1,JK) /PRHODJ(JL,1,JK)
+ PDRTHLS_TURB(JL,1,JK) = PDRTHLS_TURB(JL,1,JK) /PRHODJ(JL,1,JK)
+ PDRRTS_TURB(JL,1,JK) = PDRRTS_TURB(JL,1,JK) /PRHODJ(JL,1,JK)
+ ENDDO
+ENDDO
+
+DO JRR=1,KRR
+ DO JK=2,KLEV+1
+ DO JL = 1,KLON
+ PRRS(JL,1,JK-1,JRR) = ZRRS(JL,1,JK,JRR)/PRHODJ(JL,1,JK)
+ ENDDO
+ PRM(:,1,JK-1,JRR) = ZRM(:,1,JK,JRR)
+ ENDDO
+ENDDO
+
+DO JSV=1,KSV
+ DO JK=2,KLEV+1
+ DO JL = 1,KLON
+ PRSVS(JL,1,JK-1,JSV) = ZRSVS(JL,1,JK,JSV)/PRHODJ(JL,1,JK)
+ PDRSVS_TURB(JL,1,JK-1,JSV) = ZDRSVS_TURB(JL,1,JK,JSV)/PRHODJ(JL,1,JK)
+ ENDDO
+ ENDDO
+ENDDO
+
+IF (LHOOK) CALL DR_HOOK('ARO_TURB_MNH',1,ZHOOK_HANDLE)
+
+CONTAINS
+
+SUBROUTINE VERTICAL_EXTEND(PX)
+
+ ! fill extra vetical levels to fit MNH interface
+
+REAL, DIMENSION(KLON,1,KLEV+2), INTENT(INOUT) :: PX
+! NO DR_HOOK, PLEASE ! Rek
+PX(:,1,1 )= PX(:,1,2)
+PX(:,1,KLEV+2)= PX(:,1,KLEV+1)
+END SUBROUTINE VERTICAL_EXTEND
+
+END SUBROUTINE ARO_TURB_MNH
diff --git a/src/arome/modset_Ryad/arpifs/namelist/namparar.nam.h b/src/arome/ext/namparar.nam.h
similarity index 86%
rename from src/arome/modset_Ryad/arpifs/namelist/namparar.nam.h
rename to src/arome/ext/namparar.nam.h
index 6032758b85cf496f9c303b39c63d0fbd72dbf15e..6f667ceae148f1b5de544b4d20f371dfae738a82 100644
--- a/src/arome/modset_Ryad/arpifs/namelist/namparar.nam.h
+++ b/src/arome/ext/namparar.nam.h
@@ -1,5 +1,5 @@
! ------------------------------------------------------------------
-NAMELIST/NAMPARAR/LOSUBG_COND,CSUBG_AUCV_RC,LOSIGMAS,NSWB_MNH,NPRINTFR,LSQUALL,&
+NAMELIST/NAMPARAR/LOSUBG_COND,CSUBG_AUCV_RC,CSUBG_AUCV_RI,LOSIGMAS,NSWB_MNH,NPRINTFR,LSQUALL,&
&NREFROI1,NREFROI2,VSQUALL,NPTP,LDIAGWMAX,NDIAGWMAX,CMICRO,CSEDIM,&
&LAROBU_ENABLE,CMF_UPDRAFT,CMF_CLOUD,LMIXUV,LLCRIT,LTOTPREC,LOSEDIC,&
&VSIGQSAT,XLINI,LOLSMC,LOTOWNC,LOCND2,RADGR,RADSN,LHARATU,&
@@ -13,5 +13,5 @@ NAMELIST/NAMPARAR/LOSUBG_COND,CSUBG_AUCV_RC,LOSIGMAS,NSWB_MNH,NPRINTFR,LSQUALL,&
&LFEEDBACKT,LEVLIMIT,LNULLWETG,LWETGPOST,LNULLWETH,LWETHPOST, &
&XFRACM90, LCONVHG, LCRFLIMIT, &
&CFRAC_ICE_ADJUST, XSPLIT_MAXCFL, CFRAC_ICE_SHALLOW_MF, LSEDIM_AFTER,&
- &LDEPOSC, XVDEPOSC
+ &LDEPOSC, XVDEPOSC, CCONDENS, CLAMBDA3, CSUBG_MF_PDF
! ------------------------------------------------------------------
diff --git a/src/arome/modset_Ryad/arpifs/phys_dmn/suparar.F90 b/src/arome/ext/suparar.F90
similarity index 93%
rename from src/arome/modset_Ryad/arpifs/phys_dmn/suparar.F90
rename to src/arome/ext/suparar.F90
index 93f26ca1795e1f62eee25742f680e2fc0e88e97f..286a2edca755160f19a3265b4244e68d07a770f4 100644
--- a/src/arome/modset_Ryad/arpifs/phys_dmn/suparar.F90
+++ b/src/arome/ext/suparar.F90
@@ -112,6 +112,7 @@ REAL(KIND=JPRB) , POINTER :: VSIGQSAT
REAL(KIND=JPRB) , POINTER :: XKRC_MF
INTEGER(KIND=JPIM) , POINTER :: NDIAGWMAX
CHARACTER(LEN=80) :: CSUBG_PR_PDF
+CHARACTER(LEN=80) :: CSUBG_MF_PDF
REAL(KIND=JPRB) , POINTER :: XFRAC_UP_MAX
CHARACTER(LEN=80) :: CSUBG_RR_EVAP
REAL(KIND=JPRB) , POINTER :: XCMF
@@ -119,6 +120,7 @@ INTEGER(KIND=JPIM) , POINTER :: NSWB_MNH
LOGICAL , POINTER :: LDIAGWMAX
REAL(KIND=JPRB) , POINTER :: XPRES_UV
CHARACTER (LEN=4) :: CSUBG_AUCV_RC
+CHARACTER (LEN=80) :: CSUBG_AUCV_RI
REAL(KIND=JPRB) , POINTER :: XALP_PERT
LOGICAL , POINTER :: LOCND2
LOGICAL , POINTER :: LHARATU
@@ -126,6 +128,8 @@ LOGICAL , POINTER :: LGRSN
INTEGER(KIND=JPIM) , POINTER :: NPRINTFR
REAL(KIND=JPRB) , POINTER :: XCQVR
CHARACTER(LEN=4) :: CMICRO
+CHARACTER(LEN=80) :: CCONDENS
+CHARACTER(LEN=4) :: CLAMBDA3
REAL(KIND=JPRB) , POINTER :: XDETR_LUP
REAL(KIND=JPRB) , POINTER :: GQVTOP
REAL(KIND=JPRB) , POINTER :: GQVPLIM
@@ -304,6 +308,8 @@ LOSIGMAS=.FALSE.
LOSEDIC=.FALSE.
NSWB_MNH=6
NPRINTFR=3600*36
+CCONDENS='CB02'
+CLAMBDA3='CB'
! for squall line academic case
LSQUALL=.FALSE.
NREFROI1=1
@@ -376,9 +382,11 @@ NDTCHEM=1_JPIM
LAROBU_ENABLE=.FALSE.
! Subgrid rain scheme
CSUBG_AUCV_RC='PDF'
+CSUBG_AUCV_RI='NONE'
CSUBG_RC_RR_ACCR='NONE'
CSUBG_RR_EVAP='NONE'
CSUBG_PR_PDF='SIGM'
+CSUBG_MF_PDF='TRIANGLE'
! Snow riming
CSNOWRIMING='M90 '
XFRACM90=0.1 ! Fraction used for the Murakami 1990 formulation
@@ -424,8 +432,12 @@ YDPARAR%CMF_CLOUD=CMF_CLOUD
YDPARAR%CSUBG_PR_PDF=CSUBG_PR_PDF
YDPARAR%CSUBG_RR_EVAP=CSUBG_RR_EVAP
YDPARAR%CSUBG_AUCV_RC=CSUBG_AUCV_RC
+YDPARAR%CSUBG_AUCV_RI=CSUBG_AUCV_RI
+YDPARAR%CSUBG_MF_PDF=CSUBG_MF_PDF
YDPARAR%CSUBG_RC_RR_ACCR=CSUBG_RC_RR_ACCR
YDPARAR%CMICRO=CMICRO
+YDPARAR%CCONDENS=CCONDENS
+YDPARAR%CLAMBDA3=CLAMBDA3
YDPARAR%CSEDIM=CSEDIM
YDPARAR%CSNOWRIMING=CSNOWRIMING
YDPARAR%CFRAC_ICE_ADJUST=CFRAC_ICE_ADJUST
@@ -444,12 +456,26 @@ ENDIF
IF ( (CMICRO == 'ICE4' .OR. CMICRO == 'OLD4') .AND. .NOT.YH%LACTIVE ) THEN
CALL ABOR1("ICE4 and OLD4 microphysics requires activation of YH in NAMGFL")
ENDIF
+IF ( CCONDENS /= 'CB02' .AND. CCONDENS /= 'GAUS') THEN
+ CALL ABOR1("CCONDENS must be CB02 or GAUS")
+ENDIF
+IF ( CLAMBDA3 /= 'CB' .AND. CLAMBDA3 /= 'NONE') THEN
+ CALL ABOR1("CLAMNDA3 must be CB or NONE")
+ENDIF
IF ( CSEDIM /= 'SPLI' .AND. CSEDIM /= 'STAT' ) THEN
CALL ABOR1("AROME Microphysics sedimentation must be EULE or STAT")
ENDIF
IF ( CSUBG_AUCV_RC /= 'PDF ' .AND. CSUBG_AUCV_RC /= 'CLFR' .AND.&
- & CSUBG_AUCV_RC /= 'NONE' ) THEN
- CALL ABOR1("switch for autoconvertion CSUBG_AUCV_RC must be 'PDF ', 'CLFR' or 'NONE'")
+ & CSUBG_AUCV_RC /= 'NONE' .AND. CSUBG_AUCV_RC /= 'ADJU' ) THEN
+ CALL ABOR1("switch for autoconvertion CSUBG_AUCV_RC must be 'PDF ', 'ADJU', 'CLFR' or 'NONE'")
+ENDIF
+IF ( CSUBG_AUCV_RI /= 'NONE' .AND. CSUBG_AUCV_RI /= 'CLFR' .AND.&
+ & CSUBG_AUCV_RI /= 'ADJU') THEN
+ CALL ABOR1("switch for autoconvertion CSUBG_AUCV_RI must be 'CLFR', 'ADJU' or 'NONE'")
+ENDIF
+IF ((CSUBG_AUCV_RC == 'ADJU' .OR. CSUBG_AUCV_RI == 'ADJU') .AND.&
+ & CCONDENS /= 'GAUS') THEN
+ CALL ABOR1("CSUBG_AUCV_RC and/or CSUBG_AUCV_RI cannot be 'ADJU' if CCONDENS is not 'GAUS'")
ENDIF
IF ( CSUBG_RC_RR_ACCR(1:4)/='NONE' .AND. CSUBG_RC_RR_ACCR(1:4)/='PRFR' ) THEN
CALL ABOR1("switch for rc rr accretion (CSUBG_RC_RR_ACCR) must be NONE or PRFR")
@@ -463,6 +489,9 @@ IF ( CSUBG_PR_PDF(1:4)/= 'SIGM' .AND. CSUBG_PR_PDF(1:9) /= 'HLCRECTPD' .AND.&
& .AND. CSUBG_PR_PDF(1:12) /= 'HLCISOTRIPDF' ) THEN
CALL ABOR1("CSUBG_PR_PDF must be SIGM, HLCRECTPD, HLCTRIANGPDF, HLCQUADRAPDF or HLCISOTRIPDF")
ENDIF
+IF ( CSUBG_MF_PDF(1:4)/= 'NONE' .AND. CSUBG_MF_PDF(1:8)/= 'TRIANGLE' ) THEN
+ CALL ABOR1("CSUBG_MF_PDF must be NONE or TRIANGLE")
+ENDIF
IF(XTSTEP_TS<0._JPRB) THEN
CALL ABOR1("XTSTEP_TS must be positive or null")
ENDIF
@@ -561,13 +590,15 @@ ENDIF
! 4. Write in kulout
WRITE(UNIT=KULOUT,FMT='('' COMMON YOMPARAR '')')
-WRITE(UNIT=KULOUT,FMT='('' LOSUBG_COND = '',L5,'' CSUBG_AUCV_RC = '',A4,&
+WRITE(UNIT=KULOUT,FMT='('' LOSUBG_COND = '',L5,'' CSUBG_AUCV_RC = '',A4,'' CSUBG_AUCV_RI = '',A4,&
& '' LOSEDIC = '',L5,'' LOSIGMAS ='',L5,'' LSQUALL = '',L5,&
& '' LOLSMC = '',L5,'' LOTOWNC = '',L5,'' VSIGQSAT = '',F6.2)')&
- & LOSUBG_COND, CSUBG_AUCV_RC, LOSEDIC, LOSIGMAS,LSQUALL,LOLSMC,LOTOWNC,VSIGQSAT
+ & LOSUBG_COND, CSUBG_AUCV_RC, CSUBG_AUCV_RI, LOSEDIC, LOSIGMAS,LSQUALL,LOLSMC,LOTOWNC,VSIGQSAT
WRITE(UNIT=KULOUT,FMT='('' CSUBG_RC_RR_ACCR = '',A80,&
-& '' CSUBG_RR_EVAP = '',A80, '' CSUBG_PR_PDF = '',A80)')&
-& CSUBG_RC_RR_ACCR, CSUBG_RR_EVAP, CSUBG_PR_PDF
+& '' CSUBG_RR_EVAP = '',A80, '' CSUBG_PR_PDF = '',A80, '' CCONDENS = '', A80, '' CSUBG_MF_PDF = '', A80)')&
+& CSUBG_RC_RR_ACCR, CSUBG_RR_EVAP, CSUBG_PR_PDF, CCONDENS, CSUBG_MF_PDF
+WRITE(UNIT=KULOUT,FMT='('' CLAMBDA3 = '',A80)')&
+& CLAMBDA3
WRITE(UNIT=KULOUT,FMT='('' NREFROI1 = '',I3,&
& '' NREFROI2 = '',I3,'' VSQUALL = '',E13.6)')NREFROI1, NREFROI2,VSQUALL
WRITE(UNIT=KULOUT,FMT='('' NGPAR = '',I3,&
diff --git a/src/arome/modset_Ryad/arpifs/module/yomparar.F90 b/src/arome/ext/yomparar.F90
similarity index 95%
rename from src/arome/modset_Ryad/arpifs/module/yomparar.F90
rename to src/arome/ext/yomparar.F90
index d7e985748654b062d62bd654c707629ac5cf9e66..8c07934b948e9d72b4861a978f0925b6619fe707 100644
--- a/src/arome/modset_Ryad/arpifs/module/yomparar.F90
+++ b/src/arome/ext/yomparar.F90
@@ -149,6 +149,10 @@ CHARACTER(LEN=80) :: CSUBG_RR_EVAP ! type of evaporation scheme
! 'PRFR, 'CLFR' or 'NONE'
CHARACTER(LEN=80) :: CSUBG_PR_PDF ! PDF chosen for precipitation production
! (NONE, SIGM, HLCRECTPD, HLCTRIANGPDF, HLCQUADRAPDF or HLCISOTRIPDF)
+CHARACTER(LEN=80) :: CSUBG_AUCV_RI ! type of ri->rs autoconversion scheme
+ ! 'NONE', 'CLFR' or 'ADJU'
+CHARACTER(LEN=80) :: CSUBG_MF_PDF ! PDF to use on MF cloud to retrieve low and high cloud parts
+ ! 'NONE' or 'TRIANGLE'
!* for autoconversion qi,qc
REAL(KIND=JPRB) :: RCRIAUTI ! ice autoconversion threshold
@@ -191,6 +195,9 @@ LOGICAL :: LQVTOP ! to activate modification of qv in input to radiation.
INTEGER(KIND=JPIM) :: NPROMICRO ! special cache-blocking factor for microphysics
+CHARACTER(LEN=80) :: CCONDENS !condensation formulation. 'GAUS' or 'CB02'
+CHARACTER(LEN=4) :: CLAMBDA3 !formulation for the lambda3 coeff used with s'r'. 'CB' or 'NONE'
+
END TYPE TPARAR
!!TYPE(TPARAR), POINTER :: YRPARAR => NULL()
diff --git a/src/arome/gmkpack_ignored_files b/src/arome/gmkpack_ignored_files
index 6abe5cdf82a32041cdd1a48a945fb33b1d4511f1..10c5e38ab406d69febb7865b66c5c4114f6bc608 100644
--- a/src/arome/gmkpack_ignored_files
+++ b/src/arome/gmkpack_ignored_files
@@ -81,3 +81,7 @@ phyex/micro/cart_compress.F90
phyex/micro/modi_add_bounds.F90
phyex/micro/modi_cart_compress.F90
phyex/micro/modi_mask_compress.F90
+phyex/micro/ini_budget.F90
+phyex/micro/modd_budget.F90
+phyex/micro/modi_budget.F90
+phyex/micro/modi_ini_budget.F90
diff --git a/src/arome/micro/ice_adjust.F90 b/src/arome/micro/ice_adjust.F90
index 3a1658256cfa31154d0f790969a04560968612c3..8e23954f699f644bcd96ec1ca4ba06c859380b39 100644
--- a/src/arome/micro/ice_adjust.F90
+++ b/src/arome/micro/ice_adjust.F90
@@ -107,7 +107,7 @@ USE MODD_CONF
USE MODD_BUDGET
!
USE MODI_CONDENSATION
-USE MODI_BUDGET
+USE MODI_BUDGET_DDH
USE MODE_FMWRIT
!
IMPLICIT NONE
@@ -378,10 +378,10 @@ ENDIF
!* 6. STORE THE BUDGET TERMS
! ----------------------
!
-IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:) * PRHODJ(:,:,:),6,HBUNAME//'_BU_RRV',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:) * PRHODJ(:,:,:),7,HBUNAME//'_BU_RRC',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:) * PRHODJ(:,:,:),9,HBUNAME//'_BU_RRI',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:) * PRHODJ(:,:,:),4,HBUNAME//'_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_RV) CALL BUDGET_DDH (PRVS(:,:,:) * PRHODJ(:,:,:),6,HBUNAME//'_BU_RRV',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:) * PRHODJ(:,:,:),7,HBUNAME//'_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:) * PRHODJ(:,:,:),9,HBUNAME//'_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:) * PRHODJ(:,:,:),4,HBUNAME//'_BU_RTH',YDDDH, YDLDDH, YDMDDH)
!
!------------------------------------------------------------------------------
!
diff --git a/src/arome/micro/lima.F90 b/src/arome/micro/lima.F90
index a1e6ca67028b8ac968a44e55700064e15c04a80f..e6a9ef41186419563223a1ba422a9af6c8bf16f6 100644
--- a/src/arome/micro/lima.F90
+++ b/src/arome/micro/lima.F90
@@ -109,7 +109,7 @@ USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_CCN_FREE, NSV
NSV_LIMA_IFN_NUCL, NSV_LIMA_IMM_NUCL, NSV_LIMA_HOM_HAZE
USE MODD_CST, ONLY : XCI, XCL, XCPD, XCPV, XLSTT, XLVTT, XTT
!
-USE MODI_BUDGET
+USE MODI_BUDGET_DDH
USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
USE MODI_LIMA_WARM_SEDIMENTATION
USE MODI_LIMA_COLD_SEDIMENTATION
@@ -617,16 +617,16 @@ IF ( LCOLD_LIMA ) ZCIT(:,:,:) = ZCIS(:,:,:) * PTSTEP
! Call budgets
!
IF(LBU_ENABLE) THEN
- IF (LBUDGET_RC .AND. LSEDC_LIMA) CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'SEDI_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'SEDI_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI .AND. LSEDI_LIMA) CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'SEDI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'SEDI_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'SEDI_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET (ZRHS(:,:,:)*PRHODJ(:,:,:), 12 , 'SEDI_BU_RRH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RC .AND. LSEDC_LIMA) CALL BUDGET_DDH (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'SEDI_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RR) CALL BUDGET_DDH (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'SEDI_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RI .AND. LSEDI_LIMA) CALL BUDGET_DDH (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'SEDI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RS) CALL BUDGET_DDH (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'SEDI_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RG) CALL BUDGET_DDH (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'SEDI_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RH) CALL BUDGET_DDH (ZRHS(:,:,:)*PRHODJ(:,:,:), 12 , 'SEDI_BU_RRH',YDDDH, YDLDDH, YDMDDH)
IF (LBUDGET_SV) THEN
- IF (LSEDC_LIMA) CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'SEDI_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (LRAIN_LIMA) CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'SEDI_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (LSEDI_LIMA) CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'SEDI_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ IF (LSEDC_LIMA) CALL BUDGET_DDH (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'SEDI_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ IF (LRAIN_LIMA) CALL BUDGET_DDH (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'SEDI_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ IF (LSEDI_LIMA) CALL BUDGET_DDH (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'SEDI_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END IF
END IF
!
@@ -1558,159 +1558,159 @@ PTHS(:,:,:) = ZW_THS(:,:,:)
IF(LBU_ENABLE) THEN
IF (LBUDGET_TH) THEN
ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_EVAP(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'REVA_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'REVA_BU_RTH',YDDDH, YDLDDH, YDMDDH)
ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_HONC(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'HONC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'HONC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_HONR(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'HONR_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'HONR_BU_RTH',YDDDH, YDLDDH, YDMDDH)
ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_DEPS(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'DEPS_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'DEPS_BU_RTH',YDDDH, YDLDDH, YDMDDH)
ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_DEPG(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'DEPG_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'DEPG_BU_RTH',YDDDH, YDLDDH, YDMDDH)
ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_IMLT(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'IMLT_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'IMLT_BU_RTH',YDDDH, YDLDDH, YDMDDH)
ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_BERFI(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'BERFI_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'BERFI_BU_RTH',YDDDH, YDLDDH, YDMDDH)
ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_RIM(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'RIM_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'RIM_BU_RTH',YDDDH, YDLDDH, YDMDDH)
ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_ACC(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'ACC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'ACC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_CFRZ(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'CFRZ_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'CFRZ_BU_RTH',YDDDH, YDLDDH, YDMDDH)
ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_WETG(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'WETG_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'WETG_BU_RTH',YDDDH, YDLDDH, YDMDDH)
ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_DRYG(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'DRYG_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'DRYG_BU_RTH',YDDDH, YDLDDH, YDMDDH)
ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_GMLT(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'GMLT_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'GMLT_BU_RTH',YDDDH, YDLDDH, YDMDDH)
END IF
IF (LBUDGET_RV) THEN
ZRVS(:,:,:) = ZRVS(:,:,:) - ZTOT_RR_EVAP(:,:,:)/PTSTEP
- CALL BUDGET (ZRVS(:,:,:)*PRHODJ(:,:,:), 6 , 'REVA_BU_RRV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRVS(:,:,:)*PRHODJ(:,:,:), 6 , 'REVA_BU_RRV',YDDDH, YDLDDH, YDMDDH)
ZRVS(:,:,:) = ZRVS(:,:,:) - ZTOT_RS_DEPS(:,:,:)/PTSTEP
- CALL BUDGET (ZRVS(:,:,:)*PRHODJ(:,:,:), 6 , 'DEPS_BU_RRV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRVS(:,:,:)*PRHODJ(:,:,:), 6 , 'DEPS_BU_RRV',YDDDH, YDLDDH, YDMDDH)
ZRVS(:,:,:) = ZRVS(:,:,:) - ZTOT_RG_DEPG(:,:,:)/PTSTEP
- CALL BUDGET (ZRVS(:,:,:)*PRHODJ(:,:,:), 6 , 'DEPG_BU_RRV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRVS(:,:,:)*PRHODJ(:,:,:), 6 , 'DEPG_BU_RRV',YDDDH, YDLDDH, YDMDDH)
END IF
IF (LBUDGET_RC) THEN
ZRCS(:,:,:) = ZRCS(:,:,:) + ZTOT_RC_AUTO(:,:,:)/PTSTEP
- CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'AUTO_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'AUTO_BU_RRC',YDDDH, YDLDDH, YDMDDH)
ZRCS(:,:,:) = ZRCS(:,:,:) + ZTOT_RC_ACCR(:,:,:)/PTSTEP
- CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'ACCR_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'ACCR_BU_RRC',YDDDH, YDLDDH, YDMDDH)
! impact of rain evap !!!!!!
ZRCS(:,:,:) = ZRCS(:,:,:)
- CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'REVA_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'REVA_BU_RRC',YDDDH, YDLDDH, YDMDDH)
ZRCS(:,:,:) = ZRCS(:,:,:) + ZTOT_RC_HONC(:,:,:)/PTSTEP
- CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'HONC_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'HONC_BU_RRC',YDDDH, YDLDDH, YDMDDH)
ZRCS(:,:,:) = ZRCS(:,:,:) + ZTOT_RC_IMLT(:,:,:)/PTSTEP
- CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'IMLT_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'IMLT_BU_RRC',YDDDH, YDLDDH, YDMDDH)
ZRCS(:,:,:) = ZRCS(:,:,:) + ZTOT_RC_BERFI(:,:,:)/PTSTEP
- CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'BERFI_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'BERFI_BU_RRC',YDDDH, YDLDDH, YDMDDH)
ZRCS(:,:,:) = ZRCS(:,:,:) + ZTOT_RC_RIM(:,:,:)/PTSTEP
- CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'RIM_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'RIM_BU_RRC',YDDDH, YDLDDH, YDMDDH)
ZRCS(:,:,:) = ZRCS(:,:,:) + ZTOT_RC_WETG(:,:,:)/PTSTEP
- CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'WETG_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'WETG_BU_RRC',YDDDH, YDLDDH, YDMDDH)
ZRCS(:,:,:) = ZRCS(:,:,:) + ZTOT_RC_DRYG(:,:,:)/PTSTEP
- CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'DRYG_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'DRYG_BU_RRC',YDDDH, YDLDDH, YDMDDH)
END IF
IF (LBUDGET_RR) THEN
ZRRS(:,:,:) = ZRRS(:,:,:) - ZTOT_RC_AUTO(:,:,:)/PTSTEP
- CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'AUTO_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'AUTO_BU_RRR',YDDDH, YDLDDH, YDMDDH)
ZRRS(:,:,:) = ZRRS(:,:,:) - ZTOT_RC_ACCR(:,:,:)/PTSTEP
- CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'ACCR_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'ACCR_BU_RRR',YDDDH, YDLDDH, YDMDDH)
ZRRS(:,:,:) = ZRRS(:,:,:) + ZTOT_RR_EVAP(:,:,:)/PTSTEP
- CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'REVA_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'REVA_BU_RRR',YDDDH, YDLDDH, YDMDDH)
ZRRS(:,:,:) = ZRRS(:,:,:) + ZTOT_RR_HONR(:,:,:)/PTSTEP
- CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'HONR_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'HONR_BU_RRR',YDDDH, YDLDDH, YDMDDH)
ZRRS(:,:,:) = ZRRS(:,:,:) + ZTOT_RR_ACC(:,:,:)/PTSTEP
- CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'ACC_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'ACC_BU_RRR',YDDDH, YDLDDH, YDMDDH)
ZRRS(:,:,:) = ZRRS(:,:,:) + ZTOT_RR_CFRZ(:,:,:)/PTSTEP
- CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'CFRZ_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'CFRZ_BU_RRR',YDDDH, YDLDDH, YDMDDH)
ZRRS(:,:,:) = ZRRS(:,:,:) + ZTOT_RR_WETG(:,:,:)/PTSTEP
- CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'WETG_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'WETG_BU_RRR',YDDDH, YDLDDH, YDMDDH)
ZRRS(:,:,:) = ZRRS(:,:,:) + ZTOT_RR_DRYG(:,:,:)/PTSTEP
- CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'DRYG_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'DRYG_BU_RRR',YDDDH, YDLDDH, YDMDDH)
ZRRS(:,:,:) = ZRRS(:,:,:) + ZTOT_RR_GMLT(:,:,:)/PTSTEP
- CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'GMLT_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'GMLT_BU_RRR',YDDDH, YDLDDH, YDMDDH)
END IF
IF (LBUDGET_RI) THEN
ZRIS(:,:,:) = ZRIS(:,:,:) - ZTOT_RC_HONC(:,:,:)/PTSTEP
- CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'HONC_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'HONC_BU_RRI',YDDDH, YDLDDH, YDMDDH)
ZRIS(:,:,:) = ZRIS(:,:,:) + ZTOT_RI_CNVI(:,:,:)/PTSTEP
- CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'CNVI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'CNVI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
ZRIS(:,:,:) = ZRIS(:,:,:) + ZTOT_RI_CNVS(:,:,:)/PTSTEP
- CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'CNVS_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'CNVS_BU_RRI',YDDDH, YDLDDH, YDMDDH)
ZRIS(:,:,:) = ZRIS(:,:,:) + ZTOT_RI_AGGS(:,:,:)/PTSTEP
- CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'AGGS_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'AGGS_BU_RRI',YDDDH, YDLDDH, YDMDDH)
ZRIS(:,:,:) = ZRIS(:,:,:) - ZTOT_RC_IMLT(:,:,:)/PTSTEP
- CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'IMLT_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'IMLT_BU_RRI',YDDDH, YDLDDH, YDMDDH)
ZRIS(:,:,:) = ZRIS(:,:,:) - ZTOT_RC_BERFI(:,:,:)/PTSTEP
- CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'BERFI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'BERFI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
ZRIS(:,:,:) = ZRIS(:,:,:) + ZTOT_RI_HMS(:,:,:)/PTSTEP
- CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'HMS_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'HMS_BU_RRI',YDDDH, YDLDDH, YDMDDH)
ZRIS(:,:,:) = ZRIS(:,:,:) + ZTOT_RI_CFRZ(:,:,:)/PTSTEP
- CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'CFRZ_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'CFRZ_BU_RRI',YDDDH, YDLDDH, YDMDDH)
ZRIS(:,:,:) = ZRIS(:,:,:) + ZTOT_RI_WETG(:,:,:)/PTSTEP
- CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'WETG_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'WETG_BU_RRI',YDDDH, YDLDDH, YDMDDH)
ZRIS(:,:,:) = ZRIS(:,:,:) + ZTOT_RI_DRYG(:,:,:)/PTSTEP
- CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'DRYG_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'DRYG_BU_RRI',YDDDH, YDLDDH, YDMDDH)
ZRIS(:,:,:) = ZRIS(:,:,:) + ZTOT_RI_HMG(:,:,:)/PTSTEP
- CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'HMG_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'HMG_BU_RRI',YDDDH, YDLDDH, YDMDDH)
END IF
IF (LBUDGET_RS) THEN
ZRSS(:,:,:) = ZRSS(:,:,:) - ZTOT_RI_CNVI(:,:,:)/PTSTEP
- CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'CNVI_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'CNVI_BU_RRS',YDDDH, YDLDDH, YDMDDH)
ZRSS(:,:,:) = ZRSS(:,:,:) + ZTOT_RS_DEPS(:,:,:)/PTSTEP
- CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'DEPS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'DEPS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
ZRSS(:,:,:) = ZRSS(:,:,:) - ZTOT_RI_CNVS(:,:,:)/PTSTEP
- CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'CNVS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'CNVS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
ZRSS(:,:,:) = ZRSS(:,:,:) - ZTOT_RI_AGGS(:,:,:)/PTSTEP
- CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'AGGS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'AGGS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
ZRSS(:,:,:) = ZRSS(:,:,:) + ZTOT_RS_RIM(:,:,:)/PTSTEP
- CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'RIM_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'RIM_BU_RRS',YDDDH, YDLDDH, YDMDDH)
ZRSS(:,:,:) = ZRSS(:,:,:) + ZTOT_RS_HMS(:,:,:)/PTSTEP
- CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'HMS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'HMS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
ZRSS(:,:,:) = ZRSS(:,:,:) + ZTOT_RS_ACC(:,:,:)/PTSTEP
- CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'ACC_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'ACC_BU_RRS',YDDDH, YDLDDH, YDMDDH)
ZRSS(:,:,:) = ZRSS(:,:,:) + ZTOT_RS_CMEL(:,:,:)/PTSTEP
- CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'CMEL_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'CMEL_BU_RRS',YDDDH, YDLDDH, YDMDDH)
ZRSS(:,:,:) = ZRSS(:,:,:) + ZTOT_RS_WETG(:,:,:)/PTSTEP
- CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'WETG_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'WETG_BU_RRS',YDDDH, YDLDDH, YDMDDH)
ZRSS(:,:,:) = ZRSS(:,:,:) + ZTOT_RS_DRYG(:,:,:)/PTSTEP
- CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'DRYG_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'DRYG_BU_RRS',YDDDH, YDLDDH, YDMDDH)
END IF
IF (LBUDGET_RG) THEN
ZRGS(:,:,:) = ZRGS(:,:,:) - ZTOT_RR_HONR(:,:,:)/PTSTEP
- CALL BUDGET (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'HONR_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'HONR_BU_RRG',YDDDH, YDLDDH, YDMDDH)
ZRGS(:,:,:) = ZRGS(:,:,:) + ZTOT_RG_DEPG(:,:,:)/PTSTEP
- CALL BUDGET (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'DEPG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'DEPG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
ZRGS(:,:,:) = ZRGS(:,:,:) + ZTOT_RG_RIM(:,:,:)/PTSTEP
- CALL BUDGET (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'RIM_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'RIM_BU_RRG',YDDDH, YDLDDH, YDMDDH)
ZRGS(:,:,:) = ZRGS(:,:,:) + ZTOT_RG_ACC(:,:,:)/PTSTEP
- CALL BUDGET (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'ACC_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'ACC_BU_RRG',YDDDH, YDLDDH, YDMDDH)
ZRGS(:,:,:) = ZRGS(:,:,:) - ZTOT_RS_CMEL(:,:,:)/PTSTEP
- CALL BUDGET (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'CMEL_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'CMEL_BU_RRG',YDDDH, YDLDDH, YDMDDH)
ZRGS(:,:,:) = ZRGS(:,:,:) - ZTOT_RR_CFRZ(:,:,:)/PTSTEP - ZTOT_RI_CFRZ(:,:,:)/PTSTEP
- CALL BUDGET (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'CFRZ_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'CFRZ_BU_RRG',YDDDH, YDLDDH, YDMDDH)
ZRGS(:,:,:) = ZRGS(:,:,:) + ZTOT_RG_WETG(:,:,:)/PTSTEP
- CALL BUDGET (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'WETG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'WETG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
ZRGS(:,:,:) = ZRGS(:,:,:) + ZTOT_RG_DRYG(:,:,:)/PTSTEP
- CALL BUDGET (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'DRYG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'DRYG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
ZRGS(:,:,:) = ZRGS(:,:,:) + ZTOT_RG_HMG(:,:,:)/PTSTEP
- CALL BUDGET (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'HMG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'HMG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
ZRGS(:,:,:) = ZRGS(:,:,:) - ZTOT_RR_GMLT(:,:,:)/PTSTEP
- CALL BUDGET (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'GMLT_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'GMLT_BU_RRG',YDDDH, YDLDDH, YDMDDH)
END IF
IF (LBUDGET_RH) THEN
ZRHS(:,:,:) = ZRHS(:,:,:) + ZTOT_RH_WETG(:,:,:)/PTSTEP
- CALL BUDGET (ZRHS(:,:,:)*PRHODJ(:,:,:), 12 , 'WETG_BU_RRH',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZRHS(:,:,:)*PRHODJ(:,:,:), 12 , 'WETG_BU_RRH',YDDDH, YDLDDH, YDMDDH)
END IF
IF (LBUDGET_SV) THEN
@@ -1718,71 +1718,71 @@ IF(LBU_ENABLE) THEN
! Cloud droplets
!
ZCCS(:,:,:) = ZCCS(:,:,:) + ZTOT_CC_SELF(:,:,:)/PTSTEP
- CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'SELF_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'SELF_BU_RSV',YDDDH, YDLDDH, YDMDDH)
ZCCS(:,:,:) = ZCCS(:,:,:) + ZTOT_CC_AUTO(:,:,:)/PTSTEP
- CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'AUTO_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'AUTO_BU_RSV',YDDDH, YDLDDH, YDMDDH)
ZCCS(:,:,:) = ZCCS(:,:,:) + ZTOT_CC_ACCR(:,:,:)/PTSTEP
- CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'ACCR_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'ACCR_BU_RSV',YDDDH, YDLDDH, YDMDDH)
! impact of rain evap !!!!!!
ZCCS(:,:,:) = ZCCS(:,:,:)
- CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'REVA_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'REVA_BU_RSV',YDDDH, YDLDDH, YDMDDH)
ZCCS(:,:,:) = ZCCS(:,:,:) + ZTOT_CC_HONC(:,:,:)/PTSTEP
- CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'HONC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'HONC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
ZCCS(:,:,:) = ZCCS(:,:,:) + ZTOT_CC_IMLT(:,:,:)/PTSTEP
- CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'IMLT_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'IMLT_BU_RSV',YDDDH, YDLDDH, YDMDDH)
ZCCS(:,:,:) = ZCCS(:,:,:) + ZTOT_CC_RIM(:,:,:)/PTSTEP
- CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'RIM_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'RIM_BU_RSV',YDDDH, YDLDDH, YDMDDH)
ZCCS(:,:,:) = ZCCS(:,:,:) + ZTOT_CC_WETG(:,:,:)/PTSTEP
- CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'WETG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'WETG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
ZCCS(:,:,:) = ZCCS(:,:,:) + ZTOT_CC_DRYG(:,:,:)/PTSTEP
- CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'DRYG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'DRYG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
!
! Rain drops
!
ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_AUTO(:,:,:)/PTSTEP
- CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'AUTO_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'AUTO_BU_RSV',YDDDH, YDLDDH, YDMDDH)
ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_SCBU(:,:,:)/PTSTEP
- CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'SCBU_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'SCBU_BU_RSV',YDDDH, YDLDDH, YDMDDH)
! Rain evaporation !!!!!!!!!!!!!
ZCRS(:,:,:) = ZCRS(:,:,:)
- CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'REVA_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'REVA_BU_RSV',YDDDH, YDLDDH, YDMDDH)
ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_BRKU(:,:,:)/PTSTEP
- CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'BRKU_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'BRKU_BU_RSV',YDDDH, YDLDDH, YDMDDH)
ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_HONR(:,:,:)/PTSTEP
- CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'HONR_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'HONR_BU_RSV',YDDDH, YDLDDH, YDMDDH)
ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_ACC(:,:,:)/PTSTEP
- CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'ACC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'ACC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_CFRZ(:,:,:)/PTSTEP
- CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'CFRZ_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'CFRZ_BU_RSV',YDDDH, YDLDDH, YDMDDH)
ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_WETG(:,:,:)/PTSTEP
- CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'WETG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'WETG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_DRYG(:,:,:)/PTSTEP
- CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'DRYG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'DRYG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_GMLT(:,:,:)/PTSTEP
- CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'GMLT_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'GMLT_BU_RSV',YDDDH, YDLDDH, YDMDDH)
!
! Ice crystals
!
ZCIS(:,:,:) = ZCIS(:,:,:) - ZTOT_CC_HONC(:,:,:)/PTSTEP
- CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'HONC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'HONC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
ZCIS(:,:,:) = ZCIS(:,:,:) + ZTOT_CI_CNVI(:,:,:)/PTSTEP
- CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'CNVI_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'CNVI_BU_RSV',YDDDH, YDLDDH, YDMDDH)
ZCIS(:,:,:) = ZCIS(:,:,:) + ZTOT_CI_CNVS(:,:,:)/PTSTEP
- CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'CNVS_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'CNVS_BU_RSV',YDDDH, YDLDDH, YDMDDH)
ZCIS(:,:,:) = ZCIS(:,:,:) + ZTOT_CI_AGGS(:,:,:)/PTSTEP
- CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'AGGS_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'AGGS_BU_RSV',YDDDH, YDLDDH, YDMDDH)
ZCIS(:,:,:) = ZCIS(:,:,:) - ZTOT_CC_IMLT(:,:,:)/PTSTEP
- CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'IMLT_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'IMLT_BU_RSV',YDDDH, YDLDDH, YDMDDH)
ZCIS(:,:,:) = ZCIS(:,:,:) + ZTOT_CI_HMS(:,:,:)/PTSTEP
- CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'HMS_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'HMS_BU_RSV',YDDDH, YDLDDH, YDMDDH)
ZCIS(:,:,:) = ZCIS(:,:,:) + ZTOT_CI_CFRZ(:,:,:)/PTSTEP
- CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'CFRZ_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'CFRZ_BU_RSV',YDDDH, YDLDDH, YDMDDH)
ZCIS(:,:,:) = ZCIS(:,:,:) + ZTOT_CI_WETG(:,:,:)/PTSTEP
- CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'WETG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'WETG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
ZCIS(:,:,:) = ZCIS(:,:,:) + ZTOT_CI_DRYG(:,:,:)/PTSTEP
- CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'DRYG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'DRYG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
ZCIS(:,:,:) = ZCIS(:,:,:) + ZTOT_CI_HMG(:,:,:)/PTSTEP
- CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'HMG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'HMG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END IF
!!$ ZTOT_RC_EVAP(I1(II),I2(II),I3(II)) = ZTOT_RC_EVAP(I1(II),I2(II),I3(II)) + Z_RC_EVAP(II) * ZMAXTIME(II)
!!$ ZTOT_CC_EVAP(I1(II),I2(II),I3(II)) = ZTOT_CC_EVAP(I1(II),I2(II),I3(II)) + Z_CC_EVAP(II) * ZMAXTIME(II)
diff --git a/src/arome/micro/lima_adjust.F90 b/src/arome/micro/lima_adjust.F90
index cb98be5a312bcb9e58d9fe4b2264c39aa8b3a86a..195cc8b1e7acb9caee488be28cfee2e8324cb70a 100644
--- a/src/arome/micro/lima_adjust.F90
+++ b/src/arome/micro/lima_adjust.F90
@@ -157,7 +157,7 @@ USE DDH_MIX, ONLY : TYP_DDH
USE YOMLDDH, ONLY : TLDDH
USE YOMMDDH, ONLY : TMDDH
!
-USE MODI_BUDGET
+USE MODI_BUDGET_DDH
USE MODI_LIMA_FUNCTIONS
!
USE MODE_FM
@@ -1199,21 +1199,21 @@ END IF
!
!
IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:) * PRHODJ(:,:,:),4,'CEDS_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:) * PRHODJ(:,:,:),6,'CEDS_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:) * PRHODJ(:,:,:),7,'CEDS_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:) * PRHODJ(:,:,:),9,'CEDS_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:) * PRHODJ(:,:,:),4,'CEDS_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RV) CALL BUDGET_DDH (PRVS(:,:,:) * PRHODJ(:,:,:),6,'CEDS_BU_RRV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:) * PRHODJ(:,:,:),7,'CEDS_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:) * PRHODJ(:,:,:),9,'CEDS_BU_RRI',YDDDH, YDLDDH, YDMDDH)
IF (LBUDGET_SV) THEN
- CALL BUDGET (PCCS(:,:,:) * PRHODJ(:,:,:),12+NSV_LIMA_NC,'CEDS_BU_RSV',YDDDH, YDLDDH, YDMDDH) ! RCC
- CALL BUDGET (PCIS(:,:,:) * PRHODJ(:,:,:),12+NSV_LIMA_NI,'CEDS_BU_RSV',YDDDH, YDLDDH, YDMDDH) ! RCI
+ CALL BUDGET_DDH (PCCS(:,:,:) * PRHODJ(:,:,:),12+NSV_LIMA_NC,'CEDS_BU_RSV',YDDDH, YDLDDH, YDMDDH) ! RCC
+ CALL BUDGET_DDH (PCIS(:,:,:) * PRHODJ(:,:,:),12+NSV_LIMA_NI,'CEDS_BU_RSV',YDDDH, YDLDDH, YDMDDH) ! RCI
IF (NMOD_CCN .GE. 1) THEN
DO JL = 1, NMOD_CCN
- CALL BUDGET (PNFS(:,:,:,JL)*PRHODJ(:,:,:),12+NSV_LIMA_CCN_FREE+JL-1,'CEDS_BU_RSV',YDDDH, YDLDDH, YDMDDH) ! RCC
+ CALL BUDGET_DDH (PNFS(:,:,:,JL)*PRHODJ(:,:,:),12+NSV_LIMA_CCN_FREE+JL-1,'CEDS_BU_RSV',YDDDH, YDLDDH, YDMDDH) ! RCC
END DO
END IF
IF (NMOD_IFN .GE. 1) THEN
DO JL = 1, NMOD_IFN
- CALL BUDGET (PIFS(:,:,:,JL)*PRHODJ(:,:,:),12+NSV_LIMA_IFN_FREE+JL-1,'CEDS_BU_RSV',YDDDH, YDLDDH, YDMDDH) ! RCC
+ CALL BUDGET_DDH (PIFS(:,:,:,JL)*PRHODJ(:,:,:),12+NSV_LIMA_IFN_FREE+JL-1,'CEDS_BU_RSV',YDDDH, YDLDDH, YDMDDH) ! RCC
END DO
END IF
END IF
diff --git a/src/arome/micro/lima_ccn_hom_freezing.F90 b/src/arome/micro/lima_ccn_hom_freezing.F90
index efb24778eb0d62c0b3be96eb5e9b271f801b68ae..2b1c25c4459de6bcbed03d519bc6a3b0988117cf 100644
--- a/src/arome/micro/lima_ccn_hom_freezing.F90
+++ b/src/arome/micro/lima_ccn_hom_freezing.F90
@@ -83,7 +83,7 @@ USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
!
USE MODD_NSV
USE MODD_BUDGET
-USE MODI_BUDGET
+USE MODI_BUDGET_DDH
!
IMPLICIT NONE
!
diff --git a/src/arome/micro/lima_cold.F90 b/src/arome/micro/lima_cold.F90
index e9b3a2e616ddfa550156e92bdd8e6903bbeb8f00..ff4827fda1741b219c3b234979259c54f7e86013 100644
--- a/src/arome/micro/lima_cold.F90
+++ b/src/arome/micro/lima_cold.F90
@@ -124,7 +124,7 @@ USE MODD_NSV
USE MODD_PARAM_LIMA
!
USE MODD_BUDGET
-USE MODI_BUDGET
+USE MODI_BUDGET_DDH
!
USE MODI_LIMA_COLD_SEDIMENTATION
USE MODI_LIMA_MEYERS
@@ -331,12 +331,12 @@ CALL LIMA_COLD_SEDIMENTATION (OSEDI, KSPLITG, PTSTEP, KMI, &
PINPRH )
IF (LBU_ENABLE) THEN
IF (LBUDGET_RI .AND. OSEDI) &
- CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9 ,'SEDI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10 ,'SEDI_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11 ,'SEDI_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:),12 ,'SEDI_BU_RRH',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9 ,'SEDI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RS) CALL BUDGET_DDH (PRSS(:,:,:)*PRHODJ(:,:,:),10 ,'SEDI_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11 ,'SEDI_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RH) CALL BUDGET_DDH (PRHS(:,:,:)*PRHODJ(:,:,:),12 ,'SEDI_BU_RRH',YDDDH, YDLDDH, YDMDDH)
IF (LBUDGET_SV) THEN
- IF (OSEDI) CALL BUDGET (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'SEDI_BU_RSV',YDDDH, YDLDDH, YDMDDH) ! RCI
+ IF (OSEDI) CALL BUDGET_DDH (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'SEDI_BU_RSV',YDDDH, YDLDDH, YDMDDH) ! RCI
END IF
END IF
!-------------------------------------------------------------------------------
diff --git a/src/arome/micro/lima_cold_hom_nucl.F90 b/src/arome/micro/lima_cold_hom_nucl.F90
index c8e2775e04e3940c05195eccc14a61e0db417095..74d950fa1c55dbfb07cf2b3155b00b600fcade1f 100644
--- a/src/arome/micro/lima_cold_hom_nucl.F90
+++ b/src/arome/micro/lima_cold_hom_nucl.F90
@@ -126,7 +126,7 @@ USE YOMMDDH, ONLY : TMDDH
!
USE MODD_NSV
USE MODD_BUDGET
-USE MODI_BUDGET
+USE MODI_BUDGET_DDH
!
IMPLICIT NONE
!
@@ -468,24 +468,24 @@ IF (INEGT.GT.0) THEN
!
! Budget storage
IF (NBUMOD==KMI .AND. LBU_ENABLE .AND. OHHONI) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
+ IF (LBUDGET_TH) CALL BUDGET_DDH ( &
UNPACK(ZTHS(:),MASK=GNEGT(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
4,'HONH_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET ( &
+ IF (LBUDGET_RV) CALL BUDGET_DDH ( &
UNPACK(ZRVS(:),MASK=GNEGT(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:),&
6,'HONH_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET ( &
+ IF (LBUDGET_RI) CALL BUDGET_DDH ( &
UNPACK(ZRIS(:),MASK=GNEGT(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
9,'HONH_BU_RRI',YDDDH, YDLDDH, YDMDDH)
IF (LBUDGET_SV) THEN
- CALL BUDGET ( UNPACK(ZCIS(:),MASK=GNEGT(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:),&
+ CALL BUDGET_DDH ( UNPACK(ZCIS(:),MASK=GNEGT(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:),&
12+NSV_LIMA_NI,'HONH_BU_RSV',YDDDH, YDLDDH, YDMDDH) ! RCI
IF (NMOD_CCN.GE.1) THEN
DO JL=1, NMOD_CCN
- CALL BUDGET ( UNPACK(ZNFS(:,JL),MASK=GNEGT(:,:,:),FIELD=PNFS(:,:,:,JL))*PRHODJ(:,:,:),&
+ CALL BUDGET_DDH ( UNPACK(ZNFS(:,JL),MASK=GNEGT(:,:,:),FIELD=PNFS(:,:,:,JL))*PRHODJ(:,:,:),&
12+NSV_LIMA_CCN_FREE+JL-1,'HONH_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END DO
- CALL BUDGET ( UNPACK(ZZNHS(:),MASK=GNEGT(:,:,:),FIELD=ZNHS(:,:,:))*PRHODJ(:,:,:),&
+ CALL BUDGET_DDH ( UNPACK(ZZNHS(:),MASK=GNEGT(:,:,:),FIELD=ZNHS(:,:,:))*PRHODJ(:,:,:),&
12+NSV_LIMA_HOM_HAZE,'HONH_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END IF
@@ -526,19 +526,19 @@ IF (INEGT.GT.0) THEN
!
! Budget storage
IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
+ IF (LBUDGET_TH) CALL BUDGET_DDH ( &
UNPACK(ZTHS(:),MASK=GNEGT(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
4,'HONC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET ( &
+ IF (LBUDGET_RC) CALL BUDGET_DDH ( &
UNPACK(ZRCS(:),MASK=GNEGT(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:),&
7,'HONC_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET ( &
+ IF (LBUDGET_RI) CALL BUDGET_DDH ( &
UNPACK(ZRIS(:),MASK=GNEGT(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
9,'HONC_BU_RRI',YDDDH, YDLDDH, YDMDDH)
IF (LBUDGET_SV) THEN
- CALL BUDGET ( UNPACK(ZCCS(:),MASK=GNEGT(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:),&
+ CALL BUDGET_DDH ( UNPACK(ZCCS(:),MASK=GNEGT(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:),&
12+NSV_LIMA_NC,'HONC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET ( UNPACK(ZCIS(:),MASK=GNEGT(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:),&
+ CALL BUDGET_DDH ( UNPACK(ZCIS(:),MASK=GNEGT(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:),&
12+NSV_LIMA_NI,'HONC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END IF
END IF
@@ -565,17 +565,17 @@ IF (INEGT.GT.0) THEN
!
! Budget storage
IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
+ IF (LBUDGET_TH) CALL BUDGET_DDH ( &
UNPACK(ZTHS(:),MASK=GNEGT(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
4,'HONR_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET ( &
+ IF (LBUDGET_RR) CALL BUDGET_DDH ( &
UNPACK(ZRRS(:),MASK=GNEGT(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:),&
8,'HONR_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET ( &
+ IF (LBUDGET_RG) CALL BUDGET_DDH ( &
UNPACK(ZRGS(:),MASK=GNEGT(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:),&
11,'HONR_BU_RRG',YDDDH, YDLDDH, YDMDDH)
IF (LBUDGET_SV) THEN
- CALL BUDGET ( UNPACK(ZCRS(:),MASK=GNEGT(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:),&
+ CALL BUDGET_DDH ( UNPACK(ZCRS(:),MASK=GNEGT(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:),&
12+NSV_LIMA_NR,'HONR_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END IF
END IF
@@ -656,31 +656,31 @@ ELSE
IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
IF ( OHHONI ) THEN
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HONH_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),6,'HONH_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HONH_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HONH_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RV) CALL BUDGET_DDH (PRVS(:,:,:)*PRHODJ(:,:,:),6,'HONH_BU_RRV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HONH_BU_RRI',YDDDH, YDLDDH, YDMDDH)
IF (LBUDGET_SV) THEN
- CALL BUDGET (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'HONH_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'HONH_BU_RSV',YDDDH, YDLDDH, YDMDDH)
IF (NMOD_CCN.GE.1) THEN
DO JL=1, NMOD_CCN
- CALL BUDGET ( UNPACK(ZNFS(:,JL),MASK=GNEGT(:,:,:),FIELD=PNFS(:,:,:,JL))*PRHODJ(:,:,:),&
+ CALL BUDGET_DDH ( UNPACK(ZNFS(:,JL),MASK=GNEGT(:,:,:),FIELD=PNFS(:,:,:,JL))*PRHODJ(:,:,:),&
& 12+NSV_LIMA_CCN_FREE+JL-1,'HONH_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END DO
- CALL BUDGET (ZNHS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_HOM_HAZE,'HONH_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZNHS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_HOM_HAZE,'HONH_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END IF
END IF
END IF
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HONC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'HONC_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HONC_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HONC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7,'HONC_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HONC_BU_RRI',YDDDH, YDLDDH, YDMDDH)
IF (LBUDGET_SV) THEN
- CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'HONC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'HONC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'HONC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'HONC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END IF
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HONR_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'HONR_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'HONR_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'HONR_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HONR_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8,'HONR_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'HONR_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_SV) CALL BUDGET_DDH (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'HONR_BU_RSV',YDDDH, YDLDDH, YDMDDH)
diff --git a/src/arome/micro/lima_cold_slow_processes.F90 b/src/arome/micro/lima_cold_slow_processes.F90
index 3792940c327c6936163560a9dcc74e4bd2b31ffa..dda09872cbf3ef68cd4e09fac8e9bf801c845346 100644
--- a/src/arome/micro/lima_cold_slow_processes.F90
+++ b/src/arome/micro/lima_cold_slow_processes.F90
@@ -112,7 +112,7 @@ USE MODD_PARAM_LIMA_COLD, ONLY : XLBI, XLBEXI, XLBS, XLBEXS, XBI, XCXS, XCCS, &
USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
USE MODD_BUDGET
USE MODD_NSV, ONLY : NSV_LIMA_NI
-USE MODI_BUDGET
+USE MODI_BUDGET_DDH
USE DDH_MIX, ONLY : TYP_DDH
USE YOMLDDH, ONLY : TLDDH
@@ -379,13 +379,13 @@ IF( IMICRO >= 1 ) THEN
!
! Budget storage
IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_RI) CALL BUDGET ( &
+ IF (LBUDGET_RI) CALL BUDGET_DDH ( &
UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
9,'CNVI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET ( &
+ IF (LBUDGET_RS) CALL BUDGET_DDH ( &
UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:),&
10,'CNVI_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET ( &
+ IF (LBUDGET_SV) CALL BUDGET_DDH ( &
UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
12+NSV_LIMA_NI,'CNVI_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END IF
@@ -410,13 +410,13 @@ IF( IMICRO >= 1 ) THEN
!
! Budget storage
IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
+ IF (LBUDGET_TH) CALL BUDGET_DDH ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
4,'DEPS_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET ( &
+ IF (LBUDGET_RV) CALL BUDGET_DDH ( &
UNPACK(ZRVS(:),MASK=GMICRO(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:),&
6,'DEPS_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET ( &
+ IF (LBUDGET_RS) CALL BUDGET_DDH ( &
UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:),&
10,'DEPS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
END IF
@@ -446,13 +446,13 @@ IF( IMICRO >= 1 ) THEN
!
! Budget storage
IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_RI) CALL BUDGET ( &
+ IF (LBUDGET_RI) CALL BUDGET_DDH ( &
UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
9,'CNVS_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET ( &
+ IF (LBUDGET_RS) CALL BUDGET_DDH ( &
UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:),&
10,'CNVS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET ( &
+ IF (LBUDGET_SV) CALL BUDGET_DDH ( &
UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
12+NSV_LIMA_NI,'CNVS_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END IF
@@ -478,13 +478,13 @@ IF( IMICRO >= 1 ) THEN
!
! Budget storage
IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_RI) CALL BUDGET ( &
+ IF (LBUDGET_RI) CALL BUDGET_DDH ( &
UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
9,'AGGS_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET ( &
+ IF (LBUDGET_RS) CALL BUDGET_DDH ( &
UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
10,'AGGS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET ( &
+ IF (LBUDGET_SV) CALL BUDGET_DDH ( &
UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
12+NSV_LIMA_NI,'AGGS_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END IF
@@ -548,30 +548,30 @@ ELSE
IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
IF (LBUDGET_TH) THEN
ZW(:,:,:) = PTHS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,4,'DEPS_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZW,4,'DEPS_BU_RTH',YDDDH, YDLDDH, YDMDDH)
ENDIF
IF (LBUDGET_RV) THEN
ZW(:,:,:) = PRVS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,6,'DEPS_BU_RRV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZW,6,'DEPS_BU_RRV',YDDDH, YDLDDH, YDMDDH)
ENDIF
IF (LBUDGET_RI) THEN
ZW(:,:,:) = PRIS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,9,'CNVI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET (ZW,9,'CNVS_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET (ZW,9,'AGGS_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZW,9,'CNVI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZW,9,'CNVS_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZW,9,'AGGS_BU_RRI',YDDDH, YDLDDH, YDMDDH)
ENDIF
IF (LBUDGET_RS) THEN
ZW(:,:,:) = PRSS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,10,'CNVI_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET (ZW,10,'DEPS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET (ZW,10,'CNVS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET (ZW,10,'AGGS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZW,10,'CNVI_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZW,10,'DEPS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZW,10,'CNVS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZW,10,'AGGS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
ENDIF
IF (LBUDGET_SV) THEN
ZW(:,:,:) = PCIS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,12+NSV_LIMA_NI,'CNVI_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET (ZW,12+NSV_LIMA_NI,'CNVS_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET (ZW,12+NSV_LIMA_NI,'AGGS_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZW,12+NSV_LIMA_NI,'CNVI_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZW,12+NSV_LIMA_NI,'CNVS_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZW,12+NSV_LIMA_NI,'AGGS_BU_RSV',YDDDH, YDLDDH, YDMDDH)
ENDIF
ENDIF
!
diff --git a/src/arome/micro/lima_meyers.F90 b/src/arome/micro/lima_meyers.F90
index ed4e749644a524b2f810879446fa638af1f97a67..06ac11de3917f156d4506e0c2d7ff776b080c799 100644
--- a/src/arome/micro/lima_meyers.F90
+++ b/src/arome/micro/lima_meyers.F90
@@ -126,7 +126,7 @@ USE MODD_CST
USE MODD_PARAM_LIMA
USE MODD_PARAM_LIMA_COLD
USE MODD_BUDGET
-USE MODI_BUDGET
+USE MODI_BUDGET_DDH
USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NI
!
USE DDH_MIX, ONLY : TYP_DDH
@@ -357,17 +357,17 @@ IF( INEGT >= 1 ) THEN
!
! Budget storage
IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
+ IF (LBUDGET_TH) CALL BUDGET_DDH ( &
UNPACK(ZTHS(:),MASK=GNEGT(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
4,'HIND_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET ( &
+ IF (LBUDGET_RV) CALL BUDGET_DDH ( &
UNPACK(ZRVS(:),MASK=GNEGT(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:),&
6,'HIND_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET ( &
+ IF (LBUDGET_RI) CALL BUDGET_DDH ( &
UNPACK(ZRIS(:),MASK=GNEGT(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
9,'HIND_BU_RRI',YDDDH, YDLDDH, YDMDDH)
IF (LBUDGET_SV) THEN
- CALL BUDGET ( UNPACK(ZCIS(:),MASK=GNEGT(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:),&
+ CALL BUDGET_DDH ( UNPACK(ZCIS(:),MASK=GNEGT(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:),&
12+NSV_LIMA_NI,'HIND_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END IF
END IF
@@ -415,12 +415,12 @@ IF( INEGT >= 1 ) THEN
!
! Budget storage
IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:), 4,'HINC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:), 7,'HINC_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:), 9,'HINC_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:), 4,'HINC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:), 7,'HINC_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:), 9,'HINC_BU_RRI',YDDDH, YDLDDH, YDMDDH)
IF (LBUDGET_SV) THEN
- CALL BUDGET ( PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'HINC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET ( PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'HINC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH ( PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'HINC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH ( PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'HINC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END IF
END IF
@@ -461,17 +461,17 @@ ELSE
! Advance the budget calls
!
IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HIND_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),6,'HIND_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HIND_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'HIND_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HIND_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RV) CALL BUDGET_DDH (PRVS(:,:,:)*PRHODJ(:,:,:),6,'HIND_BU_RRV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HIND_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_SV) CALL BUDGET_DDH (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'HIND_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HINC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'HINC_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HINC_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HINC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7,'HINC_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HINC_BU_RRI',YDDDH, YDLDDH, YDMDDH)
IF (LBUDGET_SV) THEN
- CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'HINC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'HINC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'HINC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'HINC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END IF
END IF
!
diff --git a/src/arome/micro/lima_meyers_nucleation.F90 b/src/arome/micro/lima_meyers_nucleation.F90
index 03bef71a66a4e083ddf8525fa3871968c8196232..f27af7a6b0bf2db32269a824c12e45c2bd382d1e 100644
--- a/src/arome/micro/lima_meyers_nucleation.F90
+++ b/src/arome/micro/lima_meyers_nucleation.F90
@@ -108,7 +108,7 @@ USE MODD_CST
USE MODD_PARAM_LIMA
USE MODD_PARAM_LIMA_COLD
USE MODD_BUDGET
-USE MODI_BUDGET
+USE MODI_BUDGET_DDH
USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NI
!
USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
diff --git a/src/arome/micro/lima_mixed.F90 b/src/arome/micro/lima_mixed.F90
index e9d05c37085de3f3b80ea6bea06b09c2c59ef780..1e073298670d6a1748283c507a900ed5d968af18 100644
--- a/src/arome/micro/lima_mixed.F90
+++ b/src/arome/micro/lima_mixed.F90
@@ -123,7 +123,7 @@ USE MODD_PARAM_LIMA_MIXED, ONLY : XLBG, XLBEXG, XLBH, XLBEXH
USE MODD_NSV
!
USE MODD_BUDGET
-USE MODI_BUDGET
+USE MODI_BUDGET_DDH
!
USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
USE MODI_LIMA_MIXED_SLOW_PROCESSES
@@ -675,95 +675,95 @@ ELSE
!
IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'DEPG_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),6,'DEPG_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'DEPG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'DEPG_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RV) CALL BUDGET_DDH (PRVS(:,:,:)*PRHODJ(:,:,:),6,'DEPG_BU_RRV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'DEPG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'IMLT_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'IMLT_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'IMLT_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'IMLT_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'IMLT_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'IMLT_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7,'IMLT_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'IMLT_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_SV) CALL BUDGET_DDH (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'IMLT_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_SV) CALL BUDGET_DDH (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'IMLT_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'BERFI_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'BERFI_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'BERFI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'BERFI_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7,'BERFI_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'BERFI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'RIM_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'RIM_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'RIM_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'RIM_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'RIM_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'RIM_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7,'RIM_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RS) CALL BUDGET_DDH (PRSS(:,:,:)*PRHODJ(:,:,:),10,'RIM_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'RIM_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_SV) CALL BUDGET_DDH (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'RIM_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HMS_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'HMS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'HMS_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HMS_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RS) CALL BUDGET_DDH (PRSS(:,:,:)*PRHODJ(:,:,:),10,'HMS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_SV) CALL BUDGET_DDH (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'HMS_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'ACC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'ACC_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'ACC_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'ACC_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'ACC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'ACC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8,'ACC_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RS) CALL BUDGET_DDH (PRSS(:,:,:)*PRHODJ(:,:,:),10,'ACC_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'ACC_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_SV) CALL BUDGET_DDH (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'ACC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'CMEL_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'CMEL_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RS) CALL BUDGET_DDH (PRSS(:,:,:)*PRHODJ(:,:,:),10,'CMEL_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'CMEL_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'CFRZ_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'CFRZ_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'CFRZ_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'CFRZ_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'CFRZ_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'CFRZ_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'CFRZ_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8,'CFRZ_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'CFRZ_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'CFRZ_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_SV) CALL BUDGET_DDH (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'CFRZ_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_SV) CALL BUDGET_DDH (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'CFRZ_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'WETG_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'WETG_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'WETG_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'WETG_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'WETG_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'WETG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:),12,'WETG_BU_RRH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'WETG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'WETG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'WETG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'WETG_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7,'WETG_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8,'WETG_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'WETG_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RS) CALL BUDGET_DDH (PRSS(:,:,:)*PRHODJ(:,:,:),10,'WETG_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'WETG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RH) CALL BUDGET_DDH (PRHS(:,:,:)*PRHODJ(:,:,:),12,'WETG_BU_RRH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_SV) CALL BUDGET_DDH (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'WETG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_SV) CALL BUDGET_DDH (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'WETG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_SV) CALL BUDGET_DDH (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'WETG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'DRYG_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'DRYG_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'DRYG_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'DRYG_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'DRYG_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'DRYG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'DRYG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'DRYG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'DRYG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'DRYG_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7,'DRYG_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8,'DRYG_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'DRYG_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RS) CALL BUDGET_DDH (PRSS(:,:,:)*PRHODJ(:,:,:),10,'DRYG_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'DRYG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_SV) CALL BUDGET_DDH (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'DRYG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_SV) CALL BUDGET_DDH (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'DRYG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_SV) CALL BUDGET_DDH (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'DRYG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HMG_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'HMG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'HMG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HMG_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'HMG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_SV) CALL BUDGET_DDH (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'HMG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'GMLT_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'GMLT_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'GMLT_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'GMLT_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'GMLT_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8,'GMLT_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'GMLT_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_SV) CALL BUDGET_DDH (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'GMLT_BU_RSV',YDDDH, YDLDDH, YDMDDH)
IF (LHAIL_LIMA) THEN
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'WETH_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'WETH_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'WETH_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'WETH_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'WETH_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'WETH_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:),12,'WETH_BU_RRH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'WETH_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'WETH_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'WETH_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'WETH_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7,'WETH_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8,'WETH_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'WETH_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RS) CALL BUDGET_DDH (PRSS(:,:,:)*PRHODJ(:,:,:),10,'WETH_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'WETH_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RH) CALL BUDGET_DDH (PRHS(:,:,:)*PRHODJ(:,:,:),12,'WETH_BU_RRH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_SV) CALL BUDGET_DDH (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'WETH_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_SV) CALL BUDGET_DDH (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'WETH_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_SV) CALL BUDGET_DDH (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'WETH_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'COHG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:),12,'COHG_BU_RRH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'COHG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RH) CALL BUDGET_DDH (PRHS(:,:,:)*PRHODJ(:,:,:),12,'COHG_BU_RRH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HMLT_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'HMLT_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:),12,'HMLT_BU_RRH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'HMLT_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HMLT_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8,'HMLT_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RH) CALL BUDGET_DDH (PRHS(:,:,:)*PRHODJ(:,:,:),12,'HMLT_BU_RRH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_SV) CALL BUDGET_DDH (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'HMLT_BU_RSV',YDDDH, YDLDDH, YDMDDH)
ENDIF
ENDIF
diff --git a/src/arome/micro/lima_mixed_fast_processes.F90 b/src/arome/micro/lima_mixed_fast_processes.F90
index a0197e5fb99522cb536ab3017a075a58ffcddc61..d50dbd2d47e782471eca6b3766119cbc3f7f6089 100644
--- a/src/arome/micro/lima_mixed_fast_processes.F90
+++ b/src/arome/micro/lima_mixed_fast_processes.F90
@@ -160,7 +160,7 @@ USE MODD_PARAM_LIMA_MIXED
!
USE MODD_NSV
USE MODD_BUDGET
-USE MODI_BUDGET
+USE MODI_BUDGET_DDH
!
USE DDH_MIX, ONLY : TYP_DDH
USE YOMLDDH, ONLY : TLDDH
@@ -341,20 +341,20 @@ END IF
!
! Budget storage
IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
+ IF (LBUDGET_TH) CALL BUDGET_DDH ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
4,'RIM_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET ( &
+ IF (LBUDGET_RC) CALL BUDGET_DDH ( &
UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
7,'RIM_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET ( &
+ IF (LBUDGET_RS) CALL BUDGET_DDH ( &
UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
10,'RIM_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET ( &
+ IF (LBUDGET_RG) CALL BUDGET_DDH ( &
UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
11,'RIM_BU_RRG',YDDDH, YDLDDH, YDMDDH)
IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:), &
+ CALL BUDGET_DDH (UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:), &
12+NSV_LIMA_NC,'RIM_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END IF
END IF
@@ -398,13 +398,13 @@ END IF
!
! Budget storage
IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_RI) CALL BUDGET ( &
+ IF (LBUDGET_RI) CALL BUDGET_DDH ( &
UNPACK(ZRIS(:),MASK=GMICRO,FIELD=PRIS)*PRHODJ(:,:,:), &
9,'HMS_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET ( &
+ IF (LBUDGET_RS) CALL BUDGET_DDH ( &
UNPACK(ZRSS(:),MASK=GMICRO,FIELD=PRSS)*PRHODJ(:,:,:), &
10,'HMS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET ( &
+ IF (LBUDGET_SV) CALL BUDGET_DDH ( &
UNPACK(ZCIS(:),MASK=GMICRO,FIELD=PCIS)*PRHODJ(:,:,:), &
12+NSV_LIMA_NI,'HMS_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END IF
@@ -527,20 +527,20 @@ IF( IGACC>0 ) THEN
END IF
!
IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
+ IF (LBUDGET_TH) CALL BUDGET_DDH ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
4,'ACC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET ( &
+ IF (LBUDGET_RR) CALL BUDGET_DDH ( &
UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
8,'ACC_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET ( &
+ IF (LBUDGET_RS) CALL BUDGET_DDH ( &
UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
10,'ACC_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET ( &
+ IF (LBUDGET_RG) CALL BUDGET_DDH ( &
UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
11,'ACC_BU_RRG',YDDDH, YDLDDH, YDMDDH)
IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
+ CALL BUDGET_DDH (UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
12+NSV_LIMA_NR,'ACC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END IF
END IF
@@ -575,10 +575,10 @@ END WHERE
!
! Budget storage
IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_RS) CALL BUDGET ( &
+ IF (LBUDGET_RS) CALL BUDGET_DDH ( &
UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
10,'CMEL_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET ( &
+ IF (LBUDGET_RG) CALL BUDGET_DDH ( &
UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
11,'CMEL_BU_RRG',YDDDH, YDLDDH, YDMDDH)
END IF
@@ -615,22 +615,22 @@ WHERE( (ZRIT(:)>XRTMIN(4)) .AND. (ZRRT(:)>XRTMIN(3)) .AND. (ZRIS(:)>XRTMIN(4)/PT
END WHERE
!
IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
+ IF (LBUDGET_TH) CALL BUDGET_DDH ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
4,'CFRZ_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET ( &
+ IF (LBUDGET_RR) CALL BUDGET_DDH ( &
UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
8,'CFRZ_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET ( &
+ IF (LBUDGET_RI) CALL BUDGET_DDH ( &
UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
9,'CFRZ_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET ( &
+ IF (LBUDGET_RG) CALL BUDGET_DDH ( &
UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
11,'CFRZ_BU_RRG',YDDDH, YDLDDH, YDMDDH)
IF (LBUDGET_SV) THEN
- CALL BUDGET ( UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
+ CALL BUDGET_DDH ( UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
12+NSV_LIMA_NR,'CFRZ_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET ( UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
+ CALL BUDGET_DDH ( UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
12+NSV_LIMA_NI,'CFRZ_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END IF
END IF
@@ -851,33 +851,33 @@ END WHERE
!
! Budget storage
IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
+ IF (LBUDGET_TH) CALL BUDGET_DDH ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
4,'WETG_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET ( &
+ IF (LBUDGET_RC) CALL BUDGET_DDH ( &
UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
7,'WETG_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET ( &
+ IF (LBUDGET_RR) CALL BUDGET_DDH ( &
UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
8,'WETG_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET ( &
+ IF (LBUDGET_RI) CALL BUDGET_DDH ( &
UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
9,'WETG_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET ( &
+ IF (LBUDGET_RS) CALL BUDGET_DDH ( &
UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
10,'WETG_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET ( &
+ IF (LBUDGET_RG) CALL BUDGET_DDH ( &
UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
11,'WETG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET ( &
+ IF (LBUDGET_RH) CALL BUDGET_DDH ( &
UNPACK(ZRHS(:),MASK=GMICRO(:,:,:),FIELD=PRHS)*PRHODJ(:,:,:), &
12,'WETG_BU_RRH',YDDDH, YDLDDH, YDMDDH)
IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:), &
+ CALL BUDGET_DDH (UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:), &
12+NSV_LIMA_NC,'WETG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET (UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
+ CALL BUDGET_DDH (UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
12+NSV_LIMA_NR,'WETG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET (UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
+ CALL BUDGET_DDH (UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
12+NSV_LIMA_NI,'WETG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END IF
END IF
@@ -902,30 +902,30 @@ END WHERE
!
! Budget storage
IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
+ IF (LBUDGET_TH) CALL BUDGET_DDH ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
4,'DRYG_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET ( &
+ IF (LBUDGET_RC) CALL BUDGET_DDH ( &
UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
7,'DRYG_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET ( &
+ IF (LBUDGET_RR) CALL BUDGET_DDH ( &
UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
8,'DRYG_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET ( &
+ IF (LBUDGET_RI) CALL BUDGET_DDH ( &
UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
9,'DRYG_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET ( &
+ IF (LBUDGET_RS) CALL BUDGET_DDH ( &
UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
10,'DRYG_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET ( &
+ IF (LBUDGET_RG) CALL BUDGET_DDH ( &
UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
11,'DRYG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
IF (LBUDGET_SV) THEN
- CALL BUDGET ( UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:), &
+ CALL BUDGET_DDH ( UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:), &
12+NSV_LIMA_NC,'DRYG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET ( UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
+ CALL BUDGET_DDH ( UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
12+NSV_LIMA_NR,'DRYG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET ( UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
+ CALL BUDGET_DDH ( UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
12+NSV_LIMA_NI,'DRYG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END IF
END IF
@@ -968,13 +968,13 @@ END IF
!
! Budget storage
IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_RI) CALL BUDGET ( &
+ IF (LBUDGET_RI) CALL BUDGET_DDH ( &
UNPACK(ZRIS(:),MASK=GMICRO,FIELD=PRIS)*PRHODJ(:,:,:), &
9,'HMG_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET ( &
+ IF (LBUDGET_RG) CALL BUDGET_DDH ( &
UNPACK(ZRGS(:),MASK=GMICRO,FIELD=PRGS)*PRHODJ(:,:,:), &
11,'HMG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET ( &
+ IF (LBUDGET_SV) CALL BUDGET_DDH ( &
UNPACK(ZCIS(:),MASK=GMICRO,FIELD=PCIS)*PRHODJ(:,:,:), &
12+NSV_LIMA_NI,'HMG_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END IF
@@ -1009,17 +1009,17 @@ WHERE( (ZRGT(:)>XRTMIN(6)) .AND. (ZRGS(:)>XRTMIN(6)/PTSTEP) .AND. (ZZT(:)>XTT) )
END WHERE
!
IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
+ IF (LBUDGET_TH) CALL BUDGET_DDH ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
4,'GMLT_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET ( &
+ IF (LBUDGET_RR) CALL BUDGET_DDH ( &
UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
8,'GMLT_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET ( &
+ IF (LBUDGET_RG) CALL BUDGET_DDH ( &
UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
11,'GMLT_BU_RRG',YDDDH, YDLDDH, YDMDDH)
IF (LBUDGET_SV) THEN
- CALL BUDGET ( UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
+ CALL BUDGET_DDH ( UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
12+NSV_LIMA_NR,'GMLT_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END IF
END IF
@@ -1228,33 +1228,33 @@ END IF ! IHAIL>0
!
!
IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
+ IF (LBUDGET_TH) CALL BUDGET_DDH ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
4,'WETH_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET ( &
+ IF (LBUDGET_RC) CALL BUDGET_DDH ( &
UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
7,'WETH_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET ( &
+ IF (LBUDGET_RR) CALL BUDGET_DDH ( &
UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
8,'WETH_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET ( &
+ IF (LBUDGET_RI) CALL BUDGET_DDH ( &
UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
9,'WETH_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET ( &
+ IF (LBUDGET_RS) CALL BUDGET_DDH ( &
UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
10,'WETH_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET ( &
+ IF (LBUDGET_RG) CALL BUDGET_DDH ( &
UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
11,'WETH_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET ( &
+ IF (LBUDGET_RH) CALL BUDGET_DDH ( &
UNPACK(ZRHS(:),MASK=GMICRO(:,:,:),FIELD=PRHS)*PRHODJ(:,:,:), &
12,'WETH_BU_RRH',YDDDH, YDLDDH, YDMDDH)
IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:), &
+ CALL BUDGET_DDH (UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:), &
12+NSV_LIMA_NC,'WETH_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET (UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
+ CALL BUDGET_DDH (UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
12+NSV_LIMA_NR,'WETH_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET (UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
+ CALL BUDGET_DDH (UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
12+NSV_LIMA_NI,'WETH_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END IF
END IF
@@ -1283,10 +1283,10 @@ IF ( IHAIL>0 ) THEN
END IF
!
IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_RG) CALL BUDGET ( &
+ IF (LBUDGET_RG) CALL BUDGET_DDH ( &
UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
11,'COHG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET ( &
+ IF (LBUDGET_RH) CALL BUDGET_DDH ( &
UNPACK(ZRHS(:),MASK=GMICRO(:,:,:),FIELD=PRHS)*PRHODJ(:,:,:), &
12,'COHG_BU_RRH',YDDDH, YDLDDH, YDMDDH)
END IF
@@ -1319,17 +1319,17 @@ IF ( IHAIL>0 ) THEN
END IF
!
IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
+ IF (LBUDGET_TH) CALL BUDGET_DDH ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
4,'HMLT_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET ( &
+ IF (LBUDGET_RR) CALL BUDGET_DDH ( &
UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
8,'HMLT_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET ( &
+ IF (LBUDGET_RH) CALL BUDGET_DDH ( &
UNPACK(ZRHS(:),MASK=GMICRO(:,:,:),FIELD=PRHS)*PRHODJ(:,:,:), &
12,'HMLT_BU_RRH',YDDDH, YDLDDH, YDMDDH)
IF (LBUDGET_SV) THEN
- CALL BUDGET ( UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
+ CALL BUDGET_DDH ( UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
12+NSV_LIMA_NR,'HMLT_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END IF
END IF
diff --git a/src/arome/micro/lima_mixed_slow_processes.F90 b/src/arome/micro/lima_mixed_slow_processes.F90
index a086e4437878fdb235d2bc635661faaa57e83573..566145a72bbdfb947487ce4850d2d1e07d73604c 100644
--- a/src/arome/micro/lima_mixed_slow_processes.F90
+++ b/src/arome/micro/lima_mixed_slow_processes.F90
@@ -130,7 +130,7 @@ USE MODD_PARAM_LIMA_MIXED, ONLY : XLBG, XLBEXG, XLBDAG_MAX, &
!
USE MODD_NSV
USE MODD_BUDGET
-USE MODI_BUDGET
+USE MODI_BUDGET_DDH
!
USE DDH_MIX, ONLY : TYP_DDH
USE YOMLDDH, ONLY : TLDDH
@@ -211,13 +211,13 @@ INTEGER :: JMOD_IFN
!
! Budget storage
IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
+ IF (LBUDGET_TH) CALL BUDGET_DDH ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
4,'DEPG_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET ( &
+ IF (LBUDGET_RV) CALL BUDGET_DDH ( &
UNPACK(ZRVS(:),MASK=GMICRO(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:),&
6,'DEPG_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET ( &
+ IF (LBUDGET_RG) CALL BUDGET_DDH ( &
UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
11,'DEPG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
END IF
@@ -245,19 +245,19 @@ INTEGER :: JMOD_IFN
!
! Budget storage
IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
+ IF (LBUDGET_TH) CALL BUDGET_DDH ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
4,'IMLT_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET ( &
+ IF (LBUDGET_RC) CALL BUDGET_DDH ( &
UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
7,'IMLT_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET ( &
+ IF (LBUDGET_RI) CALL BUDGET_DDH ( &
UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
9,'IMLT_BU_RRI',YDDDH, YDLDDH, YDMDDH)
IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:), &
+ CALL BUDGET_DDH (UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:), &
12+NSV_LIMA_NC,'IMLT_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET (UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
+ CALL BUDGET_DDH (UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
12+NSV_LIMA_NI,'IMLT_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END IF
END IF
@@ -281,13 +281,13 @@ INTEGER :: JMOD_IFN
!
! Budget storage
IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
+ IF (LBUDGET_TH) CALL BUDGET_DDH ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
4,'BERFI_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET ( &
+ IF (LBUDGET_RC) CALL BUDGET_DDH ( &
UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
7,'BERFI_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET ( &
+ IF (LBUDGET_RI) CALL BUDGET_DDH ( &
UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
9,'BERFI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
END IF
diff --git a/src/arome/micro/lima_nucleation_procs.F90 b/src/arome/micro/lima_nucleation_procs.F90
index 81b6c9e5b09d2c20d3e5d0a7230148b4d3db7a71..a00ee56f72bf754c0e0129edb85e35f3a0218933 100644
--- a/src/arome/micro/lima_nucleation_procs.F90
+++ b/src/arome/micro/lima_nucleation_procs.F90
@@ -68,7 +68,7 @@ USE MODD_BUDGET, ONLY : LBU_ENABLE, LBUDGET_TH, LBUDGET_RV, LBUDGET_RC, LBUD
USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_CCN_FREE, &
NSV_LIMA_NI, NSV_LIMA_IFN_FREE
!
-USE MODI_BUDGET
+USE MODI_BUDGET_DDH
USE MODI_LIMA_CCN_ACTIVATION
USE MODI_LIMA_PHILLIPS_IFN_NUCLEATION
USE MODI_LIMA_MEYERS_NUCLEATION
@@ -165,14 +165,14 @@ IF (LWARM_LIMA .AND. LACTI_LIMA) THEN
! Call budgets
!
IF (LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET (PTHT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, 4, 'HENU_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET (PRVT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, 6, 'HENU_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET (PRCT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, 7, 'HENU_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, 4, 'HENU_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RV) CALL BUDGET_DDH (PRVT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, 6, 'HENU_BU_RRV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RC) CALL BUDGET_DDH (PRCT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, 7, 'HENU_BU_RRC',YDDDH, YDLDDH, YDMDDH)
IF (LBUDGET_SV) THEN
- CALL BUDGET (PCCT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, 12+NSV_LIMA_NC, 'HENU_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PCCT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, 12+NSV_LIMA_NC, 'HENU_BU_RSV',YDDDH, YDLDDH, YDMDDH)
IF (NMOD_CCN.GE.1) THEN
DO JL=1, NMOD_CCN
- CALL BUDGET (PNFT(:,:,:,JL)*PRHODJ(:,:,:)/PTSTEP,12+NSV_LIMA_CCN_FREE+JL-1,'HENU_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PNFT(:,:,:,JL)*PRHODJ(:,:,:)/PTSTEP,12+NSV_LIMA_CCN_FREE+JL-1,'HENU_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END DO
END IF
END IF
@@ -192,24 +192,24 @@ IF (LCOLD_LIMA .AND. LNUCL_LIMA .AND. .NOT.LMEYERS_LIMA .AND. NMOD_IFN.GE.1) THE
! Call budgets
!
IF (LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ((PTHT(:,:,:)+Z_TH_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,4, 'HIND_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET ((PRVT(:,:,:)-Z_RI_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,6, 'HIND_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET ((PRIT(:,:,:)+Z_RI_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,9, 'HIND_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH ((PTHT(:,:,:)+Z_TH_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,4, 'HIND_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RV) CALL BUDGET_DDH ((PRVT(:,:,:)-Z_RI_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,6, 'HIND_BU_RRV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RI) CALL BUDGET_DDH ((PRIT(:,:,:)+Z_RI_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,9, 'HIND_BU_RRI',YDDDH, YDLDDH, YDMDDH)
IF (LBUDGET_SV) THEN
- CALL BUDGET ((PCIT(:,:,:)+Z_CI_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,12+NSV_LIMA_NI, 'HIND_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH ((PCIT(:,:,:)+Z_CI_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,12+NSV_LIMA_NI, 'HIND_BU_RSV',YDDDH, YDLDDH, YDMDDH)
IF (NMOD_IFN.GE.1) THEN
DO JL=1, NMOD_IFN
- CALL BUDGET ((ZIFT(:,:,:,JL))*PRHODJ(:,:,:)/PTSTEP, 12+NSV_LIMA_IFN_FREE+JL-1,'HIND_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH ((ZIFT(:,:,:,JL))*PRHODJ(:,:,:)/PTSTEP, 12+NSV_LIMA_IFN_FREE+JL-1,'HIND_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END DO
END IF
END IF
!
- IF (LBUDGET_TH) CALL BUDGET (ZTHT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,4,'HINC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET (ZRCT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,7,'HINC_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET (ZRIT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,9,'HINC_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (ZTHT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,4,'HINC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RC) CALL BUDGET_DDH (ZRCT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,7,'HINC_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RI) CALL BUDGET_DDH (ZRIT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,9,'HINC_BU_RRI',YDDDH, YDLDDH, YDMDDH)
IF (LBUDGET_SV) THEN
- CALL BUDGET (ZCCT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,12+NSV_LIMA_NC,'HINC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET (ZCIT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,12+NSV_LIMA_NI,'HINC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZCCT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,12+NSV_LIMA_NC,'HINC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZCIT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,12+NSV_LIMA_NI,'HINC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END IF
END IF
!
@@ -238,17 +238,17 @@ IF (LCOLD_LIMA .AND. LNUCL_LIMA .AND. LMEYERS_LIMA) THEN
! Call budgets
!
IF (LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ((PTHT(:,:,:)+Z_TH_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,4, 'HIND_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET ((PRVT(:,:,:)-Z_RI_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,6, 'HIND_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET ((PRIT(:,:,:)+Z_RI_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,9, 'HIND_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET ((PCIT(:,:,:)+Z_CI_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,12+NSV_LIMA_NI,'HIND_BU_RSV',YDDDH, YDLDDH, YDMDDH)
-!
- IF (LBUDGET_TH) CALL BUDGET (ZTHT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,4,'HINC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET (ZRCT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,7,'HINC_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET (ZRIT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,9,'HINC_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH ((PTHT(:,:,:)+Z_TH_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,4, 'HIND_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RV) CALL BUDGET_DDH ((PRVT(:,:,:)-Z_RI_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,6, 'HIND_BU_RRV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RI) CALL BUDGET_DDH ((PRIT(:,:,:)+Z_RI_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,9, 'HIND_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_SV) CALL BUDGET_DDH ((PCIT(:,:,:)+Z_CI_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,12+NSV_LIMA_NI,'HIND_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+!
+ IF (LBUDGET_TH) CALL BUDGET_DDH (ZTHT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,4,'HINC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RC) CALL BUDGET_DDH (ZRCT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,7,'HINC_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RI) CALL BUDGET_DDH (ZRIT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,9,'HINC_BU_RRI',YDDDH, YDLDDH, YDMDDH)
IF (LBUDGET_SV) THEN
- CALL BUDGET (ZCCT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,12+NSV_LIMA_NC,'HINC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET (ZCIT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,12+NSV_LIMA_NI,'HINC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZCCT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,12+NSV_LIMA_NC,'HINC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZCIT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,12+NSV_LIMA_NI,'HINC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END IF
END IF
!
@@ -272,14 +272,14 @@ IF (LCOLD_LIMA .AND. LHHONI_LIMA .AND. NMOD_CCN.GE.1) THEN
! Call budgets
!
IF (LBU_ENABLE .AND. LHHONI_LIMA) THEN
- IF (LBUDGET_TH) CALL BUDGET (ZTHT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, 4, 'HONH_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET (ZRVT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, 6, 'HONH_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET (ZRIT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, 9, 'HONH_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (ZTHT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, 4, 'HONH_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RV) CALL BUDGET_DDH (ZRVT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, 6, 'HONH_BU_RRV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RI) CALL BUDGET_DDH (ZRIT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, 9, 'HONH_BU_RRI',YDDDH, YDLDDH, YDMDDH)
IF (LBUDGET_SV) THEN
- CALL BUDGET (ZCIT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, 12+NSV_LIMA_NI, 'HONH_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZCIT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, 12+NSV_LIMA_NI, 'HONH_BU_RSV',YDDDH, YDLDDH, YDMDDH)
IF (NMOD_CCN.GE.1) THEN
DO JL=1, NMOD_CCN
- CALL BUDGET (ZNFT(:,:,:,JL)*PRHODJ(:,:,:)/PTSTEP,12+NSV_LIMA_CCN_FREE+JL-1,'HONH_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (ZNFT(:,:,:,JL)*PRHODJ(:,:,:)/PTSTEP,12+NSV_LIMA_CCN_FREE+JL-1,'HONH_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END DO
END IF
END IF
diff --git a/src/arome/micro/lima_phillips.F90 b/src/arome/micro/lima_phillips.F90
index 63b44a28bb7738eb907964f412f78394616f9569..9726b5c920f9e345fbdc020034e58ffe2ad348d1 100644
--- a/src/arome/micro/lima_phillips.F90
+++ b/src/arome/micro/lima_phillips.F90
@@ -145,7 +145,7 @@ USE MODI_LIMA_PHILLIPS_REF_SPECTRUM
USE MODI_LIMA_PHILLIPS_INTEG
!
USE MODD_BUDGET
-USE MODI_BUDGET
+USE MODI_BUDGET_DDH
USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NI, NSV_LIMA_IFN_FREE
!
USE DDH_MIX, ONLY : TYP_DDH
@@ -489,21 +489,21 @@ END DO
!
! Budget storage
IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
+ IF (LBUDGET_TH) CALL BUDGET_DDH ( &
UNPACK(ZTHS(:),MASK=GNEGT(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
4,'HIND_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET ( &
+ IF (LBUDGET_RV) CALL BUDGET_DDH ( &
UNPACK(ZRVS(:),MASK=GNEGT(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:),&
6,'HIND_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET ( &
+ IF (LBUDGET_RI) CALL BUDGET_DDH ( &
UNPACK(ZRIS(:),MASK=GNEGT(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
9,'HIND_BU_RRI',YDDDH, YDLDDH, YDMDDH)
IF (LBUDGET_SV) THEN
- CALL BUDGET ( UNPACK(ZCIS(:),MASK=GNEGT(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:),&
+ CALL BUDGET_DDH ( UNPACK(ZCIS(:),MASK=GNEGT(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:),&
12+NSV_LIMA_NI,'HIND_BU_RSV',YDDDH, YDLDDH, YDMDDH)
IF (NMOD_IFN.GE.1) THEN
DO JL=1, NMOD_IFN
- CALL BUDGET ( PIFS(:,:,:,JL)*PRHODJ(:,:,:),12+NSV_LIMA_IFN_FREE+JL-1,'HIND_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH ( PIFS(:,:,:,JL)*PRHODJ(:,:,:),12+NSV_LIMA_IFN_FREE+JL-1,'HIND_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END DO
END IF
END IF
@@ -559,19 +559,19 @@ END DO
!
! Budget storage
IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
+ IF (LBUDGET_TH) CALL BUDGET_DDH ( &
UNPACK(ZTHS(:),MASK=GNEGT(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
4,'HINC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET ( &
+ IF (LBUDGET_RC) CALL BUDGET_DDH ( &
UNPACK(ZRCS(:),MASK=GNEGT(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:),&
7,'HINC_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET ( &
+ IF (LBUDGET_RI) CALL BUDGET_DDH ( &
UNPACK(ZRIS(:),MASK=GNEGT(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
9,'HINC_BU_RRI',YDDDH, YDLDDH, YDMDDH)
IF (LBUDGET_SV) THEN
- CALL BUDGET ( UNPACK(ZCCS(:),MASK=GNEGT(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:),&
+ CALL BUDGET_DDH ( UNPACK(ZCCS(:),MASK=GNEGT(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:),&
12+NSV_LIMA_NC,'HINC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET ( UNPACK(ZCIS(:),MASK=GNEGT(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:),&
+ CALL BUDGET_DDH ( UNPACK(ZCIS(:),MASK=GNEGT(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:),&
12+NSV_LIMA_NI,'HINC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END IF
END IF
@@ -644,26 +644,26 @@ ELSE
! Advance the budget calls
!
IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HIND_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),6,'HIND_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HIND_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HIND_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RV) CALL BUDGET_DDH (PRVS(:,:,:)*PRHODJ(:,:,:),6,'HIND_BU_RRV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HIND_BU_RRI',YDDDH, YDLDDH, YDMDDH)
IF (LBUDGET_SV) THEN
!print*, 'LBUDGET_SV dans lima_phillips = ', LBUDGET_SV
- CALL BUDGET (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'HIND_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'HIND_BU_RSV',YDDDH, YDLDDH, YDMDDH)
IF (NMOD_IFN.GE.1) THEN
DO JL=1, NMOD_IFN
- CALL BUDGET ( PIFS(:,:,:,JL)*PRHODJ(:,:,:),12+NSV_LIMA_IFN_FREE+JL-1,'HIND_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH ( PIFS(:,:,:,JL)*PRHODJ(:,:,:),12+NSV_LIMA_IFN_FREE+JL-1,'HIND_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END DO
END IF
END IF
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HINC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'HINC_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HINC_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HINC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7,'HINC_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HINC_BU_RRI',YDDDH, YDLDDH, YDMDDH)
IF (LBUDGET_SV) THEN
!print*, 'LBUDGET_SV dans lima_phillips = ', LBUDGET_SV
- CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'HINC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- CALL BUDGET (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'HINC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'HINC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'HINC_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END IF
END IF
!
diff --git a/src/arome/micro/lima_phillips_ifn_nucleation.F90 b/src/arome/micro/lima_phillips_ifn_nucleation.F90
index 7f1100d55d847f7835eae86956b4bc5ab375b277..a86129119290962d62c07450ddb28a0101db6b02 100644
--- a/src/arome/micro/lima_phillips_ifn_nucleation.F90
+++ b/src/arome/micro/lima_phillips_ifn_nucleation.F90
@@ -120,7 +120,7 @@ USE MODI_LIMA_PHILLIPS_REF_SPECTRUM
USE MODI_LIMA_PHILLIPS_INTEG
!
USE MODD_BUDGET
-USE MODI_BUDGET
+USE MODI_BUDGET_DDH
USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NI, NSV_LIMA_IFN_FREE
!
!
diff --git a/src/arome/micro/lima_precip_scavenging.F90 b/src/arome/micro/lima_precip_scavenging.F90
index 808624d9855df6ade0fa8e14191d8676bf82806f..cafea718c39f7270556d40f32b3898b5b7e37bed 100644
--- a/src/arome/micro/lima_precip_scavenging.F90
+++ b/src/arome/micro/lima_precip_scavenging.F90
@@ -127,7 +127,7 @@ USE MODD_PARAM_LIMA, ONLY : NMOD_IFN, NSPECIE, XFRAC,
USE MODD_PARAM_LIMA_WARM, ONLY : XCR, XDR
!
USE MODD_BUDGET
-USE MODI_BUDGET
+USE MODI_BUDGET_DDH
!
IMPLICIT NONE
!
@@ -568,13 +568,13 @@ ENDDO
IF (LBUDGET_SV) THEN
IF (NMOD_CCN.GE.1) THEN
DO JL=1, NMOD_CCN
- CALL BUDGET ( PRSVS(:,:,:,NSV_LIMA_CCN_FREE+JL-1), &
+ CALL BUDGET_DDH ( PRSVS(:,:,:,NSV_LIMA_CCN_FREE+JL-1), &
12+NSV_LIMA_CCN_FREE+JL-1,'SCAV_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END DO
END IF
IF (NMOD_IFN.GE.1) THEN
DO JL=1, NMOD_IFN
- CALL BUDGET ( PRSVS(:,:,:,NSV_LIMA_IFN_FREE+JL-1), &
+ CALL BUDGET_DDH ( PRSVS(:,:,:,NSV_LIMA_IFN_FREE+JL-1), &
12+NSV_LIMA_IFN_FREE+JL-1,'SCAV_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END DO
END IF
diff --git a/src/arome/micro/lima_warm.F90 b/src/arome/micro/lima_warm.F90
index 0d9eb83125c74a8f27a273ee819c8fb0c4d1572e..1a74e7b2ef6d0b044332adc5c93d7e8ed447f440 100644
--- a/src/arome/micro/lima_warm.F90
+++ b/src/arome/micro/lima_warm.F90
@@ -146,7 +146,7 @@ USE MODD_NSV
!
!
USE MODD_BUDGET
-USE MODI_BUDGET
+USE MODI_BUDGET_DDH
!
USE MODE_FM
USE MODE_FMWRIT
@@ -337,12 +337,12 @@ CALL LIMA_WARM_SEDIMENTATION (OSEDC, KSPLITR, PTSTEP, KMI, &
PINPRR3D )
!
IF (LBUDGET_RC .AND. OSEDC) &
- CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'SEDI_BU_RRC',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'SEDI_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'SEDI_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'SEDI_BU_RRR',YDDDH, YDLDDH, YDMDDH)
IF (LBUDGET_SV) THEN
- IF (OSEDC) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,&
+ IF (OSEDC) CALL BUDGET_DDH (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,&
&'SEDI_BU_RSV',YDDDH, YDLDDH, YDMDDH) ! RCC
- IF (ORAIN) CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,&
+ IF (ORAIN) CALL BUDGET_DDH (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,&
&'SEDI_BU_RSV',YDDDH, YDLDDH, YDMDDH) ! RCR
END IF
!
@@ -360,14 +360,14 @@ IF (LACTI_LIMA) THEN
PRCM, PRVT, PRCT, PRRT, &
PTHS, PRVS, PRCS, PCCS, PNFS, PNAS )
!
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HENU_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),6,'HENU_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'HENU_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HENU_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RV) CALL BUDGET_DDH (PRVS(:,:,:)*PRHODJ(:,:,:),6,'HENU_BU_RRV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7,'HENU_BU_RRC',YDDDH, YDLDDH, YDMDDH)
IF (LBUDGET_SV) THEN
- CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'HENU_BU_RSV',YDDDH, YDLDDH, YDMDDH) ! RCN
+ CALL BUDGET_DDH (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'HENU_BU_RSV',YDDDH, YDLDDH, YDMDDH) ! RCN
IF (NMOD_CCN.GE.1) THEN
DO JL=1, NMOD_CCN
- CALL BUDGET ( PNFS(:,:,:,JL)*PRHODJ(:,:,:),12+NSV_LIMA_CCN_FREE+JL-1,'HENU_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH ( PNFS(:,:,:,JL)*PRHODJ(:,:,:),12+NSV_LIMA_CCN_FREE+JL-1,'HENU_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END DO
END IF
END IF
@@ -403,12 +403,12 @@ IF (ORAIN) THEN
PRVS, PRCS, PRRS, PCCS, PCRS, PTHS, &
PEVAP3D )
!
- IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),6 ,'REVA_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'REVA_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'REVA_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4 ,'REVA_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'REVA_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'REVA_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RV) CALL BUDGET_DDH (PRVS(:,:,:)*PRHODJ(:,:,:),6 ,'REVA_BU_RRV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'REVA_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'REVA_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4 ,'REVA_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_SV) CALL BUDGET_DDH (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'REVA_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_SV) CALL BUDGET_DDH (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'REVA_BU_RSV',YDDDH, YDLDDH, YDMDDH)
!
!
!-------------------------------------------------------------------------------
@@ -428,7 +428,7 @@ IF (ORAIN) THEN
!
! Budget storage
IF (LBUDGET_SV) &
- CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,&
+ CALL BUDGET_DDH (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,&
&'BRKU_BU_RSV',YDDDH, YDLDDH, YDMDDH)
!
diff --git a/src/arome/micro/lima_warm_coal.F90 b/src/arome/micro/lima_warm_coal.F90
index 9980b3785324830f0292f581dff6f3d45c5f751c..b71c5476cb770ee3c772e1c391dc6632951cd6b2 100644
--- a/src/arome/micro/lima_warm_coal.F90
+++ b/src/arome/micro/lima_warm_coal.F90
@@ -117,7 +117,7 @@ USE MODD_PARAM_LIMA_WARM
!
USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NR
USE MODD_BUDGET
-USE MODI_BUDGET
+USE MODI_BUDGET_DDH
!
USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
!
@@ -280,7 +280,7 @@ IF( IMICRO >= 1 ) THEN
!
!
ZW(:,:,:) = PCCS(:,:,:)
- IF (LBUDGET_SV) CALL BUDGET ( &
+ IF (LBUDGET_SV) CALL BUDGET_DDH ( &
UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:))&
&*PRHODJ(:,:,:),12+NSV_LIMA_NC,'SELF_BU_RSV',YDDDH, YDLDDH, YDMDDH)
!
@@ -316,21 +316,21 @@ IF (LRAIN_LIMA) THEN
!
!
ZW(:,:,:) = PRCS(:,:,:)
- IF (LBUDGET_RC) CALL BUDGET ( &
+ IF (LBUDGET_RC) CALL BUDGET_DDH ( &
UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
*PRHODJ(:,:,:),7 ,'AUTO_BU_RRC',YDDDH, YDLDDH, YDMDDH)
ZW(:,:,:) = PRRS(:,:,:)
- IF (LBUDGET_RR) CALL BUDGET ( &
+ IF (LBUDGET_RR) CALL BUDGET_DDH ( &
UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
*PRHODJ(:,:,:),8 ,'AUTO_BU_RRR',YDDDH, YDLDDH, YDMDDH)
ZW(:,:,:) = PCRS(:,:,:)
IF (LBUDGET_SV) THEN
ZW(:,:,:) = PCRS(:,:,:)
- CALL BUDGET (UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
+ CALL BUDGET_DDH (UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
*PRHODJ(:,:,:),12+NSV_LIMA_NR,'AUTO_BU_RSV',YDDDH, YDLDDH, YDMDDH)
ZW(:,:,:) = PCCS(:,:,:)
- CALL BUDGET (UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
+ CALL BUDGET_DDH (UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
*PRHODJ(:,:,:),12+NSV_LIMA_NC,'AUTO_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END IF
!
@@ -382,15 +382,15 @@ IF (LRAIN_LIMA) THEN
!
!
ZW(:,:,:) = PRCS(:,:,:)
- IF (LBUDGET_RC) CALL BUDGET ( &
+ IF (LBUDGET_RC) CALL BUDGET_DDH ( &
UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
*PRHODJ(:,:,:),7 ,'ACCR_BU_RRC',YDDDH, YDLDDH, YDMDDH)
ZW(:,:,:) = PRRS(:,:,:)
- IF (LBUDGET_RR) CALL BUDGET ( &
+ IF (LBUDGET_RR) CALL BUDGET_DDH ( &
UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
*PRHODJ(:,:,:),8 ,'ACCR_BU_RRR',YDDDH, YDLDDH, YDMDDH)
ZW(:,:,:) = PCCS(:,:,:)
- IF (LBUDGET_SV) CALL BUDGET ( &
+ IF (LBUDGET_SV) CALL BUDGET_DDH ( &
UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
*PRHODJ(:,:,:),12+NSV_LIMA_NC,'ACCR_BU_RSV',YDDDH, YDLDDH, YDMDDH)
!
@@ -440,7 +440,7 @@ IF (LRAIN_LIMA) THEN
!
!
ZW(:,:,:) = PCRS(:,:,:)
- IF (LBUDGET_SV) CALL BUDGET ( &
+ IF (LBUDGET_SV) CALL BUDGET_DDH ( &
UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
*PRHODJ(:,:,:),12+NSV_LIMA_NR,'SCBU_BU_RSV',YDDDH, YDLDDH, YDMDDH)
!
@@ -493,18 +493,18 @@ ELSE
! ------------------------
!
!
- IF (LBUDGET_SV) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'SELF_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_SV) CALL BUDGET_DDH (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'SELF_BU_RSV',YDDDH, YDLDDH, YDMDDH)
!
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'AUTO_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'AUTO_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'AUTO_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'AUTO_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'AUTO_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'AUTO_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_SV) CALL BUDGET_DDH (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'AUTO_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_SV) CALL BUDGET_DDH (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'AUTO_BU_RSV',YDDDH, YDLDDH, YDMDDH)
!
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'ACCR_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'ACCR_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_SV) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'ACCR_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'ACCR_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'ACCR_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_SV) CALL BUDGET_DDH (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'ACCR_BU_RSV',YDDDH, YDLDDH, YDMDDH)
!
- IF (LBUDGET_SV) CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'SCBU_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_SV) CALL BUDGET_DDH (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'SCBU_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END IF ! IMICRO
!
diff --git a/src/arome/micro/modi_rain_ice.F90 b/src/arome/micro/modi_rain_ice.F90
deleted file mode 100644
index d1b7e3edd7c731ff30f4f9bc5166c18096a5c5c1..0000000000000000000000000000000000000000
--- a/src/arome/micro/modi_rain_ice.F90
+++ /dev/null
@@ -1,86 +0,0 @@
-! ######spl
- MODULE MODI_RAIN_ICE
-! ####################
-!
-INTERFACE
- SUBROUTINE RAIN_ICE ( KIT, KJT, KKT, KSIZE, &
- OSEDIC,OCND2, HSEDIM, HSUBG_AUCV_RC, OWARM, KKA, KKU, KKL, &
- PTSTEP, KRR, LDMICRO, PEXN, &
- PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
- PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
- PINPRC, PINPRR, PEVAP3D, &
- PINPRS, PINPRG, PSIGS, PSEA, PTOWN, &
- PRHT, PRHS, PINPRH, PFPR, &
- YDDDH, YDLDDH, YDMDDH )
-!
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
-!
-INTEGER, INTENT(IN) :: KIT, KJT, KKT ! arrays size
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
-LOGICAL :: OCND2 ! Logical switch to separate liquid and ice
-CHARACTER(LEN=4), INTENT(IN) :: HSEDIM ! Sedimentation scheme
-CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC ! Switch for rc->rr Subgrid autoconversion
- ! Kind of Subgrid autoconversion method
-LOGICAL, INTENT(IN) :: OWARM ! .TRUE. allows raindrops to
- ! form by warm processes
- ! (Kessler scheme)
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-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(KIT,KJT,KKT), INTENT(IN) :: LDMICRO ! mask to limit computation
-!
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PEXN ! Exner function
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
-!
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PCLDFR ! Cloud fraction
-!
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-!
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PSIGS ! Sigma_s at t
-!
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
-
-!
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRC! Cloud instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR! Rain instant precip
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PEVAP3D! Rain evap profile
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS! Snow instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG! Graupel instant precip
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PTOWN! Fraction that is town
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH! Hail instant precip
-REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
-!
-END SUBROUTINE RAIN_ICE
-END INTERFACE
-END MODULE MODI_RAIN_ICE
diff --git a/src/arome/micro/rain_ice.F90 b/src/arome/micro/rain_ice.F90
deleted file mode 100644
index 74aa8152e665f9f7e53e83bef85ed7ef042a74a5..0000000000000000000000000000000000000000
--- a/src/arome/micro/rain_ice.F90
+++ /dev/null
@@ -1,1837 +0,0 @@
-!MNH_LIC Copyright 1995-2021 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.
-!-----------------------------------------------------------------
-! ######spl
- SUBROUTINE RAIN_ICE ( KIT, KJT, KKT, KSIZE, &
- OSEDIC, OCND2, HSEDIM, HSUBG_AUCV_RC, OWARM,KKA,KKU,KKL,&
- 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, PEVAP3D, &
- PINPRS, PINPRG, PSIGS, PSEA, PTOWN, &
- PRHT, PRHS, PINPRH, PFPR, &
- YDDDH, YDLDDH, YDMDDH )
- USE PARKIND1, ONLY : JPRB
- USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-! ######################################################################
-!
-!!**** * - compute the explicit microphysical sources
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the slow microphysical sources
-!! which can be computed explicitly
-!!
-!!
-!!** METHOD
-!! ------
-!! The autoconversion computation follows Kessler (1969).
-!! The sedimentation rate is computed with a time spliting technique and
-!! an upstream scheme, written as a difference of non-advective fluxes. This
-!! source term is added to the future instant ( split-implicit process ).
-!! The others microphysical processes are evaluated at the central instant
-!! (split-explicit process ): autoconversion, accretion and rain evaporation.
-!! These last 3 terms are bounded in order not to create negative values
-!! for the water species at the future instant.
-!!
-!! EXTERNAL
-!! --------
-!! None
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_PARAMETERS
-!! JPHEXT : Horizontal external points number
-!! JPVEXT : Vertical external points number
-!! Module MODD_CONF :
-!! CCONF configuration of the model for the first time step
-!! Module MODD_CST
-!! XP00 ! Reference pressure
-!! XRD,XRV ! Gaz constant for dry air, vapor
-!! XMD,XMV ! Molecular weight for dry air, vapor
-!! XCPD ! Cpd (dry air)
-!! XCL ! Cl (liquid)
-!! XCI ! Ci (solid)
-!! XTT ! Triple point temperature
-!! XLVTT ! Vaporization heat constant
-!! XALPW,XBETAW,XGAMW ! Constants for saturation vapor pressure
-!! function over liquid water
-!! XALPI,XBETAI,XGAMI ! Constants for saturation vapor pressure
-!! function over solid ice
-!! Module MODD_BUDGET:
-!! NBUMOD : model in which budget is calculated
-!! CBUTYPE : type of desired budget
-!! 'CART' for cartesian box configuration
-!! 'MASK' for budget zone defined by a mask
-!! 'NONE' ' for no budget
-!! LBU_RTH : logical for budget of RTH (potential temperature)
-!! .TRUE. = budget of RTH
-!! .FALSE. = no budget of RTH
-!! LBU_RRV : logical for budget of RRV (water vapor)
-!! .TRUE. = budget of RRV
-!! .FALSE. = no budget of RRV
-!! LBU_RRC : logical for budget of RRC (cloud water)
-!! .TRUE. = budget of RRC
-!! .FALSE. = no budget of RRC
-!! LBU_RRI : logical for budget of RRI (cloud ice)
-!! .TRUE. = budget of RRI
-!! .FALSE. = no budget of RRI
-!! LBU_RRR : logical for budget of RRR (rain water)
-!! .TRUE. = budget of RRR
-!! .FALSE. = no budget of RRR
-!! LBU_RRS : logical for budget of RRS (aggregates)
-!! .TRUE. = budget of RRS
-!! .FALSE. = no budget of RRS
-!! LBU_RRG : logical for budget of RRG (graupeln)
-!! .TRUE. = budget of RRG
-!! .FALSE. = no budget of RRG
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Book1 and Book2 of documentation ( routine RAIN_ICE )
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 02/11/95
-!! (J.Viviand) 04/02/97 debug accumulated prcipitation & convert
-!! precipitation rate in m/s
-!! (J.-P. Pinty) 17/02/97 add budget calls
-!! (J.-P. Pinty) 17/11/97 set ice sedim. for cirrus ice, reset RCHONI
-!! and RRHONG, reverse order for DEALLOCATE
-!! (J.-P. Pinty) 11/02/98 correction of the air dynamical viscosity and
-!! add advance of the budget calls
-!! (J.-P. Pinty) 18/05/98 correction of the air density in the RIAUTS
-!! process
-!! (J.-P. Pinty) 18/11/98 split the main routine
-!! (V. Masson) 18/11/98 bug in IVEC1 and IVEC2 upper limits
-!! (J. Escobar & J.-P. Pinty)
-!! 11/12/98 contains and rewrite count+pack
-!! (J. Stein & J.-P. Pinty)
-!! 14/10/99 correction for very small RIT
-!! (J. Escobar & J.-P. Pinty)
-!! 24/07/00 correction for very samll m.r. in
-!! the sedimentation subroutine
-!! (M. Tomasini) 11/05/01 Autoconversion of rc into rr modification to take
-!! into account the subgrid variance
-!! (cf Redelsperger & Sommeria JAS 86)
-!! (G. Molinie) 21/05/99 bug in RRCFRIG process, RHODREF**(-1) missing
-!! in RSRIMCG
-!! (G. Molinie & J.-P. Pinty)
-!! 21/06/99 bug in RACCS process
-!! (P. Jabouille) 27/05/04 safety test for case where esw/i(T)> pabs (~Z>40km)
-!! (J-.P. Chaboureau) 12/02/05 temperature depending ice-to-snow autocon-
-! version threshold (Chaboureau and Pinty GRL 2006)
-!! (J.-P. Pinty) 01/01/O1 add the hail category and correction of the
-!! wet growth rate of the graupeln
-!! (S.Remy & C.Lac) 06/06 Add the cloud sedimentation
-!! (S.Remy & C.Lac) 06/06 Sedimentation becoming the last process
-!! to settle the precipitating species created during the current time step
-!! (S.Remy & C.Lac) 06/06 Modification of the algorithm of sedimentation
-!! to settle n times the precipitating species created during Dt/n instead
-!! of Dt
-!! (C.Lac) 11/06 Optimization of the sedimentation loop for NEC
-!! (J.Escobar) 18/01/2008 Parallel Bug in Budget when IMICRO >= 1
-!! --> Path inhibit this test by IMICRO >= 0 allway true
-!! (Y.Seity) 03/2008 Add Statistic sedimentation
-!! (Y.Seity) 10/2009 Added condition for the raindrop accretion of the aggregates
-!! into graupeln process (5.2.6) to avoid negative graupel mixing ratio
-!! (V.Masson, C.Lac) 09/2010 Correction in split sedimentation for
-!! reproducibility
-!! (S. Riette) Oct 2010 Better vectorisation of RAIN_ICE_SEDIMENTATION_STAT
-!! (Y. Seity), 02-2012 add possibility to run with reversed vertical levels
-!! (L. Bengtsson), 02-2013 Passing in land/sea mask and town fraction in
-!! order to use different cloud droplet number conc. over
-!! land, sea and urban areas in the cloud sedimentation.
-!! (D. Degrauwe), 2013-11: Export upper-air precipitation fluxes PFPR.
-!! (S. Riette) Nov 2013 Protection against null sigma
-!! (C. Abiven, Y. Léauté, V. Seigner, S. Riette) Phasing of Turner rain subgrid param
-!! (S. Riette) Source code split into several files
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST, ONLY: XCI, XCL, XCPD, XCPV, XLSTT, XLVTT, XTT, XRHOLW
-USE MODD_PARAMETERS, ONLY: JPVEXT, XUNDEF
-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_RAIN_ICE_DESCR, ONLY: XRTMIN
-USE MODD_RAIN_ICE_PARAM
-USE MODD_FIELDS_ADDRESS, ONLY : & ! common fields adress
- & ITH, & ! Potential temperature
- & IRV, & ! Water vapor
- & IRC, & ! Cloud water
- & IRR, & ! Rain water
- & IRI, & ! Pristine ice
- & IRS, & ! Snow/aggregate
- & IRG, & ! Graupel
- & IRH ! Hail
-USE MODD_BUDGET
-USE MODD_LES
-USE MODI_BUDGET
-USE MODI_ICE4_RAINFR_VERT
-USE MODE_ICE4_SEDIMENTATION_STAT, ONLY: ICE4_SEDIMENTATION_STAT
-USE MODE_ICE4_SEDIMENTATION_SPLIT, ONLY: ICE4_SEDIMENTATION_SPLIT
-USE MODE_ICE4_SEDIMENTATION_SPLIT_MOMENTUM, ONLY: ICE4_SEDIMENTATION_SPLIT_MOMENTUM
-USE MODE_ICE4_NUCLEATION_WRAPPER, ONLY: ICE4_NUCLEATION_WRAPPER
-USE MODE_ICE4_TENDENCIES, ONLY: ICE4_TENDENCIES
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-!
-!
-INTEGER, INTENT(IN) :: KIT, KJT, KKT ! arrays size
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
-LOGICAL :: OCND2 ! Logical switch to separate liquid and ice
-CHARACTER(LEN=4), INTENT(IN) :: HSEDIM ! Sedimentation scheme
-CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC ! Kind of Subgrid autoconversion method
-LOGICAL, INTENT(IN) :: OWARM ! .TRUE. allows raindrops to
- ! form by warm processes
- ! (Kessler scheme)
-INTEGER, INTENT(IN) :: KKA !near ground array index
-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(KIT,KJT,KKT), INTENT(IN) :: ODMICRO ! mask to limit computation
-!
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PEXN ! Exner function
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
-!
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PCLDFR ! Convective Mass Flux Cloud fraction
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PSIGS ! Sigma_s at t
-!
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
-!
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRC! Cloud instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR! Rain instant precip
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PEVAP3D! Rain evap profile
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS! Snow instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG! Graupel instant precip
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PTOWN! Fraction that is town
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH! Hail instant precip
-REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
-!
-!* 0.2 Declarations of local variables :
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-INTEGER :: IIB ! Define the domain where is
-INTEGER :: IIE ! the microphysical sources have to be computed
-INTEGER :: IJB !
-INTEGER :: IJE !
-INTEGER :: IKB, IKTB !
-INTEGER :: IKE, IKTE !
-!
-INTEGER :: JI, JJ, JK
-!
-!For packing
-INTEGER :: IMICRO ! Case r_x>0 locations
-INTEGER, DIMENSION(KSIZE) :: I1,I2,I3 ! Used to replace the COUNT
-INTEGER :: JL ! and PACK intrinsics
-!
-!Arrays for nucleation call outisde of ODMICRO points
-REAL, DIMENSION(KIT, KJT, KKT) :: ZW ! work array
-REAL, DIMENSION(KIT, KJT, KKT) :: ZT ! Temperature
-REAL, DIMENSION(KIT, KJT, KKT) :: &
- & ZZ_RVHENI_MR, & ! heterogeneous nucleation mixing ratio change
- & ZZ_RVHENI ! heterogeneous nucleation
-REAL, DIMENSION(KIT, KJT, KKT) :: ZZ_LVFACT, ZZ_LSFACT
-!
-!Diagnostics
-REAL, DIMENSION(KIT, KJT, KKT) :: 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
- & ZHLI_HCF3D,& ! HLCLOUDS cloud fraction in high ice content part
- & ZHLI_LCF3D,& ! HLCLOUDS cloud fraction in low ice content part
- & ZHLI_HRI3D,& ! HLCLOUDS cloud water content in high ice content
- & ZHLI_LRI3D ! HLCLOUDS cloud water content in high ice content
-REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2)) :: ZINPRI ! Pristine ice instant precip
-!
-!Packed variables
-REAL, DIMENSION(KSIZE) :: 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
- & ZRST, & ! Snow/aggregate m.r. at t
- & ZRGT, & ! Graupel m.r. at t
- & ZRHT, & ! Hail m.r. at t
- & ZCIT, & ! Pristine ice conc. at t
- & ZTHT, & ! Potential temperature
- & ZRHODREF, & ! RHO Dry REFerence
- & ZZT, & ! Temperature
- & ZPRES, & ! Pressure
- & ZEXN, & ! EXNer Pressure
- & ZLSFACT, & ! L_s/(Pi*C_ph)
- & ZLVFACT, & ! L_v/(Pi*C_ph)
- & ZSIGMA_RC,& ! Standard deviation of rc at time t
- & ZCF, & ! Cloud fraction
- & ZHLC_HCF, & ! HLCLOUDS : fraction of High Cloud Fraction in grid
- & ZHLC_LCF, & ! HLCLOUDS : fraction of Low Cloud Fraction in grid
- ! note that ZCF = ZHLC_HCF + ZHLC_LCF
- & ZHLC_HRC, & ! HLCLOUDS : LWC that is High LWC in grid
- & ZHLC_LRC, & ! HLCLOUDS : LWC that is Low LWC in grid
- ! note that ZRC = ZHLC_HRC + ZHLC_LRC
- & ZHLI_HCF, &
- & ZHLI_LCF, &
- & ZHLI_HRI, &
- & ZHLI_LRI
-!
-!Output packed tendencies (for budgets only)
-REAL, DIMENSION(KSIZE) :: ZRVHENI_MR, & ! heterogeneous nucleation mixing ratio change
- & ZRCHONI, & ! Homogeneous nucleation
- & ZRRHONG_MR, & ! Spontaneous freezing mixing ratio change
- & ZRVDEPS, & ! Deposition on r_s,
- & ZRIAGGS, & ! Aggregation on r_s
- & ZRIAUTS, & ! Autoconversion of r_i for r_s production
- & ZRVDEPG, & ! Deposition on r_g
- & ZRCAUTR, & ! Autoconversion of r_c for r_r production
- & ZRCACCR, & ! Accretion of r_c for r_r production
- & ZRREVAV, & ! Evaporation of r_r
- & ZRIMLTC_MR, & ! Cloud ice melting mixing ratio change
- & ZRCBERI, & ! Bergeron-Findeisen effect
- & ZRHMLTR, & ! Melting of the hailstones
- & ZRSMLTG, & ! Conversion-Melting of the aggregates
- & ZRCMLTSR, & ! Cloud droplet collection onto aggregates by positive temperature
- & ZRRACCSS, ZRRACCSG, ZRSACCRG, & ! Rain accretion onto the aggregates
- & ZRCRIMSS, ZRCRIMSG, ZRSRIMCG, ZRSRIMCG_MR, & ! Cloud droplet riming of the aggregates
- & ZRICFRRG, ZRRCFRIG, ZRICFRR, & ! Rain contact freezing
- & ZRCWETG, ZRIWETG, ZRRWETG, ZRSWETG, & ! Graupel wet growth
- & ZRCDRYG, ZRIDRYG, ZRRDRYG, ZRSDRYG, & ! Graupel dry growth
- & ZRWETGH, & ! Conversion of graupel into hail
- & ZRWETGH_MR, & ! Conversion of graupel into hail, mr change
- & ZRGMLTR, & ! Melting of the graupel
- & ZRCWETH, ZRIWETH, ZRSWETH, ZRGWETH, ZRRWETH, & ! Dry growth of hailstone
- & ZRCDRYH, ZRIDRYH, ZRSDRYH, ZRRDRYH, ZRGDRYH, & ! Wet growth of hailstone
- & ZRDRYHG ! Conversion of hailstone into graupel
-!
-!Output packed total mixing ratio change (for budgets only)
-REAL, DIMENSION(KSIZE) :: ZTOT_RVHENI, & ! heterogeneous nucleation mixing ratio change
- & ZTOT_RCHONI, & ! Homogeneous nucleation
- & ZTOT_RRHONG, & ! Spontaneous freezing mixing ratio change
- & ZTOT_RVDEPS, & ! Deposition on r_s,
- & ZTOT_RIAGGS, & ! Aggregation on r_s
- & ZTOT_RIAUTS, & ! Autoconversion of r_i for r_s production
- & ZTOT_RVDEPG, & ! Deposition on r_g
- & ZTOT_RCAUTR, & ! Autoconversion of r_c for r_r production
- & ZTOT_RCACCR, & ! Accretion of r_c for r_r production
- & ZTOT_RREVAV, & ! Evaporation of r_r
- & ZTOT_RCRIMSS, ZTOT_RCRIMSG, ZTOT_RSRIMCG, & ! Cloud droplet riming of the aggregates
- & ZTOT_RIMLTC, & ! Cloud ice melting mixing ratio change
- & ZTOT_RCBERI, & ! Bergeron-Findeisen effect
- & ZTOT_RHMLTR, & ! Melting of the hailstones
- & ZTOT_RSMLTG, & ! Conversion-Melting of the aggregates
- & ZTOT_RCMLTSR, & ! Cloud droplet collection onto aggregates by positive temperature
- & ZTOT_RRACCSS, ZTOT_RRACCSG, ZTOT_RSACCRG, & ! Rain accretion onto the aggregates
- & ZTOT_RICFRRG, ZTOT_RRCFRIG, ZTOT_RICFRR, & ! Rain contact freezing
- & ZTOT_RCWETG, ZTOT_RIWETG, ZTOT_RRWETG, ZTOT_RSWETG, & ! Graupel wet growth
- & ZTOT_RCDRYG, ZTOT_RIDRYG, ZTOT_RRDRYG, ZTOT_RSDRYG, & ! Graupel dry growth
- & ZTOT_RWETGH, & ! Conversion of graupel into hail
- & ZTOT_RGMLTR, & ! Melting of the graupel
- & ZTOT_RCWETH, ZTOT_RIWETH, ZTOT_RSWETH, ZTOT_RGWETH, ZTOT_RRWETH, & ! Dry growth of hailstone
- & ZTOT_RCDRYH, ZTOT_RIDRYH, ZTOT_RSDRYH, ZTOT_RRDRYH, ZTOT_RGDRYH, & ! Wet growth of hailstone
- & ZTOT_RDRYHG ! Conversion of hailstone into graupel
-!
-!For time- or mixing-ratio- splitting
-REAL, DIMENSION(KSIZE) :: 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
- & Z0RST, & ! Snow/aggregate m.r. at the beginig of the current loop
- & Z0RGT, & ! Graupel m.r. at the beginig of the current loop
- & Z0RHT ! Hail m.r. at the beginig of the current loop
-
-
-
-
-
-!en attendant phasage on utilise KSIZE Ã la place de KPROMA
-REAL, DIMENSION(KSIZE,0:7) :: &
- & ZVART, & !Packed variables
- & ZA, ZB
-
-
-
-
-
-
-!
-!To take into acount external tendencies inside the splitting
-REAL, DIMENSION(KSIZE) :: ZEXT_RV, & ! External tendencie for rv
- & ZEXT_RC, & ! External tendencie for rc
- & ZEXT_RR, & ! External tendencie for rr
- & ZEXT_RI, & ! External tendencie for ri
- & ZEXT_RS, & ! External tendencie for rs
- & ZEXT_RG, & ! External tendencie for rg
- & ZEXT_RH, & ! External tendencie for rh
- & ZEXT_TH, & ! External tendencie for th
- & ZEXT_WW ! Working array
-LOGICAL :: GEXT_TEND
-!
-INTEGER, DIMENSION(KSIZE) :: IITER ! Number of iterations done (with real tendencies computation)
-INTEGER :: INB_ITER_MAX ! Maximum number of iterations (with real tendencies computation)
-REAL, DIMENSION(KSIZE) :: 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
-REAL, DIMENSION(KSIZE) :: ZW1D
-REAL, DIMENSION(KSIZE) :: ZCOMPUTE ! 1. for points where we must compute tendencies, 0. elsewhere
-LOGICAL :: LSOFT ! Must we really compute tendencies or only adjust them to new T variables
-REAL :: ZTSTEP ! length of sub-timestep in case of time splitting
-REAL :: ZINV_TSTEP ! Inverse ov PTSTEP
-REAL, DIMENSION(KSIZE, 8) :: ZRS_TEND
-REAL, DIMENSION(KSIZE, 8) :: ZRG_TEND
-REAL, DIMENSION(KSIZE, 10) :: ZRH_TEND
-REAL, DIMENSION(KSIZE) :: ZSSI
-!
-!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
-!
-CHARACTER(LEN=80) :: HSUBG_AUCV_RI='NONE'
-!-------------------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('RAIN_ICE', 0, ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-IF(OCND2) THEN
- WRITE(*,*) ' STOP'
- WRITE(*,*) ' OCND2 OPTION NOT CODED IN THIS RAIN_ICE VERSION'
- CALL ABORT
- STOP
-END IF
-!* 1. COMPUTE THE LOOP BOUNDS
-! -----------------------
-!
-IIB=1+JPHEXT
-IIE=SIZE(PDZZ,1) - JPHEXT
-IJB=1+JPHEXT
-IJE=SIZE(PDZZ,2) - JPHEXT
-IKB=KKA+JPVEXT*KKL
-IKE=KKU-JPVEXT*KKL
-IKTB=1+JPVEXT
-IKTE=KKT-JPVEXT
-!
-ZINV_TSTEP=1./PTSTEP
-GEXT_TEND=.TRUE.
-!
-! LSFACT and LVFACT without exner
-IF(KRR==7) THEN
- DO JK = 1, KKT
- DO JJ = 1, KJT
- DO JI = 1, KIT
- ZT(JI,JJ,JK) = PTHT(JI,JJ,JK) * PEXN(JI,JJ,JK)
- ZZ_LSFACT(JI,JJ,JK)=(XLSTT+(XCPV-XCI)*(ZT(JI,JJ,JK)-XTT)) &
- /( XCPD + XCPV*PRVT(JI,JJ,JK) + XCL*(PRCT(JI,JJ,JK)+PRRT(JI,JJ,JK)) &
- + XCI*(PRIT(JI,JJ,JK)+PRST(JI,JJ,JK)+PRGT(JI,JJ,JK)+PRHT(JI,JJ,JK)))
- ZZ_LVFACT(JI,JJ,JK)=(XLVTT+(XCPV-XCL)*(ZT(JI,JJ,JK)-XTT)) &
- /( XCPD + XCPV*PRVT(JI,JJ,JK) + XCL*(PRCT(JI,JJ,JK)+PRRT(JI,JJ,JK)) &
- + XCI*(PRIT(JI,JJ,JK)+PRST(JI,JJ,JK)+PRGT(JI,JJ,JK)+PRHT(JI,JJ,JK)))
- ENDDO
- ENDDO
- ENDDO
-ELSE
- DO JK = 1, KKT
- DO JJ = 1, KJT
- DO JI = 1, KIT
- ZT(JI,JJ,JK) = PTHT(JI,JJ,JK) * PEXN(JI,JJ,JK)
- ZZ_LSFACT(JI,JJ,JK)=(XLSTT+(XCPV-XCI)*(ZT(JI,JJ,JK)-XTT)) &
- /( XCPD + XCPV*PRVT(JI,JJ,JK) + XCL*(PRCT(JI,JJ,JK)+PRRT(JI,JJ,JK)) &
- + XCI*(PRIT(JI,JJ,JK)+PRST(JI,JJ,JK)+PRGT(JI,JJ,JK)))
- ZZ_LVFACT(JI,JJ,JK)=(XLVTT+(XCPV-XCL)*(ZT(JI,JJ,JK)-XTT)) &
- /( XCPD + XCPV*PRVT(JI,JJ,JK) + XCL*(PRCT(JI,JJ,JK)+PRRT(JI,JJ,JK)) &
- + XCI*(PRIT(JI,JJ,JK)+PRST(JI,JJ,JK)+PRGT(JI,JJ,JK)))
- ENDDO
- ENDDO
- ENDDO
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. COMPUTE THE SEDIMENTATION (RS) SOURCE
-! -------------------------------------
-!
-IF(.NOT. LSEDIM_AFTER) THEN
- !
- !* 2.1 sedimentation
- !
- IF(HSEDIM=='STAT') THEN
- IF(KRR==7) THEN
- CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, &
- &PDZZ, &
- &PRHODREF, PPABST, PTHT, PRHODJ, &
- &PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,&
- &PRSS, PRSS*PTSTEP, PRGS, PRGS*PTSTEP,&
- &PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA=PSEA, PTOWN=PTOWN, &
- &PINPRH=PINPRH, PRHT=PRHS*PTSTEP, PRHS=PRHS, PFPR=PFPR)
- ELSE
- CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, &
- &PDZZ, &
- &PRHODREF, PPABST, PTHT, PRHODJ, &
- &PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,&
- &PRSS, PRSS*PTSTEP, PRGS, PRGS*PTSTEP,&
- &PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA=PSEA, PTOWN=PTOWN, &
- &PFPR=PFPR)
- ENDIF
- PINPRS(:,:) = PINPRS(:,:) + ZINPRI(:,:)
- !No negativity correction here as we apply sedimentation on PR.S*PTSTEP variables
- ELSEIF(HSEDIM=='SPLI') THEN
- IF(KRR==7) THEN
- CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, PDZZ, &
- &PRHODREF, PPABST, PTHT, PRHODJ, &
- &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
- &PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA=PSEA, PTOWN=PTOWN, &
- &PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR)
- ELSE
- CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, PDZZ, &
- &PRHODREF, PPABST, PTHT, PRHODJ, &
- &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
- &PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA=PSEA, PTOWN=PTOWN, &
- &PFPR=PFPR)
- ENDIF
- PINPRS(:,:) = PINPRS(:,:) + ZINPRI(:,:)
- !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:
- ! sedimentation tendency and an external tendency which represents all other
- ! processes (mainly advection and microphysical processes). If both tendencies
- ! are negative, sedimentation can remove a specie at a given sub-timestep. From
- ! this point sedimentation stops for the remaining sub-timesteps but the other tendency
- ! will be still active and will lead to negative values.
- ! We could prevent the algorithm to not consume too much a specie, instead we apply
- ! a correction here.
- CALL CORRECT_NEGATIVITIES(KIT, KJT, KKT, KRR, PRVS, PRCS, PRRS, &
- &PRIS, PRSS, PRGS, &
- &PTHS, ZZ_LVFACT, ZZ_LSFACT, PRHS)
- ELSEIF(HSEDIM=='NONE') THEN
- ELSE
- WRITE(*,*) ' STOP'
- WRITE(*,*) ' NO SEDIMENTATION SCHEME FOR HSEDIM=', HSEDIM
- CALL ABORT
- STOP
- END IF
-
-
-
-
-
-
-!!!!! ajouter momentum
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- !
- !* 2.2 budget storage
- !
- IF (LBUDGET_RC .AND. OSEDIC) &
- CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'SEDI_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'SEDI_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'SEDI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:), 10, 'SEDI_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:), 11, 'SEDI_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF ( KRR == 7 .AND. LBUDGET_RH) &
- CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:), 12, 'SEDI_BU_RRH',YDDDH, YDLDDH, YDMDDH)
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. PACKING
-! --------
-! optimization by looking for locations where
-! the microphysical fields are larger than a minimal value only !!!
-!
-IMICRO=0
-IF(KSIZE/=0) IMICRO=RAIN_ICE_COUNTJV(ODMICRO(:,:,:), KIT, KJT, KKT, KSIZE, I1(:), I2(:), I3(:))
-!Packing
-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))
- ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
- ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
- ZRST(JL) = PRST(I1(JL),I2(JL),I3(JL))
- ZRGT(JL) = PRGT(I1(JL),I2(JL),I3(JL))
- ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
- ZCF(JL) = PCLDFR(I1(JL),I2(JL),I3(JL))
- ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
- ZTHT(JL) = PTHT(I1(JL),I2(JL),I3(JL))
- ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
- ZEXN(JL) = PEXN(I1(JL),I2(JL),I3(JL))
- ENDDO
- 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
- ZEXT_RR(JL) = PRRS(I1(JL),I2(JL),I3(JL)) - ZRRT(JL)*ZINV_TSTEP
- ZEXT_RI(JL) = PRIS(I1(JL),I2(JL),I3(JL)) - ZRIT(JL)*ZINV_TSTEP
- ZEXT_RS(JL) = PRSS(I1(JL),I2(JL),I3(JL)) - ZRST(JL)*ZINV_TSTEP
- ZEXT_RG(JL) = PRGS(I1(JL),I2(JL),I3(JL)) - ZRGT(JL)*ZINV_TSTEP
- ZEXT_TH(JL) = PTHS(I1(JL),I2(JL),I3(JL)) - ZTHT(JL)*ZINV_TSTEP
- !The th tendency is not related to a mixing ratio change, there is no exn/exnref issue here
- ENDDO
- ENDIF
- 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.
- ENDDO
- ENDIF
- IF(KRR==7) THEN
- DO JL=1, IMICRO
- ZRHT(JL) = PRHT(I1(JL),I2(JL),I3(JL))
- ENDDO
- IF(GEXT_TEND) THEN
- DO JL=1, IMICRO
- ZEXT_RH(JL) = PRHS(I1(JL),I2(JL),I3(JL)) - ZRHT(JL)*ZINV_TSTEP
- ENDDO
- ENDIF
- ELSE
- ZRHT(:)=0.
- IF(GEXT_TEND) ZEXT_RH(:)=0.
- ENDIF
- IF(LBU_ENABLE) THEN
- ZTOT_RVHENI(:)=0.
- ZTOT_RCHONI(:)=0.
- ZTOT_RRHONG(:)=0.
- ZTOT_RVDEPS(:)=0.
- ZTOT_RIAGGS(:)=0.
- ZTOT_RIAUTS(:)=0.
- ZTOT_RVDEPG(:)=0.
- ZTOT_RCAUTR(:)=0.
- ZTOT_RCACCR(:)=0.
- ZTOT_RREVAV(:)=0.
- ZTOT_RCRIMSS(:)=0.
- ZTOT_RCRIMSG(:)=0.
- ZTOT_RSRIMCG(:)=0.
- ZTOT_RIMLTC(:)=0.
- ZTOT_RCBERI(:)=0.
- ZTOT_RHMLTR(:)=0.
- ZTOT_RSMLTG(:)=0.
- ZTOT_RCMLTSR(:)=0.
- ZTOT_RRACCSS(:)=0.
- ZTOT_RRACCSG(:)=0.
- ZTOT_RSACCRG(:)=0.
- ZTOT_RICFRRG(:)=0.
- ZTOT_RRCFRIG(:)=0.
- ZTOT_RICFRR(:)=0.
- ZTOT_RCWETG(:)=0.
- ZTOT_RIWETG(:)=0.
- ZTOT_RRWETG(:)=0.
- ZTOT_RSWETG(:)=0.
- ZTOT_RCDRYG(:)=0.
- ZTOT_RIDRYG(:)=0.
- ZTOT_RRDRYG(:)=0.
- ZTOT_RSDRYG(:)=0.
- ZTOT_RWETGH(:)=0.
- ZTOT_RGMLTR(:)=0.
- ZTOT_RCWETH(:)=0.
- ZTOT_RIWETH(:)=0.
- ZTOT_RSWETH(:)=0.
- ZTOT_RGWETH(:)=0.
- ZTOT_RRWETH(:)=0.
- ZTOT_RCDRYH(:)=0.
- ZTOT_RIDRYH(:)=0.
- ZTOT_RSDRYH(:)=0.
- ZTOT_RRDRYH(:)=0.
- ZTOT_RGDRYH(:)=0.
- ZTOT_RDRYHG(:)=0.
- ENDIF
-ENDIF
-!-------------------------------------------------------------------------------
-!
-!* 4. LOOP
-! ----
-!
-!Maximum number of iterations
-!We only count real iterations (those for which we *compute* tendencies)
-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) !Fot the case XMRSTEP/=0. at the same time
-ENDIF
-IITER(:)=0
-ZTIME(:)=0. ! Current integration time (all points may have a different integration time)
-DO WHILE(ANY(ZTIME(:)<PTSTEP)) ! Loop to *really* compute tendencies
- IF(XMRSTEP/=0.) THEN
- ! In this case we need to remember the mixing ratios used to compute the tendencies
- ! because when mixing ratio has evolved more than a threshold, we must re-compute tendecies
- DO JL=1, IMICRO
- Z0RVT(JL)=ZRVT(JL)
- Z0RCT(JL)=ZRCT(JL)
- Z0RRT(JL)=ZRRT(JL)
- Z0RIT(JL)=ZRIT(JL)
- Z0RST(JL)=ZRST(JL)
- Z0RGT(JL)=ZRGT(JL)
- Z0RHT(JL)=ZRHT(JL)
- ENDDO
- ENDIF
- IF(XTSTEP_TS/=0.) THEN
- ! In this case we need to remember the time when tendencies were computed
- ! because when time has evolved more than a limit, we must re-compute tendecies
- ZTIME_LASTCALL(:)=ZTIME(:)
- ENDIF
- ZCOMPUTE(:)=MAX(0., -SIGN(1., ZTIME(:)-PTSTEP)) ! Compuation (1.) only for points for which integration time has not reached the timestep
- LSOFT=.FALSE. ! We *really* compute the tendencies
- IITER(:)=IITER(:)+INT(ZCOMPUTE(:))
- DO WHILE(SUM(ZCOMPUTE(:))>0.) ! Loop to adjust tendencies when we cross the 0°C or when a specie disappears
- IF(KRR==7) THEN
- DO JL=1, IMICRO
- ZZT(JL) = ZTHT(JL) * ZEXN(JL)
- ZLSFACT(JL)=(XLSTT+(XCPV-XCI)*(ZZT(JL)-XTT)) &
- &/( (XCPD + XCPV*ZRVT(JL) + XCL*(ZRCT(JL)+ZRRT(JL)) &
- &+ XCI*(ZRIT(JL)+ZRST(JL)+ZRGT(JL)+ZRHT(JL)))*ZEXN(JL) )
- ZLVFACT(JL)=(XLVTT+(XCPV-XCL)*(ZZT(JL)-XTT)) &
- &/( (XCPD + XCPV*ZRVT(JL) + XCL*(ZRCT(JL)+ZRRT(JL)) &
- &+ XCI*(ZRIT(JL)+ZRST(JL)+ZRGT(JL)+ZRHT(JL)))*ZEXN(JL) )
- ENDDO
- ELSE
- DO JL=1, IMICRO
- ZZT(JL) = ZTHT(JL) * ZEXN(JL)
- ZLSFACT(JL)=(XLSTT+(XCPV-XCI)*(ZZT(JL)-XTT)) &
- &/( (XCPD + XCPV*ZRVT(JL) + XCL*(ZRCT(JL)+ZRRT(JL)) &
- &+ XCI*(ZRIT(JL)+ZRST(JL)+ZRGT(JL)))*ZEXN(JL) )
- ZLVFACT(JL)=(XLVTT+(XCPV-XCL)*(ZZT(JL)-XTT)) &
- &/( (XCPD + XCPV*ZRVT(JL) + XCL*(ZRCT(JL)+ZRRT(JL)) &
- &+ XCI*(ZRIT(JL)+ZRST(JL)+ZRGT(JL)))*ZEXN(JL) )
- ENDDO
- ENDIF
- !
- !*** 4.1 Tendecies computation
- !
- ! Tendencies are *really* computed when LSOFT==.FALSE. and only adjusted otherwise
-
-
-
-!KPROMA=IMICRO: temporary merging step
-ZVART(:, ITH)=ZTHT(:)
-ZVART(:, IRV)=ZRVT(:)
-ZVART(:, IRC)=ZRCT(:)
-ZVART(:, IRR)=ZRRT(:)
-ZVART(:, IRI)=ZRIT(:)
-ZVART(:, IRS)=ZRST(:)
-ZVART(:, IRG)=ZRGT(:)
-IF(KRR==7) ZVART(:, IRH)=ZRHT(:)
-
- CALL ICE4_TENDENCIES(IMICRO, IMICRO, IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, KKT, KKL, &
- &KRR, LSOFT, ZCOMPUTE, &
- &OWARM, CSUBG_RC_RR_ACCR, CSUBG_RR_EVAP, &
- &HSUBG_AUCV_RC, HSUBG_AUCV_RI, CSUBG_PR_PDF, &
- &ZEXN, ZRHODREF, ZLVFACT, ZLSFACT, I1, I2, I3, &
- &ZPRES, ZCF, ZSIGMA_RC, &
- &ZCIT, &
- &ZZT, ZVART, &
- &ZRVHENI_MR, ZRRHONG_MR, ZRIMLTC_MR, ZRSRIMCG_MR, &
- &ZRCHONI, ZRVDEPS, ZRIAGGS, ZRIAUTS, ZRVDEPG, &
- &ZRCAUTR, ZRCACCR, ZRREVAV, &
- &ZRCRIMSS, ZRCRIMSG, ZRSRIMCG, ZRRACCSS, ZRRACCSG, ZRSACCRG, ZRSMLTG, ZRCMLTSR, &
- &ZRICFRRG, ZRRCFRIG, ZRICFRR, ZRCWETG, ZRIWETG, ZRRWETG, ZRSWETG, &
- &ZRCDRYG, ZRIDRYG, ZRRDRYG, ZRSDRYG, ZRWETGH, ZRWETGH_MR, ZRGMLTR, &
- &ZRCWETH, ZRIWETH, ZRSWETH, ZRGWETH, ZRRWETH, &
- &ZRCDRYH, ZRIDRYH, ZRSDRYH, ZRRDRYH, ZRGDRYH, ZRDRYHG, ZRHMLTR, &
- &ZRCBERI, &
- &ZRS_TEND, ZRG_TEND, ZRH_TEND, ZSSI, &
- &ZA, ZB, &
- &ZHLC_HCF, ZHLC_LCF, ZHLC_HRC, ZHLC_LRC, &
- &ZHLI_HCF, ZHLI_LCF, ZHLI_HRI, ZHLI_LRI, ZRAINFR)
-ZTHT(:)=ZVART(:, ITH)
-ZRVT(:)=ZVART(:, IRV)
-ZRCT(:)=ZVART(:, IRC)
-ZRRT(:)=ZVART(:, IRR)
-ZRIT(:)=ZVART(:, IRI)
-ZRST(:)=ZVART(:, IRS)
-ZRGT(:)=ZVART(:, IRG)
-IF(KRR==7) ZRHT(:)=ZVART(:, IRH)
- ! External tendencies
- IF(GEXT_TEND) THEN
- DO JL=1, IMICRO
- ZA(JL, ITH) = ZA(JL, ITH) + ZEXT_TH(JL)
- ZA(JL, IRV) = ZA(JL, IRV) + ZEXT_RV(JL)
- ZA(JL, IRC) = ZA(JL, IRC) + ZEXT_RC(JL)
- ZA(JL, IRR) = ZA(JL, IRR) + ZEXT_RR(JL)
- ZA(JL, IRI) = ZA(JL, IRI) + ZEXT_RI(JL)
- ZA(JL, IRS) = ZA(JL, IRS) + ZEXT_RS(JL)
- ZA(JL, IRG) = ZA(JL, IRG) + ZEXT_RG(JL)
- IF(KRR==7) ZA(JL, IRH) = ZA(JL, IRH) + ZEXT_RH(JL)
- ENDDO
- ENDIF
- !
- !*** 4.2 Integration time
- !
- ! If we can, we will use these tendencies until the end of the timestep
- ZMAXTIME(:)=ZCOMPUTE(:) * (PTSTEP-ZTIME(:)) ! Remaining time until the end of the timestep
-
- !We need to adjust tendencies when temperature reaches 0
- IF(LFEEDBACKT) THEN
- DO JL=1, IMICRO
- !Is ZB(:, ITH) enough to change temperature sign?
- ZW1D(JL)=(ZTHT(JL) - XTT/ZEXN(JL)) * (ZTHT(JL) + ZB(JL, ITH) - XTT/ZEXN(JL))
- ZMAXTIME(JL)=ZMAXTIME(JL)*MAX(0., SIGN(1., ZW1D(JL)))
- !Can ZA(:, ITH) make temperature change of sign?
- ZW1D(JL)=MAX(0., -SIGN(1., 1.E-20 - ABS(ZA(JL, ITH)))) ! WHERE(ABS(ZA(:, ITH))>1.E-20)
- ZTIME_THRESHOLD(JL)=(1. - ZW1D(JL))*(-1.) + &
- ZW1D(JL) * &
- (XTT/ZEXN(JL) - ZB(JL, ITH) - ZTHT(JL))/ &
- SIGN(MAX(ABS(ZA(JL, ITH)), 1.E-20), ZA(JL, ITH))
- ZW1D(JL)=MAX(0., -SIGN(1., -ZTIME_THRESHOLD(JL))) ! WHERE(ZTIME_THRESHOLD(:)>0.)
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- ZW1D(JL) * MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
- ENDDO
- 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)
- DO JL=1, IMICRO
- ZW1D(JL)=MAX(0., -SIGN(1., ZA(JL, IRV)+1.E-20)) * & ! WHERE(ZA(:, IRV)<-1.E-20)
- &MAX(0., -SIGN(1., XRTMIN(1)-ZRVT(JL))) ! WHERE(ZRVT(:)>XRTMIN(1))
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB(JL, IRV)+ZRVT(JL))/MIN(ZA(JL, IRV), -1.E-20))
-
- ZW1D(JL)=MAX(0., -SIGN(1., ZA(JL, IRC)+1.E-20)) * & ! WHERE(ZA(:, IRC)<-1.E-20)
- &MAX(0., -SIGN(1., XRTMIN(2)-ZRCT(JL))) ! WHERE(ZRCT(:)>XRTMIN(2))
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB(JL, IRC)+ZRCT(JL))/MIN(ZA(JL, IRC), -1.E-20))
-
- ZW1D(JL)=MAX(0., -SIGN(1., ZA(JL, IRR)+1.E-20)) * & ! WHERE(ZA(:, IRR)<-1.E-20)
- &MAX(0., -SIGN(1., XRTMIN(3)-ZRRT(JL))) ! WHERE(ZRRT(:)>XRTMIN(3))
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB(JL, IRR)+ZRRT(JL))/MIN(ZA(JL, IRR), -1.E-20))
-
- ZW1D(JL)=MAX(0., -SIGN(1., ZA(JL, IRI)+1.E-20)) * & ! WHERE(ZA(:, IRI)<-1.E-20)
- &MAX(0., -SIGN(1., XRTMIN(4)-ZRIT(JL))) ! WHERE(ZRIT(:)>XRTMIN(4))
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB(JL, IRI)+ZRIT(JL))/MIN(ZA(JL, IRI), -1.E-20))
-
- ZW1D(JL)=MAX(0., -SIGN(1., ZA(JL, IRS)+1.E-20)) * & ! WHERE(ZA(:, IRS)<-1.E-20)
- &MAX(0., -SIGN(1., XRTMIN(5)-ZRST(JL))) ! WHERE(ZRST(:)>XRTMIN(5))
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB(JL, IRS)+ZRST(JL))/MIN(ZA(JL, IRS), -1.E-20))
-
- ZW1D(JL)=MAX(0., -SIGN(1., ZA(JL, IRG)+1.E-20)) * & ! WHERE(ZA(:, IRG)<-1.E-20)
- &MAX(0., -SIGN(1., XRTMIN(6)-ZRGT(JL))) ! WHERE(ZRGT(:)>XRTMIN(6))
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB(JL, IRG)+ZRGT(JL))/MIN(ZA(JL, IRG), -1.E-20))
- ENDDO
-
- IF(KRR==7) THEN
- DO JL=1, IMICRO
- ZW1D(JL)=MAX(0., -SIGN(1., ZA(JL, IRH)+1.E-20)) * & ! WHERE(ZA(:, IRH)<-1.E-20)
- &MAX(0., -SIGN(1., XRTMIN(7)-ZRHT(JL))) ! WHERE(ZRHT(:)>XRTMIN(7))
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB(JL, IRH)+ZRHT(JL))/MIN(ZA(JL, IRH), -1.E-20))
- ENDDO
- ENDIF
-
- !We stop when the end of the timestep is reached
- ZCOMPUTE(:)=ZCOMPUTE(:) * MAX(0., -SIGN(1., ZTIME(:)+ZMAXTIME(:)-PTSTEP))
-
- !We must recompute tendencies when the end of the sub-timestep is reached
- IF(XTSTEP_TS/=0.) THEN
- DO JL=1, IMICRO
- ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
- &MAX(0., -SIGN(1., ZTIME_LASTCALL(JL)+ZTSTEP-ZTIME(JL)-ZMAXTIME(JL))) ! WHERE(ZTIME(:)+ZMAXTIME(:)>ZTIME_LASTCALL(:)+ZTSTEP)
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL) * (ZTIME_LASTCALL(JL)-ZTIME(JL)+ZTSTEP)
- ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
- ENDDO
- 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
- DO JL=1, IMICRO
- ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
- &MAX(0., -SIGN(1., 1.E-20-ABS(ZA(JL, IRV)))) ! WHERE(ABS(ZA(:, IRV))>1.E-20)
- ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
- &ZW1D(JL)*(SIGN(1., ZA(JL, IRV))*XMRSTEP+Z0RVT(JL)-ZRVT(JL)-ZB(JL, IRV))/ &
- &SIGN(MAX(ABS(ZA(JL, IRV)), 1.E-20), ZA(JL, IRV))
- ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
- &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
- &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRVT(JL))) + & !WHERE(ZRVT(:)>XRTMIN(6)) .OR.
- &MAX(0., -SIGN(1., -ZA(JL, IRV)))) !WHERE(ZA(:, IRV)>0.)
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
- ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
-
- ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
- &MAX(0., -SIGN(1., 1.E-20-ABS(ZA(JL, IRC)))) ! WHERE(ABS(ZA(:, IRC))>1.E-20)
- ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
- &ZW1D(JL)*(SIGN(1., ZA(JL, IRC))*XMRSTEP+Z0RCT(JL)-ZRCT(JL)-ZB(JL, IRC))/ &
- &SIGN(MAX(ABS(ZA(JL, IRC)), 1.E-20), ZA(JL, IRC))
- ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
- &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
- &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRCT(JL))) + & !WHERE(ZRCT(:)>XRTMIN(6)) .OR.
- &MAX(0., -SIGN(1., -ZA(JL, IRC)))) !WHERE(ZA(:, IRC)>0.)
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
- ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
-
- ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
- &MAX(0., -SIGN(1., 1.E-20-ABS(ZA(JL, IRR)))) ! WHERE(ABS(ZA(:, IRR))>1.E-20)
- ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
- &ZW1D(JL)*(SIGN(1., ZA(JL, IRR))*XMRSTEP+Z0RRT(JL)-ZRRT(JL)-ZB(JL, IRR))/ &
- &SIGN(MAX(ABS(ZA(JL, IRR)), 1.E-20), ZA(JL, IRR))
- ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
- &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
- &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRRT(JL))) + & !WHERE(ZRRT(:)>XRTMIN(6)) .OR.
- &MAX(0., -SIGN(1., -ZA(JL, IRR)))) !WHERE(ZA(:, IRR)>0.)
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
- ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
-
- ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
- &MAX(0., -SIGN(1., 1.E-20-ABS(ZA(JL, IRI)))) ! WHERE(ABS(ZA(:, IRI))>1.E-20)
- ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
- &ZW1D(JL)*(SIGN(1., ZA(JL, IRI))*XMRSTEP+Z0RIT(JL)-ZRIT(JL)-ZB(JL, IRI))/ &
- &SIGN(MAX(ABS(ZA(JL, IRI)), 1.E-20), ZA(JL, IRI))
- ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
- &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
- &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRIT(JL))) + & !WHERE(ZRIT(:)>XRTMIN(6)) .OR.
- &MAX(0., -SIGN(1., -ZA(JL, IRI)))) !WHERE(ZA(:, IRI)>0.)
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
- ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
-
- ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
- &MAX(0., -SIGN(1., 1.E-20-ABS(ZA(JL, IRS)))) ! WHERE(ABS(ZA(:, IRS))>1.E-20)
- ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
- &ZW1D(JL)*(SIGN(1., ZA(JL, IRS))*XMRSTEP+Z0RST(JL)-ZRST(JL)-ZB(JL, IRS))/ &
- &SIGN(MAX(ABS(ZA(JL, IRS)), 1.E-20), ZA(JL, IRS))
- ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
- &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
- &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRST(JL))) + & !WHERE(ZRST(:)>XRTMIN(6)) .OR.
- &MAX(0., -SIGN(1., -ZA(JL, IRS)))) !WHERE(ZA(:, IRS)>0.)
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
- ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
-
- ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
- &MAX(0., -SIGN(1., 1.E-20-ABS(ZA(JL, IRG)))) ! WHERE(ABS(ZA(:, IRG))>1.E-20)
- ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
- &ZW1D(JL)*(SIGN(1., ZA(JL, IRG))*XMRSTEP+Z0RGT(JL)-ZRGT(JL)-ZB(JL, IRG))/ &
- &SIGN(MAX(ABS(ZA(JL, IRG)), 1.E-20), ZA(JL, IRG))
- ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
- &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
- &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRGT(JL))) + & !WHERE(ZRGT(:)>XRTMIN(6)) .OR.
- &MAX(0., -SIGN(1., -ZA(JL, IRG)))) !WHERE(ZA(:, IRG)>0.)
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
- ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
- ENDDO
-
- IF(KRR==7) THEN
- DO JL=1, IMICRO
- ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
- &MAX(0., -SIGN(1., 1.E-20-ABS(ZA(JL, IRH)))) ! WHERE(ABS(ZA(:, IRH))>1.E-20)
- ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
- &ZW1D(JL)*(SIGN(1., ZA(JL, IRH))*XMRSTEP+Z0RHT(JL)-ZRHT(JL)-ZB(JL, IRH))/ &
- &SIGN(MAX(ABS(ZA(JL, IRH)), 1.E-20), ZA(JL, IRH))
- ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
- &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
- &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRHT(JL))) + & !WHERE(ZRHT(:)>XRTMIN(6)) .OR.
- &MAX(0., -SIGN(1., -ZA(JL, IRH)))) !WHERE(ZA(:, IRH)>0.)
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
- ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
- ENDDO
- ENDIF
-
- DO JL=1, IMICRO
- IF(KRR==7) THEN
- ZW1D(JL)=MAX(ABS(ZB(JL, IRV)), ABS(ZB(JL, IRC)), ABS(ZB(JL, IRR)), ABS(ZB(JL, IRI)), &
- &ABS(ZB(JL, IRS)), ABS(ZB(JL, IRG)), ABS(ZB(JL, IRH)))
- ELSE
- ZW1D(JL)=MAX(ABS(ZB(JL, IRV)), ABS(ZB(JL, IRC)), ABS(ZB(JL, IRR)), ABS(ZB(JL, IRI)), &
- &ABS(ZB(JL, IRS)), ABS(ZB(JL, IRG)))
- ENDIF
- ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & !WHERE(IITER(:)<INB_ITER_MAX)
- &MAX(0., -SIGN(1., XMRSTEP-ZW1D(JL))) !WHERE(ZW1D(:)>XMRSTEP)
- ZMAXTIME(JL)=(1.-ZW1D(JL))*ZMAXTIME(JL)
- ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
- ENDDO
- ENDIF
- !
- !*** 4.3 New values of variables for next iteration
- !
- DO JL=1, IMICRO
- ZTHT(JL)=ZTHT(JL)+ZA(JL, ITH)*ZMAXTIME(JL)+ZB(JL, ITH)
- ZRVT(JL)=ZRVT(JL)+ZA(JL, IRV)*ZMAXTIME(JL)+ZB(JL, IRV)
- ZRCT(JL)=ZRCT(JL)+ZA(JL, IRC)*ZMAXTIME(JL)+ZB(JL, IRC)
- ZRRT(JL)=ZRRT(JL)+ZA(JL, IRR)*ZMAXTIME(JL)+ZB(JL, IRR)
- ZRIT(JL)=ZRIT(JL)+ZA(JL, IRI)*ZMAXTIME(JL)+ZB(JL, IRI)
- ZRST(JL)=ZRST(JL)+ZA(JL, IRS)*ZMAXTIME(JL)+ZB(JL, IRS)
- ZRGT(JL)=ZRGT(JL)+ZA(JL, IRG)*ZMAXTIME(JL)+ZB(JL, IRG)
- ZCIT(JL)=ZCIT(JL) * MAX(0., -SIGN(1., -ZRIT(JL))) ! WHERE(ZRIT(:)==0.) ZCIT(:) = 0.
- ENDDO
- IF(KRR==7) ZRHT(:)=ZRHT(:)+ZA(:, IRH)*ZMAXTIME(:)+ZB(:, IRH)
- !
- !*** 4.4 Mixing ratio change due to each process
- !
- IF(LBU_ENABLE) THEN
- ZTOT_RVHENI(:)= ZTOT_RVHENI(:) +ZRVHENI_MR(:)
- ZTOT_RCHONI(:)= ZTOT_RCHONI(:) +ZRCHONI(:) *ZMAXTIME(:)
- ZTOT_RRHONG(:)= ZTOT_RRHONG(:) +ZRRHONG_MR(:)
- ZTOT_RVDEPS(:)= ZTOT_RVDEPS(:) +ZRVDEPS(:) *ZMAXTIME(:)
- ZTOT_RIAGGS(:)= ZTOT_RIAGGS(:) +ZRIAGGS(:) *ZMAXTIME(:)
- ZTOT_RIAUTS(:)= ZTOT_RIAUTS(:) +ZRIAUTS(:) *ZMAXTIME(:)
- ZTOT_RVDEPG(:)= ZTOT_RVDEPG(:) +ZRVDEPG(:) *ZMAXTIME(:)
- ZTOT_RCAUTR(:)= ZTOT_RCAUTR(:) +ZRCAUTR(:) *ZMAXTIME(:)
- ZTOT_RCACCR(:)= ZTOT_RCACCR(:) +ZRCACCR(:) *ZMAXTIME(:)
- ZTOT_RREVAV(:)= ZTOT_RREVAV(:) +ZRREVAV(:) *ZMAXTIME(:)
- ZTOT_RCRIMSS(:)=ZTOT_RCRIMSS(:)+ZRCRIMSS(:)*ZMAXTIME(:)
- ZTOT_RCRIMSG(:)=ZTOT_RCRIMSG(:)+ZRCRIMSG(:)*ZMAXTIME(:)
- ZTOT_RSRIMCG(:)=ZTOT_RSRIMCG(:)+ZRSRIMCG(:)*ZMAXTIME(:)+ZRSRIMCG_MR(:)
- ZTOT_RRACCSS(:)=ZTOT_RRACCSS(:)+ZRRACCSS(:)*ZMAXTIME(:)
- ZTOT_RRACCSG(:)=ZTOT_RRACCSG(:)+ZRRACCSG(:)*ZMAXTIME(:)
- ZTOT_RSACCRG(:)=ZTOT_RSACCRG(:)+ZRSACCRG(:)*ZMAXTIME(:)
- ZTOT_RSMLTG(:)= ZTOT_RSMLTG(:) +ZRSMLTG(:) *ZMAXTIME(:)
- ZTOT_RCMLTSR(:)=ZTOT_RCMLTSR(:)+ZRCMLTSR(:) *ZMAXTIME(:)
- ZTOT_RICFRRG(:)=ZTOT_RICFRRG(:)+ZRICFRRG(:)*ZMAXTIME(:)
- ZTOT_RRCFRIG(:)=ZTOT_RRCFRIG(:)+ZRRCFRIG(:)*ZMAXTIME(:)
- ZTOT_RICFRR(:)= ZTOT_RICFRR(:) +ZRICFRR(:) *ZMAXTIME(:)
- ZTOT_RCWETG(:)= ZTOT_RCWETG(:) +ZRCWETG(:) *ZMAXTIME(:)
- ZTOT_RIWETG(:)= ZTOT_RIWETG(:) +ZRIWETG(:) *ZMAXTIME(:)
- ZTOT_RRWETG(:)= ZTOT_RRWETG(:) +ZRRWETG(:) *ZMAXTIME(:)
- ZTOT_RSWETG(:)= ZTOT_RSWETG(:) +ZRSWETG(:) *ZMAXTIME(:)
- ZTOT_RWETGH(:)= ZTOT_RWETGH(:) +ZRWETGH(:) *ZMAXTIME(:)+ZRWETGH_MR(:)
- ZTOT_RCDRYG(:)= ZTOT_RCDRYG(:) +ZRCDRYG(:) *ZMAXTIME(:)
- ZTOT_RIDRYG(:)= ZTOT_RIDRYG(:) +ZRIDRYG(:) *ZMAXTIME(:)
- ZTOT_RRDRYG(:)= ZTOT_RRDRYG(:) +ZRRDRYG(:) *ZMAXTIME(:)
- ZTOT_RSDRYG(:)= ZTOT_RSDRYG(:) +ZRSDRYG(:) *ZMAXTIME(:)
- ZTOT_RGMLTR(:)= ZTOT_RGMLTR(:) +ZRGMLTR(:) *ZMAXTIME(:)
- ZTOT_RCWETH(:)= ZTOT_RCWETH(:) +ZRCWETH(:) *ZMAXTIME(:)
- ZTOT_RIWETH(:)= ZTOT_RIWETH(:) +ZRIWETH(:) *ZMAXTIME(:)
- ZTOT_RSWETH(:)= ZTOT_RSWETH(:) +ZRSWETH(:) *ZMAXTIME(:)
- ZTOT_RGWETH(:)= ZTOT_RGWETH(:) +ZRGWETH(:) *ZMAXTIME(:)
- ZTOT_RRWETH(:)= ZTOT_RRWETH(:) +ZRRWETH(:) *ZMAXTIME(:)
- ZTOT_RCDRYH(:)= ZTOT_RCDRYH(:) +ZRCDRYH(:) *ZMAXTIME(:)
- ZTOT_RIDRYH(:)= ZTOT_RIDRYH(:) +ZRIDRYH(:) *ZMAXTIME(:)
- ZTOT_RSDRYH(:)= ZTOT_RSDRYH(:) +ZRSDRYH(:) *ZMAXTIME(:)
- ZTOT_RRDRYH(:)= ZTOT_RRDRYH(:) +ZRRDRYH(:) *ZMAXTIME(:)
- ZTOT_RGDRYH(:)= ZTOT_RGDRYH(:) +ZRGDRYH(:) *ZMAXTIME(:)
- ZTOT_RDRYHG(:)= ZTOT_RDRYHG(:) +ZRDRYHG(:) *ZMAXTIME(:)
- ZTOT_RHMLTR(:)= ZTOT_RHMLTR(:) +ZRHMLTR(:) *ZMAXTIME(:)
- ZTOT_RIMLTC(:)= ZTOT_RIMLTC(:) +ZRIMLTC_MR(:)
- ZTOT_RCBERI(:)= ZTOT_RCBERI(:) +ZRCBERI(:) *ZMAXTIME(:)
- ENDIF
- !
- !*** 4.5 Next loop
- !
- LSOFT=.TRUE. ! We try to adjust tendencies (inner while loop)
- ZTIME(:)=ZTIME(:)+ZMAXTIME(:)
- ENDDO
-ENDDO
-!-------------------------------------------------------------------------------
-!
-!* 5. UNPACKING DIAGNOSTICS
-! ---------------------
-!
-IF(IMICRO>0) THEN
- ZW(:,:,:) = 0.
- ZHLC_HCF3D(:,:,:) = UNPACK(ZHLC_HCF(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))
- ZW(:,:,:) = 0.
- ZHLC_LCF3D(:,:,:) = UNPACK(ZHLC_LCF(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))
- ZW(:,:,:) = 0.
- ZHLC_HRC3D(:,:,:) = UNPACK(ZHLC_HRC(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))
- ZW(:,:,:) = 0.
- ZHLC_LRC3D(:,:,:) = UNPACK(ZHLC_LRC(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))
- PCIT(:,:,:) = UNPACK(ZCIT(:), MASK=ODMICRO(:,:,:), FIELD=PCIT(:,:,:))
-ELSE
- ZRAINFR(:,:,:)=0.
- ZHLC_HCF3D(:,:,:)=0.
- ZHLC_LCF3D(:,:,:)=0.
- ZHLC_HRC3D(:,:,:)=0.
- ZHLC_LRC3D(:,:,:)=0.
- PCIT(:,:,:) = 0.
-ENDIF
-IF(OWARM) THEN
- ZW(:,:,:)=0.
- PEVAP3D(:,:,:)=UNPACK(ZRREVAV(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))
-ENDIF
-!
-!
-!* 6. COMPUTES THE SLOW COLD PROCESS SOURCES OUTSIDE OF ODMICRO POINTS
-! ----------------------------------------------------------------
-!
-CALL ICE4_NUCLEATION_WRAPPER(KIT, KJT, KKT, .NOT. ODMICRO, &
- PTHT, PPABST, PRHODREF, PEXN, ZZ_LSFACT, ZT, &
- PRVT, &
- PCIT, ZZ_RVHENI_MR)
-DO JK = 1, KKT
- DO JJ = 1, KJT
- DO JI = 1, KIT
- ZZ_LSFACT(JI,JJ,JK)=ZZ_LSFACT(JI,JJ,JK)/PEXNREF(JI,JJ,JK)
- ZZ_LVFACT(JI,JJ,JK)=ZZ_LVFACT(JI,JJ,JK)/PEXNREF(JI,JJ,JK)
- ZZ_RVHENI(JI,JJ,JK) = MIN(PRVS(JI,JJ,JK), ZZ_RVHENI_MR(JI,JJ,JK)/PTSTEP)
- PRIS(JI,JJ,JK)=PRIS(JI,JJ,JK)+ZZ_RVHENI(JI,JJ,JK)
- PRVS(JI,JJ,JK)=PRVS(JI,JJ,JK)-ZZ_RVHENI(JI,JJ,JK)
- PTHS(JI,JJ,JK)=PTHS(JI,JJ,JK) + ZZ_RVHENI(JI,JJ,JK)*ZZ_LSFACT(JI,JJ,JK)
- ENDDO
- ENDDO
-ENDDO
-!-------------------------------------------------------------------------------
-!
-!* 7. UNPACKING AND TOTAL TENDENCIES
-! ------------------------------
-!
-!
-!*** 7.1 total tendencies limited by available species
-!
-! ZW_??S variables will contain the new S variables values
-!
-IF(GEXT_TEND) THEN
- !Z..T variables contain the exeternal tendency, we substract it
- DO JL=1, IMICRO
- ZRVT(JL) = ZRVT(JL) - ZEXT_RV(JL) * PTSTEP
- ZRCT(JL) = ZRCT(JL) - ZEXT_RC(JL) * PTSTEP
- ZRRT(JL) = ZRRT(JL) - ZEXT_RR(JL) * PTSTEP
- ZRIT(JL) = ZRIT(JL) - ZEXT_RI(JL) * PTSTEP
- ZRST(JL) = ZRST(JL) - ZEXT_RS(JL) * PTSTEP
- ZRGT(JL) = ZRGT(JL) - ZEXT_RG(JL) * PTSTEP
- ZTHT(JL) = ZTHT(JL) - ZEXT_TH(JL) * PTSTEP
- ENDDO
- IF (KRR==7) ZRHT(:) = ZRHT(:) - ZEXT_RH(:) * PTSTEP
-ENDIF
-!Tendencies computed from difference between old state and new state (can be negative)
-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(KRR==7) THEN
- ZW_RHS(:,:,:) = (UNPACK(ZRHT(:), MASK=ODMICRO(:,:,:), FIELD=PRHT(:,:,:)) - PRHT(:,:,:))*ZINV_TSTEP
-ELSE
- ZW_RHS(:,:,:) = 0.
-ENDIF
-DO JK = 1, KKT
- DO JJ = 1, KJT
- DO JI = 1, KIT
- ZW_THS(JI,JJ,JK) = (ZW_RCS(JI,JJ,JK)+ZW_RRS(JI,JJ,JK))*ZZ_LVFACT(JI,JJ,JK) + &
- & (ZW_RIS(JI,JJ,JK)+ZW_RSS(JI,JJ,JK)+ZW_RGS(JI,JJ,JK)+ &
- &ZW_RHS(JI,JJ,JK))*ZZ_LSFACT(JI,JJ,JK)
- !We apply these tendencies to the S variables
- ZW_RVS(JI,JJ,JK) = PRVS(JI,JJ,JK) + ZW_RVS(JI,JJ,JK)
- ZW_RCS(JI,JJ,JK) = PRCS(JI,JJ,JK) + ZW_RCS(JI,JJ,JK)
- ZW_RRS(JI,JJ,JK) = PRRS(JI,JJ,JK) + ZW_RRS(JI,JJ,JK)
- ZW_RIS(JI,JJ,JK) = PRIS(JI,JJ,JK) + ZW_RIS(JI,JJ,JK)
- ZW_RSS(JI,JJ,JK) = PRSS(JI,JJ,JK) + ZW_RSS(JI,JJ,JK)
- ZW_RGS(JI,JJ,JK) = PRGS(JI,JJ,JK) + ZW_RGS(JI,JJ,JK)
- ZW_THS(JI,JJ,JK) = PTHS(JI,JJ,JK) + ZW_THS(JI,JJ,JK)
- ENDDO
- ENDDO
-ENDDO
-IF(KRR==7) ZW_RHS(:,:,:) = PRHS(:,:,:) + ZW_RHS(:,:,:)
-!We correct negativities with conservation
-CALL CORRECT_NEGATIVITIES(KIT, KJT, KKT, KRR, ZW_RVS, ZW_RCS, ZW_RRS, &
- &ZW_RIS, ZW_RSS, ZW_RGS, &
- &ZW_THS, ZZ_LVFACT, ZZ_LSFACT, ZW_RHS)
-!
-!*** 7.2 LBU_ENABLE case
-!
-IF(LBU_ENABLE) THEN
- ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET(PRVS(:,:,:)*PRHODJ(:,:,:), 6, 'HENU_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'HENU_BU_RRI',YDDDH, YDLDDH, YDMDDH)
-
- ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'HON_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'HON_BU_RRI',YDDDH, YDLDDH, YDMDDH)
-
- ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'SFR_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'SFR_BU_RRG',YDDDH, YDLDDH, YDMDDH)
-
- ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET(PRVS(:,:,:)*PRHODJ(:,:,:), 6, 'DEPS_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'DEPS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
-
- ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'AGGS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
-
- ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'AUTS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
-
- ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET(PRVS(:,:,:)*PRHODJ(:,:,:), 6, 'DEPG_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'DEPG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
-
- IF(OWARM) THEN
- ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'AUTO_BU_RRR',YDDDH, YDLDDH, YDMDDH)
-
- ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'ACCR_BU_RRR',YDDDH, YDLDDH, YDMDDH)
-
- ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET(PRVS(:,:,:)*PRHODJ(:,:,:), 6, 'REVA_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'REVA_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- ENDIF
-
- ZW(:,:,:) = 0.
- 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=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=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'RIM_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'RIM_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'RIM_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'RIM_BU_RRG',YDDDH, YDLDDH, YDMDDH)
-
- ZW(:,:,:) = 0.
- 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=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=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
- PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'ACC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'ACC_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'ACC_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'ACC_BU_RRG',YDDDH, YDLDDH, YDMDDH)
-
- ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RSMLTG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
- PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'CMEL_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'CMEL_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'CMEL_BU_RRR',YDDDH, YDLDDH, YDMDDH)
-
- ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RICFRRG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
- PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = 0.
- 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=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
- PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
- PRRS(:,:,:) = PRRS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'CFRZ_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'CFRZ_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'CFRZ_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'CFRZ_BU_RRG',YDDDH, YDLDDH, YDMDDH)
-
- ZW(:,:,:) = 0.
- 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=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=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
- PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'WETG_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'WETG_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'WETG_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'WETG_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'WETG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
-
- IF(KRR==7) THEN
- ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), 12,'GHCV_BU_RRH',YDDDH, YDLDDH, YDMDDH)
- END IF
-
- ZW(:,:,:) = 0.
- 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=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=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
- PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'DRYG_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'DRYG_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'DRYG_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'DRYG_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'DRYG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
-
- ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'GMLT_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'GMLT_BU_RRG',YDDDH, YDLDDH, YDMDDH)
-
- IF(KRR==7) THEN
- ZW(:,:,:) = 0.
- 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=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=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
- PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RSWETH(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
- PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'WETH_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'WETH_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'WETH_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'WETH_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), 12,'WETH_BU_RRH',YDDDH, YDLDDH, YDMDDH)
-
- ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), 12,'HGCV_BU_RRH',YDDDH, YDLDDH, YDMDDH)
-
- ZW(:,:,:) = 0.
- 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=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=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
- PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RSDRYH(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
- PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RGDRYH(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
- PRGS(:,:,:) = PRGS(:,:,:) - ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'DRYH_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'DRYH_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'DRYH_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'DRYH_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'DRYH_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), 12,'DRYH_BU_RRH',YDDDH, YDLDDH, YDMDDH)
-
- ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'HMLT_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), 12,'HMLT_BU_RRH',YDDDH, YDLDDH, YDMDDH)
- ENDIF
-
- ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'IMLT_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'IMLT_BU_RRI',YDDDH, YDLDDH, YDMDDH)
-
- ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'BERFI_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'BERFI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
-ENDIF
-!
-!*** 7.3 Final tendencies
-!
-DO JK = 1, KKT
- DO JJ = 1, KJT
- DO JI = 1, KIT
- PRVS(JI,JJ,JK) = ZW_RVS(JI,JJ,JK)
- PRCS(JI,JJ,JK) = ZW_RCS(JI,JJ,JK)
- PRRS(JI,JJ,JK) = ZW_RRS(JI,JJ,JK)
- PRIS(JI,JJ,JK) = ZW_RIS(JI,JJ,JK)
- PRSS(JI,JJ,JK) = ZW_RSS(JI,JJ,JK)
- PRGS(JI,JJ,JK) = ZW_RGS(JI,JJ,JK)
- PTHS(JI,JJ,JK) = ZW_THS(JI,JJ,JK)
- ENDDO
- ENDDO
-ENDDO
-IF (KRR==7) PRHS(:,:,:) = ZW_RHS(:,:,:)
-IF(LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'CORR_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET(PRVS(:,:,:)*PRHODJ(:,:,:), 6, 'CORR_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'CORR_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'CORR_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'CORR_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'CORR_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'CORR_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (KRR==7) THEN
- IF (LBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), 12,'CORR_BU_RRH',YDDDH, YDLDDH, YDMDDH)
- ENDIF
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-!* 8. COMPUTE THE SEDIMENTATION (RS) SOURCE
-! -------------------------------------
-!
-IF(LSEDIM_AFTER) THEN
- !
- !* 8.1 sedimentation
- !
- 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, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, &
- &PDZZ, &
- &PRHODREF, PPABST, PTHT, PRHODJ, &
- &PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,&
- &PRSS, PRSS*PTSTEP, PRGS, PRGS*PTSTEP,&
- &PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA=PSEA, PTOWN=PTOWN, &
- &PINPRH=PINPRH, PRHT=PRHS*PTSTEP, PRHS=PRHS, PFPR=PFPR)
- ELSE
- CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, &
- &PDZZ, &
- &PRHODREF, PPABST, PTHT, PRHODJ, &
- &PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,&
- &PRSS, PRSS*PTSTEP, PRGS, PRGS*PTSTEP,&
- &PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA=PSEA, PTOWN=PTOWN, &
- &PFPR=PFPR)
- ENDIF
- PINPRS(:,:) = PINPRS(:,:) + ZINPRI(:,:)
- !No negativity correction here as we apply sedimentation on PR.S*PTSTEP variables
- ELSEIF(HSEDIM=='SPLI') THEN
- !SR: It *seems* that we must have two separate calls for ifort
- IF(KRR==7) THEN
- CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, &
- &PDZZ, &
- &PRHODREF, PPABST, PTHT, PRHODJ, &
- &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
- &PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA=PSEA, PTOWN=PTOWN, &
- &PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR)
- ELSE
- CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, &
- &PDZZ, &
- &PRHODREF, PPABST, PTHT, PRHODJ, &
- &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
- &PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA=PSEA, PTOWN=PTOWN, &
- &PFPR=PFPR)
- ENDIF
- PINPRS(:,:) = PINPRS(:,:) + ZINPRI(:,:)
- !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:
- ! sedimentation tendency and an external tendency which represents all other
- ! processes (mainly advection and microphysical processes). If both tendencies
- ! are negative, sedimentation can remove a specie at a given sub-timestep. From
- ! this point sedimentation stops for the remaining sub-timesteps but the other tendency
- ! will be still active and will lead to negative values.
- ! We could prevent the algorithm to not consume too much a specie, instead we apply
- ! a correction here.
- CALL CORRECT_NEGATIVITIES(KIT, KJT, KKT, KRR, PRVS, PRCS, PRRS, &
- &PRIS, PRSS, PRGS, &
- &PTHS, ZZ_LVFACT, ZZ_LSFACT, PRHS)
- ELSE
- WRITE(*,*) ' STOP'
- WRITE(*,*) ' NO SEDIMENTATION SCHEME FOR HSEDIM=', HSEDIM
- CALL ABORT
- STOP
- END IF
- !
- !* 8.2 budget storage
- !
- IF (LBUDGET_RC .AND. OSEDIC) &
- CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'SEDI_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'SEDI_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'SEDI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:), 10, 'SEDI_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:), 11, 'SEDI_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF ( KRR == 7 .AND. LBUDGET_RH) &
- CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:), 12, 'SEDI_BU_RRH',YDDDH, YDLDDH, YDMDDH)
- !
- !sedimentation of rain fraction
- CALL ICE4_RAINFR_VERT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, KKT, KKL, ZRAINFR, PRRS(:,:,:)*PTSTEP)
-
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-!* 9. COMPUTE THE FOG DEPOSITION TERM
-! -------------------------------------
-!
-IF (LDEPOSC) THEN !cloud water deposition on vegetation
- PRCS(:,:,IKB) = PRCS(:,:,IKB) - XVDEPOSC * PRCT(:,:,IKB) / PDZZ(:,:,IKB)
- PINPRC(:,:) = PINPRC(:,:) + XVDEPOSC * PRCT(:,:,IKB) * PRHODREF(:,:,IKB)/XRHOLW
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- !PINDEP(:,:) = XVDEPOSC * PRCT(:,:,KKB) * PRHODREF(:,:,KKB) /XRHOLW
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'DEPO_BU_RRC',YDDDH, YDLDDH, YDMDDH)
-ENDIF
-
-IF (LHOOK) CALL DR_HOOK('RAIN_ICE', 1, ZHOOK_HANDLE)
-!
-CONTAINS
- FUNCTION RAIN_ICE_COUNTJV(LTAB, KIT, KJT, KKT, KSIZE, I1,I2,I3) RESULT(IC)
- !
- !* 0. DECLARATIONS
- ! ------------
- !
- IMPLICIT NONE
- !
- !* 0.2 declaration of local variables
- !
- !
- INTEGER, INTENT(IN) :: KIT, KJT, KKT, KSIZE
- LOGICAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: LTAB ! Mask
- INTEGER, DIMENSION(KSIZE), INTENT(OUT) :: I1,I2,I3 ! Used to replace the COUNT and PACK
- INTEGER :: JI,JJ,JK,IC
- !
- !-------------------------------------------------------------------------------
- !
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
- IF (LHOOK) CALL DR_HOOK('RAIN_ICE:RAIN_ICE_COUNTJV', 0, ZHOOK_HANDLE)
- IC = 0
- DO JK = 1, SIZE(LTAB,3)
- DO JJ = 1, SIZE(LTAB,2)
- DO JI = 1, SIZE(LTAB,1)
- IF(LTAB(JI,JJ,JK)) THEN
- IC = IC +1
- I1(IC) = JI
- I2(IC) = JJ
- I3(IC) = JK
- END IF
- END DO
- END DO
- END DO
- !
- IF (LHOOK) CALL DR_HOOK('RAIN_ICE:RAIN_ICE_COUNTJV', 1, ZHOOK_HANDLE)
- !
- END FUNCTION RAIN_ICE_COUNTJV
- !
- !
- SUBROUTINE CORRECT_NEGATIVITIES(KIT, KJT, KKT, KRR, PRV, PRC, PRR, &
- &PRI, PRS, PRG, &
- &PTH, PLVFACT, PLSFACT, PRH)
- !
- IMPLICIT NONE
- !
- INTEGER, INTENT(IN) :: KIT, KJT, KKT, KRR
- REAL, DIMENSION(KIT, KJT, KKT), INTENT(INOUT) :: PRV, PRC, PRR, PRI, PRS, PRG, PTH
- REAL, DIMENSION(KIT, KJT, KKT), INTENT(IN) :: PLVFACT, PLSFACT
- REAL, DIMENSION(KIT, KJT, KKT), OPTIONAL, INTENT(INOUT) :: PRH
- !
- REAL, DIMENSION(KIT, KJT, KKT) :: ZW
- INTEGER :: JI, JJ, JK
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
- !
- IF (LHOOK) CALL DR_HOOK('RAIN_ICE:CORRECT_NEGATIVITIES', 0, ZHOOK_HANDLE)
- !
- !We correct negativities with conservation
- ! 1) deal with negative values for mixing ratio, except for vapor
- DO JK = 1, KKT
- DO JJ = 1, KJT
- DO JI = 1, KIT
- ZW(JI,JJ,JK) =PRC(JI,JJ,JK)-MAX(PRC(JI,JJ,JK), 0.)
- PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
- PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLVFACT(JI,JJ,JK)
- PRC(JI,JJ,JK)=PRC(JI,JJ,JK)-ZW(JI,JJ,JK)
-
- ZW(JI,JJ,JK) =PRR(JI,JJ,JK)-MAX(PRR(JI,JJ,JK), 0.)
- PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
- PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLVFACT(JI,JJ,JK)
- PRR(JI,JJ,JK)=PRR(JI,JJ,JK)-ZW(JI,JJ,JK)
-
- ZW(JI,JJ,JK) =PRI(JI,JJ,JK)-MAX(PRI(JI,JJ,JK), 0.)
- PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
- PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
- PRI(JI,JJ,JK)=PRI(JI,JJ,JK)-ZW(JI,JJ,JK)
-
- ZW(JI,JJ,JK) =PRS(JI,JJ,JK)-MAX(PRS(JI,JJ,JK), 0.)
- PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
- PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
- PRS(JI,JJ,JK)=PRS(JI,JJ,JK)-ZW(JI,JJ,JK)
-
- ZW(JI,JJ,JK) =PRG(JI,JJ,JK)-MAX(PRG(JI,JJ,JK), 0.)
- PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
- PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
- PRG(JI,JJ,JK)=PRG(JI,JJ,JK)-ZW(JI,JJ,JK)
- ENDDO
- ENDDO
- ENDDO
-
- IF(KRR==7) THEN
- DO JK = 1, KKT
- DO JJ = 1, KJT
- DO JI = 1, KIT
- ZW(JI,JJ,JK) =PRH(JI,JJ,JK)-MAX(PRH(JI,JJ,JK), 0.)
- PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
- PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
- PRH(JI,JJ,JK)=PRH(JI,JJ,JK)-ZW(JI,JJ,JK)
- ENDDO
- ENDDO
- ENDDO
- ENDIF
-
- ! 2) deal with negative vapor mixing ratio
-
- DO JK = 1, KKT
- DO JJ = 1, KJT
- DO JI = 1, KIT
- ! for rc and ri, we keep ice fraction constant
- ZW(JI,JJ,JK)=MIN(1., MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.) / &
- &MAX(PRC(JI,JJ,JK)+PRI(JI,JJ,JK), 1.E-20)) ! Proportion of rc+ri to convert into rv
- PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)* &
- &(PRC(JI,JJ,JK)*PLVFACT(JI,JJ,JK)+PRI(JI,JJ,JK)*PLSFACT(JI,JJ,JK))
- PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)*(PRC(JI,JJ,JK)+PRI(JI,JJ,JK))
- PRC(JI,JJ,JK)=(1.-ZW(JI,JJ,JK))*PRC(JI,JJ,JK)
- PRI(JI,JJ,JK)=(1.-ZW(JI,JJ,JK))*PRI(JI,JJ,JK)
-
- ZW(JI,JJ,JK)=MIN(MAX(PRR(JI,JJ,JK), 0.), &
- &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rr to convert into rv
- PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
- PRR(JI,JJ,JK)=PRR(JI,JJ,JK)-ZW(JI,JJ,JK)
- PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLVFACT(JI,JJ,JK)
-
- ZW(JI,JJ,JK)=MIN(MAX(PRS(JI,JJ,JK), 0.), &
- &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rs to convert into rv
- PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
- PRS(JI,JJ,JK)=PRS(JI,JJ,JK)-ZW(JI,JJ,JK)
- PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
-
- ZW(JI,JJ,JK)=MIN(MAX(PRG(JI,JJ,JK), 0.), &
- &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rg to convert into rv
- PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
- PRG(JI,JJ,JK)=PRG(JI,JJ,JK)-ZW(JI,JJ,JK)
- PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
- ENDDO
- ENDDO
- ENDDO
-
- IF(KRR==7) THEN
- DO JK = 1, KKT
- DO JJ = 1, KJT
- DO JI = 1, KIT
- ZW(JI,JJ,JK)=MIN(MAX(PRH(JI,JJ,JK), 0.), &
- &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rh to convert into rv
- PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
- PRH(JI,JJ,JK)=PRH(JI,JJ,JK)-ZW(JI,JJ,JK)
- PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
- ENDDO
- ENDDO
- ENDDO
- ENDIF
- !
- IF (LHOOK) CALL DR_HOOK('RAIN_ICE:CORRECT_NEGATIVITIES', 1, ZHOOK_HANDLE)
- !
- END SUBROUTINE CORRECT_NEGATIVITIES
-
-!
-END SUBROUTINE RAIN_ICE
diff --git a/src/arome/micro/rain_ice_old.F90 b/src/arome/micro/rain_ice_old.F90
index eb1d734b8a1c9b413d38ad608ba67d6fafa7875b..9a83426d0060f359f1bcd9031ee0d6af3232c064 100644
--- a/src/arome/micro/rain_ice_old.F90
+++ b/src/arome/micro/rain_ice_old.F90
@@ -169,7 +169,7 @@ USE MODD_PARAM_ICE
USE MODD_BUDGET
USE MODD_SPP_TYPE
USE MODD_LES
-USE MODI_BUDGET
+USE MODI_BUDGET_DDH
USE MODI_GAMMA
USE MODD_TIWMX
USE MODI_ICECLOUD
@@ -1201,87 +1201,87 @@ IF( IMICRO >= 0 ) THEN
! Reordered for compability with flexible structures like in AROME
! rain_ice_slow
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HON_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'HON_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HON_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'SFR_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'SFR_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'SFR_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'DEPS_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),6,'DEPS_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'DEPS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'AGGS_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'AGGS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'AUTS_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'AUTS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'DEPG_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),6,'DEPG_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'DEPG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HON_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7,'HON_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HON_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'SFR_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8,'SFR_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'SFR_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'DEPS_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RV) CALL BUDGET_DDH (PRVS(:,:,:)*PRHODJ(:,:,:),6,'DEPS_BU_RRV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RS) CALL BUDGET_DDH (PRSS(:,:,:)*PRHODJ(:,:,:),10,'DEPS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'AGGS_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RS) CALL BUDGET_DDH (PRSS(:,:,:)*PRHODJ(:,:,:),10,'AGGS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'AUTS_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RS) CALL BUDGET_DDH (PRSS(:,:,:)*PRHODJ(:,:,:),10,'AUTS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'DEPG_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RV) CALL BUDGET_DDH (PRVS(:,:,:)*PRHODJ(:,:,:),6,'DEPG_BU_RRV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'DEPG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
IF (OWARM) THEN ! rain_ice_warm
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'AUTO_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'AUTO_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'ACCR_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'ACCR_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'REVA_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),6,'REVA_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'REVA_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7,'AUTO_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8,'AUTO_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7,'ACCR_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8,'ACCR_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'REVA_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RV) CALL BUDGET_DDH (PRVS(:,:,:)*PRHODJ(:,:,:),6,'REVA_BU_RRV',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8,'REVA_BU_RRR',YDDDH, YDLDDH, YDMDDH)
ENDIF
!rain_ice_fast_rs
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'RIM_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'RIM_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'RIM_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'RIM_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'ACC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'ACC_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'ACC_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'ACC_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'CMEL_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'CMEL_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'RIM_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7,'RIM_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RS) CALL BUDGET_DDH (PRSS(:,:,:)*PRHODJ(:,:,:),10,'RIM_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'RIM_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'ACC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8,'ACC_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RS) CALL BUDGET_DDH (PRSS(:,:,:)*PRHODJ(:,:,:),10,'ACC_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'ACC_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RS) CALL BUDGET_DDH (PRSS(:,:,:)*PRHODJ(:,:,:),10,'CMEL_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'CMEL_BU_RRG',YDDDH, YDLDDH, YDMDDH)
!rain_ice_fast_rg
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'CFRZ_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'CFRZ_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'CFRZ_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'CFRZ_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'WETG_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'WETG_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'WETG_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'WETG_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'WETG_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'WETG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:),12,'WETG_BU_RRH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'DRYG_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'DRYG_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'DRYG_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'DRYG_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'DRYG_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'DRYG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'GMLT_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'GMLT_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'GMLT_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'CFRZ_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8,'CFRZ_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'CFRZ_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'CFRZ_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'WETG_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7,'WETG_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8,'WETG_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'WETG_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RS) CALL BUDGET_DDH (PRSS(:,:,:)*PRHODJ(:,:,:),10,'WETG_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'WETG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RH) CALL BUDGET_DDH (PRHS(:,:,:)*PRHODJ(:,:,:),12,'WETG_BU_RRH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'DRYG_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7,'DRYG_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8,'DRYG_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'DRYG_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RS) CALL BUDGET_DDH (PRSS(:,:,:)*PRHODJ(:,:,:),10,'DRYG_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'DRYG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'GMLT_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8,'GMLT_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'GMLT_BU_RRG',YDDDH, YDLDDH, YDMDDH)
IF(KRR==7) THEN ! rain_ice_fast_rh
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'WETH_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'WETH_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'WETH_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'WETH_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'WETH_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'WETH_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:),12,'WETH_BU_RRH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HMLT_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'HMLT_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:),12,'HMLT_BU_RRH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'WETH_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7,'WETH_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8,'WETH_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'WETH_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RS) CALL BUDGET_DDH (PRSS(:,:,:)*PRHODJ(:,:,:),10,'WETH_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'WETH_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RH) CALL BUDGET_DDH (PRHS(:,:,:)*PRHODJ(:,:,:),12,'WETH_BU_RRH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HMLT_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8,'HMLT_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RH) CALL BUDGET_DDH (PRHS(:,:,:)*PRHODJ(:,:,:),12,'HMLT_BU_RRH',YDDDH, YDLDDH, YDMDDH)
ENDIF
!rain_ice_fast_ri
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'IMLT_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'IMLT_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'IMLT_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'BERFI_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'BERFI_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'BERFI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'IMLT_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7,'IMLT_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'IMLT_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'BERFI_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RC) CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7,'BERFI_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'BERFI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
!
END IF
!
@@ -1765,13 +1765,13 @@ IF (KRR == 7 .AND. (ILENALLOCH .GT. 0 )) DEALLOCATE(ZRHODREFH,ZRHS,ILISTH)
!* 2.3 budget storage
!
IF (LBUDGET_RC .AND. OSEDIC) &
- CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'SEDI_BU_RRC',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'SEDI_BU_RRR',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9 ,'SEDI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'SEDI_BU_RRS',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'SEDI_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'SEDI_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'SEDI_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9 ,'SEDI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_RS) CALL BUDGET_DDH (PRSS(:,:,:)*PRHODJ(:,:,:),10,'SEDI_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'SEDI_BU_RRG',YDDDH, YDLDDH, YDMDDH)
IF ( KRR == 7 .AND. LBUDGET_RH) &
- CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:),12,'SEDI_BU_RRH',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PRHS(:,:,:)*PRHODJ(:,:,:),12,'SEDI_BU_RRH',YDDDH, YDLDDH, YDMDDH)
!
IF (LHOOK) CALL DR_HOOK('RAIN_ICE_OLD:RAIN_ICE_SEDIMENTATION_SPLIT',1,ZHOOK_HANDLE)
END SUBROUTINE RAIN_ICE_SEDIMENTATION_SPLIT
@@ -2214,13 +2214,13 @@ END DO
!* 2.3 budget storage
!
IF (LBUDGET_RC .AND. OSEDIC) &
- CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'SEDI_BU_RRC',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'SEDI_BU_RRR',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9 ,'SEDI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'SEDI_BU_RRS',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'SEDI_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'SEDI_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_RR) CALL BUDGET_DDH (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'SEDI_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9 ,'SEDI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_RS) CALL BUDGET_DDH (PRSS(:,:,:)*PRHODJ(:,:,:),10,'SEDI_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_RG) CALL BUDGET_DDH (PRGS(:,:,:)*PRHODJ(:,:,:),11,'SEDI_BU_RRG',YDDDH, YDLDDH, YDMDDH)
IF ( KRR == 7 .AND. LBUDGET_RH) &
- CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:),12,'SEDI_BU_RRH',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PRHS(:,:,:)*PRHODJ(:,:,:),12,'SEDI_BU_RRH',YDDDH, YDLDDH, YDMDDH)
!
IF (LHOOK) CALL DR_HOOK('RAIN_ICE_OLD:RAIN_ICE_SEDIMENTATION_STAT',1,ZHOOK_HANDLE)
@@ -2389,9 +2389,9 @@ END IF
!
!* 3.1.3 budget storage
!
-IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HENU_BU_RTH',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),6,'HENU_BU_RRV',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HENU_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_TH) CALL BUDGET_DDH (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HENU_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_RV) CALL BUDGET_DDH (PRVS(:,:,:)*PRHODJ(:,:,:),6,'HENU_BU_RRV',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_RI) CALL BUDGET_DDH (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HENU_BU_RRI',YDDDH, YDLDDH, YDMDDH)
!
IF (LHOOK) CALL DR_HOOK('RAIN_ICE_OLD:RAIN_ICE_NUCLEATION',1,ZHOOK_HANDLE)
END SUBROUTINE RAIN_ICE_NUCLEATION
@@ -2422,13 +2422,13 @@ IMPLICIT NONE
ZTHS(:) = ZTHS(:) + ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RCHONI))
ENDWHERE
!
- IF (LBUDGET_TH) CALL BUDGET ( &
+ IF (LBUDGET_TH) CALL BUDGET_DDH ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
4,'HON_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET ( &
+ IF (LBUDGET_RC) CALL BUDGET_DDH ( &
UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
7,'HON_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET ( &
+ IF (LBUDGET_RI) CALL BUDGET_DDH ( &
UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
9,'HON_BU_RRI',YDDDH, YDLDDH, YDMDDH)
!
@@ -2442,13 +2442,13 @@ IMPLICIT NONE
ZTHS(:) = ZTHS(:) + ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RRHONG))
ENDWHERE
!
- IF (LBUDGET_TH) CALL BUDGET ( &
+ IF (LBUDGET_TH) CALL BUDGET_DDH ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
4,'SFR_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET ( &
+ IF (LBUDGET_RR) CALL BUDGET_DDH ( &
UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
8,'SFR_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET ( &
+ IF (LBUDGET_RG) CALL BUDGET_DDH ( &
UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
11,'SFR_BU_RRG',YDDDH, YDLDDH, YDMDDH)
!
@@ -2510,13 +2510,13 @@ IMPLICIT NONE
END WHERE
ENDIF
- IF (LBUDGET_TH) CALL BUDGET ( &
+ IF (LBUDGET_TH) CALL BUDGET_DDH ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
4,'DEPS_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET ( &
+ IF (LBUDGET_RV) CALL BUDGET_DDH ( &
UNPACK(ZRVS(:),MASK=GMICRO(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:), &
6,'DEPS_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET ( &
+ IF (LBUDGET_RS) CALL BUDGET_DDH ( &
UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
10,'DEPS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
!
@@ -2531,10 +2531,10 @@ IMPLICIT NONE
ZRSS(:) = ZRSS(:) + ZZW(:)
ZRIS(:) = ZRIS(:) - ZZW(:)
END WHERE
- IF (LBUDGET_RI) CALL BUDGET ( &
+ IF (LBUDGET_RI) CALL BUDGET_DDH ( &
UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
9,'AGGS_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET ( &
+ IF (LBUDGET_RS) CALL BUDGET_DDH ( &
UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
10,'AGGS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
!
@@ -2570,10 +2570,10 @@ IMPLICIT NONE
ENDIF
DEALLOCATE(ZCRIAUTI)
- IF (LBUDGET_RI) CALL BUDGET ( &
+ IF (LBUDGET_RI) CALL BUDGET_DDH ( &
UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
9,'AUTS_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET ( &
+ IF (LBUDGET_RS) CALL BUDGET_DDH ( &
UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
10,'AUTS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
!
@@ -2616,13 +2616,13 @@ IMPLICIT NONE
END IF
- IF (LBUDGET_TH) CALL BUDGET ( &
+ IF (LBUDGET_TH) CALL BUDGET_DDH ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
4,'DEPG_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET ( &
+ IF (LBUDGET_RV) CALL BUDGET_DDH ( &
UNPACK(ZRVS(:),MASK=GMICRO(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:), &
6,'DEPG_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET ( &
+ IF (LBUDGET_RG) CALL BUDGET_DDH ( &
UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
11,'DEPG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
!
@@ -2666,10 +2666,10 @@ IMPLICIT NONE
END WHERE
ENDIF
!
- IF (LBUDGET_RC) CALL BUDGET ( &
+ IF (LBUDGET_RC) CALL BUDGET_DDH ( &
UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
7,'AUTO_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET ( &
+ IF (LBUDGET_RR) CALL BUDGET_DDH ( &
UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
8,'AUTO_BU_RRR',YDDDH, YDLDDH, YDMDDH)
!
@@ -2720,10 +2720,10 @@ IMPLICIT NONE
STOP 'wrong CSUBG_RC_RR_ACCR case'
ENDIF
- IF (LBUDGET_RC) CALL BUDGET ( &
+ IF (LBUDGET_RC) CALL BUDGET_DDH ( &
UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
7,'ACCR_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET ( &
+ IF (LBUDGET_RR) CALL BUDGET_DDH ( &
UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
8,'ACCR_BU_RRR',YDDDH, YDLDDH, YDMDDH)
!
@@ -2836,13 +2836,13 @@ IMPLICIT NONE
STOP 'wrong CSUBG_RR_EVAP case'
END IF
- IF (LBUDGET_TH) CALL BUDGET ( &
+ IF (LBUDGET_TH) CALL BUDGET_DDH ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
4,'REVA_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET ( &
+ IF (LBUDGET_RV) CALL BUDGET_DDH ( &
UNPACK(ZRVS(:),MASK=GMICRO(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:), &
6,'REVA_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET ( &
+ IF (LBUDGET_RR) CALL BUDGET_DDH ( &
UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
8,'REVA_BU_RRR',YDDDH, YDLDDH, YDMDDH)
ZW(:,:,:)=PEVAP3D(:,:,:)
@@ -2974,16 +2974,16 @@ IMPLICIT NONE
DEALLOCATE(ZVEC2)
DEALLOCATE(ZVEC1)
END IF
- IF (LBUDGET_TH) CALL BUDGET ( &
+ IF (LBUDGET_TH) CALL BUDGET_DDH ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
4,'RIM_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET ( &
+ IF (LBUDGET_RC) CALL BUDGET_DDH ( &
UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
7,'RIM_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET ( &
+ IF (LBUDGET_RS) CALL BUDGET_DDH ( &
UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
10,'RIM_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET ( &
+ IF (LBUDGET_RG) CALL BUDGET_DDH ( &
UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
11,'RIM_BU_RRG',YDDDH, YDLDDH, YDMDDH)
DEALLOCATE(GRIM)
@@ -3103,16 +3103,16 @@ IMPLICIT NONE
DEALLOCATE(ZVEC1)
END IF
DEALLOCATE(GACC)
- IF (LBUDGET_TH) CALL BUDGET ( &
+ IF (LBUDGET_TH) CALL BUDGET_DDH ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
4,'ACC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET ( &
+ IF (LBUDGET_RR) CALL BUDGET_DDH ( &
UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
8,'ACC_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET ( &
+ IF (LBUDGET_RS) CALL BUDGET_DDH ( &
UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
10,'ACC_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET ( &
+ IF (LBUDGET_RG) CALL BUDGET_DDH ( &
UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
11,'ACC_BU_RRG',YDDDH, YDLDDH, YDMDDH)
!
@@ -3140,10 +3140,10 @@ IMPLICIT NONE
ZRSS(:) = ZRSS(:) - ZZW(:)
ZRGS(:) = ZRGS(:) + ZZW(:)
END WHERE
- IF (LBUDGET_RS) CALL BUDGET ( &
+ IF (LBUDGET_RS) CALL BUDGET_DDH ( &
UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
10,'CMEL_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET ( &
+ IF (LBUDGET_RG) CALL BUDGET_DDH ( &
UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
11,'CMEL_BU_RRG',YDDDH, YDLDDH, YDMDDH)
!
@@ -3180,16 +3180,16 @@ IMPLICIT NONE
ZRGS(:) = ZRGS(:) + ZZW1(:,3)+ZZW1(:,4)
ZTHS(:) = ZTHS(:) + ZZW1(:,4)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*RRCFRIG)
END WHERE
- IF (LBUDGET_TH) CALL BUDGET ( &
+ IF (LBUDGET_TH) CALL BUDGET_DDH ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
4,'CFRZ_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET ( &
+ IF (LBUDGET_RR) CALL BUDGET_DDH ( &
UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
8,'CFRZ_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET ( &
+ IF (LBUDGET_RI) CALL BUDGET_DDH ( &
UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
9,'CFRZ_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET ( &
+ IF (LBUDGET_RG) CALL BUDGET_DDH ( &
UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
11,'CFRZ_BU_RRG',YDDDH, YDLDDH, YDMDDH)
!
@@ -3407,26 +3407,26 @@ IMPLICIT NONE
! f(L_f*(RCWETG+RRWETG))
END WHERE
END IF
- IF (LBUDGET_TH) CALL BUDGET ( &
+ IF (LBUDGET_TH) CALL BUDGET_DDH ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
4,'WETG_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET ( &
+ IF (LBUDGET_RC) CALL BUDGET_DDH ( &
UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
7,'WETG_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET ( &
+ IF (LBUDGET_RR) CALL BUDGET_DDH ( &
UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
8,'WETG_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET ( &
+ IF (LBUDGET_RI) CALL BUDGET_DDH ( &
UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
9,'WETG_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET ( &
+ IF (LBUDGET_RS) CALL BUDGET_DDH ( &
UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
10,'WETG_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET ( &
+ IF (LBUDGET_RG) CALL BUDGET_DDH ( &
UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
11,'WETG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
IF ( KRR == 7 ) THEN
- IF (LBUDGET_RH) CALL BUDGET ( &
+ IF (LBUDGET_RH) CALL BUDGET_DDH ( &
UNPACK(ZRHS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
12,'WETG_BU_RRH',YDDDH, YDLDDH, YDMDDH)
END IF
@@ -3443,22 +3443,22 @@ IMPLICIT NONE
ZTHS(:) = ZTHS(:) + (ZZW1(:,1)+ZZW1(:,4))*(ZLSFACT(:)-ZLVFACT(:)) !
! f(L_f*(RCDRYG+RRDRYG))
END WHERE
- IF (LBUDGET_TH) CALL BUDGET ( &
+ IF (LBUDGET_TH) CALL BUDGET_DDH ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
4,'DRYG_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET ( &
+ IF (LBUDGET_RC) CALL BUDGET_DDH ( &
UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
7,'DRYG_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET ( &
+ IF (LBUDGET_RR) CALL BUDGET_DDH ( &
UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
8,'DRYG_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET ( &
+ IF (LBUDGET_RI) CALL BUDGET_DDH ( &
UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
9,'DRYG_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET ( &
+ IF (LBUDGET_RS) CALL BUDGET_DDH ( &
UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
10,'DRYG_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET ( &
+ IF (LBUDGET_RG) CALL BUDGET_DDH ( &
UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
11,'DRYG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
!
@@ -3488,13 +3488,13 @@ IMPLICIT NONE
ZRGS(:) = ZRGS(:) - ZZW(:)
ZTHS(:) = ZTHS(:) - ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(-RGMLTR))
END WHERE
- IF (LBUDGET_TH) CALL BUDGET ( &
+ IF (LBUDGET_TH) CALL BUDGET_DDH ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
4,'GMLT_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET ( &
+ IF (LBUDGET_RR) CALL BUDGET_DDH ( &
UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
8,'GMLT_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET ( &
+ IF (LBUDGET_RG) CALL BUDGET_DDH ( &
UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
11,'GMLT_BU_RRG',YDDDH, YDLDDH, YDMDDH)
IF (LHOOK) CALL DR_HOOK('RAIN_ICE_OLD:RAIN_ICE_FAST_RG',1,ZHOOK_HANDLE)
@@ -3705,25 +3705,25 @@ IMPLICIT NONE
! f(L_f*(RCWETH+RRWETH))
END WHERE
END IF
- IF (LBUDGET_TH) CALL BUDGET ( &
+ IF (LBUDGET_TH) CALL BUDGET_DDH ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
4,'WETH_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET ( &
+ IF (LBUDGET_RC) CALL BUDGET_DDH ( &
UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
7,'WETH_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET ( &
+ IF (LBUDGET_RR) CALL BUDGET_DDH ( &
UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
8,'WETH_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET ( &
+ IF (LBUDGET_RI) CALL BUDGET_DDH ( &
UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
9,'WETH_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET ( &
+ IF (LBUDGET_RS) CALL BUDGET_DDH ( &
UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
10,'WETH_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET ( &
+ IF (LBUDGET_RG) CALL BUDGET_DDH ( &
UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
11,'WETH_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET ( &
+ IF (LBUDGET_RH) CALL BUDGET_DDH ( &
UNPACK(ZRHS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
12,'WETH_BU_RRH',YDDDH, YDLDDH, YDMDDH)
!
@@ -3779,13 +3779,13 @@ IMPLICIT NONE
END WHERE
END IF
DEALLOCATE(GHAIL)
- IF (LBUDGET_TH) CALL BUDGET ( &
+ IF (LBUDGET_TH) CALL BUDGET_DDH ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
4,'HMLT_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET ( &
+ IF (LBUDGET_RR) CALL BUDGET_DDH ( &
UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
8,'HMLT_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET ( &
+ IF (LBUDGET_RH) CALL BUDGET_DDH ( &
UNPACK(ZRHS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
12,'HMLT_BU_RRH',YDDDH, YDLDDH, YDMDDH)
!
@@ -3816,13 +3816,13 @@ IMPLICIT NONE
ZRIS(:) = 0.0
ZCIT(:) = 0.0
END WHERE
- IF (LBUDGET_TH) CALL BUDGET ( &
+ IF (LBUDGET_TH) CALL BUDGET_DDH ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
4,'IMLT_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET ( &
+ IF (LBUDGET_RC) CALL BUDGET_DDH ( &
UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
7,'IMLT_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET ( &
+ IF (LBUDGET_RI) CALL BUDGET_DDH ( &
UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
9,'IMLT_BU_RRI',YDDDH, YDLDDH, YDMDDH)
!
@@ -3889,13 +3889,13 @@ IMPLICIT NONE
END WHERE
ENDIF
- IF (LBUDGET_TH) CALL BUDGET ( &
+ IF (LBUDGET_TH) CALL BUDGET_DDH ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
4,'BERFI_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET ( &
+ IF (LBUDGET_RC) CALL BUDGET_DDH ( &
UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
7,'BERFI_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET ( &
+ IF (LBUDGET_RI) CALL BUDGET_DDH ( &
UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
9,'BERFI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
!
diff --git a/src/arome/modset_Ryad/arpifs/phys_dmn/mf_phys.F90 b/src/arome/modset_Ryad/arpifs/phys_dmn/mf_phys.F90
deleted file mode 100644
index f0d6a8ccc5472eae499ec078e0fba3b934e247f0..0000000000000000000000000000000000000000
--- a/src/arome/modset_Ryad/arpifs/phys_dmn/mf_phys.F90
+++ /dev/null
@@ -1,2817 +0,0 @@
-#ifdef RS6K
-@PROCESS NOCHECK
-#endif
-SUBROUTINE MF_PHYS(YDGEOMETRY,YDGMV,YDSURF,YDCFU,YDXFU,YDMODEL,&
- !---------------------------------------------------------------------
- ! - INPUT and INOUT.
- & KBL,KGPCOMP,KST,KEND,KGL1,KGL2,KSTGLO,&
- & LDCONFX,PDTPHY,&
- & KIBL,POROGL,POROGM,&
- & PCUCONVCA,PNLCONVCA,&
- & PGMV,PGMVS,PGFL,PWT0,PWT0L,PWT0M,&
- & PRCP0,PHI0,PHIF0,PRE0,PRE0F,PREPHY0,PREPHY0F,PXYB0,&
- & PWT9,PRCP9,PHI9,PHIF9,PRE9,PRE9F,PREPHY9,PREPHY9F,PXYB9,&
- & PKOZO,PGP2DSDT,PGRADH_PHY,&
- & PFORCEU,PFORCEV,PFORCET,PFORCEQ,&
- & PCTY0,&
- & PB1,PB2,PGMVT1,PGMVT1S,PGFLT1,&
- & PSP_SB,PSP_SG,PSP_RR,&
- & PSD_VF,PSD_VP,PSD_VV,PSD_VH,PSD_VK,PSD_VA,PSD_VC,PSD_DI,PSD_VD,PSD_SFL,&
- & PSD_SFO,PSD_XP,PSD_XP2,&
- & PEMTD,PEMTU,PTRSW,PRMOON,PGPAR,&
- & PGDEOSI,PGUEOSI,PGMU0,PGMU0_MIN,PGMU0_MAX,&
- & PGDEOTI,PGDEOTI2,PGUEOTI,PGUEOTI2,PGEOLT,PGEOXT,&
- & PGRPROX,PGMIXP,PGFLUXC,PGRSURF,&
- !---------------------------------------------------------------------
- ! - OUTPUT .
- & PDHSF,PALBDG,PCAPE,PCTOP,PCLCC,PCLCH,PCLCL,PCLCM,PCLCT,PCLPH,PVEIN,PCT,&
- & PDIFCQ,PDIFCQI,PDIFCQL,PDIFCS,PDIFTQ,PDIFTQI,PDIFTQL,PDIFTS,&
- & PFCCQL,PFCCQN,PFCHOZ,PFCHSP,PFCLL,PFCLN,PFCQING,PFCQLNG,PFCQNG,PFCS,&
- & PFCSQL,PFCSQN,PFEVL,PFEVN,PFEVV,PFGEL,PFGELS,PFLWSP,PFONTE,&
- & PFPLCL,PFPLCN,PFPLCG,PFPLCHL,PFPLSL,PFPLSN,PFPLSG,PFPLSHL,&
- & PMRT,PFRMH,PFRSO,PFRSOC,PFRSODS,PFRSOLU,PFRSGNI,&
- & PFRSDNI,PFRSOPS,PFRSOPT,PFRTH,PFRTHC,PFRTHDS,PFTR,PGZ0,PGZ0H,PNEB,&
- & PQCLS,PQICE,PQLI,PQS,&
- & PRH,PRHCLS,PRUISL,PRUISP,PRUISS,&
- & PSTRCU,PSTRCV,PSTRDU,PSTRDV,PSTRMU,PSTRMV,PSTRTU,PSTRTV,&
- & PDIFCQLC,PDIFCQIC,PFIMCC,&
- & PFEDQLC,PFEDQIC,PFEDQRC,PFEDQSC,PFCNEGQLC,PFCNEGQIC,PFCNEGQRC,PFCNEGQSC,&
- & PUCLS,PVCLS,PNUCLS,PNVCLS,PTCLS,PUGST,PVGST,&
- & PMOCON,PFDIS,&
- & PFHPCL,PFHPCN,PFHPCG,PFHPSL,PFHPSN,PFHPSG,PFHSCL,PFHSCN,PFHSSL,PFHSSN,PFHSSG,&
- & PFEPFP, PFCMPCQ, PFCMPSN, PFCMPSL,&
- & PTENDU,PTENDV,&
- & PQSOL,&
- & PFPFPSL,PFPFPSN,PFPFPSG,PFPFPCL,PFPFPCN,PFPEVPSL,PFPEVPSN,PFPEVPSG,&
- & PFPEVPCL,PFPEVPCN,PFPEVPCG,PDERNSHF,PFCQRNG, PFCQSNG,PFCQGNG,&
- & PDIAGH,PTPWCLS,PVISICLD, PVISIHYDRO,PMXCLWC,&
- & PFLASH,PTRAJ_PHYS,YDDDH,PFTCNS)
-
-!**** *MF_PHYS* METEO-FRANCE PHYSICS.
-
-! Purpose.
-! --------
-! Call METEO-FRANCE physics and physical tendencies.
-
-!** Interface.
-! ----------
-! *CALL* *MF_PHYS(...)*
-
-! Explicit arguments :
-! --------------------
-
-! INPUT:
-! ------
-! KBL : NPROMA-packets number
-! KGPCOMP : total number of grid points in the domain
-! KST : first element of work.
-! KEND : last element of work.
-! KGL1,KGL2 : first and last latitude of computations.
-! - bounds NGPTOT-packets for DM calculations.
-! KSTGLO : global offset.
-! LDCONFX : (see in CPG)
-! PDTPHY : timestep used in the physics.
-! KIBL : index into YRCSGEOM/YRGSGEOM types in YDGEOMETRY
-! POROGL,POROGM: components of grad(orography).
-! PCUCONVCA : CA array for interaction with the physics
-! PNLCONVCA : CA array for interaction with the physics
-! PGMV : GMV at time t and t-dt.
-! PGMVS : GMVS at time t and t-dt.
-! PGFL : GFL at time t and t-dt.
-! PWT0 : w-wind time t.
-! PWT0L : zonal derivative of w-wind at time t.
-! PWT0M : merid derivative of w-wind at time t.
-! PRCP0 : contains "cp", "R" and "Kap=R/Cp" at t.
-! PHI0 : geopotential height at half levels at time t.
-! PHIF0 : geopotential height at full levels at time t.
-! PRE0 : hydrostatic pressure "prehyd" at half levels at time t.
-! PRE0F : hydrostatic pressure "prehyd" at full levels at time t.
-! PREPHY0 : input pressure "pre" for AROME at half levels at time t.
-! PREPHY0F : input pressure "pre" for AROME at full levels at time t.
-! PXYB0 : contains pressure depth, "delta", "alpha" at time t.
-! PRKQVH : Rasch-Kristjansson scheme - water vapour tendency
-! PRKQCH : Rasch-Kristjansson scheme - condensates tendency
-! PWT9 : Vertical wind time t-dt.
-! PRCP9 : contains "cp", "R" and "Kap=R/Cp" at t-dt.
-! PHI9 : geopotential height at half levels at time t-dt.
-! PHIF9 : geopotential height at full levels at time t-dt.
-! PRE9 : hydrostatic pressure "prehyd" at half levels at time t-dt.
-! PRE9F : hydrostatic pressure "prehyd" at full levels at time t-dt.
-! PREPHY9 : input pressure "pre" for AROME at half levels at time t-dt.
-! PREPHY9F : input pressure "pre" for AROME at full levels at time t-dt.
-! PXYB9 : contains pressure depth, "delta", "alpha" at time t-dt.
-! PKOZO : fields for photochemistery of ozon.
-! PGP2DSDT : stochastic physics random pattern.
-! PGRADH_PHY: horizontal gradients for physics
-
-! INPUT/OUTPUT:
-! -------------
-! PCTY0 : contains vertical velocities, vertical integral of divergence at t.
-! PB1 : "SLB1"-buffer, used for interpolations in the SL scheme.
-! PB2 : "SLB2"-buffer.
-! PGFLT1 : GFL t+dt
-! PGPAR : surface fields for AROME.
-! PGDEOSI : DESCENDING INCREMENTAL OPTICAL DEPTHS, SOLAR
-! PGUEOSI : ASCENDING INCREMENTAL OPTICAL DEPTHS, SOLAR
-! PGMU0 : COSINE OF SOLAR ZENITH ANGLE, APPROXIMATE ACTUAL VALUE
-! PGMU0_MIN : COSINE OF SOLAR ZENITH ANGLE, MIN VALUE
-! PGMU0_MAX : COSINE OF SOLAR ZENITH ANGLE, MAX VALUE
-! PGDEOTI : descending incremental optical depths, dB/dT(T0) weights
-! PGDEOTI2 : descending incremental optical depths, B weights with
-! linear T_e correction
-! PGUEOTI : ascending incremental optical depths, dB/dT(T0) weights
-! PGUEOTI2 : ascending incremental optical depths, B weights with
-! linear T_e correction
-! PGEOLT : local optical depths, dB/dT(T0) weights
-! PGEOXT : maximum optical depths for EBL-EAL, dB/dT(T0) weights
-! PGRPROX : correction term for adjacent exchanges
-! PGMIXP : non-statistical weights for bracketing
-! PGFLUXC : out of bracket part of clearsky EBL, resp. EBL-EAL flux
-! PGRSURF : corrective ratio for surface cts contribution
-
-! OUTPUT:
-! -------
-! PDHSF : distribution of horizontal mean weights used for
-! simplified radiation scheme.
-! ---------------------- output of aplpar ------------------------------
-! PALBDG : modele surface shortwave albedo (diagnostic).
-! PCAPE : CAPE.
-! PCTOP : top of convective nebulosity (diagnostic).
-! PCLCC : convective cloud cover (diagnostic).
-! PCLCH : high cloud cover (diagnostic).
-! PCLCL : low cloud cover (diagnostic).
-! PCLCM : medium cloud cover (diagnostic).
-! PCLCT : total cloud cover (diagnostic).
-! PCLPH : height (in meters) of the PBL.
-! PVEIN : ventilation index in the PBL.
-! PCT : thermical coefficient of soil-vegetation middle.
-! PDIFCQ : convective flux of specific humidity (not rain/snow).
-! PDIFCQI : convective flux of solid water (not rain/snow).
-! PDIFCQL : convective flux of liquid water (not rain/snow).
-! PDIFCS : convective flux of enthalpy (not rain/snow).
-! PDIFTQ : turbulent flux (inc. "q" negative) of specific humidity.
-! PDIFTQI : turbulent flux (inc. "q" negative) of solid water.
-! PDIFTQL : turbulent flux (inc. "q" negative) of liquid water.
-! PDIFTS : turbulent flux of enthalpy (or dry static energy).
-! PFCCQL : convective condensation flux for liquid water.
-! PFCCQN : convective condensation flux for ice.
-! PFCHOZ : ozon photo-chemical flux.
-! PFPFPSL : flux of liquid resol. precipitation: the generation term.
-! PFPFPSN : flux of solid resolved precipitation: the generation term.
-! PFPFPCL : flux of liquid conv. precipitation: the generation term.
-! PFPFPCN : flux of solid conv. precipitation: the generation term.
-! PFPEVPSL : resolved precipitation flux due to evaporation.
-! PFPEVPSN : resolved precipitation flux due to sublimation.
-! PFPEVPCL : convective precipitation flux due to evaporation.
-! PFPEVPCN : convective precipitation flux due to sublimation.
-! PFCHSP : heat flux from surface to deep soil.
-! PFCLL : latent heat flux over liquid water (or wet soil).
-! PFCLN : latent heat flux over snow (or ice).
-! PFCQING : pseudo-flux of ice to correct for "qi"<0.
-! PFCQLNG : pseudo-flux of liquid water to correct for "ql"<0.
-! PFCQNG : pseudo-flux of water to correct for Q<0.
-! PFCS : sensible heat flux at surface level.
-! PFCSQL : stratiform condensation flux for liquid water.
-! PFCSQN : stratiform condensation flux for ice.
-! PFEVL : water vapour flux over liquid water (or wet soil).
-! PFEVN : water vapour flux over snow (or ice) and frozen soil.
-! PFEVV : evapotranspiration flux.
-! PFGEL : freezing flux of soil water.
-! PFGELS : freezing flux of soil water at surface level.
-! PFLWSP : water flux from surface to deep soil.
-! PFONTE : water flux corresponding to surface snow melt.
-! PFPLCL : convective precipitation as rain.
-! PFPLCN : convective precipitation as snow.
-! PFPLCG : convective precipitation as graupel.
-! PFPLCHL : convective precipitation as hail.
-! PFPLSL : stratiform precipitation as rain.
-! PFPLSN : stratiform precipitation as snow.
-! PFPLSG : stratiform precipitation as graupel.
-! PFPLSHL : stratiform precipitation as hail.
-! PMRT : mean radiant temperature.
-! PFRMH : mesospheric enthalpy flux.
-! PFRSO : shortwave radiative flux.
-! PFRSOC : shortwave clear sky radiative flux.
-! PFRSODS : surface downwards solar flux.
-! PFRSOLU : downward lunar flux at surface.
-! PFRSGNI : Global normal irradiance
-! PFRSDNI : Direct normal irradiance
-! PFRSOPS : surface parallel solar flux.
-! PFRSOPT : top parallel solar flux.
-! PFRTH : longwave radiative flux.
-! PFRTHC : longwave clear sky radiative flux.
-! PFRTHDS : surface downwards IR flux.
-! PFTR : transpiration flux.
-! PGZ0 : g*roughness length (current).
-! PGZ0H : current g*thermal roughness length (if KVCLIV >=8).
-! PNEB : fractional cloudiness for radiation.
-! PQCLS : specific humidity at 2 meters (diagnostic).
-! PQICE : specific humidity of solid water for radiation.
-! PQLI : specific humidity of liquid water for radiation.
-! PQS : specific humidity at surface level.
-! PRH : relative humidity.
-! PRHCLS : relative humidity at 2 meters (diagnostic).
-! PRUISL : run-off flux out the interception water-tank.
-! PRUISP : run-off flux in soil.
-! PRUISS : run-off flux at surface level.
-! PSTRCU : convective flux of momentum "U".
-! PSTRCV : convective flux of momentum "V".
-! PSTRDU : gravity wave drag flux "U".
-! PSTRDV : gravity wave drag flux "V".
-! PSTRMU : mesospheric flux for "U"-momentum.
-! PSTRMV : mesospheric flux for "V"-momentum.
-! PSTRTU : turbulent flux of momentum "U".
-! PSTRTV : turbulent flux of momentum "V".
-! PDIFCQLC to PFCNEGQSC:
-! PUCLS : U-component of wind at 10 meters (diagnostic).
-! PVCLS : V-component of wind at 10 meters (diagnostic).
-! PNUCLS : U-component of neutral wind at 10 meters (diagnostic).
-! PNVCLS : V-component of neutral wind at 10 meters (diagnostic).
-! PTCLS : temperature at 2 meters (diagnostic).
-! PTPWCLS : wet-bulb temperature at 2 meters (diagnostic)
-! PUGST : U-component of gusts (diagnostic).
-! PVGST : V-component of gusts (diagnostic).
-! PDERNSHF : derivative of the non solar surface with respect to Tsurf
-! ---------------------- end of output of aplpar -----------------------
-! PMOCON : moisture convergence.
-! PFDIS : enthalpy flux due to dissipation of kinetic energy.
-! PFHPCL : liquid water convective condensation enthalpy flux.
-! PFHPCN : snow convective condensation enthalpy flux.
-! PFHPSL : liquid water stratiform condensation enthalpy flux.
-! PFHPSN : snow stratiform condensation enthalpy flux.
-! PFHSCL : sensible heat flux due to liquid convective precipitations
-! PFHSCN : sensible heat flux due to snow convective precipitations.
-! PFHSSL : sensible heat flux due to liquid stratiform precipitations
-! PFHSSN : sensible heat flux due to snow stratiform precipitations.
-! PTENDU : "U"-wind tendency due to physics.
-! PTENDV : "V"-wind tendency due to physics.
-! PQSOL : surface specific humidity used in case "delta m=1".
-! PFCQRNG : pseudo-flux of rain to correct for Q<0
-! PFCQSNG : pseudo-flux of snow to correct for Q<0
-! PDIAGH : Add Hail diagnostic PDIAGH (AROME)
-! PFLASH : Add lightening density (fl/ km2 /s )
-! PVISICLD : Visibility due to ice and/or water cloud
-! PVISIHYDRO : Vsibility due to precipitations(rain, graupel, snow)
-! PMXCLWC : Cloud Water Liquid Content at HVISI meters
-
-! Implicit arguments :
-! --------------------
-
-! Method.
-! -------
-
-! Externals.
-! ----------
-
-! Reference.
-! ----------
-
-! Author.
-! -------
-! 2000-12-04: F. Bouyssel & J.M. Piriou
-
-! Modifications.
-! --------------
-! 04-Mar-2009 A.Alias : call CPTEND/INITAPLPAR modified to add
-! Humidity Mesopheric flux (ZFRMQ).
-! and IVCLIA removed and call to CPNUDG modified as
-! Nuding mask is now in SD_VF group
-! call HL_APLPAR modified to add PFCQNG for acdifus
-! call APL_AROME modified to add Sulfate/Volcano aerosols for radaer
-! K. Yessad (Jul 2009): remove CDLOCK + some cleanings
-! 2009-10-15 Y. Bouteloup : Store radiative cloud water and ice in GFL (YIRAD and YLRAD)
-! F. Vana 15-Oct-2009 : NSPLTHOI option
-! K.Yessad (Feb 2010): use YM_RADTC and RFORADTC
-! 2010-03-26 Y. Bouteloup : Store radiative cloud water and ice in GFL (AROME case)
-! 2010-04-26 Y. Bouteloup : Only one call to cputqy, cputqys and cputqy_arome
-! This need the use of ZTENDGFL as argument of cptend, cptend_new and apl_arome.
-! 2010-05-11 F. Bouyssel : Use of PINDX, PINDY
-! 2010-05-28 C. Geijo : Fix error in IPTR array element referencing
-! 2010-06-21 O.Riviere/F. Bouyssel : Fix to have Ts evolving in Fa files with Surfex
-! Dec 2010 A.Alias : ZMU0N added to call CPPHINP/APLPAR/APL_AROME/HL_APLPAR
-! CALL to CPNUDG with or with LMSE (A.Voldoire)
-! K. Yessad (Jan 2011): introduce INTDYN_MOD structures.
-! L. Bengtsson-Sedlar & F. Vana 18-Feb-2011 : CA scheme for convection
-! F. Vana 22-Feb-2011 : 3D turbulence
-! 2011-02-01 M. Mokhtari: Add LMDUST and PEXTT9 and PEXTT0 IN APLPAR
-! (treatment of the desert aerosols)
-! 2011-03 A.Alias : new argument to for sunshine hours YSD_VD%YSUND
-! CPNUDG if LMSE=.T. or LMSE=.F. (bugfix)
-! debug ozone GFL (IPO3) (D. St-Martin)
-! Humidity Mesopheric flux (ZFRMQ) added in CPTEND_NEW
-! F.Bouyssel (26-03-2011): Fix to have Snow in hist file with surfex
-! 2011-06: M. Jerczynski - some cleaning to meet norms
-! E. Bazile 2011-08-26 : Output for MUSC 1D with LFA files with WRITEPHYSIO
-! used previously for extracting profiles from 3D (now also available for AROME).
-! K. Yessad (Dec 2011): use YDOROG, YDGSGEOM and YDCSGEOM.
-! 2011-11-21 JF Gueremy : dry convective adjustment (LAJUCV)
-! F. Vana 26-Jan-2012 : historic Qs for TOM's BBC.
-! F.Bouttier Jul 2012: stochastic physics for AROME
-! Z. SASSI : 07-Mar-2013 INITIALIZING THE WEIGHT VECTORS PDHSF(NPROMA)
-! [DISTRIBUTION OF HORIZONTAL MEANS WEIGHTS]
-! F. Vana 28-Nov-2013 : Redesigned trajectory handling
-! T. Wilhelmsson (Sept 2013) Geometry and setup refactoring.
-! 2013-11, D. Degrauwe: Flexible interface CPTEND_FLEX.
-! 2013-11, J. Masek: Passing intermittency arrays for ACRANEB2.
-! K. Yessad (July 2014): Move some variables.
-! 2016-04, J. Masek: Passing sunshine duration to APL_AROME.
-! 2016-09, M. Mokhtari & A. Ambar: replacement of ZEXT and ZEZDIAG by PGFL
-! in aplpar.F90 argument.
-! 2016-10, P. Marguinaud : Port to single precision
-! K. Yessad (Dec 2016): Prune obsolete options.
-! K. Yessad (June 2017): Introduce NHQE model.
-! 2017-09, J. Masek: Shifted dimensioning of PGMU0.
-! K. Yessad (Feb 2018): remove deep-layer formulations.
-! K. Yessad (Apr 2018): introduce key L_RDRY_VD (ensure consistent definition of "dver" everywhere).
-! 2018-09, F. Duruisseau: add rconv and sconv in gfl for bayrad
-! 2018-09, R. Brozkova: Passing of diagnostic hail, global normal
-! irradiance and mean radiant temperature from APLPAR.
-! 2018-09, D. St-Martin : add NOGWD inputs in aplpar
-! 2018-09, M. Michou : add ARPEGE-Climat chemistry call in aplpar
-! R. El Khatib 27-02-2019 Use pointer function SC2PRG to avoid bounds violation
-! 2019-05, I. Etchevers : add visibilities and precipitation type
-! R. El Khatib 27-02-2019 memory bandwidth savings.
-! R. El Khatib 30-Oct-2018 IMAXDRAFT
-! 2019-09, M. Hrastinski: Dataflow for TKE and TTE terms in ALARO DDH (PFTCNS).
-! 2019-09, J. Masek: Modified call to APL_AROME (added argument NFRRC).
-! 2019-12, Y. Bouteloup: Introduction of ZTENDU and ZTENDV for computation of ZDEC in cputqy
-! diferent from PTENDU and PTENDV in the case of the use of Tiedtke scheme to avoid double counting
-! 2020-12, U. Andrae : Introduce SPP for HARMONIE-AROME
-! 2021-01, R. Brozkova: ALARO graupel fix.
-! R. El Khatib 24-Aug-2021 Fix potentially non-associated pointers
-! End Modifications
-!-------------------------------------------------------------------------------
-
-USE GEOMETRY_MOD , ONLY : GEOMETRY
-USE SURFACE_FIELDS_MIX , ONLY : TSURF
-USE YOMGMV , ONLY : TGMV
-USE YOMCFU , ONLY : TCFU
-USE YOMXFU , ONLY : TXFU
-USE TYPE_MODEL , ONLY : MODEL
-USE PARKIND1 , ONLY : JPIM ,JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-USE SC2PRG_MOD , ONLY : SC2PRG
-
-USE YOMCT0 , ONLY : LSLAG, LTWOTL, LNHDYN, LAROME, LSFORCS, LNHQE,LCORWAT
-USE YOMCT3 , ONLY : NSTEP
-USE YOMCVER , ONLY : LVERTFE ,LVFE_GWMPA
-USE YOMDYNA , ONLY : LGWADV, L3DTURB, L_RDRY_VD
-USE YOMNUD , ONLY : NFNUDG ,LNUDG
-USE YOMSNU , ONLY : XPNUDG
-USE MODULE_RADTC_MIX , ONLY : YM_RADTC
-USE YOMSCM , ONLY : LGSCM
-USE YOMCST , ONLY : RG, RD
-USE YOMCHET , ONLY : GCHETN
-USE INTDYN_MOD , ONLY : YYTCTY0 ,YYTRCP0 ,YYTRCP9 ,YYTXYB0_PHY,YYTXYB9_PHY
-USE YOMLSFORC , ONLY : LMUSCLFA
-USE YOMSPSDT , ONLY : YSPPT
-USE YOMTRAJ , ONLY : TRAJ_PHYS_TYPE, LPRTTRAJ
-USE YOMLUN , ONLY : NULOUT
-
-USE DDH_MIX , ONLY : TYP_DDH
-USE INTFLEX_MOD , ONLY : LINTFLEX, TYPE_INTPROCSET, NEWINTPROCSET, CLEANINTPROCSET
-USE SPP_MOD , ONLY : YSPP_CONFIG,YSPP
-! -------------------------------------------------------------------------
-
-IMPLICIT NONE
-
-TYPE(GEOMETRY) ,INTENT(IN) :: YDGEOMETRY
-TYPE(TGMV) ,INTENT(INOUT) :: YDGMV
-TYPE(TSURF) ,INTENT(INOUT) :: YDSURF
-TYPE(TCFU) ,INTENT(INOUT) :: YDCFU
-TYPE(TXFU) ,INTENT(INOUT) :: YDXFU
-TYPE(MODEL) ,INTENT(INOUT) :: YDMODEL
-INTEGER(KIND=JPIM),INTENT(IN) :: KBL
-INTEGER(KIND=JPIM),INTENT(IN) :: KGPCOMP
-INTEGER(KIND=JPIM),INTENT(IN) :: KST
-INTEGER(KIND=JPIM),INTENT(IN) :: KEND
-INTEGER(KIND=JPIM),INTENT(IN) :: KGL1
-INTEGER(KIND=JPIM),INTENT(IN) :: KGL2
-INTEGER(KIND=JPIM),INTENT(IN) :: KSTGLO
-LOGICAL ,INTENT(IN) :: LDCONFX
-REAL(KIND=JPRB) ,INTENT(IN) :: PDTPHY
-INTEGER(KIND=JPIM),INTENT(IN) :: KIBL
-REAL(KIND=JPRB) ,INTENT(IN) :: POROGL(YDGEOMETRY%YRDIM%NPROMA)
-REAL(KIND=JPRB) ,INTENT(IN) :: POROGM(YDGEOMETRY%YRDIM%NPROMA)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PCUCONVCA(YDGEOMETRY%YRDIM%NPROMA)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PNLCONVCA(YDGEOMETRY%YRDIM%NPROMA)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PGMV(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG,YDGMV%NDIMGMV)
-REAL(KIND=JPRB) ,INTENT(IN) :: PGMVS(YDGEOMETRY%YRDIM%NPROMA,YDGMV%NDIMGMVS)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PGFL(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG,YDMODEL%YRML_GCONF%YGFL%NDIM)
-REAL(KIND=JPRB) ,INTENT(IN) :: PWT0(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(IN) :: PWT0L(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(IN) :: PWT0M(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PRCP0(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG,YYTRCP0%NDIM)
-REAL(KIND=JPRB) ,INTENT(IN) :: PHI0(YDGEOMETRY%YRDIM%NPROMA,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(IN) :: PHIF0(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(IN) :: PRE0(YDGEOMETRY%YRDIM%NPROMA,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(IN) :: PRE0F(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(IN) :: PREPHY0(YDGEOMETRY%YRDIM%NPROMA,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(IN) :: PREPHY0F(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(IN) :: PXYB0(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG,YYTXYB0_PHY%NDIM)
-REAL(KIND=JPRB) ,INTENT(IN) :: PWT9(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PRCP9(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG,YYTRCP9%NDIM)
-REAL(KIND=JPRB) ,INTENT(IN) :: PHI9(YDGEOMETRY%YRDIM%NPROMA,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(IN) :: PHIF9(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(IN) :: PRE9(YDGEOMETRY%YRDIM%NPROMA,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(IN) :: PRE9F(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(IN) :: PREPHY9(YDGEOMETRY%YRDIM%NPROMA,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(IN) :: PREPHY9F(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(IN) :: PXYB9(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG,YYTXYB9_PHY%NDIM)
-REAL(KIND=JPRB) ,INTENT(IN) :: PKOZO(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG*YDMODEL%YRML_PHY_G%YRDPHY%NVCLIS+1)
-REAL(KIND=JPRB) ,INTENT(IN) :: PGP2DSDT(YDGEOMETRY%YRDIM%NPROMA,YSPPT%YGPSDT(1)%NG2D)
-REAL(KIND=JPRB) ,INTENT(IN) :: PFORCEU(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(IN) :: PFORCEV(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(IN) :: PFORCET(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(IN) :: PFORCEQ(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PGRADH_PHY(YDGEOMETRY%YRDIM%NPROMA,YDMODEL%YRML_PHY_MF%YRARPHY%NGRADIENTS,YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PCTY0(YDGEOMETRY%YRDIM%NPROMA,0:YDGEOMETRY%YRDIMV%NFLEVG,YYTCTY0%NDIM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PB1(YDGEOMETRY%YRDIM%NPROMA,YDMODEL%YRML_DYN%YRPTRSLB1%NFLDSLB1)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PB2(YDGEOMETRY%YRDIM%NPROMA,YDMODEL%YRML_DYN%YRPTRSLB2%NFLDSLB2)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PGMVT1(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG,YDGMV%YT1%NDIM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PGMVT1S(YDGEOMETRY%YRDIM%NPROMA,YDGMV%YT1%NDIMS)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PGFLT1(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG,YDMODEL%YRML_GCONF%YGFL%NDIM1)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PSP_SB(YDGEOMETRY%YRDIM%NPROMA,YDSURF%YSP_SBD%NLEVS,YDSURF%YSP_SBD%NDIM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PSP_SG(YDGEOMETRY%YRDIM%NPROMA,YDSURF%YSP_SGD%NDIM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PSP_RR(YDGEOMETRY%YRDIM%NPROMA,YDSURF%YSP_RRD%NDIM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PSD_VF(YDGEOMETRY%YRDIM%NPROMA,YDSURF%YSD_VFD%NDIM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PSD_VP(YDGEOMETRY%YRDIM%NPROMA,YDSURF%YSD_VPD%NDIM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PSD_VV(YDGEOMETRY%YRDIM%NPROMA,YDSURF%YSD_VVD%NDIM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PSD_VH(YDGEOMETRY%YRDIM%NPROMA,YDSURF%YSD_VHD%NDIM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PSD_VK(YDGEOMETRY%YRDIM%NPROMA,YDSURF%YSD_VKD%NDIM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PSD_VA(YDGEOMETRY%YRDIM%NPROMA,YDSURF%YSD_VAD%NDIM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PSD_VC(YDGEOMETRY%YRDIM%NPROMA,YDSURF%YSD_VCD%NDIM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PSD_DI(YDGEOMETRY%YRDIM%NPROMA,YDSURF%YSD_DID%NLEVS,YDSURF%YSD_DID%NDIM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PSD_XP(YDGEOMETRY%YRDIM%NPROMA,YDSURF%YSD_XPD%NLEVS,YDSURF%YSD_XPD%NDIM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PSD_XP2(YDGEOMETRY%YRDIM%NPROMA,YDSURF%YSD_XP2D%NLEVS,YDSURF%YSD_XP2D%NDIM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PSD_VD(YDGEOMETRY%YRDIM%NPROMA,YDSURF%YSD_VDD%NDIM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PSD_SFL(YDGEOMETRY%YRDIM%NPROMA,YDSURF%YSD_SFLD%NDIM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PSD_SFO(YDGEOMETRY%YRDIM%NPROMA,YDSURF%YSD_SFOD%NDIM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PEMTD(YDGEOMETRY%YRDIM%NPROMA,1:YDGEOMETRY%YRDIMV%NFLEVG+1)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PEMTU(YDGEOMETRY%YRDIM%NPROMA,1:YDGEOMETRY%YRDIMV%NFLEVG+1)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PTRSW(YDGEOMETRY%YRDIM%NPROMA,1:YDGEOMETRY%YRDIMV%NFLEVG+1)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PRMOON(YDGEOMETRY%YRDIM%NPROMA)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PGPAR(YDGEOMETRY%YRDIM%NPROMA,YDMODEL%YRML_PHY_MF%YRPARAR%NGPAR+1)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PDHSF(YDGEOMETRY%YRDIM%NPROMA)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PALBDG(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PCAPE(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PCTOP(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PCLCC(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PCLCH(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PCLCL(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PCLCM(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PCLCT(YDGEOMETRY%YRDIM%NPROMA)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PCLPH(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PVEIN(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PCT(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PDIFCQ(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PDIFCQI(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PDIFCQL(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PDIFCS(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PDIFTQ(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PDIFTQI(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PDIFTQL(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PDIFTS(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFCCQL(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFCCQN(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFCHOZ(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFPFPSL(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFPFPSN(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFPFPSG(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFPFPCL(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFPFPCN(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFPEVPSL(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFPEVPSN(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFPEVPSG(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFPEVPCL(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFPEVPCN(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFPEVPCG(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFCHSP(YDGEOMETRY%YRDIM%NPROMM,YDSURF%YSP_SBD%NLEVS)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFCLL(YDGEOMETRY%YRDIM%NPROMM,YDMODEL%YRML_PHY_G%YRDPHY%NTSSG+1)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFCLN(YDGEOMETRY%YRDIM%NPROMM,YDMODEL%YRML_PHY_G%YRDPHY%NTSSG+1)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PFCQING(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFCQLNG(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFCQNG(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFCS(YDGEOMETRY%YRDIM%NPROMM,YDMODEL%YRML_PHY_G%YRDPHY%NTSSG+1)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFCSQL(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFCSQN(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFEVL(YDGEOMETRY%YRDIM%NPROMM,YDMODEL%YRML_PHY_G%YRDPHY%NTSSG+1)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFEVN(YDGEOMETRY%YRDIM%NPROMM,YDMODEL%YRML_PHY_G%YRDPHY%NTSSG+1)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFEVV(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFGEL(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFGELS(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFLWSP(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFONTE(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFPLCL(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFPLCN(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFPLCG(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFPLCHL(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFPLSL(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFPLSN(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFPLSG(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFPLSHL(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PMRT(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFRMH(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PDIFCQLC(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PDIFCQIC(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFIMCC (YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFEDQLC(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFEDQIC(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFEDQRC(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFEDQSC(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFCNEGQLC(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFCNEGQIC(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFCNEGQRC(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFCNEGQSC(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFRSO(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG,YDMODEL%YRML_PHY_G%YRDPHY%NTSSG+1)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PFRSOC(YDGEOMETRY%YRDIM%NPROMM,0:1)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PFRSODS(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PFRSOLU(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PFRSGNI(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PFRSDNI(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PFRSOPS(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PFRSOPT(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFRTH(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG,YDMODEL%YRML_PHY_G%YRDPHY%NTSSG+1)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PFRTHC(YDGEOMETRY%YRDIM%NPROMM,0:1)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PFRTHDS(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFTR(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PGZ0(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PGZ0H(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PNEB(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PQCLS(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PQICE(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PQLI(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PQS(YDGEOMETRY%YRDIM%NPROMA)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PRH(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PRHCLS(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PRUISL(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PRUISP(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PRUISS(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PSTRCU(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PSTRCV(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PSTRDU(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PSTRDV(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PSTRMU(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PSTRMV(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PSTRTU(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PSTRTV(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PUCLS(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PVCLS(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PNUCLS(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PNVCLS(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PTCLS(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PUGST(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PVGST(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PMOCON(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PFDIS(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PFHPCL(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PFHPCN(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PFHPCG(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PFHPSL(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PFHPSN(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PFHPSG(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PFHSCL(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PFHSCN(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PFHSSL(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PFHSSN(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PFHSSG(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PFEPFP(YDGEOMETRY%YRDIM%NPROMA,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PFCMPCQ(YDGEOMETRY%YRDIM%NPROMA,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PFCMPSN(YDGEOMETRY%YRDIM%NPROMA,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PFCMPSL(YDGEOMETRY%YRDIM%NPROMA,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PTENDU(YDGEOMETRY%YRDIM%NPROMM,YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PTENDV(YDGEOMETRY%YRDIM%NPROMM,YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PQSOL(YDGEOMETRY%YRDIM%NPROMA)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PDERNSHF(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PFCQRNG(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PFCQSNG(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PFCQGNG(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PDIAGH(YDGEOMETRY%YRDIM%NPROMA)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PFLASH(YDGEOMETRY%YRDIM%NPROMA)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PGDEOSI(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG,2)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PGUEOSI(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG,2)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PGMU0(YDGEOMETRY%YRDIM%NPROMM,0:YDMODEL%YRML_PHY_MF%YRPHY%NSORAYFR-1)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PGMU0_MIN(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PGMU0_MAX(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PGDEOTI(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PGDEOTI2(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PGUEOTI(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PGUEOTI2(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PGEOLT(YDGEOMETRY%YRDIM%NPROMM,YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PGEOXT(YDGEOMETRY%YRDIM%NPROMM,YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PGRPROX(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PGMIXP(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PGFLUXC(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PGRSURF(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PVISICLD(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(INOUT) :: PFTCNS(YDGEOMETRY%YRDIM%NPROMA,0:YDGEOMETRY%YRDIMV%NFLEVG,6)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PVISIHYDRO(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PMXCLWC(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) ,INTENT(OUT) :: PTPWCLS(YDGEOMETRY%YRDIM%NPROMM)
-
-TYPE (TRAJ_PHYS_TYPE), INTENT(INOUT) :: PTRAJ_PHYS
-TYPE(TYP_DDH) ,INTENT(INOUT) :: YDDDH
-
-! ------------------------------------------------------------------
-LOGICAL :: LLDIAB
-LOGICAL :: LL_SAVE_PHSURF
-LOGICAL :: LLXFUMSE
-
-INTEGER(KIND=JPIM) :: IFIELDSS
-INTEGER(KIND=JPIM) :: IBLK
-INTEGER(KIND=JPIM) :: IPQ,IPO3,ITDIA,IPTREXT,IPTR_CONT,IEFB1,IEFB2,IEFB3
-INTEGER(KIND=JPIM) :: IPGFL(YDMODEL%YRML_GCONF%YGFL%NUMFLDS),IPTR(YDMODEL%YRML_GCONF%YGFL%NUMFLDS)
-
-INTEGER(KIND=JPIM) :: INSTEP_DEB,INSTEP_FIN
-INTEGER(KIND=JPIM) :: JLEV, JGFL
-INTEGER(KIND=JPIM) :: JROF
-INTEGER(KIND=JPIM) :: ISLB1U9 ,ISLB1V9 ,ISLB1T9 ,ISLB1GFL9, ISLB1VD9
-
-INTEGER(KIND=JPIM) :: ICLPH(YDGEOMETRY%YRDIM%NPROMA) ! cf. KCLPH in APLPAR.
-
-! --- UPPER AIR PHYSICAL TENDENCIES.
-REAL(KIND=JPRB) :: ZTENDH(YDGEOMETRY%YRDIM%NPROMM,YDGEOMETRY%YRDIMV%NFLEVG) ! Enthalpy tendency.
-REAL(KIND=JPRB) :: ZTENDQ(YDGEOMETRY%YRDIM%NPROMM,YDGEOMETRY%YRDIMV%NFLEVG) ! Moisture tendency.
-REAL(KIND=JPRB) :: ZTENDPTKE(YDGEOMETRY%YRDIM%NPROMM,YDGEOMETRY%YRDIMV%NFLEVG) ! Pseudo progn. TKE
-
-! GFL tendencies for APL_AROME (assumes YDMODEL%YRML_GCONF%YGFL%NUMFLDS>=YDMODEL%YRML_PHY_MF%YRPARAR%NRR)
-! for now, use Jovi's trick :
-REAL(KIND=JPRB) :: ZTENDGFLR(YDGEOMETRY%YRDIM%NPROMM,YDGEOMETRY%YRDIMV%NFLEVG,0:YDMODEL%YRML_GCONF%YGFL%NUMFLDS)
-REAL(KIND=JPRB) :: ZTENDGFL(YDGEOMETRY%YRDIM%NPROMM,YDGEOMETRY%YRDIMV%NFLEVG,YDMODEL%YRML_GCONF%YGFL%NUMFLDS) ! GFL tendencies
-
-REAL(KIND=JPRB) :: ZUDOM(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG),&
- & ZUDAL(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) :: ZDDOM(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG),&
- & ZDDAL(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) :: ZUNEBH(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG),&
- & ZENTCH(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG)
-
-! --- UPPER AIR PHYSICAL TENDENCIES FOR AROME.
-! (the previous one are not used in AROME)
-REAL(KIND=JPRB) :: ZTENDT (YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG) ! temperature tendency
-REAL(KIND=JPRB) :: ZTENDW (YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG) ! W tendency
-REAL(KIND=JPRB) :: ZTENDD (YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG) ! d tendency
-REAL(KIND=JPRB) :: ZTENDEXT(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG,YDMODEL%YRML_GCONF%YGFL%NGFL_EXT) ! GFL EXTRA tendency
-REAL(KIND=JPRB) :: ZTENDEXT_DEP(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG,YDMODEL%YRML_GCONF%YGFL%NGFL_EXT) ! GFL EXTRA tendency
-REAL(KIND=JPRB) :: ZDIFEXT(YDGEOMETRY%YRDIM%NPROMA,0:YDGEOMETRY%YRDIMV%NFLEVG,YDMODEL%YRML_GCONF%YGFL%NGFL_EXT) ! Extra-GFL fluxes.
-
-REAL(KIND=JPRB) :: ZTENDU (YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG) ! U tendency without deep convection contribution
-REAL(KIND=JPRB) :: ZTENDV (YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG) ! V tendency without deep convection contribution
-! --- SURFACE AND DEEP RESERVOIR PHYSICAL TENDENCIES.
-REAL(KIND=JPRB) :: ZTDTS(YDGEOMETRY%YRDIM%NPROMM) ! Surface temperature tendency.
-REAL(KIND=JPRB) :: ZTDTP(YDGEOMETRY%YRDIM%NPROMM,YDSURF%YSP_SBD%NLEVS) ! Deep temperature tendency.
-REAL(KIND=JPRB) :: ZTDWS(YDGEOMETRY%YRDIM%NPROMM) ! Surface water res. tendency.
-REAL(KIND=JPRB) :: ZTDWP(YDGEOMETRY%YRDIM%NPROMM) ! Deep water res. tendency.
-REAL(KIND=JPRB) :: ZTDWL(YDGEOMETRY%YRDIM%NPROMM) ! Interception water res. tendency
-REAL(KIND=JPRB) :: ZTDSNS(YDGEOMETRY%YRDIM%NPROMM) ! Snow res. tendency.
-REAL(KIND=JPRB) :: ZTDWPI(YDGEOMETRY%YRDIM%NPROMM) ! Deep ice res. tendency.
-REAL(KIND=JPRB) :: ZTDWSI(YDGEOMETRY%YRDIM%NPROMM) ! Surface ice res. tendency.
-REAL(KIND=JPRB) :: ZTDALBNS(YDGEOMETRY%YRDIM%NPROMA) ! Snow albedo tendency.
-REAL(KIND=JPRB) :: ZTDRHONS(YDGEOMETRY%YRDIM%NPROMA) ! Snow density tendency.
-
-! --- FLUXES FROM PARAMETERISATIONS AND TENDENCIES COMP.
-REAL(KIND=JPRB) :: ZFP(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG) ! Total rainfall flux.
-REAL(KIND=JPRB) :: ZFPLCH(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG) ! convective precipitation flux,
- ! local
-REAL(KIND=JPRB) :: ZFPLSH(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG) ! stratiform precipitation flux,
- ! local
-REAL(KIND=JPRB) :: ZFPLSN(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG) ! all solid stratiform precipitation flux,
- ! local
-REAL(KIND=JPRB) :: ZFTKE(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG) ! TKE flux.
-REAL(KIND=JPRB) :: ZFTKEI(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG) ! TKE flux.
-REAL(KIND=JPRB) :: ZFEFB1(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG) ! EFB1 flux.
-REAL(KIND=JPRB) :: ZFEFB2(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG) ! EFB2 flux.
-REAL(KIND=JPRB) :: ZFEFB3(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG) ! EFB3 flux.
-
-! --- Fields of potential use for HIRLAM .
-REAL(KIND=JPRB) :: ZCVGQL(YDGEOMETRY%YRDIM%NPROMM,YDGEOMETRY%YRDIMV%NFLEVG) ! local array for cloud water tendency
-REAL(KIND=JPRB) :: ZCVGQI(YDGEOMETRY%YRDIM%NPROMM,YDGEOMETRY%YRDIMV%NFLEVG) ! local array for cloud ice tendency
-REAL(KIND=JPRB) :: ZCVGT(YDGEOMETRY%YRDIM%NPROMM,YDGEOMETRY%YRDIMV%NFLEVG) ! local array for temperature tendency
-
-! --- MISCELLANEOUS PARAMETERISATIONS, 2D ARRAYS ---
-REAL(KIND=JPRB) :: ZCVGQ(YDGEOMETRY%YRDIM%NPROMM,YDGEOMETRY%YRDIMV%NFLEVG) ! convergence of humidity
- ! ("Kuo" condition).
-REAL(KIND=JPRB) :: ZFHP(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG) ! Total enthalpy flux
- ! + sensible heat flux.
-REAL(KIND=JPRB) :: ZLCVQ(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG) ! limited physical contribution to
- ! the diagnostic of moisture
- ! convergence (remove
- ! large scale precip. contrib.).
-REAL(KIND=JPRB) :: ZLSCPE(YDGEOMETRY%YRDIM%NPROMM,YDGEOMETRY%YRDIMV%NFLEVG) ! cf. PLSCPE in APLPAR.
-REAL(KIND=JPRB) :: ZLH(YDGEOMETRY%YRDIM%NPROMM,YDGEOMETRY%YRDIMV%NFLEVG) ! cf. PLH in APLPAR.
-REAL(KIND=JPRB) :: ZQW(YDGEOMETRY%YRDIM%NPROMM,YDGEOMETRY%YRDIMV%NFLEVG) ! cf. PQW in APLPAR.
-REAL(KIND=JPRB) :: ZTW(YDGEOMETRY%YRDIM%NPROMM,YDGEOMETRY%YRDIMV%NFLEVG) ! cf. PTW in APLPAR.
-
-REAL(KIND=JPRB) :: ZFRMQ(YDGEOMETRY%YRDIM%NPROMM,0:YDGEOMETRY%YRDIMV%NFLEVG) ! cf. MESOSPHERIC humidity flux in APLPAR.
-
-! --- 1D DIAGNOSTIC FIELDS, SURFACE FLUXES
-REAL(KIND=JPRB) :: ZCD(YDGEOMETRY%YRDIM%NPROMM) ! cf. PCD in APLPAR.
-REAL(KIND=JPRB) :: ZCDN(YDGEOMETRY%YRDIM%NPROMM) ! cf. PCDN in APLPAR.
-REAL(KIND=JPRB) :: ZCH(YDGEOMETRY%YRDIM%NPROMM) ! cf. PCH in APLPAR.
-REAL(KIND=JPRB) :: ZEMIS(YDGEOMETRY%YRDIM%NPROMM) ! cf. PEMIS in APLPAR.
-REAL(KIND=JPRB) :: ZFEVI(YDGEOMETRY%YRDIM%NPROMM,YDMODEL%YRML_PHY_G%YRDPHY%NTSSG+1) ! cf. PFEVI in APLPAR.
-REAL(KIND=JPRB) :: ZNEIJ(YDGEOMETRY%YRDIM%NPROMM) ! cf. PNEIJ in APLPAR.
-REAL(KIND=JPRB) :: ZVEG(YDGEOMETRY%YRDIM%NPROMM) ! cf. PVEG in APLPAR.
-REAL(KIND=JPRB) :: ZQSAT(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG) ! specific humidity at saturation.
-REAL(KIND=JPRB) :: ZQSATS(YDGEOMETRY%YRDIM%NPROMA) ! cf. PQSATS in APLPAR.
-REAL(KIND=JPRB) :: ZQS1(YDGEOMETRY%YRDIM%NPROMM) ! cf. PQS1 in APLPARS.
-
-! --- DIAGNOSTIC FIELDS STATE OF SURFACE AIR ---
-REAL(KIND=JPRB) :: ZC1(YDGEOMETRY%YRDIM%NPROMM) ! cf. PC1 in APLPAR.
-REAL(KIND=JPRB) :: ZC2(YDGEOMETRY%YRDIM%NPROMM) ! cf. PC2 in APLPAR.
-REAL(KIND=JPRB) :: ZCPS(YDGEOMETRY%YRDIM%NPROMM) ! cf. PCPS in APLPAR.
-REAL(KIND=JPRB) :: ZLHS(YDGEOMETRY%YRDIM%NPROMM) ! cf. PLHS in APLPAR.
-REAL(KIND=JPRB) :: ZRS(YDGEOMETRY%YRDIM%NPROMM) ! cf. PRS in APLPAR.
-
-! --- RADIATION COEFFICIENTS FOR SIMPLIFIED PHYSICS IN GRID-POINT ---
-REAL(KIND=JPRB) :: ZAC(YDGEOMETRY%YRDIM%NPROMM,(YDGEOMETRY%YRDIMV%NFLEVG+1)*(YDGEOMETRY%YRDIMV%NFLEVG+1)) ! Curtis matrix.
-REAL(KIND=JPRB) :: ZAC_HC(YDGEOMETRY%YRDIMV%NFLEVG+1,YDGEOMETRY%YRDIMV%NFLEVG+1) ! horizontally-constant field for ZAC.
-REAL(KIND=JPRB) :: ZRADTC(YDGEOMETRY%YRDIM%NPROMM,YDGEOMETRY%YRDIMV%NFLEVG,YM_RADTC%NDIM) ! others than Curtis matrix.
-
-! --- GEOMETRY FOR RADIATION ---
-REAL(KIND=JPRB) :: ZMMU0(YDGEOMETRY%YRDIM%NPROMA) ! mean solar angle (for given day for
- ! simpl. rad. scheme)
-REAL(KIND=JPRB) :: ZMU0(YDGEOMETRY%YRDIM%NPROMA) ! local cosine of instantaneous solar zenith
- ! angle.
-REAL(KIND=JPRB) :: ZMU0LU(YDGEOMETRY%YRDIM%NPROMM) ! local cosine of instantaneous lunar zenith
- ! angle.
-REAL(KIND=JPRB) :: ZMU0M(YDGEOMETRY%YRDIM%NPROMA) ! local cosine of averaged solar zenith angle
-REAL(KIND=JPRB) :: ZMU0N(YDGEOMETRY%YRDIM%NPROMA) ! same as ZMU0 for next time step (used for YDMODEL%YRML_PHY_MF%YRARPHY%LMSE)
-
-! ---FOR AROME PHYSICS ---
-REAL(KIND=JPRB) :: ZDT !pour cputqy_arome, a changer peut etre plus tard...
-REAL(KIND=JPRB) :: ZGWT1(YDGEOMETRY%YRDIM%NPROMA,0:YDGEOMETRY%YRDIMV%NFLEVG) ! vertical velocity calculated by
- ! cputqy_arome before convertion in d
-REAL(KIND=JPRB) :: ZTT1(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG) ! Temperature at t1
-
-! ZRTT1: appropriate version of R*T at t1 for gnhgw2svd
-! Version of R must be consistent with definition of vertical divergence.
-REAL(KIND=JPRB) :: ZRTT1(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG)
-
-! --- Buffers to save the initial value of ---
-! --- some pseudo-historical surface buffers ---
-REAL(KIND=JPRB) :: ZHV(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) :: ZGZ0F(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) :: ZGZ0HF(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) :: ZPBLH(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) :: ZFHPS(YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) :: ZQSH (YDGEOMETRY%YRDIM%NPROMM)
-REAL(KIND=JPRB) :: ZUDGRO(YDGEOMETRY%YRDIM%NPROMM)
-
-! --- FOR BAYRAD ALLSKY FRAMEWORK ---
-REAL(KIND=JPRB) :: ZQRCONV(YDGEOMETRY%YRDIM%NPROMM,YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) :: ZQSCONV(YDGEOMETRY%YRDIM%NPROMM,YDGEOMETRY%YRDIMV%NFLEVG)
-
-! Horizontal exchange coefficients for 3D turbulence
-REAL(KIND=JPRB) :: ZKUROV_H(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG),&
- & ZKTROV_H(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG)
-
-! Empty arrays for 3TL scheme (to be coded later)
-!!later REAL(KIND=JPRB) :: ZDIVT9(NPROMA,NFLEVG)
-!!later REAL(KIND=JPRB) :: ZUT9L(NPROMA,NFLEVG)
-!!later REAL(KIND=JPRB) :: ZVT9L(NPROMA,NFLEVG)
-REAL(KIND=JPRB) :: ZWT9L(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) :: ZWT9M(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) :: ZDPRECIPS(YDGEOMETRY%YRDIM%NPROMA,YDMODEL%YRML_PHY_MF%YRPHY%YRDPRECIPS%NDTPREC)
-REAL(KIND=JPRB) :: ZDPRECIPS2(YDGEOMETRY%YRDIM%NPROMA,YDMODEL%YRML_PHY_MF%YRPHY%YRDPRECIPS%NDTPREC2)
-
-REAL(KIND=JPRB) :: ZTAUX(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG),&
- & ZDTAJU(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG)
-
-REAL(KIND=JPRB) :: ZEDR(YDGEOMETRY%YRDIM%NPROMA,YDGEOMETRY%YRDIMV%NFLEVG)
-
-! To save Tt for NHQE model
-REAL(KIND=JPRB) :: ZTT0_SAVE(YDGEOMETRY%YRDIM%NPROMNH,YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) :: ZTT0L_SAVE(YDGEOMETRY%YRDIM%NPROMNH,YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) :: ZTT0M_SAVE(YDGEOMETRY%YRDIM%NPROMNH,YDGEOMETRY%YRDIMV%NFLEVG)
-REAL(KIND=JPRB) :: ZTT9_SAVE(YDGEOMETRY%YRDIM%NPROMNH,YDGEOMETRY%YRDIMV%NFLEVG)
-
-! required for INTFLEX
-TYPE(TYPE_INTPROCSET) :: YLPROCSET
-
-REAL(KIND=JPRB), TARGET :: ZAESUL_NULL(YDGEOMETRY%YRDIM%NPROMA), ZVAVOL_NULL(YDGEOMETRY%YRDIM%NPROMA)
-! SPP
-REAL(KIND=JPRB) :: ZGP2DSPP(YDGEOMETRY%YRDIM%NPROMA,YSPP%N2D)
-
-INTEGER(KIND=JPIM) :: IMAXDRAFT
-
-INTEGER(KIND=JPIM) :: IPTRLIMA
-INTEGER(KIND=JPIM) :: IRR ! pointer of 1st hydrometeors in ZTENDGFLR
-INTEGER(KIND=JPIM) :: IPTRTKE ! pointer of TKE in ZTENDGFLR
-
-REAL(KIND=JPRB), POINTER :: ZT0DIV(:,:), ZT0SP(:), ZT0SPD(:,:), ZT0SPDL(:,:)
-REAL(KIND=JPRB), POINTER :: ZT0SPDM(:,:), ZT0SPL(:), ZT0SPM(:), ZT0T(:,:)
-REAL(KIND=JPRB), POINTER :: ZT0TL(:,:), ZT0TM(:,:), ZT0U(:,:), ZT0UL(:,:)
-REAL(KIND=JPRB), POINTER :: ZT0V(:,:), ZT0VL(:,:), ZT0VOR(:,:), ZT1SP(:)
-REAL(KIND=JPRB), POINTER :: ZT9DIV(:,:), ZT9SP(:), ZT9SPD(:,:), ZT9T(:,:)
-REAL(KIND=JPRB), POINTER :: ZT9U(:,:), ZT9UL(:,:), ZT9V(:,:), ZT9VL(:,:)
-REAL(KIND=JPRB), POINTER :: ZT9VOR(:,:)
-REAL(KIND=JPRB), POINTER :: ZDIXEDR(:,:), ZSFLSFL1(:), ZSFOSFO1(:), ZVADES(:)
-REAL(KIND=JPRB), POINTER :: ZVALAN(:), ZVASEA(:), ZVASOO(:), ZVASUL(:)
-REAL(KIND=JPRB), POINTER :: ZVAVOL(:), ZVCVC1(:), ZVDSUND(:), ZVFALBF(:)
-REAL(KIND=JPRB), POINTER :: ZVFALBSF(:), ZVFEMISF(:), ZVFGETRL(:), ZVFLSM(:)
-REAL(KIND=JPRB), POINTER :: ZVFNUDM(:), ZVFVEG(:), ZVFVRLAN(:), ZVFVRLDI(:)
-REAL(KIND=JPRB), POINTER :: ZVFZ0F(:), ZVFZ0RLF(:), ZVHBCCH(:), ZVHPBLH(:)
-REAL(KIND=JPRB), POINTER :: ZVHQSH(:), ZVHSCCH(:), ZVHSPSH(:), ZVHTCCH(:)
-REAL(KIND=JPRB), POINTER :: ZVKUDGRO(:), ZVPTPC(:), ZVPWPC(:), ZVVALV(:)
-REAL(KIND=JPRB), POINTER :: ZVVARG(:), ZVVD2(:), ZVVHV(:), ZVVIVEG(:)
-REAL(KIND=JPRB), POINTER :: ZVVLAI(:), ZVVRSMIN(:), ZVVSAB(:), ZVVZ0H(:)
-REAL(KIND=JPRB), POINTER :: ZRRFC0(:), ZRRFC1(:), ZRRFC9(:), ZRRIC0(:)
-REAL(KIND=JPRB), POINTER :: ZRRIC1(:), ZRRIC9(:), ZRRT0(:), ZRRT1(:)
-REAL(KIND=JPRB), POINTER :: ZRRT9(:), ZRRW0(:), ZRRW1(:), ZRRW9(:)
-REAL(KIND=JPRB), POINTER :: ZSBQ0(:,:), ZSBQ1(:,:), ZSBQ9(:,:), ZSBTL0(:,:)
-REAL(KIND=JPRB), POINTER :: ZSBTL1(:,:), ZSBTL9(:,:), ZSBT0(:,:), ZSBT1(:,:)
-REAL(KIND=JPRB), POINTER :: ZSBT9(:,:), ZSGA0(:), ZSGA1(:), ZSGA9(:)
-REAL(KIND=JPRB), POINTER :: ZSGF0(:), ZSGF1(:), ZSGF9(:), ZSGR0(:)
-REAL(KIND=JPRB), POINTER :: ZSGR1(:), ZSGR9(:), ZSGT1(:)
-REAL(KIND=JPRB), POINTER :: ZMCOR(:,:), ZMRAB3C(:,:), ZMRAB3N(:,:), ZMRAB4C(:,:)
-REAL(KIND=JPRB), POINTER :: ZMRAB4N(:,:), ZMRAB6C(:,:), ZMRAB6N(:,:), ZMRAT1C(:,:)
-REAL(KIND=JPRB), POINTER :: ZMRAT1N(:,:), ZMRAT2C(:,:), ZMRAT2N(:,:), ZMRAT3C(:,:)
-REAL(KIND=JPRB), POINTER :: ZMRAT3N(:,:), ZMRAT4C(:,:), ZMRAT4N(:,:), ZMRAT5C(:,:)
-REAL(KIND=JPRB), POINTER :: ZMRAT5N(:,:)
-REAL(KIND=JPRB), POINTER :: ZPA1(:,:), ZP1CHEM(:,:), ZP1CHEM9(:,:), ZPCPF(:,:)
-REAL(KIND=JPRB), POINTER :: ZPCPF1(:,:), ZPCVGQ(:,:), ZPCVGQL(:,:), ZPCVGQM(:,:)
-REAL(KIND=JPRB), POINTER :: ZPCVV(:,:), ZPCVV1(:,:), ZPCVV9(:,:), ZPDAL(:,:)
-REAL(KIND=JPRB), POINTER :: ZPDAL1(:,:), ZPDOM(:,:), ZPDOM1(:,:), ZPEFB1(:,:)
-REAL(KIND=JPRB), POINTER :: ZPTENDEFB11(:,:), ZPEFB19(:,:), ZPEFB2(:,:), ZPTENDEFB21(:,:)
-REAL(KIND=JPRB), POINTER :: ZPEFB29(:,:), ZPEFB3(:,:), ZPTENDEFB31(:,:), ZPEFB39(:,:)
-REAL(KIND=JPRB), POINTER :: ZP1EXT(:,:), ZP1EXT9(:,:), ZP1EZDIAG(:,:), ZPFQTUR(:,:)
-REAL(KIND=JPRB), POINTER :: ZPFQTUR1(:,:), ZPFSTUR(:,:), ZPFSTUR1(:,:), ZPG(:,:)
-REAL(KIND=JPRB), POINTER :: ZPTENDG1(:,:), ZPG9(:,:), ZPH(:,:), ZPH9(:,:)
-REAL(KIND=JPRB), POINTER :: ZPICONV(:,:), ZPTENDICONV1(:,:), ZPI(:,:), ZPTENDI1(:,:)
-REAL(KIND=JPRB), POINTER :: ZPI9(:,:), ZPIRAD1(:,:), ZPLCONV(:,:), ZPTENDLCONV1(:,:)
-REAL(KIND=JPRB), POINTER :: ZP1LIMA(:,:), ZP1LIMA9(:,:), ZPL(:,:), ZPTENDL1(:,:)
-REAL(KIND=JPRB), POINTER :: ZPL9(:,:), ZPLRAD1(:,:), ZPMXL(:,:), ZPMXL1(:,:)
-REAL(KIND=JPRB), POINTER :: ZP1NOGW(:,:), ZP1NOGW9(:,:), ZP2NOGW(:,:), ZP2NOGW9(:,:)
-REAL(KIND=JPRB), POINTER :: ZPO3(:,:), ZPO31(:,:), ZPO39(:,:), ZPQ(:,:)
-REAL(KIND=JPRB), POINTER :: ZPTENDQ1(:,:), ZPQ9(:,:), ZPQL(:,:), ZPQM(:,:)
-REAL(KIND=JPRB), POINTER :: ZPRCONV(:,:), ZPRCONV1(:,:), ZPTENDRCONV1(:,:), ZPRKTH(:,:)
-REAL(KIND=JPRB), POINTER :: ZPRKTH1(:,:), ZPRKTQC(:,:), ZPRKTQC1(:,:), ZPRKTQV(:,:)
-REAL(KIND=JPRB), POINTER :: ZPRKTQV1(:,:), ZPR(:,:), ZPTENDR1(:,:), ZPR9(:,:)
-REAL(KIND=JPRB), POINTER :: ZPSCONV(:,:), ZPSCONV1(:,:), ZPTENDSCONV1(:,:), ZPSHTUR(:,:)
-REAL(KIND=JPRB), POINTER :: ZPSHTUR1(:,:), ZPS(:,:), ZPTENDS1(:,:), ZPS9(:,:)
-REAL(KIND=JPRB), POINTER :: ZPSPF(:,:), ZPSPF1(:,:), ZPSRC(:,:), ZPSRC1(:,:)
-REAL(KIND=JPRB), POINTER :: ZPSRC9(:,:), ZPTKE(:,:), ZPTENDTKE1(:,:), ZPTKE9(:,:)
-REAL(KIND=JPRB), POINTER :: ZPTTE(:,:), ZPTTE1(:,:), ZPUAL(:,:), ZPUAL1(:,:)
-REAL(KIND=JPRB), POINTER :: ZPUEN(:,:), ZPUEN1(:,:), ZPUNEBH(:,:), ZPUNEBH1(:,:)
-REAL(KIND=JPRB), POINTER :: ZPUOM(:,:), ZPUOM1(:,:)
-
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-
-! ------------------------------------------------------------------
-
-#include "abor1.intfb.h"
-#include "apl_arome.intfb.h"
-#include "aplpar.intfb.h"
-#include "aplpar2intflex.intfb.h"
-#include "aplpars.intfb.h"
-#include "aplpassh.intfb.h"
-#include "cpchet.intfb.h"
-#include "cpmvvps.intfb.h"
-#include "cpnudg.intfb.h"
-#include "cpozo.intfb.h"
-#include "cpphinp.intfb.h"
-#include "cppsolan.intfb.h"
-#include "cpqsol.intfb.h"
-#include "cptend_new.intfb.h"
-#include "cptend_flex.intfb.h"
-#include "cptends.intfb.h"
-#include "cptendsm.intfb.h"
-#include "cputqy_arome.intfb.h"
-#include "cputqy.intfb.h"
-#include "cputqys.intfb.h"
-#include "cpwts.intfb.h"
-#include "cp_ptrslb1.intfb.h"
-#include "gnhgw2svdarome.intfb.h"
-#include "initaplpar.intfb.h"
-#include "profilechet.intfb.h"
-#include "rdradcoef.intfb.h"
-#include "writephysio.intfb.h"
-#include "wrphtrajm.intfb.h"
-#include "wrradcoef.intfb.h"
-#include "acajucv.intfb.h"
-#include "gnhqe_conv_tempe.intfb.h"
-
-! ------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('MF_PHYS',0,ZHOOK_HANDLE)
-ASSOCIATE(YDDIM=>YDGEOMETRY%YRDIM,YDDIMV=>YDGEOMETRY%YRDIMV,YDGEM=>YDGEOMETRY%YRGEM, YDVAB=>YDGEOMETRY%YRVAB, &
- & YDCSGEOM=>YDGEOMETRY%YRCSGEOM(KIBL), YDGSGEOM=>YDGEOMETRY%YRGSGEOM(KIBL), YDOROG=>YDGEOMETRY%YROROG(KIBL), &
- & YDPHY=>YDMODEL%YRML_PHY_MF%YRPHY,YDPTRSLB1=>YDMODEL%YRML_DYN%YRPTRSLB1,YDPTRSLB2=>YDMODEL%YRML_DYN%YRPTRSLB2, &
- & YDTOPH=>YDMODEL%YRML_PHY_MF%YRTOPH,YDSIMPHL=>YDMODEL%YRML_PHY_MF%YRSIMPHL,YDRIP=>YDMODEL%YRML_GCONF%YRRIP, &
- & YDMDDH=>YDMODEL%YRML_DIAG%YRMDDH,YDRCOEF=>YDMODEL%YRML_PHY_RAD%YRRCOEF, &
- & YDARPHY=>YDMODEL%YRML_PHY_MF%YRARPHY,YDDPHY=>YDMODEL%YRML_PHY_G%YRDPHY,YDLDDH=>YDMODEL%YRML_DIAG%YRLDDH, &
- & YDPHY2=>YDMODEL%YRML_PHY_MF%YRPHY2,YGFL=>YDMODEL%YRML_GCONF%YGFL,YDEPHY=>YDMODEL%YRML_PHY_EC%YREPHY, &
- & YDPARAR=>YDMODEL%YRML_PHY_MF%YRPARAR, YDPRECIPS=>YDMODEL%YRML_PHY_MF%YRPHY%YRDPRECIPS, &
- & YDSTOPH=>YDMODEL%YRML_PHY_STOCH%YRSTOPH)
-
-ASSOCIATE(MVTS=>YDPARAR%MVTS, NRR=>YDPARAR%NRR, NGPAR=>YDPARAR%NGPAR, CMF_UPDRAFT=>YDPARAR%CMF_UPDRAFT,&
- & TSPHY=>YDPHY2%TSPHY, &
- & NPROMA=>YDDIM%NPROMA, NPROMM=>YDDIM%NPROMM, &
- & NTSSG=>YDDPHY%NTSSG, NVCLIS=>YDDPHY%NVCLIS, &
- & YT1=>YDGMV%YT1, YT0=>YDGMV%YT0, YT9=>YDGMV%YT9, &
- & LMDUST=>YDARPHY%LMDUST, LMPA=>YDARPHY%LMPA, LMSE=>YDARPHY%LMSE, LMFSHAL=>YDARPHY%LMFSHAL,&
- & YI=>YGFL%YI, YH=>YGFL%YH, YEZDIAG=>YGFL%YEZDIAG, YL=>YGFL%YL, &
- & YEXT=>YGFL%YEXT, YA=>YGFL%YA, YSRC=>YGFL%YSRC, YSPF=>YGFL%YSPF, &
- & YUEN=>YGFL%YUEN, YG=>YGFL%YG, YCVGQ=>YGFL%YCVGQ, YMXL=>YGFL%YMXL, &
- & YQ=>YGFL%YQ, YCPF=>YGFL%YCPF, YR=>YGFL%YR, YSCONV=>YGFL%YSCONV, YS=>YGFL%YS, &
- & YEFB3=>YGFL%YEFB3, YEFB2=>YGFL%YEFB2, YEFB1=>YGFL%YEFB1, YRKTH=>YGFL%YRKTH, &
- & YDOM=>YGFL%YDOM, YFQTUR=>YGFL%YFQTUR, YFSTUR=>YGFL%YFSTUR, &
- & YUNEBH=>YGFL%YUNEBH, YUOM=>YGFL%YUOM, YCVV=>YGFL%YCVV, YO3=>YGFL%YO3, YNOGW=>YGFL%YNOGW, &
- & LCHEM_ARPCLIM=>YDMODEL%YRML_CHEM%YRCHEM%LCHEM_ARPCLIM,&
- & YCHEM=>YGFL%YCHEM, NGFL_EXT=>YGFL%NGFL_EXT, YRKTQC=>YGFL%YRKTQC, YTKE=>YGFL%YTKE, &
- & YIRAD=>YGFL%YIRAD, YDAL=>YGFL%YDAL, YCOMP=>YGFL%YCOMP, &
- & NGFL_EZDIAG=>YGFL%NGFL_EZDIAG, YRKTQV=>YGFL%YRKTQV, YUAL=>YGFL%YUAL, &
- & YTTE=>YGFL%YTTE, YLCONV=>YGFL%YLCONV, YSHTUR=>YGFL%YSHTUR, &
- & YRCONV=>YGFL%YRCONV, YICONV=>YGFL%YICONV, YLRAD=>YGFL%YLRAD, &
- & YSP_SBD=>YDSURF%YSP_SBD, YSD_SFLD=>YDSURF%YSD_SFLD, YSD_VDD=>YDSURF%YSD_VDD, &
- & YSP_RR=>YDSURF%YSP_RR, YSD_VFD=>YDSURF%YSD_VFD, YSD_VP=>YDSURF%YSD_VP, &
- & YSP_RRD=>YDSURF%YSP_RRD, YSD_VC=>YDSURF%YSD_VC, YSD_VA=>YDSURF%YSD_VA, &
- & YSD_VHD=>YDSURF%YSD_VHD, YSD_VKD=>YDSURF%YSD_VKD, &
- & YSD_VF=>YDSURF%YSD_VF, YSD_VD=>YDSURF%YSD_VD, YSD_VH=>YDSURF%YSD_VH, &
- & YSD_VK=>YDSURF%YSD_VK, YSD_SFOD=>YDSURF%YSD_SFOD, YSP_SG=>YDSURF%YSP_SG, &
- & YSP_SB=>YDSURF%YSP_SB, YSP_SGD=>YDSURF%YSP_SGD, YSD_DI=>YDSURF%YSD_DI, &
- & YSD_VV=>YDSURF%YSD_VV, YSD_VCD=>YDSURF%YSD_VCD, YSD_SFO=>YDSURF%YSD_SFO, &
- & YSD_VVD=>YDSURF%YSD_VVD, YSD_SFL=>YDSURF%YSD_SFL, YSD_VPD=>YDSURF%YSD_VPD, &
- & YSD_VAD=>YDSURF%YSD_VAD, YSD_XP=>YDSURF%YSD_XP,YSD_XP2=>YDSURF%YSD_XP2,&
- & NFLEVG=>YDDIMV%NFLEVG, NFLSA=>YDDIMV%NFLSA, NFLSUL=>YDDIMV%NFLSUL, &
- & LTRAJPS=>YDSIMPHL%LTRAJPS, LSIMPH=>YDSIMPHL%LSIMPH, LRAYSP=>YDSIMPHL%LRAYSP, &
- & LNEBR=>YDPHY%LNEBR, LCDDPRO=>YDPHY%LCDDPRO, LNEBN=>YDPHY%LNEBN, &
- & LMPHYS=>YDPHY%LMPHYS, NSORAYFR=>YDPHY%NSORAYFR, &
- & LCVCSD=>YDPHY%LCVCSD, LCVPRO=>YDPHY%LCVPRO, LNSDO=>YDPHY%LNSDO,&
- & LSTRAPRO=>YDPHY%LSTRAPRO, LUDEVOL=>YDPHY%LUDEVOL, LPTKE=>YDPHY%LPTKE, &
- & NDPSFI=>YDPHY%NDPSFI, LOZONE=>YDPHY%LOZONE, L3MT=>YDPHY%L3MT, &
- & LGPCMT=>YDPHY%LGPCMT, LAJUCV=>YDPHY%LAJUCV, LCVPGY=>YDPHY%LCVPGY, &
- & LRRGUST=>YDPHY%LRRGUST, LEDR=>YDPHY%LEDR, &
- & NTAJUC=>YDTOPH%NTAJUC, NTPLUI=>YDTOPH%NTPLUI, NDIM=>YGFL%NDIM, &
- & NDIM1=>YGFL%NDIM1, NUMFLDS=>YGFL%NUMFLDS, LAGPHY=>YDEPHY%LAGPHY, &
- & LEPHYS=>YDEPHY%LEPHYS, NDIMGMV=>YDGMV%NDIMGMV, &
- & LDPRECIPS=>YDPHY%LDPRECIPS, LDPRECIPS2=>YDPHY%LDPRECIPS2, &
- & NDTPREC=>YDPRECIPS%NDTPREC, NDTPREC2=>YDPRECIPS%NDTPREC2, &
- & NDTPRECCUR=>YDPRECIPS%NDTPRECCUR, NDTPRECCUR2=>YDPRECIPS%NDTPRECCUR2,&
- & NDIMGMVS=>YDGMV%NDIMGMVS, &
- & LSDDH=>YDLDDH%LSDDH, &
- & HDSF=>YDMDDH%HDSF, &
- & MSLB1SP9=>YDPTRSLB1%MSLB1SP9, &
- & NFLDSLB1=>YDPTRSLB1%NFLDSLB1, &
- & MSLB2KAPPAH=>YDPTRSLB2%MSLB2KAPPAH, &
- & MSLB2KAPPAM=>YDPTRSLB2%MSLB2KAPPAM, &
- & NFLDSLB2=>YDPTRSLB2%NFLDSLB2, &
- & LRCOEF=>YDRCOEF%LRCOEF, &
- & LTLADDIA=>YDRCOEF%LTLADDIA, &
- & NG3SR=>YDRCOEF%NG3SR, &
- & NSTOP=>YDRIP%NSTOP, NLIMA=>YGFL%NLIMA, YLIMA=>YGFL%YLIMA)
-
-CALL SC2PRG(YA%MP1 ,PGFLT1 ,ZPA1)
-CALL SC2PRG(1,YCHEM(:)%MP,PGFL ,ZP1CHEM)
-CALL SC2PRG(1,YCHEM(:)%MP9,PGFL ,ZP1CHEM9)
-CALL SC2PRG(YCPF%MP ,PGFL ,ZPCPF)
-CALL SC2PRG(YCPF%MP1 ,PGFLT1 ,ZPCPF1)
-CALL SC2PRG(YCVGQ%MP ,PGFL ,ZPCVGQ)
-CALL SC2PRG(YCVGQ%MPL ,PGFL ,ZPCVGQL)
-CALL SC2PRG(YCVGQ%MPM ,PGFL ,ZPCVGQM)
-CALL SC2PRG(YCVV%MP ,PGFL ,ZPCVV)
-CALL SC2PRG(YCVV%MP1 ,PGFLT1 ,ZPCVV1)
-CALL SC2PRG(YCVV%MP9 ,PGFL ,ZPCVV9)
-CALL SC2PRG(YDAL%MP ,PGFL ,ZPDAL)
-CALL SC2PRG(YDAL%MP1 ,PGFLT1 ,ZPDAL1)
-CALL SC2PRG(YDOM%MP ,PGFL ,ZPDOM)
-CALL SC2PRG(YDOM%MP1 ,PGFLT1 ,ZPDOM1)
-CALL SC2PRG(YEFB1%MP ,PGFL ,ZPEFB1)
-CALL SC2PRG(YEFB1%MP1 ,ZTENDGFL ,ZPTENDEFB11)
-CALL SC2PRG(YEFB1%MP9 ,PGFL ,ZPEFB19)
-CALL SC2PRG(YEFB2%MP ,PGFL ,ZPEFB2)
-CALL SC2PRG(YEFB2%MP1 ,ZTENDGFL ,ZPTENDEFB21)
-CALL SC2PRG(YEFB2%MP9 ,PGFL ,ZPEFB29)
-CALL SC2PRG(YEFB3%MP ,PGFL ,ZPEFB3)
-CALL SC2PRG(YEFB3%MP1 ,ZTENDGFL ,ZPTENDEFB31)
-CALL SC2PRG(YEFB3%MP9 ,PGFL ,ZPEFB39)
-CALL SC2PRG(1,YEXT(:)%MP,PGFL ,ZP1EXT)
-CALL SC2PRG(1,YEXT(:)%MP9,PGFL ,ZP1EXT9)
-CALL SC2PRG(1,YEZDIAG(:)%MP,PGFL,ZP1EZDIAG)
-CALL SC2PRG(YFQTUR%MP ,PGFL ,ZPFQTUR)
-CALL SC2PRG(YFQTUR%MP1,PGFLT1 ,ZPFQTUR1)
-CALL SC2PRG(YFSTUR%MP ,PGFL ,ZPFSTUR)
-CALL SC2PRG(YFSTUR%MP1,PGFLT1 ,ZPFSTUR1)
-CALL SC2PRG(YG%MP ,PGFL ,ZPG)
-CALL SC2PRG(YG%MP1 ,ZTENDGFL ,ZPTENDG1)
-CALL SC2PRG(YG%MP9 ,PGFL ,ZPG9)
-CALL SC2PRG(YH%MP ,PGFL ,ZPH)
-CALL SC2PRG(YH%MP9 ,PGFL ,ZPH9)
-CALL SC2PRG(YICONV%MP ,PGFL ,ZPICONV)
-CALL SC2PRG(YICONV%MP1,ZTENDGFL ,ZPTENDICONV1)
-CALL SC2PRG(YI%MP ,PGFL ,ZPI)
-CALL SC2PRG(YI%MP1 ,ZTENDGFL ,ZPTENDI1)
-CALL SC2PRG(YI%MP9 ,PGFL ,ZPI9)
-CALL SC2PRG(YIRAD%MP1 ,PGFLT1 ,ZPIRAD1)
-CALL SC2PRG(YLCONV%MP ,PGFL ,ZPLCONV)
-CALL SC2PRG(YLCONV%MP1,ZTENDGFL ,ZPTENDLCONV1)
-CALL SC2PRG(1,YLIMA(:)%MP,PGFL ,ZP1LIMA)
-CALL SC2PRG(1,YLIMA(:)%MP9,PGFL ,ZP1LIMA9)
-CALL SC2PRG(YL%MP ,PGFL ,ZPL)
-CALL SC2PRG(YL%MP1 ,ZTENDGFL ,ZPTENDL1)
-CALL SC2PRG(YL%MP9 ,PGFL ,ZPL9)
-CALL SC2PRG(YLRAD%MP1 ,PGFLT1 ,ZPLRAD1)
-CALL SC2PRG(YMXL%MP ,PGFL ,ZPMXL)
-CALL SC2PRG(YMXL%MP1 ,PGFLT1 ,ZPMXL1)
-CALL SC2PRG(1,YNOGW(:)%MP,PGFL ,ZP1NOGW)
-CALL SC2PRG(1,YNOGW(:)%MP9,PGFL ,ZP1NOGW9)
-CALL SC2PRG(2,YNOGW(:)%MP,PGFL ,ZP2NOGW)
-CALL SC2PRG(2,YNOGW(:)%MP9,PGFL ,ZP2NOGW9)
-CALL SC2PRG(YO3%MP ,PGFL ,ZPO3)
-CALL SC2PRG(YO3%MP1 ,PGFLT1 ,ZPO31)
-CALL SC2PRG(YO3%MP9 ,PGFL ,ZPO39)
-CALL SC2PRG(YQ%MP ,PGFL ,ZPQ)
-CALL SC2PRG(YQ%MP1 ,ZTENDGFL ,ZPTENDQ1)
-CALL SC2PRG(YQ%MP9 ,PGFL ,ZPQ9)
-CALL SC2PRG(YQ%MPL ,PGFL ,ZPQL)
-CALL SC2PRG(YQ%MPM ,PGFL ,ZPQM)
-CALL SC2PRG(YRCONV%MP ,PGFL ,ZPRCONV)
-CALL SC2PRG(YRCONV%MP1,PGFLT1 ,ZPRCONV1)
-CALL SC2PRG(YRCONV%MP1,ZTENDGFL ,ZPTENDRCONV1)
-CALL SC2PRG(YRKTH%MP ,PGFL ,ZPRKTH)
-CALL SC2PRG(YRKTH%MP1 ,PGFLT1 ,ZPRKTH1)
-CALL SC2PRG(YRKTQC%MP ,PGFL ,ZPRKTQC)
-CALL SC2PRG(YRKTQC%MP1,PGFLT1 ,ZPRKTQC1)
-CALL SC2PRG(YRKTQV%MP ,PGFL ,ZPRKTQV)
-CALL SC2PRG(YRKTQV%MP1,PGFLT1 ,ZPRKTQV1)
-CALL SC2PRG(YR%MP ,PGFL ,ZPR)
-CALL SC2PRG(YR%MP1 ,ZTENDGFL ,ZPTENDR1)
-CALL SC2PRG(YR%MP9 ,PGFL ,ZPR9)
-CALL SC2PRG(YSCONV%MP ,PGFL ,ZPSCONV)
-CALL SC2PRG(YSCONV%MP1,PGFLT1 ,ZPSCONV1)
-CALL SC2PRG(YSCONV%MP1,ZTENDGFL ,ZPTENDSCONV1)
-CALL SC2PRG(YSHTUR%MP ,PGFL ,ZPSHTUR)
-CALL SC2PRG(YSHTUR%MP1,PGFLT1 ,ZPSHTUR1)
-CALL SC2PRG(YS%MP ,PGFL ,ZPS)
-CALL SC2PRG(YS%MP1 ,ZTENDGFL ,ZPTENDS1)
-CALL SC2PRG(YS%MP9 ,PGFL ,ZPS9)
-CALL SC2PRG(YSPF%MP ,PGFL ,ZPSPF)
-CALL SC2PRG(YSPF%MP1 ,PGFLT1 ,ZPSPF1)
-CALL SC2PRG(YSRC%MP ,PGFL ,ZPSRC)
-CALL SC2PRG(YSRC%MP1 ,PGFLT1 ,ZPSRC1)
-CALL SC2PRG(YSRC%MP9 ,PGFL ,ZPSRC9)
-CALL SC2PRG(YTKE%MP ,PGFL ,ZPTKE)
-CALL SC2PRG(YTKE%MP1 ,ZTENDGFL ,ZPTENDTKE1)
-CALL SC2PRG(YTKE%MP9 ,PGFL ,ZPTKE9)
-CALL SC2PRG(YTTE%MP ,PGFL ,ZPTTE)
-CALL SC2PRG(YTTE%MP1 ,PGFLT1 ,ZPTTE1)
-CALL SC2PRG(YUAL%MP ,PGFL ,ZPUAL)
-CALL SC2PRG(YUAL%MP1 ,PGFLT1 ,ZPUAL1)
-CALL SC2PRG(YUEN%MP ,PGFL ,ZPUEN)
-CALL SC2PRG(YUEN%MP1 ,PGFLT1 ,ZPUEN1)
-CALL SC2PRG(YUNEBH%MP ,PGFL ,ZPUNEBH)
-CALL SC2PRG(YUNEBH%MP1,PGFLT1 ,ZPUNEBH1)
-CALL SC2PRG(YUOM%MP ,PGFL ,ZPUOM)
-CALL SC2PRG(YUOM%MP1 ,PGFLT1 ,ZPUOM1)
-CALL SC2PRG(YM_RADTC%MCOR,ZRADTC ,ZMCOR)
-CALL SC2PRG(YM_RADTC%MRAB3C,ZRADTC ,ZMRAB3C)
-CALL SC2PRG(YM_RADTC%MRAB3N,ZRADTC ,ZMRAB3N)
-CALL SC2PRG(YM_RADTC%MRAB4C,ZRADTC ,ZMRAB4C)
-CALL SC2PRG(YM_RADTC%MRAB4N,ZRADTC ,ZMRAB4N)
-CALL SC2PRG(YM_RADTC%MRAB6C,ZRADTC ,ZMRAB6C)
-CALL SC2PRG(YM_RADTC%MRAB6N,ZRADTC ,ZMRAB6N)
-CALL SC2PRG(YM_RADTC%MRAT1C,ZRADTC ,ZMRAT1C)
-CALL SC2PRG(YM_RADTC%MRAT1N,ZRADTC ,ZMRAT1N)
-CALL SC2PRG(YM_RADTC%MRAT2C,ZRADTC ,ZMRAT2C)
-CALL SC2PRG(YM_RADTC%MRAT2N,ZRADTC ,ZMRAT2N)
-CALL SC2PRG(YM_RADTC%MRAT3C,ZRADTC ,ZMRAT3C)
-CALL SC2PRG(YM_RADTC%MRAT3N,ZRADTC ,ZMRAT3N)
-CALL SC2PRG(YM_RADTC%MRAT4C,ZRADTC ,ZMRAT4C)
-CALL SC2PRG(YM_RADTC%MRAT4N,ZRADTC ,ZMRAT4N)
-CALL SC2PRG(YM_RADTC%MRAT5C,ZRADTC ,ZMRAT5C)
-CALL SC2PRG(YM_RADTC%MRAT5N,ZRADTC ,ZMRAT5N)
-CALL SC2PRG(YSD_DI%YXEDR%MP,PSD_DI ,ZDIXEDR)
-CALL SC2PRG(1,YSD_SFL%YSFL(:)%MP,PSD_SFL ,ZSFLSFL1)
-CALL SC2PRG(1,YSD_SFO%YSFO(:)%MP,PSD_SFO ,ZSFOSFO1)
-CALL SC2PRG(YSD_VA%YDES%MP,PSD_VA ,ZVADES)
-CALL SC2PRG(YSD_VA%YLAN%MP,PSD_VA ,ZVALAN)
-CALL SC2PRG(YSD_VA%YSEA%MP,PSD_VA ,ZVASEA)
-CALL SC2PRG(YSD_VA%YSOO%MP,PSD_VA ,ZVASOO)
-CALL SC2PRG(YSD_VA%YSUL%MP,PSD_VA ,ZVASUL)
-CALL SC2PRG(YSD_VA%YVOL%MP,PSD_VA ,ZVAVOL)
-CALL SC2PRG(1,YSD_VC%YVC(:)%MP,PSD_VC,ZVCVC1)
-CALL SC2PRG(YSD_VD%YSUND%MP,PSD_VD ,ZVDSUND)
-CALL SC2PRG(YSD_VF%YALBF%MP,PSD_VF ,ZVFALBF)
-CALL SC2PRG(YSD_VF%YALBSF%MP,PSD_VF,ZVFALBSF)
-CALL SC2PRG(YSD_VF%YEMISF%MP,PSD_VF,ZVFEMISF)
-CALL SC2PRG(YSD_VF%YGETRL%MP,PSD_VF,ZVFGETRL)
-CALL SC2PRG(YSD_VF%YLSM%MP,PSD_VF ,ZVFLSM)
-CALL SC2PRG(YSD_VF%YNUDM%MP,PSD_VF ,ZVFNUDM)
-CALL SC2PRG(YSD_VF%YVEG%MP,PSD_VF ,ZVFVEG)
-CALL SC2PRG(YSD_VF%YVRLAN%MP,PSD_VF,ZVFVRLAN)
-CALL SC2PRG(YSD_VF%YVRLDI%MP,PSD_VF,ZVFVRLDI)
-CALL SC2PRG(YSD_VF%YZ0F%MP,PSD_VF ,ZVFZ0F)
-CALL SC2PRG(YSD_VF%YZ0RLF%MP,PSD_VF,ZVFZ0RLF)
-CALL SC2PRG(YSD_VH%YBCCH%MP,PSD_VH ,ZVHBCCH)
-CALL SC2PRG(YSD_VH%YPBLH%MP,PSD_VH ,ZVHPBLH)
-CALL SC2PRG(YSD_VH%YQSH%MP,PSD_VH ,ZVHQSH)
-CALL SC2PRG(YSD_VH%YSCCH%MP,PSD_VH ,ZVHSCCH)
-CALL SC2PRG(YSD_VH%YSPSH%MP,PSD_VH ,ZVHSPSH)
-CALL SC2PRG(YSD_VH%YTCCH%MP,PSD_VH ,ZVHTCCH)
-CALL SC2PRG(YSD_VK%YUDGRO%MP,PSD_VK,ZVKUDGRO)
-CALL SC2PRG(YSD_VP%YTPC%MP,PSD_VP ,ZVPTPC)
-CALL SC2PRG(YSD_VP%YWPC%MP,PSD_VP ,ZVPWPC)
-CALL SC2PRG(YSD_VV%YALV%MP,PSD_VV ,ZVVALV)
-CALL SC2PRG(YSD_VV%YARG%MP,PSD_VV ,ZVVARG)
-CALL SC2PRG(YSD_VV%YD2%MP,PSD_VV ,ZVVD2)
-CALL SC2PRG(YSD_VV%YHV%MP,PSD_VV ,ZVVHV)
-CALL SC2PRG(YSD_VV%YIVEG%MP,PSD_VV ,ZVVIVEG)
-CALL SC2PRG(YSD_VV%YLAI%MP,PSD_VV ,ZVVLAI)
-CALL SC2PRG(YSD_VV%YRSMIN%MP,PSD_VV,ZVVRSMIN)
-CALL SC2PRG(YSD_VV%YSAB%MP,PSD_VV ,ZVVSAB)
-CALL SC2PRG(YSD_VV%YZ0H%MP,PSD_VV ,ZVVZ0H)
-CALL SC2PRG(YSP_RR%YFC%MP0,PSP_RR ,ZRRFC0)
-CALL SC2PRG(YSP_RR%YFC%MP1,PSP_RR ,ZRRFC1)
-CALL SC2PRG(YSP_RR%YFC%MP9,PSP_RR ,ZRRFC9)
-CALL SC2PRG(YSP_RR%YIC%MP0,PSP_RR ,ZRRIC0)
-CALL SC2PRG(YSP_RR%YIC%MP1,PSP_RR ,ZRRIC1)
-CALL SC2PRG(YSP_RR%YIC%MP9,PSP_RR ,ZRRIC9)
-CALL SC2PRG(YSP_RR%YT%MP0,PSP_RR ,ZRRT0)
-CALL SC2PRG(YSP_RR%YT%MP1,PSP_RR ,ZRRT1)
-CALL SC2PRG(YSP_RR%YT%MP9,PSP_RR ,ZRRT9)
-CALL SC2PRG(YSP_RR%YW%MP0,PSP_RR ,ZRRW0)
-CALL SC2PRG(YSP_RR%YW%MP1,PSP_RR ,ZRRW1)
-CALL SC2PRG(YSP_RR%YW%MP9,PSP_RR ,ZRRW9)
-CALL SC2PRG(YSP_SB%YQ%MP0,PSP_SB ,ZSBQ0)
-CALL SC2PRG(YSP_SB%YQ%MP1,PSP_SB ,ZSBQ1)
-CALL SC2PRG(YSP_SB%YQ%MP9,PSP_SB ,ZSBQ9)
-CALL SC2PRG(YSP_SB%YTL%MP0,PSP_SB ,ZSBTL0)
-CALL SC2PRG(YSP_SB%YTL%MP1,PSP_SB ,ZSBTL1)
-CALL SC2PRG(YSP_SB%YTL%MP9,PSP_SB ,ZSBTL9)
-CALL SC2PRG(YSP_SB%YT%MP0,PSP_SB ,ZSBT0)
-CALL SC2PRG(YSP_SB%YT%MP1,PSP_SB ,ZSBT1)
-CALL SC2PRG(YSP_SB%YT%MP9,PSP_SB ,ZSBT9)
-CALL SC2PRG(YSP_SG%YA%MP0,PSP_SG ,ZSGA0)
-CALL SC2PRG(YSP_SG%YA%MP1,PSP_SG ,ZSGA1)
-CALL SC2PRG(YSP_SG%YA%MP9,PSP_SG ,ZSGA9)
-CALL SC2PRG(YSP_SG%YF%MP0,PSP_SG ,ZSGF0)
-CALL SC2PRG(YSP_SG%YF%MP1,PSP_SG ,ZSGF1)
-CALL SC2PRG(YSP_SG%YF%MP9,PSP_SG ,ZSGF9)
-CALL SC2PRG(YSP_SG%YR%MP0,PSP_SG ,ZSGR0)
-CALL SC2PRG(YSP_SG%YR%MP1,PSP_SG ,ZSGR1)
-CALL SC2PRG(YSP_SG%YR%MP9,PSP_SG ,ZSGR9)
-CALL SC2PRG(YSP_SG%YT%MP1,PSP_SG ,ZSGT1)
-CALL SC2PRG(YT0%MDIV ,PGMV ,ZT0DIV)
-CALL SC2PRG(YT0%MSP ,PGMVS ,ZT0SP)
-CALL SC2PRG(YT0%MSPD ,PGMV ,ZT0SPD)
-CALL SC2PRG(YT0%MSPDL ,PGMV ,ZT0SPDL)
-CALL SC2PRG(YT0%MSPDM ,PGMV ,ZT0SPDM)
-CALL SC2PRG(YT0%MSPL ,PGMVS ,ZT0SPL)
-CALL SC2PRG(YT0%MSPM ,PGMVS ,ZT0SPM)
-CALL SC2PRG(YT0%MT ,PGMV ,ZT0T)
-CALL SC2PRG(YT0%MTL ,PGMV ,ZT0TL)
-CALL SC2PRG(YT0%MTM ,PGMV ,ZT0TM)
-CALL SC2PRG(YT0%MU ,PGMV ,ZT0U)
-CALL SC2PRG(YT0%MUL ,PGMV ,ZT0UL)
-CALL SC2PRG(YT0%MV ,PGMV ,ZT0V)
-CALL SC2PRG(YT0%MVL ,PGMV ,ZT0VL)
-CALL SC2PRG(YT0%MVOR ,PGMV ,ZT0VOR)
-CALL SC2PRG(YT1%MSP ,PGMVT1S ,ZT1SP)
-CALL SC2PRG(YT9%MDIV ,PGMV ,ZT9DIV)
-CALL SC2PRG(YT9%MSP ,PGMVS ,ZT9SP)
-CALL SC2PRG(YT9%MSPD ,PGMV ,ZT9SPD)
-CALL SC2PRG(YT9%MT ,PGMV ,ZT9T)
-CALL SC2PRG(YT9%MU ,PGMV ,ZT9U)
-CALL SC2PRG(YT9%MUL ,PGMV ,ZT9UL)
-CALL SC2PRG(YT9%MV ,PGMV ,ZT9V)
-CALL SC2PRG(YT9%MVL ,PGMV ,ZT9VL)
-CALL SC2PRG(YT9%MVOR ,PGMV ,ZT9VOR)
-! ------------------------------------------------------------------
-
-! 0. constructor for procset
-IF (LINTFLEX) YLPROCSET=NEWINTPROCSET()
-
-! 1. Preliminary calculations necessary
-! for all types of physics.
-! ------------------------------------
-
-IF (LSLAG) CALL CP_PTRSLB1(YDMODEL%YRML_DYN%YRDYN,YDPTRSLB1,ISLB1U9,ISLB1V9,ISLB1T9,ISLB1VD9,ISLB1GFL9)
-
-IBLK=(KSTGLO-1)/NPROMA+1
-INSTEP_DEB=1
-INSTEP_FIN=1
-
-! initialisation for surfex if XFU
-LLXFUMSE=.FALSE.
-IF (LDCONFX) THEN
- LLXFUMSE=.TRUE.
-ENDIF
-
-! SPP
-IF ( YSPP_CONFIG%LSPP ) THEN
- DO JROF=1,YSPP%N2D
- ZGP2DSPP(:,JROF) = YSPP%GP_ARP(JROF)%GP2D(:,1,KIBL)
- ENDDO
-ENDIF
-
-! Complete physics is called.
-LLDIAB=(LMPHYS.OR.LEPHYS).AND.(.NOT.LAGPHY)
-
-! In the NHQE model, MF_PHYS enters with Tt and grad(Tt), where Tt = T * exp(-(R/cp) log(pre/prehyd)).
-! But calculations of MF_PHYS must use T and grad(T).
-! So we do a conversion Tt -> T.
-IF (LNHQE) THEN
- ! Valid for NPDVAR=2 only.
- ! At instant t (with the derivatives):
- DO JLEV=1,NFLEVG
- DO JROF=KST,KEND
- ZTT0_SAVE(JROF,JLEV)=ZT0T(JROF,JLEV)
- ZTT0L_SAVE(JROF,JLEV)=ZT0TL(JROF,JLEV)
- ZTT0M_SAVE(JROF,JLEV)=ZT0TM(JROF,JLEV)
- ENDDO
- ENDDO
- CALL GNHQE_CONV_TEMPE(YDGEOMETRY,.TRUE.,YDMODEL%YRML_GCONF%YGFL%NDIM,KST,KEND,&
- & ZT0SPD,ZT0SP,ZT0T,&
- & KGFLTYP=0,PGFL=PGFL,KDDER=2,PQCHAL=ZT0SPDL,PQCHAM=ZT0SPDM,&
- & PTL=ZT0TL,PTM=ZT0TM)
- ! At instant t-dt for leap-frog advections (without the derivatives):
- IF (.NOT.LTWOTL) THEN
- DO JLEV=1,NFLEVG
- DO JROF=KST,KEND
- ZTT9_SAVE(JROF,JLEV)=ZT9T(JROF,JLEV)
- ENDDO
- ENDDO
- CALL GNHQE_CONV_TEMPE(YDGEOMETRY,.TRUE.,YDMODEL%YRML_GCONF%YGFL%NDIM,KST,KEND,&
- & ZT9SPD,ZT9SP,ZT9T,&
- & KGFLTYP=9,PGFL=PGFL)
- ENDIF
-ENDIF
-
-IF (LRAYSP.AND.(NSTEP >= INSTEP_DEB .AND. NSTEP <= INSTEP_FIN)) THEN
- CALL CPPSOLAN(YDGEOMETRY%YRDIM,KST,KEND,YDGSGEOM%GEMU,YDGSGEOM%GELAM,ZMMU0)
- IF (.NOT.LSDDH) THEN
-!-----------INITIALIZING THE WEIGHT VECTORS-------------
-DO JROF=KST,KEND
- PDHSF(JROF)=HDSF(JROF+KSTGLO-1)
-ENDDO
-!-------------------------------------------------------
- ENDIF
-ENDIF
-
-IF (LLDIAB.OR.LSIMPH) THEN
- CALL CPPHINP(YDGEOMETRY,YDMODEL,KST,KEND,&
- & YDGSGEOM%GEMU,YDGSGEOM%GELAM,&
- & ZT0U,ZT0V,&
- & ZPQ,ZPQL,ZPQM,ZPCVGQL,ZPCVGQM,&
- & PXYB0(1,1,YYTXYB0_PHY%M_RDELP),PCTY0(1,0,YYTCTY0%M_EVEL),ZPCVGQ,&
- & ZMU0,ZMU0LU,ZMU0M,ZMU0N,ZCVGQ)
- ZLCVQ(KST:KEND,1:NFLEVG)=ZCVGQ(KST:KEND,1:NFLEVG)
-ENDIF
-
-DO JLEV=1,NFLEVG
- DO JROF=KST,KEND
- ZCVGQL(JROF,JLEV)=0._JPRB
- ZCVGQI(JROF,JLEV)=0._JPRB
- ZCVGT (JROF,JLEV)=0._JPRB
- ENDDO
-ENDDO
-
-DO JROF=KST,KEND
- ZQSATS(JROF)=0.0_JPRB
- ZFPLCH(JROF,0)=0.0_JPRB
- ZFPLSH(JROF,0)=0.0_JPRB
-ENDDO
-
-IF(LNEBN.OR.LNEBR.OR.LRRGUST) THEN
- DO JLEV=1,NFLEVG
- DO JROF=KST,KEND
- ZFPLCH(JROF,JLEV)=ZPCPF(JROF,JLEV)
- ENDDO
- ENDDO
-ENDIF
-IF(LRRGUST) THEN
- DO JLEV=1,NFLEVG
- DO JROF=KST,KEND
- ZFPLSH(JROF,JLEV)=ZPSPF(JROF,JLEV)
- ENDDO
- ENDDO
-ENDIF
-
-! * In some cases, some pseudo-historic surface buffers (like z0) should
-! not be modified between the entrance and the output of MF_PHYS
-! (this is the case for example if LDCONFX=T).
-! For the time being, we must save:
-! - HV (group VV) : resistance to evapotranspiration
-! - Z0F (group VD): gravity * surface roughness length
-! - Z0H (group VV): gravity * roughness length for heat
-! - PBLH (group VH): PBL height
-! - SPSH (group VH):
-! - QSH (group VH):
-LL_SAVE_PHSURF=LLDIAB.AND.LDCONFX
-IF (LL_SAVE_PHSURF) THEN
- IF(YSD_VV%YHV%LSET) ZHV(1:NPROMA)=ZVVHV(1:NPROMA)
- IF(YSD_VF%YZ0F%LSET) ZGZ0F(1:NPROMA)=ZVFZ0F(1:NPROMA)
- IF(YSD_VV%YZ0H%LSET) ZGZ0HF(1:NPROMA)=ZVVZ0H(1:NPROMA)
- IF(YSD_VH%YPBLH%LSET) ZPBLH(1:NPROMA)=ZVHPBLH(1:NPROMA)
- IF(YSD_VH%YSPSH%LSET) ZFHPS(1:NPROMA)=ZVHSPSH(1:NPROMA)
- IF(YSD_VH%YQSH%LSET) ZQSH(1:NPROMA)=ZVHQSH(1:NPROMA)
- IF(YSD_VK%YUDGRO%LSET) ZUDGRO(1:NPROMA)=ZVKUDGRO(1:NPROMA)
- IF(LCVPRO.OR.LGPCMT) THEN
- ZUDAL(:,:)=ZPUAL(:,:)
- ZUDOM(:,:)=ZPUOM(:,:)
- IF(LCDDPRO) THEN
- ZDDAL(:,:)=ZPDAL(:,:)
- ZDDOM(:,:)=ZPDOM(:,:)
- ENDIF
- ENDIF
- IF(YUNEBH%LACTIVE) ZUNEBH(:,:)=ZPUNEBH(:,:)
- IF(YUEN%LACTIVE) ZENTCH(:,:)=ZPUEN(:,:)
-ENDIF
-
-IF (.NOT.ASSOCIATED(ZVASUL)) THEN
- ZAESUL_NULL(:)=0._JPRB
- ZVASUL=>ZAESUL_NULL
-ENDIF
-IF (.NOT.ASSOCIATED(ZVAVOL)) THEN
- ZVAVOL_NULL(:)=0._JPRB
- ZVAVOL=>ZVAVOL_NULL
-ENDIF
-
-CALL INITAPLPAR ( YGFL, YDARPHY, KST, KEND, NPROMA, NFLEVG, NTSSG, YSP_SBD%NLEVS,&
- & ZVFVEG ,&
- & PDIFCQ , PDIFCQI, PDIFCQL, PDIFCS , ZDIFEXT, PDIFTQ , PDIFTQI, PDIFTQL,&
- & PDIFTS , PFCCQL , PFCCQN , PFCSQL , PFCSQN , PFCQNG , PFCQING,&
- & PFCQLNG, PFCQRNG, PFCQSNG,PFCQGNG,&
- & PFPLCL , PFPLCN , PFPLCG , PFPLCHL, PFPLSL , PFPLSN ,PFPLSG ,&
- & PFPLSHL, PFRSO , PFRSOC ,&
- & PFRTH , PFRTHC , PSTRCU , PSTRCV , PSTRDU , PSTRDV , PSTRTU ,&
- & PSTRTV , PSTRMU , PSTRMV , PFRMH , ZFRMQ ,&
- & PDIFCQLC,PDIFCQIC,PFIMCC,&
- & PFEDQLC, PFEDQIC, PFEDQRC, PFEDQSC, PFCNEGQLC,PFCNEGQIC,PFCNEGQRC,PFCNEGQSC,&
- & PFCHOZ , ZCPS , ZLHS ,&
- & ZRS , ZLH , ZLSCPE , PNEB , PQICE , PQLI , ZQSAT ,&
- & ZQW , PRH , ZTW , PALBDG , ZCD , ZCDN , ZCH ,&
- & ZC1 , ZC2 , PCT , ZEMIS , PFCHSP , PFCLL , PFCLN ,&
- & PFCS , ZFEVI , PFEVL , PFEVN , PFEVV , PFLASH , PFTR , PFLWSP ,&
- & PFONTE , PFGEL , PFGELS ,&
- & PFRSGNI, PFRSDNI, PFRSODS, PFRSOPS, PFRSOPT, PFRSOLU, PFRTHDS,&
- & PFPFPSL, PFPFPSN,PFPFPSG, PFPFPCL, PFPFPCN,PFPEVPSL,PFPEVPSN,PFPEVPSG,PFPEVPCL,&
- & PFPEVPCN,PFPEVPCG,ZFTKE , ZFTKEI , ZFEFB1 , ZFEFB2 , ZFEFB3,&
- & PGZ0 , PGZ0H , ZNEIJ , ZVEG , PQS , ZQSATS , PRUISL ,&
- & PRUISP , PRUISS , PUCLS , PVCLS , PNUCLS , PNVCLS , PTCLS , PMRT,&
- & PQCLS , PRHCLS , PCLCT , PCLCH , PCLCM , PCLCL , PCLCC ,&
- & PCAPE , PCTOP , ICLPH , PCLPH , PVEIN , PUGST , PVGST ,&
- & PDIAGH , ZEDR, PVISICLD, PVISIHYDRO, PMXCLWC)
-
-!* 2. Complete physics.
-! -----------------
-
-! 2.2 Complete physics.
-! -----------------
-
-IF (LLDIAB.AND.(.NOT.LMPA)) THEN
-
- ! PAS DE TEMPS DE LA PHYSIQUE (/YOMPHY2/)
- ! Dans le cas des iterations de l'initialisation par modes normaux,
- ! le pas de temps pour la physique ne peux pas etre nul pour APLPAR et
- ! CPATY (par contre c'est bien PDTPHY qui est passe en argument aux autres
- ! sous-prog. de la physique). Ceci est du a l'impossibilite de prendre en
- ! compte des flux qui deviennent infinis pour TSPHY=0 (flux de masse du au
- ! reajustement des sursaturations par exemple...). Mais les tendances phys.
- ! sont bien nulles dans le cas de la configuration 'E' (Modes Normaux).
- ! PHYSICS TIME STEP (/YOMPHY2/)
- ! In case of normal mode initialisation iterations, the physics time
- ! step cannot be zero for APLPAR and CPATY (nevertheless it is PDTPHY
- ! which is passed to other physics subroutines). This is due to the
- ! impossibility to take into account fluxes which are infinite for TSPHY=0
- ! (e.g.: mass flux due to oversaturation...).
-
- TSPHY = MAX(PDTPHY,1.0_JPRB)
-
- ! CALL PARAMETERISATIONS
-
- DO JROF=KST,KEND
- ZVFLSM(JROF)=REAL(NINT(ZVFLSM(JROF)),JPRB)
- ENDDO
-
- IF (LTWOTL) THEN
-
- IF (LAJUCV) THEN
- DO JLEV=1,NFLEVG
- DO JROF=KST,KEND
- ZTAUX(JROF,JLEV)=ZT0T(JROF,JLEV)
- ENDDO
- ENDDO
- CALL ACAJUCV(YDMODEL%YRML_PHY_MF%YRPHY0,KST,KEND,NPROMA,NTPLUI,NFLEVG,NTAJUC,&
- & PRE0,PXYB0(1,1,YYTXYB0_PHY%M_ALPH),PXYB0(1,1,YYTXYB0_PHY%M_DELP),&
- & PXYB0(1,1,YYTXYB0_PHY%M_LNPR),ZT0T)
- DO JLEV=1,NFLEVG
- DO JROF=KST,KEND
- ZDTAJU(JROF,JLEV)=ZT0T(JROF,JLEV)-ZTAUX(JROF,JLEV)
- ENDDO
- ENDDO
- ENDIF
-
- ITDIA=1_JPIM
- CALL APLPAR(YDGEOMETRY,YDSURF, YDXFU, YDCFU, YDMODEL, KST , KEND , NPROMA ,&
- & ITDIA , NFLEVG , KSTGLO,&
- & NVCLIS , YSD_VVD%NUMFLDS ,&
- & NSTEP ,&
- & NTSSG , YSP_SBD%NLEVS ,&
- & KBL , KGPCOMP, YDCFU%NFRRC, PDTPHY,YDCSGEOM%RINDX,YDCSGEOM%RINDY, LLXFUMSE,&
- & PHI0 , PRE0 , PHIF0 , PRE0F ,PXYB0(1,1,YYTXYB0_PHY%M_ALPH),ZVVARG,&
- & ZVVD2 ,&
- & PXYB0(1,1,YYTXYB0_PHY%M_DELP),ZVVIVEG,ZVVLAI,&
- & PXYB0(1,1,YYTXYB0_PHY%M_LNPR),PXYB0(1,1,YYTXYB0_PHY%M_RDELP),&
- & ZVVRSMIN , ZVVSAB ,&
- & ZVVZ0H , ZVASEA , ZVALAN ,&
- & ZVASOO , ZVADES , ZVASUL ,&
- & ZVAVOL ,YDGSGEOM%RCORI, ZP1EXT,&
- & ZT0U,ZT0V,ZT0T,&
- & ZPQ,ZPI,ZPL,&
- & ZPLCONV,ZPICONV,ZPRCONV,ZPSCONV,&
- & ZPS,ZPR,ZPG,ZPTKE,&
- & ZPEFB1,ZPEFB2,ZPEFB3,&
- & ZPCVV,ZPO3,ZP1CHEM,ZP1NOGW,ZP2NOGW, PGFL, &
- & ZT0VOR,&
- & PRCP0(1,1,YYTRCP0%M_CP), ZCVGQ ,PRCP0(1,1,YYTRCP0%M_R), PKOZO , ZFPLCH , ZFPLSH ,&
- & ZPDAL,ZPDOM,ZPUEN,ZPUAL,&
- & ZPUOM,ZPUNEBH, PCTY0(1,0,YYTCTY0%M_EVEL),&
- & ZPRKTH,ZPRKTQV,ZPRKTQC, ZPTTE,&
- & ZPMXL,ZPSHTUR,ZPFQTUR, ZPFSTUR,&
- & ZVHTCCH , ZVHSCCH , ZVHBCCH ,&
- & ZVHSPSH ,ZVHPBLH ,&
- & ZVHQSH ,ZVKUDGRO ,&
- & PGPAR , PCUCONVCA, PNLCONVCA,&
- & ZSGF0 , ZSGA0, ZSGR0,&
- & ZSBT0 , ZRRT0 , ZRRFC0 ,&
- & ZSBQ0 , ZSBTL0, ZRRW0 ,&
- & ZRRIC0,&
- & ZVVHV , PCTY0(1,1,YYTCTY0%M_VVEL),&
- & PEMTD , PEMTU ,PTRSW ,&
- & ZVVALV ,&
- & ZVFALBF , ZVFALBSF , ZVFEMISF ,&
- & ZVFGETRL , ZVFLSM , ZVFVEG ,&
- & ZVFZ0F , ZVFZ0RLF,&
- & ZVFVRLAN , ZVFVRLDI , ZVCVC1 ,&
- & ZSFLSFL1 , ZSFOSFO1 ,&
- & PRMOON ,&
- & ZMU0 , ZMU0LU , ZMU0M ,ZMU0N,YDGSGEOM%GELAM,YDGSGEOM%GEMU,YDGSGEOM%GM,&
- & ZAC , ZAC_HC , ZMCOR , ZMMU0 , PDHSF ,&
- & ZMRAB3C,ZMRAB3N,&
- & ZMRAB4C,ZMRAB4N,&
- & ZMRAB6C,ZMRAB6N,&
- & ZMRAT1C,ZMRAT1N,&
- & ZMRAT2C,ZMRAT2N,&
- & ZMRAT3C,ZMRAT3N,&
- & ZMRAT4C,ZMRAT4N,&
- & ZMRAT5C,ZMRAT5N,&
- & YDOROG%OROG,&
- & PWT0,ZT0DIV,ZT0UL,ZT0VL,PWT0L,PWT0M,&
- & PGDEOSI,PGUEOSI,PGMU0,PGMU0_MIN,PGMU0_MAX,&
- & PGDEOTI,PGDEOTI2,PGUEOTI,PGUEOTI2,PGEOLT,PGEOXT,&
- & PGRPROX,PGMIXP,PGFLUXC,PGRSURF,&
- & PDIFCQ , PDIFCQI, PDIFCQL, PDIFCS , ZDIFEXT, PDIFTQ , PDIFTQI,&
- & PDIFTQL,&
- & PDIFTS , PFCCQL , PFCCQN , PFCSQL , PFCSQN , PFCQNG ,&
- & PFCQING, PFCQLNG, PFCQRNG, PFCQSNG, PFCQGNG,&
- & PFPLCL , PFPLCN , PFPLCG , PFPLSL , PFPLSN , PFPLSG , PFRSO ,&
- & PFRSOC ,&
- & PFRTH , PFRTHC , PSTRCU , PSTRCV , PSTRDU , PSTRDV ,&
- & PSTRTU ,&
- & PSTRTV , PSTRMU , PSTRMV , PFRMH , ZFRMQ ,&
- & PDIFCQLC,PDIFCQIC,PFIMCC,&
- & PFEDQLC, PFEDQIC, PFEDQRC, PFEDQSC, PFCNEGQLC,PFCNEGQIC,PFCNEGQRC,PFCNEGQSC,&
- & PFCHOZ ,&
- & ZCPS , ZLHS ,&
- & ZRS , ZLH , ZLSCPE , PNEB , PQICE , PQLI ,&
- & ZPA1,ZPLRAD1,ZPIRAD1,&
- & ZQRCONV, ZQSCONV,&
- & ZQSAT ,&
- & ZQW , PRH , ZTW , PALBDG , ZCD , ZCDN ,&
- & ZCH ,&
- & ZC1 , ZC2 , PCT , ZEMIS , PFCHSP , PFCLL ,&
- & PFCLN ,&
- & PFCS , ZFEVI , PFEVL , PFEVN , PFEVV , PFLASH,PFTR ,&
- & PFLWSP , PFONTE , PSP_SG(1,YSP_SG%YT%MP1), PFGEL , PFGELS ,&
- & PFRSGNI, PFRSDNI, PFRSODS, PFRSOPS, PFRSOPT, PFRSOLU, PFRTHDS,&
- & PFPFPSL, PFPFPSN, PFPFPSG, PFPFPCL, PFPFPCN, PFPEVPSL, PFPEVPSN,PFPEVPSG, PFPEVPCL,&
- & PFPEVPCN,PFPEVPCG,ZFTKE , ZFTKEI, ZFEFB1 , ZFEFB2 , ZFEFB3 ,PGZ0 , PGZ0H ,&
- & ZNEIJ , ZVEG , PQS,&
- & ZQSATS , PRUISL , PRUISP , PRUISS ,&
- & PUCLS , PVCLS , PNUCLS , PNVCLS , PTCLS , PMRT ,&
- & PQCLS , PRHCLS , PCLCT , PCLCH , PCLCM , PCLCL ,&
- & PCLCC , PCAPE , PCTOP , ICLPH , PCLPH , PVEIN , PUGST , PVGST , PDIAGH, &
- & ZP1EZDIAG, PTPWCLS,ZDPRECIPS,ZDPRECIPS2,PVISICLD,PVISIHYDRO,PMXCLWC,&
- & ZSGF1, ZTENDPTKE, ZKUROV_H, ZKTROV_H,&
- & PDERNSHF, ZTENDEXT_DEP, ZVDSUND,PTRAJ_PHYS,&
- & ZEDR, YDDDH, ZSBT1, ZRRW1, &
- & ZSBQ1,ZRRIC1,ZSBTL1,&
- & ZRRFC1,ZSGA1,ZSGR1,PFTCNS,&
- & ZGP2DSPP)
-
- IF (LAJUCV) THEN
- DO JLEV=1,NFLEVG
- DO JROF=KST,KEND
- ZT0T(JROF,JLEV)=ZTAUX(JROF,JLEV)
- ENDDO
- ENDDO
- DO JLEV=1,NFLEVG
- DO JROF=KST,KEND
- PB1(JROF,ISLB1T9+JLEV-NFLSA)=PB1(JROF,ISLB1T9+JLEV-NFLSA)+ZDTAJU(JROF,JLEV)
- ENDDO
- ENDDO
- ENDIF
-
- ELSE
-
- ! IF (LAJUCV) THEN
- ! missing code under LAJUCV for leap-frog schemes.
- ! ENDIF
-
- ITDIA=1_JPIM
- CALL APLPAR(YDGEOMETRY,YDSURF, YDXFU, YDCFU,YDMODEL, KST, KEND , NPROMA ,&
- & ITDIA , NFLEVG , KSTGLO ,&
- & NVCLIS , YSD_VVD%NUMFLDS ,&
- & NSTEP ,&
- & NTSSG , YSP_SBD%NLEVS ,&
- & KBL , KGPCOMP, YDCFU%NFRRC, PDTPHY,YDCSGEOM%RINDX,YDCSGEOM%RINDY, LLXFUMSE,&
- & PHI9 , PRE9 , PHIF9 , PRE9F , PXYB9(1,1,YYTXYB9_PHY%M_ALPH) , ZVVARG ,&
- & ZVVD2 ,&
- & PXYB9(1,1,YYTXYB9_PHY%M_DELP),ZVVIVEG,ZVVLAI,&
- & PXYB9(1,1,YYTXYB9_PHY%M_LNPR),PXYB9(1,1,YYTXYB9_PHY%M_RDELP),&
- & ZVVRSMIN , ZVVSAB ,&
- & ZVVZ0H , ZVASEA , ZVALAN ,&
- & ZVASOO , ZVADES , ZVASUL ,&
- & ZVAVOL,YDGSGEOM%RCORI, ZP1EXT9,&
- & ZT9U,ZT9V,ZT9T,&
- & ZPQ9,ZPI9,ZPL9,&
- & ZPLCONV,ZPICONV,ZPRCONV,ZPSCONV,&
- & ZPS9,ZPR9,ZPG9,ZPTKE9,&
- & ZPEFB19,ZPEFB29,ZPEFB39,&
- & ZPCVV9,ZPO39,ZP1CHEM9,ZP1NOGW9,ZP2NOGW9, PGFL, &
- & ZT9VOR,&
- & PRCP9(1,1,YYTRCP9%M_CP), ZCVGQ ,PRCP9(1,1,YYTRCP9%M_R), PKOZO , ZFPLCH, ZFPLSH ,&
- & ZPDAL,ZPDOM,ZPUEN,ZPUAL,&
- & ZPUOM,ZPUNEBH, PCTY0(1,0,YYTCTY0%M_EVEL),&
- & ZPRKTH,ZPRKTQV,ZPRKTQC, ZPTTE,&
- & ZPMXL,ZPSHTUR,ZPFQTUR,ZPFSTUR,&
- & ZVHTCCH , ZVHSCCH , ZVHBCCH ,&
- & ZVHSPSH , ZVHPBLH ,&
- & ZVHQSH ,ZVKUDGRO ,&
- & PGPAR , PCUCONVCA, PNLCONVCA,&
- & ZSGF9 , ZSGA9, ZSGR9,&
- & ZSBT9 , ZRRT9 , ZRRFC9 ,&
- & ZSBQ9 , ZSBTL9, ZRRW9 ,&
- & ZRRIC9,&
- & ZVVHV , PCTY0(1,1,YYTCTY0%M_VVEL),&
- & PEMTD , PEMTU ,PTRSW ,&
- & ZVVALV ,&
- & ZVFALBF , ZVFALBSF , ZVFEMISF ,&
- & ZVFGETRL , ZVFLSM , ZVFVEG ,&
- & ZVFZ0F , ZVFZ0RLF,&
- & ZVFVRLAN , ZVFVRLDI , ZVCVC1 ,&
- & ZSFLSFL1 , ZSFOSFO1 , PRMOON ,&
- & ZMU0 , ZMU0LU , ZMU0M , ZMU0N,YDGSGEOM%GELAM,YDGSGEOM%GEMU,YDGSGEOM%GM,&
- & ZAC , ZAC_HC , ZMCOR , ZMMU0 , PDHSF ,&
- & ZMRAB3C,ZMRAB3N,&
- & ZMRAB4C,ZMRAB4N,&
- & ZMRAB6C,ZMRAB6N,&
- & ZMRAT1C,ZMRAT1N,&
- & ZMRAT2C,ZMRAT2N,&
- & ZMRAT3C,ZMRAT3N,&
- & ZMRAT4C,ZMRAT4N,&
- & ZMRAT5C,ZMRAT5N,&
- & YDOROG%OROG,&
- & PWT9,ZT9DIV,ZT9UL,ZT9VL,ZWT9L,ZWT9M,&
- & PGDEOSI,PGUEOSI,PGMU0,PGMU0_MIN,PGMU0_MAX,&
- & PGDEOTI,PGDEOTI2,PGUEOTI,PGUEOTI2,PGEOLT,PGEOXT,&
- & PGRPROX,PGMIXP,PGFLUXC,PGRSURF,&
- & PDIFCQ , PDIFCQI, PDIFCQL, PDIFCS , ZDIFEXT, PDIFTQ , PDIFTQI,&
- & PDIFTQL,&
- & PDIFTS , PFCCQL , PFCCQN , PFCSQL , PFCSQN , PFCQNG ,&
- & PFCQING, PFCQLNG, PFCQRNG, PFCQSNG,PFCQGNG,&
- & PFPLCL , PFPLCN , PFPLCG , PFPLSL , PFPLSN , PFPLSG , PFRSO ,&
- & PFRSOC ,&
- & PFRTH , PFRTHC , PSTRCU , PSTRCV , PSTRDU , PSTRDV ,&
- & PSTRTU ,&
- & PSTRTV , PSTRMU , PSTRMV , PFRMH , ZFRMQ ,&
- & PDIFCQLC,PDIFCQIC,PFIMCC,&
- & PFEDQLC, PFEDQIC, PFEDQRC, PFEDQSC, PFCNEGQLC,PFCNEGQIC,PFCNEGQRC,PFCNEGQSC,&
- & PFCHOZ ,&
- & ZCPS , ZLHS ,&
- & ZRS , ZLH , ZLSCPE , PNEB , PQICE , PQLI ,&
- & ZPA1,ZPLRAD1,ZPIRAD1,&
- & ZQRCONV, ZQSCONV,&
- & ZQSAT ,&
- & ZQW , PRH , ZTW , PALBDG , ZCD , ZCDN ,&
- & ZCH ,&
- & ZC1 , ZC2 , PCT , ZEMIS , PFCHSP , PFCLL ,&
- & PFCLN ,&
- & PFCS , ZFEVI , PFEVL , PFEVN , PFEVV , PFLASH, PFTR ,&
- & PFLWSP , PFONTE , ZSGT1, PFGEL , PFGELS ,&
- & PFRSGNI, PFRSDNI, PFRSODS, PFRSOPS, PFRSOPT, PFRSOLU, PFRTHDS,&
- & PFPFPSL, PFPFPSN, PFPFPSG, PFPFPCL, PFPFPCN, PFPEVPSL,PFPEVPSN,PFPEVPSG, PFPEVPCL,&
- & PFPEVPCN,PFPEVPCG,ZFTKE , ZFTKEI, ZFEFB1 , ZFEFB2 , ZFEFB3 ,PGZ0 , PGZ0H ,&
- & ZNEIJ , ZVEG , PQS,&
- & ZQSATS , PRUISL , PRUISP , PRUISS ,&
- & PUCLS , PVCLS , PNUCLS , PNVCLS , PTCLS , PMRT ,&
- & PQCLS , PRHCLS , PCLCT , PCLCH , PCLCM , PCLCL ,&
- & PCLCC , PCAPE , PCTOP , ICLPH , PCLPH , PVEIN , PUGST , PVGST , PDIAGH, &
- & ZP1EZDIAG, PTPWCLS,ZDPRECIPS,ZDPRECIPS2,PVISICLD,PVISIHYDRO,PMXCLWC,&
- & ZSGF1, ZTENDPTKE, ZKUROV_H, ZKTROV_H ,&
- & PDERNSHF, ZTENDEXT_DEP, ZVDSUND,PTRAJ_PHYS,&
- & ZEDR,YDDDH, ZSBT1, ZRRW1, &
- & ZSBQ1,ZRRIC1,ZSBTL1,&
- & ZRRFC1,ZSGA1,ZSGR1,PFTCNS,&
- & ZGP2DSPP)
-
- ! IF (LAJUCV) THEN
- ! missing code under LAJUCV for leap-frog schemes.
- ! ENDIF
-
- ENDIF
-
- ! convert to flexible interface structure
- IF (LINTFLEX) THEN
- CALL APLPAR2INTFLEX(YGFL,YDPHY,NPROMA, KST, KEND, NFLEVG,&
- & PDIFCQ , PDIFCQI, PDIFCQL, PDIFCS ,ZDIFEXT,&
- & PDIFTQ , PDIFTQI, PDIFTQL, PDIFTS ,&
- & PFCCQL , PFCCQN , PFCSQL , PFCSQN ,&
- & PFPLSL , PFPLSN , PFPLCL, PFPLCN,&
- & PFPEVPSL,PFPEVPSN,PFPEVPCL,PFPEVPCN,&
- & PFPFPSL, PFPFPSN, PFPFPCL ,PFPFPCN ,&
- & PFCQLNG, PFCQING, PFCQRNG, PFCQSNG,&
- & PFCQNG , PFRMH , ZFRMQ , PFRSO , PFRTH ,&
- & PSTRCU , PSTRCV , PSTRDU , PSTRDV ,&
- & PSTRTU , PSTRTV , PSTRMU , PSTRMV ,&
- & PDIFCQLC,PDIFCQIC,PFIMCC,&
- & PFEDQLC, PFEDQIC, PFEDQRC, PFEDQSC, PFCNEGQLC,PFCNEGQIC,PFCNEGQRC,PFCNEGQSC,&
- & ZFTKE,&
- & ZTENDPTKE, ZTENDEXT, ZTENDEXT_DEP,&
- & YLPROCSET )
- ENDIF
-
-ENDIF ! LLDIAB.AND..NOT.LMPA
-
-! 2.3 Computes MOCON in the CLP.
-! --------------------------
-PMOCON(KST:KEND)=0.0_JPRB
-IF (LLDIAB.AND.(.NOT.LMPA)) THEN
-
- IF (LTWOTL) THEN
- DO JLEV=1,NFLEVG
- DO JROF = KST, KEND
- PMOCON(JROF) = PMOCON(JROF)+(ZLCVQ(JROF,JLEV)-ZPQ(JROF,JLEV)*&
- & ZT0DIV(JROF,JLEV))*PXYB0(JROF,JLEV,YYTXYB0_PHY%M_DELP)&
- & *MAX(0,SIGN(1,JLEV-ICLPH(JROF)))
- ENDDO
- ENDDO
- DO JROF = KST, KEND
- PMOCON(JROF) = PMOCON(JROF)/(PRE0(JROF,NFLEVG)-PRE0(JROF,ICLPH(JROF)-1))
- ENDDO
- ELSE
- DO JLEV=1,NFLEVG
- DO JROF = KST, KEND
- PMOCON(JROF) = PMOCON(JROF)+(ZLCVQ(JROF,JLEV)-ZPQ9(JROF,JLEV)*&
- & ZT0DIV(JROF,JLEV))*PXYB9(JROF,JLEV,YYTXYB9_PHY%M_DELP)&
- & *MAX(0,SIGN(1,JLEV-ICLPH(JROF)))
- ENDDO
- ENDDO
- DO JROF = KST, KEND
- PMOCON(JROF) = PMOCON(JROF)/(PRE9(JROF,NFLEVG)-PRE9(JROF,ICLPH(JROF)-1))
- ENDDO
- ENDIF
-ENDIF
-
-! Store surface water flux P and E for water conservation
-IF (LCORWAT) THEN
- PSD_VH(KST:KEND,YSD_VH%YPSL%MP) = PFPLSL(KST:KEND,NFLEVG)
- PSD_VH(KST:KEND,YSD_VH%YPCL%MP) = PFPLCL(KST:KEND,NFLEVG)
- PSD_VH(KST:KEND,YSD_VH%YPSN%MP) = PFPLSN(KST:KEND,NFLEVG)
- PSD_VH(KST:KEND,YSD_VH%YPCN%MP) = PFPLCN(KST:KEND,NFLEVG)
- PSD_VH(KST:KEND,YSD_VH%YEVA%MP) = PFEVN(KST:KEND,1)-PFEVL(KST:KEND,1)
-ENDIF
-
-! 2.4 Stores radiation coefficients.
-! ------------------------------
-
-! * writes grid-point transmission coefficients for simplified physics.
-
-IF (LRCOEF.AND.(NSTEP == 1).AND.LLDIAB.AND.(.NOT.LMPA)) THEN
- IFIELDSS=NG3SR*NFLEVG
- CALL WRRADCOEF(YDGEOMETRY,YDRCOEF,KST,KEND,KSTGLO,IFIELDSS,ZRADTC,ZAC_HC)
-ENDIF
-
-! 2.5 Ozone
-! -----
-
-IF (LLDIAB.AND.LOZONE.AND.(.NOT.LMPA)) THEN
- ! * Caution: this part has not been yet validated relative
- ! to the GFL implementation, and LOZONE (the setup of
- ! which has not yet been updated) can be true only if
- ! the GFL ozone is activated as a prognostic and advected
- ! variable.
- IPO3=(YO3%MP_SL1-1)*(NFLEVG+2*NFLSUL)
- IF (LSLAG) THEN
- IF (LTWOTL) THEN
- CALL CPOZO (NPROMA,KST,KEND,NFLEVG,PDTPHY,PFCHOZ,&
- & PB1(1,ISLB1GFL9+IPO3+1-NFLSA),PXYB0(1,1,YYTXYB0_PHY%M_RDELP))
- ELSE
- CALL CPOZO (NPROMA,KST,KEND,NFLEVG,PDTPHY,PFCHOZ,&
- & PB1(1,ISLB1GFL9+IPO3+1-NFLSA),PXYB9(1,1,YYTXYB9_PHY%M_RDELP))
- ENDIF
- ELSE
- CALL CPOZO (NPROMA,KST,KEND,NFLEVG,PDTPHY,PFCHOZ,&
- & ZPO31,PXYB9(1,1,YYTXYB9_PHY%M_RDELP))
- ENDIF
-ENDIF
-
-! 2.5.1 Chemical species
-! ----------------
-IF (LCHEM_ARPCLIM) THEN
- ! Processes described in my_phys ARPEGE-Climat 6.3 : to be added later here
- ! Modify also calls in CPTEND_NEW, etc.. as done ARPEGE-Climat 6.3.
-ENDIF
-
-! 2.6 surface specific humidity necessary to compute the vertical
-! advection of q in the case "delta m=1" (unlagged physics only).
-! ---------------------------------------------------------------
-
-IF (LLDIAB.AND.(NDPSFI == 1)) THEN
- CALL CPQSOL(YDGEOMETRY%YRDIMV,YDPHY,NPROMA,KST,KEND,PRE0,ZRRT0,PQS,ZQSATS,PQSOL)
-ENDIF
-
-! 2.7 Computation of tendencies T,u,v and Q.
-! --------------------------------------
-
-! Set GFL tendencies to 0
-
-ZTENDGFL(:,:,:) = 0.0_JPRB
-
-IF (LLDIAB.AND.(.NOT.LSIMPH).AND.(.NOT.LMPA)) THEN
-
- TSPHY = MAX(PDTPHY,1.0_JPRB)
-
- ! * CPTEND+CPUTQY = Old( CPATY + CPDUP + CPDTHP )
- ! Calcul des tendances de T , U et de Q et modifications
- ! eventuelles de W et de OMEGA/P
-
- IF (LTWOTL) THEN
-
- IF (LINTFLEX.AND.(.NOT.LDCONFX)) THEN
- CALL CPTEND_FLEX( YDLDDH,YDMDDH,YGFL,YDPHY,NPROMA, KST, KEND, NFLEVG,YDGSGEOM%GNORDL,YDGSGEOM%GNORDM,&
- & PXYB0(1,1,YYTXYB0_PHY%M_DELP) ,&
- & PXYB0(1,1,YYTXYB0_PHY%M_RDELP), PRCP0(1,1,YYTRCP0%M_CP),&
- & ZT0U,ZT0V,ZT0T,ZRRT0,&
- & PGFL,&
- & YLPROCSET,&
- & PTENDU , PTENDV , ZTENDH , ZTENDGFL,&
- & PFHSCL ,PFHSCN,PFHSSL,PFHSSN,&
- & PFHPCL ,PFHPCN,PFHPSL,PFHPSN,&
- & ZFHP ,ZFP , PFEPFP, PFCMPCQ, PFCMPSN, PFCMPSL,YDDDH )
- ELSE
- CALL CPTEND_NEW( YDMODEL, NPROMA, KST, KEND, NFLEVG,YDGSGEOM%GNORDL,YDGSGEOM%GNORDM,&
- & PDIFCQ , PDIFCQI, PDIFCQL, PDIFCS ,ZDIFEXT,&
- & PDIFTQ , PDIFTQI, PDIFTQL, PDIFTS ,&
- & PFCCQL , PFCCQN , PFCSQL , PFCSQN ,&
- & PFPLSL , PFPLSN , PFPLSG , PFPLCL, PFPLCN, PFPLCG,&
- & PFPEVPSL,PFPEVPSN,PFPEVPSG,PFPEVPCL,PFPEVPCN,PFPEVPCG,&
- & PFPFPSL, PFPFPSN, PFPFPSG, PFPFPCL ,PFPFPCN ,&
- & PFCQLNG, PFCQING, PFCQRNG, PFCQSNG, PFCQGNG ,&
- & PFCQNG , PFRMH , ZFRMQ , PFRSO , PFRTH ,&
- & PSTRCU , PSTRCV , PSTRDU , PSTRDV ,&
- & PSTRTU , PSTRTV , PSTRMU , PSTRMV ,&
- & PDIFCQLC,PDIFCQIC,PFIMCC,&
- & PFEDQLC, PFEDQIC, PFEDQRC, PFEDQSC, PFCNEGQLC,PFCNEGQIC,PFCNEGQRC,PFCNEGQSC,&
- & ZFTKE , ZFTKEI, ZFEFB1 , ZFEFB2 , ZFEFB3 ,PXYB0(1,1,YYTXYB0_PHY%M_DELP) ,&
- & PXYB0(1,1,YYTXYB0_PHY%M_RDELP), PHIF0 , PRCP0(1,1,YYTRCP0%M_CP),&
- & ZT0U,ZT0V,ZT0T,&
- & ZPQ,ZPI,ZPL,&
- & ZPLCONV,ZPICONV,ZPRCONV,ZPSCONV,&
- & ZPR,ZPS,ZPG,&
- & ZCPS , ZRRT0 ,&
- & PFHSCL ,PFHSCN,PFHSSL,PFHSSN,PFHSSG,&
- & PFHPCL ,PFHPCN,PFHPCG,PFHPSL,PFHPSN,PFHPSG,&
- & ZFHP ,ZFP , PFEPFP, PFCMPCQ, PFCMPSN, PFCMPSL,&
- & PTENDU , PTENDV , ZTENDU, ZTENDV, ZTENDH ,&
- & ZPTENDQ1,ZPTENDI1,ZPTENDL1,&
- & ZPTENDLCONV1,ZPTENDICONV1,&
- & ZPTENDRCONV1,ZPTENDSCONV1,&
- & ZPTENDR1,ZPTENDS1,ZPTENDG1,ZPTENDTKE1,&
- & ZPTENDEFB11,ZPTENDEFB21,ZPTENDEFB31,&
- & ZTENDEXT,YDDDH)
- ENDIF
- ELSE
- IF (LINTFLEX.AND.(.NOT.LDCONFX)) THEN
- CALL CPTEND_FLEX( YDLDDH,YDMDDH,YGFL,YDPHY,NPROMA, KST, KEND, NFLEVG,YDGSGEOM%GNORDL,YDGSGEOM%GNORDM,&
- & PXYB9(1,1,YYTXYB9_PHY%M_DELP) ,&
- & PXYB9(1,1,YYTXYB9_PHY%M_RDELP), PRCP9(1,1,YYTRCP9%M_CP),&
- & ZT9U,ZT9V,ZT9T,ZRRT9,&
- & PGFL,&
- & YLPROCSET,&
- & PTENDU , PTENDV , ZTENDH , ZTENDGFL,&
- & PFHSCL ,PFHSCN,PFHSSL,PFHSSN,&
- & PFHPCL ,PFHPCN,PFHPSL,PFHPSN,&
- & ZFHP ,ZFP , PFEPFP, PFCMPCQ, PFCMPSN, PFCMPSL,YDDDH )
- ELSE
- CALL CPTEND_NEW( YDMODEL, NPROMA, KST, KEND, NFLEVG,YDGSGEOM%GNORDL,YDGSGEOM%GNORDM,&
- & PDIFCQ , PDIFCQI, PDIFCQL, PDIFCS ,ZDIFEXT,&
- & PDIFTQ , PDIFTQI, PDIFTQL, PDIFTS ,&
- & PFCCQL , PFCCQN , PFCSQL , PFCSQN ,&
- & PFPLSL , PFPLSN , PFPLSG , PFPLCL, PFPLCN, PFPLCG,&
- & PFPEVPSL,PFPEVPSN,PFPEVPSG,PFPEVPCL,PFPEVPCN,PFPEVPCG,&
- & PFPFPSL, PFPFPSN, PFPFPSG, PFPFPCL ,PFPFPCN,&
- & PFCQLNG, PFCQING, PFCQRNG, PFCQSNG, PFCQGNG,&
- & PFCQNG , PFRMH , ZFRMQ , PFRSO , PFRTH ,&
- & PSTRCU , PSTRCV , PSTRDU , PSTRDV ,&
- & PSTRTU , PSTRTV , PSTRMU , PSTRMV ,&
- & PDIFCQLC,PDIFCQIC,PFIMCC,&
- & PFEDQLC, PFEDQIC, PFEDQRC, PFEDQSC, PFCNEGQLC,PFCNEGQIC,PFCNEGQRC,PFCNEGQSC,&
- & ZFTKE , ZFTKEI, ZFEFB1 , ZFEFB2 , ZFEFB3 , PXYB9(1,1,YYTXYB9_PHY%M_DELP) ,&
- & PXYB9(1,1,YYTXYB9_PHY%M_RDELP), PHIF9 , PRCP9(1,1,YYTRCP9%M_CP),&
- & ZT9U,ZT9V,ZT9T,&
- & ZPQ9,ZPI9,ZPL9,&
- & ZPLCONV,ZPICONV,ZPRCONV,ZPSCONV,&
- & ZPR9,ZPS9,ZPG9,&
- & ZCPS , ZRRT9,&
- & PFHSCL ,PFHSCN,PFHSSL,PFHSSN,PFHSSG,&
- & PFHPCL ,PFHPCN,PFHPCG,PFHPSL,PFHPSN,PFHPSG,&
- & ZFHP ,ZFP , PFEPFP, PFCMPCQ, PFCMPSN, PFCMPSL,&
- & PTENDU , PTENDV , ZTENDU, ZTENDV, ZTENDH ,&
- & ZPTENDQ1,ZPTENDI1,ZPTENDL1,&
- & ZPTENDLCONV1,ZPTENDICONV1,&
- & ZPTENDRCONV1,ZPTENDSCONV1,&
- & ZPTENDR1,ZPTENDS1,ZPTENDG1,ZPTENDTKE1,&
- & ZPTENDEFB11,ZPTENDEFB21,ZPTENDEFB31,&
- & ZTENDEXT,YDDDH)
- ENDIF
-
- IF ( L3MT.OR.LSTRAPRO.OR.(NDPSFI==1)) THEN
-! PFEPFP was ZFEPFP in CPTEND_NEW, before, ZFEPFP still in CPFHPFS
- DO JLEV= 0, NFLEVG
- DO JROF = 1, NPROMA
- PFEPFP(JROF,JLEV) = 0.0_JPRB
- PFCMPCQ(JROF,JLEV) = 0.0_JPRB
- PFCMPSN(JROF,JLEV) = 0.0_JPRB
- PFCMPSL(JROF,JLEV) = 0.0_JPRB
- ENDDO
- ENDDO
- ENDIF
-
- ENDIF ! LTWOTL
-
-
-
-! 2.7.1 Diagnostics on physical tendencies
-! ----------------------------------
-
- IF (.NOT.LDCONFX) THEN
- IF ((GCHETN%LFREQD).OR.(GCHETN%LCOORD).OR.(GCHETN%LPROFV)) THEN
- IF (LTWOTL) THEN
- CALL CPCHET( YDRIP,YDPHY, NPROMA, KST, KEND, NFLEVG, NSTEP,&
- & PFHSCL , PFHSCN , PFHSSL , PFHSSN ,&
- & PFHPCL , PFHPCN , PFHPSL , PFHPSN ,&
- & PDIFCQ , PDIFCQI, PDIFCQL, PDIFCS ,&
- & PDIFTQ , PDIFTQI, PDIFTQL, PDIFTS ,&
- & PFCCQL , PFCCQN , PFCSQL , PFCSQN ,&
- & PFPLCL , PFPLCN , PFPLSL , PFPLSN ,&
- & PFPFPSL, PFPFPSN, PFPFPCL, PFPFPCN,&
- & PFPEVPSL,PFPEVPSN,PFPEVPCL,PFPEVPCN,&
- & PFRMH , ZFRMQ , PFRSO , PFRTH ,&
- & PSTRCU , PSTRCV , PSTRDU , PSTRDV ,&
- & PSTRTU , PSTRTV , PSTRMU , PSTRMV ,&
- & PXYB0(1,1,YYTXYB0_PHY%M_RDELP), PRCP0(1,1,YYTRCP0%M_CP),&
- & ZT0T,ZPQ,ZPI,ZPL,&
- & ZCPS , ZRRT0 , PQS ,&
- & PTENDU , PTENDV , ZTENDH ,&
- & ZPTENDQ1,ZPTENDI1,ZPTENDL1,&
- & ZPTENDR1,ZPTENDS1,&
- & YDGSGEOM%GEMU,YDGSGEOM%GELAM, PHI0 , PHIF0 )
- ELSE
- CALL CPCHET( YDRIP,YDPHY, NPROMA, KST, KEND, NFLEVG, NSTEP,&
- & PFHSCL , PFHSCN , PFHSSL , PFHSSN ,&
- & PFHPCL , PFHPCN , PFHPSL , PFHPSN ,&
- & PDIFCQ , PDIFCQI, PDIFCQL, PDIFCS ,&
- & PDIFTQ , PDIFTQI, PDIFTQL, PDIFTS ,&
- & PFCCQL , PFCCQN , PFCSQL , PFCSQN ,&
- & PFPLCL , PFPLCN , PFPLSL , PFPLSN ,&
- & PFPFPSL, PFPFPSN, PFPFPCL, PFPFPCN,&
- & PFPEVPSL,PFPEVPSN,PFPEVPCL,PFPEVPCN,&
- & PFRMH , ZFRMQ , PFRSO , PFRTH ,&
- & PSTRCU , PSTRCV , PSTRDU , PSTRDV ,&
- & PSTRTU , PSTRTV , PSTRMU , PSTRMV ,&
- & PXYB9(1,1,YYTXYB9_PHY%M_RDELP), PRCP9(1,1,YYTRCP9%M_CP),&
- & ZT9T,ZPQ9,ZPI9,ZPL9,&
- & ZCPS , ZRRT9 , PQS ,&
- & PTENDU , PTENDV , ZTENDH ,&
- & ZPTENDQ1,ZPTENDI1,ZPTENDL1,&
- & ZPTENDR1,ZPTENDS1,&
- & YDGSGEOM%GEMU,YDGSGEOM%GELAM, PHI9 , PHIF9 )
- ENDIF
- ENDIF
-
- IF (GCHETN%LPROFV)&
- & CALL PROFILECHET(YDGEOMETRY,YDSURF,YDDPHY,YDRIP,YDMODEL%YRML_PHY_MF,&
- & KEND,&
- & YDGSGEOM%GELAM,YDGSGEOM%GEMU,&
- & YDGSGEOM%GM,ZMU0,YDOROG%OROG,POROGL,POROGM,YDGSGEOM%RCORI,YDCSGEOM%RATATH,YDCSGEOM%RATATX,&
- & ZVFLSM, ZVVARG, ZVVSAB, ZVFALBF,&
- & ZVFALBSF, ZVFEMISF, ZVVD2, ZVVIVEG,&
- & ZVVLAI, PCT, ZVFZ0F, ZVVZ0H, ZVFZ0RLF,&
- & ZVFGETRL, ZVFVRLAN, ZVFVRLDI, ZVVRSMIN,&
- & ZVFVEG, ZVVHV, ZVASEA, ZVALAN,&
- & ZVASOO, ZVADES, ZVCVC1,&
- & ZT0SP,ZT0SPL,ZT0SPM,&
- & ZT0T,ZT0TL,ZT0TM,&
- & ZPQ,ZPQL,ZPQM,&
- & ZT0U,ZT0V,ZT0VOR,ZT0DIV, ZCVGQ, ZLCVQ,&
- & ZRRT9, ZSBT9, ZRRFC9, ZRRW9,&
- & ZRRIC9, ZSBQ9, ZSBTL9, ZSGF9,&
- & PDIFCQ, PDIFCQI, PDIFCQL, PDIFCS, PDIFTQ, PDIFTQI, PDIFTQL,&
- & PDIFTS, PFCCQL, PFCCQN, PFCSQL, PFCSQN, PFCQNG, PFCQING,&
- & PFCQLNG, PFPLCL, PFPLCN, PFPLSL, PFPLSN, PFRSO, PFRTH,&
- & PSTRCU, PSTRCV, PSTRDU, PSTRDV, PSTRTU, PSTRTV, PSTRMU, PSTRMV,&
- & PFRMH, PFCHOZ, PNEB, PQICE, PQLI, PRH,&
- & PFCS, PFCLL, PFCLN, PFEVL, PFEVN, PFEVV, PFTR, PFLWSP, PFONTE,&
- & PFGEL, PFGELS, PFRSODS, PFRSOPS, PFRSOPT, PFRTHDS,&
- & PQS, PRUISL, PRUISP, PRUISS,&
- & PUCLS, PVCLS, PTCLS, PQCLS, PRHCLS,&
- & PCLCT, PCLCH, PCLCM, PCLCL, PCLCC,&
- & ZFPLCH, ZFPLSH,&
- & ZVHTCCH, ZVHSCCH, ZVHBCCH, ZVHPBLH )
-
- ENDIF
-
-ENDIF
-
-! 2.8 Modification of vertical velocities
-! by some physics output when required.
-! -------------------------------------
-
-IF (LLDIAB.AND.(.NOT.LSIMPH)) THEN
-
- ! * MODIFICATION DE LA VITESSE VERTICALE ET DE LA TENDANCE DE
- ! PRESSION DE SURFACE SI NDPSFI=1 ( MASSE VARIABLE ).
- ! Ajout de la physique dans l'equation de continuite/Add physics
- ! in continuity equation.
-
- IF (NDPSFI == 1) THEN
- IF (LSLAG .AND. LTWOTL) THEN
- CALL CPMVVPS(YDVAB,NPROMA,KST,KEND,NFLEVG,PDTPHY,&
- & ZFP,PRE0(1,NFLEVG),PFEVL,PFEVN,&
- & PCTY0(1,0,YYTCTY0%M_EVEL),PCTY0(1,0,YYTCTY0%M_PSDVBC),PB1(1,MSLB1SP9))
- ELSEIF (LSLAG .AND. (.NOT.LTWOTL)) THEN
- CALL CPMVVPS(YDVAB,NPROMA,KST,KEND,NFLEVG,PDTPHY,&
- & ZFP,PRE9(1,NFLEVG),PFEVL,PFEVN,&
- & PCTY0(1,0,YYTCTY0%M_EVEL),PCTY0(1,0,YYTCTY0%M_PSDVBC),PB1(1,MSLB1SP9))
- ELSE
- CALL CPMVVPS(YDVAB,NPROMA,KST,KEND,NFLEVG,PDTPHY,&
- & ZFP,PRE9(1,NFLEVG),PFEVL,PFEVN,&
- & PCTY0(1,0,YYTCTY0%M_EVEL),PCTY0(1,0,YYTCTY0%M_PSDVBC),ZT1SP)
- ENDIF
- ENDIF
-
-ENDIF
-
-! 2.9 Computation of evolution of T, u, v and Q.
-! ------------------------------------------
-
-! * Calculation of IPGFL, since the old pointers
-! MSLB1[X]9 (=MSLB1GFL9+IP[X]) do not exist any longer in PTRSLB1.
-
-! usefull pointer for new version of cputqy
-
-DO JGFL=1,NUMFLDS
- IF ((YCOMP(JGFL)%MP1 > 0) .AND. (YCOMP(JGFL)%MP_SL1 > 0)) THEN
- IPGFL(YCOMP(JGFL)%MP1) = (YCOMP(JGFL)%MP_SL1-1)*(NFLEVG+2*NFLSUL)
- ENDIF
-ENDDO
-
-! ALARO does not respect the coding rules, tendency of pseudo-TKE is computed in APLPAR and not
-! in CPTEND_NEW. To use the new version of cputqy it is then necessary to write it in GFL tendencies array.
-! This memory transfer is not necessary, please respect coding rules to avoid it.
-
-! Not necessary for intflex: already done in aplpar2intflex
-IF (.NOT.(LINTFLEX.AND.(.NOT.LDCONFX))) THEN
- IF (LPTKE) THEN
- DO JLEV=1,NFLEVG
- DO JROF=KST,KEND
- ZPTENDTKE1(JROF,JLEV) = ZTENDPTKE(JROF,JLEV)
- ENDDO
- ENDDO
- ENDIF
- ! Extra-GFL
- IF(LMDUST.AND.(NGFL_EXT/=0)) THEN
- DO JGFL=1, NGFL_EXT
- DO JLEV=1,NFLEVG
- DO JROF=KST,KEND
- ZTENDGFL(JROF,JLEV,YEXT(JGFL)%MP1) = ZTENDEXT(JROF,JLEV,JGFL)+&! turbulent tendency
- & ZTENDEXT_DEP(JROF,JLEV,JGFL) ! moist tendency
-! moist tendency
-! moist tendency
-! moist tendency
-! moist tendency
-! moist tendency
-! moist tendency
-! moist tendency
-! moist tendency
- ENDDO
- ENDDO
- ENDDO
- ENDIF
-ENDIF
-
-! ky: non-zero option not yet coded for the time being.
-ZTENDD=0.0_JPRB
-
-IF (LLDIAB.AND.(.NOT.LSIMPH).AND.(.NOT.LMPA)) THEN
- ! Calcul de T , Q et du Vent a l'instant 1
-
- CALL CPUTQY(YDGEOMETRY%YRDIMV,YDGMV,YGFL,YDPTRSLB1,YDPHY,NPROMA,KST,KEND,NFLEVG,PDTPHY,IPGFL,&
- & ISLB1T9,ISLB1U9,ISLB1V9,ISLB1VD9,ISLB1GFL9,&
- & ZTENDH, ZTENDT, PTENDU, PTENDV, ZTENDU, ZTENDV, ZTENDD, ZTENDGFL,&
- & PRCP0(1,1,YYTRCP0%M_CP),PXYB0(1,1,YYTXYB0_PHY%M_DELP),ZT0T,ZT0U,ZT0V,&
- & PRCP9(1,1,YYTRCP9%M_CP),PXYB9(1,1,YYTXYB9_PHY%M_DELP),ZT9T,ZT9U,ZT9V,&
- & PB1, PGMVT1, PGFLT1,&
- & PFDIS)
-
-ENDIF
-
-! 2.9a Evolution of precipitation fluxes
-! ------------------------------------------
-
-IF(LNEBN.OR.LNEBR.OR.LRRGUST) THEN
- DO JLEV=1,NFLEVG
- DO JROF=KST,KEND
- ZPCPF1(JROF,JLEV)=ZFPLCH(JROF,JLEV)
- ENDDO
- ENDDO
-ENDIF
-IF(LRRGUST) THEN
- DO JLEV=1,NFLEVG
- DO JROF=KST,KEND
- ZPSPF1(JROF,JLEV)=ZFPLSH(JROF,JLEV)
- ENDDO
- ENDDO
-ENDIF
-
-! 2.9b Prognostic convection etc.
-! --------------------------
-
-! TRANSFER NOT ADVECTED VARIABLES INTO PGFLT1
-IF (LCVPRO.OR.LGPCMT) THEN
- IF (.NOT.YUAL%LADV) THEN
- ZPUAL1(KST:KEND,1:NFLEVG)=ZPUAL(KST:KEND,1:NFLEVG)
- ZPUOM1(KST:KEND,1:NFLEVG)=ZPUOM(KST:KEND,1:NFLEVG)
- ENDIF
- IF (LCDDPRO) THEN
- IF (.NOT.YDAL%LADV) THEN
- ZPDAL1(KST:KEND,1:NFLEVG)=ZPDAL(KST:KEND,1:NFLEVG)
- ZPDOM1(KST:KEND,1:NFLEVG)=ZPDOM(KST:KEND,1:NFLEVG)
- ENDIF
- ENDIF
-ENDIF
-IF (YUNEBH%LACTIVE.AND..NOT.YUNEBH%LADV)THEN
- ZPUNEBH1(KST:KEND,1:NFLEVG)=ZPUNEBH(KST:KEND,1:NFLEVG)
-ENDIF
-IF (YUEN%LACTIVE.AND..NOT.YUEN%LADV) THEN
- ZPUEN1(KST:KEND,1:NFLEVG)=ZPUEN(KST:KEND,1:NFLEVG)
-ENDIF
-IF (YTTE%LACTIVE.AND..NOT.YTTE%LADV) THEN
- ZPTTE1(KST:KEND,1:NFLEVG)=ZPTTE(KST:KEND,1:NFLEVG)
-ENDIF
-IF (YMXL%LACTIVE.AND..NOT.YMXL%LADV) THEN
- ZPMXL1(KST:KEND,1:NFLEVG)=ZPMXL(KST:KEND,1:NFLEVG)
-ENDIF
-IF (YSHTUR%LACTIVE.AND..NOT.YSHTUR%LADV) THEN
- ZPSHTUR1(KST:KEND,1:NFLEVG)=ZPSHTUR(KST:KEND,1:NFLEVG)
-ENDIF
-IF (YFQTUR%LACTIVE.AND..NOT.YFQTUR%LADV) THEN
- ZPFQTUR1(KST:KEND,1:NFLEVG)=ZPFQTUR(KST:KEND,1:NFLEVG)
-ENDIF
-IF (YFSTUR%LACTIVE.AND..NOT.YFSTUR%LADV) THEN
- ZPFSTUR1(KST:KEND,1:NFLEVG)=ZPFSTUR(KST:KEND,1:NFLEVG)
-ENDIF
-IF (YRKTH%LACTIVE)THEN
- ZPRKTH1(KST:KEND,1:NFLEVG)=ZPRKTH(KST:KEND,1:NFLEVG)
-ENDIF
-IF (YRKTQV%LACTIVE)THEN
- ZPRKTQV1(KST:KEND,1:NFLEVG)=ZPRKTQV(KST:KEND,1:NFLEVG)
-ENDIF
-IF (YRKTQC%LACTIVE)THEN
- ZPRKTQC1(KST:KEND,1:NFLEVG)=ZPRKTQC(KST:KEND,1:NFLEVG)
-ENDIF
-
-! 2.10 Surface variables.
-! ------------------
-
-IF (LLDIAB.AND.LMPHYS.AND.(.NOT.LMPA).AND.(.NOT.LSFORCS)) THEN
-
- IF (.NOT.LMSE) THEN
- DO JLEV=0,NFLEVG
- DO JROF=KST,KEND
- ZFPLSN(JROF,JLEV)=PFPLSN(JROF,JLEV)+PFPLSG(JROF,JLEV)
- ENDDO
- ENDDO
- CALL CPTENDS( YDMODEL%YRML_PHY_MF, NPROMA, KST, KEND, NFLEVG, YSP_SBD%NLEVS, PDTPHY,&
- & PFPLCL, PFPLSL, PFPLCN, ZFPLSN,&
- & PFRSO, PFRTH,&
- & ZSGA1,PCT, ZC1, ZC2,&
- & PFCHSP, PFCLL, PFCLN, PFCS,&
- & ZFEVI,PFEVL, PFEVN,&
- & PFEVV, PFGEL, PFGELS, PFLWSP, PFONTE, PFTR,&
- & ZVFLSM, ZSGR1,&
- & PRUISL, PRUISP, PRUISS, ZSGF1, ZVEG,&
- & ZTDTS, ZTDTP, ZTDWS, ZTDWSI, ZTDWP, ZTDWPI, ZTDWL,&
- & ZTDSNS, ZTDALBNS, ZTDRHONS)
-
- CALL CPWTS(YDSURF, YDMODEL%YRML_AOC%YRMCC,YDPHY,YDMODEL%YRML_PHY_MF%YRPHY1, NPROMA, KST,KEND, YSP_SBD%NLEVS, PDTPHY,&
- & ZTDTS, ZTDTP, ZTDWS, ZTDWSI, ZTDWP, ZTDWPI, ZTDWL,&
- & ZTDSNS, ZTDALBNS, ZTDRHONS,&
- & ZVPTPC,ZVPWPC,ZVFLSM,ZVVIVEG,&
- & ZRRT1,ZSBT1,ZRRW1,&
- & ZRRIC1,&
- & ZSBQ1,ZSBTL1,ZRRFC1,&
- & ZSGF1,ZSGA1,ZSGR1)
- ELSE
- IF (LLXFUMSE) THEN
- DO JROF=KST,KEND
- ZRRT0(JROF)=PGPAR(JROF,MVTS)
- ENDDO
- ELSE
- DO JROF=KST,KEND
- ZRRT1(JROF)=PGPAR(JROF,MVTS)
- ENDDO
- ENDIF
- ENDIF
- IF(LNUDG)THEN
-
- ! * Calculation of IPQ since the old pointers
- ! MSLB1[X]9 (=MSLB1GFL9+IP[X]) do not exist any longer in PTRSLB1.
- IPQ=(YQ%MP_SL1-1)*(NFLEVG+2*NFLSUL)
-
- CALL CPNUDG ( NPROMA, KST,KEND, NFNUDG, NFLEVG, IBLK,&
- & XPNUDG,&
- & ZVFNUDM,&
- & ZRRT1,ZRRW1,&
- & ZSBQ1,ZSGF1,&
- & PB1(1,ISLB1T9+1-NFLSA),PB1(1,ISLB1GFL9+IPQ+1-NFLSA),&
- & PB1(1,ISLB1U9+1-NFLSA),PB1(1,ISLB1V9+1-NFLSA),&
- & PB1(1,MSLB1SP9),&
- & ZT0T,ZPQ,ZT0U,&
- & ZT0V,PRE0(1,NFLEVG),YDGSGEOM%GM,ZVFLSM)
- ENDIF
-ENDIF
-
-! 2.11 Evolution of CVV (GY)
-! ---------------------
-
-IF(LCVPGY) THEN
- DO JLEV=1,NFLEVG
- DO JROF=KST,KEND
- ZPCVV1(JROF,JLEV)=ZPCVV(JROF,JLEV)
- ENDDO
- ENDDO
-ENDIF
-
-! -------------------------------------------------------------------
-
-!* 3. Simplified physics.
-! -------------------
-
-! 3.1 Preliminary calculations necessary for simplified physics.
-! ----------------------------------------------------------
-
-IF (LSIMPH) THEN
-
- ! * read grid-point transmission coefficients for simplified physics.
- IF (LRAYSP.AND.LRCOEF.AND.(NSTEP > 1.OR.LTLADDIA)) THEN
- IFIELDSS=NG3SR*NFLEVG
- CALL RDRADCOEF(YDGEOMETRY,YDRCOEF,KST,KEND,KSTGLO,IFIELDSS,ZRADTC,ZAC_HC)
- ENDIF
-
-ENDIF
-
-! 3.2 Simplified physics.
-! -------------------
-
-IF (LSIMPH) THEN
-
- TSPHY = MAX(PDTPHY,1.0_JPRB)
-
- IF (LTWOTL) THEN
-
- CALL APLPASSH (YDPHY,YDMODEL%YRML_PHY_MF%YRPHY1,KST,KEND,NPROMA,NFLEVG,&
- & PRE0,ZPQ,&
- & ZSGF1,ZRRT1,ZRRW1,&
- & ZVFLSM,ZVFVEG,&
- & ZQS1)
-
- IF (.NOT.LLDIAB) THEN
- CALL APLPASSH (YDPHY,YDMODEL%YRML_PHY_MF%YRPHY1,KST,KEND,NPROMA,NFLEVG,&
- & PRE0,ZPQ,&
- & ZSGF0,ZRRT0,ZRRW0,&
- & ZVFLSM,ZVFVEG,&
- & PQS)
- ENDIF
-
- CALL APLPARS(YDGEOMETRY,YDRCOEF,YDMODEL%YRML_PHY_MF,KST,KEND,NPROMA,1,NFLEVG,NTSSG,NSTEP,&
- & PHI0,PRE0,PHIF0,PRE0F,PXYB0(1,1,YYTXYB0_PHY%M_DELP),PXYB0(1,1,YYTXYB0_PHY%M_RDELP),&
- & ZT0U,ZT0V,ZT0T,ZPQ,PRCP0(1,1,YYTRCP0%M_CP),ZCVGQ,&
- & ZSGF0,ZRRT0,PQS,&
- & ZRRT1,ZQS1,&
- & ZVFGETRL,ZVFLSM,&
- & ZVFZ0F,ZVFVRLAN,ZVFVRLDI,&
- & ZVFALBF,ZMU0,YDGSGEOM%GM,&
- & ZAC_HC,ZMCOR,&
- & ZMRAB3C,ZMRAB3N,&
- & ZMRAB4C,ZMRAB4N,&
- & ZMRAB6C,ZMRAB6N,&
- & ZMRAT1C,ZMRAT1N,&
- & ZMRAT2C,ZMRAT2N,&
- & ZMRAT3C,ZMRAT3N,&
- & ZMRAT4C,ZMRAT4N,&
- & ZMRAT5C,ZMRAT5N,&
- & PDIFCQ,PDIFCS,PDIFTQ,PDIFTS,&
- & PFCCQL,PFCCQN,PFCSQL,PFCSQN,&
- & PFPLCL,PFPLCN,PFPLSL,PFPLSN,PFRSO,PFRTH,&
- & PSTRCU,PSTRCV,PSTRDU,PSTRDV,PSTRTU,PSTRTV,&
- & PSTRMU,PSTRMV,PFRMH)
-
- ELSE
-
- CALL APLPASSH (YDPHY,YDMODEL%YRML_PHY_MF%YRPHY1,KST,KEND,NPROMA,NFLEVG,&
- & PRE0,ZPQ,&
- & ZSGF1,ZRRT1,ZRRW1,&
- & ZVFLSM,ZVFVEG,&
- & ZQS1)
-
- IF (.NOT.LLDIAB) THEN
- CALL APLPASSH (YDPHY,YDMODEL%YRML_PHY_MF%YRPHY1,KST,KEND,NPROMA,NFLEVG,&
- & PRE9,ZPQ9,&
- & ZSGF0,ZRRT9,ZRRW9,&
- & ZVFLSM,ZVFVEG,&
- & PQS)
- ENDIF
-
- CALL APLPARS(YDGEOMETRY,YDRCOEF,YDMODEL%YRML_PHY_MF,KST,KEND,NPROMA,1,NFLEVG,NTSSG,NSTEP,&
- & PHI9,PRE9,PHIF9,PRE9F,PXYB9(1,1,YYTXYB9_PHY%M_DELP),PXYB9(1,1,YYTXYB9_PHY%M_RDELP),&
- & ZT9U,ZT9V,ZT9T,ZPQ9,PRCP9(1,1,YYTRCP9%M_CP),ZCVGQ,&
- & ZSGF0,ZRRT9,PQS,&
- & ZRRT1,ZQS1,&
- & ZVFGETRL,ZVFLSM,&
- & ZVFZ0F,ZVFVRLAN,ZVFVRLDI,&
- & ZVFALBF,ZMU0,YDGSGEOM%GM,&
- & ZAC_HC,ZMCOR,&
- & ZMRAB3C,ZMRAB3N,&
- & ZMRAB4C,ZMRAB4N,&
- & ZMRAB6C,ZMRAB6N,&
- & ZMRAT1C,ZMRAT1N,&
- & ZMRAT2C,ZMRAT2N,&
- & ZMRAT3C,ZMRAT3N,&
- & ZMRAT4C,ZMRAT4N,&
- & ZMRAT5C,ZMRAT5N,&
- & PDIFCQ,PDIFCS,PDIFTQ,PDIFTS,&
- & PFCCQL,PFCCQN,PFCSQL,PFCSQN,&
- & PFPLCL,PFPLCN,PFPLSL,PFPLSN,PFRSO,PFRTH,&
- & PSTRCU,PSTRCV,PSTRDU,PSTRDV,PSTRTU,PSTRTV,&
- & PSTRMU,PSTRMV,PFRMH)
-
- ENDIF
-
-ENDIF
-
-! 3.3 Store the model trajectory at t-dt (leap-frog) or t (sl2tl).
-! ------------------------------------------------------------
-
-IF (LTRAJPS) THEN
- IF (LTWOTL) THEN
- PTRAJ_PHYS%PQSSMF(KST:KEND)=PQS(KST:KEND)
- PTRAJ_PHYS%PTSMF(KST:KEND) =ZRRT0(KST:KEND)
- PTRAJ_PHYS%PSNSMF(KST:KEND)=ZSGF0(KST:KEND)
- ELSE
- CALL WRPHTRAJM(YDGEOMETRY,YDSIMPHL,KST,KEND,PTRAJ_PHYS,&
- & ZT9U,ZT9V,ZT9T,&
- & ZPQ9,ZPL9,ZPI9,ZT9SP)
-
- PTRAJ_PHYS%PQSSMF(KST:KEND)=PQS(KST:KEND)
- PTRAJ_PHYS%PTSMF(KST:KEND) =ZRRT9(KST:KEND)
- PTRAJ_PHYS%PSNSMF(KST:KEND)=ZSGF9(KST:KEND)
- ENDIF
- IF (LPRTTRAJ.AND.PTRAJ_PHYS%LASTCHUNK) WRITE(NULOUT,*)'GREPTRAJ STORE TRAJ_PHYS in MF_PHYS'
-ENDIF
-
-! 3.4 Computation of tendencies T,u,v and Q.
-! --------------------------------------
-
-IF (LSIMPH) THEN
-
- TSPHY = MAX(PDTPHY,1.0_JPRB)
-
- IF (LTWOTL) THEN
- CALL CPTENDSM (YDPHY,NPROMA,KST,KEND,NFLEVG,&
- & PDIFCQ,PDIFCS,PDIFTQ,PDIFTS,&
- & PFCCQL,PFCCQN,PFCSQL,PFCSQN,&
- & PFPLCL,PFPLCN,PFPLSL,PFPLSN,&
- & PFRSO,PFRTH,&
- & PSTRCU,PSTRCV,PSTRDU,PSTRDV,&
- & PSTRTU,PSTRTV,&
- & PSTRMU,PSTRMV,PFRMH,&
- & PXYB0(1,1,YYTXYB0_PHY%M_RDELP),PHIF0,&
- & ZT0U,ZT0V,ZT0T,ZPQ,&
- & PQS,ZRRT0,YDOROG%OROG,&
- & PTENDU,PTENDV,ZTENDH,ZTENDQ,&
- & PFHPCL,PFHPCN,PFHPSL,PFHPSN,&
- & PFHSCL,PFHSCN,PFHSSL,PFHSSN)
- ELSE
- CALL CPTENDSM (YDPHY,NPROMA,KST,KEND,NFLEVG,&
- & PDIFCQ,PDIFCS,PDIFTQ,PDIFTS,&
- & PFCCQL,PFCCQN,PFCSQL,PFCSQN,&
- & PFPLCL,PFPLCN,PFPLSL,PFPLSN,&
- & PFRSO,PFRTH,&
- & PSTRCU,PSTRCV,PSTRDU,PSTRDV,&
- & PSTRTU,PSTRTV,&
- & PSTRMU,PSTRMV,PFRMH,&
- & PXYB9(1,1,YYTXYB9_PHY%M_RDELP),PHIF9,&
- & ZT9U,ZT9V,ZT9T,ZPQ9,&
- & PQS,ZRRT9,YDOROG%OROG,&
- & PTENDU,PTENDV,ZTENDH,ZTENDQ,&
- & PFHPCL,PFHPCN,PFHPSL,PFHPSN,&
- & PFHSCL,PFHSCN,PFHSSL,PFHSSN)
- ENDIF
-
-ENDIF
-
-! 3.5 Computation of evolution of T, u, v and Q.
-! ------------------------------------------
-
-IF (LSIMPH) THEN
-
- CALL CPUTQYS(YDGEOMETRY%YRDIMV,YDGMV,YGFL,YDPTRSLB1,&
- & YDSTOPH, YDPHY2, &
- & NPROMA,KST,KEND,NFLEVG,PDTPHY,IPGFL,&
- & ISLB1U9,ISLB1V9,ISLB1T9,ISLB1GFL9,&
- & ZTENDH, ZTENDQ, PTENDU, PTENDV,&
- & PFORCEU, PFORCEV, PFORCET, PFORCEQ, &
- & PRCP0(1,1,YYTRCP0%M_CP),PXYB0(1,1,YYTXYB0_PHY%M_DELP),ZT0T,ZT0U,ZT0V,&
- & PRCP9(1,1,YYTRCP9%M_CP),PXYB9(1,1,YYTXYB9_PHY%M_DELP),ZT9T,ZT9U,ZT9V,&
- & PB1, PGMVT1, PGFLT1,&
- & PFDIS)
-
-ENDIF
-
-! ------------------------------------------------------------------
-
-!* 4. AROME physics.
-! ---------------
-
-IF (LMPA) THEN
-
- ! 4.1 CALL APL_AROME
- ! --------------
-
- IPTR(:) = 0 ! means no fields defined in ZGFLTENDR at start ; > 0 means defined.
-
- ! * ZTENDR
- IRR=1
- IPTR_CONT = IRR
- IF (YQ%LACTIVE) THEN
- IPTR(YQ%MP1) = IPTR_CONT ; IPTR_CONT = IPTR_CONT+1
- ENDIF
- IF (YL%LACTIVE) THEN
- IPTR(YL%MP1) = IPTR_CONT ; IPTR_CONT = IPTR_CONT+1
- ENDIF
- IF (YR%LACTIVE) THEN
- IPTR(YR%MP1) = IPTR_CONT ; IPTR_CONT = IPTR_CONT+1
- ENDIF
- IF (YI%LACTIVE) THEN
- IPTR(YI%MP1) = IPTR_CONT ; IPTR_CONT = IPTR_CONT+1
- ENDIF
- IF (YS%LACTIVE) THEN
- IPTR(YS%MP1) = IPTR_CONT ; IPTR_CONT = IPTR_CONT+1
- ENDIF
- IF (YG%LACTIVE) THEN
- IPTR(YG%MP1) = IPTR_CONT ; IPTR_CONT = IPTR_CONT+1
- ENDIF
- IF (YH%LACTIVE) THEN
- IPTR(YH%MP1) = IPTR_CONT ; IPTR_CONT = IPTR_CONT+1
- ENDIF
-
- ! * ZTENDTKE
- IF (YTKE%LACTIVE) THEN
- IPTR(YTKE%MP1) = IPTR_CONT ; IPTR_CONT = IPTR_CONT+1
- IPTRTKE=IPTR(YTKE%MP1)
- ELSE
- IPTRTKE=0
- ENDIF
- ! * ZTENDEFB1 ZTENDEFB2 ZTENDEFB3
- IF (YEFB1%LACTIVE) THEN
- IPTR(YEFB1%MP1) = IPTR_CONT ; IPTR_CONT = IPTR_CONT+1
- IEFB1 = IPTR(YEFB1%MP1)
- ELSE
- IEFB1 = 0
- ENDIF
- IF (YEFB2%LACTIVE) THEN
- IPTR(YEFB2%MP1) = IPTR_CONT ; IPTR_CONT = IPTR_CONT+1
- IEFB2 = IPTR(YEFB2%MP1)
- ELSE
- IEFB2 = 0
- ENDIF
- IF (YEFB3%LACTIVE) THEN
- IPTR(YEFB3%MP1) = IPTR_CONT ; IPTR_CONT = IPTR_CONT+1
- IEFB3 = IPTR(YEFB3%MP1)
- ELSE
- IEFB3 = 0
- ENDIF
-
- ! * ZTENDEXT
- IF (NGFL_EXT > 0) THEN
- DO JGFL=1,NGFL_EXT
- IF (YEXT(JGFL)%LACTIVE) THEN
- IPTR(YEXT(JGFL)%MP1)=IPTR_CONT
- IPTR_CONT = IPTR_CONT+1
- ENDIF
- ENDDO
- IPTREXT=IPTR(YEXT(1)%MP1)
- ELSE
- IPTREXT=0
- ENDIF
-
- ! * LIMA
- IF (NLIMA > 0) THEN
- DO JGFL=1,NLIMA
- IF (YLIMA(JGFL)%LACTIVE) THEN
- IPTR(YLIMA(JGFL)%MP1)=IPTR_CONT
- IPTR_CONT = IPTR_CONT+1
- ENDIF
- ENDDO
- IPTRLIMA=IPTR(YLIMA(1)%MP1)
- ELSE
- IPTRLIMA=0
- ENDIF
-
-
- ! If an incorrect address is used, then the initialization below will detect it :
- ZTENDGFLR(:,:,0)=HUGE(1._JPRB)
-
- IF (LMFSHAL .AND. CMF_UPDRAFT=='DUAL') THEN
- IMAXDRAFT=3
- ELSE
- IMAXDRAFT=0
- ENDIF
-
- IF(LTWOTL) THEN
- CALL APL_AROME(YDGEOMETRY,YDSURF,YDCFU,YDXFU,YDMODEL, KBL, KGPCOMP, KST , KEND , NPROMA ,&
- & 1 , NFLEVG , NSTEP ,&
- & IMAXDRAFT, NTSSG, YDCFU%NFRRC, PDTPHY, LLXFUMSE,YDCSGEOM%RINDX,YDCSGEOM%RINDY,&
- & YDGSGEOM%GEMU,YDGSGEOM%GELAM,YDOROG%OROG,YDGSGEOM%GM,&
- & ZMU0,ZMU0LU,ZMU0M,ZMU0N,&
- & YDGSGEOM%GECLO,YDGSGEOM%GESLO,ZVCVC1,ZVFLSM,&
- & ZVASEA , ZVALAN ,ZVASOO , ZVADES ,&
- & ZVASUL , ZVAVOL ,&
- & PGP2DSDT, ZGP2DSPP, &
- & PHI0,PHIF0,PREPHY0,PREPHY0F,PXYB0(1,1,YYTXYB0_PHY%M_RDELP),PXYB0(1,1,YYTXYB0_PHY%M_DELP),&
- & ZT0T,ZPQ,&
- & PRCP0(1,1,YYTRCP0%M_CP),PRCP0(1,1,YYTRCP0%M_R),PXYB0(1,1,YYTXYB0_PHY%M_ALPH),PXYB0(1,1,YYTXYB0_PHY%M_LNPR),&
- & ZPL,ZPI,ZPR,ZPS,&
- & ZPG,ZPH,ZP1LIMA,ZPTKE,&
- & ZPEFB1,ZPEFB2,ZPEFB3,&
- & ZPSRC,ZP1EXT,&
- & ZT0U,ZT0V, PWT0,ZEDR,&
- & PFORCEU,PFORCEV,PFORCET,PFORCEQ,&
- & PGPAR,PEMTD,PEMTU,PTRSW,&
- & PGDEOSI,PGUEOSI,PGMU0,PGMU0_MIN,PGMU0_MAX,&
- & PGDEOTI,PGDEOTI2,PGUEOTI,PGUEOTI2,PGEOLT,PGEOXT,&
- & PGRPROX,PGMIXP,PGFLUXC,PGRSURF,&
- & PGRADH_PHY,&
- ! outputs
- & ZPLRAD1,ZPIRAD1,PRH,ZPA1,ZPSRC1,&
- & ZTENDT, ZTENDGFLR(1,1,IRR), PTENDU, PTENDV,ZTENDW, ZTENDGFLR(1,1,IPTRLIMA), ZTENDGFLR(1,1,IPTRTKE),&
- & ZTENDGFLR(1,1,IEFB1),ZTENDGFLR(1,1,IEFB2),ZTENDGFLR(1,1,IEFB3),&
- & ZTENDGFLR(1,1,IPTREXT),&
- & PFRTH, PFRSO, PFRTHDS, PFRSODS, PFRSOPS, PFRSDNI, PFRSOPT, PFRTHC, PFRSOC,&
- & ZVFALBF, ZVFEMISF,ZP1EZDIAG,&
- & PCLCH,PCLCL,PCLCM,PCLCT,PFPLSL,PFPLSN,PFPLSG,PFPLSHL,PSTRTU,PSTRTV,&
- & PFCS,PFCLL,PFCLN,PUCLS,PVCLS,PNUCLS,PNVCLS,PTCLS,PQCLS,PRHCLS,PUGST,PVGST,&
- & PFEVL,PFEVN,PCLPH,ZSGF1,ZSGR1,ZVDSUND,&
- & PDIAGH,PFLASH,ZSFOSFO1,PTPWCLS, ZDPRECIPS, ZDPRECIPS2,&
- & PVISICLD, PVISIHYDRO, PMXCLWC,YLPROCSET,YDDDH )
- ELSE
- CALL APL_AROME(YDGEOMETRY,YDSURF,YDCFU,YDXFU,YDMODEL, KBL, KGPCOMP, KST , KEND , NPROMA ,&
- & 1 , NFLEVG , NSTEP ,&
- & IMAXDRAFT, NTSSG, YDCFU%NFRRC, PDTPHY, LLXFUMSE,YDCSGEOM%RINDX,YDCSGEOM%RINDY,&
- & YDGSGEOM%GEMU,YDGSGEOM%GELAM,YDOROG%OROG,YDGSGEOM%GM,&
- & ZMU0,ZMU0LU,ZMU0M,ZMU0N,&
- & YDGSGEOM%GECLO,YDGSGEOM%GESLO,ZVCVC1,ZVFLSM,&
- & ZVASEA , ZVALAN ,ZVASOO , ZVADES ,&
- & ZVASUL , ZVAVOL ,&
- & PGP2DSDT, ZGP2DSPP, &
- & PHI9,PHIF9,PREPHY9,PREPHY9F,PXYB9(1,1,YYTXYB9_PHY%M_RDELP),PXYB9(1,1,YYTXYB9_PHY%M_DELP),&
- & ZT9T,ZPQ9,&
- & PRCP9(1,1,YYTRCP9%M_CP),PRCP9(1,1,YYTRCP9%M_R),PXYB9(1,1,YYTXYB9_PHY%M_ALPH),PXYB9(1,1,YYTXYB9_PHY%M_LNPR),&
- & ZPL9,ZPI9,ZPR9,ZPS9,&
- & ZPG9,ZPH9,ZP1LIMA9,ZPTKE9,&
- & ZPEFB19,ZPEFB29,ZPEFB39,&
- & ZPSRC9,ZP1EXT9,&
- & ZT9U,ZT9V, PWT9,ZEDR ,&
- & PFORCEU,PFORCEV,PFORCET,PFORCEQ,&
- & PGPAR,PEMTD,PEMTU,PTRSW,&
- & PGDEOSI,PGUEOSI,PGMU0,PGMU0_MIN,PGMU0_MAX,&
- & PGDEOTI,PGDEOTI2,PGUEOTI,PGUEOTI2,PGEOLT,PGEOXT,&
- & PGRPROX,PGMIXP,PGFLUXC,PGRSURF,&
- & PGRADH_PHY,&
- ! outputs
- & ZPLRAD1,ZPIRAD1,PRH,ZPA1,ZPSRC1,&
- & ZTENDT, ZTENDGFLR(1,1,IRR), PTENDU, PTENDV,ZTENDW, ZTENDGFLR(1,1,IPTRLIMA), ZTENDGFLR(1,1,IPTRTKE),&
- & ZTENDGFLR(1,1,IEFB1),ZTENDGFLR(1,1,IEFB2),ZTENDGFLR(1,1,IEFB3),&
- & ZTENDGFLR(1,1,IPTREXT),&
- & PFRTH, PFRSO, PFRTHDS, PFRSODS, PFRSOPS, PFRSDNI, PFRSOPT, PFRTHC, PFRSOC,&
- & ZVFALBF, ZVFEMISF,ZP1EZDIAG,&
- & PCLCH,PCLCL,PCLCM,PCLCT,PFPLSL,PFPLSN,PFPLSG,PFPLSHL,PSTRTU,PSTRTV,&
- & PFCS,PFCLL,PFCLN,PUCLS,PVCLS,PNUCLS,PNVCLS,PTCLS,PQCLS,PRHCLS,PUGST,PVGST,&
- & PFEVL,PFEVN,PCLPH,ZSGF1,ZSGR1,ZVDSUND,&
- & PDIAGH,PFLASH,ZSFOSFO1, PTPWCLS, ZDPRECIPS, ZDPRECIPS2,&
- & PVISICLD, PVISIHYDRO, PMXCLWC,YLPROCSET,YDDDH )
- ENDIF
- !Save surface temperature
- IF (LMSE.OR.LSFORCS) THEN
- IF (LLXFUMSE) THEN
- DO JROF=KST,KEND
- ZRRT0(JROF)=PGPAR(JROF,MVTS)
- ENDDO
- ELSE
- DO JROF=KST,KEND
- ZRRT1(JROF)=PGPAR(JROF,MVTS)
- ENDDO
- ENDIF
- ENDIF
- ! 4.2 COMPUTE THE PHYS. TENDENCY FOR "T" AND "w"
- ! ------------------------------------------
-
-
- IF (LVERTFE.AND.LVFE_GWMPA) THEN
- ! * case LVFE_GWMPA not yet coded.
- ! (in this case ZGWT1 must be computed at full levels and
- ! not at half levels)
- CALL ABOR1(' MF_PHYS: case LVFE_GWMPA not yet coded if LMPA=T!')
- ENDIF
-
- ZDT = PDTPHY
-
- ZTENDD=0.0_JPRB
-
- ! * compute ZTT1:
- IF (LSLAG.AND.LTWOTL) THEN
- DO JLEV=1,NFLEVG
- DO JROF=KST,KEND
- ZTT1(JROF,JLEV)=ZT0T(JROF,JLEV)+ZDT*ZTENDT(JROF,JLEV)
- ENDDO
- ENDDO
- ELSE
- DO JLEV=1,NFLEVG
- DO JROF=KST,KEND
- ZTT1(JROF,JLEV)=ZT9T(JROF,JLEV)+ZDT*ZTENDT(JROF,JLEV)
- ENDDO
- ENDDO
- ENDIF
-
- ! * compute ZGWT1 = tendency of gw:
- IF (LNHDYN) THEN
- ! Valid for LVFE_GWMPA=F only; ZGWT1 assumed to be half level values.
- DO JLEV=1,NFLEVG-1
- DO JROF=KST,KEND
- ZGWT1(JROF,JLEV)=0.5_JPRB*RG*(ZTENDW(JROF,JLEV)+ZTENDW(JROF,JLEV+1))
- ENDDO
- ENDDO
- DO JROF=KST,KEND
- ZGWT1(JROF,NFLEVG)=0.0_JPRB
- ZGWT1(JROF,0)=0.0_JPRB
- ENDDO
- ENDIF
-
- ! * convert gw tendency in d tendency:
- IF(LNHDYN) THEN
-
- IF (LGWADV) THEN
- ZTENDD(KST:KEND,1:NFLEVG)=ZGWT1(KST:KEND,1:NFLEVG)
- ELSE
-
- ! * Provide the appropriate version of (RT) at t+dt for GNHGW2SVDAROME:
- IF (L_RDRY_VD) THEN
- ! Use Rd because "dver" is currently defined with Rd.
- ZRTT1(KST:KEND,1:NFLEVG)=RD*ZTT1(KST:KEND,1:NFLEVG)
- ELSE
- ! Use "moist R" because "dver" is defined with "moist R".
- ! Unfortunately, R(t+dt) is not yet available there, use R(t) instead.
- ! "Moist R" tendency is neglected in the below call to GNHGW2SVDAROME.
- DO JLEV=1,NFLEVG
- DO JROF=KST,KEND
- ZRTT1(JROF,JLEV)=PRCP0(JROF,JLEV,YYTRCP0%M_R)*ZTT1(JROF,JLEV)
- ENDDO
- ENDDO
- ENDIF
-
- ! * Do conversion:
- IF (LSLAG.AND.LTWOTL) THEN
- CALL GNHGW2SVDAROME(YDGEOMETRY,KST,KEND,PRE0F,PXYB0(1,1,YYTXYB0_PHY%M_LNPR),ZRTT1,PREPHY0F,ZGWT1,&
- & ZTENDD)
- ELSE
- CALL GNHGW2SVDAROME(YDGEOMETRY,KST,KEND,PRE9F,PXYB9(1,1,YYTXYB9_PHY%M_LNPR),ZRTT1,PREPHY9F,ZGWT1,&
- & ZTENDD)
- ENDIF
-
- ENDIF
- ELSE
- ZTENDD=0.0_JPRB
- ENDIF
-
- ! 4.3 PUT THE TENDENCIES IN PB1/GFLT1/GMVT1.
- ! --------------------------------------
-
-
- IF ( LINTFLEX ) THEN
- IF (LTWOTL) THEN
- CALL CPTEND_FLEX( YDLDDH,YDMDDH,YGFL,YDPHY,NPROMA, KST, KEND, NFLEVG,YDGSGEOM%GNORDL,YDGSGEOM%GNORDM,&
- & PXYB0(1,1,YYTXYB0_PHY%M_DELP) ,&
- & PXYB0(1,1,YYTXYB0_PHY%M_RDELP), PRCP0(1,1,YYTRCP0%M_CP),&
- & ZT0U,ZT0V,ZT0T,ZRRT0,&
- & PGFL,&
- & YLPROCSET,&
- & PTENDU , PTENDV , ZTENDH , ZTENDGFL,&
- & PFHSCL ,PFHSCN,PFHSSL,PFHSSN,&
- & PFHPCL ,PFHPCN,PFHPSL,PFHPSN,&
- & ZFHP ,ZFP , PFEPFP, PFCMPCQ, PFCMPSN, PFCMPSL,YDDDH )
- ELSE
- CALL CPTEND_FLEX( YDLDDH,YDMDDH,YGFL,YDPHY,NPROMA, KST, KEND, NFLEVG,YDGSGEOM%GNORDL,YDGSGEOM%GNORDM,&
- & PXYB9(1,1,YYTXYB9_PHY%M_DELP) ,&
- & PXYB9(1,1,YYTXYB9_PHY%M_RDELP), PRCP9(1,1,YYTRCP9%M_CP),&
- & ZT9U,ZT9V,ZT9T,ZRRT9,&
- & PGFL,&
- & YLPROCSET,&
- & PTENDU , PTENDV , ZTENDH , ZTENDGFL,&
- & PFHSCL ,PFHSCN,PFHSSL,PFHSSN,&
- & PFHPCL ,PFHPCN,PFHPSL,PFHPSN,&
- & ZFHP ,ZFP , PFEPFP, PFCMPCQ, PFCMPSN, PFCMPSL,YDDDH )
- ENDIF
-
- CALL CPUTQY(YDGEOMETRY%YRDIMV,YDGMV,YGFL,YDPTRSLB1,YDPHY,NPROMA,KST,KEND,NFLEVG,PDTPHY,IPGFL,&
- & ISLB1T9,ISLB1U9,ISLB1V9,ISLB1VD9,ISLB1GFL9,&
- & ZTENDH, ZTENDT, PTENDU, PTENDV, ZTENDU, ZTENDV, ZTENDD, ZTENDGFL,&
- & PRCP0(1,1,YYTRCP0%M_CP),PXYB0(1,1,YYTXYB0_PHY%M_DELP),ZT0T,ZT0U,ZT0V,&
- & PRCP9(1,1,YYTRCP9%M_CP),PXYB9(1,1,YYTXYB9_PHY%M_DELP),ZT9T,ZT9U,ZT9V,&
- & PB1, PGMVT1, PGFLT1,&
- & PFDIS)
-
- ELSE
-
- ! start ZTENDGFLR at 1 because it is dimensionned (:,:,0:n)
- CALL CPUTQY_AROME(YDGEOMETRY%YRDIMV,YDGMV,YGFL,YDPTRSLB1,NPROMA,KST,KEND,NFLEVG,ZDT,IPGFL,IPTR,&
- & ISLB1U9,ISLB1V9,ISLB1T9,ISLB1GFL9,ISLB1VD9 ,&
- & ZTENDT, ZTENDGFLR(:,:,1), PTENDU, PTENDV, ZTENDD ,&
- & PB1, PGMVT1, PGFLT1)
- ENDIF
-
-ENDIF
-
-! ------------------------------------------------------------------
-
-!* 5. Final calculations.
-! -------------------
-
-! * Restore the initial value of some pseudo-historical surface buffers
-! if relevant.
-IF (LL_SAVE_PHSURF) THEN
- IF(YSD_VV%YHV%LSET) ZVVHV(1:NPROMA)=ZHV(1:NPROMA)
- IF(YSD_VF%YZ0F%LSET) ZVFZ0F(1:NPROMA)=ZGZ0F(1:NPROMA)
- IF(YSD_VV%YZ0H%LSET) ZVVZ0H(1:NPROMA)=ZGZ0HF(1:NPROMA)
- IF(YSD_VH%YPBLH%LSET) ZVHPBLH(1:NPROMA)=ZPBLH(1:NPROMA)
- IF(YSD_VH%YSPSH%LSET) ZVHSPSH(1:NPROMA)=ZFHPS(1:NPROMA)
- IF(YSD_VH%YQSH%LSET) ZVHQSH(1:NPROMA)=ZQSH(1:NPROMA)
- IF(YSD_VK%YUDGRO%LSET) ZVKUDGRO(1:NPROMA)=ZUDGRO(1:NPROMA)
- IF(LCVPRO.OR.LGPCMT) THEN
- ZPUAL(:,:)=ZUDAL(:,:)
- ZPUOM(:,:)=ZUDOM(:,:)
- IF(LCDDPRO) THEN
- ZPDAL(:,:)=ZDDAL(:,:)
- ZPDOM(:,:)=ZDDOM(:,:)
- ENDIF
- ENDIF
- IF(YUNEBH%LACTIVE) ZPUNEBH(:,:)=ZUNEBH(:,:)
- IF(YUEN%LACTIVE) ZPUEN(:,:)=ZENTCH(:,:)
-ENDIF
-
-! Store horizontal exchange coefficients (3D turbulence) to SL2 buffers
-IF (L3DTURB) THEN
- DO JLEV=1,NFLEVG
- PB2(KST:KEND,MSLB2KAPPAM+JLEV-1)=ZKUROV_H(KST:KEND,JLEV)
- PB2(KST:KEND,MSLB2KAPPAH+JLEV-1)=ZKTROV_H(KST:KEND,JLEV)
- ENDDO
-ENDIF
-
-!--------------------------------------------------------------------
-! BAYRAD
-! Fill convective hydrometeors mixing ratio in GFL
-!--------------------------------------------------------------------
-IF((.NOT.LGPCMT).AND.(.NOT.LAROME)) THEN
- IF(YRCONV%LACTIVE) THEN
- ZPRCONV1(:,:) = ZQRCONV(:,:)
- ENDIF
- IF(YSCONV%LACTIVE) THEN
- ZPSCONV1(:,:) = ZQSCONV(:,:)
- ENDIF
-ENDIF
-
-
-
-!-------------------------------------------------
-! Extract Single Column Model profiles from 3D run or
-! write LFA file for MUSC (1D model)
-!-------------------------------------------------
-IF(LGSCM.OR.LMUSCLFA) THEN
- IF (LAROME) THEN
- DO JLEV=1,NFLEVG
- DO JROF=KST,KEND
- PNEB(JROF,JLEV)=ZPA1(JROF,JLEV)
- ENDDO
- ENDDO
- ENDIF
- CALL WRITEPHYSIO(YDGEOMETRY,YDSURF,YDDPHY,YDRIP,YDMODEL%YRML_PHY_MF,&
- & KEND,&
- & KST, KGL1, KGL2, KSTGLO,&
- & NSTEP , NTSSG , YSP_SBD%NLEVS ,&
- & YDGSGEOM%GELAM,YDGSGEOM%GEMU,&
- & YDGSGEOM%GM, ZMU0,YDOROG%OROG,POROGL,POROGM,YDGSGEOM%RCORI,YDCSGEOM%RATATH,YDCSGEOM%RATATX,&
- & PHI0 , PRE0 , PHIF0 , PRE0F , PXYB0(1,1,YYTXYB0_PHY%M_ALPH), PXYB0(1,1,YYTXYB0_PHY%M_DELP),&
- & PXYB0(1,1,YYTXYB0_PHY%M_LNPR), PXYB0(1,1,YYTXYB0_PHY%M_RDELP),&
- & ZVFLSM, ZVVARG, ZVVSAB,&
- & ZVVD2, ZVVIVEG, ZVVLAI, PCT,&
- & ZVVALV, PALBDG, ZVFALBF, ZVFALBSF, ZSGT1,&
- & ZVFEMISF,&
- & ZVFZ0F, ZVVZ0H, ZVFZ0RLF,&
- & ZVFGETRL, ZVFVRLAN, ZVFVRLDI, ZVVRSMIN,&
- & ZVFVEG, ZVVHV, ZVASEA, ZVALAN,&
- & ZVASOO, ZVADES, ZVCVC1,&
- & ZT0SP,ZT0SPL,ZT0SPM,&
- & ZT0T,ZT0TL,ZT0TM,&
- & ZPQ,ZPQL,ZPQM,&
- & ZPI,ZPL, ZPS,ZPR,ZPG,ZPTKE,&
- & ZPEFB1,ZPEFB2,ZPEFB3,&
- & PRCP0(1,1,YYTRCP0%M_CP), PRCP0(1,1,YYTRCP0%M_R),&
- & ZT0U,ZT0V,ZT0VOR,ZT0DIV, ZCVGQ, ZLCVQ,&
- & ZRRT9, ZSBT9, ZRRFC9, ZRRW9,&
- & ZRRIC9, ZSBQ9, ZSBTL9, ZSGF9,&
- & ZSGA0, ZSGR0, PCTY0(1,1,YYTCTY0%M_VVEL),&
- & PEMTD , PEMTU ,PTRSW ,YDGSGEOM%GECLO,YDGSGEOM%GESLO,&
- & PDIFCQ, PDIFCQI, PDIFCQL, PDIFCS, PDIFTQ, PDIFTQI, PDIFTQL,&
- & PDIFTS, PFCCQL, PFCCQN, PFCSQL, PFCSQN, PFCQNG, PFCQING,&
- & PFCQLNG, PFCQRNG, PFCQSNG, PFPLCL, PFPLCN, PFPLSL, PFPLSN, PFPLSG, PFPLSHL,&
- & PFPFPSL, PFPFPSN, PFPFPCL, PFPFPCN, PFPEVPSL,PFPEVPSN,PFPEVPCL, PFPEVPCN,&
- & ZFTKE, ZFEFB1, ZFEFB2, ZFEFB3, PFRSO, PFRSOC, PFRTH, PFRTHC, PFRSOLU,&
- & PSTRCU, PSTRCV, PSTRDU, PSTRDV, PSTRTU, PSTRTV, PSTRMU, PSTRMV,&
- & PFRMH, ZFRMQ, PFCHOZ, PNEB, PQICE, PQLI, PRH,&
- & PFCS, PFCLL, PFCLN, PFEVL, PFEVN, ZFEVI, PFEVV, PFTR, PFLWSP, PFONTE,&
- & PFGEL, PFGELS, PFCHSP, PFRSODS, PFRSOPS, PFRSOPT, PFRTHDS,&
- & ZCD, ZCDN, ZCH, ZC1, ZC2, ZEMIS, PGZ0 , PGZ0H , ZNEIJ , ZVEG,&
- & ZCPS, ZLHS, ZRS, ZLH, ZLSCPE, ZQSAT, ZQW, ZTW,&
- & PQS, ZQSATS, PRUISL, PRUISP, PRUISS,&
- & PUCLS, PVCLS, PTCLS, PQCLS, PRHCLS,&
- & PCLCT, PCLCH, PCLCM, PCLCL, PCLCC,&
- & PCAPE , PCTOP, ICLPH , PCLPH , PUGST , PVGST,&
- & ZFPLCH, ZFPLSH,&
- & ZVHTCCH, ZVHSCCH, ZVHBCCH, ZVHPBLH )
-ENDIF
-
-IF (LEDR) THEN
- ZDIXEDR(:,:)=ZEDR(:,:)
-ENDIF
-
-IF (LDPRECIPS) THEN
- PSD_XP(KST:KEND,NDTPRECCUR,YSD_XP%YPRECIP%MP)=ZDPRECIPS(KST:KEND,NDTPRECCUR)
-ENDIF
-
-IF (LDPRECIPS2) THEN
- PSD_XP2(KST:KEND,NDTPRECCUR2,YSD_XP2%YPRECIP2%MP)=ZDPRECIPS2(KST:KEND,NDTPRECCUR2)
-ENDIF
-
-! Restore Tt and grad(Tt) for NHQE model.
-IF (LNHQE) THEN
- ! At instant t (with the derivatives):
- DO JLEV=1,NFLEVG
- DO JROF=KST,KEND
- ZT0T(JROF,JLEV)=ZTT0_SAVE(JROF,JLEV)
- ZT0TL(JROF,JLEV)=ZTT0L_SAVE(JROF,JLEV)
- ZT0TM(JROF,JLEV)=ZTT0M_SAVE(JROF,JLEV)
- ENDDO
- ENDDO
- ! At instant t-dt for leap-frog advections (without the derivatives):
- IF (.NOT.LTWOTL) THEN
- DO JLEV=1,NFLEVG
- DO JROF=KST,KEND
- ZT9T(JROF,JLEV)=ZTT9_SAVE(JROF,JLEV)
- ENDDO
- ENDDO
- ENDIF
-ENDIF
-
-! ------------------------------------------------------------------
-
-! 6. destructor for procset
-IF (LINTFLEX) CALL CLEANINTPROCSET(YLPROCSET)
-
-! ------------------------------------------------------------------
-
-END ASSOCIATE
-END ASSOCIATE
-IF (LHOOK) CALL DR_HOOK('MF_PHYS',1,ZHOOK_HANDLE)
-END SUBROUTINE MF_PHYS
diff --git a/src/arome/modset_Ryad/arpifs/programs/master.F90 b/src/arome/modset_Ryad/arpifs/programs/master.F90
deleted file mode 100644
index ba909e5177a9387c5ee4e78ded824b953c9be963..0000000000000000000000000000000000000000
--- a/src/arome/modset_Ryad/arpifs/programs/master.F90
+++ /dev/null
@@ -1,287 +0,0 @@
-PROGRAM MASTER
-
-USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY : STDOUT=>OUTPUT_UNIT
-#ifdef WITH_FCKIT
-USE FCKIT_MODULE, ONLY : FCKIT_MAIN, FCKIT_LOG, FCKIT_EXCEPTION, FCKIT_EXCEPTION_HANDLER
-#endif
-USE PARKIND1 ,ONLY : JPIM, JPIB, JPRB, JPRD
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE MPL_MODULE ,ONLY : MPL_END
-USE OML_MOD ,ONLY : OML_MAX_THREADS
-USE STACK_MIX ,ONLY : INIT_STACK
-USE YOMIO_SERV ,ONLY : IO_SERV_C001
-USE YOMFP_SERV ,ONLY : FP_SERV_C001
-#ifdef RS6K
-USE YOMERRTRAP ,ONLY : SET_ERR_TRAP
-#endif
-USE MPL_MPIF, ONLY : MPI_COMM_WORLD, MPI_THREAD_MULTIPLE, MPI_THREAD_SINGLE, MPI_WTIME
-USE MPL_MODULE, ONLY : LMPLUSERCOMM, MPLUSERCOMM, LTHSAFEMPI, LINITMPI_VIA_MPL
-#if defined WITH_OASIS || defined WITH_NEMO
-USE COUPLING
-#endif
-#ifdef __INTEL_COMPILER
-USE IFPORT, ONLY : GETPID
-#endif
-IMPLICIT NONE
-
-! P. Marguinaud : 01-Jan-2001 : Support for IO server
-! R. El Khatib : 22-Mar-2011 : conditional support for IBM high perf monitoring
-! P. Marguinaud : 10-Oct-2013 : Change IO server init & exit routines
-! F. Suzat : 14-Avr-2020 : print pid in output file
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-LOGICAL :: LLHOOK_SAVE
-INTEGER (KIND=JPIM) :: ICOMM_IFS_PLUS_IFS_IO_SERV
-INTEGER (KIND=JPIM) :: ICOMM_IFS_PLUS_NEMO_IO_SERV
-
-LOGICAL :: LLINIT, LLSERV, LLCOUPACTIVE, LLMPI1, LLSTARTUPCOST
-INTEGER :: IERR, ICOL, INUM, IREQUIRED,IPROVIDED,IME
-
-#ifdef RS6K
-INTEGER(KIND=JPIB) :: IRTC,JI
-#endif
-LOGICAL :: LLNEMOIO, LLNEMOIOSERVER
-CHARACTER(LEN=512) :: CLIOSERV_LOGFILE
-#ifdef WITH_FCKIT
-PROCEDURE(FCKIT_EXCEPTION_HANDLER), POINTER :: FUNPTR
-#endif
-INTEGER(KIND=JPIM) :: IER
-CHARACTER(LEN=20) :: CL_MPI_EPOCH ! 10-digits in seconds + dot + 9-digits nanosecs
-CHARACTER(LEN=32) :: CLENV
-REAL(KIND=JPRD) :: ZMPI_INIT(2)
-
-#include "abor1.intfb.h"
-#include "cnt0.intfb.h"
-!#include "couplo4_inimpi.intfb.h"
-!#include "couplo4_endmpi.intfb.h"
-#include "io_serv_init_part1.intfb.h"
-#include "io_serv_init_part2.intfb.h"
-#include "io_serv_exit.intfb.h"
-#include "io_serv_run.intfb.h"
-#include "fp_serv_init_part1.intfb.h"
-#include "fp_serv_init_part2.intfb.h"
-#include "fp_serv_exit.intfb.h"
-#include "ininemoio.intfb.h"
-#include "ininemoio2.intfb.h"
-#include "ec_meminfo.intfb.h"
-
-LLHOOK_SAVE = LHOOK
-LHOOK = .FALSE.
-LLNEMOIOSERVER = .FALSE.
-LLNEMOIO = .FALSE.
-
-IME = -1
-LLSTARTUPCOST = .FALSE. ! If true, then display MPI startup cost (only ever to happen on the global master task IME == 0)
-ZMPI_INIT(:) = 0
-
-! OASIS3 or OASIS4 interface must be initialized before any DR_HOOK call.
-
-#ifdef WITH_OASIS
-CALL CPL_INIT(LLCOUPACTIVE)
-#else
-#ifdef CPLOASIS
-!! Setup OASIS for coupling through SURFEX
-CALL INI_OASIS3_SFX
-#endif
-#endif
-
-#ifdef WITH_NEMO
-CALL ININEMOIO (LLNEMOIO, LLNEMOIOSERVER)
-#endif
-
-CALL MPI_INITIALIZED (LLINIT, IERR)
-IF (IERR /= 0) CALL ABOR1 ('MASTER: MPI_INITIALIZED FAILED')
-
-IF (.NOT. LLINIT) THEN
-#ifndef MPI1
- LLMPI1 = .FALSE.
- IREQUIRED = MPI_THREAD_MULTIPLE
- IPROVIDED = MPI_THREAD_SINGLE
- CALL MPI_INIT_THREAD(IREQUIRED,IPROVIDED,IERR)
- IF (IERR /= 0) CALL ABOR1 ('MASTER: MPI_INIT_THREAD FAILED')
- LTHSAFEMPI = (IPROVIDED >= IREQUIRED)
-#else
- LLMPI1 = .TRUE.
- IREQUIRED = -1
- IPROVIDED = -1
- CALL MPI_INIT(IERR)
- IF (IERR /= 0) CALL ABOR1 ('MASTER: MPI_INIT FAILED')
- LTHSAFEMPI = .FALSE.
-#endif
- LINITMPI_VIA_MPL = .TRUE. ! To re-instate ec_meminfo-call from within ec_mpi_finalize @ mpl_end()
-
- CALL MPI_Comm_rank(MPI_COMM_WORLD, IME, IERR)
-
- ! MPI_Init* overhead -- reference time from MPI_EPOCH variable (obtained via command date +%s.%N)
- CALL EC_GETENV('MPI_EPOCH',CL_MPI_EPOCH)
- IF (CL_MPI_EPOCH /= ' ') THEN
- CALL MPI_Barrier(MPI_COMM_WORLD, IERR)
- IF (IME == 0) THEN
- ZMPI_INIT(2) = MPI_Wtime() ! *not* from ifsaux/support/env.c
- !READ(CL_MPI_EPOCH,'(f20.0)',err=999,end=999) ZMPI_INIT(1)
- READ(CL_MPI_EPOCH,'(f20.0)') ZMPI_INIT(1)
- LLSTARTUPCOST = .TRUE.
-!999 CONTINUE
- ENDIF
- ENDIF
-
- ! Print out thread safety etc. messages -- must use MPI_Comm_rank since MPL not initialized just yet
- IF (IME == 0) THEN
- WRITE(0,'(1X,A,4(1X,I0),2(1X,L1))') &
- & 'MAIN: IREQUIRED, MPI_THREAD_MULTIPLE, MPI_THREAD_SINGLE, IPROVIDED, LTHSAFEMPI, LLMPI1 =',&
- & IREQUIRED, MPI_THREAD_MULTIPLE, MPI_THREAD_SINGLE, IPROVIDED, LTHSAFEMPI, LLMPI1
- ENDIF
-ENDIF
-
-! Every program needs to be initialised
-#ifdef WITH_FCKIT
-IF(.NOT.LLNEMOIOSERVER) THEN
- CALL FCKIT_MAIN%INITIALISE()
-
-#ifndef ONT_REGISTER_FCKIT_HANDLER
- ! Register ABOR1 as fckit's exception handler
- FUNPTR => ABOR1_EXCEPTION_HANDLER
- CALL FCKIT_EXCEPTION%SET_HANDLER( FUNPTR )
-#endif
-ENDIF
-#endif
-
-IF (LMPLUSERCOMM) THEN
- ICOMM_IFS_PLUS_IFS_IO_SERV = MPLUSERCOMM
-ELSE
- ICOMM_IFS_PLUS_IFS_IO_SERV = MPI_COMM_WORLD
-ENDIF
-
-! IO_SERV has to be initialized before any DR_HOOK call.
-CALL IO_SERV_INIT_PART1 (IO_SERV_C001, ICOMM_IFS_PLUS_IFS_IO_SERV)
-
-! Setup default for eckit/fckit enabled logging
-! - Worker with proc==1 writes to STDOUT, others disabled
-! - IO-servers write each to a server specific file IOSERV.<IOPROC>
-! In further routines this may be ammended to write to NULOUT (see SU0YOMA)
-#ifdef WITH_FCKIT
-IF(.NOT.LLNEMOIOSERVER) THEN
- IF( FCKIT_MAIN%TASKID()+1 == 1 ) THEN
- CALL FCKIT_LOG%SET_FORTRAN_UNIT(UNIT=STDOUT,STYLE=FCKIT_LOG%PREFIX)
- ELSEIF( IO_SERV_C001%LIO_SERVER ) THEN
- WRITE(CLIOSERV_LOGFILE,'(A,I0)') "IOSERV.",IO_SERV_C001%MYPROC_IO
- CALL FCKIT_LOG%SET_FILE(TRIM(CLIOSERV_LOGFILE),STYLE=FCKIT_LOG%PREFIX)
- ELSE
- CALL FCKIT_LOG%RESET()
- ENDIF
-ENDIF
-#endif
-
-! FP_SERV has to be initialized before any DR_HOOK call.
-CALL FP_SERV_INIT_PART1 (FP_SERV_C001, ICOMM_IFS_PLUS_IFS_IO_SERV)
-
-LLSERV = IO_SERV_C001%LIO_SERVER .OR. FP_SERV_C001%LFP_SERVER
-
-! Create a communicator for IFS compute tasks and NEMO/IO server
-
-IF (LLSERV) THEN
- ICOL = 2
- INUM = 0
-ELSE
- ICOL = 1
- CALL MPI_COMM_RANK (MPI_COMM_WORLD, INUM, IERR)
-ENDIF
-#ifndef CPLOASIS
-CALL MPI_COMM_SPLIT (MPI_COMM_WORLD, ICOL, INUM, ICOMM_IFS_PLUS_NEMO_IO_SERV, IERR)
-#endif
-IF (.NOT.LLSERV .AND. LLNEMOIO) THEN
-#ifdef WITH_NEMO
- CALL ININEMOIO2 (ICOMM_IFS_PLUS_NEMO_IO_SERV)
-#endif
-ENDIF
-
-IF (.NOT.LLNEMOIOSERVER) THEN
-
-CALL IO_SERV_INIT_PART2 (IO_SERV_C001, ICOMM_IFS_PLUS_IFS_IO_SERV)
-
-CALL FP_SERV_INIT_PART2 (FP_SERV_C001, ICOMM_IFS_PLUS_IFS_IO_SERV)
-
-#ifdef RS6K
-! Must be first for signal handlers
-!$OMP PARALLEL DO PRIVATE(JI),SCHEDULE(STATIC,1)
-DO JI=1,OML_MAX_THREADS()
- CALL SET_ERR_TRAP
-ENDDO
-!$OMP END PARALLEL DO
-#endif
-
-IF (LLSTARTUPCOST) THEN
- WRITE(0,'(1X,A,F30.6,A)') 'MAIN: MPI startup cost = ',ZMPI_INIT(2) - ZMPI_INIT(1),' secs'
- !WRITE(0,'(1X,A,3F30.9,A)') 'MAIN: MPI startup cost = ',ZMPI_INIT(1),ZMPI_INIT(2),ZMPI_INIT(2) - ZMPI_INIT(1),' secs'
-ENDIF
-
-LHOOK = LLHOOK_SAVE
-
-IF (IO_SERV_C001%LIO_SERVER) THEN
-
- CALL EC_MEMINFO(-1,"master:io-server",ICOMM_IFS_PLUS_IFS_IO_SERV,KBARR=1,KIOTASK=1,KCALL=0)
- CALL IO_SERV_RUN(IO_SERV_C001)
-
-ELSE
-
- IF (LHOOK) CALL DR_HOOK('MASTER',0,ZHOOK_HANDLE)
- CALL INIT_STACK(1)
-
-#ifdef IBM_HPM
- CALL HPM_BEGT(99)
-#endif
-
-#ifdef RS6K
-WRITE(0,'(A,I20)') "JIO1 SYNC time=",IRTC()
-#endif
-
- CALL EC_MEMINFO(-1,"master:computation",ICOMM_IFS_PLUS_IFS_IO_SERV,KBARR=1,KIOTASK=0,KCALL=0)
-
- CALL GET_ENVIRONMENT_VARIABLE('EC_DISPLAY_PID',CLENV)
- IF (CLENV == '1' .OR. CLENV == 'true' .OR. CLENV == 'TRUE') THEN
-#ifdef __INTEL_COMPILER
- WRITE (0, *) __FILE__, ':', __LINE__ , '######### PID',GETPID()
-#endif
- ENDIF
-
-#ifdef CPLOASIS
- CALL CNT0(LDCOUPACTIVE=LLCOUPACTIVE,KCOMM=ICOMM_IFS_PLUS_IFS_IO_SERV)
-#else
- CALL CNT0(LDCOUPACTIVE=LLCOUPACTIVE,KCOMM=ICOMM_IFS_PLUS_NEMO_IO_SERV)
-#endif
-
-#ifdef IBM_HPM
- CALL HPM_ENDT(99)
- CALL HPM_PRNT(99)
-#endif
-
- IF (LHOOK) CALL DR_HOOK('MASTER',1,ZHOOK_HANDLE)
-
-ENDIF
-
-! Every program needs to be finalised (optional, but good practise)
-#ifdef WITH_FCKIT
-CALL FCKIT_MAIN%FINALISE()
-#endif
-
-! OASIS3 or OASIS4 interface must be finalised after last DR_HOOK call.
-
-CALL IO_SERV_EXIT(IO_SERV_C001)
-
-CALL FP_SERV_EXIT (FP_SERV_C001)
-
-#ifdef WITH_OASIS
-CALL CPL_FINALIZE(LLCOUPACTIVE)
-#else
-#ifdef CPLOASIS
-!! end coupling with OASIS through SURFEX
- CALL END_OASIS3_SFX
-#endif
-#endif
-
-! CALL COUPLO4_ENDMPI
-
-CALL MPL_END(KERROR=IER) ! Does not fail
-
-ENDIF
-
-END PROGRAM MASTER
diff --git a/src/arome/modset_Ryad/mpa/micro/module/modi_ice4_rimltc.F90 b/src/arome/modset_Ryad/mpa/micro/module/modi_ice4_rimltc.F90
deleted file mode 100644
index 2eef6d1aeab2e954a89900dfda071f4bc1b85deb..0000000000000000000000000000000000000000
--- a/src/arome/modset_Ryad/mpa/micro/module/modi_ice4_rimltc.F90
+++ /dev/null
@@ -1,3 +0,0 @@
-MODULE MODI_ICE4_RIMLTC
-! dead code
-END MODULE MODI_ICE4_RIMLTC
diff --git a/src/arome/turb/tke_eps_sources.F90 b/src/arome/turb/tke_eps_sources.F90
index fc586dd609be380c5933c7cbe98e21d746e2adaf..672987f182e17653c639b6206b88e93acd184127 100644
--- a/src/arome/turb/tke_eps_sources.F90
+++ b/src/arome/turb/tke_eps_sources.F90
@@ -131,7 +131,7 @@ USE MODI_GRADIENT_W
USE MODI_SHUMAN , ONLY : DZM, DZF, MZM, MZF
USE MODI_TRIDIAG
USE MODI_TRIDIAG_TKE
-USE MODI_BUDGET
+USE MODI_BUDGET_DDH
USE MODE_FMWRIT
USE MODI_LES_MEAN_SUBGRID
!
@@ -335,18 +335,18 @@ IF (LBUDGET_TKE) THEN
! add the dynamical production
!
PRTKES(:,:,:) = PRTKES(:,:,:) + PDP(:,:,:) * PRHODJ(:,:,:)
- CALL BUDGET (PRTKES(:,:,:),5,'DP_BU_RTKE',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PRTKES(:,:,:),5,'DP_BU_RTKE',YDDDH, YDLDDH, YDMDDH)
!
! add the thermal production
!
PRTKES(:,:,:) = PRTKES(:,:,:) + PTP(:,:,:) * PRHODJ(:,:,:)
- CALL BUDGET (PRTKES(:,:,:),5,'TP_BU_RTKE',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PRTKES(:,:,:),5,'TP_BU_RTKE',YDDDH, YDLDDH, YDMDDH)
!
! add the dissipation
!
PRTKES(:,:,:) = PRTKES(:,:,:) - XCED * SQRT(PTKEM(:,:,:)) / PLEPS(:,:,:) * &
(PEXPL*PTKEM(:,:,:) + PIMPL*ZRES(:,:,:)) * PRHODJ(:,:,:)
-CALL BUDGET (PRTKES(:,:,:),5,'DISS_BU_RTKE',YDDDH, YDLDDH, YDMDDH)
+CALL BUDGET_DDH (PRTKES(:,:,:),5,'DISS_BU_RTKE',YDDDH, YDLDDH, YDMDDH)
END IF
!
!* 2.5 computes the final RTKE and stores the whole turbulent transport
@@ -359,7 +359,7 @@ PRTKES(:,:,:) = ZRES(:,:,:) * PRHODJ(:,:,:) / PTSTEP
!
! stores the whole turbulent transport
!
-IF (LBUDGET_TKE) CALL BUDGET (PRTKES(:,:,:),5,'TR_BU_RTKE',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_TKE) CALL BUDGET_DDH (PRTKES(:,:,:),5,'TR_BU_RTKE',YDDDH, YDLDDH, YDMDDH)
!
!
!----------------------------------------------------------------------------
diff --git a/src/arome/turb/turb.F90 b/src/arome/turb/turb.F90
index 3a0b480d85d7ed81bfdc6d4c77b3d13c56725ca2..68fec59f897017987d8cc13e0546e88f392ca912 100644
--- a/src/arome/turb/turb.F90
+++ b/src/arome/turb/turb.F90
@@ -234,7 +234,7 @@ USE MODI_TURB_VER
USE MODI_TKE_EPS_SOURCES
USE MODI_SHUMAN, ONLY : MZF, MXF, MYF
USE MODI_GRADIENT_M
-USE MODI_BUDGET
+USE MODI_BUDGET_DDH
USE MODI_LES_MEAN_SUBGRID
USE MODI_RMC01
USE MODI_GRADIENT_W
@@ -818,34 +818,34 @@ CALL TURB_VER(KKA,KKU,KKL,KRR, KRRL, KRRI, &
PDP,PTP,PSIGS,PWTH,PWRC,PWSV )
!
-IF (LBUDGET_U) CALL BUDGET (PRUS,1,'VTURB_BU_RU',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_V) CALL BUDGET (PRVS,2,'VTURB_BU_RV',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_W) CALL BUDGET (PRWS,3,'VTURB_BU_RW',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_U) CALL BUDGET_DDH (PRUS,1,'VTURB_BU_RU',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_V) CALL BUDGET_DDH (PRVS,2,'VTURB_BU_RV',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_W) CALL BUDGET_DDH (PRWS,3,'VTURB_BU_RW',YDDDH, YDLDDH, YDMDDH)
IF (LBUDGET_TH) THEN
IF ( KRRI >= 1 .AND. KRRL >= 1 ) THEN
- CALL BUDGET (PRTHLS+ ZLVOCPEXNM * PRRS(:,:,:,2) + ZLSOCPEXNM * PRRS(:,:,:,4),4,'VTURB_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PRTHLS+ ZLVOCPEXNM * PRRS(:,:,:,2) + ZLSOCPEXNM * PRRS(:,:,:,4),4,'VTURB_BU_RTH',YDDDH, YDLDDH, YDMDDH)
ELSE IF ( KRRL >= 1 ) THEN
- CALL BUDGET (PRTHLS+ ZLOCPEXNM * PRRS(:,:,:,2),4,'VTURB_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PRTHLS+ ZLOCPEXNM * PRRS(:,:,:,2),4,'VTURB_BU_RTH',YDDDH, YDLDDH, YDMDDH)
ELSE
- CALL BUDGET (PRTHLS,4,'VTURB_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PRTHLS,4,'VTURB_BU_RTH',YDDDH, YDLDDH, YDMDDH)
END IF
END IF
IF (LBUDGET_SV) THEN
DO JSV = 1,NSV
- CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'VTURB_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PRSVS(:,:,:,JSV),JSV+12,'VTURB_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END DO
END IF
IF (LBUDGET_RV) THEN
IF ( KRRI >= 1 .AND. KRRL >= 1) THEN
- CALL BUDGET (PRRS(:,:,:,1)-PRRS(:,:,:,2)-PRRS(:,:,:,4),6,'VTURB_BU_RRV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PRRS(:,:,:,1)-PRRS(:,:,:,2)-PRRS(:,:,:,4),6,'VTURB_BU_RRV',YDDDH, YDLDDH, YDMDDH)
ELSE IF ( KRRL >= 1 ) THEN
- CALL BUDGET (PRRS(:,:,:,1)-PRRS(:,:,:,2),6,'VTURB_BU_RRV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PRRS(:,:,:,1)-PRRS(:,:,:,2),6,'VTURB_BU_RRV',YDDDH, YDLDDH, YDMDDH)
ELSE
- CALL BUDGET (PRRS(:,:,:,1),6,'VTURB_BU_RRV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PRRS(:,:,:,1),6,'VTURB_BU_RRV',YDDDH, YDLDDH, YDMDDH)
END IF
END IF
-IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7,'VTURB_BU_RRC',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9,'VTURB_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_RC) CALL BUDGET_DDH (PRRS(:,:,:,2),7,'VTURB_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_RI) CALL BUDGET_DDH (PRRS(:,:,:,4),9,'VTURB_BU_RRI',YDDDH, YDLDDH, YDMDDH)
!
!
IF (HTURBDIM=='3DIM') THEN
@@ -870,34 +870,34 @@ IF (HTURBDIM=='3DIM') THEN
END IF
!
!
-IF (LBUDGET_U) CALL BUDGET (PRUS,1,'HTURB_BU_RU',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_V) CALL BUDGET (PRVS,2,'HTURB_BU_RV',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_W) CALL BUDGET (PRWS,3,'HTURB_BU_RW',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_U) CALL BUDGET_DDH (PRUS,1,'HTURB_BU_RU',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_V) CALL BUDGET_DDH (PRVS,2,'HTURB_BU_RV',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_W) CALL BUDGET_DDH (PRWS,3,'HTURB_BU_RW',YDDDH, YDLDDH, YDMDDH)
IF (LBUDGET_TH) THEN
IF ( KRRI >= 1 .AND. KRRL >= 1 ) THEN
- CALL BUDGET (PRTHLS+ ZLVOCPEXNM * PRRS(:,:,:,2) + ZLSOCPEXNM * PRRS(:,:,:,4),4,'HTURB_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PRTHLS+ ZLVOCPEXNM * PRRS(:,:,:,2) + ZLSOCPEXNM * PRRS(:,:,:,4),4,'HTURB_BU_RTH',YDDDH, YDLDDH, YDMDDH)
ELSE IF ( KRRL >= 1 ) THEN
- CALL BUDGET (PRTHLS+ ZLOCPEXNM * PRRS(:,:,:,2),4,'HTURB_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PRTHLS+ ZLOCPEXNM * PRRS(:,:,:,2),4,'HTURB_BU_RTH',YDDDH, YDLDDH, YDMDDH)
ELSE
- CALL BUDGET (PRTHLS,4,'HTURB_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PRTHLS,4,'HTURB_BU_RTH',YDDDH, YDLDDH, YDMDDH)
END IF
END IF
IF (LBUDGET_SV) THEN
DO JSV = 1,NSV
- CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'HTURB_BU_RSV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PRSVS(:,:,:,JSV),JSV+12,'HTURB_BU_RSV',YDDDH, YDLDDH, YDMDDH)
END DO
END IF
IF (LBUDGET_RV) THEN
IF ( KRRI >= 1 .AND. KRRL >= 1) THEN
- CALL BUDGET (PRRS(:,:,:,1)-PRRS(:,:,:,2)-PRRS(:,:,:,4),6,'HTURB_BU_RRV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PRRS(:,:,:,1)-PRRS(:,:,:,2)-PRRS(:,:,:,4),6,'HTURB_BU_RRV',YDDDH, YDLDDH, YDMDDH)
ELSE IF ( KRRL >= 1 ) THEN
- CALL BUDGET (PRRS(:,:,:,1)-PRRS(:,:,:,2),6,'HTURB_BU_RRV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PRRS(:,:,:,1)-PRRS(:,:,:,2),6,'HTURB_BU_RRV',YDDDH, YDLDDH, YDMDDH)
ELSE
- CALL BUDGET (PRRS(:,:,:,1),6,'HTURB_BU_RRV',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PRRS(:,:,:,1),6,'HTURB_BU_RRV',YDDDH, YDLDDH, YDMDDH)
END IF
END IF
-IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7,'HTURB_BU_RRC',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9,'HTURB_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_RC) CALL BUDGET_DDH (PRRS(:,:,:,2),7,'HTURB_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+IF (LBUDGET_RI) CALL BUDGET_DDH (PRRS(:,:,:,4),9,'HTURB_BU_RRI',YDDDH, YDLDDH, YDMDDH)
!
!----------------------------------------------------------------------------
!
@@ -924,11 +924,11 @@ CALL TKE_EPS_SOURCES(KKA,KKU,KKL,KMI,PTKEM,ZLM,ZLEPS,PDP,ZTRH, &
& PTDISS,PEDR,YDDDH, YDLDDH, YDMDDH)
IF (LBUDGET_TH) THEN
IF ( KRRI >= 1 .AND. KRRL >= 1 ) THEN
- CALL BUDGET (PRTHLS+ ZLVOCPEXNM * PRRS(:,:,:,2) + ZLSOCPEXNM * PRRS(:,:,:,4),4,'DISSH_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PRTHLS+ ZLVOCPEXNM * PRRS(:,:,:,2) + ZLSOCPEXNM * PRRS(:,:,:,4),4,'DISSH_BU_RTH',YDDDH, YDLDDH, YDMDDH)
ELSE IF ( KRRL >= 1 ) THEN
- CALL BUDGET (PRTHLS+ ZLOCPEXNM * PRRS(:,:,:,2),4,'DISSH_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PRTHLS+ ZLOCPEXNM * PRRS(:,:,:,2),4,'DISSH_BU_RTH',YDDDH, YDLDDH, YDMDDH)
ELSE
- CALL BUDGET (PRTHLS,4,'DISSH_BU_RTH',YDDDH, YDLDDH, YDMDDH)
+ CALL BUDGET_DDH (PRTHLS,4,'DISSH_BU_RTH',YDDDH, YDLDDH, YDMDDH)
END IF
END IF
diff --git a/src/common/micro/mode_ice4_sedimentation_stat.F90 b/src/common/micro/mode_ice4_sedimentation_stat.F90
index 26b25e10350bb349df94d7d16c95a67d264e0f2a..22d76575dac5b87e81803f5ccd27b49c0e853c64 100644
--- a/src/common/micro/mode_ice4_sedimentation_stat.F90
+++ b/src/common/micro/mode_ice4_sedimentation_stat.F90
@@ -209,7 +209,7 @@ DO JK = KKE , KKB, -1*KKL
IF (JK==KKB) THEN
DO JJ = KJB, KJE
DO JI = KIB, KIE
- PINPRC(JI,JJ) = ZSED(JI,JJ,IK,2)/XRHOLW
+ IF(OSEDIC) PINPRC(JI,JJ) = ZSED(JI,JJ,IK,2)/XRHOLW
PINPRR(JI,JJ) = ZSED(JI,JJ,IK,3)/XRHOLW
PINPRI(JI,JJ) = ZSED(JI,JJ,IK,4)/XRHOLW
PINPRS(JI,JJ) = ZSED(JI,JJ,IK,5)/XRHOLW
diff --git a/src/common/micro/mode_ice4_tendencies.F90 b/src/common/micro/mode_ice4_tendencies.F90
index f9af1458deaa289095f6d610f2b463368ee2eb5f..50f8ae0a4624f1b26adaec490c549a358100304b 100644
--- a/src/common/micro/mode_ice4_tendencies.F90
+++ b/src/common/micro/mode_ice4_tendencies.F90
@@ -6,22 +6,6 @@
MODULE MODE_ICE4_TENDENCIES
IMPLICIT NONE
CONTAINS
-!
-!
-!
-!
-!
-!
-!!! NOTE: *quand l'array syntax sera remplacée par des boucles, en profiter
-!!! pour supprimer les arguments PA et PB des différentes routines
-!!! pour generaliser le fonctionnement de nucleation, rimltc et rrhong
-!!! *avec loop, pcompute *et* llcompute utiles tous les deux?
-!
-!
-!
-!
-!
-!
SUBROUTINE ICE4_TENDENCIES(KPROMA, KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, &
&KRR, ODSOFT, PCOMPUTE, &
&OWARM, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
@@ -64,6 +48,7 @@ SUBROUTINE ICE4_TENDENCIES(KPROMA, KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE
! ------------
!
USE MODD_BUDGET, ONLY : LBU_ENABLE
+USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
USE MODD_CST, ONLY: XALPI, XBETAI, XCI, XCPV, XEPSILO, XGAMI, XLSTT, XMD, XMV, XP00, XRV, XTT
USE MODD_PARAM_ICE, ONLY: CSNOWRIMING
USE MODD_RAIN_ICE_DESCR, ONLY: XLBDAS_MAX, XLBEXG, XLBEXH, XLBEXR, XLBEXS, XLBG, XLBH, XLBR, XLBS, XRTMIN
@@ -175,14 +160,14 @@ REAL, DIMENSION(KPROMA, 10), INTENT(INOUT) :: PRH_TEND
REAL, DIMENSION(KPROMA), INTENT(OUT) :: PSSI
REAL, DIMENSION(KPROMA,0:KRR), INTENT(OUT) :: PA
REAL, DIMENSION(KPROMA,0:KRR), INTENT(OUT) :: PB
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PHLC_HCF
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PHLC_LCF
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PHLC_HRC
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PHLC_LRC
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PHLI_HCF
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PHLI_LCF
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PHLI_HRI
-REAL, DIMENSION(KPROMA), INTENT(OUT) :: PHLI_LRI
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLC_HCF
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLC_LCF
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLC_HRC
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLC_LRC
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLI_HCF
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLI_LCF
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLI_HRI
+REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLI_LRI
REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRAINFR ! Rain fraction
!
!* 0.2 declaration of local variables
@@ -319,6 +304,15 @@ CALL ICE4_COMPUTE_PDF(KSIZE, HSUBG_AUCV_RC, HSUBG_AUCV_RI, HSUBG_PR_PDF,&
PHLI_HCF, PHLI_LCF, PHLI_HRI, PHLI_LRI, ZRAINFR)
LLRFR=HSUBG_RC_RR_ACCR=='PRFR' .OR. HSUBG_RR_EVAP=='PRFR'
IF (LLRFR) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'MODE_ICE4_TENDENCIES', 'LLRFR case broken by optimisation, see comments in mode_ice4_tendencies to knwon why (and how to reapir)....')
+ !Microphyscs was optimized by introducing chunks of KPROMA size
+ !Thus, in ice4_tendencies, the 1D array represent only a fraction of the points where microphisical species are present
+ !We cannot rebuild the entire 3D arrays here, so we cannot call ice4_rainfr_vert here
+ !A solution would be to suppress optimisation in this case by setting KPROMA=KSIZE in rain_ice
+ !Another solution would be to compute column by column?
+ !Another one would be to cut tendencies in 3 parts: before rainfr_vert, rainfr_vert, after rainfr_vert
+
+
!Diagnostic of precipitation fraction
PRAINFR(:,:,:) = 0.
ZRRT3D (:,:,:) = 0.
diff --git a/src/arome/modset_Ryad/mpa/micro/module/modi_rain_ice.F90 b/src/common/micro/modi_rain_ice.F90
similarity index 81%
rename from src/arome/modset_Ryad/mpa/micro/module/modi_rain_ice.F90
rename to src/common/micro/modi_rain_ice.F90
index 66776ce91f19b5ed06fe7b2591dca37d5ca41afd..d0f1cef0460e13d564d6ce5cc476494b82685fa5 100644
--- a/src/arome/modset_Ryad/mpa/micro/module/modi_rain_ice.F90
+++ b/src/common/micro/modi_rain_ice.F90
@@ -4,19 +4,20 @@
!
INTERFACE
SUBROUTINE RAIN_ICE ( KPROMA, KIT, KJT, KKT, KSIZE, &
- OSEDIC,OCND2, HSEDIM, HSUBG_AUCV_RC, OWARM, KKA, KKU, KKL, &
+ OSEDIC,OCND2, HSEDIM, HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
+ OWARM, KKA, KKU, KKL, &
PTSTEP, KRR, LDMICRO, PEXN, &
PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
PINPRC, PINPRR, PEVAP3D, &
- PINPRS, PINPRG, PSIGS, PSEA, PTOWN, &
+ PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, PSEA, PTOWN, &
PRHT, PRHS, PINPRH, PFPR, &
- YDDDH, YDLDDH, YDMDDH )
+ TBUDGETS, KBUDGETS)
!
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
+USE MODD_BUDGET, ONLY : TBUDGETDATA
+USE MODD_PARAM_ICE, ONLY: LDEPOSC
!
INTEGER, INTENT(IN) :: KPROMA ! cache-blocking factor for microphysic loop
INTEGER, INTENT(IN) :: KIT, KJT, KKT ! arrays size
@@ -26,6 +27,8 @@ LOGICAL :: OCND2 ! Logical switch to separate l
CHARACTER(LEN=4), INTENT(IN) :: HSEDIM ! Sedimentation scheme
CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC ! Switch for rc->rr Subgrid autoconversion
! Kind of Subgrid autoconversion method
+CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI ! Switch for ri->rs Subgrid autoconversion
+ ! Kind of Subgrid autoconversion method
LOGICAL, INTENT(IN) :: OWARM ! .TRUE. allows raindrops to
! form by warm processes
! (Kessler scheme)
@@ -47,6 +50,10 @@ REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at
!
REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLC_HRC
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLC_HCF
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLI_HRI
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLI_HCF
!
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRVT ! Water vapor m.r. at t
@@ -72,15 +79,17 @@ REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR! Rain instant precip
REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PEVAP3D! Rain evap profile
REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS! Snow instant precip
REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG! Graupel instant precip
+REAL, DIMENSION(MERGE(KIT, 0, LDEPOSC), MERGE(KJT, 0, LDEPOSC)), INTENT(OUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRAINFR !Precipitation fraction
REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PTOWN! Fraction that is town
REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH! Hail instant precip
REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
+!
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
!
END SUBROUTINE RAIN_ICE
END INTERFACE
diff --git a/src/arome/modset_Ryad/mpa/micro/internals/rain_ice.F90 b/src/common/micro/rain_ice.F90
similarity index 55%
rename from src/arome/modset_Ryad/mpa/micro/internals/rain_ice.F90
rename to src/common/micro/rain_ice.F90
index d5f1bb22b9e1c19f130b9f3529924ceab5dff08c..952e54e53c6a2bc10323bdd57b406e5194c36adb 100644
--- a/src/arome/modset_Ryad/mpa/micro/internals/rain_ice.F90
+++ b/src/common/micro/rain_ice.F90
@@ -4,18 +4,18 @@
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ######spl
- SUBROUTINE RAIN_ICE ( KPROMA, KIT, KJT, KKT, KSIZE, &
- OSEDIC, OCND2, HSEDIM, HSUBG_AUCV_RC, OWARM,KKA,KKU,KKL,&
+ SUBROUTINE RAIN_ICE ( KPROMA, KIT, KJT, KKT, KSIZE, &
+ OSEDIC, OCND2, HSEDIM, HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
+ OWARM, KKA, KKU, KKL, &
PTSTEP, KRR, ODMICRO, PEXN, &
PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
PINPRC, PINPRR, PEVAP3D, &
- PINPRS, PINPRG, PSIGS, PSEA, PTOWN, &
+ PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, PSEA, PTOWN, &
PRHT, PRHS, PINPRH, PFPR, &
- YDDDH, YDLDDH, YDMDDH )
- USE PARKIND1, ONLY : JPRB
- USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+ TBUDGETS, KBUDGETS)
! ######################################################################
!
!!**** * - compute the explicit microphysical sources
@@ -153,21 +153,40 @@
!! land, sea and urban areas in the cloud sedimentation.
!! (D. Degrauwe), 2013-11: Export upper-air precipitation fluxes PFPR.
!! (S. Riette) Nov 2013 Protection against null sigma
+!! (C. Lac) FIT temporal scheme : instant M removed
+!! (JP Pinty), 01-2014 : ICE4 : partial reconversion of hail to graupel
+!! July, 2015 (O.Nuissier/F.Duffourg) Add microphysics diagnostic for
+!! aircraft, ballon and profiler
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! C.Lac : 10/2016 : add droplet deposition
+!! C.Lac : 01/2017 : correction on droplet deposition
+!! J.Escobar : 10/2017 : for real*4 , limit exp() in RAIN_ICE_SLOW with XMNH_HUGE_12_LOG
!! (C. Abiven, Y. Léauté, V. Seigner, S. Riette) Phasing of Turner rain subgrid param
!! (S. Riette) Source code split into several files
+!! 02/2019 C.Lac add rain fraction as an output field
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
+! P. Wautelet 17/01/2020: move Quicksort to tools.f90
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+! P. Wautelet 25/02/2020: bugfix: add missing budget: WETH_BU_RRG
!! R. El Khatib 24-Aug-2021 Optimizations
+!-----------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+
+USE MODD_BUDGET, ONLY: TBUDGETDATA, LBU_ENABLE, &
+ & LBUDGET_TH, LBUDGET_RV, LBUDGET_RC, LBUDGET_RR, LBUDGET_RI, LBUDGET_RS, LBUDGET_RG, LBUDGET_RH, &
+ & NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH
USE MODD_CST, ONLY: XCI, XCL, XCPD, XCPV, XLSTT, XLVTT, XTT, XRHOLW
-USE MODD_PARAMETERS, ONLY: JPVEXT, XUNDEF
+USE MODD_PARAMETERS, ONLY: JPVEXT
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_RAIN_ICE_DESCR, ONLY: XRTMIN
-USE MODD_RAIN_ICE_PARAM
-USE MODD_BUDGET
-USE MODD_LES
USE MODD_FIELDS_ADDRESS, ONLY : & ! common fields adress
& ITH, & ! Potential temperature
& IRV, & ! Water vapor
@@ -177,16 +196,17 @@ USE MODD_FIELDS_ADDRESS, ONLY : & ! common fields adress
& IRS, & ! Snow/aggregate
& IRG, & ! Graupel
& IRH ! Hail
-USE MODI_BUDGET
-USE MODI_ICE4_RAINFR_VERT
+
+USE MODE_BUDGET, ONLY: BUDGET_STORE_ADD, BUDGET_STORE_INIT, BUDGET_STORE_END
+USE MODE_ll
+USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
+
+USE MODE_ICE4_RAINFR_VERT, ONLY: ICE4_RAINFR_VERT
USE MODE_ICE4_SEDIMENTATION_STAT, ONLY: ICE4_SEDIMENTATION_STAT
USE MODE_ICE4_SEDIMENTATION_SPLIT, ONLY: ICE4_SEDIMENTATION_SPLIT
USE MODE_ICE4_SEDIMENTATION_SPLIT_MOMENTUM, ONLY: ICE4_SEDIMENTATION_SPLIT_MOMENTUM
USE MODE_ICE4_NUCLEATION_WRAPPER, ONLY: ICE4_NUCLEATION_WRAPPER
USE MODE_ICE4_TENDENCIES, ONLY: ICE4_TENDENCIES
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
!
IMPLICIT NONE
!
@@ -201,6 +221,7 @@ LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
LOGICAL :: OCND2 ! Logical switch to separate liquid and ice
CHARACTER(LEN=4), INTENT(IN) :: HSEDIM ! Sedimentation scheme
CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC ! Kind of Subgrid autoconversion method
+CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI ! Kind of Subgrid autoconversion method
LOGICAL, INTENT(IN) :: OWARM ! .TRUE. allows raindrops to
! form by warm processes
! (Kessler scheme)
@@ -220,6 +241,10 @@ REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at
!
REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PCLDFR ! Convective Mass Flux Cloud fraction
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLC_HRC
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLC_HCF
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLI_HRI
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLI_HCF
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRVT ! Water vapor m.r. at t
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
@@ -227,7 +252,6 @@ REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PSIGS ! Sigma_s at t
!
REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PTHS ! Theta source
REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
@@ -242,25 +266,24 @@ REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR! Rain instant precip
REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PEVAP3D! Rain evap profile
REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS! Snow instant precip
REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG! Graupel instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRAINFR !Precipitation fraction
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PSIGS ! Sigma_s at t
REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PTOWN! Fraction that is town
REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH! Hail instant precip
REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
+!
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
!
!* 0.2 Declarations of local variables :
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!REAL(KIND=JPRB) :: ZHOOK_HANDLE1
-!REAL(KIND=JPRB) :: ZHOOK_HANDLE2
-!REAL(KIND=JPRB) :: ZHOOK_HANDLE3
-!REAL(KIND=JPRB) :: ZHOOK_HANDLE4
-!REAL(KIND=JPRB) :: ZHOOK_HANDLE5
-
+INTEGER :: IIU
+INTEGER :: IJU
INTEGER :: IIB ! Define the domain where is
INTEGER :: IIE ! the microphysical sources have to be computed
INTEGER :: IJB !
@@ -274,10 +297,12 @@ INTEGER :: ISTI, ISTJ, ISTK
!Arrays for nucleation call outisde of ODMICRO points
REAL, DIMENSION(KIT, KJT, KKT) :: ZW ! work array
REAL, DIMENSION(KIT, KJT, KKT) :: ZT ! Temperature
-REAL, DIMENSION(KIT, KJT, KKT) :: &
- & ZZ_RVHENI_MR ! heterogeneous nucleation mixing ratio change
-REAL, DIMENSION(KIT, KJT, KKT) :: ZZ_LVFACT, ZZ_LSFACT
-REAL :: ZZ_RVHENI ! heterogeneous nucleation
+REAL, DIMENSION(KIT, KJT, KKT) :: ZZ_RVHENI_MR, & ! heterogeneous nucleation mixing ratio change
+ & ZZ_RVHENI ! heterogeneous nucleation
+REAL, DIMENSION(MERGE(KIT, 0, LBU_ENABLE), &
+ &MERGE(KJT, 0, LBU_ENABLE), &
+ &MERGE(KKT, 0, LBU_ENABLE)) :: ZW1, ZW2, ZW3, ZW4, ZW5, ZW6 !Work arrays
+REAL, DIMENSION(KIT, KJT, KKT) :: ZZ_LVFACT, ZZ_LSFACT, ZZ_DIFF
!
REAL, DIMENSION(KIT,KJT,KKT) :: ZRCT ! Cloud water m.r. source at t
REAL, DIMENSION(KIT,KJT,KKT) :: ZRRT ! Rain water m.r. source at t
@@ -285,20 +310,9 @@ REAL, DIMENSION(KIT,KJT,KKT) :: ZRIT ! Pristine ice m.r. source at t
REAL, DIMENSION(KIT,KJT,KKT) :: ZRST ! Snow/aggregate m.r. source at t
REAL, DIMENSION(KIT,KJT,KKT) :: ZRGT ! Graupel m.r. source at t
REAL, DIMENSION(KIT,KJT,KKT) :: ZRHT ! Hail m.r. source at t
+REAL, DIMENSION(KIT,KJT,KKT) :: ZCITOUT ! Output value for CIT
!Diagnostics
-LOGICAL :: LLRAIN_FRACTION=.FALSE. ! activate or rain fraction
-REAL, DIMENSION(KIT, KJT, KKT) :: ZRAINFR3D
-LOGICAL :: LLHLC=.FALSE. ! activate or not HLCLOUDS
-REAL, DIMENSION(KIT, KJT, KKT) :: &
- & 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
- & ZHLI_HCF3D,& ! HLCLOUDS cloud fraction in high ice content part
- & ZHLI_LCF3D,& ! HLCLOUDS cloud fraction in low ice content part
- & ZHLI_HRI3D,& ! HLCLOUDS cloud water content in high ice content
- & ZHLI_LRI3D ! HLCLOUDS cloud water content in high ice content
REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2)) :: ZINPRI ! Pristine ice instant precip
!
LOGICAL :: GEXT_TEND
@@ -341,8 +355,8 @@ REAL, DIMENSION(KSIZE) :: ZTOT_RVHENI, & ! heterogeneous nucleation mixing ratio
!For packing
INTEGER :: IMICRO ! Case r_x>0 locations
INTEGER :: JL, JV
-REAL, DIMENSION(KPROMA) :: ZTIME ! Current integration time (starts with 0 and ends with PTSTEP)
-REAL, DIMENSION(KPROMA) :: &
+REAL, DIMENSION(KPROMA) :: ZTIME ! Current integration time (starts with 0 and ends with PTSTEP)
+REAL, DIMENSION(KPROMA) :: &
& ZMAXTIME, & ! Time on which we can apply the current tendencies
& ZTIME_LASTCALL, & ! Integration time when last tendecies call has been done
& ZCOMPUTE, & ! 1. for points where we must compute tendencies, 0. elsewhere
@@ -366,7 +380,6 @@ REAL, DIMENSION(KPROMA) :: &
& ZHLI_LCF, &
& ZHLI_HRI, &
& ZHLI_LRI
- & ZRAINFR ! rain fraction
!
!Output packed tendencies (for budgets only)
REAL, DIMENSION(KPROMA) :: ZRVHENI_MR, & ! heterogeneous nucleation mixing ratio change
@@ -396,9 +409,9 @@ REAL, DIMENSION(KPROMA) :: ZRVHENI_MR, & ! heterogeneous nucleation mixing ratio
& ZRCDRYH, ZRIDRYH, ZRSDRYH, ZRRDRYH, ZRGDRYH, & ! Wet growth of hailstone
& ZRDRYHG ! Conversion of hailstone into graupel
!
-!For time- or mixing-ratio- splitting at the begining of the current loop
-LOGICAL, DIMENSION(KRR) :: LLCPZ0T
-REAL, DIMENSION(KPROMA) :: Z0T
+!For mixing-ratio-splitting
+LOGICAL :: LLCPZ0RT
+REAL, DIMENSION(KPROMA, KRR) :: Z0RT ! Mixing-ratios at the beginig of the current loop
!
REAL, DIMENSION(KPROMA,0:7) :: &
& ZVART, & !Packed variables
@@ -411,33 +424,41 @@ REAL, DIMENSION(KPROMA,10) :: ZRH_TEND
INTEGER, DIMENSION(KPROMA) :: &
& I1,I2,I3, & ! Used to replace the COUNT and PACK intrinsics on variables
& IITER ! Number of iterations done (with real tendencies computation)
+INTEGER, DIMENSION(KSIZE) :: I1TOT, I2TOT, I3TOT ! Used to replace the COUNT and PACK intrinsics
!
-REAL, DIMENSION(KPROMA) :: ZSUM2, ZMAXB, ZTHRESHOLD
-REAL :: ZDEVIDE, ZX, ZSUM1
+REAL, DIMENSION(KPROMA) :: ZSUM2, ZMAXB
+REAL :: ZDEVIDE, ZX, ZRICE
!
-INTEGER :: IOFF, IC, JMICRO
-LOGICAL :: LLSIGMA_RC, LL_ANY_ITER
-
-#include "abor1.intfb.h"
+INTEGER :: IC, JMICRO
+LOGICAL :: LLSIGMA_RC, LL_ANY_ITER, LL_AUCV_ADJU
+!
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('RAIN_ICE', 0, ZHOOK_HANDLE)
+!
!-------------------------------------------------------------------------------
!
-!IF (LHOOK) CALL DR_HOOK('RAIN_ICE:ANTE_MICRO', 0, ZHOOK_HANDLE1)
IF(OCND2) THEN
- WRITE(*,*) ' STOP'
- WRITE(*,*) ' OCND2 OPTION NOT CODED IN THIS RAIN_ICE VERSION'
- CALL ABORT
- STOP
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'RAIN_ICE', 'OCND2 OPTION NOT CODED IN THIS RAIN_ICE VERSION')
END IF
+IF(KPROMA /= KSIZE) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'RAIN_ICE', 'For now, KPROMA must be equal to KSIZE, see code for explanation')
+ ! 2 issues
+ ! * Microphyscs was optimized by introducing chunks of KPROMA size
+ ! Thus, in ice4_tendencies, the 1D array represent only a fraction of the points where microphisical species are present
+ ! We cannot rebuild the entire 3D arrays in the subroutine, so we cannot call ice4_rainfr_vert in it
+ ! A solution would be to suppress optimisation in this case by setting KPROMA=KSIZE in rain_ice
+ ! Another solution would be to compute column by column?
+ ! Another one would be to cut tendencies in 3 parts: before rainfr_vert, rainfr_vert, after rainfr_vert
+ ! * When chuncks are used, result is different
+ENDIF
+!
!* 1. COMPUTE THE LOOP BOUNDS
! -----------------------
!
-IIB=1+JPHEXT
-IIE=SIZE(PDZZ,1) - JPHEXT
-IJB=1+JPHEXT
-IJE=SIZE(PDZZ,2) - JPHEXT
+IIU=SIZE(PDZZ,1)
+IJU=SIZE(PDZZ,2)
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE,IIU,IJU)
IKB=KKA+JPVEXT*KKL
IKE=KKU-JPVEXT*KKL
IKTB=1+JPVEXT
@@ -451,11 +472,11 @@ DO JK = 1, KKT
DO JJ = 1, KJT
DO JI = 1, KIT
IF (KRR==7) THEN
- ZSUM1=PRIT(JI,JJ,JK)+PRST(JI,JJ,JK)+PRGT(JI,JJ,JK)+PRHT(JI,JJ,JK)
+ ZRICE=PRIT(JI,JJ,JK)+PRST(JI,JJ,JK)+PRGT(JI,JJ,JK)+PRHT(JI,JJ,JK)
ELSE
- ZSUM1=PRIT(JI,JJ,JK)+PRST(JI,JJ,JK)+PRGT(JI,JJ,JK)
+ ZRICE=PRIT(JI,JJ,JK)+PRST(JI,JJ,JK)+PRGT(JI,JJ,JK)
ENDIF
- ZDEVIDE = XCPD + XCPV*PRVT(JI,JJ,JK) + XCL*(PRCT(JI,JJ,JK)+PRRT(JI,JJ,JK)) + XCI*ZSUM1
+ ZDEVIDE = XCPD + XCPV*PRVT(JI,JJ,JK) + XCL*(PRCT(JI,JJ,JK)+PRRT(JI,JJ,JK)) + XCI*ZRICE
ZT(JI,JJ,JK) = PTHT(JI,JJ,JK) * PEXN(JI,JJ,JK)
ZZ_LSFACT(JI,JJ,JK)=(XLSTT+(XCPV-XCI)*(ZT(JI,JJ,JK)-XTT)) / ZDEVIDE
ZZ_LVFACT(JI,JJ,JK)=(XLVTT+(XCPV-XCL)*(ZT(JI,JJ,JK)-XTT)) / ZDEVIDE
@@ -472,6 +493,13 @@ IF(.NOT. LSEDIM_AFTER) THEN
!
!* 2.1 sedimentation
!
+ IF (LBUDGET_RC .AND. OSEDIC) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RC), 'SEDI', PRCS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RR), 'SEDI', PRRS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RI) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RI), 'SEDI', PRIS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RS) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RS), 'SEDI', PRSS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RG) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RG), 'SEDI', PRGS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RH), 'SEDI', PRHS(:, :, :) * PRHODJ(:, :, :))
+
IF(HSEDIM=='STAT') THEN
IF(KRR==7) THEN
DO JK = 1, KKT
@@ -487,8 +515,7 @@ IF(.NOT. LSEDIM_AFTER) THEN
ENDDO
ENDDO
CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, &
- &PDZZ, &
+ &PTSTEP, KRR, OSEDIC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, ZRCT, PRRS, ZRRT, PRIS, ZRIT,&
&PRSS, ZRST, PRGS, ZRGT,&
@@ -508,8 +535,7 @@ IF(.NOT. LSEDIM_AFTER) THEN
ENDDO
ENDDO
CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, &
- &PDZZ, &
+ &PTSTEP, KRR, OSEDIC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, ZRCT, PRRS, ZRRT, PRIS, ZRIT,&
&PRSS, ZRST, PRGS, ZRGT,&
@@ -518,13 +544,11 @@ IF(.NOT. LSEDIM_AFTER) THEN
&PFPR=PFPR)
ENDIF
PINPRS(:,:) = PINPRS(:,:) + ZINPRI(:,:)
- !No negativity correction here as we apply sedimentation on ZR.T variables
+ !No negativity correction here as we apply sedimentation on PR.S*PTSTEP variables
ELSEIF(HSEDIM=='SPLI') THEN
- !SR: It *seems* that we must have two separate calls for ifort
IF(KRR==7) THEN
CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, &
- &PDZZ, &
+ &PTSTEP, KRR, OSEDIC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
@@ -532,8 +556,7 @@ IF(.NOT. LSEDIM_AFTER) THEN
&PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR)
ELSE
CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, &
- &PDZZ, &
+ &PTSTEP, KRR, OSEDIC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
@@ -556,27 +579,43 @@ IF(.NOT. LSEDIM_AFTER) THEN
&PTHS, ZZ_LVFACT, ZZ_LSFACT, PRHS)
ELSEIF(HSEDIM=='NONE') THEN
ELSE
- WRITE(*,*) ' STOP'
- WRITE(*,*) ' NO SEDIMENTATION SCHEME FOR HSEDIM=', HSEDIM
- CALL ABORT
- STOP
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'RAIN_ICE', 'no sedimentation scheme for HSEDIM='//HSEDIM)
END IF
+
+
+
+
+
+
+!!!!! ajouter momentum
+
+
+
+
+
+
+
+
+
+
+
+
+
+
!
!* 2.2 budget storage
!
- IF (LBUDGET_RC .AND. OSEDIC) &
- CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'SEDI_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'SEDI_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'SEDI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:), 10, 'SEDI_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:), 11, 'SEDI_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF ( KRR == 7 .AND. LBUDGET_RH) &
- CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:), 12, 'SEDI_BU_RRH',YDDDH, YDLDDH, YDMDDH)
+ IF (LBUDGET_RC .AND. OSEDIC) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RC), 'SEDI', PRCS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RR), 'SEDI', PRRS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RI) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RI), 'SEDI', PRIS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RS) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RS), 'SEDI', PRSS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RG) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RG), 'SEDI', PRGS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RH), 'SEDI', PRHS(:, :, :) * PRHODJ(:, :, :))
ENDIF
!
-! Bakup of tendencies + PEVAP3D preset :
DO JK = 1,KKT
+ !Backup of T variables
ZWR(:,:,JK,IRV)=PRVT(:,:,JK)
ZWR(:,:,JK,IRC)=PRCT(:,:,JK)
ZWR(:,:,JK,IRR)=PRRT(:,:,JK)
@@ -588,18 +627,13 @@ DO JK = 1,KKT
ELSE
ZWR(:,:,JK,IRH)=0.
ENDIF
+
+ !Preset for output 3D variables
IF(OWARM) THEN
PEVAP3D(:,:,JK)=0.
ENDIF
- IF (KSIZE==0) THEN
- PCIT(:,:,JK) = 0.
- ENDIF
- IF (LLHLC) THEN
- ZHLC_HCF3D(:,:,JK)=0.
- ZHLC_LCF3D(:,:,JK)=0.
- ZHLC_HRC3D(:,:,JK)=0.
- ZHLC_LRC3D(:,:,JK)=0.
- ENDIF
+ PRAINFR(:,:,JK)=0.
+ ZCITOUT(:,:,JK)=0.
ENDDO
IF(LBU_ENABLE) THEN
@@ -650,12 +684,13 @@ IF(LBU_ENABLE) THEN
ZTOT_RDRYHG(:)=0.
ENDIF
-!IF (LHOOK) CALL DR_HOOK('RAIN_ICE:ANTE_MICRO', 1, ZHOOK_HANDLE1)
!-------------------------------------------------------------------------------
! optimization by looking for locations where
! the microphysical fields are larger than a minimal value only !!!
!
-IF (KSIZE /= COUNT(ODMICRO)) CALL ABOR1('RAIN_ICE : KSIZE /= COUNT(ODMICRO)')
+IF (KSIZE /= COUNT(ODMICRO)) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'RAIN_ICE', 'RAIN_ICE : KSIZE /= COUNT(ODMICRO)')
+ENDIF
IF (KSIZE > 0) THEN
@@ -665,13 +700,14 @@ IF (KSIZE > 0) THEN
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) !Fot the case XMRSTEP/=0. at the same time
+ INB_ITER_MAX=MAX(NMAXITER, INB_ITER_MAX) !For the case XMRSTEP/=0. at the same time
ENDIF
!===============================================================================================================
! Cache-blocking loop :
LLSIGMA_RC=(HSUBG_AUCV_RC=='PDF ' .AND. CSUBG_PR_PDF=='SIGM')
+ LL_AUCV_ADJU=(HSUBG_AUCV_RC=='ADJU' .OR. HSUBG_AUCV_RI=='ADJU')
! starting indexes :
IC=0
@@ -685,7 +721,6 @@ IF (KSIZE > 0) THEN
!
!* 3. PACKING
! --------
- !IF (LHOOK) CALL DR_HOOK('RAIN_ICE:PACK', 0, ZHOOK_HANDLE4)
! Setup packing parameters
OUTER_LOOP: DO JK = ISTK, KKT
@@ -695,41 +730,50 @@ IF (KSIZE > 0) THEN
IF (ODMICRO(JI,JJ,JK)) THEN
IC=IC+1
! Initialization of variables in packed format :
- ZVART(IC,ITH)=PTHT(JI,JJ,JK)
- ZVART(IC,IRV)=PRVT(JI,JJ,JK)
- ZVART(IC,IRC)=PRCT(JI,JJ,JK)
- ZVART(IC,IRR)=PRRT(JI,JJ,JK)
- ZVART(IC,IRI)=PRIT(JI,JJ,JK)
- ZVART(IC,IRS)=PRST(JI,JJ,JK)
- ZVART(IC,IRG)=PRGT(JI,JJ,JK)
+ ZVART(IC, ITH)=PTHT(JI, JJ, JK)
+ ZVART(IC, IRV)=PRVT(JI, JJ, JK)
+ ZVART(IC, IRC)=PRCT(JI, JJ, JK)
+ ZVART(IC, IRR)=PRRT(JI, JJ, JK)
+ ZVART(IC, IRI)=PRIT(JI, JJ, JK)
+ ZVART(IC, IRS)=PRST(JI, JJ, JK)
+ ZVART(IC, IRG)=PRGT(JI, JJ, JK)
IF (KRR==7) THEN
- ZVART(IC,IRH)=PRHT(JI,JJ,JK)
+ ZVART(IC, IRH)=PRHT(JI, JJ, JK)
ENDIF
IF (GEXT_TEND) THEN
- ZEXTPK(IC,ITH)=PTHS(JI,JJ,JK)
- ZEXTPK(IC,IRV)=PRVS(JI,JJ,JK)
- ZEXTPK(IC,IRC)=PRCS(JI,JJ,JK)
- ZEXTPK(IC,IRR)=PRRS(JI,JJ,JK)
- ZEXTPK(IC,IRI)=PRIS(JI,JJ,JK)
- ZEXTPK(IC,IRS)=PRSS(JI,JJ,JK)
- ZEXTPK(IC,IRG)=PRGS(JI,JJ,JK)
+ !The th tendency is not related to a mixing ratio change, there is no exn/exnref issue here
+ ZEXTPK(IC, ITH)=PTHS(JI, JJ, JK)
+ ZEXTPK(IC, IRV)=PRVS(JI, JJ, JK)
+ ZEXTPK(IC, IRC)=PRCS(JI, JJ, JK)
+ ZEXTPK(IC, IRR)=PRRS(JI, JJ, JK)
+ ZEXTPK(IC, IRI)=PRIS(JI, JJ, JK)
+ ZEXTPK(IC, IRS)=PRSS(JI, JJ, JK)
+ ZEXTPK(IC, IRG)=PRGS(JI, JJ, JK)
IF (KRR==7) THEN
- ZEXTPK(IC,IRH)=PRHS(JI,JJ,JK)
+ ZEXTPK(IC, IRH)=PRHS(JI, JJ, JK)
ENDIF
- !The th tendency is not related to a mixing ratio change, there is no exn/exnref issue here
ENDIF
- ZCIT (IC)=PCIT (JI,JJ,JK)
- ZCF (IC)=PCLDFR (JI,JJ,JK)
- ZRHODREF (IC)=PRHODREF(JI,JJ,JK)
- ZPRES (IC)=PPABST (JI,JJ,JK)
- ZEXN (IC)=PEXN (JI,JJ,JK)
+ ZCIT (IC)=PCIT (JI, JJ, JK)
+ ZCF (IC)=PCLDFR (JI, JJ, JK)
+ ZRHODREF (IC)=PRHODREF(JI, JJ, JK)
+ ZPRES (IC)=PPABST (JI, JJ, JK)
+ ZEXN (IC)=PEXN (JI, JJ, JK)
IF(LLSIGMA_RC) THEN
- ZSIGMA_RC(IC)=PSIGS (JI,JJ,JK)
+ ZSIGMA_RC(IC)=PSIGS (JI, JJ, JK)
+ ENDIF
+ IF (LL_AUCV_ADJU) THEN
+ ZHLC_HCF(IC) = PHLC_HCF(JI, JJ, JK)
+ ZHLC_HRC(IC) = PHLC_HRC(JI, JJ, JK)
+ ZHLI_HCF(IC) = PHLI_HCF(JI, JJ, JK)
+ ZHLI_HRI(IC) = PHLI_HRI(JI, JJ, JK)
ENDIF
! Save indices for later usages:
I1(IC) = JI
I2(IC) = JJ
I3(IC) = JK
+ I1TOT(JMICRO+IC-1)=JI
+ I2TOT(JMICRO+IC-1)=JJ
+ I3TOT(JMICRO+IC-1)=JK
IF (IC==IMICRO) THEN
! the end of the chunk has been reached, then reset the starting index :
ISTI=JI+1
@@ -766,39 +810,44 @@ IF (KSIZE > 0) THEN
ENDDO OUTER_LOOP
IF (GEXT_TEND) THEN
- DO JL = 1,IMICRO
- ZEXTPK(JL,ITH)=ZEXTPK(JL,ITH)-ZVART(JL,ITH)*ZINV_TSTEP
- ZEXTPK(JL,IRV)=ZEXTPK(JL,IRV)-ZVART(JL,IRV)*ZINV_TSTEP
- ZEXTPK(JL,IRC)=ZEXTPK(JL,IRC)-ZVART(JL,IRC)*ZINV_TSTEP
- ZEXTPK(JL,IRR)=ZEXTPK(JL,IRR)-ZVART(JL,IRR)*ZINV_TSTEP
- ZEXTPK(JL,IRI)=ZEXTPK(JL,IRI)-ZVART(JL,IRI)*ZINV_TSTEP
- ZEXTPK(JL,IRS)=ZEXTPK(JL,IRS)-ZVART(JL,IRS)*ZINV_TSTEP
- ZEXTPK(JL,IRG)=ZEXTPK(JL,IRG)-ZVART(JL,IRG)*ZINV_TSTEP
- IF (KRR==7) THEN
- ZEXTPK(JL,IRH)=ZEXTPK(JL,IRH)-ZVART(JL,IRH)*ZINV_TSTEP
- ENDIF
- ENDDO
+ DO JV=0, KRR
+ DO JL=1, IMICRO
+ ZEXTPK(JL, JV)=ZEXTPK(JL, JV)-ZVART(JL, JV)*ZINV_TSTEP
+ ENDDO
+ ENDDO
ENDIF
IF (LLSIGMA_RC) THEN
- DO JL = 1,IMICRO
+ DO JL=1, IMICRO
ZSIGMA_RC(JL)=ZSIGMA_RC(JL)*2.
ENDDO
ENDIF
-
- !IF (LHOOK) CALL DR_HOOK('RAIN_ICE:PACK', 1, ZHOOK_HANDLE4)
+ IF (LL_AUCV_ADJU) THEN
+ DO JL=1, IMICRO
+ ZHLC_LRC(JL) = ZVART(JL, IRC) - ZHLC_HRC(JL)
+ ZHLI_LRI(JL) = ZVART(JL, IRI) - ZHLI_HRI(JL)
+ IF(ZVART(JL, IRC)>0.) THEN
+ ZHLC_LCF(JL) = ZCF(JL)- ZHLC_HCF(JL)
+ ELSE
+ ZHLC_LCF(JL)=0.
+ ENDIF
+ IF(ZVART(JL, IRI)>0.) THEN
+ ZHLI_LCF(JL) = ZCF(JL)- ZHLI_HCF(JL)
+ ELSE
+ ZHLI_LCF(JL)=0.
+ ENDIF
+ ENDDO
+ ENDIF
!-------------------------------------------------------------------------------
!
!* 4. LOOP
! ----
!
- !IF (LHOOK) CALL DR_HOOK('RAIN_ICE:IMICRO', 0, ZHOOK_HANDLE2)
-
IITER(1:IMICRO)=0
ZTIME(1:IMICRO)=0. ! Current integration time (all points may have a different integration time)
DO WHILE(ANY(ZTIME(1:IMICRO)<PTSTEP)) ! Loop to *really* compute tendencies
-
+
IF(XTSTEP_TS/=0.) THEN
! In this case we need to remember the time when tendencies were computed
! because when time has evolved more than a limit, we must re-compute tendencies
@@ -813,18 +862,17 @@ IF (KSIZE > 0) THEN
ENDIF
ENDDO
LL_ANY_ITER=ANY(IITER(1:IMICRO) < INB_ITER_MAX)
- LLCPZ0T(:)=XMRSTEP/=0. .AND. LL_ANY_ITER
+ LLCPZ0RT=.TRUE.
LSOFT=.FALSE. ! We *really* compute the tendencies
-
- DO WHILE(ANY(ZCOMPUTE(1:IMICRO)==1.)) ! Loop to adjust tendencies when we cross the 0°C or when a species disappears
+ DO WHILE(ANY(ZCOMPUTE(1:IMICRO)==1.)) ! Loop to adjust tendencies when we cross the 0°C or when a species disappears
!$OMP SIMD
DO JL=1, IMICRO
ZSUM2(JL)=SUM(ZVART(JL,IRI:KRR))
ENDDO
DO JL=1, IMICRO
- ZDEVIDE=(XCPD + XCPV*ZVART(JL,IRV) + XCL*(ZVART(JL,IRC)+ZVART(JL,IRR)) + XCI*ZSUM2(JL)) * ZEXN(JL)
- ZZT(JL) = ZVART(JL,ITH) * ZEXN(JL)
+ ZDEVIDE=(XCPD + XCPV*ZVART(JL, IRV) + XCL*(ZVART(JL, IRC)+ZVART(JL, IRR)) + XCI*ZSUM2(JL)) * ZEXN(JL)
+ ZZT(JL) = ZVART(JL, ITH) * ZEXN(JL)
ZLSFACT(JL)=(XLSTT+(XCPV-XCI)*(ZZT(JL)-XTT)) / ZDEVIDE
ZLVFACT(JL)=(XLVTT+(XCPV-XCL)*(ZZT(JL)-XTT)) / ZDEVIDE
ENDDO
@@ -832,7 +880,7 @@ IF (KSIZE > 0) THEN
!*** 4.1 Tendencies computation
!
! Tendencies are *really* computed when LSOFT==.FALSE. and only adjusted otherwise
- CALL ICE4_TENDENCIES(KPROMA,IMICRO, IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, KKT, KKL, &
+ CALL ICE4_TENDENCIES(KPROMA, IMICRO, IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, KKT, KKL, &
&KRR, LSOFT, ZCOMPUTE, &
&OWARM, CSUBG_RC_RR_ACCR, CSUBG_RR_EVAP, &
&HSUBG_AUCV_RC, HSUBG_AUCV_RI, CSUBG_PR_PDF, &
@@ -840,7 +888,6 @@ IF (KSIZE > 0) THEN
&ZPRES, ZCF, ZSIGMA_RC, &
&ZCIT, &
&ZZT, ZVART, &
- &PRRT, &
&ZRVHENI_MR, ZRRHONG_MR, ZRIMLTC_MR, ZRSRIMCG_MR, &
&ZRCHONI, ZRVDEPS, ZRIAGGS, ZRIAUTS, ZRVDEPG, &
&ZRCAUTR, ZRCACCR, ZRREVAV, &
@@ -857,9 +904,9 @@ IF (KSIZE > 0) THEN
! External tendencies
IF(GEXT_TEND) THEN
- DO JV=0,KRR
+ DO JV=0, KRR
DO JL=1, IMICRO
- ZA(JL,JV) = ZA(JL,JV) + ZEXTPK(JL,JV)
+ ZA(JL, JV) = ZA(JL, JV) + ZEXTPK(JL, JV)
ENDDO
ENDDO
ENDIF
@@ -874,14 +921,14 @@ IF (KSIZE > 0) THEN
!We need to adjust tendencies when temperature reaches 0
IF(LFEEDBACKT) THEN
DO JL=1, IMICRO
- !Is ZB(:,ITH) enough to change temperature sign?
+ !Is ZB(:, ITH) enough to change temperature sign?
ZX=XTT/ZEXN(JL)
- IF ( (ZVART(JL,ITH) - ZX)*(ZVART(JL,ITH) + ZB(JL,ITH) - ZX) < 0.) THEN
+ IF ((ZVART(JL, ITH) - ZX) * (ZVART(JL, ITH) + ZB(JL, ITH) - ZX) < 0.) THEN
ZMAXTIME(JL)=0.
- ENDIF
- !Can ZA(:,ITH) make temperature change of sign?
+ ENDIF
+ !Can ZA(:, ITH) make temperature change of sign?
IF (ABS(ZA(JL,ITH)) > 1.E-20 ) THEN
- ZTIME_THRESHOLD= (ZX - ZB(JL,ITH) - ZVART(JL,ITH))/ZA(JL,ITH)
+ ZTIME_THRESHOLD=(ZX - ZB(JL, ITH) - ZVART(JL, ITH))/ZA(JL, ITH)
IF (ZTIME_THRESHOLD > 0.) THEN
ZMAXTIME(JL)=MIN(ZMAXTIME(JL), ZTIME_THRESHOLD)
ENDIF
@@ -889,26 +936,26 @@ IF (KSIZE > 0) THEN
ENDDO
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)
- DO JV=1,KRR
+ !We need to adjust tendencies when a species disappears
+ !When a species is missing, only the external tendencies can be negative (and we must keep track of it)
+ DO JV=1, KRR
DO JL=1, IMICRO
- IF ( ZA(JL,JV) < -1.E-20 .AND. ZVART(JL,JV) > XRTMIN(JV) ) THEN
- ZMAXTIME(JL)=MIN(ZMAXTIME(JL),-(ZB(JL,JV)+ZVART(JL,JV))/ZA(JL,JV))
+ IF (ZA(JL, JV) < -1.E-20 .AND. ZVART(JL, JV) > XRTMIN(JV)) THEN
+ ZMAXTIME(JL)=MIN(ZMAXTIME(JL), -(ZB(JL, JV)+ZVART(JL, JV))/ZA(JL, JV))
ENDIF
ENDDO
ENDDO
- !We must recompute tendencies when the end of the sub-timestep is reached
+ !We stop when the end of the timestep is reached
DO JL=1, IMICRO
- !We stop when the end of the timestep is reached
IF (ZTIME(JL)+ZMAXTIME(JL) >= PTSTEP) THEN
ZCOMPUTE(JL)=0.
ENDIF
ENDDO
+ !We must recompute tendencies when the end of the sub-timestep is reached
IF (XTSTEP_TS/=0.) THEN
DO JL=1, IMICRO
- IF ((IITER(JL) < INB_ITER_MAX).AND.(ZTIME(JL)+ZMAXTIME(JL) > ZTIME_LASTCALL(JL)+ZTSTEP)) THEN
+ IF ((IITER(JL) < INB_ITER_MAX) .AND. (ZTIME(JL)+ZMAXTIME(JL) > ZTIME_LASTCALL(JL)+ZTSTEP)) THEN
ZMAXTIME(JL)=ZTIME_LASTCALL(JL)-ZTIME(JL)+ZTSTEP
ZCOMPUTE(JL)=0.
ENDIF
@@ -916,34 +963,33 @@ IF (KSIZE > 0) THEN
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)
+ !When a species 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 species was already missing)
IF (XMRSTEP/=0.) THEN
IF (LL_ANY_ITER) THEN
- ! In this case we need to remember the mixing ratios used to compute the tendencies
+ ! In this case we need to remember the initial mixing ratios used to compute the tendencies
! because when mixing ratio has evolved more than a threshold, we must re-compute tendencies
+ ! Thus, at first iteration (ie when LLCPZ0RT=.TRUE.) we copy ZVART into Z0RT
DO JV=1,KRR
- IF (LLCPZ0T(JV)) Z0T(:)=ZVART(:,JV)
- DO JL=1,IMICRO
+ IF (LLCPZ0RT) Z0RT(1:IMICRO, JV)=ZVART(1:IMICRO, JV)
+ DO JL=1, IMICRO
IF (IITER(JL)<INB_ITER_MAX .AND. ABS(ZA(JL,JV))>1.E-20) THEN
- ZTHRESHOLD(JL)=(XMRSTEP+Z0T(JL)-ZVART(JL,JV)-ZB(JL,JV))/ZA(JL,JV)
+ ZTIME_THRESHOLD=(SIGN(1., ZA(JL, JV))*XMRSTEP+Z0RT(JL, JV)-ZVART(JL, JV)-ZB(JL, JV))/ZA(JL, JV)
ELSE
- ZTHRESHOLD(JL)=-1.
+ ZTIME_THRESHOLD=-1.
ENDIF
- ENDDO
- DO JL=1,IMICRO
- IF ( ZTHRESHOLD(JL)>=0. .AND. ZTHRESHOLD(JL)<ZMAXTIME(JL) .AND. (ZVART(JL,JV)>XRTMIN(6) .OR. ZA(JL,JV)>0.) ) THEN
- ZMAXTIME(JL)=MIN(ZMAXTIME(JL),ZTHRESHOLD(JL))
+ IF (ZTIME_THRESHOLD>=0 .AND. ZTIME_THRESHOLD<ZMAXTIME(JL) .AND. (ZVART(JL, JV)>XRTMIN(JV) .OR. ZA(JL, JV)>0.)) THEN
+ ZMAXTIME(JL)=MIN(ZMAXTIME(JL), ZTIME_THRESHOLD)
ZCOMPUTE(JL)=0.
ENDIF
ENDDO
ENDDO
- LLCPZ0T(:)=.FALSE.
+ LLCPZ0RT=.FALSE.
!$OMP SIMD
DO JL=1,IMICRO
ZMAXB(JL)=MAXVAL(ABS(ZB(JL,1:KRR)))
ENDDO
- DO JL=1,IMICRO
+ DO JL=1, IMICRO
IF (IITER(JL)<INB_ITER_MAX .AND. ZMAXB(JL)>XMRSTEP) THEN
ZMAXTIME(JL)=0.
ZCOMPUTE(JL)=0.
@@ -954,9 +1000,9 @@ IF (KSIZE > 0) THEN
!
!*** 4.3 New values of variables for next iteration
!
- DO JV=0,KRR
+ DO JV=0, KRR
DO JL=1, IMICRO
- ZVART(JL,JV)=ZVART(JL,JV)+ZA(JL,JV)*ZMAXTIME(JL)+ZB(JL,JV)
+ ZVART(JL, JV)=ZVART(JL, JV)+ZA(JL, JV)*ZMAXTIME(JL)+ZB(JL, JV)
ENDDO
ENDDO
DO JL=1, IMICRO
@@ -969,51 +1015,51 @@ IF (KSIZE > 0) THEN
!
IF(LBU_ENABLE) THEN
DO JL=1, IMICRO
- ZTOT_RVHENI(JMICRO+JL-1)=ZTOT_RVHENI(JMICRO+JL-1)+ZRVHENI_MR(JL)
- ZTOT_RCHONI(JMICRO+JL-1)=ZTOT_RCHONI(JMICRO+JL-1)+ZRCHONI(JL)*ZMAXTIME(JL)
- ZTOT_RRHONG(JMICRO+JL-1)=ZTOT_RRHONG(JMICRO+JL-1)+ZRRHONG_MR(JL)
- ZTOT_RVDEPS(JMICRO+JL-1)=ZTOT_RVDEPS(JMICRO+JL-1)+ZRVDEPS(JL)*ZMAXTIME(JL)
- ZTOT_RIAGGS(JMICRO+JL-1)=ZTOT_RIAGGS(JMICRO+JL-1)+ZRIAGGS(JL)*ZMAXTIME(JL)
- ZTOT_RIAUTS(JMICRO+JL-1)=ZTOT_RIAUTS(JMICRO+JL-1)+ZRIAUTS(JL)*ZMAXTIME(JL)
- ZTOT_RVDEPG(JMICRO+JL-1)=ZTOT_RVDEPG(JMICRO+JL-1)+ZRVDEPG(JL)*ZMAXTIME(JL)
- ZTOT_RCAUTR(JMICRO+JL-1)=ZTOT_RCAUTR(JMICRO+JL-1)+ZRCAUTR(JL)*ZMAXTIME(JL)
- ZTOT_RCACCR(JMICRO+JL-1)=ZTOT_RCACCR(JMICRO+JL-1)+ZRCACCR(JL)*ZMAXTIME(JL)
- ZTOT_RREVAV(JMICRO+JL-1)=ZTOT_RREVAV(JMICRO+JL-1)+ZRREVAV(JL)*ZMAXTIME(JL)
- ZTOT_RCRIMSS(JMICRO+JL-1)=ZTOT_RCRIMSS(JMICRO+JL-1)+ZRCRIMSS(JL)*ZMAXTIME(JL)
- ZTOT_RCRIMSG(JMICRO+JL-1)=ZTOT_RCRIMSG(JMICRO+JL-1)+ZRCRIMSG(JL)*ZMAXTIME(JL)
- ZTOT_RSRIMCG(JMICRO+JL-1)=ZTOT_RSRIMCG(JMICRO+JL-1)+ZRSRIMCG(JL)*ZMAXTIME(JL)+ZRSRIMCG_MR(JL)
- ZTOT_RRACCSS(JMICRO+JL-1)=ZTOT_RRACCSS(JMICRO+JL-1)+ZRRACCSS(JL)*ZMAXTIME(JL)
- ZTOT_RRACCSG(JMICRO+JL-1)=ZTOT_RRACCSG(JMICRO+JL-1)+ZRRACCSG(JL)*ZMAXTIME(JL)
- ZTOT_RSACCRG(JMICRO+JL-1)=ZTOT_RSACCRG(JMICRO+JL-1)+ZRSACCRG(JL)*ZMAXTIME(JL)
- ZTOT_RSMLTG(JMICRO+JL-1)=ZTOT_RSMLTG(JMICRO+JL-1)+ZRSMLTG(JL)*ZMAXTIME(JL)
- ZTOT_RCMLTSR(JMICRO+JL-1)=ZTOT_RCMLTSR(JMICRO+JL-1)+ZRCMLTSR(JL)*ZMAXTIME(JL)
- ZTOT_RICFRRG(JMICRO+JL-1)=ZTOT_RICFRRG(JMICRO+JL-1)+ZRICFRRG(JL)*ZMAXTIME(JL)
- ZTOT_RRCFRIG(JMICRO+JL-1)=ZTOT_RRCFRIG(JMICRO+JL-1)+ZRRCFRIG(JL)*ZMAXTIME(JL)
- ZTOT_RICFRR(JMICRO+JL-1)=ZTOT_RICFRR(JMICRO+JL-1)+ZRICFRR(JL)*ZMAXTIME(JL)
- ZTOT_RCWETG(JMICRO+JL-1)=ZTOT_RCWETG(JMICRO+JL-1)+ZRCWETG(JL)*ZMAXTIME(JL)
- ZTOT_RIWETG(JMICRO+JL-1)=ZTOT_RIWETG(JMICRO+JL-1)+ZRIWETG(JL)*ZMAXTIME(JL)
- ZTOT_RRWETG(JMICRO+JL-1)=ZTOT_RRWETG(JMICRO+JL-1)+ZRRWETG(JL)*ZMAXTIME(JL)
- ZTOT_RSWETG(JMICRO+JL-1)=ZTOT_RSWETG(JMICRO+JL-1)+ZRSWETG(JL)*ZMAXTIME(JL)
- ZTOT_RWETGH(JMICRO+JL-1)=ZTOT_RWETGH(JMICRO+JL-1)+ZRWETGH(JL)*ZMAXTIME(JL)+ZRWETGH_MR(JL)
- ZTOT_RCDRYG(JMICRO+JL-1)=ZTOT_RCDRYG(JMICRO+JL-1)+ZRCDRYG(JL)*ZMAXTIME(JL)
- ZTOT_RIDRYG(JMICRO+JL-1)=ZTOT_RIDRYG(JMICRO+JL-1)+ZRIDRYG(JL)*ZMAXTIME(JL)
- ZTOT_RRDRYG(JMICRO+JL-1)=ZTOT_RRDRYG(JMICRO+JL-1)+ZRRDRYG(JL)*ZMAXTIME(JL)
- ZTOT_RSDRYG(JMICRO+JL-1)=ZTOT_RSDRYG(JMICRO+JL-1)+ZRSDRYG(JL)*ZMAXTIME(JL)
- ZTOT_RGMLTR(JMICRO+JL-1)=ZTOT_RGMLTR(JMICRO+JL-1)+ZRGMLTR(JL)*ZMAXTIME(JL)
- ZTOT_RCWETH(JMICRO+JL-1)=ZTOT_RCWETH(JMICRO+JL-1)+ZRCWETH(JL)*ZMAXTIME(JL)
- ZTOT_RIWETH(JMICRO+JL-1)=ZTOT_RIWETH(JMICRO+JL-1)+ZRIWETH(JL)*ZMAXTIME(JL)
- ZTOT_RSWETH(JMICRO+JL-1)=ZTOT_RSWETH(JMICRO+JL-1)+ZRSWETH(JL)*ZMAXTIME(JL)
- ZTOT_RGWETH(JMICRO+JL-1)=ZTOT_RGWETH(JMICRO+JL-1)+ZRGWETH(JL)*ZMAXTIME(JL)
- ZTOT_RRWETH(JMICRO+JL-1)=ZTOT_RRWETH(JMICRO+JL-1)+ZRRWETH(JL)*ZMAXTIME(JL)
- ZTOT_RCDRYH(JMICRO+JL-1)=ZTOT_RCDRYH(JMICRO+JL-1)+ZRCDRYH(JL)*ZMAXTIME(JL)
- ZTOT_RIDRYH(JMICRO+JL-1)=ZTOT_RIDRYH(JMICRO+JL-1)+ZRIDRYH(JL)*ZMAXTIME(JL)
- ZTOT_RSDRYH(JMICRO+JL-1)=ZTOT_RSDRYH(JMICRO+JL-1)+ZRSDRYH(JL)*ZMAXTIME(JL)
- ZTOT_RRDRYH(JMICRO+JL-1)=ZTOT_RRDRYH(JMICRO+JL-1)+ZRRDRYH(JL)*ZMAXTIME(JL)
- ZTOT_RGDRYH(JMICRO+JL-1)=ZTOT_RGDRYH(JMICRO+JL-1)+ZRGDRYH(JL)*ZMAXTIME(JL)
- ZTOT_RDRYHG(JMICRO+JL-1)=ZTOT_RDRYHG(JMICRO+JL-1)+ZRDRYHG(JL)*ZMAXTIME(JL)
- ZTOT_RHMLTR(JMICRO+JL-1)=ZTOT_RHMLTR(JMICRO+JL-1)+ZRHMLTR(JL)*ZMAXTIME(JL)
- ZTOT_RIMLTC(JMICRO+JL-1)=ZTOT_RIMLTC(JMICRO+JL-1)+ZRIMLTC_MR(JL)
- ZTOT_RCBERI(JMICRO+JL-1)=ZTOT_RCBERI(JMICRO+JL-1)+ZRCBERI(JL)*ZMAXTIME(JL)
+ ZTOT_RVHENI (JMICRO+JL-1)=ZTOT_RVHENI (JMICRO+JL-1)+ZRVHENI_MR(JL)
+ ZTOT_RCHONI (JMICRO+JL-1)=ZTOT_RCHONI (JMICRO+JL-1)+ZRCHONI (JL)*ZMAXTIME(JL)
+ ZTOT_RRHONG (JMICRO+JL-1)=ZTOT_RRHONG (JMICRO+JL-1)+ZRRHONG_MR(JL)
+ ZTOT_RVDEPS (JMICRO+JL-1)=ZTOT_RVDEPS (JMICRO+JL-1)+ZRVDEPS (JL)*ZMAXTIME(JL)
+ ZTOT_RIAGGS (JMICRO+JL-1)=ZTOT_RIAGGS (JMICRO+JL-1)+ZRIAGGS (JL)*ZMAXTIME(JL)
+ ZTOT_RIAUTS (JMICRO+JL-1)=ZTOT_RIAUTS (JMICRO+JL-1)+ZRIAUTS (JL)*ZMAXTIME(JL)
+ ZTOT_RVDEPG (JMICRO+JL-1)=ZTOT_RVDEPG (JMICRO+JL-1)+ZRVDEPG (JL)*ZMAXTIME(JL)
+ ZTOT_RCAUTR (JMICRO+JL-1)=ZTOT_RCAUTR (JMICRO+JL-1)+ZRCAUTR (JL)*ZMAXTIME(JL)
+ ZTOT_RCACCR (JMICRO+JL-1)=ZTOT_RCACCR (JMICRO+JL-1)+ZRCACCR (JL)*ZMAXTIME(JL)
+ ZTOT_RREVAV (JMICRO+JL-1)=ZTOT_RREVAV (JMICRO+JL-1)+ZRREVAV (JL)*ZMAXTIME(JL)
+ ZTOT_RCRIMSS(JMICRO+JL-1)=ZTOT_RCRIMSS(JMICRO+JL-1)+ZRCRIMSS (JL)*ZMAXTIME(JL)
+ ZTOT_RCRIMSG(JMICRO+JL-1)=ZTOT_RCRIMSG(JMICRO+JL-1)+ZRCRIMSG (JL)*ZMAXTIME(JL)
+ ZTOT_RSRIMCG(JMICRO+JL-1)=ZTOT_RSRIMCG(JMICRO+JL-1)+ZRSRIMCG (JL)*ZMAXTIME(JL)+ZRSRIMCG_MR(JL)
+ ZTOT_RRACCSS(JMICRO+JL-1)=ZTOT_RRACCSS(JMICRO+JL-1)+ZRRACCSS (JL)*ZMAXTIME(JL)
+ ZTOT_RRACCSG(JMICRO+JL-1)=ZTOT_RRACCSG(JMICRO+JL-1)+ZRRACCSG (JL)*ZMAXTIME(JL)
+ ZTOT_RSACCRG(JMICRO+JL-1)=ZTOT_RSACCRG(JMICRO+JL-1)+ZRSACCRG (JL)*ZMAXTIME(JL)
+ ZTOT_RSMLTG (JMICRO+JL-1)=ZTOT_RSMLTG (JMICRO+JL-1)+ZRSMLTG (JL)*ZMAXTIME(JL)
+ ZTOT_RCMLTSR(JMICRO+JL-1)=ZTOT_RCMLTSR(JMICRO+JL-1)+ZRCMLTSR (JL)*ZMAXTIME(JL)
+ ZTOT_RICFRRG(JMICRO+JL-1)=ZTOT_RICFRRG(JMICRO+JL-1)+ZRICFRRG (JL)*ZMAXTIME(JL)
+ ZTOT_RRCFRIG(JMICRO+JL-1)=ZTOT_RRCFRIG(JMICRO+JL-1)+ZRRCFRIG (JL)*ZMAXTIME(JL)
+ ZTOT_RICFRR (JMICRO+JL-1)=ZTOT_RICFRR (JMICRO+JL-1)+ZRICFRR (JL)*ZMAXTIME(JL)
+ ZTOT_RCWETG (JMICRO+JL-1)=ZTOT_RCWETG (JMICRO+JL-1)+ZRCWETG (JL)*ZMAXTIME(JL)
+ ZTOT_RIWETG (JMICRO+JL-1)=ZTOT_RIWETG (JMICRO+JL-1)+ZRIWETG (JL)*ZMAXTIME(JL)
+ ZTOT_RRWETG (JMICRO+JL-1)=ZTOT_RRWETG (JMICRO+JL-1)+ZRRWETG (JL)*ZMAXTIME(JL)
+ ZTOT_RSWETG (JMICRO+JL-1)=ZTOT_RSWETG (JMICRO+JL-1)+ZRSWETG (JL)*ZMAXTIME(JL)
+ ZTOT_RWETGH (JMICRO+JL-1)=ZTOT_RWETGH (JMICRO+JL-1)+ZRWETGH (JL)*ZMAXTIME(JL)+ZRWETGH_MR(JL)
+ ZTOT_RCDRYG (JMICRO+JL-1)=ZTOT_RCDRYG (JMICRO+JL-1)+ZRCDRYG (JL)*ZMAXTIME(JL)
+ ZTOT_RIDRYG (JMICRO+JL-1)=ZTOT_RIDRYG (JMICRO+JL-1)+ZRIDRYG (JL)*ZMAXTIME(JL)
+ ZTOT_RRDRYG (JMICRO+JL-1)=ZTOT_RRDRYG (JMICRO+JL-1)+ZRRDRYG (JL)*ZMAXTIME(JL)
+ ZTOT_RSDRYG (JMICRO+JL-1)=ZTOT_RSDRYG (JMICRO+JL-1)+ZRSDRYG (JL)*ZMAXTIME(JL)
+ ZTOT_RGMLTR (JMICRO+JL-1)=ZTOT_RGMLTR (JMICRO+JL-1)+ZRGMLTR (JL)*ZMAXTIME(JL)
+ ZTOT_RCWETH (JMICRO+JL-1)=ZTOT_RCWETH (JMICRO+JL-1)+ZRCWETH (JL)*ZMAXTIME(JL)
+ ZTOT_RIWETH (JMICRO+JL-1)=ZTOT_RIWETH (JMICRO+JL-1)+ZRIWETH (JL)*ZMAXTIME(JL)
+ ZTOT_RSWETH (JMICRO+JL-1)=ZTOT_RSWETH (JMICRO+JL-1)+ZRSWETH (JL)*ZMAXTIME(JL)
+ ZTOT_RGWETH (JMICRO+JL-1)=ZTOT_RGWETH (JMICRO+JL-1)+ZRGWETH (JL)*ZMAXTIME(JL)
+ ZTOT_RRWETH (JMICRO+JL-1)=ZTOT_RRWETH (JMICRO+JL-1)+ZRRWETH (JL)*ZMAXTIME(JL)
+ ZTOT_RCDRYH (JMICRO+JL-1)=ZTOT_RCDRYH (JMICRO+JL-1)+ZRCDRYH (JL)*ZMAXTIME(JL)
+ ZTOT_RIDRYH (JMICRO+JL-1)=ZTOT_RIDRYH (JMICRO+JL-1)+ZRIDRYH (JL)*ZMAXTIME(JL)
+ ZTOT_RSDRYH (JMICRO+JL-1)=ZTOT_RSDRYH (JMICRO+JL-1)+ZRSDRYH (JL)*ZMAXTIME(JL)
+ ZTOT_RRDRYH (JMICRO+JL-1)=ZTOT_RRDRYH (JMICRO+JL-1)+ZRRDRYH (JL)*ZMAXTIME(JL)
+ ZTOT_RGDRYH (JMICRO+JL-1)=ZTOT_RGDRYH (JMICRO+JL-1)+ZRGDRYH (JL)*ZMAXTIME(JL)
+ ZTOT_RDRYHG (JMICRO+JL-1)=ZTOT_RDRYHG (JMICRO+JL-1)+ZRDRYHG (JL)*ZMAXTIME(JL)
+ ZTOT_RHMLTR (JMICRO+JL-1)=ZTOT_RHMLTR (JMICRO+JL-1)+ZRHMLTR (JL)*ZMAXTIME(JL)
+ ZTOT_RIMLTC (JMICRO+JL-1)=ZTOT_RIMLTC (JMICRO+JL-1)+ZRIMLTC_MR(JL)
+ ZTOT_RCBERI (JMICRO+JL-1)=ZTOT_RCBERI (JMICRO+JL-1)+ZRCBERI (JL)*ZMAXTIME(JL)
ENDDO
ENDIF
!
@@ -1025,59 +1071,70 @@ IF (KSIZE > 0) THEN
IF(GEXT_TEND) THEN
!Z..T variables contain the external tendency, we substract it
- DO JV=0,KRR
+ DO JV=0, KRR
DO JL=1, IMICRO
- ZVART(JL,JV) = ZVART(JL,JV) - ZEXTPK(JL,JV) * PTSTEP
+ ZVART(JL, JV) = ZVART(JL, JV) - ZEXTPK(JL, JV) * PTSTEP
ENDDO
ENDDO
ENDIF
- !IF (LHOOK) CALL DR_HOOK('RAIN_ICE:IMICRO', 1, ZHOOK_HANDLE2)
!-------------------------------------------------------------------------------
!
!* 5. UNPACKING DIAGNOSTICS
! ---------------------
-
- !IF (LHOOK) CALL DR_HOOK('RAIN_ICE:UNPACK', 0, ZHOOK_HANDLE5)
- !
- DO JL = 1,IMICRO
- PCIT (I1(JL),I2(JL),I3(JL))=ZCIT (JL)
+!
+ DO JL=1, IMICRO
+ ZCITOUT (I1(JL),I2(JL),I3(JL))=ZCIT (JL)
IF(OWARM) THEN
PEVAP3D(I1(JL),I2(JL),I3(JL))=ZRREVAV(JL)
ENDIF
- IF (LLHLC) THEN
- ZHLC_HCF3D(I1(JL),I2(JL),I3(JL))=ZHLC_HCF(JL)
- ZHLC_LCF3D(I1(JL),I2(JL),I3(JL))=ZHLC_LCF(JL)
- ZHLC_HRC3D(I1(JL),I2(JL),I3(JL))=ZHLC_HRC(JL)
- ZHLC_LRC3D(I1(JL),I2(JL),I3(JL))=ZHLC_LRC(JL)
- ENDIF
- !ZWR variables will contain the new S variables values
- ZWR(I1(JL),I2(JL),I3(JL),1)=ZVART(JL,1)
- ZWR(I1(JL),I2(JL),I3(JL),2)=ZVART(JL,2)
- ZWR(I1(JL),I2(JL),I3(JL),3)=ZVART(JL,3)
- ZWR(I1(JL),I2(JL),I3(JL),4)=ZVART(JL,4)
- ZWR(I1(JL),I2(JL),I3(JL),5)=ZVART(JL,5)
- ZWR(I1(JL),I2(JL),I3(JL),6)=ZVART(JL,6)
+ ZWR(I1(JL),I2(JL),I3(JL),IRV)=ZVART(JL, IRV)
+ ZWR(I1(JL),I2(JL),I3(JL),IRC)=ZVART(JL, IRC)
+ ZWR(I1(JL),I2(JL),I3(JL),IRR)=ZVART(JL, IRR)
+ ZWR(I1(JL),I2(JL),I3(JL),IRI)=ZVART(JL, IRI)
+ ZWR(I1(JL),I2(JL),I3(JL),IRS)=ZVART(JL, IRS)
+ ZWR(I1(JL),I2(JL),I3(JL),IRG)=ZVART(JL, IRG)
IF (KRR==7) THEN
- ZWR(I1(JL),I2(JL),I3(JL),7)=ZVART(JL,7)
+ ZWR(I1(JL),I2(JL),I3(JL),IRH)=ZVART(JL, IRH)
ENDIF
ENDDO
- !
- !IF (LHOOK) CALL DR_HOOK('RAIN_ICE:UNPACK', 1, ZHOOK_HANDLE5)
ENDDO ! JMICRO
ENDIF ! KSIZE > 0
+PCIT(:,:,:)=ZCITOUT(:,:,:)
!==========================================================================================================
-!IF (LHOOK) CALL DR_HOOK('RAIN_ICE:POST_MICRO', 0, ZHOOK_HANDLE3)
+!
!* 6. COMPUTES THE SLOW COLD PROCESS SOURCES OUTSIDE OF ODMICRO POINTS
! ----------------------------------------------------------------
!
+CALL ICE4_NUCLEATION_WRAPPER(KIT, KJT, KKT, .NOT. ODMICRO, &
+ PTHT, PPABST, PRHODREF, PEXN, ZZ_LSFACT, ZT, &
+ PRVT, &
+ PCIT, ZZ_RVHENI_MR)
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. TOTAL TENDENCIES
+! ----------------
+!
+!
+!*** 7.1 total tendencies limited by available species
+!
DO JK = 1, KKT
DO JJ = 1, KJT
+!DEC$ IVDEP
DO JI = 1, KIT
+ !LV/LS
+ ZZ_LSFACT(JI,JJ,JK)=ZZ_LSFACT(JI,JJ,JK)/PEXNREF(JI,JJ,JK)
+ ZZ_LVFACT(JI,JJ,JK)=ZZ_LVFACT(JI,JJ,JK)/PEXNREF(JI,JJ,JK)
+
+ !Tendency dure to nucleation on non ODMICRO points
+ ZZ_RVHENI(JI,JJ,JK) = MIN(PRVS(JI,JJ,JK), ZZ_RVHENI_MR(JI,JJ,JK)/PTSTEP)
+
+ !Hydrometeor tendencies is the difference between old state and new state (can be negative)
ZWR(JI,JJ,JK,IRV)=(ZWR(JI,JJ,JK,IRV)-PRVT(JI,JJ,JK))*ZINV_TSTEP
ZWR(JI,JJ,JK,IRC)=(ZWR(JI,JJ,JK,IRC)-PRCT(JI,JJ,JK))*ZINV_TSTEP
ZWR(JI,JJ,JK,IRR)=(ZWR(JI,JJ,JK,IRR)-PRRT(JI,JJ,JK))*ZINV_TSTEP
@@ -1087,399 +1144,386 @@ DO JK = 1, KKT
IF(KRR==7) THEN
ZWR(JI,JJ,JK,IRH)=(ZWR(JI,JJ,JK,IRH)-PRHT(JI,JJ,JK))*ZINV_TSTEP
ENDIF
- ENDDO
- ENDDO
-ENDDO
-!
-CALL ICE4_NUCLEATION_WRAPPER(KIT, KJT, KKT, .NOT. ODMICRO, &
- PTHT, PPABST, PRHODREF, PEXN, ZZ_LSFACT/PEXN, ZT, &
- PRVT, &
- PCIT, ZZ_RVHENI_MR)
-DO JK = 1, KKT
- DO JJ = 1, KJT
-!DEC$ IVDEP
- DO JI = 1, KIT
- ZZ_LSFACT(JI,JJ,JK)=ZZ_LSFACT(JI,JJ,JK)/PEXNREF(JI,JJ,JK)
- ZZ_LVFACT(JI,JJ,JK)=ZZ_LVFACT(JI,JJ,JK)/PEXNREF(JI,JJ,JK)
- ZZ_RVHENI = MIN(PRVS(JI,JJ,JK), ZZ_RVHENI_MR(JI,JJ,JK)/PTSTEP)
- PRIS(JI,JJ,JK)=PRIS(JI,JJ,JK)+ZZ_RVHENI
- PRVS(JI,JJ,JK)=PRVS(JI,JJ,JK)-ZZ_RVHENI
- PTHS(JI,JJ,JK)=PTHS(JI,JJ,JK) + ZZ_RVHENI*ZZ_LSFACT(JI,JJ,JK)
-!-------------------------------------------------------------------------------
-!* 7. TOTAL TENDENCIES
- ZWR(JI,JJ,JK,ITH) = (ZWR(JI,JJ,JK,IRC)+ZWR(JI,JJ,JK,IRR))*ZZ_LVFACT(JI,JJ,JK) &
- & + (ZWR(JI,JJ,JK,IRI)+ZWR(JI,JJ,JK,IRS)+ZWR(JI,JJ,JK,IRG)+ZWR(JI,JJ,JK,IRH))*ZZ_LSFACT(JI,JJ,JK)
- ZWR(JI,JJ,JK,ITH) = PTHS(JI,JJ,JK) + ZWR(JI,JJ,JK,ITH)
+
+ !Theta tendency computed from hydrometeors tendencies
+ ZWR(JI,JJ,JK, ITH) = (ZWR(JI,JJ,JK,IRC)+ZWR(JI,JJ,JK,IRR))*ZZ_LVFACT(JI,JJ,JK)+ &
+ & (ZWR(JI,JJ,JK,IRI)+ZWR(JI,JJ,JK,IRS)+ZWR(JI,JJ,JK,IRG)+ &
+ & ZWR(JI,JJ,JK,IRH))*ZZ_LSFACT(JI,JJ,JK)
+
!We apply these tendencies to the S variables
- ZWR(JI,JJ,JK,IRV) = PRVS(JI,JJ,JK) + ZWR(JI,JJ,JK,IRV)
- ZWR(JI,JJ,JK,IRC) = PRCS(JI,JJ,JK) + ZWR(JI,JJ,JK,IRC)
- ZWR(JI,JJ,JK,IRR) = PRRS(JI,JJ,JK) + ZWR(JI,JJ,JK,IRR)
- ZWR(JI,JJ,JK,IRI) = PRIS(JI,JJ,JK) + ZWR(JI,JJ,JK,IRI)
- ZWR(JI,JJ,JK,IRS) = PRSS(JI,JJ,JK) + ZWR(JI,JJ,JK,IRS)
- ZWR(JI,JJ,JK,IRG) = PRGS(JI,JJ,JK) + ZWR(JI,JJ,JK,IRG)
+ !including the nucleation part
+ PTHS(JI,JJ,JK) = PTHS(JI,JJ,JK) + ZWR(JI,JJ,JK,ITH)+ZZ_RVHENI(JI,JJ,JK)*ZZ_LSFACT(JI,JJ,JK)
+ PRVS(JI,JJ,JK) = PRVS(JI,JJ,JK) + ZWR(JI,JJ,JK,IRV)-ZZ_RVHENI(JI,JJ,JK)
+ PRCS(JI,JJ,JK) = PRCS(JI,JJ,JK) + ZWR(JI,JJ,JK,IRC)
+ PRRS(JI,JJ,JK) = PRRS(JI,JJ,JK) + ZWR(JI,JJ,JK,IRR)
+ PRIS(JI,JJ,JK) = PRIS(JI,JJ,JK) + ZWR(JI,JJ,JK,IRI)+ZZ_RVHENI(JI,JJ,JK)
+ PRSS(JI,JJ,JK) = PRSS(JI,JJ,JK) + ZWR(JI,JJ,JK,IRS)
+ PRGS(JI,JJ,JK) = PRGS(JI,JJ,JK) + ZWR(JI,JJ,JK,IRG)
IF (KRR==7) THEN
- ZWR(JI,JJ,JK,IRH) = PRHS(JI,JJ,JK) + ZWR(JI,JJ,JK,IRH)
+ PRHS(JI,JJ,JK) = PRHS(JI,JJ,JK) + ZWR(JI,JJ,JK,IRH)
ENDIF
ENDDO
ENDDO
ENDDO
-!We correct negativities with conservation
-CALL CORRECT_NEGATIVITIES(KIT, KJT, KKT, KRR, ZWR(:,:,:,IRV), ZWR(:,:,:,IRC), ZWR(:,:,:,IRR), ZWR(:,:,:,IRI), &
- &ZWR(:,:,:,IRS), ZWR(:,:,:,IRG), ZWR(:,:,:,ITH), ZZ_LVFACT, ZZ_LSFACT, ZWR(:,:,:,IRH))
!
!*** 7.2 LBU_ENABLE case
!
IF(LBU_ENABLE) THEN
+ IF (LBUDGET_TH) THEN
+ ZZ_DIFF(:, :, :) = ZZ_LSFACT(:, :, :) - ZZ_LVFACT(:, :, :)
+ END IF
+
ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET(PRVS(:,:,:)*PRHODJ(:,:,:), 6, 'HENU_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'HENU_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RVHENI(JL) * ZINV_TSTEP
+ END DO
+ ZW(:,:,:)=ZW(:,:,:)+ZZ_RVHENI
+ IF (LBUDGET_TH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'HENU', ZW(:, :, :)*ZZ_LSFACT(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RV) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RV), 'HENU', -ZW(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RI) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RI), 'HENU', ZW(:, :, :) *PRHODJ(:, :, :))
ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'HON_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'HON_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RCHONI(JL) * ZINV_TSTEP
+ END DO
+ IF (LBUDGET_TH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'HON', ZW(:, :, :)*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RC) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RC), 'HON', -ZW(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RI) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RI), 'HON', ZW(:, :, :) *PRHODJ(:, :, :))
ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'SFR_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'SFR_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RRHONG(JL) * ZINV_TSTEP
+ END DO
+ IF (LBUDGET_TH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'SFR', ZW(:, :, :)*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'SFR', -ZW(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'SFR', ZW(:, :, :) *PRHODJ(:, :, :))
ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET(PRVS(:,:,:)*PRHODJ(:,:,:), 6, 'DEPS_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'DEPS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RVDEPS(JL) * ZINV_TSTEP
+ END DO
+ IF (LBUDGET_TH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'DEPS', ZW(:, :, :)*ZZ_LSFACT(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RV) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RV), 'DEPS', -ZW(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RS) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RS), 'DEPS', ZW(:, :, :) *PRHODJ(:, :, :))
ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'AGGS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RIAGGS(JL) * ZINV_TSTEP
+ END DO
+ IF (LBUDGET_RI) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RI), 'AGGS', -ZW(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RS) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RS), 'AGGS', ZW(:, :, :)*PRHODJ(:, :, :))
ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'AUTS_BU_RRS',YDDDH, YDLDDH, YDMDDH)
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RIAUTS(JL) * ZINV_TSTEP
+ END DO
+ IF (LBUDGET_RI) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RI), 'AUTS', -ZW(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RS) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RS), 'AUTS', ZW(:, :, :)*PRHODJ(:, :, :))
ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET(PRVS(:,:,:)*PRHODJ(:,:,:), 6, 'DEPG_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'DEPG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RVDEPG(JL) * ZINV_TSTEP
+ END DO
+ IF (LBUDGET_TH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'DEPG', ZW(:, :, :)*ZZ_LSFACT(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RV) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RV), 'DEPG', -ZW(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'DEPG', ZW(:, :, :) *PRHODJ(:, :, :))
IF(OWARM) THEN
ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'AUTO_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RCAUTR(JL) * ZINV_TSTEP
+ END DO
+ IF (LBUDGET_RC) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RC), 'AUTO', -ZW(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'AUTO', ZW(:, :, :)*PRHODJ(:, :, :))
ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'ACCR_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RCACCR(JL) * ZINV_TSTEP
+ END DO
+ IF (LBUDGET_RC) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RC), 'ACCR', -ZW(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'ACCR', ZW(:, :, :)*PRHODJ(:, :, :))
ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET(PRVS(:,:,:)*PRHODJ(:,:,:), 6, 'REVA_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'REVA_BU_RRR',YDDDH, YDLDDH, YDMDDH)
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RREVAV(JL) * ZINV_TSTEP
+ END DO
+ IF (LBUDGET_TH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'REVA', -ZW(:, :, :)*ZZ_LVFACT(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RV) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RV), 'REVA', ZW(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'REVA', -ZW(:, :, :) *PRHODJ(:, :, :))
ENDIF
- ZW(:,:,:) = 0.
- 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=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=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'RIM_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'RIM_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'RIM_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'RIM_BU_RRG',YDDDH, YDLDDH, YDMDDH)
-
- ZW(:,:,:) = 0.
- 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=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=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
- PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'ACC_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'ACC_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'ACC_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'ACC_BU_RRG',YDDDH, YDLDDH, YDMDDH)
-
- ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RSMLTG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
- PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'CMEL_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'CMEL_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'CMEL_BU_RRR',YDDDH, YDLDDH, YDMDDH)
-
- ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RICFRRG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
- PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = 0.
- 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=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
- PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
- PRRS(:,:,:) = PRRS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'CFRZ_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'CFRZ_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'CFRZ_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'CFRZ_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ ZW1(:,:,:) = 0.
+ DO JL=1, KSIZE
+ ZW1(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RCRIMSS(JL) * ZINV_TSTEP
+ END DO
+ ZW2(:,:,:) = 0.
+ DO JL=1, KSIZE
+ ZW2(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RCRIMSG(JL) * ZINV_TSTEP
+ END DO
+ ZW3(:,:,:) = 0.
+ DO JL=1, KSIZE
+ ZW3(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RSRIMCG(JL) * ZINV_TSTEP
+ END DO
+ IF (LBUDGET_TH) &
+ CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'RIM', (ZW1(:, :, :)+ZW2(:, :, :))*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RC) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RC), 'RIM', (-ZW1(:, :, :)-ZW2(:, :, :))*PRHODJ(:, :, :))
+ IF (LBUDGET_RS) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RS), 'RIM', ( ZW1(:, :, :)-ZW3(:, :, :))*PRHODJ(:, :, :))
+ IF (LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'RIM', ( ZW2(:, :, :)+ZW3(:, :, :))*PRHODJ(:, :, :))
+
+ ZW1(:,:,:) = 0.
+ DO JL=1, KSIZE
+ ZW1(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RRACCSS(JL) * ZINV_TSTEP
+ END DO
+ ZW2(:,:,:) = 0.
+ DO JL=1, KSIZE
+ ZW2(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RRACCSG(JL) * ZINV_TSTEP
+ END DO
+ ZW3(:,:,:) = 0.
+ DO JL=1, KSIZE
+ ZW3(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RSACCRG(JL) * ZINV_TSTEP
+ END DO
+ IF (LBUDGET_TH) &
+ CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'ACC', (ZW1(:, :, :)+ZW2(:, :, :) )*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'ACC', (-ZW1(:, :, :)-ZW2(:, :, :))*PRHODJ(:, :, :))
+ IF (LBUDGET_RS) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RS), 'ACC', ( ZW1(:, :, :)-ZW3(:, :, :))*PRHODJ(:, :, :))
+ IF (LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'ACC', ( ZW2(:, :, :)+ZW3(:, :, :))*PRHODJ(:, :, :))
ZW(:,:,:) = 0.
- 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=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=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
- PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RSMLTG(JL) * ZINV_TSTEP
+ END DO
+ IF (LBUDGET_RS) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RS), 'CMEL', -ZW(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'CMEL', ZW(:, :, :)*PRHODJ(:, :, :))
ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'WETG_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'WETG_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'WETG_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'WETG_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'WETG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RCMLTSR(JL) * ZINV_TSTEP
+ END DO
+ IF (LBUDGET_RC) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RC), 'CMEL', -ZW(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'CMEL', ZW(:, :, :)*PRHODJ(:, :, :))
+
+ ZW1(:,:,:) = 0.
+ DO JL=1, KSIZE
+ ZW1(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RICFRRG(JL) * ZINV_TSTEP
+ END DO
+ ZW2(:,:,:) = 0.
+ DO JL=1, KSIZE
+ ZW2(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RRCFRIG(JL) * ZINV_TSTEP
+ END DO
+ ZW3(:,:,:) = 0.
+ DO JL=1, KSIZE
+ ZW3(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RICFRR(JL) * ZINV_TSTEP
+ END DO
+ IF (LBUDGET_TH) &
+ CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'CFRZ', ZW2(:, :, :)*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'CFRZ', (-ZW2(:, :, :)+ZW3(:, :, :))*PRHODJ(:, :, :))
+ IF (LBUDGET_RI) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RI), 'CFRZ', (-ZW1(:, :, :)-ZW3(:, :, :))*PRHODJ(:, :, :))
+ IF (LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'CFRZ', ( ZW1(:, :, :)+ZW2(:, :, :))*PRHODJ(:, :, :))
+
+ ZW1(:,:,:) = 0.
+ DO JL=1, KSIZE
+ ZW1(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RCWETG(JL) * ZINV_TSTEP
+ END DO
+ ZW2(:,:,:) = 0.
+ DO JL=1, KSIZE
+ ZW2(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RRWETG(JL) * ZINV_TSTEP
+ END DO
+ ZW3(:,:,:) = 0.
+ DO JL=1, KSIZE
+ ZW3(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RIWETG(JL) * ZINV_TSTEP
+ END DO
+ ZW4(:,:,:) = 0.
+ DO JL=1, KSIZE
+ ZW4(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RSWETG(JL) * ZINV_TSTEP
+ END DO
+ IF (LBUDGET_TH) &
+ CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'WETG', (ZW1(:, :, :)+ZW2(:, :, :))*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RC) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RC), 'WETG', -zw1(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'WETG', -zw2(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RI) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RI), 'WETG', -zw3(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RS) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RS), 'WETG', -zw4(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'WETG', (ZW1(:, :, :)+ZW2(:, :, :)+ZW3(:, :, :)+ZW4(:, :, :)) &
+ & *PRHODJ(:, :, :))
IF(KRR==7) THEN
ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), 12,'GHCV_BU_RRH',YDDDH, YDLDDH, YDMDDH)
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RWETGH(JL) * ZINV_TSTEP
+ END DO
+ IF (LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'GHCV', -ZW(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RH), 'GHCV', ZW(:, :, :)*PRHODJ(:, :, :))
END IF
- ZW(:,:,:) = 0.
- 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=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=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
- PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'DRYG_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'DRYG_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'DRYG_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'DRYG_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'DRYG_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ ZW1(:,:,:) = 0.
+ DO JL=1, KSIZE
+ ZW1(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RCDRYG(JL) * ZINV_TSTEP
+ END DO
+ ZW2(:,:,:) = 0.
+ DO JL=1, KSIZE
+ ZW2(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RRDRYG(JL) * ZINV_TSTEP
+ END DO
+ ZW3(:,:,:) = 0.
+ DO JL=1, KSIZE
+ ZW3(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RIDRYG(JL) * ZINV_TSTEP
+ END DO
+ ZW4(:,:,:) = 0.
+ DO JL=1, KSIZE
+ ZW4(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RSDRYG(JL) * ZINV_TSTEP
+ END DO
+ IF (LBUDGET_TH) &
+ CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'DRYG', (ZW1(:, :, :)+ZW2(:, :, :) )*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RC) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RC), 'DRYG', -zw1(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'DRYG', -zw2(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RI) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RI), 'DRYG', -zw3(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RS) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RS), 'DRYG', -zw4(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'DRYG', (ZW1(:, :, :)+ZW2(:, :, :)+ZW3(:, :, :)+ZW4(:, :, :)) &
+ & *PRHODJ(:, :, :))
ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'GMLT_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'GMLT_BU_RRG',YDDDH, YDLDDH, YDMDDH)
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RGMLTR(JL) * ZINV_TSTEP
+ END DO
+ IF (LBUDGET_TH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'GMLT', -ZW(:, :, :)*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'GMLT', ZW(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'GMLT', -ZW(:, :, :) *PRHODJ(:, :, :))
IF(KRR==7) THEN
- ZW(:,:,:) = 0.
- 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=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=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
- PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RSWETH(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
- PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'WETH_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'WETH_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'WETH_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'WETH_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), 12,'WETH_BU_RRH',YDDDH, YDLDDH, YDMDDH)
-
- ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), 12,'HGCV_BU_RRH',YDDDH, YDLDDH, YDMDDH)
+ ZW1(:,:,:) = 0.
+ DO JL=1, KSIZE
+ ZW1(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RCWETH(JL) * ZINV_TSTEP
+ END DO
+ ZW2(:,:,:) = 0.
+ DO JL=1, KSIZE
+ ZW2(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RRWETH(JL) * ZINV_TSTEP
+ END DO
+ ZW3(:,:,:) = 0.
+ DO JL=1, KSIZE
+ ZW3(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RIWETH(JL) * ZINV_TSTEP
+ END DO
+ ZW4(:,:,:) = 0.
+ DO JL=1, KSIZE
+ ZW4(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RSWETH(JL) * ZINV_TSTEP
+ END DO
+ ZW5(:,:,:) = 0.
+ DO JL=1, KSIZE
+ ZW5(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RGWETH(JL) * ZINV_TSTEP
+ END DO
+ IF (LBUDGET_TH) &
+ CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'WETH', (ZW1(:, :, :)+ZW2(:, :, :))*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RC) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RC), 'WETH', -ZW1(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'WETH', -ZW2(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RI) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RI), 'WETH', -ZW3(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RS) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RS), 'WETH', -ZW4(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'WETH', -ZW5(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RH), 'WETH', (ZW1(:, :, :)+ZW2(:, :, :)+ZW3(:, :, :)+ &
+ &ZW4(:, :, :)+ZW5(:, :, : )) *PRHODJ(:, :, :))
ZW(:,:,:) = 0.
- 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=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=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
- PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RSDRYH(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
- PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RGDRYH(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
- PRGS(:,:,:) = PRGS(:,:,:) - ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'DRYH_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'DRYH_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'DRYH_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'DRYH_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'DRYH_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), 12,'DRYH_BU_RRH',YDDDH, YDLDDH, YDMDDH)
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RGWETH(JL) * ZINV_TSTEP
+ END DO
+ IF (LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'HGCV', -ZW(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RH), 'HGCV', ZW(:, :, :)*PRHODJ(:, :, :))
+
+ ZW1(:,:,:) = 0.
+ DO JL=1, KSIZE
+ ZW1(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RCDRYH(JL) * ZINV_TSTEP
+ END DO
+ ZW2(:,:,:) = 0.
+ DO JL=1, KSIZE
+ ZW2(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RRDRYH(JL) * ZINV_TSTEP
+ END DO
+ ZW3(:,:,:) = 0.
+ DO JL=1, KSIZE
+ ZW3(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RIDRYH(JL) * ZINV_TSTEP
+ END DO
+ ZW4(:,:,:) = 0.
+ DO JL=1, KSIZE
+ ZW4(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RSDRYH(JL) * ZINV_TSTEP
+ END DO
+ ZW5(:,:,:) = 0.
+ DO JL=1, KSIZE
+ ZW5(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RGDRYH(JL) * ZINV_TSTEP
+ END DO
+ ZW6(:,:,:) = 0.
+ DO JL=1, KSIZE
+ ZW6(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RDRYHG(JL) * ZINV_TSTEP
+ END DO
+ IF (LBUDGET_TH) &
+ CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'DRYH', (ZW1(:, :, :)+ZW2(:, :, :))*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RC) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RC), 'DRYH', -ZW1(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'DRYH', -ZW2(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RI) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RI), 'DRYH', -ZW3(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RS) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RS), 'DRYH', -ZW4(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'DRYH', (-ZW5(:, :, :)+ZW6(:, :, : )) *PRHODJ(:, :, :))
+ IF (LBUDGET_RH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RH), 'DRYH', (ZW1(:, :, :)+ZW2(:, :, :)+ZW3(:, :, :)+ &
+ &ZW4(:, :, :)+ZW5(:, :, : )-ZW6(:, :, :)) &
+ & *PRHODJ(:, :, :))
ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'HMLT_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), 12,'HMLT_BU_RRH',YDDDH, YDLDDH, YDMDDH)
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RHMLTR(JL) * ZINV_TSTEP
+ END DO
+ IF (LBUDGET_TH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'HMLT', -ZW(:, :, :)*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'HMLT', ZW(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RH), 'HMLT', -ZW(:, :, :) *PRHODJ(:, :, :))
ENDIF
ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'IMLT_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'IMLT_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RIMLTC(JL) * ZINV_TSTEP
+ END DO
+ IF (LBUDGET_TH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'IMLT', -ZW(:, :, :)*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RC) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RC), 'IMLT', ZW(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RI) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RI), 'IMLT', -ZW(:, :, :) *PRHODJ(:, :, :))
ZW(:,:,:) = 0.
- 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',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'BERFI_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'BERFI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RCBERI(JL) * ZINV_TSTEP
+ END DO
+ IF (LBUDGET_TH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'BERFI', ZW(:, :, :)*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RC) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RC), 'BERFI', -ZW(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RI) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RI), 'BERFI', ZW(:, :, :) *PRHODJ(:, :, :))
+
ENDIF
!
-
!*** 7.3 Final tendencies
!
-DO JK = 1, KKT
- PTHS(:,:,JK) = ZWR(:,:,JK,ITH)
- PRVS(:,:,JK) = ZWR(:,:,JK,IRV)
- PRCS(:,:,JK) = ZWR(:,:,JK,IRC)
- PRRS(:,:,JK) = ZWR(:,:,JK,IRR)
- PRIS(:,:,JK) = ZWR(:,:,JK,IRI)
- PRSS(:,:,JK) = ZWR(:,:,JK,IRS)
- PRGS(:,:,JK) = ZWR(:,:,JK,IRG)
- IF (KRR==7) THEN
- PRHS(:,:,JK) = ZWR(:,:,JK,IRH)
- ENDIF
-ENDDO
+IF (LBU_ENABLE) THEN
+ IF (LBUDGET_TH) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_TH), 'CORR', PTHS(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RV) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RV), 'CORR', PRVS(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RC) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RC), 'CORR', PRCS(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RR), 'CORR', PRSS(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RI) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RI), 'CORR', PRIS(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RS) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RS), 'CORR', PRSS(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RG) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RG), 'CORR', PRGS(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RH), 'CORR', PRHS(:, :, :)*PRHODJ(:, :, :))
+END IF
-IF(LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'CORR_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RV) CALL BUDGET(PRVS(:,:,:)*PRHODJ(:,:,:), 6, 'CORR_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'CORR_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'CORR_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'CORR_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'CORR_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'CORR_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF (KRR==7) THEN
- IF (LBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), 12,'CORR_BU_RRH',YDDDH, YDLDDH, YDMDDH)
- ENDIF
-ENDIF
+!NOTE:
+! This call cannot be moved before the preeceding budget calls because,
+! with AROME, the BUDGET_STORE_INIT does nothing. The equivalent is done only
+! once before the physics call and copies of the S variables evolve automatically
+! internally to the budget (DDH) machinery at each BUDGET_STORE_ADD and
+! BUDGET_STORE_END calls. Thus, the difference between the DDH internal version
+! of the S variables and the S variables used in the folowing BUDGET_STORE_END
+! call must only be due to the correction of negativities.
+!
+!We correct negativities with conservation
+CALL CORRECT_NEGATIVITIES(KIT, KJT, KKT, KRR, PRVS, PRCS, PRRS, &
+ &PRIS, PRSS, PRGS, &
+ &PTHS, ZZ_LVFACT, ZZ_LSFACT, PRHS)
+
+IF (LBU_ENABLE) THEN
+ IF (LBUDGET_TH) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_TH), 'CORR', PTHS(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RV) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RV), 'CORR', PRVS(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RC) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RC), 'CORR', PRCS(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RR), 'CORR', PRRS(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RI) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RI), 'CORR', PRIS(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RS) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RS), 'CORR', PRSS(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RG) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RG), 'CORR', PRGS(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RH), 'CORR', PRHS(:, :, :)*PRHODJ(:, :, :))
+END IF
!
!-------------------------------------------------------------------------------
!
@@ -1490,6 +1534,13 @@ IF(LSEDIM_AFTER) THEN
!
!* 8.1 sedimentation
!
+ IF (LBUDGET_RC .and. osedic) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RC), 'SEDI', PRCS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RR), 'SEDI', PRRS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RI) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RI), 'SEDI', PRIS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RS) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RS), 'SEDI', PRSS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RG) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RG), 'SEDI', PRGS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RH), 'SEDI', PRHS(:, :, :) * PRHODJ(:, :, :))
+
IF(HSEDIM=='STAT') THEN
IF (KRR==7) THEN
DO JK = 1, KKT
@@ -1505,8 +1556,7 @@ IF(LSEDIM_AFTER) THEN
ENDDO
ENDDO
CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, &
- &PDZZ, &
+ &PTSTEP, KRR, OSEDIC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, ZRCT, PRRS, ZRRT, PRIS, ZRIT,&
&PRSS, ZRST, PRGS, ZRGT,&
@@ -1526,8 +1576,7 @@ IF(LSEDIM_AFTER) THEN
ENDDO
ENDDO
CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, &
- &PDZZ, &
+ &PTSTEP, KRR, OSEDIC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, ZRCT, PRRS, ZRRT, PRIS, ZRIT,&
&PRSS, ZRST, PRGS, ZRGT,&
@@ -1536,13 +1585,12 @@ IF(LSEDIM_AFTER) THEN
&PFPR=PFPR)
ENDIF
PINPRS(:,:) = PINPRS(:,:) + ZINPRI(:,:)
- !No negativity correction here as we apply sedimentation on ZR.T variables
+ !No negativity correction here as we apply sedimentation on PR.S*PTSTEP variables
ELSEIF(HSEDIM=='SPLI') THEN
!SR: It *seems* that we must have two separate calls for ifort
IF(KRR==7) THEN
CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, &
- &PDZZ, &
+ &PTSTEP, KRR, OSEDIC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
@@ -1550,8 +1598,7 @@ IF(LSEDIM_AFTER) THEN
&PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR)
ELSE
CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, &
- &PDZZ, &
+ &PTSTEP, KRR, OSEDIC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
@@ -1564,37 +1611,35 @@ IF(LSEDIM_AFTER) THEN
! It is initialized with the m.r. at T and is modified by two tendencies:
! sedimentation tendency and an external tendency which represents all other
! processes (mainly advection and microphysical processes). If both tendencies
- ! are negative, sedimentation can remove a specie at a given sub-timestep. From
+ ! are negative, sedimentation can remove a species at a given sub-timestep. From
! this point sedimentation stops for the remaining sub-timesteps but the other tendency
! will be still active and will lead to negative values.
- ! We could prevent the algorithm to not consume too much a specie, instead we apply
+ ! We could prevent the algorithm to not consume too much a species, instead we apply
! a correction here.
CALL CORRECT_NEGATIVITIES(KIT, KJT, KKT, KRR, PRVS, PRCS, PRRS, &
&PRIS, PRSS, PRGS, &
&PTHS, ZZ_LVFACT, ZZ_LSFACT, PRHS)
ELSE
- WRITE(*,*) ' STOP'
- WRITE(*,*) ' NO SEDIMENTATION SCHEME FOR HSEDIM=', HSEDIM
- CALL ABORT
- STOP
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'RAIN_ICE', 'no sedimentation scheme for HSEDIM='//HSEDIM)
END IF
!
!* 8.2 budget storage
!
- IF (LBUDGET_RC .AND. OSEDIC) &
- CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'SEDI_BU_RRC',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'SEDI_BU_RRR',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'SEDI_BU_RRI',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:), 10, 'SEDI_BU_RRS',YDDDH, YDLDDH, YDMDDH)
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:), 11, 'SEDI_BU_RRG',YDDDH, YDLDDH, YDMDDH)
- IF ( KRR == 7 .AND. LBUDGET_RH) &
- CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:), 12, 'SEDI_BU_RRH',YDDDH, YDLDDH, YDMDDH)
- !
- !sedimentation of rain fraction
- IF (LLRAIN_FRACTION) THEN
- CALL ICE4_RAINFR_VERT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, KKT, KKL, ZRAINFR3D, PRRS(:,:,:)*PTSTEP)
+ IF (LBUDGET_RC .AND. OSEDIC) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RC), 'SEDI', PRCS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RR), 'SEDI', PRRS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RI) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RI), 'SEDI', PRIS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RS) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RS), 'SEDI', PRSS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RG) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RG), 'SEDI', PRGS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RH), 'SEDI', PRHS(:, :, :) * PRHODJ(:, :, :))
+
+ !"sedimentation" of rain fraction
+ IF (PRESENT(PRHS)) THEN
+ CALL ICE4_RAINFR_VERT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, KKT, KKL, PRAINFR, PRRS(:,:,:)*PTSTEP, &
+ &PRSS(:,:,:)*PTSTEP, PRGS(:,:,:)*PTSTEP, PRHS(:,:,:)*PTSTEP)
+ ELSE
+ CALL ICE4_RAINFR_VERT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, KKT, KKL, PRAINFR, PRRS(:,:,:)*PTSTEP, &
+ &PRSS(:,:,:)*PTSTEP, PRGS(:,:,:)*PTSTEP)
ENDIF
-
ENDIF
!
!-------------------------------------------------------------------------------
@@ -1603,19 +1648,22 @@ ENDIF
! -------------------------------------
!
IF (LDEPOSC) THEN !cloud water deposition on vegetation
+ IF (LBU_ENABLE .AND. LBUDGET_RC) &
+ & CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RC), 'DEPO', PRCS(:, :, :)*PRHODJ(:, :, :))
+
DO JJ = 1, KJT
!DEC$ IVDEP
DO JI = 1, KIT
- PRCS(JI,JJ,IKB) = PRCS(JI,JJ,IKB) - XVDEPOSC * PRCT(JI,JJ,IKB) / PDZZ(JI,JJ,IKB)
- PINPRC(JI,JJ) = PINPRC(JI,JJ) + XVDEPOSC * PRCT(JI,JJ,IKB) * PRHODREF(JI,JJ,IKB)/XRHOLW
+ PINDEP(JI, JJ) = XVDEPOSC * PRCT(JI, JJ, IKB) * PRHODREF(JI, JJ, IKB) / XRHOLW
+ PRCS(JI, JJ, IKB) = PRCS(JI, JJ, IKB) - XVDEPOSC * PRCT(JI, JJ, IKB) / PDZZ(JI, JJ, IKB)
+ PINPRC(JI, JJ) = PINPRC(JI, JJ) + PINDEP(JI, JJ)
ENDDO
ENDDO
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'DEPO_BU_RRC',YDDDH, YDLDDH, YDMDDH)
+ IF (LBU_ENABLE .AND. LBUDGET_RC) &
+ & CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RC), 'DEPO', PRCS(:, :, :)*PRHODJ(:, :, :))
ENDIF
-!IF (LHOOK) CALL DR_HOOK('RAIN_ICE:POST_MICRO', 1, ZHOOK_HANDLE3)
-
IF (LHOOK) CALL DR_HOOK('RAIN_ICE', 1, ZHOOK_HANDLE)
!
CONTAINS
@@ -1638,47 +1686,47 @@ CONTAINS
IF (LHOOK) CALL DR_HOOK('RAIN_ICE:CORRECT_NEGATIVITIES', 0, ZHOOK_HANDLE)
!
!We correct negativities with conservation
- ! 1) deal with negative values for mixing ratio, except for vapor
DO JK = 1, KKT
DO JJ = 1, KJT
DO JI = 1, KIT
- ZW =PRC(JI,JJ,JK)-MAX(PRC(JI,JJ,JK), 0.)
+ ! 1) deal with negative values for mixing ratio, except for vapor
+ ZW =PRC(JI,JJ,JK)-MAX(PRC(JI,JJ,JK), 0.)
PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW
PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW*PLVFACT(JI,JJ,JK)
PRC(JI,JJ,JK)=PRC(JI,JJ,JK)-ZW
- ZW =PRR(JI,JJ,JK)-MAX(PRR(JI,JJ,JK), 0.)
+ ZW =PRR(JI,JJ,JK)-MAX(PRR(JI,JJ,JK), 0.)
PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW
PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW*PLVFACT(JI,JJ,JK)
PRR(JI,JJ,JK)=PRR(JI,JJ,JK)-ZW
- ZW =PRI(JI,JJ,JK)-MAX(PRI(JI,JJ,JK), 0.)
+ ZW =PRI(JI,JJ,JK)-MAX(PRI(JI,JJ,JK), 0.)
PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW
PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW*PLSFACT(JI,JJ,JK)
PRI(JI,JJ,JK)=PRI(JI,JJ,JK)-ZW
- ZW =PRS(JI,JJ,JK)-MAX(PRS(JI,JJ,JK), 0.)
+ ZW =PRS(JI,JJ,JK)-MAX(PRS(JI,JJ,JK), 0.)
PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW
PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW*PLSFACT(JI,JJ,JK)
PRS(JI,JJ,JK)=PRS(JI,JJ,JK)-ZW
- ZW =PRG(JI,JJ,JK)-MAX(PRG(JI,JJ,JK), 0.)
+ ZW =PRG(JI,JJ,JK)-MAX(PRG(JI,JJ,JK), 0.)
PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW
PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW*PLSFACT(JI,JJ,JK)
PRG(JI,JJ,JK)=PRG(JI,JJ,JK)-ZW
IF(KRR==7) THEN
- ZW =PRH(JI,JJ,JK)-MAX(PRH(JI,JJ,JK), 0.)
+ ZW =PRH(JI,JJ,JK)-MAX(PRH(JI,JJ,JK), 0.)
PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW
PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW*PLSFACT(JI,JJ,JK)
PRH(JI,JJ,JK)=PRH(JI,JJ,JK)-ZW
ENDIF
- ! 2) deal with negative vapor mixing ratio
+ ! 2) deal with negative vapor mixing ratio
! for rc and ri, we keep ice fraction constant
ZW=MIN(1., MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.) / &
- &MAX(PRC(JI,JJ,JK)+PRI(JI,JJ,JK), 1.E-20)) ! Proportion of rc+ri to convert into rv
+ &MAX(PRC(JI,JJ,JK)+PRI(JI,JJ,JK), 1.E-20)) ! Proportion of rc+ri to convert into rv
PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW* &
&(PRC(JI,JJ,JK)*PLVFACT(JI,JJ,JK)+PRI(JI,JJ,JK)*PLSFACT(JI,JJ,JK))
PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW*(PRC(JI,JJ,JK)+PRI(JI,JJ,JK))
@@ -1686,26 +1734,26 @@ CONTAINS
PRI(JI,JJ,JK)=(1.-ZW)*PRI(JI,JJ,JK)
ZW=MIN(MAX(PRR(JI,JJ,JK), 0.), &
- &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rr to convert into rv
+ &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rr to convert into rv
PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW
PRR(JI,JJ,JK)=PRR(JI,JJ,JK)-ZW
PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW*PLVFACT(JI,JJ,JK)
ZW=MIN(MAX(PRS(JI,JJ,JK), 0.), &
- &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rs to convert into rv
+ &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rs to convert into rv
PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW
PRS(JI,JJ,JK)=PRS(JI,JJ,JK)-ZW
PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW*PLSFACT(JI,JJ,JK)
ZW=MIN(MAX(PRG(JI,JJ,JK), 0.), &
- &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rg to convert into rv
+ &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rg to convert into rv
PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW
PRG(JI,JJ,JK)=PRG(JI,JJ,JK)-ZW
PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW*PLSFACT(JI,JJ,JK)
IF(KRR==7) THEN
ZW=MIN(MAX(PRH(JI,JJ,JK), 0.), &
- &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rh to convert into rv
+ &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rh to convert into rv
PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW
PRH(JI,JJ,JK)=PRH(JI,JJ,JK)-ZW
PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW*PLSFACT(JI,JJ,JK)
@@ -1713,7 +1761,6 @@ CONTAINS
ENDDO
ENDDO
ENDDO
-
!
IF (LHOOK) CALL DR_HOOK('RAIN_ICE:CORRECT_NEGATIVITIES', 1, ZHOOK_HANDLE)
!
diff --git a/src/mesonh/micro/rain_ice_red.f90 b/src/mesonh/micro/rain_ice_red.f90
index a4bba492156a17a7de4f7c417a672a22dc10fefd..e3d0fabd52c8b09aafead4b71716d4e091b87a83 100644
--- a/src/mesonh/micro/rain_ice_red.f90
+++ b/src/mesonh/micro/rain_ice_red.f90
@@ -1,3 +1,11 @@
+
+!Note de phasage pour Méso-NH: dans resolved_cloud, il faut:
+! - récuperer le tbudgets de modd_budget pour le passer ici, kbudgets vaut size(tbudgets)
+! - passer OCND2=.FALSE.
+! - passer à KPROMA la même valeur que KSIZE (bug sinon)
+! - créer des tableaux temporaires pour PSIGS, PINDEP, PINPRC pour gérer les options
+
+
!MNH_LIC Copyright 1995-2021 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
@@ -8,22 +16,26 @@
! ########################
!
INTERFACE
- SUBROUTINE RAIN_ICE_RED ( KIT, KJT, KKT, KSIZE, &
- OSEDIC, HSEDIM, HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
- OWARM, KKA, KKU, KKL, &
- PTSTEP, KRR, ODMICRO, PEXN, &
+ SUBROUTINE RAIN_ICE_RED ( KPROMA, KIT, KJT, KKT, KSIZE, &
+ OSEDIC, OCND2, HSEDIM, HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
+ OWARM, KKA, KKU, KKL, &
+ PTSTEP, KRR, ODMICRO, PEXN, &
PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
- PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF,&
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
- PINPRC,PINPRR, PINPRR3D, PEVAP3D, &
+ PINPRC,PINPRR, PEVAP3D, &
PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, PSEA, PTOWN, &
- PRHT, PRHS, PINPRH, PFPR )
+ PRHT, PRHS, PINPRH, PFPR, &
+ TBUDGETS, KBUDGETS)
!
!
+USE MODD_BUDGET, ONLY: TBUDGETDATA
+INTEGER, INTENT(IN) :: KPROMA ! cache-blocking factor for microphysic loop
INTEGER, INTENT(IN) :: KIT, KJT, KKT ! arrays size
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
+LOGICAL :: OCND2 ! Logical switch to separate liquid and ice
CHARACTER(LEN=4), INTENT(IN) :: HSEDIM ! Sedimentation scheme
CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC ! Switch for rc->rr Subgrid autoconversion
! Kind of Subgrid autoconversion method
@@ -72,15 +84,14 @@ REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. s
REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
!
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC! Cloud instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRC! Cloud instant precip
REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR! Rain instant precip
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PINPRR3D! Rain inst precip 3D
REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PEVAP3D! Rain evap profile
REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS! Snow instant precip
REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG! Graupel instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINDEP ! Cloud instant deposition
REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRAINFR
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PSIGS ! Sigma_s at t
REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PTOWN! Fraction that is town
REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
@@ -88,21 +99,25 @@ REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. so
REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH! Hail instant precip
REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
!
+TYPE(TBUDGETDATA), OPTIONAL, DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+INTEGER, INTENT(IN) : KBUDGETS
+!
END SUBROUTINE RAIN_ICE_RED
END INTERFACE
END MODULE MODI_RAIN_ICE_RED
! ######spl
- SUBROUTINE RAIN_ICE_RED ( KIT, KJT, KKT, KSIZE, &
- OSEDIC, HSEDIM, HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
- OWARM,KKA,KKU,KKL,&
+ SUBROUTINE RAIN_ICE_RED ( KPROMA, KIT, KJT, KKT, KSIZE, &
+ OSEDIC, OCND2, HSEDIM, HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
+ OWARM, KKA, KKU, KKL, &
PTSTEP, KRR, ODMICRO, PEXN, &
PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
- PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
- PINPRC,PINPRR, PINPRR3D, PEVAP3D, &
+ PINPRC, PINPRR, PEVAP3D, &
PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, PSEA, PTOWN, &
- PRHT, PRHS, PINPRH, PFPR )
+ PRHT, PRHS, PINPRH, PFPR, &
+ TBUDGETS, KBUDGETS)
! ######################################################################
!
!!**** * - compute the explicit microphysical sources
@@ -257,6 +272,7 @@ END MODULE MODI_RAIN_ICE_RED
! P. Wautelet 17/01/2020: move Quicksort to tools.f90
! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
! P. Wautelet 25/02/2020: bugfix: add missing budget: WETH_BU_RRG
+!! R. El Khatib 24-Aug-2021 Optimizations
!-----------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -265,16 +281,14 @@ END MODULE MODI_RAIN_ICE_RED
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-use modd_budget, only: lbu_enable, &
- lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, &
- NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, &
- tbudgets
+USE MODD_BUDGET, ONLY: TBUDGETDATA, LBU_ENABLE, &
+ & LBUDGET_TH, LBUDGET_RV, LBUDGET_RC, LBUDGET_RR, LBUDGET_RI, LBUDGET_RS, LBUDGET_RG, LBUDGET_RH, &
+ & NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH
USE MODD_CST, ONLY: XCI, XCL, XCPD, XCPV, XLSTT, XLVTT, XTT, XRHOLW
-USE MODD_PARAMETERS, ONLY: JPVEXT, XUNDEF
+USE MODD_PARAMETERS, ONLY: JPVEXT
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_RAIN_ICE_DESCR, ONLY: XRTMIN
-USE MODD_VAR_ll, ONLY: IP
USE MODD_FIELDS_ADDRESS, ONLY : & ! common fields adress
& ITH, & ! Potential temperature
& IRV, & ! Water vapor
@@ -284,27 +298,29 @@ USE MODD_FIELDS_ADDRESS, ONLY : & ! common fields adress
& IRS, & ! Snow/aggregate
& IRG, & ! Graupel
& IRH ! Hail
-use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end
+
+USE MODE_BUDGET, ONLY: BUDGET_STORE_ADD, BUDGET_STORE_INIT, BUDGET_STORE_END
USE MODE_ll
-USE MODE_MSG
-use mode_tools, only: Countjv
+USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
-USE MODI_ICE4_RAINFR_VERT
+USE MODE_ICE4_RAINFR_VERT, ONLY: ICE4_RAINFR_VERT
USE MODE_ICE4_SEDIMENTATION_STAT, ONLY: ICE4_SEDIMENTATION_STAT
USE MODE_ICE4_SEDIMENTATION_SPLIT, ONLY: ICE4_SEDIMENTATION_SPLIT
USE MODE_ICE4_SEDIMENTATION_SPLIT_MOMENTUM, ONLY: ICE4_SEDIMENTATION_SPLIT_MOMENTUM
USE MODE_ICE4_NUCLEATION_WRAPPER, ONLY: ICE4_NUCLEATION_WRAPPER
USE MODE_ICE4_TENDENCIES, ONLY: ICE4_TENDENCIES
-
+!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
!
!
+INTEGER, INTENT(IN) :: KPROMA ! cache-blocking factor for microphysic loop
INTEGER, INTENT(IN) :: KIT, KJT, KKT ! arrays size
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
+LOGICAL :: OCND2 ! Logical switch to separate liquid and ice
CHARACTER(LEN=4), INTENT(IN) :: HSEDIM ! Sedimentation scheme
CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC ! Kind of Subgrid autoconversion method
CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI ! Kind of Subgrid autoconversion method
@@ -347,15 +363,14 @@ REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. sou
REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
!
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC! Cloud instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRC! Cloud instant precip
REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR! Rain instant precip
-REAL, DIMENSION(KIT,KJT,KKT),INTENT(OUT) :: PINPRR3D! Rain inst precip 3D
REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PEVAP3D! Rain evap profile
REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS! Snow instant precip
REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG! Graupel instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud instant deposition
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRAINFR
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at t
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRAINFR !Precipitation fraction
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PSIGS ! Sigma_s at t
REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PTOWN! Fraction that is town
REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
@@ -363,8 +378,14 @@ REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. so
REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH! Hail instant precip
REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
!
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
+!
!* 0.2 Declarations of local variables :
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+INTEGER :: IIU
+INTEGER :: IJU
INTEGER :: IIB ! Define the domain where is
INTEGER :: IIE ! the microphysical sources have to be computed
INTEGER :: IJB !
@@ -373,44 +394,76 @@ INTEGER :: IKB, IKTB !
INTEGER :: IKE, IKTE !
!
INTEGER :: JI, JJ, JK
-!
-!For packing
-INTEGER :: IMICRO ! Case r_x>0 locations
-INTEGER, DIMENSION(KSIZE) :: I1,I2,I3 ! Used to replace the COUNT
-INTEGER :: JL ! and PACK intrinsics
+INTEGER :: ISTI, ISTJ, ISTK
!
!Arrays for nucleation call outisde of ODMICRO points
REAL, DIMENSION(KIT, KJT, KKT) :: ZW ! work array
REAL, DIMENSION(KIT, KJT, KKT) :: ZT ! Temperature
-REAL, DIMENSION(KIT, KJT, KKT) :: &
- & ZZ_RVHENI_MR, & ! heterogeneous nucleation mixing ratio change
- & ZZ_RVHENI ! heterogeneous nucleation
-real, dimension(:,:,:), allocatable :: zw1, zw2, zw3, zw4, zw5, zw6 !Work arrays
-real, dimension(:,:,:), allocatable :: zz_diff
-REAL, DIMENSION(KIT, KJT, KKT) :: ZZ_LVFACT, ZZ_LSFACT
-!
+REAL, DIMENSION(KIT, KJT, KKT) :: ZZ_RVHENI_MR, & ! heterogeneous nucleation mixing ratio change
+ & ZZ_RVHENI ! heterogeneous nucleation
+REAL, DIMENSION(MERGE(KIT, 0, LBU_ENABLE), &
+ &MERGE(KJT, 0, LBU_ENABLE), &
+ &MERGE(KKT, 0, LBU_ENABLE)) :: ZW1, ZW2, ZW3, ZW4, ZW5, ZW6 !Work arrays
+REAL, DIMENSION(KIT, KJT, KKT) :: ZZ_LVFACT, ZZ_LSFACT, ZZ_DIFF
+!
+REAL, DIMENSION(KIT,KJT,KKT) :: ZRCT ! Cloud water m.r. source at t
+REAL, DIMENSION(KIT,KJT,KKT) :: ZRRT ! Rain water m.r. source at t
+REAL, DIMENSION(KIT,KJT,KKT) :: ZRIT ! Pristine ice m.r. source at t
+REAL, DIMENSION(KIT,KJT,KKT) :: ZRST ! Snow/aggregate m.r. source at t
+REAL, DIMENSION(KIT,KJT,KKT) :: ZRGT ! Graupel m.r. source at t
+REAL, DIMENSION(KIT,KJT,KKT) :: ZRHT ! Hail m.r. source at t
+REAL, DIMENSION(KIT,KJT,KKT) :: ZCITOUT ! Output value for CIT
+
!Diagnostics
-REAL, DIMENSION(KIT, KJT, KKT) :: &
- & 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
- & ZHLI_HCF3D,& ! HLCLOUDS cloud fraction in high ice content part
- & ZHLI_LCF3D,& ! HLCLOUDS cloud fraction in low ice content part
- & ZHLI_HRI3D,& ! HLCLOUDS cloud water content in high ice content
- & ZHLI_LRI3D ! HLCLOUDS cloud water content in high ice content
REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2)) :: ZINPRI ! Pristine ice instant precip
!
-!Packed variables
-REAL, DIMENSION(KSIZE) :: 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
- & ZRST, & ! Snow/aggregate m.r. at t
- & ZRGT, & ! Graupel m.r. at t
- & ZRHT, & ! Hail m.r. at t
+LOGICAL :: GEXT_TEND
+LOGICAL :: LSOFT ! Must we really compute tendencies or only adjust them to new T variables
+INTEGER :: INB_ITER_MAX ! Maximum number of iterations (with real tendencies computation)
+REAL :: ZW1D
+REAL :: ZTSTEP ! length of sub-timestep in case of time splitting
+REAL :: ZINV_TSTEP ! Inverse ov PTSTEP
+REAL :: ZTIME_THRESHOLD ! Time to reach threshold
+!For total tendencies computation
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3),0:7) :: ZWR
+!
+!Output packed total mixing ratio change (for budgets only)
+REAL, DIMENSION(KSIZE) :: ZTOT_RVHENI, & ! heterogeneous nucleation mixing ratio change
+ & ZTOT_RCHONI, & ! Homogeneous nucleation
+ & ZTOT_RRHONG, & ! Spontaneous freezing mixing ratio change
+ & ZTOT_RVDEPS, & ! Deposition on r_s,
+ & ZTOT_RIAGGS, & ! Aggregation on r_s
+ & ZTOT_RIAUTS, & ! Autoconversion of r_i for r_s production
+ & ZTOT_RVDEPG, & ! Deposition on r_g
+ & ZTOT_RCAUTR, & ! Autoconversion of r_c for r_r production
+ & ZTOT_RCACCR, & ! Accretion of r_c for r_r production
+ & ZTOT_RREVAV, & ! Evaporation of r_r
+ & ZTOT_RCRIMSS, ZTOT_RCRIMSG, ZTOT_RSRIMCG, & ! Cloud droplet riming of the aggregates
+ & ZTOT_RIMLTC, & ! Cloud ice melting mixing ratio change
+ & ZTOT_RCBERI, & ! Bergeron-Findeisen effect
+ & ZTOT_RHMLTR, & ! Melting of the hailstones
+ & ZTOT_RSMLTG, & ! Conversion-Melting of the aggregates
+ & ZTOT_RCMLTSR, & ! Cloud droplet collection onto aggregates by positive temperature
+ & ZTOT_RRACCSS, ZTOT_RRACCSG, ZTOT_RSACCRG, & ! Rain accretion onto the aggregates
+ & ZTOT_RICFRRG, ZTOT_RRCFRIG, ZTOT_RICFRR, & ! Rain contact freezing
+ & ZTOT_RCWETG, ZTOT_RIWETG, ZTOT_RRWETG, ZTOT_RSWETG, & ! Graupel wet growth
+ & ZTOT_RCDRYG, ZTOT_RIDRYG, ZTOT_RRDRYG, ZTOT_RSDRYG, & ! Graupel dry growth
+ & ZTOT_RWETGH, & ! Conversion of graupel into hail
+ & ZTOT_RGMLTR, & ! Melting of the graupel
+ & ZTOT_RCWETH, ZTOT_RIWETH, ZTOT_RSWETH, ZTOT_RGWETH, ZTOT_RRWETH, & ! Dry growth of hailstone
+ & ZTOT_RCDRYH, ZTOT_RIDRYH, ZTOT_RSDRYH, ZTOT_RRDRYH, ZTOT_RGDRYH, & ! Wet growth of hailstone
+ & ZTOT_RDRYHG ! Conversion of hailstone into graupel
+!
+!For packing
+INTEGER :: IMICRO ! Case r_x>0 locations
+INTEGER :: JL, JV
+REAL, DIMENSION(KPROMA) :: ZTIME ! Current integration time (starts with 0 and ends with PTSTEP)
+REAL, DIMENSION(KPROMA) :: &
+ & ZMAXTIME, & ! Time on which we can apply the current tendencies
+ & ZTIME_LASTCALL, & ! Integration time when last tendecies call has been done
+ & ZCOMPUTE, & ! 1. for points where we must compute tendencies, 0. elsewhere
+ & ZSSI, &
& ZCIT, & ! Pristine ice conc. at t
- & ZTHT, & ! Potential temperature
& ZRHODREF, & ! RHO Dry REFerence
& ZZT, & ! Temperature
& ZPRES, & ! Pressure
@@ -428,11 +481,10 @@ REAL, DIMENSION(KSIZE) :: ZRVT, & ! Water vapor m.r. at t
& ZHLI_HCF, &
& ZHLI_LCF, &
& ZHLI_HRI, &
- & ZHLI_LRI, &
- & ZFRAC
+ & ZHLI_LRI
!
!Output packed tendencies (for budgets only)
-REAL, DIMENSION(KSIZE) :: ZRVHENI_MR, & ! heterogeneous nucleation mixing ratio change
+REAL, DIMENSION(KPROMA) :: ZRVHENI_MR, & ! heterogeneous nucleation mixing ratio change
& ZRCHONI, & ! Homogeneous nucleation
& ZRRHONG_MR, & ! Spontaneous freezing mixing ratio change
& ZRVDEPS, & ! Deposition on r_s,
@@ -459,101 +511,56 @@ REAL, DIMENSION(KSIZE) :: ZRVHENI_MR, & ! heterogeneous nucleation mixing ratio
& ZRCDRYH, ZRIDRYH, ZRSDRYH, ZRRDRYH, ZRGDRYH, & ! Wet growth of hailstone
& ZRDRYHG ! Conversion of hailstone into graupel
!
-!Output packed total mixing ratio change (for budgets only)
-REAL, DIMENSION(KSIZE) :: ZTOT_RVHENI, & ! heterogeneous nucleation mixing ratio change
- & ZTOT_RCHONI, & ! Homogeneous nucleation
- & ZTOT_RRHONG, & ! Spontaneous freezing mixing ratio change
- & ZTOT_RVDEPS, & ! Deposition on r_s,
- & ZTOT_RIAGGS, & ! Aggregation on r_s
- & ZTOT_RIAUTS, & ! Autoconversion of r_i for r_s production
- & ZTOT_RVDEPG, & ! Deposition on r_g
- & ZTOT_RCAUTR, & ! Autoconversion of r_c for r_r production
- & ZTOT_RCACCR, & ! Accretion of r_c for r_r production
- & ZTOT_RREVAV, & ! Evaporation of r_r
- & ZTOT_RCRIMSS, ZTOT_RCRIMSG, ZTOT_RSRIMCG, & ! Cloud droplet riming of the aggregates
- & ZTOT_RIMLTC, & ! Cloud ice melting mixing ratio change
- & ZTOT_RCBERI, & ! Bergeron-Findeisen effect
- & ZTOT_RHMLTR, & ! Melting of the hailstones
- & ZTOT_RSMLTG, & ! Conversion-Melting of the aggregates
- & ZTOT_RCMLTSR, & ! Cloud droplet collection onto aggregates by positive temperature
- & ZTOT_RRACCSS, ZTOT_RRACCSG, ZTOT_RSACCRG, & ! Rain accretion onto the aggregates
- & ZTOT_RICFRRG, ZTOT_RRCFRIG, ZTOT_RICFRR, & ! Rain contact freezing
- & ZTOT_RCWETG, ZTOT_RIWETG, ZTOT_RRWETG, ZTOT_RSWETG, & ! Graupel wet growth
- & ZTOT_RCDRYG, ZTOT_RIDRYG, ZTOT_RRDRYG, ZTOT_RSDRYG, & ! Graupel dry growth
- & ZTOT_RWETGH, & ! Conversion of graupel into hail
- & ZTOT_RGMLTR, & ! Melting of the graupel
- & ZTOT_RCWETH, ZTOT_RIWETH, ZTOT_RSWETH, ZTOT_RGWETH, ZTOT_RRWETH, & ! Dry growth of hailstone
- & ZTOT_RCDRYH, ZTOT_RIDRYH, ZTOT_RSDRYH, ZTOT_RRDRYH, ZTOT_RGDRYH, & ! Wet growth of hailstone
- & ZTOT_RDRYHG ! Conversion of hailstone into graupel
+!For mixing-ratio-splitting
+LOGICAL :: LLCPZ0RT
+REAL, DIMENSION(KPROMA, KRR) :: Z0RT ! Mixing-ratios at the beginig of the current loop
!
-!For time- or mixing-ratio- splitting
-REAL, DIMENSION(KSIZE) :: 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
- & Z0RST, & ! Snow/aggregate m.r. at the beginig of the current loop
- & Z0RGT, & ! Graupel m.r. at the beginig of the current loop
- & Z0RHT ! Hail m.r. at the beginig of the current loop
-
-
-
-
-
-!en attendant phasage on utilise KSIZE Ã la place de KPROMA
-REAL, DIMENSION(KSIZE,0:7) :: &
+REAL, DIMENSION(KPROMA,0:7) :: &
& ZVART, & !Packed variables
+ & ZEXTPK, & !To take into acount external tendencies inside the splitting
& ZA, ZB
+!
+REAL, DIMENSION(KPROMA, 8) :: ZRS_TEND, ZRG_TEND
+REAL, DIMENSION(KPROMA,10) :: ZRH_TEND
-
-
-
-
-
+INTEGER, DIMENSION(KPROMA) :: &
+ & I1,I2,I3, & ! Used to replace the COUNT and PACK intrinsics on variables
+ & IITER ! Number of iterations done (with real tendencies computation)
+INTEGER, DIMENSION(KSIZE) :: I1TOT, I2TOT, I3TOT ! Used to replace the COUNT and PACK intrinsics
!
-!To take into acount external tendencies inside the splitting
-REAL, DIMENSION(KSIZE) :: ZEXT_RV, & ! External tendencie for rv
- & ZEXT_RC, & ! External tendencie for rc
- & ZEXT_RR, & ! External tendencie for rr
- & ZEXT_RI, & ! External tendencie for ri
- & ZEXT_RS, & ! External tendencie for rs
- & ZEXT_RG, & ! External tendencie for rg
- & ZEXT_RH, & ! External tendencie for rh
- & ZEXT_TH, & ! External tendencie for th
- & ZEXT_WW ! Working array
-LOGICAL :: GEXT_TEND
+REAL, DIMENSION(KPROMA) :: ZSUM2, ZMAXB
+REAL :: ZDEVIDE, ZX, ZRICE
!
-INTEGER, DIMENSION(KSIZE) :: IITER ! Number of iterations done (with real tendencies computation)
-INTEGER :: INB_ITER_MAX ! Maximum number of iterations (with real tendencies computation)
-REAL, DIMENSION(KSIZE) :: 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
-REAL, DIMENSION(KSIZE) :: ZW1D
-REAL, DIMENSION(KSIZE) :: ZCOMPUTE ! 1. for points where we must compute tendencies, 0. elsewhere
-LOGICAL :: LSOFT ! Must we really compute tendencies or only adjust them to new T variables
-LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)):: GDEP
-REAL :: ZTSTEP ! length of sub-timestep in case of time splitting
-REAL :: ZINV_TSTEP ! Inverse ov PTSTEP
-REAL, DIMENSION(KSIZE, 8) :: ZRS_TEND
-REAL, DIMENSION(KSIZE, 8) :: ZRG_TEND
-REAL, DIMENSION(KSIZE, 10) :: ZRH_TEND
-REAL, DIMENSION(KSIZE) :: ZSSI
-!
-!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
+INTEGER :: IC, JMICRO
+LOGICAL :: LLSIGMA_RC, LL_ANY_ITER, LL_AUCV_ADJU
+
!
!-------------------------------------------------------------------------------
-if ( lbu_enable ) then
- if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
-end if
+IF (LHOOK) CALL DR_HOOK('RAIN_ICE', 0, ZHOOK_HANDLE)
+!
!-------------------------------------------------------------------------------
!
+IF(OCND2) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'RAIN_ICE', 'OCND2 OPTION NOT CODED IN THIS RAIN_ICE VERSION')
+END IF
+IF(KPROMA /= KSIZE) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'RAIN_ICE', 'For now, KPROMA must be equal to KSIZE, see code for explanation')
+ ! 2 issues
+ ! * Microphyscs was optimized by introducing chunks of KPROMA size
+ ! Thus, in ice4_tendencies, the 1D array represent only a fraction of the points where microphisical species are present
+ ! We cannot rebuild the entire 3D arrays in the subroutine, so we cannot call ice4_rainfr_vert in it
+ ! A solution would be to suppress optimisation in this case by setting KPROMA=KSIZE in rain_ice
+ ! Another solution would be to compute column by column?
+ ! Another one would be to cut tendencies in 3 parts: before rainfr_vert, rainfr_vert, after rainfr_vert
+ ! * When chuncks are used, result is different
+ENDIF
+!
!* 1. COMPUTE THE LOOP BOUNDS
! -----------------------
!
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IIU=SIZE(PDZZ,1)
+IJU=SIZE(PDZZ,2)
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE,IIU,IJU)
IKB=KKA+JPVEXT*KKL
IKE=KKU-JPVEXT*KKL
IKTB=1+JPVEXT
@@ -563,35 +570,21 @@ ZINV_TSTEP=1./PTSTEP
GEXT_TEND=.TRUE.
!
! LSFACT and LVFACT without exner
-IF(KRR==7) THEN
- DO JK = 1, KKT
- DO JJ = 1, KJT
- DO JI = 1, KIT
- ZT(JI,JJ,JK) = PTHT(JI,JJ,JK) * PEXN(JI,JJ,JK)
- ZZ_LSFACT(JI,JJ,JK)=(XLSTT+(XCPV-XCI)*(ZT(JI,JJ,JK)-XTT)) &
- /( XCPD + XCPV*PRVT(JI,JJ,JK) + XCL*(PRCT(JI,JJ,JK)+PRRT(JI,JJ,JK)) &
- + XCI*(PRIT(JI,JJ,JK)+PRST(JI,JJ,JK)+PRGT(JI,JJ,JK)+PRHT(JI,JJ,JK)))
- ZZ_LVFACT(JI,JJ,JK)=(XLVTT+(XCPV-XCL)*(ZT(JI,JJ,JK)-XTT)) &
- /( XCPD + XCPV*PRVT(JI,JJ,JK) + XCL*(PRCT(JI,JJ,JK)+PRRT(JI,JJ,JK)) &
- + XCI*(PRIT(JI,JJ,JK)+PRST(JI,JJ,JK)+PRGT(JI,JJ,JK)+PRHT(JI,JJ,JK)))
- ENDDO
- ENDDO
- ENDDO
-ELSE
- DO JK = 1, KKT
- DO JJ = 1, KJT
- DO JI = 1, KIT
- ZT(JI,JJ,JK) = PTHT(JI,JJ,JK) * PEXN(JI,JJ,JK)
- ZZ_LSFACT(JI,JJ,JK)=(XLSTT+(XCPV-XCI)*(ZT(JI,JJ,JK)-XTT)) &
- /( XCPD + XCPV*PRVT(JI,JJ,JK) + XCL*(PRCT(JI,JJ,JK)+PRRT(JI,JJ,JK)) &
- + XCI*(PRIT(JI,JJ,JK)+PRST(JI,JJ,JK)+PRGT(JI,JJ,JK)))
- ZZ_LVFACT(JI,JJ,JK)=(XLVTT+(XCPV-XCL)*(ZT(JI,JJ,JK)-XTT)) &
- /( XCPD + XCPV*PRVT(JI,JJ,JK) + XCL*(PRCT(JI,JJ,JK)+PRRT(JI,JJ,JK)) &
- + XCI*(PRIT(JI,JJ,JK)+PRST(JI,JJ,JK)+PRGT(JI,JJ,JK)))
- ENDDO
+DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ IF (KRR==7) THEN
+ ZRICE=PRIT(JI,JJ,JK)+PRST(JI,JJ,JK)+PRGT(JI,JJ,JK)+PRHT(JI,JJ,JK)
+ ELSE
+ ZRICE=PRIT(JI,JJ,JK)+PRST(JI,JJ,JK)+PRGT(JI,JJ,JK)
+ ENDIF
+ ZDEVIDE = XCPD + XCPV*PRVT(JI,JJ,JK) + XCL*(PRCT(JI,JJ,JK)+PRRT(JI,JJ,JK)) + XCI*ZRICE
+ ZT(JI,JJ,JK) = PTHT(JI,JJ,JK) * PEXN(JI,JJ,JK)
+ ZZ_LSFACT(JI,JJ,JK)=(XLSTT+(XCPV-XCI)*(ZT(JI,JJ,JK)-XTT)) / ZDEVIDE
+ ZZ_LVFACT(JI,JJ,JK)=(XLVTT+(XCPV-XCL)*(ZT(JI,JJ,JK)-XTT)) / ZDEVIDE
ENDDO
ENDDO
-ENDIF
+ENDDO
!
!-------------------------------------------------------------------------------
!
@@ -602,58 +595,73 @@ IF(.NOT. LSEDIM_AFTER) THEN
!
!* 2.1 sedimentation
!
- if ( lbudget_rc .and. osedic ) call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
-
- !Init only if not osedic (to prevent crash with double init)
- !Remark: the 2 source terms SEDI and DEPO could be mixed and stored in the same source term (SEDI)
- ! if osedic=T and ldeposc=T (a warning is printed in ini_budget in that case)
- if ( lbudget_rc .and. ldeposc .and. .not.osedic ) &
- call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
+ IF (LBUDGET_RC .AND. OSEDIC) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RC), 'SEDI', PRCS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RR), 'SEDI', PRRS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RI) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RI), 'SEDI', PRIS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RS) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RS), 'SEDI', PRSS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RG) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RG), 'SEDI', PRGS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RH), 'SEDI', PRHS(:, :, :) * PRHODJ(:, :, :))
IF(HSEDIM=='STAT') THEN
- !SR: It *seems* that we must have two separate calls for ifort
IF(KRR==7) THEN
+ DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ ZRCT(JI,JJ,JK)=PRCS(JI,JJ,JK)*PTSTEP
+ ZRRT(JI,JJ,JK)=PRRS(JI,JJ,JK)*PTSTEP
+ ZRIT(JI,JJ,JK)=PRIS(JI,JJ,JK)*PTSTEP
+ ZRST(JI,JJ,JK)=PRSS(JI,JJ,JK)*PTSTEP
+ ZRGT(JI,JJ,JK)=PRGS(JI,JJ,JK)*PTSTEP
+ ZRHT(JI,JJ,JK)=PRHS(JI,JJ,JK)*PTSTEP
+ ENDDO
+ ENDDO
+ ENDDO
CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
+ &PTSTEP, KRR, OSEDIC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
- &PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,&
- &PRSS, PRSS*PTSTEP, PRGS, PRGS*PTSTEP,&
- &PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
+ &PRCS, ZRCT, PRRS, ZRRT, PRIS, ZRIT,&
+ &PRSS, ZRST, PRGS, ZRGT,&
+ &PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
&PSEA=PSEA, PTOWN=PTOWN, &
- &PINPRH=PINPRH, PRHT=PRHS*PTSTEP, PRHS=PRHS, PFPR=PFPR)
+ &PINPRH=PINPRH, PRHT=ZRHT, PRHS=PRHS, PFPR=PFPR)
ELSE
+ DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ ZRCT(JI,JJ,JK)=PRCS(JI,JJ,JK)*PTSTEP
+ ZRRT(JI,JJ,JK)=PRRS(JI,JJ,JK)*PTSTEP
+ ZRIT(JI,JJ,JK)=PRIS(JI,JJ,JK)*PTSTEP
+ ZRST(JI,JJ,JK)=PRSS(JI,JJ,JK)*PTSTEP
+ ZRGT(JI,JJ,JK)=PRGS(JI,JJ,JK)*PTSTEP
+ ENDDO
+ ENDDO
+ ENDDO
CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
+ &PTSTEP, KRR, OSEDIC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
- &PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,&
- &PRSS, PRSS*PTSTEP, PRGS, PRGS*PTSTEP,&
- &PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
+ &PRCS, ZRCT, PRRS, ZRRT, PRIS, ZRIT,&
+ &PRSS, ZRST, PRGS, ZRGT,&
+ &PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
&PSEA=PSEA, PTOWN=PTOWN, &
&PFPR=PFPR)
ENDIF
PINPRS(:,:) = PINPRS(:,:) + ZINPRI(:,:)
!No negativity correction here as we apply sedimentation on PR.S*PTSTEP variables
ELSEIF(HSEDIM=='SPLI') THEN
- !SR: It *seems* that we must have two separate calls for ifort
IF(KRR==7) THEN
CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
+ &PTSTEP, KRR, OSEDIC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
- &PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
+ &PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
&PSEA=PSEA, PTOWN=PTOWN, &
&PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR)
ELSE
CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
+ &PTSTEP, KRR, OSEDIC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
- &PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
+ &PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
&PSEA=PSEA, PTOWN=PTOWN, &
&PFPR=PFPR)
ENDIF
@@ -663,235 +671,323 @@ IF(.NOT. LSEDIM_AFTER) THEN
! It is initialized with the m.r. at T and is modified by two tendencies:
! sedimentation tendency and an external tendency which represents all other
! processes (mainly advection and microphysical processes). If both tendencies
- ! are negative, sedimentation can remove a specie at a given sub-timestep. From
+ ! are negative, sedimentation can remove a species at a given sub-timestep. From
! this point sedimentation stops for the remaining sub-timesteps but the other tendency
! will be still active and will lead to negative values.
- ! We could prevent the algorithm to not consume too much a specie, instead we apply
+ ! We could prevent the algorithm to not consume too much a species, instead we apply
! a correction here.
CALL CORRECT_NEGATIVITIES(KIT, KJT, KKT, KRR, PRVS, PRCS, PRRS, &
&PRIS, PRSS, PRGS, &
&PTHS, ZZ_LVFACT, ZZ_LSFACT, PRHS)
ELSEIF(HSEDIM=='NONE') THEN
ELSE
- call Print_msg( NVERB_FATAL, 'GEN', 'RAIN_ICE_RED', 'no sedimentation scheme for HSEDIM='//HSEDIM )
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'RAIN_ICE', 'no sedimentation scheme for HSEDIM='//HSEDIM)
END IF
+
+
+
+
+
+
+!!!!! ajouter momentum
+
+
+
+
+
+
+
+
+
+
+
+
+
+
!
!* 2.2 budget storage
!
- if ( lbudget_rc .and. osedic ) call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
-
- !If osedic=T and ldeposc=T, DEPO is in fact mixed and stored with the SEDI source term
- !(a warning is printed in ini_budget in that case)
- if ( lbudget_rc .and. ldeposc .and. .not.osedic) &
- call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
+ IF (LBUDGET_RC .AND. OSEDIC) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RC), 'SEDI', PRCS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RR), 'SEDI', PRRS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RI) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RI), 'SEDI', PRIS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RS) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RS), 'SEDI', PRSS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RG) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RG), 'SEDI', PRGS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RH), 'SEDI', PRHS(:, :, :) * PRHODJ(:, :, :))
ENDIF
!
+
+DO JK = 1,KKT
+ !Backup of T variables
+ ZWR(:,:,JK,IRV)=PRVT(:,:,JK)
+ ZWR(:,:,JK,IRC)=PRCT(:,:,JK)
+ ZWR(:,:,JK,IRR)=PRRT(:,:,JK)
+ ZWR(:,:,JK,IRI)=PRIT(:,:,JK)
+ ZWR(:,:,JK,IRS)=PRST(:,:,JK)
+ ZWR(:,:,JK,IRG)=PRGT(:,:,JK)
+ IF (KRR==7) THEN
+ ZWR(:,:,JK,IRH)=PRHT(:,:,JK)
+ ELSE
+ ZWR(:,:,JK,IRH)=0.
+ ENDIF
+
+ !Preset for output 3D variables
+ IF(OWARM) THEN
+ PEVAP3D(:,:,JK)=0.
+ ENDIF
+ PRAINFR(:,:,JK)=0.
+ ZCITOUT(:,:,JK)=0.
+ENDDO
+
+IF(LBU_ENABLE) THEN
+ ZTOT_RVHENI(:)=0.
+ ZTOT_RCHONI(:)=0.
+ ZTOT_RRHONG(:)=0.
+ ZTOT_RVDEPS(:)=0.
+ ZTOT_RIAGGS(:)=0.
+ ZTOT_RIAUTS(:)=0.
+ ZTOT_RVDEPG(:)=0.
+ ZTOT_RCAUTR(:)=0.
+ ZTOT_RCACCR(:)=0.
+ ZTOT_RREVAV(:)=0.
+ ZTOT_RCRIMSS(:)=0.
+ ZTOT_RCRIMSG(:)=0.
+ ZTOT_RSRIMCG(:)=0.
+ ZTOT_RIMLTC(:)=0.
+ ZTOT_RCBERI(:)=0.
+ ZTOT_RHMLTR(:)=0.
+ ZTOT_RSMLTG(:)=0.
+ ZTOT_RCMLTSR(:)=0.
+ ZTOT_RRACCSS(:)=0.
+ ZTOT_RRACCSG(:)=0.
+ ZTOT_RSACCRG(:)=0.
+ ZTOT_RICFRRG(:)=0.
+ ZTOT_RRCFRIG(:)=0.
+ ZTOT_RICFRR(:)=0.
+ ZTOT_RCWETG(:)=0.
+ ZTOT_RIWETG(:)=0.
+ ZTOT_RRWETG(:)=0.
+ ZTOT_RSWETG(:)=0.
+ ZTOT_RCDRYG(:)=0.
+ ZTOT_RIDRYG(:)=0.
+ ZTOT_RRDRYG(:)=0.
+ ZTOT_RSDRYG(:)=0.
+ ZTOT_RWETGH(:)=0.
+ ZTOT_RGMLTR(:)=0.
+ ZTOT_RCWETH(:)=0.
+ ZTOT_RIWETH(:)=0.
+ ZTOT_RSWETH(:)=0.
+ ZTOT_RGWETH(:)=0.
+ ZTOT_RRWETH(:)=0.
+ ZTOT_RCDRYH(:)=0.
+ ZTOT_RIDRYH(:)=0.
+ ZTOT_RSDRYH(:)=0.
+ ZTOT_RRDRYH(:)=0.
+ ZTOT_RGDRYH(:)=0.
+ ZTOT_RDRYHG(:)=0.
+ENDIF
+
!-------------------------------------------------------------------------------
-!
-!* 3. PACKING
-! --------
! optimization by looking for locations where
! the microphysical fields are larger than a minimal value only !!!
!
-IMICRO=0
-IF(KSIZE/=0) IMICRO=COUNTJV(ODMICRO(:,:,:), I1(:), I2(:), I3(:))
-!Packing
-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))
- ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
- ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
- ZRST(JL) = PRST(I1(JL),I2(JL),I3(JL))
- ZRGT(JL) = PRGT(I1(JL),I2(JL),I3(JL))
- ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
- ZCF(JL) = PCLDFR(I1(JL),I2(JL),I3(JL))
- ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
- ZTHT(JL) = PTHT(I1(JL),I2(JL),I3(JL))
- ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
- ZEXN(JL) = PEXN(I1(JL),I2(JL),I3(JL))
- ZHLC_HCF(JL) = PHLC_HCF(I1(JL),I2(JL),I3(JL))
- ZHLC_HRC(JL) = PHLC_HRC(I1(JL),I2(JL),I3(JL))
- ZHLC_LRC(JL) = ZRCT(JL) - ZHLC_HRC(JL)
- ZHLI_HCF(JL) = PHLI_HCF(I1(JL),I2(JL),I3(JL))
- ZHLI_HRI(JL) = PHLI_HRI(I1(JL),I2(JL),I3(JL))
- ZHLI_LRI(JL) = ZRIT(JL) - ZHLI_HRI(JL)
- IF(ZRCT(JL)>0.) THEN
- ZHLC_LCF(JL) = ZCF(JL)- ZHLC_HCF(JL)
- ELSE
- ZHLC_LCF(JL)=0.
+IF (KSIZE /= COUNT(ODMICRO)) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'RAIN_ICE', 'RAIN_ICE : KSIZE /= COUNT(ODMICRO)')
+ENDIF
+
+IF (KSIZE > 0) THEN
+
+ !Maximum number of iterations
+ !We only count real iterations (those for which we *compute* tendencies)
+ 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
+
+!===============================================================================================================
+! Cache-blocking loop :
+
+ LLSIGMA_RC=(HSUBG_AUCV_RC=='PDF ' .AND. CSUBG_PR_PDF=='SIGM')
+ LL_AUCV_ADJU=(HSUBG_AUCV_RC=='ADJU' .OR. HSUBG_AUCV_RI=='ADJU')
+
+ ! starting indexes :
+ IC=0
+ ISTK=1
+ ISTJ=1
+ ISTI=1
+
+ DO JMICRO=1,KSIZE,KPROMA
+
+ IMICRO=MIN(KPROMA,KSIZE-JMICRO+1)
+!
+!* 3. PACKING
+! --------
+
+ ! Setup packing parameters
+ OUTER_LOOP: DO JK = ISTK, KKT
+ DO JJ = ISTJ, KJT
+ IF (ANY(ODMICRO(:,JJ,JK))) THEN
+ DO JI = ISTI, KIT
+ IF (ODMICRO(JI,JJ,JK)) THEN
+ IC=IC+1
+ ! Initialization of variables in packed format :
+ ZVART(IC, ITH)=PTHT(JI, JJ, JK)
+ ZVART(IC, IRV)=PRVT(JI, JJ, JK)
+ ZVART(IC, IRC)=PRCT(JI, JJ, JK)
+ ZVART(IC, IRR)=PRRT(JI, JJ, JK)
+ ZVART(IC, IRI)=PRIT(JI, JJ, JK)
+ ZVART(IC, IRS)=PRST(JI, JJ, JK)
+ ZVART(IC, IRG)=PRGT(JI, JJ, JK)
+ IF (KRR==7) THEN
+ ZVART(IC, IRH)=PRHT(JI, JJ, JK)
+ ENDIF
+ IF (GEXT_TEND) THEN
+ !The th tendency is not related to a mixing ratio change, there is no exn/exnref issue here
+ ZEXTPK(IC, ITH)=PTHS(JI, JJ, JK)
+ ZEXTPK(IC, IRV)=PRVS(JI, JJ, JK)
+ ZEXTPK(IC, IRC)=PRCS(JI, JJ, JK)
+ ZEXTPK(IC, IRR)=PRRS(JI, JJ, JK)
+ ZEXTPK(IC, IRI)=PRIS(JI, JJ, JK)
+ ZEXTPK(IC, IRS)=PRSS(JI, JJ, JK)
+ ZEXTPK(IC, IRG)=PRGS(JI, JJ, JK)
+ IF (KRR==7) THEN
+ ZEXTPK(IC, IRH)=PRHS(JI, JJ, JK)
+ ENDIF
+ ENDIF
+ ZCIT (IC)=PCIT (JI, JJ, JK)
+ ZCF (IC)=PCLDFR (JI, JJ, JK)
+ ZRHODREF (IC)=PRHODREF(JI, JJ, JK)
+ ZPRES (IC)=PPABST (JI, JJ, JK)
+ ZEXN (IC)=PEXN (JI, JJ, JK)
+ IF(LLSIGMA_RC) THEN
+ ZSIGMA_RC(IC)=PSIGS (JI, JJ, JK)
+ ENDIF
+ IF (LL_AUCV_ADJU) THEN
+ ZHLC_HCF(IC) = PHLC_HCF(JI, JJ, JK)
+ ZHLC_HRC(IC) = PHLC_HRC(JI, JJ, JK)
+ ZHLI_HCF(IC) = PHLI_HCF(JI, JJ, JK)
+ ZHLI_HRI(IC) = PHLI_HRI(JI, JJ, JK)
+ ENDIF
+ ! Save indices for later usages:
+ I1(IC) = JI
+ I2(IC) = JJ
+ I3(IC) = JK
+ I1TOT(JMICRO+IC-1)=JI
+ I2TOT(JMICRO+IC-1)=JJ
+ I3TOT(JMICRO+IC-1)=JK
+ IF (IC==IMICRO) THEN
+ ! the end of the chunk has been reached, then reset the starting index :
+ ISTI=JI+1
+ IF (ISTI <= KIT) THEN
+ ISTJ=JJ
+ ISTK=JK
+ ELSE
+ ! end of line, restart from 1 and increment upper loop
+ ISTI=1
+ ISTJ=JJ+1
+ IF (ISTJ <= KJT) THEN
+ ISTK=JK
+ ELSE
+ ! end of line, restart from 1 and increment upper loop
+ ISTJ=1
+ ISTK=JK+1
+ IF (ISTK > KKT) THEN
+ ! end of line, restart from 1
+ ISTK=1
+ ENDIF
+ ENDIF
+ ENDIF
+ IC=0
+ EXIT OUTER_LOOP
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDIF
+ ! restart inner loop on JI :
+ ISTI=1
+ ENDDO
+ ! restart inner loop on JJ :
+ ISTJ=1
+ ENDDO OUTER_LOOP
+
+ IF (GEXT_TEND) THEN
+ DO JV=0, KRR
+ DO JL=1, IMICRO
+ ZEXTPK(JL, JV)=ZEXTPK(JL, JV)-ZVART(JL, JV)*ZINV_TSTEP
+ ENDDO
+ ENDDO
ENDIF
- IF(ZRIT(JL)>0.) THEN
- ZHLI_LCF(JL) = ZCF(JL)- ZHLI_HCF(JL)
- ELSE
- ZHLI_LCF(JL)=0.
+ IF (LLSIGMA_RC) THEN
+ DO JL=1, IMICRO
+ ZSIGMA_RC(JL)=ZSIGMA_RC(JL)*2.
+ ENDDO
ENDIF
- ENDDO
- 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
- ZEXT_RR(JL) = PRRS(I1(JL),I2(JL),I3(JL)) - ZRRT(JL)*ZINV_TSTEP
- ZEXT_RI(JL) = PRIS(I1(JL),I2(JL),I3(JL)) - ZRIT(JL)*ZINV_TSTEP
- ZEXT_RS(JL) = PRSS(I1(JL),I2(JL),I3(JL)) - ZRST(JL)*ZINV_TSTEP
- ZEXT_RG(JL) = PRGS(I1(JL),I2(JL),I3(JL)) - ZRGT(JL)*ZINV_TSTEP
- ZEXT_TH(JL) = PTHS(I1(JL),I2(JL),I3(JL)) - ZTHT(JL)*ZINV_TSTEP
- !The th tendency is not related to a mixing ratio change, there is no exn/exnref issue here
- ENDDO
- ENDIF
- 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.
- ENDDO
- ENDIF
- IF(KRR==7) THEN
- DO JL=1, IMICRO
- ZRHT(JL) = PRHT(I1(JL),I2(JL),I3(JL))
- ENDDO
- IF(GEXT_TEND) THEN
+ IF (LL_AUCV_ADJU) THEN
DO JL=1, IMICRO
- ZEXT_RH(JL) = PRHS(I1(JL),I2(JL),I3(JL)) - ZRHT(JL)*ZINV_TSTEP
+ ZHLC_LRC(JL) = ZVART(JL, IRC) - ZHLC_HRC(JL)
+ ZHLI_LRI(JL) = ZVART(JL, IRI) - ZHLI_HRI(JL)
+ IF(ZVART(JL, IRC)>0.) THEN
+ ZHLC_LCF(JL) = ZCF(JL)- ZHLC_HCF(JL)
+ ELSE
+ ZHLC_LCF(JL)=0.
+ ENDIF
+ IF(ZVART(JL, IRI)>0.) THEN
+ ZHLI_LCF(JL) = ZCF(JL)- ZHLI_HCF(JL)
+ ELSE
+ ZHLI_LCF(JL)=0.
+ ENDIF
ENDDO
ENDIF
- ELSE
- ZRHT(:)=0.
- IF(GEXT_TEND) ZEXT_RH(:)=0.
- ENDIF
- IF(LBU_ENABLE) THEN
- ZTOT_RVHENI(:)=0.
- ZTOT_RCHONI(:)=0.
- ZTOT_RRHONG(:)=0.
- ZTOT_RVDEPS(:)=0.
- ZTOT_RIAGGS(:)=0.
- ZTOT_RIAUTS(:)=0.
- ZTOT_RVDEPG(:)=0.
- ZTOT_RCAUTR(:)=0.
- ZTOT_RCACCR(:)=0.
- ZTOT_RREVAV(:)=0.
- ZTOT_RCRIMSS(:)=0.
- ZTOT_RCRIMSG(:)=0.
- ZTOT_RSRIMCG(:)=0.
- ZTOT_RIMLTC(:)=0.
- ZTOT_RCBERI(:)=0.
- ZTOT_RHMLTR(:)=0.
- ZTOT_RSMLTG(:)=0.
- ZTOT_RCMLTSR(:)=0.
- ZTOT_RRACCSS(:)=0.
- ZTOT_RRACCSG(:)=0.
- ZTOT_RSACCRG(:)=0.
- ZTOT_RICFRRG(:)=0.
- ZTOT_RRCFRIG(:)=0.
- ZTOT_RICFRR(:)=0.
- ZTOT_RCWETG(:)=0.
- ZTOT_RIWETG(:)=0.
- ZTOT_RRWETG(:)=0.
- ZTOT_RSWETG(:)=0.
- ZTOT_RCDRYG(:)=0.
- ZTOT_RIDRYG(:)=0.
- ZTOT_RRDRYG(:)=0.
- ZTOT_RSDRYG(:)=0.
- ZTOT_RWETGH(:)=0.
- ZTOT_RGMLTR(:)=0.
- ZTOT_RCWETH(:)=0.
- ZTOT_RIWETH(:)=0.
- ZTOT_RSWETH(:)=0.
- ZTOT_RGWETH(:)=0.
- ZTOT_RRWETH(:)=0.
- ZTOT_RCDRYH(:)=0.
- ZTOT_RIDRYH(:)=0.
- ZTOT_RSDRYH(:)=0.
- ZTOT_RRDRYH(:)=0.
- ZTOT_RGDRYH(:)=0.
- ZTOT_RDRYHG(:)=0.
- ENDIF
-ENDIF
+
!-------------------------------------------------------------------------------
!
!* 4. LOOP
! ----
!
-!Maximum number of iterations
-!We only count real iterations (those for which we *compute* tendencies)
-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
-IITER(:)=0
-ZTIME(:)=0. ! Current integration time (all points may have a different integration time)
-DO WHILE(ANY(ZTIME(:)<PTSTEP)) ! Loop to *really* compute tendencies
- IF(XMRSTEP/=0.) THEN
- ! In this case we need to remember the mixing ratios used to compute the tendencies
- ! because when mixing ratio has evolved more than a threshold, we must re-compute tendecies
- DO JL=1, IMICRO
- Z0RVT(JL)=ZRVT(JL)
- Z0RCT(JL)=ZRCT(JL)
- Z0RRT(JL)=ZRRT(JL)
- Z0RIT(JL)=ZRIT(JL)
- Z0RST(JL)=ZRST(JL)
- Z0RGT(JL)=ZRGT(JL)
- Z0RHT(JL)=ZRHT(JL)
- ENDDO
- ENDIF
- IF(XTSTEP_TS/=0.) THEN
- ! In this case we need to remember the time when tendencies were computed
- ! because when time has evolved more than a limit, we must re-compute tendecies
- ZTIME_LASTCALL(:)=ZTIME(:)
- ENDIF
- ZCOMPUTE(:)=MAX(0., -SIGN(1., ZTIME(:)-PTSTEP)) ! Compuation (1.) only for points for which integration time has not reached the timestep
- LSOFT=.FALSE. ! We *really* compute the tendencies
- IITER(:)=IITER(:)+INT(ZCOMPUTE(:))
- DO WHILE(SUM(ZCOMPUTE(:))>0.) ! Loop to adjust tendencies when we cross the 0°C or when a specie disappears
- IF(KRR==7) THEN
- DO JL=1, IMICRO
- ZZT(JL) = ZTHT(JL) * ZEXN(JL)
- ZLSFACT(JL)=(XLSTT+(XCPV-XCI)*(ZZT(JL)-XTT)) &
- &/( (XCPD + XCPV*ZRVT(JL) + XCL*(ZRCT(JL)+ZRRT(JL)) &
- &+ XCI*(ZRIT(JL)+ZRST(JL)+ZRGT(JL)+ZRHT(JL)))*ZEXN(JL) )
- ZLVFACT(JL)=(XLVTT+(XCPV-XCL)*(ZZT(JL)-XTT)) &
- &/( (XCPD + XCPV*ZRVT(JL) + XCL*(ZRCT(JL)+ZRRT(JL)) &
- &+ XCI*(ZRIT(JL)+ZRST(JL)+ZRGT(JL)+ZRHT(JL)))*ZEXN(JL) )
- ENDDO
- ELSE
- DO JL=1, IMICRO
- ZZT(JL) = ZTHT(JL) * ZEXN(JL)
- ZLSFACT(JL)=(XLSTT+(XCPV-XCI)*(ZZT(JL)-XTT)) &
- &/( (XCPD + XCPV*ZRVT(JL) + XCL*(ZRCT(JL)+ZRRT(JL)) &
- &+ XCI*(ZRIT(JL)+ZRST(JL)+ZRGT(JL)))*ZEXN(JL) )
- ZLVFACT(JL)=(XLVTT+(XCPV-XCL)*(ZZT(JL)-XTT)) &
- &/( (XCPD + XCPV*ZRVT(JL) + XCL*(ZRCT(JL)+ZRRT(JL)) &
- &+ XCI*(ZRIT(JL)+ZRST(JL)+ZRGT(JL)))*ZEXN(JL) )
- ENDDO
- ENDIF
- !
- !*** 4.1 Tendecies computation
- !
- ! Tendencies are *really* computed when LSOFT==.FALSE. and only adjusted otherwise
+ IITER(1:IMICRO)=0
+ ZTIME(1:IMICRO)=0. ! Current integration time (all points may have a different integration time)
+ DO WHILE(ANY(ZTIME(1:IMICRO)<PTSTEP)) ! Loop to *really* compute tendencies
+ IF(XTSTEP_TS/=0.) THEN
+ ! In this case we need to remember the time when tendencies were computed
+ ! because when time has evolved more than a limit, we must re-compute tendencies
+ ZTIME_LASTCALL(1:IMICRO)=ZTIME(1:IMICRO)
+ ENDIF
+ DO JL=1, IMICRO
+ IF (ZTIME(JL) < PTSTEP) THEN
+ ZCOMPUTE(JL)=1. ! Computation (1.) only for points for which integration time has not reached the timestep
+ IITER(JL)=IITER(JL)+1
+ ELSE
+ ZCOMPUTE(JL)=0.
+ ENDIF
+ ENDDO
+ LL_ANY_ITER=ANY(IITER(1:IMICRO) < INB_ITER_MAX)
+ LLCPZ0RT=.TRUE.
+ LSOFT=.FALSE. ! We *really* compute the tendencies
-!KPROMA=IMICRO: temporary merging step
-ZVART(:, ITH)=ZTHT(:)
-ZVART(:, IRV)=ZRVT(:)
-ZVART(:, IRC)=ZRCT(:)
-ZVART(:, IRR)=ZRRT(:)
-ZVART(:, IRI)=ZRIT(:)
-ZVART(:, IRS)=ZRST(:)
-ZVART(:, IRG)=ZRGT(:)
-IF(KRR==7) ZVART(:, IRH)=ZRHT(:)
-
- CALL ICE4_TENDENCIES(IMICRO, IMICRO, IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, KKT, KKL, &
+ DO WHILE(ANY(ZCOMPUTE(1:IMICRO)==1.)) ! Loop to adjust tendencies when we cross the 0°C or when a species disappears
+!$OMP SIMD
+ DO JL=1, IMICRO
+ ZSUM2(JL)=SUM(ZVART(JL,IRI:KRR))
+ ENDDO
+ DO JL=1, IMICRO
+ ZDEVIDE=(XCPD + XCPV*ZVART(JL, IRV) + XCL*(ZVART(JL, IRC)+ZVART(JL, IRR)) + XCI*ZSUM2(JL)) * ZEXN(JL)
+ ZZT(JL) = ZVART(JL, ITH) * ZEXN(JL)
+ ZLSFACT(JL)=(XLSTT+(XCPV-XCI)*(ZZT(JL)-XTT)) / ZDEVIDE
+ ZLVFACT(JL)=(XLVTT+(XCPV-XCL)*(ZZT(JL)-XTT)) / ZDEVIDE
+ ENDDO
+ !
+ !*** 4.1 Tendencies computation
+ !
+ ! Tendencies are *really* computed when LSOFT==.FALSE. and only adjusted otherwise
+ CALL ICE4_TENDENCIES(KPROMA, IMICRO, IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, KKT, KKL, &
&KRR, LSOFT, ZCOMPUTE, &
&OWARM, CSUBG_RC_RR_ACCR, CSUBG_RR_EVAP, &
&HSUBG_AUCV_RC, HSUBG_AUCV_RI, CSUBG_PR_PDF, &
&ZEXN, ZRHODREF, ZLVFACT, ZLSFACT, I1, I2, I3, &
- &ZPRES, ZCF, ZSIGMA_RC,&
+ &ZPRES, ZCF, ZSIGMA_RC, &
&ZCIT, &
&ZZT, ZVART, &
&ZRVHENI_MR, ZRRHONG_MR, ZRIMLTC_MR, ZRSRIMCG_MR, &
@@ -907,795 +1003,629 @@ IF(KRR==7) ZVART(:, IRH)=ZRHT(:)
&ZA, ZB, &
&ZHLC_HCF, ZHLC_LCF, ZHLC_HRC, ZHLC_LRC, &
&ZHLI_HCF, ZHLI_LCF, ZHLI_HRI, ZHLI_LRI, PRAINFR)
-ZTHT(:)=ZVART(:, ITH)
-ZRVT(:)=ZVART(:, IRV)
-ZRCT(:)=ZVART(:, IRC)
-ZRRT(:)=ZVART(:, IRR)
-ZRIT(:)=ZVART(:, IRI)
-ZRST(:)=ZVART(:, IRS)
-ZRGT(:)=ZVART(:, IRG)
-IF(KRR==7) ZRHT(:)=ZVART(:, IRH)
-
- ! External tendencies
- IF(GEXT_TEND) THEN
- DO JL=1, IMICRO
- ZA(JL, ITH) = ZA(JL, ITH) + ZEXT_TH(JL)
- ZA(JL, IRV) = ZA(JL, IRV) + ZEXT_RV(JL)
- ZA(JL, IRC) = ZA(JL, IRC) + ZEXT_RC(JL)
- ZA(JL, IRR) = ZA(JL, IRR) + ZEXT_RR(JL)
- ZA(JL, IRI) = ZA(JL, IRI) + ZEXT_RI(JL)
- ZA(JL, IRS) = ZA(JL, IRS) + ZEXT_RS(JL)
- ZA(JL, IRG) = ZA(JL, IRG) + ZEXT_RG(JL)
- ZA(JL, IRH) = ZA(JL, IRH) + ZEXT_RH(JL)
- ENDDO
- ENDIF
- !
- !*** 4.2 Integration time
- !
- ! If we can, we will use these tendencies until the end of the timestep
- ZMAXTIME(:)=ZCOMPUTE(:) * (PTSTEP-ZTIME(:)) ! Remaining time until the end of the timestep
-
- !We need to adjust tendencies when temperature reaches 0
- IF(LFEEDBACKT) THEN
- DO JL=1, IMICRO
- !Is ZB_TH enough to change temperature sign?
- ZW1D(JL)=(ZTHT(JL) - XTT/ZEXN(JL)) * (ZTHT(JL) + ZB_TH(JL) - XTT/ZEXN(JL))
- ZMAXTIME(JL)=ZMAXTIME(JL)*MAX(0., SIGN(1., ZW1D(JL)))
- !Can ZA(:, ITH) make temperature change of sign?
- ZW1D(JL)=MAX(0., -SIGN(1., 1.E-20 - ABS(ZA(JL, ITH)))) ! WHERE(ABS(ZA(:, ITH))>1.E-20)
- ZTIME_THRESHOLD(JL)=(1. - ZW1D(JL))*(-1.) + &
- ZW1D(JL) * &
- (XTT/ZEXN(JL) - ZB_TH(JL) - ZTHT(JL))/ &
- SIGN(MAX(ABS(ZA(JL, ITH)), 1.E-20), ZA(JL, ITH))
- ZW1D(JL)=MAX(0., -SIGN(1., 1.E-20 - ZTIME_THRESHOLD(JL))) ! WHERE(ZTIME_THRESHOLD(:)>1.E-20)
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- ZW1D(JL) * MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
- ENDDO
- ENDIF
-
- !We need to adjust tendencies when a specy disappears
- !When a species is missing, only the external tendencies can be negative (and we must keep track of it)
- DO JL=1, IMICRO
- ZW1D(JL)=MAX(0., -SIGN(1., ZA(JL, IRV)+1.E-20)) * & ! WHERE(ZA(:, IRV)<-1.E-20)
- &MAX(0., -SIGN(1., XRTMIN(1)-ZRVT(JL))) ! WHERE(ZRVT(:)>XRTMIN(1))
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RV(JL)+ZRVT(JL))/MIN(ZA(JL, IRV), -1.E-20))
-
- ZW1D(JL)=MAX(0., -SIGN(1., ZA(JL, IRC)+1.E-20)) * & ! WHERE(ZA(:, IRC)<-1.E-20)
- &MAX(0., -SIGN(1., XRTMIN(2)-ZRCT(JL))) ! WHERE(ZRCT(:)>XRTMIN(2))
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RC(JL)+ZRCT(JL))/MIN(ZA(JL, IRC), -1.E-20))
-
- ZW1D(JL)=MAX(0., -SIGN(1., ZA(JL, IRR)+1.E-20)) * & ! WHERE(ZA(:, IRR)<-1.E-20)
- &MAX(0., -SIGN(1., XRTMIN(3)-ZRRT(JL))) ! WHERE(ZRRT(:)>XRTMIN(3))
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RR(JL)+ZRRT(JL))/MIN(ZA(JL, IRR), -1.E-20))
-
- ZW1D(JL)=MAX(0., -SIGN(1., ZA(JL, IRI)+1.E-20)) * & ! WHERE(ZI_RV(:)<-1.E-20)
- &MAX(0., -SIGN(1., XRTMIN(4)-ZRIT(JL))) ! WHERE(ZRIT(:)>XRTMIN(4))
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RI(JL)+ZRIT(JL))/MIN(ZARI(JL, IRI), -1.E-20))
-
- ZW1D(JL)=MAX(0., -SIGN(1., ZA(JL, IRS)+1.E-20)) * & ! WHERE(ZA(:, IRS)<-1.E-20)
- &MAX(0., -SIGN(1., XRTMIN(5)-ZRST(JL))) ! WHERE(ZRST(:)>XRTMIN(5))
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RS(JL)+ZRST(JL))/MIN(ZA(JL, IRS), -1.E-20))
-
- ZW1D(JL)=MAX(0., -SIGN(1., ZA(JL, IRG)+1.E-20)) * & ! WHERE(ZA(:, IRG)<-1.E-20)
- &MAX(0., -SIGN(1., XRTMIN(6)-ZRGT(JL))) ! WHERE(ZRGT(:)>XRTMIN(6))
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RG(JL)+ZRGT(JL))/MIN(ZA(JL, IRG), -1.E-20))
- ENDDO
- IF(KRR==7) THEN
- DO JL=1, IMICRO
- ZW1D(JL)=MAX(0., -SIGN(1., ZA(JL, IRH)+1.E-20)) * & ! WHERE(ZA(:, IRH)<-1.E-20)
- &MAX(0., -SIGN(1., XRTMIN(7)-ZRHT(JL))) ! WHERE(ZRHT(:)>XRTMIN(7))
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RH(JL)+ZRHT(JL))/MIN(ZA(JL, IRH), -1.E-20))
- ENDDO
- ENDIF
+ ! External tendencies
+ IF(GEXT_TEND) THEN
+ DO JV=0, KRR
+ DO JL=1, IMICRO
+ ZA(JL, JV) = ZA(JL, JV) + ZEXTPK(JL, JV)
+ ENDDO
+ ENDDO
+ ENDIF
+ !
+ !*** 4.2 Integration time
+ !
+ ! If we can, we shall use these tendencies until the end of the timestep
+ DO JL=1, IMICRO
+ ZMAXTIME(JL)=ZCOMPUTE(JL) * (PTSTEP-ZTIME(JL)) ! Remaining time until the end of the timestep
+ ENDDO
- !We stop when the end of the timestep is reached
- ZCOMPUTE(:)=ZCOMPUTE(:) * MAX(0., -SIGN(1., ZTIME(:)+ZMAXTIME(:)-PTSTEP))
+ !We need to adjust tendencies when temperature reaches 0
+ IF(LFEEDBACKT) THEN
+ DO JL=1, IMICRO
+ !Is ZB(:, ITH) enough to change temperature sign?
+ ZX=XTT/ZEXN(JL)
+ IF ((ZVART(JL, ITH) - ZX) * (ZVART(JL, ITH) + ZB(JL, ITH) - ZX) < 0.) THEN
+ ZMAXTIME(JL)=0.
+ ENDIF
+ !Can ZA(:, ITH) make temperature change of sign?
+ IF (ABS(ZA(JL,ITH)) > 1.E-20 ) THEN
+ ZTIME_THRESHOLD=(ZX - ZB(JL, ITH) - ZVART(JL, ITH))/ZA(JL, ITH)
+ IF (ZTIME_THRESHOLD > 0.) THEN
+ ZMAXTIME(JL)=MIN(ZMAXTIME(JL), ZTIME_THRESHOLD)
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDIF
+
+ !We need to adjust tendencies when a species disappears
+ !When a species is missing, only the external tendencies can be negative (and we must keep track of it)
+ DO JV=1, KRR
+ DO JL=1, IMICRO
+ IF (ZA(JL, JV) < -1.E-20 .AND. ZVART(JL, JV) > XRTMIN(JV)) THEN
+ ZMAXTIME(JL)=MIN(ZMAXTIME(JL), -(ZB(JL, JV)+ZVART(JL, JV))/ZA(JL, JV))
+ ENDIF
+ ENDDO
+ ENDDO
- !We must recompute tendencies when the end of the sub-timestep is reached
- IF(XTSTEP_TS/=0.) THEN
- DO JL=1, IMICRO
- ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
- &MAX(0., -SIGN(1., ZTIME_LASTCALL(JL)+ZTSTEP-ZTIME(JL)-ZMAXTIME(JL))) ! WHERE(ZTIME(:)+ZMAXTIME(:)>ZTIME_LASTCALL(:)+ZTSTEP)
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL) * (ZTIME_LASTCALL(JL)-ZTIME(JL)+ZTSTEP)
- ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
- ENDDO
- ENDIF
+ !We stop when the end of the timestep is reached
+ DO JL=1, IMICRO
+ IF (ZTIME(JL)+ZMAXTIME(JL) >= PTSTEP) THEN
+ ZCOMPUTE(JL)=0.
+ ENDIF
+ ENDDO
+ !We must recompute tendencies when the end of the sub-timestep is reached
+ IF (XTSTEP_TS/=0.) THEN
+ DO JL=1, IMICRO
+ IF ((IITER(JL) < INB_ITER_MAX) .AND. (ZTIME(JL)+ZMAXTIME(JL) > ZTIME_LASTCALL(JL)+ZTSTEP)) THEN
+ ZMAXTIME(JL)=ZTIME_LASTCALL(JL)-ZTIME(JL)+ZTSTEP
+ ZCOMPUTE(JL)=0.
+ ENDIF
+ ENDDO
+ ENDIF
+
+ !We must recompute tendencies when the maximum allowed change is reached
+ !When a species 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 species was already missing)
+ IF (XMRSTEP/=0.) THEN
+ IF (LL_ANY_ITER) THEN
+ ! In this case we need to remember the initial mixing ratios used to compute the tendencies
+ ! because when mixing ratio has evolved more than a threshold, we must re-compute tendencies
+ ! Thus, at first iteration (ie when LLCPZ0RT=.TRUE.) we copy ZVART into Z0RT
+ DO JV=1,KRR
+ IF (LLCPZ0RT) Z0RT(1:IMICRO, JV)=ZVART(1:IMICRO, JV)
+ DO JL=1, IMICRO
+ IF (IITER(JL)<INB_ITER_MAX .AND. ABS(ZA(JL,JV))>1.E-20) THEN
+ ZTIME_THRESHOLD=(SIGN(1., ZA(JL, JV))*XMRSTEP+Z0RT(JL, JV)-ZVART(JL, JV)-ZB(JL, JV))/ZA(JL, JV)
+ ELSE
+ ZTIME_THRESHOLD=-1.
+ ENDIF
+ IF (ZTIME_THRESHOLD>=0 .AND. ZTIME_THRESHOLD<ZMAXTIME(JL) .AND. (ZVART(JL, JV)>XRTMIN(JV) .OR. ZA(JL, JV)>0.)) THEN
+ ZMAXTIME(JL)=MIN(ZMAXTIME(JL), ZTIME_THRESHOLD)
+ ZCOMPUTE(JL)=0.
+ ENDIF
+ ENDDO
+ ENDDO
+ LLCPZ0RT=.FALSE.
+!$OMP SIMD
+ DO JL=1,IMICRO
+ ZMAXB(JL)=MAXVAL(ABS(ZB(JL,1:KRR)))
+ ENDDO
+ DO JL=1, IMICRO
+ IF (IITER(JL)<INB_ITER_MAX .AND. ZMAXB(JL)>XMRSTEP) THEN
+ ZMAXTIME(JL)=0.
+ ZCOMPUTE(JL)=0.
+ ENDIF
+ ENDDO
+ ENDIF ! LL_ANY_ITER
+ ENDIF ! XMRSTEP/=0.
+ !
+ !*** 4.3 New values of variables for next iteration
+ !
+ DO JV=0, KRR
+ DO JL=1, IMICRO
+ ZVART(JL, JV)=ZVART(JL, JV)+ZA(JL, JV)*ZMAXTIME(JL)+ZB(JL, JV)
+ ENDDO
+ ENDDO
+ DO JL=1, IMICRO
+ IF (ZVART(JL,IRI)==0.) ZCIT(JL) = 0.
+ ZTIME(JL)=ZTIME(JL)+ZMAXTIME(JL)
+ ENDDO
- !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
- DO JL=1, IMICRO
- ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
- &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RV(JL)))) ! WHERE(ABS(ZA_RV(:))>1.E-20)
- ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
- &ZW1D(JL)*(SIGN(1., ZA_RV(JL))*XMRSTEP+Z0RVT(JL)-ZRVT(JL)-ZB_RV(JL))/ &
- &SIGN(MAX(ABS(ZA_RV(JL)), 1.E-20), ZA_RV(JL))
- ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
- &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
- &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRVT(JL))) + & !WHERE(ZRVT(:)>XRTMIN(6)) .OR.
- &MAX(0., -SIGN(1., -ZA_RV(JL)))) !WHERE(ZA_RV(:)>0.)
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
- ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
-
- ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
- &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RC(JL)))) ! WHERE(ABS(ZA_RC(:))>1.E-20)
- ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
- &ZW1D(JL)*(SIGN(1., ZA_RC(JL))*XMRSTEP+Z0RCT(JL)-ZRCT(JL)-ZB_RC(JL))/ &
- &SIGN(MAX(ABS(ZA_RC(JL)), 1.E-20), ZA_RC(JL))
- ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
- &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
- &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRCT(JL))) + & !WHERE(ZRCT(:)>XRTMIN(6)) .OR.
- &MAX(0., -SIGN(1., -ZA_RC(JL)))) !WHERE(ZA_RC(:)>0.)
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
- ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
-
- ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
- &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RR(JL)))) ! WHERE(ABS(ZA_RR(:))>1.E-20)
- ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
- &ZW1D(JL)*(SIGN(1., ZA_RR(JL))*XMRSTEP+Z0RRT(JL)-ZRRT(JL)-ZB_RR(JL))/ &
- &SIGN(MAX(ABS(ZA_RR(JL)), 1.E-20), ZA_RR(JL))
- ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
- &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
- &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRRT(JL))) + & !WHERE(ZRRT(:)>XRTMIN(6)) .OR.
- &MAX(0., -SIGN(1., -ZA_RR(JL)))) !WHERE(ZA_RR(:)>0.)
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
- ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
-
- ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
- &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RI(JL)))) ! WHERE(ABS(ZA_RI(:))>1.E-20)
- ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
- &ZW1D(JL)*(SIGN(1., ZA_RI(JL))*XMRSTEP+Z0RIT(JL)-ZRIT(JL)-ZB_RI(JL))/ &
- &SIGN(MAX(ABS(ZA_RI(JL)), 1.E-20), ZA_RI(JL))
- ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
- &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
- &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRIT(JL))) + & !WHERE(ZRIT(:)>XRTMIN(6)) .OR.
- &MAX(0., -SIGN(1., -ZA_RI(JL)))) !WHERE(ZA_RI(:)>0.)
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
- ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
-
- ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
- &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RS(JL)))) ! WHERE(ABS(ZA_RS(:))>1.E-20)
- ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
- &ZW1D(JL)*(SIGN(1., ZA_RS(JL))*XMRSTEP+Z0RST(JL)-ZRST(JL)-ZB_RS(JL))/ &
- &SIGN(MAX(ABS(ZA_RS(JL)), 1.E-20), ZA_RS(JL))
- ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
- &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
- &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRST(JL))) + & !WHERE(ZRST(:)>XRTMIN(6)) .OR.
- &MAX(0., -SIGN(1., -ZA_RS(JL)))) !WHERE(ZA_RS(:)>0.)
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
- ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
-
- ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
- &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RG(JL)))) ! WHERE(ABS(ZA_RG(:))>1.E-20)
- ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
- &ZW1D(JL)*(SIGN(1., ZA_RG(JL))*XMRSTEP+Z0RGT(JL)-ZRGT(JL)-ZB_RG(JL))/ &
- &SIGN(MAX(ABS(ZA_RG(JL)), 1.E-20), ZA_RG(JL))
- ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
- &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
- &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRGT(JL))) + & !WHERE(ZRGT(:)>XRTMIN(6)) .OR.
- &MAX(0., -SIGN(1., -ZA_RG(JL)))) !WHERE(ZA_RG(:)>0.)
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
- ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+ !
+ !*** 4.4 Mixing ratio change due to each process
+ !
+ IF(LBU_ENABLE) THEN
+ DO JL=1, IMICRO
+ ZTOT_RVHENI (JMICRO+JL-1)=ZTOT_RVHENI (JMICRO+JL-1)+ZRVHENI_MR(JL)
+ ZTOT_RCHONI (JMICRO+JL-1)=ZTOT_RCHONI (JMICRO+JL-1)+ZRCHONI (JL)*ZMAXTIME(JL)
+ ZTOT_RRHONG (JMICRO+JL-1)=ZTOT_RRHONG (JMICRO+JL-1)+ZRRHONG_MR(JL)
+ ZTOT_RVDEPS (JMICRO+JL-1)=ZTOT_RVDEPS (JMICRO+JL-1)+ZRVDEPS (JL)*ZMAXTIME(JL)
+ ZTOT_RIAGGS (JMICRO+JL-1)=ZTOT_RIAGGS (JMICRO+JL-1)+ZRIAGGS (JL)*ZMAXTIME(JL)
+ ZTOT_RIAUTS (JMICRO+JL-1)=ZTOT_RIAUTS (JMICRO+JL-1)+ZRIAUTS (JL)*ZMAXTIME(JL)
+ ZTOT_RVDEPG (JMICRO+JL-1)=ZTOT_RVDEPG (JMICRO+JL-1)+ZRVDEPG (JL)*ZMAXTIME(JL)
+ ZTOT_RCAUTR (JMICRO+JL-1)=ZTOT_RCAUTR (JMICRO+JL-1)+ZRCAUTR (JL)*ZMAXTIME(JL)
+ ZTOT_RCACCR (JMICRO+JL-1)=ZTOT_RCACCR (JMICRO+JL-1)+ZRCACCR (JL)*ZMAXTIME(JL)
+ ZTOT_RREVAV (JMICRO+JL-1)=ZTOT_RREVAV (JMICRO+JL-1)+ZRREVAV (JL)*ZMAXTIME(JL)
+ ZTOT_RCRIMSS(JMICRO+JL-1)=ZTOT_RCRIMSS(JMICRO+JL-1)+ZRCRIMSS (JL)*ZMAXTIME(JL)
+ ZTOT_RCRIMSG(JMICRO+JL-1)=ZTOT_RCRIMSG(JMICRO+JL-1)+ZRCRIMSG (JL)*ZMAXTIME(JL)
+ ZTOT_RSRIMCG(JMICRO+JL-1)=ZTOT_RSRIMCG(JMICRO+JL-1)+ZRSRIMCG (JL)*ZMAXTIME(JL)+ZRSRIMCG_MR(JL)
+ ZTOT_RRACCSS(JMICRO+JL-1)=ZTOT_RRACCSS(JMICRO+JL-1)+ZRRACCSS (JL)*ZMAXTIME(JL)
+ ZTOT_RRACCSG(JMICRO+JL-1)=ZTOT_RRACCSG(JMICRO+JL-1)+ZRRACCSG (JL)*ZMAXTIME(JL)
+ ZTOT_RSACCRG(JMICRO+JL-1)=ZTOT_RSACCRG(JMICRO+JL-1)+ZRSACCRG (JL)*ZMAXTIME(JL)
+ ZTOT_RSMLTG (JMICRO+JL-1)=ZTOT_RSMLTG (JMICRO+JL-1)+ZRSMLTG (JL)*ZMAXTIME(JL)
+ ZTOT_RCMLTSR(JMICRO+JL-1)=ZTOT_RCMLTSR(JMICRO+JL-1)+ZRCMLTSR (JL)*ZMAXTIME(JL)
+ ZTOT_RICFRRG(JMICRO+JL-1)=ZTOT_RICFRRG(JMICRO+JL-1)+ZRICFRRG (JL)*ZMAXTIME(JL)
+ ZTOT_RRCFRIG(JMICRO+JL-1)=ZTOT_RRCFRIG(JMICRO+JL-1)+ZRRCFRIG (JL)*ZMAXTIME(JL)
+ ZTOT_RICFRR (JMICRO+JL-1)=ZTOT_RICFRR (JMICRO+JL-1)+ZRICFRR (JL)*ZMAXTIME(JL)
+ ZTOT_RCWETG (JMICRO+JL-1)=ZTOT_RCWETG (JMICRO+JL-1)+ZRCWETG (JL)*ZMAXTIME(JL)
+ ZTOT_RIWETG (JMICRO+JL-1)=ZTOT_RIWETG (JMICRO+JL-1)+ZRIWETG (JL)*ZMAXTIME(JL)
+ ZTOT_RRWETG (JMICRO+JL-1)=ZTOT_RRWETG (JMICRO+JL-1)+ZRRWETG (JL)*ZMAXTIME(JL)
+ ZTOT_RSWETG (JMICRO+JL-1)=ZTOT_RSWETG (JMICRO+JL-1)+ZRSWETG (JL)*ZMAXTIME(JL)
+ ZTOT_RWETGH (JMICRO+JL-1)=ZTOT_RWETGH (JMICRO+JL-1)+ZRWETGH (JL)*ZMAXTIME(JL)+ZRWETGH_MR(JL)
+ ZTOT_RCDRYG (JMICRO+JL-1)=ZTOT_RCDRYG (JMICRO+JL-1)+ZRCDRYG (JL)*ZMAXTIME(JL)
+ ZTOT_RIDRYG (JMICRO+JL-1)=ZTOT_RIDRYG (JMICRO+JL-1)+ZRIDRYG (JL)*ZMAXTIME(JL)
+ ZTOT_RRDRYG (JMICRO+JL-1)=ZTOT_RRDRYG (JMICRO+JL-1)+ZRRDRYG (JL)*ZMAXTIME(JL)
+ ZTOT_RSDRYG (JMICRO+JL-1)=ZTOT_RSDRYG (JMICRO+JL-1)+ZRSDRYG (JL)*ZMAXTIME(JL)
+ ZTOT_RGMLTR (JMICRO+JL-1)=ZTOT_RGMLTR (JMICRO+JL-1)+ZRGMLTR (JL)*ZMAXTIME(JL)
+ ZTOT_RCWETH (JMICRO+JL-1)=ZTOT_RCWETH (JMICRO+JL-1)+ZRCWETH (JL)*ZMAXTIME(JL)
+ ZTOT_RIWETH (JMICRO+JL-1)=ZTOT_RIWETH (JMICRO+JL-1)+ZRIWETH (JL)*ZMAXTIME(JL)
+ ZTOT_RSWETH (JMICRO+JL-1)=ZTOT_RSWETH (JMICRO+JL-1)+ZRSWETH (JL)*ZMAXTIME(JL)
+ ZTOT_RGWETH (JMICRO+JL-1)=ZTOT_RGWETH (JMICRO+JL-1)+ZRGWETH (JL)*ZMAXTIME(JL)
+ ZTOT_RRWETH (JMICRO+JL-1)=ZTOT_RRWETH (JMICRO+JL-1)+ZRRWETH (JL)*ZMAXTIME(JL)
+ ZTOT_RCDRYH (JMICRO+JL-1)=ZTOT_RCDRYH (JMICRO+JL-1)+ZRCDRYH (JL)*ZMAXTIME(JL)
+ ZTOT_RIDRYH (JMICRO+JL-1)=ZTOT_RIDRYH (JMICRO+JL-1)+ZRIDRYH (JL)*ZMAXTIME(JL)
+ ZTOT_RSDRYH (JMICRO+JL-1)=ZTOT_RSDRYH (JMICRO+JL-1)+ZRSDRYH (JL)*ZMAXTIME(JL)
+ ZTOT_RRDRYH (JMICRO+JL-1)=ZTOT_RRDRYH (JMICRO+JL-1)+ZRRDRYH (JL)*ZMAXTIME(JL)
+ ZTOT_RGDRYH (JMICRO+JL-1)=ZTOT_RGDRYH (JMICRO+JL-1)+ZRGDRYH (JL)*ZMAXTIME(JL)
+ ZTOT_RDRYHG (JMICRO+JL-1)=ZTOT_RDRYHG (JMICRO+JL-1)+ZRDRYHG (JL)*ZMAXTIME(JL)
+ ZTOT_RHMLTR (JMICRO+JL-1)=ZTOT_RHMLTR (JMICRO+JL-1)+ZRHMLTR (JL)*ZMAXTIME(JL)
+ ZTOT_RIMLTC (JMICRO+JL-1)=ZTOT_RIMLTC (JMICRO+JL-1)+ZRIMLTC_MR(JL)
+ ZTOT_RCBERI (JMICRO+JL-1)=ZTOT_RCBERI (JMICRO+JL-1)+ZRCBERI (JL)*ZMAXTIME(JL)
+ ENDDO
+ ENDIF
+ !
+ !*** 4.5 Next loop
+ !
+ LSOFT=.TRUE. ! We try to adjust tendencies (inner while loop)
ENDDO
+ ENDDO
- IF(KRR==7) THEN
+ IF(GEXT_TEND) THEN
+ !Z..T variables contain the external tendency, we substract it
+ DO JV=0, KRR
DO JL=1, IMICRO
- ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
- &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RH(JL)))) ! WHERE(ABS(ZA_RH(:))>1.E-20)
- ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
- &ZW1D(JL)*(SIGN(1., ZA_RH(JL))*XMRSTEP+Z0RHT(JL)-ZRHT(JL)-ZB_RH(JL))/ &
- &SIGN(MAX(ABS(ZA_RH(JL)), 1.E-20), ZA_RH(JL))
- ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
- &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
- &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRHT(JL))) + & !WHERE(ZRHT(:)>XRTMIN(6)) .OR.
- &MAX(0., -SIGN(1., -ZA_RH(JL)))) !WHERE(ZA_RH(:)>0.)
- ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
- &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
- ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+ ZVART(JL, JV) = ZVART(JL, JV) - ZEXTPK(JL, JV) * PTSTEP
ENDDO
- ENDIF
-
- DO JL=1, IMICRO
- ZW1D(JL)=MAX(ABS(ZB_RV(JL)), ABS(ZB_RC(JL)), ABS(ZB_RR(JL)), ABS(ZB_RI(JL)), &
- &ABS(ZB_RS(JL)), ABS(ZB_RG(JL)), ABS(ZB_RH(JL)))
- ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & !WHERE(IITER(:)<INB_ITER_MAX)
- &MAX(0., -SIGN(1., XMRSTEP-ZW1D(JL))) !WHERE(ZW1D(:)>XMRSTEP)
- ZMAXTIME(JL)=(1.-ZW1D(JL))*ZMAXTIME(JL)
- ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
ENDDO
ENDIF
- !
- !*** 4.3 New values of variables for next iteration
- !
- DO JL=1, IMICRO
- ZTHT(JL)=ZTHT(JL)+ZA_TH(JL)*ZMAXTIME(JL)+ZB_TH(JL)
- ZRVT(JL)=ZRVT(JL)+ZA_RV(JL)*ZMAXTIME(JL)+ZB_RV(JL)
- ZRCT(JL)=ZRCT(JL)+ZA_RC(JL)*ZMAXTIME(JL)+ZB_RC(JL)
- ZRRT(JL)=ZRRT(JL)+ZA_RR(JL)*ZMAXTIME(JL)+ZB_RR(JL)
- ZRIT(JL)=ZRIT(JL)+ZA_RI(JL)*ZMAXTIME(JL)+ZB_RI(JL)
- ZRST(JL)=ZRST(JL)+ZA_RS(JL)*ZMAXTIME(JL)+ZB_RS(JL)
- ZRGT(JL)=ZRGT(JL)+ZA_RG(JL)*ZMAXTIME(JL)+ZB_RG(JL)
- ZCIT(JL)=ZCIT(JL) * MAX(0., -SIGN(1., -ZRIT(JL))) ! WHERE(ZRIT(:)==0.) ZCIT(:) = 0.
- ENDDO
- IF(KRR==7) ZRHT(:)=ZRHT(:)+ZA_RH(:)*ZMAXTIME(:)+ZB_RH(:)
- !
- !*** 4.4 Mixing ratio change due to each process
- !
- IF(LBU_ENABLE) THEN
- ZTOT_RVHENI(:)= ZTOT_RVHENI(:) +ZRVHENI_MR(:)
- ZTOT_RCHONI(:)= ZTOT_RCHONI(:) +ZRCHONI(:) *ZMAXTIME(:)
- ZTOT_RRHONG(:)= ZTOT_RRHONG(:) +ZRRHONG_MR(:)
- ZTOT_RVDEPS(:)= ZTOT_RVDEPS(:) +ZRVDEPS(:) *ZMAXTIME(:)
- ZTOT_RIAGGS(:)= ZTOT_RIAGGS(:) +ZRIAGGS(:) *ZMAXTIME(:)
- ZTOT_RIAUTS(:)= ZTOT_RIAUTS(:) +ZRIAUTS(:) *ZMAXTIME(:)
- ZTOT_RVDEPG(:)= ZTOT_RVDEPG(:) +ZRVDEPG(:) *ZMAXTIME(:)
- ZTOT_RCAUTR(:)= ZTOT_RCAUTR(:) +ZRCAUTR(:) *ZMAXTIME(:)
- ZTOT_RCACCR(:)= ZTOT_RCACCR(:) +ZRCACCR(:) *ZMAXTIME(:)
- ZTOT_RREVAV(:)= ZTOT_RREVAV(:) +ZRREVAV(:) *ZMAXTIME(:)
- ZTOT_RCRIMSS(:)=ZTOT_RCRIMSS(:)+ZRCRIMSS(:)*ZMAXTIME(:)
- ZTOT_RCRIMSG(:)=ZTOT_RCRIMSG(:)+ZRCRIMSG(:)*ZMAXTIME(:)
- ZTOT_RSRIMCG(:)=ZTOT_RSRIMCG(:)+ZRSRIMCG(:)*ZMAXTIME(:)+ZRSRIMCG_MR(:)
- ZTOT_RRACCSS(:)=ZTOT_RRACCSS(:)+ZRRACCSS(:)*ZMAXTIME(:)
- ZTOT_RRACCSG(:)=ZTOT_RRACCSG(:)+ZRRACCSG(:)*ZMAXTIME(:)
- ZTOT_RSACCRG(:)=ZTOT_RSACCRG(:)+ZRSACCRG(:)*ZMAXTIME(:)
- ZTOT_RSMLTG(:)= ZTOT_RSMLTG(:) +ZRSMLTG(:) *ZMAXTIME(:)
- ZTOT_RCMLTSR(:)=ZTOT_RCMLTSR(:)+ZRCMLTSR(:) *ZMAXTIME(:)
- ZTOT_RICFRRG(:)=ZTOT_RICFRRG(:)+ZRICFRRG(:)*ZMAXTIME(:)
- ZTOT_RRCFRIG(:)=ZTOT_RRCFRIG(:)+ZRRCFRIG(:)*ZMAXTIME(:)
- ZTOT_RICFRR(:)= ZTOT_RICFRR(:) +ZRICFRR(:) *ZMAXTIME(:)
- ZTOT_RCWETG(:)= ZTOT_RCWETG(:) +ZRCWETG(:) *ZMAXTIME(:)
- ZTOT_RIWETG(:)= ZTOT_RIWETG(:) +ZRIWETG(:) *ZMAXTIME(:)
- ZTOT_RRWETG(:)= ZTOT_RRWETG(:) +ZRRWETG(:) *ZMAXTIME(:)
- ZTOT_RSWETG(:)= ZTOT_RSWETG(:) +ZRSWETG(:) *ZMAXTIME(:)
- ZTOT_RWETGH(:)= ZTOT_RWETGH(:) +ZRWETGH(:) *ZMAXTIME(:)+ZRWETGH_MR(:)
- ZTOT_RCDRYG(:)= ZTOT_RCDRYG(:) +ZRCDRYG(:) *ZMAXTIME(:)
- ZTOT_RIDRYG(:)= ZTOT_RIDRYG(:) +ZRIDRYG(:) *ZMAXTIME(:)
- ZTOT_RRDRYG(:)= ZTOT_RRDRYG(:) +ZRRDRYG(:) *ZMAXTIME(:)
- ZTOT_RSDRYG(:)= ZTOT_RSDRYG(:) +ZRSDRYG(:) *ZMAXTIME(:)
- ZTOT_RGMLTR(:)= ZTOT_RGMLTR(:) +ZRGMLTR(:) *ZMAXTIME(:)
- ZTOT_RCWETH(:)= ZTOT_RCWETH(:) +ZRCWETH(:) *ZMAXTIME(:)
- ZTOT_RIWETH(:)= ZTOT_RIWETH(:) +ZRIWETH(:) *ZMAXTIME(:)
- ZTOT_RSWETH(:)= ZTOT_RSWETH(:) +ZRSWETH(:) *ZMAXTIME(:)
- ZTOT_RGWETH(:)= ZTOT_RGWETH(:) +ZRGWETH(:) *ZMAXTIME(:)
- ZTOT_RRWETH(:)= ZTOT_RRWETH(:) +ZRRWETH(:) *ZMAXTIME(:)
- ZTOT_RCDRYH(:)= ZTOT_RCDRYH(:) +ZRCDRYH(:) *ZMAXTIME(:)
- ZTOT_RIDRYH(:)= ZTOT_RIDRYH(:) +ZRIDRYH(:) *ZMAXTIME(:)
- ZTOT_RSDRYH(:)= ZTOT_RSDRYH(:) +ZRSDRYH(:) *ZMAXTIME(:)
- ZTOT_RRDRYH(:)= ZTOT_RRDRYH(:) +ZRRDRYH(:) *ZMAXTIME(:)
- ZTOT_RGDRYH(:)= ZTOT_RGDRYH(:) +ZRGDRYH(:) *ZMAXTIME(:)
- ZTOT_RDRYHG(:)= ZTOT_RDRYHG(:) +ZRDRYHG(:) *ZMAXTIME(:)
- ZTOT_RHMLTR(:)= ZTOT_RHMLTR(:) +ZRHMLTR(:) *ZMAXTIME(:)
- ZTOT_RIMLTC(:)= ZTOT_RIMLTC(:) +ZRIMLTC_MR(:)
- ZTOT_RCBERI(:)= ZTOT_RCBERI(:) +ZRCBERI(:) *ZMAXTIME(:)
- ENDIF
- !
- !*** 4.5 Next loop
- !
- LSOFT=.TRUE. ! We try to adjust tendencies (inner while loop)
- ZTIME(:)=ZTIME(:)+ZMAXTIME(:)
- ENDDO
-ENDDO
+
!-------------------------------------------------------------------------------
!
!* 5. UNPACKING DIAGNOSTICS
! ---------------------
!
-IF(IMICRO>0) THEN
- ZHLC_HCF3D(:,:,:)=0.
- ZHLC_LCF3D(:,:,:)=0.
- ZHLC_HRC3D(:,:,:)=0.
- ZHLC_LRC3D(:,:,:)=0.
- ZHLI_HCF3D(:,:,:)=0.
- ZHLI_LCF3D(:,:,:)=0.
- ZHLI_HRI3D(:,:,:)=0.
- ZHLI_LRI3D(:,:,:)=0.
- DO JL=1,IMICRO
- ZHLC_HCF3D(I1(JL), I2(JL), I3(JL)) = ZHLC_HCF(JL)
- ZHLC_LCF3D(I1(JL), I2(JL), I3(JL)) = ZHLC_LCF(JL)
- ZHLC_HRC3D(I1(JL), I2(JL), I3(JL)) = ZHLC_HRC(JL)
- ZHLC_LRC3D(I1(JL), I2(JL), I3(JL)) = ZHLC_LRC(JL)
- ZHLI_LCF3D(I1(JL), I2(JL), I3(JL)) = ZHLI_LCF(JL)
- ZHLI_HCF3D(I1(JL), I2(JL), I3(JL)) = ZHLI_HCF(JL)
- ZHLI_HRI3D(I1(JL), I2(JL), I3(JL)) = ZHLI_HRI(JL)
- ZHLI_LRI3D(I1(JL), I2(JL), I3(JL)) = ZHLI_LRI(JL)
- PCIT(I1(JL), I2(JL), I3(JL)) = ZCIT(JL)
- END DO
-ELSE
- PRAINFR(:,:,:)=0.
- ZHLC_HCF3D(:,:,:)=0.
- ZHLC_LCF3D(:,:,:)=0.
- ZHLC_HRC3D(:,:,:)=0.
- ZHLC_LRC3D(:,:,:)=0.
- ZHLI_HCF3D(:,:,:)=0.
- ZHLI_LCF3D(:,:,:)=0.
- ZHLI_HRI3D(:,:,:)=0.
- ZHLI_LRI3D(:,:,:)=0.
- PCIT(:,:,:) = 0.
-ENDIF
-IF(OWARM) THEN
- PEVAP3D(:,:,:) = 0.
- DO JL=1,IMICRO
- PEVAP3D(I1(JL), I2(JL), I3(JL)) = ZRREVAV(JL)
- END DO
-ENDIF
-!
+ DO JL=1, IMICRO
+ ZCITOUT (I1(JL),I2(JL),I3(JL))=ZCIT (JL)
+ IF(OWARM) THEN
+ PEVAP3D(I1(JL),I2(JL),I3(JL))=ZRREVAV(JL)
+ ENDIF
+ ZWR(I1(JL),I2(JL),I3(JL),IRV)=ZVART(JL, IRV)
+ ZWR(I1(JL),I2(JL),I3(JL),IRC)=ZVART(JL, IRC)
+ ZWR(I1(JL),I2(JL),I3(JL),IRR)=ZVART(JL, IRR)
+ ZWR(I1(JL),I2(JL),I3(JL),IRI)=ZVART(JL, IRI)
+ ZWR(I1(JL),I2(JL),I3(JL),IRS)=ZVART(JL, IRS)
+ ZWR(I1(JL),I2(JL),I3(JL),IRG)=ZVART(JL, IRG)
+ IF (KRR==7) THEN
+ ZWR(I1(JL),I2(JL),I3(JL),IRH)=ZVART(JL, IRH)
+ ENDIF
+ ENDDO
+
+ ENDDO ! JMICRO
+ENDIF ! KSIZE > 0
+PCIT(:,:,:)=ZCITOUT(:,:,:)
+
+!==========================================================================================================
+
+
!
!* 6. COMPUTES THE SLOW COLD PROCESS SOURCES OUTSIDE OF ODMICRO POINTS
! ----------------------------------------------------------------
!
CALL ICE4_NUCLEATION_WRAPPER(KIT, KJT, KKT, .NOT. ODMICRO, &
- PTHT, PPABST, PRHODREF, PEXN, ZZ_LSFACT/PEXN, ZT, &
+ PTHT, PPABST, PRHODREF, PEXN, ZZ_LSFACT, ZT, &
PRVT, &
PCIT, ZZ_RVHENI_MR)
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. TOTAL TENDENCIES
+! ----------------
+!
+!
+!*** 7.1 total tendencies limited by available species
+!
DO JK = 1, KKT
DO JJ = 1, KJT
+!DEC$ IVDEP
DO JI = 1, KIT
+ !LV/LS
ZZ_LSFACT(JI,JJ,JK)=ZZ_LSFACT(JI,JJ,JK)/PEXNREF(JI,JJ,JK)
ZZ_LVFACT(JI,JJ,JK)=ZZ_LVFACT(JI,JJ,JK)/PEXNREF(JI,JJ,JK)
+
+ !Tendency dure to nucleation on non ODMICRO points
ZZ_RVHENI(JI,JJ,JK) = MIN(PRVS(JI,JJ,JK), ZZ_RVHENI_MR(JI,JJ,JK)/PTSTEP)
- PRIS(JI,JJ,JK)=PRIS(JI,JJ,JK)+ZZ_RVHENI(JI,JJ,JK)
- PRVS(JI,JJ,JK)=PRVS(JI,JJ,JK)-ZZ_RVHENI(JI,JJ,JK)
- PTHS(JI,JJ,JK)=PTHS(JI,JJ,JK) + ZZ_RVHENI(JI,JJ,JK)*ZZ_LSFACT(JI,JJ,JK)
+
+ !Hydrometeor tendencies is the difference between old state and new state (can be negative)
+ ZWR(JI,JJ,JK,IRV)=(ZWR(JI,JJ,JK,IRV)-PRVT(JI,JJ,JK))*ZINV_TSTEP
+ ZWR(JI,JJ,JK,IRC)=(ZWR(JI,JJ,JK,IRC)-PRCT(JI,JJ,JK))*ZINV_TSTEP
+ ZWR(JI,JJ,JK,IRR)=(ZWR(JI,JJ,JK,IRR)-PRRT(JI,JJ,JK))*ZINV_TSTEP
+ ZWR(JI,JJ,JK,IRI)=(ZWR(JI,JJ,JK,IRI)-PRIT(JI,JJ,JK))*ZINV_TSTEP
+ ZWR(JI,JJ,JK,IRS)=(ZWR(JI,JJ,JK,IRS)-PRST(JI,JJ,JK))*ZINV_TSTEP
+ ZWR(JI,JJ,JK,IRG)=(ZWR(JI,JJ,JK,IRG)-PRGT(JI,JJ,JK))*ZINV_TSTEP
+ IF(KRR==7) THEN
+ ZWR(JI,JJ,JK,IRH)=(ZWR(JI,JJ,JK,IRH)-PRHT(JI,JJ,JK))*ZINV_TSTEP
+ ENDIF
+
+ !Theta tendency computed from hydrometeors tendencies
+ ZWR(JI,JJ,JK, ITH) = (ZWR(JI,JJ,JK,IRC)+ZWR(JI,JJ,JK,IRR))*ZZ_LVFACT(JI,JJ,JK)+ &
+ & (ZWR(JI,JJ,JK,IRI)+ZWR(JI,JJ,JK,IRS)+ZWR(JI,JJ,JK,IRG)+ &
+ & ZWR(JI,JJ,JK,IRH))*ZZ_LSFACT(JI,JJ,JK)
+
+ !We apply these tendencies to the S variables
+ !including the nucleation part
+ PTHS(JI,JJ,JK) = PTHS(JI,JJ,JK) + ZWR(JI,JJ,JK,ITH)+ZZ_RVHENI(JI,JJ,JK)*ZZ_LSFACT(JI,JJ,JK)
+ PRVS(JI,JJ,JK) = PRVS(JI,JJ,JK) + ZWR(JI,JJ,JK,IRV)-ZZ_RVHENI(JI,JJ,JK)
+ PRCS(JI,JJ,JK) = PRCS(JI,JJ,JK) + ZWR(JI,JJ,JK,IRC)
+ PRRS(JI,JJ,JK) = PRRS(JI,JJ,JK) + ZWR(JI,JJ,JK,IRR)
+ PRIS(JI,JJ,JK) = PRIS(JI,JJ,JK) + ZWR(JI,JJ,JK,IRI)+ZZ_RVHENI(JI,JJ,JK)
+ PRSS(JI,JJ,JK) = PRSS(JI,JJ,JK) + ZWR(JI,JJ,JK,IRS)
+ PRGS(JI,JJ,JK) = PRGS(JI,JJ,JK) + ZWR(JI,JJ,JK,IRG)
+ IF (KRR==7) THEN
+ PRHS(JI,JJ,JK) = PRHS(JI,JJ,JK) + ZWR(JI,JJ,JK,IRH)
+ ENDIF
ENDDO
ENDDO
ENDDO
-!
-if ( lbu_enable ) then
- !Note: there is an other contribution for HENU later
- if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HENU', zz_rvheni(:, :, :) * prhodj(:, :, :) )
-end if
-!-------------------------------------------------------------------------------
-!
-!* 7. UNPACKING AND TOTAL TENDENCIES
-! ------------------------------
-!
-!
-!*** 7.1 total tendencies limited by available species
-!
-! ZW_??S variables will contain the new S variables values
-!
-IF(GEXT_TEND) THEN
- !Z..T variables contain the exeternal tendency, we substract it
- DO JL=1, IMICRO
- ZRVT(JL) = ZRVT(JL) - ZEXT_RV(JL) * PTSTEP
- ZRCT(JL) = ZRCT(JL) - ZEXT_RC(JL) * PTSTEP
- ZRRT(JL) = ZRRT(JL) - ZEXT_RR(JL) * PTSTEP
- ZRIT(JL) = ZRIT(JL) - ZEXT_RI(JL) * PTSTEP
- ZRST(JL) = ZRST(JL) - ZEXT_RS(JL) * PTSTEP
- ZRGT(JL) = ZRGT(JL) - ZEXT_RG(JL) * PTSTEP
- ZTHT(JL) = ZTHT(JL) - ZEXT_TH(JL) * PTSTEP
- ENDDO
- IF (KRR==7) ZRHT(:) = ZRHT(:) - ZEXT_RH(:) * PTSTEP
-ENDIF
-!Tendencies computed from difference between old state and new state (can be negative)
- ZW_RVS(:,:,:) = 0.
- ZW_RCS(:,:,:) = 0.
- ZW_RRS(:,:,:) = 0.
- ZW_RIS(:,:,:) = 0.
- ZW_RSS(:,:,:) = 0.
- ZW_RGS(:,:,:) = 0.
- ZW_RHS(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW_RVS(I1(JL), I2(JL), I3(JL)) = ( ZRVT(JL) - PRVT(I1(JL), I2(JL), I3(JL)) ) * ZINV_TSTEP
- ZW_RCS(I1(JL), I2(JL), I3(JL)) = ( ZRCT(JL) - PRCT(I1(JL), I2(JL), I3(JL)) ) * ZINV_TSTEP
- ZW_RRS(I1(JL), I2(JL), I3(JL)) = ( ZRRT(JL) - PRRT(I1(JL), I2(JL), I3(JL)) ) * ZINV_TSTEP
- ZW_RIS(I1(JL), I2(JL), I3(JL)) = ( ZRIT(JL) - PRIT(I1(JL), I2(JL), I3(JL)) ) * ZINV_TSTEP
- ZW_RSS(I1(JL), I2(JL), I3(JL)) = ( ZRST(JL) - PRST(I1(JL), I2(JL), I3(JL)) ) * ZINV_TSTEP
- ZW_RGS(I1(JL), I2(JL), I3(JL)) = ( ZRGT(JL) - PRGT(I1(JL), I2(JL), I3(JL)) ) * ZINV_TSTEP
- END DO
- IF(KRR==7) THEN
- DO JL=1,IMICRO
- ZW_RHS(I1(JL), I2(JL), I3(JL)) = ( ZRHT(JL) - PRHT(I1(JL), I2(JL), I3(JL)) ) * ZINV_TSTEP
- END DO
-END IF
-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
-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(:,:,:)
-ZW_THS(:,:,:) = PTHS(:,:,:) + ZW_THS(:,:,:)
-
-if ( lbu_enable ) then
- if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'CORR', zw_ths(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'CORR', zw_rvs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'CORR', zw_rcs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'CORR', zw_rrs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CORR', zw_ris(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'CORR', zw_rss(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'CORR', zw_rgs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'CORR', zw_rhs(:, :, :) * prhodj(:, :, :) )
-end if
-!We correct negativities with conservation
-CALL CORRECT_NEGATIVITIES(KIT, KJT, KKT, KRR, ZW_RVS, ZW_RCS, ZW_RRS, &
- &ZW_RIS, ZW_RSS, ZW_RGS, &
- &ZW_THS, ZZ_LVFACT, ZZ_LSFACT, ZW_RHS)
-
-if ( lbu_enable ) then
- if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'CORR', zw_ths(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'CORR', zw_rvs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'CORR', zw_rcs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'CORR', zw_rrs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CORR', zw_ris(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'CORR', zw_rss(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'CORR', zw_rgs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'CORR', zw_rhs(:, :, :) * prhodj(:, :, :) )
-end if
!
!*** 7.2 LBU_ENABLE case
!
IF(LBU_ENABLE) THEN
- allocate( zw1( size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
- allocate( zw2( size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
- allocate( zw3( size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
- allocate( zw4( size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
- if ( krr == 7 ) then
- allocate( zw5( size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
- allocate( zw6( size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
- end if
-
- if ( lbudget_th ) then
- allocate( zz_diff( size( zz_lsfact, 1 ), size( zz_lsfact, 2 ), size( zz_lsfact, 3 ) ) )
- zz_diff(:, :, :) = zz_lsfact(:, :, :) - zz_lvfact(:, :, :)
- end if
+ IF (LBUDGET_TH) THEN
+ ZZ_DIFF(:, :, :) = ZZ_LSFACT(:, :, :) - ZZ_LVFACT(:, :, :)
+ END IF
ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RVHENI(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RVHENI(JL) * ZINV_TSTEP
END DO
- if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HENU', zw(:, :, :) * zz_lsfact(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'HENU', -zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HENU', zw(:, :, :) * prhodj(:, :, :) )
+ ZW(:,:,:)=ZW(:,:,:)+ZZ_RVHENI
+ IF (LBUDGET_TH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'HENU', ZW(:, :, :)*ZZ_LSFACT(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RV) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RV), 'HENU', -ZW(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RI) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RI), 'HENU', ZW(:, :, :) *PRHODJ(:, :, :))
ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCHONI(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RCHONI(JL) * ZINV_TSTEP
END DO
- if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HON', zw(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'HON', -zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HON', zw(:, :, :) * prhodj(:, :, :) )
+ IF (LBUDGET_TH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'HON', ZW(:, :, :)*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RC) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RC), 'HON', -ZW(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RI) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RI), 'HON', ZW(:, :, :) *PRHODJ(:, :, :))
ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RRHONG(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RRHONG(JL) * ZINV_TSTEP
END DO
- if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'SFR', zw(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'SFR', -zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'SFR', zw(:, :, :) * prhodj(:, :, :) )
+ IF (LBUDGET_TH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'SFR', ZW(:, :, :)*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'SFR', -ZW(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'SFR', ZW(:, :, :) *PRHODJ(:, :, :))
ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RVDEPS(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RVDEPS(JL) * ZINV_TSTEP
END DO
- if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPS', zw(:, :, :) * zz_lsfact(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPS', -zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'DEPS', zw(:, :, :) * prhodj(:, :, :) )
+ IF (LBUDGET_TH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'DEPS', ZW(:, :, :)*ZZ_LSFACT(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RV) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RV), 'DEPS', -ZW(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RS) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RS), 'DEPS', ZW(:, :, :) *PRHODJ(:, :, :))
ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RIAGGS(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RIAGGS(JL) * ZINV_TSTEP
END DO
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'AGGS', -zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'AGGS', zw(:, :, :) * prhodj(:, :, :) )
+ IF (LBUDGET_RI) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RI), 'AGGS', -ZW(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RS) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RS), 'AGGS', ZW(:, :, :)*PRHODJ(:, :, :))
ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RIAUTS(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RIAUTS(JL) * ZINV_TSTEP
END DO
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'AUTS', -zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'AUTS', zw(:, :, :) * prhodj(:, :, :) )
+ IF (LBUDGET_RI) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RI), 'AUTS', -ZW(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RS) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RS), 'AUTS', ZW(:, :, :)*PRHODJ(:, :, :))
ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RVDEPG(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RVDEPG(JL) * ZINV_TSTEP
END DO
- if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPG', zw(:, :, :) * zz_lsfact(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPG', -zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'DEPG', zw(:, :, :) * prhodj(:, :, :) )
+ IF (LBUDGET_TH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'DEPG', ZW(:, :, :)*ZZ_LSFACT(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RV) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RV), 'DEPG', -ZW(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'DEPG', ZW(:, :, :) *PRHODJ(:, :, :))
IF(OWARM) THEN
ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCAUTR(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RCAUTR(JL) * ZINV_TSTEP
END DO
- if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'AUTO', -zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'AUTO', zw(:, :, :) * prhodj(:, :, :) )
+ IF (LBUDGET_RC) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RC), 'AUTO', -ZW(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'AUTO', ZW(:, :, :)*PRHODJ(:, :, :))
ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCACCR(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RCACCR(JL) * ZINV_TSTEP
END DO
- if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'ACCR', -zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'ACCR', zw(:, :, :) * prhodj(:, :, :) )
+ IF (LBUDGET_RC) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RC), 'ACCR', -ZW(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'ACCR', ZW(:, :, :)*PRHODJ(:, :, :))
ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RREVAV(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RREVAV(JL) * ZINV_TSTEP
END DO
- if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'REVA', -zw(:, :, :) * zz_lvfact(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'REVA', zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'REVA', -zw(:, :, :) * prhodj(:, :, :) )
+ IF (LBUDGET_TH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'REVA', -ZW(:, :, :)*ZZ_LVFACT(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RV) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RV), 'REVA', ZW(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'REVA', -ZW(:, :, :) *PRHODJ(:, :, :))
ENDIF
ZW1(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RCRIMSS(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW1(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RCRIMSS(JL) * ZINV_TSTEP
END DO
ZW2(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RCRIMSG(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW2(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RCRIMSG(JL) * ZINV_TSTEP
END DO
ZW3(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RSRIMCG(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW3(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RSRIMCG(JL) * ZINV_TSTEP
END DO
- if ( lbudget_th ) &
- call Budget_store_add( tbudgets(NBUDGET_TH), 'RIM', ( zw1(:, :, :) + zw2(:, :, :) ) * zz_diff(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'RIM', ( -zw1(:, :, :) - zw2(:, :, :) ) * prhodj(:, :, :) )
- if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'RIM', ( zw1(:, :, :) - zw3(:, :, :) ) * prhodj(:, :, :) )
- if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'RIM', ( zw2(:, :, :) + zw3(:, :, :) ) * prhodj(:, :, :) )
+ IF (LBUDGET_TH) &
+ CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'RIM', (ZW1(:, :, :)+ZW2(:, :, :))*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RC) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RC), 'RIM', (-ZW1(:, :, :)-ZW2(:, :, :))*PRHODJ(:, :, :))
+ IF (LBUDGET_RS) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RS), 'RIM', ( ZW1(:, :, :)-ZW3(:, :, :))*PRHODJ(:, :, :))
+ IF (LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'RIM', ( ZW2(:, :, :)+ZW3(:, :, :))*PRHODJ(:, :, :))
ZW1(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RRACCSS(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW1(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RRACCSS(JL) * ZINV_TSTEP
END DO
ZW2(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RRACCSG(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW2(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RRACCSG(JL) * ZINV_TSTEP
END DO
ZW3(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RSACCRG(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW3(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RSACCRG(JL) * ZINV_TSTEP
END DO
- if ( lbudget_th ) &
- call Budget_store_add( tbudgets(NBUDGET_TH), 'ACC', ( zw1(:, :, :) + zw2(:, :, :) ) * zz_diff(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'ACC', ( -zw1(:, :, :) - zw2(:, :, :) ) * prhodj(:, :, :) )
- if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'ACC', ( zw1(:, :, :) - zw3(:, :, :) ) * prhodj(:, :, :) )
- if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'ACC', ( zw2(:, :, :) + zw3(:, :, :) ) * prhodj(:, :, :) )
+ IF (LBUDGET_TH) &
+ CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'ACC', (ZW1(:, :, :)+ZW2(:, :, :) )*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'ACC', (-ZW1(:, :, :)-ZW2(:, :, :))*PRHODJ(:, :, :))
+ IF (LBUDGET_RS) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RS), 'ACC', ( ZW1(:, :, :)-ZW3(:, :, :))*PRHODJ(:, :, :))
+ IF (LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'ACC', ( ZW2(:, :, :)+ZW3(:, :, :))*PRHODJ(:, :, :))
ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RSMLTG(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RSMLTG(JL) * ZINV_TSTEP
END DO
- if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'CMEL', -zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'CMEL', zw(:, :, :) * prhodj(:, :, :) )
+ IF (LBUDGET_RS) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RS), 'CMEL', -ZW(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'CMEL', ZW(:, :, :)*PRHODJ(:, :, :))
ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCMLTSR(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RCMLTSR(JL) * ZINV_TSTEP
END DO
- if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'CMEL', -zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'CMEL', zw(:, :, :) * prhodj(:, :, :) )
+ IF (LBUDGET_RC) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RC), 'CMEL', -ZW(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'CMEL', ZW(:, :, :)*PRHODJ(:, :, :))
ZW1(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RICFRRG(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW1(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RICFRRG(JL) * ZINV_TSTEP
END DO
ZW2(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RRCFRIG(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW2(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RRCFRIG(JL) * ZINV_TSTEP
END DO
ZW3(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RICFRR(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW3(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RICFRR(JL) * ZINV_TSTEP
END DO
- if ( lbudget_th ) &
- call Budget_store_add( tbudgets(NBUDGET_TH), 'CFRZ', zw2(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'CFRZ', ( -zw2(:, :, :) + zw3(:, :, :) ) * prhodj(:, :, :) )
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'CFRZ', ( -zw1(:, :, :) - zw3(:, :, :) ) * prhodj(:, :, :) )
- if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'CFRZ', ( zw1(:, :, :) + zw2(:, :, :) ) * prhodj(:, :, :) )
+ IF (LBUDGET_TH) &
+ CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'CFRZ', ZW2(:, :, :)*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'CFRZ', (-ZW2(:, :, :)+ZW3(:, :, :))*PRHODJ(:, :, :))
+ IF (LBUDGET_RI) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RI), 'CFRZ', (-ZW1(:, :, :)-ZW3(:, :, :))*PRHODJ(:, :, :))
+ IF (LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'CFRZ', ( ZW1(:, :, :)+ZW2(:, :, :))*PRHODJ(:, :, :))
ZW1(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RCWETG(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW1(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RCWETG(JL) * ZINV_TSTEP
END DO
ZW2(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RRWETG(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW2(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RRWETG(JL) * ZINV_TSTEP
END DO
ZW3(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RIWETG(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW3(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RIWETG(JL) * ZINV_TSTEP
END DO
ZW4(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW4(I1(JL), I2(JL), I3(JL)) = ZTOT_RSWETG(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW4(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RSWETG(JL) * ZINV_TSTEP
END DO
- if ( lbudget_th ) &
- call Budget_store_add( tbudgets(NBUDGET_TH), 'WETG', ( zw1(:, :, :) + zw2(:, :, :) ) * zz_diff(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'WETG', -zw1(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'WETG', -zw2(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'WETG', -zw3(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'WETG', -zw4(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'WETG', ( zw1(:, :, :) + zw2(:, :, :) &
- + zw3(:, :, :) + zw4(:, :, :) ) &
- * prhodj(:, :, :) )
+ IF (LBUDGET_TH) &
+ CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'WETG', (ZW1(:, :, :)+ZW2(:, :, :))*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RC) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RC), 'WETG', -zw1(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'WETG', -zw2(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RI) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RI), 'WETG', -zw3(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RS) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RS), 'WETG', -zw4(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'WETG', (ZW1(:, :, :)+ZW2(:, :, :)+ZW3(:, :, :)+ZW4(:, :, :)) &
+ & *PRHODJ(:, :, :))
IF(KRR==7) THEN
ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RWETGH(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RWETGH(JL) * ZINV_TSTEP
END DO
- if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'GHCV', -zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rh ) call Budget_store_add( tbudgets(NBUDGET_RH), 'GHCV', zw(:, :, :) * prhodj(:, :, :) )
+ IF (LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'GHCV', -ZW(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RH), 'GHCV', ZW(:, :, :)*PRHODJ(:, :, :))
END IF
ZW1(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RCDRYG(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW1(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RCDRYG(JL) * ZINV_TSTEP
END DO
ZW2(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RRDRYG(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW2(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RRDRYG(JL) * ZINV_TSTEP
END DO
ZW3(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RIDRYG(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW3(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RIDRYG(JL) * ZINV_TSTEP
END DO
ZW4(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW4(I1(JL), I2(JL), I3(JL)) = ZTOT_RSDRYG(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW4(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RSDRYG(JL) * ZINV_TSTEP
END DO
- if ( lbudget_th ) &
- call Budget_store_add( tbudgets(NBUDGET_TH), 'DRYG', ( zw1(:, :, :) + zw2(:, :, :) ) * zz_diff(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'DRYG', -zw1(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'DRYG', -zw2(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'DRYG', -zw3(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'DRYG', -zw4(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'DRYG', ( zw1(:, :, :) + zw2(:, :, :) &
- + zw3(:, :, :) + zw4(:, :, :) ) &
- * prhodj(:, :, :) )
+ IF (LBUDGET_TH) &
+ CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'DRYG', (ZW1(:, :, :)+ZW2(:, :, :) )*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RC) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RC), 'DRYG', -zw1(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'DRYG', -zw2(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RI) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RI), 'DRYG', -zw3(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RS) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RS), 'DRYG', -zw4(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'DRYG', (ZW1(:, :, :)+ZW2(:, :, :)+ZW3(:, :, :)+ZW4(:, :, :)) &
+ & *PRHODJ(:, :, :))
ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RGMLTR(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RGMLTR(JL) * ZINV_TSTEP
END DO
- if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'GMLT', -zw(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'GMLT', zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'GMLT', -zw(:, :, :) * prhodj(:, :, :) )
+ IF (LBUDGET_TH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'GMLT', -ZW(:, :, :)*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'GMLT', ZW(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'GMLT', -ZW(:, :, :) *PRHODJ(:, :, :))
IF(KRR==7) THEN
ZW1(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RCWETH(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW1(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RCWETH(JL) * ZINV_TSTEP
END DO
ZW2(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RRWETH(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW2(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RRWETH(JL) * ZINV_TSTEP
END DO
ZW3(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RIWETH(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW3(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RIWETH(JL) * ZINV_TSTEP
END DO
ZW4(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW4(I1(JL), I2(JL), I3(JL)) = ZTOT_RSWETH(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW4(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RSWETH(JL) * ZINV_TSTEP
END DO
ZW5(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW5(I1(JL), I2(JL), I3(JL)) = ZTOT_RGWETH(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW5(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RGWETH(JL) * ZINV_TSTEP
END DO
- if ( lbudget_th ) &
- call Budget_store_add( tbudgets(NBUDGET_TH), 'WETH', ( zw1(:, :, :) + zw2(:, :, :) ) * zz_diff(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'WETH', -zw1(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'WETH', -zw2(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'WETH', -zw3(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'WETH', -zw4(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'WETH', -zw5(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rh ) call Budget_store_add( tbudgets(NBUDGET_RH), 'WETH', ( zw1(:, :, :) + zw2(:, :, :) + zw3(:, :, :) &
- + zw4(:, :, :) + zw5(:, :, : ) ) &
- * prhodj(:, :, :) )
+ IF (LBUDGET_TH) &
+ CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'WETH', (ZW1(:, :, :)+ZW2(:, :, :))*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RC) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RC), 'WETH', -ZW1(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'WETH', -ZW2(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RI) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RI), 'WETH', -ZW3(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RS) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RS), 'WETH', -ZW4(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'WETH', -ZW5(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RH), 'WETH', (ZW1(:, :, :)+ZW2(:, :, :)+ZW3(:, :, :)+ &
+ &ZW4(:, :, :)+ZW5(:, :, : )) *PRHODJ(:, :, :))
ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RGWETH(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RGWETH(JL) * ZINV_TSTEP
END DO
- if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'HGCV', -zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rh ) call Budget_store_add( tbudgets(NBUDGET_RH), 'HGCV', zw(:, :, :) * prhodj(:, :, :) )
+ IF (LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'HGCV', -ZW(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RH), 'HGCV', ZW(:, :, :)*PRHODJ(:, :, :))
ZW1(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RCDRYH(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW1(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RCDRYH(JL) * ZINV_TSTEP
END DO
ZW2(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RRDRYH(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW2(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RRDRYH(JL) * ZINV_TSTEP
END DO
ZW3(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RIDRYH(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW3(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RIDRYH(JL) * ZINV_TSTEP
END DO
ZW4(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW4(I1(JL), I2(JL), I3(JL)) = ZTOT_RSDRYH(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW4(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RSDRYH(JL) * ZINV_TSTEP
END DO
ZW5(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW5(I1(JL), I2(JL), I3(JL)) = ZTOT_RGDRYH(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW5(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RGDRYH(JL) * ZINV_TSTEP
END DO
ZW6(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW6(I1(JL), I2(JL), I3(JL)) = ZTOT_RDRYHG(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW6(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RDRYHG(JL) * ZINV_TSTEP
END DO
- if ( lbudget_th ) &
- call Budget_store_add( tbudgets(NBUDGET_TH), 'DRYH', ( zw1(:, :, :) + zw2(:, :, :) ) * zz_diff(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'DRYH', -zw1(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'DRYH', -zw2(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'DRYH', -zw3(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'DRYH', -zw4(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'DRYH', ( -zw5(:, :, :) + zw6(:, :, : ) ) * prhodj(:, :, :) )
- if ( lbudget_rh ) call Budget_store_add( tbudgets(NBUDGET_RH), 'DRYH', ( zw1(:, :, :) + zw2(:, :, :) + zw3(:, :, :) &
- + zw4(:, :, :) + zw5(:, :, : )- zw6(:, :, :) ) &
- * prhodj(:, :, :) )
+ IF (LBUDGET_TH) &
+ CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'DRYH', (ZW1(:, :, :)+ZW2(:, :, :))*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RC) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RC), 'DRYH', -ZW1(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'DRYH', -ZW2(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RI) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RI), 'DRYH', -ZW3(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RS) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RS), 'DRYH', -ZW4(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RG) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RG), 'DRYH', (-ZW5(:, :, :)+ZW6(:, :, : )) *PRHODJ(:, :, :))
+ IF (LBUDGET_RH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RH), 'DRYH', (ZW1(:, :, :)+ZW2(:, :, :)+ZW3(:, :, :)+ &
+ &ZW4(:, :, :)+ZW5(:, :, : )-ZW6(:, :, :)) &
+ & *PRHODJ(:, :, :))
ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RHMLTR(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RHMLTR(JL) * ZINV_TSTEP
END DO
- if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HMLT', -zw(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'HMLT', zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rh ) call Budget_store_add( tbudgets(NBUDGET_RH), 'HMLT', -zw(:, :, :) * prhodj(:, :, :) )
+ IF (LBUDGET_TH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'HMLT', -ZW(:, :, :)*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RR), 'HMLT', ZW(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RH), 'HMLT', -ZW(:, :, :) *PRHODJ(:, :, :))
ENDIF
ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RIMLTC(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RIMLTC(JL) * ZINV_TSTEP
END DO
- if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'IMLT', -zw(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'IMLT', zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'IMLT', -zw(:, :, :) * prhodj(:, :, :) )
+ IF (LBUDGET_TH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'IMLT', -ZW(:, :, :)*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RC) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RC), 'IMLT', ZW(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RI) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RI), 'IMLT', -ZW(:, :, :) *PRHODJ(:, :, :))
ZW(:,:,:) = 0.
- DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCBERI(JL) * ZINV_TSTEP
+ DO JL=1, KSIZE
+ ZW(I1TOT(JL), I2TOT(JL), I3TOT(JL)) = ZTOT_RCBERI(JL) * ZINV_TSTEP
END DO
- if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'BERFI', zw(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'BERFI', -zw(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'BERFI', zw(:, :, :) * prhodj(:, :, :) )
+ IF (LBUDGET_TH) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_TH), 'BERFI', ZW(:, :, :)*ZZ_DIFF(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RC) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RC), 'BERFI', -ZW(:, :, :) *PRHODJ(:, :, :))
+ IF (LBUDGET_RI) CALL BUDGET_STORE_ADD(TBUDGETS(NBUDGET_RI), 'BERFI', ZW(:, :, :) *PRHODJ(:, :, :))
- deallocate( zw1, zw2, zw3, zw4 )
- if ( krr == 7 ) deallocate( zw5, zw6 )
- if ( lbudget_th ) deallocate( zz_diff )
ENDIF
!
!*** 7.3 Final tendencies
!
-DO JK = 1, KKT
- DO JJ = 1, KJT
- DO JI = 1, KIT
- PRVS(JI,JJ,JK) = ZW_RVS(JI,JJ,JK)
- PRCS(JI,JJ,JK) = ZW_RCS(JI,JJ,JK)
- PRRS(JI,JJ,JK) = ZW_RRS(JI,JJ,JK)
- PRIS(JI,JJ,JK) = ZW_RIS(JI,JJ,JK)
- PRSS(JI,JJ,JK) = ZW_RSS(JI,JJ,JK)
- PRGS(JI,JJ,JK) = ZW_RGS(JI,JJ,JK)
- PTHS(JI,JJ,JK) = ZW_THS(JI,JJ,JK)
- ENDDO
- ENDDO
-ENDDO
-IF (KRR==7) PRHS(:,:,:) = ZW_RHS(:,:,:)
+IF (LBU_ENABLE) THEN
+ IF (LBUDGET_TH) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_TH), 'CORR', PTHS(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RV) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RV), 'CORR', PRVS(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RC) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RC), 'CORR', PRCS(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RR), 'CORR', PRSS(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RI) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RI), 'CORR', PRIS(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RS) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RS), 'CORR', PRSS(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RG) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RG), 'CORR', PRGS(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RH), 'CORR', PRHS(:, :, :)*PRHODJ(:, :, :))
+END IF
+
+!NOTE:
+! This call cannot be moved before the preeceding budget calls because,
+! with AROME, the BUDGET_STORE_INIT does nothing. The equivalent is done only
+! once before the physics call and copies of the S variables evolve automatically
+! internally to the budget (DDH) machinery at each BUDGET_STORE_ADD and
+! BUDGET_STORE_END calls. Thus, the difference between the DDH internal version
+! of the S variables and the S variables used in the folowing BUDGET_STORE_END
+! call must only be due to the correction of negativities.
+!
+!We correct negativities with conservation
+CALL CORRECT_NEGATIVITIES(KIT, KJT, KKT, KRR, PRVS, PRCS, PRRS, &
+ &PRIS, PRSS, PRGS, &
+ &PTHS, ZZ_LVFACT, ZZ_LSFACT, PRHS)
+
+IF (LBU_ENABLE) THEN
+ IF (LBUDGET_TH) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_TH), 'CORR', PTHS(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RV) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RV), 'CORR', PRVS(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RC) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RC), 'CORR', PRCS(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RR), 'CORR', PRRS(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RI) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RI), 'CORR', PRIS(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RS) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RS), 'CORR', PRSS(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RG) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RG), 'CORR', PRGS(:, :, :)*PRHODJ(:, :, :))
+ IF (LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RH), 'CORR', PRHS(:, :, :)*PRHODJ(:, :, :))
+END IF
!
!-------------------------------------------------------------------------------
!
@@ -1706,37 +1636,53 @@ IF(LSEDIM_AFTER) THEN
!
!* 8.1 sedimentation
!
- if ( lbudget_rc .and. osedic ) call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
-
- !Init only if not osedic (to prevent crash with double init)
- !Remark: the 2 source terms SEDI and DEPO could be mixed and stored in the same source term (SEDI)
- ! if osedic=T and ldeposc=T (a warning is printed in ini_budget in that case)
- if ( lbudget_rc .and. ldeposc .and. .not.osedic ) &
- call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
+ IF (LBUDGET_RC .and. osedic) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RC), 'SEDI', PRCS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RR), 'SEDI', PRRS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RI) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RI), 'SEDI', PRIS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RS) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RS), 'SEDI', PRSS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RG) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RG), 'SEDI', PRGS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RH), 'SEDI', PRHS(:, :, :) * PRHODJ(:, :, :))
IF(HSEDIM=='STAT') THEN
- !SR: It *seems* that we must have two separate calls for ifort
- IF(KRR==7) THEN
+ IF (KRR==7) THEN
+ DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ ZRCT(JI,JJ,JK)=PRCS(JI,JJ,JK)*PTSTEP
+ ZRRT(JI,JJ,JK)=PRRS(JI,JJ,JK)*PTSTEP
+ ZRIT(JI,JJ,JK)=PRIS(JI,JJ,JK)*PTSTEP
+ ZRST(JI,JJ,JK)=PRSS(JI,JJ,JK)*PTSTEP
+ ZRGT(JI,JJ,JK)=PRGS(JI,JJ,JK)*PTSTEP
+ ZRHT(JI,JJ,JK)=PRHS(JI,JJ,JK)*PTSTEP
+ ENDDO
+ ENDDO
+ ENDDO
CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
+ &PTSTEP, KRR, OSEDIC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
- &PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,&
- &PRSS, PRSS*PTSTEP, PRGS, PRGS*PTSTEP,&
- &PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
+ &PRCS, ZRCT, PRRS, ZRRT, PRIS, ZRIT,&
+ &PRSS, ZRST, PRGS, ZRGT,&
+ &PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
&PSEA=PSEA, PTOWN=PTOWN, &
- &PINPRH=PINPRH, PRHT=PRHS*PTSTEP, PRHS=PRHS, PFPR=PFPR)
+ &PINPRH=PINPRH, PRHT=ZRHT, PRHS=PRHS, PFPR=PFPR)
ELSE
+ DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ ZRCT(JI,JJ,JK)=PRCS(JI,JJ,JK)*PTSTEP
+ ZRRT(JI,JJ,JK)=PRRS(JI,JJ,JK)*PTSTEP
+ ZRIT(JI,JJ,JK)=PRIS(JI,JJ,JK)*PTSTEP
+ ZRST(JI,JJ,JK)=PRSS(JI,JJ,JK)*PTSTEP
+ ZRGT(JI,JJ,JK)=PRGS(JI,JJ,JK)*PTSTEP
+ ENDDO
+ ENDDO
+ ENDDO
CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ,&
+ &PTSTEP, KRR, OSEDIC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
- &PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,&
- &PRSS, PRSS*PTSTEP, PRGS, PRGS*PTSTEP,&
- &PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
+ &PRCS, ZRCT, PRRS, ZRRT, PRIS, ZRIT,&
+ &PRSS, ZRST, PRGS, ZRGT,&
+ &PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
&PSEA=PSEA, PTOWN=PTOWN, &
&PFPR=PFPR)
ENDIF
@@ -1746,18 +1692,18 @@ IF(LSEDIM_AFTER) THEN
!SR: It *seems* that we must have two separate calls for ifort
IF(KRR==7) THEN
CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
+ &PTSTEP, KRR, OSEDIC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
- &PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
+ &PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
&PSEA=PSEA, PTOWN=PTOWN, &
&PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR)
ELSE
CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
+ &PTSTEP, KRR, OSEDIC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
- &PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
+ &PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
&PSEA=PSEA, PTOWN=PTOWN, &
&PFPR=PFPR)
ENDIF
@@ -1767,33 +1713,28 @@ IF(LSEDIM_AFTER) THEN
! It is initialized with the m.r. at T and is modified by two tendencies:
! sedimentation tendency and an external tendency which represents all other
! processes (mainly advection and microphysical processes). If both tendencies
- ! are negative, sedimentation can remove a specie at a given sub-timestep. From
+ ! are negative, sedimentation can remove a species at a given sub-timestep. From
! this point sedimentation stops for the remaining sub-timesteps but the other tendency
! will be still active and will lead to negative values.
- ! We could prevent the algorithm to not consume too much a specie, instead we apply
+ ! We could prevent the algorithm to not consume too much a species, instead we apply
! a correction here.
CALL CORRECT_NEGATIVITIES(KIT, KJT, KKT, KRR, PRVS, PRCS, PRRS, &
&PRIS, PRSS, PRGS, &
&PTHS, ZZ_LVFACT, ZZ_LSFACT, PRHS)
ELSE
- call Print_msg( NVERB_FATAL, 'GEN', 'RAIN_ICE_RED', 'no sedimentation scheme for HSEDIM='//HSEDIM )
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'RAIN_ICE', 'no sedimentation scheme for HSEDIM='//HSEDIM)
END IF
!
!* 8.2 budget storage
!
- if ( lbudget_rc .and. osedic ) call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
-
- !If osedic=T and ldeposc=T, DEPO is in fact mixed and stored with the SEDI source term
- !(a warning is printed in ini_budget in that case)
- if ( lbudget_rc .and. ldeposc .and. .not.osedic) &
- call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
-
- !sedimentation of rain fraction
+ IF (LBUDGET_RC .AND. OSEDIC) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RC), 'SEDI', PRCS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RR) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RR), 'SEDI', PRRS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RI) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RI), 'SEDI', PRIS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RS) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RS), 'SEDI', PRSS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RG) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RG), 'SEDI', PRGS(:, :, :) * PRHODJ(:, :, :))
+ IF (LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RH), 'SEDI', PRHS(:, :, :) * PRHODJ(:, :, :))
+
+ !"sedimentation" of rain fraction
IF (PRESENT(PRHS)) THEN
CALL ICE4_RAINFR_VERT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, KKT, KKL, PRAINFR, PRRS(:,:,:)*PTSTEP, &
&PRSS(:,:,:)*PTSTEP, PRGS(:,:,:)*PTSTEP, PRHS(:,:,:)*PTSTEP)
@@ -1803,6 +1744,29 @@ IF(LSEDIM_AFTER) THEN
ENDIF
ENDIF
!
+!-------------------------------------------------------------------------------
+!
+!* 9. COMPUTE THE FOG DEPOSITION TERM
+! -------------------------------------
+!
+IF (LDEPOSC) THEN !cloud water deposition on vegetation
+ IF (LBU_ENABLE .AND. LBUDGET_RC) &
+ & CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RC), 'DEPO', PRCS(:, :, :)*PRHODJ(:, :, :))
+
+ DO JJ = 1, KJT
+!DEC$ IVDEP
+ DO JI = 1, KIT
+ PINDEP(JI, JJ) = XVDEPOSC * PRCT(JI, JJ, IKB) * PRHODREF(JI, JJ, IKB) / XRHOLW
+ PRCS(JI, JJ, IKB) = PRCS(JI, JJ, IKB) - XVDEPOSC * PRCT(JI, JJ, IKB) / PDZZ(JI, JJ, IKB)
+ PINPRC(JI, JJ) = PINPRC(JI, JJ) + PINDEP(JI, JJ)
+ ENDDO
+ ENDDO
+
+ IF (LBU_ENABLE .AND. LBUDGET_RC) &
+ & CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RC), 'DEPO', PRCS(:, :, :)*PRHODJ(:, :, :))
+ENDIF
+
+IF (LHOOK) CALL DR_HOOK('RAIN_ICE', 1, ZHOOK_HANDLE)
!
CONTAINS
!
@@ -1817,105 +1781,90 @@ CONTAINS
REAL, DIMENSION(KIT, KJT, KKT), INTENT(IN) :: PLVFACT, PLSFACT
REAL, DIMENSION(KIT, KJT, KKT), OPTIONAL, INTENT(INOUT) :: PRH
!
- REAL, DIMENSION(KIT, KJT, KKT) :: ZW
+ REAL :: ZW
INTEGER :: JI, JJ, JK
+ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
+ IF (LHOOK) CALL DR_HOOK('RAIN_ICE:CORRECT_NEGATIVITIES', 0, ZHOOK_HANDLE)
!
!We correct negativities with conservation
- ! 1) deal with negative values for mixing ratio, except for vapor
DO JK = 1, KKT
DO JJ = 1, KJT
DO JI = 1, KIT
- ZW(JI,JJ,JK) =PRC(JI,JJ,JK)-MAX(PRC(JI,JJ,JK), 0.)
- PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
- PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLVFACT(JI,JJ,JK)
- PRC(JI,JJ,JK)=PRC(JI,JJ,JK)-ZW(JI,JJ,JK)
-
- ZW(JI,JJ,JK) =PRR(JI,JJ,JK)-MAX(PRR(JI,JJ,JK), 0.)
- PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
- PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLVFACT(JI,JJ,JK)
- PRR(JI,JJ,JK)=PRR(JI,JJ,JK)-ZW(JI,JJ,JK)
-
- ZW(JI,JJ,JK) =PRI(JI,JJ,JK)-MAX(PRI(JI,JJ,JK), 0.)
- PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
- PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
- PRI(JI,JJ,JK)=PRI(JI,JJ,JK)-ZW(JI,JJ,JK)
-
- ZW(JI,JJ,JK) =PRS(JI,JJ,JK)-MAX(PRS(JI,JJ,JK), 0.)
- PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
- PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
- PRS(JI,JJ,JK)=PRS(JI,JJ,JK)-ZW(JI,JJ,JK)
-
- ZW(JI,JJ,JK) =PRG(JI,JJ,JK)-MAX(PRG(JI,JJ,JK), 0.)
- PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
- PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
- PRG(JI,JJ,JK)=PRG(JI,JJ,JK)-ZW(JI,JJ,JK)
- ENDDO
- ENDDO
- ENDDO
-
- IF(KRR==7) THEN
- DO JK = 1, KKT
- DO JJ = 1, KJT
- DO JI = 1, KIT
- ZW(JI,JJ,JK) =PRH(JI,JJ,JK)-MAX(PRH(JI,JJ,JK), 0.)
- PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
- PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
- PRH(JI,JJ,JK)=PRH(JI,JJ,JK)-ZW(JI,JJ,JK)
- ENDDO
- ENDDO
- ENDDO
- ENDIF
+ ! 1) deal with negative values for mixing ratio, except for vapor
+ ZW =PRC(JI,JJ,JK)-MAX(PRC(JI,JJ,JK), 0.)
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW*PLVFACT(JI,JJ,JK)
+ PRC(JI,JJ,JK)=PRC(JI,JJ,JK)-ZW
+
+ ZW =PRR(JI,JJ,JK)-MAX(PRR(JI,JJ,JK), 0.)
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW*PLVFACT(JI,JJ,JK)
+ PRR(JI,JJ,JK)=PRR(JI,JJ,JK)-ZW
+
+ ZW =PRI(JI,JJ,JK)-MAX(PRI(JI,JJ,JK), 0.)
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW*PLSFACT(JI,JJ,JK)
+ PRI(JI,JJ,JK)=PRI(JI,JJ,JK)-ZW
+
+ ZW =PRS(JI,JJ,JK)-MAX(PRS(JI,JJ,JK), 0.)
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW*PLSFACT(JI,JJ,JK)
+ PRS(JI,JJ,JK)=PRS(JI,JJ,JK)-ZW
+
+ ZW =PRG(JI,JJ,JK)-MAX(PRG(JI,JJ,JK), 0.)
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW*PLSFACT(JI,JJ,JK)
+ PRG(JI,JJ,JK)=PRG(JI,JJ,JK)-ZW
+
+ IF(KRR==7) THEN
+ ZW =PRH(JI,JJ,JK)-MAX(PRH(JI,JJ,JK), 0.)
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW*PLSFACT(JI,JJ,JK)
+ PRH(JI,JJ,JK)=PRH(JI,JJ,JK)-ZW
+ ENDIF
+
+ ! 2) deal with negative vapor mixing ratio
- ! 2) deal with negative vapor mixing ratio
-
- DO JK = 1, KKT
- DO JJ = 1, KJT
- DO JI = 1, KIT
! for rc and ri, we keep ice fraction constant
- ZW(JI,JJ,JK)=MIN(1., MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.) / &
- &MAX(PRC(JI,JJ,JK)+PRI(JI,JJ,JK), 1.E-20)) ! Proportion of rc+ri to convert into rv
- PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)* &
+ ZW=MIN(1., MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.) / &
+ &MAX(PRC(JI,JJ,JK)+PRI(JI,JJ,JK), 1.E-20)) ! Proportion of rc+ri to convert into rv
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW* &
&(PRC(JI,JJ,JK)*PLVFACT(JI,JJ,JK)+PRI(JI,JJ,JK)*PLSFACT(JI,JJ,JK))
- PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)*(PRC(JI,JJ,JK)+PRI(JI,JJ,JK))
- PRC(JI,JJ,JK)=(1.-ZW(JI,JJ,JK))*PRC(JI,JJ,JK)
- PRI(JI,JJ,JK)=(1.-ZW(JI,JJ,JK))*PRI(JI,JJ,JK)
-
- ZW(JI,JJ,JK)=MIN(MAX(PRR(JI,JJ,JK), 0.), &
- &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rr to convert into rv
- PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
- PRR(JI,JJ,JK)=PRR(JI,JJ,JK)-ZW(JI,JJ,JK)
- PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLVFACT(JI,JJ,JK)
-
- ZW(JI,JJ,JK)=MIN(MAX(PRS(JI,JJ,JK), 0.), &
- &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rs to convert into rv
- PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
- PRS(JI,JJ,JK)=PRS(JI,JJ,JK)-ZW(JI,JJ,JK)
- PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
-
- ZW(JI,JJ,JK)=MIN(MAX(PRG(JI,JJ,JK), 0.), &
- &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rg to convert into rv
- PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
- PRG(JI,JJ,JK)=PRG(JI,JJ,JK)-ZW(JI,JJ,JK)
- PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW*(PRC(JI,JJ,JK)+PRI(JI,JJ,JK))
+ PRC(JI,JJ,JK)=(1.-ZW)*PRC(JI,JJ,JK)
+ PRI(JI,JJ,JK)=(1.-ZW)*PRI(JI,JJ,JK)
+
+ ZW=MIN(MAX(PRR(JI,JJ,JK), 0.), &
+ &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rr to convert into rv
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW
+ PRR(JI,JJ,JK)=PRR(JI,JJ,JK)-ZW
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW*PLVFACT(JI,JJ,JK)
+
+ ZW=MIN(MAX(PRS(JI,JJ,JK), 0.), &
+ &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rs to convert into rv
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW
+ PRS(JI,JJ,JK)=PRS(JI,JJ,JK)-ZW
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW*PLSFACT(JI,JJ,JK)
+
+ ZW=MIN(MAX(PRG(JI,JJ,JK), 0.), &
+ &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rg to convert into rv
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW
+ PRG(JI,JJ,JK)=PRG(JI,JJ,JK)-ZW
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW*PLSFACT(JI,JJ,JK)
+
+ IF(KRR==7) THEN
+ ZW=MIN(MAX(PRH(JI,JJ,JK), 0.), &
+ &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rh to convert into rv
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW
+ PRH(JI,JJ,JK)=PRH(JI,JJ,JK)-ZW
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW*PLSFACT(JI,JJ,JK)
+ ENDIF
ENDDO
ENDDO
ENDDO
-
- IF(KRR==7) THEN
- DO JK = 1, KKT
- DO JJ = 1, KJT
- DO JI = 1, KIT
- ZW(JI,JJ,JK)=MIN(MAX(PRH(JI,JJ,JK), 0.), &
- &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rh to convert into rv
- PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
- PRH(JI,JJ,JK)=PRH(JI,JJ,JK)-ZW(JI,JJ,JK)
- PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
- ENDDO
- ENDDO
- ENDDO
- ENDIF
!
+ IF (LHOOK) CALL DR_HOOK('RAIN_ICE:CORRECT_NEGATIVITIES', 1, ZHOOK_HANDLE)
!
END SUBROUTINE CORRECT_NEGATIVITIES