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

Go to the source code of this file.

Functions/Subroutines

subroutine i2curvf (ms, in, x, v, vr, a, ar, stifn, stifr, weight, nsv, msr, irtl, irect, crst, mmass, smass, siner, fsav, nsn, nmn, idel2, fncont, h3d_data, fncontp, ftcontp)

Function/Subroutine Documentation

◆ i2curvf()

subroutine i2curvf ( ms,
in,
x,
v,
vr,
a,
ar,
stifn,
stifr,
integer, dimension(*) weight,
integer, dimension(*) nsv,
integer, dimension(*) msr,
integer, dimension(*) irtl,
integer, dimension(4,*) irect,
crst,
mmass,
smass,
siner,
fsav,
integer nsn,
integer nmn,
integer idel2,
fncont,
type (h3d_database) h3d_data,
fncontp,
ftcontp )

Definition at line 35 of file i2curvf.F.

42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE h3d_mod
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50C-----------------------------------------------
51C D u m m y A r g u m e n t s
52C-----------------------------------------------
53 INTEGER NSN,NMN,IDEL2
54 INTEGER IRECT(4,*),NSV(*),MSR(*),IRTL(*),WEIGHT(*)
55C REAL
56 my_real
57 . ms(*),in(*),mmass(*),smass(*),siner(*),x(3,*),v(3,*),
58 . vr(3,*),a(3,*),ar(3,*),stifn(*),stifr(*),fsav(*),
59 . crst(2,*),fncont(3,*),fncontp(3,*),ftcontp(3,*)
60 TYPE (H3D_DATABASE) :: H3D_DATA
61C-----------------------------------------------
62C L o c a l V a r i a b l e s
63C-----------------------------------------------
64 INTEGER I1,I2,I3,I4,II,IS,IM,JJ,L,NIR
65 INTEGER INOD(4)
66 my_real
67 . xms,ins,stfn,stfr,fs(3),moms(3),ls1,ls2,lt1,lt2,
68 . ls,lt,len,s,t,w,xc,yc,zc,dm1,dm2,din1,din2,din3,
69 . sumhrs,sumhrt,sumhprs,sumhprt
70 my_real
71 . fsloc(6),fmloc(4,6),rot(9),roti(9),dm(4),din(4),dstfn(4),
72 . dstfr(4),h(4),hh(4),hrs(4),hrt(4),hps(4),hpt(4),hprs(4),
73 . hprt(4),hxs(4),hxt(4),fx(4),fy(4),fz(4)
74C======================================================================|
75 nir = 4
76C----------------------
77 DO ii=1,nsn
78 is = nsv(ii)
79 IF (is > 0) THEN
80 w = weight(is)
81 l = irtl(ii)
82 DO jj=1,nir
83 inod(jj) = irect(jj,l)
84 ENDDO
85C---
86 CALL i2curv_rep(inod , x ,v ,ls1 ,ls2 ,
87 . lt1 ,lt2 ,rot(1) ,rot(4) ,rot(7) ,
88 . rot(2) ,rot(5) ,rot(8) ,rot(3) ,rot(6) ,
89 . rot(9) )
90 CALL inv3(rot,roti)
91C---
92 s=crst(1,ii)
93 t=crst(2,ii)
94 CALL i2_fform(
95 . nir,s,t,h,hh,hrs,hrt,hps,hpt,hprs,hprt,
96 . hxs,hxt,ls1,ls2,lt1,lt2,ls,lt)
97C
98 sumhrs = abs(hrs(1) +hrs(2) +hrs(3) +hrs(4))
99 sumhrt = abs(hrt(1) +hrt(2) +hrt(3) +hrt(4))
100 sumhprs = abs(hprs(1)+hprs(2)+hprs(3)+hprs(4))
101 sumhprt = abs(hprt(1)+hprt(2)+hprt(3)+hprt(4))
102 i1 = inod(1)
103 i2 = inod(2)
104 i3 = inod(3)
105 i4 = inod(4)
106 xc = x(1,i1)*h(1)+x(1,i2)*h(2)+x(1,i3)*h(3)+x(1,i4)*h(4)
107 yc = x(2,i2)*h(1)+x(2,i2)*h(2)+x(2,i3)*h(3)+x(2,i4)*h(4)
108 zc = x(3,i3)*h(1)+x(3,i2)*h(2)+x(3,i3)*h(3)+x(3,i4)*h(4)
109C
110 fs(1) = a(1,is)*w
111 fs(2) = a(2,is)*w
112 fs(3) = a(3,is)*w
113 moms(1) = ar(1,is)*w
114 moms(2) = ar(2,is)*w
115 moms(3) = ar(3,is)*w
116 xms = ms(is)*w
117 ins = in(is)*w
118 stfn=stifn(is)*w
119 stfr=stifr(is)*w
120C
121C--- secnd forces -> rep local
122C
123 fsloc(1) = rot(1)*fs(1) + rot(4)*fs(2) + rot(7)*fs(3)
124 fsloc(2) = rot(2)*fs(1) + rot(5)*fs(2) + rot(8)*fs(3)
125 fsloc(3) = rot(3)*fs(1) + rot(6)*fs(2) + rot(9)*fs(3)
126 fsloc(4) = rot(1)*moms(1) + rot(4)*moms(2) + rot(7)*moms(3)
127 fsloc(5) = rot(2)*moms(1) + rot(5)*moms(2) + rot(8)*moms(3)
128 fsloc(6) = rot(3)*moms(1) + rot(6)*moms(2) + rot(9)*moms(3)
129C
130C------- transfer secnd forces to main
131 DO jj=1,nir
132 fmloc(jj,1) = h(jj)*fsloc(1)
133 fmloc(jj,2) = h(jj)*fsloc(2)
134 fmloc(jj,3) = hh(jj)*fsloc(3)
135 . + hps(jj)*fsloc(4) + hpt(jj)*fsloc(5)
136 fmloc(jj,4) = hrs(jj)*fsloc(3)
137 . + hprs(jj)*fsloc(4) + hxt(jj)*fsloc(5)
138 fmloc(jj,5) = hrt(jj)*fsloc(3)
139 . + hxs(jj)*fsloc(4) + hprt(jj)*fsloc(5)
140 fmloc(jj,6) = h(jj)*fsloc(6)
141 ENDDO
142C------- transfer secnd mass + inertia + stiffness to main
143 DO jj=1,nir
144 im = inod(jj)
145 len = sqrt((x(1,im)-xc)**2+(x(2,im)-yc)**2+(x(3,im)-zc)**2)
146C
147 dm1 = h(jj) *xms
148 dm2 = hh(jj)*xms
149 IF (len > zero) THEN
150 dm2 = dm2 + hh(jj)*(sumhrs +sumhrt)*xms/len
151 . +(abs(hps(jj))*sumhprs + abs(hpt(jj))*sumhprt)*ins/len
152 ENDIF
153 IF (dm1 > dm2) THEN
154 dm(jj) = dm1
155 dstfn(jj) = h(jj)*stfn
156 ELSEIF (len > zero) THEN
157 dm(jj) = dm2
158 dstfn(jj) = hh(jj)*stfn
159 . + hh(jj)*(sumhrs +sumhrt)*stfn/len
160 . +(abs(hps(jj))*sumhprs + abs(hpt(jj))*sumhprt)*stfr/len
161 ELSE
162 dm(jj) = dm2
163 dstfn(jj) = hh(jj)*stfn
164 ENDIF
165C
166 din1 = abs(hrs(jj))*(sumhrs+sumhrt)*xms
167 . +(abs(hprs(jj))*sumhprs + abs(hxt(jj))*sumhprt)*ins
168 . + abs(hrs(jj))*xms*len
169 din2 = abs(hrt(jj))*(sumhrs+sumhrt)*xms
170 . +(abs(hprt(jj))*sumhprt + abs(hxs(jj))*sumhprs)*ins
171 . + abs(hrt(jj))*xms*len
172 din3 = h(jj)*ins
173 IF (din1 >= din2 .AND. din1 >= din3) THEN
174 din(jj) = din1
175 dstfr(jj) = abs(hrs(jj))*(sumhrs+sumhrt)*stfn
176 . +(abs(hprs(jj))*sumhprs + abs(hxt(jj))*sumhprt)*stfr
177 . + abs(hrs(jj))*stfn*len
178 ELSEIF (din2 >= din1 .AND. din2 >= din3) THEN
179 din(jj) = din2
180 dstfr(jj) = abs(hrt(jj))*(sumhrs+sumhrt)*stfn
181 . +(abs(hprt(jj))*sumhprt + abs(hxs(jj))*sumhprs)*stfr
182 . + abs(hrt(jj))*stfn*len
183 ELSEIF (din3 >= din1 .AND. din3 >= din2) THEN
184 din(jj) = din3
185 dstfr(jj) = h(jj)*stfr
186 ENDIF
187 ENDDO
188C
189C--- update main forces in global frame
190C
191 DO jj=1,nir
192 im = inod(jj)
193 fx(jj) = roti(1)*fmloc(jj,1)+roti(4)*fmloc(jj,2)+roti(7)*fmloc(jj,3)
194 fy(jj) = roti(2)*fmloc(jj,1)+roti(5)*fmloc(jj,2)+roti(8)*fmloc(jj,3)
195 fz(jj) = roti(3)*fmloc(jj,1)+roti(6)*fmloc(jj,2)+roti(9)*fmloc(jj,3)
196 a(1,im) = a(1,im) + fx(jj)
197 a(2,im) = a(2,im) + fy(jj)
198 a(3,im) = a(3,im) + fz(jj)
199 ar(1,im) = ar(1,im) +
200 . roti(1)*fmloc(jj,4)+roti(4)*fmloc(jj,5)+roti(7)*fmloc(jj,6)
201 ar(2,im) = ar(2,im) +
202 . roti(2)*fmloc(jj,4)+roti(5)*fmloc(jj,5)+roti(8)*fmloc(jj,6)
203 ar(3,im) = ar(3,im) +
204 . roti(3)*fmloc(jj,4)+roti(6)*fmloc(jj,5)+roti(9)*fmloc(jj,6)
205 ms(im) = ms(im) + dm(jj)
206 in(im) = in(im) + din(jj)
207 stifn(im) = stifn(im) + dstfn(jj)
208 stifr(im) = stifr(im) + dstfr(jj)
209 ENDDO
210C
211C--- output of tied contact forces
212 CALL i2forces(x ,fs ,fx ,fy ,fz ,
213 . inod(1) ,nir ,fsav ,fncont ,fncontp,
214 . ftcontp ,weight ,h3d_data,is ,h)
215C---
216 IF (idel2/=0.AND.ms(is)/=zero) smass(ii)=ms(is)
217 IF (idel2/=0.AND.ms(is)/=zero) siner(ii)=in(is)
218 stifr(is)=em20
219 stifn(is)=em20
220 in(is) =zero
221 ms(is) =zero
222 a(1,is) =zero
223 a(2,is) =zero
224 a(3,is) =zero
225 ar(1,is) =zero
226 ar(2,is) =zero
227 ar(3,is) =zero
228C---
229 ENDIF
230 ENDDO
231C-----------
232 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
i2_fform
subroutine i2_fform(nir, s, t, h, hh, hrs, hrt, hps, hpt, hprs, hprt, hxs, hxt, ls1, ls2, lt1, lt2, ls, lt)
Definition i2_fform.F:33
i2curv_rep
subroutine i2curv_rep(inod, x, v, ls1, ls2, lt1, lt2, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z)
Definition i2curv_rep.F:35
i2forces
subroutine i2forces(x, fs, fx, fy, fz, irect, nir, fsav, fncont, fncontp, ftcontp, weight, h3d_data, nsl, h)
Definition i2forces.F:52
inv3
subroutine inv3(a, b)
Definition inv3.F:29
h3d_mod
Definition h3d_mod.F:308