Context Navigation

init_be.F90 @ 5117

Last change on this file since 5117 was 5117, checked in by abarral, 4 months ago
rename modules properly lmdz_* move some unused files to obsolete/ (lint) uppercase fortran keywords
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: 26.7 KB

Line
1	!$Id $
2
3	SUBROUTINE init_be(pctsrf,pplay,masktr,tautr,vdeptr,scavtr,srcbe)
4	!!!SUBROUTINE init_be(pctsrf,masktr,tautr,vdeptr,scavtr,srcbe)
5
6	USE dimphy
7	USE indice_sol_mod
8	USE lmdz_geometry, ONLY: longitude, latitude
9
10	IMPLICIT NONE
11	!=====================================================================
12	! Objet : prescription d'une source de Beryllium 7
13	! pour 19 niveaux verticaux
14	! (d'apres le diagramme de Lal and Peters, 1967)
15
16
17	! written by : O. Coindreau (CEA/LDG) 05/2005
18	! last modified by : A. Jamelot (LMD/CEA) 04/03/2009
19	!=====================================================================
20
21	INCLUDE "YOMCST.h"
22	INCLUDE "YOECUMF.h"
23
24	! Input Arguments
25
26	REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: pctsrf !Pourcentage de sol (f(nature du sol))
27	REAL,DIMENSION(klon,klev), INTENT(IN) :: pplay ! Pressions en milieu de couches
28
29	! Output Arguments
30
31	REAL,DIMENSION(klon),INTENT(OUT) :: masktr ! Masque de l'echange avec la surface (possible => 1 )
32	REAL,INTENT(OUT) :: tautr ! Constante de decroissance radioactive
33	REAL,INTENT(OUT) :: vdeptr ! Vitesse de depot sec dans la couche Brownienne
34	REAL,INTENT(OUT) :: scavtr ! Coefficient de lessivage
35	REAL,DIMENSION(klon,klev),INTENT(OUT) :: srcbe ! source volumique de 7Be
36
37	! Local Variables
38
39	!!! INTEGER :: iref ! numero d'un point oceanique donnant la grille de pression de reference
40	REAL,DIMENSION(klon) :: rlatgeo ! latitudes geomagnetiques de la grille
41	REAL :: glt ! latitude du pole geomagnetique
42	REAL :: glg ! longitude du pole geomagnetique
43	REAL :: latgeo,qcos
44	INTEGER :: k,i, kref, k2
45	INTEGER :: nref
46	PARAMETER (nref=39)
47	REAL,DIMENSION(nref), SAVE :: pref ! grille de pression de reference (bas des couches)
48	DATA pref / &
49	101249.99999999994, 100387.17261011522, 99447.35334189111, 98357.43412194174, &
50	97046.47707771382, 95447.1116450629, 93496.85259615642, 91139.46548240296, &
51	88326.55568744117, 85019.60710580258, 81192.7404556645, 76836.48366938648, &
52	71962.81275769137, 66611.56331321516, 60857.914829743604, 54819.84484441629, &
53	48663.06257114699, 42598.95465845692, 36869.104365898806, 31709.927925633147, &
54	27296.757208636915, 23682.282929080895, 20766.025578936627, 18336.105961406534, &
55	16178.04816768436, 14168.286905562818, 12275.719926478887, 10507.798835225762, &
56	8876.585404909414, 7391.283929569539, 6057.514475749798, 4877.165909157005, &
57	3848.34936408203, 2965.444753540027, 2219.2391544640013, 1597.15366044666, &
58	1083.5531161631498, 660.1311067852655, 306.36072267002805 /
59	!$OMP THREADPRIVATE(pref)
60
61	WRITE(,)'PASSAGE init_be ...'
62
63	! la source est maintenant définie independemment de la valeur de klev.
64	!!! Source actuellement definie pour klev = 19 et klev >= 39
65	!! IF (klev /= 19 .AND. klev<39) CALL abort_physic("init_be","Source du be7 necessite klev=19 ou klev>=39",1)
66	!!!
67	! Definition des constantes
68	! -------------------------
69	tautr = 6645000.
70	vdeptr = 1.E-3
71	scavtr = 0.5
72	!!!!!jyg le 13/03/2013; puis 20/03/2013 : pref est maintenant une table.
73	!!!
74	!!! Recherche d'un point rlat=0., rlon=180.
75	!! iref=(klon+1)/2
76	!! DO i = 1,klon
77	!! IF (abs(rlatd(i)) .LT. 0.15 .AND. cos(rlond(i)) .LT. -0.85) iref=i
78	!! ENDDO
79	!!!
80	!!! Grille de pression de reference (= approx de sommets de couches)
81	!! pref(1) = pplay(iref,1)+0.5*(pplay(iref,1)-pplay(iref,2))
82	!! DO k = 2,klev
83	!! pref(k) = 0.5*(pplay(iref,k-1)+pplay(iref,k))
84	!! ENDDO
85	!!!
86
87	WRITE(,) '-------------- SOURCE DE BERYLLIUM ------------------- '
88	WRITE(,)'Decroissance (s): ', tautr
89	WRITE(,)'Vitesse de depot sec: ',vdeptr
90	WRITE(,)'Facteur de lessivage: ',scavtr
91
92	DO i = 1,klon
93	masktr(i) = 0.
94	IF ( NINT(pctsrf(i,1)) == 1 ) masktr(i) = 1.
95	END DO
96
97	! Premiers niveaux: source nulle
98	! ------------------------------
99	DO k = 1,6
100	DO i = 1,klon
101	srcbe(i,k) = 0.
102	END DO
103	END DO
104
105	! Pour les autres niveaux:
106	! 1-passer des coordonnees geographiques a la latitude geomagnetique
107	! 2-prescrire la source de Be (en 10exp5 at/g/s) dans ce repere
108	! 3-mettre la source de Be ds la bonne unite (en at/kgA/s)
109
110	glt = 78.5*rpi/180.
111	glg = -69.0*rpi/180.
112
113	DO i = 1,klon
114	qcos=sin(glt)*sin(latitude(i))
115	!!jyg
116	!! qcos=qcos+cos(glt)cos(latitude(i))cos(longitude(i)+glg)
117	qcos=qcos+cos(glt)cos(latitude(i))cos(longitude(i)-glg)
118	!!jyg end
119	IF ( qcos < -1.) qcos = -1.
120	IF ( qcos > 1.) qcos = 1.
121	rlatgeo(i)=rpi/2.-acos(qcos)
122	ENDDO
123
124	!!!===========================
125	!!! Cas 19 niveaux verticaux
126	!!!===========================
127	!! IF (klev.EQ.19) THEN
128	!! DO k = 1,klev
129	!! DO i = 1,klon
130	!!!!!jyg le 13/03/2013
131	!!!
132	!!! k est le niveau dans la grille locale
133	!!! Determination du niveau kref dans la grille de refernce
134	!! kref = 1
135	!! DO k2 = 1,klev
136	!! IF (pref(k2) .GT. pplay(i,k)) kref=k2
137	!! ENDDO
138	!!!!!
139	!! latgeo=(180./rpi)*abs(rlatgeo(i))
140	!! IF ( kref .EQ. 1 ) THEN
141	!! IF (latgeo.GE.50.0) srcbe(i,k)=0.1
142	!! IF (latgeo.GE.40.0 .AND. latgeo.LT.50.0) srcbe(i,k)=0.09
143	!! IF (latgeo.GE.30.0 .AND. latgeo.LT.40.0) srcbe(i,k)=0.07
144	!! END IF
145	!! IF ( kref .EQ. 2 ) THEN
146	!! IF (latgeo.GE.50.0) srcbe(i,k)=0.12
147	!! IF (latgeo.GE.40.0 .AND. latgeo.LT.50.0) srcbe(i,k)=0.1
148	!! IF (latgeo.GE.30.0 .AND. latgeo.LT.40.0) srcbe(i,k)=0.09
149	!! IF (latgeo.GE.20.0 .AND. latgeo.LT.30.0) srcbe(i,k)=0.07
150	!! END IF
151	!! IF ( kref .EQ. 3 ) THEN
152	!! IF (latgeo.GE.50.0) srcbe(i,k)=0.14
153	!! IF (latgeo.GE.40.0 .AND. latgeo.LT.50.0) srcbe(i,k)=0.12
154	!! IF (latgeo.GE.30.0 .AND. latgeo.LT.40.0) srcbe(i,k)=0.1
155	!! IF (latgeo.GE.20.0 .AND. latgeo.LT.30.0) srcbe(i,k)=0.09
156	!! IF (latgeo.GE.10.0 .AND. latgeo.LT.20.0) srcbe(i,k)=0.07
157	!! END IF
158	!! IF ( kref .EQ. 4 ) THEN
159	!! IF (latgeo.GE.50.0) srcbe(i,k)=0.175
160	!! IF (latgeo.GE.40.0 .AND. latgeo.LT.50.0) srcbe(i,k)=0.16
161	!! IF (latgeo.GE.30.0 .AND. latgeo.LT.40.0) srcbe(i,k)=0.14
162	!! IF (latgeo.GE.20.0 .AND. latgeo.LT.30.0) srcbe(i,k)=0.12
163	!! IF (latgeo.GE.10.0 .AND. latgeo.LT.20.0) srcbe(i,k)=0.1
164	!! IF (latgeo.GE.0.0 .AND. latgeo.LT.10.0) srcbe(i,k)=0.09
165	!! END IF
166	!! IF ( kref .EQ. 5 ) THEN
167	!! IF (latgeo.GE.50.0) srcbe(i,k)=0.28
168	!! IF (latgeo.GE.40.0 .AND. latgeo.LT.50.0) srcbe(i,k)=0.26
169	!! IF (latgeo.GE.30.0 .AND. latgeo.LT.40.0) srcbe(i,k)=0.23
170	!! IF (latgeo.GE.20.0 .AND. latgeo.LT.30.0) srcbe(i,k)=0.175
171	!! IF (latgeo.GE.10.0 .AND. latgeo.LT.20.0) srcbe(i,k)=0.14
172	!! IF (latgeo.GE.0.0 .AND. latgeo.LT.10.0) srcbe(i,k)=0.12
173	!! END IF
174	!! IF ( kref .EQ. 6 ) THEN
175	!! IF (latgeo.GE.50.0) srcbe(i,k)=0.56
176	!! IF (latgeo.GE.40.0 .AND. latgeo.LT.50.0) srcbe(i,k)=0.49
177	!! IF (latgeo.GE.30.0 .AND. latgeo.LT.40.0) srcbe(i,k)=0.42
178	!! IF (latgeo.GE.20.0 .AND. latgeo.LT.30.0) srcbe(i,k)=0.28
179	!! IF (latgeo.GE.10.0 .AND. latgeo.LT.20.0) srcbe(i,k)=0.26
180	!! IF (latgeo.GE.0.0 .AND. latgeo.LT.10.0) srcbe(i,k)=0.245
181	!! END IF
182	!! IF ( kref .EQ. 7 ) THEN
183	!! IF (latgeo.GE.50.0) srcbe(i,k)=1.05
184	!! IF (latgeo.GE.40.0 .AND. latgeo.LT.50.0) srcbe(i,k)=0.875
185	!! IF (latgeo.GE.30.0 .AND. latgeo.LT.40.0) srcbe(i,k)=0.7
186	!! IF (latgeo.GE.20.0 .AND. latgeo.LT.30.0) srcbe(i,k)=0.52
187	!! IF (latgeo.GE.10.0 .AND. latgeo.LT.20.0) srcbe(i,k)=0.44
188	!! IF (latgeo.GE.0.0 .AND. latgeo.LT.10.0) srcbe(i,k)=0.385
189	!! END IF
190	!! IF ( kref .EQ. 8 ) THEN
191	!! IF (latgeo.GE.50.0) srcbe(i,k)=2.
192	!! IF (latgeo.GE.40.0 .AND. latgeo.LT.50.0) srcbe(i,k)=1.8
193	!! IF (latgeo.GE.30.0 .AND. latgeo.LT.40.0) srcbe(i,k)=1.5
194	!! IF (latgeo.GE.20.0 .AND. latgeo.LT.30.0) srcbe(i,k)=1.
195	!! IF (latgeo.GE.10.0 .AND. latgeo.LT.20.0) srcbe(i,k)=0.8
196	!! IF (latgeo.GE.0.0 .AND. latgeo.LT.10.0) srcbe(i,k)=0.75
197	!! END IF
198	!! IF ( kref .EQ. 9 ) THEN
199	!! IF (latgeo.GE.50.0) srcbe(i,k)=4.
200	!! IF (latgeo.GE.40.0 .AND. latgeo.LT.50.0) srcbe(i,k)=3.5
201	!! IF (latgeo.GE.30.0 .AND. latgeo.LT.40.0) srcbe(i,k)=3.
202	!! IF (latgeo.GE.20.0 .AND. latgeo.LT.30.0) srcbe(i,k)=2.5
203	!! IF (latgeo.GE.10.0 .AND. latgeo.LT.20.0) srcbe(i,k)=1.8
204	!! IF (latgeo.GE.0.0 .AND. latgeo.LT.10.0) srcbe(i,k)=1.4
205	!! END IF
206	!! IF ( kref .EQ. 10 ) THEN
207	!! IF (latgeo.GE.50.0) srcbe(i,k)=8.5
208	!! IF (latgeo.GE.40.0 .AND. latgeo.LT.50.0) srcbe(i,k)=8.
209	!! IF (latgeo.GE.30.0 .AND. latgeo.LT.40.0) srcbe(i,k)=7.
210	!! IF (latgeo.GE.20.0 .AND. latgeo.LT.30.0) srcbe(i,k)=4.5
211	!! IF (latgeo.GE.10.0 .AND. latgeo.LT.20.0) srcbe(i,k)=3.5
212	!! IF (latgeo.GE.0.0 .AND. latgeo.LT.10.0) srcbe(i,k)=3.
213	!! END IF
214	!! IF ( kref .EQ. 11 ) THEN
215	!! IF (latgeo.GE.50.0) srcbe(i,k)=17.
216	!! IF (latgeo.GE.40.0 .AND. latgeo.LT.50.0) srcbe(i,k)=15.
217	!! IF (latgeo.GE.30.0 .AND. latgeo.LT.40.0) srcbe(i,k)=11.
218	!! IF (latgeo.GE.20.0 .AND. latgeo.LT.30.0) srcbe(i,k)=8.
219	!! IF (latgeo.GE.10.0 .AND. latgeo.LT.20.0) srcbe(i,k)=5.
220	!! IF (latgeo.GE.0.0 .AND. latgeo.LT.10.0) srcbe(i,k)=4.
221	!! END IF
222	!! IF ( kref .EQ. 12 ) THEN
223	!! IF (latgeo.GE.50.0) srcbe(i,k)=25.
224	!! IF (latgeo.GE.40.0 .AND. latgeo.LT.50.0) srcbe(i,k)=22.
225	!! IF (latgeo.GE.30.0 .AND. latgeo.LT.40.0) srcbe(i,k)=17.
226	!! IF (latgeo.GE.20.0 .AND. latgeo.LT.30.0) srcbe(i,k)=11.
227	!! IF (latgeo.GE.10.0 .AND. latgeo.LT.20.0) srcbe(i,k)=7.5
228	!! IF (latgeo.GE.0.0 .AND. latgeo.LT.10.0) srcbe(i,k)=7.
229	!! END IF
230	!! IF ( kref .EQ. 13 ) THEN
231	!! IF (latgeo.GE.60.0) srcbe(i,k)=33.
232	!! IF (latgeo.GE.50.0 .AND. latgeo.LT.60.0) srcbe(i,k)=32.
233	!! IF (latgeo.GE.40.0 .AND. latgeo.LT.50.0) srcbe(i,k)=30.
234	!! IF (latgeo.GE.30.0 .AND. latgeo.LT.40.0) srcbe(i,k)=22.
235	!! IF (latgeo.GE.20.0 .AND. latgeo.LT.30.0) srcbe(i,k)=15.
236	!! IF (latgeo.GE.10.0 .AND. latgeo.LT.20.0) srcbe(i,k)=11.
237	!! IF (latgeo.GE.0.0 .AND. latgeo.LT.10.0) srcbe(i,k)=8.
238	!! END IF
239	!! IF ( kref .EQ. 14 ) THEN
240	!! IF (latgeo.GE.60.0) srcbe(i,k)=48.
241	!! IF (latgeo.GE.50.0 .AND. latgeo.LT.60.0) srcbe(i,k)=45.
242	!! IF (latgeo.GE.40.0 .AND. latgeo.LT.50.0) srcbe(i,k)=36.
243	!! IF (latgeo.GE.30.0 .AND. latgeo.LT.40.0) srcbe(i,k)=26.
244	!! IF (latgeo.GE.20.0 .AND. latgeo.LT.30.0) srcbe(i,k)=17.5
245	!! IF (latgeo.GE.10.0 .AND. latgeo.LT.20.0) srcbe(i,k)=12.5
246	!! IF (latgeo.GE.0.0 .AND. latgeo.LT.10.0) srcbe(i,k)=10.
247	!! END IF
248	!! IF ( kref .EQ. 15 ) THEN
249	!! IF (latgeo.GE.70.0) srcbe(i,k)=58.
250	!! IF (latgeo.GE.60.0 .AND. latgeo.LT.70.0) srcbe(i,k)=57.
251	!! IF (latgeo.GE.50.0 .AND. latgeo.LT.60.0) srcbe(i,k)=50.
252	!! IF (latgeo.GE.40.0 .AND. latgeo.LT.50.0) srcbe(i,k)=38.
253	!! IF (latgeo.GE.30.0 .AND. latgeo.LT.40.0) srcbe(i,k)=25.
254	!! IF (latgeo.GE.20.0 .AND. latgeo.LT.30.0) srcbe(i,k)=15.
255	!! IF (latgeo.GE.10.0 .AND. latgeo.LT.20.0) srcbe(i,k)=12.5
256	!! IF (latgeo.GE.0.0 .AND. latgeo.LT.10.0) srcbe(i,k)=10.
257	!! END IF
258	!! IF ( kref .EQ. 16 ) THEN
259	!! IF (latgeo.GE.70.0) srcbe(i,k)=70.
260	!! IF (latgeo.GE.60.0 .AND. latgeo.LT.70.0) srcbe(i,k)=65.
261	!! IF (latgeo.GE.50.0 .AND. latgeo.LT.60.0) srcbe(i,k)=50.
262	!! IF (latgeo.GE.40.0 .AND. latgeo.LT.50.0) srcbe(i,k)=32.
263	!! IF (latgeo.GE.30.0 .AND. latgeo.LT.40.0) srcbe(i,k)=20.
264	!! IF (latgeo.GE.20.0 .AND. latgeo.LT.30.0) srcbe(i,k)=13.
265	!! IF (latgeo.GE.10.0 .AND. latgeo.LT.20.0) srcbe(i,k)=9.
266	!! IF (latgeo.GE.0.0 .AND. latgeo.LT.10.0) srcbe(i,k)=7.5
267	!! END IF
268	!! IF ( kref .GE. 17 ) THEN
269	!! IF (latgeo.GE.70.0) srcbe(i,k)=80.
270	!! IF (latgeo.GE.60.0 .AND. latgeo.LT.70.0) srcbe(i,k)=70.
271	!! IF (latgeo.GE.50.0 .AND. latgeo.LT.60.0) srcbe(i,k)=45.
272	!! IF (latgeo.GE.40.0 .AND. latgeo.LT.50.0) srcbe(i,k)=27.
273	!! IF (latgeo.GE.30.0 .AND. latgeo.LT.40.0) srcbe(i,k)=17.5
274	!! IF (latgeo.GE.20.0 .AND. latgeo.LT.30.0) srcbe(i,k)=12.
275	!! IF (latgeo.GE.10.0 .AND. latgeo.LT.20.0) srcbe(i,k)=8.
276	!! IF (latgeo.GE.0.0 .AND. latgeo.LT.10.0) srcbe(i,k)=7.
277	!! END IF
278	!! END DO
279	!! END DO
280	!! END IF ! fin de 19 niveaux verticaux
281	!!
282	!!!!!! IF (klev .ge. 39) THEN
283	DO k = 1,klev
284	DO i = 1,klon
285	!!!jyg le 13/03/2013
286
287	! k est le niveau dans la grille locale
288	! Determination du niveau kref dans la grille de refernce
289	kref = 1
290	DO k2 = 1,nref
291	IF (pref(k2) > pplay(i,k)) kref=k2
292	ENDDO
293	!!!
294	latgeo=(180./rpi)*abs(rlatgeo(i))
295	IF ( kref <= 4 ) THEN
296	IF (latgeo>=50.0) srcbe(i,k)=0.07
297	END IF
298	IF ( kref == 5 ) THEN
299	IF (latgeo>=50.0) srcbe(i,k)=0.1
300	IF (latgeo>=20.0 .AND. latgeo<50.0) srcbe(i,k)=0.09
301	IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=0.07
302	END IF
303	IF ( kref == 6 ) THEN
304	IF (latgeo>=50.0) srcbe(i,k)=0.14
305	IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=0.12
306	IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=0.1
307	IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=0.09
308	IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=0.07
309	END IF
310	IF ( kref == 7 ) THEN
311	IF (latgeo>=50.0) srcbe(i,k)=0.16
312	IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=0.16
313	IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=0.14
314	IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=0.12
315	IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=0.1
316	IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=0.09
317	END IF
318	IF ( kref == 8 ) THEN
319	IF (latgeo>=50.0) srcbe(i,k)=0.175
320	IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=0.16
321	IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=0.14
322	IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=0.12
323	IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=0.1
324	IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=0.1
325	END IF
326	IF ( kref == 9 ) THEN
327	IF (latgeo>=50.0) srcbe(i,k)=0.245
328	IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=0.21
329	IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=0.175
330	IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=0.14
331	IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=0.12
332	IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=0.12
333	END IF
334	IF ( kref == 10 ) THEN
335	IF (latgeo>=50.0) srcbe(i,k)=0.31
336	IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=0.28
337	IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=0.245
338	IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=0.21
339	IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=0.16
340	IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=0.14
341	END IF
342	IF ( kref == 11 ) THEN
343	IF (latgeo>=50.0) srcbe(i,k)=0.35
344	IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=0.3
345	IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=0.3
346	IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=0.2
347	IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=0.18
348	IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=0.16
349	END IF
350	IF ( kref == 12 ) THEN
351	IF (latgeo>=40.0) srcbe(i,k)=0.5
352	IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=0.4
353	IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=0.35
354	IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=0.3
355	IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=0.25
356	END IF
357	IF ( kref == 13 ) THEN
358	IF (latgeo>=50.0) srcbe(i,k)=0.8
359	IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=0.7
360	IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=0.6
361	IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=0.5
362	IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=0.4
363	IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=0.35
364	END IF
365	IF ( kref == 14 ) THEN
366	IF (latgeo>=50.0) srcbe(i,k)=1.2
367	IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=1.
368	IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=0.75
369	IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=0.6
370	IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=0.5
371	IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=0.4
372	END IF
373	IF ( kref == 15 ) THEN
374	IF (latgeo>=60.0) srcbe(i,k)=1.75
375	IF (latgeo>=50.0 .AND. latgeo<60.0) srcbe(i,k)=1.8
376	IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=1.6
377	IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=1.4
378	IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=0.9
379	IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=0.75
380	IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=0.65
381	END IF
382	IF ( kref == 16 ) THEN
383	IF (latgeo>=50.0) srcbe(i,k)=3.
384	IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=2.5
385	IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=1.8
386	IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=1.5
387	IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=1.2
388	IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=0.9
389	END IF
390	IF ( kref == 17 ) THEN
391	IF (latgeo>=50.0) srcbe(i,k)=4.
392	IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=3.
393	IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=2.5
394	IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=2.
395	IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=1.6
396	IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=1.4
397	END IF
398	IF ( kref == 18 ) THEN
399	IF (latgeo>=50.0) srcbe(i,k)=7.
400	IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=6.
401	IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=4.5
402	IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=3.5
403	IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=3.
404	IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=2.
405	END IF
406	IF ( kref == 19 ) THEN
407	IF (latgeo>=50.0) srcbe(i,k)=8.5
408	IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=8.
409	IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=7.
410	IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=4.
411	IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=3.5
412	IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=3.
413	END IF
414	IF ( kref == 20 ) THEN
415	IF (latgeo>=50.0) srcbe(i,k)=12.5
416	IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=12.
417	IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=8.
418	IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=6.
419	IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=4.
420	IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=3.5
421	END IF
422	IF ( kref == 21 ) THEN
423	IF (latgeo>=50.0) srcbe(i,k)=16.
424	IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=13.
425	IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=10.
426	IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=7.5
427	IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=4.5
428	IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=4.
429	END IF
430	IF ( kref == 22 ) THEN
431	IF (latgeo>=50.0) srcbe(i,k)=20.
432	IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=17.5
433	IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=12.5
434	IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=9.
435	IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=6.
436	IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=4.5
437	END IF
438	IF ( kref == 23 ) THEN
439	IF (latgeo>=50.0) srcbe(i,k)=25.
440	IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=22.
441	IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=15.
442	IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=10.
443	IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=7.5
444	IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=6.
445	END IF
446	IF ( kref == 24 ) THEN
447	IF (latgeo>=50.0) srcbe(i,k)=28.
448	IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=26.
449	IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=18.
450	IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=12.
451	IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=8.5
452	IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=7.
453	END IF
454	IF ( kref == 25 ) THEN
455	IF (latgeo>=50.0) srcbe(i,k)=33.
456	IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=28.
457	IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=20.
458	IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=14.
459	IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=10.
460	IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=8.5
461	END IF
462	IF ( kref == 26 ) THEN
463	IF (latgeo>=60.0) srcbe(i,k)=38.
464	IF (latgeo>=50.0 .AND. latgeo<60.0) srcbe(i,k)=36.
465	IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=32.
466	IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=24.
467	IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=15.
468	IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=11.5
469	IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=10.
470	!!jyg
471	!! IF (latgeo.GE.0.0 .AND. latgeo.LT.10.0) srcbe(i,k)=6.
472	!!jyg end
473	END IF
474	IF ( kref == 27 ) THEN
475	IF (latgeo>=60.0) srcbe(i,k)=46.
476	IF (latgeo>=50.0 .AND. latgeo<60.0) srcbe(i,k)=44.
477	IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=35.
478	IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=25.
479	IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=16.
480	IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=12.5
481	IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=10.
482	END IF
483	IF ( kref == 28 ) THEN
484	IF (latgeo>=60.0) srcbe(i,k)=53.
485	IF (latgeo>=50.0 .AND. latgeo<60.0) srcbe(i,k)=48.
486	IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=37.
487	IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=25.
488	IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=16.
489	IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=12.5
490	IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=10.
491	END IF
492	IF ( kref == 29 ) THEN
493	IF (latgeo>=70.0) srcbe(i,k)=58.
494	IF (latgeo>=60.0 .AND. latgeo<70.0) srcbe(i,k)=56.
495	IF (latgeo>=50.0 .AND. latgeo<60.0) srcbe(i,k)=50.
496	IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=36.
497	IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=24.
498	IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=15.
499	IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=11.5
500	IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=10.
501	END IF
502	IF ( kref == 30 ) THEN
503	IF (latgeo>=70.0) srcbe(i,k)=65.
504	IF (latgeo>=60.0 .AND. latgeo<70.0) srcbe(i,k)=60.
505	IF (latgeo>=50.0 .AND. latgeo<60.0) srcbe(i,k)=50.
506	IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=35.
507	IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=22.
508	IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=14.
509	IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=10.
510	IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=9.
511	END IF
512	IF ( kref == 31 ) THEN
513	IF (latgeo>=70.0) srcbe(i,k)=70.
514	IF (latgeo>=60.0 .AND. latgeo<70.0) srcbe(i,k)=62.
515	IF (latgeo>=50.0 .AND. latgeo<60.0) srcbe(i,k)=48.
516	IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=32.
517	IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=21.
518	IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=13.
519	IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=9.
520	IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=7.6
521	END IF
522	IF ( kref == 32 ) THEN
523	IF (latgeo>=70.0) srcbe(i,k)=80.
524	IF (latgeo>=60.0 .AND. latgeo<70.0) srcbe(i,k)=60.
525	IF (latgeo>=50.0 .AND. latgeo<60.0) srcbe(i,k)=46.
526	IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=30.
527	IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=17.5
528	IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=11.
529	IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=8.
530	IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=7.4
531	END IF
532	IF ( kref >= 33 ) THEN
533	IF (latgeo>=70.0) srcbe(i,k)=80.
534	IF (latgeo>=60.0 .AND. latgeo<70.0) srcbe(i,k)=70.
535	IF (latgeo>=50.0 .AND. latgeo<60.0) srcbe(i,k)=45.
536	IF (latgeo>=40.0 .AND. latgeo<50.0) srcbe(i,k)=27.
537	IF (latgeo>=30.0 .AND. latgeo<40.0) srcbe(i,k)=15.
538	IF (latgeo>=20.0 .AND. latgeo<30.0) srcbe(i,k)=10.
539	IF (latgeo>=10.0 .AND. latgeo<20.0) srcbe(i,k)=7.6
540	IF (latgeo>=0.0 .AND. latgeo<10.0) srcbe(i,k)=7.
541	END IF
542	END DO
543	END DO
544	!!!!!! END IF ! fin de 39 niveaux verticaux
545
546
547	!====================================
548	! Conversion de la source en U/s/kgA
549	!====================================
550	DO k = 1,klev
551	DO i = 1,klon
552	! La source est at/min/m3 -> at/s/kgA
553	! avec une masse volumique de l'air = 1.295 kg/m3
554	! 1/(60*1.295) = 0.01287
555	srcbe(i,k)=srcbe(i,k)*0.01287
556	!! print *,' k, srcbe(i,k) ', &
557	!! k, srcbe(i,k)
558	! La source est at/min/m3 -> at/s/m3
559	! srcbe(i,k)=srcbe(i,k)*0.0166667
560	END DO
561	END DO
562
563	END SUBROUTINE init_be

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

Download in other formats:

Original Format