OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
r2r_speedup.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/.
23Cbm|====================================================================
24Cbm| CHK_DT_ENGINE src/rad2r/routines_r2r.F
25Cbm|-- called by -----------
26Cbm| R2R_GROUP src/rad2r/r2r_group.F
27Cbm|-- calls ---------------
28Cbm|====================================================================
29!||====================================================================
30!|| r2r_speedup ../starter/source/coupling/rad2rad/r2r_speedup.F
31!||--- called by ------------------------------------------------------
32!|| lectur ../starter/source/starter/lectur.F
33!||--- calls -----------------------------------------------------
34!|| ancmsg ../starter/source/output/message/message.F
35!|| find_dt_engine ../starter/source/coupling/rad2rad/r2r_speedup.f
36!||--- uses -----------------------------------------------------
37!|| message_mod ../starter/share/message_module/message_mod.F
38!|| r2r_mod ../starter/share/modules1/r2r_mod.F
39!||====================================================================
40 SUBROUTINE r2r_speedup(DTELEM,DTNODA,DT_R2R,COST_R2R,ISOLOFF,
41 . ISHEOFF,ITRUOFF ,IPOUOFF ,IRESOFF ,ITRIOFF,
42 . IQUAOFF)
43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE my_alloc_mod
47 USE message_mod
48 USE r2r_mod
49C-----------------------------------------------
50C I m p l i c i t T y p e s
51C-----------------------------------------------
52#include "implicit_f.inc"
53C-----------------------------------------------
54C C o m m o n B l o c k s
55C-----------------------------------------------
56#include "units_c.inc"
57#include "scr15_c.inc"
58#include "sphcom.inc"
59#include "r2r_c.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63 INTEGER ISOLOFF(*),ISHEOFF(*),ITRUOFF(*),IPOUOFF(*),IRESOFF(*),ITRIOFF(*),
64 . IQUAOFF(*)
65 my_real
66 . dtelem(*),dtnoda,dt_r2r(4,*),cost_r2r
67C-----------------------------------------------
68C L o c a l V a r i a b l e s
69C-----------------------------------------------
70 INTEGER :: I,FLG_CHK,FLG_CTL,DOMLEN,FLG_CHK_SUB,FLG_CTL_SUB
71 my_real :: DT,DT_SUB,SPEEDUP,COST_SUB
72 CHARACTER NAM*150
73C-----------------------------------------------
74 CALL find_dt_engine(dtelem,dtnoda,dt,flg_chk,flg_ctl,isoloff,isheoff,itruoff ,ipouoff ,iresoff ,itrioff,iquaoff)
75
76 DO i=1,numsph-nsphres
77 cost_r2r = cost_r2r + 12.0
78 END DO
79
80 IF (iddom /= 0) THEN
81C
82 dt_r2r(1,1) = dt
83 dt_r2r(2,1) = cost_r2r
84 IF (flg_chk>0) dt_r2r(3,1) = one
85 IF (flg_ctl>0) dt_r2r(4,1) = one
86C
87 ELSE
88C
89 WRITE(iout,1000)
90 WRITE(iout,1001)
91C
92 IF (flg_chk==0) THEN
93 CALL ancmsg(msgid=1095, msgtype=msgwarning, anmode=aninfo_blind_2, c1=rootnam(1:rootlen)//'_0001.rad')
94 ENDIF
95C
96 dt_sub = dt_r2r(1,1)
97 cost_sub = dt_r2r(2,1)
98C
99 IF (flg_swale == 1) THEN
100 dt_sub = dt
101 dt = dt_r2r(1,1)
102 cost_sub = cost_r2r
103 cost_r2r = dt_r2r(2,1)
104 ENDIF
105C
106 flg_chk_sub = 0
107 flg_ctl_sub = 0
108 IF (dt_r2r(3,1)>em20) flg_chk_sub = 1
109 IF (dt_r2r(4,1)>em20) flg_ctl_sub = 1
110 nam=dom_name(isubdom(8,1):isubdom(8,1)+
111 . isubdom(7,1)-1)
112 domlen = isubdom(7,1)
113C
114 IF (flg_chk_sub==0) THEN
115 CALL ancmsg(msgid=1095, msgtype=msgwarning, anmode=aninfo_blind_2, c1=nam(1:domlen)//'_0001.rad')
116 ENDIF
117C
118 speedup = 0.9*((cost_r2r+cost_sub)/((cost_r2r*dt_sub/dt)+cost_sub))
119C
120 WRITE(iout,2000) dt
121 WRITE(iout,2001) nam(1:domlen),dt_sub
122 WRITE(iout,2002) speedup
123C
124 ENDIF
125
126C--------------------------------------------------------
127 1000 FORMAT(//,' MULTIDOMAINS SPEEDUP ESTIMATION')
128 1001 FORMAT( ' ------------------------')
129 2000 FORMAT(/,' ESTIMATED TIME STEP FOR FULLDOMAIN',3x,1pg20.13)
130 2001 FORMAT(' ESTIMATED TIME STEP FOR SUBDOMAIN',1x,a,3x,1pg20.13)
131 2002 FORMAT(/,' ESTIMATED THEORETICAL SPEEDUP',2x,f10.1,//)
132C--------------------------------------------------------
133
134 RETURN
135 END
136
137Cbm|====================================================================
138Cbm| CHK_DT_ENGINE src/rad2r/routines_r2r.F
139Cbm|-- called by -----------
140Cbm| R2R_GROUP src/rad2r/r2r_group.F
141Cbm|-- calls ---------------
142Cbm|====================================================================
143!||====================================================================
144!|| find_dt_engine ../starter/source/coupling/rad2rad/r2r_speedup.F
145!||--- called by ------------------------------------------------------
146!|| r2r_speedup ../starter/source/coupling/rad2rad/r2r_speedup.F
147!||--- calls -----------------------------------------------------
148!||--- uses -----------------------------------------------------
149!|| message_mod ../starter/share/message_module/message_mod.F
150!|| r2r_mod ../starter/share/modules1/r2r_mod.F
151!||====================================================================
152 SUBROUTINE find_dt_engine(DTELEM,DTNODA,DT,FLG_CHK,FLG_CTL,
153 . ISOLOFF,ISHEOFF,ITRUOFF ,IPOUOFF ,IRESOFF ,
154 . ITRIOFF,IQUAOFF)
155C-----------------------------------------------
156C M o d u l e s
157C-----------------------------------------------
158 USE my_alloc_mod
159 USE r2r_mod
160 USE inoutfile_mod
161 USE message_mod
162C-----------------------------------------------
163C I m p l i c i t T y p e s
164C-----------------------------------------------
165#include "implicit_f.inc"
166C-----------------------------------------------
167C C o m m o n B l o c k s
168C-----------------------------------------------
169#include "com04_c.inc"
170#include "com06_c.inc"
171#include "scr15_c.inc"
172#include "sphcom.inc"
173C-----------------------------------------------
174C D u m m y A r g u m e n t s
175C-----------------------------------------------
176 INTEGER FLG_CHK,FLG_CTL,ISOLOFF(*),ISHEOFF(*),ITRUOFF(*),
177 . IPOUOFF(*),IRESOFF(*),ITRIOFF(*),IQUAOFF(*)
178 my_real
179 . DT,DTELEM(*),DTNODA
180C-----------------------------------------------
181C L o c a l V a r i a b l e s
182C-----------------------------------------------
183 INTEGER IO_ERR1,I,DT_INDEX(11),FLAG_TRI(11),NUME(11),NUMEL
184 CHARACTER FILNAM*109, KEYA*80, KEYA2*80
185 my_real
186 . DTSCA,DTMINI,DTINI,DTMAX,DT_MIN_ELEM(11),DTFAC1(11)
187 INTEGER :: LEN_TMP_NAME
188 CHARACTER(len=4096) :: TMP_NAME
189 INTEGER :: IERROR
190 INTEGER, DIMENSION(:), ALLOCATABLE :: PERM
191C-----------------------------------------------
192C
193 flg_chk = 0
194 flg_ctl = 0
195 dtmax = ep30
196 dt_index(:) = 0
197 dt_min_elem(:) = ep30
198 flag_tri(:) = 0
199 dtfac1(:) = dtfac
200 numel= numelc+numels+numelt+numelq+numelp+numelr+numeltg
201 . +numelx+numsph+numelig3d
202 CALL my_alloc( perm,numel+1)
203
204C-----------------------------------------------
205C Computation of index in dtelem for each type of elements
206C-----------------------------------------------
207 nume(1) = numels
208 nume(2) = numelq
209 nume(3) = numelc
210 nume(4) = numelt
211 nume(5) = numelp
212 nume(6) = numelr
213 nume(7) = numeltg
214 nume(8) = 0
215 nume(9) = numelx
216 nume(10) = numsph
217 nume(11) = numelig3d
218 dt_index(1) = 0
219 DO i=2,11
220 dt_index(i) = dt_index(i-1) + nume(i-1)
221 END DO
222
223C-----------------------------------------------
224C Off elements must be taken into account and sorting if necessart
225C-----------------------------------------------
226 DO i = 1, numels
227 IF (isoloff(i)/=0) THEN
228 dtelem(i+dt_index(1)) = ep30
229 flag_tri(1) = 1
230 ENDIF
231 END DO
232C
233 DO i = 1, numelq
234 IF (iquaoff(i)/=0) THEN
235 dtelem(i+dt_index(2)) = ep30
236 flag_tri(2) = 1
237 ENDIF
238 END DO
239C
240 DO i = 1, numelc
241 IF (isheoff(i)/=0) THEN
242 dtelem(i+dt_index(3)) = ep30
243 flag_tri(3) = 1
244 END IF
245 END DO
246C
247 DO i = 1, numelt
248 IF (itruoff(i)/=0) THEN
249 dtelem(i+dt_index(4)) = ep30
250 flag_tri(4) = 1
251 END IF
252 END DO
253C
254 DO i = 1, numelp
255 IF (ipouoff(i)/=0) THEN
256 dtelem(i+dt_index(5)) = ep30
257 flag_tri(5) = 1
258 END IF
259 END DO
260C
261 DO i = 1, numelr
262 IF (iresoff(i)/=0) THEN
263 dtelem(i+dt_index(6)) = ep30
264 flag_tri(6) = 1
265 END IF
266 END DO
267C
268 DO i = 1, numeltg
269 IF (itrioff(i)/=0) THEN
270 dtelem(i+dt_index(7)) = ep30
271 flag_tri(7) = 1
272 END IF
273 END DO
274C
275 DO i=1,11
276 IF (flag_tri(i)==1) THEN
277 CALL myqsort(nume(i),dtelem(1+dt_index(i)),perm(1+dt_index(i)),ierror)
278 dtelem(numel+1+dt_index(i):numel+nume(i)+1+dt_index(i)) = perm(1+dt_index(i):nume(i)+1+dt_index(i))
279 ENDIF
280 END DO
281
282C-----------------------------------------------
283C Computation of min time step for each type of element
284C-----------------------------------------------
285 DO i=1,11
286 dt_min_elem(i) = dtelem(1+dt_index(i))
287 END DO
288
289C-----------------------------------------------
290C Prereading of data in engine input file
291C-----------------------------------------------
292 filnam=rootnam(1:rootlen)//'_0001.rad'
293 tmp_name=infile_name(1:infile_name_len)//filnam(1:len_trim(filnam))
294 len_tmp_name = infile_name_len+len_trim(filnam)
295 OPEN(unit=71,file=tmp_name(1:len_tmp_name),
296 . access='SEQUENTIAL',status='OLD',iostat=io_err1)
297C
298 IF (io_err1/=0) THEN
299 filnam=rootnam(1:rootlen)//'D01'
300 tmp_name=infile_name(1:infile_name_len)//filnam(1:len_trim(filnam))
301 len_tmp_name = infile_name_len+len_trim(filnam)
302 OPEN(unit=71,file=tmp_name(1:len_tmp_name),
303 . access='SEQUENTIAL',status='OLD',iostat=io_err1)
304 ENDIF
305
306 IF (io_err1==0) THEN
307C
308 flg_chk = 1
309 10 READ(71,'(a)',END=20) KEYA
310C--
311 IF (KEYA(1:3)=='/dt') THEN
312 READ(71,'(a)',END=20) KEYA2
313 IF(KEYA2(1:1)/='$.AND.'KEYA2(1:1)/='#') THEN
314 backspace(71)
315 ENDIF
316 ENDIF
317C
318C-- nodal time step--
319 IF(keya(1:8)=='/DT/NODA') THEN
320 READ(71,*,END=20) DTSCA,dtmini
321 dtnoda = dtsca*dtnoda
322 IF(keya(1:12)=='/DT/NODA/CST') THEN
323 flg_ctl = 1
324 dtnoda = max(dtnoda,dtmini)
325 ENDIF
326C-- solid element time step --
327 ELSEIF(keya(1:9)=='/DT/BRICK') THEN
328 READ(71,*,END=20) DTSCA,dtmini
329 dtfac1(1) = dtsca
330 IF (keya(10:13)=='/DEL') THEN
331 DO i = 1,numels
332 IF (dtsca*dtelem(dt_index(1)+i)>dtmini) THEN
333 dt_min_elem(1) = dtelem(dt_index(1)+i)
334 EXIT
335 ENDIF
336 END DO
337 ENDIF
338C-- quad element time step --
339 ELSEIF(keya(1:9)=='/DT/QUAD') THEN
340 READ(71,*,END=20) DTSCA,dtmini
341 dtfac1(2) = dtsca
342 IF (keya(10:13)=='/DEL') THEN
343 DO i = 1,numelq
344 IF (dtsca*dtelem(dt_index(2)+i)>dtmini) THEN
345 dt_min_elem(2) = dtelem(dt_index(2)+i)
346 EXIT
347 ENDIF
348 END DO
349 ENDIF
350C-- shell element time step --
351 ELSEIF(keya(1:9)=='/DT/SHELL') THEN
352 READ(71,*,END=20) DTSCA,dtmini
353 dtfac1(3) = dtsca
354 IF ((keya(10:14)/='/STOP').AND.(keya(10:13)/='/CST')) THEN
355 DO i = 1,numelc
356 IF (dtsca*dtelem(dt_index(3)+i)>dtmini) THEN
357 dt_min_elem(3) = dtelem(dt_index(3)+i)
358 EXIT
359 ENDIF
360 END DO
361 ENDIF
362C-- beam element time step --
363 ELSEIF (keya(1:8)=='/DT/BEAM') THEN
364 READ(71,*,END=20) DTSCA,dtmini
365 dtfac1(4) = dtsca
366 IF (keya(9:12)=='/DEL') THEN
367 DO i = 1,numelt
368 IF (dtsca*dtelem(dt_index(4)+i)>dtmini) THEN
369 dt_min_elem(4) = dtelem(dt_index(4)+i)
370 EXIT
371 ENDIF
372 END DO
373 ENDIF
374C-- truss element time step --
375 ELSEIF (keya(1:9)=='/DT/TRUSS') THEN
376 READ(71,*,END=20) DTSCA,dtmini
377 dtfac1(5) = dtsca
378 IF (keya(10:13)=='/DEL') THEN
379 DO i = 1,numelp
380 IF (dtsca*dtelem(dt_index(5)+i)>dtmini) THEN
381 dt_min_elem(5) = dtelem(dt_index(5)+i)
382 EXIT
383 ENDIF
384 END DO
385 ENDIF
386C-- spring element time step --
387 ELSEIF (keya(1:10)=='/DT/SPRING') THEN
388 READ(71,*,END=20) DTSCA,dtmini
389 dtfac1(6) = dtsca
390 IF (keya(11:14)=='/DEL') THEN
391 DO i = 1,numelr
392 IF (dtsca*dtelem(dt_index(6)+i)>dtmini) THEN
393 dt_min_elem(6) = dtelem(dt_index(6)+i)
394 EXIT
395 ENDIF
396 END DO
397 ENDIF
398C-- sh3n element time step --
399 ELSEIF(keya(1:9)=='/DT/SH_3N') THEN
400 READ(71,*,END=20) DTSCA,dtmini
401 dtfac1(7) = dtsca
402 IF ((keya(10:14)/='/STOP').AND.(keya(10:13)/='/CST')) THEN
403 DO i = 1,numeltg
404 IF (dtsca*dtelem(dt_index(7)+i)>dtmini) THEN
405 dt_min_elem(7) = dtelem(dt_index(7)+i)
406 EXIT
407 ENDIF
408 END DO
409 ENDIF
410C-- sph particle time step --
411 ELSEIF (keya(1:10)=='/DT/SPHCEL') THEN
412 READ(71,*,END=20) DTSCA,dtmini
413 dtfac1(10) = dtsca
414 IF (keya(11:14)=='/DEL') THEN
415 DO i = 1,numsph
416 IF (dtsca*dtelem(dt_index(10)+i)>dtmini) THEN
417 dt_min_elem(10) = dtelem(dt_index(10)+i)
418 EXIT
419 ENDIF
420 END DO
421 ENDIF
422C-- default time step --
423 ELSEIF(keya(1:4)=='/DT ') THEN
424 flg_ctl = 1
425 READ(71,*,END=20) DTSCA,dtmini
426 DO i=1,11
427 dtfac1(i) = dtsca
428 END DO
429C-- max time step--
430 ELSEIF(keya(1:5)=='/DTIX') THEN
431 flg_ctl = 1
432 READ(71,*,END=20) DTINI,dtmax
433 ENDIF
434C
435 GOTO 10
436C
437 20 CONTINUE
438 CLOSE(71)
439C
440 ENDIF
441
442C-----------------------------------------------
443C Prediction of final time step
444C-----------------------------------------------
445 dt = ep30
446 DO i=1,11
447 dt = min(dt,dtfac1(i)*dt_min_elem(i))
448 END DO
449C
450 IF (dtnoda>zero) dt = dtnoda
451C
452 dt = min(dt,dtmax)
453
454 DEALLOCATE( perm )
455
456C-------------------------------------------
457 RETURN
458 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
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
inoutfile_mod
Definition inoutfile_mod.F:96
inoutfile_mod::infile_name_len
integer infile_name_len
Definition inoutfile_mod.F:114
inoutfile_mod::infile_name
character(len=infile_char_len) infile_name
Definition inoutfile_mod.F:116
message_mod
Definition message_mod.F:1249
r2r_mod
Definition r2r_mod.F:125
r2r_mod::isubdom
integer, dimension(:,:), allocatable isubdom
Definition r2r_mod.F:144
find_dt_engine
subroutine find_dt_engine(dtelem, dtnoda, dt, flg_chk, flg_ctl, isoloff, isheoff, itruoff, ipouoff, iresoff, itrioff, iquaoff)
Definition r2r_speedup.F:155
r2r_speedup
subroutine r2r_speedup(dtelem, dtnoda, dt_r2r, cost_r2r, isoloff, isheoff, itruoff, ipouoff, iresoff, itrioff, iquaoff)
Definition r2r_speedup.F:43
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
starter
program starter
Definition starter.F:39