Context Navigation

traclmdz_mod.F90 @ 4050

Last change on this file since 4050 was 4050, checked in by dcugnet, 2 years ago

Second commit for new tracers.

include most of the keys in the tracers descriptor vector "tracers(:)".
fix in phylmdiso/cv3_routines: fq_* variables were used where their fxt_* counterparts were expected.
multiple IF(nqdesc(iq)>0) and IF(nqfils(iq)>0) tests suppressed, because they are not needed: "do ... enddo" loops with 0 upper bound are not executed.
remove French accents from comments (encoding problem) in phylmdiso/cv3_routines and phylmdiso/cv30_routines.
modifications in "isotopes_verif_mod", where the call to function "iso_verif_tag17_q_deltad_chn" in "iso_verif_tag17_q_deltad_chn" was not detected at linking stage, although defined in the same module (?).

Property copyright set to
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory

File size: 22.3 KB

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

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

Download in other formats:

Original Format