Context Navigation

init_be.F90 @ 2347

Last change on this file since 2347 was 2320, checked in by Ehouarn Millour, 9 years ago
Physics/dynamics separation: make an infotrac_phy module, which should be used from within the physics, and is initialized from infotrac (dynamics) via iniphysiq. EM
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: 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_phy, 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_physic("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