41
48
49
50
51#include "implicit_f.inc"
52
53
54
55#include "units_c.inc"
56#include "param_c.inc"
57#include "com04_c.inc"
58#include "sphcom.inc"
59#include "tablen_c.inc"
60
61
62
63 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
64 INTEGER IGEO(NPROPGI),ISKN(LISKN,*),IGTYP,IUNIT,SUB_ID
65
67 . geo(npropg)
68 TYPE(PROP_TAG_) , DIMENSION(0:MAXPROP) :: PROP_TAG
69 CHARACTER(LEN=NCHARTITLE)::IDTITL
70 TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
71
72
73
74 INTEGER IFUNC, IFUNC2, IFUNC3, IECROU, IFV, ISK, IG,
75 . ISENS,IFL,IFAIL,IEQUIL,IFAIL2,ISRATE,K
76
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
82
83
84
85 DATA pun/0.1/
86
87
88
89 pun = em01
90 iequil=0
91 ifail2 = 0
92 israte = 0
93 asrate = zero
94
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)
100
101
102
103
105
106
107
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)
116
117
118
120 CALL hm_get_floatv(
'INERTIA',xin,is_available,lsubmodel,unitab)
121 CALL hm_get_floatv(
'Asrate',asrate,is_available,lsubmodel,unitab)
122
123
124
125 igeo( 1)=ig
126 igeo(11)=igtyp
127 geo(12) =igtyp+pun
128
129 IF(xin <= em20) THEN
130 xin = em20
132 . msgtype=msgwarning,
133 . anmode=aninfo_blind_1,
134 . i1=ig,
135 . c1=idtitl)
136 ENDIF
137
138 IF (ifl == 1) isens=-isens
139
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
151
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
163
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
176
177
178
179
180
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)
186
187 CALL hm_get_floatv(
'STIFF1',xk,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)
198
200
201 IF (iecrou == 4 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
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
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
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
224 . msgtype=msgerror,
225 . anmode=aninfo_blind_1,
226 . i1=ig,
227 . c1=idtitl)
228 ENDIF
229 IF (iecrou == 7 .AND. ifunc == 0) THEN
231 . msgtype=msgerror,
232 . anmode=aninfo_blind_1,
233 . i1=ig,
234 . c1=idtitl)
235 ELSEIF (iecrou == 7 .AND. ifunc2 == 0) THEN
237 . msgtype=msgwarning,
238 . anmode=aninfo_blind_1,
239 . i1=ig,
240 . c1=idtitl,
241 . i2=iecrou)
242 iecrou = 2
243 ENDIF
244
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
248 . msgtype=msgwarning,
249 . anmode=aninfo_blind_1,
250 . i1=ig,
251 . c1=idtitl)
252 ENDIF
253
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
265
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
272
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
285
286 IF (iecrou == 6) THEN
287 geo(25) = 6
288 ENDIF
289
290 igeo(101) = ifunc
291 igeo(102) = ifv
292 igeo(103) = ifunc2
293 igeo(119) = ifunc3
294
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
306
307
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)
313
314 CALL hm_get_floatv(
'STIFF2',xk,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)
325
327
328 IF (iecrou == 4 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
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
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
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
351 . msgtype=msgerror,
352 . anmode=aninfo_blind_1,
353 . i1=ig,
354 . c1=idtitl)
355 ENDIF
356 IF (iecrou == 7 .AND. ifunc == 0) THEN
358 . msgtype=msgerror,
359 . anmode=aninfo_blind_1,
360 . i1=ig,
361 . c1=idtitl)
362
363 ELSEIF (iecrou == 7 .AND. ifunc2 == 0) THEN
365 . msgtype=msgwarning,
366 . anmode=aninfo_blind_1,
367 . i1=ig,
368 . c1=idtitl,
369 . i2=iecrou)
370 iecrou = 2
371 ENDIF
372
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
376 . msgtype=msgwarning,
377 . anmode=aninfo_blind_1,
378 . i1=ig,
379 . c1=idtitl)
380 ENDIF
381
382 IF (a == zero) a = one
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
393
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
400
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
413
414 IF (iecrou == 6) THEN
415 geo(25) = 6
416 ENDIF
417
418 igeo(104) = ifunc
419 igeo(105) = ifv
420 igeo(106) = ifunc2
421 igeo(120) = ifunc3
422
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
434
435
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)
441
442 CALL hm_get_floatv(
'STIFF3',xk,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)
453
455
456 IF (iecrou == 4 .AND. (ifunc == 0 .OR. ifunc2 == 0))THEN
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
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
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
479 . msgtype=msgerror,
480 . anmode=aninfo_blind_1,
481 . i1=ig,
482 . c1=idtitl)
483 ENDIF
484 IF (iecrou == 7 .AND. ifunc == 0) THEN
486 . msgtype=msgerror,
487 . anmode=aninfo_blind_1,
488 . i1=ig,
489 . c1=idtitl)
490 ELSEIF (iecrou == 7 .AND. ifunc2 == 0) THEN
492 . msgtype=msgwarning,
493 . anmode=aninfo_blind_1,
494 . i1=ig,
495 . c1=idtitl,
496 . i2=iecrou)
497 iecrou = 2
498 ENDIF
499
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
503 . msgtype=msgwarning,
504 . anmode=aninfo_blind_1,
505 . i1=ig,
506 . c1=idtitl)
507 ENDIF
508
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
520
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
527
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
540
541 IF (iecrou == 6) THEN
542 geo(25) = 6
543 ENDIF
544
545 igeo(107) = ifunc
546 igeo(108) = ifv
547 igeo(109) = ifunc2
548 igeo(121) = ifunc3
549
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 .
557 ENDIF
558 ENDIF
559
560
561
562
563
564
565
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)
571
572 CALL hm_get_floatv(
'STIFF4',xk,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)
583
585
586 IF (iecrou == 4 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
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
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
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
609 . msgtype=msgerror,
610 . anmode=aninfo_blind_1,
611 . i1=ig,
612 . c1=idtitl)
613 ENDIF
614 IF (iecrou == 7 .AND. ifunc == 0) THEN
616 . msgtype=msgerror,
617 . anmode=aninfo_blind_1,
618 . i1=ig,
619 . c1=idtitl)
620 ELSEIF (iecrou == 7 .AND. ifunc2 == 0) THEN
622 . msgtype=msgwarning,
623 . anmode=aninfo_blind_1,
624 . i1=ig,
625 . c1=idtitl,
626 . i2=iecrou)
627 iecrou = 2
628 ENDIF
629
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
633 . msgtype=msgwarning,
634 . anmode=aninfo_blind_1,
635 . i1=ig,
636 . c1=idtitl)
637 ENDIF
638
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
650
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
657
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
670
671 IF (iecrou == 6) THEN
672 geo(25) = 6
673 ENDIF
674
675 igeo(110) = ifunc
676 igeo(111) = ifv
677 igeo(112) = ifunc2
678 igeo(122) = ifunc3
679
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
691
692
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)
698
699 CALL hm_get_floatv(
'STIFF5',xk,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)
710
711 CALL HM_GET_FLOATV_DIM('min_rup5',CRIT_SCALE,IS_AVAILABLE,LSUBMODEL,UNITAB)
712
713.AND..OR. IF (IECROU == 4 (IFUNC == 0 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.AND. IF (IECROU == 4 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.AND..OR. IF (IECROU == 5 (IFUNC == 0 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.AND..OR. IF (IECROU == 6 (IFUNC == 0 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.AND. IF (IECROU == 7 IFUNC == 0) THEN
742 CALL ANCMSG(MSGID=1058,
743 . MSGTYPE=MSGERROR,
744 . ANMODE=ANINFO_BLIND_1,
745 . I1=IG,
746 . C1=IDTITL)
747.AND. ELSEIF (IECROU == 7 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
756
757 A_WITHOUT_UNIT = A / (FAC_M * FAC_L**2 / FAC_T**2)
758.AND..AND. IF (IFUNC == 0 A /= ZERO 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
765
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
777
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
784
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
797
798 IF (IECROU == 6) THEN
799 GEO(25) = 6
800 ENDIF
801
802 IGEO(113) = IFUNC
803 IGEO(114) = IFV
804 IGEO(115) = IFUNC2
805 IGEO(123) = IFUNC3
806
807.NOT. IF( 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!-----------------
819
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)
825
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)
837
838 CALL HM_GET_FLOATV_DIM('min_rup6',CRIT_SCALE,IS_AVAILABLE,LSUBMODEL,UNITAB)
839
840.AND..OR. IF (IECROU == 4 (IFUNC == 0 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.AND. IF (IECROU == 4 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.AND..OR. IF (IECROU == 5 (IFUNC == 0 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.AND..OR. IF (IECROU == 6 (IFUNC == 0 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.AND. IF (IECROU == 7 IFUNC == 0) THEN
869 CALL ANCMSG(MSGID=1058,
870 . MSGTYPE=MSGERROR,
871 . ANMODE=ANINFO_BLIND_1,
872 . I1=IG,
873 . C1=IDTITL)
874
875.AND. ELSEIF (IECROU == 7 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
884
885 A_WITHOUT_UNIT = A / (FAC_M * FAC_L**2 / FAC_T**2)
886.AND..AND. IF (IFUNC == 0 A /= ZERO 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
893
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
905
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
912
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
925
926 IF (IECROU == 6) THEN
927 GEO(25) = 6
928 ENDIF
929
930 IGEO(116) = IFUNC
931 IGEO(117) = IFV
932 IGEO(118) = IFUNC2
933 IGEO(124) = IFUNC3
934
935.NOT. IF( 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
944
945 IF (ASRATE == ZERO) ASRATE=EP30 / FAC_T
946 GEO(96) = ISRATE
947 GEO(97) = ASRATE
948.NOT. IF( IS_ENCRYPTED)THEN
949 WRITE(IOUT, 1850) ISRATE, ASRATE
950 ENDIF
951
952
953
954
955
956.AND. IF(GEO(39)/=ZEROIGEO( 9)== 0) IGEO( 9)=NINT(GEO(39))
957
958
959
960
961
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
987
988
989 RETURN
990
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/)
1103
1104 RETURN
subroutine damping(nodft, nodlt, v, vr, a, ar, damp, ms, in, igrnod, dim, itask, weight, tagslv_rby, wfext)
end diagonal values have been computed in the(sparse) matrix id.SOL
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)
for(i8=*sizetab-1;i8 >=0;i8--)
integer, parameter nchartitle
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)
character *2 function nl()