Context Navigation

init_be.F90 @ 1795

Last change on this file since 1795 was 1795, checked in by Ehouarn Millour, 11 years ago

Version testing basee sur la r1794

Testing release based on r1794

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

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

Download in other formats:

Original Format