/[lmdze]/trunk/libf/phylmd/CV3_routines/cv3_compress.f90
ViewVC logotype

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

  ViewVC Help
Powered by ViewVC 1.1.21