Context Navigation

init_be.F90 @ 5451

Last change on this file since 5451 was 4056, checked in by dcugnet, 3 years ago

Most of the changes are intended to help to eventually remove the constraints about the tracers assumptions, in particular water tracers.

Remove index tables itr_indice and niadv, replaced by tracers(:)%isAdvected and tracers(:)%isH2OFamily. Most of the loops are now from 1 to nqtot:
- DO iq=nqo+1,nqtot loops are replaced with: DO iq=1,nqtot

IF(tracers(iq)%isH2Ofamily) CYCLE

DO it=1,nbtr; iq=niadv(it+nqo)

and DO it=1,nqtottr; iq=itr_indice(it) loops are replaced with:

it = 0
DO iq = 1, nqtot

IF(.NOT.tracers(iq)%isAdvected .OR. tracers(iq)%isH2Ofamily) CYCLE
it = it+1

Move some StratAer? related code from infotrac to infotrac_phy
Remove "nqperes" variable:

DO iq=1,nqpere loops are replaced with:
DO iq=1,nqtot

IF(tracers(iq)%parent/='air') CYCLE

Cosmetic changes (justification, SELECT CASE instead of multiple IF...) mostly in advtrac* routines.

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

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

Download in other formats:

Original Format