OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_prop08.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_prop08 ../starter/source/properties/spring/hm_read_prop08.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!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
30!|| hm_get_floatv_dim ../starter/source/devtools/hm_reader/hm_get_floatv_dim.F
31!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
32!|| hm_option_is_encrypted ../starter/source/devtools/hm_reader/hm_option_is_encrypted.F
33!||--- uses -----------------------------------------------------
34!|| elbuftag_mod ../starter/share/modules1/elbuftag_mod.F
35!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
36!|| message_mod ../starter/share/message_module/message_mod.f
37!|| submodel_mod ../starter/share/modules1/submodel_mod.F
38!||====================================================================
39 SUBROUTINE hm_read_prop08(GEO,IGEO,PROP_TAG ,IGTYP,IG,
40 . ISKN,UNITAB,IUNIT,IDTITL,LSUBMODEL,SUB_ID)
41C-----------------------------------------------
42 USE unitab_mod
43 USE elbuftag_mod
44 USE message_mod
45 USE submodel_mod
46 USE hm_option_read_mod
47 USE names_and_titles_mod , ONLY : nchartitle
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "units_c.inc"
56#include "param_c.inc"
57#include "com04_c.inc"
58#include "sphcom.inc"
59#include "tablen_c.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
64 INTEGER IGEO(NPROPGI),ISKN(LISKN,*),IGTYP,IUNIT,SUB_ID
65C REAL
66 my_real
67 . geo(npropg)
68 TYPE(prop_tag_) , DIMENSION(0:MAXPROP) :: PROP_TAG
69 CHARACTER(LEN=NCHARTITLE)::IDTITL
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 IFUNC, IFUNC2, IFUNC3, IECROU, IFV, ISK, IG,
75 . isens,ifl,ifail,iequil,ifail2,israte,k
76C REAL
77 my_real
78 . a, b, d, e, f, xm, xin, xk, xc, dn, dx, pun,
79 . asrate, lscale, gf3, crit_scale,fac_m,fac_l,fac_t,
80 . a_without_unit
81 LOGICAL IS_AVAILABLE, IS_ENCRYPTED
82C-----------------------------------------------
83C E x t e r n a l F u n c t i o n s
84C-----------------------------------------------
85 DATA pun/0.1/
86C=======================================================================
87C
88C----------------------
89 pun = em01
90 iequil=0
91 ifail2 = 0
92 israte = 0
93 asrate = zero
94C
95 is_encrypted = .false.
96 is_available = .false.
97 fac_m = unitab%FAC_M(iunit)
98 fac_l = unitab%FAC_L(iunit)
99 fac_t = unitab%FAC_T(iunit)
100C
101C--------------------------------------------------
102C EXTRACT DATA (IS OPTION CRYPTED)
103C--------------------------------------------------
104 CALL hm_option_is_encrypted(is_encrypted)
105C--------------------------------------------------
106C EXTRACT DATAS (INTEGER VALUES)
107C--------------------------------------------------
108 CALL hm_get_intv('SKEW_CSID',isk,is_available,lsubmodel)
109 IF(isk == 0 .AND. sub_id /= 0 ) isk = lsubmodel(sub_id)%SKEW
110 CALL hm_get_intv('ISENSOR',isens,is_available,lsubmodel)
111 CALL hm_get_intv('ISFLAG',ifl,is_available,lsubmodel)
112 CALL hm_get_intv('Ifail',ifail,is_available,lsubmodel)
113 CALL hm_get_intv('Ifail2',ifail2,is_available,lsubmodel)
114 CALL hm_get_intv('Iequil',iequil,is_available,lsubmodel)
115 CALL hm_get_intv('ISRATE',israte,is_available,lsubmodel)
116C--------------------------------------------------
117C EXTRACT DATAS (REAL VALUES)
118C-------------------------------------------------
119 CALL hm_get_floatv('MASS',xm,is_available,lsubmodel,unitab)
120 CALL hm_get_floatv('INERTIA',xin,is_available,lsubmodel,unitab)
121 CALL hm_get_floatv('Asrate',asrate,is_available,lsubmodel,unitab)
122C----------------------
123C
124C Temporary double storage - Delete GEO (12) = Igtyp after tests
125 igeo( 1)=ig
126 igeo(11)=igtyp
127 geo(12) =igtyp+pun
128C----
129 IF(xin <= em20) THEN
130 xin = em20
131 CALL ancmsg(msgid=445,
132 . msgtype=msgwarning,
133 . anmode=aninfo_blind_1,
134 . i1=ig,
135 . c1=idtitl)
136 ENDIF
137C
138 IF (ifl == 1) isens=-isens
139C----
140 DO k=0,numskw+min(1,nspcond)*numsph+nsubmod
141 IF (isk == iskn(4,k+1)) THEN
142 isk=k+1
143 GO TO 100
144 ENDIF
145 ENDDO
146 CALL ancmsg(msgid=137,anmode=aninfo,msgtype=msgerror,
147 . c1='PROPERTY',
148 . c2='PROPERTY',
149 . i1=igeo(1),i2=isk,c3=idtitl)
150100 CONTINUE
151C
152 IF (ifail2 /= 1 .AND. ifail2 /= 2) ifail2 = 0
153 geo(1) =xm
154 geo(2) =isk+pun
155 igeo(2)=isk
156 geo(8) =2.1
157 geo(9) =xin
158 igeo(3)=isens
159 geo(79)=ifail
160 geo(80)=ifl
161 geo(94)=iequil
162 geo(95)=ifail2
163C----
164 IF(.NOT. is_encrypted)THEN
165 WRITE(iout,1800)ig,xm,xin,iskn(4,isk),abs(isens),ifl,ifail,ifail2
166 ELSE
167 WRITE(iout,1000)ig
168 1000 FORMAT(
169 & 5x,'SPRING PROPERTY SET'/,
170 & 5x,'-------------------'/,
171 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
172 & 5x,'CONFIDENTIAL DATA'//)
173 ENDIF
174!-------------------------------------------------------
175! Translations
176!-------------------------------------------------------
177!-----------------
178 ! Traction X
179!-----------------
180C-- Int - Trans X
181 CALL hm_get_intv('FUN_A1',ifunc,is_available,lsubmodel)
182 CALL hm_get_intv('HFLAG1',iecrou,is_available,lsubmodel)
183 CALL hm_get_intv('FUN_B1',ifv,is_available,lsubmodel)
184 CALL hm_get_intv('FUN_C1',ifunc2,is_available,lsubmodel)
185 CALL hm_get_intv('FUN_D1',ifunc3,is_available,lsubmodel)
186C-- Real - Trans X
187 CALL hm_get_floatv('STIFF1',xk,is_available,lsubmodel,unitab)
188 CALL hm_get_floatv('DAMP1',xc,is_available,lsubmodel,unitab)
189 CALL hm_get_floatv('Acoeft1',a,is_available,lsubmodel,unitab)
190 CALL hm_get_floatv('Bcoeft1',b,is_available,lsubmodel,unitab)
191 CALL hm_get_floatv('Dcoeft1',d,is_available,lsubmodel,unitab)
192 CALL hm_get_floatv('MIN_RUP1',dn,is_available,lsubmodel,unitab)
193 CALL hm_get_floatv('MAX_RUP1',dx,is_available,lsubmodel,unitab)
194 CALL hm_get_floatv('Prop_X_F',f,is_available,lsubmodel,unitab)
195 CALL hm_get_floatv('Prop_X_E',e,is_available,lsubmodel,unitab)
196 CALL hm_get_floatv('scale1',lscale,is_available,lsubmodel,unitab)
197 CALL hm_get_floatv('ffac',gf3,is_available,lsubmodel,unitab)
198C
199 CALL hm_get_floatv_dim('MIN_RUP1',crit_scale,is_available,lsubmodel,unitab)
200C
201 IF (iecrou == 4 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
202 CALL ancmsg(msgid=231,
203 . msgtype=msgerror,
204 . anmode=aninfo_blind_1,
205 . i1=ig,
206 . c1=idtitl)
207 ENDIF
208 IF (iecrou == 4 .AND. geo(2) == zero) THEN
209 CALL ancmsg(msgid=230,
210 . msgtype=msgerror,
211 . anmode=aninfo_blind_1,
212 . i1=ig,
213 . c1=idtitl)
214 ENDIF
215 IF (iecrou == 5 .AND. (ifunc ==0 .OR. ifunc2 == 0)) THEN
216 CALL ancmsg(msgid=231,
217 . msgtype=msgerror,
218 . anmode=aninfo_blind_1,
219 . i1=ig,
220 . c1=idtitl)
221 ENDIF
222 IF (iecrou == 6 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
223 CALL ancmsg(msgid=1057,
224 . msgtype=msgerror,
225 . anmode=aninfo_blind_1,
226 . i1=ig,
227 . c1=idtitl)
228 ENDIF
229 IF (iecrou == 7 .AND. ifunc == 0) THEN
230 CALL ancmsg(msgid=1058,
231 . msgtype=msgerror,
232 . anmode=aninfo_blind_1,
233 . i1=ig,
234 . c1=idtitl)
235 ELSEIF (iecrou == 7 .AND. ifunc2 == 0) THEN
236 CALL ancmsg(msgid=1059,
237 . msgtype=msgwarning,
238 . anmode=aninfo_blind_1,
239 . i1=ig,
240 . c1=idtitl,
241 . i2=iecrou)
242 iecrou = 2
243 ENDIF
244C
245 a_without_unit = a / (fac_m * fac_l / (fac_t **2))
246 IF (ifunc == 0 .AND. a /= zero .AND. a_without_unit /= one) THEN
247 CALL ancmsg(msgid=663,
248 . msgtype=msgwarning,
249 . anmode=aninfo_blind_1,
250 . i1=ig,
251 . c1=idtitl)
252 ENDIF
253C----
254 IF (a == zero) a = one * (fac_m * fac_l / (fac_t **2))
255 IF (d == zero) d = one * (fac_l / fac_t)
256 IF (e == zero) e = one * (fac_m * fac_l / (fac_t **2))
257 IF (f == zero) f = one * (fac_l / fac_t)
258 IF (gf3 == zero) gf3 = one * (fac_m * fac_l / (fac_t **2))
259 IF (lscale == zero) lscale = one * fac_l
260 IF (ifunc == 0) THEN
261 a = one
262 b = zero
263 e = zero
264 ENDIF
265C
266 IF (ifail2 == 0) THEN
267 dn = dn * lscale / fac_l
268 dx = dx * lscale / fac_l
269 ENDIF
270 IF (dn == zero) dn=-ep30* crit_scale
271 IF (dx == zero) dx= ep30* crit_scale
272C----
273 geo(41) = a
274 geo(42) = b
275 geo(43) = d
276 geo(40) = e
277 geo(132)= gf3
278 geo(44) = one / f
279 geo(39) = one / lscale
280 geo(65) = dn
281 geo(66) = dx
282 geo(3) = xk / a
283 geo(4) = xc
284 geo(7) = iecrou+pun
285C-- If H=6 - additional internal variables must be stored in UVAR - recommendation - GEO(25) = NUVAR
286 IF (iecrou == 6) THEN
287 geo(25) = 6
288 ENDIF
289C
290 igeo(101) = ifunc
291 igeo(102) = ifv
292 igeo(103) = ifunc2
293 igeo(119) = ifunc3
294C----
295 IF(.NOT. is_encrypted)THEN
296 IF (iecrou /= 5) THEN
297 WRITE(iout,1810)'X',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
298 . a,b,d,e,gf3,ifv,ifunc3,dn,dx
299 ELSE
300 WRITE(iout,1820)'X',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
301 . a,b,d,e,gf3,ifv,ifunc3,dn,dx
302 ENDIF
303 ENDIF
304!-----------------
305 ! Traction Y
306!-----------------
307C-- Int - Trans Y
308 CALL hm_get_intv('FUN_A2',ifunc,is_available,lsubmodel)
309 CALL hm_get_intv('HFLAG2',iecrou,is_available,lsubmodel)
310 CALL hm_get_intv('FUN_B2',ifv,is_available,lsubmodel)
311 CALL hm_get_intv('FUN_C2',ifunc2,is_available,lsubmodel)
312 CALL hm_get_intv('FUN_D2',ifunc3,is_available,lsubmodel)
313C-- Real - Trans Y
314 CALL hm_get_floatv('STIFF2',xk,is_available,lsubmodel,unitab)
315 CALL hm_get_floatv('DAMP2',xc,is_available,lsubmodel,unitab)
316 CALL hm_get_floatv('Acoeft2',a,is_available,lsubmodel,unitab)
317 CALL hm_get_floatv('Bcoeft2',b,is_available,lsubmodel,unitab)
318 CALL hm_get_floatv('Dcoeft2',d,is_available,lsubmodel,unitab)
319 CALL hm_get_floatv('MIN_RUP2',dn,is_available,lsubmodel,unitab)
320 CALL hm_get_floatv('MAX_RUP2',dx,is_available,lsubmodel,unitab)
321 CALL hm_get_floatv('Prop_Y_F',f,is_available,lsubmodel,unitab)
322 CALL hm_get_floatv('Prop_Y_E',e,is_available,lsubmodel,unitab)
323 CALL hm_get_floatv('scale2',lscale,is_available,lsubmodel,unitab)
324 CALL hm_get_floatv('df',gf3,is_available,lsubmodel,unitab)
325C
326 CALL hm_get_floatv_dim('MIN_RUP2',crit_scale,is_available,lsubmodel,unitab)
327C
328 IF (iecrou == 4 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
329 CALL ancmsg(msgid=231,
330 . msgtype=msgerror,
331 . anmode=aninfo_blind_1,
332 . i1=ig,
333 . c1=idtitl)
334 ENDIF
335 IF (iecrou == 4 .AND. geo(2) == zero) THEN
336 CALL ancmsg(msgid=230,
337 . msgtype=msgerror,
338 . anmode=aninfo_blind_1,
339 . i1=ig,
340 . c1=idtitl)
341 ENDIF
342 IF (iecrou == 5 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
343 CALL ancmsg(msgid=231,
344 . msgtype=msgerror,
345 . anmode=aninfo_blind_1,
346 . i1=ig,
347 . c1=idtitl)
348 ENDIF
349 IF (iecrou == 6 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
350 CALL ancmsg(msgid=1057,
351 . msgtype=msgerror,
352 . anmode=aninfo_blind_1,
353 . i1=ig,
354 . c1=idtitl)
355 ENDIF
356 IF (iecrou == 7 .AND. ifunc == 0) THEN
357 CALL ancmsg(msgid=1058,
358 . msgtype=msgerror,
359 . anmode=aninfo_blind_1,
360 . i1=ig,
361 . c1=idtitl)
362
363 ELSEIF (iecrou == 7 .AND. ifunc2 == 0) THEN
364 CALL ancmsg(msgid=1059,
365 . msgtype=msgwarning,
366 . anmode=aninfo_blind_1,
367 . i1=ig,
368 . c1=idtitl,
369 . i2=iecrou)
370 iecrou = 2
371 ENDIF
372C
373 a_without_unit = a / (fac_m * fac_l / (fac_t **2))
374 IF (ifunc == 0 .AND. a /= zero .AND. a_without_unit /= one) THEN
375 CALL ancmsg(msgid=663,
376 . msgtype=msgwarning,
377 . anmode=aninfo_blind_1,
378 . i1=ig,
379 . c1=idtitl)
380 ENDIF
381C----
382 IF (a == zero) a = one * (fac_m * fac_l / (fac_t **2))
383 IF (d == zero) d = one * (fac_l / fac_t)
384 IF (e == zero) e = one * (fac_m * fac_l / (fac_t **2))
385 IF (f == zero) f = one * (fac_l / fac_t)
386 IF (gf3 == zero) gf3 = one * (fac_m * fac_l / (fac_t **2))
387 IF (lscale == zero) lscale = one * fac_l
388 IF (ifunc == 0) THEN
389 a = one
390 b = zero
391 e = zero
392 ENDIF
393C
394 IF (ifail2 == 0) THEN
395 dn = dn * lscale / fac_l
396 dx = dx * lscale / fac_l
397 ENDIF
398 IF (dn == zero) dn=-ep30* crit_scale
399 IF (dx == zero) dx= ep30* crit_scale
400C----
401 geo(45) = a
402 geo(46) = b
403 geo(47) = d
404 geo(180)= e
405 geo(133)= gf3
406 geo(48) = one / f
407 geo(174)= one / lscale
408 geo(67 )= dn
409 geo(68) = dx
410 geo(10) = xk / a
411 geo(11) = xc
412 geo(14) = iecrou+pun
413C-- If H=6 - additional internal variables must be stored in UVAR - recommendation - GEO(25) = NUVAR
414 IF (iecrou == 6) THEN
415 geo(25) = 6
416 ENDIF
417C
418 igeo(104) = ifunc
419 igeo(105) = ifv
420 igeo(106) = ifunc2
421 igeo(120) = ifunc3
422C----
423 IF(.NOT. is_encrypted)THEN
424 IF (iecrou /= 5) THEN
425 WRITE(iout,1810)'Y',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
426 . a,b,d,e,gf3,ifv,ifunc3,dn,dx
427 ELSE
428 WRITE(iout,1820)'Y',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
429 . a,b,d,e,gf3,ifv,ifunc3,dn,dx
430 ENDIF
431 ENDIF
432!-----------------
433 ! Traction Z
434!-----------------
435C-- Int - Trans Z
436 CALL hm_get_intv('FUN_A3',ifunc,is_available,lsubmodel)
437 CALL hm_get_intv('HFLAG3',iecrou,is_available,lsubmodel)
438 CALL hm_get_intv('FUN_B3',ifv,is_available,lsubmodel)
439 CALL hm_get_intv('FUN_C3',ifunc2,is_available,lsubmodel)
440 CALL hm_get_intv('FUN_D3',ifunc3,is_available,lsubmodel)
441C-- Real - Trans Z
442 CALL hm_get_floatv('STIFF3',xk,is_available,lsubmodel,unitab)
443 CALL hm_get_floatv('DAMP3',xc,is_available,lsubmodel,unitab)
444 CALL hm_get_floatv('Acoeft3',a,is_available,lsubmodel,unitab)
445 CALL hm_get_floatv('Bcoeft3',b,is_available,lsubmodel,unitab)
446 CALL hm_get_floatv('Dcoeft3',d,is_available,lsubmodel,unitab)
447 CALL hm_get_floatv('MIN_RUP3',dn,is_available,lsubmodel,unitab)
448 CALL hm_get_floatv('MAX_RUP3',dx,is_available,lsubmodel,unitab)
449 CALL hm_get_floatv('Prop_Z_F',f,is_available,lsubmodel,unitab)
450 CALL hm_get_floatv('Prop_Z_E',e,is_available,lsubmodel,unitab)
451 CALL hm_get_floatv('scale3',lscale,is_available,lsubmodel,unitab)
452 CALL hm_get_floatv('D2',gf3,is_available,lsubmodel,unitab)
453C
454 CALL hm_get_floatv_dim('MIN_RUP3',crit_scale,is_available,lsubmodel,unitab)
455C
456 IF (iecrou == 4 .AND. (ifunc == 0 .OR. ifunc2 == 0))THEN
457 CALL ancmsg(msgid=231,
458 . msgtype=msgerror,
459 . anmode=aninfo_blind_1,
460 . i1=ig,
461 . c1=idtitl)
462 ENDIF
463 IF (iecrou == 4 .AND. geo(2) == zero)THEN
464 CALL ancmsg(msgid=230,
465 . msgtype=msgerror,
466 . anmode=aninfo_blind_1,
467 . i1=ig,
468 . c1=idtitl)
469 ENDIF
470 IF (iecrou == 5 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
471 CALL ancmsg(msgid=231,
472 . msgtype=msgerror,
473 . anmode=aninfo_blind_1,
474 . i1=ig,
475 . c1=idtitl)
476 ENDIF
477 IF (iecrou == 6 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
478 CALL ancmsg(msgid=1057,
479 . msgtype=msgerror,
480 . anmode=aninfo_blind_1,
481 . i1=ig,
482 . c1=idtitl)
483 ENDIF
484 IF (iecrou == 7 .AND. ifunc == 0) THEN
485 CALL ancmsg(msgid=1058,
486 . msgtype=msgerror,
487 . anmode=aninfo_blind_1,
488 . i1=ig,
489 . c1=idtitl)
490 ELSEIF (iecrou == 7 .AND. ifunc2 == 0) THEN
491 CALL ancmsg(msgid=1059,
492 . msgtype=msgwarning,
493 . anmode=aninfo_blind_1,
494 . i1=ig,
495 . c1=idtitl,
496 . i2=iecrou)
497 iecrou = 2
498 ENDIF
499C
500 a_without_unit = a / (fac_m * fac_l / (fac_t **2))
501 IF (ifunc == 0 .AND. a /= zero .AND. a_without_unit /= one) THEN
502 CALL ancmsg(msgid=663,
503 . msgtype=msgwarning,
504 . anmode=aninfo_blind_1,
505 . i1=ig,
506 . c1=idtitl)
507 ENDIF
508C----
509 IF (a == zero) a = one * (fac_m * fac_l / (fac_t **2))
510 IF (d == zero) d = one * (fac_l / fac_t)
511 IF (e == zero) e = one * (fac_m * fac_l / (fac_t **2))
512 IF (f == zero) f = one * (fac_l / fac_t)
513 IF (gf3 == zero) gf3 = one * (fac_m * fac_l / (fac_t **2))
514 IF (lscale == zero) lscale = one * fac_l
515 IF (ifunc == 0) THEN
516 a = one
517 b = zero
518 e = zero
519 ENDIF
520C
521 IF (ifail2 == 0) THEN
522 dn = dn * lscale / fac_l
523 dx = dx * lscale / fac_l
524 ENDIF
525 IF (dn == zero) dn=-ep30* crit_scale
526 IF (dx == zero) dx= ep30* crit_scale
527C----
528 geo(49) = a
529 geo(50) = b
530 geo(51) = d
531 geo(181)= e
532 geo(134)= gf3
533 geo(52) = one / f
534 geo(175)= one / lscale
535 geo(69) = dn
536 geo(77) = dx
537 geo(15) = xk / a
538 geo(16) = xc
539 geo(18) = iecrou+pun
540C-- If H=6 - additional internal variables must be stored in UVAR - recommendation - GEO(25) = NUVAR
541 IF (iecrou == 6) THEN
542 geo(25) = 6
543 ENDIF
544C
545 igeo(107) = ifunc
546 igeo(108) = ifv
547 igeo(109) = ifunc2
548 igeo(121) = ifunc3
549C----
550 IF(.NOT. is_encrypted)THEN
551 IF (iecrou /= 5) THEN
552 WRITE(iout,1810)'Z',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
553 . a,b,d,e,gf3,ifv,ifunc3,dn,dx
554 ELSE
555 WRITE(iout,1820)'Z',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
556 . a,b,d,e,gf3,ifv,ifunc3,dn,dx
557 ENDIF
558 ENDIF
559!-------------------------------------------------------
560! Rotations
561!-------------------------------------------------------
562!-----------------
563 ! Rotation X
564!-----------------
565C-- Int - Rota X
566 CALL hm_get_intv('FUN_A4',ifunc,is_available,lsubmodel)
567 CALL hm_get_intv('HFLAG4',iecrou,is_available,lsubmodel)
568 CALL hm_get_intv('FUN_B4',ifv,is_available,lsubmodel)
569 CALL hm_get_intv('FUN_C4',ifunc2,is_available,lsubmodel)
570 CALL hm_get_intv('FUN_D4',ifunc3,is_available,lsubmodel)
571C-- Real - Rota X
572 CALL hm_get_floatv('STIFF4',xk,is_available,lsubmodel,unitab)
573 CALL hm_get_floatv('DAMP4',xc,is_available,lsubmodel,unitab)
574 CALL hm_get_floatv('Acoeft4',a,is_available,lsubmodel,unitab)
575 CALL hm_get_floatv('Bcoeft4',b,is_available,lsubmodel,unitab)
576 CALL hm_get_floatv('Dcoeft4',d,is_available,lsubmodel,unitab)
577 CALL hm_get_floatv('MIN_RUP4',dn,is_available,lsubmodel,unitab)
578 CALL hm_get_floatv('MAX_RUP4',dx,is_available,lsubmodel,unitab)
579 CALL hm_get_floatv('Prop_Tor_F',f,is_available,lsubmodel,unitab)
580 CALL hm_get_floatv('Prop_Tor_E',e,is_available,lsubmodel,unitab)
581 CALL hm_get_floatv('scale4',lscale,is_available,lsubmodel,unitab)
582 CALL hm_get_floatv('Y0',gf3,is_available,lsubmodel,unitab)
583C
584 CALL hm_get_floatv_dim('MIN_RUP4',crit_scale,is_available,lsubmodel,unitab)
585C
586 IF (iecrou == 4 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
587 CALL ancmsg(msgid=231,
588 . msgtype=msgerror,
589 . anmode=aninfo_blind_1,
590 . i1=ig,
591 . c1=idtitl)
592 ENDIF
593 IF (iecrou == 4 .AND. geo(2) == zero) THEN
594 CALL ancmsg(msgid=230,
595 . msgtype=msgerror,
596 . anmode=aninfo_blind_1,
597 . i1=ig,
598 . c1=idtitl)
599 ENDIF
600 IF (iecrou == 5 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
601 CALL ancmsg(msgid=231,
602 . msgtype=msgerror,
603 . anmode=aninfo_blind_1,
604 . i1=ig,
605 . c1=idtitl)
606 ENDIF
607 IF (iecrou == 6 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
608 CALL ancmsg(msgid=1057,
609 . msgtype=msgerror,
610 . anmode=aninfo_blind_1,
611 . i1=ig,
612 . c1=idtitl)
613 ENDIF
614 IF (iecrou == 7 .AND. ifunc == 0) THEN
615 CALL ancmsg(msgid=1058,
616 . msgtype=msgerror,
617 . anmode=aninfo_blind_1,
618 . i1=ig,
619 . c1=idtitl)
620 ELSEIF (iecrou == 7 .AND. ifunc2 == 0) THEN
621 CALL ancmsg(msgid=1059,
622 . msgtype=msgwarning,
623 . anmode=aninfo_blind_1,
624 . i1=ig,
625 . c1=idtitl,
626 . i2=iecrou)
627 iecrou = 2
628 ENDIF
629C
630 a_without_unit = a / (fac_m * fac_l**2 / fac_t**2)
631 IF (ifunc == 0 .AND. a /= zero .AND. a_without_unit /= one) THEN
632 CALL ancmsg(msgid=663,
633 . msgtype=msgwarning,
634 . anmode=aninfo_blind_1,
635 . i1=ig,
636 . c1=idtitl)
637 ENDIF
638C----
639 IF (a == zero) a = one * (fac_m * fac_l**2 / (fac_t **2))
640 IF (d == zero) d = one / fac_t
641 IF (e == zero) e = one * (fac_m * fac_l**2 / (fac_t **2))
642 IF (f == zero) f = one / fac_t
643 IF (gf3 == zero) gf3 = one * (fac_m * fac_l**2 / (fac_t **2))
644 IF (lscale == zero) lscale = one
645 IF (ifunc == 0) THEN
646 a = one
647 b = zero
648 e = zero
649 ENDIF
650C
651 IF (ifail2 == 0) THEN
652 dn = dn * lscale
653 dx = dx * lscale
654 ENDIF
655 IF (dn == zero) dn=-ep30* crit_scale
656 IF (dx == zero) dx= ep30* crit_scale
657C----
658 geo(53) = a
659 geo(54) = b
660 geo(55) = d
661 geo(182) = e
662 geo(135) = gf3
663 geo(56) = one / f
664 geo(176) = one / lscale
665 geo(71) = dn
666 geo(72) = dx
667 geo(19) = xk / a
668 geo(20) = xc
669 geo(22) = iecrou+pun
670C-- If H=6 - additional internal variables must be stored in UVAR - recommendation - GEO(25) = NUVAR
671 IF (iecrou == 6) THEN
672 geo(25) = 6
673 ENDIF
674C
675 igeo(110) = ifunc
676 igeo(111) = ifv
677 igeo(112) = ifunc2
678 igeo(122) = ifunc3
679C----
680 IF(.NOT. is_encrypted)THEN
681 IF (iecrou /= 5) THEN
682 WRITE(iout,1830)'X',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
683 . a,b,d,e,gf3,ifv,ifunc3,dn,dx
684 ELSE
685 WRITE(iout,1840)'X',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
686 . a,b,d,e,gf3,ifv,ifunc3,dn,dx
687 ENDIF
688 ENDIF
689!-----------------
690 ! Rotation Y
691!-----------------
692C-- Int - Rota Y
693 CALL hm_get_intv('FUN_A5',ifunc,is_available,lsubmodel)
694 CALL hm_get_intv('HFLAG5',iecrou,is_available,lsubmodel)
695 CALL hm_get_intv('FUN_B5',ifv,is_available,lsubmodel)
696 CALL hm_get_intv('FUN_C5',ifunc2,is_available,lsubmodel)
697 CALL hm_get_intv('FUN_D5',ifunc3,is_available,lsubmodel)
698C-- Real - Rota Y
699 CALL hm_get_floatv('STIFF5',xk,is_available,lsubmodel,unitab)
700 CALL hm_get_floatv('DAMP5',xc,is_available,lsubmodel,unitab)
701 CALL hm_get_floatv('Acoeft5',a,is_available,lsubmodel,unitab)
702 CALL hm_get_floatv('Bcoeft5',b,is_available,lsubmodel,unitab)
703 CALL hm_get_floatv('Dcoeft5',d,is_available,lsubmodel,unitab)
704 CALL hm_get_floatv('MIN_RUP5',dn,is_available,lsubmodel,unitab)
705 CALL hm_get_floatv('MAX_RUP5',dx,is_available,lsubmodel,unitab)
706 CALL hm_get_floatv('Prop_FlxY_F',f,is_available,lsubmodel,unitab)
707 CALL hm_get_floatv('Prop_FlxY_E',e,is_available,lsubmodel,unitab)
708 CALL hm_get_floatv('scale5',lscale,is_available,lsubmodel,unitab)
709 CALL hm_get_floatv('Z0',gf3,is_available,lsubmodel,unitab)
710C
711 CALL hm_get_floatv_dim('MIN_RUP5',crit_scale,is_available,lsubmodel,unitab)
712C
713 IF (iecrou == 4 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
714 CALL ancmsg(msgid=231,
715 . msgtype=msgerror,
716 . anmode=aninfo_blind_1,
717 . i1=ig,
718 . c1=idtitl)
719 ENDIF
720 IF (iecrou == 4 .AND. geo(2) == zero) THEN
721 CALL ancmsg(msgid=230,
722 . msgtype=msgerror,
723 . anmode=aninfo_blind_1,
724 . i1=ig,
725 . c1=idtitl)
726 ENDIF
727 IF (iecrou == 5 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
728 CALL ancmsg(msgid=231,
729 . msgtype=msgerror,
730 . anmode=aninfo_blind_1,
731 . i1=ig,
732 . c1=idtitl)
733 ENDIF
734 IF (iecrou == 6 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
735 CALL ancmsg(msgid=1057,
736 . msgtype=msgerror,
737 . anmode=aninfo_blind_1,
738 . i1=ig,
739 . c1=idtitl)
740 ENDIF
741 IF (iecrou == 7 .AND. ifunc == 0) THEN
742 CALL ancmsg(msgid=1058,
743 . msgtype=msgerror,
744 . anmode=aninfo_blind_1,
745 . i1=ig,
746 . c1=idtitl)
747 ELSEIF (iecrou == 7 .AND. ifunc2 == 0) THEN
748 CALL ancmsg(msgid=1059,
749 . msgtype=msgwarning,
750 . anmode=aninfo_blind_1,
751 . i1=ig,
752 . c1=idtitl,
753 . i2=iecrou)
754 iecrou = 2
755 ENDIF
756C
757 a_without_unit = a / (fac_m * fac_l**2 / fac_t**2)
758 IF (ifunc == 0 .AND. a /= zero .AND. a_without_unit /= one) THEN
759 CALL ancmsg(msgid=663,
760 . msgtype=msgwarning,
761 . anmode=aninfo_blind_1,
762 . i1=ig,
763 . c1=idtitl)
764 ENDIF
765C----
766 IF (a == zero) a = one * (fac_m * fac_l**2 / (fac_t **2))
767 IF (d == zero) d = one / fac_t
768 IF (e == zero) e = one * (fac_m * fac_l**2 / (fac_t **2))
769 IF (f == zero) f = one / fac_t
770 IF (gf3 == zero) gf3 = one * (fac_m * fac_l**2 / (fac_t **2))
771 IF (lscale == zero) lscale = one
772 IF (ifunc == 0) THEN
773 a = one
774 b = zero
775 e = zero
776 ENDIF
777C
778 IF (ifail2 == 0) THEN
779 dn = dn * lscale
780 dx = dx * lscale
781 ENDIF
782 IF (dn == zero) dn=-ep30* crit_scale
783 IF (dx == zero) dx= ep30* crit_scale
784C----
785 geo(57) = a
786 geo(58) = b
787 geo(59) = d
788 geo(183) = e
789 geo(136) = gf3
790 geo(60) = one / f
791 geo(177) = one / lscale
792 geo(73) = dn
793 geo(74) = dx
794 geo(23) = xk / a
795 geo(24) = xc
796 geo(26) = iecrou+pun
797C-- If H=6 - additional internal variables must be stored in UVAR - recommendation - GEO(25) = NUVAR
798 IF (iecrou == 6) THEN
799 geo(25) = 6
800 ENDIF
801C
802 igeo(113) = ifunc
803 igeo(114) = ifv
804 igeo(115) = ifunc2
805 igeo(123) = ifunc3
806C----
807 IF(.NOT. is_encrypted)THEN
808 IF (iecrou /= 5) THEN
809 WRITE(iout,1830)'Y',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
810 . a,b,d,e,gf3,ifv,ifunc3,dn,dx
811 ELSE
812 WRITE(iout,1840)'Y',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
813 . a,b,d,e,gf3,ifv,ifunc3,dn,dx
814 ENDIF
815 ENDIF
816!-----------------
817 ! Rotation Z
818!-----------------
819C-- Int - Rota Z
820 CALL hm_get_intv('FUN_A6',ifunc,is_available,lsubmodel)
821 CALL hm_get_intv('HFLAG6',iecrou,is_available,lsubmodel)
822 CALL hm_get_intv('FUN_B6',ifv,is_available,lsubmodel)
823 CALL hm_get_intv('FUN_C6',ifunc2,is_available,lsubmodel)
824 CALL hm_get_intv('FUN_D6',ifunc3,is_available,lsubmodel)
825C-- Real - Rota Z
826 CALL hm_get_floatv('STIFF6',xk,is_available,lsubmodel,unitab)
827 CALL hm_get_floatv('DAMP6',xc,is_available,lsubmodel,unitab)
828 CALL hm_get_floatv('Acoeft6',a,is_available,lsubmodel,unitab)
829 CALL hm_get_floatv('Bcoeft6',b,is_available,lsubmodel,unitab)
830 CALL hm_get_floatv('Dcoeft6',d,is_available,lsubmodel,unitab)
831 CALL hm_get_floatv('MIN_RUP6',dn,is_available,lsubmodel,unitab)
832 CALL hm_get_floatv('MAX_RUP6',dx,is_available,lsubmodel,unitab)
833 CALL hm_get_floatv('Prop_FlxZ_F',f,is_available,lsubmodel,unitab)
834 CALL hm_get_floatv('Prop_FlxZ_E',e,is_available,lsubmodel,unitab)
835 CALL hm_get_floatv('scale6',lscale,is_available,lsubmodel,unitab)
836 CALL hm_get_floatv('Hscale6',gf3,is_available,lsubmodel,unitab)
837C
838 CALL hm_get_floatv_dim('MIN_RUP6',crit_scale,is_available,lsubmodel,unitab)
839C
840 IF (iecrou == 4 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
841 CALL ancmsg(msgid=231,
842 . msgtype=msgerror,
843 . anmode=aninfo_blind_1,
844 . i1=ig,
845 . c1=idtitl)
846 ENDIF
847 IF (iecrou == 4 .AND. geo(2) == zero) THEN
848 CALL ancmsg(msgid=230,
849 . msgtype=msgerror,
850 . anmode=aninfo_blind_1,
851 . i1=ig,
852 . c1=idtitl)
853 ENDIF
854 IF (iecrou == 5 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
855 CALL ancmsg(msgid=231,
856 . msgtype=msgerror,
857 . anmode=aninfo_blind_1,
858 . i1=ig,
859 . c1=idtitl)
860 ENDIF
861 IF (iecrou == 6 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
862 CALL ancmsg(msgid=1057,
863 . msgtype=msgerror,
864 . anmode=aninfo_blind_1,
865 . i1=ig,
866 . c1=idtitl)
867 ENDIF
868 IF (iecrou == 7 .AND. ifunc == 0) THEN
869 CALL ancmsg(msgid=1058,
870 . msgtype=msgerror,
871 . anmode=aninfo_blind_1,
872 . i1=ig,
873 . c1=idtitl)
874
875 ELSEIF (iecrou == 7 .AND. ifunc2 == 0) THEN
876 CALL ancmsg(msgid=1059,
877 . msgtype=msgwarning,
878 . anmode=aninfo_blind_1,
879 . i1=ig,
880 . c1=idtitl,
881 . i2=iecrou)
882 iecrou = 2
883 ENDIF
884C
885 a_without_unit = a / (fac_m * fac_l**2 / fac_t**2)
886 IF (ifunc == 0 .AND. a /= zero .AND. a_without_unit /= one) THEN
887 CALL ancmsg(msgid=663,
888 . msgtype=msgwarning,
889 . anmode=aninfo_blind_1,
890 . i1=ig,
891 . c1=idtitl)
892 ENDIF
893C----
894 IF (a == zero) a = one * (fac_m * fac_l**2 / (fac_t **2))
895 IF (d == zero) d = one / fac_t
896 IF (e == zero) e = one * (fac_m * fac_l**2 / (fac_t **2))
897 IF (f == zero) f = one / fac_t
898 IF (gf3 == zero) gf3 = one * (fac_m * fac_l**2 / (fac_t **2))
899 IF (lscale == zero) lscale = one
900 IF (ifunc == 0) THEN
901 a = one
902 b = zero
903 e = zero
904 ENDIF
905C
906 IF (ifail2 == 0) THEN
907 dn = dn * lscale
908 dx = dx * lscale
909 ENDIF
910 IF (dn == zero) dn=-ep30* crit_scale
911 IF (dx == zero) dx= ep30* crit_scale
912C----
913 geo(61) = a
914 geo(62) = b
915 geo(63) = d
916 geo(184) = e
917 geo(137) = gf3
918 geo(64) = one / f
919 geo(178) = one / lscale
920 geo(75) = dn
921 geo(76) = dx
922 geo(27) = xk / a
923 geo(28) = xc
924 geo(30) = iecrou+pun
925C-- If H=6 - additional internal variables must be stored in UVAR - recommendation - GEO(25) = NUVAR
926 IF (iecrou == 6) THEN
927 geo(25) = 6
928 ENDIF
929C
930 igeo(116) = ifunc
931 igeo(117) = ifv
932 igeo(118) = ifunc2
933 igeo(124) = ifunc3
934C----
935 IF(.NOT. is_encrypted)THEN
936 IF (iecrou /= 5) THEN
937 WRITE(iout,1830)'Z',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
938 . a,b,d,e,gf3,ifv,ifunc3,dn,dx
939 ELSE
940 WRITE(iout,1840)'Z',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
941 . a,b,d,e,gf3,ifv,ifunc3,dn,dx
942 ENDIF
943 ENDIF
944C------------------------
945 IF (asrate == zero) asrate=ep30 / fac_t
946 geo(96) = israte
947 geo(97) = asrate
948 IF(.NOT. is_encrypted)THEN
949 WRITE(iout, 1850) israte, asrate
950 ENDIF
951C
952C----------------------
953C FROM LECGEO - GENERAL
954C----------------------
955C
956 IF(geo(39)/=zero.AND.igeo( 9)== 0) igeo( 9)=nint(geo(39))
957C
958C-----------------------------
959C PROPERTY BUFFER
960C-----------------------------
961C
962 prop_tag(igtyp)%G_FOR = 3 ! (FX,FY,FZ)
963 prop_tag(igtyp)%G_MOM = 3 ! (XMOM,YMOM,ZMOM)
964 prop_tag(igtyp)%G_LENGTH = 3 ! X0 (AL0,Y0,Z0)
965 prop_tag(igtyp)%G_TOTDEPL = 3 ! DX (DY,DZ) - total deformation (translation)
966 prop_tag(igtyp)%G_TOTROT = 3 ! RX (RY,RZ) - total deformation (rotation)
967 prop_tag(igtyp)%G_FOREP = 3 ! FORCE - (ELASTO PLASTIQUE (ISOTROPE))
968 prop_tag(igtyp)%G_MOMEP = 3 ! MOMENT - (ELASTO PLASTIQUE (ISOTROPE))
969 prop_tag(igtyp)%G_DEP_IN_TENS = 3 ! DPX (DPY,DPZ) - max displacement in tension
970 prop_tag(igtyp)%G_DEP_IN_COMP = 3 ! DPX2 (DPY2, DPZ2) - Max Displacement in Compression
971 prop_tag(igtyp)%G_ROT_IN_TENS = 3 ! RPX (RPY,RPZ) - max rotation in tension
972 prop_tag(igtyp)%G_ROT_IN_COMP = 3 ! RPX2 (RPY2,RPY2) - max rotation in compression
973 prop_tag(igtyp)%G_POSX = 5
974 prop_tag(igtyp)%G_POSY = 5
975 prop_tag(igtyp)%G_POSZ = 5
976 prop_tag(igtyp)%G_POSXX = 5
977 prop_tag(igtyp)%G_POSYY = 5
978 prop_tag(igtyp)%G_POSZZ = 5
979 prop_tag(igtyp)%G_YIELD = 6
980 prop_tag(igtyp)%G_LENGTH_ERR = 3
981 prop_tag(igtyp)%G_E6 = 6
982 prop_tag(igtyp)%G_RUPTCRIT = 1
983 prop_tag(igtyp)%G_NUVAR = max(prop_tag(igtyp)%G_NUVAR,nint(geo(25))) ! additional internal variables for h=6
984 prop_tag(igtyp)%G_DEFINI = 6
985 prop_tag(igtyp)%G_FORINI = 6
986 prop_tag(igtyp)%G_SKEW_ID = 1
987C
988C------------------------
989 RETURN
990C------------------------
991 1800 FORMAT(
992 & 5x,'SPRING PROPERTY SET'/,
993 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
994 & 5x,'SPRING MASS . . . . . . . . . . . . . .=',1pg20.13/,
995 & 5x,'SPRING INERTIA. . . . . . . . . . . . .=',1pg20.13/,
996 & 5x,'SKEW FRAME NUMBER (0:GLOBAL). . . . . .=',i10/,
997 & 5x,'SENSOR NUMBER (0:NOT USED). . . . . . .=',i10/,
998 & 5x,'SENSOR FLAG (0:ACTIV 1:DISACT 2:BOTH) .=',i10/,
999 & 5x,'FAILURE FLAG (0:UNCOUPLED 1:COUPLED). .=',i10/,
1000 & 5x,'FAILURE CRITERION (DISPL/FORCE/ENERGY).=',i10/,
1001 & 5x,' 0:DISPLACEMENT 1:FORCE 2:ENERGY ' ,/)
1002 1810 FORMAT(
1003 & 5x,a1,' TRANSLATION'/,
1004 & 5x,'SPRING STIFFNESS. . . . . . . . . . . .=',1pg20.13/,
1005 & 5x,'SPRING DAMPING. . . . . . . . . . . . .=',1pg20.13/,
1006 & 5x,'FUNCTION IDENTIFIER FOR LOADING ',/,
1007 & 5x,'FORCE-DISPLACEMENT CURVE. . . . . . . .=',i10/,
1008 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
1009 & 5x,'FUNCTION IDENTIFIER FOR UNLOADING ',/,
1010 & 5x,'FORCE-DISPLACEMENT CURVE (H=4,5,7). . .=',i10/,
1011 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
1012 & 5x,'HARDENING FLAG H. . . . . . . . . . . .=',i10/,
1013 & 5x,'0:ELASTIC 1:ISOTROPIC 2:UNCOUPLED',/,
1014 & 5x,'4:KINEMATIC 5:UNCOUPLED NL (UN/RE)LOADING',/,
1015 & 5x,'6:ELASTO PLASTIC WITH HARDENING 7: ELASTIC HYSTERESIS',/,
1016 & 5x,'DYNAMIC AMPLIFICATION FACTOR A. . . . .=',1pg20.13/,
1017 & 5x,'DYNAMIC AMPLIFICATION FACTOR B. . . . .=',1pg20.13/,
1018 & 5x,'DYNAMIC AMPLIFICATION FACTOR D. . . . .=',1pg20.13/,
1019 & 5x,'DYNAMIC AMPLIFICATION FACTOR E. . . . .=',1pg20.13/,
1020 & 5x,'DYNAMIC AMPLIFICATION FACTOR IGF3 . . .=',1pg20.13/,
1021 & 5x,'FUNCTION IDENTIFIER FOR ',/,
1022 & 5x,'FORCE-VELOCITY CURVE. . . . . . . . . .=',i10/,
1023 & 5x,'FUNCTION IDENTIFIER FOR THE ADDITIONAL ',/,
1024 & 5x,'FORCE-VELOCITY CURVE. . . . . . . . . .=',i10/,
1025 & 5x,'NEGATIVE FAILURE DISPLACEMENT . . . . .=',1pg20.13/,
1026 & 5x,'POSITIVE FAILURE DISPLACEMENT . . . . .=',1pg20.13/)
1027 1820 FORMAT(
1028 & 5x,a1,' TRANSLATION'/,
1029 & 5x,'SPRING STIFFNESS. . . . . . . . . . . .=',1pg20.13/,
1030 & 5x,'SPRING DAMPING. . . . . . . . . . . . .=',1pg20.13/,
1031 & 5x,'FUNCTION IDENTIFIER FOR LOADING ',/,
1032 & 5x,'FORCE-DISPLACEMENT CURVE. . . . . . . .=',i10/,
1033 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
1034 & 5x,'PERMANENT DISPL./MAX. DISPL. CURVE(H=5)=',i10/,
1035 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
1036 & 5x,'HARDENING FLAG H. . . . . . . . . . . .=',i10/,
1037 & 5x,'0:ELASTIC 1:ISOTROPIC 2:UNCOUPLED',/,
1038 & 5x,'4:KINEMATIC 5:UNCOUPLED NL (UN/RE)LOADING',/,
1039 & 5x,'6:ELASTO PLASTIC WITH HARDENING 7: ELASTIC HYSTERESIS',/,
1040 & 5x,'DYNAMIC AMPLIFICATION FACTOR A. . . . .=',1pg20.13/,
1041 & 5x,'DYNAMIC AMPLIFICATION FACTOR B. . . . .=',1pg20.13/,
1042 & 5x,'DYNAMIC AMPLIFICATION FACTOR D. . . . .=',1pg20.13/,
1043 & 5x,'DYNAMIC AMPLIFICATION FACTOR E. . . . .=',1pg20.13/,
1044 & 5x,'DYNAMIC AMPLIFICATION FACTOR IGF3 . . .=',1pg20.13/,
1045 & 5x,'FUNCTION IDENTIFIER FOR ',/,
1046 & 5x,'FORCE-VELOCITY CURVE. . . . . . . . . .=',i10/,
1047 & 5x,'FUNCTION IDENTIFIER FOR THE ADDITIONAL ',/,
1048 & 5x,'FORCE-VELOCITY CURVE. . . . . . . . . .=',i10/,
1049 & 5x,'NEGATIVE FAILURE DISPLACEMENT . . . . .=',1pg20.13/,
1050 & 5x,'POSITIVE FAILURE DISPLACEMENT . . . . .=',1pg20.13/)
1051 1830 FORMAT(
1052 & 5x,a1,' ROTATION'/,
1053 & 5x,'spring stiffness. . . . . . . . . . . .=',1PG20.13/,
1054 & 5X,'spring damping. . . . . . . . . . . . .=',1PG20.13/,
1055 & 5X,'FUNCTION identifier for loading ',/,
1056 & 5X,'force-displacement curve. . . . . . . .=',I10/,
1057 & 5X,'abscissa scale factor on curve . . . . =',1PG20.13/,
1058 & 5X,'function identifier for unloading ',/,
1059 & 5X,'force-displacement curve (H=4,5,7). . .=',I10/,
1060 & 5X,'abscissa scale factor on curve . . . . =',1PG20.13/,
1061 & 5X,'hardening flag h. . . . . . . . . . . .=',I10/,
1062 & 5X,'0:elastic 1:isotropic 2:uncoupled',/,
1063 & 5X,'4:kinematic 5:uncoupled nl (UN/RE)loading',/,
1064 & 5X,'6:elasto plastic with hardening 7: elastic hysteresis',/,
1065 & 5X,'dynamic amplification factor a. . . . .=',1PG20.13/,
1066 & 5X,'dynamic amplification factor b. . . . .=',1PG20.13/,
1067 & 5X,'dynamic amplification factor d. . . . .=',1PG20.13/,
1068 & 5X,'dynamic amplification factor e. . . . .=',1PG20.13/,
1069 & 5X,'dynamic amplification factor igf3 . . .=',1PG20.13/,
1070 & 5X,'function identifier for ',/,
1071 & 5X,'force-velocity curve. . . . . . . . . .=',I10/,
1072 & 5X,'function identifier for the additional ',/,
1073 & 5X,'force-velocity curve. . . . . . . . . .=',I10/,
1074 & 5X,'negative failure rotation . . . . . . .=',1PG20.13/,
1075 & 5X,'positive failure rotation . . . . . . .=',1PG20.13/)
1076 1840 FORMAT(
1077 & 5X,A1,' rotation'/,
1078 & 5X,'spring stiffness. . . . . . . . . . . .=',1PG20.13/,
1079 & 5X,'spring damping. . . . . . . . . . . . .=',1PG20.13/,
1080 & 5X,'function identifier for loading ',/,
1081 & 5X,'force-displacement curve. . . . . . . .=',I10/,
1082 & 5X,'abscissa scale factor on curve . . . . =',1PG20.13/,
1083 & 5X,'permanent rot./max. rot. curve (H=5). .=',I10/,
1084 & 5X,'abscissa scale factor on curve . . . . =',1PG20.13/,
1085 & 5X,'hardening flag h. . . . . . . . . . . .=',I10/,
1086 & 5X,'0:elastic 1:isotropic 2:uncoupled',/,
1087 & 5X,'4:kinematic 5:uncoupled nl (UN/RE)loading',/,
1088 & 5X,'6:elasto plastic with hardening 7: elastic hysteresis',/,
1089 & 5X,'dynamic amplification factor a. . . . .=',1PG20.13/,
1090 & 5X,'dynamic amplification factor b. . . . .=',1PG20.13/,
1091 & 5X,'dynamic amplification factor d. . . . .=',1PG20.13/,
1092 & 5X,'dynamic amplification factor e. . . . .=',1PG20.13/,
1093 & 5X,'dynamic amplification factor igf3 . . .=',1PG20.13/,
1094 & 5X,'function identifier for ',/,
1095 & 5X,'force-velocity curve. . . . . . . . . .=',I10/,
1096 & 5X,'function identifier for the additional ',/,
1097 & 5X,'force-velocity curve. . . . . . . . . .=',I10/,
1098 & 5X,'negative failure rotation . . . . . . .=',1PG20.13/,
1099 & 5X,'positive failure rotation . . . . . . .=',1PG20.13/)
11001850 FORMAT(
1101 & 5X,'smooth strain rate option . . .. . . . =',I10/,
1102 & 5X,'strain rate cutting frequency .. . . . =',1PG20.13/)
1103c-----------
1104 RETURN
1105 END
my_real
#define my_real
Definition cppsort.cpp:32
damping
subroutine damping(nodft, nodlt, v, vr, a, ar, damp, ms, in, igrnod, dim, itask, weight, tagslv_rby, wfext)
Definition damping.F:882
the
end diagonal values have been computed in the(sparse) matrix id.SOL
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_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_prop08
subroutine hm_read_prop08(geo, igeo, prop_tag, igtyp, ig, iskn, unitab, iunit, idtitl, lsubmodel, sub_id)
Definition hm_read_prop08.F:41
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
elbuftag_mod
Definition elbuftag_mod.F:230
hm_option_read_mod
Definition hm_option_read_mod.F:412
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
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:725
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
nl
character *2 function nl()
Definition message.F:2360
starter
program starter
Definition starter.F:39
elbuftag_mod::prop_tag_
Definition elbuftag_mod.F:377
submodel_mod::submodel_data
Definition submodel_mod.F:728
velocity
subroutine velocity(a, ar, v, vr, fzero, itab, nale)
Definition velocity.F:29