65
66
67
75 USE matparam_def_mod
77
78
79
80#include "implicit_f.inc"
81
82
83
84#include "com01_c.inc"
85#include "com04_c.inc"
86#include "drape_c.inc"
87#include "param_c.inc"
88#include "scr17_c.inc"
89#include "scry_c.inc"
90#include "vect01_c.inc"
91
92
93
94 TYPE (UNIT_TYPE_),INTENT(IN) ::
95 INTEGER IXS(NIXS,*), IXQ(NIXQ,*) ,IXC(NIXC,*),
96 . IGEO(NPROPGI,*) , IXT(NIXT,*) ,IXP(NIXP,*), IXR(NIXR,*),
97 . IXTG(NIXTG,*) , INDEX(*) ,ITRI(*) ,IPM(,*),
98 . KSYSUSR(*) , IDRAPE(NPLYMAX,*)
99 INTEGER NSIGI, NSIGSH, NSIGS, NSIGSPH, NSIGRS,
100 . ISOLNODD00(*), NSIGBEAM, NSIGTRUSS, STRSGLOB(*),
101 . STRAGLOB(*), ORTHOGLOB(*), ISIGSH, IYLDINI, FAIL_INI(5),
102 . IUSOLYLD, IUSER,VARMAX
103 INTEGER ID_SIGSH(*), ID_SOLID_SIGI(*), ID_QUAD_SIGI(*)
104 INTEGER ID_SIGSPRI(*), ID_SIGBEAM(*), ID_SIGTRUSS(*)
105 INTEGER WORK(*)
106 INTEGER NIBRICK, NIQUAD, NISHELL, NISH3N, NISPRING, NIBEAM, NITRUSS
108 . geo(*),pm(npropm,*),rtrans(ntransf,*),
109 . sigi(nsigs,*),sigsh(
max(1,nsigsh),*),sigtruss(nsigtruss,*),
110 . sigsp(nsigi,*),sigsph(nsigsph,*),sigrs(nsigrs,*),sigbeam(nsigbeam,*)
111
112 TYPE(SUBMODEL_DATA) LSUBMODEL(*)
113 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
114
115 TYPE(MAPPING_STRUCT_) :: MAP_TABLES
116 INTEGER, DIMENSION(NPARG,NGROUP) ,INTENT(IN):: IPARG
117 INTEGER, INTENT(INOUT) :: PTSHEL(NUMELC),PTSH3N(NUMELTG)
118 TYPE (STACK_PLY) :: STACK
119 INTEGER, INTENT(IN) :: IWORKSH(3,NUMELC + NUMELTG)
120 INTEGER, INTENT(IN) :: IOUT
121 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
122 INTEGER, INTENT(INOUT) :: NISPHCEL
123 INTEGER, INTENT(IN) :: NUMSPH
124 INTEGER, INTENT(IN) :: NISP
125 INTEGER, INTENT(IN) :: KXSP(NISP,NUMSPH)
126 INTEGER, INTENT(INOUT) :: ID_SIGSPH()
127
128
129
130 INTEGER K, N, I,J, L,IG, ISOLNOD,IGTYP,
131 . IHBE,NE, ISH3N,IIS,NIP,IPG,NPG,PT,NPP,
132 . J1,JJ1,NU,IP,JJ,NUVAR,L_SIGB,
133 . NVARSH,NUMR,NUMSOLID,KK,UID,IFLAGUNIT,
134 . IUNIT, IFRAM, JJHBE, IORTH, ND, NPTD00,
135 . NUVARD00, NDIR, NPGTMP,
136 . NPTR,NPTS,NPTT,JR,JS,JT,NFAIL(5),IMAT,ILAW,
137 . ,NPT_MAX,MLAWLY,IPMAT,JDRP_ID,NVARBEAM,IFAIL,NEM1,
138 . IRUPT_TYP,NVAR_RUPT,IOK,NVMAX,CPTVAR,FLAGDEG,NUM_LINES,NMAX_AUX,NMAX_FAIL,
139 . ISUBSTACK,NSLICE,IPNPT_LAY,IPT
140 INTEGER IE, KN, IR, IS, IT, BRIGLOB, SUB_ID, NLAY, ILAY, PID
141 INTEGER KTRIELS, KTRIELC, KTRIELTG, KTRIELSPR, KTRIELBEAM, KTRIELTRUSS,
142 . KTRIELTQUAD, KTRIELSPHCEL
143 INTEGER IGBR, JGBR, I1, SIZE,NSROT,NG,ITYR,NFTR,NELR,ISMRAD
144
145
147 . em , eb, h1, h2, h3,
148 . r0 , ein, vx, vy, vz, phi1, phi2, scaleyld,
149 . exx, eyy, exy, eyz, ezx, fxx, fyy, fxy,
150 . epsp, angle1, angle2, aa,
area,
for,ener,dens,
153 . s(6),
154
155 . tmpval(varmax),
156 . tmpval1(varmax),tmpval2(varmax),tmpval3(varmax),
157 . tmpval4(varmax),tmpval5(varmax),tmpval6(varmax),
158 . tmpval7(varmax),tmpval8(varmax),tmpval9(varmax),
159 . tmpval10(varmax),tmpval11(varmax),tmpval12(varmax),
160 . tmpval13(varmax)
161
162 INTEGER, DIMENSION(:), ALLOCATABLE :: KSYSUSRTG ,KSYSUSRS,INDEXS,ITRIS,
163 . KSYSUSRQ,INDEXQ,ITRIQ,IES2IPARG,MLAW_LY,ITRISPH,INDEXSPH,KSYSUSRSPH
164
165 CHARACTER(LEN=NCHARKEY) :: KEY,KEY2,KEY3
166 CHARACTER(LEN=NCHARTITLE) :: TITR,TITR1
167 CHARACTER*15,KEYWORD
168 INTEGER NONEXIST
169
171 INTEGER UEL2SYS
172
173 LOGICAL IS_AVAILABLE,GLOB
174
175 INTEGER NB_INIBRI,NB_INISHE,NB_INISH3,NB_ELEMENTS,ID_ELEM,
176 . ,ELTP,INI,K0,NB_INITRUSS,NB_INIBEAM,NB_INISPRI,NB_INIQUA,
177 . SUB_INDEX,IDOUB,ISTRSF,ISTRSFG,ISTRAF,ISTRAFG,ISTAT,NB_INISPHCEL
179 . thk,for1,for2,for3,mom1,mom2,mom3
180
181 INTEGER SET_USRTOS
183
184
185
186
187
188 sub_index = 0
189 nonexist = 0
190
191 ALLOCATE (itris(numels))
192 ALLOCATE (indexs(2*numels))
193 ALLOCATE (ksysusrs(2*numels))
194 ALLOCATE (ksysusrtg(2*numeltg))
195 ALLOCATE (itriq(numelq))
196 ALLOCATE (indexq(2*numelq))
197 ALLOCATE (ksysusrq(2*numelq))
198 ALLOCATE (ies2iparg(numels) ,stat=istat)
199 ALLOCATE (itrisph(numsph))
200 ALLOCATE (indexsph(2*numsph))
201 ALLOCATE (ksysusrsph(2*numsph))
202 IF (istat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,
203 . msgtype=msgerror,
204 . c1='IES2IPARG')
205
206 IF (numels > 0) itris(1:numels) = 0
207 IF (numels > 0) indexs(1:2*numels) = 0
208 IF (numels > 0) ksysusrs(1:2*numels)=0
209 IF (numeltg > 0) ksysusrtg(1:2*numeltg)=0
210 IF (numelq > 0) itriq(1:numelq) = 0
211 IF (numelq > 0) indexq(1:2*numelq) = 0
212 IF (numelq > 0) ksysusrq(1:2*numelq)=0
213 IF (numels > 0) ies2iparg(1:numels) = 0
214
215 ktriels = 0
216 ktrielc = 0
217 ktrieltg = 0
218 ktrielspr = 0
219 ktrielbeam = 0
220 ktrieltruss = 0
221 ktrieltquad = 0
222 ktrielsphcel = 0
223 nem1 = 0
224
225
226
227 is_available = .false.
228 glob = .false.
229
230
231
232
234
235 IF ( nb_inibri > 0 ) THEN
236
237 DO ng=1,ngroup
238 ityr=iparg(5,ng)
239 nftr=iparg(3,ng)
240 nelr=iparg(2,ng)
241 IF (ityr /= 1 ) cycle
242 DO i=1,nelr
243 ies2iparg(i+nftr) = ng
244 ENDDO
245 END DO
246
247
249 istrsf=0
250 istrsfg=0
251 istraf=0
252 istrafg=0
253
254 DO ini=1,nb_inibri
255
257 . unit_id = uid,
258 . submodel_index = sub_index,
259 . submodel_id = sub_id,
260 . keyword2 = key)
261
262
263 SELECT CASE (key(1:len_trim(key)))
264
265 CASE ( 'STRS_FGLO' )
266 istrsfg=1
267 CASE ( 'strs_f' )
268 ISTRSF=1
269 CASE ( 'stra_fglo' )
270 ISTRAFG=1
271 CASE ( 'stra_f' )
272 ISTRAF=1
273 END SELECT ! SELECT CASE(KEY)
274 END DO
275.AND. IF (ISTRSFG>0ISTRSF>0) THEN
276 CALL ANCMSG(MSGID=2044,ANMODE=ANINFO,MSGTYPE=MSGWARNING)
277 END IF
278.AND. IF (ISTRAFG>0ISTRAF>0) THEN
279 CALL ANCMSG(MSGID=2045,ANMODE=ANINFO,MSGTYPE=MSGWARNING)
280 END IF
281 END IF !( NB_INIBRI > 0 ) THEN
282
283 BRIGLOB = 0
284 NIBRICK = 0
285 I = 0
286!
287!
288 IF ( NB_INIBRI > 0 ) THEN
289!
290 ! Start reading /INIBRI card
291 CALL HM_OPTION_START('/inibri')
292!---
293! to be replaced by --- MAP_TABLES%ISOLM ---
294 IF(KTRIELS==0)THEN
295 DO IE = 1, NUMELS
296 ITRIS(IE) = IXS(NIXS,IE)
297 END DO
298 CALL MY_ORDERS(0,WORK,ITRIS,INDEXS,NUMELS,1)
299 DO J = 1, NUMELS
300 IE=INDEXS(J)
301 KSYSUSRS(J) =IXS(NIXS,IE)
302 KSYSUSRS(NUMELS+J)=IE
303 END DO
304 KTRIELS=1
305 END IF
306!---
307 DO INI=1,NB_INIBRI
308!
309 CALL HM_OPTION_READ_KEY(LSUBMODEL,
310 . UNIT_ID = UID,
311 . SUBMODEL_INDEX = SUB_INDEX,
312 . SUBMODEL_ID = SUB_ID,
313 . KEYWORD2 = KEY)
314!
315 IFLAGUNIT = 0
316 DO IUNIT=1,UNITAB%NUNITS
317 IF (UNITAB%UNIT_ID(IUNIT) == UID) THEN
318 IFLAGUNIT = 1
319 EXIT
320 ENDIF
321 ENDDO
322.AND. IF (UID/=0IFLAGUNIT == 0) THEN
323 CALL ANCMSG(MSGID=659,ANMODE=ANINFO,MSGTYPE=MSGERROR,
324 . I2=UID,I1=SUB_ID,C1='inibri',
325 . C2='inibri',C3=' ')
326 ENDIF
327
328 SELECT CASE (KEY(1:LEN_TRIM(KEY)))
329
330 CASE ( 'fill' )
331
332 CALL HM_GET_INTV('inibri_fill_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
333!
334 DO J=1,NB_ELEMENTS
335 ! Reading --- ID_ELEM, FILL ---
336 CALL HM_GET_INT_ARRAY_INDEX('brick_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
337 CALL HM_GET_FLOAT_ARRAY_INDEX('value',FILL,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
338!
339 I=I+1
340 ID_SOLID_SIGI(I) = ID_ELEM
341 SIGI(11,I) = FILL
342!
343 ENDDO ! DO J=1,NB_ELEMENTS
344
345 CASE ( 'epsp' )
346
347 CALL HM_GET_INTV('inibri_epsp_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
348!
349 DO J=1,NB_ELEMENTS
350 ! Reading --- ID_ELEM, EPSP ---
351 CALL HM_GET_INT_ARRAY_INDEX('brick_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
352 CALL HM_GET_FLOAT_ARRAY_INDEX('value',EPSP,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
353!
354 I=I+1
355 ID_SOLID_SIGI(I) = ID_ELEM
356 SIGI(10,I) = EPSP
357!
358 ENDDO ! DO J=1,NB_ELEMENTS
359
360 CASE ( 'ener' )
361
362 CALL HM_GET_INTV('inibri_ener_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
363!
364 DO J=1,NB_ELEMENTS
365 ! Reading --- ID_ELEM, ENER ---
366 CALL HM_GET_INT_ARRAY_INDEX('brick_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
367 CALL HM_GET_FLOAT_ARRAY_INDEX('value',ENER,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
368!
369 I=I+1
370 ID_SOLID_SIGI(I) = ID_ELEM
371 SIGI(9,I) = ENER
372!
373 ENDDO ! DO J=1,NB_ELEMENTS
374
375 CASE ( 'dens' )
376
377 CALL HM_GET_INTV('inibri_dens_count',nb_elements,is_available,lsubmodel)
378
379 DO j=1,nb_elements
380
383
384 i=i+1
385 id_solid_sigi(i) = id_elem
386 sigi(8,i) = dens
387
388 ENDDO
389
390 CASE ( 'STRESS' )
391
392 CALL hm_get_intv(
'inibri_stress_count',nb_elements,is_available,lsubmodel)
393
394 DO j=1,nb_elements
395
403
404 i=i+1
405 id_solid_sigi(i) = id_elem
406 DO k=1,6
407 sigi(k,i) = s(k)
408 ENDDO
409
410 ENDDO
411
412 CASE ( 'AUX' )
413
414 CALL hm_get_intv(
'inibri_aux_count',nb_elements,is_available,lsubmodel)
415
416 DO j=1,nb_elements
417
423
424 ie=
uel2sys(id_elem,ksysusrs,numels)
425
426 IF (ie == 0) THEN
427
428 nonexist = nonexist+1
429 ELSE
430 keyword = '/INIBRI/AUX '
431 i=i+1
432 nlay=0
433 id_solid_sigi(i) = id_elem
434 iuser = 1
435 sigsp(nvsolid1 + nvsolid2 +1 , i) = isolnod
436 sigsp(nvsolid1 + nvsolid2 +2 , i) = npt
437 sigsp(nvsolid1 + nvsolid2 +3 , i) = nuvar
438 sigsp(nvsolid1 + nvsolid2 +4 , i) = jjhbe
439
441 1 ixs ,igeo ,itris ,isolnodd00 ,ie ,
442 2 npt ,nlay ,isolnod ,jjhbe ,igtyp ,
443 3 isrot ,keyword )
444
445 imat = ixs(1,ie)
446 ilaw = ipm(2,imat)
447 nuvard00 = ipm(8,imat)
448 IF (nuvard00 > nuvar) THEN
450 . msgtype=msgwarning,
451 . anmode=aninfo,
452 . i1=itris(ie),
453 . c1='NUMBER OF USER VARIABLES',
454 . c2='MATERIAL LAW ',
455 . i2=ipm(1,ixs(10,ie)),
456 . c3='/INIBRI/AUX')
457 ENDIF
458 IF ((ilaw == 36 .and. (nuvar < 4 .or. nuvard00 > 3) .and.
459 . nuvard00 < nuvar) .or.
460 . (ilaw /= 36 .and. ilaw /= 78 .and. ilaw /= 87 .and. ilaw /= 112 .and. nuvard00 < nuvar)) THEN
462 . msgtype=msgerror,
463 . anmode=aninfo,
464 . i1=itris(ie),
465 . c1='NUMBER OF USER VARIABLES',
466 . c2='MATERIAL LAW ',
467 . i2=ipm(1,ixs(10,ie)),
468 . c3='/INIBRI/AUX')
469 ENDIF
470
471 nmax_aux = npt*nuvar
473 DO jj=1,npt
474 iis = nvsolid1 + nvsolid2 + 4 + nuvar*(jj - 1)
475 DO k=1,nuvar
476 l = nuvar*(jj-1) + k
477 sigsp(iis + k,i) = tmpval(l)
478 ENDDO
479 ENDDO
480 ENDIF
481 ENDDO
482
483 CASE ( 'STRS_FGLO' )
484
485 keyword='/INIBRI/STRS_FG'
486 igtyp = 0
487 briglob = 1
488
489 CALL hm_get_intv(
'inibri_strs_fglo_count',nb_elements,is_available,lsubmodel)
490
491 DO j=1,nb_elements
492
500
503
504 IF (jjhbe == 2) jjhbe = 1
505 IF (igbr > 0) THEN
506 DO k=1,ngrbric
507 IF (igbr == igrbric(k)%ID) THEN
508 jgbr = k
509 EXIT
510 ENDIF
511 ENDDO
512 ie = igrbric(jgbr)%ENTITY(1)
513 id_elem = ixs(nixs,ie)
514 ENDIF
515
516
517
518
519
520 ie=
uel2sys(id_elem,ksysusrs,numels)
521
522 IF (ie == 0) THEN
523
524 nonexist = nonexist+1
525 ELSEIF (strsglob(ie) >= 0) THEN
526
527 ELSE
528
529 i=i+1
530 id_solid_sigi(i) = id_elem
531 sigsp(2,i) = npt
532
533
534 IF (briglob == 1) strsglob(ie)=1
535
537 1 ixs ,igeo ,itris ,isolnodd00 ,ie ,
538 2 npt ,nlay ,isolnod ,jjhbe ,igtyp ,
539 3 isrot ,keyword )
540
541 IF ( (isolnod == 8 .AND. (jjhbe==1.OR.jjhbe==2.OR.jjhbe==12.OR.jjhbe==24)
542 . .AND. igtyp /= 43) .OR.(isolnod == 4 .AND. isrot == 0)
543 . .OR.(isolnod == 4 .AND. isrot == 3).OR.jjhbe==5) THEN
544
545 IF(isolnod == 8 .AND. jjhbe == 12) THEN
546 sigsp(2,i) = npt
547 sigsp(1,i) = 1
548 DO k=1,6
549 sigi(k,i) = zero
550 ENDDO
551 sigi(10,i) = zero
552
553 SIZE = npt
563
564 DO k=1,npt
565 iis= 4 + (k-1)*9
566 ein = tmpval1(k)
567 r0 = tmpval2(k)
568 sigsp(iis+8,i) = ein
569 sigsp(iis+9,i) = r0
570
571 s(1) = tmpval3(k)
572 s(2) = tmpval4(k)
573 s(3) = tmpval5(k)
574
575 s(4) = tmpval6(k)
576 s(5) = tmpval7(k)
577 s(6) = tmpval8(k)
578 IF (sub_id /= 0)
CALL subrottens(s,rtrans,sub_id,lsubmodel)
579 sigsp(iis+1,i) = s(1)
580 sigsp(iis+2,i) = s(2)
581 sigsp(iis+3,i) = s(3)
582 sigsp(iis+4,i) = s(4)
583 sigsp(iis+5,i) = s(5)
584 sigsp(iis+6,i) = s(6)
585
586 epsp = tmpval9(k)
587 sigsp(iis+7,i) = epsp
588 ENDDO
589 ELSE
590
591 SIZE = npt
601
602 sigsp(2,i) = npt
603 IF (npt == 8) THEN
604 sigsp(1,i) = 1
605 sigi(8,i) = tmpval2(1)
606 sigi(9,i) = tmpval1(1)
607 ELSEIF (npt == 1) THEN
608 sigi(8,i) = tmpval2(1)
609 sigi(9,i) = tmpval1(1)
610 ENDIF
611 sigsp(3,i) = tmpval1(1)
612 sigsp(4,i) = tmpval2(1)
613
614 IF (npt == 1) THEN
615 s(1) = tmpval3(1)
616 s(2) = tmpval4(1)
617 s(3) = tmpval5(1)
618 s(4) = tmpval6(1)
619 s(5) = tmpval7(1)
620 s(6) = tmpval8(1)
621 IF (sub_id /= 0)
CALL subrottens(s,rtrans,sub_id,lsubmodel)
622 sigi(1,i) = s(1)
623 sigi(2,i) = s(2)
624 sigi(3,i) = s(3)
625 sigi(4,i) = s(4)
626 sigi(5,i) = s(5)
627 sigi(6,i) = s(6)
628 sigi(10,i)= tmpval9(1)
629 ELSE
630 DO k=1,6
631 sigi(k,i) = zero
632 ENDDO
633 sigi(10,i) = zero
634 DO k=1,npt
635 iis= 4 + (k-1)*7
636 s(1) = tmpval3(k)
637 s(2) = tmpval4(k)
638 s(3) = tmpval5(k)
639 sigsp(iis+1,i) = s(1)
640 sigsp(iis+2,i) = s(2)
641 sigsp(iis+3,i) = s(3)
642 s(4) = tmpval6(k)
643 s(5) = tmpval7(k)
644 s(6) = tmpval8(k)
645 IF (sub_id /= 0)
CALL subrottens(s,rtrans,sub_id,lsubmodel)
646 sigsp(iis+1,i) = s(1)
647 sigsp(iis+2,i) = s(2)
648 sigsp(iis+3,i) = s(3)
649 sigsp(iis+4,i) = s(4)
650 sigsp(iis+5,i) = s(5)
651 sigsp(iis+6,i) = s(6)
652 epsp = tmpval9(k)
653 sigsp(iis+7,i) = epsp
654 DO l=1,6
655 sigi(l,i) = sigi(l,i) + fourth*sigsp(iis+l,i)
656 ENDDO
657 sigi(10,i)= sigi(10,i) + fourth*sigsp(iis+7,i)
658 ENDDO
659 ENDIF
660 ENDIF
661
662 ELSE
663
664
665 IF (isolnod == 16) THEN
666
667 SIZE = nptt*nptr*nlay
677
678 kk = 0
679 DO jt=1,nptt
680 DO jr=1,nptr
681 DO jl=1,nlay
682 k = jr + ( (jl-1) + (jt-1)*nlay )*nptr
683 iis = 1 + (k-1)*9
684
685 kk = kk + 1
686
687 s(1) = tmpval1(kk)
688 s(2) = tmpval2(kk)
689 s(3) = tmpval3(kk)
690 s(4) = tmpval4(kk)
691 s(5) = tmpval5(kk)
692 s(6) = tmpval6(kk)
693 IF (sub_id /= 0)
CALL subrottens(s,rtrans,sub_id,lsubmodel)
694 sigsp(iis+1,i) = s(1)
695 sigsp(iis+2,i) = s(2)
696 sigsp(iis+3,i) = s(3)
697 sigsp(iis+4,i) = s(4)
698 sigsp(iis+5,i) = s(5)
699 sigsp(iis+6,i) = s(6)
700 epsp = tmpval7(kk)
701 ein = tmpval8(kk)
702 r0 = tmpval9(kk)
703 sigsp(iis+7,i) = epsp
704 sigsp(iis+8,i) = ein
705 sigsp(iis+9,i) = r0
706 ENDDO
707 ENDDO
708 ENDDO
709
710 ELSEIF (isolnod == 20) THEN
711
712 SIZE = nptt*npts*nptr
721 CALL HM_GET_FLOAT_ARRAY('rho' ,TMPVAL9,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
722!
723!
724 KK = 0
725!
726 DO JT=1,NPTT
727 DO JS=1,NPTS
728 DO JR=1,NPTR
729 K = JR + ( (JS-1) + (JT-1)*NPTS )*NPTR
730 IIS = 1 + (K-1)*9
731!
732 KK = KK + 1
733!
734 S(1) = TMPVAL1(KK)
735 S(2) = TMPVAL2(KK)
736 S(3) = TMPVAL3(KK)
737 S(4) = TMPVAL4(KK)
738 S(5) = TMPVAL5(KK)
739 S(6) = TMPVAL6(KK)
740 IF (SUB_ID /= 0) CALL SUBROTTENS(S,RTRANS,SUB_ID,LSUBMODEL)
741 SIGSP(IIS+1,I) = S(1)
742 SIGSP(IIS+2,I) = S(2)
743 SIGSP(IIS+3,I) = S(3)
744 SIGSP(IIS+4,I) = S(4)
745 SIGSP(IIS+5,I) = S(5)
746 SIGSP(IIS+6,I) = S(6)
747 EPSP = TMPVAL7(KK)
748 EIN = TMPVAL8(KK)
749 R0 = TMPVAL9(KK)
750 SIGSP(IIS+7,I) = EPSP
751 SIGSP(IIS+8,I) = EIN
752 SIGSP(IIS+9,I) = R0
753 ENDDO ! DO JT=1,NPTT
754 ENDDO ! DO JS=1,NPTS
755 ENDDO ! DO JR=1,NPTR
756!
757 ELSE
758!
759 IF (IGTYP == 22) THEN
760!
761 SIZE = NPTR*NPTS*NPTT
762 CALL HM_GET_FLOAT_ARRAY('sigma1' ,TMPVAL1,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
763 CALL HM_GET_FLOAT_ARRAY('sigma2' ,TMPVAL2,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
764 CALL HM_GET_FLOAT_ARRAY('sigma3' ,TMPVAL3,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
765 CALL HM_GET_FLOAT_ARRAY('sigma12' ,TMPVAL4,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
766 CALL HM_GET_FLOAT_ARRAY('sigma23' ,TMPVAL5,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
767 CALL HM_GET_FLOAT_ARRAY('sigma31' ,tmpval6,SIZE,j,is_available,lsubmodel,unitab)
771
772
773 kk = 0
774
775 DO jr=1,nptr
776 DO js=1,npts
777 DO jt=1,nptt
778
779 iis = 1 + (k-1)*9
780
781 kk = kk + 1
782
783 s(1) = tmpval1(kk)
784 s(2) = tmpval2(kk)
785 s(3) = tmpval3(kk)
786 s(4) = tmpval4(kk)
787 s(5) = tmpval5(kk)
788 s(6) = tmpval6(kk)
789 IF (sub_id /= 0)
CALL subrottens(s,rtrans,sub_id,lsubmodel)
790 sigsp(iis+1,i) = s(1)
791 sigsp(iis+2,i) = s(2)
792 sigsp(iis+3,i) = s(3)
793 sigsp(iis+4,i) = s(4)
794 sigsp(iis+5,i) = s(5)
795 sigsp(iis+6,i) = s(6)
796 epsp = tmpval7(kk)
797 ein = tmpval8(kk)
798 r0 = tmpval9(kk)
799 sigsp(iis+7,i) = epsp
800 sigsp(iis+8,i) = ein
801 sigsp(iis+9,i) = r0
802 ENDDO
803 ENDDO
804 ENDDO
805
806 ELSE
807
808 SIZE = npt
818
819 DO k=1,npt
820 iis= 1 + (k-1)*9
821 s(1) = tmpval1(k)
822 s(2) = tmpval2(k)
823 s(3) = tmpval3(k)
824 s(4) = tmpval4(k)
825 s(5) = tmpval5(k)
826 s(6) = tmpval6(k)
827 IF (sub_id /= 0)
CALL subrottens(s,rtrans,sub_id,lsubmodel)
828 sigsp(iis+1,i) = s(1)
829 sigsp(iis+2,i) = s(2)
830 sigsp(iis+3,i) = s(3)
831 sigsp(iis+4,i) = s(4)
832 sigsp(iis+5,i) = s(5)
833 sigsp(iis+6,i) = s(6)
834 epsp = tmpval7(k)
835 ein = tmpval8(k)
836 r0 = tmpval9(k)
837 sigsp(iis+7,i) = epsp
838 sigsp(iis+8,i) = ein
839 sigsp(iis+9,i) = r0
840 ENDDO
841 ENDIF
842 ENDIF
843 ENDIF
844 ENDIF
845
846 IF (igbr > 0) THEN
847 i1 = i
848 DO k = 2,igrbric(jgbr)%NENTITY
849 ie = igrbric(jgbr)%ENTITY(k)
851 1 ixs ,igeo ,itris ,isolnodd00 ,ie ,
852 2 npt ,nlay ,isolnod ,jjhbe ,igtyp ,
853 3 isrot ,keyword )
854 IF (strsglob(ie) >= 0) cycle
855 IF (briglob == 1) strsglob(ie)=1
856 i = i+1
857 id_solid_sigi(i) = ixs(11,ie)
858 DO l = 1,nsigi
859 sigsp(l,i) = sigsp(l,i1)
860 ENDDO
861 DO l = 1,nsigs
862 sigi(l,i) = sigi(l,i1)
863 ENDDO
864 ENDDO
865 ENDIF
866
867 ENDDO
868
869 CASE ( 'STRS_F' )
870
871 keyword='/INIBRI/STRS_F '
872 igtyp = 0
873
874 CALL hm_get_intv(
'inibri_strs_f_count',nb_elements,is_available,lsubmodel)
875
876 DO j=1,nb_elements
877
882
888
889 IF (igbr > 0) THEN
890 DO k=1,ngrbric
891 IF (igbr == igrbric(k)%ID) THEN
892 jgbr = k
893 EXIT
894 ENDIF
895 ENDDO
896 ie = igrbric(jgbr)%ENTITY(1)
897 id_elem = ixs(nixs,ie)
898 ENDIF
899
900
901
902
903 ie=
uel2sys(id_elem,ksysusrs,numels)
904
905 IF (ie == 0) THEN
906
907 nonexist = nonexist+1
908 ELSEIF (strsglob(ie) >= 0) THEN
909
910 ELSE
911
912 i=i+1
913 IF (jjhbe == 2) jjhbe = 1
914 id_solid_sigi(i) = id_elem
915 sigsp(2,i) = npt
916
918 1 ixs ,igeo ,itris ,isolnodd00 ,ie ,
919 2 npt ,nlay ,isolnod ,jjhbe ,igtyp ,
920 3 isrot ,keyword )
921
922 strsglob(ie) = 0
923 IF ( (isolnod == 8 .AND. (jjhbe==1.OR.jjhbe==2.OR.jjhbe==12.OR.jjhbe==24)
924 . .AND. igtyp /= 43) .OR.(isolnod == 4 .AND. isrot == 0)
925 . .OR.(isolnod == 4 .AND. isrot == 3).OR.jjhbe==5) THEN
926
927 IF(isolnod == 8 .AND. jjhbe == 12) THEN
928 sigsp(2,i) = npt
929 sigsp(1,i) = 1
930 DO k=1,6
931 sigi(k,i) = zero
932 ENDDO
933 sigi(10,i) = zero
934
935 SIZE = npt
945
946 DO k=1,npt
947 iis= 4 + (k-1)*9
948 ein = tmpval1(k)
949 r0 = tmpval2(k)
950 sigsp(iis+8,i) = ein
951 sigsp(iis+9,i) = r0
952
953 s(1) = tmpval3(k)
954 s(2) = tmpval4(k)
955 s(3) = tmpval5(k)
956
957 s(4) = tmpval6(k)
958 s(5) = tmpval7(k)
959 s(6) = tmpval8(k)
960
961 sigsp(iis+1,i) = s(1)
962 sigsp(iis+2,i) = s(2)
963 sigsp(iis+3,i) = s(3)
964 sigsp(iis+4,i) = s(4)
965 sigsp(iis+5,i) = s(5)
966 sigsp(iis+6,i) = s(6)
967
968 epsp = tmpval9(k)
969 sigsp(iis+7,i) = epsp
970 ENDDO
971 ELSE
972
973 SIZE = npt
983
984 sigsp(2,i) = npt
985 IF(npt == 8)THEN
986 sigsp(1,i) = 1
987 sigi(8,i) = tmpval2(1)
988 sigi(9,i) = tmpval1(1)
989 ELSEIF(npt == 1) THEN
990 sigi(8,i) = tmpval2(1)
991 sigi(9,i) = tmpval1(1)
992 ENDIF
993 sigsp(3,i) = tmpval1(1)
994 sigsp(4,i) = tmpval2(1)
995
996 IF (npt == 1) THEN
997
998 s(1) = tmpval3(1)
999 s(2) = tmpval4(1)
1000 s(3) = tmpval5(1)
1001 s(4) = tmpval6(1)
1002 s(5) = tmpval7(1)
1003 s(6) = tmpval8(1)
1004
1005 sigi(1,i) = s(1)
1006 sigi(2,i) = s(2)
1007 sigi(3,i) = s(3)
1008 sigi(4,i) = s(4)
1009 sigi(5,i) = s(5)
1010 sigi(6,i) = s(6)
1011 sigi(10,i)= tmpval9(1)
1012 ELSE
1013 DO k=1,6
1014 sigi(k,i) = zero
1015 ENDDO
1016 sigi(10,i) = zero
1017
1018 DO k=1,npt
1019 iis= 4 + (k-1)*7
1020 s(1) = tmpval3(k)
1021 s(2) = tmpval4(k)
1022 s(3) = tmpval5(k)
1023 sigsp(iis+1,i) = s(1)
1024 sigsp(iis+2,i) = s(2)
1025 sigsp(iis+3,i) = s(3)
1026 s(4) = tmpval6(k)
1027 s(5) = tmpval7(k)
1028 s(6) = tmpval8(k)
1029
1030 sigsp(iis+1,i) = s(1)
1031 sigsp(iis+2,i) = s(2)
1032 sigsp(iis+3,i) = s(3)
1033 sigsp(iis+4,i) = s(4)
1034 sigsp(iis+5,i) = s(5)
1035 sigsp(iis+6,i) = s(6)
1036 epsp = tmpval9(k)
1037 sigsp(iis+7,i) = epsp
1038 DO l=1,6
1039 sigi(l,i) = sigi(l,i) + fourth*sigsp(iis+l,i)
1040 ENDDO
1041 sigi(10,i)= sigi(10,i) + fourth*sigsp(iis+7,i)
1042 ENDDO
1043 ENDIF
1044 ENDIF
1045
1046 ELSE
1047
1048
1049 IF (isolnod == 16) THEN
1050
1051 SIZE = nptt*nptr*nlay
1061
1062
1063 kk = 0
1064
1065 DO jt=1,nptt
1066 DO jr=1,nptr
1067 DO jl=1,nlay
1068 k = jr + ( (jl-1) + (jt-1)*nlay )*nptr
1069 iis = 1 + (k-1)*9
1070
1071 kk = kk + 1
1072
1073 s(1) = tmpval1(kk)
1074 s(2) = tmpval2(kk)
1075 s(3) = tmpval3(kk)
1076 s(4) = tmpval4(kk)
1077 s(5) = tmpval5(kk)
1078 s(6) = tmpval6(kk)
1079
1080 sigsp(iis+1,i) = s(1)
1081 sigsp(iis+2,i) = s(2)
1082 sigsp(iis+3,i) = s(3)
1083 sigsp(iis+4,i) = s(4)
1084 sigsp(iis+5,i) = s(5)
1085 sigsp(iis+6,i) = s(6)
1086 epsp = tmpval7(kk)
1087 ein = tmpval8(kk)
1088 r0 = tmpval9(kk)
1089 sigsp(iis+7,i) = epsp
1090 sigsp(iis+8,i) = ein
1091 sigsp(iis+9,i) = r0
1092 ENDDO
1093 ENDDO
1094 ENDDO
1095
1096 ELSEIF (isolnod == 20) THEN
1097
1098 SIZE = nptt*npts*nptr
1108
1109
1110 kk = 0
1111
1112 DO jt=1,nptt
1113 DO js=1,npts
1114 DO jr=1,nptr
1115 k = jr + ( (js-1) + (jt-1)*npts )*nptr
1116 iis = 1 + (k-1)*9
1117
1118 kk = kk + 1
1119
1120 s(1) = tmpval1(kk)
1121 s(2) = tmpval2(kk)
1122 s(3) = tmpval3(kk)
1123 s(4) = tmpval4(kk)
1124 s(5) = tmpval5(kk)
1125 s(6) = tmpval6(kk)
1126
1127 sigsp(iis+1,i) = s(1)
1128 sigsp(iis+2,i) = s(2)
1129 sigsp(iis+3,i) = s(3)
1130 sigsp(iis+4,i) = s(4)
1131 sigsp(iis+5,i) = s(5)
1132 sigsp(iis+6,i) = s(6)
1133 epsp = tmpval7(kk)
1134 ein = tmpval8(kk)
1135 r0 = tmpval9(kk)
1136 sigsp(iis+7,i) = epsp
1137 sigsp(iis+8,i) = ein
1138 sigsp(iis+9,i) = r0
1139 ENDDO
1140 ENDDO
1141 ENDDO
1142
1143 ELSE
1144
1145 IF (igtyp == 22) THEN
1146
1147 SIZE = nptr*npts*nptt
1157
1158
1159 kk = 0
1160
1161 DO jr=1,nptr
1162 DO js=1,npts
1163 DO jt=1,nptt
1164 k = jr + ( (js-1) + (jt-1)*npts )*nptr
1165 iis = 1 + (k-1)*9
1166
1167 kk = kk + 1
1168
1169 s(1) = tmpval1(kk)
1170 s(2) = tmpval2(kk)
1171 s(3) = tmpval3(kk)
1172 s(4) = tmpval4(kk)
1173 s(5) = tmpval5(kk)
1174 s(6) = tmpval6(kk)
1175
1176 sigsp(iis+1,i) = s(1)
1177 sigsp(iis+2,i) = s(2)
1178 sigsp(iis+3,i) = s(3)
1179 sigsp(iis+4,i) = s(4)
1180 sigsp(iis+5,i) = s(5)
1181 sigsp(iis+6,i) = s(6)
1182 epsp = tmpval7(kk)
1183 ein = tmpval8(kk)
1184 r0 = tmpval9(kk)
1185 sigsp(iis+7,i) = epsp
1186 sigsp(iis+8,i) = ein
1187 sigsp(iis+9,i) = r0
1188 ENDDO
1189 ENDDO
1190 ENDDO
1191
1192 ELSE
1193
1194 SIZE = npt
1204
1205 DO k=1,npt
1206 iis= 1 + (k-1)*9
1207 s(1) = tmpval1(k)
1208 s(2) = tmpval2(k)
1209 s(3) = tmpval3(k)
1210 s(4) = tmpval4(k)
1211 s(5) = tmpval5(k)
1212 s(6) = tmpval6(k)
1213
1214 sigsp(iis+1,i) = s(1)
1215 sigsp(iis+2,i) = s(2)
1216 sigsp(iis+3,i) = s(3)
1217 sigsp(iis+4,i) = s(4)
1218 sigsp(iis+5,i) = s(5)
1219 sigsp(iis+6,i) = s(6)
1220 epsp = tmpval7(k)
1221 ein = tmpval8(k)
1222 r0 = tmpval9(k)
1223 sigsp(iis+7,i) = epsp
1224 sigsp(iis+8,i) = ein
1225 sigsp(iis+9,i) = r0
1226 ENDDO
1227 ENDIF
1228 ENDIF ! IF (isolnod == 16)
1229 ENDIF
1230 ENDIF
1231
1232 IF (igbr > 0) THEN
1233 i1 = i
1234 DO k = 2,igrbric(jgbr)%NENTITY
1235 ie = igrbric(jgbr)%ENTITY(k)
1237 1 ixs ,igeo ,itris ,isolnodd00 ,ie ,
1238 2 npt ,nlay ,isolnod ,jjhbe ,igtyp ,
1239 3 isrot ,keyword )
1240
1241 IF (strsglob(ie) >= 0) cycle
1242 strsglob(ie)=0
1243 i = i+1
1244 id_solid_sigi(i) = ixs(11,ie)
1245 DO l = 1,nsigi
1246 sigsp(l,i) = sigsp(l,i1)
1247 ENDDO
1248 DO l = 1,nsigs
1249 sigi(l,i) = sigi(l,i1)
1250 ENDDO
1251 ENDDO
1252 ENDIF
1253
1254 ENDDO
1255
1256
1257 CASE ( 'STRA_F' )
1258
1259 CALL hm_get_intv(
'inibri_stra_f_count',nb_elements,is_available,lsubmodel)
1260
1261 keyword='/INIBRI/STRA_F '
1262 igtyp = 0
1263
1264 DO j=1,nb_elements
1265
1274
1275 i=i+1
1276 IF (jjhbe == 2) jjhbe = 1
1277 id_solid_sigi(i) = id_elem
1278
1279
1280
1281
1282 ie=
uel2sys(id_elem,ksysusrs,numels)
1283
1284
1285
1286
1287 IF (ie == 0) THEN
1288
1289 nonexist = nonexist+1
1290 ELSEIF (straglob(ie)>=0) THEN
1291 ELSE
1293 1 ixs ,igeo ,itris ,isolnodd00 ,ie ,
1294 2 npt ,nlay ,isolnod ,jjhbe ,igtyp ,
1295 3 isrot ,keyword )
1296
1297 straglob(ie) = 0
1298 IF ( isolnod == 16 ) THEN
1299
1300 SIZE = nptt*nptr*nlay
1307
1308
1309 kk = 0
1310
1311 DO jt=1,nptt
1312 DO jr=1,nptr
1313 DO jl=1,nlay
1314 k = jr + ( (jl-1) + (jt-1)*nlay )*nptr
1315 iis= nvsolid1 + (k-1)*6
1316
1317 kk = kk + 1
1318
1319 s(1) = tmpval1(kk)
1320 s(2) = tmpval2(kk)
1321 s(3) = tmpval3(kk)
1322 s(4) = tmpval4(kk)
1323 s(5) = tmpval5(kk)
1324 s(6) = tmpval6(kk)
1325
1326 sigsp(iis+1,i) = s(1)
1327 sigsp(iis+2,i) = s(2)
1328 sigsp(iis+3,i) = s(3)
1329 sigsp(iis+4,i) = s(4)
1330 sigsp(iis+5,i) = s(5)
1331 sigsp(iis+6,i) = s(6)
1332 ENDDO
1333 ENDDO
1334 ENDDO
1335
1336 ELSEIF ( isolnod == 20 ) THEN
1337
1338 SIZE = nptt*npts*nptr
1345
1346
1347 kk = 0
1348
1349 DO jt=1,nptt
1350 DO js=1,npts
1351 DO jr=1,nptr
1352 k = jr + ( (js-1) + (jt-1)*npts )*nptr
1353 iis= nvsolid1 + (k-1)*6
1354
1355 kk = kk + 1
1356
1357 s(1) = tmpval1(kk)
1358 s(2) = tmpval2(kk)
1359 s(3) = tmpval3(kk)
1360 s(4) = tmpval4(kk)
1361 s(5) = tmpval5(kk)
1362 s(6) = tmpval6(kk)
1363
1364 sigsp(iis+1,i) = s(1)
1365 sigsp(iis+2,i) = s(2)
1366 sigsp(iis+3,i) = s(3)
1367 sigsp(iis+4,i) = s(4)
1368 sigsp(iis+5,i) = s(5)
1369 sigsp(iis+6,i) = s(6)
1370 ENDDO
1371 ENDDO
1372 ENDDO
1373
1374 ELSEIF ((igtyp == 21 .OR. igtyp == 22) .AND. jjhbe == 14) THEN
1375
1376 SIZE = nptr*npts*nptt
1383
1384
1385 kk = 0
1386
1387 DO jr=1,nptr
1388 DO js=1,npts
1389 DO jt=1,nptt
1390 k = jr + ( (js-1) + (jt-1)*npts )*nptr
1391 iis= nvsolid1 + (k-1)*6
1392
1393 kk = kk + 1
1394
1395 s(1) = tmpval1(kk)
1396 s(2) = tmpval2(kk)
1397 s(3) = tmpval3(kk)
1398 s(4) = tmpval4(kk)
1399 s(5) = tmpval5(kk)
1400 s(6) = tmpval6(kk)
1401
1402 sigsp(iis+1,i) = s(1)
1403 sigsp(iis+2,i) = s(2)
1404 sigsp(iis+3,i) = s(3)
1405 sigsp(iis+4,i) = s(4)
1406 sigsp(iis+5,i) = s(5)
1407 sigsp(iis+6,i) = s(6)
1408 ENDDO
1409 ENDDO
1410 ENDDO
1411
1412 ELSE
1413
1414 SIZE = npt
1421
1422 DO k=1,npt
1423 iis= nvsolid1 + (k-1)*6
1424 s(1) = tmpval1(k)
1425 s(2) = tmpval2(k)
1426 s(3) = tmpval3(k)
1427 s(4) = tmpval4(k)
1428 s(5) = tmpval5(k)
1429 s(6) = tmpval6(k)
1430
1431 sigsp(iis+1,i) =s(1)
1432 sigsp(iis+2,i) =s(2)
1433 sigsp(iis+3,i) =s(3)
1434 sigsp(iis+4,i) =s(4)
1435 sigsp(iis+5,i) =s(5)
1436 sigsp(iis+6,i) =s(6)
1437 ENDDO
1438
1439
1440 ENDIF
1441 ENDIF
1442 ENDDO
1443
1444
1445 CASE ( 'STRA_FGLO' )
1446
1447 CALL hm_get_intv(
'inibri_stra_fglo_count',nb_elements,is_available,lsubmodel)
1448
1449 keyword='/INIBRI/STRA_F '
1450 igtyp = 0
1451 briglob = 1
1452
1453 DO j=1,nb_elements
1454
1463
1464 i=i+1
1465 IF (jjhbe == 2) jjhbe = 1
1466 id_solid_sigi(i) = id_elem
1467
1468
1469
1470
1471 ie=
uel2sys(id_elem,ksysusrs,numels)
1472
1473
1474
1475
1476
1477 IF (ie == 0) THEN
1478
1479 nonexist = nonexist+1
1480 ELSEIF (straglob(ie)>=0) THEN
1481 ELSE
1483 1 ixs ,igeo ,itris ,isolnodd00 ,ie ,
1484 2 npt ,nlay ,isolnod ,jjhbe ,igtyp ,
1485 3 isrot ,keyword )
1486 IF (briglob == 1) straglob(ie)=1
1487
1488 IF ( isolnod == 16 ) THEN
1489
1490 SIZE = nptt*nptr*nlay
1493 CALL HM_GET_FLOAT_ARRAY('epsilon_3' ,TMPVAL3,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1494 CALL HM_GET_FLOAT_ARRAY('epsilon_12' ,TMPVAL4,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1495 CALL HM_GET_FLOAT_ARRAY('epsilon_23' ,TMPVAL5,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1496 CALL HM_GET_FLOAT_ARRAY('epsilon_31' ,TMPVAL6,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1497!
1498!
1499 KK = 0
1500!
1501 DO JT=1,NPTT
1502 DO JR=1,NPTR
1503 DO JL=1,NLAY
1504 K = JR + ( (JL-1) + (JT-1)*NLAY )*NPTR
1505 IIS= NVSOLID1 + (K-1)*6
1506!
1507 KK = KK + 1
1508!
1509 S(1) = TMPVAL1(KK)
1510 S(2) = TMPVAL2(KK)
1511 S(3) = TMPVAL3(KK)
1512 S(4) = TMPVAL4(KK)
1513 S(5) = TMPVAL5(KK)
1514 S(6) = TMPVAL6(KK)
1515 IF (SUB_ID /= 0) CALL SUBROTTENS(S,RTRANS,SUB_ID,LSUBMODEL)
1516 SIGSP(IIS+1,I) = S(1)
1517 SIGSP(IIS+2,I) = S(2)
1518 SIGSP(IIS+3,I) = S(3)
1519 SIGSP(IIS+4,I) = S(4)
1520 SIGSP(IIS+5,I) = S(5)
1521 SIGSP(IIS+6,I) = S(6)
1522 ENDDO ! DO JL=1,NLAY
1523 ENDDO ! DO JR=1,NPTR
1524 ENDDO ! DO JT=1,NPTT
1525!
1526 ELSEIF ( ISOLNOD == 20 ) THEN
1527!
1528 SIZE = NPTT*NPTS*NPTR
1529 CALL HM_GET_FLOAT_ARRAY('epsilon_1' ,TMPVAL1,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1530 CALL HM_GET_FLOAT_ARRAY('epsilon_2' ,TMPVAL2,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1531 CALL HM_GET_FLOAT_ARRAY('epsilon_3' ,TMPVAL3,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1532 CALL HM_GET_FLOAT_ARRAY('epsilon_12' ,TMPVAL4,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1533 CALL HM_GET_FLOAT_ARRAY('epsilon_23' ,TMPVAL5,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1534 CALL HM_GET_FLOAT_ARRAY('epsilon_31' ,TMPVAL6,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1535!
1536!
1537 KK = 0
1538!
1539 DO JT=1,NPTT
1540 DO JS=1,NPTS
1541 DO JR=1,NPTR
1542 K = JR + ( (JS-1) + (JT-1)*NPTS )*NPTR
1543 IIS= NVSOLID1 + (K-1)*6
1544!
1545 KK = KK + 1
1546!
1547 S(1) = TMPVAL1(KK)
1548 S(2) = TMPVAL2(KK)
1549 S(3) = TMPVAL3(KK)
1550 S(4) = TMPVAL4(KK)
1551 S(5) = TMPVAL5(KK)
1552 S(6) = TMPVAL6(KK)
1553 IF (SUB_ID /= 0) CALL SUBROTTENS(S,RTRANS,SUB_ID,LSUBMODEL)
1554 SIGSP(IIS+1,I) = S(1)
1555 SIGSP(IIS+2,I) = S(2)
1556 SIGSP(IIS+3,I) = S(3)
1557 SIGSP(IIS+4,I) = S(4)
1558 SIGSP(IIS+5,I) = S(5)
1559 SIGSP(IIS+6,I) = S(6)
1560 ENDDO ! DO JR=1,NPTR
1561 ENDDO ! DO JS=1,NPTS
1562 ENDDO ! DO JT=1,NPTT
1563!
1564.OR..AND. ELSEIF ((IGTYP == 21 IGTYP == 22) JJHBE == 14) THEN
1565!
1566 SIZE = NPTR*NPTS*NPTT
1567 CALL HM_GET_FLOAT_ARRAY('epsilon_1' ,TMPVAL1,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1568 CALL HM_GET_FLOAT_ARRAY('epsilon_2' ,TMPVAL2,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1569 CALL HM_GET_FLOAT_ARRAY('epsilon_3' ,TMPVAL3,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1570 CALL HM_GET_FLOAT_ARRAY('epsilon_12' ,TMPVAL4,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1571 CALL HM_GET_FLOAT_ARRAY('epsilon_23' ,TMPVAL5,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1572 CALL HM_GET_FLOAT_ARRAY('epsilon_31' ,TMPVAL6,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1573!
1574 KK = 0
1575!
1576 DO JR=1,NPTR
1577 DO JS=1,NPTS
1578 DO JT=1,NPTT
1579 K = JR + ( (JS-1) + (JT-1)*NPTS )*NPTR
1580 IIS= NVSOLID1 + (K-1)*6
1581!
1582 KK = KK + 1
1583!
1584 S(1) = TMPVAL1(KK)
1585 S(2) = TMPVAL2(KK)
1586 S(3) = TMPVAL3(KK)
1587 S(4) = TMPVAL4(KK)
1588 S(5) = TMPVAL5(KK)
1589 S(6) = TMPVAL6(KK)
1590 IF (SUB_ID /= 0) CALL SUBROTTENS(S,RTRANS,SUB_ID,LSUBMODEL)
1591 SIGSP(IIS+1,I) = S(1)
1592 SIGSP(IIS+2,I) = S(2)
1593 SIGSP(IIS+3,I) = S(3)
1594 SIGSP(IIS+4,I) = S(4)
1595 SIGSP(IIS+5,I) = S(5)
1596 SIGSP(IIS+6,I) = S(6)
1597 ENDDO ! DO JT=1,NPTT
1598 ENDDO ! DO JS=1,NPTS
1599 ENDDO ! DO JR=1,NPTR
1600!
1601 ELSE
1602!
1603 SIZE = NPT
1604 CALL HM_GET_FLOAT_ARRAY('epsilon_1' ,TMPVAL1,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1605 CALL HM_GET_FLOAT_ARRAY('epsilon_2' ,TMPVAL2,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1606 CALL HM_GET_FLOAT_ARRAY('epsilon_3' ,TMPVAL3,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1607 CALL HM_GET_FLOAT_ARRAY('epsilon_12' ,TMPVAL4,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1608 CALL HM_GET_FLOAT_ARRAY('epsilon_23' ,TMPVAL5,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1609 CALL HM_GET_FLOAT_ARRAY('epsilon_31' ,TMPVAL6,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1610!
1611 DO K=1,NPT
1612 IIS= NVSOLID1 + (K-1)*6
1613 S(1) = TMPVAL1(K)
1614 S(2) = TMPVAL2(K)
1615 S(3) = TMPVAL3(K)
1616 S(4) = TMPVAL4(K)
1617 S(5) = TMPVAL5(K)
1618 S(6) = TMPVAL6(K)
1619 IF (SUB_ID /= 0) CALL SUBROTTENS(S,RTRANS,SUB_ID,LSUBMODEL)
1620 SIGSP(IIS+1,I) =S(1)
1621 SIGSP(IIS+2,I) =S(2)
1622 SIGSP(IIS+3,I) =S(3)
1623 SIGSP(IIS+4,I) =S(4)
1624 SIGSP(IIS+5,I) =S(5)
1625 SIGSP(IIS+6,I) =S(6)
1626 ENDDO ! DO K=1,NPT
1627
1628!
1629 ENDIF ! IF ( ISOLNOD == 16 )
1630 ENDIF ! IF (IE == 0)
1631 ENDDO ! DO J=1,NB_ELEMENTS
1632
1633
1634 CASE ( 'fail' )
1635
1636 CALL HM_GET_INTV('inibri_fail_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
1637!
1638 DO J=1,NB_ELEMENTS
1639 CALL HM_GET_INT_ARRAY_INDEX('brick_id' ,ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
1640 CALL HM_GET_INT_ARRAY_INDEX('nlay',NLAY,J,IS_AVAILABLE,LSUBMODEL)
1641 CALL HM_GET_INT_ARRAY_INDEX('nptr',NPTR,J,IS_AVAILABLE,LSUBMODEL)
1642 CALL HM_GET_INT_ARRAY_INDEX('npts',NPTS,J,IS_AVAILABLE,LSUBMODEL)
1643 CALL HM_GET_INT_ARRAY_INDEX('nptt',NPTT,J,IS_AVAILABLE,LSUBMODEL)
1644 CALL HM_GET_INT_ARRAY_INDEX('lay_id',ILAY,J,IS_AVAILABLE,LSUBMODEL)
1645 CALL HM_GET_INT_ARRAY_INDEX('fail_id',IFAIL,J,IS_AVAILABLE,LSUBMODEL)
1646 CALL HM_GET_INT_ARRAY_INDEX('ifail_typ',IRUPT_TYP,J,IS_AVAILABLE,LSUBMODEL)
1647 CALL HM_GET_INT_ARRAY_INDEX('nvar',NVAR_RUPT,J,IS_AVAILABLE,LSUBMODEL)
1648 CALL HM_GET_INT_ARRAY_INDEX('mat_id',IMAT,J,IS_AVAILABLE,LSUBMODEL)
1649!
1650 CALL HM_GET_INT_ARRAY_INDEX('num_lines',NUM_LINES,J,IS_AVAILABLE,LSUBMODEL)
1651!
1652! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISOLM,NUMELS)
1653! IE = MAP_TABLES%ISOLM(ELT,2)
1654!
1655 IE=UEL2SYS(ID_ELEM,KSYSUSRS,NUMELS)
1656!
1657 NVMAX = NVSOLID4 /(NPTR*NPTS*NPTT*NLAY*5)
1658!
1659 IF(ID_ELEM /= NEM1) I=I+1
1660 NEM1 = ID_ELEM
1661 IOK = 0
1662!
1663 DO K=1,NUMMAT
1664 IF(IPM(1,K) == IMAT)THEN
1665 IMAT = K
1666 IOK = 1
1667 EXIT
1668 ENDIF
1669 ENDDO
1670!
1671 IF (IOK == 0) THEN
1672 CALL ANCMSG(MSGID=1033,
1673 . MSGTYPE=MSGERROR,
1674 . ANMODE=ANINFO,
1675 . I1=ITRIS(IE),
1676 . C1='material law',
1677 . C2='/inibri/fail')
1678 ENDIF
1679 ID_SOLID_SIGI(I) = ID_ELEM
1680!
1681 IF (IE == 0) THEN
1682 ! Solid was not found. Issue a Warning & Skip.
1683 NONEXIST = NONEXIST+1
1684 ELSE
1685 IOK = 0
1686 DO K=1,5
1687 NFAIL(K) = MAT_PARAM(IMAT)%FAIL(K)%FAIL_ID
1688.AND. IF (IFAIL == NFAIL(K)
1689 . IRUPT_TYP == MAT_PARAM(IMAT)%FAIL(K)%IRUPT) THEN
1690 IFAIL = K
1691 FAIL_INI(IFAIL)=1
1692 IOK = 1
1693 EXIT
1694 ENDIF
1695 ENDDO
1696 IF (IOK == 0) THEN
1697 CALL ANCMSG(MSGID=1033,
1698 . MSGTYPE=MSGERROR,
1699 . ANMODE=ANINFO,
1700 . I1=ITRIS(IE),
1701 . C1='failure criteria',
1702 . C2='/inibri/fail')
1703 ENDIF ! IF (IOK == 0)
1704!
1705 IIS= NVSOLID1 + NVSOLID2 + 4 + NUSOLID + NVSOLID3
1706!
1707 NMAX_FAIL = NUM_LINES*NVAR_RUPT
1708 CALL HM_GET_FLOAT_ARRAY('v' ,TMPVAL,NMAX_FAIL,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1709!
1710 DO JJ=1,NUM_LINES
1711 DO K=1,NVAR_RUPT
1712 L = NVAR_RUPT*(JJ-1) + K
1713 SIGSP(IIS+L+(IFAIL-1)*NLAY*NPTR*NPTS*NPTT*NVMAX+
1714 . (ILAY-1)*NVMAX*NPTR*NPTS*NPTT,I) = TMPVAL(L)
1715 ENDDO ! DO K=1,NVAR_RUPT
1716 ENDDO ! DO JJ=1,NUM_LINE
1717!
1718 ENDIF ! IF (IE == 0)
1719 ENDDO ! DO J=1,NB_ELEMENTS
1720
1721 CASE ( 'scale_yld' )
1722
1723 CALL HM_GET_INTV('inibri_scale_yld_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
1724!
1725 IUSOLYLD = 1
1726 DO J=1,NB_ELEMENTS
1727 CALL HM_GET_INT_ARRAY_INDEX('brick_id' ,ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
1728 CALL HM_GET_INT_ARRAY_INDEX('nptr',NPTR,J,IS_AVAILABLE,LSUBMODEL)
1729 CALL HM_GET_INT_ARRAY_INDEX('npts',NPTS,J,IS_AVAILABLE,LSUBMODEL)
1730 CALL HM_GET_INT_ARRAY_INDEX('nptt',NPTT,J,IS_AVAILABLE,LSUBMODEL)
1731 CALL HM_GET_INT_ARRAY_INDEX('nlay',NLAY,J,IS_AVAILABLE,LSUBMODEL)
1732!
1733 CALL HM_GET_INT_ARRAY_INDEX('num_lines',NUM_LINES,J,IS_AVAILABLE,LSUBMODEL)
1734!
1735! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISOLM,NUMELS)
1736! IE = MAP_TABLES%ISOLM(ELT,2)
1737!
1738 IE=UEL2SYS(ID_ELEM,KSYSUSRS,NUMELS)
1739!
1740 I=I+1
1741 IF (NLAY == 0) NLAY = 1
1742 SIGI( 7,I) = ID_ELEM
1743 ID_SOLID_SIGI(I) = ID_ELEM
1744 IIS = NVSOLID1 + NVSOLID2 + NVSOLID3 + NUSOLID + 4 + NVSOLID4
1745 SIGSP(IIS + 7,I) = ID_ELEM
1746!
1747 SIGSP(IIS +1 , I) = NPTR
1748 SIGSP(IIS +2 , I) = NPTS
1749 SIGSP(IIS +3 , I) = NPTT
1750 SIGSP(IIS +4 , I) = NLAY
1751!
1752 IF (IE == 0) THEN
1753 ! Solid was not found. Issue a Warning & Skip.
1754 NONEXIST = NONEXIST+1
1755 ELSE
1756 IIS = NVSOLID1 + NVSOLID2 + NVSOLID3 + NUSOLID + 4 + NVSOLID4 + 7
1757!
1758 SIZE = NLAY*NPTT*NPTS*NPTR
1759 CALL HM_GET_FLOAT_ARRAY('alpha_lkji' ,TMPVAL,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1760!
1761 DO ILAY = 1,NLAY
1762 DO IT=1,NPTT
1763 DO IS=1,NPTS
1764 DO IR=1,NPTR
1765 JJ = NPTR*NPTS*NPTT*(ILAY-1)+ NPTR*NPTS*(IT-1)+NPTR*(IS-1)+IR
1766 SIGSP(IIS+ JJ ,I) = TMPVAL(JJ)
1767 ENDDO ! DO IR=1,NPTR
1768 ENDDO ! DO IS=1,NPTS
1769 ENDDO ! DO IT=1,NPTT
1770 ENDDO ! DO ILAY = 1,NLAY
1771!! IIS = IIS + NPTR*NPTS*NPTT*NLAY
1772!
1773 ENDIF ! IF (IE == 0)
1774 ENDDO ! DO J=1,NB_ELEMENTS
1775
1776 CASE ( 'ortho' )
1777
1778 CALL HM_GET_INTV('inibri_ortho_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
1779!
1780 KEYWORD='/inibri/ortho '
1781 NPT = 0
1782!
1783 DO J=1,NB_ELEMENTS
1784 CALL HM_GET_INT_ARRAY_INDEX('brick_id' ,ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
1785 CALL HM_GET_INT_ARRAY_INDEX('nb_layer' ,NLAY,J,IS_AVAILABLE,LSUBMODEL)
1786 CALL HM_GET_INT_ARRAY_INDEX('isolnod' ,ISOLNOD,J,IS_AVAILABLE,LSUBMODEL)
1787 CALL HM_GET_INT_ARRAY_INDEX('prop_type',IGTYP,J,IS_AVAILABLE,LSUBMODEL)
1788 CALL HM_GET_INT_ARRAY_INDEX('isolid' ,JJHBE,J,IS_AVAILABLE,LSUBMODEL)
1789!
1790 I=I+1
1791 ID_SOLID_SIGI(I) = ID_ELEM
1792 IF (JJHBE == 2) JJHBE = 1
1793!
1794! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISOLM,NUMELS)
1795! IE = MAP_TABLES%ISOLM(ELT,2)
1796!
1797 IE=UEL2SYS(ID_ELEM,KSYSUSRS,NUMELS)
1798!
1799!
1800 IF (IE == 0) THEN
1801 ! Solid was not found. Issue a Warning & Skip.
1802 NONEXIST = NONEXIST+1
1803 ELSE
1804 CALL LEC_INISTATE_D00_BRICK_CHECK (
1805 1 IXS ,IGEO ,ITRIS ,ISOLNODD00 ,IE ,
1806 2 NPT ,NLAY ,ISOLNOD ,JJHBE ,IGTYP ,
1807 3 ISROT ,KEYWORD )
1808!
1809 IIS= NVSOLID1 + NVSOLID2 + 4 + NUSOLID
1810!! IF(KEY2(8:10)=='glo.OR.'
1811.AND.!! . (IGTYP /= 21 IGTYP /= 22)) THEN
1812.AND. IF (IGTYP /= 21 IGTYP /= 22) THEN
1813 ORTHOGLOB(IE) = 1
1814 SIZE = NLAY
1815 CALL HM_GET_FLOAT_ARRAY('x1' ,TMPVAL1,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1816 CALL HM_GET_FLOAT_ARRAY('y1' ,TMPVAL2,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1817 CALL HM_GET_FLOAT_ARRAY('z1' ,TMPVAL3,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1818 CALL HM_GET_FLOAT_ARRAY('x2' ,TMPVAL4,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1819 CALL HM_GET_FLOAT_ARRAY('y2' ,TMPVAL5,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1820 CALL HM_GET_FLOAT_ARRAY('z3' ,TMPVAL6,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1821!
1822 DO K=1,NLAY
1823 SIGSP(IIS+1,I) = TMPVAL1(K)
1824 SIGSP(IIS+2,I) = TMPVAL2(K)
1825 SIGSP(IIS+3,I) = TMPVAL3(K)
1826 SIGSP(IIS+4,I) = TMPVAL4(K)
1827 SIGSP(IIS+5,I) = TMPVAL5(K)
1828 SIGSP(IIS+6,I) = TMPVAL6(K)
1829 IIS = IIS + 6
1830 ENDDO
1831 ELSE
1832 SIZE = NLAY
1833 CALL HM_GET_FLOAT_ARRAY('cos_alpha' ,TMPVAL1,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1834 CALL HM_GET_FLOAT_ARRAY('sin_alpha' ,TMPVAL2,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1835!
1836 DO K=1,NLAY
1837 SIGSP(IIS+1,I) = TMPVAL1(K)
1838 SIGSP(IIS+2,I) = TMPVAL2(K)
1839 IIS = IIS + 6
1840 ENDDO
1841.AND. ENDIF ! IF (IGTYP /= 21 IGTYP /= 22)
1842!
1843 ENDIF ! IF (IE == 0)
1844 ENDDO ! DO J=1,NB_ELEMENTS
1845
1846
1847 CASE ( 'eref' )
1848
1849 CALL HM_GET_INTV('inibri_eref_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
1850!
1851 KEYWORD='/inibri/eref '
1852!
1853 DO J=1,NB_ELEMENTS
1854 CALL HM_GET_INT_ARRAY_INDEX('brick_id' ,ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
1855 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NPT,J,IS_AVAILABLE,LSUBMODEL)
1856 CALL HM_GET_INT_ARRAY_INDEX('isolnod' ,ISOLNOD,J,IS_AVAILABLE,LSUBMODEL)
1857 CALL HM_GET_INT_ARRAY_INDEX('isolid' ,JJHBE,J,IS_AVAILABLE,LSUBMODEL)
1858 CALL HM_GET_INT_ARRAY_INDEX('ismstr' ,ISMSTR,J,IS_AVAILABLE,LSUBMODEL)
1859 CALL HM_GET_INT_ARRAY_INDEX('nsrot' ,NSROT,J,IS_AVAILABLE,LSUBMODEL)
1860!
1861 I=I+1
1862 IF (JJHBE == 2) JJHBE = 1
1863 ID_SOLID_SIGI(I) = ID_ELEM
1864!
1865! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISOLM,NUMELS)
1866! IE = MAP_TABLES%ISOLM(ELT,2)
1867!
1868 IE=UEL2SYS(ID_ELEM,KSYSUSRS,NUMELS)
1869!
1870!
1871 IF (IE == 0) THEN
1872 ! Solid was not found. Issue a Warning & Skip.
1873 NONEXIST = NONEXIST+1
1874 ELSE
1875 CALL LEC_INISTATE_D00_BRICK_CHECK (
1876 1 IXS ,IGEO ,ITRIS ,ISOLNODD00 ,IE ,
1877 2 NPT ,NLAY ,ISOLNOD ,JJHBE ,IGTYP ,
1878 3 ISROT ,KEYWORD )
1879
1880
1881 PID = IXS(10,IE)
1882 NG = IES2IPARG(IE)
1883 ISMRAD = IPARG(9,NG)
1884.OR..AND. IF (ISMRAD/=ISMSTR(ISMSTR/=1ISMSTR<10)) THEN
1885 CALL ANCMSG(MSGID=695,
1886 . MSGTYPE=MSGERROR,
1887 . ANMODE=ANINFO,
1888 . I1=ITRIS(IE),
1889 . C1='small strain formulation',
1890 . c2='SOLID PROPERTY'
1891 . i2=igeo(1,pid),
1892 . c3=keyword)
1893 ENDIF
1894 iis= nvsolid1 + nvsolid2 + nvsolid3 + nusolid+4 + nvsolid4 +
1895 . nvsolid5
1896
1897 SIZE = isolnod
1899 CALL HM_GET_FLOAT_ARRAY('yref' ,TMPVAL2,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1900 CALL HM_GET_FLOAT_ARRAY('zref' ,TMPVAL3,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1901!
1902 DO K=1,ISOLNOD
1903 S(1) =TMPVAL1(K)
1904 S(2) =TMPVAL2(K)
1905 S(3) =TMPVAL3(K)
1906.AND..OR. IF(SUB_ID /= 0 (ISMSTR==1ISMSTR==11))
1907 . CALL SUBROTVECT (S(1),S(2),S(3),RTRANS,SUB_ID,LSUBMODEL)
1908 SIGSP(IIS+(K-1)*3+1,I) =S(1)
1909 SIGSP(IIS+(K-1)*3+2,I) =S(2)
1910 SIGSP(IIS+(K-1)*3+3,I) =S(3)
1911 ENDDO ! DO J=1,ISOLNOD
1912 SIZE = NSROT
1913 CALL HM_GET_FLOAT_ARRAY('rx' ,TMPVAL1,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1914 CALL HM_GET_FLOAT_ARRAY('ry' ,TMPVAL2,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1915 CALL HM_GET_FLOAT_ARRAY('rz' ,TMPVAL3,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1916!
1917 IIS = IIS + 3*ISOLNOD
1918 DO K=1,NSROT
1919 S(1) =TMPVAL1(K)
1920 S(2) =TMPVAL2(K)
1921 S(3) =TMPVAL3(K)
1922.AND..OR. IF(SUB_ID /= 0 (ISMSTR==1ISMSTR==11))
1923 . CALL SUBROTVECT (S(1),S(2),S(3),RTRANS,SUB_ID,LSUBMODEL)
1924 SIGSP(IIS+(K-1)*3+1,I) =S(1)
1925 SIGSP(IIS+(K-1)*3+2,I) =S(2)
1926 SIGSP(IIS+(K-1)*3+3,I) =S(3)
1927 ENDDO
1928 STRAGLOB(IE)=10
1929!
1930 ENDIF ! IF (IE == 0)
1931 ENDDO ! DO J=1,NB_ELEMENTS
1932
1933
1934 CASE DEFAULT
1935
1936 END SELECT ! SELECT CASE(KEY)
1937!---
1938 ENDDO ! DO INI=1,NB_INIBRI
1939 ENDIF ! IF ( NB_INIBRI > 0 )
1940!
1941 NIBRICK = I
1942!-----------------------------------------
1943! --- /INISHE ---
1944!-----------------------------------------
1945 NISHELL = 0
1946 I = 0
1947!
1948 CALL HM_OPTION_COUNT('/inishe', NB_INISHE)
1949!
1950 IF ( NB_INISHE > 0 ) THEN
1951!
1952 ! Start reading /INISHE card
1953 CALL HM_OPTION_START('/inishe')
1954!---
1955! to be replaced by --- MAP_TABLES%ISH4NM ---
1956 IF (KTRIELC == 0) THEN
1957
1958 DO IE = 1, NUMELC
1959 ITRI(IE) = IXC(NIXC,IE)
1960 END DO
1961 CALL MY_ORDERS(0,WORK,ITRI,INDEX,NUMELC,1)
1962 DO J = 1, NUMELC
1963 IE=INDEX(J)
1964 KSYSUSR(J) =IXC(NIXC,IE)
1965 KSYSUSR(NUMELC+J)=IE
1966 END DO
1967 KTRIELC=1
1968 ENDIF
1969!---
1970 DO INI=1,NB_INISHE
1971!
1972 CALL HM_OPTION_READ_KEY(LSUBMODEL,
1973 . UNIT_ID = UID,
1974 . SUBMODEL_INDEX = SUB_INDEX,
1975 . SUBMODEL_ID = SUB_ID,
1976 . KEYWORD2 = KEY,
1977 . KEYWORD3 = KEY2)
1978!
1979 IF (KEY2 /= ' ') GLOB = .TRUE.
1980!
1981 IFLAGUNIT = 0
1982 DO IUNIT=1,UNITAB%NUNITS
1983 IF (UNITAB%UNIT_ID(IUNIT) == UID) THEN
1984 IFLAGUNIT = 1
1985 EXIT
1986 ENDIF
1987 ENDDO
1988!
1989.AND. IF (UID /= 0IFLAGUNIT == 0) THEN
1990 CALL ANCMSG(MSGID=659,ANMODE=ANINFO,MSGTYPE=MSGERROR,
1991 . I2=UID, I1=SUB_ID, C1='inishe',
1992 . C2='inishe',
1993 . C3=' ')
1994 ENDIF
1995
1996 SELECT CASE (KEY(1:LEN_TRIM(KEY)))
1997
1998 CASE ( 'epsp_f' )
1999
2000 ISIGSH =1
2001!
2002 CALL HM_GET_INTV('inishe_epsp_f_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
2003!
2004 DO J=1,NB_ELEMENTS
2005 ! Reading --- ID_ELEM, NIP, NPG, THK ---
2006 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
2007 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NIP,J,IS_AVAILABLE,LSUBMODEL)
2008 CALL HM_GET_INT_ARRAY_INDEX('npg',NPG,J,IS_AVAILABLE,LSUBMODEL)
2009 CALL HM_GET_FLOAT_ARRAY_INDEX('thick',THK,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2010!
2011! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH4NM,NUMELC)
2012! IE = MAP_TABLES%ISH4NM(ELT,2)
2013!
2014 IE=UEL2SYS(ID_ELEM,KSYSUSR,NUMELC)
2015!
2016 IF (IE == 0) THEN
2017 ! Shell was not found. Issue a Warning & Skip.
2018 NONEXIST = NONEXIST+1
2019 ELSE
2020!
2021 ! check is SHELL is QEPH
2022 IG = IXC(6,IE)
2023 IHBE = IGEO(10,IG)
2024.OR. IF (IHBE==12 IHBE==24) THEN
2025 NPGTMP = 4
2026 ELSE
2027 NPGTMP = 1
2028 ENDIF
2029 IF (NPGTMP /= NPG) THEN
2030 CALL FRETITL2(TITR,IGEO(NPROPGI-LTITR+1,IG),LTITR)
2031 CALL ANCMSG(MSGID=26,
2032 . ANMODE=ANINFO,
2033 . MSGTYPE=MSGERROR,
2034 . I1=IGEO(1,IG),
2035 . C1=TITR,
2036 . I2=ID_ELEM)
2037 ENDIF
2038!
2039 I = PTSHEL(IE)
2040 ID_SIGSH(I) = ID_ELEM
2041 SIGSH(1,I) = ID_ELEM
2042 SIGSH(2,I) = NIP
2043 SIGSH(3,I) = THK
2044 SIGSH(NVSHELL - 1,I) = ONE
2045!
2046 IF (NPG <= 1) THEN
2047!---
2048 SIZE = NIP*MAX(NPG,1)
2049 CALL HM_GET_FLOAT_ARRAY('ep',TMPVAL,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2050!
2051 PT=22
2052 JJ=NIP*MAX(NPG,1)
2053 K0 = 0
2054 DO WHILE(JJ > 0)
2055 L=MIN(JJ,5)
2056 DO K=1,L
2057 SIGSH(PT+(K-1)*6+5,I) = TMPVAL(K+K0)
2058 ENDDO
2059 K0=K0+5
2060 PT=PT+30
2061 JJ=JJ-5
2062 ENDDO ! DO WHILE(JJ > 0)
2063!--------------------
2064 ELSEIF (NPG > 1) THEN
2065 SIGSH(NVSHELL,I) = NPG
2066!
2067 IF (NIP == 0) THEN
2068!---
2069 SIZE = NPG
2070 CALL HM_GET_FLOAT_ARRAY('ep',TMPVAL,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2071!
2072 PT=22
2073 DO K=1,NPG
2074 SIGSH(PT+(K-1)*9+5,I) = TMPVAL(K)
2075 ENDDO
2076 ELSE
2077!---
2078 SIZE = NIP*NPG
2079 CALL HM_GET_FLOAT_ARRAY('ep',TMPVAL,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2080!
2081 PT=22
2082 JJ=NIP*NPG
2083 K0 = 0
2084 DO WHILE(JJ > 0)
2085 L=MIN(JJ,5)
2086 DO K=1,L
2087 SIGSH(PT+(K-1)*6+5,I) = TMPVAL(K+K0)
2088 ENDDO
2089!
2090 K0=K0+5
2091 PT=PT+30
2092 JJ=JJ-5
2093 END DO ! DO WHILE(JJ > 0)
2094!---------------------
2095 END IF ! IF (NIP == 0)
2096 END IF !(NPG<=1)
2097 ENDIF ! IF (IE /= 0)
2098 ENDDO ! DO I=1,NB_ELEMENTS
2099
2100 CASE ( 'strs_f' )
2101
2102 ISIGSH =1
2103
2104! --- 'strs_f/glob' ---
2105
2106 IF ( GLOB ) THEN
2107 CALL HM_GET_INTV('inishe_strs_f_glob_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
2108!
2109 DO J=1,NB_ELEMENTS
2110 ! Reading --- ID_ELEM, NIP, NPG, THK ---
2111 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
2112 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NIP,J,IS_AVAILABLE,LSUBMODEL)
2113 CALL HM_GET_INT_ARRAY_INDEX('npg',NPG,J,IS_AVAILABLE,LSUBMODEL)
2114 CALL HM_GET_FLOAT_ARRAY_INDEX('thick',thk,j,is_available,lsubmodel,unitab)
2115
2116
2117
2118
2119 ie=
uel2sys(id_elem,ksysusr,numelc)
2120
2121 IF (ie == 0) THEN
2122
2123 nonexist = nonexist+1
2124 ELSE
2125
2126
2127 ig = ixc(6,ie)
2128 ihbe = igeo(10,ig)
2129 IF (ihbe==12 .OR. ihbe==24) THEN
2130 npgtmp = 4
2131 ELSE
2132 npgtmp = 1
2133 ENDIF
2134 IF (npgtmp /= npg) THEN
2135 CALL fretitl2(titr,igeo(npropgi-ltitr+1,ig),ltitr)
2137 . anmode=aninfo,
2138 . msgtype=msgerror,
2139 . i1=igeo(1,ig),
2140 . c1=titr,
2141 . i2=id_elem)
2142 ENDIF
2143
2144
2150
2151 i = ptshel(ie)
2152 sigsh(1,i) = id_elem
2153 id_sigsh(i) = id_elem
2154 sigsh(2,i) = nip
2155 sigsh(3,i) = thk
2156 sigsh(4,i) = em
2157 sigsh(5,i) = eb
2158 sigsh(17,i) = one
2159 sigsh(nvshell - 1 , i) = one
2160
2161 IF (npg == 0 .OR. npg == 1) THEN
2162
2163 sigsh(14,i) = h1
2164 sigsh(15,i) = h2
2165 sigsh(16,i) = h3
2166
2167 IF (nip == 0) THEN
2168
2172
2176
2177
2181
2186
2187 ELSEIF (nip /= 0) THEN
2188
2189 SIZE = nip
2198
2199
2200 inishvar = 22 + nip*6
2201 DO n=1,nip
2202 pt = 22 + (n-1)*6
2203
2204 sigsh(pt,i) = tmpval1(n)
2205 sigsh(pt + 1,i) = tmpval2(n)
2206 sigsh(inishvar + n,i) = tmpval3(n)
2207 sigsh(pt + 2,i) = tmpval4(n)
2208 sigsh(pt + 3,i) = tmpval5(n)
2209 sigsh(pt + 4,i) = tmpval6(n)
2210 sigsh(pt + 5,i) = tmpval7(n)
2211 sigsh(inishvar + nip + n,i) = tmpval8(n)
2212 ENDDO
2213 ENDIF
2214
2215 ELSEIF (npg > 1) THEN
2216
2217 sigsh(nvshell,i) = npg
2218
2219 IF (nip == 0) THEN
2220
2221 SIZE = npg
2235
2236 DO k=1,npg
2237 pt= 22 + (k-1)*13
2238
2239 sigsh(pt ,i) = tmpval1(k)
2240 sigsh(pt+1,i) = tmpval2(k)
2241 sigsh(pt+2,i) = tmpval3(k)
2242 sigsh(pt+3,i) = tmpval4(k)
2243 sigsh(pt+4,i) = tmpval5(k)
2244 sigsh(pt+5,i) = tmpval6(k)
2245 sigsh(pt+6,i) = tmpval7(k)
2246 sigsh(pt+7,i) = tmpval8(k)
2247 sigsh(pt+8,i) = tmpval9(k)
2248 sigsh(pt+9,i) = tmpval10(k)
2249 sigsh(pt+10,i) = tmpval11(k)
2250 sigsh(pt+11,i) = tmpval12(k)
2251 sigsh(pt+12,i) = tmpval13(k)
2252 ENDDO
2253
2254 ELSE
2255
2256 SIZE = nip*npg
2265
2266
2267 pt = 22
2268 DO n=1,nip
2269 DO k=1,npg
2270 l = (n-1)*npg+k
2271
2272 sigsh(pt ,i) = tmpval1(l)
2273 sigsh(pt+1,i) = tmpval2(l)
2274 sigsh(pt+2,i) = tmpval3(l)
2275 sigsh(pt+3,i) = tmpval4(l)
2276 sigsh(pt+4,i) = tmpval5(l)
2277 sigsh(pt+5,i) = tmpval6(l)
2278 sigsh(pt+6,i) = tmpval7(l)
2279 sigsh(pt+7,i) = tmpval8(l)
2280 pt = pt + 8
2281 ENDDO
2282 ENDDO
2283 ENDIF
2284
2285 ENDIF
2286
2287 ENDIF
2288 ENDDO
2289
2290
2291
2292 ELSEIF ( .NOT. glob ) THEN
2293
2294 CALL hm_get_intv(
'inishe_strs_f_count',nb_elements,is_available,lsubmodel)
2295
2296 DO j=1,nb_elements
2297
2301 CALL HM_GET_FLOAT_ARRAY_INDEX('thick',THK,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2302!
2303! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH4NM,NUMELC)
2304! IE = MAP_TABLES%ISH4NM(ELT,2)
2305!
2306 IE=UEL2SYS(ID_ELEM,KSYSUSR,NUMELC)
2307!
2308 IF (IE == 0) THEN
2309 ! Shell was not found. Issue a Warning & Skip.
2310 NONEXIST = NONEXIST+1
2311 ELSE
2312!
2313 ! check is SHELL is QEPH
2314 IG = IXC(6,IE)
2315 IHBE = IGEO(10,IG)
2316.OR. IF (IHBE==12 IHBE==24) THEN
2317 NPGTMP = 4
2318 ELSE
2319 NPGTMP = 1
2320 ENDIF
2321 IF (NPGTMP /= NPG) THEN
2322 CALL FRETITL2(TITR,IGEO(NPROPGI-LTITR+1,IG),LTITR)
2323 CALL ANCMSG(MSGID=26,
2324 . ANMODE=ANINFO,
2325 . MSGTYPE=MSGERROR,
2326 . I1=IGEO(1,IG),
2327 . C1=TITR,
2328 . I2=ID_ELEM)
2329 ENDIF
2330!
2331 ! Reading CARD_2 --- EM,EB,H1,H2,H3 ---
2332 CALL HM_GET_FLOAT_ARRAY_INDEX('em',EM,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2333 CALL HM_GET_FLOAT_ARRAY_INDEX('eb',EB,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2334 CALL HM_GET_FLOAT_ARRAY_INDEX('h1',H1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2335 CALL HM_GET_FLOAT_ARRAY_INDEX('h2',H2,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2336 CALL HM_GET_FLOAT_ARRAY_INDEX('h3',H3,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2337!
2338 I = PTSHEL(IE)
2339
2340 SIGSH(1,I) = ID_ELEM
2341 ID_SIGSH(I) = ID_ELEM
2342 SIGSH(2,I) = NIP
2343 SIGSH(3,I) = THK
2344 SIGSH(4,I) = EM
2345 SIGSH(5,I) = EB
2346 SIGSH(17,I) = ZERO
2347 SIGSH(NVSHELL - 1 , I) = ONE
2348!----
2349.OR. IF (NPG == 0 NPG == 1) THEN
2350!----
2351 SIGSH(14,I) = H1
2352 SIGSH(15,I) = H2
2353 SIGSH(16,I) = H3
2354!
2355 IF (NIP == 0) THEN
2356 ! Reading CARD_3 --- sigma_1, sigma_2, sigma_12, sigma_23, sigma_31 ---
2357 CALL HM_GET_FLOAT_ARRAY('sigma_1' ,SIGSH(22,I),1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2358 CALL HM_GET_FLOAT_ARRAY('sigma_2' ,SIGSH(23,I),1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2359 CALL HM_GET_FLOAT_ARRAY('sigma_12',SIGSH(24,I),1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2360 CALL HM_GET_FLOAT_ARRAY('sigma_23',SIGSH(25,I),1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2361 CALL HM_GET_FLOAT_ARRAY('sigma_31',SIGSH(26,I),1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2362!
2363 ! Reading CARD_4 --- eps_p, sigma_b1, sigma_b2, sigma_b12 ---
2364 CALL HM_GET_FLOAT_ARRAY('eps_p' ,SIGSH(27,I),1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2365 CALL HM_GET_FLOAT_ARRAY('sigma_b1' ,SIGSH(28,I),1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2366 CALL HM_GET_FLOAT_ARRAY('sigma_b2' ,SIGSH(29,I),1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2367 CALL HM_GET_FLOAT_ARRAY('sigma_b12',SIGSH(30,I),1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2368!
2369 ELSEIF (NIP /= 0) THEN
2370!
2371 SIZE = NIP
2372 CALL HM_GET_FLOAT_ARRAY('sigma_1' ,TMPVAL1,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2373 CALL HM_GET_FLOAT_ARRAY('sigma_2' ,TMPVAL2,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2374 CALL HM_GET_FLOAT_ARRAY('sigma_12',TMPVAL3,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2375 CALL HM_GET_FLOAT_ARRAY('sigma_23',TMPVAL4,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2376 CALL HM_GET_FLOAT_ARRAY('sigma_31',TMPVAL5,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2377 CALL HM_GET_FLOAT_ARRAY('eps_p' ,TMPVAL6,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2378!
2379!
2380 INISHVAR = 22 + NIP*6
2381 DO N=1,NIP
2382 PT = 22 + (N-1)*6
2383 ! Reading CARD_3 --- sigma_1, sigma_2, sigma_12 ---
2384 SIGSH(PT ,I) = TMPVAL1(N)
2385 SIGSH(PT+1,I) = TMPVAL2(N)
2386 SIGSH(PT+2,I) = TMPVAL3(N)
2387 SIGSH(PT+3,I) = TMPVAL4(N)
2388 SIGSH(PT+4,I) = TMPVAL5(N)
2389 SIGSH(PT+6,I) = TMPVAL6(N)
2390 ENDDO ! DO K=1,NIP
2391 ENDIF ! IF (NIP = 0) THEN
2392!----
2393 ELSEIF (NPG > 1) THEN
2394!----
2395 SIGSH(NVSHELL,I) = NPG
2396!
2397 IF (NIP == 0) THEN
2398!
2399 SIZE = NPG
2400 CALL HM_GET_FLOAT_ARRAY('sigma_1' ,TMPVAL1,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2401 CALL HM_GET_FLOAT_ARRAY('sigma_2' ,TMPVAL2,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2402 CALL HM_GET_FLOAT_ARRAY('sigma_12' ,TMPVAL3,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2403 CALL HM_GET_FLOAT_ARRAY('sigma_23' ,TMPVAL4,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2404 CALL HM_GET_FLOAT_ARRAY('sigma_31' ,TMPVAL5,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2405 CALL HM_GET_FLOAT_ARRAY('eps_p' ,TMPVAL6,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2406 CALL HM_GET_FLOAT_ARRAY('sigma_b1' ,TMPVAL7,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2407 CALL HM_GET_FLOAT_ARRAY('sigma_b2' ,TMPVAL8,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2408 CALL HM_GET_FLOAT_ARRAY('sigma_b12',TMPVAL9,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2409!
2410 DO K=1,NPG
2411 PT= 22 + (K-1)*9
2412 ! Reading CARD_3 --- sigma_1, sigma_2, sigma_12, sigma_23, sigma_31 ---
2413 SIGSH(PT ,I) = TMPVAL1(K)
2414 SIGSH(PT+1,I) = TMPVAL2(K)
2415 SIGSH(PT+2,I) = TMPVAL3(K)
2416 SIGSH(PT+3,I) = TMPVAL4(K)
2417 SIGSH(PT+4,I) = TMPVAL5(K)
2418 SIGSH(PT+5,I) = TMPVAL6(K)
2419 SIGSH(PT+6,I) = TMPVAL7(K)
2420 SIGSH(PT+7,I) = TMPVAL8(K)
2421 SIGSH(PT+8,I) = TMPVAL9(K)
2422 ENDDO ! DO K=1,NPG
2423!
2424 ELSE ! NIP > 0
2425!
2426 SIZE = NIP*NPG
2427 CALL HM_GET_FLOAT_ARRAY('sigma_1' ,TMPVAL1,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2428 CALL HM_GET_FLOAT_ARRAY('sigma_2' ,TMPVAL2,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2429 CALL HM_GET_FLOAT_ARRAY('sigma_12',TMPVAL3,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2430 CALL HM_GET_FLOAT_ARRAY('sigma_23',TMPVAL4,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2431 CALL HM_GET_FLOAT_ARRAY('sigma_31',TMPVAL5,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2432 CALL HM_GET_FLOAT_ARRAY('eps_p' ,TMPVAL6,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2433!
2434 PT = 22
2435 DO N=1,NIP
2436 DO K=1,NPG
2437 L = (N-1)*NPG+K
2438 ! Reading CARD_3 --- sigma_1, sigma_2, sigma_12 ---
2439 SIGSH(PT ,I) = TMPVAL1(L)
2440 SIGSH(PT+1,I) = TMPVAL2(L)
2441 SIGSH(PT+2,I) = TMPVAL3(L)
2442 SIGSH(PT+3,I) = TMPVAL4(L)
2443 SIGSH(PT+4,I) = TMPVAL5(L)
2444 SIGSH(PT+5,I) = TMPVAL6(L)
2445
2446 PT = PT + 6
2447 ENDDO ! DO K=1,NPG
2448 ENDDO ! DO N=1,NIP
2449 ENDIF ! IF (NIP == 0) THEN
2450!----
2451.OR. ENDIF ! IF (NPG == 0 NPG == 1)
2452!----
2453 ENDIF ! IF (IE == 0)
2454 ENDDO ! DO I=1,NB_ELEMENTS
2455 ENDIF ! IF ( GLOB )
2456
2457 CASE ( 'stra_f' )
2458
2459
2460 ITHKSHEL =2
2461
2462 IF ( GLOB ) THEN
2463 CALL HM_GET_INTV('inishe_stra_f_glob_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
2464!
2465 DO J=1,NB_ELEMENTS
2466 ! Reading CARD_1 --- ID_ELEM, NIP, NPG, THK ---
2467 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
2468 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NIP,J,IS_AVAILABLE,LSUBMODEL)
2469 CALL HM_GET_INT_ARRAY_INDEX('npg',NPG,J,IS_AVAILABLE,LSUBMODEL)
2470 CALL HM_GET_FLOAT_ARRAY_INDEX('thick',THK,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2471!
2472! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH4NM,NUMELC)
2473! IE = MAP_TABLES%ISH4NM(ELT,2)
2474!
2475 IE=UEL2SYS(ID_ELEM,KSYSUSR,NUMELC)
2476!
2477 IF (IE == 0) THEN
2478 ! Shell was not found. Issue a Warning & Skip.
2479 NONEXIST = NONEXIST+1
2480 ELSE
2481 I = PTSHEL(IE)
2482 SIGSH(1,I) = ID_ELEM
2483 ID_SIGSH(I) = ID_ELEM
2484 SIGSH(2,I) = NIP
2485 SIGSH(3,I) = THK
2486 SIGSH(17,I) = ONE
2487 SIGSH(NVSHELL - 1 , I) = ONE
2488
2489.OR. IF (NPG == 0 NPG == 1) THEN
2490 IG = IXC(6,IE)
2491 IHBE = IGEO(10,IG)
2492 IF (IHBE==24) SIGSH(NVSHELL,I) = 4
2493 ELSEIF (NPG>1 ) THEN
2494
2495 SIGSH(NVSHELL,I) = NPG
2496 ELSE
2497
2498.OR. ENDIF ! IF (NPG == 0 NPG == 1)
2499 PT = INISHVAR1
2500 NPP = NIP
2501 IF (NPP==0) NPP=2
2502!===============================================
2503 SIZE = NPP*NPG
2504 CALL HM_GET_FLOAT_ARRAY('eps_xx' ,TMPVAL1,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2505 CALL HM_GET_FLOAT_ARRAY('eps_yy' ,TMPVAL2,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2506 CALL HM_GET_FLOAT_ARRAY('eps_zz' ,TMPVAL3,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2507 CALL HM_GET_FLOAT_ARRAY('eps_xy' ,TMPVAL4,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2508 CALL HM_GET_FLOAT_ARRAY('eps_yz' ,TMPVAL5,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2509 CALL HM_GET_FLOAT_ARRAY('eps_zx' ,TMPVAL6,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2510 CALL HM_GET_FLOAT_ARRAY('t' ,TMPVAL7,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2511!
2512 DO N=1,MIN(2,NPP)
2513 DO IPG=1,MAX(1,NPG)
2514 L = (N-1)*MAX(1,NPG)+IPG
2515 SIGSH(PT ,I) = TMPVAL1(L)
2516 SIGSH(PT+1,I) = TMPVAL2(L)
2517 SIGSH(PT+2,I) = TMPVAL3(L)
2518 SIGSH(PT+3,I) = TMPVAL4(L)
2519 SIGSH(PT+4,I) = TMPVAL5(L)
2520 SIGSH(PT+5,I) = TMPVAL6(L)
2521 SIGSH(PT+6,I) = TMPVAL7(L)
2522 PT=PT+7
2523 ENDDO
2524 ENDDO
2525!===============================================
2526 ENDIF ! IF (IE == 0) THEN
2527 ENDDO ! DO J=1,NB_ELEMENTS
2528!
2529.NOT. ELSEIF ( GLOB ) THEN
2530!
2531 CALL HM_GET_INTV('inishe_stra_f_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
2532!
2533 DO J=1,NB_ELEMENTS
2534 ! Reading CARD_1 --- ID_ELEM, NIP, NPG, THK ---
2535 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
2536 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NIP,J,IS_AVAILABLE,LSUBMODEL)
2537 CALL HM_GET_INT_ARRAY_INDEX('npg',NPG,J,IS_AVAILABLE,LSUBMODEL)
2538 CALL HM_GET_FLOAT_ARRAY_INDEX('thick',THK,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2539!
2540! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH4NM,NUMELC)
2541! IE = MAP_TABLES%ISH4NM(ELT,2)
2542!
2543 IE=UEL2SYS(ID_ELEM,KSYSUSR,NUMELC)
2544!
2545 IF (IE == 0) THEN
2546 ! Shell was not found. Issue a Warning & Skip.
2547 NONEXIST = NONEXIST+1
2548 ELSE
2549 I = PTSHEL(IE)
2550 SIGSH(1,I) = ID_ELEM
2551 ID_SIGSH(I) = ID_ELEM
2552 SIGSH(3,I) = THK
2553 SIGSH(NVSHELL - 1 , I) = ONE
2554!
2555.OR. IF (NPG == 0 NPG == 1) THEN
2556!
2557 IG = IXC(6,IE)
2558 IHBE = IGEO(10,IG)
2559 IF (IHBE==24) SIGSH(NVSHELL,I) = 4
2560!
2561 CALL HM_GET_FLOAT_ARRAY('eps_1' ,SIGSH(6,I),1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2562 CALL HM_GET_FLOAT_ARRAY('eps_2' ,SIGSH(7,I),1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2563 CALL HM_GET_FLOAT_ARRAY('eps_12' ,SIGSH(8,I),1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2564 CALL HM_GET_FLOAT_ARRAY('eps_23' ,SIGSH(9,I),1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2565 CALL HM_GET_FLOAT_ARRAY('eps_31' ,SIGSH(10,I),1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2566 CALL HM_GET_FLOAT_ARRAY('k1' ,SIGSH(11,I),1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2567 CALL HM_GET_FLOAT_ARRAY('k2' ,SIGSH(12,I),1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2568 CALL HM_GET_FLOAT_ARRAY('k12' ,SIGSH(13,I),1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2569!
2570 ELSEIF (NPG>1 ) THEN
2571!
2572 SIGSH(NVSHELL,I) = NPG
2573
2574 SIGSH(6,I) =ZERO
2575 SIGSH(7,I) =ZERO
2576 SIGSH(8,I) =ZERO
2577 SIGSH(9,I) =ZERO
2578 SIGSH(10,I)=ZERO
2579 SIGSH(11,I)=ZERO
2580 SIGSH(12,I)=ZERO
2581 SIGSH(13,I)=ZERO
2582!
2583 SIZE = NPG
2584 CALL HM_GET_FLOAT_ARRAY('eps_1' ,TMPVAL1,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2585 CALL HM_GET_FLOAT_ARRAY('eps_2' ,TMPVAL2,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2586 CALL HM_GET_FLOAT_ARRAY('eps_12' ,TMPVAL3,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2587 CALL HM_GET_FLOAT_ARRAY('eps_23' ,TMPVAL4,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2588 CALL HM_GET_FLOAT_ARRAY('eps_31' ,TMPVAL5,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2589 CALL HM_GET_FLOAT_ARRAY('k1' ,TMPVAL6,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2590 CALL HM_GET_FLOAT_ARRAY('k2' ,TMPVAL7,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2591 CALL HM_GET_FLOAT_ARRAY('k12' ,TMPVAL8,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2592!
2593 DO IPG=1,NPG
2594! average only :
2595 SIGSH(6,I) =SIGSH(6,I) +TMPVAL1(IPG)/NPG
2596 SIGSH(7,I) =SIGSH(7,I) +TMPVAL2(IPG)/NPG
2597 SIGSH(8,I) =SIGSH(8,I) +TMPVAL3(IPG)/NPG
2598 SIGSH(9,I) =SIGSH(9,I) +TMPVAL4(IPG)/NPG
2599 SIGSH(10,I)=SIGSH(10,I)+TMPVAL5(IPG)/NPG
2600 SIGSH(11,I)=SIGSH(11,I)+TMPVAL6(IPG)/NPG
2601 SIGSH(12,I)=SIGSH(12,I)+TMPVAL7(IPG)/NPG
2602 SIGSH(13,I)=SIGSH(13,I)+TMPVAL8(IPG)/NPG
2603 END DO
2604 ELSE
2605
2606.OR. ENDIF ! IF (NPG == 0 NPG == 1)
2607 ENDIF ! IF (IE == 0) THEN
2608 ENDDO ! DO J=1,NB_ELEMENTS
2609 ENDIF ! IF ( GLOB ) THEN
2610
2611
2612 CASE ( 'thick' )
2613
2614 ITHKSHEL = 1
2615!
2616 CALL HM_GET_INTV('no_elems',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
2617!
2618 DO J=1,NB_ELEMENTS
2619 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
2620 CALL HM_GET_FLOAT_ARRAY_INDEX('thick' ,THK,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2621!
2622!
2623! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH4NM,NUMELC)
2624! IE = MAP_TABLES%ISH4NM(ELT,2)
2625!
2626 IE=UEL2SYS(ID_ELEM,KSYSUSR,NUMELC)
2627!
2628 IF (IE == 0) THEN
2629 ! Shell was not found. Issue a Warning & Skip.
2630 NONEXIST = NONEXIST+1
2631 ELSE
2632 I = PTSHEL(IE)
2633 SIGSH(1,I) = ID_ELEM
2634 ID_SIGSH(I) = ID_ELEM
2635 SIGSH(2,I) = 0
2636 SIGSH(3,I) = THK
2637 ENDIF ! IF (IE == 0)
2638 ENDDO ! DO J=1,NB_ELEMENTS
2639
2640 CASE ( 'epsp' )
2641
2642!
2643 CALL HM_GET_INTV('no_blocks',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
2644!
2645 DO J=1,NB_ELEMENTS
2646 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
2647 CALL HM_GET_FLOAT_ARRAY_INDEX('ep' ,EPSP,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2648!
2649!
2650! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH4NM,NUMELC)
2651! IE = MAP_TABLES%ISH4NM(ELT,2)
2652!
2653 IE=UEL2SYS(ID_ELEM,KSYSUSR,NUMELC)
2654!
2655 IF (IE == 0) THEN
2656 ! Shell was not found. Issue a Warning & Skip.
2657 NONEXIST = NONEXIST+1
2658 ELSE
2659 I = PTSHEL(IE)
2660 SIGSH(1,I) = ID_ELEM
2661 ID_SIGSH(I) = ID_ELEM
2662 SIGSH(2,I) = 0
2663 SIGSH(27,I)= EPSP
2664 ENDIF ! IF (IE == 0) THEN
2665 ENDDO ! DO J=1,NB_ELEMENTS
2666!-------------------
2667 CASE ( 'ortho' )
2668
2669 CALL hm_get_intv(
'inishe_ortho_count',nb_elements,is_available,lsubmodel)
2670
2671 DO j=1,nb_elements
2674
2678
2679
2680
2681
2682 ie=
uel2sys(id_elem,ksysusr,numelc)
2683
2684 IF (ie == 0) THEN
2685
2686 nonexist = nonexist+1
2687 ELSE
2688
2689 ig = ixc(6,ie)
2690 ihbe = igeo(10,ig)
2691 igtyp=igeo(11,ig)
2692 iortshel = 1
2693 i = ptshel(ie)
2694 pt = nvshell + nushell
2695 sigsh(1,i) = id_elem
2696 id_sigsh(i) = id_elem
2697 IF ( igtyp == 9) nip = nint(geo(npropg*(ig-1)+6))
2698 sigsh(pt + 4 ,i) = nip
2699 sigsh(pt + 5 ,i) = one
2700 IF( ihbe==12 .OR. ihbe==24) THEN
2701 sigsh(nvshell,i) = 4
2702 ELSE
2703 sigsh(nvshell,i) = 1
2704 ENDIF
2705 sigsh(pt+1,i) = vx
2706 sigsh(pt+2,i) = vy
2707 sigsh(pt+3,i) = vz
2708 pt = pt + 5
2709 IF ( igtyp == 9 ) THEN
2712 sigsh(pt+1,i) = phi1*pi/hundred80
2713 sigsh(pt+2,i) = phi2*pi/hundred80
2714 pt = pt + 2
2715 ELSEIF (igtyp == 1 ) THEN
2717 . msgtype=msgerror,
2718 . anmode=aninfo,
2719 . c1='/INISHE/ORTHO',
2720 . c2='SHELL',
2721 . i2=id_elem,i1=igeo(1,ig))
2722 ELSE
2723 SIZE = nip
2726 DO jj = 1,nip
2727 sigsh(pt+1,i) = tmpval1(jj)*pi/hundred80
2728 sigsh(pt+2,i) = tmpval2(jj)*pi/hundred80
2729 pt = pt + 2
2730 ENDDO
2731 ENDIF
2732 ENDIF
2733 ENDDO
2734
2735 CASE ( 'ORTH_LOC' )
2736
2737 CALL hm_get_intv(
'inishe_orth_loc_count',nb_elements,is_available,lsubmodel)
2738
2739 DO j=1,nb_elements
2745
2746
2747
2748
2749
2750 ie=
uel2sys(id_elem,ksysusr,numelc)
2751
2752 IF (ie == 0) THEN
2753
2754 nonexist = nonexist+1
2755 ELSE
2756
2757 ig = ixc(6,ie)
2758 ihbe = igeo(10,ig)
2759 igtyp = igeo(11,ig)
2760 iortshel = 2
2761 i = ptshel(ie)
2762 pt = nvshell + nushell
2763 id_sigsh(i) = id_elem
2764 sigsh(1,i) = id_elem
2765 IF (igtyp == 9) nip = nint(geo(npropg*(ig-1)+6))
2766 sigsh(pt + 4,i) = nip
2767 sigsh(pt + 5,i) = one
2768 IF( ihbe==12 .OR. ihbe==24) THEN
2769 sigsh(nvshell,i) = 4
2770 ELSE
2771 sigsh(nvshell,i) = 1
2772 ENDIF
2773
2774 pt = pt + 5
2775 IF (igtyp == 51 .OR. igtyp == 52) THEN
2776 isubstack = iworksh(3, ie)
2777 nlay = stack%IGEO(1,isubstack)
2778 ipmat = 2 + nlay
2779 IF (ndir /= 2) THEN
2780 DO jj = 1,nlay
2781 mlawly= stack%IGEO(ipmat + jj,isubstack)
2782 IF (mlawly == 58) THEN
2784 . msgtype=msgerror,
2785 . anmode=aninfo,
2786 . c1='SHELL',
2787 . i1=id_elem)
2788 ENDIF
2789 ENDDO
2790 ENDIF
2791 ENDIF
2792
2793 SIZE = nip
2796
2797 ALLOCATE(mlaw_ly(nip))
2798 mlaw_ly = 0
2799 IF (igtyp == 9) THEN
2800 angle1 = tmpval1(1)
2801 IF(flagdeg == 1) angle1 = angle1*pi/hundred80
2802 sigsh(pt+1,i) = cos(angle1)
2803 sigsh(pt+2,i) = sin(angle1)
2804 pt = pt + 2
2805 ELSEIF (igtyp == 10 .OR. igtyp == 11 .OR. igtyp == 16 .OR.
2806 . igtyp == 17 .OR. igtyp == 51 .OR. igtyp == 52) THEN
2807 IF (igtyp == 51 .OR. igtyp == 52)THEN
2808 isubstack = iworksh(3, ie)
2809 nlay = stack%IGEO(1,isubstack)
2810 ipmat = 2 + nlay
2811 ipnpt_lay = ipmat + 2*nlay
2812 IF(nlay /= nip) THEN
2813 IF(ndrape > 0) THEN
2814 ipt = 0
2815 DO jj =1,nlay
2816 nslice = stack%IGEO(ipnpt_lay + jj,isubstack)
2817 DO n = 1, nslice
2818 ipt = ipt + 1
2819 mlaw_ly(ipt)= stack%IGEO(ipmat + jj,isubstack)
2820 ENDDO
2821 ENDDO
2822 ELSE
2823
2824 ENDIF
2825 ELSE
2826 DO jj =1,nlay
2827 mlaw_ly(jj)= stack%IGEO(ipmat + jj,isubstack)
2828 ENDDO
2829 ENDIF
2830 ENDIF
2831 DO jj = 1,nip
2832 angle1 = tmpval1(jj)
2833 angle2 = tmpval2(jj)
2834 IF(flagdeg == 1) angle1 = angle1*pi/hundred80
2835 IF(flagdeg == 1) angle2 = angle2*pi/hundred80
2836
2837 IF (igtyp == 16 .OR.
2838 . (igtyp == 51 .AND. mlaw_ly(jj) == 58) .OR.
2839 . (igtyp == 52 .AND. mlaw_ly(jj) == 58) ) THEN
2840
2841 angle2 = angle2 + angle1
2842 sigsh(pt+1,i) = cos(angle1)
2843 sigsh(pt+2,i) = sin(angle1)
2844 sigsh(pt+3,i) = cos(angle2)
2845 sigsh(pt+4,i) = sin(angle2)
2846 pt = pt + 4
2847 ELSE
2848 sigsh(pt+1,i) = cos(angle1)
2849 sigsh(pt+2,i) = sin(angle1)
2850 pt = pt + 2
2851 ENDIF
2852 ENDDO
2853 ELSEIF (igtyp == 1) THEN
2855 . msgtype=msgerror,
2856 . anmode=aninfo,
2857 . c1='/INISHE/ORTH_LOC',
2858 . c2='SHELL',
2859 . i2=id_elem,i1=igeo(1,ig))
2860 ENDIF
2861 IF(ALLOCATED(mlaw_ly))DEALLOCATE(mlaw_ly)
2862 ENDIF
2863 ENDDO
2864
2865 CASE ( 'SCALE_YLD' )
2866
2867 CALL hm_get_intv(
'inishe_scale_yld_count',nb_elements,is_available,lsubmodel)
2868 iyldini = 1
2869
2870 DO j=1,nb_elements
2874
2875
2876
2877
2878 ie=
uel2sys(id_elem,ksysusr,numelc)
2879
2880 IF (ie == 0) THEN
2881
2882 nonexist = nonexist+1
2883 ELSE
2884 i = ptshel(ie)
2885 sigsh(nvshell + 1,i) = id_elem
2886 id_sigsh(i) = id_elem
2887 sigsh(nvshell + 2,i) = nip
2888 sigsh(nvshell + 3,i) = npg
2889
2890 SIZE = npg*nip
2891 pt = nvshell+nushell+nortshel+nvshell1+3
2892
2894
2895 DO n = 1,npg
2896 DO ip = 1,nip
2897 l = (n-1)*nip+ip
2898
2899 scaleyld = tmpval1(l)
2900 sigsh(pt+l,i) = scaleyld
2901 ENDDO
2902 ENDDO
2903 pt = pt + nip * npg
2904
2905 ENDIF
2906 ENDDO
2907
2908 CASE ( 'AUX' )
2909
2910 CALL hm_get_intv(
'inishe_aux_count',nb_elements,is_available,lsubmodel)
2911 DO j=1,nb_elements
2916
2917
2918
2919
2920
2921 ie=
uel2sys(id_elem,ksysusr,numelc)
2922
2923 IF (ie == 0) THEN
2924
2925 nonexist = nonexist+1
2926 ELSE
2927
2928 imat = ixc(1,ie)
2929 ilaw = ipm(2,imat)
2930 nuvard00 = ipm(8,imat)
2931 IF (nuvard00 > nuvar) THEN
2933 . msgtype=msgwarning,
2934 . anmode=aninfo,
2935 . i1=itri(ie),
2936 . c1='NUMBER OF USER VARIABLES',
2937 . c2='MATERIAL LAW ',
2938 . i2=ipm(1,imat),
2939 . c3='/INISHE/AUX')
2940 ENDIF
2941 IF ((ilaw == 36 .and. (nuvar < 4 .or. nuvard00 > 3) .and.
2942 . nuvard00 < nuvar) .or.
2943 . (ilaw /= 36 .and. ilaw /= 78 .and. ilaw /= 87 .and. ilaw /= 112 .and. nuvard00 < nuvar)) THEN
2945
2946 . anmode=aninfo,
2947 . i1=itri(ie),
2948 . c1='NUMBER OF USER VARIABLES',
2949 . c2='MATERIAL LAW ',
2950 . i2=ipm(1,imat),
2951 . c3='/INISHE/AUX')
2952 ENDIF
2953
2954 i = ptshel(ie)
2955 iuser = 1
2956 nvarsh = nvshell + 4
2957 IF (nip == 0) nip = 1
2958 IF (npg == 0) npg = 1
2959 sigsh(1,i) = id_elem
2960 id_sigsh(i) = id_elem
2961 sigsh(2,i) = nip
2962 sigsh(nvshell,i) = npg
2963
2964 ig = ixc(6,ie)
2965 ihbe = igeo(10,ig)
2966 IF (ihbe==24) sigsh(nvshell,i) = 4
2967
2968 sigsh(nvshell + 2 ,i) = nip
2969 sigsh(nvshell + 3 ,i) = npg
2970 sigsh(nvshell + 4 ,i) = nuvar
2971 pt = 0
2972
2974 nmax_aux = num_lines*nuvar
2976
2977 DO jj=1,num_lines
2978 DO k=1,nuvar
2979 l = nuvar*(jj-1) + k
2980 sigsh(nvarsh+pt+k,i) = tmpval(l)
2981 ENDDO
2982 pt = pt + nuvar
2983 ENDDO
2984
2985 ENDIF
2986 ENDDO
2987
2988 CASE ( 'FAIL' )
2989
2990 CALL hm_get_intv(
'inishe_fail_count',nb_elements,is_available,lsubmodel)
2991 DO j=1,nb_elements
3002
3003
3004
3005
3006 ie=
uel2sys(id_elem,ksysusr,numelc)
3007
3008 IF (ie == 0) THEN
3009
3010
3011 nonexist = nonexist+1
3012 ELSE
3013
3016 npt_max =
max(nptt,nlay)
3017 nvmax = nvshell1 /(
max(1,npg)*npt_max*5)
3018 IF (id_elem /= nem1) i = ptshel(ie)
3019 nem1 = id_elem
3020 iok = 0
3021
3022 DO k=1,nummat
3023 IF (ipm(1,k) == imat) THEN
3024 imat = k
3025 iok = 1
3026 EXIT
3027 ENDIF
3028 ENDDO
3029 IF (iok == 0) THEN
3031 . msgtype=msgerror,
3032 . anmode=aninfo,
3033 . i1=itri(ie),
3034 . c1='MATERIAL LAW',
3035 . c2='/INISHE/FAIL')
3036 ENDIF
3037
3038 ig = ixc(6,ie)
3039 ihbe = igeo(10,ig)
3040 igtyp=igeo(11,ig)
3041 sigsh(1,i) = id_elem
3042 id_sigsh(i) = id_elem
3043 IF ( igtyp == 9 ) nlay = nint(geo(npropg*(ig-1)+6))
3044 IF ( igtyp == 10 .OR. igtyp == 11) THEN
3045 sigsh(2,i) = nlay
3046 ELSE
3047 sigsh(2,i) = nptt*nlay
3048 ENDIF
3049 IF (ihbe==12 .OR. ihbe==24) THEN
3050 sigsh(nvshell,i) = 4
3051 ELSE
3052 sigsh(nvshell,i) = 1
3053 ENDIF
3054
3055
3056 iok = 0
3057 DO k=1,5
3058 nfail(k) = mat_param(imat)%FAIL(k)%FAIL_ID
3059 IF (ifail == nfail(k) .AND.
3060 . irupt_typ == mat_param(imat)%FAIL(k)%IRUPT) THEN
3061 ifail = k
3062 fail_ini(ifail)=1
3063 iok = 1
3064 EXIT
3065 ENDIF
3066 ENDDO
3067 IF (iok == 0) THEN
3069 . msgtype=msgerror,
3070 . anmode=aninfo,
3071 . i1=itri(ie),
3072 . c1='FAILURE CRITERIA',
3073 . c2='/INISHE/FAIL')
3074 ENDIF
3075
3076 pt = nvshell+nushell+3+nortshel
3080
3081 nmax_fail = num_lines*nvar_rupt
3083
3084 DO jj=1,num_lines
3085 DO k=1,nvar_rupt
3086 l = nvar_rupt*(jj-1) + k
3087 sigsh(pt+l+(ifail-1)*npt_max*npg*nvmax+
3088 . (ilay-1)*nvmax*npg*nptt,i) = tmpval(l)
3089 ENDDO
3090 ENDDO
3091
3092 ENDIF
3093 ENDDO
3094
3095 CASE DEFAULT
3096
3097 END SELECT
3098
3099 ENDDO
3100
3101 ENDIF
3102
3103 nishell = i
3104
3105
3106
3107
3108
3109
3110 i=numshel
3111
3113
3114 IF ( nb_inish3 > 0 ) THEN
3115
3116
3118
3119
3120 IF (ktrieltg==0) THEN
3121
3122 DO ie = 1, numeltg
3123 itri(ie) = ixtg(nixtg,ie)
3124 END DO
3125 CALL my_orders(0,work,itri,index,numeltg,1)
3126 DO j = 1, numeltg
3127 ie=index(j)
3128 ksysusrtg(j) =ixtg(nixtg,ie)
3129 ksysusrtg(numeltg+j)=ie
3130 END DO
3131 ktrieltg=1
3132 END IF
3133
3134 DO ini=1,nb_inish3
3135
3137 . unit_id = uid,
3138 . submodel_index = sub_index,
3139 . submodel_id = sub_id,
3140 . keyword2 = key,
3141 . keyword3 = key2)
3142
3143 IF (key2 /= ' ') glob = .true.
3144
3145
3146
3147 DO iunit=1,unitab%NUNITS
3148 IF (unitab%UNIT_ID(iunit) == uid) THEN
3149 iflagunit = 1
3150 EXIT
3151 ENDIF
3152 ENDDO
3153
3154 IF (uid /= 0.AND.iflagunit == 0) THEN
3155 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
3156 . i2=uid, i1=sub_id, c1='INISH3',
3157 . c2='INISH3',
3158 . c3=' ')
3159 ENDIF
3160
3161 SELECT CASE (key(1:len_trim(key)))
3162
3163 CASE ( 'EPSP_F' )
3164 isigsh =1
3165
3166
3167 CALL hm_get_intv(
'inish3_epsp_f_count',nb_elements,is_available,lsubmodel)
3168
3169 DO j=1,nb_elements
3170
3175
3176
3177
3178
3179 ie =
uel2sys(id_elem,ksysusrtg,numeltg)
3180
3181 IF (ie == 0) THEN
3182
3183 nonexist = nonexist+1
3184 ELSE
3185
3186 i = numshel + ptsh3n(ie)
3187
3188 id_sigsh(i) = id_elem
3189 sigsh(1,i) = id_elem
3190 sigsh(2,i) = nip
3191 sigsh(3,i) = thk
3192 sigsh(nvshell - 1,i) = one
3193
3194 IF (npg <= 1) THEN
3195!---
3196
3197 SIZE = nip*
max(npg,1)
3199
3200 pt=22
3202 k0 = 0
3203 DO WHILE(jj > 0)
3205 DO k=1,l
3206 sigsh(pt+(k-1)*6+5,i) = tmpval(k+k0)
3207 ENDDO
3208
3209 k0=k0+5
3210 pt=pt+30
3211 jj=jj-5
3212 END DO
3213
3214 ELSEIF (npg > 1) THEN
3215 sigsh(nvshell,i) = npg
3216
3217 IF (nip == 0) THEN
3218
3219 SIZE = npg
3221
3222 pt=22
3223 DO k=1,npg
3224 sigsh(pt+(k-1)*9+5,i) = tmpval(k
3225 ENDDO
3226 ELSE
3227
3228 SIZE = nip*npg
3230
3231 pt=22
3232 jj=nip*npg
3233 k0 = 0
3234 DO WHILE(jj > 0)
3236 DO k=1,l
3237 sigsh(pt+(k-1)*6+5,i) = tmpval(k+k0)
3238 ENDDO
3239
3240 k0=k0+5
3241 pt=pt+30
3242 jj=jj-5
3243 END DO
3244
3245 END IF
3246 END IF
3247 ENDIF
3248
3249 ENDDO
3250
3251 CASE ( 'STRS_F' )
3252
3253 isigsh =1
3254
3255
3256
3257
3258
3259 IF (glob ) THEN
3260 CALL hm_get_intv(
'inish3_strs_f_glob_count',nb_elements,is_available,lsubmodel)
3261
3262 DO j=1,nb_elements
3263
3268
3269
3270
3271
3272 ie=
uel2sys(id_elem,ksysusrtg,numeltg)
3273
3274 IF (ie == 0) THEN
3275
3276 nonexist = nonexist+1
3277 ELSE
3278
3279
3282
3283 i = numshel + ptsh3n(ie)
3284
3285 sigsh(1,i) = id_elem
3286 id_sigsh(i) = id_elem
3287 sigsh(2,i) = nip
3288 sigsh(3,i) = thk
3289 sigsh(4,i) = em
3290 sigsh(5,i) = eb
3291 sigsh(14,i) = zero
3292 sigsh(15,i) = zero
3293 sigsh(16,i) = zero
3294 sigsh(17,i) = one
3295 sigsh(nvshell - 1,i) = one
3296
3297 IF (npg == 0 .OR. npg == 1) THEN
3298
3299 IF (nip == 0) THEN
3300
3304
3308
3309
3313
3318
3319 ELSEIF (nip /= 0) THEN
3320
3321
3322
3323 SIZE = nip
3332
3333
3334 inishvar = 22 + nip*6
3335 DO n=1,nip
3336 pt = 22 + (n-1)*6
3337
3338 sigsh(pt,i) = tmpval1(n)
3339 sigsh(pt + 1,i) = tmpval2(n)
3340 sigsh(inishvar + n,i) = tmpval3(n)
3341 sigsh(pt + 2,i) = tmpval4(n)
3342 sigsh(pt + 3,i) = tmpval5(n)
3343 sigsh(pt + 4,i) = tmpval6(n)
3344 sigsh(pt + 5,i) = tmpval7(n)
3345 sigsh(inishvar+nip+n,i) = tmpval8(n)
3346 ENDDO
3347 ENDIF
3348
3349 ELSEIF (npg > 1) THEN
3350
3351 sigsh(nvshell,i) = npg
3352
3353 IF (nip == 0) THEN
3354
3355 SIZE = npg
3369
3370 DO k=1,npg
3371 pt= 22 + (k-1)*13
3372
3373 sigsh(pt ,i) = tmpval1(k)
3374 sigsh(pt+1,i) = tmpval2(k)
3375 sigsh(pt+2,i) = tmpval3(k)
3376 sigsh(pt+3,i) = tmpval4(k)
3377 sigsh(pt+4,i) = tmpval5(k)
3378 sigsh(pt+5,i) = tmpval6(k)
3379 sigsh(pt+6,i) = tmpval7(k)
3380 sigsh(pt+7,i) = tmpval8(k)
3381 sigsh(pt+8,i) = tmpval9(k)
3382 sigsh(pt+9,i) = tmpval10(k)
3383 sigsh(pt+10,i) = tmpval11(k)
3384
3385 sigsh(pt+12,i) = tmpval13(k)
3386
3387
3388 ENDDO
3389
3390 ELSE
3391
3392 SIZE = nip*npg
3401
3402
3403 pt = 22
3404 DO n=1,nip
3405 DO k=1,npg
3406 l = (n-1)*npg+k
3407
3408 sigsh(pt ,i) = tmpval1(l)
3409 sigsh(pt+1,i) = tmpval2(l)
3410 sigsh(pt+2,i) = tmpval3(l)
3411 sigsh(pt+3,i) = tmpval4(l)
3412 sigsh(pt+4,i) = tmpval5(l)
3413 sigsh(pt+5,i) = tmpval6(l)
3414 sigsh(pt+6,i) = tmpval7(l)
3415 sigsh(pt+7,i) = tmpval8(l)
3416 pt = pt + 8
3417 ENDDO
3418 ENDDO
3419 ENDIF
3420
3421 ENDIF
3422
3423 ENDIF
3424 ENDDO
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434 ELSEIF ( .NOT. glob ) THEN
3435
3436 CALL hm_get_intv(
'inish3_strs_f_count',nb_elements,is_available,lsubmodel)
3437
3438 DO j=1,nb_elements
3439
3444
3445
3446
3447
3448 ie=
uel2sys(id_elem,ksysusrtg,numeltg)
3449
3450 IF (ie == 0) THEN
3451
3452 nonexist = nonexist+1
3453 ELSE
3454
3455
3458
3459 i = numshel + ptsh3n(ie)
3460
3461 sigsh(1,i) = id_elem
3462 id_sigsh(i) = id_elem
3463 sigsh(2,i) = nip
3464 sigsh(3,i) = thk
3465 sigsh(4,i) = em
3466 sigsh(5,i) = eb
3467 sigsh(14,i) = zero
3468 sigsh(15,i) = zero
3469 sigsh(16,i) = zero
3470 sigsh(17,i) = zero
3471 sigsh(nvshell - 1,i) = one
3472
3473 IF (npg == 0 .OR. npg == 1) THEN
3474
3475 IF (nip == 0) THEN
3476
3482
3483
3488
3489 ELSEIF (nip /= 0) THEN
3490
3491!
3492
3493
3494 SIZE = nip
3501
3502
3503 inishvar = 22 + nip*6
3504 DO n=1,nip
3505 pt = 22 + (n-1)*6
3506
3507 sigsh(pt ,i) = tmpval1(n)
3508 sigsh(pt + 1,i) = tmpval2(n)
3509 sigsh(pt + 2,i) = tmpval3(n)
3510 sigsh(pt + 3,i) = tmpval4(n)
3511 sigsh(pt + 4,i) = tmpval5(n)
3512 sigsh(pt + 5,i) = tmpval6(n)
3513 ENDDO
3514 ENDIF
3515
3516 ELSEIF (npg > 1) THEN
3517
3518 sigsh(nvshell,i) = npg
3519
3520 IF (nip == 0) THEN
3521
3522 SIZE = npg
3532
3533 DO k=1,npg
3534 pt= 22 + (k-1)*9
3535
3536 sigsh(pt ,i) = tmpval1(k)
3537 sigsh(pt+1,i) = tmpval2(k)
3538 sigsh(pt+2,i) = tmpval3(k)
3539 sigsh(pt+3,i) = tmpval4(k)
3540 sigsh(pt+4,i) = tmpval5(k)
3541 sigsh(pt+5,i) = tmpval6(k)
3542 sigsh(pt+6,i) = tmpval7(k)
3543 sigsh(pt+7,i) = tmpval8(k)
3544 sigsh(pt+8,i) = tmpval9(k)
3545 ENDDO
3546
3547 ELSE
3548
3549 SIZE = nip*npg
3556!
3557 pt = 22
3558 DO n=1,nip
3559 DO k=1,npg
3560 l = (n-1)*npg+k
3561
3562 sigsh(pt ,i) = tmpval1(l)
3563 sigsh(pt+1,i) = tmpval2(l)
3564 sigsh(pt+2,i) = tmpval3(l)
3565 sigsh(pt+3,i) = tmpval4(l)
3566 sigsh(pt+4,i) = tmpval5(l)
3567 sigsh(pt+5,i) = tmpval6(l)
3568
3569 pt = pt + 6
3570 ENDDO
3571 ENDDO
3572 ENDIF
3573
3574 ENDIF
3575
3576 ENDIF
3577 ENDDO
3578
3579 ENDIF
3580
3581
3582 CASE ( 'STRA_F' )
3583
3584 ithkshel =2
3585
3586 IF ( glob ) THEN
3587 CALL hm_get_intv(
'inish3_stra_f_glob_count',nb_elements,is_available,lsubmodel)
3588
3589 DO j=1,nb_elements
3590
3595
3596
3597
3598
3599 ie=
uel2sys(id_elem,ksysusrtg,numeltg)
3600
3601 IF (ie == 0) THEN
3602
3603 nonexist = nonexist+1
3604 ELSE
3605 i = numshel + ptsh3n(ie)
3606 sigsh(1,i) = id_elem
3607 id_sigsh(i) = id_elem
3608 sigsh(2,i) = nip
3609 sigsh(3,i) = thk
3610 sigsh(17,i) = one
3611 sigsh(nvshell,i) =
max(1,npg)
3612 sigsh(nvshell - 1,i) = one
3613
3614 pt = inishvar1
3615 npp = nip
3616 IF (npp==0) npp=2
3617
3618 SIZE = npp*npg
3626
3629 l = (n-1)*
max(1,npg)+ipg
3630 sigsh(pt ,i) = tmpval1(l)
3631 sigsh(pt+1,i) = tmpval2(l)
3632 sigsh(pt+2,i) = tmpval3(l)
3633 sigsh(pt+3,i) = tmpval4(l)
3634 sigsh(pt+4,i) = tmpval5(l)
3635 sigsh(pt+5,i) = tmpval6(l)
3636 sigsh(pt+6,i) = tmpval7(l)
3637 pt=pt+7
3638 ENDDO
3639 ENDDO
3640
3641 ENDIF
3642 ENDDO
3643
3644 ELSEIF ( .NOT. glob ) THEN
3645
3646
3647 CALL hm_get_intv(
'inish3_stra_f_count',nb_elements,is_available,lsubmodel)
3648
3649 DO j=1,nb_elements
3650
3655
3656
3657
3658
3659 ie=
uel2sys(id_elem,ksysusrtg,numeltg)
3660
3661 IF (ie == 0) THEN
3662
3663 nonexist = nonexist+1
3664 ELSE
3665 i = numshel + ptsh3n(ie)
3666 sigsh(1,i) = id_elem
3667 id_sigsh(i) = id_elem
3668 sigsh(3,i) = thk
3669 sigsh(nvshell - 1,i) = one
3670
3671 IF (npg == 0 .OR. npg == 1) THEN
3672
3681
3682 ELSEIF (npg>1 ) THEN
3683
3684 sigsh(nvshell,i) = npg
3685
3686 sigsh(6,i) =zero
3687 sigsh(7,i) =zero
3688 sigsh(8,i) =zero
3689 sigsh(9,i) =zero
3690 sigsh(10,i)=zero
3691 sigsh(11,i)=zero
3692 sigsh(12,i)=zero
3693 sigsh(13,i)=zero
3694
3695 SIZE = npg
3704
3705 DO ipg=1,npg
3706 sigsh(6,i) =sigsh(6,i) +tmpval1(ipg)/npg
3707 sigsh(7,i) =sigsh(7,i) +tmpval2(ipg)/npg
3708 sigsh(8,i) =sigsh(8,i) +tmpval3(ipg)/npg
3709 sigsh(9,i) =sigsh(9,i) +tmpval4(ipg)/npg
3710 sigsh(10,i)=sigsh(10,i)+tmpval5(ipg)/npg
3711 sigsh(11,i)=sigsh(11,i)+tmpval6(ipg)/npg
3712 sigsh(12,i)=sigsh(12,i)+tmpval7(ipg)/npg
3713 sigsh(13,i)=sigsh(13,i)+tmpval8(ipg)/npg
3714 END DO
3715 ELSE
3716
3717 ENDIF
3718 ENDIF
3719 ENDDO
3720 ENDIF
3721
3722 CASE ( 'THICK' )
3723
3724 ithkshel = 1
3725
3726 CALL hm_get_intv(
'no_elems',nb_elements,is_available,lsubmodel)
3727
3728 DO j=1,nb_elements
3731
3732
3733
3734
3735
3736 ie=
uel2sys(id_elem,ksysusrtg,numeltg)
3737
3738 IF (ie == 0) THEN
3739
3740 nonexist = nonexist+1
3741 ELSE
3742 i = numshel + ptsh3n(ie)
3743 sigsh(1,i) = id_elem
3744 id_sigsh(i) = id_elem
3745 sigsh(2,i) = 0
3746 sigsh(3,i) = thk
3747 ENDIF
3748 ENDDO
3749
3750 CASE ( 'EPSP' )
3751
3752
3753 CALL hm_get_intv(
'no_blocks',nb_elements,is_available,lsubmodel)
3754
3755 DO j=1,nb_elements
3758
3759
3760
3761
3762 ie=
uel2sys(id_elem,ksysusrtg,numeltg)
3763
3764 IF (ie == 0) THEN
3765
3766 nonexist = nonexist+1
3767 ELSE
3768 i = numshel + ptsh3n(ie)
3769 sigsh(1,i) = id_elem
3770 id_sigsh(i) = id_elem
3771 sigsh(2,i) = 0
3772 sigsh(27,i)= epsp
3773 ENDIF
3774 ENDDO
3775
3776 CASE ( 'ORTHO' )
3777
3778 CALL hm_get_intv(
'inish3_ortho_count',nb_elements,is_available,lsubmodel)
3779
3780 DO j=1,nb_elements
3783
3787
3788
3789
3790
3791 ie=
uel2sys(id_elem,ksysusrtg,numeltg)
3792
3793 IF (ie == 0) THEN
3794
3795 nonexist = nonexist+1
3796 ELSE
3797
3798 ig = ixtg(5,ie)
3799 ish3n = igeo(18,ig)
3800 igtyp=igeo(11,ig)
3801 iortshel = 1
3802 i = numshel + ptsh3n(ie)
3803 pt = nvshell+nushell
3804
3805 id_sigsh(i) = id_elem
3806 IF ( igtyp == 9) nip = nint(geo(npropg*(ig-1)+6))
3807 sigsh(pt + 4,i) = nip
3808 IF( ish3n == 30 ) THEN
3809 sigsh(nvshell,i) = 3
3810 ELSE
3811 sigsh(nvshell,i) = 1
3812 ENDIF
3813 sigsh(pt+1,i) = vx
3814 sigsh(pt+2,i) = vy
3815 sigsh(pt+3,i) = vz
3816 pt = pt+4
3817 IF ( igtyp == 9 ) THEN
3820 sigsh(pt+1,i) = phi1*pi/hundred80
3821 sigsh(pt+2,i) = phi2*pi/hundred80
3822 pt = pt + 2
3823 ELSEIF (igtyp == 1 ) THEN
3825 . msgtype=msgerror,
3826 . anmode=aninfo,
3827 . c1='/INISH3/ORTHO',
3828 . c2='SH3N',
3829 . i2=id_elem,i1=igeo(1,ig))
3830 ELSE
3831 SIZE = nip
3834 DO jj = 1,nip
3835 sigsh(pt+1,i) = tmpval1(jj)*pi/hundred80
3836 sigsh(pt+2,i) = tmpval2(jj)*pi/hundred80
3837 pt = pt + 2
3838 ENDDO
3839 ENDIF
3840 ENDIF
3841 ENDDO
3842
3843 CASE ( 'ORTH_LOC' )
3844
3845 CALL hm_get_intv(
'inish3_orth_loc_count',nb_elements,is_available,lsubmodel)
3846
3847 DO j=1,nb_elements
3853
3854
3855
3856
3857
3858 ie=
uel2sys(id_elem,ksysusrtg,numeltg)
3859
3860 IF (ie == 0) THEN
3861
3862 nonexist = nonexist+1
3863 ELSE
3864
3865 ig = ixtg(5,ie)
3866 ish3n = igeo(18,ig)
3867 igtyp = igeo(11,ig)
3868 iortshel = 2
3869 i = numshel + ptsh3n(ie)
3870 pt = nvshell + nushell
3871 sigsh(1,i) = id_elem
3872 id_sigsh(i) = id_elem
3873 IF (igtyp == 9) nip = nint(geo(npropg*(ig-1)+6))
3874 sigsh(pt + 4 ,i) = nip
3875 sigsh(pt + 5,i) = one
3876 IF (ish3n == 30) THEN
3877 sigsh(nvshell,i) = 3
3878 ELSE
3879 sigsh(nvshell,i) = 1
3880 ENDIF
3881 pt = pt + 5
3882
3883 IF (igtyp == 51 .OR. igtyp == 52) THEN
3884 isubstack = iworksh(3, numelc + ie)
3885 nlay = stack%IGEO(1,isubstack)
3886 ipmat = 2 + nlay
3887 IF (ndir /= 2) THEN
3888 DO jj = 1,nlay
3889 mlawly= stack%IGEO(ipmat + jj,isubstack)
3890 IF (mlawly == 58) THEN
3892 . msgtype=msgerror,
3893 . anmode=aninfo,
3894 . c1='SH3N',
3895 . i1=id_elem)
3896 ENDIF
3897 ENDDO
3898 ENDIF
3899 ENDIF
3900
3901 ALLOCATE(mlaw_ly(nip))
3902 mlaw_ly = 0
3903 SIZE = nip
3906
3907 IF (igtyp == 9) THEN
3908 angle1 = tmpval1(1)
3909 IF(flagdeg == 1) angle1 = angle1*pi/hundred80
3910 sigsh(pt+1,i) = cos(angle1)
3911 sigsh(pt+2,i) = sin(angle1)
3912 pt = pt + 2
3913 ELSEIF (igtyp == 10 .OR. igtyp == 11 .OR. igtyp == 16 .OR.
3914 . igtyp == 17 .OR. igtyp == 51 .OR. igtyp == 52) THEN
3915 IF (igtyp == 51 .OR. igtyp == 52)THEN
3916 isubstack = iworksh(3, numelc + ie)
3917 nlay = stack%IGEO(1,isubstack)
3918 ipmat = 2 + nlay
3919 ipnpt_lay = ipmat + 2*nlay
3920 IF(nlay /= nip) THEN
3921 IF(ndrape > 0) THEN
3922 ipt = 0
3923 DO jj =1,nlay
3924 nslice = stack%IGEO(ipnpt_lay + jj,isubstack)
3925 DO n = 1, nslice
3926 ipt = ipt + 1
3927 mlaw_ly(ipt)= stack%IGEO(ipmat + jj,isubstack)
3928 ENDDO
3929 ENDDO
3930 ELSE
3931
3932 ENDIF
3933 ELSE
3934 DO jj =1,nlay
3935 mlaw_ly(jj)= stack%IGEO(ipmat + jj,isubstack)
3936 ENDDO
3937 ENDIF
3938 ENDIF
3939 DO jj = 1,nip
3940 angle1 = tmpval1(jj)
3941 angle2 = tmpval2(jj)
3942 IF(flagdeg == 1) angle1 = angle1*pi/hundred80
3943 IF(flagdeg == 1) angle2 = angle2*pi/hundred80
3944
3945 IF (igtyp == 16 .OR.
3946 . (igtyp == 51 .AND. mlaw_ly(jj) == 58) .OR.
3947 . (igtyp == 52 .AND. mlaw_ly(jj) == 58) ) THEN
3948
3949 angle2 = angle2 + angle1
3950 sigsh(pt+1,i) = cos(angle1)
3951 sigsh(pt+2,i) = sin(angle1)
3952 sigsh(pt+3,i) = cos(angle2)
3953 sigsh(pt+4,i) = sin(angle2)
3954 pt = pt + 4
3955 ELSE
3956 angle1 = tmpval1(jj)
3957 angle1 = angle1*pi/hundred80
3958 sigsh(pt+1,i) = cos(angle1)
3959 sigsh(pt+2,i) = sin(angle1)
3960 pt = pt + 2
3961 ENDIF
3962 ENDDO
3963 ELSEIF (igtyp == 1) THEN
3965 . msgtype=msgerror,
3966 . anmode=aninfo,
3967 . c1='/INISH3/ORTH_LOC',
3968 . c2='3 NODES SHELL',
3969 . i2=id_elem,i1=igeo(1,ig))
3970 ENDIF ! IF (igtyp == 9)
3971 IF(ALLOCATED(mlaw_ly))DEALLOCATE(mlaw_ly)
3972 ENDIF
3973 ENDDO
3974
3975 CASE ( 'SCALE_YLD' )
3976
3977 CALL hm_get_intv(
'inish3_scale_yld_count',nb_elements
3978 iyldini = 1
3979
3980 DO j=1,nb_elements
3982 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NIP,J,IS_AVAILABLE,LSUBMODEL)
3983 CALL HM_GET_INT_ARRAY_INDEX('npg',NPG,J,IS_AVAILABLE,LSUBMODEL)
3984!
3985! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH3NM,NUMELTG)
3986! IE = MAP_TABLES%ISH3NM(ELT,2)
3987!
3988 IE=UEL2SYS(ID_ELEM,KSYSUSRTG,NUMELTG)
3989!
3990 IF (IE == 0) THEN
3991 ! Shell was not found. Issue a Warning & Skip.
3992 NONEXIST = NONEXIST+1
3993 ELSE
3994 I = NUMSHEL + PTSH3N(IE)
3995 SIGSH(NVSHELL + 1,I) = ID_ELEM ! elt ID
3996 ID_SIGSH(I) = ID_ELEM
3997 SIGSH(NVSHELL + 2,I) = NIP ! integ point
3998 SIGSH(NVSHELL + 3,I) = NPG
3999!
4000 SIZE = NPG*NIP
4001 CALL HM_GET_FLOAT_ARRAY('alpha_ij' ,TMPVAL1,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4002!
4003 DO N = 1,NPG
4004 DO IP = 1,NIP
4005 L = (N-1)*NIP+IP
4006 PT=NVSHELL + 3 !22
4007 SCALEYLD = TMPVAL1(L)
4008 SIGSH(PT+ L,I) = SCALEYLD
4009 ENDDO !IP = 1,NIP
4010 ENDDO !N = 1,NPG
4011 PT = PT + NIP * NPG
4012!
4013 ENDIF ! IF (IE == 0) THEN
4014 ENDDO ! DO J=1,NB_ELEMENTS
4015!-------------------
4016 CASE ( 'aux' )
4017!-------------------
4018 CALL HM_GET_INTV('inish3_aux_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
4019 DO J=1,NB_ELEMENTS
4020 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
4021 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NIP,J,IS_AVAILABLE,LSUBMODEL)
4022 CALL HM_GET_INT_ARRAY_INDEX('npg',NPG,J,IS_AVAILABLE,LSUBMODEL)
4023 CALL HM_GET_INT_ARRAY_INDEX('nvars',NUVAR,J,IS_AVAILABLE,LSUBMODEL)
4024!
4025!
4026! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH3NM,NUMELTG)
4027! IE = MAP_TABLES%ISH3NM(ELT,2)
4028!
4029 IE=UEL2SYS(ID_ELEM,KSYSUSRTG,NUMELTG)
4030!
4031 IF (IE == 0) THEN
4032 ! Shell was not found. Issue a Warning & Skip.
4033 NONEXIST = NONEXIST+1
4034 ELSE
4035
4036 IMAT = IXTG(1,IE)
4037 ILAW = IPM(2,IMAT)
4038 NUVARD00 = IPM(8,IMAT)
4039 IF (NUVARD00 > NUVAR) THEN
4040 CALL ANCMSG(MSGID=1121,
4041 . MSGTYPE=MSGWARNING,
4042 . ANMODE=ANINFO,
4043 . I1=ITRI(IE),
4044 . C1='number of user variables',
4045 . C2='material law ',
4046 . I2=IPM(1,IMAT),
4047 . C3='/inish3/aux')
4048 ENDIF
4049.and..or..and. IF ((ILAW == 36 (NUVAR < 4 NUVARD00 > 3)
4050.or. . NUVARD00 < NUVAR)
4051.and..and..and..and. . (ILAW /= 36 ILAW /= 78 ILAW /= 87 ILAW /= 112 NUVARD00 < NUVAR)) THEN
4052 CALL ANCMSG(MSGID=695,
4053 . MSGTYPE=MSGERROR,
4054 . ANMODE=ANINFO,
4055 . I1=ITRI(IE),
4056 . C1='number of user variables',
4057 . C2='material law ',
4058 . I2=IPM(1,IMAT),
4059 . C3='/inish3/aux')
4060 ENDIF
4061
4062 I = NUMSHEL + PTSH3N(IE)
4063 IUSER = 1
4064 NVARSH = NVSHELL + 4
4065 IF (NIP == 0) NIP = 1
4066 IF (NPG == 0) NPG = 1
4067 SIGSH(1,I) = ID_ELEM
4068 ID_SIGSH(I) = ID_ELEM
4069 SIGSH(2,I) = NIP
4070 SIGSH(NVSHELL,I) = NPG
4071 SIGSH(NVSHELL + 2 ,I) = NIP
4072 SIGSH(NVSHELL + 3 ,I) = NPG
4073 SIGSH(NVSHELL + 4 ,I) = NUVAR
4074 PT = 0
4075!
4076 CALL HM_GET_INT_ARRAY_INDEX('num_lines',NUM_LINES,J,IS_AVAILABLE,LSUBMODEL)
4077 NMAX_AUX = NUM_LINES*NUVAR
4078 CALL HM_GET_FLOAT_ARRAY('v' ,TMPVAL,NMAX_AUX,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4079!
4080 DO JJ=1,NUM_LINES
4081 DO K=1,NUVAR
4082 L = NUVAR*(JJ-1) + K
4083 SIGSH(NVARSH+PT+K,I) = TMPVAL(L)
4084 ENDDO ! DO K=1,NUVAR
4085 PT = PT + NUVAR
4086 ENDDO ! DO JJ=1,NUM_LINES
4087!
4088 ENDIF ! IF (IE == 0) THEN
4089 ENDDO ! DO J=1,NB_ELEMENTS
4090!-------------------
4091 CASE ( 'fail' )
4092!-------------------
4093 CALL HM_GET_INTV('inish3_fail_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
4094 DO J=1,NB_ELEMENTS
4095 CALL HM_GET_INT_ARRAY_INDEX('shell_id' ,ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
4096 CALL HM_GET_INT_ARRAY_INDEX('nlay' ,NLAY,J,IS_AVAILABLE,LSUBMODEL)
4097 CALL HM_GET_INT_ARRAY_INDEX('npg' ,NPG,J,IS_AVAILABLE,LSUBMODEL)
4098 CALL HM_GET_INT_ARRAY_INDEX('nptt' ,NPTT,J,IS_AVAILABLE,LSUBMODEL)
4099 CALL HM_GET_INT_ARRAY_INDEX('lay_id' ,ILAY,J,IS_AVAILABLE,LSUBMODEL)
4100 CALL HM_GET_INT_ARRAY_INDEX('fail_id' ,IFAIL,J,IS_AVAILABLE,LSUBMODEL)
4101 CALL HM_GET_INT_ARRAY_INDEX('ifail_typ',IRUPT_TYP,J,IS_AVAILABLE,LSUBMODEL)
4102 CALL HM_GET_INT_ARRAY_INDEX('nvar' ,NVAR_RUPT,J,IS_AVAILABLE,LSUBMODEL)
4103 CALL HM_GET_INT_ARRAY_INDEX('mat_id' ,IMAT,J,IS_AVAILABLE,LSUBMODEL)
4104 CALL HM_GET_INT_ARRAY_INDEX('num_lines',NUM_LINES,J,IS_AVAILABLE,LSUBMODEL)
4105!
4106! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH3NM,NUMELTG)
4107! IE = MAP_TABLES%ISH3NM(ELT,2)
4108!
4109 IE=UEL2SYS(ID_ELEM,KSYSUSRTG,NUMELTG)
4110!
4111 IF (IE == 0) THEN
4112 ! Shell was not found. Issue a Warning & Skip.
4113 NONEXIST = NONEXIST+1
4114 ELSE
4115
4116 NPTT = MAX(1,NPTT)
4117 NLAY = MAX(1,NLAY)
4118 NPT_MAX = MAX(NPTT,NLAY)
4119 NVMAX = NVSHELL1 /(MAX(1,NPG)*NPT_MAX*5)
4120 !!IF (ID_ELEM /= NEM1) I = PTSH3N(IE)
4121 NEM1 = ID_ELEM
4122 I = NUMSHEL + PTSH3N(IE)
4123 IOK = 0
4124!
4125 DO K=1,NUMMAT
4126 IF (IPM(1,K) == IMAT) THEN
4127 IMAT = K
4128 IOK = 1
4129 EXIT
4130 ENDIF
4131 ENDDO
4132 IF (IOK == 0) THEN
4133 CALL ANCMSG(MSGID=1033,
4134 . MSGTYPE=MSGERROR,
4135 . ANMODE=ANINFO,
4136 . I1=ITRI(IE),
4137 . C1='material law',
4138 . C2='/inishe/fail')
4139 ENDIF ! IF (IOK == 0)
4140!
4141 IG = IXTG(5,IE)
4142 ISH3N = IGEO(18,IG)
4143 IGTYP=IGEO(11,IG)
4144 SIGSH(1,I) = ID_ELEM
4145 ID_SIGSH(I) = ID_ELEM
4146 IF ( IGTYP == 9 ) NLAY = NINT(GEO(NPROPG*(IG-1)+6))
4147.OR. IF ( IGTYP == 10 IGTYP == 11) THEN
4148 SIGSH(2,I) = NLAY
4149 ELSE
4150 SIGSH(2,I) = NPTT*NLAY
4151 ENDIF
4152 IF( ISH3N == 30 ) THEN
4153 SIGSH(NVSHELL,I) = 3
4154 ELSE
4155 SIGSH(NVSHELL,I) = 1
4156 ENDIF
4157!
4158! check for consistency ( D00 & INIBRI)
4159 IOK = 0
4160 DO K=1,5
4161 NFAIL(K) = MAT_PARAM(IMAT)%FAIL(K)%FAIL_ID
4162.AND. IF (IFAIL == NFAIL(K)
4163 . IRUPT_TYP == MAT_PARAM(IMAT)%FAIL(K)%IRUPT) THEN
4164 IFAIL = K
4165 FAIL_INI(IFAIL)=1
4166 IOK = 1
4167 EXIT
4168 ENDIF
4169 ENDDO
4170 IF (IOK == 0) THEN
4171 CALL ANCMSG(MSGID=1033,
4172 . MSGTYPE=MSGERROR,
4173 . ANMODE=ANINFO,
4174 . I1=ITRI(IE),
4175 . C1='failure criteria',
4176 . C2='/inish3/fail')
4177 ENDIF
4178!
4179 PT = NVSHELL+NUSHELL+3+NORTSHEL
4180 NPG = MAX(1,NPG)
4181 NPTT = MAX(1,NPTT)
4182 NLAY = MAX(1,NLAY)
4183!
4184 NMAX_FAIL = NUM_LINES*NVAR_RUPT
4185 CALL HM_GET_FLOAT_ARRAY('v' ,TMPVAL,NMAX_FAIL,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4186!
4187 DO JJ=1,NUM_LINES
4188 DO K=1,NVAR_RUPT
4189 L = NVAR_RUPT*(JJ-1) + K
4190 SIGSH(PT+L+(IFAIL-1)*NPT_MAX*NPG*NVMAX+
4191 . (ILAY-1)*NVMAX*NPG*NPTT,I) = TMPVAL(L)
4192 ENDDO ! DO K=1,NVAR_RUPT
4193 ENDDO ! DO JJ=1,NUM_LINES
4194!
4195 ENDIF ! IF (IE == 0) THEN
4196 ENDDO ! DO J=1,NB_ELEMENTS
4197!---------------
4198 CASE DEFAULT
4199
4200 END SELECT ! SELECT CASE(KEY)
4201!
4202 ENDDO ! DO INI=1,NB_INISH3
4203
4204 ENDIF ! IF ( NB_INISH3 > 0 )
4205!
4206 NISH3N = I-NISHELL
4207!
4208!-----------------------------------------
4209! --- /INITRUSS ---
4210!-----------------------------------------
4211 NITRUSS = 0
4212 I = 0
4213!
4214 CALL HM_OPTION_COUNT('/initruss', NB_INITRUSS)
4215!
4216 IF ( NB_INITRUSS > 0 ) THEN
4217!
4218 ! Start reading /INITRUSS card
4219 CALL HM_OPTION_START('/initruss')
4220!---
4221! to be replaced by --- MAP_TABLES%ITRUSSM ---
4222 IF (KTRIELTRUSS == 0) THEN
4223
4224 DO IE = 1, NUMELT
4225 ITRI(IE) = IXT(NIXT,IE)
4226 END DO
4227 CALL MY_ORDERS(0,WORK,ITRI,INDEX,NUMELT,1)
4228 DO J = 1, NUMELT
4229 IE=INDEX(J)
4230 KSYSUSR(J) =IXT(NIXT,IE)
4231 KSYSUSR(NUMELT+J)=IE
4232 END DO
4233 KTRIELTRUSS=1
4234 ENDIF
4235!---
4236 DO INI=1,NB_INITRUSS
4237!
4238 CALL HM_OPTION_READ_KEY(LSUBMODEL,
4239 . UNIT_ID = UID,
4240 . SUBMODEL_INDEX = SUB_INDEX,
4241 . SUBMODEL_ID = SUB_ID,
4242 . KEYWORD2 = KEY)
4243!
4244 IFLAGUNIT = 0
4245 DO IUNIT=1,UNITAB%NUNITS
4246 IF (UNITAB%UNIT_ID(IUNIT) == UID) THEN
4247 IFLAGUNIT = 1
4248 EXIT
4249 ENDIF
4250 ENDDO
4251.AND. IF (UID /= 0IFLAGUNIT == 0) THEN
4252 CALL ANCMSG(MSGID=659,ANMODE=ANINFO,MSGTYPE=MSGERROR,
4253 . I2=UID,I1=SUB_ID,C1='initruss',
4254 . C2='initruss',
4255 . C3=' ')
4256 ENDIF
4257
4258 SELECT CASE (KEY(1:LEN_TRIM(KEY)))
4259
4260 CASE ( 'full' )
4261
4262!
4263 CALL HM_GET_INTV('no_of_elems',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
4264!
4265 DO J=1,NB_ELEMENTS
4266 ! Reading --- ID_ELEM, Prop ... ---
4267 CALL HM_GET_INT_ARRAY_INDEX('truss_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
4268 CALL HM_GET_INT_ARRAY_INDEX('prop_type',IGTYP,J,IS_AVAILABLE,LSUBMODEL)
4269!
4270! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ITRUSSM,NUMELT)
4271! IE = MAP_TABLES%ITRUSSM(ELT,2)
4272!
4273 IE=UEL2SYS(ID_ELEM,KSYSUSR,NUMELT)
4274!
4275 IF (IE == 0) THEN
4276 ! Shell was not found. Issue a Warning & Skip.
4277 NONEXIST = NONEXIST+1
4278 ELSE
4279!
4280 CALL HM_GET_FLOAT_ARRAY_INDEX('eint' ,EIN,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4281 CALL HM_GET_FLOAT_ARRAY_INDEX('f' ,FOR,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4282 CALL HM_GET_FLOAT_ARRAY_INDEX('area' ,EPSP,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4283 CALL HM_GET_FLOAT_ARRAY_INDEX('eps_p',AREA,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4284!
4285 I=I+1
4286 ID_SIGTRUSS(I) = ID_ELEM
4287 SIGTRUSS(1,I) = ID_ELEM
4288 SIGTRUSS(2,I) = IGTYP
4289 SIGTRUSS(3,I) = EIN
4290 SIGTRUSS(4,I) = FOR
4291 SIGTRUSS(5,I) = EPSP
4292 SIGTRUSS(6,I) = AREA
4293!
4294 ENDIF ! IF (IE == 0)
4295 ENDDO ! DO J=1,NB_ELEMENTS
4296!
4297 CASE DEFAULT
4298!
4299 END SELECT ! SELECT CASE(KEY)
4300!
4301 ENDDO ! DO INI=1,NB_NITRUSS
4302
4303 ENDIF ! IF ( NB_NITRUSS > 0 )
4304!
4305 NITRUSS = I
4306
4307
4308
4309!-----------------------------------------
4310! --- /INIBEAM ---
4311!-----------------------------------------
4312 NIBEAM = 0
4313 I = 0
4314!
4315 CALL HM_OPTION_COUNT('/inibeam', NB_INIBEAM)
4316!
4317 IF ( NB_INIBEAM > 0 ) THEN
4318!
4319 ! Start reading /INIBEAM card
4320 CALL HM_OPTION_START('/inibeam')
4321!---
4322! to be replaced by --- MAP_TABLES%IBEAMM ---
4323 IF (KTRIELBEAM == 0) THEN
4324! tri local des elts du D00 par ID croissant (on ne trie qu'une fois)
4325 DO ie = 1,numelp
4326 itri(ie) = ixp(nixp,ie)
4327 ENDDO
4328 CALL my_orders(0,work,itri,index,numelp,1)
4329 DO j = 1,numelp
4330 ie = index(j)
4331 ksysusr(j) =ixp(nixp,ie)
4332 ksysusr(numelp+j)=ie
4333 ENDDO
4334 ktrielbeam=1
4335 ENDIF
4336
4337 DO ini=1,nb_inibeam
4338
4340 . unit_id = uid,
4341 . submodel_index = sub_index
4342 . submodel_id = sub_id,
4343 . keyword2 = key)
4344
4345 iflagunit = 0
4346 DO iunit=1,unitab%NUNITS
4347 IF (unitab%UNIT_ID(iunit) == uid) THEN
4348 iflagunit = 1
4349 EXIT
4350 ENDIF
4351 ENDDO
4352 IF (uid /= 0.AND.iflagunit == 0) THEN
4353 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
4354 . i2=uid,i1=sub_id,c1='INIBEAM',
4355 . c2='INIBEAM',
4356 . c3=' ')
4357 ENDIF
4358
4359 SELECT CASE (KEY(1:LEN_TRIM(KEY)))
4360
4361 CASE ( 'full' )
4362
4363!
4364 CALL HM_GET_INTV('inibeam_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
4365!
4366 DO J=1,NB_ELEMENTS
4367 ! Reading --- ID_ELEM, Prop ... ---
4368 CALL HM_GET_INT_ARRAY_INDEX('beam_id' ,ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
4369 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NIP,J,IS_AVAILABLE,LSUBMODEL)
4370 CALL HM_GET_INT_ARRAY_INDEX('prop_type',IGTYP,J,IS_AVAILABLE,LSUBMODEL)
4371!
4372! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%IBEAMM,NUMELP)
4373! IE = MAP_TABLES%ITRUSSM(ELT,2)
4374!
4375 IE=UEL2SYS(ID_ELEM,KSYSUSR,NUMELP)
4376!
4377 IF (IE == 0) THEN
4378 ! Shell was not found. Issue a Warning & Skip.
4379 NONEXIST = NONEXIST+1
4380 ELSE
4381 CALL HM_GET_FLOAT_ARRAY_INDEX('eimemb' ,EM,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4382 CALL HM_GET_FLOAT_ARRAY_INDEX('eibend' ,EB,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4383 CALL HM_GET_FLOAT_ARRAY_INDEX('f1' ,FOR1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4384 CALL HM_GET_FLOAT_ARRAY_INDEX('f2' ,FOR2,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4385 CALL HM_GET_FLOAT_ARRAY_INDEX('f3' ,FOR3,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4386 CALL HM_GET_FLOAT_ARRAY_INDEX('m1' ,MOM1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4387 CALL HM_GET_FLOAT_ARRAY_INDEX('m2' ,MOM2,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4388 CALL HM_GET_FLOAT_ARRAY_INDEX('m3' ,MOM3,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4389!
4390 I=I+1
4391 ID_SIGBEAM(I) = ID_ELEM
4392 SIGBEAM(1,I) = ID_ELEM
4393 SIGBEAM(2,I) = NIP
4394 SIGBEAM(3,I) = IGTYP
4395!
4396 SIGBEAM(4,I) = EM
4397 SIGBEAM(5,I) = EB
4398!
4399 SIGBEAM(6,I) = FOR1
4400 SIGBEAM(7,I) = FOR2
4401 SIGBEAM(8,I) = FOR3
4402 SIGBEAM(9,I) = MOM1
4403 SIGBEAM(10,I) = MOM2
4404 SIGBEAM(11,I) = MOM3
4405!
4406 PT = 11
4407 IF (NIP == 0) THEN
4408 IF (IGTYP == 3) THEN
4409 CALL HM_GET_FLOAT_ARRAY_INDEX('epsilonp' ,EPSP,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4410 SIGBEAM(PT+1,I) = EPSP
4411 ENDIF ! IF (IGTYP == 3)
4412 ELSEIF (NIP > 0) THEN
4413
4414 IF (IGTYP == 18) THEN
4415 SIZE = NIP
4416 CALL HM_GET_FLOAT_ARRAY('sigma1' ,TMPVAL1,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4417 CALL HM_GET_FLOAT_ARRAY('sigma12' ,TMPVAL2,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4418 CALL HM_GET_FLOAT_ARRAY('sigma13' ,TMPVAL3,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4419 CALL HM_GET_FLOAT_ARRAY('epsilonp_array',TMPVAL4,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4420 DO K=1,NIP
4421 SIGBEAM(PT+1,I) = TMPVAL1(K) ! SXX
4422 SIGBEAM(PT+2,I) = TMPVAL2(K) ! SXY
4423 SIGBEAM(PT+3,I) = TMPVAL3(K) ! SZX
4424 SIGBEAM(PT+4,I) = TMPVAL4(K) ! EPSP
4425!
4426 PT = PT + 4
4427 ENDDO ! DO K=1,NIP
4428 ENDIF ! IF (IGTYP == 18)
4429!------
4430 ENDIF ! IF (NIP == 0)
4431!
4432 ENDIF ! IF (IE == 0)
4433!
4434 ENDDO ! DO J=1,NB_ELEMENTS
4435!
4436
4437 CASE ( 'aux' )
4438
4439!
4440!
4441 CALL HM_GET_INTV('inibeam_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
4442!
4443 DO J=1,NB_ELEMENTS
4444 ! Reading --- ID_ELEM, Prop ... ---
4445 CALL HM_GET_INT_ARRAY_INDEX('beam_id' ,ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
4446 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NIP,J,IS_AVAILABLE,LSUBMODEL)
4447 CALL HM_GET_INT_ARRAY_INDEX('prop_type',IGTYP,J,IS_AVAILABLE,LSUBMODEL)
4448 CALL HM_GET_INT_ARRAY_INDEX('nvars' ,NUVAR,J,IS_AVAILABLE,LSUBMODEL)
4449!
4450! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%IBEAMM,NUMELP)
4451! IE = MAP_TABLES%ITRUSSM(ELT,2)
4452!
4453 IE=UEL2SYS(ID_ELEM,KSYSUSR,NUMELP)
4454!
4455 IF (IE == 0) THEN
4456 ! Shell was not found. Issue a Warning & Skip.
4457 NONEXIST = NONEXIST+1
4458 ELSE
4459!
4460! -- UVAR --
4461!
4462 I=I+1
4463 ID_SIGBEAM(I) = ID_ELEM
4464 SIGBEAM(1,I) = ID_ELEM
4465 SIGBEAM(2,I) = NIP
4466!
4467 IUSER = 1
4468 NVARBEAM = NVBEAM + 4
4469 SIGBEAM(NVBEAM + 1 ,I) = ID_ELEM
4470 SIGBEAM(NVBEAM + 2 ,I) = NIP
4471 SIGBEAM(NVBEAM + 3 ,I) = IGTYP
4472 SIGBEAM(NVBEAM + 4 ,I) = NUVAR
4473!
4474 IF (IGTYP /= 18) THEN
4475 CALL ANCMSG(MSGID=1236,ANMODE=ANINFO,MSGTYPE=MSGERROR,
4476 . C1='aux',
4477 . I1=ID_ELEM)
4478 ENDIF
4479!
4480 PT = 0
4481!
4482 NMAX_AUX = NIP*NUVAR
4483 CALL HM_GET_FLOAT_ARRAY('v' ,TMPVAL,NMAX_AUX,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4484!
4485 DO JJ=1,NIP
4486 DO K=1,NUVAR
4487 L = NUVAR*(JJ-1) + K
4488 SIGBEAM(NVARBEAM+PT+K,I) = TMPVAL(L)
4489 ENDDO ! DO K=1,NUVAR
4490 PT = PT + NUVAR
4491 ENDDO ! DO JJ=1,NIP
4492!
4493 ENDIF ! IF (IE == 0)
4494!
4495 ENDDO ! DO J=1,NB_ELEMENTS
4496!
4497 CASE DEFAULT
4498!
4499 END SELECT ! SELECT CASE(KEY)
4500!
4501 ENDDO ! DO INI=1,NB_INIBEAM
4502
4503 ENDIF ! IF ( NB_INIBEAM > 0 )
4504!
4505 NIBEAM = I
4506
4507
4508
4509!-----------------------------------------
4510! --- /INISPRI ---
4511!-----------------------------------------
4512 NISPRING = 0
4513 I = 0
4514!
4515 CALL HM_OPTION_COUNT('/inispri', NB_INISPRI)
4516!
4517 IF ( NB_INISPRI > 0 ) THEN
4518!
4519 ! Start reading /INISPRI card
4520 CALL HM_OPTION_START('/inispri')
4521!---
4522! to be replaced by --- MAP_TABLES%ISPRINGM ---
4523 IF (KTRIELSPR == 0) THEN
4524
4525 DO IE = 1,NUMELR
4526 ITRI(IE) = IXR(NIXR,IE)
4527 ENDDO
4528 CALL MY_ORDERS(0,WORK,ITRI,INDEX,NUMELR,1)
4529 DO J = 1,NUMELR
4530 IE = INDEX(J)
4531 KSYSUSR(J) =IXR(NIXR,IE)
4532 KSYSUSR(NUMELR+J)=IE
4533 ENDDO
4534 KTRIELSPR=1
4535 ENDIF ! IF (KTRIELSPR==0)
4536!---
4537 DO INI=1,NB_INISPRI
4538!
4539 CALL HM_OPTION_READ_KEY(LSUBMODEL,
4540 . UNIT_ID = UID,
4541 . SUBMODEL_INDEX = SUB_INDEX,
4542 . SUBMODEL_ID = SUB_ID,
4543 . KEYWORD2 = KEY)
4544!
4545 IFLAGUNIT = 0
4546 DO IUNIT=1,UNITAB%NUNITS
4547 IF (UNITAB%UNIT_ID(IUNIT) == UID) THEN
4548 IFLAGUNIT = 1
4549 EXIT
4550 ENDIF
4551 ENDDO
4552.AND. IF (UID /= 0IFLAGUNIT == 0) THEN
4553 CALL ANCMSG(MSGID=659,ANMODE=ANINFO,MSGTYPE=MSGERROR,
4554 . I2=UID,I1=SUB_ID,C1='inispring',
4555 . C2='inispri',
4556 . C3=' ')
4557 ENDIF
4558
4559 SELECT CASE (KEY(1:LEN_TRIM(KEY)))
4560
4561 CASE ( 'full' )
4562
4563!
4564 CALL HM_GET_INTV('size_spring',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
4565!
4566 DO J=1,NB_ELEMENTS
4567 ! Reading --- ID_ELEM, Prop ... ---
4568 CALL HM_GET_INT_ARRAY_INDEX('spring_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
4569 CALL HM_GET_INT_ARRAY_INDEX('prop_type',IGTYP,J,IS_AVAILABLE,LSUBMODEL)
4570 CALL HM_GET_INT_ARRAY_INDEX('nvars' ,NUVAR,J,IS_AVAILABLE,LSUBMODEL)
4571!
4572! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISPRINGM,NUMELR)
4573! IE = MAP_TABLES%ISPRINGM(ELT,2)
4574!
4575 IE=UEL2SYS(ID_ELEM,KSYSUSR,NUMELR)
4576!
4577 IF (IE == 0) THEN
4578 ! Shell was not found. Issue a Warning & Skip.
4579 NONEXIST = NONEXIST+1
4580 ELSE
4581 I=I+1
4582 ID_SIGSPRI(I) = ID_ELEM
4583 SIGRS(1,I) = ID_ELEM
4584
4585.OR. IF (IGTYP == 4 IGTYP == 12) THEN
4586
4587 CALL HM_GET_FLOAT_ARRAY_INDEX('f_x' ,SIGRS(2,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4588 CALL HM_GET_FLOAT_ARRAY_INDEX('d_x' ,SIGRS(3,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4589 CALL HM_GET_FLOAT_ARRAY_INDEX('fep_x' ,SIGRS(4,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4590 CALL HM_GET_FLOAT_ARRAY_INDEX('dpl_x+' ,SIGRS(5,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4591 CALL HM_GET_FLOAT_ARRAY_INDEX('dpl_x-' ,SIGRS(6,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4592 CALL HM_GET_FLOAT_ARRAY_INDEX('l_x' ,SIGRS(7,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4593 CALL HM_GET_FLOAT_ARRAY_INDEX('ei' ,SIGRS(8,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4594!
4595 IF (IGTYP == 12) THEN
4596 CALL HM_GET_FLOAT_ARRAY_INDEX('dfs' ,SIGRS(9,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4597 ENDIF
4598
4599.OR..OR..OR. ELSEIF (IGTYP == 8 IGTYP == 13 IGTYP == 25 IGTYP == 23) THEN
4600
4601 CALL HM_GET_FLOAT_ARRAY_INDEX('f_x' ,SIGRS(2,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4602 CALL HM_GET_FLOAT_ARRAY_INDEX('d_x' ,SIGRS(3,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4603 CALL HM_GET_FLOAT_ARRAY_INDEX('fep_x' ,SIGRS(4,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4604 CALL HM_GET_FLOAT_ARRAY_INDEX('dpl_x+' ,SIGRS(5,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4605 CALL HM_GET_FLOAT_ARRAY_INDEX('dpl_x-' ,SIGRS(6,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4606!
4607 CALL HM_GET_FLOAT_ARRAY_INDEX('f_y' ,SIGRS(7,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4608 CALL HM_GET_FLOAT_ARRAY_INDEX('d_y' ,SIGRS(8,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4609 CALL HM_GET_FLOAT_ARRAY_INDEX('fep_y' ,SIGRS(9,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4610 CALL HM_GET_FLOAT_ARRAY_INDEX('dpl_y+' ,SIGRS(10,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4611 CALL HM_GET_FLOAT_ARRAY_INDEX('dpl_y-' ,SIGRS(11,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4612!
4613 CALL HM_GET_FLOAT_ARRAY_INDEX('f_z' ,SIGRS(12,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4614 CALL HM_GET_FLOAT_ARRAY_INDEX('d_z' ,SIGRS(13,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4615 CALL HM_GET_FLOAT_ARRAY_INDEX('fep_z' ,SIGRS(14,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4616 CALL HM_GET_FLOAT_ARRAY_INDEX('dpl_z+' ,SIGRS(15,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4617 CALL HM_GET_FLOAT_ARRAY_INDEX('dpl_z-' ,SIGRS(16,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4618!
4619 CALL HM_GET_FLOAT_ARRAY_INDEX('m_x' ,SIGRS(17,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4620 CALL HM_GET_FLOAT_ARRAY_INDEX('r_x' ,SIGRS(18,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4621 CALL HM_GET_FLOAT_ARRAY_INDEX('mep_x' ,SIGRS(19,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4622 CALL HM_GET_FLOAT_ARRAY_INDEX('rpl_x+' ,SIGRS(20,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4623 CALL HM_GET_FLOAT_ARRAY_INDEX('rpl_x-' ,SIGRS(21,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4624!
4625 CALL HM_GET_FLOAT_ARRAY_INDEX('m_y' ,SIGRS(22,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4626 CALL HM_GET_FLOAT_ARRAY_INDEX('r_y' ,SIGRS(23,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4627 CALL HM_GET_FLOAT_ARRAY_INDEX('mep_y' ,SIGRS(24,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4628 CALL HM_GET_FLOAT_ARRAY_INDEX('rpl_y+' ,SIGRS(25,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4629 CALL HM_GET_FLOAT_ARRAY_INDEX('rpl_y-' ,SIGRS(26,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4630!
4631 CALL HM_GET_FLOAT_ARRAY_INDEX('m_z' ,SIGRS(27,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4632 CALL HM_GET_FLOAT_ARRAY_INDEX('r_z' ,sigrs(28,i),j,is_available,lsubmodel,unitab)
4636
4642
4648
4649 ELSEIF (igtyp == 26) THEN
4650
4657
4658
4659 ELSEIF (igtyp == 29 .OR. igtyp == 30 .OR. igtyp == 31 .OR.
4660 . igtyp == 32 .OR. igtyp == 33 .OR. igtyp == 35 .OR.
4661 . igtyp == 36 .OR. igtyp == 44 .OR. igtyp == 45 .OR.
4662 . igtyp == 46) THEN
4663
4677
4678 pt = 14
4679
4680
4681
4682 SIZE = nuvar
4684
4685 DO k=1,nuvar
4686 sigrs(pt+k,i) = tmpval(k)
4687 ENDDO
4688 pt = pt + nuvar
4689
4690 ENDIF
4691
4692 ENDIF
4693
4694 ENDDO
4695
4696 CASE DEFAULT
4697
4698 END SELECT
4699
4700 ENDDO
4701
4702 ENDIF
4703
4704 nispring = i
4705
4706
4707
4708
4709
4710
4711 niquad = 0
4712 i = 0
4713
4715
4716 IF ( nb_iniqua > 0 ) THEN
4717
4718
4720
4721
4722 IF (ktrieltquad == 0) THEN
4723
4724 DO ie = 1, numelq
4725 itriq(ie) = ixq(nixq,ie)
4726 END DO
4727 CALL my_orders(0,work,itriq,indexq,numelq,1)
4728 DO j = 1, numelq
4729 ie=indexq(j)
4730 ksysusrq(j) = ixq(nixq,ie)
4731 ksysusrq(numelq+j)=ie
4732 END DO
4733 ktrieltquad=1
4734 ENDIF
4735
4736 DO ini=1,nb_iniqua
4737
4739 . unit_id = uid,
4740 . submodel_index = sub_index,
4741 . submodel_id = sub_id,
4742 . keyword2 = key)
4743
4744 iflagunit = 0
4745 DO iunit=1,unitab%NUNITS
4746 IF (unitab%UNIT_ID(iunit) == uid) THEN
4747 iflagunit = 1
4748 EXIT
4749 ENDIF
4750 ENDDO
4751 IF (uid/=0.AND.iflagunit == 0) THEN
4752 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
4753 . i2=uid,i1=sub_id,c1='INIQUA',
4754 . c2='INIQUA',
4755 . c3=' ')
4756 ENDIF
4757
4758 SELECT CASE (key(1:len_trim(key)))
4759
4760 CASE ( 'DENS' )
4761
4762
4763 CALL hm_get_intv(
'no_blocks',nb_elements,is_available,lsubmodel)
4764
4765 DO j=1,nb_elements
4766
4768
4769
4770
4771
4772
4773 ie=
uel2sys(id_elem,ksysusrq,numelq)
4774
4775 IF (ie == 0) THEN
4776
4777 nonexist = nonexist+1
4778 ELSE
4780 i=i+1
4781 id_quad_sigi(i) = id_elem
4782 sigi(8,i) = dens
4783 ENDIF
4784 ENDDO
4785
4786 CASE ( 'ENER' )
4787
4788
4789 CALL hm_get_intv(
'no_blocks',nb_elements,is_available,lsubmodel)
4790
4791 DO j=1,nb_elements
4792
4794
4795
4796
4797
4798
4799 ie=
uel2sys(id_elem,ksysusrq,numelq)
4800
4801 IF (ie == 0) THEN
4802
4803 nonexist = nonexist+1
4804 ELSE
4806 i=i+1
4807 id_quad_sigi(i) = id_elem
4808 sigi(9,i) = ener
4809 ENDIF
4810 ENDDO
4811
4812 CASE ( 'EPSP' )
4813
4814
4815 CALL hm_get_intv(
'no_blocks',nb_elements,is_available,lsubmodel)
4816
4817 DO j=1,nb_elements
4818
4820
4821
4822
4823
4824 ie=
uel2sys(id_elem,ksysusrq,numelq)
4825
4826 IF (ie == 0) THEN
4827
4828 nonexist = nonexist+1
4829 ELSE
4831 i=i+1
4832 id_quad_sigi(i) = id_elem
4833 sigi(10,i) = epsp
4834 ENDIF
4835 ENDDO
4836
4837 CASE ( 'STRESS' )
4838
4839
4841
4842 DO j=1,nb_elements
4843
4844
4846
4847
4848
4849
4850 ie=
uel2sys(id_elem,ksysusrq,numelq)
4851
4852 IF (ie == 0) THEN
4853
4854 nonexist = nonexist+1
4855 ELSE
4860
4861 i=i+1
4862 id_quad_sigi(i) = id_elem
4863 DO k=1,4
4864 sigi(k,i) = s(k)
4865 ENDDO
4866 ENDIF
4867 ENDDO
4868
4869 CASE DEFAULT
4870
4871 END SELECT
4872
4873
4874 ENDDO
4875
4876 ENDIF
4877
4878 niquad = i
4879
4880
4881
4882
4883 nisphcel = 0
4884 i = 0
4886
4887 IF ( nb_inisphcel > 0 ) THEN
4888
4889
4891
4892 IF (ktrielsphcel == 0) THEN
4893 DO ie = 1, numsph
4894 itrisph(ie) = kxsp(nisp,ie)
4895 END DO
4896 CALL my_orders(0,work,itrisph,indexsph,numsph,1)
4897 DO j = 1, numsph
4898 ie=indexsph(j)
4899 ksysusrsph(j) =kxsp(nisp,ie)
4900 ksysusrsph(numsph+j)=ie
4901 END DO
4902 ktrielsphcel=1
4903 ENDIF
4904
4905 DO ini=1,nb_inisphcel
4906
4908 . unit_id = uid,
4909 . submodel_index = sub_index,
4910 . submodel_id = sub_id,
4911 . keyword2 = key,
4912 . keyword3 = key2)
4913
4914 IF (key2 /= ' ') glob = .true.
4915
4916 iflagunit = 0
4917 DO iunit=1,unitab%NUNITS
4918 IF (unitab%UNIT_ID(iunit) == uid) THEN
4919 iflagunit = 1
4920 EXIT
4921 ENDIF
4922 ENDDO
4923
4924 IF (uid /= 0.AND.iflagunit == 0) THEN
4925 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
4926 . i2=uid, i1=sub_id, c1='INISPHCEL',
4927 . c2='INISPHCEL',
4928 . c3=' ')
4929 ENDIF
4930
4931 SELECT CASE (key(1:len_trim(key)))
4932
4933 CASE ( 'FULL' )
4934
4935 CALL hm_get_intv(
'no_blocks',nb_elements,is_available,lsubmodel)
4936
4937 DO j=1,nb_elements
4938 i=i+1
4948
4949 ie=
uel2sys(id_elem,ksysusrsph,numsph)
4950
4951 IF (ie == 0) THEN
4952
4953 nonexist = nonexist+1
4954 ELSE
4955 id_sigsph(i) = id_elem
4956 sigsph(1,i) = s(1)
4957 sigsph(2,i) = s(2)
4958 sigsph(3,i) = s(3)
4959 sigsph(4,i) = zero
4960 sigsph(5,i) = zero
4961 sigsph(6,i) = zero
4962 sigsph(7,i) = zero
4963 sigsph(8,i) = rho
4964 sigsph(9,i) = ener
4965 sigsph(10,i) = epsp
4967 sigsph(12,i) = nuvar
4969 DO k=1,nuvar
4970 sigsph(12+k,i) = tmpval(k)
4971 ENDDO
4972
4973 ENDIF
4974 ENDDO
4975
4976 CASE DEFAULT
4977
4978 END SELECT
4979
4980 ENDDO
4981
4982 ENDIF
4983
4984
4985
4986
4987 IF (nonexist > 0) THEN
4988 CALL ancmsg(msgid=3045,anmode=aninfo,msgtype=msgwarning,i1=nonexist)
4989 ENDIF
4990
4991 DEALLOCATE (itris)
4992 DEALLOCATE (indexs)
4993 DEALLOCATE (ksysusrs)
4994 DEALLOCATE (ksysusrtg)
4995 DEALLOCATE (itriq)
4996 DEALLOCATE (indexq)
4997 DEALLOCATE (ksysusrq)
4998 DEALLOCATE (ies2iparg)
4999 IF(ALLOCATED(itrisph)) DEALLOCATE(itrisph)
5000 IF(ALLOCATED(indexsph)) DEALLOCATE(indexsph)
5001 IF(ALLOCATED(ksysusrsph)) DEALLOCATE(ksysusrsph)
5002
5003 RETURN
5004
subroutine hm_get_float_array(name, rarray, s_rarray, index, is_available, lsubmodel, unitab)
subroutine hm_get_float_array_index(name, rval, index, is_available, lsubmodel, unitab)
subroutine hm_get_int_array_index(name, ival, index, is_available, lsubmodel)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
subroutine hm_option_count(entity_type, hm_option_number)
subroutine hm_option_start(entity_type)
subroutine area(d1, x, x2, y, y2, eint, stif0)
integer function set_usrtos(iu, ipartm1, npart)
subroutine lec_inistate_d00_brick_check(ixs, igeo, itris, isolnodd00, ie, npt, nlay, isolnod, jjhbe, igtyp, isrot, keyword)
for(i8=*sizetab-1;i8 >=0;i8--)
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
integer, parameter nchartitle
integer, parameter ncharkey
integer function nvar(text)
subroutine slen(x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, j, area, aream)
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)
subroutine subrottens(tens, rtrans, sub_id, lsubmodel)
integer function uel2sys(iu, ksysusr, numel)
1.15.0