source: LMDZ5/trunk/libf/phylmd/cv3a_compress.F @ 1885

Last change on this file since 1885 was 1849, checked in by Ehouarn Millour, 11 years ago

Including the thermodynamics of ice in the convection scheme (iactive only if iflag_ice_thermo==1).
CR+JYG
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 5.2 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, lf1     ,cpn1   ,p1,ph1,tv1    ,tp1,tvp1,clw1
9     :    ,h1_wake,lv1_wake,lf1_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, lf     ,cpn    ,p,ph,tv    ,tp,tvp,clw
19     o    ,h_wake,lv_wake,lf_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),lf1(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),lf1_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),lf(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),lf_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      CHARACTER (LEN=20) :: modname='cv3a_compress'
79      CHARACTER (LEN=80) :: abort_message
80
81
82      do 110 k=1,nl+1
83       nn=0
84      do 100 i=1,len
85      if(iflag1(i).eq.0)then
86        nn=nn+1
87        wghti(nn,k)=wghti1(i,k)
88        t(nn,k)=t1(i,k)
89        q(nn,k)=q1(i,k)
90        qs(nn,k)=qs1(i,k)
91        t_wake(nn,k)=t1_wake(i,k)
92        q_wake(nn,k)=q1_wake(i,k)
93        qs_wake(nn,k)=qs1_wake(i,k)
94        u(nn,k)=u1(i,k)
95        v(nn,k)=v1(i,k)
96        gz(nn,k)=gz1(i,k)
97        th(nn,k)=th1(i,k)
98        th_wake(nn,k)=th1_wake(i,k)
99        h(nn,k)=h1(i,k)
100        lv(nn,k)=lv1(i,k)
101        lf(nn,k)=lf1(i,k)
102        cpn(nn,k)=cpn1(i,k)
103        p(nn,k)=p1(i,k)
104        ph(nn,k)=ph1(i,k)
105        tv(nn,k)=tv1(i,k)
106        tp(nn,k)=tp1(i,k)
107        tvp(nn,k)=tvp1(i,k)
108        clw(nn,k)=clw1(i,k)
109        h_wake(nn,k)=h1_wake(i,k)
110        lv_wake(nn,k)=lv1_wake(i,k)
111        lf_wake(nn,k)=lf1_wake(i,k)
112        cpn_wake(nn,k)=cpn1_wake(i,k)
113        tv_wake(nn,k)=tv1_wake(i,k)
114        sig(nn,k)=sig1(i,k)
115        w0(nn,k)=w01(i,k)
116      endif
117 100    continue
118 110  continue
119
120!AC!      do 121 j=1,ntra
121!AC!ccccc      do 111 k=1,nl+1
122!AC!      do 111 k=1,nd
123!AC!       nn=0
124!AC!      do 101 i=1,len
125!AC!      if(iflag1(i).eq.0)then
126!AC!       nn=nn+1
127!AC!       tra(nn,k,j)=tra1(i,k,j)
128!AC!      endif
129!AC! 101  continue
130!AC! 111  continue
131!AC! 121  continue
132
133      if (nn.ne.ncum) then
134        print*,'WARNING nn not equal to ncum: ',nn,ncum
135        abort_message = ''
136        CALL abort_gcm (modname,abort_message,1)
137      endif
138
139      nn=0
140      do 150 i=1,len
141      if(iflag1(i).eq.0)then
142      nn=nn+1
143      s_wake(nn)=s1_wake(i)
144      iflag(nn)=iflag1(i)
145      nk(nn)=nk1(i)
146      icb(nn)=icb1(i)
147      icbs(nn)=icbs1(i)
148      plcl(nn)=plcl1(i)
149      tnk(nn)=tnk1(i)
150      qnk(nn)=qnk1(i)
151      gznk(nn)=gznk1(i)
152      hnk(nn)=hnk1(i)
153      unk(nn)=unk1(i)
154      vnk(nn)=vnk1(i)
155      pbase(nn)=pbase1(i)
156      buoybase(nn)=buoybase1(i)
157      ptop2(nn)=ptop2(i)
158      ale(nn) = ale1(i)
159      alp(nn) = alp1(i)
160      endif
161 150  continue
162
163      if (nn.ne.ncum) then
164         print*,'WARNING nn not equal to ncum: ',nn,ncum
165         abort_message = ''
166         CALL abort_gcm (modname,abort_message,1)
167      endif
168
169      RETURN
170      END
Note: See TracBrowser for help on using the repository browser.