/[lmdze]/trunk/phylmd/CV_routines/cv_compress.f
ViewVC logotype

Contents of /trunk/phylmd/CV_routines/cv_compress.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 103 - (show annotations)
Fri Aug 29 13:00:05 2014 UTC (9 years, 8 months ago) by guez
File size: 2312 byte(s)
Renamed module cvparam to cv_param. Deleted procedure
cv_param. Changed variables of module cv_param into parameters.

In procedures cv_driver, cv_uncompress and cv3_uncompress, removed
some arguments giving dimensions and used module variables klon and
klev instead.

In procedures gradiv2, laplacien_gam and laplacien, changed
declarations of local variables because klevel is not always klev.

Removed code for nudging surface pressure.

Removed arguments pim and pjm of tau2alpha. Added assignment of false
to variable first.

Replaced real argument del of procedures foeew and FOEDE by logical
argument.

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 cv_param
12 implicit none
13
14
15 ! inputs:
16 integer, intent(in):: len,ncum,nd,nloc
17 integer iflag1(len),nk1(len),icb1(len)
18 real, intent(in):: cbmf1(len),plcl1(len),tnk1(len),qnk1(len),gznk1(len)
19 real, intent(in):: t1(len,nd)
20 real, intent(in):: 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, intent(in):: 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