/[lmdze]/trunk/phylmd/phytrac.f
ViewVC logotype

Diff of /trunk/phylmd/phytrac.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/Sources/phylmd/phytrac.f revision 203 by guez, Wed Jun 8 15:10:12 2016 UTC trunk/phylmd/phytrac.f revision 265 by guez, Tue Mar 20 09:35:59 2018 UTC
# Line 8  module phytrac_m Line 8  module phytrac_m
8  contains  contains
9    
10    SUBROUTINE phytrac(julien, gmtime, firstcal, lafin, pdtphys, t_seri, paprs, &    SUBROUTINE phytrac(julien, gmtime, firstcal, lafin, pdtphys, t_seri, paprs, &
11         pplay, pmfu, pmfd, pde_u, pen_d, coefh, fm_therm, entr_therm, yu1, &         pplay, pmfu, pmfd, pde_u, pen_d, coefh, cdragh, fm_therm, entr_therm, &
12         yv1, ftsol, pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, dnwd, &         yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, dnwd, &
13         tr_seri, zmasse, ncid_startphy)         tr_seri, zmasse, ncid_startphy)
14    
15      ! From phylmd/phytrac.F, version 1.15 2006/02/21 08:08:30 (SVN      ! From phylmd/phytrac.F, version 1.15, 2006/02/21 08:08:30 (SVN
16      ! revision 679) and phylmd/write_histrac.h, version 1.9 2006/02/21      ! revision 679) and phylmd/write_histrac.h, version 1.9,
17      ! 08:08:30      ! 2006/02/21 08:08:30
18    
19      ! Authors: Fr\'ed\'eric Hourdin, Abderrahmane Idelkadi, Marie-Alice      ! Authors: Fr\'ed\'eric Hourdin, Abderrahmane Idelkadi, Marie-Alice
20      ! Foujols, Olivia      ! Foujols
21    
22      ! Objet : moniteur g\'en\'eral des tendances des traceurs      ! Objet : moniteur g\'en\'eral des tendances des traceurs
23    
# Line 25  contains Line 25  contains
25      ! bien les vrais traceurs, sans la vapeur d'eau ni l'eau liquide.      ! bien les vrais traceurs, sans la vapeur d'eau ni l'eau liquide.
26    
27      ! Modifications pour les traceurs :      ! Modifications pour les traceurs :
28      ! - uniformisation des parametrisations dans phytrac      ! - uniformisation des param\'etrisations dans phytrac
29      ! - stockage des moyennes des champs n\'ecessaires en mode traceur off-line      ! - stockage des moyennes des champs n\'ecessaires en mode traceur off-line
30    
31      use abort_gcm_m, only: abort_gcm      use abort_gcm_m, only: abort_gcm
# Line 35  contains Line 35  contains
35      USE conf_gcm_m, ONLY: lmt_pas      USE conf_gcm_m, ONLY: lmt_pas
36      use ctherm, only: iflag_thermals      use ctherm, only: iflag_thermals
37      use cvltr_m, only: cvltr      use cvltr_m, only: cvltr
38      use dimens_m, only: llm, nqmx      use dimensions, only: llm, nqmx
39      use dimphy, only: klon      use dimphy, only: klon
40      use histwrite_phy_m, only: histwrite_phy      use histwrite_phy_m, only: histwrite_phy
41      use indicesol, only: nbsrf      use indicesol, only: nbsrf
# Line 77  contains Line 77  contains
77    
78      REAL pde_u(klon, llm) ! flux detraine dans le panache montant      REAL pde_u(klon, llm) ! flux detraine dans le panache montant
79      REAL pen_d(klon, llm) ! flux entraine dans le panache descendant      REAL pen_d(klon, llm) ! flux entraine dans le panache descendant
80      REAL coefh(klon, llm) ! coeff melange couche limite      REAL coefh(:, 2:) ! (klon, 2:llm) coeff melange couche limite
81        real cdragh(:) ! (klon)
82      ! thermiques:      real fm_therm(klon, llm+1), entr_therm(klon, llm) ! thermiques
83      real fm_therm(klon, llm+1), entr_therm(klon, llm)      REAL, intent(in):: yu1(:), yv1(:) ! (klon) vent au premier niveau
   
     ! Couche limite:  
     REAL yu1(klon) ! vents au premier niveau  
     REAL yv1(klon) ! vents au premier niveau  
84    
85      ! Arguments n\'ecessaires pour les sources et puits de traceur :      ! Arguments n\'ecessaires pour les sources et puits de traceur :
86      real, intent(in):: ftsol(klon, nbsrf) ! Temperature du sol (surf)(Kelvin)      real, intent(in):: ftsol(:, :) ! (klon, nbsrf) surface temperature (K)
87      real, intent(in):: pctsrf(klon, nbsrf) ! Pourcentage de sol f(nature du sol)      real, intent(in):: pctsrf(klon, nbsrf) ! Pourcentage de sol f(nature du sol)
88    
89      ! Lessivage pour le on-line      ! Lessivage pour le on-line
90      REAL frac_impa(klon, llm) ! fraction d'aerosols impactes      REAL, intent(in):: frac_impa(klon, llm) ! fraction d'aerosols impactes
91      REAL frac_nucl(klon, llm) ! fraction d'aerosols nuclees      REAL, intent(in):: frac_nucl(klon, llm) ! fraction d'aerosols nuclees
92    
93      ! Kerry Emanuel      ! Kerry Emanuel
94      real, intent(in):: da(klon, llm), phi(klon, llm, llm), mp(klon, llm)      real, intent(in):: da(klon, llm), phi(klon, llm, llm), mp(klon, llm)
# Line 140  contains Line 136  contains
136    
137      CHARACTER itn      CHARACTER itn
138    
139      ! nature du traceur      logical, save:: aerosol(nqmx - 2) ! Nature du traceur
   
     logical aerosol(nqmx - 2) ! Nature du traceur  
140      ! ! aerosol(it) = true => aerosol      ! ! aerosol(it) = true => aerosol
141      ! ! aerosol(it) = false => gaz      ! ! aerosol(it) = false => gaz
142      logical clsol(nqmx - 2) ! couche limite sol calcul\'ee  
143      logical radio(nqmx - 2) ! d\'ecroisssance radioactive      logical, save:: clsol(nqmx - 2) ! couche limite sol flux
144      save aerosol, clsol, radio      ! calcul\'ee, sinon prescrit
145        logical, save:: radio(nqmx - 2) ! d\'ecroisssance radioactive
146    
147      ! convection tiedtke      ! convection tiedtke
148      INTEGER i, k, it      INTEGER i, k, it
# Line 166  contains Line 161  contains
161      REAL d_tr_th(klon, llm, nqmx - 2) ! la tendance des thermiques      REAL d_tr_th(klon, llm, nqmx - 2) ! la tendance des thermiques
162      REAL d_tr_dec(klon, llm, 2) ! la tendance de la decroissance      REAL d_tr_dec(klon, llm, 2) ! la tendance de la decroissance
163      ! ! radioactive du rn - > pb      ! ! radioactive du rn - > pb
164      REAL d_tr_lessi_impa(klon, llm, nqmx - 2) ! la tendance du lessivage  
165      ! ! par impaction      REAL d_tr_lessi_impa(klon, llm, nqmx - 2)
166      REAL d_tr_lessi_nucl(klon, llm, nqmx - 2) ! la tendance du lessivage      ! tendance du lessivage par impaction
167      ! ! par nucleation  
168      REAL flestottr(klon, llm, nqmx - 2) ! flux de lessivage      REAL d_tr_lessi_nucl(klon, llm, nqmx - 2)
169      ! ! dans chaque couche      ! tendance du lessivage par nucleation
170    
171        REAL flestottr(klon, llm, nqmx - 2) ! flux de lessivage dans chaque couche
172    
173      real ztra_th(klon, llm)      real ztra_th(klon, llm)
174      integer isplit, varid      integer isplit, varid
175    
176      ! Controls:      ! Controls:
     logical:: couchelimite = .true.  
177      logical:: convection = .true.      logical:: convection = .true.
     logical:: lessivage = .true.  
     logical, save:: inirnpb  
178    
179      !--------------------------------------      !--------------------------------------
180    
# Line 188  contains Line 182  contains
182      call assert(shape(tr_seri) == (/klon, llm, nqmx - 2/), "phytrac tr_seri")      call assert(shape(tr_seri) == (/klon, llm, nqmx - 2/), "phytrac tr_seri")
183    
184      if (firstcal) then      if (firstcal) then
        print *, 'phytrac: pdtphys = ', pdtphys  
        inirnpb = .true.  
   
185         ! Initialisation de certaines variables pour le radon et le plomb         ! Initialisation de certaines variables pour le radon et le plomb
186         ! Initialisation du traceur dans le sol (couche limite radonique)         ! Initialisation du traceur dans le sol (couche limite radonique)
187         trs(:, 2:) = 0.         trs(:, 2:) = 0.
# Line 207  contains Line 198  contains
198    
199         ! Initialisation de la nature des traceurs         ! Initialisation de la nature des traceurs
200    
201         DO it = 1, nqmx - 2         aerosol = .FALSE. ! Tous les traceurs sont des gaz par defaut
202            aerosol(it) = .FALSE. ! Tous les traceurs sont des gaz par defaut         radio = .FALSE. ! par d\'efaut pas de passage par "radiornpb"
           radio(it) = .FALSE. ! par d\'efaut pas de passage par "radiornpb"  
           clsol(it) = .FALSE. ! Par defaut couche limite avec flux prescrit  
        ENDDO  
203    
204         if (nqmx >= 5) then         if (nqmx >= 5) then
205            call press_coefoz ! read input pressure levels for ozone coefficients            call press_coefoz ! read input pressure levels for ozone coefficients
206         end if         end if
     ENDIF  
207    
     if (inirnpb) THEN  
208         ! Initialisation du traceur dans le sol (couche limite radonique)         ! Initialisation du traceur dans le sol (couche limite radonique)
209         radio(1)= .true.         radio(1)= .true.
210         radio(2)= .true.         radio(2)= .true.
211         clsol(1)= .true.         clsol(:2)= .true.
212         clsol(2)= .true.         clsol(3:)= .false.
213         aerosol(2) = .TRUE. ! le Pb est un aerosol         aerosol(2) = .TRUE. ! le Pb est un aerosol
214         call initrrnpb(pctsrf, masktr, fshtr, hsoltr, tautr, vdeptr, scavtr)         call initrrnpb(pctsrf, masktr, fshtr, hsoltr, tautr, vdeptr, scavtr)
        inirnpb=.false.  
215      endif      endif
216    
217      if (convection) then      if (convection) then
# Line 285  contains Line 270  contains
270    
271      ! Calcul de l'effet de la couche limite      ! Calcul de l'effet de la couche limite
272    
273      if (couchelimite) then      DO k = 1, llm
274         DO k = 1, llm         DO i = 1, klon
275            DO i = 1, klon            delp(i, k) = paprs(i, k)-paprs(i, k+1)
              delp(i, k) = paprs(i, k)-paprs(i, k+1)  
           ENDDO  
276         ENDDO         ENDDO
277        ENDDO
278    
279         ! MAF modif pour tenir compte du cas traceur      ! MAF modif pour tenir compte du cas traceur
280         DO it=1, nqmx - 2      DO it=1, nqmx - 2
281            if (clsol(it)) then         if (clsol(it)) then
282               ! couche limite avec quantite dans le sol calculee            ! couche limite avec quantite dans le sol calculee
283               CALL cltracrn(it, pdtphys, yu1, yv1, coefh, t_seri, ftsol, &            CALL cltracrn(it, pdtphys, yu1, yv1, coefh, cdragh, t_seri, ftsol, &
284                    pctsrf, tr_seri(:, :, it), trs(:, it), paprs, pplay, delp, &                 pctsrf, tr_seri(:, :, it), trs(:, it), paprs, pplay, delp, &
285                    masktr(1, it), fshtr(1, it), hsoltr(it), tautr(it), &                 masktr(1, it), fshtr(1, it), hsoltr(it), tautr(it), &
286                    vdeptr(it), rlat, d_tr_cl(1, 1, it), d_trs)                 vdeptr(it), rlat, d_tr_cl(1, 1, it), d_trs)
287               DO k = 1, llm            DO k = 1, llm
288                  DO i = 1, klon               DO i = 1, klon
289                     tr_seri(i, k, it) = tr_seri(i, k, it) + d_tr_cl(i, k, it)                  tr_seri(i, k, it) = tr_seri(i, k, it) + d_tr_cl(i, k, it)
                 ENDDO  
290               ENDDO               ENDDO
291              ENDDO
292    
293               trs(:, it) = trs(:, it) + d_trs            trs(:, it) = trs(:, it) + d_trs
294            else         else
295               ! couche limite avec flux prescrit            ! couche limite avec flux prescrit
296               !MAF provisoire source / traceur a creer            !MAF provisoire source / traceur a creer
297               DO i=1, klon            DO i=1, klon
298                  source(i) = 0. ! pas de source, pour l'instant               source(i) = 0. ! pas de source, pour l'instant
299               ENDDO            ENDDO
300    
301               CALL cltrac(pdtphys, coefh, t_seri, tr_seri(:, :, it), source, &            CALL cltrac(pdtphys, coefh, t_seri, tr_seri(:, :, it), source, &
302                    paprs, pplay, delp, d_tr_cl(1, 1, it))                 paprs, pplay, delp, d_tr_cl(1, 1, it))
303               DO k = 1, llm            DO k = 1, llm
304                  DO i = 1, klon               DO i = 1, klon
305                     tr_seri(i, k, it) = tr_seri(i, k, it) + d_tr_cl(i, k, it)                  tr_seri(i, k, it) = tr_seri(i, k, it) + d_tr_cl(i, k, it)
                 ENDDO  
306               ENDDO               ENDDO
307            endif            ENDDO
308         ENDDO         endif
309      endif      ENDDO
310    
311      ! Calcul de l'effet du puits radioactif      ! Calcul de l'effet du puits radioactif
312    
# Line 349  contains Line 332  contains
332    
333      ! Calcul de l'effet de la precipitation      ! Calcul de l'effet de la precipitation
334    
335      IF (lessivage) THEN      d_tr_lessi_nucl = 0.
336         d_tr_lessi_nucl = 0.      d_tr_lessi_impa = 0.
337         d_tr_lessi_impa = 0.      flestottr = 0.
        flestottr = 0.  
   
        ! tendance des aerosols nuclees et impactes  
338    
339         DO it = 1, nqmx - 2      ! tendance des aerosols nuclees et impactes
           IF (aerosol(it)) THEN  
              DO k = 1, llm  
                 DO i = 1, klon  
                    d_tr_lessi_nucl(i, k, it) = d_tr_lessi_nucl(i, k, it) + &  
                         (1 - frac_nucl(i, k))*tr_seri(i, k, it)  
                    d_tr_lessi_impa(i, k, it) = d_tr_lessi_impa(i, k, it) + &  
                         (1 - frac_impa(i, k))*tr_seri(i, k, it)  
                 ENDDO  
              ENDDO  
           ENDIF  
        ENDDO  
   
        ! Mises a jour des traceurs + calcul des flux de lessivage  
        ! Mise a jour due a l'impaction et a la nucleation  
340    
341         DO it = 1, nqmx - 2      DO it = 1, nqmx - 2
342            IF (aerosol(it)) THEN         IF (aerosol(it)) THEN
343               DO k = 1, llm            DO k = 1, llm
344                  DO i = 1, klon               DO i = 1, klon
345                     tr_seri(i, k, it) = tr_seri(i, k, it) * frac_impa(i, k) &                  d_tr_lessi_nucl(i, k, it) = d_tr_lessi_nucl(i, k, it) + &
346                          * frac_nucl(i, k)                       (1 - frac_nucl(i, k))*tr_seri(i, k, it)
347                  ENDDO                  d_tr_lessi_impa(i, k, it) = d_tr_lessi_impa(i, k, it) + &
348                         (1 - frac_impa(i, k))*tr_seri(i, k, it)
349               ENDDO               ENDDO
350            ENDIF            ENDDO
351         ENDDO         ENDIF
352        ENDDO
353    
354         ! Flux lessivage total      ! Mises a jour des traceurs + calcul des flux de lessivage
355        ! Mise a jour due a l'impaction et a la nucleation
356    
357         DO it = 1, nqmx - 2      DO it = 1, nqmx - 2
358           IF (aerosol(it)) THEN
359            DO k = 1, llm            DO k = 1, llm
360               DO i = 1, klon               DO i = 1, klon
361                  flestottr(i, k, it) = flestottr(i, k, it) &                  tr_seri(i, k, it) = tr_seri(i, k, it) * frac_impa(i, k) &
362                       - (d_tr_lessi_nucl(i, k, it) + d_tr_lessi_impa(i, k, it)) &                       * frac_nucl(i, k)
                      * (paprs(i, k)-paprs(i, k+1)) / (RG * pdtphys)  
363               ENDDO               ENDDO
364            ENDDO            ENDDO
365           ENDIF
366        ENDDO
367    
368        ! Flux lessivage total
369        DO it = 1, nqmx - 2
370           DO k = 1, llm
371              DO i = 1, klon
372                 flestottr(i, k, it) = flestottr(i, k, it) &
373                      - (d_tr_lessi_nucl(i, k, it) + d_tr_lessi_impa(i, k, it)) &
374                      * (paprs(i, k)-paprs(i, k+1)) / (RG * pdtphys)
375              ENDDO
376         ENDDO         ENDDO
377      ENDIF      ENDDO
378    
379      ! Ecriture des sorties      ! Ecriture des sorties
380      CALL histwrite_phy("zmasse", zmasse)      CALL histwrite_phy("zmasse", zmasse)
381      DO it=1, nqmx - 2      DO it=1, nqmx - 2
382         CALL histwrite_phy(tname(it+2), tr_seri(:, :, it))         CALL histwrite_phy(tname(it+2), tr_seri(:, :, it))
383         if (lessivage) THEN         CALL histwrite_phy("fl"//tname(it+2), flestottr(:, :, it))
           CALL histwrite_phy("fl"//tname(it+2), flestottr(:, :, it))  
        endif  
384         CALL histwrite_phy("d_tr_th_"//tname(it+2), d_tr_th(:, :, it))         CALL histwrite_phy("d_tr_th_"//tname(it+2), d_tr_th(:, :, it))
385         CALL histwrite_phy("d_tr_cv_"//tname(it+2), d_tr_cv(:, :, it))         CALL histwrite_phy("d_tr_cv_"//tname(it+2), d_tr_cv(:, :, it))
386         CALL histwrite_phy("d_tr_cl_"//tname(it+2), d_tr_cl(:, :, it))         CALL histwrite_phy("d_tr_cl_"//tname(it+2), d_tr_cl(:, :, it))
Legend:
Removed from v.203  
changed lines
  Added in v.265
  ViewVC Help
Powered by ViewVC 1.1.21