/[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/libf/phylmd/CV3_routines/cv3_compress.f90 revision 52 by guez, Fri Sep 23 12:28:01 2011 UTC trunk/Sources/phylmd/CV30_routines/cv30_compress.f revision 197 by guez, Tue May 24 12:25:29 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 cvparam3  
       implicit none  
   
   
 ! inputs:  
       integer 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  
   
 !      do 121 j=1,ntra  
 !      do 111 k=1,nd  
 !       nn=0  
 !      do 101 i=1,len  
 !      if(iflag1(i).eq.0)then  
 !       nn=nn+1  
 !       tra(nn,k,j)=tra1(i,k,j)  
 !      endif  
 ! 101  continue  
 ! 111  continue  
 ! 121  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(iflag1, nk1, icb1, icbs1, plcl1, tnk1, qnk1, &
8           gznk1, pbase1, buoybase1, t1, q1, qs1, u1, v1, gz1, th1, h1, lv1, cpn1, &
9           p1, ph1, tv1, tp1, tvp1, clw1, sig1, w01, nk, 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):: iflag1(:), nk1(:), icb1(:), icbs1(:) ! (klon)
21        real, intent(in):: plcl1(klon), tnk1(klon), qnk1(klon), gznk1(klon)
22        real pbase1(klon), buoybase1(klon)
23        real, intent(in):: t1(klon, klev)
24        real, intent(in):: q1(klon, klev), qs1(klon, klev)
25        real, intent(in):: u1(klon, klev), v1(klon, klev)
26        real gz1(klon, klev), h1(klon, klev), lv1(klon, klev), cpn1(klon, klev)
27        real, intent(in):: p1(klon, klev), ph1(klon, klev + 1)
28        real, intent(in):: tv1(klon, klev), tp1(klon, klev)
29        real tvp1(klon, klev), clw1(klon, klev)
30        real th1(klon, klev)
31        real sig1(klon, klev), w01(klon, klev)
32    
33        ! outputs:
34        integer nk(:) ! (klon)
35        integer, intent(out):: icb(:) ! (ncum) {2 <= icb <= nl - 3}
36        integer icbs(klon)
37        real, intent(out):: plcl(:) ! (ncum)
38        real tnk(:), qnk(:), gznk(:) ! (klon)
39        real pbase(klon), buoybase(klon)
40        real t(klon, klev), q(klon, klev), qs(klon, klev)
41        real u(klon, klev), v(klon, klev)
42        real gz(klon, klev), h(klon, klev), lv(klon, klev), cpn(klon, klev)
43        real p(klon, klev)
44        real ph(:, :) ! (klon, klev + 1)
45        real tv(klon, klev), tp(klon, klev)
46        real tvp(klon, klev), clw(klon, klev)
47        real th(klon, klev)
48        real sig(klon, klev), w0(klon, klev)
49    
50        ! Local:
51        integer i, k, nn, ncum
52    
53        !---------------------------------------------------------------
54    
55        ncum = size(icb)
56    
57        do k = 1, nl + 1
58           nn = 0
59           do i = 1, klon
60              if (iflag1(i) == 0) then
61                 nn = nn + 1
62                 sig(nn, k) = sig1(i, k)
63                 w0(nn, k) = w01(i, k)
64                 t(nn, k) = t1(i, k)
65                 q(nn, k) = q1(i, k)
66                 qs(nn, k) = qs1(i, k)
67                 u(nn, k) = u1(i, k)
68                 v(nn, k) = v1(i, k)
69                 gz(nn, k) = gz1(i, k)
70                 h(nn, k) = h1(i, k)
71                 lv(nn, k) = lv1(i, k)
72                 cpn(nn, k) = cpn1(i, k)
73                 p(nn, k) = p1(i, k)
74                 ph(nn, k) = ph1(i, k)
75                 tv(nn, k) = tv1(i, k)
76                 tp(nn, k) = tp1(i, k)
77                 tvp(nn, k) = tvp1(i, k)
78                 clw(nn, k) = clw1(i, k)
79                 th(nn, k) = th1(i, k)
80              endif
81           end do
82        end do
83    
84        nn = 0
85    
86        do i = 1, klon
87           if (iflag1(i) == 0) then
88              nn = nn + 1
89              pbase(nn) = pbase1(i)
90              buoybase(nn) = buoybase1(i)
91              plcl(nn) = plcl1(i)
92              tnk(nn) = tnk1(i)
93              qnk(nn) = qnk1(i)
94              gznk(nn) = gznk1(i)
95              nk(nn) = nk1(i)
96              icb(nn) = icb1(i)
97              icbs(nn) = icbs1(i)
98           endif
99        end do
100    
101        do i = 1, ncum
102           call assert(2 <= icb(i) .and. icb(i) <= nl - 3 .and. ph(i, icb(i) + 1) &
103                < plcl(i) .and. (plcl(i) <= ph(i, icb(i)) .or. icb(i) == 2), &
104                "cv30_compress")
105        end do
106    
107      end SUBROUTINE cv30_compress
108    
109    end module cv30_compress_m
Legend:
Removed from v.52  
changed lines
  Added in v.197
  ViewVC Help
Powered by ViewVC 1.1.21