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
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 IF(ie > 0 .AND. 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 IF(ie > 0 .AND. 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 ELSEIF ( .NOT. 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 IF(ie > 0 .AND. 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 IF(ie > 0 .AND. 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 ELSEIF ( .NOT. 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 IF(ie > 0 .AND. 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 IF(ie > 0 .AND. 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 IF(ie > 0 .AND. 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 IF(ie > 0 .AND. 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 IF(ie > 0 .AND. 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 IF(ie > 0 .AND. 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 IF(ie > 0 .AND. 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 IF(ie > 0 .AND. 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 ELSEIF (igtyp == 8 .OR. igtyp == 13 .OR.
1108 . igtyp == 23 .OR. igtyp == 25) THEN
1109C------
1110 nvspri = nvspri + 43
1111C------
1112C user springs
1113 ELSEIF (igtyp == 29 .OR. igtyp == 30 .OR. igtyp == 31 .OR.
1114 . igtyp == 32 .OR. igtyp == 33 .OR. igtyp == 35 .OR.
1115 . igtyp == 36 .OR. igtyp == 44 .OR. igtyp == 45 .OR.
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 ENDIF ! IF (ISIGI==-3.OR.ISIGI==-4.OR.ISIGI==-5)
1200!
1201 RETURN
1202 END
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_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: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
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895
submodel_mod::submodel_data
Definition submodel_mod.F:728
uel2sys
integer function uel2sys(iu, ksysusr, numel)
Definition yctrl.F:407