43
44
45
46#include "implicit_f.inc"
47
48
49
50#include "mvsiz_p.inc"
51
52
53
54 INTEGER, INTENT(IN) :: ISMSTR
55 INTEGER JFT, JLT,NEL
57 . px1(*), px2(*), py1(*), py2(*),
58 . offg(*),sti(*), stir(*)
60 . x2(mvsiz), x3(mvsiz), x4(mvsiz),
area(mvsiz),
61 . y2(mvsiz), y3(mvsiz), y4(mvsiz), z2(mvsiz),
62 . x1g(mvsiz), x2g(mvsiz), x3g(mvsiz), x4g(mvsiz),
63 . y1g(mvsiz), y2g(mvsiz), y3g(mvsiz), y4g(mvsiz),
64 . z1g(mvsiz), z2g(mvsiz), z3g(mvsiz), z4g(mvsiz),
65 . e1x(mvsiz), e1y(mvsiz), e1z(mvsiz),
66 . e2x(mvsiz), e2y(mvsiz), e2z(mvsiz),
67 . e3x(mvsiz), e3y(mvsiz), e3z(mvsiz),
68 . vhx(mvsiz), vhy(mvsiz), a_i(mvsiz),
69 . ux1(mvsiz),ux2(mvsiz),ux3(mvsiz),ux4(mvsiz),
70 . uy1(mvsiz),uy2(mvsiz),uy3(mvsiz),uy4(mvsiz)
71 double precision
72 . smstr(*)
73
74
75
76
77
78
79 INTEGER I,II(6),J
80
82 . x21g(mvsiz), y21g(mvsiz), z21g(mvsiz), x31g(mvsiz),
83 . y31g(mvsiz), z31g(mvsiz),
84 . x41g(mvsiz), y41g(mvsiz), z41g(mvsiz)
86 . x21ga, y21ga, z21ga, x31ga, y31ga, z31ga,
87 . x41ga, y41ga, z41ga
88
89 DO i=1,6
90 ii(i) = nel*(i-1)
91 ENDDO
92
93 DO i=jft,jlt
94 sti(i) = zero
95 stir(i)= zero
96 x21ga=x2g(i)-x1g(i)
97 y21ga=y2g(i)-y1g(i)
98 z21ga=z2g(i)-z1g(i)
99 x31ga=x3g(i)-x1g(i)
100 y31ga=y3g(i)-y1g(i)
101 z31ga=z3g(i)-z1g(i)
102 x41ga=x4g(i)-x1g(i)
103 y41ga=y4g(i)-y1g(i)
104 z41ga=z4g(i)-z1g(i)
105
106 x2(i)=e1x(i)*x21ga+e1y(i)*y21ga+e1z(i)*z21ga
107 y2(i)=e2x(i)*x21ga+e2y(i)*y21ga+e2z(i)*z21ga
108 y3(i)=e2x(i)*x31ga+e2y(i)*y31ga+e2z(i)*z31ga
109 x3(i)=e1x(i)*x31ga+e1y(i)*y31ga+e1z(i)*z31ga
110 x4(i)=e1x(i)*x41ga+e1y(i)*y41ga+e1z(i)*z41ga
111 y4(i)=e2x(i)*x41ga+e2y(i)*y41ga+e2z(i)*z41ga
112 z2(i)=e3x(i)*x21ga+e3y(i)*y21ga+e3z(i)*z21ga
113 ENDDO
114
115 IF (ismstr == 11) THEN
116 DO i=jft,jlt
117 IF(abs(offg(i)) == one)offg(i)=sign(two,offg(i))
118 ux1(i) = zero
119 uy1(i) = zero
120 ux2(i) = zero
121 uy2(i) = zero
122 ux3(i) = zero
123 uy3(i) = zero
124 ux4(i) = zero
125 uy4(i) = zero
126 IF(abs(offg(i)) == two)THEN
127 ux2(i) = x2(i)-smstr(ii(1)+i)
128 uy2(i) = y2(i)-smstr(ii(2)+i)
129 ux3(i) = x3(i)-smstr(ii(3)+i)
130 uy3(i) = y3(i)-smstr(ii(4)+i)
131 ux4(i) = x4(i)-smstr(ii(5)+i)
132 uy4(i) = y4(i)-smstr(ii(6)+i)
133 x2(i) = smstr(ii(1)+i)
134 y2(i) = smstr(ii(2)+i)
135 x3(i) = smstr(ii(3)+i)
136 y3(i) = smstr(ii(4)+i)
137 x4(i) = smstr(ii(5)+i)
138 y4(i) = smstr(ii(6)+i)
139 z2(i) = zero
140 ELSE
141 smstr(ii(1)+i)=x2(i)
142 smstr(ii(2)+i)=y2(i)
143 smstr(ii(3)+i)=x3(i)
144 smstr(ii(4)+i)=y3(i)
145 smstr(ii(5)+i)=x4(i)
146 smstr(ii(6)+i)=y4(i)
147 ENDIF
148 ENDDO
149 ELSEIF(ismstr == 1.OR.ismstr == 2)THEN
150 DO i=jft,jlt
151 IF(abs(offg(i)) == two)THEN
152 x2(i)=smstr(ii(1)+i)
153 y2(i)=smstr(ii(2)+i)
154 x3(i)=smstr(ii(3)+i)
155 y3(i)=smstr(ii(4)+i)
156 x4(i)=smstr(ii(5)+i)
157 y4(i)=smstr(ii(6)+i)
158 z2(i)=zero
159 ELSE
160 smstr(ii(1)+i)=x2(i)
161 smstr(ii(2)+i)=y2(i)
162 smstr(ii(3)+i)=x3(i)
163 smstr(ii(4)+i)=y3(i)
164 smstr(ii(5)+i)=x4(i)
165 smstr(ii(6)+i)=y4(i)
166 ENDIF
167 ENDDO
168 IF (ismstr == 1) THEN
169 DO i=jft,jlt
170 IF (offg(i) == one) offg(i)=two
171 ENDDO
172 ENDIF
173 ENDIF
174
175 DO 40 i=jft,jlt
176 px1(i)= half*(y2(i)-y4(i))
177 py1(i)= half*(x4(i)-x2(i))
178 px2(i)= half* y3(i)
179 py2(i)=-half* x3(i)
180 40 CONTINUE
181
182 DO i=jft,jlt
183 area(i)=
max(two*(py2(i)*px1(i)-py1(i)*px2(i)),em20)
184 a_i(i) = one /
area(i)
185 ENDDO
186
187
188
189 DO i=jft,jlt
190 vhx(i)=(-x2(i)+x3(i)-x4(i))/
area(i)
191 vhy(i)=(-y2(i)+y3(i)-y4(i))/
area(i)
192 ENDDO
193
194 RETURN
subroutine area(d1, x, x2, y, y2, eint, stif0)