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
77C-----------------------------------------------
78C I m p l i c i t T y p e s
79C-----------------------------------------------
80#include "implicit_f.inc"
81C-----------------------------------------------
82C C o m m o n B l o c k s
83C-----------------------------------------------
84#include "com01_c.inc"
85#include "com04_c.inc"
86#include "drape_c.inc"
87#include "param_c.inc"
88#include "scr17_c.inc"
89#include "scry_c.inc"
90#include "vect01_c.inc"
91C-----------------------------------------------
92C D u m m y A r g u m e n t s
93C-----------------------------------------------
94 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
95 INTEGER IXS(NIXS,*), IXQ(NIXQ,*) ,IXC(NIXC,*),
96 . IGEO(NPROPGI,*) , IXT(NIXT,*) ,IXP(NIXP,*), IXR(NIXR,*),
97 . IXTG(NIXTG,*) , INDEX(*) ,ITRI(*) ,IPM(NPROPMI,*),
98 . KSYSUSR(*) , IDRAPE(NPLYMAX,*)
99 INTEGER NSIGI, NSIGSH, NSIGS, NSIGSPH, NSIGRS,
100 . ISOLNODD00(*), NSIGBEAM, NSIGTRUSS, STRSGLOB(*),
101 . STRAGLOB(*), ORTHOGLOB(*), ISIGSH, IYLDINI, FAIL_INI(5),
102 . IUSOLYLD, IUSER,VARMAX
103 INTEGER ID_SIGSH(*), ID_SOLID_SIGI(*), ID_QUAD_SIGI(*)
104 INTEGER ID_SIGSPRI(*), ID_SIGBEAM(*), ID_SIGTRUSS(*)
105 INTEGER WORK(*)
106 INTEGER NIBRICK, NIQUAD, NISHELL, NISH3N, NISPRING, NIBEAM, NITRUSS
107 my_real
108 . GEO(*),PM(NPROPM,*),RTRANS(NTRANSF,*),
109 . sigi(nsigs,*),sigsh(max(1,nsigsh),*),sigtruss(nsigtruss,*),
110 . sigsp(nsigi,*),sigsph(nsigsph,*),sigrs(nsigrs,*),sigbeam(nsigbeam,*)
111C
112 TYPE(submodel_data) LSUBMODEL(*)
113 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
114C
115 TYPE(mapping_struct_) :: MAP_TABLES
116 INTEGER, DIMENSION(NPARG,NGROUP) ,INTENT(IN):: IPARG
117 INTEGER, INTENT(INOUT) :: PTSHEL(NUMELC),PTSH3N(NUMELTG)
118 TYPE (STACK_PLY) :: STACK
119 INTEGER, INTENT(IN) :: IWORKSH(3,NUMELC + NUMELTG)
120 INTEGER, INTENT(IN) :: IOUT
121 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
122 INTEGER, INTENT(INOUT) :: NISPHCEL
123 INTEGER, INTENT(IN) :: NUMSPH
124 INTEGER, INTENT(IN) :: NISP
125 INTEGER, INTENT(IN) :: KXSP(NISP,NUMSPH)
126 INTEGER, INTENT(INOUT) :: ID_SIGSPH(NUMSPH)
127C-----------------------------------------------
128C L o c a l V a r i a b l e s
129C-----------------------------------------------
130 INTEGER K, N, I,J, L,IG, ISOLNOD,IGTYP,
131 . ihbe,ne, ish3n,iis,nip,ipg,npg,pt,npp,
132 . j1,jj1,nu,ip,jj,nuvar,l_sigb,
133 . nvarsh,numr,numsolid,kk,uid,iflagunit,
134 . iunit, ifram, jjhbe, iorth, nd, nptd00,
135 . nuvard00, ndir, npgtmp,
136 . nptr,npts,nptt,jr,js,jt,nfail(5),imat,ilaw,
137 . jl,npt_max,mlawly,ipmat,jdrp_id,nvarbeam,ifail,nem1,
138 . irupt_typ,nvar_rupt,iok,nvmax,cptvar,flagdeg,num_lines,nmax_aux,nmax_fail,
139 . isubstack,nslice,ipnpt_lay,ipt
140 INTEGER IE, KN, IR, IS, IT, BRIGLOB, SUB_ID, NLAY, ILAY, PID
141 INTEGER KTRIELS, KTRIELC, KTRIELTG, KTRIELSPR, KTRIELBEAM, KTRIELTRUSS,
142 . KTRIELTQUAD, KTRIELSPHCEL
143 INTEGER IGBR, JGBR, I1, SIZE,NSROT,NG,ITYR,NFTR,NELR,ISMRAD
144! INTEGER :: VARMAX
145! PARAMETER (VARMAX = MAX(NSIGSH,NSIGI,NSIGI,NSIGTRUSS,NSIGBEAM,NSIGRS))
146 my_real
147 . em , eb, h1, h2, h3,
148 . r0 , ein, vx, vy, vz, phi1, phi2, scaleyld,
149 . exx, eyy, exy, eyz, ezx, fxx, fyy, fxy,
150 . epsp, angle1, angle2, aa, area, for,ener,dens,
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,KEY3
166 CHARACTER(LEN=NCHARTITLE) :: TITR,TITR1
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 . ELT,ELTP,INI,K0,NB_INITRUSS,NB_INIBEAM,NB_INISPRI,NB_INIQUA,
177 . sub_index,idoub,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 -- LECTURE 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.AND. IF (ISTRSFG>0ISTRSF>0) THEN
276 CALL ANCMSG(MSGID=2044,ANMODE=ANINFO,MSGTYPE=MSGWARNING)
277 END IF
278.AND. IF (ISTRAFG>0ISTRAF>0) THEN
279 CALL ANCMSG(MSGID=2045,ANMODE=ANINFO,MSGTYPE=MSGWARNING)
280 END IF
281 END IF !( NB_INIBRI > 0 ) THEN
282
283 BRIGLOB = 0
284 NIBRICK = 0
285 I = 0
286!
287!
288 IF ( NB_INIBRI > 0 ) THEN
289!
290 ! Start reading /INIBRI card
291 CALL HM_OPTION_START('/inibri')
292!---
293! to be replaced by --- MAP_TABLES%ISOLM ---
294 IF(KTRIELS==0)THEN
295 DO IE = 1, NUMELS
296 ITRIS(IE) = IXS(NIXS,IE)
297 END DO
298 CALL MY_ORDERS(0,WORK,ITRIS,INDEXS,NUMELS,1)
299 DO J = 1, NUMELS
300 IE=INDEXS(J)
301 KSYSUSRS(J) =IXS(NIXS,IE)
302 KSYSUSRS(NUMELS+J)=IE
303 END DO
304 KTRIELS=1
305 END IF
306!---
307 DO INI=1,NB_INIBRI
308!
309 CALL HM_OPTION_READ_KEY(LSUBMODEL,
310 . UNIT_ID = UID,
311 . SUBMODEL_INDEX = SUB_INDEX,
312 . SUBMODEL_ID = SUB_ID,
313 . KEYWORD2 = KEY)
314!
315 IFLAGUNIT = 0
316 DO IUNIT=1,UNITAB%NUNITS
317 IF (UNITAB%UNIT_ID(IUNIT) == UID) THEN
318 IFLAGUNIT = 1
319 EXIT
320 ENDIF
321 ENDDO
322.AND. IF (UID/=0IFLAGUNIT == 0) THEN
323 CALL ANCMSG(MSGID=659,ANMODE=ANINFO,MSGTYPE=MSGERROR,
324 . I2=UID,I1=SUB_ID,C1='inibri',
325 . C2='inibri',C3=' ')
326 ENDIF
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 ENDIF ! IF(ISOLNOD == 8 .AND. 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.OR..AND. ELSEIF ((IGTYP == 21 IGTYP == 22) JJHBE == 14) THEN
1565!
1566 SIZE = NPTR*NPTS*NPTT
1567 CALL HM_GET_FLOAT_ARRAY('epsilon_1' ,TMPVAL1,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1568 CALL HM_GET_FLOAT_ARRAY('epsilon_2' ,TMPVAL2,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1569 CALL HM_GET_FLOAT_ARRAY('epsilon_3' ,TMPVAL3,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1570 CALL HM_GET_FLOAT_ARRAY('epsilon_12' ,TMPVAL4,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1571 CALL HM_GET_FLOAT_ARRAY('epsilon_23' ,TMPVAL5,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1572 CALL HM_GET_FLOAT_ARRAY('epsilon_31' ,TMPVAL6,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1573!
1574 KK = 0
1575!
1576 DO JR=1,NPTR
1577 DO JS=1,NPTS
1578 DO JT=1,NPTT
1579 K = JR + ( (JS-1) + (JT-1)*NPTS )*NPTR
1580 IIS= NVSOLID1 + (K-1)*6
1581!
1582 KK = KK + 1
1583!
1584 S(1) = TMPVAL1(KK)
1585 S(2) = TMPVAL2(KK)
1586 S(3) = TMPVAL3(KK)
1587 S(4) = TMPVAL4(KK)
1588 S(5) = TMPVAL5(KK)
1589 S(6) = TMPVAL6(KK)
1590 IF (SUB_ID /= 0) CALL SUBROTTENS(S,RTRANS,SUB_ID,LSUBMODEL)
1591 SIGSP(IIS+1,I) = S(1)
1592 SIGSP(IIS+2,I) = S(2)
1593 SIGSP(IIS+3,I) = S(3)
1594 SIGSP(IIS+4,I) = S(4)
1595 SIGSP(IIS+5,I) = S(5)
1596 SIGSP(IIS+6,I) = S(6)
1597 ENDDO ! DO JT=1,NPTT
1598 ENDDO ! DO JS=1,NPTS
1599 ENDDO ! DO JR=1,NPTR
1600!
1601 ELSE
1602!
1603 SIZE = NPT
1604 CALL HM_GET_FLOAT_ARRAY('epsilon_1' ,TMPVAL1,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1605 CALL HM_GET_FLOAT_ARRAY('epsilon_2' ,TMPVAL2,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1606 CALL HM_GET_FLOAT_ARRAY('epsilon_3' ,TMPVAL3,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1607 CALL HM_GET_FLOAT_ARRAY('epsilon_12' ,TMPVAL4,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1608 CALL HM_GET_FLOAT_ARRAY('epsilon_23' ,TMPVAL5,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1609 CALL HM_GET_FLOAT_ARRAY('epsilon_31' ,TMPVAL6,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1610!
1611 DO K=1,NPT
1612 IIS= NVSOLID1 + (K-1)*6
1613 S(1) = TMPVAL1(K)
1614 S(2) = TMPVAL2(K)
1615 S(3) = TMPVAL3(K)
1616 S(4) = TMPVAL4(K)
1617 S(5) = TMPVAL5(K)
1618 S(6) = TMPVAL6(K)
1619 IF (SUB_ID /= 0) CALL SUBROTTENS(S,RTRANS,SUB_ID,LSUBMODEL)
1620 SIGSP(IIS+1,I) =S(1)
1621 SIGSP(IIS+2,I) =S(2)
1622 SIGSP(IIS+3,I) =S(3)
1623 SIGSP(IIS+4,I) =S(4)
1624 SIGSP(IIS+5,I) =S(5)
1625 SIGSP(IIS+6,I) =S(6)
1626 ENDDO ! DO K=1,NPT
1627
1628!
1629 ENDIF ! IF ( ISOLNOD == 16 )
1630 ENDIF ! IF (IE == 0)
1631 ENDDO ! DO J=1,NB_ELEMENTS
1632
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.AND. IF (IFAIL == NFAIL(K)
1689 . IRUPT_TYP == MAT_PARAM(IMAT)%FAIL(K)%IRUPT) THEN
1690 IFAIL = K
1691 FAIL_INI(IFAIL)=1
1692 IOK = 1
1693 EXIT
1694 ENDIF
1695 ENDDO
1696 IF (IOK == 0) THEN
1697 CALL ANCMSG(MSGID=1033,
1698 . MSGTYPE=MSGERROR,
1699 . ANMODE=ANINFO,
1700 . I1=ITRIS(IE),
1701 . C1='failure criteria',
1702 . C2='/inibri/fail')
1703 ENDIF ! IF (IOK == 0)
1704!
1705 IIS= NVSOLID1 + NVSOLID2 + 4 + NUSOLID + NVSOLID3
1706!
1707 NMAX_FAIL = NUM_LINES*NVAR_RUPT
1708 CALL HM_GET_FLOAT_ARRAY('v' ,TMPVAL,NMAX_FAIL,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1709!
1710 DO JJ=1,NUM_LINES
1711 DO K=1,NVAR_RUPT
1712 L = NVAR_RUPT*(JJ-1) + K
1713 SIGSP(IIS+L+(IFAIL-1)*NLAY*NPTR*NPTS*NPTT*NVMAX+
1714 . (ILAY-1)*NVMAX*NPTR*NPTS*NPTT,I) = TMPVAL(L)
1715 ENDDO ! DO K=1,NVAR_RUPT
1716 ENDDO ! DO JJ=1,NUM_LINE
1717!
1718 ENDIF ! IF (IE == 0)
1719 ENDDO ! DO J=1,NB_ELEMENTS
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.AND.!! . (IGTYP /= 21 IGTYP /= 22)) THEN
1812.AND. IF (IGTYP /= 21 IGTYP /= 22) THEN
1813 ORTHOGLOB(IE) = 1
1814 SIZE = NLAY
1815 CALL HM_GET_FLOAT_ARRAY('x1' ,TMPVAL1,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1816 CALL HM_GET_FLOAT_ARRAY('y1' ,TMPVAL2,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1817 CALL HM_GET_FLOAT_ARRAY('z1' ,TMPVAL3,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1818 CALL HM_GET_FLOAT_ARRAY('x2' ,TMPVAL4,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1819 CALL HM_GET_FLOAT_ARRAY('y2' ,TMPVAL5,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1820 CALL HM_GET_FLOAT_ARRAY('z3' ,TMPVAL6,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1821!
1822 DO K=1,NLAY
1823 SIGSP(IIS+1,I) = TMPVAL1(K)
1824 SIGSP(IIS+2,I) = TMPVAL2(K)
1825 SIGSP(IIS+3,I) = TMPVAL3(K)
1826 SIGSP(IIS+4,I) = TMPVAL4(K)
1827 SIGSP(IIS+5,I) = TMPVAL5(K)
1828 SIGSP(IIS+6,I) = TMPVAL6(K)
1829 IIS = IIS + 6
1830 ENDDO
1831 ELSE
1832 SIZE = NLAY
1833 CALL HM_GET_FLOAT_ARRAY('cos_alpha' ,TMPVAL1,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1834 CALL HM_GET_FLOAT_ARRAY('sin_alpha' ,TMPVAL2,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1835!
1836 DO K=1,NLAY
1837 SIGSP(IIS+1,I) = TMPVAL1(K)
1838 SIGSP(IIS+2,I) = TMPVAL2(K)
1839 IIS = IIS + 6
1840 ENDDO
1841.AND. ENDIF ! IF (IGTYP /= 21 IGTYP /= 22)
1842!
1843 ENDIF ! IF (IE == 0)
1844 ENDDO ! DO J=1,NB_ELEMENTS
1845
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.OR..AND. IF (ISMRAD/=ISMSTR(ISMSTR/=1ISMSTR<10)) THEN
1885 CALL ANCMSG(MSGID=695,
1886 . MSGTYPE=MSGERROR,
1887 . ANMODE=ANINFO,
1888 . I1=ITRIS(IE),
1889 . C1='small strain formulation',
1890 . C2='solid property',
1891 . I2=IGEO(1,PID),
1892 . C3=KEYWORD)
1893 ENDIF
1894 IIS= NVSOLID1 + NVSOLID2 + NVSOLID3 + NUSOLID+4 + NVSOLID4 +
1895 . NVSOLID5
1896!
1897 SIZE = ISOLNOD
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.AND..OR. IF(SUB_ID /= 0 (ISMSTR==1ISMSTR==11))
1907 . CALL SUBROTVECT (S(1),S(2),S(3),RTRANS,SUB_ID,LSUBMODEL)
1908 SIGSP(IIS+(K-1)*3+1,I) =S(1)
1909 SIGSP(IIS+(K-1)*3+2,I) =S(2)
1910 SIGSP(IIS+(K-1)*3+3,I) =S(3)
1911 ENDDO ! DO J=1,ISOLNOD
1912 SIZE = NSROT
1913 CALL HM_GET_FLOAT_ARRAY('rx' ,TMPVAL1,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1914 CALL HM_GET_FLOAT_ARRAY('ry' ,TMPVAL2,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1915 CALL HM_GET_FLOAT_ARRAY('rz' ,TMPVAL3,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
1916!
1917 IIS = IIS + 3*ISOLNOD
1918 DO K=1,NSROT
1919 S(1) =TMPVAL1(K)
1920 S(2) =TMPVAL2(K)
1921 S(3) =TMPVAL3(K)
1922.AND..OR. IF(SUB_ID /= 0 (ISMSTR==1ISMSTR==11))
1923 . CALL SUBROTVECT (S(1),S(2),S(3),RTRANS,SUB_ID,LSUBMODEL)
1924 SIGSP(IIS+(K-1)*3+1,I) =S(1)
1925 SIGSP(IIS+(K-1)*3+2,I) =S(2)
1926 SIGSP(IIS+(K-1)*3+3,I) =S(3)
1927 ENDDO
1928 STRAGLOB(IE)=10
1929!
1930 ENDIF ! IF (IE == 0)
1931 ENDDO ! DO J=1,NB_ELEMENTS
1932
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 tri des elts du D00 par ID croissant (on ne trie qu'une fois)
1958 DO IE = 1, NUMELC
1959 ITRI(IE) = IXC(NIXC,IE)
1960 END DO
1961 CALL MY_ORDERS(0,WORK,ITRI,INDEX,NUMELC,1)
1962 DO J = 1, NUMELC
1963 IE=INDEX(J)
1964 KSYSUSR(J) =IXC(NIXC,IE)
1965 KSYSUSR(NUMELC+J)=IE
1966 END DO
1967 KTRIELC=1
1968 ENDIF
1969!---
1970 DO INI=1,NB_INISHE
1971!
1972 CALL HM_OPTION_READ_KEY(LSUBMODEL,
1973 . UNIT_ID = UID,
1974 . SUBMODEL_INDEX = SUB_INDEX,
1975 . SUBMODEL_ID = SUB_ID,
1976 . KEYWORD2 = KEY,
1977 . KEYWORD3 = KEY2)
1978!
1979 IF (KEY2 /= ' ') GLOB = .TRUE.
1980!
1981 IFLAGUNIT = 0
1982 DO IUNIT=1,UNITAB%NUNITS
1983 IF (UNITAB%UNIT_ID(IUNIT) == UID) THEN
1984 IFLAGUNIT = 1
1985 EXIT
1986 ENDIF
1987 ENDDO
1988!
1989.AND. IF (UID /= 0IFLAGUNIT == 0) THEN
1990 CALL ANCMSG(MSGID=659,ANMODE=ANINFO,MSGTYPE=MSGERROR,
1991 . I2=UID, I1=SUB_ID, C1='inishe',
1992 . C2='inishe',
1993 . C3=' ')
1994 ENDIF
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.OR. IF (IHBE==12 IHBE==24) THEN
2025 NPGTMP = 4
2026 ELSE
2027 NPGTMP = 1
2028 ENDIF
2029 IF (NPGTMP /= NPG) THEN
2030 CALL FRETITL2(TITR,IGEO(NPROPGI-LTITR+1,IG),LTITR)
2031 CALL ANCMSG(MSGID=26,
2032 . ANMODE=ANINFO,
2033 . MSGTYPE=MSGERROR,
2034 . I1=IGEO(1,IG),
2035 . C1=TITR,
2036 . I2=ID_ELEM)
2037 ENDIF
2038!
2039 I = PTSHEL(IE)
2040 ID_SIGSH(I) = ID_ELEM
2041 SIGSH(1,I) = ID_ELEM
2042 SIGSH(2,I) = NIP
2043 SIGSH(3,I) = THK
2044 SIGSH(NVSHELL - 1,I) = ONE
2045!
2046 IF (NPG <= 1) THEN
2047!---
2048 SIZE = NIP*MAX(NPG,1)
2049 CALL HM_GET_FLOAT_ARRAY('ep',TMPVAL,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2050!
2051 PT=22
2052 JJ=NIP*MAX(NPG,1)
2053 K0 = 0
2054 DO WHILE(JJ > 0)
2055 L=MIN(JJ,5)
2056 DO K=1,L
2057 SIGSH(PT+(K-1)*6+5,I) = TMPVAL(K+K0)
2058 ENDDO
2059 K0=K0+5
2060 PT=PT+30
2061 JJ=JJ-5
2062 ENDDO ! DO WHILE(JJ > 0)
2063!--------------------
2064 ELSEIF (NPG > 1) THEN
2065 SIGSH(NVSHELL,I) = NPG
2066!
2067 IF (NIP == 0) THEN
2068!---
2069 SIZE = NPG
2070 CALL HM_GET_FLOAT_ARRAY('ep',TMPVAL,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2071!
2072 PT=22
2073 DO K=1,NPG
2074 SIGSH(PT+(K-1)*9+5,I) = TMPVAL(K)
2075 ENDDO
2076 ELSE
2077!---
2078 SIZE = NIP*NPG
2079 CALL HM_GET_FLOAT_ARRAY('ep',TMPVAL,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
2080!
2081 PT=22
2082 JJ=NIP*NPG
2083 K0 = 0
2084 DO WHILE(JJ > 0)
2085 L=MIN(JJ,5)
2086 DO K=1,L
2087 SIGSH(PT+(K-1)*6+5,I) = TMPVAL(K+K0)
2088 ENDDO
2089!
2090 K0=K0+5
2091 PT=PT+30
2092 JJ=JJ-5
2093 END DO ! DO WHILE(JJ > 0)
2094!---------------------
2095 END IF ! IF (NIP == 0)
2096 END IF !(NPG<=1)
2097 ENDIF ! IF (IE /= 0)
2098 ENDDO ! DO I=1,NB_ELEMENTS
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.OR. IF (IHBE==12 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.OR. IF (NPG == 0 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+6,i) = tmpval6(n)
2390 ENDDO ! DO K=1,NIP
2391 ENDIF ! IF (NIP = 0) THEN
2392!----
2393 ELSEIF (npg > 1) THEN
2394!----
2395 sigsh(nvshell,i) = npg
2396!
2397 IF (nip == 0) THEN
2398!
2399 SIZE = npg
2400 CALL hm_get_float_array('sigma_1' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
2401 CALL hm_get_float_array('sigma_2' ,tmpval2,SIZE,j,is_available,lsubmodel,unitab)
2402 CALL hm_get_float_array('sigma_12' ,tmpval3,SIZE,j,is_available,lsubmodel,unitab)
2403 CALL hm_get_float_array('sigma_23' ,tmpval4,SIZE,j,is_available,lsubmodel,unitab)
2404 CALL hm_get_float_array('sigma_31' ,tmpval5,SIZE,j,is_available,lsubmodel,unitab)
2405 CALL hm_get_float_array('eps_p' ,tmpval6,SIZE,j,is_available,lsubmodel,unitab)
2406 CALL hm_get_float_array('sigma_b1' ,tmpval7,SIZE,j,is_available,lsubmodel,unitab)
2407 CALL hm_get_float_array('sigma_b2' ,tmpval8,SIZE,j,is_available,lsubmodel,unitab)
2408 CALL hm_get_float_array('sigma_b12',tmpval9,SIZE,j,is_available,lsubmodel,unitab)
2409!
2410 DO k=1,npg
2411 pt= 22 + (k-1)*9
2412 ! Reading CARD_3 --- sigma_1, sigma_2, sigma_12, sigma_23, sigma_31 ---
2413 sigsh(pt ,i) = tmpval1(k)
2414 sigsh(pt+1,i) = tmpval2(k)
2415 sigsh(pt+2,i) = tmpval3(k)
2416 sigsh(pt+3,i) = tmpval4(k)
2417 sigsh(pt+4,i) = tmpval5(k)
2418 sigsh(pt+5,i) = tmpval6(k)
2419 sigsh(pt+6,i) = tmpval7(k)
2420 sigsh(pt+7,i) = tmpval8(k)
2421 sigsh(pt+8,i) = tmpval9(k)
2422 ENDDO ! DO K=1,NPG
2423!
2424 ELSE ! NIP > 0
2425!
2426 SIZE = nip*npg
2427 CALL hm_get_float_array('sigma_1' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
2428 CALL hm_get_float_array('sigma_2' ,tmpval2,SIZE,j,is_available,lsubmodel,unitab)
2429 CALL hm_get_float_array('sigma_12',tmpval3,SIZE,j,is_available,lsubmodel,unitab)
2430 CALL hm_get_float_array('sigma_23',tmpval4,SIZE,j,is_available,lsubmodel,unitab)
2431 CALL hm_get_float_array('sigma_31',tmpval5,SIZE,j,is_available,lsubmodel,unitab)
2432 CALL hm_get_float_array('eps_p' ,tmpval6,SIZE,j,is_available,lsubmodel,unitab)
2433!
2434 pt = 22
2435 DO n=1,nip
2436 DO k=1,npg
2437 l = (n-1)*npg+k
2438 ! Reading CARD_3 --- sigma_1, sigma_2, sigma_12 ---
2439 sigsh(pt ,i) = tmpval1(l)
2440 sigsh(pt+1,i) = tmpval2(l)
2441 sigsh(pt+2,i) = tmpval3(l)
2442 sigsh(pt+3,i) = tmpval4(l)
2443 sigsh(pt+4,i) = tmpval5(l)
2444 sigsh(pt+5,i) = tmpval6(l)
2445
2446 pt = pt + 6
2447 ENDDO ! DO K=1,NPG
2448 ENDDO ! DO N=1,NIP
2449 ENDIF ! IF (NIP == 0) THEN
2450!----
2451 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 npp = nip
2501 IF (npp==0) npp=2
2502!===============================================
2503 SIZE = npp*npg
2504 CALL hm_get_float_array('eps_XX' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
2505 CALL hm_get_float_array('eps_YY' ,tmpval2,SIZE,j,is_available,lsubmodel,unitab)
2506 CALL hm_get_float_array('eps_ZZ' ,tmpval3,SIZE,j,is_available,lsubmodel,unitab)
2507 CALL hm_get_float_array('eps_XY' ,tmpval4,SIZE,j,is_available,lsubmodel,unitab)
2508 CALL hm_get_float_array('eps_YZ' ,tmpval5,SIZE,j,is_available,lsubmodel,unitab)
2509 CALL hm_get_float_array('eps_ZX' ,tmpval6,SIZE,j,is_available,lsubmodel,unitab)
2510 CALL hm_get_float_array('T' ,tmpval7,SIZE,j,is_available,lsubmodel,unitab)
2511!
2512 DO n=1,min(2,npp)
2513 DO ipg=1,max(1,npg)
2514 l = (n-1)*max(1,npg)+ipg
2515 sigsh(pt ,i) = tmpval1(l)
2516 sigsh(pt+1,i) = tmpval2(l)
2517 sigsh(pt+2,i) = tmpval3(l)
2518 sigsh(pt+3,i) = tmpval4(l)
2519 sigsh(pt+4,i) = tmpval5(l)
2520 sigsh(pt+5,i) = tmpval6(l)
2521 sigsh(pt+6,i) = tmpval7(l)
2522 pt=pt+7
2523 ENDDO
2524 ENDDO
2525!===============================================
2526 ENDIF ! IF (IE == 0) THEN
2527 ENDDO ! DO J=1,NB_ELEMENTS
2528!
2529 ELSEIF (.NOT. glob ) THEN
2530!
2531 CALL hm_get_intv('inishe_stra_f_count',nb_elements,is_available,lsubmodel)
2532!
2533 DO j=1,nb_elements
2534 ! Reading CARD_1 --- ID_ELEM, NIP, NPG, THK ---
2535 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
2536 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
2537 CALL hm_get_int_array_index('npg',npg,j,is_available,lsubmodel)
2538 CALL hm_get_float_array_index('Thick',thk,j,is_available,lsubmodel,unitab)
2539!
2540! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH4NM,NUMELC)
2541! IE = MAP_TABLES%ISH4NM(ELT,2)
2542!
2543 ie=uel2sys(id_elem,ksysusr,numelc)
2544!
2545 IF (ie == 0) THEN
2546 ! Shell was not found. Issue a Warning & Skip.
2547 nonexist = nonexist+1
2548 ELSE
2549 i = ptshel(ie)
2550 sigsh(1,i) = id_elem
2551 id_sigsh(i) = id_elem
2552 sigsh(3,i) = thk
2553 sigsh(nvshell - 1 , i) = one
2554!
2555 IF (npg == 0 .OR. npg == 1) THEN
2556!
2557 ig = ixc(6,ie)
2558 ihbe = igeo(10,ig)
2559 IF (ihbe==24) sigsh(nvshell,i) = 4
2560!
2561 CALL hm_get_float_array('eps_1' ,sigsh(6,i),1,j,is_available,lsubmodel,unitab)
2562 CALL hm_get_float_array('eps_2' ,sigsh(7,i),1,j,is_available,lsubmodel,unitab)
2563 CALL hm_get_float_array('eps_12' ,sigsh(8,i),1,j,is_available,lsubmodel,unitab)
2564 CALL hm_get_float_array('eps_23' ,sigsh(9,i),1,j,is_available,lsubmodel,unitab)
2565 CALL hm_get_float_array('eps_31' ,sigsh(10,i),1,j,is_available,lsubmodel,unitab)
2566 CALL hm_get_float_array('k1' ,sigsh(11,i),1,j,is_available,lsubmodel,unitab)
2567 CALL hm_get_float_array('k2' ,sigsh(12,i),1,j,is_available,lsubmodel,unitab)
2568 CALL hm_get_float_array('k12' ,sigsh(13,i),1,j,is_available,lsubmodel,unitab)
2569!
2570 ELSEIF (npg>1 ) THEN
2571!
2572 sigsh(nvshell,i) = npg
2573
2574 sigsh(6,i) =zero
2575 sigsh(7,i) =zero
2576 sigsh(8,i) =zero
2577 sigsh(9,i) =zero
2578 sigsh(10,i)=zero
2579 sigsh(11,i)=zero
2580 sigsh(12,i)=zero
2581 sigsh(13,i)=zero
2582!
2583 SIZE = npg
2584 CALL hm_get_float_array('eps_1' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
2585 CALL hm_get_float_array('eps_2' ,tmpval2,SIZE,j,is_available,lsubmodel,unitab)
2586 CALL hm_get_float_array('eps_12' ,tmpval3,SIZE,j,is_available,lsubmodel,unitab)
2587 CALL hm_get_float_array('eps_23' ,tmpval4,SIZE,j,is_available,lsubmodel,unitab)
2588 CALL hm_get_float_array('eps_31' ,tmpval5,SIZE,j,is_available,lsubmodel,unitab)
2589 CALL hm_get_float_array('k1' ,tmpval6,SIZE,j,is_available,lsubmodel,unitab)
2590 CALL hm_get_float_array('k2' ,tmpval7,SIZE,j,is_available,lsubmodel,unitab)
2591 CALL hm_get_float_array('k12' ,tmpval8,SIZE,j,is_available,lsubmodel,unitab)
2592!
2593 DO ipg=1,npg
2594! average only :
2595 sigsh(6,i) =sigsh(6,i) +tmpval1(ipg)/npg
2596 sigsh(7,i) =sigsh(7,i) +tmpval2(ipg)/npg
2597 sigsh(8,i) =sigsh(8,i) +tmpval3(ipg)/npg
2598 sigsh(9,i) =sigsh(9,i) +tmpval4(ipg)/npg
2599 sigsh(10,i)=sigsh(10,i)+tmpval5(ipg)/npg
2600 sigsh(11,i)=sigsh(11,i)+tmpval6(ipg)/npg
2601 sigsh(12,i)=sigsh(12,i)+tmpval7(ipg)/npg
2602 sigsh(13,i)=sigsh(13,i)+tmpval8(ipg)/npg
2603 END DO
2604 ELSE
2605C CALL ANCERR(58,ANINFO_BLIND_2)
2606 ENDIF ! IF (NPG == 0 .OR. NPG == 1)
2607 ENDIF ! IF (IE == 0) THEN
2608 ENDDO ! DO J=1,NB_ELEMENTS
2609 ENDIF ! IF ( GLOB ) THEN
2610
2611C---------
2612 CASE ( 'THICK' )
2613C---------
2614 ithkshel = 1
2615!
2616 CALL hm_get_intv('no_elems',nb_elements,is_available,lsubmodel)
2617!
2618 DO j=1,nb_elements
2619 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
2620 CALL hm_get_float_array_index('Thick' ,thk,j,is_available,lsubmodel,unitab)
2621!
2622!
2623! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH4NM,NUMELC)
2624! IE = MAP_TABLES%ISH4NM(ELT,2)
2625!
2626 ie=uel2sys(id_elem,ksysusr,numelc)
2627!
2628 IF (ie == 0) THEN
2629 ! Shell was not found. Issue a Warning & Skip.
2630 nonexist = nonexist+1
2631 ELSE
2632 i = ptshel(ie)
2633 sigsh(1,i) = id_elem
2634 id_sigsh(i) = id_elem
2635 sigsh(2,i) = 0
2636 sigsh(3,i) = thk
2637 ENDIF ! IF (IE == 0)
2638 ENDDO ! DO J=1,NB_ELEMENTS
2639C---------
2640 CASE ( 'EPSP' )
2641C---------
2642!
2643 CALL hm_get_intv('no_blocks',nb_elements,is_available,lsubmodel)
2644!
2645 DO j=1,nb_elements
2646 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
2647 CALL hm_get_float_array_index('Ep' ,epsp,j,is_available,lsubmodel,unitab)
2648!
2649!
2650! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH4NM,NUMELC)
2651! IE = MAP_TABLES%ISH4NM(ELT,2)
2652!
2653 ie=uel2sys(id_elem,ksysusr,numelc)
2654!
2655 IF (ie == 0) THEN
2656 ! Shell was not found. Issue a Warning & Skip.
2657 nonexist = nonexist+1
2658 ELSE
2659 i = ptshel(ie)
2660 sigsh(1,i) = id_elem
2661 id_sigsh(i) = id_elem
2662 sigsh(2,i) = 0
2663 sigsh(27,i)= epsp
2664 ENDIF ! IF (IE == 0) THEN
2665 ENDDO ! DO J=1,NB_ELEMENTS
2666!-------------------
2667 CASE ( 'ORTHO' )
2668!-------------------
2669 CALL hm_get_intv('inishe_ortho_count',nb_elements,is_available,lsubmodel)
2670!
2671 DO j=1,nb_elements
2672 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
2673 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
2674!! CALL HM_GET_INT_ARRAY_INDEX('prop_type',IGTYP,J,IS_AVAILABLE,LSUBMODEL)
2675 CALL hm_get_float_array_index('Vx',vx,j,is_available,lsubmodel,unitab)
2676 CALL hm_get_float_array_index('Vy',vy,j,is_available,lsubmodel,unitab)
2677 CALL hm_get_float_array_index('Vz',vz,j,is_available,lsubmodel,unitab)
2678!
2679! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH4NM,NUMELC)
2680! IE = MAP_TABLES%ISH4NM(ELT,2)
2681!
2682 ie=uel2sys(id_elem,ksysusr,numelc)
2683!
2684 IF (ie == 0) THEN
2685 ! Shell was not found. Issue a Warning & Skip.
2686 nonexist = nonexist+1
2687 ELSE
2688!
2689 ig = ixc(6,ie)
2690 ihbe = igeo(10,ig)
2691 igtyp=igeo(11,ig)
2692 iortshel = 1
2693 i = ptshel(ie)
2694 pt = nvshell + nushell
2695 sigsh(1,i) = id_elem
2696 id_sigsh(i) = id_elem
2697 IF ( igtyp == 9) nip = nint(geo(npropg*(ig-1)+6))
2698 sigsh(pt + 4 ,i) = nip
2699 sigsh(pt + 5 ,i) = one
2700 IF( ihbe==12 .OR. ihbe==24) THEN
2701 sigsh(nvshell,i) = 4
2702 ELSE
2703 sigsh(nvshell,i) = 1
2704 ENDIF
2705 sigsh(pt+1,i) = vx
2706 sigsh(pt+2,i) = vy
2707 sigsh(pt+3,i) = vz
2708 pt = pt + 5
2709 IF ( igtyp == 9 ) THEN
2710 CALL hm_get_float_array_index('phi_1',phi1,j,is_available,lsubmodel,unitab)
2711 CALL hm_get_float_array_index('phi_2',phi2,j,is_available,lsubmodel,unitab)
2712 sigsh(pt+1,i) = phi1*pi/hundred80
2713 sigsh(pt+2,i) = phi2*pi/hundred80
2714 pt = pt + 2
2715 ELSEIF (igtyp == 1 ) THEN
2716 CALL ancmsg(msgid=761,
2717 . msgtype=msgerror,
2718 . anmode=aninfo,
2719 . c1='/INISHE/ORTHO',
2720 . c2='SHELL',
2721 . i2=id_elem,i1=igeo(1,ig))
2722 ELSE
2723 SIZE = nip
2724 CALL hm_get_float_array('phi_1_array',tmpval1,SIZE,j,is_available,lsubmodel,unitab)
2725 CALL hm_get_float_array('phi_2_array',tmpval2,SIZE,j,is_available,lsubmodel,unitab)
2726 DO jj = 1,nip
2727 sigsh(pt+1,i) = tmpval1(jj)*pi/hundred80
2728 sigsh(pt+2,i) = tmpval2(jj)*pi/hundred80
2729 pt = pt + 2
2730 ENDDO ! DO JJ = 1,NIP
2731 ENDIF ! IF ( IGTYP == 9)
2732 ENDIF ! IF (IE == 0) THEN
2733 ENDDO ! DO J=1,NB_ELEMENTS
2734!-------------------
2735 CASE ( 'ORTH_LOC' )
2736!-------------------
2737 CALL hm_get_intv('inishe_orth_loc_count',nb_elements,is_available,lsubmodel)
2738!
2739 DO j=1,nb_elements
2740 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
2741 CALL hm_get_int_array_index('nb_lay',nip,j,is_available,lsubmodel)
2742 CALL hm_get_int_array_index('npg',npg,j,is_available,lsubmodel)
2743 CALL hm_get_int_array_index('ndir',ndir,j,is_available,lsubmodel)
2744 CALL hm_get_int_array_index('Iunit',flagdeg,j,is_available,lsubmodel)
2745!
2746!
2747! elt = set_usrtos(id_elem,map_tables%ISH4NM,numelc)
2748! IE = MAP_TABLES%ISH4NM(ELT,2)
2749!
2750 ie=uel2sys(id_elem,ksysusr,numelc)
2751!
2752 IF (ie == 0) THEN
2753 ! Shell was not found. Issue a Warning & Skip.
2754 nonexist = nonexist+1
2755 ELSE
2756!
2757 ig = ixc(6,ie)
2758 ihbe = igeo(10,ig)
2759 igtyp = igeo(11,ig)
2760 iortshel = 2
2761 i = ptshel(ie)
2762 pt = nvshell + nushell
2763 id_sigsh(i) = id_elem
2764 sigsh(1,i) = id_elem
2765 IF (igtyp == 9) nip = nint(geo(npropg*(ig-1)+6))
2766 sigsh(pt + 4,i) = nip
2767 sigsh(pt + 5,i) = one
2768 IF( ihbe==12 .OR. ihbe==24) THEN
2769 sigsh(nvshell,i) = 4
2770 ELSE
2771 sigsh(nvshell,i) = 1
2772 ENDIF
2773!
2774 pt = pt + 5
2775 IF (igtyp == 51 .OR. igtyp == 52) THEN
2776 isubstack = iworksh(3, ie)
2777 nlay = stack%IGEO(1,isubstack)
2778 ipmat = 2 + nlay
2779 IF (ndir /= 2) THEN
2780 DO jj = 1,nlay !
2781 mlawly= stack%IGEO(ipmat + jj,isubstack)! layer material
2782 IF (mlawly == 58) THEN
2783 CALL ancmsg(msgid=1126,
2784 . msgtype=msgerror,
2785 . anmode=aninfo,
2786 . c1='SHELL',
2787 . i1=id_elem)
2788 ENDIF
2789 ENDDO
2790 ENDIF
2791 ENDIF ! IF (IGTYP == 51 .OR. IGTYP == 52)
2792!
2793 SIZE = nip
2794 CALL hm_get_float_array('phi_i' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
2795 CALL hm_get_float_array('alpha_i',tmpval2,SIZE,j,is_available,lsubmodel,unitab)
2796!
2797 ALLOCATE(mlaw_ly(nip))
2798 mlaw_ly = 0
2799 IF (igtyp == 9) THEN
2800 angle1 = tmpval1(1) ! one integration point
2801 IF(flagdeg == 1) angle1 = angle1*pi/hundred80
2802 sigsh(pt+1,i) = cos(angle1)
2803 sigsh(pt+2,i) = sin(angle1)
2804 pt = pt + 2
2805 ELSEIF (igtyp == 10 .OR. igtyp == 11 .OR. igtyp == 16 .OR.
2806 . igtyp == 17 .OR. igtyp == 51 .OR. igtyp == 52) THEN
2807 IF (igtyp == 51 .OR. igtyp == 52)THEN
2808 isubstack = iworksh(3, ie)
2809 nlay = stack%IGEO(1,isubstack) !
2810 ipmat = 2 + nlay
2811 ipnpt_lay = ipmat + 2*nlay
2812 IF(nlay /= nip) THEN
2813 IF(ndrape > 0) THEN
2814 ipt = 0
2815 DO jj =1,nlay
2816 nslice = stack%IGEO(ipnpt_lay + jj,isubstack)
2817 DO n = 1, nslice
2818 ipt = ipt + 1
2819 mlaw_ly(ipt)= stack%IGEO(ipmat + jj,isubstack)
2820 ENDDO
2821 ENDDO
2822 ELSE
2823 ! error message
2824 ENDIF
2825 ELSE
2826 DO jj =1,nlay
2827 mlaw_ly(jj)= stack%IGEO(ipmat + jj,isubstack)! layer material
2828 ENDDO
2829 ENDIF
2830 ENDIF
2831 DO jj = 1,nip
2832 angle1 = tmpval1(jj)
2833 angle2 = tmpval2(jj)
2834 IF(flagdeg == 1) angle1 = angle1*pi/hundred80
2835 IF(flagdeg == 1) angle2 = angle2*pi/hundred80
2836!
2837 IF (igtyp == 16 .OR.
2838 . (igtyp == 51 .AND. mlaw_ly(jj) == 58) .OR.
2839 . (igtyp == 52 .AND. mlaw_ly(jj) == 58) ) THEN
2840!
2841 angle2 = angle2 + angle1
2842 sigsh(pt+1,i) = cos(angle1)
2843 sigsh(pt+2,i) = sin(angle1)
2844 sigsh(pt+3,i) = cos(angle2)
2845 sigsh(pt+4,i) = sin(angle2)
2846 pt = pt + 4
2847 ELSE
2848 sigsh(pt+1,i) = cos(angle1)
2849 sigsh(pt+2,i) = sin(angle1)
2850 pt = pt + 2
2851 ENDIF
2852 ENDDO ! DO JJ = 1,NIP
2853 ELSEIF (igtyp == 1) THEN
2854 CALL ancmsg(msgid=761,
2855 . msgtype=msgerror,
2856 . anmode=aninfo,
2857 . c1='/INISHE/ORTH_LOC',
2858 . c2='SHELL',
2859 . i2=id_elem,i1=igeo(1,ig))
2860 ENDIF ! IF (IGTYP == 9)
2861 IF(ALLOCATED(mlaw_ly))DEALLOCATE(mlaw_ly)
2862 ENDIF ! IF (IE == 0) THEN
2863 ENDDO ! DO J=1,NB_ELEMENTS
2864!-------------------
2865 CASE ( 'SCALE_YLD' )
2866!-------------------
2867 CALL hm_get_intv('inishe_scale_yld_count',nb_elements,is_available,lsubmodel)
2868 iyldini = 1
2869!
2870 DO j=1,nb_elements
2871 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
2872 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
2873 CALL hm_get_int_array_index('npg',npg,j,is_available,lsubmodel)
2874!
2875! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH4NM,NUMELC)
2876! IE = MAP_TABLES%ISH4NM(ELT,2)
2877!
2878 ie=uel2sys(id_elem,ksysusr,numelc)
2879!
2880 IF (ie == 0) THEN
2881 ! Shell was not found. Issue a Warning & Skip.
2882 nonexist = nonexist+1
2883 ELSE
2884 i = ptshel(ie)
2885 sigsh(nvshell + 1,i) = id_elem ! elt ID
2886 id_sigsh(i) = id_elem
2887 sigsh(nvshell + 2,i) = nip ! integ point
2888 sigsh(nvshell + 3,i) = npg
2889!
2890 SIZE = npg*nip
2891 pt = nvshell+nushell+nortshel+nvshell1+3
2892!
2893 CALL hm_get_float_array('Alpha_ij' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
2894!
2895 DO n = 1,npg
2896 DO ip = 1,nip
2897 l = (n-1)*nip+ip
2898!! PT=NVSHELL + 3 !22
2899 scaleyld = tmpval1(l)
2900 sigsh(pt+l,i) = scaleyld
2901 ENDDO !IP = 1,NIP
2902 ENDDO !N = 1,NPG
2903 pt = pt + nip * npg
2904!
2905 ENDIF ! IF (IE == 0) THEN
2906 ENDDO ! DO j=1,nb_elements
2907!-------------------
2908 CASE ( 'AUX' )
2909!-------------------
2910 CALL hm_get_intv('inishe_aux_count',nb_elements,is_available,lsubmodel)
2911 DO j=1,nb_elements
2912 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
2913 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
2914 CALL hm_get_int_array_index('npg',npg,j,is_available,lsubmodel)
2915 CALL hm_get_int_array_index('nvars',nuvar,j,is_available,lsubmodel)
2916!
2917!
2918! elt = set_usrtos(id_elem,map_tables%ISH4NM,numelc)
2919! IE = MAP_TABLES%ISH4NM(ELT,2)
2920!
2921 ie=uel2sys(id_elem,ksysusr,numelc)
2922!
2923 IF (ie == 0) THEN
2924 ! Shell was not found. Issue a Warning & Skip.
2925 nonexist = nonexist+1
2926 ELSE
2927C----------
2928 imat = ixc(1,ie)
2929 ilaw = ipm(2,imat)
2930 nuvard00 = ipm(8,imat)
2931 IF (nuvard00 > nuvar) THEN
2932 CALL ancmsg(msgid=1121,
2933 . msgtype=msgwarning,
2934 . anmode=aninfo,
2935 . i1=itri(ie),
2936 . c1='NUMBER OF USER VARIABLES',
2937 . c2='MATERIAL LAW ',
2938 . i2=ipm(1,imat),
2939 . c3='/INISHE/AUX')
2940 ENDIF
2941 IF ((ilaw == 36 .and. (nuvar < 4 .or. nuvard00 > 3) .and.
2942 . nuvard00 < nuvar) .or.
2943 . (ilaw /= 36 .and. ilaw /= 78 .and. ilaw /= 87 .and. ilaw /= 112 .and. nuvard00 < nuvar)) THEN
2944 CALL ancmsg(msgid=695,
2945 . msgtype=msgerror,
2946 . anmode=aninfo,
2947 . i1=itri(ie),
2948 . c1='NUMBER OF USER VARIABLES',
2949 . c2='MATERIAL LAW ',
2950 . i2=ipm(1,imat),
2951 . c3='/INISHE/AUX')
2952 ENDIF
2953C----------
2954 i = ptshel(ie)
2955 iuser = 1
2956 nvarsh = nvshell + 4
2957 IF (nip == 0) nip = 1
2958 IF (npg == 0) npg = 1
2959 sigsh(1,i) = id_elem
2960 id_sigsh(i) = id_elem
2961 sigsh(2,i) = nip
2962 sigsh(nvshell,i) = npg
2963!----
2964 ig = ixc(6,ie)
2965 ihbe = igeo(10,ig)
2966 IF (ihbe==24) sigsh(nvshell,i) = 4
2967!----
2968 sigsh(nvshell + 2 ,i) = nip
2969 sigsh(nvshell + 3 ,i) = npg
2970 sigsh(nvshell + 4 ,i) = nuvar
2971 pt = 0
2972!
2973 CALL hm_get_int_array_index('num_lines',num_lines,j,is_available,lsubmodel)
2974 nmax_aux = num_lines*nuvar
2975 CALL hm_get_float_array('V' ,tmpval,nmax_aux,j,is_available,lsubmodel,unitab)
2976!
2977 DO jj=1,num_lines
2978 DO k=1,nuvar
2979 l = nuvar*(jj-1) + k
2980 sigsh(nvarsh+pt+k,i) = tmpval(l)
2981 ENDDO ! DO K=1,NUVAR
2982 pt = pt + nuvar
2983 ENDDO ! DO JJ=1,NUM_LINES
2984!
2985 ENDIF ! IF (IE == 0) THEN
2986 ENDDO ! DO J=1,NB_ELEMENTS
2987!-------------------
2988 CASE ( 'fail' )
2989!-------------------
2990 CALL HM_GET_INTV('inishe_fail_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
2991 DO J=1,NB_ELEMENTS
2992 CALL HM_GET_INT_ARRAY_INDEX('shell_id' ,ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
2993 CALL HM_GET_INT_ARRAY_INDEX('nlay' ,NLAY,J,IS_AVAILABLE,LSUBMODEL)
2994 CALL HM_GET_INT_ARRAY_INDEX('npg' ,NPG,J,IS_AVAILABLE,LSUBMODEL)
2995 CALL HM_GET_INT_ARRAY_INDEX('nptt' ,NPTT,J,IS_AVAILABLE,LSUBMODEL)
2996 CALL HM_GET_INT_ARRAY_INDEX('lay_id' ,ILAY,J,IS_AVAILABLE,LSUBMODEL)
2997 CALL HM_GET_INT_ARRAY_INDEX('fail_id' ,IFAIL,J,IS_AVAILABLE,LSUBMODEL)
2998 CALL HM_GET_INT_ARRAY_INDEX('ifail_typ',IRUPT_TYP,J,IS_AVAILABLE,LSUBMODEL)
2999 CALL HM_GET_INT_ARRAY_INDEX('nvar' ,NVAR_RUPT,J,IS_AVAILABLE,LSUBMODEL)
3000 CALL HM_GET_INT_ARRAY_INDEX('mat_id' ,IMAT,J,IS_AVAILABLE,LSUBMODEL)
3001 CALL HM_GET_INT_ARRAY_INDEX('num_lines',NUM_LINES,J,IS_AVAILABLE,LSUBMODEL)
3002!
3003! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH4NM,NUMELC)
3004! IE = MAP_TABLES%ISH4NM(ELT,2)
3005!
3006 IE=UEL2SYS(ID_ELEM,KSYSUSR,NUMELC)
3007!
3008 IF (IE == 0) THEN
3009!
3010 ! Shell was not found. Issue a Warning & Skip.
3011 NONEXIST = NONEXIST+1
3012 ELSE
3013C----------
3014 NPTT = MAX(1,NPTT)
3015 NLAY = MAX(1,NLAY)
3016 NPT_MAX = MAX(NPTT,NLAY)
3017 NVMAX = NVSHELL1 /(MAX(1,NPG)*NPT_MAX*5)
3018 IF (ID_ELEM /= NEM1) I = PTSHEL(IE)
3019 NEM1 = ID_ELEM
3020 IOK = 0
3021!
3022 DO K=1,NUMMAT
3023 IF (IPM(1,K) == IMAT) THEN
3024 IMAT = K
3025 IOK = 1
3026 EXIT
3027 ENDIF
3028 ENDDO
3029 IF (IOK == 0) THEN
3030 CALL ANCMSG(MSGID=1033,
3031 . MSGTYPE=MSGERROR,
3032 . ANMODE=ANINFO,
3033 . I1=ITRI(IE),
3034 . C1='material law',
3035 . C2='/inishe/fail')
3036 ENDIF ! IF (IOK == 0)
3037!
3038 IG = IXC(6,IE)
3039 IHBE = IGEO(10,IG)
3040 IGTYP=IGEO(11,IG)
3041 SIGSH(1,I) = ID_ELEM
3042 ID_SIGSH(I) = ID_ELEM
3043 IF ( IGTYP == 9 ) NLAY = NINT(GEO(NPROPG*(IG-1)+6))
3044.OR. IF ( IGTYP == 10 IGTYP == 11) THEN
3045 SIGSH(2,I) = NLAY
3046 ELSE
3047 SIGSH(2,I) = NPTT*NLAY
3048 ENDIF
3049.OR. IF (IHBE==12 IHBE==24) THEN
3050 SIGSH(NVSHELL,I) = 4
3051 ELSE
3052 SIGSH(NVSHELL,I) = 1
3053 ENDIF
3054!
3055! check for consistency ( D00 & INIBRI)
3056 IOK = 0
3057 DO K=1,5
3058 NFAIL(K) = MAT_PARAM(IMAT)%FAIL(K)%FAIL_ID
3059.AND. IF (IFAIL == NFAIL(K)
3060 . IRUPT_TYP == MAT_PARAM(IMAT)%FAIL(K)%IRUPT) THEN
3061 IFAIL = K
3062 FAIL_INI(IFAIL)=1
3063 IOK = 1
3064 EXIT
3065 ENDIF
3066 ENDDO
3067 IF (IOK == 0) THEN
3068 CALL ANCMSG(MSGID=1033,
3069 . MSGTYPE=MSGERROR,
3070 . ANMODE=ANINFO,
3071 . I1=ITRI(IE),
3072 . C1='failure criteria',
3073 . C2='/inishe/fail')
3074 ENDIF
3075!
3076 PT = NVSHELL+NUSHELL+3+NORTSHEL
3077 NPG = MAX(1,NPG)
3078 NPTT = MAX(1,NPTT)
3079 NLAY = MAX(1,NLAY)
3080!
3081 NMAX_FAIL = NUM_LINES*NVAR_RUPT
3082 CALL HM_GET_FLOAT_ARRAY('v' ,TMPVAL,NMAX_FAIL,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3083!
3084 DO JJ=1,NUM_LINES
3085 DO K=1,NVAR_RUPT
3086 L = NVAR_RUPT*(JJ-1) + K
3087 SIGSH(PT+L+(IFAIL-1)*NPT_MAX*NPG*NVMAX+
3088 . (ILAY-1)*NVMAX*NPG*NPTT,I) = TMPVAL(L)
3089 ENDDO ! DO K=1,NVAR_RUPT
3090 ENDDO ! DO JJ=1,NUM_LINES
3091!
3092 ENDIF ! IF (IE == 0) THEN
3093 ENDDO ! DO J=1,NB_ELEMENTS
3094C---------
3095 CASE DEFAULT
3096
3097 END SELECT ! SELECT CASE(KEY)
3098
3099 ENDDO ! DO INI=1,NB_INISHE
3100
3101 ENDIF ! IF ( NB_INISHE > 0 )
3102!
3103 NISHELL = I
3104
3105! NUMSHEL = NISHELL
3106
3107!-----------------------------------------
3108! --- /INISH3 ---
3109!-----------------------------------------
3110 I=NUMSHEL ! counted in yctrl.F
3111!
3112 CALL HM_OPTION_COUNT('/inish3', NB_INISH3)
3113!
3114 IF ( NB_INISH3 > 0 ) THEN
3115!
3116 ! Start reading /INISH3 card
3117 CALL HM_OPTION_START('/inish3')
3118!---
3119! to be replaced by --- MAP_TABLES%ISH3NM ---
3120 IF (KTRIELTG==0) THEN
3121C tri des elts du D00 par ID croissant (on ne trie qu'une fois)
3122 DO IE = 1, NUMELTG
3123 ITRI(IE) = IXTG(NIXTG,IE)
3124 END DO
3125 CALL MY_ORDERS(0,WORK,ITRI,INDEX,NUMELTG,1)
3126 DO J = 1, NUMELTG
3127 IE=INDEX(J)
3128 KSYSUSRTG(J) =IXTG(NIXTG,IE)
3129 KSYSUSRTG(NUMELTG+J)=IE
3130 END DO
3131 KTRIELTG=1
3132 END IF
3133!---
3134 DO INI=1,NB_INISH3
3135!
3136 CALL HM_OPTION_READ_KEY(LSUBMODEL,
3137 . UNIT_ID = UID,
3138 . SUBMODEL_INDEX = SUB_INDEX,
3139 . SUBMODEL_ID = SUB_ID,
3140 . KEYWORD2 = KEY,
3141 . KEYWORD3 = KEY2)
3142!
3143 IF (KEY2 /= ' ') GLOB = .TRUE.
3144!
3145! WRITE(iout,*) 'mirc',KEY(1:LEN_TRIM(KEY))
3146!
3147 DO IUNIT=1,UNITAB%NUNITS
3148 IF (UNITAB%UNIT_ID(IUNIT) == UID) THEN
3149 IFLAGUNIT = 1
3150 EXIT
3151 ENDIF
3152 ENDDO
3153!
3154.AND. IF (UID /= 0IFLAGUNIT == 0) THEN
3155 CALL ANCMSG(MSGID=659,ANMODE=ANINFO,MSGTYPE=MSGERROR,
3156 . I2=UID, I1=SUB_ID, C1='inish3',
3157 . C2='inish3',
3158 . C3=' ')
3159 ENDIF
3160c---------------------------------------
3161 SELECT CASE (KEY(1:LEN_TRIM(KEY)))
3162
3163 CASE ( 'epsp_f' )
3164 ISIGSH =1
3165C---------
3166!
3167 CALL HM_GET_INTV('inish3_epsp_f_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
3168!
3169 DO J=1,NB_ELEMENTS
3170 ! Reading --- ID_ELEM, NIP, NPG, THK ---
3171 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
3172 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NIP,J,IS_AVAILABLE,LSUBMODEL)
3173 CALL HM_GET_INT_ARRAY_INDEX('npg',NPG,J,IS_AVAILABLE,LSUBMODEL)
3174 CALL HM_GET_FLOAT_ARRAY_INDEX('thick',THK,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3175!
3176! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH3NM,NUMELTG)
3177! IE = MAP_TABLES%ISH3NM(ELT,2)
3178!
3179 IE = UEL2SYS(ID_ELEM,KSYSUSRTG,NUMELTG)
3180!
3181 IF (IE == 0) THEN
3182 ! Shell was not found. Issue a Warning & Skip.
3183 NONEXIST = NONEXIST+1
3184 ELSE
3185!
3186 I = NUMSHEL + PTSH3N(IE)
3187!
3188 ID_SIGSH(I) = ID_ELEM
3189 SIGSH(1,I) = ID_ELEM
3190 SIGSH(2,I) = NIP
3191 SIGSH(3,I) = THK
3192 SIGSH(NVSHELL - 1,I) = ONE
3193!
3194 IF (NPG <= 1) THEN
3195!---
3196!
3197 SIZE = NIP*MAX(NPG,1)
3198 CALL HM_GET_FLOAT_ARRAY('ep',TMPVAL,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)!
3199!
3200 PT=22
3201 JJ=NIP*MAX(NPG,1)
3202 K0 = 0
3203 DO WHILE(JJ > 0)
3204 L=MIN(JJ,5)
3205 DO K=1,L
3206 SIGSH(PT+(K-1)*6+5,I) = TMPVAL(K+K0)
3207 ENDDO
3208!
3209 K0=K0+5
3210 PT=PT+30
3211 JJ=JJ-5
3212 END DO ! DO WHILE(JJ > 0)
3213!---------------------
3214 ELSEIF (NPG > 1) THEN
3215 SIGSH(NVSHELL,I) = NPG
3216!
3217 IF (NIP == 0) THEN
3218!---
3219 SIZE = NPG
3220 CALL HM_GET_FLOAT_ARRAY('ep',TMPVAL,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)!
3221!
3222 PT=22
3223 DO K=1,NPG
3224 SIGSH(PT+(K-1)*9+5,I) = TMPVAL(K)
3225 ENDDO
3226 ELSE
3227!---
3228 SIZE = NIP*NPG
3229 CALL HM_GET_FLOAT_ARRAY('ep',TMPVAL,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)!
3230!
3231 PT=22
3232 JJ=NIP*NPG
3233 K0 = 0
3234 DO WHILE(JJ > 0)
3235 L=MIN(JJ,5)
3236 DO K=1,L
3237 SIGSH(PT+(K-1)*6+5,I) = TMPVAL(K+K0)
3238 ENDDO
3239!
3240 K0=K0+5
3241 PT=PT+30
3242 JJ=JJ-5
3243 END DO ! DO WHILE(JJ > 0)
3244!---------------------
3245 END IF ! IF (NIP == 0)
3246 END IF ! (NPG<=1)
3247 ENDIF ! IF (IE /= 0)
3248!
3249 ENDDO ! DO J=1,NB_ELEMENTS
3250C---------
3251 CASE ( 'strs_f' )
3252C---------
3253 ISIGSH =1
3254
3255C------------------------------------
3256! --- 'strs_f/glob' ---
3257C------------------------------------
3258
3259 IF (GLOB ) THEN
3260 CALL HM_GET_INTV('inish3_strs_f_glob_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
3261!
3262 DO J=1,NB_ELEMENTS
3263 ! Reading --- ID_ELEM, NIP, NPG, THK ---
3264 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
3265 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NIP,J,IS_AVAILABLE,LSUBMODEL)
3266 CALL HM_GET_INT_ARRAY_INDEX('npg',NPG,J,IS_AVAILABLE,LSUBMODEL)
3267 CALL HM_GET_FLOAT_ARRAY_INDEX('thick',THK,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3268!
3269! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH3NM,NUMELTG)
3270! IE = MAP_TABLES%ISH3NM(ELT,2)
3271!
3272 IE=UEL2SYS(ID_ELEM,KSYSUSRTG,NUMELTG)
3273!
3274 IF (IE == 0) THEN
3275 ! Shell was not found. Issue a Warning & Skip.
3276 NONEXIST = NONEXIST+1
3277 ELSE
3278!
3279 ! Reading CARD_1 --- EM,EB,H1,H2,H3 ---
3280 CALL HM_GET_FLOAT_ARRAY_INDEX('em',EM,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3281 CALL HM_GET_FLOAT_ARRAY_INDEX('eb',EB,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3282!
3283 I = NUMSHEL + PTSH3N(IE)
3284!
3285 SIGSH(1,I) = ID_ELEM
3286 ID_SIGSH(I) = ID_ELEM
3287 SIGSH(2,I) = NIP
3288 SIGSH(3,I) = THK
3289 SIGSH(4,I) = EM
3290 SIGSH(5,I) = EB
3291 SIGSH(14,I) = ZERO
3292 SIGSH(15,I) = ZERO
3293 SIGSH(16,I) = ZERO
3294 SIGSH(17,I) = ONE
3295 SIGSH(NVSHELL - 1,I) = ONE
3296!----
3297.OR. IF (NPG == 0 NPG == 1) THEN
3298!----
3299 IF (NIP == 0) THEN
3300 ! Reading CARD_2 --- sigma_X, sigma_Y, sigma_Z ---
3301 CALL HM_GET_FLOAT_ARRAY('sigma_x',SIGSH(22,I),1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3302 CALL HM_GET_FLOAT_ARRAY('sigma_y',SIGSH(23,I),1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3303 CALL HM_GET_FLOAT_ARRAY('sigma_z',SIGSH(18,I),1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3304 ! Reading CARD_3 --- sigma_XY, sigma_YZ, sigma_ZX ---
3305 CALL HM_GET_FLOAT_ARRAY('sigma_xy',SIGSH(24,I),1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3306 CALL HM_GET_FLOAT_ARRAY('sigma_yz',SIGSH(25,I),1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3307 CALL HM_GET_FLOAT_ARRAY('sigma_zx',SIGSH(26,I),1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3308!
3309 ! Reading CARD_4 --- sigma_bX, sigma_bY, sigma_bZ ---
3310 CALL HM_GET_FLOAT_ARRAY('sigma_bx',SIGSH(28,I),1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3311 CALL HM_GET_FLOAT_ARRAY('sigma_by',SIGSH(29,I),1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3312 CALL HM_GET_FLOAT_ARRAY('sigma_bz',SIGSH(19,I),1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3313 ! Reading CARD_5 --- sigma_bXY, sigma_bYZ, sigma_bZX, eps_p ---
3314 CALL HM_GET_FLOAT_ARRAY('sigma_bxy',SIGSH(30,I),1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3315 CALL HM_GET_FLOAT_ARRAY('sigma_byz',SIGSH(20,I),1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3316 CALL HM_GET_FLOAT_ARRAY('sigma_bzx',SIGSH(21,I),1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3317 CALL HM_GET_FLOAT_ARRAY('eps_p' ,SIGSH(27,I),1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3318!
3319 ELSEIF (NIP /= 0) THEN
3320!
3321!! CALL HM_GET_FLOAT_ARRAY('ep',TMPVAL,36,J,IS_AVAILABLE,LSUBMODEL,UNITAB)!
3322!
3323 SIZE = NIP
3324 CALL HM_GET_FLOAT_ARRAY('sigma_x' ,TMPVAL1,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3325 CALL HM_GET_FLOAT_ARRAY('sigma_y' ,TMPVAL2,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3326 CALL HM_GET_FLOAT_ARRAY('sigma_z' ,TMPVAL3,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3327 CALL HM_GET_FLOAT_ARRAY('sigma_xy',TMPVAL4,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3328 CALL HM_GET_FLOAT_ARRAY('sigma_yz',TMPVAL5,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3329 CALL HM_GET_FLOAT_ARRAY('sigma_zx',TMPVAL6,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3330 CALL HM_GET_FLOAT_ARRAY('eps_p' ,TMPVAL7,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3331 CALL HM_GET_FLOAT_ARRAY('pos_nip' ,TMPVAL8,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3332C------------potision Ti [-1,1] 'pos_nip' ---> undocumented FIELD
3333!
3334 INISHVAR = 22 + NIP*6
3335 DO N=1,NIP
3336 PT = 22 + (N-1)*6
3337 ! Reading CARD_2 --- sigma_X, sigma_Y, sigma_Z ---
3338 SIGSH(PT,I) = TMPVAL1(N)
3339 SIGSH(PT + 1,I) = TMPVAL2(N)
3340 SIGSH(INISHVAR + N,I) = TMPVAL3(N)
3341 SIGSH(PT + 2,I) = TMPVAL4(N)
3342 SIGSH(PT + 3,I) = TMPVAL5(N)
3343 SIGSH(PT + 4,I) = TMPVAL6(N)
3344 SIGSH(PT + 5,I) = TMPVAL7(N)
3345 SIGSH(INISHVAR+NIP+N,I) = TMPVAL8(N)
3346 ENDDO ! DO K=1,NIP
3347 ENDIF ! IF (NIP = 0) THEN
3348!----
3349 ELSEIF (NPG > 1) THEN
3350!----
3351 SIGSH(NVSHELL,I) = NPG
3352!
3353 IF (NIP == 0) THEN
3354!
3355 SIZE = NPG
3356 CALL HM_GET_FLOAT_ARRAY('sigma_x' ,TMPVAL1,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3357 CALL HM_GET_FLOAT_ARRAY('sigma_y' ,TMPVAL2,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3358 CALL HM_GET_FLOAT_ARRAY('sigma_z' ,TMPVAL3,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3359 CALL HM_GET_FLOAT_ARRAY('sigma_xy' ,TMPVAL4,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3360 CALL HM_GET_FLOAT_ARRAY('sigma_yz' ,TMPVAL5,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3361 CALL HM_GET_FLOAT_ARRAY('sigma_zx' ,TMPVAL6,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3362 CALL HM_GET_FLOAT_ARRAY('sigma_bx' ,TMPVAL7,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3363 CALL HM_GET_FLOAT_ARRAY('sigma_by' ,TMPVAL8,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3364 CALL HM_GET_FLOAT_ARRAY('sigma_bz' ,TMPVAL9,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3365 CALL HM_GET_FLOAT_ARRAY('sigma_bxy',TMPVAL10,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3366 CALL HM_GET_FLOAT_ARRAY('sigma_byz',TMPVAL11,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3367 CALL HM_GET_FLOAT_ARRAY('sigma_bzx',TMPVAL12,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3368 CALL HM_GET_FLOAT_ARRAY('eps_p' ,tmpval13,SIZE,j,is_available,lsubmodel,unitab)
3369!
3370 DO k=1,npg
3371 pt= 22 + (k-1)*13
3372 ! Reading CARD_2 --- sigma_X, sigma_Y, sigma_Z ---
3373 sigsh(pt ,i) = tmpval1(k)
3374 sigsh(pt+1,i) = tmpval2(k)
3375 sigsh(pt+2,i) = tmpval3(k)
3376 sigsh(pt+3,i) = tmpval4(k)
3377 sigsh(pt+4,i) = tmpval5(k)
3378 sigsh(pt+5,i) = tmpval6(k)
3379 sigsh(pt+6,i) = tmpval7(k)
3380 sigsh(pt+7,i) = tmpval8(k)
3381 sigsh(pt+8,i) = tmpval9(k)
3382 sigsh(pt+9,i) = tmpval10(k)
3383 sigsh(pt+10,i) = tmpval11(k)
3384 sigsh(pt+11,i) = tmpval12(k)
3385 sigsh(pt+12,i) = tmpval13(k)
3386! SIGSH(PT:PT+11,I) = SIGSH(PT:PT+11,I)
3387! SIGSH(PT+12,I) = SIGSH(PT+12,I)
3388 ENDDO ! DO K=1,NPG
3389!
3390 ELSE ! NIP > 0
3391!
3392 SIZE = nip*npg
3393 CALL hm_get_float_array('sigma_X' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
3394 CALL hm_get_float_array('sigma_Y' ,tmpval2,SIZE,j,is_available,lsubmodel,unitab)
3395 CALL hm_get_float_array('sigma_Z' ,tmpval3,SIZE,j,is_available,lsubmodel,unitab)
3396 CALL hm_get_float_array('sigma_XY',tmpval4,SIZE,j,is_available,lsubmodel,unitab)
3397 CALL hm_get_float_array('sigma_YZ',tmpval5,SIZE,j,is_available,lsubmodel,unitab)
3398 CALL hm_get_float_array('sigma_ZX',tmpval6,SIZE,j,is_available,lsubmodel,unitab)
3399 CALL hm_get_float_array('eps_p' ,tmpval7,SIZE,j,is_available,lsubmodel,unitab)
3400 CALL hm_get_float_array('pos_nip' ,tmpval8,SIZE,j,is_available,lsubmodel,unitab)
3401C------------potision Ti [-1,1] 'pos_nip' ---> undocumented FIELD
3402!
3403 pt = 22
3404 DO n=1,nip
3405 DO k=1,npg
3406 l = (n-1)*npg+k
3407 ! Reading CARD_2 --- sigma_X, sigma_Y, sigma_Z ---
3408 sigsh(pt ,i) = tmpval1(l)
3409 sigsh(pt+1,i) = tmpval2(l)
3410 sigsh(pt+2,i) = tmpval3(l)
3411 sigsh(pt+3,i) = tmpval4(l)
3412 sigsh(pt+4,i) = tmpval5(l)
3413 sigsh(pt+5,i) = tmpval6(l)
3414 sigsh(pt+6,i) = tmpval7(l)
3415 sigsh(pt+7,i) = tmpval8(l)
3416 pt = pt + 8
3417 ENDDO ! DO N=1,NPG
3418 ENDDO ! DO J=1,NIP
3419 ENDIF ! IF (NIP == 0) THEN
3420!----
3421 ENDIF ! IF (NPG == 0 .OR. NPG == 1)
3422!----
3423 ENDIF ! IF (IE == 0)
3424 ENDDO ! DO I=1,NB_ELEMENTS
3425
3426C------------------------------------
3427! --- 'STRS_F' ---
3428C------------------------------------
3429C---------
3430!! CASE ( 'STRS_F' )
3431C---------
3432!! ISIGSH =1
3433!
3434 ELSEIF ( .NOT. glob ) THEN
3435!
3436 CALL hm_get_intv('inish3_strs_f_count',nb_elements,is_available,lsubmodel)
3437!
3438 DO j=1,nb_elements
3439 ! Reading CARD_1 --- ID_ELEM, NIP, NPG, THK ---
3440 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
3441 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
3442 CALL hm_get_int_array_index('npg',npg,j,is_available,lsubmodel)
3443 CALL hm_get_float_array_index('Thick',thk,j,is_available,lsubmodel,unitab)
3444!
3445! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH3NM,NUMELTG)
3446! IE = MAP_TABLES%ISH3NM(ELT,2)
3447!
3448 ie=uel2sys(id_elem,ksysusrtg,numeltg)
3449!
3450 IF (ie == 0) THEN
3451 ! Shell was not found. Issue a Warning & Skip.
3452 nonexist = nonexist+1
3453 ELSE
3454!
3455 ! Reading CARD_2 --- EM,EB,H1,H2,H3 ---
3456 CALL hm_get_float_array_index('Em',em,j,is_available,lsubmodel,unitab)
3457 CALL hm_get_float_array_index('Eb',eb,j,is_available,lsubmodel,unitab)
3458!
3459 i = numshel + ptsh3n(ie)
3460 !!
3461 sigsh(1,i) = id_elem
3462 id_sigsh(i) = id_elem
3463 sigsh(2,i) = nip
3464 sigsh(3,i) = thk
3465 sigsh(4,i) = em
3466 sigsh(5,i) = eb
3467 sigsh(14,i) = zero
3468 sigsh(15,i) = zero
3469 sigsh(16,i) = zero
3470 sigsh(17,i) = zero
3471 sigsh(nvshell - 1,i) = one
3472!----
3473 IF (npg == 0 .OR. npg == 1) THEN
3474!----
3475 IF (nip == 0) THEN
3476 ! Reading CARD_3 --- sigma_1, sigma_2, sigma_12, sigma_23, sigma_31 ---
3477 CALL hm_get_float_array('sigma_1' ,sigsh(22,i),1,j,is_available,lsubmodel,unitab)
3478 CALL hm_get_float_array('sigma_2' ,sigsh(23,i),1,j,is_available,lsubmodel,unitab)
3479 CALL hm_get_float_array('sigma_12',sigsh(24,i),1,j,is_available,lsubmodel,unitab)
3480 CALL hm_get_float_array('sigma_23',sigsh(25,i),1,j,is_available,lsubmodel,unitab)
3481 CALL hm_get_float_array('sigma_31',sigsh(26,i),1,j,is_available,lsubmodel,unitab)
3482!
3483 ! Reading CARD_4 --- eps_p, sigma_b1, sigma_b2, sigma_b12 ---
3484 CALL hm_get_float_array('eps_p' ,sigsh(27,i),1,j,is_available,lsubmodel,unitab)
3485 CALL hm_get_float_array('sigma_b1' ,sigsh(28,i),1,j,is_available,lsubmodel,unitab)
3486 CALL hm_get_float_array('sigma_b2' ,sigsh(29,i),1,j,is_available,lsubmodel,unitab)
3487 CALL hm_get_float_array('sigma_b12',sigsh(30,i),1,j,is_available,lsubmodel,unitab)
3488!
3489 ELSEIF (nip /= 0) THEN
3490!
3491!! CALL HM_GET_FLOAT_ARRAY('Ep',TMPVAL,36,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3492!
3493!
3494 SIZE = nip
3495 CALL hm_get_float_array('sigma_1' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
3496 CALL hm_get_float_array('sigma_2' ,tmpval2,SIZE,j,is_available,lsubmodel,unitab)
3497 CALL hm_get_float_array('sigma_12' ,tmpval3,SIZE,j,is_available,lsubmodel,unitab)
3498 CALL hm_get_float_array('sigma_23' ,tmpval4,SIZE,j,is_available,lsubmodel,unitab)
3499 CALL hm_get_float_array('sigma_31' ,tmpval5,SIZE,j,is_available,lsubmodel,unitab)
3500 CALL hm_get_float_array('eps_p' ,tmpval6,SIZE,j,is_available,lsubmodel,unitab)
3501!
3502!
3503 inishvar = 22 + nip*6
3504 DO n=1,nip
3505 pt = 22 + (n-1)*6
3506 ! Reading CARD_3 --- sigma_1, sigma_2, sigma_12 ---
3507 sigsh(pt ,i) = tmpval1(n)
3508 sigsh(pt + 1,i) = tmpval2(n)
3509 sigsh(pt + 2,i) = tmpval3(n)
3510 sigsh(pt + 3,i) = tmpval4(n)
3511 sigsh(pt + 4,i) = tmpval5(n)
3512 sigsh(pt + 5,i) = tmpval6(n)
3513 ENDDO ! DO K=1,NIP
3514 ENDIF ! IF (NIP = 0) THEN
3515!----
3516 ELSEIF (npg > 1) THEN
3517!----
3518 sigsh(nvshell,i) = npg
3519!
3520 IF (nip == 0) THEN
3521!
3522 SIZE = npg
3523 CALL hm_get_float_array('sigma_1' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
3524 CALL hm_get_float_array('sigma_2' ,tmpval2,SIZE,j,is_available,lsubmodel,unitab)
3525 CALL hm_get_float_array('sigma_12' ,tmpval3,SIZE,j,is_available,lsubmodel,unitab)
3526 CALL hm_get_float_array('sigma_23' ,tmpval4,SIZE,j,is_available,lsubmodel,unitab)
3527 CALL hm_get_float_array('sigma_31' ,tmpval5,SIZE,j,is_available,lsubmodel,unitab)
3528 CALL hm_get_float_array('eps_p' ,tmpval6,SIZE,j,is_available,lsubmodel,unitab)
3529 CALL hm_get_float_array('sigma_b1' ,tmpval7,SIZE,j,is_available,lsubmodel,unitab)
3530 CALL hm_get_float_array('sigma_b2' ,tmpval8,SIZE,j,is_available,lsubmodel,unitab)
3531 CALL hm_get_float_array('sigma_b12' ,tmpval9,SIZE,j,is_available,lsubmodel,unitab)
3532!
3533 DO k=1,npg
3534 pt= 22 + (k-1)*9
3535 ! Reading CARD_3 --- sigma_1, sigma_2, sigma_12, sigma_23, sigma_31 ---
3536 sigsh(pt ,i) = tmpval1(k)
3537 sigsh(pt+1,i) = tmpval2(k)
3538 sigsh(pt+2,i) = tmpval3(k)
3539 sigsh(pt+3,i) = tmpval4(k)
3540 sigsh(pt+4,i) = tmpval5(k)
3541 sigsh(pt+5,i) = tmpval6(k)
3542 sigsh(pt+6,i) = tmpval7(k)
3543 sigsh(pt+7,i) = tmpval8(k)
3544 sigsh(pt+8,i) = tmpval9(k)
3545 ENDDO ! DO K=1,NPG
3546!
3547 ELSE ! NIP > 0
3548!
3549 SIZE = nip*npg
3550 CALL hm_get_float_array('sigma_1' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
3551 CALL hm_get_float_array('sigma_2' ,tmpval2,SIZE,j,is_available,lsubmodel,unitab)
3552 CALL hm_get_float_array('sigma_12' ,tmpval3,SIZE,j,is_available,lsubmodel,unitab)
3553 CALL hm_get_float_array('sigma_23' ,tmpval4,SIZE,j,is_available,lsubmodel,unitab)
3554 CALL hm_get_float_array('sigma_31' ,tmpval5,SIZE,j,is_available,lsubmodel,unitab)
3555 CALL hm_get_float_array('eps_p' ,tmpval6,SIZE,j,is_available,lsubmodel,unitab)
3556!
3557 pt = 22
3558 DO n=1,nip
3559 DO k=1,npg
3560 l = (n-1)*npg+k
3561 ! Reading CARD_3 --- sigma_1, sigma_2, sigma_12 ---
3562 sigsh(pt ,i) = tmpval1(l)
3563 sigsh(pt+1,i) = tmpval2(l)
3564 sigsh(pt+2,i) = tmpval3(l)
3565 sigsh(pt+3,i) = tmpval4(l)
3566 sigsh(pt+4,i) = tmpval5(l)
3567 sigsh(pt+5,i) = tmpval6(l)
3568!
3569 pt = pt + 6
3570 ENDDO ! DO K=1,NPG
3571 ENDDO ! DO N=1,NIP
3572 ENDIF ! IF (NIP == 0) THEN
3573!----
3574 ENDIF ! IF (NPG == 0 .OR. NPG == 1)
3575!----
3576 ENDIF ! IF (IE == 0)
3577 ENDDO ! DO I=1,NB_ELEMENTS
3578C---------
3579 ENDIF ! IF (GLOB ) THEN
3580C---------
3581C---------
3582 CASE ( 'STRA_F' )
3583C---------
3584 ithkshel =2
3585C-------global sys with diff format
3586 IF ( glob ) THEN
3587 CALL hm_get_intv('inish3_stra_f_glob_count',nb_elements,is_available,lsubmodel)
3588!
3589 DO j=1,nb_elements
3590 ! Reading CARD_1 --- ID_ELEM, NIP, NPG, THK ---
3591 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
3592 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
3593 CALL hm_get_int_array_index('npg',npg,j,is_available,lsubmodel)
3594 CALL hm_get_float_array_index('Thick',thk,j,is_available,lsubmodel,unitab)
3595!
3596! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH3NM,NUMELTG)
3597! IE = MAP_TABLES%ISH3NM(ELT,2)
3598!
3599 ie=uel2sys(id_elem,ksysusrtg,numeltg)
3600!
3601 IF (ie == 0) THEN
3602 ! Shell was not found. Issue a Warning & Skip.
3603 nonexist = nonexist+1
3604 ELSE
3605 i = numshel + ptsh3n(ie)
3606 sigsh(1,i) = id_elem
3607 id_sigsh(i) = id_elem
3608 sigsh(2,i) = nip
3609 sigsh(3,i) = thk
3610 sigsh(17,i) = one
3611 sigsh(nvshell,i) = max(1,npg)
3612 sigsh(nvshell - 1,i) = one
3613C----
3614 pt = inishvar1
3615 npp = nip
3616 IF (npp==0) npp=2
3617!===============================================
3618 SIZE = npp*npg
3619 CALL hm_get_float_array('eps_XX' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
3620 CALL hm_get_float_array('eps_YY' ,tmpval2,SIZE,j,is_available,lsubmodel,unitab)
3621 CALL hm_get_float_array('eps_ZZ' ,tmpval3,SIZE,j,is_available,lsubmodel,unitab)
3622 CALL hm_get_float_array('eps_XY' ,tmpval4,SIZE,j,is_available,lsubmodel,unitab)
3623 CALL hm_get_float_array('eps_YZ' ,tmpval5,SIZE,j,is_available,lsubmodel,unitab)
3624 CALL hm_get_float_array('eps_ZX' ,tmpval6,SIZE,j,is_available,lsubmodel,unitab)
3625 CALL hm_get_float_array('T' ,tmpval7,SIZE,j,is_available,lsubmodel,unitab)
3626!
3627 DO n=1,min(2,npp)
3628 DO ipg=1,max(1,npg)
3629 l = (n-1)*max(1,npg)+ipg
3630 sigsh(pt ,i) = tmpval1(l)
3631 sigsh(pt+1,i) = tmpval2(l)
3632 sigsh(pt+2,i) = tmpval3(l)
3633 sigsh(pt+3,i) = tmpval4(l)
3634 sigsh(pt+4,i) = tmpval5(l)
3635 sigsh(pt+5,i) = tmpval6(l)
3636 sigsh(pt+6,i) = tmpval7(l)
3637 pt=pt+7
3638 ENDDO
3639 ENDDO
3640!===============================================
3641 ENDIF ! IF (IE == 0) THEN
3642 ENDDO ! DO J=1,NB_ELEMENTS
3643!
3644 ELSEIF ( .NOT. glob ) THEN
3645!C---------local sy
3646!
3647 CALL hm_get_intv('inish3_stra_f_count',nb_elements,is_available,lsubmodel)
3648!
3649 DO j=1,nb_elements
3650 ! Reading CARD_1 --- ID_ELEM, NIP, NPG, THK ---
3651 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
3652 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
3653 CALL hm_get_int_array_index('npg',npg,j,is_available,lsubmodel)
3654 CALL hm_get_float_array_index('Thick',thk,j,is_available,lsubmodel,unitab)
3655!
3656! elt = set_usrtos(id_elem,map_tables%ISH3NM,numeltg)
3657! IE = MAP_TABLES%ISH4NM(ELT,2)
3658!
3659 ie=uel2sys(id_elem,ksysusrtg,numeltg)
3660!
3661 IF (ie == 0) THEN
3662 ! Shell was not found. Issue a Warning & Skip.
3663 nonexist = nonexist+1
3664 ELSE
3665 i = numshel + ptsh3n(ie)
3666 sigsh(1,i) = id_elem
3667 id_sigsh(i) = id_elem
3668 sigsh(3,i) = thk
3669 sigsh(nvshell - 1,i) = one
3670!
3671 IF (npg == 0 .OR. npg == 1) THEN
3672!
3673 CALL hm_get_float_array('eps_1' ,sigsh(6,i),1,j,is_available,lsubmodel,unitab)
3674 CALL hm_get_float_array('eps_2' ,sigsh(7,i),1,j,is_available,lsubmodel,unitab)
3675 CALL hm_get_float_array('eps_12' ,sigsh(8,i),1,j,is_available,lsubmodel,unitab)
3676 CALL hm_get_float_array('eps_23' ,sigsh(9,i),1,j,is_available,lsubmodel,unitab)
3677 CALL hm_get_float_array('eps_31' ,sigsh(10,i),1,j,is_available,lsubmodel,unitab)
3678 CALL hm_get_float_array('k1' ,sigsh(11,i),1,j,is_available,lsubmodel,unitab)
3679 CALL hm_get_float_array('k2' ,sigsh(12,i),1,j,is_available,lsubmodel,unitab)
3680 CALL hm_get_float_array('k12' ,SIGSH(13,I),1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3681!
3682 ELSEIF (NPG>1 ) THEN
3683!
3684 SIGSH(NVSHELL,I) = NPG
3685
3686 SIGSH(6,I) =ZERO
3687 SIGSH(7,I) =ZERO
3688 SIGSH(8,I) =ZERO
3689 SIGSH(9,I) =ZERO
3690 SIGSH(10,I)=ZERO
3691 SIGSH(11,I)=ZERO
3692 SIGSH(12,I)=ZERO
3693 SIGSH(13,I)=ZERO
3694!
3695 SIZE = NPG
3696 CALL HM_GET_FLOAT_ARRAY('eps_1' ,TMPVAL1,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3697 CALL HM_GET_FLOAT_ARRAY('eps_2' ,TMPVAL2,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3698 CALL HM_GET_FLOAT_ARRAY('eps_12' ,TMPVAL3,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3699 CALL HM_GET_FLOAT_ARRAY('eps_23' ,TMPVAL4,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3700 CALL HM_GET_FLOAT_ARRAY('eps_31' ,TMPVAL5,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3701 CALL HM_GET_FLOAT_ARRAY('k1' ,TMPVAL6,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3702 CALL HM_GET_FLOAT_ARRAY('k2' ,TMPVAL7,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3703 CALL HM_GET_FLOAT_ARRAY('k12' ,TMPVAL8,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3704!
3705 DO IPG=1,NPG
3706 SIGSH(6,I) =SIGSH(6,I) +TMPVAL1(IPG)/NPG
3707 SIGSH(7,I) =SIGSH(7,I) +TMPVAL2(IPG)/NPG
3708 SIGSH(8,I) =SIGSH(8,I) +TMPVAL3(IPG)/NPG
3709 SIGSH(9,I) =SIGSH(9,I) +TMPVAL4(IPG)/NPG
3710 SIGSH(10,I)=SIGSH(10,I)+TMPVAL5(IPG)/NPG
3711 SIGSH(11,I)=SIGSH(11,I)+TMPVAL6(IPG)/NPG
3712 SIGSH(12,I)=SIGSH(12,I)+TMPVAL7(IPG)/NPG
3713 SIGSH(13,I)=SIGSH(13,I)+TMPVAL8(IPG)/NPG
3714 END DO
3715 ELSE
3716C CALL ANCERR(58,ANINFO_BLIND_2)
3717.OR. ENDIF ! IF (NPG == 0 NPG == 1)
3718 ENDIF ! IF (IE == 0) THEN
3719 ENDDO ! DO J=1,NB_ELEMENTS
3720 ENDIF ! IF ( GLOB ) THEN
3721C---------
3722 CASE ( 'thick' )
3723C---------
3724 ITHKSHEL = 1
3725!
3726 CALL HM_GET_INTV('no_elems',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
3727!
3728 DO J=1,NB_ELEMENTS
3729 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
3730 CALL HM_GET_FLOAT_ARRAY_INDEX('thick' ,THK,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3731!
3732!
3733! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH3NM,NUMELTG)
3734! IE = MAP_TABLES%ISH3NM(ELT,2)
3735!
3736 IE=UEL2SYS(ID_ELEM,KSYSUSRTG,NUMELTG)
3737!
3738 IF (IE == 0) THEN
3739 ! Shell was not found. Issue a Warning & Skip.
3740 NONEXIST = NONEXIST+1
3741 ELSE
3742 I = NUMSHEL + PTSH3N(IE)
3743 SIGSH(1,I) = ID_ELEM
3744 ID_SIGSH(I) = ID_ELEM
3745 SIGSH(2,I) = 0
3746 SIGSH(3,I) = THK
3747 ENDIF ! IF (IE == 0)
3748 ENDDO ! DO J=1,NB_ELEMENTS
3749C---------
3750 CASE ( 'epsp' )
3751C---------
3752!
3753 CALL HM_GET_INTV('no_blocks',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
3754!
3755 DO J=1,NB_ELEMENTS
3756 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
3757 CALL HM_GET_FLOAT_ARRAY_INDEX('ep' ,EPSP,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3758!
3759! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH3NM,NUMELTG)
3760! IE = MAP_TABLES%ISH3NM(ELT,2)
3761!
3762 IE=UEL2SYS(ID_ELEM,KSYSUSRTG,NUMELTG)
3763!
3764 IF (IE == 0) THEN
3765 ! Shell was not found. Issue a Warning & Skip.
3766 NONEXIST = NONEXIST+1
3767 ELSE
3768 I = NUMSHEL + PTSH3N(IE)
3769 SIGSH(1,I) = ID_ELEM
3770 ID_SIGSH(I) = ID_ELEM
3771 SIGSH(2,I) = 0
3772 SIGSH(27,I)= EPSP
3773 ENDIF ! IF (IE == 0) THEN
3774 ENDDO ! DO J=1,NB_ELEMENTS
3775!-------------------
3776 CASE ( 'ortho' )
3777!-------------------
3778 CALL HM_GET_INTV('inish3_ortho_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
3779!
3780 DO J=1,NB_ELEMENTS
3781 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
3782 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NIP,J,IS_AVAILABLE,LSUBMODEL)
3783!! CALL HM_GET_INT_ARRAY_INDEX('prop_type',IGTYP,J,IS_AVAILABLE,LSUBMODEL)
3784 CALL HM_GET_FLOAT_ARRAY_INDEX('vx',VX,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3785 CALL HM_GET_FLOAT_ARRAY_INDEX('vy',VY,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3786 CALL HM_GET_FLOAT_ARRAY_INDEX('vz',VZ,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3787!
3788! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH3NM,NUMELTH)
3789! IE = MAP_TABLES%ISH3NM(ELT,2)
3790!
3791 IE=UEL2SYS(ID_ELEM,KSYSUSRTG,NUMELTG)
3792!
3793 IF (IE == 0) THEN
3794 ! Shell was not found. Issue a Warning & Skip.
3795 NONEXIST = NONEXIST+1
3796 ELSE
3797!
3798 IG = IXTG(5,IE)
3799 ISH3N = IGEO(18,IG)
3800 IGTYP=IGEO(11,IG)
3801 IORTSHEL = 1
3802 I = NUMSHEL + PTSH3N(IE)
3803 PT = NVSHELL+NUSHELL
3804 !! SIGSH(1,I) = ID_ELEM
3805 ID_SIGSH(I) = ID_ELEM
3806 IF ( IGTYP == 9) NIP = NINT(GEO(NPROPG*(IG-1)+6))
3807 SIGSH(PT + 4,I) = NIP
3808 IF( ISH3N == 30 ) THEN
3809 SIGSH(NVSHELL,I) = 3
3810 ELSE
3811 SIGSH(NVSHELL,I) = 1
3812 ENDIF
3813 SIGSH(PT+1,I) = VX
3814 SIGSH(PT+2,I) = VY
3815 SIGSH(PT+3,I) = VZ
3816 PT = PT+4
3817 IF ( IGTYP == 9 ) THEN
3818 CALL HM_GET_FLOAT_ARRAY_INDEX('phi_1',PHI1,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3819 CALL HM_GET_FLOAT_ARRAY_INDEX('phi_2',PHI2,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3820 SIGSH(PT+1,I) = PHI1*PI/HUNDRED80
3821 SIGSH(PT+2,I) = PHI2*PI/HUNDRED80
3822 PT = PT + 2
3823 ELSEIF (IGTYP == 1 ) THEN
3824 CALL ANCMSG(MSGID=761,
3825 . MSGTYPE=MSGERROR,
3826 . ANMODE=ANINFO,
3827 . C1='/inish3/ortho',
3828 . C2='sh3n',
3829 . I2=ID_ELEM,I1=IGEO(1,IG))
3830 ELSE
3831 SIZE = NIP
3832 CALL HM_GET_FLOAT_ARRAY('phi_1_array',TMPVAL1,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3833 CALL HM_GET_FLOAT_ARRAY('phi_2_array',TMPVAL2,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3834 DO JJ = 1,NIP
3835 SIGSH(PT+1,I) = TMPVAL1(JJ)*PI/HUNDRED80
3836 SIGSH(PT+2,I) = TMPVAL2(JJ)*PI/HUNDRED80
3837 PT = PT + 2
3838 ENDDO ! DO JJ = 1,NIP
3839 ENDIF ! IF ( IGTYP == 9)
3840 ENDIF ! IF (IE == 0) THEN
3841 ENDDO ! DO J=1,NB_ELEMENTS
3842!-------------------
3843 CASE ( 'orth_loc' )
3844!-------------------
3845 CALL HM_GET_INTV('inish3_orth_loc_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
3846!
3847 DO J=1,NB_ELEMENTS
3848 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
3849 CALL HM_GET_INT_ARRAY_INDEX('nb_lay',NIP,J,IS_AVAILABLE,LSUBMODEL)
3850 CALL HM_GET_INT_ARRAY_INDEX('npg',NPG,J,IS_AVAILABLE,LSUBMODEL)
3851 CALL HM_GET_INT_ARRAY_INDEX('ndir',NDIR,J,IS_AVAILABLE,LSUBMODEL)
3852 CALL HM_GET_INT_ARRAY_INDEX('iunit',FLAGDEG,J,IS_AVAILABLE,LSUBMODEL)
3853!
3854!
3855! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH3NM,NUMELTG)
3856! IE = MAP_TABLES%ISH3NM(ELT,2)
3857!
3858 IE=UEL2SYS(ID_ELEM,KSYSUSRTG,NUMELTG)
3859!
3860 IF (IE == 0) THEN
3861 ! Shell was not found. Issue a Warning & Skip.
3862 NONEXIST = NONEXIST+1
3863 ELSE
3864!
3865 IG = IXTG(5,IE)
3866 ISH3N = IGEO(18,IG)
3867 IGTYP = IGEO(11,IG)
3868 IORTSHEL = 2
3869 I = NUMSHEL + PTSH3N(IE)
3870 PT = NVSHELL + NUSHELL
3871 SIGSH(1,I) = ID_ELEM
3872 ID_SIGSH(I) = ID_ELEM
3873 IF (IGTYP == 9) NIP = NINT(GEO(NPROPG*(IG-1)+6))
3874 SIGSH(PT + 4 ,I) = NIP
3875 SIGSH(PT + 5,I) = ONE
3876 IF (ISH3N == 30) THEN
3877 SIGSH(NVSHELL,I) = 3
3878 ELSE
3879 SIGSH(NVSHELL,I) = 1
3880 ENDIF
3881 PT = PT + 5
3882!
3883.OR. IF (IGTYP == 51 IGTYP == 52) THEN
3884 ISUBSTACK = IWORKSH(3, NUMELC + IE)
3885 NLAY = STACK%IGEO(1,ISUBSTACK)
3886 IPMAT = 2 + NLAY
3887 IF (NDIR /= 2) THEN
3888 DO JJ = 1,NLAY
3889 MLAWLY= STACK%IGEO(IPMAT + JJ,ISUBSTACK) ! layer material
3890 IF (MLAWLY == 58) THEN
3891 CALL ANCMSG(MSGID=1126,
3892 . MSGTYPE=MSGERROR,
3893 . ANMODE=ANINFO,
3894 . C1='sh3n',
3895 . I1=ID_ELEM)
3896 ENDIF
3897 ENDDO
3898 ENDIF
3899.OR. ENDIF ! IF (IGTYP == 51 IGTYP == 52)
3900!
3901 ALLOCATE(MLAW_LY(NIP))
3902 MLAW_LY = 0
3903 SIZE = NIP
3904 CALL HM_GET_FLOAT_ARRAY('phi_i' ,TMPVAL1,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3905 CALL HM_GET_FLOAT_ARRAY('alpha_i',TMPVAL2,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
3906!
3907 IF (IGTYP == 9) THEN
3908 ANGLE1 = TMPVAL1(1) ! one integration point
3909 IF(FLAGDEG == 1) ANGLE1 = ANGLE1*PI/HUNDRED80
3910 SIGSH(PT+1,I) = COS(ANGLE1)
3911 SIGSH(PT+2,I) = SIN(ANGLE1)
3912 PT = PT + 2
3913.OR..OR..OR. ELSEIF (IGTYP == 10 IGTYP == 11 IGTYP == 16
3914.OR..OR. . IGTYP == 17 IGTYP == 51 IGTYP == 52) THEN
3915.OR. IF (IGTYP == 51 IGTYP == 52)THEN
3916 ISUBSTACK = IWORKSH(3, NUMELC + IE)
3917 NLAY = STACK%IGEO(1,ISUBSTACK) !
3918 IPMAT = 2 + NLAY
3919 IPNPT_LAY = IPMAT + 2*NLAY
3920 IF(NLAY /= NIP) THEN
3921 IF(NDRAPE > 0) THEN
3922 IPT = 0
3923 DO JJ =1,NLAY
3924 NSLICE = STACK%IGEO(IPNPT_LAY + JJ,ISUBSTACK)
3925 DO N = 1, NSLICE
3926 IPT = IPT + 1
3927 MLAW_LY(IPT)= STACK%IGEO(IPMAT + JJ,ISUBSTACK)
3928 ENDDO
3929 ENDDO
3930 ELSE
3931 ! error message
3932 ENDIF ! ndrape
3933 ELSE
3934 DO JJ =1,NLAY
3935 MLAW_LY(JJ)= STACK%IGEO(IPMAT + JJ,ISUBSTACK)! layer material
3936 ENDDO
3937 ENDIF
3938 ENDIF
3939 DO JJ = 1,NIP
3940 ANGLE1 = TMPVAL1(JJ)
3941 ANGLE2 = TMPVAL2(JJ)
3942 IF(FLAGDEG == 1) ANGLE1 = ANGLE1*PI/HUNDRED80
3943 IF(FLAGDEG == 1) ANGLE2 = ANGLE2*PI/HUNDRED80
3944!
3945.OR. IF (IGTYP == 16
3946.AND..OR. . (IGTYP == 51 MLAW_LY(JJ) == 58)
3947.AND. . (IGTYP == 52 MLAW_LY(JJ) == 58) ) THEN
3948!
3949 ANGLE2 = ANGLE2 + ANGLE1
3950 SIGSH(PT+1,I) = COS(ANGLE1)
3951 SIGSH(PT+2,I) = SIN(ANGLE1)
3952 SIGSH(PT+3,I) = COS(ANGLE2)
3953 SIGSH(PT+4,I) = SIN(ANGLE2)
3954 PT = PT + 4
3955 ELSE
3956 ANGLE1 = TMPVAL1(JJ)
3957 ANGLE1 = ANGLE1*PI/HUNDRED80
3958 SIGSH(PT+1,I) = COS(ANGLE1)
3959 SIGSH(PT+2,I) = SIN(ANGLE1)
3960 PT = PT + 2
3961 ENDIF
3962 ENDDO ! DO JJ = 1,NIP
3963 ELSEIF (IGTYP == 1) THEN
3964 CALL ANCMSG(MSGID=761,
3965 . MSGTYPE=MSGERROR,
3966 . ANMODE=ANINFO,
3967 . C1='/inish3/orth_loc',
3968 . C2='3 nodes shell',
3969 . I2=ID_ELEM,I1=IGEO(1,IG))
3970 ENDIF ! IF (IGTYP == 9)
3971 IF(ALLOCATED(MLAW_LY))DEALLOCATE(MLAW_LY)
3972 ENDIF ! IF (IE == 0) THEN
3973 ENDDO ! DO J=1,NB_ELEMENTS
3974!-------------------
3975 CASE ( 'scale_yld' )
3976!-------------------
3977 CALL HM_GET_INTV('inish3_scale_yld_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
3978 IYLDINI = 1
3979!
3980 DO J=1,NB_ELEMENTS
3981 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
3982 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NIP,J,IS_AVAILABLE,LSUBMODEL)
3983 CALL HM_GET_INT_ARRAY_INDEX('npg',NPG,J,IS_AVAILABLE,LSUBMODEL)
3984!
3985! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH3NM,NUMELTG)
3986! IE = MAP_TABLES%ISH3NM(ELT,2)
3987!
3988 IE=UEL2SYS(ID_ELEM,KSYSUSRTG,NUMELTG)
3989!
3990 IF (IE == 0) THEN
3991 ! Shell was not found. Issue a Warning & Skip.
3992 NONEXIST = NONEXIST+1
3993 ELSE
3994 I = NUMSHEL + PTSH3N(IE)
3995 SIGSH(NVSHELL + 1,I) = ID_ELEM ! elt ID
3996 ID_SIGSH(I) = ID_ELEM
3997 SIGSH(NVSHELL + 2,I) = NIP ! integ point
3998 SIGSH(NVSHELL + 3,I) = NPG
3999!
4000 SIZE = NPG*NIP
4001 CALL HM_GET_FLOAT_ARRAY('alpha_ij' ,TMPVAL1,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4002!
4003 DO N = 1,NPG
4004 DO IP = 1,NIP
4005 L = (N-1)*NIP+IP
4006 PT=NVSHELL + 3 !22
4007 SCALEYLD = TMPVAL1(L)
4008 SIGSH(PT+ L,I) = SCALEYLD
4009 ENDDO !IP = 1,NIP
4010 ENDDO !N = 1,NPG
4011 PT = PT + NIP * NPG
4012!
4013 ENDIF ! IF (IE == 0) THEN
4014 ENDDO ! DO J=1,NB_ELEMENTS
4015!-------------------
4016 CASE ( 'aux' )
4017!-------------------
4018 CALL HM_GET_INTV('inish3_aux_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
4019 DO J=1,NB_ELEMENTS
4020 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
4021 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NIP,J,IS_AVAILABLE,LSUBMODEL)
4022 CALL HM_GET_INT_ARRAY_INDEX('npg',NPG,J,IS_AVAILABLE,LSUBMODEL)
4023 CALL HM_GET_INT_ARRAY_INDEX('nvars',NUVAR,J,IS_AVAILABLE,LSUBMODEL)
4024!
4025!
4026! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH3NM,NUMELTG)
4027! IE = MAP_TABLES%ISH3NM(ELT,2)
4028!
4029 IE=UEL2SYS(ID_ELEM,KSYSUSRTG,NUMELTG)
4030!
4031 IF (IE == 0) THEN
4032 ! Shell was not found. Issue a Warning & Skip.
4033 NONEXIST = NONEXIST+1
4034 ELSE
4035C----------
4036 IMAT = IXTG(1,IE)
4037 ILAW = IPM(2,IMAT)
4038 NUVARD00 = IPM(8,IMAT)
4039 IF (NUVARD00 > NUVAR) THEN
4040 CALL ANCMSG(MSGID=1121,
4041 . MSGTYPE=MSGWARNING,
4042 . ANMODE=ANINFO,
4043 . I1=ITRI(IE),
4044 . C1='number of user variables',
4045 . C2='material law ',
4046 . I2=IPM(1,IMAT),
4047 . C3='/inish3/aux')
4048 ENDIF
4049.and..or..and. IF ((ILAW == 36 (NUVAR < 4 NUVARD00 > 3)
4050.or. . NUVARD00 < NUVAR)
4051.and..and..and..and. . (ILAW /= 36 ILAW /= 78 ILAW /= 87 ILAW /= 112 NUVARD00 < NUVAR)) THEN
4052 CALL ANCMSG(MSGID=695,
4053 . MSGTYPE=MSGERROR,
4054 . ANMODE=ANINFO,
4055 . I1=ITRI(IE),
4056 . C1='number of user variables',
4057 . C2='material law ',
4058 . I2=IPM(1,IMAT),
4059 . C3='/inish3/aux')
4060 ENDIF
4061C----------
4062 I = NUMSHEL + PTSH3N(IE)
4063 IUSER = 1
4064 NVARSH = NVSHELL + 4
4065 IF (NIP == 0) NIP = 1
4066 IF (NPG == 0) NPG = 1
4067 SIGSH(1,I) = ID_ELEM
4068 ID_SIGSH(I) = ID_ELEM
4069 SIGSH(2,I) = NIP
4070 SIGSH(NVSHELL,I) = NPG
4071 SIGSH(NVSHELL + 2 ,I) = NIP
4072 SIGSH(NVSHELL + 3 ,I) = NPG
4073 SIGSH(NVSHELL + 4 ,I) = NUVAR
4074 PT = 0
4075!
4076 CALL HM_GET_INT_ARRAY_INDEX('num_lines',NUM_LINES,J,IS_AVAILABLE,LSUBMODEL)
4077 NMAX_AUX = NUM_LINES*NUVAR
4078 CALL HM_GET_FLOAT_ARRAY('v' ,TMPVAL,NMAX_AUX,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4079!
4080 DO JJ=1,NUM_LINES
4081 DO K=1,NUVAR
4082 L = NUVAR*(JJ-1) + K
4083 SIGSH(NVARSH+PT+K,I) = TMPVAL(L)
4084 ENDDO ! DO K=1,NUVAR
4085 PT = PT + NUVAR
4086 ENDDO ! DO JJ=1,NUM_LINES
4087!
4088 ENDIF ! IF (IE == 0) THEN
4089 ENDDO ! DO J=1,NB_ELEMENTS
4090!-------------------
4091 CASE ( 'fail' )
4092!-------------------
4093 CALL HM_GET_INTV('inish3_fail_count',nb_elements,is_available,lsubmodel)
4094 DO j=1,nb_elements
4095 CALL hm_get_int_array_index('shell_ID' ,id_elem,j,is_available,lsubmodel)
4096 CALL hm_get_int_array_index('Nlay' ,nlay,j,is_available,lsubmodel)
4097 CALL hm_get_int_array_index('npg' ,npg,j,is_available,lsubmodel)
4098 CALL hm_get_int_array_index('nptt' ,nptt,j,is_available,lsubmodel)
4099 CALL hm_get_int_array_index('lay_id' ,ILAY,J,IS_AVAILABLE,LSUBMODEL)
4100 CALL HM_GET_INT_ARRAY_INDEX('fail_id' ,IFAIL,J,IS_AVAILABLE,LSUBMODEL)
4101 CALL HM_GET_INT_ARRAY_INDEX('ifail_typ',IRUPT_TYP,J,IS_AVAILABLE,LSUBMODEL)
4102 CALL HM_GET_INT_ARRAY_INDEX('nvar' ,NVAR_RUPT,J,IS_AVAILABLE,LSUBMODEL)
4103 CALL HM_GET_INT_ARRAY_INDEX('mat_id' ,IMAT,J,IS_AVAILABLE,LSUBMODEL)
4104 CALL HM_GET_INT_ARRAY_INDEX('num_lines',NUM_LINES,J,IS_AVAILABLE,LSUBMODEL)
4105!
4106! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISH3NM,NUMELTG)
4107! IE = MAP_TABLES%ISH3NM(ELT,2)
4108!
4109 IE=UEL2SYS(ID_ELEM,KSYSUSRTG,NUMELTG)
4110!
4111 IF (IE == 0) THEN
4112 ! Shell was not found. Issue a Warning & Skip.
4113 NONEXIST = NONEXIST+1
4114 ELSE
4115C----------
4116 NPTT = MAX(1,NPTT)
4117 NLAY = MAX(1,NLAY)
4118 NPT_MAX = MAX(NPTT,NLAY)
4119 NVMAX = NVSHELL1 /(MAX(1,NPG)*NPT_MAX*5)
4120 !!IF (ID_ELEM /= NEM1) I = PTSH3N(IE)
4121 NEM1 = ID_ELEM
4122 I = NUMSHEL + PTSH3N(IE)
4123 IOK = 0
4124!
4125 DO K=1,NUMMAT
4126 IF (IPM(1,K) == IMAT) THEN
4127 IMAT = K
4128 IOK = 1
4129 EXIT
4130 ENDIF
4131 ENDDO
4132 IF (IOK == 0) THEN
4133 CALL ANCMSG(MSGID=1033,
4134 . MSGTYPE=MSGERROR,
4135 . ANMODE=ANINFO,
4136 . I1=ITRI(IE),
4137 . C1='material law',
4138 . C2='/inishe/fail')
4139 ENDIF ! IF (IOK == 0)
4140!
4141 IG = IXTG(5,IE)
4142 ISH3N = IGEO(18,IG)
4143 IGTYP=IGEO(11,IG)
4144 SIGSH(1,I) = ID_ELEM
4145 ID_SIGSH(I) = ID_ELEM
4146 IF ( IGTYP == 9 ) NLAY = NINT(GEO(NPROPG*(IG-1)+6))
4147.OR. IF ( IGTYP == 10 IGTYP == 11) THEN
4148 SIGSH(2,I) = NLAY
4149 ELSE
4150 SIGSH(2,I) = NPTT*NLAY
4151 ENDIF
4152 IF( ISH3N == 30 ) THEN
4153 SIGSH(NVSHELL,I) = 3
4154 ELSE
4155 SIGSH(NVSHELL,I) = 1
4156 ENDIF
4157!
4158! check for consistency ( D00 & INIBRI)
4159 IOK = 0
4160 DO K=1,5
4161 NFAIL(K) = MAT_PARAM(IMAT)%FAIL(K)%FAIL_ID
4162.AND. IF (IFAIL == NFAIL(K)
4163 . IRUPT_TYP == MAT_PARAM(IMAT)%FAIL(K)%IRUPT) THEN
4164 IFAIL = K
4165 FAIL_INI(IFAIL)=1
4166 IOK = 1
4167 EXIT
4168 ENDIF
4169 ENDDO
4170 IF (IOK == 0) THEN
4171 CALL ANCMSG(MSGID=1033,
4172 . MSGTYPE=MSGERROR,
4173 . ANMODE=ANINFO,
4174 . I1=ITRI(IE),
4175 . C1='failure criteria',
4176 . C2='/inish3/fail')
4177 ENDIF
4178!
4179 PT = NVSHELL+NUSHELL+3+NORTSHEL
4180 NPG = MAX(1,NPG)
4181 NPTT = MAX(1,NPTT)
4182 NLAY = MAX(1,NLAY)
4183!
4184 NMAX_FAIL = NUM_LINES*NVAR_RUPT
4185 CALL HM_GET_FLOAT_ARRAY('v' ,TMPVAL,NMAX_FAIL,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4186!
4187 DO JJ=1,NUM_LINES
4188 DO K=1,NVAR_RUPT
4189 L = NVAR_RUPT*(JJ-1) + K
4190 SIGSH(PT+L+(IFAIL-1)*NPT_MAX*NPG*NVMAX+
4191 . (ILAY-1)*NVMAX*NPG*NPTT,I) = TMPVAL(L)
4192 ENDDO ! DO K=1,NVAR_RUPT
4193 ENDDO ! DO JJ=1,NUM_LINES
4194!
4195 ENDIF ! IF (IE == 0) THEN
4196 ENDDO ! DO J=1,NB_ELEMENTS
4197!---------------
4198 CASE DEFAULT
4199
4200 END SELECT ! SELECT CASE(KEY)
4201!
4202 ENDDO ! DO INI=1,NB_INISH3
4203
4204 ENDIF ! IF ( NB_INISH3 > 0 )
4205!
4206 NISH3N = I-NISHELL
4207!
4208!-----------------------------------------
4209! --- /INITRUSS ---
4210!-----------------------------------------
4211 NITRUSS = 0
4212 I = 0
4213!
4214 CALL HM_OPTION_COUNT('/initruss', NB_INITRUSS)
4215!
4216 IF ( NB_INITRUSS > 0 ) THEN
4217!
4218 ! Start reading /INITRUSS card
4219 CALL HM_OPTION_START('/initruss')
4220!---
4221! to be replaced by --- MAP_TABLES%ITRUSSM ---
4222 IF (KTRIELTRUSS == 0) THEN
4223C tri des elts du D00 par ID croissant (on ne trie qu'une fois)
4224 DO IE = 1, NUMELT
4225 ITRI(IE) = IXT(NIXT,IE)
4226 END DO
4227 CALL MY_ORDERS(0,WORK,ITRI,INDEX,NUMELT,1)
4228 DO J = 1, NUMELT
4229 IE=INDEX(J)
4230 KSYSUSR(J) =IXT(NIXT,IE)
4231 KSYSUSR(NUMELT+J)=IE
4232 END DO
4233 KTRIELTRUSS=1
4234 ENDIF
4235!---
4236 DO INI=1,NB_INITRUSS
4237!
4238 CALL HM_OPTION_READ_KEY(LSUBMODEL,
4239 . UNIT_ID = UID,
4240 . SUBMODEL_INDEX = SUB_INDEX,
4241 . SUBMODEL_ID = SUB_ID,
4242 . KEYWORD2 = KEY)
4243!
4244 IFLAGUNIT = 0
4245 DO IUNIT=1,UNITAB%NUNITS
4246 IF (UNITAB%UNIT_ID(IUNIT) == UID) THEN
4247 IFLAGUNIT = 1
4248 EXIT
4249 ENDIF
4250 ENDDO
4251.AND. IF (UID /= 0IFLAGUNIT == 0) THEN
4252 CALL ANCMSG(MSGID=659,ANMODE=ANINFO,MSGTYPE=MSGERROR,
4253 . I2=UID,I1=SUB_ID,C1='initruss',
4254 . C2='initruss',
4255 . C3=' ')
4256 ENDIF
4257c---------------------------------------
4258 SELECT CASE (KEY(1:LEN_TRIM(KEY)))
4259C---------
4260 CASE ( 'full' )
4261C---------
4262!
4263 CALL HM_GET_INTV('no_of_elems',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
4264!
4265 DO J=1,NB_ELEMENTS
4266 ! Reading --- ID_ELEM, Prop ... ---
4267 CALL HM_GET_INT_ARRAY_INDEX('truss_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
4268 CALL HM_GET_INT_ARRAY_INDEX('prop_type',IGTYP,J,IS_AVAILABLE,LSUBMODEL)
4269!
4270! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ITRUSSM,NUMELT)
4271! IE = MAP_TABLES%ITRUSSM(ELT,2)
4272!
4273 IE=UEL2SYS(ID_ELEM,KSYSUSR,NUMELT)
4274!
4275 IF (IE == 0) THEN
4276 ! Shell was not found. Issue a Warning & Skip.
4277 NONEXIST = NONEXIST+1
4278 ELSE
4279!
4280 CALL HM_GET_FLOAT_ARRAY_INDEX('eint' ,EIN,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4281 CALL HM_GET_FLOAT_ARRAY_INDEX('f' ,FOR,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4282 CALL HM_GET_FLOAT_ARRAY_INDEX('area' ,EPSP,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4283 CALL HM_GET_FLOAT_ARRAY_INDEX('eps_p',AREA,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4284!
4285 I=I+1
4286 ID_SIGTRUSS(I) = ID_ELEM
4287 SIGTRUSS(1,I) = ID_ELEM
4288 SIGTRUSS(2,I) = IGTYP
4289 SIGTRUSS(3,I) = EIN
4290 SIGTRUSS(4,I) = FOR
4291 SIGTRUSS(5,I) = EPSP
4292 SIGTRUSS(6,I) = AREA
4293!
4294 ENDIF ! IF (IE == 0)
4295 ENDDO ! DO J=1,NB_ELEMENTS
4296!
4297 CASE DEFAULT
4298!
4299 END SELECT ! SELECT CASE(KEY)
4300!
4301 ENDDO ! DO INI=1,NB_NITRUSS
4302
4303 ENDIF ! IF ( NB_NITRUSS > 0 )
4304!
4305 NITRUSS = I
4306
4307
4308
4309!-----------------------------------------
4310! --- /INIBEAM ---
4311!-----------------------------------------
4312 NIBEAM = 0
4313 I = 0
4314!
4315 CALL HM_OPTION_COUNT('/inibeam', NB_INIBEAM)
4316!
4317 IF ( NB_INIBEAM > 0 ) THEN
4318!
4319 ! Start reading /INIBEAM card
4320 CALL HM_OPTION_START('/inibeam')
4321!---
4322! to be replaced by --- MAP_TABLES%IBEAMM ---
4323 IF (KTRIELBEAM == 0) THEN
4324! tri local des elts du D00 par ID croissant (on ne trie qu'une fois)
4325 DO ie = 1,numelp
4326 itri(ie) = ixp(nixp,ie)
4327 ENDDO
4328 CALL my_orders(0,work,itri,index,numelp,1)
4329 DO j = 1,numelp
4330 ie = index(j)
4331 ksysusr(j) =ixp(nixp,ie)
4332 ksysusr(numelp+j)=ie
4333 ENDDO
4334 ktrielbeam=1
4335 ENDIF ! IF (KTRIELBEAM==0)
4336!---
4337 DO ini=1,nb_inibeam
4338!
4339 CALL hm_option_read_key(lsubmodel,
4340 . unit_id = uid,
4341 . submodel_index = sub_index,
4342 . submodel_id = sub_id,
4343 . keyword2 = key)
4344!
4345 iflagunit = 0
4346 DO iunit=1,unitab%NUNITS
4347 IF (unitab%UNIT_ID(iunit) == uid) THEN
4348 iflagunit = 1
4349 EXIT
4350 ENDIF
4351 ENDDO
4352 IF (uid /= 0.AND.iflagunit == 0) THEN
4353 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
4354 . i2=uid,i1=sub_id,c1='INIBEAM',
4355 . c2='INIBEAM',
4356 . c3=' ')
4357 ENDIF
4358c---------------------------------------
4359 SELECT CASE (key(1:len_trim(key)))
4360C---------
4361 CASE ( 'FULL' )
4362C---------
4363!
4364 CALL hm_get_intv('inibeam_count',nb_elements,is_available,lsubmodel)
4365!
4366 DO j=1,nb_elements
4367 ! Reading --- ID_ELEM, Prop ... ---
4368 CALL hm_get_int_array_index('beam_ID' ,id_elem,j,is_available,lsubmodel)
4369 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
4370 CALL hm_get_int_array_index('prop_type',igtyp,j,is_available,lsubmodel)
4371!
4372! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%IBEAMM,NUMELP)
4373! IE = MAP_TABLES%ITRUSSM(ELT,2)
4374!
4375 ie=uel2sys(id_elem,ksysusr,numelp)
4376!
4377 IF (ie == 0) THEN
4378 ! Shell was not found. Issue a Warning & Skip.
4379 nonexist = nonexist+1
4380 ELSE
4381 CALL hm_get_float_array_index('EImemb' ,em,j,is_available,lsubmodel,unitab)
4382 CALL hm_get_float_array_index('EIbend' ,eb,j,is_available,lsubmodel,unitab)
4383 CALL hm_get_float_array_index('F1' ,for1,j,is_available,lsubmodel,unitab)
4384 CALL hm_get_float_array_index('F2' ,for2,j,is_available,lsubmodel,unitab)
4385 CALL hm_get_float_array_index('F3' ,for3,j,is_available,lsubmodel,unitab)
4386 CALL hm_get_float_array_index('M1' ,mom1,j,is_available,lsubmodel,unitab)
4387 CALL hm_get_float_array_index('M2' ,mom2,j,is_available,lsubmodel,unitab)
4388 CALL hm_get_float_array_index('M3' ,mom3,j,is_available,lsubmodel,unitab)
4389!
4390 i=i+1
4391 id_sigbeam(i) = id_elem
4392 sigbeam(1,i) = id_elem
4393 sigbeam(2,i) = nip
4394 sigbeam(3,i) = igtyp
4395!
4396 sigbeam(4,i) = em
4397 sigbeam(5,i) = eb
4398!
4399 sigbeam(6,i) = for1
4400 sigbeam(7,i) = for2
4401 sigbeam(8,i) = for3
4402 sigbeam(9,i) = mom1
4403 sigbeam(10,i) = mom2
4404 sigbeam(11,i) = mom3
4405!
4406 pt = 11
4407 IF (nip == 0) THEN
4408 IF (igtyp == 3) THEN
4409 CALL hm_get_float_array_index('EpsilonP' ,epsp,j,is_available,lsubmodel,unitab)
4410 sigbeam(pt+1,i) = epsp
4411 ENDIF ! IF (IGTYP == 3)
4412 ELSEIF (nip > 0) THEN
4413
4414 IF (igtyp == 18) THEN
4415 SIZE = nip
4416 CALL hm_get_float_array('Sigma1' ,tmpval1,SIZE,j,is_available,lsubmodel,unitab)
4417 CALL hm_get_float_array('Sigma12' ,tmpval2,SIZE,j,is_available,lsubmodel,unitab)
4418 CALL hm_get_float_array('Sigma13' ,tmpval3,SIZE,j,is_available,lsubmodel,unitab)
4419 CALL hm_get_float_array('EpsilonP_array',tmpval4,SIZE,j,is_available,lsubmodel,unitab)
4420 DO k=1,nip
4421 sigbeam(pt+1,i) = tmpval1(k) ! SXX
4422 sigbeam(pt+2,i) = tmpval2(k) ! SXY
4423 sigbeam(pt+3,i) = tmpval3(k) ! SZX
4424 sigbeam(pt+4,i) = tmpval4(k) ! EPSP
4425!
4426 pt = pt + 4
4427 ENDDO ! DO K=1,NIP
4428 ENDIF ! IF (IGTYP == 18)
4429!------
4430 ENDIF ! IF (NIP == 0)
4431!
4432 ENDIF ! IF (IE == 0)
4433!
4434 ENDDO ! DO J=1,NB_ELEMENTS
4435!
4436C---------
4437 CASE ( 'AUX' )
4438C---------
4439!
4440!
4441 CALL hm_get_intv('inibeam_count',nb_elements,is_available,lsubmodel)
4442!
4443 DO j=1,nb_elements
4444 ! Reading --- ID_ELEM, Prop ... ---
4445 CALL hm_get_int_array_index('beam_ID' ,id_elem,j,is_available,lsubmodel)
4446 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
4447 CALL hm_get_int_array_index('prop_type',igtyp,j,is_available,lsubmodel)
4448 CALL hm_get_int_array_index('nvars' ,nuvar,j,is_available,lsubmodel)
4449!
4450! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%IBEAMM,NUMELP)
4451! IE = MAP_TABLES%ITRUSSM(ELT,2)
4452!
4453 ie=uel2sys(id_elem,ksysusr,numelp)
4454!
4455 IF (ie == 0) THEN
4456 ! Shell was not found. Issue a Warning & Skip.
4457 nonexist = nonexist+1
4458 ELSE
4459!
4460! -- UVAR --
4461!
4462 i=i+1
4463 id_sigbeam(i) = id_elem
4464 sigbeam(1,i) = id_elem
4465 sigbeam(2,i) = nip
4466!
4467 iuser = 1
4468 nvarbeam = nvbeam + 4
4469 sigbeam(nvbeam + 1 ,i) = id_elem
4470 sigbeam(nvbeam + 2 ,i) = nip
4471 sigbeam(nvbeam + 3 ,i) = igtyp
4472 sigbeam(nvbeam + 4 ,i) = nuvar
4473!
4474 IF (igtyp /= 18) THEN
4475 CALL ancmsg(msgid=1236,anmode=aninfo,msgtype=msgerror,
4476 . c1='AUX',
4477 . i1=id_elem)
4478 ENDIF
4479!
4480 pt = 0
4481!
4482 nmax_aux = nip*nuvar
4483 CALL hm_get_float_array('V' ,tmpval,nmax_aux,j,is_available,lsubmodel,unitab)
4484!
4485 DO jj=1,nip
4486 DO k=1,nuvar
4487 l = nuvar*(jj-1) + k
4488 sigbeam(nvarbeam+pt+k,i) = tmpval(l)
4489 ENDDO ! DO K=1,NUVAR
4490 pt = pt + nuvar
4491 ENDDO ! DO JJ=1,NIP
4492!
4493 ENDIF ! IF (IE == 0)
4494!
4495 ENDDO ! DO J=1,NB_ELEMENTS
4496!
4497 CASE DEFAULT
4498!
4499 END SELECT ! SELECT CASE(KEY)
4500!
4501 ENDDO ! DO INI=1,NB_INIBEAM
4502
4503 ENDIF ! IF ( NB_INIBEAM > 0 )
4504!
4505 nibeam = i
4506
4507
4508
4509!-----------------------------------------
4510! --- /INISPRI ---
4511!-----------------------------------------
4512 nispring = 0
4513 i = 0
4514!
4515 CALL hm_option_count('/INISPRI', nb_inispri)
4516!
4517 IF ( nb_inispri > 0 ) THEN
4518!
4519 ! Start reading /INISPRI card
4520 CALL hm_option_start('/INISPRI')
4521!---
4522! to be replaced by --- MAP_TABLES%ISPRINGM ---
4523 IF (ktrielspr == 0) THEN
4524C tri local des elts du D00 par ID croissant (on ne trie qu'une fois)
4525 DO ie = 1,numelr
4526 itri(ie) = ixr(nixr,ie)
4527 ENDDO
4528 CALL my_orders(0,work,itri,index,numelr,1)
4529 DO j = 1,numelr
4530 ie = index(j)
4531 ksysusr(j) =ixr(nixr,ie)
4532 ksysusr(numelr+j)=ie
4533 ENDDO
4534 ktrielspr=1
4535 ENDIF ! IF (KTRIELSPR==0)
4536!---
4537 DO ini=1,nb_inispri
4538!
4539 CALL hm_option_read_key(lsubmodel,
4540 . unit_id = uid,
4541 . submodel_index = sub_index,
4542 . submodel_id = sub_id,
4543 . keyword2 = key)
4544!
4545 iflagunit = 0
4546 DO iunit=1,unitab%NUNITS
4547 IF (unitab%UNIT_ID(iunit) == uid) THEN
4548 iflagunit = 1
4549 EXIT
4550 ENDIF
4551 ENDDO
4552 IF (uid /= 0.AND.iflagunit == 0) THEN
4553 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
4554 . i2=uid,i1=sub_id,c1='INISPRING',
4555 . c2='INISPRI',
4556 . c3=' ')
4557 ENDIF
4558c---------------------------------------
4559 SELECT CASE (key(1:len_trim(key)))
4560C---------
4561 CASE ( 'FULL' )
4562C---------
4563!
4564 CALL hm_get_intv('size_spring',nb_elements,is_available,lsubmodel)
4565!
4566 DO j=1,nb_elements
4567 ! Reading --- ID_ELEM, Prop ... ---
4568 CALL hm_get_int_array_index('spring_ID',id_elem,j,is_available,lsubmodel)
4569 CALL hm_get_int_array_index('prop_type',igtyp,j,is_available,lsubmodel)
4570 CALL hm_get_int_array_index('nvars' ,nuvar,j,is_available,lsubmodel)
4571!
4572! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%ISPRINGM,NUMELR)
4573! IE = MAP_TABLES%ISPRINGM(ELT,2)
4574!
4575 ie=uel2sys(id_elem,ksysusr,numelr)
4576!
4577 IF (ie == 0) THEN
4578 ! Shell was not found. Issue a Warning & Skip.
4579 nonexist = nonexist+1
4580 ELSE
4581 i=i+1
4582 id_sigspri(i) = id_elem
4583 sigrs(1,i) = id_elem
4584C------
4585 IF (igtyp == 4 .OR. igtyp == 12) THEN
4586C------
4587 CALL hm_get_float_array_index('F_X' ,sigrs(2,i),j,is_available,lsubmodel,unitab)
4588 CALL hm_get_float_array_index('D_X' ,sigrs(3,i),j,is_available,lsubmodel,unitab)
4589 CALL hm_get_float_array_index('FEP_X' ,sigrs(4,i),j,is_available,lsubmodel,unitab)
4590 CALL hm_get_float_array_index('DPL_X+' ,sigrs(5,i),j,is_available,lsubmodel,unitab)
4591 CALL hm_get_float_array_index('dpl_x-' ,SIGRS(6,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4592 CALL HM_GET_FLOAT_ARRAY_INDEX('l_x' ,sigrs(7,i),j,is_available,lsubmodel,unitab)
4593 CALL hm_get_float_array_index('EI' ,sigrs(8,i),j,is_available,lsubmodel,unitab)
4594!
4595 IF (igtyp == 12) THEN
4596 CALL hm_get_float_array_index('DFS' ,sigrs(9,i),j,is_available,lsubmodel,unitab)
4597 ENDIF
4598C------
4599 ELSEIF (igtyp == 8 .OR. igtyp == 13 .OR. igtyp == 25 .OR. igtyp == 23) THEN
4600C------
4601 CALL hm_get_float_array_index('F_X' ,sigrs(2,i),j,is_available,lsubmodel,unitab)
4602 CALL hm_get_float_array_index('D_X' ,sigrs(3,i),j,is_available,lsubmodel,unitab)
4603 CALL hm_get_float_array_index('FEP_X' ,sigrs(4,i),j,is_available,lsubmodel,unitab)
4604 CALL hm_get_float_array_index('DPL_X+' ,sigrs(5,i),j,is_available,lsubmodel,unitab)
4605 CALL hm_get_float_array_index('DPL_X-' ,sigrs(6,i),j,is_available,lsubmodel,unitab)
4606!
4607 CALL hm_get_float_array_index('F_Y' ,sigrs(7,i),j,is_available,lsubmodel,unitab)
4608 CALL hm_get_float_array_index('D_Y' ,sigrs(8,i),j,is_available,lsubmodel,unitab)
4609 CALL hm_get_float_array_index('FEP_Y' ,sigrs(9,i),j,is_available,lsubmodel,unitab)
4610 CALL hm_get_float_array_index('DPL_Y+' ,sigrs(10,i),j,is_available,lsubmodel,unitab)
4611 CALL hm_get_float_array_index('DPL_Y-' ,sigrs(11,i),j,is_available,lsubmodel,unitab)
4612!
4613 CALL hm_get_float_array_index('f_z' ,SIGRS(12,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4614 CALL HM_GET_FLOAT_ARRAY_INDEX('d_z' ,SIGRS(13,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4615 CALL HM_GET_FLOAT_ARRAY_INDEX('fep_z' ,SIGRS(14,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4616 CALL HM_GET_FLOAT_ARRAY_INDEX('dpl_z+' ,SIGRS(15,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4617 CALL HM_GET_FLOAT_ARRAY_INDEX('dpl_z-' ,SIGRS(16,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4618!
4619 CALL HM_GET_FLOAT_ARRAY_INDEX('m_x' ,SIGRS(17,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4620 CALL HM_GET_FLOAT_ARRAY_INDEX('r_x' ,SIGRS(18,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4621 CALL HM_GET_FLOAT_ARRAY_INDEX('mep_x' ,SIGRS(19,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4622 CALL HM_GET_FLOAT_ARRAY_INDEX('rpl_x+' ,SIGRS(20,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4623 CALL HM_GET_FLOAT_ARRAY_INDEX('rpl_x-' ,SIGRS(21,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4624!
4625 CALL HM_GET_FLOAT_ARRAY_INDEX('m_y' ,SIGRS(22,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4626 CALL HM_GET_FLOAT_ARRAY_INDEX('r_y' ,SIGRS(23,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4627 CALL HM_GET_FLOAT_ARRAY_INDEX('mep_y' ,SIGRS(24,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4628 CALL HM_GET_FLOAT_ARRAY_INDEX('rpl_y+' ,SIGRS(25,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4629 CALL HM_GET_FLOAT_ARRAY_INDEX('rpl_y-' ,SIGRS(26,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4630!
4631 CALL HM_GET_FLOAT_ARRAY_INDEX('m_z' ,SIGRS(27,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4632 CALL HM_GET_FLOAT_ARRAY_INDEX('r_z' ,SIGRS(28,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4633 CALL HM_GET_FLOAT_ARRAY_INDEX('mep_z' ,SIGRS(29,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4634 CALL HM_GET_FLOAT_ARRAY_INDEX('rpl_z+' ,SIGRS(30,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4635 CALL HM_GET_FLOAT_ARRAY_INDEX('rpl_z-' ,SIGRS(31,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4636!
4637 CALL HM_GET_FLOAT_ARRAY_INDEX('l_x' ,SIGRS(32,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4638 CALL HM_GET_FLOAT_ARRAY_INDEX('l_y' ,SIGRS(33,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4639 CALL HM_GET_FLOAT_ARRAY_INDEX('l_z' ,SIGRS(34,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4640 CALL HM_GET_FLOAT_ARRAY_INDEX('ei' ,SIGRS(35,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4641 CALL HM_GET_FLOAT_ARRAY_INDEX('ed_x' ,SIGRS(36,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4642!
4643 CALL HM_GET_FLOAT_ARRAY_INDEX('ed_y' ,SIGRS(37,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4644 CALL HM_GET_FLOAT_ARRAY_INDEX('ed_z' ,SIGRS(38,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4645 CALL HM_GET_FLOAT_ARRAY_INDEX('er_x' ,SIGRS(39,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4646 CALL HM_GET_FLOAT_ARRAY_INDEX('er_y' ,SIGRS(40,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4647 CALL HM_GET_FLOAT_ARRAY_INDEX('er_z' ,SIGRS(41,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4648C------
4649 ELSEIF (IGTYP == 26) THEN
4650C------
4651 CALL HM_GET_FLOAT_ARRAY_INDEX('f_x' ,SIGRS(2,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4652 CALL HM_GET_FLOAT_ARRAY_INDEX('d_x' ,SIGRS(3,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4653 CALL HM_GET_FLOAT_ARRAY_INDEX('fep_x' ,SIGRS(4,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4654 CALL HM_GET_FLOAT_ARRAY_INDEX('l_x' ,SIGRS(7,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4655 CALL HM_GET_FLOAT_ARRAY_INDEX('ei' ,SIGRS(8,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4656 CALL HM_GET_FLOAT_ARRAY_INDEX('dv' ,SIGRS(9,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4657C------
4658C user springs
4659.OR..OR..OR. ELSEIF (IGTYP == 29 IGTYP == 30 IGTYP == 31
4660.OR..OR..OR. . IGTYP == 32 IGTYP == 33 IGTYP == 35
4661.OR..OR..OR. . IGTYP == 36 IGTYP == 44 IGTYP == 45
4662 . IGTYP == 46) THEN
4663C------!
4664 CALL HM_GET_FLOAT_ARRAY_INDEX('f_x' ,SIGRS(2,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4665 CALL HM_GET_FLOAT_ARRAY_INDEX('d_x' ,SIGRS(3,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4666 CALL HM_GET_FLOAT_ARRAY_INDEX('f_y' ,SIGRS(4,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4667 CALL HM_GET_FLOAT_ARRAY_INDEX('d_y' ,SIGRS(5,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4668 CALL HM_GET_FLOAT_ARRAY_INDEX('f_z' ,SIGRS(6,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4669 CALL HM_GET_FLOAT_ARRAY_INDEX('d_z' ,SIGRS(7,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4670 CALL HM_GET_FLOAT_ARRAY_INDEX('m_x' ,SIGRS(8,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4671 CALL HM_GET_FLOAT_ARRAY_INDEX('r_x' ,SIGRS(9,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4672 CALL HM_GET_FLOAT_ARRAY_INDEX('m_y' ,SIGRS(10,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4673 CALL HM_GET_FLOAT_ARRAY_INDEX('r_y' ,SIGRS(11,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4674 CALL HM_GET_FLOAT_ARRAY_INDEX('m_z' ,SIGRS(12,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4675 CALL HM_GET_FLOAT_ARRAY_INDEX('r_z' ,SIGRS(13,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4676 CALL HM_GET_FLOAT_ARRAY_INDEX('ei' ,SIGRS(14,I),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4677!
4678 PT = 14
4679!
4680! -- UVAR --
4681!
4682 SIZE = NUVAR
4683 CALL HM_GET_FLOAT_ARRAY('vr' ,TMPVAL,SIZE,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4684!
4685 DO K=1,NUVAR
4686 SIGRS(PT+K,I) = TMPVAL(K)
4687 ENDDO ! DO K=1,NUVAR
4688 PT = PT + NUVAR
4689!
4690.OR. ENDIF ! IF (IGTYP == 4 IGTYP == 12)
4691!
4692 ENDIF ! IF (IE == 0)
4693!
4694 ENDDO ! DO J=1,NB_ELEMENTS
4695!
4696 CASE DEFAULT
4697!
4698 END SELECT ! SELECT CASE(KEY)
4699!
4700 ENDDO ! DO INI=1,NB_INISPRI
4701
4702 ENDIF ! IF ( NB_INISPRI > 0 )
4703!
4704 NISPRING = I
4705
4706
4707
4708!-----------------------------------------
4709! --- /INIQUA ---
4710!-----------------------------------------
4711 NIQUAD = 0
4712 I = 0
4713!
4714 CALL HM_OPTION_COUNT('/iniqua', NB_INIQUA)
4715!
4716 IF ( NB_INIQUA > 0 ) THEN
4717!
4718 ! Start reading /INIQUA card
4719 CALL HM_OPTION_START('/iniqua')
4720!---
4721! to be replaced by --- MAP_TABLES%IQUADM ---
4722 IF (KTRIELTQUAD == 0) THEN
4723C tri des elts du D00 par ID croissant (on ne trie qu'une fois)
4724 DO IE = 1, NUMELQ
4725 ITRIQ(IE) = IXQ(NIXQ,IE)
4726 END DO
4727 CALL MY_ORDERS(0,WORK,ITRIQ,INDEXQ,NUMELQ,1)
4728 DO J = 1, NUMELQ
4729 IE=INDEXQ(J)
4730 KSYSUSRQ(J) = IXQ(NIXQ,IE)
4731 KSYSUSRQ(NUMELQ+J)=IE
4732 END DO
4733 KTRIELTQUAD=1
4734 ENDIF
4735!---
4736 DO INI=1,NB_INIQUA
4737!
4738 CALL HM_OPTION_READ_KEY(LSUBMODEL,
4739 . UNIT_ID = UID,
4740 . SUBMODEL_INDEX = SUB_INDEX,
4741 . SUBMODEL_ID = SUB_ID,
4742 . KEYWORD2 = KEY)
4743!
4744 IFLAGUNIT = 0
4745 DO IUNIT=1,UNITAB%NUNITS
4746 IF (UNITAB%UNIT_ID(IUNIT) == UID) THEN
4747 IFLAGUNIT = 1
4748 EXIT
4749 ENDIF
4750 ENDDO
4751.AND. IF (UID/=0IFLAGUNIT == 0) THEN
4752 CALL ANCMSG(MSGID=659,ANMODE=ANINFO,MSGTYPE=MSGERROR,
4753 . I2=UID,I1=SUB_ID,C1='iniqua',
4754 . C2='iniqua',
4755 . C3=' ')
4756 ENDIF
4757c---------------------------------------
4758 SELECT CASE (KEY(1:LEN_TRIM(KEY)))
4759C---------
4760 CASE ( 'dens' )
4761C---------
4762!
4763 CALL HM_GET_INTV('no_blocks',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
4764!
4765 DO J=1,NB_ELEMENTS
4766 ! Reading --- ID_ELEM, ... ---
4767 CALL HM_GET_INT_ARRAY_INDEX('quad_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
4768!
4769! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%IQUADM,NUMELQ)
4770! IE = MAP_TABLES%IQUADM(ELT,2)
4771!
4772!! IE=UEL2SYS(ID_ELEM,KSYSUSR,NUMELQ)
4773 IE=UEL2SYS(ID_ELEM,KSYSUSRQ,NUMELQ)
4774!
4775 IF (IE == 0) THEN
4776 ! Shell was not found. Issue a Warning & Skip.
4777 NONEXIST = NONEXIST+1
4778 ELSE
4779 CALL HM_GET_FLOAT_ARRAY_INDEX('value',DENS,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4780 I=I+1
4781 ID_QUAD_SIGI(I) = ID_ELEM
4782 SIGI(8,I) = DENS
4783 ENDIF ! IF (IE == 0)
4784 ENDDO ! DO J=1,NB_ELEMENTS
4785C---------
4786 CASE ( 'ener' )
4787C---------
4788!
4789 CALL HM_GET_INTV('no_blocks',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
4790!
4791 DO J=1,NB_ELEMENTS
4792 ! Reading --- ID_ELEM, ... ---
4793 CALL HM_GET_INT_ARRAY_INDEX('quad_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
4794!
4795! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%IQUADM,NUMELQ)
4796! IE = MAP_TABLES%IQUADM(ELT,2)
4797!
4798!! IE=UEL2SYS(ID_ELEM,KSYSUSR,NUMELQ)
4799 IE=UEL2SYS(ID_ELEM,KSYSUSRQ,NUMELQ)
4800!
4801 IF (IE == 0) THEN
4802 ! Shell was not found. Issue a Warning & Skip.
4803 NONEXIST = NONEXIST+1
4804 ELSE
4805 CALL HM_GET_FLOAT_ARRAY_INDEX('value',ENER,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4806 I=I+1
4807 ID_QUAD_SIGI(I) = ID_ELEM
4808 SIGI(9,I) = ENER
4809 ENDIF ! IF (IE == 0)
4810 ENDDO ! DO J=1,NB_ELEMENTS
4811C---------
4812 CASE ( 'epsp' )
4813C---------
4814!
4815 CALL HM_GET_INTV('no_blocks',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
4816!
4817 DO J=1,NB_ELEMENTS
4818 ! Reading --- ID_ELEM, ... ---
4819 CALL HM_GET_INT_ARRAY_INDEX('quad_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
4820!
4821! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%IQUADM,NUMELQ)
4822! IE = MAP_TABLES%IQUADM(ELT,2)
4823!
4824 IE=UEL2SYS(ID_ELEM,KSYSUSRQ,NUMELQ)
4825!
4826 IF (IE == 0) THEN
4827 ! Shell was not found. Issue a Warning & Skip.
4828 NONEXIST = NONEXIST+1
4829 ELSE
4830 CALL HM_GET_FLOAT_ARRAY_INDEX('value',EPSP,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4831 I=I+1
4832 ID_QUAD_SIGI(I) = ID_ELEM
4833 SIGI(10,I) = EPSP
4834 ENDIF ! IF (IE == 0)
4835 ENDDO ! DO J=1,NB_ELEMENTS
4836C---------
4837 CASE ( 'stress' )
4838C---------
4839
4840 CALL HM_GET_INTV('no_blocks',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
4841!
4842 DO J=1,NB_ELEMENTS
4843 ! Reading --- ID_ELEM, ... ---
4844
4845 CALL HM_GET_INT_ARRAY_INDEX('quad_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
4846!
4847! ELT = SET_USRTOS(ID_ELEM,MAP_TABLES%IQUADM,NUMELQ)
4848! IE = MAP_TABLES%IQUADM(ELT,2)
4849!
4850 IE=UEL2SYS(ID_ELEM,KSYSUSRQ,NUMELQ)
4851!
4852 IF (IE == 0) THEN
4853 ! Shell was not found. Issue a Warning & Skip.
4854 NONEXIST = NONEXIST+1
4855 ELSE
4856 CALL HM_GET_FLOAT_ARRAY_INDEX('sigma_x' ,S(1),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4857 CALL HM_GET_FLOAT_ARRAY_INDEX('sigma_y' ,S(2),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4858 CALL HM_GET_FLOAT_ARRAY_INDEX('sigma_z' ,S(3),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4859 CALL HM_GET_FLOAT_ARRAY_INDEX('sigma_xy',S(4),J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4860!
4861 I=I+1
4862 ID_QUAD_SIGI(I) = ID_ELEM
4863 DO K=1,4
4864 SIGI(K,I) = S(K)
4865 ENDDO
4866 ENDIF ! IF (IE == 0)
4867 ENDDO ! DO J=1,NB_ELEMENTS
4868!
4869 CASE DEFAULT
4870!
4871 END SELECT ! SELECT CASE(KEY)
4872!
4873!
4874 ENDDO ! DO INI=1,NB_INIQUA
4875!
4876 ENDIF ! IF ( NB_INIQUA > 0 )
4877!
4878 NIQUAD = I
4879
4880!-----------------------------------------
4881! --- /INISPHCEL ---
4882!-----------------------------------------
4883 NISPHCEL = 0
4884 I = 0
4885 CALL HM_OPTION_COUNT('/inisphcel', NB_INISPHCEL)
4886!
4887 IF ( NB_INISPHCEL > 0 ) THEN
4888!
4889 ! Start reading /INISPHCEL card
4890 CALL HM_OPTION_START('/inisphcel')
4891!---
4892 IF (KTRIELSPHCEL == 0) THEN
4893 DO IE = 1, NUMSPH
4894 ITRISPH(IE) = KXSP(NISP,IE)
4895 END DO
4896 CALL MY_ORDERS(0,WORK,ITRISPH,INDEXSPH,NUMSPH,1)
4897 DO J = 1, NUMSPH
4898 IE=INDEXSPH(J)
4899 KSYSUSRSPH(J) =KXSP(NISP,IE)
4900 KSYSUSRSPH(NUMSPH+J)=IE
4901 END DO
4902 KTRIELSPHCEL=1
4903 ENDIF
4904!---
4905 DO INI=1,NB_INISPHCEL
4906!
4907 CALL HM_OPTION_READ_KEY(LSUBMODEL,
4908 . UNIT_ID = UID,
4909 . SUBMODEL_INDEX = SUB_INDEX,
4910 . SUBMODEL_ID = SUB_ID,
4911 . KEYWORD2 = KEY,
4912 . KEYWORD3 = KEY2)
4913!
4914 IF (KEY2 /= ' ') GLOB = .TRUE.
4915!
4916 IFLAGUNIT = 0
4917 DO IUNIT=1,UNITAB%NUNITS
4918 IF (UNITAB%UNIT_ID(IUNIT) == UID) THEN
4919 IFLAGUNIT = 1
4920 EXIT
4921 ENDIF
4922 ENDDO
4923!
4924.AND. IF (UID /= 0IFLAGUNIT == 0) THEN
4925 CALL ANCMSG(MSGID=659,ANMODE=ANINFO,MSGTYPE=MSGERROR,
4926 . I2=UID, I1=SUB_ID, C1='inisphcel',
4927 . C2='inisphcel',
4928 . C3=' ')
4929 ENDIF
4930c---------------------------------------
4931 SELECT CASE (KEY(1:LEN_TRIM(KEY)))
4932C---------
4933 CASE ( 'full' )
4934C---------
4935 CALL HM_GET_INTV('no_blocks',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
4936!
4937 DO J=1,NB_ELEMENTS
4938 I=I+1
4939 CALL HM_GET_INT_ARRAY_INDEX('sphcel_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
4940 CALL HM_GET_INT_ARRAY_INDEX('nvarsph',NUVAR,J,IS_AVAILABLE,LSUBMODEL)
4941 CALL HM_GET_FLOAT_ARRAY_INDEX('eint',ENER,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4942 CALL HM_GET_FLOAT_ARRAY_INDEX('rho',RHO,J,IS_AVAILABLE,LSUBMODEL,UNITAB)
4943 CALL HM_GET_FLOAT_ARRAY_INDEX('h',slen,j,is_available,lsubmodel,unitab)
4944 CALL hm_get_float_array_index('Sigma1',s(1),j,is_available,lsubmodel,unitab)
4945 CALL hm_get_float_array_index('Sigma2',s(2),j,is_available,lsubmodel,unitab)
4946 CALL hm_get_float_array_index('Sigma3',s(3),j,is_available,lsubmodel,unitab)
4947 CALL hm_get_float_array_index('Epsp',epsp,j,is_available,lsubmodel,unitab)
4948!
4949 ie=uel2sys(id_elem,ksysusrsph,numsph)
4950!
4951 IF (ie == 0) THEN
4952 ! Sphcel was not found. Issue a Warning & Skip.
4953 nonexist = nonexist+1
4954 ELSE
4955 id_sigsph(i) = id_elem
4956 sigsph(1,i) = s(1)
4957 sigsph(2,i) = s(2)
4958 sigsph(3,i) = s(3)
4959 sigsph(4,i) = zero
4960 sigsph(5,i) = zero
4961 sigsph(6,i) = zero
4962 sigsph(7,i) = zero
4963 sigsph(8,i) = rho
4964 sigsph(9,i) = ener
4965 sigsph(10,i) = epsp
4966 sigsph(11,i) = slen
4967 sigsph(12,i) = nuvar
4968 CALL hm_get_float_array('V' ,tmpval,nuvar,j,is_available,lsubmodel,unitab)
4969 DO k=1,nuvar
4970 sigsph(12+k,i) = tmpval(k)
4971 ENDDO
4972!--------------------
4973 ENDIF ! IF (IE /= 0)
4974 ENDDO ! DO I=1,NB_ELEMENTS
4975C---------
4976 CASE DEFAULT
4977C---------
4978 END SELECT ! SELECT CASE(KEY)
4979!
4980 ENDDO ! DO INI=1,NB_INI
4981!
4982 ENDIF ! IF ( NB_INI > 0 )
4983
4984
4985
4986! message in case some elements was not found in the model
4987 IF (nonexist > 0) THEN
4988 CALL ancmsg(msgid=3045,anmode=aninfo,msgtype=msgwarning,i1=nonexist)
4989 ENDIF ! IF (NONEXIST > 0)
4990C------------------------------------
4991 DEALLOCATE (itris)
4992 DEALLOCATE (indexs)
4993 DEALLOCATE (ksysusrs)
4994 DEALLOCATE (ksysusrtg)
4995 DEALLOCATE (itriq)
4996 DEALLOCATE (indexq)
4997 DEALLOCATE (ksysusrq)
4998 DEALLOCATE (ies2iparg)
4999 IF(ALLOCATED(itrisph)) DEALLOCATE(itrisph)
5000 IF(ALLOCATED(indexsph)) DEALLOCATE(indexsph)
5001 IF(ALLOCATED(ksysusrsph)) DEALLOCATE(ksysusrsph)
5002C------------------------------------
5003 RETURN
5004C
5005 END
5006
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:523
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:251
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
initia
subroutine initia(iparg, elbuf, ms, in, v, x, ixs, ixq, ixc, ixt, ixp, ixr, detonators, geo, pm, rby, npby, lpby, npc, npts, pld, veul, ale_connectivity, skew, fill, ipart, itab, sensors, skvol, ixtg, thk, nloc_dmg, group_param_tab, glob_therm, igrnod, igrsurf, bufsf, vr, bufmat, xlas, las, dtelem, mss, msq, msc, mst, msp, msr, mstg, ptg, inc, nod2eltg, knod2eltg, inp, inr, intg, index, itri, kxx, ixx, xelemwa, iwa, nod2elq, knod2elq, nod2els, knod2els, kxsp, ixsp, nod2sp, ispcond, icode, iskew, iskn, ispsym, xframe, isptag, spbuf, mssx, nsigi, npbyl, lpbyl, rbyl, msnf, mssf, nsigsh, igeo, ipm, nsigs, nsigsph, vns, vnsx, stc, stt, stp, str, sttg, stur, bns, bnsx, volnod, bvolnod, etnod, nshnod, stifint, fxbdep, fxbvit, fxbacc, fxbipm, fxbrpm, fxbelm, fxbsig, fxbmod, ins, ptshel, ptsh3n, ptsol, ptquad, wma, ptsph, fxbnod, mbufel, mdepl, fxani, numel, nsigrs, sh4tree, sh3tree, mcp, temp, imerge2, iadmerge2, slnrbm, nslnrbm, rmstifn, rmstifr, ms_layer, zi_layer, itag, itagel, mcpc, mcptg, xrefc, xreftg, xrefs, mssa, msrt, irbe2, lrbe2, inivol, kvol, nbsubmat, ixs10, ixs16, ixs20, totaddmas, ipmas, stifn, msz2, itagn, sitage, itage, ixr_kj, elbuf_tab, nom_opt, ptr_nopt_rbe2, ptr_nopt_adm, ptr_nopt_fun, sol2sph, irst, sh3trim, xfem_tab, kxig3d, ixig3d, msig3d, knot, nctrlmax, wige, stack, rnoise, drape, sh4ang, sh3ang, geo_stack, igeo_stack, stifintr, strc, strp, strr, strtg, perturb, itagnd, nativ_sms, iloadp, facload, ptspri, nsigbeam, ptbeam, nsigtruss, pttruss, multi_fvm, sigi, sigsh, sigsp, sigsph, sigrs, sigbeam, sigtruss, strsglob, straglob, orthoglob, isigsh, iyldini, ksigsh3, fail_ini, iusolyld, iuser, iddlevel, inimap1d, inimap2d, func2d, fvm_inivel, tagprt_sms, igrbric, igrquad, igrsh4n, igrsh3n, igrpart, totmas, knotlocpc, knotlocel, vnige, bnige, fxbglm, fxbcpm, fxbcps, fxblm, fxbfls, fxbdls, fxb_matrix, fxb_matrix_add, fxb_last_adress, ptr_nopt_fxb, r_skew, knod2el1d, nod2el1d, ebcs_tab, rby_iniaxis, alea, knod2elc, nod2elc, dr, slrbody, drapeg, ipari, intbuf_tab, interfaces, mat_param, npreload_a, preload_a, fail_fractal, fail_brokmann, defaults, ndamp_freq_range, dampr, ibeam_vector, rbeam_vector, ikine)
Definition initia.F:188
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
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:662
hm_option_read_mod
Definition hm_option_read_mod.F:408
mapping_option_mod
Definition dichotomy_mod.F:36
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
stack_mod
Definition stack_mod.F:72
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
nvar
integer function nvar(text)
Definition nvar.F:32
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:889
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804
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:723
subrottens
subroutine subrottens(tens, rtrans, sub_id, lsubmodel)
Definition subrot.F:321