OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
outri.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| outri ../starter/source/materials/time_step/outri.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!|| message_mod ../starter/share/message_module/message_mod.F
30!||====================================================================
31 SUBROUTINE outri(DTELEM,IXS ,IXQ ,IXC ,IXT ,
32 . IXP ,IXR ,IXTG ,KXX ,
33 . KXSP ,KXIG3D,IGEO ,NUMEL)
34C
35C TRI DES DTEL (POUR CHAQUE TYPE D'ELEMENT) ET IMPRESSIONS
36C
37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE my_alloc_mod
41 USE message_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 "sphcom.inc"
52#include "scr23_c.inc"
53#include "param_c.inc"
54#include "units_c.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER IXS(NIXS,*), IXQ(NIXQ,*), IXC(NIXC,*), IXT(NIXT,*)
59 INTEGER IXP(NIXP,*), IXR(NIXR,*), IXTG(NIXTG,*)
60 INTEGER KXX(NIXX,*), KXSP(NISP,*) ,KXIG3D(NIXIG3D,*),
61 . igeo(npropgi,*)
62 my_real
63 . dtelem(2*numel)
64 INTEGER,INTENT(IN) :: NUMEL
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68 INTEGER NUM2, I, NUMIMP, NUMELO, NUM1, IS_PROP45
69 REAL*4 VINGTR4, TEMPO
70 INTEGER :: IERROR
71 INTEGER, DIMENSION(:), ALLOCATABLE :: PERM
72 DATA vingtr4 /20./
73C=======================================================================␓
74C INITIALISATION DES NOS INTERNES DES ELEMENTS AVANT TRI
75C
76 CALL my_alloc(perm,numel)
77 ! --------------------
78 ! solid and quad
79 num2 = 0
80 DO i=1,numels+numelq
81 perm(num2+i)=i
82 ENDDO
83 ! --------------------
84 ! shell
85 num2=numels+numelq
86 DO i=1,numelc
87 perm(num2+i)=i
88 ENDDO
89 ! --------------------
90 ! truss
91 num2=num2+numelc
92 DO i=1,numelt
93 perm(num2+i)=i
94 ENDDO
95 ! --------------------
96 ! beam
97 num2=num2+numelt
98 DO i=1,numelp
99 perm(num2+i)=i
100 ENDDO
101 ! --------------------
102 ! spring
103 num2=num2+numelp
104 DO i=1,numelr
105 perm(num2+i)=i
106 ENDDO
107 ! --------------------
108 ! triangle
109 num2=num2+numelr
110 DO i=1,numeltg
111 perm(num2+i)=i
112 ENDDO
113 ! --------------------
114 ! the X element :)
115 num2=num2+numeltg
116 DO i=1,numelx
117 perm(num2+i)=i
118 ENDDO
119 ! --------------------
120 ! sph
121 num2=num2+numelx
122 DO i=1,numsph
123 perm(num2+i)=i
124 ENDDO
125 ! --------------------
126 ! igeo element
127 num2=num2+numsph
128 DO i=1,numelig3d
129 perm(num2+i)=i
130 ENDDO
131 ! --------------------
132C
133C TRIS DES ELEMENTS EN FONCTION DU PAS DE TEMPS
134C
135 IF (numels>1) THEN
136 num2 = 1
137 CALL myqsort(numels,dtelem(num2),perm(num2),ierror)
138 ENDIF
139 IF (numelq>1) THEN
140 num2 = 1
141 CALL myqsort(numelq,dtelem(num2),perm(num2),ierror)
142 ENDIF
143 IF (numelc>1) THEN
144 num2 = numels+1
145 CALL myqsort(numelc,dtelem(num2),perm(num2),ierror)
146 ENDIF
147 IF (numelt>1) THEN
148 num2 = numels+numelc+1
149 CALL myqsort(numelt,dtelem(num2),perm(num2),ierror)
150 ENDIF
151 IF (numelp>1) THEN
152 num2 = numels+numelc+numelt+1
153 CALL myqsort(numelp,dtelem(num2),perm(num2),ierror)
154 ENDIF
155 IF (numelr>1) THEN
156 num2 = numels+numelc+numelt+numelp+1
157 CALL myqsort(numelr,dtelem(num2),perm(num2),ierror)
158 ENDIF
159 IF (numeltg>1) THEN
160 num2=numels+numelc+numelt+numelp+numelr+1
161 CALL myqsort(numeltg,dtelem(num2),perm(num2),ierror)
162 ENDIF
163 IF (numelx>1) THEN
164 num2=numels+numelc+numelt+numelp+numelr+numeltg+1
165 CALL myqsort(numelx,dtelem(num2),perm(num2),ierror)
166 ENDIF
167 IF (numsph>1) THEN
168 num2=numels+numelc+numelt+numelp+numelr+numeltg+numelx+1
169 CALL myqsort(numsph,dtelem(num2),perm(num2),ierror)
170 ENDIF
171 IF (numelig3d>1) THEN
172 num2=numels+numelc+numelt+numelp+numelr+numeltg+numelx+
173 . numsph+1
174 CALL myqsort(numelig3d,dtelem(num2),perm(num2),ierror)
175 ENDIF
176
177 dtelem(numel+1:2*numel) = perm(1:numel)
178
179C
180C IMPRESSIONS PAR GROUPES DES ELEMENTS TRIES
181C
182 IF (numels>0) THEN
183 tempo = numels*twoem2
184 numimp=min0(numels,max1(vingtr4,tempo))
185 WRITE(iout,1000)
186 WRITE(iout,1001)
187 DO i=1,numimp
188 numelo=nint(dtelem(numel+i))
189 WRITE(iout,1002)dtelem(i),ixs(11,numelo)
190 END DO
191 ENDIF
192
193 IF (numelq>0) THEN
194 tempo = numelq*twoem2
195 numimp=min0(numelq,max1(vingtr4,tempo))
196 WRITE(iout,1000)
197 WRITE(iout,1001)
198 DO i=1,numimp
199 numelo=nint(dtelem(numel+i))
200 WRITE(iout,1002)dtelem(i),ixq(7,numelo)
201 END DO
202 ENDIF
203
204 IF(numelc>0) THEN
205 tempo = numelc*twoem2
206 numimp=min0(numelc,max1(vingtr4,tempo))
207 num2=numel+numels
208 WRITE(iout,2000)
209 WRITE(iout,1001)
210c IF(NUMELC>1)THEN
211c CALL ANCHECK(92)
212c END IF
213 DO i=1,numimp
214 numelo=nint(dtelem(num2+i))
215 WRITE(iout,1002)dtelem(numels+i),ixc(7,numelo)
216 END DO
217 ENDIF
218
219 IF(numelt>0) THEN
220 tempo = numelt*twoem2
221 numimp=min0(numelt,max1(vingtr4,tempo))
222 num1=numels+numelq+numelc
223 num2=num1+numel
224 WRITE(iout,3000)
225 WRITE(iout,1001)
226c CALL ANCHECK(94)
227 DO i=1,numimp
228 numelo=nint(dtelem(num2+i))
229 WRITE(iout,1002)dtelem(num1+i),
230 . ixt(5,numelo)
231 END DO
232 ENDIF
233
234 IF(numelp>0) THEN
235 tempo = numelp*twoem2
236 numimp=min0(numelp,max1(vingtr4,tempo))
237 num1=numels+numelc+numelt
238 num2=num1+numel
239 WRITE(iout,4000)
240 WRITE(iout,1001)
241 DO i=1,numimp
242 numelo=nint(dtelem(num2+i))
243 WRITE(iout,1002)dtelem(num1+i),ixp(6,numelo)
244 END DO
245 ENDIF
246
247 is_prop45 = 0
248 IF(numelr>0) THEN
249 tempo = numelr*twoem2
250 numimp=min0(numelr,max1(vingtr4,tempo))
251 num1=numels+numelc+numelt+numelp
252 num2=num1+numel
253 WRITE(iout,5000)
254 WRITE(iout,1001)
255c CALL ANCHECK(95)
256 DO i=1,numimp
257 numelo=nint(dtelem(num2+i))
258 IF( igeo(11,ixr(1,numelo)) == 45) THEN
259 is_prop45 = 1
260 ELSE
261 WRITE(iout,1002)dtelem(num1+i),ixr(6,numelo)
262 ENDIF
263 END DO
264 IF (is_prop45 == 1)
265 . WRITE(iout,5001)
266 ENDIF
267
268 IF(numeltg>0 .AND. n2d == 0) THEN
269 tempo = numeltg*twoem2
270 numimp=min0(numeltg,max1(vingtr4,tempo))
271 num1=numels+numelc+numelt+numelp+numelr
272 num2=num1+numel
273 WRITE(iout,6000)
274 WRITE(iout,1001)
275c CALL ANCHECK(93)
276 DO i=1,numimp
277 numelo=nint(dtelem(num2+i))
278 WRITE(iout,1002)dtelem(num1+i),ixtg(6,numelo)
279 END DO
280 ENDIF
281
282 IF(numeltg>0 .AND. n2d /= 0) THEN
283 tempo = numeltg*twoem2
284 numimp=min0(numeltg,max1(vingtr4,tempo))
285 num1=numels+numelc+numelt+numelp+numelr
286 num2=num1+numel
287 WRITE(iout,10000)
288 WRITE(iout,1001)
289c CALL ANCHECK(93)
290 DO i=1,numimp
291 numelo=nint(dtelem(num2+i))
292 WRITE(iout,1002)dtelem(num1+i),ixtg(6,numelo)
293 END DO
294 ENDIF
295
296 IF(numelx>0) THEN
297 tempo = numelx*twoem2
298 numimp=min0(numelx,max1(vingtr4,tempo))
299 num1=numels+numelc+numelt+numelp+numelr+numeltg
300 num2=num1+numel
301 WRITE(iout,7000)
302 WRITE(iout,1001)
303 DO i=1,numimp
304 numelo=nint(dtelem(num2+i))
305 WRITE(iout,1002)dtelem(num1+i),kxx(5,numelo)
306 END DO
307 ENDIF
308
309 IF(numsph>0) THEN
310 tempo = numsph*twoem2
311 numimp=min0(numsph,max1(vingtr4,tempo))
312 num1=numels+numelc+numelt+numelp+numelr+numeltg+numelx
313 num2=num1+numel
314 WRITE(iout,8000)
315 WRITE(iout,1001)
316 DO i=1,numimp
317 numelo=nint(dtelem(num2+i))
318 WRITE(iout,1002)dtelem(num1+i),kxsp(nisp,numelo)
319 END DO
320 ENDIF
321
322 IF(numelig3d>0) THEN
323 tempo = numelig3d*twoem2
324 numimp=min0(numelig3d,max1(vingtr4,tempo))
325 num1=numels+numelc+numelt+numelp+numelr+numeltg+numelx+
326 . numsph
327 num2=num1+numel
328 WRITE(iout,9000)
329 WRITE(iout,1001)
330 DO i=1,numimp
331 numelo=nint(dtelem(num2+i))
332 WRITE(iout,1002)dtelem(num1+i),kxig3d(5,numelo)
333 END DO
334 ENDIF
335 DEALLOCATE( perm )
336C--------------------------------------------------------
337 1000 FORMAT(//,' SOLID ELEMENTS TIME STEP')
338 1001 FORMAT( ' ------------------------',//,
339 . ' TIME STEP ELEMENT NUMBER')
340 1002 FORMAT(1x,1pg20.13,5x,i10)
341 2000 FORMAT(/,' SHELL ELEMENTS TIME STEP')
342 3000 FORMAT(/,' TRUSS ELEMENTS TIME STEP')
343 4000 FORMAT(/,' BEAM ELEMENTS TIME STEP')
344 5000 FORMAT(/,' SPRING ELEMENTS TIME STEP')
345 5001 FORMAT(/,' Info : spring TYPE45 (KJOINT2) time step is evaluated at the beginning of the engine')
346 6000 FORMAT(/,' TRIANGULAR SHELL ELEMENTS TIME STEP')
34750000 FORMAT(/,' USER RNUR ELEMENTS TIME STEP')
348 7000 FORMAT(/,' MULTI-PURPOSE ELEMENTS TIME STEP')
349 8000 FORMAT(/,' SMOOTH PARTICLES TIME STEP')
350 9000 FORMAT(/,' ISO GEOMETRIC ELEMENTS TIME STEP')
35110000 FORMAT(/,' 2D TRIA ELEMENTS TIME STEP')
352C--------------------------------------------------------
353
354 RETURN
355 END
356C
357!||====================================================================
358!|| outrin ../starter/source/materials/time_step/outri.F
359!||--- called by ------------------------------------------------------
360!|| lectur ../starter/source/starter/lectur.F
361!||--- calls -----------------------------------------------------
362!||--- uses -----------------------------------------------------
363!|| message_mod ../starter/share/message_module/message_mod.F
364!|| r2r_mod ../starter/share/modules1/r2r_mod.F
365!||====================================================================
366 SUBROUTINE outrin(MS,IN,STIFN,STIFR,ITAB,DTNODA)
367C-----------------------------------------------
368C M o d u l e s
369C-----------------------------------------------
370 USE my_alloc_mod
371 USE r2r_mod
372 USE plot_curve_mod
373 USE message_mod
374C-----------------------------------------------
375C TRI DES DT NODAUX ET IMPRESSIONS
376C-----------------------------------------------
377C I m p l i c i t T y p e s
378C-----------------------------------------------
379#include "implicit_f.inc"
380C-----------------------------------------------
381C D u m m y A r g u m e n t s
382C-----------------------------------------------
383 INTEGER ITAB(*)
384 my_real
385 . ms(numnod),in(numnod),stifn(numnod),stifr(numnod),dtnoda
386C-----------------------------------------------
387C C o m m o n B l o c k s
388C-----------------------------------------------
389#include "com01_c.inc"
390#include "com04_c.inc"
391#include "units_c.inc"
392#include "r2r_c.inc"
393C-----------------------------------------------
394C L o c a l V a r i a b l e s
395C-----------------------------------------------
396 INTEGER I,N,IMAX, OLD_NUMB, P80, NB_OF_COLUM, STORAGE, OLD_COMPT, COMPT
397 my_real, DIMENSION(:), ALLOCATABLE :: DT
398 my_real
399 . dtnoda_stat(20),nb_nod_stat(20),chunk, dt_max, dt_min, seuil
400 INTEGER :: IERROR
401 INTEGER, DIMENSION(:), ALLOCATABLE :: PERM
402C=======================================================================
403 CALL my_alloc(perm,numnod)
404 CALL my_alloc(dt,numnod)
405 dtnoda = ep30
406C
407 DO i=1,numnod
408 IF((ms(i)/=zero).AND.(stifn(i)>em20))THEN
409 dt(i)=ms(i)/stifn(i)
410 ELSE
411 dt(i)=ep30 ! -1- free nodes dt=1e30 instead of dt=1416=sqrt(1e6).
412 ! -2- nodal time step from VOID elem (stifn<em20) is dt=EP30 too.
413 ENDIF
414 ENDDO
415
416 IF(iroddl/=0)THEN
417 DO i=1,numnod
418 IF(in(i)/=zero)THEN
419 dt(i)=min(dt(i),in(i)/stifr(i))
420 ENDIF
421 ENDDO
422 ENDIF
423
424 DO i=1,numnod
425 IF(dt(i)/=ep30)dt(i)=sqrt(abs(two*dt(i)))
426 END DO
427C---- Multidomains : Nodal time step is deactivated for split RBODY
428 IF(nsubdom>0) THEN
429 DO i=1,numnod
430 IF(tagno(i+n_part)==3) dt(i) = ep30
431 END DO
432 END IF
433C
434 DO i=1,numnod
435 perm(i)=i
436 ENDDO
437
438 CALL myqsort(numnod,dt,perm,ierror)
439C
440 dtnoda = min(dtnoda,dt(1))
441C
442 IF ( n2d/=1) THEN
443 WRITE(iout,1000)
444 WRITE(iout,1001)
445 n=perm(1)
446c CALL ANCHECK(96)
447 DO i=1,min(numnod0,max(100,numnod0/50))
448 n=perm(i)
449 WRITE(iout,1002)dt(i),itab(n)
450 ENDDO
451C
452C
453C----- Curve of nodal time step distribution
454C
455C Determination of the scale of the graph (max and min)
456C
457 dt_max = ep30
458 DO i=1,numnod
459 IF (dt(numnod-i+1) < 1e7) THEN
460 imax = numnod-i+1
461 dt_max = dt(numnod-i+1)
462 EXIT
463 ENDIF
464 ENDDO
465 p80 = nint(0.8*numnod)
466 dt_max = min(dt_max,dt(p80))
467 dt_min = dt(1)
468C
469 nb_nod_stat(:)=zero
470 dtnoda_stat(:)=zero
471 chunk = (dt_max-dt_min)/18.0
472 compt = 2
473 old_compt = 2
474 old_numb = 1
475 seuil = dt_min + chunk
476C
477C Determination of the columns
478C
479 DO i=1,numnod
480 storage = 0
481 IF (dt(i) > dt_max) EXIT
482 DO WHILE ((dt(i) > seuil).AND.(compt<19))
483 compt = compt+1
484 seuil = seuil + chunk
485 storage = 1
486 ENDDO
487 IF (storage == 1) THEN
488 nb_nod_stat(old_compt) = (100.0*(i-old_numb))/(one*numnod)
489 old_numb = i
490 old_compt = compt
491 ENDIF
492 ENDDO
493C
494 nb_nod_stat(compt) = (100.0*(i-old_numb))/(one*numnod)
495 nb_of_colum = compt+1
496C
497C Determination of time axis - DT(1) and DT(COMPT+1) are used for printout of the scale -
498C dt is divided by dt_scale for agreement with nodal time step prinout
499C
500 dtnoda_stat(1) = dt_min*(one-em10)
501 dtnoda_stat(nb_of_colum) = dt_max*(one+em10)
502 DO i=2,compt
503 dtnoda_stat(i) = (dt_min+chunk*(i-2)+half*chunk)
504 ENDDO
505C
506C----- Visual output of nodal time stemp distribution
507C
508 WRITE(iout,2003)
509 WRITE(iout,2004)
510 CALL plot_curve(dtnoda_stat, nb_nod_stat, nb_of_colum, input_size_x=60, input_size_y=24, input_curve_type = 1,
511 . input_txt_x="NODAL TIME STEP",input_txt_y="% OF NODES")
512 ENDIF
513C
514
515 DEALLOCATE( perm )
516 DEALLOCATE( dt )
517
518C-----------
519 1000 FORMAT(//,' NODAL TIME STEP (estimation)')
520 1001 FORMAT( ' ---------------',//,
521 . ' TIME STEP NODE NUMBER')
522 1002 FORMAT(1x,1pg20.13,5x,i10)
523 2003 FORMAT(//,' NODAL TIME STEP DISTRIBUTION ')
524 2004 FORMAT( ' ----------------------------',//)
525C-----------
526
527 RETURN
528 END
my_real
#define my_real
Definition cppsort.cpp:32
dtnoda
subroutine dtnoda(nodft, nodlt, neltst, ityptst, itab, ms, in, stifn, stifr, dt2t, dmast, dinert, adt, adm, imsch, weight, a, ar, igrnod, nodadt_therm, adi, rbym, arby, arrby, weight_md, mcp, mcp_off, condn, nale, h3d_data)
Definition dtnoda.F:42
plot_curve_mod::plot_curve
Definition plot_curve_mod.F:31
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
myqsort
subroutine myqsort(n, a, perm, error)
Definition myqsort.F:51
message_mod
Definition message_mod.F:1249
plot_curve_mod
Definition plot_curve_mod.F:29
r2r_mod
Definition r2r_mod.F:125
r2r_mod::tagno
integer, dimension(:), allocatable tagno
Definition r2r_mod.F:132
outrin
subroutine outrin(ms, in, stifn, stifr, itab, dtnoda)
Definition outri.F:367
outri
subroutine outri(dtelem, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, kxx, kxsp, kxig3d, igeo, numel)
Definition outri.F:34