Context Navigation

phytrac_mod.F90 @ 4218

Last change on this file since 4218 was 4170, checked in by dcugnet, 2 years ago
The variable "types_trac" is the equivalent of "type_trac" in case multiple sections must be read and used in "tracer.def" file. Tests on the "type_trac" were replaced with tests on the vector "types_trac". Most of the time, there are two components: 'lmdz' and a second one. The later has priority on 'lmdz' and must be used for the tests. For more components, care must be taken to execute specific parts of the code on the right tracers ; the tracers(:)%component has been created in that respect.
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 Property svn:keywords set to `Id`
File size: 45.5 KB

Rev	Line
[1877]	1	!$Id: phytrac_mod.F90 4170 2022-06-16 18:16:59Z lguez $
[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)
[3043]	51	!$OMP THREADPRIVATE(d_tr_cl,d_tr_dry,flux_tr_dry,d_tr_dec,d_tr_cv)
[1813]	52
	53
	54	CONTAINS
	55
[3465]	56	SUBROUTINE phytrac_init()
	57	USE dimphy
[4170]	58	USE infotrac_phy, ONLY: nbtr, types_trac
[3649]	59	USE tracco2i_mod, ONLY: tracco2i_init
[3465]	60	IMPLICIT NONE
	61
	62	ALLOCATE(d_tr_cl(klon,klev,nbtr),d_tr_dry(klon,nbtr))
	63	ALLOCATE(flux_tr_dry(klon,nbtr),d_tr_dec(klon,klev,nbtr),d_tr_cv(klon,klev,nbtr))
	64	ALLOCATE(d_tr_insc(klon,klev,nbtr),d_tr_bcscav(klon,klev,nbtr))
	65	ALLOCATE(d_tr_evapls(klon,klev,nbtr),d_tr_ls(klon,klev,nbtr))
	66	ALLOCATE(qPrls(klon,nbtr),d_tr_trsp(klon,klev,nbtr))
	67	ALLOCATE(d_tr_sscav(klon,klev,nbtr),d_tr_sat(klon,klev,nbtr))
	68	ALLOCATE(d_tr_uscav(klon,klev,nbtr),qPr(klon,klev,nbtr),qDi(klon,klev,nbtr))
	69	ALLOCATE(qPa(klon,klev,nbtr),qMel(klon,klev,nbtr))
	70	ALLOCATE(qTrdi(klon,klev,nbtr),dtrcvMA(klon,klev,nbtr))
	71	ALLOCATE(d_tr_th(klon,klev,nbtr))
	72	ALLOCATE(d_tr_lessi_impa(klon,klev,nbtr),d_tr_lessi_nucl(klon,klev,nbtr))
	73
[3649]	74
	75
	76	!===============================================================================
	77	! -- Do specific treatment according to chemestry model or local LMDZ tracers
	78	!
	79	!===============================================================================
[4170]	80	! -- CO2 interactif --
	81	IF(ANY(types_trac == 'co2i') .OR. ANY(types_trac == 'inco')) CALL tracco2i_init()
[3649]	82
	83
[3465]	84	END SUBROUTINE phytrac_init
	85
[2146]	86	SUBROUTINE phytrac( &
	87	nstep, julien, gmtime, debutphy, &
	88	lafin, pdtphys, u, v, t_seri, &
	89	paprs, pplay, pmfu, pmfd, &
	90	pen_u, pde_u, pen_d, pde_d, &
	91	cdragh, coefh, fm_therm, entr_therm, &
	92	yu1, yv1, ftsol, pctsrf, &
	93	ustar, u10m, v10m, &
	94	wstar, ale_bl, ale_wake, &
	95	xlat, xlon, &
	96	frac_impa,frac_nucl,beta_fisrt,beta_v1, &
	97	presnivs, pphis, pphi, albsol, &
[2784]	98	sh, ch, rh, cldfra, rneb, &
[2146]	99	diafra, cldliq, itop_con, ibas_con, &
	100	pmflxr, pmflxs, prfl, psfl, &
	101	da, phi, mp, upwd, &
	102	phi2, d1a, dam, sij, wght_cvfd, & ! RomP +RL
	103	wdtrainA, wdtrainM, sigd, clw, elij, & ! RomP
	104	evap, ep, epmlmMm, eplaMm, & ! RomP
	105	dnwd, aerosol_couple, flxmass_w, &
	106	tau_aero, piz_aero, cg_aero, ccm, &
	107	rfname, &
	108	d_tr_dyn, & ! RomP
[3418]	109	tr_seri, init_source)
[2146]	110	!
	111	!======================================================================
	112	! Auteur(s) FH
	113	! Objet: Moniteur general des tendances traceurs
	114	! Modification R. Pilon 01 janvier 2012 transport+scavenging KE scheme : cvltr
	115	! Modification R. Pilon 10 octobre 2012 large scale scavenging incloud_scav + bc_scav
	116	!======================================================================
[1813]	117
[2146]	118	USE ioipsl
	119	USE phys_cal_mod, only : hour
	120	USE dimphy
[4170]	121	USE infotrac_phy, ONLY: nbtr, nqCO2, types_trac, type_trac, conv_flg, pbl_flg
[4124]	122	USE strings_mod, ONLY: int2str
[2146]	123	USE mod_grid_phy_lmdz
	124	USE mod_phys_lmdz_para
	125	USE iophy
	126	USE traclmdz_mod
	127	USE tracinca_mod
	128	USE tracreprobus_mod
	129	USE indice_sol_mod
	130	USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
[2311]	131	USE print_control_mod, ONLY: lunout
[2394]	132	USE aero_mod, ONLY : naero_grp
[1813]	133
[3361]	134	USE tracco2i_mod
	135
[2690]	136	#ifdef CPP_StratAer
	137	USE traccoag_mod
[2752]	138	USE phys_local_var_mod, ONLY: mdw
[3100]	139	USE phys_local_var_mod, ONLY: budg_dep_dry_ocs, budg_dep_wet_ocs
	140	USE phys_local_var_mod, ONLY: budg_dep_dry_so2, budg_dep_wet_so2
[2752]	141	USE phys_local_var_mod, ONLY: budg_dep_dry_h2so4, budg_dep_wet_h2so4
	142	USE phys_local_var_mod, ONLY: budg_dep_dry_part, budg_dep_wet_part
[4056]	143	USE infotrac_phy, ONLY: nbtr_sulgas, id_OCS_strat, id_SO2_strat, id_H2SO4_strat
[2690]	144	USE aerophys
	145	#endif
	146
[2146]	147	IMPLICIT NONE
[1813]	148
[2146]	149	INCLUDE "YOMCST.h"
	150	INCLUDE "clesphys.h"
	151	!==========================================================================
	152	! -- ARGUMENT DESCRIPTION --
	153	!==========================================================================
[1813]	154
[2146]	155	! Input arguments
	156	!----------------
	157	!Configuration grille,temps:
	158	INTEGER,INTENT(IN) :: nstep ! Appel physique
	159	INTEGER,INTENT(IN) :: julien ! Jour julien
	160	REAL,INTENT(IN) :: gmtime ! Heure courante
	161	REAL,INTENT(IN) :: pdtphys ! Pas d'integration pour la physique (seconde)
	162	LOGICAL,INTENT(IN) :: debutphy ! le flag de l'initialisation de la physique
	163	LOGICAL,INTENT(IN) :: lafin ! le flag de la fin de la physique
[1813]	164
[2146]	165	REAL,DIMENSION(klon),INTENT(IN) :: xlat ! latitudes pour chaque point
	166	REAL,DIMENSION(klon),INTENT(IN) :: xlon ! longitudes pour chaque point
	167	!
	168	!Physique:
	169	!--------
	170	REAL,DIMENSION(klon,klev),INTENT(IN) :: t_seri ! Temperature
	171	REAL,DIMENSION(klon,klev),INTENT(IN) :: u ! variable not used
	172	REAL,DIMENSION(klon,klev),INTENT(IN) :: v ! variable not used
	173	REAL,DIMENSION(klon,klev),INTENT(IN) :: sh ! humidite specifique
	174	REAL,DIMENSION(klon,klev),INTENT(IN) :: rh ! humidite relative
[3861]	175	REAL,DIMENSION(klon,klev),INTENT(IN) :: ch ! eau liquide (+ glace si le traceur existe)
[2146]	176	REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs ! pression pour chaque inter-couche (en Pa)
	177	REAL,DIMENSION(klon,klev),INTENT(IN) :: pplay ! pression pour le mileu de chaque couche (en Pa)
	178	REAL,DIMENSION(klon,klev),INTENT(IN) :: pphi ! geopotentiel
	179	REAL,DIMENSION(klon),INTENT(IN) :: pphis
	180	REAL,DIMENSION(klev),INTENT(IN) :: presnivs
	181	REAL,DIMENSION(klon,klev),INTENT(IN) :: cldliq ! eau liquide nuageuse
	182	REAL,DIMENSION(klon,klev),INTENT(IN) :: cldfra ! fraction nuageuse (tous les nuages)
	183	REAL,DIMENSION(klon,klev),INTENT(IN) :: diafra ! fraction nuageuse (convection ou stratus artificiels)
	184	REAL,DIMENSION(klon,klev),INTENT(IN) :: rneb ! fraction nuageuse (grande echelle)
	185	!
	186	REAL :: ql_incl ! contenu en eau liquide nuageuse dans le nuage ! ql_incl=oliq/rneb
	187	REAL,DIMENSION(klon,klev),INTENT(IN) :: beta_fisrt ! taux de conversion de l'eau cond (de fisrtilp)
	188	REAL,DIMENSION(klon,klev),INTENT(out) :: beta_v1 ! -- (originale version)
[1813]	189
[2146]	190	!
	191	INTEGER,DIMENSION(klon),INTENT(IN) :: itop_con
	192	INTEGER,DIMENSION(klon),INTENT(IN) :: ibas_con
	193	REAL,DIMENSION(klon),INTENT(IN) :: albsol ! albedo surface
	194	!
	195	!Dynamique
	196	!--------
	197	REAL,DIMENSION(klon,klev,nbtr),INTENT(IN) :: d_tr_dyn
	198	!
	199	!Convection:
	200	!----------
	201	REAL,DIMENSION(klon,klev),INTENT(IN) :: pmfu ! flux de masse dans le panache montant
	202	REAL,DIMENSION(klon,klev),INTENT(IN) :: pmfd ! flux de masse dans le panache descendant
	203	REAL,DIMENSION(klon,klev),INTENT(IN) :: pen_u ! flux entraine dans le panache montant
	204	REAL,DIMENSION(klon,klev),INTENT(IN) :: pde_u ! flux detraine dans le panache montant
	205	REAL,DIMENSION(klon,klev),INTENT(IN) :: pen_d ! flux entraine dans le panache descendant
	206	REAL,DIMENSION(klon,klev),INTENT(IN) :: pde_d ! flux detraine dans le panache descendant
[1813]	207
[2146]	208	!...Tiedke
	209	REAL,DIMENSION(klon,klev+1),INTENT(IN) :: pmflxr, pmflxs ! Flux precipitant de pluie, neige aux interfaces [convection]
	210	REAL,DIMENSION(klon,klev+1),INTENT(IN) :: prfl, psfl ! Flux precipitant de pluie, neige aux interfaces [large-scale]
[1813]	211
[2146]	212	LOGICAL,INTENT(IN) :: aerosol_couple
	213	REAL,DIMENSION(klon,klev),INTENT(IN) :: flxmass_w
[2394]	214	REAL,DIMENSION(klon,klev,naero_grp,2),INTENT(IN) :: tau_aero
	215	REAL,DIMENSION(klon,klev,naero_grp,2),INTENT(IN) :: piz_aero
	216	REAL,DIMENSION(klon,klev,naero_grp,2),INTENT(IN) :: cg_aero
	217	CHARACTER(len=4),DIMENSION(naero_grp),INTENT(IN) :: rfname
[2146]	218	REAL,DIMENSION(klon,klev,2),INTENT(IN) :: ccm
	219	!... K.Emanuel
	220	REAL,DIMENSION(klon,klev),INTENT(IN) :: da
	221	REAL,DIMENSION(klon,klev,klev),INTENT(IN):: phi
	222	! RomP >>>
	223	REAL,DIMENSION(klon,klev),INTENT(IN) :: d1a,dam
	224	REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: phi2
	225	!
	226	REAL,DIMENSION(klon,klev),INTENT(IN) :: wdtrainA
	227	REAL,DIMENSION(klon,klev),INTENT(IN) :: wdtrainM
	228	REAL,DIMENSION(klon),INTENT(IN) :: sigd
	229	! ---- RomP flux entraine, detraine et precipitant kerry Emanuel
	230	REAL,DIMENSION(klon,klev),INTENT(IN) :: evap
	231	REAL,DIMENSION(klon,klev),INTENT(IN) :: ep
	232	REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: sij
	233	REAL,DIMENSION(klon,klev),INTENT(IN) :: wght_cvfd !RL
	234	REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: elij
	235	REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: epmlmMm
	236	REAL,DIMENSION(klon,klev),INTENT(IN) :: eplaMm
	237	REAL,DIMENSION(klon,klev),INTENT(IN) :: clw
	238	! RomP <<<
[1813]	239
[2146]	240	!
	241	REAL,DIMENSION(klon,klev),INTENT(IN) :: mp
	242	REAL,DIMENSION(klon,klev),INTENT(IN) :: upwd ! saturated updraft mass flux
	243	REAL,DIMENSION(klon,klev),INTENT(IN) :: dnwd ! saturated downdraft mass flux
	244	!
	245	!Thermiques:
	246	!----------
	247	REAL,DIMENSION(klon,klev+1),INTENT(IN) :: fm_therm
	248	REAL,DIMENSION(klon,klev),INTENT(IN) :: entr_therm
	249	!
	250	!Couche limite:
	251	!--------------
	252	!
	253	REAL,DIMENSION(:),INTENT(IN) :: cdragh ! (klon) coeff drag pour T et Q
	254	REAL,DIMENSION(:,:),INTENT(IN) :: coefh ! (klon,klev) coeff melange CL (m**2/s)
	255	REAL,DIMENSION(:),INTENT(IN) :: ustar,u10m,v10m ! (klon) u* & vent a 10m (m/s)
	256	REAL,DIMENSION(:),INTENT(IN) :: wstar,ale_bl,ale_wake ! (klon) w* and Avail. Lifting Ener.
	257	REAL,DIMENSION(:),INTENT(IN) :: yu1 ! (klon) vents au premier niveau
	258	REAL,DIMENSION(:),INTENT(IN) :: yv1 ! (klon) vents au premier niveau
	259	!
	260	!Lessivage:
	261	!----------
	262	!
	263	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: ccntrAA
	264	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: ccntrENV
	265	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: coefcoli
	266	LOGICAL, DIMENSION(:), ALLOCATABLE, SAVE :: flag_cvltr
	267	!$OMP THREADPRIVATE(ccntrAA,ccntrENV,coefcoli,flag_cvltr)
	268	REAL, DIMENSION(klon,klev) :: ccntrAA_3d
	269	REAL, DIMENSION(klon,klev) :: ccntrENV_3d
	270	REAL, DIMENSION(klon,klev) :: coefcoli_3d
	271	!
	272	! pour le ON-LINE
	273	!
	274	REAL,DIMENSION(klon,klev),INTENT(IN) :: frac_impa ! fraction d'aerosols non impactes
	275	REAL,DIMENSION(klon,klev),INTENT(IN) :: frac_nucl ! fraction d'aerosols non nuclees
[1813]	276
[2146]	277	! Arguments necessaires pour les sources et puits de traceur:
	278	REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: ftsol ! Temperature du sol (surf)(Kelvin)
	279	REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: pctsrf ! Pourcentage de sol (nature du sol)
[1813]	280
[2690]	281	#ifdef CPP_StratAer
	282	REAL,DIMENSION(klon) :: v_dep_dry !dry deposition velocity of stratospheric sulfate in m/s
	283	#endif
[2146]	284	! Output argument
	285	!----------------
	286	REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT) :: tr_seri ! Concentration Traceur [U/KgA]
	287	REAL,DIMENSION(klon,klev) :: sourceBE
[3418]	288	REAL,DIMENSION(klon,nbtr), INTENT(IN) :: init_source
[2690]	289
[2146]	290	!=======================================================================================
	291	! -- LOCAL VARIABLES --
	292	!=======================================================================================
	293
	294	INTEGER :: i, k, it
	295	INTEGER :: nsplit
	296
	297	!Sources et Reservoirs de traceurs (ex:Radon):
	298	!--------------------------------------------
	299	!
	300	REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: source ! a voir lorsque le flux de surface est prescrit
[1813]	301	!$OMP THREADPRIVATE(source)
	302
[2146]	303	!
[4011]	304	!Entrees/Sorties:
[2146]	305	!---------------
	306	INTEGER :: iiq, ierr
	307	INTEGER :: nhori, nvert
	308	REAL :: zsto, zout, zjulian
	309	INTEGER,SAVE :: nid_tra ! pointe vers le fichier histrac.nc
[1813]	310	!$OMP THREADPRIVATE(nid_tra)
[2146]	311	REAL,DIMENSION(klon) :: zx_tmp_fi2d ! variable temporaire grille physique
	312	INTEGER :: itau_w ! pas de temps ecriture = nstep + itau_phy
	313	LOGICAL,PARAMETER :: ok_sync=.TRUE.
	314	!
	315	! Nature du traceur
	316	!------------------
	317	LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: aerosol ! aerosol(it) = true => aerosol => lessivage
[1813]	318	!$OMP THREADPRIVATE(aerosol) ! aerosol(it) = false => gaz
[2146]	319	REAL,DIMENSION(klon,klev) :: delp ! epaisseur de couche (Pa)
	320	!
	321	! Tendances de traceurs (Td) et flux de traceurs:
	322	!------------------------
	323	REAL,DIMENSION(klon,klev) :: d_tr ! Td dans l'atmosphere
	324	REAL,DIMENSION(klon,klev) :: Mint
	325	REAL,DIMENSION(klon,klev,nbtr) :: zmfd1a
	326	REAL,DIMENSION(klon,klev,nbtr) :: zmfdam
	327	REAL,DIMENSION(klon,klev,nbtr) :: zmfphi2
	328	! Physique
	329	!----------
	330	REAL,DIMENSION(klon,klev,nbtr) :: flestottr ! flux de lessivage dans chaque couche
[4011]	331	REAL,DIMENSION(klon,klev) :: zmasse ! densite atmospherique Kg/m2
[2146]	332	REAL,DIMENSION(klon,klev) :: ztra_th
	333	!PhH
	334	REAL,DIMENSION(klon,klev) :: zrho
	335	REAL,DIMENSION(klon,klev) :: zdz
	336	REAL :: evaplsc,dx,beta ! variable pour lessivage Genthon
	337	REAL,DIMENSION(klon) :: his_dh ! ---
	338	! in-cloud scav variables
	339	REAL :: ql_incloud_ref ! ref value of in-cloud condensed water content
	340
	341	!Controles:
	342	!---------
	343	INTEGER,SAVE :: iflag_vdf_trac,iflag_con_trac,iflag_the_trac
	344	INTEGER,SAVE :: iflag_con_trac_omp, iflag_vdf_trac_omp,iflag_the_trac_omp
[1820]	345	!$OMP THREADPRIVATE(iflag_vdf_trac,iflag_con_trac,iflag_the_trac)
[1813]	346
[2146]	347	LOGICAL,SAVE :: lessivage
[1813]	348	!$OMP THREADPRIVATE(lessivage)
	349
[2146]	350	!RomP >>>
	351	INTEGER,SAVE :: iflag_lscav_omp,iflag_lscav
[2210]	352	REAL, SAVE :: ccntrAA_in,ccntrAA_omp
	353	REAL, SAVE :: ccntrENV_in,ccntrENV_omp
	354	REAL, SAVE :: coefcoli_in,coefcoli_omp
	355
[2146]	356	LOGICAL,SAVE :: convscav_omp,convscav
[1822]	357	!$OMP THREADPRIVATE(iflag_lscav)
[2210]	358	!$OMP THREADPRIVATE(ccntrAA_in,ccntrENV_in,coefcoli_in)
[1822]	359	!$OMP THREADPRIVATE(convscav)
[2146]	360	!RomP <<<
	361	!######################################################################
	362	! -- INITIALIZATION --
	363	!######################################################################
[1813]	364
[2146]	365	DO k=1,klev
	366	DO i=1,klon
	367	sourceBE(i,k)=0.
	368	Mint(i,k)=0.
	369	zrho(i,k)=0.
	370	zdz(i,k)=0.
	371	END DO
	372	END DO
[1813]	373
[2146]	374	DO it=1, nbtr
	375	DO k=1,klev
	376	DO i=1,klon
	377	d_tr_insc(i,k,it)=0.
	378	d_tr_bcscav(i,k,it)=0.
	379	d_tr_evapls(i,k,it)=0.
	380	d_tr_ls(i,k,it)=0.
	381	d_tr_cv(i,k,it)=0.
	382	d_tr_cl(i,k,it)=0.
	383	d_tr_trsp(i,k,it)=0.
	384	d_tr_sscav(i,k,it)=0.
	385	d_tr_sat(i,k,it)=0.
	386	d_tr_uscav(i,k,it)=0.
	387	d_tr_lessi_impa(i,k,it)=0.
	388	d_tr_lessi_nucl(i,k,it)=0.
	389	qDi(i,k,it)=0.
	390	qPr(i,k,it)=0.
	391	qPa(i,k,it)=0.
	392	qMel(i,k,it)=0.
	393	qTrdi(i,k,it)=0.
	394	dtrcvMA(i,k,it)=0.
	395	zmfd1a(i,k,it)=0.
	396	zmfdam(i,k,it)=0.
	397	zmfphi2(i,k,it)=0.
	398	END DO
	399	END DO
[1813]	400	END DO
[2146]	401
[2710]	402	DO it=1, nbtr
	403	DO i=1,klon
	404	d_tr_dry(i,it)=0.
	405	flux_tr_dry(i,it)=0.
	406	END DO
	407	END DO
	408
[2146]	409	DO k = 1, klev
	410	DO i = 1, klon
	411	delp(i,k) = paprs(i,k)-paprs(i,k+1)
	412	END DO
	413	END DO
	414
	415	IF (debutphy) THEN
	416	!!jyg
[1813]	417	!$OMP BARRIER
[2146]	418	ecrit_tra=86400. ! frequence de stokage en dur
	419	! obsolete car remplace par des ecritures dans phys_output_write
	420	!RomP >>>
	421	!
	422	!Config Key = convscav
	423	!Config Desc = Convective scavenging switch: 0=off, 1=on.
[3450]	424	!Config Def = .FALSE.
[2146]	425	!Config Help =
	426	!
[1813]	427	!$OMP MASTER
[3450]	428	convscav_omp=.FALSE.
[2146]	429	call getin('convscav', convscav_omp)
	430	iflag_vdf_trac_omp=1
	431	call getin('iflag_vdf_trac', iflag_vdf_trac_omp)
	432	iflag_con_trac_omp=1
	433	call getin('iflag_con_trac', iflag_con_trac_omp)
	434	iflag_the_trac_omp=1
	435	call getin('iflag_the_trac', iflag_the_trac_omp)
[1813]	436	!$OMP END MASTER
	437	!$OMP BARRIER
[2146]	438	convscav=convscav_omp
	439	iflag_vdf_trac=iflag_vdf_trac_omp
	440	iflag_con_trac=iflag_con_trac_omp
	441	iflag_the_trac=iflag_the_trac_omp
	442	write(lunout,*) 'phytrac passage dans routine conv avec lessivage', convscav
	443	!
	444	!Config Key = iflag_lscav
	445	!Config Desc = Large scale scavenging parametrization: 0=none, 1=old(Genthon92),
	446	! 2=1+PHeinrich, 3=Reddy_Boucher2004, 4=3+RPilon.
	447	!Config Def = 1
	448	!Config Help =
	449	!
[1813]	450	!$OMP MASTER
[2146]	451	iflag_lscav_omp=1
	452	call getin('iflag_lscav', iflag_lscav_omp)
[2210]	453	ccntrAA_omp=1
	454	ccntrENV_omp=1.
	455	coefcoli_omp=0.001
	456	call getin('ccntrAA', ccntrAA_omp)
	457	call getin('ccntrENV', ccntrENV_omp)
	458	call getin('coefcoli', coefcoli_omp)
[1813]	459	!$OMP END MASTER
	460	!$OMP BARRIER
[2146]	461	iflag_lscav=iflag_lscav_omp
[2210]	462	ccntrAA_in=ccntrAA_omp
	463	ccntrENV_in=ccntrENV_omp
	464	coefcoli_in=coefcoli_omp
[2146]	465	!
	466	SELECT CASE(iflag_lscav)
	467	CASE(0)
	468	WRITE(lunout,*) 'Large scale scavenging: none'
	469	CASE(1)
	470	WRITE(lunout,*) 'Large scale scavenging: C. Genthon, Tellus(1992), 44B, 371-389'
	471	CASE(2)
	472	WRITE(lunout,*) 'Large scale scavenging: C. Genthon, modified P. Heinrich'
	473	CASE(3)
	474	WRITE(lunout,*) 'Large scale scavenging: M. Shekkar Reddy and O. Boucher, JGR(2004), 109, D14202'
	475	CASE(4)
	476	WRITE(lunout,*) 'Large scale scavenging: Reddy and Boucher, modified R. Pilon'
	477	END SELECT
	478	!RomP <<<
	479	WRITE(,) 'FIRST TIME IN PHYTRAC : pdtphys(sec) = ',pdtphys,'ecrit_tra (sec) = ',ecrit_tra
	480	ALLOCATE( source(klon,nbtr), stat=ierr)
[2311]	481	IF (ierr /= 0) CALL abort_physic('phytrac', 'pb in allocation 1',1)
[1813]	482
[2146]	483	ALLOCATE( aerosol(nbtr), stat=ierr)
[2311]	484	IF (ierr /= 0) CALL abort_physic('phytrac', 'pb in allocation 2',1)
[2146]	485
	486
	487	! Initialize module for specific tracers
[4170]	488	IF(ANY(types_trac == 'inca')) THEN
[3418]	489	source(:,:)=init_source(:,:)
[2146]	490	CALL tracinca_init(aerosol,lessivage)
[4170]	491	ELSE IF(ANY(types_trac == 'repr')) THEN
[2146]	492	source(:,:)=0.
[4170]	493	ELSE IF(ANY(types_trac == 'co2i')) THEN
[3361]	494	source(:,:)=0.
[3450]	495	lessivage = .FALSE.
	496	aerosol(:) = .FALSE.
	497	pbl_flg(:) = 1
	498	iflag_the_trac= 1
	499	iflag_vdf_trac= 1
	500	iflag_con_trac= 1
[4170]	501	ELSE IF(ANY(types_trac == 'inco')) THEN
[4056]	502	source(:,1:nqCO2) = 0. ! from CO2i ModThL
	503	source(:,nqCO2+1:nbtr)=init_source(:,:) ! from INCA ModThL
	504	aerosol(1:nqCO2) = .FALSE. ! from CO2i ModThL
	505	CALL tracinca_init(aerosol(nqCO2+1:nbtr),lessivage) ! from INCA ModThL
	506	pbl_flg(1:nqCO2) = 1 ! From CO2i ModThL
	507	iflag_the_trac = 1 ! From CO2i
	508	iflag_vdf_trac = 1 ! From CO2i
	509	iflag_con_trac = 1 ! From CO2i
[2690]	510	#ifdef CPP_StratAer
[4170]	511	ELSE IF(ANY(types_trac == 'coag')) THEN
[2690]	512	source(:,:)=0.
	513	DO it= 1, nbtr_sulgas
	514	aerosol(it)=.FALSE.
	515	IF (it==id_H2SO4_strat) aerosol(it)=.TRUE.
	516	ENDDO
	517	DO it= nbtr_sulgas+1, nbtr
	518	aerosol(it)=.TRUE.
	519	ENDDO
	520	#endif
[4170]	521	ELSE IF(ANY(types_trac == 'lmdz')) THEN
	522	CALL traclmdz_init(pctsrf,xlat,xlon,ftsol,tr_seri,t_seri,pplay,sh,pdtphys,aerosol,lessivage)
	523	END IF
[2146]	524
	525	!
	526	!--initialising coefficients for scavenging in the case of NP
	527	!
	528	ALLOCATE(flag_cvltr(nbtr))
	529	IF (iflag_con.EQ.3) THEN
	530	!
	531	ALLOCATE(ccntrAA(nbtr))
	532	ALLOCATE(ccntrENV(nbtr))
	533	ALLOCATE(coefcoli(nbtr))
	534	!
	535	DO it=1, nbtr
[4170]	536	IF(ANY(types_trac == 'repr')) THEN
[3450]	537	flag_cvltr(it)=.FALSE.
[4170]	538	ELSE IF(ANY(types_trac == 'inca')) THEN
[2146]	539	! IF ((it.EQ.id_Rn222) .OR. ((it.GE.id_SO2) .AND. (it.LE.id_NH3)) ) THEN
	540	! !--gas-phase species
[3450]	541	! flag_cvltr(it)=.FALSE.
[1813]	542	!
[2146]	543	! ELSEIF ( (it.GE.id_CIDUSTM) .AND. (it.LE.id_AIN) ) THEN
	544	! !--insoluble aerosol species
[3450]	545	! flag_cvltr(it)=.TRUE.
[2146]	546	! ccntrAA(it)=0.7
	547	! ccntrENV(it)=0.7
	548	! coefcoli(it)=0.001
	549	! ELSEIF ( (it.EQ.id_Pb210) .OR. ((it.GE.id_CSSSM) .AND. (it.LE.id_SSN))) THEN
	550	! !--soluble aerosol species
[3450]	551	! flag_cvltr(it)=.TRUE.
[2146]	552	! ccntrAA(it)=0.9
	553	! ccntrENV(it)=0.9
	554	! coefcoli(it)=0.001
	555	! ELSE
	556	! WRITE(lunout,*) 'pb it=', it
[2311]	557	! CALL abort_physic('phytrac','pb it scavenging',1)
[2146]	558	! ENDIF
	559	!--test OB
	560	!--for now we do not scavenge in cvltr
[3450]	561	flag_cvltr(it)=.FALSE.
[4170]	562	ELSE IF(ANY(types_trac == 'co2i')) THEN
[3361]	563	!--co2 tracers are not scavenged
[3450]	564	flag_cvltr(it)=.FALSE.
[4170]	565	ELSE IF(ANY(types_trac == 'inco')) THEN ! Add ThL
[3865]	566	flag_cvltr(it)=.FALSE.
[2690]	567	#ifdef CPP_StratAer
[4170]	568	ELSE IF(ANY(types_trac == 'coag')) THEN
[2690]	569	IF (convscav.and.aerosol(it)) THEN
[3450]	570	flag_cvltr(it)=.TRUE.
[2690]	571	ccntrAA(it) =ccntrAA_in
	572	ccntrENV(it)=ccntrENV_in
	573	coefcoli(it)=coefcoli_in
	574	ELSE
[3450]	575	flag_cvltr(it)=.FALSE.
[2690]	576	ENDIF
	577	#endif
[4170]	578	ELSE IF(ANY(types_trac == 'lmdz')) THEN
	579	IF (convscav.and.aerosol(it)) THEN
	580	flag_cvltr(it)=.TRUE.
	581	ccntrAA(it) =ccntrAA_in !--a modifier par JYG a lire depuis fichier
	582	ccntrENV(it)=ccntrENV_in
	583	coefcoli(it)=coefcoli_in
	584	ELSE
	585	flag_cvltr(it)=.FALSE.
	586	ENDIF
	587	END IF
[2146]	588	ENDDO
	589	!
	590	ELSE ! iflag_con .ne. 3
[3450]	591	flag_cvltr(:) = .FALSE.
[2146]	592	ENDIF
	593	!
	594	! print out all tracer flags
	595	!
	596	WRITE(lunout,*) 'print out all tracer flags'
	597	WRITE(lunout,*) 'type_trac =', type_trac
	598	WRITE(lunout,*) 'config_inca =', config_inca
	599	WRITE(lunout,*) 'iflag_con_trac =', iflag_con_trac
	600	WRITE(lunout,*) 'iflag_con =', iflag_con
	601	WRITE(lunout,*) 'convscav =', convscav
	602	WRITE(lunout,*) 'iflag_lscav =', iflag_lscav
	603	WRITE(lunout,*) 'aerosol =', aerosol
	604	WRITE(lunout,*) 'iflag_the_trac =', iflag_the_trac
	605	WRITE(lunout,*) 'iflag_thermals =', iflag_thermals
	606	WRITE(lunout,*) 'iflag_vdf_trac =', iflag_vdf_trac
	607	WRITE(lunout,*) 'pbl_flg =', pbl_flg
	608	WRITE(lunout,*) 'lessivage =', lessivage
	609	write(lunout,*) 'flag_cvltr = ', flag_cvltr
[1813]	610
[4170]	611	IF (lessivage .AND. (ANY(types_trac == 'inca') .OR. ANY(types_trac=='inco'))) THEN ! Mod ThL
[2311]	612	CALL abort_physic('phytrac', 'lessivage=T config_inca=inca impossible',1)
[3531]	613	! STOP
[2146]	614	ENDIF
	615	!
[3450]	616	ENDIF ! of IF (debutphy)
[2146]	617	!############################################ END INITIALIZATION #######
[1813]	618
[2146]	619	DO k=1,klev
	620	DO i=1,klon
	621	zmasse(i,k)=(paprs(i,k)-paprs(i,k+1))/rg
	622	END DO
	623	END DO
	624	!
	625	IF (id_be .GT. 0) THEN
	626	DO k=1,klev
	627	DO i=1,klon
	628	sourceBE(i,k)=srcbe(i,k) !RomP -> pour sortie histrac
	629	END DO
	630	END DO
	631	ENDIF
[1813]	632
[2146]	633	!===============================================================================
	634	! -- Do specific treatment according to chemestry model or local LMDZ tracers
	635	!
	636	!===============================================================================
[4170]	637	IF(ANY(types_trac == 'inca')) THEN
[2146]	638	! -- CHIMIE INCA config_inca = aero or chem --
[2637]	639	! Appel fait en fin de phytrac pour avoir les emissions modifiees par
	640	! la couche limite et la convection avant le calcul de la chimie
[2690]	641
[4170]	642	ELSE IF(ANY(types_trac == 'repr')) THEN
[2146]	643	! -- CHIMIE REPROBUS --
	644	CALL tracreprobus(pdtphys, gmtime, debutphy, julien, &
	645	presnivs, xlat, xlon, pphis, pphi, &
	646	t_seri, pplay, paprs, sh , &
[2180]	647	tr_seri)
[1813]	648
[4170]	649	ELSE IF(ANY(types_trac == 'co2i')) THEN
[3361]	650	! -- CO2 interactif --
	651	! -- source is updated with FF and BB emissions
[3450]	652	! -- and net fluxes from ocean and orchidee
[3361]	653	! -- sign convention : positive into the atmosphere
[3450]	654
[3361]	655	CALL tracco2i(pdtphys, debutphy, &
	656	xlat, xlon, pphis, pphi, &
	657	t_seri, pplay, paprs, tr_seri, source)
[4170]	658	ELSE IF(ANY(types_trac == 'inco')) THEN ! Add ThL
[3865]	659	CALL tracco2i(pdtphys, debutphy, &
	660	xlat, xlon, pphis, pphi, &
	661	t_seri, pplay, paprs, tr_seri, source)
[3361]	662
[2690]	663	#ifdef CPP_StratAer
[4170]	664	ELSE IF(ANY(types_trac == 'coag')) THEN
[2690]	665	! --STRATOSPHERIC AER IN THE STRAT --
	666	CALL traccoag(pdtphys, gmtime, debutphy, julien, &
	667	presnivs, xlat, xlon, pphis, pphi, &
	668	t_seri, pplay, paprs, sh, rh , &
	669	tr_seri)
	670	#endif
[4170]	671	ELSE IF(ANY(types_trac == 'lmdz')) THEN
	672	! -- Traitement des traceurs avec traclmdz
	673	CALL traclmdz(nstep, julien, gmtime, pdtphys, t_seri, paprs, pplay, &
	674	cdragh, coefh, yu1, yv1, ftsol, pctsrf, xlat, xlon,iflag_vdf_trac>=0,sh, &
	675	rh, pphi, ustar, wstar, ale_bl, ale_wake, u10m, v10m, &
	676	tr_seri, source, d_tr_cl,d_tr_dec, zmasse) !RomP
	677	END IF
[2146]	678	!======================================================================
	679	! -- Calcul de l'effet de la convection --
	680	!======================================================================
[1813]	681
[2146]	682	IF (iflag_con_trac==1) THEN
[1813]	683
[2146]	684	DO it=1, nbtr
	685	IF ( conv_flg(it) == 0 ) CYCLE
	686	IF (iflag_con.LT.2) THEN
	687	!--pas de transport convectif
[2690]	688	d_tr_cv(:,:,it)=0.
[1813]	689
[2146]	690	ELSE IF (iflag_con.EQ.2) THEN
	691	!--ancien transport convectif de Tiedtke
[1813]	692
[2146]	693	CALL nflxtr(pdtphys, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
	694	pplay, paprs, tr_seri(:,:,it), d_tr_cv(:,:,it))
	695	ELSE
	696	!--nouveau transport convectif de Emanuel
[1813]	697
[2146]	698	IF (flag_cvltr(it)) THEN
	699	!--nouveau transport convectif de Emanuel avec lessivage convectif
	700	!
	701	!
	702	ccntrAA_3d(:,:) =ccntrAA(it)
	703	ccntrENV_3d(:,:)=ccntrENV(it)
	704	coefcoli_3d(:,:)=coefcoli(it)
[1813]	705
[2146]	706	!--beware this interface is a bit weird because it is called for each tracer
	707	!--with the full array tr_seri even if only item it is processed
[1813]	708
[2210]	709	print*,'CV SCAV ',it,ccntrAA(it),ccntrENV(it)
	710
[2146]	711	CALL cvltr_scav(pdtphys, da, phi,phi2,d1a,dam, mp,ep, &
	712	sigd,sij,wght_cvfd,clw,elij,epmlmMm,eplaMm, &
	713	pmflxr,pmflxs,evap,t_seri,wdtrainA,wdtrainM, &
	714	paprs,it,tr_seri,upwd,dnwd,itop_con,ibas_con, &
	715	ccntrAA_3d,ccntrENV_3d,coefcoli_3d, &
	716	d_tr_cv,d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav,qDi,qPr,&
	717	qPa,qMel,qTrdi,dtrcvMA,Mint, &
	718	zmfd1a,zmfphi2,zmfdam)
[1813]	719
[2146]	720
	721	ELSE !---flag_cvltr(it).EQ.FALSE
	722	!--nouveau transport convectif de Emanuel mais pas de lessivage convectif
	723
	724	!--beware this interface is a bit weird because it is called for each tracer
	725	!--with the full array tr_seri even if only item it is processed
	726	!
	727	CALL cvltr_noscav(it,pdtphys, da, phi,mp,wght_cvfd,paprs,pplay, & !jyg
	728	tr_seri,upwd,dnwd,d_tr_cv) !jyg
	729
	730	ENDIF
	731
	732	ENDIF !--iflag
	733
	734	!--on ajoute les tendances
	735
	736	DO k = 1, klev
	737	DO i = 1, klon
	738	tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_cv(i,k,it)
	739	END DO
	740	END DO
	741
[4124]	742	CALL minmaxqfi(tr_seri(:,:,it),0.,1.e33,'convection it = '//TRIM(int2str(it)))
[2146]	743
	744	END DO ! nbtr
	745
[2690]	746	#ifdef CPP_StratAer
[4170]	747	IF (ANY(types_trac=='coag')) THEN
[2690]	748	! initialize wet deposition flux of sulfur
[3100]	749	budg_dep_wet_ocs(:)=0.0
	750	budg_dep_wet_so2(:)=0.0
[2752]	751	budg_dep_wet_h2so4(:)=0.0
	752	budg_dep_wet_part(:)=0.0
[2690]	753	! compute wet deposition flux of sulfur (sum over gases and particles)
	754	! and convert to kg(S)/m2/s
	755	DO i = 1, klon
	756	DO k = 1, klev
	757	DO it = 1, nbtr
	758	!do not include SO2 because most of it comes trom the troposphere
[3100]	759	IF (it==id_OCS_strat) THEN
	760	budg_dep_wet_ocs(i)=budg_dep_wet_ocs(i)+d_tr_cv(i,k,it)*(mSatom/mOCSmol) &
	761	& *(paprs(i,k)-paprs(i,k+1))/RG/pdtphys
	762	ELSEIF (it==id_SO2_strat) THEN
	763	budg_dep_wet_so2(i)=budg_dep_wet_so2(i)+d_tr_cv(i,k,it)*(mSatom/mSO2mol) &
	764	& *(paprs(i,k)-paprs(i,k+1))/RG/pdtphys
	765	ELSEIF (it==id_H2SO4_strat) THEN
[2752]	766	budg_dep_wet_h2so4(i)=budg_dep_wet_h2so4(i)+d_tr_cv(i,k,it)*(mSatom/mH2SO4mol) &
[2690]	767	& *(paprs(i,k)-paprs(i,k+1))/RG/pdtphys
	768	ELSEIF (it.GT.nbtr_sulgas) THEN
[2752]	769	budg_dep_wet_part(i)=budg_dep_wet_part(i)+d_tr_cv(i,k,it)*(mSatom/mH2SO4mol) &
[2690]	770	& dens_aer_dry4./3.RPI(mdw(it-nbtr_sulgas)/2.)**3 &
	771	& *(paprs(i,k)-paprs(i,k+1))/RG/pdtphys
	772	ENDIF
	773	ENDDO
	774	ENDDO
	775	ENDDO
	776	ENDIF
	777	#endif
	778
[3450]	779	ENDIF ! convection
[2146]	780
	781	!======================================================================
	782	! -- Calcul de l'effet des thermiques --
	783	!======================================================================
	784
[1813]	785	DO it=1,nbtr
[2146]	786	DO k=1,klev
	787	DO i=1,klon
	788	d_tr_th(i,k,it)=0.
	789	tr_seri(i,k,it)=MAX(tr_seri(i,k,it),0.)
[3099]	790	! the next safeguard causes some problem for stratospheric aerosol tracers (particle number)
[3109]	791	! and there is little justification for it so it is commented out (4 December 2017) by OB
	792	! if reinstated please keep the ifndef CPP_StratAer
	793	!#ifndef CPP_StratAer
	794	! tr_seri(i,k,it)=MIN(tr_seri(i,k,it),1.e10)
	795	!#endif
[2146]	796	END DO
	797	END DO
	798	END DO
[1813]	799
[2146]	800	IF (iflag_thermals.GT.0.AND.iflag_the_trac>0) THEN
[1813]	801
[2146]	802	DO it=1, nbtr
[1813]	803
[2146]	804	CALL thermcell_dq(klon,klev,1,pdtphys,fm_therm,entr_therm, &
	805	zmasse,tr_seri(1:klon,1:klev,it), &
	806	d_tr_th(1:klon,1:klev,it),ztra_th,0 )
[1813]	807
[2146]	808	DO k=1,klev
	809	DO i=1,klon
	810	d_tr_th(i,k,it)=pdtphys*d_tr_th(i,k,it)
	811	tr_seri(i,k,it)=MAX(tr_seri(i,k,it)+d_tr_th(i,k,it),0.)
	812	END DO
	813	END DO
[1813]	814
[2146]	815	END DO ! it
[1813]	816
[3450]	817	ENDIF ! Thermiques
[1813]	818
[2146]	819	!======================================================================
	820	! -- Calcul de l'effet de la couche limite --
	821	!======================================================================
	822
	823	IF (iflag_vdf_trac==1) THEN
	824
	825	! Injection during BL mixing
	826	!
[2690]	827	#ifdef CPP_StratAer
[4170]	828	IF (ANY(types_trac=='coag')) THEN
[2690]	829
	830	! initialize dry deposition flux of sulfur
[3100]	831	budg_dep_dry_ocs(:)=0.0
	832	budg_dep_dry_so2(:)=0.0
[2752]	833	budg_dep_dry_h2so4(:)=0.0
	834	budg_dep_dry_part(:)=0.0
[2690]	835
	836	! compute dry deposition velocity as function of surface type (numbers
	837	! from IPSL note 23, 2002)
	838	v_dep_dry(:) = pctsrf(:,is_ter) * 2.5e-3 &
	839	& + pctsrf(:,is_oce) * 0.5e-3 &
	840	& + pctsrf(:,is_lic) * 2.5e-3 &
	841	& + pctsrf(:,is_sic) * 2.5e-3
	842
	843	! compute surface dry deposition flux
	844	zrho(:,1)=pplay(:,1)/t_seri(:,1)/RD
	845
	846	DO it=1, nbtr
	847	source(:,it) = - v_dep_dry(:) * tr_seri(:,1,it) * zrho(:,1)
	848	ENDDO
	849
	850	ENDIF
	851	#endif
	852
[2146]	853	DO it=1, nbtr
	854	!
	855	IF( pbl_flg(it) /= 0 ) THEN
	856	!
	857	CALL cltrac(pdtphys, coefh,t_seri, &
	858	tr_seri(:,:,it), source(:,it), &
	859	paprs, pplay, delp, &
	860	d_tr_cl(:,:,it),d_tr_dry(:,it),flux_tr_dry(:,it))
	861	!
	862	tr_seri(:,:,it)=tr_seri(:,:,it)+d_tr_cl(:,:,it)
	863	!
[2690]	864	#ifdef CPP_StratAer
[4170]	865	IF (ANY(types_trac=='coag')) THEN
[2690]	866	! compute dry deposition flux of sulfur (sum over gases and particles)
[3100]	867	IF (it==id_OCS_strat) THEN
	868	budg_dep_dry_ocs(:)=budg_dep_dry_ocs(:)-source(:,it)*(mSatom/mOCSmol)
	869	ELSEIF (it==id_SO2_strat) THEN
	870	budg_dep_dry_so2(:)=budg_dep_dry_so2(:)-source(:,it)*(mSatom/mSO2mol)
	871	ELSEIF (it==id_H2SO4_strat) THEN
[2752]	872	budg_dep_dry_h2so4(:)=budg_dep_dry_h2so4(:)-source(:,it)*(mSatom/mH2SO4mol)
[2690]	873	ELSEIF (it.GT.nbtr_sulgas) THEN
[2752]	874	budg_dep_dry_part(:)=budg_dep_dry_part(:)-source(:,it)(mSatom/mH2SO4mol)dens_aer_dry &
[2690]	875	& 4./3.RPI(mdw(it-nbtr_sulgas)/2.)*3
	876	ENDIF
	877	ENDIF
	878	#endif
	879	!
	880	ENDIF
[2146]	881	!
[2690]	882	ENDDO
[2146]	883	!
	884	ELSE IF (iflag_vdf_trac==0) THEN
	885	!
	886	! Injection of source in the first model layer
	887	!
	888	DO it=1,nbtr
	889	d_tr_cl(:,1,it)=source(:,it)RG/delp(:,1)pdtphys
	890	tr_seri(:,1,it)=tr_seri(:,1,it)+d_tr_cl(:,1,it)
	891	ENDDO
	892	d_tr_cl(:,2:klev,1:nbtr)=0.
	893	!
	894	ELSE IF (iflag_vdf_trac==-1) THEN
	895	!
	896	! Nothing happens
	897	d_tr_cl=0.
	898	!
	899	ELSE
	900	!
[2311]	901	CALL abort_physic('iflag_vdf_trac', 'cas non prevu',1)
[2146]	902	!
[3450]	903	ENDIF ! couche limite
[2146]	904
	905	!======================================================================
	906	! Calcul de l'effet de la precipitation grande echelle
	907	! POUR INCA le lessivage est fait directement dans INCA
	908	!======================================================================
	909
	910	IF (lessivage) THEN
	911
	912	ql_incloud_ref = 10.e-4
	913	ql_incloud_ref = 5.e-4
	914
	915
	916	! calcul du contenu en eau liquide au sein du nuage
	917	ql_incl = ql_incloud_ref
	918	! choix du lessivage
	919	!
	920	IF (iflag_lscav .EQ. 3 .OR. iflag_lscav .EQ. 4) THEN
	921	! ******** Olivier Boucher version (3) possibly with modified ql_incl (4)
	922	!
	923	DO it = 1, nbtr
[2210]	924
	925	IF (aerosol(it)) THEN
[2146]	926	! incloud scavenging and removal by large scale rain ! orig : ql_incl was replaced by 0.5e-3 kg/kg
	927	! the value 0.5e-3 kg/kg is from Giorgi and Chameides (1986), JGR
	928	! Liu (2001) proposed to use 1.5e-3 kg/kg
	929
[2284]	930	!jyg<
	931	!! CALL lsc_scav(pdtphys,it,iflag_lscav,ql_incl,prfl,psfl,rneb,beta_fisrt, &
	932	CALL lsc_scav(pdtphys,it,iflag_lscav,aerosol,ql_incl,prfl,psfl,rneb,beta_fisrt, &
	933	!>jyg
[1813]	934	beta_v1,pplay,paprs,t_seri,tr_seri,d_tr_insc, &
	935	d_tr_bcscav,d_tr_evapls,qPrls)
	936
[2146]	937	!large scale scavenging tendency
	938	DO k = 1, klev
	939	DO i = 1, klon
	940	d_tr_ls(i,k,it)=d_tr_insc(i,k,it)+d_tr_bcscav(i,k,it)+d_tr_evapls(i,k,it)
	941	tr_seri(i,k,it)=tr_seri(i,k,it)+d_tr_ls(i,k,it)
	942	ENDDO
	943	ENDDO
[4124]	944	CALL minmaxqfi(tr_seri(:,:,it),0.,1.e33,'lsc scav it = '//TRIM(int2str(it)))
[2210]	945	ENDIF
	946
[2146]	947	END DO !tr
[1813]	948
[2690]	949	#ifdef CPP_StratAer
[4170]	950	IF (ANY(types_trac=='coag')) THEN
[2690]	951	! compute wet deposition flux of sulfur (sum over gases and
	952	! particles) and convert to kg(S)/m2/s
	953	! adding contribution of d_tr_ls to d_tr_cv (above)
	954	DO i = 1, klon
	955	DO k = 1, klev
	956	DO it = 1, nbtr
[3100]	957	IF (it==id_OCS_strat) THEN
	958	budg_dep_wet_ocs(i)=budg_dep_wet_ocs(i)+d_tr_ls(i,k,it)*(mSatom/mOCSmol) &
	959	& *(paprs(i,k)-paprs(i,k+1))/RG/pdtphys
	960	ELSEIF (it==id_SO2_strat) THEN
	961	budg_dep_wet_so2(i)=budg_dep_wet_so2(i)+d_tr_ls(i,k,it)*(mSatom/mSO2mol) &
	962	& *(paprs(i,k)-paprs(i,k+1))/RG/pdtphys
	963	ELSEIF (it==id_H2SO4_strat) THEN
[2752]	964	budg_dep_wet_h2so4(i)=budg_dep_wet_h2so4(i)+d_tr_ls(i,k,it)*(mSatom/mH2SO4mol) &
[2690]	965	& *(paprs(i,k)-paprs(i,k+1))/RG/pdtphys
	966	ELSEIF (it.GT.nbtr_sulgas) THEN
[2752]	967	budg_dep_wet_part(i)=budg_dep_wet_part(i)+d_tr_ls(i,k,it)*(mSatom/mH2SO4mol) &
[2690]	968	& dens_aer_dry4./3.RPI(mdw(it-nbtr_sulgas)/2.)**3 &
	969	& *(paprs(i,k)-paprs(i,k+1))/RG/pdtphys
	970	ENDIF
	971	ENDDO
	972	ENDDO
	973	ENDDO
	974	ENDIF
	975	#endif
	976
[2146]	977	ELSE IF (iflag_lscav .EQ. 2) THEN ! frac_impa, frac_nucl
	978	! ********* modified old version
[1813]	979
[2146]	980	d_tr_lessi_nucl(:,:,:) = 0.
	981	d_tr_lessi_impa(:,:,:) = 0.
	982	flestottr(:,:,:) = 0.
	983	! Tendance des aerosols nuclees et impactes
	984	DO it = 1, nbtr
	985	IF (aerosol(it)) THEN
	986	his_dh(:)=0.
	987	DO k = 1, klev
	988	DO i = 1, klon
	989	!PhH
	990	zrho(i,k)=pplay(i,k)/t_seri(i,k)/RD
	991	zdz(i,k)=(paprs(i,k)-paprs(i,k+1))/zrho(i,k)/RG
	992	!
[3450]	993	ENDDO
	994	ENDDO
[1813]	995
[2146]	996	DO k=klev-1, 1, -1
	997	DO i=1, klon
	998	! d_tr_ls(i,k,it)=tr_seri(i,k,it)(frac_impa(i,k)frac_nucl(i,k)-1.)
	999	dx=d_tr_ls(i,k,it)
	1000	his_dh(i)=his_dh(i)-dxzrho(i,k)zdz(i,k)/pdtphys ! kg/m2/s
	1001	evaplsc = prfl(i,k) - prfl(i,k+1) + psfl(i,k) - psfl(i,k+1)
	1002	! Evaporation Partielle -> Liberation Partielle 0.5*evap
	1003	IF ( evaplsc .LT.0..and.abs(prfl(i,k+1)+psfl(i,k+1)).gt.1.e-10) THEN
	1004	evaplsc = (-evaplsc)/(prfl(i,k+1)+psfl(i,k+1))
	1005	! evaplsc est donc positif, his_dh(i) est positif
	1006	!--------------
	1007	d_tr_evapls(i,k,it)=0.5evaplsc(d_tr_lessi_nucl(i,k+1,it) &
	1008	+d_tr_lessi_impa(i,k+1,it))
	1009	!------------- d_tr_evapls(i,k,it)=-0.5evaplsc(d_tr_lsc(i,k+1,it))
	1010	beta=0.5*evaplsc
	1011	if ((prfl(i,k)+psfl(i,k)).lt.1.e-10) THEN
	1012	beta=1.0*evaplsc
	1013	endif
	1014	dx=betahis_dh(i)/zrho(i,k)/zdz(i,k)pdtphys
	1015	his_dh(i)=(1.-beta)*his_dh(i) ! tracer from
	1016	d_tr_evapls(i,k,it)=dx
	1017	ENDIF
	1018	d_tr_ls(i,k,it)=tr_seri(i,k,it)(frac_impa(i,k)frac_nucl(i,k)-1.) &
	1019	+d_tr_evapls(i,k,it)
[1813]	1020
[2146]	1021	!--------------
	1022	d_tr_lessi_nucl(i,k,it) = d_tr_lessi_nucl(i,k,it) + &
	1023	( 1 - frac_nucl(i,k) )*tr_seri(i,k,it)
	1024	d_tr_lessi_impa(i,k,it) = d_tr_lessi_impa(i,k,it) + &
	1025	( 1 - frac_impa(i,k) )*tr_seri(i,k,it)
	1026	!
	1027	! Flux lessivage total
	1028	flestottr(i,k,it) = flestottr(i,k,it) - &
	1029	( d_tr_lessi_nucl(i,k,it) + &
	1030	d_tr_lessi_impa(i,k,it) ) * &
	1031	( paprs(i,k)-paprs(i,k+1) ) / &
	1032	(RG * pdtphys)
	1033	!! Mise a jour des traceurs due a l'impaction,nucleation
	1034	! tr_seri(i,k,it)=tr_seri(i,k,it)frac_impa(i,k)frac_nucl(i,k)
	1035	!! calcul de la tendance liee au lessivage stratiforme
	1036	! d_tr_ls(i,k,it)=tr_seri(i,k,it)*&
	1037	! (1.-1./(frac_impa(i,k)*frac_nucl(i,k)))
	1038	!--------------
[3450]	1039	ENDDO
	1040	ENDDO
	1041	ENDIF
	1042	ENDDO
[2146]	1043	! ********* end modified old version
[1813]	1044
[2146]	1045	ELSE IF (iflag_lscav .EQ. 1) THEN ! frac_impa, frac_nucl
	1046	! ********* old version
[1813]	1047
[2146]	1048	d_tr_lessi_nucl(:,:,:) = 0.
	1049	d_tr_lessi_impa(:,:,:) = 0.
	1050	flestottr(:,:,:) = 0.
	1051	!=========================
	1052	! LESSIVAGE LARGE SCALE :
	1053	!=========================
[1813]	1054
[2146]	1055	! Tendance des aerosols nuclees et impactes
	1056	! -----------------------------------------
	1057	DO it = 1, nbtr
	1058	IF (aerosol(it)) THEN
	1059	DO k = 1, klev
	1060	DO i = 1, klon
	1061	d_tr_lessi_nucl(i,k,it) = d_tr_lessi_nucl(i,k,it) + &
	1062	( 1 - frac_nucl(i,k) )*tr_seri(i,k,it)
	1063	d_tr_lessi_impa(i,k,it) = d_tr_lessi_impa(i,k,it) + &
	1064	( 1 - frac_impa(i,k) )*tr_seri(i,k,it)
[1813]	1065
[2146]	1066	!
	1067	! Flux lessivage total
	1068	! ------------------------------------------------------------
	1069	flestottr(i,k,it) = flestottr(i,k,it) - &
	1070	( d_tr_lessi_nucl(i,k,it) + &
	1071	d_tr_lessi_impa(i,k,it) ) * &
	1072	( paprs(i,k)-paprs(i,k+1) ) / &
	1073	(RG * pdtphys)
	1074	!
	1075	! Mise a jour des traceurs due a l'impaction,nucleation
	1076	! ----------------------------------------------------------------------
	1077	tr_seri(i,k,it)=tr_seri(i,k,it)frac_impa(i,k)frac_nucl(i,k)
[3450]	1078	ENDDO
	1079	ENDDO
	1080	ENDIF
	1081	ENDDO
[1813]	1082
[2146]	1083	! ********* end old version
	1084	ENDIF ! iflag_lscav . EQ. 1, 2, 3 or 4
	1085	!
[3450]	1086	ENDIF ! lessivage
[2146]	1087
[2637]	1088
	1089	! -- CHIMIE INCA config_inca = aero or chem --
[4170]	1090	IF (ANY(types_trac == 'inca') .OR. ANY(types_trac == 'inco')) THEN ! ModThL
[2637]	1091
	1092	CALL tracinca(&
	1093	nstep, julien, gmtime, lafin, &
	1094	pdtphys, t_seri, paprs, pplay, &
	1095	pmfu, upwd, ftsol, pctsrf, pphis, &
[2784]	1096	pphi, albsol, sh, ch, rh, &
[2637]	1097	cldfra, rneb, diafra, cldliq, &
	1098	itop_con, ibas_con, pmflxr, pmflxs, &
	1099	prfl, psfl, aerosol_couple, flxmass_w, &
	1100	tau_aero, piz_aero, cg_aero, ccm, &
	1101	rfname, &
[3870]	1102	tr_seri(:,:,1+nqCO2:nbtr), source(:,1+nqCO2:nbtr)) ! ModThL
[2637]	1103	ENDIF
[1813]	1104
[2146]	1105	END SUBROUTINE phytrac
[1813]	1106
	1107	END MODULE

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

Download in other formats:

Original Format