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

Last change on this file since 1705 was 1650, checked in by Laurent Fairhead, 12 years ago

Inclusion de modifications pour régler le problème convection/traceurs dans la nouvelle
physique

  1. Cozic

Modifications needed to correct the convection/tracers problem with the new physics

  1. Cozic
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 4.9 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!AC!
12     :         ,da,phi
13!AC!
14     o         ,iflag1,kbas1,ktop1
15     :         ,precip1,cbmf1,plcl1,plfc1,wbeff1,sig1,w01,ptop21
16     :         ,ft1,fq1,fu1,fv1,ftra1
17     :         ,sigd1,Ma1,mip1,Vprecip1,upwd1,dnwd1,dnwd01
18     :         ,qcondc1,wd1,cape1,cin1
19     :         ,tvp1
20     :         ,ftd1,fqd1
21     :         ,Plim11,Plim21,asupmax1,supmax01
22     :         ,asupmaxmin1     
23!AC!
24     :         ,da1,phi1  )
25!AC!
26***************************************************************
27*                                                             *
28* CV3A_UNCOMPRESS                                             *
29*                                                             *
30*                                                             *
31* written by   : Sandrine Bony-Lena , 17/05/2003, 11.22.15    *
32* modified by  : Jean-Yves Grandpeix, 23/06/2003, 10.36.17    *
33***************************************************************
34*
35      implicit none
36
37#include "cv3param.h"
38
39c inputs:
40      integer nloc, len, ncum, nd, ntra
41      integer idcum(nloc)
42      integer iflag(nloc),kbas(nloc),ktop(nloc)
43      real precip(nloc),cbmf(nloc),plcl(nloc),plfc(nloc)
44      real wbeff(len)
45      real sig(nloc,nd), w0(nloc,nd),ptop2(nloc)
46      real ft(nloc,nd), fq(nloc,nd), fu(nloc,nd), fv(nloc,nd)
47      real ftra(nloc,nd,ntra)
48      real sigd(nloc)
49      real Ma(nloc,nd),mip(nloc,nd),Vprecip(nloc,nd+1)
50      real upwd(nloc,nd),dnwd(nloc,nd),dnwd0(nloc,nd)
51      real qcondc(nloc,nd)
52      real wd(nloc),cape(nloc),cin(nloc)
53      real tvp(nloc,nd)
54      real ftd(nloc,nd), fqd(nloc,nd)
55      real Plim1(nloc),Plim2(nloc)
56      real asupmax(nloc,nd),supmax0(nloc)
57      real asupmaxmin(nloc)
58!AC!
59      real da(nloc,nd),phi(nloc,nd,nd)
60!AC!
61c outputs:
62      integer iflag1(len),kbas1(len),ktop1(len)
63      real precip1(len),cbmf1(len),plcl1(nloc),plfc1(nloc)
64      real wbeff1(len)
65      real sig1(len,nd), w01(len,nd),ptop21(len)
66      real ft1(len,nd), fq1(len,nd), fu1(len,nd), fv1(len,nd)
67      real ftra1(len,nd,ntra)
68      real sigd1(len)
69      real Ma1(len,nd),mip1(len,nd),Vprecip1(len,nd+1)
70      real upwd1(len,nd),dnwd1(len,nd),dnwd01(len,nd)
71      real qcondc1(len,nd)
72      real wd1(len),cape1(len),cin1(len)
73      real tvp1(len,nd)
74      real ftd1(len,nd), fqd1(len,nd)
75      real Plim11(len),Plim21(len)
76      real asupmax1(len,nd),supmax01(len)
77      real asupmaxmin1(len)
78!AC!
79      real da1(nloc,nd),phi1(nloc,nd,nd)
80!AC!
81c
82c local variables:
83      integer i,k,j,k1,k2
84
85        do 2000 i=1,ncum
86         ptop21(idcum(i))=ptop2(i)
87         sigd1(idcum(i))=sigd(i)
88         precip1(idcum(i))=precip(i)
89         cbmf1(idcum(i))=cbmf(i)
90         plcl1(idcum(i))=plcl(i)
91         plfc1(idcum(i))=plfc(i)
92         wbeff1(idcum(i))=wbeff(i)
93         iflag1(idcum(i))=iflag(i)
94         kbas1(idcum(i))=kbas(i)
95         ktop1(idcum(i))=ktop(i)
96         wd1(idcum(i))=wd(i)
97         cape1(idcum(i))=cape(i)
98         cin1(idcum(i))=cin(i)
99         Plim11(idcum(i))=Plim1(i)
100         Plim21(idcum(i))=Plim2(i)
101         supmax01(idcum(i))=supmax0(i)
102         asupmaxmin1(idcum(i))=asupmaxmin(i)
103 2000   continue
104
105        do 2020 k=1,nd
106          do 2010 i=1,ncum
107            sig1(idcum(i),k)=sig(i,k)
108            w01(idcum(i),k)=w0(i,k)
109            ft1(idcum(i),k)=ft(i,k)
110            fq1(idcum(i),k)=fq(i,k)
111            fu1(idcum(i),k)=fu(i,k)
112            fv1(idcum(i),k)=fv(i,k)
113            Ma1(idcum(i),k)=Ma(i,k)
114            mip1(idcum(i),k)=mip(i,k)
115            Vprecip1(idcum(i),k)=Vprecip(i,k)
116            upwd1(idcum(i),k)=upwd(i,k)
117            dnwd1(idcum(i),k)=dnwd(i,k)
118            dnwd01(idcum(i),k)=dnwd0(i,k)
119            qcondc1(idcum(i),k)=qcondc(i,k)
120            tvp1(idcum(i),k)=tvp(i,k)
121            ftd1(idcum(i),k)=ftd(i,k)
122            fqd1(idcum(i),k)=fqd(i,k)
123            asupmax1(idcum(i),k)=asupmax(i,k)
124!AC!
125            da1(idcum(i),k)=da(i,k)
126!AC!
127 2010    continue
128 2020   continue
129
130        do 2040 i=1,ncum
131          sig1(idcum(i),nd)=sig(i,nd)
1322040    continue
133
134
135!AC!        do 2100 j=1,ntra
136!AC!c oct3         do 2110 k=1,nl
137!AC!         do 2110 k=1,nd ! oct3
138!AC!          do 2120 i=1,ncum
139!AC!            ftra1(idcum(i),k,j)=ftra(i,k,j)
140!AC! 2120     continue
141!AC! 2110    continue
142!AC! 2100   continue
143
144!AC!
145       do j=1,nd
146         do k=1,nd
147          do i=1,ncum
148            phi1(idcum(i),k,j)=phi(i,k,j)
149          end do
150         end do
151        end do
152!AC!
153
154c
155c        do 2220 k2=1,nd
156c         do 2210 k1=1,nd
157c          do 2200 i=1,ncum
158c            ment1(idcum(i),k1,k2) = ment(i,k1,k2)
159c            sij1(idcum(i),k1,k2) = sij(i,k1,k2)
160c2200      enddo
161c2210     enddo
162c2220    enddo
163
164       RETURN
165      END
166
Note: See TracBrowser for help on using the repository browser.