GCC Code Coverage Report


Directory: ./
File: phys/phytrac_mod.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 188 277 67.9%
Branches: 275 620 44.4%

Line Branch Exec Source
1 !$Id: phytrac_mod.F90 3870 2021-04-08 20:58:58Z fairhead $
2 MODULE phytrac_mod
3 !=================================================================================
4 ! Interface between the LMDZ physical package and tracer computation.
5 ! Chemistry modules (INCA, Reprobus or the more specific traclmdz routine)
6 ! are called from phytrac.
7 !
8 !======================================================================
9 ! Auteur(s) FH
10 ! Objet: Moniteur general des tendances traceurs
11 !
12 ! iflag_vdf_trac : Options for activating transport by vertical diffusion :
13 ! 1. notmal
14 ! 0. emission is injected in the first layer only, without diffusion
15 ! -1 no emission & no diffusion
16 ! Modification 2013/07/22 : transformed into a module to pass tendencies to
17 ! physics outputs. Additional keys for controling activation of sub processes.
18 ! Modification R. Pilon 10 octobre 2012 large scale scavenging incloud_scav + bc_scav
19 ! Modification R. Pilon 01 janvier 2012 transport+scavenging KE scheme : cvltr
20 !=================================================================================
21
22 !
23 ! Tracer tendencies, for outputs
24 !-------------------------------
25 REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_cl ! Td couche limite/traceur
26 REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_dec !RomP
27 REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_cv ! Td convection/traceur
28 ! RomP >>>
29 REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_insc
30 REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_bcscav
31 REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_evapls
32 REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_ls
33 REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_trsp
34 REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_sscav
35 REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_sat
36 REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_uscav
37 REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: qPr,qDi ! concentration tra dans pluie,air descente insaturee
38 REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: qPa,qMel
39 REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: qTrdi,dtrcvMA ! conc traceur descente air insaturee et td convective MA
40 ! RomP <<<
41 REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_th ! Td thermique
42 REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_lessi_impa ! Td du lessivage par impaction
43 REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_lessi_nucl ! Td du lessivage par nucleation
44 REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: qPrls !jyg: concentration tra dans pluie LS a la surf.
45 REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: d_tr_dry ! Td depot sec/traceur (1st layer),ALLOCATABLE,SAVE jyg
46 REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: flux_tr_dry ! depot sec/traceur (surface),ALLOCATABLE,SAVE jyg
47
48 !$OMP THREADPRIVATE(qPa,qMel,qTrdi,dtrcvMA,d_tr_th,d_tr_lessi_impa,d_tr_lessi_nucl)
49 !$OMP THREADPRIVATE(d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav,qPr,qDi)
50 !$OMP THREADPRIVATE(d_tr_insc,d_tr_bcscav,d_tr_evapls,d_tr_ls,qPrls)
51 !$OMP THREADPRIVATE(d_tr_cl,d_tr_dry,flux_tr_dry,d_tr_dec,d_tr_cv)
52
53
54 CONTAINS
55
56 37216802 SUBROUTINE phytrac_init()
57 USE dimphy
58 USE infotrac_phy, ONLY: nbtr, nqCO2, type_trac
59 USE tracco2i_mod, ONLY: tracco2i_init
60 IMPLICIT NONE
61
62
12/24
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
✓ Branch 9 taken 1 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 1 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 1 times.
✓ Branch 17 taken 1 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 1 times.
✗ Branch 20 not taken.
✗ Branch 21 not taken.
✓ Branch 22 taken 1 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 1 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 1 times.
4 ALLOCATE(d_tr_cl(klon,klev,nbtr),d_tr_dry(klon,nbtr))
63
16/32
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 1 times.
✓ Branch 11 taken 1 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 1 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 1 times.
✗ Branch 16 not taken.
✗ Branch 17 not taken.
✓ Branch 18 taken 1 times.
✗ Branch 20 not taken.
✓ Branch 21 taken 1 times.
✗ Branch 23 not taken.
✓ Branch 24 taken 1 times.
✓ Branch 26 taken 1 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 1 times.
✗ Branch 29 not taken.
✓ Branch 30 taken 1 times.
✗ Branch 31 not taken.
✗ Branch 32 not taken.
✓ Branch 33 taken 1 times.
✗ Branch 35 not taken.
✓ Branch 36 taken 1 times.
✗ Branch 38 not taken.
✓ Branch 39 taken 1 times.
6 ALLOCATE(flux_tr_dry(klon,nbtr),d_tr_dec(klon,klev,nbtr),d_tr_cv(klon,klev,nbtr))
64
12/24
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✓ Branch 7 taken 1 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 1 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 1 times.
✓ Branch 15 taken 1 times.
✗ Branch 16 not taken.
✓ Branch 17 taken 1 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 1 times.
✗ Branch 20 not taken.
✗ Branch 21 not taken.
✓ Branch 22 taken 1 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 1 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 1 times.
5 ALLOCATE(d_tr_insc(klon,klev,nbtr),d_tr_bcscav(klon,klev,nbtr))
65
12/24
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✓ Branch 7 taken 1 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 1 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 1 times.
✓ Branch 15 taken 1 times.
✗ Branch 16 not taken.
✓ Branch 17 taken 1 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 1 times.
✗ Branch 20 not taken.
✗ Branch 21 not taken.
✓ Branch 22 taken 1 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 1 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 1 times.
5 ALLOCATE(d_tr_evapls(klon,klev,nbtr),d_tr_ls(klon,klev,nbtr))
66
10/20
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 1 times.
✓ Branch 11 taken 1 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 1 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 1 times.
✗ Branch 16 not taken.
✗ Branch 17 not taken.
✓ Branch 18 taken 1 times.
✗ Branch 20 not taken.
✓ Branch 21 taken 1 times.
✗ Branch 23 not taken.
✓ Branch 24 taken 1 times.
4 ALLOCATE(qPrls(klon,nbtr),d_tr_trsp(klon,klev,nbtr))
67
12/24
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✓ Branch 7 taken 1 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 1 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 1 times.
✓ Branch 15 taken 1 times.
✗ Branch 16 not taken.
✓ Branch 17 taken 1 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 1 times.
✗ Branch 20 not taken.
✗ Branch 21 not taken.
✓ Branch 22 taken 1 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 1 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 1 times.
5 ALLOCATE(d_tr_sscav(klon,klev,nbtr),d_tr_sat(klon,klev,nbtr))
68
18/36
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✓ Branch 7 taken 1 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 1 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 1 times.
✓ Branch 15 taken 1 times.
✗ Branch 16 not taken.
✓ Branch 17 taken 1 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 1 times.
✗ Branch 20 not taken.
✗ Branch 21 not taken.
✓ Branch 22 taken 1 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 1 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 1 times.
✓ Branch 30 taken 1 times.
✗ Branch 31 not taken.
✓ Branch 32 taken 1 times.
✗ Branch 33 not taken.
✓ Branch 34 taken 1 times.
✗ Branch 35 not taken.
✗ Branch 36 not taken.
✓ Branch 37 taken 1 times.
✗ Branch 39 not taken.
✓ Branch 40 taken 1 times.
✗ Branch 42 not taken.
✓ Branch 43 taken 1 times.
7 ALLOCATE(d_tr_uscav(klon,klev,nbtr),qPr(klon,klev,nbtr),qDi(klon,klev,nbtr))
69
12/24
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✓ Branch 7 taken 1 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 1 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 1 times.
✓ Branch 15 taken 1 times.
✗ Branch 16 not taken.
✓ Branch 17 taken 1 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 1 times.
✗ Branch 20 not taken.
✗ Branch 21 not taken.
✓ Branch 22 taken 1 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 1 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 1 times.
5 ALLOCATE(qPa(klon,klev,nbtr),qMel(klon,klev,nbtr))
70
12/24
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✓ Branch 7 taken 1 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 1 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 1 times.
✓ Branch 15 taken 1 times.
✗ Branch 16 not taken.
✓ Branch 17 taken 1 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 1 times.
✗ Branch 20 not taken.
✗ Branch 21 not taken.
✓ Branch 22 taken 1 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 1 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 1 times.
5 ALLOCATE(qTrdi(klon,klev,nbtr),dtrcvMA(klon,klev,nbtr))
71
6/12
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✓ Branch 7 taken 1 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 1 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 1 times.
3 ALLOCATE(d_tr_th(klon,klev,nbtr))
72
12/24
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✓ Branch 7 taken 1 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 1 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 1 times.
✓ Branch 15 taken 1 times.
✗ Branch 16 not taken.
✓ Branch 17 taken 1 times.
✗ Branch 18 not taken.
✓ Branch 19 taken 1 times.
✗ Branch 20 not taken.
✗ Branch 21 not taken.
✓ Branch 22 taken 1 times.
✗ Branch 24 not taken.
✓ Branch 25 taken 1 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 1 times.
5 ALLOCATE(d_tr_lessi_impa(klon,klev,nbtr),d_tr_lessi_nucl(klon,klev,nbtr))
73
74
75
76 !===============================================================================
77 ! -- Do specific treatment according to chemestry model or local LMDZ tracers
78 !
79 !===============================================================================
80 SELECT CASE(type_trac)
81 CASE('co2i')
82 ! -- CO2 interactif --
83 CALL tracco2i_init()
84 CASE('inco')
85
1/3
✗ Branch 0 not taken.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
1 CALL tracco2i_init()
86 END SELECT
87
88
89 1 END SUBROUTINE phytrac_init
90
91 480 SUBROUTINE phytrac( &
92 nstep, julien, gmtime, debutphy, &
93 480 lafin, pdtphys, u, v, t_seri, &
94 480 paprs, pplay, pmfu, pmfd, &
95 pen_u, pde_u, pen_d, pde_d, &
96
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 cdragh, coefh, fm_therm, entr_therm, &
97
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 480 times.
480 yu1, yv1, ftsol, pctsrf, &
98
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 480 times.
960 ustar, u10m, v10m, &
99
4/8
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 480 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 480 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 480 times.
480 wstar, ale_bl, ale_wake, &
100 480 xlat, xlon, &
101 frac_impa,frac_nucl,beta_fisrt,beta_v1, &
102 presnivs, pphis, pphi, albsol, &
103 sh, ch, rh, cldfra, rneb, &
104 diafra, cldliq, itop_con, ibas_con, &
105 pmflxr, pmflxs, prfl, psfl, &
106 da, phi, mp, upwd, &
107 phi2, d1a, dam, sij, wght_cvfd, & ! RomP +RL
108 wdtrainA, wdtrainM, sigd, clw, elij, & ! RomP
109 evap, ep, epmlmMm, eplaMm, & ! RomP
110 dnwd, aerosol_couple, flxmass_w, &
111 tau_aero, piz_aero, cg_aero, ccm, &
112 rfname, &
113 d_tr_dyn, & ! RomP
114
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 tr_seri, init_source)
115 !
116 !======================================================================
117 ! Auteur(s) FH
118 ! Objet: Moniteur general des tendances traceurs
119 ! Modification R. Pilon 01 janvier 2012 transport+scavenging KE scheme : cvltr
120 ! Modification R. Pilon 10 octobre 2012 large scale scavenging incloud_scav + bc_scav
121 !======================================================================
122
123 USE ioipsl
124 USE phys_cal_mod, only : hour
125 USE dimphy
126 USE infotrac_phy, ONLY: nbtr, nqCO2, type_trac, conv_flg, solsym, pbl_flg
127 USE mod_grid_phy_lmdz
128 USE mod_phys_lmdz_para
129 USE iophy
130 USE traclmdz_mod
131 USE tracinca_mod
132 USE tracreprobus_mod
133 USE indice_sol_mod
134 USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
135 USE print_control_mod, ONLY: lunout
136 USE aero_mod, ONLY : naero_grp
137
138 USE tracco2i_mod
139
140
141 IMPLICIT NONE
142
143 INCLUDE "YOMCST.h"
144 INCLUDE "clesphys.h"
145 INCLUDE "thermcell.h"
146 !==========================================================================
147 ! -- ARGUMENT DESCRIPTION --
148 !==========================================================================
149
150 ! Input arguments
151 !----------------
152 !Configuration grille,temps:
153 INTEGER,INTENT(IN) :: nstep ! Appel physique
154 INTEGER,INTENT(IN) :: julien ! Jour julien
155 REAL,INTENT(IN) :: gmtime ! Heure courante
156 REAL,INTENT(IN) :: pdtphys ! Pas d'integration pour la physique (seconde)
157 LOGICAL,INTENT(IN) :: debutphy ! le flag de l'initialisation de la physique
158 LOGICAL,INTENT(IN) :: lafin ! le flag de la fin de la physique
159
160 REAL,DIMENSION(klon),INTENT(IN) :: xlat ! latitudes pour chaque point
161 REAL,DIMENSION(klon),INTENT(IN) :: xlon ! longitudes pour chaque point
162 !
163 !Physique:
164 !--------
165 REAL,DIMENSION(klon,klev),INTENT(IN) :: t_seri ! Temperature
166 REAL,DIMENSION(klon,klev),INTENT(IN) :: u ! variable not used
167 REAL,DIMENSION(klon,klev),INTENT(IN) :: v ! variable not used
168 REAL,DIMENSION(klon,klev),INTENT(IN) :: sh ! humidite specifique
169 REAL,DIMENSION(klon,klev),INTENT(IN) :: rh ! humidite relative
170 REAL,DIMENSION(klon,klev),INTENT(IN) :: ch ! eau liquide (+ glace si le traceur existe)
171 REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs ! pression pour chaque inter-couche (en Pa)
172 REAL,DIMENSION(klon,klev),INTENT(IN) :: pplay ! pression pour le mileu de chaque couche (en Pa)
173 REAL,DIMENSION(klon,klev),INTENT(IN) :: pphi ! geopotentiel
174 REAL,DIMENSION(klon),INTENT(IN) :: pphis
175 REAL,DIMENSION(klev),INTENT(IN) :: presnivs
176 REAL,DIMENSION(klon,klev),INTENT(IN) :: cldliq ! eau liquide nuageuse
177 REAL,DIMENSION(klon,klev),INTENT(IN) :: cldfra ! fraction nuageuse (tous les nuages)
178 REAL,DIMENSION(klon,klev),INTENT(IN) :: diafra ! fraction nuageuse (convection ou stratus artificiels)
179 REAL,DIMENSION(klon,klev),INTENT(IN) :: rneb ! fraction nuageuse (grande echelle)
180 !
181 REAL :: ql_incl ! contenu en eau liquide nuageuse dans le nuage ! ql_incl=oliq/rneb
182 REAL,DIMENSION(klon,klev),INTENT(IN) :: beta_fisrt ! taux de conversion de l'eau cond (de fisrtilp)
183 REAL,DIMENSION(klon,klev),INTENT(out) :: beta_v1 ! -- (originale version)
184
185 !
186 INTEGER,DIMENSION(klon),INTENT(IN) :: itop_con
187 INTEGER,DIMENSION(klon),INTENT(IN) :: ibas_con
188 REAL,DIMENSION(klon),INTENT(IN) :: albsol ! albedo surface
189 !
190 !Dynamique
191 !--------
192 REAL,DIMENSION(klon,klev,nbtr),INTENT(IN) :: d_tr_dyn
193 !
194 !Convection:
195 !----------
196 REAL,DIMENSION(klon,klev),INTENT(IN) :: pmfu ! flux de masse dans le panache montant
197 REAL,DIMENSION(klon,klev),INTENT(IN) :: pmfd ! flux de masse dans le panache descendant
198 REAL,DIMENSION(klon,klev),INTENT(IN) :: pen_u ! flux entraine dans le panache montant
199 REAL,DIMENSION(klon,klev),INTENT(IN) :: pde_u ! flux detraine dans le panache montant
200 REAL,DIMENSION(klon,klev),INTENT(IN) :: pen_d ! flux entraine dans le panache descendant
201 REAL,DIMENSION(klon,klev),INTENT(IN) :: pde_d ! flux detraine dans le panache descendant
202
203 !...Tiedke
204 REAL,DIMENSION(klon,klev+1),INTENT(IN) :: pmflxr, pmflxs ! Flux precipitant de pluie, neige aux interfaces [convection]
205 REAL,DIMENSION(klon,klev+1),INTENT(IN) :: prfl, psfl ! Flux precipitant de pluie, neige aux interfaces [large-scale]
206
207 LOGICAL,INTENT(IN) :: aerosol_couple
208 REAL,DIMENSION(klon,klev),INTENT(IN) :: flxmass_w
209 REAL,DIMENSION(klon,klev,naero_grp,2),INTENT(IN) :: tau_aero
210 REAL,DIMENSION(klon,klev,naero_grp,2),INTENT(IN) :: piz_aero
211 REAL,DIMENSION(klon,klev,naero_grp,2),INTENT(IN) :: cg_aero
212 CHARACTER(len=4),DIMENSION(naero_grp),INTENT(IN) :: rfname
213 REAL,DIMENSION(klon,klev,2),INTENT(IN) :: ccm
214 !... K.Emanuel
215 REAL,DIMENSION(klon,klev),INTENT(IN) :: da
216 REAL,DIMENSION(klon,klev,klev),INTENT(IN):: phi
217 ! RomP >>>
218 REAL,DIMENSION(klon,klev),INTENT(IN) :: d1a,dam
219 REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: phi2
220 !
221 REAL,DIMENSION(klon,klev),INTENT(IN) :: wdtrainA
222 REAL,DIMENSION(klon,klev),INTENT(IN) :: wdtrainM
223 REAL,DIMENSION(klon),INTENT(IN) :: sigd
224 ! ---- RomP flux entraine, detraine et precipitant kerry Emanuel
225 REAL,DIMENSION(klon,klev),INTENT(IN) :: evap
226 REAL,DIMENSION(klon,klev),INTENT(IN) :: ep
227 REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: sij
228 REAL,DIMENSION(klon,klev),INTENT(IN) :: wght_cvfd !RL
229 REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: elij
230 REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: epmlmMm
231 REAL,DIMENSION(klon,klev),INTENT(IN) :: eplaMm
232 REAL,DIMENSION(klon,klev),INTENT(IN) :: clw
233 ! RomP <<<
234
235 !
236 REAL,DIMENSION(klon,klev),INTENT(IN) :: mp
237 REAL,DIMENSION(klon,klev),INTENT(IN) :: upwd ! saturated updraft mass flux
238 REAL,DIMENSION(klon,klev),INTENT(IN) :: dnwd ! saturated downdraft mass flux
239 !
240 !Thermiques:
241 !----------
242 REAL,DIMENSION(klon,klev+1),INTENT(IN) :: fm_therm
243 REAL,DIMENSION(klon,klev),INTENT(IN) :: entr_therm
244 !
245 !Couche limite:
246 !--------------
247 !
248 REAL,DIMENSION(:),INTENT(IN) :: cdragh ! (klon) coeff drag pour T et Q
249 REAL,DIMENSION(:,:),INTENT(IN) :: coefh ! (klon,klev) coeff melange CL (m**2/s)
250 REAL,DIMENSION(:),INTENT(IN) :: ustar,u10m,v10m ! (klon) u* & vent a 10m (m/s)
251 REAL,DIMENSION(:),INTENT(IN) :: wstar,ale_bl,ale_wake ! (klon) w* and Avail. Lifting Ener.
252 REAL,DIMENSION(:),INTENT(IN) :: yu1 ! (klon) vents au premier niveau
253 REAL,DIMENSION(:),INTENT(IN) :: yv1 ! (klon) vents au premier niveau
254 !
255 !Lessivage:
256 !----------
257 !
258 REAL, DIMENSION(:), ALLOCATABLE, SAVE :: ccntrAA
259 REAL, DIMENSION(:), ALLOCATABLE, SAVE :: ccntrENV
260 REAL, DIMENSION(:), ALLOCATABLE, SAVE :: coefcoli
261 LOGICAL, DIMENSION(:), ALLOCATABLE, SAVE :: flag_cvltr
262 !$OMP THREADPRIVATE(ccntrAA,ccntrENV,coefcoli,flag_cvltr)
263 960 REAL, DIMENSION(klon,klev) :: ccntrAA_3d
264 960 REAL, DIMENSION(klon,klev) :: ccntrENV_3d
265 960 REAL, DIMENSION(klon,klev) :: coefcoli_3d
266 !
267 ! pour le ON-LINE
268 !
269 REAL,DIMENSION(klon,klev),INTENT(IN) :: frac_impa ! fraction d'aerosols non impactes
270 REAL,DIMENSION(klon,klev),INTENT(IN) :: frac_nucl ! fraction d'aerosols non nuclees
271
272 ! Arguments necessaires pour les sources et puits de traceur:
273 REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: ftsol ! Temperature du sol (surf)(Kelvin)
274 REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: pctsrf ! Pourcentage de sol (nature du sol)
275
276 ! Output argument
277 !----------------
278 REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT) :: tr_seri ! Concentration Traceur [U/KgA]
279 960 REAL,DIMENSION(klon,klev) :: sourceBE
280 REAL,DIMENSION(klon,nbtr), INTENT(IN) :: init_source
281
282 !=======================================================================================
283 ! -- LOCAL VARIABLES --
284 !=======================================================================================
285
286 INTEGER :: i, k, it
287 INTEGER :: nsplit
288
289 !Sources et Reservoirs de traceurs (ex:Radon):
290 !--------------------------------------------
291 !
292 REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: source ! a voir lorsque le flux de surface est prescrit
293 !$OMP THREADPRIVATE(source)
294
295 !
296 !Entrees/Sorties: (cf ini_histrac.h et write_histrac.h)
297 !---------------
298 INTEGER :: iiq, ierr
299 INTEGER :: nhori, nvert
300 REAL :: zsto, zout, zjulian
301 INTEGER,SAVE :: nid_tra ! pointe vers le fichier histrac.nc
302 !$OMP THREADPRIVATE(nid_tra)
303 REAL,DIMENSION(klon) :: zx_tmp_fi2d ! variable temporaire grille physique
304 INTEGER :: itau_w ! pas de temps ecriture = nstep + itau_phy
305 LOGICAL,PARAMETER :: ok_sync=.TRUE.
306 !
307 ! Nature du traceur
308 !------------------
309 LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: aerosol ! aerosol(it) = true => aerosol => lessivage
310 !$OMP THREADPRIVATE(aerosol) ! aerosol(it) = false => gaz
311 960 REAL,DIMENSION(klon,klev) :: delp ! epaisseur de couche (Pa)
312 !
313 ! Tendances de traceurs (Td) et flux de traceurs:
314 !------------------------
315 REAL,DIMENSION(klon,klev) :: d_tr ! Td dans l'atmosphere
316 960 REAL,DIMENSION(klon,klev) :: Mint
317 960 REAL,DIMENSION(klon,klev,nbtr) :: zmfd1a
318 960 REAL,DIMENSION(klon,klev,nbtr) :: zmfdam
319 960 REAL,DIMENSION(klon,klev,nbtr) :: zmfphi2
320 ! Physique
321 !----------
322 960 REAL,DIMENSION(klon,klev,nbtr) :: flestottr ! flux de lessivage dans chaque couche
323 960 REAL,DIMENSION(klon,klev) :: zmasse ! densit� atmosph�rique Kg/m2
324 960 REAL,DIMENSION(klon,klev) :: ztra_th
325 !PhH
326 960 REAL,DIMENSION(klon,klev) :: zrho
327 960 REAL,DIMENSION(klon,klev) :: zdz
328 REAL :: evaplsc,dx,beta ! variable pour lessivage Genthon
329 480 REAL,DIMENSION(klon) :: his_dh ! ---
330 ! in-cloud scav variables
331 REAL :: ql_incloud_ref ! ref value of in-cloud condensed water content
332
333 !Controles:
334 !---------
335 INTEGER,SAVE :: iflag_vdf_trac,iflag_con_trac,iflag_the_trac
336 INTEGER,SAVE :: iflag_con_trac_omp, iflag_vdf_trac_omp,iflag_the_trac_omp
337 !$OMP THREADPRIVATE(iflag_vdf_trac,iflag_con_trac,iflag_the_trac)
338
339 LOGICAL,SAVE :: lessivage
340 !$OMP THREADPRIVATE(lessivage)
341
342 !RomP >>>
343 INTEGER,SAVE :: iflag_lscav_omp,iflag_lscav
344 REAL, SAVE :: ccntrAA_in,ccntrAA_omp
345 REAL, SAVE :: ccntrENV_in,ccntrENV_omp
346 REAL, SAVE :: coefcoli_in,coefcoli_omp
347
348 LOGICAL,SAVE :: convscav_omp,convscav
349 !$OMP THREADPRIVATE(iflag_lscav)
350 !$OMP THREADPRIVATE(ccntrAA_in,ccntrENV_in,coefcoli_in)
351 !$OMP THREADPRIVATE(convscav)
352 !RomP <<<
353 !######################################################################
354 ! -- INITIALIZATION --
355 !######################################################################
356
357
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO k=1,klev
358
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 DO i=1,klon
359 18607680 sourceBE(i,k)=0.
360 18607680 Mint(i,k)=0.
361 18607680 zrho(i,k)=0.
362 18626400 zdz(i,k)=0.
363 END DO
364 END DO
365
366
2/2
✓ Branch 0 taken 960 times.
✓ Branch 1 taken 480 times.
1440 DO it=1, nbtr
367
2/2
✓ Branch 0 taken 37440 times.
✓ Branch 1 taken 960 times.
38880 DO k=1,klev
368
2/2
✓ Branch 0 taken 37215360 times.
✓ Branch 1 taken 37440 times.
37253760 DO i=1,klon
369 37215360 d_tr_insc(i,k,it)=0.
370 37215360 d_tr_bcscav(i,k,it)=0.
371 37215360 d_tr_evapls(i,k,it)=0.
372 37215360 d_tr_ls(i,k,it)=0.
373 37215360 d_tr_cv(i,k,it)=0.
374 37215360 d_tr_cl(i,k,it)=0.
375 37215360 d_tr_trsp(i,k,it)=0.
376 37215360 d_tr_sscav(i,k,it)=0.
377 37215360 d_tr_sat(i,k,it)=0.
378 37215360 d_tr_uscav(i,k,it)=0.
379 37215360 d_tr_lessi_impa(i,k,it)=0.
380 37215360 d_tr_lessi_nucl(i,k,it)=0.
381 37215360 qDi(i,k,it)=0.
382 37215360 qPr(i,k,it)=0.
383 37215360 qPa(i,k,it)=0.
384 37215360 qMel(i,k,it)=0.
385 37215360 qTrdi(i,k,it)=0.
386 37215360 dtrcvMA(i,k,it)=0.
387 37215360 zmfd1a(i,k,it)=0.
388 37215360 zmfdam(i,k,it)=0.
389 37252800 zmfphi2(i,k,it)=0.
390 END DO
391 END DO
392 END DO
393
394
2/2
✓ Branch 0 taken 960 times.
✓ Branch 1 taken 480 times.
1440 DO it=1, nbtr
395
2/2
✓ Branch 0 taken 954240 times.
✓ Branch 1 taken 960 times.
955680 DO i=1,klon
396 954240 d_tr_dry(i,it)=0.
397 955200 flux_tr_dry(i,it)=0.
398 END DO
399 END DO
400
401
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO k = 1, klev
402
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 DO i = 1, klon
403 18626400 delp(i,k) = paprs(i,k)-paprs(i,k+1)
404 END DO
405 END DO
406
407
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 479 times.
480 IF (debutphy) THEN
408 !!jyg
409 !$OMP BARRIER
410 1 ecrit_tra=86400. ! frequence de stokage en dur
411 ! obsolete car remplace par des ecritures dans phys_output_write
412 !RomP >>>
413 !
414 !Config Key = convscav
415 !Config Desc = Convective scavenging switch: 0=off, 1=on.
416 !Config Def = .FALSE.
417 !Config Help =
418 !
419 !$OMP MASTER
420 1 convscav_omp=.FALSE.
421 1 call getin('convscav', convscav_omp)
422 1 iflag_vdf_trac_omp=1
423 1 call getin('iflag_vdf_trac', iflag_vdf_trac_omp)
424 1 iflag_con_trac_omp=1
425 1 call getin('iflag_con_trac', iflag_con_trac_omp)
426 1 iflag_the_trac_omp=1
427 1 call getin('iflag_the_trac', iflag_the_trac_omp)
428 !$OMP END MASTER
429 !$OMP BARRIER
430 1 convscav=convscav_omp
431 1 iflag_vdf_trac=iflag_vdf_trac_omp
432 1 iflag_con_trac=iflag_con_trac_omp
433 1 iflag_the_trac=iflag_the_trac_omp
434 1 write(lunout,*) 'phytrac passage dans routine conv avec lessivage', convscav
435 !
436 !Config Key = iflag_lscav
437 !Config Desc = Large scale scavenging parametrization: 0=none, 1=old(Genthon92),
438 ! 2=1+PHeinrich, 3=Reddy_Boucher2004, 4=3+RPilon.
439 !Config Def = 1
440 !Config Help =
441 !
442 !$OMP MASTER
443 1 iflag_lscav_omp=1
444 1 call getin('iflag_lscav', iflag_lscav_omp)
445 1 ccntrAA_omp=1
446 1 ccntrENV_omp=1.
447 1 coefcoli_omp=0.001
448 1 call getin('ccntrAA', ccntrAA_omp)
449 1 call getin('ccntrENV', ccntrENV_omp)
450 1 call getin('coefcoli', coefcoli_omp)
451 !$OMP END MASTER
452 !$OMP BARRIER
453 1 iflag_lscav=iflag_lscav_omp
454 1 ccntrAA_in=ccntrAA_omp
455 1 ccntrENV_in=ccntrENV_omp
456 1 coefcoli_in=coefcoli_omp
457 !
458 SELECT CASE(iflag_lscav)
459 CASE(0)
460 WRITE(lunout,*) 'Large scale scavenging: none'
461 CASE(1)
462 1 WRITE(lunout,*) 'Large scale scavenging: C. Genthon, Tellus(1992), 44B, 371-389'
463 CASE(2)
464 WRITE(lunout,*) 'Large scale scavenging: C. Genthon, modified P. Heinrich'
465 CASE(3)
466 WRITE(lunout,*) 'Large scale scavenging: M. Shekkar Reddy and O. Boucher, JGR(2004), 109, D14202'
467 CASE(4)
468
1/6
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
1 WRITE(lunout,*) 'Large scale scavenging: Reddy and Boucher, modified R. Pilon'
469 END SELECT
470 !RomP <<<
471 1 WRITE(*,*) 'FIRST TIME IN PHYTRAC : pdtphys(sec) = ',pdtphys,'ecrit_tra (sec) = ',ecrit_tra
472
6/12
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
✓ Branch 9 taken 1 times.
✓ Branch 10 taken 1 times.
✗ Branch 11 not taken.
2 ALLOCATE( source(klon,nbtr), stat=ierr)
473
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF (ierr /= 0) CALL abort_physic('phytrac', 'pb in allocation 1',1)
474
475
4/8
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 1 times.
✓ Branch 6 taken 1 times.
✗ Branch 7 not taken.
1 ALLOCATE( aerosol(nbtr), stat=ierr)
476
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF (ierr /= 0) CALL abort_physic('phytrac', 'pb in allocation 2',1)
477
478
479 ! Initialize module for specific tracers
480 1 SELECT CASE(type_trac)
481 CASE('lmdz')
482 1 CALL traclmdz_init(pctsrf,xlat,xlon,ftsol,tr_seri,t_seri,pplay,sh,pdtphys,aerosol,lessivage)
483 CASE('inca')
484 source(:,:)=init_source(:,:)
485 CALL tracinca_init(aerosol,lessivage)
486 CASE('repr')
487 source(:,:)=0.
488 CASE('co2i')
489 source(:,:)=0.
490 lessivage = .FALSE.
491 aerosol(:) = .FALSE.
492 pbl_flg(:) = 1
493 iflag_the_trac= 1
494 iflag_vdf_trac= 1
495 iflag_con_trac= 1
496 CASE('inco')
497 source(:,1:nqCO2) = 0. ! from CO2i ModThL
498 source(:,nqCO2+1:nbtr)=init_source(:,:) ! from INCA ModThL
499 aerosol(1:nqCO2) = .FALSE. ! from CO2i ModThL
500 CALL tracinca_init(aerosol(nqCO2+1:nbtr),lessivage) ! from INCA ModThL
501 pbl_flg(1:nqCO2) = 1 ! From CO2i ModThL
502 iflag_the_trac= 1 ! From CO2i
503 iflag_vdf_trac= 1 ! From CO2i
504
1/6
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
1 iflag_con_trac= 1 ! From CO2i
505 END SELECT
506
507 !
508 !--initialising coefficients for scavenging in the case of NP
509 !
510
3/6
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
1 ALLOCATE(flag_cvltr(nbtr))
511
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (iflag_con.EQ.3) THEN
512 !
513
3/6
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
1 ALLOCATE(ccntrAA(nbtr))
514
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
1 ALLOCATE(ccntrENV(nbtr))
515
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
1 ALLOCATE(coefcoli(nbtr))
516 !
517
2/2
✓ Branch 0 taken 2 times.
✓ Branch 1 taken 1 times.
3 DO it=1, nbtr
518 1 SELECT CASE(type_trac)
519 CASE('lmdz')
520
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 2 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
2 IF (convscav.and.aerosol(it)) THEN
521 flag_cvltr(it)=.TRUE.
522 ccntrAA(it) =ccntrAA_in !--a modifier par JYG a lire depuis fichier
523 ccntrENV(it)=ccntrENV_in
524 coefcoli(it)=coefcoli_in
525 ELSE
526 2 flag_cvltr(it)=.FALSE.
527 ENDIF
528
529 CASE('repr')
530 flag_cvltr(it)=.FALSE.
531
532 CASE('inca')
533 ! IF ((it.EQ.id_Rn222) .OR. ((it.GE.id_SO2) .AND. (it.LE.id_NH3)) ) THEN
534 ! !--gas-phase species
535 ! flag_cvltr(it)=.FALSE.
536 !
537 ! ELSEIF ( (it.GE.id_CIDUSTM) .AND. (it.LE.id_AIN) ) THEN
538 ! !--insoluble aerosol species
539 ! flag_cvltr(it)=.TRUE.
540 ! ccntrAA(it)=0.7
541 ! ccntrENV(it)=0.7
542 ! coefcoli(it)=0.001
543 ! ELSEIF ( (it.EQ.id_Pb210) .OR. ((it.GE.id_CSSSM) .AND. (it.LE.id_SSN))) THEN
544 ! !--soluble aerosol species
545 ! flag_cvltr(it)=.TRUE.
546 ! ccntrAA(it)=0.9
547 ! ccntrENV(it)=0.9
548 ! coefcoli(it)=0.001
549 ! ELSE
550 ! WRITE(lunout,*) 'pb it=', it
551 ! CALL abort_physic('phytrac','pb it scavenging',1)
552 ! ENDIF
553 !--test OB
554 !--for now we do not scavenge in cvltr
555 flag_cvltr(it)=.FALSE.
556
557 CASE('co2i')
558 !--co2 tracers are not scavenged
559 flag_cvltr(it)=.FALSE.
560 CASE('inco') ! Add ThL
561
1/6
✓ Branch 0 taken 2 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
2 flag_cvltr(it)=.FALSE.
562
563 END SELECT
564 ENDDO
565 !
566 ELSE ! iflag_con .ne. 3
567 flag_cvltr(:) = .FALSE.
568 ENDIF
569 !
570 ! Initialize diagnostic output
571 ! ----------------------------
572 ! INCLUDE "ini_histrac.h"
573 !
574 ! print out all tracer flags
575 !
576 1 WRITE(lunout,*) 'print out all tracer flags'
577 1 WRITE(lunout,*) 'type_trac =', type_trac
578 1 WRITE(lunout,*) 'config_inca =', config_inca
579 1 WRITE(lunout,*) 'iflag_con_trac =', iflag_con_trac
580 1 WRITE(lunout,*) 'iflag_con =', iflag_con
581 1 WRITE(lunout,*) 'convscav =', convscav
582 1 WRITE(lunout,*) 'iflag_lscav =', iflag_lscav
583 1 WRITE(lunout,*) 'aerosol =', aerosol
584 1 WRITE(lunout,*) 'iflag_the_trac =', iflag_the_trac
585 1 WRITE(lunout,*) 'iflag_thermals =', iflag_thermals
586 1 WRITE(lunout,*) 'iflag_vdf_trac =', iflag_vdf_trac
587 1 WRITE(lunout,*) 'pbl_flg =', pbl_flg
588 1 WRITE(lunout,*) 'lessivage =', lessivage
589 1 write(lunout,*) 'flag_cvltr = ', flag_cvltr
590
591
3/6
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 1 times.
1 IF (lessivage .AND. (type_trac .EQ. 'inca' .OR. type_trac .EQ. 'inco')) THEN ! Mod ThL
592 CALL abort_physic('phytrac', 'lessivage=T config_inca=inca impossible',1)
593 ! STOP
594 ENDIF
595 !
596 ENDIF ! of IF (debutphy)
597 !############################################ END INITIALIZATION #######
598
599
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO k=1,klev
600
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 DO i=1,klon
601 18626400 zmasse(i,k)=(paprs(i,k)-paprs(i,k+1))/rg
602 END DO
603 END DO
604 !
605
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (id_be .GT. 0) THEN
606 DO k=1,klev
607 DO i=1,klon
608 sourceBE(i,k)=srcbe(i,k) !RomP -> pour sortie histrac
609 END DO
610 END DO
611 ENDIF
612
613 !===============================================================================
614 ! -- Do specific treatment according to chemestry model or local LMDZ tracers
615 !
616 !===============================================================================
617 480 SELECT CASE(type_trac)
618 CASE('lmdz')
619 ! -- Traitement des traceurs avec traclmdz
620 CALL traclmdz(nstep, julien, gmtime, pdtphys, t_seri, paprs, pplay, &
621 cdragh, coefh, yu1, yv1, ftsol, pctsrf, xlat, xlon,iflag_vdf_trac>=0,sh, &
622 rh, pphi, ustar, wstar, ale_bl, ale_wake, u10m, v10m, &
623
10/20
✗ Branch 11 not taken.
✓ Branch 12 taken 480 times.
✗ Branch 13 not taken.
✓ Branch 14 taken 480 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 480 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 480 times.
✗ Branch 19 not taken.
✓ Branch 20 taken 480 times.
✗ Branch 21 not taken.
✓ Branch 22 taken 480 times.
✗ Branch 23 not taken.
✓ Branch 24 taken 480 times.
✗ Branch 25 not taken.
✓ Branch 26 taken 480 times.
✗ Branch 27 not taken.
✓ Branch 28 taken 480 times.
✗ Branch 29 not taken.
✓ Branch 30 taken 480 times.
480 tr_seri, source, d_tr_cl,d_tr_dec, zmasse) !RomP
624
625 CASE('inca')
626 ! -- CHIMIE INCA config_inca = aero or chem --
627 ! Appel fait en fin de phytrac pour avoir les emissions modifiees par
628 ! la couche limite et la convection avant le calcul de la chimie
629
630 CASE('repr')
631 ! -- CHIMIE REPROBUS --
632 CALL tracreprobus(pdtphys, gmtime, debutphy, julien, &
633 presnivs, xlat, xlon, pphis, pphi, &
634 t_seri, pplay, paprs, sh , &
635 tr_seri)
636
637 CASE('co2i')
638 ! -- CO2 interactif --
639 ! -- source is updated with FF and BB emissions
640 ! -- and net fluxes from ocean and orchidee
641 ! -- sign convention : positive into the atmosphere
642
643 CALL tracco2i(pdtphys, debutphy, &
644 xlat, xlon, pphis, pphi, &
645 t_seri, pplay, paprs, tr_seri, source)
646 CASE('inco') ! Add ThL
647 CALL tracco2i(pdtphys, debutphy, &
648 xlat, xlon, pphis, pphi, &
649
1/5
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
480 t_seri, pplay, paprs, tr_seri, source)
650
651
652 END SELECT
653 !======================================================================
654 ! -- Calcul de l'effet de la convection --
655 !======================================================================
656
657
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 IF (iflag_con_trac==1) THEN
658
659
2/2
✓ Branch 0 taken 960 times.
✓ Branch 1 taken 480 times.
1440 DO it=1, nbtr
660
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 960 times.
960 IF ( conv_flg(it) == 0 ) CYCLE
661
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 960 times.
960 IF (iflag_con.LT.2) THEN
662 !--pas de transport convectif
663 d_tr_cv(:,:,it)=0.
664
665
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 960 times.
960 ELSE IF (iflag_con.EQ.2) THEN
666 !--ancien transport convectif de Tiedtke
667
668 CALL nflxtr(pdtphys, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
669 pplay, paprs, tr_seri(:,:,it), d_tr_cv(:,:,it))
670 ELSE
671 !--nouveau transport convectif de Emanuel
672
673
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 960 times.
960 IF (flag_cvltr(it)) THEN
674 !--nouveau transport convectif de Emanuel avec lessivage convectif
675 !
676 !
677 ccntrAA_3d(:,:) =ccntrAA(it)
678 ccntrENV_3d(:,:)=ccntrENV(it)
679 coefcoli_3d(:,:)=coefcoli(it)
680
681 !--beware this interface is a bit weird because it is called for each tracer
682 !--with the full array tr_seri even if only item it is processed
683
684 print*,'CV SCAV ',it,ccntrAA(it),ccntrENV(it)
685
686 CALL cvltr_scav(pdtphys, da, phi,phi2,d1a,dam, mp,ep, &
687 sigd,sij,wght_cvfd,clw,elij,epmlmMm,eplaMm, &
688 pmflxr,pmflxs,evap,t_seri,wdtrainA,wdtrainM, &
689 paprs,it,tr_seri,upwd,dnwd,itop_con,ibas_con, &
690 ccntrAA_3d,ccntrENV_3d,coefcoli_3d, &
691 d_tr_cv,d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav,qDi,qPr,&
692 qPa,qMel,qTrdi,dtrcvMA,Mint, &
693 zmfd1a,zmfphi2,zmfdam)
694
695
696 ELSE !---flag_cvltr(it).EQ.FALSE
697 !--nouveau transport convectif de Emanuel mais pas de lessivage convectif
698
699 !--beware this interface is a bit weird because it is called for each tracer
700 !--with the full array tr_seri even if only item it is processed
701 !
702 CALL cvltr_noscav(it,pdtphys, da, phi,mp,wght_cvfd,paprs,pplay, & !jyg
703 960 tr_seri,upwd,dnwd,d_tr_cv) !jyg
704
705 ENDIF
706
707 ENDIF !--iflag
708
709 !--on ajoute les tendances
710
711
2/2
✓ Branch 0 taken 37440 times.
✓ Branch 1 taken 960 times.
38400 DO k = 1, klev
712
2/2
✓ Branch 0 taken 37215360 times.
✓ Branch 1 taken 37440 times.
37253760 DO i = 1, klon
713 37252800 tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_cv(i,k,it)
714 END DO
715 END DO
716
717 1440 CALL minmaxqfi(tr_seri(:,:,it),0.,1.e33,'convection it = '//solsym(it))
718
719 END DO ! nbtr
720
721
722 ENDIF ! convection
723
724 !======================================================================
725 ! -- Calcul de l'effet des thermiques --
726 !======================================================================
727
728
2/2
✓ Branch 0 taken 960 times.
✓ Branch 1 taken 480 times.
1440 DO it=1,nbtr
729
2/2
✓ Branch 0 taken 37440 times.
✓ Branch 1 taken 960 times.
38880 DO k=1,klev
730
2/2
✓ Branch 0 taken 37215360 times.
✓ Branch 1 taken 37440 times.
37253760 DO i=1,klon
731 37215360 d_tr_th(i,k,it)=0.
732 37252800 tr_seri(i,k,it)=MAX(tr_seri(i,k,it),0.)
733 ! the next safeguard causes some problem for stratospheric aerosol tracers (particle number)
734 ! and there is little justification for it so it is commented out (4 December 2017) by OB
735 ! if reinstated please keep the ifndef CPP_StratAer
736 !#ifndef CPP_StratAer
737 ! tr_seri(i,k,it)=MIN(tr_seri(i,k,it),1.e10)
738 !#endif
739 END DO
740 END DO
741 END DO
742
743
2/4
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 480 times.
✗ Branch 3 not taken.
480 IF (iflag_thermals.GT.0.AND.iflag_the_trac>0) THEN
744
745
2/2
✓ Branch 0 taken 960 times.
✓ Branch 1 taken 480 times.
1440 DO it=1, nbtr
746
747 CALL thermcell_dq(klon,klev,1,pdtphys,fm_therm,entr_therm, &
748 zmasse,tr_seri(1:klon,1:klev,it), &
749
1/2
✗ Branch 2 not taken.
✓ Branch 3 taken 960 times.
960 d_tr_th(1:klon,1:klev,it),ztra_th,0 )
750
751
2/2
✓ Branch 0 taken 37440 times.
✓ Branch 1 taken 960 times.
38880 DO k=1,klev
752
2/2
✓ Branch 0 taken 37215360 times.
✓ Branch 1 taken 37440 times.
37253760 DO i=1,klon
753 37215360 d_tr_th(i,k,it)=pdtphys*d_tr_th(i,k,it)
754 37252800 tr_seri(i,k,it)=MAX(tr_seri(i,k,it)+d_tr_th(i,k,it),0.)
755 END DO
756 END DO
757
758 END DO ! it
759
760 ENDIF ! Thermiques
761
762 !======================================================================
763 ! -- Calcul de l'effet de la couche limite --
764 !======================================================================
765
766
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 IF (iflag_vdf_trac==1) THEN
767
768 ! Injection during BL mixing
769 !
770
771
2/2
✓ Branch 0 taken 480 times.
✓ Branch 1 taken 960 times.
1440 DO it=1, nbtr
772 !
773
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 960 times.
1440 IF( pbl_flg(it) /= 0 ) THEN
774 !
775 CALL cltrac(pdtphys, coefh,t_seri, &
776 tr_seri(:,:,it), source(:,it), &
777 paprs, pplay, delp, &
778 d_tr_cl(:,:,it),d_tr_dry(:,it),flux_tr_dry(:,it))
779 !
780 tr_seri(:,:,it)=tr_seri(:,:,it)+d_tr_cl(:,:,it)
781 !
782 !
783 ENDIF
784 !
785 ENDDO
786 !
787 ELSE IF (iflag_vdf_trac==0) THEN
788 !
789 ! Injection of source in the first model layer
790 !
791 DO it=1,nbtr
792 d_tr_cl(:,1,it)=source(:,it)*RG/delp(:,1)*pdtphys
793 tr_seri(:,1,it)=tr_seri(:,1,it)+d_tr_cl(:,1,it)
794 ENDDO
795 d_tr_cl(:,2:klev,1:nbtr)=0.
796 !
797 ELSE IF (iflag_vdf_trac==-1) THEN
798 !
799 ! Nothing happens
800 d_tr_cl=0.
801 !
802 ELSE
803 !
804 CALL abort_physic('iflag_vdf_trac', 'cas non prevu',1)
805 !
806 ENDIF ! couche limite
807
808 !======================================================================
809 ! Calcul de l'effet de la precipitation grande echelle
810 ! POUR INCA le lessivage est fait directement dans INCA
811 !======================================================================
812
813
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 IF (lessivage) THEN
814
815 ql_incloud_ref = 10.e-4
816 ql_incloud_ref = 5.e-4
817
818
819 ! calcul du contenu en eau liquide au sein du nuage
820 480 ql_incl = ql_incloud_ref
821 ! choix du lessivage
822 !
823
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 IF (iflag_lscav .EQ. 3 .OR. iflag_lscav .EQ. 4) THEN
824 ! ******** Olivier Boucher version (3) possibly with modified ql_incl (4)
825 !
826 DO it = 1, nbtr
827
828 IF (aerosol(it)) THEN
829 ! incloud scavenging and removal by large scale rain ! orig : ql_incl was replaced by 0.5e-3 kg/kg
830 ! the value 0.5e-3 kg/kg is from Giorgi and Chameides (1986), JGR
831 ! Liu (2001) proposed to use 1.5e-3 kg/kg
832
833 !jyg<
834 !! CALL lsc_scav(pdtphys,it,iflag_lscav,ql_incl,prfl,psfl,rneb,beta_fisrt, &
835 CALL lsc_scav(pdtphys,it,iflag_lscav,aerosol,ql_incl,prfl,psfl,rneb,beta_fisrt, &
836 !>jyg
837 beta_v1,pplay,paprs,t_seri,tr_seri,d_tr_insc, &
838 d_tr_bcscav,d_tr_evapls,qPrls)
839
840 !large scale scavenging tendency
841 DO k = 1, klev
842 DO i = 1, klon
843 d_tr_ls(i,k,it)=d_tr_insc(i,k,it)+d_tr_bcscav(i,k,it)+d_tr_evapls(i,k,it)
844 tr_seri(i,k,it)=tr_seri(i,k,it)+d_tr_ls(i,k,it)
845 ENDDO
846 ENDDO
847 CALL minmaxqfi(tr_seri(:,:,it),0.,1.e33,'lsc scav it = '//solsym(it))
848 ENDIF
849
850 END DO !tr
851
852
853
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
480 ELSE IF (iflag_lscav .EQ. 2) THEN ! frac_impa, frac_nucl
854 ! ********* modified old version
855
856 d_tr_lessi_nucl(:,:,:) = 0.
857 d_tr_lessi_impa(:,:,:) = 0.
858 flestottr(:,:,:) = 0.
859 ! Tendance des aerosols nuclees et impactes
860 DO it = 1, nbtr
861 IF (aerosol(it)) THEN
862 his_dh(:)=0.
863 DO k = 1, klev
864 DO i = 1, klon
865 !PhH
866 zrho(i,k)=pplay(i,k)/t_seri(i,k)/RD
867 zdz(i,k)=(paprs(i,k)-paprs(i,k+1))/zrho(i,k)/RG
868 !
869 ENDDO
870 ENDDO
871
872 DO k=klev-1, 1, -1
873 DO i=1, klon
874 ! d_tr_ls(i,k,it)=tr_seri(i,k,it)*(frac_impa(i,k)*frac_nucl(i,k)-1.)
875 dx=d_tr_ls(i,k,it)
876 his_dh(i)=his_dh(i)-dx*zrho(i,k)*zdz(i,k)/pdtphys ! kg/m2/s
877 evaplsc = prfl(i,k) - prfl(i,k+1) + psfl(i,k) - psfl(i,k+1)
878 ! Evaporation Partielle -> Liberation Partielle 0.5*evap
879 IF ( evaplsc .LT.0..and.abs(prfl(i,k+1)+psfl(i,k+1)).gt.1.e-10) THEN
880 evaplsc = (-evaplsc)/(prfl(i,k+1)+psfl(i,k+1))
881 ! evaplsc est donc positif, his_dh(i) est positif
882 !--------------
883 d_tr_evapls(i,k,it)=0.5*evaplsc*(d_tr_lessi_nucl(i,k+1,it) &
884 +d_tr_lessi_impa(i,k+1,it))
885 !------------- d_tr_evapls(i,k,it)=-0.5*evaplsc*(d_tr_lsc(i,k+1,it))
886 beta=0.5*evaplsc
887 if ((prfl(i,k)+psfl(i,k)).lt.1.e-10) THEN
888 beta=1.0*evaplsc
889 endif
890 dx=beta*his_dh(i)/zrho(i,k)/zdz(i,k)*pdtphys
891 his_dh(i)=(1.-beta)*his_dh(i) ! tracer from
892 d_tr_evapls(i,k,it)=dx
893 ENDIF
894 d_tr_ls(i,k,it)=tr_seri(i,k,it)*(frac_impa(i,k)*frac_nucl(i,k)-1.) &
895 +d_tr_evapls(i,k,it)
896
897 !--------------
898 d_tr_lessi_nucl(i,k,it) = d_tr_lessi_nucl(i,k,it) + &
899 ( 1 - frac_nucl(i,k) )*tr_seri(i,k,it)
900 d_tr_lessi_impa(i,k,it) = d_tr_lessi_impa(i,k,it) + &
901 ( 1 - frac_impa(i,k) )*tr_seri(i,k,it)
902 !
903 ! Flux lessivage total
904 flestottr(i,k,it) = flestottr(i,k,it) - &
905 ( d_tr_lessi_nucl(i,k,it) + &
906 d_tr_lessi_impa(i,k,it) ) * &
907 ( paprs(i,k)-paprs(i,k+1) ) / &
908 (RG * pdtphys)
909 !! Mise a jour des traceurs due a l'impaction,nucleation
910 ! tr_seri(i,k,it)=tr_seri(i,k,it)*frac_impa(i,k)*frac_nucl(i,k)
911 !! calcul de la tendance liee au lessivage stratiforme
912 ! d_tr_ls(i,k,it)=tr_seri(i,k,it)*&
913 ! (1.-1./(frac_impa(i,k)*frac_nucl(i,k)))
914 !--------------
915 ENDDO
916 ENDDO
917 ENDIF
918 ENDDO
919 ! ********* end modified old version
920
921
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
480 ELSE IF (iflag_lscav .EQ. 1) THEN ! frac_impa, frac_nucl
922 ! ********* old version
923
924
6/6
✓ Branch 0 taken 960 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 37440 times.
✓ Branch 3 taken 960 times.
✓ Branch 4 taken 37215360 times.
✓ Branch 5 taken 37440 times.
37254240 d_tr_lessi_nucl(:,:,:) = 0.
925
6/6
✓ Branch 0 taken 960 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 37440 times.
✓ Branch 3 taken 960 times.
✓ Branch 4 taken 37215360 times.
✓ Branch 5 taken 37440 times.
37254240 d_tr_lessi_impa(:,:,:) = 0.
926
6/6
✓ Branch 0 taken 960 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 37440 times.
✓ Branch 3 taken 960 times.
✓ Branch 4 taken 37215360 times.
✓ Branch 5 taken 37440 times.
37254240 flestottr(:,:,:) = 0.
927 !=========================
928 ! LESSIVAGE LARGE SCALE :
929 !=========================
930
931 ! Tendance des aerosols nuclees et impactes
932 ! -----------------------------------------
933
2/2
✓ Branch 0 taken 480 times.
✓ Branch 1 taken 960 times.
1440 DO it = 1, nbtr
934
2/2
✓ Branch 0 taken 480 times.
✓ Branch 1 taken 480 times.
1440 IF (aerosol(it)) THEN
935
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
19200 DO k = 1, klev
936
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
18626880 DO i = 1, klon
937 d_tr_lessi_nucl(i,k,it) = d_tr_lessi_nucl(i,k,it) + &
938 18607680 ( 1 - frac_nucl(i,k) )*tr_seri(i,k,it)
939 d_tr_lessi_impa(i,k,it) = d_tr_lessi_impa(i,k,it) + &
940 18607680 ( 1 - frac_impa(i,k) )*tr_seri(i,k,it)
941
942 !
943 ! Flux lessivage total
944 ! ------------------------------------------------------------
945 flestottr(i,k,it) = flestottr(i,k,it) - &
946 ( d_tr_lessi_nucl(i,k,it) + &
947 d_tr_lessi_impa(i,k,it) ) * &
948 ( paprs(i,k)-paprs(i,k+1) ) / &
949 18607680 (RG * pdtphys)
950 !
951 ! Mise a jour des traceurs due a l'impaction,nucleation
952 ! ----------------------------------------------------------------------
953 18626400 tr_seri(i,k,it)=tr_seri(i,k,it)*frac_impa(i,k)*frac_nucl(i,k)
954 ENDDO
955 ENDDO
956 ENDIF
957 ENDDO
958
959 ! ********* end old version
960 ENDIF ! iflag_lscav . EQ. 1, 2, 3 or 4
961 !
962 ENDIF ! lessivage
963
964
965 ! -- CHIMIE INCA config_inca = aero or chem --
966
2/4
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 480 times.
480 IF (type_trac == 'inca' .OR. type_trac == 'inco') THEN ! ModThL
967
968 CALL tracinca(&
969 nstep, julien, gmtime, lafin, &
970 pdtphys, t_seri, paprs, pplay, &
971 pmfu, upwd, ftsol, pctsrf, pphis, &
972 pphi, albsol, sh, ch, rh, &
973 cldfra, rneb, diafra, cldliq, &
974 itop_con, ibas_con, pmflxr, pmflxs, &
975 prfl, psfl, aerosol_couple, flxmass_w, &
976 tau_aero, piz_aero, cg_aero, ccm, &
977 rfname, &
978 tr_seri(:,:,1+nqCO2:nbtr), source(:,1+nqCO2:nbtr)) ! ModThL
979 ENDIF
980 !=============================================================
981 ! Ecriture des sorties
982 !=============================================================
983 ! INCLUDE "write_histrac.h"
984
985 480 END SUBROUTINE phytrac
986
987 END MODULE
988