/[lmdze]/trunk/Sources/phylmd/CV30_routines/cv30_compress.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/CV30_routines/cv30_compress.f

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

trunk/phylmd/CV3_routines/cv3_compress.f revision 91 by guez, Wed Mar 26 17:18:58 2014 UTC trunk/Sources/phylmd/CV30_routines/cv30_compress.f revision 201 by guez, Mon Jun 6 17:42:15 2016 UTC
# Line 1  Line 1 
1  module cv3_compress_m  module cv30_compress_m
2    
3    implicit none    implicit none
4    
5  contains  contains
6    
7    SUBROUTINE cv3_compress(len, nloc, ncum, nd, ntra, iflag1, nk1, icb1, &    SUBROUTINE cv30_compress(idcum, iflag1, icb1, icbs1, plcl1, tnk1, qnk1, &
8         icbs1, plcl1, tnk1, qnk1, gznk1, pbase1, buoybase1, t1, q1, qs1, u1, &         gznk1, pbase1, buoybase1, t1, q1, qs1, u1, v1, gz1, th1, h1, lv1, &
9         v1, gz1, th1, tra1, h1, lv1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &         cpn1, p1, ph1, tv1, tp1, tvp1, clw1, sig1, w01, icb, icbs, plcl, tnk, &
10         sig1, w01, iflag, nk, icb, icbs, plcl, tnk, qnk, gznk, pbase, &         qnk, gznk, pbase, buoybase, t, q, qs, u, v, gz, th, h, lv, cpn, p, ph, &
11         buoybase, t, q, qs, u, v, gz, th, tra, h, lv, cpn, p, ph, tv, tp, tvp, &         tv, tp, tvp, clw, sig, w0)
12         clw, sig, w0)  
13        ! Compress the fields (vectorization over convective gridpoints).
14      use cv3_param_m  
15        use cv30_param_m, only: nl
16        USE dimphy, ONLY: klev, klon
17        use nr_util, only: assert
18    
19      ! inputs:      ! inputs:
20      integer, intent(in):: len, ncum, nd, ntra, nloc      integer, intent(in):: idcum(:) ! (ncum)
21      integer iflag1(len), nk1(len), icb1(len), icbs1(len)      integer, intent(in):: iflag1(:), icb1(:), icbs1(:) ! (klon)
22      real plcl1(len), tnk1(len), qnk1(len), gznk1(len)      real, intent(in):: plcl1(klon), tnk1(klon), qnk1(klon), gznk1(klon)
23      real pbase1(len), buoybase1(len)      real pbase1(klon), buoybase1(klon)
24      real, intent(in):: t1(len, nd)      real, intent(in):: t1(klon, klev) ! temperature (K)
25      real, intent(in):: q1(len, nd), qs1(len, nd), u1(len, nd), v1(len, nd)      real, intent(in):: q1(klon, klev), qs1(klon, klev)
26      real gz1(len, nd), h1(len, nd), lv1(len, nd), cpn1(len, nd)      real, intent(in):: u1(klon, klev), v1(klon, klev)
27      real p1(len, nd), ph1(len, nd+1), tv1(len, nd), tp1(len, nd)      real gz1(klon, klev), h1(klon, klev)
28      real tvp1(len, nd), clw1(len, nd)  
29      real th1(len, nd)      real, intent(in):: lv1(:, :) ! (klon, nl)
30      real sig1(len, nd), w01(len, nd)      ! specific latent heat of vaporization of water, in J kg-1
31      real, intent(in):: tra1(len, nd, ntra)  
32        real, intent(in):: cpn1(:, :) ! (klon, nl)
33        ! specific heat capacity at constant pressure of humid air, in J K-1 kg-1
34    
35        real, intent(in):: p1(klon, klev), ph1(klon, klev + 1)
36        real, intent(in):: tv1(klon, klev), tp1(klon, klev)
37        real tvp1(klon, klev), clw1(klon, klev)
38        real, intent(in):: th1(:, :) ! (klon, nl) potential temperature, in K
39        real sig1(klon, klev), w01(klon, klev)
40    
41      ! outputs:      ! outputs:
42      ! en fait, on a nloc=len pour l'instant (cf cv_driver)      integer, intent(out):: icb(:) ! (ncum) {2 <= icb <= nl - 3}
43      integer iflag(nloc), nk(nloc), icb(nloc), icbs(nloc)      integer icbs(klon)
44      real plcl(nloc), tnk(nloc), qnk(nloc), gznk(nloc)      real, intent(out):: plcl(:) ! (ncum)
45      real pbase(nloc), buoybase(nloc)      real tnk(:), qnk(:), gznk(:) ! (klon)
46      real t(nloc, nd), q(nloc, nd), qs(nloc, nd), u(nloc, nd), v(nloc, nd)      real pbase(klon), buoybase(klon)
47      real gz(nloc, nd), h(nloc, nd), lv(nloc, nd), cpn(nloc, nd)      real t(klon, klev) ! temperature (K)
48      real p(nloc, nd), ph(nloc, nd+1), tv(nloc, nd), tp(nloc, nd)      real q(klon, klev), qs(klon, klev)
49      real tvp(nloc, nd), clw(nloc, nd)      real u(klon, klev), v(klon, klev)
50      real th(nloc, nd)      real gz(klon, klev), h(klon, klev)
51      real sig(nloc, nd), w0(nloc, nd)  
52      real tra(nloc, nd, ntra)      real, intent(out):: lv(:, :) ! (ncum, nl)
53        ! specific latent heat of vaporization of water, in J kg-1
54      ! local variables:  
55      integer i, k, nn, j      real cpn(:, :) ! (ncum, nl)
56        ! specific heat capacity at constant pressure of humid air, in J K-1 kg-1
57    
58      do  k=1, nl+1      real p(klon, klev)
59         nn=0      real ph(:, :) ! (klon, klev + 1)
60         do  i=1, len      real tv(klon, klev), tp(klon, klev)
61            if(iflag1(i).eq.0)then      real tvp(klon, klev), clw(klon, klev)
62               nn=nn+1      real, intent(out):: th(:, :) ! (ncum, nl) potential temperature, in K
63               sig(nn, k)=sig1(i, k)      real sig(klon, klev), w0(klon, klev)
64               w0(nn, k)=w01(i, k)  
65               t(nn, k)=t1(i, k)      ! Local:
66               q(nn, k)=q1(i, k)      integer i, k, nn, ncum
67               qs(nn, k)=qs1(i, k)  
68               u(nn, k)=u1(i, k)      !---------------------------------------------------------------
69               v(nn, k)=v1(i, k)  
70               gz(nn, k)=gz1(i, k)      ncum = size(icb)
71               h(nn, k)=h1(i, k)  
72               lv(nn, k)=lv1(i, k)      do k = 1, nl + 1
73               cpn(nn, k)=cpn1(i, k)         nn = 0
74               p(nn, k)=p1(i, k)         do i = 1, klon
75               ph(nn, k)=ph1(i, k)            if (iflag1(i) == 0) then
76               tv(nn, k)=tv1(i, k)               nn = nn + 1
77               tp(nn, k)=tp1(i, k)               sig(nn, k) = sig1(i, k)
78               tvp(nn, k)=tvp1(i, k)               w0(nn, k) = w01(i, k)
79               clw(nn, k)=clw1(i, k)               t(nn, k) = t1(i, k)
80               th(nn, k)=th1(i, k)               q(nn, k) = q1(i, k)
81                 qs(nn, k) = qs1(i, k)
82                 u(nn, k) = u1(i, k)
83                 v(nn, k) = v1(i, k)
84                 gz(nn, k) = gz1(i, k)
85                 h(nn, k) = h1(i, k)
86                 p(nn, k) = p1(i, k)
87                 ph(nn, k) = ph1(i, k)
88                 tv(nn, k) = tv1(i, k)
89                 tp(nn, k) = tp1(i, k)
90                 tvp(nn, k) = tvp1(i, k)
91                 clw(nn, k) = clw1(i, k)
92            endif            endif
93         end do         end do
94      end do      end do
95    
96      if (nn.ne.ncum) then      th = th1(idcum, :)
97         print*, 'strange! nn not equal to ncum: ', nn, ncum      lv = lv1(idcum, :)
98         stop      cpn = cpn1(idcum, :)
99      endif  
100        nn = 0
101      nn=0  
102      do  i=1, len      do i = 1, klon
103         if(iflag1(i).eq.0)then         if (iflag1(i) == 0) then
104            nn=nn+1            nn = nn + 1
105            pbase(nn)=pbase1(i)            pbase(nn) = pbase1(i)
106            buoybase(nn)=buoybase1(i)            buoybase(nn) = buoybase1(i)
107            plcl(nn)=plcl1(i)            plcl(nn) = plcl1(i)
108            tnk(nn)=tnk1(i)            tnk(nn) = tnk1(i)
109            qnk(nn)=qnk1(i)            qnk(nn) = qnk1(i)
110            gznk(nn)=gznk1(i)            gznk(nn) = gznk1(i)
111            nk(nn)=nk1(i)            icb(nn) = icb1(i)
112            icb(nn)=icb1(i)            icbs(nn) = icbs1(i)
           icbs(nn)=icbs1(i)  
           iflag(nn)=iflag1(i)  
113         endif         endif
114      end do      end do
115    
116    end SUBROUTINE cv3_compress      do i = 1, ncum
117           call assert(2 <= icb(i) .and. icb(i) <= nl - 3 .and. ph(i, icb(i) + 1) &
118                < plcl(i) .and. (plcl(i) <= ph(i, icb(i)) .or. icb(i) == 2), &
119                "cv30_compress")
120        end do
121    
122      end SUBROUTINE cv30_compress
123    
124  end module cv3_compress_m  end module cv30_compress_m
Legend:
Removed from v.91  
changed lines
  Added in v.201
  ViewVC Help
Powered by ViewVC 1.1.21