OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_mat108.F File Reference
#include "implicit_f.inc"
#include "units_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_mat108 (uparam, maxuparam, nuparam, nfunc, parmat, unitab, pm, lsubmodel, israte, mat_id, titr, ifunc, maxfunc, mtag, matparam)

Function/Subroutine Documentation

◆ hm_read_mat108()

subroutine hm_read_mat108 ( intent(inout) uparam,
integer, intent(in) maxuparam,
integer, intent(inout) nuparam,
integer, intent(inout) nfunc,
intent(inout) parmat,
type (unit_type_), intent(in) unitab,
intent(inout) pm,
type(submodel_data), dimension(*), intent(in) lsubmodel,
integer, intent(inout) israte,
integer, intent(in) mat_id,
character(len=nchartitle), intent(in) titr,
integer, dimension(maxfunc), intent(inout) ifunc,
integer, intent(in) maxfunc,
type(mlaw_tag_), intent(inout) mtag,
type(matparam_struct_), intent(inout) matparam )

Definition at line 39 of file hm_read_mat108.F.

42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE unitab_mod
46 USE message_mod
47 USE submodel_mod
48 USE elbuftag_mod
49 USE matparam_def_mod
50 USE names_and_titles_mod , ONLY : nchartitle
51C-----------------------------------------------
52C I m p l i c i t T y p e sXM
53C-----------------------------------------------
54#include "implicit_f.inc"
55C-----------------------------------------------
56C C o m m o n B l o c k s
57C-----------------------------------------------
58#include "units_c.inc"
59#include "param_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, INTENT(IN) :: MAT_ID,MAXUPARAM,MAXFUNC
65 my_real, DIMENSION(NPROPM) ,INTENT(INOUT) :: pm
66 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
67 INTEGER, INTENT(INOUT) :: ISRATE,IFUNC(MAXFUNC)
68 INTEGER, INTENT(INOUT) :: NUPARAM,NFUNC
69 my_real, DIMENSION(MAXUPARAM) ,INTENT(INOUT) :: uparam
70 my_real, DIMENSION(100),INTENT(INOUT) :: parmat
71 TYPE(SUBMODEL_DATA), DIMENSION(*),INTENT(IN) :: LSUBMODEL
72 TYPE(MLAW_TAG_), INTENT(INOUT) :: MTAG
73 TYPE(MATPARAM_STRUCT_) ,INTENT(INOUT) :: MATPARAM
74C
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78 INTEGER J, IFUNC1, IFUNC2,IFUNC3, IECROU, IFUNC4, IG,
79 . IFAIL,IFAIL2,FLGCHK,ILAW,IEQUIL,
80 . I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,
81 . IF1,IF2,IF3,IF4,SIZ_ARRAY_COMP
82C REAL
83 my_real
84 . a, b, d, e, f, xk, xc, dn, dx, fwv, lscale,
85 . pun, asrate,gf3 ,rho0,a_unit,e_unit,d_unit,
86 . l_unit,gf_unit,f_unit
87 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
88C=======================================================================
89 is_encrypted = .false.
90 is_available = .false.
91 ilaw = 108
92 pun = em01
93 fwv = zero
94 israte = 0
95 asrate = zero
96 siz_array_comp = 0
97c------------------------------------------
98 CALL hm_option_is_encrypted(is_encrypted)
99c------------------------------------------
100c
101!-------------------------------------------------------
102! Density
103!-------------------------------------------------------
104c-------------------------------------------------------------------------------
105 WRITE(iout,1100) trim(titr),mat_id,ilaw
106 CALL hm_get_floatv('MAT_RHO' ,rho0 ,is_available, lsubmodel, unitab)
107 WRITE(iout,1300) rho0
108 pm(1) = rho0
109 pm(89) = rho0
110c-------------------------------------------------------------------------------
111!-------------------------------------------------------
112! Flags
113!-------------------------------------------------------
114 ifail2 = 0
115 CALL hm_get_intv ('Ifail' ,ifail ,is_available, lsubmodel)
116 CALL hm_get_intv ('Iequil' ,iequil ,is_available, lsubmodel)
117 CALL hm_get_intv ('Ifail2' ,ifail2 ,is_available, lsubmodel)
118c
119C----
120C----
121C
122 IF (ifail2 /= 1 .AND. ifail2 /= 2 .AND. ifail2 /= 3) ifail2 = 0
123
124 uparam(1)=ifail
125 uparam(2)=iequil
126 uparam(3)=ifail2
127C UPARAM(4) used for NUVAR
128C
129 nuparam = 4
130c
131 IF (is_encrypted) THEN
132 WRITE(iout,1000)mat_id
133 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
134 ELSE
135 WRITE(iout,1700)ifail,ifail2,iequil
136 ENDIF
137c-------------------------------------------------------------------------------
138!-------------------------------------------------------
139! Translations
140!-------------------------------------------------------
141!-----------------
142 ! Traction X
143!-----------------
144 CALL hm_get_floatv('STIFF1' ,xk ,is_available, lsubmodel, unitab)
145 CALL hm_get_floatv('DAMP1' ,xc ,is_available, lsubmodel, unitab)
146 CALL hm_get_floatv('Acoeft1' ,a ,is_available, lsubmodel, unitab)
147 CALL hm_get_floatv('Bcoeft1' ,b ,is_available, lsubmodel, unitab)
148 CALL hm_get_floatv('Dcoeft1' ,d ,is_available, lsubmodel, unitab)
149 CALL hm_get_intv ('FUN_A1' ,ifunc1 ,is_available, lsubmodel)
150 CALL hm_get_intv ('HFLAG1' ,iecrou ,is_available, lsubmodel)
151 CALL hm_get_intv ('FUN_B1' ,ifunc2 ,is_available, lsubmodel)
152 CALL hm_get_intv ('FUN_C1' ,ifunc3 ,is_available, lsubmodel)
153 CALL hm_get_intv ('FUN_D1' ,ifunc4 ,is_available, lsubmodel)
154 CALL hm_get_floatv('MIN_RUP1' ,dn ,is_available, lsubmodel, unitab)
155 CALL hm_get_floatv('MAX_RUP1' ,dx ,is_available, lsubmodel, unitab)
156 CALL hm_get_floatv('Prop_X_F' ,f ,is_available, lsubmodel, unitab)
157 CALL hm_get_floatv('Prop_X_E' ,e ,is_available, lsubmodel, unitab)
158 CALL hm_get_floatv('scale1' ,lscale ,is_available, lsubmodel, unitab)
159 CALL hm_get_floatv('ffac' ,gf3 ,is_available, lsubmodel, unitab)
160 IF (iecrou == 4 .AND. (ifunc1 == 0 .OR. ifunc3 == 0)) THEN
161 CALL ancmsg(msgid=231,
162 . msgtype=msgerror,
163 . anmode=aninfo_blind_1,
164 . i1=ig,
165 . c1=titr)
166 ENDIF
167
168 IF (iecrou == 4 ) THEN
169 CALL ancmsg(msgid=230,
170 . msgtype=msgerror,
171 . anmode=aninfo_blind_1,
172 . i1=ig,
173 . c1=titr)
174 ENDIF
175 IF (iecrou == 5. and. (ifunc1 == 0 .OR. ifunc3 == 0)) THEN
176 CALL ancmsg(msgid=231,
177 . msgtype=msgerror,
178 . anmode=aninfo_blind_1,
179 . i1=ig,
180 . c1=titr)
181 ENDIF
182 IF (((iecrou==6).OR.(iecrou==9)) .AND. (ifunc1 == 0 .OR. ifunc3 == 0)) THEN
183 CALL ancmsg(msgid=1057,
184 . msgtype=msgerror,
185 . anmode=aninfo_blind_1,
186 . i1=ig,
187 . c1=titr)
188 ENDIF
189 IF (iecrou == 7 .AND. ifunc1 == 0) THEN
190 CALL ancmsg(msgid=1058,
191 . msgtype=msgerror,
192 . anmode=aninfo_blind_1,
193 . i1=ig,
194 . c1=titr)
195 ELSEIF (iecrou == 7 .AND. ifunc3 == 0) THEN
196 CALL ancmsg(msgid=1059,
197 . msgtype=msgwarning,
198 . anmode=aninfo_blind_1,
199 . i1=ig,
200 . c1=titr,
201 . i2=iecrou)
202 iecrou = 2
203 ENDIF
204 IF (ifunc1 == 0 .AND. a /= zero .AND. a /= one) THEN
205 CALL ancmsg(msgid=663,
206 . msgtype=msgwarning,
207 . anmode=aninfo_blind_1,
208 . i1=ig,
209 . c1=titr)
210 ENDIF
211C--------
212C----
213 IF (dn == zero) dn=-infinity
214 IF (dx == zero) dx= infinity
215 IF (a == zero) THEN
216 CALL hm_get_floatv_dim('Acoeft1' ,a_unit ,is_available, lsubmodel, unitab)
217 a = one * a_unit
218 ENDIF
219 IF (d == zero) THEN
220 CALL hm_get_floatv_dim('Dcoeft1' ,d_unit ,is_available, lsubmodel, unitab)
221 d = one * d_unit
222 ENDIF
223 IF (e == zero) THEN
224 CALL hm_get_floatv_dim('Prop_X_E',e_unit ,is_available, lsubmodel, unitab)
225 e = one * e_unit
226 ENDIF
227 IF (f == zero) THEN
228 CALL hm_get_floatv_dim('Prop_X_F',f_unit ,is_available, lsubmodel, unitab)
229 f = one * f_unit
230 ENDIF
231 IF (lscale == zero) THEN
232 CALL hm_get_floatv_dim('scale1',l_unit ,is_available, lsubmodel, unitab)
233 lscale = one*l_unit
234 ENDIF
235 IF (gf3 == zero) THEN
236 CALL hm_get_floatv_dim('ffac',gf_unit ,is_available, lsubmodel, unitab)
237 gf3 = one*gf_unit
238 ENDIF
239 IF (ifunc1 == 0) THEN
240 a = one
241 b = zero
242 e = zero
243 ENDIF
244!
245C----
246 i1 = nuparam
247 i2 = i1 + 6
248 i3 = i2 + 6
249 i4 = i3 + 6
250 i5 = i4 + 6
251 i6 = i5 + 6
252 i7 = i6 + 6
253 i8 = i7 + 6
254 i9 = i8 + 6
255 i10 = i9 + 6
256 i11 = i10 + 6 ! not used
257 i12 = i11 + 6
258 i13 = i12 + 6
259 ! I14 not used
260C
261 uparam(i1 + 1) = a !
262 uparam(i2 + 1) = b
263 uparam(i3 + 1) = d
264 uparam(i4 + 1) = e
265 uparam(i5 + 1) = gf3
266 uparam(i6 + 1) = one / f
267 uparam(i7 + 1) = one / lscale
268 uparam(i8 + 1) = dn
269 uparam(i9 + 1) = dx
270 uparam(i10 + 1) = zero ! not used
271 uparam(i11 + 1) = xk
272 uparam(i12 + 1) = xc
273 uparam(i13 + 1) = iecrou+pun
274C
275C for interface stifness
276 pm(191) = xk
277 !!
278C-- If H=6 -
279 IF ((iecrou==6).OR.(iecrou==9)) THEN
280 uparam(4) = 6
281 ENDIF
282 IF (iecrou==9) siz_array_comp = 6
283C
284 if1 = 0
285 if2 = 6
286 if3 = 12
287 if4 = 18
288!!
289 ifunc(1) = ifunc1
290 ifunc(if2 + 1) = ifunc2
291 ifunc(if3 + 1) = ifunc3
292 ifunc(if4 + 1) = ifunc4
293 nfunc = 4
294C----
295 IF (is_encrypted) THEN
296 ! WRITE(IOUT,'(5X,A,//)')'CONFIDENTIAL DATA'
297 ELSE
298 IF (iecrou /= 5) THEN
299 WRITE(iout,1810)'X',xk,xc,ifunc1,lscale,ifunc3,f,iecrou,
300 . a,b,d,e,gf3,ifunc2,ifunc4,dn,dx
301 ELSE
302 WRITE(iout,1820)'X',xk,xc,ifunc1,lscale,ifunc3,f,iecrou,
303 . a,b,d,e,gf3,ifunc2,ifunc4,dn,dx
304 ENDIF ! IF (IECROU /= 5)
305 ENDIF ! IF (IS_ENCRYPTED)
306c-------------------------------------------------------------------------------
307!-----------------
308 ! Shear XY
309!-----------------
310C
311 CALL hm_get_floatv('STIFF2' ,xk ,is_available, lsubmodel, unitab)
312 CALL hm_get_floatv('DAMP2' ,xc ,is_available, lsubmodel, unitab)
313 CALL hm_get_floatv('Acoeft2' ,a ,is_available, lsubmodel, unitab)
314 CALL hm_get_floatv('Bcoeft2' ,b ,is_available, lsubmodel, unitab)
315 CALL hm_get_floatv('Dcoeft2' ,d ,is_available, lsubmodel, unitab)
316 CALL hm_get_intv ('FUN_A2' ,ifunc1 ,is_available, lsubmodel)
317 CALL hm_get_intv ('HFLAG2' ,iecrou ,is_available, lsubmodel)
318 CALL hm_get_intv ('FUN_B2' ,ifunc2 ,is_available, lsubmodel)
319 CALL hm_get_intv ('FUN_C2' ,ifunc3 ,is_available, lsubmodel)
320 CALL hm_get_intv ('FUN_D2' ,ifunc4 ,is_available, lsubmodel)
321 CALL hm_get_floatv('MIN_RUP2' ,dn ,is_available, lsubmodel, unitab)
322 CALL hm_get_floatv('MAX_RUP2' ,dx ,is_available, lsubmodel, unitab)
323 CALL hm_get_floatv('Prop_Y_F' ,f ,is_available, lsubmodel, unitab)
324 CALL hm_get_floatv('Prop_Y_E' ,e ,is_available, lsubmodel, unitab)
325 CALL hm_get_floatv('scale2' ,lscale ,is_available, lsubmodel, unitab)
326 CALL hm_get_floatv('df' ,gf3 ,is_available, lsubmodel, unitab)
327C
328 IF (iecrou == 4 .AND. (ifunc1 == 0 .OR. ifunc3 == 0)) THEN
329 CALL ancmsg(msgid=231,
330 . msgtype=msgerror,
331 . anmode=aninfo_blind_1,
332 . i1=ig,
333 . c1=titr)
334 ENDIF
335!! IF (IECROU == 4 .AND. GEO(2) == ZERO)THEN
336 IF (iecrou == 4 )THEN
337 CALL ancmsg(msgid=230,
338 . msgtype=msgerror,
339 . anmode=aninfo_blind_1,
340 . i1=ig,
341 . c1=titr)
342 ENDIF
343 IF (iecrou == 5 .AND. (ifunc1 == 0 .OR. ifunc3 == 0)) THEN
344 CALL ancmsg(msgid=231,
345 . msgtype=msgerror,
346 . anmode=aninfo_blind_1,
347 . i1=ig,
348 . c1=titr)
349 ENDIF
350 IF (((iecrou==6).OR.(iecrou==9)) .AND. (ifunc1 == 0 .OR. ifunc3 == 0)) THEN
351 CALL ancmsg(msgid=1057,
352 . msgtype=msgerror,
353 . anmode=aninfo_blind_1,
354 . i1=ig,
355 . c1=titr)
356 ENDIF
357 IF (iecrou == 7 .AND. ifunc1 == 0) THEN
358 CALL ancmsg(msgid=1058,
359 . msgtype=msgerror,
360 . anmode=aninfo_blind_1,
361 . i1=ig,
362 . c1=titr)
363 ELSEIF (iecrou == 7 .AND. ifunc3 == 0) THEN
364 CALL ancmsg(msgid=1059,
365 . msgtype=msgwarning,
366 . anmode=aninfo_blind_1,
367 . i1=ig,
368 . c1=titr,
369 . i2=iecrou)
370 iecrou = 2
371 ENDIF
372 IF (ifunc1 == 0 .AND. a /= zero .AND. a /= one) THEN
373 CALL ancmsg(msgid=663,
374 . msgtype=msgwarning,
375 . anmode=aninfo_blind_1,
376 . i1=ig,
377 . c1=titr)
378 ENDIF
379C----
380 IF (dn == zero) dn =-infinity
381 IF (dx == zero) dx = infinity
382 IF (a == zero) THEN
383 CALL hm_get_floatv_dim('Acoeft2' ,a_unit ,is_available, lsubmodel, unitab)
384 a = one * a_unit
385 ENDIF
386 IF (d == zero) THEN
387 CALL hm_get_floatv_dim('Dcoeft2' ,d_unit ,is_available, lsubmodel, unitab)
388 d = one * d_unit
389 ENDIF
390 IF (e == zero) THEN
391 CALL hm_get_floatv_dim('Prop_Y_E',e_unit ,is_available, lsubmodel, unitab)
392 e = one * e_unit
393 ENDIF
394 IF (f == zero) THEN
395 CALL hm_get_floatv_dim('Prop_Y_F',f_unit ,is_available, lsubmodel, unitab)
396 f = one * f_unit
397 ENDIF
398 IF (lscale == zero) THEN
399 CALL hm_get_floatv_dim('scale2',l_unit ,is_available, lsubmodel, unitab)
400 lscale = one*l_unit
401 ENDIF
402 IF (gf3 == zero) THEN
403 CALL hm_get_floatv_dim('df',gf_unit ,is_available, lsubmodel, unitab)
404 gf3 = one*gf_unit
405 ENDIF
406 IF (ifunc1 == 0) THEN
407 a = one
408 b = zero
409 e = zero
410 ENDIF
411C----
412 uparam(i1 + 2) = a !
413 uparam(i2 + 2) = b
414 uparam(i3 + 2) = d
415 uparam(i4 + 2) = e
416 uparam(i5 + 2) = gf3
417 uparam(i6 + 2) = one / f
418 uparam(i7 + 2) = one / lscale
419 uparam(i8 + 2) = dn
420 uparam(i9 + 2) = dx
421 uparam(i10 + 2) = zero ! not used
422 uparam(i11 + 2) = xk
423 uparam(i12 + 2) = xc
424 uparam(i13 + 2) = iecrou+pun
425C for interface stifness
426 pm(192) = xk
427 !!
428C-- If H=6 - additional internal variables must be stored in UVAR -
429 IF ((iecrou==6).OR.(iecrou==9)) THEN
430 uparam(4) = 6
431 ENDIF
432 IF (iecrou==9) siz_array_comp = 6
433C
434 ifunc(2) = ifunc1
435 ifunc(if2 + 2) = ifunc2
436 ifunc(if3 + 2) = ifunc3
437 ifunc(if4 + 2) = ifunc4
438 nfunc = nfunc + 4
439C----
440 IF (is_encrypted) THEN
441 ! WRITE(IOUT,'(5X,A,//)')'CONFIDENTIAL DATA'
442 ELSE
443 IF (iecrou /= 5) THEN
444 WRITE(iout,1810)'Y ',xk,xc,ifunc1,lscale,ifunc3,f,iecrou,
445 . a,b,d,e,gf3,ifunc2,ifunc4,dn,dx
446 ELSE
447 WRITE(iout,1820)'Y SHEAR',xk,xc,ifunc1,lscale,ifunc3,f,iecrou,
448 . a,b,d,e,gf3,ifunc2,ifunc4,dn,dx
449 ENDIF ! IF (IECROU /= 5)
450 ENDIF ! IF (IS_ENCRYPTED)
451c-------------------------------------------------------------------------------
452!-----------------
453 ! Traction Z
454!-----------------
455c
456 CALL hm_get_floatv('STIFF3' ,xk ,is_available, lsubmodel, unitab)
457 CALL hm_get_floatv('DAMP3' ,xc ,is_available, lsubmodel, unitab)
458 CALL hm_get_floatv('Acoeft3' ,a ,is_available, lsubmodel, unitab)
459 CALL hm_get_floatv('Bcoeft3' ,b ,is_available, lsubmodel, unitab)
460 CALL hm_get_floatv('Dcoeft3' ,d ,is_available, lsubmodel, unitab)
461 CALL hm_get_intv ('FUN_A3' ,ifunc1 ,is_available, lsubmodel)
462 CALL hm_get_intv ('HFLAG3' ,iecrou ,is_available, lsubmodel)
463 CALL hm_get_intv ('FUN_B3' ,ifunc2 ,is_available, lsubmodel)
464 CALL hm_get_intv ('FUN_C3' ,ifunc3 ,is_available, lsubmodel)
465 CALL hm_get_intv ('FUN_D3' ,ifunc4 ,is_available, lsubmodel)
466 CALL hm_get_floatv('MIN_RUP3' ,dn ,is_available, lsubmodel, unitab)
467 CALL hm_get_floatv('MAX_RUP3' ,dx ,is_available, lsubmodel, unitab)
468 CALL hm_get_floatv('Prop_Z_F' ,f ,is_available, lsubmodel, unitab)
469 CALL hm_get_floatv('Prop_Z_E' ,e ,is_available, lsubmodel, unitab)
470 CALL hm_get_floatv('scale3' ,lscale ,is_available, lsubmodel, unitab)
471 CALL hm_get_floatv('D2' ,gf3 ,is_available, lsubmodel, unitab)
472C----
473 IF (iecrou == 4 .AND. (ifunc1 == 0 .OR. ifunc3 == 0)) THEN
474 CALL ancmsg(msgid=231,
475 . msgtype=msgerror,
476 . anmode=aninfo_blind_1,
477 . i1=ig,
478 . c1=titr)
479 ENDIF
480!! IF (IECROU == 4 .AND. GEO(2) == ZERO) THEN
481 IF (iecrou == 4 ) THEN
482 CALL ancmsg(msgid=230,
483 . msgtype=msgerror,
484 . anmode=aninfo_blind_1,
485 . i1=ig,
486 . c1=titr)
487 ENDIF
488 IF (iecrou == 5 .AND. (ifunc1 == 0 .OR. ifunc3 == 0)) THEN
489 CALL ancmsg(msgid=231,
490 . msgtype=msgerror,
491 . anmode=aninfo_blind_1,
492 . i1=ig,
493 . c1=titr)
494 ENDIF
495 IF (((iecrou==6).OR.(iecrou==9)) .AND. (ifunc1 == 0 .OR. ifunc3 == 0)) THEN
496 CALL ancmsg(msgid=1057,
497 . msgtype=msgerror,
498 . anmode=aninfo_blind_1,
499 . i1=ig,
500 . c1=titr)
501 ENDIF
502 IF (iecrou == 7 .AND. ifunc1 == 0) THEN
503 CALL ancmsg(msgid=1058,
504 . msgtype=msgerror,
505 . anmode=aninfo_blind_1,
506 . i1=ig,
507 . c1=titr)
508 ELSEIF (iecrou == 7 .AND. ifunc3 == 0) THEN
509 CALL ancmsg(msgid=1059,
510 . msgtype=msgwarning,
511 . anmode=aninfo_blind_1,
512 . i1=ig,
513 . c1=titr,
514 . i2=iecrou)
515 iecrou = 2
516 ENDIF
517 IF (ifunc1 == 0 .AND. a /= zero .AND. a /= one) THEN
518 CALL ancmsg(msgid=663,
519 . msgtype=msgwarning,
520 . anmode=aninfo_blind_1,
521 . i1=ig,
522 . c1=titr)
523 ENDIF
524C----
525 IF (dn == zero) dn =-infinity
526 IF (dx == zero) dx = infinity
527 IF (a == zero) THEN
528 CALL hm_get_floatv_dim('Acoeft3' ,a_unit ,is_available, lsubmodel, unitab)
529 a = one * a_unit
530 ENDIF
531 IF (d == zero) THEN
532 CALL hm_get_floatv_dim('Dcoeft3' ,d_unit ,is_available, lsubmodel, unitab)
533 d = one * d_unit
534 ENDIF
535 IF (e == zero) THEN
536 CALL hm_get_floatv_dim('Prop_Z_E',e_unit ,is_available, lsubmodel, unitab)
537 e = one * e_unit
538 ENDIF
539 IF (f == zero) THEN
540 CALL hm_get_floatv_dim('Prop_Z_F',f_unit ,is_available, lsubmodel, unitab)
541 f = one * f_unit
542 ENDIF
543 IF (lscale == zero) THEN
544 CALL hm_get_floatv_dim('scale3',l_unit ,is_available, lsubmodel, unitab)
545 lscale = one*l_unit
546 ENDIF
547 IF (gf3 == zero) THEN
548 CALL hm_get_floatv_dim('D2' ,gf_unit ,is_available, lsubmodel, unitab)
549 gf3 = one*gf_unit
550 ENDIF
551 IF (ifunc1 == 0) THEN
552 a = one
553 b = zero
554 e = zero
555 ENDIF
556C----
557 uparam(i1 + 3) = a !
558 uparam(i2 + 3) = b
559 uparam(i3 + 3) = d
560 uparam(i4 + 3) = e
561 uparam(i5 + 3) = gf3
562 uparam(i6 + 3) = one / f
563 uparam(i7 + 3) = one / lscale
564 uparam(i8 + 3) = dn
565 uparam(i9 + 3) = dx
566 uparam(i10 + 3) = zero ! not used
567 uparam(i11 + 3) = xk
568 uparam(i12 + 3) = xc
569 uparam(i13 + 3) = iecrou+pun
570C for interface stifness
571 pm(193) = xk
572 !!
573C-- If H=6 - additional internal variables must be stored in UVAR
574 IF ((iecrou==6).OR.(iecrou==9)) THEN
575 uparam(4) = 6
576 ENDIF
577 IF (iecrou==9) siz_array_comp = 6
578C
579 ifunc(3) = ifunc1
580 ifunc(if2 + 3) = ifunc2
581 ifunc(if3 + 3) = ifunc3
582 ifunc(if4 + 3) = ifunc4
583 nfunc = nfunc + 4
584C----
585 IF (is_encrypted) THEN
586! ! WRITE(IOUT,'(5X,A,//)')'CONFIDENTIAL DATA'
587 ELSE
588 IF (iecrou /= 5) THEN
589 WRITE(iout,1810)'Z ',xk,xc,ifunc1,lscale,ifunc3,f,iecrou,
590 . a,b,d,e,gf3,ifunc2,ifunc4,dn,dx
591 ELSE
592 WRITE(iout,1820)'Z ',xk,xc,ifunc1,lscale,ifunc3,f,iecrou,
593 . a,b,d,e,gf3,ifunc2,ifunc4,dn,dx
594 ENDIF ! IF (IECROU /= 5)
595 ENDIF ! IF (IS_ENCRYPTED)
596c
597!-------------------------------------------------------
598! Rotations
599!-------------------------------------------------------
600!-----------------
601 ! Torsion X
602!-----------------
603 CALL hm_get_floatv('STIFF4' ,xk ,is_available, lsubmodel, unitab)
604 CALL hm_get_floatv('DAMP4' ,xc ,is_available, lsubmodel, unitab)
605 CALL hm_get_floatv('Acoeft4' ,a ,is_available, lsubmodel, unitab)
606 CALL hm_get_floatv('Bcoeft4' ,b ,is_available, lsubmodel, unitab)
607 CALL hm_get_floatv('Dcoeft4' ,d ,is_available, lsubmodel, unitab)
608 CALL hm_get_intv ('FUN_A4' ,ifunc1 ,is_available, lsubmodel)
609 CALL hm_get_intv ('HFLAG4' ,iecrou ,is_available, lsubmodel)
610 CALL hm_get_intv ('FUN_B4' ,ifunc2 ,is_available, lsubmodel)
611 CALL hm_get_intv ('FUN_C4' ,ifunc3 ,is_available, lsubmodel)
612 CALL hm_get_intv ('FUN_D4' ,ifunc4 ,is_available, lsubmodel)
613 CALL hm_get_floatv('MIN_RUP4' ,dn ,is_available, lsubmodel, unitab)
614 CALL hm_get_floatv('MAX_RUP4' ,dx ,is_available, lsubmodel, unitab)
615 CALL hm_get_floatv('Prop_Tor_F',f ,is_available, lsubmodel, unitab)
616 CALL hm_get_floatv('Prop_Tor_E',e ,is_available, lsubmodel, unitab)
617 CALL hm_get_floatv('scale4' ,lscale ,is_available, lsubmodel, unitab)
618 CALL hm_get_floatv('Y0' ,gf3 ,is_available, lsubmodel, unitab)
619C----
620 IF (iecrou == 4 .AND. (ifunc1 == 0 .OR. ifunc3 == 0)) THEN
621 CALL ancmsg(msgid=231,
622 . msgtype=msgerror,
623 . anmode=aninfo_blind_1,
624 . i1=ig,
625 . c1=titr)
626 ENDIF
627!! IF (IECROU == 4. AND. GEO(2) == ZERO) THEN
628 IF (iecrou == 4) THEN
629 CALL ancmsg(msgid=230,
630 . msgtype=msgerror,
631 . anmode=aninfo_blind_1,
632 . i1=ig,
633 . c1=titr)
634 ENDIF
635 IF (iecrou == 5 .AND. (ifunc1 == 0 .OR. ifunc3 == 0)) THEN
636 CALL ancmsg(msgid=231,
637 . msgtype=msgerror,
638 . anmode=aninfo_blind_1,
639 . i1=ig,
640 . c1=titr)
641 ENDIF
642 IF (((iecrou==6).OR.(iecrou==9)) .AND. (ifunc1 == 0 .OR. ifunc3 == 0)) THEN
643 CALL ancmsg(msgid=1057,
644 . msgtype=msgerror,
645 . anmode=aninfo_blind_1,
646 . i1=ig,
647 . c1=titr)
648 ENDIF
649 IF (iecrou == 7 .AND. ifunc1 == 0) THEN
650 CALL ancmsg(msgid=1058,
651 . msgtype=msgerror,
652 . anmode=aninfo_blind_1,
653 . i1=ig,
654 . c1=titr)
655 ELSEIF (iecrou == 7 .AND. ifunc3 == 0) THEN
656 CALL ancmsg(msgid=1059,
657 . msgtype=msgwarning,
658 . anmode=aninfo_blind_1,
659 . i1=ig,
660 . c1=titr,
661 . i2=iecrou)
662 iecrou = 2
663 ENDIF
664 IF (ifunc1 == 0 .AND. a /= zero .AND. a /= one) THEN
665 CALL ancmsg(msgid=663,
666 . msgtype=msgwarning,
667 . anmode=aninfo_blind_1,
668 . i1=ig,
669 . c1=titr)
670 ENDIF
671C----
672 IF (dn == zero) dn =-infinity
673 IF (dx == zero) dx = infinity
674 IF (a == zero) THEN
675 CALL hm_get_floatv_dim('Acoeft4' ,a_unit ,is_available, lsubmodel, unitab)
676 a = one * a_unit
677 ENDIF
678 IF (d == zero) THEN
679 CALL hm_get_floatv_dim('Dcoeft4' ,d_unit ,is_available, lsubmodel, unitab)
680 d = one * d_unit
681 ENDIF
682 IF (e == zero) THEN
683 CALL hm_get_floatv_dim('Prop_Tor_E',e_unit ,is_available, lsubmodel, unitab)
684 e = one * e_unit
685 ENDIF
686 IF (f == zero) THEN
687 CALL hm_get_floatv_dim('Prop_Tor_F',f_unit ,is_available, lsubmodel, unitab)
688 f = one * f_unit
689 ENDIF
690 IF (lscale == zero) THEN
691 CALL hm_get_floatv_dim('scale4',l_unit ,is_available, lsubmodel, unitab)
692 lscale = one*l_unit
693 ENDIF
694 IF (gf3 == zero) THEN
695 CALL hm_get_floatv_dim('Y0',gf_unit ,is_available, lsubmodel, unitab)
696 gf3 = one*gf_unit
697 ENDIF
698 IF (ifunc1 == 0) THEN
699 a = one
700 b = zero
701 e = zero
702 ENDIF
703C----
704C
705 uparam(i1 + 4) = a !
706 uparam(i2 + 4) = b
707 uparam(i3 + 4) = d
708 uparam(i4 + 4) = e
709 uparam(i5 + 4) = gf3
710 uparam(i6 + 4) = one / f
711 uparam(i7 + 4) = one / lscale
712 uparam(i8 + 4) = dn
713 uparam(i9 + 4) = dx
714 uparam(i10 + 4) = zero ! not used
715 uparam(i11 + 4) = xk
716 uparam(i12 + 4) = xc
717 uparam(i13 + 4) = iecrou+pun
718C-- If H=6 - additional internal variables must be stored in UVAR -
719 IF ((iecrou==6).OR.(iecrou==9)) THEN
720 uparam(4) = 6
721 ENDIF
722 IF (iecrou==9) siz_array_comp = 6
723C
724 ifunc(4) = ifunc1
725 ifunc(if2 + 4) = ifunc2
726 ifunc(if3 + 4) = ifunc3
727 ifunc(if4 + 4) = ifunc4
728 nfunc = nfunc + 4
729C----
730 IF (is_encrypted) THEN
731 ! WRITE(IOUT,'(5X,A,//)')'CONFIDENTIAL DATA'
732 ELSE
733 IF (iecrou /= 5) THEN
734 WRITE(iout,1830)'x rotation',XK,XC,IFUNC1,LSCALE,IFUNC3,F,IECROU,
735 . A,B,D,E,GF3,IFUNC2,IFUNC4,DN,DX
736 ELSE
737 WRITE(IOUT,1840)'x rotation',XK,XC,IFUNC1,LSCALE,IFUNC3,F,IECROU,
738 . A,B,D,E,GF3,IFUNC2,IFUNC4,DN,DX
739 ENDIF ! IF (IECROU /= 5)
740 ENDIF ! IF (IS_ENCRYPTED)
741C
742!-----------------
743 ! Rotation Y
744!----------------
745 CALL HM_GET_FLOATV('stiff5' ,XK ,IS_AVAILABLE, LSUBMODEL, UNITAB)
746 CALL HM_GET_FLOATV('damp5' ,XC ,IS_AVAILABLE, LSUBMODEL, UNITAB)
747 CALL HM_GET_FLOATV('acoeft5' ,A ,IS_AVAILABLE, LSUBMODEL, UNITAB)
748 CALL HM_GET_FLOATV('bcoeft5' ,B ,IS_AVAILABLE, LSUBMODEL, UNITAB)
749 CALL HM_GET_FLOATV('dcoeft5' ,D ,IS_AVAILABLE, LSUBMODEL, UNITAB)
750 CALL HM_GET_INTV ('fun_a5' ,IFUNC1 ,IS_AVAILABLE, LSUBMODEL)
751 CALL HM_GET_INTV ('hflag5' ,IECROU ,IS_AVAILABLE, LSUBMODEL)
752 CALL HM_GET_INTV ('fun_b5' ,IFUNC2 ,IS_AVAILABLE, LSUBMODEL)
753 CALL HM_GET_INTV ('fun_c5' ,IFUNC3 ,IS_AVAILABLE, LSUBMODEL)
754 CALL HM_GET_INTV ('fun_d5' ,IFUNC4 ,IS_AVAILABLE, LSUBMODEL)
755 CALL HM_GET_FLOATV('min_rup5' ,DN ,IS_AVAILABLE, LSUBMODEL, UNITAB)
756 CALL HM_GET_FLOATV('max_rup5' ,DX ,IS_AVAILABLE, LSUBMODEL, UNITAB)
757 CALL HM_GET_FLOATV('prop_flxy_f',F ,IS_AVAILABLE, LSUBMODEL, UNITAB)
758 CALL HM_GET_FLOATV('prop_flxy_e',E ,IS_AVAILABLE, LSUBMODEL, UNITAB)
759 CALL HM_GET_FLOATV('scale5' ,LSCALE ,IS_AVAILABLE, LSUBMODEL, UNITAB)
760 CALL HM_GET_FLOATV('z0' ,GF3 ,IS_AVAILABLE, LSUBMODEL, UNITAB)
761C----
762.AND..OR. IF (IECROU == 4 (IFUNC1 == 0 IFUNC3 == 0)) THEN
763 CALL ANCMSG(MSGID=231,
764 . MSGTYPE=MSGERROR,
765 . ANMODE=ANINFO_BLIND_1,
766 . I1=IG,
767 . C1=TITR)
768 ENDIF
769.AND.!! IF (IECROU == 4 GEO(2) == ZERO) THEN
770 IF (IECROU == 4 ) THEN
771 CALL ANCMSG(MSGID=230,
772 . MSGTYPE=MSGERROR,
773 . ANMODE=ANINFO_BLIND_1,
774 . I1=IG,
775 . C1=TITR)
776 ENDIF
777.AND..OR. IF (IECROU == 5 (IFUNC1 == 0 IFUNC3 == 0)) THEN
778 CALL ANCMSG(MSGID=231,
779 . MSGTYPE=MSGERROR,
780 . ANMODE=ANINFO_BLIND_1,
781 . I1=IG,
782 . C1=TITR)
783 ENDIF
784.OR..AND..OR. IF (((IECROU==6)(IECROU==9)) (IFUNC1 == 0 IFUNC3 == 0)) THEN
785 CALL ANCMSG(MSGID=1057,
786 . MSGTYPE=MSGERROR,
787 . ANMODE=ANINFO_BLIND_1,
788 . I1=IG,
789 . C1=TITR)
790 ENDIF
791.AND. IF (IECROU == 7 IFUNC1 == 0) THEN
792 CALL ANCMSG(MSGID=1058,
793 . MSGTYPE=MSGERROR,
794 . ANMODE=ANINFO_BLIND_1,
795 . I1=IG,
796 . C1=TITR)
797.AND. ELSEIF (IECROU == 7 IFUNC3 == 0) THEN
798 CALL ANCMSG(MSGID=1059,
799 . MSGTYPE=MSGWARNING,
800 . ANMODE=ANINFO_BLIND_1,
801 . I1=IG,
802 . C1=TITR,
803 . I2=IECROU)
804 IECROU = 2
805 ENDIF
806.AND..AND. IF (IFUNC1 == 0 A /= ZERO A /= ONE) THEN
807 CALL ANCMSG(MSGID=663,
808 . MSGTYPE=MSGWARNING,
809 . ANMODE=ANINFO_BLIND_1,
810 . I1=IG,
811 . C1=TITR)
812 ENDIF
813C----
814 IF (DN == ZERO) DN =-INFINITY
815 IF (DX == ZERO) DX = INFINITY
816 IF (A == ZERO) THEN
817 CALL HM_GET_FLOATV_DIM('acoeft5' ,A_UNIT ,IS_AVAILABLE, LSUBMODEL, UNITAB)
818 A = ONE * A_UNIT
819 ENDIF
820 IF (D == ZERO) THEN
821 CALL HM_GET_FLOATV_DIM('dcoeft5' ,D_UNIT ,IS_AVAILABLE, LSUBMODEL, UNITAB)
822 D = ONE * D_UNIT
823 ENDIF
824 IF (E == ZERO) THEN
825 CALL HM_GET_FLOATV_DIM('prop_flxy_e',E_UNIT ,IS_AVAILABLE, LSUBMODEL, UNITAB)
826 E = ONE * E_UNIT
827 ENDIF
828 IF (F == ZERO) THEN
829 CALL HM_GET_FLOATV_DIM('prop_flxy_f',F_UNIT ,IS_AVAILABLE, LSUBMODEL, UNITAB)
830 F = ONE * F_UNIT
831 ENDIF
832 IF (LSCALE == ZERO) THEN
833 CALL HM_GET_FLOATV_DIM('scale5',L_UNIT ,IS_AVAILABLE, LSUBMODEL, UNITAB)
834 LSCALE = ONE*L_UNIT
835 ENDIF
836 IF (GF3 == ZERO) THEN
837 CALL HM_GET_FLOATV_DIM('z0',GF_UNIT ,IS_AVAILABLE, LSUBMODEL, UNITAB)
838 GF3 = ONE*GF_UNIT
839 ENDIF
840 IF (IFUNC1 == 0) THEN
841 A = ONE
842 B = ZERO
843 E = ZERO
844 ENDIF
845C----
846 UPARAM(I1 + 5) = A !
847 UPARAM(I2 + 5) = B
848 UPARAM(I3 + 5) = D
849 UPARAM(I4 + 5) = E
850 UPARAM(I5 + 5) = GF3
851 UPARAM(I6 + 5) = ONE / F
852 UPARAM(I7 + 5) = ONE / LSCALE
853 UPARAM(I8 + 5) = DN
854 UPARAM(I9 + 5) = DX
855 UPARAM(I10 + 5) = ZERO ! not used
856 UPARAM(I11 + 5) = XK
857 UPARAM(I12 + 5) = XC
858 UPARAM(I13 + 5) = IECROU+PUN
859C-- If H=6 - additional internal variables must be stored in UVAR -
860.OR. IF ((IECROU==6)(IECROU==9)) THEN
861 UPARAM(4) = 6
862 ENDIF
863 IF (IECROU==9) SIZ_ARRAY_COMP = 6
864C
865 IFUNC(5) = IFUNC1
866 IFUNC(IF2 + 5) = IFUNC2
867 IFUNC(IF3 + 5) = IFUNC3
868 IFUNC(IF4 + 5) = IFUNC4
869 NFUNC = NFUNC + 4
870C----
871 IF (IS_ENCRYPTED) THEN
872 ! WRITE(IOUT,'(5x,a,//)')'confidential data'
873 ELSE
874 IF (IECROU /= 5) THEN
875 WRITE(IOUT,1830)'y rotation ',XK,XC,IFUNC1,LSCALE,IFUNC3,F,
876 . IECROU,A,B,D,E,GF3,IFUNC2,IFUNC4,DN,DX
877 ELSE
878 WRITE(IOUT,1840)'y rotation',XK,XC,IFUNC1,LSCALE,IFUNC3,F,
879 . IECROU,A,B,D,E,GF3,IFUNC2,IFUNC4,DN,DX
880 ENDIF ! IF (IECROU /= 5)
881 ENDIF ! IF (IS_ENCRYPTED)
882C
883!-----------------
884 ! Rotation Z
885!-----------------
886 CALL HM_GET_FLOATV('stiff6' ,XK ,IS_AVAILABLE, LSUBMODEL, UNITAB)
887 CALL HM_GET_FLOATV('damp6' ,XC ,IS_AVAILABLE, LSUBMODEL, UNITAB)
888 CALL HM_GET_FLOATV('acoeft6' ,A ,IS_AVAILABLE, LSUBMODEL, UNITAB)
889 CALL HM_GET_FLOATV('bcoeft6' ,B ,IS_AVAILABLE, LSUBMODEL, UNITAB)
890 CALL HM_GET_FLOATV('dcoeft6' ,D ,IS_AVAILABLE, LSUBMODEL, UNITAB)
891 CALL HM_GET_INTV ('fun_a6' ,IFUNC1 ,IS_AVAILABLE, LSUBMODEL)
892 CALL HM_GET_INTV ('hflag6' ,IECROU ,IS_AVAILABLE, LSUBMODEL)
893 CALL HM_GET_INTV ('fun_b6' ,IFUNC2 ,IS_AVAILABLE, LSUBMODEL)
894 CALL HM_GET_INTV ('fun_c6' ,IFUNC3 ,IS_AVAILABLE, LSUBMODEL)
895 CALL HM_GET_INTV ('fun_d6' ,IFUNC4 ,IS_AVAILABLE, LSUBMODEL)
896 CALL HM_GET_FLOATV('min_rup6' ,DN ,IS_AVAILABLE, LSUBMODEL, UNITAB)
897 CALL HM_GET_FLOATV('max_rup6' ,DX ,IS_AVAILABLE, LSUBMODEL, UNITAB)
898 CALL HM_GET_FLOATV('prop_flxz_f',F ,IS_AVAILABLE, LSUBMODEL, UNITAB)
899 CALL HM_GET_FLOATV('prop_flxz_e',E ,IS_AVAILABLE, LSUBMODEL, UNITAB)
900 CALL HM_GET_FLOATV('scale6' ,LSCALE ,IS_AVAILABLE, LSUBMODEL, UNITAB)
901 CALL HM_GET_FLOATV('hscale6' ,GF3 ,IS_AVAILABLE, LSUBMODEL, UNITAB)
902C----
903.AND..OR. IF (IECROU == 4 (IFUNC1 == 0 IFUNC3 == 0)) THEN
904 CALL ANCMSG(MSGID=231,
905 . MSGTYPE=MSGERROR,
906 . ANMODE=ANINFO_BLIND_1,
907 . I1=IG,
908 . C1=TITR)
909 ENDIF
910.AND.!! IF (IECROU == 4 GEO(2) == ZERO) THEN
911 IF (IECROU == 4 ) THEN
912 CALL ANCMSG(MSGID=230,
913 . MSGTYPE=MSGERROR,
914 . ANMODE=ANINFO_BLIND_1,
915 . I1=IG,
916 . C1=TITR)
917 ENDIF
918.AND..OR. IF (IECROU == 5 (IFUNC1 == 0 IFUNC3 == 0)) THEN
919 CALL ANCMSG(MSGID=231,
920 . MSGTYPE=MSGERROR,
921 . ANMODE=ANINFO_BLIND_1,
922 . I1=IG,
923 . C1=TITR)
924 ENDIF
925.OR..AND..OR. IF (((IECROU==6)(IECROU==9)) (IFUNC1 == 0 IFUNC3 == 0)) THEN
926 CALL ANCMSG(MSGID=1057,
927 . MSGTYPE=MSGERROR,
928 . ANMODE=ANINFO_BLIND_1,
929 . I1=IG,
930 . C1=TITR)
931 ENDIF
932.AND. IF (IECROU == 7 IFUNC1 == 0) THEN
933 CALL ANCMSG(MSGID=1058,
934 . MSGTYPE=MSGERROR,
935 . ANMODE=ANINFO_BLIND_1,
936 . I1=IG,
937 . C1=TITR)
938.AND. ELSEIF (IECROU == 7 IFUNC3 == 0) THEN
939 CALL ANCMSG(MSGID=1059,
940 . MSGTYPE=MSGWARNING,
941 . ANMODE=ANINFO_BLIND_1,
942 . I1=IG,
943 . C1=TITR,
944 . I2=IECROU)
945 IECROU = 2
946 ENDIF
947.AND..AND. IF (IFUNC1 == 0 A /= ZERO A /= ONE) THEN
948 CALL ANCMSG(MSGID=663,
949 . MSGTYPE=MSGWARNING,
950 . ANMODE=ANINFO_BLIND_1,
951 . I1=IG,
952 . C1=TITR)
953 ENDIF
954C----
955 IF (DN == ZERO) DN =-INFINITY
956 IF (DX == ZERO) DX = INFINITY
957 IF (A == ZERO) THEN
958 CALL HM_GET_FLOATV_DIM('acoeft6' ,A_UNIT ,IS_AVAILABLE, LSUBMODEL, UNITAB)
959 A = ONE * A_UNIT
960 ENDIF
961 IF (D == ZERO) THEN
962 CALL HM_GET_FLOATV_DIM('dcoeft6' ,D_UNIT ,IS_AVAILABLE, LSUBMODEL, UNITAB)
963 D = ONE * D_UNIT
964 ENDIF
965 IF (E == ZERO) THEN
966 CALL HM_GET_FLOATV_DIM('prop_flxz_e',E_UNIT ,IS_AVAILABLE, LSUBMODEL, UNITAB)
967 E = ONE * E_UNIT
968 ENDIF
969 IF (F == ZERO) THEN
970 CALL HM_GET_FLOATV_DIM('prop_flxz_f',F_UNIT ,IS_AVAILABLE, LSUBMODEL, UNITAB)
971 F = ONE * F_UNIT
972 ENDIF
973 IF (LSCALE == ZERO) THEN
974 CALL HM_GET_FLOATV_DIM('scale6',L_UNIT ,IS_AVAILABLE, LSUBMODEL, UNITAB)
975 LSCALE = ONE*L_UNIT
976 ENDIF
977 IF (GF3 == ZERO) THEN
978 CALL HM_GET_FLOATV_DIM('hscale6',GF_UNIT ,IS_AVAILABLE, LSUBMODEL, UNITAB)
979 GF3 = ONE*GF_UNIT
980 ENDIF
981 IF (IFUNC1 == 0) THEN
982 A = ONE
983 B = ZERO
984 E = ZERO
985 ENDIF
986C---
987 UPARAM(I1 + 6) = A !
988 UPARAM(I2 + 6) = B
989 UPARAM(I3 + 6) = D
990 UPARAM(I4 + 6) = E
991 UPARAM(I5 + 6) = GF3
992 UPARAM(I6 + 6) = ONE / F
993 UPARAM(I7 + 6) = ONE / LSCALE
994 UPARAM(I8 + 6) = DN
995 UPARAM(I9 + 6) = DX
996 UPARAM(I10 + 6) = ZERO ! not used
997 UPARAM(I11 + 6) = XK
998 UPARAM(I12 + 6) = XC
999 UPARAM(I13 + 6) = IECROU+PUN
1000!!
1001 NUPARAM = NUPARAM + 6*14
1002C-- If H=6 - additional internal variables must be stored in UVAR -
1003.OR. IF ((IECROU==6)(IECROU==9)) THEN
1004 UPARAM(4) = 6
1005 ENDIF
1006 IF (IECROU==9) SIZ_ARRAY_COMP = 6
1007C
1008 IFUNC(6) = IFUNC1
1009 IFUNC(IF2 + 6) = IFUNC2
1010 IFUNC(IF3 + 6) = IFUNC3
1011 IFUNC(IF4 + 6) = IFUNC4
1012 NFUNC = NFUNC + 4
1013C----
1014 IF (IS_ENCRYPTED) THEN
1015 ! WRITE(IOUT,'(5x,a,//)')'confidential data'
1016 ELSE
1017 IF (IECROU /= 5) THEN
1018 WRITE(IOUT,1830)'z rotation',XK,XC,IFUNC1,LSCALE,IFUNC3,F,
1019 . IECROU,A,B,D,E,GF3,IFUNC2,IFUNC4,DN,DX
1020 ELSE
1021 WRITE(IOUT,1840)'z rotation',XK,XC,IFUNC1,LSCALE,IFUNC3,F,
1022 . IECROU,A,B,D,E,GF3,IFUNC2,IFUNC4,DN,DX
1023 ENDIF ! IF (IECROU /= 5)
1024 ENDIF ! IF (IS_ENCRYPTED)
1025C----
1026C-----------------------------
1027!-------------------------------------------------------
1028c--- filtering
1029!-------------------------------------------------------
1030 CALL HM_GET_FLOATV('asrate' ,ASRATE ,IS_AVAILABLE, LSUBMODEL, UNITAB)
1031 CALL HM_GET_INTV ('israte' ,ISRATE ,IS_AVAILABLE, LSUBMODEL)
1032c
1033C----
1034 IF (ASRATE == ZERO) ASRATE = INFINITY
1035C----
1036!
1037 IF (IS_ENCRYPTED) THEN
1038 ! WRITE(IOUT,'(5x,a,//)')'confidential data'
1039 ELSE
1040 WRITE(IOUT,1900) ISRATE,ASRATE
1041 ENDIF
1042!
1043C----! NUPARAM = 88 = 4 + 14*6
1044!
1045 UPARAM(NUPARAM + 1) = ISRATE
1046 UPARAM(NUPARAM + 2) = ASRATE
1047 NUPARAM = NUPARAM + 2
1048C
1049C----! Force offset for iecr=9 - (4 + 14*6) + 2 + 6 - NUPARAM = 96
1050 NUPARAM = NUPARAM + 6
1051C
1052C------------------------
1053C------------------------
1054 MTAG%G_TOTDEPL = 3 ! DX (DY,DZ) - total deformation (translation)
1055 MTAG%G_TOTROT = 3 ! RX (RY,RZ) - total deformation (rotation)
1056 MTAG%G_DEP_IN_TENS = 3 ! DPX (DPY,DPZ) - max displacement in tension
1057 MTAG%G_DEP_IN_COMP = 3 ! DPX2 (DPY2,DPZ2) - max displacement in compression
1058 MTAG%G_ROT_IN_TENS = 3 ! RPX (RPY,RPZ) - max rotation in tension
1059 MTAG%G_ROT_IN_COMP = 3 ! RPX2 (RPY2,RPY2) - max rotation in compression
1060 MTAG%G_POSX = 5
1061 MTAG%G_POSY = 5
1062 MTAG%G_POSZ = 5
1063 MTAG%G_POSXX = 5
1064 MTAG%G_POSYY = 5
1065 MTAG%G_POSZZ = 5
1066 MTAG%G_YIELD = 6
1067 MTAG%G_RUPTCRIT = 1
1068 MTAG%G_NUVAR = MAX(MTAG%G_NUVAR,NINT(UPARAM(4)))
1069 MTAG%G_MASS = 1
1070 MTAG%G_SKEW_ID = 1
1071 MTAG%G_YIELD_IN_COMP = SIZ_ARRAY_COMP ! Yield in compression - H=9
1072 MTAG%G_XXOLD_IN_COMP = SIZ_ARRAY_COMP ! Previous displacement in compression
1073C
1074 ! Properties compatibility
1075 CALL INIT_MAT_KEYWORD(MATPARAM,"SPRING_MATERIAL")
1076C
1077 PARMAT(4) = ISRATE
1078 PARMAT(5) = ASRATE
1079C------------------------
1080 RETURN
1081c-----------
1082 1000 FORMAT(
1083 & 5X,'spring material set'/,
1084 & 5X,'-------------------'/,
1085 & 5X,'material set number . . . . . . . . . .=',I10/,
1086 & 5X,'confidential data'//)
1087 1100 FORMAT(/
1088 & 5X,A,/,
1089 & 5X,'material number. . . . . . . . . . . . =',I10/,
1090 & 5X,'material law . . . . . . . . . . . . . =',I10/)
1091 1300 FORMAT(
1092 & 5X,'initial density . . . . . . . . . . . .=',1PG20.13/)
1093 1700 FORMAT(
1094 & 5X,'failure flag(0:uncoupled 1:coupled). .=',I10/,
1095 & 5X,'failure2(0:displ,1:force,2:energy) . .=',I10/,
1096 & 5X,'equilibrium flag. . . . . . . . . . . .=',I10/,
1097 & 5X,' 0: no equilibrium 1:force and moment equilibrium ' ,/)
1098 1810 FORMAT(
1099 & 5X,A,' translation'/,
1100 & 5X,'spring stiffness. . . . . . . . . . . .=',1PG20.13/,
1101 & 5X,'spring damping. . . . . . . . . . . . .=',1PG20.13/,
1102 & 5X,'FUNCTION identifier for loading ',/,
1103 & 5X,'force-displacement curve. . . . . . . .=',I10/,
1104 & 5X,'abscissa scale factor on curve . . . . =',1PG20.13/,
1105 & 5X,'function identifier for unloading ',/,
1106 & 5X,'force-displacement curve (H=4,5,7). . .=',I10/,
1107 & 5X,'abscissa scale factor on curve . . . . =',1PG20.13/,
1108 & 5X,'hardening flag h. . . . . . . . . . . .=',I10/,
1109 & 5X,'0:elastic 1:isotropic 2:uncoupled',/,
1110 & 5X,'4:kinematic 5:uncoupled nl (UN/RE)loading',/,
1111 & 5X,'6:elasto plastic with hardening 7: elastic hysteresis',/,
1112 & 5X,'dynamic amplification factor a. . . . .=',1PG20.13/,
1113 & 5X,'dynamic amplification factor b. . . . .=',1PG20.13/,
1114 & 5X,'dynamic amplification factor d. . . . .=',1PG20.13/,
1115 & 5X,'dynamic amplification factor e. . . . .=',1PG20.13/,
1116 & 5X,'dynamic amplification factor gf3 . . .=',1PG20.13/,
1117 & 5X,'function identifier for ',/,
1118 & 5X,'force-velocity curve. . . . . . . . . .=',I10/,
1119 & 5X,'function identifier for the additional ',/,
1120 & 5X,'force-velocity curve. . . . . . . . . .=',I10/,
1121 & 5X,'negative failure displacement . . . . .=',1PG20.13/,
1122 & 5X,'positive failure displacement . . . . .=',1PG20.13/)
1123 1820 FORMAT(
1124 & 5X,A,/,
1125 & 5X,'spring stiffness. . . . . . . . . . . .=',1PG20.13/,
1126 & 5X,'spring damping. . . . . . . . . . . . .=',1PG20.13/,
1127 & 5X,'function identifier for loading ',/,
1128 & 5X,'force-displacement curve. . . . . . . .=',I10/,
1129 & 5X,'abscissa scale factor on curve . . . . =',1PG20.13/,
1130 & 5X,'permanent displ./max. displ. curve(H=5)=',I10/,
1131 & 5X,'abscissa scale factor on curve . . . . =',1PG20.13/,
1132 & 5X,'hardening flag h. . . . . . . . . . . .=',I10/,
1133 & 5X,'0:elastic 1:isotropic 2:uncoupled',/,
1134 & 5X,'4:kinematic 5:uncoupled nl (UN/RE)loading',/,
1135 & 5X,'6:elasto plastic with hardening 7: elastic hysteresis',/,
1136 & 5X,'dynamic amplification factor a. . . . .=',1PG20.13/,
1137 & 5X,'dynamic amplification factor b. . . . .=',1PG20.13/,
1138 & 5X,'dynamic amplification factor d. . . . .=',1PG20.13/,
1139 & 5X,'dynamic amplification factor e. . . . .=',1PG20.13/,
1140 & 5X,'dynamic amplification factor gf3 . . .=',1PG20.13/,
1141 & 5X,'function identifier for ',/,
1142 & 5X,'force-velocity curve. . . . . . . . . .=',I10/,
1143 & 5X,'function identifier for the additional ',/,
1144 & 5X,'force-velocity curve. . . . . . . . . .=',I10/,
1145 & 5X,'negative failure displacement . . . . .=',1PG20.13/,
1146 & 5X,'positive failure displacement . . . . .=',1PG20.13/)
1147 1830 FORMAT(
1148 & 5X,A,/,
1149 & 5X,'spring stiffness. . . . . . . . . . . .=',1PG20.13/,
1150 & 5X,'spring damping. . . . . . . . . . . . .=',1PG20.13/,
1151 & 5X,'function identifier for loading ',/,
1152 & 5X,'moment-rotation curve . . . . . . . . .=',I10/,
1153 & 5X,'abscissa scale factor on curve . . . . =',1PG20.13/,
1154 & 5X,'function identifier for unloading ',/,
1155 & 5X,'moment-rotation curve (H=4,5,7). . . . =',I10/,
1156 & 5X,'abscissa scale factor on curve . . . . =',1PG20.13/,
1157 & 5X,'hardening flag h. . . . . . . . . . . .=',I10/,
1158 & 5X,'0:elastic 1:isotropic 2:uncoupled',/,
1159 & 5X,'4:kinematic 5:uncoupled nl (UN/RE)loading',/,
1160 & 5X,'6:elasto plastic with hardening 7: elastic hysteresis',/,
1161 & 5X,'dynamic amplification factor a. . . . .=',1PG20.13/,
1162 & 5X,'dynamic amplification factor b. . . . .=',1PG20.13/,
1163 & 5X,'dynamic amplification factor d. . . . .=',1PG20.13/,
1164 & 5X,'dynamic amplification factor e. . . . .=',1PG20.13/,
1165 & 5X,'dynamic amplification factor gf3 . . .=',1PG20.13/,
1166 & 5X,'function identifier for ',/,
1167 & 5X,'force-velocity curve. . . . . . . . . .=',I10/,
1168 & 5X,'function identifier for the additional ',/,
1169 & 5X,'force-velocity curve. . . . . . . . . .=',I10/,
1170 & 5X,'negative failure rotation . . . . . . .=',1PG20.13/,
1171 & 5X,'positive failure rotation . . . . . . .=',1PG20.13/)
1172 1840 FORMAT(
1173 & 5X,A,/,
1174 & 5X,'spring stiffness. . . . . . . . . . . .=',1PG20.13/,
1175 & 5X,'spring damping. . . . . . . . . . . . .=',1PG20.13/,
1176 & 5X,'function identifier for loading ',/,
1177 & 5X,'moment/rotation curve . . . . . . . . .=',I10/,
1178 & 5X,'abscissa scale factor on curve . . . . =',1PG20.13/,
1179 & 5X,'permanent rot./max. rot. curve (H=5). .=',I10/,
1180 & 5X,'abscissa scale factor on curve . . . . =',1PG20.13/,
1181 & 5X,'hardening flag h. . . . . . . . . . . .=',I10/,
1182 & 5X,'0:elastic 1:isotropic 2:uncoupled',/,
1183 & 5X,'4:kinematic 5:uncoupled nl (UN/RE)loading',/,
1184 & 5X,'6:elasto plastic with hardening 7: elastic hysteresis',/,
1185 & 5X,'dynamic amplification factor a. . . . .=',1PG20.13/,
1186 & 5X,'dynamic amplification factor b. . . . .=',1PG20.13/,
1187 & 5X,'dynamic amplification factor d. . . . .=',1PG20.13/,
1188 & 5X,'dynamic amplification factor e. . . . .=',1PG20.13/,
1189 & 5X,'dynamic amplification factor gf3 . . .=',1PG20.13/,
1190 & 5X,'function identifier for ',/,
1191 & 5X,'force-velocity curve. . . . . . . . . .=',I10/,
1192 & 5X,'function identifier for the additional ',/,
1193 & 5X,'force-velocity curve. . . . . . . . . .=',I10/,
1194 & 5X,'negative failure rotation . . . . . . .=',1PG20.13/,
1195 & 5X,'positive failure rotation . . . . . . .=',1PG20.13/)
1196 1900 FORMAT(
1197 & 5X,'smooth strain rate option . . .. . . . =',I10/,
1198 & 5X,'strain rate cutting frequency .. . . . =',1PG20.13/)
1199c-----------
1200c-----------
1201 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: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
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
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