OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_prop26.F File Reference
#include "implicit_f.inc"
#include "scr17_c.inc"
#include "units_c.inc"
#include "param_c.inc"
#include "tablen_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_prop26 (geo, igeo, unitab, ig, igtyp, prop_tag, lsubmodel)

Function/Subroutine Documentation

◆ hm_read_prop26()

subroutine hm_read_prop26 ( geo,
integer, dimension(npropgi) igeo,
type (unit_type_), intent(in) unitab,
integer ig,
integer igtyp,
type(prop_tag_), dimension(0:maxprop) prop_tag,
type(submodel_data), dimension(*), intent(in) lsubmodel )

Definition at line 42 of file hm_read_prop26.F.

44C-----------------------------------------------
45 USE unitab_mod
46 USE elbuftag_mod
47 USE message_mod
48 USE submodel_mod
49 USE names_and_titles_mod , ONLY : nchartitle
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "scr17_c.inc"
58#include "units_c.inc"
59#include "param_c.inc"
60#include "tablen_c.inc"
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
65 INTEGER IGEO(NPROPGI),IG,IGTYP
66C REAL
67 my_real
68 . geo(npropg)
69 TYPE(PROP_TAG_) , DIMENSION(0:MAXPROP) :: PROP_TAG
70 TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
71C-----------------------------------------------
72C L o c a l V a r i a b l e s
73C-----------------------------------------------
74 INTEGER I,NFUNC,NFUND,IFUN,IAD,ISENS,IFL,ILENG,IRTYP
75C REAL
76 my_real
77 . mass,kmax,dmax,xfac,yfac,rate,alpha,dmin,
78 . pun,yfac_dim,xfac_dim
79 CHARACTER(LEN=NCHARTITLE) :: TITR
80 LOGICAL IS_AVAILABLE, IS_ENCRYPTED
81C=======================================================================
82 pun = em01
83C
84 is_encrypted = .false.
85 is_available = .false.
86C
87 igeo( 1)=ig
88 igeo(11)=igtyp
89 geo(12) =igtyp+pun
90C
91C--------------------------------------------------
92C EXTRACT DATA (IS OPTION CRYPTED)
93C--------------------------------------------------
94 CALL hm_option_is_encrypted(is_encrypted)
95C--------------------------------------------------
96C EXTRACT DATAS (INTEGER VALUES)
97C--------------------------------------------------
98 CALL hm_get_intv('ISFLAG',ifl,is_available,lsubmodel)
99 CALL hm_get_intv('ISENSOR',isens,is_available,lsubmodel)
100 CALL hm_get_intv('Ileng',ileng,is_available,lsubmodel)
101
102 CALL hm_get_intv('NFUNC',nfunc,is_available,lsubmodel)
103 CALL hm_get_intv('NRATEN',nfund,is_available,lsubmodel)
104 CALL hm_get_floatv('DMIN',dmin,is_available,lsubmodel,unitab)
105C--------------------------------------------------
106C EXTRACT DATAS (REAL VALUES)
107C--------------------------------------------------
108 CALL hm_get_floatv('m_coeff',mass,is_available,lsubmodel,unitab)
109 CALL hm_get_floatv('SCALE',xfac,is_available,lsubmodel,unitab)
110 CALL hm_get_floatv_dim('SCALE',xfac_dim,is_available,lsubmodel,unitab)
111 CALL hm_get_floatv('STIFF0',kmax,is_available,lsubmodel,unitab)
112 CALL hm_get_floatv('DMAX',dmax,is_available,lsubmodel,unitab)
113 CALL hm_get_floatv('ALPHA1',alpha,is_available,lsubmodel,unitab)
114C----
115 irtyp = 7
116 CALL fretitl2(titr,igeo(npropgi-ltitr+1),ltitr)
117c
118 ! Check if at least one loading curve is defined
119 IF (nfunc <= 0) THEN
120 CALL ancmsg(msgid=2078,
121 . msgtype=msgerror,
122 . anmode=aninfo_blind_1,
123 . i1=ig,
124 . c1=titr)
125 ENDIF
126c
127 IF (alpha == zero) alpha = one
128 IF (xfac == zero) xfac = one * xfac_dim
129 dmin = -abs(dmin)
130 dmax = abs(dmax)
131 IF (dmin == zero) dmin = -infinity
132 IF (dmax == zero) dmax = infinity
133 IF (ileng == 1) xfac = one
134c
135C--- Loading curves
136 iad = 100
137 DO i = 1, nfunc
138 CALL hm_get_int_array_index('FUN_LOAD',ifun,i,is_available,lsubmodel)
139 CALL hm_get_float_array_index('SCALE_LOAD',yfac,i,is_available,lsubmodel,unitab)
140 CALL hm_get_float_array_index('STRAINRATE_LOAD',rate,i,is_available,lsubmodel,unitab)
141 CALL hm_get_float_array_index_dim('SCALE_LOAD',yfac_dim,i,is_available,lsubmodel,unitab)
142C
143 IF (ifun <= 0) THEN
144 CALL ancmsg(msgid=862,
145 . msgtype=msgerror,
146 . anmode=aninfo_blind_1,
147 . i1=ig,
148 . c1=titr)
149 EXIT
150 ENDIF
151 IF(i > 1 .AND. rate < geo(iad+100+i-1)) THEN
152 CALL ancmsg(msgid=861,
153 . msgtype=msgerror,
154 . anmode=aninfo_blind_1,
155 . i1=ig,
156 . c1=titr)
157 EXIT
158 ENDIF
159 IF (yfac == zero) yfac = one * yfac_dim
160C
161 igeo(iad+i) = ifun
162 geo(iad+100+i) = rate
163 geo(iad+200+i) = yfac
164 ENDDO
165C--- Unloading curves
166 iad = 100+nfunc
167 ! -> defined by user
168 IF (nfund > 0) THEN
169 DO i = 1, nfund
170 CALL hm_get_int_array_index('FUN_UNLOAD',ifun,i,is_available,lsubmodel)
171 CALL hm_get_float_array_index('SCALE_UNLOAD',yfac,i,is_available,lsubmodel,unitab)
172 CALL hm_get_float_array_index('STRAINRATE_UNLOAD',rate,i,is_available,lsubmodel,unitab)
173 CALL hm_get_float_array_index_dim('SCALE_UNLOAD',yfac_dim,i,is_available,lsubmodel,unitab)
174C
175 IF (ifun <= 0) THEN
176 CALL ancmsg(msgid=862,
177 . msgtype=msgerror,
178 . anmode=aninfo_blind_1,
179 . i1=ig,
180 . c1=titr)
181 EXIT
182 ENDIF
183 IF(i > 1 .AND. rate < geo(iad+100+i-1)) THEN
184 CALL ancmsg(msgid=861,
185 . msgtype=msgerror,
186 . anmode=aninfo_blind_1,
187 . i1=ig,
188 . c1=titr)
189 EXIT
190 ENDIF
191 IF (yfac == zero) yfac = one * yfac_dim
192C
193 igeo(iad+i) = ifun
194 geo(iad+100+i) = rate
195 geo(iad+200+i) = yfac
196 ENDDO
197 ! -> defined by default
198 ELSE
199 CALL ancmsg(msgid=2079,
200 . msgtype=msgwarning,
201 . anmode=aninfo_blind_1,
202 . i1=ig,
203 . c1=titr)
204 nfund = nfunc
205 DO i = 1,nfund
206 igeo(iad+i) = igeo(100+i)
207 geo(iad+100+i) = geo(200+i)
208 geo(iad+200+i) = geo(300+i)
209 ENDDO
210 ENDIF
211C
212 igeo(20) = nfunc
213 igeo(21) = nfund
214 geo(1) = mass
215 geo(2) = kmax
216 geo(4) = alpha
217 geo(5) = xfac
218 geo(8) = irtyp + em20
219 geo(15) = dmin
220 geo(16) = dmax
221C
222 IF (mass < em15)THEN
223 CALL ancmsg(msgid=229,
224 . msgtype=msgerror,
225 . anmode=aninfo_blind_1,
226 . i1=ig,
227 . c1=titr)
228 ENDIF
229 IF (ifl == 0)THEN
230 igeo(3)=isens
231 ELSEIF (ifl == 1)THEN
232 igeo(3)=-isens
233 ELSEIF (ifl == 2)THEN
234 igeo(3)=isens
235 ENDIF
236 geo(80)=ifl
237 geo(93)=ileng
238C
239 IF(is_encrypted)THEN
240 WRITE(iout,1000)ig
241 ELSE
242 WRITE(iout,1500)ig,mass,kmax,nfunc,nfund,dmin,dmax,alpha,xfac,ileng
243 iad = 100
244 DO i=1,nfunc
245 WRITE(iout,1700) igeo(iad+i),geo(iad+200+i),geo(iad+100+i)
246 ENDDO
247 iad = 100+nfunc
248 DO i=1,nfund
249 WRITE(iout,1800) igeo(iad+i),geo(iad+200+i),geo(iad+100+i)
250 ENDDO
251 ENDIF
252C
253 prop_tag(igtyp)%G_EINT = 1
254 prop_tag(igtyp)%G_FOR = 1
255 prop_tag(igtyp)%G_LENGTH = 1
256 prop_tag(igtyp)%G_TOTDEPL = 1
257 prop_tag(igtyp)%G_FOREP = 1
258 prop_tag(igtyp)%G_DEP_IN_COMP = 1
259 prop_tag(igtyp)%G_POSX = 5 ! just temp - not really used -
260 prop_tag(igtyp)%G_LENGTH_ERR = 1
261 prop_tag(igtyp)%G_DV = 1
262 prop_tag(igtyp)%G_RUPTCRIT = 1
263C
264C-----------
265 RETURN
266C-----------
267 1000 FORMAT(
268 & 5x,'TABULATED ELASTO-PLASTIC SPRING PROPERTY SET'/,
269 & 5x,'-------------------'/,
270 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
271 & 5x,'CONFIDENTIAL DATA'//)
272 1500 FORMAT(
273 & 5x,'TABULATED ELASTIC SPRING PROPERTY SET'/,
274 & 5x,'-------------------------------------'/,
275 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
276 & 5x,'SPRING MASS . . . . . . . . . . . . . .=',1pg20.13/,
277 & 5x,'MAXIMUM STIFFNESS . . . . . . . . . . .=',1pg20.13/,
278 & 5x,'NUMBER OF LOADING CURVES . . . . . . .=',i10/,
279 & 5x,'NUMBER OF UNLOADING CURVES. . . . . . .=',i10/,
280 & 5x,'FAILURE DISPLACEMENT IN COMPRESSION . .=',1pg20.13/,
281 & 5x,'FAILURE DISPLACEMENT IN TENSION . . . .=',1pg20.13/,
282 & 5x,'STRAIN RATE FILTERING FACTOR . . . . .=',1pg20.13/,
283 & 5x,'ABSCISSA SCALE FACTOR . . . . .=',1pg20.13/,
284 & 5x,'UNIT LENGTH FLAG. . . . . . . . . . . .=',i10/,
285 & 5x,'IF=1 UNIT LENGTH MASS,STIFFNESS AND INPUT',/,
286 & 5x,' CURVE ARE STRAIN DEPENDING',/)
287 1700 FORMAT(
288 & 5x,'YIELD STRESS FUNCTION NUMBER . . . . . =',i10/
289 & 7x,'SCALE FACTOR. . . . . . . . . . . . . . =',1pg20.13/
290 & 7x,'STRAIN RATE . . . . . . . . . . . . . . =',1pg20.13)
291 1800 FORMAT(
292 & 5x,'UNLOADING FUNCTION NUMBER . . . . . . . =',i10/
293 & 7x,'SCALE FACTOR. . . . . . . . . . . . . . =',1pg20.13/
294 & 7x,'STRAIN RATE . . . . . . . . . . . . . . =',1pg20.13)
295c sensor and sensor flag not used
296C-----------
297 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
alpha
#define alpha
Definition eval.h:35
hm_get_float_array_index
subroutine hm_get_float_array_index(name, rval, index, is_available, lsubmodel, unitab)
Definition hm_get_float_array_index.F:105
hm_get_float_array_index_dim
subroutine hm_get_float_array_index_dim(name, dim_fac, index, is_available, lsubmodel, unitab)
Definition hm_get_float_array_index_dim.F:47
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:418
hm_get_floatv_dim
subroutine hm_get_floatv_dim(name, dim_fac, is_available, lsubmodel, unitab)
Definition hm_get_floatv_dim.F:161
hm_get_int_array_index
subroutine hm_get_int_array_index(name, ival, index, is_available, lsubmodel)
Definition hm_get_int_array_index.F:164
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
hm_option_is_encrypted
subroutine hm_option_is_encrypted(is_encrypted)
Definition hm_option_is_encrypted.F:288
elbuftag_mod
Definition elbuftag_mod.F:230
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
submodel_mod
Definition submodel_mod.F:717
unitab_mod
Definition unitab_mod.F:517
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:799