source: LMDZ5/branches/LMDZ5_SPLA/libf/phylmd/phytrac_mod.F90 @ 2544

Last change on this file since 2544 was 2007, checked in by fhourdin, 11 years ago

Modification pour garantir la conservation des espèces traces.

Modification for tracer conservation

Jean-Yves Grandpeix

  • 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: 29.2 KB
Line 
1!$Id$
2MODULE 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
54CONTAINS
55
56SUBROUTINE 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!======================================================================
87
88  USE ioipsl
89  USE phys_cal_mod, only : hour
90  USE dimphy
91  USE infotrac
92  USE mod_grid_phy_lmdz
93  USE mod_phys_lmdz_para
94  USE comgeomphy
95  USE iophy
96  USE traclmdz_mod
97  USE tracinca_mod
98  USE tracreprobus_mod
99  USE control_mod
100  USE indice_sol_mod
101
102  IMPLICIT NONE
103
104  INCLUDE "YOMCST.h"
105  INCLUDE "dimensions.h"
106  INCLUDE "clesphys.h"
107  INCLUDE "temps.h"
108  INCLUDE "paramet.h"
109  INCLUDE "thermcell.h"
110  INCLUDE "iniprint.h"
111!==========================================================================
112!                   -- ARGUMENT DESCRIPTION --
113!==========================================================================
114
115! Input arguments
116!----------------
117!Configuration grille,temps:
118  INTEGER,INTENT(IN) :: nstep      ! Appel physique
119  INTEGER,INTENT(IN) :: julien     ! Jour julien
120  REAL,INTENT(IN)    :: gmtime     ! Heure courante
121  REAL,INTENT(IN)    :: pdtphys    ! Pas d'integration pour la physique (seconde)
122  LOGICAL,INTENT(IN) :: debutphy   ! le flag de l'initialisation de la physique
123  LOGICAL,INTENT(IN) :: lafin      ! le flag de la fin de la physique
124 
125  REAL,DIMENSION(klon),INTENT(IN) :: xlat    ! latitudes pour chaque point
126  REAL,DIMENSION(klon),INTENT(IN) :: xlon    ! longitudes pour chaque point
127!
128!Physique:
129!--------
130  REAL,DIMENSION(klon,klev),INTENT(IN)   :: t_seri  ! Temperature
131  REAL,DIMENSION(klon,klev),INTENT(IN)   :: u       ! variable not used
132  REAL,DIMENSION(klon,klev),INTENT(IN)   :: v       ! variable not used
133  REAL,DIMENSION(klon,klev),INTENT(IN)   :: sh      ! humidite specifique
134  REAL,DIMENSION(klon,klev),INTENT(IN)   :: rh      ! humidite relative
135  REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs   ! pression pour chaque inter-couche (en Pa)
136  REAL,DIMENSION(klon,klev),INTENT(IN)   :: pplay   ! pression pour le mileu de chaque couche (en Pa)
137  REAL,DIMENSION(klon,klev),INTENT(IN)   :: pphi    ! geopotentiel
138  REAL,DIMENSION(klon),INTENT(IN)        :: pphis
139  REAL,DIMENSION(klev),INTENT(IN)        :: presnivs
140  REAL,DIMENSION(klon,klev),INTENT(IN)   :: cldliq  ! eau liquide nuageuse
141  REAL,DIMENSION(klon,klev),INTENT(IN)   :: cldfra  ! fraction nuageuse (tous les nuages)
142  REAL,DIMENSION(klon,klev),INTENT(IN)   :: diafra  ! fraction nuageuse (convection ou stratus artificiels)
143  REAL,DIMENSION(klon,klev),INTENT(IN)   :: rneb    ! fraction nuageuse (grande echelle)
144!
145  REAL                                   :: ql_incl ! contenu en eau liquide nuageuse dans le nuage ! ql_incl=oliq/rneb
146  REAL,DIMENSION(klon,klev),INTENT(IN)   :: beta_fisrt ! taux de conversion de l'eau cond (de fisrtilp)
147  REAL,DIMENSION(klon,klev),INTENT(out)  :: beta_v1    ! -- (originale version)
148
149!
150  INTEGER,DIMENSION(klon),INTENT(IN)     :: itop_con
151  INTEGER,DIMENSION(klon),INTENT(IN)     :: ibas_con
152  REAL,DIMENSION(klon),INTENT(IN)        :: albsol  ! albedo surface
153!
154!Dynamique
155!--------
156  REAL,DIMENSION(klon,klev,nbtr),INTENT(IN)    :: d_tr_dyn
157!
158!Convection:
159!----------
160  REAL,DIMENSION(klon,klev),INTENT(IN) :: pmfu  ! flux de masse dans le panache montant
161  REAL,DIMENSION(klon,klev),INTENT(IN) :: pmfd  ! flux de masse dans le panache descendant
162  REAL,DIMENSION(klon,klev),INTENT(IN) :: pen_u ! flux entraine dans le panache montant
163  REAL,DIMENSION(klon,klev),INTENT(IN) :: pde_u ! flux detraine dans le panache montant
164  REAL,DIMENSION(klon,klev),INTENT(IN) :: pen_d ! flux entraine dans le panache descendant
165  REAL,DIMENSION(klon,klev),INTENT(IN) :: pde_d ! flux detraine dans le panache descendant
166
167!...Tiedke     
168  REAL,DIMENSION(klon,klev+1),INTENT(IN)   :: pmflxr, pmflxs ! Flux precipitant de pluie, neige aux interfaces [convection]
169  REAL,DIMENSION(klon,klev+1),INTENT(IN)   :: prfl, psfl ! Flux precipitant de pluie, neige aux interfaces [large-scale]
170
171  LOGICAL,INTENT(IN)                       :: aerosol_couple
172  REAL,DIMENSION(klon,klev),INTENT(IN)     :: flxmass_w
173  REAL,DIMENSION(klon,klev,9,2),INTENT(IN) :: tau_aero
174  REAL,DIMENSION(klon,klev,9,2),INTENT(IN) :: piz_aero
175  REAL,DIMENSION(klon,klev,9,2),INTENT(IN) :: cg_aero
176  CHARACTER(len=4),DIMENSION(9),INTENT(IN) :: rfname
177  REAL,DIMENSION(klon,klev,2),INTENT(IN)   :: ccm
178!... K.Emanuel
179  REAL,DIMENSION(klon,klev),INTENT(IN)     :: da
180  REAL,DIMENSION(klon,klev,klev),INTENT(IN):: phi
181! RomP >>>
182  REAL,DIMENSION(klon,klev),INTENT(IN)      :: d1a,dam
183  REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: phi2
184!
185  REAL,DIMENSION(klon,klev),INTENT(IN)      :: wdtrainA
186  REAL,DIMENSION(klon,klev),INTENT(IN)      :: wdtrainM
187  REAL,DIMENSION(klon),INTENT(IN)           :: sigd
188! ---- RomP flux entraine, detraine et precipitant kerry Emanuel
189  REAL,DIMENSION(klon,klev),INTENT(IN)      :: evap
190  REAL,DIMENSION(klon,klev),INTENT(IN)      :: ep
191  REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: sij
192  REAL,DIMENSION(klon,klev),INTENT(IN)      :: wght_cvfd          !RL
193  REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: elij
194  REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: epmlmMm
195  REAL,DIMENSION(klon,klev),INTENT(IN)      :: eplaMm
196  REAL,DIMENSION(klon,klev),INTENT(IN)      :: clw
197! RomP <<<
198
199!
200  REAL,DIMENSION(klon,klev),INTENT(IN)     :: mp
201  REAL,DIMENSION(klon,klev),INTENT(IN)     :: upwd      ! saturated updraft mass flux
202  REAL,DIMENSION(klon,klev),INTENT(IN)     :: dnwd      ! saturated downdraft mass flux
203!
204!Thermiques:
205!----------
206  REAL,DIMENSION(klon,klev+1),INTENT(IN)   :: fm_therm
207  REAL,DIMENSION(klon,klev),INTENT(IN)     :: entr_therm
208!
209!Couche limite:
210!--------------
211!
212!
213  REAL,DIMENSION(:),INTENT(IN)   :: cdragh          ! (klon) coeff drag pour T et Q
214  REAL,DIMENSION(:,:),INTENT(IN) :: coefh           ! (klon,klev) coeff melange CL (m**2/s)
215  REAL,DIMENSION(:),INTENT(IN)   :: ustar,u10m,v10m ! (klon) u* & vent a 10m (m/s)
216  REAL,DIMENSION(:),INTENT(IN)   :: wstar,ale_bl,ale_wake ! (klon) w* and Avail. Lifting Ener.
217  REAL,DIMENSION(:),INTENT(IN)   :: yu1             ! (klon) vents au premier niveau
218  REAL,DIMENSION(:),INTENT(IN)   :: yv1             ! (klon) vents au premier niveau
219
220!
221!Lessivage:
222!----------
223!
224! pour le ON-LINE
225!
226  REAL,DIMENSION(klon,klev),INTENT(IN) :: frac_impa ! fraction d'aerosols non impactes
227  REAL,DIMENSION(klon,klev),INTENT(IN) :: frac_nucl ! fraction d'aerosols non nuclees
228
229! Arguments necessaires pour les sources et puits de traceur:
230  REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: ftsol  ! Temperature du sol (surf)(Kelvin)
231  REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: pctsrf ! Pourcentage de sol (nature du sol)
232
233
234! Output argument
235!----------------
236  REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT) :: tr_seri ! Concentration Traceur [U/KgA]
237  REAL,DIMENSION(klon,klev)                    :: sourceBE
238!=======================================================================================
239!                        -- LOCAL VARIABLES --
240!=======================================================================================
241
242  INTEGER :: i, k, it
243  INTEGER :: nsplit
244
245!Sources et Reservoirs de traceurs (ex:Radon):
246!--------------------------------------------
247!
248  REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: source  ! a voir lorsque le flux de surface est prescrit
249!$OMP THREADPRIVATE(source)
250
251!
252!Entrees/Sorties: (cf ini_histrac.h et write_histrac.h) 
253!---------------
254  INTEGER                   :: iiq, ierr
255  INTEGER                   :: nhori, nvert
256  REAL                      :: zsto, zout, zjulian
257  INTEGER,SAVE              :: nid_tra     ! pointe vers le fichier histrac.nc         
258!$OMP THREADPRIVATE(nid_tra)
259  REAL,DIMENSION(klon)      :: zx_tmp_fi2d ! variable temporaire grille physique
260  INTEGER                   :: itau_w      ! pas de temps ecriture = nstep + itau_phy
261  LOGICAL,PARAMETER         :: ok_sync=.TRUE.
262
263!
264! Nature du traceur
265!------------------
266  LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: aerosol  ! aerosol(it) = true  => aerosol => lessivage
267!$OMP THREADPRIVATE(aerosol)                        ! aerosol(it) = false => gaz
268  REAL,DIMENSION(klon,klev)             :: delp     ! epaisseur de couche (Pa)
269!
270! Tendances de traceurs (Td) et flux de traceurs:
271!------------------------
272  REAL,DIMENSION(klon,klev)      :: d_tr     ! Td dans l'atmosphere
273  REAL,DIMENSION(klon,klev)      :: Mint
274  REAL,DIMENSION(klon,klev,nbtr) :: zmfd1a
275  REAL,DIMENSION(klon,klev,nbtr) :: zmfdam
276  REAL,DIMENSION(klon,klev,nbtr) :: zmfphi2
277! Physique
278!----------
279  REAL,DIMENSION(klon,klev,nbtr) :: flestottr ! flux de lessivage dans chaque couche
280  REAL,DIMENSION(klon,klev)      :: zmasse    ! densité atmosphérique Kg/m2
281  REAL,DIMENSION(klon,klev)      :: ztra_th
282!PhH
283  REAL,DIMENSION(klon,klev)      :: zrho
284  REAL,DIMENSION(klon,klev)      :: zdz
285  REAL                           :: evaplsc,dx,beta ! variable pour lessivage Genthon
286  REAL,DIMENSION(klon)           :: his_dh          ! ---
287! in-cloud scav variables
288  REAL           :: ql_incloud_ref     ! ref value of in-cloud condensed water content
289 
290!Controles:
291!---------
292  INTEGER,SAVE :: iflag_vdf_trac,iflag_con_trac,iflag_the_trac
293  INTEGER,SAVE  :: iflag_con_trac_omp, iflag_vdf_trac_omp,iflag_the_trac_omp
294!$OMP THREADPRIVATE(iflag_vdf_trac,iflag_con_trac,iflag_the_trac)
295
296  LOGICAL,SAVE :: lessivage
297!$OMP THREADPRIVATE(lessivage)
298
299  CHARACTER(len=8),DIMENSION(nbtr) :: solsym
300!RomP >>>
301  INTEGER,SAVE  :: iflag_lscav_omp,iflag_lscav
302  LOGICAL,SAVE  :: convscav_omp,convscav
303!$OMP THREADPRIVATE(iflag_lscav)
304!$OMP THREADPRIVATE(convscav)
305!RomP <<<
306!######################################################################
307!                    -- INITIALIZATION --
308!######################################################################
309IF (debutphy) THEN
310ALLOCATE(d_tr_cl(klon,klev,nbtr),d_tr_dry(klon,nbtr))
311ALLOCATE(flux_tr_dry(klon,nbtr),d_tr_dec(klon,klev,nbtr),d_tr_cv(klon,klev,nbtr))
312ALLOCATE(d_tr_insc(klon,klev,nbtr),d_tr_bcscav(klon,klev,nbtr))
313ALLOCATE(d_tr_evapls(klon,klev,nbtr),d_tr_ls(klon,klev,nbtr))
314ALLOCATE(qPrls(klon,nbtr),d_tr_trsp(klon,klev,nbtr))
315ALLOCATE(d_tr_sscav(klon,klev,nbtr),d_tr_sat(klon,klev,nbtr))
316ALLOCATE(d_tr_uscav(klon,klev,nbtr),qPr(klon,klev,nbtr),qDi(klon,klev,nbtr))
317ALLOCATE(qPa(klon,klev,nbtr),qMel(klon,klev,nbtr))
318ALLOCATE(qTrdi(klon,klev,nbtr),dtrcvMA(klon,klev,nbtr))
319ALLOCATE(d_tr_th(klon,klev,nbtr))
320ALLOCATE(d_tr_lessi_impa(klon,klev,nbtr),d_tr_lessi_nucl(klon,klev,nbtr))
321ENDIF
322
323  DO k=1,klev
324     DO i=1,klon
325      sourceBE(i,k)=0.
326      Mint(i,k)=0.
327      zrho(i,k)=0.
328      zdz(i,k)=0.
329     END DO
330  END DO
331
332  DO it=1, nbtr
333   DO k=1,klev
334    DO i=1,klon
335    d_tr_insc(i,k,it)=0.
336    d_tr_bcscav(i,k,it)=0.
337    d_tr_evapls(i,k,it)=0.
338    d_tr_ls(i,k,it)=0.
339    d_tr_cv(i,k,it)=0.
340    d_tr_cl(i,k,it)=0.
341    d_tr_trsp(i,k,it)=0.
342    d_tr_sscav(i,k,it)=0.
343    d_tr_sat(i,k,it)=0.
344    d_tr_uscav(i,k,it)=0.
345    d_tr_lessi_impa(i,k,it)=0.
346    d_tr_lessi_nucl(i,k,it)=0.
347    qDi(i,k,it)=0.
348    qPr(i,k,it)=0.
349    qPa(i,k,it)=0.
350    qMel(i,k,it)=0.
351    qTrdi(i,k,it)=0.
352    dtrcvMA(i,k,it)=0.
353    zmfd1a(i,k,it)=0.
354    zmfdam(i,k,it)=0.
355    zmfphi2(i,k,it)=0.
356    END DO
357   END DO
358  END DO
359  IF (debutphy) THEN
360!!jyg
361!$OMP BARRIER
362   ecrit_tra=86400. ! frequence de stokage en dur
363                    ! obsolete car remplace par des ecritures dans phys_output_write
364!RomP >>>
365!
366!Config Key  = convscav
367!Config Desc = Convective scavenging switch: 0=off, 1=on.
368!Config Def  = .false.
369!Config Help =
370!
371!$OMP MASTER
372  convscav_omp=.false.
373  call getin('convscav', convscav_omp)
374  iflag_vdf_trac_omp=1
375  call getin('iflag_vdf_trac', iflag_vdf_trac_omp)
376  iflag_con_trac_omp=1
377  call getin('iflag_con_trac', iflag_con_trac_omp)
378  iflag_the_trac_omp=1
379  call getin('iflag_the_trac', iflag_the_trac_omp)
380!$OMP END MASTER
381!$OMP BARRIER
382  convscav=convscav_omp
383  iflag_vdf_trac=iflag_vdf_trac_omp
384  iflag_con_trac=iflag_con_trac_omp
385  iflag_the_trac=iflag_the_trac_omp
386  print*,'phytrac passage dans routine conv avec lessivage', convscav
387!
388!Config Key  = iflag_lscav
389!Config Desc = Large scale scavenging parametrization: 0=none, 1=old(Genthon92),
390!              2=1+PHeinrich, 3=Reddy_Boucher2004, 4=3+RPilon.
391!Config Def  = 1
392!Config Help =
393!
394!$OMP MASTER
395  iflag_lscav_omp=1
396  call getin('iflag_lscav', iflag_lscav_omp)
397!$OMP END MASTER
398!$OMP BARRIER
399  iflag_lscav=iflag_lscav_omp
400!
401  SELECT CASE(iflag_lscav)
402  CASE(0)
403   PRINT*, 'Large scale scavenging: none'
404  CASE(1)
405   PRINT*, 'Large scale scavenging: C. Genthon, Tellus(1992), 44B, 371-389'
406  CASE(2)
407   PRINT*, 'Large scale scavenging: C. Genthon, modified P. Heinrich'
408  CASE(3)
409   PRINT*, 'Large scale scavenging: M. Shekkar Reddy and O. Boucher, JGR(2004), 109, D14202'
410  CASE(4)
411   PRINT*, 'Large scale scavenging: Reddy and Boucher, modified R. Pilon'
412  END SELECT
413!RomP <<<
414     WRITE(*,*) 'FIRST TIME IN PHYTRAC : pdtphys(sec) = ',pdtphys,'ecrit_tra (sec) = ',ecrit_tra
415     ALLOCATE( source(klon,nbtr), stat=ierr)
416     IF (ierr /= 0) CALL abort_gcm('phytrac', 'pb in allocation 1',1)
417     
418     ALLOCATE( aerosol(nbtr), stat=ierr)
419     IF (ierr /= 0) CALL abort_gcm('phytrac', 'pb in allocation 2',1)
420     
421
422     ! Initialize module for specific tracers
423     SELECT CASE(type_trac)
424     CASE('lmdz')
425        CALL traclmdz_init(pctsrf, xlat, xlon, ftsol, tr_seri, t_seri, pplay, sh, pdtphys, aerosol, lessivage)
426     CASE('inca')
427        source(:,:)=0.
428        CALL tracinca_init(aerosol,lessivage)
429     CASE('repr')
430        source(:,:)=0.
431     END SELECT
432!
433! Initialize diagnostic output
434! ----------------------------
435#ifdef CPP_IOIPSL
436!     INCLUDE "ini_histrac.h"
437#endif
438  END IF ! of IF (debutphy)
439!############################################ END INITIALIZATION #######
440
441  DO k=1,klev
442     DO i=1,klon
443        zmasse(i,k)=(paprs(i,k)-paprs(i,k+1))/rg
444     END DO
445  END DO
446!
447  IF (id_be .GT. 0) THEN
448  DO k=1,klev
449     DO i=1,klon
450        sourceBE(i,k)=srcbe(i,k)       !RomP  -> pour sortie histrac
451     END DO
452  END DO
453  ENDIF
454
455!===============================================================================
456!    -- Do specific treatment according to chemestry model or local LMDZ tracers
457!     
458!===============================================================================
459  SELECT CASE(type_trac)
460  CASE('lmdz')
461     !    -- Traitement des traceurs avec traclmdz
462     CALL traclmdz(nstep, julien, gmtime, pdtphys, t_seri, paprs, pplay, &
463          cdragh,  coefh, yu1, yv1, ftsol, pctsrf, xlat, xlon,iflag_vdf_trac>=0,sh, &
464           rh, pphi, ustar, wstar, ale_bl, ale_wake,  u10m, v10m, &
465           tr_seri, source, solsym, d_tr_cl,d_tr_dec, zmasse)               !RomP
466
467  CASE('inca')
468     !    -- CHIMIE INCA  config_inca = aero or chem --
469
470     CALL tracinca(&
471          nstep,    julien,   gmtime,         lafin,     &
472          pdtphys,  t_seri,   paprs,          pplay,     &
473          pmfu,     ftsol,    pctsrf,         pphis,     &
474          pphi,     albsol,   sh,             rh,        &
475          cldfra,   rneb,     diafra,         cldliq,    &
476          itop_con, ibas_con, pmflxr,         pmflxs,    &
477          prfl,     psfl,     aerosol_couple, flxmass_w, &
478          tau_aero, piz_aero, cg_aero,        ccm,       &
479          rfname,                                        &
480          tr_seri,  source,   solsym)     
481
482  CASE('repr')
483     !   -- CHIMIE REPROBUS --
484
485     CALL tracreprobus(pdtphys, gmtime, debutphy, julien, &
486          presnivs, xlat, xlon, pphis, pphi, &
487          t_seri, pplay, paprs, sh , &
488          tr_seri, solsym)
489     
490  END SELECT
491!======================================================================
492!       -- Calcul de l'effet de la convection --
493!======================================================================
494
495  IF (iflag_con_trac==1) THEN
496     DO it=1, nbtr
497        IF ( conv_flg(it) == 0 ) CYCLE
498        IF (iflag_con.LT.2) THEN
499           d_tr_cv(:,:,it)=0.
500        ELSE IF (iflag_con.EQ.2) THEN
501!..Tiedke
502           CALL nflxtr(pdtphys, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
503                pplay, paprs, tr_seri(:,:,it), d_tr_cv(:,:,it))
504! RomP >>>               
505        ELSE   
506!..K.Emanuel                  !RomP modif arg
507        if (convscav.and.aerosol(it)) then    ! lessivage convectif pour aerosol
508!
509          CALL cvltr(pdtphys, da, phi,phi2,d1a,dam, mp,ep,              &
510!!               sigd,sij,clw,elij,epmlmMm,eplaMm,                        &   !RL
511               sigd,sij,wght_cvfd,clw,elij,epmlmMm,eplaMm,              &     !RL
512               pmflxr,pmflxs,evap,t_seri,wdtrainA,wdtrainM,             &   
513               paprs,it,tr_seri,upwd,dnwd,itop_con,ibas_con,            &
514               d_tr_cv,d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav,qDi,qPr,&
515               qPa,qMel,qTrdi,dtrcvMA,Mint,                             &
516               zmfd1a,zmfphi2,zmfdam)
517        else  !pas de lessivage convectif ou n'est pas un aerosol
518!!           CALL cvltrorig(it,pdtphys, da, phi,mp,paprs,pplay,tr_seri,&      !jyg
519!!                    upwd,dnwd,d_tr_cv)                                      !jyg
520           CALL cvltr_noscav(it,pdtphys, da, phi,mp,wght_cvfd,paprs,pplay, &  !jyg
521                    tr_seri,upwd,dnwd,d_tr_cv)                                !jyg
522        endif
523        END IF
524! RomP <<<
525
526        DO k = 1, klev
527           DO i = 1, klon       
528              tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_cv(i,k,it)
529           END DO
530        END DO
531
532        CALL minmaxqfi(tr_seri(:,:,it),0.,1.e33,'convection it = '//solsym(it))
533             
534     END DO ! nbtr
535  END IF ! convection
536
537!======================================================================
538!    -- Calcul de l'effet des thermiques --
539!======================================================================
540
541  DO it=1,nbtr
542     DO k=1,klev
543        DO i=1,klon
544           d_tr_th(i,k,it)=0.
545           tr_seri(i,k,it)=MAX(tr_seri(i,k,it),0.)
546           tr_seri(i,k,it)=MIN(tr_seri(i,k,it),1.e10)
547        END DO
548     END DO
549  END DO
550 
551  IF (iflag_thermals.GT.0.AND.iflag_the_trac>0) THEN   
552     nsplit=10
553     DO it=1, nbtr
554        DO isplit=1,nsplit
555
556           CALL dqthermcell(klon,klev,pdtphys/nsplit, &
557                fm_therm,entr_therm,zmasse, &
558                tr_seri(1:klon,1:klev,it),d_tr,ztra_th)
559
560           DO k=1,klev
561              DO i=1,klon
562                 d_tr(i,k)=pdtphys*d_tr(i,k)/nsplit
563                 d_tr_th(i,k,it)=d_tr_th(i,k,it)+d_tr(i,k)
564                 tr_seri(i,k,it)=MAX(tr_seri(i,k,it)+d_tr(i,k),0.)
565              END DO
566           END DO
567        END DO ! nsplit
568     END DO ! it
569  END IF ! Thermiques
570
571!======================================================================
572!     -- Calcul de l'effet de la couche limite --
573!======================================================================
574
575  DO k = 1, klev
576     DO i = 1, klon
577        delp(i,k) = paprs(i,k)-paprs(i,k+1)
578     END DO
579  END DO
580
581  IF (iflag_vdf_trac==1) THEN
582     DO it=1, nbtr
583        if (prt_level > 20) write(lunout,*)'trac pbl ',it,pbl_flg(it)
584        IF( pbl_flg(it) /= 0 ) THEN
585           CALL cltrac(pdtphys, coefh,t_seri,       &
586                tr_seri(:,:,it), source(:,it),      &
587                paprs, pplay, delp,                 &
588                d_tr_cl(:,:,it),d_tr_dry(:,it),flux_tr_dry(:,it))
589           tr_seri(:,:,it)=tr_seri(:,:,it)+d_tr_cl(:,:,it)
590        END IF
591     END DO
592  ELSE IF (iflag_vdf_trac==0) THEN
593!   Injection of source in the first model layer
594    DO it=1,nbtr
595       d_tr_cl(:,1,it)=source(:,it)*rg/delp(:,1)*pdtphys
596       tr_seri(:,1,it)=tr_seri(:,1,it)+d_tr_cl(:,1,it)
597    ENDDO
598    d_tr_cl(:,2:klev,1:nbtr)=0.
599  ELSE IF (iflag_vdf_trac==-1) THEN
600    d_tr_cl=0.
601  ELSE
602    CALL abort_gcm('iflag_vdf_trac', 'cas non prevu',1)
603  END IF ! couche limite
604
605
606
607!======================================================================
608!   Calcul de l'effet de la precipitation grande echelle
609!======================================================================
610  IF (lessivage) THEN
611
612   ql_incloud_ref = 10.e-4
613   ql_incloud_ref =  5.e-4
614
615
616! calcul du contenu en eau liquide au sein du nuage
617     ql_incl = ql_incloud_ref
618! choix du lessivage
619!
620  IF (iflag_lscav .EQ. 3 .OR. iflag_lscav .EQ. 4) THEN
621! ********  Olivier Boucher version (3) possibly with modified ql_incl (4)
622!
623   DO it = 1, nbtr
624!  incloud scavenging and removal by large scale rain ! orig : ql_incl was replaced by 0.5e-3 kg/kg
625! the value 0.5e-3 kg/kg is from Giorgi and Chameides (1986), JGR
626! Liu (2001) proposed to use 1.5e-3 kg/kg
627
628    CALL lsc_scav(pdtphys,it,iflag_lscav,ql_incl,prfl,psfl,rneb,beta_fisrt,  &
629                  beta_v1,pplay,paprs,t_seri,tr_seri,d_tr_insc,   &
630                  d_tr_bcscav,d_tr_evapls,qPrls)
631
632!large scale scavenging tendency
633   DO k = 1, klev
634    DO i = 1, klon
635    d_tr_ls(i,k,it)=d_tr_insc(i,k,it)+d_tr_bcscav(i,k,it)+d_tr_evapls(i,k,it)
636    tr_seri(i,k,it)=tr_seri(i,k,it)+d_tr_ls(i,k,it)
637    ENDDO
638   ENDDO
639     CALL minmaxqfi(tr_seri(:,:,it),0.,1.e33,'lsc scav it = '//solsym(it))
640   END DO  !tr
641
642 ELSE IF (iflag_lscav .EQ. 2) THEN ! frac_impa, frac_nucl
643! *********   modified  old version
644
645     d_tr_lessi_nucl(:,:,:) = 0.
646     d_tr_lessi_impa(:,:,:) = 0.
647     flestottr(:,:,:) = 0.
648! Tendance des aerosols nuclees et impactes
649     DO it = 1, nbtr
650        IF (aerosol(it)) THEN
651        his_dh(:)=0.
652           DO k = 1, klev
653              DO i = 1, klon
654!PhH
655              zrho(i,k)=pplay(i,k)/t_seri(i,k)/RD
656              zdz(i,k)=(paprs(i,k)-paprs(i,k+1))/zrho(i,k)/RG
657!
658              END DO
659           END DO
660
661          DO k=klev-1, 1, -1
662            DO i=1, klon
663!             d_tr_ls(i,k,it)=tr_seri(i,k,it)*(frac_impa(i,k)*frac_nucl(i,k)-1.)
664             dx=d_tr_ls(i,k,it)
665             his_dh(i)=his_dh(i)-dx*zrho(i,k)*zdz(i,k)/pdtphys !  kg/m2/s
666             evaplsc = prfl(i,k) - prfl(i,k+1) + psfl(i,k) - psfl(i,k+1)
667! Evaporation Partielle -> Liberation Partielle 0.5*evap
668            IF ( evaplsc .LT.0..and.abs(prfl(i,k+1)+psfl(i,k+1)).gt.1.e-10) THEN
669                evaplsc = (-evaplsc)/(prfl(i,k+1)+psfl(i,k+1))
670! evaplsc est donc positif, his_dh(i) est positif
671!-------------- 
672             d_tr_evapls(i,k,it)=0.5*evaplsc*(d_tr_lessi_nucl(i,k+1,it) &
673                                  +d_tr_lessi_impa(i,k+1,it))
674!-------------   d_tr_evapls(i,k,it)=-0.5*evaplsc*(d_tr_lsc(i,k+1,it))
675             beta=0.5*evaplsc
676              if ((prfl(i,k)+psfl(i,k)).lt.1.e-10) THEN
677               beta=1.0*evaplsc
678              endif
679            dx=beta*his_dh(i)/zrho(i,k)/zdz(i,k)*pdtphys
680            his_dh(i)=(1.-beta)*his_dh(i)   ! tracer from
681            d_tr_evapls(i,k,it)=dx
682            ENDIF
683            d_tr_ls(i,k,it)=tr_seri(i,k,it)*(frac_impa(i,k)*frac_nucl(i,k)-1.) &
684                            +d_tr_evapls(i,k,it)
685
686!--------------
687                 d_tr_lessi_nucl(i,k,it) = d_tr_lessi_nucl(i,k,it) +    &
688                      ( 1 - frac_nucl(i,k) )*tr_seri(i,k,it)
689                 d_tr_lessi_impa(i,k,it) = d_tr_lessi_impa(i,k,it) +    &
690                      ( 1 - frac_impa(i,k) )*tr_seri(i,k,it)
691!
692! Flux lessivage total
693                 flestottr(i,k,it) = flestottr(i,k,it) -   &
694                      ( d_tr_lessi_nucl(i,k,it)   +        &
695                      d_tr_lessi_impa(i,k,it) ) *          &
696                      ( paprs(i,k)-paprs(i,k+1) ) /        &
697                      (RG * pdtphys)
698!! Mise a jour des traceurs due a l'impaction,nucleation
699!                 tr_seri(i,k,it)=tr_seri(i,k,it)*frac_impa(i,k)*frac_nucl(i,k)
700!!  calcul de la tendance liee au lessivage stratiforme
701!                 d_tr_ls(i,k,it)=tr_seri(i,k,it)*&
702!                                (1.-1./(frac_impa(i,k)*frac_nucl(i,k)))
703!--------------
704              END DO
705           END DO
706        END IF
707     END DO
708! *********   end modified old version
709
710 ELSE IF (iflag_lscav .EQ. 1) THEN ! frac_impa, frac_nucl
711! *********    old version
712
713     d_tr_lessi_nucl(:,:,:) = 0.
714     d_tr_lessi_impa(:,:,:) = 0.
715     flestottr(:,:,:) = 0.
716!=========================
717! LESSIVAGE LARGE SCALE :
718!=========================
719
720! Tendance des aerosols nuclees et impactes
721! -----------------------------------------
722     DO it = 1, nbtr
723        IF (aerosol(it)) THEN
724           DO k = 1, klev
725              DO i = 1, klon
726                 d_tr_lessi_nucl(i,k,it) = d_tr_lessi_nucl(i,k,it) +    &
727                      ( 1 - frac_nucl(i,k) )*tr_seri(i,k,it)
728                 d_tr_lessi_impa(i,k,it) = d_tr_lessi_impa(i,k,it) +    &
729                      ( 1 - frac_impa(i,k) )*tr_seri(i,k,it)
730
731!
732! Flux lessivage total
733! ------------------------------------------------------------
734                 flestottr(i,k,it) = flestottr(i,k,it) -   &
735                      ( d_tr_lessi_nucl(i,k,it)   +        &
736                      d_tr_lessi_impa(i,k,it) ) *          &
737                      ( paprs(i,k)-paprs(i,k+1) ) /        &
738                      (RG * pdtphys)
739!
740! Mise a jour des traceurs due a l'impaction,nucleation
741! ----------------------------------------------------------------------
742                 tr_seri(i,k,it)=tr_seri(i,k,it)*frac_impa(i,k)*frac_nucl(i,k)
743              END DO
744           END DO
745        END IF
746     END DO
747     
748! *********   end old version
749  ENDIF  !  iflag_lscav . EQ. 1, 2, 3 or 4
750!
751  END IF !  lessivage
752
753!=============================================================
754!   Ecriture des sorties
755!=============================================================
756#ifdef CPP_IOIPSL
757! INCLUDE "write_histrac.h"
758#endif
759
760END SUBROUTINE phytrac
761
762END MODULE
Note: See TracBrowser for help on using the repository browser.