40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
58 USE elbufdef_mod
63 use element_mod , only : nixs,nixq
64
65
66
67#include "implicit_f.inc"
68
69
70
71#include "com01_c.inc"
72#include "com04_c.inc"
73#include "vect01_c.inc"
74#include "param_c.inc"
75#include "mvsiz_p.inc"
76
77
78
79 INTEGER IXQ(NIXQ,*),IXS(NIXS,*),ITAB(*),IPARG(NPARG,*)
80 REAL WA4(*)
82 INTEGER :: IBID
83 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET ::
84 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECTIVITY
85
86
87
88 INTEGER I, ITYP, NEL,
89 . IR1, IR2, J, JJ, NNO_L, NNI_L, II3, II4, JJJ, NNI,
90 . IALEL,NNOD,IPOS,NGv,IDLOCv,K, IAD2
91 INTEGER IV(6), IE
92 INTEGER NG
93 TYPE(G_BUFEL_) ,POINTER :: GBUF
94 my_real,
ALLOCATABLE,
DIMENSION(:) :: count_vol
96
98
99
100
101
102
103
104
105
106 wa4(1:numnod) = zero
107
108 RETURN
109
110
111
112
113
114
115
116 nnod = nixs-3
117
118
119
120
121 ALLOCATE(count_vol(numnod))
122 count_vol(:) = 0
123 DO ng = 1, ngroup
124 nel =iparg(2,ng)
125 nft =iparg(3,ng)
126 ityp =iparg(5,ng)
127 ialel =iparg(7,ng)+iparg(11,ng)
128 IF(ityp/=1 .AND. ityp/=2)cycle
129 IF(ialel==0)cycle
130 gbuf => elbuf_tab(ng)%GBUF
131 DO i=1,nel
132 j = i+nft
133
134 ENDDO
135 ENDDO
136
137 DO ng = 1, ngroup
138 nel =iparg(2,ng)
139 nft =iparg(3,ng)
140 ityp =iparg(5,ng)
141 ialel =iparg(7,ng)+iparg(11,ng)
142 IF(ityp/=1 .AND. ityp/=2)cycle
143 IF(ialel==0)cycle
144 gbuf => elbuf_tab(ng)%GBUF
145 DO i=1,nel
146 lft = 1
147 llt = nel
149 1 ixs, x, ale_connectivity,grad)
150 ie =nft+i
151 iad2 = ale_connectivity%ee_connect%iad_connect(ie)
152 iv(1)=ale_connectivity%ee_connect%connected(iad2 + 1 - 1
153 iv(2)=ale_connectivity%ee_connect%connected(iad2 + 2 - 1)
154 iv(3)=ale_connectivity%ee_connect%connected(iad2 + 3 - 1)
155 iv(4)=ale_connectivity%ee_connect%connected(iad2 + 4 - 1)
156 iv(5)=ale_connectivity%ee_connect%connected(iad2 + 5 - 1)
157 iv(6)=ale_connectivity%ee_connect%connected(iad2 + 6 - 1)
158 IF(iv(1)<=0)iv(1)=ie
159 IF(iv(2)<=0)iv(2)=ie
160 IF(iv(3)<=0)iv(3)=ie
161 IF(iv(4)<=0)iv(4)=ie
162 IF(iv(5)<=0)iv(5)=ie
163 IF(iv(6)<=0)iv(6)=ie
164 dphi(i) = zero
165
166
167
168
169
170
171 DO j=2,nnod+1
172 jj=ixs(j,nft+i)
173 k = j-1
174 wa4(jj) = wa4(jj)+ dphi(i)
175 count_vol(jj) = count_vol(jj) + 1
176 ENDDO
177 ENDDO
178 enddo
179
180
181 DO i=1,numnod
182 IF(count_vol(i)/=zero)THEN
183 wa4(i)=wa4(i)/count_vol(i)
184 ENDIF
185 ENDDO
186 DEALLOCATE(count_vol)
187
subroutine agrad3(ixs, x, ale_connectivity, grad, nel)