OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_prop26.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_prop26 ../starter/source/properties/spring/hm_read_prop26.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_properties ../starter/source/properties/hm_read_properties.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| fretitl2 ../starter/source/starter/freform.F
30!|| hm_get_float_array_index ../starter/source/devtools/hm_reader/hm_get_float_array_index.F
31!|| hm_get_float_array_index_dim ../starter/source/devtools/hm_reader/hm_get_float_array_index_dim.F
32!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
33!|| hm_get_floatv_dim ../starter/source/devtools/hm_reader/hm_get_floatv_dim.F
34!|| hm_get_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
35!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
36!|| hm_option_is_encrypted ../starter/source/devtools/hm_reader/hm_option_is_encrypted.F
37!||--- uses -----------------------------------------------------
38!|| elbuftag_mod ../starter/share/modules1/elbuftag_mod.F
39!|| message_mod ../starter/share/message_module/message_mod.F
40!|| submodel_mod ../starter/share/modules1/submodel_mod.F
41!||====================================================================
42 SUBROUTINE hm_read_prop26(GEO , IGEO , UNITAB , IG , IGTYP,
43 . PROP_TAG, LSUBMODEL)
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
298 END SUBROUTINE hm_read_prop26
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
hm_read_prop26
subroutine hm_read_prop26(geo, igeo, unitab, ig, igtyp, prop_tag, lsubmodel)
Definition hm_read_prop26.F:44
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
elbuftag_mod::prop_tag_
Definition elbuftag_mod.F:377
submodel_mod::submodel_data
Definition submodel_mod.F:728