Context Navigation

init_be.F90 @ 1893

Last change on this file since 1893 was 1795, checked in by Ehouarn Millour, 11 years ago

Version testing basee sur la r1794

Testing release based on r1794

File size: 27.6 KB

Rev	Line
[1191]	1	!$Id $
	2
[1750]	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
[1795]	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))
[1750]	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	!
[1750]	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
[1750]	46	INTEGER :: k,i, kref, k2
	47	INTEGER :: nref
	48	PARAMETER (nref=39)
[1795]	49	REAL,DIMENSION(nref), SAVE :: pref ! grille de pression de reference (bas des couches)
[1750]	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
[1750]	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
[1750]	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	!
[1750]	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))
[1750]	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
[1750]	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
[1750]	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))
[1750]	297	IF ( kref .LE. 4 ) THEN
[1191]	298	IF (latgeo.GE.50.0) srcbe(i,k)=0.07
	299	END IF
[1750]	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
[1750]	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
[1750]	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
[1750]	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
[1750]	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
[1750]	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
[1750]	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
[1750]	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
[1750]	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
[1750]	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
[1750]	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
[1750]	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
[1750]	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
[1750]	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
[1750]	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
[1750]	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
[1750]	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
[1750]	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
[1750]	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
[1750]	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
[1750]	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
[1750]	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.
[1750]	472	!!jyg
	473	!! IF (latgeo.GE.0.0 .and. latgeo.LT.10.0) srcbe(i,k)=6.
	474	!!jyg end
[1191]	475	END IF
[1750]	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
[1750]	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
[1750]	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
[1750]	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
[1750]	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
[1750]	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
[1750]	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
[1750]	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
[1750]	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