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 ,PARGEO ,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 my_real
93 . pargeo(*)
94
95 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
96 TYPE (SUBMODEL_DATA) ,DIMENSION(NSUBMOD) :: LSUBMODEL
97C-----------------------------------------------
98C E x t e r n a l F u n c t i o n s
99C-----------------------------------------------
100 INTEGER SET_U_PNU,SET_U_GEO
101C-----------------------------------------------
102C P a r a m e t e r s
103C-----------------------------------------------
104 INTEGER KFUNC,KMAT,KPROP
105 parameter(kfunc=29)
106 parameter(kmat=31)
107 parameter(kprop=33)
108C-----------------------------------------------
109C L o c a l V a r i a b l e s
110C-----------------------------------------------
111 INTEGER IERROR,IDEBUG,IFUNN,IFUNT,IFUNS,IRUPT,IFILTR
112 my_real
113 . scal_f,scal_d,scal_sr,dnmax,dtmax,alpha,rupt,debug,filtr
114!
115 LOGICAL IS_AVAILABLE
116C=======================================================================
117C--- CARD1 :
118!! READ(IIN,ERR=999,FMT='(4F20.0)')SCAL_F,SCAL_D,SCAL_SR,ALPHA
119C--- CARD2 :
120!! READ(IIN,ERR=999,FMT='(6I10,2F20.0)')IRUPT,IDEBUG,IFILTR,IFUNS,
121!! . IFUNN,IFUNT,DNMAX,DTMAX
122C---
123 is_available = .false.
124!---
125C--- CARD1 :
126 CALL hm_get_floatv('F_scale_stress',scal_f,is_available,lsubmodel,unitab)
127 CALL hm_get_floatv('F_scale_strrate',scal_sr,is_available,lsubmodel,unitab)
128 CALL hm_get_floatv('F_scale_dist',scal_d,is_available,lsubmodel,unitab)
129 CALL hm_get_floatv('Alpha',alpha,is_available,lsubmodel,unitab)
130C--- CARD2 :
131 CALL hm_get_intv('RUPT',irupt,is_available,lsubmodel)
132 CALL hm_get_intv('DEBUG',idebug,is_available,lsubmodel)
133 CALL hm_get_intv('LFILTR',ifiltr,is_available,lsubmodel)
134 CALL hm_get_intv('FUNCT_ID_sr',ifuns,is_available,lsubmodel)
135 CALL hm_get_intv('FUNCT_ID_sn',ifunn,is_available,lsubmodel)
136 CALL hm_get_intv('FUNCT_ID_st',ifunt,is_available,lsubmodel)
137 CALL hm_get_floatv('MAX_N_DIST',dnmax,is_available,lsubmodel,unitab)
138 CALL hm_get_floatv('MAX_T_DIST',dtmax,is_available,lsubmodel,unitab)
139!---
140 IF (scal_f == 0.0) scal_f = one
141 IF (scal_d == 0.0) scal_d = one
142 IF (scal_sr == 0.0) scal_sr = one
143 IF (dnmax == 0.0) dnmax = ep20
144 IF (dtmax == 0.0) dtmax = ep20
145 IF (ifiltr == 1) THEN
146 IF (alpha == zero) alpha = one
147 alpha = min(alpha,one)
148 alpha = max(alpha,zero)
149 ENDIF
150 IF (ifunn == 0 .OR. ifunt == 0) GOTO 999
151C
152 rupt = irupt
153 debug = idebug
154 filtr = ifiltr
155C
156 ierror = set_u_geo( 2,scal_f)
157 ierror = set_u_geo( 3,scal_d)
158 ierror = set_u_geo( 4,scal_sr)
159 ierror = set_u_geo( 5,dnmax)
160 ierror = set_u_geo( 6,dtmax)
161 ierror = set_u_geo( 7,alpha)
162 ierror = set_u_geo( 8,rupt)
163 ierror = set_u_geo( 9,debug)
164 ierror = set_u_geo(10,filtr)
165C
166 ierror = set_u_pnu(1,ifunn,kfunc)
167 ierror = set_u_pnu(2,ifunt,kfunc)
168 ierror = set_u_pnu(3,ifuns,kfunc)
169C
170C this is the number of user variables per secnd node used in engine:
171C
172 nuvar = 2
173C------------------------------
174 WRITE(iout,1000)
175 WRITE(iout,1100) scal_f,scal_d,scal_sr,alpha,
176 . dnmax,dtmax,ifunn,ifunt,ifuns,irupt,ifiltr,idebug
177C------------------------------
178 RETURN
179999 WRITE(iout,*)' **ERROR IN USER INTERFACE PROPERTY INPUT'
180 CALL my_exit(2)
181C-----
182 1000 FORMAT(
183 . ' USER INTERFACE RUPTURE PARAMETERS '/
184 . ' ---------------------- '/)
185 1100 FORMAT(/10x,'SCAL_F . . . . . . . . . .',1pg20.13
186 . /10x,'SCAL_DISP. . . . . . . . .',1pg20.13
187 . /10x,'SCAL_SR . . . . . . . . .',1pg20.13
188 . /10x,'filtering coeff. . . . . .',1PG20.13
189 . /10X,'dn_max . . . . . . . . . .',1PG20.13
190 . /10X,'dt_max . . . . . . . . . .',1PG20.13
191 . /10X,'ifunn . . . . . . . .',I10
192 . /10X,'ifunt . . . . . . . .',I10
193 . /10X,'ifuns . . . . . . . .',I10
194 . /10X,'irupt . . . . . . . .',I10
195 . /10X,'ifiltr . . . . . . . .',I10
196 . /10X,'idebug . . . . . . . . .',I10//)
197C=======================================================================
198 RETURN
199 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:415
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_read_prop_user4
subroutine hm_read_prop_user4(iout, nuvar, pargeo, 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:1249
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513