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

Diff of /trunk/phylmd/phytrac.f

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

revision 203 by guez, Wed Jun 8 15:10:12 2016 UTC revision 227 by guez, Thu Nov 2 15:47:03 2017 UTC
# Line 12  contains Line 12  contains
12         yv1, ftsol, pctsrf, frac_impa, frac_nucl, da, phi, mp, upwd, dnwd, &         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 78  contains Line 78  contains
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(klon, llm) ! coeff melange couche limite
81        real fm_therm(klon, llm+1), entr_therm(klon, llm) ! thermiques
82      ! thermiques:      REAL, intent(in):: yu1(:), yv1(:) ! (klon) vent au premier niveau
     real fm_therm(klon, llm+1), entr_therm(klon, llm)  
   
     ! Couche limite:  
     REAL yu1(klon) ! vents au premier niveau  
     REAL yv1(klon) ! vents au premier niveau  
83    
84      ! Arguments n\'ecessaires pour les sources et puits de traceur :      ! Arguments n\'ecessaires pour les sources et puits de traceur :
85      real, intent(in):: ftsol(klon, nbsrf) ! Temperature du sol (surf)(Kelvin)      real, intent(in):: ftsol(:, :) ! (klon, nbsrf) surface temperature (K)
86      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)
87    
88      ! Lessivage pour le on-line      ! Lessivage pour le on-line
89      REAL frac_impa(klon, llm) ! fraction d'aerosols impactes      REAL, intent(in):: frac_impa(klon, llm) ! fraction d'aerosols impactes
90      REAL frac_nucl(klon, llm) ! fraction d'aerosols nuclees      REAL, intent(in):: frac_nucl(klon, llm) ! fraction d'aerosols nuclees
91    
92      ! Kerry Emanuel      ! Kerry Emanuel
93      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 135  contains
135    
136      CHARACTER itn      CHARACTER itn
137    
138      ! nature du traceur      logical, save:: aerosol(nqmx - 2) ! Nature du traceur
   
     logical 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 166  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 188  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  
        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 207  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 285  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, 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 349  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.  
   
        ! tendance des aerosols nuclees et impactes  
337    
338         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  
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                     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) + &
345                          * frac_nucl(i, k)                       (1 - frac_nucl(i, k))*tr_seri(i, k, it)
346                  ENDDO                  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)
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.203  
changed lines
  Added in v.227
  ViewVC Help
Powered by ViewVC 1.1.21