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 33 of file i15ass.F.

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