37 . A ,AR ,STIFN ,STIFR ,WEIGHT ,
38 . NSV ,MSR ,IRTL ,IRECT ,CRST ,
39 . MMASS ,SMASS ,SINER ,FSAV ,NSN ,
40 . NMN ,IDEL2 ,FNCONT ,H3D_DATA,FNCONTP ,
49#include "implicit_f.inc"
54 INTEGER IRECT(4,*),NSV(*),MSR(*),IRTL(*),WEIGHT(*)
57 . MS(*),IN(*),MMASS(*),SMASS(*),SINER(*),X(3,*),V(3,*),
58 . VR(3,*),A(3,*),AR(3,*),STIFN(*),STIFR(*),FSAV(*),
59 . crst(2,*),fncont(3,*),fncontp(3,*),ftcontp(3,*)
60 TYPE (H3D_DATABASE) :: H3D_DATA
64 INTEGER I1,I2,I3,I4,II,IS,IM,JJ,L,NIR
67 . xms,ins,stfn,stfr,fs(3),moms(3),ls1,ls2,lt1,lt2,
68 . ls,lt,len,s,t,w,xc,yc,zc,dm1,dm2,din1,din2,din3,
71 . fsloc(6),fmloc(4,6),rot(9),roti(9),dm(4),din(4),dstfn(4),
72 . dstfr(4),h(4),hh(4),hrs(4),hrt(4),hps(4),hpt(4),hprs
73 . hprt(4),hxs(4),hxt(4),fx(4),fy(4),fz(4)
83 inod(jj) = irect(jj,l)
87 . lt1 ,lt2 ,rot(1) ,rot(4) ,rot(7) ,
88 . rot(2) ,rot(5) ,rot(8) ,rot(3) ,rot(6) ,
95 . nir,s,t,h,hh,hrs,hrt,hps,hpt,hprs,hprt,
96 . hxs,hxt,ls1,ls2,lt1,lt2,ls,lt)
98 sumhrs = abs(hrs(1) +hrs(2) +hrs(3) +hrs(4))
99 sumhrt = abs(hrt(1) +hrt(2) +hrt(3) +hrt(4))
100 sumhprs = abs(hprs(1)+hprs(2)+hprs(3)+hprs(4))
101 sumhprt = abs(hprt(1)+hprt(2)+hprt(3)+hprt(4))
106 xc = x(1,i1)*h(1)+x(1,i2)*h(2)+x(1,i3)*h(3)+x(1,i4)*h(4)
107 yc = x(2,i2)*h(1)+x(2,i2)
108 zc = x(3,i3)*h(1)+x(3,i2)*h(2)+x(3,i3)*h(3)+x(3,i4)*h(4)
123 fsloc(1) = rot(1)*fs(1) + rot(4)*fs(2) + rot(7)*fs(3)
124 fsloc(2) = rot(2)*fs(1) + rot(5)*fs(2) + rot(8)*fs(3)
125 fsloc(3) = rot(3)*fs(1) + rot(6)*fs(2) + rot(9)*fs(3)
126 fsloc(4) = rot(1)*moms(1) + rot(4)*moms(2) + rot(7)*moms(3)
127 fsloc(5) = rot(2)*moms(1) + rot(5)*moms(2) + rot(8)*moms(3)
128 fsloc(6) = rot(3)*moms(1) + rot(6)*moms(2) + rot(9)*moms(3)
132 fmloc(jj,1) = h(jj)*fsloc(1)
133 fmloc(jj,2) = h(jj)*fsloc(2)
134 fmloc(jj,3) = hh(jj)*fsloc(3)
135 . + hps(jj)*fsloc(4) + hpt(jj)*fsloc(5)
136 fmloc(jj,4) = hrs(jj)*fsloc(3)
137 . + hprs(jj)*fsloc(4) + hxt(jj)*fsloc(5)
138 fmloc(jj,5) = hrt(jj)*fsloc(3)
139 . + hxs(jj)*fsloc(4) + hprt(jj)*fsloc(5)
140 fmloc(jj,6) = h(jj)*fsloc(6)
145 len = sqrt((x(1,im)-xc)**2+(x(2,im)-yc)**2+(x(3,im)-zc)**2)
150 dm2 = dm2 + hh(jj)*(sumhrs +sumhrt)*xms/len
151 . +(abs(hps(jj))*sumhprs + abs(hpt(jj))*sumhprt)*ins/len
155 dstfn(jj) = h(jj)*stfn
156 ELSEIF (len > zero)
THEN
158 dstfn(jj) = hh(jj)*stfn
159 . + hh(jj)*(sumhrs +sumhrt)*stfn/len
160 . +(abs(hps(jj))*sumhprs + abs(hpt(jj))*sumhprt)*stfr/len
163 dstfn(jj) = hh(jj)*stfn
166 din1 = abs(hrs(jj))*(sumhrs+sumhrt)*xms
167 . +(abs(hprs(jj))*sumhprs + abs(hxt(jj))*sumhprt)*ins
168 . + abs(hrs(jj))*xms*len
169 din2 = abs(hrt(jj))*(sumhrs+sumhrt)*xms
170 . +(abs(hprt(jj))*sumhprt + abs(hxs(jj))*sumhprs)*ins
171 . + abs(hrt(jj))*xms*len
173 IF (din1 >= din2 .AND. din1 >= din3)
THEN
175 dstfr(jj) = abs(hrs(jj))*(sumhrs+sumhrt)*stfn
176 . +(abs(hprs(jj))*sumhprs + abs(hxt(jj))*sumhprt)*stfr
177 . + abs(hrs(jj))*stfn*len
178 ELSEIF (din2 >= din1 .AND. din2 >= din3)
THEN
180 dstfr(jj) = abs(hrt(jj))*(sumhrs+sumhrt)*stfn
181 . +(abs(hprt(jj))*sumhprt + abs(hxs(jj))*sumhprs)*stfr
182 . + abs(hrt(jj))*stfn*len
183 ELSEIF (din3 >= din1 .AND. din3 >= din2)
THEN
185 dstfr(jj) = h(jj)*stfr
193 fx(jj) = roti(1)*fmloc(jj,1)+roti(4)*fmloc
194 fy(jj) = roti(2)*fmloc(jj,1)+roti(5)*fmloc(jj,2)+roti(8)*fmloc(jj,3)
195 fz(jj) = roti(3)*fmloc(jj,1)+roti(6
196 a(1,im) = a(1,im) + fx(jj)
197 a(2,im) = a(2,im) + fy(jj)
198 a(3,im) = a(3,im) + fz(jj)
199 ar(1,im) = ar(1,im) +
200 . roti(1)*fmloc(jj,4)+roti(4)*fmloc(jj,5)+roti(7)*fmloc(jj,6)
201 ar(2,im) = ar(2,im) +
202 . roti(2)*fmloc(jj,4)+roti(5)*fmloc(jj,5)+roti(8)*fmloc(jj,6)
203 ar(3,im) = ar(3,im) +
204 . roti(3)*fmloc(jj,4)+roti(6)*fmloc(jj,5)+roti(9)*fmloc(jj,6)
205 ms(im) = ms(im) + dm(jj)
206 in(im) = in(im) + din(jj)
207 stifn(im) = stifn(im) + dstfn(jj)
208 stifr(im) = stifr(im) + dstfr(jj)
213 . inod(1) ,nir ,fsav ,fncont ,fncontp,
214 . ftcontp ,weight ,h3d_data,is ,h)
216 IF (idel2/=0.AND.ms(is)/=zero) smass(ii)=ms(is)
217 IF (idel2/=0.AND.ms(is)/=zero) siner(ii)=in(is)