OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
iniebcs_nrf_tcar.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!|| iniebcs_nrf_tcar ../starter/source/boundary_conditions/ebcs/iniebcs_nrf_tcar.F
25!||--- called by ------------------------------------------------------
26!|| iniebcsp0 ../starter/source/boundary_conditions/ebcs/iniebcsp0.F
27!||--- calls -----------------------------------------------------
28!|| ebcs_set_tcarp ../starter/source/boundary_conditions/ebcs/iniebcs_nrf_tcar.F
29!||--- uses -----------------------------------------------------
30!|| inigrav ../starter/share/modules1/inigrav_mod.F
31!||====================================================================
32 SUBROUTINE iniebcs_nrf_tcar(EBCS_TAB,
33 . X, IXS,IXQ,IXTG,
34 . PM, IPM,MAT_PARAM)
35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE elbufdef_mod
39 USE inigrav
40 USE ebcs_mod
41 USE matparam_def_mod, ONLY : matparam_struct_
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 "param_c.inc"
51#include "com04_c.inc"
52#include "com01_c.inc"
53#include "units_c.inc"
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 TYPE(t_ebcs_tab), INTENT(INOUT) :: EBCS_TAB
58 INTEGER,INTENT(IN),TARGET :: IXS(NIXS,NUMELS),IXQ(NIXQ,NUMELQ), IXTG(NIXTG,NUMELTG)
59 my_real, INTENT(IN) :: x(3,numnod)
60 my_real,INTENT(IN) :: pm(npropm,nummat)
61 INTEGER,INTENT(IN) :: IPM(NPROPMI,NUMMAT)
62 TYPE(matparam_struct_) ,DIMENSION(NUMMAT) ,INTENT(IN) :: MAT_PARAM
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66 INTEGER :: IMAT,MLN,IADBUF,IMAT_SUB,NIX,NELS,NBPHASE
67 INTEGER :: TAGMAT(NUMMAT+1),II, NBMAT, KK
68 my_real :: tcp_ref,xmin,ymin,zmin,xmax,ymax,zmax,ssp0,ssp0max,lc,lc0max
69 INTEGER, DIMENSION(:, :), POINTER :: IX
70C-----------------------------------------------
71C S o u r c e L i n e s
72C-----------------------------------------------
73
74 ssp0 = zero
75 tagmat(1:nummat) = 0
76 nels = -huge(nels)
77 nix = -huge(nix)
78 ix => null()
79 IF(numels>0)THEN
80 nels = numels
81 nix=nixs
82 ix => ixs(1:nix, 1:nels)
83 ELSEIF(numelq >0)THEN
84 nels = numelq
85 nix=nixq
86 ix => ixq(1:nix, 1:nels)
87 ELSEIF(n2d /=0 .AND. numeltg >0)THEN
88 nels = numeltg
89 nix=nixtg
90 ix => ixtg(1:nix, 1:nels)
91 ENDIF
92
93 !-----------------------------!
94 ! CALCULATION OF SSP0MAX !
95 !-----------------------------!
96 nbphase = 0
97 DO ii=1,nels
98 imat = ix(1,ii)
99 IF(imat == 0)cycle
100 IF(tagmat(imat)==1)cycle
101 tagmat(imat)=1
102 mln = ipm(2,imat)
103 iadbuf = ipm(7,imat)
104 IF(mln == 51)THEN
105 ssp0=pm(27,imat)
106 nbphase=max(nbphase,4)
107 ELSEIF(mln == 151)THEN
108 nbmat = mat_param(imat)%MULTIMAT%NB
109 nbphase = max(nbphase,nbmat)
110 imat_sub = mat_param(imat)%MULTIMAT%MID(1)
111 ssp0 = ipm(27,imat_sub)
112 DO kk=2,nbmat
113 imat_sub = mat_param(imat)%MULTIMAT%MID(kk)
114 ssp0=max(ssp0,pm(27,imat_sub))
115 ENDDO
116 ELSE
117 ssp0=pm(27,imat)
118 ENDIF
119 ENDDO
120 ssp0max = ssp0
121
122 !-----------------------------!
123 ! LC ESTIMATOR !
124 !-----------------------------!
125 xmin = x(1,1)
126 ymin = x(2,1)
127 zmin = x(3,1)
128 xmax = x(1,1)
129 ymax = x(2,1)
130 zmax = x(3,1)
131 DO ii=1,numnod
132 xmin = min(xmin,x(1,ii))
133 ymin = min(ymin,x(2,ii))
134 zmin = min(zmin,x(3,ii))
135 xmax = max(xmax,x(1,ii))
136 ymax = max(ymax,x(2,ii))
137 zmax = max(zmax,x(3,ii))
138 ENDDO
139 lc = xmax-xmin
140 lc = max(lc,ymax-ymin)
141 lc = max(lc,zmax-zmin)
142 lc0max = lc
143
144 !-----------------------------!
145 ! CALCULATION AND ASSIGNMENT : Tcp !
146 !-----------------------------!
147 IF(ssp0max == zero)THEN
148 tcp_ref = ep20
149 ELSE
150 tcp_ref = lc0max/two/ssp0max/log(two)
151 ENDIF
152 DO kk=1,ebcs_tab%NEBCS
153 select type (twf => ebcs_tab%tab(kk)%poly)
154 type is (t_ebcs_nrf)
155 CALL ebcs_set_tcarp(twf,tcp_ref)
156 end select
157 ENDDO
158
159 !-----------------------------!
160 ! ALLOCATION BUFFER VOL FRAC !
161 !-----------------------------!
162 !EBCS%NBMAT= NBPHASE
163 !IF(NBPHASE > 0)THEN
164 ! ALLOCATE(EBCS%PHASE_ALPHA(NBPHASE,EBCS%NB_ELEM))
165 ! EBCS%PHASE_ALPHA(1:NBPHASE,1:EBCS%NB_ELEM) = ZERO
166 !ENDIF
167
168 !-----------------------------!
169 ! OUTPUT !
170 !-----------------------------!
171 WRITE (iout,1001)lc0max,ssp0max,tcp_ref
172
173
174 1001 FORMAT(
175 .//
176 .' NON REFLECTING FRONTIERS (EBCS) '/
177 .' ------------------------------- '/
178 & 5x,'INITIALIZATION OF GLOBAL PARAMETERS ',/
179 & 5x,'CHARACTERISTIC LENGTH. . . . . . . . . .=',e12.4/
180 & 5x,'REFERENCE SOUND SPEED. . . . . . . . . =',e12.4/
181 & 5x,'CHARACTERISTIC TIME (TCP). . . . . . . .=',e12.4//)
182
183
184 END SUBROUTINE iniebcs_nrf_tcar
185
186
187C-----------------------------------------------
188
189
190!||====================================================================
191!|| ebcs_set_tcarp ../starter/source/boundary_conditions/ebcs/iniebcs_nrf_tcar.F
192!||--- called by ------------------------------------------------------
193!|| iniebcs_nrf_tcar ../starter/source/boundary_conditions/ebcs/iniebcs_nrf_tcar.F
194!||--- uses -----------------------------------------------------
195!||====================================================================
196 SUBROUTINE ebcs_set_tcarp(EBCS,TCAR_P)
197 USE ebcs_mod
198#include "implicit_f.inc"
199
200 TYPE(t_ebcs_nrf) :: EBCS
201 my_real :: TCAR_P
202
203 IF(ebcs%TCAR_P == zero) ebcs%TCAR_P = tcar_p
204
205 END SUBROUTINE
my_real
#define my_real
Definition cppsort.cpp:32
iniebcs_nrf_tcar
subroutine iniebcs_nrf_tcar(ebcs_tab, x, ixs, ixq, ixtg, pm, ipm, mat_param)
Definition iniebcs_nrf_tcar.F:35
ebcs_set_tcarp
subroutine ebcs_set_tcarp(ebcs, tcar_p)
Definition iniebcs_nrf_tcar.F:197
ymax
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition law100_upd.F:274
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21