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 144 of file radioss2.F.

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