OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
contrl.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "units_c.inc"
#include "warn_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com06_c.inc"
#include "com08_c.inc"
#include "com09_c.inc"
#include "com10_c.inc"
#include "com_xfem1.inc"
#include "intstamp_c.inc"
#include "random_c.inc"
#include "scr03_c.inc"
#include "scr05_c.inc"
#include "scr06_c.inc"
#include "scr10_c.inc"
#include "scr12_c.inc"
#include "scr15_c.inc"
#include "scr16_c.inc"
#include "scr22_c.inc"
#include "scr23_c.inc"
#include "titr_c.inc"
#include "param_c.inc"
#include "sphcom.inc"
#include "lagmult.inc"
#include "fxbcom.inc"
#include "scr14_c.inc"
#include "remesh_c.inc"
#include "sysunit.inc"
#include "commandline.inc"
#include "r2r_c.inc"
#include "userlib.inc"
#include "spmd_c.inc"
#include "drape_c.inc"
#include "inter22.inc"
#include "boltpr_c.inc"
#include "ige3d_c.inc"
#include "com_engcards_c.inc"
#include "sms_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine contrl (multi_fvm, lsubmodel, is_dyna, detonators, user_windows, mat_elem, names_and_titles, lipart1, defaults, glob_therm, pblast, output)
subroutine find_dt1brick_engine ()
subroutine ini_h3dtmax_engine (iparg, ipart, iparts, ipartc, ipartg, iddlevel)
subroutine read_h3dtmax_key (key_tm, key_len, ifund, ntm_part, ipart)

Function/Subroutine Documentation

◆ contrl()

subroutine contrl ( type(multi_fvm_struct), intent(in) multi_fvm,
type(submodel_data), dimension(nsubmod) lsubmodel,
integer, intent(in) is_dyna,
type(detonators_struct_) detonators,
type(user_windows_), intent(inout) user_windows,
type(mat_elem_), intent(inout) mat_elem,
type(names_and_titles_), intent(inout) names_and_titles,
integer, intent(in) lipart1,
type(defaults_), intent(inout) defaults,
type (glob_therm_), intent(inout) glob_therm,
type(pblast_), intent(inout) pblast,
type(output_), intent(inout) output )
Parameters
[in,out]names_and_titlesNAMES_AND_TITLES host the input deck names and titles for outputs
[in]lipart1Number of variables of IPART
[in,out]defaultsDefaults mod
[in,out]pblastPBLAST load type

Definition at line 81 of file contrl.F.

83C----------------------------------------------------------
84C M o d u l e s
85C-----------------------------------------------
86 USE message_mod
87 USE multi_fvm_mod
88 USE submodel_mod
91 USE check_mod
93 USE setdef_mod
95 USE inivol_def_mod , ONLY : num_inivol
96 USE refsta_mod
97 USE ale_ebcs_mod
98 USE restmod
99 USE grp_size_mod
100 USE anim_mod
102 USE alefvm_mod , only:alefvm_param
104 USE ale_mod
105 USE mat_elem_mod
107 USE bcs_mod , only : bcs
108 USE defaults_mod
109 USE format_mod
110 use glob_therm_mod
111 USE pblast_mod
112 USE output_mod , ONLY : output_
113C-----------------------------------------------
114C I m p l i c i t T y p e s
115C-----------------------------------------------
116#include "implicit_f.inc"
117C-----------------------------------------------
118C G l o b a l P a r a m e t e r s
119C-----------------------------------------------
120#include "mvsiz_p.inc"
121C-----------------------------------------------
122C C o m m o n B l o c k s
123C-----------------------------------------------
124#include "units_c.inc"
125#include "warn_c.inc"
126#include "com01_c.inc"
127#include "com04_c.inc"
128#include "com06_c.inc"
129#include "com08_c.inc"
130#include "com09_c.inc"
131#include "com10_c.inc"
132#include "com_xfem1.inc"
133#include "intstamp_c.inc"
134#include "random_c.inc"
135#include "scr03_c.inc"
136#include "scr05_c.inc"
137#include "scr06_c.inc"
138#include "scr10_c.inc"
139#include "scr12_c.inc"
140#include "scr15_c.inc"
141#include "scr16_c.inc"
142#include "scr22_c.inc"
143#include "scr23_c.inc"
144#include "titr_c.inc"
145#include "param_c.inc"
146#include "sphcom.inc"
147#include "lagmult.inc"
148#include "fxbcom.inc"
149#include "scr14_c.inc"
150#include "remesh_c.inc"
151#include "sysunit.inc"
152#include "commandline.inc"
153#include "r2r_c.inc"
154#include "userlib.inc"
155#include "spmd_c.inc"
156#include "drape_c.inc"
157#include "inter22.inc"
158#include "boltpr_c.inc"
159#include "ige3d_c.inc"
160#include "com_engcards_c.inc"
161#include "sms_c.inc"
162C-----------------------------------------------
163C D u m m y A r g u m e n t s
164C-----------------------------------------------
165 TYPE(MULTI_FVM_STRUCT), INTENT(IN) :: MULTI_FVM
166 TYPE(SUBMODEL_DATA) LSUBMODEL(NSUBMOD)
167 INTEGER,INTENT(IN)::IS_DYNA
168 TYPE(DETONATORS_STRUCT_) :: DETONATORS
169 TYPE(USER_WINDOWS_), INTENT(INOUT) :: USER_WINDOWS
170 TYPE(MAT_ELEM_), INTENT(INOUT) :: MAT_ELEM
171 TYPE(NAMES_AND_TITLES_),INTENT(INOUT) :: NAMES_AND_TITLES !< NAMES_AND_TITLES host the input deck names and titles for outputs
172 INTEGER,INTENT(IN) :: LIPART1 !< Number of variables of IPART
173 TYPE(DEFAULTS_), INTENT(INOUT) :: DEFAULTS !< Defaults mod
174 type (glob_therm_) ,intent(inout) :: glob_therm
175 TYPE(PBLAST_), INTENT(INOUT) :: PBLAST !< PBLAST load type
176 TYPE(OUTPUT_),INTENT(INOUT) :: OUTPUT
177C-----------------------------------------------
178C L o c a l V a r i a b l e s
179C-----------------------------------------------
180 INTEGER I, J, N, ISFIL, IPCT, IBID,INSH,
181 . IHBE_DD,IPARITH,JALE,JEUL,
182 . IUN,NSHFRAM,JUPW,IMAT,IG,ISH3N_DD,IFRAME_DDS,
183 . IPLA_DDS,NPTS_DD,UID,IHBE,ISMSTR,IPLAS,ICPRE,ICSTR,NPT,
184 . ISROT,L1,NPTS, NIMPDISP,NIMPVEL,NIMPACC,ICR,
185 . STAT,IERROR,ID,IDX,IDY,IDZ,NCTRL,BID,NSH3NFRAM,NS17_OLD,
186 . IGNORE_SPMD,IGNORE_THREADS,GOT_VARIABLE,KROT,OLD_RSB,
187 . NRAFX,NRAFY,NRAFZ,NFUNCT0,NTABLE0,NTABLE1,NSENSOR,
188 . IRFE,IRFL, HM_NINTER_DEF,NB_AMS,NUMNUSR,NPERTURB_HM,ICR3,
189 . NPYFUN
190 INTEGER IARCHS(8)
191 INTEGER IS_BEGIN,SCHAR
192 INTEGER IHBE_DS,ISST_DS,IPLA_DS,IFRAME_DS,ITET4_D,ITET10_D,ICPRE_D,IMAS_DS,ICONTROL_D,
193 . IHBE_D,IPLA_D,ISTR_D,ITHK_D,ISHEA_D,ISST_D,
194 . ISH3N_D, ISTRA_D,NPTS_D,IDRIL_D,IOFFSET_D,DEF_INTER(100)
195 my_real dtini, dtx ,rbid
196 CHARACTER (LEN=NCHARLINE) :: CART
197 CHARACTER (LEN=NCHARLINE) :: XRFILE ! NCHARLINE as #define is set to 500 in Starter
198 CHARACTER (LEN=NCHARLINE) :: KEY
199 CHARACTER (LEN=NCHARLINE) :: KEY2
200 CHARACTER (LEN=NCHARLINE) :: TMPLINE
201 CHARACTER (LEN=NCHARLINE) :: LINE
202 CHARACTER (LEN=NCHARTITLE) :: TITR
203 CHARACTER (LEN=255) :: STR_NBTHREADS
204 CHARACTER MESS*40, ERRMSG*40
205 CHARACTER*3 :: LABEL_DEF,LABEL_ROT
206C-----------------------------------------------
207C OpenMP specific
208#if defined(_OPENMP)
209 INTEGER OMP_GET_THREAD_NUM, OMP_GET_NUM_THREADS,NTHREAD1
210 EXTERNAL omp_get_thread_num, omp_get_num_threads
211 CHARACTER (LEN=255) :: STR
212#endif
213 INTEGER NTHREAD_S
214 my_real :: dt_input
215C
216 INTEGER , DIMENSION(:), ALLOCATABLE :: NPLY,NSUB,NISUB
217
218 INTEGER :: NITER,IFORM
219
220 INTEGER :: LEN_TMP_NAME
221 CHARACTER(len=4096) :: TMP_NAME
222 LOGICAL :: IS_AVAILABLE
223 INTEGER :: NUMTITLE, NGRTRIA, IDUMMY, NANIM_VERS
224 INTEGER :: NALEMUSCL
225 INTEGER :: NB_INISHE,NB_INISH3,NB_INIBRI,NB_INIQUAD,
226 . NB_INIBEAM,NB_INITRUSS,NB_INISPRIG,NB_INISPHCEL
227 INTEGER :: LEN_LINE
228 CHARACTER*20 UNIT_NAME
229 INTEGER IS_U_STRING
230C-----------------------------------------------
231C E x t e r n a l F u n c t i o n
232C-----------------------------------------------
233 INTEGER NBCS_LAGM
234 EXTERNAL nbcs_lagm
235C-----------------------------------------------
236C data
237C-----------------------------------------------
238 DATA s0file/' '/
239 DATA xrfile/' '/
240 DATA iun/1/
241
242C-----------------------------------------------
243C S o u r c e L i n e s
244C-----------------------------------------------
245
246C=======================================================================
247C Read title
248C=======================================================================
249 CALL hm_option_count('/TITLE', numtitle)
250 IF (numtitle > 0) THEN
251 CALL hm_option_start('/title')
252 CALL HM_OPTION_READ_KEY(LSUBMODEL, OPTION_TITR = LINE)
253 CALL HM_GET_STRING('my_title', LINE, ncharline, IS_AVAILABLE)
254 ELSE
255 LINE = ' '
256 ENDIF
257! Standard output
258 WRITE(ISTDO,'(a)') LINE(1:LEN_TRIM(LINE))
259
260 ! Store the input deck title in Structure
261 LEN_LINE= MIN(LEN_TRIM(LINE),LTITLE) ! Truncate to LTITLE
262 NAMES_AND_TITLES%TITLE(1:LEN_LINE)=LINE(1:LEN_LINE)
263
264 IMOT=0
265 REEL=ZEP66
266C=======================================================================
267C UNIT SYSTEM READER
268C First option to be read in order to convert other options.
269C=======================================================================
270 WRITE(ISTDO,'(a)')TITRE(12)
271 CALL HM_OPTION_COUNT('/unit',NUNIT0)
272 UNITAB%NUNIT0 = NUNIT0
273c
274 CALL HM_OPTION_COUNT('/begin',IS_BEGIN)
275
276 SCHAR = 20
277 IF (IS_BEGIN /= 0) THEN
278 CALL HM_OPTION_START('/begin')
279 CALL HM_OPTION_NEXT()
280
281 CALL HM_GET_INTV('invers', INVERS, IS_AVAILABLE, LSUBMODEL)
282 INVERS_SRC = INVERS
283 INVERS_INIT = INVERS
284
285 CALL HM_GET_STRING('length_inputunit_code',KEYLI,SCHAR,IS_AVAILABLE)
286 CALL HM_GET_STRING('mass_inputunit_code',KEYMI,SCHAR,IS_AVAILABLE)
287 CALL HM_GET_STRING('time_inputunit_code',KEYTI,SCHAR,IS_AVAILABLE)
288 CALL HM_GET_STRING('length_workunit_code',KEYL,SCHAR,IS_AVAILABLE)
289 CALL HM_GET_STRING('mass_workunit_code',KEYM,SCHAR,IS_AVAILABLE)
290 CALL HM_GET_STRING('time_workunit_code',KEYT,SCHAR,IS_AVAILABLE)
291
292 !convert into ascci format specific encoding of greek letter \mu
293 CALL ASCII_ENCODING_MU_LETTER(KEYLI, KEYMI, KEYTI, KEYL, KEYM, KEYT)
294
295 IF(INVERS <= 90)THEN
296 ! /UNIT/LENGTH/[value]
297 ! /UNIT/MASS/[value]
298 ! /UNIT/TIME/[value]
299 CALL HM_OPTION_START('/unit')
300 DO N=1,NUNIT0
301 CALL HM_OPTION_READ_KEY(LSUBMODEL,OPTION_ID = ID)
302 UNIT_NAME = ''
303 CALL HM_GET_STRING('unit_name',UNIT_NAME,2*ncharfield,IS_AVAILABLE)
304c
305 IF(UNIT_NAME == 'length') THEN
306 CALL HM_GET_STRING('type_unit',KEYL,2*ncharfield,IS_AVAILABLE)
307 ENDIF
308 IF(UNIT_NAME == 'mass') THEN
309 CALL HM_GET_STRING('type_unit',KEYM,2*ncharfield,IS_AVAILABLE)
310 ENDIF
311 IF(UNIT_NAME == 'time') THEN
312 CALL HM_GET_STRING('type_unit',KEYT,2*ncharfield,IS_AVAILABLE)
313 ENDIF
314 ENDDO
315 ENDIF !(INVERS <= 90)
316
317 ENDIF
318 CALL HM_READ_UNIT(UNITAB,LSUBMODEL)
319C=======================================================================
320C READING CONTROL CARDS
321C=======================================================================
322 WRITE(ISTDO,'(a)')TITRE(10)
323C-------------------------------------------------------------------
324C READING OF /SPMD
325C-------------------------------------------------------------------
326 CALL HM_READ_SPMD(LSUBMODEL)
327C
328 IGNORE_SPMD=0
329 IF (GOT_NCPU ==1) THEN
330 IF (NSPMD/=0) THEN
331 IGNORE_SPMD=1
332 END IF
333 NSPMD = NCPU
334 ENDIF
335C
336C thread number
337C
338 IGNORE_THREADS=0
339 GOT_VARIABLE=0
340#if defined(_OPENMP)
341 STR = ' '
342 CALL GETENV('omp_num_threads',STR)
343 NTHREAD1=0
344C nthread1 : thread number determined by environment variable
345 READ(STR,'(i10)',ERR=999)NTHREAD1
346 IF(NTHREAD1>0)THEN
347 NTHREAD = NTHREAD1
348 ENDIF
349 IF (GOT_NTH ==1) THEN
350 IF (NTHREAD/=0) THEN
351 IGNORE_THREADS=1
352 END IF
353 NTHREAD = NTH
354 ELSE
355 IF(NTHREAD1>0)THEN
356 GOT_VARIABLE=1
357 END IF
358 ENDIF
359C case no -nt, no OMP_NUM_THREADS, no /SPMD
360 NTHREAD = MAX(NTHREAD,1)
361 NTHREAD_S = NTHREAD
362 NTHREAD_R2R = NTHREAD
363 CALL OMP_SET_NUM_THREADS(NTHREAD_S)
364
365c else (open mp not defined)
366#elif 1
367 IF (GOT_NTH ==1) THEN
368 IF (NTHREAD/=0) THEN
369 IGNORE_THREADS=1
370 END IF
371 NTHREAD = NTH
372 ENDIF
373 NTHREAD_S = 1
374#endif
375C-------------------------------------------------------------------
376C /ARCH option not defined, IARCH= IBUILTIN & Grpsiz = ARCHINFO(IBUILTIN)
377 IARCH = IBUILTIN
378 NVSIZ = ARCHINFO(IBUILTIN,1)
379 IVECTOR = ARCHINFO(IBUILTIN,2)
380
381 ! ---------------------------
382 ! -grp_size hidden option
383 IF(GRP_SIZE_BOOL) THEN
384 NVSIZ = GRP_SIZE
385 ENDIF
386 ! ---------------------------
387C-------------------------------------------------------------------
388C READING OF /IOFLAG
389C-------------------------------------------------------------------
390 CALL HM_READ_IOFLAG(LSUBMODEL)
391C-------------------------------------------------------------------
392C READING OF /ANALY
393C-------------------------------------------------------------------
394 IPARI0= 1
395 INTEG8= 0
396 CALL HM_READ_ANALY(NANALY,IPARITH,IPARI0,LSUBMODEL)
397 N2D = NANALY
398C-------------------------------------------------------------------
399C READING OF /IMPLICIT
400C-------------------------------------------------------------------
401 CALL HM_READ_IMPLICIT(LSUBMODEL)
402C-------------------------------------------------------------------
403C READING OF /AMS
404C-------------------------------------------------------------------
405 CALL HM_OPTION_COUNT('/ams', NB_AMS)
406 CALL HM_READ_SMS(LSUBMODEL)
407C-------------------------------------------------------------------
408C READING OF /CAA
409C-------------------------------------------------------------------
410 CALL HM_READ_CAA(LSUBMODEL)
411C-------------------------------------------------------------------
412C READING OF /RANDOM
413C-------------------------------------------------------------------
414 CALL HM_OPTION_COUNT('/random',NRAND)
415C-------------------------------------------------------------------
416C READING OF /LAGMUL
417C-------------------------------------------------------------------
418 CALL HM_READ_LAGMUL(LSUBMODEL)
419C-------------------------------------------------------------------
420 CALL HM_OPTION_COUNT('/PRIVATE/metadata/fatxml',IPRIVATE)
421 IF(IPRIVATE > 0 ) IPRIVATE = 1
422C-------------------------------------------------------------------
423C READING OF /STAMPING
424C-------------------------------------------------------------------
425 CALL HM_OPTION_COUNT('/stamping',ISTAMPING)
426 IF(ISTAMPING > 0 ) ISTAMPING = 1
427C-------------------------------------------------------------------
428 ICRASH = 0
429C-------------------------------------------------------------------
430C READING DEFAULT VALUES FOR SHELLS, SOLIDS, INTERFACES ...
431C-------------------------------------------------------------------
432!--- remove first /DEF/SOLID in src21_c.inc
433 CALL init_def_zero(DEFAULTS)
434!---- obsolet flag values fixed here
435 IPLA_DS =2 ! obsolet
436 ISTR_D=1 ! istrain
437 ISHEA_D=0 ! Old hidden flag in /DEF_SHELL
438 INER_9_12 = ZERO
439 INSH = 0 ! Old hidden flag in /DEF_SHELL
440 NPTS_D = -1 ! Old hidden flag in /DEF_SHELL
441C-------------------------------------------------------------------
442C READING OF SHELL PROPERTIES DEFAULT VALUES
443C-------------------------------------------------------------------
444 CALL HM_READ_DEFSHELL(LSUBMODEL,DEFAULTS%SHELL)
445C-------------------------------------------------------------------
446C READING OF SOLID PROPERTIES DEFAULT VALUES
447C-------------------------------------------------------------------
448 CALL HM_READ_DEFSOLID(LSUBMODEL,DEFAULTS%SOLID)
449C----------------------------------------------
450 IS17OLD = 1 ! To be cleaned
451C-----
452 IF(INSH==1)INER_9_12 = TWELVE
453 IF(INSH==2)INER_9_12 = SIXTEEN
454 IF(INSH==3)INER_9_12 = FOURTY8
455 IF(INSH==4)INER_9_12 = THIRTY
456 IF(INSH==5)INER_9_12 = NINE
457! default values in def_solid/def_shell
458 CALL init_def_elem(N2D,IIMPLICIT,DEFAULTS)
459C-------------------------------------------------------------------
460C READING OF INTERFACES DEFAULT VALUES
461C-------------------------------------------------------------------
462 HM_NINTER_DEF = 0
463 DEF_INTER(1:100) = 0
464 CALL HM_OPTION_COUNT('/default/inter',HM_NINTER_DEF)
465 CALL HM_READ_DEFINTER(HM_NINTER_DEF,DEF_INTER,LSUBMODEL)
466 DEFAULTS%interface%DEF_INTER(1:100) = DEF_INTER(1:100)
467C-------------------------------------------------------------------
468 CALL HM_OPTION_COUNT('/intthick/v5',IINTTHICK)
469 IF (IINTTHICK > 1) THEN
470 CALL ANCMSG(MSGID=725,MSGTYPE=MSGERROR,ANMODE=ANINFO,I1=IINTTHICK)
471 ENDIF
472C-------------------------------------------------------------------
473C READGING OF /SHFRAM
474C-------------------------------------------------------------------
475 ISHFRAM = 0
476 CALL HM_OPTION_COUNT('/shfra/v4',NSHFRAM)
477 IF (NSHFRAM == 1) THEN
478 ISHFRAM = 2
479 ELSEIF (NSHFRAM > 1) THEN
480 CALL ANCMSG(MSGID=546,MSGTYPE=MSGERROR,ANMODE=ANINFO,I1=NSHFRAM)
481 ENDIF
482C-------------------------------------------------------------------
483C READGING OF /SH_3NFR
484C-------------------------------------------------------------------
485 ISH3NFRAM = 0
486C=======================================================================
487C Initialisations vs DOMDEC (Must stay after reading the control cards, because of output to STDO)
488C=======================================================================
489 IF(DECNEQ==0) DECNEQ = 100
490 IF(DECTYP < 0) THEN
491 DECTYP = - DECTYP
492 EDGE_FILTERING = 0
493 ELSE
494 EDGE_FILTERING = 1
495 ENDIF
496 OLD_RSB=0
497 IF(DECTYP == 2)THEN
498 DECTYP=0
499 OLD_RSB=1
500 ENDIF
501 IF(DECTYP==0)THEN
502.AND. IF(NB_AMS==0IIMPLICIT==0) THEN
503 DECTYP = 3
504 ELSE
505 DECTYP = 5
506 END IF
507 END IF
508
509 DDNOD_SMS=0
510 IF(DECTYP==7)THEN
511 IF(NB_AMS/=0)THEN
512 DECTYP = 5
513 DDNOD_SMS=1
514 ELSEIF(IIMPLICIT/=0) THEN
515 DECTYP = 5
516 ELSE
517 DECTYP = 3
518 END IF
519 END IF
520 IF(NSPMD < 1) NSPMD=1
521 IF(NSPMD > PARASIZ) NSPMD=PARASIZ
522 IF(NTHREAD < 1) NTHREAD=1
523C maximum number of SMP threads equal to NTHMAX
524 IF(NTHREAD > NTHMAX) NTHREAD=NTHMAX
525C
526 IF (GOT_INSPIRE_ALM == 1)THEN
527 IF (NTHREAD_S==1)THEN
528 WRITE(ISTDO,'(a,i4,a)')' .. solver running on ',NTHREAD_S,' thread'
529 ELSE
530 WRITE(ISTDO,'(a,i4,a)')' .. solver running on ',NTHREAD_S,' threads'
531 ENDIF
532 ELSE
533 IF (NTHREAD_S==1)THEN
534 WRITE(ISTDO,'(a,i4,a)')' .. starter running on ',NTHREAD_S,' thread'
535 ELSE
536 WRITE(ISTDO,'(a,i4,a)')' .. starter running on ',NTHREAD_S,' threads'
537 ENDIF
538 ENDIF
539
540C=======================================================================
541C OPTIONS NUMBERING
542C=======================================================================
543C WRITE(ISTDO,'(/,A)')' .. OPTIONS COUNTING'
544C-------------------------------------------------------------------
545C User-Defined Nodes & Cnodes numbering
546C Check nodes within some tolerance and possibly merge nodes
547C-------------------------------------------------------------------
548 CALL CPP_NODES_COUNT(NUMNUSR,NUMCNOD)
549C------
550C Pre-read Nodes & Cnodes and compute NUMNOD taking into account that some nodes may be merged.
551 CALL HM_PREREAD_NODE(UNITAB,LSUBMODEL,NUMNUSR,IS_DYNA) ! NUMNOD is computed here
552C------
553C numnod=0 : ask user to provide relevant input file.
554 IF(NUMNOD==0)THEN
555 CALL ANCMSG(MSGID=3,MSGTYPE=MSGERROR,ANMODE=ANINFO)
556 CALL ARRET(2)
557 ENDIF
558C-------------------------------------------------------------------
559 ISUMNX = 0
560 NANIM1D = 0
561 MAXNX = 0
562 NANIM2D = 0
563 NANIM3D = 0
564 NTHREAD_R2R = 1
565 IBID = 0
566 RBID = ZERO
567 NPINCH = 0
568 NSUBDOM = 0
569C---------------------------------------------------
570 CALL HM_OPTION_COUNT('/subdomain',NSUBDOM)
571 CALL HM_OPTION_COUNT('/extern/link',NR2RLNK)
572C---------------------------------------------------
573 LENMOD=0
574 LENGLM=0
575 LENCP=0
576 LENLM=0
577 LENFLS=0
578 LENDLS=0
579 LENVAR=0
580 LENRPM=0
581 LENMCD=0
582 LENELM=0
583 LENSIG=0
584 LENGRVI=0
585 LENGRVR=0
586C--- Xfem -------------------------------------------------------
587C---
588C WARNING: NUMNOD, NUMELC, NUMELTG ==> will be changed (by xfem)
589C---
590 NLEVMAX = 0
591 CALL HM_OPTION_COUNT('/inicrack',NINICRACK)
592C---------------------------------------------------
593C COUNTING ELEMENTS
594C---------------------------------------------------
595 NUMELX = 0
596 NUMBRICK = 0
597 NUMTETRA4 = 0
598 NUMPENTA6 = 0
599 NUMELS10 = 0
600 NUMELS20 = 0
601 CALL HM_ELEM_COUNT('xelem',NUMELX,IS_DYNA)
602 CALL HM_ELEM_COUNT('brick',NUMBRICK,IS_DYNA)
603 CALL HM_ELEM_COUNT('tetra4',NUMTETRA4,IS_DYNA)
604 CALL HM_ELEM_COUNT('penta6',NUMPENTA6,IS_DYNA)
605 NUMELS8 = NUMBRICK+NUMTETRA4+NUMPENTA6
606C
607 CALL HM_ELEM_COUNT('tetra10',NUMELS10,IS_DYNA)
608 IF (IS_DYNA == 0) CALL HM_ELEM_COUNT('brick20',NUMELS20,IS_DYNA)
609 CALL HM_ELEM_COUNT('shel16',NUMELS16,IS_DYNA)
610C
611C
612 NUMELS = NUMELS8+NUMELS10+NUMELS20+NUMELS16
613C
614C Look for /DT1/BRICK & /DT1TET10 /DTTSH in RADIOSS Engine input deck
615C
616 IF(NUMELS>0)THEN
617 CALL FIND_DT1BRICK_ENGINE()
618 END IF
619C-----
620 CALL HM_ELEM_COUNT('shell',NUMELC,IS_DYNA)
621.AND. IF(NUMELC > 0 NANALY /= 0)THEN
622 CALL ANCMSG(MSGID=285,MSGTYPE=MSGERROR,ANMODE=ANINFO)
623 NUMELC = 0
624 ENDIF
625C-----
626 CALL HM_ELEM_COUNT('sh3n',NUMELTG,IS_DYNA)
627.AND. IF(NUMELTG > 0 NANALY /= 0)THEN
628 CALL ANCMSG(MSGID=287,MSGTYPE=MSGERROR,ANMODE=ANINFO)
629 NUMELTG = 0
630 ENDIF
631C-----
632 CALL HM_ELEM_COUNT('truss' ,NUMELT,IS_DYNA)
633 CALL HM_ELEM_COUNT('beam' ,NUMELP,IS_DYNA)
634 CALL HM_ELEM_COUNT('spring',NUMELR,IS_DYNA)
635C-----
636 CALL HM_ELEM_COUNT('rivet',NRIVET,IS_DYNA)
637C-----
638 NUMELQ = 0
639 CALL HM_ELEM_COUNT('quad',NUMELQ,IS_DYNA)
640C-----
641 CALL HM_ELEM_COUNT('tria',NUMELTRIA,IS_DYNA)
642 NUMELTG = NUMELTG + NUMELTRIA !2d shell + 3d tria (only one type depending on N2D flag)
643C-----
644C---------------------------------------------------
645 CALL HM_OPTION_COUNT('part',NPART)
646 IF(NPART==0)THEN
647 CALL ANCMSG(MSGID=1114,
648 . MSGTYPE=MSGWARNING,
649 . ANMODE=ANINFO)
650 ENDIF
651 CALL HM_OPTION_COUNT('subset',NSUBS)
652C add 1 : for global subset
653 NSUBS = NSUBS+1
654C---------------------------------------------------
655 CALL HM_OPTION_COUNT('/thpart',NTHPART)
656C---------------------------------------------------
657C LOOKING FOR /ADMESH and COUNTING ADDITIONAL NODES & ELEMENTS
658C---------------------------------------------------
659 CALL HM_OPTION_COUNT('/admesh/global',NADMESHG)
660 CALL HM_OPTION_COUNT('/admesh/set',NADMESHSET)
661 CALL HM_OPTION_COUNT('/admesh/state',NADMESHSTAT)
662 NADMESH = NADMESHG + NADMESHSET + NADMESHSTAT
663 NUMNOD0 = NUMNOD
664 NUMELC0 = NUMELC
665 NUMELTG0 = NUMELTG
666 ISTATCND = 0
667 IADMERRT = 0
668 IF(NADMESH/=0)THEN
669C
670C NUMNOD, NUMELC, NUMELTG will be changed
671 CALL NBADMESH(LSUBMODEL,NUMNUSR,UNITAB)
672 END IF
673C-----
674 IF(NSPMD > 1)THEN
675C Tests option non disponible en SPMD (ie NSPMD > 1)
676 IF(NADMESH/=0)THEN
677 CALL ANCMSG(MSGID=704,
678 . MSGTYPE=MSGERROR,
679 . ANMODE=ANINFO)
680 END IF
681 END IF
682C---------------------------------------------------
683C LOOKING FOR IGE REFINEMENT and COUNTING ADDITIONAL NODES & ELEMENTS
684C---------------------------------------------------
685 NUMNODIGE0 = NUMNOD
686 NUMELIG3D0 = NUMELIG3D
687 IF(NRAFMAX/=0)THEN
688C
689C NUMNOD, NUMELIG3D will be changed, SIXIG3D and KXIG3D too
690 CALL NBADIGEMESH(LSUBMODEL,NUMNUSR)
691 END IF
692C---------------------------------------------------
693C MATERIALS (+1 materiau fictif ressort)
694C---------------------------------------------------
695 HM_NUMMAT = 0
696 CALL HM_OPTION_COUNT('material',HM_NUMMAT)
697 NUMMAT = HM_NUMMAT + 1
698 MAT_ELEM%NUMMAT = NUMMAT
699C---------------------------------------------------
700C PROPERTIES
701C---------------------------------------------------
702 HM_NUMGEO = 0
703 CALL HM_OPTION_COUNT('property',HM_NUMGEO)
704 NUMGEO = HM_NUMGEO
705C-----
706 CALL HM_OPTION_COUNT('/ply', NUMPLY)
707 CALL HM_OPTION_COUNT('/drape',NDRAPE)
708 CALL HM_OPTION_COUNT('/stack',NUMSTACK)
709C---------------------------------------------------
710C TOOLS
711C---------------------------------------------------
712 CALL HM_OPTION_COUNT('/accel', naccelm)
713C-----
714 CALL hm_option_count('/GAUGE', nbgauge)
715C-----
716 CALL hm_option_count('/ACTIV', nactiv)
717C-----
718 CALL hm_option_count('/ADMAS',nodmas)
719C-----
720 CALL hm_option_count('/CLUSTER',ncluster)
721C-----
722 CALL hm_option_count('/PYTHON_FUNCT' , npyfun)
723
724 CALL hm_option_count('/FUNCT' , nfunct0)
725
726 CALL hm_option_count('/TABLE/0', ntable0)
727 CALL hm_option_count('/TABLE/1', ntable1)
728 nfunct = nfunct0 + ntable0 + ntable1 + npyfun
729 ntable = nfunct
730C-----
731 CALL hm_option_count('/FUNC_2D', nfunc2d)
732C-----
733 iperturb = 0
734 CALL hm_option_count('/PERTURB',nperturb)
735 IF (nperturb > 0) iperturb = 1
736C-----
737 CALL hm_option_count('/SENSOR', nsensor)
738C-----
739 CALL hm_option_count('/SKEW',numskw)
740 CALL hm_option_count('/FRAME',numfram)
741C-----
742 CALL hm_option_count('TRANSFORM',ntransf)
743C---------------------------------------------------
744C LOADS
745C---------------------------------------------------
746 CALL hm_option_count('/CLOAD',nconld)
747 CALL hm_option_count('/PLOAD',npreld)
748 CALL hm_option_count('/LOAD/CENTRI',nloadc)
749 CALL hm_option_count('/LOAD/PFLUID',nloadp_f)
750 CALL hm_option_count('/LOAD/PBLAST',pblast%NLOADP_B)
751 CALL hm_option_count('/LOAD/PRESSURE',nloadp_hyd)
752C---------------------------------------------------
753C GRAVITY
754C---------------------------------------------------
755 CALL hm_option_count('/GRAV',ngrav)
756C---------------------------------------------------
757C BOUNDARY CONDITIONS
758C---------------------------------------------------
759 CALL hm_option_count('/BCS/LAGMUL',nbcslag)
760 CALL hm_option_count('/BCS/CYCLIC',nbcscyc)
761 CALL hm_option_count('/BCS',numbcs)
762 CALL hm_option_count('/NBCS',numbcsn)
763 nbcskin = numbcs - nbcslag
764 CALL hm_option_count('/BCS/WALL',bcs%NUM_WALL)
765C---------------------------------------------------
766C KINEMATIC CONDITIONS
767C---------------------------------------------------
768 CALL hm_option_count('/IMPDISP',nimpdisp)
769 CALL hm_option_count('/IMPVEL' ,nimpvel)
770 CALL hm_option_count('/IMPACC' ,nimpacc)
771 nfxvel = nimpdisp + nimpvel + nimpacc
772C-----
773 CALL hm_option_count('/RBODY',nrbody)
774 nrbody0 = nrbody
775 CALL hm_option_count('/RBODY/LAGMUL',nrbylag)
776 nrbykin = nrbody - nrbylag
777 CALL hm_option_count('/FXBODY',nfxbody)
778C-----
779 CALL hm_option_count('/MERGE/RBODY',nrbmerge)
780C-----
781 CALL hm_option_count('/MERGE/NODE',nb_merge_node)
782C-----
783 CALL hm_option_count('/RBE2', nrbe2)
784 CALL hm_option_count('/RBE3', nrbe3)
785C-----
786 CALL hm_option_count('/RLINK', nlink)
787C-----
788 CALL hm_option_count('/RWALL',nrwall)
789C-----
790 CALL hm_option_count('/MPC',nummpc)
791 CALL hm_option_count('/CYL_JOINT', njoint)
792 CALL hm_option_count('/GJOINT', ngjoint)
793C---------------------------------------------------
794C SEATBELT TOOLS
795C---------------------------------------------------
796 CALL hm_option_count('/SLIPRING', nslipring)
797 CALL hm_option_count('/RETRACTOR', nretractor)
798C---------------------------------------------------
799C MONITORED VOLUMES
800C---------------------------------------------------
801 CALL hm_option_count('/MONVOL', nmonvol)
802C---------------------------------------------------
803C INTERFACES
804C---------------------------------------------------
805 ninter = 0
806 hm_ninter= 0
807 CALL hm_option_count('/INTER',hm_ninter)
808C-----
809 CALL hm_option_count('/INTER/TYPE22',int22)
810 IF(int22>0)nsub22=2
811 IF(int22>0)alefvm_param%IEnabled=1 !AUTOMATICALLY ENABLING ALE FVM SCHEME FOR FSI INTER22
812C-----
813 CALL hm_option_count('/INTER/SUB',nintsub)
814 ninter = hm_ninter - nintsub
815C-----
816 CALL hm_option_count('/FRICTION',ninterfric)
817 CALL hm_option_count('/FRIC_ORIENT',nfric_orient)
818C---------------------------------------------------
819 CALL hm_option_count('/DAMP',ndamp)
820C---------------------------------------------------
821 CALL hm_option_count('/PRELOAD',npreload) !Bolt preloading
822C---------------------------------------------------
823 CALL hm_option_count('/SECT',nsect)
824C---------------------------------------------------
825C---------------------------------------------------
826C Box, Groups, Lines, Surfaces, Sets
827C---------------------------------------------------
828 CALL hm_option_count('/BOX' ,nbbox)
829 CALL hm_option_count('/SURF',nsurf)
830 CALL hm_option_count('/LINE' ,nslin)
831 CALL hm_option_count('/GRNOD' ,ngrnod )
832 CALL hm_option_count('/GRBRIC',ngrbric)
833 CALL hm_option_count('/GRQUAD',ngrquad)
834 CALL hm_option_count('/GRPART',ngrpart)
835 CALL hm_option_count('/GRSHEL',ngrshel)
836 CALL hm_option_count('/GRSH3N',ngrsh3n)
837 CALL hm_option_count('/GRTRIA',ngrtria)
838 ngrsh3n = ngrsh3n + ngrtria ! 3D or 2D (same buffer)
839 CALL hm_option_count('/GRTRUS',ngrtrus)
840 CALL hm_option_count('/GRBEAM',ngrbeam)
841 CALL hm_option_count('/GRSPRI',ngrspri)
842 nsets = 0
843 CALL hm_option_count('/SET',nsets)
844 ngpe = ngrnod + ngrbric + ngrquad + ngrshel + ngrsh3n + ngrtrus + ngrbeam + ngrspri + ngrpart
845C---------------------------------------------------
846C Initial conditions
847C---------------------------------------------------
848 CALL hm_option_count('/INIVEL',hm_ninvel)
849 ninvel = hm_ninvel
850C-----
851 CALL hm_option_count('/REFSTA',irefsta)
852 is_refsta = .false.
853 IF(irefsta > 0)is_refsta = .true.
854C-----
855 CALL hm_option_count('/XREF',nxref)
856C-----
857 CALL hm_option_count('/EREF',neref)
858C
859C---- READING OF /INISTA
860 CALL hm_read_inista(s0file, isigi, ioutp_fmt, irootyy_r, lsubmodel)
861C
862 irfe=irform/5
863 irfl=irform-5*irfe
864 irform=5*irfe+irfl
865 IF (irform /= 12) THEN
866 CALL ancmsg(msgid=636,msgtype=msgwarning,anmode=aninfo_blind_1)
867 irform = 12
868 ENDIF
869C
870C---- READING OF /REFSTA
871 CALL hm_read_refsta(lsubmodel, xrfile)
872C-----
873 CALL hm_option_count('/INIGRAV',ninigrav)
874C-----
875 CALL hm_option_count('/INIMAP1D', ninimap1d)
876 CALL hm_option_count('/INIMAP2D', ninimap2d)
877C-----
878 CALL hm_option_count('/INIVOL' ,num_inivol)
879C---------------------------------------------------
880C Thermal FE options
881C---------------------------------------------------
882 CALL hm_option_count('/INITEMP' ,glob_therm%NINTEMP)
883 CALL hm_option_count('/IMPTEMP' ,glob_therm%NIMTEMP)
884 CALL hm_option_count('/IMPFLUX' ,glob_therm%NIMPFLUX)
885 CALL hm_option_count('/CONVEC' ,glob_therm%NCONVEC)
886 CALL hm_option_count('/RADIATION',glob_therm%NRADIA)
887C---------------------------------------------------
888C SPH
889C---------------------------------------------------
890 CALL hm_option_count('/SPHCEL',numsph)
891
892 nselsp = 0
893 CALL hm_option_count('/SPHBCS',nspcond)
894 nsphsym= 0
895 maxpjet= 0
896C
897c call NBSPH only once NSPMD is known in order to compute NSPHRES=NSPHRES*NSPMD to prepare NSPHRES by proc
898c for inlets treatment in SPMD
899c NSPHRES is the global number of SPH reserve
900C NBSPH computes NSPHIO & NSPHRES :
901 CALL nbsph(lsubmodel)
902C
903C add NSPHRES number of SPH reserve for inlet
904 numnod=numnod+nsphres
905 numsph=numsph+nsphres
906C---------------------------------------------------
907C MADYMO
908C---------------------------------------------------
909 nexmad =0
910 nconx =0
911 CALL hm_option_count('/MADYMO/EXFEM', nexmad)
912 CALL hm_option_count('/MADYMO/LINK', nconx)
913 IF (nconx > 0) CALL ancmsg(msgid=2023, msgtype=msgerror, anmode=aninfo)
914C---------------------------------------------------
915 neig = 0
916 CALL hm_option_count('/EIG',neig)
917 IF (neig>0) ipari0 = 0
918C---------------------------------------------------
919 nflow = 0
920 CALL hm_option_count('/BEM/FLOW', nflow)
921 idummy = 0
922 CALL hm_option_count('/BEM/DAA', idummy)
923 nflow = nflow + idummy
924C---------------------------------------------------
925C DFS, ALE, EULER
926C---------------------------------------------------
927 flg_fsi = 0
928 ale%GLOBAL%IS_BOUNDARY_MATERIAL = .false.
929C-----
930 CALL hm_option_count('/EBCS',nebcs)
931C---------------------------------------------------
932! Counting /DFS
933C---------------------------------------------------
934 CALL hm_option_count('/DFS/DETPOIN',detonators%N_DET_POINT)
935 CALL hm_option_count('/DFS/DETLINE',detonators%N_DET_LINE)
936 CALL hm_option_count('/DFS/WAV_SHA',detonators%N_DET_WAVE_SHAPER)
937 CALL hm_option_count('/DFS/DETPLAN',detonators%N_DET_PLANE)
938 CALL hm_option_count('/DFS/DETCORD',detonators%N_DET_CORD)
939 detonators%N_DET=detonators%N_DET_POINT
940 . +detonators%N_DET_LINE
941 . +detonators%N_DET_WAVE_SHAPER
942 . +detonators%N_DET_PLANE
943 . +detonators%N_DET_CORD
944C---------------------------------------------------
945! /DFS/LASER
946C---------------------------------------------------
947 nlaser = 0
948 CALL hm_option_count('/DFS/LASER',nlaser)
949C---------------------------------------------------
950 jeul=0
951 CALL hm_option_count('/EULER/MAT', jeul)
952 jeul=min(jeul,1)
953 lveul=32
954 IF(integ8==1)lveul=52
955C---------------------------------------------------
956 jale=0
957 CALL hm_option_count('/ALE/MAT', jale)
958 jale=min(jale,1)
959C---------------------------------------------------
960 nalebcs = 0
961 CALL hm_option_count('/ALE/BCS', nalebcs)
962 IF(ale%GLOBAL%ICAA == 1) ale%GRID%NWALE = -1
963 dt_input = zero
964 !********************************
965 ! /ALE/GRID: ALE grid formulation
966 !********************************
967 CALL hm_read_ale_grid(dt_input, ale%GRID%ALPHA, ale%GRID%GAMMA, ale%GRID%VGX, ale%GRID%VGY, ale%GRID%VGZ,
968 . volmin, lsubmodel, unitab)
969
970 !*******************************************************************
971 ! /ALE/MUSCL: activation of second order methods for LAW51 or LAW151
972 !*******************************************************************
973 CALL hm_read_ale_muscl(lsubmodel, unitab)
974
975 !************************
976 ! /ALE/LINK/VEL: counting
977 !************************
978 CALL hm_option_count('/ALE/LINK/VEL', nalelk)
979
980 !*****************
981 ! /ALE/SOLVER/FINT
982 !*****************
983 CALL hm_read_ale_solver(lsubmodel, unitab, ale%GLOBAL%ICAA, ale%GLOBAL%ISFINT)
984
985 !********
986 ! /UPWIND
987 !********
988 CALL hm_read_upwind(jupw, ale%UPWIND%UPWMG, ale%UPWIND%UPWOG, ale%UPWIND%UPWSM, lsubmodel, unitab)
989C---------------------------------------------------
990C OPTIONS DE L'ENGINE LUES DANS LE STARTER
991C { ENGINE OPTIONS READ IN THE STARTER }
992C---------------------------------------------------
993 CALL hm_option_count('/RUN',nrun_eng)
994 CALL hm_option_count('/ANIM',nanim_eng)
995 CALL hm_option_count('/TFILE',ntfile_eng)
996 CALL hm_option_count('/RFILE',nrfile_eng)
997 CALL hm_option_count('/DT',ndt_eng)
998 CALL hm_option_count('/STOP',nstop_eng)
999 CALL hm_option_count('/VERS',nvers_eng)
1000 ngine=nrun_eng+nanim_eng+ntfile_eng+nrfile_eng+ndt_eng+nstop_eng+nvers_eng
1001C---------------------------------------------------
1002 ndsolv=0
1003C----------------------------------------------------------
1004C Anim version 5 non encore supporte
1005 anim_vers = 44
1006 nanim_vers = 0
1007 CALL hm_option_count('/ANIM/VERS',nanim_vers)
1008 IF (nanim_vers > 0) THEN
1009 CALL hm_option_start('/ANIM/VERS')
1010 CALL hm_option_next()
1011 CALL hm_get_intv('Anim_vers', anim_vers, is_available, lsubmodel)
1012 ENDIF
1013C=======================================================================
1014C Some initializations ... (some flags / values need a 1st pre-reading of some options)
1015C=======================================================================
1016 iform8 = 2
1017 dtini = zero
1018 dtfac = zero
1019 dthis = zero
1020 DO i = 1,10
1021 dtabf(i) = ep30
1022 dtabfwr(i) = ep30
1023 ENDDO
1024 dtmin = zero
1025 ihsh = 0
1026 DO i = 1,9
1027 dthis1(i)= 0
1028 ENDDO
1029C----------------------------------------------------------
1030C solids with rotation
1031C----------------------------------------------------------
1032 krot = 0
1033 CALL hm_option_count('/INIVEL/NODE',i)
1034 IF(i > 0)krot=1
1035 iroddl=min(1,numelc+numelp+nrbody+numelr+numeltg+ngjoint+nummpc+nfxbody+numelx+krot)
1036 iroddl0 = 0
1037 iisrot = 0
1038 !for SIN initialization and IN allocation in lectur.F
1039 CALL hm_option_start('MATERIAL')
1040 DO i = 1, hm_nummat
1041 mat_number = i
1042 CALL hm_option_read_key(lsubmodel,keyword2 = key)
1043 IF ((key(1:5) == 'LAW13' .AND.
1044 . key(1:6) /= 'LAW131' .AND. key(1:6) /= 'LAW132' .AND.
1045 . key(1:6) /= 'law133.AND.' KEY(1:6) /= 'law134.AND.'
1046 . KEY(1:6) /= 'law135.AND.' KEY(1:6) /= 'law136.AND.'
1047 . KEY(1:6) /= 'law137.AND.' KEY(1:6) /= 'law138.AND.'
1048 . KEY(1:6) /= 'law139' )
1049 . .OR. key(1:5) == 'RIGID') iroddl0 = 1
1050 IF (key(1:5) == 'LAW68' .OR. key(1:5) == 'COSSE') iisrot = 1
1051 ENDDO
1052C--------------------------------------------
1053C PRE-READ OF Prop IDS for triangles SH3N6 & solid rotations
1054C PRE-READ OF Prop IDS , PARTS & SOLIDSfor sol to SPH
1055C--------------------------------------------
1056 ALLOCATE(igeo(npropgi*numgeo),stat=stat)
1057 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='IGEO')
1058 igeo=0
1059 numeltg6 = 0
1060 nsphsol = 0
1061 ALLOCATE(nsub(numgeo + numstack) ,stat=stat)
1062 ALLOCATE(nisub(numgeo + numstack) ,stat=stat)
1063 ALLOCATE(nply(numgeo + numstack) ,stat=stat)
1064c
1065 CALL hm_preread_properties(igeo,nsphsol,nply,nsub,nisub,lsubmodel,defaults)
1066
1067 IF(nsphsol/=0.AND.numels8/=0)THEN
1068 ALLOCATE(ipart(lipart1*npart),stat=stat)
1069 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='IPART')
1070 ipart=0
1071 CALL hm_preread_part(ipart,igeo,lsubmodel)
1072C
1073 ALLOCATE(ixs(nixs*numels8),stat=stat)
1074 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='IPART')
1075 CALL hm_prelce16s(ipart,igeo,ixs,nsphsol,lsubmodel,is_dyna)
1076C
1077 irest_mselt=1
1078C
1079 ENDIF
1080 numnod=numnod+nsphsol
1081 numsph=numsph+nsphsol
1082C-----
1083 IF(numsph/=0)THEN
1084 CALL hm_read_sphglo(lsubmodel)
1085 ENDIF
1086C----------------------------------------------------------
1087 CALL contrbe2(icr,lsubmodel)
1088 CALL contrbe3(icr3,lsubmodel)
1089 IF(iisrot==1.OR.icr>0.OR.icr3>0)iroddl = 1
1090C----------------------------------------------------------
1091 CALL hm_option_count('/USERWI',user_windows%HAS_USER_WINDOW)
1092 ncpri=1
1093 IF(dtini==zero)dtini=ep06
1094 IF(volmin==zero)volmin=-ep20
1095 dt2old=dtini/onep1
1096 tt=zero
1097 dt1=zero
1098 dt2=zero
1099C
1100 t1s= zero
1101 dt2s=zero
1102C
1103 dtx=zero
1104 tstop=zero
1105 dtanim = zero
1106 tanim=zero
1107 tanim_stop = ep20
1108 dtoutp = zero
1109 toutp=zero
1110 this=zero
1111 tabfis=zero
1112 tabfwr=zero
1113 econtv = zero
1114 output%TH%WFEXT = zero
1115 reint = zero
1116 ureint = zero
1117 econtd = zero
1118 econt_cumu = zero
1119
1120 irun=0
1121 iger=0
1122 ianim=0
1123 ih3d=0
1124C
1125 DO i = 1,9
1126 this1(i)= 0
1127 ENDDO
1128C
1129 n2d = nanaly
1130 IF(dtfac==zero.AND.n2d/=0)dtfac=0.67 !0.67 => 0.670000016689301 !ZEP67 => 0.670000000000000
1131 IF(dtfac==zero.AND.n2d==0)dtfac=0.90 !0.90 => 0.899999976158142 !ZEP9 => 0.900000000000000
1132C=======================================================================
1133C Opening of some input files (.sty, etc...)
1134C=======================================================================
1135 IF(isigi==1.OR.isigi==2) THEN
1136C-- Lecture fichier S00 supprimee
1137 ELSEIF(isigi==3.OR.isigi==4.OR.isigi==5) THEN
1138C-- Lecture fichier Y00/Ynn
1139 IF(s0file==' ') THEN
1140 isigi=-isigi
1141 ELSE
1142 j = 0
1143 IF(irootyy_r==2)THEN
1144 DO i=1,ncharline
1145 IF(s0file(i:i)/=' ')j = j + 1
1146 ENDDO
1147 n = j - 3
1148 tmp_name=infile_name(1:infile_name_len)//s0file(1:len_trim(s0file))
1149 len_tmp_name = infile_name_len+len_trim(s0file)
1150 IF(s0file(n:n)=='Y')THEN
1151 OPEN(unit=iin4,file=tmp_name(1:len_tmp_name),access='SEQUENTIAL',form='FORMATTED',status='OLD')
1152
1153 tmp_name=infile_name(1:infile_name_len)//s0file(1:n)//'000'
1154 len_tmp_name = infile_name_len+n+3
1155 OPEN(unit=iin5,file=tmp_name(1:len_tmp_name),access='SEQUENTIAL',form='FORMATTED',status='OLD')
1156 ELSE
1157 OPEN(unit=iin4,file=tmp_name(1:len_tmp_name),err=100,access='SEQUENTIAL',form='FORMATTED',status='OLD')
1158 CALL ancmsg(msgid=169,msgtype=msgerror,anmode=aninfo,c1=s0file)
1159100 CALL ancmsg(msgid=2062,msgtype=msgerror,anmode=aninfo,c1=s0file)
1160 ENDIF
1161 ELSE
1162 j = 0
1163 i = 1
1164 DO WHILE(s0file(i:i)/=' ')
1165 j = j + 1
1166 i = i + 1
1167 ENDDO
1168 n = j-3
1169 tmp_name=infile_name(1:infile_name_len)//s0file(1:len_trim(s0file))
1170 len_tmp_name = infile_name_len+len_trim(s0file)
1171 IF(s0file(n:n+4)=='.sty')THEN
1172 OPEN(unit=iin4,file=tmp_name(1:len_tmp_name),access='SEQUENTIAL',form='FORMATTED',status='OLD')
1173
1174 tmp_name=infile_name(1:infile_name_len)//s0file(1:n-6)//'_0000.sty'
1175 len_tmp_name = infile_name_len+n-6+9
1176 OPEN(unit=iin5,file=tmp_name(1:len_tmp_name),access='SEQUENTIAL',form='FORMATTED',status='OLD')
1177 ELSE
1178 OPEN(unit=iin4,file=tmp_name(1:len_tmp_name),err=200,access='SEQUENTIAL',form='FORMATTED',status='OLD')
1179 CALL ancmsg(msgid=169,msgtype=msgerror,anmode=aninfo,c1=s0file)
1180200 CALL ancmsg(msgid=2062,msgtype=msgerror,anmode=aninfo,c1=s0file)
1181 ENDIF
1182 ENDIF
1183 ENDIF
1184 ENDIF
1185C---------------------------------------------------
1186C COUNT /INI CARDS READ BY HM_READER
1187C---------------------------------------------------
1188 CALL hm_option_count('/INISHE', nb_inishe)
1189 CALL hm_option_count('/INISH3', nb_inish3)
1190 CALL hm_option_count('/INIBRI', nb_inibri)
1191 CALL hm_option_count('/INIQUA', nb_iniquad)
1192 CALL hm_option_count('/INIBEAM', nb_inibeam)
1193 CALL hm_option_count('/INITRUSS', nb_initruss)
1194 CALL hm_option_count('/INISPRI', nb_inisprig)
1195 CALL hm_option_count('/inisphcel', NB_INISPHCEL)
1196
1197.AND. IF(ISIGI==0
1198 . (NB_INISHE+NB_INISH3
1199 . +NB_INIBRI+NB_INIQUAD
1200 . +NB_INIBEAM+NB_INITRUSS
1201 . +NB_INISPRIG+NB_INISPHCEL)/=0) ISIGI=-3
1202C=======================================================================
1203C Writing to 0000.out FILE
1204C=======================================================================
1205 WRITE (IOUT,'(a)') TRIM(NAMES_AND_TITLES%TITLE)
1206 WRITE (IOUT,'(//a/a/,(a,1pg20.13))')TITRE(110),TITRE(111)
1207 WRITE (IOUT,'(a,i10)') TITRE(117)(1:57),IPRI,
1208 . TITRE(120)(1:57),INVERS_SRC
1209 WRITE (IOUT,'(a,i10)')
1210 . ' nsubs: number of subsets. . . . . . . . . . . . . .',
1211 . NSUBS,
1212 . ' npart: number of parts. . . . . . . . . . . . . . .',
1213 . NPART
1214 WRITE (IOUT,'(a,i10)') TITRE(125)(1:57),NUMMAT-1,
1215 . TITRE(135)(1:57),NUMGEO,
1216 . TITRE(126)(1:57),NUMNOD,TITRE(127)(1:57),NUMSKW,
1217 . TITRE(128)(1:57),NUMBCS
1218 IF (NALEBCS /= 0)
1219 . WRITE (IOUT,'(a,i10)') TITRE(189)(1:57), NALEBCS
1220 WRITE (IOUT,'(a,i10)')
1221 . ' numfram: number of reference frames . . . . . . . . .',
1222 . NUMFRAM
1223 WRITE (IOUT,'(a,i10)')
1224 . TITRE(131)(1:57),NUMELQ ,
1225 . TITRE(191)(1:57),NUMELTRIA,
1226 . TITRE(132)(1:57),NUMELS ,
1227 . TITRE(133)(1:57),NUMELC ,
1228 . TITRE(134)(1:57),NUMELT ,
1229 . TITRE(136)(1:57),NUMELP ,
1230 . TITRE(137)(1:57),NUMELR ,
1231 . TITRE(180)(1:57),NUMELTG-NUMELTRIA,
1232 . TITRE(182)(1:57),NUMELX ,
1233 . TITRE(186)(1:57),NUMELIG3D
1234 WRITE (IOUT,'(a,i10)')
1235 .' numsph : number of smooth particles(sph cells) . . .',
1236 . NUMSPH
1237 WRITE (IOUT,'(a,i10)')
1238 .' nsphbcs: number of sph symmetry conditions. . . . . .',
1239 . NSPCOND
1240 WRITE (IOUT,'(a,i10)')
1241 .' nsphio : number of sph inlet/outlet conditions. . . .',
1242 . NSPHIO
1243 IF(NSPHRES/=0)THEN
1244 WRITE (IOUT,'(a,/,a,i10)')
1245 .' nsphres:number of particles from sph reserves among numsph,',
1246 .' number of nodes from sph reserves among numnod. . .',
1247 . NSPHRES
1248 ENDIF
1249 IF(NSPHSOL/=0)THEN
1250 WRITE (IOUT,'(a,/,a,i10)')
1251 .' nsphsol:number of particles & nodes created from solids .',
1252 .' (among numsph & numnod) . . . . . . . . . . . . .',
1253 . NSPHSOL
1254 ENDIF
1255 WRITE (IOUT,'(/(a,i10))') TITRE(138)(1:57),NFUNCT,
1256 .' ngrav: number of gravity loads . . . . . . . . . . .',
1257 .NGRAV,
1258 .' nfunc2d: number of user 2d functions . . . . . . . .',
1259 .NFUNC2D,
1260 .' ninigrv:number of initial gravity loads . . . . . . .',
1261 .NINIGRAV,
1262 .' nconld: number of concentrated loads. . . . . . . . .',
1263 .NCONLD,
1264 .' ninvel: number of initial velocities. . . . . . . . .',
1265 .NINVEL,
1266 .' npreld: number of pressure loads. . . . . . . . . . .',
1267 .NPRELD,
1268 .' ninimap1d: number of initial 1d mapping.. . . . . . .',
1269 .NINIMAP1D,
1270 .' ninimap2d: number of initial 2d mapping.. . . . . . .',
1271 .NINIMAP2D
1272 IF(NPRELOAD>0) THEN
1273 WRITE (IOUT,'(a,i10)')
1274 . ' npreload: number of bolt preloadings. . . . . . . . .',
1275 . NPRELOAD
1276 ENDIF
1277 IF(DETONATORS%N_DET > 0)THEN
1278 WRITE (IOUT,'(/(a,i10))') TITRE(141)(1:57),DETONATORS%N_DET_POINT,
1279 . TITRE(171)(1:57),DETONATORS%N_DET_LINE,
1280 . TITRE(172)(1:57),DETONATORS%N_DET_WAVE_SHAPER,
1281 . TITRE(187)(1:57),DETONATORS%N_DET_CORD,
1282 . TITRE(188)(1:57),DETONATORS%N_DET_PLANE
1283 ENDIF
1284 IF(NLASER > 0) WRITE (IOUT,'((a,i10))') TITRE(178)(1:57),NLASER
1285 WRITE (IOUT,'(4x,a,i10)')
1286 . 'number of accelerometers. . . . . . . . . . . . . . .',
1287 . NACCELM,
1288 . 'number of sensors . . . . . . . . . . . . . . . . . .',
1289 . NSENSOR,
1290 . 'number of gauges. . . . . . . . . . . . . . . . . . .',
1291 . NBGAUGE
1292 WRITE (IOUT,'(a,i10)') TITRE(146)(1:57),NINTER,
1293 . TITRE(147)(1:57),NRWALL,TITRE(148)(1:57),NRBODY,
1294 .' nfxbody: number of flexible bodies. . . . . . . . . .',
1295 .NFXBODY,
1296 . TITRE(149)(1:57),NCONX,
1297 . TITRE(150)(1:57),NODMAS,TITRE(183)(1:57),NIMPDISP,
1298 . TITRE(184)(1:57),NIMPVEL,TITRE(185)(1:57),NIMPACC,
1299 . TITRE(152)(1:57),NRIVET,TITRE(153)(1:57),NSECT,
1300 . TITRE(155)(1:57),NJOINT
1301C
1302 IF(NINTERFRIC > 0) WRITE (IOUT,'(a,i10)') TITRE(190)(1:57),NINTERFRIC
1303 IF(NALELK>0)WRITE(IOUT,'(a,i10)')
1304 .' nalelk: number of ale links. . . . . . . . . . . . . ',
1305 .NALELK
1306 WRITE (IOUT, 5051) NACTIV
1307 WRITE (IOUT, 5052) NDAMP
1308 WRITE (IOUT, 5053) NGJOINT
1309 WRITE (IOUT, 5054) NUMMPC
1310 WRITE (IOUT, 5050) NR2RLNK
1311 WRITE (IOUT, 5055) NSUBDOM
1312 WRITE (IOUT,5000)NVOLU+NMONVOL
1313 WRITE(IOUT,'(a,i10)')
1314 .' neig: number of eigen and static modes problems . .',
1315 .NEIG
1316 WRITE(IOUT,'(a,i10)')
1317 .' nbem: number of bem solved problems . . . . . . . .',
1318 .NFLOW
1319 WRITE(IOUT,'(a,i10)')
1320 .' NRBE2: NUMBER OF RBE2 RIGID ELEMENTS . . . . . . . .',
1321 .nrbe2
1322 WRITE(iout,'(A,I10)')
1323 .' NRBE3: NUMBER OF RBE3 CONSTRAINT ELEMENTS . . . . .',
1324 .nrbe3
1325 WRITE (iout,'(2A/A,I10)')' INITIAL STRESS FILE =',trim(s0file),
1326 . ' FLAG ISIGI. . .',
1327 . isigi
1328C
1329 IF (irefsta/=0) THEN
1330 WRITE (iout,'(2A/A,I10/A,I10)')
1331 . ' REFERENCE METRIC FILE =',xrfile,
1332 . ' FLAG IREFSTA. .',
1333 . irefsta,
1334 . ' NUMBER OF STEPS , NITRS. .',
1335 . nitrs
1336 ENDIF
1337
1338 IF(jale+jeul/=0)THEN
1339 WRITE(iout,'(A,I10)')' isfint: ale/euler momentum integration formulation. .',ALE%GLOBAL%ISFINT
1340 ENDIF
1341 IF(ALE%GLOBAL%ICAA==1)THEN
1342 WRITE(IOUT,5380)
1343 END IF
1344 IF(JALE/=0)THEN
1345 WRITE (IOUT,5100)ALE%GRID%NWALE
1346 SELECT CASE (ALE%GRID%NWALE)
1347 CASE(0);WRITE (IOUT,5199) ALE%GRID%ALPHA,ALE%GRID%GAMMA,ALE%GRID%VGX,ALE%GRID%VGY,ALE%GRID%VGZ,VOLMIN
1348 CASE(1);WRITE (IOUT,5200) ALE%GRID%ALPHA,VOLMIN
1349 CASE(2);WRITE (IOUT,5300) DT_INPUT, ALE%GRID%ALPHA,ALE%GRID%GAMMA,ALE%GRID%VGX,ALE%GRID%VGY,VOLMIN
1350 CASE(3);WRITE (IOUT,5350)
1351 CASE(4);WRITE (IOUT,5351) ALE%GRID%ALPHA,ALE%GRID%GAMMA,ALE%GRID%VGX,ALE%GRID%VGY
1352 CASE(5);WRITE (IOUT,5353) ALE%GRID%ALPHA,NINT(ALE%GRID%VGX)
1353 CASE(6);WRITE (IOUT,5354)
1354 CASE(7);
1355 LABEL_DEF = ' no'
1356 IF(INT(ALE%GRID%VGX) == 1)LABEL_DEF = 'yes'
1357 LABEL_ROT = ' no'
1358 IF(INT(ALE%GRID%VGY) == 1)LABEL_ROT = 'yes'
1359 WRITE (IOUT,5355) LABEL_DEF,LABEL_ROT,ALE%GRID%ALPHA,ALE%GRID%GAMMA
1360 END SELECT
1361 ENDIF
1362
1363 IF(ALEFVM_Param%ISOLVER /= 0)ALEMUSCL_Param%IALEMUSCL=0 !muscl not compatible with FVM solver for int22
1364 CALL HM_OPTION_COUNT('/ale/muscl', NALEMUSCL)
1365 IF(ALE%UPWIND%UPWSM/=ONE)THEN
1366.OR. IF(NALEMUSCL>0 ALEMUSCL_Param%IALEMUSCL>0)THEN
1367 NALEMUSCL=0
1368 ALEMUSCL_Param%IALEMUSCL=0
1369 !ignore muscl & use upwsm3 (backward compatibility)
1370 !double check engine file with /ALE/MUSCL/OFF
1371 ENDIF
1372 ENDIF
1373
1374 IF(JALE+JEUL/=0)THEN
1375.AND. IF(ALEMUSCL_Param%IALEMUSCL == 1 JUPW/=0 ) THEN !eta3 + muscl(law51) : conflict
1376 CALL ANCMSG(MSGID=1564, MSGTYPE=MSGWARNING, ANMODE=ANINFO)
1377.OR. ELSEIF(ALEMUSCL_Param%IALEMUSCL == 0 JUPW/=0)THEN
1378 WRITE (IOUT,5360)ALE%UPWIND%UPWMG,ALE%UPWIND%UPWOG !,UPWSM
1379 END IF
1380.OR. IF (ALEMUSCL_Param%IALEMUSCL == 1 ALEMUSCL_Param%IALEMUSCL==2) THEN
1381 WRITE (IOUT, 5504) ALEMUSCL_Param%BETA,ALEMUSCL_Param%IALEMUSCL-1
1382 ENDIF
1383 ENDIF
1384
1385 WRITE (IOUT,'(//,a,i10)') TITRE(130)(1:57),NANALY
1386
1387! for print out
1388 IHBE_DS= DEFAULTS%SOLID%ISOLID
1389 ISST_DS= DEFAULTS%SOLID%ISMSTR
1390 ICPRE_D= DEFAULTS%SOLID%ICPRE
1391 ITET4_D= DEFAULTS%SOLID%ITETRA4
1392 ITET10_D= DEFAULTS%SOLID%ITETRA10
1393 IFRAME_DS = DEFAULTS%SOLID%IFRAME
1394 IMAS_DS= DEFAULTS%SOLID%IMAS
1395!
1396 IOFFSET_D= DEFAULTS%SHELL%ioffset !< offset support contact
1397 IHBE_D = DEFAULTS%SHELL%ishell
1398 ISH3N_D= DEFAULTS%SHELL%ish3n
1399 ISST_D = DEFAULTS%SHELL%ismstr
1400 IPLA_D = DEFAULTS%SHELL%iplas
1401 ITHK_D = DEFAULTS%SHELL%ithick
1402 IDRIL_D= DEFAULTS%SHELL%idrill
1403
1404 ICONTROL_D= DEFAULTS%SOLID%ICONTROL
1405 IF(N2D==0)THEN
1406.AND. IF(NUMELQ/=0. OR. (NUMELTG/=0N2D/=0) )THEN
1407 CALL ANCMSG(MSGID = 286,MSGTYPE = MSGERROR,ANMODE = ANINFO)
1408 ENDIF
1409 ENDIF
1410C 012
1411 WRITE(IOUT,5500)INTEG8,IPARITH,USER_WINDOWS%HAS_USER_WINDOW,IHBE_DS,
1412 . ITET4_D,ITET10_D,ISST_DS,ICPRE_D,IHBE_D,ISST_D,ITHK_D,
1413 . IPLA_D,ISTR_D,ISHEA_D,INSH,ISH3N_D, NPTS_D, IFRAME_DS,
1414 . IOFFSET_D,
1415 . ICONTROL_D
1416 WRITE(IOUT,5501)ISHFRAM
1417 IF(ISH3NFRAM>0)WRITE(IOUT,5901)ISH3NFRAM
1418.AND. IF(JALE/=0 ALEFVM_Param%IEnabled/=0)WRITE(IOUT,5502)ALEFVM_Param%ISOLVER
1419.AND. IF(JALE/=0 ALE%GLOBAL%ISFINT/=0) WRITE(IOUT,5503)ALE%GLOBAL%ISFINT
1420 WRITE(IOUT,5700)LAGM_TOL
1421 WRITE(IOUT,5800)IMAS_DS
1422.AND. IF ((NUMSPH>0)(NSPHSOL==0)) WRITE (IOUT,5600) SPASORT,LVOISPH,KVOISPH
1423.AND. IF ((NUMSPH>0)(NSPHSOL>0)) THEN
1424 IF (ITSOL2SPH==1) WRITE (IOUT,5610) SPASORT,LVOISPH,KVOISPH,ITSOL2SPH
1425 IF (ITSOL2SPH==2) WRITE (IOUT,5620) SPASORT,LVOISPH,KVOISPH,ITSOL2SPH
1426 ENDIF
1427C-------------------------------------------------------------------
1428 WRITE(IOUT,1000)
1429 IF(IEXPM==1) THEN
1430 ELSE IF(IMOT/=0) THEN
1431 WRITE(IOUT,*)'memory request not efficient on this computer'
1432 ENDIF
1433 IF(ICRAY<2) THEN
1434C
1435 IPCT=NINT(REEL*100)
1436c WRITE(IOUT,3000) LMA,LAM,IPCT
1437 ELSE IF(ICRAY==2) THEN
1438C MasPar Special
1439c WRITE(IOUT,3002) LMA,LAM
1440 ENDIF
1441
1442 IF(NTHREAD_S>1)THEN
1443 STR_NBTHREADS = 'threads'
1444 ELSE
1445 STR_NBTHREADS = 'thread'
1446 ENDIF
1447 IF(GOT_INSPIRE_ALM == 1)THEN
1448 WRITE(IOUT,4001) NTHREAD_S,STR_NBTHREADS,NSPMD,NTHREAD,IARCH,ARCHN(IARCH),NVSIZ
1449 ELSE
1450 WRITE(IOUT,4000) NTHREAD_S,STR_NBTHREADS,NSPMD,NTHREAD,IARCH,ARCHN(IARCH),NVSIZ
1451 ENDIF
1452C
1453.OR. IF(IGNORE_SPMD==1IGNORE_THREADS==1)THEN
1454 WRITE(IOUT,'(a)') ' '
1455 WRITE(IOUT,'(a)') ' info : number of spmd domain and threads defined in command line'
1456 WRITE(IOUT,'(a)') ' /spmd card PARAMETER are ignored'
1457 ENDIF
1458 IF(GOT_VARIABLE==1)THEN
1459 WRITE(IOUT,'(a)') ' '
1460 WRITE(IOUT,*) ' info : omp_num_threads set, default setting ignored'
1461 WRITE(IOUT,*)' '
1462 ENDIF
1463
1464 IF(OLD_RSB==1)THEN
1465 WRITE(IOUT,'(a)') ' '
1466 WRITE(IOUT,'(a)') ' info : /spmd option, dectyp=2 '
1467 WRITE(IOUT,'(a)') ' rsb domain decomposition deprecated, changing to default VALUE'
1468 ENDIF
1469
1470
1471 IF (USERL_AVAIL==1)THEN
1472 WRITE(IOUT,4500)
1473 IF(GOT_INSPIRE_ALM == 1)THEN
1474 WRITE(IOUT,4601) DLIBFILE(1:DLIBFILE_SIZE),DLIBTKVERS
1475 ELSE
1476 WRITE(IOUT,4600) DLIBFILE(1:DLIBFILE_SIZE),DLIBTKVERS
1477 ENDIF
1478 ENDIF
1479C
1480C--------------------------------------------------------------------
1481C DEALLOCATE
1482C--------------------------------------------------------------------
1483 IF(ALLOCATED(IXS)) DEALLOCATE(IXS)
1484 IF(ALLOCATED(IGEO)) DEALLOCATE(IGEO)
1485 IF(ALLOCATED(IPART))DEALLOCATE(IPART)
1486C--------------------------------------------------------------------
1487 1000 FORMAT(//
1488 & 4X,'speed parameters '/
1489 & 4X,'---------------- '/)
1490c 2000 FORMAT(
1491c & 4X,'MEMORY REQUESTED BY USER (KWORDS). . . . . . . . . .',I10)
1492c 3000 FORMAT(
1493c & 4X,'MEMORY AVAILABLE FOR INTEGERS . . . . . . . . . . . .',I10/
1494c & 4X,'MEMORY AVAILABLE FOR REALS. . . . . . . . . . . . . .',I10/
1495c & 4X,'PERCENTAGE OF MEMORY FOR REALS . . . . . . . . . . .',I10)
1496c 3002 FORMAT(
1497c & 4X,'MEMORY AVAILABLE FOR INTEGERS . . . . . . . . . . . .',I10/
1498c & 4X,'MEMORY AVAILABLE FOR REALS. . . . . . . . . . . . . .',I10)
1499 4000 FORMAT(
1500 & 4X,'starter running on. . . . . . . . . . . . . . . . . .',I10,
1501 . ' ',A20/
1502 & 4X,'number of spmd domains. . . . . . . . . . . . . . . .',I10/
1503 & 4X,'number of threads per domain. . . . . . . . . . . . .',I10/
1504 & 4X,'architecture optimization . . . . . . . . . . . . . .',I10,
1505 . ', ',A20/
1506 & 4X,'SIZE of element buffer. . . . . . . . . . . . . . . .',I10)
1507 4001 FORMAT(
1508 & 4X,'solver running on . . . . . . . . . . . . . . . . . .',I10,
1509 . ' ',A20/
1510 & 4X,'number of spmd domains. . . . . . . . . . . . . . . .',I10/
1511 & 4X,'number of threads per domain. . . . . . . . . . . . .',I10/
1512 & 4X,'architecture optimization . . . . . . . . . . . . . .',I10,
1513 . ', ',A20/
1514 & 4X,'SIZE of element buffer. . . . . . . . . . . . . . . .',I10)
1515
1516 4500 FORMAT(//
1517 & 4X,'EXTERNAL library for users code INTERFACE '/
1518 & 4X,'----------------------------------------- '/)
1519 4600 FORMAT(
1520 & 4X,'library name . . . . . . . . . . . . . . . . . . . . ',A/
1521 & 4X,'radioss users code INTERFACE version . . . . . . . .',I10)
1522 4601 FORMAT(
1523 & 4X,'library name . . . . . . . . . . . . . . . . . . . . ',A/
1524 & 4X,'solver users code INTERFACE version . . . . . . . . .',I10)
1525
1526
1527 5000 FORMAT(
1528 & ' nvolu: number of monitored volumes . . . . . . . . .',I10)
1529 5050 FORMAT(
1530 & ' nr2rlnk: number of EXTERNAL coupling links . . . . . ',I10)
1531 5051 FORMAT(
1532 & ' nactiv: number of element deactivation groups . . . .',I10)
1533 5052 FORMAT(
1534 & ' ndamp: number of rayleigh damping groups . . . . . .',I10)
1535 5053 FORMAT(
1536 & ' ngjoint: number of gear TYPE joints . . . . . . . . .',I10)
1537 5054 FORMAT(
1538 & ' nummpc: number of multi-point constraints . . . . . .',I10)
1539 5055 FORMAT(
1540 & ' nsubdom: number of subdomains . . . . . .. . . . . . ',I10)
1541 5100 FORMAT(/
1542 & 4X,'nwale : ale grid velocity formulation . . . . . . . .',I10)
1543 5199 FORMAT(//
1544 & 4X,'ale grid smoothing formulation'/
1545 & 4X,'------------------------------'/
1546 & 5X,'donea grid velocity computation method '//
1547 & 5X,'alpha : donea coefficient. . . . . . . . . . ',1PG20.13/
1548 & 5X,'gamma : grid velocity limitation factor. . . ',1pg20.13/
1549 & 5x,'FscaleX : X-GRID VELOCITY SCALE FACTOR . . . . ',1pg20.13/
1550 & 5x,'FscaleY : Y-GRID VELOCITY SCALE FACTOR . . . . ',1pg20.13/
1551 & 5x,'FscaleZ : Z-GRID VELOCITY SCALE FACTOR . . . . ',1pg20.13/
1552 & 5x,'VOLMIN : MINIMUM VOLUME FOR ELEMENT DELETION. ',1pg20.13)
1553 5200 FORMAT(//
1554 & 4x,'ALE GRID SMOOTHING FORMULATION'/
1555 & 4x,'------------------------------'/
1556 & 5x,'ALTAIR AVERAGE DISPLACEMENT GRID FORMULATION '//
1557 & 5x,'UMAX : MAXIMUM ABSOLUTE GRID VELOCITY . . . . ',1pg20.13/
1558 & 5x,'VMIN : MINIMUM VOLUME FOR ELEMENT DELETION. . ',1pg20.13)
1559 5300 FORMAT(//
1560 & 4x,'ALE GRID SMOOTHING FORMULATION'/
1561 & 4x,'------------------------------'/
1562 &5x,'ALTAIR SPRING METHOD FOR GRID VELOCITY COMPUTATION '//
1563 &5x,'dt0 : typical time step . . . . . . . . . . . . ',1PG20.13/
1564 &5X,'dt0* : effective time step. . . . . . . . . . . . ',1PG20.13/
1565 &5X,'gamma : non linearity factor . . . . . . . . . . . ',1PG20.13/
1566 &5X,'eta : damping coefficient . . . . . . . . . . . ',1PG20.13/
1567 &5X,'nu : shear factor . . . . . . . . . . . . . . . ',1PG20.13/
1568 &5X,'volmin: minimum volume for element deletion. . . . ',1PG20.13)
1569 5350 FORMAT(//
1570 & 4X,'ale grid smoothing formulation'/
1571 & 4X,'------------------------------'/
1572 & 5X,'grid velocity is not computed(quasi euler) ')
1573 5351 FORMAT(//
1574 & 4X,'ale grid smoothing formulation'/
1575 & 4X,'------------------------------'/
1576 & 5X,'altair standard method for grid velocity computation '//
1577 & 5X,'alpha : stability factor . . . . . . . . . . . . ',1PG20.13/
1578 & 5X,'gamma : non linearity factor . . . . . . . . . . ',1PG20.13/
1579 & 5X,'beta : damping coefficient. . . . . . . . . . . ',1PG20.13/
1580 & 5X,'lc : characteristic length. . . . . . . . . . ',1PG20.13)
1581 5353 FORMAT(//
1582 & 4X,'ale grid smoothing formulation'/
1583 & 4X,'------------------------------'/
1584 & 5X,'laplacian smoothing '//
1585 & 5X,'lambda:. . . . . . . . . . . . . . . . . . . . . ',1PG20.13/
1586 & 5X,'niter :. . . . . . . . . . . . . . . . . . . . . ',I10)
1587 5354 FORMAT(//
1588 & 4X,'ale grid smoothing formulation'/
1589 & 4X,'------------------------------'/
1590 & 5X,'volume smoothing ')
1591 5355 FORMAT(//
1592 & 4X,'ale grid smoothing formulation'/
1593 & 4X,'------------------------------'/
1594 & 5X,'flow-tracking(mass weighted averaged velocity)'//
1595 & 5X,'deformation enabled : . . . . . . . . . . . . . ',A3/
1596 & 5X,'rotation enabled : . . . . . . . . . . . . . . . ',A3/
1597 & 5X,'deformation scale factor : . . . . . . . . . . . ',1PG20.13/
1598 & 5X,'rotation scale factor: . . . . . . . . . . . . . ',1PG20.13/)
1599
1600
1601 5360 FORMAT(//
1602 & 4X,'ale upwind parameters'/
1603 & 4X,'---------------------'/
1604 & 5X,'upwind for momentum transport . . . . .=',1PG20.13/,
1605 & 5X,'upwind for other transport. . . . . . .=',1PG20.13/)
1606 5380 FORMAT(/
1607 & 4X,'caa fluid formulation activated')
1608 5400 FORMAT(
1609 & 4X,'alpha m + beta k damping'/,
1610 & 4X,'------------------------'/,
1611 . 4X,'node group id(=0 all nodes). . . . . . ',I5/,
1612 & 5X,'alpha . . . . . . . . . . . . . . . . .=',1PG20.13/,
1613 & 5X,'beta. . . . . . . . . . . . . . . . . .=',1PG20.13)
1614 5500 FORMAT(//4X,'analysis options'/
1615 & 4X,'----------------'//
1616 & 4X,'integ8 : 8 gauss point condensed integration . . . . .',I10/
1617 & 4X,'iparith: parallel arithmetic flag(2 off, 1 0n). . . .',I10/
1618 & 4X,'iuserw : general user window flag. . . . . . . . . . .',I10/
1619 & 4X,'isolid : default brick formulation flag. . . . . . . .',I10/
1620 & 4X,'itet4 : default tetra4 formulation flag . . . . . . .',I10/
1621 & 4X,'itet10 : default tetra10 formulation flag. . . . . . .',I10/
1622 & 4X,'ismstr : default brick small strain flag . . . . . . .',I10/
1623 & 4X,'icpre : default solid constant pressure flag. . . . .',I10/
1624 & 4X,'ishell : default shell formulation flag. . . . . . . .',I10/
1625 & 4X,'isst : default shell small strain flag . . . . . . .',I10/
1626 & 4X,'ithk : default shell thickness variation flag. . . .',I10/
1627 & 4X,'ipla : default plane stress plasticity flag. . . . .',I10/
1628 & 4X,'istr : default shell strain computation flag . . . .',I10/
1629 & 4X,'ishea : default shell shear computation flag. . . . .',I10/
1630 & 4X,'insh : shell inertia flag. . . . . . . . . . . . . .',I10/
1631 & 4X,'ish3n : default 3 node shell formulation flag . . . .',I10/
1632 & 4X,'npts : shell properties default number of ',/
1633 & 4X,' integration points or layers. . . . . . . . .',I10/
1634 & 4X,'iframe : default solid frame formulation flag . . . . ',I10/
1635 & 4X,'ioffset: default shell offset flag. . . . . . . . . . ',I10/
1636 & 4X,'icontrol:default solid distortion control flag. . . . ',I10)
1637 5501 FORMAT(
1638 & 4X,'ishfram: local shell frame definition. . . . . . . . .',I10)
1639 5502 FORMAT(
1640 & 4X,'ialefvm: fvm for ale momentum equation. . . . . . . .',I10)
1641 5503 FORMAT(
1642 & 4X,'isfint : internal forces formulation . . . . . . . . .',I10)
1643 5504 FORMAT(//
1644 & 4X,'muscl(monotonic upstream-centered scheme for conservation laws)'/
1645 & 4X,'----------------------------------------------------------------'/
1646 & 5X,'compression coefficient(beta). . . . . . . . . . . : ',1PG20.13/
1647 & 5X,'formulation flag(iflag). . . . . . . . . . . . . . : ',I10)
1648 5700 FORMAT(//
1649 & 4X,'lagrange multiplier options'/
1650 & 4X,'---------------------------'/
1651 & 4X,'lagm_tol:convergence criterion. . . . . . . . . . . .',
1652 & 1PG20.13)
1653 RETURN
1654 5600 FORMAT(//4X,'sph global parameters'/
1655 & 4X,'---------------------'//
1656 & 4x,'ALPHA SORT :SORTING SECURITY COEFFICIENT . . . . . .',
1657 & 1pg20.13/,
1658 & 4x,'LNEIGH :MAXIMUM NUMBER OF COMPUTED NEIGHBOURS. .',i10/,
1659 & 4x,'NNEIGH :MAXIMUM NUMBER OF STORED NEIGHBOURS. . .',i10)
1660 5610 FORMAT(//4x,'SPH GLOBAL PARAMETERS'/
1661 & 4x,'---------------------'//
1662 & 4x,'ALPHA SORT :SORTING SECURITY COEFFICIENT . . . . . .',
1663 & 1pg20.13/,
1664 & 4x,'LNEIGH :MAXIMUM NUMBER OF COMPUTED NEIGHBOURS. .',i10/,
1665 & 4x,'NNEIGH :MAXIMUM NUMBER OF STORED NEIGHBOURS. . .',i10/,
1666 & 4x,'ITSOL2SPH :SOL2SPH PARTICLES ACTIVATION TYPE. . . .',i10/,
1667 & 4x,'(SOL2SPH PARTICLES ACTIVATION BASED ON PARTS)')
1668 5620 FORMAT(//4x,'SPH GLOBAL PARAMETERS'/
1669 & 4x,'---------------------'//
1670 & 4x,'ALPHA SORT :SORTING SECURITY COEFFICIENT . . . . . .',
1671 & 1pg20.13/,
1672 & 4x,'LNEIGH :MAXIMUM NUMBER OF COMPUTED NEIGHBOURS. .',i10/,
1673 & 4x,'NNEIGH :MAXIMUM NUMBER OF STORED NEIGHBOURS. . .',i10/,
1674 & 4x,'ITSOL2SPH :SOL2SPH PARTICLES ACTIVATION TYPE. . . .',i10/,
1675 & 4x,'(SOL2SPH PARTICLES ACTIVATION BASED ON SUBSETS)')
1676 5800 FORMAT(
1677 & //4x,'NODAL MASS DISTRIBUTION FLAG . . . . . . . . .',i10)
1678 5901 FORMAT(
1679 & 4x,'ISH3NFRAM: OLD LOCAL SH3N FRAME ACTIVATION . . . . . .',i10)
1680 999 CALL freerr(1)
1681 RETURN
subroutine contrbe3(icr, lsubmodel)
Definition contrbe3.F:36
#define my_real
Definition cppsort.cpp:32
subroutine damping(nodft, nodlt, v, vr, a, ar, damp, ms, in, igrnod, dim, itask, weight, tagslv_rby, wfext)
Definition damping.F:882
#define alpha
Definition eval.h:35
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
subroutine hm_option_count(entity_type, hm_option_number)
subroutine hm_option_next()
subroutine hm_option_start(entity_type)
subroutine hm_preread_properties(igeo, nsphsol, nply, nsub, nisub, lsubmodel, defaults)
subroutine hm_read_ale_grid(dt_input, alpha, gamma, vgx, vgy, vgz, volmin, lsubmodel, unitab)
subroutine hm_read_ale_muscl(lsubmodel, unitab)
subroutine hm_read_ale_solver(lsubmodel, unitab, icaa, isfint)
subroutine hm_read_inista(s0file, isigi, ioutp_fmt, irootyy_r, lsubmodel)
subroutine hm_preread_part(ipart, igeo, lsubmodel)
subroutine contrbe2(icr, lsubmodel)
subroutine hm_read_refsta(lsubmodel, xrfile)
subroutine hm_prelce16s(ipart, igeo, ixs, nsphsol, lsubmodel, is_dyna)
subroutine hm_read_sphglo(lsubmodel)
subroutine hm_read_upwind(jupw, eta1, eta2, eta3, lsubmodel, unitab)
#define min(a, b)
Definition macros.h:20
initmumps id
for(i8=*sizetab-1;i8 >=0;i8--)
integer nebcs
type(ale_) ale
Definition ale_mod.F:249
type(alefvm_param_), target alefvm_param
Definition alefvm_mod.F:121
type(alemuscl_param_) alemuscl_param
integer num_inivol
Definition inivol_mod.F:85
integer infile_name_len
character(len=infile_char_len) infile_name
integer, parameter ncharline
logical is_refsta
Definition refsta_mod.F:37
integer, dimension(:), allocatable, target ixs
Definition restart_mod.F:60
integer, dimension(:), pointer iframe
type(unit_type_) unitab
integer, dimension(:), allocatable, target ipart
Definition restart_mod.F:60
integer, dimension(:), allocatable igeo
Definition restart_mod.F:83
integer nsets
Definition setdef_mod.F:120
subroutine nbsph(lsubmodel)
Definition nbsph.F:39
program radioss
Definition radioss.F:34
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
subroutine freerr(it)
Definition freform.F:506
integer function istr(str)
Definition istr.F:31
program starter
Definition starter.F:39
subroutine static(v, vr, a, ar, ms, in, igrnod, weight_md, wfext)
Definition static.F:33
subroutine upwind(rho, vis, vdx, vdy, vdz, r, s, t, deltax, gam, nel)
Definition upwind.F:35

◆ find_dt1brick_engine()

subroutine find_dt1brick_engine

Definition at line 1692 of file contrl.F.

1693C-----------------------------------------------
1694C M o d u l e s
1695C-----------------------------------------------
1696 USE message_mod
1697 USE inoutfile_mod
1698C-----------------------------------------------
1699C I m p l i c i t T y p e s
1700C-----------------------------------------------
1701#include "implicit_f.inc"
1702C-----------------------------------------------
1703C C o m m o n B l o c k s
1704C-----------------------------------------------
1705#include "com04_c.inc"
1706#include "scr15_c.inc"
1707#include "scr17_c.inc"
1708C-----------------------------------------------
1709C L o c a l V a r i a b l e s
1710C-----------------------------------------------
1711 INTEGER IO_ERR1, NITER
1712 CHARACTER FILNAM*109, KEYA*80, KEYA2*80
1713
1714 INTEGER :: LEN_TMP_NAME
1715 CHARACTER(len=4096) :: TMP_NAME
1716C-----------------------------------------------
1717 io_err1=0
1718 idttsh=0
1719C-----------------------------------------------
1720C Lecture des donnees dans le fichier engine
1721C { Reading data from the engine file }
1722C-----------------------------------------------
1723 filnam=rootnam(1:rootlen)//'_0001.rad'
1724
1725 tmp_name=infile_name(1:infile_name_len)//filnam(1:rootlen+9)
1726 len_tmp_name = infile_name_len+rootlen+9
1727 OPEN(unit=71,file=tmp_name(1:len_tmp_name),
1728 . access='SEQUENTIAL',status='OLD',iostat=io_err1)
1729C
1730 IF (io_err1/=0) THEN
1731 filnam=rootnam(1:rootlen)//'D01'
1732 tmp_name=infile_name(1:infile_name_len)//filnam(1:rootlen+3)
1733 len_tmp_name = infile_name_len+rootlen+3
1734 OPEN(unit=71,file=tmp_name(1:len_tmp_name),
1735 . access='SEQUENTIAL',status='OLD',iostat=io_err1)
1736 ENDIF
1737
1738 IF (io_err1==0) THEN
1739C
1740 10 READ(71,'(A)',END=20) keya
1741C
1742 IF(keya(1:10)=='/DT1/BRICK') THEN
1743 idt1sol=1
1744 ELSEIF(keya(1:9)=='/DT1TET10') THEN
1745 niter=0
1746 READ(keya(11:20),'(I10)',err=30) niter
1747 30 CONTINUE
1748 IF(niter == 0)niter=1
1749 idt1tet10=niter+1
1750 ELSEIF(keya(1:6)=='/DTTSH') THEN
1751 idttsh=1
1752 ENDIF
1753C
1754 GOTO 10
1755C
1756 20 CONTINUE
1757
1758 CLOSE(71)
1759C
1760 ELSE
1761C
1762 IF(numtetra4/=0) CALL ancmsg(msgid=1589,
1763 . msgtype=msgwarning,
1764 . anmode=aninfo_blind_2,
1765 . c1=rootnam(1:rootlen)//'_0001.rad',
1766 . c2=rootnam(1:rootlen)//'D01')
1767C
1768 IF(numels10/=0) CALL ancmsg(msgid=1606,
1769 . msgtype=msgwarning,
1770 . anmode=aninfo_blind_2,
1771 . c1=rootnam(1:rootlen)//'_0001.rad',
1772 . c2=rootnam(1:rootlen)//'D01')
1773C
1774 ENDIF
1775C-------------------------------------------
1776 RETURN

◆ ini_h3dtmax_engine()

subroutine ini_h3dtmax_engine ( integer, dimension(nparg,ngroup), intent(in) iparg,
integer, dimension(lipart1,npart), intent(in) ipart,
integer, dimension(numels), intent(in) iparts,
integer, dimension(numelc), intent(in) ipartc,
integer, dimension(numeltg), intent(in) ipartg,
integer, intent(in) iddlevel )

Definition at line 1787 of file contrl.F.

1788C-----------------------------------------------
1789C M o d u l e s
1790C-----------------------------------------------
1791 USE message_mod
1792 USE inoutfile_mod
1793 USE outmax_mod
1794 USE names_and_titles_mod , ONLY : ncharline
1795C-----------------------------------------------
1796C I m p l i c i t T y p e s
1797C-----------------------------------------------
1798#include "implicit_f.inc"
1799C-----------------------------------------------
1800C C o m m o n B l o c k s
1801C-----------------------------------------------
1802#include "com01_c.inc"
1803#include "com04_c.inc"
1804#include "scr15_c.inc"
1805#include "scr17_c.inc"
1806#include "param_c.inc"
1807C-----------------------------------------------
1808C D u m m y A r g u m e n t s
1809C-----------------------------------------------
1810 INTEGER ,INTENT(IN) :: IDDLEVEL
1811 INTEGER, DIMENSION(NPARG,NGROUP) ,INTENT(IN):: IPARG
1812 INTEGER ,DIMENSION(LIPART1,NPART),INTENT(IN):: IPART
1813 INTEGER ,DIMENSION(NUMELS),INTENT(IN):: IPARTS
1814 INTEGER ,DIMENSION(NUMELC),INTENT(IN):: IPARTC
1815 INTEGER ,DIMENSION(NUMELTG),INTENT(IN):: IPARTG
1816C-----------------------------------------------
1817C L o c a l V a r i a b l e s
1818C-----------------------------------------------
1819 INTEGER I, J, K, N ,NELC , NELTG , IP , NPRT , IPRT
1820 INTEGER IH3D,NG,ITY,NFT,IKEY,K_LEN
1821
1822 INTEGER :: TMAX_IPART(NPART),NKPART(NPART+1,NKEYMAX+1)
1823 CHARACTER(LEN=NCHARLINE) :: CARTE
1824C-----------------------------------------------
1825 IF (ALLOCATED(ikeymax)) DEALLOCATE(ikeymax)
1826 IF (ALLOCATED(ipart_ok)) DEALLOCATE(ipart_ok)
1827 ALLOCATE(ikeymax(nkeymax),ipart_ok(ngroup,nkeymax))
1828 ikeymax =0
1829 ipart_ok = 0
1830 lmax_dis = 0
1831 lmax_vel = 0
1832 lmax_nsig = 0
1833 lmax_nstra = 0
1834 nkpart(1:npart+1,1:nkeymax+1) = 0
1835C-----------------------------------------------
1836C Lecture des donnees dans le fichier engine
1837C { Reading data from the engine file }
1838C-----------------------------------------------
1839 ih3d=1
1840 k_len = 19
1841 carte(1:k_len) = '/H3D/ELEM/VONM/TMAX'
1842 CALL read_h3dtmax_key(carte,k_len,ikey,nkpart(1,ih3d),ipart)
1843 IF (ikey >0) THEN
1844 ikeymax(ih3d) = 1
1845 ELSE
1846 k_len = 20
1847 carte(1:k_len) = '/H3D/SOLID/VONM/TMAX'
1848 CALL read_h3dtmax_key(carte,k_len,ikey,nkpart(1,ih3d),ipart)
1849 IF (ikey >0) ikeymax(ih3d) = 1
1850 carte(1:k_len) = '/h3d/shell/vonm/tmax'
1851 CALL READ_H3DTMAX_KEY(CARTE,K_LEN,IKEY,NKPART(1,IH3D),IPART)
1852 IF (IKEY >0) IKEYMAX(IH3D) = 1
1853 END IF
1854 IH3D=2
1855 K_LEN = 20
1856 CARTE(1:K_LEN) = '/h3d/elem/sigeq/tmax'
1857 CALL READ_H3DTMAX_KEY(CARTE,K_LEN,IKEY,NKPART(1,IH3D),IPART)
1858 IF (IKEY >0) THEN
1859 IKEYMAX(IH3D) = 1
1860 ELSE
1861 K_LEN = 21
1862 CARTE(1:K_LEN) = '/h3d/solid/sigeq/tmax'
1863 CALL READ_H3DTMAX_KEY(CARTE,K_LEN,IKEY,NKPART(1,IH3D),IPART)
1864 IF (IKEY >0) IKEYMAX(IH3D) = 1
1865 CARTE(1:K_LEN) = '/h3d/shell/sigeq/tmax'
1866 CALL READ_H3DTMAX_KEY(CARTE,K_LEN,IKEY,NKPART(1,IH3D),IPART)
1867 IF (IKEY >0) IKEYMAX(IH3D) = 1
1868 END IF
1869 IH3D=3
1870 K_LEN = 19
1871 CARTE(1:K_LEN) = '/h3d/elem/ener/tmax'
1872 CALL READ_H3DTMAX_KEY(CARTE,K_LEN,IKEY,NKPART(1,IH3D),IPART)
1873 IF (IKEY >0) THEN
1874 IKEYMAX(IH3D) = 1
1875 ELSE
1876 K_LEN = 20
1877 CARTE(1:K_LEN) = '/h3d/solid/ener/tmax'
1878 CALL READ_H3DTMAX_KEY(CARTE,K_LEN,IKEY,NKPART(1,IH3D),IPART)
1879 IF (IKEY >0) IKEYMAX(IH3D) = 1
1880 CARTE(1:K_LEN) = '/h3d/shell/ener/tmax'
1881 CALL READ_H3DTMAX_KEY(CARTE,K_LEN,IKEY,NKPART(1,IH3D),IPART)
1882 IF (IKEY >0) IKEYMAX(IH3D) = 1
1883 END IF
1884 IH3D=4
1885 K_LEN = 19
1886 CARTE(1:K_LEN) = '/h3d/elem/dama/tmax'
1887 CALL READ_H3DTMAX_KEY(CARTE,K_LEN,IKEY,NKPART(1,IH3D),IPART)
1888 IF (IKEY >0) THEN
1889 IKEYMAX(IH3D) = 1
1890 ELSE
1891 K_LEN = 20
1892 CARTE(1:K_LEN) = '/h3d/solid/dama/tmax'
1893 CALL READ_H3DTMAX_KEY(CARTE,K_LEN,IKEY,NKPART(1,IH3D),IPART)
1894 IF (IKEY >0) IKEYMAX(IH3D) = 1
1895 CARTE(1:K_LEN) = '/h3d/shell/dama/tmax'
1896 CALL READ_H3DTMAX_KEY(CARTE,K_LEN,IKEY,NKPART(1,IH3D),IPART)
1897 IF (IKEY >0) IKEYMAX(IH3D) = 1
1898 END IF
1899 IH3D=5
1900 K_LEN = 26
1901 CARTE(1:K_LEN) = '/h3d/elem/tens/stress/tmax'
1902 CALL READ_H3DTMAX_KEY(CARTE,K_LEN,IKEY,NKPART(1,IH3D),IPART)
1903 IF (IKEY >0) THEN
1904 IKEYMAX(IH3D) = 1
1905 ELSE
1906 K_LEN = 27
1907 CARTE(1:K_LEN) = '/h3d/solid/tens/stress/tmax'
1908 CALL READ_H3DTMAX_KEY(CARTE,K_LEN,IKEY,NKPART(1,IH3D),IPART)
1909 IF (IKEY >0) IKEYMAX(IH3D) = 1
1910 CARTE(1:K_LEN) = '/h3d/shell/tens/stress/tmax'
1911 CALL READ_H3DTMAX_KEY(CARTE,K_LEN,IKEY,NKPART(1,IH3D),IPART)
1912 IF (IKEY >0) IKEYMAX(IH3D) = 1
1913 END IF
1914 IH3D=6
1915 K_LEN = 26
1916 CARTE(1:K_LEN) = '/h3d/elem/tens/strain/tmax'
1917 CALL READ_H3DTMAX_KEY(CARTE,K_LEN,IKEY,NKPART(1,IH3D),IPART)
1918 IF (IKEY >0) THEN
1919 IKEYMAX(IH3D) = 1
1920 ELSE
1921 K_LEN = 27
1922 CARTE(1:K_LEN) = '/h3d/solid/tens/strain/tmax'
1923 CALL READ_H3DTMAX_KEY(CARTE,K_LEN,IKEY,NKPART(1,IH3D),IPART)
1924 IF (IKEY >0) IKEYMAX(IH3D) = 1
1925 CARTE(1:K_LEN) = '/h3d/shell/tens/strain/tmax'
1926 CALL READ_H3DTMAX_KEY(CARTE,K_LEN,IKEY,NKPART(1,IH3D),IPART)
1927 IF (IKEY >0) IKEYMAX(IH3D) = 1
1928 END IF
1929 IH3D=7 ! NKEYMAX+1
1930 K_LEN = 9
1931 CARTE(1:K_LEN) = '/h3d/part'
1932 CALL READ_H3DTMAX_KEY(CARTE,K_LEN,IKEY,NKPART(1,IH3D),IPART)
1933 IF (IKEY == 0 ) NKPART(1:NPART,IH3D)=1
1934 IH3D=8
1935 K_LEN =18
1936 CARTE(1:K_LEN) = '/h3d/noda/dis/tmax'
1937 CALL READ_H3DTMAX_KEY(CARTE,K_LEN,IKEY,TMAX_IPART,IPART)
1938 IF (IKEY > 0 ) LMAX_DIS = 3
1939 IH3D=9
1940 K_LEN =18
1941 CARTE(1:K_LEN) = '/h3d/noda/vel/tmax'
1942 CALL READ_H3DTMAX_KEY(CARTE,K_LEN,IKEY,TMAX_IPART,IPART)
1943 IF (IKEY > 0 ) LMAX_VEL = 3
1944 IH3D=10
1945 K_LEN =18
1946 CARTE(1:K_LEN) = '/h3d/noda/gps/tmax'
1947 CALL READ_H3DTMAX_KEY(CARTE,K_LEN,IKEY,TMAX_IPART,IPART)
1948 IF (IKEY > 0 ) LMAX_NSIG = 6
1949 IH3D=11
1950 K_LEN =23
1951 CARTE(1:K_LEN) = '/h3d/noda/gpstrain/tmax'
1952 CALL READ_H3DTMAX_KEY(CARTE,K_LEN,IKEY,TMAX_IPART,IPART)
1953 IF (IKEY > 0 ) LMAX_NSTRA = 6
1954C
1955 IH3D = 0
1956 DO I=1,NKEYMAX
1957 IH3D = IH3D + IKEYMAX(I)
1958 END DO
1959 IF (IH3D>0) THEN
1960 DO I=1,NKEYMAX
1961 NKPART(1:NPART,I)=NKPART(1:NPART,NKEYMAX+1)*NKPART(1:NPART,I)
1962 END DO
1963C
1964 DO NG=1,NGROUP
1965 NFT=IPARG(3,NG)+1
1966 ITY=IPARG(5,NG)
1967C
1968 IPRT = 0
1969 SELECT CASE (ITY)
1970 CASE(1)
1971 IPRT = IPARTS(NFT)
1972 CASE(3)
1973 IPRT = IPARTC(NFT)
1974 CASE(7)
1975 IPRT = IPARTG(NFT)
1976 END SELECT
1977 IF(IPRT>0) IPART_OK(NG,1:NKEYMAX) = NKPART(IPRT,1:NKEYMAX)
1978 END DO
1979 END IF
1980C-------------------------------------------
1981 RETURN
subroutine read_h3dtmax_key(key_tm, key_len, ifund, ntm_part, ipart)
Definition contrl.F:1991
integer, dimension(:,:), allocatable ipart_ok
Definition outmax_mod.F:72
integer lmax_vel
Definition outmax_mod.F:61
integer lmax_nstra
Definition outmax_mod.F:63
integer lmax_dis
Definition outmax_mod.F:60
integer lmax_nsig
Definition outmax_mod.F:62
integer, dimension(:), allocatable ikeymax
Definition outmax_mod.F:71
integer nkeymax
Definition outmax_mod.F:65

◆ read_h3dtmax_key()

subroutine read_h3dtmax_key ( character(len=key_len) key_tm,
integer, intent(in) key_len,
integer, intent(out) ifund,
integer, dimension(npart), intent(inout) ntm_part,
integer, dimension(lipart1,npart), intent(in) ipart )

Definition at line 1990 of file contrl.F.

1991C-----------------------------------------------
1992C M o d u l e s
1993C-----------------------------------------------
1994 USE message_mod
1995 USE inoutfile_mod
1996 USE names_and_titles_mod , ONLY : ncharline
1997C-----------------------------------------------
1998C I m p l i c i t T y p e s
1999C-----------------------------------------------
2000#include "implicit_f.inc"
2001C-----------------------------------------------
2002C C o m m o n B l o c k s
2003C-----------------------------------------------
2004#include "com01_c.inc"
2005#include "com04_c.inc"
2006#include "scr15_c.inc"
2007#include "scr17_c.inc"
2008#include "param_c.inc"
2009C-----------------------------------------------
2010C D u m m y A r g u m e n t s
2011C-----------------------------------------------
2012 INTEGER, INTENT(IN):: KEY_LEN
2013 CHARACTER(len=KEY_LEN) :: KEY_TM
2014 INTEGER ,DIMENSION(LIPART1,NPART),INTENT(IN):: IPART
2015 INTEGER, INTENT(OUT):: IFUND
2016 INTEGER ,DIMENSION(NPART),INTENT(INOUT):: NTM_PART
2017C-----------------------------------------------
2018C L o c a l V a r i a b l e s
2019C-----------------------------------------------
2020 INTEGER I, J, K, N ,NELC , NELTG , IP , NPRT , IPRT
2021 INTEGER IH3D,NG,ITY,NFT,IO_ERR1,LEN_C,IC
2022 CHARACTER FILNAM*109, KEYA*80, KEYA2*80
2023 CHARACTER(LEN=NCHARLINE) :: CARTE
2024
2025 INTEGER :: LEN_TMP_NAME,TMAX_IPART(NPART)
2026 CHARACTER(len=4096) :: TMP_NAME
2027C-----------------------------------------------
2028 ifund=0
2029 io_err1 = 0
2030 nprt = 0
2031C-----------------------------------------------
2032C Lecture des donnees dans le fichier engine
2033C-----------------------------------------------
2034 filnam=rootnam(1:rootlen)//'_0001.rad'
2035
2036 tmp_name=infile_name(1:infile_name_len)//filnam(1:rootlen+9)
2037 len_tmp_name = infile_name_len+rootlen+9
2038 OPEN(unit=71,file=tmp_name(1:len_tmp_name),
2039 . access='SEQUENTIAL',status='OLD',iostat=io_err1)
2040
2041 DO WHILE (io_err1 == 0 .AND. ifund==0)
2042C
2043 READ(71,fmt='(A)',END=20) keya
2044 IF(keya(1:key_len) == key_tm ) THEN
2045C---- read ipart_id if there are
2046 ifund = 1
2047 ic = 1
2048 nprt = npart
2049 DO WHILE(ic == 1)
2050 READ(71,fmt='(A)',err=20,END=20) carte
2051 IF(carte(1:1) == '#' .OR. carte(1:1) == '$') cycle
2052 ic = 0
2053 len_c = len_trim(carte)
2054 IF(carte(len_c:len_c)==char(13)) len_c = len_c - 1
2055 IF (carte(1:1) == '/' .OR. len_c==0) THEN
2056 ELSE
2057 j=1
2058 nprt = 0
2059 DO WHILE(carte(1:1) /= '/' .AND. carte(1:1) /= '#' .AND.
2060 . carte(1:1) /= '$' .AND. len_c /= 0)
2061 DO WHILE (j <= len_c)
2062 IF(carte(j:j) /= ' ') THEN
2063 k=j
2064 DO WHILE(carte(k:k) /= ' ' .AND. k < len_c)
2065 k=k+1
2066 ENDDO
2067 nprt = nprt + 1
2068 READ(carte(j:k),'(I10)') iprt
2069 tmax_ipart(nprt) = iprt
2070 j = k
2071 ENDIF
2072 j = j +1
2073 END DO
2074 READ(71,fmt='(A)',err=20,END=20) carte
2075 len_c = len_trim(carte)
2076 IF(carte(len_c:len_c)==char(13)) len_c = len_c - 1
2077 END DO
2078 IF (nprt==0) THEN
2079 nprt = npart
2080 ntm_part(1:nprt) = 1
2081 END IF
2082 END IF
2083 END DO !(IC == 1) remove comments
2084 END IF
2085C
2086 END DO
2087C
2088 20 CONTINUE
2089
2090 CLOSE(71)
2091C
2092 IF (ifund>0 .AND. (nprt == npart .OR.nprt ==0)) THEN
2093 ntm_part(1:nprt) = 1
2094 ELSEIF (ifund>0) THEN
2095 DO i=1,nprt
2096 ip=0
2097 iprt = tmax_ipart(i)
2098 DO j=1,npart
2099 IF(ipart(4,j)==iprt)ip=j
2100 END DO
2101 IF (ip > 0) ntm_part(ip)=1
2102 ip = 0
2103 DO j=1,npart
2104 ip = ip +ntm_part(j)
2105 END DO
2106 IF (ip==0) ntm_part(1:npart) = 1
2107 ENDDO
2108 END IF
2109C-------------------------------------------
2110 RETURN
subroutine tmax_ipart(iparg, ipart, iparts, ipartc, ipartg, h3d_data)
Definition tmax_ipart.F:34