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

Last change on this file since 1663 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
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
[1650]11!AC!
12     :         ,da,phi
13!AC!
[879]14     o         ,iflag1,kbas1,ktop1
[1518]15     :         ,precip1,cbmf1,plcl1,plfc1,wbeff1,sig1,w01,ptop21
[879]16     :         ,ft1,fq1,fu1,fv1,ftra1
[1518]17     :         ,sigd1,Ma1,mip1,Vprecip1,upwd1,dnwd1,dnwd01
[879]18     :         ,qcondc1,wd1,cape1,cin1
19     :         ,tvp1
20     :         ,ftd1,fqd1
21     :         ,Plim11,Plim21,asupmax1,supmax01
[1650]22     :         ,asupmaxmin1     
23!AC!
24     :         ,da1,phi1  )
25!AC!
[879]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)
[1518]43      real precip(nloc),cbmf(nloc),plcl(nloc),plfc(nloc)
44      real wbeff(len)
[879]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)
[1518]48      real sigd(nloc)
[1334]49      real Ma(nloc,nd),mip(nloc,nd),Vprecip(nloc,nd+1)
[879]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)
[1650]58!AC!
59      real da(nloc,nd),phi(nloc,nd,nd)
60!AC!
[879]61c outputs:
62      integer iflag1(len),kbas1(len),ktop1(len)
[1518]63      real precip1(len),cbmf1(len),plcl1(nloc),plfc1(nloc)
64      real wbeff1(len)
[879]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)
[1518]68      real sigd1(len)
[1334]69      real Ma1(len,nd),mip1(len,nd),Vprecip1(len,nd+1)
[879]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)
[1650]78!AC!
79      real da1(nloc,nd),phi1(nloc,nd,nd)
80!AC!
[879]81c
82c local variables:
83      integer i,k,j,k1,k2
84
85        do 2000 i=1,ncum
86         ptop21(idcum(i))=ptop2(i)
[1518]87         sigd1(idcum(i))=sigd(i)
[879]88         precip1(idcum(i))=precip(i)
[1398]89         cbmf1(idcum(i))=cbmf(i)
[1518]90         plcl1(idcum(i))=plcl(i)
91         plfc1(idcum(i))=plfc(i)
92         wbeff1(idcum(i))=wbeff(i)
[879]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)
[1650]124!AC!
125            da1(idcum(i),k)=da(i,k)
126!AC!
127 2010    continue
[879]128 2020   continue
129
130        do 2040 i=1,ncum
131          sig1(idcum(i),nd)=sig(i,nd)
1322040    continue
133
134
[1650]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
[879]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.