/[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 213 by guez, Mon Feb 27 15:44:55 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 91  contains Line 91  contains
91      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)
92    
93      ! Lessivage pour le on-line      ! Lessivage pour le on-line
94      REAL frac_impa(klon, llm) ! fraction d'aerosols impactes      REAL, intent(in):: frac_impa(klon, llm) ! fraction d'aerosols impactes
95      REAL frac_nucl(klon, llm) ! fraction d'aerosols nuclees      REAL, intent(in):: frac_nucl(klon, llm) ! fraction d'aerosols nuclees
96    
97      ! Kerry Emanuel      ! Kerry Emanuel
98      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 166  contains Line 166  contains
166      REAL d_tr_th(klon, llm, nqmx - 2) ! la tendance des thermiques      REAL d_tr_th(klon, llm, nqmx - 2) ! la tendance des thermiques
167      REAL d_tr_dec(klon, llm, 2) ! la tendance de la decroissance      REAL d_tr_dec(klon, llm, 2) ! la tendance de la decroissance
168      ! ! radioactive du rn - > pb      ! ! radioactive du rn - > pb
169      REAL d_tr_lessi_impa(klon, llm, nqmx - 2) ! la tendance du lessivage  
170      ! ! par impaction      REAL d_tr_lessi_impa(klon, llm, nqmx - 2)
171      REAL d_tr_lessi_nucl(klon, llm, nqmx - 2) ! la tendance du lessivage      ! tendance du lessivage par impaction
172      ! ! par nucleation  
173      REAL flestottr(klon, llm, nqmx - 2) ! flux de lessivage      REAL d_tr_lessi_nucl(klon, llm, nqmx - 2)
174      ! ! dans chaque couche      ! tendance du lessivage par nucleation
175    
176        REAL flestottr(klon, llm, nqmx - 2) ! flux de lessivage dans chaque couche
177    
178      real ztra_th(klon, llm)      real ztra_th(klon, llm)
179      integer isplit, varid      integer isplit, varid
# Line 179  contains Line 181  contains
181      ! Controls:      ! Controls:
182      logical:: couchelimite = .true.      logical:: couchelimite = .true.
183      logical:: convection = .true.      logical:: convection = .true.
     logical:: lessivage = .true.  
184      logical, save:: inirnpb      logical, save:: inirnpb
185    
186      !--------------------------------------      !--------------------------------------
# Line 188  contains Line 189  contains
189      call assert(shape(tr_seri) == (/klon, llm, nqmx - 2/), "phytrac tr_seri")      call assert(shape(tr_seri) == (/klon, llm, nqmx - 2/), "phytrac tr_seri")
190    
191      if (firstcal) then      if (firstcal) then
        print *, 'phytrac: pdtphys = ', pdtphys  
192         inirnpb = .true.         inirnpb = .true.
193    
194         ! Initialisation de certaines variables pour le radon et le plomb         ! Initialisation de certaines variables pour le radon et le plomb
# Line 349  contains Line 349  contains
349    
350      ! Calcul de l'effet de la precipitation      ! Calcul de l'effet de la precipitation
351    
352      IF (lessivage) THEN      d_tr_lessi_nucl = 0.
353         d_tr_lessi_nucl = 0.      d_tr_lessi_impa = 0.
354         d_tr_lessi_impa = 0.      flestottr = 0.
        flestottr = 0.  
355    
356         ! tendance des aerosols nuclees et impactes      ! tendance des aerosols nuclees et impactes
357    
358         DO it = 1, nqmx - 2      DO it = 1, nqmx - 2
359            IF (aerosol(it)) THEN         IF (aerosol(it)) THEN
360               DO k = 1, llm            DO k = 1, llm
361                  DO i = 1, klon               DO i = 1, klon
362                     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) + &
363                          (1 - frac_nucl(i, k))*tr_seri(i, k, it)                       (1 - frac_nucl(i, k))*tr_seri(i, k, it)
364                     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) + &
365                          (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  
366               ENDDO               ENDDO
367            ENDIF            ENDDO
368         ENDDO         ENDIF
369        ENDDO
370    
371         ! Flux lessivage total      ! Mises a jour des traceurs + calcul des flux de lessivage
372        ! Mise a jour due a l'impaction et a la nucleation
373    
374         DO it = 1, nqmx - 2      DO it = 1, nqmx - 2
375           IF (aerosol(it)) THEN
376            DO k = 1, llm            DO k = 1, llm
377               DO i = 1, klon               DO i = 1, klon
378                  flestottr(i, k, it) = flestottr(i, k, it) &                  tr_seri(i, k, it) = tr_seri(i, k, it) * frac_impa(i, k) &
379                       - (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)  
380               ENDDO               ENDDO
381            ENDDO            ENDDO
382           ENDIF
383        ENDDO
384    
385        ! Flux lessivage total
386        DO it = 1, nqmx - 2
387           DO k = 1, llm
388              DO i = 1, klon
389                 flestottr(i, k, it) = flestottr(i, k, it) &
390                      - (d_tr_lessi_nucl(i, k, it) + d_tr_lessi_impa(i, k, it)) &
391                      * (paprs(i, k)-paprs(i, k+1)) / (RG * pdtphys)
392              ENDDO
393         ENDDO         ENDDO
394      ENDIF      ENDDO
395    
396      ! Ecriture des sorties      ! Ecriture des sorties
397      CALL histwrite_phy("zmasse", zmasse)      CALL histwrite_phy("zmasse", zmasse)
398      DO it=1, nqmx - 2      DO it=1, nqmx - 2
399         CALL histwrite_phy(tname(it+2), tr_seri(:, :, it))         CALL histwrite_phy(tname(it+2), tr_seri(:, :, it))
400         if (lessivage) THEN         CALL histwrite_phy("fl"//tname(it+2), flestottr(:, :, it))
           CALL histwrite_phy("fl"//tname(it+2), flestottr(:, :, it))  
        endif  
401         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))
402         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))
403         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.213
  ViewVC Help
Powered by ViewVC 1.1.21