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 32 of file multi_compute_dt.F.

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