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

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

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

trunk/Sources/phylmd/Thermcell/thermcell.f revision 157 by guez, Mon Jul 20 16:01:49 2015 UTC trunk/phylmd/Thermcell/thermcell.f revision 324 by guez, Wed Feb 6 15:58:03 2019 UTC
# Line 4  module thermcell_m Line 4  module thermcell_m
4    
5  contains  contains
6    
7    SUBROUTINE thermcell(ngrid, nlay, ptimestep, pplay, pplev, pphi, pu, pv, pt, &    SUBROUTINE thermcell(ngrid, nlay, ptimestep, pplay, pplev, pphi, u, v, pt, &
8         po, pduadj, pdvadj, pdtadj, pdoadj, fm0, entr0, r_aspect, l_mix, w2di, &         po, pduadj, pdvadj, pdtadj, pdoadj, fm0, entr0)
        tho)  
9    
10      ! Calcul du transport vertical dans la couche limite en pr\'esence      ! Calcul du transport vertical dans la couche limite en pr\'esence
11      ! de "thermiques" explicitement repr\'esent\'es. R\'ecriture \`a partir      ! de "thermiques" explicitement repr\'esent\'es. R\'ecriture \`a partir
# Line 23  contains Line 22  contains
22      USE dimphy, ONLY : klev, klon      USE dimphy, ONLY : klev, klon
23      USE suphec_m, ONLY : rd, rg, rkappa      USE suphec_m, ONLY : rd, rg, rkappa
24    
25      ! arguments:      INTEGER ngrid, nlay
26        real ptimestep
     INTEGER ngrid, nlay, w2di  
     real tho  
     real ptimestep, l_mix, r_aspect  
     REAL, intent(in):: pt(ngrid, nlay)  
     real pdtadj(ngrid, nlay)  
     REAL, intent(in):: pu(ngrid, nlay)  
     real pduadj(ngrid, nlay)  
     REAL, intent(in):: pv(ngrid, nlay)  
     real pdvadj(ngrid, nlay)  
     REAL po(ngrid, nlay), pdoadj(ngrid, nlay)  
27      REAL, intent(in):: pplay(ngrid, nlay)      REAL, intent(in):: pplay(ngrid, nlay)
28      real, intent(in):: pplev(ngrid, nlay+1)      real, intent(in):: pplev(ngrid, nlay+1)
29      real, intent(in):: pphi(ngrid, nlay)      real, intent(in):: pphi(ngrid, nlay)
30        REAL, intent(in):: u(ngrid, nlay)
31        REAL, intent(in):: v(ngrid, nlay)
32        REAL, intent(in):: pt(ngrid, nlay)
33        REAL po(ngrid, nlay)
34        real pduadj(ngrid, nlay)
35        real pdvadj(ngrid, nlay)
36        real pdtadj(ngrid, nlay)
37        real pdoadj(ngrid, nlay)
38        real fm0(klon, klev+1), entr0(klon, klev)
39    
40        ! Local:
41        
42      integer idetr      integer idetr
43      save idetr      save idetr
44      data idetr/3/      data idetr/3/
45    
     ! local:  
   
46      INTEGER ig, k, l, lmaxa(klon), lmix(klon)      INTEGER ig, k, l, lmaxa(klon), lmix(klon)
47      ! CR: on remplace lmax(klon, klev+1)      ! CR: on remplace lmax(klon, klev+1)
48      INTEGER lmax(klon), lmin(klon), lentr(klon)      INTEGER lmax(klon), lmin(klon), lentr(klon)
# Line 53  contains Line 51  contains
51    
52      real zmax(klon), zw, zw2(klon, klev+1), ztva(klon, klev)      real zmax(klon), zw, zw2(klon, klev+1), ztva(klon, klev)
53    
54      real zlev(klon, klev+1), zlay(klon, klev)      real zlev(klon, klev+1)
55      REAL zh(klon, klev), zdhadj(klon, klev)      REAL zh(klon, klev), zdhadj(klon, klev)
56      REAL ztv(klon, klev)      REAL ztv(klon, klev)
57      real zu(klon, klev), zv(klon, klev), zo(klon, klev)      real zu(klon, klev), zv(klon, klev), zo(klon, klev)
     real zla(klon, klev+1)  
     real zwa(klon, klev+1)  
     real zld(klon, klev+1)  
58      real zva(klon, klev)      real zva(klon, klev)
59      real zua(klon, klev)      real zua(klon, klev)
60      real zoa(klon, klev)      real zoa(klon, klev)
# Line 72  contains Line 67  contains
67      real thetath2(klon, klev), wth2(klon, klev)      real thetath2(klon, klev), wth2(klon, klev)
68      common/comtherm/thetath2, wth2      common/comtherm/thetath2, wth2
69    
     integer isplit, nsplit  
     parameter (nsplit=10)  
     data isplit/0/  
     save isplit  
   
     logical sorties  
70      real rho(klon, klev), rhobarz(klon, klev+1), masse(klon, klev)      real rho(klon, klev), rhobarz(klon, klev+1), masse(klon, klev)
71      real zpspsk(klon, klev)      real zpspsk(klon, klev)
72    
73      real wmax(klon), wmaxa(klon)      real wmax(klon), wmaxa(klon)
     real wa(klon, klev, klev+1)  
     real wd(klon, klev+1)  
74      real fracd(klon, klev+1)      real fracd(klon, klev+1)
75      real xxx(klon, klev+1)      real xxx(klon, klev+1)
76      real larg_cons(klon, klev+1)      real larg_cons(klon, klev+1)
77      real larg_detr(klon, klev+1)      real larg_detr(klon, klev+1)
78      real fm0(klon, klev+1), entr0(klon, klev), detr(klon, klev)      real detr(klon, klev)
79      real fm(klon, klev+1), entr(klon, klev)      real fm(klon, klev+1), entr(klon, klev)
80      real fmc(klon, klev+1)      real fmc(klon, klev+1)
81    
# Line 98  contains Line 85  contains
85      real f(klon)      real f(klon)
86      real zlevinter(klon)      real zlevinter(klon)
87    
88        real, parameter:: r_aspect = 4.
89        real, parameter:: l_mix = 10.
90        real, parameter:: tho = 0.
91        integer, parameter:: w2di = 0
92    
93      EXTERNAL SCOPY      EXTERNAL SCOPY
94    
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 120  contains Line 111  contains
111         DO ig=1, ngrid         DO ig=1, ngrid
112            zpspsk(ig, l)=(pplay(ig, l)/pplev(ig, 1))**RKAPPA            zpspsk(ig, l)=(pplay(ig, l)/pplev(ig, 1))**RKAPPA
113            zh(ig, l)=pt(ig, l)/zpspsk(ig, l)            zh(ig, l)=pt(ig, l)/zpspsk(ig, l)
114            zu(ig, l)=pu(ig, l)            zu(ig, l)=u(ig, l)
115            zv(ig, l)=pv(ig, l)            zv(ig, l)=v(ig, l)
116            zo(ig, l)=po(ig, l)            zo(ig, l)=po(ig, l)
117            ztv(ig, l)=zh(ig, l)*(1.+0.61*zo(ig, l))            ztv(ig, l)=zh(ig, l)*(1.+0.61*zo(ig, l))
118         end DO         end DO
# Line 141  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 161  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 545  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 619  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.157  
changed lines
  Added in v.324
  ViewVC Help
Powered by ViewVC 1.1.21