OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
starter0.F File Reference
#include "implicit_f.inc"
#include "analyse_name.inc"
#include "r4r8_p.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 "sphcom.inc"
#include "titr_c.inc"
#include "units_c.inc"
#include "units_fxbody_c.inc"
#include "warn_c.inc"
#include "scr03_c.inc"
#include "scr05_c.inc"
#include "scr06_c.inc"
#include "scr12_c.inc"
#include "scr15_c.inc"
#include "scr17_c.inc"
#include "scr23_c.inc"
#include "param_c.inc"
#include "lagmult.inc"
#include "flowcom.inc"
#include "xtimscr_c.inc"
#include "sysunit.inc"
#include "build_info.inc"
#include "altdoctag.inc"
#include "execinp.inc"
#include "r2r_c.inc"
#include "commandline.inc"
#include "userlib.inc"
#include "ngr2usr_c.inc"
#include "inter22.inc"
#include "ige3d_c.inc"
#include "machine.inc"
#include "archloops.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine starter0

Function/Subroutine Documentation

◆ starter0()

subroutine starter0

Definition at line 78 of file starter0.F.

79C-----------------------------------------------
80C M o d u l e s
81C-----------------------------------------------
82 USE message_mod
83 USE multi_fvm_mod
84 USE submodel_mod
85 USE check_mod
86 USE inoutfile_mod
87 USE detonators_mod
88 USE ebcs_mod
89 USE alemuscl_mod , only:alemuscl_param
90 USE alefvm_mod , only:alefvm_param
91 USE user_windows_mod
92 USE user_sensor_mod
93 USE user_interface_mod
94 USE ale_mod
95 USE output_mod
96 USE mat_elem_mod
97 USE names_and_titles_mod
98 USE defaults_mod, only: defaults_
99 use glob_therm_mod
100 use glob_therm_init_mod
101 USE pblast_mod
102 use checksum_starter_option_mod
103 use checksum_check_mod
104 use th_mod , only : th_has_noda_pext
105C-----------------------------------------------
106C I m p l i c i t T y p e s
107C-----------------------------------------------
108#include "implicit_f.inc"
109C-----------------------------------------------
110C A n a l y s e M o d u l e
111C-----------------------------------------------
112#include "analyse_name.inc"
113C-----------------------------------------------
114C G l o b a l P a r a m e t e r s
115C-----------------------------------------------
116#include "r4r8_p.inc"
117C-----------------------------------------------
118C C o m m o n B l o c k s
119C-----------------------------------------------
120#include "com01_c.inc"
121#include "com04_c.inc"
122#include "com06_c.inc"
123#include "com08_c.inc"
124#include "com09_c.inc"
125#include "com10_c.inc"
126#include "sphcom.inc"
127#include "titr_c.inc"
128#include "units_c.inc"
129#include "units_fxbody_c.inc"
130#include "warn_c.inc"
131#include "scr03_c.inc"
132#include "scr05_c.inc"
133#include "scr06_c.inc"
134#include "scr12_c.inc"
135#include "scr15_c.inc"
136#include "scr17_c.inc"
137#include "scr23_c.inc"
138#include "param_c.inc"
139#include "lagmult.inc"
140#include "flowcom.inc"
141#include "xtimscr_c.inc"
142#include "sysunit.inc"
143#include "build_info.inc"
144#include "altdoctag.inc"
145#include "execinp.inc"
146#include "r2r_c.inc"
147#include "commandline.inc"
148#include "userlib.inc"
149#include "ngr2usr_c.inc"
150#include "inter22.inc"
151#include "ige3d_c.inc"
152C-----------------------------------------------
153C L o c a l V a r i a b l e s
154C-----------------------------------------------
155 INTEGER I,J,K, STAT,INP,OUT
156 INTEGER IFILNAM(2148),LEN,IDMAX_INTER,
157 . IDMAX_GRNOD,IDMAX_LINE,IDMAX_TABLE,IDMAX_FAIL,IDMAX_FUNCT,
158 . IDMAX_PART,IDMAX_PROP,IDMAX_MAT,IDMAX_ELEM,IDMAX_TH,
159 . NB_SEATBELT_SHELLS,RADIOSSV,IFL
160 INTEGER LENR,RUNN,FVERS,IO_ERR,TAGLEN,CHECKSUMLEN,IS_DYNA
161 INTEGER LFNAME,LEN_ENV,STATUS,ISUB_HIERARCHY,TRALL_MAXVAL(7),EDI_RES,
162 . LOAD_ERROR,IBID
163 INTEGER :: LEN_TMP_NAME
164 INTEGER :: ANERROR
165 INTEGER :: RADFLEX_PROCESS_PID
166C
167 INTEGER, DIMENSION(:,:), ALLOCATABLE :: SEATBELT_CONVERTED_ELEMENTS
168C
169 CHARACTER(LEN=2148) :: FILNAM ! Maximum is SIZE(OUTFILE_CHAR_LEN) + 100
170 CHARACTER CHRUN*4,CPUNAM*20,ROOTN*80,CHRUNR*4,ARCHTITLE*66
171 CHARACTER ALTDOCTAG*256,CHECKSUM*256
172 CHARACTER*2048 FNAME,VAL
173C
174 CHARACTER(LEN=NCHARLINE) :: ERR_MSG
175 CHARACTER(len=8) :: STARTDATE
176 CHARACTER(len=10) :: STARTTIME
177 CHARACTER(len=8) :: ENDDATE
178 CHARACTER(len=10) :: ENDTIME
179 CHARACTER(len=2048) :: TMP_NAME
180 CHARACTER(len=2048) :: OUT_FILE_NAME
181 INTEGER :: NB_DYNA_INCLUDE
182C
183 my_real unite, rtitr
184C
185 TYPE(MULTI_FVM_STRUCT) :: MULTI_FVM
186 TYPE(SUBMODEL_DATA) , DIMENSION(:), ALLOCATABLE :: LSUBMODEL
187 TYPE(DETONATORS_STRUCT_),TARGET :: DETONATORS
188 TYPE(t_ebcs_tab) :: EBCS_TAB
189 TYPE(OUTPUT_),TARGET :: OUTPUT
190c TYPE(SENSORS_) :: SENSORS ! declared as global in USER_SENSOR_MOD
191 TYPE(MAT_ELEM_) :: MAT_ELEM
192 CHARACTER(LEN=NCHARLINE) :: CWD
193 CHARACTER GLOBAL_PATH*(ncharline+2048)
194 INTEGER :: LEN_CWD
195 INTEGER*4 GETCWD, STATUS_CWD
196 TYPE(NAMES_AND_TITLES_) :: NAMES_AND_TITLES !< NAMES_AND_TITLES host the input deck names and titles for outputs
197 TYPE(DEFAULTS_) :: DEFAULTS !< Hosts the variables from /DEF/ option
198 TYPE(glob_therm_) :: glob_therm
199 TYPE(pblast_) :: PBLAST
200C-----------------------------------------------
201C E x t e r n a l F u n c t i o n s
202C-----------------------------------------------
203 INTEGER,EXTERNAL :: ANEND
204C--------------------------------------------------------
205C LAM MAX LENGTH REAL ARRAY
206C LMA MAX LENGTH INTEGER ARRAY
207C------------------------------------------------
208C MACHINE.INC CONTAINS MACHINE SPECIFICATIONS
209C (MALLOC,TYPE MACHINE...)
210C------------------------------------------------
211#include "machine.inc"
212C=======================================================================
213#include "archloops.inc"
214C -------------------------------------------------
215C First task check the exec arguments (fill common)
216 CALL execargcheck(output)
217
218 ! Options not requiering Starter deck read
219 ! ----------------------------------------
220
221 ! -checksum_read [rootname]
222 IF ( output%CHECKSUM%ST_CHECKSUM_READ == 1 ) THEN
223 CALL checksum_check(output%CHECKSUM%ROOTNAME,path,cpunam,archtitle,iresp)
224 stop
225 ENDIF
226C -------------------------------------------------
227C Constants
228 CALL iniconstant
229
230C timers initialization
231 CALL initime()
232c
233 CALL names_and_title_init(names_and_titles)
234C=======================================================================
235C while waiting IOUT to be initialized set to stdout
236C Needs to be done in the early beginning
237C ===================================================
238 iout=6
239 istdo=6
240C=======================================================================
241 CALL radioss_title(istdo,cpunam,archtitle,filnam,rootlen,chrun,iresp,1)
242C=======================================================================
243c
244
245C-------------------------------------------------------------------
246C Version number
247C To be modified when structure of rst file is modified
248C-------------------------------------------------------------------
249C
250C CODVERS : VERSION CODE = 2019 IF RELEASE 2019
251C IMINVER : MINOR VERSION CODE = 1 IF MINOR RELEASE A(A~1) OF 4.4 RELEASE
252C ISRCVER : SOURCE VERSION CODE = 41*100+9
253C-------------------------------------------------------------------
254 codvers = 2026
255 iminver = 1
256 isrcver = 1
257C-------------------------------------------------------------------
258 dyna_message = 0 ! Variable for message
259 load_error = 0
260 CALL hm_reader_variables(load_error,codvers)
261 IF(load_error /= 0) THEN
262 WRITE(istdo,'(A)') ' '
263 WRITE(istdo,'(A)') '------------------------------------------------------------------------'
264 WRITE(istdo,'(A)') ' ERROR : '
265 WRITE(istdo,'(A)') ' Reader configuration files are not available'
266 WRITE(istdo,'(A)') ' Check and set RAD_CFG_PATH variable.'
267 WRITE(istdo,'(A)') ' '
268 WRITE(istdo,'(A)') ' Standard configuration file installation is '
269#ifdef _WIN64
270 WRITE(istdo,'(A)') ' %ALTAIR_HOME%\hwsolvers\radioss\cfg'
271#else
272 WRITE(istdo,'(A)') ' $ALTAIR_HOME/hwsolvers/radioss/cfg'
273#endif
274 WRITE(istdo,'(A)') '------------------------------------------------------------------------'
275 WRITE(istdo,'(A)') ' '
276 CALL my_exit(2)
277 ENDIF
278
279! ----------------------------
280! if -infile or outfile cdl are used, then one needs to change $TMPDIR
281! in order to write all scratch files in the user folder
282 IF(inout_bool) CALL radioss_set_env_variable(outfile_name , outfile_name_len)
283! ----------------------------
284 CALL date_and_time(startdate,starttime)
285c
286 res_mes = 123456
287 res_tmp = 123457
288 res_check = 123499
289 OPEN (unit=res_mes,status='SCRATCH',form='FORMATTED')
290 OPEN (unit=res_check,status='SCRATCH',form='FORMATTED')
291C
292 iskip_ngr2usr_error = 0 !set to 1 before calling NGR2USR enables to skip error message (otherwise they are often duplicated).
293C
294 CALL ini_msg()
295 CALL build_msg()
296 CALL check_message_definition()
297C-------------------------------------------------------------------
298C initialization for Analyse Module
299C-------------------------------------------------------------------
300 ierr = 0
301 CALL aninit(an_starter, an_live)
302 CALL setignorecore (itrace)
303
304 ioutp = 0
305 ioutput = 0
306C-------------------------------------------------------------------
307C Multidomains -> environment variable reading(windows)
308C-------------------------------------------------------------------
309 ipid = 1
310 iddom = 0
311 flg_swale = 0
312#if CPP_mach == CPP_w95 || CPP_mach == CPP_win64_spmd || CPP_mach == CPP_p4win64_spmd || CPP_mach == CPP_wnt || CPP_mach == CPP_wmr || CPP_mach == CPP_p4win64 || CPP_mach == CPP_p4win32
313 CALL get_environment_variable("R2R_ENV_IPID",val,len_env,status,.true.)
314C---------> IPID = 0 --> Multidomains starter fils--------------
315 IF (len_env==1) ipid = 0
316 CALL get_environment_variable("R2R_ENV_SWALE",val,len_env,status,.true.)
317C---------> IPID = 0 --> Multidomains switch ALE----------------
318 IF (len_env==1) flg_swale = 1
319#endif
320
321C-------------------------------------------------------------------
322C Date
323C To be modified when structure of rst file is modified
324C-------------------------------------------------------------------
325C ITESTV Format [Version][YY][MM][DD]
326 itestv = 210290720
327
328 CALL ale%init()
329
330 alefvm_param%IEnabled = 0
331 alefvm_param%ISOLVER = 0
332 alefvm_param%IPRINT_1 = 0
333 alefvm_param%IPRINT_2 = 0
334C MUSCL Activation
335 alemuscl_param%IALEMUSCL = 1
336C MUSCL compression coefficient, default value set to 1.
337 alemuscl_param%BETA = two
338 ratio22 = one + ten/hundred
339 radiossv = 100090402
340 iflexpipe = 1
341 len = ncharfield*2
342C
343 th_has_noda_pext = 0
344C
345C No Decay for Starter
346 taglen = 0
347 checksumlen = 0
348 altdoctag = '0'
349 CHECKSUM = '0'
350 UNITMAX = 0
351C---
352C init to 0 variable position writing double precision (XDP)
353 IRXDP = 0
354C
355 IF(IR4R8==2) ITESTV=-ITESTV
356C------------------------------------------------
357C Dynamic Libraries initialization
358C------------------------------------------------
359 CALL USER_WINDOWS_INIT(USER_WINDOWS)
360 USERLIB_LIST(1:100)=0
361 IF(GOT_USERL_ALTNAME==1)THEN
362 DLIBFILE(1:LEN_USERL_ALTNAME)=USERL_ALTNAME(1:LEN_USERL_ALTNAME)
363 DLIBFILE_SIZE=LEN_USERL_ALTNAME
364 ELSE
365 DLIBFILE='libraduser_'
366 DLIBFILE_SIZE=LEN_TRIM(DLIBFILE)
367 ENDIF
368 USERL_AVAIL=0
369 CALL DYN_USERLIB_INIT(DLIBFILE,DLIBFILE_SIZE,USERL_AVAIL,DLIBTKVERS,IRESP,GOT_USERL_ALTNAME)
370C------------------------------------------------
371C Mds lib initialization
372C------------------------------------------------
373#ifdef DNC
374 CALL MDS_USERLIB_INIT (IRESP, MDS_AVAIL, MDS_VER, MDS_PATH, MDS_PATH_LEN)
375#else
376 MDS_AVAIL=0
377#endif
378C-----------------------------------------------------
379C Avoid linking issue with dynamical libraries
380C-----------------------------------------------------
381 IERR=0
382 CALL ST_UACCESS_DUM(IERR)
383 CALL ST_UTABLE_DUM(IERR)
384C-----------------------------------------------------
385C initializations
386C-----------------------------------------------------
387 IS_DYNA = 0
388 IF (GOT_INPUT == 1)THEN
389C SEARCH RUN NUMBER
390 CALL GET_FILE_NAME_INFO(INPUT, LENI, ROOTN, LENR, RUNN, FVERS, IS_DYNA)
391 IF (GOT_PATH==1) THEN
392 FNAME=PATH(1:LENP)//INPUT(1:LENI)
393 ELSE
394 FNAME=INPUT(1:LENI)
395 ENDIF
396 LFNAME=LENI+LENP
397 ISTDI = 81
398
399#if CPP_mach == CPP_w95 || CPP_mach == CPP_win64_spmd || CPP_mach == CPP_p4win64_spmd || CPP_mach == CPP_wnt || CPP_mach == CPP_wmr || CPP_mach == CPP_p4win64 || CPP_mach == CPP_p4win32
400
401 TMP_NAME(1:2048) =''
402 LEN_TMP_NAME = INFILE_NAME_LEN+LFNAME
403 TMP_NAME=INFILE_NAME(1:INFILE_NAME_LEN)//FNAME(1:LFNAME)
404 OPEN(UNIT=ISTDI,FORM='formatted',FILE=TMP_NAME(1:LEN_TMP_NAME),
405 . ACTION='read',STATUS='old',IOSTAT=IO_ERR)
406 IF (IO_ERR/=0) THEN
407 WRITE(6,*)' '
408 WRITE(6,*)'*** error input file "',FNAME(1:LFNAME),
409 * '" not found'
410 WRITE(6,*)' '
411 CALL prhelpinfo()
412 CALL my_exit(2)
413 ENDIF
414 CLOSE(unit=istdi)
415#endif
416 ELSE
417 fname = " "
418 rootn = "RADIOSS_STARTER_INPUT"
419 lenr = 21
420 lfname = 1
421 istdi = 5
422 ENDIF
423C------------------------------------------------
424C Read DYNA model & convert DYNA -> Radioss objects
425C------------------------------------------------
426 CALL startime(15,1)
427
428 nb_dyna_include = 0
429 IF(is_dyna == 1) THEN
430 CALL cpp_read_dyna_and_convert(fname, lfname,edi_res,filnam,rootlen+9+outfile_name_len)
431 ENDIF
432 CALL stoptime(15,1)
433C----------------------------------------------------------------------
434C Open starter output file as soon as possible
435C----------------------------------------------------------------------
436 err_msg='OPEN OUTPUT FILE'
437 err_category='OPEN OUTPUT FILE'
438 CALL trace_in1(err_msg,len_trim(err_msg))
439C----------------------------------------------------------------------
440 IF (got_input == 1)THEN
441C Rootname is not taken from /INPUT
442 IF (lenr <=80)THEN
443 rootnam(1:lenr)=rootn(1:lenr)
444 ENDIF
445 rootlen = lenr
446C Runnumber is taken from input name
447 irun = runn
448 ENDIF
449
450 IF(irun > 0)THEN
451 WRITE(istdo,'(A)') ' '
452 WRITE(istdo,'(A,I4)') '** ERROR : INPUT FILE RUN NUMBER SET TO ',irun
453 WRITE(istdo,'(A)') ' MODIF FILES OPTION IS DEPRECATED'
454 WRITE(istdo,'(A)') ' '
455 CALL my_exit(2)
456 ENDIF
457
458C-------------------------------------------------------------------
459 iout=7
460C message file id
461C-------------------------------------------------------------------
462 WRITE(chrun,'(I4.4)')irun
463 out_file_name=''
464C
465 IF (ipid==1) THEN
466 filnam =outfile_name(1:outfile_name_len)//
467 . rootnam(1:rootlen)//'_'//chrun//'.out'
468 OPEN(unit=iout,file=filnam(1:outfile_name_len+rootlen+9),
469 . access='SEQUENTIAL',
470 . form='FORMATTED',status='UNKNOWN')
471
472 out_file_name(1:len_trim(filnam))=filnam(1:len_trim(filnam))
473
474 WRITE(iout, '(1X,A)')trim(filnam)
475C
476 CALL trace_out1()
477C
478 CALL radioss_title(iout,cpunam,archtitle,
479 * filnam,rootlen,chrun,iresp,1)
480
481 CALL printcpu()
482 CALL printcenter(" ",0,IOUT,1)
483 ELSEIF (FLG_SWALE==1) THEN
484 FILNAM =OUTFILE_NAME(1:OUTFILE_NAME_LEN)//ROOTNAM(1:ROOTLEN)//'_'//CHRUN//'.out'
485 OPEN(UNIT=IOUT,FILE=FILNAM(1:ROOTLEN+9+OUTFILE_NAME_LEN),
486 . ACCESS='SEQUENTIAL',
487 . FORM='FORMATTED',STATUS='UNKNOWN')
488
489 OUT_FILE_NAME(1:ROOTLEN+9+OUTFILE_NAME_LEN)=FILNAM(1:ROOTLEN+9+OUTFILE_NAME_LEN)
490
491 ENDIF
492 CALL TITRE1
493C------------------------------------------------
494 ERR_MSG='OPEN OUTPUT FILE'
495 ERR_CATEGORY='OPEN OUTPUT FILE'
496C------------------------------------------------
497 IUGEO=4
498 IIN=8
499 IIN2=11
500 IIN3=12
501 IIN4=13
502 IIN5=14
503 IIN6=15
504 IIN7=17
505 IOU2=16
506 IIN8 =18
507 IIN9 =19
508 IUINIMAP=21
509 IUREE=22
510 IFICM=23
511 IFXM=24
512 IFXS=25
513 IEIGM=26
514c use in ddsplit, will be re-set in ddsplit for multi threading purpose
515 IFXM_L=27
516 IFXS_L=28
517c
518 IUSBM =29
519 IUSC1=30
520 TSUB =31
521 TSUB_TMP =32
522C IUSC2=9 ou 10
523 IUSC3=50
524
525C new composite shell pid max nbs 200
526 NPROPG =1000
527 NPROPM =250
528 NPARG = 100
529 NPARI = 100
530 NPARIR=48
531 LFXVELR = 9
532 NIBCLD = 9
533 LFACCLD = 2
534 NIGRV = 6
535 LFACGRV = 2
536 LFACLOAD = 13
537 NRVOLU =73
538 NICBAG=5
539 NRCBAG=9
540 NIBJET=14
541 NRBJET=420
542 NRBHOL=22
543 NIBHOL=19+15
544 NIXIG3D= 15
545 NIXX = 5
546 NIXFR1 = 0
547 NIXFR2 = 0
548 NISX = 6
549 NPEBC =14
550 NPEBCR =10
551 NIMV = 75 ! array size for Monitored Volumes
552 NRBY = 30
553 NRBYLAG= 0
554 NNPBY = 19
555 NMGRBY = 7
556 NRWLP = 26
557 NIBVEL = 0
558 NBVELP = 6
559 NRCNX = 12
560 NTHVKI = 40
561 NRBE2L = 12
562 NRBE3L = 10
563C Parameters
564C LTITR = 40
565 RTITR = nchartitle/3.
566 LTITR = ceiling(RTITR)
567 LNOPT1 = 20 + LTITR
568 LIGRN1 = 20 + LTITR
569 LISURF1 = 20 + LTITR
570 LISLIN1 = 20 + LTITR
571 NITHGR = 20 + LTITR
572 LILSET1 = 20 + LTITR
573 LISUB1 = 20 + LTITR
574 LIBOX1 = 20 + LTITR
575 LIPART1 = 20 + LTITR
576 NPROPGI = 750 + LTITR
577 NPROPMI = 300 + LTITR
578C npsav not used by starter
579 NPSAV = 0
580 NR2R = 2
581 NISP = 8
582 NSPBUF = 14
583 NISPCOND= 6
584 KVOISPH = 0
585c 2 new values for ISPHIO, NSEG and IAS for inlet outlet in spmd
586 NISPHIO = 16
587 NRIVF = 13
588 NXFRAME = 36
589 LSKEW = 12
590 LISKN = 6
591 NBCSLAG = 0
592 LACTIV = 10
593 LRACTIV = 2
594 LKJNI = 6
595 LKJNR = 19
596 NFRBYM = 28
597 NIRBYM = 2
598 NNPRW = 8
599 SEGINDX=0
600 NHIN2 =0
601 NIFV = 16
602 ALE%GLOBAL%NALENOVS = 6
603 NLEDGE = 15
604 NRTRANS = 22
605C
606 NEXMAD=0
607 NMADPRT=0
608 NMADSH4=0
609 NMADSH3=0
610 NMADSOL=0
611 NMADNOD=0
612 I7STIFS=0
613 NRDAMP=37
614 NIFLOW=28
615 NRFLOW=24
616 NIIOFLOW=4
617 NRIOFLOW=3
618 MULTI_FVM%IS_USED = .FALSE.
619 MULTI_FVM%NS_DIFF = .FALSE.
620C
621 KSH4TREE =4
622 KSH3TREE =4
623 KPADMESH =2
624 KCONTACT =0
625 KIPADMESH=1
626C
627 SIZFIELD = 13
628 SIZLOADP = 13
629c constant for access in tab IBUFSSG_IO, use in engine
630 NIBSPH = 4
631C
632 LLACCELM = 25
633 LLGAUGE = 37
634C
635 ALE%GLOBAL%I_DT_NODA_ALE_ON = 0 ! by default DT NODA * options are no longer available for ALE grid points.
636C
637 INP = ISTDI
638 FLAG_KEY_M = 0
639 FLAG_KEY_L = 0
640 FLAG_KEY_T = 0
641C------------------------------------------------------------------
642 IF( GOT_INSPIRE_ALM == 1)THEN
643 ERR_MSG='SOLVER'
644 ELSE
645 ERR_MSG='RADIOSS STARTER'
646 ENDIF
647 CALL TRACE_IN1(ERR_MSG,LEN_TRIM(ERR_MSG))
648 ERR_MSG='GLOBAL UNITS'
649 ERR_CATEGORY='GLOBAL UNITS'
650 CALL TRACE_IN1(ERR_MSG,LEN_TRIM(ERR_MSG))
651C-------------------------------------------------
652 CALL TRACE_OUT1()
653C-------------------------------------------------
654 CALL INICOD
655C-------------------------------------------------------------------
656C Runnumber is taken from input name or previous treatments
657C-------------------------------------------------------------------
658 IRUN = RUNN
659 CALL TRACE_IN1(ERR_MSG,LEN_TRIM(ERR_MSG))
660 ALLOCATE(LSUBMODEL(1))
661 IF(ALLOCATED(LSUBMODEL)) DEALLOCATE(LSUBMODEL)
662
663C------------------------------------------------
664C Build model in memory (Radioss format)
665C------------------------------------------------
666.AND. IF (GOT_INPUT == 1 IS_DYNA == 0)THEN
667C
668 CALL STARTIME(16,1)
669 STATUS_CWD = GETCWD(CWD)
670 LEN_CWD = LEN_TRIM(CWD)
671 GLOBAL_PATH = TRIM(PATH)
672c
673 CALL CPP_BUILD_MODEL_INC(FNAME,LFNAME,EDI_RES,NB_DYNA_INCLUDE,GLOBAL_PATH,LEN_TRIM(GLOBAL_PATH) )
674c
675.NE. IF(NB_DYNA_INCLUDE 0) THEN
676 DYNA_MESSAGE=1
677 CLOSE(IOUT)
678 CALL CPP_PRINT_DYNA(FILNAM,ROOTLEN+9+OUTFILE_NAME_LEN)
679 OPEN(UNIT=IOUT,FILE=FILNAM(1:ROOTLEN+9+OUTFILE_NAME_LEN),
680 . ACCESS='SEQUENTIAL',FORM='FORMATTED',STATUS='UNKNOWN',POSITION="append")
681 WRITE(IOUT,'(A)')''
682 WRITE(IOUT,'(A)')''
683 WRITE(IOUT,'(A)')'************************************************************************'
684 WRITE(IOUT,'(A)')'* RADIOSS STARTER PROCESS'
685 WRITE(IOUT,'(A)')'************************************************************************'
686 ENDIF
687 CALL STOPTIME(16,1)
688 ENDIF
689C-------------------------------------------------------------------
690C Keyword mapping header output ( DYNA to RADIOSS)
691C-------------------------------------------------------------------
692 IF (IS_DYNA == 1) THEN
693 DYNA_MESSAGE=1
694 CLOSE(IOUT)
695 CALL CPP_PRINT_DYNA(FILNAM,ROOTLEN+9+OUTFILE_NAME_LEN)
696 OPEN(UNIT=IOUT,FILE=FILNAM(1:ROOTLEN+9+OUTFILE_NAME_LEN),
697 . ACCESS='SEQUENTIAL',FORM='FORMATTED',STATUS='UNKNOWN',POSITION="append")
698 WRITE(IOUT,'(A)')''
699 WRITE(IOUT,'(A)')''
700 WRITE(IOUT,'(A)')'************************************************************************'
701 WRITE(IOUT,'(A)')'* RADIOSS STARTER PROCESS'
702 WRITE(IOUT,'(A)')'************************************************************************'
703 ENDIF
704C------------------------------------------------
705C Output errors/warning message (input reading phase)
706C------------------------------------------------
707 IF (GOT_INPUT == 1) CALL HM_MESSAGES(IS_DYNA)
708C------------------------------------------------
709C Write list of replaced parameters
710C------------------------------------------------
711.AND. IF(IPID /= 0 GOT_HSTP_READ == 0) THEN
712 CLOSE(IOUT)
713 CALL CPP_PRINT_PARAMETERS(FILNAM,ROOTLEN+9+OUTFILE_NAME_LEN)
714 OPEN(UNIT=IOUT,FILE=FILNAM(1:ROOTLEN+9+OUTFILE_NAME_LEN),
715 . ACCESS='SEQUENTIAL',FORM='FORMATTED',STATUS='UNKNOWN',POSITION="append")
716 ENDIF
717C------------------------------------------------
718C count submodels & dimension LSUBMODEL structure
719C------------------------------------------------
720 IF(ALLOCATED(lsubmodel)) DEALLOCATE(lsubmodel)
721 nsubmod = 0
722 ibid = 0
723 CALL cpp_submodel_count(nsubmod,ibid)
724 IF(nsubmod > 0)THEN
725 ALLOCATE (lsubmodel(nsubmod),stat=stat)
726 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
727 . msgtype=msgerror,
728 . c1='LSUBMODEL')
729C------------------------------------------------
730C Build submodel hierarchy
731C------------------------------------------------
732 lsubmodel(1:nsubmod)%SKEW = 0
733 CALL hm_read_submodel(lsubmodel)
734 ELSE
735 ALLOCATE (lsubmodel(0),stat=stat)
736 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
737 . msgtype=msgerror,
738 . c1='LSUBMODEL')
739 ENDIF
740C-------------------------------------------------------------------
741C Convert /INTER/TYPE19 in memory to /INTER/TYPE7 & /INTER/TYPE11
742C-------------------------------------------------------------------
743 CALL hm_get_max_id('/INTER',idmax_inter,lsubmodel)
744 CALL hm_get_max_id('/GRNOD',idmax_grnod,lsubmodel)
745 CALL hm_get_max_id('/LINE',idmax_line,lsubmodel)
746 CALL hm_convert_inter_type19(idmax_inter,idmax_grnod,idmax_line,lsubmodel)
747C-------------------------------------------------------------------
748C Convert /FAIL/TAB in memory to /FAIL/TAB1 & /TABLE
749C-------------------------------------------------------------------
750 CALL hm_get_max_id('/TABLE',idmax_table,lsubmodel)
751 CALL hm_get_max_id('/FUNCT',idmax_funct,lsubmodel)
752 CALL hm_get_max_id('/FAIL',idmax_fail,lsubmodel)
753 IF (is_dyna == 0) CALL hm_convert_fail_tab(max(idmax_funct,idmax_table),idmax_fail,lsubmodel)
754C-------------------------------------------------------------------
755C Convert /SHELL & /MAT/LAW119 to /SPRING /PART /PROP/TYPE23 & /MAT/LAW114
756C Convert /TH & /SECT making reference to springs translated from shells
757C-------------------------------------------------------------------
758c Count number of translated shell elements
759 nb_seatbelt_shells = 0
760 CALL hm_count_2d_element_seatbelt(nb_seatbelt_shells,lsubmodel)
761 ALLOCATE (seatbelt_converted_elements(3,nb_seatbelt_shells),stat=stat)
762 seatbelt_converted_elements(1:3,1:nb_seatbelt_shells) = 0
763 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
764 . msgtype=msgerror,
765 . c1='SEATBELT_CONVERTED_ELEMENTS')
766c Get max ids in the input deck
767 idmax_part = 0
768 idmax_prop = 0
769 idmax_mat = 0
770 idmax_elem = 0
771 idmax_th = 0
772 CALL hm_get_max_id('/PART',idmax_part,lsubmodel)
773 CALL hm_get_max_id('/PROP',idmax_prop,lsubmodel)
774 CALL hm_get_max_id('/MAT',idmax_mat,lsubmodel)
775 CALL hm_get_max_id('/SPRING',idmax_elem,lsubmodel)
776 CALL hm_get_max_id('/TH',idmax_th,lsubmodel)
777c 2d seatbelt translation
778 IF (nb_seatbelt_shells > 0)
779 . CALL hm_convert_2d_elements_seatbelt(idmax_part,idmax_prop,idmax_mat,idmax_elem,idmax_th,
780 . seatbelt_converted_elements,nb_seatbelt_shells,lsubmodel)
781C------------------------------------------------------------------
782 ! Initialisation of glob_therm module
783C------------------------------------------------------------------
784 call glob_therm_init(glob_therm)
785C-------------------------------------------------------------------
786C Control variables (count options)
787C-------------------------------------------------------------------
788 CALL contrl(multi_fvm,lsubmodel,is_dyna,detonators,user_windows,mat_elem,
789 . names_and_titles,lipart1,defaults,glob_therm,pblast,output)
790C-------------------------------------------------------------------
791C Parameters modification and parameters write (-HSTP_READ -HSTP_WRITE ARGUMENTS)
792C-------------------------------------------------------------------
793#ifdef DNC
794 IF (got_hstp_read == 1 .OR. got_hstp_write == 1) THEN
795 CALL hstp(rootn,rootlen,lsubmodel,startdate,starttime,filnam,outfile_name_len)
796 ENDIF
797#endif
798C-----------------------------------------------------
799 CALL trace_out1()
800C-----------------------------------------------------
801c stop CPU timer for interval between translator and lectur
802c (freeform)
803 CALL stoptime(4,1)
804
805 IF(irun==0)THEN
806C--------------------------------------------------
807C Initial run
808C--------------------------------------------------
809 iresmd=0
810C
811 invstr=invers
812 err_msg='DECK READING'
813 err_category='DECK READING'
814 CALL trace_in1(err_msg,len_trim(err_msg))
815
816c----------- Child process creation for multidomains-----
817 IF (nsubdom>0) THEN
818 CALL r2r_fork(chrun,filnam,lsubmodel)
819 ENDIF
820
821c start CPU timer for lectur
822 CALL startime(2,1)
823C--------------------------------------------------
824C Checksum option
825C--------------------------------------------------
826 call hm_read_checksum(leni,input,lenp,path,output)
827C--------------------------------------------------
828C Main reading routine
829C--------------------------------------------------
830 CALL lectur(
831 . multi_fvm ,lsubmodel ,is_dyna ,detonators ,ebcs_tab,
832 . seatbelt_converted_elements ,nb_seatbelt_shells,nb_dyna_include ,user_windows ,output ,
833 . mat_elem,names_and_titles,defaults,glob_therm,pblast,sensor_user_struct)
834
835c stop CPU timer for lectur
836 CALL stoptime(2,1)
837
838 IF (ipid/=0) CLOSE(iin2)
839 CALL trace_out1()
840
841 ELSE
842C--------------------------------------------------
843C Modification run (deprecated)
844C --------------------------------------------------
845
846 CALL ancmsg(msgid=1621,
847 . msgtype=msgerror,
848 . anmode=anstop)
849
850 ENDIF
851C
852 IF(ALLOCATED(seatbelt_converted_elements)) DEALLOCATE(seatbelt_converted_elements)
853 CALL user_windows_clean(user_windows)
854 CALL th_clean(output%TH)
855C
856 IF (ierr==0)THEN
857 ! -----------------------------
858 ! write the message only if restart
859 ! files are generated
860 IF(restart_file==1) THEN
861 WRITE(chrunr,'(I4.4)')irun
862 filnam=rootnam(1:rootlen)//'_'//chrunr
863 WRITE (iout,80) filnam(1:rootlen+5)
864 80 FORMAT (/4x,14h restart files:,1x,a,8h written/
865 . 4x,14h -------------/)
866 END IF
867 ! -----------------------------
868 ELSE
869 WRITE(iout,'(a)')TITRE(47)
870 ENDIF
871c print timers
872 CALL PRINTIME(1,GOT_TIMER,STARTDATE,STARTTIME,ENDDATE,ENDTIME)
873C
874 IF (IPID/=0) THEN
875#if CPP_mach == CPP_w95 || CPP_mach == CPP_win64_spmd || CPP_mach == CPP_p4win64_spmd || CPP_mach == CPP_wnt || CPP_mach == CPP_wmr || CPP_mach == CPP_p4win64 || CPP_mach == CPP_p4win32
876 CLOSE(UNIT=ISTDI, STATUS='delete', IOSTAT=IO_ERR)
877#else
878 CLOSE(UNIT=ISTDI, STATUS='delete', IOSTAT=IO_ERR)
879#endif
880 IF (IO_ERR /= 0) THEN
881 WRITE(6,*)' '
882 WRITE(6,*)'*** error closing temporary input file'
883 ENDIF
884
885 CALL CPP_DELETE_MODEL()
886 ENDIF
887C
888 CALL TRACE_OUT1()
889
890 CALL F_ANEND(OUT_FILE_NAME,LEN_TRIM(OUT_FILE_NAME),ROOTNAM,
891 * ROOTLEN,ENDDATE,ENDTIME,OUTPUT)
892C---
893 print*,'done'
894 RETURN
895C---
my_exit
void my_exit(int *i)
Definition analyse.c:1038
aninit
void aninit(int *prgrm, int *GUI_mode)
Definition analyse.c:945
contrl
subroutine contrl(multi_fvm, lsubmodel, is_dyna, detonators, user_windows, mat_elem, names_and_titles, lipart1, defaults, glob_therm, pblast, output)
Definition contrl.F:83
my_real
#define my_real
Definition cppsort.cpp:32
hm_convert_2d_elements_seatbelt
subroutine hm_convert_2d_elements_seatbelt(idmax_part, idmax_prop, idmax_mat, idmax_elem, idmax_th, seatbelt_converted_elements, nb_seatbelt_shells, lsubmodel)
Definition hm_convert_2d_elements_seatbelt.F:40
hm_convert_fail_tab
subroutine hm_convert_fail_tab(table_maxid, fail_maxid, lsubmodel)
Definition hm_convert_fail_tab.F:37
hm_convert_inter_type19
subroutine hm_convert_inter_type19(idmax_inter, idmax_grnod, idmax_line, lsubmodel)
Definition hm_convert_inter_type19.F:36
hm_count_2d_element_seatbelt
subroutine hm_count_2d_element_seatbelt(nb_shells, lsubmodel)
Definition hm_count_2d_element_seatbelt.F:39
hm_get_max_id
subroutine hm_get_max_id(name, idmax, lsubmodel)
Definition hm_get_max_id.F:35
hm_read_submodel
subroutine hm_read_submodel(lsubmodel)
Definition hm_read_submodel.F:38
ini_msg
subroutine ini_msg()
Definition inimsg.F:31
max
#define max(a, b)
Definition macros.h:21
ale_mod
Definition ale_mod.F:149
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:249
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:54
alemuscl_mod::alemuscl_param
type(alemuscl_param_) alemuscl_param
Definition alemuscl_mod.F:75
check_mod
Definition check_mod.F:34
check_mod::restart_file
integer restart_file
Definition check_mod.F:52
check_mod::check_message_definition
subroutine check_message_definition()
Definition check_mod.F:65
detonators_mod
Definition detonators_mod.F:79
inoutfile_mod
Definition inoutfile_mod.F:96
inoutfile_mod::inout_bool
logical inout_bool
Definition inoutfile_mod.F:106
inoutfile_mod::outfile_name
character(len=outfile_char_len) outfile_name
Definition inoutfile_mod.F:111
inoutfile_mod::outfile_name_len
integer outfile_name_len
Definition inoutfile_mod.F:109
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::names_and_title_init
subroutine names_and_title_init(names_and_titles)
Definition names_and_titles_mod.F:1035
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1005
submodel_mod
Definition submodel_mod.F:712
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:720
th_mod
Definition th_mod.F:42
th_mod::th_has_noda_pext
integer th_has_noda_pext
Definition th_mod.F:121
user_windows_mod
Definition user_windows_mod.F:48
user_windows_mod::user_windows_clean
subroutine user_windows_clean(user_window)
Definition user_windows_mod.F:112
printcpu
subroutine printcpu()
Definition printcpu.F:32
r2r_fork
subroutine r2r_fork(chrun, filnam, lsubmodel)
Definition r2r_fork.F:41
radioss_set_env_variable
void radioss_set_env_variable(char *variable, char *value, int *len_value)
Definition radioss_set_env_variable.c:46
build_msg
subroutine build_msg()
Definition build_msg.F:36
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
prhelpinfo
subroutine prhelpinfo()
Definition execargcheck.F:1254
execargcheck
subroutine execargcheck(output)
Definition execargcheck.F:42
lectur
subroutine lectur(multi_fvm, lsubmodel, is_dyna, detonators, ebcs_tab, seatbelt_converted_elements, nb_seatbelt_shells, nb_dyna_include, user_windows, output, mat_elem, names_and_titles, defaults, glob_therm, pblast, sensor_user_struct)
Definition lectur.F:533
radioss_title
subroutine radioss_title(iout, cpunam, archtitle, filnam, rootlen, chrun, iresp, iflag)
Definition radioss_title.F:33
printcenter
subroutine printcenter(array, arrlen, linout, flag)
Definition radioss_title.F:112
iniconstant
subroutine iniconstant
Definition iniconstant.F:29
startime
subroutine startime(event, itask)
Definition timer.F:93
initime
subroutine initime()
Definition timer.F:30
stoptime
subroutine stoptime(event, itask)
Definition timer.F:135
trace_in1
subroutine trace_in1(my_char, ilen)
Definition trace_back.F:37
trace_out1
subroutine trace_out1()
Definition trace_back.F:364
setignorecore
void setignorecore(int *on)
Definition traceback_handler.c:89