40
42 use element_mod , only : nixc
43
44
45
46#include "implicit_f.inc"
47
48
49
50#include "mvsiz_p.inc"
51
52
53
54#include "scr03_c.inc"
55#include "vect01_c.inc"
56
57
58
59 INTEGER IXC(NIXC,*)
60 INTEGER , DIMENSION(MVSIZ), INTENT(OUT) :: NGL,
61 . IX1,IX2,IX3,IX4
63 my_real ,
DIMENSION(MVSIZ),
INTENT(OUT) ::
64 . x1,x2,x3,x4,y1,y2,y3,y4,z1,z2,z3,z4
65
66
67
68 INTEGER I, TEST0, TEST1, TEST2
69 my_real xn14, xn13, xn24, xn23, xn12, x31,
70 . y31, z31, x42, y42, z42, e3x, e3y, e3z, surf
71
72
73
74 DO i=lft,llt
75 ix1(i)=ixc(2,i)
76 ix2(i)=ixc(3,i)
77 ix3(i)=ixc(4,i)
78 ix4(i)=ixc(5,i)
79 ngl(i)=ixc(nixc,i)
80 ENDDO
81
82
83
84 IF (nxref == 0) THEN
85 DO i=lft,llt
86 x1(i)=x(1,ix1(i))
87 y1(i)=x(2,ix1(i))
88 z1(i)=x(3,ix1(i))
89 x2(i)=x(1,ix2(i))
90 y2(i)=x(2,ix2(i))
91 z2(i)=x(3,ix2(i))
92 x3(i)=x(1,ix3(i))
93 y3(i)=x(2,ix3(i))
94 z3(i)=x(3,ix3(i))
95 x4(i)=x(1,ix4(i))
96 y4(i)=x(2,ix4(i))
97 z4(i)=x(3,ix4(i))
98 ENDDO
99 ELSE
100 DO i=lft,llt
101 x1(i)=xrefc(1,1,i)
102 y1(i)=xrefc(1,2,i)
103 z1(i)=xrefc(1,3,i)
104 x2(i)=xrefc(2,1,i)
105 y2(i)=xrefc(2,2,i)
106 z2(i)=xrefc(2,3,i)
107 x3(i)=xrefc(3,1,i)
108 y3(i)=xrefc(3,2,i)
109 z3(i)=xrefc(3,3,i)
110 x4(i)=xrefc(4,1,i)
111 y4(i)=xrefc(4,2,i)
112 z4(i)=xrefc(4,3,i)
113 ENDDO
114 ENDIF
115
116 DO i=lft,llt
117 xn14=(x1(i)-x4(i))**2+(y1(i)-y4(i))**2+(z1(i)-z4(i))**2
118 xn13=(x1(i)-x3(i))**2+(y1(i)-y3(i))**2+(z1
119 xn24=(x2(i)-x4(i))**2+(y2(i)-y4(i))**2+(z2(i)-z4(i))**2
120 xn23=(x2(i)-x3(i))**2+(y2(i)-y3(i))**2+(z2(i)-z3(i))**2
121 xn12=(x1(i)-x2(i))**2+(y1(i)-y2(i))**2+(z1(i)-z2(i))**2
122 x31=x3(i)-x1(i)
123 y31=y3(i)-y1(i)
124 z31=z3(i)-z1(i)
125 x42=x4(i)-x2(i)
126 y42=y4(i)-y2(i)
127 z42=z4(i)-z2(i)
128 e3x=y31*z42-z31*y42
129 e3y=z31*x42-x31*z42
130 e3z=x31*y42-y31*x42
131 surf=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
132
133 test0=0
134 test1=0
135 test2=0
136 IF (xn13+xn24+xn12 < em20) THEN
137 CALL ancmsg(msgid=20,anmode=aninfo,msgtype=msgerror,
138 . i1=ixc(nixc,i))
139 test0=1
140 ELSE IF(surf<=em20) THEN
141 CALL ancmsg(msgid=21,anmode=aninfo,msgtype=msgerror,
142 . i1=ixc(nixc,i))
143 test1=1
144 ELSE IF(xn12<=1.e-20.OR.xn23<=1.e-20.OR.xn14<=1.e-20) THEN
145 CALL ancmsg(msgid=22,anmode=aninfo,msgtype=msgerror,
146 . i1=ixc(nixc,i))
147 test2=1
148 ENDIF
149 IF (test0 == 1 .OR. test1 == 1 .OR. test2 == 1) THEN
150 x1(i)=zero
151 y1(i)=zero
152 z1(i)=zero
153 x2(i)=one
154 y2(i)=zero
155 z2(i)=zero
156 x3(i)=one
157 y3(i)=one
158 z3(i)=zero
159 x4(i)=zero
160 y4(i)=one
161 z4(i)=zero
162 ENDIF
163 ENDDO
164
165 RETURN
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)
1.15.0