Context Navigation

init_be.F90 @ 2005

Last change on this file since 2005 was 1907, checked in by lguez, 11 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
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

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.

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

Rev	Line
[1191]	1	!$Id $
	2
[1742]	3	SUBROUTINE init_be(pctsrf,pplay,masktr,tautr,vdeptr,scavtr,srcbe)
	4	!!!SUBROUTINE init_be(pctsrf,masktr,tautr,vdeptr,scavtr,srcbe)
[1191]	5
	6	USE dimphy
	7	USE comgeomphy
	8	USE infotrac, ONLY : nbtr
[1785]	9	USE indice_sol_mod
[1191]	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))
[1742]	29	REAL,DIMENSION(klon,klev), INTENT(IN) :: pplay ! Pressions en milieu de couches
[1191]	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	!
[1742]	41	!!! INTEGER :: iref ! numero d'un point oceanique donnant la grille de pression de reference
[1191]	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
[1742]	46	INTEGER :: k,i, kref, k2
	47	INTEGER :: nref
	48	PARAMETER (nref=39)
[1760]	49	REAL,DIMENSION(nref), SAVE :: pref ! grille de pression de reference (bas des couches)
[1742]	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)
[1191]	62
	63	WRITE(,)'PASSAGE init_be ...'
	64
[1742]	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_gcm("init_be","Source du be7 necessite klev=19 ou klev>=39",1)
	68	!!!
[1191]	69	! Definition des constantes
	70	! -------------------------
	71	tautr = 6645000.
	72	vdeptr = 1.E-3
	73	scavtr = 0.5
[1742]	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	!!!
[1191]	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	!
[1742]	112	glt = 78.5*rpi/180.
	113	glg = -69.0*rpi/180.
[1191]	114
	115	DO i = 1,klon
	116	qcos=sin(glt)*sin(rlatd(i))
[1742]	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
[1191]	121	IF ( qcos .LT. -1.) qcos = -1.
	122	IF ( qcos .GT. 1.) qcos = 1.
	123	rlatgeo(i)=rpi/2.-acos(qcos)
	124	ENDDO
	125
[1742]	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
[1191]	285	DO k = 1,klev
	286	DO i = 1,klon
[1742]	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	!!!
[1191]	296	latgeo=(180./rpi)*abs(rlatgeo(i))
[1742]	297	IF ( kref .LE. 4 ) THEN
[1191]	298	IF (latgeo.GE.50.0) srcbe(i,k)=0.07
	299	END IF
[1742]	300	IF ( kref .EQ. 5 ) THEN
[1191]	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
[1742]	305	IF ( kref .EQ. 6 ) THEN
[1191]	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
[1742]	312	IF ( kref .EQ. 7 ) THEN
[1191]	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
[1742]	320	IF ( kref .EQ. 8 ) THEN
[1191]	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
[1742]	328	IF ( kref .EQ. 9 ) THEN
[1191]	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
[1742]	336	IF ( kref .EQ. 10 ) THEN
[1191]	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
[1742]	344	IF ( kref .EQ. 11 ) THEN
[1191]	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
[1742]	352	IF ( kref .EQ. 12 ) THEN
[1191]	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
[1742]	359	IF ( kref .EQ. 13 ) THEN
[1191]	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
[1742]	367	IF ( kref .EQ. 14 ) THEN
[1191]	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
[1742]	375	IF ( kref .EQ. 15 ) THEN
[1191]	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
[1742]	384	IF ( kref .EQ. 16 ) THEN
[1191]	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
[1742]	392	IF ( kref .EQ. 17 ) THEN
[1191]	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
[1742]	400	IF ( kref .EQ. 18 ) THEN
[1191]	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
[1742]	408	IF ( kref .EQ. 19 ) THEN
[1191]	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
[1742]	416	IF ( kref .EQ. 20 ) THEN
[1191]	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
[1742]	424	IF ( kref .EQ. 21 ) THEN
[1191]	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
[1742]	432	IF ( kref .EQ. 22 ) THEN
[1191]	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
[1742]	440	IF ( kref .EQ. 23 ) THEN
[1191]	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
[1742]	448	IF ( kref .EQ. 24 ) THEN
[1191]	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
[1742]	456	IF ( kref .EQ. 25 ) THEN
[1191]	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
[1742]	464	IF ( kref .EQ. 26 ) THEN
[1191]	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.
[1742]	472	!!jyg
	473	!! IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=6.
	474	!!jyg end
[1191]	475	END IF
[1742]	476	IF ( kref .EQ. 27 ) THEN
[1191]	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
[1742]	485	IF ( kref .EQ. 28 ) THEN
[1191]	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
[1742]	494	IF ( kref .EQ. 29 ) THEN
[1191]	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
[1742]	504	IF ( kref .EQ. 30 ) THEN
[1191]	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
[1742]	514	IF ( kref .EQ. 31 ) THEN
[1191]	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
[1742]	524	IF ( kref .EQ. 32 ) THEN
[1191]	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
[1742]	534	IF ( kref .GE. 33 ) THEN
[1191]	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
[1742]	546	!!!!!! END IF ! fin de 39 niveaux verticaux
[1191]	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
[1742]	558	!! print *,' k, srcbe(i,k) ', &
	559	!! k, srcbe(i,k)
[1191]	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
	565	END SUBROUTINE init_be

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format