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 SORTING OF DTEL (FOR EACH TYPE OF ELEMENT) AND PRINTING
36C
37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE my_alloc_mod
41 USE message_mod
42 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C C o m m o n B l o c k s
49C-----------------------------------------------
50#include "com01_c.inc"
51#include "com04_c.inc"
52#include "sphcom.inc"
53#include "scr23_c.inc"
54#include "param_c.inc"
55#include "units_c.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59 INTEGER IXS(NIXS,*), IXQ(NIXQ,*), IXC(NIXC,*), IXT(NIXT,*)
60 INTEGER IXP(NIXP,*), IXR(NIXR,*), IXTG(NIXTG,*)
61 INTEGER KXX(NIXX,*), KXSP(NISP,*) ,KXIG3D(NIXIG3D,*),
62 . igeo(npropgi,*)
63 my_real
64 . dtelem(2*numel)
65 INTEGER,INTENT(IN) :: NUMEL
66C-----------------------------------------------
67C L o c a l V a r i a b l e s
68C-----------------------------------------------
69 INTEGER NUM2, I, NUMIMP, NUMELO, NUM1, IS_PROP45
70 REAL*4 VINGTR4, TEMPO
71 INTEGER :: IERROR
72 INTEGER, DIMENSION(:), ALLOCATABLE :: PERM
73 DATA vingtr4 /20./
74C=======================================================================␓
75C INITIALIZATION OF INTERNAL NUMBERS OF ELEMENTS BEFORE SORTING
76C
77 CALL my_alloc(perm,numel)
78 ! --------------------
79 ! solid and quad
80 num2 = 0
81 DO i=1,numels+numelq
82 perm(num2+i)=i
83 ENDDO
84 ! --------------------
85 ! shell
86 num2=numels+numelq
87 DO i=1,numelc
88 perm(num2+i)=i
89 ENDDO
90 ! --------------------
91 ! truss
92 num2=num2+numelc
93 DO i=1,numelt
94 perm(num2+i)=i
95 ENDDO
96 ! --------------------
97 ! beam
98 num2=num2+numelt
99 DO i=1,numelp
100 perm(num2+i)=i
101 ENDDO
102 ! --------------------
103 ! spring
104 num2=num2+numelp
105 DO i=1,numelr
106 perm(num2+i)=i
107 ENDDO
108 ! --------------------
109 ! triangle
110 num2=num2+numelr
111 DO i=1,numeltg
112 perm(num2+i)=i
113 ENDDO
114 ! --------------------
115 ! the X element :)
116 num2=num2+numeltg
117 DO i=1,numelx
118 perm(num2+i)=i
119 ENDDO
120 ! --------------------
121 ! sph
122 num2=num2+numelx
123 DO i=1,numsph
124 perm(num2+i)=i
125 ENDDO
126 ! --------------------
127 ! igeo element
128 num2=num2+numsph
129 DO i=1,numelig3d
130 perm(num2+i)=i
131 ENDDO
132 ! --------------------
133C
134C SORTING OF ELEMENTS ACCORDING TO THE TIME STEP
135C
136 IF (numels>1) THEN
137 num2 = 1
138 CALL myqsort(numels,dtelem(num2),perm(num2),ierror)
139 ENDIF
140 IF (numelq>1) THEN
141 num2 = 1
142 CALL myqsort(numelq,dtelem(num2),perm(num2),ierror)
143 ENDIF
144 IF (numelc>1) THEN
145 num2 = numels+1
146 CALL myqsort(numelc,dtelem(num2),perm(num2),ierror)
147 ENDIF
148 IF (numelt>1) THEN
149 num2 = numels+numelc+1
150 CALL myqsort(numelt,dtelem(num2),perm(num2),ierror)
151 ENDIF
152 IF (numelp>1) THEN
153 num2 = numels+numelc+numelt+1
154 CALL myqsort(numelp,dtelem(num2),perm(num2),ierror)
155 ENDIF
156 IF (numelr>1) THEN
157 num2 = numels+numelc+numelt+numelp+1
158 CALL myqsort(numelr,dtelem(num2),perm(num2),ierror)
159 ENDIF
160 IF (numeltg>1) THEN
161 num2=numels+numelc+numelt+numelp+numelr+1
162 CALL myqsort(numeltg,dtelem(num2),perm(num2),ierror)
163 ENDIF
164 IF (numelx>1) THEN
165 num2=numels+numelc+numelt+numelp+numelr+numeltg+1
166 CALL myqsort(numelx,dtelem(num2),perm(num2),ierror)
167 ENDIF
168 IF (numsph>1) THEN
169 num2=numels+numelc+numelt+numelp+numelr+numeltg+numelx+1
170 CALL myqsort(numsph,dtelem(num2),perm(num2),ierror)
171 ENDIF
172 IF (numelig3d>1) THEN
173 num2=numels+numelc+numelt+numelp+numelr+numeltg+numelx+
174 . numsph+1
175 CALL myqsort(numelig3d,dtelem(num2),perm(num2),ierror)
176 ENDIF
177
178 dtelem(numel+1:2*numel) = perm(1:numel)
179
180C
181C PRINTING IN GROUPS OF SORTED ELEMENTS
182C
183 IF (numels>0) THEN
184 tempo = numels*twoem2
185 numimp=min0(numels,max1(vingtr4,tempo))
186 WRITE(iout,1000)
187 WRITE(iout,1001)
188 DO i=1,numimp
189 numelo=nint(dtelem(numel+i))
190 WRITE(iout,1002)dtelem(i),ixs(11,numelo)
191 END DO
192 ENDIF
193
194 IF (numelq>0) THEN
195 tempo = numelq*twoem2
196 numimp=min0(numelq,max1(vingtr4,tempo))
197 WRITE(iout,1000)
198 WRITE(iout,1001)
199 DO i=1,numimp
200 numelo=nint(dtelem(numel+i))
201 WRITE(iout,1002)dtelem(i),ixq(7,numelo)
202 END DO
203 ENDIF
204
205 IF(numelc>0) THEN
206 tempo = numelc*twoem2
207 numimp=min0(numelc,max1(vingtr4,tempo))
208 num2=numel+numels
209 WRITE(iout,2000)
210 WRITE(iout,1001)
211c IF(NUMELC>1)THEN
212c CALL ANCHECK(92)
213c END IF
214 DO i=1,numimp
215 numelo=nint(dtelem(num2+i))
216 WRITE(iout,1002)dtelem(numels+i),ixc(7,numelo)
217 END DO
218 ENDIF
219
220 IF(numelt>0) THEN
221 tempo = numelt*twoem2
222 numimp=min0(numelt,max1(vingtr4,tempo))
223 num1=numels+numelq+numelc
224 num2=num1+numel
225 WRITE(iout,3000)
226 WRITE(iout,1001)
227c CALL ANCHECK(94)
228 DO i=1,numimp
229 numelo=nint(dtelem(num2+i))
230 WRITE(iout,1002)dtelem(num1+i),
231 . ixt(5,numelo)
232 END DO
233 ENDIF
234
235 IF(numelp>0) THEN
236 tempo = numelp*twoem2
237 numimp=min0(numelp,max1(vingtr4,tempo))
238 num1=numels+numelc+numelt
239 num2=num1+numel
240 WRITE(iout,4000)
241 WRITE(iout,1001)
242 DO i=1,numimp
243 numelo=nint(dtelem(num2+i))
244 WRITE(iout,1002)dtelem(num1+i),ixp(6,numelo)
245 END DO
246 ENDIF
247
248 is_prop45 = 0
249 IF(numelr>0) THEN
250 tempo = numelr*twoem2
251 numimp=min0(numelr,max1(vingtr4,tempo))
252 num1=numels+numelc+numelt+numelp
253 num2=num1+numel
254 WRITE(iout,5000)
255 WRITE(iout,1001)
256c CALL ANCHECK(95)
257 DO i=1,numimp
258 numelo=nint(dtelem(num2+i))
259 IF( igeo(11,ixr(1,numelo)) == 45) THEN
260 is_prop45 = 1
261 ELSE
262 WRITE(iout,1002)dtelem(num1+i),ixr(6,numelo)
263 ENDIF
264 END DO
265 IF (is_prop45 == 1)
266 . WRITE(iout,5001)
267 ENDIF
268
269 IF(numeltg>0 .AND. n2d == 0) THEN
270 tempo = numeltg*twoem2
271 numimp=min0(numeltg,max1(vingtr4,tempo))
272 num1=numels+numelc+numelt+numelp+numelr
273 num2=num1+numel
274 WRITE(iout,6000)
275 WRITE(iout,1001)
276c CALL ANCHECK(93)
277 DO i=1,numimp
278 numelo=nint(dtelem(num2+i))
279 WRITE(iout,1002)dtelem(num1+i),ixtg(6,numelo)
280 END DO
281 ENDIF
282
283 IF(numeltg>0 .AND. n2d /= 0) THEN
284 tempo = numeltg*twoem2
285 numimp=min0(numeltg,max1(vingtr4,tempo))
286 num1=numels+numelc+numelt+numelp+numelr
287 num2=num1+numel
288 WRITE(iout,10000)
289 WRITE(iout,1001)
290c CALL ANCHECK(93)
291 DO i=1,numimp
292 numelo=nint(dtelem(num2+i))
293 WRITE(iout,1002)dtelem(num1+i),ixtg(6,numelo)
294 END DO
295 ENDIF
296
297 IF(numelx>0) THEN
298 tempo = numelx*twoem2
299 numimp=min0(numelx,max1(vingtr4,tempo))
300 num1=numels+numelc+numelt+numelp+numelr+numeltg
301 num2=num1+numel
302 WRITE(iout,7000)
303 WRITE(iout,1001)
304 DO i=1,numimp
305 numelo=nint(dtelem(num2+i))
306 WRITE(iout,1002)dtelem(num1+i),kxx(5,numelo)
307 END DO
308 ENDIF
309
310 IF(numsph>0) THEN
311 tempo = numsph*twoem2
312 numimp=min0(numsph,max1(vingtr4,tempo))
313 num1=numels+numelc+numelt+numelp+numelr+numeltg+numelx
314 num2=num1+numel
315 WRITE(iout,8000)
316 WRITE(iout,1001)
317 DO i=1,numimp
318 numelo=nint(dtelem(num2+i))
319 WRITE(iout,1002)dtelem(num1+i),kxsp(nisp,numelo)
320 END DO
321 ENDIF
322
323 IF(numelig3d>0) THEN
324 tempo = numelig3d*twoem2
325 numimp=min0(numelig3d,max1(vingtr4,tempo))
326 num1=numels+numelc+numelt+numelp+numelr+numeltg+numelx+
327 . numsph
328 num2=num1+numel
329 WRITE(iout,9000)
330 WRITE(iout,1001)
331 DO i=1,numimp
332 numelo=nint(dtelem(num2+i))
333 WRITE(iout,1002)dtelem(num1+i),kxig3d(5,numelo)
334 END DO
335 ENDIF
336 DEALLOCATE( perm )
337C--------------------------------------------------------
338 1000 FORMAT(//,' SOLID ELEMENTS TIME STEP')
339 1001 FORMAT( ' ------------------------',//,
340 . ' TIME STEP ELEMENT NUMBER')
341 1002 FORMAT(1x,1pg20.13,5x,i10)
342 2000 FORMAT(/,' SHELL ELEMENTS TIME STEP')
343 3000 FORMAT(/,' TRUSS ELEMENTS TIME STEP')
344 4000 FORMAT(/,' BEAM ELEMENTS TIME STEP')
345 5000 FORMAT(/,' SPRING ELEMENTS TIME STEP')
346 5001 FORMAT(/,' Info : spring TYPE45 (KJOINT2) time step is evaluated at the beginning of the engine')
347 6000 FORMAT(/,' TRIANGULAR SHELL ELEMENTS TIME STEP')
34850000 FORMAT(/,' USER RNUR ELEMENTS TIME STEP')
349 7000 FORMAT(/,' MULTI-PURPOSE ELEMENTS TIME STEP')
350 8000 FORMAT(/,' SMOOTH PARTICLES TIME STEP')
351 9000 FORMAT(/,' ISO GEOMETRIC ELEMENTS TIME STEP')
35210000 FORMAT(/,' 2D TRIA ELEMENTS TIME STEP')
353C--------------------------------------------------------
354
355 RETURN
356 END
357C
358!||====================================================================
359!|| outrin ../starter/source/materials/time_step/outri.F
360!||--- called by ------------------------------------------------------
361!|| lectur ../starter/source/starter/lectur.F
362!||--- calls -----------------------------------------------------
363!||--- uses -----------------------------------------------------
364!|| message_mod ../starter/share/message_module/message_mod.F
365!|| r2r_mod ../starter/share/modules1/r2r_mod.F
366!||====================================================================
367 SUBROUTINE outrin(MS,IN,STIFN,STIFR,ITAB,DTNODA)
368C-----------------------------------------------
369C M o d u l e s
370C-----------------------------------------------
371 USE my_alloc_mod
372 USE r2r_mod
373 USE plot_curve_mod
374 USE message_mod
375C-----------------------------------------------
376C SORTING OF NODAL DT AND PRINTING
377C-----------------------------------------------
378C I m p l i c i t T y p e s
379C-----------------------------------------------
380#include "implicit_f.inc"
381C-----------------------------------------------
382C D u m m y A r g u m e n t s
383C-----------------------------------------------
384 INTEGER ITAB(*)
385 my_real
386 . ms(numnod),in(numnod),stifn(numnod),stifr(numnod),dtnoda
387C-----------------------------------------------
388C C o m m o n B l o c k s
389C-----------------------------------------------
390#include "com01_c.inc"
391#include "com04_c.inc"
392#include "units_c.inc"
393#include "r2r_c.inc"
394C-----------------------------------------------
395C L o c a l V a r i a b l e s
396C-----------------------------------------------
397 INTEGER I,N,IMAX, OLD_NUMB, P80, NB_OF_COLUM, STORAGE, OLD_COMPT, COMPT
398 my_real, DIMENSION(:), ALLOCATABLE :: DT
399 my_real
400 . dtnoda_stat(20),nb_nod_stat(20),chunk, dt_max, dt_min, seuil
401 INTEGER :: IERROR
402 INTEGER, DIMENSION(:), ALLOCATABLE :: PERM
403C=======================================================================
404 CALL my_alloc(perm,numnod)
405 CALL my_alloc(dt,numnod)
406 dtnoda = ep30
407C
408 DO i=1,numnod
409 IF((ms(i)/=zero).AND.(stifn(i)>em20))THEN
410 dt(i)=ms(i)/stifn(i)
411 ELSE
412 dt(i)=ep30 ! -1- free nodes dt=1e30 instead of dt=1416=sqrt(1e6).
413 ! -2- nodal time step from VOID elem (stifn<em20) is dt=EP30 too.
414 ENDIF
415 ENDDO
416
417 IF(iroddl/=0)THEN
418 DO i=1,numnod
419 IF(in(i)/=zero)THEN
420 dt(i)=min(dt(i),in(i)/stifr(i))
421 ENDIF
422 ENDDO
423 ENDIF
424
425 DO i=1,numnod
426 IF(dt(i)/=ep30)dt(i)=sqrt(abs(two*dt(i)))
427 END DO
428C---- Multidomains : Nodal time step is deactivated for split RBODY
429 IF(nsubdom>0) THEN
430 DO i=1,numnod
431 IF(tagno(i+n_part)==3) dt(i) = ep30
432 END DO
433 END IF
434C
435 DO i=1,numnod
436 perm(i)=i
437 ENDDO
438
439 CALL myqsort(numnod,dt,perm,ierror)
440C
441 dtnoda = min(dtnoda,dt(1))
442C
443 IF ( n2d/=1) THEN
444 WRITE(iout,1000)
445 WRITE(iout,1001)
446 n=perm(1)
447c CALL ANCHECK(96)
448 DO i=1,min(numnod0,max(100,numnod0/50))
449 n=perm(i)
450 WRITE(iout,1002)dt(i),itab(n)
451 ENDDO
452C
453C
454C----- Curve of nodal time step distribution
455C
456C Determination of the scale of the graph (max and min)
457C
458 dt_max = ep30
459 DO i=1,numnod
460 IF (dt(numnod-i+1) < 1e7) THEN
461 imax = numnod-i+1
462 dt_max = dt(numnod-i+1)
463 EXIT
464 ENDIF
465 ENDDO
466 p80 = nint(0.8*numnod)
467 dt_max = min(dt_max,dt(p80))
468 dt_min = dt(1)
469C
470 nb_nod_stat(:)=zero
471 dtnoda_stat(:)=zero
472 chunk = (dt_max-dt_min)/18.0
473 compt = 2
474 old_compt = 2
475 old_numb = 1
476 seuil = dt_min + chunk
477C
478C Determination of the columns
479C
480 DO i=1,numnod
481 storage = 0
482 IF (dt(i) > dt_max) EXIT
483 DO WHILE ((dt(i) > seuil).AND.(compt<19))
484 compt = compt+1
485 seuil = seuil + chunk
486 storage = 1
487 ENDDO
488 IF (storage == 1) THEN
489 nb_nod_stat(old_compt) = (100.0*(i-old_numb))/(one*numnod)
490 old_numb = i
491 old_compt = compt
492 ENDIF
493 ENDDO
494C
495 nb_nod_stat(compt) = (100.0*(i-old_numb))/(one*numnod)
496 nb_of_colum = compt+1
497C
498C Determination of time axis - DT(1) and DT(COMPT+1) are used for printout of the scale -
499C dt is divided by dt_scale for agreement with nodal time step prinout
500C
501 dtnoda_stat(1) = dt_min*(one-em10)
502 dtnoda_stat(nb_of_colum) = dt_max*(one+em10)
503 DO i=2,compt
504 dtnoda_stat(i) = (dt_min+chunk*(i-2)+half*chunk)
505 ENDDO
506C
507C----- Visual output of nodal time stemp distribution
508C
509 WRITE(iout,2003)
510 WRITE(iout,2004)
511 CALL plot_curve(dtnoda_stat, nb_nod_stat, nb_of_colum, input_size_x=60, input_size_y=24, input_curve_type = 1,
512 . input_txt_x="NODAL TIME STEP",input_txt_y="% OF NODES")
513 ENDIF
514C
515
516 DEALLOCATE( perm )
517 DEALLOCATE( dt )
518
519C-----------
520 1000 FORMAT(//,' NODAL TIME STEP (estimation)')
521 1001 FORMAT( ' ---------------',//,
522 . ' TIME STEP NODE NUMBER')
523 1002 FORMAT(1x,1pg20.13,5x,i10)
524 2003 FORMAT(//,' NODAL TIME STEP DISTRIBUTION ')
525 2004 FORMAT( ' ----------------------------',//)
526C-----------
527
528 RETURN
529 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:1257
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:368
outri
subroutine outri(dtelem, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, kxx, kxsp, kxig3d, igeo, numel)
Definition outri.F:34