/[lmdze]/trunk/phylmd/CV3_routines/cv3_compress.f
ViewVC logotype

Annotation of /trunk/phylmd/CV3_routines/cv3_compress.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 47 - (hide annotations)
Fri Jul 1 15:00:48 2011 UTC (12 years, 11 months ago) by guez
Original Path: trunk/libf/phylmd/CV3_routines/cv3_compress.f90
File size: 2903 byte(s)
Split "thermcell.f" and "cv3_routines.f".
Removed copies of files that are now in "L_util".
Moved "mva9" and "diagetpq" to their own files.
Unified variable names across procedures.

1 guez 47
2     SUBROUTINE cv3_compress( len,nloc,ncum,nd,ntra &
3     ,iflag1,nk1,icb1,icbs1 &
4     ,plcl1,tnk1,qnk1,gznk1,pbase1,buoybase1 &
5     ,t1,q1,qs1,u1,v1,gz1,th1 &
6     ,tra1 &
7     ,h1,lv1,cpn1,p1,ph1,tv1,tp1,tvp1,clw1 &
8     ,sig1,w01 &
9     ,iflag,nk,icb,icbs &
10     ,plcl,tnk,qnk,gznk,pbase,buoybase &
11     ,t,q,qs,u,v,gz,th &
12     ,tra &
13     ,h,lv,cpn,p,ph,tv,tp,tvp,clw &
14     ,sig,w0 )
15     use cvparam3
16     implicit none
17    
18    
19     ! inputs:
20     integer len,ncum,nd,ntra,nloc
21     integer iflag1(len),nk1(len),icb1(len),icbs1(len)
22     real plcl1(len),tnk1(len),qnk1(len),gznk1(len)
23     real pbase1(len),buoybase1(len)
24     real t1(len,nd),q1(len,nd),qs1(len,nd),u1(len,nd),v1(len,nd)
25     real gz1(len,nd),h1(len,nd),lv1(len,nd),cpn1(len,nd)
26     real p1(len,nd),ph1(len,nd+1),tv1(len,nd),tp1(len,nd)
27     real tvp1(len,nd),clw1(len,nd)
28     real th1(len,nd)
29     real sig1(len,nd), w01(len,nd)
30     real, intent(in):: tra1(len,nd,ntra)
31    
32     ! outputs:
33     ! en fait, on a nloc=len pour l'instant (cf cv_driver)
34     integer iflag(nloc),nk(nloc),icb(nloc),icbs(nloc)
35     real plcl(nloc),tnk(nloc),qnk(nloc),gznk(nloc)
36     real pbase(nloc),buoybase(nloc)
37     real t(nloc,nd),q(nloc,nd),qs(nloc,nd),u(nloc,nd),v(nloc,nd)
38     real gz(nloc,nd),h(nloc,nd),lv(nloc,nd),cpn(nloc,nd)
39     real p(nloc,nd),ph(nloc,nd+1),tv(nloc,nd),tp(nloc,nd)
40     real tvp(nloc,nd),clw(nloc,nd)
41     real th(nloc,nd)
42     real sig(nloc,nd), w0(nloc,nd)
43     real tra(nloc,nd,ntra)
44    
45     ! local variables:
46     integer i,k,nn,j
47    
48    
49     do 110 k=1,nl+1
50     nn=0
51     do 100 i=1,len
52     if(iflag1(i).eq.0)then
53     nn=nn+1
54     sig(nn,k)=sig1(i,k)
55     w0(nn,k)=w01(i,k)
56     t(nn,k)=t1(i,k)
57     q(nn,k)=q1(i,k)
58     qs(nn,k)=qs1(i,k)
59     u(nn,k)=u1(i,k)
60     v(nn,k)=v1(i,k)
61     gz(nn,k)=gz1(i,k)
62     h(nn,k)=h1(i,k)
63     lv(nn,k)=lv1(i,k)
64     cpn(nn,k)=cpn1(i,k)
65     p(nn,k)=p1(i,k)
66     ph(nn,k)=ph1(i,k)
67     tv(nn,k)=tv1(i,k)
68     tp(nn,k)=tp1(i,k)
69     tvp(nn,k)=tvp1(i,k)
70     clw(nn,k)=clw1(i,k)
71     th(nn,k)=th1(i,k)
72     endif
73     100 continue
74     110 continue
75    
76     ! do 121 j=1,ntra
77     ! do 111 k=1,nd
78     ! nn=0
79     ! do 101 i=1,len
80     ! if(iflag1(i).eq.0)then
81     ! nn=nn+1
82     ! tra(nn,k,j)=tra1(i,k,j)
83     ! endif
84     ! 101 continue
85     ! 111 continue
86     ! 121 continue
87    
88     if (nn.ne.ncum) then
89     print*,'strange! nn not equal to ncum: ',nn,ncum
90     stop
91     endif
92    
93     nn=0
94     do 150 i=1,len
95     if(iflag1(i).eq.0)then
96     nn=nn+1
97     pbase(nn)=pbase1(i)
98     buoybase(nn)=buoybase1(i)
99     plcl(nn)=plcl1(i)
100     tnk(nn)=tnk1(i)
101     qnk(nn)=qnk1(i)
102     gznk(nn)=gznk1(i)
103     nk(nn)=nk1(i)
104     icb(nn)=icb1(i)
105     icbs(nn)=icbs1(i)
106     iflag(nn)=iflag1(i)
107     endif
108     150 continue
109    
110     return
111     end

  ViewVC Help
Powered by ViewVC 1.1.21