Context Navigation

traclmdz_mod.F90 @ 1644

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

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

Download in other formats:

Original Format