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

Go to the source code of this file.

Functions/Subroutines

subroutine sfor_n2s3 (xi, yi, zi, forc_n, x1, y1, z1, for_t1, x2, y2, z2, for_t2, x3, y3, z3, for_t3, stif, ifc1, ifctl, penmin, penref, fktmax, ll, fqmax, vx1, vx2, vx3, vxi, vy1, vy2, vy3, vyi, vz1, vz2, vz3, vzi, nel, e_distor, dt1)

Function/Subroutine Documentation

◆ sfor_n2s3()

subroutine sfor_n2s3 ( intent(in) xi,
intent(in) yi,
intent(in) zi,
intent(inout) forc_n,
intent(in) x1,
intent(in) y1,
intent(in) z1,
intent(inout) for_t1,
intent(in) x2,
intent(in) y2,
intent(in) z2,
intent(inout) for_t2,
intent(in) x3,
intent(in) y3,
intent(in) z3,
intent(inout) for_t3,
intent(in) stif,
integer, dimension(mvsiz), intent(in) ifc1,
integer, intent(out) ifctl,
intent(in) penmin,
intent(in) penref,
intent(inout) fktmax,
intent(in) ll,
intent(in) fqmax,
intent(in) vx1,
intent(in) vx2,
intent(in) vx3,
intent(in) vxi,
intent(in) vy1,
intent(in) vy2,
intent(in) vy3,
intent(in) vyi,
intent(in) vz1,
intent(in) vz2,
intent(in) vz3,
intent(in) vzi,
integer, intent(in) nel,
intent(inout) e_distor,
intent(in) dt1 )

Definition at line 30 of file sfor_n2s3.F.

40C-----------------------------------------------
41C I m p l i c i t T y p e s
42C-----------------------------------------------
43#include "implicit_f.inc"
44C-----------------------------------------------
45C G l o b a l P a r a m e t e r s
46C-----------------------------------------------
47#include "mvsiz_p.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER, INTENT (IN) :: NEL
52 INTEGER, INTENT (OUT) :: IFCTL
53 INTEGER, DIMENSION(MVSIZ), INTENT (IN) :: IFC1
54 my_real, DIMENSION(MVSIZ), INTENT (IN) :: x1, x2, x3,
55 . y1, y2, y3,
56 . z1, z2, z3,
57 . xi, yi, zi,
58 . vx1, vx2, vx3, vxi ,
59 . vy1, vy2, vy3, vyi ,
60 . vz1, vz2, vz3, vzi
61 my_real, INTENT (IN) :: fqmax,dt1
62 my_real, DIMENSION(MVSIZ), INTENT (INOUT) :: fktmax
63 my_real, DIMENSION(MVSIZ), INTENT (IN) :: stif,ll,penmin, penref
64 my_real, DIMENSION(MVSIZ,3), INTENT (INOUT) :: forc_n, for_t1, for_t2, for_t3
65 my_real, DIMENSION(NEL), INTENT (INOUT) :: e_distor
66C-----------------------------------------------
67C C o m m o n B l o c k s
68C-----------------------------------------------
69C
70C-----------------------------------------------
71C L o c a l V a r i a b l e s
72C-----------------------------------------------
73 INTEGER I,J,IFCTL1,ie
74C 12
75 my_real nx(mvsiz),ny(mvsiz),nz(mvsiz),fn(mvsiz),
76 . xsc(mvsiz),ysc(mvsiz),zsc(mvsiz),pene(mvsiz),
77 . xa(mvsiz),ya(mvsiz),za(mvsiz),area(mvsiz),
78 . xb(mvsiz),yb(mvsiz),zb(mvsiz),
79 . xc(mvsiz),yc(mvsiz),zc(mvsiz),
80 . la(mvsiz),lb(mvsiz),lc(mvsiz),stifkt(mvsiz),
81 . rx, ry, rz, sx, sy, sz,vxc,vyc,vzc,
82 . x42,y42, z42, x31, y31, z31,fx,fy,fz,
83 . sax,say,saz,sbx,sby,sbz,scx,scy,scz,
84 . trx,try,trz,tsx,tsy,tsz,ttx,tty,ttz,
85 . tr2,ts2,tt2,aaa,bbb,vr,vs,vt,nnx,nny,nnz,
86 . xab,xbc,xca,yab,ybc,yca,zab,zbc,zca,
87 . xia, xib, xic, yia, yib, yic,
88 . zia, zib, zic, h0,norm,s2,fac,s2min,lj,
89 . f_q,f_c,kts,zerom,tx,ty,tz,pendr,dx,dy,dz,dn
90C----------------------------
91 ifctl = 0
92 ifctl1 = 0
93C-------diff in velocity as 1er sorting
94 DO i=1,nel
95 IF (ifc1(i)==0) cycle
96 ifctl1=1
97 END DO
98C
99 IF (ifctl1==1) THEN
100 pene(1:nel) =zero
101 zerom = -two*em03
102 DO i=1,nel
103 IF (ifc1(i)==0) cycle
104 rx =x2(i)-x1(i)
105 ry =y2(i)-y1(i)
106 rz =z2(i)-z1(i)
107 sx =x3(i)-x1(i)
108 sy =y3(i)-y1(i)
109 sz =z3(i)-z1(i)
110 nx(i)=ry*sz - rz*sy
111 ny(i)=rz*sx - rx*sz
112 nz(i)=rx*sy - ry*sx
113 area(i) = nx(i)*nx(i)+ny(i)*ny(i)+nz(i)*nz(i)
114 norm=one/max(em20,sqrt(area(i)))
115 nx(i)=nx(i)*norm
116 ny(i)=ny(i)*norm
117 nz(i)=nz(i)*norm
118 bbb = (x3(i)-xi(i))*nx(i) +
119 . (y3(i)-yi(i))*ny(i) +
120 . (z3(i)-zi(i))*nz(i) -penmin(i)
121 pene(i) = max(zero,-bbb)
122 IF (area(i)<penmin(i)*ll(i)) pene(i)=min(pene(i),em01*penmin(i))
123 ENDDO
124! 3 A
125! / \
126! / \
127! / \
128! 1-------2 C
129 DO i=1,nel
130 IF(pene(i) == zero) cycle
131C-------- if other sub-tria ? still using elementary nodal normal
132 xa(i) = x3(i)
133 ya(i) = y3(i)
134 za(i) = z3(i)
135 xb(i) = x1(i)
136 yb(i) = y1(i)
137 zb(i) = z1(i)
138 xc(i) = x2(i)
139 yc(i) = y2(i)
140 zc(i) = z2(i)
141 ENDDO
142 DO i=1,nel
143 IF(pene(i) == zero) cycle
144 xab = xb(i)-xa(i)
145 yab = yb(i)-ya(i)
146 zab = zb(i)-za(i)
147 xbc = xc(i)-xb(i)
148 ybc = yc(i)-yb(i)
149 zbc = zc(i)-zb(i)
150 xca = xa(i)-xc(i)
151 yca = ya(i)-yc(i)
152 zca = za(i)-zc(i)
153
154 xia = xa(i)-xi(i)
155 yia = ya(i)-yi(i)
156 zia = za(i)-zi(i)
157 xib = xb(i)-xi(i)
158 yib = yb(i)-yi(i)
159 zib = zb(i)-zi(i)
160 xic = xc(i)-xi(i)
161 yic = yc(i)-yi(i)
162 zic = zc(i)-zi(i)
163 sx = - yab*zca + zab*yca
164 sy = - zab*xca + xab*zca
165 sz = - xab*yca + yab*xca
166 s2 = sx*sx+sy*sy+sz*sz
167 sax = yib*zic - zib*yic
168 say = zib*xic - xib*zic
169 saz = xib*yic - yib*xic
170 la(i) = (sx*sax+sy*say+sz*saz)/s2
171 sbx = yic*zia - zic*yia
172 sby = zic*xia - xic*zia
173 sbz = xic*yia - yic*xia
174 lb(i) = (sx*sbx+sy*sby+sz*sbz)/s2
175 lc(i) = one - la(i) - lb(i)
176 lj = min(la(i),lb(i),lc(i))
177 IF (lj<zerom) pene(i)=min(pene(i),penmin(i))
178 IF(la(i)<zero)THEN
179 IF(lb(i)<zero)THEN
180 la(i) = zero
181 lb(i) = zero
182 lc(i) = one
183 ELSEIF(lc(i)<zero)THEN
184 lc(i) = zero
185 la(i) = zero
186 lb(i) = one
187 ELSE
188 la(i) = zero
189 aaa = lb(i) + lc(i)
190 lb(i) = lb(i)/aaa
191 lc(i) = lc(i)/aaa
192 ENDIF
193 ELSEIF(lb(i)<zero)THEN
194 IF(lc(i)<zero)THEN
195 lb(i) = zero
196 lc(i) = zero
197 la(i) = one
198 ELSE
199 lb(i) = zero
200 aaa = lc(i) + la(i)
201 lc(i) = lc(i)/aaa
202 la(i) = la(i)/aaa
203 ENDIF
204 ELSEIF(lc(i)<zero)THEN
205 lc(i) = zero
206 aaa = la(i) + lb(i)
207 la(i) = la(i)/aaa
208 lb(i) = lb(i)/aaa
209 ENDIF
210 ENDDO
211 f_q = ep02
212 DO i=1,nel
213 IF(pene(i) == zero) cycle
214 pendr = (pene(i)/penref(i))**2
215 fac = min(fqmax,f_q*pendr)
216 fktmax(i) =max(fktmax(i),(one+three*fac))
217 fn(i) = (fac+one)*stif(i)*pene(i)
218 ENDDO
219 DO i=1,nel
220 IF(pene(i) == zero) cycle
221 dx = vxi(i) - lb(i)*vx1(i) - lc(i)*vx2(i)- la(i)*vx3(i)
222 dy = vyi(i) - lb(i)*vy1(i) - lc(i)*vy2(i)- la(i)*vy3(i)
223 dz = vzi(i) - lb(i)*vz1(i) - lc(i)*vz2(i)- la(i)*vz3(i)
224 dn = (nx(i)*dx + ny(i)*dy + nz(i)*dz)*dt1
225 e_distor(i) = e_distor(i) - fn(i)*dn
226 ENDDO
227 DO i=1,nel
228 IF (pene(i) ==zero) cycle
229 fx = nx(i)*fn(i)
230 fy = ny(i)*fn(i)
231 fz = nz(i)*fn(i)
232 forc_n(i,1) = forc_n(i,1) - fx
233 forc_n(i,2) = forc_n(i,2) - fy
234 forc_n(i,3) = forc_n(i,3) - fz
235 for_t1(i,1) = for_t1(i,1) + fx*lb(i)
236 for_t1(i,2) = for_t1(i,2) + fy*lb(i)
237 for_t1(i,3) = for_t1(i,3) + fz*lb(i)
238 for_t2(i,1) = for_t2(i,1) + fx*lc(i)
239 for_t2(i,2) = for_t2(i,2) + fy*lc(i)
240 for_t2(i,3) = for_t2(i,3) + fz*lc(i)
241 for_t3(i,1) = for_t3(i,1) + fx*la(i)
242 for_t3(i,2) = for_t3(i,2) + fy*la(i)
243 for_t3(i,3) = for_t3(i,3) + fz*la(i)
244 ifctl = 1
245 ENDDO
246 END IF ! (IFCTL1==1) THEN
247c-----------
248 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
norm
norm(diag(diag(diag(inv(mat))) -id.SOL), 2) % destroy mumps instance id.JOB
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21