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