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

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

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

revision 195 by guez, Wed May 18 17:56:44 2016 UTC revision 201 by guez, Mon Jun 6 17:42:15 2016 UTC
# Line 4  module cv30_compress_m Line 4  module cv30_compress_m
4    
5  contains  contains
6    
7    SUBROUTINE cv30_compress(ncum, iflag1, nk1, icb1, icbs1, plcl1, tnk1, qnk1, &    SUBROUTINE cv30_compress(idcum, iflag1, icb1, icbs1, plcl1, tnk1, qnk1, &
8         gznk1, pbase1, buoybase1, t1, q1, qs1, u1, v1, gz1, th1, h1, lv1, cpn1, &         gznk1, pbase1, buoybase1, t1, q1, qs1, u1, v1, gz1, th1, h1, lv1, &
9         p1, ph1, tv1, tp1, tvp1, clw1, sig1, w01, iflag, nk, icb, icbs, plcl, &         cpn1, p1, ph1, tv1, tp1, tvp1, clw1, sig1, w01, icb, icbs, plcl, tnk, &
10         tnk, qnk, gznk, pbase, buoybase, t, q, qs, u, v, gz, th, h, lv, cpn, p, &         qnk, gznk, pbase, buoybase, t, q, qs, u, v, gz, th, h, lv, cpn, p, ph, &
11         ph, tv, tp, tvp, clw, sig, w0)         tv, tp, tvp, clw, sig, w0)
12    
13      ! Compress the fields (vectorization over convective gridpoints).      ! Compress the fields (vectorization over convective gridpoints).
14    
# Line 17  contains Line 17  contains
17      use nr_util, only: assert      use nr_util, only: assert
18    
19      ! inputs:      ! inputs:
20      integer, intent(in):: ncum      integer, intent(in):: idcum(:) ! (ncum)
21      integer, intent(in):: iflag1(klon), nk1(klon), icb1(klon), icbs1(klon)      integer, intent(in):: iflag1(:), icb1(:), icbs1(:) ! (klon)
22      real, intent(in):: plcl1(klon), tnk1(klon), qnk1(klon), gznk1(klon)      real, intent(in):: plcl1(klon), tnk1(klon), qnk1(klon), gznk1(klon)
23      real pbase1(klon), buoybase1(klon)      real pbase1(klon), buoybase1(klon)
24      real, intent(in):: t1(klon, klev)      real, intent(in):: t1(klon, klev) ! temperature (K)
25      real, intent(in):: q1(klon, klev), qs1(klon, klev)      real, intent(in):: q1(klon, klev), qs1(klon, klev)
26      real, intent(in):: u1(klon, klev), v1(klon, klev)      real, intent(in):: u1(klon, klev), v1(klon, klev)
27      real gz1(klon, klev), h1(klon, klev), lv1(klon, klev), cpn1(klon, klev)      real gz1(klon, klev), h1(klon, klev)
28      real, intent(in):: p1(klon, klev), ph1(klon, klev+1)  
29        real, intent(in):: lv1(:, :) ! (klon, nl)
30        ! specific latent heat of vaporization of water, in J kg-1
31    
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)      real, intent(in):: tv1(klon, klev), tp1(klon, klev)
37      real tvp1(klon, klev), clw1(klon, klev)      real tvp1(klon, klev), clw1(klon, klev)
38      real th1(klon, klev)      real, intent(in):: th1(:, :) ! (klon, nl) potential temperature, in K
39      real sig1(klon, klev), w01(klon, klev)      real sig1(klon, klev), w01(klon, klev)
40    
41      ! outputs:      ! outputs:
42      integer iflag(klon), nk(klon)      integer, intent(out):: icb(:) ! (ncum) {2 <= icb <= nl - 3}
     integer, intent(out):: icb(:) ! (ncum)  
43      integer icbs(klon)      integer icbs(klon)
44      real plcl(klon), tnk(klon), qnk(klon), gznk(klon)      real, intent(out):: plcl(:) ! (ncum)
45        real tnk(:), qnk(:), gznk(:) ! (klon)
46      real pbase(klon), buoybase(klon)      real pbase(klon), buoybase(klon)
47      real t(klon, klev), q(klon, klev), qs(klon, klev)      real t(klon, klev) ! temperature (K)
48        real q(klon, klev), qs(klon, klev)
49      real u(klon, klev), v(klon, klev)      real u(klon, klev), v(klon, klev)
50      real gz(klon, klev), h(klon, klev), lv(klon, klev), cpn(klon, klev)      real gz(klon, klev), h(klon, klev)
51      real p(klon, klev), ph(klon, klev+1), tv(klon, klev), tp(klon, klev)  
52        real, intent(out):: lv(:, :) ! (ncum, nl)
53        ! specific latent heat of vaporization of water, in J kg-1
54    
55        real cpn(:, :) ! (ncum, nl)
56        ! specific heat capacity at constant pressure of humid air, in J K-1 kg-1
57    
58        real p(klon, klev)
59        real ph(:, :) ! (klon, klev + 1)
60        real tv(klon, klev), tp(klon, klev)
61      real tvp(klon, klev), clw(klon, klev)      real tvp(klon, klev), clw(klon, klev)
62      real th(klon, klev)      real, intent(out):: th(:, :) ! (ncum, nl) potential temperature, in K
63      real sig(klon, klev), w0(klon, klev)      real sig(klon, klev), w0(klon, klev)
64    
65      ! Local:      ! Local:
66      integer i, k, nn      integer i, k, nn, ncum
67    
68      !---------------------------------------------------------------      !---------------------------------------------------------------
69    
70      do k=1, nl+1      ncum = size(icb)
71         nn=0  
72         do i=1, klon      do k = 1, nl + 1
73           nn = 0
74           do i = 1, klon
75            if (iflag1(i) == 0) then            if (iflag1(i) == 0) then
76               nn=nn+1               nn = nn + 1
77               sig(nn, k)=sig1(i, k)               sig(nn, k) = sig1(i, k)
78               w0(nn, k)=w01(i, k)               w0(nn, k) = w01(i, k)
79               t(nn, k)=t1(i, k)               t(nn, k) = t1(i, k)
80               q(nn, k)=q1(i, k)               q(nn, k) = q1(i, k)
81               qs(nn, k)=qs1(i, k)               qs(nn, k) = qs1(i, k)
82               u(nn, k)=u1(i, k)               u(nn, k) = u1(i, k)
83               v(nn, k)=v1(i, k)               v(nn, k) = v1(i, k)
84               gz(nn, k)=gz1(i, k)               gz(nn, k) = gz1(i, k)
85               h(nn, k)=h1(i, k)               h(nn, k) = h1(i, k)
86               lv(nn, k)=lv1(i, k)               p(nn, k) = p1(i, k)
87               cpn(nn, k)=cpn1(i, k)               ph(nn, k) = ph1(i, k)
88               p(nn, k)=p1(i, k)               tv(nn, k) = tv1(i, k)
89               ph(nn, k)=ph1(i, k)               tp(nn, k) = tp1(i, k)
90               tv(nn, k)=tv1(i, k)               tvp(nn, k) = tvp1(i, k)
91               tp(nn, k)=tp1(i, k)               clw(nn, k) = clw1(i, k)
              tvp(nn, k)=tvp1(i, k)  
              clw(nn, k)=clw1(i, k)  
              th(nn, k)=th1(i, k)  
92            endif            endif
93         end do         end do
94      end do      end do
95    
96      call assert(nn == ncum, "cv30_compress")      th = th1(idcum, :)
97      nn=0      lv = lv1(idcum, :)
98        cpn = cpn1(idcum, :)
99    
100        nn = 0
101    
102      do i=1, klon      do i = 1, klon
103         if (iflag1(i) == 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        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    end SUBROUTINE cv30_compress
123    
124  end module cv30_compress_m  end module cv30_compress_m
Legend:
Removed from v.195  
changed lines
  Added in v.201
  ViewVC Help
Powered by ViewVC 1.1.21