/[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 82 by guez, Wed Mar 5 14:57:53 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 cv30_compress_m
2    
3        SUBROUTINE cv3_compress( len,nloc,ncum,nd,ntra &    implicit none
           ,iflag1,nk1,icb1,icbs1 &  
           ,plcl1,tnk1,qnk1,gznk1,pbase1,buoybase1 &  
           ,t1,q1,qs1,u1,v1,gz1,th1 &  
           ,tra1 &  
           ,h1,lv1,cpn1,p1,ph1,tv1,tp1,tvp1,clw1  &  
           ,sig1,w01 &  
           ,iflag,nk,icb,icbs &  
           ,plcl,tnk,qnk,gznk,pbase,buoybase &  
           ,t,q,qs,u,v,gz,th &  
           ,tra &  
           ,h,lv,cpn,p,ph,tv,tp,tvp,clw  &  
           ,sig,w0  )  
             use cv3_param_m  
       implicit none  
   
   
 ! inputs:  
       integer, intent(in):: len,ncum,nd,ntra,nloc  
       integer iflag1(len),nk1(len),icb1(len),icbs1(len)  
       real plcl1(len),tnk1(len),qnk1(len),gznk1(len)  
       real pbase1(len),buoybase1(len)  
       real, intent(in):: t1(len,nd)  
       real q1(len,nd),qs1(len,nd),u1(len,nd),v1(len,nd)  
       real gz1(len,nd),h1(len,nd),lv1(len,nd),cpn1(len,nd)  
       real p1(len,nd),ph1(len,nd+1),tv1(len,nd),tp1(len,nd)  
       real tvp1(len,nd),clw1(len,nd)  
       real th1(len,nd)  
       real sig1(len,nd), w01(len,nd)  
       real, intent(in):: tra1(len,nd,ntra)  
   
 ! outputs:  
 ! en fait, on a nloc=len pour l'instant (cf cv_driver)  
       integer iflag(nloc),nk(nloc),icb(nloc),icbs(nloc)  
       real plcl(nloc),tnk(nloc),qnk(nloc),gznk(nloc)  
       real pbase(nloc),buoybase(nloc)  
       real t(nloc,nd),q(nloc,nd),qs(nloc,nd),u(nloc,nd),v(nloc,nd)  
       real gz(nloc,nd),h(nloc,nd),lv(nloc,nd),cpn(nloc,nd)  
       real p(nloc,nd),ph(nloc,nd+1),tv(nloc,nd),tp(nloc,nd)  
       real tvp(nloc,nd),clw(nloc,nd)  
       real th(nloc,nd)  
       real sig(nloc,nd), w0(nloc,nd)  
       real tra(nloc,nd,ntra)  
   
 ! local variables:  
       integer i,k,nn,j  
   
   
       do 110 k=1,nl+1  
        nn=0  
       do 100 i=1,len  
       if(iflag1(i).eq.0)then  
         nn=nn+1  
         sig(nn,k)=sig1(i,k)  
         w0(nn,k)=w01(i,k)  
         t(nn,k)=t1(i,k)  
         q(nn,k)=q1(i,k)  
         qs(nn,k)=qs1(i,k)  
         u(nn,k)=u1(i,k)  
         v(nn,k)=v1(i,k)  
         gz(nn,k)=gz1(i,k)  
         h(nn,k)=h1(i,k)  
         lv(nn,k)=lv1(i,k)  
         cpn(nn,k)=cpn1(i,k)  
         p(nn,k)=p1(i,k)  
         ph(nn,k)=ph1(i,k)  
         tv(nn,k)=tv1(i,k)  
         tp(nn,k)=tp1(i,k)  
         tvp(nn,k)=tvp1(i,k)  
         clw(nn,k)=clw1(i,k)  
         th(nn,k)=th1(i,k)  
       endif  
  100    continue  
  110  continue  
   
       if (nn.ne.ncum) then  
          print*,'strange! nn not equal to ncum: ',nn,ncum  
          stop  
       endif  
   
       nn=0  
       do 150 i=1,len  
       if(iflag1(i).eq.0)then  
       nn=nn+1  
       pbase(nn)=pbase1(i)  
       buoybase(nn)=buoybase1(i)  
       plcl(nn)=plcl1(i)  
       tnk(nn)=tnk1(i)  
       qnk(nn)=qnk1(i)  
       gznk(nn)=gznk1(i)  
       nk(nn)=nk1(i)  
       icb(nn)=icb1(i)  
       icbs(nn)=icbs1(i)  
       iflag(nn)=iflag1(i)  
       endif  
  150  continue  
4    
5        return  contains
6        end  
7      SUBROUTINE cv30_compress(idcum, iflag1, icb1, icbs1, plcl1, tnk1, qnk1, &
8           gznk1, pbase1, buoybase1, t1, q1, qs1, u1, v1, gz1, th1, h1, lv1, &
9           cpn1, p1, ph1, tv1, tp1, tvp1, clw1, sig1, w01, icb, icbs, plcl, tnk, &
10           qnk, gznk, pbase, buoybase, t, q, qs, u, v, gz, th, h, lv, cpn, p, ph, &
11           tv, tp, tvp, clw, sig, w0)
12    
13        ! Compress the fields (vectorization over convective gridpoints).
14    
15        use cv30_param_m, only: nl
16        USE dimphy, ONLY: klev, klon
17        use nr_util, only: assert
18    
19        ! inputs:
20        integer, intent(in):: idcum(:) ! (ncum)
21        integer, intent(in):: iflag1(:), icb1(:), icbs1(:) ! (klon)
22        real, intent(in):: plcl1(klon), tnk1(klon), qnk1(klon), gznk1(klon)
23        real pbase1(klon), buoybase1(klon)
24        real, intent(in):: t1(klon, klev) ! temperature (K)
25        real, intent(in):: q1(klon, klev), qs1(klon, klev)
26        real, intent(in):: u1(klon, klev), v1(klon, klev)
27        real gz1(klon, klev), h1(klon, klev)
28    
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)
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:
42        integer, intent(out):: icb(:) ! (ncum) {2 <= icb <= nl - 3}
43        integer icbs(klon)
44        real, intent(out):: plcl(:) ! (ncum)
45        real tnk(:), qnk(:), gznk(:) ! (klon)
46        real pbase(klon), buoybase(klon)
47        real t(klon, klev) ! temperature (K)
48        real q(klon, klev), qs(klon, klev)
49        real u(klon, klev), v(klon, klev)
50        real gz(klon, klev), h(klon, klev)
51    
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)
62        real, intent(out):: th(:, :) ! (ncum, nl) potential temperature, in K
63        real sig(klon, klev), w0(klon, klev)
64    
65        ! Local:
66        integer i, k, nn, ncum
67    
68        !---------------------------------------------------------------
69    
70        ncum = size(icb)
71    
72        do k = 1, nl + 1
73           nn = 0
74           do i = 1, klon
75              if (iflag1(i) == 0) then
76                 nn = nn + 1
77                 sig(nn, k) = sig1(i, k)
78                 w0(nn, k) = w01(i, k)
79                 t(nn, k) = t1(i, k)
80                 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
93           end do
94        end do
95    
96        th = th1(idcum, :)
97        lv = lv1(idcum, :)
98        cpn = cpn1(idcum, :)
99    
100        nn = 0
101    
102        do i = 1, klon
103           if (iflag1(i) == 0) then
104              nn = nn + 1
105              pbase(nn) = pbase1(i)
106              buoybase(nn) = buoybase1(i)
107              plcl(nn) = plcl1(i)
108              tnk(nn) = tnk1(i)
109              qnk(nn) = qnk1(i)
110              gznk(nn) = gznk1(i)
111              icb(nn) = icb1(i)
112              icbs(nn) = icbs1(i)
113           endif
114        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
123    
124    end module cv30_compress_m

Legend:
Removed from v.82  
changed lines
  Added in v.201

  ViewVC Help
Powered by ViewVC 1.1.21