37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
53 USE elbufdef_mod
57 USE multimat_param_mod , ONLY : m51_n0phas, m51_nvphas
58
59
60
61#include "implicit_f.inc"
62
63
64
65#include "com01_c.inc"
66#include "com04_c.inc"
67#include "vect01_c.inc"
68#include "param_c.inc"
69#include "inter22.inc"
70
71
72
73 INTEGER,INTENT(IN) :: IFUNC, IFLOW(*),IPARG(NPARG,*),IX(NIX,*),ITAB(*),NIX,NV46
75 REAL,INTENT(INOUT) :: WA4(*)
76
77 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
78 TYPE(BUF_MAT_),POINTER :: MBUF
79
80
81
82 INTEGER :: IADI, IADR, I, ITYP, NINOUT, NNO, NEL, II1, II2,K1,K,
83 . IR1, IR2, J, JJ, NNO_L, NNI_L, II3, II4, JJJ, NNI,
84 . IALEL,NNOD,IPOS,IV,NGv,J1,J2,IBV, MLW,NumNodCell,
85 . NG, KCVT, II, NBF, NBL, IB, ICELL, NIN, MCELL,
86 . IPHASE
87 TYPE(G_BUFEL_) ,POINTER :: GBUF,GBUFv
88 my_real,
ALLOCATABLE,
DIMENSION(:) :: count_vol
90 INTEGER,DIMENSION(:,:), POINTER :: pAdjBRICK
91
92
93
94
95
96
97
98
99
100
101
102 nnod = nix-3
103 iphase = ifunc-19
104
105 IF(int22==0)THEN
106
107
108
109
110
111
112 ALLOCATE(count_vol(numnod))
113 count_vol(:) = 0
114 DO ng = 1, ngroup
115 mlw = iparg(1,ng)
116 nel = iparg(2,ng)
117 nft = iparg(3,ng)
118 ityp = iparg(5,ng)
119 ialel = iparg(7,ng)+iparg(11,ng)
120 IF(ityp/=1 .AND. ityp/=2)cycle
121 IF(ialel==0)cycle
122 IF(mlw/=37.AND.mlw/=51)cycle
123 gbuf => elbuf_tab(ng)%GBUF
124 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
125 IF(mlw==37)THEN
126 DO i=1,nel
127 vf = mbuf%VAR(nel*(3+iphase-1)+i)
128
129 DO j=2,nnod+1
130 jj = ix(j,nft+i)
131 wa4(jj) = wa4(jj)+vf*v*one_over_8
132 count_vol(jj) = count_vol(jj) + v * one_over_8
133 ENDDO
134 enddo
135 ELSEIF(mlw==51)THEN
136 DO i=1,nel
137 ipos = 1
138 k1 = m51_n0phas + (iphase-1)*m51_nvphas +ipos-1
139 k = k1 * nel
140 vf = mbuf%VAR(k+i)
141 v = gbuf%VOL(i)
142 DO j=2,nnod+1
143 jj = ix(j,nft+i)
144 wa4(jj) = wa4(jj)+vf*v*one_over_8
145 count_vol(jj) = count_vol(jj) + v * one_over_8
146 ENDDO
147 enddo
148 ENDIF
149 enddo
150
151 DO i=1,numnod
152 IF(count_vol(i)/=zeroTHEN
153 wa4(i)=wa4(i)/count_vol(i)
154 ENDIF
155 ENDDO
156 DEALLOCATE(count_vol)
157 ELSEIF(int22>0)THEN
158
159
160
161
162
163
164
165
166
167
168 nbf = 1
170 nin = 1
171
172 ALLOCATE(count_vol(numnod))
173 count_vol = 0
174 DO ng = 1, ngroup
175 mlw = iparg(1,ng)
176 nel = iparg(2,ng)
177 nft = iparg(3,ng)
178 ityp = iparg(5,ng)
179 ialel = iparg(7,ng)+iparg(11,ng)
180 IF(ityp/=1 .AND. ityp/=2)cycle
181 IF(ialel==0)cycle
182 IF(mlw/=37.AND.mlw/=51)cycle
183 gbuf => elbuf_tab(ng)%GBUF
184 mbuf
185 DO i=1,nel
186 ib = nint(gbuf%TAG22(i))
187
188
189
190 IF(ib==0)THEN
191 IF(mlw==37)THEN
192 vf = mbuf%VAR(nel*(3+iphase-1)+i)
193 v = gbuf%VOL(i)
194 DO j=2,nnod+1
195 jj = ix(j,nft+i)
196 wa4(jj) = wa4(jj)+vf*v*one_over_8
197 count_vol(jj) = count_vol(jj) + v * one_over_8
198 ENDDO
199 ELSEIF(mlw==51)THEN
200 ipos = 1
201 k1 = m51_n0phas + (iphase-1)*m51_nvphas +ipos-1
202 k = k1 * nel
203 vf = mbuf%VAR(k+i)
204 v = gbuf%VOL(i)
205 DO j=2,nnod+1
206 jj = ix(j,nft+i)
207 wa4(jj) = wa4(jj)+vf*v*one_over_8
208 count_vol(jj) = count_vol(jj) + v * one_over_8
209 ENDDO
210 ENDIF
211
212
213
214 ELSE
215 nin = 1
216 DO j=2,nnod+1
217 jj = ix(j,nft+i)
218 icell =
brick_list(nin,ib)%NODE(j-1)%WhichCell
219 vf =
brick_list(nin,ib)%POLY(icell)%VFRACm(iphase)
220
221
222
223 numnodcell =
brick_list(nin,ib)%POLY(icell)%NumNOD
225 wa4(jj) = wa4(jj)+vf*v/numnodcell
226 count_vol(jj) = count_vol(jj) + v / numnodcell
227 ENDDO
228 ENDIF
229 enddo
230 enddo
231 DO i=1,numnod
232 IF(count_vol(i)/=zero)THEN
233 wa4(i)=wa4(i)/count_vol(i)
234 ENDIF
235 ENDDO
236 DEALLOCATE(count_vol)
237
238 endif
239
240
241
242 RETURN
type(brick_entity), dimension(:,:), allocatable, target brick_list