/[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 201 by guez, Mon Jun 6 17:42:15 2016 UTC trunk/phylmd/phytrac.f revision 266 by guez, Thu Apr 19 17:54:55 2018 UTC
# Line 7  module phytrac_m Line 7  module phytrac_m
7    
8  contains  contains
9    
10    SUBROUTINE phytrac(lmt_pas, julien, gmtime, firstcal, lafin, pdtphys, &    SUBROUTINE phytrac(julien, gmtime, firstcal, lafin, pdtphys, t_seri, paprs, &
11         t_seri, paprs, pplay, pmfu, pmfd, pde_u, pen_d, coefh, fm_therm, &         pplay, pmfu, pmfd, pde_u, pen_d, coefh, cdragh, fm_therm, entr_therm, &
12         entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, da, phi, &         yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, dnwd, &
13         mp, upwd, dnwd, 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
     use clesphys, only: ecrit_tra  
32      use clesphys2, only: conv_emanuel      use clesphys2, only: conv_emanuel
33      use cltrac_m, only: cltrac      use cltrac_m, only: cltrac
34      use cltracrn_m, only: cltracrn      use cltracrn_m, only: cltracrn
35        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 55  contains Line 55  contains
55      use SUPHEC_M, only: rg      use SUPHEC_M, only: rg
56      use time_phylmdz, only: itap      use time_phylmdz, only: itap
57    
     integer, intent(in):: lmt_pas ! number of time steps of "physics" per day  
58      integer, intent(in):: julien !jour julien, 1 <= julien <= 360      integer, intent(in):: julien !jour julien, 1 <= julien <= 360
59      real, intent(in):: gmtime ! heure de la journ\'ee en fraction de jour      real, intent(in):: gmtime ! heure de la journ\'ee en fraction de jour
60      logical, intent(in):: firstcal ! first call to "calfis"      logical, intent(in):: firstcal ! first call to "calfis"
# Line 78  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 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 124  contains Line 119  contains
119    
120      REAL, save:: trs(klon, nqmx - 2) ! Concentration de traceur dans le sol      REAL, save:: trs(klon, nqmx - 2) ! Concentration de traceur dans le sol
121    
122      REAL masktr(klon, nqmx - 2) ! Masque reservoir de sol traceur      REAL, save:: masktr(klon, nqmx - 2) ! Masque reservoir de sol traceur
123      ! Masque de l'echange avec la surface      ! Masque de l'echange avec la surface
124      ! (1 = reservoir) ou (possible => 1)      ! (1 = reservoir) ou (possible => 1)
125      SAVE masktr      
126      REAL fshtr(klon, nqmx - 2) ! Flux surfacique dans le reservoir de sol      REAL, save:: fshtr(klon, nqmx - 2)
127      SAVE fshtr      ! Flux surfacique dans le reservoir de sol
128      REAL hsoltr(nqmx - 2) ! Epaisseur equivalente du reservoir de sol      
129      SAVE hsoltr      REAL, save:: hsoltr(nqmx - 2) ! Epaisseur equivalente du reservoir de sol
130      REAL tautr(nqmx - 2) ! Constante de decroissance radioactive      REAL, save:: tautr(nqmx - 2) ! constante de d\'ecroissance radioactive
     SAVE tautr  
     REAL vdeptr(nqmx - 2) ! Vitesse de depot sec dans la couche Brownienne  
     SAVE vdeptr  
     REAL scavtr(nqmx - 2) ! Coefficient de lessivage  
     SAVE scavtr  
131    
132      CHARACTER itn      REAL, save:: vdeptr(nqmx - 2)
133        ! Vitesse de depot sec dans la couche Brownienne
134    
135      ! nature du traceur      REAL, save:: scavtr(nqmx - 2) ! Coefficient de lessivage
136        CHARACTER itn
137    
138      logical aerosol(nqmx - 2) ! Nature du traceur      logical, save:: aerosol(nqmx - 2) ! Nature du traceur
139      ! ! aerosol(it) = true => aerosol      ! ! aerosol(it) = true => aerosol
140      ! ! aerosol(it) = false => gaz      ! ! aerosol(it) = false => gaz
141      logical clsol(nqmx - 2) ! couche limite sol calcul\'ee  
142      logical radio(nqmx - 2) ! d\'ecroisssance radioactive      logical, save:: clsol(nqmx - 2) ! couche limite sol flux
143      save aerosol, clsol, radio      ! calcul\'ee, sinon prescrit
144        logical, save:: radio(nqmx - 2) ! d\'ecroisssance radioactive
145    
146      ! convection tiedtke      ! convection tiedtke
147      INTEGER i, k, it      INTEGER i, k, it
# Line 167  contains Line 160  contains
160      REAL d_tr_th(klon, llm, nqmx - 2) ! la tendance des thermiques      REAL d_tr_th(klon, llm, nqmx - 2) ! la tendance des thermiques
161      REAL d_tr_dec(klon, llm, 2) ! la tendance de la decroissance      REAL d_tr_dec(klon, llm, 2) ! la tendance de la decroissance
162      ! ! radioactive du rn - > pb      ! ! radioactive du rn - > pb
163      REAL d_tr_lessi_impa(klon, llm, nqmx - 2) ! la tendance du lessivage  
164      ! ! par impaction      REAL d_tr_lessi_impa(klon, llm, nqmx - 2)
165      REAL d_tr_lessi_nucl(klon, llm, nqmx - 2) ! la tendance du lessivage      ! tendance du lessivage par impaction
166      ! ! par nucleation  
167      REAL flestottr(klon, llm, nqmx - 2) ! flux de lessivage      REAL d_tr_lessi_nucl(klon, llm, nqmx - 2)
168      ! ! dans chaque couche      ! tendance du lessivage par nucleation
169    
170        REAL flestottr(klon, llm, nqmx - 2) ! flux de lessivage dans chaque couche
171    
172      real ztra_th(klon, llm)      real ztra_th(klon, llm)
173      integer isplit, varid      integer isplit, varid
174    
175      ! Controls:      ! Controls:
     logical:: couchelimite = .true.  
176      logical:: convection = .true.      logical:: convection = .true.
     logical:: lessivage = .true.  
     logical, save:: inirnpb  
177    
178      !--------------------------------------      !--------------------------------------
179    
# Line 189  contains Line 181  contains
181      call assert(shape(tr_seri) == (/klon, llm, nqmx - 2/), "phytrac tr_seri")      call assert(shape(tr_seri) == (/klon, llm, nqmx - 2/), "phytrac tr_seri")
182    
183      if (firstcal) then      if (firstcal) then
        print *, 'phytrac: pdtphys = ', pdtphys  
        PRINT *, 'Frequency of tracer output: ecrit_tra = ', ecrit_tra  
        inirnpb = .true.  
   
184         ! Initialisation de certaines variables pour le radon et le plomb         ! Initialisation de certaines variables pour le radon et le plomb
185         ! Initialisation du traceur dans le sol (couche limite radonique)         ! Initialisation du traceur dans le sol (couche limite radonique)
186         trs(:, 2:) = 0.         trs(:, 2:) = 0.
# Line 209  contains Line 197  contains
197    
198         ! Initialisation de la nature des traceurs         ! Initialisation de la nature des traceurs
199    
200         DO it = 1, nqmx - 2         aerosol = .FALSE. ! Tous les traceurs sont des gaz par defaut
201            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  
202    
203         if (nqmx >= 5) then         if (nqmx >= 5) then
204            call press_coefoz ! read input pressure levels for ozone coefficients            call press_coefoz ! read input pressure levels for ozone coefficients
205         end if         end if
     ENDIF  
206    
     if (inirnpb) THEN  
207         ! Initialisation du traceur dans le sol (couche limite radonique)         ! Initialisation du traceur dans le sol (couche limite radonique)
208         radio(1)= .true.         radio(1)= .true.
209         radio(2)= .true.         radio(2)= .true.
210         clsol(1)= .true.         clsol(:2)= .true.
211         clsol(2)= .true.         clsol(3:)= .false.
212         aerosol(2) = .TRUE. ! le Pb est un aerosol         aerosol(2) = .TRUE. ! le Pb est un aerosol
213         call initrrnpb(pctsrf, masktr, fshtr, hsoltr, tautr, vdeptr, scavtr)         call initrrnpb(pctsrf, masktr, fshtr, hsoltr, tautr, vdeptr, scavtr)
        inirnpb=.false.  
214      endif      endif
215    
216      if (convection) then      if (convection) then
# Line 287  contains Line 269  contains
269    
270      ! Calcul de l'effet de la couche limite      ! Calcul de l'effet de la couche limite
271    
272      if (couchelimite) then      DO k = 1, llm
273         DO k = 1, llm         DO i = 1, klon
274            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  
275         ENDDO         ENDDO
276        ENDDO
277    
278         ! MAF modif pour tenir compte du cas traceur      ! MAF modif pour tenir compte du cas traceur
279         DO it=1, nqmx - 2      DO it=1, nqmx - 2
280            if (clsol(it)) then         if (clsol(it)) then
281               ! couche limite avec quantite dans le sol calculee            ! couche limite avec quantite dans le sol calculee
282               CALL cltracrn(it, pdtphys, yu1, yv1, coefh, t_seri, ftsol, &            CALL cltracrn(it, pdtphys, yu1, yv1, coefh, cdragh, t_seri, ftsol, &
283                    pctsrf, tr_seri(:, :, it), trs(:, it), paprs, pplay, delp, &                 pctsrf, tr_seri(:, :, it), trs(:, it), paprs, pplay, delp, &
284                    masktr(1, it), fshtr(1, it), hsoltr(it), tautr(it), &                 masktr(1, it), fshtr(1, it), hsoltr(it), tautr(it), &
285                    vdeptr(it), rlat, d_tr_cl(1, 1, it), d_trs)                 vdeptr(it), rlat, d_tr_cl(1, 1, it), d_trs)
286               DO k = 1, llm            DO k = 1, llm
287                  DO i = 1, klon               DO i = 1, klon
288                     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  
289               ENDDO               ENDDO
290              ENDDO
291    
292               trs(:, it) = trs(:, it) + d_trs            trs(:, it) = trs(:, it) + d_trs
293            else         else
294               ! couche limite avec flux prescrit            ! couche limite avec flux prescrit
295               !MAF provisoire source / traceur a creer            !MAF provisoire source / traceur a creer
296               DO i=1, klon            DO i=1, klon
297                  source(i) = 0. ! pas de source, pour l'instant               source(i) = 0. ! pas de source, pour l'instant
298               ENDDO            ENDDO
299    
300               CALL cltrac(pdtphys, coefh, t_seri, tr_seri(:, :, it), source, &            CALL cltrac(pdtphys, coefh, t_seri, tr_seri(:, :, it), source, &
301                    paprs, pplay, delp, d_tr_cl(1, 1, it))                 paprs, pplay, delp, d_tr_cl(1, 1, it))
302               DO k = 1, llm            DO k = 1, llm
303                  DO i = 1, klon               DO i = 1, klon
304                     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  
305               ENDDO               ENDDO
306            endif            ENDDO
307         ENDDO         endif
308      endif      ENDDO
309    
310      ! Calcul de l'effet du puits radioactif      ! Calcul de l'effet du puits radioactif
311    
# Line 351  contains Line 331  contains
331    
332      ! Calcul de l'effet de la precipitation      ! Calcul de l'effet de la precipitation
333    
334      IF (lessivage) THEN      d_tr_lessi_nucl = 0.
335         d_tr_lessi_nucl = 0.      d_tr_lessi_impa = 0.
336         d_tr_lessi_impa = 0.      flestottr = 0.
        flestottr = 0.  
337    
338         ! tendance des aerosols nuclees et impactes      ! tendance des aerosols nuclees et impactes
339    
340         DO it = 1, nqmx - 2      DO it = 1, nqmx - 2
341            IF (aerosol(it)) THEN         IF (aerosol(it)) THEN
342               DO k = 1, llm            DO k = 1, llm
343                  DO i = 1, klon               DO i = 1, klon
344                     d_tr_lessi_nucl(i, k, it) = d_tr_lessi_nucl(i, k, it) + &                  d_tr_lessi_nucl(i, k, it) = d_tr_lessi_nucl(i, k, it) + &
345                          (1 - frac_nucl(i, k))*tr_seri(i, k, it)                       (1 - frac_nucl(i, k))*tr_seri(i, k, it)
346                     d_tr_lessi_impa(i, k, it) = d_tr_lessi_impa(i, k, it) + &                  d_tr_lessi_impa(i, k, it) = d_tr_lessi_impa(i, k, it) + &
347                          (1 - frac_impa(i, k))*tr_seri(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  
   
        DO it = 1, nqmx - 2  
           IF (aerosol(it)) THEN  
              DO k = 1, llm  
                 DO i = 1, klon  
                    tr_seri(i, k, it) = tr_seri(i, k, it) * frac_impa(i, k) &  
                         * frac_nucl(i, k)  
                 ENDDO  
348               ENDDO               ENDDO
349            ENDIF            ENDDO
350         ENDDO         ENDIF
351        ENDDO
352    
353         ! Flux lessivage total      ! Mises a jour des traceurs + calcul des flux de lessivage
354        ! Mise a jour due a l'impaction et a la nucleation
355    
356         DO it = 1, nqmx - 2      DO it = 1, nqmx - 2
357           IF (aerosol(it)) THEN
358            DO k = 1, llm            DO k = 1, llm
359               DO i = 1, klon               DO i = 1, klon
360                  flestottr(i, k, it) = flestottr(i, k, it) &                  tr_seri(i, k, it) = tr_seri(i, k, it) * frac_impa(i, k) &
361                       - (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)  
362               ENDDO               ENDDO
363            ENDDO            ENDDO
364           ENDIF
365        ENDDO
366    
367        ! Flux lessivage total
368        DO it = 1, nqmx - 2
369           DO k = 1, llm
370              DO i = 1, klon
371                 flestottr(i, k, it) = flestottr(i, k, it) &
372                      - (d_tr_lessi_nucl(i, k, it) + d_tr_lessi_impa(i, k, it)) &
373                      * (paprs(i, k)-paprs(i, k+1)) / (RG * pdtphys)
374              ENDDO
375         ENDDO         ENDDO
376      ENDIF      ENDDO
377    
378      ! Ecriture des sorties      ! Ecriture des sorties
379      CALL histwrite_phy("zmasse", zmasse)      CALL histwrite_phy("zmasse", zmasse)
380      DO it=1, nqmx - 2      DO it=1, nqmx - 2
381         CALL histwrite_phy(tname(it+2), tr_seri(:, :, it))         CALL histwrite_phy(tname(it+2), tr_seri(:, :, it))
382         if (lessivage) THEN         CALL histwrite_phy("fl"//tname(it+2), flestottr(:, :, it))
           CALL histwrite_phy("fl"//tname(it+2), flestottr(:, :, it))  
        endif  
383         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))
384         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))
385         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.201  
changed lines
  Added in v.266
  ViewVC Help
Powered by ViewVC 1.1.21