Context Navigation

traclmdz_mod.F90 @ 1200

Last change on this file since 1200 was 1191, checked in by jghattas, 15 years ago

Reecriture de phytrac et les routines concernes (Anthony Jamelot)

les suffix change de F -> F90 (nflxtr.F90,cltracrn.F90,initrrnpb.F90,cvltr.F90,minmaxqfi.F90,cltrac.F90,phytrac.F90)

Traitement d'un nouveau traceur berelium (optionel, toujours pour des
tests)(Anthony Jamelot)

radiornpb.F change du nom pour radio_decay.F90 car il traite maintenant tout les traceurs radioactives
ajoute init_be.F90

Nouveau interface dans phytrac pour serparer les calculs et appels
specifique a INCA avec les traitements des traceurs specifiques au LMDZ
(JG)

ajoute tracinca_mod.F90 pour les appeles a INCA
ajoute traclmdz_mod.F90 pour les calculs des traceurs specifiques a LMDZ
enleve fichier restartrac et ajoute la variable trs dans restartphy.nc

La convergence numerique a etait rompue uniquement pour les traceurs
LMDZ RN et PB.

File size: 10.8 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
9	REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: masktr ! Masque reservoir de sol traceur
10	!$OMP THREADPRIVATE(masktr) ! Masque de l'echange avec la surface (1 = reservoir) ou (possible >= 1 )
11	REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: fshtr ! Flux surfacique dans le reservoir de sol
12	!$OMP THREADPRIVATE(fshtr)
13	REAL,DIMENSION(:),ALLOCATABLE,SAVE :: hsoltr ! Epaisseur equivalente du reservoir de sol
14	!$OMP THREADPRIVATE(hsoltr)
15	!
16	!Radioelements:
17	!--------------
18	!
19	REAL,DIMENSION(:),ALLOCATABLE,SAVE :: tautr ! Constante de decroissance radioactive
20	!$OMP THREADPRIVATE(tautr)
21	REAL,DIMENSION(:),ALLOCATABLE,SAVE :: vdeptr ! Vitesse de depot sec dans la couche Brownienne
22	!$OMP THREADPRIVATE(vdeptr)
23	REAL,DIMENSION(:),ALLOCATABLE,SAVE :: scavtr ! Coefficient de lessivage
24	!$OMP THREADPRIVATE(scavtr)
25	REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: srcbe ! Production du beryllium7 dans l atmosphere (U/s/kgA)
26	!$OMP THREADPRIVATE(srcbe)
27
28	LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: radio ! radio(it) = true => decroisssance radioactive
29	!$OMP THREADPRIVATE(radio)
30
31	REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: trs ! Conc. radon ds le sol
32	!$OMP THREADPRIVATE(trs)
33
34	INTEGER,SAVE :: id_be ! Activation et position du traceur Be7 [ id_be=0 -> desactive ]
35	!$OMP THREADPRIVATE(id_be)
36
37	LOGICAL,SAVE :: rnpb=.TRUE. ! Presence du couple Rn222, Pb210
38	!$OMP THREADPRIVATE(rnpb)
39
40
41	CONTAINS
42
43	SUBROUTINE traclmdz_from_restart(trs_in)
44	! This subroutine initialize the module saved variable trs with values from restart file (startphy.nc).
45	! This subroutine is called from phyetat0 after the field trs_in has been read.
46
47	USE dimphy
48	USE infotrac
49	IMPLICIT NONE
50
51	! Input argument
52	REAL,DIMENSION(klon,nbtr), INTENT(IN) :: trs_in
53
54	! Local variables
55	INTEGER :: ierr
56
57	! Allocate restart variables trs
58	ALLOCATE( trs(klon,nbtr), stat=ierr)
59	IF (ierr /= 0) CALL abort_gcm('traclmdz_start', 'pb in allocation 1',1)
60
61	! Initialize trs with values read from restart file
62	trs(:,:) = trs_in(:,:)
63
64	END SUBROUTINE traclmdz_from_restart
65
66
67	SUBROUTINE traclmdz_init(pctsrf, ftsol, aerosol, lessivage)
68	! This subroutine allocates and initialize module variables and control variables.
69	USE dimphy
70	USE infotrac
71
72	IMPLICIT NONE
73
74	INCLUDE "indicesol.h"
75
76	! Input variables
77	REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: pctsrf ! Pourcentage de sol f(nature du sol)
78	REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: ftsol ! Temperature du sol (surf)(Kelvin)
79
80	! Output variables
81	LOGICAL,DIMENSION(nbtr), INTENT(OUT) :: aerosol
82	LOGICAL,INTENT(OUT) :: lessivage
83
84	! Local variables
85	INTEGER :: ierr, it, iiq
86
87	! --------------------------------------------
88	! Allocation
89	! --------------------------------------------
90
91	ALLOCATE( scavtr(nbtr), stat=ierr)
92	IF (ierr /= 0) CALL abort_gcm('phytrac', 'pb in allocation 9',1)
93	scavtr(:)=1.
94
95	ALLOCATE( radio(nbtr), stat=ierr)
96	IF (ierr /= 0) CALL abort_gcm('phytrac', 'pb in allocation 11',1)
97	radio(:) = .false. ! Par defaut pas decroissance radioactive
98
99	ALLOCATE( masktr(klon,nbtr), stat=ierr)
100	IF (ierr /= 0) CALL abort_gcm('phytrac', 'pb in allocation 2',1)
101
102	ALLOCATE( fshtr(klon,nbtr), stat=ierr)
103	IF (ierr /= 0) CALL abort_gcm('phytrac', 'pb in allocation 3',1)
104
105	ALLOCATE( hsoltr(nbtr), stat=ierr)
106	IF (ierr /= 0) CALL abort_gcm('phytrac', 'pb in allocation 4',1)
107
108	ALLOCATE( tautr(nbtr), stat=ierr)
109	IF (ierr /= 0) CALL abort_gcm('phytrac', 'pb in allocation 5',1)
110	tautr(:) = 0.
111
112	ALLOCATE( vdeptr(nbtr), stat=ierr)
113	IF (ierr /= 0) CALL abort_gcm('phytrac', 'pb in allocation 6',1)
114	vdeptr(:) = 0.
115
116
117	lessivage = .TRUE.
118	aerosol(:) = .FALSE. ! Tous les traceurs sont des gaz par defaut
119
120	!
121	! Recherche des traceurs connus : Be7, CO2,...
122	! --------------------------------------------
123	DO it=1,nbtr
124	iiq=niadv(it+2)
125	!
126	! Recherche du Beryllium 7
127	!
128	IF ( tname(iiq) == "BE" .OR. tname(iiq) == "Be" .OR. &
129	tname(iiq) == "BE7" .OR. tname(iiq) == "Be7" ) THEN
130	id_be=it
131	ALLOCATE( srcbe(klon,klev) )
132	radio(id_be) = .TRUE.
133	aerosol(id_be) = .TRUE. ! le Be est un aerosol
134	CALL init_be(pctsrf,masktr(:,id_be),tautr(id_be),vdeptr(id_be),scavtr(id_be),srcbe)
135	WRITE(,) 'Initialisation srcBe: OK'
136	ELSE
137	id_be=0
138	END IF
139
140	! Placer ici la recherche de nouveaux traceurs
141	! ...
142	END DO
143	!
144	! Valeurs specifiques pour les traceurs Rn222 et Pb210
145	! ----------------------------------------------
146	IF (rnpb) THEN
147
148	radio(1)= .TRUE.
149	radio(2)= .TRUE.
150	pbl_flg(1) = 0 ! au lieu de clsol=true ! CL au sol calcule
151	pbl_flg(2) = 0 ! au lieu de clsol=true
152
153	aerosol(2) = .TRUE. ! le Pb est un aerosol
154
155	CALL initrrnpb (ftsol,pctsrf,masktr,fshtr,hsoltr,tautr,vdeptr,scavtr)
156	END IF
157
158	END SUBROUTINE traclmdz_init
159
160	SUBROUTINE traclmdz( &
161	pdtphys, t_seri, &
162	paprs, pplay, cdragh, coefh, &
163	yu1, yv1, ftsol, pctsrf, &
164	xlat, couchelimite, &
165	tr_seri, source, solsym, d_tr_cl)
166
167	USE dimphy
168	USE infotrac
169
170	IMPLICIT NONE
171
172	INCLUDE "YOMCST.h"
173	INCLUDE "indicesol.h"
174
175	!==========================================================================
176	! -- DESCRIPTION DES ARGUMENTS --
177	!==========================================================================
178
179	! Input arguments
180	!
181	!Configuration grille,temps:
182	REAL,INTENT(IN) :: pdtphys ! Pas d'integration pour la physique (seconde)
183	REAL,DIMENSION(klon),INTENT(IN) :: xlat ! latitudes pour chaque point
184
185	!
186	!Physique:
187	!--------
188	REAL,DIMENSION(klon,klev),INTENT(IN) :: t_seri ! Temperature
189	REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs ! pression pour chaque inter-couche (en Pa)
190	REAL,DIMENSION(klon,klev),INTENT(IN) :: pplay ! pression pour le mileu de chaque couche (en Pa)
191
192
193	!Couche limite:
194	!--------------
195	!
196	REAL,DIMENSION(klon,klev),INTENT(IN) :: cdragh ! coeff drag pour T et Q
197	REAL,DIMENSION(klon,klev),INTENT(IN) :: coefh ! coeff melange CL (m**2/s)
198	REAL,DIMENSION(klon),INTENT(IN) :: yu1 ! vents au premier niveau
199	REAL,DIMENSION(klon),INTENT(IN) :: yv1 ! vents au premier niveau
200	LOGICAL,INTENT(IN) :: couchelimite
201
202	! Arguments necessaires pour les sources et puits de traceur:
203	REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: ftsol ! Temperature du sol (surf)(Kelvin)
204	REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: pctsrf ! Pourcentage de sol f(nature du sol)
205
206	! InOutput argument
207	REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT) :: tr_seri ! Concentration Traceur [U/KgA]
208
209	! Output argument
210	CHARACTER(len=8),DIMENSION(nbtr), INTENT(OUT) :: solsym
211	REAL,DIMENSION(klon,nbtr), INTENT(OUT) :: source ! a voir lorsque le flux de surface est prescrit
212	REAL,DIMENSION(klon,klev,nbtr), INTENT(OUT) :: d_tr_cl ! Td couche limite/traceur
213
214
215	!=======================================================================================
216	! -- VARIABLES LOCALES TRACEURS --
217	!=======================================================================================
218
219	INTEGER :: i, k, it
220
221
222	REAL,DIMENSION(klon) :: d_trs ! Td dans le reservoir
223	REAL,DIMENSION(klon,klev) :: delp ! epaisseur de couche (Pa)
224
225	REAL,DIMENSION(klon,klev,nbtr) :: d_tr_dec ! Td radioactive
226	REAL :: zrho ! Masse Volumique de l'air KgA/m3
227
228	!
229	!
230	!=================================================================
231	! Ajout de la production en Be7 (Beryllium) srcbe U/s/kgA
232	!=================================================================
233	!
234	IF ( id_be /= 0 ) THEN
235	DO k = 1, klev
236	DO i = 1, klon
237	tr_seri(i,k,id_be) = tr_seri(i,k,id_be)+srcbe(i,k)*pdtphys
238	END DO
239	END DO
240	WRITE(,) 'Ajout srcBe dans tr_seri: OK'
241	END IF
242
243
244	DO it=1,nbtr
245	WRITE(solsym(it),'(i2)') it
246	END DO
247	!======================================================================
248	! -- Calcul de l'effet de la couche limite --
249	!======================================================================
250
251	IF (couchelimite) THEN
252	DO it=1, nbtr
253	IF ( it == id_be ) THEN
254	DO i=1, klon
255	zrho = pplay(i,1)/t_seri(i,1)/RD
256	source(i,it) = - vdeptr(it)tr_seri(i,1,it)zrho
257	END DO
258	ELSE
259	source(:,it) = 0.0
260	END IF
261	END DO
262	END IF
263
264
265	DO k = 1, klev
266	DO i = 1, klon
267	delp(i,k) = paprs(i,k)-paprs(i,k+1)
268	END DO
269	END DO
270
271	DO it=1, nbtr
272	IF (couchelimite .AND. pbl_flg(it) == 0 ) THEN ! couche limite avec quantite dans le sol calculee
273	CALL cltracrn(it, pdtphys, yu1, yv1, &
274	cdragh, coefh,t_seri,ftsol,pctsrf, &
275	tr_seri(:,:,it),trs(:,it), &
276	paprs, pplay, delp, &
277	masktr(:,it),fshtr(:,it),hsoltr(it),&
278	tautr(it),vdeptr(it), &
279	xlat,d_tr_cl(:,:,it),d_trs)
280
281	DO k = 1, klev
282	DO i = 1, klon
283	tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_cl(i,k,it)
284	END DO
285	END DO
286
287	! Traceur dans le reservoir sol
288	DO i = 1, klon
289	trs(i,it) = trs(i,it) + d_trs(i)
290	END DO
291	END IF
292	END DO
293
294	!======================================================================
295	! Calcul de l'effet du puits radioactif
296	!======================================================================
297	CALL radio_decay (radio,rnpb,pdtphys,tautr,tr_seri,d_tr_dec)
298
299	DO it=1,nbtr
300	IF(radio(it)) then
301	DO k = 1, klev
302	DO i = 1, klon
303	tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_dec(i,k,it)
304	END DO
305	END DO
306	CALL minmaxqfi(tr_seri(:,:,it),0.,1.e33,'puits rn it='//solsym(it))
307	END IF
308	END DO
309
310
311	END SUBROUTINE traclmdz
312
313
314	SUBROUTINE traclmdz_to_restart(trs_out)
315	! This subroutine is called from phyredem.F where the module
316	! variable trs is written to restart file (restartphy.nc)
317	USE dimphy
318	USE infotrac
319
320	IMPLICIT NONE
321
322	REAL,DIMENSION(klon,nbtr), INTENT(OUT) :: trs_out
323
324	trs_out(:,:) = trs(:,:)
325
326	END SUBROUTINE traclmdz_to_restart
327
328
329	END MODULE traclmdz_mod

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

Download in other formats:

Original Format