source: LMDZ5/branches/LMDZ5V1.0-dev/libf/phylmd/phytrac.F90 @ 1444

Last change on this file since 1444 was 1444, checked in by jghattas, 14 years ago

Modifications for carbon tracers :

  • add possibility to read source at different frequency
  • add dynamic varaiable to send fluxes in interface between ORCHIDEE and LMDZ : this is still under developpment under cpp key ORCH_NEW. No compatible official ORCHIDEE version does yet exist.
  • add variable co2_send in restart file.
  • clean up and bug fixes.


  • 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       !
69  REAL,DIMENSION(klon,klev),INTENT(IN)   :: v       !
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,klev),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!IM ajout t_seri, pplay, sh    CALL traclmdz_init(pctsrf, ftsol, tr_seri, aerosol, lessivage)
216        CALL traclmdz_init(pctsrf, ftsol, tr_seri, t_seri, pplay, sh, pdtphys, aerosol, lessivage)
217     CASE('inca')
218        source(:,:)=0.
219        CALL tracinca_init(aerosol,lessivage)
220     END SELECT
221!
222! Initialize diagnostic output
223! ----------------------------
224#ifdef CPP_IOIPSL
225!     INCLUDE "ini_histrac.h"
226#endif
227  END IF
228!############################################ END INITIALIZATION #######
229
230  DO k=1,klev
231     DO i=1,klon
232        zmasse(i,k)=(paprs(i,k)-paprs(i,k+1))/rg
233     END DO
234  END DO
235
236!===============================================================================
237!    -- Do specific treatment according to chemestry model or local LMDZ tracers
238!     
239!===============================================================================
240  SELECT CASE(type_trac)
241  CASE('lmdz')
242     !    -- Traitement des traceurs avec traclmdz
243     CALL traclmdz(nstep, julien, gmtime, pdtphys, t_seri, paprs, pplay, &
244          cdragh,  coefh, yu1, yv1, ftsol, pctsrf, xlat, xlon, couchelimite, &
245          sh, tr_seri, source, solsym, d_tr_cl, zmasse)
246  CASE('inca')
247     !    -- CHIMIE INCA  config_inca = aero or chem --
248
249     CALL tracinca(&
250          nstep,    julien,   gmtime,         lafin,     &
251          pdtphys,  t_seri,   paprs,          pplay,     &
252          pmfu,     ftsol,    pctsrf,         pphis,     &
253          pphi,     albsol,   sh,             rh,        &
254          cldfra,   rneb,     diafra,         cldliq,    &
255          itop_con, ibas_con, pmflxr,         pmflxs,    &
256          prfl,     psfl,     aerosol_couple, flxmass_w, &
257          tau_aero, piz_aero, cg_aero,        ccm,       &
258          rfname,                                        &
259          tr_seri,  source,   solsym)     
260  END SELECT
261
262!======================================================================
263!       -- Calcul de l'effet de la convection --
264!======================================================================
265  IF (convection) THEN
266     DO it=1, nbtr
267        IF ( conv_flg(it) == 0 ) CYCLE
268       
269        IF (iflag_con.LT.2) THEN
270           d_tr_cv(:,:,:)=0.
271        ELSE IF (iflag_con.EQ.2) THEN
272!..Tiedke
273           CALL nflxtr(pdtphys, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
274                pplay, paprs, tr_seri(:,:,it), d_tr_cv(:,:,it))
275        ELSE
276!..K.Emanuel
277           CALL cvltr(pdtphys, da, phi, mp, paprs,pplay, tr_seri(:,:,it),&
278                upwd,dnwd,d_tr_cv(:,:,it))
279        END IF
280
281        DO k = 1, klev
282           DO i = 1, klon       
283              tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_cv(i,k,it)
284           END DO
285        END DO
286
287        CALL minmaxqfi(tr_seri(:,:,it),0.,1.e33,'convection it = '//solsym(it))
288             
289     END DO ! nbtr
290  END IF ! convection
291
292!======================================================================
293!    -- Calcul de l'effet des thermiques --
294!======================================================================
295
296  DO it=1,nbtr
297     DO k=1,klev
298        DO i=1,klon
299           d_tr_th(i,k,it)=0.
300           tr_seri(i,k,it)=MAX(tr_seri(i,k,it),0.)
301           tr_seri(i,k,it)=MIN(tr_seri(i,k,it),1.e10)
302        END DO
303     END DO
304  END DO
305 
306  IF (iflag_thermals.GT.0) THEN   
307     nsplit=10
308     DO it=1, nbtr
309        DO isplit=1,nsplit
310
311           CALL dqthermcell(klon,klev,pdtphys/nsplit, &
312                fm_therm,entr_therm,zmasse, &
313                tr_seri(1:klon,1:klev,it),d_tr,ztra_th)
314
315           DO k=1,klev
316              DO i=1,klon
317                 d_tr(i,k)=pdtphys*d_tr(i,k)/nsplit
318                 d_tr_th(i,k,it)=d_tr_th(i,k,it)+d_tr(i,k)
319                 tr_seri(i,k,it)=MAX(tr_seri(i,k,it)+d_tr(i,k),0.)
320              END DO
321           END DO
322        END DO ! nsplit
323     END DO ! it
324  END IF ! Thermiques
325
326!======================================================================
327!     -- Calcul de l'effet de la couche limite --
328!======================================================================
329
330  IF (couchelimite) THEN
331
332     DO k = 1, klev
333        DO i = 1, klon
334           delp(i,k) = paprs(i,k)-paprs(i,k+1)
335        END DO
336     END DO
337
338     DO it=1, nbtr
339       
340        IF( pbl_flg(it) /= 0 ) THEN
341       
342           CALL cltrac(pdtphys, coefh,t_seri,       &
343                tr_seri(:,:,it), source(:,it),      &
344                paprs, pplay, delp,                 &
345                d_tr_cl(:,:,it))
346           
347           DO k = 1, klev
348              DO i = 1, klon
349                 tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_cl(i,k,it)
350              END DO
351           END DO
352        END IF
353
354     END DO
355     
356  END IF ! couche limite
357
358
359!======================================================================
360!   Calcul de l'effet de la precipitation
361!======================================================================
362
363  IF (lessivage) THEN
364     
365     d_tr_lessi_nucl(:,:,:) = 0.
366     d_tr_lessi_impa(:,:,:) = 0.
367     flestottr(:,:,:) = 0.
368!=========================
369! LESSIVAGE LARGE SCALE :
370!=========================
371
372! Tendance des aerosols nuclees et impactes
373! -----------------------------------------
374     DO it = 1, nbtr
375        IF (aerosol(it)) THEN
376           DO k = 1, klev
377              DO i = 1, klon
378                 d_tr_lessi_nucl(i,k,it) = d_tr_lessi_nucl(i,k,it) +    &
379                      ( 1 - frac_nucl(i,k) )*tr_seri(i,k,it)
380                 d_tr_lessi_impa(i,k,it) = d_tr_lessi_impa(i,k,it) +    &
381                      ( 1 - frac_impa(i,k) )*tr_seri(i,k,it)
382
383!
384! Flux lessivage total
385! ------------------------------------------------------------
386                 flestottr(i,k,it) = flestottr(i,k,it) -   &
387                      ( d_tr_lessi_nucl(i,k,it)   +        &
388                      d_tr_lessi_impa(i,k,it) ) *          &
389                      ( paprs(i,k)-paprs(i,k+1) ) /        &
390                      (RG * pdtphys)
391!
392! Mise a jour des traceurs due a l'impaction,nucleation
393! ----------------------------------------------------------------------
394                 tr_seri(i,k,it)=tr_seri(i,k,it)*frac_impa(i,k)*frac_nucl(i,k)
395              END DO
396           END DO
397        END IF
398     END DO
399     
400  END IF ! lessivage
401
402!=============================================================
403!   Ecriture des sorties
404!=============================================================
405#ifdef CPP_IOIPSL
406!  INCLUDE "write_histrac.h"
407#endif
408
409END SUBROUTINE phytrac
Note: See TracBrowser for help on using the repository browser.