OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
radioss2.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| radioss2 ../engine/source/engine/radioss2.F
25!||--- called by ------------------------------------------------------
26!|| radioss0 ../engine/source/engine/radioss0.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../engine/source/output/message/message.F
29!|| arret ../engine/source/system/arret.F
30!|| bcs0 ../engine/source/constraints/general/bcs/bcs0.F
31!|| build_msg ../common_source/tools/memory/my_alloc.F90
32!|| cdk6bc3 ../engine/source/elements/sh3n/coquedk6/cdk6bc3.F
33!|| check_message_definition ../common_source/modules/check_mod.F
34!|| checksum_option_outfile ../common_source/modules/output/checksum_mod.F90
35!|| close_c ../common_source/tools/input_output/write_routtines.c
36!|| condrmat ../engine/source/materials/mat/mat013/condrmat.F
37!|| coqini ../engine/source/elements/shell/coqini.F
38!|| cur_fil_c ../common_source/tools/input_output/write_routtines.c
39!|| fvdeal ../engine/source/airbag/fvdeal.F
40!|| get_file_name_info ../engine/source/system/get_file_name_info.F
41!|| hist1 ../engine/source/output/th/hist1.F
42!|| hist13 ../engine/source/output/th/hist13.F
43!|| ini_msg ../engine/source/output/message/ini_msg.F
44!|| inicod ../engine/source/tools/univ/inicod.F
45!|| iniconstant ../engine/source/system/iniconstant.F
46!|| inipar ../engine/source/mpi/init/inipar.F
47!|| iniresa ../engine/source/output/restart/rdresa.F
48!|| init_dyn_lib_struc ../engine/share/modules/dynlib_mod.F
49!|| init_th0 ../engine/source/output/th/init_th0.F
50!|| initime ../engine/source/system/timer_mod.F90
51!|| lecinp ../engine/source/input/lecinp.F
52!|| lectur ../engine/source/input/lectur.F
53!|| lf_convert_c_flat ../engine/source/engine/lf_convert_c.c
54!|| my_getpid ../engine/source/system/pid.c
55!|| names_and_title_init ../common_source/modules/names_and_titles_mod.F
56!|| omp_get_thread_num ../engine/source/engine/openmp_stub.F90
57!|| open_c ../common_source/tools/input_output/write_routtines.c
58!|| open_f_scratch_file ../engine/source/system/open_tempfile.F
59!|| printcenter ../engine/source/engine/radioss_title.F
60!|| printcpu ../engine/source/system/timer.F
61!|| qaopen ../common_source/qa/qa_out_mod.F
62!|| r2r_input_init ../engine/source/coupling/rad2rad/r2r_input_init.F
63!|| radioss_title ../engine/source/engine/radioss_title.F
64!|| rdresa ../engine/source/output/restart/rdresa.F
65!|| rdresb ../engine/source/output/restart/rdresb.F
66!|| read_c_c ../common_source/tools/input_output/write_routtines.c
67!|| resol_head ../engine/source/engine/resol_head.F
68!|| restalloc ../engine/source/output/restart/arralloc.F
69!|| setignorecore ../engine/source/system/traceback_handler.c
70!|| solver_stacksize ../common_source/comm/stacksize.cpp
71!|| spmd_reduce_db ../engine/source/mpi/generic/spmd_reduce_db.F
72!|| spmd_rst_check ../engine/source/mpi/init/spmd_rst_check.F
73!|| stack_ply_alloc ../engine/share/modules/stack_mod.F
74!|| switch_to_dtnoda ../engine/source/time_step/switch_to_dtnoda.F
75!|| table_zero ../engine/source/tools/curve/table_tools.F
76!|| th_clean ../common_source/modules/output/time_history_mod.F
77!|| trace_in ../engine/source/system/trace_back.F
78!|| trace_out ../engine/source/system/trace_back.F
79!|| uaccess_dum ../engine/source/user_interface/uaccess.F
80!|| ufunc_dum ../engine/source/user_interface/ufunc.F
81!|| upidmid_dum ../engine/source/user_interface/upidmid.F
82!|| usensor_dum ../engine/source/user_interface/usensor.F
83!|| user_windows_clean ../common_source/modules/user_windows_mod.F
84!|| usrplas_dum ../engine/source/user_interface/usrplas.F
85!|| utable_dum ../engine/source/user_interface/utable.F
86!|| write_tpl_file ../engine/source/implicit/imp_solv.F
87!||--- uses -----------------------------------------------------
88!|| ale_connectivity_mod ../common_source/modules/ale/ale_connectivity_mod.F
89!|| ale_mod ../common_source/modules/ale/ale_mod.F
90!|| alefvm_mod ../common_source/modules/ale/alefvm_mod.F
91!|| alemuscl_mod ../common_source/modules/ale/alemuscl_mod.F
92!|| check_mod ../common_source/modules/check_mod.F
93!|| checksum_output_option_mod ../common_source/modules/output/checksum_mod.F90
94!|| connectivity_mod ../common_source/modules/connectivity.F90
95!|| coupling_adapter_mod ../engine/source/coupling/coupling_adapter.F90
96!|| diffusion_mod ../engine/share/modules/diffusion_mod.F
97!|| drape_mod ../engine/share/modules/drape_mod.F
98!|| dsgraph_mod ../engine/share/modules/dsgraph_mod.F
99!|| dt_mod ../engine/source/modules/dt_mod.F
100!|| dynlib_mod ../engine/share/modules/dynlib_mod.F
101!|| ebcs_mod ../common_source/modules/boundary_conditions/ebcs_mod.F90
102!|| file_descriptor_mod ../engine/source/modules/file_descriptor_mod.F90
103!|| glob_therm_mod ../common_source/modules/mat_elem/glob_therm_mod.F90
104!|| group_mod ../engine/share/modules/group_mod.F
105!|| groupdef_mod ../common_source/modules/groupdef_mod.F
106!|| h3d_mod ../engine/share/modules/h3d_mod.F
107!|| inoutfile_mod ../common_source/modules/inoutfile_mod.F
108!|| interfaces_mod ../common_source/modules/interfaces/interfaces_mod.F90
109!|| intstamp_glob_mod ../engine/share/modules/intstamp_glob_mod.F
110!|| linear_solver_mod ../engine/share/modules/linear_solver_mod.F
111!|| loads_mod ../common_source/modules/loads/loads_mod.F90
112!|| mat_elem_mod ../common_source/modules/mat_elem/mat_elem_mod.F90
113!|| mds_restart_mod ../common_source/modules/mds_rest.mod.F
114!|| message_mod ../engine/share/message_module/message_mod.F
115!|| monvol_struct_mod ../engine/share/modules/monvol_struct_mod.F
116!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.F90
117!|| names_and_titles_mod ../common_source/modules/names_and_titles_mod.F
118!|| nodal_arrays_mod ../common_source/modules/nodal_arrays.F90
119!|| output_mod ../common_source/modules/output/output_mod.F90
120!|| pblast_mod ../common_source/modules/loads/pblast_mod.F90
121!|| pinchtype_mod ../common_source/modules/pinchtype_mod.F
122!|| python_funct_mod ../common_source/modules/python_mod.F90
123!|| qa_out_mod ../common_source/qa/qa_out_mod.F
124!|| rad2r_mod ../engine/share/modules/rad2r.F
125!|| rbe3_mod ../common_source/modules/constraints/rbe3_mod.F90
126!|| restmod ../engine/share/modules/restart_mod.F
127!|| scratchfile_mod ../engine/share/modules/scratchfiles_mod.F
128!|| segvar_mod ../engine/share/modules/segvar_mod.F
129!|| sensor_mod ../common_source/modules/sensor_mod.F90
130!|| skew_mod ../common_source/modules/skew_mod.F90
131!|| soltosph_mod ../engine/share/modules/soltosph_mod.F
132!|| spmd_mod ../engine/source/mpi/spmd_mod.F90
133!|| stack_mod ../engine/share/modules/stack_mod.F
134!|| state_mod ../common_source/modules/state_mod.F
135!|| table_glob_mod ../engine/share/modules/table_glob_mod.F
136!|| time_history_mod ../common_source/modules/output/time_history_mod.F
137!|| time_mod ../engine/share/modules/time_mod.F
138!|| timer_mod ../engine/source/system/timer_mod.F90
139!|| unitab_mod ../common_source/modules/unitab_mod.F
140!|| user_interface_mod ../engine/source/modules/user_interface_mod.F90
141!||====================================================================
142 SUBROUTINE radioss2(IDATA,MIDATA,RDATA,MRDATA)
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 IF (impl_s>zero.AND.iline==zero.AND.solvnfo>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 IF(pradios/=iradios.OR.presfil/=iresfil)THEN
869 CALL ancmsg(msgid=146,anmode=aninfo)
870 CALL arret(2)
871 ENDIF
872 ENDIF
873
874 IF (ispmd==0) THEN
875 IF(itestv/=itstv1.OR.nvsiz>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 IF(nfxflux_glob >0 .AND. (iparit > 0 .OR. 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 IF(iadrf/=0.OR.iadif/=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 IF (mln==51 .OR. mln==37 .OR. mln==20 .OR. 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 IF(mmale==0 .OR. 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 IF(ilaw20 == 0 .AND. 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 IF(isms_selec==0.AND.flag_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 IF(idtmins==1.OR.(idtmins_old==1.AND.mcheck/=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 IF(idtmins_old /= 1 .AND. 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 IF(.NOT.ALLOCATED(admsms))ALLOCATE(admsms(0))
1389 IF(.NOT.ALLOCATED(dmelc ))ALLOCATE(dmelc(0))
1390 IF(.NOT.ALLOCATED(dmeltg))ALLOCATE(dmeltg(0))
1391 IF(.NOT.ALLOCATED(dmels ))ALLOCATE(dmels(0))
1392 IF(.NOT.ALLOCATED(dmeltr))ALLOCATE(dmeltr(0))
1393 IF(.NOT.ALLOCATED(dmelp ))ALLOCATE(dmelp(0))
1394 IF(.NOT.ALLOCATED(dmelrt))ALLOCATE(dmelrt(0))
1395 IF(.NOT.ALLOCATED(res_sms))ALLOCATE(res_sms(0))
1396 IF(.NOT.ALLOCATED(diag_sms))ALLOCATE(diag_sms(0))
1397 IF(.NOT.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 IF(nspmd>1 .AND. 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 IF(.NOT.ALLOCATED(mds_label)) THEN
1449 ALLOCATE( mds_label(1024,mds_nmat) )
1450 ENDIF
1451 IF(.NOT.ALLOCATED(mds_ndepsvar)) THEN
1452 ALLOCATE( mds_ndepsvar(mds_nmat) )
1453 ENDIF
1454 IF(.NOT.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 IF ((irad2r==1).AND.(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 IF(nthgrp01(i) /= 0 .AND. 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 IF(nthgrp01(5)/=0 .AND. 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 IF(nthgrp01(6)/=0 .AND. 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 IF(nthgrp01(7)/=0 .AND. 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 IF(nthgrp01(8)/=0 .AND. 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 IF(nthgrp01(9)/=0 .AND. 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
2236 END
2237
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)
restalloc
subroutine restalloc(element, nodes, multi_fvm, h3d_data, pinch_data, ale_connectivity, segvar, interfaces, skews, glob_therm, rbe3)
Definition arralloc.F:71
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:30
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
the
end diagonal values have been computed in the(sparse) matrix id.SOL
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
inipar
subroutine inipar(coupling, itid, icas, nnodes, input, got_input, nbtask)
Definition inipar.F:376
init_th0
subroutine init_th0(iparg, elbuf_tab, igeo, ixr, th, weight)
Definition init_th0.F:39
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
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
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_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
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
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::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
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
radioss2
subroutine radioss2(idata, midata, rdata, mrdata)
Definition radioss2.F:143
rdresa
subroutine rdresa(itstv1, lheader, lvarint, lvarrea, pradios, presfil, multi_fvm, h3d_data, pinch_data, dynain_data, interfaces, sensors, loads, mat_elem, names_and_titles, skews, glob_therm, pblast, rbe3)
Definition rdresa.F:54
iniresa
subroutine iniresa(h3d_data, pinch_data, glob_therm)
Definition rdresa.F:212
rdresb
subroutine rdresb(af, iaf, lvarrea, irunn, multi_fvm, h3d_data, pinch_data, ale_connectivity, t_monvol, sensors, ebcs_tab, dynain_data, user_windows, output, interfaces, loads, mat_elem, python, iflow, skews, rflow, liflow, lrflow, impl_s0, forneqs, unitab, stack, drape_sh4n, drape_sh3n, drapeg, ndrape, glob_therm, pblast, element, nodes, rbe3)
Definition rdresb.F:159
resol_head
subroutine resol_head(element, nodes, itask, af, iaf, idata, rdata, graphe, iflow, rflow, stack, irunn_bis, timers, multi_fvm, h3d_data, subsets, igrnod, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring, igrpart, igrsurf, igrslin, forneqs, pinch_data, ale_connectivity, drape_sh4n, drape_sh3n, t_monvol, sensors, ebcs_tab, diffusion, segvar, dynain_data, drapeg, user_windows, output, interfaces, dt, loads, mat_elem, python, names_and_titles, unitab, skews, liflow, lrflow, glob_therm, pblast, rbe3, coupling)
Definition resol_head.F:86
spmd_reduce_db
subroutine spmd_reduce_db(value, res, my_size, my_rank, my_operation)
Definition spmd_reduce_db.F:32
spmd_rst_check
subroutine spmd_rst_check()
Definition spmd_rst_check.F:35
solver_stacksize
void solver_stacksize()
Definition stacksize.cpp:60
fvdeal
subroutine fvdeal()
Definition fvmesh.F:3500
build_msg
subroutine build_msg()
Definition build_msg.F:36
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
lectur
subroutine lectur(multi_fvm, lsubmodel, is_dyna, detonators, ebcs_tab, seatbelt_converted_elements, nb_seatbelt_shells, nb_dyna_include, user_windows, output, mat_elem, names_and_titles, defaults, glob_therm, pblast, sensor_user_struct)
Definition lectur.F:533
radioss_title
subroutine radioss_title(iout, cpunam, archtitle, filnam, rootlen, chrun, iresp, iflag)
Definition radioss_title.F:33
printcenter
subroutine printcenter(array, arrlen, linout, flag)
Definition radioss_title.F:112
arret
subroutine arret(nn)
Definition arret.F:87
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
setignorecore
void setignorecore(int *on)
Definition traceback_handler.c:89
table_zero
subroutine table_zero(table)
Definition table_tools.F:31
inicod
subroutine inicod
Definition inicod.F:31
ale_connectivity_mod::t_ale_connectivity
Definition ale_connectivity_mod.F:254
diffusion_mod::t_diffusion
Definition diffusion_mod.F:49
drape_mod::drape_
Definition drape_mod.F:71
drape_mod::drapeg_
Definition drape_mod.F:79
dsgraph_mod::prgraph
Definition dsgraph_mod.F:45
linear_solver_mod::t_cg_solver
Definition linear_solver_mod.F:86
monvol_struct_mod::monvol_struct_
Definition monvol_struct_mod.F:84
names_and_titles_mod::names_and_titles_
Definition names_and_titles_mod.F:1016
segvar_mod::t_segvar
Definition segvar_mod.F:69
unitab_mod::unit_type_
Definition unitab_mod.F:520
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:41
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
read_c_c
void read_c_c(int *w, int *len)
Definition write_routtines.c:857
close_c
void close_c()
Definition write_routtines.c:298
cur_fil_c
void cur_fil_c(int *nf)
Definition write_routtines.c:477
open_c
void open_c(int *ifil, int *len, int *mod)
Definition write_routtines.c:180