OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i7err3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i7err3 (x, nrtm, irect, noint, itab, id, titr, ix1, ix2, ix3, ix4, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, n1, n2, n3, x0, y0, z0, xn1, yn1, zn1, xn2, yn2, zn2, xn3, yn3, zn3, xn4, yn4, zn4)

Function/Subroutine Documentation

◆ i7err3()

subroutine i7err3 ( x,
integer nrtm,
integer, dimension(4,*) irect,
integer noint,
integer, dimension(*) itab,
integer id,
character(len=nchartitle) titr,
integer, dimension(mvsiz), intent(out) ix1,
integer, dimension(mvsiz), intent(out) ix2,
integer, dimension(mvsiz), intent(out) ix3,
integer, dimension(mvsiz), intent(out) ix4,
intent(inout) x1,
intent(inout) x2,
intent(inout) x3,
intent(inout) x4,
intent(inout) y1,
intent(inout) y2,
intent(inout) y3,
intent(inout) y4,
intent(inout) z1,
intent(inout) z2,
intent(inout) z3,
intent(inout) z4,
intent(inout) n1,
intent(inout) n2,
intent(inout) n3,
intent(inout) x0,
intent(inout) y0,
intent(inout) z0,
intent(inout) xn1,
intent(inout) yn1,
intent(inout) zn1,
intent(inout) xn2,
intent(inout) yn2,
intent(inout) zn2,
intent(inout) xn3,
intent(inout) yn3,
intent(inout) zn3,
intent(inout) xn4,
intent(inout) yn4,
intent(inout) zn4 )

Definition at line 33 of file i7err3.F.

42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE message_mod
46 USE names_and_titles_mod , ONLY : nchartitle
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51C-----------------------------------------------
52C G l o b a l P a r a m e t e r s
53C-----------------------------------------------
54#include "mvsiz_p.inc"
55C-----------------------------------------------
56C C o m m o n B l o c k s
57C-----------------------------------------------
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 INTEGER NRTM, IRECT(4,*), NOINT, ITAB(*)
62 my_real
63 . x(3,*)
64 INTEGER ID
65 CHARACTER(LEN=NCHARTITLE) :: TITR
66 INTEGER, DIMENSION(MVSIZ), INTENT(OUT) :: IX1,IX2,IX3,IX4
67 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: x1,x2,x3,x4
68 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: y1,y2,y3,y4
69 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: z1,z2,z3,z4
70 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: n1,n2,n3
71 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: x0,y0,z0
72 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: xn1,yn1,zn1
73 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: xn2,yn2,zn2
74 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: xn3,yn3,zn3
75 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: xn4,yn4,zn4
76C-----------------------------------------------
77C L o c a l V a r i a b l e s
78C-----------------------------------------------
79 INTEGER I, J, IDEB
80C REAL
81 my_real :: an
82 my_real, DIMENSION(MVSIZ) :: xx1,yy1,zz1
83 my_real, DIMENSION(MVSIZ) :: xx2,yy2,zz2
84 my_real, DIMENSION(MVSIZ) :: xx3,yy3,zz3
85 my_real, DIMENSION(MVSIZ) :: xx4,yy4,zz4
86C-----------------------------------------------
87C
88 ideb=0
89 DO WHILE(ideb<nrtm)
90C
91 DO i=1,min(mvsiz,nrtm-ideb)
92 j=ideb+i
93 ix1(i)=irect(1,j)
94 ix2(i)=irect(2,j)
95 ix3(i)=irect(3,j)
96 ix4(i)=irect(4,j)
97 x1(i) =x(1,ix1(i))
98 y1(i) =x(2,ix1(i))
99 z1(i) =x(3,ix1(i))
100 x2(i) =x(1,ix2(i))
101 y2(i) =x(2,ix2(i))
102 z2(i) =x(3,ix2(i))
103 x3(i) =x(1,ix3(i))
104 y3(i) =x(2,ix3(i))
105 z3(i) =x(3,ix3(i))
106 x4(i) =x(1,ix4(i))
107 y4(i) =x(2,ix4(i))
108 z4(i) =x(3,ix4(i))
109 ENDDO
110C
111 DO i=1,min(mvsiz,nrtm-ideb)
112 x0(i) = fourth*(x1(i)+x2(i)+x3(i)+x4(i))
113 y0(i) = fourth*(y1(i)+y2(i)+y3(i)+y4(i))
114 z0(i) = fourth*(z1(i)+z2(i)+z3(i)+z4(i))
115C
116 xx1(i) = x1(i)-x0(i)
117 xx2(i) = x2(i)-x0(i)
118 xx3(i) = x3(i)-x0(i)
119 xx4(i) = x4(i)-x0(i)
120 yy1(i) = y1(i)-y0(i)
121 yy2(i) = y2(i)-y0(i)
122 yy3(i) = y3(i)-y0(i)
123 yy4(i) = y4(i)-y0(i)
124 zz1(i) = z1(i)-z0(i)
125 zz2(i) = z2(i)-z0(i)
126 zz3(i) = z3(i)-z0(i)
127 zz4(i) = z4(i)-z0(i)
128 ENDDO
129C
130 DO i=1,min(mvsiz,nrtm-ideb)
131 xn1(i) = yy1(i)*zz2(i) - yy2(i)*zz1(i)
132 yn1(i) = zz1(i)*xx2(i) - zz2(i)*xx1(i)
133 zn1(i) = xx1(i)*yy2(i) - xx2(i)*yy1(i)
134 n1(i)=xn1(i)
135 n2(i)=yn1(i)
136 n3(i)=zn1(i)
137 ENDDO
138C
139 DO i=1,min(mvsiz,nrtm-ideb)
140 xn2(i) = yy2(i)*zz3(i) - yy3(i)*zz2(i)
141 yn2(i) = zz2(i)*xx3(i) - zz3(i)*xx2(i)
142 zn2(i) = xx2(i)*yy3(i) - xx3(i)*yy2(i)
143 n1(i)=n1(i)+xn2(i)
144 n2(i)=n2(i)+yn2(i)
145 n3(i)=n3(i)+zn2(i)
146 ENDDO
147C
148 DO i=1,min(mvsiz,nrtm-ideb)
149 IF(ix3(i)/=ix4(i)) THEN
150 xn3(i) = yy3(i)*zz4(i) - yy4(i)*zz3(i)
151 yn3(i) = zz3(i)*xx4(i) - zz4(i)*xx3(i)
152 zn3(i) = xx3(i)*yy4(i) - xx4(i)*yy3(i)
153 n1(i)=n1(i)+xn3(i)
154 n2(i)=n2(i)+yn3(i)
155 n3(i)=n3(i)+zn3(i)
156 ELSE
157 xn3(i)=zero
158 yn3(i)=zero
159 zn3(i)=zero
160 ENDIF
161 ENDDO
162C
163 DO i=1,min(mvsiz,nrtm-ideb)
164 xn4(i) = yy4(i)*zz1(i) - yy1(i)*zz4(i)
165 yn4(i) = zz4(i)*xx1(i) - zz1(i)*xx4(i)
166 zn4(i) = xx4(i)*yy1(i) - xx1(i)*yy4(i)
167 n1(i)=n1(i)+xn4(i)
168 n2(i)=n2(i)+yn4(i)
169 n3(i)=n3(i)+zn4(i)
170 ENDDO
171C
172 DO i=1,min(mvsiz,nrtm-ideb)
173 an= max(em20,sqrt(n1(i)*n1(i)+n2(i)*n2(i)+n3(i)*n3(i)))
174 n1(i)=n1(i)/an
175 n2(i)=n2(i)/an
176 n3(i)=n3(i)/an
177 ENDDO
178C
179 DO i=1,min(mvsiz,nrtm-ideb)
180 x0(i)=(n1(i)*xn1(i)+n2(i)*yn1(i)+n3(i)*zn1(i))
181 z0(i)=(n1(i)*xn3(i)+n2(i)*yn3(i)+n3(i)*zn3(i))
182C
183 IF(z0(i)==zero.AND.x0(i)==zero)THEN
184 CALL ancmsg(msgid=558,
185 . msgtype=msgerror,
186 . anmode=aninfo_blind_1,
187 . i1=id,
188 . c1=titr,
189 . i2=itab(ix1(i)),
190 . i3=itab(ix2(i)),
191 . i4=itab(ix3(i)),
192 . i5=itab(ix4(i)))
193 ENDIF
194 ENDDO
195C
196 ideb=ideb+min(mvsiz,nrtm-ideb)
197 ENDDO
198C
199 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
ancmsg
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)
Definition message.F:889