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

Last change on this file since 1634 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
RevLine 
[879]1      SUBROUTINE cv3a_uncompress(nloc,len,ncum,nd,ntra,idcum
2     :         ,iflag,kbas,ktop
[1518]3     :         ,precip,cbmf,plcl,plfc,wbeff,sig,w0,ptop2
[879]4     :         ,ft,fq,fu,fv,ftra
[1518]5     :         ,sigd,Ma,mip,Vprecip,upwd,dnwd,dnwd0
[879]6     :         ,qcondc,wd,cape,cin
7     :         ,tvp
8     :         ,ftd,fqd
9     :         ,Plim1,Plim2,asupmax,supmax0
10     :         ,asupmaxmin
11     o         ,iflag1,kbas1,ktop1
[1518]12     :         ,precip1,cbmf1,plcl1,plfc1,wbeff1,sig1,w01,ptop21
[879]13     :         ,ft1,fq1,fu1,fv1,ftra1
[1518]14     :         ,sigd1,Ma1,mip1,Vprecip1,upwd1,dnwd1,dnwd01
[879]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)
[1518]37      real precip(nloc),cbmf(nloc),plcl(nloc),plfc(nloc)
38      real wbeff(len)
[879]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)
[1518]42      real sigd(nloc)
[1334]43      real Ma(nloc,nd),mip(nloc,nd),Vprecip(nloc,nd+1)
[879]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)
[1518]55      real precip1(len),cbmf1(len),plcl1(nloc),plfc1(nloc)
56      real wbeff1(len)
[879]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)
[1518]60      real sigd1(len)
[1334]61      real Ma1(len,nd),mip1(len,nd),Vprecip1(len,nd+1)
[879]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)
[1518]76         sigd1(idcum(i))=sigd(i)
[879]77         precip1(idcum(i))=precip(i)
[1398]78         cbmf1(idcum(i))=cbmf(i)
[1518]79         plcl1(idcum(i))=plcl(i)
80         plfc1(idcum(i))=plfc(i)
81         wbeff1(idcum(i))=wbeff(i)
[879]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.