Context Navigation

phytrac.F90 @ 1376

Last change on this file since 1376 was 1376, checked in by musat, 14 years ago
Output all tracers defined in .def in hist files with dynamic declaration of LMDZ atmospheric tracers' output levels Add 6 pseudo-water tracers with and without transport by boundary layer IM
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 15.2 KB

Line
1
2	!$Id $
3
4	SUBROUTINE phytrac( &
5	nstep, julien, gmtime, debutphy, &
6	lafin, pdtphys, u, v, t_seri, &
7	paprs, pplay, pmfu, pmfd, &
8	pen_u, pde_u, pen_d, pde_d, &
9	cdragh, coefh, fm_therm, entr_therm,&
10	yu1, yv1, ftsol, pctsrf, &
11	xlat, frac_impa,frac_nucl,xlon, &
12	presnivs, pphis, pphi, albsol, &
13	sh, rh, cldfra, rneb, &
14	diafra, cldliq, itop_con, ibas_con, &
15	pmflxr, pmflxs, prfl, psfl, &
16	da, phi, mp, upwd, &
17	dnwd, aerosol_couple, flxmass_w, &
18	tau_aero, piz_aero, cg_aero, ccm, &
19	rfname, &
20	tr_seri)
21	!
22	!======================================================================
23	! Auteur(s) FH
24	! Objet: Moniteur general des tendances traceurs
25	!======================================================================
26
27	USE ioipsl
28	USE dimphy
29	USE infotrac
30	USE mod_grid_phy_lmdz
31	USE mod_phys_lmdz_para
32	USE comgeomphy
33	USE iophy
34	USE traclmdz_mod
35	USE tracinca_mod
36	USE control_mod
37
38
39
40	IMPLICIT NONE
41
42	INCLUDE "YOMCST.h"
43	INCLUDE "dimensions.h"
44	INCLUDE "indicesol.h"
45	INCLUDE "clesphys.h"
46	INCLUDE "temps.h"
47	INCLUDE "paramet.h"
48	INCLUDE "thermcell.h"
49	!==========================================================================
50	! -- ARGUMENT DESCRIPTION --
51	!==========================================================================
52
53	! Input arguments
54	!----------------
55	!Configuration grille,temps:
56	INTEGER,INTENT(IN) :: nstep ! Appel physique
57	INTEGER,INTENT(IN) :: julien ! Jour julien
58	REAL,INTENT(IN) :: gmtime
59	REAL,INTENT(IN) :: pdtphys ! Pas d'integration pour la physique (seconde)
60	LOGICAL,INTENT(IN) :: debutphy ! le flag de l'initialisation de la physique
61	LOGICAL,INTENT(IN) :: lafin ! le flag de la fin de la physique
62
63	REAL,DIMENSION(klon),INTENT(IN) :: xlat ! latitudes pour chaque point
64	REAL,DIMENSION(klon),INTENT(IN) :: xlon ! longitudes pour chaque point
65	!
66	!Physique:
67	!--------
68	REAL,DIMENSION(klon,klev),INTENT(IN) :: t_seri ! Temperature
69	REAL,DIMENSION(klon,klev),INTENT(IN) :: u !
70	REAL,DIMENSION(klon,klev),INTENT(IN) :: v !
71	REAL,DIMENSION(klon,klev),INTENT(IN) :: sh ! humidite specifique
72	REAL,DIMENSION(klon,klev),INTENT(IN) :: rh ! humidite relative
73	REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs ! pression pour chaque inter-couche (en Pa)
74	REAL,DIMENSION(klon,klev),INTENT(IN) :: pplay ! pression pour le mileu de chaque couche (en Pa)
75	REAL,DIMENSION(klon,klev),INTENT(IN) :: pphi ! geopotentiel
76	REAL,DIMENSION(klon),INTENT(IN) :: pphis
77	REAL,DIMENSION(klev),INTENT(IN) :: presnivs
78	REAL,DIMENSION(klon,klev),INTENT(IN) :: cldliq ! eau liquide nuageuse
79	REAL,DIMENSION(klon,klev),INTENT(IN) :: cldfra ! fraction nuageuse (tous les nuages)
80	REAL,DIMENSION(klon,klev),INTENT(IN) :: diafra ! fraction nuageuse (convection ou stratus artificiels)
81	REAL,DIMENSION(klon,klev),INTENT(IN) :: rneb ! fraction nuageuse (grande echelle)
82	INTEGER,DIMENSION(klon),INTENT(IN) :: itop_con
83	INTEGER,DIMENSION(klon),INTENT(IN) :: ibas_con
84	REAL,DIMENSION(klon),INTENT(IN) :: albsol ! albedo surface
85	!
86	!Convection:
87	!----------
88	REAL,DIMENSION(klon,klev),INTENT(IN) :: pmfu ! flux de masse dans le panache montant
89	REAL,DIMENSION(klon,klev),INTENT(IN) :: pmfd ! flux de masse dans le panache descendant
90	REAL,DIMENSION(klon,klev),INTENT(IN) :: pen_u ! flux entraine dans le panache montant
91	REAL,DIMENSION(klon,klev),INTENT(IN) :: pde_u ! flux detraine dans le panache montant
92	REAL,DIMENSION(klon,klev),INTENT(IN) :: pen_d ! flux entraine dans le panache descendant
93	REAL,DIMENSION(klon,klev),INTENT(IN) :: pde_d ! flux detraine dans le panache descendant
94
95	!...Tiedke
96	REAL,DIMENSION(klon,klev+1),INTENT(IN) :: pmflxr, pmflxs ! Flux precipitant de pluie, neige aux interfaces [convection]
97	REAL,DIMENSION(klon,klev+1),INTENT(IN) :: prfl, psfl ! Flux precipitant de pluie, neige aux interfaces [large-scale]
98
99	LOGICAL,INTENT(IN) :: aerosol_couple
100	REAL,DIMENSION(klon,klev),INTENT(IN) :: flxmass_w
101	REAL,DIMENSION(klon,klev,9,2),INTENT(IN) :: tau_aero
102	REAL,DIMENSION(klon,klev,9,2),INTENT(IN) :: piz_aero
103	REAL,DIMENSION(klon,klev,9,2),INTENT(IN) :: cg_aero
104	CHARACTER(len=4),DIMENSION(9),INTENT(IN) :: rfname
105	REAL,DIMENSION(klon,klev,2),INTENT(IN) :: ccm
106	!... K.Emanuel
107	REAL,DIMENSION(klon,klev),INTENT(IN) :: da
108	REAL,DIMENSION(klon,klev,klev),INTENT(IN):: phi
109	REAL,DIMENSION(klon,klev),INTENT(IN) :: mp
110	REAL,DIMENSION(klon,klev),INTENT(IN) :: upwd ! saturated updraft mass flux
111	REAL,DIMENSION(klon,klev),INTENT(IN) :: dnwd ! saturated downdraft mass flux
112	!
113	!Thermiques:
114	!----------
115	REAL,DIMENSION(klon,klev+1),INTENT(IN) :: fm_therm
116	REAL,DIMENSION(klon,klev),INTENT(IN) :: entr_therm
117	!
118	!Couche limite:
119	!--------------
120	!
121	REAL,DIMENSION(klon,klev),INTENT(IN) :: cdragh ! coeff drag pour T et Q
122	REAL,DIMENSION(klon,klev),INTENT(IN) :: coefh ! coeff melange CL (m**2/s)
123	REAL,DIMENSION(klon),INTENT(IN) :: yu1 ! vents au premier niveau
124	REAL,DIMENSION(klon),INTENT(IN) :: yv1 ! vents au premier niveau
125	!
126	!Lessivage:
127	!----------
128	!
129	! pour le ON-LINE
130	!
131	REAL,DIMENSION(klon,klev),INTENT(IN) :: frac_impa ! fraction d'aerosols non impactes
132	REAL,DIMENSION(klon,klev),INTENT(IN) :: frac_nucl ! fraction d'aerosols non nuclees
133
134	! Arguments necessaires pour les sources et puits de traceur:
135	REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: ftsol ! Temperature du sol (surf)(Kelvin)
136	REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: pctsrf ! Pourcentage de sol (nature du sol)
137
138
139	! Output argument
140	!----------------
141	REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT) :: tr_seri ! Concentration Traceur [U/KgA]
142
143	!=======================================================================================
144	! -- LOCAL VARIABLES --
145	!=======================================================================================
146
147	INTEGER :: i, k, it
148	INTEGER :: nsplit
149
150	!Sources et Reservoirs de traceurs (ex:Radon):
151	!--------------------------------------------
152	!
153	REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: source ! a voir lorsque le flux de surface est prescrit
154	!$OMP THREADPRIVATE(source)
155
156	!
157	!Entrees/Sorties: (cf ini_histrac.h et write_histrac.h)
158	!---------------
159	INTEGER :: iiq, ierr
160	INTEGER :: nhori, nvert
161	REAL :: zsto, zout, zjulian
162	INTEGER,SAVE :: nid_tra ! pointe vers le fichier histrac.nc
163	!$OMP THREADPRIVATE(nid_tra)
164	REAL,DIMENSION(klon) :: zx_tmp_fi2d ! variable temporaire grille physique
165	INTEGER :: itau_w ! pas de temps ecriture = nstep + itau_phy
166	LOGICAL,PARAMETER :: ok_sync=.TRUE.
167
168	!
169	! Nature du traceur
170	!------------------
171	LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: aerosol ! aerosol(it) = true => aerosol => lessivage
172	!$OMP THREADPRIVATE(aerosol) ! aerosol(it) = false => gaz
173	REAL,DIMENSION(klon,klev) :: delp ! epaisseur de couche (Pa)
174	!
175	! Tendances de traceurs (Td):
176	!------------------------
177	!
178	REAL,DIMENSION(klon,klev) :: d_tr ! Td dans l'atmosphere
179	REAL,DIMENSION(klon,klev,nbtr) :: d_tr_cl ! Td couche limite/traceur
180	REAL,DIMENSION(klon,klev,nbtr) :: d_tr_cv ! Td convection/traceur
181	REAL,DIMENSION(klon,klev,nbtr) :: d_tr_th ! Td thermique
182	REAL,DIMENSION(klon,klev,nbtr) :: d_tr_lessi_impa ! Td du lessivage par impaction
183	REAL,DIMENSION(klon,klev,nbtr) :: d_tr_lessi_nucl ! Td du lessivage par nucleation
184	!
185	! Physique
186	!----------
187	REAL,DIMENSION(klon,klev,nbtr) :: flestottr ! flux de lessivage dans chaque couche
188	REAL,DIMENSION(klon,klev) :: zmasse ! densité atmosphérique Kg/m2
189	REAL,DIMENSION(klon,klev) :: ztra_th
190
191	!Controles:
192	!---------
193	LOGICAL,SAVE :: couchelimite=.TRUE.
194	LOGICAL,SAVE :: convection=.TRUE.
195	LOGICAL,SAVE :: lessivage
196	!$OMP THREADPRIVATE(couchelimite,convection,lessivage)
197
198	CHARACTER(len=8),DIMENSION(nbtr) :: solsym
199
200
201	!######################################################################
202	! -- INITIALIZATION --
203	!######################################################################
204	IF (debutphy) THEN
205	WRITE(,) 'FIRST TIME IN PHYTRAC : pdtphys(sec) = ',pdtphys,'ecrit_tra (sec) = ',ecrit_tra
206	ALLOCATE( source(klon,nbtr), stat=ierr)
207	IF (ierr /= 0) CALL abort_gcm('phytrac', 'pb in allocation 1',1)
208
209	ALLOCATE( aerosol(nbtr), stat=ierr)
210	IF (ierr /= 0) CALL abort_gcm('phytrac', 'pb in allocation 2',1)
211
212
213	! Initialize module for specific tracers
214	SELECT CASE(type_trac)
215	CASE('lmdz')
216	!IM ajout t_seri, pplay, sh CALL traclmdz_init(pctsrf, ftsol, tr_seri, aerosol, lessivage)
217	CALL traclmdz_init(pctsrf, ftsol, tr_seri, t_seri, pplay, sh, aerosol, lessivage)
218	CASE('inca')
219	source(:,:)=0.
220	CALL tracinca_init(aerosol,lessivage)
221	END SELECT
222	!
223	! Initialize diagnostic output
224	! ----------------------------
225	#ifdef CPP_IOIPSL
226	INCLUDE "ini_histrac.h"
227	#endif
228	END IF
229	!############################################ END INITIALIZATION #######
230
231	!===============================================================================
232	! -- Do specific treatment according to chemestry model or local LMDZ tracers
233	!
234	!===============================================================================
235	SELECT CASE(type_trac)
236	CASE('lmdz')
237	! -- Traitement des traceurs avec traclmdz
238
239	CALL traclmdz(&
240	nstep, pdtphys, t_seri, &
241	paprs, pplay, cdragh, coefh, &
242	yu1, yv1, ftsol, pctsrf, &
243	xlat, couchelimite, sh, &
244	tr_seri, source, solsym, d_tr_cl)
245
246	CASE('inca')
247	! -- CHIMIE INCA config_inca = aero or chem --
248
249	CALL tracinca(&
250	nstep, julien, gmtime, lafin, &
251	pdtphys, t_seri, paprs, pplay, &
252	pmfu, ftsol, pctsrf, pphis, &
253	pphi, albsol, sh, rh, &
254	cldfra, rneb, diafra, cldliq, &
255	itop_con, ibas_con, pmflxr, pmflxs, &
256	prfl, psfl, aerosol_couple, flxmass_w, &
257	tau_aero, piz_aero, cg_aero, ccm, &
258	rfname, &
259	tr_seri, source, solsym)
260	END SELECT
261
262	!======================================================================
263	! -- Calcul de l'effet de la convection --
264	!======================================================================
265	IF (convection) THEN
266	DO it=1, nbtr
267	IF ( conv_flg(it) == 0 ) CYCLE
268
269	IF (iflag_con.LT.2) THEN
270	d_tr_cv(:,:,:)=0.
271	ELSE IF (iflag_con.EQ.2) THEN
272	!..Tiedke
273	CALL nflxtr(pdtphys, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
274	pplay, paprs, tr_seri(:,:,it), d_tr_cv(:,:,it))
275	ELSE
276	!..K.Emanuel
277	CALL cvltr(pdtphys, da, phi, mp, paprs,pplay, tr_seri(:,:,it),&
278	upwd,dnwd,d_tr_cv(:,:,it))
279	END IF
280
281	!IM ajout traceurs RR
282	! print*,'phytrac it,nseuil=',it,nseuil
283	IF (it.lt.nseuil) THEN
284	DO k = 1, klev
285	DO i = 1, klon
286	tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_cv(i,k,it)
287	END DO
288	END DO
289	END IF !(it.lt.nseuil) then
290
291	CALL minmaxqfi(tr_seri(:,:,it),0.,1.e33,'convection it = '//solsym(it))
292
293	END DO ! nbtr
294	END IF ! convection
295
296	!======================================================================
297	! -- Calcul de l'effet des thermiques --
298	!======================================================================
299
300	DO k=1,klev
301	DO i=1,klon
302	zmasse(i,k)=(paprs(i,k)-paprs(i,k+1))/rg
303	END DO
304	END DO
305
306	DO it=1,nbtr
307	DO k=1,klev
308	DO i=1,klon
309	d_tr_th(i,k,it)=0.
310	tr_seri(i,k,it)=MAX(tr_seri(i,k,it),0.)
311	tr_seri(i,k,it)=MIN(tr_seri(i,k,it),1.e10)
312	END DO
313	END DO
314	END DO
315
316	IF (iflag_thermals.GT.0) THEN
317	nsplit=10
318	DO it=1, nbtr
319	DO isplit=1,nsplit
320
321	CALL dqthermcell(klon,klev,pdtphys/nsplit, &
322	fm_therm,entr_therm,zmasse, &
323	tr_seri(1:klon,1:klev,it),d_tr,ztra_th)
324
325	DO k=1,klev
326	DO i=1,klon
327	d_tr(i,k)=pdtphys*d_tr(i,k)/nsplit
328	d_tr_th(i,k,it)=d_tr_th(i,k,it)+d_tr(i,k)
329	tr_seri(i,k,it)=MAX(tr_seri(i,k,it)+d_tr(i,k),0.)
330	END DO
331	END DO
332	END DO ! nsplit
333	END DO ! it
334	END IF ! Thermiques
335
336	!======================================================================
337	! -- Calcul de l'effet de la couche limite --
338	!======================================================================
339
340	IF (couchelimite) THEN
341
342	DO k = 1, klev
343	DO i = 1, klon
344	delp(i,k) = paprs(i,k)-paprs(i,k+1)
345	END DO
346	END DO
347
348	DO it=1, nbtr
349
350	IF( pbl_flg(it) /= 0 ) THEN
351
352	CALL cltrac(pdtphys, coefh,t_seri, &
353	tr_seri(:,:,it), source(:,it), &
354	paprs, pplay, delp, &
355	d_tr_cl(:,:,it))
356
357	DO k = 1, klev
358	DO i = 1, klon
359	tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_cl(i,k,it)
360	END DO
361	END DO
362	END IF
363
364	END DO
365
366	END IF ! couche limite
367
368
369	!======================================================================
370	! Calcul de l'effet de la precipitation
371	!======================================================================
372
373	IF (lessivage) THEN
374
375	d_tr_lessi_nucl(:,:,:) = 0.
376	d_tr_lessi_impa(:,:,:) = 0.
377	flestottr(:,:,:) = 0.
378	!=========================
379	! LESSIVAGE LARGE SCALE :
380	!=========================
381
382	! Tendance des aerosols nuclees et impactes
383	! -----------------------------------------
384	DO it = 1, nbtr
385	IF (aerosol(it)) THEN
386	DO k = 1, klev
387	DO i = 1, klon
388	d_tr_lessi_nucl(i,k,it) = d_tr_lessi_nucl(i,k,it) + &
389	( 1 - frac_nucl(i,k) )*tr_seri(i,k,it)
390	d_tr_lessi_impa(i,k,it) = d_tr_lessi_impa(i,k,it) + &
391	( 1 - frac_impa(i,k) )*tr_seri(i,k,it)
392
393	!
394	! Flux lessivage total
395	! ------------------------------------------------------------
396	flestottr(i,k,it) = flestottr(i,k,it) - &
397	( d_tr_lessi_nucl(i,k,it) + &
398	d_tr_lessi_impa(i,k,it) ) * &
399	( paprs(i,k)-paprs(i,k+1) ) / &
400	(RG * pdtphys)
401	!
402	! Mise a jour des traceurs due a l'impaction,nucleation
403	! ----------------------------------------------------------------------
404	tr_seri(i,k,it)=tr_seri(i,k,it)frac_impa(i,k)frac_nucl(i,k)
405	END DO
406	END DO
407	END IF
408	END DO
409
410	END IF ! lessivage
411
412	!=============================================================
413	! Ecriture des sorties
414	!=============================================================
415	#ifdef CPP_IOIPSL
416	INCLUDE "write_histrac.h"
417	#endif
418
419	END SUBROUTINE phytrac

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

Download in other formats:

Original Format