source: LMDZ5/trunk/libf/phylmd/cv3a_uncompress.F @ 1518

Last change on this file since 1518 was 1518, checked in by idelkadi, 13 years ago

Modifications des routines de convection :

  • correction de bug : le champ sigd n'etait pas decompresse avant d'etre sorti de la convection.
  • sortir de nouveaux champs de convection (plcl, plfc, wb)
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 4.5 KB
Line 
1      SUBROUTINE cv3a_uncompress(nloc,len,ncum,nd,ntra,idcum
2     :         ,iflag,kbas,ktop
3     :         ,precip,cbmf,plcl,plfc,wbeff,sig,w0,ptop2
4     :         ,ft,fq,fu,fv,ftra
5     :         ,sigd,Ma,mip,Vprecip,upwd,dnwd,dnwd0
6     :         ,qcondc,wd,cape,cin
7     :         ,tvp
8     :         ,ftd,fqd
9     :         ,Plim1,Plim2,asupmax,supmax0
10     :         ,asupmaxmin
11     o         ,iflag1,kbas1,ktop1
12     :         ,precip1,cbmf1,plcl1,plfc1,wbeff1,sig1,w01,ptop21
13     :         ,ft1,fq1,fu1,fv1,ftra1
14     :         ,sigd1,Ma1,mip1,Vprecip1,upwd1,dnwd1,dnwd01
15     :         ,qcondc1,wd1,cape1,cin1
16     :         ,tvp1
17     :         ,ftd1,fqd1
18     :         ,Plim11,Plim21,asupmax1,supmax01
19     :         ,asupmaxmin1     )
20***************************************************************
21*                                                             *
22* CV3A_UNCOMPRESS                                             *
23*                                                             *
24*                                                             *
25* written by   : Sandrine Bony-Lena , 17/05/2003, 11.22.15    *
26* modified by  : Jean-Yves Grandpeix, 23/06/2003, 10.36.17    *
27***************************************************************
28*
29      implicit none
30
31#include "cv3param.h"
32
33c inputs:
34      integer nloc, len, ncum, nd, ntra
35      integer idcum(nloc)
36      integer iflag(nloc),kbas(nloc),ktop(nloc)
37      real precip(nloc),cbmf(nloc),plcl(nloc),plfc(nloc)
38      real wbeff(len)
39      real sig(nloc,nd), w0(nloc,nd),ptop2(nloc)
40      real ft(nloc,nd), fq(nloc,nd), fu(nloc,nd), fv(nloc,nd)
41      real ftra(nloc,nd,ntra)
42      real sigd(nloc)
43      real Ma(nloc,nd),mip(nloc,nd),Vprecip(nloc,nd+1)
44      real upwd(nloc,nd),dnwd(nloc,nd),dnwd0(nloc,nd)
45      real qcondc(nloc,nd)
46      real wd(nloc),cape(nloc),cin(nloc)
47      real tvp(nloc,nd)
48      real ftd(nloc,nd), fqd(nloc,nd)
49      real Plim1(nloc),Plim2(nloc)
50      real asupmax(nloc,nd),supmax0(nloc)
51      real asupmaxmin(nloc)
52
53c outputs:
54      integer iflag1(len),kbas1(len),ktop1(len)
55      real precip1(len),cbmf1(len),plcl1(nloc),plfc1(nloc)
56      real wbeff1(len)
57      real sig1(len,nd), w01(len,nd),ptop21(len)
58      real ft1(len,nd), fq1(len,nd), fu1(len,nd), fv1(len,nd)
59      real ftra1(len,nd,ntra)
60      real sigd1(len)
61      real Ma1(len,nd),mip1(len,nd),Vprecip1(len,nd+1)
62      real upwd1(len,nd),dnwd1(len,nd),dnwd01(len,nd)
63      real qcondc1(len,nd)
64      real wd1(len),cape1(len),cin1(len)
65      real tvp1(len,nd)
66      real ftd1(len,nd), fqd1(len,nd)
67      real Plim11(len),Plim21(len)
68      real asupmax1(len,nd),supmax01(len)
69      real asupmaxmin1(len)
70c
71c local variables:
72      integer i,k,j,k1,k2
73
74        do 2000 i=1,ncum
75         ptop21(idcum(i))=ptop2(i)
76         sigd1(idcum(i))=sigd(i)
77         precip1(idcum(i))=precip(i)
78         cbmf1(idcum(i))=cbmf(i)
79         plcl1(idcum(i))=plcl(i)
80         plfc1(idcum(i))=plfc(i)
81         wbeff1(idcum(i))=wbeff(i)
82         iflag1(idcum(i))=iflag(i)
83         kbas1(idcum(i))=kbas(i)
84         ktop1(idcum(i))=ktop(i)
85         wd1(idcum(i))=wd(i)
86         cape1(idcum(i))=cape(i)
87         cin1(idcum(i))=cin(i)
88         Plim11(idcum(i))=Plim1(i)
89         Plim21(idcum(i))=Plim2(i)
90         supmax01(idcum(i))=supmax0(i)
91         asupmaxmin1(idcum(i))=asupmaxmin(i)
92 2000   continue
93
94        do 2020 k=1,nd
95          do 2010 i=1,ncum
96            sig1(idcum(i),k)=sig(i,k)
97            w01(idcum(i),k)=w0(i,k)
98            ft1(idcum(i),k)=ft(i,k)
99            fq1(idcum(i),k)=fq(i,k)
100            fu1(idcum(i),k)=fu(i,k)
101            fv1(idcum(i),k)=fv(i,k)
102            Ma1(idcum(i),k)=Ma(i,k)
103            mip1(idcum(i),k)=mip(i,k)
104            Vprecip1(idcum(i),k)=Vprecip(i,k)
105            upwd1(idcum(i),k)=upwd(i,k)
106            dnwd1(idcum(i),k)=dnwd(i,k)
107            dnwd01(idcum(i),k)=dnwd0(i,k)
108            qcondc1(idcum(i),k)=qcondc(i,k)
109            tvp1(idcum(i),k)=tvp(i,k)
110            ftd1(idcum(i),k)=ftd(i,k)
111            fqd1(idcum(i),k)=fqd(i,k)
112            asupmax1(idcum(i),k)=asupmax(i,k)
113 2010     continue
114 2020   continue
115
116        do 2040 i=1,ncum
117          sig1(idcum(i),nd)=sig(i,nd)
1182040    continue
119
120
121        do 2100 j=1,ntra
122c oct3         do 2110 k=1,nl
123         do 2110 k=1,nd ! oct3
124          do 2120 i=1,ncum
125            ftra1(idcum(i),k,j)=ftra(i,k,j)
126 2120     continue
127 2110    continue
128 2100   continue
129c
130c        do 2220 k2=1,nd
131c         do 2210 k1=1,nd
132c          do 2200 i=1,ncum
133c            ment1(idcum(i),k1,k2) = ment(i,k1,k2)
134c            sij1(idcum(i),k1,k2) = sij(i,k1,k2)
135c2200      enddo
136c2210     enddo
137c2220    enddo
138
139       RETURN
140      END
141
Note: See TracBrowser for help on using the repository browser.