Context Navigation

init_be.F90 @ 4525

Last change on this file since 4525 was 4056, checked in by dcugnet, 3 years ago

Most of the changes are intended to help to eventually remove the constraints about the tracers assumptions, in particular water tracers.

Remove index tables itr_indice and niadv, replaced by tracers(:)%isAdvected and tracers(:)%isH2OFamily. Most of the loops are now from 1 to nqtot:
- DO iq=nqo+1,nqtot loops are replaced with: DO iq=1,nqtot

IF(tracers(iq)%isH2Ofamily) CYCLE

DO it=1,nbtr; iq=niadv(it+nqo)

and DO it=1,nqtottr; iq=itr_indice(it) loops are replaced with:

it = 0
DO iq = 1, nqtot

IF(.NOT.tracers(iq)%isAdvected .OR. tracers(iq)%isH2Ofamily) CYCLE
it = it+1

Move some StratAer? related code from infotrac to infotrac_phy
Remove "nqperes" variable:

DO iq=1,nqpere loops are replaced with:
DO iq=1,nqtot

IF(tracers(iq)%parent/='air') CYCLE

Cosmetic changes (justification, SELECT CASE instead of multiple IF...) mostly in advtrac* routines.

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

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

Download in other formats:

Original Format