93 USE user_interface_mod
98 USE defaults_mod,
only: defaults_
100 use glob_therm_init_mod
102 use checksum_starter_option_mod
103 use checksum_check_mod
108#include "implicit_f.inc"
112#include "analyse_name.inc"
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"
128#include "units_c.inc"
129#include "units_fxbody_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"
147#include "commandline.inc"
148#include "userlib.inc"
149#include "ngr2usr_c.inc"
150#include "inter22.inc"
151#include "ige3d_c.inc"
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,
163 INTEGER :: LEN_TMP_NAME
165 INTEGER :: RADFLEX_PROCESS_PID
167 INTEGER,
DIMENSION(:,:),
ALLOCATABLE :: SEATBELT_CONVERTED_ELEMENTS
169 CHARACTER(LEN=2148) :: FILNAM
170 CHARACTER CHRUN*4,CPUNAM*20,ROOTN*80,CHRUNR*4,ARCHTITLE*66
171 CHARACTER ALTDOCTAG*256,CHECKSUM*256
172 CHARACTER*2048 FNAME,VAL
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) ::
181 INTEGER :: NB_DYNA_INCLUDE
185 TYPE(multi_fvm_struct) :: MULTI_FVM
188 TYPE(t_ebcs_tab) :: EBCS_TAB
189 TYPE(output_),
TARGET :: OUTPUT
192 CHARACTER(LEN=NCHARLINE) :: CWD
193 CHARACTER GLOBAL_PATH*(ncharline+2048)
195 INTEGER*4 GETCWD, STATUS_CWD
197 TYPE(defaults_) :: DEFAULTS
198 TYPE(glob_therm_) :: glob_therm
199 TYPE(pblast_) :: PBLAST
203 INTEGER,
EXTERNAL :: ANEND
211#include
"machine.inc"
213#include
"archloops.inc"
222 IF ( output%CHECKSUM%ST_CHECKSUM_READ == 1 )
THEN
223 CALL checksum_check(output%CHECKSUM%ROOTNAME,path,cpunam,archtitle,iresp)
241 CALL radioss_title(istdo,cpunam,archtitle,filnam,rootlen,chrun,iresp,1)
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 '
270 WRITE(istdo,
'(A)')
' %ALTAIR_HOME%\hwsolvers\radioss\cfg'
272 WRITE(istdo,
'(A)')
' $ALTAIR_HOME/hwsolvers/radioss/cfg'
274 WRITE(istdo,
'(A)') '------------------------------------------------------------------------
'
275 WRITE(ISTDO,'(a)
') ' '
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)
289 OPEN (UNIT=RES_MES,STATUS='scratch
',FORM='formatted
')
290 OPEN (UNIT=RES_CHECK,STATUS='scratch
',FORM='formatted
')
292 ISKIP_NGR2USR_ERROR = 0 !set to 1 before calling NGR2USR enables to skip error message (otherwise they are often duplicated).
296 CALL CHECK_MESSAGE_DEFINITION()
301 CALL ANINIT(AN_STARTER, AN_LIVE)
302 CALL SETIGNORECORE (ITRACE)
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.)
315 IF (LEN_ENV==1) IPID = 0
316 CALL GET_ENVIRONMENT_VARIABLE("R2R_ENV_SWALE",VAL,LEN_ENV,STATUS,.TRUE.)
318 IF (LEN_ENV==1) FLG_SWALE = 1
330 ALEFVM_Param%IEnabled = 0
331 ALEFVM_Param%ISOLVER = 0
332 ALEFVM_Param%IPRINT_1 = 0
333 ALEFVM_Param%IPRINT_2 = 0
335 ALEMUSCL_Param%IALEMUSCL = 1
337 ALEMUSCL_Param%BETA = TWO
338 RATIO22 = ONE + TEN/HUNDRED
355 IF(IR4R8==2) ITESTV=-ITESTV
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
365 DLIBFILE='libraduser_
'
366 DLIBFILE_SIZE=LEN_TRIM(DLIBFILE)
369 CALL DYN_USERLIB_INIT(DLIBFILE,DLIBFILE_SIZE,USERL_AVAIL,DLIBTKVERS,IRESP,GOT_USERL_ALTNAME)
374 CALL MDS_USERLIB_INIT (IRESP, MDS_AVAIL, MDS_VER, MDS_PATH, MDS_PATH_LEN)
382 CALL ST_UACCESS_DUM(IERR)
383 CALL ST_UTABLE_DUM(IERR)
388 IF (GOT_INPUT == 1)THEN
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)
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
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)
408 WRITE(6,*)'*** error input file
"',FNAME(1:LFNAME),
418 ROOTN = "RADIOSS_STARTER_INPUT"
429 IF(IS_DYNA == 1) THEN
430 CALL CPP_READ_DYNA_AND_CONVERT(FNAME, LFNAME,EDI_RES,FILNAM,ROOTLEN+9+OUTFILE_NAME_LEN)
436 ERR_MSG='OPEN output file
'
437 ERR_CATEGORY='OPEN output file
'
438 CALL TRACE_IN1(ERR_MSG,LEN_TRIM(ERR_MSG))
440 IF (GOT_INPUT == 1)THEN
443 ROOTNAM(1:LENR)=ROOTN(1:LENR)
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)
') ' '
462 WRITE(CHRUN,'(i4.4)
')IRUN
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
')
472 OUT_FILE_NAME(1:LEN_TRIM(FILNAM))=FILNAM(1:LEN_TRIM(FILNAM))
474 WRITE(IOUT, '(1x,a)
')TRIM(FILNAM)
478 CALL RADIOSS_TITLE(IOUT,CPUNAM,ARCHTITLE,
479 * FILNAM,ROOTLEN,CHRUN,IRESP,1)
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')
494 err_msg=
'OPEN OUTPUT FILE'
495 err_category=
'OPEN OUTPUT FILE'
566 ltitr = ceiling(rtitr)
576 npropgi = 750 + ltitr
577 npropmi = 300 + ltitr
618 multi_fvm%IS_USED = .false.
619 multi_fvm%NS_DIFF = .false.
635 ale%GLOBAL%I_DT_NODA_ALE_ON = 0
642 IF( got_inspire_alm == 1)
THEN
645 err_msg=
'RADIOSS STARTER'
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))
659 CALL trace_in1(err_msg,len_trim(err_msg))
660 ALLOCATE(lsubmodel(1))
661 IF(
ALLOCATED(lsubmodel))
DEALLOCATE(lsubmodel)
666 IF (got_input == 1 .AND. is_dyna == 0)
THEN
669 status_cwd = getcwd(cwd)
670 len_cwd = len_trim(cwd)
671 global_path = trim(path)
673 CALL cpp_build_model_inc(fname,lfname,edi_res,nb_dyna_include,global_path,len_trim(global_path) )
675 IF(nb_dyna_include .NE. 0)
THEN
680 . access=
'SEQUENTIAL',form=
'FORMATTED',status=
'UNKNOWN',position=
"APPEND")
683 WRITE(iout,
'(A)')
'************************************************************************'
684 WRITE(iout,
'(A)')
'* RADIOSS STARTER PROCESS'
685 WRITE(iout,
'(A)')
'************************************************************************'
692 IF (is_dyna == 1)
THEN
697 . access=
'SEQUENTIAL',form=
'FORMATTED',status=
'UNKNOWN',position=
"APPEND")
700 WRITE(iout,
'(A)')
'************************************************************************'
701 WRITE(iout,
'(A)')
'* RADIOSS STARTER PROCESS'
702 WRITE(iout,
'(A)')
'************************************************************************'
711 IF(ipid /= 0 .AND. got_hstp_read == 0)
THEN
715 . access=
'SEQUENTIAL',form=
'FORMATTED',status=
'UNKNOWN',position=
"APPEND")
720 IF(
ALLOCATED(lsubmodel))
DEALLOCATE(lsubmodel)
723 CALL cpp_submodel_count(
nsubmod,ibid)
725 ALLOCATE (lsubmodel(
nsubmod),stat=stat)
726 IF (stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,
735 ALLOCATE (lsubmodel(0),stat=stat)
736 IF (stat /= 0)
CALL ancmsg(msgid=268,anmode=aninfo,
759 nb_seatbelt_shells = 0
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
765 . c1=
'SEATBELT_CONVERTED_ELEMENTS')
778 IF (nb_seatbelt_shells > 0)
780 . seatbelt_converted_elements,nb_seatbelt_shells,lsubmodel)
784 call glob_therm_init(glob_therm)
788 CALL contrl(multi_fvm,lsubmodel,is_dyna,detonators,user_windows,mat_elem,
789 . names_and_titles,lipart1,defaults,glob_therm,pblast,output)
794 IF (got_hstp_read == 1 .OR. got_hstp_write == 1)
THEN
795 CALL hstp(rootn,rootlen,lsubmodel,startdate,starttime,filnam,
outfile_name_len)
812 err_msg=
'DECK READING'
813 err_category=
'DECK READING'
814 CALL trace_in1(err_msg,len_trim(err_msg))
818 CALL r2r_fork(chrun,filnam,lsubmodel)
826 call hm_read_checksum(leni,input,lenp,path,output)
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)
838 IF (ipid/=0)
CLOSE(iin2)
852 IF(
ALLOCATED(seatbelt_converted_elements))
DEALLOCATE(seatbelt_converted_elements)
854 CALL th_clean(output%TH)
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 -------------/)
869 WRITE(iout,
'(A)')titre(47)
872 CALL printime(1,got_timer,startdate,starttime,enddate,endtime)
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)
878 CLOSE(unit=istdi, status=
'DELETE', iostat=io_err)
880 IF (io_err /= 0)
THEN
882 WRITE(6,*)
'*** ERROR CLOSING TEMPORARY INPUT FILE'
885 CALL cpp_delete_model()
890 CALL f_anend(out_file_name,len_trim(out_file_name),rootnam,
891 * rootlen,enddate,endtime,output)
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)