/[lmdze]/trunk/phylmd/Thermcell/thermcell.f
ViewVC logotype

Diff of /trunk/phylmd/Thermcell/thermcell.f

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

trunk/phylmd/Thermcell/thermcell.f revision 105 by guez, Thu Sep 4 10:40:24 2014 UTC trunk/Sources/phylmd/Thermcell/thermcell.f revision 178 by guez, Fri Mar 11 18:47:26 2016 UTC
# Line 8  contains Line 8  contains
8         po, pduadj, pdvadj, pdtadj, pdoadj, fm0, entr0, r_aspect, l_mix, w2di, &         po, pduadj, pdvadj, pdtadj, pdoadj, fm0, entr0, r_aspect, l_mix, w2di, &
9         tho)         tho)
10    
11      ! Calcul du transport vertical dans la couche limite en présence      ! Calcul du transport vertical dans la couche limite en pr\'esence
12      ! de "thermiques" explicitement représentés. Récriture à partir      ! de "thermiques" explicitement repr\'esent\'es. R\'ecriture \`a partir
13      ! d'un listing papier à Habas, le 14/02/00. Le thermique est      ! d'un listing papier \`a Habas, le 14/02/00. Le thermique est
14      ! supposé homogène et dissipé par mélange avec son      ! suppos\'e homog\`ene et dissip\'e par m\'elange avec son
15      ! environnement. La longueur "l_mix" contrôle l'efficacité du      ! environnement. La longueur "l_mix" contr\^ole l'efficacit\'e du
16      ! mélange. Le calcul du transport des différentes espèces se fait      ! m\'elange. Le calcul du transport des diff\'erentes esp\`eces se fait
17      ! en prenant en compte :      ! en prenant en compte :
18      ! 1. un flux de masse montant      ! 1. un flux de masse montant
19      ! 2. un flux de masse descendant      ! 2. un flux de masse descendant
20      ! 3. un entraînement      ! 3. un entra\^inement
21      ! 4. un détraînement      ! 4. un d\'etra\^inement
22    
23      USE dimphy, ONLY : klev, klon      USE dimphy, ONLY : klev, klon
24      USE suphec_m, ONLY : rd, rg, rkappa      USE suphec_m, ONLY : rd, rg, rkappa
# Line 46  contains Line 46  contains
46      ! local:      ! local:
47    
48      INTEGER ig, k, l, lmaxa(klon), lmix(klon)      INTEGER ig, k, l, lmaxa(klon), lmix(klon)
     real zsortie1d(klon)  
49      ! CR: on remplace lmax(klon, klev+1)      ! CR: on remplace lmax(klon, klev+1)
50      INTEGER lmax(klon), lmin(klon), lentr(klon)      INTEGER lmax(klon), lmin(klon), lentr(klon)
51      real linter(klon)      real linter(klon)
52      real zmix(klon), fracazmix(klon)      real zmix(klon), fracazmix(klon)
53    
54      real zmax(klon), zw, zz, zw2(klon, klev+1), ztva(klon, klev), zzz      real zmax(klon), zw, zw2(klon, klev+1), ztva(klon, klev)
55    
56      real zlev(klon, klev+1), zlay(klon, klev)      real zlev(klon, klev+1)
57      REAL zh(klon, klev), zdhadj(klon, klev)      REAL zh(klon, klev), zdhadj(klon, klev)
58      REAL ztv(klon, klev)      REAL ztv(klon, klev)
59      real zu(klon, klev), zv(klon, klev), zo(klon, klev)      real zu(klon, klev), zv(klon, klev), zo(klon, klev)
     REAL wh(klon, klev+1)  
     real wu(klon, klev+1), wv(klon, klev+1), wo(klon, klev+1)  
     real zla(klon, klev+1)  
     real zwa(klon, klev+1)  
     real zld(klon, klev+1)  
     real zwd(klon, klev+1)  
     real zsortie(klon, klev)  
60      real zva(klon, klev)      real zva(klon, klev)
61      real zua(klon, klev)      real zua(klon, klev)
62      real zoa(klon, klev)      real zoa(klon, klev)
# Line 77  contains Line 69  contains
69      real thetath2(klon, klev), wth2(klon, klev)      real thetath2(klon, klev), wth2(klon, klev)
70      common/comtherm/thetath2, wth2      common/comtherm/thetath2, wth2
71    
72      integer isplit, nsplit      integer nsplit
73      parameter (nsplit=10)      parameter (nsplit=10)
     data isplit/0/  
     save isplit  
74    
     logical sorties  
75      real rho(klon, klev), rhobarz(klon, klev+1), masse(klon, klev)      real rho(klon, klev), rhobarz(klon, klev+1), masse(klon, klev)
76      real zpspsk(klon, klev)      real zpspsk(klon, klev)
77    
78      real wmax(klon), wmaxa(klon)      real wmax(klon), wmaxa(klon)
     real wa(klon, klev, klev+1)  
     real wd(klon, klev+1)  
79      real fracd(klon, klev+1)      real fracd(klon, klev+1)
80      real xxx(klon, klev+1)      real xxx(klon, klev+1)
81      real larg_cons(klon, klev+1)      real larg_cons(klon, klev+1)
# Line 102  contains Line 89  contains
89      real entr_star_tot(klon), entr_star2(klon)      real entr_star_tot(klon), entr_star2(klon)
90      real f(klon)      real f(klon)
91      real zlevinter(klon)      real zlevinter(klon)
     logical first  
     data first /.false./  
     save first  
   
     character(len=2) str2  
     character(len=10) str10  
   
     LOGICAL vtest(klon)  
92    
93      EXTERNAL SCOPY      EXTERNAL SCOPY
94    
     integer ncorrec  
     save ncorrec  
     data ncorrec/0/  
   
95      !-----------------------------------------------------------------------      !-----------------------------------------------------------------------
96    
97      ! initialisation:      ! initialisation:
98    
     sorties=.true.  
99      IF(ngrid.NE.klon) THEN      IF(ngrid.NE.klon) THEN
100         PRINT *         PRINT *
101         PRINT *, 'STOP dans convadj'         PRINT *, 'STOP dans convadj'
# Line 158  contains Line 132  contains
132         zlev(ig, 1)=0.         zlev(ig, 1)=0.
133         zlev(ig, nlay+1)=(2.*pphi(ig, klev)-pphi(ig, klev-1))/RG         zlev(ig, nlay+1)=(2.*pphi(ig, klev)-pphi(ig, klev-1))/RG
134      enddo      enddo
     do l=1, nlay  
        do ig=1, ngrid  
           zlay(ig, l)=pphi(ig, l)/RG  
        enddo  
     enddo  
135    
136      ! Calcul des densites      ! Calcul des densites
137    
# Line 178  contains Line 147  contains
147         enddo         enddo
148      enddo      enddo
149    
     do k=1, nlay  
        do l=1, nlay+1  
           do ig=1, ngrid  
              wa(ig, k, l)=0.  
           enddo  
        enddo  
     enddo  
   
150      ! Calcul de w2, quarre de w a partir de la cape      ! Calcul de w2, quarre de w a partir de la cape
151      ! a partir de w2, on calcule wa, vitesse de l'ascendance      ! a partir de w2, on calcule wa, vitesse de l'ascendance
152    
# Line 422  contains Line 383  contains
383    
384      ! calcul de la largeur de chaque ascendance dans le cas conservatif.      ! calcul de la largeur de chaque ascendance dans le cas conservatif.
385      ! dans ce cas simple, on suppose que la largeur de l'ascendance provenant      ! dans ce cas simple, on suppose que la largeur de l'ascendance provenant
386      ! d'une couche est égale à la hauteur de la couche alimentante.      ! d'une couche est \'egale \`a la hauteur de la couche alimentante.
387      ! La vitesse maximale dans l'ascendance est aussi prise comme estimation      ! La vitesse maximale dans l'ascendance est aussi prise comme estimation
388      ! de la vitesse d'entrainement horizontal dans la couche alimentante.      ! de la vitesse d'entrainement horizontal dans la couche alimentante.
389    
# Line 447  contains Line 408  contains
408         enddo         enddo
409      enddo      enddo
410    
411      ! calcul de la fraction de la maille concernée par l'ascendance en tenant      ! calcul de la fraction de la maille concern\'ee par l'ascendance en tenant
412      ! compte de l'epluchage du thermique.      ! compte de l'epluchage du thermique.
413    
414      !CR def de zmix continu (profil parabolique des vitesses)      !CR def de zmix continu (profil parabolique des vitesses)
# Line 562  contains Line 523  contains
523         do ig=1, ngrid         do ig=1, ngrid
524            if(fracd(ig, l).lt.0.1) then            if(fracd(ig, l).lt.0.1) then
525               stop'fracd trop petit'               stop'fracd trop petit'
           else  
              ! vitesse descendante "diagnostique"  
              wd(ig, l)=fm(ig, l)/(fracd(ig, l)*rhobarz(ig, l))  
526            endif            endif
527         enddo         enddo
528      enddo      enddo
# Line 636  contains Line 594  contains
594         enddo         enddo
595      enddo      enddo
596    
     print *, '14 OK convect8'  
   
     ! Calculs pour les sorties  
   
     if(sorties) then  
        do l=1, nlay  
           do ig=1, ngrid  
              zla(ig, l)=(1.-fracd(ig, l))*zmax(ig)  
              zld(ig, l)=fracd(ig, l)*zmax(ig)  
              if(1.-fracd(ig, l).gt.1.e-10) &  
                   zwa(ig, l)=wd(ig, l)*fracd(ig, l)/(1.-fracd(ig, l))  
           enddo  
        enddo  
   
        isplit=isplit+1  
     endif  
   
     print *, '19 OK convect8'  
   
597    end SUBROUTINE thermcell    end SUBROUTINE thermcell
598    
599  end module thermcell_m  end module thermcell_m
Legend:
Removed from v.105  
changed lines
  Added in v.178
  ViewVC Help
Powered by ViewVC 1.1.21