source: dynamico_lmdz/aquaplanet/LMDZ5/libf/phylmd/init_be.F90 @ 3825

Last change on this file since 3825 was 3825, checked in by ymipsl, 10 years ago

Reorganize geometry and grid modules. Prepare physics for unstructutured grid support. Simplify initialization of physics from dynamic.
Compiled only with dynd3dmem, but not tested for moment.

YM

File size: 27.6 KB
Line 
1!$Id $
2
3SUBROUTINE 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 infotrac_phy, ONLY : nbtr
8  USE indice_sol_mod
9  USE geometry_mod, ONLY : longitude, latitude
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(latitude(i))
117!!jyg
118!!     qcos=qcos+cos(glt)*cos(rlatd(i))*cos(rlond(i)+glg)
119     qcos=qcos+cos(glt)*cos(latitude(i))*cos(longitude(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
565END SUBROUTINE init_be
Note: See TracBrowser for help on using the repository browser.