OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
radioss2.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "r4r8_p.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com06_c.inc"
#include "com08_c.inc"
#include "com10_c.inc"
#include "com_xfem1.inc"
#include "intstamp_c.inc"
#include "sphcom.inc"
#include "units_c.inc"
#include "param_c.inc"
#include "scr02_c.inc"
#include "scr03_c.inc"
#include "scr05_c.inc"
#include "scr06_c.inc"
#include "scr07_c.inc"
#include "scr13_c.inc"
#include "scr14_c.inc"
#include "scr17_c.inc"
#include "scr18_c.inc"
#include "scr20_c.inc"
#include "scr23_c.inc"
#include "scr_fac_c.inc"
#include "chara_c.inc"
#include "task_c.inc"
#include "warn_c.inc"
#include "parit_c.inc"
#include "titr_c.inc"
#include "flowcom.inc"
#include "impl1_c.inc"
#include "tabsiz_c.inc"
#include "sms_c.inc"
#include "filescount_c.inc"
#include "rad2r_c.inc"
#include "userlib.inc"
#include "drape_c.inc"
#include "inter22.inc"
#include "couple_c.inc"
#include "build_info.inc"
#include "machine.inc"
#include "machine2.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine radioss2 (idata, midata, rdata, mrdata)

Function/Subroutine Documentation

◆ radioss2()

subroutine radioss2 ( integer, dimension(*) idata,
integer midata,
rdata,
integer mrdata )

Definition at line 142 of file radioss2.F.

143C-----------------------------------------------
144C M o d u l e s
145C-----------------------------------------------
146 USE timer_mod
147 USE dsgraph_mod
148 USE restmod
149 USE intstamp_glob_mod
150 USE table_glob_mod
151 USE message_mod
152 USE rad2r_mod
153 USE soltosph_mod
154 USE stack_mod
155 USE alefvm_mod
156 USE multi_fvm_mod
157 USE h3d_mod
158 USE group_mod
159 USE groupdef_mod
160 USE mat_elem_mod
161 USE time_mod
162 USE pinchtype_mod
163 USE check_mod
164 USE inoutfile_mod
165 USE qa_out_mod
166 USE ale_connectivity_mod
167 USE dynlib_mod
168 USE monvol_struct_mod
169 USE drape_mod
170 USE sensor_mod
171 USE ebcs_mod
172 USE diffusion_mod
173 USE linear_solver_mod
174 USE mds_restart_mod , ONLY : mds_label,mds_matid,mds_files,mds_ndepsvar,mds_nmat
175 USE segvar_mod
176 USE scratchfile_mod
177 USE state_mod
178 USE alemuscl_mod , only:alemuscl_param
179 USE user_interface_mod
180 USE ale_mod
181 USE output_mod , ONLY : output_, output_ptr
182 USE interfaces_mod
183 USE dt_mod
184 USE loads_mod
185 USE python_funct_mod
186 USE names_and_titles_mod
187 USE unitab_mod
188 USE skew_mod
189 use glob_therm_mod
190 use pblast_mod
191 use connectivity_mod
192 use nodal_arrays_mod
193 use rbe3_mod
194 USE time_history_mod , only : th_clean
195 USE spmd_mod
196 use checksum_output_option_mod
197 use file_descriptor_mod,only : fd_bin_th,fd_bin_rd_rst,fd_bin_wr_rst ! Contains the file descriptors for all files / same as unit_c.inc
198 use coupling_adapter_mod
199C-----------------------------------------------
200C I m p l i c i t T y p e s
201C-----------------------------------------------
202#include "implicit_f.inc"
203C-----------------------------------------------
204C G l o b a l P a r a m e t e r s
205C-----------------------------------------------
206#include "mvsiz_p.inc"
207#include "r4r8_p.inc"
208C-----------------------------------------------
209C C o m m o n B l o c k s
210C-----------------------------------------------
211#include "com01_c.inc"
212#include "com04_c.inc"
213#include "com06_c.inc"
214#include "com08_c.inc"
215#include "com10_c.inc"
216#include "com_xfem1.inc"
217#include "intstamp_c.inc"
218#include "sphcom.inc"
219#include "units_c.inc"
220#include "param_c.inc"
221#include "scr02_c.inc"
222#include "scr03_c.inc"
223#include "scr05_c.inc"
224#include "scr06_c.inc"
225#include "scr07_c.inc"
226#include "scr13_c.inc"
227#include "scr14_c.inc"
228#include "scr17_c.inc"
229#include "scr18_c.inc"
230#include "scr20_c.inc"
231#include "scr23_c.inc"
232#include "scr_fac_c.inc"
233#include "chara_c.inc"
234#include "task_c.inc"
235#include "warn_c.inc"
236#include "parit_c.inc"
237#include "titr_c.inc"
238#include "flowcom.inc"
239#include "impl1_c.inc"
240#include "tabsiz_c.inc"
241#include "sms_c.inc"
242#include "filescount_c.inc"
243#include "rad2r_c.inc"
244#include "userlib.inc"
245#include "drape_c.inc"
246#include "inter22.inc"
247#include "couple_c.inc"
248C-----------------------------------------------
249C D u m m y A r g u m e n t s
250C-----------------------------------------------
251 INTEGER MRDATA,MIDATA
252 INTEGER IDATA(*)
253 my_real rdata(*)
254C-----------------------------------------------
255C L o c a l V a r i a b l e s
256C-----------------------------------------------
257 INTEGER ITASK, ITID(PARASIZ), NBTASK(PARASIZ+1),
258 . IFILNAM(2148), IFILNAM_TMP(2148)
259 INTEGER ITSTV1, IEXPM, IRUNN, IRFL, IRFE, IRR, IT, JT, I,
260 . NNODES,N,LEN, IOS,
261 . I13A,I13B,I13C,I13D,I13E,I13F,I13G,I13H,I76A,I88A,I89A,
262 . I40A,I40B,I40G,I78N,IO_ERR,LEN_G,LEN_M, IAD1, IAD2, IAD3,
263 . IUN,IFUN, ITH, I76ATH(9), IFIL, IO_ERRL,
264 . RADIOSSV,RADFLEXV,RDFLEXCOMP,ABFV,ABFCOMP,IFILABF,
265 . NB_OF_FILES,N_FAIL,IP,IRUNN_BIS,IFILTITL
266 INTEGER OMP_GET_THREAD_NUM,LONG,LONG_TMP,
267 . LENV,FVERS,LFNAME,NB_INDEX_ABF
268 CHARACTER FILNAM*100, CHRUNM1*2, INPUTNAM*100,
269 . CHR_OLD*2,FNAME*2048,IOFF1*3,IOFF2*3,IOFF3*3
270 CHARACTER*2048 INAME
271 CHARACTER*4 PROCNAM,CHRU_M1
272
273 CHARACTER*10 CPID
274 CHARACTER*6 CISPMD
275 INTEGER MY_PID
276 INTEGER NFXFLUX_GLOB
277
278 CHARACTER ABC(26)*1, FILNAMTH*100, FILTH*3, LINE*256,
279 . FILNAMABF*100,FILNAMABF_TMP*100
280 DATA abc/'a','b','c','d','e','f','g','h','i','j','k','l','m','n','o','p','q','r','s','t','u','v','w','x','y','z'/
281
282 INTEGER LHEADER, LVARINT, LVARREA
283 INTEGER PRADIOS,PRESFIL
284 INTEGER I15A,I15B,I15C,I15D,I15E,I15F,I15G,I15H,I15I,I15J,
285 . I15ATH,ITHFLAG
286 INTEGER ICH,MSGID
287C Madymo Stuff
288 INTEGER IERROR,MADSTRLEN
289 CHARACTER MAD_OPTION_STRING*256
290 INTEGER KMADPRT,KMADSH4,KMADSH3,KMADSOL,KMADNOD,KMADFAIL,K1,K2,K3,K4,K5,K6,K7,K8,K9,K10,K11
291 INTEGER BUFTEST(100),NB_MAN,FLAG_MAIN,J, ILAW51,ILAW37,ILAW20
292
293 my_real, DIMENSION(:),ALLOCATABLE :: forneqs
294 TYPE(PRGRAPH), DIMENSION(:), ALLOCATABLE :: GRAPHE
295 INTEGER, DIMENSION(:), ALLOCATABLE :: IFLOW
296 my_real, DIMENSION(:), ALLOCATABLE :: rflow
297 my_real rnb_index_abf,rmaxint
298 SAVE itask, irfe, itid
299 SAVE ixdp
300 INTEGER MLN,IMID,MMALE,IFAILURE_NXT,FLAG_CST_AMS
301 INTEGER IPPID ,IPMAT, IPMAT_IPLY ,IPANG,IPTHK ,IPPOS,IS,IPT
302
303 TYPE (STACK_PLY) :: STACK
304 TYPE (MULTI_FVM_STRUCT) :: MULTI_FVM
305 TYPE (H3D_DATABASE) :: H3D_DATA
306
307 TYPE (PINCH) :: PINCH_DATA
308 TYPE(DRAPE_), DIMENSION(:), ALLOCATABLE :: DRAPE_SH4N,DRAPE_SH3N
309 TYPE(DRAPEG_) :: DRAPEG
310 TYPE(OUTPUT_),TARGET :: OUTPUT
311 TYPE(PYTHON_) :: PYTHON
312C
313 INTEGER :: CURRENT_RUN,PREVIOUS_RUN
314 REAL(kind=8) :: local_starter_time,local_engine_time,result
315
316 INTEGER :: LEN_TMP_NAME,LEN_TMP_NAME2,BOOL_C
317 CHARACTER(len=2048) :: TMP_NAME,TMP_NAME2
318 INTEGER :: DYN_LIB_MODE
319 INTEGER :: RADFLEX_PROCESS_PID
320 INTEGER IUTITLHIS,IUTITLHI(9)
321 TYPE (DYNAIN_DATABASE) :: DYNAIN_DATA
322 TYPE (INTERFACES_) :: INTERFACES
323c TYPE (SENSORS_) :: SENSORS ! defined as global in user_interface_mod
324 TYPE (DT_) :: DT
325 TYPE (LOADS_) :: LOADS
326 TYPE (MAT_ELEM_) :: MAT_ELEM
327 TYPE (SKEW_) :: SKEWS
328 type (glob_therm_) :: glob_therm
329 TYPE (PBLAST_) :: PBLAST
330C----------------------------------------------------------------------------------
331C MDS Table
332 INTEGER, DIMENSION(:), ALLOCATABLE :: MDS_OUTPUT_TABLE
333 INTEGER MAX_DEPVAR
334 TYPE(t_ale_connectivity) :: ALE_CONNECTIVITY
335 TYPE(MONVOL_STRUCT_), DIMENSION(:), ALLOCATABLE :: T_MONVOL
336
337 TYPE(t_ebcs_tab) :: EBCS_TAB
338! TYPE(T_CG_SOLVER) :: LINEAR_SOLVER
339#ifdef MUMPS5
340 TYPE(T_MUMPS_SOLVER) :: LINEAR_SOLVER
341#else
342 TYPE(T_CG_SOLVER) :: LINEAR_SOLVER
343#endif
344 TYPE(T_DIFFUSION) :: DIFFUSION
345 TYPE(t_segvar) :: SEGVAR
346C----------------------------------------------------------------------------------
347 TYPE(NAMES_AND_TITLES_) :: NAMES_AND_TITLES !< NAMES_AND_TITLES host the input deck names and titles for outputs
348 TYPE(UNIT_TYPE_) :: UNITAB !< units conversion
349 TYPE(connectivity_) :: element
350 TYPE(nodal_arrays_), target :: nodes
351 TYPE(timer_) :: TIMERS
352 TYPE(rbe3_) :: rbe3
353 TYPE(coupling_type) :: coupling
354C------------------------------------------------------------------
355C to build a IBM PARALLEL version
356C In starter : define install parameter nspmd
357C uncomment:
358C In CUPDT3(COQUE) : @PROCESS DIRECTIVE ...
359C------------------------------------------------------------------
360#include "build_info.inc"
361C------------------------------------------------------------------
362#include "machine.inc"
363C------------------------------------------------
364C Init Timer (from beginning of radioss2 (reading timer)
365C------------------------------------------------
366 istdo=6
367 CALL ini_msg()
368 CALL build_msg()
369
370 CALL check_message_definition()
371C
372 CALL initime(timers)
373c
374 CALL names_and_title_init(names_and_titles)
375C------------------------------------------------
376C VERSIO(2) used for Time History output
377c DATA VERSIO(2)/'VERSION 5.2main, '/
378 lenv=len_trim(vers)
379 WRITE(versio(2),'(A)') ' '
380 WRITE(versio(2),'(A,A,A)') 'VERSION ',vers(1:lenv),','
381CRVERS for version in MADCL
382 rvers(1:lenv)=vers(1:lenv)
383C------------------------------------------------------------------
384C Constant initialization
385 CALL iniconstant
386C------------------------------------------------------------------
387 codvers= 101
388 msgid = 38
389
390 CALL ale%init()
391C CODVERS : VERSION CODE = 44 IF RELEASE 4.4
392C IMINVER : MINOR VERSION CODE = 1 IF MINOR RELEASE A(A~1) OF 4.4 RELEASE
393C ISRCVER : SOURCE VERSION CODE = 41*100+9
394C IF RELEASE WAS BUILT FROM SOURCE
395 iminver=1
396 isrcver=1
397 abinp = 0
398 about = 0
399
400 !External Foce Work
401 output%TH%WFEXT = 0.0d0
402 output%TH%WFEXT_MD = 0.0d0
403
404 output%CHECKSUM%CHECKSUM_COUNT = 0
405 output_ptr => output
406
407#include "machine2.inc"
408
409C------------------------------------------------------------------
410C Version number & date
411C To be modified when structure of rst file is modified
412C should be identical to ITESTV in starter
413C ITESTV Format [Version][YY][MM][DD]
414C-------------------------------------------------------------------
415 itstv1=210290720
416C
417 IF(ir4r8==2) itstv1 = -itstv1
418C------------------------------------------------------------------
419C Compatible radflex number
420C 2 digits = equivalent radioss version
421C 2 digits = release year
422C 2 digits = release month
423C 2 digits = release day
424C------------------------------------------------------------------
425C D place in machine.inc RDFLEXCOMP = 50060828
426C------------------------------------------------------------------
427 ineri=0
428 iplast=1
429 iin=8
430 iout=7
431 isolv=0
432 istdi=5
433 iugeo=4
434! ----------------------------------------
435! in order to open a file, need a FILE
436! pointer
437! FILE pointer already used :
438! 0-->4
439! 20 : reopen the _0001.rst in order to
440! add the real elapsed time
441! 31-->41
442! 42-->42+n for sectio (but I don't known
443! the value of n)
444! ----------------------------------------
445 iuhis=3
446 iuhi(1)=31
447 iuhi(2)=32
448 iuhi(3)=33
449 iuhi(4)=34
450 iuhi(5)=35
451 iuhi(6)=36
452 iuhi(7)=37
453 iuhi(8)=38
454 iuhi(9)=39
455 icheckd = 40
456 icheckr = 41
457 iuinimap=21
458 iuree=22
459 ificm=23
460 ificm2=24
461 ifxm=25
462 ifxs=26
463 ieigm=27
464 iusc1=9
465 iusc2=30
466 iusc3=50
467 iusc4=70
468 iunoi=10
469 idbg5=67
470 idbg8=68
471 nodadt=0
472 ificds=103
473 nixx=5
474 nixig3d=15
475 nanim2d=0
476 nanim3d=0
477 nrwlp = 26
478 nbvelp = 6
479 nrvolu=24
480 lfacload =13
481 lkjni = 6
482 lkjnr = 19
483 kwasph = 16
484 nexmad=0
485 nmadprt=0
486 nmadsh4=0
487 nmadsh3=0
488 nmadsol=0
489 nmadnod=0
490 ndsolv=0
491 nbuck=0
492 nrbe3l = 10
493 nrbe2l = 12
494 nsmspcg=0
495 iudynain = 19833333
496 alemuscl_param%I_MUSCL_OFF = 0
497 iutitlhis=110
498 iutitlhi(1)=110
499 iutitlhi(2)=111
500 iutitlhi(3)=112
501 iutitlhi(4)=113
502 iutitlhi(5)=114
503 iutitlhi(6)=115
504 iutitlhi(7)=116
505 iutitlhi(8)=117
506 iutitlhi(9)=118
507 use_ifxm = 0
508 use_ifxs = 0
509 use_ieigm = 0
510 max_depvar=0
511C--------------------------------------------------
512C Initialize ProcessID variable for scratch filesqq
513 CALL my_getpid(my_pid)
514C--------------------------------------------------
515C Radioss userlibraries initialization
516C--------------------------------------------------
517 user_interface_nodes => nodes ! should be done only if user_interface is used
518 IF(got_userl_altname==1)THEN
519 dlibfile(1:len_userl_altname)=userl_altname(1:len_userl_altname)
520 dlibfile_size=len_userl_altname
521 ELSE
522 dlibfile='libraduser_'
523 dlibfile_size=len_trim(dlibfile)
524 ENDIF
525 userl_avail=0
526 dlib_array(1:nbr_dlib) = 0
527 CALL dyn_userlib_init(dlibfile,dlibfile_size,userl_avail,dlibtkvers,iresp,got_userl_altname,
528 1 dlib_array)
529 dyn_lib_mode = 1
530 CALL init_dyn_lib_struc(dyn_lib_mode)
531
532C Linux Issue call dummy routines to avoid loader removing object files
533 ierr=0
534 CALL usrplas_dum(ierr)
535 CALL utable_dum(ierr)
536 CALL usensor_dum(ierr)
537 CALL upidmid_dum(ierr)
538 CALL ufunc_dum(ierr)
539 CALL uaccess_dum(ierr)
540C--------------------------------------------------
541C Radioss MDS initialization
542C--------------------------------------------------
543#ifdef DNC
544 CALL mds_userlib_init(iresp,mds_avail,mds_ver,mds_path,mds_path_len)
545#else
546 mds_avail=0
547#endif
548C--------------------------------------------------
549C Error messages initialization
550C--------------------------------------------------
551C Common initialization for arrays size
552 totalfilecount = 0
553 animtotalsize = 0
554 thfilesize = 0
555 multithfilesize = 0
556 outpfilesize = 0
557 multirests = 0
558 restartfilesize = 0
559 bcsfilesize = 0
560 mumpsfilesize = 0
561 h3dtotalsize = 0
562C--------------------------------------------------
563 IF (got_input == 1) THEN
564C Get input numer & run number
565
566 CALL get_file_name_info(input,leninput,
567 * rootn,lenrootn,
568 * runn,fvers)
569
570C Open input file for reading
571 istdi = 80
572 inputnam(1:leninput)=input(1:leninput)
573 IF (got_path==1)THEN
574 fname=path(1:lenpath)//inputnam(1:leninput)
575 ELSE
576 fname(1:leninput) = inputnam(1:leninput)
577 ENDIF
578 lfname=leninput+lenpath
579
580C Save Filename with path for use in user library
581 rad_inputname(1:lfname)=fname(1:lfname)
582 len_rad_inputname=lfname
583c
584 tmp_name(1:2048) =''
585 len_tmp_name = infile_name_len
586 tmp_name=infile_name(1:infile_name_len)
587 tmp_name2(1:2048) =''
588 LEN_TMP_NAME2 = OUTFILE_NAME_LEN
589 TMP_NAME2=OUTFILE_NAME(1:OUTFILE_NAME_LEN)
590 BOOL_C = 0
591 IF(OUTFILE_BOOL) BOOL_C = 1
592
593 CALL LF_CONVERT_C_FLAT(GOT_INPUT,ROOTN,LENROOTN,FNAME,LFNAME,
594 . INAME, IERR,1024,LEN_TMP_NAME,TMP_NAME,
595 . LEN_TMP_NAME2,TMP_NAME2)
596
597 IF (IERR == 0) THEN
598 ISTDI = 80
599 OPEN(UNIT=ISTDI,FORM='formatted',FILE=INAME(1:LFNAME),
600 . ACTION='read',STATUS='old',IOSTAT=IO_ERR)
601 ELSE
602 CALL ANCMSG(MSGID=144,ANMODE=ANINFO,
603 . C1=FNAME(1:LFNAME))
604 CALL ARRET(5)
605 ENDIF
606 ENDIF
607
608C--------------------------------------------------
609C initialization bool variables for smp termination
610 PARALLEL_END = 0
611 PARALLEL_SECTION = 0
612C--------------------------------------------------
613 CALL INICOD
614 CALL COQINI
615C--------------------------------------------------
616C Get Hardware characteristics before init // (system incompatible with infiniband)
617 CALL PRINTCPU(1)
618C Init NTHREAD(=NPROC) tasks
619 coupling%FILNAM=ROOTN(1:LENROOTN)//'.cpl'
620 CALL INIPAR(coupling,ITID,1,NNODES,INPUTNAM,GOT_INPUT,NBTASK)
621C KMP_STACKSIZE/OMP_STACKSIZE Environment variable check
622 CALL SOLVER_STACKSIZE()
623C--------------------------------------------------
624C some initializations to be done after INIPAR
625
626 HELAS=HALF
627 HVISC=HALF
628 HVLIN=ZERO
629C--------------------------------------------------
630 CALL OPEN_F_SCRATCH_FILE(8,1,ROOTN,LENROOTN,IINFNA)
631
632 IF ( GOT_INPUT == 0)THEN
633 IF (ISPMD/=0) THEN
634 CALL OPEN_F_SCRATCH_FILE(IOUT,1,ROOTN,LENROOTN,IUSC4_FNAM)
635 LEN_IUSC4_FNAM=LEN_TRIM(IUSC4_FNAM)
636
637 WRITE(UNIT=IOUT,IOSTAT=IOS,FMT='(a)')
638 OPEN(UNIT=ISTDI,FORM='formatted',FILE=INPUTNAM,STATUS='old',IOSTAT=IO_ERR)
639 IF (IO_ERR/=0) THEN
640 CALL ANCMSG(MSGID=145,ANMODE=ANINFO,
641 . C1=INPUTNAM)
642 CALL ARRET(2)
643 ENDIF
644 ENDIF
645 ELSE
646 IF (ISPMD/=0) THEN
647 CALL OPEN_F_SCRATCH_FILE(IOUT,1,ROOTN,LENROOTN,IUSC4_FNAM)
648 LEN_IUSC4_FNAM=LEN_TRIM(IUSC4_FNAM)
649 WRITE(UNIT=IOUT,IOSTAT=IOS,FMT='(a)')
650 ENDIF
651 ENDIF
652C------------------------------------------------
653C Standard input reading
654C------------------------------------------------
655 CALL LECINP(IRUNN,IRFL,IRFE,H3D_DATA,FLAG_CST_AMS,DYNAIN_DATA,
656 . SENSORS,DT,OUTPUT,GLOB_THERM)
657
658 NFSKYI=5
659
660 IF(KDTINT==0 )NFSKYI=4
661
662 IF (GOT_INPUT==0)THEN
663C --------------------------------
664C when stdi indirection is used need to rebuild Engine input deck
665C For dynamical user libraries
666C --------------------------------
667 WRITE(CHRUN,'(i2.2)')IRUNN
668 RAD_INPUTNAME=ROOTNAM(1:ROOTLEN)//'d'//CHRUN
669 LEN_RAD_INPUTNAME=LEN_TRIM(RAD_INPUTNAME)
670 ENDIF
671C------------------------------------------------
672C only reading/writing ieee validated for all versions
673 IRFORM = 12
674C------------------------------------------------
675C Restart
676C------------------------------------------------
677 IF(ISPMD==ZERO) THEN
678C Create info, hist, monitor, progress and tpl files for writing implicit nonlinear solver information
679.AND..AND. IF (IMPL_S>ZEROILINE==ZEROSOLVNFO>ZERO) THEN
680 ISOLPGRS = 666666
681 FILNAM=ROOTNAM(1:ROOTLEN)//'_'//CHRUN//'.progress'
682 LEN_TMP_NAME = OUTFILE_NAME_LEN+ROOTLEN+14
683 TMP_NAME=OUTFILE_NAME(1:OUTFILE_NAME_LEN)//FILNAM(1:ROOTLEN+14)
684 OPEN(UNIT=ISOLPGRS,FILE=TMP_NAME(1:LEN_TMP_NAME),
685 . ACCESS='sequential',
686 . FORM='formatted',STATUS='unknown')
687 WRITE(ISOLPGRS,'(i4)') 0
688 WRITE(ISOLPGRS,'(e11.4)') ZERO
689 WRITE(ISOLPGRS,'(i4)') 0
690 WRITE(ISOLPGRS,'(i4)') 0
691 WRITE(ISOLPGRS,'(i4)') 0
692 CALL FLUSH(ISOLPGRS)
693 ISOLMNTR = 66666
694 FILNAM=ROOTNAM(1:ROOTLEN)//'_'//CHRUN//'.monitor'
695 LEN_TMP_NAME = OUTFILE_NAME_LEN+ROOTLEN+13
696 TMP_NAME=OUTFILE_NAME(1:OUTFILE_NAME_LEN)//FILNAM(1:ROOTLEN+13)
697 OPEN(UNIT=ISOLMNTR,FILE=TMP_NAME(1:LEN_TMP_NAME),
698 . ACCESS='sequential',
699 . FORM='formatted',STATUS='unknown')
700 ISOLHIST = 66
701 FILNAM=ROOTNAM(1:ROOTLEN)//'_'//CHRUN//'_implicit.hist'
702 LEN_TMP_NAME = OUTFILE_NAME_LEN+ROOTLEN+19
703 TMP_NAME=OUTFILE_NAME(1:OUTFILE_NAME_LEN)//FILNAM(1:ROOTLEN+19)
704 OPEN(UNIT=ISOLHIST,FILE=TMP_NAME(1:LEN_TMP_NAME),
705 . ACCESS='sequential',
706 . FORM='formatted',STATUS='unknown')
707 IF (IDTC==3) THEN
708 WRITE(ISOLHIST,1007) 'cumulative iterations','cycle',
709 . 'iteration per cycle',
710 . 'residual disp.','residual force','residual energy',
711 . 'tolerance disp.','tolerance force','tolerance energy',
712 . 'converged step','diverged step',
713 . 'time','line search coefficient','load factor','arc length'
714 ELSE
715 WRITE(ISOLHIST,1003) 'cumulative iterations','cycle',
716 . 'iteration per cycle',
717 . 'residual disp.','residual force','residual energy',
718 . 'tolerance disp.','tolerance force','tolerance energy',
719 . 'converged step','diverged step',
720 . 'time','line search coefficient'
721 ENDIF
7221003 FORMAT(A,',',A,',',A,',',A,',',A,',',A,',',A,',',A,',',A,
723 . ',',A,',',A,',',A,',',A)
7241007 FORMAT(A,',',A,',',A,',',A,',',A,',',A,',',A,',',A,',',A,
725 . ',',A,',',A,',',A,',',A,',',A,',',A)
726 ISOLINFO = 666
727 FILNAM=ROOTNAM(1:ROOTLEN)//'_'//CHRUN//'_implicit.info'
728 INPUTNAM='check_data'
729 LEN_TMP_NAME = OUTFILE_NAME_LEN+ROOTLEN+19
730 TMP_NAME=OUTFILE_NAME(1:OUTFILE_NAME_LEN)//FILNAM(1:ROOTLEN+19)
731 OPEN(UNIT=ISOLINFO,FILE=TMP_NAME(1:LEN_TMP_NAME),
732 . ACCESS='sequential',
733 . FORM='formatted',STATUS='unknown')
734 ISOLTPL = 6666
735 FILNAM=ROOTNAM(1:ROOTLEN)//'_'//CHRUN//'_implicit.tpl'
736 LEN_TMP_NAME = OUTFILE_NAME_LEN+ROOTLEN+18
737 TMP_NAME=OUTFILE_NAME(1:OUTFILE_NAME_LEN)//FILNAM(1:ROOTLEN+18)
738 INPUTNAM='check_data'
739 OPEN(UNIT=ISOLTPL,FILE=TMP_NAME(1:LEN_TMP_NAME),
740 . ACCESS='sequential',
741 . FORM='formatted',STATUS='unknown')
742 FILNAM=ROOTNAM(1:ROOTLEN)//'_'//CHRUN//'_implicit'
743 WRITE(ISOLTPL,1004) FILNAM(1:ROOTLEN+14)
744 WRITE(ISOLTPL,1005)
745 FILNAM=ROOTNAM(1:ROOTLEN)//'_'//CHRUN//'_implicit.hist'
746 WRITE(ISOLTPL,1006) FILNAM(1:ROOTLEN+19)
747 IOFF1 = 'off'
748 IOFF2 = 'off'
749 IOFF3 = 'off'
750
751.OR..OR..OR. IF (NITOL == 1 NITOL == 12 NITOL == 13 NITOL == 123) IOFF1 = 'on'
752.OR..OR..OR..OR. IF (NITOL == 0 NITOL == 2 NITOL == 12 NITOL == 23 NITOL == 123) IOFF2 = 'on'
753.OR..OR..OR. IF (NITOL == 3 NITOL == 13 NITOL == 23 NITOL == 123) IOFF3 = 'on'
754
755 FILNAM=ROOTNAM(1:ROOTLEN)
756 CALL WRITE_TPL_FILE(FILNAM(1:ROOTLEN),IOFF1,IOFF2,IOFF3)
7571004 FORMAT('*definereport(',A,', plot_file_1)')
7581005 FORMAT(' *id("HyperWorks", "Report")')
7591006 FORMAT(' *parameter(plot_file_1, plot_file_1, filename, "*", "',A,'")')
760 ENDIF
761 ENDIF
762 WRITE(CHRUN,'(i4.4)')IRUNN
763 IF(MCHECK/=0)THEN
764 IF(ISPMD==0) THEN
765 FILNAM=ROOTNAM(1:ROOTLEN)//'_'//CHRUN//'.out'
766 LEN_TMP_NAME = OUTFILE_NAME_LEN+ROOTLEN+9
767 TMP_NAME=OUTFILE_NAME(1:OUTFILE_NAME_LEN)//FILNAM(1:ROOTLEN+9)
768 INPUTNAM='check_data'
769 OPEN(UNIT=IOUT,FILE=TMP_NAME(1:LEN_TMP_NAME),ACCESS='sequential',FORM='formatted',STATUS='unknown')
770 OUTPUT%OUT_FILENAME(1:LEN_TMP_NAME)=TMP_NAME(1:LEN_TMP_NAME)
771 IO_ERRL=0
772 DO WHILE (IO_ERRL>=0)
773 READ(IOUT,'(a)',END = 1000,IOSTAT=IO_ERRL)LINE
774 ENDDO
775 1000 BACKSPACE(IOUT)
776 WRITE(IOUT,'(1x,a)')FILNAM(1:ROOTLEN+9)
777 WRITE(PROCNAM,'(i4.4)')ISPMD
778 FILNAM =ROOTNAM(1:ROOTLEN)//'_'//CHRUN//'_'//PROCNAM//'.rst'
779 LEN = ROOTLEN + 14
780 ENDIF
781 WRITE(PROCNAM,'(i4.4)')ISPMD+1
782 FILNAM =ROOTNAM(1:ROOTLEN)//'_'//CHRUN//'_'//PROCNAM//'.rst'
783 LEN = ROOTLEN + 14
784 ELSE
785 IF (ISPMD==0) THEN
786 WRITE(CHR_OLD,'(i2.2)')IRUNN
787 FILNAM=ROOTNAM(1:ROOTLEN)//'_'//CHRUN//'.out'
788
789 IF (GOT_INPUT == 0)THEN
790 INPUTNAM=ROOTNAM(1:ROOTLEN)//'d'//CHR_OLD
791 IF(INVERS>=50)
792 . INPUTNAM=ROOTNAM(1:ROOTLEN)//'_'//CHRUN//'.rad'
793 ELSE
794 INPUTNAM(1:LENINPUT)=INPUT(1:LENINPUT)
795 ENDIF
796 LEN_TMP_NAME = OUTFILE_NAME_LEN+ROOTLEN+9
797 TMP_NAME=OUTFILE_NAME(1:OUTFILE_NAME_LEN)//FILNAM(1:ROOTLEN+9)
798 OPEN(UNIT=IOUT,FILE=TMP_NAME(1:LEN_TMP_NAME),
799 . ACCESS='sequential',
800 . FORM='formatted',STATUS='unknown')
801C
802 OUTPUT%OUT_FILENAME(1:LEN_TMP_NAME)=TMP_NAME(1:LEN_TMP_NAME)
803 WRITE(IOUT,'(1x,a)')FILNAM(1:ROOTLEN+9)
804 ENDIF
805 WRITE(CHRU_M1,'(i4.4)')IRUNN-1
806 WRITE(PROCNAM,'(i4.4)')ISPMD
807 FILNAM=ROOTNAM(1:ROOTLEN)//'_'//CHRU_M1//'_'//PROCNAM
808 LEN = ROOTLEN+10
809C
810 WRITE(CHRU_M1,'(i4.4)')IRUNN-1
811 WRITE(PROCNAM,'(i4.4)')ISPMD+1
812 FILNAM=ROOTNAM(1:ROOTLEN)//'_'//CHRU_M1//'_'//PROCNAM
813 LEN = ROOTLEN+10
814 IF(CHRUN0(1:1)=='_')THEN
815 FILNAM=FILNAM(1:LEN)//CHRUN0
816 LEN = LEN+2
817 ENDIF
818 FILNAM=FILNAM(1:LEN)//'.rst'
819 LEN = LEN + 4
820 ENDIF
821 ! ---------------------------------
822 ! restarts are read into outfile folder
823 ! even if -inline is used in order to
824 ! satisfy the PO :-(
825 LEN_TMP_NAME = OUTFILE_NAME_LEN + LEN
826 TMP_NAME=OUTFILE_NAME(1:OUTFILE_NAME_LEN)//FILNAM(1:LEN)
827 ! ---------------------------------
828C
829C restart file written with binary format ieee
830C
831 DO I=1,LEN_TMP_NAME
832 IFILNAM(I)=ICHAR(TMP_NAME(I:I))
833 END DO
834 IFIL = fd_bin_rd_rst ! Parameter for binary file reading
835 CALL CUR_FIL_C(IFIL)
836 CALL OPEN_C(IFILNAM,LEN_TMP_NAME,1)
837 CALL READ_C_C(IFILNAM,LEN)
838 DO I=1,LEN
839 FILNAM(I:I) = CHAR(IFILNAM(I))
840 END DO
841C
842 IF (ISPMD==0) THEN
843 CALL RADIOSS_TITLE(IOUT ,CPUNAM,ARCHTITLE,
844 * FILNAM,ROOTLEN,CHRUN,IRESP,0)
845 CALL RADIOSS_TITLE(ISTDO,CPUNAM,ARCHTITLE,
846 * FILNAM,ROOTLEN,CHRUN,IRESP,1)
847 ENDIF
848C------------------------------------------------------------------
849C IGNORE CORE
850C------------------------------------------------------------------
851 IF(ITRACE==1) CALL SETIGNORECORE (1)
852 ITASKP1_DEF=0
853 CALL TRACE_IN(1,0,ZERO)
854 CALL TRACE_IN(17,1,ZERO)
855C------------------------------------------------
856C .rst file reading 1
857C------------------------------------------------
858 CALL RDRESA(ITSTV1 ,LHEADER ,LVARINT ,LVARREA ,PRADIOS ,
859 . PRESFIL, MULTI_FVM, H3D_DATA,
860 . PINCH_DATA,DYNAIN_DATA,INTERFACES,SENSORS,LOADS,
861 . MAT_ELEM,NAMES_AND_TITLES,SKEWS ,GLOB_THERM,PBLAST,
862 . RBE3)
863
864C------------------------------------------------
865C Test of .rst file compatibility
866C------------------------------------------------
867 IF(ISPMD==0) THEN
868.OR. IF(PRADIOS/=IRADIOSPRESFIL/=IRESFIL)THEN
869 CALL ANCMSG(MSGID=146,ANMODE=ANINFO)
870 CALL ARRET(2)
871 ENDIF
872 ENDIF
873
874 IF (ISPMD==0) THEN
875.OR. IF(ITESTV/=ITSTV1NVSIZ>MVSIZ)THEN
876 CALL ANCMSG(MSGID=147,ANMODE=ANINFO)
877 IF(DEBUG(2)<2)CALL ARRET(2)
878 ENDIF
879 ENDIF
880
881 CALL TRACE_OUT(17)
882
883
884C CALL TRACE_IN(19,0,ZERO)
885C IF(ISPMD==0) CALL XTIME0(NNODES)
886C CALL TRACE_OUT(19)
887
888
889 CALL INIPAR(coupling,ITID,3,NNODES,INPUTNAM,GOT_INPUT,NBTASK)
890
891 IF(NSPMD > 1 ) THEN
892 !CALL SPMD_ALLREDUCE_INT(GLOB_THERM%NFXFLUX,NFXFLUX_GLOB,1,"SUM ")
893 CALL SPMD_ALLREDUCE(GLOB_THERM%NFXFLUX,NFXFLUX_GLOB,1,SPMD_SUM)
894 ELSE
895 NFXFLUX_GLOB = GLOB_THERM%NFXFLUX
896 ENDIF
897.AND..OR. IF(NFXFLUX_GLOB >0 (IPARIT > 0 IPARIT == -1)) THEN
898 IPARIT=0
899 IF(ISPMD == 0) THEN
900 WRITE(6,*) "WARNING: /IMPFLUX is not compatible with",
901 . " /PARITH/ON, switching to /PARITH/OFF"
902 ENDIF
903 ENDIF
904
905 CALL TRACE_IN(17,1,ZERO)
906C end init rdresa after call xtime0
907 CALL INIRESA(H3D_DATA,PINCH_DATA,GLOB_THERM)
908 CALL TRACE_OUT(17)
909
910
911 IF(ISPMD==0) THEN
912
913 WRITE(IOUT, '(1x,a,i5)')'number of spmd domains ',
914 . NSPMD
915 IF(NBTASK(NSPMD+1) == NSPMD*NTHREAD)THEN
916C Default case with same number of THREADS per MPI domain
917 WRITE(IOUT, '(1x,a,i5)')'number of threads per domain ',
918 . NTHREAD
919 WRITE(IOUT, '(1x,a,i5)')'number of hmpp processes ',
920 . NSPMD*NTHREAD
921 WRITE(ISTDO,'(1x,a,i5)')'number of hmpp processes ',
922 . NSPMD*NTHREAD
923 ELSE
924C Specific case with different number of threads per MPI domain
925 DO I = 1, NSPMD
926 WRITE(IOUT, '(1x,a,i5,a,i5)')'domain',I,
927 . ', number of threads ',
928 . NBTASK(I)
929 END DO
930 WRITE(IOUT, '(1x,a,i5)')'number of hmpp processes ',
931 . NBTASK(NSPMD+1)
932 WRITE(ISTDO,'(1x,a,i5)')'number of hmpp processes ',
933 . NBTASK(NSPMD+1)
934
935 END IF
936
937 ! Open the qaprint file
938 CALL QAOPEN('engine')
939 ENDIF
940C
941
942 CALL PRINTCPU(2)
943
944 IF(ISPMD==0) CALL PRINTCENTER(" ",0,IOUT,1)
945
946 ! ---------------------------------------------------
947 ! Arrays, Types Allocation and initialization
948 ! ---------------------------------------------------
949 CALL TRACE_IN(17,2,ZERO)
950
951 ! Variable & sizes
952 SIGEO = NPROPGI*NUMGEO
953 SIPM = NPROPMI*NUMMAT
954
955
956 ! Finite Volume Method
957 IF (MULTI_FVM%IS_USED) THEN
958 MULTI_FVM%MUSCL = ALEMUSCL_Param%IALEMUSCL
959 ENDIF
960
961 CALL ALE_CONNECTIVITY%ALE_CONNECTIVITY_INIT()
962
963 ! Most of arrays from Restart
964 CALL RESTALLOC(ELEMENT,NODES,MULTI_FVM,H3D_DATA,PINCH_DATA,ALE_CONNECTIVITY,SEGVAR,INTERFACES,SKEWS,
965 * GLOB_THERM,RBE3)
966
967 ! Initialization
968 IGEO = 0
969 IPM = 0
970
971 ! IAF,AF : Fluid, noise
972 IF(IFIF>0)ALLOCATE (IAF(IFIF),STAT=IADIF)
973 IF(MFIF>0)ALLOCATE (AF(MFIF),STAT=IADRF)
974.OR. IF(IADRF/=0IADIF/=0)THEN
975 CALL ANCMSG(MSGID=20,ANMODE=ANINFO)
976 CALL ARRET(2)
977 ENDIF
978
979
980 ! Monvol / Airbag
981 ALLOCATE(T_MONVOL(NVOLU))
982
983 ! Table structure allocation
984 IF(NTABLE/=0)THEN
985 ALLOCATE(TABLE(NTABLE),STAT=IERR)
986 IF (IERR/=0)THEN
987 CALL ANCMSG(MSGID=20,ANMODE=ANINFO)
988 CALL ARRET(2)
989 ENDIF
990 CALL TABLE_ZERO(TABLE)
991 ELSE
992 ALLOCATE(TABLE(0))
993 END IF
994
995 NSPROC=1
996 ALLOCATE(GRAPHE(0))
997
998 !NFLOW
999 IF (NFLOW>0) THEN
1000 ALLOCATE(IFLOW(LIFLOW), RFLOW(LRFLOW))
1001 ELSE
1002 ALLOCATE(IFLOW(0), RFLOW(0))
1003 ENDIF
1004
1005 ! Heat Transfer
1006! IF (GLOB_THERM%ITHERM_FE > 0 ) THEN
1007! ALLOCATE(NODES%MCP(NUMNOD),NODES%TEMP(NUMNOD))
1008! ELSE
1009! ALLOCATE(NODES%MCP(0),NODES%TEMP(0))
1010! ENDIF
1011
1012 ! Nitsche Method : Equivalent Nodal Force allocation
1013 IF(NITSCHE > 0 ) THEN
1014 ALLOCATE(FORNEQS(3*NUMNOD))
1015 ELSE
1016 ALLOCATE(FORNEQS(0))
1017 ENDIF
1018
1019 ! Stack Ply
1020 CALL STACK_PLY_ALLOC(STACK,IPART_STACK,NPT_STACK,NS_STACK)
1021
1022 ! Drape
1023 SCDRAPE = 0
1024 STDRAPE = 0
1025 IF (NDRAPE > 0) THEN
1026 ALLOCATE(DRAPE_SH4N(NUMELC_DRAPE),DRAPE_SH3N(NUMELTG_DRAPE))
1027 ALLOCATE(DRAPEG%INDX_SH4N(NUMELC),DRAPEG%INDX_SH3N(NUMELTG))
1028 DRAPEG%INDX_SH4N = 0
1029 DRAPEG%INDX_SH3N = 0
1030 ELSE
1031 ALLOCATE(DRAPE_SH4N(0),DRAPE_SH3N(0),DRAPEG%INDX_SH4N(0),
1032 . DRAPEG%INDX_SH3N(0) )
1033 ENDIF
1034
1035 ! allocation of engine time array
1036 ALLOCATE(GLOBAL_COMP_TIME%ENGINE_TIME(IRUNN))
1037 GLOBAL_COMP_TIME%ENGINE_TIME(1:IRUNN) = ZERO
1038 GLOBAL_COMP_TIME%RUN_NBR = IRUNN
1039 GLOBAL_COMP_TIME%RST_NAME(1:1000)=''
1040 GLOBAL_COMP_TIME%RST_NAME=ROOTNAM(1:ROOTLEN)//'_'//CHRUN//'_0001.rst'
1041
1042 ! ---------------------------------------------------------------------------------------------
1043 ! .rst file reading 2
1044 ! ---------------------------------------------------------------------------------------------
1045 CALL RDRESB(AF ,IAF ,LVARREA ,IRUNN ,
1046 . MULTI_FVM ,H3D_DATA ,PINCH_DATA ,ALE_CONNECTIVITY ,T_MONVOL ,
1047 . SENSORS ,EBCS_TAB ,DYNAIN_DATA ,USER_WINDOWS ,OUTPUT ,
1048 . INTERFACES ,LOADS ,MAT_ELEM ,PYTHON ,IFLOW ,
1049 . SKEWS ,RFLOW ,LIFLOW ,LRFLOW ,IMPL_S0 ,
1050 . FORNEQS ,UNITAB,
1051 . STACK ,DRAPE_SH4N ,DRAPE_SH3N ,DRAPEG ,NDRAPE ,
1052 . GLOB_THERM ,PBLAST ,ELEMENT ,NODES ,RBE3)
1053 ! Close restart file
1054 CALL CLOSE_C
1055 ! --------------------------------------------------------------------------------------------
1056 IF (NSPMD > 1) CALL SPMD_RST_CHECK()
1057c----------
1058 NSPROC=1
1059C----------
1060 ALLOCATE(DMSPH(SDMSPH),STAT=IERR)
1061 IF (IERR/=0)THEN
1062 CALL ANCMSG(MSGID=20,ANMODE=ANINFO)
1063 CALL ARRET(2)
1064 ENDIF
1065
1066C--------------------------------------------
1067C Multimaterial law update (/ANIM/BRIC/VFRAC) (TRIMAT common value unknown in freanim.F since its read after it)
1068C Consistency with material law number is also checked here
1069C
1070C 283 : Volumetric Fraction 1 (all multimaterial laws, difference is made in dfunc6.F)
1071C 284 : Volumetric Fraction 2 (all multimaterial laws, difference is made in dfunc6.F)
1072C 285 : Volumetric Fraction 3 (law51 only)
1073C 286 : Volumetric Fraction 4 (law51 only)
1074C--------------------------------------------
1075 !TABVINT not yet read in FREANIM.F so treatment is done here.
1076 !----------------------------------!
1077 ! Testing if multimaterial law is !
1078 ! linked to a PART !
1079 ! YES: MMALE=1 !
1080 ! NO : MMALE=0 !
1081 ! +JWL EOS for burn fraction !
1082 !----------------------------------!
1083 MMALE = 0
1084 ILAW37 = 0
1085 ILAW51 = 0
1086 ILAW20 = 0
1087 DO I=1,NPART
1088 !IID = IPART(LIPART1*(I-1)+1) !internal ID
1089 !UID = IPART(LIPART1*(I-1)+5) !user ID
1090 !MLN = IPM(NPROPMI*(IMID-1)+2)!material law number
1091 IMID = IPART(LIPART1*(I-1)+1)
1092 MLN = IPM(NPROPMI*(IMID-1)+2)
1093.OR..OR..OR. IF (MLN==51 MLN==37 MLN==20 MLN == 151) MMALE = 1
1094 IF (MLN==51) ILAW51=1
1095 IF (MLN==37) ILAW37=1
1096 IF (MLN==20) ILAW20=1
1097 ENDDO
1098 !----------------------------------!
1099 ! Updating contour output request !
1100 ! according multimaterial law type!
1101 ! and usage !
1102 !----------------------------------!
1103 !COMMUN LAW51/LAW37
1104 !Removing /ANIM/ELEM/VFRAC if no multimaterial law
1105 IF(MMALE==0)THEN
1106 DO I=283,286
1107 IF(ANIM_SE(I)==1)THEN
1108 ANIM_SE(I)=0
1109 NSE_ANI=NSE_ANI-1
1110 END IF
1111 ENDDO
1112 DO I=10248,10251
1113 IF(ANIM_CE(I)==1)THEN
1114 ANIM_CE(I)=0
1115 NCE_ANI=NCE_ANI-1
1116 END IF
1117 ENDDO
1118 !/ANIM/ELEM/VFRAC not relevant in this case
1119 NN_ANI = NN_ANI - ANIM_N(20)
1120 NN_ANI = NN_ANI - ANIM_N(21)
1121 NN_ANI = NN_ANI - ANIM_N(22)
1122 NN_ANI = NN_ANI - ANIM_N(23)
1123 ANIM_N(20) = 0
1124 ANIM_N(21) = 0
1125 ANIM_N(22) = 0
1126 ANIM_N(23) = 0
1127 ENDIF
1128
1129.OR. IF(MMALE==0 INT22==0)THEN
1130 !/ANIM/ELEM/ZVFRAC not relevant in this case
1131 NN_ANI = NN_ANI - ANIM_N(24)
1132 NN_ANI = NN_ANI - ANIM_N(25)
1133 NN_ANI = NN_ANI - ANIM_N(26)
1134 NN_ANI = NN_ANI - ANIM_N(27)
1135 ANIM_N(24) = 0
1136 ANIM_N(25) = 0
1137 ANIM_N(26) = 0
1138 ANIM_N(27) = 0
1139 ENDIF
1140
1141 IF(INT22==0)THEN
1142 !/ANIM/ELEM/ZVOLD not relevant in this case
1143 !/ANIM/ELEM/ZVNEW not relevant in this case
1144 NN_ANI = NN_ANI - ANIM_N(28)
1145 NN_ANI = NN_ANI - ANIM_N(29)
1146 ANIM_N(28) = 0
1147 ANIM_N(29) = 0
1148 !/ANIM/VECT/ZVEL not relevant in this case
1149 NV_ANI = NV_ANI - ANIM_V(21)
1150 ANIM_V(21) = 0
1151 !/ANIM/VECT/ZFVEL not relevant in this case
1152 NV_ANI = NV_ANI - ANIM_V(22)
1153 ANIM_V(22) = 0
1154 !/ANIM/VECT/ZMOM not relevant in this case
1155 NV_ANI = NV_ANI - ANIM_V(23)
1156 ANIM_V(23) = 0
1157 !/ANIM/VECT/ZFP not relevant in this case
1158 NV_ANI = NV_ANI - ANIM_V(24)
1159 ANIM_V(24) = 0
1160 !/ANIM/VECT/ZFINT not relevant in this case
1161 NV_ANI = NV_ANI - ANIM_V(25)
1162 ANIM_V(25) = 0
1163 ENDIF
1164
1165 NN_ANI = NN_ANI + OUTPUT%CHECKSUM%CHECKSUM_COUNT
1166
1167 !COMMUN LAW51/LAW37
1168 !if multimaterial law then removing useless phases output (phases 3 or/and 4)
1169 IF(MMALE==1)THEN
1170 IF(N2D==0)THEN
1171 !no 2D output
1172 DO I=10248,10251
1173 IF(ANIM_CE(I)==1)THEN
1174 ANIM_CE(I)=0
1175 NCE_ANI=NCE_ANI-1
1176 END IF
1177 ENDDO
1178 !multimaterial with law51
1179 IF(TRIMAT/=4)THEN !if anim keyword present : removing phasis which are not defined
1180 IF(ANIM_SE(286)==1)THEN !removing phase4 (jwl)
1181 ANIM_SE(286)=0
1182 NSE_ANI=NSE_ANI-1
1183 END IF
1184 ENDIF
1185 !multimaterial with law37
1186 IF(TRIMAT==-2)THEN
1187 IF(ANIM_SE(285)==1)THEN !removing phase3 (only 2 phases with law37 or law20), phase 4 already removed
1188 ANIM_SE(285)=0
1189 NSE_ANI=NSE_ANI-1
1190 END IF
1191 ENDIF
1192 ELSEIF(N2D>0)THEN
1193 !no 3D output
1194 DO I=283,286
1195 IF(ANIM_SE(I)==1)THEN
1196 ANIM_SE(I)=0
1197 NSE_ANI=NSE_ANI-1
1198 END IF
1199 ENDDO
1200 !!multimaterial with law51
1201 !IF(TRIMAT/=4)THEN !if anim keyword present : removing phasis which are not defined
1202 ! IF(ANIM_CE(10251)==1)THEN !removing phase4 (jwl)
1203 ! ANIM_CE(10251)=0
1204 ! NCE_ANI=NCE_ANI-1
1205 ! END IF
1206 !0ENDIF
1207 !IF(TRIMAT==0)THEN
1208 ! DO I=10250,10251
1209 ! IF(ANIM_CE(I)==1)THEN
1210 ! ANIM_CE(I) = 0
1211 ! NCE_ANI = NCE_ANI-1
1212 ! END IF
1213 ! ENDDO
1214 !ENDIF
1215 ENDIF
1216 ENDIF
1217
1218 IF(MMALE==1)THEN
1219 IF(TRIMAT==-2)TRIMAT=0 !skip law51 loops with law37
1220 ENDIF
1221
1222 !no need to output zero contour for ALE ANIM keywords if ALE not defined. (example: schlieren +SH3N)
1223 IF(IALE+IEULER+GLOB_THERM%ITHERM == 0)THEN
1224 NCE_ANI = NCE_ANI - ANIM_CE(10672)
1225 NSE_ANI = NSE_ANI - ANIM_SE(4892)
1226 ANIM_CE(10672) = 0 !quad schlieren
1227 ANIM_SE(4892) = 0 !solid schlieren
1228 ENDIF
1229
1230 !no need to output phase contour if no law51
1231 IF(ILAW51 == 0)THEN
1232 !densities
1233 DO I=4897,4900
1234 NSE_ANI = NSE_ANI - ANIM_SE(I)
1235 ANIM_SE(I) = 0
1236 ENDDO
1237 !specific energies
1238 DO I=4901,4904
1239 NSE_ANI = NSE_ANI - ANIM_SE(I)
1240 ANIM_SE(I) = 0
1241 ENDDO
1242 !temperatures
1243 DO I=4905,4908
1244 NSE_ANI = NSE_ANI - ANIM_SE(I)
1245 ANIM_SE(I) = 0
1246 ENDDO
1247 !pressure
1248 DO I=4909,4912
1249 NSE_ANI = NSE_ANI - ANIM_SE(I)
1250 ANIM_SE(I) = 0
1251 ENDDO
1252 !plastic strain
1253 DO I=4913,4916
1254 NSE_ANI = NSE_ANI - ANIM_SE(I)
1255 ANIM_SE(I) = 0
1256 ENDDO
1257 !sound speed
1258 DO I=4917,4920
1259 NSE_ANI = NSE_ANI - ANIM_SE(I)
1260 ANIM_SE(I) = 0
1261 ENDDO
1262 !volumes
1263 DO I=4922,4925
1264 NSE_ANI = NSE_ANI - ANIM_SE(I)
1265 ANIM_SE(I) = 0
1266 ENDDO
1267 !masses
1268 DO I=4926,4929
1269 NSE_ANI = NSE_ANI - ANIM_SE(I)
1270 ANIM_SE(I) = 0
1271 ENDDO
1272 !artificial viscosities
1273 DO I=4931,4934
1274 NSE_ANI = NSE_ANI - ANIM_SE(I)
1275 ANIM_SE(I) = 0
1276 ENDDO
1277 !nodal volumetric fraction : no phase 3 & 4
1278 NN_ANI = NN_ANI - ANIM_N(22)
1279 NN_ANI = NN_ANI - ANIM_N(23)
1280 ANIM_N(22) = 0
1281 ANIM_N(23) = 0
1282 !centroid volumetric fraction : no phase 3 & 4
1283 NN_ANI = NN_ANI - ANIM_N(26)
1284 NN_ANI = NN_ANI - ANIM_N(27)
1285 ANIM_N(26) = 0
1286 ANIM_N(27) = 0
1287 ENDIF !IF(ILAW51 == 0)
1288
1289 IF(ILAW37==0)THEN
1290 !submat densities
1291 NSE_ANI = NSE_ANI - ANIM_SE(4935)
1292 NSE_ANI = NSE_ANI - ANIM_SE(4936)
1293 ANIM_SE(4935) = 0
1294 ANIM_SE(4936) = 0
1295 ENDIF
1296
1297 !no need to output phase contour if no law20
1298.AND. IF(ILAW20 == 0 ILAW51 == 0)THEN
1299 DO I= 11890,11925
1300 NCE_ANI = NCE_ANI - ANIM_CE(I)
1301 ANIM_CE(I) = 0
1302 ENDDO
1303 ENDIF !IF(ILAW20 == 0)
1304
1305 IF(ALE%GLOBAL%I_DT_NODA_ALE_ON_KEY==1) ALE%GLOBAL%I_DT_NODA_ALE_ON = 1
1306
1307C--------------------------------------------
1308 IF (NSPMD > 1) THEN
1309 PREVIOUS_RUN = GLOBAL_COMP_TIME%RUN_NBR-1
1310 CALL SPMD_ALLREDUCE(GLOBAL_COMP_TIME%STARTER_TIME,LOCAL_STARTER_TIME,1,SPMD_MAX)
1311 GLOBAL_COMP_TIME%STARTER_TIME = LOCAL_STARTER_TIME
1312 IF(PREVIOUS_RUN>0) THEN
1313 CALL SPMD_ALLREDUCE(GLOBAL_COMP_TIME%ENGINE_TIME(PREVIOUS_RUN),LOCAL_ENGINE_TIME,1,SPMD_MAX)
1314 GLOBAL_COMP_TIME%ENGINE_TIME(PREVIOUS_RUN) = LOCAL_ENGINE_TIME
1315 ENDIF
1316 ENDIF
1317C--------------------------------------------
1318C Automatic element selection for AMS - AMS deactivated if no element selected
1319.AND. IF(ISMS_SELEC==0FLAG_CST_AMS==1)THEN
1320 IDTMINS = 0
1321 CALL ANCMSG(MSGID=278,ANMODE=ANINFO_BLIND)
1322 END IF
1323C
1324 IF(IDTMINS==1)THEN
1325 CALL ANCMSG(MSGID=245,ANMODE=ANINFO_BLIND)
1326 CALL ARRET(2)
1327 END IF
1328C
1329C--------------------------------------------
1330.OR..AND. IF(IDTMINS==1(IDTMINS_OLD==1MCHECK/=0))THEN
1331 IF(IDTMINS_OLD /= 1)THEN
1332 ALLOCATE(ADMSMS(NUMNOD),RES_SMS(3*NUMNOD),STAT=IERR)
1333 IF(IERR/=0) THEN
1334 CALL ANCMSG(MSGID=19,ANMODE=ANINFO,
1335 . C1='(/dt/.../ams)')
1336 CALL ARRET(2)
1337 ENDIF
1338 ENDIF
1339 IF(IDTMINS_OLD /= 2)THEN
1340 ALLOCATE(DIAG_SMS(NUMNOD),STAT=IERR)
1341 IF(IERR/=0) THEN
1342 CALL ANCMSG(MSGID=19,ANMODE=ANINFO,
1343 . C1='(/dt/.../ams)')
1344 CALL ARRET(2)
1345 ENDIF
1346 IF(MCHECK==0)DIAG_SMS(1:NUMNOD)=NODES%MS(1:NUMNOD)
1347 ENDIF
1348 ELSEIF(IDTMINS==2)THEN
1349 IF(IDTMINS_OLD /= 2)THEN
1350 ALLOCATE(DMELC(NUMELC),DMELTG(NUMELTG),DMELS(NUMELS),
1351 . DMELTR(NUMELT),DMELP(NUMELP),DMELRT(NUMELR),
1352 . DIAG_SMS(NUMNOD),DMINT2(4*I2NSN25),
1353 . STAT=IERR)
1354 IF(IERR/=0) THEN
1355 CALL ANCMSG(MSGID=19,ANMODE=ANINFO,
1356 . C1='(/dt/.../ams)')
1357 CALL ARRET(2)
1358 ENDIF
1359 DMELC (1:NUMELC)=ZERO
1360 DMELTG(1:NUMELTG)=ZERO
1361 DMELS (1:NUMELS)=ZERO
1362 DMELTR(1:NUMELT)=ZERO
1363 DMELP (1:NUMELP)=ZERO
1364 DMELRT(1:NUMELR)=ZERO
1365 DMINT2(1:4*I2NSN25)=ZERO
1366 DIAG_SMS(1:NUMNOD)=NODES%MS(1:NUMNOD)
1367 ENDIF
1368.AND. IF(IDTMINS_OLD /= 1 IDTMINS_OLD /= 2)THEN
1369 ALLOCATE(RES_SMS(3*NUMNOD),STAT=IERR)
1370 IF(IERR/=0) THEN
1371 CALL ANCMSG(MSGID=19,ANMODE=ANINFO,
1372 . C1='(/dt/.../ams)')
1373 CALL ARRET(2)
1374 ENDIF
1375 END IF
1376 ELSEIF(IDTMINS_INT/=0)THEN
1377 IF(IDTMINS_INT_OLD==0)THEN
1378 ALLOCATE(RES_SMS(3*NUMNOD),STAT=IERR)
1379 ALLOCATE(DIAG_SMS(NUMNOD),DMINT2(4*I2NSN25),STAT=IERR)
1380 IF(IERR/=0) THEN
1381 CALL ANCMSG(MSGID=19,ANMODE=ANINFO,
1382 . C1='(/dt/.../ams)')
1383 CALL ARRET(2)
1384 ENDIF
1385 DIAG_SMS(1:NUMNOD)=NODES%MS(1:NUMNOD)
1386 END IF
1387 END IF
1388.NOT. IF(ALLOCATED(ADMSMS))ALLOCATE(ADMSMS(0))
1389.NOT. IF(ALLOCATED(DMELC ))ALLOCATE(DMELC (0))
1390.NOT. IF(ALLOCATED(DMELTG))ALLOCATE(DMELTG(0))
1391.NOT. IF(ALLOCATED(DMELS ))ALLOCATE(DMELS (0))
1392.NOT. IF(ALLOCATED(DMELTR))ALLOCATE(DMELTR(0))
1393.NOT. IF(ALLOCATED(DMELP ))ALLOCATE(DMELP (0))
1394.NOT. IF(ALLOCATED(DMELRT))ALLOCATE(DMELRT(0))
1395.NOT. IF(ALLOCATED(RES_SMS))ALLOCATE(RES_SMS(0))
1396.NOT. IF(ALLOCATED(DIAG_SMS))ALLOCATE(DIAG_SMS(0))
1397.NOT. IF(ALLOCATED(DMINT2))ALLOCATE(DMINT2(0))
1398C--------------------------------------------
1399 CALL TRACE_OUT(17)
1400 IRUN=IRUNN
1401C------------------------------------------------
1402C multimat law 151 + Navier Stokes
1403C------------------------------------------------
1404#if !defined(MUMPS5)
1405 !If Viscosity is defined (/MAT/LAW6:NU parameter) with collocated scheme (/MAT/LAW151 , viscosity is solved with linear solver
1406 ! Consequently if MUMPS is not defined then it will work only with -nspmd=1
1407.AND. IF(NSPMD>1 MULTI_FVM%NS_DIFF)THEN
1408 WRITE(6,FMT='(a)') " Fatal error: MUMPS is required to solve Navier-Stokes viscosity"
1409 CALL FLUSH(6)
1410 CALL ARRET(5)
1411 ENDIF
1412#endif
1413C------------------------------------------------
1414C Restart indicator for multimat law 151 + symmetry
1415C------------------------------------------------
1416 IF (MULTI_FVM%IS_USED) THEN
1417 MULTI_FVM%IS_RESTART = .TRUE.
1418 MULTI_FVM%SYM = N2D
1419 IF (MULTI_FVM%NS_DIFF) THEN
1420 CALL DIFFUSION%INIT_DIFFUSION(LINEAR_SOLVER, 3, IPARG, ALE_CONNECTIVITY)
1421 ENDIF
1422 ENDIF
1423C------------------------------------------------
1424C Check for springs with stiffness but no mass
1425C ... Switch for cohesive elements should also be done here ...
1426C-----------------------------------------------------
1427 IF(MCHECK==0)THEN
1428 CALL SWITCH_TO_DTNODA(
1429 . IXR ,GEO ,PM ,IPARG ,MAT_ELEM%ELBUF,
1430 . NODES%MS ,NODES%IN ,NODES%ITAB ,IGEO ,IPM ,
1431 . BUFMAT ,IPART ,IGRNOD ,IGRPART)
1432 END IF
1433C-----------------------------------------------------
1434 MAX_DEPVAR = 0
1435#ifdef DNC
1436 IF(MDS_AVAIL==1) THEN
1437 NSPMD_USER = NSPMD
1438 NTASK_USER = NTHREAD
1439 ISPMD_USER = ISPMD
1440
1441 MAX_DEPVAR=0
1442 DO I=1,MDS_NMAT
1443 MAX_DEPVAR=MAX(MAX_DEPVAR,MDS_NDEPSVAR(I) )
1444 ENDDO
1445 ALLOCATE (MDS_OUTPUT_TABLE(MDS_NMAT*MAX_DEPVAR) )
1446 ENDIF
1447#endif
1448.NOT. IF(ALLOCATED(MDS_LABEL)) THEN
1449 ALLOCATE( MDS_LABEL(1024,MDS_NMAT) )
1450 ENDIF
1451.NOT. IF(ALLOCATED(MDS_NDEPSVAR)) THEN
1452 ALLOCATE( MDS_NDEPSVAR(MDS_NMAT) )
1453 ENDIF
1454.NOT. IF(ALLOCATED(MDS_OUTPUT_TABLE) ) THEN
1455 ALLOCATE (MDS_OUTPUT_TABLE(MDS_NMAT*MAX_DEPVAR) )
1456 ENDIF
1457C------------------------------------------------
1458C engine file reading
1459C------------------------------------------------
1460 CALL TRACE_IN(16,2,ZERO)
1461 CALL LECTUR( NODES%ICODE , NODES%ISKEW , ISKWN , IXTG , IXS ,
1462 2 IXQ , ELEMENT%SHELL%IXC , IXT , IXP , IXR ,
1463 3 NODES%ITAB , NODES%ITABM1 ,NPC, IPARG, IGRV ,
1464 4 LGRAV ,IPARI,
1465 5 NPBY , LPBY ,ILINK, LLINK ,LINALE ,
1466 6 NEFLSW , NNFLSW , ICUT , IAF(IF01),
1467 7 NODES%X ,NODES%V, NODES%VR, NODES%MS ,NODES%IN ,
1468 8 SKEWS%SKEW ,TF ,RBY ,
1469 9 WA ,CRFLSW ,XCUT ,ANIN ,DAMPR ,
1470 A IGRNOD ,KXSP,NODES%WEIGHT ,FR_RBY2 ,FR_RL,
1471 B PARTSAV,IPART,PM,
1472 C MONVOL ,VOLMON, IPART_STATE,GEO,TABLE,
1473 D IFRAME,XFRAME,MAT_ELEM%ELBUF,IGEO,INTERFACES%INTBUF_TAB,
1474 E IPM ,H3D_DATA, MULTI_FVM,
1475 F IGRPART,TAG_SKINS6,ICFIELD,LCFIELD,NODES%TAG_S_RBY,
1476 G MDS_LABEL,MDS_OUTPUT_TABLE,MDS_NMAT,MAX_DEPVAR,
1477 H MDS_NDEPSVAR,STACK,IBCL,ILOADP,LLOADP,SENSORS,
1478 I DYNAIN_DATA,DT ,LOADS ,OUTPUT,NAMES_AND_TITLES,
1479 J MAT_ELEM%MAT_PARAM,GLOB_THERM,PBLAST)
1480C------------------------------------------------
1481C Close & Delete scratch file
1482 CLOSE (UNIT=IIN)
1483 LEN_IINFNA=LEN_TRIM(IINFNA)
1484 CALL DELETE_USER_FILE(IINFNA,LEN_IINFNA)
1485C------------------------------------------------
1486 CALL TRACE_OUT(16)
1487C------------------------------------------------
1488C initializations MDS
1489C------------------------------------------------
1490
1491#ifdef DNC
1492 IF (MDS_AVAIL==1) THEN
1493 CALL MDS_ENGINE_USER_INITIALIZE(NSPMD_USER,NTASK_USER,ISPMD_USER,TSTOP,
1494 * MDS_NMAT,MDS_MATID,MDS_FILES,MDS_LABEL,MDS_NDEPSVAR,MAX_DEPVAR,MDS_OUTPUT_TABLE)
1495 ENDIF
1496#endif
1497
1498C------------------------------------------------
1499 CALL TRACE_IN(19,0,ZERO)
1500 CALL TRACE_OUT(19)
1501C------------------------------------------------
1502.AND. IF ((IRAD2R==1)(R2R_SIU==1))THEN
1503 CALL R2R_INPUT_INIT(IRUNN,OUTPUT)
1504 ENDIF
1505C------------------------------------------------
1506C Check NXT FAIL for output
1507C------------------------------------------------
1508 IFAILURE_NXT = 0
1509 DO N=1,NUMMAT
1510 N_FAIL = IPM(NPROPMI*(N-1)+220)
1511 DO J=1,N_FAIL
1512 IP = (J - 1)*15
1513 IF(IPM(NPROPMI*(N-1)+111+IP)==25 ) IFAILURE_NXT = 1
1514 ENDDO
1515 ENDDO
1516 IF(IFAILURE_NXT == 1) THEN
1517 NCE_ANI=NCE_ANI + 3
1518 ANIM_CE(10253) = 1
1519 ANIM_CE(10254) = 1
1520 ANIM_CE(10255) = 1
1521 ENDIF
1522 CALL BCS0 (NODES%ICODE,NODES%ICODT,NODES%ICODR, ICODE_PLY, ICODT_PLY,IBC_PLY)
1523 IT = 1
1524 IF (NUMELTG6>0) THEN
1525 CALL CDK6BC3(NODES%ICODT ,NODES%ISKEW,ISKWN,IXTG ,
1526 1 IXTG1 ,NPBY,
1527 2 NODES%X ,SKEWS%SKEW)
1528 ENDIF
1529C
1530C bcs rigid material
1531C
1532 IF(IRIGID_MAT > 0)
1533 . CALL CONDRMAT(NODES%ICODT,NODES%ICODR, IRBYM, LNRBYM,ICODRBYM)
1534
1535C
1536 CALL TRACE_IN(18,0,ZERO)
1537
1538C------------------------------------------------
1539C ABF file check if external abf program available & initpipes
1540C------------------------------------------------
1541C
1542C number of written abf_files .abf, _a.abf .....
1543 IF (ISPMD==0) THEN
1544C
1545 NB_OF_FILES = 1
1546 DO I=1,9
1547.AND. IF(NTHGRP01(I) /= 0 ABFILE(I+1) /= 0)
1548 . NB_OF_FILES = NB_OF_FILES + 1
1549 ENDDO
1550 IF (NABFILE /= 0) THEN
1551#ifdef DNC
1552 ABFV = 0
1553 IABFPIPE=1
1554 ABFCOMP=180182702
1555
1556 IF(ISPMD==0) THEN
1557
1558 CALL OPEN_ABFPIPE(ABINP,ABOUT,IABFPIPE,1,ABFV,NB_OF_FILES)
1559
1560 IF (IABFPIPE < 0) THEN
1561 SELECT CASE (IABFPIPE)
1562 CASE (-1)
1563C--- Error: abf pas trouve
1564 CALL ANCMSG(MSGID=150,ANMODE=ANINFO)
1565 CASE (-2)
1566 CALL ANCMSG(MSGID=151,ANMODE=ANINFO,I1=ABFCOMP)
1567 END SELECT
1568 CALL CHECK_ABF(ABINP,ABOUT,-1)
1569 CALL ARRET(2)
1570C---
1571 ELSEIF (ABFV < ABFCOMP) THEN
1572 CALL ANCMSG(MSGID=152,ANMODE=ANINFO)
1573 CALL CHECK_ABF(ABINP,ABOUT,-1)
1574 CALL ARRET(2)
1575 ENDIF
1576
1577 CALL CHECK_ABF(ABINP,ABOUT,IABFPIPE)
1578
1579 ENDIF
1580#else
1581 ! ABF converter is not available
1582 WRITE(6,'(a)') '*** error /abf is not available'
1583 CALL ARRET(2)
1584#endif
1585 ENDIF
1586 ENDIF
1587C------------------------------------------------
1588C Write th file structure
1589C------------------------------------------------
1590 IF (ISPMD==0) THEN
1591 IF(TH_VERS>=40)THEN
1592 WRITE(CHR_OLD,'(i2.2)')IRUNN
1593 FILNAMTH=ROOTNAM(1:ROOTLEN)//'t'//CHR_OLD
1594 LONG= 3
1595 IF(TH_VERS>=50)THEN
1596 FILNAMTH=ROOTNAM(1:ROOTLEN)//'_'//CHRUN//'.thy'
1597 LONG = 9
1598 ENDIF
1599 IUNIT=IUHIS
1600 IFIL = fd_bin_th
1601 OUTPUT%TH%TH_WRITE_TYPE = ITFORM
1602 IFILTITL = IUTITLHIS
1603 ITHFLAG = 10
1604 CALL HIST1( FILNAMTH ,IFIL ,NTHGRP ,LONG,
1605 2 PM ,GEO ,IPART,
1606 3 SUBSETS ,OUTPUT%TH%ITHGRP ,OUTPUT%TH%ITHBUF ,IGEO,
1607 4 IPM ,IPART ,LIPART1 ,8,
1608 5 12 ,ITFORM ,ITHFLAG ,ITHVAR,
1609 6 IFILTITL,OUTPUT%TH%SITHBUF ,NAMES_AND_TITLES)
1610 WA(1:SWA) = ZERO
1611 ! Store filename for eventuel checksum computation
1612 OUTPUT%TH%TH_FILENAME(1:LEN_TRIM(FILNAMTH))=FILNAMTH(1:LEN_TRIM(FILNAMTH))
1613
1614C Multiple th files
1615 IF(NTHGRP01(1)/=0)THEN
1616 WRITE(CHR_OLD,'(i2.2)')IRUNN
1617 FILTH = CHR_OLD
1618 FILTH(3:3)= ABC(1)
1619 FILNAMTH=ROOTNAM(1:ROOTLEN)//'t'//FILTH
1620 LONG = 4
1621 IF(TH_VERS>=50) THEN
1622 FILNAMTH=ROOTNAM(1:ROOTLEN)
1623 . //'_'//CHRUN//'_'//ABC(1)//'.thy'
1624 LONG = 11
1625 ENDIF
1626 IUNIT= IUHI(1)
1627 IFIL= IUNIT
1628 IFILTITL = IUTITLHI(1)
1629 ITHFLAG = 1
1630 CALL HIST1( FILNAMTH ,IFIL ,NTHGRP1(1) ,LONG ,
1631 2 PM ,GEO ,IPART,
1632 3 SUBSETS ,OUTPUT%TH%ITHGRPA ,OUTPUT%TH%ITHBUFA ,IGEO ,
1633 4 IPM ,IPART(1+LIPART1*(NPART+NTHPART)) ,2 ,1 ,
1634 5 1 ,AFORM(1) ,ITHFLAG ,ITHVAR,
1635 6 IFILTITL,OUTPUT%TH%SITHBUFA ,NAMES_AND_TITLES)
1636 END IF
1637
1638 IF(NTHGRP01(2)/=0)THEN
1639 WRITE(CHR_OLD,'(i2.2)')IRUNN
1640 FILTH = CHR_OLD
1641 FILTH(3:3)= ABC(2)
1642 FILNAMTH=ROOTNAM(1:ROOTLEN)//'t'//filth
1643 long = 4
1644 IF(th_vers>=50) THEN
1645 filnamth=rootnam(1:rootlen)
1646 . //'_'//chrun//'_'//abc(2)//'.thy'
1647 long = 11
1648 ENDIF
1649 iunit= iuhi(2)
1650 ifil= iunit
1651 ifiltitl = iutitlhi(2)
1652 ithflag = 2
1653 CALL hist1(filnamth,ifil ,nthgrp1(2) ,long,
1654 2 pm ,geo ,ipart ,
1655 3 subsets ,output%TH%ITHGRPB ,output%TH%ITHBUFB ,igeo ,
1656 4 ipm ,ipart(1+lipart1*(npart+nthpart)+2*(npart+nthpart)),2,1,
1657 5 1 ,aform(2) ,ithflag ,ithvar,
1658 6 ifiltitl,output%TH%SITHBUFB,names_and_titles)
1659 END IF
1660
1661 IF(nthgrp01(3)/=0)THEN
1662 WRITE(chr_old,'(I2.2)')irunn
1663 filth = chr_old
1664 filth(3:3)= abc(3)
1665 filnamth=rootnam(1:rootlen)//'T'//filth
1666 long = 4
1667 IF(th_vers>=50) THEN
1668 filnamth=rootnam(1:rootlen)
1669 . //'_'//chrun//'_'//abc(3)//'.thy'
1670 long = 11
1671 ENDIF
1672 iunit= iuhi(3)
1673 ifil= iunit
1674 ifiltitl = iutitlhi(3)
1675 ithflag = 3
1676 CALL hist1(filnamth ,ifil ,nthgrp1(3) ,long,
1677 2 pm ,geo ,ipart ,
1678 3 subsets ,output%TH%ITHGRPC ,output%TH%ITHBUFC ,igeo ,
1679 4 ipm ,ipart(1+lipart1*(npart+nthpart)+4*(npart+nthpart)) ,2 ,1,
1680 5 1 ,aform(3) ,ithflag ,ithvar,
1681 6 ifiltitl,output%TH%SITHBUFC,names_and_titles)
1682 END IF
1683
1684 IF(nthgrp01(4)/=0)THEN
1685 WRITE(chr_old,'(I2.2)')irunn
1686 filth = chr_old
1687 filth(3:3)= abc(4)
1688 filnamth=rootnam(1:rootlen)//'T'//filth
1689 long = 4
1690 IF(th_vers>=50) THEN
1691 filnamth=rootnam(1:rootlen)
1692 . //'_'//chrun//'_'//abc(4)//'.thy'
1693 long = 11
1694 ENDIF
1695 iunit= iuhi(4)
1696 ifiltitl = iutitlhi(4)
1697 ifil= iunit
1698 ithflag = 4
1699 CALL hist1(filnamth,ifil,nthgrp1(4),long,
1700 2 pm ,geo ,ipart ,
1701 3 subsets ,output%TH%ITHGRPD ,output%TH%ITHBUFD ,igeo,
1702 4 ipm ,ipart(1+lipart1*(npart+nthpart)+6*(npart+nthpart)) ,2 ,1,
1703 5 1 ,aform(4) ,ithflag ,ithvar,
1704 6 ifiltitl ,output%TH%SITHBUFD,names_and_titles)
1705 END IF
1706
1707 IF(nthgrp01(5)/=0)THEN
1708 WRITE(chr_old,'(I2.2)')irunn
1709 filth = chr_old
1710 filth(3:3)= abc(5)
1711 filnamth=rootnam(1:rootlen)//'T'//filth
1712 long = 4
1713 IF(th_vers>=50) THEN
1714 filnamth=rootnam(1:rootlen)
1715 . //'_'//chrun//'_'//abc(5)//'.thy'
1716 long = 11
1717 ENDIF
1718 iunit= iuhi(5)
1719 ifil= iunit
1720 ifiltitl = iutitlhi(5)
1721 ithflag = 5
1722 CALL hist1(filnamth,ifil ,nthgrp1(5) ,long,
1723 2 pm ,geo ,ipart,
1724 3 subsets ,output%TH%ITHGRPE ,output%TH%ITHBUFE ,igeo,
1725 4 ipm ,ipart(1+lipart1*(npart+nthpart)+8*(npart+nthpart)),2,1,
1726 5 1 ,aform(5) ,ithflag ,ithvar,
1727 6 ifiltitl,output%TH%SITHBUFE,names_and_titles)
1728 END IF
1729
1730 IF(nthgrp01(6)/=0)THEN
1731 WRITE(chr_old,'(I2.2)')irunn
1732 filth = chr_old
1733 filth(3:3)= abc(6)
1734 filnamth=rootnam(1:rootlen)//'T'//filth
1735 long = 4
1736 IF(th_vers>=50) THEN
1737 filnamth=rootnam(1:rootlen)
1738 . //'_'//chrun//'_'//abc(6)//'.thy'
1739 long = 11
1740 ENDIF
1741 iunit= iuhi(6)
1742 ifil= iunit
1743 ifiltitl = iutitlhi(6)
1744 ithflag = 6
1745 CALL hist1(filnamth,ifil ,nthgrp1(6) ,long,
1746 2 pm ,geo ,ipart ,
1747 3 subsets ,output%TH%ITHGRPF ,output%TH%ITHBUFF ,igeo ,
1748 4 ipm ,ipart(1+lipart1*(npart+nthpart)+10*(npart+nthpart)),2,1,
1749 5 1 ,aform(6) ,ithflag ,ithvar,
1750 6 ifiltitl,output%TH%SITHBUFF,names_and_titles)
1751 END IF
1752
1753 IF(nthgrp01(7)/=0)THEN
1754 WRITE(chr_old,'(I2.2)')irunn
1755 filth = chr_old
1756 filth(3:3)= abc(7)
1757 filnamth=rootnam(1:rootlen)//'T'//filth
1758 long = 4
1759 IF(th_vers>=50) THEN
1760 filnamth=rootnam(1:rootlen)
1761 . //'_'//chrun//'_'//abc(7)//'.thy'
1762 long = 11
1763 ENDIF
1764 iunit= iuhi(7)
1765 ifil= iunit
1766 ifiltitl = iutitlhi(7)
1767 ithflag = 7
1768 CALL hist1(filnamth,ifil ,nthgrp1(7) ,long,
1769 2 pm ,geo ,ipart ,
1770 3 subsets ,output%TH%ITHGRPG ,output%TH%ITHBUFG ,igeo ,
1771 4 ipm,ipart(1+lipart1*(npart+nthpart)+12*(npart+nthpart)),2,1,
1772 5 1 ,aform(7) ,ithflag ,ithvar,
1773 6 ifiltitl,output%TH%SITHBUFG ,names_and_titles)
1774 END IF
1775
1776 IF(nthgrp01(8)/=0)THEN
1777 WRITE(chr_old,'(I2.2)')irunn
1778 filth = chr_old
1779 filth(3:3)= abc(8)
1780 filnamth=rootnam(1:rootlen)//'T'//filth
1781 long = 4
1782 IF(th_vers>=50) THEN
1783 filnamth=rootnam(1:rootlen)
1784 . //'_'//chrun//'_'//abc(8)//'.thy'
1785 long = 11
1786 ENDIF
1787 iunit= iuhi(8)
1788 ifil= iunit
1789 ifiltitl = iutitlhi(8)
1790 ithflag = 8
1791 CALL hist1(filnamth ,ifil ,nthgrp1(8),long,
1792 2 pm ,geo ,ipart,
1793 3 subsets ,output%TH%ITHGRPH ,output%TH%ITHBUFH ,igeo,
1794 4 ipm ,ipart(1+lipart1*(npart+nthpart)+14*(npart+nthpart)),2,1,
1795 5 1 ,aform(8) ,ithflag ,ithvar,
1796 6 ifiltitl,output%TH%SITHBUFH,names_and_titles)
1797 END IF
1798
1799 IF(nthgrp01(9)/=0)THEN
1800 WRITE(chr_old,'(I2.2)')irunn
1801 filth = chr_old
1802 filth(3:3)= abc(9)
1803 filnamth=rootnam(1:rootlen)//'T'//filth
1804 long = 4
1805 IF(th_vers>=50) THEN
1806 filnamth=rootnam(1:rootlen)
1807 . //'_'//chrun//'_'//abc(9)//'.thy'
1808 long = 11
1809 ENDIF
1810 iunit= iuhi(9)
1811 ifil= iunit
1812 ifiltitl = iutitlhi(9)
1813 ithflag = 9
1814 CALL hist1(filnamth,ifil,nthgrp1(9),long,
1815 2 pm ,geo ,ipart ,
1816 3 subsets ,output%TH%ITHGRPI ,output%TH%ITHBUFI ,igeo,
1817 4 ipm ,ipart(1+lipart1*(npart+nthpart)+16*(npart+nthpart)),2,1,
1818 5 1 ,aform(9) ,ithflag ,ithvar,
1819 6 ifiltitl,output%TH%SITHBUFI,names_and_titles)
1820 END IF
1821 ELSE
1822 WRITE(chr_old,'(I2.2)')irunn
1823 CALL hist13(
1824 1 iparg ,ixs ,ixq ,element%SHELL%IXC ,ixt ,
1825 2 ixp ,ixr ,nodes%ITAB ,pm ,
1826 3 npbyl ,ixtg ,irfe ,laccelm ,
1827 4 ipari ,ipart ,output%TH%ITHGRP ,output%TH%ITHBUF ,chr_old,names_and_titles)
1828 ENDIF
1829
1830 IF(nabfile /= 0) THEN
1831#ifdef DNC
1832 IF(abfile(1) /=0)THEN
1833 filnamabf_tmp=rootnam(1:rootlen)//'_'//chrun//'.tmp'
1834 long_tmp = 9
1835 ifilabf = 11
1836 ithflag = 10
1837 CALL abfhist1(filnamabf_tmp ,ifilabf ,nthgrp ,long_tmp,
1838 2 wa ,pm ,geo ,ipart,
1839 3 subsets ,output%TH%ITHGRP ,output%TH%ITHBUF ,igeo,
1840 4 ipm ,ipart ,lipart1 ,8,
1841 5 12 ,ithvar ,ithflag,names_and_titles,
1842 6 output%TH%SITHBUF )
1843 filnamabf=rootnam(1:rootlen)//'_'//chrun//'.abf'
1844 long = 9
1845 len_tmp_name = outfile_name_len + rootlen + long
1846 tmp_name=outfile_name(1:outfile_name_len)//filnamabf(1:rootlen+long)
1847
1848 len_tmp_name2 = outfile_name_len + rootlen + long_tmp
1849 tmp_name2=outfile_name(1:outfile_name_len)//filnamabf_tmp(1:rootlen+long_tmp)
1850 DO i=1,len_tmp_name!ROOTLEN+LONG
1851 ifilnam(i)=ichar(tmp_name(i:i))
1852 ENDDO
1853 DO i=1,len_tmp_name2!ROOTLEN+LONG_TMP
1854 ifilnam_tmp(i)=ichar(tmp_name2(i:i))
1855 ENDDO
1856C NB_INDEX_ABF = MAX(2147483647,NINT((TSTOP-TT)/DTABF(1))+1)
1857C avoid SIGFPE
1858 rmaxint=1073741824
1859 rnb_index_abf = min(rmaxint,(tstop-tt)/dtabf(1))
1860 nb_index_abf = int(rnb_index_abf)+1
1861 CALL build_abffile(abinp,about,iabfpipe,ifilnam,len_tmp_name,
1862 . ifilnam_tmp,len_tmp_name2,nb_index_abf)
1863 ENDIF
1864c
1865 IF(nthgrp01(1)/=0 .AND. abfile(2) /=0)THEN
1866 filnamabf_tmp=rootnam(1:rootlen)//'_'//chrun//'_a.tmp'
1867 long_tmp = 11
1868 ifilabf = 12
1869 ifil= iunit
1870 ithflag = 1
1871 CALL abfhist1(filnamabf_tmp ,ifilabf ,nthgrp1(1) ,long_tmp,
1872 2 wa ,pm ,geo ,ipart,
1873 3 subsets ,output%TH%ITHGRPA ,output%TH%ITHBUFA ,igeo,
1874 4 ipm ,ipart(1+lipart1*(npart+nthpart)) ,2,1,
1875 5 1 ,ithvar ,ithflag,names_and_titles,
1876 6 output%TH%SITHBUFA)
1877 filnamabf=rootnam(1:rootlen)//'_'//chrun//'_a.abf'
1878 long = 11
1879 len_tmp_name = outfile_name_len + rootlen + long
1880 tmp_name=outfile_name(1:outfile_name_len)//filnamabf(1:rootlen+long)
1881
1882 len_tmp_name2 = outfile_name_len + rootlen + long_tmp
1883 tmp_name2=outfile_name(1:outfile_name_len)//filnamabf_tmp(1:rootlen+long_tmp)
1884 DO i=1,len_tmp_name!ROOTLEN+LONG
1885 ifilnam(i)=ichar(tmp_name(i:i))
1886 ENDDO
1887
1888 DO i=1,len_tmp_name2!ROOTLEN+LONG_TMP
1889 ifilnam_tmp(i)=ichar(tmp_name2(i:i))
1890 ENDDO
1891 nb_index_abf = nint((tstop-tt)/dtabf(2))+1
1892 CALL build_abffile(abinp,about,iabfpipe,ifilnam,len_tmp_name,
1893 . ifilnam_tmp,len_tmp_name2,nb_index_abf)
1894 END IF
1895
1896 IF(nthgrp01(2)/=0 .AND. abfile(3) /=0)THEN
1897 filnamabf_tmp=rootnam(1:rootlen)//'_'//chrun//'_b.tmp'
1898 long_tmp = 11
1899 ifilabf = 13
1900 ifil= iunit
1901 ithflag = 2
1902 CALL abfhist1(filnamabf_tmp ,ifilab f ,nthgrp1(2) ,long_tmp,
1903 2 wa ,pm ,geo ,ipart,
1904 3 subsets ,output%TH%ITHGRPB,output%TH%ITHBUFB ,igeo,
1905 4 ipm ,ipart(1+lipart1*(npart+nthpart)+2*(npart+nthpart)),2,1,
1906 5 1 ,ithvar ,ithflag,names_and_titles,
1907 6 output%TH%SITHBUFB)
1908 filnamabf=rootnam(1:rootlen)//'_'//chrun//'_b.abf'
1909 long = 11
1910 len_tmp_name = outfile_name_len + rootlen + long
1911 tmp_name=outfile_name(1:outfile_name_len)//filnamabf(1:rootlen+long)
1912
1913 len_tmp_name2 = outfile_name_len + rootlen + long_tmp
1914 tmp_name2=outfile_name(1:outfile_name_len)//filnamabf_tmp(1:rootlen+long_tmp)
1915
1916 DO i=1,len_tmp_name!ROOTLEN+LONG
1917 ifilnam(i)=ichar(tmp_name(i:i))
1918 ENDDO
1919
1920 DO i=1,len_tmp_name2!ROOTLEN+LONG_TMP
1921 ifilnam_tmp(i)=ichar(tmp_name2(i:i))
1922 ENDDO
1923 nb_index_abf = nint((tstop-tt)/dtabf(3))+1
1924 CALL build_abffile(abinp,about,iabfpipe,ifilnam,len_tmp_name,
1925 . ifilnam_tmp,len_tmp_name2,nb_index_abf)
1926 END IF
1927
1928 IF(nthgrp01(3)/=0 .AND. abfile(4) /=0)THEN
1929 filnamabf_tmp=rootnam(1:rootlen)//'_'//chrun//'_c.tmp'
1930 long_tmp = 11
1931 ifilabf = 14
1932 ifil= iunit
1933 ithflag = 3
1934 CALL abfhist1(filnamabf_tmp ,ifilabf ,nthgrp1(3) ,long_tmp,
1935 2 wa ,pm ,geo ,ipart ,
1936 3 subsets ,output%TH%ITHGRPC ,output%TH%ITHBUFC ,igeo,
1937 4 ipm ,ipart ,2 ,1,
1938 5 1 ,ithvar ,ithflag,names_and_titles,
1939 6 output%TH%SITHBUFC)
1940 filnamabf=rootnam(1:rootlen)//'_'//chrun//'_c.abf'
1941 long = 11
1942 len_tmp_name = outfile_name_len + rootlen + long
1943 tmp_name=outfile_name(1:outfile_name_len)//filnamabf(1:rootlen+long)
1944
1945 len_tmp_name2 = outfile_name_len + rootlen + long_tmp
1946 tmp_name2=outfile_name(1:outfile_name_len)//filnamabf_tmp(1:rootlen+long_tmp)
1947 DO i=1,len_tmp_name!ROOTLEN+LONG
1948 ifilnam(i)=ichar(tmp_name(i:i))
1949 ENDDO
1950
1951 DO i=1,len_tmp_name2!ROOTLEN+LONG_TMP
1952 ifilnam_tmp(i)=ichar(tmp_name2(i:i))
1953 ENDDO
1954 nb_index_abf = nint((tstop-tt)/dtabf(4))+1
1955 CALL build_abffile(abinp,about,iabfpipe,ifilnam,len_tmp_name2,
1956 . ifilnam_tmp,len_tmp_name2,nb_index_abf)
1957 END IF
1958
1959 IF(nthgrp01(4)/=0 .AND. abfile(5) /=0)THEN
1960 filnamabf_tmp=rootnam(1:rootlen)//'_'//chrun//'_d.tmp'
1961 long_tmp = 11
1962 ifilabf = 15
1963 ifil= iunit
1964 ithflag = 4
1965 CALL abfhist1( filnamabf_tmp ,ifilabf ,nthgrp1(4) ,long_tmp,
1966 2 wa ,pm ,geo ,ipart,
1967 3 subsets ,output%TH%ITHGRPD ,output%TH%ITHBUFD ,igeo,
1968 4 ipm ,ipart ,2 ,1 ,
1969 5 1 ,ithvar ,ithflag,names_and_titles,
1970 6 output%TH%SITHBUFD)
1971 filnamabf=rootnam(1:rootlen)//'_'//chrun//'_d.abf'
1972 LONG = 11
1973 LEN_TMP_NAME = OUTFILE_NAME_LEN + ROOTLEN + LONG
1974 TMP_NAME=OUTFILE_NAME(1:OUTFILE_NAME_LEN)//FILNAMABF(1:ROOTLEN+LONG)
1975
1976 LEN_TMP_NAME2 = OUTFILE_NAME_LEN + ROOTLEN + LONG_TMP
1977 TMP_NAME2=OUTFILE_NAME(1:OUTFILE_NAME_LEN)//FILNAMABF_TMP(1:ROOTLEN+LONG_TMP)
1978 DO I=1,LEN_TMP_NAME!ROOTLEN+LONG
1979 IFILNAM(I)=ICHAR(TMP_NAME(I:I))
1980 ENDDO
1981 DO I=1,LEN_TMP_NAME2!ROOTLEN+LONG_TMP
1982 IFILNAM_TMP(I)=ICHAR(TMP_NAME2(I:I))
1983 ENDDO
1984 NB_INDEX_ABF = NINT((TSTOP-TT)/DTABF(5))+1
1985 CALL BUILD_ABFFILE(ABINP,ABOUT,IABFPIPE,IFILNAM,LEN_TMP_NAME,
1986 . IFILNAM_TMP,LEN_TMP_NAME2,NB_INDEX_ABF)
1987 END IF
1988.AND. IF(NTHGRP01(5)/=0 ABFILE(6) /=0)THEN
1989 FILNAMABF_TMP=ROOTNAM(1:ROOTLEN)//'_'//CHRUN//'_e.tmp'
1990 LONG_TMP = 11
1991 IFILABF = 16
1992 IFIL= IUNIT
1993 ITHFLAG = 5
1994 CALL ABFHIST1( FILNAMABF_TMP ,IFILABF,NTHGRP1(5),LONG_TMP,
1995 2 WA ,PM ,GEO ,IPART,
1996 3 SUBSETS ,OUTPUT%TH%ITHGRPE ,OUTPUT%TH%ITHBUFE ,IGEO,
1997 4 IPM ,IPART ,2 ,1 ,
1998 5 1 ,ITHVAR ,ITHFLAG,NAMES_AND_TITLES,
1999 6 OUTPUT%TH%SITHBUFE)
2000 FILNAMABF=ROOTNAM(1:ROOTLEN)//'_'//CHRUN//'_e.abf'
2001 LONG = 11
2002 LEN_TMP_NAME = OUTFILE_NAME_LEN + ROOTLEN + LONG
2003 TMP_NAME=OUTFILE_NAME(1:OUTFILE_NAME_LEN)//FILNAMABF(1:ROOTLEN+LONG)
2004
2005 LEN_TMP_NAME2 = OUTFILE_NAME_LEN + ROOTLEN + LONG_TMP
2006 TMP_NAME2=OUTFILE_NAME(1:OUTFILE_NAME_LEN)//FILNAMABF_TMP(1:ROOTLEN+LONG_TMP)
2007 DO I=1,LEN_TMP_NAME!ROOTLEN+LONG
2008 IFILNAM(I)=ICHAR(TMP_NAME(I:I))
2009 ENDDO
2010 DO I=1,LEN_TMP_NAME2!ROOTLEN+LONG_TMP
2011 IFILNAM_TMP(I)=ICHAR(TMP_NAME2(I:I))
2012 ENDDO
2013 NB_INDEX_ABF = NINT((TSTOP-TT)/DTABF(6))+1
2014 CALL BUILD_ABFFILE(ABINP,ABOUT,IABFPIPE,IFILNAM,LEN_TMP_NAME,
2015 . IFILNAM_TMP,LEN_TMP_NAME2,NB_INDEX_ABF)
2016 END IF
2017
2018.AND. IF(NTHGRP01(6)/=0 ABFILE(7) /=0)THEN
2019 FILNAMABF_TMP=ROOTNAM(1:ROOTLEN)//'_'//CHRUN//'_f.tmp'
2020 LONG_TMP = 11
2021 IFILABF = 17
2022 IFIL= IUNIT
2023 ITHFLAG = 6
2024 CALL ABFHIST1(FILNAMABF_TMP,IFILABF,NTHGRP1(6),LONG_TMP,
2025 2 WA ,PM ,GEO ,IPART ,
2026 3 SUBSETS ,OUTPUT%TH%ITHGRPF,OUTPUT%TH%ITHBUFF,IGEO ,
2027 4 IPM ,IPART ,2 ,1 ,
2028 5 1 ,ITHVAR,ITHFLAG,NAMES_AND_TITLES,
2029 6 OUTPUT%TH%SITHBUFF)
2030 FILNAMABF=ROOTNAM(1:ROOTLEN)//'_'//CHRUN//'_f.abf'
2031 LONG = 11
2032 LEN_TMP_NAME = OUTFILE_NAME_LEN + ROOTLEN + LONG
2033 TMP_NAME=OUTFILE_NAME(1:OUTFILE_NAME_LEN)//FILNAMABF(1:ROOTLEN+LONG)
2034
2035 LEN_TMP_NAME2 = OUTFILE_NAME_LEN + ROOTLEN + LONG_TMP
2036 TMP_NAME2=OUTFILE_NAME(1:OUTFILE_NAME_LEN)//FILNAMABF_TMP(1:ROOTLEN+LONG_TMP)
2037 DO I=1,LEN_TMP_NAME!ROOTLEN+LONG
2038 IFILNAM(I)=ICHAR(TMP_NAME(I:I))
2039 ENDDO
2040 DO I=1,LEN_TMP_NAME2!ROOTLEN+LONG_TMP
2041 IFILNAM_TMP(I)=ICHAR(TMP_NAME2(I:I))
2042 ENDDO
2043 NB_INDEX_ABF = NINT((TSTOP-TT)/DTABF(7))+1
2044 CALL BUILD_ABFFILE(ABINP,ABOUT,IABFPIPE,IFILNAM,LEN_TMP_NAME,
2045 . IFILNAM_TMP,LEN_TMP_NAME2,NB_INDEX_ABF)
2046 END IF
2047
2048.AND. IF(NTHGRP01(7)/=0 ABFILE(8) /=0)THEN
2049 FILNAMABF_TMP=ROOTNAM(1:ROOTLEN)//'_'//CHRUN//'_g.tmp'
2050 LONG_TMP = 11
2051 IFILABF = 18
2052 IFIL= IUNIT
2053 ITHFLAG = 7
2054 CALL ABFHIST1(FILNAMABF_TMP,IFILABF,NTHGRP1(7),LONG_TMP,
2055 2 WA ,PM ,GEO ,IPART ,
2056 3 SUBSETS ,OUTPUT%TH%ITHGRPG,OUTPUT%TH%ITHBUFG,IGEO ,
2057 4 IPM ,IPART ,2 ,1 ,
2058 5 1 ,ITHVAR,ITHFLAG,NAMES_AND_TITLES,
2059 6 OUTPUT%TH%SITHBUFG)
2060
2061 FILNAMABF=ROOTNAM(1:ROOTLEN)//'_'//CHRUN//'_g.abf'
2062 LONG = 11
2063 LEN_TMP_NAME = OUTFILE_NAME_LEN + ROOTLEN + LONG
2064 TMP_NAME=OUTFILE_NAME(1:OUTFILE_NAME_LEN)//FILNAMABF(1:ROOTLEN+LONG)
2065
2066 LEN_TMP_NAME2 = OUTFILE_NAME_LEN + ROOTLEN + LONG_TMP
2067 TMP_NAME2=OUTFILE_NAME(1:OUTFILE_NAME_LEN)//FILNAMABF_TMP(1:ROOTLEN+LONG_TMP)
2068
2069 DO I=1,LEN_TMP_NAME!ROOTLEN+LONG
2070 IFILNAM(I)=ICHAR(TMP_NAME(I:I))
2071 ENDDO
2072
2073 DO I=1,LEN_TMP_NAME2!ROOTLEN+LONG_TMP
2074 IFILNAM_TMP(I)=ICHAR(TMP_NAME2(I:I))
2075 ENDDO
2076
2077 NB_INDEX_ABF = NINT((TSTOP-TT)/DTABF(8))+1
2078 CALL BUILD_ABFFILE(ABINP,ABOUT,IABFPIPE,IFILNAM,LEN_TMP_NAME,
2079 . IFILNAM_TMP,LEN_TMP_NAME2,NB_INDEX_ABF)
2080 END IF
2081
2082.AND. IF(NTHGRP01(8)/=0 ABFILE(9) /=0)THEN
2083 FILNAMABF_TMP=ROOTNAM(1:ROOTLEN)//'_'//CHRUN//'_h.tmp'
2084 LONG_TMP = 11
2085 IFILABF = 19
2086 IFIL= IUNIT
2087 ITHFLAG = 8
2088
2089 CALL ABFHIST1(FILNAMABF_TMP ,IFILABF ,NTHGRP1(8) ,LONG_TMP,
2090 2 WA ,PM ,GEO ,IPART,
2091 3 SUBSETS ,OUTPUT%TH%ITHGRPH ,OUTPUT%TH%ITHBUFH ,IGEO,
2092 4 IPM ,IPART ,2 ,1 ,
2093 5 1 ,ITHVAR ,ITHFLAG ,NAMES_AND_TITLES,
2094 6 OUTPUT%TH%SITHBUFH)
2095
2096 FILNAMABF=ROOTNAM(1:ROOTLEN)//'_'//CHRUN//'_h.abf'
2097 LONG = 11
2098 LEN_TMP_NAME = OUTFILE_NAME_LEN + ROOTLEN + LONG
2099 TMP_NAME=OUTFILE_NAME(1:OUTFILE_NAME_LEN)//FILNAMABF(1:ROOTLEN+LONG)
2100
2101 LEN_TMP_NAME2 = OUTFILE_NAME_LEN + ROOTLEN + LONG_TMP
2102 TMP_NAME2=OUTFILE_NAME(1:OUTFILE_NAME_LEN)//FILNAMABF_TMP(1:ROOTLEN+LONG_TMP)
2103
2104 DO I=1,LEN_TMP_NAME!ROOTLEN+LONG
2105 IFILNAM(I)=ICHAR(TMP_NAME(I:I))
2106 ENDDO
2107
2108 DO I=1,LEN_TMP_NAME2!ROOTLEN+LONG_TMP
2109 IFILNAM_TMP(I)=ICHAR(TMP_NAME2(I:I))
2110 ENDDO
2111 NB_INDEX_ABF = NINT((TSTOP-TT)/DTABF(9))+1
2112
2113 CALL BUILD_ABFFILE(ABINP,ABOUT,IABFPIPE,IFILNAM,LEN_TMP_NAME,
2114 . IFILNAM_TMP,LEN_TMP_NAME2,NB_INDEX_ABF)
2115 END IF
2116
2117.AND. IF(NTHGRP01(9)/=0 ABFILE(10) /=0)THEN
2118 FILNAMABF_TMP=ROOTNAM(1:ROOTLEN)//'_'//CHRUN//'_i.tmp'
2119 LONG_TMP = 11
2120 IFILABF = 20
2121 IFIL= IUNIT
2122 ITHFLAG = 9
2123 CALL ABFHIST1(FILNAMABF_TMP ,IFILABF,NTHGRP1(9) ,LONG_TMP ,
2124 2 WA ,PM ,GEO ,IPART,
2125 3 SUBSETS ,OUTPUT%TH%ITHGRPI ,OUTPUT%TH%ITHBUFI ,IGEO ,
2126 4 IPM ,IPART(1+LIPART1*(NPART+NTHPART)+16*(NPART+NTHPART)),2,1,
2127 5 1 ,ITHVAR ,ITHFLAG,NAMES_AND_TITLES,
2128 6 OUTPUT%TH%SITHBUFI)
2129
2130 FILNAMABF=ROOTNAM(1:ROOTLEN)//'_'//CHRUN//'_i.abf'
2131 LONG = 11
2132 LEN_TMP_NAME = OUTFILE_NAME_LEN + ROOTLEN + LONG
2133 TMP_NAME=OUTFILE_NAME(1:OUTFILE_NAME_LEN)//FILNAMABF(1:ROOTLEN+LONG)
2134
2135 LEN_TMP_NAME2 = OUTFILE_NAME_LEN + ROOTLEN + LONG_TMP
2136 TMP_NAME2=OUTFILE_NAME(1:OUTFILE_NAME_LEN)//FILNAMABF_TMP(1:ROOTLEN+LONG_TMP)
2137 DO I=1,LEN_TMP_NAME!ROOTLEN+LONG
2138 IFILNAM(I)=ICHAR(TMP_NAME(I:I))
2139 ENDDO
2140
2141 DO I=1,LEN_TMP_NAME2!ROOTLEN+LONG_TMP
2142 IFILNAM_TMP(I)=ICHAR(TMP_NAME2(I:I))
2143 ENDDO
2144
2145 NB_INDEX_ABF = NINT((TSTOP-TT)/DTABF(10))+1
2146 CALL BUILD_ABFFILE(ABINP,ABOUT,IABFPIPE,IFILNAM,LEN_TMP_NAME,
2147 . IFILNAM_TMP,LEN_TMP_NAME2,NB_INDEX_ABF)
2148 END IF
2149#else
2150 ! ABF converter is not available
2151 WRITE(6,'(a)') '*** error /abf is not available'
2152 CALL ARRET(2)
2153#endif
2154 ENDIF
2155 ENDIF
2156 CALL INIT_TH0( IPARG,MAT_ELEM%ELBUF,IGEO,IXR,OUTPUT%TH,NODES%WEIGHT)
2157 CALL TRACE_OUT(18)
2158C---------------------------------------------------------------------
2159#ifdef DNC
2160C New MADYMO coupling
2161 IF (IMADCPL==1)THEN
2162 CALL INIT_MADCPL()
2163
2164C Send Data / Fem Structures
2165
2166 K1=1+LIPART1*(NPART+NTHPART)+2*9*(NPART+NTHPART)
2167 K2=K1+NUMELS
2168 K3=K2+NUMELQ
2169 K4=K3+NUMELC
2170 K5=K4+NUMELT
2171 K6=K5+NUMELP
2172 K7=K6+NUMELR
2173 K8=K7
2174 K9=K8+NUMELTG
2175 K10=K9+NUMELX
2176 K11=K10+NUMSPH
2177 CALL RAD_INIT_MADCPL(IPART, PM, GEO, NODES%ITAB,
2178 * NODES%X, NODES%MS,
2179 * ELEMENT%SHELL%IXC ,IXTG ,IXS ,
2180 * IPART(K3),IPART(K8),IPART(K1),
2181 * MADPRT, MADCLNOD, MADSH4, MADSH3,
2182 * MADSOL )
2183 END IF
2184#endif
2185C---------------------------------------------------------------------
2186 ITASK=0
2187 IRUNN_BIS = IRUNN
2188
2189 IF (ISPMD==0)THEN
2190 CALL checksum_option_outfile(OUTPUT%checksum)
2191 ENDIF
2192
2193 CALL RESOL_HEAD(ELEMENT, NODES, ITASK ,AF ,IAF ,IDATA ,RDATA,
2194 . GRAPHE ,IFLOW ,RFLOW ,
2195 . STACK ,IRUNN_BIS , TIMERS,
2196 . MULTI_FVM ,H3D_DATA ,SUBSETS ,IGRNOD ,
2197 . IGRBRIC ,IGRQUAD ,IGRSH4N ,IGRSH3N ,IGRTRUSS ,
2198 . IGRBEAM ,IGRSPRING ,IGRPART ,IGRSURF ,IGRSLIN ,
2199 . FORNEQS ,PINCH_DATA ,ALE_CONNECTIVITY,
2200 . DRAPE_SH4N ,DRAPE_SH3N ,T_MONVOL ,SENSORS ,EBCS_TAB ,
2201 . DIFFUSION ,SEGVAR ,DYNAIN_DATA ,DRAPEG ,USER_WINDOWS ,
2202 . OUTPUT ,INTERFACES ,DT ,LOADS ,MAT_ELEM , PYTHON,
2203 . NAMES_AND_TITLES, UNITAB ,SKEWS,LIFLOW ,LRFLOW ,glob_therm,PBLAST,
2204 . RBE3, coupling)
2205C---------------------------------------------------------------------
2206 CURRENT_RUN = GLOBAL_COMP_TIME%RUN_NBR
2207 CALL SPMD_REDUCE_DB(GLOBAL_COMP_TIME%ENGINE_TIME(CURRENT_RUN),RESULT,1,0,"MAX ")
2208
2209
2210#ifdef DNC
2211C New MADYMO coupling
2212 IF (IMADCPL==1)THEN
2213 CALL TERMINATE_MADCPL(N)
2214 ENDIF
2215#endif
2216C----------------------------------------------------------------------X
2217C End tasks
2218 CALL INIPAR(coupling,ITID,2,NNODES,INPUTNAM,GOT_INPUT,NBTASK)
2219C---------------------------------------------------------------------
2220 IF(MSTOP==1) THEN
2221 N = 3
2222 ELSE
2223 N = 1
2224 ENDIF
2225
2226 CALL USER_WINDOWS_CLEAN(USER_WINDOWS)
2227 CALL TH_CLEAN(OUTPUT%TH)
2228 DEALLOCATE(GRAPHE)
2229 DEALLOCATE(IFLOW, RFLOW)
2230 CALL FVDEAL()
2231
2232 CALL ARRET(N)
2233C---------------------------------------------------------------------
2234
2235 RETURN
build_abffile
void build_abffile(int *finp, int *fout, int *code_ret, int *ifil, int *len, int *ifiltmp, int *lentmp, int *nb_index_abf)
my_real
#define my_real
Definition cppsort.cpp:32
uaccess_dum
subroutine uaccess_dum(ierr)
Definition uaccess.F:29
utable_dum
subroutine utable_dum(ierr)
Definition utable.F:29
hist13
subroutine hist13(iparg, ixs, ixq, ixc, ixt, ixp, ixr, itab, pm, npby, ixtg, irfe, laccelm, ipari, ipart, ithgrp, ithbuf, chrun_old, names_and_titles)
Definition hist13.F:42
hist1
subroutine hist1(filnam, ifil, nthgrp2, long, pm, geo, ipart, subset, ithgrp, ithbuf, igeo, ipm, iparth, nparth, nvparth, nvsubth, ittyp, ithflag, ithvar, ifiltitl, sithbuf, names_and_titles)
Definition hist1.F:50
ini_msg
subroutine ini_msg()
Definition inimsg.F:31
min
#define min(a, b)
Definition macros.h:20
id
initmumps id
Definition multiplerhs_example.m:4
ale_connectivity_mod
Definition ale_connectivity_mod.F:223
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
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::check_message_definition
subroutine check_message_definition()
Definition check_mod.F:65
diffusion_mod
Definition diffusion_mod.F:36
drape_mod
Definition drape_mod.F:54
dsgraph_mod
Definition dsgraph_mod.F:31
dt_mod
Definition dt_mod.F:79
dynlib_mod
Definition dynlib_mod.F:31
dynlib_mod::dlib_array
integer, dimension(nbr_dlib) dlib_array
Definition dynlib_mod.F:65
dynlib_mod::init_dyn_lib_struc
subroutine init_dyn_lib_struc(mode)
Definition dynlib_mod.F:97
dynlib_mod::nbr_dlib
integer, parameter nbr_dlib
Definition dynlib_mod.F:63
group_mod
Definition group_mod.F:31
group_mod::subsets
type(subset_), dimension(:), allocatable, target subsets
Definition group_mod.F:45
groupdef_mod
Definition groupdef_mod.F:662
h3d_mod
Definition h3d_mod.F:308
inoutfile_mod
Definition inoutfile_mod.F:96
inoutfile_mod::infile_name_len
integer infile_name_len
Definition inoutfile_mod.F:114
inoutfile_mod::outfile_name
character(len=outfile_char_len) outfile_name
Definition inoutfile_mod.F:111
inoutfile_mod::infile_name
character(len=infile_char_len) infile_name
Definition inoutfile_mod.F:116
inoutfile_mod::outfile_name_len
integer outfile_name_len
Definition inoutfile_mod.F:109
intstamp_glob_mod
Definition intstamp_glob_mod.F:30
linear_solver_mod
Definition linear_solver_mod.F:35
linear_solver_mod::error
subroutine error()
Definition linear_solver_mod.F:119
mds_restart_mod
Definition mds_rest.mod.F:29
mds_restart_mod::mds_matid
integer, dimension(:), allocatable mds_matid
Definition mds_rest.mod.F:31
mds_restart_mod::mds_nmat
integer mds_nmat
Definition mds_rest.mod.F:30
mds_restart_mod::mds_ndepsvar
integer, dimension(:), allocatable mds_ndepsvar
Definition mds_rest.mod.F:32
mds_restart_mod::mds_label
character(len=64), dimension(:,:), allocatable mds_label
Definition mds_rest.mod.F:33
mds_restart_mod::mds_files
character, dimension(:,:,:), allocatable mds_files
Definition mds_rest.mod.F:34
message_mod
Definition message_mod.F:1249
monvol_struct_mod
Definition monvol_struct_mod.F:66
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
pinchtype_mod
Definition pinchtype_mod.F:69
qa_out_mod
Definition qa_out_mod.F:78
rad2r_mod
Definition rad2r.F:46
restmod::ixs
integer, dimension(:), allocatable, target ixs
Definition restart_mod.F:60
restmod::ipm
integer, dimension(:), allocatable ipm
Definition restart_mod.F:83
restmod::ipart
integer, dimension(:), allocatable, target ipart
Definition restart_mod.F:60
restmod::ipari
integer, dimension(:), allocatable, target ipari
Definition restart_mod.F:60
restmod::ixt
integer, dimension(:), allocatable ixt
Definition restart_mod.F:60
restmod::ixr
integer, dimension(:), allocatable ixr
Definition restart_mod.F:60
restmod::ixtg
integer, dimension(:), allocatable, target ixtg
Definition restart_mod.F:60
restmod::ixp
integer, dimension(:), allocatable ixp
Definition restart_mod.F:60
restmod::laccelm
integer, dimension(:), allocatable laccelm
Definition restart_mod.F:60
restmod::igeo
integer, dimension(:), allocatable igeo
Definition restart_mod.F:83
restmod::npbyl
integer, dimension(:), pointer npbyl
Definition restart_mod.F:108
restmod::iparg
integer, dimension(:), allocatable iparg
Definition restart_mod.F:60
restmod::ixq
integer, dimension(:), allocatable ixq
Definition restart_mod.F:60
restmod::ithvar
integer, dimension(:), allocatable ithvar
Definition restart_mod.F:60
scratchfile_mod
Definition scratchfiles_mod.F:34
scratchfile_mod::use_ieigm
integer use_ieigm
Definition scratchfiles_mod.F:37
scratchfile_mod::use_ifxm
integer use_ifxm
Definition scratchfiles_mod.F:37
scratchfile_mod::use_ifxs
integer use_ifxs
Definition scratchfiles_mod.F:37
segvar_mod
Definition segvar_mod.F:61
soltosph_mod
Definition soltosph_mod.F:32
stack_mod
Definition stack_mod.F:72
state_mod
Definition state_mod.F:54
table_glob_mod
Definition table_glob_mod.F:34
time_history_mod
Definition time_history_mod.F:35
time_history_mod::th_clean
subroutine th_clean(th)
Definition time_history_mod.F:182
time_mod
Definition time_mod.F:34
unitab_mod
Definition unitab_mod.F:513
build_msg
subroutine build_msg()
Definition build_msg.F:36
get_file_name_info
subroutine get_file_name_info(input, leni, rootname, lenr, runn, fvers, is_dyna)
Definition get_file_name_info.F:34
iniconstant
subroutine iniconstant
Definition iniconstant.F:29
initime
subroutine initime()
Definition timer.F:30
my_getpid
#define my_getpid
Definition tmpenv_c.c:47
ufunc_dum
subroutine ufunc_dum(ierr)
Definition ufunc.F:29
upidmid_dum
subroutine upidmid_dum(ierr)
Definition upidmid.F:33
usensor_dum
subroutine usensor_dum(ierr)
Definition usensor.F:30
usrplas_dum
subroutine usrplas_dum(ierr)
Definition usrplas.F:29