Context Navigation

traclmdz_mod.F90 @ 1530

Last change on this file since 1530 was 1454, checked in by Laurent Fairhead, 14 years ago

Merge of LMDZ5V1.0-dev branch r1453 into LMDZ5 trunk r1434

Fusion entre la version r1453 de la branche de développement LMDZ5V1.0-dev
et le tronc LMDZ5 (r1434)

File size: 20.5 KB

Rev	Line
[1191]	1	!$Id $
	2	!
	3	MODULE traclmdz_mod
	4	!
	5	! In this module all tracers specific to LMDZ are treated. This module is used
	6	! only if running without any other chemestry model as INCA or REPROBUS.
	7	!
[1403]	8	IMPLICIT NONE
	9
[1191]	10	REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: masktr ! Masque reservoir de sol traceur
	11	!$OMP THREADPRIVATE(masktr) ! Masque de l'echange avec la surface (1 = reservoir) ou (possible >= 1 )
	12	REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: fshtr ! Flux surfacique dans le reservoir de sol
	13	!$OMP THREADPRIVATE(fshtr)
	14	REAL,DIMENSION(:),ALLOCATABLE,SAVE :: hsoltr ! Epaisseur equivalente du reservoir de sol
	15	!$OMP THREADPRIVATE(hsoltr)
	16	!
	17	!Radioelements:
	18	!--------------
	19	!
	20	REAL,DIMENSION(:),ALLOCATABLE,SAVE :: tautr ! Constante de decroissance radioactive
	21	!$OMP THREADPRIVATE(tautr)
	22	REAL,DIMENSION(:),ALLOCATABLE,SAVE :: vdeptr ! Vitesse de depot sec dans la couche Brownienne
	23	!$OMP THREADPRIVATE(vdeptr)
	24	REAL,DIMENSION(:),ALLOCATABLE,SAVE :: scavtr ! Coefficient de lessivage
	25	!$OMP THREADPRIVATE(scavtr)
	26	REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: srcbe ! Production du beryllium7 dans l atmosphere (U/s/kgA)
	27	!$OMP THREADPRIVATE(srcbe)
	28
	29	LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: radio ! radio(it) = true => decroisssance radioactive
	30	!$OMP THREADPRIVATE(radio)
	31
	32	REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: trs ! Conc. radon ds le sol
	33	!$OMP THREADPRIVATE(trs)
	34
[1409]	35	INTEGER,SAVE :: id_aga ! Identification number for tracer : Age of stratospheric air
	36	!$OMP THREADPRIVATE(id_aga)
	37	INTEGER,SAVE :: lev_1p5km ! Approximative vertical layer number at 1.5km above surface, used for calculation of the age of air. The result shouldn't be that sensible to the exactness of this value as long as it is in the lower troposphere.
	38	!$OMP THREADPRIVATE(lev_1p5km)
	39
	40	INTEGER,SAVE :: id_rn, id_pb ! Identification number for tracer : radon (Rn222), lead (Pb210)
	41	!$OMP THREADPRIVATE(id_rn, id_pb)
	42
[1191]	43	INTEGER,SAVE :: id_be ! Activation et position du traceur Be7 [ id_be=0 -> desactive ]
	44	!$OMP THREADPRIVATE(id_be)
	45
[1403]	46	INTEGER,SAVE :: id_pcsat, id_pcocsat, id_pcq ! traceurs pseudo-vapeur CL qsat, qsat_oc, q
	47	!$OMP THREADPRIVATE(id_pcsat, id_pcocsat, id_pcq)
[1421]	48	INTEGER,SAVE :: id_pcs0, id_pcos0, id_pcq0 ! traceurs pseudo-vapeur CL qsat, qsat_oc, q
	49	! ! qui ne sont pas transportes par la convection
[1403]	50	!$OMP THREADPRIVATE(id_pcs0, id_pcos0, id_pcq0)
	51
	52	INTEGER, SAVE:: id_o3
[1421]	53	!$OMP THREADPRIVATE(id_o3)
	54	! index of ozone tracer with Cariolle parameterization
	55	! 0 means no ozone tracer
[1403]	56
[1409]	57	LOGICAL,SAVE :: rnpb=.FALSE. ! Presence du couple Rn222, Pb210
[1191]	58	!$OMP THREADPRIVATE(rnpb)
	59
	60
	61	CONTAINS
	62
	63	SUBROUTINE traclmdz_from_restart(trs_in)
	64	! This subroutine initialize the module saved variable trs with values from restart file (startphy.nc).
	65	! This subroutine is called from phyetat0 after the field trs_in has been read.
	66
	67	USE dimphy
	68	USE infotrac
	69
	70	! Input argument
	71	REAL,DIMENSION(klon,nbtr), INTENT(IN) :: trs_in
	72
	73	! Local variables
	74	INTEGER :: ierr
	75
	76	! Allocate restart variables trs
	77	ALLOCATE( trs(klon,nbtr), stat=ierr)
[1212]	78	IF (ierr /= 0) CALL abort_gcm('traclmdz_from_restart', 'pb in allocation 1',1)
[1191]	79
	80	! Initialize trs with values read from restart file
	81	trs(:,:) = trs_in(:,:)
	82
	83	END SUBROUTINE traclmdz_from_restart
	84
	85
[1454]	86	SUBROUTINE traclmdz_init(pctsrf, ftsol, tr_seri, t_seri, pplay, sh, pdtphys, aerosol, lessivage)
[1191]	87	! This subroutine allocates and initialize module variables and control variables.
[1421]	88	! Initialization of the tracers should be done here only for those not found in the restart file.
[1191]	89	USE dimphy
	90	USE infotrac
[1403]	91	USE regr_pr_comb_coefoz_m, ONLY: alloc_coefoz
	92	USE press_coefoz_m, ONLY: press_coefoz
[1227]	93	USE carbon_cycle_mod, ONLY : carbon_cycle_init, carbon_cycle_tr, carbon_cycle_cpl
[1421]	94	USE mod_grid_phy_lmdz
	95	USE mod_phys_lmdz_para
[1191]	96
	97	INCLUDE "indicesol.h"
[1421]	98	INCLUDE "iniprint.h"
[1191]	99	! Input variables
[1227]	100	REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: pctsrf ! Pourcentage de sol f(nature du sol)
	101	REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: ftsol ! Temperature du sol (surf)(Kelvin)
[1403]	102	REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT) :: tr_seri! Concentration Traceur [U/KgA]
	103	REAL,DIMENSION(klon,klev),INTENT(IN) :: t_seri ! Temperature
	104	REAL,DIMENSION(klon,klev),INTENT(IN) :: pplay ! pression pour le mileu de chaque couche (en Pa)
	105	REAL,DIMENSION(klon,klev),INTENT(IN) :: sh ! humidite specifique
[1454]	106	REAL,INTENT(IN) :: pdtphys ! Pas d'integration pour la physique (seconde)
[1227]	107
[1191]	108	! Output variables
	109	LOGICAL,DIMENSION(nbtr), INTENT(OUT) :: aerosol
	110	LOGICAL,INTENT(OUT) :: lessivage
	111
	112	! Local variables
[1403]	113	INTEGER :: ierr, it, iiq, i, k
[1421]	114	REAL, DIMENSION(klon_glo,klev) :: varglo ! variable temporaire sur la grille global
	115	REAL, DIMENSION(klev) :: mintmp, maxtmp
	116	LOGICAL :: zero
	117
[1191]	118	! --------------------------------------------
	119	! Allocation
	120	! --------------------------------------------
	121	ALLOCATE( scavtr(nbtr), stat=ierr)
[1212]	122	IF (ierr /= 0) CALL abort_gcm('traclmdz_init', 'pb in allocation 9',1)
[1191]	123	scavtr(:)=1.
	124
	125	ALLOCATE( radio(nbtr), stat=ierr)
[1212]	126	IF (ierr /= 0) CALL abort_gcm('traclmdz_init', 'pb in allocation 11',1)
[1191]	127	radio(:) = .false. ! Par defaut pas decroissance radioactive
	128
	129	ALLOCATE( masktr(klon,nbtr), stat=ierr)
[1212]	130	IF (ierr /= 0) CALL abort_gcm('traclmdz_init', 'pb in allocation 2',1)
[1191]	131
	132	ALLOCATE( fshtr(klon,nbtr), stat=ierr)
[1212]	133	IF (ierr /= 0) CALL abort_gcm('traclmdz_init', 'pb in allocation 3',1)
[1191]	134
	135	ALLOCATE( hsoltr(nbtr), stat=ierr)
[1212]	136	IF (ierr /= 0) CALL abort_gcm('traclmdz_init', 'pb in allocation 4',1)
[1191]	137
	138	ALLOCATE( tautr(nbtr), stat=ierr)
[1212]	139	IF (ierr /= 0) CALL abort_gcm('traclmdz_init', 'pb in allocation 5',1)
[1191]	140	tautr(:) = 0.
	141
	142	ALLOCATE( vdeptr(nbtr), stat=ierr)
[1212]	143	IF (ierr /= 0) CALL abort_gcm('traclmdz_init', 'pb in allocation 6',1)
[1191]	144	vdeptr(:) = 0.
	145
	146
	147	lessivage = .TRUE.
	148	aerosol(:) = .FALSE. ! Tous les traceurs sont des gaz par defaut
	149
	150	!
[1403]	151	! Recherche des traceurs connus : Be7, O3, CO2,...
[1191]	152	! --------------------------------------------
[1409]	153	id_rn=0; id_pb=0; id_aga=0; id_be=0; id_o3=0
[1421]	154	id_pcsat=0; id_pcocsat=0; id_pcq=0; id_pcs0=0; id_pcos0=0; id_pcq0=0
[1191]	155	DO it=1,nbtr
	156	iiq=niadv(it+2)
[1409]	157	IF ( tname(iiq) == "RN" ) THEN
	158	id_rn=it ! radon
	159	ELSE IF ( tname(iiq) == "PB") THEN
	160	id_pb=it ! plomb
	161	ELSE IF ( tname(iiq) == "Aga" .OR. tname(iiq) == "AGA" ) THEN
	162	! Age of stratospheric air
	163	id_aga=it
	164	radio(id_aga) = .FALSE.
	165	aerosol(id_aga) = .FALSE.
	166	pbl_flg(id_aga) = 0
	167
	168	! Find the first model layer above 1.5km from the surface
	169	IF (klev>=30) THEN
	170	lev_1p5km=6 ! NB! This value is for klev=39
	171	ELSE IF (klev>=10) THEN
	172	lev_1p5km=5 ! NB! This value is for klev=19
	173	ELSE
	174	lev_1p5km=klev/2
	175	END IF
	176	ELSE IF ( tname(iiq) == "BE" .OR. tname(iiq) == "Be" .OR. &
[1191]	177	tname(iiq) == "BE7" .OR. tname(iiq) == "Be7" ) THEN
[1212]	178	! Recherche du Beryllium 7
[1191]	179	id_be=it
	180	ALLOCATE( srcbe(klon,klev) )
	181	radio(id_be) = .TRUE.
	182	aerosol(id_be) = .TRUE. ! le Be est un aerosol
	183	CALL init_be(pctsrf,masktr(:,id_be),tautr(id_be),vdeptr(id_be),scavtr(id_be),srcbe)
[1421]	184	WRITE(lunout,*) 'Initialisation srcBe: OK'
[1403]	185	ELSE IF (tname(iiq)=="O3" .OR. tname(iiq)=="o3") THEN
	186	! Recherche de l'ozone : parametrization de la chimie par Cariolle
	187	id_o3=it
	188	CALL alloc_coefoz ! allocate ozone coefficients
	189	CALL press_coefoz ! read input pressure levels
[1421]	190	ELSE IF ( tname(iiq) == "pcsat" .OR. tname(iiq) == "Pcsat" ) THEN
	191	id_pcsat=it
	192	ELSE IF ( tname(iiq) == "pcocsat" .OR. tname(iiq) == "Pcocsat" ) THEN
	193	id_pcocsat=it
	194	ELSE IF ( tname(iiq) == "pcq" .OR. tname(iiq) == "Pcq" ) THEN
	195	id_pcq=it
	196	ELSE IF ( tname(iiq) == "pcs0" .OR. tname(iiq) == "Pcs0" ) THEN
	197	id_pcs0=it
	198	conv_flg(it)=0 ! No transport by convection for this tracer
	199	ELSE IF ( tname(iiq) == "pcos0" .OR. tname(iiq) == "Pcos0" ) THEN
	200	id_pcos0=it
	201	conv_flg(it)=0 ! No transport by convection for this tracer
	202	ELSE IF ( tname(iiq) == "pcq0" .OR. tname(iiq) == "Pcq0" ) THEN
	203	id_pcq0=it
	204	conv_flg(it)=0 ! No transport by convection for this tracer
	205	ELSE
	206	WRITE(lunout,*) 'This is an unknown tracer in LMDZ : ', trim(tname(iiq))
[1403]	207	END IF
	208	END DO
	209
[1191]	210	!
	211	! Valeurs specifiques pour les traceurs Rn222 et Pb210
	212	! ----------------------------------------------
[1409]	213	IF ( id_rn/=0 .AND. id_pb/=0 ) THEN
	214	rnpb = .TRUE.
	215	radio(id_rn)= .TRUE.
	216	radio(id_pb)= .TRUE.
	217	pbl_flg(id_rn) = 0 ! au lieu de clsol=true ! CL au sol calcule
	218	pbl_flg(id_pb) = 0 ! au lieu de clsol=true
	219	aerosol(id_rn) = .FALSE.
	220	aerosol(id_pb) = .TRUE. ! le Pb est un aerosol
[1191]	221
	222	CALL initrrnpb (ftsol,pctsrf,masktr,fshtr,hsoltr,tautr,vdeptr,scavtr)
	223	END IF
	224
[1227]	225	!
	226	! Initialisation de module carbon_cycle_mod
	227	! ----------------------------------------------
	228	IF (carbon_cycle_tr .OR. carbon_cycle_cpl) THEN
[1454]	229	CALL carbon_cycle_init(tr_seri, pdtphys, aerosol, radio)
[1227]	230	END IF
	231
[1421]	232	! Check if all tracers have restart values
	233	! ----------------------------------------------
	234	DO it=1,nbtr
	235	iiq=niadv(it+2)
	236	! Test if tracer is zero everywhere.
	237	! Done by master process MPI and master thread OpenMP
	238	CALL gather(tr_seri(:,:,it),varglo)
	239	IF (is_mpi_root .AND. is_omp_root) THEN
	240	mintmp=MINVAL(varglo,dim=1)
	241	maxtmp=MAXVAL(varglo,dim=1)
	242	IF (MINVAL(mintmp,dim=1)==0. .AND. MAXVAL(maxtmp,dim=1)==0.) THEN
	243	! Tracer is zero everywhere
	244	zero=.TRUE.
	245	ELSE
	246	zero=.FALSE.
	247	END IF
[1403]	248	END IF
	249
[1421]	250	! Distribute variable at all processes
	251	CALL bcast(zero)
[1403]	252
[1421]	253	! Initalize tracer that was not found in restart file.
	254	IF (zero) THEN
	255	! The tracer was not found in restart file or it was equal zero everywhere.
	256	WRITE(lunout,*) "The tracer ",trim(tname(iiq))," will be initialized"
	257	IF (it==id_pcsat .OR. it==id_pcq .OR. &
	258	it==id_pcs0 .OR. it==id_pcq0) THEN
	259	tr_seri(:,:,it) = 100.
	260	ELSE IF (it==id_pcocsat .OR. it==id_pcos0) THEN
	261	DO i = 1, klon
	262	IF ( pctsrf (i, is_oce) == 0. ) THEN
	263	tr_seri(i,:,it) = 0.
	264	ELSE
	265	tr_seri(i,:,it) = 100.
	266	END IF
	267	END DO
	268	ELSE
	269	! No specific initialization exist for this tracer
	270	tr_seri(:,:,it) = 0.
	271	END IF
[1403]	272	END IF
[1421]	273	END DO
[1403]	274
[1191]	275	END SUBROUTINE traclmdz_init
	276
[1403]	277	SUBROUTINE traclmdz(nstep, julien, gmtime, pdtphys, t_seri, paprs, pplay, &
	278	cdragh, coefh, yu1, yv1, ftsol, pctsrf, xlat, xlon, couchelimite, sh, &
	279	tr_seri, source, solsym, d_tr_cl, zmasse)
[1191]	280
	281	USE dimphy
	282	USE infotrac
[1403]	283	USE regr_pr_comb_coefoz_m, ONLY: regr_pr_comb_coefoz
	284	USE o3_chem_m, ONLY: o3_chem
[1227]	285	USE carbon_cycle_mod, ONLY : carbon_cycle, carbon_cycle_tr, carbon_cycle_cpl
[1191]	286	INCLUDE "YOMCST.h"
	287	INCLUDE "indicesol.h"
	288
	289	!==========================================================================
	290	! -- DESCRIPTION DES ARGUMENTS --
	291	!==========================================================================
	292
	293	! Input arguments
	294	!
	295	!Configuration grille,temps:
[1212]	296	INTEGER,INTENT(IN) :: nstep ! nombre d'appels de la physiq
[1403]	297	INTEGER,INTENT(IN) :: julien ! Jour julien
	298	REAL,INTENT(IN) :: gmtime
[1191]	299	REAL,INTENT(IN) :: pdtphys ! Pas d'integration pour la physique (seconde)
	300	REAL,DIMENSION(klon),INTENT(IN) :: xlat ! latitudes pour chaque point
[1403]	301	REAL, INTENT(IN):: xlon(:) ! dim(klon) longitude
[1191]	302
	303	!
	304	!Physique:
	305	!--------
	306	REAL,DIMENSION(klon,klev),INTENT(IN) :: t_seri ! Temperature
	307	REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs ! pression pour chaque inter-couche (en Pa)
	308	REAL,DIMENSION(klon,klev),INTENT(IN) :: pplay ! pression pour le mileu de chaque couche (en Pa)
[1403]	309	REAL,intent(in):: zmasse (:, :) ! dim(klon,klev) density of air, in kg/m2
[1191]	310
	311
	312	!Couche limite:
	313	!--------------
	314	!
[1454]	315	REAL,DIMENSION(klon),INTENT(IN) :: cdragh ! coeff drag pour T et Q
[1191]	316	REAL,DIMENSION(klon,klev),INTENT(IN) :: coefh ! coeff melange CL (m**2/s)
	317	REAL,DIMENSION(klon),INTENT(IN) :: yu1 ! vents au premier niveau
	318	REAL,DIMENSION(klon),INTENT(IN) :: yv1 ! vents au premier niveau
	319	LOGICAL,INTENT(IN) :: couchelimite
[1421]	320	REAL,DIMENSION(klon,klev),INTENT(IN) :: sh ! humidite specifique
[1191]	321
	322	! Arguments necessaires pour les sources et puits de traceur:
	323	REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: ftsol ! Temperature du sol (surf)(Kelvin)
	324	REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: pctsrf ! Pourcentage de sol f(nature du sol)
	325
	326	! InOutput argument
	327	REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT) :: tr_seri ! Concentration Traceur [U/KgA]
	328
	329	! Output argument
	330	CHARACTER(len=8),DIMENSION(nbtr), INTENT(OUT) :: solsym
	331	REAL,DIMENSION(klon,nbtr), INTENT(OUT) :: source ! a voir lorsque le flux de surface est prescrit
	332	REAL,DIMENSION(klon,klev,nbtr), INTENT(OUT) :: d_tr_cl ! Td couche limite/traceur
	333
	334	!=======================================================================================
	335	! -- VARIABLES LOCALES TRACEURS --
	336	!=======================================================================================
	337
	338	INTEGER :: i, k, it
[1421]	339	INTEGER :: lmt_pas ! number of time steps of "physics" per day
[1191]	340
	341	REAL,DIMENSION(klon) :: d_trs ! Td dans le reservoir
[1421]	342	REAL,DIMENSION(klon,klev) :: qsat ! pression de la vapeur a saturation
[1191]	343	REAL,DIMENSION(klon,klev,nbtr) :: d_tr_dec ! Td radioactive
[1421]	344	REAL :: zrho ! Masse Volumique de l'air KgA/m3
	345	REAL :: amn, amx
[1191]	346	!
	347	!=================================================================
	348	! Ajout de la production en Be7 (Beryllium) srcbe U/s/kgA
	349	!=================================================================
	350	!
	351	IF ( id_be /= 0 ) THEN
	352	DO k = 1, klev
	353	DO i = 1, klon
	354	tr_seri(i,k,id_be) = tr_seri(i,k,id_be)+srcbe(i,k)*pdtphys
	355	END DO
	356	END DO
	357	WRITE(,) 'Ajout srcBe dans tr_seri: OK'
	358	END IF
	359
[1421]	360
	361	!=================================================================
	362	! Update pseudo-vapor tracers
	363	!=================================================================
	364
	365	CALL q_sat(klon*klev,t_seri,pplay,qsat)
	366
[1403]	367	IF ( id_pcsat /= 0 ) THEN
	368	DO k = 1, klev
	369	DO i = 1, klon
[1421]	370	IF ( pplay(i,k).GE.85000.) THEN
	371	tr_seri(i,k,id_pcsat) = qsat(i,k)
	372	ELSE
	373	tr_seri(i,k,id_pcsat) = MIN (qsat(i,k), tr_seri(i,k,id_pcsat))
	374	END IF
[1403]	375	END DO
	376	END DO
	377	END IF
[1191]	378
[1403]	379	IF ( id_pcocsat /= 0 ) THEN
	380	DO k = 1, klev
	381	DO i = 1, klon
[1421]	382	IF ( pplay(i,k).GE.85000.) THEN
	383	IF ( pctsrf (i, is_oce) > 0. ) THEN
	384	tr_seri(i,k,id_pcocsat) = qsat(i,k)
	385	ELSE
	386	tr_seri(i,k,id_pcocsat) = 0.
	387	END IF
	388	ELSE
	389	tr_seri(i,k,id_pcocsat) = MIN (qsat(i,k), tr_seri(i,k,id_pcocsat))
[1403]	390	END IF
	391	END DO
	392	END DO
	393	END IF
	394
	395	IF ( id_pcq /= 0 ) THEN
	396	DO k = 1, klev
	397	DO i = 1, klon
[1421]	398	IF ( pplay(i,k).GE.85000.) THEN
	399	tr_seri(i,k,id_pcq) = sh(i,k)
	400	ELSE
	401	tr_seri(i,k,id_pcq) = MIN (qsat(i,k), tr_seri(i,k,id_pcq))
	402	END IF
[1403]	403	END DO
	404	END DO
	405	END IF
	406
[1421]	407
[1403]	408	IF ( id_pcs0 /= 0 ) THEN
	409	DO k = 1, klev
	410	DO i = 1, klon
[1421]	411	IF ( pplay(i,k).GE.85000.) THEN
	412	tr_seri(i,k,id_pcs0) = qsat(i,k)
	413	ELSE
	414	tr_seri(i,k,id_pcs0) = MIN (qsat(i,k), tr_seri(i,k,id_pcs0))
	415	END IF
[1403]	416	END DO
	417	END DO
	418	END IF
	419
[1421]	420
[1403]	421	IF ( id_pcos0 /= 0 ) THEN
	422	DO k = 1, klev
	423	DO i = 1, klon
[1421]	424	IF ( pplay(i,k).GE.85000.) THEN
	425	IF ( pctsrf (i, is_oce) > 0. ) THEN
	426	tr_seri(i,k,id_pcos0) = qsat(i,k)
	427	ELSE
	428	tr_seri(i,k,id_pcos0) = 0.
	429	END IF
	430	ELSE
	431	tr_seri(i,k,id_pcos0) = MIN (qsat(i,k), tr_seri(i,k,id_pcos0))
	432	END IF
[1403]	433	END DO
	434	END DO
	435	END IF
	436
[1421]	437
[1403]	438	IF ( id_pcq0 /= 0 ) THEN
	439	DO k = 1, klev
	440	DO i = 1, klon
[1421]	441	IF ( pplay(i,k).GE.85000.) THEN
	442	tr_seri(i,k,id_pcq0) = sh(i,k)
	443	ELSE
	444	tr_seri(i,k,id_pcq0) = MIN (qsat(i,k), tr_seri(i,k,id_pcq0))
	445	END IF
[1403]	446	END DO
	447	END DO
	448	END IF
	449
[1409]	450	!=================================================================
	451	! Update tracer : Age of stratospheric air
	452	!=================================================================
	453	IF (id_aga/=0) THEN
	454
	455	! Bottom layers
	456	DO k = 1, lev_1p5km
	457	tr_seri(:,k,id_aga) = 0.0
	458	END DO
	459
	460	! Layers above 1.5km
	461	DO k = lev_1p5km+1,klev-1
	462	tr_seri(:,k,id_aga) = tr_seri(:,k,id_aga) + pdtphys
	463	END DO
	464
	465	! Top layer
	466	tr_seri(:,klev,id_aga) = tr_seri(:,klev-1,id_aga)
	467
	468	END IF
	469
[1191]	470	!======================================================================
	471	! -- Calcul de l'effet de la couche limite --
	472	!======================================================================
	473
	474	IF (couchelimite) THEN
[1212]	475	source(:,:) = 0.0
	476
	477	IF (id_be /=0) THEN
	478	DO i=1, klon
	479	zrho = pplay(i,1)/t_seri(i,1)/RD
	480	source(i,id_be) = - vdeptr(id_be)tr_seri(i,1,id_be)zrho
	481	END DO
	482	END IF
	483
[1191]	484	END IF
	485
	486	DO it=1, nbtr
[1409]	487	IF (couchelimite .AND. pbl_flg(it) == 0 .AND. (it==id_rn .OR. it==id_pb)) THEN
	488	! couche limite avec quantite dans le sol calculee
[1191]	489	CALL cltracrn(it, pdtphys, yu1, yv1, &
	490	cdragh, coefh,t_seri,ftsol,pctsrf, &
	491	tr_seri(:,:,it),trs(:,it), &
[1403]	492	paprs, pplay, zmasse * rg, &
[1191]	493	masktr(:,it),fshtr(:,it),hsoltr(it),&
	494	tautr(it),vdeptr(it), &
	495	xlat,d_tr_cl(:,:,it),d_trs)
	496
	497	DO k = 1, klev
	498	DO i = 1, klon
	499	tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_cl(i,k,it)
	500	END DO
	501	END DO
	502
	503	! Traceur dans le reservoir sol
	504	DO i = 1, klon
	505	trs(i,it) = trs(i,it) + d_trs(i)
	506	END DO
	507	END IF
	508	END DO
[1403]	509
	510
[1191]	511	!======================================================================
	512	! Calcul de l'effet du puits radioactif
	513	!======================================================================
	514	CALL radio_decay (radio,rnpb,pdtphys,tautr,tr_seri,d_tr_dec)
[1421]	515
[1191]	516	DO it=1,nbtr
[1421]	517	WRITE(solsym(it),'(i2)') it
	518	END DO
	519
	520	DO it=1,nbtr
[1191]	521	IF(radio(it)) then
	522	DO k = 1, klev
	523	DO i = 1, klon
	524	tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_dec(i,k,it)
	525	END DO
	526	END DO
	527	CALL minmaxqfi(tr_seri(:,:,it),0.,1.e33,'puits rn it='//solsym(it))
	528	END IF
	529	END DO
	530
[1227]	531	!======================================================================
[1403]	532	! Parameterization of ozone chemistry
	533	!======================================================================
	534
	535	IF (id_o3 /= 0) then
	536	lmt_pas = NINT(86400./pdtphys)
	537	IF (MOD(nstep - 1, lmt_pas) == 0) THEN
	538	! Once per day, update the coefficients for ozone chemistry:
	539	CALL regr_pr_comb_coefoz(julien, xlat, paprs, pplay)
	540	END IF
	541	CALL o3_chem(julien, gmtime, t_seri, zmasse, pdtphys, xlat, &
	542	xlon, tr_seri(:, :, id_o3))
	543	END IF
	544
	545	!======================================================================
[1227]	546	! Calcul de cycle de carbon
	547	!======================================================================
	548	IF (carbon_cycle_tr .OR. carbon_cycle_cpl) THEN
[1454]	549	CALL carbon_cycle(nstep, pdtphys, pctsrf, tr_seri, source)
[1227]	550	END IF
	551
[1191]	552	END SUBROUTINE traclmdz
	553
	554
	555	SUBROUTINE traclmdz_to_restart(trs_out)
	556	! This subroutine is called from phyredem.F where the module
	557	! variable trs is written to restart file (restartphy.nc)
	558	USE dimphy
	559	USE infotrac
	560
	561	REAL,DIMENSION(klon,nbtr), INTENT(OUT) :: trs_out
[1203]	562	INTEGER :: ierr
[1212]	563
	564	IF ( ALLOCATED(trs) ) THEN
	565	trs_out(:,:) = trs(:,:)
[1203]	566	ELSE
[1212]	567	! No previous allocate of trs. This is the case for create_etat0_limit.
	568	trs_out(:,:) = 0.0
[1203]	569	END IF
[1212]	570
[1191]	571	END SUBROUTINE traclmdz_to_restart
	572
	573
	574	END MODULE traclmdz_mod

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

Download in other formats:

Original Format