Directory: | ./ |
---|---|
File: | phys/traclmdz_mod.f90 |
Date: | 2022-01-11 19:19:34 |
Exec | Total | Coverage | |
---|---|---|---|
Lines: | 101 | 219 | 46.1% |
Branches: | 135 | 378 | 35.7% |
Line | Branch | Exec | Source |
---|---|---|---|
1 | !$Id $ | ||
2 | ! | ||
3 | MODULE traclmdz_mod | ||
4 | |||
5 | ! | ||
6 | ! In this module all tracers specific to LMDZ are treated. This module is used | ||
7 | ! only if running without any other chemestry model as INCA or REPROBUS. | ||
8 | ! | ||
9 | IMPLICIT NONE | ||
10 | |||
11 | REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: masktr ! Masque reservoir de sol traceur | ||
12 | !$OMP THREADPRIVATE(masktr) ! Masque de l'echange avec la surface (1 = reservoir) ou (possible >= 1 ) | ||
13 | REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: fshtr ! Flux surfacique dans le reservoir de sol | ||
14 | !$OMP THREADPRIVATE(fshtr) | ||
15 | REAL,DIMENSION(:),ALLOCATABLE,SAVE :: hsoltr ! Epaisseur equivalente du reservoir de sol | ||
16 | !$OMP THREADPRIVATE(hsoltr) | ||
17 | ! | ||
18 | !Radioelements: | ||
19 | !-------------- | ||
20 | ! | ||
21 | REAL,DIMENSION(:),ALLOCATABLE,SAVE :: tautr ! Constante de decroissance radioactive | ||
22 | !$OMP THREADPRIVATE(tautr) | ||
23 | REAL,DIMENSION(:),ALLOCATABLE,SAVE :: vdeptr ! Vitesse de depot sec dans la couche Brownienne | ||
24 | !$OMP THREADPRIVATE(vdeptr) | ||
25 | REAL,DIMENSION(:),ALLOCATABLE,SAVE :: scavtr ! Coefficient de lessivage | ||
26 | !$OMP THREADPRIVATE(scavtr) | ||
27 | REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: srcbe ! Production du beryllium7 dans l atmosphere (U/s/kgA) | ||
28 | !$OMP THREADPRIVATE(srcbe) | ||
29 | |||
30 | LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: radio ! radio(it) = true => decroisssance radioactive | ||
31 | !$OMP THREADPRIVATE(radio) | ||
32 | |||
33 | REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: trs ! Conc. radon ds le sol | ||
34 | !$OMP THREADPRIVATE(trs) | ||
35 | |||
36 | INTEGER,SAVE :: id_aga ! Identification number for tracer : Age of stratospheric air | ||
37 | !$OMP THREADPRIVATE(id_aga) | ||
38 | INTEGER,SAVE :: lev_1p5km ! Approximative vertical layer number at 1.5km above surface, used for calculation of the age of air. The result shouldn't be that sensible to the exactness of this value as long as it is in the lower troposphere. | ||
39 | !$OMP THREADPRIVATE(lev_1p5km) | ||
40 | |||
41 | INTEGER,SAVE :: id_rn, id_pb ! Identification number for tracer : radon (Rn222), lead (Pb210) | ||
42 | !$OMP THREADPRIVATE(id_rn, id_pb) | ||
43 | |||
44 | INTEGER,SAVE :: id_be ! Activation et position du traceur Be7 [ id_be=0 -> desactive ] | ||
45 | !$OMP THREADPRIVATE(id_be) | ||
46 | |||
47 | INTEGER,SAVE :: id_pcsat, id_pcocsat, id_pcq ! traceurs pseudo-vapeur CL qsat, qsat_oc, q | ||
48 | !$OMP THREADPRIVATE(id_pcsat, id_pcocsat, id_pcq) | ||
49 | INTEGER,SAVE :: id_pcs0, id_pcos0, id_pcq0 ! traceurs pseudo-vapeur CL qsat, qsat_oc, q | ||
50 | ! ! qui ne sont pas transportes par la convection | ||
51 | !$OMP THREADPRIVATE(id_pcs0, id_pcos0, id_pcq0) | ||
52 | |||
53 | INTEGER, SAVE:: id_o3 | ||
54 | !$OMP THREADPRIVATE(id_o3) | ||
55 | ! index of ozone tracer with Cariolle parameterization | ||
56 | ! 0 means no ozone tracer | ||
57 | |||
58 | LOGICAL,SAVE :: rnpb=.FALSE. ! Presence du couple Rn222, Pb210 | ||
59 | !$OMP THREADPRIVATE(rnpb) | ||
60 | |||
61 | |||
62 | CONTAINS | ||
63 | |||
64 | 1 | SUBROUTINE traclmdz_from_restart(trs_in) | |
65 | ! This subroutine initialize the module saved variable trs with values from restart file (startphy.nc). | ||
66 | ! This subroutine is called from phyetat0 after the field trs_in has been read. | ||
67 | |||
68 | USE dimphy | ||
69 | USE infotrac_phy | ||
70 | |||
71 | ! Input argument | ||
72 | REAL,DIMENSION(klon,nbtr), INTENT(IN) :: trs_in | ||
73 | |||
74 | ! Local variables | ||
75 | INTEGER :: ierr | ||
76 | |||
77 | ! Allocate restart variables trs | ||
78 |
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( trs(klon,nbtr), stat=ierr) |
79 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
|
1 | IF (ierr /= 0) CALL abort_physic('traclmdz_from_restart', 'pb in allocation 1',1) |
80 | |||
81 | ! Initialize trs with values read from restart file | ||
82 |
4/4✓ Branch 0 taken 2 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 1988 times.
✓ Branch 3 taken 2 times.
|
1991 | trs(:,:) = trs_in(:,:) |
83 | |||
84 | 1 | END SUBROUTINE traclmdz_from_restart | |
85 | |||
86 | |||
87 | 1 | SUBROUTINE traclmdz_init(pctsrf, xlat, xlon, ftsol, tr_seri, t_seri, pplay, sh, pdtphys, aerosol, lessivage) | |
88 | ! This subroutine allocates and initialize module variables and control variables. | ||
89 | ! Initialization of the tracers should be done here only for those not found in the restart file. | ||
90 | USE dimphy | ||
91 | USE infotrac_phy | ||
92 | USE regr_pr_comb_coefoz_m, ONLY: alloc_coefoz | ||
93 | USE press_coefoz_m, ONLY: press_coefoz | ||
94 | USE mod_grid_phy_lmdz | ||
95 | USE mod_phys_lmdz_para | ||
96 | USE indice_sol_mod | ||
97 | USE print_control_mod, ONLY: lunout | ||
98 | |||
99 | ! Input variables | ||
100 | REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: pctsrf ! Pourcentage de sol f(nature du sol) | ||
101 | REAL,DIMENSION(klon),INTENT(IN) :: xlat ! latitudes en degres pour chaque point | ||
102 | REAL,DIMENSION(klon),INTENT(IN) :: xlon ! longitudes en degres pour chaque point | ||
103 | REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: ftsol ! Temperature du sol (surf)(Kelvin) | ||
104 | REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT) :: tr_seri! Concentration Traceur [U/KgA] | ||
105 | REAL,DIMENSION(klon,klev),INTENT(IN) :: t_seri ! Temperature | ||
106 | REAL,DIMENSION(klon,klev),INTENT(IN) :: pplay ! pression pour le mileu de chaque couche (en Pa) | ||
107 | REAL,DIMENSION(klon,klev),INTENT(IN) :: sh ! humidite specifique | ||
108 | REAL,INTENT(IN) :: pdtphys ! Pas d'integration pour la physique (seconde) | ||
109 | |||
110 | ! Output variables | ||
111 | LOGICAL,DIMENSION(nbtr), INTENT(OUT) :: aerosol | ||
112 | LOGICAL,INTENT(OUT) :: lessivage | ||
113 | |||
114 | ! Local variables | ||
115 | INTEGER :: ierr, it, iiq, i, k | ||
116 | 2 | REAL, DIMENSION(klon_glo,klev) :: varglo ! variable temporaire sur la grille global | |
117 | 2 | REAL, DIMENSION(klev) :: mintmp, maxtmp | |
118 | LOGICAL :: zero | ||
119 | ! RomP >>> profil initial Be7 | ||
120 | integer ilesfil | ||
121 | parameter (ilesfil=1) | ||
122 | integer irr,kradio | ||
123 | 2 | real beryllium(klon,klev) | |
124 | ! profil initial Pb210 | ||
125 | integer ilesfil2 | ||
126 | parameter (ilesfil2=1) | ||
127 | integer irr2,kradio2 | ||
128 | 2 | real plomb(klon,klev) | |
129 | !! RomP <<< | ||
130 | ! -------------------------------------------- | ||
131 | ! Allocation | ||
132 | ! -------------------------------------------- | ||
133 |
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( scavtr(nbtr), stat=ierr) |
134 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
|
1 | IF (ierr /= 0) CALL abort_physic('traclmdz_init', 'pb in allocation 9',1) |
135 |
2/2✓ Branch 0 taken 2 times.
✓ Branch 1 taken 1 times.
|
3 | scavtr(:)=1. |
136 | |||
137 |
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( radio(nbtr), stat=ierr) |
138 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
|
1 | IF (ierr /= 0) CALL abort_physic('traclmdz_init', 'pb in allocation 11',1) |
139 |
2/2✓ Branch 0 taken 2 times.
✓ Branch 1 taken 1 times.
|
3 | radio(:) = .false. ! Par defaut pas decroissance radioactive |
140 | |||
141 |
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( masktr(klon,nbtr), stat=ierr) |
142 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
|
1 | IF (ierr /= 0) CALL abort_physic('traclmdz_init', 'pb in allocation 2',1) |
143 | |||
144 |
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( fshtr(klon,nbtr), stat=ierr) |
145 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
|
1 | IF (ierr /= 0) CALL abort_physic('traclmdz_init', 'pb in allocation 3',1) |
146 | |||
147 |
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( hsoltr(nbtr), stat=ierr) |
148 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
|
1 | IF (ierr /= 0) CALL abort_physic('traclmdz_init', 'pb in allocation 4',1) |
149 | |||
150 |
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( tautr(nbtr), stat=ierr) |
151 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
|
1 | IF (ierr /= 0) CALL abort_physic('traclmdz_init', 'pb in allocation 5',1) |
152 |
2/2✓ Branch 0 taken 2 times.
✓ Branch 1 taken 1 times.
|
3 | tautr(:) = 0. |
153 | |||
154 |
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( vdeptr(nbtr), stat=ierr) |
155 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
|
1 | IF (ierr /= 0) CALL abort_physic('traclmdz_init', 'pb in allocation 6',1) |
156 |
2/2✓ Branch 0 taken 2 times.
✓ Branch 1 taken 1 times.
|
3 | vdeptr(:) = 0. |
157 | |||
158 | |||
159 | 1 | lessivage = .TRUE. | |
160 | !!jyg(20130206) : le choix d activation du lessivage est fait dans phytrac avec iflag_lscav | ||
161 | !! call getin('lessivage',lessivage) | ||
162 | !! if(lessivage) then | ||
163 | !! print*,'lessivage lsc ON' | ||
164 | !! else | ||
165 | !! print*,'lessivage lsc OFF' | ||
166 | !! endif | ||
167 |
2/2✓ Branch 0 taken 2 times.
✓ Branch 1 taken 1 times.
|
3 | aerosol(:) = .FALSE. ! Tous les traceurs sont des gaz par defaut |
168 | |||
169 | ! | ||
170 | ! Recherche des traceurs connus : Be7, O3, CO2,... | ||
171 | ! -------------------------------------------- | ||
172 | 1 | id_rn=0; id_pb=0; id_aga=0; id_be=0; id_o3=0 | |
173 | 1 | id_pcsat=0; id_pcocsat=0; id_pcq=0; id_pcs0=0; id_pcos0=0; id_pcq0=0 | |
174 |
2/2✓ Branch 0 taken 2 times.
✓ Branch 1 taken 1 times.
|
3 | DO it=1,nbtr |
175 | !! iiq=niadv(it+2) ! jyg | ||
176 | 2 | iiq=niadv(it+nqo) ! jyg | |
177 |
2/2✓ Branch 0 taken 1 times.
✓ Branch 1 taken 1 times.
|
3 | IF ( tname(iiq) == "RN" ) THEN |
178 | 1 | id_rn=it ! radon | |
179 |
1/2✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
|
1 | ELSE IF ( tname(iiq) == "PB") THEN |
180 | 1 | id_pb=it ! plomb | |
181 | ! RomP >>> profil initial de PB210 | ||
182 | 1 | open (ilesfil2,file='prof.pb210',status='old',iostat=irr2) | |
183 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
|
1 | IF (irr2 == 0) THEN |
184 | ✗ | read(ilesfil2,*) kradio2 | |
185 | ✗ | print*,'number of levels for pb210 profile ',kradio2 | |
186 | ✗ | do k=kradio2,1,-1 | |
187 | ✗ | read (ilesfil2,*) plomb(:,k) | |
188 | enddo | ||
189 | ✗ | close(ilesfil2) | |
190 | ✗ | do k=1,klev | |
191 | ✗ | do i=1,klon | |
192 | ✗ | tr_seri(i,k,id_pb)=plomb(i,k) | |
193 | !! print*, 'tr_seri',i,k,tr_seri(i,k,id_pb) | ||
194 | enddo | ||
195 | enddo | ||
196 | ELSE | ||
197 | 1 | print *, 'Prof.pb210 does not exist: use restart values' | |
198 | ENDIF | ||
199 | ! RomP <<< | ||
200 | ✗ | ELSE IF ( tname(iiq) == "Aga" .OR. tname(iiq) == "AGA" ) THEN | |
201 | ! Age of stratospheric air | ||
202 | ✗ | id_aga=it | |
203 | ✗ | radio(id_aga) = .FALSE. | |
204 | ✗ | aerosol(id_aga) = .FALSE. | |
205 | ✗ | pbl_flg(id_aga) = 0 | |
206 | |||
207 | ! Find the first model layer above 1.5km from the surface | ||
208 | ✗ | IF (klev>=30) THEN | |
209 | ✗ | lev_1p5km=6 ! NB! This value is for klev=39 | |
210 | ✗ | ELSE IF (klev>=10) THEN | |
211 | ✗ | lev_1p5km=5 ! NB! This value is for klev=19 | |
212 | ELSE | ||
213 | ✗ | lev_1p5km=klev/2 | |
214 | END IF | ||
215 | ELSE IF ( tname(iiq) == "BE" .OR. tname(iiq) == "Be" .OR. & | ||
216 | ✗ | tname(iiq) == "BE7" .OR. tname(iiq) == "Be7" ) THEN | |
217 | ! Recherche du Beryllium 7 | ||
218 | ✗ | id_be=it | |
219 | ✗ | ALLOCATE( srcbe(klon,klev) ) | |
220 | ✗ | radio(id_be) = .TRUE. | |
221 | ✗ | aerosol(id_be) = .TRUE. ! le Be est un aerosol | |
222 | !jyg le 13/03/2013 ; ajout de pplay en argument de init_be | ||
223 | !!! CALL init_be(pctsrf,masktr(:,id_be),tautr(id_be),vdeptr(id_be),scavtr(id_be),srcbe) | ||
224 | ✗ | CALL init_be(pctsrf,pplay,masktr(:,id_be),tautr(id_be),vdeptr(id_be),scavtr(id_be),srcbe) | |
225 | ✗ | WRITE(lunout,*) 'Initialisation srcBe: OK' | |
226 | ! RomP >>> profil initial de Be7 | ||
227 | ✗ | open (ilesfil,file='prof.be7',status='old',iostat=irr) | |
228 | ✗ | IF (irr == 0) THEN | |
229 | ✗ | read(ilesfil,*) kradio | |
230 | ✗ | print*,'number of levels for Be7 profile ',kradio | |
231 | ✗ | do k=kradio,1,-1 | |
232 | ✗ | read (ilesfil,*) beryllium(:,k) | |
233 | enddo | ||
234 | ✗ | close(ilesfil) | |
235 | ✗ | do k=1,klev | |
236 | ✗ | do i=1,klon | |
237 | ✗ | tr_seri(i,k,id_be)=beryllium(i,k) | |
238 | !! print*, 'tr_seri',i,k,tr_seri(i,k,id_be) | ||
239 | enddo | ||
240 | enddo | ||
241 | ELSE | ||
242 | ✗ | print *, 'Prof.Be7 does not exist: use restart values' | |
243 | ENDIF | ||
244 | ! RomP <<< | ||
245 | ✗ | ELSE IF (tname(iiq)=="O3" .OR. tname(iiq)=="o3") THEN | |
246 | ! Recherche de l'ozone : parametrization de la chimie par Cariolle | ||
247 | ✗ | id_o3=it | |
248 | ✗ | CALL alloc_coefoz ! allocate ozone coefficients | |
249 | ✗ | CALL press_coefoz ! read input pressure levels | |
250 | ✗ | ELSE IF ( tname(iiq) == "pcsat" .OR. tname(iiq) == "Pcsat" ) THEN | |
251 | ✗ | id_pcsat=it | |
252 | ✗ | ELSE IF ( tname(iiq) == "pcocsat" .OR. tname(iiq) == "Pcocsat" ) THEN | |
253 | ✗ | id_pcocsat=it | |
254 | ✗ | ELSE IF ( tname(iiq) == "pcq" .OR. tname(iiq) == "Pcq" ) THEN | |
255 | ✗ | id_pcq=it | |
256 | ✗ | ELSE IF ( tname(iiq) == "pcs0" .OR. tname(iiq) == "Pcs0" ) THEN | |
257 | ✗ | id_pcs0=it | |
258 | ✗ | conv_flg(it)=0 ! No transport by convection for this tracer | |
259 | ✗ | ELSE IF ( tname(iiq) == "pcos0" .OR. tname(iiq) == "Pcos0" ) THEN | |
260 | ✗ | id_pcos0=it | |
261 | ✗ | conv_flg(it)=0 ! No transport by convection for this tracer | |
262 | ✗ | ELSE IF ( tname(iiq) == "pcq0" .OR. tname(iiq) == "Pcq0" ) THEN | |
263 | ✗ | id_pcq0=it | |
264 | ✗ | conv_flg(it)=0 ! No transport by convection for this tracer | |
265 | ELSE | ||
266 | ✗ | WRITE(lunout,*) 'This is an unknown tracer in LMDZ : ', trim(tname(iiq)) | |
267 | END IF | ||
268 | END DO | ||
269 | |||
270 | ! | ||
271 | ! Valeurs specifiques pour les traceurs Rn222 et Pb210 | ||
272 | ! ---------------------------------------------- | ||
273 |
2/4✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
|
1 | IF ( id_rn/=0 .AND. id_pb/=0 ) THEN |
274 | 1 | rnpb = .TRUE. | |
275 | 1 | radio(id_rn)= .TRUE. | |
276 | 1 | radio(id_pb)= .TRUE. | |
277 | 1 | pbl_flg(id_rn) = 0 ! au lieu de clsol=true ! CL au sol calcule | |
278 | 1 | pbl_flg(id_pb) = 0 ! au lieu de clsol=true | |
279 | 1 | aerosol(id_rn) = .FALSE. | |
280 | 1 | aerosol(id_pb) = .TRUE. ! le Pb est un aerosol | |
281 | |||
282 | 1 | CALL initrrnpb (ftsol,pctsrf,masktr,fshtr,hsoltr,tautr,vdeptr,scavtr) | |
283 | END IF | ||
284 | |||
285 | ! | ||
286 | ! Check if all tracers have restart values | ||
287 | ! ---------------------------------------------- | ||
288 |
2/2✓ Branch 0 taken 2 times.
✓ Branch 1 taken 1 times.
|
3 | DO it=1,nbtr |
289 | !! iiq=niadv(it+2) ! jyg | ||
290 | 2 | iiq=niadv(it+nqo) ! jyg | |
291 | ! Test if tracer is zero everywhere. | ||
292 | ! Done by master process MPI and master thread OpenMP | ||
293 | 2 | CALL gather(tr_seri(:,:,it),varglo) | |
294 |
2/4✓ Branch 0 taken 2 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
|
2 | IF (is_mpi_root .AND. is_omp_root) THEN |
295 | 2 | mintmp=MINVAL(varglo,dim=1) | |
296 | 2 | maxtmp=MAXVAL(varglo,dim=1) | |
297 |
13/22✓ Branch 0 taken 2 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 2 times.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
✓ Branch 6 taken 2 times.
✓ Branch 7 taken 78 times.
✓ Branch 8 taken 17 times.
✓ Branch 9 taken 61 times.
✓ Branch 10 taken 2 times.
✗ Branch 11 not taken.
✗ Branch 12 not taken.
✓ Branch 13 taken 2 times.
✗ Branch 14 not taken.
✗ Branch 15 not taken.
✓ Branch 16 taken 78 times.
✓ Branch 17 taken 2 times.
✓ Branch 18 taken 2 times.
✓ Branch 19 taken 76 times.
✗ Branch 20 not taken.
✓ Branch 21 taken 2 times.
|
164 | IF (MINVAL(mintmp,dim=1)==0. .AND. MAXVAL(maxtmp,dim=1)==0.) THEN |
298 | ! Tracer is zero everywhere | ||
299 | ✗ | zero=.TRUE. | |
300 | ELSE | ||
301 | 2 | zero=.FALSE. | |
302 | END IF | ||
303 | END IF | ||
304 | |||
305 | ! Distribute variable at all processes | ||
306 | 2 | CALL bcast(zero) | |
307 | |||
308 | ! Initalize tracer that was not found in restart file. | ||
309 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 2 times.
|
3 | IF (zero) THEN |
310 | ! The tracer was not found in restart file or it was equal zero everywhere. | ||
311 | ✗ | WRITE(lunout,*) "The tracer ",trim(tname(iiq))," will be initialized" | |
312 | IF (it==id_pcsat .OR. it==id_pcq .OR. & | ||
313 | ✗ | it==id_pcs0 .OR. it==id_pcq0) THEN | |
314 | ✗ | tr_seri(:,:,it) = 100. | |
315 | ✗ | ELSE IF (it==id_pcocsat .OR. it==id_pcos0) THEN | |
316 | ✗ | DO i = 1, klon | |
317 | ✗ | IF ( pctsrf (i, is_oce) == 0. ) THEN | |
318 | ✗ | tr_seri(i,:,it) = 0. | |
319 | ELSE | ||
320 | ✗ | tr_seri(i,:,it) = 100. | |
321 | END IF | ||
322 | END DO | ||
323 | ELSE | ||
324 | ! No specific initialization exist for this tracer | ||
325 | ✗ | tr_seri(:,:,it) = 0. | |
326 | END IF | ||
327 | END IF | ||
328 | END DO | ||
329 | |||
330 | 1 | END SUBROUTINE traclmdz_init | |
331 | |||
332 | 480 | SUBROUTINE traclmdz(nstep, julien, gmtime, pdtphys, t_seri, paprs, pplay, & | |
333 | 1440 | cdragh, coefh, yu1, yv1, ftsol, pctsrf, xlat, xlon, couchelimite, sh, & | |
334 | rh, pphi, ustar, wstar, ale_bl, ale_wake, zu10m, zv10m, & | ||
335 |
2/4✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 480 times.
|
480 | tr_seri, source, d_tr_cl,d_tr_dec, zmasse) !RomP |
336 | |||
337 | USE dimphy | ||
338 | USE infotrac_phy | ||
339 | USE regr_pr_comb_coefoz_m, ONLY: regr_pr_comb_coefoz | ||
340 | USE o3_chem_m, ONLY: o3_chem | ||
341 | USE indice_sol_mod | ||
342 | |||
343 | INCLUDE "YOMCST.h" | ||
344 | |||
345 | !========================================================================== | ||
346 | ! -- DESCRIPTION DES ARGUMENTS -- | ||
347 | !========================================================================== | ||
348 | |||
349 | ! Input arguments | ||
350 | ! | ||
351 | !Configuration grille,temps: | ||
352 | INTEGER,INTENT(IN) :: nstep ! nombre d'appels de la physiq | ||
353 | INTEGER,INTENT(IN) :: julien ! Jour julien | ||
354 | REAL,INTENT(IN) :: gmtime | ||
355 | REAL,INTENT(IN) :: pdtphys ! Pas d'integration pour la physique (seconde) | ||
356 | REAL,DIMENSION(klon),INTENT(IN) :: xlat ! latitudes pour chaque point | ||
357 | REAL, INTENT(IN):: xlon(:) ! dim(klon) longitude | ||
358 | |||
359 | ! | ||
360 | !Physique: | ||
361 | !-------- | ||
362 | REAL,DIMENSION(klon,klev),INTENT(IN) :: t_seri ! Temperature | ||
363 | REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs ! pression pour chaque inter-couche (en Pa) | ||
364 | REAL,DIMENSION(klon,klev),INTENT(IN) :: pplay ! pression pour le mileu de chaque couche (en Pa) | ||
365 | REAL,intent(in):: zmasse (:, :) ! dim(klon,klev) density of air, in kg/m2 | ||
366 | |||
367 | |||
368 | !Couche limite: | ||
369 | !-------------- | ||
370 | ! | ||
371 | REAL,DIMENSION(klon),INTENT(IN) :: cdragh ! coeff drag pour T et Q | ||
372 | REAL,DIMENSION(klon,klev),INTENT(IN) :: coefh ! coeff melange CL (m**2/s) | ||
373 | REAL,DIMENSION(klon),INTENT(IN) :: yu1 ! vents au premier niveau | ||
374 | REAL,DIMENSION(klon),INTENT(IN) :: yv1 ! vents au premier niveau | ||
375 | LOGICAL,INTENT(IN) :: couchelimite | ||
376 | REAL,DIMENSION(klon,klev),INTENT(IN) :: sh ! humidite specifique | ||
377 | REAL,DIMENSION(klon,klev),INTENT(IN) :: rh ! Humidite relative | ||
378 | REAL,DIMENSION(klon,klev),INTENT(IN) :: pphi ! geopotentie | ||
379 | REAL,DIMENSION(klon),INTENT(IN) :: ustar ! ustar (m/s) | ||
380 | REAL,DIMENSION(klon),INTENT(IN) :: wstar,ale_bl,ale_wake ! wstar (m/s) and Avail. Lifti. Energ. | ||
381 | REAL,DIMENSION(klon),INTENT(IN) :: zu10m ! vent zonal 10m (m/s) | ||
382 | REAL,DIMENSION(klon),INTENT(IN) :: zv10m ! vent zonal 10m (m/s) | ||
383 | |||
384 | ! Arguments necessaires pour les sources et puits de traceur: | ||
385 | REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: ftsol ! Temperature du sol (surf)(Kelvin) | ||
386 | REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: pctsrf ! Pourcentage de sol f(nature du sol) | ||
387 | |||
388 | ! InOutput argument | ||
389 | REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT) :: tr_seri ! Concentration Traceur [U/KgA] | ||
390 | |||
391 | ! Output argument | ||
392 | REAL,DIMENSION(klon,nbtr), INTENT(OUT) :: source ! a voir lorsque le flux de surface est prescrit | ||
393 | REAL,DIMENSION(klon,klev,nbtr), INTENT(OUT) :: d_tr_cl ! Td couche limite/traceur | ||
394 | |||
395 | !======================================================================================= | ||
396 | ! -- VARIABLES LOCALES TRACEURS -- | ||
397 | !======================================================================================= | ||
398 | |||
399 | INTEGER :: i, k, it | ||
400 | INTEGER :: lmt_pas ! number of time steps of "physics" per day | ||
401 | |||
402 | 960 | REAL,DIMENSION(klon) :: d_trs ! Td dans le reservoir | |
403 | 960 | REAL,DIMENSION(klon,klev) :: qsat ! pression de la vapeur a saturation | |
404 | REAL,DIMENSION(klon,klev,nbtr) :: d_tr_dec ! Td radioactive | ||
405 | REAL :: zrho ! Masse Volumique de l'air KgA/m3 | ||
406 | REAL :: amn, amx | ||
407 | ! | ||
408 | !================================================================= | ||
409 | ! Ajout de la production en Be7 (Beryllium) srcbe U/s/kgA | ||
410 | !================================================================= | ||
411 | ! | ||
412 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | IF ( id_be /= 0 ) THEN |
413 | ✗ | DO k = 1, klev | |
414 | ✗ | DO i = 1, klon | |
415 | ✗ | tr_seri(i,k,id_be) = tr_seri(i,k,id_be)+srcbe(i,k)*pdtphys | |
416 | END DO | ||
417 | END DO | ||
418 | ✗ | WRITE(*,*) 'Ajout srcBe dans tr_seri: OK' | |
419 | END IF | ||
420 | |||
421 | |||
422 | !================================================================= | ||
423 | ! Update pseudo-vapor tracers | ||
424 | !================================================================= | ||
425 | |||
426 | 480 | CALL q_sat(klon*klev,t_seri,pplay,qsat) | |
427 | |||
428 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | IF ( id_pcsat /= 0 ) THEN |
429 | ✗ | DO k = 1, klev | |
430 | ✗ | DO i = 1, klon | |
431 | ✗ | IF ( pplay(i,k).GE.85000.) THEN | |
432 | ✗ | tr_seri(i,k,id_pcsat) = qsat(i,k) | |
433 | ELSE | ||
434 | ✗ | tr_seri(i,k,id_pcsat) = MIN (qsat(i,k), tr_seri(i,k,id_pcsat)) | |
435 | END IF | ||
436 | END DO | ||
437 | END DO | ||
438 | END IF | ||
439 | |||
440 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | IF ( id_pcocsat /= 0 ) THEN |
441 | ✗ | DO k = 1, klev | |
442 | ✗ | DO i = 1, klon | |
443 | ✗ | IF ( pplay(i,k).GE.85000.) THEN | |
444 | ✗ | IF ( pctsrf (i, is_oce) > 0. ) THEN | |
445 | ✗ | tr_seri(i,k,id_pcocsat) = qsat(i,k) | |
446 | ELSE | ||
447 | ✗ | tr_seri(i,k,id_pcocsat) = 0. | |
448 | END IF | ||
449 | ELSE | ||
450 | ✗ | tr_seri(i,k,id_pcocsat) = MIN (qsat(i,k), tr_seri(i,k,id_pcocsat)) | |
451 | END IF | ||
452 | END DO | ||
453 | END DO | ||
454 | END IF | ||
455 | |||
456 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | IF ( id_pcq /= 0 ) THEN |
457 | ✗ | DO k = 1, klev | |
458 | ✗ | DO i = 1, klon | |
459 | ✗ | IF ( pplay(i,k).GE.85000.) THEN | |
460 | ✗ | tr_seri(i,k,id_pcq) = sh(i,k) | |
461 | ELSE | ||
462 | ✗ | tr_seri(i,k,id_pcq) = MIN (qsat(i,k), tr_seri(i,k,id_pcq)) | |
463 | END IF | ||
464 | END DO | ||
465 | END DO | ||
466 | END IF | ||
467 | |||
468 | |||
469 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | IF ( id_pcs0 /= 0 ) THEN |
470 | ✗ | DO k = 1, klev | |
471 | ✗ | DO i = 1, klon | |
472 | ✗ | IF ( pplay(i,k).GE.85000.) THEN | |
473 | ✗ | tr_seri(i,k,id_pcs0) = qsat(i,k) | |
474 | ELSE | ||
475 | ✗ | tr_seri(i,k,id_pcs0) = MIN (qsat(i,k), tr_seri(i,k,id_pcs0)) | |
476 | END IF | ||
477 | END DO | ||
478 | END DO | ||
479 | END IF | ||
480 | |||
481 | |||
482 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | IF ( id_pcos0 /= 0 ) THEN |
483 | ✗ | DO k = 1, klev | |
484 | ✗ | DO i = 1, klon | |
485 | ✗ | IF ( pplay(i,k).GE.85000.) THEN | |
486 | ✗ | IF ( pctsrf (i, is_oce) > 0. ) THEN | |
487 | ✗ | tr_seri(i,k,id_pcos0) = qsat(i,k) | |
488 | ELSE | ||
489 | ✗ | tr_seri(i,k,id_pcos0) = 0. | |
490 | END IF | ||
491 | ELSE | ||
492 | ✗ | tr_seri(i,k,id_pcos0) = MIN (qsat(i,k), tr_seri(i,k,id_pcos0)) | |
493 | END IF | ||
494 | END DO | ||
495 | END DO | ||
496 | END IF | ||
497 | |||
498 | |||
499 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | IF ( id_pcq0 /= 0 ) THEN |
500 | ✗ | DO k = 1, klev | |
501 | ✗ | DO i = 1, klon | |
502 | ✗ | IF ( pplay(i,k).GE.85000.) THEN | |
503 | ✗ | tr_seri(i,k,id_pcq0) = sh(i,k) | |
504 | ELSE | ||
505 | ✗ | tr_seri(i,k,id_pcq0) = MIN (qsat(i,k), tr_seri(i,k,id_pcq0)) | |
506 | END IF | ||
507 | END DO | ||
508 | END DO | ||
509 | END IF | ||
510 | |||
511 | !================================================================= | ||
512 | ! Update tracer : Age of stratospheric air | ||
513 | !================================================================= | ||
514 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | IF (id_aga/=0) THEN |
515 | |||
516 | ! Bottom layers | ||
517 | ✗ | DO k = 1, lev_1p5km | |
518 | ✗ | tr_seri(:,k,id_aga) = 0.0 | |
519 | END DO | ||
520 | |||
521 | ! Layers above 1.5km | ||
522 | ✗ | DO k = lev_1p5km+1,klev-1 | |
523 | ✗ | tr_seri(:,k,id_aga) = tr_seri(:,k,id_aga) + pdtphys | |
524 | END DO | ||
525 | |||
526 | ! Top layer | ||
527 | ✗ | tr_seri(:,klev,id_aga) = tr_seri(:,klev-1,id_aga) | |
528 | |||
529 | END IF | ||
530 | |||
531 | !====================================================================== | ||
532 | ! -- Calcul de l'effet de la couche limite -- | ||
533 | !====================================================================== | ||
534 | |||
535 |
1/2✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
|
480 | IF (couchelimite) THEN |
536 |
4/4✓ Branch 0 taken 960 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 954240 times.
✓ Branch 3 taken 960 times.
|
955680 | source(:,:) = 0.0 |
537 | |||
538 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | IF (id_be /=0) THEN |
539 | ✗ | DO i=1, klon | |
540 | ✗ | zrho = pplay(i,1)/t_seri(i,1)/RD | |
541 | ✗ | source(i,id_be) = - vdeptr(id_be)*tr_seri(i,1,id_be)*zrho | |
542 | END DO | ||
543 | END IF | ||
544 | |||
545 | END IF | ||
546 | |||
547 |
2/2✓ Branch 0 taken 960 times.
✓ Branch 1 taken 480 times.
|
1440 | DO it=1, nbtr |
548 |
5/8✓ Branch 0 taken 960 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 960 times.
✓ Branch 4 taken 480 times.
✓ Branch 5 taken 480 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 480 times.
|
1440 | IF (couchelimite .AND. pbl_flg(it) == 0 .AND. (it==id_rn .OR. it==id_pb)) THEN |
549 | ! couche limite avec quantite dans le sol calculee | ||
550 | CALL cltracrn(it, pdtphys, yu1, yv1, & | ||
551 | cdragh, coefh,t_seri,ftsol,pctsrf, & | ||
552 | tr_seri(:,:,it),trs(:,it), & | ||
553 | paprs, pplay, zmasse * rg, & | ||
554 | masktr(:,it),fshtr(:,it),hsoltr(it),& | ||
555 | tautr(it),vdeptr(it), & | ||
556 |
5/6✓ Branch 0 taken 960 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 37440 times.
✓ Branch 3 taken 960 times.
✓ Branch 4 taken 37440 times.
✓ Branch 5 taken 37215360 times.
|
37253760 | xlat,d_tr_cl(:,:,it),d_trs) |
557 | |||
558 |
2/2✓ Branch 0 taken 37440 times.
✓ Branch 1 taken 960 times.
|
38400 | DO k = 1, klev |
559 |
2/2✓ Branch 0 taken 37215360 times.
✓ Branch 1 taken 37440 times.
|
37253760 | DO i = 1, klon |
560 | 37252800 | tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_cl(i,k,it) | |
561 | END DO | ||
562 | END DO | ||
563 | |||
564 | ! Traceur dans le reservoir sol | ||
565 |
2/2✓ Branch 0 taken 960 times.
✓ Branch 1 taken 954240 times.
|
955200 | DO i = 1, klon |
566 | 955200 | trs(i,it) = trs(i,it) + d_trs(i) | |
567 | END DO | ||
568 | END IF | ||
569 | END DO | ||
570 | |||
571 | |||
572 | !====================================================================== | ||
573 | ! Calcul de l'effet du puits radioactif | ||
574 | !====================================================================== | ||
575 | 480 | CALL radio_decay (radio,rnpb,pdtphys,tautr,tr_seri,d_tr_dec) | |
576 | |||
577 |
2/2✓ Branch 0 taken 960 times.
✓ Branch 1 taken 480 times.
|
1440 | DO it=1,nbtr |
578 | 1440 | WRITE(solsym(it),'(i2)') it | |
579 | END DO | ||
580 | |||
581 |
2/2✓ Branch 0 taken 960 times.
✓ Branch 1 taken 480 times.
|
1440 | DO it=1,nbtr |
582 |
1/2✓ Branch 0 taken 960 times.
✗ Branch 1 not taken.
|
1440 | IF(radio(it)) then |
583 |
2/2✓ Branch 0 taken 37440 times.
✓ Branch 1 taken 960 times.
|
38400 | DO k = 1, klev |
584 |
2/2✓ Branch 0 taken 37215360 times.
✓ Branch 1 taken 37440 times.
|
37253760 | DO i = 1, klon |
585 | 37252800 | tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_dec(i,k,it) | |
586 | END DO | ||
587 | END DO | ||
588 | 960 | CALL minmaxqfi(tr_seri(:,:,it),0.,1.e33,'puits rn it='//solsym(it)) | |
589 | END IF | ||
590 | END DO | ||
591 | |||
592 | !====================================================================== | ||
593 | ! Parameterization of ozone chemistry | ||
594 | !====================================================================== | ||
595 | |||
596 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | IF (id_o3 /= 0) then |
597 | ✗ | lmt_pas = NINT(86400./pdtphys) | |
598 | ✗ | IF (MOD(nstep - 1, lmt_pas) == 0) THEN | |
599 | ! Once per day, update the coefficients for ozone chemistry: | ||
600 | ✗ | CALL regr_pr_comb_coefoz(julien, xlat, paprs, pplay) | |
601 | END IF | ||
602 | CALL o3_chem(julien, gmtime, t_seri, zmasse, pdtphys, xlat, & | ||
603 | ✗ | xlon, tr_seri(:, :, id_o3)) | |
604 | END IF | ||
605 | |||
606 | 480 | END SUBROUTINE traclmdz | |
607 | |||
608 | |||
609 | 2 | SUBROUTINE traclmdz_to_restart(trs_out) | |
610 | ! This subroutine is called from phyredem.F where the module | ||
611 | ! variable trs is written to restart file (restartphy.nc) | ||
612 | ✗ | USE dimphy | |
613 | USE infotrac_phy | ||
614 | |||
615 | REAL,DIMENSION(klon,nbtr), INTENT(OUT) :: trs_out | ||
616 | INTEGER :: ierr | ||
617 | |||
618 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 2 times.
|
2 | IF ( ALLOCATED(trs) ) THEN |
619 |
4/4✓ Branch 0 taken 4 times.
✓ Branch 1 taken 2 times.
✓ Branch 2 taken 3976 times.
✓ Branch 3 taken 4 times.
|
3982 | trs_out(:,:) = trs(:,:) |
620 | ELSE | ||
621 | ! No previous allocate of trs. This is the case for create_etat0_limit. | ||
622 | ✗ | trs_out(:,:) = 0.0 | |
623 | END IF | ||
624 | |||
625 | 2 | END SUBROUTINE traclmdz_to_restart | |
626 | |||
627 | |||
628 | END MODULE traclmdz_mod | ||
629 |