source: LMDZ6/branches/Amaury_dev/libf/phylmd/init_be.F90 @ 5497

Last change on this file since 5497 was 5160, checked in by abarral, 6 months ago

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