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, idtitl, 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,
character(len=nchartitle) idtitl,
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,FLAG_FMT
66C REAL
67 my_real
68 . geo(npropg)
69 CHARACTER(LEN=NCHARTITLE)::IDTITL
70 TYPE(PROP_TAG_) , DIMENSION(0:MAXPROP) :: PROP_TAG
71 TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
72C-----------------------------------------------
73C L o c a l V a r i a b l e s
74C-----------------------------------------------
75 INTEGER I,J,NFUNC,NFUND,IFUN,IAD,ISENS,IFL,ILENG,IRTYP
76C REAL
77 my_real
78 . mass,kmax,dmax,xfac,yfac,rate,alpha,dmin,
79 . pun,yfac_dim,xfac_dim
80 CHARACTER(LEN=NCHARTITLE) :: TITR
81 LOGICAL IS_AVAILABLE, IS_ENCRYPTED
82C=======================================================================
83 pun = em01
84C
85 is_encrypted = .false.
86 is_available = .false.
87C
88 igeo( 1)=ig
89 igeo(11)=igtyp
90 geo(12) =igtyp+pun
91C
92C--------------------------------------------------
93C EXTRACT DATA (IS OPTION CRYPTED)
94C--------------------------------------------------
95 CALL hm_option_is_encrypted(is_encrypted)
96C--------------------------------------------------
97C EXTRACT DATAS (INTEGER VALUES)
98C--------------------------------------------------
99 CALL hm_get_intv('ISFLAG',ifl,is_available,lsubmodel)
100 CALL hm_get_intv('ISENSOR',isens,is_available,lsubmodel)
101 CALL hm_get_intv('Ileng',ileng,is_available,lsubmodel)
102
103 CALL hm_get_intv('NFUNC',nfunc,is_available,lsubmodel)
104 CALL hm_get_intv('NRATEN',nfund,is_available,lsubmodel)
105 CALL hm_get_floatv('DMIN',dmin,is_available,lsubmodel,unitab)
106C--------------------------------------------------
107C EXTRACT DATAS (REAL VALUES)
108C--------------------------------------------------
109 CALL hm_get_floatv('m_coeff',mass,is_available,lsubmodel,unitab)
110 CALL hm_get_floatv('SCALE',xfac,is_available,lsubmodel,unitab)
111 CALL hm_get_floatv_dim('SCALE',xfac_dim,is_available,lsubmodel,unitab)
112 CALL hm_get_floatv('STIFF0',kmax,is_available,lsubmodel,unitab)
113 CALL hm_get_floatv('DMAX',dmax,is_available,lsubmodel,unitab)
114 CALL hm_get_floatv('ALPHA1',alpha,is_available,lsubmodel,unitab)
115C----
116 irtyp = 7
117 CALL fretitl2(titr,igeo(npropgi-ltitr+1),ltitr)
118c
119 ! Check if at least one loading curve is defined
120 IF (nfunc <= 0) THEN
121 CALL ancmsg(msgid=2078,
122 . msgtype=msgerror,
123 . anmode=aninfo_blind_1,
124 . i1=ig,
125 . c1=titr)
126 ENDIF
127c
128 IF (alpha == zero) alpha = one
129 IF (xfac == zero) xfac = one * xfac_dim
130 dmin = -abs(dmin)
131 dmax = abs(dmax)
132 IF (dmin == zero) dmin = -infinity
133 IF (dmax == zero) dmax = infinity
134 IF (ileng == 1) xfac = one
135c
136C--- Loading curves
137 iad = 100
138 DO i = 1, nfunc
139 CALL hm_get_int_array_index('FUN_LOAD',ifun,i,is_available,lsubmodel)
140 CALL hm_get_float_array_index('SCALE_LOAD',yfac,i,is_available,lsubmodel,unitab)
141 CALL hm_get_float_array_index('STRAINRATE_LOAD',rate,i,is_available,lsubmodel,unitab)
142 CALL hm_get_float_array_index_dim('SCALE_LOAD',yfac_dim,i,is_available,lsubmodel,unitab)
143C
144 IF (ifun <= 0) THEN
145 CALL ancmsg(msgid=862,
146 . msgtype=msgerror,
147 . anmode=aninfo_blind_1,
148 . i1=ig,
149 . c1=titr)
150 EXIT
151 ENDIF
152 IF(i > 1 .AND. rate < geo(iad+100+i-1)) THEN
153 CALL ancmsg(msgid=861,
154 . msgtype=msgerror,
155 . anmode=aninfo_blind_1,
156 . i1=ig,
157 . c1=titr)
158 EXIT
159 ENDIF
160 IF (yfac == zero) yfac = one * yfac_dim
161C
162 igeo(iad+i) = ifun
163 geo(iad+100+i) = rate
164 geo(iad+200+i) = yfac
165 ENDDO
166C--- Unloading curves
167 iad = 100+nfunc
168 ! -> defined by user
169 IF (nfund > 0) THEN
170 DO i = 1, nfund
171 CALL hm_get_int_array_index('FUN_UNLOAD',ifun,i,is_available,lsubmodel)
172 CALL hm_get_float_array_index('SCALE_UNLOAD',yfac,i,is_available,lsubmodel,unitab)
173 CALL hm_get_float_array_index('STRAINRATE_UNLOAD',rate,i,is_available,lsubmodel,unitab)
174 CALL hm_get_float_array_index_dim('SCALE_UNLOAD',yfac_dim,i,is_available,lsubmodel,unitab)
175C
176 IF (ifun <= 0) THEN
177 CALL ancmsg(msgid=862,
178 . msgtype=msgerror,
179 . anmode=aninfo_blind_1,
180 . i1=ig,
181 . c1=titr)
182 EXIT
183 ENDIF
184 IF(i > 1 .AND. rate < geo(iad+100+i-1)) THEN
185 CALL ancmsg(msgid=861,
186 . msgtype=msgerror,
187 . anmode=aninfo_blind_1,
188 . i1=ig,
189 . c1=titr)
190 EXIT
191 ENDIF
192 IF (yfac == zero) yfac = one * yfac_dim
193C
194 igeo(iad+i) = ifun
195 geo(iad+100+i) = rate
196 geo(iad+200+i) = yfac
197 ENDDO
198 ! -> defined by default
199 ELSE
200 CALL ancmsg(msgid=2079,
201 . msgtype=msgwarning,
202 . anmode=aninfo_blind_1,
203 . i1=ig,
204 . c1=titr)
205 nfund = nfunc
206 DO i = 1,nfund
207 igeo(iad+i) = igeo(100+i)
208 geo(iad+100+i) = geo(200+i)
209 geo(iad+200+i) = geo(300+i)
210 ENDDO
211 ENDIF
212C
213 igeo(20) = nfunc
214 igeo(21) = nfund
215 geo(1) = mass
216 geo(2) = kmax
217 geo(4) = alpha
218 geo(5) = xfac
219 geo(8) = irtyp + em20
220 geo(15) = dmin
221 geo(16) = dmax
222C
223 IF (mass < em15)THEN
224 CALL ancmsg(msgid=229,
225 . msgtype=msgerror,
226 . anmode=aninfo_blind_1,
227 . i1=ig,
228 . c1=titr)
229 ENDIF
230 IF (ifl == 0)THEN
231 igeo(3)=isens
232 ELSEIF (ifl == 1)THEN
233 igeo(3)=-isens
234 ELSEIF (ifl == 2)THEN
235 igeo(3)=isens
236 ENDIF
237 geo(80)=ifl
238 geo(93)=ileng
239C
240 IF(is_encrypted)THEN
241 WRITE(iout,1000)ig
242 ELSE
243 WRITE(iout,1500)ig,mass,kmax,nfunc,nfund,dmin,dmax,alpha,xfac,ileng
244 iad = 100
245 DO i=1,nfunc
246 WRITE(iout,1700) igeo(iad+i),geo(iad+200+i),geo(iad+100+i)
247 ENDDO
248 iad = 100+nfunc
249 DO i=1,nfund
250 WRITE(iout,1800) igeo(iad+i),geo(iad+200+i),geo(iad+100+i)
251 ENDDO
252 ENDIF
253C
254 prop_tag(igtyp)%G_EINT = 1
255 prop_tag(igtyp)%G_FOR = 1
256 prop_tag(igtyp)%G_LENGTH = 1
257 prop_tag(igtyp)%G_TOTDEPL = 1
258 prop_tag(igtyp)%G_FOREP = 1
259 prop_tag(igtyp)%G_DEP_IN_COMP = 1
260 prop_tag(igtyp)%G_POSX = 5 ! just temp - not really used -
261 prop_tag(igtyp)%G_LENGTH_ERR = 1
262 prop_tag(igtyp)%G_DV = 1
263 prop_tag(igtyp)%G_RUPTCRIT = 1
264C
265C-----------
266 RETURN
267C-----------
268 1000 FORMAT(
269 & 5x,'TABULATED ELASTO-PLASTIC SPRING PROPERTY SET'/,
270 & 5x,'-------------------'/,
271 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
272 & 5x,'CONFIDENTIAL DATA'//)
273 1500 FORMAT(
274 & 5x,'TABULATED ELASTIC SPRING PROPERTY SET'/,
275 & 5x,'-------------------------------------'/,
276 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
277 & 5x,'SPRING MASS . . . . . . . . . . . . . .=',1pg20.13/,
278 & 5x,'MAXIMUM STIFFNESS . . . . . . . . . . .=',1pg20.13/,
279 & 5x,'NUMBER OF LOADING CURVES . . . . . . .=',i10/,
280 & 5x,'NUMBER OF UNLOADING CURVES. . . . . . .=',i10/,
281 & 5x,'FAILURE DISPLACEMENT IN COMPRESSION . .=',1pg20.13/,
282 & 5x,'FAILURE DISPLACEMENT IN TENSION . . . .=',1pg20.13/,
283 & 5x,'STRAIN RATE FILTERING FACTOR . . . . .=',1pg20.13/,
284 & 5x,'ABSCISSA SCALE FACTOR . . . . .=',1pg20.13/,
285 & 5x,'UNIT LENGTH FLAG. . . . . . . . . . . .=',i10/,
286 & 5x,'IF=1 UNIT LENGTH MASS,STIFFNESS AND INPUT',/,
287 & 5x,' CURVE ARE STRAIN DEPENDING',/)
288 1700 FORMAT(
289 & 5x,'YIELD STRESS FUNCTION NUMBER . . . . . =',i10/
290 & 7x,'SCALE FACTOR. . . . . . . . . . . . . . =',1pg20.13/
291 & 7x,'STRAIN RATE . . . . . . . . . . . . . . =',1pg20.13)
292 1800 FORMAT(
293 & 5x,'UNLOADING FUNCTION NUMBER . . . . . . . =',i10/
294 & 7x,'SCALE FACTOR. . . . . . . . . . . . . . =',1pg20.13/
295 & 7x,'STRAIN RATE . . . . . . . . . . . . . . =',1pg20.13)
296c sensor and sensor flag not used
297C-----------
298 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: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_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:523
hm_option_is_encrypted
subroutine hm_option_is_encrypted(is_encrypted)
Definition hm_option_is_encrypted.F:284
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
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:889
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804