OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_prop46.F File Reference
#include "implicit_f.inc"
#include "tablen_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_prop46 (iout, nuvar, pargeo, unitab, igtyp, id, prop_tag, titr, lsubmodel, iunit)

Function/Subroutine Documentation

◆ hm_read_prop46()

subroutine hm_read_prop46 ( integer iout,
integer nuvar,
pargeo,
type (unit_type_), intent(in) unitab,
integer igtyp,
integer id,
type(prop_tag_), dimension(0:maxprop) prop_tag,
character(len=nchartitle) titr,
type(submodel_data), dimension(*), intent(in) lsubmodel,
integer iunit )

Definition at line 39 of file hm_read_prop46.F.

41C-----------------------------------------------
42 USE unitab_mod
43 USE message_mod
44 USE elbuftag_mod
45 USE submodel_mod
46 USE names_and_titles_mod , ONLY : nchartitle
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 C o m m o n B l o c k s
65C-----------------------------------------------
66#include "tablen_c.inc"
67C----------+---------+---+---+--------------------------------------------
68C
69C This subroutine read the user geometry parameters.
70C
71C The geometry datas has to bee stored in radioss storage
72C with the function SET_U_GEO(value_index,value).
73C
74C If some standard radioss functions (time function or
75C x,y function) are used, this function IDs has to
76C bee stored with the function SET_U_PNU(func_index,func_id,KFUNC).
77C
78C If this property refers to a user material, this
79C material IDs has to bee stored with the function
80C SET_U_PNU(mat_index,mat_id,KMAT).
81C
82C If this property refers to a user property, this
83C sub-property IDs has to bee stored with the function
84C SET_U_PNU(sub_prop_index,sub_prop_id,KMAT).
85C
86C SET_U_GEO and SET_U_PNU return 0 if no error
87C SET_U_GEO and SET_U_PNU return the maximum allowed index
88C if index is larger than this maximum
89C-----------------------------------------------
90C D u m m y A r g u m e n t s
91C-----------------------------------------------
92 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
93 INTEGER IOUT,NUVAR,IGTYP,ID,IUNIT
94 my_real pargeo(*)
95 CHARACTER(LEN=NCHARTITLE) :: TITR
96 TYPE(PROP_TAG_) , DIMENSION(0:MAXPROP) :: PROP_TAG
97 TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
98C=======================================================================
99C-----------------------------------------------
100C L o c a l V a r i a b l e s
101C-----------------------------------------------
102 INTEGER IFUNC1,IFUNC2,IFUNC3,IFUNC4,IFUNC5,IERROR,KFUNC,
103 . EPSI,IDENS
104 my_real
105 . amas,elastif,xlim1,xlim2,xk,damp,fac_m, fac_l, fac_t,fscale,
106 . scalet,scalex,scalev,scalef,r_epsi,scalex_unit,scalev_unit
107 LOGICAL IS_AVAILABLE, IS_ENCRYPTED
108C-----------------------------------------------
109
110 INTEGER SET_U_PNU,SET_U_GEO
111 EXTERNAL set_u_pnu,set_u_geo
112 parameter(kfunc=29)
113 !PARAMETER (KMAT=31)
114 !PARAMETER (KPROP=30)
115C
116C=======================================================================
117C
118 is_encrypted = .false.
119 is_available = .false.
120C
121C--------------------------------------------------
122C EXTRACT DATA (IS OPTION CRYPTED)
123C--------------------------------------------------
124 CALL hm_option_is_encrypted(is_encrypted)
125C--------------------------------------------------
126C EXTRACT DATAS (INTEGER VALUES)
127C--------------------------------------------------
128 CALL hm_get_intv('FUN_A1',ifunc1,is_available,lsubmodel)
129 CALL hm_get_intv('FUN_B1',ifunc2,is_available,lsubmodel)
130 CALL hm_get_intv('FUN_C1',ifunc3,is_available,lsubmodel)
131 CALL hm_get_intv('FUN_D1',ifunc4,is_available,lsubmodel)
132 CALL hm_get_intv('MAT_IMASS',idens,is_available,lsubmodel)
133 CALL hm_get_intv('EPSI',epsi,is_available,lsubmodel)
134C--------------------------------------------------
135C EXTRACT DATAS (REAL VALUES)
136C--------------------------------------------------
137 CALL hm_get_floatv('PROP_MASS',amas,is_available,lsubmodel,unitab)
138 CALL hm_get_floatv('STIFF0',elastif,is_available,lsubmodel,unitab)
139 CALL hm_get_floatv('VEL_X',xlim1,is_available,lsubmodel,unitab)
140 CALL hm_get_floatv('NFORCE',xlim2,is_available,lsubmodel,unitab)
141 CALL hm_get_floatv('STIFF1',xk,is_available,lsubmodel,unitab)
142 CALL hm_get_floatv('DAMP1',damp,is_available,lsubmodel,unitab)
143C-- Optional ligne
144 CALL hm_get_floatv('FScale11',scalet,is_available,lsubmodel,unitab)
145 CALL hm_get_floatv('FScale22',scalex,is_available,lsubmodel,unitab)
146 CALL hm_get_floatv('FScale21',scalev,is_available,lsubmodel,unitab)
147 CALL hm_get_floatv('FScale12',scalef,is_available,lsubmodel,unitab)
148C
149 CALL hm_get_floatv_dim('FScale22',scalex_unit,is_available,lsubmodel,unitab)
150 CALL hm_get_floatv_dim('FScale21',scalev_unit,is_available,lsubmodel,unitab)
151C----------------------
152C
153 IF(.NOT. is_encrypted)THEN
154 WRITE(iout,1400) id
155 ELSE
156 WRITE(iout,1500) id
157 ENDIF
158C
159 fac_m = unitab%FAC_M(iunit)
160 fac_l = unitab%FAC_L(iunit)
161 fac_t = unitab%FAC_T(iunit)
162 fscale = fac_m * fac_l / (fac_t **two)
163c WRITE(IOUT,*) ' My User routine : Debug Start USER'
164c WRITE(IOUT,*) ' *** MAT MUSCLE ***'
165 nuvar = 4
166C
167 !default contact stiff
168 IF (xk == zero)THEN
169 xk = elastif
170 ENDIF
171 pargeo(1) = zero
172 pargeo(2) = xk
173C front wave = 1
174 pargeo(3) = one
175C
176 IF (xlim1 == zero) xlim1 = ep30*scalev_unit
177 IF (scalet == zero) scalet = one*fac_t
178 IF (scalex == zero) scalex = one*scalex_unit
179 IF (scalev == zero) scalev = one*scalev_unit
180 IF (scalef == zero) scalef = one*fscale
181C
182 ierror = set_u_geo(1,amas)
183 ierror = set_u_geo(2,elastif)
184 ierror = set_u_geo(3,xlim1)
185 ierror = set_u_geo(4,xlim2)
186 ierror = set_u_geo(5,xk)
187 ierror = set_u_geo(6,damp)
188 r_epsi = epsi
189 ierror = set_u_geo(7,r_epsi)
190 ierror = set_u_geo(8,scalet)
191 ierror = set_u_geo(9,scalex)
192 ierror = set_u_geo(10,scalev)
193 ierror = set_u_geo(11,scalef)
194 ierror = set_u_geo(12,(real(idens)+em05))
195C
196 ifunc5 = 0
197 ierror = set_u_pnu(1,ifunc1,kfunc)
198 ierror = set_u_pnu(2,ifunc2,kfunc)
199 ierror = set_u_pnu(3,ifunc3,kfunc)
200 ierror = set_u_pnu(4,ifunc4,kfunc)
201 ierror = set_u_pnu(5,ifunc5,kfunc)
202C
203 IF(.NOT. is_encrypted)THEN
204 WRITE(iout,1000)
205 . amas,elastif,xlim1,xlim2,xk,damp,epsi,
206 . ifunc1,ifunc2,ifunc3,
207 . ifunc4,idens,scalef,scalet,scalex,scalev
208 ENDIF
209C
210C-----------------------------
211C PROPERTY BUFFER
212C-----------------------------
213
214 prop_tag(igtyp)%G_FOR = 3
215 prop_tag(igtyp)%G_MOM = 5
216 prop_tag(igtyp)%G_SKEW = 6
217 prop_tag(igtyp)%G_MASS = 1
218 prop_tag(igtyp)%G_V_REPCVT = 3 ! -- VITESSES REPERE CONVECTEE (V_REPCVT)
219 prop_tag(igtyp)%G_VR_REPCVT = 3 ! -- VITESSES REPERE CONVECTEE (VR_REPCVT)
220 prop_tag(igtyp)%G_NUVAR = nuvar
221C
222 RETURN
223C
224 1000 FORMAT(
225 & 5x,'MASS PER ELEMENT . . . . . . . . . . . . .=',e12.4/,
226 & 5x,'STIFFNESS PER UNIT LENGTH. . . . . . . . .=',e12.4/,
227 & 5x,'MAXIMUM STRAIN RATE. . . . . . . . . . . .=',e12.4/,
228 & 5x,'MAXIMUM FORCE. . . . . . . . . . . . . . .=',e12.4/,
229 & 5x,'STIFFNESS FOR INTERFACE. . . . . . . . . .=',e12.4/,
230 & 5x,'DAMPING VALUE. . . . . . . . . . . . . . .=',e12.4/,
231 & 5x,'ELONGATION CALCULATION FLAG:1=L;0=L/L_o-1 =',i10/,
232C & 5X,' (1: elongation=L , 0(def): =(L / L_0) -1)',E12.4/,
233 & 5x,'FORCE VS. TIME ACTIVE FUNCTION ID. . . . .=',i10/,
234 & 5x,'FORCE VS. DEFLECTION ACTIVE FUNCTION ID. .=',i10/,
235 & 5x,'force vs. velocity active FUNCTION id. . .=',I10/,
236 & 5X,'force vs. deflection passive function id .=',I10/,
237C & 5X,'DEBUGGING FUNCTION ID. . . . . . . . . . .=',I10/,
238 & 5X,'flag for mass input. . . . . . . . . . . .=',I10/,
239 & 5X,'force scale factor . . . . . . . . . . . .=',E12.4/,
240 & 5X,'time scale factor . . . . . . . . . . . .=',E12.4/,
241 & 5X,'elongation scale factor . . . . . . . . .=',E12.4/,
242 & 5X,'velocity scale factor . . . . . . . . . .=',E12.4//)
243C
244 1400 FORMAT(
245 & 5X,'user property set'/,
246 & 5X,'property set number . . . . . . . . . .=',I10)
247C
248 1500 FORMAT(
249 & 5X,'user property set'/,
250 & 5X,'property set number . . . . . . . . . .=',I10,
251 & 5X,'confidential data'//)
252C
my_real
#define my_real
Definition cppsort.cpp:32
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
hm_get_floatv_dim
subroutine hm_get_floatv_dim(name, dim_fac, is_available, lsubmodel, unitab)
Definition hm_get_floatv_dim.F:159
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_option_is_encrypted
subroutine hm_option_is_encrypted(is_encrypted)
Definition hm_option_is_encrypted.F:284
id
initmumps id
Definition multiplerhs_example.m:4
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
elbuftag_mod
Definition elbuftag_mod.F:227
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
set_u_pnu
integer function set_u_pnu(ivar, ip, k)
Definition uaccess.F:127
set_u_geo
integer function set_u_geo(ivar, a)
Definition uaccess.F:64