Context Navigation

phytrac.F90 @ 1691

Last change on this file since 1691 was 1670, checked in by idelkadi, 12 years ago

Modifications for inclusion of chimere dust emission module :
u* is passed from the boundary layer parameterization to the physics
main routine (physiq.F) and then to phytrac, traclmdz and change_srf_frac.
The interface of traclmdz is enriched with 4 other variables.
Also u* and the vertically cumulated amount of tracers is added in the
outputs.

Modifications pour l'inclusion du module d'émission de poussière de Chimere :
u* est passé depuis la couche limite vers le programme principal de la
physique (physiq.F) et ensuite à phytrac, traclmdz et change_srf_frac.
L'interface de traclmdz est enrichie avec 4 autres variables.
Les variables u* et les cumuls verticaux des traceurs sont ajoutés
dans les sorties.

Property svn:eol-style set to native
Property svn:keywords set to Author Date Id Revision

File size: 15.5 KB

Rev	Line
[1191]	1	!$Id $
	2
	3	SUBROUTINE phytrac( &
	4	nstep, julien, gmtime, debutphy, &
	5	lafin, pdtphys, u, v, t_seri, &
	6	paprs, pplay, pmfu, pmfd, &
	7	pen_u, pde_u, pen_d, pde_d, &
	8	cdragh, coefh, fm_therm, entr_therm,&
	9	yu1, yv1, ftsol, pctsrf, &
[1670]	10	ustar, u10m, v10m, &
[1191]	11	xlat, frac_impa,frac_nucl,xlon, &
	12	presnivs, pphis, pphi, albsol, &
	13	sh, rh, cldfra, rneb, &
	14	diafra, cldliq, itop_con, ibas_con, &
	15	pmflxr, pmflxs, prfl, psfl, &
	16	da, phi, mp, upwd, &
	17	dnwd, aerosol_couple, flxmass_w, &
	18	tau_aero, piz_aero, cg_aero, ccm, &
	19	rfname, &
	20	tr_seri)
[524]	21	!
[1191]	22	!======================================================================
	23	! Auteur(s) FH
	24	! Objet: Moniteur general des tendances traceurs
	25	!======================================================================
[524]	26
[1191]	27	USE ioipsl
	28	USE dimphy
	29	USE infotrac
	30	USE mod_grid_phy_lmdz
	31	USE mod_phys_lmdz_para
	32	USE comgeomphy
	33	USE iophy
	34	USE traclmdz_mod
	35	USE tracinca_mod
[1565]	36	USE tracreprobus_mod
[1403]	37	USE control_mod
[524]	38
	39
[1191]	40	IMPLICIT NONE
[959]	41
[1191]	42	INCLUDE "YOMCST.h"
	43	INCLUDE "dimensions.h"
	44	INCLUDE "indicesol.h"
	45	INCLUDE "clesphys.h"
	46	INCLUDE "temps.h"
	47	INCLUDE "paramet.h"
	48	INCLUDE "thermcell.h"
[1575]	49	INCLUDE "iniprint.h"
[1191]	50	!==========================================================================
	51	! -- ARGUMENT DESCRIPTION --
	52	!==========================================================================
[541]	53
[1191]	54	! Input arguments
	55	!----------------
	56	!Configuration grille,temps:
	57	INTEGER,INTENT(IN) :: nstep ! Appel physique
	58	INTEGER,INTENT(IN) :: julien ! Jour julien
[1565]	59	REAL,INTENT(IN) :: gmtime ! Heure courante
[1191]	60	REAL,INTENT(IN) :: pdtphys ! Pas d'integration pour la physique (seconde)
	61	LOGICAL,INTENT(IN) :: debutphy ! le flag de l'initialisation de la physique
	62	LOGICAL,INTENT(IN) :: lafin ! le flag de la fin de la physique
	63
	64	REAL,DIMENSION(klon),INTENT(IN) :: xlat ! latitudes pour chaque point
	65	REAL,DIMENSION(klon),INTENT(IN) :: xlon ! longitudes pour chaque point
	66	!
	67	!Physique:
	68	!--------
	69	REAL,DIMENSION(klon,klev),INTENT(IN) :: t_seri ! Temperature
[1454]	70	REAL,DIMENSION(klon,klev),INTENT(IN) :: u ! variable not used
	71	REAL,DIMENSION(klon,klev),INTENT(IN) :: v ! variable not used
[1191]	72	REAL,DIMENSION(klon,klev),INTENT(IN) :: sh ! humidite specifique
	73	REAL,DIMENSION(klon,klev),INTENT(IN) :: rh ! humidite relative
	74	REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs ! pression pour chaque inter-couche (en Pa)
	75	REAL,DIMENSION(klon,klev),INTENT(IN) :: pplay ! pression pour le mileu de chaque couche (en Pa)
	76	REAL,DIMENSION(klon,klev),INTENT(IN) :: pphi ! geopotentiel
	77	REAL,DIMENSION(klon),INTENT(IN) :: pphis
	78	REAL,DIMENSION(klev),INTENT(IN) :: presnivs
	79	REAL,DIMENSION(klon,klev),INTENT(IN) :: cldliq ! eau liquide nuageuse
	80	REAL,DIMENSION(klon,klev),INTENT(IN) :: cldfra ! fraction nuageuse (tous les nuages)
	81	REAL,DIMENSION(klon,klev),INTENT(IN) :: diafra ! fraction nuageuse (convection ou stratus artificiels)
	82	REAL,DIMENSION(klon,klev),INTENT(IN) :: rneb ! fraction nuageuse (grande echelle)
	83	INTEGER,DIMENSION(klon),INTENT(IN) :: itop_con
	84	INTEGER,DIMENSION(klon),INTENT(IN) :: ibas_con
	85	REAL,DIMENSION(klon),INTENT(IN) :: albsol ! albedo surface
	86	!
	87	!Convection:
	88	!----------
	89	REAL,DIMENSION(klon,klev),INTENT(IN) :: pmfu ! flux de masse dans le panache montant
	90	REAL,DIMENSION(klon,klev),INTENT(IN) :: pmfd ! flux de masse dans le panache descendant
	91	REAL,DIMENSION(klon,klev),INTENT(IN) :: pen_u ! flux entraine dans le panache montant
	92	REAL,DIMENSION(klon,klev),INTENT(IN) :: pde_u ! flux detraine dans le panache montant
	93	REAL,DIMENSION(klon,klev),INTENT(IN) :: pen_d ! flux entraine dans le panache descendant
	94	REAL,DIMENSION(klon,klev),INTENT(IN) :: pde_d ! flux detraine dans le panache descendant
[619]	95
[1191]	96	!...Tiedke
	97	REAL,DIMENSION(klon,klev+1),INTENT(IN) :: pmflxr, pmflxs ! Flux precipitant de pluie, neige aux interfaces [convection]
	98	REAL,DIMENSION(klon,klev+1),INTENT(IN) :: prfl, psfl ! Flux precipitant de pluie, neige aux interfaces [large-scale]
[524]	99
[1191]	100	LOGICAL,INTENT(IN) :: aerosol_couple
	101	REAL,DIMENSION(klon,klev),INTENT(IN) :: flxmass_w
	102	REAL,DIMENSION(klon,klev,9,2),INTENT(IN) :: tau_aero
	103	REAL,DIMENSION(klon,klev,9,2),INTENT(IN) :: piz_aero
	104	REAL,DIMENSION(klon,klev,9,2),INTENT(IN) :: cg_aero
	105	CHARACTER(len=4),DIMENSION(9),INTENT(IN) :: rfname
	106	REAL,DIMENSION(klon,klev,2),INTENT(IN) :: ccm
	107	!... K.Emanuel
	108	REAL,DIMENSION(klon,klev),INTENT(IN) :: da
	109	REAL,DIMENSION(klon,klev,klev),INTENT(IN):: phi
	110	REAL,DIMENSION(klon,klev),INTENT(IN) :: mp
	111	REAL,DIMENSION(klon,klev),INTENT(IN) :: upwd ! saturated updraft mass flux
	112	REAL,DIMENSION(klon,klev),INTENT(IN) :: dnwd ! saturated downdraft mass flux
	113	!
	114	!Thermiques:
	115	!----------
	116	REAL,DIMENSION(klon,klev+1),INTENT(IN) :: fm_therm
	117	REAL,DIMENSION(klon,klev),INTENT(IN) :: entr_therm
	118	!
	119	!Couche limite:
	120	!--------------
	121	!
[1670]	122	REAL,DIMENSION(klon),INTENT(IN) :: cdragh ! coeff drag pour T et Q
	123	REAL,DIMENSION(klon,klev),INTENT(IN):: coefh ! coeff melange CL (m**2/s)
	124	REAL,DIMENSION(klon),INTENT(IN) :: ustar,u10m,v10m ! u* & vent a 10m (m/s)
	125	REAL,DIMENSION(klon),INTENT(IN) :: yu1 ! vents au premier niveau
	126	REAL,DIMENSION(klon),INTENT(IN) :: yv1 ! vents au premier niveau
[1191]	127	!
	128	!Lessivage:
	129	!----------
	130	!
	131	! pour le ON-LINE
	132	!
	133	REAL,DIMENSION(klon,klev),INTENT(IN) :: frac_impa ! fraction d'aerosols non impactes
	134	REAL,DIMENSION(klon,klev),INTENT(IN) :: frac_nucl ! fraction d'aerosols non nuclees
[524]	135
[1191]	136	! Arguments necessaires pour les sources et puits de traceur:
	137	REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: ftsol ! Temperature du sol (surf)(Kelvin)
	138	REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: pctsrf ! Pourcentage de sol (nature du sol)
[524]	139
	140
[1191]	141	! Output argument
	142	!----------------
	143	REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT) :: tr_seri ! Concentration Traceur [U/KgA]
[524]	144
[1191]	145	!=======================================================================================
	146	! -- LOCAL VARIABLES --
	147	!=======================================================================================
[766]	148
[1191]	149	INTEGER :: i, k, it
	150	INTEGER :: nsplit
[524]	151
[1191]	152	!Sources et Reservoirs de traceurs (ex:Radon):
	153	!--------------------------------------------
	154	!
	155	REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: source ! a voir lorsque le flux de surface est prescrit
	156	!$OMP THREADPRIVATE(source)
[524]	157
[1191]	158	!
	159	!Entrees/Sorties: (cf ini_histrac.h et write_histrac.h)
	160	!---------------
	161	INTEGER :: iiq, ierr
	162	INTEGER :: nhori, nvert
	163	REAL :: zsto, zout, zjulian
	164	INTEGER,SAVE :: nid_tra ! pointe vers le fichier histrac.nc
	165	!$OMP THREADPRIVATE(nid_tra)
	166	REAL,DIMENSION(klon) :: zx_tmp_fi2d ! variable temporaire grille physique
	167	INTEGER :: itau_w ! pas de temps ecriture = nstep + itau_phy
	168	LOGICAL,PARAMETER :: ok_sync=.TRUE.
[524]	169
[1191]	170	!
	171	! Nature du traceur
	172	!------------------
	173	LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: aerosol ! aerosol(it) = true => aerosol => lessivage
	174	!$OMP THREADPRIVATE(aerosol) ! aerosol(it) = false => gaz
	175	REAL,DIMENSION(klon,klev) :: delp ! epaisseur de couche (Pa)
	176	!
	177	! Tendances de traceurs (Td):
	178	!------------------------
	179	!
	180	REAL,DIMENSION(klon,klev) :: d_tr ! Td dans l'atmosphere
	181	REAL,DIMENSION(klon,klev,nbtr) :: d_tr_cl ! Td couche limite/traceur
	182	REAL,DIMENSION(klon,klev,nbtr) :: d_tr_cv ! Td convection/traceur
	183	REAL,DIMENSION(klon,klev,nbtr) :: d_tr_th ! Td thermique
	184	REAL,DIMENSION(klon,klev,nbtr) :: d_tr_lessi_impa ! Td du lessivage par impaction
	185	REAL,DIMENSION(klon,klev,nbtr) :: d_tr_lessi_nucl ! Td du lessivage par nucleation
	186	!
	187	! Physique
	188	!----------
	189	REAL,DIMENSION(klon,klev,nbtr) :: flestottr ! flux de lessivage dans chaque couche
	190	REAL,DIMENSION(klon,klev) :: zmasse ! densité atmosphérique Kg/m2
	191	REAL,DIMENSION(klon,klev) :: ztra_th
	192
	193	!Controles:
	194	!---------
	195	LOGICAL,SAVE :: couchelimite=.TRUE.
	196	LOGICAL,SAVE :: convection=.TRUE.
	197	LOGICAL,SAVE :: lessivage
	198	!$OMP THREADPRIVATE(couchelimite,convection,lessivage)
[766]	199
[1191]	200	CHARACTER(len=8),DIMENSION(nbtr) :: solsym
[524]	201
	202
[1191]	203	!######################################################################
	204	! -- INITIALIZATION --
	205	!######################################################################
	206	IF (debutphy) THEN
[1575]	207	IF (prt_level >9) WRITE(lunout,*) 'FIRST TIME IN PHYTRAC : pdtphys(sec) = ',pdtphys,'ecrit_tra (sec) = ',ecrit_tra
[1191]	208	ALLOCATE( source(klon,nbtr), stat=ierr)
	209	IF (ierr /= 0) CALL abort_gcm('phytrac', 'pb in allocation 1',1)
	210
	211	ALLOCATE( aerosol(nbtr), stat=ierr)
	212	IF (ierr /= 0) CALL abort_gcm('phytrac', 'pb in allocation 2',1)
	213
[524]	214
[1191]	215	! Initialize module for specific tracers
	216	SELECT CASE(type_trac)
	217	CASE('lmdz')
[1579]	218	CALL traclmdz_init(pctsrf, xlat, xlon, ftsol, tr_seri, t_seri, pplay, sh, pdtphys, aerosol, lessivage)
[1191]	219	CASE('inca')
	220	source(:,:)=0.
	221	CALL tracinca_init(aerosol,lessivage)
[1565]	222	CASE('repr')
	223	source(:,:)=0.
[1191]	224	END SELECT
	225	!
	226	! Initialize diagnostic output
	227	! ----------------------------
[1192]	228	#ifdef CPP_IOIPSL
[1575]	229	INCLUDE "ini_histrac.h"
[1192]	230	#endif
[1191]	231	END IF
	232	!############################################ END INITIALIZATION #######
[524]	233
[1403]	234	DO k=1,klev
	235	DO i=1,klon
	236	zmasse(i,k)=(paprs(i,k)-paprs(i,k+1))/rg
	237	END DO
	238	END DO
	239
[1191]	240	!===============================================================================
	241	! -- Do specific treatment according to chemestry model or local LMDZ tracers
	242	!
	243	!===============================================================================
	244	SELECT CASE(type_trac)
	245	CASE('lmdz')
	246	! -- Traitement des traceurs avec traclmdz
[1403]	247	CALL traclmdz(nstep, julien, gmtime, pdtphys, t_seri, paprs, pplay, &
[1670]	248	cdragh, coefh, yu1, yv1, ftsol, pctsrf, xlat, xlon,couchelimite,sh,&
	249	rh, pphi, ustar, u10m, v10m, &
	250	tr_seri, source, solsym, d_tr_cl, zmasse)
[1191]	251	CASE('inca')
	252	! -- CHIMIE INCA config_inca = aero or chem --
[776]	253
[1191]	254	CALL tracinca(&
	255	nstep, julien, gmtime, lafin, &
	256	pdtphys, t_seri, paprs, pplay, &
	257	pmfu, ftsol, pctsrf, pphis, &
	258	pphi, albsol, sh, rh, &
	259	cldfra, rneb, diafra, cldliq, &
	260	itop_con, ibas_con, pmflxr, pmflxs, &
	261	prfl, psfl, aerosol_couple, flxmass_w, &
	262	tau_aero, piz_aero, cg_aero, ccm, &
	263	rfname, &
	264	tr_seri, source, solsym)
[1565]	265
	266	CASE('repr')
	267	! -- CHIMIE REPROBUS --
	268
	269	CALL tracreprobus(pdtphys, gmtime, debutphy, julien, &
	270	presnivs, xlat, xlon, pphis, pphi, &
	271	t_seri, pplay, paprs, sh , &
	272	tr_seri, solsym)
	273
[1191]	274	END SELECT
[524]	275
[1191]	276	!======================================================================
	277	! -- Calcul de l'effet de la convection --
	278	!======================================================================
	279	IF (convection) THEN
	280	DO it=1, nbtr
	281	IF ( conv_flg(it) == 0 ) CYCLE
	282
	283	IF (iflag_con.LT.2) THEN
	284	d_tr_cv(:,:,:)=0.
	285	ELSE IF (iflag_con.EQ.2) THEN
	286	!..Tiedke
	287	CALL nflxtr(pdtphys, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
	288	pplay, paprs, tr_seri(:,:,it), d_tr_cv(:,:,it))
	289	ELSE
	290	!..K.Emanuel
	291	CALL cvltr(pdtphys, da, phi, mp, paprs,pplay, tr_seri(:,:,it),&
	292	upwd,dnwd,d_tr_cv(:,:,it))
	293	END IF
[959]	294
[1191]	295	DO k = 1, klev
	296	DO i = 1, klon
	297	tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_cv(i,k,it)
	298	END DO
	299	END DO
[959]	300
[1191]	301	CALL minmaxqfi(tr_seri(:,:,it),0.,1.e33,'convection it = '//solsym(it))
	302
	303	END DO ! nbtr
	304	END IF ! convection
[959]	305
[524]	306	!======================================================================
[1191]	307	! -- Calcul de l'effet des thermiques --
[524]	308	!======================================================================
	309
[1191]	310	DO it=1,nbtr
	311	DO k=1,klev
	312	DO i=1,klon
	313	d_tr_th(i,k,it)=0.
	314	tr_seri(i,k,it)=MAX(tr_seri(i,k,it),0.)
	315	tr_seri(i,k,it)=MIN(tr_seri(i,k,it),1.e10)
[524]	316	END DO
[1191]	317	END DO
	318	END DO
	319
	320	IF (iflag_thermals.GT.0) THEN
	321	nsplit=10
	322	DO it=1, nbtr
	323	DO isplit=1,nsplit
[524]	324
[1191]	325	CALL dqthermcell(klon,klev,pdtphys/nsplit, &
	326	fm_therm,entr_therm,zmasse, &
	327	tr_seri(1:klon,1:klev,it),d_tr,ztra_th)
[524]	328
[1191]	329	DO k=1,klev
	330	DO i=1,klon
	331	d_tr(i,k)=pdtphys*d_tr(i,k)/nsplit
	332	d_tr_th(i,k,it)=d_tr_th(i,k,it)+d_tr(i,k)
	333	tr_seri(i,k,it)=MAX(tr_seri(i,k,it)+d_tr(i,k),0.)
	334	END DO
	335	END DO
	336	END DO ! nsplit
	337	END DO ! it
	338	END IF ! Thermiques
[682]	339
[1191]	340	!======================================================================
	341	! -- Calcul de l'effet de la couche limite --
	342	!======================================================================
[682]	343
[1191]	344	IF (couchelimite) THEN
[524]	345
[1191]	346	DO k = 1, klev
	347	DO i = 1, klon
	348	delp(i,k) = paprs(i,k)-paprs(i,k+1)
	349	END DO
	350	END DO
[524]	351
[1191]	352	DO it=1, nbtr
	353
	354	IF( pbl_flg(it) /= 0 ) THEN
	355
	356	CALL cltrac(pdtphys, coefh,t_seri, &
	357	tr_seri(:,:,it), source(:,it), &
	358	paprs, pplay, delp, &
	359	d_tr_cl(:,:,it))
	360
	361	DO k = 1, klev
	362	DO i = 1, klon
	363	tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_cl(i,k,it)
	364	END DO
	365	END DO
	366	END IF
[959]	367
[1191]	368	END DO
	369
	370	END IF ! couche limite
[959]	371
[619]	372
[1191]	373	!======================================================================
	374	! Calcul de l'effet de la precipitation
	375	!======================================================================
[959]	376
[1191]	377	IF (lessivage) THEN
	378
	379	d_tr_lessi_nucl(:,:,:) = 0.
	380	d_tr_lessi_impa(:,:,:) = 0.
	381	flestottr(:,:,:) = 0.
	382	!=========================
	383	! LESSIVAGE LARGE SCALE :
	384	!=========================
[524]	385
[1191]	386	! Tendance des aerosols nuclees et impactes
	387	! -----------------------------------------
	388	DO it = 1, nbtr
	389	IF (aerosol(it)) THEN
	390	DO k = 1, klev
[524]	391	DO i = 1, klon
[1191]	392	d_tr_lessi_nucl(i,k,it) = d_tr_lessi_nucl(i,k,it) + &
	393	( 1 - frac_nucl(i,k) )*tr_seri(i,k,it)
	394	d_tr_lessi_impa(i,k,it) = d_tr_lessi_impa(i,k,it) + &
	395	( 1 - frac_impa(i,k) )*tr_seri(i,k,it)
[524]	396
[1191]	397	!
	398	! Flux lessivage total
	399	! ------------------------------------------------------------
	400	flestottr(i,k,it) = flestottr(i,k,it) - &
	401	( d_tr_lessi_nucl(i,k,it) + &
	402	d_tr_lessi_impa(i,k,it) ) * &
	403	( paprs(i,k)-paprs(i,k+1) ) / &
	404	(RG * pdtphys)
	405	!
	406	! Mise a jour des traceurs due a l'impaction,nucleation
	407	! ----------------------------------------------------------------------
	408	tr_seri(i,k,it)=tr_seri(i,k,it)frac_impa(i,k)frac_nucl(i,k)
	409	END DO
	410	END DO
	411	END IF
	412	END DO
	413
	414	END IF ! lessivage
[524]	415
[1191]	416	!=============================================================
	417	! Ecriture des sorties
	418	!=============================================================
[1192]	419	#ifdef CPP_IOIPSL
[1575]	420	INCLUDE "write_histrac.h"
[1192]	421	#endif
[524]	422
[1191]	423	END SUBROUTINE phytrac

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

Download in other formats:

Original Format