source: LMDZ5/trunk/libf/phylmd/init_be.F90 @ 2340

Last change on this file since 2340 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
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 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
565END SUBROUTINE init_be
Note: See TracBrowser for help on using the repository browser.