source: LMDZ6/branches/Ocean_skin/libf/phylmd/init_be.F90 @ 5453

Last change on this file since 5453 was 4368, checked in by lguez, 2 years ago

Sync latest trunk changes to Ocean_skin

  • 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
RevLine 
[1191]1!$Id $
2
[1742]3SUBROUTINE init_be(pctsrf,pplay,masktr,tautr,vdeptr,scavtr,srcbe)
4!!!SUBROUTINE init_be(pctsrf,masktr,tautr,vdeptr,scavtr,srcbe)
[1191]5
6  USE dimphy
[1785]7  USE indice_sol_mod
[2351]8  USE geometry_mod, ONLY : longitude, latitude
[1191]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))
[1742]28  REAL,DIMENSION(klon,klev), INTENT(IN) :: pplay  ! Pressions en milieu de couches
[1191]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!
[1742]40!!!  INTEGER              :: iref      ! numero d'un point oceanique donnant la grille de pression de reference
[1191]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
[1742]45  INTEGER              :: k,i, kref, k2
46  INTEGER              :: nref
47  PARAMETER (nref=39)
[1760]48  REAL,DIMENSION(nref), SAVE :: pref      ! grille de pression de reference (bas des couches)
[1742]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)
[1191]61
62  WRITE(*,*)'PASSAGE init_be ...'
63
[1742]64! la source est maintenant définie independemment de la valeur de klev.
65!!! Source actuellement definie pour klev = 19 et klev >= 39
[2311]66!!  IF (klev /= 19 .AND. klev<39) CALL abort_physic("init_be","Source du be7 necessite klev=19 ou klev>=39",1)
[1742]67!!!
[1191]68! Definition des constantes
69! -------------------------
70  tautr = 6645000.
71  vdeptr = 1.E-3
72  scavtr = 0.5
[1742]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!!!
[1191]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!
[1742]111  glt =  78.5*rpi/180.
112  glg = -69.0*rpi/180.
[1191]113
114  DO i = 1,klon
[2351]115     qcos=sin(glt)*sin(latitude(i))
[1742]116!!jyg
[2351]117!!     qcos=qcos+cos(glt)*cos(latitude(i))*cos(longitude(i)+glg)
118     qcos=qcos+cos(glt)*cos(latitude(i))*cos(longitude(i)-glg)
[1742]119!!jyg end
[1191]120     IF ( qcos .LT. -1.) qcos = -1.
121     IF ( qcos .GT. 1.)  qcos = 1.
122     rlatgeo(i)=rpi/2.-acos(qcos)
123  ENDDO
124
[1742]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
[1191]284     DO k = 1,klev
285        DO i = 1,klon
[1742]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!!!
[1191]295           latgeo=(180./rpi)*abs(rlatgeo(i))
[1742]296           IF ( kref .LE. 4 ) THEN
[1191]297              IF (latgeo.GE.50.0) srcbe(i,k)=0.07
298           END IF
[1742]299           IF ( kref .EQ. 5 ) THEN
[1191]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
[1742]304           IF ( kref .EQ. 6 ) THEN
[1191]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
[1742]311           IF ( kref .EQ. 7 ) THEN
[1191]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
[1742]319           IF ( kref .EQ. 8 ) THEN
[1191]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
[1742]327           IF ( kref .EQ. 9 ) THEN
[1191]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
[1742]335           IF ( kref .EQ. 10 ) THEN
[1191]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
[1742]343           IF ( kref .EQ. 11 ) THEN
[1191]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
[1742]351           IF ( kref .EQ. 12 ) THEN
[1191]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
[1742]358           IF ( kref .EQ. 13 ) THEN
[1191]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
[1742]366           IF ( kref .EQ. 14 ) THEN
[1191]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
[1742]374           IF ( kref .EQ. 15 ) THEN
[1191]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
[1742]383           IF ( kref .EQ. 16 ) THEN
[1191]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
[1742]391           IF ( kref .EQ. 17 ) THEN
[1191]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
[1742]399           IF ( kref .EQ. 18 ) THEN
[1191]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
[1742]407           IF ( kref .EQ. 19 ) THEN
[1191]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
[1742]415           IF ( kref .EQ. 20 ) THEN
[1191]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
[1742]423           IF ( kref .EQ. 21 ) THEN
[1191]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
[1742]431           IF ( kref .EQ. 22 ) THEN
[1191]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
[1742]439           IF ( kref .EQ. 23 ) THEN
[1191]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
[1742]447           IF ( kref .EQ. 24 ) THEN
[1191]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
[1742]455           IF ( kref .EQ. 25 ) THEN
[1191]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
[1742]463           IF ( kref .EQ. 26 ) THEN
[1191]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.
[1742]471!!jyg
472!!              IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=6.
473!!jyg end
[1191]474           END IF
[1742]475           IF ( kref .EQ. 27 ) THEN
[1191]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
[1742]484           IF ( kref .EQ. 28 ) THEN
[1191]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
[1742]493           IF ( kref .EQ. 29 ) THEN
[1191]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
[1742]503           IF ( kref .EQ. 30 ) THEN
[1191]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
[1742]513           IF ( kref .EQ. 31 ) THEN
[1191]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
[1742]523           IF ( kref .EQ. 32 ) THEN
[1191]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
[1742]533           IF ( kref .GE. 33 ) THEN
[1191]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
[1742]545!!!!!!  END IF ! fin de 39 niveaux verticaux
[1191]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
[1742]557!!       print *,'  k, srcbe(i,k) ',   &
558!!                  k, srcbe(i,k)
[1191]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
564END SUBROUTINE init_be
Note: See TracBrowser for help on using the repository browser.