OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
multi_compute_dt.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "param_c.inc"
#include "task_c.inc"
#include "mvsiz_p.inc"
#include "scr18_c.inc"
#include "units_c.inc"
#include "com08_c.inc"
#include "comlock.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine multi_compute_dt (dt2t, elbuf_tab, iparg, itask, ixs, ixq, ixtg, pm, ipm, multi_fvm, wgrid, xgrid, neltst, ityptst)

Function/Subroutine Documentation

◆ multi_compute_dt()

subroutine multi_compute_dt ( intent(out) dt2t,
type(elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nparg, *), intent(in) iparg,
integer, intent(in) itask,
integer, dimension(nixs, *), intent(in) ixs,
integer, dimension(nixq, *), intent(in) ixq,
integer, dimension(nixtg, *), intent(in) ixtg,
dimension(npropm, *), intent(in) pm,
integer, dimension(npropmi, *), intent(in) ipm,
type(multi_fvm_struct), intent(inout) multi_fvm,
dimension(*), intent(in) wgrid,
dimension(3, *), intent(in) xgrid,
integer, intent(out) neltst,
integer, intent(out) ityptst )

Definition at line 33 of file multi_compute_dt.F.

36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE initbuf_mod
40 USE elbufdef_mod
41 USE multi_fvm_mod
42 use element_mod , only : nixs,nixq,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 "param_c.inc"
52#include "task_c.inc"
53#include "mvsiz_p.inc"
54#include "scr18_c.inc"
55#include "units_c.inc"
56#include "com08_c.inc"
57#include "comlock.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 my_real, INTENT(OUT) :: dt2t
62 TYPE(ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
63 INTEGER, INTENT(IN) :: IPARG(NPARG, *)
64 INTEGER, INTENT(IN) :: ITASK ! SMP TASK
65 INTEGER, INTENT(IN) :: IXS(NIXS, *), IXQ(NIXQ, *), IXTG(NIXTG, *)
66 INTEGER, INTENT(IN) :: IPM(NPROPMI, *)
67 my_real, INTENT(IN) :: pm(npropm, *)
68 TYPE(MULTI_FVM_STRUCT), INTENT(INOUT) :: MULTI_FVM
69 my_real, INTENT(IN) :: wgrid(*), xgrid(3, *)
70 INTEGER, INTENT(OUT) :: ITYPTST, NELTST
71C-----------------------------------------------
72C L o c a l V a r i a b l e s
73C-----------------------------------------------
74 TYPE(G_BUFEL_), POINTER :: GBUF
75 INTEGER :: NG, NEL, II, JJ, KFACE, I, J, NB_FACE, NFT, ITY
76 INTEGER :: IPLA
77 INTEGER :: NBMAT, IMAT
78 INTEGER :: NODE1, NODE2, NODE3, NODE4,
79 . NODE5, NODE6, NODE7, NODE8
80 my_real :: w1(3), w2(3), w3(3), w4(3),
81 . w5(3), w6(3), w7(3), w8(3)
82 my_real :: x1(3), x2(3), x3(3), x4(3),
83 . x5(3), x6(3), x7(3), x8(3)
84 my_real :: wfac(1:3), surf
85 my_real :: lambdaii, lambdaf, normuii, normujj
86 my_real :: fii(5), fjj(5), normal_vel, normal_vel2, vii(5), vjj(5), vel2
87 my_real :: dtel(mvsiz), nx, ny, nz
88 INTEGER :: ISOLNOD, MATLAW
89 LOGICAL :: l_FOUND_LOWER
90
91C Time step
92 dt2t = zero
93 ityptst = 0
94 neltst = 0
95
96 DO ng = itask + 1, ngroup, nthread
97 matlaw = iparg(1, ng)
98 IF (matlaw == 151) THEN
99 nel = iparg(2, ng)
100 nft = iparg(3, ng)
101 ity = iparg(5, ng)
102 isolnod = iparg(28, ng)
103 gbuf => elbuf_tab(ng)%GBUF
104C DELTAX is to be kept
105 gbuf%DELTAX(1:nel) = zero
106C Number of faces in an element
107 nb_face = 6
108 IF (ity == 2) THEN
109 nb_face = 4
110 ELSEIF (ity == 7) THEN
111 nb_face = 3
112 ENDIF
113
114C Computation flow
115 dtel(1:nel) = zero
116 DO ii = 1, nel
117 i = ii + nft
118C Face KFACE
119 DO kface = 1, nb_face
120 nx = multi_fvm%FACE_DATA%NORMAL(1, kface, i)
121 ny = multi_fvm%FACE_DATA%NORMAL(2, kface, i)
122 nz = multi_fvm%FACE_DATA%NORMAL(3, kface, i)
123 wfac(1:3) = multi_fvm%FACE_DATA%WFAC(1:3, kface, i)
124 surf = multi_fvm%FACE_DATA%SURF(kface, i)
125C Time step
126 normal_vel2 = (multi_fvm%VEL(1, i) - wfac(1)) * nx +
127 . (multi_fvm%VEL(2, i) - wfac(2)) * ny +
128 . (multi_fvm%VEL(3, i) - wfac(3)) * nz
129 dtel(ii) = max(dtel(ii),
130 . surf / gbuf%VOL(ii) * (multi_fvm%SOUND_SPEED(i) + abs(normal_vel2)) / dtfac1(102))
131 gbuf%DELTAX(ii) = max(gbuf%DELTAX(ii), surf / gbuf%VOL(ii))
132 ENDDO !KFACE
133 gbuf%DELTAX(ii) = one / gbuf%DELTAX(ii)
134 ENDDO ! II = 1, NEL
135C----------------------
136C Globalize time step for this group
137C----------------------
138 l_found_lower=.false.
139 DO ii = 1, nel
140 IF(dtel(ii)>zero)gbuf%DT(ii) = one/dtel(ii)
141 IF (dtel(ii) > dt2t) THEN
142 l_found_lower=.true.
143 dt2t = dtel(ii)
144 ityptst = ity
145 IF (multi_fvm%SYM == 0) THEN
146 neltst = ixs(nixs, ii + nft)
147 ELSE
148 IF (ity == 2) THEN
149C QUADS
150 neltst = ixq(nixq, ii + nft)
151 ELSEIF (ity == 7) THEN
152C TRIANGLES
153 neltst = ixtg(nixtg, ii + nft)
154 ENDIF
155 ENDIF
156 ENDIF
157 ENDDO
158
159 !CHECK IF LOWER THAN DTMIN
160 IF(l_found_lower .AND. dt2t/=zero)THEN
161 IF(one/dt2t<dtmin1(102))THEN
162 tstop = tt
163#include "lockon.inc"
164 WRITE(iout,*) ' **ERROR : TIME STEP LESS OR EQUAL DTMIN FOR ALE/EULER CELL',neltst
165 WRITE(istdo,*)' **ERROR : TIME STEP LESS OR EQUAL DTMIN FOR ALE/EULER CELL',neltst
166#include "lockoff.inc"
167 ENDIF
168 ENDIF
169
170 ENDIF
171 ENDDO ! NG = ITASK + 1, NGROUP, NTHREAD
172C----------------------
173C Global time step
174C----------------------
175 IF (dt2t > zero) THEN
176 dt2t = one / dt2t
177 ELSE
178 dt2t = ep30
179 ENDIF
180C----------------------
181C Boundary fluxes
182C----------------------
my_real
#define my_real
Definition cppsort.cpp:32
dtel
subroutine dtel(ssp, pm, geo, pid, mat, rho0, vis, deltax, aire, vol, dtx)
Definition dtel.F:46
max
#define max(a, b)
Definition macros.h:21
initbuf_mod
Definition initbuf.F:160