34 use element_mod , only : nixr
35
36
37
38#include "implicit_f.inc"
39
40
41
42#include "mvsiz_p.inc"
43
44
45
46#include "impl1_c.inc"
47#include "comlock.inc"
48#include "units_c.inc"
49#include "scr17_c.inc"
50
51
52
53 INTEGER JFT, JLT
54 INTEGER NCC(NIXR,*),PID(*),NGL(*)
55
57 . x(3,*),al(*),
58 . r11(*),r21(*),r31(*),offg(*) ,off(*)
59
60
61
62 INTEGER I,NC1(MVSIZ),NC2(MVSIZ)
63
65 . x1(mvsiz), x2(mvsiz),y1(mvsiz), y2(mvsiz),
66 . z1(mvsiz), z2(mvsiz),
norm
67
68
69 DO i=jft, jlt
70 pid(i)=ncc(1,i)
71 ngl(i)=ncc(5,i)
72 nc1(i)=ncc(2,i)
73 nc2(i)=ncc(3,i)
74 ENDDO
75
76
77
78 DO i=jft, jlt
79 x1(i)=x(1,nc1(i))
80 y1(i)=x(2,nc1(i))
81 z1(i)=x(3,nc1(i))
82 x2(i)=x(1,nc2(i))
83 y2(i)=x(2,nc2(i))
84 z2(i)=x(3,nc2(i))
85 ENDDO
86
87
88
89 DO i=jft, jlt
90 r11(i)=one
91 r21(i)=zero
92 r31(i)=zero
93 ENDDO
94 DO i=jft, jlt
95 r11(i)=x2(i)-x1(i)
96 r21(i)=y2(i)-y1(i)
97 r31(i)=z2(i)-z1(i)
98 al(i)=sqrt(r11(i)*r11(i)+r21(i)*r21(i)+r31(i)*r31(i))
100 ENDDO
101 IF (imp_chk > 0) THEN
102 DO i=jft,jlt
103 IF(offg(i)/=zero)THEN
104 IF(al(i)<=em14)THEN
105#include "lockon.inc"
106 WRITE(iout ,2001) ngl(i)
107#include "lockoff.inc"
108 idel7nok = 1
109 imp_iw = imp_iw + 1
110 ENDIF
111 ENDIF
112 ENDDO
113 ENDIF
114
115 DO i=jft, jlt
116 IF (al(i)>em14) THEN
121 ENDIF
122 ENDDO
123 DO i=jft,jlt
124 off(i)=offg(i)
125 ENDDO
126
127 RETURN
128 2001 FORMAT(/'***WARNING :SPRING TYPE4 ZERO-LENGTH : ELEMENT NB:',
129 . i8/)
norm(diag(diag(diag(inv(mat))) -id.SOL), 2) % destroy mumps instance id.JOB