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

Go to the source code of this file.

Functions/Subroutines

subroutine cderi3 (jft, jlt, smstr, offg, sti, stir, area, px1, px2, py1, py2, x2, x3, x4, y2, y3, y4, z2, x1g, x2g, x3g, x4g, y1g, y2g, y3g, y4g, z1g, z2g, z3g, z4g, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, vhx, vhy, a_i, ux1, ux2, ux3, ux4, uy1, uy2, uy3, uy4, nel, ismstr)

Function/Subroutine Documentation

◆ cderi3()

subroutine cderi3 ( integer jft,
integer jlt,
double precision, dimension(*) smstr,
offg,
sti,
stir,
area,
px1,
px2,
py1,
py2,
x2,
x3,
x4,
y2,
y3,
y4,
z2,
x1g,
x2g,
x3g,
x4g,
y1g,
y2g,
y3g,
y4g,
z1g,
z2g,
z3g,
z4g,
e1x,
e1y,
e1z,
e2x,
e2y,
e2z,
e3x,
e3y,
e3z,
vhx,
vhy,
a_i,
ux1,
ux2,
ux3,
ux4,
uy1,
uy2,
uy3,
uy4,
integer nel,
integer, intent(in) ismstr )

Definition at line 29 of file cderi3.F.

43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C G l o b a l P a r a m e t e r s
49C-----------------------------------------------
50#include "mvsiz_p.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
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(*)
73C-----------------------------------------------
74C C o m m o n B l o c k s
75C-----------------------------------------------
76C-----------------------------------------------
77C L o c a l V a r i a b l e s
78C-----------------------------------------------
79 INTEGER I,II(6),J
80C REAL
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
88C-----------------------------------------------
89 DO i=1,6
90 ii(i) = nel*(i-1)
91 ENDDO
92C
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)
105C
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
114C
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
174C
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
181C
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
186C
187C CALCUL POUR VECTEURS HOURGLASS
188C
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
193C-----------
194 RETURN
#define my_real
Definition cppsort.cpp:32
subroutine area(d1, x, x2, y, y2, eint, stif0)
#define max(a, b)
Definition macros.h:21