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 | |
---|
39 | c 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! |
---|
61 | c 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! |
---|
81 | c |
---|
82 | c 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) |
---|
132 | 2040 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 | |
---|
154 | c |
---|
155 | c do 2220 k2=1,nd |
---|
156 | c do 2210 k1=1,nd |
---|
157 | c do 2200 i=1,ncum |
---|
158 | c ment1(idcum(i),k1,k2) = ment(i,k1,k2) |
---|
159 | c sij1(idcum(i),k1,k2) = sij(i,k1,k2) |
---|
160 | c2200 enddo |
---|
161 | c2210 enddo |
---|
162 | c2220 enddo |
---|
163 | |
---|
164 | RETURN |
---|
165 | END |
---|
166 | |
---|