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"
#include "scr17_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 82 of file contrl.F.

84C----------------------------------------------------------
85C M o d u l e s
86C-----------------------------------------------
87 USE message_mod
88 USE multi_fvm_mod
89 USE submodel_mod
90 USE pinchtype_mod
91 USE hm_option_read_mod
92 USE check_mod
93 USE inoutfile_mod
94 USE setdef_mod
95 USE detonators_mod
96 USE inivol_def_mod , ONLY : num_inivol
97 USE refsta_mod
98 USE ale_ebcs_mod
99 USE restmod
100 USE grp_size_mod
101 USE output_mod
102 USE alemuscl_mod , only:alemuscl_param
103 USE alefvm_mod , only:alefvm_param
104 USE user_windows_mod
105 USE ale_mod
106 USE mat_elem_mod
107 USE names_and_titles_mod
108 USE bcs_mod , only : bcs
109 USE defaults_mod
110 USE format_mod
111 use glob_therm_mod
112 USE pblast_mod
113 USE output_mod , ONLY : output_
114 use ascii_encoding_mu_letter_mod, only : ascii_encoding_mu_letter
115 USE eos_param_mod , ONLY : analy_temp
116 use element_mod , only : nixs
117C-----------------------------------------------
118C I m p l i c i t T y p e s
119C-----------------------------------------------
120#include "implicit_f.inc"
121C-----------------------------------------------
122C G l o b a l P a r a m e t e r s
123C-----------------------------------------------
124#include "mvsiz_p.inc"
125C-----------------------------------------------
126C C o m m o n B l o c k s
127C-----------------------------------------------
128#include "units_c.inc"
129#include "warn_c.inc"
130#include "com01_c.inc"
131#include "com04_c.inc"
132#include "com06_c.inc"
133#include "com08_c.inc"
134#include "com09_c.inc"
135#include "com10_c.inc"
136#include "com_xfem1.inc"
137#include "intstamp_c.inc"
138#include "random_c.inc"
139#include "scr03_c.inc"
140#include "scr05_c.inc"
141#include "scr06_c.inc"
142#include "scr10_c.inc"
143#include "scr12_c.inc"
144#include "scr15_c.inc"
145#include "scr16_c.inc"
146#include "scr22_c.inc"
147#include "scr23_c.inc"
148#include "titr_c.inc"
149#include "param_c.inc"
150#include "sphcom.inc"
151#include "lagmult.inc"
152#include "fxbcom.inc"
153#include "scr14_c.inc"
154#include "remesh_c.inc"
155#include "sysunit.inc"
156#include "commandline.inc"
157#include "r2r_c.inc"
158#include "userlib.inc"
159#include "spmd_c.inc"
160#include "drape_c.inc"
161#include "inter22.inc"
162#include "boltpr_c.inc"
163#include "ige3d_c.inc"
164#include "com_engcards_c.inc"
165#include "sms_c.inc"
166C-----------------------------------------------
167C D u m m y A r g u m e n t s
168C-----------------------------------------------
169 TYPE(MULTI_FVM_STRUCT), INTENT(IN) :: MULTI_FVM
170 TYPE(SUBMODEL_DATA) LSUBMODEL(NSUBMOD)
171 INTEGER,INTENT(IN)::IS_DYNA
172 TYPE(DETONATORS_STRUCT_) :: DETONATORS
173 TYPE(USER_WINDOWS_), INTENT(INOUT) :: USER_WINDOWS
174 TYPE(MAT_ELEM_), INTENT(INOUT) :: MAT_ELEM
175 TYPE(NAMES_AND_TITLES_),INTENT(INOUT) :: NAMES_AND_TITLES !< NAMES_AND_TITLES host the input deck names and titles for outputs
176 INTEGER,INTENT(IN) :: LIPART1 !< Number of variables of IPART
177 TYPE(DEFAULTS_), INTENT(INOUT) :: DEFAULTS !< Defaults mod
178 type (glob_therm_) ,intent(inout) :: glob_therm
179 TYPE(PBLAST_), INTENT(INOUT) :: PBLAST !< PBLAST load type
180 TYPE(OUTPUT_),INTENT(INOUT) :: OUTPUT
181C-----------------------------------------------
182C L o c a l V a r i a b l e s
183C-----------------------------------------------
184 INTEGER I, J, N, ISFIL, IPCT, IBID,INSH,
185 . IHBE_DD,IPARITH,JALE,JEUL,
186 . IUN,NSHFRAM,JUPW,IMAT,IG,ISH3N_DD,IFRAME_DDS,
187 . IPLA_DDS,NPTS_DD,UID,IHBE,ISMSTR,IPLAS,ICPRE,ICSTR,NPT,
188 . ISROT,L1,NPTS, NIMPDISP,NIMPVEL,NIMPACC,ICR,
189 . STAT,IERROR,ID,IDX,IDY,IDZ,NCTRL,BID,NSH3NFRAM,NS17_OLD,
190 . IGNORE_SPMD,IGNORE_THREADS,GOT_VARIABLE,KROT,OLD_RSB,
191 . NRAFX,NRAFY,NRAFZ,NFUNCT0,NTABLE0,NTABLE1,NSENSOR,
192 . IRFE,IRFL, HM_NINTER_DEF,NB_AMS,NUMNUSR,NPERTURB_HM,ICR3,
193 . NPYFUN
194 INTEGER IARCHS(8)
195 INTEGER IS_BEGIN,SCHAR
196 INTEGER :: NPROP,NALEMAT,NEULERMAT
197 INTEGER IHBE_DS,ISST_DS,IPLA_DS,IFRAME_DS,ITET4_D,ITET10_D,ICPRE_D,IMAS_DS,ICONTROL_D,
198 . IHBE_D,IPLA_D,ISTR_D,ITHK_D,ISHEA_D,ISST_D,
199 . ISH3N_D, ISTRA_D,NPTS_D,IDRIL_D,IOFFSET_D,DEF_INTER(100)
200 my_real dtini, dtx ,rbid
201 CHARACTER (LEN=NCHARLINE) :: CART
202 CHARACTER (LEN=NCHARLINE) :: XRFILE ! NCHARLINE as #define is set to 500 in Starter
203 CHARACTER (LEN=NCHARLINE) :: KEY
204 CHARACTER (LEN=NCHARLINE) :: KEY2
205 CHARACTER (LEN=NCHARLINE) :: TMPLINE
206 CHARACTER (LEN=NCHARLINE) :: LINE
207 CHARACTER (LEN=NCHARTITLE) :: TITR
208 CHARACTER (LEN=255) :: STR_NBTHREADS
209 CHARACTER MESS*40, ERRMSG*40
210 CHARACTER*3 :: LABEL_DEF,LABEL_ROT
211C-----------------------------------------------
212C OpenMP specific
213#if defined(_OPENMP)
214 INTEGER OMP_GET_THREAD_NUM, OMP_GET_NUM_THREADS,NTHREAD1
215 EXTERNAL omp_get_thread_num, omp_get_num_threads
216 CHARACTER (LEN=255) :: STR
217#endif
218 INTEGER NTHREAD_S
219 my_real :: dt_input
220C
221 INTEGER , DIMENSION(:), ALLOCATABLE :: NPLY,NSUB,NISUB
222
223 INTEGER :: NITER,IFORM
224
225 INTEGER :: LEN_TMP_NAME
226 CHARACTER(len=4096) :: TMP_NAME
227 LOGICAL :: IS_AVAILABLE
228 INTEGER :: NUMTITLE, NGRTRIA, IDUMMY, NANIM_VERS
229 INTEGER :: NALEMUSCL
230 INTEGER :: NB_INISHE,NB_INISH3,NB_INIBRI,NB_INIQUAD,
231 . NB_INIBEAM,NB_INITRUSS,NB_INISPRIG,NB_INISPHCEL
232 INTEGER :: LEN_LINE
233 CHARACTER*20 UNIT_NAME
234 INTEGER IS_U_STRING
235C-----------------------------------------------
236C E x t e r n a l F u n c t i o n
237C-----------------------------------------------
238 INTEGER NBCS_LAGM
239 EXTERNAL nbcs_lagm
240C-----------------------------------------------
241C data
242C-----------------------------------------------
243 DATA s0file/' '/
244 DATA xrfile/' '/
245 DATA iun/1/
246
247C-----------------------------------------------
248C S o u r c e L i n e s
249C-----------------------------------------------
250
251C=======================================================================
252C Read title
253C=======================================================================
254 CALL hm_option_count('/TITLE', numtitle)
255 IF (numtitle > 0) THEN
256 CALL hm_option_start('/TITLE')
257 CALL hm_option_read_key(lsubmodel, option_titr = line)
258 CALL hm_get_string('MY_TITLE', line, ncharline, is_available)
259 ELSE
260 line = ' '
261 ENDIF
262! Standard output
263 WRITE(istdo,'(A)') line(1:len_trim(line))
264
265 ! Store the input deck title in Structure
266 len_line= min(len_trim(line),ltitle) ! Truncate to LTITLE
267 names_and_titles%TITLE(1:len_line)=line(1:len_line)
268
269 imot=0
270 reel=zep66
271C=======================================================================
272C UNIT SYSTEM READER
273C First option to be read in order to convert other options.
274C=======================================================================
275 WRITE(istdo,'(A)')titre(12)
276 CALL hm_option_count('/UNIT',nunit0)
277 unitab%NUNIT0 = nunit0
278c
279 CALL hm_option_count('/BEGIN',is_begin)
280
281 schar = 20
282 IF (is_begin /= 0) THEN
283 CALL hm_option_start('/BEGIN')
284 CALL hm_option_next()
285
286 CALL hm_get_intv('INVERS', invers, is_available, lsubmodel)
287 invers_src = invers
288 invers_init = invers
289
290 CALL hm_get_string('length_inputunit_code',keyli,schar,is_available)
291 CALL hm_get_string('mass_inputunit_code',keymi,schar,is_available)
292 CALL hm_get_string('time_inputunit_code',keyti,schar,is_available)
293 CALL hm_get_string('length_workunit_code',keyl,schar,is_available)
294 CALL hm_get_string('mass_workunit_code',keym,schar,is_available)
295 CALL hm_get_string('time_workunit_code',keyt,schar,is_available)
296
297 !convert into ascci format specific encoding of greek letter \mu
298 CALL ascii_encoding_mu_letter(keyli, keymi, keyti, keyl, keym, keyt)
299
300 IF(invers <= 90)THEN
301 ! /UNIT/LENGTH/[value]
302 ! /UNIT/MASS/[value]
303 ! /UNIT/TIME/[value]
304 CALL hm_option_start('/UNIT')
305 DO n=1,nunit0
306 CALL hm_option_read_key(lsubmodel,option_id = id)
307 unit_name = ''
308 CALL hm_get_string('UNIT_NAME',unit_name,2*ncharfield,is_available)
309c
310 IF(unit_name == 'LENGTH') THEN
311 CALL hm_get_string('TYPE_UNIT',keyl,2*ncharfield,is_available)
312 ENDIF
313 IF(unit_name == 'MASS') THEN
314 CALL hm_get_string('TYPE_UNIT',keym,2*ncharfield,is_available)
315 ENDIF
316 IF(unit_name == 'TIME') THEN
317 CALL hm_get_string('TYPE_UNIT',keyt,2*ncharfield,is_available)
318 ENDIF
319 ENDDO
320 ENDIF !(INVERS <= 90)
321
322 ENDIF
323 CALL hm_read_unit(unitab,lsubmodel)
324C=======================================================================
325C READING CONTROL CARDS
326C=======================================================================
327 WRITE(istdo,'(A)')titre(10)
328C-------------------------------------------------------------------
329C READING OF /SPMD
330C-------------------------------------------------------------------
331 CALL hm_read_spmd(lsubmodel)
332C
333 ignore_spmd=0
334 IF (got_ncpu ==1) THEN
335 IF (nspmd/=0) THEN
336 ignore_spmd=1
337 END IF
338 nspmd = ncpu
339 ENDIF
340C
341C thread number
342C
343 ignore_threads=0
344 got_variable=0
345#if defined(_OPENMP)
346 str = ' '
347 CALL getenv('OMP_NUM_THREADS',str)
348 nthread1=0
349C nthread1 : thread number determined by environment variable
350 READ(str,'(I10)',err=999)nthread1
351 IF(nthread1>0)THEN
352 nthread = nthread1
353 ENDIF
354 IF (got_nth ==1) THEN
355 IF (nthread/=0) THEN
356 ignore_threads=1
357 END IF
358 nthread = nth
359 ELSE
360 IF(nthread1>0)THEN
361 got_variable=1
362 END IF
363 ENDIF
364C case no -nt, no OMP_NUM_THREADS, no /SPMD
365 nthread = max(nthread,1)
366 nthread_s = nthread
367 nthread_r2r = nthread
368 CALL omp_set_num_threads(nthread_s)
369
370c else (open mp not defined)
371#elif 1
372 IF (got_nth ==1) THEN
373 IF (nthread/=0) THEN
374 ignore_threads=1
375 END IF
376 nthread = nth
377 ENDIF
378 nthread_s = 1
379#endif
380C-------------------------------------------------------------------
381C /ARCH option not defined, IARCH= IBUILTIN & Grpsiz = ARCHINFO(IBUILTIN)
382 iarch = ibuiltin
383 nvsiz = archinfo(ibuiltin,1)
384 ivector = archinfo(ibuiltin,2)
385
386 ! ---------------------------
387 ! -grp_size hidden option
388 IF(grp_size_bool) THEN
389 nvsiz = grp_size
390 ENDIF
391 ! ---------------------------
392C-------------------------------------------------------------------
393C READING OF /IOFLAG
394C-------------------------------------------------------------------
395 CALL hm_read_ioflag(lsubmodel)
396C-------------------------------------------------------------------
397C READING OF /ANALY
398C-------------------------------------------------------------------
399 ipari0= 1
400 integ8= 0
401 CALL hm_read_analy(nanaly,iparith,ipari0,lsubmodel)
402 n2d = nanaly
403C-------------------------------------------------------------------
404C READING OF /IMPLICIT
405C-------------------------------------------------------------------
406 CALL hm_read_implicit(lsubmodel)
407C-------------------------------------------------------------------
408C READING OF /AMS
409C-------------------------------------------------------------------
410 CALL hm_option_count('/AMS', nb_ams)
411 CALL hm_read_sms(lsubmodel)
412C-------------------------------------------------------------------
413C READING OF /CAA
414C-------------------------------------------------------------------
415 CALL hm_read_caa(lsubmodel)
416C-------------------------------------------------------------------
417C READING OF /RANDOM
418C-------------------------------------------------------------------
419 CALL hm_option_count('/RANDOM',nrand)
420C-------------------------------------------------------------------
421C READING OF /LAGMUL
422C-------------------------------------------------------------------
423 CALL hm_read_lagmul(lsubmodel)
424C-------------------------------------------------------------------
425 CALL hm_option_count('/PRIVATE/METADATA/FATXML',iprivate)
426 IF(iprivate > 0 ) iprivate = 1
427C-------------------------------------------------------------------
428C READING OF /STAMPING
429C-------------------------------------------------------------------
430 CALL hm_option_count('/STAMPING',istamping)
431 IF(istamping > 0 ) istamping = 1
432C-------------------------------------------------------------------
433 icrash = 0
434C-------------------------------------------------------------------
435C READING DEFAULT VALUES FOR SHELLS, SOLIDS, INTERFACES ...
436C-------------------------------------------------------------------
437!--- remove first /DEF/SOLID in src21_c.inc
438 CALL init_def_zero(defaults)
439!---- obsolet flag values fixed here
440 ipla_ds =2 ! obsolet
441 istr_d=1 ! istrain
442 ishea_d=0 ! Old hidden flag in /DEF_SHELL
443 iner_9_12 = zero
444 insh = 0 ! Old hidden flag in /DEF_SHELL
445 npts_d = -1 ! Old hidden flag in /DEF_SHELL
446C-------------------------------------------------------------------
447C READING OF SHELL PROPERTIES DEFAULT VALUES
448C-------------------------------------------------------------------
449 CALL hm_read_defshell(lsubmodel,defaults%SHELL)
450C-------------------------------------------------------------------
451C READING OF SOLID PROPERTIES DEFAULT VALUES
452C-------------------------------------------------------------------
453 CALL hm_read_defsolid(lsubmodel,defaults%SOLID)
454C----------------------------------------------
455 is17old = 1 ! To be cleaned
456C-----
457 IF(insh==1)iner_9_12 = twelve
458 IF(insh==2)iner_9_12 = sixteen
459 IF(insh==3)iner_9_12 = forty8
460 IF(insh==4)iner_9_12 = thirty
461 IF(insh==5)iner_9_12 = nine
462! default values in def_solid/def_shell
463 CALL init_def_elem(n2d,iimplicit,defaults)
464C-------------------------------------------------------------------
465C READING OF INTERFACES DEFAULT VALUES
466C-------------------------------------------------------------------
467 hm_ninter_def = 0
468 def_inter(1:100) = 0
469 CALL hm_option_count('/DEFAULT/INTER',hm_ninter_def)
470 CALL hm_read_definter(hm_ninter_def,def_inter,lsubmodel)
471 defaults%interface%DEF_INTER(1:100) = def_inter(1:100)
472C-------------------------------------------------------------------
473 CALL hm_option_count('/INTTHICK/V5',iintthick)
474 IF (iintthick > 1) THEN
475 CALL ancmsg(msgid=725,msgtype=msgerror,anmode=aninfo,i1=iintthick)
476 ENDIF
477C-------------------------------------------------------------------
478C READGING OF /SHFRAM
479C-------------------------------------------------------------------
480 ishfram = 0
481 CALL hm_option_count('/SHFRA/V4',nshfram)
482 IF (nshfram == 1) THEN
483 ishfram = 2
484 ELSEIF (nshfram > 1) THEN
485 CALL ancmsg(msgid=546,msgtype=msgerror,anmode=aninfo,i1=nshfram)
486 ENDIF
487C-------------------------------------------------------------------
488C READGING OF /SH_3NFR
489C-------------------------------------------------------------------
490 ish3nfram = 0
491C=======================================================================
492C Initialisations vs DOMDEC (Must stay after reading the control cards, because of output to STDO)
493C=======================================================================
494 IF(decneq==0) decneq = 100
495 IF(dectyp < 0) THEN
496 dectyp = - dectyp
497 edge_filtering = 0
498 ELSE
499 edge_filtering = 1
500 ENDIF
501 old_rsb=0
502 IF(dectyp == 2)THEN
503 dectyp=0
504 old_rsb=1
505 ENDIF
506 IF(dectyp==0)THEN
507 IF(nb_ams==0.AND.iimplicit==0) THEN
508 dectyp = 3
509 ELSE
510 dectyp = 5
511 END IF
512 END IF
513
514 ddnod_sms=0
515 IF(dectyp==7)THEN
516 IF(nb_ams/=0)THEN
517 dectyp = 5
518 ddnod_sms=1
519 ELSEIF(iimplicit/=0) THEN
520 dectyp = 5
521 ELSE
522 dectyp = 3
523 END IF
524 END IF
525 IF(nspmd < 1) nspmd=1
526 IF(nspmd > parasiz) nspmd=parasiz
527 IF(nthread < 1) nthread=1
528C maximum number of SMP threads equal to NTHMAX
529 IF(nthread > nthmax) nthread=nthmax
530C
531 IF (got_inspire_alm == 1)THEN
532 IF (nthread_s==1)THEN
533 WRITE(istdo,'(A,I4,A)')' .. SOLVER RUNNING ON ',nthread_s,' THREAD'
534 ELSE
535 WRITE(istdo,'(A,I4,A)')' .. SOLVER RUNNING ON ',nthread_s,' THREADS'
536 ENDIF
537 ELSE
538 IF (nthread_s==1)THEN
539 WRITE(istdo,'(A,I4,A)')' .. STARTER RUNNING ON ',nthread_s,' THREAD'
540 ELSE
541 WRITE(istdo,'(A,I4,A)')' .. STARTER RUNNING ON ',nthread_s,' THREADS'
542 ENDIF
543 ENDIF
544
545C=======================================================================
546C OPTIONS NUMBERING
547C=======================================================================
548C WRITE(ISTDO,'(/,A)')' .. OPTIONS COUNTING'
549C-------------------------------------------------------------------
550C User-Defined Nodes & Cnodes numbering
551C Check nodes within some tolerance and possibly merge nodes
552C-------------------------------------------------------------------
553 CALL cpp_nodes_count(numnusr,numcnod)
554C------
555C Pre-read Nodes & Cnodes and compute NUMNOD taking into account that some nodes may be merged.
556 CALL hm_preread_node(unitab,lsubmodel,numnusr,is_dyna) ! NUMNOD is computed here
557C------
558C numnod=0 : ask user to provide relevant input file.
559 IF(numnod==0)THEN
560 CALL ancmsg(msgid=3,msgtype=msgerror,anmode=aninfo)
561 CALL arret(2)
562 ENDIF
563C-------------------------------------------------------------------
564 isumnx = 0
565 nanim1d = 0
566 maxnx = 0
567 nanim2d = 0
568 nanim3d = 0
569 nthread_r2r = 1
570 ibid = 0
571 rbid = zero
572 npinch = 0
573 nsubdom = 0
574C---------------------------------------------------
575 CALL hm_option_count('/SUBDOMAIN',nsubdom)
576 CALL hm_option_count('/EXTERN/LINK',nr2rlnk)
577C---------------------------------------------------
578 lenmod=0
579 lenglm=0
580 lencp=0
581 lenlm=0
582 lenfls=0
583 lendls=0
584 lenvar=0
585 lenrpm=0
586 lenmcd=0
587 lenelm=0
588 lensig=0
589 lengrvi=0
590 lengrvr=0
591C--- Xfem -------------------------------------------------------
592C---
593C WARNING: NUMNOD, NUMELC, NUMELTG ==> will be changed (by xfem)
594C---
595 nlevmax = 0
596 CALL hm_option_count('/INICRACK',ninicrack)
597C---------------------------------------------------
598C COUNTING ELEMENTS
599C---------------------------------------------------
600 numelx = 0
601 numbrick = 0
602 numtetra4 = 0
603 numpenta6 = 0
604 numels10 = 0
605 numels20 = 0
606 CALL hm_elem_count('XELEM',numelx,is_dyna)
607 CALL hm_elem_count('BRICK',numbrick,is_dyna)
608 CALL hm_elem_count('TETRA4',numtetra4,is_dyna)
609 CALL hm_elem_count('PENTA6',numpenta6,is_dyna)
610 numels8 = numbrick+numtetra4+numpenta6
611C
612 CALL hm_elem_count('TETRA10',numels10,is_dyna)
613 IF (is_dyna == 0) CALL hm_elem_count('BRICK20',numels20,is_dyna)
614 CALL hm_elem_count('SHEL16',numels16,is_dyna)
615C
616C
617 numels = numels8+numels10+numels20+numels16
618C
619C Look for /DT1/BRICK & /DT1TET10 /DTTSH in RADIOSS Engine input deck
620C
621 IF(numels>0)THEN
622 CALL find_dt1brick_engine()
623 END IF
624C-----
625 CALL hm_elem_count('SHELL',numelc,is_dyna)
626 IF(numelc > 0 .AND. nanaly /= 0)THEN
627 CALL ancmsg(msgid=285,msgtype=msgerror,anmode=aninfo)
628 numelc = 0
629 ENDIF
630C-----
631 CALL hm_elem_count('SH3N',numeltg,is_dyna)
632 IF(numeltg > 0 .AND. nanaly /= 0)THEN
633 CALL ancmsg(msgid=287,msgtype=msgerror,anmode=aninfo)
634 numeltg = 0
635 ENDIF
636C-----
637 CALL hm_elem_count('TRUSS' ,numelt,is_dyna)
638 CALL hm_elem_count('BEAM' ,numelp,is_dyna)
639 CALL hm_elem_count('SPRING',numelr,is_dyna)
640C-----
641 CALL hm_elem_count('RIVET',nrivet,is_dyna)
642C-----
643 numelq = 0
644 CALL hm_elem_count('QUAD',numelq,is_dyna)
645C-----
646 CALL hm_elem_count('TRIA',numeltria,is_dyna)
647 numeltg = numeltg + numeltria !2d shell + 3d tria (only one type depending on N2D flag)
648C-----
649C---------------------------------------------------
650 CALL hm_option_count('PART',npart)
651 IF(npart==0)THEN
652 CALL ancmsg(msgid=1114,
653 . msgtype=msgwarning,
654 . anmode=aninfo)
655 ENDIF
656 CALL hm_option_count('SUBSET',nsubs)
657C add 1 : for global subset
658 nsubs = nsubs+1
659C---------------------------------------------------
660 CALL hm_option_count('/THPART',nthpart)
661C---------------------------------------------------
662C LOOKING FOR /ADMESH and COUNTING ADDITIONAL NODES & ELEMENTS
663C---------------------------------------------------
664 CALL hm_option_count('/ADMESH/GLOBAL',nadmeshg)
665 CALL hm_option_count('/ADMESH/SET',nadmeshset)
666 CALL hm_option_count('/ADMESH/STATE',nadmeshstat)
667 nadmesh = nadmeshg + nadmeshset + nadmeshstat
668 numnod0 = numnod
669 numelc0 = numelc
670 numeltg0 = numeltg
671 istatcnd = 0
672 iadmerrt = 0
673 IF(nadmesh/=0)THEN
674C
675C NUMNOD, NUMELC, NUMELTG will be changed
676 CALL nbadmesh(lsubmodel,numnusr,unitab)
677 END IF
678C-----
679 IF(nspmd > 1)THEN
680C Option tests not available in SPMD (IE NSPMD> 1)
681 IF(nadmesh/=0)THEN
682 CALL ancmsg(msgid=704,
683 . msgtype=msgerror,
684 . anmode=aninfo)
685 END IF
686 END IF
687C---------------------------------------------------
688C LOOKING FOR IGE REFINEMENT and COUNTING ADDITIONAL NODES & ELEMENTS
689C---------------------------------------------------
690 numnodige0 = numnod
691 numelig3d0 = numelig3d
692 IF(nrafmax/=0)THEN
693C
694C NUMNOD, NUMELIG3D will be changed, SIXIG3D and KXIG3D too
695 CALL nbadigemesh(lsubmodel,numnusr)
696 END IF
697C---------------------------------------------------
698C MATERIALS (+1 materiau fictif ressort)
699C---------------------------------------------------
700 hm_nummat = 0
701 CALL hm_option_count('MATERIAL',hm_nummat)
702 nummat = hm_nummat + 1
703 mat_elem%NUMMAT = nummat
704C---------------------------------------------------
705C PROPERTIES
706C---------------------------------------------------
707 hm_numgeo = 0
708 CALL hm_option_count('PROPERTY',hm_numgeo)
709 numgeo = hm_numgeo
710C-----
711 CALL hm_option_count('/PLY', numply)
712 CALL hm_option_count('/DRAPE',ndrape)
713 CALL hm_option_count('/STACK',numstack)
714C---------------------------------------------------
715C TOOLS
716C---------------------------------------------------
717 CALL hm_option_count('/ACCEL', naccelm)
718C-----
719 CALL hm_option_count('/GAUGE', nbgauge)
720C-----
721 CALL hm_option_count('/ACTIV', nactiv)
722C-----
723 CALL hm_option_count('/ADMAS',nodmas)
724C-----
725 CALL hm_option_count('/CLUSTER',ncluster)
726C-----
727 CALL hm_option_count('/PYTHON_FUNCT' , npyfun)
728
729 CALL hm_option_count('/FUNCT' , nfunct0)
730
731 CALL hm_option_count('/TABLE/0', ntable0)
732 CALL hm_option_count('/TABLE/1', ntable1)
733 nfunct = nfunct0 + ntable0 + ntable1 + npyfun
734 ntable = nfunct
735C-----
736 CALL hm_option_count('/FUNC_2D', nfunc2d)
737C-----
738 iperturb = 0
739 CALL hm_option_count('/PERTURB',nperturb)
740 IF (nperturb > 0) iperturb = 1
741C-----
742 CALL hm_option_count('/SENSOR', nsensor)
743C-----
744 CALL hm_option_count('/SKEW',numskw)
745 CALL hm_option_count('/FRAME',numfram)
746C-----
747 CALL hm_option_count('TRANSFORM',ntransf)
748C---------------------------------------------------
749C LOADS
750C---------------------------------------------------
751 CALL hm_option_count('/CLOAD',nconld)
752 CALL hm_option_count('/PLOAD',npreld)
753 CALL hm_option_count('/LOAD/CENTRI',nloadc)
754 CALL hm_option_count('/LOAD/PFLUID',nloadp_f)
755 CALL hm_option_count('/LOAD/PBLAST',pblast%NLOADP_B)
756 CALL hm_option_count('/LOAD/PRESSURE',nloadp_hyd)
757C---------------------------------------------------
758C GRAVITY
759C---------------------------------------------------
760 CALL hm_option_count('/GRAV',ngrav)
761C---------------------------------------------------
762C BOUNDARY CONDITIONS
763C---------------------------------------------------
764 CALL hm_option_count('/BCS/LAGMUL',nbcslag)
765 CALL hm_option_count('/BCS/CYCLIC',nbcscyc)
766 CALL hm_option_count('/BCS',numbcs)
767 CALL hm_option_count('/NBCS',numbcsn)
768 nbcskin = numbcs - nbcslag
769 CALL hm_option_count('/BCS/WALL',bcs%NUM_WALL)
770 CALL hm_option_count('/BCS/NRF',bcs%NUM_NRF)
771C---------------------------------------------------
772C KINEMATIC CONDITIONS
773C---------------------------------------------------
774 CALL hm_option_count('/IMPDISP',nimpdisp)
775 CALL hm_option_count('/IMPVEL' ,nimpvel)
776 CALL hm_option_count('/IMPACC' ,nimpacc)
777 nfxvel = nimpdisp + nimpvel + nimpacc
778C-----
779 CALL hm_option_count('/RBODY',nrbody)
780 nrbody0 = nrbody
781 CALL hm_option_count('/RBODY/LAGMUL',nrbylag)
782 nrbykin = nrbody - nrbylag
783 CALL hm_option_count('/FXBODY',nfxbody)
784C-----
785 CALL hm_option_count('/MERGE/RBODY',nrbmerge)
786C-----
787 CALL hm_option_count('/MERGE/NODE',nb_merge_node)
788C-----
789 CALL hm_option_count('/RBE2', nrbe2)
790 CALL hm_option_count('/RBE3', nrbe3)
791C-----
792 CALL hm_option_count('/RLINK', nlink)
793C-----
794 CALL hm_option_count('/RWALL',nrwall)
795C-----
796 CALL hm_option_count('/MPC',nummpc)
797 CALL hm_option_count('/CYL_JOINT', njoint)
798 CALL hm_option_count('/GJOINT', ngjoint)
799C---------------------------------------------------
800C SEATBELT TOOLS
801C---------------------------------------------------
802 CALL hm_option_count('/SLIPRING', nslipring)
803 CALL hm_option_count('/RETRACTOR', nretractor)
804C---------------------------------------------------
805C MONITORED VOLUMES
806C---------------------------------------------------
807 CALL hm_option_count('/MONVOL', nmonvol)
808C---------------------------------------------------
809C INTERFACES
810C---------------------------------------------------
811 ninter = 0
812 hm_ninter= 0
813 CALL hm_option_count('/INTER',hm_ninter)
814C-----
815 CALL hm_option_count('/INTER/TYPE22',int22)
816 IF(int22>0)nsub22=2
817 IF(int22>0)alefvm_param%IEnabled=1 !AUTOMATICALLY ENABLING ALE FVM SCHEME FOR FSI INTER22
818C-----
819 CALL hm_option_count('/INTER/SUB',nintsub)
820 ninter = hm_ninter - nintsub
821C-----
822 CALL hm_option_count('/friction',NINTERFRIC)
823 CALL HM_OPTION_COUNT('/fric_orient',NFRIC_ORIENT)
824C---------------------------------------------------
825 CALL HM_OPTION_COUNT('/damp',NDAMP)
826C---------------------------------------------------
827 CALL HM_OPTION_COUNT('/preload',NPRELOAD) !Bolt preloading
828C---------------------------------------------------
829 CALL HM_OPTION_COUNT('/sect',NSECT)
830C---------------------------------------------------
831C---------------------------------------------------
832C Box, groups, lines, surfaces, sets
833C---------------------------------------------------
834 CALL HM_OPTION_COUNT('/box' ,NBBOX)
835 CALL HM_OPTION_COUNT('/surf',NSURF)
836 CALL HM_OPTION_COUNT('/line' ,NSLIN)
837 CALL HM_OPTION_COUNT('/grnod' ,NGRNOD )
838 CALL HM_OPTION_COUNT('/grbric',NGRBRIC)
839 CALL HM_OPTION_COUNT('/grquad',NGRQUAD)
840 CALL HM_OPTION_COUNT('/grpart',NGRPART)
841 CALL HM_OPTION_COUNT('/grshel',NGRSHEL)
842 CALL HM_OPTION_COUNT('/grsh3n',NGRSH3N)
843 CALL HM_OPTION_COUNT('/grtria',NGRTRIA)
844 NGRSH3N = NGRSH3N + NGRTRIA ! 3D or 2D (same buffer)
845 CALL HM_OPTION_COUNT('/grtrus',ngrtrus)
846 CALL hm_option_count('/GRBEAM',ngrbeam)
847 CALL hm_option_count('/GRSPRI',ngrspri)
848 nsets = 0
849 CALL hm_option_count('/SET',nsets)
850 ngpe = ngrnod + ngrbric + ngrquad + ngrshel + ngrsh3n + ngrtrus + ngrbeam + ngrspri + ngrpart
851C---------------------------------------------------
852C Initial conditions
853C---------------------------------------------------
854 CALL hm_option_count('/INIVEL',hm_ninvel)
855 ninvel = hm_ninvel
856C-----
857 CALL hm_option_count('/REFSTA',irefsta)
858 is_refsta = .false.
859 IF(irefsta > 0)is_refsta = .true.
860C-----
861 CALL hm_option_count('/XREF',nxref)
862C-----
863 CALL hm_option_count('/EREF',neref)
864C
865C---- READING OF /INISTA
866 CALL hm_read_inista(s0file, isigi, ioutp_fmt, irootyy_r, lsubmodel)
867C
868 irfe=irform/5
869 irfl=irform-5*irfe
870 irform=5*irfe+irfl
871 IF (irform /= 12) THEN
872 CALL ancmsg(msgid=636,msgtype=msgwarning,anmode=aninfo_blind_1)
873 irform = 12
874 ENDIF
875C
876C---- READING OF /REFSTA
877 CALL hm_read_refsta(lsubmodel, xrfile)
878C-----
879 CALL hm_option_count('/INIGRAV',ninigrav)
880C-----
881 CALL hm_option_count('/INIMAP1D', ninimap1d)
882 CALL hm_option_count('/INIMAP2D', ninimap2d)
883C-----
884 CALL hm_option_count('/INIVOL' ,num_inivol)
885C---------------------------------------------------
886C Thermal FE options
887C---------------------------------------------------
888 CALL hm_option_count('/INITEMP' ,glob_therm%NINTEMP)
889 CALL hm_option_count('/IMPTEMP' ,glob_therm%NIMTEMP)
890 CALL hm_option_count('/IMPFLUX' ,glob_therm%NIMPFLUX)
891 CALL hm_option_count('/CONVEC' ,glob_therm%NCONVEC)
892 CALL hm_option_count('/RADIATION',glob_therm%NRADIA)
893C---------------------------------------------------
894C SPH
895C---------------------------------------------------
896 CALL hm_option_count('/SPHCEL',numsph)
897
898 nselsp = 0
899 CALL hm_option_count('/SPHBCS',nspcond)
900 nsphsym= 0
901 maxpjet= 0
902C
903c call NBSPH only once NSPMD is known in order to compute NSPHRES=NSPHRES*NSPMD to prepare NSPHRES by proc
904c for inlets treatment in SPMD
905c NSPHRES is the global number of SPH reserve
906C NBSPH computes NSPHIO & NSPHRES :
907 CALL nbsph(lsubmodel)
908C
909C add NSPHRES number of SPH reserve for inlet
910 numnod=numnod+nsphres
911 numsph=numsph+nsphres
912C---------------------------------------------------
913C MADYMO
914C---------------------------------------------------
915 nexmad =0
916 nconx =0
917 CALL hm_option_count('/MADYMO/EXFEM', nexmad)
918 CALL hm_option_count('/MADYMO/LINK', nconx)
919 IF (nconx > 0) CALL ancmsg(msgid=2023, msgtype=msgerror, anmode=aninfo)
920C---------------------------------------------------
921 neig = 0
922 CALL hm_option_count('/EIG',neig)
923 IF (neig>0) ipari0 = 0
924C---------------------------------------------------
925 nflow = 0
926 CALL hm_option_count('/BEM/FLOW', nflow)
927 idummy = 0
928 CALL hm_option_count('/BEM/DAA', idummy)
929 nflow = nflow + idummy
930C---------------------------------------------------
931C DFS, ALE, EULER
932C---------------------------------------------------
933 flg_fsi = 0
934 ale%GLOBAL%IS_BOUNDARY_MATERIAL = .false.
935C-----
936 CALL hm_option_count('/EBCS',nebcs)
937C---------------------------------------------------
938! Counting /DFS
939C---------------------------------------------------
940 CALL hm_option_count('/DFS/DETPOIN',detonators%N_DET_POINT)
941 CALL hm_option_count('/DFS/DETLINE',detonators%N_DET_LINE)
942 CALL hm_option_count('/DFS/WAV_SHA',detonators%N_DET_WAVE_SHAPER)
943 CALL hm_option_count('/DFS/DETPLAN',detonators%N_DET_PLANE)
944 CALL hm_option_count('/DFS/DETCORD',detonators%N_DET_CORD)
945 detonators%N_DET=detonators%N_DET_POINT
946 . +detonators%N_DET_LINE
947 . +detonators%N_DET_WAVE_SHAPER
948 . +detonators%N_DET_PLANE
949 . +detonators%N_DET_CORD
950C---------------------------------------------------
951! /DFS/LASER
952C---------------------------------------------------
953 nlaser = 0
954 CALL hm_option_count('/DFS/LASER',nlaser)
955C---------------------------------------------------
956! DETECT ALE OR EULER FRAMEWORK
957C---------------------------------------------------
958 CALL hm_option_count('/ALE/MAT',nalemat)
959 CALL hm_option_count('/EULER/MAT',neulermat)
960 IF(nalemat > 0) ale%GLOBAL%IS_DEFINED_ALE = 1
961 IF(neulermat > 0)ale%GLOBAL%IS_DEFINED_EULER = 1
962 CALL hm_option_count('/PROP', nprop)
963 DO i=1,nprop
964 CALL hm_option_start('/PROP')
965 CALL hm_option_next()
966 CALL hm_get_intv('Iale',jale,is_available,lsubmodel)
967 IF(jale == 1) ale%GLOBAL%IS_DEFINED_ALE = 1
968 IF(jale == 2) ale%GLOBAL%IS_DEFINED_EULER = 1
969 IF(ale%GLOBAL%IS_DEFINED_EULER == 1 .AND. ale%GLOBAL%IS_DEFINED_EULER == 1)EXIT
970 ENDDO
971 jeul = ale%GLOBAL%IS_DEFINED_EULER ! =1 : if /EULER/MAT or /PROP/SOLID (IALE=2) is defined within the input file
972 jale = ale%GLOBAL%IS_DEFINED_ALE ! =1 : if /ALE/MAT or /PROP/SOLID (IALE=1) is defined within the input file
973 lveul=32
974 IF(integ8==1)lveul=52
975C---------------------------------------------------
976 nalebcs = 0
977 CALL hm_option_count('/ALE/BCS', nalebcs)
978 IF(ale%GLOBAL%ICAA == 1) ale%GRID%NWALE = -1
979 dt_input = zero
980 !********************************
981 ! /ALE/GRID: ALE grid formulation
982 !********************************
983 CALL hm_read_ale_grid(dt_input, ale%GRID%ALPHA, ale%GRID%GAMMA, ale%GRID%VGX, ale%GRID%VGY, ale%GRID%VGZ,
984 . volmin, lsubmodel, unitab)
985
986 !*******************************************************************
987 ! /ALE/MUSCL: activation of second order methods for LAW51 or LAW151
988 !*******************************************************************
989 CALL hm_read_ale_muscl(lsubmodel, unitab)
990
991 !************************
992 ! /ALE/LINK/VEL: counting
993 !************************
994 CALL hm_option_count('/ALE/LINK/VEL', nalelk)
995
996 !*****************
997 ! /ALE/SOLVER/FINT
998 !*****************
999 CALL hm_read_ale_solver(lsubmodel, unitab, ale%GLOBAL%ICAA, ale%GLOBAL%ISFINT)
1000
1001 !********
1002 ! /UPWIND
1003 !********
1004 CALL hm_read_upwind(jupw, ale%UPWIND%UPWMG, ale%UPWIND%UPWOG, ale%UPWIND%UPWSM, lsubmodel, unitab)
1005C---------------------------------------------------
1006C ENGINE OPTIONS READ IN THE STARTER
1007C---------------------------------------------------
1008 CALL hm_option_count('/RUN',nrun_eng)
1009 CALL hm_option_count('/ANIM',nanim_eng)
1010 CALL hm_option_count('/TFILE',ntfile_eng)
1011 CALL hm_option_count('/RFILE',nrfile_eng)
1012 CALL hm_option_count('/DT',ndt_eng)
1013 CALL hm_option_count('/STOP',nstop_eng)
1014 CALL hm_option_count('/VERS',nvers_eng)
1015 ngine=nrun_eng+nanim_eng+ntfile_eng+nrfile_eng+ndt_eng+nstop_eng+nvers_eng
1016C---------------------------------------------------
1017 ndsolv=0
1018C----------------------------------------------------------
1019C Anim version 5 non encore supporte
1020 anim_vers = 44
1021 nanim_vers = 0
1022 CALL hm_option_count('/ANIM/VERS',nanim_vers)
1023 IF (nanim_vers > 0) THEN
1024 CALL hm_option_start('/ANIM/VERS')
1025 CALL hm_option_next()
1026 CALL hm_get_intv('Anim_vers', anim_vers, is_available, lsubmodel)
1027 ENDIF
1028C=======================================================================
1029C Some initializations ... (some flags / values need a 1st pre-reading of some options)
1030C=======================================================================
1031 iform8 = 2
1032 dtini = zero
1033 dtfac = zero
1034 dthis = zero
1035 DO i = 1,10
1036 dtabf(i) = ep30
1037 dtabfwr(i) = ep30
1038 ENDDO
1039 dtmin = zero
1040 ihsh = 0
1041 DO i = 1,9
1042 dthis1(i)= 0
1043 ENDDO
1044C----------------------------------------------------------
1045C solids with rotation
1046C----------------------------------------------------------
1047 krot = 0
1048 CALL hm_option_count('/INIVEL/NODE',i)
1049 IF(i > 0)krot=1
1050 iroddl=min(1,numelc+numelp+nrbody+numelr+numeltg+ngjoint+nummpc+nfxbody+numelx+krot)
1051 iroddl0 = 0
1052 iisrot = 0
1053 !for SIN initialization and IN allocation in lectur.F
1054 CALL hm_option_start('MATERIAL')
1055 DO i = 1, hm_nummat
1056 mat_number = i
1057 CALL hm_option_read_key(lsubmodel,keyword2 = key)
1058 IF ((key(1:5) == 'LAW13' .AND. key(1:6) /= 'LAW130' .AND.
1059 . key(1:6) /= 'LAW131' .AND. key(1:6) /= 'LAW132' .AND.
1060 . key(1:6) /= 'LAW133' .AND. key(1:6) /= 'LAW134' .AND.
1061 . key(1:6) /= 'LAW135' .AND. key(1:6) /= 'LAW136' .AND.
1062 . key(1:6) /= 'LAW137' .AND. key(1:6) /= 'LAW138' .AND.
1063 . key(1:6) /= 'LAW139' )
1064 . .OR. key(1:5) == 'RIGID') iroddl0 = 1
1065 IF (key(1:5) == 'LAW68' .OR. key(1:5) == 'COSSE') iisrot = 1
1066 ENDDO
1067C--------------------------------------------
1068C PRE-READ OF Prop IDS for triangles SH3N6 & solid rotations
1069C PRE-READ OF Prop IDS , PARTS & SOLIDSfor sol to SPH
1070C--------------------------------------------
1071 ALLOCATE(igeo(npropgi*numgeo),stat=stat)
1072 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='IGEO')
1073 igeo=0
1074 numeltg6 = 0
1075 nsphsol = 0
1076 ALLOCATE(nsub(numgeo + numstack) ,stat=stat)
1077 ALLOCATE(nisub(numgeo + numstack) ,stat=stat)
1078 ALLOCATE(nply(numgeo + numstack) ,stat=stat)
1079c
1080 CALL hm_preread_properties(igeo,nsphsol,nply,nsub,nisub,lsubmodel,defaults)
1081
1082 IF(nsphsol/=0.AND.numels8/=0)THEN
1083 ALLOCATE(ipart(lipart1*npart),stat=stat)
1084 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='IPART')
1085 ipart=0
1086 CALL hm_preread_part(ipart,igeo,lsubmodel)
1087C
1088 ALLOCATE(ixs(nixs*numels8),stat=stat)
1089 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='IPART')
1090 CALL hm_prelce16s(ipart,igeo,ixs,nsphsol,lsubmodel,is_dyna)
1091C
1092 irest_mselt=1
1093C
1094 ENDIF
1095 numnod=numnod+nsphsol
1096 numsph=numsph+nsphsol
1097C-----
1098 IF(numsph/=0)THEN
1099 CALL hm_read_sphglo(lsubmodel)
1100 ENDIF
1101C----------------------------------------------------------
1102 CALL contrbe2(icr,lsubmodel)
1103 CALL contrbe3(icr3,lsubmodel)
1104 IF(iisrot==1.OR.icr>0.OR.icr3>0)iroddl = 1
1105C----------------------------------------------------------
1106 CALL hm_option_count('/USERWI',user_windows%HAS_USER_WINDOW)
1107 ncpri=1
1108 IF(dtini==zero)dtini=ep06
1109 IF(volmin==zero)volmin=-ep20
1110 dt2old=dtini/onep1
1111 tt=zero
1112 dt1=zero
1113 dt2=zero
1114C
1115 t1s= zero
1116 dt2s=zero
1117C
1118 dtx=zero
1119 tstop=zero
1120 output%DTANIM = zero
1121 output%TANIM=zero
1122 output%TANIM_STOP = ep20
1123 dtoutp = zero
1124 toutp=zero
1125 this=zero
1126 tabfis=zero
1127 tabfwr=zero
1128 econtv = zero
1129 output%TH%WFEXT = zero
1130 reint = zero
1131 ureint = zero
1132 econtd = zero
1133 econt_cumu = zero
1134
1135 irun=0
1136 iger=0
1137 ianim=0
1138 ih3d=0
1139C
1140 DO i = 1,9
1141 this1(i)= 0
1142 ENDDO
1143C
1144 n2d = nanaly
1145 IF(dtfac==zero.AND.n2d/=0)dtfac=0.67 !0.67 => 0.670000016689301 !ZEP67 => 0.670000000000000
1146 IF(dtfac==zero.AND.n2d==0)dtfac=0.90 !0.90 => 0.899999976158142 !ZEP9 => 0.900000000000000
1147C=======================================================================
1148C Opening of some input files (.sty, etc...)
1149C=======================================================================
1150 IF(isigi==1.OR.isigi==2) THEN
1151C- Reading file S00 deleted
1152 ELSEIF(isigi==3.OR.isigi==4.OR.isigi==5) THEN
1153C- Reading file y00/ynn
1154 IF(s0file==' ') THEN
1155 isigi=-isigi
1156 ELSE
1157 j = 0
1158 IF(irootyy_r==2)THEN
1159 DO i=1,ncharline
1160 IF(s0file(i:i)/=' ')j = j + 1
1161 ENDDO
1162 n = j - 3
1163 tmp_name=infile_name(1:infile_name_len)//s0file(1:len_trim(s0file))
1164 len_tmp_name = infile_name_len+len_trim(s0file)
1165 IF(s0file(n:n)=='Y')THEN
1166 OPEN(unit=iin4,file=tmp_name(1:len_tmp_name),access='SEQUENTIAL',form='FORMATTED',status='OLD')
1167
1168 tmp_name=infile_name(1:infile_name_len)//s0file(1:n)//'000'
1169 len_tmp_name = infile_name_len+n+3
1170 OPEN(unit=iin5,file=tmp_name(1:len_tmp_name),access='SEQUENTIAL',form='FORMATTED',status='OLD')
1171 ELSE
1172 OPEN(unit=iin4,file=tmp_name(1:len_tmp_name),err=100,access='SEQUENTIAL',form='FORMATTED',status='OLD')
1173 CALL ancmsg(msgid=169,msgtype=msgerror,anmode=aninfo,c1=s0file)
1174100 CALL ancmsg(msgid=2062,msgtype=msgerror,anmode=aninfo,c1=s0file)
1175 ENDIF
1176 ELSE
1177 j = 0
1178 i = 1
1179 DO WHILE(s0file(i:i)/=' ')
1180 j = j + 1
1181 i = i + 1
1182 ENDDO
1183 n = j-3
1184 tmp_name=infile_name(1:infile_name_len)//s0file(1:len_trim(s0file))
1185 len_tmp_name = infile_name_len+len_trim(s0file)
1186 IF(s0file(n:n+4)=='.sty')THEN
1187 OPEN(unit=iin4,file=tmp_name(1:len_tmp_name),access='SEQUENTIAL',form='FORMATTED',status='OLD')
1188
1189 tmp_name=infile_name(1:infile_name_len)//s0file(1:n-6)//'_0000.sty'
1190 len_tmp_name = infile_name_len+n-6+9
1191 OPEN(unit=iin5,file=tmp_name(1:len_tmp_name),access='SEQUENTIAL',form='FORMATTED',status='OLD')
1192 ELSE
1193 OPEN(unit=iin4,file=tmp_name(1:len_tmp_name),err=200,access='SEQUENTIAL',form='FORMATTED',status='OLD')
1194 CALL ancmsg(msgid=169,msgtype=msgerror,anmode=aninfo,c1=s0file)
1195200 CALL ancmsg(msgid=2062,msgtype=msgerror,anmode=aninfo,c1=s0file)
1196 ENDIF
1197 ENDIF
1198 ENDIF
1199 ENDIF
1200C---------------------------------------------------
1201C COUNT /INI CARDS READ BY HM_READER
1202C---------------------------------------------------
1203 CALL hm_option_count('/INISHE', nb_inishe)
1204 CALL hm_option_count('/INISH3', nb_inish3)
1205 CALL hm_option_count('/INIBRI', nb_inibri)
1206 CALL hm_option_count('/INIQUA', nb_iniquad)
1207 CALL hm_option_count('/INIBEAM', nb_inibeam)
1208 CALL hm_option_count('/INITRUSS', nb_initruss)
1209 CALL hm_option_count('/INISPRI', nb_inisprig)
1210 CALL hm_option_count('/INISPHCEL', nb_inisphcel)
1211
1212 IF(isigi==0.AND.
1213 . (nb_inishe+nb_inish3
1214 . +nb_inibri+nb_iniquad
1215 . +nb_inibeam+nb_initruss
1216 . +nb_inisprig+nb_inisphcel)/=0) isigi=-3
1217C=======================================================================
1218C Writing to 0000.out FILE
1219C=======================================================================
1220 WRITE (iout,'(A)') trim(names_and_titles%TITLE)
1221 WRITE (iout,'(//A/A/,(A,1PG20.13))')titre(110),titre(111)
1222 WRITE (iout,'(A,I10)') titre(117)(1:57),ipri,
1223 . titre(120)(1:57),invers_src
1224 WRITE (iout,'(A,I10)')
1225 . ' NSUBS: NUMBER OF SUBSETS. . . . . . . . . . . . . .',
1226 . nsubs,
1227 . ' NPART: NUMBER OF PARTS. . . . . . . . . . . . . . .',
1228 . npart
1229 WRITE (iout,'(A,I10)') titre(125)(1:57),nummat-1,
1230 . titre(135)(1:57),numgeo,
1231 . titre(126)(1:57),numnod,titre(127)(1:57),numskw,
1232 . titre(128)(1:57),numbcs
1233 IF (nalebcs /= 0)
1234 . WRITE (iout,'(A,I10)') titre(189)(1:57), nalebcs
1235 WRITE (iout,'(A,I10)')
1236 . ' NUMFRAM: NUMBER OF REFERENCE FRAMES . . . . . . . . .',
1237 . numfram
1238 WRITE (iout,'(A,I10)')
1239 . titre(131)(1:57),numelq ,
1240 . titre(191)(1:57),numeltria,
1241 . titre(132)(1:57),numels ,
1242 . titre(133)(1:57),numelc ,
1243 . titre(134)(1:57),numelt ,
1244 . titre(136)(1:57),numelp ,
1245 . titre(137)(1:57),numelr ,
1246 . titre(180)(1:57),numeltg-numeltria,
1247 . titre(182)(1:57),numelx ,
1248 . titre(186)(1:57),numelig3d
1249 WRITE (iout,'(A,I10)')
1250 .' NUMSPH : NUMBER OF SMOOTH PARTICLES (SPH CELLS) . . .',
1251 . numsph
1252 WRITE (iout,'(A,I10)')
1253 .' NSPHBCS: NUMBER OF SPH SYMMETRY CONDITIONS. . . . . .',
1254 . nspcond
1255 WRITE (iout,'(A,I10)')
1256 .' NSPHIO : NUMBER OF SPH INLET/OUTLET CONDITIONS. . . .',
1257 . nsphio
1258 IF(nsphres/=0)THEN
1259 WRITE (iout,'(A,/,A,I10)')
1260 .' NSPHRES:NUMBER OF PARTICLES FROM SPH RESERVES AMONG NUMSPH,',
1261 .' NUMBER OF NODES FROM SPH RESERVES AMONG NUMNOD. . .',
1262 . nsphres
1263 ENDIF
1264 IF(nsphsol/=0)THEN
1265 WRITE (iout,'(A,/,A,I10)')
1266 .' NSPHSOL:NUMBER OF PARTICLES & NODES CREATED FROM SOLIDS .',
1267 .' (AMONG NUMSPH & NUMNOD) . . . . . . . . . . . . .',
1268 . nsphsol
1269 ENDIF
1270 WRITE (iout,'(/(A,I10))') titre(138)(1:57),nfunct,
1271 .' NGRAV: NUMBER OF GRAVITY LOADS . . . . . . . . . . .',
1272 .ngrav,
1273 .' NFUNC2D: NUMBER OF USER 2D FUNCTIONS . . . . . . . .',
1274 .nfunc2d,
1275 .' NINIGRV:NUMBER OF INITIAL GRAVITY LOADS . . . . . . .',
1276 .ninigrav,
1277 .' NCONLD: NUMBER OF CONCENTRATED LOADS. . . . . . . . .',
1278 .nconld,
1279 .' NINVEL: NUMBER OF INITIAL VELOCITIES. . . . . . . . .',
1280 .ninvel,
1281 .' NPRELD: NUMBER OF PRESSURE LOADS. . . . . . . . . . .',
1282 .npreld,
1283 .' NINIMAP1D: NUMBER OF INITIAL 1D MAPPING.. . . . . . .',
1284 .ninimap1d,
1285 .' NINIMAP2D: NUMBER OF INITIAL 2D MAPPING.. . . . . . .',
1286 .ninimap2d
1287 IF(npreload>0) THEN
1288 WRITE (iout,'(A,I10)')
1289 . ' NPRELOAD: NUMBER OF BOLT PRELOADINGS. . . . . . . . .',
1290 . npreload
1291 ENDIF
1292 IF(detonators%N_DET > 0)THEN
1293 WRITE (iout,'(/(A,I10))') titre(141)(1:57),detonators%N_DET_POINT,
1294 . titre(171)(1:57),detonators%N_DET_LINE,
1295 . titre(172)(1:57),detonators%N_DET_WAVE_SHAPER,
1296 . titre(187)(1:57),detonators%N_DET_CORD,
1297 . titre(188)(1:57),detonators%N_DET_PLANE
1298 ENDIF
1299 IF(nlaser > 0) WRITE (iout,'((A,I10))') titre(178)(1:57),nlaser
1300 WRITE (iout,'(4X,A,I10)')
1301 . 'NUMBER OF ACCELEROMETERS. . . . . . . . . . . . . . .',
1302 . naccelm,
1303 . 'NUMBER OF SENSORS . . . . . . . . . . . . . . . . . .',
1304 . nsensor,
1305 . 'NUMBER OF GAUGES. . . . . . . . . . . . . . . . . . .',
1306 . nbgauge
1307 WRITE (iout,'(A,I10)') titre(146)(1:57),ninter,
1308 . titre(147)(1:57),nrwall,titre(148)(1:57),nrbody,
1309 .' NFXBODY: NUMBER OF FLEXIBLE BODIES. . . . . . . . . .',
1310 .nfxbody,
1311 . titre(149)(1:57),nconx,
1312 . titre(150)(1:57),nodmas,titre(183)(1:57),nimpdisp,
1313 . titre(184)(1:57),nimpvel,titre(185)(1:57),nimpacc,
1314 . titre(152)(1:57),nrivet,titre(153)(1:57),nsect,
1315 . titre(155)(1:57),njoint
1316C
1317 IF(ninterfric > 0) WRITE (iout,'(A,I10)') titre(190)(1:57),ninterfric
1318 IF(nalelk>0)WRITE(iout,'(A,I10)')
1319 .' NALELK: NUMBER OF ALE LINKS. . . . . . . . . . . . . ',
1320 .nalelk
1321 WRITE (iout, 5051) nactiv
1322 WRITE (iout, 5052) ndamp
1323 WRITE (iout, 5053) ngjoint
1324 WRITE (iout, 5054) nummpc
1325 WRITE (iout, 5050) nr2rlnk
1326 WRITE (iout, 5055) nsubdom
1327 WRITE (iout,5000)nvolu+nmonvol
1328 WRITE(iout,'(A,I10)')
1329 .' NEIG: NUMBER OF EIGEN AND STATIC MODES PROBLEMS . .',
1330 .neig
1331 WRITE(iout,'(A,I10)')
1332 .' NBEM: NUMBER OF BEM SOLVED PROBLEMS . . . . . . . .',
1333 .nflow
1334 WRITE(iout,'(A,I10)')
1335 .' NRBE2: NUMBER OF RBE2 RIGID ELEMENTS . . . . . . . .',
1336 .nrbe2
1337 WRITE(iout,'(A,I10)')
1338 .' NRBE3: NUMBER OF RBE3 CONSTRAINT ELEMENTS . . . . .',
1339 .nrbe3
1340 WRITE (iout,'(2A/A,I10)')' INITIAL STRESS FILE =',trim(s0file),
1341 . ' FLAG ISIGI. . .',
1342 . isigi
1343C
1344 IF (irefsta/=0) THEN
1345 WRITE (iout,'(2A/A,I10/A,I10)')
1346 . ' REFERENCE METRIC FILE =',xrfile,
1347 . ' FLAG IREFSTA. .',
1348 . irefsta,
1349 . ' NUMBER OF STEPS , NITRS. .',
1350 . nitrs
1351 ENDIF
1352
1353 IF(jale+jeul/=0)THEN
1354 WRITE(iout,'(A,I10)')' ISFINT: ALE/EULER MOMENTUM INTEGRATION FORMULATION. .',ale%GLOBAL%ISFINT
1355 ENDIF
1356 IF(ale%GLOBAL%ICAA==1)THEN
1357 WRITE(iout,5380)
1358 END IF
1359 IF(jale/=0)THEN
1360 WRITE (iout,5100)ale%GRID%NWALE
1361 SELECT CASE (ale%GRID%NWALE)
1362 CASE(0);WRITE (iout,5199) ale%GRID%ALPHA,ale%GRID%GAMMA,ale%GRID%VGX,ale%GRID%VGY,ale%GRID%VGZ,volmin
1363 CASE(1);WRITE (iout,5200) ale%GRID%ALPHA,volmin
1364 CASE(2);WRITE (iout,5300) dt_input, ale%GRID%ALPHA,ale%GRID%GAMMA,ale%GRID%VGX,ale%GRID%VGY,volmin
1365 CASE(3);WRITE (iout,5350)
1366 CASE(4);WRITE (iout,5351) ale%GRID%ALPHA,ale%GRID%GAMMA,ale%GRID%VGX,ale%GRID%VGY
1367 CASE(5);WRITE (iout,5353) ale%GRID%ALPHA,nint(ale%GRID%VGX)
1368 CASE(6);WRITE (iout,5354)
1369 CASE(7);
1370 label_def = ' NO'
1371 IF(int(ale%GRID%VGX) == 1)label_def = 'YES'
1372 label_rot = ' NO'
1373 IF(int(ale%GRID%VGY) == 1)label_rot = 'YES'
1374 WRITE (iout,5355) label_def,label_rot,ale%GRID%ALPHA,ale%GRID%GAMMA
1375 END SELECT
1376 ENDIF
1377
1378 IF(alefvm_param%ISOLVER /= 0)alemuscl_param%IALEMUSCL=0 !muscl not compatible with FVM solver for int22
1379 CALL hm_option_count('/ALE/MUSCL', nalemuscl)
1380 IF(ale%UPWIND%UPWSM/=one)THEN
1381 IF(nalemuscl>0 .OR. alemuscl_param%IALEMUSCL>0)THEN
1382 nalemuscl=0
1383 alemuscl_param%IALEMUSCL=0
1384 !ignore muscl & use upwsm3 (backward compatibility)
1385 !double check engine file with /ALE/MUSCL/OFF
1386 ENDIF
1387 ENDIF
1388
1389 IF(jale+jeul/=0)THEN
1390 IF(alemuscl_param%IALEMUSCL == 1 .AND. jupw/=0 ) THEN !eta3 + muscl(law51) : conflict
1391 CALL ancmsg(msgid=1564, msgtype=msgwarning, anmode=aninfo)
1392 ELSEIF(alemuscl_param%IALEMUSCL == 0 .OR. jupw/=0)THEN
1393 WRITE (iout,5360)ale%UPWIND%UPWMG,ale%UPWIND%UPWOG !,UPWSM
1394 END IF
1395 IF (alemuscl_param%IALEMUSCL == 1 .OR. alemuscl_param%IALEMUSCL==2) THEN
1396 WRITE (iout, 5504) alemuscl_param%BETA,alemuscl_param%IALEMUSCL-1
1397 ENDIF
1398 ENDIF
1399
1400 WRITE (iout,'(//,A,I10)') titre(130)(1:57),nanaly
1401
1402! for print out
1403 ihbe_ds= defaults%SOLID%ISOLID
1404 isst_ds= defaults%SOLID%ISMSTR
1405 icpre_d= defaults%SOLID%ICPRE
1406 itet4_d= defaults%SOLID%ITETRA4
1407 itet10_d= defaults%SOLID%ITETRA10
1408 iframe_ds = defaults%SOLID%IFRAME
1409 imas_ds= defaults%SOLID%IMAS
1410!
1411 ioffset_d= defaults%SHELL%ioffset !< offset support contact
1412 ihbe_d = defaults%SHELL%ishell
1413 ish3n_d= defaults%SHELL%ish3n
1414 isst_d = defaults%SHELL%ismstr
1415 ipla_d = defaults%SHELL%iplas
1416 ithk_d = defaults%SHELL%ithick
1417 idril_d= defaults%SHELL%idrill
1418
1419 icontrol_d= defaults%SOLID%ICONTROL
1420 IF(n2d==0)THEN
1421 IF(numelq/=0. or. (numeltg/=0.AND.n2d/=0) )THEN
1422 CALL ancmsg(msgid = 286,msgtype = msgerror,anmode = aninfo)
1423 ENDIF
1424 ENDIF
1425C 012
1426 WRITE(iout,5500)integ8,iparith,user_windows%HAS_USER_WINDOW,ihbe_ds,
1427 . itet4_d,itet10_d,isst_ds,icpre_d,ihbe_d,isst_d,ithk_d,
1428 . ipla_d,istr_d,ishea_d,insh,ish3n_d, npts_d, iframe_ds,
1429 . ioffset_d,
1430 . icontrol_d
1431 WRITE(iout,5501)ishfram
1432 IF(analy_temp /= 0)WRITE(iout,5505)analy_temp
1433 IF(ish3nfram>0)WRITE(iout,5901)ish3nfram
1434 IF(jale/=0 .AND. alefvm_param%IEnabled/=0)WRITE(iout,5502)alefvm_param%ISOLVER
1435 IF(jale/=0 .AND. ale%GLOBAL%ISFINT/=0) WRITE(iout,5503)ale%GLOBAL%ISFINT
1436 WRITE(iout,5700)lagm_tol
1437 WRITE(iout,5800)imas_ds
1438 IF ((numsph>0).AND.(nsphsol==0)) WRITE (iout,5600) spasort,lvoisph,kvoisph
1439 IF ((numsph>0).AND.(nsphsol>0)) THEN
1440 IF (itsol2sph==1) WRITE (iout,5610) spasort,lvoisph,kvoisph,itsol2sph
1441 IF (itsol2sph==2) WRITE (iout,5620) spasort,lvoisph,kvoisph,itsol2sph
1442 ENDIF
1443C-------------------------------------------------------------------
1444 WRITE(iout,1000)
1445 IF(iexpm==1) THEN
1446 ELSE IF(imot/=0) THEN
1447 WRITE(iout,*)'MEMORY REQUEST NOT EFFICIENT ON THIS COMPUTER'
1448 ENDIF
1449 IF(icray<2) THEN
1450C
1451 ipct=nint(reel*100)
1452c WRITE(IOUT,3000) LMA,LAM,IPCT
1453 ELSE IF(icray==2) THEN
1454C MasPar Special
1455c WRITE(IOUT,3002) LMA,LAM
1456 ENDIF
1457
1458 IF(nthread_s>1)THEN
1459 str_nbthreads = 'THREADS'
1460 ELSE
1461 str_nbthreads = 'THREAD'
1462 ENDIF
1463 IF(got_inspire_alm == 1)THEN
1464 WRITE(iout,4001) nthread_s,str_nbthreads,nspmd,nthread,iarch,archn(iarch),nvsiz
1465 ELSE
1466 WRITE(iout,4000) nthread_s,str_nbthreads,nspmd,nthread,iarch,archn(iarch),nvsiz
1467 ENDIF
1468C
1469 IF(ignore_spmd==1.OR.ignore_threads==1)THEN
1470 WRITE(iout,'(A)') ' '
1471 WRITE(iout,'(A)') ' INFO : NUMBER OF SPMD DOMAIN AND THREADS DEFINED IN COMMAND LINE'
1472 WRITE(iout,'(A)') ' /SPMD CARD PARAMETER ARE IGNORED'
1473 ENDIF
1474 IF(got_variable==1)THEN
1475 WRITE(iout,'(A)') ' '
1476 WRITE(iout,*) ' INFO : OMP_NUM_THREADS SET, DEFAULT SETTING IGNORED'
1477 WRITE(iout,*)' '
1478 ENDIF
1479
1480 IF(old_rsb==1)THEN
1481 WRITE(iout,'(A)') ' '
1482 WRITE(iout,'(A)') ' INFO : /SPMD OPTION, DECTYP=2 '
1483 WRITE(iout,'(A)') ' RSB DOMAIN DECOMPOSITION DEPRECATED, CHANGING TO DEFAULT VALUE'
1484 ENDIF
1485
1486
1487 IF (userl_avail==1)THEN
1488 WRITE(iout,4500)
1489 IF(got_inspire_alm == 1)THEN
1490 WRITE(iout,4601) dlibfile(1:dlibfile_size),dlibtkvers
1491 ELSE
1492 WRITE(iout,4600) dlibfile(1:dlibfile_size),dlibtkvers
1493 ENDIF
1494 ENDIF
1495C
1496C--------------------------------------------------------------------
1497C DEALLOCATE
1498C--------------------------------------------------------------------
1499 IF(ALLOCATED(ixs)) DEALLOCATE(ixs)
1500 IF(ALLOCATED(igeo)) DEALLOCATE(igeo)
1501 IF(ALLOCATED(ipart))DEALLOCATE(ipart)
1502C--------------------------------------------------------------------
1503 1000 FORMAT(//
1504 & 4x,'SPEED PARAMETERS '/
1505 & 4x,'---------------- '/)
1506c 2000 FORMAT(
1507c & 4X,'MEMORY REQUESTED BY USER (KWORDS). . . . . . . . . .',I10)
1508c 3000 FORMAT(
1509c & 4X,'MEMORY AVAILABLE FOR INTEGERS . . . . . . . . . . . .',I10/
1510c & 4X,'MEMORY AVAILABLE FOR REALS. . . . . . . . . . . . . .',I10/
1511c & 4X,'PERCENTAGE OF MEMORY FOR REALS . . . . . . . . . . .',I10)
1512c 3002 FORMAT(
1513c & 4X,'MEMORY AVAILABLE FOR INTEGERS . . . . . . . . . . . .',I10/
1514c & 4X,'MEMORY AVAILABLE FOR REALS. . . . . . . . . . . . . .',I10)
1515 4000 FORMAT(
1516 & 4x,'STARTER RUNNING ON. . . . . . . . . . . . . . . . . .',i10,
1517 . ' ',a20/
1518 & 4x,'NUMBER OF SPMD DOMAINS. . . . . . . . . . . . . . . .',i10/
1519 & 4x,'NUMBER OF THREADS PER DOMAIN. . . . . . . . . . . . .',i10/
1520 & 4x,'ARCHITECTURE OPTIMIZATION . . . . . . . . . . . . . .',i10,
1521 . ', ',a20/
1522 & 4x,'SIZE OF ELEMENT BUFFER. . . . . . . . . . . . . . . .',i10)
1523 4001 FORMAT(
1524 & 4x,'SOLVER RUNNING ON . . . . . . . . . . . . . . . . . .',i10,
1525 . ' ',a20/
1526 & 4x,'NUMBER OF SPMD DOMAINS. . . . . . . . . . . . . . . .',i10/
1527 & 4x,'NUMBER OF THREADS PER DOMAIN. . . . . . . . . . . . .',i10/
1528 & 4x,'ARCHITECTURE OPTIMIZATION . . . . . . . . . . . . . .',i10,
1529 . ', ',a20/
1530 & 4x,'SIZE OF ELEMENT BUFFER. . . . . . . . . . . . . . . .',i10)
1531
1532 4500 FORMAT(//
1533 & 4x,'EXTERNAL LIBRARY FOR USERS CODE INTERFACE '/
1534 & 4x,'----------------------------------------- '/)
1535 4600 FORMAT(
1536 & 4x,'LIBRARY NAME . . . . . . . . . . . . . . . . . . . . ',a/
1537 & 4x,'RADIOSS USERS CODE INTERFACE VERSION . . . . . . . .',i10)
1538 4601 FORMAT(
1539 & 4x,'LIBRARY NAME . . . . . . . . . . . . . . . . . . . . ',a/
1540 & 4x,'SOLVER USERS CODE INTERFACE VERSION . . . . . . . . .',i10)
1541
1542
1543 5000 FORMAT(
1544 & ' NVOLU: NUMBER OF MONITORED VOLUMES . . . . . . . . .',i10)
1545 5050 FORMAT(
1546 & ' NR2RLNK: NUMBER OF EXTERNAL COUPLING LINKS . . . . . ',i10)
1547 5051 FORMAT(
1548 & ' NACTIV: NUMBER OF ELEMENT DEACTIVATION GROUPS . . . .',i10)
1549 5052 FORMAT(
1550 & ' NDAMP: NUMBER OF RAYLEIGH DAMPING GROUPS . . . . . .',i10)
1551 5053 FORMAT(
1552 & ' NGJOINT: NUMBER OF GEAR TYPE JOINTS . . . . . . . . .',i10)
1553 5054 FORMAT(
1554 & ' NUMMPC: NUMBER OF MULTI-POINT CONSTRAINTS . . . . . .',i10)
1555 5055 FORMAT(
1556 & ' NSUBDOM: NUMBER OF SUBDOMAINS . . . . . .. . . . . . ',i10)
1557 5100 FORMAT(/
1558 & 4x,'NWALE : ALE GRID VELOCITY FORMULATION . . . . . . . .',i10)
1559 5199 FORMAT(//
1560 & 4x,'ALE GRID SMOOTHING FORMULATION'/
1561 & 4x,'------------------------------'/
1562 & 5x,'DONEA GRID VELOCITY COMPUTATION METHOD '//
1563 & 5x,'ALPHA : DONEA COEFFICIENT. . . . . . . . . . ',1pg20.13/
1564 & 5x,'GAMMA : GRID VELOCITY LIMITATION FACTOR. . . ',1pg20.13/
1565 & 5x,'FscaleX : X-GRID VELOCITY SCALE FACTOR . . . . ',1pg20.13/
1566 & 5x,'FscaleY : Y-GRID VELOCITY SCALE FACTOR . . . . ',1pg20.13/
1567 & 5x,'FscaleZ : Z-GRID VELOCITY SCALE FACTOR . . . . ',1pg20.13/
1568 & 5x,'VOLMIN : MINIMUM VOLUME FOR ELEMENT DELETION. ',1pg20.13)
1569 5200 FORMAT(//
1570 & 4x,'ALE GRID SMOOTHING FORMULATION'/
1571 & 4x,'------------------------------'/
1572 & 5x,'ALTAIR AVERAGE DISPLACEMENT GRID FORMULATION '//
1573 & 5x,'UMAX : MAXIMUM ABSOLUTE GRID VELOCITY . . . . ',1pg20.13/
1574 & 5x,'VMIN : MINIMUM VOLUME FOR ELEMENT DELETION. . ',1pg20.13)
1575 5300 FORMAT(//
1576 & 4x,'ALE GRID SMOOTHING FORMULATION'/
1577 & 4x,'------------------------------'/
1578 &5x,'ALTAIR SPRING METHOD FOR GRID VELOCITY COMPUTATION '//
1579 &5x,'DT0 : TYPICAL TIME STEP . . . . . . . . . . . . ',1pg20.13/
1580 &5x,'DT0* : EFFECTIVE TIME STEP. . . . . . . . . . . . ',1pg20.13/
1581 &5x,'GAMMA : NON LINEARITY FACTOR . . . . . . . . . . . ',1pg20.13/
1582 &5x,'ETA : DAMPING COEFFICIENT . . . . . . . . . . . ',1pg20.13/
1583 &5x,'NU : SHEAR FACTOR . . . . . . . . . . . . . . . ',1pg20.13/
1584 &5x,'VOLMIN: MINIMUM VOLUME FOR ELEMENT DELETION. . . . ',1pg20.13)
1585 5350 FORMAT(//
1586 & 4x,'ALE GRID SMOOTHING FORMULATION'/
1587 & 4x,'------------------------------'/
1588 & 5x,'GRID VELOCITY IS NOT COMPUTED (QUASI EULER) ')
1589 5351 FORMAT(//
1590 & 4x,'ALE GRID SMOOTHING FORMULATION'/
1591 & 4x,'------------------------------'/
1592 & 5x,'ALTAIR STANDARD METHOD FOR GRID VELOCITY COMPUTATION '//
1593 & 5x,'ALPHA : STABILITY FACTOR . . . . . . . . . . . . ',1pg20.13/
1594 & 5x,'GAMMA : NON LINEARITY FACTOR . . . . . . . . . . ',1pg20.13/
1595 & 5x,'BETA : DAMPING COEFFICIENT. . . . . . . . . . . ',1pg20.13/
1596 & 5x,'LC : CHARACTERISTIC LENGTH. . . . . . . . . . ',1pg20.13)
1597 5353 FORMAT(//
1598 & 4x,'ALE GRID SMOOTHING FORMULATION'/
1599 & 4x,'------------------------------'/
1600 & 5x,'LAPLACIAN SMOOTHING '//
1601 & 5x,'LAMBDA:. . . . . . . . . . . . . . . . . . . . . ',1pg20.13/
1602 & 5x,'NITER :. . . . . . . . . . . . . . . . . . . . . ',i10)
1603 5354 FORMAT(//
1604 & 4x,'ALE GRID SMOOTHING FORMULATION'/
1605 & 4x,'------------------------------'/
1606 & 5x,'VOLUME SMOOTHING ')
1607 5355 FORMAT(//
1608 & 4x,'ALE GRID SMOOTHING FORMULATION'/
1609 & 4x,'------------------------------'/
1610 & 5x,'FLOW-TRACKING (MASS WEIGHTED AVERAGED VELOCITY)'//
1611 & 5x,'DEFORMATION ENABLED : . . . . . . . . . . . . . ',a3/
1612 & 5x,'ROTATION ENABLED : . . . . . . . . . . . . . . . ',a3/
1613 & 5x,'DEFORMATION SCALE FACTOR : . . . . . . . . . . . ',1pg20.13/
1614 & 5x,'ROTATION SCALE FACTOR: . . . . . . . . . . . . . ',1pg20.13/)
1615
1616
1617 5360 FORMAT(//
1618 & 4x,'ALE UPWIND PARAMETERS'/
1619 & 4x,'---------------------'/
1620 & 5x,'UPWIND FOR MOMENTUM TRANSPORT . . . . .=',1pg20.13/,
1621 & 5x,'UPWIND FOR OTHER TRANSPORT. . . . . . .=',1pg20.13/)
1622 5380 FORMAT(/
1623 & 4x,'CAA FLUID FORMULATION ACTIVATED')
1624 5500 FORMAT(//4x,'ANALYSIS OPTIONS'/
1625 & 4x,'----------------'//
1626 & 4x,'INTEG8 : 8 GAUSS POINT CONDENSED INTEGRATION . . . . .',i10/
1627 & 4x,'IPARITH: PARALLEL ARITHMETIC FLAG (2 OFF, 1 0N). . . .',i10/
1628 & 4x,'IUSERW : GENERAL USER WINDOW FLAG. . . . . . . . . . .',i10/
1629 & 4x,'ISOLID : DEFAULT BRICK FORMULATION FLAG. . . . . . . .',i10/
1630 & 4x,'ITET4 : DEFAULT TETRA4 FORMULATION FLAG . . . . . . .',i10/
1631 & 4x,'ITET10 : DEFAULT TETRA10 FORMULATION FLAG. . . . . . .',i10/
1632 & 4x,'ISMSTR : DEFAULT BRICK SMALL STRAIN FLAG . . . . . . .',i10/
1633 & 4x,'ICPRE : DEFAULT SOLID CONSTANT PRESSURE FLAG. . . . .',i10/
1634 & 4x,'ISHELL : DEFAULT SHELL FORMULATION FLAG. . . . . . . .',i10/
1635 & 4x,'ISST : DEFAULT SHELL SMALL STRAIN FLAG . . . . . . .',i10/
1636 & 4x,'ITHK : DEFAULT SHELL THICKNESS VARIATION FLAG. . . .',i10/
1637 & 4x,'IPLA : DEFAULT PLANE STRESS PLASTICITY FLAG. . . . .',i10/
1638 & 4x,'ISTR : DEFAULT SHELL STRAIN COMPUTATION FLAG . . . .',i10/
1639 & 4x,'ISHEA : DEFAULT SHELL SHEAR COMPUTATION FLAG. . . . .',i10/
1640 & 4x,'INSH : SHELL INERTIA FLAG. . . . . . . . . . . . . .',i10/
1641 & 4x,'ISH3N : DEFAULT 3 NODE SHELL FORMULATION FLAG . . . .',i10/
1642 & 4x,'NPTS : SHELL PROPERTIES DEFAULT NUMBER OF ',/
1643 & 4x,' INTEGRATION POINTS OR LAYERS. . . . . . . . .',i10/
1644 & 4x,'IFRAME : DEFAULT SOLID FRAME FORMULATION FLAG . . . . ',i10/
1645 & 4x,'IOFFSET: DEFAULT SHELL OFFSET FLAG. . . . . . . . . . ',i10/
1646 & 4x,'ICONTROL:DEFAULT SOLID DISTORTION CONTROL FLAG. . . . ',i10)
1647 5501 FORMAT(
1648 & 4x,'ISHFRAM: LOCAL SHELL FRAME DEFINITION. . . . . . . . .',i10)
1649 5502 FORMAT(
1650 & 4x,'IALEFVM: FVM FOR ALE MOMENTUM EQUATION. . . . . . . .',i10)
1651 5503 FORMAT(
1652 & 4x,'ISFINT : INTERNAL FORCES FORMULATION . . . . . . . . .',i10)
1653 5504 FORMAT(//
1654 & 4x,'MUSCL (MONOTONIC UPSTREAM-CENTERED SCHEME FOR CONSERVATION LAWS)'/
1655 & 4x,'----------------------------------------------------------------'/
1656 & 5x,'COMPRESSION COEFFICIENT (BETA). . . . . . . . . . . : ',1pg20.13/
1657 & 5x,'FORMULATION FLAG (IFLAG). . . . . . . . . . . . . . : ',i10)
1658 5505 FORMAT(
1659 & 4x,'ITEMP : TEMPERATURE CUTOFF FLAG . . . . . . . . . . .',i10)
1660 5700 FORMAT(//
1661 & 4x,'LAGRANGE MULTIPLIER OPTIONS'/
1662 & 4x,'---------------------------'/
1663 & 4x,'LAGM_TOL:CONVERGENCE CRITERION. . . . . . . . . . . .',
1664 & 1pg20.13)
1665 RETURN
1666 5600 FORMAT(//4x,'SPH GLOBAL PARAMETERS'/
1667 & 4x,'---------------------'//
1668 & 4x,'ALPHA SORT :SORTING SECURITY COEFFICIENT . . . . . .',
1669 & 1pg20.13/,
1670 & 4x,'LNEIGH :MAXIMUM NUMBER OF COMPUTED NEIGHBOURS. .',i10/,
1671 & 4x,'NNEIGH :MAXIMUM NUMBER OF STORED NEIGHBOURS. . .',i10)
1672 5610 FORMAT(//4x,'SPH GLOBAL PARAMETERS'/
1673 & 4x,'---------------------'//
1674 & 4x,'ALPHA SORT :SORTING SECURITY COEFFICIENT . . . . . .',
1675 & 1pg20.13/,
1676 & 4x,'LNEIGH :MAXIMUM NUMBER OF COMPUTED NEIGHBOURS. .',i10/,
1677 & 4x,'NNEIGH :MAXIMUM NUMBER OF STORED NEIGHBOURS. . .',i10/,
1678 & 4x,'ITSOL2SPH :SOL2SPH PARTICLES ACTIVATION TYPE. . . .',i10/,
1679 & 4x,'(SOL2SPH PARTICLES ACTIVATION BASED ON PARTS)')
1680 5620 FORMAT(//4x,'SPH GLOBAL PARAMETERS'/
1681 & 4x,'---------------------'//
1682 & 4x,'ALPHA SORT :SORTING SECURITY COEFFICIENT . . . . . .',
1683 & 1pg20.13/,
1684 & 4x,'LNEIGH :MAXIMUM NUMBER OF COMPUTED NEIGHBOURS. .',i10/,
1685 & 4x,'NNEIGH :MAXIMUM NUMBER OF STORED NEIGHBOURS. . .',i10/,
1686 & 4x,'ITSOL2SPH :SOL2SPH PARTICLES ACTIVATION TYPE. . . .',i10/,
1687 & 4x,'(SOL2SPH PARTICLES ACTIVATION BASED ON SUBSETS)')
1688 5800 FORMAT(
1689 & //4x,'NODAL MASS DISTRIBUTION FLAG . . . . . . . . .',i10)
1690 5901 FORMAT(
1691 & 4x,'ISH3NFRAM: OLD LOCAL SH3N FRAME ACTIVATION . . . . . .',i10)
1692 999 CALL freerr(1)
1693 RETURN
contrbe3
subroutine contrbe3(icr, lsubmodel)
Definition contrbe3.F:36
find_dt1brick_engine
subroutine find_dt1brick_engine()
Definition contrl.F:1705
my_real
#define my_real
Definition cppsort.cpp:32
hm_elem_count
subroutine hm_elem_count(elem_type, hm_elem_number, is_dyna)
Definition hm_elem_count.F:33
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
hm_get_string
subroutine hm_get_string(name, sval, size, is_available)
Definition hm_get_string.F:78
hm_option_count
subroutine hm_option_count(entity_type, hm_option_number)
Definition hm_option_count.F:105
hm_option_next
subroutine hm_option_next()
Definition hm_option_next.F:39
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:253
hm_preread_node
subroutine hm_preread_node(unitab, lsubmodel, numnusr, is_dyna)
Definition hm_preread_node.F:38
hm_preread_properties
subroutine hm_preread_properties(igeo, nsphsol, nply, nsub, nisub, lsubmodel, defaults)
Definition hm_preread_properties.F:40
hm_read_ale_grid
subroutine hm_read_ale_grid(dt_input, alpha, gamma, vgx, vgy, vgz, volmin, lsubmodel, unitab)
Definition hm_read_ale_grid.F:40
hm_read_ale_muscl
subroutine hm_read_ale_muscl(lsubmodel, unitab)
Definition hm_read_ale_muscl.F:40
hm_read_ale_solver
subroutine hm_read_ale_solver(lsubmodel, unitab, icaa, isfint)
Definition hm_read_ale_solver.F:39
hm_read_analy
subroutine hm_read_analy(nanaly, iparith, ipari0, lsubmodel)
Definition hm_read_analy.F:37
hm_read_caa
subroutine hm_read_caa(lsubmodel)
Definition hm_read_caa.F:36
hm_read_definter
subroutine hm_read_definter(hm_ninter_def, def_inter, lsubmodel)
Definition hm_read_definter.F:42
hm_read_defshell
subroutine hm_read_defshell(lsubmodel, defaults_shell)
Definition hm_read_defshell.F:39
hm_read_defsolid
subroutine hm_read_defsolid(lsubmodel, defaults_solid)
Definition hm_read_defsolid.F:39
hm_read_implicit
subroutine hm_read_implicit(lsubmodel)
Definition hm_read_implicit.F:36
hm_read_inista
subroutine hm_read_inista(s0file, isigi, ioutp_fmt, irootyy_r, lsubmodel)
Definition hm_read_inista.F:39
hm_read_ioflag
subroutine hm_read_ioflag(lsubmodel)
Definition hm_read_ioflag.F:38
hm_read_lagmul
subroutine hm_read_lagmul(lsubmodel)
Definition hm_read_lagmul.F:39
hm_preread_part
subroutine hm_preread_part(ipart, igeo, lsubmodel)
Definition hm_read_part.F:529
contrbe2
subroutine contrbe2(icr, lsubmodel)
Definition hm_read_rbe2.F:1000
hm_read_refsta
subroutine hm_read_refsta(lsubmodel, xrfile)
Definition hm_read_refsta.F:42
hm_read_sms
subroutine hm_read_sms(lsubmodel)
Definition hm_read_sms.F:38
hm_prelce16s
subroutine hm_prelce16s(ipart, igeo, ixs, nsphsol, lsubmodel, is_dyna)
Definition hm_read_solid.F:875
hm_read_sphglo
subroutine hm_read_sphglo(lsubmodel)
Definition hm_read_sphglo.F:38
hm_read_spmd
subroutine hm_read_spmd(lsubmodel)
Definition hm_read_spmd.F:38
hm_read_unit
subroutine hm_read_unit(unitab, lsubmodel)
Definition hm_read_unit.F:46
hm_read_upwind
subroutine hm_read_upwind(jupw, eta1, eta2, eta3, lsubmodel, unitab)
Definition hm_read_upwind.F:39
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:414
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
ale_ebcs_mod
Definition ale_ebcs_mod.F:40
ale_ebcs_mod::nebcs
integer nebcs
Definition ale_ebcs_mod.F:43
ale_mod
Definition ale_mod.F:150
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:253
alefvm_mod
Definition alefvm_mod.F:88
alefvm_mod::alefvm_param
type(alefvm_param_), target alefvm_param
Definition alefvm_mod.F:121
alemuscl_mod
Definition alemuscl_mod.F:55
alemuscl_mod::alemuscl_param
type(alemuscl_param_) alemuscl_param
Definition alemuscl_mod.F:76
check_mod
Definition check_mod.F:34
detonators_mod
Definition detonators_mod.F:80
grp_size_mod
Definition grp_size_mod.F:29
grp_size_mod::grp_size_bool
logical grp_size_bool
Definition grp_size_mod.F:39
grp_size_mod::grp_size
integer grp_size
Definition grp_size_mod.F:40
hm_option_read_mod
Definition hm_option_read_mod.F:412
inivol_def_mod
Definition inivol_mod.F:45
inivol_def_mod::num_inivol
integer num_inivol
Definition inivol_mod.F:85
inoutfile_mod
Definition inoutfile_mod.F:96
inoutfile_mod::infile_name_len
integer infile_name_len
Definition inoutfile_mod.F:114
inoutfile_mod::infile_name
character(len=infile_char_len) infile_name
Definition inoutfile_mod.F:116
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::ltitle
integer, parameter ltitle
Definition names_and_titles_mod.F:1012
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1010
names_and_titles_mod::ncharline
integer, parameter ncharline
Definition names_and_titles_mod.F:1006
pinchtype_mod
Definition pinchtype_mod.F:69
pinchtype_mod::npinch
integer npinch
Definition pinchtype_mod.F:73
refsta_mod
Definition refsta_mod.F:32
refsta_mod::is_refsta
logical is_refsta
Definition refsta_mod.F:37
restmod::ixs
integer, dimension(:), allocatable, target ixs
Definition restart_mod.F:60
restmod::unitab
type(unit_type_) unitab
Definition restart_mod.F:211
restmod::ipart
integer, dimension(:), allocatable, target ipart
Definition restart_mod.F:60
restmod::igeo
integer, dimension(:), allocatable igeo
Definition restart_mod.F:83
setdef_mod
Definition setdef_mod.F:107
setdef_mod::nsets
integer nsets
Definition setdef_mod.F:120
submodel_mod
Definition submodel_mod.F:717
user_windows_mod
Definition user_windows_mod.F:48
nbadigemesh
subroutine nbadigemesh(lsubmodel, numnusr)
Definition nbadigemesh.F:45
nbadmesh
subroutine nbadmesh(lsubmodel, numnusr, unitab)
Definition nbadmesh.F:43
nbsph
subroutine nbsph(lsubmodel)
Definition nbsph.F:39
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895
freerr
subroutine freerr(it)
Definition freform.F:501
arret
subroutine arret(nn)
Definition arret.F:86

◆ find_dt1brick_engine()

subroutine find_dt1brick_engine

Definition at line 1704 of file contrl.F.

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

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

◆ 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 2000 of file contrl.F.

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