Context Navigation

phytrac.F90 @ 3013

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

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

Download in other formats:

Original Format