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
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 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*max(1,npg)*7)
463!! NVSH_STRA = MAX(NVSH_STRA,NIP*MAX(1,NPG)*7)
464 ENDDO ! DO J=1,NB_ELEMENTS
465!
466 ELSEIF ( .NOT. 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 IF(ie > 0 .AND. 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 IF(ie > 0 .AND. 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.AND. IF(IE > 0 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.AND. IF(IE > 0 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.NOT. ELSEIF ( 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 IF(ie > 0 .AND. 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 IF(ie > 0 .AND. 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 IF(ie > 0 .AND. 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 IF(ie > 0 .AND. 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 IF(ie > 0 .AND. 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 IF(ie > 0 .AND. 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 IF(ie > 0 .AND. 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 ENDIF ! IF (ISIGI==-3.OR.ISIGI==-4.OR.ISIGI==-5)
1201!
1202 RETURN
1203 399 CONTINUE
1204 CALL ancmsg(msgid=557,
1205 . msgtype=msgerror,
1206 . anmode=aninfo_blind_1)
1207
1208 RETURN
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_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
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
uel2sys
integer function uel2sys(iu, ksysusr, numel)
Definition yctrl.F:408