/[lmdze]/trunk/libf/phylmd/CV_routines/cv_compress.f90
ViewVC logotype

Contents of /trunk/libf/phylmd/CV_routines/cv_compress.f90

Parent Directory Parent Directory | Revision Log Revision Log


Revision 52 - (show annotations)
Fri Sep 23 12:28:01 2011 UTC (12 years, 7 months ago) by guez
File size: 2255 byte(s)
Split "conflx.f" into single-procedure files in directory "Conflx".

Split "cv_routines.f" into single-procedure files in directory
"CV_routines". Made module "cvparam" from included file
"cvparam.h". No included file other than "netcdf.inc" left in LMDZE.

1
2 SUBROUTINE cv_compress( len,nloc,ncum,nd &
3 ,iflag1,nk1,icb1 &
4 ,cbmf1,plcl1,tnk1,qnk1,gznk1 &
5 ,t1,q1,qs1,u1,v1,gz1 &
6 ,h1,lv1,cpn1,p1,ph1,tv1,tp1,tvp1,clw1 &
7 ,iflag,nk,icb &
8 ,cbmf,plcl,tnk,qnk,gznk &
9 ,t,q,qs,u,v,gz,h,lv,cpn,p,ph,tv,tp,tvp,clw &
10 ,dph )
11 use cvparam
12 implicit none
13
14
15 ! inputs:
16 integer len,ncum,nd,nloc
17 integer iflag1(len),nk1(len),icb1(len)
18 real cbmf1(len),plcl1(len),tnk1(len),qnk1(len),gznk1(len)
19 real, intent(in):: t1(len,nd)
20 real q1(len,nd),qs1(len,nd),u1(len,nd),v1(len,nd)
21 real gz1(len,nd),h1(len,nd),lv1(len,nd),cpn1(len,nd)
22 real p1(len,nd),ph1(len,nd+1),tv1(len,nd),tp1(len,nd)
23 real tvp1(len,nd),clw1(len,nd)
24
25 ! outputs:
26 integer iflag(nloc),nk(nloc),icb(nloc)
27 real cbmf(nloc),plcl(nloc),tnk(nloc),qnk(nloc),gznk(nloc)
28 real t(nloc,nd),q(nloc,nd),qs(nloc,nd),u(nloc,nd),v(nloc,nd)
29 real gz(nloc,nd),h(nloc,nd),lv(nloc,nd),cpn(nloc,nd)
30 real p(nloc,nd),ph(nloc,nd+1),tv(nloc,nd),tp(nloc,nd)
31 real tvp(nloc,nd),clw(nloc,nd)
32 real dph(nloc,nd)
33
34 ! local variables:
35 integer i,k,nn
36
37
38 do 110 k=1,nl+1
39 nn=0
40 do 100 i=1,len
41 if(iflag1(i).eq.0)then
42 nn=nn+1
43 t(nn,k)=t1(i,k)
44 q(nn,k)=q1(i,k)
45 qs(nn,k)=qs1(i,k)
46 u(nn,k)=u1(i,k)
47 v(nn,k)=v1(i,k)
48 gz(nn,k)=gz1(i,k)
49 h(nn,k)=h1(i,k)
50 lv(nn,k)=lv1(i,k)
51 cpn(nn,k)=cpn1(i,k)
52 p(nn,k)=p1(i,k)
53 ph(nn,k)=ph1(i,k)
54 tv(nn,k)=tv1(i,k)
55 tp(nn,k)=tp1(i,k)
56 tvp(nn,k)=tvp1(i,k)
57 clw(nn,k)=clw1(i,k)
58 endif
59 100 continue
60 110 continue
61
62 if (nn.ne.ncum) then
63 print*,'strange! nn not equal to ncum: ',nn,ncum
64 stop
65 endif
66
67 nn=0
68 do 150 i=1,len
69 if(iflag1(i).eq.0)then
70 nn=nn+1
71 cbmf(nn)=cbmf1(i)
72 plcl(nn)=plcl1(i)
73 tnk(nn)=tnk1(i)
74 qnk(nn)=qnk1(i)
75 gznk(nn)=gznk1(i)
76 nk(nn)=nk1(i)
77 icb(nn)=icb1(i)
78 iflag(nn)=iflag1(i)
79 endif
80 150 continue
81
82 do 170 k=1,nl
83 do 160 i=1,ncum
84 dph(i,k)=ph(i,k)-ph(i,k+1)
85 160 continue
86 170 continue
87
88 return
89 end

  ViewVC Help
Powered by ViewVC 1.1.21