Context Navigation

traclmdz_mod.F90 @ 1715

Last change on this file since 1715 was 1670, checked in by idelkadi, 12 years ago

Modifications for inclusion of chimere dust emission module :
u* is passed from the boundary layer parameterization to the physics
main routine (physiq.F) and then to phytrac, traclmdz and change_srf_frac.
The interface of traclmdz is enriched with 4 other variables.
Also u* and the vertically cumulated amount of tracers is added in the
outputs.

Modifications pour l'inclusion du module d'émission de poussière de Chimere :
u* est passé depuis la couche limite vers le programme principal de la
physique (physiq.F) et ensuite à phytrac, traclmdz et change_srf_frac.
L'interface de traclmdz est enrichie avec 4 autres variables.
Les variables u* et les cumuls verticaux des traceurs sont ajoutés
dans les sorties.

File size: 21.1 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format