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