OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_yctrl.F File Reference
#include "implicit_f.inc"
#include "scry_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_yctrl (unitab, lsubmodel, igrbric, ixc, ixtg, ptshel, ptsh3n, nusphcel)

Function/Subroutine Documentation

◆ hm_yctrl()

subroutine hm_yctrl ( type (unit_type_), intent(in) unitab,
type(submodel_data), dimension(*) lsubmodel,
type (group_), dimension(ngrbric) igrbric,
integer, dimension(nixc,numelc) ixc,
integer, dimension(nixtg,numeltg) ixtg,
integer, dimension(numelc), intent(inout) ptshel,
integer, dimension(numeltg), intent(inout) ptsh3n,
integer, intent(inout) nusphcel )

Definition at line 40 of file hm_yctrl.F.

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
50 use element_mod , only : nixc,nixtg
51C-----------------------------------------------
52C I m p l i c i t T y p e s
53C-----------------------------------------------
54#include "implicit_f.inc"
55C-----------------------------------------------
56C C o m m o n B l o c k s
57C-----------------------------------------------
58#include "scry_c.inc"
59#include "com01_c.inc"
60#include "com04_c.inc"
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
65 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
66!
67 TYPE(SUBMODEL_DATA) LSUBMODEL(*)
68 INTEGER IXTG(NIXTG,NUMELTG) ,IXC(NIXC,NUMELC)
69 INTEGER, INTENT(INOUT) :: PTSHEL(NUMELC),PTSH3N(NUMELTG)
70 INTEGER, INTENT(INOUT) :: NUSPHCEL
71C-----------------------------------------------
72C L o c a l V a r i a b l e s
73C-----------------------------------------------
74 INTEGER
75 . I,J,NGAUSS,NLAYER ,
76 . NUMS,NIP,NUVAR,JJHBE,J1,NU,IP,N,NPSOLID,
77 . K,IHBE,NPG,ND,NVAR_SHELL,NPT,NE,
78 . NVSHELL0,NUSHELL0,NORTSHEL0,NUSOLID0,NELS,KK,JJ,
79 . ISOLNOD,ISOLID,IFRAM,IORTH,IREP,IGTYP,ISH3N,NDIR,NLAYERS,
80 . UID,SUB_ID,NLAY,NPTR,NPTS,NPTT,IFAIL,IRUPT_TYP,NVAR_RUPT,
81 . ILAY,IMAT,NPT_MAX,NUBEAM0,NVSH_STRA,PROP,NSROT
82 INTEGER IGBR, JGBR, IOK
83 CHARACTER(LEN=NCHARKEY) :: KEY2,KEY3,KEY
84C-----------------------------------------------
85 LOGICAL IS_AVAILABLE,GLOB
86 CHARACTER MESS*40
87 INTEGER ID_ELEM,NB_INIBRI,NB_INISHE,NB_INISH3,NB_ELEMENTS,
88 . NB_INITRUSS,NB_INIBEAM,NB_INISPRI,NB_INIQUA,IE,KTRIELC,
89 . KTRIELTG,NELT,NB_INISPHCEL
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 sorting elements of D00 by ascending id (sorted only once)
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+2*MAX(1,NPG)*7) ! QEPH used 1 and NVSHELL-1 is used
463 ENDDO ! DO J=1,NB_ELEMENTS
464!
465.NOT. ELSEIF ( GLOB ) THEN
466
467 CALL HM_GET_INTV('inishe_stra_f_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
468!
469 DO J=1,NB_ELEMENTS
470 CALL HM_GET_INT_ARRAY_INDEX('npg',NPG,J,IS_AVAILABLE,LSUBMODEL)
471 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
472 IE=UEL2SYS(ID_ELEM,KSYSUSR,NUMELC)
473!
474 IF(IE == 0 ) CYCLE
475 NVAR_SHELL = MAX(NVAR_SHELL, MAX(1,NPG)*8)
476.AND. IF(IE > 0 PTSHEL(IE)== 0 ) THEN
477 NUMSHEL = NUMSHEL + 1
478 PTSHEL(IE) = NUMSHEL
479 ENDIF ! IE > 0
480 ENDDO ! DO J=1,NB_ELEMENTS
481 ENDIF ! IF ( GLOB )
482!-------------------
483 CASE ( 'thick' )
484!-------------------
485 CALL HM_GET_INTV('no_elems',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
486!
487 DO J=1,NB_ELEMENTS
488 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
489 IE=UEL2SYS(ID_ELEM,KSYSUSR,NUMELC)
490 IF(IE == 0 ) CYCLE
491.AND. IF(IE > 0 PTSHEL(IE)== 0 ) THEN
492 NUMSHEL = NUMSHEL + 1
493 PTSHEL(IE) = NUMSHEL
494 ENDIF
495 ENDDO
496!
497!-------------------
498 CASE ( 'epsp' )
499!-------------------
500 CALL HM_GET_INTV('no_blocks',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
501!
502 DO J=1,NB_ELEMENTS
503 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
504 IE=UEL2SYS(ID_ELEM,KSYSUSR,NUMELC)
505 IF(IE == 0 ) CYCLE
506.AND. IF(IE > 0 PTSHEL(IE)== 0 ) THEN
507 NUMSHEL = NUMSHEL + 1
508 PTSHEL(IE) = NUMSHEL
509 ENDIF
510 ENDDO
511!-------------------
512 CASE ( 'ortho' )
513!-------------------
514 CALL HM_GET_INTV('inishe_ortho_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
515!
516 DO J=1,NB_ELEMENTS
517 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
518 IE=UEL2SYS(ID_ELEM,KSYSUSR,NUMELC)
519 IF(IE == 0 ) CYCLE
520.AND. IF(IE > 0 PTSHEL(IE)== 0 ) THEN
521 NUMSHEL = NUMSHEL + 1
522 PTSHEL(IE) = NUMSHEL
523 ENDIF
524 ENDDO
525!
526 DO J=1,NB_ELEMENTS
527 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NIP,J,IS_AVAILABLE,LSUBMODEL)
528 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
529 IE=UEL2SYS(ID_ELEM,KSYSUSR,NUMELC)
530 IF(IE == 0 ) CYCLE
531.AND. IF(IE > 0 PTSHEL(IE)== 0 ) THEN
532 NUMSHEL = NUMSHEL + 1
533 PTSHEL(IE) = NUMSHEL
534 ENDIF
535 IF (NIP==0) THEN
536 NVAR_SHELL = MAX(NVAR_SHELL, 9)
537 ELSE
538 NVAR_SHELL = MAX(NVAR_SHELL, MAX(1,NIP)*24)
539 ENDIF
540 IORTSHEL = 1
541 NORTSHEL = MAX(NORTSHEL, NORTSHEL0 + MAX(1,NIP)*2)
542 NPT = MAX(1,NIP)
543 ENDDO ! DO J=1,NB_ELEMENTS
544!-------------------
545 CASE ( 'orth_loc' )
546!-------------------
547
548 CALL HM_GET_INTV('inishe_orth_loc_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
549 DO J=1,NB_ELEMENTS
550 CALL HM_GET_INT_ARRAY_INDEX('nb_lay',NIP,J,IS_AVAILABLE,LSUBMODEL)
551 CALL HM_GET_INT_ARRAY_INDEX('npg',NPG,J,IS_AVAILABLE,LSUBMODEL)
552 CALL HM_GET_INT_ARRAY_INDEX('ndir',NDIR,J,IS_AVAILABLE,LSUBMODEL)
553 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
554 !
555 IE=UEL2SYS(ID_ELEM,KSYSUSR,NUMELC)
556 IF(IE == 0 ) CYCLE
557.AND. IF(IE > 0 PTSHEL(IE)== 0 ) THEN
558 NUMSHEL = NUMSHEL + 1
559 PTSHEL(IE) = NUMSHEL
560 ENDIF
561 IF (NIP==0) THEN
562 NVAR_SHELL = MAX(NVAR_SHELL, MAX(1,NPG)*9)
563 ELSE
564 NVAR_SHELL = MAX(NVAR_SHELL, MAX(1,NIP)*24)
565 ENDIF
566 IORTSHEL = 2
567 NORTSHEL = MAX(NORTSHEL, NORTSHEL0 + MAX(1,NIP)*2)
568 IF (NDIR == 2) NORTSHEL = MAX(NORTSHEL, NORTSHEL0 + MAX(1,NIP)*4)
569 ENDDO ! DO J=1,NB_ELEMENTS
570!-------------------
571 CASE ( 'scale_yld' )
572!-------------------
573 CALL HM_GET_INTV('inishe_scale_yld_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
574 IUFACYLD = 1
575 DO J=1,NB_ELEMENTS
576 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NIP,J,IS_AVAILABLE,LSUBMODEL)
577 CALL HM_GET_INT_ARRAY_INDEX('npg',NPG,J,IS_AVAILABLE,LSUBMODEL)
578 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
579 !!
580 IE=UEL2SYS(ID_ELEM,KSYSUSR,NUMELC)
581 IF(IE == 0 ) CYCLE
582.AND. IF(IE > 0 PTSHEL(IE)== 0 ) THEN
583 NUMSHEL = NUMSHEL + 1
584 PTSHEL(IE) = NUMSHEL
585 ENDIF
586 IF (NIP==0) THEN
587 NVAR_SHELL = MAX(NVAR_SHELL, MAX(1,NPG)*9)
588 ELSE
589 NVAR_SHELL = MAX(NVAR_SHELL, MAX(1,NIP)*MAX(1,NPG)*6)
590 ENDIF
591 NVSHELL2 = MAX(NVSHELL2,MAX(1,NPG)*MAX(1,NIP))
592 ENDDO ! DO J=1,NB_ELEMENTS
593!-------------------
594 CASE ( 'aux' )
595!-------------------
596 CALL HM_GET_INTV('inishe_aux_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
597 IUSHELL = 1
598 DO J=1,NB_ELEMENTS
599 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NIP,J,IS_AVAILABLE,LSUBMODEL)
600 CALL HM_GET_INT_ARRAY_INDEX('npg',npg,j,is_available,lsubmodel)
601 CALL hm_get_int_array_index('nvars',nuvar,j,is_available,lsubmodel)
602 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
603 !!
604 ie=uel2sys(id_elem,ksysusr,numelc)
605 IF(ie == 0 ) cycle
606 IF(ie > 0 .AND. ptshel(ie)== 0 ) THEN
607 numshel = numshel + 1
608 ptshel(ie) = numshel
609 ENDIF ! IE > 0
610 IF (nip==0) THEN
611 nvar_shell = max(nvar_shell, max(1,npg)*9)
612 ELSE
613 nvar_shell = max(nvar_shell, max(1,nip)*24)
614 ENDIF
615 nushell = max(nushell,nushell0+max(1,npg)*max(1,nip)*nuvar)
616 ENDDO ! DO J=1,NB_ELEMENTS
617!-------------------
618 CASE ( 'FAIL' )
619!-------------------
620 CALL hm_get_intv('inishe_fail_count',nb_elements,is_available,lsubmodel)
621 DO j=1,nb_elements
622 CALL hm_get_int_array_index('Nlay',nlay,j,is_available,lsubmodel)
623 CALL hm_get_int_array_index('npg',npg,j,is_available,lsubmodel)
624 CALL hm_get_int_array_index('nptt',nptt,j,is_available,lsubmodel)
625 CALL hm_get_int_array_index('lay_ID',ilay,j,is_available,lsubmodel)
626 CALL hm_get_int_array_index('Nvar',nvar_rupt,j,is_available,lsubmodel)
627 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
628 !!
629 ie=uel2sys(id_elem,ksysusr,numelc)
630 IF(ie == 0 ) cycle
631 IF(ie > 0 .AND. ptshel(ie)== 0 ) THEN
632 numshel = numshel + 1
633 ptshel(ie) = numshel
634 ENDIF ! IE > 0
635 npg = max(1,npg)
636 nptt = max(1,nptt)
637 nlay = max(1,nlay)
638 npt_max = max(nptt,nlay)
639 nvar_shell = max(nvar_shell, max(1,nlay)*24)
640 nvshell1 = max(nvshell1,npg*npt_max*5*nvar_rupt)
641 ENDDO ! DO J=1,NB_ELEMENTS
642!
643 CASE DEFAULT
644!
645 END SELECT ! SELECT CASE(KEY)
646
647 ENDDO ! DO I=1,NB_INISHE
648 ENDIF ! IF ( NB_INISHE > 0 )
649
650
651C------------------------------------
652C /INISH3 card
653C------------------------------------
654 CALL hm_option_count('/INISH3', nb_inish3)
655 IF ( nb_inish3 > 0 ) THEN
656 !!
657 IF (ktrieltg==0) THEN
658C sorting elements of D00 by ascending id (sorted only once)
659 DO ie = 1, numeltg
660 itri(ie) = ixtg(nixtg,ie)
661 END DO
662 CALL my_orders(0,work,itri,index,numeltg,1)
663 DO j = 1, numeltg
664 ie=index(j)
665 ksysusrtg(j) =ixtg(nixtg,ie)
666 ksysusrtg(numeltg+j)=ie
667 END DO
668 ktrieltg=1
669 END IF
670 ! Start reading /INISH3 card
671 CALL hm_option_start('/INISH3')
672!
673 numsh3n = 0
674 DO i=1,nb_inish3
675!
676 CALL hm_option_read_key(lsubmodel,
677 . keyword2 = key,
678 . keyword3 = key2)
679!
680 IF (key2 /= ' ') glob = .true.
681!
682 SELECT CASE (key(1:len_trim(key)))
683!-------------------
684 CASE ( 'EPSP_F' )
685!-------------------
686 CALL hm_get_intv('inish3_epsp_f_count',nb_elements,is_available,lsubmodel)
687!
688
689 DO j=1,nb_elements
690 ! Reading --- ID_ELEM, NIP, NPG, THK ---
691 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
692 CALL hm_get_int_array_index('npg',npg,j,is_available,lsubmodel)
693 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
694 ie = uel2sys(id_elem,ksysusrtg,numeltg)
695 IF(ie == 0 ) cycle
696 IF(ie > 0 .AND. ptsh3n(ie) == 0) THEN
697 numsh3n = numsh3n + 1
698 ptsh3n(ie) = numsh3n
699 ENDIF
700!
701 IF (nip == 0) THEN
702 nvar_shell = max(nvar_shell, max(1,npg)*9)
703 ELSE
704 nvar_shell = max(nvar_shell, max(1,nip)*max(1,npg)*6)
705 ENDIF
706!
707 ENDDO ! DO J=1,NB_ELEMENTS
708!-------------------
709 CASE ( 'STRS_F' )
710!-------------------
711 IF ( glob ) THEN
712!
713 CALL hm_get_intv('inish3_strs_f_glob_count',nb_elements,is_available,lsubmodel)
714!
715 DO j=1,nb_elements
716 ! Reading --- ID_ELEM, NIP, NPG, THK ---
717 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
718 CALL hm_get_int_array_index('npg',npg,j,is_available,lsubmodel)
719 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
720 ie = uel2sys(id_elem,ksysusrtg,numeltg)
721 IF(ie == 0 ) cycle
722 IF(ie > 0 .AND. ptsh3n(ie) == 0) THEN
723 numsh3n = numsh3n + 1
724 ptsh3n(ie) = numsh3n
725 ENDIF
726!
727 IF (nip == 0) THEN
728 nvar_shell = max(nvar_shell, max(1,npg)*13)
729 ELSE
730 nvar_shell = max(nvar_shell, max(1,nip)*max(1,npg)*8)
731 ENDIF
732!
733 ENDDO ! DO J=1,NB_ELEMENTS
734!
735!! CASE ( 'STRS_F' )
736 ELSEIF ( .NOT. glob ) THEN
737!
738 CALL hm_get_intv('inish3_strs_f_count',nb_elements,is_available,lsubmodel)
739!
740 DO j=1,nb_elements
741 ! Reading CARD_1 --- ID_ELEM, NIP, NPG, THK ---
742 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
743 CALL hm_get_int_array_index('npg',npg,j,is_available,lsubmodel)
744 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
745 ie = uel2sys(id_elem,ksysusrtg,numeltg)
746 IF(ie == 0 ) cycle
747 IF(ie > 0 .AND. ptsh3n(ie) == 0) THEN
748 numsh3n = numsh3n + 1
749 ptsh3n(ie) = numsh3n
750 ENDIF
751!
752 IF (nip == 0) THEN
753 nvar_shell = max(nvar_shell, max(1,npg)*9)
754 ELSE
755 nvar_shell = max(nvar_shell, max(1,nip)*max(1,npg)*6)
756 ENDIF
757!
758 ENDDO ! DO J=1,NB_ELEMENTS
759!
760 ENDIF ! IF ( GLOB )
761!-------------------
762 CASE ( 'STRA_F' )
763!-------------------
764 IF ( glob ) THEN
765 CALL hm_get_intv('inish3_stra_f_glob_count',nb_elements,is_available,lsubmodel)
766!
767 DO j=1,nb_elements
768 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
769 CALL hm_get_int_array_index('npg',npg,j,is_available,lsubmodel)
770 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
771 ie = uel2sys(id_elem,ksysusrtg,numeltg)
772 IF(ie == 0 ) cycle
773 IF(ie > 0 .AND. ptsh3n(ie) == 0) THEN
774 numsh3n = numsh3n + 1
775 ptsh3n(ie) = numsh3n
776 ENDIF
777!
778 IF (nip==0) nip=2
779C---------store only up to 2 pts of NIP eij(6)+T, pointer= INISHVAR1
780 nvsh_stra = max(nvsh_stra,1+2*max(1,npg)*7)
781!! NVSH_STRA = MAX(NVSH_STRA,NIP*MAX(1,NPG)*7)
782 ENDDO ! DO J=1,NB_ELEMENTS
783!
784 ELSEIF ( .NOT. glob ) THEN
785
786 CALL hm_get_intv('inish3_stra_f_count',nb_elements,is_available,lsubmodel)
787!
788 DO j=1,nb_elements
789 CALL hm_get_int_array_index('npg',npg,j,is_available,lsubmodel)
790 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
791 ie = uel2sys(id_elem,ksysusrtg,numeltg)
792 IF(ie == 0 ) cycle
793 IF(ie > 0 .AND. ptsh3n(ie) == 0) THEN
794 numsh3n = numsh3n + 1
795 ptsh3n(ie) = numsh3n
796 ENDIF
797!
798 nvar_shell = max(nvar_shell, max(1,npg)*8)
799 ENDDO ! DO J=1,NB_ELEMENTS
800 ENDIF ! IF ( GLOB )
801!-------------------
802 CASE ( 'THICK' )
803!-------------------
804 CALL hm_get_intv('no_elems',nb_elements,is_available,lsubmodel)
805!
806 DO j=1,nb_elements
807 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
808 ie = uel2sys(id_elem,ksysusrtg,numeltg)
809 IF(ie == 0 ) cycle
810 IF(ie > 0 .AND. ptsh3n(ie) == 0) THEN
811 numsh3n = numsh3n + 1
812 ptsh3n(ie) = numsh3n
813 ENDIF
814 ENDDO ! DO J=1,NB_ELEMENTS
815!-------------------
816 CASE ( 'EPSP' )
817!-------------------
818 CALL hm_get_intv('no_blocks',nb_elements,is_available,lsubmodel)
819!
820 DO j=1,nb_elements
821 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
822 ie = uel2sys(id_elem,ksysusrtg,numeltg)
823 IF(ie == 0 ) cycle
824 IF(ie > 0 .AND. ptsh3n(ie) == 0) THEN
825 numsh3n = numsh3n + 1
826 ptsh3n(ie) = numsh3n
827 ENDIF
828 ENDDO ! DO J=1,NB_ELEMENTS
829!-------------------
830 CASE ( 'ORTHO' )
831!-------------------
832 CALL hm_get_intv('inish3_ortho_count',nb_elements,is_available,lsubmodel)
833!
834 DO j=1,nb_elements
835 CALL hm_get_int_array_index('nb_integr',nip,j,is_available,lsubmodel)
836 CALL hm_get_int_array_index('shell_ID',id_elem,j,is_available,lsubmodel)
837 ie = uel2sys(id_elem,ksysusrtg,numeltg)
838 IF(ie == 0 ) cycle
839 IF(ie > 0 .AND. ptsh3n(ie) == 0) THEN
840 numsh3n = numsh3n + 1
841 ptsh3n(ie) = numsh3n
842 ENDIF
843!
844 IF (nip==0) THEN
845 nvar_shell = max(nvar_shell, 9)
846 ELSE
847 nvar_shell = max(nvar_shell, max(1,nip)*24)
848 ENDIF
849 iortshel = 1
850 nortshel = max(nortshel, nortshel0 + max(1,nip)*2)
851 npt = max(1,nip)
852 ENDDO ! DO J=1,NB_ELEMENTS
853!-------------------
854 CASE ( 'ORTH_LOC' )
855!-------------------
856 CALL hm_get_intv('inish3_orth_loc_count',nb_elements,is_available,lsubmodel)
857!
858!
859 DO j=1,nb_elements
860 CALL hm_get_int_array_index('nb_lay',nip,j,is_available,lsubmodel)
861 CALL hm_get_int_array_index('npg',npg,j,is_available,lsubmodel)
862 CALL hm_get_int_array_index('ndir',NDIR,J,IS_AVAILABLE,LSUBMODEL)
863 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
864 IE = UEL2SYS(ID_ELEM,KSYSUSRTG,NUMELTG)
865 IF(IE == 0 ) CYCLE
866.AND. IF(IE > 0 PTSH3N(IE) == 0) THEN
867 NUMSH3N = NUMSH3N + 1
868 PTSH3N(IE) = NUMSH3N
869 ENDIF
870!
871 IF (NIP==0) THEN
872 NVAR_SHELL = MAX(NVAR_SHELL, MAX(1,NPG)*9)
873 ELSE
874 NVAR_SHELL = MAX(NVAR_SHELL, MAX(1,NIP)*24)
875 ENDIF
876 IORTSHEL = 2
877 NORTSHEL = MAX(NORTSHEL, NORTSHEL0 + MAX(1,NIP)*2)
878 IF (NDIR == 2) NORTSHEL = MAX(NORTSHEL, NORTSHEL0 + MAX(1,NIP)*4)
879 ENDDO ! DO J=1,NB_ELEMENTS
880!-------------------
881 CASE ( 'scale_yld' )
882!-------------------
883 CALL HM_GET_INTV('inish3_scale_yld_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
884 IUFACYLD = 1
885 DO J=1,NB_ELEMENTS
886 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NIP,J,IS_AVAILABLE,LSUBMODEL)
887 CALL HM_GET_INT_ARRAY_INDEX('npg',NPG,J,IS_AVAILABLE,LSUBMODEL)
888 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
889 IE = UEL2SYS(ID_ELEM,KSYSUSRTG,NUMELTG)
890 IF(IE == 0 ) CYCLE
891.AND. IF(IE > 0 PTSH3N(IE) == 0) THEN
892 NUMSH3N = NUMSH3N + 1
893 PTSH3N(IE) = NUMSH3N
894 ENDIF
895!
896 IF (NIP==0) THEN
897 NVAR_SHELL = MAX(NVAR_SHELL, MAX(1,NPG)*9)
898 ELSE
899 NVAR_SHELL = MAX(NVAR_SHELL, MAX(1,NIP)*MAX(1,NPG)*6)
900 ENDIF
901 NVSHELL2 = MAX(NVSHELL2,MAX(1,NPG)*MAX(1,NIP))
902 ENDDO ! DO J=1,NB_ELEMENTS
903!-------------------
904 CASE ( 'aux' )
905!-------------------
906 CALL HM_GET_INTV('inish3_aux_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
907 IUSHELL = 1
908 DO J=1,NB_ELEMENTS
909 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NIP,J,IS_AVAILABLE,LSUBMODEL)
910 CALL HM_GET_INT_ARRAY_INDEX('npg',NPG,J,IS_AVAILABLE,LSUBMODEL)
911 CALL HM_GET_INT_ARRAY_INDEX('nvars',NUVAR,J,IS_AVAILABLE,LSUBMODEL)
912 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
913 IE = UEL2SYS(ID_ELEM,KSYSUSRTG,NUMELTG)
914 IF(IE == 0 ) CYCLE
915.AND. IF(IE > 0 PTSH3N(IE) == 0) THEN
916 NUMSH3N = NUMSH3N + 1
917 PTSH3N(IE) = NUMSH3N
918 ENDIF
919!
920 IF (NIP==0) THEN
921 NVAR_SHELL = MAX(NVAR_SHELL, MAX(1,NPG)*9)
922 ELSE
923 NVAR_SHELL = MAX(NVAR_SHELL, MAX(1,NIP)*24)
924 ENDIF
925 NUSHELL = MAX(NUSHELL,NUSHELL0+MAX(1,NPG)*MAX(1,NIP)*NUVAR)
926 ENDDO ! DO J=1,NB_ELEMENTS
927!-------------------
928 CASE ( 'fail' )
929!-------------------
930 CALL HM_GET_INTV('inish3_fail_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
931 DO J=1,NB_ELEMENTS
932 CALL HM_GET_INT_ARRAY_INDEX('nlay',NLAY,J,IS_AVAILABLE,LSUBMODEL)
933 CALL HM_GET_INT_ARRAY_INDEX('npg',NPG,J,IS_AVAILABLE,LSUBMODEL)
934 CALL HM_GET_INT_ARRAY_INDEX('nptt',NPTT,J,IS_AVAILABLE,LSUBMODEL)
935 CALL HM_GET_INT_ARRAY_INDEX('lay_id',ILAY,J,IS_AVAILABLE,LSUBMODEL)
936 CALL HM_GET_INT_ARRAY_INDEX('nvar',NVAR_RUPT,J,IS_AVAILABLE,LSUBMODEL)
937 CALL HM_GET_INT_ARRAY_INDEX('shell_id',ID_ELEM,J,IS_AVAILABLE,LSUBMODEL)
938 IE = UEL2SYS(ID_ELEM,KSYSUSRTG,NUMELTG)
939 IF(IE == 0 ) CYCLE
940.AND. IF(IE > 0 PTSH3N(IE) == 0) THEN
941 NUMSH3N = NUMSH3N + 1
942 PTSH3N(IE) = NUMSH3N
943 ENDIF
944 NPG = MAX(1,NPG)
945 NPTT = MAX(1,NPTT)
946 NLAY = MAX(1,NLAY)
947 NPT_MAX = MAX(NPTT,NLAY)
948 NVAR_SHELL = MAX(NVAR_SHELL, MAX(1,NLAY)*24)
949 NVSHELL1 = MAX(NVSHELL1,NPG*NPT_MAX*5*NVAR_RUPT)
950 ENDDO ! DO J=1,NB_ELEMENTS
951!
952!
953 CASE DEFAULT
954!
955 END SELECT ! SELECT CASE(KEY)
956
957 ENDDO ! DO I=1,NB_INISH3
958 ENDIF ! IF ( NB_INISH3 > 0 )
959!---
960
961
962 INISHVAR1 = NVAR_SHELL + NVSHELL0 + NPT
963 NVSHELL = INISHVAR1 + NVSH_STRA
964
965
966C------------------------------------
967C /INITRUSS card
968C------------------------------------
969 CALL HM_OPTION_COUNT('/initruss', NB_INITRUSS)
970
971 IF ( NB_INITRUSS > 0 ) THEN
972 ! Start reading /INITRUSS card
973 CALL HM_OPTION_START('/initruss')
974!
975 DO I=1,NB_INITRUSS
976!
977 CALL HM_OPTION_READ_KEY(LSUBMODEL,
978 . KEYWORD2 = KEY)
979!
980 SELECT CASE (KEY(1:LEN_TRIM(KEY)))
981!-------------------
982 CASE ( 'full' )
983!-------------------
984 CALL HM_GET_INTV('no_of_elems',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
985!
986 NUMTRUS = NUMTRUS + NB_ELEMENTS
987!
988 NVTRUSS = NVTRUSS + 6*NB_ELEMENTS
989!
990 CASE DEFAULT
991!
992 END SELECT ! SELECT CASE(KEY)
993
994 ENDDO ! DO I=1,NB_INITRUSS
995 ENDIF ! IF ( NB_INITRUSS > 0 )
996
997
998C------------------------------------
999C /INIBEAM card
1000C------------------------------------
1001 CALL HM_OPTION_COUNT('/inibeam', NB_INIBEAM)
1002!
1003 IF ( NB_INIBEAM > 0 ) THEN
1004 ! Start reading /INIBEAM card
1005 CALL HM_OPTION_START('/inibeam')
1006!
1007 DO I=1,NB_INIBEAM
1008!
1009 CALL HM_OPTION_READ_KEY(LSUBMODEL,
1010 . KEYWORD2 = KEY)
1011
1012!
1013 SELECT CASE (KEY(1:LEN_TRIM(KEY)))
1014!
1015!-------------------
1016 CASE ( 'full' )
1017!-------------------
1018!
1019 CALL HM_GET_INTV('inibeam_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
1020!
1021 NUMBEAM = NUMBEAM + NB_ELEMENTS
1022!
1023 DO J=1,NB_ELEMENTS
1024 ! Reading --- ID_ELEM, Prop ... ---
1025 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NIP,J,IS_AVAILABLE,LSUBMODEL)
1026 CALL HM_GET_INT_ARRAY_INDEX('prop_type',IGTYP,J,IS_AVAILABLE,LSUBMODEL)
1027!
1028 NVBEAM = NVBEAM + 11
1029 IF (IGTYP == 3) THEN
1030 NVBEAM = NVBEAM + 1
1031 ELSEIF (IGTYP == 18) THEN
1032 NVBEAM = NVBEAM + 4*NIP
1033 ENDIF
1034 ENDDO ! DO J=1,NB_ELEMENTS
1035!
1036!-------------------
1037 CASE ( 'aux' )
1038!-------------------
1039!
1040 CALL HM_GET_INTV('inibeam_count',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
1041!
1042 NUMBEAM = NUMBEAM + NB_ELEMENTS
1043!
1044 DO J=1,NB_ELEMENTS
1045 ! Reading --- ID_ELEM, Prop ... ---
1046 CALL HM_GET_INT_ARRAY_INDEX('nb_integr',NIP,J,IS_AVAILABLE,LSUBMODEL)
1047 CALL HM_GET_INT_ARRAY_INDEX('prop_type',IGTYP,J,IS_AVAILABLE,LSUBMODEL)
1048 CALL HM_GET_INT_ARRAY_INDEX('nvars' ,NUVAR,J,IS_AVAILABLE,LSUBMODEL)
1049!
1050 IF (IGTYP == 18) THEN
1051 NUBEAM = MAX(NUBEAM,NUBEAM0 + NIP*NUVAR)
1052 ENDIF
1053 ENDDO ! DO J=1,NB_ELEMENTS
1054!
1055 CASE DEFAULT
1056!
1057 END SELECT ! SELECT CASE(KEY)
1058
1059 ENDDO ! DO I=1,NB_INIBEAM
1060 ENDIF ! IF ( NB_INIBEAM > 0 )
1061
1062
1063
1064C------------------------------------
1065C /INISPRI card
1066C------------------------------------
1067 CALL HM_OPTION_COUNT('/inispri', NB_INISPRI)
1068!
1069 IF ( NB_INISPRI > 0 ) THEN
1070 ! Start reading /INISPRI card
1071 CALL HM_OPTION_START('/inispri')
1072!
1073 DO I=1,NB_INISPRI
1074!
1075 CALL HM_OPTION_READ_KEY(LSUBMODEL,
1076 . KEYWORD2 = KEY)
1077
1078!
1079 SELECT CASE (KEY(1:LEN_TRIM(KEY)))
1080!
1081!-------------------
1082 CASE ( 'full' )
1083!-------------------
1084!
1085 CALL HM_GET_INTV('size_spring',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
1086!
1087 NUMSPRI = NUMSPRI + NB_ELEMENTS
1088!
1089 DO J=1,NB_ELEMENTS
1090 ! Reading --- ID_ELEM, Prop ... ---
1091 CALL HM_GET_INT_ARRAY_INDEX('prop_type',IGTYP,J,IS_AVAILABLE,LSUBMODEL)
1092 CALL HM_GET_INT_ARRAY_INDEX('nvars' ,NUVAR,J,IS_AVAILABLE,LSUBMODEL)
1093!
1094C------
1095 IF (IGTYP == 4) THEN
1096C------
1097 NVSPRI = NVSPRI + 10
1098C------
1099 ELSEIF (IGTYP == 12) THEN
1100C------
1101 NVSPRI = NVSPRI + 11
1102C------
1103 ELSEIF (IGTYP == 26) THEN
1104C------
1105 NVSPRI = NVSPRI + 9
1106C------
1107.OR..OR. ELSEIF (IGTYP == 8 IGTYP == 13
1108.OR. . IGTYP == 23 IGTYP == 25) THEN
1109C------
1110 NVSPRI = NVSPRI + 43
1111C------
1112C user springs
1113.OR..OR..OR. ELSEIF (IGTYP == 29 IGTYP == 30 IGTYP == 31
1114.OR..OR..OR. . IGTYP == 32 IGTYP == 33 IGTYP == 35
1115.OR..OR..OR. . IGTYP == 36 IGTYP == 44 IGTYP == 45
1116 . IGTYP == 46) THEN
1117C------
1118 NVSPRI = NVSPRI + 16 + NUVAR
1119C------
1120 ENDIF ! IF (IGTYP == 4)
1121!
1122 ENDDO ! DO J=1,NB_ELEMENTS
1123!
1124 CASE DEFAULT
1125!
1126 END SELECT ! SELECT CASE(KEY)
1127
1128 ENDDO ! DO I=1,NB_INIBEAM
1129 ENDIF ! IF ( NB_INIBEAM > 0 )
1130
1131
1132
1133C------------------------------------
1134C /INIQUA card
1135C------------------------------------
1136 CALL HM_OPTION_COUNT('/iniqua', NB_INIQUA)
1137!
1138 IF ( NB_INIQUA > 0 ) THEN
1139 ! Start reading /INIQUA card
1140 CALL HM_OPTION_START('/iniqua')
1141!
1142 DO I=1,NB_INIQUA
1143!
1144 CALL HM_OPTION_READ_KEY(LSUBMODEL,
1145 . KEYWORD2 = KEY)
1146!
1147 CALL HM_GET_INTV('no_blocks',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
1148!
1149
1150 NUMQUAD = NUMQUAD + NB_ELEMENTS
1151!
1152 ENDDO ! DO I=1,NB_INIQUA
1153!
1154 ENDIF ! IF ( NB_INIQUA > 0 )
1155
1156
1157
1158C------------------------------------
1159C /INISPHCEL card
1160C------------------------------------
1161 CALL HM_OPTION_COUNT('/inisphcel', NB_INISPHCEL)
1162!
1163 IF ( NB_INISPHCEL > 0 ) THEN
1164 ! Start reading /INISPHCEL card
1165 CALL HM_OPTION_START('/inisphcel')
1166!
1167 DO I=1,NB_INISPHCEL
1168!
1169 CALL HM_OPTION_READ_KEY(LSUBMODEL,
1170 . KEYWORD2 = KEY)
1171!
1172 CALL HM_GET_INTV('no_blocks',NB_ELEMENTS,IS_AVAILABLE,LSUBMODEL)
1173
1174 NUMSPHY = NUMSPHY + NB_ELEMENTS
1175
1176 SELECT CASE (KEY(1:LEN_TRIM(KEY)))
1177
1178!-------------------
1179 CASE ( 'full' )
1180!-------------------
1181!!
1182 DO J=1,NB_ELEMENTS
1183 ! Reading --- ID_ELEM, Prop ... ---
1184 CALL HM_GET_INT_ARRAY_INDEX('nvarsph' ,NUVAR,J,IS_AVAILABLE,LSUBMODEL)
1185!
1186 NUSPHCEL = MAX(NUSPHCEL,NUVAR)
1187 ENDDO ! DO J=1,NB_ELEMENTS
1188!
1189 CASE DEFAULT
1190!
1191 END SELECT ! SELECT CASE(KEY)
1192!
1193 ENDDO ! DO I=1,NB_INISPHCEL
1194!
1195 ENDIF ! IF ( NB_INISPHCEL > 0 )
1196
1197
1198!---
1199.OR..OR. ENDIF ! IF (ISIGI==-3ISIGI==-4ISIGI==-5)
1200!
1201 RETURN
hm_get_int_array_index
subroutine hm_get_int_array_index(name, ival, index, is_available, lsubmodel)
Definition hm_get_int_array_index.F:164
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
hm_option_count
subroutine hm_option_count(entity_type, hm_option_number)
Definition hm_option_count.F:105
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:253
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:414
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:668
hm_option_read_mod
Definition hm_option_read_mod.F:412
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1005
submodel_mod
Definition submodel_mod.F:717
unitab_mod
Definition unitab_mod.F:517
nvar
integer function nvar(text)
Definition nvar.F:32
uel2sys
integer function uel2sys(iu, ksysusr, numel)
Definition yctrl.F:407