Context Navigation

init_be.F90 @ 5133

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

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

Download in other formats:

Original Format