source: LMDZ4/trunk/libf/phylmd/cv3a_uncompress.F @ 902

Last change on this file since 902 was 879, checked in by Laurent Fairhead, 17 years ago

Suite de la bascule vers une physique avec thermiques, nouvelle convection, poche froide ...
LF

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 4.2 KB
RevLine 
[879]1      SUBROUTINE cv3a_uncompress(nloc,len,ncum,nd,ntra,idcum
2     :         ,iflag,kbas,ktop
3     :         ,precip,sig,w0,ptop2
4     :         ,ft,fq,fu,fv,ftra
5     :         ,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,sig1,w01,ptop21
13     :         ,ft1,fq1,fu1,fv1,ftra1
14     :         ,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)
38      real sig(nloc,nd), w0(nloc,nd),ptop2(nloc)
39      real ft(nloc,nd), fq(nloc,nd), fu(nloc,nd), fv(nloc,nd)
40      real ftra(nloc,nd,ntra)
41      real Ma(nloc,nd),mip(nloc,nd),Vprecip(nloc,nd)
42      real upwd(nloc,nd),dnwd(nloc,nd),dnwd0(nloc,nd)
43      real qcondc(nloc,nd)
44      real wd(nloc),cape(nloc),cin(nloc)
45      real tvp(nloc,nd)
46      real ftd(nloc,nd), fqd(nloc,nd)
47      real Plim1(nloc),Plim2(nloc)
48      real asupmax(nloc,nd),supmax0(nloc)
49      real asupmaxmin(nloc)
50
51c outputs:
52      integer iflag1(len),kbas1(len),ktop1(len)
53      real precip1(len)
54      real sig1(len,nd), w01(len,nd),ptop21(len)
55      real ft1(len,nd), fq1(len,nd), fu1(len,nd), fv1(len,nd)
56      real ftra1(len,nd,ntra)
57      real Ma1(len,nd),mip1(len,nd),Vprecip1(len,nd)
58      real upwd1(len,nd),dnwd1(len,nd),dnwd01(len,nd)
59      real qcondc1(len,nd)
60      real wd1(len),cape1(len),cin1(len)
61      real tvp1(len,nd)
62      real ftd1(len,nd), fqd1(len,nd)
63      real Plim11(len),Plim21(len)
64      real asupmax1(len,nd),supmax01(len)
65      real asupmaxmin1(len)
66c
67c local variables:
68      integer i,k,j,k1,k2
69
70        do 2000 i=1,ncum
71         ptop21(idcum(i))=ptop2(i)
72         precip1(idcum(i))=precip(i)
73         iflag1(idcum(i))=iflag(i)
74         kbas1(idcum(i))=kbas(i)
75         ktop1(idcum(i))=ktop(i)
76         wd1(idcum(i))=wd(i)
77         cape1(idcum(i))=cape(i)
78         cin1(idcum(i))=cin(i)
79         Plim11(idcum(i))=Plim1(i)
80         Plim21(idcum(i))=Plim2(i)
81         supmax01(idcum(i))=supmax0(i)
82         asupmaxmin1(idcum(i))=asupmaxmin(i)
83 2000   continue
84
85        do 2020 k=1,nd
86          do 2010 i=1,ncum
87            sig1(idcum(i),k)=sig(i,k)
88            w01(idcum(i),k)=w0(i,k)
89            ft1(idcum(i),k)=ft(i,k)
90            fq1(idcum(i),k)=fq(i,k)
91            fu1(idcum(i),k)=fu(i,k)
92            fv1(idcum(i),k)=fv(i,k)
93            Ma1(idcum(i),k)=Ma(i,k)
94            mip1(idcum(i),k)=mip(i,k)
95            Vprecip1(idcum(i),k)=Vprecip(i,k)
96            upwd1(idcum(i),k)=upwd(i,k)
97            dnwd1(idcum(i),k)=dnwd(i,k)
98            dnwd01(idcum(i),k)=dnwd0(i,k)
99            qcondc1(idcum(i),k)=qcondc(i,k)
100            tvp1(idcum(i),k)=tvp(i,k)
101            ftd1(idcum(i),k)=ftd(i,k)
102            fqd1(idcum(i),k)=fqd(i,k)
103            asupmax1(idcum(i),k)=asupmax(i,k)
104 2010     continue
105 2020   continue
106
107        do 2040 i=1,ncum
108          sig1(idcum(i),nd)=sig(i,nd)
1092040    continue
110
111
112        do 2100 j=1,ntra
113c oct3         do 2110 k=1,nl
114         do 2110 k=1,nd ! oct3
115          do 2120 i=1,ncum
116            ftra1(idcum(i),k,j)=ftra(i,k,j)
117 2120     continue
118 2110    continue
119 2100   continue
120c
121c        do 2220 k2=1,nd
122c         do 2210 k1=1,nd
123c          do 2200 i=1,ncum
124c            ment1(idcum(i),k1,k2) = ment(i,k1,k2)
125c            sij1(idcum(i),k1,k2) = sij(i,k1,k2)
126c2200      enddo
127c2210     enddo
128c2220    enddo
129
130       RETURN
131      END
132
Note: See TracBrowser for help on using the repository browser.