Context Navigation

init_be.f90 @ 5327

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

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

Download in other formats:

Original Format