source: LMDZ4/branches/LMDZ4-dev-20091210/libf/phylmd/cv3a_compress.F @ 4104

Last change on this file since 4104 was 1127, checked in by idelkadi, 16 years ago

Corrections sur les wakes et la convection pour surmonter le probleme de l'eau negative
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 4.8 KB
Line 
1      SUBROUTINE cv3a_compress( len,nloc,ncum,nd,ntra
2     :    ,iflag1,nk1,icb1,icbs1
3     :    ,plcl1,tnk1,qnk1,gznk1,hnk1,unk1,vnk1
4     :    ,wghti1,pbase1,buoybase1
5     :    ,t1,q1,qs1,t1_wake,q1_wake,qs1_wake,s1_wake
6     :    ,u1,v1,gz1,th1,th1_wake
7     :    ,tra1
8     :    ,h1     ,lv1     ,cpn1   ,p1,ph1,tv1    ,tp1,tvp1,clw1
9     :    ,h1_wake,lv1_wake,cpn1_wake     ,tv1_wake
10     :    ,sig1,w01,ptop21
11     :    ,Ale1,Alp1
12     o    ,iflag,nk,icb,icbs
13     o    ,plcl,tnk,qnk,gznk,hnk,unk,vnk
14     o    ,wghti,pbase,buoybase
15     o    ,t,q,qs,t_wake,q_wake,qs_wake,s_wake
16     o    ,u,v,gz,th,th_wake
17     o    ,tra
18     o    ,h     ,lv     ,cpn    ,p,ph,tv    ,tp,tvp,clw
19     o    ,h_wake,lv_wake,cpn_wake    ,tv_wake
20     o    ,sig,w0,ptop2
21     o    ,Ale,Alp  )
22***************************************************************
23*                                                             *
24* CV3A_COMPRESS                                               *
25*                                                             *
26*                                                             *
27* written by   : Sandrine Bony-Lena , 17/05/2003, 11.22.15    *
28* modified by  : Jean-Yves Grandpeix, 23/06/2003, 10.28.09    *
29***************************************************************
30*
31      implicit none
32
33#include "cv3param.h"
34
35c inputs:
36      integer len,nloc,ncum,nd,ntra
37      integer iflag1(len),nk1(len),icb1(len),icbs1(len)
38      real plcl1(len),tnk1(len),qnk1(len),gznk1(len)
39      real hnk1(len),unk1(len),vnk1(len)
40      real wghti1(len,nd),pbase1(len),buoybase1(len)
41      real t1(len,nd),q1(len,nd),qs1(len,nd)
42      real t1_wake(len,nd),q1_wake(len,nd),qs1_wake(len,nd)
43      real s1_wake(len)
44      real u1(len,nd),v1(len,nd)
45      real gz1(len,nd),th1(len,nd),th1_wake(len,nd)
46      real tra1(len,nd,ntra)
47      real h1(len,nd),lv1(len,nd),cpn1(len,nd)
48      real p1(len,nd),ph1(len,nd+1),tv1(len,nd),tp1(len,nd)
49      real tvp1(len,nd),clw1(len,nd)
50      real h1_wake(len,nd),lv1_wake(len,nd),cpn1_wake(len,nd)
51      real tv1_wake(len,nd)
52      real sig1(len,nd), w01(len,nd), ptop21(len)
53      real Ale1(len),Alp1(len)
54
55c outputs:
56c en fait, on a nloc=len pour l'instant (cf cv_driver)
57      integer iflag(len),nk(len),icb(len),icbs(len)
58      real plcl(len),tnk(len),qnk(len),gznk(len)
59      real hnk(len),unk(len),vnk(len)
60      real wghti(len,nd),pbase(len),buoybase(len)
61      real t(len,nd),q(len,nd),qs(len,nd)
62      real t_wake(len,nd),q_wake(len,nd),qs_wake(len,nd)
63      real s_wake(len)
64      real u(len,nd),v(len,nd)
65      real gz(len,nd),th(len,nd),th_wake(len,nd)
66      real tra(len,nd,ntra)
67      real h(len,nd),lv(len,nd),cpn(len,nd)
68      real p(len,nd),ph(len,nd+1),tv(len,nd),tp(len,nd)
69      real tvp(len,nd),clw(len,nd)
70      real h_wake(len,nd),lv_wake(len,nd),cpn_wake(len,nd)
71      real tv_wake(len,nd)
72      real sig(len,nd), w0(len,nd), ptop2(len)
73      real Ale(len),Alp(len)
74
75c local variables:
76      integer i,k,nn,j
77
78
79      do 110 k=1,nl+1
80       nn=0
81      do 100 i=1,len
82      if(iflag1(i).eq.0)then
83        nn=nn+1
84        wghti(nn,k)=wghti1(i,k)
85        t(nn,k)=t1(i,k)
86        q(nn,k)=q1(i,k)
87        qs(nn,k)=qs1(i,k)
88        t_wake(nn,k)=t1_wake(i,k)
89        q_wake(nn,k)=q1_wake(i,k)
90        qs_wake(nn,k)=qs1_wake(i,k)
91        u(nn,k)=u1(i,k)
92        v(nn,k)=v1(i,k)
93        gz(nn,k)=gz1(i,k)
94        th(nn,k)=th1(i,k)
95        th_wake(nn,k)=th1_wake(i,k)
96        h(nn,k)=h1(i,k)
97        lv(nn,k)=lv1(i,k)
98        cpn(nn,k)=cpn1(i,k)
99        p(nn,k)=p1(i,k)
100        ph(nn,k)=ph1(i,k)
101        tv(nn,k)=tv1(i,k)
102        tp(nn,k)=tp1(i,k)
103        tvp(nn,k)=tvp1(i,k)
104        clw(nn,k)=clw1(i,k)
105        h_wake(nn,k)=h1_wake(i,k)
106        lv_wake(nn,k)=lv1_wake(i,k)
107        cpn_wake(nn,k)=cpn1_wake(i,k)
108        tv_wake(nn,k)=tv1_wake(i,k)
109        sig(nn,k)=sig1(i,k)
110        w0(nn,k)=w01(i,k)
111      endif
112 100    continue
113 110  continue
114
115      do 121 j=1,ntra
116ccccc      do 111 k=1,nl+1
117      do 111 k=1,nd
118       nn=0
119      do 101 i=1,len
120      if(iflag1(i).eq.0)then
121       nn=nn+1
122       tra(nn,k,j)=tra1(i,k,j)
123      endif
124 101  continue
125 111  continue
126 121  continue
127
128      if (nn.ne.ncum) then
129         print*,'WARNING nn not equal to ncum: ',nn,ncum
130         stop
131      endif
132
133      nn=0
134      do 150 i=1,len
135      if(iflag1(i).eq.0)then
136      nn=nn+1
137      s_wake(nn)=s1_wake(i)
138      iflag(nn)=iflag1(i)
139      nk(nn)=nk1(i)
140      icb(nn)=icb1(i)
141      icbs(nn)=icbs1(i)
142      plcl(nn)=plcl1(i)
143      tnk(nn)=tnk1(i)
144      qnk(nn)=qnk1(i)
145      gznk(nn)=gznk1(i)
146      hnk(nn)=hnk1(i)
147      unk(nn)=unk1(i)
148      vnk(nn)=vnk1(i)
149      pbase(nn)=pbase1(i)
150      buoybase(nn)=buoybase1(i)
151      ptop2(nn)=ptop2(i)
152      ale(nn) = ale1(i)
153      alp(nn) = alp1(i)
154      endif
155 150  continue
156
157      if (nn.ne.ncum) then
158         print*,'WARNING nn not equal to ncum: ',nn,ncum
159         stop
160      endif
161
162      RETURN
163      END
Note: See TracBrowser for help on using the repository browser.