Context Navigation

phytrac.F90 @ 1670

Last change on this file since 1670 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.

Property svn:eol-style set to native
Property svn:keywords set to Author Date Id Revision

File size: 15.5 KB

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

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

Download in other formats:

Original Format