33
34
35
38
39
40
41#include "implicit_f.inc"
42
43
44
45
46
47
48 INTEGER IBUFN(*),ITY,ID,ADMID
49 my_real ms(*),amasu,x(3,*),addmas
50 CHARACTER(LEN=NCHARTITLE)::TITR
51
52
53
54 INTEGER K
56 . x1,x2,x3,x4,y1,y2,y3,y4,z1,z2,z3,z4,
57 . x21,y21,z21,x31,y31,z31,x42,y42,z42,
58 . x32,y32,z32,e3x,e3y,e3z,smass,sum,
area,
59 . a2,b2,c2,aa,bb,cc,ang1,ang2,ang3
60
61 IF(ity /= 7)THEN
62
63
64
65 x1=x(1,ibufn(1))
66 y1=x(2,ibufn(1))
67 z1=x(3,ibufn(1))
68 x2=x(1,ibufn(2))
69 y2=x(2,ibufn(2))
70 z2=x(3,ibufn(2))
71 x3=x(1,ibufn(3))
72 y3=x(2,ibufn(3))
73 z3=x(3,ibufn(3))
74 x4=x(1,ibufn(4))
75 y4=x(2,ibufn(4))
76 z4=x(3,ibufn(4))
77
78 x21=x2-x1
79 y21=y2-y1
80 z21=z2-z1
81 x31=x3-x1
82 y31=y3-y1
83 z31=z3-z1
84 x42=x4-x2
85 y42=y4-y2
86 z42=z4-z2
87
88 e3x=y31*z42-z31*y42
89 e3y=z31*x42-x31*z42
90 e3z=x31*y42-y31*x42
91 sum=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
93
94
95
97
98 ms(ibufn(1))=ms(ibufn(1)) + smass * fourth
99 ms(ibufn(2))=ms(ibufn(2)) + smass * fourth
100 ms(ibufn(3))=ms(ibufn(3)) + smass * fourth
101 ms(ibufn(4))=ms(ibufn(4)) + smass * fourth
102
103 addmas = addmas + smass
104
105 ELSE IF(ity == 7)THEN
106
107
108
109 x1=x(1,ibufn(1))
110 y1=x(2,ibufn(1))
111 z1=x(3,ibufn(1))
112 x2=x(1,ibufn(2))
113 y2=x(2,ibufn(2))
114 z2=x(3,ibufn(2))
115 x3=x(1,ibufn(3))
116 y3=x(2,ibufn(3))
117 z3=x(3,ibufn(3))
118
119 x21=x2-x1
120 y21=y2-y1
121 z21=z2-z1
122 x31=x3-x1
123 y31=y3-y1
124 z31=z3-z1
125 x32=x3-x2
126 y32=y3-y2
127 z32=z3-z2
128
129 a2 = x21**2 + y21**2 + z21**2
130 b2 = x32**2 + y32**2 + z32**2
131 c2 = x31**2 + y31**2 + z31**2
132 aa = sqrt(a2)
133 bb = sqrt(b2)
134 cc = sqrt(c2)
135
136 ang1 = acos((a2 + c2 - b2)/(two * aa * cc)) / pi
137 ang2 = acos((a2 + b2 - c2)/(two * aa * bb)) / pi
138 ang3 = acos((b2 + c2 - a2)/(two * bb * cc)) / pi
139
140 IF ( ( (a2 + c2 - b2)/(2. * aa * cc) <= -one ) .OR.
141 . ( (a2 + c2 - b2)/(2. * aa * cc) >= one ) .OR.
142 . ( (a2 + b2 - c2)/(2. * aa * bb) <= -one ) .OR.
143 . ( (a2 + b2 - c2)/(2. * aa * bb) >= one ) .OR.
144 . ( (b2 + c2 - a2)/(2. * bb * cc) <= -one ) .OR.
145 . ( (b2 + c2 - a2)/(2. * bb * cc) >= one ) ) THEN
147 . msgtype=msgerror,
148 . anmode=aninfo,
149 . i1=admid,
151 ENDIF
152
153 e3x=y21*z31-z21*y31
154 e3y=z21*x31-x21*z31
155 e3z=x21*y31-y21*x31
156 sum=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
158
160
161 ms(ibufn(1))=ms(ibufn(1)) + smass * ang1
162 ms(ibufn(2))=ms(ibufn(2)) + smass * ang2
163 ms(ibufn(3))=ms(ibufn(3)) + smass * ang3
164
165
166
167 addmas = addmas + smass
168 END IF
169
170 RETURN
subroutine area(d1, x, x2, y, y2, eint, stif0)
integer, parameter nchartitle
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)