40
46
47
48
49#include "implicit_f.inc"
50
51
52
53#include "units_c.inc"
54#include "param_c.inc"
55#include "tablen_c.inc"
56
57
58
59 TYPE (UNIT_TYPE_),INTENT(IN) :: UNITAB
60 INTEGER IGEO(NPROPGI),IGTYP,IG
61
63 . geo(npropg)
64 TYPE(PROP_TAG_) , DIMENSION(0:MAXPROP) :: PROP_TAG
65 TYPE(SUBMODEL_DATA),INTENT(IN) :: LSUBMODEL(*)
66
67
68
69 INTEGER IFUNC,IFUNC2,ISENS,IFL,IFAIL,J,ILENG,ITENS,Fsmooth
70
72 . mass,stiff,damp,gap,min_rup,max_rup,
73 . ascale1,ascale2,fscale1,fscale2,
74 . ascale1_unit,ascale2_unit,fscale1_unit,
75 . fscale2_unit,nexp,fcut
76 LOGICAL IS_AVAILABLE, IS_ENCRYPTED
77
78
79 is_encrypted = .false.
80 is_available = .false.
81
82
83
84
86
87
88
89
90
91 CALL hm_get_floatv(
'MASS' ,mass ,is_available,lsubmodel,unitab)
92 CALL hm_get_intv(
'ISENSOR' ,isens ,is_available,lsubmodel)
93 CALL hm_get_intv(
'ISFLAG' ,ifl ,is_available,lsubmodel)
94 CALL hm_get_intv(
'Ileng' ,ileng ,is_available,lsubmodel)
95 CALL hm_get_intv(
'Itens' ,itens ,is_available,lsubmodel)
96 CALL hm_get_intv(
'Ifail' ,ifail ,is_available,lsubmodel)
97
98 CALL hm_get_floatv(
'STIFF' ,stiff ,is_available,lsubmodel,unitab)
99 CALL hm_get_floatv(
'DAMP' ,damp ,is_available,lsubmodel,unitab)
100 CALL hm_get_floatv(
'NEXP' ,nexp ,is_available,lsubmodel,unitab)
101 CALL hm_get_floatv(
'MIN_RUP' ,min_rup ,is_available,lsubmodel,unitab)
102 CALL hm_get_floatv(
'MAX_RUP' ,max_rup ,is_available,lsubmodel,unitab)
103
104 CALL hm_get_floatv(
'GAP' ,gap ,is_available,lsubmodel,unitab)
105 CALL hm_get_intv(
'FSMOOTH' ,fsmooth ,is_available,lsubmodel)
106 CALL hm_get_floatv(
'FCUT' ,fcut ,is_available,lsubmodel,unitab)
107
108 CALL hm_get_intv(
'FUN1' ,ifunc ,is_available,lsubmodel)
109 CALL hm_get_intv(
'FUN2' ,ifunc2 ,is_available,lsubmodel)
110 CALL hm_get_floatv(
'ASCALE1' ,ascale1 ,is_available,lsubmodel,unitab)
111 IF (ascale1 == zero) THEN
113 ascale1 = one * ascale1_unit
114 ENDIF
115 CALL hm_get_floatv(
'FSCALE1' ,fscale1 ,is_available,lsubmodel,unitab)
116 IF (fscale1 == zero) THEN
118 fscale1 = one * fscale1_unit
119 ENDIF
120 CALL hm_get_floatv(
'ASCALE2' ,ascale2 ,is_available,lsubmodel,unitab)
121 IF (ascale2 == zero) THEN
123 ascale2 = one * ascale2_unit
124 ENDIF
125 CALL hm_get_floatv(
'FSCALE2' ,fscale2 ,is_available,lsubmodel,unitab)
126 IF (fscale2 == zero) THEN
128 fscale2 = one * fscale2_unit
129 ENDIF
130
131
132
133
134
135
136 min_rup = -abs(min_rup)
137 gap = -abs(gap)
138 IF (gap < zero) itens = 0
139
140 IF (nexp <= zero) nexp = one
141
142 IF (fsmooth /= 0) fsmooth = 1
143
144 IF (ifunc /= 0) stiff = zero
145 IF (ifunc2 /= 0) damp = zero
146
147 IF (ifl == 1) isens = -isens
148
149 IF (min_rup == zero) min_rup = -infinity
150 IF (max_rup == zero) max_rup = infinity
151
152 IF (fcut /= zero) THEN
153
154 fsmooth = 1
155 ELSE
156
157 IF (fsmooth /= 0) THEN
158 fcut = 100000.0d0*unitab%FAC_T_WORK
159
160 ELSE
161 fcut = zero
162 ENDIF
163 ENDIF
164
165
166
167
168
169 igeo(1) = ig
170 igeo(3) = isens
171 igeo(11) = igtyp
172 igeo(101) = ifunc
173 igeo(102) = ifunc2
174
175
176 geo(1) = mass
177 geo(2) = stiff
178 geo(3) = damp
179 geo(5) = ep06
180 geo(7) = zero
181 geo(8) = onep1
182 geo(10) = fscale1
183 geo(12) = igtyp+em01
184 geo(15) = min_rup
185 geo(16) = max_rup
186 geo(18) = ascale2
187 geo(19) = gap
188 geo(25) = zero
189 geo(39) = ascale1
190 geo(43) = ifail
191 geo(80) = ifl
192 geo(93) = ileng
193 geo(132) = fscale2
194 geo(133) = itens
195 geo(134) = nexp
196 geo(135) = fsmooth
197 geo(136) = fcut
198
199
200
201
202 IF (geo(171) /= zero .AND. igeo(10) == 0) igeo(10) = nint(geo(171))
203
204
205
206
207 prop_tag(igtyp)%G_EINT = 1
208 prop_tag(igtyp)%G_FOR = 1
209 prop_tag(igtyp)%G_LENGTH = 1
210 prop_tag(igtyp)%G_TOTDEPL = 1
211 prop_tag(igtyp)%G_DEP_IN_TENS = 1
212 prop_tag(igtyp)%G_DEP_IN_COMP = 1
213 prop_tag(igtyp)%G_POSX = 5
214 prop_tag(igtyp)%G_LENGTH_ERR = 1
215 prop_tag(igtyp)%G_NUVAR =
max(prop_tag(igtyp)%G_NUVAR,nint(geo(25)))
216 prop_tag(igtyp)%G_DEFINI = 1
217 prop_tag(igtyp)%G_FORINI = 1
218 prop_tag(igtyp)%G_RUPTCRIT = 1
219
220
221
222
223 WRITE(iout,2000)
224 IF (.NOT. is_encrypted) THEN
225
226 IF (ileng == 0) THEN
227 WRITE(iout,1400) ig,mass
228 ELSE
229 WRITE(iout,1410) ig,mass
230 ENDIF
231
232
233 IF (ifunc == 0) THEN
234 IF (ileng == 0) THEN
235 WRITE(iout,1450) stiff,nexp
236 ELSE
237 WRITE(iout,1460) stiff,nexp
238 ENDIF
239
240 ELSE
241 IF (ileng == 0) THEN
242 WRITE(iout,1500) ifunc,ascale1,fscale1
243 ELSE
244 WRITE(iout,1510) ifunc,ascale1,fscale1
245 ENDIF
246 ENDIF
247
248
249 IF (ifunc2 == 0) THEN
250 IF (ileng == 0) THEN
251 WRITE(iout,1550) damp
252 ELSE
253 WRITE(iout,1560) damp
254 ENDIF
255
256 ELSE
257 IF (ileng == 0) THEN
258 WRITE(iout,1600) ifunc2,ascale2,fscale2
259 ELSE
260 WRITE(iout,1610) ifunc2,ascale2,fscale2
261 ENDIF
262 ENDIF
263
264 IF (gap /= zero) THEN
265 IF (ileng == 0) THEN
266 WRITE(iout,1650) gap
267 ELSE
268 WRITE(iout,1660) gap
269 ENDIF
270 ENDIF
271
272 WRITE(iout,1700) ileng
273
274 WRITE(iout,1800) itens
275
276 WRITE(iout,1900) fsmooth,fcut
277
278 IF (ifail /= 0) THEN
279 IF (ileng == 0) THEN
280 WRITE(iout,1750) ifail,min_rup,max_rup
281 ELSE
282 WRITE(iout,1760) ifail,min_rup,max_rup
283 ENDIF
284 ENDIF
285 ELSE
286 WRITE(iout,1000) ig
287 ENDIF
288
289
2902000 FORMAT(
291 & 5x,'------------------------------------------------------'/,
292 & 5x,' BOUNDED DAMPER SPRING PROPERTY SET '/,
293 & 5x,'------------------------------------------------------'/)
2941000 FORMAT(
295 & 5x,'PROPERTY SET NUMBER . . . . . . . . . . . . . . . . .=',i10/,
296 & 5x,'CONFIDENTIAL DATA'//)
2971400 FORMAT(
298 & 5x,'PROPERTY SET NUMBER . . . . . . . . . . . . . . . . .=',i10/,
299 & 5x,'SPRING MASS . . . . . . . . . . . . . . . . . . . . .=',1pg20.13/)
3001410 FORMAT(
301 & 5x,'PROPERTY SET NUMBER . . . . . . . . . . . . . . . . .=',i10/,
302 & 5x,'SPRING LINEIC MASS . . . . . . . . . . . . . . . . . .=',1pg20.13/)
3031450 FORMAT(
304 & 5x,'LINEAR SPRING STIFFNESS . . . . . . . . . . . . . . .=',1pg20.13/,
305 & 5x,'NON-LINEAR EXPONENT . . . . . . . . . . . . . . . . .=',1pg20.13/)
3061460 FORMAT(
307 & 5x,'LINEAR SPRING STIFFNESS PER UNIT LENGTH. . . . . . . .=',1pg20.13/,
308 & 5x,'NON-LINEAR EXPONENT . . . . . . . . . . . . . . . . .=',1pg20.13/)
3091500 FORMAT(
310 & 5x,'NON LINEAR STIFFNESS FORCE FUNCTION ID . . . . . . . .=',i10/,
311 & 5x,'ELONGATION SCALE FACTOR FOR STIFFNESS FUNCTION . . . .=',1pg20.13/,
312 & 5x,'FORCE SCALE FACTOR FOR STIFFNESS FUNCTION . . . . . .=',1pg20.13/)
3131510 FORMAT(
314 & 5x,'NON LINEAR STIFFNESS FORCE FUNCTION ID . . . . . . . .=',i10/,
315 & 5x,'STRAIN SCALE FACTOR FOR STIFFNESS FUNCTION . . . . . .=',1pg20.13/,
316 & 5x,'FORCE SCALE FACTOR FOR STIFFNESS FUNCTION . . . . . .=',1pg20.13/)
3171550 FORMAT(
318 & 5x,'LINEAR DAMPING COEFFICIENT . . . . . . . . . . . . . .=',1pg20.13/)
3191560 FORMAT(
320 & 5x,'LINEAR DAMPING COEFFICIENT PER UNIT LENGTH . . . . . .=',1pg20.13/)
3211600 FORMAT(
322 & 5x,'NON LINEAR DAMPING FORCE FUNCTION ID . . . . . . . . .=',i10/,
323 & 5x,'VELOCITY SCALE FACTOR FOR DAMPING FUNCTION . . . . . .=',1pg20.13/,
324 & 5x,'FORCE SCALE FACTOR FOR DAMPING FUNCTION . . . . . . .=',1pg20.13/)
3251610 FORMAT(
326 & 5x,'NON LINEAR DAMPING FORCE FUNCTION ID . . . . . . . . .=',i10/,
327 & 5x,'STRAIN-RATE SCALE FACTOR FOR DAMPING FUNCTION . . . .=',1pg20.13/,
328 & 5x,'FORCE SCALE FACTOR FOR DAMPING FUNCTION . . . . . . .=',1pg20.13/)
3291650 FORMAT(
330 & 5x,'MINIMUM COMPRESSION GAP (LENGTH) FOR ACTIVATION . . .=',1pg20.13/)
3311660 FORMAT(
332 & 5x,'MINIMUM COMPRESSION GAP (STRAIN) FOR ACTIVATION . . .=',1pg20.13/)
3331700 FORMAT(
334 & 5x,'UNIT LENGTH FLAG . . . . . . . . . . . . . . . . . . .=',i10/,
335 & 5x,' ILENG = 0 : INPUT VALUES WITH CLASSICAL UNITS ',/,
336 & 5x,' ILENG = 1 : INPUT VALUES PER UNIT LENGTH ',/)
3371750 FORMAT(
338 & 5x,'FAILURE FLAG IFAIL . . . . . . . . . . . . . . . . . .=',i10/,
339 & 5x,' IFAIL = 1 : DISPLACEMENT FAILURE CRITERION ',/,
340 & 5x,' IFAIL = 2 : FORCE FAILURE CRITERION ',/,
341 & 5x,'NEGATIVE FAILURE LIMIT . . . . . . . . . . . . . . . .=',1pg20.13/,
342 & 5x,'POSITIVE FAILURE LIMIT (IF ITENS = 1). . . . . . . . .=',1pg20.13/)
3431760 FORMAT(
344 & 5x,'FAILURE FLAG IFAIL . . . . . . . . . . . . . . . . . .=',i10/,
345 & 5x,' IFAIL = 1 : STRAIN FAILURE CRITERION ',/,
346 & 5x,' IFAIL = 2 : FORCE FAILURE CRITERION ',/,
347 & 5x,'NEGATIVE FAILURE LIMIT . . . . . . . . . . . . . . . .=',1pg20.13/,
348 & 5x,'POSITIVE FAILURE LIMIT (IF ITENS = 1). . . . . . . . .=',1pg20.13/)
3491800 FORMAT(
350 & 5x,'TENSILE BEHAVIOR FLAG . . . . . . . . . . . . . . . .=',i10/,
351 & 5x,' ITENS = 0 : NO STIFFNESS AND DAMPING IN TENSION ',/,
352 & 5x,' ITENS = 1 : STIFFNESS AND DAMPING FOR TENSION ',/)
3531900 FORMAT(
354 & 5x,'SPRING FORCE FILTERING FLAG . . . . . . . . . . . . .=',i10/,
355 & 5x,' FSMOOTH = 0 : NO FILTERING ',/,
356 & 5x,' FSMOOTH = 1 : FILTERING ACTIVATED ',/,
357 & 5x,'CUTOFF FREQUENCY . . . . . . . . . . . . . . . . . . .=',1pg20.13/)
358
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_floatv_dim(name, dim_fac, is_available, lsubmodel, unitab)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
subroutine hm_option_is_encrypted(is_encrypted)