Context Navigation

phytrac.F90 @ 1565

Last change on this file since 1565 was 1565, checked in by jghattas, 13 years ago

Added interface with chemestry model REPROBUS :

Compile LMDZ together with Reprobus code (dependecies in both directions) and cpp key REPROBUS :

./makelmdz_fcm -ext_src my_path_to_reprobus -cpp REPROBUS ...

For running, add type_trac=repr in run.def.

/Marion Marchand, JG

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

File size: 15.3 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	xlat, frac_impa,frac_nucl,xlon, &
11	presnivs, pphis, pphi, albsol, &
12	sh, rh, cldfra, rneb, &
13	diafra, cldliq, itop_con, ibas_con, &
14	pmflxr, pmflxs, prfl, psfl, &
15	da, phi, mp, upwd, &
16	dnwd, aerosol_couple, flxmass_w, &
17	tau_aero, piz_aero, cg_aero, ccm, &
18	rfname, &
19	tr_seri)
20	!
21	!======================================================================
22	! Auteur(s) FH
23	! Objet: Moniteur general des tendances traceurs
24	!======================================================================
25
26	USE ioipsl
27	USE dimphy
28	USE infotrac
29	USE mod_grid_phy_lmdz
30	USE mod_phys_lmdz_para
31	USE comgeomphy
32	USE iophy
33	USE traclmdz_mod
34	USE tracinca_mod
35	USE tracreprobus_mod
36	USE control_mod
37
38
39	IMPLICIT NONE
40
41	INCLUDE "YOMCST.h"
42	INCLUDE "dimensions.h"
43	INCLUDE "indicesol.h"
44	INCLUDE "clesphys.h"
45	INCLUDE "temps.h"
46	INCLUDE "paramet.h"
47	INCLUDE "thermcell.h"
48	!==========================================================================
49	! -- ARGUMENT DESCRIPTION --
50	!==========================================================================
51
52	! Input arguments
53	!----------------
54	!Configuration grille,temps:
55	INTEGER,INTENT(IN) :: nstep ! Appel physique
56	INTEGER,INTENT(IN) :: julien ! Jour julien
57	REAL,INTENT(IN) :: gmtime ! Heure courante
58	REAL,INTENT(IN) :: pdtphys ! Pas d'integration pour la physique (seconde)
59	LOGICAL,INTENT(IN) :: debutphy ! le flag de l'initialisation de la physique
60	LOGICAL,INTENT(IN) :: lafin ! le flag de la fin de la physique
61
62	REAL,DIMENSION(klon),INTENT(IN) :: xlat ! latitudes pour chaque point
63	REAL,DIMENSION(klon),INTENT(IN) :: xlon ! longitudes pour chaque point
64	!
65	!Physique:
66	!--------
67	REAL,DIMENSION(klon,klev),INTENT(IN) :: t_seri ! Temperature
68	REAL,DIMENSION(klon,klev),INTENT(IN) :: u ! variable not used
69	REAL,DIMENSION(klon,klev),INTENT(IN) :: v ! variable not used
70	REAL,DIMENSION(klon,klev),INTENT(IN) :: sh ! humidite specifique
71	REAL,DIMENSION(klon,klev),INTENT(IN) :: rh ! humidite relative
72	REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs ! pression pour chaque inter-couche (en Pa)
73	REAL,DIMENSION(klon,klev),INTENT(IN) :: pplay ! pression pour le mileu de chaque couche (en Pa)
74	REAL,DIMENSION(klon,klev),INTENT(IN) :: pphi ! geopotentiel
75	REAL,DIMENSION(klon),INTENT(IN) :: pphis
76	REAL,DIMENSION(klev),INTENT(IN) :: presnivs
77	REAL,DIMENSION(klon,klev),INTENT(IN) :: cldliq ! eau liquide nuageuse
78	REAL,DIMENSION(klon,klev),INTENT(IN) :: cldfra ! fraction nuageuse (tous les nuages)
79	REAL,DIMENSION(klon,klev),INTENT(IN) :: diafra ! fraction nuageuse (convection ou stratus artificiels)
80	REAL,DIMENSION(klon,klev),INTENT(IN) :: rneb ! fraction nuageuse (grande echelle)
81	INTEGER,DIMENSION(klon),INTENT(IN) :: itop_con
82	INTEGER,DIMENSION(klon),INTENT(IN) :: ibas_con
83	REAL,DIMENSION(klon),INTENT(IN) :: albsol ! albedo surface
84	!
85	!Convection:
86	!----------
87	REAL,DIMENSION(klon,klev),INTENT(IN) :: pmfu ! flux de masse dans le panache montant
88	REAL,DIMENSION(klon,klev),INTENT(IN) :: pmfd ! flux de masse dans le panache descendant
89	REAL,DIMENSION(klon,klev),INTENT(IN) :: pen_u ! flux entraine dans le panache montant
90	REAL,DIMENSION(klon,klev),INTENT(IN) :: pde_u ! flux detraine dans le panache montant
91	REAL,DIMENSION(klon,klev),INTENT(IN) :: pen_d ! flux entraine dans le panache descendant
92	REAL,DIMENSION(klon,klev),INTENT(IN) :: pde_d ! flux detraine dans le panache descendant
93
94	!...Tiedke
95	REAL,DIMENSION(klon,klev+1),INTENT(IN) :: pmflxr, pmflxs ! Flux precipitant de pluie, neige aux interfaces [convection]
96	REAL,DIMENSION(klon,klev+1),INTENT(IN) :: prfl, psfl ! Flux precipitant de pluie, neige aux interfaces [large-scale]
97
98	LOGICAL,INTENT(IN) :: aerosol_couple
99	REAL,DIMENSION(klon,klev),INTENT(IN) :: flxmass_w
100	REAL,DIMENSION(klon,klev,9,2),INTENT(IN) :: tau_aero
101	REAL,DIMENSION(klon,klev,9,2),INTENT(IN) :: piz_aero
102	REAL,DIMENSION(klon,klev,9,2),INTENT(IN) :: cg_aero
103	CHARACTER(len=4),DIMENSION(9),INTENT(IN) :: rfname
104	REAL,DIMENSION(klon,klev,2),INTENT(IN) :: ccm
105	!... K.Emanuel
106	REAL,DIMENSION(klon,klev),INTENT(IN) :: da
107	REAL,DIMENSION(klon,klev,klev),INTENT(IN):: phi
108	REAL,DIMENSION(klon,klev),INTENT(IN) :: mp
109	REAL,DIMENSION(klon,klev),INTENT(IN) :: upwd ! saturated updraft mass flux
110	REAL,DIMENSION(klon,klev),INTENT(IN) :: dnwd ! saturated downdraft mass flux
111	!
112	!Thermiques:
113	!----------
114	REAL,DIMENSION(klon,klev+1),INTENT(IN) :: fm_therm
115	REAL,DIMENSION(klon,klev),INTENT(IN) :: entr_therm
116	!
117	!Couche limite:
118	!--------------
119	!
120	REAL,DIMENSION(klon),INTENT(IN) :: cdragh ! coeff drag pour T et Q
121	REAL,DIMENSION(klon,klev),INTENT(IN) :: coefh ! coeff melange CL (m**2/s)
122	REAL,DIMENSION(klon),INTENT(IN) :: yu1 ! vents au premier niveau
123	REAL,DIMENSION(klon),INTENT(IN) :: yv1 ! vents au premier niveau
124	!
125	!Lessivage:
126	!----------
127	!
128	! pour le ON-LINE
129	!
130	REAL,DIMENSION(klon,klev),INTENT(IN) :: frac_impa ! fraction d'aerosols non impactes
131	REAL,DIMENSION(klon,klev),INTENT(IN) :: frac_nucl ! fraction d'aerosols non nuclees
132
133	! Arguments necessaires pour les sources et puits de traceur:
134	REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: ftsol ! Temperature du sol (surf)(Kelvin)
135	REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: pctsrf ! Pourcentage de sol (nature du sol)
136
137
138	! Output argument
139	!----------------
140	REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT) :: tr_seri ! Concentration Traceur [U/KgA]
141
142	!=======================================================================================
143	! -- LOCAL VARIABLES --
144	!=======================================================================================
145
146	INTEGER :: i, k, it
147	INTEGER :: nsplit
148
149	!Sources et Reservoirs de traceurs (ex:Radon):
150	!--------------------------------------------
151	!
152	REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: source ! a voir lorsque le flux de surface est prescrit
153	!$OMP THREADPRIVATE(source)
154
155	!
156	!Entrees/Sorties: (cf ini_histrac.h et write_histrac.h)
157	!---------------
158	INTEGER :: iiq, ierr
159	INTEGER :: nhori, nvert
160	REAL :: zsto, zout, zjulian
161	INTEGER,SAVE :: nid_tra ! pointe vers le fichier histrac.nc
162	!$OMP THREADPRIVATE(nid_tra)
163	REAL,DIMENSION(klon) :: zx_tmp_fi2d ! variable temporaire grille physique
164	INTEGER :: itau_w ! pas de temps ecriture = nstep + itau_phy
165	LOGICAL,PARAMETER :: ok_sync=.TRUE.
166
167	!
168	! Nature du traceur
169	!------------------
170	LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: aerosol ! aerosol(it) = true => aerosol => lessivage
171	!$OMP THREADPRIVATE(aerosol) ! aerosol(it) = false => gaz
172	REAL,DIMENSION(klon,klev) :: delp ! epaisseur de couche (Pa)
173	!
174	! Tendances de traceurs (Td):
175	!------------------------
176	!
177	REAL,DIMENSION(klon,klev) :: d_tr ! Td dans l'atmosphere
178	REAL,DIMENSION(klon,klev,nbtr) :: d_tr_cl ! Td couche limite/traceur
179	REAL,DIMENSION(klon,klev,nbtr) :: d_tr_cv ! Td convection/traceur
180	REAL,DIMENSION(klon,klev,nbtr) :: d_tr_th ! Td thermique
181	REAL,DIMENSION(klon,klev,nbtr) :: d_tr_lessi_impa ! Td du lessivage par impaction
182	REAL,DIMENSION(klon,klev,nbtr) :: d_tr_lessi_nucl ! Td du lessivage par nucleation
183	!
184	! Physique
185	!----------
186	REAL,DIMENSION(klon,klev,nbtr) :: flestottr ! flux de lessivage dans chaque couche
187	REAL,DIMENSION(klon,klev) :: zmasse ! densité atmosphérique Kg/m2
188	REAL,DIMENSION(klon,klev) :: ztra_th
189
190	!Controles:
191	!---------
192	LOGICAL,SAVE :: couchelimite=.TRUE.
193	LOGICAL,SAVE :: convection=.TRUE.
194	LOGICAL,SAVE :: lessivage
195	!$OMP THREADPRIVATE(couchelimite,convection,lessivage)
196
197	CHARACTER(len=8),DIMENSION(nbtr) :: solsym
198
199
200	!######################################################################
201	! -- INITIALIZATION --
202	!######################################################################
203	IF (debutphy) THEN
204	WRITE(,) 'FIRST TIME IN PHYTRAC : pdtphys(sec) = ',pdtphys,'ecrit_tra (sec) = ',ecrit_tra
205	ALLOCATE( source(klon,nbtr), stat=ierr)
206	IF (ierr /= 0) CALL abort_gcm('phytrac', 'pb in allocation 1',1)
207
208	ALLOCATE( aerosol(nbtr), stat=ierr)
209	IF (ierr /= 0) CALL abort_gcm('phytrac', 'pb in allocation 2',1)
210
211
212	! Initialize module for specific tracers
213	SELECT CASE(type_trac)
214	CASE('lmdz')
215	CALL traclmdz_init(pctsrf, ftsol, tr_seri, t_seri, pplay, sh, pdtphys, aerosol, lessivage)
216	CASE('inca')
217	source(:,:)=0.
218	CALL tracinca_init(aerosol,lessivage)
219	CASE('repr')
220	source(:,:)=0.
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	DO k=1,klev
232	DO i=1,klon
233	zmasse(i,k)=(paprs(i,k)-paprs(i,k+1))/rg
234	END DO
235	END DO
236
237	!===============================================================================
238	! -- Do specific treatment according to chemestry model or local LMDZ tracers
239	!
240	!===============================================================================
241	SELECT CASE(type_trac)
242	CASE('lmdz')
243	! -- Traitement des traceurs avec traclmdz
244	CALL traclmdz(nstep, julien, gmtime, pdtphys, t_seri, paprs, pplay, &
245	cdragh, coefh, yu1, yv1, ftsol, pctsrf, xlat, xlon, couchelimite, &
246	sh, tr_seri, source, solsym, d_tr_cl, zmasse)
247	CASE('inca')
248	! -- CHIMIE INCA config_inca = aero or chem --
249
250	CALL tracinca(&
251	nstep, julien, gmtime, lafin, &
252	pdtphys, t_seri, paprs, pplay, &
253	pmfu, ftsol, pctsrf, pphis, &
254	pphi, albsol, sh, rh, &
255	cldfra, rneb, diafra, cldliq, &
256	itop_con, ibas_con, pmflxr, pmflxs, &
257	prfl, psfl, aerosol_couple, flxmass_w, &
258	tau_aero, piz_aero, cg_aero, ccm, &
259	rfname, &
260	tr_seri, source, solsym)
261
262	CASE('repr')
263	! -- CHIMIE REPROBUS --
264
265	CALL tracreprobus(pdtphys, gmtime, debutphy, julien, &
266	presnivs, xlat, xlon, pphis, pphi, &
267	t_seri, pplay, paprs, sh , &
268	tr_seri, solsym)
269
270	END SELECT
271
272	!======================================================================
273	! -- Calcul de l'effet de la convection --
274	!======================================================================
275	IF (convection) THEN
276	DO it=1, nbtr
277	IF ( conv_flg(it) == 0 ) CYCLE
278
279	IF (iflag_con.LT.2) THEN
280	d_tr_cv(:,:,:)=0.
281	ELSE IF (iflag_con.EQ.2) THEN
282	!..Tiedke
283	CALL nflxtr(pdtphys, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
284	pplay, paprs, tr_seri(:,:,it), d_tr_cv(:,:,it))
285	ELSE
286	!..K.Emanuel
287	CALL cvltr(pdtphys, da, phi, mp, paprs,pplay, tr_seri(:,:,it),&
288	upwd,dnwd,d_tr_cv(:,:,it))
289	END IF
290
291	DO k = 1, klev
292	DO i = 1, klon
293	tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_cv(i,k,it)
294	END DO
295	END DO
296
297	CALL minmaxqfi(tr_seri(:,:,it),0.,1.e33,'convection it = '//solsym(it))
298
299	END DO ! nbtr
300	END IF ! convection
301
302	!======================================================================
303	! -- Calcul de l'effet des thermiques --
304	!======================================================================
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