OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
set_elgroup_param.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!|| set_elgroup_param ../starter/source/elements/shell/coque/set_elgroup_param.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.f
27!||--- uses -----------------------------------------------------
28!||====================================================================
30 . GROUP_PARAM_TAB,IPARG ,NGROUP ,N2D ,
31 . IPM ,IGEO ,PM ,GEO ,
32 . BUFMAT )
33C-----------------------------------------------
34C M o d u l e s
35C-----------------------------------------------
36 USE group_param_mod
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C C o m m o n B l o c k s
43C-----------------------------------------------
44#include "param_c.inc"
45#include "com04_c.inc"
46#include "tabsiz_c.inc"
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50 INTEGER NGROUP,N2D
51 INTEGER ,DIMENSION(NPARG,NGROUP) :: IPARG
52 INTEGER ,DIMENSION(NPROPMI,NUMMAT) :: IPM
53 INTEGER ,DIMENSION(NPROPGI,NUMGEO) :: IGEO
54 my_real ,DIMENSION(NPROPM,NUMMAT) :: pm
55 my_real ,DIMENSION(NPROPG,NUMGEO) :: geo
56 my_real ,DIMENSION(SBUFMAT) :: bufmat
57 TYPE(group_param_) ,DIMENSION(NGROUP) :: GROUP_PARAM_TAB
58C-----------------------------------------------
59C L o c a l V a r i a b l e s
60C-----------------------------------------------
61 INTEGER NG,ITY,IGTYP,IDEF,IGMAT,IHBE,ISH3N,IEL,PID,IMAT,ILAW,IADD,
62 . NIP,ISMSTR,ICOAT
63 my_real DM,TCOAT
64C=======================================================================
65 DO ng=1,ngroup
66 ity = iparg(5,ng)
67 IF (n2d == 0 .and. (ity == 3 .or. ity == 7)) THEN
68 ilaw = iparg(1,ng)
69 imat = iparg(18,ng)
70 pid = iparg(62,ng)
71 iel = iparg(3,ng)+1
72 igtyp = iparg(38,ng)
73 dm = geo(16,pid)
74 idef = igeo(31,pid)
75 igmat = igeo(98,pid)
76c IHBE = IGEO(10,PID) ! should be the same, GEO(171) is obsolete, check !!!
77 ihbe = nint(geo(171,pid))
78 ish3n = igeo(18,pid)
79c
80c Set default membrane shell viscosity parameter (DM)
81c
82 IF (dm == zero) THEN
83 SELECT CASE (ilaw)
84 CASE (65)
85 dm = fiveem2
86 CASE (19, 119)
87 IF (ity == 3 .AND. ihbe == 23) THEN
88 dm = zep015
89 ELSE
90 dm = fourth
91 END IF
92 CASE (58, 158)
93 IF (ihbe == 11) THEN
94 dm = one_fifth
95 ELSE
96 dm = three_over_4 * em01
97 END IF
98 CASE (25, 125, 127)
99 IF (ihbe == 23) dm = em01
100 CASE DEFAULT
101 IF (ihbe == 23 .AND. (igtyp == 1 .or. igtyp == 9)) dm = zep015
102 END SELECT
103 END IF
104c------ specific composite IGMAT > 0
105 IF (igmat > 0) THEN ! .and. (ILAW /= 15 .AND. ILAW /= 27)) THEN
106 IF (dm == zero) dm = fiveem2
107 ELSEIF ( ilaw == 15 .or. ilaw == 27 .or. ilaw == 25 .or. ilaw==125
108 . .or. ilaw == 127) THEN
109 IF (dm == zero) dm = fiveem2
110 ENDIF !(IGMAT > 0
111c
112 group_param_tab(ng)%VISC_DM = dm
113c
114c------ special settings for law119
115c
116 IF (ilaw == 119) THEN
117 iadd = max(1,ipm(7,imat))-1
118 icoat = nint(bufmat(iadd+14))
119 tcoat = bufmat(iadd+16)
120 ismstr = 11 ! force small strain formulation for law 119 regardless of input
121 ihbe = 11 ! force full shell integration (Batoz) for law 119 regardless of input
122 IF (icoat > zero .AND. tcoat > zero) THEN
123 nip = 3
124 ! update shell thickness in the property to take coating into account
125 geo(1,pid) = geo(1,pid) + two*tcoat
126 ELSE
127 nip = 1
128 END IF
129 iparg(6,ng) = nip
130 iparg(9,ng) = ismstr
131 iparg(23,ng)= ihbe
132 END IF
133
134
135 ELSE
136c
137 group_param_tab(ng)%VISC_DM = zero
138c
139 ENDIF
140c
141 group_param_tab(ng)%VISC_DN = zero
142
143 ENDDO
144c-----------
145 RETURN
146 END
#define my_real
Definition cppsort.cpp:32
#define max(a, b)
Definition macros.h:21
subroutine set_elgroup_param(group_param_tab, iparg, ngroup, n2d, ipm, igeo, pm, geo, bufmat)
subroutine lectur(multi_fvm, lsubmodel, is_dyna, detonators, ebcs_tab, seatbelt_converted_elements, nb_seatbelt_shells, nb_dyna_include, user_windows, output, mat_elem, names_and_titles, defaults, glob_therm, pblast, sensor_user_struct)
Definition lectur.F:533
program starter
Definition starter.F:39