source: lmdz_wrf/WRFV3/lmdz/cv3a_uncompress.F90 @ 1

Last change on this file since 1 was 1, checked in by lfita, 10 years ago
  • -- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 8.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!                                                                                    &
12       &          ,da,phi,mp,phi2,d1a,dam,sigij                                      & ! RomP+AC+jyg
13       &          ,clw,elij,evap,ep,epmlmMm,eplaMm                                   & ! RomP
14       &          ,wdtrainA,wdtrainM                                                 & ! RomP
15!                                                                                    &
16       &         ,iflag1,kbas1,ktop1                                                 &
17       &         ,precip1,cbmf1,plcl1,plfc1,wbeff1,sig1,w01,ptop21                   &
18       &         ,ft1,fq1,fu1,fv1,ftra1                                              &
19       &         ,sigd1,Ma1,mip1,Vprecip1,upwd1,dnwd1,dnwd01                         &
20       &         ,qcondc1,wd1,cape1,cin1                                             &
21       &         ,tvp1                                                               &
22       &         ,ftd1,fqd1                                                          &
23       &         ,Plim11,Plim21,asupmax1,supmax01                                    &
24       &         ,asupmaxmin1                                                        &
25!                                                                                    &
26       &          ,da1,phi1,mp1,phi21,d1a1,dam1,sigij1                               & ! RomP+AC+jyg
27       &          ,clw1,elij1,evap1,ep1,epmlmMm1,eplaMm1                             & ! RomP
28       &          ,wdtrainA1,wdtrainM1)                 ! RomP
29!
30!***************************************************************
31!*                                                             *
32!* CV3A_UNCOMPRESS                                             *
33!*                                                             *
34!*                                                             *
35!* written by   : Sandrine Bony-Lena , 17/05/2003, 11.22.15    *
36!* modified by  : Jean-Yves Grandpeix, 23/06/2003, 10.36.17    *
37!***************************************************************
38!*
39      implicit none
40
41#include "cv3param.h"
42
43!c inputs:
44      integer nloc, len, ncum, nd, ntra
45      integer idcum(nloc)
46      integer iflag(nloc),kbas(nloc),ktop(nloc)
47      real precip(nloc),cbmf(nloc),plcl(nloc),plfc(nloc)
48      real wbeff(len)
49      real sig(nloc,nd), w0(nloc,nd),ptop2(nloc)
50      real ft(nloc,nd), fq(nloc,nd), fu(nloc,nd), fv(nloc,nd)
51      real ftra(nloc,nd,ntra)
52      real sigd(nloc)
53      real Ma(nloc,nd),mip(nloc,nd),Vprecip(nloc,nd+1)
54      real upwd(nloc,nd),dnwd(nloc,nd),dnwd0(nloc,nd)
55      real qcondc(nloc,nd)
56      real wd(nloc),cape(nloc),cin(nloc)
57      real tvp(nloc,nd)
58      real ftd(nloc,nd), fqd(nloc,nd)
59      real Plim1(nloc),Plim2(nloc)
60      real asupmax(nloc,nd),supmax0(nloc)
61      real asupmaxmin(nloc)
62!
63      real da(nloc,nd),phi(nloc,nd,nd)                    !AC!
64      real mp(nloc,nd)                                    !RomP
65      real phi2(nloc,nd,nd)                               !RomP
66      real d1a(nloc,nd),dam(nloc,nd)                      !RomP
67      real sigij(nloc,nd,nd)                              !RomP
68      real clw(nloc,nd),elij(nloc,nd,nd)                  !RomP
69      real evap(nloc,nd),ep(nloc,nd)                      !RomP
70      real epmlmMm(nloc,nd,nd),eplaMm(nloc,nd)            !RomP+jyg
71      real wdtrainA(nloc,nd), wdtrainM(nloc,nd)           !RomP
72!
73!c outputs:
74      integer iflag1(len),kbas1(len),ktop1(len)
75      real precip1(len),cbmf1(len),plcl1(nloc),plfc1(nloc)
76      real wbeff1(len)
77      real sig1(len,nd), w01(len,nd),ptop21(len)
78      real ft1(len,nd), fq1(len,nd), fu1(len,nd), fv1(len,nd)
79      real ftra1(len,nd,ntra)
80      real sigd1(len)
81      real Ma1(len,nd),mip1(len,nd),Vprecip1(len,nd+1)
82      real upwd1(len,nd),dnwd1(len,nd),dnwd01(len,nd)
83      real qcondc1(len,nd)
84      real wd1(len),cape1(len),cin1(len)
85      real tvp1(len,nd)
86      real ftd1(len,nd), fqd1(len,nd)
87      real Plim11(len),Plim21(len)
88      real asupmax1(len,nd),supmax01(len)
89      real asupmaxmin1(len)
90!
91      real da1(nloc,nd),phi1(nloc,nd,nd)                  !AC!
92      real mp1(nloc,nd)                                   !RomP
93      real phi21(nloc,nd,nd)                              !RomP
94      real d1a1(nloc,nd),dam1(nloc,nd)                    !RomP
95      real sigij1(len,nd,nd)                              !RomP
96      real clw1(len,nd),elij1(len,nd,nd)                  !RomP
97      real evap1(len,nd),ep1(len,nd)                      !RomP
98      real epmlmMm1(len,nd,nd),eplaMm1(len,nd)            !RomP+jyg
99      real wdtrainA1(len,nd), wdtrainM1(len,nd)           !RomP
100!
101!c
102!c local variables:
103      integer i,k,j
104!cc    integer k1,k2
105
106        do 2000 i=1,ncum
107         ptop21(idcum(i))=ptop2(i)
108         sigd1(idcum(i))=sigd(i)
109         precip1(idcum(i))=precip(i)
110         cbmf1(idcum(i))=cbmf(i)
111         plcl1(idcum(i))=plcl(i)
112         plfc1(idcum(i))=plfc(i)
113         wbeff1(idcum(i))=wbeff(i)
114         iflag1(idcum(i))=iflag(i)
115         kbas1(idcum(i))=kbas(i)
116         ktop1(idcum(i))=ktop(i)
117         wd1(idcum(i))=wd(i)
118         cape1(idcum(i))=cape(i)
119         cin1(idcum(i))=cin(i)
120         Plim11(idcum(i))=Plim1(i)
121         Plim21(idcum(i))=Plim2(i)
122         supmax01(idcum(i))=supmax0(i)
123         asupmaxmin1(idcum(i))=asupmaxmin(i)
124 2000   continue
125
126        do 2020 k=1,nd
127          do 2010 i=1,ncum
128            sig1(idcum(i),k)=sig(i,k)
129            w01(idcum(i),k)=w0(i,k)
130            ft1(idcum(i),k)=ft(i,k)
131            fq1(idcum(i),k)=fq(i,k)
132            fu1(idcum(i),k)=fu(i,k)
133            fv1(idcum(i),k)=fv(i,k)
134            Ma1(idcum(i),k)=Ma(i,k)
135            mip1(idcum(i),k)=mip(i,k)
136            Vprecip1(idcum(i),k)=Vprecip(i,k)
137            upwd1(idcum(i),k)=upwd(i,k)
138            dnwd1(idcum(i),k)=dnwd(i,k)
139            dnwd01(idcum(i),k)=dnwd0(i,k)
140            qcondc1(idcum(i),k)=qcondc(i,k)
141            tvp1(idcum(i),k)=tvp(i,k)
142            ftd1(idcum(i),k)=ftd(i,k)
143            fqd1(idcum(i),k)=fqd(i,k)
144            asupmax1(idcum(i),k)=asupmax(i,k)
145!
146            da1(idcum(i),k)=da(i,k)                       !AC!
147            mp1(idcum(i),k)      = mp(i,k)                !RomP
148            d1a1(idcum(i),k)     = d1a(i,k)               !RomP
149            dam1(idcum(i),k)     = dam(i,k)               !RomP
150            clw1(idcum(i),k)     = clw(i,k)               !RomP
151            evap1(idcum(i),k)    = evap(i,k)              !RomP
152            ep1(idcum(i),k)      = ep(i,k)                !RomP
153            eplaMm(idcum(i),k)   = eplaMm(i,k)            !RomP+jyg
154            wdtrainA1(idcum(i),k)= wdtrainA(i,k)          !RomP
155            wdtrainM1(idcum(i),k)= wdtrainM(i,k)          !RomP
156!
157 2010    continue
158 2020   continue
159
160        do 2040 i=1,ncum
161          sig1(idcum(i),nd)=sig(i,nd)
1622040    continue
163
164
165!AC!        do 2100 j=1,ntra
166!AC!c oct3         do 2110 k=1,nl
167!AC!         do 2110 k=1,nd ! oct3
168!AC!          do 2120 i=1,ncum
169!AC!            ftra1(idcum(i),k,j)=ftra(i,k,j)
170!AC! 2120     continue
171!AC! 2110    continue
172!AC! 2100   continue
173
174!AC!
175       do j=1,nd
176         do k=1,nd
177          do i=1,ncum
178            phi1(idcum(i),k,j)   = phi(i,k,j)           !AC!
179            phi21(idcum(i),k,j)  = phi2(i,k,j)          !RomP
180            sigij1(idcum(i),k,j) = sigij(i,k,j)         !RomP
181            elij1(idcum(i),k,j)  = elij(i,k,j)          !RomP
182            epmlmMm(idcum(i),k,j)= epmlmMm(i,k,j)       !RomP+jyg
183          end do
184         end do
185        end do
186!AC!
187
188!c
189!c        do 2220 k2=1,nd
190!c         do 2210 k1=1,nd
191!c          do 2200 i=1,ncum
192!c            ment1(idcum(i),k1,k2) = ment(i,k1,k2)
193!c            sigij1(idcum(i),k1,k2) = sigij(i,k1,k2)
194!c2200      enddo
195!c2210     enddo
196!c2220    enddo
197
198       RETURN
199      END
200
Note: See TracBrowser for help on using the repository browser.