Context Navigation

phytrac_mod.F90 @ 2404

Last change on this file since 2404 was 2394, checked in by acozic, 9 years ago

to fit with inca we need to increase dimension of naero_grp in aero_mod.
When lmdz is running without inca dim 10 to 12 will be empty and there is no change in results

these modifications only impact the old physics coupled with inca

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: 36.6 KB

Rev	Line
[1877]	1	!$Id$
[1813]	2	MODULE phytrac_mod
	3	!=================================================================================
	4	! Interface between the LMDZ physical package and tracer computation.
	5	! Chemistry modules (INCA, Reprobus or the more specific traclmdz routine)
	6	! are called from phytrac.
	7	!
	8	!======================================================================
	9	! Auteur(s) FH
	10	! Objet: Moniteur general des tendances traceurs
	11	!
	12	! iflag_vdf_trac : Options for activating transport by vertical diffusion :
	13	! 1. notmal
	14	! 0. emission is injected in the first layer only, without diffusion
	15	! -1 no emission & no diffusion
	16	! Modification 2013/07/22 : transformed into a module to pass tendencies to
	17	! physics outputs. Additional keys for controling activation of sub processes.
	18	! Modification R. Pilon 10 octobre 2012 large scale scavenging incloud_scav + bc_scav
	19	! Modification R. Pilon 01 janvier 2012 transport+scavenging KE scheme : cvltr
	20	!=================================================================================
	21
	22	!
	23	! Tracer tendencies, for outputs
	24	!-------------------------------
	25	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_cl ! Td couche limite/traceur
	26	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_dec !RomP
	27	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_cv ! Td convection/traceur
	28	! RomP >>>
	29	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_insc
	30	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_bcscav
	31	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_evapls
	32	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_ls
	33	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_trsp
	34	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_sscav
	35	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_sat
	36	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_uscav
	37	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: qPr,qDi ! concentration tra dans pluie,air descente insaturee
	38	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: qPa,qMel
	39	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: qTrdi,dtrcvMA ! conc traceur descente air insaturee et td convective MA
	40	! RomP <<<
	41	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_th ! Td thermique
	42	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_lessi_impa ! Td du lessivage par impaction
	43	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_lessi_nucl ! Td du lessivage par nucleation
	44	REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: qPrls !jyg: concentration tra dans pluie LS a la surf.
	45	REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: d_tr_dry ! Td depot sec/traceur (1st layer),ALLOCATABLE,SAVE jyg
	46	REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: flux_tr_dry ! depot sec/traceur (surface),ALLOCATABLE,SAVE jyg
	47
	48	!$OMP THREADPRIVATE(qPa,qMel,qTrdi,dtrcvMA,d_tr_th,d_tr_lessi_impa,d_tr_lessi_nucl)
	49	!$OMP THREADPRIVATE(d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav,qPr,qDi)
	50	!$OMP THREADPRIVATE(d_tr_insc,d_tr_bcscav,d_tr_evapls,d_tr_ls,qPrls)
	51	!$OMP THREADPRIVATE(d_tr,d_tr_cl,d_tr_dry,flux_tr_dry,d_tr_dec,d_tr_cv)
	52
	53
	54	CONTAINS
	55
[2146]	56	SUBROUTINE phytrac( &
	57	nstep, julien, gmtime, debutphy, &
	58	lafin, pdtphys, u, v, t_seri, &
	59	paprs, pplay, pmfu, pmfd, &
	60	pen_u, pde_u, pen_d, pde_d, &
	61	cdragh, coefh, fm_therm, entr_therm, &
	62	yu1, yv1, ftsol, pctsrf, &
	63	ustar, u10m, v10m, &
	64	wstar, ale_bl, ale_wake, &
	65	xlat, xlon, &
	66	frac_impa,frac_nucl,beta_fisrt,beta_v1, &
	67	presnivs, pphis, pphi, albsol, &
	68	sh, rh, cldfra, rneb, &
	69	diafra, cldliq, itop_con, ibas_con, &
	70	pmflxr, pmflxs, prfl, psfl, &
	71	da, phi, mp, upwd, &
	72	phi2, d1a, dam, sij, wght_cvfd, & ! RomP +RL
	73	wdtrainA, wdtrainM, sigd, clw, elij, & ! RomP
	74	evap, ep, epmlmMm, eplaMm, & ! RomP
	75	dnwd, aerosol_couple, flxmass_w, &
	76	tau_aero, piz_aero, cg_aero, ccm, &
	77	rfname, &
	78	d_tr_dyn, & ! RomP
	79	tr_seri)
	80	!
	81	!======================================================================
	82	! Auteur(s) FH
	83	! Objet: Moniteur general des tendances traceurs
	84	! Modification R. Pilon 01 janvier 2012 transport+scavenging KE scheme : cvltr
	85	! Modification R. Pilon 10 octobre 2012 large scale scavenging incloud_scav + bc_scav
	86	!======================================================================
[1813]	87
[2146]	88	USE ioipsl
	89	USE phys_cal_mod, only : hour
	90	USE dimphy
[2320]	91	USE infotrac_phy, ONLY: nbtr, type_trac, conv_flg, solsym, pbl_flg
[2146]	92	USE mod_grid_phy_lmdz
	93	USE mod_phys_lmdz_para
	94	USE iophy
	95	USE traclmdz_mod
	96	USE tracinca_mod
	97	USE tracreprobus_mod
	98	USE indice_sol_mod
[1813]	99
[2146]	100	USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
[2311]	101	USE print_control_mod, ONLY: lunout
[2394]	102	USE aero_mod, ONLY : naero_grp
[1813]	103
[2146]	104	IMPLICIT NONE
[1813]	105
[2146]	106	INCLUDE "YOMCST.h"
	107	INCLUDE "clesphys.h"
	108	INCLUDE "thermcell.h"
	109	!==========================================================================
	110	! -- ARGUMENT DESCRIPTION --
	111	!==========================================================================
[1813]	112
[2146]	113	! Input arguments
	114	!----------------
	115	!Configuration grille,temps:
	116	INTEGER,INTENT(IN) :: nstep ! Appel physique
	117	INTEGER,INTENT(IN) :: julien ! Jour julien
	118	REAL,INTENT(IN) :: gmtime ! Heure courante
	119	REAL,INTENT(IN) :: pdtphys ! Pas d'integration pour la physique (seconde)
	120	LOGICAL,INTENT(IN) :: debutphy ! le flag de l'initialisation de la physique
	121	LOGICAL,INTENT(IN) :: lafin ! le flag de la fin de la physique
[1813]	122
[2146]	123	REAL,DIMENSION(klon),INTENT(IN) :: xlat ! latitudes pour chaque point
	124	REAL,DIMENSION(klon),INTENT(IN) :: xlon ! longitudes pour chaque point
	125	!
	126	!Physique:
	127	!--------
	128	REAL,DIMENSION(klon,klev),INTENT(IN) :: t_seri ! Temperature
	129	REAL,DIMENSION(klon,klev),INTENT(IN) :: u ! variable not used
	130	REAL,DIMENSION(klon,klev),INTENT(IN) :: v ! variable not used
	131	REAL,DIMENSION(klon,klev),INTENT(IN) :: sh ! humidite specifique
	132	REAL,DIMENSION(klon,klev),INTENT(IN) :: rh ! humidite relative
	133	REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs ! pression pour chaque inter-couche (en Pa)
	134	REAL,DIMENSION(klon,klev),INTENT(IN) :: pplay ! pression pour le mileu de chaque couche (en Pa)
	135	REAL,DIMENSION(klon,klev),INTENT(IN) :: pphi ! geopotentiel
	136	REAL,DIMENSION(klon),INTENT(IN) :: pphis
	137	REAL,DIMENSION(klev),INTENT(IN) :: presnivs
	138	REAL,DIMENSION(klon,klev),INTENT(IN) :: cldliq ! eau liquide nuageuse
	139	REAL,DIMENSION(klon,klev),INTENT(IN) :: cldfra ! fraction nuageuse (tous les nuages)
	140	REAL,DIMENSION(klon,klev),INTENT(IN) :: diafra ! fraction nuageuse (convection ou stratus artificiels)
	141	REAL,DIMENSION(klon,klev),INTENT(IN) :: rneb ! fraction nuageuse (grande echelle)
	142	!
	143	REAL :: ql_incl ! contenu en eau liquide nuageuse dans le nuage ! ql_incl=oliq/rneb
	144	REAL,DIMENSION(klon,klev),INTENT(IN) :: beta_fisrt ! taux de conversion de l'eau cond (de fisrtilp)
	145	REAL,DIMENSION(klon,klev),INTENT(out) :: beta_v1 ! -- (originale version)
[1813]	146
[2146]	147	!
	148	INTEGER,DIMENSION(klon),INTENT(IN) :: itop_con
	149	INTEGER,DIMENSION(klon),INTENT(IN) :: ibas_con
	150	REAL,DIMENSION(klon),INTENT(IN) :: albsol ! albedo surface
	151	!
	152	!Dynamique
	153	!--------
	154	REAL,DIMENSION(klon,klev,nbtr),INTENT(IN) :: d_tr_dyn
	155	!
	156	!Convection:
	157	!----------
	158	REAL,DIMENSION(klon,klev),INTENT(IN) :: pmfu ! flux de masse dans le panache montant
	159	REAL,DIMENSION(klon,klev),INTENT(IN) :: pmfd ! flux de masse dans le panache descendant
	160	REAL,DIMENSION(klon,klev),INTENT(IN) :: pen_u ! flux entraine dans le panache montant
	161	REAL,DIMENSION(klon,klev),INTENT(IN) :: pde_u ! flux detraine dans le panache montant
	162	REAL,DIMENSION(klon,klev),INTENT(IN) :: pen_d ! flux entraine dans le panache descendant
	163	REAL,DIMENSION(klon,klev),INTENT(IN) :: pde_d ! flux detraine dans le panache descendant
[1813]	164
[2146]	165	!...Tiedke
	166	REAL,DIMENSION(klon,klev+1),INTENT(IN) :: pmflxr, pmflxs ! Flux precipitant de pluie, neige aux interfaces [convection]
	167	REAL,DIMENSION(klon,klev+1),INTENT(IN) :: prfl, psfl ! Flux precipitant de pluie, neige aux interfaces [large-scale]
[1813]	168
[2146]	169	LOGICAL,INTENT(IN) :: aerosol_couple
	170	REAL,DIMENSION(klon,klev),INTENT(IN) :: flxmass_w
[2394]	171	REAL,DIMENSION(klon,klev,naero_grp,2),INTENT(IN) :: tau_aero
	172	REAL,DIMENSION(klon,klev,naero_grp,2),INTENT(IN) :: piz_aero
	173	REAL,DIMENSION(klon,klev,naero_grp,2),INTENT(IN) :: cg_aero
	174	CHARACTER(len=4),DIMENSION(naero_grp),INTENT(IN) :: rfname
[2146]	175	REAL,DIMENSION(klon,klev,2),INTENT(IN) :: ccm
	176	!... K.Emanuel
	177	REAL,DIMENSION(klon,klev),INTENT(IN) :: da
	178	REAL,DIMENSION(klon,klev,klev),INTENT(IN):: phi
	179	! RomP >>>
	180	REAL,DIMENSION(klon,klev),INTENT(IN) :: d1a,dam
	181	REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: phi2
	182	!
	183	REAL,DIMENSION(klon,klev),INTENT(IN) :: wdtrainA
	184	REAL,DIMENSION(klon,klev),INTENT(IN) :: wdtrainM
	185	REAL,DIMENSION(klon),INTENT(IN) :: sigd
	186	! ---- RomP flux entraine, detraine et precipitant kerry Emanuel
	187	REAL,DIMENSION(klon,klev),INTENT(IN) :: evap
	188	REAL,DIMENSION(klon,klev),INTENT(IN) :: ep
	189	REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: sij
	190	REAL,DIMENSION(klon,klev),INTENT(IN) :: wght_cvfd !RL
	191	REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: elij
	192	REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: epmlmMm
	193	REAL,DIMENSION(klon,klev),INTENT(IN) :: eplaMm
	194	REAL,DIMENSION(klon,klev),INTENT(IN) :: clw
	195	! RomP <<<
[1813]	196
[2146]	197	!
	198	REAL,DIMENSION(klon,klev),INTENT(IN) :: mp
	199	REAL,DIMENSION(klon,klev),INTENT(IN) :: upwd ! saturated updraft mass flux
	200	REAL,DIMENSION(klon,klev),INTENT(IN) :: dnwd ! saturated downdraft mass flux
	201	!
	202	!Thermiques:
	203	!----------
	204	REAL,DIMENSION(klon,klev+1),INTENT(IN) :: fm_therm
	205	REAL,DIMENSION(klon,klev),INTENT(IN) :: entr_therm
	206	!
	207	!Couche limite:
	208	!--------------
	209	!
	210	!
	211	REAL,DIMENSION(:),INTENT(IN) :: cdragh ! (klon) coeff drag pour T et Q
	212	REAL,DIMENSION(:,:),INTENT(IN) :: coefh ! (klon,klev) coeff melange CL (m**2/s)
	213	REAL,DIMENSION(:),INTENT(IN) :: ustar,u10m,v10m ! (klon) u* & vent a 10m (m/s)
	214	REAL,DIMENSION(:),INTENT(IN) :: wstar,ale_bl,ale_wake ! (klon) w* and Avail. Lifting Ener.
	215	REAL,DIMENSION(:),INTENT(IN) :: yu1 ! (klon) vents au premier niveau
	216	REAL,DIMENSION(:),INTENT(IN) :: yv1 ! (klon) vents au premier niveau
[1813]	217
[2146]	218	!
	219	!Lessivage:
	220	!----------
	221	!
	222	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: ccntrAA
	223	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: ccntrENV
	224	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: coefcoli
	225	LOGICAL, DIMENSION(:), ALLOCATABLE, SAVE :: flag_cvltr
	226	!$OMP THREADPRIVATE(ccntrAA,ccntrENV,coefcoli,flag_cvltr)
	227	REAL, DIMENSION(klon,klev) :: ccntrAA_3d
	228	REAL, DIMENSION(klon,klev) :: ccntrENV_3d
	229	REAL, DIMENSION(klon,klev) :: coefcoli_3d
	230	!
	231	! pour le ON-LINE
	232	!
	233	REAL,DIMENSION(klon,klev),INTENT(IN) :: frac_impa ! fraction d'aerosols non impactes
	234	REAL,DIMENSION(klon,klev),INTENT(IN) :: frac_nucl ! fraction d'aerosols non nuclees
[1813]	235
[2146]	236	! Arguments necessaires pour les sources et puits de traceur:
	237	REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: ftsol ! Temperature du sol (surf)(Kelvin)
	238	REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: pctsrf ! Pourcentage de sol (nature du sol)
[1813]	239
	240
[2146]	241	! Output argument
	242	!----------------
	243	REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT) :: tr_seri ! Concentration Traceur [U/KgA]
	244	REAL,DIMENSION(klon,klev) :: sourceBE
	245	!=======================================================================================
	246	! -- LOCAL VARIABLES --
	247	!=======================================================================================
	248
	249	INTEGER :: i, k, it
	250	INTEGER :: nsplit
	251
	252	!Sources et Reservoirs de traceurs (ex:Radon):
	253	!--------------------------------------------
	254	!
	255	REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: source ! a voir lorsque le flux de surface est prescrit
[1813]	256	!$OMP THREADPRIVATE(source)
	257
[2146]	258	!
	259	!Entrees/Sorties: (cf ini_histrac.h et write_histrac.h)
	260	!---------------
	261	INTEGER :: iiq, ierr
	262	INTEGER :: nhori, nvert
	263	REAL :: zsto, zout, zjulian
	264	INTEGER,SAVE :: nid_tra ! pointe vers le fichier histrac.nc
[1813]	265	!$OMP THREADPRIVATE(nid_tra)
[2146]	266	REAL,DIMENSION(klon) :: zx_tmp_fi2d ! variable temporaire grille physique
	267	INTEGER :: itau_w ! pas de temps ecriture = nstep + itau_phy
	268	LOGICAL,PARAMETER :: ok_sync=.TRUE.
[1820]	269
[2146]	270	!
	271	! Nature du traceur
	272	!------------------
	273	LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: aerosol ! aerosol(it) = true => aerosol => lessivage
[1813]	274	!$OMP THREADPRIVATE(aerosol) ! aerosol(it) = false => gaz
[2146]	275	REAL,DIMENSION(klon,klev) :: delp ! epaisseur de couche (Pa)
	276	!
	277	! Tendances de traceurs (Td) et flux de traceurs:
	278	!------------------------
	279	REAL,DIMENSION(klon,klev) :: d_tr ! Td dans l'atmosphere
	280	REAL,DIMENSION(klon,klev) :: Mint
	281	REAL,DIMENSION(klon,klev,nbtr) :: zmfd1a
	282	REAL,DIMENSION(klon,klev,nbtr) :: zmfdam
	283	REAL,DIMENSION(klon,klev,nbtr) :: zmfphi2
	284	! Physique
	285	!----------
	286	REAL,DIMENSION(klon,klev,nbtr) :: flestottr ! flux de lessivage dans chaque couche
	287	REAL,DIMENSION(klon,klev) :: zmasse ! densité atmosphérique Kg/m2
	288	REAL,DIMENSION(klon,klev) :: ztra_th
	289	!PhH
	290	REAL,DIMENSION(klon,klev) :: zrho
	291	REAL,DIMENSION(klon,klev) :: zdz
	292	REAL :: evaplsc,dx,beta ! variable pour lessivage Genthon
	293	REAL,DIMENSION(klon) :: his_dh ! ---
	294	! in-cloud scav variables
	295	REAL :: ql_incloud_ref ! ref value of in-cloud condensed water content
	296
	297	!Controles:
	298	!---------
	299	INTEGER,SAVE :: iflag_vdf_trac,iflag_con_trac,iflag_the_trac
	300	INTEGER,SAVE :: iflag_con_trac_omp, iflag_vdf_trac_omp,iflag_the_trac_omp
[1820]	301	!$OMP THREADPRIVATE(iflag_vdf_trac,iflag_con_trac,iflag_the_trac)
[1813]	302
[2146]	303	LOGICAL,SAVE :: lessivage
[1813]	304	!$OMP THREADPRIVATE(lessivage)
	305
[2146]	306	!RomP >>>
	307	INTEGER,SAVE :: iflag_lscav_omp,iflag_lscav
[2210]	308	REAL, SAVE :: ccntrAA_in,ccntrAA_omp
	309	REAL, SAVE :: ccntrENV_in,ccntrENV_omp
	310	REAL, SAVE :: coefcoli_in,coefcoli_omp
	311
[2146]	312	LOGICAL,SAVE :: convscav_omp,convscav
[1822]	313	!$OMP THREADPRIVATE(iflag_lscav)
[2210]	314	!$OMP THREADPRIVATE(ccntrAA_in,ccntrENV_in,coefcoli_in)
[1822]	315	!$OMP THREADPRIVATE(convscav)
[2146]	316	!RomP <<<
	317	!######################################################################
	318	! -- INITIALIZATION --
	319	!######################################################################
	320	IF (debutphy) THEN
	321	ALLOCATE(d_tr_cl(klon,klev,nbtr),d_tr_dry(klon,nbtr))
	322	ALLOCATE(flux_tr_dry(klon,nbtr),d_tr_dec(klon,klev,nbtr),d_tr_cv(klon,klev,nbtr))
	323	ALLOCATE(d_tr_insc(klon,klev,nbtr),d_tr_bcscav(klon,klev,nbtr))
	324	ALLOCATE(d_tr_evapls(klon,klev,nbtr),d_tr_ls(klon,klev,nbtr))
	325	ALLOCATE(qPrls(klon,nbtr),d_tr_trsp(klon,klev,nbtr))
	326	ALLOCATE(d_tr_sscav(klon,klev,nbtr),d_tr_sat(klon,klev,nbtr))
	327	ALLOCATE(d_tr_uscav(klon,klev,nbtr),qPr(klon,klev,nbtr),qDi(klon,klev,nbtr))
	328	ALLOCATE(qPa(klon,klev,nbtr),qMel(klon,klev,nbtr))
	329	ALLOCATE(qTrdi(klon,klev,nbtr),dtrcvMA(klon,klev,nbtr))
	330	ALLOCATE(d_tr_th(klon,klev,nbtr))
	331	ALLOCATE(d_tr_lessi_impa(klon,klev,nbtr),d_tr_lessi_nucl(klon,klev,nbtr))
	332	ENDIF
[1813]	333
[2146]	334	DO k=1,klev
	335	DO i=1,klon
	336	sourceBE(i,k)=0.
	337	Mint(i,k)=0.
	338	zrho(i,k)=0.
	339	zdz(i,k)=0.
	340	END DO
	341	END DO
[1813]	342
[2146]	343	DO it=1, nbtr
	344	DO k=1,klev
	345	DO i=1,klon
	346	d_tr_insc(i,k,it)=0.
	347	d_tr_bcscav(i,k,it)=0.
	348	d_tr_evapls(i,k,it)=0.
	349	d_tr_ls(i,k,it)=0.
	350	d_tr_cv(i,k,it)=0.
	351	d_tr_cl(i,k,it)=0.
	352	d_tr_trsp(i,k,it)=0.
	353	d_tr_sscav(i,k,it)=0.
	354	d_tr_sat(i,k,it)=0.
	355	d_tr_uscav(i,k,it)=0.
	356	d_tr_lessi_impa(i,k,it)=0.
	357	d_tr_lessi_nucl(i,k,it)=0.
	358	qDi(i,k,it)=0.
	359	qPr(i,k,it)=0.
	360	qPa(i,k,it)=0.
	361	qMel(i,k,it)=0.
	362	qTrdi(i,k,it)=0.
	363	dtrcvMA(i,k,it)=0.
	364	zmfd1a(i,k,it)=0.
	365	zmfdam(i,k,it)=0.
	366	zmfphi2(i,k,it)=0.
	367	END DO
	368	END DO
[1813]	369	END DO
[2146]	370
	371	DO k = 1, klev
	372	DO i = 1, klon
	373	delp(i,k) = paprs(i,k)-paprs(i,k+1)
	374	END DO
	375	END DO
	376
	377	IF (debutphy) THEN
	378	!!jyg
[1813]	379	!$OMP BARRIER
[2146]	380	ecrit_tra=86400. ! frequence de stokage en dur
	381	! obsolete car remplace par des ecritures dans phys_output_write
	382	!RomP >>>
	383	!
	384	!Config Key = convscav
	385	!Config Desc = Convective scavenging switch: 0=off, 1=on.
	386	!Config Def = .false.
	387	!Config Help =
	388	!
[1813]	389	!$OMP MASTER
[2146]	390	convscav_omp=.false.
	391	call getin('convscav', convscav_omp)
	392	iflag_vdf_trac_omp=1
	393	call getin('iflag_vdf_trac', iflag_vdf_trac_omp)
	394	iflag_con_trac_omp=1
	395	call getin('iflag_con_trac', iflag_con_trac_omp)
	396	iflag_the_trac_omp=1
	397	call getin('iflag_the_trac', iflag_the_trac_omp)
[1813]	398	!$OMP END MASTER
	399	!$OMP BARRIER
[2146]	400	convscav=convscav_omp
	401	iflag_vdf_trac=iflag_vdf_trac_omp
	402	iflag_con_trac=iflag_con_trac_omp
	403	iflag_the_trac=iflag_the_trac_omp
	404	write(lunout,*) 'phytrac passage dans routine conv avec lessivage', convscav
	405	!
	406	!Config Key = iflag_lscav
	407	!Config Desc = Large scale scavenging parametrization: 0=none, 1=old(Genthon92),
	408	! 2=1+PHeinrich, 3=Reddy_Boucher2004, 4=3+RPilon.
	409	!Config Def = 1
	410	!Config Help =
	411	!
[1813]	412	!$OMP MASTER
[2146]	413	iflag_lscav_omp=1
	414	call getin('iflag_lscav', iflag_lscav_omp)
[2210]	415	ccntrAA_omp=1
	416	ccntrENV_omp=1.
	417	coefcoli_omp=0.001
	418	call getin('ccntrAA', ccntrAA_omp)
	419	call getin('ccntrENV', ccntrENV_omp)
	420	call getin('coefcoli', coefcoli_omp)
[1813]	421	!$OMP END MASTER
	422	!$OMP BARRIER
[2146]	423	iflag_lscav=iflag_lscav_omp
[2210]	424	ccntrAA_in=ccntrAA_omp
	425	ccntrENV_in=ccntrENV_omp
	426	coefcoli_in=coefcoli_omp
[2146]	427	!
	428	SELECT CASE(iflag_lscav)
	429	CASE(0)
	430	WRITE(lunout,*) 'Large scale scavenging: none'
	431	CASE(1)
	432	WRITE(lunout,*) 'Large scale scavenging: C. Genthon, Tellus(1992), 44B, 371-389'
	433	CASE(2)
	434	WRITE(lunout,*) 'Large scale scavenging: C. Genthon, modified P. Heinrich'
	435	CASE(3)
	436	WRITE(lunout,*) 'Large scale scavenging: M. Shekkar Reddy and O. Boucher, JGR(2004), 109, D14202'
	437	CASE(4)
	438	WRITE(lunout,*) 'Large scale scavenging: Reddy and Boucher, modified R. Pilon'
	439	END SELECT
	440	!RomP <<<
	441	WRITE(,) 'FIRST TIME IN PHYTRAC : pdtphys(sec) = ',pdtphys,'ecrit_tra (sec) = ',ecrit_tra
	442	ALLOCATE( source(klon,nbtr), stat=ierr)
[2311]	443	IF (ierr /= 0) CALL abort_physic('phytrac', 'pb in allocation 1',1)
[1813]	444
[2146]	445	ALLOCATE( aerosol(nbtr), stat=ierr)
[2311]	446	IF (ierr /= 0) CALL abort_physic('phytrac', 'pb in allocation 2',1)
[2146]	447
	448
	449	! Initialize module for specific tracers
	450	SELECT CASE(type_trac)
	451	CASE('lmdz')
	452	CALL traclmdz_init(pctsrf,xlat,xlon,ftsol,tr_seri,t_seri,pplay,sh,pdtphys,aerosol,lessivage)
	453	CASE('inca')
	454	source(:,:)=0.
	455	CALL tracinca_init(aerosol,lessivage)
	456	CASE('repr')
	457	source(:,:)=0.
	458	END SELECT
	459
	460	!
	461	!--initialising coefficients for scavenging in the case of NP
	462	!
	463	ALLOCATE(flag_cvltr(nbtr))
	464	IF (iflag_con.EQ.3) THEN
	465	!
	466	ALLOCATE(ccntrAA(nbtr))
	467	ALLOCATE(ccntrENV(nbtr))
	468	ALLOCATE(coefcoli(nbtr))
	469	!
	470	DO it=1, nbtr
	471	SELECT CASE(type_trac)
	472	CASE('lmdz')
	473	IF (convscav.and.aerosol(it)) THEN
	474	flag_cvltr(it)=.true.
[2210]	475	ccntrAA(it) =ccntrAA_in !--a modifier par JYG a lire depuis fichier
	476	ccntrENV(it)=ccntrENV_in
	477	coefcoli(it)=coefcoli_in
[2146]	478	ELSE
	479	flag_cvltr(it)=.false.
	480	ENDIF
	481
	482	CASE('inca')
	483	! IF ((it.EQ.id_Rn222) .OR. ((it.GE.id_SO2) .AND. (it.LE.id_NH3)) ) THEN
	484	! !--gas-phase species
	485	! flag_cvltr(it)=.false.
[1813]	486	!
[2146]	487	! ELSEIF ( (it.GE.id_CIDUSTM) .AND. (it.LE.id_AIN) ) THEN
	488	! !--insoluble aerosol species
	489	! flag_cvltr(it)=.true.
	490	! ccntrAA(it)=0.7
	491	! ccntrENV(it)=0.7
	492	! coefcoli(it)=0.001
	493	! ELSEIF ( (it.EQ.id_Pb210) .OR. ((it.GE.id_CSSSM) .AND. (it.LE.id_SSN))) THEN
	494	! !--soluble aerosol species
	495	! flag_cvltr(it)=.true.
	496	! ccntrAA(it)=0.9
	497	! ccntrENV(it)=0.9
	498	! coefcoli(it)=0.001
	499	! ELSE
	500	! WRITE(lunout,*) 'pb it=', it
[2311]	501	! CALL abort_physic('phytrac','pb it scavenging',1)
[2146]	502	! ENDIF
	503	!--test OB
	504	!--for now we do not scavenge in cvltr
	505	flag_cvltr(it)=.false.
	506	END SELECT
	507	ENDDO
	508	!
	509	ELSE ! iflag_con .ne. 3
	510	flag_cvltr(:) = .false.
	511	ENDIF
	512	!
	513	! Initialize diagnostic output
	514	! ----------------------------
[1813]	515	#ifdef CPP_IOIPSL
[2146]	516	! INCLUDE "ini_histrac.h"
[1813]	517	#endif
[2146]	518	!
	519	! print out all tracer flags
	520	!
	521	WRITE(lunout,*) 'print out all tracer flags'
	522	WRITE(lunout,*) 'type_trac =', type_trac
	523	WRITE(lunout,*) 'config_inca =', config_inca
	524	WRITE(lunout,*) 'iflag_con_trac =', iflag_con_trac
	525	WRITE(lunout,*) 'iflag_con =', iflag_con
	526	WRITE(lunout,*) 'convscav =', convscav
	527	WRITE(lunout,*) 'iflag_lscav =', iflag_lscav
	528	WRITE(lunout,*) 'aerosol =', aerosol
	529	WRITE(lunout,*) 'iflag_the_trac =', iflag_the_trac
	530	WRITE(lunout,*) 'iflag_thermals =', iflag_thermals
	531	WRITE(lunout,*) 'iflag_vdf_trac =', iflag_vdf_trac
	532	WRITE(lunout,*) 'pbl_flg =', pbl_flg
	533	WRITE(lunout,*) 'lessivage =', lessivage
	534	write(lunout,*) 'flag_cvltr = ', flag_cvltr
[1813]	535
[2146]	536	IF (lessivage.AND.config_inca.EQ.'inca') THEN
[2311]	537	CALL abort_physic('phytrac', 'lessivage=T config_inca=inca impossible',1)
[2146]	538	STOP
	539	ENDIF
	540	!
	541	END IF ! of IF (debutphy)
	542	!############################################ END INITIALIZATION #######
[1813]	543
[2146]	544	DO k=1,klev
	545	DO i=1,klon
	546	zmasse(i,k)=(paprs(i,k)-paprs(i,k+1))/rg
	547	END DO
	548	END DO
	549	!
	550	IF (id_be .GT. 0) THEN
	551	DO k=1,klev
	552	DO i=1,klon
	553	sourceBE(i,k)=srcbe(i,k) !RomP -> pour sortie histrac
	554	END DO
	555	END DO
	556	ENDIF
[1813]	557
[2146]	558	!===============================================================================
	559	! -- Do specific treatment according to chemestry model or local LMDZ tracers
	560	!
	561	!===============================================================================
	562	SELECT CASE(type_trac)
	563	CASE('lmdz')
	564	! -- Traitement des traceurs avec traclmdz
	565	CALL traclmdz(nstep, julien, gmtime, pdtphys, t_seri, paprs, pplay, &
	566	cdragh, coefh, yu1, yv1, ftsol, pctsrf, xlat, xlon,iflag_vdf_trac>=0,sh, &
	567	rh, pphi, ustar, wstar, ale_bl, ale_wake, u10m, v10m, &
[2180]	568	tr_seri, source, d_tr_cl,d_tr_dec, zmasse) !RomP
[1813]	569
[2146]	570	CASE('inca')
	571	! -- CHIMIE INCA config_inca = aero or chem --
[1813]	572
[2146]	573	CALL tracinca(&
	574	nstep, julien, gmtime, lafin, &
	575	pdtphys, t_seri, paprs, pplay, &
	576	pmfu, upwd, ftsol, pctsrf, pphis, &
	577	pphi, albsol, sh, rh, &
	578	cldfra, rneb, diafra, cldliq, &
	579	itop_con, ibas_con, pmflxr, pmflxs, &
	580	prfl, psfl, aerosol_couple, flxmass_w, &
	581	tau_aero, piz_aero, cg_aero, ccm, &
	582	rfname, &
[2180]	583	tr_seri, source)
[1813]	584
[2146]	585	CASE('repr')
	586	! -- CHIMIE REPROBUS --
[1813]	587
[2146]	588	CALL tracreprobus(pdtphys, gmtime, debutphy, julien, &
	589	presnivs, xlat, xlon, pphis, pphi, &
	590	t_seri, pplay, paprs, sh , &
[2180]	591	tr_seri)
[1813]	592
[2146]	593	END SELECT
	594	!======================================================================
	595	! -- Calcul de l'effet de la convection --
	596	!======================================================================
[1813]	597
[2146]	598	IF (iflag_con_trac==1) THEN
[1813]	599
[2146]	600	DO it=1, nbtr
	601	IF ( conv_flg(it) == 0 ) CYCLE
	602	IF (iflag_con.LT.2) THEN
	603	!--pas de transport convectif
[1813]	604
[2146]	605	d_tr_cv(:,:,it)=0.
	606	ELSE IF (iflag_con.EQ.2) THEN
	607	!--ancien transport convectif de Tiedtke
[1813]	608
[2146]	609	CALL nflxtr(pdtphys, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
	610	pplay, paprs, tr_seri(:,:,it), d_tr_cv(:,:,it))
	611	ELSE
	612	!--nouveau transport convectif de Emanuel
[1813]	613
[2146]	614	IF (flag_cvltr(it)) THEN
	615	!--nouveau transport convectif de Emanuel avec lessivage convectif
	616	!
	617	!
	618	ccntrAA_3d(:,:) =ccntrAA(it)
	619	ccntrENV_3d(:,:)=ccntrENV(it)
	620	coefcoli_3d(:,:)=coefcoli(it)
[1813]	621
[2146]	622	!--beware this interface is a bit weird because it is called for each tracer
	623	!--with the full array tr_seri even if only item it is processed
[1813]	624
[2210]	625	print*,'CV SCAV ',it,ccntrAA(it),ccntrENV(it)
	626
[2146]	627	CALL cvltr_scav(pdtphys, da, phi,phi2,d1a,dam, mp,ep, &
	628	sigd,sij,wght_cvfd,clw,elij,epmlmMm,eplaMm, &
	629	pmflxr,pmflxs,evap,t_seri,wdtrainA,wdtrainM, &
	630	paprs,it,tr_seri,upwd,dnwd,itop_con,ibas_con, &
	631	ccntrAA_3d,ccntrENV_3d,coefcoli_3d, &
	632	d_tr_cv,d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav,qDi,qPr,&
	633	qPa,qMel,qTrdi,dtrcvMA,Mint, &
	634	zmfd1a,zmfphi2,zmfdam)
[1813]	635
[2146]	636
	637	ELSE !---flag_cvltr(it).EQ.FALSE
	638	!--nouveau transport convectif de Emanuel mais pas de lessivage convectif
	639
	640	!--beware this interface is a bit weird because it is called for each tracer
	641	!--with the full array tr_seri even if only item it is processed
	642	!
	643	CALL cvltr_noscav(it,pdtphys, da, phi,mp,wght_cvfd,paprs,pplay, & !jyg
	644	tr_seri,upwd,dnwd,d_tr_cv) !jyg
	645
	646	ENDIF
	647
	648	ENDIF !--iflag
	649
	650	!--on ajoute les tendances
	651
	652	DO k = 1, klev
	653	DO i = 1, klon
	654	tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_cv(i,k,it)
	655	END DO
	656	END DO
	657
	658	CALL minmaxqfi(tr_seri(:,:,it),0.,1.e33,'convection it = '//solsym(it))
	659
	660	END DO ! nbtr
	661
	662	END IF ! convection
	663
	664	!======================================================================
	665	! -- Calcul de l'effet des thermiques --
	666	!======================================================================
	667
[1813]	668	DO it=1,nbtr
[2146]	669	DO k=1,klev
	670	DO i=1,klon
	671	d_tr_th(i,k,it)=0.
	672	tr_seri(i,k,it)=MAX(tr_seri(i,k,it),0.)
	673	tr_seri(i,k,it)=MIN(tr_seri(i,k,it),1.e10)
	674	END DO
	675	END DO
	676	END DO
[1813]	677
[2146]	678	IF (iflag_thermals.GT.0.AND.iflag_the_trac>0) THEN
[1813]	679
[2146]	680	DO it=1, nbtr
[1813]	681
[2146]	682	CALL thermcell_dq(klon,klev,1,pdtphys,fm_therm,entr_therm, &
	683	zmasse,tr_seri(1:klon,1:klev,it), &
	684	d_tr_th(1:klon,1:klev,it),ztra_th,0 )
[1813]	685
[2146]	686	DO k=1,klev
	687	DO i=1,klon
	688	d_tr_th(i,k,it)=pdtphys*d_tr_th(i,k,it)
	689	tr_seri(i,k,it)=MAX(tr_seri(i,k,it)+d_tr_th(i,k,it),0.)
	690	END DO
	691	END DO
[1813]	692
[2146]	693	END DO ! it
[1813]	694
[2146]	695	END IF ! Thermiques
[1813]	696
[2146]	697	!======================================================================
	698	! -- Calcul de l'effet de la couche limite --
	699	!======================================================================
	700
	701	IF (iflag_vdf_trac==1) THEN
	702
	703	! Injection during BL mixing
	704	!
	705	DO it=1, nbtr
	706	!
	707	IF( pbl_flg(it) /= 0 ) THEN
	708	!
	709	CALL cltrac(pdtphys, coefh,t_seri, &
	710	tr_seri(:,:,it), source(:,it), &
	711	paprs, pplay, delp, &
	712	d_tr_cl(:,:,it),d_tr_dry(:,it),flux_tr_dry(:,it))
	713	!
	714	tr_seri(:,:,it)=tr_seri(:,:,it)+d_tr_cl(:,:,it)
	715	!
	716	END IF
	717	!
	718	END DO
	719	!
	720	ELSE IF (iflag_vdf_trac==0) THEN
	721	!
	722	! Injection of source in the first model layer
	723	!
	724	DO it=1,nbtr
	725	d_tr_cl(:,1,it)=source(:,it)RG/delp(:,1)pdtphys
	726	tr_seri(:,1,it)=tr_seri(:,1,it)+d_tr_cl(:,1,it)
	727	ENDDO
	728	d_tr_cl(:,2:klev,1:nbtr)=0.
	729	!
	730	ELSE IF (iflag_vdf_trac==-1) THEN
	731	!
	732	! Nothing happens
	733	!
	734	d_tr_cl=0.
	735	!
	736	ELSE
	737	!
[2311]	738	CALL abort_physic('iflag_vdf_trac', 'cas non prevu',1)
[2146]	739	!
	740	END IF ! couche limite
	741
	742	!======================================================================
	743	! Calcul de l'effet de la precipitation grande echelle
	744	! POUR INCA le lessivage est fait directement dans INCA
	745	!======================================================================
	746
	747	IF (lessivage) THEN
	748
	749	ql_incloud_ref = 10.e-4
	750	ql_incloud_ref = 5.e-4
	751
	752
	753	! calcul du contenu en eau liquide au sein du nuage
	754	ql_incl = ql_incloud_ref
	755	! choix du lessivage
	756	!
	757	IF (iflag_lscav .EQ. 3 .OR. iflag_lscav .EQ. 4) THEN
	758	! ******** Olivier Boucher version (3) possibly with modified ql_incl (4)
	759	!
	760	DO it = 1, nbtr
[2210]	761
	762	IF (aerosol(it)) THEN
[2146]	763	! incloud scavenging and removal by large scale rain ! orig : ql_incl was replaced by 0.5e-3 kg/kg
	764	! the value 0.5e-3 kg/kg is from Giorgi and Chameides (1986), JGR
	765	! Liu (2001) proposed to use 1.5e-3 kg/kg
	766
[2284]	767	!jyg<
	768	!! CALL lsc_scav(pdtphys,it,iflag_lscav,ql_incl,prfl,psfl,rneb,beta_fisrt, &
	769	CALL lsc_scav(pdtphys,it,iflag_lscav,aerosol,ql_incl,prfl,psfl,rneb,beta_fisrt, &
	770	!>jyg
[1813]	771	beta_v1,pplay,paprs,t_seri,tr_seri,d_tr_insc, &
	772	d_tr_bcscav,d_tr_evapls,qPrls)
	773
[2146]	774	!large scale scavenging tendency
	775	DO k = 1, klev
	776	DO i = 1, klon
	777	d_tr_ls(i,k,it)=d_tr_insc(i,k,it)+d_tr_bcscav(i,k,it)+d_tr_evapls(i,k,it)
	778	tr_seri(i,k,it)=tr_seri(i,k,it)+d_tr_ls(i,k,it)
	779	ENDDO
	780	ENDDO
	781	CALL minmaxqfi(tr_seri(:,:,it),0.,1.e33,'lsc scav it = '//solsym(it))
[2210]	782	ENDIF
	783
[2146]	784	END DO !tr
[1813]	785
[2146]	786	ELSE IF (iflag_lscav .EQ. 2) THEN ! frac_impa, frac_nucl
	787	! ********* modified old version
[1813]	788
[2146]	789	d_tr_lessi_nucl(:,:,:) = 0.
	790	d_tr_lessi_impa(:,:,:) = 0.
	791	flestottr(:,:,:) = 0.
	792	! Tendance des aerosols nuclees et impactes
	793	DO it = 1, nbtr
	794	IF (aerosol(it)) THEN
	795	his_dh(:)=0.
	796	DO k = 1, klev
	797	DO i = 1, klon
	798	!PhH
	799	zrho(i,k)=pplay(i,k)/t_seri(i,k)/RD
	800	zdz(i,k)=(paprs(i,k)-paprs(i,k+1))/zrho(i,k)/RG
	801	!
	802	END DO
	803	END DO
[1813]	804
[2146]	805	DO k=klev-1, 1, -1
	806	DO i=1, klon
	807	! d_tr_ls(i,k,it)=tr_seri(i,k,it)(frac_impa(i,k)frac_nucl(i,k)-1.)
	808	dx=d_tr_ls(i,k,it)
	809	his_dh(i)=his_dh(i)-dxzrho(i,k)zdz(i,k)/pdtphys ! kg/m2/s
	810	evaplsc = prfl(i,k) - prfl(i,k+1) + psfl(i,k) - psfl(i,k+1)
	811	! Evaporation Partielle -> Liberation Partielle 0.5*evap
	812	IF ( evaplsc .LT.0..and.abs(prfl(i,k+1)+psfl(i,k+1)).gt.1.e-10) THEN
	813	evaplsc = (-evaplsc)/(prfl(i,k+1)+psfl(i,k+1))
	814	! evaplsc est donc positif, his_dh(i) est positif
	815	!--------------
	816	d_tr_evapls(i,k,it)=0.5evaplsc(d_tr_lessi_nucl(i,k+1,it) &
	817	+d_tr_lessi_impa(i,k+1,it))
	818	!------------- d_tr_evapls(i,k,it)=-0.5evaplsc(d_tr_lsc(i,k+1,it))
	819	beta=0.5*evaplsc
	820	if ((prfl(i,k)+psfl(i,k)).lt.1.e-10) THEN
	821	beta=1.0*evaplsc
	822	endif
	823	dx=betahis_dh(i)/zrho(i,k)/zdz(i,k)pdtphys
	824	his_dh(i)=(1.-beta)*his_dh(i) ! tracer from
	825	d_tr_evapls(i,k,it)=dx
	826	ENDIF
	827	d_tr_ls(i,k,it)=tr_seri(i,k,it)(frac_impa(i,k)frac_nucl(i,k)-1.) &
	828	+d_tr_evapls(i,k,it)
[1813]	829
[2146]	830	!--------------
	831	d_tr_lessi_nucl(i,k,it) = d_tr_lessi_nucl(i,k,it) + &
	832	( 1 - frac_nucl(i,k) )*tr_seri(i,k,it)
	833	d_tr_lessi_impa(i,k,it) = d_tr_lessi_impa(i,k,it) + &
	834	( 1 - frac_impa(i,k) )*tr_seri(i,k,it)
	835	!
	836	! Flux lessivage total
	837	flestottr(i,k,it) = flestottr(i,k,it) - &
	838	( d_tr_lessi_nucl(i,k,it) + &
	839	d_tr_lessi_impa(i,k,it) ) * &
	840	( paprs(i,k)-paprs(i,k+1) ) / &
	841	(RG * pdtphys)
	842	!! Mise a jour des traceurs due a l'impaction,nucleation
	843	! tr_seri(i,k,it)=tr_seri(i,k,it)frac_impa(i,k)frac_nucl(i,k)
	844	!! calcul de la tendance liee au lessivage stratiforme
	845	! d_tr_ls(i,k,it)=tr_seri(i,k,it)*&
	846	! (1.-1./(frac_impa(i,k)*frac_nucl(i,k)))
	847	!--------------
	848	END DO
	849	END DO
	850	END IF
	851	END DO
	852	! ********* end modified old version
[1813]	853
[2146]	854	ELSE IF (iflag_lscav .EQ. 1) THEN ! frac_impa, frac_nucl
	855	! ********* old version
[1813]	856
[2146]	857	d_tr_lessi_nucl(:,:,:) = 0.
	858	d_tr_lessi_impa(:,:,:) = 0.
	859	flestottr(:,:,:) = 0.
	860	!=========================
	861	! LESSIVAGE LARGE SCALE :
	862	!=========================
[1813]	863
[2146]	864	! Tendance des aerosols nuclees et impactes
	865	! -----------------------------------------
	866	DO it = 1, nbtr
	867	IF (aerosol(it)) THEN
	868	DO k = 1, klev
	869	DO i = 1, klon
	870	d_tr_lessi_nucl(i,k,it) = d_tr_lessi_nucl(i,k,it) + &
	871	( 1 - frac_nucl(i,k) )*tr_seri(i,k,it)
	872	d_tr_lessi_impa(i,k,it) = d_tr_lessi_impa(i,k,it) + &
	873	( 1 - frac_impa(i,k) )*tr_seri(i,k,it)
[1813]	874
[2146]	875	!
	876	! Flux lessivage total
	877	! ------------------------------------------------------------
	878	flestottr(i,k,it) = flestottr(i,k,it) - &
	879	( d_tr_lessi_nucl(i,k,it) + &
	880	d_tr_lessi_impa(i,k,it) ) * &
	881	( paprs(i,k)-paprs(i,k+1) ) / &
	882	(RG * pdtphys)
	883	!
	884	! Mise a jour des traceurs due a l'impaction,nucleation
	885	! ----------------------------------------------------------------------
	886	tr_seri(i,k,it)=tr_seri(i,k,it)frac_impa(i,k)frac_nucl(i,k)
	887	END DO
	888	END DO
	889	END IF
	890	END DO
[1813]	891
[2146]	892	! ********* end old version
	893	ENDIF ! iflag_lscav . EQ. 1, 2, 3 or 4
	894	!
	895	END IF ! lessivage
	896
	897	!=============================================================
	898	! Ecriture des sorties
	899	!=============================================================
[1813]	900	#ifdef CPP_IOIPSL
[2146]	901	! INCLUDE "write_histrac.h"
[1813]	902	#endif
	903
[2146]	904	END SUBROUTINE phytrac
[1813]	905
	906	END MODULE

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

Download in other formats:

Original Format