/[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

revision 195 by guez, Wed May 18 17:56:44 2016 UTC revision 196 by guez, Mon May 23 13:50:39 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(iflag1, nk1, 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, cpn1, &
9         p1, ph1, tv1, tp1, tvp1, clw1, sig1, w01, iflag, nk, icb, icbs, plcl, &         p1, ph1, tv1, tp1, tvp1, clw1, sig1, w01, nk, 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    
15      use cv30_param_m, only: nl      use cv30_param_m, only: nl
16      USE dimphy, ONLY: klev, klon      USE dimphy, ONLY: klev, klon
     use nr_util, only: assert  
17    
18      ! inputs:      ! inputs:
19      integer, intent(in):: ncum      integer, intent(in):: iflag1(:), nk1(:), icb1(:), icbs1(:) ! (klon)
     integer, intent(in):: iflag1(klon), nk1(klon), icb1(klon), icbs1(klon)  
20      real, intent(in):: plcl1(klon), tnk1(klon), qnk1(klon), gznk1(klon)      real, intent(in):: plcl1(klon), tnk1(klon), qnk1(klon), gznk1(klon)
21      real pbase1(klon), buoybase1(klon)      real pbase1(klon), buoybase1(klon)
22      real, intent(in):: t1(klon, klev)      real, intent(in):: t1(klon, klev)
23      real, intent(in):: q1(klon, klev), qs1(klon, klev)      real, intent(in):: q1(klon, klev), qs1(klon, klev)
24      real, intent(in):: u1(klon, klev), v1(klon, klev)      real, intent(in):: u1(klon, klev), v1(klon, klev)
25      real gz1(klon, klev), h1(klon, klev), lv1(klon, klev), cpn1(klon, klev)      real gz1(klon, klev), h1(klon, klev), lv1(klon, klev), cpn1(klon, klev)
26      real, intent(in):: p1(klon, klev), ph1(klon, klev+1)      real, intent(in):: p1(klon, klev), ph1(klon, klev + 1)
27      real, intent(in):: tv1(klon, klev), tp1(klon, klev)      real, intent(in):: tv1(klon, klev), tp1(klon, klev)
28      real tvp1(klon, klev), clw1(klon, klev)      real tvp1(klon, klev), clw1(klon, klev)
29      real th1(klon, klev)      real th1(klon, klev)
30      real sig1(klon, klev), w01(klon, klev)      real sig1(klon, klev), w01(klon, klev)
31    
32      ! outputs:      ! outputs:
33      integer iflag(klon), nk(klon)      integer nk(:) ! (klon)
34    
35      integer, intent(out):: icb(:) ! (ncum)      integer, intent(out):: icb(:) ! (ncum)
36        ! {2 <= icb <= nl - 3}
37        ! {ph(i, icb(i) + 1) < plcl(i) <= ph(i, icb(i))}
38    
39      integer icbs(klon)      integer icbs(klon)
40      real plcl(klon), tnk(klon), qnk(klon), gznk(klon)      real, intent(out):: plcl(:) ! (ncum)
41        real tnk(:), qnk(:), gznk(:) ! (klon)
42      real pbase(klon), buoybase(klon)      real pbase(klon), buoybase(klon)
43      real t(klon, klev), q(klon, klev), qs(klon, klev)      real t(klon, klev), q(klon, klev), qs(klon, klev)
44      real u(klon, klev), v(klon, klev)      real u(klon, klev), v(klon, klev)
45      real gz(klon, klev), h(klon, klev), lv(klon, klev), cpn(klon, klev)      real gz(klon, klev), h(klon, klev), lv(klon, klev), cpn(klon, klev)
46      real p(klon, klev), ph(klon, klev+1), tv(klon, klev), tp(klon, klev)      real p(klon, klev)
47        real ph(:, :) ! (klon, klev + 1)
48        real tv(klon, klev), tp(klon, klev)
49      real tvp(klon, klev), clw(klon, klev)      real tvp(klon, klev), clw(klon, klev)
50      real th(klon, klev)      real th(klon, klev)
51      real sig(klon, klev), w0(klon, klev)      real sig(klon, klev), w0(klon, klev)
52    
53      ! Local:      ! Local:
54      integer i, k, nn      integer i, k, nn, ncum
55    
56      !---------------------------------------------------------------      !---------------------------------------------------------------
57    
58      do k=1, nl+1      ncum = size(icb)
59         nn=0  
60         do i=1, klon      do k = 1, nl + 1
61           nn = 0
62           do i = 1, klon
63            if (iflag1(i) == 0) then            if (iflag1(i) == 0) then
64               nn=nn+1               nn = nn + 1
65               sig(nn, k)=sig1(i, k)               sig(nn, k) = sig1(i, k)
66               w0(nn, k)=w01(i, k)               w0(nn, k) = w01(i, k)
67               t(nn, k)=t1(i, k)               t(nn, k) = t1(i, k)
68               q(nn, k)=q1(i, k)               q(nn, k) = q1(i, k)
69               qs(nn, k)=qs1(i, k)               qs(nn, k) = qs1(i, k)
70               u(nn, k)=u1(i, k)               u(nn, k) = u1(i, k)
71               v(nn, k)=v1(i, k)               v(nn, k) = v1(i, k)
72               gz(nn, k)=gz1(i, k)               gz(nn, k) = gz1(i, k)
73               h(nn, k)=h1(i, k)               h(nn, k) = h1(i, k)
74               lv(nn, k)=lv1(i, k)               lv(nn, k) = lv1(i, k)
75               cpn(nn, k)=cpn1(i, k)               cpn(nn, k) = cpn1(i, k)
76               p(nn, k)=p1(i, k)               p(nn, k) = p1(i, k)
77               ph(nn, k)=ph1(i, k)               ph(nn, k) = ph1(i, k)
78               tv(nn, k)=tv1(i, k)               tv(nn, k) = tv1(i, k)
79               tp(nn, k)=tp1(i, k)               tp(nn, k) = tp1(i, k)
80               tvp(nn, k)=tvp1(i, k)               tvp(nn, k) = tvp1(i, k)
81               clw(nn, k)=clw1(i, k)               clw(nn, k) = clw1(i, k)
82               th(nn, k)=th1(i, k)               th(nn, k) = th1(i, k)
83            endif            endif
84         end do         end do
85      end do      end do
86    
87      call assert(nn == ncum, "cv30_compress")      nn = 0
     nn=0  
88    
89      do i=1, klon      do i = 1, klon
90         if (iflag1(i) == 0) then         if (iflag1(i) == 0) then
91            nn=nn+1            nn = nn + 1
92            pbase(nn)=pbase1(i)            pbase(nn) = pbase1(i)
93            buoybase(nn)=buoybase1(i)            buoybase(nn) = buoybase1(i)
94            plcl(nn)=plcl1(i)            plcl(nn) = plcl1(i)
95            tnk(nn)=tnk1(i)            tnk(nn) = tnk1(i)
96            qnk(nn)=qnk1(i)            qnk(nn) = qnk1(i)
97            gznk(nn)=gznk1(i)            gznk(nn) = gznk1(i)
98            nk(nn)=nk1(i)            nk(nn) = nk1(i)
99            icb(nn)=icb1(i)            icb(nn) = icb1(i)
100            icbs(nn)=icbs1(i)            icbs(nn) = icbs1(i)
           iflag(nn)=iflag1(i)  
101         endif         endif
102      end do      end do
103    
Legend:
Removed from v.195  
changed lines
  Added in v.196
  ViewVC Help
Powered by ViewVC 1.1.21