OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_inistate_d00.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| hm_read_inistate_d00 ../starter/source/elements/initia/hm_read_inistate_d00.F
25!||--- called by ------------------------------------------------------
26!|| lec_inistate ../starter/source/elements/initia/lec_inistate.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| fretitl2 ../starter/source/starter/freform.F
30!|| hm_get_float_array ../starter/source/devtools/hm_reader/hm_get_float_array.F
31!|| hm_get_float_array_index ../starter/source/devtools/hm_reader/hm_get_float_array_index.F
32!|| hm_get_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
33!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.f
34!|| hm_option_count ../starter/source/devtools/hm_reader/hm_option_count.F
35!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
36!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.f
37!|| lec_inistate_d00_brick_check ../starter/source/elements/initia/lec_inistate_d00_brick-check.F
38!|| set_usrtos ../starter/source/model/sets/ipartm1.F
39!|| subrottens ../starter/source/model/submodel/subrot.F
40!|| subrotvect ../starter/source/model/submodel/subrot.F
41!|| uel2sys ../starter/source/initial_conditions/inista/yctrl.F
42!||--- uses -----------------------------------------------------
43!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.f
44!|| mapping_option_mod ../starter/share/modules1/dichotomy_mod.f
45!|| message_mod ../starter/share/message_module/message_mod.F
46!|| stack_mod ../starter/share/modules1/stack_mod.F
47!|| submodel_mod ../starter/share/modules1/submodel_mod.F
48!||====================================================================
49 SUBROUTINE hm_read_inistate_d00 (
50 1 IXS ,IXQ ,IXC ,IXT ,IXP ,
51 2 IXR ,GEO ,PM ,IXTG ,INDEX ,
52 3 ITRI ,NSIGSH ,IGEO ,
53 4 IPM ,NSIGS ,NSIGSPH ,KSYSUSR ,NSIGRS ,
54 5 UNITAB ,ISOLNODD00 ,LSUBMODEL ,RTRANS ,IDRAPE ,
55 6 NSIGI ,NSIGBEAM ,NSIGTRUSS ,
56 7 SIGI ,SIGSH ,SIGSP ,SIGSPH ,SIGRS ,
57 8 SIGBEAM ,SIGTRUSS ,STRSGLOB ,STRAGLOB ,ORTHOGLOB ,
58 9 ISIGSH ,IYLDINI ,FAIL_INI ,IUSOLYLD ,IUSER ,
59 A ID_SIGSH ,ID_SOLID_SIGI,ID_QUAD_SIGI ,ID_SIGSPRI ,ID_SIGBEAM,
60 B ID_SIGTRUSS,WORK ,IGRBRIC ,NIBRICK ,NIQUAD ,
61 C NISHELL ,NISH3N ,NISPRING ,NIBEAM ,NITRUSS ,
62 D MAP_TABLES ,VARMAX ,IPARG ,PTSHEL ,PTSH3N ,
63 E STACK ,IWORKSH ,IOUT ,MAT_PARAM ,NISPHCEL ,
64 F NUMSPH ,NISP ,KXSP ,ID_SIGSPH )
65C-----------------------------------------------
66C M o d u l e s
67C-----------------------------------------------
68 USE unitab_mod
69 USE groupdef_mod
70 USE submodel_mod
71 USE message_mod
72 USE hm_option_read_mod
73 USE mapping_option_mod
74 USE stack_mod
75 USE matparam_def_mod
76 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
77 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
78C-----------------------------------------------
79C I m p l i c i t T y p e s
80C-----------------------------------------------
81#include "implicit_f.inc"
82C-----------------------------------------------
83C C o m m o n B l o c k s
84C-----------------------------------------------
85#include "com01_c.inc"
86#include "com04_c.inc"
87#include "drape_c.inc"
88#include "param_c.inc"
89#include "scr17_c.inc"
90#include "scry_c.inc"
91#include "vect01_c.inc"
92C-----------------------------------------------
93C D u m m y A r g u m e n t s
94C-----------------------------------------------
95 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
96 INTEGER IXS(NIXS,*), IXQ(NIXQ,*) ,IXC(NIXC,*),
97 . IGEO(NPROPGI,*) , IXT(NIXT,*) ,IXP(NIXP,*), IXR(NIXR,*),
98 . IXTG(NIXTG,*) , INDEX(*) ,ITRI(*) ,IPM(NPROPMI,*),
99 . KSYSUSR(*) , IDRAPE(NPLYMAX,*)
100 INTEGER NSIGI, NSIGSH, NSIGS, NSIGSPH, NSIGRS,
101 . ISOLNODD00(*), NSIGBEAM, NSIGTRUSS, STRSGLOB(*),
102 . STRAGLOB(*), ORTHOGLOB(*), ISIGSH, IYLDINI, FAIL_INI(5),
103 . IUSOLYLD, IUSER,VARMAX
104 INTEGER ID_SIGSH(*), ID_SOLID_SIGI(*), ID_QUAD_SIGI(*)
105 INTEGER ID_SIGSPRI(*), ID_SIGBEAM(*), ID_SIGTRUSS(*)
106 INTEGER WORK(*)
107 INTEGER NIBRICK, NIQUAD, NISHELL, NISH3N, NISPRING, NIBEAM, NITRUSS
108 my_real
109 . GEO(*),PM(NPROPM,*),RTRANS(NTRANSF,*),
110 . sigi(nsigs,*),sigsh(max(1,nsigsh),*),sigtruss(nsigtruss,*),
111 . sigsp(nsigi,*),sigsph(nsigsph,*),sigrs(nsigrs,*),sigbeam(nsigbeam,*)
112C
113 TYPE(submodel_data) LSUBMODEL(*)
114 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
115C
116 TYPE(mapping_struct_) :: MAP_TABLES
117 INTEGER, DIMENSION(NPARG,NGROUP) ,INTENT(IN):: IPARG
118 INTEGER, INTENT(INOUT) :: PTSHEL(NUMELC),PTSH3N(NUMELTG)
119 TYPE (STACK_PLY) :: STACK
120 INTEGER, INTENT(IN) :: IWORKSH(3,NUMELC + NUMELTG)
121 INTEGER, INTENT(IN) :: IOUT
122 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
123 INTEGER, INTENT(INOUT) :: NISPHCEL
124 INTEGER, INTENT(IN) :: NUMSPH
125 INTEGER, INTENT(IN) :: NISP
126 INTEGER, INTENT(IN) :: KXSP(NISP,NUMSPH)
127 INTEGER, INTENT(INOUT) :: ID_SIGSPH(NUMSPH)
128C-----------------------------------------------
129C L o c a l V a r i a b l e s
130C-----------------------------------------------
131 INTEGER K, N, I,J, L,IG, ISOLNOD,IGTYP,
132 . ihbe, ish3n,iis,nip,ipg,npg,pt,npp,
133 . ip,jj,nuvar,
134 . nvarsh,kk,uid,iflagunit,
135 . iunit, jjhbe,
136 . nuvard00, ndir, npgtmp,
137 . nptr,npts,nptt,jr,js,jt,nfail(5),imat,ilaw,
138 . jl,npt_max,mlawly,ipmat,nvarbeam,ifail,nem1,
139 . irupt_typ,nvar_rupt,iok,nvmax,flagdeg,num_lines,nmax_aux,nmax_fail,
140 . isubstack,nslice,ipnpt_lay,ipt
141 INTEGER IE, IR, IS, IT, BRIGLOB, SUB_ID, NLAY, ILAY, PID
142 INTEGER KTRIELS, KTRIELC, KTRIELTG, KTRIELSPR, KTRIELBEAM, KTRIELTRUSS,
143 . KTRIELTQUAD, KTRIELSPHCEL
144 INTEGER IGBR, JGBR, I1, SIZE,NSROT,NG,ITYR,NFTR,NELR,ISMRAD
145! INTEGER :: VARMAX
146! PARAMETER (VARMAX = MAX(NSIGSH,NSIGI,NSIGI,NSIGTRUSS,NSIGBEAM,NSIGRS))
147 my_real
148 . em , eb, h1, h2, h3,
149 . r0 , ein, vx, vy, vz, phi1, phi2, scaleyld,
150 . epsp, angle1, angle2, area, for,ener,dens,
151 . fill, rho, slen
152 my_real
153 . s(6),
154! . TMPVAL(NVSHELL),
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
166 CHARACTER(LEN=NCHARTITLE) :: TITR
167 CHARACTER*15,KEYWORD
168 INTEGER NONEXIST
169C-----------------------------------------------
170 EXTERNAL UEL2SYS
171 INTEGER UEL2SYS
172C-----------------------------------------------
173 LOGICAL IS_AVAILABLE,GLOB
174
175 INTEGER NB_INIBRI,NB_INISHE,NB_INISH3,NB_ELEMENTS,ID_ELEM,
176 . INI,K0,NB_INITRUSS,NB_INIBEAM,NB_INISPRI,NB_INIQUA,
177 . sub_index,istrsf,istrsfg,istraf,istrafg,istat,nb_inisphcel
178 my_real
179 . thk,for1,for2,for3,mom1,mom2,mom3
180!
181 INTEGER SET_USRTOS
182 EXTERNAL set_usrtos
183C=======================================================================
184C
185C -- READING OF INITIAL STATE DATA - EXTRACTED FROM INITIA.F
186C
187C=======================================================================
188 sub_index = 0
189 nonexist = 0
190C
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')
205C
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
214C
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
224C-----------------------------------------
225C INITIAL CONSTRAINTS FILE D00
226C-----------------------------------------
227 is_available = .false.
228 glob = .false.
229!-----------------------------------------
230! --- /INIBRI ---
231!-----------------------------------------
232!- check incompatibility keywords first---
233 CALL hm_option_count('/INIBRI', nb_inibri)
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 ! Start reading /INIBRI card
248 CALL hm_option_start('/INIBRI')
249 istrsf=0
250 istrsfg=0
251 istraf=0
252 istrafg=0
253!
254 DO ini=1,nb_inibri
255!
256 CALL hm_option_read_key(lsubmodel,
257 . unit_id = uid,
258 . submodel_index = sub_index,
259 . submodel_id = sub_id,
260 . keyword2 = key)
261!
262c---------------------------------------
263 SELECT CASE (key(1:len_trim(key)))
264C---------
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 IF (istrsfg>0.AND.istrsf>0) THEN
276 CALL ancmsg(msgid=2044,anmode=aninfo,msgtype=msgwarning)
277 END IF
278 IF (istrafg>0.AND.istraf>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 IF (uid/=0.AND.iflagunit == 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
327c---------------------------------------
328 SELECT CASE (key(1:len_trim(key)))
329C---------
330 CASE ( 'FILL' )
331C---------
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
344C---------
345 CASE ( 'EPSP' )
346C---------
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
359C---------
360 CASE ( 'ENER' )
361C---------
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
374C---------
375 CASE ( 'DENS' )
376C---------
377 CALL hm_get_intv('inibri_dens_count',nb_elements,is_available,lsubmodel)
378!
379 DO j=1,nb_elements
380 ! Reading --- ID_ELEM, DENS ---
381 CALL hm_get_int_array_index('brick_ID',id_elem,j,is_available,lsubmodel)
382 CALL hm_get_float_array_index('value',dens,j,is_available,lsubmodel,unitab)
383!
384 i=i+1
385 id_solid_sigi(i) = id_elem
386 sigi(8,i) = dens
387!
388 ENDDO ! DO J=1,NB_ELEMENTS
389C---------
390 CASE ( 'STRESS' )
391C---------
392 CALL hm_get_intv('inibri_stress_count',nb_elements,is_available,lsubmodel)
393!
394 DO j=1,nb_elements
395 ! Reading --- ID_ELEM, STRESS ---
396 CALL hm_get_int_array_index('bric_IDst',id_elem,j,is_available,lsubmodel)
397 CALL hm_get_float_array_index('SIGMA_x',s(1),j,is_available,lsubmodel,unitab)
398 CALL hm_get_float_array_index('SIGMA_y',s(2),j,is_available,lsubmodel,unitab)
399 CALL hm_get_float_array_index('SIGMA_z',s(3),j,is_available,lsubmodel,unitab)
400 CALL hm_get_float_array_index('SIGMA_xy',s(4),j,is_available,lsubmodel,unitab)
401 CALL hm_get_float_array_index('SIGMA_yz',s(5),j,is_available,lsubmodel,unitab)
402 CALL hm_get_float_array_index('SIGMA_xz',s(6),j,is_available,lsubmodel,unitab)
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 ! DO J=1,NB_ELEMENTS
411C---------
412 CASE ( 'AUX' )
413C---------
414 CALL hm_get_intv('inibri_aux_count',nb_elements,is_available,lsubmodel)
415!
416 DO j=1,nb_elements
417 ! Reading --- ID_ELEM, ... ---
418 CALL hm_get_int_array_index('brick_ID',id_elem,j,is_available,lsubmodel)
419 CALL hm_get_int_array_index('Nb_integr',npt,j,is_available,lsubmodel)
420 CALL hm_get_int_array_index('Isolnod',isolnod,j,is_available,lsubmodel)
421 CALL hm_get_int_array_index('Isolid',jjhbe,j,is_available,lsubmodel)
422 CALL hm_get_int_array_index('nvars',nuvar,j,is_available,lsubmodel)
423!
424 ie=uel2sys(id_elem,ksysusrs,numels)
425!
426 IF (ie == 0) THEN
427 ! Shell was not found. Issue a Warning & Skip.
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!
440 CALL lec_inistate_d00_brick_check (
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
449 CALL ancmsg(msgid=1121,
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
461 CALL ancmsg(msgid=695,
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
472 CALL hm_get_float_array('V',tmpval,nmax_aux,j,is_available,lsubmodel,unitab)
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 ! DO K=1,NUVAR
479 ENDDO ! DO JJ=1,NUM_LINES
480 ENDIF ! IF (IE == 0) THEN
481 ENDDO ! DO J=1,NB_ELEMENTS
482C---------
483 CASE ( 'STRS_FGLO' )
484C---------
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 ! Reading --- ID_ELEM, NIP, NPG, THK ---
493 CALL hm_get_int_array_index('brick_ID',id_elem,j,is_available,lsubmodel)
494 CALL hm_get_int_array_index('Nb_integr',npt,j,is_available,lsubmodel)
495 CALL hm_get_int_array_index('Isolnod',isolnod,j,is_available,lsubmodel)
496 CALL hm_get_int_array_index('Isolid',jjhbe,j,is_available,lsubmodel)
497 CALL hm_get_int_array_index('nptr',nptr,j,is_available,lsubmodel)
498 CALL hm_get_int_array_index('npts',npts,j,is_available,lsubmodel)
499 CALL hm_get_int_array_index('nptt',nptt,j,is_available,lsubmodel)
500! need to be added (cfg + doc)
501 CALL hm_get_int_array_index('nlay',nlay,j,is_available,lsubmodel)
502 CALL hm_get_int_array_index('grbric_ID',igbr,j,is_available,lsubmodel)
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! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISOLM,NUMELS)
518! IE = MAP_TABLES%ISOLM(ELT,2)
519!
520 ie=uel2sys(id_elem,ksysusrs,numels)
521!
522 IF (ie == 0) THEN
523 ! Solid was not found. Issue a Warning & Skip.
524 nonexist = nonexist+1
525 ELSEIF (strsglob(ie) >= 0) THEN
526! --- treated already
527 ELSE
528!
529 i=i+1
530 id_solid_sigi(i) = id_elem
531 sigsp(2,i) = npt
532 ! STRSGLOB(IE)=0 -> stress read in element system
533 ! STRSGLOB(IE)=1 -> stress read in global reference system
534 IF (briglob == 1) strsglob(ie)=1
535!
536 CALL lec_inistate_d00_brick_check (
537 1 ixs ,igeo ,itris ,isolnodd00 ,ie ,
538 2 npt ,nlay ,isolnod ,jjhbe ,igtyp ,
539 3 isrot ,keyword )
540!---------not have to distinquate 2 groupes, can be cleaned later
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! -----------First Group of solids : 4 lines to be read-----------------
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
554 CALL hm_get_float_array('E_int' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
555 CALL hm_get_float_array('RHO' ,tmpval2,SIZE,j,is_available,lsubmodel,unitab)
556 CALL hm_get_float_array('SIGMA1' ,tmpval3,SIZE,j,is_available,lsubmodel,unitab)
557 CALL hm_get_float_array('SIGMA2' ,tmpval4,SIZE,j,is_available,lsubmodel,unitab)
558 CALL hm_get_float_array('SIGMA3' ,tmpval5,SIZE,j,is_available,lsubmodel,unitab)
559 CALL hm_get_float_array('SIGMA12' ,tmpval6,SIZE,j,is_available,lsubmodel,unitab)
560 CALL hm_get_float_array('SIGMA23' ,tmpval7,SIZE,j,is_available,lsubmodel,unitab)
561 CALL hm_get_float_array('SIGMA31' ,tmpval8,SIZE,j,is_available,lsubmodel,unitab)
562 CALL hm_get_float_array('EPSILON_p' ,tmpval9,SIZE,j,is_available,lsubmodel,unitab)
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 ! DO K=1,NPT
589 ELSE ! IF(ISOLNOD == 8 .AND. JJHBE == 12)
590!
591 SIZE = npt
592 CALL hm_get_float_array('E_int' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
593 CALL hm_get_float_array('RHO' ,tmpval2,SIZE,j,is_available,lsubmodel,unitab)
594 CALL hm_get_float_array('SIGMA1' ,tmpval3,SIZE,j,is_available,lsubmodel,unitab)
595 CALL hm_get_float_array('SIGMA2' ,tmpval4,SIZE,j,is_available,lsubmodel,unitab)
596 CALL hm_get_float_array('SIGMA3' ,tmpval5,SIZE,j,is_available,lsubmodel,unitab)
597 CALL hm_get_float_array('SIGMA12' ,tmpval6,SIZE,j,is_available,lsubmodel,unitab)
598 CALL hm_get_float_array('SIGMA23' ,tmpval7,SIZE,j,is_available,lsubmodel,unitab)
599 CALL hm_get_float_array('SIGMA31' ,tmpval8,SIZE,j,is_available,lsubmodel,unitab)
600 CALL hm_get_float_array('EPSILON_p' ,tmpval9,SIZE,j,is_available,lsubmodel,unitab)
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 ! NPT /= 1
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 ! DO K=1,NPT
659 ENDIF ! NPT
660 ENDIF ! IF(ISOLNOD == 8 .AND. JJHBE == 12)
661 !---
662 ELSE
663 !---
664! --------------------Second Group of solids : 3 lines to be read-----------------
665 IF (isolnod == 16) THEN
666!
667 SIZE = nptt*nptr*nlay
668 CALL hm_get_float_array('SIGMA1' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
669 CALL hm_get_float_array('SIGMA2' ,tmpval2,SIZE,j,is_available,lsubmodel,unitab)
670 CALL hm_get_float_array('SIGMA3' ,tmpval3,SIZE,j,is_available,lsubmodel,unitab)
671 CALL hm_get_float_array('SIGMA12' ,tmpval4,SIZE,j,is_available,lsubmodel,unitab)
672 CALL hm_get_float_array('SIGMA23' ,tmpval5,SIZE,j,is_available,lsubmodel,unitab)
673 CALL hm_get_float_array('SIGMA31' ,tmpval6,SIZE,j,is_available,lsubmodel,unitab)
674 CALL hm_get_float_array('EPSILON_p' ,tmpval7,SIZE,j,is_available,lsubmodel,unitab)
675 CALL hm_get_float_array('E_int' ,tmpval8,SIZE,j,is_available,lsubmodel,unitab)
676 CALL hm_get_float_array('RHO' ,tmpval9,SIZE,j,is_available,lsubmodel,unitab)
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 ! DO JL=1,NLAY
707 ENDDO ! DO JR=1,NPTR
708 ENDDO ! DO JT=1,NPTT
709!
710 ELSEIF (isolnod == 20) THEN
711!
712 SIZE = nptt*npts*nptr
713 CALL hm_get_float_array('SIGMA1' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
714 CALL hm_get_float_array('SIGMA2' ,tmpval2,SIZE,j,is_available,lsubmodel,unitab)
715 CALL hm_get_float_array('SIGMA3' ,tmpval3,SIZE,j,is_available,lsubmodel,unitab)
716 CALL hm_get_float_array('SIGMA12' ,tmpval4,SIZE,j,is_available,lsubmodel,unitab)
717 CALL hm_get_float_array('SIGMA23' ,tmpval5,SIZE,j,is_available,lsubmodel,unitab)
718 CALL hm_get_float_array('SIGMA31' ,tmpval6,SIZE,j,is_available,lsubmodel,unitab)
719 CALL hm_get_float_array('EPSILON_p' ,tmpval7,SIZE,j,is_available,lsubmodel,unitab)
720 CALL hm_get_float_array('E_int' ,tmpval8,SIZE,j,is_available,lsubmodel,unitab)
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)
768 CALL hm_get_float_array('EPSILON_p' ,tmpval7,SIZE,j,is_available,lsubmodel,unitab)
769 CALL hm_get_float_array('E_int' ,tmpval8,SIZE,j,is_available,lsubmodel,unitab)
770 CALL hm_get_float_array('RHO' ,tmpval9,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 k = jr + ( (js-1) + (jt-1)*npts )*nptr
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 ! DO JT=1,NPTT
803 ENDDO ! DO JS=1,NPTS
804 ENDDO ! DO jr=1,nptr
805!
806 ELSE ! (igtyp /= 22)
807!
808 SIZE = npt
809 CALL hm_get_float_array('SIGMA1' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
810 CALL hm_get_float_array('SIGMA2' ,tmpval2,SIZE,j,is_available,lsubmodel,unitab)
811 CALL hm_get_float_array('SIGMA3' ,tmpval3,SIZE,j,is_available,lsubmodel,unitab)
812 CALL hm_get_float_array('SIGMA12' ,tmpval4,SIZE,j,is_available,lsubmodel,unitab)
813 CALL hm_get_float_array('SIGMA23' ,tmpval5,SIZE,j,is_available,lsubmodel,unitab)
814 CALL hm_get_float_array('SIGMA31' ,tmpval6,SIZE,j,is_available,lsubmodel,unitab)
815 CALL hm_get_float_array('EPSILON_p' ,tmpval7,SIZE,j,is_available,lsubmodel,unitab)
816 CALL hm_get_float_array('E_int' ,tmpval8,SIZE,j,is_available,lsubmodel,unitab)
817 CALL hm_get_float_array('RHO' ,tmpval9,SIZE,j,is_available,lsubmodel,unitab)
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 ! DO K=1,NPT
841 ENDIF ! IF (IGTYP == 22)
842 ENDIF ! IF (ISOLNOD == 16)
843 ENDIF ! IF ( (ISOLNOD == 8 .AND. ...)
844 ENDIF ! IF (IE == 0)
845!
846 IF (igbr > 0) THEN
847 i1 = i
848 DO k = 2,igrbric(jgbr)%NENTITY
849 ie = igrbric(jgbr)%ENTITY(k)
850 CALL lec_inistate_d00_brick_check (
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 ! DO K = 2,IGRBRIC(JGBR)%NENTITY
865 ENDIF ! IF (IGBR > 0)
866!
867 ENDDO ! DO J=1,NB_ELEMENTS
868C---------
869 CASE ( 'STRS_F' )
870C---------
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 ! Reading --- ID_ELEM, NIP, NPG, THK ---
878 CALL hm_get_int_array_index('brick_ID',id_elem,j,is_available,lsubmodel)
879 CALL hm_get_int_array_index('Nb_integr',npt,j,is_available,lsubmodel)
880 CALL hm_get_int_array_index('Isolnod',isolnod,j,is_available,lsubmodel)
881 CALL hm_get_int_array_index('Isolid',jjhbe,j,is_available,lsubmodel)
882! need to be added (cfg + doc)
883 CALL hm_get_int_array_index('nptr',nptr,j,is_available,lsubmodel)
884 CALL hm_get_int_array_index('npts',npts,j,is_available,lsubmodel)
885 CALL hm_get_int_array_index('nptt',nptt,j,is_available,lsubmodel)
886 CALL hm_get_int_array_index('nlay',nlay,j,is_available,lsubmodel)
887 CALL hm_get_int_array_index('grbric_ID',igbr,j,is_available,lsubmodel)
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! elt = set_usrtos(id_elem,map_tables%ISOLM,numels)
901! IE = MAP_TABLES%ISOLM(ELT,2)
902!
903 ie=uel2sys(id_elem,ksysusrs,numels)
904!
905 IF (ie == 0) THEN
906 ! Solid was not found. Issue a Warning & Skip.
907 nonexist = nonexist+1
908 ELSEIF (strsglob(ie) >= 0) THEN
909! --- treated already
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!
917 CALL lec_inistate_d00_brick_check (
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! -----------First Group of solids : 4 lines to be read-----------------
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
936 CALL hm_get_float_array('E_int' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
937 CALL hm_get_float_array('RHO' ,tmpval2,SIZE,j,is_available,lsubmodel,unitab)
938 CALL hm_get_float_array('SIGMA1' ,tmpval3,SIZE,j,is_available,lsubmodel,unitab)
939 CALL hm_get_float_array('SIGMA2' ,tmpval4,SIZE,j,is_available,lsubmodel,unitab)
940 CALL hm_get_float_array('SIGMA3' ,tmpval5,SIZE,j,is_available,lsubmodel,unitab)
941 CALL hm_get_float_array('SIGMA12' ,tmpval6,SIZE,j,is_available,lsubmodel,unitab)
942 CALL hm_get_float_array('SIGMA23' ,tmpval7,SIZE,j,is_available,lsubmodel,unitab)
943 CALL hm_get_float_array('SIGMA31' ,tmpval8,SIZE,j,is_available,lsubmodel,unitab)
944 CALL hm_get_float_array('EPSILON_p' ,tmpval9,SIZE,j,is_available,lsubmodel,unitab)
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 ! DO K=1,NPT
971 ELSE ! IF(ISOLNOD == 8 .AND. JJHBE == 12)
972!
973 SIZE = npt
974 CALL hm_get_float_array('E_int' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
975 CALL hm_get_float_array('rho' ,TMPVAL2,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
976 CALL HM_GET_FLOAT_ARRAY('sigma1' ,TMPVAL3,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
977 CALL HM_GET_FLOAT_ARRAY('sigma2' ,TMPVAL4,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
978 CALL HM_GET_FLOAT_ARRAY('sigma3' ,TMPVAL5,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
979 CALL HM_GET_FLOAT_ARRAY('sigma12' ,TMPVAL6,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
980 CALL HM_GET_FLOAT_ARRAY('sigma23' ,TMPVAL7,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
981 CALL HM_GET_FLOAT_ARRAY('sigma31' ,TMPVAL8,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
982 CALL HM_GET_FLOAT_ARRAY('epsilon_p' ,TMPVAL9,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
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 ! NPT /= 1
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 ! DO K=1,NPT
1043 ENDIF ! NPT
1044.AND. ENDIF ! IF(ISOLNOD == 8 JJHBE == 12)
1045 !---
1046 ELSE
1047 !---
1048! --------------------Second Group of solids : 3 lines to be read-----------------
1049 IF (ISOLNOD == 16) THEN
1050!
1051 SIZE = NPTT*NPTR*NLAY
1052 CALL HM_GET_FLOAT_ARRAY('sigma1' ,TMPVAL1,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1053 CALL HM_GET_FLOAT_ARRAY('sigma2' ,TMPVAL2,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1054 CALL HM_GET_FLOAT_ARRAY('sigma3' ,TMPVAL3,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1055 CALL HM_GET_FLOAT_ARRAY('sigma12' ,TMPVAL4,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1056 CALL HM_GET_FLOAT_ARRAY('sigma23' ,TMPVAL5,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1057 CALL HM_GET_FLOAT_ARRAY('sigma31' ,TMPVAL6,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1058 CALL HM_GET_FLOAT_ARRAY('epsilon_p' ,TMPVAL7,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1059 CALL HM_GET_FLOAT_ARRAY('e_int' ,TMPVAL8,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1060 CALL HM_GET_FLOAT_ARRAY('rho' ,TMPVAL9,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
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 ! DO JL=1,NLAY
1093 ENDDO ! DO JR=1,NPTR
1094 ENDDO ! DO JT=1,NPTT
1095!
1096 ELSEIF (ISOLNOD == 20) THEN
1097!
1098 SIZE = NPTT*NPTS*NPTR
1099 CALL HM_GET_FLOAT_ARRAY('sigma1' ,TMPVAL1,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1100 CALL HM_GET_FLOAT_ARRAY('sigma2' ,TMPVAL2,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1101 CALL HM_GET_FLOAT_ARRAY('sigma3' ,TMPVAL3,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1102 CALL HM_GET_FLOAT_ARRAY('sigma12' ,TMPVAL4,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1103 CALL HM_GET_FLOAT_ARRAY('sigma23' ,TMPVAL5,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1104 CALL HM_GET_FLOAT_ARRAY('sigma31' ,TMPVAL6,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1105 CALL HM_GET_FLOAT_ARRAY('epsilon_p' ,TMPVAL7,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1106 CALL HM_GET_FLOAT_ARRAY('e_int' ,TMPVAL8,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1107 CALL HM_GET_FLOAT_ARRAY('rho' ,TMPVAL9,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
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 ! DO JT=1,NPTT
1140 ENDDO ! DO JS=1,NPTS
1141 ENDDO ! DO JR=1,NPTR
1142!
1143 ELSE
1144!
1145 IF (IGTYP == 22) THEN
1146!
1147 SIZE = NPTR*NPTS*NPTT
1148 CALL HM_GET_FLOAT_ARRAY('sigma1' ,TMPVAL1,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1149 CALL HM_GET_FLOAT_ARRAY('sigma2' ,TMPVAL2,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1150 CALL HM_GET_FLOAT_ARRAY('sigma3' ,TMPVAL3,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1151 CALL HM_GET_FLOAT_ARRAY('sigma12' ,TMPVAL4,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1152 CALL HM_GET_FLOAT_ARRAY('sigma23' ,TMPVAL5,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1153 CALL HM_GET_FLOAT_ARRAY('sigma31' ,TMPVAL6,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1154 CALL HM_GET_FLOAT_ARRAY('epsilon_p' ,TMPVAL7,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1155 CALL HM_GET_FLOAT_ARRAY('e_int' ,TMPVAL8,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1156 CALL HM_GET_FLOAT_ARRAY('rho' ,TMPVAL9,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
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 ! DO JT=1,NPTT
1189 ENDDO ! DO JS=1,NPTS
1190 ENDDO ! DO JR=1,NPTR
1191!
1192 ELSE ! (IGTYP /= 22)
1193!
1194 SIZE = NPT
1195 CALL HM_GET_FLOAT_ARRAY('sigma1' ,TMPVAL1,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1196 CALL HM_GET_FLOAT_ARRAY('sigma2' ,TMPVAL2,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1197 CALL HM_GET_FLOAT_ARRAY('sigma3' ,TMPVAL3,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1198 CALL HM_GET_FLOAT_ARRAY('sigma12' ,TMPVAL4,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1199 CALL HM_GET_FLOAT_ARRAY('sigma23' ,TMPVAL5,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1200 CALL HM_GET_FLOAT_ARRAY('sigma31' ,TMPVAL6,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1201 CALL HM_GET_FLOAT_ARRAY('epsilon_p' ,TMPVAL7,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1202 CALL HM_GET_FLOAT_ARRAY('e_int' ,TMPVAL8,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1203 CALL HM_GET_FLOAT_ARRAY('rho' ,TMPVAL9,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
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 ! DO K=1,NPT
1227 ENDIF ! IF (IGTYP == 22)
1228 ENDIF ! IF (ISOLNOD == 16)
1229.AND. ENDIF ! IF ( (ISOLNOD == 8 ...)
1230 ENDIF ! IF (IE == 0)
1231!
1232 IF (IGBR > 0) THEN
1233 I1 = I
1234 DO K = 2,IGRBRIC(JGBR)%NENTITY
1235 IE = IGRBRIC(JGBR)%ENTITY(K)
1236 CALL LEC_INISTATE_D00_BRICK_CHECK (
1237 1 IXS ,IGEO ,ITRIS ,ISOLNODD00 ,IE ,
1238 2 NPT ,NLAY ,ISOLNOD ,JJHBE ,IGTYP ,
1239 3 ISROT ,KEYWORD )
1240!! IF (BRIGLOB == 1) STRSGLOB(IE)=1
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 ! DO K = 2,IGRBRIC(JGBR)%NENTITY
1252 ENDIF ! IF (IGBR > 0)
1253!
1254 ENDDO ! DO J=1,NB_ELEMENTS
1255
1256C---------
1257 CASE ( 'stra_f' )
1258C---------
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 ! Reading --- ID_ELEM, .... ---
1266 CALL HM_GET_INT_ARRAY_INDEX('brick_id' ,ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
1267 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NPT,J,IS_AVAILABLE,LSUBMODEL)
1268 CALL HM_GET_INT_ARRAY_INDEX('isolnod' ,ISOLNOD,J,IS_AVAILABLE,LSUBMODEL)
1269 CALL HM_GET_INT_ARRAY_INDEX('isolid' ,JJHBE,J,IS_AVAILABLE,LSUBMODEL)
1270 CALL HM_GET_INT_ARRAY_INDEX('nptr' ,NPTR,J,IS_AVAILABLE,LSUBMODEL)
1271 CALL HM_GET_INT_ARRAY_INDEX('npts' ,NPTS,J,IS_AVAILABLE,LSUBMODEL)
1272 CALL HM_GET_INT_ARRAY_INDEX('nptt' ,nptt,j,is_available,lsubmodel)
1273 CALL hm_get_int_array_index('nlay' ,nlay,j,is_available,lsubmodel)
1274!
1275 i=i+1
1276 IF (jjhbe == 2) jjhbe = 1
1277 id_solid_sigi(i) = id_elem
1278!
1279! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISOLM,NUMELS)
1280! IE = MAP_TABLES%ISOLM(ELT,2)
1281!
1282 ie=uel2sys(id_elem,ksysusrs,numels)
1283C STRAGLOB(IE)=0 -> strain read in element system
1284C STRAGLOB(IE)=1 -> strain read in global reference system
1285C STRAGLOB(IE)=10-> reference configuration /INIBRI/EREF
1286!
1287 IF (ie == 0) THEN
1288 ! Solid was not found. Issue a Warning & Skip.
1289 nonexist = nonexist+1
1290 ELSEIF (straglob(ie)>=0) THEN
1291 ELSE
1292 CALL lec_inistate_d00_brick_check (
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
1301 CALL hm_get_float_array('EPSILON_1' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
1302 CALL hm_get_float_array('EPSILON_2' ,tmpval2,SIZE,j,is_available,lsubmodel,unitab)
1303 CALL hm_get_float_array('EPSILON_3' ,tmpval3,SIZE,j,is_available,lsubmodel,unitab)
1304 CALL hm_get_float_array('EPSILON_12' ,tmpval4,SIZE,j,is_available,lsubmodel,unitab)
1305 CALL hm_get_float_array('EPSILON_23' ,tmpval5,SIZE,j,is_available,lsubmodel,unitab)
1306 CALL hm_get_float_array('EPSILON_31' ,tmpval6,SIZE,j,is_available,lsubmodel,unitab)
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 ! DO JL=1,NLAY
1333 ENDDO ! DO JR=1,NPTR
1334 ENDDO ! DO JT=1,NPTT
1335!
1336 ELSEIF ( isolnod == 20 ) THEN
1337!
1338 SIZE = nptt*npts*nptr
1339 CALL hm_get_float_array('EPSILON_1' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
1340 CALL hm_get_float_array('EPSILON_2' ,tmpval2,SIZE,j,is_available,lsubmodel,unitab)
1341 CALL hm_get_float_array('EPSILON_3' ,tmpval3,SIZE,j,is_available,lsubmodel,unitab)
1342 CALL hm_get_float_array('EPSILON_12' ,tmpval4,SIZE,j,is_available,lsubmodel,unitab)
1343 CALL hm_get_float_array('EPSILON_23' ,tmpval5,SIZE,j,is_available,lsubmodel,unitab)
1344 CALL hm_get_float_array('EPSILON_31' ,tmpval6,SIZE,j,is_available,lsubmodel,unitab)
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 ! DO JR=1,NPTR
1371 ENDDO ! DO JS=1,NPTS
1372 ENDDO ! DO JT=1,NPTT
1373!
1374 ELSEIF ((igtyp == 21 .OR. igtyp == 22) .AND. jjhbe == 14) THEN
1375!
1376 SIZE = nptr*npts*nptt
1377 CALL hm_get_float_array('EPSILON_1' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
1378 CALL hm_get_float_array('EPSILON_2' ,tmpval2,SIZE,j,is_available,lsubmodel,unitab)
1379 CALL hm_get_float_array('EPSILON_3' ,tmpval3,SIZE,j,is_available,lsubmodel,unitab)
1380 CALL hm_get_float_array('EPSILON_12' ,tmpval4,SIZE,j,is_available,lsubmodel,unitab)
1381 CALL hm_get_float_array('EPSILON_23' ,tmpval5,SIZE,j,is_available,lsubmodel,unitab)
1382 CALL hm_get_float_array('EPSILON_31' ,tmpval6,SIZE,j,is_available,lsubmodel,unitab)
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 ! DO JT=1,NPTT
1409 ENDDO ! DO JS=1,NPTS
1410 ENDDO ! DO JR=1,NPTR
1411!
1412 ELSE
1413!
1414 SIZE = npt
1415 CALL hm_get_float_array('EPSILON_1' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
1416 CALL hm_get_float_array('EPSILON_2' ,tmpval2,SIZE,j,is_available,lsubmodel,unitab)
1417 CALL hm_get_float_array('EPSILON_3' ,tmpval3,SIZE,j,is_available,lsubmodel,unitab)
1418 CALL hm_get_float_array('epsilon_12' ,TMPVAL4,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1419 CALL HM_GET_FLOAT_ARRAY('epsilon_23' ,TMPVAL5,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1420 CALL HM_GET_FLOAT_ARRAY('epsilon_31' ,TMPVAL6,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
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 ! DO K=1,NPT
1438
1439!
1440 ENDIF ! IF ( ISOLNOD == 16 )
1441 ENDIF ! IF (IE == 0)
1442 ENDDO ! DO J=1,NB_ELEMENTS
1443
1444C---------
1445 CASE ( 'stra_fglo' )
1446C---------
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 ! Reading --- ID_ELEM, .... ---
1455 CALL HM_GET_INT_ARRAY_INDEX('brick_id' ,ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
1456 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NPT,J,IS_AVAILABLE,LSUBMODEL)
1457 CALL HM_GET_INT_ARRAY_INDEX('isolnod' ,ISOLNOD,J,IS_AVAILABLE,LSUBMODEL)
1458 CALL HM_GET_INT_ARRAY_INDEX('isolid' ,JJHBE,J,IS_AVAILABLE,LSUBMODEL)
1459 CALL HM_GET_INT_ARRAY_INDEX('nptr' ,NPTR,J,IS_AVAILABLE,LSUBMODEL)
1460 CALL HM_GET_INT_ARRAY_INDEX('npts' ,NPTS,J,IS_AVAILABLE,LSUBMODEL)
1461 CALL HM_GET_INT_ARRAY_INDEX('nptt' ,NPTT,J,IS_AVAILABLE,LSUBMODEL)
1462 CALL HM_GET_INT_ARRAY_INDEX('nlay' ,NLAY,J,IS_AVAILABLE,LSUBMODEL)
1463!
1464 I=I+1
1465 IF (JJHBE == 2) JJHBE = 1
1466 ID_SOLID_SIGI(I) = ID_ELEM
1467!
1468! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISOLM,NUMELS)
1469! IE = MAP_TABLES%ISOLM(ELT,2)
1470!
1471 IE=UEL2SYS(ID_ELEM,KSYSUSRS,NUMELS)
1472C STRAGLOB(IE)=0 -> strain read in element system
1473C STRAGLOB(IE)=1 -> strain read in global reference system
1474C STRAGLOB(IE)=10-> reference configuration /INIBRI/EREF
1475!
1476!
1477 IF (IE == 0) THEN
1478 ! Solid was not found. Issue a Warning & Skip.
1479 NONEXIST = NONEXIST+1
1480 ELSEIF (STRAGLOB(IE)>=0) THEN
1481 ELSE
1482 CALL LEC_INISTATE_D00_BRICK_CHECK (
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
1491 CALL HM_GET_FLOAT_ARRAY('epsilon_1' ,TMPVAL1,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1492 CALL HM_GET_FLOAT_ARRAY('epsilon_2' ,TMPVAL2,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
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 ELSEIF ((igtyp == 21 .OR. igtyp == 22) .AND. 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
1633C---------
1634 CASE ( 'FAIL' )
1635C---------
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 IF (ifail == nfail(k) .AND.
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
1720C---------
1721 CASE ( 'SCALE_YLD' )
1722C---------
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
1775C---------
1776 CASE ( 'ORTHO' )
1777C---------
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!! . (IGTYP /= 21 .AND. IGTYP /= 22)) THEN
1812 IF (igtyp /= 21 .AND. 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 ENDIF ! IF (IGTYP /= 21 .AND. IGTYP /= 22)
1842!
1843 ENDIF ! IF (IE == 0)
1844 ENDDO ! DO J=1,NB_ELEMENTS
1845
1846C---------
1847 CASE ( 'EREF' )
1848C---------
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 )
1879C
1880C---------!!!add check Ismstr
1881 pid = ixs(10,ie)
1882 ng = ies2iparg(ie)
1883 ismrad = iparg(9,ng)
1884 IF (ismrad/=ismstr.OR.(ismstr/=1.AND.ismstr<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
1898 CALL hm_get_float_array('Xref' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
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 IF(sub_id /= 0 .AND.(ismstr==1.OR.ismstr==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 IF(sub_id /= 0 .AND.(ismstr==1.OR.ismstr==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
1933C---------
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
1957C sorting elements of D00 by ascending id (sorted only once)
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 IF (uid /= 0.AND.iflagunit == 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
1995c---------------------------------------
1996 SELECT CASE (key(1:len_trim(key)))
1997C---------
1998 CASE ( 'EPSP_F' )
1999C---------
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 IF (ihbe==12 .OR. 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
2099C---------
2100 CASE ( 'STRS_F' )
2101C---------
2102 isigsh =1
2103C------------------------------------
2104! --- 'STRS_F/GLOB' ---
2105C------------------------------------
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! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH4NM,NUMELC)
2117! IE = MAP_TABLES%ISH4NM(ELT,2)
2118!
2119 ie=uel2sys(id_elem,ksysusr,numelc)
2120!
2121 IF (ie == 0) THEN
2122 ! Shell was not found. Issue a Warning & Skip.
2123 nonexist = nonexist+1
2124 ELSE
2125!
2126 ! check is SHELL is QEPH
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)
2136 CALL ancmsg(msgid=26,
2137 . anmode=aninfo,
2138 . msgtype=msgerror,
2139 . i1=igeo(1,ig),
2140 . c1=titr,
2141 . i2=id_elem)
2142 ENDIF
2143!
2144 ! Reading CARD_1 --- EM,EB,H1,H2,H3 ---
2145 CALL hm_get_float_array_index('Em',em,j,is_available,lsubmodel,unitab)
2146 CALL hm_get_float_array_index('Eb',eb,j,is_available,lsubmodel,unitab)
2147 CALL hm_get_float_array_index('H1',h1,j,is_available,lsubmodel,unitab)
2148 CALL hm_get_float_array_index('H2',h2,j,is_available,lsubmodel,unitab)
2149 CALL hm_get_float_array_index('H3',h3,j,is_available,lsubmodel,unitab)
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 ! Reading CARD_2 --- sigma_X, sigma_Y, sigma_Z ---
2169 CALL hm_get_float_array('sigma_X',sigsh(22,i),1,j,is_available,lsubmodel,unitab)
2170 CALL hm_get_float_array('sigma_Y',sigsh(23,i),1,j,is_available,lsubmodel,unitab)
2171 CALL hm_get_float_array('sigma_Z',sigsh(18,i),1,j,is_available,lsubmodel,unitab)
2172 ! Reading CARD_3 --- sigma_XY, sigma_YZ, sigma_ZX ---
2173 CALL hm_get_float_array('sigma_XY',sigsh(24,i),1,j,is_available,lsubmodel,unitab)
2174 CALL hm_get_float_array('sigma_YZ',sigsh(25,i),1,j,is_available,lsubmodel,unitab)
2175 CALL hm_get_float_array('sigma_ZX',sigsh(26,i),1,j,is_available,lsubmodel,unitab)
2176!
2177 ! Reading CARD_4 --- sigma_bX, sigma_bY, sigma_bZ ---
2178 CALL hm_get_float_array('sigma_bX',sigsh(28,i),1,j,is_available,lsubmodel,unitab)
2179 CALL hm_get_float_array('sigma_bY',sigsh(29,i),1,j,is_available,lsubmodel,unitab)
2180 CALL hm_get_float_array('sigma_bZ',sigsh(19,i),1,j,is_available,lsubmodel,unitab)
2181 ! Reading CARD_5 --- sigma_bXY, sigma_bYZ, sigma_bZX, eps_p ---
2182 CALL hm_get_float_array('sigma_bXY',sigsh(30,i),1,j,is_available,lsubmodel,unitab)
2183 CALL hm_get_float_array('sigma_bYZ',sigsh(20,i),1,j,is_available,lsubmodel,unitab)
2184 CALL hm_get_float_array('sigma_bZX',sigsh(21,i),1,j,is_available,lsubmodel,unitab)
2185 CALL hm_get_float_array('eps_p' ,sigsh(27,i),1,j,is_available,lsubmodel,unitab)
2186!
2187 ELSEIF (nip /= 0) THEN
2188!
2189 SIZE = nip
2190 CALL hm_get_float_array('sigma_X' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
2191 CALL hm_get_float_array('sigma_Y' ,tmpval2,SIZE,j,is_available,lsubmodel,unitab)
2192 CALL hm_get_float_array('sigma_Z' ,tmpval3,SIZE,j,is_available,lsubmodel,unitab)
2193 CALL hm_get_float_array('sigma_XY',tmpval4,SIZE,j,is_available,lsubmodel,unitab)
2194 CALL hm_get_float_array('sigma_YZ',tmpval5,SIZE,j,is_available,lsubmodel,unitab)
2195 CALL hm_get_float_array('sigma_ZX',tmpval6,SIZE,j,is_available,lsubmodel,unitab)
2196 CALL hm_get_float_array('eps_p' ,tmpval7,SIZE,j,is_available,lsubmodel,unitab)
2197 CALL hm_get_float_array('pos_nip' ,tmpval8,SIZE,j,is_available,lsubmodel,unitab)
2198C------------potision Ti [-1,1] 'pos_nip' ---> undocumented FIELD
2199!
2200 inishvar = 22 + nip*6
2201 DO n=1,nip
2202 pt = 22 + (n-1)*6
2203 ! Reading CARD_2 --- sigma_X, sigma_Y, sigma_Z ---
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 ! DO K=1,NIP
2213 ENDIF ! IF (NIP = 0) THEN
2214!----
2215 ELSEIF (npg > 1) THEN
2216!----
2217 sigsh(nvshell,i) = npg
2218!
2219 IF (nip == 0) THEN
2220!
2221 SIZE = npg
2222 CALL hm_get_float_array('sigma_X' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
2223 CALL hm_get_float_array('sigma_Y' ,tmpval2,SIZE,j,is_available,lsubmodel,unitab)
2224 CALL hm_get_float_array('sigma_Z' ,tmpval3,SIZE,j,is_available,lsubmodel,unitab)
2225 CALL hm_get_float_array('sigma_XY' ,tmpval4,SIZE,j,is_available,lsubmodel,unitab)
2226 CALL hm_get_float_array('sigma_YZ' ,tmpval5,SIZE,j,is_available,lsubmodel,unitab)
2227 CALL hm_get_float_array('sigma_ZX' ,tmpval6,SIZE,j,is_available,lsubmodel,unitab)
2228 CALL hm_get_float_array('sigma_bX' ,tmpval7,SIZE,j,is_available,lsubmodel,unitab)
2229 CALL hm_get_float_array('sigma_bY' ,tmpval8,SIZE,j,is_available,lsubmodel,unitab)
2230 CALL hm_get_float_array('sigma_bZ' ,tmpval9,SIZE,j,is_available,lsubmodel,unitab)
2231 CALL hm_get_float_array('sigma_bXY',tmpval10,SIZE,j,is_available,lsubmodel,unitab)
2232 CALL hm_get_float_array('sigma_bYZ',tmpval11,SIZE,j,is_available,lsubmodel,unitab)
2233 CALL hm_get_float_array('sigma_bZX',tmpval12,SIZE,j,is_available,lsubmodel,unitab)
2234 CALL hm_get_float_array('eps_p' ,tmpval13,SIZE,j,is_available,lsubmodel,unitab)
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 ! DO K=1,NPG
2253!
2254 ELSE ! NIP > 0
2255!
2256 SIZE = nip*npg
2257 CALL hm_get_float_array('sigma_X' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
2258 CALL hm_get_float_array('sigma_Y' ,tmpval2,SIZE,j,is_available,lsubmodel,unitab)
2259 CALL hm_get_float_array('sigma_Z' ,tmpval3,SIZE,j,is_available,lsubmodel,unitab)
2260 CALL hm_get_float_array('sigma_XY',tmpval4,SIZE,j,is_available,lsubmodel,unitab)
2261 CALL hm_get_float_array('sigma_YZ',tmpval5,SIZE,j,is_available,lsubmodel,unitab)
2262 CALL hm_get_float_array('sigma_ZX',tmpval6,SIZE,j,is_available,lsubmodel,unitab)
2263 CALL hm_get_float_array('eps_p' ,tmpval7,SIZE,j,is_available,lsubmodel,unitab)
2264 CALL hm_get_float_array('pos_nip' ,tmpval8,SIZE,j,is_available,lsubmodel,unitab)
2265C------------potision Ti [-1,1] 'pos_nip' ---> undocumented FIELD
2266!
2267 pt = 22
2268 DO n=1,nip
2269 DO k=1,npg
2270 l = (n-1)*npg+k
2271 ! Reading CARD_2 --- sigma_X, sigma_Y, sigma_Z ---
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 ! DO N=1,NPG
2282 ENDDO ! DO N=1,NIP
2283 ENDIF ! IF (NIP == 0) THEN
2284!----
2285 ENDIF ! IF (NPG == 0 .OR. NPG == 1)
2286!----
2287 ENDIF ! IF (IE == 0)
2288 ENDDO ! DO I=1,NB_ELEMENTS
2289C------------------------------------
2290! --- 'STRS_F' ---
2291C------------------------------------
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 ! Reading CARD_1 --- ID_ELEM, NIP, NPG, THK ---
2298 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
2299 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
2300 CALL hm_get_int_array_index('npg',npg,j,is_available,lsubmodel)
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 IF (ihbe==12 .OR. 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 IF (npg == 0 .OR. 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+5,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 ENDIF ! IF (NPG == 0 .OR. NPG == 1)
2452!----
2453 ENDIF ! IF (IE == 0)
2454 ENDDO ! DO I=1,NB_ELEMENTS
2455 ENDIF ! IF ( GLOB )
2456C---------
2457 CASE ( 'STRA_F' )
2458C---------
2459C-------- use ITHKSHEL instead of ISIGSH to avoid memory issue in case of STRA_F w/o STRS_F
2460 ithkshel =2
2461C-------global sys with diff format
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
2488C----
2489 IF (npg == 0 .OR. 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
2494C----look at how to orginase SIGSH(,I)
2495 sigsh(nvshell,i) = npg
2496 ELSE
2497C CALL ANCERR(58,ANINFO_BLIND_2)
2498 ENDIF ! IF (NPG == 0 .OR. NPG == 1)
2499 pt = inishvar1
2500 IF (ihbe==24) THEN
2501 sigsh(inishvar1,i) = max(1,npg) !have to use this since SIGSH(NVSHELL,I) is used also for stress
2502 pt = pt +1
2503 END IF
2504 npp = nip
2505 IF (npp==0) npp=2
2506!===============================================
2507 SIZE = npp*npg
2508 CALL hm_get_float_array('eps_XX' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
2509 CALL hm_get_float_array('eps_YY' ,tmpval2,SIZE,j,is_available,lsubmodel,unitab)
2510 CALL hm_get_float_array('eps_ZZ' ,tmpval3,SIZE,j,is_available,lsubmodel,unitab)
2511 CALL hm_get_float_array('eps_XY' ,tmpval4,SIZE,j,is_available,lsubmodel,unitab)
2512 CALL hm_get_float_array('eps_YZ' ,tmpval5,SIZE,j,is_available,lsubmodel,unitab)
2513 CALL hm_get_float_array('eps_ZX' ,tmpval6,SIZE,j,is_available,lsubmodel,unitab)
2514 CALL hm_get_float_array('T' ,tmpval7,SIZE,j,is_available,lsubmodel,unitab)
2515!
2516 DO n=1,min(2,npp)
2517 DO ipg=1,max(1,npg)
2518 l = (n-1)*max(1,npg)+ipg
2519 sigsh(pt ,i) = tmpval1(l)
2520 sigsh(pt+1,i) = tmpval2(l)
2521 sigsh(pt+2,i) = tmpval3(l)
2522 sigsh(pt+3,i) = tmpval4(l)
2523 sigsh(pt+4,i) = tmpval5(l)
2524 sigsh(pt+5,i) = tmpval6(l)
2525 sigsh(pt+6,i) = tmpval7(l)
2526 pt=pt+7
2527 ENDDO
2528 ENDDO
2529!===============================================
2530 ENDIF ! IF (IE == 0) THEN
2531 ENDDO ! DO J=1,NB_ELEMENTS
2532!
2533 ELSEIF (.NOT. glob ) THEN
2534!
2535 CALL hm_get_intv('inishe_stra_f_count',nb_elements,is_available,lsubmodel)
2536!
2537 DO j=1,nb_elements
2538 ! Reading CARD_1 --- ID_ELEM, NIP, NPG, THK ---
2539 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
2540 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
2541 CALL hm_get_int_array_index('npg',npg,j,is_available,lsubmodel)
2542 CALL hm_get_float_array_index('Thick',thk,j,is_available,lsubmodel,unitab)
2543!
2544! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH4NM,NUMELC)
2545! IE = MAP_TABLES%ISH4NM(ELT,2)
2546!
2547 ie=uel2sys(id_elem,ksysusr,numelc)
2548!
2549 IF (ie == 0) THEN
2550 ! Shell was not found. Issue a Warning & Skip.
2551 nonexist = nonexist+1
2552 ELSE
2553 i = ptshel(ie)
2554 sigsh(1,i) = id_elem
2555 id_sigsh(i) = id_elem
2556 sigsh(3,i) = thk
2557 sigsh(nvshell - 1 , i) = one
2558!
2559 IF (npg == 0 .OR. npg == 1) THEN
2560!
2561 ig = ixc(6,ie)
2562 ihbe = igeo(10,ig)
2563 IF (ihbe==24) sigsh(nvshell,i) = 4
2564!
2565 CALL hm_get_float_array('eps_1' ,sigsh(6,i),1,j,is_available,lsubmodel,unitab)
2566 CALL hm_get_float_array('eps_2' ,sigsh(7,i),1,j,is_available,lsubmodel,unitab)
2567 CALL hm_get_float_array('eps_12' ,sigsh(8,i),1,j,is_available,lsubmodel,unitab)
2568 CALL hm_get_float_array('eps_23' ,sigsh(9,i),1,j,is_available,lsubmodel,unitab)
2569 CALL hm_get_float_array('eps_31' ,sigsh(10,i),1,j,is_available,lsubmodel,unitab)
2570 CALL hm_get_float_array('k1' ,sigsh(11,i),1,j,is_available,lsubmodel,unitab)
2571 CALL hm_get_float_array('k2' ,sigsh(12,i),1,j,is_available,lsubmodel,unitab)
2572 CALL hm_get_float_array('k12' ,sigsh(13,i),1,j,is_available,lsubmodel,unitab)
2573!
2574 ELSEIF (npg>1 ) THEN
2575!
2576 sigsh(nvshell,i) = npg
2577
2578 sigsh(6,i) =zero
2579 sigsh(7,i) =zero
2580 sigsh(8,i) =zero
2581 sigsh(9,i) =zero
2582 sigsh(10,i)=zero
2583 sigsh(11,i)=zero
2584 sigsh(12,i)=zero
2585 sigsh(13,i)=zero
2586!
2587 SIZE = npg
2588 CALL hm_get_float_array('eps_1' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
2589 CALL hm_get_float_array('eps_2' ,tmpval2,SIZE,j,is_available,lsubmodel,unitab)
2590 CALL hm_get_float_array('eps_12' ,tmpval3,SIZE,j,is_available,lsubmodel,unitab)
2591 CALL hm_get_float_array('eps_23' ,tmpval4,SIZE,j,is_available,lsubmodel,unitab)
2592 CALL hm_get_float_array('eps_31' ,tmpval5,SIZE,j,is_available,lsubmodel,unitab)
2593 CALL hm_get_float_array('k1' ,tmpval6,SIZE,j,is_available,lsubmodel,unitab)
2594 CALL hm_get_float_array('k2' ,tmpval7,SIZE,j,is_available,lsubmodel,unitab)
2595 CALL hm_get_float_array('k12' ,tmpval8,SIZE,j,is_available,lsubmodel,unitab)
2596!
2597 DO ipg=1,npg
2598! average only :
2599 sigsh(6,i) =sigsh(6,i) +tmpval1(ipg)/npg
2600 sigsh(7,i) =sigsh(7,i) +tmpval2(ipg)/npg
2601 sigsh(8,i) =sigsh(8,i) +tmpval3(ipg)/npg
2602 sigsh(9,i) =sigsh(9,i) +tmpval4(ipg)/npg
2603 sigsh(10,i)=sigsh(10,i)+tmpval5(ipg)/npg
2604 sigsh(11,i)=sigsh(11,i)+tmpval6(ipg)/npg
2605 sigsh(12,i)=sigsh(12,i)+tmpval7(ipg)/npg
2606 sigsh(13,i)=sigsh(13,i)+tmpval8(ipg)/npg
2607 END DO
2608 ELSE
2609C CALL ANCERR(58,ANINFO_BLIND_2)
2610 ENDIF ! IF (NPG == 0 .OR. NPG == 1)
2611 ENDIF ! IF (IE == 0) THEN
2612 ENDDO ! DO J=1,NB_ELEMENTS
2613 ENDIF ! IF ( GLOB ) THEN
2614
2615C---------
2616 CASE ( 'THICK' )
2617C---------
2618 ithkshel = 1
2619!
2620 CALL hm_get_intv('no_elems',nb_elements,is_available,lsubmodel)
2621!
2622 DO j=1,nb_elements
2623 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
2624 CALL hm_get_float_array_index('Thick' ,thk,j,is_available,lsubmodel,unitab)
2625!
2626!
2627! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH4NM,NUMELC)
2628! IE = MAP_TABLES%ISH4NM(ELT,2)
2629!
2630 ie=uel2sys(id_elem,ksysusr,numelc)
2631!
2632 IF (ie == 0) THEN
2633 ! Shell was not found. Issue a Warning & Skip.
2634 nonexist = nonexist+1
2635 ELSE
2636 i = ptshel(ie)
2637 sigsh(1,i) = id_elem
2638 id_sigsh(i) = id_elem
2639 sigsh(2,i) = 0
2640 sigsh(3,i) = thk
2641 ENDIF ! IF (IE == 0)
2642 ENDDO ! DO J=1,NB_ELEMENTS
2643C---------
2644 CASE ( 'EPSP' )
2645C---------
2646!
2647 CALL hm_get_intv('no_blocks',nb_elements,is_available,lsubmodel)
2648!
2649 DO j=1,nb_elements
2650 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
2651 CALL hm_get_float_array_index('Ep' ,epsp,j,is_available,lsubmodel,unitab)
2652!
2653!
2654! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH4NM,NUMELC)
2655! IE = MAP_TABLES%ISH4NM(ELT,2)
2656!
2657 ie=uel2sys(id_elem,ksysusr,numelc)
2658!
2659 IF (ie == 0) THEN
2660 ! Shell was not found. Issue a Warning & Skip.
2661 nonexist = nonexist+1
2662 ELSE
2663 i = ptshel(ie)
2664 sigsh(1,i) = id_elem
2665 id_sigsh(i) = id_elem
2666 sigsh(2,i) = 0
2667 sigsh(27,i)= epsp
2668 ENDIF ! IF (IE == 0) THEN
2669 ENDDO ! DO J=1,NB_ELEMENTS
2670!-------------------
2671 CASE ( 'ORTHO' )
2672!-------------------
2673 CALL hm_get_intv('inishe_ortho_count',nb_elements,is_available,lsubmodel)
2674!
2675 DO j=1,nb_elements
2676 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
2677 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
2678!! CALL HM_GET_INT_ARRAY_INDEX('prop_type',IGTYP,J,IS_AVAILABLE,LSUBMODEL)
2679 CALL hm_get_float_array_index('Vx',vx,j,is_available,lsubmodel,unitab)
2680 CALL hm_get_float_array_index('Vy',vy,j,is_available,lsubmodel,unitab)
2681 CALL hm_get_float_array_index('Vz',vz,j,is_available,lsubmodel,unitab)
2682!
2683! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH4NM,NUMELC)
2684! IE = MAP_TABLES%ISH4NM(ELT,2)
2685!
2686 ie=uel2sys(id_elem,ksysusr,numelc)
2687!
2688 IF (ie == 0) THEN
2689 ! Shell was not found. Issue a Warning & Skip.
2690 nonexist = nonexist+1
2691 ELSE
2692!
2693 ig = ixc(6,ie)
2694 ihbe = igeo(10,ig)
2695 igtyp=igeo(11,ig)
2696 iortshel = 1
2697 i = ptshel(ie)
2698 pt = nvshell + nushell
2699 sigsh(1,i) = id_elem
2700 id_sigsh(i) = id_elem
2701 IF ( igtyp == 9) nip = nint(geo(npropg*(ig-1)+6))
2702 sigsh(pt + 4 ,i) = nip
2703 sigsh(pt + 5 ,i) = one
2704 IF( ihbe==12 .OR. ihbe==24) THEN
2705 sigsh(nvshell,i) = 4
2706 ELSE
2707 sigsh(nvshell,i) = 1
2708 ENDIF
2709 sigsh(pt+1,i) = vx
2710 sigsh(pt+2,i) = vy
2711 sigsh(pt+3,i) = vz
2712 pt = pt + 5
2713 IF ( igtyp == 9 ) THEN
2714 CALL hm_get_float_array_index('phi_1',phi1,j,is_available,lsubmodel,unitab)
2715 CALL hm_get_float_array_index('phi_2',phi2,j,is_available,lsubmodel,unitab)
2716 sigsh(pt+1,i) = phi1*pi/hundred80
2717 sigsh(pt+2,i) = phi2*pi/hundred80
2718 pt = pt + 2
2719 ELSEIF (igtyp == 1 ) THEN
2720 CALL ancmsg(msgid=761,
2721 . msgtype=msgerror,
2722 . anmode=aninfo,
2723 . c1='/INISHE/ORTHO',
2724 . c2='SHELL',
2725 . i2=id_elem,i1=igeo(1,ig))
2726 ELSE
2727 SIZE = nip
2728 CALL hm_get_float_array('phi_1_array',tmpval1,SIZE,j,is_available,lsubmodel,unitab)
2729 CALL hm_get_float_array('phi_2_array',tmpval2,SIZE,j,is_available,lsubmodel,unitab)
2730 DO jj = 1,nip
2731 sigsh(pt+1,i) = tmpval1(jj)*pi/hundred80
2732 sigsh(pt+2,i) = tmpval2(jj)*pi/hundred80
2733 pt = pt + 2
2734 ENDDO ! DO JJ = 1,NIP
2735 ENDIF ! IF ( IGTYP == 9)
2736 ENDIF ! IF (IE == 0) THEN
2737 ENDDO ! DO J=1,NB_ELEMENTS
2738!-------------------
2739 CASE ( 'ORTH_LOC' )
2740!-------------------
2741 CALL hm_get_intv('inishe_orth_loc_count',nb_elements,is_available,lsubmodel)
2742!
2743 DO j=1,nb_elements
2744 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
2745 CALL hm_get_int_array_index('nb_lay',nip,j,is_available,lsubmodel)
2746 CALL hm_get_int_array_index('npg',npg,j,is_available,lsubmodel)
2747 CALL hm_get_int_array_index('ndir',ndir,j,is_available,lsubmodel)
2748 CALL hm_get_int_array_index('Iunit',flagdeg,j,is_available,lsubmodel)
2749!
2750!
2751! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH4NM,NUMELC)
2752! IE = MAP_TABLES%ISH4NM(ELT,2)
2753!
2754 ie=uel2sys(id_elem,ksysusr,numelc)
2755!
2756 IF (ie == 0) THEN
2757 ! Shell was not found. Issue a Warning & Skip.
2758 nonexist = nonexist+1
2759 ELSE
2760!
2761 ig = ixc(6,ie)
2762 ihbe = igeo(10,ig)
2763 igtyp = igeo(11,ig)
2764 iortshel = 2
2765 i = ptshel(ie)
2766 pt = nvshell + nushell
2767 id_sigsh(i) = id_elem
2768 sigsh(1,i) = id_elem
2769 IF (igtyp == 9) nip = nint(geo(npropg*(ig-1)+6))
2770 sigsh(pt + 4,i) = nip
2771 sigsh(pt + 5,i) = one
2772 IF( ihbe==12 .OR. ihbe==24) THEN
2773 sigsh(nvshell,i) = 4
2774 ELSE
2775 sigsh(nvshell,i) = 1
2776 ENDIF
2777!
2778 pt = pt + 5
2779 IF (igtyp == 51 .OR. igtyp == 52) THEN
2780 isubstack = iworksh(3, ie)
2781 nlay = stack%IGEO(1,isubstack)
2782 ipmat = 2 + nlay
2783 IF (ndir /= 2) THEN
2784 DO jj = 1,nlay !
2785 mlawly= stack%IGEO(ipmat + jj,isubstack)! layer material
2786 IF (mlawly == 58) THEN
2787 CALL ancmsg(msgid=1126,
2788 . msgtype=msgerror,
2789 . anmode=aninfo,
2790 . c1='SHELL',
2791 . i1=id_elem)
2792 ENDIF
2793 ENDDO
2794 ENDIF
2795 ENDIF ! IF (IGTYP == 51 .OR. IGTYP == 52)
2796!
2797 SIZE = nip
2798 CALL hm_get_float_array('phi_i' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
2799 CALL hm_get_float_array('alpha_i',tmpval2,SIZE,j,is_available,lsubmodel,unitab)
2800!
2801 ALLOCATE(mlaw_ly(nip))
2802 mlaw_ly = 0
2803 IF (igtyp == 9) THEN
2804 angle1 = tmpval1(1) ! one integration point
2805 IF(flagdeg == 1) angle1 = angle1*pi/hundred80
2806 sigsh(pt+1,i) = cos(angle1)
2807 sigsh(pt+2,i) = sin(angle1)
2808 pt = pt + 2
2809 ELSEIF (igtyp == 10 .OR. igtyp == 11 .OR. igtyp == 16 .OR.
2810 . igtyp == 17 .OR. igtyp == 51 .OR. igtyp == 52) THEN
2811 IF (igtyp == 51 .OR. igtyp == 52)THEN
2812 isubstack = iworksh(3, ie)
2813 nlay = stack%IGEO(1,isubstack) !
2814 ipmat = 2 + nlay
2815 ipnpt_lay = ipmat + 2*nlay
2816 IF(nlay /= nip) THEN
2817 IF(ndrape > 0) THEN
2818 ipt = 0
2819 DO jj =1,nlay
2820 nslice = stack%IGEO(ipnpt_lay + jj,isubstack)
2821 DO n = 1, nslice
2822 ipt = ipt + 1
2823 mlaw_ly(ipt)= stack%IGEO(ipmat + jj,isubstack)
2824 ENDDO
2825 ENDDO
2826 ELSE
2827 ! error message
2828 ENDIF
2829 ELSE
2830 DO jj =1,nlay
2831 mlaw_ly(jj)= stack%IGEO(ipmat + jj,isubstack)! layer material
2832 ENDDO
2833 ENDIF
2834 ENDIF
2835 DO jj = 1,nip
2836 angle1 = tmpval1(jj)
2837 angle2 = tmpval2(jj)
2838 IF(flagdeg == 1) angle1 = angle1*pi/hundred80
2839 IF(flagdeg == 1) angle2 = angle2*pi/hundred80
2840!
2841 IF (igtyp == 16 .OR.
2842 . (igtyp == 51 .AND. mlaw_ly(jj) == 58) .OR.
2843 . (igtyp == 52 .AND. mlaw_ly(jj) == 58) ) THEN
2844!
2845 angle2 = angle2 + angle1
2846 sigsh(pt+1,i) = cos(angle1)
2847 sigsh(pt+2,i) = sin(angle1)
2848 sigsh(pt+3,i) = cos(angle2)
2849 sigsh(pt+4,i) = sin(angle2)
2850 pt = pt + 4
2851 ELSE
2852 sigsh(pt+1,i) = cos(angle1)
2853 sigsh(pt+2,i) = sin(angle1)
2854 pt = pt + 2
2855 ENDIF
2856 ENDDO ! DO JJ = 1,NIP
2857 ELSEIF (igtyp == 1) THEN
2858 CALL ancmsg(msgid=761,
2859 . msgtype=msgerror,
2860 . anmode=aninfo,
2861 . c1='/INISHE/ORTH_LOC',
2862 . c2='SHELL',
2863 . i2=id_elem,i1=igeo(1,ig))
2864 ENDIF ! IF (IGTYP == 9)
2865 IF(ALLOCATED(mlaw_ly))DEALLOCATE(mlaw_ly)
2866 ENDIF ! IF (IE == 0) THEN
2867 ENDDO ! DO J=1,NB_ELEMENTS
2868!-------------------
2869 CASE ( 'SCALE_YLD' )
2870!-------------------
2871 CALL hm_get_intv('inishe_scale_yld_count',nb_elements,is_available,lsubmodel)
2872 iyldini = 1
2873!
2874 DO j=1,nb_elements
2875 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
2876 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
2877 CALL hm_get_int_array_index('npg',npg,j,is_available,lsubmodel)
2878!
2879! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH4NM,NUMELC)
2880! IE = MAP_TABLES%ISH4NM(ELT,2)
2881!
2882 ie=uel2sys(id_elem,ksysusr,numelc)
2883!
2884 IF (ie == 0) THEN
2885 ! Shell was not found. Issue a Warning & Skip.
2886 nonexist = nonexist+1
2887 ELSE
2888 i = ptshel(ie)
2889 sigsh(nvshell + 1,i) = id_elem ! elt ID
2890 id_sigsh(i) = id_elem
2891 sigsh(nvshell + 2,i) = nip ! integ point
2892 sigsh(nvshell + 3,i) = npg
2893!
2894 SIZE = npg*nip
2895 pt = nvshell+nushell+nortshel+nvshell1+3
2896!
2897 CALL hm_get_float_array('Alpha_ij' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
2898!
2899 DO n = 1,npg
2900 DO ip = 1,nip
2901 l = (n-1)*nip+ip
2902!! PT=NVSHELL + 3 !22
2903 scaleyld = tmpval1(l)
2904 sigsh(pt+l,i) = scaleyld
2905 ENDDO !IP = 1,NIP
2906 ENDDO !N = 1,NPG
2907 pt = pt + nip * npg
2908!
2909 ENDIF ! IF (IE == 0) THEN
2910 ENDDO ! DO J=1,NB_ELEMENTS
2911!-------------------
2912 CASE ( 'AUX' )
2913!-------------------
2914 CALL hm_get_intv('inishe_aux_count',nb_elements,is_available,lsubmodel)
2915 DO j=1,nb_elements
2916 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
2917 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
2918 CALL hm_get_int_array_index('npg',npg,j,is_available,lsubmodel)
2919 CALL hm_get_int_array_index('nvars',nuvar,j,is_available,lsubmodel)
2920!
2921!
2922! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH4NM,NUMELC)
2923! IE = MAP_TABLES%ISH4NM(ELT,2)
2924!
2925 ie=uel2sys(id_elem,ksysusr,numelc)
2926!
2927 IF (ie == 0) THEN
2928 ! Shell was not found. Issue a Warning & Skip.
2929 nonexist = nonexist+1
2930 ELSE
2931C----------
2932 imat = ixc(1,ie)
2933 ilaw = ipm(2,imat)
2934 nuvard00 = ipm(8,imat)
2935 IF (nuvard00 > nuvar) THEN
2936 CALL ancmsg(msgid=1121,
2937 . msgtype=msgwarning,
2938 . anmode=aninfo,
2939 . i1=itri(ie),
2940 . c1='NUMBER OF USER VARIABLES',
2941 . c2='MATERIAL LAW ',
2942 . i2=ipm(1,imat),
2943 . c3='/INISHE/AUX')
2944 ENDIF
2945 IF ((ilaw == 36 .and. (nuvar < 4 .or. nuvard00 > 3) .and.
2946 . nuvard00 < nuvar) .or.
2947 . (ilaw /= 36 .and. ilaw /= 78 .and. ilaw /= 87 .and. ilaw /= 112 .and. nuvard00 < nuvar)) THEN
2948 CALL ancmsg(msgid=695,
2949 . msgtype=msgerror,
2950 . anmode=aninfo,
2951 . i1=itri(ie),
2952 . c1='NUMBER OF USER VARIABLES',
2953 . c2='MATERIAL LAW ',
2954 . i2=ipm(1,imat),
2955 . c3='/INISHE/AUX')
2956 ENDIF
2957C----------
2958 i = ptshel(ie)
2959 iuser = 1
2960 nvarsh = nvshell + 4
2961 IF (nip == 0) nip = 1
2962 IF (npg == 0) npg = 1
2963 sigsh(1,i) = id_elem
2964 id_sigsh(i) = id_elem
2965 sigsh(2,i) = nip
2966 sigsh(nvshell,i) = npg
2967!----
2968 ig = ixc(6,ie)
2969 ihbe = igeo(10,ig)
2970 IF (ihbe==24) sigsh(nvshell,i) = 4
2971!----
2972 sigsh(nvshell + 2 ,i) = nip
2973 sigsh(nvshell + 3 ,i) = npg
2974 sigsh(nvshell + 4 ,i) = nuvar
2975 pt = 0
2976!
2977 CALL hm_get_int_array_index('num_lines',num_lines,j,is_available,lsubmodel)
2978 nmax_aux = num_lines*nuvar
2979 CALL hm_get_float_array('V' ,tmpval,nmax_aux,j,is_available,lsubmodel,unitab)
2980!
2981 DO jj=1,num_lines
2982 DO k=1,nuvar
2983 l = nuvar*(jj-1) + k
2984 sigsh(nvarsh+pt+k,i) = tmpval(l)
2985 ENDDO ! DO K=1,NUVAR
2986 pt = pt + nuvar
2987 ENDDO ! DO JJ=1,NUM_LINES
2988!
2989 ENDIF ! IF (IE == 0) THEN
2990 ENDDO ! DO J=1,NB_ELEMENTS
2991!-------------------
2992 CASE ( 'FAIL' )
2993!-------------------
2994 CALL hm_get_intv('inishe_fail_count',nb_elements,is_available,lsubmodel)
2995 DO j=1,nb_elements
2996 CALL hm_get_int_array_index('shell_ID' ,id_elem,j,is_available,lsubmodel)
2997 CALL hm_get_int_array_index('Nlay' ,nlay,j,is_available,lsubmodel)
2998 CALL hm_get_int_array_index('npg' ,npg,j,is_available,lsubmodel)
2999 CALL hm_get_int_array_index('nptt' ,nptt,j,is_available,lsubmodel)
3000 CALL hm_get_int_array_index('lay_ID' ,ilay,j,is_available,lsubmodel)
3001 CALL hm_get_int_array_index('fail_ID' ,ifail,j,is_available,lsubmodel)
3002 CALL hm_get_int_array_index('Ifail_typ',irupt_typ,j,is_available,lsubmodel)
3003 CALL hm_get_int_array_index('Nvar' ,nvar_rupt,j,is_available,lsubmodel)
3004 CALL hm_get_int_array_index('mat_ID' ,imat,j,is_available,lsubmodel)
3005 CALL hm_get_int_array_index('num_lines',num_lines,j,is_available,lsubmodel)
3006!
3007! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH4NM,NUMELC)
3008! IE = MAP_TABLES%ISH4NM(ELT,2)
3009!
3010 ie=uel2sys(id_elem,ksysusr,numelc)
3011!
3012 IF (ie == 0) THEN
3013!
3014 ! Shell was not found. Issue a Warning & Skip.
3015 nonexist = nonexist+1
3016 ELSE
3017C----------
3018 nptt = max(1,nptt)
3019 nlay = max(1,nlay)
3020 npt_max = max(nptt,nlay)
3021 nvmax = nvshell1 /(max(1,npg)*npt_max*5)
3022 IF (id_elem /= nem1) i = ptshel(ie)
3023 nem1 = id_elem
3024 iok = 0
3025!
3026 DO k=1,nummat
3027 IF (ipm(1,k) == imat) THEN
3028 imat = k
3029 iok = 1
3030 EXIT
3031 ENDIF
3032 ENDDO
3033 IF (iok == 0) THEN
3034 CALL ancmsg(msgid=1033,
3035 . msgtype=msgerror,
3036 . anmode=aninfo,
3037 . i1=itri(ie),
3038 . c1='MATERIAL LAW',
3039 . c2='/INISHE/FAIL')
3040 ENDIF ! IF (IOK == 0)
3041!
3042 ig = ixc(6,ie)
3043 ihbe = igeo(10,ig)
3044 igtyp=igeo(11,ig)
3045 sigsh(1,i) = id_elem
3046 id_sigsh(i) = id_elem
3047 IF ( igtyp == 9 ) nlay = nint(geo(npropg*(ig-1)+6))
3048 IF ( igtyp == 10 .OR. igtyp == 11) THEN
3049 sigsh(2,i) = nlay
3050 ELSE
3051 sigsh(2,i) = nptt*nlay
3052 ENDIF
3053 IF (ihbe==12 .OR. ihbe==24) THEN
3054 sigsh(nvshell,i) = 4
3055 ELSE
3056 sigsh(nvshell,i) = 1
3057 ENDIF
3058!
3059! check for consistency ( D00 & INIBRI)
3060 iok = 0
3061 DO k=1,5
3062 nfail(k) = mat_param(imat)%FAIL(k)%FAIL_ID
3063 IF (ifail == nfail(k) .AND.
3064 . irupt_typ == mat_param(imat)%FAIL(k)%IRUPT) THEN
3065 ifail = k
3066 fail_ini(ifail)=1
3067 iok = 1
3068 EXIT
3069 ENDIF
3070 ENDDO
3071 IF (iok == 0) THEN
3072 CALL ancmsg(msgid=1033,
3073 . msgtype=msgerror,
3074 . anmode=aninfo,
3075 . i1=itri(ie),
3076 . c1='FAILURE CRITERIA',
3077 . c2='/INISHE/FAIL')
3078 ENDIF
3079!
3080 pt = nvshell+nushell+3+nortshel
3081 npg = max(1,npg)
3082 nptt = max(1,nptt)
3083 nlay = max(1,nlay)
3084!
3085 nmax_fail = num_lines*nvar_rupt
3086 CALL hm_get_float_array('V' ,tmpval,nmax_fail,j,is_available,lsubmodel,unitab)
3087!
3088 DO jj=1,num_lines
3089 DO k=1,nvar_rupt
3090 l = nvar_rupt*(jj-1) + k
3091 sigsh(pt+l+(ifail-1)*npt_max*npg*nvmax+
3092 . (ilay-1)*nvmax*npg*nptt,i) = tmpval(l)
3093 ENDDO ! DO K=1,NVAR_RUPT
3094 ENDDO ! DO JJ=1,NUM_LINES
3095!
3096 ENDIF ! IF (IE == 0) THEN
3097 ENDDO ! DO J=1,NB_ELEMENTS
3098C---------
3099 CASE DEFAULT
3100
3101 END SELECT ! SELECT CASE(KEY)
3102
3103 ENDDO ! DO INI=1,NB_INISHE
3104
3105 ENDIF ! IF ( NB_INISHE > 0 )
3106!
3107 nishell = i
3108
3109! NUMSHEL = NISHELL
3110
3111!-----------------------------------------
3112! --- /INISH3 ---
3113!-----------------------------------------
3114 i=numshel ! counted in yctrl.F
3115!
3116 CALL hm_option_count('/INISH3', nb_inish3)
3117!
3118 IF ( nb_inish3 > 0 ) THEN
3119!
3120 ! Start reading /INISH3 card
3121 CALL hm_option_start('/INISH3')
3122!---
3123! to be replaced by --- MAP_TABLES%ISH3NM ---
3124 IF (ktrieltg==0) THEN
3125C sorting elements of D00 by ascending id (sorted only once)
3126 DO ie = 1, numeltg
3127 itri(ie) = ixtg(nixtg,ie)
3128 END DO
3129 CALL my_orders(0,work,itri,index,numeltg,1)
3130 DO j = 1, numeltg
3131 ie=index(j)
3132 ksysusrtg(j) =ixtg(nixtg,ie)
3133 ksysusrtg(numeltg+j)=ie
3134 END DO
3135 ktrieltg=1
3136 END IF
3137!---
3138 DO ini=1,nb_inish3
3139!
3140 CALL hm_option_read_key(lsubmodel,
3141 . unit_id = uid,
3142 . submodel_index = sub_index,
3143 . submodel_id = sub_id,
3144 . keyword2 = key,
3145 . keyword3 = key2)
3146!
3147 IF (key2 /= ' ') glob = .true.
3148!
3149! WRITE(iout,*) 'MIRC',KEY(1:LEN_TRIM(KEY))
3150!
3151 DO iunit=1,unitab%NUNITS
3152 IF (unitab%UNIT_ID(iunit) == uid) THEN
3153 iflagunit = 1
3154 EXIT
3155 ENDIF
3156 ENDDO
3157!
3158 IF (uid /= 0.AND.iflagunit == 0) THEN
3159 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
3160 . i2=uid, i1=sub_id, c1='INISH3',
3161 . c2='INISH3',
3162 . c3=' ')
3163 ENDIF
3164c---------------------------------------
3165 SELECT CASE (key(1:len_trim(key)))
3166
3167 CASE ( 'EPSP_F' )
3168 isigsh =1
3169C---------
3170!
3171 CALL hm_get_intv('inish3_epsp_f_count',nb_elements,is_available,lsubmodel)
3172!
3173 DO j=1,nb_elements
3174 ! Reading --- ID_ELEM, NIP, NPG, THK ---
3175 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
3176 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
3177 CALL hm_get_int_array_index('npg',npg,j,is_available,lsubmodel)
3178 CALL hm_get_float_array_index('Thick',thk,j,is_available,lsubmodel,unitab)
3179!
3180! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH3NM,NUMELTG)
3181! IE = MAP_TABLES%ISH3NM(ELT,2)
3182!
3183 ie = uel2sys(id_elem,ksysusrtg,numeltg)
3184!
3185 IF (ie == 0) THEN
3186 ! Shell was not found. Issue a Warning & Skip.
3187 nonexist = nonexist+1
3188 ELSE
3189!
3190 i = numshel + ptsh3n(ie)
3191!
3192 id_sigsh(i) = id_elem
3193 sigsh(1,i) = id_elem
3194 sigsh(2,i) = nip
3195 sigsh(3,i) = thk
3196 sigsh(nvshell - 1,i) = one
3197!
3198 IF (npg <= 1) THEN
3199!---
3200!
3201 SIZE = nip*max(npg,1)
3202 CALL hm_get_float_array('Ep',tmpval,SIZE,j,is_available,lsubmodel,unitab)!
3203!
3204 pt=22
3205 jj=nip*max(npg,1)
3206 k0 = 0
3207 DO WHILE(jj > 0)
3208 l=min(jj,5)
3209 DO k=1,l
3210 sigsh(pt+(k-1)*6+5,i) = tmpval(k+k0)
3211 ENDDO
3212!
3213 k0=k0+5
3214 pt=pt+30
3215 jj=jj-5
3216 END DO ! DO WHILE(JJ > 0)
3217!---------------------
3218 ELSEIF (npg > 1) THEN
3219 sigsh(nvshell,i) = npg
3220!
3221 IF (nip == 0) THEN
3222!---
3223 SIZE = npg
3224 CALL hm_get_float_array('Ep',tmpval,SIZE,j,is_available,lsubmodel,unitab)!
3225!
3226 pt=22
3227 DO k=1,npg
3228 sigsh(pt+(k-1)*9+5,i) = tmpval(k)
3229 ENDDO
3230 ELSE
3231!---
3232 SIZE = nip*npg
3233 CALL hm_get_float_array('Ep',tmpval,SIZE,j,is_available,lsubmodel,unitab)!
3234!
3235 pt=22
3236 jj=nip*npg
3237 k0 = 0
3238 DO WHILE(jj > 0)
3239 l=min(jj,5)
3240 DO k=1,l
3241 sigsh(pt+(k-1)*6+5,i) = tmpval(k+k0)
3242 ENDDO
3243!
3244 k0=k0+5
3245 pt=pt+30
3246 jj=jj-5
3247 END DO ! DO WHILE(JJ > 0)
3248!---------------------
3249 END IF ! IF (NIP == 0)
3250 END IF ! (NPG<=1)
3251 ENDIF ! IF (IE /= 0)
3252!
3253 ENDDO ! DO J=1,NB_ELEMENTS
3254C---------
3255 CASE ( 'STRS_F' )
3256C---------
3257 isigsh =1
3258
3259C------------------------------------
3260! --- 'STRS_F/GLOB' ---
3261C------------------------------------
3262
3263 IF (glob ) THEN
3264 CALL hm_get_intv('inish3_strs_f_glob_count',nb_elements,is_available,lsubmodel)
3265!
3266 DO j=1,nb_elements
3267 ! Reading --- ID_ELEM, NIP, NPG, THK ---
3268 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
3269 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
3270 CALL hm_get_int_array_index('npg',npg,j,is_available,lsubmodel)
3271 CALL hm_get_float_array_index('Thick',thk,j,is_available,lsubmodel,unitab)
3272!
3273! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH3NM,NUMELTG)
3274! IE = MAP_TABLES%ISH3NM(ELT,2)
3275!
3276 ie=uel2sys(id_elem,ksysusrtg,numeltg)
3277!
3278 IF (ie == 0) THEN
3279 ! Shell was not found. Issue a Warning & Skip.
3280 nonexist = nonexist+1
3281 ELSE
3282!
3283 ! Reading CARD_1 --- EM,EB,H1,H2,H3 ---
3284 CALL hm_get_float_array_index('Em',em,j,is_available,lsubmodel,unitab)
3285 CALL hm_get_float_array_index('Eb',eb,j,is_available,lsubmodel,unitab)
3286!
3287 i = numshel + ptsh3n(ie)
3288!
3289 sigsh(1,i) = id_elem
3290 id_sigsh(i) = id_elem
3291 sigsh(2,i) = nip
3292 sigsh(3,i) = thk
3293 sigsh(4,i) = em
3294 sigsh(5,i) = eb
3295 sigsh(14,i) = zero
3296 sigsh(15,i) = zero
3297 sigsh(16,i) = zero
3298 sigsh(17,i) = one
3299 sigsh(nvshell - 1,i) = one
3300!----
3301 IF (npg == 0 .OR. npg == 1) THEN
3302!----
3303 IF (nip == 0) THEN
3304 ! Reading CARD_2 --- sigma_X, sigma_Y, sigma_Z ---
3305 CALL hm_get_float_array('sigma_X',sigsh(22,i),1,j,is_available,lsubmodel,unitab)
3306 CALL hm_get_float_array('sigma_Y',sigsh(23,i),1,j,is_available,lsubmodel,unitab)
3307 CALL hm_get_float_array('sigma_Z',sigsh(18,i),1,j,is_available,lsubmodel,unitab)
3308 ! Reading CARD_3 --- sigma_XY, sigma_YZ, sigma_ZX ---
3309 CALL hm_get_float_array('sigma_XY',sigsh(24,i),1,j,is_available,lsubmodel,unitab)
3310 CALL hm_get_float_array('sigma_YZ',sigsh(25,i),1,j,is_available,lsubmodel,unitab)
3311 CALL hm_get_float_array('sigma_ZX',sigsh(26,i),1,j,is_available,lsubmodel,unitab)
3312!
3313 ! Reading CARD_4 --- sigma_bX, sigma_bY, sigma_bZ ---
3314 CALL hm_get_float_array('sigma_bX',sigsh(28,i),1,j,is_available,lsubmodel,unitab)
3315 CALL hm_get_float_array('sigma_bY',sigsh(29,i),1,j,is_available,lsubmodel,unitab)
3316 CALL hm_get_float_array('sigma_bZ',sigsh(19,i),1,j,is_available,lsubmodel,unitab)
3317 ! Reading CARD_5 --- sigma_bXY, sigma_bYZ, sigma_bZX, eps_p ---
3318 CALL hm_get_float_array('sigma_bXY',sigsh(30,i),1,j,is_available,lsubmodel,unitab)
3319 CALL hm_get_float_array('sigma_bYZ',sigsh(20,i),1,j,is_available,lsubmodel,unitab)
3320 CALL hm_get_float_array('sigma_bZX',sigsh(21,i),1,j,is_available,lsubmodel,unitab)
3321 CALL hm_get_float_array('eps_p' ,sigsh(27,i),1,j,is_available,lsubmodel,unitab)
3322!
3323 ELSEIF (nip /= 0) THEN
3324!
3325!! CALL HM_GET_FLOAT_ARRAY('Ep',TMPVAL,36,J,IS_AVAILABLE,LSUBMODEL,UNITAB)!
3326!
3327 SIZE = nip
3328 CALL hm_get_float_array('sigma_X' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
3329 CALL hm_get_float_array('sigma_Y' ,tmpval2,SIZE,j,is_available,lsubmodel,unitab)
3330 CALL hm_get_float_array('sigma_Z' ,tmpval3,SIZE,j,is_available,lsubmodel,unitab)
3331 CALL hm_get_float_array('sigma_XY',tmpval4,SIZE,j,is_available,lsubmodel,unitab)
3332 CALL hm_get_float_array('sigma_YZ',tmpval5,SIZE,j,is_available,lsubmodel,unitab)
3333 CALL hm_get_float_array('sigma_ZX',tmpval6,SIZE,j,is_available,lsubmodel,unitab)
3334 CALL hm_get_float_array('eps_p' ,tmpval7,SIZE,j,is_available,lsubmodel,unitab)
3335 CALL hm_get_float_array('pos_nip' ,tmpval8,SIZE,j,is_available,lsubmodel,unitab)
3336C------------potision Ti [-1,1] 'pos_nip' ---> undocumented FIELD
3337!
3338 inishvar = 22 + nip*6
3339 DO n=1,nip
3340 pt = 22 + (n-1)*6
3341 ! Reading CARD_2 --- sigma_X, sigma_Y, sigma_Z ---
3342 sigsh(pt,i) = tmpval1(n)
3343 sigsh(pt + 1,i) = tmpval2(n)
3344 sigsh(inishvar + n,i) = tmpval3(n)
3345 sigsh(pt + 2,i) = tmpval4(n)
3346 sigsh(pt + 3,i) = tmpval5(n)
3347 sigsh(pt + 4,i) = tmpval6(n)
3348 sigsh(pt + 5,i) = tmpval7(n)
3349 sigsh(inishvar+nip+n,i) = tmpval8(n)
3350 ENDDO ! DO K=1,NIP
3351 ENDIF ! IF (NIP = 0) THEN
3352!----
3353 ELSEIF (npg > 1) THEN
3354!----
3355 sigsh(nvshell,i) = npg
3356!
3357 IF (nip == 0) THEN
3358!
3359 SIZE = npg
3360 CALL hm_get_float_array('sigma_X' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
3361 CALL hm_get_float_array('sigma_Y' ,tmpval2,SIZE,j,is_available,lsubmodel,unitab)
3362 CALL hm_get_float_array('sigma_Z' ,tmpval3,SIZE,j,is_available,lsubmodel,unitab)
3363 CALL hm_get_float_array('sigma_XY' ,tmpval4,SIZE,j,is_available,lsubmodel,unitab)
3364 CALL hm_get_float_array('sigma_YZ' ,tmpval5,SIZE,j,is_available,lsubmodel,unitab)
3365 CALL hm_get_float_array('sigma_ZX' ,tmpval6,SIZE,j,is_available,lsubmodel,unitab)
3366 CALL hm_get_float_array('sigma_bX' ,tmpval7,SIZE,j,is_available,lsubmodel,unitab)
3367 CALL hm_get_float_array('sigma_bY' ,tmpval8,SIZE,j,is_available,lsubmodel,unitab)
3368 CALL hm_get_float_array('sigma_bZ' ,tmpval9,SIZE,j,is_available,lsubmodel,unitab)
3369 CALL hm_get_float_array('sigma_bXY',tmpval10,SIZE,j,is_available,lsubmodel,unitab)
3370 CALL hm_get_float_array('sigma_bYZ',tmpval11,SIZE,j,is_available,lsubmodel,unitab)
3371 CALL hm_get_float_array('sigma_bZX',tmpval12,SIZE,j,is_available,lsubmodel,unitab)
3372 CALL hm_get_float_array('eps_p' ,tmpval13,SIZE,j,is_available,lsubmodel,unitab)
3373!
3374 DO k=1,npg
3375 pt= 22 + (k-1)*13
3376 ! Reading CARD_2 --- sigma_X, sigma_Y, sigma_Z ---
3377 sigsh(pt ,i) = tmpval1(k)
3378 sigsh(pt+1,i) = tmpval2(k)
3379 sigsh(pt+2,i) = tmpval3(k)
3380 sigsh(pt+3,i) = tmpval4(k)
3381 sigsh(pt+4,i) = tmpval5(k)
3382 sigsh(pt+5,i) = tmpval6(k)
3383 sigsh(pt+6,i) = tmpval7(k)
3384 sigsh(pt+7,i) = tmpval8(k)
3385 sigsh(pt+8,i) = tmpval9(k)
3386 sigsh(pt+9,i) = tmpval10(k)
3387 sigsh(pt+10,i) = tmpval11(k)
3388 sigsh(pt+11,i) = tmpval12(k)
3389 sigsh(pt+12,i) = tmpval13(k)
3390! SIGSH(PT:PT+11,I) = SIGSH(PT:PT+11,I)
3391! SIGSH(PT+12,I) = SIGSH(PT+12,I)
3392 ENDDO ! DO K=1,NPG
3393!
3394 ELSE ! NIP > 0
3395!
3396 SIZE = nip*npg
3397 CALL hm_get_float_array('sigma_X' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
3398 CALL hm_get_float_array('sigma_Y' ,tmpval2,SIZE,j,is_available,lsubmodel,unitab)
3399 CALL hm_get_float_array('sigma_Z' ,tmpval3,SIZE,j,is_available,lsubmodel,unitab)
3400 CALL hm_get_float_array('sigma_XY',tmpval4,SIZE,j,is_available,lsubmodel,unitab)
3401 CALL hm_get_float_array('sigma_YZ',tmpval5,SIZE,j,is_available,lsubmodel,unitab)
3402 CALL hm_get_float_array('sigma_ZX',tmpval6,SIZE,j,is_available,lsubmodel,unitab)
3403 CALL hm_get_float_array('eps_p' ,tmpval7,SIZE,j,is_available,lsubmodel,unitab)
3404 CALL hm_get_float_array('pos_nip' ,tmpval8,SIZE,j,is_available,lsubmodel,unitab)
3405C------------potision Ti [-1,1] 'pos_nip' ---> undocumented FIELD
3406!
3407 pt = 22
3408 DO n=1,nip
3409 DO k=1,npg
3410 l = (n-1)*npg+k
3411 ! Reading CARD_2 --- sigma_X, sigma_Y, sigma_Z ---
3412 sigsh(pt ,i) = tmpval1(l)
3413 sigsh(pt+1,i) = tmpval2(l)
3414 sigsh(pt+2,i) = tmpval3(l)
3415 sigsh(pt+3,i) = tmpval4(l)
3416 sigsh(pt+4,i) = tmpval5(l)
3417 sigsh(pt+5,i) = tmpval6(l)
3418 sigsh(pt+6,i) = tmpval7(l)
3419 sigsh(pt+7,i) = tmpval8(l)
3420 pt = pt + 8
3421 ENDDO ! DO N=1,NPG
3422 ENDDO ! DO j=1,nip
3423 ENDIF ! IF (NIP == 0) THEN
3424!----
3425 ENDIF ! IF (NPG == 0 .OR. NPG == 1)
3426!----
3427 ENDIF ! IF (IE == 0)
3428 ENDDO ! DO I=1,NB_ELEMENTS
3429
3430C------------------------------------
3431! --- 'STRS_F' ---
3432C------------------------------------
3433C---------
3434!! CASE ( 'STRS_F' )
3435C---------
3436!! ISIGSH =1
3437!
3438 ELSEIF ( .NOT. glob ) THEN
3439!
3440 CALL hm_get_intv('inish3_strs_f_count',nb_elements,is_available,lsubmodel)
3441!
3442 DO j=1,nb_elements
3443 ! Reading CARD_1 --- ID_ELEM, NIP, NPG, THK ---
3444 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
3445 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
3446 CALL hm_get_int_array_index('npg',npg,j,is_available,lsubmodel)
3447 CALL hm_get_float_array_index('Thick',thk,j,is_available,lsubmodel,unitab)
3448!
3449! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH3NM,NUMELTG)
3450! IE = MAP_TABLES%ISH3NM(ELT,2)
3451!
3452 ie=uel2sys(id_elem,ksysusrtg,numeltg)
3453!
3454 IF (ie == 0) THEN
3455 ! Shell was not found. Issue a Warning & Skip.
3456 nonexist = nonexist+1
3457 ELSE
3458!
3459 ! Reading CARD_2 --- EM,EB,H1,H2,H3 ---
3460 CALL hm_get_float_array_index('Em',em,j,is_available,lsubmodel,unitab)
3461 CALL hm_get_float_array_index('Eb',eb,j,is_available,lsubmodel,unitab)
3462!
3463 i = numshel + ptsh3n(ie)
3464 !!
3465 sigsh(1,i) = id_elem
3466 id_sigsh(i) = id_elem
3467 sigsh(2,i) = nip
3468 sigsh(3,i) = thk
3469 sigsh(4,i) = em
3470 sigsh(5,i) = eb
3471 sigsh(14,i) = zero
3472 sigsh(15,i) = zero
3473 sigsh(16,i) = zero
3474 sigsh(17,i) = zero
3475 sigsh(nvshell - 1,i) = one
3476!----
3477 IF (npg == 0 .OR. npg == 1) THEN
3478!----
3479 IF (nip == 0) THEN
3480 ! Reading CARD_3 --- sigma_1, sigma_2, sigma_12, sigma_23, sigma_31 ---
3481 CALL hm_get_float_array('sigma_1' ,sigsh(22,i),1,j,is_available,lsubmodel,unitab)
3482 CALL hm_get_float_array('sigma_2' ,sigsh(23,i),1,j,is_available,lsubmodel,unitab)
3483 CALL hm_get_float_array('sigma_12',sigsh(24,i),1,j,is_available,lsubmodel,unitab)
3484 CALL hm_get_float_array('sigma_23',sigsh(25,i),1,j,is_available,lsubmodel,unitab)
3485 CALL hm_get_float_array('sigma_31',sigsh(26,i),1,j,is_available,lsubmodel,unitab)
3486!
3487 ! Reading CARD_4 --- eps_p, sigma_b1, sigma_b2, sigma_b12 ---
3488 CALL hm_get_float_array('eps_p' ,sigsh(27,i),1,j,is_available,lsubmodel,unitab)
3489 CALL hm_get_float_array('sigma_b1' ,sigsh(28,i),1,j,is_available,lsubmodel,unitab)
3490 CALL hm_get_float_array('sigma_b2' ,sigsh(29,i),1,j,is_available,lsubmodel,unitab)
3491 CALL hm_get_float_array('sigma_b12',sigsh(30,i),1,j,is_available,lsubmodel,unitab)
3492!
3493 ELSEIF (nip /= 0) THEN
3494!
3495!! CALL HM_GET_FLOAT_ARRAY('Ep',TMPVAL,36,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3496!
3497!
3498 SIZE = nip
3499 CALL hm_get_float_array('sigma_1' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
3500 CALL hm_get_float_array('sigma_2' ,tmpval2,SIZE,j,is_available,lsubmodel,unitab)
3501 CALL hm_get_float_array('sigma_12' ,tmpval3,SIZE,j,is_available,lsubmodel,unitab)
3502 CALL hm_get_float_array('sigma_23' ,tmpval4,SIZE,j,is_available,lsubmodel,unitab)
3503 CALL hm_get_float_array('sigma_31' ,tmpval5,SIZE,j,is_available,lsubmodel,unitab)
3504 CALL hm_get_float_array('eps_p' ,tmpval6,SIZE,j,is_available,lsubmodel,unitab)
3505!
3506!
3507 inishvar = 22 + nip*6
3508 DO n=1,nip
3509 pt = 22 + (n-1)*6
3510 ! Reading CARD_3 --- sigma_1, sigma_2, sigma_12 ---
3511 sigsh(pt ,i) = tmpval1(n)
3512 sigsh(pt + 1,i) = tmpval2(n)
3513 sigsh(pt + 2,i) = tmpval3(n)
3514 sigsh(pt + 3,i) = tmpval4(n)
3515 sigsh(pt + 4,i) = tmpval5(n)
3516 sigsh(pt + 5,i) = tmpval6(n)
3517 ENDDO ! DO K=1,NIP
3518 ENDIF ! IF (NIP = 0) THEN
3519!----
3520 ELSEIF (npg > 1) THEN
3521!----
3522 sigsh(nvshell,i) = npg
3523!
3524 IF (nip == 0) THEN
3525!
3526 SIZE = npg
3527 CALL hm_get_float_array('sigma_1' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
3528 CALL hm_get_float_array('sigma_2' ,tmpval2,SIZE,j,is_available,lsubmodel,unitab)
3529 CALL hm_get_float_array('sigma_12' ,tmpval3,SIZE,j,is_available,lsubmodel,unitab)
3530 CALL hm_get_float_array('sigma_23' ,tmpval4,SIZE,j,is_available,lsubmodel,unitab)
3531 CALL hm_get_float_array('sigma_31' ,tmpval5,SIZE,j,is_available,lsubmodel,unitab)
3532 CALL hm_get_float_array('eps_p' ,tmpval6,SIZE,j,is_available,lsubmodel,unitab)
3533 CALL hm_get_float_array('sigma_b1' ,tmpval7,SIZE,j,is_available,lsubmodel,unitab)
3534 CALL hm_get_float_array('sigma_b2' ,tmpval8,SIZE,j,is_available,lsubmodel,unitab)
3535 CALL hm_get_float_array('sigma_b12' ,tmpval9,SIZE,j,is_available,lsubmodel,unitab)
3536!
3537 DO k=1,npg
3538 pt= 22 + (k-1)*9
3539 ! Reading CARD_3 --- sigma_1, sigma_2, sigma_12, sigma_23, sigma_31 ---
3540 sigsh(pt ,i) = tmpval1(k)
3541 sigsh(pt+1,i) = tmpval2(k)
3542 sigsh(pt+2,i) = tmpval3(k)
3543 sigsh(pt+3,i) = tmpval4(k)
3544 sigsh(pt+4,i) = tmpval5(k)
3545 sigsh(pt+5,i) = tmpval6(k)
3546 sigsh(pt+6,i) = tmpval7(k)
3547 sigsh(pt+7,i) = tmpval8(k)
3548 sigsh(pt+8,i) = tmpval9(k)
3549 ENDDO ! DO K=1,NPG
3550!
3551 ELSE ! NIP > 0
3552!
3553 SIZE = nip*npg
3554 CALL hm_get_float_array('sigma_1' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
3555 CALL hm_get_float_array('sigma_2' ,tmpval2,SIZE,j,is_available,lsubmodel,unitab)
3556 CALL hm_get_float_array('sigma_12' ,tmpval3,SIZE,j,is_available,lsubmodel,unitab)
3557 CALL hm_get_float_array('sigma_23' ,tmpval4,SIZE,j,is_available,lsubmodel,unitab)
3558 CALL hm_get_float_array('sigma_31' ,tmpval5,SIZE,j,is_available,lsubmodel,unitab)
3559 CALL hm_get_float_array('eps_p' ,tmpval6,SIZE,j,is_available,lsubmodel,unitab)
3560!
3561 pt = 22
3562 DO n=1,nip
3563 DO k=1,npg
3564 l = (n-1)*npg+k
3565 ! Reading CARD_3 --- sigma_1, sigma_2, sigma_12 ---
3566 sigsh(pt ,i) = tmpval1(l)
3567 sigsh(pt+1,i) = tmpval2(l)
3568 sigsh(pt+2,i) = tmpval3(l)
3569 sigsh(pt+3,i) = tmpval4(l)
3570 sigsh(pt+4,i) = tmpval5(l)
3571 sigsh(pt+5,i) = tmpval6(l)
3572!
3573 pt = pt + 6
3574 ENDDO ! DO K=1,NPG
3575 ENDDO ! DO N=1,NIP
3576 ENDIF ! IF (NIP == 0) THEN
3577!----
3578 ENDIF ! IF (NPG == 0 .OR. NPG == 1)
3579!----
3580 ENDIF ! IF (IE == 0)
3581 ENDDO ! DO I=1,NB_ELEMENTS
3582C---------
3583 ENDIF ! IF (GLOB ) THEN
3584C---------
3585C---------
3586 CASE ( 'STRA_F' )
3587C---------
3588 ithkshel =2
3589C-------global sys with diff format
3590 IF ( glob ) THEN
3591 CALL hm_get_intv('inish3_stra_f_glob_count',nb_elements,is_available,lsubmodel)
3592!
3593 DO j=1,nb_elements
3594 ! Reading CARD_1 --- ID_ELEM, NIP, NPG, THK ---
3595 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
3596 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
3597 CALL hm_get_int_array_index('npg',npg,j,is_available,lsubmodel)
3598 CALL hm_get_float_array_index('Thick',thk,j,is_available,lsubmodel,unitab)
3599!
3600! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH3NM,NUMELTG)
3601! IE = MAP_TABLES%ISH3NM(ELT,2)
3602!
3603 ie=uel2sys(id_elem,ksysusrtg,numeltg)
3604!
3605 IF (ie == 0) THEN
3606 ! Shell was not found. Issue a Warning & Skip.
3607 nonexist = nonexist+1
3608 ELSE
3609 i = numshel + ptsh3n(ie)
3610 sigsh(1,i) = id_elem
3611 id_sigsh(i) = id_elem
3612 sigsh(2,i) = nip
3613 sigsh(3,i) = thk
3614 sigsh(17,i) = one
3615 sigsh(nvshell,i) = max(1,npg)
3616 sigsh(nvshell - 1,i) = one
3617C----
3618 pt = inishvar1
3619 npp = nip
3620 IF (npp==0) npp=2
3621!===============================================
3622 SIZE = npp*npg
3623 CALL hm_get_float_array('eps_XX' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
3624 CALL hm_get_float_array('eps_YY' ,tmpval2,SIZE,j,is_available,lsubmodel,unitab)
3625 CALL hm_get_float_array('eps_ZZ' ,tmpval3,SIZE,j,is_available,lsubmodel,unitab)
3626 CALL hm_get_float_array('eps_XY' ,tmpval4,SIZE,j,is_available,lsubmodel,unitab)
3627 CALL hm_get_float_array('eps_YZ' ,tmpval5,SIZE,j,is_available,lsubmodel,unitab)
3628 CALL hm_get_float_array('eps_ZX' ,tmpval6,SIZE,j,is_available,lsubmodel,unitab)
3629 CALL hm_get_float_array('T' ,tmpval7,SIZE,j,is_available,lsubmodel,unitab)
3630!
3631 DO n=1,min(2,npp)
3632 DO ipg=1,max(1,npg)
3633 l = (n-1)*max(1,npg)+ipg
3634 sigsh(pt ,i) = tmpval1(l)
3635 sigsh(pt+1,i) = tmpval2(l)
3636 sigsh(pt+2,i) = tmpval3(l)
3637 sigsh(pt+3,i) = tmpval4(l)
3638 sigsh(pt+4,i) = tmpval5(l)
3639 sigsh(pt+5,i) = tmpval6(l)
3640 sigsh(pt+6,i) = tmpval7(l)
3641 pt=pt+7
3642 ENDDO
3643 ENDDO
3644!===============================================
3645 ENDIF ! IF (IE == 0) THEN
3646 ENDDO ! DO J=1,NB_ELEMENTS
3647!
3648 ELSEIF ( .NOT. glob ) THEN
3649!C---------local sy
3650!
3651 CALL hm_get_intv('inish3_stra_f_count',nb_elements,is_available,lsubmodel)
3652!
3653 DO j=1,nb_elements
3654 ! Reading CARD_1 --- ID_ELEM, NIP, NPG, THK ---
3655 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
3656 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
3657 CALL hm_get_int_array_index('npg',npg,j,is_available,lsubmodel)
3658 CALL hm_get_float_array_index('Thick',thk,j,is_available,lsubmodel,unitab)
3659!
3660! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH3NM,NUMELTG)
3661! IE = MAP_TABLES%ISH4NM(ELT,2)
3662!
3663 ie=uel2sys(id_elem,ksysusrtg,numeltg)
3664!
3665 IF (ie == 0) THEN
3666 ! Shell was not found. Issue a Warning & Skip.
3667 nonexist = nonexist+1
3668 ELSE
3669 i = numshel + ptsh3n(ie)
3670 sigsh(1,i) = id_elem
3671 id_sigsh(i) = id_elem
3672 sigsh(3,i) = thk
3673 sigsh(nvshell - 1,i) = one
3674!
3675 IF (npg == 0 .OR. npg == 1) THEN
3676!
3677 CALL hm_get_float_array('eps_1' ,sigsh(6,i),1,j,is_available,lsubmodel,unitab)
3678 CALL hm_get_float_array('eps_2' ,sigsh(7,i),1,j,is_available,lsubmodel,unitab)
3679 CALL hm_get_float_array('eps_12' ,sigsh(8,i),1,j,is_available,lsubmodel,unitab)
3680 CALL hm_get_float_array('eps_23' ,sigsh(9,i),1,j,is_available,lsubmodel,unitab)
3681 CALL hm_get_float_array('eps_31' ,sigsh(10,i),1,j,is_available,lsubmodel,unitab)
3682 CALL hm_get_float_array('k1' ,sigsh(11,i),1,j,is_available,lsubmodel,unitab)
3683 CALL hm_get_float_array('k2' ,sigsh(12,i),1,j,is_available,lsubmodel,unitab)
3684 CALL hm_get_float_array('k12' ,sigsh(13,i),1,j,is_available,lsubmodel,unitab)
3685!
3686 ELSEIF (npg>1 ) THEN
3687!
3688 sigsh(nvshell,i) = npg
3689
3690 sigsh(6,i) =zero
3691 sigsh(7,i) =zero
3692 sigsh(8,i) =zero
3693 sigsh(9,i) =zero
3694 sigsh(10,i)=zero
3695 sigsh(11,i)=zero
3696 sigsh(12,i)=zero
3697 sigsh(13,i)=zero
3698!
3699 SIZE = npg
3700 CALL hm_get_float_array('eps_1' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
3701 CALL hm_get_float_array('eps_2' ,tmpval2,SIZE,j,is_available,lsubmodel,unitab)
3702 CALL hm_get_float_array('eps_12' ,tmpval3,SIZE,j,is_available,lsubmodel,unitab)
3703 CALL hm_get_float_array('eps_23' ,tmpval4,SIZE,j,is_available,lsubmodel,unitab)
3704 CALL hm_get_float_array('eps_31' ,tmpval5,SIZE,j,is_available,lsubmodel,unitab)
3705 CALL hm_get_float_array('k1' ,tmpval6,SIZE,j,is_available,lsubmodel,unitab)
3706 CALL hm_get_float_array('k2' ,tmpval7,SIZE,j,is_available,lsubmodel,unitab)
3707 CALL hm_get_float_array('k12' ,tmpval8,SIZE,j,is_available,lsubmodel,unitab)
3708!
3709 DO ipg=1,npg
3710 sigsh(6,i) =sigsh(6,i) +tmpval1(ipg)/npg
3711 sigsh(7,i) =sigsh(7,i) +tmpval2(ipg)/npg
3712 sigsh(8,i) =sigsh(8,i) +tmpval3(ipg)/npg
3713 sigsh(9,i) =sigsh(9,i) +tmpval4(ipg)/npg
3714 sigsh(10,i)=sigsh(10,i)+tmpval5(ipg)/npg
3715 sigsh(11,i)=sigsh(11,i)+tmpval6(ipg)/npg
3716 sigsh(12,i)=sigsh(12,i)+tmpval7(ipg)/npg
3717 sigsh(13,i)=sigsh(13,i)+tmpval8(ipg)/npg
3718 END DO
3719 ELSE
3720C CALL ANCERR(58,ANINFO_BLIND_2)
3721 ENDIF ! IF (NPG == 0 .OR. NPG == 1)
3722 ENDIF ! IF (IE == 0) THEN
3723 ENDDO ! DO J=1,NB_ELEMENTS
3724 ENDIF ! IF ( GLOB ) THEN
3725C---------
3726 CASE ( 'THICK' )
3727C---------
3728 ithkshel = 1
3729!
3730 CALL hm_get_intv('no_elems',nb_elements,is_available,lsubmodel)
3731!
3732 DO j=1,nb_elements
3733 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
3734 CALL hm_get_float_array_index('Thick' ,thk,j,is_available,lsubmodel,unitab)
3735!
3736!
3737! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH3NM,NUMELTG)
3738! IE = MAP_TABLES%ISH3NM(ELT,2)
3739!
3740 ie=uel2sys(id_elem,ksysusrtg,numeltg)
3741!
3742 IF (ie == 0) THEN
3743 ! Shell was not found. Issue a Warning & Skip.
3744 nonexist = nonexist+1
3745 ELSE
3746 i = numshel + ptsh3n(ie)
3747 sigsh(1,i) = id_elem
3748 id_sigsh(i) = id_elem
3749 sigsh(2,i) = 0
3750 sigsh(3,i) = thk
3751 ENDIF ! IF (IE == 0)
3752 ENDDO ! DO J=1,NB_ELEMENTS
3753C---------
3754 CASE ( 'EPSP' )
3755C---------
3756!
3757 CALL hm_get_intv('no_blocks',nb_elements,is_available,lsubmodel)
3758!
3759 DO j=1,nb_elements
3760 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
3761 CALL hm_get_float_array_index('Ep' ,epsp,j,is_available,lsubmodel,unitab)
3762!
3763! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH3NM,NUMELTG)
3764! IE = MAP_TABLES%ISH3NM(ELT,2)
3765!
3766 ie=uel2sys(id_elem,ksysusrtg,numeltg)
3767!
3768 IF (ie == 0) THEN
3769 ! Shell was not found. Issue a Warning & Skip.
3770 nonexist = nonexist+1
3771 ELSE
3772 i = numshel + ptsh3n(ie)
3773 sigsh(1,i) = id_elem
3774 id_sigsh(i) = id_elem
3775 sigsh(2,i) = 0
3776 sigsh(27,i)= epsp
3777 ENDIF ! IF (IE == 0) THEN
3778 ENDDO ! DO J=1,NB_ELEMENTS
3779!-------------------
3780 CASE ( 'ORTHO' )
3781!-------------------
3782 CALL hm_get_intv('inish3_ortho_count',nb_elements,is_available,lsubmodel)
3783!
3784 DO j=1,nb_elements
3785 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
3786 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
3787!! CALL HM_GET_INT_ARRAY_INDEX('prop_type',IGTYP,J,IS_AVAILABLE,LSUBMODEL)
3788 CALL hm_get_float_array_index('Vx',vx,j,is_available,lsubmodel,unitab)
3789 CALL hm_get_float_array_index('Vy',vy,j,is_available,lsubmodel,unitab)
3790 CALL hm_get_float_array_index('Vz',vz,j,is_available,lsubmodel,unitab)
3791!
3792! elt = set_usrtos(id_elem,map_tables%ISH3NM,numelth)
3793! IE = MAP_TABLES%ISH3NM(ELT,2)
3794!
3795 ie=uel2sys(id_elem,ksysusrtg,numeltg)
3796!
3797 IF (ie == 0) THEN
3798 ! Shell was not found. Issue a Warning & Skip.
3799 nonexist = nonexist+1
3800 ELSE
3801!
3802 ig = ixtg(5,ie)
3803 ish3n = igeo(18,ig)
3804 igtyp=igeo(11,ig)
3805 iortshel = 1
3806 i = numshel + ptsh3n(ie)
3807 pt = nvshell+nushell
3808 !! SIGSH(1,I) = ID_ELEM
3809 id_sigsh(i) = id_elem
3810 IF ( igtyp == 9) nip = nint(geo(npropg*(ig-1)+6))
3811 sigsh(pt + 4,i) = nip
3812 IF( ish3n == 30 ) THEN
3813 sigsh(nvshell,i) = 3
3814 ELSE
3815 sigsh(nvshell,i) = 1
3816 ENDIF
3817 sigsh(pt+1,i) = vx
3818 sigsh(pt+2,i) = vy
3819 sigsh(pt+3,i) = vz
3820 pt = pt+4
3821 IF ( igtyp == 9 ) THEN
3822 CALL hm_get_float_array_index('phi_1',phi1,j,is_available,lsubmodel,unitab)
3823 CALL hm_get_float_array_index('phi_2',phi2,j,is_available,lsubmodel,unitab)
3824 sigsh(pt+1,i) = phi1*pi/hundred80
3825 sigsh(pt+2,i) = phi2*pi/hundred80
3826 pt = pt + 2
3827 ELSEIF (igtyp == 1 ) THEN
3828 CALL ancmsg(msgid=761,
3829 . msgtype=msgerror,
3830 . anmode=aninfo,
3831 . c1='/INISH3/ORTHO',
3832 . c2='SH3N',
3833 . i2=id_elem,i1=igeo(1,ig))
3834 ELSE
3835 SIZE = nip
3836 CALL hm_get_float_array('phi_1_array',tmpval1,SIZE,j,is_available,lsubmodel,unitab)
3837 CALL hm_get_float_array('phi_2_array',tmpval2,SIZE,j,is_available,lsubmodel,unitab)
3838 DO jj = 1,nip
3839 sigsh(pt+1,i) = tmpval1(jj)*pi/hundred80
3840 sigsh(pt+2,i) = tmpval2(jj)*pi/hundred80
3841 pt = pt + 2
3842 ENDDO ! DO JJ = 1,NIP
3843 ENDIF ! IF ( IGTYP == 9)
3844 ENDIF ! IF (IE == 0) THEN
3845 ENDDO ! DO J=1,NB_ELEMENTS
3846!-------------------
3847 CASE ( 'ORTH_LOC' )
3848!-------------------
3849 CALL hm_get_intv('inish3_orth_loc_count',nb_elements,is_available,lsubmodel)
3850!
3851 DO j=1,nb_elements
3852 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
3853 CALL hm_get_int_array_index('nb_lay',nip,j,is_available,lsubmodel)
3854 CALL hm_get_int_array_index('npg',npg,j,is_available,lsubmodel)
3855 CALL hm_get_int_array_index('ndir',ndir,j,is_available,lsubmodel)
3856 CALL hm_get_int_array_index('Iunit',flagdeg,j,is_available,lsubmodel)
3857!
3858!
3859! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH3NM,NUMELTG)
3860! IE = MAP_TABLES%ISH3NM(ELT,2)
3861!
3862 ie=uel2sys(id_elem,ksysusrtg,numeltg)
3863!
3864 IF (ie == 0) THEN
3865 ! Shell was not found. Issue a Warning & Skip.
3866 nonexist = nonexist+1
3867 ELSE
3868!
3869 ig = ixtg(5,ie)
3870 ish3n = igeo(18,ig)
3871 igtyp = igeo(11,ig)
3872 iortshel = 2
3873 i = numshel + ptsh3n(ie)
3874 pt = nvshell + nushell
3875 sigsh(1,i) = id_elem
3876 id_sigsh(i) = id_elem
3877 IF (igtyp == 9) nip = nint(geo(npropg*(ig-1)+6))
3878 sigsh(pt + 4 ,i) = nip
3879 sigsh(pt + 5,i) = one
3880 IF (ish3n == 30) THEN
3881 sigsh(nvshell,i) = 3
3882 ELSE
3883 sigsh(nvshell,i) = 1
3884 ENDIF
3885 pt = pt + 5
3886!
3887 IF (igtyp == 51 .OR. igtyp == 52) THEN
3888 isubstack = iworksh(3, numelc + ie)
3889 nlay = stack%IGEO(1,isubstack)
3890 ipmat = 2 + nlay
3891 IF (ndir /= 2) THEN
3892 DO jj = 1,nlay
3893 mlawly= stack%IGEO(ipmat + jj,isubstack) ! layer material
3894 IF (mlawly == 58) THEN
3895 CALL ancmsg(msgid=1126,
3896 . msgtype=msgerror,
3897 . anmode=aninfo,
3898 . c1='SH3N',
3899 . i1=id_elem)
3900 ENDIF
3901 ENDDO
3902 ENDIF
3903 ENDIF ! IF (IGTYP == 51 .OR. IGTYP == 52)
3904!
3905 ALLOCATE(mlaw_ly(nip))
3906 mlaw_ly = 0
3907 SIZE = nip
3908 CALL hm_get_float_array('phi_i' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
3909 CALL hm_get_float_array('alpha_i',tmpval2,SIZE,j,is_available,lsubmodel,unitab)
3910!
3911 IF (igtyp == 9) THEN
3912 angle1 = tmpval1(1) ! one integration point
3913 IF(flagdeg == 1) angle1 = angle1*pi/hundred80
3914 sigsh(pt+1,i) = cos(angle1)
3915 sigsh(pt+2,i) = sin(angle1)
3916 pt = pt + 2
3917 ELSEIF (igtyp == 10 .OR. igtyp == 11 .OR. igtyp == 16 .OR.
3918 . igtyp == 17 .OR. igtyp == 51 .OR. igtyp == 52) THEN
3919 IF (igtyp == 51 .OR. igtyp == 52)THEN
3920 isubstack = iworksh(3, numelc + ie)
3921 nlay = stack%IGEO(1,isubstack) !
3922 ipmat = 2 + nlay
3923 ipnpt_lay = ipmat + 2*nlay
3924 IF(nlay /= nip) THEN
3925 IF(ndrape > 0) THEN
3926 ipt = 0
3927 DO jj =1,nlay
3928 nslice = stack%IGEO(ipnpt_lay + jj,isubstack)
3929 DO n = 1, nslice
3930 ipt = ipt + 1
3931 mlaw_ly(ipt)= stack%IGEO(ipmat + jj,isubstack)
3932 ENDDO
3933 ENDDO
3934 ELSE
3935 ! error message
3936 ENDIF ! ndrape
3937 ELSE
3938 DO jj =1,nlay
3939 mlaw_ly(jj)= stack%IGEO(ipmat + jj,isubstack)! layer material
3940 ENDDO
3941 ENDIF
3942 ENDIF
3943 DO jj = 1,nip
3944 angle1 = tmpval1(jj)
3945 angle2 = tmpval2(jj)
3946 IF(flagdeg == 1) angle1 = angle1*pi/hundred80
3947 IF(flagdeg == 1) angle2 = angle2*pi/hundred80
3948!
3949 IF (igtyp == 16 .OR.
3950 . (igtyp == 51 .AND. mlaw_ly(jj) == 58) .OR.
3951 . (igtyp == 52 .AND. mlaw_ly(jj) == 58) ) THEN
3952!
3953 angle2 = angle2 + angle1
3954 sigsh(pt+1,i) = cos(angle1)
3955 sigsh(pt+2,i) = sin(angle1)
3956 sigsh(pt+3,i) = cos(angle2)
3957 sigsh(pt+4,i) = sin(angle2)
3958 pt = pt + 4
3959 ELSE
3960 angle1 = tmpval1(jj)
3961 angle1 = angle1*pi/hundred80
3962 sigsh(pt+1,i) = cos(angle1)
3963 sigsh(pt+2,i) = sin(angle1)
3964 pt = pt + 2
3965 ENDIF
3966 ENDDO ! DO JJ = 1,NIP
3967 ELSEIF (igtyp == 1) THEN
3968 CALL ancmsg(msgid=761,
3969 . msgtype=msgerror,
3970 . anmode=aninfo,
3971 . c1='/INISH3/ORTH_LOC',
3972 . c2='3 NODES SHELL',
3973 . i2=id_elem,i1=igeo(1,ig))
3974 ENDIF ! IF (IGTYP == 9)
3975 IF(ALLOCATED(mlaw_ly))DEALLOCATE(mlaw_ly)
3976 ENDIF ! IF (IE == 0) THEN
3977 ENDDO ! DO J=1,NB_ELEMENTS
3978!-------------------
3979 CASE ( 'SCALE_YLD' )
3980!-------------------
3981 CALL hm_get_intv('inish3_scale_yld_count',nb_elements,is_available,lsubmodel)
3982 iyldini = 1
3983!
3984 DO j=1,nb_elements
3985 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
3986 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
3987 CALL hm_get_int_array_index('npg',npg,j,is_available,lsubmodel)
3988!
3989! elt = set_usrtos(id_elem,map_tables%ISH3NM,numeltg)
3990! IE = MAP_TABLES%ISH3NM(ELT,2)
3991!
3992 ie=uel2sys(id_elem,ksysusrtg,numeltg)
3993!
3994 IF (ie == 0) THEN
3995 ! Shell was not found. Issue a Warning & Skip.
3996 nonexist = nonexist+1
3997 ELSE
3998 i = numshel + ptsh3n(ie)
3999 sigsh(nvshell + 1,i) = id_elem ! elt ID
4000 id_sigsh(i) = id_elem
4001 sigsh(nvshell + 2,i) = nip ! integ point
4002 sigsh(nvshell + 3,i) = npg
4003!
4004 SIZE = npg*nip
4005 CALL hm_get_float_array('Alpha_ij' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
4006!
4007 DO n = 1,npg
4008 DO ip = 1,nip
4009 l = (n-1)*nip+ip
4010 pt=nvshell + 3 !22
4011 scaleyld = tmpval1(l)
4012 sigsh(pt+ l,i) = scaleyld
4013 ENDDO !IP = 1,NIP
4014 ENDDO !N = 1,NPG
4015 pt = pt + nip * npg
4016!
4017 ENDIF ! IF (IE == 0) THEN
4018 ENDDO ! DO J=1,NB_ELEMENTS
4019!-------------------
4020 CASE ( 'AUX' )
4021!-------------------
4022 CALL hm_get_intv('inish3_aux_count',nb_elements,is_available,lsubmodel)
4023 DO j=1,nb_elements
4024 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
4025 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
4026 CALL hm_get_int_array_index('npg',npg,j,is_available,lsubmodel)
4027 CALL hm_get_int_array_index('nvars',nuvar,j,is_available,lsubmodel)
4028!
4029!
4030! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH3NM,NUMELTG)
4031! IE = MAP_TABLES%ISH3NM(ELT,2)
4032!
4033 ie=uel2sys(id_elem,ksysusrtg,numeltg)
4034!
4035 IF (ie == 0) THEN
4036 ! Shell was not found. Issue a Warning & Skip.
4037 nonexist = nonexist+1
4038 ELSE
4039C----------
4040 imat = ixtg(1,ie)
4041 ilaw = ipm(2,imat)
4042 nuvard00 = ipm(8,imat)
4043 IF (nuvard00 > nuvar) THEN
4044 CALL ancmsg(msgid=1121,
4045 . msgtype=msgwarning,
4046 . anmode=aninfo,
4047 . i1=itri(ie),
4048 . c1='NUMBER OF USER VARIABLES',
4049 . c2='MATERIAL LAW ',
4050 . i2=ipm(1,imat),
4051 . c3='/INISH3/AUX')
4052 ENDIF
4053 IF ((ilaw == 36 .and. (nuvar < 4 .or. nuvard00 > 3) .and.
4054 . nuvard00 < nuvar) .or.
4055 . (ilaw /= 36 .and. ilaw /= 78 .and. ilaw /= 87 .and. ilaw /= 112 .and. nuvard00 < nuvar)) THEN
4056 CALL ancmsg(msgid=695,
4057 . msgtype=msgerror,
4058 . anmode=aninfo,
4059 . i1=itri(ie),
4060 . c1='NUMBER OF USER VARIABLES',
4061 . c2='MATERIAL LAW ',
4062 . i2=ipm(1,imat),
4063 . c3='/INISH3/AUX')
4064 ENDIF
4065C----------
4066 i = numshel + ptsh3n(ie)
4067 iuser = 1
4068 nvarsh = nvshell + 4
4069 IF (nip == 0) nip = 1
4070 IF (npg == 0) npg = 1
4071 sigsh(1,i) = id_elem
4072 id_sigsh(i) = id_elem
4073 sigsh(2,i) = nip
4074 sigsh(nvshell,i) = npg
4075 sigsh(nvshell + 2 ,i) = nip
4076 sigsh(nvshell + 3 ,i) = npg
4077 sigsh(nvshell + 4 ,i) = nuvar
4078 pt = 0
4079!
4080 CALL hm_get_int_array_index('num_lines',num_lines,j,is_available,lsubmodel)
4081 nmax_aux = num_lines*nuvar
4082 CALL hm_get_float_array('V' ,tmpval,nmax_aux,j,is_available,lsubmodel,unitab)
4083!
4084 DO jj=1,num_lines
4085 DO k=1,nuvar
4086 l = nuvar*(jj-1) + k
4087 sigsh(nvarsh+pt+k,i) = tmpval(l)
4088 ENDDO ! DO K=1,NUVAR
4089 pt = pt + nuvar
4090 ENDDO ! DO JJ=1,NUM_LINES
4091!
4092 ENDIF ! IF (IE == 0) THEN
4093 ENDDO ! DO J=1,NB_ELEMENTS
4094!-------------------
4095 CASE ( 'FAIL' )
4096!-------------------
4097 CALL hm_get_intv('inish3_fail_count',nb_elements,is_available,lsubmodel)
4098 DO j=1,nb_elements
4099 CALL hm_get_int_array_index('shell_ID' ,id_elem,j,is_available,lsubmodel)
4100 CALL hm_get_int_array_index('Nlay' ,nlay,j,is_available,lsubmodel)
4101 CALL hm_get_int_array_index('npg' ,npg,j,is_available,lsubmodel)
4102 CALL hm_get_int_array_index('nptt' ,nptt,j,is_available,lsubmodel)
4103 CALL hm_get_int_array_index('lay_ID' ,ilay,j,is_available,lsubmodel)
4104 CALL hm_get_int_array_index('fail_ID' ,ifail,j,is_available,lsubmodel)
4105 CALL hm_get_int_array_index('Ifail_typ',irupt_typ,j,is_available,lsubmodel)
4106 CALL hm_get_int_array_index('Nvar' ,nvar_rupt,j,is_available,lsubmodel)
4107 CALL hm_get_int_array_index('mat_ID' ,imat,j,is_available,lsubmodel)
4108 CALL hm_get_int_array_index('num_lines',num_lines,j,is_available,lsubmodel)
4109!
4110! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH3NM,NUMELTG)
4111! IE = MAP_TABLES%ISH3NM(ELT,2)
4112!
4113 ie=uel2sys(id_elem,ksysusrtg,numeltg)
4114!
4115 IF (ie == 0) THEN
4116 ! Shell was not found. Issue a Warning & Skip.
4117 nonexist = nonexist+1
4118 ELSE
4119C----------
4120 nptt = max(1,nptt)
4121 nlay = max(1,nlay)
4122 npt_max = max(nptt,nlay)
4123 nvmax = nvshell1 /(max(1,npg)*npt_max*5)
4124 !!IF (ID_ELEM /= NEM1) I = PTSH3N(IE)
4125 nem1 = id_elem
4126 i = numshel + ptsh3n(ie)
4127 iok = 0
4128!
4129 DO k=1,nummat
4130 IF (ipm(1,k) == imat) THEN
4131 imat = k
4132 iok = 1
4133 EXIT
4134 ENDIF
4135 ENDDO
4136 IF (iok == 0) THEN
4137 CALL ancmsg(msgid=1033,
4138 . msgtype=msgerror,
4139 . anmode=aninfo,
4140 . i1=itri(ie),
4141 . c1='MATERIAL LAW',
4142 . c2='/INISHE/FAIL')
4143 ENDIF ! IF (IOK == 0)
4144!
4145 ig = ixtg(5,ie)
4146 ish3n = igeo(18,ig)
4147 igtyp=igeo(11,ig)
4148 sigsh(1,i) = id_elem
4149 id_sigsh(i) = id_elem
4150 IF ( igtyp == 9 ) nlay = nint(geo(npropg*(ig-1)+6))
4151 IF ( igtyp == 10 .OR. igtyp == 11) THEN
4152 sigsh(2,i) = nlay
4153 ELSE
4154 sigsh(2,i) = nptt*nlay
4155 ENDIF
4156 IF( ish3n == 30 ) THEN
4157 sigsh(nvshell,i) = 3
4158 ELSE
4159 sigsh(nvshell,i) = 1
4160 ENDIF
4161!
4162! check for consistency ( D00 & INIBRI)
4163 iok = 0
4164 DO k=1,5
4165 nfail(k) = mat_param(imat)%FAIL(k)%FAIL_ID
4166 IF (ifail == nfail(k) .AND.
4167 . irupt_typ == mat_param(imat)%FAIL(k)%IRUPT) THEN
4168 ifail = k
4169 fail_ini(ifail)=1
4170 iok = 1
4171 EXIT
4172 ENDIF
4173 ENDDO
4174 IF (iok == 0) THEN
4175 CALL ancmsg(msgid=1033,
4176 . msgtype=msgerror,
4177 . anmode=aninfo,
4178 . i1=itri(ie),
4179 . c1='FAILURE CRITERIA',
4180 . c2='/INISH3/FAIL')
4181 ENDIF
4182!
4183 pt = nvshell+nushell+3+nortshel
4184 npg = max(1,npg)
4185 nptt = max(1,nptt)
4186 nlay = max(1,nlay)
4187!
4188 nmax_fail = num_lines*nvar_rupt
4189 CALL hm_get_float_array('V' ,tmpval,nmax_fail,j,is_available,lsubmodel,unitab)
4190!
4191 DO jj=1,num_lines
4192 DO k=1,nvar_rupt
4193 l = nvar_rupt*(jj-1) + k
4194 sigsh(pt+l+(ifail-1)*npt_max*npg*nvmax+
4195 . (ilay-1)*nvmax*npg*nptt,i) = tmpval(l)
4196 ENDDO ! DO K=1,NVAR_RUPT
4197 ENDDO ! DO JJ=1,NUM_LINES
4198!
4199 ENDIF ! IF (IE == 0) THEN
4200 ENDDO ! DO J=1,NB_ELEMENTS
4201!---------------
4202 CASE DEFAULT
4203
4204 END SELECT ! SELECT CASE(KEY)
4205!
4206 ENDDO ! DO INI=1,NB_INISH3
4207
4208 ENDIF ! IF ( NB_INISH3 > 0 )
4209!
4210 nish3n = i-nishell
4211!
4212!-----------------------------------------
4213! --- /INITRUSS ---
4214!-----------------------------------------
4215 nitruss = 0
4216 i = 0
4217!
4218 CALL hm_option_count('/INITRUSS', nb_initruss)
4219!
4220 IF ( nb_initruss > 0 ) THEN
4221!
4222 ! Start reading /INITRUSS card
4223 CALL hm_option_start('/INITRUSS')
4224!---
4225! to be replaced by --- MAP_TABLES%ITRUSSM ---
4226 IF (ktrieltruss == 0) THEN
4227C sorting elements of D00 by ascending id (sorted only once)
4228 DO ie = 1, numelt
4229 itri(ie) = ixt(nixt,ie)
4230 END DO
4231 CALL my_orders(0,work,itri,index,numelt,1)
4232 DO j = 1, numelt
4233 ie=index(j)
4234 ksysusr(j) =ixt(nixt,ie)
4235 ksysusr(numelt+j)=ie
4236 END DO
4237 ktrieltruss=1
4238 ENDIF
4239!---
4240 DO ini=1,nb_initruss
4241!
4242 CALL hm_option_read_key(lsubmodel,
4243 . unit_id = uid,
4244 . submodel_index = sub_index,
4245 . submodel_id = sub_id,
4246 . keyword2 = key)
4247!
4248 iflagunit = 0
4249 DO iunit=1,unitab%NUNITS
4250 IF (unitab%UNIT_ID(iunit) == uid) THEN
4251 iflagunit = 1
4252 EXIT
4253 ENDIF
4254 ENDDO
4255 IF (uid /= 0.AND.iflagunit == 0) THEN
4256 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
4257 . i2=uid,i1=sub_id,c1='INITRUSS',
4258 . c2='INITRUSS',
4259 . c3=' ')
4260 ENDIF
4261c---------------------------------------
4262 SELECT CASE (key(1:len_trim(key)))
4263C---------
4264 CASE ( 'FULL' )
4265C---------
4266!
4267 CALL hm_get_intv('no_of_elems',nb_elements,is_available,lsubmodel)
4268!
4269 DO j=1,nb_elements
4270 ! Reading --- ID_ELEM, Prop ... ---
4271 CALL hm_get_int_array_index('truss_ID',id_elem,j,is_available,lsubmodel)
4272 CALL hm_get_int_array_index('prop_type',igtyp,j,is_available,lsubmodel)
4273!
4274! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ITRUSSM,NUMELT)
4275! IE = MAP_TABLES%ITRUSSM(ELT,2)
4276!
4277 ie=uel2sys(id_elem,ksysusr,numelt)
4278!
4279 IF (ie == 0) THEN
4280 ! Shell was not found. Issue a Warning & Skip.
4281 nonexist = nonexist+1
4282 ELSE
4283!
4284 CALL hm_get_float_array_index('EINT' ,ein,j,is_available,lsubmodel,unitab)
4285 CALL hm_get_float_array_index('F' ,for,j,is_available,lsubmodel,unitab)
4286 CALL hm_get_float_array_index('AREA' ,epsp,j,is_available,lsubmodel,unitab)
4287 CALL hm_get_float_array_index('Eps_p',area,j,is_available,lsubmodel,unitab)
4288!
4289 i=i+1
4290 id_sigtruss(i) = id_elem
4291 sigtruss(1,i) = id_elem
4292 sigtruss(2,i) = igtyp
4293 sigtruss(3,i) = ein
4294 sigtruss(4,i) = for
4295 sigtruss(5,i) = epsp
4296 sigtruss(6,i) = area
4297!
4298 ENDIF ! IF (IE == 0)
4299 ENDDO ! DO J=1,NB_ELEMENTS
4300!
4301 CASE DEFAULT
4302!
4303 END SELECT ! SELECT CASE(KEY)
4304!
4305 ENDDO ! DO INI=1,NB_NITRUSS
4306
4307 ENDIF ! IF ( NB_NITRUSS > 0 )
4308!
4309 nitruss = i
4310
4311
4312
4313!-----------------------------------------
4314! --- /INIBEAM ---
4315!-----------------------------------------
4316 nibeam = 0
4317 i = 0
4318!
4319 CALL hm_option_count('/INIBEAM', nb_inibeam)
4320!
4321 IF ( nb_inibeam > 0 ) THEN
4322!
4323 ! Start reading /INIBEAM card
4324 CALL hm_option_start('/INIBEAM')
4325!---
4326! to be replaced by --- MAP_TABLES%IBEAMM ---
4327 IF (ktrielbeam == 0) THEN
4328! local sorting of elements of D00 by ascending id (sorted only once)
4329 DO ie = 1,numelp
4330 itri(ie) = ixp(nixp,ie)
4331 ENDDO
4332 CALL my_orders(0,work,itri,index,numelp,1)
4333 DO j = 1,numelp
4334 ie = index(j)
4335 ksysusr(j) =ixp(nixp,ie)
4336 ksysusr(numelp+j)=ie
4337 ENDDO
4338 ktrielbeam=1
4339 ENDIF ! IF (KTRIELBEAM==0)
4340!---
4341 DO ini=1,nb_inibeam
4342!
4343 CALL hm_option_read_key(lsubmodel,
4344 . unit_id = uid,
4345 . submodel_index = sub_index,
4346 . submodel_id = sub_id,
4347 . keyword2 = key)
4348!
4349 iflagunit = 0
4350 DO iunit=1,unitab%NUNITS
4351 IF (unitab%UNIT_ID(iunit) == uid) THEN
4352 iflagunit = 1
4353 EXIT
4354 ENDIF
4355 ENDDO
4356 IF (uid /= 0.AND.iflagunit == 0) THEN
4357 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
4358 . i2=uid,i1=sub_id,c1='INIBEAM',
4359 . c2='INIBEAM',
4360 . c3=' ')
4361 ENDIF
4362c---------------------------------------
4363 SELECT CASE (key(1:len_trim(key)))
4364C---------
4365 CASE ( 'FULL' )
4366C---------
4367!
4368 CALL hm_get_intv('inibeam_count',nb_elements,is_available,lsubmodel)
4369!
4370 DO j=1,nb_elements
4371 ! Reading --- ID_ELEM, Prop ... ---
4372 CALL hm_get_int_array_index('beam_ID' ,id_elem,j,is_available,lsubmodel)
4373 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
4374 CALL hm_get_int_array_index('prop_type',igtyp,j,is_available,lsubmodel)
4375!
4376! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%IBEAMM,NUMELP)
4377! IE = MAP_TABLES%ITRUSSM(ELT,2)
4378!
4379 ie=uel2sys(id_elem,ksysusr,numelp)
4380!
4381 IF (ie == 0) THEN
4382 ! Shell was not found. Issue a Warning & Skip.
4383 nonexist = nonexist+1
4384 ELSE
4385 CALL hm_get_float_array_index('EImemb' ,em,j,is_available,lsubmodel,unitab)
4386 CALL hm_get_float_array_index('EIbend' ,eb,j,is_available,lsubmodel,unitab)
4387 CALL hm_get_float_array_index('F1' ,for1,j,is_available,lsubmodel,unitab)
4388 CALL hm_get_float_array_index('F2' ,for2,j,is_available,lsubmodel,unitab)
4389 CALL hm_get_float_array_index('F3' ,for3,j,is_available,lsubmodel,unitab)
4390 CALL hm_get_float_array_index('M1' ,mom1,j,is_available,lsubmodel,unitab)
4391 CALL hm_get_float_array_index('M2' ,mom2,j,is_available,lsubmodel,unitab)
4392 CALL hm_get_float_array_index('M3' ,mom3,j,is_available,lsubmodel,unitab)
4393!
4394 i=i+1
4395 id_sigbeam(i) = id_elem
4396 sigbeam(1,i) = id_elem
4397 sigbeam(2,i) = nip
4398 sigbeam(3,i) = igtyp
4399!
4400 sigbeam(4,i) = em
4401 sigbeam(5,i) = eb
4402!
4403 sigbeam(6,i) = for1
4404 sigbeam(7,i) = for2
4405 sigbeam(8,i) = for3
4406 sigbeam(9,i) = mom1
4407 sigbeam(10,i) = mom2
4408 sigbeam(11,i) = mom3
4409!
4410 pt = 11
4411 IF (nip == 0) THEN
4412 IF (igtyp == 3) THEN
4413 CALL hm_get_float_array_index('EpsilonP' ,epsp,j,is_available,lsubmodel,unitab)
4414 sigbeam(pt+1,i) = epsp
4415 ENDIF ! IF (IGTYP == 3)
4416 ELSEIF (nip > 0) THEN
4417
4418 IF (igtyp == 18) THEN
4419 SIZE = nip
4420 CALL hm_get_float_array('Sigma1' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
4421 CALL hm_get_float_array('Sigma12' ,tmpval2,SIZE,j,is_available,lsubmodel,unitab)
4422 CALL hm_get_float_array('Sigma13' ,tmpval3,SIZE,j,is_available,lsubmodel,unitab)
4423 CALL hm_get_float_array('EpsilonP_array',tmpval4,SIZE,j,is_available,lsubmodel,unitab)
4424 DO k=1,nip
4425 sigbeam(pt+1,i) = tmpval1(k) ! SXX
4426 sigbeam(pt+2,i) = tmpval2(k) ! SXY
4427 sigbeam(pt+3,i) = tmpval3(k) ! SZX
4428 sigbeam(pt+4,i) = tmpval4(k) ! EPSP
4429!
4430 pt = pt + 4
4431 ENDDO ! DO K=1,NIP
4432 ENDIF ! IF (IGTYP == 18)
4433!------
4434 ENDIF ! IF (NIP == 0)
4435!
4436 ENDIF ! IF (IE == 0)
4437!
4438 ENDDO ! DO J=1,NB_ELEMENTS
4439!
4440C---------
4441 CASE ( 'AUX' )
4442C---------
4443!
4444!
4445 CALL hm_get_intv('inibeam_count',nb_elements,is_available,lsubmodel)
4446!
4447 DO j=1,nb_elements
4448 ! Reading --- ID_ELEM, Prop ... ---
4449 CALL hm_get_int_array_index('beam_ID' ,id_elem,j,is_available,lsubmodel)
4450 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
4451 CALL hm_get_int_array_index('prop_type',igtyp,j,is_available,lsubmodel)
4452 CALL hm_get_int_array_index('nvars' ,nuvar,j,is_available,lsubmodel)
4453!
4454! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%IBEAMM,NUMELP)
4455! IE = MAP_TABLES%ITRUSSM(ELT,2)
4456!
4457 ie=uel2sys(id_elem,ksysusr,numelp)
4458!
4459 IF (ie == 0) THEN
4460 ! Shell was not found. Issue a Warning & Skip.
4461 nonexist = nonexist+1
4462 ELSE
4463!
4464! -- UVAR --
4465!
4466 i=i+1
4467 id_sigbeam(i) = id_elem
4468 sigbeam(1,i) = id_elem
4469 sigbeam(2,i) = nip
4470!
4471 iuser = 1
4472 nvarbeam = nvbeam + 4
4473 sigbeam(nvbeam + 1 ,i) = id_elem
4474 sigbeam(nvbeam + 2 ,i) = nip
4475 sigbeam(nvbeam + 3 ,i) = igtyp
4476 sigbeam(nvbeam + 4 ,i) = nuvar
4477!
4478 IF (igtyp /= 18) THEN
4479 CALL ancmsg(msgid=1236,anmode=aninfo,msgtype=msgerror,
4480 . c1='AUX',
4481 . i1=id_elem)
4482 ENDIF
4483!
4484 pt = 0
4485!
4486 nmax_aux = nip*nuvar
4487 CALL hm_get_float_array('V' ,tmpval,nmax_aux,j,is_available,lsubmodel,unitab)
4488!
4489 DO jj=1,nip
4490 DO k=1,nuvar
4491 l = nuvar*(jj-1) + k
4492 sigbeam(nvarbeam+pt+k,i) = tmpval(l)
4493 ENDDO ! DO K=1,NUVAR
4494 pt = pt + nuvar
4495 ENDDO ! DO JJ=1,NIP
4496!
4497 ENDIF ! IF (IE == 0)
4498!
4499 ENDDO ! DO J=1,NB_ELEMENTS
4500!
4501 CASE DEFAULT
4502!
4503 END SELECT ! SELECT CASE(KEY)
4504!
4505 ENDDO ! DO INI=1,NB_INIBEAM
4506
4507 ENDIF ! IF ( NB_INIBEAM > 0 )
4508!
4509 nibeam = i
4510
4511
4512
4513!-----------------------------------------
4514! --- /INISPRI ---
4515!-----------------------------------------
4516 nispring = 0
4517 i = 0
4518!
4519 CALL hm_option_count('/INISPRI', nb_inispri)
4520!
4521 IF ( nb_inispri > 0 ) THEN
4522!
4523 ! Start reading /INISPRI card
4524 CALL hm_option_start('/INISPRI')
4525!---
4526! to be replaced by --- MAP_TABLES%ISPRINGM ---
4527 IF (ktrielspr == 0) THEN
4528C local sorting of elements of D00 by ascending id (sorted only once)
4529 DO ie = 1,numelr
4530 itri(ie) = ixr(nixr,ie)
4531 ENDDO
4532 CALL my_orders(0,work,itri,index,numelr,1)
4533 DO j = 1,numelr
4534 ie = index(j)
4535 ksysusr(j) =ixr(nixr,ie)
4536 ksysusr(numelr+j)=ie
4537 ENDDO
4538 ktrielspr=1
4539 ENDIF ! IF (KTRIELSPR==0)
4540!---
4541 DO ini=1,nb_inispri
4542!
4543 CALL hm_option_read_key(lsubmodel,
4544 . unit_id = uid,
4545 . submodel_index = sub_index,
4546 . submodel_id = sub_id,
4547 . keyword2 = key)
4548!
4549 iflagunit = 0
4550 DO iunit=1,unitab%NUNITS
4551 IF (unitab%UNIT_ID(iunit) == uid) THEN
4552 iflagunit = 1
4553 EXIT
4554 ENDIF
4555 ENDDO
4556 IF (uid /= 0.AND.iflagunit == 0) THEN
4557 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
4558 . i2=uid,i1=sub_id,c1='INISPRING',
4559 . c2='INISPRI',
4560 . c3=' ')
4561 ENDIF
4562c---------------------------------------
4563 SELECT CASE (key(1:len_trim(key)))
4564C---------
4565 CASE ( 'FULL' )
4566C---------
4567!
4568 CALL hm_get_intv('size_spring',nb_elements,is_available,lsubmodel)
4569!
4570 DO j=1,nb_elements
4571 ! reading --- id_elem, prop ... ---
4572 CALL hm_get_int_array_index('spring_ID',id_elem,j,is_available,lsubmodel)
4573 CALL hm_get_int_array_index('prop_type',igtyp,j,is_available,lsubmodel)
4574 CALL hm_get_int_array_index('nvars' ,nuvar,j,is_available,lsubmodel)
4575!
4576! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISPRINGM,NUMELR)
4577! IE = MAP_TABLES%ISPRINGM(ELT,2)
4578!
4579 ie=uel2sys(id_elem,ksysusr,numelr)
4580!
4581 IF (ie == 0) THEN
4582 ! Shell was not found. Issue a Warning & Skip.
4583 nonexist = nonexist+1
4584 ELSE
4585 i=i+1
4586 id_sigspri(i) = id_elem
4587 sigrs(1,i) = id_elem
4588C------
4589 IF (igtyp == 4 .OR. igtyp == 12) THEN
4590C------
4591 CALL hm_get_float_array_index('F_X' ,sigrs(2,i),j,is_available,lsubmodel,unitab)
4592 CALL hm_get_float_array_index('D_X' ,sigrs(3,i),j,is_available,lsubmodel,unitab)
4593 CALL hm_get_float_array_index('FEP_X' ,sigrs(4,i),j,is_available,lsubmodel,unitab)
4594 CALL hm_get_float_array_index('DPL_X+' ,sigrs(5,i),j,is_available,lsubmodel,unitab)
4595 CALL hm_get_float_array_index('DPL_X-' ,sigrs(6,i),j,is_available,lsubmodel,unitab)
4596 CALL hm_get_float_array_index('L_X' ,sigrs(7,i),j,is_available,lsubmodel,unitab)
4597 CALL hm_get_float_array_index('EI' ,sigrs(8,i),j,is_available,lsubmodel,unitab)
4598!
4599 IF (igtyp == 12) THEN
4600 CALL hm_get_float_array_index('DFS' ,sigrs(9,i),j,is_available,lsubmodel,unitab)
4601 ENDIF
4602C------
4603 ELSEIF (igtyp == 8 .OR. igtyp == 13 .OR. igtyp == 25 .OR. igtyp == 23) THEN
4604C------
4605 CALL hm_get_float_array_index('F_X' ,sigrs(2,i),j,is_available,lsubmodel,unitab)
4606 CALL hm_get_float_array_index('D_X' ,sigrs(3,i),j,is_available,lsubmodel,unitab)
4607 CALL hm_get_float_array_index('FEP_X' ,sigrs(4,i),j,is_available,lsubmodel,unitab)
4608 CALL hm_get_float_array_index('DPL_X+' ,sigrs(5,i),j,is_available,lsubmodel,unitab)
4609 CALL hm_get_float_array_index('DPL_X-' ,sigrs(6,i),j,is_available,lsubmodel,unitab)
4610!
4611 CALL hm_get_float_array_index('F_Y' ,sigrs(7,i),j,is_available,lsubmodel,unitab)
4612 CALL hm_get_float_array_index('D_Y' ,sigrs(8,i),j,is_available,lsubmodel,unitab)
4613 CALL hm_get_float_array_index('FEP_Y' ,sigrs(9,i),j,is_available,lsubmodel,unitab)
4614 CALL hm_get_float_array_index('DPL_Y+' ,sigrs(10,i),j,is_available,lsubmodel,unitab)
4615 CALL hm_get_float_array_index('DPL_Y-' ,sigrs(11,i),j,is_available,lsubmodel,unitab)
4616!
4617 CALL hm_get_float_array_index('F_Z' ,sigrs(12,i),j,is_available,lsubmodel,unitab)
4618 CALL hm_get_float_array_index('D_Z' ,sigrs(13,i),j,is_available,lsubmodel,unitab)
4619 CALL hm_get_float_array_index('FEP_Z' ,sigrs(14,i),j,is_available,lsubmodel,unitab)
4620 CALL hm_get_float_array_index('DPL_Z+' ,sigrs(15,i),j,is_available,lsubmodel,unitab)
4621 CALL hm_get_float_array_index('DPL_Z-' ,sigrs(16,i),j,is_available,lsubmodel,unitab)
4622!
4623 CALL hm_get_float_array_index('M_X' ,sigrs(17,i),j,is_available,lsubmodel,unitab)
4624 CALL hm_get_float_array_index('R_X' ,sigrs(18,i),j,is_available,lsubmodel,unitab)
4625 CALL hm_get_float_array_index('MEP_X' ,sigrs(19,i),j,is_available,lsubmodel,unitab)
4626 CALL hm_get_float_array_index('RPL_X+' ,sigrs(20,i),j,is_available,lsubmodel,unitab)
4627 CALL hm_get_float_array_index('RPL_X-' ,sigrs(21,i),j,is_available,lsubmodel,unitab)
4628!
4629 CALL hm_get_float_array_index('M_Y' ,sigrs(22,i),j,is_available,lsubmodel,unitab)
4630 CALL hm_get_float_array_index('R_Y' ,sigrs(23,i),j,is_available,lsubmodel,unitab)
4631 CALL hm_get_float_array_index('MEP_Y' ,sigrs(24,i),j,is_available,lsubmodel,unitab)
4632 CALL hm_get_float_array_index('RPL_Y+' ,sigrs(25,i),j,is_available,lsubmodel,unitab)
4633 CALL hm_get_float_array_index('RPL_Y-' ,sigrs(26,i),j,is_available,lsubmodel,unitab)
4634!
4635 CALL hm_get_float_array_index('M_Z' ,sigrs(27,i),j,is_available,lsubmodel,unitab)
4636 CALL hm_get_float_array_index('R_Z' ,sigrs(28,i),j,is_available,lsubmodel,unitab)
4637 CALL hm_get_float_array_index('MEP_Z' ,sigrs(29,i),j,is_available,lsubmodel,unitab)
4638 CALL hm_get_float_array_index('RPL_Z+' ,sigrs(30,i),j,is_available,lsubmodel,unitab)
4639 CALL hm_get_float_array_index('RPL_Z-' ,sigrs(31,i),j,is_available,lsubmodel,unitab)
4640!
4641 CALL hm_get_float_array_index('L_X' ,sigrs(32,i),j,is_available,lsubmodel,unitab)
4642 CALL hm_get_float_array_index('L_Y' ,sigrs(33,i),j,is_available,lsubmodel,unitab)
4643 CALL hm_get_float_array_index('L_Z' ,sigrs(34,i),j,is_available,lsubmodel,unitab)
4644 CALL hm_get_float_array_index('EI' ,sigrs(35,i),j,is_available,lsubmodel,unitab)
4645 CALL hm_get_float_array_index('ED_X' ,sigrs(36,i),j,is_available,lsubmodel,unitab)
4646!
4647 CALL hm_get_float_array_index('ED_Y' ,sigrs(37,i),j,is_available,lsubmodel,unitab)
4648 CALL hm_get_float_array_index('ED_Z' ,sigrs(38,i),j,is_available,lsubmodel,unitab)
4649 CALL hm_get_float_array_index('ER_X' ,sigrs(39,i),j,is_available,lsubmodel,unitab)
4650 CALL hm_get_float_array_index('ER_Y' ,sigrs(40,i),j,is_available,lsubmodel,unitab)
4651 CALL hm_get_float_array_index('ER_Z' ,sigrs(41,i),j,is_available,lsubmodel,unitab)
4652C------
4653 ELSEIF (igtyp == 26) THEN
4654C------
4655 CALL hm_get_float_array_index('F_X' ,sigrs(2,i),j,is_available,lsubmodel,unitab)
4656 CALL hm_get_float_array_index('D_X' ,sigrs(3,i),j,is_available,lsubmodel,unitab)
4657 CALL hm_get_float_array_index('FEP_X' ,sigrs(4,i),j,is_available,lsubmodel,unitab)
4658 CALL hm_get_float_array_index('L_X' ,sigrs(7,i),j,is_available,lsubmodel,unitab)
4659 CALL hm_get_float_array_index('EI' ,sigrs(8,i),j,is_available,lsubmodel,unitab)
4660 CALL hm_get_float_array_index('DV' ,sigrs(9,i),j,is_available,lsubmodel,unitab)
4661C------
4662C user springs
4663 ELSEIF (igtyp == 29 .OR. igtyp == 30 .OR. igtyp == 31 .OR.
4664 . igtyp == 32 .OR. igtyp == 33 .OR. igtyp == 35 .OR.
4665 . igtyp == 36 .OR. igtyp == 44 .OR. igtyp == 45 .OR.
4666 . igtyp == 46) THEN
4667C------!
4668 CALL hm_get_float_array_index('F_X' ,sigrs(2,i),j,is_available,lsubmodel,unitab)
4669 CALL hm_get_float_array_index('D_X' ,sigrs(3,i),j,is_available,lsubmodel,unitab)
4670 CALL hm_get_float_array_index('F_Y' ,sigrs(4,i),j,is_available,lsubmodel,unitab)
4671 CALL hm_get_float_array_index('D_Y' ,sigrs(5,i),j,is_available,lsubmodel,unitab)
4672 CALL hm_get_float_array_index('F_Z' ,sigrs(6,i),j,is_available,lsubmodel,unitab)
4673 CALL hm_get_float_array_index('D_Z' ,sigrs(7,i),j,is_available,lsubmodel,unitab)
4674 CALL hm_get_float_array_index('M_X' ,sigrs(8,i),j,is_available,lsubmodel,unitab)
4675 CALL hm_get_float_array_index('R_X' ,sigrs(9,i),j,is_available,lsubmodel,unitab)
4676 CALL hm_get_float_array_index('M_Y' ,sigrs(10,i),j,is_available,lsubmodel,unitab)
4677 CALL hm_get_float_array_index('R_Y' ,sigrs(11,i),j,is_available,lsubmodel,unitab)
4678 CALL hm_get_float_array_index('M_Z' ,sigrs(12,i),j,is_available,lsubmodel,unitab)
4679 CALL hm_get_float_array_index('R_Z' ,sigrs(13,i),j,is_available,lsubmodel,unitab)
4680 CALL hm_get_float_array_index('EI' ,sigrs(14,i),j,is_available,lsubmodel,unitab)
4681!
4682 pt = 14
4683!
4684! -- UVAR --
4685!
4686 SIZE = nuvar
4687 CALL hm_get_float_array('VR' ,tmpval,SIZE,j,is_available,lsubmodel,unitab)
4688!
4689 DO k=1,nuvar
4690 sigrs(pt+k,i) = tmpval(k)
4691 ENDDO ! DO K=1,NUVAR
4692 pt = pt + nuvar
4693!
4694 ENDIF ! IF (IGTYP == 4 .OR. IGTYP == 12)
4695!
4696 ENDIF ! IF (IE == 0)
4697!
4698 ENDDO ! DO J=1,NB_ELEMENTS
4699!
4700 CASE DEFAULT
4701!
4702 END SELECT ! SELECT CASE(KEY)
4703!
4704 ENDDO ! DO INI=1,NB_INISPRI
4705
4706 ENDIF ! IF ( NB_INISPRI > 0 )
4707!
4708 nispring = i
4709
4710
4711
4712!-----------------------------------------
4713! --- /INIQUA ---
4714!-----------------------------------------
4715 niquad = 0
4716 i = 0
4717!
4718 CALL hm_option_count('/INIQUA', nb_iniqua)
4719!
4720 IF ( nb_iniqua > 0 ) THEN
4721!
4722 ! Start reading /INIQUA card
4723 CALL hm_option_start('/INIQUA')
4724!---
4725! to be replaced by --- MAP_TABLES%IQUADM ---
4726 IF (ktrieltquad == 0) THEN
4727C sorting elements of D00 by ascending id (sorted only once)
4728 DO ie = 1, numelq
4729 itriq(ie) = ixq(nixq,ie)
4730 END DO
4731 CALL my_orders(0,work,itriq,indexq,numelq,1)
4732 DO j = 1, numelq
4733 ie=indexq(j)
4734 ksysusrq(j) = ixq(nixq,ie)
4735 ksysusrq(numelq+j)=ie
4736 END DO
4737 ktrieltquad=1
4738 ENDIF
4739!---
4740 DO ini=1,nb_iniqua
4741!
4742 CALL hm_option_read_key(lsubmodel,
4743 . unit_id = uid,
4744 . submodel_index = sub_index,
4745 . submodel_id = sub_id,
4746 . keyword2 = key)
4747!
4748 iflagunit = 0
4749 DO iunit=1,unitab%NUNITS
4750 IF (unitab%UNIT_ID(iunit) == uid) THEN
4751 iflagunit = 1
4752 EXIT
4753 ENDIF
4754 ENDDO
4755 IF (uid/=0.AND.iflagunit == 0) THEN
4756 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
4757 . i2=uid,i1=sub_id,c1='INIQUA',
4758 . c2='INIQUA',
4759 . c3=' ')
4760 ENDIF
4761c---------------------------------------
4762 SELECT CASE (key(1:len_trim(key)))
4763C---------
4764 CASE ( 'DENS' )
4765C---------
4766!
4767 CALL hm_get_intv('no_blocks',nb_elements,is_available,lsubmodel)
4768!
4769 DO j=1,nb_elements
4770 ! Reading --- ID_ELEM, ... ---
4771 CALL hm_get_int_array_index('quad_ID',id_elem,j,is_available,lsubmodel)
4772!
4773! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%IQUADM,NUMELQ)
4774! IE = MAP_TABLES%IQUADM(ELT,2)
4775!
4776!! IE=UEL2SYS(ID_ELEM,KSYSUSR,NUMELQ)
4777 ie=uel2sys(id_elem,ksysusrq,numelq)
4778!
4779 IF (ie == 0) THEN
4780 ! Shell was not found. Issue a Warning & Skip.
4781 nonexist = nonexist+1
4782 ELSE
4783 CALL hm_get_float_array_index('value',dens,j,is_available,lsubmodel,unitab)
4784 i=i+1
4785 id_quad_sigi(i) = id_elem
4786 sigi(8,i) = dens
4787 ENDIF ! IF (IE == 0)
4788 ENDDO ! DO J=1,NB_ELEMENTS
4789C---------
4790 CASE ( 'ENER' )
4791C---------
4792!
4793 CALL hm_get_intv('no_blocks',nb_elements,is_available,lsubmodel)
4794!
4795 DO j=1,nb_elements
4796 ! Reading --- ID_ELEM, ... ---
4797 CALL hm_get_int_array_index('quad_ID',id_elem,j,is_available,lsubmodel)
4798!
4799! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%IQUADM,NUMELQ)
4800! IE = MAP_TABLES%IQUADM(ELT,2)
4801!
4802!! IE=UEL2SYS(ID_ELEM,KSYSUSR,NUMELQ)
4803 ie=uel2sys(id_elem,ksysusrq,numelq)
4804!
4805 IF (ie == 0) THEN
4806 ! Shell was not found. Issue a Warning & Skip.
4807 nonexist = nonexist+1
4808 ELSE
4809 CALL hm_get_float_array_index('value',ener,j,is_available,lsubmodel,unitab)
4810 i=i+1
4811 id_quad_sigi(i) = id_elem
4812 sigi(9,i) = ener
4813 ENDIF ! IF (IE == 0)
4814 ENDDO ! DO J=1,NB_ELEMENTS
4815C---------
4816 CASE ( 'EPSP' )
4817C---------
4818!
4819 CALL hm_get_intv('no_blocks',nb_elements,is_available,lsubmodel)
4820!
4821 DO j=1,nb_elements
4822 ! Reading --- ID_ELEM, ... ---
4823 CALL hm_get_int_array_index('quad_ID',id_elem,j,is_available,lsubmodel)
4824!
4825! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%IQUADM,NUMELQ)
4826! IE = MAP_TABLES%IQUADM(ELT,2)
4827!
4828 ie=uel2sys(id_elem,ksysusrq,numelq)
4829!
4830 IF (ie == 0) THEN
4831 ! Shell was not found. Issue a Warning & Skip.
4832 nonexist = nonexist+1
4833 ELSE
4834 CALL hm_get_float_array_index('value',epsp,j,is_available,lsubmodel,unitab)
4835 i=i+1
4836 id_quad_sigi(i) = id_elem
4837 sigi(10,i) = epsp
4838 ENDIF ! IF (IE == 0)
4839 ENDDO ! DO J=1,NB_ELEMENTS
4840C---------
4841 CASE ( 'STRESS' )
4842C---------
4843
4844 CALL hm_get_intv('no_blocks',nb_elements,is_available,lsubmodel)
4845!
4846 DO j=1,nb_elements
4847 ! Reading --- ID_ELEM, ... ---
4848
4849 CALL hm_get_int_array_index('quad_ID',id_elem,j,is_available,lsubmodel)
4850!
4851! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%IQUADM,NUMELQ)
4852! IE = MAP_TABLES%IQUADM(ELT,2)
4853!
4854 ie=uel2sys(id_elem,ksysusrq,numelq)
4855!
4856 IF (ie == 0) THEN
4857 ! Shell was not found. Issue a Warning & Skip.
4858 nonexist = nonexist+1
4859 ELSE
4860 CALL hm_get_float_array_index('SIGMA_x' ,s(1),j,is_available,lsubmodel,unitab)
4861 CALL hm_get_float_array_index('SIGMA_y' ,s(2),j,is_available,lsubmodel,unitab)
4862 CALL hm_get_float_array_index('SIGMA_z' ,s(3),j,is_available,lsubmodel,unitab)
4863 CALL hm_get_float_array_index('SIGMA_xy',s(4),j,is_available,lsubmodel,unitab)
4864!
4865 i=i+1
4866 id_quad_sigi(i) = id_elem
4867 DO k=1,4
4868 sigi(k,i) = s(k)
4869 ENDDO
4870 ENDIF ! IF (IE == 0)
4871 ENDDO ! DO J=1,NB_ELEMENTS
4872!
4873 CASE DEFAULT
4874!
4875 END SELECT ! SELECT CASE(KEY)
4876!
4877!
4878 ENDDO ! DO INI=1,NB_INIQUA
4879!
4880 ENDIF ! IF ( NB_INIQUA > 0 )
4881!
4882 niquad = i
4883
4884!-----------------------------------------
4885! --- /INISPHCEL ---
4886!-----------------------------------------
4887 nisphcel = 0
4888 i = 0
4889 CALL hm_option_count('/INISPHCEL', nb_inisphcel)
4890!
4891 IF ( nb_inisphcel > 0 ) THEN
4892!
4893 ! Start reading /INISPHCEL card
4894 CALL hm_option_start('/INISPHCEL')
4895!---
4896 IF (ktrielsphcel == 0) THEN
4897 DO ie = 1, numsph
4898 itrisph(ie) = kxsp(nisp,ie)
4899 END DO
4900 CALL my_orders(0,work,itrisph,indexsph,numsph,1)
4901 DO j = 1, numsph
4902 ie=indexsph(j)
4903 ksysusrsph(j) =kxsp(nisp,ie)
4904 ksysusrsph(numsph+j)=ie
4905 END DO
4906 ktrielsphcel=1
4907 ENDIF
4908!---
4909 DO ini=1,nb_inisphcel
4910!
4911 CALL hm_option_read_key(lsubmodel,
4912 . unit_id = uid,
4913 . submodel_index = sub_index,
4914 . submodel_id = sub_id,
4915 . keyword2 = key,
4916 . keyword3 = key2)
4917!
4918 IF (key2 /= ' ') glob = .true.
4919!
4920 iflagunit = 0
4921 DO iunit=1,unitab%NUNITS
4922 IF (unitab%UNIT_ID(iunit) == uid) THEN
4923 iflagunit = 1
4924 EXIT
4925 ENDIF
4926 ENDDO
4927!
4928 IF (uid /= 0.AND.iflagunit == 0) THEN
4929 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
4930 . i2=uid, i1=sub_id, c1='INISPHCEL',
4931 . c2='INISPHCEL',
4932 . c3=' ')
4933 ENDIF
4934c---------------------------------------
4935 SELECT CASE (key(1:len_trim(key)))
4936C---------
4937 CASE ( 'FULL' )
4938C---------
4939 CALL hm_get_intv('no_blocks',nb_elements,is_available,lsubmodel)
4940!
4941 DO j=1,nb_elements
4942 i=i+1
4943 CALL hm_get_int_array_index('sphcel_ID',id_elem,j,is_available,lsubmodel)
4944 CALL hm_get_int_array_index('nvarsph',nuvar,j,is_available,lsubmodel)
4945 CALL hm_get_float_array_index('Eint',ener,j,is_available,lsubmodel,unitab)
4946 CALL hm_get_float_array_index('Rho',rho,j,is_available,lsubmodel,unitab)
4947 CALL hm_get_float_array_index('h',slen,j,is_available,lsubmodel,unitab)
4948 CALL hm_get_float_array_index('Sigma1',s(1),j,is_available,lsubmodel,unitab)
4949 CALL hm_get_float_array_index('Sigma2',s(2),j,is_available,lsubmodel,unitab)
4950 CALL hm_get_float_array_index('Sigma3',s(3),j,is_available,lsubmodel,unitab)
4951 CALL hm_get_float_array_index('Epsp',epsp,j,is_available,lsubmodel,unitab)
4952!
4953 ie=uel2sys(id_elem,ksysusrsph,numsph)
4954!
4955 IF (ie == 0) THEN
4956 ! Sphcel was not found. Issue a Warning & Skip.
4957 nonexist = nonexist+1
4958 ELSE
4959 id_sigsph(i) = id_elem
4960 sigsph(1,i) = s(1)
4961 sigsph(2,i) = s(2)
4962 sigsph(3,i) = s(3)
4963 sigsph(4,i) = zero
4964 sigsph(5,i) = zero
4965 sigsph(6,i) = zero
4966 sigsph(7,i) = zero
4967 sigsph(8,i) = rho
4968 sigsph(9,i) = ener
4969 sigsph(10,i) = epsp
4970 sigsph(11,i) = slen
4971 sigsph(12,i) = nuvar
4972 CALL hm_get_float_array('V' ,tmpval,nuvar,j,is_available,lsubmodel,unitab)
4973 DO k=1,nuvar
4974 sigsph(12+k,i) = tmpval(k)
4975 ENDDO
4976!--------------------
4977 ENDIF ! IF (IE /= 0)
4978 ENDDO ! DO I=1,NB_ELEMENTS
4979C---------
4980 CASE DEFAULT
4981C---------
4982 END SELECT ! SELECT CASE(KEY)
4983!
4984 ENDDO ! DO INI=1,NB_INI
4985!
4986 ENDIF ! IF ( NB_INI > 0 )
4987
4988
4989
4990! message in case some elements was not found in the model
4991 IF (nonexist > 0) THEN
4992 CALL ancmsg(msgid=3045,anmode=aninfo,msgtype=msgwarning,i1=nonexist)
4993 ENDIF ! IF (NONEXIST > 0)
4994C------------------------------------
4995 DEALLOCATE (itris)
4996 DEALLOCATE (indexs)
4997 DEALLOCATE (ksysusrs)
4998 DEALLOCATE (ksysusrtg)
4999 DEALLOCATE (itriq)
5000 DEALLOCATE (indexq)
5001 DEALLOCATE (ksysusrq)
5002 DEALLOCATE (ies2iparg)
5003 IF(ALLOCATED(itrisph)) DEALLOCATE(itrisph)
5004 IF(ALLOCATED(indexsph)) DEALLOCATE(indexsph)
5005 IF(ALLOCATED(ksysusrsph)) DEALLOCATE(ksysusrsph)
5006C------------------------------------
5007 RETURN
5008C
5009 END
5010
hm_get_float_array
subroutine hm_get_float_array(name, rarray, s_rarray, index, is_available, lsubmodel, unitab)
Definition hm_get_float_array.F:33
hm_get_float_array_index
subroutine hm_get_float_array_index(name, rval, index, is_available, lsubmodel, unitab)
Definition hm_get_float_array_index.F:105
hm_get_int_array_index
subroutine hm_get_int_array_index(name, ival, index, is_available, lsubmodel)
Definition hm_get_int_array_index.F:164
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
hm_option_count
subroutine hm_option_count(entity_type, hm_option_number)
Definition hm_option_count.F:105
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:253
hm_read_inistate_d00
subroutine hm_read_inistate_d00(ixs, ixq, ixc, ixt, ixp, ixr, geo, pm, ixtg, index, itri, nsigsh, igeo, ipm, nsigs, nsigsph, ksysusr, nsigrs, unitab, isolnodd00, lsubmodel, rtrans, idrape, nsigi, nsigbeam, nsigtruss, sigi, sigsh, sigsp, sigsph, sigrs, sigbeam, sigtruss, strsglob, straglob, orthoglob, isigsh, iyldini, fail_ini, iusolyld, iuser, id_sigsh, id_solid_sigi, id_quad_sigi, id_sigspri, id_sigbeam, id_sigtruss, work, igrbric, nibrick, niquad, nishell, nish3n, nispring, nibeam, nitruss, map_tables, varmax, iparg, ptshel, ptsh3n, stack, iworksh, iout, mat_param, nisphcel, numsph, nisp, kxsp, id_sigsph)
Definition hm_read_inistate_d00.F:65
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:414
lec_inistate_d00_brick_check
subroutine lec_inistate_d00_brick_check(ixs, igeo, itris, isolnodd00, ie, npt, nlay, isolnod, jjhbe, igtyp, isrot, keyword)
Definition lec_inistate_d00_brick-check.F:36
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
groupdef_mod
Definition groupdef_mod.F:668
hm_option_read_mod
Definition hm_option_read_mod.F:412
mapping_option_mod
Definition dichotomy_mod.F:36
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1005
stack_mod
Definition stack_mod.F:75
submodel_mod
Definition submodel_mod.F:717
unitab_mod
Definition unitab_mod.F:517
slen
subroutine slen(x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, j, area, aream)
Definition slen.F:31
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:799
starter
program starter
Definition starter.F:39
mapping_option_mod::mapping_struct_
Definition dichotomy_mod.F:58
submodel_mod::submodel_data
Definition submodel_mod.F:728
subrotvect
subroutine subrotvect(x, y, z, rtrans, sub_id, lsubmodel)
Definition subrot.F:54
subrottens
subroutine subrottens(tens, rtrans, sub_id, lsubmodel)
Definition subrot.F:321