OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sms_auto_dt.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "scr17_c.inc"
#include "sphcom.inc"
#include "units_c.inc"
#include "sms_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine sms_auto_dt (dtelem, nativ_sms, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ixs10, ixs16, ixs20, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, ipartg, ipartx, ipart, iparg, elbuf_tab, igeo, iddlevel, tagprt_sms)
subroutine nod_sms_dt (numnod, tagel_sms, nel, nft, nix, mix, lix_input, ix, tagn_sms, dtelem, ity, dt_index, ipart, compt, compt_part, compt_tot_part, igeo, ipartg, tagprt_sms)
subroutine nod_sms_dt_sol (numnod, tagel_sms, nel, nft, nix, offset, ixs, tagn_sms)

Function/Subroutine Documentation

◆ nod_sms_dt()

subroutine nod_sms_dt ( integer numnod,
integer, dimension(*) tagel_sms,
integer nel,
integer nft,
integer nix,
integer mix,
integer lix_input,
integer, dimension(nix,*) ix,
integer, dimension(*) tagn_sms,
dtelem,
integer ity,
integer dt_index,
integer, dimension(*) ipart,
integer compt,
integer, dimension(*) compt_part,
integer, dimension(*) compt_tot_part,
integer, dimension(npropgi,*) igeo,
integer, dimension(lipart1,*) ipartg,
integer, dimension(*) tagprt_sms )

Definition at line 288 of file sms_auto_dt.F.

292C-----------------------------------------------
293C I m p l i c i t T y p e s
294C-----------------------------------------------
295#include "implicit_f.inc"
296#include "sms_c.inc"
297#include "scr17_c.inc"
298#include "param_c.inc"
299C-----------------------------------------------
300C D u m m y A r g u m e n t s
301C-----------------------------------------------
302 INTEGER NUMNOD , NIX ,MIX, LIX_INPUT,
303 . IX(NIX,*), TAGN_SMS(*),NEL,
304 . IPART(*),COMPT_PART(*),COMPT_TOT_PART(*),COMPT,ID_PART,
305 . TAGEL_SMS(*),NFT,ITY,DT_INDEX,IGEO(NPROPGI,*),IPARTG(LIPART1,*),TAGPRT_SMS(*)
306 my_real
307 . dtelem(*)
308C-----------------------------------------------
309C L o c a l V a r i a b l e s
310C-----------------------------------------------
311 INTEGER I, J, K, TAG(NUMNOD), ID_ELT, IGTYP, IGG, LIX
312C-----------------------------------------------
313C S o u r c e L i n e s
314C-----------------------------------------------
315C
316 DO j=1,nel
317 id_elt = nft + j
318 id_part = ipart(id_elt)
319 igg = ipartg(2,id_part)
320 igtyp = igeo(11,igg)
321 IF (tagprt_sms(id_part)==0) compt_tot_part(id_part) = compt_tot_part(id_part) + 1
322C
323 IF(dtelem(dt_index+id_elt)>dt_sms_switch) cycle
324C
325C--- Third node must be taken into account for spring pulley
326 lix = lix_input
327 IF ((ity==6).AND.(igtyp==12)) lix = 3
328C
329 DO k=1,lix
330 i = ix(mix+k,id_elt)
331 IF(i/=0) tag(i)=0
332 ENDDO
333 DO k=1,lix
334 i = ix(mix+k,id_elt)
335 IF(i/=0)THEN
336 IF(tag(i)==0)THEN
337 tagn_sms(i)=1
338 tag(i)=1
339 END IF
340 END IF
341 ENDDO
342 IF (tagprt_sms(id_part)==0) THEN
343 compt = compt + 1
344 compt_part(id_part) = compt_part(id_part) + 1
345 ENDIF
346
347C--- Tag per element
348 tagel_sms(j) = 1
349C
350 ENDDO
351C
352 RETURN
my_real
#define my_real
Definition cppsort.cpp:32

◆ nod_sms_dt_sol()

subroutine nod_sms_dt_sol ( integer numnod,
integer, dimension(*) tagel_sms,
integer nel,
integer nft,
integer nix,
integer offset,
integer, dimension(nix,*) ixs,
integer, dimension(*) tagn_sms )

Definition at line 362 of file sms_auto_dt.F.

365C-----------------------------------------------
366C M o d u l e s
367C-----------------------------------------------
368 USE sms_mod
369C-----------------------------------------------
370C I m p l i c i t T y p e s
371C-----------------------------------------------
372#include "implicit_f.inc"
373C-----------------------------------------------
374C D u m m y A r g u m e n t s
375C-----------------------------------------------
376 INTEGER NUMNOD , NIX, OFFSET,
377 . IXS(NIX,*), TAGN_SMS(*),NEL,TAGEL_SMS(*),NFT
378C-----------------------------------------------
379C L o c a l V a r i a b l e s
380C-----------------------------------------------
381 INTEGER I, J, K, TAG(NUMNOD), ID_ELT, ID_ELT_B
382C-----------------------------------------------
383C S o u r c e L i n e s
384C-----------------------------------------------
385C
386 DO j=1,nel
387 id_elt = nft + j
388 id_elt_b = nft + j - offset
389C
390 IF (tagel_sms(j) == 1) THEN
391C
392C-- > Tag of additional nodes for selected solides with more than 8 nodes
393C
394 DO k=1,nix
395 i = ixs(k,id_elt_b)
396 IF(i/=0) tag(i)=0
397 ENDDO
398 DO k=1,nix
399 i = ixs(k,id_elt_b)
400 IF(i/=0)THEN
401 IF(tag(i)==0)THEN
402 tagn_sms(i)=1
403 tag(i)=1
404 END IF
405 END IF
406 ENDDO
407C
408 ENDIF
409C
410 ENDDO
411C
412 RETURN
sms_mod
Definition sms_mod.F:29

◆ sms_auto_dt()

subroutine sms_auto_dt ( dtelem,
integer, dimension(*) nativ_sms,
integer, dimension(nixs,*) ixs,
integer, dimension(nixq,*) ixq,
integer, dimension(nixc,*) ixc,
integer, dimension(nixt,*) ixt,
integer, dimension(nixp,*) ixp,
integer, dimension(nixr,*) ixr,
integer, dimension(nixtg,*) ixtg,
integer, dimension(6,*) ixs10,
integer, dimension(8,*) ixs16,
integer, dimension(12,*) ixs20,
integer, dimension(*) iparts,
integer, dimension(*) ipartq,
integer, dimension(*) ipartc,
integer, dimension(*) ipartt,
integer, dimension(*) ipartp,
integer, dimension(*) ipartr,
integer, dimension(*) ipartg,
integer, dimension(*) ipartx,
integer, dimension(lipart1,*) ipart,
integer, dimension(nparg,ngroup) iparg,
type(elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(npropgi,*) igeo,
integer iddlevel,
integer, dimension(*) tagprt_sms )

Definition at line 32 of file sms_auto_dt.F.

38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE elbufdef_mod
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C C o m m o n B l o c k s
48C-----------------------------------------------
49#include "com01_c.inc"
50#include "com04_c.inc"
51#include "param_c.inc"
52#include "scr17_c.inc"
53#include "sphcom.inc"
54#include "units_c.inc"
55#include "sms_c.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59 INTEGER NATIV_SMS(*),IPART(LIPART1,*),
60 . IXS(NIXS,*),IXS10(6,*) ,IXS16(8,*) ,IXS20(12,*),
61 . IXQ(NIXQ,*),IXC(NIXC,*), IXT(NIXT,*), IXP(NIXP,*),
62 . IXR(NIXR,*),IXTG(NIXTG,*),IPARTS(*),IPARTQ(*),IPARTC(*),
63 . IPARTT(*),IPARTP(*),IPARTR(*),IPARTG(*),IPARTX(*),
64 . IPARG(NPARG,NGROUP),IGEO(NPROPGI,*),IDDLEVEL, TAGPRT_SMS(*)
65 my_real
66 . dtelem(*)
67C
68 TYPE(ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
69C-----------------------------------------------
70C L o c a l V a r i a b l e s
71C-----------------------------------------------
72 INTEGER I,NEL,IAD,NFT,ITY,ISOL,NG,NUMEL,
73 . COMPT_PART(NPART),COMPT_TOT_PART(NPART),COMPT(7),COMPT_TOT,
74 . NUME(7),DT_INDEX(7)
75 CHARACTER FILNAM*109, KEYA*80, KEYA2*80
76 CHARACTER*12 :: TYPE_ELEM(7)
77 my_real
78 . ratio
79C-----------------------------------------------
80C D e r i v e d T y p e D e f i n i t i o n s
81C-----------------------------------------------
82 TYPE(G_BUFEL_) ,POINTER :: GBUF
83C-----------------------------------------------
84C
85C Selection of elements for AMS based on time step
86C must be launched 2 times (iddlevel = 0/1)
87C because GBUF%ISMS is cleared after the end of first pass
88C
89C-----------------------------------------------
90C
91C-----------------------------------------------
92C Remplissage de ISMS pour les elements selectionnes par PART
93C-----------------------------------------------
94C
95 IF(isms_selec==1 .OR. isms_selec==2 .OR. isms_selec==4)THEN
96
97 DO ng=1,ngroup
98C
99 nel = iparg(2,ng)
100 nft = iparg(3,ng)
101 iad = iparg(4,ng)
102 ity = iparg(5,ng)
103 isol = iparg(28,ng)
104 gbuf => elbuf_tab(ng)%GBUF
105C
106 IF(ity==1)THEN
107 DO i=1,nel
108 IF(tagprt_sms(iparts(nft+i))/=0) gbuf%ISMS(i)=1
109 END DO
110 ELSEIF(ity==3)THEN
111 DO i=1,nel
112 IF(tagprt_sms(ipartc(nft+i))/=0) gbuf%ISMS(i)=1
113 END DO
114 ELSEIF(ity==7)THEN
115 DO i=1,nel
116 IF(tagprt_sms(ipartg(nft+i))/=0) gbuf%ISMS(i)=1
117 END DO
118 ELSEIF(ity==4)THEN
119 DO i=1,nel
120 IF(tagprt_sms(ipartt(nft+i))/=0) gbuf%ISMS(i)=1
121 END DO
122 ELSEIF(ity==5)THEN
123 DO i=1,nel
124 IF(tagprt_sms(ipartp(nft+i))/=0) gbuf%ISMS(i)=1
125 END DO
126 ELSEIF(ity==6)THEN
127 DO i=1,nel
128 IF(tagprt_sms(ipartr(nft+i))/=0) gbuf%ISMS(i)=1
129 END DO
130 END IF
131 END DO
132C
133 IF(isms_selec==1 .OR. isms_selec==2) RETURN
134C
135 END IF
136C
137C-----------------------------------------------
138C Calcul des index dans dtelem pour chaque type d'element
139C-----------------------------------------------
140C
141 numel= numelc+numels+numelt+numelq+numelp+numelr+numeltg
142 . +numelx+numsph+numelig3d
143C
144 nume(1) = numels
145 nume(2) = numelq
146 nume(3) = numelc
147 nume(4) = numelt
148 nume(5) = numelp
149 nume(6) = numelr
150 nume(7) = numeltg
151 dt_index(1) = 0
152 DO i=2,7
153 dt_index(i) = dt_index(i-1) + nume(i-1)
154 END DO
155C
156 compt(1:7) = 0
157 compt_part(1:npart) = 0
158 compt_tot_part(1:npart) = 0
159C
160 type_elem(1)='SOLID'
161 type_elem(3)='SHELL-4NODES'
162 type_elem(4)='TRUSS'
163 type_elem(5)='BEAM'
164 type_elem(6)='SPRING'
165 type_elem(7)='SHELL-3NODES'
166C
167C--------------------------------------------------
168C Identification des elements a switcher en AMS
169C--------------------------------------------------
170C
171 DO ng=1,ngroup
172C
173 nel = iparg(2,ng)
174 nft = iparg(3,ng)
175 iad = iparg(4,ng)
176 ity = iparg(5,ng)
177 isol = iparg(28,ng)
178 gbuf => elbuf_tab(ng)%GBUF
179C
180 IF (ity == 1) THEN
181C
182 CALL nod_sms_dt(numnod,gbuf%ISMS,nel,nft,nixs ,1 ,8 ,
183 . ixs ,nativ_sms,dtelem,ity,dt_index(ity),
184 . iparts,compt(ity),compt_part,compt_tot_part,igeo,ipart,tagprt_sms)
185C
186C Tag of additional nodes for solides with more than 8 nodes
187C
188 IF (isol==10) CALL nod_sms_dt_sol(numnod,gbuf%ISMS,nel,nft,6 ,numels8,
189 . ixs10 ,nativ_sms)
190 IF (isol==20) CALL nod_sms_dt_sol(numnod,gbuf%ISMS,nel,nft,12,numels8+numels10,
191 . ixs20 ,nativ_sms)
192 IF (isol==16) CALL nod_sms_dt_sol(numnod,gbuf%ISMS,nel,nft,8 ,numels8+numels10+numels20,
193 . ixs16 ,nativ_sms)
194C
195 ELSEIF (ity==3) THEN
196C
197 CALL nod_sms_dt(numnod,gbuf%ISMS,nel,nft,nixc ,1 ,4 ,
198 . ixc ,nativ_sms,dtelem,ity,dt_index(ity),
199 . ipartc,compt(ity),compt_part,compt_tot_part,igeo,ipart,tagprt_sms)
200C
201 ELSEIF (ity==7) THEN
202C
203 CALL nod_sms_dt(numnod,gbuf%ISMS,nel,nft,nixtg,1 ,3 ,
204 . ixtg,nativ_sms,dtelem,ity,dt_index(ity),
205 . ipartg,compt(ity),compt_part,compt_tot_part,igeo,ipart,tagprt_sms)
206C
207 ELSEIF (ity==4) THEN
208C
209 CALL nod_sms_dt(numnod,gbuf%ISMS,nel,nft,nixt ,1 ,2 ,
210 . ixt ,nativ_sms,dtelem,ity,dt_index(ity),
211 . ipartt,compt(ity),compt_part,compt_tot_part,igeo,ipart,tagprt_sms)
212C
213 ELSEIF (ity==5) THEN
214C
215 CALL nod_sms_dt(numnod,gbuf%ISMS,nel,nft,nixp ,1 ,2 ,
216 . ixp ,nativ_sms,dtelem,ity,dt_index(ity),
217 . ipartp,compt(ity),compt_part,compt_tot_part,igeo,ipart,tagprt_sms)
218C
219 ELSEIF (ity==6) THEN
220C
221 CALL nod_sms_dt(numnod,gbuf%ISMS,nel,nft,nixr ,1 ,2 ,
222 . ixr ,nativ_sms,dtelem,ity,dt_index(ity),
223 . ipartr,compt(ity),compt_part,compt_tot_part,igeo,ipart,tagprt_sms)
224C
225 ENDIF
226C
227 ENDDO
228C
229 compt_tot = 0
230 DO i=1,7
231 compt_tot = compt_tot + compt(i)
232 ENDDO
233C
234C------------------------------------------------------------------
235C Printout of selected elements - only at first call of initia
236C------------------------------------------------------------------
237C
238 IF (iddlevel == 0) THEN
239C
240 WRITE(iout,1000)
241 WRITE(iout,1001)
242 IF (compt_tot>0) THEN
243 WRITE(iout,2000) compt_tot
244 ratio = 100*real(compt_tot)/real(max(1,numel))
245 WRITE(iout,2001) ratio
246 WRITE(iout,2010)
247 WRITE(iout,2011)
248 DO i=1,7
249 IF (compt(i)>0) WRITE(iout,'(7X,A12,I10)') type_elem(i),compt(i)
250 END DO
251 WRITE(iout,2020)
252 WRITE(iout,2011)
253 WRITE(iout,2021)
254 DO i=1,npart
255 IF ((compt_part(i)>0).AND.(compt_tot_part(i)>0)) THEN
256 ratio = 100*real(compt_part(i))/real(compt_tot_part(i))
257 WRITE(iout,'(4X,I10,19X,I10,12X,F16.1)') ipart(4,i),compt_part(i),ratio
258 ENDIF
259 ENDDO
260 ELSE
261 WRITE(iout,3000)
262 ENDIF
263C
264 ENDIF
265C
266C-------------------------------------------
267 RETURN
268C
269 1000 FORMAT(//,9x,'AUTOMATIC SELECTION OF ELEMENTS FOR AMS')
270 1001 FORMAT(9x,'---------------------------------------',/)
271
272 2000 FORMAT(3x,'TOTAL NUMBER OF ELEMENTS SELECTED ',i10)
273 2001 FORMAT(3x,'% OF ELEMENTS SELECTED IN THE MODEL',f16.1)
274 2010 FORMAT(/,3x,'REPARTITION OF SELECTED ELEMENTS BY TYPES')
275 2011 FORMAT(3x,'-----------------------------------------')
276 2020 FORMAT(/,3x,'REPARTITION OF SELECTED ELEMENTS BY PARTS')
277 2021 FORMAT(7x,'PART ID',6x,'NB OF ELEMENTS SELECTED',6x,'% OF ELEMENTS SELECTED')
278
279 3000 FORMAT(2x,'NO ELEMENTS SELECTED FOR AMS ACTIVATION')
280
max
#define max(a, b)
Definition macros.h:21
nod_sms_dt
subroutine nod_sms_dt(numnod, tagel_sms, nel, nft, nix, mix, lix_input, ix, tagn_sms, dtelem, ity, dt_index, ipart, compt, compt_part, compt_tot_part, igeo, ipartg, tagprt_sms)
Definition sms_auto_dt.F:292
nod_sms_dt_sol
subroutine nod_sms_dt_sol(numnod, tagel_sms, nel, nft, nix, offset, ixs, tagn_sms)
Definition sms_auto_dt.F:365