source: LMDZ5/trunk/libf/phylmd/phytrac.F90 @ 1454

Last change on this file since 1454 was 1454, checked in by Laurent Fairhead, 14 years ago

Merge of LMDZ5V1.0-dev branch r1453 into LMDZ5 trunk r1434


Fusion entre la version r1453 de la branche de développement LMDZ5V1.0-dev
et le tronc LMDZ5 (r1434)

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 15.0 KB
Line 
1!$Id $
2
3SUBROUTINE 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)         
20!
21!======================================================================
22! Auteur(s) FH
23! Objet: Moniteur general des tendances traceurs
24!======================================================================
25
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
35  USE control_mod
36
37
38
39  IMPLICIT NONE
40
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!==========================================================================
51
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
68  REAL,DIMENSION(klon,klev),INTENT(IN)   :: u       ! variable not used
69  REAL,DIMENSION(klon,klev),INTENT(IN)   :: v       ! variable not used
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
93
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]
97
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!
120  REAL,DIMENSION(klon),INTENT(IN)      :: cdragh ! coeff drag pour T et Q
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
132
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)
136
137
138! Output argument
139!----------------
140  REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT) :: tr_seri ! Concentration Traceur [U/KgA] 
141
142!=======================================================================================
143!                        -- LOCAL VARIABLES --
144!=======================================================================================
145
146  INTEGER :: i, k, it
147  INTEGER :: nsplit
148
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)
154
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.
166
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)
196
197  CHARACTER(len=8),DIMENSION(nbtr) :: solsym
198
199
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     
211
212     ! Initialize module for specific tracers
213     SELECT CASE(type_trac)
214     CASE('lmdz')
215        CALL traclmdz_init(pctsrf, ftsol, tr_seri, t_seri, pplay, sh, pdtphys, aerosol, lessivage)
216     CASE('inca')
217        source(:,:)=0.
218        CALL tracinca_init(aerosol,lessivage)
219     END SELECT
220!
221! Initialize diagnostic output
222! ----------------------------
223#ifdef CPP_IOIPSL
224!     INCLUDE "ini_histrac.h"
225#endif
226  END IF
227!############################################ END INITIALIZATION #######
228
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
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
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)
245  CASE('inca')
246     !    -- CHIMIE INCA  config_inca = aero or chem --
247
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
260
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
279
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
285
286        CALL minmaxqfi(tr_seri(:,:,it),0.,1.e33,'convection it = '//solsym(it))
287             
288     END DO ! nbtr
289  END IF ! convection
290
291!======================================================================
292!    -- Calcul de l'effet des thermiques --
293!======================================================================
294
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)
301        END DO
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
309
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)
313
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
324
325!======================================================================
326!     -- Calcul de l'effet de la couche limite --
327!======================================================================
328
329  IF (couchelimite) THEN
330
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
336
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
352
353     END DO
354     
355  END IF ! couche limite
356
357
358!======================================================================
359!   Calcul de l'effet de la precipitation
360!======================================================================
361
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!=========================
370
371! Tendance des aerosols nuclees et impactes
372! -----------------------------------------
373     DO it = 1, nbtr
374        IF (aerosol(it)) THEN
375           DO k = 1, klev
376              DO i = 1, klon
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)
381
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
400
401!=============================================================
402!   Ecriture des sorties
403!=============================================================
404#ifdef CPP_IOIPSL
405!  INCLUDE "write_histrac.h"
406#endif
407
408END SUBROUTINE phytrac
Note: See TracBrowser for help on using the repository browser.