Context Navigation

init_be.f90 @ 5428

Last change on this file since 5428 was 5289, checked in by abarral, 2 months ago
Turn YOECUMF.h into a module Fix USE in fxy_new_mod_h.f90
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory
File size: 27.6 KB

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

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

Download in other formats:

Original Format