source: LMDZ6/branches/contrails/libf/phylmd/init_be.f90 @ 5449

Last change on this file since 5449 was 5289, checked in by abarral, 8 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
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 indice_sol_mod
8  USE geometry_mod, ONLY : longitude, latitude
9  USE yomcst_mod_h
10  USE yoecumf_mod_h
11IMPLICIT 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
561END SUBROUTINE init_be
Note: See TracBrowser for help on using the repository browser.