OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i15ass.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "com04_c.inc"
#include "com06_c.inc"
#include "com08_c.inc"
#include "scr07_c.inc"
#include "scr14_c.inc"
#include "scr16_c.inc"
#include "parit_c.inc"
#include "param_c.inc"
#include "scr18_c.inc"
#include "vectorize.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i15ass (output, af, x, v, ksurf, igrsurf, bufsf, stifn, fs, fcont, fskyi, isky, de, wnf, wtf, wns, fnormx, fnormy, fnormz, ftangx, ftangy, ftangz, nnc, knc, h3d_data)

Function/Subroutine Documentation

◆ i15ass()

subroutine i15ass ( type(output_), intent(inout) output,
af,
x,
v,
integer ksurf,
type (surf_), dimension(nsurf) igrsurf,
bufsf,
stifn,
fs,
fcont,
fskyi,
integer, dimension(*) isky,
de,
wnf,
wtf,
wns,
fnormx,
fnormy,
fnormz,
ftangx,
ftangy,
ftangz,
integer nnc,
integer, dimension(*) knc,
type(h3d_database) h3d_data )

Definition at line 32 of file i15ass.F.

37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE h3d_mod
41 USE groupdef_mod
42 USE output_mod, ONLY : output_
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47#include "comlock.inc"
48C-----------------------------------------------
49C C o m m o n B l o c k s
50C-----------------------------------------------
51#include "com04_c.inc"
52#include "com06_c.inc"
53#include "com08_c.inc"
54#include "scr07_c.inc"
55#include "scr14_c.inc"
56#include "scr16_c.inc"
57#include "parit_c.inc"
58#include "param_c.inc"
59#include "scr18_c.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63 TYPE(OUTPUT_), INTENT(INOUT) :: OUTPUT
64 INTEGER KSURF,ISKY(*),NNC,KNC(*)
65 my_real
66 . af(*) , x(3,*), v(3,*),bufsf(*),
67 . stifn(*), fs(nthvki),
68 . fcont(3,*),fskyi(lskyi,nfskyi), de,
69 . wnf(3,*) ,wtf(3,*) ,wns(*) ,
70 . fnormx,fnormy,fnormz,ftangx,ftangy,ftangz
71 TYPE(H3D_DATABASE) :: H3D_DATA
72 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 INTEGER ADRBUF, I, IN, I3, I2, I1
77 INTEGER NISKYL
78 my_real
79 . rot(9), xk , yk, zk, fx, fy, fz, am1, am2, am3,
80 . fn1, fn2, fn3, ft1, ft2, ft3,
81 . stf, dd
82C-----------------------------------------------
83 adrbuf=igrsurf(ksurf)%IAD_BUFR
84 DO i=1,9
85 rot(i)=bufsf(adrbuf+7+i-1)
86 END DO
87C---------------------------------
88C outputs in the global coordinate system
89C---------------------------------
90 fn1=rot(1)*fnormx+rot(4)*fnormy+rot(7)*fnormz
91 fn2=rot(2)*fnormx+rot(5)*fnormy+rot(8)*fnormz
92 fn3=rot(3)*fnormx+rot(6)*fnormy+rot(9)*fnormz
93 fs(1)=fs(1)-fn1*dt1
94 fs(2)=fs(2)-fn2*dt1
95 fs(3)=fs(3)-fn3*dt1
96 ft1=rot(1)*ftangx+rot(4)*ftangy+rot(7)*ftangz
97 ft2=rot(2)*ftangx+rot(5)*ftangy+rot(8)*ftangz
98 ft3=rot(3)*ftangx+rot(6)*ftangy+rot(9)*ftangz
99 fs(4)=fs(4)-ft1*dt1
100 fs(5)=fs(5)-ft2*dt1
101 fs(6)=fs(6)-ft3*dt1
102C------------------------------------------------------------
103C RETOUR EN GLOBAL.
104C------------------------------------------------------------
105#include "vectorize.inc"
106 DO i=1,nnc
107 in=knc(i)
108 fx=wnf(1,in)+wtf(1,in)
109 fy=wnf(2,in)+wtf(2,in)
110 fz=wnf(3,in)+wtf(3,in)
111 wnf(1,in)=rot(1)*fx+rot(4)*fy+rot(7)*fz
112 wnf(2,in)=rot(2)*fx+rot(5)*fy+rot(8)*fz
113 wnf(3,in)=rot(3)*fx+rot(6)*fy+rot(9)*fz
114 ENDDO
115C------------------------------------------------------------
116C assembly at the main node of the surface
117C------------------------------------------------------------
118 DO i=1,nnc
119 in=knc(i)
120 xk=x(1,in)-bufsf(adrbuf+16)
121 yk=x(2,in)-bufsf(adrbuf+17)
122 zk=x(3,in)-bufsf(adrbuf+18)
123 fx =wnf(1,in)
124 fy =wnf(2,in)
125 fz =wnf(3,in)
126 am1=yk*fz-zk*fy
127 am2=zk*fx-xk*fz
128 am3=xk*fy-yk*fx
129C-----
130 bufsf(adrbuf+25)=bufsf(adrbuf+25)-fx
131 bufsf(adrbuf+26)=bufsf(adrbuf+26)-fy
132 bufsf(adrbuf+27)=bufsf(adrbuf+27)-fz
133 bufsf(adrbuf+28)=bufsf(adrbuf+28)-am1
134 bufsf(adrbuf+29)=bufsf(adrbuf+29)-am2
135 bufsf(adrbuf+30)=bufsf(adrbuf+30)-am3
136C-----
137 stf=wns(in)
138 bufsf(adrbuf+31)=bufsf(adrbuf+31)+stf
139 dd = xk**2+yk**2+zk**2
140 bufsf(adrbuf+32)=bufsf(adrbuf+32)+dd*stf
141 ENDDO
142C---------------------------------
143C Assembly of forces with second nodes.
144C---------------------------------
145 IF (iparit/=0) THEN
146#include "lockon.inc"
147 niskyl = nisky
148 nisky = nisky+nnc
149#include "lockoff.inc"
150 END IF
151 IF (iparit==0) THEN
152#include "vectorize.inc"
153 DO 300 i=1,nnc
154 in=knc(i)
155 fx=wnf(1,in)
156 fy=wnf(2,in)
157 fz=wnf(3,in)
158 i3=3*in
159 i2=i3-1
160 i1=i2-1
161 af(i1)=af(i1)+fx
162 af(i2)=af(i2)+fy
163 af(i3)=af(i3)+fz
164 stifn(in)=stifn(in)+wns(in)
165 300 CONTINUE
166 ELSE
167 IF(kdtint==0)THEN
168 DO 350 i=1,nnc
169 in=knc(i)
170 fx=wnf(1,in)
171 fy=wnf(2,in)
172 fz=wnf(3,in)
173 niskyl = niskyl + 1
174 fskyi(niskyl,1)=fx
175 fskyi(niskyl,2)=fy
176 fskyi(niskyl,3)=fz
177 fskyi(niskyl,4)=wns(in)
178 isky(niskyl) =in
179 350 CONTINUE
180 ELSE
181 DO i=1,nnc
182 in=knc(i)
183 fx=wnf(1,in)
184 fy=wnf(2,in)
185 fz=wnf(3,in)
186 niskyl = niskyl + 1
187 fskyi(niskyl,1)=fx
188 fskyi(niskyl,2)=fy
189 fskyi(niskyl,3)=fz
190 fskyi(niskyl,4)=wns(in)
191 fskyi(niskyl,5)=zero
192 isky(niskyl) =in
193 ENDDO
194 ENDIF
195 ENDIF
196C------------------------------------------------------------
197C animation (contact forces)
198C------------------------------------------------------------
199 IF(anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT>0.AND.
200 . ((tt>=output%TANIM .AND. tt<=output%TANIM_STOP).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
201 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))THEN
202#include "lockon.inc"
203#include "vectorize.inc"
204 DO 400 i=1,nnc
205 in=knc(i)
206 fcont(1,in) =fcont(1,in) + wnf(1,in)
207 fcont(2,in) =fcont(2,in) + wnf(2,in)
208 fcont(3,in) =fcont(3,in) + wnf(3,in)
209 400 CONTINUE
210#include "lockoff.inc"
211 ENDIF
212C---------------------------------
213C for work of forces on secondary nodes
214C 1ere partie : ici
215C 2eme partie : apres calculation de DT2.
216C---------------------------------
217 DO 450 i=1,nnc
218 in=knc(i)
219 fx=wnf(1,in)
220 fy=wnf(2,in)
221 fz=wnf(3,in)
222 de=de+fx*v(1,in)+fy*v(2,in)+fz*v(3,in)
223 450 CONTINUE
224C---------------------------------
225C Working force at interface (Madymo)
226C---------------------------------
227 fs(7)=fs(7)+de*dt1*half
228 IF (igrsurf(ksurf)%TYPE==100) THEN
229C Madymo Ellipsoids
230!$OMP ATOMIC
231 output%TH%WFEXT=output%TH%WFEXT+de*dt1*half
232 ENDIF
233C----------------------------------
234 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
groupdef_mod
Definition groupdef_mod.F:668
h3d_mod
Definition h3d_mod.F:311