OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_yctrl.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_yctrl ../starter/source/elements/initia/hm_yctrl.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| hm_get_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
30!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
31!|| hm_option_count ../starter/source/devtools/hm_reader/hm_option_count.F
32!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
33!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
34!|| uel2sys ../starter/source/initial_conditions/inista/yctrl.F
35!||--- uses -----------------------------------------------------
36!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
37!|| message_mod ../starter/share/message_module/message_mod.F
38!|| submodel_mod ../starter/share/modules1/submodel_mod.F
39!||====================================================================
40 SUBROUTINE hm_yctrl(UNITAB,LSUBMODEL,IGRBRIC,IXC, IXTG,PTSHEL,PTSH3N,NUSPHCEL)
41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE groupdef_mod
45 USE unitab_mod
46 USE message_mod
47 USE submodel_mod
48 USE hm_option_read_mod
49 USE names_and_titles_mod , ONLY : ncharkey
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "scry_c.inc"
58#include "com01_c.inc"
59#include "com04_c.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
64 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
65!
66 TYPE(submodel_data) LSUBMODEL(*)
67 INTEGER IXTG(NIXTG,NUMELTG) ,IXC(NIXC,NUMELC)
68 INTEGER, INTENT(INOUT) :: PTSHEL(NUMELC),PTSH3N(NUMELTG)
69 INTEGER, INTENT(INOUT) :: NUSPHCEL
70C-----------------------------------------------
71C L o c a l V a r i a b l e s
72C-----------------------------------------------
73 INTEGER
74 . I,J,NGAUSS,NLAYER ,
75 . NUMS,NIP,NUVAR,JJHBE,J1,NU,IP,N,NPSOLID,
76 . K,IHBE,NPG,ND,NVAR_SHELL,NPT,NE,
77 . NVSHELL0,NUSHELL0,NORTSHEL0,NUSOLID0,NELS,KK,JJ,
78 . ISOLNOD,ISOLID,IFRAM,IORTH,IREP,IGTYP,ISH3N,NDIR,NLAYERS,
79 . UID,SUB_ID,NLAY,NPTR,NPTS,NPTT,IFAIL,IRUPT_TYP,NVAR_RUPT,
80 . ILAY,IMAT,NPT_MAX,NUBEAM0,NVSH_STRA,PROP,NSROT
81 INTEGER IGBR, JGBR, IOK
82 CHARACTER(LEN=NCHARKEY) :: KEY2,KEY3,KEY
83C-----------------------------------------------
84 LOGICAL IS_AVAILABLE,GLOB
85 CHARACTER MESS*40
86 INTEGER ID_ELEM,NB_INIBRI,NB_INISHE,NB_INISH3,NB_ELEMENTS,
87 . NB_INITRUSS,NB_INIBEAM,NB_INISPRI,NB_INIQUA,IE,KTRIELC,
88 . KTRIELTG,NELT,NB_INISPHCEL
89 my_real thk
90 INTEGER, DIMENSION(:), ALLOCATABLE :: KSYSUSRTG ,KSYSUSR,WORK,ITRI,
91 . INDEX
92C-----------------------------------------------
93 EXTERNAL uel2sys
94 INTEGER UEL2SYS
95C=======================================================================
96! NFILSOL=0
97! NUMSOL =0
98! NUMQUAD=0
99! NUMSHEL=0
100! NUMTRUS=0
101! NUMBEAM=0
102! NUMSPRI=0
103! NUMSH3N=0
104 nvshell0 = 33
105 nushell0 = 4
106 nortshel0 = 5
107 nvar_shell = 0
108 nubeam0 = 4
109! NUBEAM = 0
110! NVBEAM = 0
111! NVTRUSS = 0
112!! NVSPRI = 0
113 nvsh_stra =0
114!
115! IUFACYLD = 0
116! IUSHELL = 0
117! NUSHELL = 0
118! NVSHELL1 = 0
119! NVSHELL2 = 0
120!cc NGAUSS = 0
121!cc NLAYER = 0
122!cc NVSHELL = 0
123! IUSOLID = 0
124! NUSOLID = 0
125! NVSOLID1 = 0
126! NVSOLID2 = 0
127! NVSOLID3 = 0
128! NVSOLID4 = 0
129! NVSOLID5 = 0
130!cc NPSOLID = 0
131!cc NVSOLID = 0
132 ALLOCATE (ksysusr(2*numelc))
133 ALLOCATE (ksysusrtg(2*numeltg))
134 ALLOCATE (work(70000))
135 nelt = max(numelc, numeltg)
136 ALLOCATE(itri(nelt),index(2*nelt))
137 ktrielc = 0
138 ktrieltg = 0
139 ksysusr = 0
140 ksysusrtg = 0
141 work = 0
142 itri = 0
143 index= 0
144!-----------------------------------------
145
146C-----------------------------------------
147C CONTRAINTES INITIALES FICHIER D00
148C-----------------------------------------
149 is_available = .false.
150 glob = .false.
151!
152 IF (isigi==-3.OR.isigi==-4.OR.isigi==-5) THEN
153
154
155C------------------------------------
156C /INIBRI card
157C------------------------------------
158 CALL hm_option_count('/INIBRI', nb_inibri)
159 IF ( nb_inibri > 0 ) THEN
160 ! Start reading /INIBRI card
161 CALL hm_option_start('/INIBRI')
162!
163 DO i=1,nb_inibri
164!
165 CALL hm_option_read_key(lsubmodel,
166 . keyword2 = key)
167!
168 SELECT CASE (key(1:len_trim(key)))
169!-------------------
170 CASE ( 'FILL' )
171!-------------------
172 CALL hm_get_intv('inibri_fill_count',nb_elements,is_available,lsubmodel)
173 numsol = numsol + nb_elements
174 nfilsol = 1
175!-------------------
176 CASE ( 'EPSP' )
177!-------------------
178 CALL hm_get_intv('inibri_epsp_count',nb_elements,is_available,lsubmodel)
179 numsol = numsol + nb_elements
180!-------------------
181 CASE ( 'ENER' )
182!-------------------
183 CALL hm_get_intv('inibri_ener_count',nb_elements,is_available,lsubmodel)
184 numsol = numsol + nb_elements
185!-------------------
186 CASE ( 'DENS' )
187!-------------------
188 CALL hm_get_intv('inibri_dens_count',nb_elements,is_available,lsubmodel)
189 numsol = numsol + nb_elements
190!-------------------
191 CASE ( 'STRESS' )
192!-------------------
193 CALL hm_get_intv('inibri_stress_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
194 NUMSOL = NUMSOL + NB_ELEMENTS
195!-------------------
196 CASE ( 'aux' )
197!-------------------
198 CALL HM_GET_INTV('inibri_aux_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
199 NUMSOL = NUMSOL + NB_ELEMENTS
200!
201 DO J=1,NB_ELEMENTS
202 CALL HM_GET_INT_ARRAY_INDEX('brick_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
203 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NPT,J,IS_AVAILABLE,LSUBMODEL)
204 CALL HM_GET_INT_ARRAY_INDEX('isolnod',ISOLNOD,J,IS_AVAILABLE,LSUBMODEL)
205 CALL HM_GET_INT_ARRAY_INDEX('isolid',JJHBE,J,IS_AVAILABLE,LSUBMODEL)
206 CALL HM_GET_INT_ARRAY_INDEX('nvars',NUVAR,J,IS_AVAILABLE,LSUBMODEL)
207!
208 IUSOLID = 1
209 NUSOLID = MAX(NUSOLID,NPT*NUVAR)
210 ENDDO ! DO J=1,NB_ELEMENTS
211!-------------------
212 CASE ( 'strs_f' )
213!-------------------
214 CALL HM_GET_INTV('inibri_strs_f_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
215!
216 DO J=1,NB_ELEMENTS
217 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NPT,J,IS_AVAILABLE,LSUBMODEL)
218!
219 NUMSOL = NUMSOL + 1
220 NVSOLID1 = MAX (NVSOLID1,NPT*9 + 4)
221 ENDDO ! DO J=1,NB_ELEMENTS
222!-------------------
223 CASE ( 'strs_fglo' )
224!-------------------
225 CALL HM_GET_INTV('inibri_strs_fglo_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
226!
227 DO J=1,NB_ELEMENTS
228 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NPT,J,IS_AVAILABLE,LSUBMODEL)
229 CALL HM_GET_INT_ARRAY_INDEX('grbric_id',IGBR,J,IS_AVAILABLE,LSUBMODEL)
230!
231 IF (IGBR > 0) THEN
232 IOK = 0
233 JGBR = 0
234 DO K=1,NGRBRIC
235 IF (IGBR == IGRBRIC(K)%ID) THEN
236 JGBR = K
237 IOK = 1
238 EXIT
239 ENDIF
240 ENDDO
241 IF (IOK == 0) THEN
242 CALL ANCMSG(MSGID=1611,MSGTYPE=MSGERROR,ANMODE=ANINFO,C1='strs_fglo',I1=IGBR)
243 ENDIF
244 NUMSOL = NUMSOL + IGRBRIC(JGBR)%NENTITY
245 ELSE
246 NUMSOL = NUMSOL + 1
247 ENDIF
248 NVSOLID1 = MAX (NVSOLID1,NPT*9 + 4)
249 ENDDO ! DO J=1,NB_ELEMENTS
250!-------------------
251 CASE ( 'stra_f' )
252!-------------------
253 CALL HM_GET_INTV('inibri_stra_f_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
254!
255 NUMSOL = NUMSOL + NB_ELEMENTS
256 DO J=1,NB_ELEMENTS
257 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NPT,J,IS_AVAILABLE,LSUBMODEL)
258 NVSOLID2 = MAX(NVSOLID2, MAX(1,NPT)*6)
259 ENDDO ! DO J=1,NB_ELEMENTS
260!-------------------
261 CASE ( 'stra_fglo' )
262!-------------------
263 CALL HM_GET_INTV('inibri_stra_fglo_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
264!
265 NUMSOL = NUMSOL + NB_ELEMENTS
266 DO J=1,NB_ELEMENTS
267 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NPT,J,IS_AVAILABLE,LSUBMODEL)
268 NVSOLID2 = MAX(NVSOLID2, MAX(1,NPT)*6)
269 ENDDO ! DO J=1,NB_ELEMENTS
270!-------------------
271 CASE ( 'fail' )
272!-------------------
273 CALL HM_GET_INTV('inibri_fail_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
274!
275 NUMSOL = NUMSOL + NB_ELEMENTS
276 DO J=1,NB_ELEMENTS
277 CALL HM_GET_INT_ARRAY_INDEX('nlay',NLAY,J,IS_AVAILABLE,LSUBMODEL)
278 CALL HM_GET_INT_ARRAY_INDEX('nptr',NPTR,J,IS_AVAILABLE,LSUBMODEL)
279 CALL HM_GET_INT_ARRAY_INDEX('npts',NPTS,J,IS_AVAILABLE,LSUBMODEL)
280 CALL HM_GET_INT_ARRAY_INDEX('nptt',NPTT,J,IS_AVAILABLE,LSUBMODEL)
281 CALL HM_GET_INT_ARRAY_INDEX('nvar',NVAR_RUPT,J,IS_AVAILABLE,LSUBMODEL)
282 NVSOLID4 = MAX(NVSOLID4,NPTR*NPTS*NPTT*NLAY*5*NVAR_RUPT)
283 ENDDO ! DO J=1,NB_ELEMENTS
284!-------------------
285 CASE ( 'scale_yld' )
286!-------------------
287 CALL HM_GET_INTV('inibri_scale_yld_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
288!
289 IUFACYLD = 1
290 NUMSOL = NUMSOL + NB_ELEMENTS
291!
292 DO J=1,NB_ELEMENTS
293 CALL HM_GET_INT_ARRAY_INDEX('nptr',NPTR,J,IS_AVAILABLE,LSUBMODEL)
294 CALL HM_GET_INT_ARRAY_INDEX('npts',NPTS,J,IS_AVAILABLE,LSUBMODEL)
295 CALL HM_GET_INT_ARRAY_INDEX('nptt',NPTT,J,IS_AVAILABLE,LSUBMODEL)
296 CALL HM_GET_INT_ARRAY_INDEX('nlay',NLAY,J,IS_AVAILABLE,LSUBMODEL)
297 NVSOLID5 = MAX(NVSOLID5,NPTR*NPTS*NPTT*NLAY + 7)
298 ENDDO ! DO J=1,NB_ELEMENTS
299!-------------------
300 CASE ( 'ortho' )
301!-------------------
302 CALL HM_GET_INTV('inibri_ortho_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
303!
304 NUMSOL = NUMSOL + NB_ELEMENTS
305 DO J=1,NB_ELEMENTS
306 CALL HM_GET_INT_ARRAY_INDEX('nb_layer',NLAYERS,J,IS_AVAILABLE,LSUBMODEL)
307 NVSOLID3 = MAX(NVSOLID3,NLAYERS * 6)
308 ENDDO ! DO J=1,NB_ELEMENTS
309!-------------------
310 CASE ( 'eref' )
311!-------------------
312 CALL HM_GET_INTV('inibri_eref_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
313!
314 NUMSOL = NUMSOL + NB_ELEMENTS
315 DO J=1,NB_ELEMENTS
316 CALL HM_GET_INT_ARRAY_INDEX('isolnod',ISOLNOD,J,IS_AVAILABLE,LSUBMODEL)
317 CALL HM_GET_INT_ARRAY_INDEX('nsrot',NSROT,J,IS_AVAILABLE,LSUBMODEL)
318C------ use NVSOLID5 temporarily, read directly after new reader or add NVSOLID6
319 NVSOLID6 = MAX(NVSOLID6, (ISOLNOD+NSROT)*3)
320 ENDDO ! DO J=1,NB_ELEMENTS
321!
322 CASE DEFAULT
323!
324 END SELECT ! SELECT CASE(KEY)
325!
326 ENDDO ! DO I=1,NB_INIBRI
327 ENDIF ! IF ( NB_INIBRI > 0 )
328
329C------------------------------------
330C /INISHE card
331C------------------------------------
332
333 NPT = 0
334!
335 CALL HM_OPTION_COUNT('/inishe', NB_INISHE)
336 IF ( NB_INISHE > 0 ) THEN
337
338 IF (KTRIELC == 0) THEN
339C tri des elts du D00 par ID croissant (on ne trie qu'une fois)
340 DO IE = 1, NUMELC
341 ITRI(IE) = IXC(NIXC,IE)
342 END DO
343 CALL MY_ORDERS(0,WORK,ITRI,INDEX,NUMELC,1)
344 DO J = 1, NUMELC
345 IE=INDEX(J)
346 KSYSUSR(J) =IXC(NIXC,IE)
347 KSYSUSR(NUMELC+J)=IE
348 END DO
349 KTRIELC=1
350 ENDIF
351!!
352 ! Start reading /INISHE card
353 CALL HM_OPTION_START('/inishe')
354!
355 NUMSHEL = 0
356 DO I=1,NB_INISHE
357!
358 CALL HM_OPTION_READ_KEY(LSUBMODEL,
359 . KEYWORD2 = KEY,
360 . KEYWORD3 = KEY2)
361!
362 IF (KEY2 /= ' ') GLOB = .TRUE.
363!
364 SELECT CASE (KEY(1:LEN_TRIM(KEY)))
365
366!-------------------
367 CASE ( 'epsp_f' )
368!-------------------
369 CALL HM_GET_INTV('inishe_epsp_f_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
370!
371 DO J=1,NB_ELEMENTS
372 ! Reading --- ID_ELEM, NIP, NPG, THK ---
373 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NIP,J,IS_AVAILABLE,LSUBMODEL)
374 CALL HM_GET_INT_ARRAY_INDEX('npg',NPG,J,IS_AVAILABLE,LSUBMODEL)
375 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
376!
377 IE=UEL2SYS(ID_ELEM,KSYSUSR,NUMELC)
378 IF(IE == 0 ) CYCLE
379.AND. IF(IE > 0 PTSHEL(IE)== 0 ) THEN
380 NUMSHEL = NUMSHEL + 1
381 PTSHEL(IE) = NUMSHEL
382 ENDIF
383 IF (NIP == 0) THEN
384 NVAR_SHELL = MAX(NVAR_SHELL, MAX(1,NPG)*9)
385 ELSE
386 NVAR_SHELL = MAX(NVAR_SHELL, MAX(1,NIP)*MAX(1,NPG)*6)
387 ENDIF
388!
389 ENDDO ! DO J=1,NB_ELEMENTS
390!-------------------
391 CASE ( 'strs_f' )
392!-------------------
393 IF ( GLOB ) THEN
394 CALL HM_GET_INTV('inishe_strs_f_glob_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
395
396!
397 DO J=1,NB_ELEMENTS
398 ! Reading --- ID_ELEM, NIP, NPG, THK ---
399 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
400 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NIP,J,IS_AVAILABLE,LSUBMODEL)
401 CALL HM_GET_INT_ARRAY_INDEX('npg',NPG,J,IS_AVAILABLE,LSUBMODEL)
402 !
403 IE=UEL2SYS(ID_ELEM,KSYSUSR,NUMELC)
404 IF(IE == 0 ) CYCLE
405.AND. IF(IE > 0 PTSHEL(IE)== 0 ) THEN
406 NUMSHEL = NUMSHEL + 1
407 PTSHEL(IE) = NUMSHEL
408 ENDIF
409 IF (NIP == 0) THEN
410 NVAR_SHELL = MAX(NVAR_SHELL, MAX(1,NPG)*13)
411 ELSE
412 NVAR_SHELL = MAX(NVAR_SHELL, MAX(1,NIP)*MAX(1,NPG)*8)
413 ENDIF
414!
415 ENDDO ! DO J=1,NB_ELEMENTS
416!
417.NOT. ELSEIF ( GLOB ) THEN
418!
419 CALL HM_GET_INTV('inishe_strs_f_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
420!
421 DO J=1,NB_ELEMENTS
422 ! Reading CARD_1 --- ID_ELEM, NIP, NPG, THK ---
423 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NIP,J,IS_AVAILABLE,LSUBMODEL)
424 CALL HM_GET_INT_ARRAY_INDEX('npg',NPG,J,IS_AVAILABLE,LSUBMODEL)
425 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
426 IE=UEL2SYS(ID_ELEM,KSYSUSR,NUMELC)
427!
428
429 IF(IE == 0 ) CYCLE
430.AND. IF(IE > 0 PTSHEL(IE)== 0 ) THEN
431 NUMSHEL = NUMSHEL + 1
432 PTSHEL(IE) = NUMSHEL
433 ENDIF
434 IF (NIP == 0) THEN
435 NVAR_SHELL = MAX(NVAR_SHELL, MAX(1,NPG)*9)
436 ELSE
437 NVAR_SHELL = MAX(NVAR_SHELL, MAX(1,NIP)*MAX(1,NPG)*6)
438 ENDIF
439!
440 ENDDO ! DO J=1,NB_ELEMENTS
441!
442 ENDIF ! IF ( GLOB )
443!-------------------
444 CASE ( 'stra_f' )
445!-------------------
446 IF ( GLOB ) THEN
447 CALL HM_GET_INTV('inishe_stra_f_glob_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
448!
449 DO J=1,NB_ELEMENTS
450 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NIP,J,IS_AVAILABLE,LSUBMODEL)
451 CALL HM_GET_INT_ARRAY_INDEX('npg',NPG,J,IS_AVAILABLE,LSUBMODEL)
452 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
453 IE=UEL2SYS(ID_ELEM,KSYSUSR,NUMELC)
454!
455 IF (NIP==0) NIP=2
456 IF(IE == 0 ) CYCLE
457.AND. IF(IE > 0 PTSHEL(IE)== 0 ) THEN
458 NUMSHEL = NUMSHEL + 1
459 PTSHEL(IE) = NUMSHEL
460 ENDIF ! IE > 0
461C---------store only up to 2 pts of NIP eij(6)+T, pointer= INISHVAR1
462 NVSH_STRA = MAX(NVSH_STRA,2*MAX(1,NPG)*7)
463!! NVSH_STRA = MAX(NVSH_STRA,NIP*MAX(1,NPG)*7)
464 ENDDO ! DO J=1,NB_ELEMENTS
465!
466.NOT. ELSEIF ( GLOB ) THEN
467
468 CALL HM_GET_INTV('inishe_stra_f_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
469!
470 DO J=1,NB_ELEMENTS
471 CALL HM_GET_INT_ARRAY_INDEX('npg',NPG,J,IS_AVAILABLE,LSUBMODEL)
472 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
473 IE=UEL2SYS(ID_ELEM,KSYSUSR,NUMELC)
474!
475 IF(IE == 0 ) CYCLE
476 NVAR_SHELL = MAX(NVAR_SHELL, MAX(1,NPG)*8)
477.AND. IF(IE > 0 PTSHEL(IE)== 0 ) THEN
478 NUMSHEL = NUMSHEL + 1
479 PTSHEL(IE) = NUMSHEL
480 ENDIF ! IE > 0
481 ENDDO ! DO J=1,NB_ELEMENTS
482 ENDIF ! IF ( GLOB )
483!-------------------
484 CASE ( 'thick' )
485!-------------------
486 CALL HM_GET_INTV('no_elems',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
487!
488 DO J=1,NB_ELEMENTS
489 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
490 IE=UEL2SYS(ID_ELEM,KSYSUSR,NUMELC)
491 IF(IE == 0 ) CYCLE
492.AND. IF(IE > 0 PTSHEL(IE)== 0 ) THEN
493 NUMSHEL = NUMSHEL + 1
494 PTSHEL(IE) = NUMSHEL
495 ENDIF
496 ENDDO
497!
498!-------------------
499 CASE ( 'epsp' )
500!-------------------
501 CALL HM_GET_INTV('no_blocks',nb_elements,is_available,lsubmodel)
502!
503 DO j=1,nb_elements
504 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
505 ie=uel2sys(id_elem,ksysusr,numelc)
506 IF(ie == 0 ) cycle
507 IF(ie > 0 .AND. ptshel(ie)== 0 ) THEN
508 numshel = numshel + 1
509 ptshel(ie) = numshel
510 ENDIF
511 ENDDO
512!-------------------
513 CASE ( 'ORTHO' )
514!-------------------
515 CALL hm_get_intv('inishe_ortho_count',nb_elements,is_available,lsubmodel)
516!
517 DO j=1,nb_elements
518 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
519 ie=uel2sys(id_elem,ksysusr,numelc)
520 IF(ie == 0 ) cycle
521 IF(ie > 0 .AND. ptshel(ie)== 0 ) THEN
522 numshel = numshel + 1
523 ptshel(ie) = numshel
524 ENDIF
525 ENDDO
526!
527 DO j=1,nb_elements
528 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
529 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
530 ie=uel2sys(id_elem,ksysusr,numelc)
531 IF(ie == 0 ) cycle
532 IF(ie > 0 .AND. ptshel(ie)== 0 ) THEN
533 numshel = numshel + 1
534 ptshel(ie) = numshel
535 ENDIF
536 IF (nip==0) THEN
537 nvar_shell = max(nvar_shell, 9)
538 ELSE
539 nvar_shell = max(nvar_shell, max(1,nip)*24)
540 ENDIF
541 iortshel = 1
542 nortshel = max(nortshel, nortshel0 + max(1,nip)*2)
543 npt = max(1,nip)
544 ENDDO ! DO J=1,NB_ELEMENTS
545!-------------------
546 CASE ( 'ORTH_LOC' )
547!-------------------
548
549 CALL hm_get_intv('inishe_orth_loc_count',nb_elements,is_available,lsubmodel)
550 DO j=1,nb_elements
551 CALL hm_get_int_array_index('nb_lay',nip,j,is_available,lsubmodel)
552 CALL hm_get_int_array_index('npg',npg,j,is_available,lsubmodel)
553 CALL hm_get_int_array_index('ndir',ndir,j,is_available,lsubmodel)
554 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
555 !
556 ie=uel2sys(id_elem,ksysusr,numelc)
557 IF(ie == 0 ) cycle
558 IF(ie > 0 .AND. ptshel(ie)== 0 ) THEN
559 numshel = numshel + 1
560 ptshel(ie) = numshel
561 ENDIF
562 IF (nip==0) THEN
563 nvar_shell = max(nvar_shell, max(1,npg)*9)
564 ELSE
565 nvar_shell = max(nvar_shell, max(1,nip)*24)
566 ENDIF
567 iortshel = 2
568 nortshel = max(nortshel, nortshel0 + max(1,nip)*2)
569 IF (ndir == 2) nortshel = max(nortshel, nortshel0 + max(1,nip)*4)
570 ENDDO ! DO J=1,NB_ELEMENTS
571!-------------------
572 CASE ( 'SCALE_YLD' )
573!-------------------
574 CALL hm_get_intv('inishe_scale_yld_count',nb_elements,is_available,lsubmodel)
575 iufacyld = 1
576 DO j=1,nb_elements
577 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
578 CALL hm_get_int_array_index('npg',npg,j,is_available,lsubmodel)
579 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
580 !!
581 ie=uel2sys(id_elem,ksysusr,numelc)
582 IF(ie == 0 ) cycle
583 IF(ie > 0 .AND. ptshel(ie)== 0 ) THEN
584 numshel = numshel + 1
585 ptshel(ie) = numshel
586 ENDIF
587 IF (nip==0) THEN
588 nvar_shell = max(nvar_shell, max(1,npg)*9)
589 ELSE
590 nvar_shell = max(nvar_shell, max(1,nip)*max(1,npg)*6)
591 ENDIF
592 nvshell2 = max(nvshell2,max(1,npg)*max(1,nip))
593 ENDDO ! DO J=1,NB_ELEMENTS
594!-------------------
595 CASE ( 'AUX' )
596!-------------------
597 CALL hm_get_intv('inishe_aux_count',nb_elements,is_available,lsubmodel)
598 iushell = 1
599 DO j=1,nb_elements
600 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
601 CALL hm_get_int_array_index('npg',npg,j,is_available,lsubmodel)
602 CALL hm_get_int_array_index('nvars',nuvar,j,is_available,lsubmodel)
603 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
604 !!
605 ie=uel2sys(id_elem,ksysusr,numelc)
606 IF(ie == 0 ) cycle
607 IF(ie > 0 .AND. ptshel(ie)== 0 ) THEN
608 numshel = numshel + 1
609 ptshel(ie) = numshel
610 ENDIF ! IE > 0
611 IF (nip==0) THEN
612 nvar_shell = max(nvar_shell, max(1,npg)*9)
613 ELSE
614 nvar_shell = max(nvar_shell, max(1,nip)*24)
615 ENDIF
616 nushell = max(nushell,nushell0+max(1,npg)*max(1,nip)*nuvar)
617 ENDDO ! DO J=1,NB_ELEMENTS
618!-------------------
619 CASE ( 'FAIL' )
620!-------------------
621 CALL hm_get_intv('inishe_fail_count',nb_elements,is_available,lsubmodel)
622 DO j=1,nb_elements
623 CALL hm_get_int_array_index('Nlay',nlay,j,is_available,lsubmodel)
624 CALL hm_get_int_array_index('npg',npg,j,is_available,lsubmodel)
625 CALL hm_get_int_array_index('nptt',nptt,j,is_available,lsubmodel)
626 CALL hm_get_int_array_index('lay_ID',ilay,j,is_available,lsubmodel)
627 CALL hm_get_int_array_index('Nvar',nvar_rupt,j,is_available,lsubmodel)
628 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
629 !!
630 ie=uel2sys(id_elem,ksysusr,numelc)
631 IF(ie == 0 ) cycle
632 IF(ie > 0 .AND. ptshel(ie)== 0 ) THEN
633 numshel = numshel + 1
634 ptshel(ie) = numshel
635 ENDIF ! ie > 0
636 npg = max(1,npg)
637 nptt = max(1,nptt)
638 nlay = max(1,nlay)
639 npt_max = max(nptt,nlay)
640 nvar_shell = max(nvar_shell, max(1,nlay)*24)
641 nvshell1 = max(nvshell1,npg*npt_max*5*nvar_rupt)
642 ENDDO ! DO J=1,NB_ELEMENTS
643!
644 CASE DEFAULT
645!
646 END SELECT ! SELECT CASE(KEY)
647
648 ENDDO ! DO I=1,NB_INISHE
649 ENDIF ! IF ( NB_INISHE > 0 )
650
651
652C------------------------------------
653C /INISH3 card
654C------------------------------------
655 CALL hm_option_count('/INISH3', nb_inish3)
656 IF ( nb_inish3 > 0 ) THEN
657 !!
658 IF (ktrieltg==0) THEN
659C tri des elts du D00 par ID croissant (on ne trie qu'une fois)
660 DO ie = 1, numeltg
661 itri(ie) = ixtg(nixtg,ie)
662 END DO
663 CALL my_orders(0,work,itri,index,numeltg,1)
664 DO j = 1, numeltg
665 ie=index(j)
666 ksysusrtg(j) =ixtg(nixtg,ie)
667 ksysusrtg(numeltg+j)=ie
668 END DO
669 ktrieltg=1
670 END IF
671 ! Start reading /INISH3 card
672 CALL hm_option_start('/INISH3')
673!
674 numsh3n = 0
675 DO i=1,nb_inish3
676!
677 CALL hm_option_read_key(lsubmodel,
678 . keyword2 = key,
679 . keyword3 = key2)
680!
681 IF (key2 /= ' ') glob = .true.
682!
683 SELECT CASE (key(1:len_trim(key)))
684!-------------------
685 CASE ( 'EPSP_F' )
686!-------------------
687 CALL hm_get_intv('inish3_epsp_f_count',nb_elements,is_available,lsubmodel)
688!
689
690 DO j=1,nb_elements
691 ! Reading --- ID_ELEM, NIP, NPG, THK ---
692 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
693 CALL hm_get_int_array_index('npg',npg,j,is_available,lsubmodel)
694 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
695 ie = uel2sys(id_elem,ksysusrtg,numeltg)
696 IF(ie == 0 ) cycle
697 IF(ie > 0 .AND. ptsh3n(ie) == 0) THEN
698 numsh3n = numsh3n + 1
699 ptsh3n(ie) = numsh3n
700 ENDIF
701!
702 IF (nip == 0) THEN
703 nvar_shell = max(nvar_shell, max(1,npg)*9)
704 ELSE
705 nvar_shell = max(nvar_shell, max(1,nip)*max(1,npg)*6)
706 ENDIF
707!
708 ENDDO ! DO J=1,NB_ELEMENTS
709!-------------------
710 CASE ( 'STRS_F' )
711!-------------------
712 IF ( glob ) THEN
713!
714 CALL hm_get_intv('inish3_strs_f_glob_count',nb_elements,is_available,lsubmodel)
715!
716 DO j=1,nb_elements
717 ! Reading --- ID_ELEM, NIP, NPG, THK ---
718 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
719 CALL hm_get_int_array_index('npg',npg,j,is_available,lsubmodel)
720 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
721 ie = uel2sys(id_elem,ksysusrtg,numeltg)
722 IF(ie == 0 ) cycle
723 IF(ie > 0 .AND. ptsh3n(ie) == 0) THEN
724 numsh3n = numsh3n + 1
725 ptsh3n(ie) = numsh3n
726 ENDIF
727!
728 IF (nip == 0) THEN
729 nvar_shell = max(nvar_shell, max(1,npg)*13)
730 ELSE
731 nvar_shell = max(nvar_shell, max(1,nip)*max(1,npg)*8)
732 ENDIF
733!
734 ENDDO ! DO J=1,NB_ELEMENTS
735!
736!! CASE ( 'STRS_F' )
737 ELSEIF ( .NOT. glob ) THEN
738!
739 CALL hm_get_intv('inish3_strs_f_count',nb_elements,is_available,lsubmodel)
740!
741 DO j=1,nb_elements
742 ! Reading CARD_1 --- ID_ELEM, NIP, NPG, THK ---
743 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
744 CALL hm_get_int_array_index('npg',npg,j,is_available,lsubmodel)
745 CALL hm_get_int_array_index('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
746 IE = UEL2SYS(ID_ELEM,KSYSUSRTG,NUMELTG)
747 IF(IE == 0 ) CYCLE
748.AND. IF(IE > 0 PTSH3N(IE) == 0) THEN
749 NUMSH3N = NUMSH3N + 1
750 PTSH3N(IE) = NUMSH3N
751 ENDIF
752!
753 IF (NIP == 0) THEN
754 NVAR_SHELL = MAX(NVAR_SHELL, MAX(1,NPG)*9)
755 ELSE
756 NVAR_SHELL = MAX(NVAR_SHELL, MAX(1,NIP)*MAX(1,NPG)*6)
757 ENDIF
758!
759 ENDDO ! DO J=1,NB_ELEMENTS
760!
761 ENDIF ! IF ( GLOB )
762!-------------------
763 CASE ( 'stra_f' )
764!-------------------
765 IF ( GLOB ) THEN
766 CALL HM_GET_INTV('inish3_stra_f_glob_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
767!
768 DO J=1,NB_ELEMENTS
769 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NIP,J,IS_AVAILABLE,LSUBMODEL)
770 CALL HM_GET_INT_ARRAY_INDEX('npg',NPG,J,IS_AVAILABLE,LSUBMODEL)
771 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
772 IE = UEL2SYS(ID_ELEM,KSYSUSRTG,NUMELTG)
773 IF(IE == 0 ) CYCLE
774.AND. IF(IE > 0 PTSH3N(IE) == 0) THEN
775 NUMSH3N = NUMSH3N + 1
776 PTSH3N(IE) = NUMSH3N
777 ENDIF
778!
779 IF (NIP==0) NIP=2
780C---------store only up to 2 pts of NIP eij(6)+T, pointer= INISHVAR1
781 NVSH_STRA = MAX(NVSH_STRA,2*MAX(1,NPG)*7)
782!! NVSH_STRA = MAX(NVSH_STRA,NIP*MAX(1,NPG)*7)
783 ENDDO ! DO J=1,NB_ELEMENTS
784!
785.NOT. ELSEIF ( GLOB ) THEN
786
787 CALL HM_GET_INTV('inish3_stra_f_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
788!
789 DO J=1,NB_ELEMENTS
790 CALL HM_GET_INT_ARRAY_INDEX('npg',NPG,J,IS_AVAILABLE,LSUBMODEL)
791 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
792 IE = UEL2SYS(ID_ELEM,KSYSUSRTG,NUMELTG)
793 IF(IE == 0 ) CYCLE
794.AND. IF(IE > 0 PTSH3N(IE) == 0) THEN
795 NUMSH3N = NUMSH3N + 1
796 PTSH3N(IE) = NUMSH3N
797 ENDIF
798!
799 NVAR_SHELL = MAX(NVAR_SHELL, MAX(1,NPG)*8)
800 ENDDO ! DO J=1,NB_ELEMENTS
801 ENDIF ! IF ( GLOB )
802!-------------------
803 CASE ( 'thick' )
804!-------------------
805 CALL HM_GET_INTV('no_elems',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
806!
807 DO J=1,NB_ELEMENTS
808 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
809 IE = UEL2SYS(ID_ELEM,KSYSUSRTG,NUMELTG)
810 IF(IE == 0 ) CYCLE
811.AND. IF(IE > 0 PTSH3N(IE) == 0) THEN
812 NUMSH3N = NUMSH3N + 1
813 PTSH3N(IE) = NUMSH3N
814 ENDIF
815 ENDDO ! DO J=1,NB_ELEMENTS
816!-------------------
817 CASE ( 'epsp' )
818!-------------------
819 CALL HM_GET_INTV('no_blocks',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
820!
821 DO J=1,NB_ELEMENTS
822 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
823 IE = UEL2SYS(ID_ELEM,KSYSUSRTG,NUMELTG)
824 IF(IE == 0 ) CYCLE
825.AND. IF(IE > 0 PTSH3N(IE) == 0) THEN
826 NUMSH3N = NUMSH3N + 1
827 PTSH3N(IE) = NUMSH3N
828 ENDIF
829 ENDDO ! DO J=1,NB_ELEMENTS
830!-------------------
831 CASE ( 'ortho' )
832!-------------------
833 CALL HM_GET_INTV('inish3_ortho_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
834!
835 DO J=1,NB_ELEMENTS
836 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NIP,J,IS_AVAILABLE,LSUBMODEL)
837 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
838 IE = UEL2SYS(ID_ELEM,KSYSUSRTG,NUMELTG)
839 IF(IE == 0 ) CYCLE
840.AND. IF(IE > 0 PTSH3N(IE) == 0) THEN
841 NUMSH3N = NUMSH3N + 1
842 PTSH3N(IE) = NUMSH3N
843 ENDIF
844!
845 IF (NIP==0) THEN
846 NVAR_SHELL = MAX(NVAR_SHELL, 9)
847 ELSE
848 NVAR_SHELL = MAX(NVAR_SHELL, MAX(1,NIP)*24)
849 ENDIF
850 IORTSHEL = 1
851 NORTSHEL = MAX(NORTSHEL, NORTSHEL0 + MAX(1,NIP)*2)
852 NPT = MAX(1,NIP)
853 ENDDO ! DO J=1,NB_ELEMENTS
854!-------------------
855 CASE ( 'orth_loc' )
856!-------------------
857 CALL HM_GET_INTV('inish3_orth_loc_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
858!
859!
860 DO J=1,NB_ELEMENTS
861 CALL HM_GET_INT_ARRAY_INDEX('nb_lay',NIP,J,IS_AVAILABLE,LSUBMODEL)
862 CALL HM_GET_INT_ARRAY_INDEX('npg',NPG,J,IS_AVAILABLE,LSUBMODEL)
863 CALL HM_GET_INT_ARRAY_INDEX('ndir',NDIR,J,IS_AVAILABLE,LSUBMODEL)
864 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
865 IE = UEL2SYS(ID_ELEM,KSYSUSRTG,NUMELTG)
866 IF(IE == 0 ) CYCLE
867.AND. IF(IE > 0 PTSH3N(IE) == 0) THEN
868 NUMSH3N = NUMSH3N + 1
869 PTSH3N(IE) = NUMSH3N
870 ENDIF
871!
872 IF (NIP==0) THEN
873 NVAR_SHELL = MAX(NVAR_SHELL, MAX(1,NPG)*9)
874 ELSE
875 NVAR_SHELL = MAX(NVAR_SHELL, MAX(1,NIP)*24)
876 ENDIF
877 IORTSHEL = 2
878 NORTSHEL = MAX(NORTSHEL, NORTSHEL0 + MAX(1,NIP)*2)
879 IF (NDIR == 2) NORTSHEL = MAX(NORTSHEL, NORTSHEL0 + MAX(1,NIP)*4)
880 ENDDO ! DO J=1,NB_ELEMENTS
881!-------------------
882 CASE ( 'scale_yld' )
883!-------------------
884 CALL HM_GET_INTV('inish3_scale_yld_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
885 IUFACYLD = 1
886 DO J=1,NB_ELEMENTS
887 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NIP,J,IS_AVAILABLE,LSUBMODEL)
888 CALL HM_GET_INT_ARRAY_INDEX('npg',NPG,J,IS_AVAILABLE,LSUBMODEL)
889 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
890 IE = UEL2SYS(ID_ELEM,KSYSUSRTG,NUMELTG)
891 IF(IE == 0 ) CYCLE
892.AND. IF(IE > 0 PTSH3N(IE) == 0) THEN
893 NUMSH3N = NUMSH3N + 1
894 PTSH3N(IE) = NUMSH3N
895 ENDIF
896!
897 IF (NIP==0) THEN
898 NVAR_SHELL = MAX(NVAR_SHELL, MAX(1,NPG)*9)
899 ELSE
900 NVAR_SHELL = MAX(NVAR_SHELL, MAX(1,NIP)*MAX(1,NPG)*6)
901 ENDIF
902 NVSHELL2 = MAX(NVSHELL2,MAX(1,NPG)*MAX(1,NIP))
903 ENDDO ! DO J=1,NB_ELEMENTS
904!-------------------
905 CASE ( 'aux' )
906!-------------------
907 CALL HM_GET_INTV('inish3_aux_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
908 IUSHELL = 1
909 DO J=1,NB_ELEMENTS
910 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NIP,J,IS_AVAILABLE,LSUBMODEL)
911 CALL HM_GET_INT_ARRAY_INDEX('npg',NPG,J,IS_AVAILABLE,LSUBMODEL)
912 CALL HM_GET_INT_ARRAY_INDEX('nvars',NUVAR,J,IS_AVAILABLE,LSUBMODEL)
913 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
914 IE = UEL2SYS(ID_ELEM,KSYSUSRTG,NUMELTG)
915 IF(IE == 0 ) CYCLE
916.AND. IF(IE > 0 PTSH3N(IE) == 0) THEN
917 NUMSH3N = NUMSH3N + 1
918 PTSH3N(IE) = NUMSH3N
919 ENDIF
920!
921 IF (NIP==0) THEN
922 NVAR_SHELL = MAX(NVAR_SHELL, MAX(1,NPG)*9)
923 ELSE
924 NVAR_SHELL = MAX(NVAR_SHELL, MAX(1,NIP)*24)
925 ENDIF
926 NUSHELL = MAX(NUSHELL,NUSHELL0+MAX(1,NPG)*MAX(1,NIP)*NUVAR)
927 ENDDO ! DO J=1,NB_ELEMENTS
928!-------------------
929 CASE ( 'fail' )
930!-------------------
931 CALL HM_GET_INTV('inish3_fail_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
932 DO J=1,NB_ELEMENTS
933 CALL HM_GET_INT_ARRAY_INDEX('nlay',NLAY,J,IS_AVAILABLE,LSUBMODEL)
934 CALL HM_GET_INT_ARRAY_INDEX('npg',NPG,J,IS_AVAILABLE,LSUBMODEL)
935 CALL HM_GET_INT_ARRAY_INDEX('nptt',NPTT,J,IS_AVAILABLE,LSUBMODEL)
936 CALL HM_GET_INT_ARRAY_INDEX('lay_id',ILAY,J,IS_AVAILABLE,LSUBMODEL)
937 CALL HM_GET_INT_ARRAY_INDEX('nvar',NVAR_RUPT,J,IS_AVAILABLE,LSUBMODEL)
938 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
939 IE = UEL2SYS(ID_ELEM,KSYSUSRTG,NUMELTG)
940 IF(IE == 0 ) CYCLE
941.AND. IF(IE > 0 PTSH3N(IE) == 0) THEN
942 NUMSH3N = NUMSH3N + 1
943 PTSH3N(IE) = NUMSH3N
944 ENDIF
945 NPG = MAX(1,NPG)
946 NPTT = MAX(1,NPTT)
947 NLAY = MAX(1,NLAY)
948 NPT_MAX = MAX(NPTT,NLAY)
949 NVAR_SHELL = MAX(NVAR_SHELL, MAX(1,NLAY)*24)
950 NVSHELL1 = MAX(NVSHELL1,NPG*NPT_MAX*5*NVAR_RUPT)
951 ENDDO ! DO J=1,NB_ELEMENTS
952!
953!
954 CASE DEFAULT
955!
956 END SELECT ! SELECT CASE(KEY)
957
958 ENDDO ! DO I=1,NB_INISH3
959 ENDIF ! IF ( NB_INISH3 > 0 )
960!---
961
962
963 INISHVAR1 = NVAR_SHELL + NVSHELL0 + NPT
964 NVSHELL = INISHVAR1 + NVSH_STRA
965
966
967C------------------------------------
968C /INITRUSS card
969C------------------------------------
970 CALL HM_OPTION_COUNT('/initruss', NB_INITRUSS)
971
972 IF ( NB_INITRUSS > 0 ) THEN
973 ! Start reading /INITRUSS card
974 CALL HM_OPTION_START('/initruss')
975!
976 DO I=1,NB_INITRUSS
977!
978 CALL HM_OPTION_READ_KEY(LSUBMODEL,
979 . KEYWORD2 = KEY)
980!
981 SELECT CASE (KEY(1:LEN_TRIM(KEY)))
982!-------------------
983 CASE ( 'full' )
984!-------------------
985 CALL HM_GET_INTV('no_of_elems',nb_elements,is_available,lsubmodel)
986!
987 numtrus = numtrus + nb_elements
988!
989 nvtruss = nvtruss + 6*nb_elements
990!
991 CASE DEFAULT
992!
993 END SELECT ! SELECT CASE(KEY)
994
995 ENDDO ! DO I=1,NB_INITRUSS
996 ENDIF ! IF ( NB_INITRUSS > 0 )
997
998
999C------------------------------------
1000C /INIBEAM card
1001C------------------------------------
1002 CALL hm_option_count('/INIBEAM', nb_inibeam)
1003!
1004 IF ( nb_inibeam > 0 ) THEN
1005 ! Start reading /INIBEAM card
1006 CALL hm_option_start('/INIBEAM')
1007!
1008 DO i=1,nb_inibeam
1009!
1010 CALL hm_option_read_key(lsubmodel,
1011 . keyword2 = key)
1012
1013!
1014 SELECT CASE (key(1:len_trim(key)))
1015!
1016!-------------------
1017 CASE ( 'FULL' )
1018!-------------------
1019!
1020 CALL hm_get_intv('inibeam_count',nb_elements,is_available,lsubmodel)
1021!
1022 numbeam = numbeam + nb_elements
1023!
1024 DO j=1,nb_elements
1025 ! Reading --- ID_ELEM, Prop ... ---
1026 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
1027 CALL hm_get_int_array_index('prop_type',igtyp,j,is_available,lsubmodel)
1028!
1029 nvbeam = nvbeam + 11
1030 IF (igtyp == 3) THEN
1031 nvbeam = nvbeam + 1
1032 ELSEIF (igtyp == 18) THEN
1033 nvbeam = nvbeam + 4*nip
1034 ENDIF
1035 ENDDO ! DO J=1,NB_ELEMENTS
1036!
1037!-------------------
1038 CASE ( 'AUX' )
1039!-------------------
1040!
1041 CALL hm_get_intv('inibeam_count',nb_elements,is_available,lsubmodel)
1042!
1043 numbeam = numbeam + nb_elements
1044!
1045 DO j=1,nb_elements
1046 ! Reading --- ID_ELEM, Prop ... ---
1047 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
1048 CALL hm_get_int_array_index('prop_type',igtyp,j,is_available,lsubmodel)
1049 CALL hm_get_int_array_index('nvars' ,nuvar,j,is_available,lsubmodel)
1050!
1051 IF (igtyp == 18) THEN
1052 nubeam = max(nubeam,nubeam0 + nip*nuvar)
1053 ENDIF
1054 ENDDO ! DO J=1,NB_ELEMENTS
1055!
1056 CASE DEFAULT
1057!
1058 END SELECT ! SELECT CASE(KEY)
1059
1060 ENDDO ! DO I=1,NB_INIBEAM
1061 ENDIF ! IF ( NB_INIBEAM > 0 )
1062
1063
1064
1065C------------------------------------
1066C /INISPRI card
1067C------------------------------------
1068 CALL hm_option_count('/INISPRI', nb_inispri)
1069!
1070 IF ( nb_inispri > 0 ) THEN
1071 ! Start reading /INISPRI card
1072 CALL hm_option_start('/INISPRI')
1073!
1074 DO i=1,nb_inispri
1075!
1076 CALL hm_option_read_key(lsubmodel,
1077 . keyword2 = key)
1078
1079!
1080 SELECT CASE (key(1:len_trim(key)))
1081!
1082!-------------------
1083 CASE ( 'FULL' )
1084!-------------------
1085!
1086 CALL hm_get_intv('size_spring',nb_elements,is_available,lsubmodel)
1087!
1088 numspri = numspri + nb_elements
1089!
1090 DO j=1,nb_elements
1091 ! Reading --- ID_ELEM, Prop ... ---
1092 CALL hm_get_int_array_index('prop_type',igtyp,j,is_available,lsubmodel)
1093 CALL hm_get_int_array_index('nvars' ,nuvar,j,is_available,lsubmodel)
1094!
1095C------
1096 IF (igtyp == 4) THEN
1097C------
1098 nvspri = nvspri + 10
1099C------
1100 ELSEIF (igtyp == 12) THEN
1101C------
1102 nvspri = nvspri + 11
1103C------
1104 ELSEIF (igtyp == 26) THEN
1105C------
1106 nvspri = nvspri + 9
1107C------
1108 ELSEIF (igtyp == 8 .OR. igtyp == 13 .OR.
1109 . igtyp == 23 .OR. igtyp == 25) THEN
1110C------
1111 nvspri = nvspri + 43
1112C------
1113C user springs
1114 ELSEIF (igtyp == 29 .OR. igtyp == 30 .OR. igtyp == 31 .OR.
1115 . igtyp == 32 .OR. igtyp == 33 .OR. igtyp == 35 .OR.
1116 . igtyp == 36 .OR. igtyp == 44 .OR. igtyp == 45 .OR.
1117 . igtyp == 46) THEN
1118C------
1119 nvspri = nvspri + 16 + nuvar
1120C------
1121 ENDIF ! IF (IGTYP == 4)
1122!
1123 ENDDO ! DO J=1,NB_ELEMENTS
1124!
1125 CASE DEFAULT
1126!
1127 END SELECT ! SELECT CASE(KEY)
1128
1129 ENDDO ! DO I=1,NB_INIBEAM
1130 ENDIF ! IF ( NB_INIBEAM > 0 )
1131
1132
1133
1134C------------------------------------
1135C /INIQUA card
1136C------------------------------------
1137 CALL hm_option_count('/INIQUA', nb_iniqua)
1138!
1139 IF ( nb_iniqua > 0 ) THEN
1140 ! Start reading /INIQUA card
1141 CALL hm_option_start('/INIQUA')
1142!
1143 DO i=1,nb_iniqua
1144!
1145 CALL hm_option_read_key(lsubmodel,
1146 . keyword2 = key)
1147!
1148 CALL hm_get_intv('no_blocks',nb_elements,is_available,lsubmodel)
1149!
1150
1151 numquad = numquad + nb_elements
1152!
1153 ENDDO ! DO I=1,NB_INIQUA
1154!
1155 ENDIF ! IF ( NB_INIQUA > 0 )
1156
1157
1158
1159C------------------------------------
1160C /INISPHCEL card
1161C------------------------------------
1162 CALL hm_option_count('/INISPHCEL', nb_inisphcel)
1163!
1164 IF ( nb_inisphcel > 0 ) THEN
1165 ! Start reading /INISPHCEL card
1166 CALL hm_option_start('/INISPHCEL')
1167!
1168 DO i=1,nb_inisphcel
1169!
1170 CALL hm_option_read_key(lsubmodel,
1171 . keyword2 = key)
1172!
1173 CALL hm_get_intv('no_blocks',nb_elements,is_available,lsubmodel)
1174
1175 numsphy = numsphy + nb_elements
1176
1177 SELECT CASE (key(1:len_trim(key)))
1178
1179!-------------------
1180 CASE ( 'full' )
1181!-------------------
1182!!
1183 DO J=1,NB_ELEMENTS
1184 ! Reading --- ID_ELEM, Prop ... ---
1185 CALL HM_GET_INT_ARRAY_INDEX('nvarsph' ,NUVAR,J,IS_AVAILABLE,LSUBMODEL)
1186!
1187 NUSPHCEL = MAX(NUSPHCEL,NUVAR)
1188 ENDDO ! DO J=1,NB_ELEMENTS
1189!
1190 CASE DEFAULT
1191!
1192 END SELECT ! SELECT CASE(KEY)
1193!
1194 ENDDO ! DO I=1,NB_INISPHCEL
1195!
1196 ENDIF ! IF ( NB_INISPHCEL > 0 )
1197
1198
1199!---
1200.OR..OR. ENDIF ! IF (ISIGI==-3ISIGI==-4ISIGI==-5)
1201!
1202 RETURN
1203 399 CONTINUE
1204 CALL ANCMSG(MSGID=557,
1205 . MSGTYPE=MSGERROR,
1206 . ANMODE=ANINFO_BLIND_1)
1207
1208 RETURN
1209 END
my_real
#define my_real
Definition cppsort.cpp:32
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_yctrl
subroutine hm_yctrl(unitab, lsubmodel, igrbric, ixc, ixtg, ptshel, ptsh3n, nusphcel)
Definition hm_yctrl.F:41
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
max
#define max(a, b)
Definition macros.h:21
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
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
nvar
integer function nvar(text)
Definition nvar.F:32
submodel_mod::submodel_data
Definition submodel_mod.F:723
uel2sys
integer function uel2sys(iu, ksysusr, numel)
Definition yctrl.F:408