OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_prop13.F File Reference
#include "implicit_f.inc"
#include "units_c.inc"
#include "param_c.inc"
#include "com04_c.inc"
#include "sphcom.inc"
#include "tablen_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_prop13 (geo, igeo, ig, unitab, iskn, idtitl, igtyp, prop_tag, lsubmodel, sub_index)

Function/Subroutine Documentation

◆ hm_read_prop13()

subroutine hm_read_prop13 ( geo,
integer, dimension(npropgi) igeo,
integer ig,
type (unit_type_), intent(in) unitab,
integer, dimension(liskn,*) iskn,
character(len=nchartitle) idtitl,
integer igtyp,
type(prop_tag_), dimension(0:maxprop) prop_tag,
type(submodel_data), dimension(*), intent(in) lsubmodel,
integer, intent(in) sub_index )

Definition at line 38 of file hm_read_prop13.F.

40C============================================================================
41C M o d u l e s
42C-----------------------------------------------
43 USE unitab_mod
44 USE message_mod
45 USE elbuftag_mod
46 USE submodel_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,IG
65 INTEGER, INTENT(IN) :: SUB_INDEX
66C REAL
67 my_real geo(npropg)
68 TYPE(PROP_TAG_) , DIMENSION(0:MAXPROP) :: PROP_TAG
69 TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
70 CHARACTER(LEN=NCHARTITLE)::IDTITL
71C-----------------------------------------------
72C L o c a l V a r i a b l e s
73C-----------------------------------------------
74 INTEGER J, IFUNC, IFUNC2,IFUNC3, IECROU, IFV, ISK,
75 . ISENS,IFL,IFAIL,ILENG,IFAIL2,ISRATE,K
76C REAL
77 my_real
78 . a, b, d, e, f, xm, xin, xk, xc, dn, dx, fwv, lscale,
79 . pun,vt0, vr0, cc(6), cn(6), xa(6), xb(6),asrate,gf3,
80 . a_unit,b_unit,d_unit,e_unit,f_unit,
81 . lscale_unit,gf3_unit,vt0_unit,vr0_unit,asr_unit,crit_scale(6)
82 LOGICAL IS_AVAILABLE, IS_ENCRYPTED
83C=======================================================================
84 DATA pun/0.1/
85C=======================================================================
86C
87 pun = em01
88 fwv = zero
89 ifail2 = 0
90 israte = 0
91 asrate = zero
92C
93 is_encrypted = .false.
94 is_available = .false.
95
96C Double stockage temporaire - supprimer GEO(12,I)=IGTYP apres tests
97 igeo( 1)=ig
98 igeo(11)=igtyp
99 geo(12) =igtyp+pun
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_index /= 0 ) isk = lsubmodel(sub_index)%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('Ileng',ileng,is_available,lsubmodel)
114 CALL hm_get_intv('Ifail2',ifail2,is_available,lsubmodel)
115C--------------------------------------------------
116C EXTRACT DATAS (REAL VALUES)
117C--------------------------------------------------
118 CALL hm_get_floatv('MASS',xm,is_available,lsubmodel,unitab)
119 CALL hm_get_floatv('INERTIA',xin,is_available,lsubmodel,unitab)
120C
121 cc(1:6) = zero
122C----
123 IF(xin <= em20) THEN
124 xin = em20
125 CALL ancmsg(msgid=445,
126 . msgtype=msgwarning,
127 . anmode=aninfo_blind_1,
128 . i1=ig,
129 . c1=idtitl)
130 ENDIF
131C
132 IF (ifl == 1) isens=-isens
133C----
134 DO k=0,numskw+min(1,nspcond)*numsph+nsubmod
135 IF (isk == iskn(4,k+1)) THEN
136 isk=k+1
137 GO TO 100
138 ENDIF
139 ENDDO
140 CALL ancmsg(msgid=137,anmode=aninfo,msgtype=msgerror,
141 . c1='PROPERTY',
142 . c2='PROPERTY',
143 . i1=igeo(1),i2=isk,c3=idtitl)
144100 CONTINUE
145C
146 IF (ifail2 /= 1 .AND. ifail2 /= 2 .AND. ifail2 /= 3) ifail2 = 0
147 geo(1) =xm
148 geo(2) =isk+pun
149 igeo(2)=isk
150 geo(8) =4
151 geo(9) =xin
152 igeo(3)=isens
153 geo(79)=ifail
154 geo(80)=ifl
155 geo(93)=ileng
156 geo(95)=ifail2
157C----
158 IF(is_encrypted)THEN
159 WRITE(iout,1000)ig
160 1000 FORMAT(
161 & 5x,'SPRING PROPERTY SET'/,
162 & 5x,'-------------------'/,
163 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
164 & 5x,'CONFIDENTIAL DATA'//)
165 ELSE
166 WRITE(iout,1801)ig,xm,xin,iskn(4,isk),abs(isens),ifl,ifail,ifail2,
167 . ileng
168 ENDIF
169!-------------------------------------------------------
170! Translations
171!-------------------------------------------------------
172!-----------------
173 ! Traction X
174!-----------------
175C--------------------------------------------------
176C EXTRACT DATAS (INTEGER VALUES)
177C--------------------------------------------------
178 CALL hm_get_intv('FUN_A1',ifunc,is_available,lsubmodel)
179 CALL hm_get_intv('HFLAG1',iecrou,is_available,lsubmodel)
180 CALL hm_get_intv('FUN_B1',ifv,is_available,lsubmodel)
181 CALL hm_get_intv('FUN_C1',ifunc2,is_available,lsubmodel)
182 CALL hm_get_intv('FUN_D1',ifunc3,is_available,lsubmodel)
183C--------------------------------------------------
184C EXTRACT DATAS (REAL VALUES)
185C--------------------------------------------------
186 CALL hm_get_floatv('STIFF1',xk,is_available,lsubmodel,unitab)
187 CALL hm_get_floatv('DAMP1',xc,is_available,lsubmodel,unitab)
188 CALL hm_get_floatv('Acoeft1',a,is_available,lsubmodel,unitab)
189 CALL hm_get_floatv('Bcoeft1',b,is_available,lsubmodel,unitab)
190 CALL hm_get_floatv('Dcoeft1',d,is_available,lsubmodel,unitab)
191 CALL hm_get_floatv('MIN_RUP1',dn,is_available,lsubmodel,unitab)
192 CALL hm_get_floatv('MAX_RUP1',dx,is_available,lsubmodel,unitab)
193 CALL hm_get_floatv('Prop_X_F',f,is_available,lsubmodel,unitab)
194 CALL hm_get_floatv('Prop_X_E',e,is_available,lsubmodel,unitab)
195 CALL hm_get_floatv('scale1',lscale,is_available,lsubmodel,unitab)
196 CALL hm_get_floatv('Prop_X_H',gf3,is_available,lsubmodel,unitab)
197 !units for default values
198 CALL hm_get_floatv_dim('Acoeft1',a_unit,is_available,lsubmodel,unitab)
199 CALL hm_get_floatv_dim('Bcoeft1',b_unit,is_available,lsubmodel,unitab)
200 CALL hm_get_floatv_dim('Dcoeft1',d_unit,is_available,lsubmodel,unitab)
201 CALL hm_get_floatv_dim('Prop_X_F',f_unit,is_available,lsubmodel,unitab)
202 CALL hm_get_floatv_dim('Prop_X_E',e_unit,is_available,lsubmodel,unitab)
203 CALL hm_get_floatv_dim('scale1',lscale_unit,is_available,lsubmodel,unitab)
204 CALL hm_get_floatv_dim('Prop_X_H',gf3_unit,is_available,lsubmodel,unitab)
205 CALL hm_get_floatv_dim('MIN_RUP1',crit_scale(1),is_available,lsubmodel,unitab)
206C----
207! IF (IFUNC /= 0 .AND. IECROU >= 1 .AND. XK == ZERO) THEN
208! CALL ANCMSG(MSGID=230,
209! . MSGTYPE=MSGERROR,
210! . ANMODE=ANINFO_BLIND_1,
211! . I1=IG,
212! . C1=IDTITL)
213! ENDIF
214 IF (iecrou == 4 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
215 CALL ancmsg(msgid=231,
216 . msgtype=msgerror,
217 . anmode=aninfo_blind_1,
218 . i1=ig,
219 . c1=idtitl)
220 ENDIF
221 IF (iecrou == 4 .AND. geo(2) == zero) THEN
222 CALL ancmsg(msgid=230,
223 . msgtype=msgerror,
224 . anmode=aninfo_blind_1,
225 . i1=ig,
226 . c1=idtitl)
227 ENDIF
228 IF (iecrou == 5. and. (ifunc == 0 .OR. ifunc2 == 0)) THEN
229 CALL ancmsg(msgid=231,
230 . msgtype=msgerror,
231 . anmode=aninfo_blind_1,
232 . i1=ig,
233 . c1=idtitl)
234 ENDIF
235 IF (iecrou == 6 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
236 CALL ancmsg(msgid=1057,
237 . msgtype=msgerror,
238 . anmode=aninfo_blind_1,
239 . i1=ig,
240 . c1=idtitl)
241 ENDIF
242 IF (iecrou == 7 .AND. ifunc == 0) THEN
243 CALL ancmsg(msgid=1058,
244 . msgtype=msgerror,
245 . anmode=aninfo_blind_1,
246 . i1=ig,
247 . c1=idtitl)
248 ELSEIF (iecrou == 7 .AND. ifunc2 == 0) THEN
249 CALL ancmsg(msgid=1059,
250 . msgtype=msgwarning,
251 . anmode=aninfo_blind_1,
252 . i1=ig,
253 . c1=idtitl,
254 . i2=iecrou)
255 iecrou = 2
256 ENDIF
257 IF (ifunc == 0 .AND. a /= zero .AND. a /= one) THEN
258 CALL ancmsg(msgid=663,
259 . msgtype=msgwarning,
260 . anmode=aninfo_blind_1,
261 . i1=ig,
262 . c1=idtitl)
263 ENDIF
264C----
265 IF (a == zero) a = one * a_unit
266 IF (d == zero) d = one * d_unit
267 IF (e == zero) e = one * e_unit
268 IF (f == zero) f = one * f_unit
269 IF (lscale == zero) lscale = one * lscale_unit
270 IF (gf3 == zero) gf3 = one * gf3_unit
271 IF (ifunc == 0) THEN
272 a = one
273 b = zero
274 e = zero
275 ENDIF
276C
277 IF ((ifail2 == 0).OR.(ifail2 ==1)) THEN
278 dn = dn * lscale / crit_scale(1)
279 dx = dx * lscale / crit_scale(1)
280 ENDIF
281 IF (dn == zero) dn=-ep30* crit_scale(1)
282 IF (dx == zero) dx= ep30* crit_scale(1)
283 IF ((ifail2 == 0).OR.(ifail2 ==1)) crit_scale(1) = lscale / crit_scale(1)
284C----
285 geo(41) = a
286 geo(42) = b
287 geo(43) = d
288 geo(40) = e
289 geo(132)= gf3
290 geo(44) = one / f
291 geo(39) = one / lscale
292 geo(65) = dn
293 geo(66) = dx
294 geo(87) = fwv
295 geo(3) = xk / a
296 geo(4) = xc
297 geo(7) = iecrou+pun
298C-- If H=6 - additional internal variables must be stored in UVAR - - GEO(25) = NUVAR
299 IF (iecrou == 6) THEN
300 geo(25) = 6
301 ENDIF
302C
303 igeo(101) = ifunc
304 igeo(102) = ifv
305 igeo(103) = ifunc2
306 igeo(119) = ifunc3
307C----
308 IF (.NOT. is_encrypted) THEN
309 IF (iecrou /= 5) THEN
310 IF (ifail2 == 3) THEN
311 WRITE(iout,1813)'TENSION',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
312 . a,b,d,e,gf3,ifv,ifunc3,dx
313 ELSEIF (ifail2 == 2) THEN
314 WRITE(iout,1812)'TENSION',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
315 . a,b,d,e,gf3,ifv,ifunc3,dn,dx
316 ELSE
317 WRITE(iout,1810)'TENSION',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
318 . a,b,d,e,gf3,ifv,ifunc3,dn,dx
319 ENDIF ! IF (IFAIL2 == 3)
320 ELSE
321 IF (ifail2 == 3) THEN
322 WRITE(iout,1823)'TENSION',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
323 . a,b,d,e,gf3,ifv,ifunc3,dx
324 ELSEIF (ifail2 == 2) THEN
325 WRITE(iout,1822)'TENSION',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
326 . a,b,d,e,gf3,ifv,ifunc3,dn,dx
327 ELSE
328 WRITE(iout,1820)'TENSION',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
329 . a,b,d,e,gf3,ifv,ifunc3,dn,dx
330 ENDIF ! IF (IFAIL2 == 3)
331 ENDIF ! IF (IECROU /= 5)
332 ENDIF
333!-----------------
334 ! Shear XY
335!-----------------
336C--------------------------------------------------
337C EXTRACT DATAS (INTEGER VALUES)
338C--------------------------------------------------
339 CALL hm_get_intv('FUN_A2',ifunc,is_available,lsubmodel)
340 CALL hm_get_intv('HFLAG2',iecrou,is_available,lsubmodel)
341 CALL hm_get_intv('FUN_B2',ifv,is_available,lsubmodel)
342 CALL hm_get_intv('FUN_C2',ifunc2,is_available,lsubmodel)
343 CALL hm_get_intv('FUN_D2',ifunc3,is_available,lsubmodel)
344C--------------------------------------------------
345C EXTRACT DATAS (REAL VALUES)
346C--------------------------------------------------
347 CALL hm_get_floatv('STIFF2',xk,is_available,lsubmodel,unitab)
348 CALL hm_get_floatv('DAMP2',xc,is_available,lsubmodel,unitab)
349 CALL hm_get_floatv('Acoeft2',a,is_available,lsubmodel,unitab)
350 CALL hm_get_floatv('Bcoeft2',b,is_available,lsubmodel,unitab)
351 CALL hm_get_floatv('Dcoeft2',d,is_available,lsubmodel,unitab)
352 CALL hm_get_floatv('MIN_RUP2',dn,is_available,lsubmodel,unitab)
353 CALL hm_get_floatv('MAX_RUP2',dx,is_available,lsubmodel,unitab)
354 CALL hm_get_floatv('Prop_Y_F',f,is_available,lsubmodel,unitab)
355 CALL hm_get_floatv('Prop_Y_E',e,is_available,lsubmodel,unitab)
356 CALL hm_get_floatv('scale2',lscale,is_available,lsubmodel,unitab)
357 CALL hm_get_floatv('Prop_Y_H',gf3,is_available,lsubmodel,unitab)
358C
359 CALL hm_get_floatv_dim('MIN_RUP2',crit_scale(2),is_available,lsubmodel,unitab)
360
361C----
362! IF (IFUNC /= 0 .AND. IECROU >= 1 .AND. XK == ZERO) THEN
363! CALL ANCMSG(MSGID=230,
364! . MSGTYPE=MSGERROR,
365! . ANMODE=ANINFO_BLIND_1,
366! . I1=IG,
367! . C1=IDTITL)
368! ENDIF
369 IF (iecrou == 4 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
370 CALL ancmsg(msgid=231,
371 . msgtype=msgerror,
372 . anmode=aninfo_blind_1,
373 . i1=ig,
374 . c1=idtitl)
375 ENDIF
376 IF (iecrou == 4 .AND. geo(2) == zero)THEN
377 CALL ancmsg(msgid=230,
378 . msgtype=msgerror,
379 . anmode=aninfo_blind_1,
380 . i1=ig,
381 . c1=idtitl)
382 ENDIF
383 IF (iecrou == 5 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
384 CALL ancmsg(msgid=231,
385 . msgtype=msgerror,
386 . anmode=aninfo_blind_1,
387 . i1=ig,
388 . c1=idtitl)
389 ENDIF
390 IF (iecrou == 6 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
391 CALL ancmsg(msgid=1057,
392 . msgtype=msgerror,
393 . anmode=aninfo_blind_1,
394 . i1=ig,
395 . c1=idtitl)
396 ENDIF
397 IF (iecrou == 7 .AND. ifunc == 0) THEN
398 CALL ancmsg(msgid=1058,
399 . msgtype=msgerror,
400 . anmode=aninfo_blind_1,
401 . i1=ig,
402 . c1=idtitl)
403 ELSEIF (iecrou == 7 .AND. ifunc2 == 0) THEN
404 CALL ancmsg(msgid=1059,
405 . msgtype=msgwarning,
406 . anmode=aninfo_blind_1,
407 . i1=ig,
408 . c1=idtitl,
409 . i2=iecrou)
410 iecrou = 2
411 ENDIF
412 IF (ifunc == 0 .AND. a /= zero .AND. a /= one) THEN
413 CALL ancmsg(msgid=663,
414 . msgtype=msgwarning,
415 . anmode=aninfo_blind_1,
416 . i1=ig,
417 . c1=idtitl)
418 ENDIF
419C----
420 IF (a == zero) a = one * a_unit
421 IF (d == zero) d = one * d_unit
422 IF (e == zero) e = one * e_unit
423 IF (f == zero) f = one * f_unit
424 IF (lscale == zero) lscale = one * lscale_unit
425 IF (gf3 == zero) gf3 = one * gf3_unit
426 IF (ifunc == 0) THEN
427 a = one
428 b = zero
429 e = zero
430 ENDIF
431C
432 IF ((ifail2 == 0).OR.(ifail2 ==1)) THEN
433 dn = dn * lscale / crit_scale(2)
434 dx = dx * lscale / crit_scale(2)
435 ENDIF
436 IF (dn == zero) dn=-ep30* crit_scale(2)
437 IF (dx == zero) dx= ep30* crit_scale(2)
438 IF ((ifail2 == 0).OR.(ifail2 ==1)) crit_scale(2) = lscale / crit_scale(2)
439C----
440 geo(45) = a
441 geo(46) = b
442 geo(47) = d
443 geo(180)= e
444 geo(133)= gf3
445 geo(48) = one / f
446 geo(174)= one / lscale
447 geo(67) = dn
448 geo(68) = dx
449 geo(88) = fwv
450 geo(10) = xk / a
451 geo(11) = xc
452 geo(14) = iecrou+pun
453C-- If H=6 - additional internal variables must be stored in UVAR - - GEO(25) = NUVAR
454 IF (iecrou == 6) THEN
455 geo(25) = 6
456 ENDIF
457C
458 igeo(104) = ifunc
459 igeo(105) = ifv
460 igeo(106) = ifunc2
461 igeo(120) = ifunc3
462C----
463 IF (.NOT. is_encrypted) THEN
464 IF (iecrou /= 5) THEN
465 IF (ifail2 == 3) THEN
466 WRITE(iout,1813)'Y SHEAR',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
467 . a,b,d,e,gf3,ifv,ifunc3,dx
468 ELSEIF (ifail2 == 2) THEN
469 WRITE(iout,1812)'Y SHEAR',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
470 . a,b,d,e,gf3,ifv,ifunc3,dn,dx
471 ELSE
472 WRITE(iout,1810)'Y SHEAR',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
473 . a,b,d,e,gf3,ifv,ifunc3,dn,dx
474 ENDIF ! IF (IFAIL2 == 3)
475 ELSE
476 IF (ifail2 == 3) THEN
477 WRITE(iout,1823)'Y SHEAR',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
478 . a,b,d,e,gf3,ifv,ifunc3,dx
479 ELSEIF (ifail2 == 2) THEN
480 WRITE(iout,1822)'Y SHEAR',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
481 . a,b,d,e,gf3,ifv,ifunc3,dn,dx
482 ELSE
483 WRITE(iout,1820)'Y SHEAR',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
484 . a,b,d,e,gf3,ifv,ifunc3,dn,dx
485 ENDIF ! IF (IFAIL2 == 3)
486 ENDIF ! IF (IECROU /= 5)
487 ENDIF
488!-----------------
489 ! Shear XZ
490!-----------------
491C--------------------------------------------------
492C EXTRACT DATAS (INTEGER VALUES)
493C--------------------------------------------------
494 CALL hm_get_intv('FUN_A3',ifunc,is_available,lsubmodel)
495 CALL hm_get_intv('HFLAG3',iecrou,is_available,lsubmodel)
496 CALL hm_get_intv('FUN_B3',ifv,is_available,lsubmodel)
497 CALL hm_get_intv('FUN_C3',ifunc2,is_available,lsubmodel)
498 CALL hm_get_intv('FUN_D3',ifunc3,is_available,lsubmodel)
499C--------------------------------------------------
500C EXTRACT DATAS (REAL VALUES)
501C--------------------------------------------------
502 CALL hm_get_floatv('STIFF3',xk,is_available,lsubmodel,unitab)
503 CALL hm_get_floatv('DAMP3',xc,is_available,lsubmodel,unitab)
504 CALL hm_get_floatv('Acoeft3',a,is_available,lsubmodel,unitab)
505 CALL hm_get_floatv('Bcoeft3',b,is_available,lsubmodel,unitab)
506 CALL hm_get_floatv('Dcoeft3',d,is_available,lsubmodel,unitab)
507 CALL hm_get_floatv('MIN_RUP3',dn,is_available,lsubmodel,unitab)
508 CALL hm_get_floatv('MAX_RUP3',dx,is_available,lsubmodel,unitab)
509 CALL hm_get_floatv('Prop_Z_F',f,is_available,lsubmodel,unitab)
510 CALL hm_get_floatv('Prop_Z_E',e,is_available,lsubmodel,unitab)
511 CALL hm_get_floatv('scale3',lscale,is_available,lsubmodel,unitab)
512 CALL hm_get_floatv('Prop_Z_H',gf3,is_available,lsubmodel,unitab)
513C
514 CALL hm_get_floatv_dim('MIN_RUP3',crit_scale(3),is_available,lsubmodel,unitab)
515C
516C----
517! IF (IFUNC /= 0 .AND. IECROU >= 1 .AND. XK == ZERO) THEN
518! CALL ANCMSG(MSGID=230,
519! . MSGTYPE=MSGERROR,
520! . ANMODE=ANINFO_BLIND_1,
521! . I1=IG,
522! . C1=IDTITL)
523! ENDIF
524 IF (iecrou == 4 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
525 CALL ancmsg(msgid=231,
526 . msgtype=msgerror,
527 . anmode=aninfo_blind_1,
528 . i1=ig,
529 . c1=idtitl)
530 ENDIF
531 IF (iecrou == 4 .AND. geo(2) == zero) THEN
532 CALL ancmsg(msgid=230,
533 . msgtype=msgerror,
534 . anmode=aninfo_blind_1,
535 . i1=ig,
536 . c1=idtitl)
537 ENDIF
538 IF (iecrou == 5 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
539 CALL ancmsg(msgid=231,
540 . msgtype=msgerror,
541 . anmode=aninfo_blind_1,
542 . i1=ig,
543 . c1=idtitl)
544 ENDIF
545 IF (iecrou == 6 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
546 CALL ancmsg(msgid=1057,
547 . msgtype=msgerror,
548 . anmode=aninfo_blind_1,
549 . i1=ig,
550 . c1=idtitl)
551 ENDIF
552 IF (iecrou == 7 .AND. ifunc == 0) THEN
553 CALL ancmsg(msgid=1058,
554 . msgtype=msgerror,
555 . anmode=aninfo_blind_1,
556 . i1=ig,
557 . c1=idtitl)
558 ELSEIF (iecrou == 7 .AND. ifunc2 == 0) THEN
559 CALL ancmsg(msgid=1059,
560 . msgtype=msgwarning,
561 . anmode=aninfo_blind_1,
562 . i1=ig,
563 . c1=idtitl,
564 . i2=iecrou)
565 iecrou = 2
566 ENDIF
567 IF (ifunc == 0 .AND. a /= zero .AND. a /= one) THEN
568 CALL ancmsg(msgid=663,
569 . msgtype=msgwarning,
570 . anmode=aninfo_blind_1,
571 . i1=ig,
572 . c1=idtitl)
573 ENDIF
574C----
575 IF (a == zero) a = one * a_unit
576 IF (d == zero) d = one * d_unit
577 IF (e == zero) e = one * e_unit
578 IF (f == zero) f = one * f_unit
579 IF (lscale == zero) lscale = one * lscale_unit
580 IF (gf3 == zero) gf3 = one * gf3_unit
581 IF (ifunc == 0) THEN
582 a = one
583 b = zero
584 e = zero
585 ENDIF
586C
587 IF ((ifail2 == 0).OR.(ifail2 ==1)) THEN
588 dn = dn * lscale / crit_scale(3)
589 dx = dx * lscale / crit_scale(3)
590 ENDIF
591 IF (dn == zero) dn=-ep30* crit_scale(3)
592 IF (dx == zero) dx= ep30* crit_scale(3)
593 IF ((ifail2 == 0).OR.(ifail2 ==1)) crit_scale(3) = lscale / crit_scale(3)
594C----
595 geo(49) = a
596 geo(50) = b
597 geo(51) = d
598 geo(181)= e
599 geo(134)= gf3
600 geo(52) = one / f
601 geo(175)= one / lscale
602 geo(69) = dn
603 geo(77) = dx
604 geo(89) = fwv
605 geo(15) = xk / a
606 geo(16) = xc
607 geo(18) = iecrou+pun
608C-- If H=6 - additional internal variables must be stored in UVAR - - GEO(25) = NUVAR
609 IF (iecrou == 6) THEN
610 geo(25) = 6
611 ENDIF
612C
613 igeo(107) = ifunc
614 igeo(108) = ifv
615 igeo(109) = ifunc2
616 igeo(121) = ifunc3
617C----
618 IF (.NOT. is_encrypted) THEN
619 IF (iecrou /= 5) THEN
620 IF (ifail2 == 3) THEN
621 WRITE(iout,1813)'Z SHEAR',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
622 . a,b,d,e,gf3,ifv,ifunc3,dx
623 ELSEIF (ifail2 == 2) THEN
624 WRITE(iout,1812)'Z SHEAR',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
625 . a,b,d,e,gf3,ifv,ifunc3,dn,dx
626 ELSE
627 WRITE(iout,1810)'Z SHEAR',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
628 . a,b,d,e,gf3,ifv,ifunc3,dn,dx
629 ENDIF ! IF (IFAIL2 == 3)
630 ELSE
631 IF (ifail2 == 3) THEN
632 WRITE(iout,1823)'Z SHEAR',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
633 . a,b,d,e,gf3,ifv,ifunc3,dx
634 ELSEIF (ifail2 == 2) THEN
635 WRITE(iout,1822)'Z SHEAR',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
636 . a,b,d,e,gf3,ifv,ifunc3,dn,dx
637 ELSE
638 WRITE(iout,1820)'Z SHEAR',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
639 . a,b,d,e,gf3,ifv,ifunc3,dn,dx
640 ENDIF ! IF (IFAIL2 == 3)
641 ENDIF ! IF (IECROU /= 5)
642 ENDIF
643 IF (xm <= em20) THEN
644 geo(1) = em20
645 CALL ancmsg(msgid=444,
646 . msgtype=msgwarning,
647 . anmode=aninfo_blind_1,
648 . i1=ig,
649 . c1=idtitl)
650 ENDIF
651!-------------------------------------------------------
652! Rotations
653!-------------------------------------------------------
654!-----------------
655 ! Torsion X
656!-----------------
657C--------------------------------------------------
658C EXTRACT DATAS (INTEGER VALUES)
659C--------------------------------------------------
660 CALL hm_get_intv('FUN_A4',ifunc,is_available,lsubmodel)
661 CALL hm_get_intv('HFLAG4',iecrou,is_available,lsubmodel)
662 CALL hm_get_intv('FUN_B4',ifv,is_available,lsubmodel)
663 CALL hm_get_intv('FUN_C4',ifunc2,is_available,lsubmodel)
664 CALL hm_get_intv('FUN_D4',ifunc3,is_available,lsubmodel)
665C--------------------------------------------------
666C EXTRACT DATAS (REAL VALUES)
667C--------------------------------------------------
668 CALL hm_get_floatv('STIFF4',xk,is_available,lsubmodel,unitab)
669 CALL hm_get_floatv('DAMP4',xc,is_available,lsubmodel,unitab)
670 CALL hm_get_floatv('Acoeft4',a,is_available,lsubmodel,unitab)
671 CALL hm_get_floatv('Bcoeft4',b,is_available,lsubmodel,unitab)
672 CALL hm_get_floatv('Dcoeft4',d,is_available,lsubmodel,unitab)
673 CALL hm_get_floatv('MIN_RUP4',dn,is_available,lsubmodel,unitab)
674 CALL hm_get_floatv('MAX_RUP4',dx,is_available,lsubmodel,unitab)
675 CALL hm_get_floatv('Prop_Tor_F',f,is_available,lsubmodel,unitab)
676 CALL hm_get_floatv('Prop_Tor_E',e,is_available,lsubmodel,unitab)
677 CALL hm_get_floatv('scale4',lscale,is_available,lsubmodel,unitab)
678 CALL hm_get_floatv('Prop_Tor_H',gf3,is_available,lsubmodel,unitab)
679 !units for default values
680 CALL hm_get_floatv_dim('Acoeft4',a_unit,is_available,lsubmodel,unitab)
681 CALL hm_get_floatv_dim('Bcoeft4',b_unit,is_available,lsubmodel,unitab)
682 CALL hm_get_floatv_dim('Dcoeft4',d_unit,is_available,lsubmodel,unitab)
683 CALL hm_get_floatv_dim('Prop_Tor_F',f_unit,is_available,lsubmodel,unitab)
684 CALL hm_get_floatv_dim('Prop_Tor_E',e_unit,is_available,lsubmodel,unitab)
685 CALL hm_get_floatv_dim('scale4',lscale_unit,is_available,lsubmodel,unitab)
686 CALL hm_get_floatv_dim('Prop_Tor_H',gf3_unit,is_available,lsubmodel,unitab)
687 CALL hm_get_floatv_dim('MIN_RUP4',crit_scale(4),is_available,lsubmodel,unitab)
688C
689C----
690! IF(IFUNC/=0.AND.IECROU>=1.AND.XK == ZERO)THEN
691! CALL ANCMSG(MSGID=230,
692! . MSGTYPE=MSGERROR,
693! . ANMODE=ANINFO_BLIND_1,
694! . I1=IG,
695! . C1=IDTITL)
696! ENDIF
697 IF (iecrou == 4 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
698 CALL ancmsg(msgid=231,
699 . msgtype=msgerror,
700 . anmode=aninfo_blind_1,
701 . i1=ig,
702 . c1=idtitl)
703 ENDIF
704 IF (iecrou == 4. and. geo(2) == zero) THEN
705 CALL ancmsg(msgid=230,
706 . msgtype=msgerror,
707 . anmode=aninfo_blind_1,
708 . i1=ig,
709 . c1=idtitl)
710 ENDIF
711 IF (iecrou == 5 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
712 CALL ancmsg(msgid=231,
713 . msgtype=msgerror,
714 . anmode=aninfo_blind_1,
715 . i1=ig,
716 . c1=idtitl)
717 ENDIF
718 IF (iecrou == 6 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
719 CALL ancmsg(msgid=1057,
720 . msgtype=msgerror,
721 . anmode=aninfo_blind_1,
722 . i1=ig,
723 . c1=idtitl)
724 ENDIF
725 IF (iecrou == 7 .AND. ifunc == 0) THEN
726 CALL ancmsg(msgid=1058,
727 . msgtype=msgerror,
728 . anmode=aninfo_blind_1,
729 . i1=ig,
730 . c1=idtitl)
731 ELSEIF (iecrou == 7 .AND. ifunc2 == 0) THEN
732 CALL ancmsg(msgid=1059,
733 . msgtype=msgwarning,
734 . anmode=aninfo_blind_1,
735 . i1=ig,
736 . c1=idtitl,
737 . i2=iecrou)
738 iecrou = 2
739 ENDIF
740 IF (ifunc == 0 .AND. a /= zero .AND. a /= one) THEN
741 CALL ancmsg(msgid=663,
742 . msgtype=msgwarning,
743 . anmode=aninfo_blind_1,
744 . i1=ig,
745 . c1=idtitl)
746 ENDIF
747C----
748 IF (a == zero) a = one * a_unit
749 IF (d == zero) d = one * d_unit
750 IF (e == zero) e = one * e_unit
751 IF (f == zero) f = one * f_unit
752 IF (lscale == zero) lscale = one * lscale_unit
753 IF (gf3 == zero) gf3 = one * gf3_unit
754 IF (ifunc == 0) THEN
755 a = one
756 b = zero
757 e = zero
758 ENDIF
759C
760 IF ((ifail2 == 0).OR.(ifail2 ==1)) THEN
761 dn = dn * lscale / crit_scale(4)
762 dx = dx * lscale / crit_scale(4)
763 ENDIF
764 IF (dn == zero) dn=-ep30* crit_scale(4)
765 IF (dx == zero) dx= ep30* crit_scale(4)
766 IF ((ifail2 == 0).OR.(ifail2 ==1)) crit_scale(4) = lscale / crit_scale(4)
767C----
768 geo(53) = a
769 geo(54) = b
770 geo(55) = d
771 geo(182) = e
772 geo(135) = gf3
773 geo(56) = one / f
774 geo(176) = one / lscale
775 geo(71) = dn
776 geo(72) = dx
777 geo(19) = xk / a
778 geo(20) = xc
779 geo(22) = iecrou+pun
780C-- If H=6 - additional internal variables must be stored in UVAR - - GEO(25) = NUVAR
781 IF (iecrou == 6) THEN
782 geo(25) = 6
783 ENDIF
784C
785 igeo(110) = ifunc
786 igeo(111) = ifv
787 igeo(112) = ifunc2
788 igeo(122) = ifunc3
789C----
790 IF (.NOT. is_encrypted) THEN
791 IF (iecrou /= 5) THEN
792 IF (ifail2 == 3) THEN
793 WRITE(iout,1833)'TORSION',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
794 . a,b,d,e,gf3,ifv,ifunc3,dx
795 ELSEIF (ifail2 == 2) THEN
796 WRITE(iout,1832)'TORSION',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
797 . a,b,d,e,gf3,ifv,ifunc3,dn,dx
798 ELSE
799 WRITE(iout,1830)'TORSION',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
800 . a,b,d,e,gf3,ifv,ifunc3,dn,dx
801 ENDIF ! IF (IFAIL2 == 3)
802 ELSE
803 IF (ifail2 == 3) THEN
804 WRITE(iout,1843)'TORSION',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
805 . a,b,d,e,gf3,ifv,ifunc3,dx
806 ELSEIF (ifail2 == 2) THEN
807 WRITE(iout,1842)'TORSION',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
808 . a,b,d,e,gf3,ifv,ifunc3,dn,dx
809 ELSE
810 WRITE(iout,1840)'TORSION',xk,xc,ifunc,lscale,ifunc2,f,iecrou,
811 . a,b,d,e,gf3,ifv,ifunc3,dn,dx
812 ENDIF ! IF (IFAIL2 == 3)
813 ENDIF ! IF (IECROU /= 5)
814 ENDIF
815!-----------------
816 ! Rotation Y
817!-----------------
818C--------------------------------------------------
819C EXTRACT DATAS (INTEGER VALUES)
820C--------------------------------------------------
821 CALL hm_get_intv('FUN_A5',ifunc,is_available,lsubmodel)
822 CALL hm_get_intv('HFLAG5',iecrou,is_available,lsubmodel)
823 CALL hm_get_intv('FUN_B5',ifv,is_available,lsubmodel)
824 CALL hm_get_intv('FUN_C5',ifunc2,is_available,lsubmodel)
825 CALL hm_get_intv('FUN_D5',ifunc3,is_available,lsubmodel)
826C--------------------------------------------------
827C EXTRACT DATAS (REAL VALUES)
828C--------------------------------------------------
829 CALL hm_get_floatv('STIFF5',xk,is_available,lsubmodel,unitab)
830 CALL hm_get_floatv('DAMP5',xc,is_available,lsubmodel,unitab)
831 CALL hm_get_floatv('Acoeft5',a,is_available,lsubmodel,unitab)
832 CALL hm_get_floatv('Bcoeft5',b,is_available,lsubmodel,unitab)
833 CALL hm_get_floatv('Dcoeft5',d,is_available,lsubmodel,unitab)
834 CALL hm_get_floatv('MIN_RUP5',dn,is_available,lsubmodel,unitab)
835 CALL hm_get_floatv('MAX_RUP5',dx,is_available,lsubmodel,unitab)
836 CALL hm_get_floatv('Prop_FlxY_F',f,is_available,lsubmodel,unitab)
837 CALL hm_get_floatv('Prop_FlxY_E',e,is_available,lsubmodel,unitab)
838 CALL hm_get_floatv('scale5',lscale,is_available,lsubmodel,unitab)
839 CALL hm_get_floatv('Prop_FlxY_H',gf3,is_available,lsubmodel,unitab)
840 CALL hm_get_floatv_dim('MIN_RUP5',crit_scale(5),is_available,lsubmodel,unitab)
841C
842C----
843! IF (IFUNC /= 0 .AND. IECROU >= 1 .AND. XK == ZERO) THEN
844! CALL ANCMSG(MSGID=230,
845! . MSGTYPE=MSGERROR,
846! . ANMODE=ANINFO_BLIND_1,
847! . I1=IG,
848! . C1=IDTITL)
849! ENDIF
850 IF (iecrou == 4 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
851 CALL ancmsg(msgid=231,
852 . msgtype=msgerror,
853 . anmode=aninfo_blind_1,
854 . i1=ig,
855 . c1=idtitl)
856 ENDIF
857 IF (iecrou == 4 .AND. geo(2) == zero) THEN
858 CALL ancmsg(msgid=230,
859 . msgtype=msgerror,
860 . anmode=aninfo_blind_1,
861 . i1=ig,
862 . c1=idtitl)
863 ENDIF
864 IF (iecrou == 5 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
865 CALL ancmsg(msgid=231,
866 . msgtype=msgerror,
867 . anmode=aninfo_blind_1,
868 . i1=ig,
869 . c1=idtitl)
870 ENDIF
871 IF (iecrou == 6 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
872 CALL ancmsg(msgid=1057,
873 . msgtype=msgerror,
874 . anmode=aninfo_blind_1,
875 . i1=ig,
876 . c1=idtitl)
877 ENDIF
878 IF (iecrou == 7 .AND. ifunc == 0) THEN
879 CALL ancmsg(msgid=1058,
880 . msgtype=msgerror,
881 . anmode=aninfo_blind_1,
882 . i1=ig,
883 . c1=idtitl)
884 ELSEIF (iecrou == 7 .AND. ifunc2 == 0) THEN
885 CALL ancmsg(msgid=1059,
886 . msgtype=msgwarning,
887 . anmode=aninfo_blind_1,
888 . i1=ig,
889 . c1=idtitl,
890 . i2=iecrou)
891 iecrou = 2
892 ENDIF
893 IF (ifunc == 0 .AND. a /= zero .AND. a /= one) THEN
894 CALL ancmsg(msgid=663,
895 . msgtype=msgwarning,
896 . anmode=aninfo_blind_1,
897 . i1=ig,
898 . c1=idtitl)
899 ENDIF
900C----
901 IF (a == zero) a = one * a_unit
902 IF (d == zero) d = one * d_unit
903 IF (e == zero) e = one * e_unit
904 IF (f == zero) f = one * f_unit
905 IF (lscale == zero) lscale = one * lscale_unit
906 IF (gf3 == zero) gf3 = one * gf3_unit
907 IF (ifunc == 0) THEN
908 a = one
909 b = zero
910 e = zero
911 ENDIF
912C
913 IF ((ifail2 == 0).OR.(ifail2 ==1)) THEN
914 dn = dn * lscale / crit_scale(5)
915 dx = dx * lscale / crit_scale(5)
916 ENDIF
917 IF (dn == zero) dn=-ep30* crit_scale(5)
918 IF (dx == zero) dx= ep30* crit_scale(5)
919 IF ((ifail2 == 0).OR.(ifail2 ==1)) crit_scale(5) = lscale / crit_scale(5)
920C----
921 geo(57) = a
922 geo(58) = b
923 geo(59) = d
924 geo(183) = e
925 geo(136) = gf3
926 geo(60) = one / f
927 geo(177) = one / lscale
928 geo(73) = dn
929 geo(74) = dx
930 geo(23) = xk / a
931 geo(24) = xc
932 geo(26) = iecrou+pun
933C-- If H=6 - additional internal variables must be stored in UVAR - - GEO(25) = NUVAR
934 IF (iecrou == 6) THEN
935 geo(25) = 6
936 ENDIF
937C
938 igeo(113) = ifunc
939 igeo(114) = ifv
940 igeo(115) = ifunc2
941 igeo(123) = ifunc3
942C----
943 IF (.NOT. is_encrypted) THEN
944 IF (iecrou /= 5) THEN
945 IF (ifail2 == 3) THEN
946 WRITE(iout,1833)'Y FLEXION',xk,xc,ifunc,lscale,ifunc2,f,
947 . iecrou,a,b,d,e,gf3,ifv,ifunc3,dx
948 ELSEIF (ifail2 == 2) THEN
949 WRITE(iout,1832)'Y FLEXION',xk,xc,ifunc,lscale,ifunc2,f,
950 . iecrou,a,b,d,e,gf3,ifv,ifunc3,dn,dx
951 ELSE
952 WRITE(iout,1830)'Y FLEXION',xk,xc,ifunc,lscale,ifunc2,f,
953 . iecrou,a,b,d,e,gf3,ifv,ifunc3,dn,dx
954 ENDIF ! IF (IFAIL2 == 3)
955 ELSE
956 IF (ifail2 == 3) THEN
957 WRITE(iout,1843)'Y FLEXION',xk,xc,ifunc,lscale,ifunc2,f,
958 . iecrou,a,b,d,e,gf3,ifv,ifunc3,dx
959 ELSEIF (ifail2 == 2) THEN
960 WRITE(iout,1842)'Y FLEXION',xk,xc,ifunc,lscale,ifunc2,f,
961 . iecrou,a,b,d,e,gf3,ifv,ifunc3,dn,dx
962 ELSE
963 WRITE(iout,1840)'Y FLEXION',xk,xc,ifunc,lscale,ifunc2,f,
964 . iecrou,a,b,d,e,gf3,ifv,ifunc3,dn,dx
965 ENDIF ! IF (IFAIL2 == 3)
966 ENDIF ! IF (IECROU /= 5)
967 ENDIF
968!-----------------
969 ! Rotation Z
970!-----------------
971C--------------------------------------------------
972C EXTRACT DATAS (INTEGER VALUES)
973C--------------------------------------------------
974 CALL hm_get_intv('FUN_A6',ifunc,is_available,lsubmodel)
975 CALL hm_get_intv('HFLAG6',iecrou,is_available,lsubmodel)
976 CALL hm_get_intv('FUN_B6',ifv,is_available,lsubmodel)
977 CALL hm_get_intv('FUN_C6',ifunc2,is_available,lsubmodel)
978 CALL hm_get_intv('FUN_D6',ifunc3,is_available,lsubmodel)
979C--------------------------------------------------
980C EXTRACT DATAS (REAL VALUES)
981C--------------------------------------------------
982 CALL hm_get_floatv('STIFF6',xk,is_available,lsubmodel,unitab)
983 CALL hm_get_floatv('DAMP6',xc,is_available,lsubmodel,unitab)
984 CALL hm_get_floatv('Acoeft6',a,is_available,lsubmodel,unitab)
985 CALL hm_get_floatv('Bcoeft6',b,is_available,lsubmodel,unitab)
986 CALL hm_get_floatv('Dcoeft6',d,is_available,lsubmodel,unitab)
987 CALL hm_get_floatv('MIN_RUP6',dn,is_available,lsubmodel,unitab)
988 CALL hm_get_floatv('MAX_RUP6',dx,is_available,lsubmodel,unitab)
989 CALL hm_get_floatv('Prop_FlxZ_F',f,is_available,lsubmodel,unitab)
990 CALL hm_get_floatv('Prop_FlxZ_E',e,is_available,lsubmodel,unitab)
991 CALL hm_get_floatv('scale6',lscale,is_available,lsubmodel,unitab)
992 CALL hm_get_floatv('Prop_FlxZ_H',gf3,is_available,lsubmodel,unitab)
993 CALL hm_get_floatv_dim('MIN_RUP6',crit_scale(6),is_available,lsubmodel,unitab)
994C
995C----
996! IF (IFUNC /= 0 .AND. IECROU >= 1 .AND. XK == ZERO) THEN
997! CALL ANCMSG(MSGID=230,
998! . MSGTYPE=MSGERROR,
999! . ANMODE=ANINFO_BLIND_1,
1000! . I1=IG,
1001! . C1=IDTITL)
1002! ENDIF
1003 IF (iecrou == 4 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
1004 CALL ancmsg(msgid=231,
1005 . msgtype=msgerror,
1006 . anmode=aninfo_blind_1,
1007 . i1=ig,
1008 . c1=idtitl)
1009 ENDIF
1010 IF (iecrou == 4 .AND. geo(2) == zero) THEN
1011 CALL ancmsg(msgid=230,
1012 . msgtype=msgerror,
1013 . anmode=aninfo_blind_1,
1014 . i1=ig,
1015 . c1=idtitl)
1016 ENDIF
1017 IF (iecrou == 5 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
1018 CALL ancmsg(msgid=231,
1019 . msgtype=msgerror,
1020 . anmode=aninfo_blind_1,
1021 . i1=ig,
1022 . c1=idtitl)
1023 ENDIF
1024 IF (iecrou == 6 .AND. (ifunc == 0 .OR. ifunc2 == 0)) THEN
1025 CALL ancmsg(msgid=1057,
1026 . msgtype=msgerror,
1027 . anmode=aninfo_blind_1,
1028 . i1=ig,
1029 . c1=idtitl)
1030 ENDIF
1031 IF (iecrou == 7 .AND. ifunc == 0) THEN
1032 CALL ancmsg(msgid=1058,
1033 . msgtype=msgerror,
1034 . anmode=aninfo_blind_1,
1035 . i1=ig,
1036 . c1=idtitl)
1037 ELSEIF (iecrou == 7 .AND. ifunc2 == 0) THEN
1038 CALL ancmsg(msgid=1059,
1039 . msgtype=msgwarning,
1040 . anmode=aninfo_blind_1,
1041 . i1=ig,
1042 . c1=idtitl,
1043 . i2=iecrou)
1044 iecrou = 2
1045 ENDIF
1046 IF (ifunc == 0 .AND. a /= zero .AND. a /= one) THEN
1047 CALL ancmsg(msgid=663,
1048 . msgtype=msgwarning,
1049 . anmode=aninfo_blind_1,
1050 . i1=ig,
1051 . c1=idtitl)
1052 ENDIF
1053C----
1054 IF (a == zero) a = one * a_unit
1055 IF (d == zero) d = one * d_unit
1056 IF (e == zero) e = one * e_unit
1057 IF (f == zero) f = one * f_unit
1058 IF (lscale == zero) lscale = one * lscale_unit
1059 IF (gf3 == zero) gf3 = one * gf3_unit
1060 IF (ifunc == 0) THEN
1061 a = one
1062 b = zero
1063 e = zero
1064 ENDIF
1065C
1066 IF ((ifail2 == 0).OR.(ifail2 ==1)) THEN
1067 dn = dn * lscale / crit_scale(6)
1068 dx = dx * lscale / crit_scale(6)
1069 ENDIF
1070 IF (dn == zero) dn=-ep30* crit_scale(6)
1071 IF (dx == zero) dx= ep30* crit_scale(6)
1072 IF ((ifail2 == 0).OR.(ifail2 ==1)) crit_scale(6) = lscale / crit_scale(6)
1073C----
1074 geo(61) = a
1075 geo(62) = b
1076 geo(63) = d
1077 geo(184) = e
1078 geo(137) = gf3
1079 geo(64) = one / f
1080 geo(178) = one / lscale
1081 geo(75) = dn
1082 geo(76) = dx
1083 geo(27) = xk / a
1084 geo(28) = xc
1085 geo(30) = iecrou+pun
1086C-- If H=6 - additional internal variables must be stored in UVAR - - GEO(25) = NUVAR
1087 IF (iecrou == 6) THEN
1088 geo(25) = 6
1089 ENDIF
1090C
1091 igeo(116) = ifunc
1092 igeo(117) = ifv
1093 igeo(118) = ifunc2
1094 igeo(124) = ifunc3
1095C----
1096 IF (.NOT. is_encrypted) THEN
1097 IF (iecrou /= 5) THEN
1098 IF (ifail2 == 3) THEN
1099 WRITE(iout,1833)'Z FLEXION',xk,xc,ifunc,lscale,ifunc2,f,
1100 . iecrou,a,b,d,e,gf3,ifv,ifunc3,dx
1101 ELSEIF (ifail2 == 2) THEN
1102 WRITE(iout,1832)'Z FLEXION',xk,xc,ifunc,lscale,ifunc2,f,
1103 . iecrou,a,b,d,e,gf3,ifv,ifunc3,dn,dx
1104 ELSE
1105 WRITE(iout,1830)'Z FLEXION',xk,xc,ifunc,lscale,ifunc2,f,
1106 . iecrou,a,b,d,e,gf3,ifv,ifunc3,dn,dx
1107 ENDIF ! IF (IFAIL2 == 3)
1108 ELSE
1109 IF (ifail2 == 3) THEN
1110 WRITE(iout,1843)'Z FLEXION',xk,xc,ifunc,lscale,ifunc2,f,
1111 . iecrou,a,b,d,e,gf3,ifv,ifunc3,dx
1112 ELSEIF (ifail2 == 2) THEN
1113 WRITE(iout,1842)'Z FLEXION',xk,xc,ifunc,lscale,ifunc2,f,
1114 . iecrou,a,b,d,e,gf3,ifv,ifunc3,dn,dx
1115 ELSE
1116 WRITE(iout,1840)'Z FLEXION',xk,xc,ifunc,lscale,ifunc2,f,
1117 . iecrou,a,b,d,e,gf3,ifv,ifunc3,dn,dx
1118 ENDIF ! IF (IFAIL2 == 3)
1119 ENDIF ! IF (IECROU /= 5)
1120 ENDIF
1121!-------------------------------------------------------
1122c--- New uni/multiaxial failure criteria
1123!-------------------------------------------------------
1124C--------------------------------------------------
1125C EXTRACT DATAS (INTEGER VALUES)
1126C--------------------------------------------------
1127 CALL hm_get_intv('ISRATE',israte,is_available,lsubmodel)
1128C--------------------------------------------------
1129C EXTRACT DATAS (REAL VALUES)
1130C--------------------------------------------------
1131 CALL hm_get_floatv('TRANS_VEL0',vt0,is_available,lsubmodel,unitab)
1132 CALL hm_get_floatv('ROT_VEL0',vr0,is_available,lsubmodel,unitab)
1133 CALL hm_get_floatv('Asrate',asrate,is_available,lsubmodel,unitab)
1134 CALL hm_get_floatv('C1',cc(1),is_available,lsubmodel,unitab)
1135 CALL hm_get_floatv('REL_VEL_EXP1',cn(1),is_available,lsubmodel,unitab)
1136 CALL hm_get_floatv('ALPHA1',xa(1),is_available,lsubmodel,unitab)
1137 CALL hm_get_floatv('BETA1',xb(1),is_available,lsubmodel,unitab)
1138 CALL hm_get_floatv('C2',cc(2),is_available,lsubmodel,unitab)
1139 CALL hm_get_floatv('REL_VEL_EXP2',cn(2),is_available,lsubmodel,unitab)
1140 CALL hm_get_floatv('ALPHA2',xa(2),is_available,lsubmodel,unitab)
1141 CALL hm_get_floatv('BETA2',xb(2),is_available,lsubmodel,unitab)
1142 CALL hm_get_floatv('C3',cc(3),is_available,lsubmodel,unitab)
1143 CALL hm_get_floatv('REL_VEL_EXP3',cn(3),is_available,lsubmodel,unitab)
1144 CALL hm_get_floatv('ALPHA3',xa(3),is_available,lsubmodel,unitab)
1145 CALL hm_get_floatv('BETA3',xb(3),is_available,lsubmodel,unitab)
1146 CALL hm_get_floatv('C4',cc(4),is_available,lsubmodel,unitab)
1147 CALL hm_get_floatv('REL_VEL_EXP4',cn(4),is_available,lsubmodel,unitab)
1148 CALL hm_get_floatv('ALPHA4',xa(4),is_available,lsubmodel,unitab)
1149 CALL hm_get_floatv('BETA4',xb(4),is_available,lsubmodel,unitab)
1150 CALL hm_get_floatv('C5',cc(5),is_available,lsubmodel,unitab)
1151 CALL hm_get_floatv('REL_VEL_EXP5',cn(5),is_available,lsubmodel,unitab)
1152 CALL hm_get_floatv('ALPHA5',xa(5),is_available,lsubmodel,unitab)
1153 CALL hm_get_floatv('BETA5',xb(5),is_available,lsubmodel,unitab)
1154 CALL hm_get_floatv('C6',cc(6),is_available,lsubmodel,unitab)
1155 CALL hm_get_floatv('REL_VEL_EXP6',cn(6),is_available,lsubmodel,unitab)
1156 CALL hm_get_floatv('ALPHA6',xa(6),is_available,lsubmodel,unitab)
1157 CALL hm_get_floatv('BETA6',xb(6),is_available,lsubmodel,unitab)
1158 !units for default values
1159 CALL hm_get_floatv_dim('TRANS_VEL0',vt0_unit,is_available, lsubmodel, unitab)
1160 CALL hm_get_floatv_dim('ROT_VEL0',vr0_unit,is_available, lsubmodel, unitab)
1161 CALL hm_get_floatv_dim('Asrate',asr_unit,is_available, lsubmodel, unitab)
1162C----
1163 IF (asrate == zero) asrate=ep30*asr_unit
1164 IF (vt0 == zero) vt0 = one * vt0_unit
1165 IF (vr0 == zero) vr0 = one * vr0_unit
1166C
1167 DO j = 1,6
1168 IF (cn(j) == zero) cn(j) = one
1169 IF (xa(j) == zero) xa(j) = one
1170 IF (xb(j) == zero) xb(j) = two
1171 ENDDO
1172C----
1173 IF ((ifail2 == 0).OR.(ifail2 == 1)) THEN
1174 DO j = 1,6
1175 cc(j) = cc(j) * crit_scale(j)
1176 ENDDO
1177 ENDIF
1178C----
1179 geo(101) = vt0
1180 geo(102) = vr0
1181 geo(103) = cc(1)
1182 geo(104) = cc(2)
1183 geo(105) = cc(3)
1184 geo(106) = cc(4)
1185 geo(107) = cc(5)
1186 geo(108) = cc(6)
1187 geo(109) = cn(1)
1188 geo(110) = cn(2)
1189 geo(111) = cn(3)
1190 geo(112) = cn(4)
1191 geo(113) = cn(5)
1192 geo(114) = cn(6)
1193 geo(115) = xa(1)
1194 geo(116) = xa(2)
1195 geo(117) = xa(3)
1196 geo(118) = xa(4)
1197 geo(119) = xa(5)
1198 geo(120) = xa(6)
1199 geo(121) = xb(1)
1200 geo(122) = xb(2)
1201 geo(123) = xb(3)
1202 geo(124) = xb(4)
1203 geo(125) = xb(5)
1204 geo(126) = xb(6)
1205 geo(127) = israte
1206 geo(128) = asrate
1207C
1208 IF (.NOT. is_encrypted) THEN
1209 WRITE(iout,1850) vt0,vr0,
1210 . (cc(j),j=1,6),(cn(j),j=1,6),(xa(j),j=1,6),(xb(j),j=1,6)
1211 WRITE(iout,1900) israte,asrate
1212 ENDIF
1213C
1214 prop_tag(igtyp)%G_EINT = 1
1215 prop_tag(igtyp)%G_FOR = 3
1216 prop_tag(igtyp)%G_MOM = 3
1217 prop_tag(igtyp)%G_LENGTH = 3
1218 prop_tag(igtyp)%G_TOTDEPL = 3
1219 prop_tag(igtyp)%G_TOTROT = 3
1220 prop_tag(igtyp)%G_FOREP = 3
1221 prop_tag(igtyp)%G_MOMEP = 3
1222 prop_tag(igtyp)%G_DEP_IN_TENS = 3
1223 prop_tag(igtyp)%G_DEP_IN_COMP = 3
1224 prop_tag(igtyp)%G_ROT_IN_TENS = 3
1225 prop_tag(igtyp)%G_ROT_IN_COMP = 3
1226 prop_tag(igtyp)%G_POSX = 5
1227 prop_tag(igtyp)%G_POSY = 5
1228 prop_tag(igtyp)%G_POSZ = 5
1229 prop_tag(igtyp)%G_POSXX = 5
1230 prop_tag(igtyp)%G_POSYY = 5
1231 prop_tag(igtyp)%G_POSZZ = 5
1232 prop_tag(igtyp)%G_YIELD = 6
1233 prop_tag(igtyp)%G_LENGTH_ERR = 3
1234 prop_tag(igtyp)%G_SKEW = 3
1235 prop_tag(igtyp)%G_SKEW_ERR = 3
1236 prop_tag(igtyp)%G_E6 = 6
1237 prop_tag(igtyp)%G_RUPTCRIT = 1
1238 prop_tag(igtyp)%G_NUVAR = max(prop_tag(igtyp)%G_NUVAR,nint(geo(25))) ! additional internal variables for h=6
1239 prop_tag(igtyp)%G_DEFINI = 6
1240 prop_tag(igtyp)%G_FORINI = 6
1241C
1242C------------------------
1243 RETURN
1244c-----------
1245 1810 FORMAT(
1246 & 5x,a,/,
1247 & 5x,'SPRING STIFFNESS. . . . . . . . . . . .=',1pg20.13/,
1248 & 5x,'SPRING DAMPING. . . . . . . . . . . . .=',1pg20.13/,
1249 & 5x,'FUNCTION IDENTIFIER FOR LOADING ',/,
1250 & 5x,'FORCE-DISPLACEMENT CURVE. . . . . . . .=',i10/,
1251 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
1252 & 5x,'FUNCTION IDENTIFIER FOR UNLOADING ',/,
1253 & 5x,'FORCE-DISPLACEMENT CURVE (H=4,5,7). . .=',i10/,
1254 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
1255 & 5x,'HARDENING FLAG H. . . . . . . . . . . .=',i10/,
1256 & 5x,'0:ELASTIC 1:ISOTROPIC 2:UNCOUPLED',/,
1257 & 5x,'4:KINEMATIC 5:UNCOUPLED NL (UN/RE)LOADING',/,
1258 & 5x,'6:ELASTO PLASTIC WITH HARDENING 7: ELASTIC HYSTERESIS',/,
1259 & 5x,'DYNAMIC AMPLIFICATION FACTOR A. . . . .=',1pg20.13/,
1260 & 5x,'DYNAMIC AMPLIFICATION FACTOR B. . . . .=',1pg20.13/,
1261 & 5x,'DYNAMIC AMPLIFICATION FACTOR D. . . . .=',1pg20.13/,
1262 & 5x,'DYNAMIC AMPLIFICATION FACTOR E. . . . .=',1pg20.13/,
1263 & 5x,'DYNAMIC AMPLIFICATION FACTOR GF3 . . .=',1pg20.13/,
1264 & 5x,'FUNCTION IDENTIFIER FOR ',/,
1265 & 5x,'FORCE-VELOCITY CURVE. . . . . . . . . .=',i10/,
1266 & 5x,'FUNCTION IDENTIFIER FOR THE ADDITIONAL ',/,
1267 & 5x,'FORCE-VELOCITY CURVE. . . . . . . . . .=',i10/,
1268 & 5x,'NEGATIVE FAILURE DISPLACEMENT . . . . .=',1pg20.13/,
1269 & 5x,'POSITIVE FAILURE DISPLACEMENT . . . . .=',1pg20.13/)
1270 1820 FORMAT(
1271 & 5x,a,/,
1272 & 5x,'SPRING STIFFNESS. . . . . . . . . . . .=',1pg20.13/,
1273 & 5x,'SPRING DAMPING. . . . . . . . . . . . .=',1pg20.13/,
1274 & 5x,'FUNCTION IDENTIFIER FOR LOADING ',/,
1275 & 5x,'FORCE-DISPLACEMENT CURVE. . . . . . . .=',i10/,
1276 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
1277 & 5x,'PERMANENT DISPL./MAX. DISPL. CURVE(H=5)=',i10/,
1278 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
1279 & 5x,'HARDENING FLAG H. . . . . . . . . . . .=',i10/,
1280 & 5x,'0:ELASTIC 1:ISOTROPIC 2:UNCOUPLED',/,
1281 & 5x,'4:KINEMATIC 5:UNCOUPLED NL (UN/RE)LOADING',/,
1282 & 5x,'6:ELASTO PLASTIC WITH HARDENING 7: ELASTIC HYSTERESIS',/,
1283 & 5x,'DYNAMIC AMPLIFICATION FACTOR A. . . . .=',1pg20.13/,
1284 & 5x,'DYNAMIC AMPLIFICATION FACTOR B. . . . .=',1pg20.13/,
1285 & 5x,'DYNAMIC AMPLIFICATION FACTOR D. . . . .=',1pg20.13/,
1286 & 5x,'DYNAMIC AMPLIFICATION FACTOR E. . . . .=',1pg20.13/,
1287 & 5x,'DYNAMIC AMPLIFICATION FACTOR GF3 . . .=',1pg20.13/,
1288 & 5x,'FUNCTION IDENTIFIER FOR ',/,
1289 & 5x,'FORCE-VELOCITY CURVE. . . . . . . . . .=',i10/,
1290 & 5x,'FUNCTION IDENTIFIER FOR THE ADDITIONAL ',/,
1291 & 5x,'FORCE-VELOCITY CURVE. . . . . . . . . .=',i10/,
1292 & 5x,'NEGATIVE FAILURE DISPLACEMENT . . . . .=',1pg20.13/,
1293 & 5x,'POSITIVE FAILURE DISPLACEMENT . . . . .=',1pg20.13/)
1294 1830 FORMAT(
1295 & 5x,a,/,
1296 & 5x,'SPRING STIFFNESS. . . . . . . . . . . .=',1pg20.13/,
1297 & 5x,'SPRING DAMPING. . . . . . . . . . . . .=',1pg20.13/,
1298 & 5x,'FUNCTION IDENTIFIER FOR LOADING ',/,
1299 & 5x,'MOMENT-ROTATION CURVE . . . . . . . . .=',i10/,
1300 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
1301 & 5x,'FUNCTION IDENTIFIER FOR UNLOADING ',/,
1302 & 5x,'MOMENT-ROTATION CURVE (H=4,5,7). . . . =',i10/,
1303 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
1304 & 5x,'HARDENING FLAG H. . . . . . . . . . . .=',i10/,
1305 & 5x,'0:ELASTIC 1:ISOTROPIC 2:UNCOUPLED',/,
1306 & 5x,'4:KINEMATIC 5:UNCOUPLED NL (UN/RE)LOADING',/,
1307 & 5x,'6:ELASTO PLASTIC WITH HARDENING 7: ELASTIC HYSTERESIS',/,
1308 & 5x,'DYNAMIC AMPLIFICATION FACTOR A. . . . .=',1pg20.13/,
1309 & 5x,'DYNAMIC AMPLIFICATION FACTOR B. . . . .=',1pg20.13/,
1310 & 5x,'DYNAMIC AMPLIFICATION FACTOR D. . . . .=',1pg20.13/,
1311 & 5x,'DYNAMIC AMPLIFICATION FACTOR E. . . . .=',1pg20.13/,
1312 & 5x,'DYNAMIC AMPLIFICATION FACTOR GF3 . . .=',1pg20.13/,
1313 & 5x,'FUNCTION IDENTIFIER FOR ',/,
1314 & 5x,'FORCE-VELOCITY CURVE. . . . . . . . . .=',i10/,
1315 & 5x,'FUNCTION IDENTIFIER FOR THE ADDITIONAL ',/,
1316 & 5x,'FORCE-VELOCITY CURVE. . . . . . . . . .=',i10/,
1317 & 5x,'NEGATIVE FAILURE ROTATION . . . . . . .=',1pg20.13/,
1318 & 5x,'POSITIVE FAILURE ROTATION . . . . . . .=',1pg20.13/)
1319 1840 FORMAT(
1320 & 5x,a,/,
1321 & 5x,'SPRING STIFFNESS. . . . . . . . . . . .=',1pg20.13/,
1322 & 5x,'SPRING DAMPING. . . . . . . . . . . . .=',1pg20.13/,
1323 & 5x,'FUNCTION IDENTIFIER FOR LOADING ',/,
1324 & 5x,'MOMENT/ROTATION CURVE . . . . . . . . .=',i10/,
1325 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
1326 & 5x,'PERMANENT ROT./MAX. ROT. CURVE (H=5). .=',i10/,
1327 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
1328 & 5x,'HARDENING FLAG H. . . . . . . . . . . .=',i10/,
1329 & 5x,'0:ELASTIC 1:ISOTROPIC 2:UNCOUPLED',/,
1330 & 5x,'4:KINEMATIC 5:UNCOUPLED NL (UN/RE)LOADING',/,
1331 & 5x,'6:ELASTO PLASTIC WITH HARDENING 7: ELASTIC HYSTERESIS',/,
1332 & 5x,'DYNAMIC AMPLIFICATION FACTOR A. . . . .=',1pg20.13/,
1333 & 5x,'DYNAMIC AMPLIFICATION FACTOR B. . . . .=',1pg20.13/,
1334 & 5x,'DYNAMIC AMPLIFICATION FACTOR D. . . . .=',1pg20.13/,
1335 & 5x,'DYNAMIC AMPLIFICATION FACTOR E. . . . .=',1pg20.13/,
1336 & 5x,'DYNAMIC AMPLIFICATION FACTOR GF3 . . .=',1pg20.13/,
1337 & 5x,'FUNCTION IDENTIFIER FOR ',/,
1338 & 5x,'FORCE-VELOCITY CURVE. . . . . . . . . .=',i10/,
1339 & 5x,'FUNCTION IDENTIFIER FOR THE ADDITIONAL ',/,
1340 & 5x,'FORCE-VELOCITY CURVE. . . . . . . . . .=',i10/,
1341 & 5x,'NEGATIVE FAILURE ROTATION . . . . . . .=',1pg20.13/,
1342 & 5x,'POSITIVE FAILURE ROTATION . . . . . . .=',1pg20.13/)
1343 1801 FORMAT(
1344 & 5x,'SPRING PROPERTY SET (BEAM TYPE)'/,
1345 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
1346 & 5x,'SPRING MASS . . . . . . . . . . . . . .=',1pg20.13/,
1347 & 5x,'SPRING INERTIA. . . . . . . . . . . . .=',1pg20.13/,
1348 & 5x,'SKEW FRAME NUMBER (0:GLOBAL). . . . . .=',i10/,
1349 & 5x,'SENSOR NUMBER (0:NOT USED). . . . . . .=',i10/,
1350 & 5x,'SENSOR FLAG (0:ACTIV 1:DEACT 2:BOTH). .=',i10/,
1351 & 5x,'FAILURE FLAG (0:UNCOUPLED 1:COUPLED). .=',i10/,
1352 & 5x,'FAILURE CRITERION (DISPL/FORCE/ENERGY).=',i10/,
1353 & 5x,' 1:DISPLACEMENT 2:FORCE 3:ENERGY ' ,/,
1354 & 5x,'UNIT LENGTH FLAG. . . . . . . . . . . .=',i10/,
1355 & 5x,'IF=1 UNIT LENGTH MASS,STIFFNESS AND INPUT',/,
1356 & 5x,' CURVE ARE STRAIN DEPENDING',/)
1357 1812 FORMAT(
1358 & 5x,a,/,
1359 & 5x,'SPRING STIFFNESS. . . . . . . . . . . .=',1pg20.13/,
1360 & 5x,'SPRING DAMPING. . . . . . . . . . . . .=',1pg20.13/,
1361 & 5x,'FUNCTION IDENTIFIER FOR LOADING ',/,
1362 & 5x,'MOMENT/ROTATION CURVE. . . . . . . . . =',i10/,
1363 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
1364 & 5x,'FUNCTION IDENTIFIER FOR UNLOADING ',/,
1365 & 5x,'MOMENT/ROTATION CURVE (H=4,5,7). . . . =',i10/,
1366 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
1367 & 5x,'HARDENING FLAG H. . . . . . . . . . . .=',i10/,
1368 & 5x,'0:ELASTIC 1:ISOTROPIC 2:UNCOUPLED',/,
1369 & 5x,'4:KINEMATIC 5:UNCOUPLED NL (UN/RE)LOADING',/,
1370 & 5x,'6:ELASTO PLASTIC WITH HARDENING 7: ELASTIC HYSTERESIS',/,
1371 & 5x,'DYNAMIC AMPLIFICATION FACTOR A. . . . .=',1pg20.13/,
1372 & 5x,'DYNAMIC AMPLIFICATION FACTOR B. . . . .=',1pg20.13/,
1373 & 5x,'DYNAMIC AMPLIFICATION FACTOR D. . . . .=',1pg20.13/,
1374 & 5x,'DYNAMIC AMPLIFICATION FACTOR E. . . . .=',1pg20.13/,
1375 & 5x,'DYNAMIC AMPLIFICATION FACTOR GF3 . . .=',1pg20.13/,
1376 & 5x,'FUNCTION IDENTIFIER FOR ',/,
1377 & 5x,'FORCE-VELOCITY CURVE. . . . . . . . . .=',i10/,
1378 & 5x,'FUNCTION IDENTIFIER FOR THE ADDITIONAL ',/,
1379 & 5x,'FORCE-VELOCITY CURVE. . . . . . . . . .=',i10/,
1380 & 5x,'NEGATIVE FAILURE FORCE. . . . . . . . .=',1pg20.13/,
1381 & 5x,'POSITIVE FAILURE FORCE. . . . . . . . .=',1pg20.13/)
1382 1813 FORMAT(
1383 & 5x,a,/,
1384 & 5x,'SPRING STIFFNESS. . . . . . . . . . . .=',1pg20.13/,
1385 & 5x,'SPRING DAMPING. . . . . . . . . . . . .=',1pg20.13/,
1386 & 5x,'FUNCTION IDENTIFIER FOR LOADING ',/,
1387 & 5x,'MOMENT/ROTATION CURVE . . . . . . . . .=',i10/,
1388 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
1389 & 5x,'FUNCTION IDENTIFIER FOR UNLOADING ',/,
1390 & 5x,'MOMENT/ROTATION CURVE (H=4,5,7). . .=',i10/,
1391 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
1392 & 5x,'HARDENING FLAG H. . . . . . . . . . . .=',i10/,
1393 & 5x,'0:ELASTIC 1:ISOTROPIC 2:UNCOUPLED',/,
1394 & 5x,'4:KINEMATIC 5:UNCOUPLED NL (UN/RE)LOADING',/,
1395 & 5x,'6:ELASTO PLASTIC WITH HARDENING 7: ELASTIC HYSTERESIS',/,
1396 & 5x,'DYNAMIC AMPLIFICATION FACTOR A. . . . .=',1pg20.13/,
1397 & 5x,'DYNAMIC AMPLIFICATION FACTOR B. . . . .=',1pg20.13/,
1398 & 5x,'DYNAMIC AMPLIFICATION FACTOR D. . . . .=',1pg20.13/,
1399 & 5x,'DYNAMIC AMPLIFICATION FACTOR E. . . . .=',1pg20.13/,
1400 & 5x,'DYNAMIC AMPLIFICATION FACTOR GF3 . . .=',1pg20.13/,
1401 & 5x,'FUNCTION IDENTIFIER FOR ',/,
1402 & 5x,'FORCE-VELOCITY CURVE. . . . . . . . . .=',i10/,
1403 & 5x,'FUNCTION IDENTIFIER FOR THE ADDITIONAL ',/,
1404 & 5x,'FORCE-VELOCITY CURVE. . . . . . . . . .=',i10/,
1405 & 5x,'FAILURE ENERGY. . . . . . . . . . . . .=',1pg20.13/)
1406 1822 FORMAT(
1407 & 5x,a,/,
1408 & 5x,'SPRING STIFFNESS. . . . . . . . . . . .=',1pg20.13/,
1409 & 5x,'SPRING DAMPING. . . . . . . . . . . . .=',1pg20.13/,
1410 & 5x,'FUNCTION IDENTIFIER FOR LOADING ',/,
1411 & 5x,'FORCE-DISPLACEMENT CURVE. . . . . . . .=',i10/,
1412 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
1413 & 5x,'PERMANENT DISPL./MAX. DISPL. CURVE(H=5)=',i10/,
1414 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
1415 & 5x,'HARDENING FLAG H. . . . . . . . . . . .=',i10/,
1416 & 5x,'0:elastic 1:isotropic 2:uncoupled',/,
1417 & 5X,'4:kinematic 5:uncoupled nl(un/re)loading',/,
1418 & 5X,'6:elasto plastic with hardening 7: elastic hysteresis',/,
1419 & 5X,'dynamic amplification factor a. . . . .=',1PG20.13/,
1420 & 5X,'dynamic amplification factor b. . . . .=',1PG20.13/,
1421 & 5X,'dynamic amplification factor d. . . . .=',1PG20.13/,
1422 & 5X,'dynamic amplification factor e. . . . .=',1PG20.13/,
1423 & 5X,'dynamic amplification factor gf3 . . .=',1PG20.13/,
1424 & 5X,'FUNCTION identifier for ',/,
1425 & 5X,'force-velocity curve. . . . . . . . . .=',I10/,
1426 & 5X,'function identifier for the additional ',/,
1427 & 5X,'force-velocity curve. . . . . . . . . .=',I10/,
1428 & 5X,'negative failure force. . . . . . . . .=',1PG20.13/,
1429 & 5X,'positive failure force. . . . . . . . .=',1PG20.13/)
1430 1823 FORMAT(
1431 & 5X,A,/,
1432 & 5X,'spring stiffness. . . . . . . . . . . .=',1PG20.13/,
1433 & 5X,'spring damping. . . . . . . . . . . . .=',1PG20.13/,
1434 & 5X,'function identifier for loading ',/,
1435 & 5X,'force-displacement curve. . . . . . . .=',I10/,
1436 & 5X,'abscissa scale factor on curve . . . . =',1PG20.13/,
1437 & 5X,'permanent displ./max. displ. curve(H=5)=',I10/,
1438 & 5X,'abscissa scale factor on curve . . . . =',1pg20.13/,
1439 & 5x,'HARDENING FLAG H. . . . . . . . . . . .=',i10/,
1440 & 5x,'0:ELASTIC 1:ISOTROPIC 2:UNCOUPLED',/,
1441 & 5x,'4:KINEMATIC 5:UNCOUPLED NL (UN/RE)LOADING',/,
1442 & 5x,'6:ELASTO PLASTIC WITH HARDENING 7: ELASTIC HYSTERESIS',/,
1443 & 5x,'DYNAMIC AMPLIFICATION FACTOR A. . . . .=',1pg20.13/,
1444 & 5x,'DYNAMIC AMPLIFICATION FACTOR B. . . . .=',1pg20.13/,
1445 & 5x,'DYNAMIC AMPLIFICATION FACTOR D. . . . .=',1pg20.13/,
1446 & 5x,'DYNAMIC AMPLIFICATION FACTOR E. . . . .=',1pg20.13/,
1447 & 5x,'DYNAMIC AMPLIFICATION FACTOR GF3 . . .=',1pg20.13/,
1448 & 5x,'FUNCTION IDENTIFIER FOR ',/,
1449 & 5x,'FORCE-VELOCITY CURVE. . . . . . . . . .=',i10/,
1450 & 5x,'FUNCTION IDENTIFIER FOR THE ADDITIONAL ',/,
1451 & 5x,'FORCE-VELOCITY CURVE. . . . . . . . . .=',i10/,
1452 & 5x,'FAILURE ENERGY. . . . . . . . . . . . .=',1pg20.13/)
1453 1832 FORMAT(
1454 & 5x,a,/,
1455 & 5x,'SPRING STIFFNESS. . . . . . . . . . . .=',1pg20.13/,
1456 & 5x,'SPRING DAMPING. . . . . . . . . . . . .=',1pg20.13/,
1457 & 5x,'FUNCTION IDENTIFIER FOR LOADING ',/,
1458 & 5x,'MOMENT-ROTATION CURVE . . . . . . . . .=',i10/,
1459 & 5x,'abscissa scale factor on curve . . . . =',1PG20.13/,
1460 & 5X,'FUNCTION identifier for unloading ',/,
1461 & 5X,'moment-rotation curve (H=4,5,7). . . . =',I10/,
1462 & 5X,'abscissa scale factor on curve . . . . =',1PG20.13/,
1463 & 5X,'hardening flag h. . . . . . . . . . . .=',I10/,
1464 & 5X,'0:elastic 1:isotropic 2:uncoupled',/,
1465 & 5X,'4:kinematic 5:uncoupled nl (UN/RE)loading',/,
1466 & 5X,'6:elasto plastic with hardening 7: elastic hysteresis',/,
1467 & 5X,'dynamic amplification factor a. . . . .=',1PG20.13/,
1468 & 5X,'dynamic amplification factor b. . . . .=',1PG20.13/,
1469 & 5X,'dynamic amplification factor d. . . . .=',1PG20.13/,
1470 & 5X,'dynamic amplification factor e. . . . .=',1PG20.13/,
1471 & 5X,'dynamic amplification factor gf3 . . .=',1PG20.13/,
1472 & 5X,'function identifier for ',/,
1473 & 5X,'force-velocity curve. . . . . . . . . .=',I10/,
1474 & 5X,'function identifier for the additional ',/,
1475 & 5X,'force-velocity curve. . . . . . . . . .=',I10/,
1476 & 5X,'negative failure moment . . . . . . . .=',1PG20.13/,
1477 & 5X,'positive failure moment . . . . . . . .=',1PG20.13/)
1478 1833 FORMAT(
1479 & 5X,A,/,
1480 & 5X,'spring stiffness. . . . . . . . . . . .=',1PG20.13/,
1481 & 5X,'spring damping. . . . . . . . . . . . .=',1PG20.13/,
1482 & 5X,'function identifier for loading ',/,
1483 & 5X,'moment-rotation curve . . . . . . . . .=',I10/,
1484 & 5X,'abscissa scale factor on curve . . . . =',1PG20.13/,
1485 & 5X,'function identifier for unloading ',/,
1486 & 5X,'moment-rotation curve (H=4,5,7). . . . =',I10/,
1487 & 5X,'abscissa scale factor on curve . . . . =',1PG20.13/,
1488 & 5X,'hardening flag h. . . . . . . . . . . .=',I10/,
1489 & 5X,'0:elastic 1:isotropic 2:uncoupled',/,
1490 & 5X,'4:kinematic 5:uncoupled nl (UN/RE)loading',/,
1491 & 5X,'6:elasto plastic with hardening 7: elastic hysteresis',/,
1492 & 5X,'dynamic amplification factor a. . . . .=',1PG20.13/,
1493 & 5X,'dynamic amplification factor b. . . . .=',1PG20.13/,
1494 & 5X,'dynamic amplification factor d. . . . .=',1PG20.13/,
1495 & 5X,'dynamic amplification factor e. . . . .=',1PG20.13/,
1496 & 5X,'dynamic amplification factor gf3 . . .=',1PG20.13/,
1497 & 5X,'function identifier for ',/,
1498 & 5x,'FORCE-VELOCITY CURVE. . . . . . . . . .=',i10/,
1499 & 5x,'FUNCTION IDENTIFIER FOR THE ADDITIONAL ',/,
1500 & 5x,'FORCE-VELOCITY CURVE. . . . . . . . . .=',i10/,
1501 & 5x,'FAILURE ENERGY. . . . . . . . . . . . .=',1pg20.13/)
1502 1842 FORMAT(
1503 & 5x,a,/,
1504 & 5x,'SPRING STIFFNESS. . . . . . . . . . . .=',1pg20.13/,
1505 & 5x,'SPRING DAMPING. . . . . . . . . . . . .=',1pg20.13/,
1506 & 5x,'FUNCTION IDENTIFIER FOR LOADING ',/,
1507 & 5x,'MOMENT-ROTATION CURVE . . . . . . . . .=',i10/,
1508 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
1509 & 5x,'PERMANENT ROT./MAX. ROT. CURVE (H=5). .=',i10/,
1510 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
1511 & 5x,'HARDENING FLAG H. . . . . . . . . . . .=',i10/,
1512 & 5x,'0:ELASTIC 1:ISOTROPIC 2:UNCOUPLED',/,
1513 & 5x,'4:KINEMATIC 5:UNCOUPLED NL (UN/RE)LOADING',/,
1514 & 5x,'6:ELASTO PLASTIC WITH HARDENING 7: ELASTIC HYSTERESIS',/,
1515 & 5x,'DYNAMIC AMPLIFICATION FACTOR A. . . . .=',1pg20.13/,
1516 & 5x,'DYNAMIC AMPLIFICATION FACTOR B. . . . .=',1pg20.13/,
1517 & 5x,'DYNAMIC AMPLIFICATION FACTOR D. . . . .=',1pg20.13/,
1518 & 5x,'DYNAMIC AMPLIFICATION FACTOR E. . . . .=',1pg20.13/,
1519 & 5x,'DYNAMIC AMPLIFICATION FACTOR GF3 . . .=',1pg20.13/,
1520 & 5x,'FUNCTION IDENTIFIER FOR ',/,
1521 & 5x,'FORCE-VELOCITY CURVE. . . . . . . . . .=',i10/,
1522 & 5x,'FUNCTION IDENTIFIER FOR THE ADDITIONAL ',/,
1523 & 5x,'FORCE-VELOCITY CURVE. . . . . . . . . .=',i10/,
1524 & 5x,'NEGATIVE FAILURE MOMENT . . . . . . . .=',1pg20.13/,
1525 & 5x,'POSITIVE FAILURE MOMENT . . . . . . . .=',1pg20.13/)
1526 1843 FORMAT(
1527 & 5x,a,/,
1528 & 5x,'SPRING STIFFNESS. . . . . . . . . . . .=',1pg20.13/,
1529 & 5x,'SPRING DAMPING. . . . . . . . . . . . .=',1pg20.13/,
1530 & 5x,'FUNCTION IDENTIFIER FOR LOADING ',/,
1531 & 5x,'MOMENT-ROTATION CURVE . . . . . . . . .=',i10/,
1532 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
1533 & 5x,'PERMANENT ROT./MAX. ROT. CURVE (H=5). .=',i10/,
1534 & 5x,'ABSCISSA SCALE FACTOR ON CURVE . . . . =',1pg20.13/,
1535 & 5x,'HARDENING FLAG H. . . . . . . . . . . .=',i10/,
1536 & 5x,'0:ELASTIC 1:ISOTROPIC 2:UNCOUPLED',/,
1537 & 5x,'4:KINEMATIC 5:UNCOUPLED NL (UN/RE)LOADING',/,
1538 & 5x,'6:ELASTO PLASTIC WITH HARDENING 7: ELASTIC HYSTERESIS',/,
1539 & 5x,'DYNAMIC AMPLIFICATION FACTOR A. . . . .=',1pg20.13/,
1540 & 5x,'DYNAMIC AMPLIFICATION FACTOR B. . . . .=',1pg20.13/,
1541 & 5x,'DYNAMIC AMPLIFICATION FACTOR D. . . . .=',1pg20.13/,
1542 & 5x,'DYNAMIC AMPLIFICATION FACTOR E. . . . .=',1pg20.13/,
1543 & 5x,'DYNAMIC AMPLIFICATION FACTOR GF3 . . .=',1pg20.13/,
1544 & 5x,'FUNCTION IDENTIFIER FOR ',/,
1545 & 5x,'FORCE-VELOCITY CURVE. . . . . . . . . .=',i10/,
1546 & 5x,'FUNCTION IDENTIFIER FOR THE ADDITIONAL ',/,
1547 & 5x,'FORCE-VELOCITY CURVE. . . . . . . . . .=',i10/,
1548 & 5x,'FAILURE ENERGY. . . . . . . . . . . . .=',1pg20.13/)
1549 1850 FORMAT(
1550 & 5x,'TRANSL. REF. DEFORMATION VELOCITY . . .=',1pg20.13/,
1551 & 5x,'ROT. REF. DEFORMATION VELOCITY. . . . .=',1pg20.13/,
1552 & 5x,'C1 COEFFICIENT. . . . . . . . . . . . .=',1pg20.13/,
1553 & 5x,'C2 COEFFICIENT. . . . . . . . . . . . .=',1pg20.13/,
1554 & 5x,'C3 COEFFICIENT. . . . . . . . . . . . .=',1pg20.13/,
1555 & 5x,'C4 COEFFICIENT. . . . . . . . . . . . .=',1pg20.13/,
1556 & 5x,'C5 COEFFICIENT. . . . . . . . . . . . .=',1pg20.13/,
1557 & 5x,'C6 COEFFICIENT. . . . . . . . . . . . .=',1pg20.13/,
1558 & 5x,'N1 EXPONENT . . . . . . . . . . . . . .=',1pg20.13/,
1559 & 5x,'N2 EXPONENT . . . . . . . . . . . . . .=',1pg20.13/,
1560 & 5x,'N3 EXPONENT . . . . . . . . . . . . . .=',1pg20.13/,
1561 & 5x,'N4 EXPONENT . . . . . . . . . . . . . .=',1pg20.13/,
1562 & 5x,'N5 EXPONENT . . . . . . . . . . . . . .=',1pg20.13/,
1563 & 5x,'N6 EXPONENT . . . . . . . . . . . . . .=',1pg20.13/,
1564 & 5x,'A1 COEFFICIENT. . . . . . . . . . . . .=',1pg20.13/,
1565 & 5x,'A2 COEFFICIENT. . . . . . . . . . . . .=',1pg20.13/,
1566 & 5x,'A3 COEFFICIENT. . . . . . . . . . . . .=',1pg20.13/,
1567 & 5x,'A4 COEFFICIENT. . . . . . . . . . . . .=',1pg20.13/,
1568 & 5x,'A5 COEFFICIENT. . . . . . . . . . . . .=',1pg20.13/,
1569 & 5x,'a6 coefficient. . . . . . . . . . . . .=',1PG20.13/,
1570 & 5X,'b1 exponent . . . . . . . . . . . . . .=',1PG20.13/,
1571 & 5X,'b2 exponent . . . . . . . . . . . . . .=',1PG20.13/,
1572 & 5X,'b3 exponent . . . . . . . . . . . . . .=',1PG20.13/,
1573 & 5X,'b4 exponent . . . . . . . . . . . . . .=',1PG20.13/,
1574 & 5X,'b5 exponent . . . . . . . . . . . . . .=',1PG20.13/,
1575 & 5X,'b6 exponent . . . . . . . . . . . . . .=',1PG20.13/)
1576 1900 FORMAT(
1577 & 5X,'smooth strain rate option . . .. . . . =',I10/,
1578 & 5X,'strain rate cutting frequency .. . . . =',1PG20.13/)
1579c-----------
1580 RETURN
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
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
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
velocity
subroutine velocity(a, ar, v, vr, fzero, itab, nale)
Definition velocity.F:29