OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_prop_user4.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!|| hm_read_prop_user4 ../starter/source/properties/user_spring_solid/hm_read_prop_user4.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_prop_generic ../starter/source/properties/hm_read_prop_generic.F
27!||--- calls -----------------------------------------------------
28!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
29!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
30!|| my_exit ../starter/source/output/analyse/analyse.c
31!|| set_u_geo ../starter/source/user_interface/uaccess.F
32!|| set_u_pnu ../starter/source/user_interface/uaccess.F
33!||--- uses -----------------------------------------------------
34!|| message_mod ../starter/share/message_module/message_mod.F
35!|| submodel_mod ../starter/share/modules1/submodel_mod.F
36!||====================================================================
37 SUBROUTINE hm_read_prop_user4(IOUT ,NUVAR ,UNITAB ,LSUBMODEL)
38C-----------------------------------------------
39C This routine may be used for user defined rupture property
40C for interface type 2
41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE unitab_mod
45 USE message_mod
46 USE submodel_mod
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51C----------+---------+---+---+--------------------------------------------
52C VAR | SIZE |TYP| RW| DEFINITION
53C----------+---------+---+---+--------------------------------------------
54C IIN | 1 | I | R | INPUT FILE UNIT (D00 file)
55C IOUT | 1 | I | R | OUTPUT FILE UNIT (L00 file)
56C NUVAR | 1 | I | W | NUMBER OF USER ELEMENT VARIABLES
57C----------+---------+---+---+--------------------------------------------
58C PARGEO | * | F | W | 1)SKEW NUMBER
59C | | | | 2)STIFNESS FOR INTERFACE
60C | | | | 3)FRONT WAVE OPTION
61C | | | | 4)... not yet used
62C----------+---------+---+---+--------------------------------------------
63C
64C This subroutine read the user geometry parameters.
65C
66C The geometry datas has to bee stored in radioss storage
67C with the function SET_U_GEO(value_index,value).
68C
69C If some standard radioss functions (time function or
70C x,y function) are used, this function IDs has to
71C bee stored with the function SET_U_PNU(func_index,func_id,KFUNC).
72C
73C If this property refers to a user material, this
74C material IDs has to bee stored with the function
75C SET_U_PNU(mat_index,mat_id,KMAT).
76C
77C If this property refers to a user property, this
78C sub-property IDs has to bee stored with the function
79C SET_U_PNU(sub_prop_index,sub_prop_id,KMAT).
80C
81C SET_U_GEO and SET_U_PNU return 0 if no error
82C SET_U_GEO and SET_U_PNU return the maximum allowed index
83C if index is larger than this maximum
84C-----------------------------------------------
85C C o m m o n B l o c k s
86C-----------------------------------------------
87C-----------------------------------------------
88C D u m m y A r g u m e n t s
89C-----------------------------------------------
90 INTEGER ,INTENT(IN) :: IOUT
91 INTEGER NUVAR
92
93 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
94 TYPE (SUBMODEL_DATA) ,DIMENSION(NSUBMOD) :: LSUBMODEL
95C-----------------------------------------------
96C E x t e r n a l F u n c t i o n s
97C-----------------------------------------------
98 INTEGER SET_U_PNU,SET_U_GEO
99C-----------------------------------------------
100C P a r a m e t e r s
101C-----------------------------------------------
102 INTEGER KFUNC,KMAT,KPROP
103 parameter(kfunc=29)
104 parameter(kmat=31)
105 parameter(kprop=33)
106C-----------------------------------------------
107C L o c a l V a r i a b l e s
108C-----------------------------------------------
109 INTEGER IERROR,IDEBUG,IFUNN,IFUNT,IFUNS,IRUPT,IFILTR
110 my_real
111 . scal_f,scal_d,scal_sr,dnmax,dtmax,alpha,rupt,debug,filtr
112!
113 LOGICAL IS_AVAILABLE
114C=======================================================================
115C--- CARD1 :
116!! READ(IIN,ERR=999,FMT='(4F20.0)')SCAL_F,SCAL_D,SCAL_SR,ALPHA
117C--- CARD2 :
118!! READ(IIN,ERR=999,FMT='(6I10,2F20.0)')IRUPT,IDEBUG,IFILTR,IFUNS,
119!! . IFUNN,IFUNT,DNMAX,DTMAX
120C---
121 is_available = .false.
122!---
123C--- CARD1 :
124 CALL hm_get_floatv('F_scale_stress',scal_f,is_available,lsubmodel,unitab)
125 CALL hm_get_floatv('F_scale_strrate',scal_sr,is_available,lsubmodel,unitab)
126 CALL hm_get_floatv('F_scale_dist',scal_d,is_available,lsubmodel,unitab)
127 CALL hm_get_floatv('Alpha',alpha,is_available,lsubmodel,unitab)
128C--- CARD2 :
129 CALL hm_get_intv('RUPT',irupt,is_available,lsubmodel)
130 CALL hm_get_intv('DEBUG',idebug,is_available,lsubmodel)
131 CALL hm_get_intv('LFILTR',ifiltr,is_available,lsubmodel)
132 CALL hm_get_intv('FUNCT_ID_sr',ifuns,is_available,lsubmodel)
133 CALL hm_get_intv('FUNCT_ID_sn',ifunn,is_available,lsubmodel)
134 CALL hm_get_intv('FUNCT_ID_st',ifunt,is_available,lsubmodel)
135 CALL hm_get_floatv('MAX_N_DIST',dnmax,is_available,lsubmodel,unitab)
136 CALL hm_get_floatv('MAX_T_DIST',dtmax,is_available,lsubmodel,unitab)
137!---
138 IF (scal_f == 0.0) scal_f = one
139 IF (scal_d == 0.0) scal_d = one
140 IF (scal_sr == 0.0) scal_sr = one
141 IF (dnmax == 0.0) dnmax = ep20
142 IF (dtmax == 0.0) dtmax = ep20
143 IF (ifiltr == 1) THEN
144 IF (alpha == zero) alpha = one
145 alpha = min(alpha,one)
146 alpha = max(alpha,zero)
147 ENDIF
148 IF (ifunn == 0 .OR. ifunt == 0) GOTO 999
149C
150 rupt = irupt
151 debug = idebug
152 filtr = ifiltr
153C
154 ierror = set_u_geo( 2,scal_f)
155 ierror = set_u_geo( 3,scal_d)
156 ierror = set_u_geo( 4,scal_sr)
157 ierror = set_u_geo( 5,dnmax)
158 ierror = set_u_geo( 6,dtmax)
159 ierror = set_u_geo( 7,alpha)
160 ierror = set_u_geo( 8,rupt)
161 ierror = set_u_geo( 9,debug)
162 ierror = set_u_geo(10,filtr)
163C
164 ierror = set_u_pnu(1,ifunn,kfunc)
165 ierror = set_u_pnu(2,ifunt,kfunc)
166 ierror = set_u_pnu(3,ifuns,kfunc)
167C
168C this is the number of user variables per secnd node used in engine:
169C
170 nuvar = 2
171C------------------------------
172 WRITE(iout,1000)
173 WRITE(iout,1100) scal_f,scal_d,scal_sr,alpha,
174 . dnmax,dtmax,ifunn,ifunt,ifuns,irupt,ifiltr,idebug
175C------------------------------
176 RETURN
177999 WRITE(iout,*)' **ERROR IN USER INTERFACE PROPERTY INPUT'
178 CALL my_exit(2)
179C-----
180 1000 FORMAT(
181 . ' USER INTERFACE RUPTURE PARAMETERS '/
182 . ' ---------------------- '/)
183 1100 FORMAT(/10x,'SCAL_F . . . . . . . . . .',1pg20.13
184 . /10x,'SCAL_DISP. . . . . . . . .',1pg20.13
185 . /10x,'SCAL_SR . . . . . . . . .',1pg20.13
186 . /10x,'FILTERING COEFF. . . . . .',1pg20.13
187 . /10x,'DN_MAX . . . . . . . . . .',1pg20.13
188 . /10x,'DT_MAX . . . . . . . . . .',1pg20.13
189 . /10x,'IFUNN . . . . . . . .',i10
190 . /10x,'IFUNT . . . . . . . .',i10
191 . /10x,'IFUNS . . . . . . . .',i10
192 . /10x,'IRUPT . . . . . . . .',i10
193 . /10x,'IFILTR . . . . . . . .',i10
194 . /10x,'IDEBUG . . . . . . . . .',i10//)
195C=======================================================================
196 RETURN
197 END
my_exit
void my_exit(int *i)
Definition analyse.c:1038
my_real
#define my_real
Definition cppsort.cpp:32
alpha
#define alpha
Definition eval.h:35
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:418
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
hm_read_prop_user4
subroutine hm_read_prop_user4(iout, nuvar, unitab, lsubmodel)
Definition hm_read_prop_user4.F:38
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
message_mod
Definition message_mod.F:1257
submodel_mod
Definition submodel_mod.F:717
unitab_mod
Definition unitab_mod.F:517