OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
lectur.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!|| lectur ../engine/source/input/lectur.F
25!||--- called by ------------------------------------------------------
26!|| radioss2 ../engine/source/engine/radioss2.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../engine/source/output/message/message.F
29!|| anim_build_index_all ../engine/source/output/anim/reader/anim_build_index_all.F
30!|| arret ../engine/source/system/arret.F
31!|| chkipari ../engine/source/interfaces/interf/chkstfn3.f
32!|| fr_rlale ../engine/source/mpi/kinematic_conditions/fr_rlink1.F
33!|| fr_rlink1 ../engine/source/mpi/kinematic_conditions/fr_rlink1.F
34!|| lcbcsf ../engine/source/constraints/general/bcs/lcbcsf.F
35!|| leccut ../engine/source/tools/sect/leccut.F
36!|| lecdamp ../engine/source/input/lecdamp.F
37!|| leceig ../engine/source/input/leceig.F
38!|| lecflsw ../engine/source/fluid/lecflsw.F
39!|| lecfun ../engine/source/tools/curve/lecfun.F
40!|| lecfvbag ../engine/source/input/lecfvbag.F
41!|| lecfvbag1 ../engine/source/input/lecfvbag1.F
42!|| lecfxinp ../engine/source/input/lecfxinp.F
43!|| lech3d ../engine/source/output/h3d/h3d_build_fortran/lech3d.F
44!|| lecimpl ../engine/source/input/lectur.F
45!|| lecinv ../engine/source/input/lecinv.F
46!|| lecnoise ../engine/source/general_controls/computation/lecnoise.F
47!|| lecstat ../engine/source/input/lecstat.f
48!|| ngr2usr ../engine/source/input/freform.F
49!|| prelech3d ../engine/source/output/h3d/h3d_build_fortran/prelech3d.F90
50!|| rbyonf ../engine/source/constraints/general/rbody/rbyonf.F
51!|| read_dynain ../engine/source/output/dynain/read_dynain.F
52!|| rlink0 ../engine/source/constraints/general/rlink/rlink0.F
53!|| spmd_chkw ../engine/source/mpi/generic/spmd_chkw.f
54!|| spmd_glob_isum9 ../engine/source/mpi/interfaces/spmd_th.F
55!|| spmd_ibcast ../engine/source/mpi/generic/spmd_ibcast.F
56!|| spmd_wiout ../engine/source/mpi/generic/spmd_wiout.F
57!||--- uses -----------------------------------------------------
58!|| ale_mod ../common_source/modules/ale/ale_mod.F
59!|| alemuscl_mod ../common_source/modules/ale/alemuscl_mod.F
60!|| anim_mod ../common_source/modules/output/anim_mod.F
61!|| check_mod ../common_source/modules/check_mod.F
62!|| dt_mod ../engine/source/modules/dt_mod.F
63!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
64!|| fvbag_mod ../engine/share/modules/fvbag_mod.F
65!|| fxb_mod ../engine/share/modules/fxb_mod.F
66!|| glob_therm_mod ../common_source/modules/mat_elem/glob_therm_mod.F90
67!|| groupdef_mod ../common_source/modules/groupdef_mod.F
68!|| h3d_mod ../engine/share/modules/h3d_mod.F
69!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
70!|| intstamp_glob_mod ../engine/share/modules/intstamp_glob_mod.F
71!|| loads_mod ../common_source/modules/loads/loads_mod.f90
72!|| mat_elem_mod ../common_source/modules/mat_elem/mat_elem_mod.F90
73!|| message_mod ../engine/share/message_module/message_mod.F
74!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.F90
75!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
76!|| names_and_titles_mod ../common_source/modules/names_and_titles_mod.F
77!|| output_mod ../common_source/modules/output/output_mod.F90
78!|| outputs_mod ../common_source/modules/outputs_mod.F
79!|| pblast_mod ../common_source/modules/loads/pblast_mod.F90
80!|| prelech3d_mod ../engine/source/output/h3d/h3d_build_fortran/prelech3d.F90
81!|| sensor_mod ../common_source/modules/sensor_mod.F90
82!|| stack_mod ../engine/share/modules/stack_mod.f
83!|| state_mod ../common_source/modules/state_mod.F
84!|| table_mod ../engine/share/modules/table_mod.F
85!||====================================================================
86 SUBROUTINE lectur(ICODE ,ISKEW ,ISKWN ,IXTG ,IXS ,
87 2 IXQ ,IXC ,IXT ,IXP ,IXR ,
88 3 ITAB ,ITABM1,NPC ,IPARG ,IGRV ,
89 4 IBGR ,IPARI ,
90 5 NPBY ,LPBY ,NNLINK ,LLINK ,LINALE,
91 6 NEFLSW ,NNFLSW,ICUT ,INOISE ,
92 7 X ,V ,VR ,MS ,IN ,
93 8 SKEW ,PLD ,RBY ,
94 9 WA ,CRFLSW,XCUT ,ANIN ,DAMPR ,
95 A IGRNOD ,KXSP ,WEIGHT ,FR_RBY2,FR_RL ,
96 B PARTSAV,IPART ,PM ,
97 C MONVOL ,VOLMON,IPART_STATE,GEO,TABLE ,
98 D IFRAME ,XFRAME,ELBUF_STR,IGEO ,INTBUF_TAB,
99 E IPM ,H3D_DATA, MULTI_FVM,
100 F IGRPART ,TAG_SKINS6,ICFIELD,LCFIELD,TAGSLV_RBY,
101 G MDS_LABEL,MDS_OUTPUT_TABLE,MDS_NMAT,MAX_DEPVAR,
102 H MDS_NDEPSVAR,STACK,IBCL,ILOADP,LLOADP,SENSORS,
103 I DYNAIN_DATA,DT ,LOADS ,OUTPUT,NAMES_AND_TITLES,
104 J MAT_PARAM,GLOB_THERM,PBLAST)
105C-----------------------------------------------
106C M o d u l e s
107C-----------------------------------------------
108 USE table_mod
109 USE message_mod
110 USE mat_elem_mod
111 USE intbufdef_mod
112 USE stack_mod
113 USE h3d_mod
114 USE multi_fvm_mod
115 USE groupdef_mod
116 USE intstamp_glob_mod
117 USE fvbag_mod
118 USE check_mod
119 USE sensor_mod
120 USE anim_mod
121 USE outputs_mod
122 USE state_mod
123 USE alemuscl_mod , only:alemuscl_param
124 USE ale_mod
125 USE dt_mod
126 USE loads_mod
127 USE output_mod
128 USE fxb_mod
129 USE my_alloc_mod
130 USE names_and_titles_mod
131 USE elbufdef_mod
132 USE glob_therm_mod
133 USE pblast_mod
134 USE prelech3d_mod
135C-----------------------------------------------
136C I m p l i c i t T y p e s
137C-----------------------------------------------
138#include "implicit_f.inc"
139C-----------------------------------------------
140C C o m m o n B l o c k s
141C-----------------------------------------------
142#include "com01_c.inc"
143#include "com04_c.inc"
144#include "com06_c.inc"
145#include "com08_c.inc"
146#include "com09_c.inc"
147#include "param_c.inc"
148#include "warn_c.inc"
149#include "scr02_c.inc"
150#include "scr03_c.inc"
151#include "scr05_c.inc"
152#include "scr06_c.inc"
153#include "scr07_c.inc"
154#include "scr14_c.inc"
155#include "scr16_c.inc"
156#include "scr17_c.inc"
157#include "scr18_c.inc"
158#include "cong1_c.inc"
159#include "cong2_c.inc"
160#include "scrfs_c.inc"
161#include "stati_c.inc"
162#include "statr_c.inc"
163#include "units_c.inc"
164#include "scrcut_c.inc"
165#include "scrnoi_c.inc"
166#include "parit_c.inc"
167#include "chara_c.inc"
168#include "task_c.inc"
169#include "sphcom.inc"
170#include "impl1_c.inc"
171#include "tabsiz_c.inc"
172#include "remesh_c.inc"
173#include "sms_c.inc"
174#include "rad2r_c.inc"
175#include "inter22.inc"
176#include "userlib.inc"
177#include "spmd_c.inc"
178#include "intstamp_c.inc"
179#include "couple_c.inc"
180C-----------------------------------------------
181C D u m m y A r g u m e n t s
182C-----------------------------------------------
183 INTEGER IPARG(NPARG,NGROUP), IPARI(NPARI,*), IXS(NIXS,*),
184 . IXQ(NIXQ,*), IXC(NIXC,*), IXT(NIXT,*), IXP(NIXP,*),
185 . IXR(NIXR,*), IXTG(NIXTG,*),ITAB(*), ITABM1(*),
186 . ISKWN(LISKN,*), NPBY(NNPBY,*),NNLINK(*) ,LLINK(*) ,LINALE(*),
187 . ICODE(*) ,ISKEW(*),NPC(*),NEFLSW(*),NNFLSW(*),ICUT(*),
188 . INOISE(*),IGRV(NIGRV,*),IBGR(*),
189 . LPBY(*),KXSP(NISP,*),WEIGHT(*),FR_RBY2(*),
190 . FR_RL(NSPMD+2,*),
191 . IPART(*), MONVOL(*), IPART_STATE(*),IFRAME(LISKN,*),
192 . IGEO(NPROPGI,*),IPM(NPROPMI,*),TAG_SKINS6(*),
193 . ICFIELD(SIZFIELD,*), LCFIELD(*), TAGSLV_RBY(*),
194 . MDS_OUTPUT_TABLE(MDS_NMAT*MAX_DEPVAR),MDS_NMAT,MAX_DEPVAR,
195 . MDS_NDEPSVAR(*),IBCL(*),ILOADP(*),LLOADP(*)
196 my_real
197 . SKEW(LSKEW,*),RBY(*),MS(*),IN(*),ANIN(*),
198 . X(*), V(*), VR(*),WA(*),PLD(*),CRFLSW(*),XCUT(*),
199 . DAMPR(NRDAMP,*), PARTSAV(*),PM(NPROPM,*),
200 . VOLMON(*),GEO(NPROPG,*),XFRAME(NXFRAME,*)
201 TYPE(ttable) TABLE(*)
202 TYPE(ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_STR
203 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
204 TYPE (H3D_DATABASE) :: H3D_DATA
205 TYPe (MULTI_FVM_STRUCT) :: MULTI_FVM
206 TYPE(GROUP_) ,DIMENSION(NGRNOD) :: IGRNOD
207 TYPE(GROUP_) ,DIMENSION(NGRPART) :: IGRPART
208 CHARACTER MDS_LABEL(1024,MDS_NMAT)
209 TYPE (STACK_PLY) :: STACK
210 TYPE (SENSORS_) ,INTENT(INOUT) ,TARGET :: SENSORS
211 TYPE (DYNAIN_DATABASE), INTENT(INOUT) :: DYNAIN_DATA
212 TYPE (DT_), INTENT(INOUT) :: DT
213 TYPE (LOADS_), INTENT(IN) :: LOADS
214 TYPE(output_), INTENT(INOUT) :: OUTPUT !< output structure
215 TYPE(NAMES_AND_TITLES_),INTENT(INOUT) :: NAMES_AND_TITLES !< NAMES_AND_TITLES host the input deck names and titles for outputs
216 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
217 type (glob_therm_) ,intent(inout) :: glob_therm
218 type (pblast_) ,intent(inout) :: pblast
219C-----------------------------------------------
220C L o c a l V a r i a b l e s
221C-----------------------------------------------
222 INTEGER NLEC(16), I, NSLIOF, NELSOF, NELQOF, NDAMPN,
223 . nelcof, neltof, nelpof, nelrof, nintch, nubcsn, itfor0, irfe0,
224 . irfl0, k, nelof, nn, nbc, il, ii, j, klg, kug, nblk, ng,
225 . ity, nel, nft, iad, igof, k1, k2, n, i1, i2, i3, ir1, ir2, ir3,
226 . isk, ic, icr, m1, m2, im, noint, nsearch, jpri, npts,
227 . nrbyon, nrbyof, neltgof,niniv,nsliofn,nsliofs,kk,nty,
228 . nsn,nrts,nrtm,nmn,l,ncpri1,nrlink0,nalelk0,
229 . nsphof,iwiout,nlecsph(10),nfxinp,ncrst1,neigoff,neoff,
230 . naleof,neulerof,nthermof,nfvmesh,mlw,ll,isk1,isk2,
231 . nfvmodi,iok, alestrl(0:8), nalelink0, gr_id,
232 . nalelk_starter, uid, nalelk_removed, jale,userl_count,
233 . idel2,is,
234 . stext1,multirest1,nlpri1,lowmach_opt,ierror,
235 . ninterskid,ivolu,ifv,ifv_type,istatg_p,
236 . k3,k4,k5,k6,k7,k8,k9,ninefricg,ns,ni,npartof,k10,k11
237
238 INTEGER :: NBPARTALEON, NBPARTALEOFF, PARTID, ISON, ION, IOFF, NBALEON_PART, NBALEOFF_PART
239 INTEGER, DIMENSION(:), ALLOCATABLE :: ALEOFF_PARTIDS_TMP, ALEOFF_PARTIDS,
240 . aleon_partids_tmp, aleon_partids
241 INTEGER, DIMENSION(:), ALLOCATABLE :: ALELIN_ON_OFF
242 my_real
243 . TFI, DTF, DTM, ALP, GAM,
244 . CV1, CV2, CV3, VOLM, TSTART, TFIN,DT_INPUT, DT_CRIT
245 CHARACTER*9 Label1,Label2,Label3,Label4,Label5,Label6,Label7,Label8
246 CHARACTER*16 ALEform(0:8),Cale1,Cale2,CHAR1,CHAR2,Label9
247 CHARACTER*3 :: LABEL_DEF,LABEL_ROT
248 CHARACTER(LEN=4), DIMENSION(20) :: TITLE
249 my_real eta1,eta2,MIN_ASPECT,MIN_DEFV
250 my_real, DIMENSION(:), POINTER :: OFFG
251 TYPE (SENSOR_STR_) ,DIMENSION(:) ,POINTER :: SENSOR_TAB
252 LOGICAL IS_ALREADY_PRINTED
253 REAL(KIND=8) :: DTH
254 REAL(KIND=8), DIMENSION(9) :: DTH1
255 INTEGER, DIMENSION(:), ALLOCATABLE :: IPARTOF
256C-----------------------------------------------
257C E x t e r n a l F u n c t i o n s
258C-----------------------------------------------
259 INTEGER,EXTERNAL :: NGR2USR
260C-----------------------------------------------
261 ! setting NOINT in IPARI(13)
262 ierr = 0
263 dt_input= zero
264 DO i=1,ninter
265 ipari(13,i)=10
266 IF(ipari(15,i) == 0) ipari(15,i)=i
267 ENDDO
268 sensor_tab => sensors%SENSOR_TAB(1:sensors%NSENSOR)
269
270 CALL chkipari(ipari)
271
272 READ (iin,'(20A4)') title
273 READ (iin,'(4F16.0,I8,I10,2I8)')tfi,dth,dtf,dtm,ncpri1,ncrst1,multirest1,nlpri1
274 READ (iin,'(5F16.0)')(dth1(i),i=1,5)
275 READ (iin,'(4F16.0)')(dth1(i+5),i=1,4)
276 READ (iin,'(6F10.0)')alp,gam,cv1,cv2,cv3,volm
277 READ (iin,'(I8)') lowmach_opt
278 READ (iin,'(10I8)') nsliof,nelsof,nelqof,nelcof,neltof,nelpof,nelrof,neltgof,nsliofn,nsliofs
279 READ (iin,'(I8)') nsphof
280 READ (iin,'(4I8)') naleof,neulerof,nthermof,npartof
281 READ (iin,'(2I8)') nrlink0,nalelk0
282 READ (iin,'(2I8)') nalelink0
283C--------------
284C ALE ON / OFF
285C--------------
286 READ (iin, '(I8, I8)') nbpartaleon, nbpartaleoff
287 IF(mcheck == 0)THEN
288 nrlink=nrlink0
289 nalelk=nalelk0
290 nalelink=nalelink0
291 irprev = 0
292 ENDIF
293 nrbyon = 0
294 nrbyof = 0
295 nubcsn = 0
296 niniv = 0
297 READ (iin,'(2I8)') nubcsn,niniv
298 READ (iin,'(3I8)') nintch,nrbyon,nrbyof
299 READ (iin,'(I8)') ndampn
300 READ(iin,'(I8)') nfxinp
301C-----
302 READ(iin,'(2I8)') neigoff, neoff
303 READ(iin,'(2I8)') nfvmesh, nfvmodi
304C-----
305 IF(ncpri1 == 0) ncpri1=1
306 IF(mcheck == 0)ncpri = ncpri1
307C-----
308 IF(mcheck == 0)nlpri = nlpri1
309C
310 IF(ncrst1 == 0.AND.mcheck == 0) ncrst=10000000
311 IF(tfi /= 0.0) tstop=tfi
312C
313 IF(toutp0 /= zero) toutp = toutp0
314 IF(dtoutp0 > zero) dtoutp= dtoutp0
315 IF(dtoutp<=zero) toutp = ep30
316 IF (toutp < tt-dt2.AND.dtoutp > zero)toutp = toutp
317 . + int((tt-dt2-toutp)/dtoutp)*dtoutp
318 IF (toutp < tt-dt2)toutp = toutp+dtoutp
319C
320C .sta files
321 IF(tstat0 /= zero) tstat = tstat0
322 IF(dtstat0 > zero) dtstat= dtstat0
323 IF(dtstat<=zero) tstat = ep30
324 IF (tstat < tt-dt2.AND.dtstat > zero)tstat = tstat
325 . + int((tt-dt2-tstat)/dtstat)*dtstat
326 IF (tstat < tt-dt2)tstat = tstat+dtstat
327C .dynain files
328 IF(dynain_data%TDYNAIN0 /= zero) dynain_data%TDYNAIN = dynain_data%TDYNAIN0
329 IF(dynain_data%DTDYNAIN0 > zero) dynain_data%DTDYNAIN= dynain_data%DTDYNAIN0
330 IF(dynain_data%DTDYNAIN<=zero) dynain_data%TDYNAIN = ep30
331 IF (dynain_data%TDYNAIN < tt-dt2.AND.dynain_data%DTDYNAIN > zero)dynain_data%TDYNAIN = dynain_data%TDYNAIN
332 . + int((tt-dt2-dynain_data%TDYNAIN)/dynain_data%DTDYNAIN)*dynain_data%DTDYNAIN
333 IF (dynain_data%TDYNAIN< tt-dt2)dynain_data%TDYNAIN = dynain_data%TDYNAIN+dynain_data%DTDYNAIN
334C abf files
335 DO i=1,10
336 IF(dtabf0(i) > zero) dtabf(i)= dtabf0(i)
337 IF(dtabfwr0(i) > zero) dtabfwr(i)= dtabfwr0(i)
338 ENDDO
339 IF (abfile(1) /= 0) tabfis(1) = tt
340C
341 IF(dth /= zero.AND.mcheck == 0) output%TH%DTHIS=dth
342 DO i= 1, 9
343 IF(dth1(i) /= zero.AND.mcheck == 0) output%TH%DTHIS1(i)=dth1(i)
344 ENDDO
345c h3d files
346 h3d_data%DTH3D = zero
347 h3d_data%TH3D_STOP = ep30
348 IF(h3d_data%TH3D0 /= zero) h3d_data%TH3D = h3d_data%TH3D0
349 IF(h3d_data%DTH3D0 > zero) h3d_data%DTH3D= h3d_data%DTH3D0
350 IF(h3d_data%TH3D_STOP0 > zero .AND. h3d_data%TH3D_STOP0 /= ep20)THEN
351 h3d_data%TH3D_STOP = h3d_data%TH3D_STOP0
352 ENDIF
353 IF(h3d_data%DTH3D<=zero) THEN
354 h3d_data%TH3D = ep30
355 h3d_data%TH3D_STOP = ep30
356 ENDIF
357 IF (h3d_data%TH3D < tt-dt2.AND. h3d_data%DTH3D > zero)
358 . h3d_data%TH3D = h3d_data%TH3D + int((tt-dt2-h3d_data%TH3D)/h3d_data%DTH3D)*h3d_data%DTH3D
359 IF (h3d_data%TH3D < tt-dt2)h3d_data%TH3D = h3d_data%TH3D+h3d_data%DTH3D
360C
361 IF(mcheck == 0)THEN
362 ale%GRID%VGY0=zero
363 ale%GRID%VGZ0=zero
364 IF(dtf /= zero) dtfac=dtf
365 IF(dtm /= zero) dtmin=dtm
366 IF(alp /= zero) ale%GRID%ALPHA=alp
367 IF(gam /= zero) ale%GRID%GAMMA=gam
368 IF(cv1 /= zero) ale%GRID%VGX =cv1
369 IF(cv2 /= zero) ale%GRID%VGY =cv2
370 IF(cv3 /= zero) ale%GRID%VGZ =cv3
371 IF(ale%GRID%NWALE_ENGINE == 2)THEN
372 IF(alp /= zero) THEN
373 ale%GRID%ALPHA = alp/(-ale%GRID%VGX+sqrt(ale%GRID%VGX**2+ one))
374 dt_input = alp
375 ELSE
376 dt_input = ale%GRID%ALPHA*(-ale%GRID%VGX+sqrt(ale%GRID%VGX**2+ one))
377 ENDIF
378 ENDIF
379 IF(ale%GRID%NWALE_ENGINE == 1.AND.alp == zero) ale%GRID%ALPHA=ep30
380 IF(volm /= zero)volmin=volm
381 IF(int22>0)THEN
382 dtfac22 = one
383 IF(dtfac>half)dtfac22 = half / dtfac
384 ENDIF
385 ENDIF
386C
387 IF(mcheck==0)THEN
388 IF(idtmins/=0)THEN
389 IF(dtmins == zero)dtmins = dtmin
390 IF(dtfacs == zero)dtfacs = dtfac
391 IF(tol_sms == zero) tol_sms = em03
392 IF(nsmspcg==0)nsmspcg=1000
393 idtgrs =idtgrs_old
394 IF(ispmd==0)THEN
395C
396 IF(idtmins==2.AND.irest_mselt==0)THEN
397 CALL ancmsg(msgid=120,anmode=aninfo_blind)
398 CALL arret(2)
399 END IF
400C
401C IF((IDTMINS==2.OR.IDTMINS_INT/=0).AND.NODADT/=0)THEN
402C CALL ANCMSG(MSGID=209,ANMODE=ANINFO_BLIND)
403C CALL ARRET(2)
404C END IF
405 END IF
406 ENDIF
407 IF(idtmins_int/=0)THEN
408 IF(dtmins_int == zero)dtmins_int = dtmin
409 IF(dtfacs_int == zero)dtfacs_int = dtfac
410 IF(tol_sms == zero) tol_sms = em03
411 IF(nsmspcg==0)nsmspcg=1000
412 ENDIF
413 ELSE
414 idtmins=idtmins_old
415 dtmins =dtmins_old
416 dtfacs =dtfacs_old
417 idtgrs =idtgrs_old
418 idtmins_int=idtmins_int_old
419 dtmins_int =dtmins_int_old
420 dtfacs_int =dtfacs_int_old
421 END IF
422C
423 dtfacx = one
424 DO i=1,51
425 IF(dtmin1(i) == zero)dtmin1(i) = dtmin
426 IF(dtfac1(i) == zero)dtfac1(i) = dtfac
427 dtfacx = min(dtfac1(i), dtfacx)
428 ENDDO
429
430 IF(idtmin(52) == 0)idtmin(52) = 1
431 IF(dtfac1(52) == zero)dtfac1(52) = zep9
432 IF(dtmin1(52) == zero)dtmin1(52) = em20
433
434 i=102
435 IF(ale%GLOBAL%IDT_ALE==-1)THEN
436 IF(dtmin1(i) == zero)dtmin1(i) = dtmin
437 IF(dtfac1(i) == zero)dtfac1(i) = dtfac
438 ELSE
439 IF(dtmin1(i) == zero)dtmin1(i) = zero
440 IF(dtfac1(i) == zero)dtfac1(i) = half
441 ENDIF
442C
443 IF(nodadt == 0)THEN
444 IF(idtmin(1) == 0)idtmin(1) = 1
445 IF(idtmin(2) == 0)idtmin(2) = 1
446 IF(idtmin(3) == 0)idtmin(3) = 2
447 IF(idtmin(7) == 0)idtmin(7) = 2
448 ENDIF
449C
450 IF(ispmd == 0) WRITE(iout,'(//1X,20A4//)') title
451 itfor0=itform + 1
452 irfe0 =(irform/5)
453 irfl0 =(irform-5*irfe0) + 1
454 irfe0 =irfe0 + 1
455
456C --------------------------------------------------------------------
457c CALL RCHECKMASS(IXR ,GEO ,PM ,MSR ,INR ,
458c . MS ,IN ,ITAB ,IGEO ,IPM ,
459c . UPARAM ,IPART ,IPARTR )
460C --------------------------------------------------------------------
461C User Libraries output & checks
462C --------------------------------------------------------------------
463 IF (nspmd > 1)THEN
464 userl_count = userl_avail
465 CALL spmd_glob_isum9(userl_count,1)
466 IF (ispmd==0)THEN
467 IF (userl_count /= 0 .AND. userl_count /= nspmd)THEN
468 CALL ancmsg(msgid=254,anmode=aninfo,
469 . c1=dlibfile(1:dlibfile_size))
470 CALL arret(2)
471 ENDIF
472 ENDIF
473 ENDIF
474C When Dynamical user libraries are used, add a print in 0001.out file
475 IF (userl_avail==1)THEN
476 IF(ispmd==0)THEN
477 WRITE(iout,4500)
478 WRITE(iout,4600) dlibfile(1:dlibfile_size),dlibtkvers
479 ENDIF
480 ENDIF
481C --------------------------------------------------------------------
482
483 IF (irad2r==1) THEN
484 IF(ispmd==0) WRITE(iout,1099)
485 IF (itfor0==1 ) THEN
486 CALL ancmsg(msgid=242,anmode=aninfo_blind)
487 CALL arret(2)
488 ENDIF
489 ELSE
490 IF ((r2r_siu==1).AND.(ispmd==0)) THEN
491 CALL ancmsg(msgid=239,anmode=aninfo_blind)
492 CALL arret(2)
493 ENDIF
494 ENDIF
495C
496 min_aspect = dt%BRICK_CST_COL_MIN
497 min_defv = dt%BRICK_CST_DEFV_MIN
498 IF(ispmd == 0.AND.mcheck == 0)WRITE(iout,1100)tstop,output%TH%DTHIS,dtfac,dtmin
499 IF(nodadt == 0)THEN
500 IF ((min_aspect+min_defv)>zero) THEN
501 IF(ispmd == 0.AND.mcheck == 0)THEN
502 WRITE(iout,4700) dtfac1(1),dtmin1(1),idtmin(1),
503 + min_aspect,min_defv,
504 + dtfac1(2),dtmin1(2),idtmin(2),
505 + dtfac1(3),dtmin1(3),idtmin(3),
506 + dtfac1(4),dtmin1(4),idtmin(4),
507 + dtfac1(5),dtmin1(5),idtmin(5),
508 + dtfac1(6),dtmin1(6),idtmin(6),
509 + dtfac1(9),dtmin1(9),idtmin(9),
510 + dtfac1(10),dtmin1(10),idtmin(10)
511 !WRITE(IOUT,4710) DTFAC1(102),DTMIN1(102)
512 IF(idt1sh /=0) WRITE(iout,4720)
513 IF(idt1sol/=0) WRITE(iout,4730)
514 IF(idt1tet10/=0) WRITE(iout,4740)
515 endif!(ISPMD == 0.AND.MCHECK == 0)
516 ELSE
517 IF(ispmd == 0.AND.mcheck == 0)THEN
518 WRITE(iout,1105) dtfac1(1),dtmin1(1),idtmin(1),
519 + dtfac1(2),dtmin1(2),idtmin(2),
520 + dtfac1(3),dtmin1(3),idtmin(3),
521 + dtfac1(4),dtmin1(4),idtmin(4),
522 + dtfac1(5),dtmin1(5),idtmin(5),
523 + dtfac1(6),dtmin1(6),idtmin(6),
524 + dtfac1(9),dtmin1(9),idtmin(9),
525 + dtfac1(10),dtmin1(10),idtmin(10)
526 !WRITE(IOUT,4710) DTFAC1(102),DTMIN1(102)
527 IF(idt1sh /=0) WRITE(iout,4720)
528 IF(idt1sol/=0) WRITE(iout,4730)
529 IF(idt1tet10/=0) WRITE(iout,4740)
530 endif!(ISPMD == 0.AND.MCHECK == 0)
531 END IF !(min_aspect+min_defv)>zero)
532 IF (dt%IDEL_BRICK>zero) THEN
533 IF(ispmd == 0.AND.mcheck == 0)THEN
534 WRITE(iout,5020)dt%BRICK_DEL_COL_MIN,dt%BRICK_DEL_DEFV_MIN,dt%BRICK_DEL_ASP_MAX,dt%BRICK_DEL_DEFV_MAX
535 ENDIF
536 ENDIF
537 IF(idtmin(11) == 3 .OR. idtmin(11) == 8) THEN
538 IF(ispmd == 0.AND.mcheck == 0)WRITE(iout,1107)dtfac1(11),dtmin1(11),idtmin(11)
539 ENDIF
540 IF(idtmins_int/=0)THEN
541 IF((ispmd == 0).AND.mcheck == 0)THEN
542 WRITE(iout,1209) dtfacs_int,dtmins_int
543 END IF
544 END IF
545 IF(idtmins/=0)THEN
546 IF((ispmd == 0).AND.mcheck == 0.AND.idtgrs<=0)THEN
547 WRITE(iout,1109) dtfacs,dtmins,tol_sms,nsmspcg,m_vs_sms,ncprisms,-idtgrs
548 ELSEIF((ispmd == 0).AND.mcheck == 0)THEN
549 WRITE(iout,1109) dtfacs,dtmins,tol_sms,nsmspcg,m_vs_sms,ncprisms,igrpart(idtgrs)%ID
550 END IF
551 END IF
552 ELSE
553 IF(ispmd == 0.AND.mcheck == 0)THEN
554 IF(idtmin(11)==0)THEN
555 WRITE(iout,1116) dtfac1(11),zero
556 ELSEIF(idtmin(11)==1.OR.idtmin(11)==3.OR.idtmin(11) == 8)THEN
557 IF ( percent_addmass > zero) THEN
558 WRITE(iout,1206) dtfac1(11),dtmin1(11),percent_addmass,idtmin(11)
559 ELSE
560 WRITE(iout,1106) dtfac1(11),dtmin1(11),idtmin(11)
561 ENDIF
562 END IF
563 END IF
564 IF ((min_aspect+min_defv)>zero) THEN
565 IF(ispmd == 0.AND.mcheck == 0)THEN
566 WRITE(iout,4700) dtfac1(1),dtmin1(1),idtmin(1),
567 + min_aspect,min_defv,
568 + dtfac1(2),dtmin1(2),idtmin(2),
569 + dtfac1(3),dtmin1(3),idtmin(3),
570 + dtfac1(4),dtmin1(4),idtmin(4),
571 + dtfac1(5),dtmin1(5),idtmin(5),
572 + dtfac1(6),dtmin1(6),idtmin(6),
573 + dtfac1(9),dtmin1(9),idtmin(9),
574 + dtfac1(10),dtmin1(10),idtmin(10)
575 !WRITE(IOUT,4710) DTFAC1(102),DTMIN1(102)
576 IF(idt1sh /=0) WRITE(iout,4720)
577 IF(idt1sol/=0) WRITE(iout,4730)
578 IF(idt1tet10/=0) WRITE(iout,4740)
579 ENDIF
580 ELSE
581 IF(ispmd == 0.AND.mcheck == 0)THEN
582 WRITE(iout,1105) dtfac1(1),dtmin1(1),idtmin(1),
583 + dtfac1(2),dtmin1(2),idtmin(2),
584 + dtfac1(3),dtmin1(3),idtmin(3),
585 + dtfac1(4),dtmin1(4),idtmin(4),
586 + dtfac1(5),dtmin1(5),idtmin(5),
587 + dtfac1(6),dtmin1(6),idtmin(6),
588 + dtfac1(9),dtmin1(9),idtmin(9),
589 + dtfac1(10),dtmin1(10),idtmin(10)
590 !WRITE(IOUT,4710) DTFAC1(102),DTMIN1(102)
591 IF(idt1sh /=0) WRITE(iout,4720)
592 IF(idt1sol/=0) WRITE(iout,4730)
593 IF(idt1tet10/=0) WRITE(iout,4740)
594 ENDIF
595 END IF !((MIN_ASPECT+MIN_DEFV)>ZERO) THEN
596 IF (dt%IDEL_BRICK>zero) THEN
597 IF(ispmd == 0.AND.mcheck == 0)THEN
598 WRITE(iout,5020)dt%BRICK_DEL_COL_MIN,dt%BRICK_DEL_DEFV_MIN,dt%BRICK_DEL_ASP_MAX,dt%BRICK_DEL_DEFV_MAX
599 ENDIF
600 END IF
601 IF(idtmins_int/=0)THEN
602 IF((ispmd == 0).AND.mcheck == 0)THEN
603 WRITE(iout,1209) dtfacs_int,dtmins_int
604 END IF
605 END IF
606C
607 IF(idtmins/=0)THEN
608C
609 IF (isms_selec < 3) THEN
610 IF((ispmd == 0).AND.mcheck == 0.AND.idtgrs<=0) THEN
611 WRITE(iout,1108) dtfacs,dtmins,tol_sms,nsmspcg,ncprisms,-idtgrs
612 ELSEIF((ispmd == 0).AND.mcheck == 0)THEN
613 WRITE(iout,1108) dtfacs,dtmins,tol_sms,nsmspcg,ncprisms,igrpart(idtgrs)%ID
614 END IF
615C
616 ELSE
617C-- /DT/CST_AMS >- automatic element selection
618 dt_crit = dtmins / max(em20,dtfac1(11))
619 IF((ispmd == 0).AND.mcheck == 0.AND.idtgrs<=0)THEN
620 WRITE(iout,2109) dtfacs,dtmins,tol_sms,nsmspcg,m_vs_sms,ncprisms,dt_crit,-idtgrs
621 ELSEIF((ispmd == 0).AND.mcheck == 0)THEN
622 WRITE(iout,2109) dtfacs,dtmins,tol_sms, nsmspcg,m_vs_sms,ncprisms,dt_crit,igrpart(idtgrs)%ID
623 END IF
624C
625 END IF
626C
627 ENDIF
628C
629 ENDIF
630C
631
632 IF(nodadt==0.AND.(istatcnd/=0.AND.impl_s==0))THEN
633 CALL ancmsg(msgid=121,anmode=aninfo_blind)
634 CALL arret(2)
635 END IF
636 IF(ispmd == 0.AND.mcheck == 0.AND.kdtint /= 0)THEN
637 WRITE(iout,'(A)')' NEW (HIDDEN) TIME STEP COMPUTATION',' ON INTERFACE TYPE 7,11 AND 19 IS ON'
638 ENDIF
639 IF(ispmd == 0.AND.mcheck == 0.AND.kdtsmstr == 0)THEN
640 WRITE(iout,'(A)')' BACK TO VERSION 4 COMPUTATION OF NODAL TIME STEP',' CASE OF SMALL STRAIN FOR SOLIDS.'
641 ENDIF
642 IF(codvers>=44.AND.numsph /= 0.AND.mcheck == 0)THEN
643 IF(idtmin(51) == 3)THEN
644 IF(ispmd == 0)THEN
645 WRITE(istdo,*)' ** WARNING SMALL STRAIN FORMULATION FOR SPH'
646 WRITE(iout,*)' ** WARNING SMALL STRAIN FORMULATION IS NOT AVAILABLE FOR SPH,',' OPTION /DT/SPHCEL/CST WILL BE OMITTED.'
647 END IF
648 idtmin(51)=0
649 ENDIF
650 IF(nodadt == 1)THEN
651 IF(ispmd == 0) WRITE(iout,*)'IMPROVED TIME STEP (NODAL) COMPUTATION ON SPH PARTICLES :'
652 dtfac1(51)=dtfac1(11)
653 ENDIF
654 IF(ispmd == 0) WRITE(iout,1151)dtfac1(51),dtmin1(51),idtmin(51)
655 ENDIF
656C
657 IF(ispmd == 0.AND.mcheck == 0) THEN
658 IF(num_opt_dt_fvmbag_0+num_opt_dt_fvmbag_1>0)THEN
659 !if at least on option /DT/FVMBAG/0 or /DT/FVMBAG/1 is defined then output parameter for the retained one (last read one)
660 ! (multiple definition is not expected)
661 IF(num_opt_dt_fvmbag_1>0)THEN
662 WRITE(iout,1156)
663 ELSE
664 WRITE(iout,1155)
665 ENDIF
666 WRITE(iout,1152)dtfac1(52),dtmin1(52),idtmin(52)
667 ENDIF
668 ENDIF
669 IF(ispmd == 0.AND.mcheck == 0) THEN
670 k1 = 1
671 is_already_printed = .false.
672 DO ivolu = 1, nvolu
673 ifv = monvol(k1 - 1 + 45)
674 ifv_type = monvol(k1 - 1 + 2)
675 IF (ifv_type == 6 .OR. ifv_type == 8 .OR. ifv_type == 11) THEN
676 IF(.NOT.is_already_printed)THEN
677 WRITE(iout,1157)
678 is_already_printed=.true.
679 ENDIF
680 ENDIF
681 IF(ifv_type == 6) WRITE(iout,1147)monvol(k1)
682 IF(ifv_type == 8) WRITE(iout,1148)monvol(k1)
683 IF(ifv_type == 11)WRITE(iout,1149)monvol(k1)
684 IF (ifv_type == 6 .OR. ifv_type == 8 .OR. ifv_type == 11) THEN
685 WRITE(iout,1153)fvdata_old(ifv)%CFL_COEF,fvdata_old(ifv)%DTMIN,fvdata_old(ifv)%ID_DT_OPTION
686 IF(fvdata_old(ifv)%ID_DT_OPTION ==2)THEN
687 WRITE(iout,1154)fvdata_old(ifv)%L_TYPE,fvdata_old(ifv)%LAMBDA,fvdata_old(ifv)%DTOLD
688 ENDIF
689 ENDIF
690 k1=k1+nimv
691 ENDDO
692 ENDIF
693C
694 IF(ispmd == 0.AND.mcheck == 0.AND.idt1sol /= 0) WRITE(iout,'(A)')' OPTIMIZED TIME STEP COMPUTATION FOR HEPH.'
695 IF(ispmd == 0.AND.mcheck == 0.AND.idttsh /= 0) WRITE(iout,'(A)')' OPTIMIZED (SHELL) TIME STEP FOR THICK SHELLS.'
696 IF(ispmd == 0.AND.mcheck == 0)WRITE(iout,1110)ncpri,ncrst,multirest,invers,itfor0
697 IF(ispmd == 0.AND.restart_file == 0) WRITE(iout,*) check_message(2)(1:len_trim(check_message(2)) )
698 IF (impl_s == 1.AND.ikg>=5) THEN
699 ikg=ikg-5
700 IF(ispmd == 0) THEN
701 WRITE(iout,*) ' ** WARNING ** : PARITH/ON IS NOT ','COMPATIBLE WITH IMPLICIT OPTION '
702 WRITE(iout,*) ' ** RESETTING ** : PARITH/OFF '
703 ENDIF
704 ENDIF
705C-------------------------------------------
706C .h3d files
707C-------------------------------------------
708 CALL prelech3d(numgeo ,npropgi ,npropmi ,nummat ,numply ,
709 . igeo ,ipm ,h3d_data ,multi_fvm,mds_output_table,
710 . mds_nmat ,max_depvar,mds_ndepsvar,mat_param,numsphg)
711 CALL lech3d(geo,igeo,ipm,ipart,h3d_data,multi_fvm,ipari,iparg,tag_skins6,
712 . mds_label,mds_output_table,mds_nmat,max_depvar,mds_ndepsvar,
713 . elbuf_str,stack,ibcl,iloadp,lloadp,loads,mat_param,pblast,
714 . igrpart)
715c
716 IF(h3d_data%N_OUTP_H3D /= 0 .AND. ispmd == 0)THEN
717 WRITE(iout,5000)h3d_data%TH3D,h3d_data%DTH3D
718 WRITE(iout,*)' |'
719 DO i=1,h3d_data%N_OUTP_H3D
720 IF( h3d_data%OUTPUT_LIST(i)%ETYPE == 1 .OR.
721 . h3d_data%OUTPUT_LIST(i)%ETYPE == 2 .AND. numelcg+numeltgg > 0 .OR.
722 . h3d_data%OUTPUT_LIST(i)%ETYPE == 3 .AND. numelsg > 0 .OR.
723 . h3d_data%OUTPUT_LIST(i)%ETYPE == 4 .AND. numeltrg+numelpg+numelrg > 0 .OR.
724 . h3d_data%OUTPUT_LIST(i)%ETYPE == 5 .AND. numsphg > 0 .OR.
725 . h3d_data%OUTPUT_LIST(i)%ETYPE == 6 .AND. numelqg > 0 .OR.
726 . h3d_data%OUTPUT_LIST(i)%ETYPE == 7 .AND. numsking > 0) THEN
727 char1=' '
728 IF(h3d_data%OUTPUT_LIST(i)%ETYPE == 1)THEN
729 char1='NODAL'
730 ELSEIF(h3d_data%OUTPUT_LIST(i)%ETYPE == 2)THEN
731 char1='SHELL'
732 ELSEIF(h3d_data%OUTPUT_LIST(i)%ETYPE == 3)THEN
733 char1='SOLID'
734 ELSEIF(h3d_data%OUTPUT_LIST(i)%ETYPE == 4)THEN
735 char1='ONED'
736 ELSEIF(h3d_data%OUTPUT_LIST(i)%ETYPE == 5)THEN
737 char1='SPH'
738 ELSEIF(h3d_data%OUTPUT_LIST(i)%ETYPE == 6)THEN
739 char1='QUAD'
740 ELSEIF(h3d_data%OUTPUT_LIST(i)%ETYPE == 7)THEN
741 char1='SKIN'
742 ENDIF
743c
744 char2=' '
745 IF(h3d_data%OUTPUT_LIST(i)%OUTP_TYPE == 1)THEN
746 char2='SCALAR'
747 ELSEIF(h3d_data%OUTPUT_LIST(i)%OUTP_TYPE == 2)THEN
748 char2='VECTOR'
749 ELSEIF(h3d_data%OUTPUT_LIST(i)%OUTP_TYPE == 3)THEN
750 char2='TENSOR'
751 ELSEIF(h3d_data%OUTPUT_LIST(i)%OUTP_TYPE == 4)THEN
752 char2='TORSOR'
753 ENDIF
754c
755 stext1 = h3d_data%OUTPUT_LIST(i)%S_STRING1
756 WRITE(iout,*) ' |----'//char1//' '//char2//' : '
757c WRITE(IOUT,*) ' |----'//H3D_DATA%OUTPUT_LIST(I)%KEYWORD
758 WRITE(iout,*) ' | '//h3d_data%OUTPUT_LIST(i)%STRING1(1:stext1)
759
760 IF (h3d_data%OUTPUT_LIST(i)%IUVAR > 0)
761 . WRITE(iout,*) ' | UVAR=', h3d_data%OUTPUT_LIST(i)%IUVAR
762
763 IF (h3d_data%OUTPUT_LIST(i)%PLY > 0)
764 . WRITE(iout,*) ' | PLY=',h3d_data%OUTPUT_LIST(i)%PLY
765
766 IF (h3d_data%OUTPUT_LIST(i)%LAYER > 0)
767 . WRITE(iout,*) ' | LAYER=',h3d_data%OUTPUT_LIST(i)%LAYER
768
769 IF (h3d_data%OUTPUT_LIST(i)%IPT > 0)
770 . WRITE(iout,*) ' | IPT=',h3d_data%OUTPUT_LIST(i)%IPT
771
772 IF (h3d_data%OUTPUT_LIST(i)%IR > 0)
773 . WRITE(iout,*) ' | IR=',h3d_data%OUTPUT_LIST(i)%IR
774
775 IF (h3d_data%OUTPUT_LIST(i)%IR > 0)
776 . WRITE(iout,*) ' | IS=',h3d_data%OUTPUT_LIST(i)%IS
777
778 IF (h3d_data%OUTPUT_LIST(i)%IT > 0)
779 . WRITE(iout,*) ' | IT=',h3d_data%OUTPUT_LIST(i)%IT
780
781 WRITE(iout,*)' |'
782 ENDIF
783 ENDDO
784 WRITE(iout,*)' '
785 WRITE(iout,*)' '
786 ENDIF
787C-------------------------------------------
788C---------------------
789C FE THERMAL ANALYSIS
790C---------------------
791 IF(ispmd == 0 .AND. imassi > 0 ) THEN
792 WRITE(iout,'(A)')' RESET INITIAL MASS FOR THIS RUN '
793 ENDIF
794C---------------------
795C INITIAL MASS
796C---------------------
797 IF (ispmd == 0 .AND. glob_therm%ITHERM_FE > 0 ) THEN
798 WRITE(iout,'(A)')' FINITE ELEMENT THERMAL ANALYSIS '
799 IF (glob_therm%IDT_THERM == 1) THEN
800 WRITE(iout,'(A)')' THERMAL ANALYSIS ONLY'
801 WRITE(iout,'(A,1X,G14.7)')' THERMAL TIME STEP SCALE FACTOR . . . . . . . . .', glob_therm%DTFACTHERM
802 ENDIF
803 IF (glob_therm%THEACCFACT > one ) THEN
804 WRITE(iout,'(A,1X,G14.7/)')' FACTOR TO SPEED-UP THERMAL ANALYSIS. . . . . . .', glob_therm%THEACCFACT
805 ENDIF
806 ENDIF
807C-------------------------------------------
808C Animations
809C-------------------------------------------
810 IF(tanim0 /= zero) tanim = tanim0
811 IF(tanim_stop0/=zero .AND. tanim_stop0/=ep20) tanim_stop = tanim_stop0
812 IF(dtanim0 > zero) dtanim= dtanim0
813 IF(dtanim<=zero) tanim = ep30
814 IF (tanim < tt-dt2.AND.dtanim > zero)tanim = tanim
815 . + int((tt-dt2-tanim)/dtanim)*dtanim
816 IF (tanim < tt-dt2)tanim = tanim+dtanim
817C-----------------------
818 IF(anim_v(14)+h3d_data%N_VECT_DROT > 0 .AND.
819 . ((isecut == 0 .AND. iisrot == 0 .AND. impose_dr == 0 .AND. idrot == 0) .OR. iroddl == 0)) THEN
820 IF(ispmd == 0) THEN
821 WRITE(iout,*) ' ** WARNING ** : /ANIM/DROT OPTION USED',
822 . ' WHILE ROTATIONAL DOF ARE NOT COMPUTED',
823 . ' (IDROT = 0 IN /IOFLAG OPTION)'
824 WRITE(istdo,*) ' ** WARNING ** : /ANIM/DROT OPTION USED',
825 . ' WHILE ROTATIONAL DOF ARE NOT COMPUTED',
826 . ' (IDROT = 0 IN /IOFLAG OPTION)'
827 ENDIF
828 IF(anim_v(14) == 1) THEN
829 anim_v(14) = 0
830 nv_ani = nv_ani - 1
831 ENDIF
832 ENDIF
833C-----------------------
834 IF(ispmd == 0.AND.mcheck == 0) THEN
835C-----------------------
836C Tracing Animations cards
837C-----------------------
838 WRITE(iout,1120)tanim,dtanim,tanim_stop,sensors%ANIM_ID,sensors%ANIM_DT,
839 + anim_e(1),anim_e(2),anim_e(3),anim_e(25),
840 + anim_e(4),anim_e(5),anim_e(6),
841 + anim_e(7),anim_e(8),anim_e(9),
842 + anim_e(10)+anim_e(4960)+anim_e(4961)+anim_e(4962)
843 WRITE(iout,1129) anim_n(3),anim_n(4),anim_n(6)
844 WRITE(iout,1130)
845 + anim_v(1),anim_v(2),anim_v(3),anim_v(4),anim_v(5),
846 + anim_v(6),anim_v(7),anim_v(9),anim_v(12),
847 + anim_t(1),anim_t(2),anim_t(3),anim_t(4)
848 WRITE(iout,1140)
849 + anim_t(5),anim_t(6),anim_t(7),anim_t(8),
850 + anim_m,anim_k
851 ENDIF
852C-----------------------
853C The correct indexes in ANIM data structures wrt integration points or layers
854C of all actual elements will be rebuilt ::
855C-----------------------
856 CALL anim_build_index_all(ispmd ,mcheck ,sensors ,igeo ,geo )
857C-------------------------------------------
858C STOP/SENSOR
859C-------------------------------------------
860 IF (mcheck == 0) THEN
861 ALLOCATE(sensors%STOP(sensors%NSTOP))
862 sensors%STOP(:) = 0
863 END IF
864 IF (mcheck == 0) THEN
865 IF (sensors%NSTOP > 0) THEN
866 DO k=1,sensors%NSTOP
867 ierr = 1
868 IF (sensors%STOP_TMP(k) > 0) THEN
869 DO i=1,sensors%NSENSOR
870 IF (sensor_tab(i)%SENS_ID == sensors%STOP_TMP(k)) THEN
871 sensors%STOP(k) = i
872 ierr = 0
873 EXIT
874 ENDIF
875 ENDDO
876 ENDIF
877 IF (ierr == 1) THEN
878 CALL ancmsg(msgid=233, anmode=aninfo,i1=sensors%STOP_TMP(k))
879 ENDIF
880 ENDDO
881 ENDIF
882 END IF !(ISPMD==0.AND.MCHECK==0)
883C-------------------------------------------
884C STATE/SENSOR
885C-------------------------------------------
886 IF (mcheck == 0) THEN
887 ALLOCATE(sensors%STAT(sensors%NSTAT))
888 sensors%STAT(:) = 0
889 END IF
890 IF (ispmd == 0 .AND. mcheck == 0) THEN
891 mstatt = 0
892 IF (sensors%NSTAT > 0) THEN
893 DO k=1,sensors%NSTAT
894 ierr = 1
895 IF(sensors%STAT(k) /= 0) THEN
896 DO i=1,sensors%NSENSOR
897 IF (sensors%SENSOR_TAB(i)%SENS_ID == sensors%STAT(k)) THEN
898 sensors%STAT(k) = i
899 ierr = 0
900 EXIT
901 ENDIF
902 ENDDO
903 ENDIF
904 IF (ierr == 1) THEN
905 CALL ancmsg(msgid=235, anmode=aninfo,i1=sensors%STAT(k))
906 ELSE
907 mstat(k) = 0
908 ENDIF
909 ENDDO
910 ENDIF
911 END IF !(ISPMD==0.AND.MCHECK==0)
912C-------------------------------------------
913C OUTP/SENSOR
914C-------------------------------------------
915 IF (mcheck == 0) THEN
916 ALLOCATE(sensors%OUTP(sensors%NOUTP))
917 sensors%OUTP(:) = 0
918 END IF
919 IF (ispmd == 0 .AND. mcheck == 0) THEN
920 IF (sensors%NOUTP > 0) THEN
921 DO k=1,sensors%NOUTP
922 ierr = 1
923 IF (sensors%OUTP_TMP(k) > 0) THEN
924 DO i=1,sensors%NSENSOR
925 IF (sensors%SENSOR_TAB(i)%SENS_ID == sensors%OUTP_TMP(k)) THEN
926 sensors%OUTP(k) = i
927 ierr = 0
928 EXIT
929 ENDIF
930 ENDDO
931 ENDIF
932 IF (ierr == 1) THEN
933 CALL ancmsg(msgid=236, anmode=aninfo,i1 = sensors%OUTP_TMP(k))
934 ENDIF
935 ENDDO
936 ENDIF
937 END IF !(ISPMD==0.AND.MCHECK==0)
938C-------------------------------------------
939C H3D/SENSOR
940C-------------------------------------------
941 IF (ispmd == 0.AND.mcheck == 0) THEN
942 DO k=1,h3d_data%N_SENS_H3D
943 iok = 0
944 IF(h3d_data%LSENS_H3D(k) /= 0)THEN
945 DO i=1,sensors%NSENSOR
946 IF(h3d_data%LSENS_H3D(k) == sensor_tab(i)%SENS_ID)THEN
947 h3d_data%LSENS_H3D(k)=i
948 iok = 1
949 EXIT
950 ENDIF
951 ENDDO
952 ENDIF
953 IF(iok == 0) THEN
954 CALL ancmsg(msgid=283,anmode=aninfo,i1=h3d_data%LSENS_H3D(k))
955 CALL arret(2)
956 ENDIF
957 ENDDO
958 ENDIF !(ISPMD==0.AND.MCHECK==0)
959C-------------------------------------------
960C STATE/SENSOR
961C-------------------------------------------
962 IF(ispmd == 0.AND.mcheck == 0) THEN
963 WRITE(iout,1150)dtin,dtmx
964 IF(impl /= 0)
965 . WRITE(iout,1160)eps,eps2,nitmx
966 istatg_p = iabs(istatg)
967 IF(istat == 1)THEN
968 WRITE(iout,1171)istatg_p,beta,period
969 ELSEIF(istat == 2)THEN
970 IF (tst_start>zero.OR.tst_stop>zero) THEN
971 IF (tst_stop==zero) tst_stop = tstop
972 WRITE(iout,5001)istatg_p,tst_start,tst_stop
973 ELSE
974 WRITE(iout,1172)istatg_p
975 END IF
976 ELSEIF(istat == 3)THEN
977 IF (tst_start>zero.OR.tst_stop>zero) THEN
978 IF (tst_stop==zero) tst_stop = tstop
979 WRITE(iout,5011)istatg_p,tst_start,tst_stop
980 ELSE
981 WRITE(iout,5010)istatg_p
982 END IF
983 ENDIF
984C-----------------------
985 IF(iparit == 0)THEN
986 WRITE(iout,1180)
987 ELSEIF(iparit == 1)THEN
988 WRITE(iout,1181)
989 ELSE
990 WRITE(iout,1182)iparit-1
991 ENDIF
992C-----------------------
993 WRITE(iout,1300) nsliof,npartof,nelsof,nelqof,nelcof,neltof,nelpof,nelrof,neltgof,nsphof
994 WRITE(iout,1400) nrlink
995 WRITE(iout,1500) nubcsn
996 IF(iale /= 0.OR.ieuler /= 0)WRITE(iout,1450) nalelink+nalelk !format v12 + format v5
997c
998 ELSEIF(ispmd == 0 .AND. mcheck /= 0) THEN
999 ENDIF !(ISPMD==0.AND.MCHECK==0)
1000C-----------------------------------
1001C ALE/EULER : UPWIND
1002C----------------------------------------
1003 ! ALE%UPWIND%UPW_UPDATE == 1 : ENGINE /UPWIND CARD DETECTED
1004 !ALE%UPWIND%UPW_UPDATE == 2 : /UPWIND CARD IS CHANGING AT LEAST ONE PARAMETER
1005 !if /UPWIND is defined then set new parameters
1006 IF(ispmd == 0 .AND. mcheck == 0)THEN
1007 IF(iale /= 0 .OR. ieuler /= 0)THEN
1008 IF(ale%UPWIND%UPW_UPDATE /= 0 )THEN
1009 DO k=1,nummat-1
1010 !ILAW=PM(19,K)
1011 jale=int(pm(72,k)) ! JALE from PROP (IGEO(62,IPID)) is not checked since this option /UPWIND is obsolete
1012 IF(jale /= 0)THEN
1013 IF(pm(15,k) /= ale%UPWIND%UPWMG2 .OR. pm(16,k) /= ale%UPWIND%UPWOG2)THEN
1014 ale%UPWIND%UPW_UPDATE = 2
1015 pm(15,k) = ale%UPWIND%UPWMG2
1016 pm(16,k) = ale%UPWIND%UPWOG2
1017 ENDIF
1018 ENDIF
1019 ENDDO
1020 IF(ale%UPWIND%UPWSM /= ale%UPWIND%UPWSM2)THEN
1021 ale%UPWIND%UPW_UPDATE = 2
1022 ale%UPWIND%UPWSM = ale%UPWIND%UPWSM2
1023 ENDIF
1024 !if /UPWIND is not defined then catch parameter from previous run
1025 ELSEIF(ale%UPWIND%UPW_UPDATE == 0)THEN
1026 ale%UPWIND%UPWMG2=one
1027 ale%UPWIND%UPWOG2=one
1028 ale%UPWIND%UPWSM2=one
1029 DO k=1,nummat-1
1030 !ilaw=pm(19,k)
1031 jale=int(pm(72,k))
1032 IF(jale /= 0)THEN
1033 IF(pm(15,k) /= ale%UPWIND%UPWMG2 .OR. pm(16,k) /= ale%UPWIND%UPWOG2 .OR. ale%UPWIND%UPWSM /= ale%UPWIND%UPWSM2)THEN
1034 IF(pm(15,k) /= zero)ale%UPWIND%UPWMG2 = pm(15,k)
1035 IF(pm(16,k) /= zero)ale%UPWIND%UPWOG2 = pm(16,k)
1036 IF(ale%UPWIND%UPWSM /= zero)ale%UPWIND%UPWSM2 = ale%UPWIND%UPWSM
1037 EXIT
1038 ENDIF
1039 ENDIF
1040 ENDDO
1041 ENDIF
1042 ENDIF
1043 ENDIF
1044C-----------------------------------
1045C ALE/EULER : OUTPUT
1046C----------------------------------------
1047 IF(iale /= 0 .OR. ieuler /= 0)THEN
1048 !-----------------------
1049 ! QUASI-INCOMPRESSIBLE /INCMP
1050 !-----------------------
1051 IF(ale%GLOBAL%INCOMP == 1.AND.mcheck == 0) WRITE(iout,1196)
1052 !-----------------------
1053 ! GRID FORMULATION
1054 !-----------------------
1055 !---ALE GRID FORMULATION CHECK---!
1056 IF(ale%GRID%NWALE_ENGINE /= ale%GRID%NWALE_RST .AND. ale%GRID%NWALE_ENGINE /= -1) THEN !Forbid ALE grid formulation switch
1057 IF(ale%GRID%NWALE_ENGINE /= 3)THEN !expect if new one is /ALE/ZERO
1058 aleform=(/'DONEA ','DISP ','SPRING ', 'ZERO ',
1059 . 'STANDARD ','LAPLACIAN ','VOLUME ', 'FLOW-TRACKING ',
1060 . 'LAGRANGE ' /)
1061 alestrl=(/5,4,6,4,8,9,6,13,8/)
1062 cale1=aleform(ale%GRID%NWALE_ENGINE)
1063 cale2=aleform(ale%GRID%NWALE_RST)
1064 CALL ancmsg(msgid=229,anmode=aninfo,
1065 . c1=cale1(1:alestrl(ale%GRID%NWALE_ENGINE)),c2=cale2(1:alestrl(ale%GRID%NWALE_RST)))
1066 CALL arret(2)
1067 ELSE
1068 ale%GRID%NWALE_ENGINE = 3
1069 END IF
1070 END IF
1071
1072 !--Labels for Staggered Scheme
1073 IF(ale%UPWIND%UPWM == 2)THEN
1074 label1='TG '
1075 ELSEIF(ale%UPWIND%UPWM == 3)THEN
1076 label1='SUPG '
1077 ELSE
1078 label1='UPWIND '
1079 ENDIF
1080 label2='UPWIND '
1081 label3='UPWIND '
1082 IF(alemuscl_param%IALEMUSCL == 0)THEN
1083 label4='UPWIND '
1084 ELSE
1085 label4='MUSCL '
1086 ENDIF
1087 !--Labels for Colocated Scheme
1088 IF(alemuscl_param%IALEMUSCL == 0)THEN
1089 label5='1ST-ORDER'
1090 label6='1ST-ORDER'
1091 label7='1ST-ORDER'
1092 label8='1ST-ORDER'
1093 ELSEIF(alemuscl_param%IALEMUSCL == 1)THEN
1094 label5='2ND-ORDER'
1095 label6='2ND-ORDER'
1096 label7='2ND-ORDER'
1097 label8='2ND-ORDER'
1098 ELSEIF(alemuscl_param%IALEMUSCL == 2)THEN
1099 label5='1ST-ORDER'
1100 label6='1ST-ORDER'
1101 label7='1ST-ORDER'
1102 label8='2ND-ORDER'
1103 ENDIF
1104 multi_fvm%LOWMACH_OPT = .false.
1105 IF (lowmach_opt == 1 .AND. multi_fvm%IS_USED) THEN
1106 multi_fvm%LOWMACH_OPT = .true.
1107 ENDIF
1108 aleform=(/'DONEA ','DISP ','SPRING ', 'ZERO ',
1109 . 'STANDARD ','LAPLACIAN ','VOLUME ', 'FLOW-TRACKING ',
1110 . 'LAGRANGE '/)
1111 !effective value which will be retained during numerical solving
1112 IF(ale%GRID%NWALE_ENGINE /= -1)THEN
1113 ale%GRID%NWALE = ale%GRID%NWALE_ENGINE
1114 ELSE
1115 ale%GRID%NWALE = ale%GRID%NWALE_RST
1116 ENDIF
1117 label9(:)=' '
1118 label9(1:16)=aleform(ale%GRID%NWALE)
1119 eta1=ale%UPWIND%UPWMG2
1120 eta2=ale%UPWIND%UPWOG2
1121 IF(ale%UPWIND%UPWM>1)eta1=ale%UPWIND%CUPWM
1122 !OUTPUT NUMERICAL SCHEME AND ITS PARAMETERS
1123 IF(ispmd == 0 .AND. mcheck == 0)THEN
1124 WRITE(iout,1001)
1125 WRITE(iout,1002)label1,eta1,label2,eta2,label3,eta2,label4
1126 IF(multi_fvm%IS_USED)THEN
1127 WRITE(iout,1003)label5,label6,label7,label8
1128 IF(multi_fvm%LOWMACH_OPT)WRITE(iout,1004)
1129 IF(alemuscl_param%IALEMUSCL/=0)WRITE(iout,1005)alemuscl_param%BETA
1130 ENDIF
1131 !OUTPUT COURANT NUMBER
1132 WRITE(iout,1006) dtfac1(102),dtmin1(102)
1133 !OUTPUT GRID SMOOTHING FORMULATION AND ITS PARAMETERS
1134 WRITE(iout,1007)label9(1:len_trim(label9))
1135 SELECT CASE (ale%GRID%NWALE)
1136 CASE(0) !DONEA
1137 WRITE(iout,1008)
1138 WRITE(iout,1200) ale%GRID%ALPHA,ale%GRID%GAMMA,ale%GRID%VGX,ale%GRID%VGY,ale%GRID%VGZ,volmin
1139 CASE(1) !DISP
1140 WRITE(iout,1008)
1141 WRITE(iout,1220) ale%GRID%ALPHA,volmin
1142 CASE(2) !SPRING
1143 WRITE(iout,1008)
1144 WRITE(iout,1250) dt_input,ale%GRID%ALPHA,ale%GRID%GAMMA,ale%GRID%VGX,ale%GRID%VGY,volmin
1145 CASE(3) !ZERO
1146 !no parameters
1147 CASE(4) !STANDARD
1148 WRITE(iout,1008)
1149 WRITE(iout,1254) ale%GRID%ALPHA,ale%GRID%GAMMA,ale%GRID%VGX,ale%GRID%VGY
1150 CASE(5)! LAPLACIAN
1151 WRITE(iout,1008)
1152 WRITE(iout,1254) ale%GRID%ALPHA,ale%GRID%GAMMA,ale%GRID%VGX,ale%GRID%VGY
1153 CASE(6) !VOLUME
1154 !no parameters
1155 CASE(7) !FLOW-TRACKING
1156 WRITE(iout,1008)
1157 label_def=' NO'
1158 label_rot=' NO'
1159 IF(int(ale%GRID%VGX) == 1)label_def='YES'
1160 IF(int(ale%GRID%VGY) == 1)label_rot='YES'
1161 WRITE(iout,1257) label_def,label_rot,ale%GRID%ALPHA,ale%GRID%GAMMA
1162 CASE(8) !LAGRANGE
1163 !no parameters
1164 END SELECT
1165 ENDIF
1166 ENDIF !(IALE/=0.OR.IEULER/=0)
1167 !---CHECK END-------------------!
1168!-----------------------
1169! FEM MOMENTUM INTEGRATION
1170!-----------------------
1171 IF(ispmd == 0.AND.mcheck == 0)THEN
1172 IF(iale+ieuler /= 0 .AND. ale%GLOBAL%ISFINT /= 3)THEN
1173 SELECT CASE(ale%GLOBAL%ISFINT)
1174 !CASE(3)
1175 ! WRITE(IOUT,1197) !default
1176 CASE(2)
1177 WRITE(iout,1198)
1178 CASE(1)
1179 WRITE(iout,1199)
1180 END SELECT
1181 ENDIF
1182 ENDIF
1183
1184C-------------------------------
1185C ELIMINATION PARTIE ALE EULER THERMIQUE
1186C-------------------------------
1187 IF(iale /= 0.AND.naleof == 1)THEN
1188 IF(ispmd == 0.AND.mcheck == 0)THEN
1189 WRITE(iout,*)'ALE FORMULATION SWITCHED OFF '
1190 END IF
1191 iale = 0
1192 END IF
1193 IF(ieuler /= 0.AND.neulerof == 1)THEN
1194 IF(ispmd == 0.AND.mcheck == 0)THEN
1195 WRITE(iout,*)'EULER FORMULATION SWITCHED OFF '
1196 END IF
1197 ieuler = 0
1198 END IF
1199 IF (glob_therm%ITHERM /= 0.AND.nthermof == 1)THEN
1200 IF(ispmd == 0.AND.mcheck == 0)THEN
1201 WRITE(iout,*)'THERMIC FORMULATION SWITCHED OFF '
1202 END IF
1203 glob_therm%ITHERM = 0
1204 END IF
1205C-------------------------------
1206 IF(idel7 /= 0.AND.mcheck == 0.AND.n2d == 0)THEN
1207 ideli7 = idel7 - 1
1208 IF(ispmd == 0)THEN
1209 WRITE(iout,1550) ideli7
1210 CALL ancmsg(msgid=122,anmode=aninfo_blind)
1211 CALL arret(2)
1212 ENDIF
1213 ELSEIF(n2d /= 0.AND.mcheck == 0)THEN
1214 IF(ispmd == 0)WRITE(iout,1550) idel7-1
1215 END IF
1216C-------------------------------
1217C INTERFACE CLEANING
1218C-------------------------------
1219 IF(nsliof /= 0) THEN
1220C
1221 nn=(nsliof+9)/10
1222 DO il=1,nn
1223 READ (iin,'(10i10)') (NLEC(I),I=1,10)
1224 DO I=1,10
1225 IF(NLEC(I) == 0)CYCLE
1226.AND. IF(ISPMD == 0MCHECK == 0)WRITE(IOUT,2000) NLEC(I)
1227 DO K=1,NINTER
1228 IF(IPARI(15,K) == NLEC(I))THEN
1229 IF(IPARI(7,K)==2)THEN
1230 IDEL2= IPARI(17,K)
1231 IF(IDEL2 /= 0)THEN
1232C SMASS & SINER have been saved only if IDEL2 /= 0
1233 NSN = IPARI(5,K)
1234 DO N=1,NSN
1235 IS =INTBUF_TAB(K)%NSV(N)
1236 IF(IS > 0)THEN
1237 MS(IS)=INTBUF_TAB(K)%SMAS(N)
1238 IN(IS)=INTBUF_TAB(K)%SINER(N)
1239 INTBUF_TAB(K)%NSV(N)=-IS
1240 END IF
1241 END DO
1242 END IF
1243 END IF
1244C----- change T_stop for int25 otherwise issue w/ int25
1245 IF(IPARI(7,K)==25)THEN
1246 INTBUF_TAB(K)%VARIABLES(11) = ZERO
1247 ELSE
1248 IPARI(7,K)=0
1249 ENDIF
1250 END IF
1251 ENDDO
1252 ENDDO !next I
1253 ENDDO
1254 ENDIF
1255C-----------------------------------
1256C CLEANING INTERFACE NODES
1257C----------------------------------------
1258 IF(NSLIOFN /= 0) THEN
1259 READ (IIN,'(2i8)') I,NN
1260 KK=0
1261 DO K=1,NINTER
1262 IF(IPARI(15,K) == I)KK=K
1263 ENDDO
1264 IF(KK == 0)THEN
1265 IF(ISPMD == 0) THEN
1266 CALL ANCMSG(MSGID=123,ANMODE=ANINFO_BLIND)
1267 ENDIF
1268 CALL ARRET(2)
1269 ENDIF
1270 NRTS =IPARI(3,KK)
1271 NRTM =IPARI(3,KK)
1272 NSN =IPARI(5,KK)
1273 NMN =IPARI(6,KK)
1274 NTY =IPARI(7,KK)
1275 IF (IPARI(71,KK)/=0) NTY = 19 ! Interface type 19
1276 IF(NTY == 3)THEN
1277 NSN =NSN + NMN
1278.OR. ELSEIF(NTY == 4 NTY == 5)THEN
1279.OR..OR. ELSEIF(NTY == 7 NTY == 10 NTY == 22)THEN
1280 ELSE
1281 IF(ISPMD == 0) THEN
1282 CALL ANCMSG(MSGID=124,ANMODE=ANINFO_BLIND)
1283 ENDIF
1284 CALL ARRET(2)
1285 ENDIF
1286 DO IL=1,NN
1287 READ (IIN,'(10i10)') (NLEC(I),I=1,10)
1288 DO I=1,10
1289 IF(NLEC(I) /= 0)THEN
1290 DO K=1,NSN
1291 IF(ITAB(INTBUF_TAB(KK)%NSV(K)) == NLEC(I))THEN !NSV(K)
1292 INTBUF_TAB(KK)%STFNS(K)=ZERO !STFNS(K)
1293 ENDIF
1294 ENDDO
1295 ENDIF
1296 ENDDO
1297 ENDDO
1298 ENDIF
1299C----------------------------------------------
1300C CLEANING ELEMS
1301C----------------------------------------------
1302 NELOF=NELSOF+NELQOF+NELCOF+NELTOF+NELPOF+NELROF+NELTGOF+NSPHOF
1303C-----------------------
1304C 1. 3D ELEMS
1305C-----------------------
1306 IF(NELSOF > 0)THEN
1307.AND. IF(ISPMD == 0MCHECK == 0)WRITE (IOUT,1810)
1308 NN=(NELSOF+4)/5
1309 NBC=5
1310 DO IL=1,NN
1311 READ (IIN,'(10i10)') (NLEC(II),II=1,10)
1312 DO J=1,NBC
1313 KLG=NLEC(2*J-1)
1314 KUG=NLEC(2*J )
1315 IF(KLG<=0) GO TO 120
1316 NBLK=(IL-1)*NBC+J
1317 DO L=1,NUMELS
1318.AND. IF(IXS(NIXS,L)>=KLGIXS(NIXS,L)<=KUG) THEN
1319 DO K=KLG,KUG
1320 IF(IXS(NIXS,L) == K) THEN
1321 IXS(1,L)=-IABS(IXS(1,L))
1322 GOTO 111
1323 ENDIF
1324 ENDDO
1325 ENDIF
1326111 CONTINUE
1327 ENDDO
1328 ENDDO
1329 ENDDO
1330 120 CONTINUE
1331 K=0
1332 DO J=1,NUMELS
1333 IF(IXS(1,J) < 0)THEN
1334 K=K+1
1335 NLEC(K) = IXS(NIXS,J)
1336 IF(K == 10)THEN
1337 IF(MCHECK == 0)WRITE (IOUT,'(5i10)') (NLEC(II),II=1,K)
1338 K=0
1339 ENDIF
1340 ENDIF
1341 ENDDO
1342 IF(K > 0) THEN
1343 IF(MCHECK == 0)WRITE (IOUT,'(5i10)') (NLEC(II),II=1,K)
1344 ENDIF
1345 IF(NSPMD > 1) THEN
1346 ! required treatments to retrieve deleted elems in correct order
1347 IWIOUT = 0
1348 IF (ISPMD /= 0) CALL SPMD_CHKW(IWIOUT,IOUT)
1349 CALL SPMD_GLOB_ISUM9(IWIOUT,1)
1350 CALL SPMD_IBCAST(IWIOUT,IWIOUT,1,1,0,2)
1351 IF (IWIOUT > 0) THEN
1352 CALL SPMD_WIOUT(IOUT,IWIOUT)
1353 IWIOUT = 0
1354 ENDIF
1355 ENDIF
1356 ENDIF!(NELSOF > 0)
1357C-----------------------
1358C 2. 2D-ELEMS
1359C-----------------------
1360 IF(NELQOF > 0)THEN
1361.AND. IF(ISPMD == 0MCHECK == 0)WRITE (IOUT,1820)
1362 IF (INVERS < 18) THEN
1363 NN=(NELQOF+7)/8
1364 NBC=8
1365 ELSE
1366 NN=(NELQOF+4)/5
1367 NBC=5
1368 ENDIF
1369 DO I=1,NN
1370 READ (IIN,'(10i10)') (NLEC(II),II=1,10)
1371 DO J=1,NBC
1372 KLG=NLEC(2*J-1)
1373 KUG=NLEC(2*J )
1374 IF(KLG<=0) GO TO 220
1375 NBLK=(I-1)*NBC+J
1376 DO L=1,NUMELQ
1377.AND. IF(IXQ(NIXQ,L)>=KLGIXQ(NIXQ,L)<=KUG) THEN
1378 DO K=KLG,KUG
1379 IF(IXQ(NIXQ,L) == K) THEN
1380 IXQ(1,L)=-IABS(IXQ(1,L))
1381 GOTO 211
1382 ENDIF
1383 ENDDO
1384 ENDIF
1385 211 CONTINUE
1386 ENDDO
1387 ENDDO
1388 ENDDO
1389 220 CONTINUE
1390 K=0
1391 DO J=1,NUMELQ
1392 IF(IXQ(1,J) < 0)THEN
1393 K=K+1
1394 NLEC(K) = IXQ(NIXQ,J)
1395 IF(K == 10)THEN
1396 IF(MCHECK == 0)WRITE (IOUT,'(5i10)') (NLEC(II),II=1,K)
1397 K=0
1398 ENDIF
1399 ENDIF
1400 ENDDO
1401 IF(K > 0) THEN
1402 IF(MCHECK == 0)WRITE (IOUT,'(5i10)') (NLEC(II),II=1,K)
1403 ENDIF
1404 IF(NSPMD > 1) THEN
1405 ! required treatments to retrieve deleted elems in correct order
1406 IWIOUT = 0
1407 IF (ISPMD /= 0) CALL SPMD_CHKW(IWIOUT,IOUT)
1408 CALL SPMD_GLOB_ISUM9(IWIOUT,1)
1409 CALL SPMD_IBCAST(IWIOUT,IWIOUT,1,1,0,2)
1410 IF (IWIOUT > 0) THEN
1411 CALL SPMD_WIOUT(IOUT,IWIOUT)
1412 IWIOUT = 0
1413 ENDIF
1414 ENDIF
1415 END IF
1416C-----------------------
1417C 3. SHELL ELEMS
1418C-----------------------
1419 IF(NELCOF > 0)THEN
1420.AND. IF(ISPMD == 0MCHECK == 0)WRITE (IOUT,1830)
1421 NN=(NELCOF+4)/5
1422 NBC=5
1423 DO I=1,NN
1424 READ (IIN,'(10i10)') (NLEC(II),II=1,10)
1425 DO J=1,NBC
1426 KLG=NLEC(2*J-1)
1427 KUG=NLEC(2*J )
1428 IF(KLG<=0) GO TO 320
1429 NBLK=(I-1)*NBC+J
1430 DO L=1,NUMELC
1431.AND. IF(IXC(NIXC,L)>=KLGIXC(NIXC,L)<=KUG) THEN
1432 DO K=KLG,KUG
1433 IF(IXC(NIXC,L) == K) THEN
1434 IXC(1,L)=-IABS(IXC(1,L))
1435 GOTO 311
1436 ENDIF
1437 ENDDO
1438 ENDIF
1439 311 CONTINUE
1440 ENDDO
1441 ENDDO
1442 ENDDO
1443 320 CONTINUE
1444 K=0
1445 DO J=1,NUMELC
1446 IF(IXC(1,J) < 0)THEN
1447 K=K+1
1448 NLEC(K) = IXC(NIXC,J)
1449 IF(K == 10)THEN
1450 IF(MCHECK == 0)WRITE (IOUT,'(5i10)') (NLEC(II),II=1,K)
1451 K=0
1452 ENDIF
1453 ENDIF
1454 ENDDO
1455 IF(K > 0) THEN
1456 IF(MCHECK == 0)WRITE (IOUT,'(5i10)') (NLEC(II),II=1,K)
1457 ENDIF
1458 IF(NSPMD > 1) THEN
1459 ! required treatments to retrieve deleted elems in correct order
1460 IWIOUT = 0
1461 IF (ISPMD /= 0) CALL SPMD_CHKW(IWIOUT,IOUT)
1462 CALL SPMD_GLOB_ISUM9(IWIOUT,1)
1463 CALL SPMD_IBCAST(IWIOUT,IWIOUT,1,1,0,2)
1464 IF (IWIOUT > 0) THEN
1465 CALL SPMD_WIOUT(IOUT,IWIOUT)
1466 IWIOUT = 0
1467 ENDIF
1468 ENDIF
1469 END IF
1470C-----------------------
1471C 4. ROD ELEMS
1472C-----------------------
1473 IF(NELTOF > 0)THEN
1474.AND. IF(ISPMD == 0MCHECK == 0)WRITE (IOUT,1840)
1475 NN=(NELTOF+4)/5
1476 NBC=5
1477 DO I=1,NN
1478 READ (IIN,'(10i10)') (NLEC(II),II=1,10)
1479 DO J=1,NBC
1480 KLG=NLEC(2*J-1)
1481 KUG=NLEC(2*J )
1482 IF(KLG<=0) GO TO 420
1483 NBLK=(I-1)*NBC+J
1484 DO L=1,NUMELT
1485.AND. IF(IXT(NIXT,L)>=KLGIXT(NIXT,L)<=KUG) THEN
1486 DO K=KLG,KUG
1487 IF(IXT(NIXT,L) == K) THEN
1488 IXT(1,L)=-IABS(IXT(1,L))
1489 GOTO 411
1490 ENDIF
1491 ENDDO
1492 ENDIF
1493 411 CONTINUE
1494 ENDDO
1495 ENDDO
1496 ENDDO
1497 420 CONTINUE
1498 K=0
1499 DO J=1,NUMELT
1500 IF(IXT(1,J) < 0)THEN
1501 K=K+1
1502 NLEC(K) = IXT(NIXT,J)
1503 IF(K == 10)THEN
1504 IF(MCHECK == 0)WRITE (IOUT,'(5i10)') (NLEC(II),II=1,K)
1505 K=0
1506 ENDIF
1507 ENDIF
1508 ENDDO
1509 IF(K > 0) THEN
1510 IF(MCHECK == 0) WRITE (IOUT,'(5i10)') (NLEC(II),II=1,K)
1511 ENDIF
1512 IF(NSPMD > 1) THEN
1513 ! required treatments to retrieve deleted elems in correct order
1514 IWIOUT = 0
1515 IF (ISPMD /= 0) CALL SPMD_CHKW(IWIOUT,IOUT)
1516 CALL SPMD_GLOB_ISUM9(IWIOUT,1)
1517 CALL SPMD_IBCAST(IWIOUT,IWIOUT,1,1,0,2)
1518 IF (IWIOUT > 0) THEN
1519 CALL SPMD_WIOUT(IOUT,IWIOUT)
1520 IWIOUT = 0
1521 ENDIF
1522 ENDIF
1523 END IF
1524C-----------------------
1525C 5. BEAM ELEMS
1526C-----------------------
1527 IF(NELPOF > 0)THEN
1528.AND. IF(ISPMD == 0MCHECK == 0)WRITE (IOUT,1850)
1529 NN=(NELPOF+4)/5
1530 NBC=5
1531 DO I=1,NN
1532 READ (IIN,'(10i10)') (NLEC(II),II=1,10)
1533 DO J=1,NBC
1534 KLG=NLEC(2*J-1)
1535 KUG=NLEC(2*J )
1536 IF(KLG<=0) GO TO 520
1537 NBLK=(I-1)*NBC+J
1538 DO L=1,NUMELP
1539.AND. IF(IXP(NIXP,L)>=KLGIXP(NIXP,L)<=KUG) THEN
1540 DO K=KLG,KUG
1541 IF(IXP(NIXP,L) == K) THEN
1542 IXP(1,L)=-IABS(IXP(1,L))
1543 GOTO 511
1544 ENDIF
1545 ENDDO
1546 ENDIF
1547 511 CONTINUE
1548 ENDDO
1549 ENDDO
1550 ENDDO
1551 520 CONTINUE
1552 K=0
1553 DO J=1,NUMELP
1554 IF(IXP(1,J) < 0)THEN
1555 K=K+1
1556 NLEC(K) = IXP(NIXP,J)
1557 IF(K == 10)THEN
1558 IF(MCHECK == 0)WRITE (IOUT,'(5i10)') (NLEC(II),II=1,K)
1559 K=0
1560 ENDIF
1561 ENDIF
1562 ENDDO
1563 IF(K > 0) THEN
1564 IF(MCHECK == 0)WRITE (IOUT,'(5i10)') (NLEC(II),II=1,K)
1565 ENDIF
1566 IF(NSPMD > 1) THEN
1567 ! required treatments to retrieve deleted elems in correct order
1568 IWIOUT = 0
1569 IF (ISPMD /= 0) CALL SPMD_CHKW(IWIOUT,IOUT)
1570 CALL SPMD_GLOB_ISUM9(IWIOUT,1)
1571 CALL SPMD_IBCAST(IWIOUT,IWIOUT,1,1,0,2)
1572 IF (IWIOUT > 0) THEN
1573 CALL SPMD_WIOUT(IOUT,IWIOUT)
1574 IWIOUT = 0
1575 ENDIF
1576 ENDIF
1577 END IF
1578C-----------------------
1579C 6. SPRING ELEMS
1580C-----------------------
1581 IF(NELROF > 0)THEN
1582.AND. IF(ISPMD == 0MCHECK == 0)WRITE (IOUT,1860)
1583 NN=(NELROF+4)/5
1584 NBC=5
1585 DO I=1,NN
1586 READ (IIN,'(10i10)') (NLEC(II),II=1,10)
1587 DO J=1,NBC
1588 KLG=NLEC(2*J-1)
1589 KUG=NLEC(2*J )
1590 IF(KLG<=0) GO TO 620
1591 NBLK=(I-1)*NBC+J
1592 DO L=1,NUMELR
1593.AND. IF(IXR(NIXR,L)>=KLGIXR(NIXR,L)<=KUG) THEN
1594 DO K=KLG,KUG
1595 IF(IXR(NIXR,L) == K) THEN
1596 IXR(1,L)=-IABS(IXR(1,L))
1597 GOTO 611
1598 ENDIF
1599 ENDDO
1600 ENDIF
1601 611 CONTINUE
1602 ENDDO
1603 ENDDO
1604 ENDDO
1605 620 CONTINUE
1606 K=0
1607 DO J=1,NUMELR
1608 IF(IXR(1,J) < 0)THEN
1609 K=K+1
1610 NLEC(K) = IXR(NIXR,J)
1611 IF(K == 10)THEN
1612 IF(MCHECK == 0)WRITE (IOUT,'(5i10)') (NLEC(II),II=1,K)
1613 K=0
1614 ENDIF
1615 ENDIF
1616 ENDDO
1617 IF(K > 0) THEN
1618 IF(MCHECK == 0) WRITE (IOUT,'(5i10)') (NLEC(II),II=1,K)
1619 ENDIF
1620 IF(NSPMD > 1) THEN
1621 ! required treatments to retrieve deleted elems in correct order
1622 IWIOUT = 0
1623 IF (ISPMD /= 0) CALL SPMD_CHKW(IWIOUT,IOUT)
1624 CALL SPMD_GLOB_ISUM9(IWIOUT,1)
1625 CALL SPMD_IBCAST(IWIOUT,IWIOUT,1,1,0,2)
1626 IF (IWIOUT > 0) THEN
1627 CALL SPMD_WIOUT(IOUT,IWIOUT)
1628 IWIOUT = 0
1629 ENDIF
1630 ENDIF
1631 ENDIF
1632C-----------------------
1633C 7. 3N-SHELL-ELEMS
1634C-----------------------
1635 IF(NELTGOF > 0)THEN
1636.AND. IF(ISPMD == 0MCHECK == 0)WRITE (IOUT,1870)
1637 NN=(NELTGOF+4)/5
1638 NBC=5
1639 DO I=1,NN
1640 READ (IIN,'(10i10)') (NLEC(II),II=1,10)
1641 DO J=1,NBC
1642 KLG=NLEC(2*J-1)
1643 KUG=NLEC(2*J )
1644 IF(KLG<=0) GO TO 640
1645 NBLK=(I-1)*NBC+J
1646 DO L=1,NUMELTG
1647.AND. IF(IXTG(NIXTG,L)>=KLGIXTG(NIXTG,L)<=KUG) THEN
1648 DO K=KLG,KUG
1649 IF(IXTG(NIXTG,L) == K) THEN
1650 IXTG(1,L)=-IABS(IXTG(1,L))
1651 GOTO 631
1652 ENDIF
1653 ENDDO
1654 ENDIF
1655 631 CONTINUE
1656 ENDDO
1657 ENDDO
1658 ENDDO
1659 640 CONTINUE
1660 K=0
1661 DO J=1,NUMELTG
1662 IF(IXTG(1,J) < 0)THEN
1663 K=K+1
1664 NLEC(K) = IXTG(NIXTG,J)
1665 IF(K == 10)THEN
1666 IF(MCHECK == 0)WRITE (IOUT,'(5i10)') (NLEC(II),II=1,K)
1667 K=0
1668 ENDIF
1669 ENDIF
1670 ENDDO
1671 IF(K > 0) THEN
1672 IF(MCHECK == 0) WRITE (IOUT,'(5i10)') (NLEC(II),II=1,K)
1673 ENDIF
1674 IF(NSPMD > 1) THEN
1675 ! required treatments to retrieve deleted elems in correct order
1676 IWIOUT = 0
1677 IF (ISPMD /= 0) CALL SPMD_CHKW(IWIOUT,IOUT)
1678 CALL SPMD_GLOB_ISUM9(IWIOUT,1)
1679 CALL SPMD_IBCAST(IWIOUT,IWIOUT,1,1,0,2)
1680 IF (IWIOUT > 0) THEN
1681 CALL SPMD_WIOUT(IOUT,IWIOUT)
1682 IWIOUT = 0
1683 ENDIF
1684 ENDIF
1685C
1686 END IF
1687C-----------------------
1688C 8. SPH PARTICLES
1689C-----------------------
1690 IF(NSPHOF > 0)THEN
1691.AND. IF(ISPMD == 0MCHECK == 0)WRITE (IOUT,1880)
1692 NN=(NSPHOF+4)/5
1693 NBC=5
1694 K=0
1695 DO I=1,NN
1696 READ (IIN,'(10i10)') (NLEC(II),II=1,10)
1697 DO J=1,NBC
1698 KLG=NLEC(2*J-1)
1699 KUG=NLEC(2*J )
1700 IF(KLG<=0) GO TO 732
1701 NBLK=(I-1)*NBC+J
1702 DO L=1,NUMSPH
1703.AND. IF(KXSP(NISP,L)>=KLGKXSP(NISP,L)<=KUG) THEN
1704C number of the related group :
1705 NG =MOD(ABS(KXSP(2,L)),NGROUP+1)
1706 IF(NG /= 0)THEN
1707 NFT=IPARG(3,NG)
1708 IAD=IPARG(4,NG)
1709 II=L-NFT
1710! ELBUF_STR(NG)%GBUF%OFF(II) = ZERO
1711 KXSP(2,L) = 0
1712 K=K+1
1713 NLECSPH(K) = KXSP(NISP,L)
1714 IF(K == 10)THEN
1715 IF(MCHECK == 0) WRITE (IOUT,'(5i10)') (NLECSPH(II),II=1,K)
1716 K=0
1717 END IF
1718 END IF
1719 ENDIF
1720 ENDDO
1721 ENDDO
1722 ENDDO
1723 732 CONTINUE
1724 IF(K > 0) THEN
1725 IF(MCHECK == 0)WRITE (IOUT,'(5i10)') (NLECSPH(II),II=1,K)
1726 END IF
1727 IF(NSPMD > 1) THEN
1728 ! required treatments to retrieve deleted elems in correct order
1729 IWIOUT = 0
1730 IF (ISPMD /= 0) CALL SPMD_CHKW(IWIOUT,IOUT)
1731 CALL SPMD_GLOB_ISUM9(IWIOUT,1)
1732 CALL SPMD_IBCAST(IWIOUT,IWIOUT,1,1,0,2)
1733 IF (IWIOUT > 0) THEN
1734 CALL SPMD_WIOUT(IOUT,IWIOUT)
1735 IWIOUT = 0
1736 ENDIF
1737 ENDIF
1738C
1739 END IF
1740!-----------------------
1741! 9. /DEL/PART
1742!-----------------------
1743 IF(NPARTOF > 0)THEN
1744.AND. IF(ISPMD == 0MCHECK == 0)WRITE (IOUT,1890)
1745 NN=(NPARTOF+4)/5
1746 NBC=5
1747 ALLOCATE(IPARTOF(NPART))
1748 IPARTOF = 0
1749 DO I=1,NN
1750 READ (IIN,'(10i10)') (NLEC(II),II=1,10)
1751 DO J=1,NBC
1752 KLG=NLEC(2*J-1)
1753 KUG=NLEC(2*J )
1754 IF(KLG<=0) GO TO 832
1755 NBLK=(I-1)*NBC+J
1756 DO L = 1, NPART
1757 DO K=KLG,KUG
1758 IF(IPART(4 + (L - 1) * LIPART1) == K) THEN
1759 IPARTOF(L)=1
1760 CYCLE
1761 ENDIF
1762 ENDDO
1763 ENDDO
1764 ENDDO
1765 ENDDO
1766 832 CONTINUE
1767 K=0
1768 DO L=1,NPART
1769 IF(IPARTOF(L)== 1)THEN
1770 K=K+1
1771 NLEC(K) = IPART(4 + (L - 1) * LIPART1)
1772 IF(K == 10)THEN
1773 IF(MCHECK == 0)WRITE (IOUT,'(5i10)') (NLEC(II),II=1,K)
1774 K=0
1775 ENDIF
1776 ENDIF
1777 ENDDO
1778 IF(K > 0) THEN
1779 IF(MCHECK == 0) WRITE (IOUT,'(5i10)') (NLEC(II),II=1,K)
1780 ENDIF
1781 IF(NSPMD > 1) THEN
1782 ! required treatments to retrieve deleted elems in correct order
1783 IWIOUT = 0
1784 IF (ISPMD /= 0) CALL SPMD_CHKW(IWIOUT,IOUT)
1785 CALL SPMD_GLOB_ISUM9(IWIOUT,1)
1786 CALL SPMD_IBCAST(IWIOUT,IWIOUT,1,1,0,2)
1787 IF (IWIOUT > 0) THEN
1788 CALL SPMD_WIOUT(IOUT,IWIOUT)
1789 IWIOUT = 0
1790 ENDIF
1791 ENDIF
1792!
1793 END IF
1794
1795C-------------------------------
1796C Output by interface :
1797C 1 - Skid lines
1798C-------------------------------
1799.AND. IF(H3D_DATA%N_SCAL_SKID > 0NINTSKIDOLD==0) THEN
1800 NINTERSKID = H3D_DATA%N_SCAL_SKID
1801 IF(NINTSTAMP/=0) THEN
1802 ALLOCATE (PSKIDS(NINTERSKID,NUMNODG))
1803 PSKIDS(1:NINTERSKID,1:NUMNODG) = ZERO
1804 ELSE
1805 ALLOCATE (PSKIDS(NINTERSKID,NUMNOD))
1806 PSKIDS(1:NINTERSKID,1:NUMNOD) = ZERO
1807 ENDIF
1808.AND. ELSEIF(H3D_DATA%N_SCAL_SKID == 0NINTSKIDOLD==0)THEN
1809 ALLOCATE (PSKIDS(0,0))
1810 ENDIF
1811C-------------------------------------------
1812C 2 - Frictionnal energy: allocs tabs
1813C--------------------------------------------
1814.AND. IF(H3D_DATA%N_SCAL_CSE_FRIC >0S_EFRIC == 0)THEN
1815 ALLOCATE(EFRICG(NUMNOD))
1816 EFRICG(1:NUMNOD) = ZERO
1817 IF(NINTSTAMP/=0) THEN
1818 ALLOCATE(EFRICG_STAMP(NUMNODG))
1819 EFRICG_STAMP(1:NUMNODG) = ZERO
1820 ELSE
1821 ALLOCATE(EFRICG_STAMP(0))
1822 ENDIF
1823 ELSEIF(S_EFRIC==0)THEN
1824 ALLOCATE(EFRICG(0))
1825 ALLOCATE(EFRICG_STAMP(0))
1826 ENDIF
1827
1828.AND. IF(H3D_DATA%N_SCAL_CSE_FRICINT > 0S_EFRICINT==0) THEN
1829C
1830 NINEFRICG = H3D_DATA%N_SCAL_CSE_FRICINT
1831 NINEFRIC_STAMP = 0
1832 NINEFRIC = 0
1833 IF(NINTSTAMP/=0) THEN
1834 DO N=1,NINTER
1835 NI = H3D_DATA%N_CSE_FRIC_INTER (N)
1836.AND. IF(NI/= 0IPARI(7,N)==21) NINEFRIC_STAMP = NINEFRIC_STAMP + 1
1837 ENDDO
1838 ENDIF
1839 IF(NINEFRIC_STAMP==NINEFRICG) THEN
1840 CALL MY_ALLOC(EFRIC_STAMP,NINEFRICG,NUMNODG)
1841 EFRIC_STAMP(1:NINEFRICG,1:NUMNODG) = ZERO
1842 CALL MY_ALLOC(EFRIC,0,0)
1843 ELSEIF(NINEFRIC_STAMP==0) THEN
1844 NINEFRIC = NINEFRICG
1845 CALL MY_ALLOC(EFRIC,NINEFRIC,NUMNOD)
1846 EFRIC(1:NINEFRICG,1:NUMNOD) = ZERO
1847 CALL MY_ALLOC(EFRIC_STAMP,0,0)
1848 ELSE
1849 NINEFRIC = NINEFRICG-NINEFRIC_STAMP
1850 CALL MY_ALLOC(EFRIC_STAMP,NINEFRIC_STAMP,NUMNODG)
1851 EFRIC_STAMP(1:NINEFRIC_STAMP,1:NUMNODG) = ZERO
1852 CALL MY_ALLOC(EFRIC,NINEFRIC,NUMNOD)
1853 EFRIC(1:NINEFRIC,1:NUMNOD) = ZERO
1854 NS = 0
1855 NN= 0
1856 DO N=1,NINTER
1857 NI = H3D_DATA%N_CSE_FRIC_INTER (N)
1858.AND. IF(NI/= 0IPARI(7,N)==21) THEN
1859 NS = NS+1
1860 H3D_DATA%N_CSE_FRIC_INTER (N) = NINEFRIC + NS
1861 ELSEIF (NI/=0) THEN
1862 NN = NN+1
1863 H3D_DATA%N_CSE_FRIC_INTER (N) = NN
1864 ENDIF
1865 ENDDO
1866 ENDIF
1867 ELSEIF(S_EFRICINT==0)THEN
1868 CALL MY_ALLOC(EFRIC,0,0)
1869 CALL MY_ALLOC(EFRIC_STAMP,0,0)
1870 ENDIF
1871C-----------------------------------
1872
1873C-----------------------
1874C RESET OFF ARRAY
1875C-----------------------
1876 IF (NELOF > 0)THEN
1877 DO NG=1,NGROUP
1878 OFFG => ELBUF_STR(NG)%GBUF%OFF
1879 MLW=IPARG(1,NG)
1880 ITY=IPARG(5,NG)
1881 NEL=IPARG(2,NG)
1882 NFT=IPARG(3,NG)
1883 IAD=IPARG(4,NG)
1884 IGOF=0
1885C-----------------------
1886C 1. SOLID ELEMS
1887C-----------------------
1888.AND. IF(ITY == 1NELSOF /= 0)THEN
1889 IGOF=1
1890 DO I=1,NEL
1891 II=I+NFT
1892 IF(IXS(1,II) < 0)THEN
1893 IXS(1,II)=-IXS(1,II)
1894 IF (MLW /= 0) THEN
1895 OFFG(I)=ZERO
1896 ELSE ! loi0, pas de off
1897 CALL ANCMSG(MSGID=238,ANMODE=ANINFO_BLIND,I1=IXS(NIXS,II),C1='brick',C2='brick')
1898 ENDIF
1899 ELSE
1900 IGOF=0
1901 ENDIF
1902 ENDDO
1903C-----------------------
1904C 2. 2D ELEMS
1905C-----------------------
1906.AND. ELSEIF(ITY == 2NELQOF /= 0)THEN
1907 IGOF=1
1908 DO I=1,NEL
1909 II=I+NFT
1910 IF(IXQ(1,II) < 0)THEN
1911 IXQ(1,II)=-IXQ(1,II)
1912 OFFG(I) = ZERO
1913 ELSE
1914 IGOF=0
1915 ENDIF
1916 ENDDO
1917C-----------------------
1918C 3. SHELL ELEMS
1919C-----------------------
1920.AND. ELSEIF(ITY == 3NELCOF /= 0)THEN
1921 IGOF=1
1922 DO I=1,NEL
1923 II=I+NFT
1924 IF(IXC(1,II) < 0)THEN
1925 IXC(1,II)=-IXC(1,II)
1926 IF (MLW /= 0) THEN
1927 OFFG(I) = ZERO
1928 ELSE ! loi0, pas de off
1929 CALL ANCMSG(MSGID=238,ANMODE=ANINFO_BLIND,I1=IXC(NIXC,II), C1='shell',C2='shell')
1930 ENDIF
1931 ELSE
1932 IGOF=0
1933 ENDIF
1934 ENDDO
1935C-----------------------
1936C 4. ROD ELEMS
1937C-----------------------
1938.AND. ELSEIF(ITY == 4NELTOF /= 0)THEN
1939C IGOF=1
1940C suppression du groupe incompatible avec option gap truss
1941 IGOF=0
1942 DO I=1,NEL
1943 II=I+NFT
1944 IF(IXT(1,II) < 0)THEN
1945 IXT(1,II)=-IXT(1,II)
1946 OFFG(I) = ZERO
1947C ELSE
1948C IGOF=0
1949 ENDIF
1950 ENDDO
1951C-----------------------
1952C 5. BEAM ELEMS
1953C-----------------------
1954.AND. ELSEIF(ITY == 5NELPOF /= 0)THEN
1955 IGOF=1
1956 DO I=1,NEL
1957 II=I+NFT
1958 IF(IXP(1,II) < 0)THEN
1959 IXP(1,II)=-IXP(1,II)
1960 OFFG(I) = ZERO
1961 ELSE
1962 IGOF=0
1963 ENDIF
1964 ENDDO
1965C-----------------------
1966C 6. ELEMENTS RESSORTS
1967C-----------------------
1968.AND. ELSEIF(ITY == 6NELROF /= 0)THEN
1969 IGOF=0
1970 DO I=1,NEL
1971 II=I+NFT
1972 IF(IXR(1,II) < 0)THEN
1973 IXR(1,II)=-IXR(1,II)
1974 OFFG(I) = ZERO
1975 ENDIF
1976 ENDDO
1977C-----------------------
1978C 7. 3N-SHELL-ELEMS
1979C-----------------------
1980.AND. ELSEIF(ITY == 7NELTGOF /= 0)THEN
1981 IGOF=1
1982 DO I=1,NEL
1983 II=I+NFT
1984 IF(IXTG(1,II) < 0)THEN
1985 IXTG(1,II)=-IXTG(1,II)
1986 IF(MLW /= 0) THEN
1987 OFFG(I) = ZERO
1988 ELSE ! loi0, pas de off
1989 CALL ANCMSG(MSGID=238,ANMODE=ANINFO_BLIND,I1=IXTG(NIXTG,II), C1='sh_3n',C2='sh_3n')
1990 ENDIF
1991 ELSE
1992 IGOF=0
1993 ENDIF
1994 ENDDO
1995C-----------------------
1996C 8. SPH PARTICLES
1997C-----------------------
1998.AND. ELSEIF(ITY == 51NSPHOF /= 0)THEN
1999 IGOF=1
2000 DO I=1,NEL
2001 II=I+NFT
2002 IF(KXSP(2,II) == 0)THEN
2003 OFFG(I) = ZERO
2004 ELSE
2005 IGOF=0
2006 ENDIF
2007 ENDDO
2008 ENDIF
2009C----------------------------------------
2010C CHECK FOR GROUP CLEANING
2011C----------------------------------------
2012 IPARG(8,NG)=MAX0(IPARG(8,NG),IGOF)
2013 ENDDO ! next NG
2014 END IF
2015! /DEL/PART
2016 IF(NPARTOF > 0)THEN
2017! per group
2018 K1=1+LIPART1*(NPART+NTHPART)+2*9*(NPART+NTHPART)
2019 K2=K1+NUMELS
2020 K3=K2+NUMELQ
2021 K4=K3+NUMELC
2022 K5=K4+NUMELT
2023 K6=K5+NUMELP
2024 K7=K6+NUMELR
2025 K8=K7
2026 K9=K8+NUMELTG
2027 K10= K9 + NUMELX
2028 K11= K10+ NUMSPH
2029 DO NG = 1, NGROUP
2030 OFFG => ELBUF_STR(NG)%GBUF%OFF
2031 MLW=IPARG(1,NG)
2032 ITY = IPARG(5, NG)
2033 NEL = IPARG(2, NG)
2034 NFT = IPARG(3, NG)
2035 IF (NEL == 0) CYCLE
2036 IGOF=0
2037 SELECT CASE (ITY)
2038 CASE(1)
2039! 1. SOLID ELEMS
2040 IGOF=1
2041 DO I=1,NEL
2042 II=I+NFT-1
2043 PARTID = IPART(K1 + II)
2044 IF (IPARTOF(PARTID)==1) THEN
2045 IF (MLW/=0) OFFG(I) = ZERO
2046 ELSE
2047 IGOF=0
2048 ENDIF
2049 ENDDO
2050 CASE(2)
2051! 2. 2D ELEMS
2052 IGOF=1
2053 DO I=1,NEL
2054 II=I+NFT-1
2055 PARTID = IPART(K2 + II)
2056 IF (IPARTOF(PARTID)==1) THEN
2057 OFFG(I) = ZERO
2058 ELSE
2059 IGOF=0
2060 ENDIF
2061 ENDDO
2062 CASE(3)
2063! 3. SHELL ELEMS
2064 IGOF=1
2065 DO I=1,NEL
2066 II=I+NFT-1
2067 PARTID = IPART(K3 + II)
2068 IF (IPARTOF(PARTID)==1) THEN
2069 IF (MLW/=0) OFFG(I) = ZERO
2070 ELSE
2071 IGOF=0
2072 ENDIF
2073 ENDDO
2074 CASE(4)
2075! 4. ROD ELEMS
2076 IGOF=0
2077 DO I=1,NEL
2078 II=I+NFT-1
2079 PARTID = IPART(K4 + II)
2080 IF (IPARTOF(PARTID)==1) OFFG(I) = ZERO
2081 ENDDO
2082 CASE(5)
2083! 5. BEAM ELEMS
2084 IGOF=1
2085 DO I=1,NEL
2086 II=I+NFT-1
2087 PARTID = IPART(K5 + II)
2088 IF (IPARTOF(PARTID)==1) THEN
2089 OFFG(I) = ZERO
2090 ELSE
2091 IGOF=0
2092 ENDIF
2093 ENDDO
2094 CASE(6)
2095! 6. ELEMENTS RESSORTS
2096 IGOF=0
2097 DO I=1,NEL
2098 II=I+NFT-1
2099 PARTID = IPART(K6 + II)
2100 IF (IPARTOF(PARTID)==1) OFFG(I) = ZERO
2101 ENDDO
2102 CASE(7)
2103! 7. 3N-SHELL-ELEMS
2104 IGOF=1
2105 DO I=1,NEL
2106 II=I+NFT-1
2107 PARTID = IPART(K7 + II)
2108 IF (IPARTOF(PARTID)==1) THEN
2109 IF (MLW/=0) OFFG(I) = ZERO
2110 ELSE
2111 IGOF=0
2112 ENDIF
2113 ENDDO
2114 CASE(51)
2115! 8. SPH PARTICLES
2116 IGOF=1
2117 DO I=1,NEL
2118 II=I+NFT-1
2119 PARTID = IPART(K10 + II)
2120 IF (IPARTOF(PARTID)==1) THEN
2121 OFFG(I) = ZERO
2122 ELSE
2123 IGOF=0
2124 ENDIF
2125 ENDDO
2126 END SELECT
2127 IPARG(8,NG)=MAX0(IPARG(8,NG),IGOF)
2128 ENDDO
2129 IF (ALLOCATED(IPARTOF)) DEALLOCATE(IPARTOF)
2130 END IF
2131C-------------------------------------------
2132C ADDING RIGID LINK BETWEEN NODES
2133C-------------------------------------------
2134.AND. IF(NRLINK > 0 MCHECK == 0) THEN
2135 K1 =1
2136 K2 =1
2137 DO K=1,NRLINK
2138 READ (IIN,'(i8,1x,3i1,1x,3i1,i10)')N,I1,I2,I3,IR1,IR2,IR3,ISK
2139 READ (IIN,'(10i10)') (LLINK(K2+I-1),I=1,N)
2140 IC=I3+2*I2+4*I1
2141 ICR=IR3+2*IR2+4*IR1
2142 IF(IRODDL == 0)ICR=0
2143.AND. IF(ISPMD == 0MCHECK == 0)WRITE(IOUT,2100) K,I1,I2,I3,IR1,IR2,IR3,ISK,N
2144.AND. IF(ISPMD == 0MCHECK == 0)WRITE(IOUT,'(10i10)') (LLINK(K2+I-1),I=1,N)
2145 IF ( ISK /= 0) THEN
2146 ISK1 = 0
2147 ISK2 = 0
2148 DO LL=0,NUMSKW
2149 IF(ISK == ISKWN(4,LL+1)) THEN
2150 ISK1 = LL
2151 ISK2 = 1
2152 ENDIF
2153 ENDDO
2154 IF ( ISK2 == 0) THEN
2155 CALL ANCMSG(MSGID=125,ANMODE=ANINFO)
2156 CALL ARRET(2)
2157 ENDIF
2158 ISK = ISK1
2159 ENDIF
2160 ! shared verification & defining specific data structure
2161 CALL FR_RLINK1(LLINK(K2),ITABM1,FR_RL(1,K),N)
2162 CALL RLINK0(
2163 1 V ,VR ,MS ,IN ,NNLINK(K1),
2164 2 NNLINK(K1+1),NNLINK(K1+2),LLINK(K2),N ,IC ,
2165 3 ICR ,NNLINK(K1+3),ISK ,SKEW(1,ISK+1),ISKWN ,
2166 4 FR_RL(1,K) ,WEIGHT )
2167 K1=K1+4
2168 K2=K2+N
2169 IF(IC+ICR == 0)THEN
2170 IF(ISPMD == 0)CALL ANCMSG(MSGID=126,ANMODE=ANINFO)
2171 CALL ARRET(2)
2172 ENDIF
2173 ENDDO
2174 ENDIF
2175C-------------------------------------------
2176C ALE - LINK ON GRID VELOCITY
2177C format v5 ('/VEL/*')
2178C-------------------------------------------
2179C
2180C |ALE LINK 1 |2 |NALELK
2181C +----+----+----+----+----+----+----+----+----+...-+----+----+----+--...+----+----+--...
2182C LINALE |uID | M1 | M2 | N | IC | IM |id1 |id2 |id3 |... |idn | ... |
2183C +----+----+----+----+----+----+----+----+----+...-+----+----+----+--...+----+----+--...
2184C (1:SLINALE) 1 2 3 4 5 6 6+1 6+N
2185C +LLINAL |
2186C (N=1 if grnod_id is used)
2187C
2188C First subarrays are used to define ale links from starter (1:SLINALE). Engine links are in (SLINALE+1:SLINALE+LLINAL)
2189C Only Starter part is written in restart files.
2190C
2191C M1 : MAIN node 1
2192C M2 : MAIN node 2
2193C N : number of nodes
2194C IC : dir XYZ
2195C IM : formulation option -1,0,1
2196C id*: node_id list or grnod_id
2197C
2198C N<0 means that ALE LINK is tagged in FRALNK() as defined from a grnod_id.
2199
2200C
2201C +--RADIOSS2
2202C +--LECINP
2203C | +--FREFORM (direct access writing IUSC1, counting number of /VEL/ALE cards)
2204C | +--FRALNK(src/freef/fralnk.F) (LINALE size calculation:SLINALE, reading/checking GRNOD option)
2205C +--LECTUR (storing data in LINALE)
2206C | +--FR_RLALE(priv/spmd/fr_rlink1.F) (check and tag available nodes on current domain)
2207C +--RESOL
2208C +--ALEWDX
2209C +--ALELIN(priv/ale/alelin.F) (ale link subroutine, updated to be used with grnod_id)
2210C
2211C
2212C
2213
2214C SLINALE : starter size
2215C LLINAL : engine size
2216C NALELK : engine /VEL/ALE card (obsolete)
2217C NALELINK: engine /ALELINK/VEL
2218C after reading : SLINALE <- SLINALE+LLINAL
2219C NALELK <- NALELK+NALELINK
2220
2221 NALELK_starter = 0
2222 IF(MCHECK==0)NALELK_starter = SLINALE/7 !SLINALE : starter linale size
2223 NALELK_removed=0
2224 K=6
2225
2226 !setting MAIN node user id to internal id
2227 DO J=1,NALELK_starter
2228.AND. IF(IRUN == 1 MCHECK == 0)
2229 . CALL FR_RLALE(LINALE(K-4),LINALE(K-3),LINALE(K+1),ITABM1,-1)
2230 K=K+1+6
2231 ENDDO
2232
2233.AND. IF(NALELK /= 0MCHECK == 0)THEN
2234 K=SLINALE+6 !LINALE(1:SLINALE):starter cards ;LINALE(SLINALE+1:SLINALE+LLINE):engine cards
2235 !K=5 !en attendant de copier LIALE starter dans (1:SLINALE)
2236 DO J=1,NALELK
2237 READ (IIN,'(3i10,5x,3i1,i10)')M1,M2,N,I1,I2,I3,IM
2238 !---------------------------------!
2239 ! ALE LINK DEFINED FROM NODES !
2240 !---------------------------------!
2241 IF(N>0)THEN
2242 READ (IIN,'(10i10)')(LINALE(K+I),I=1,N)
2243 IC=I3+2*I2+4*I1
2244 IF(IC == 0)THEN
2245 IC=7
2246 I1=1
2247 I2=1
2248 I3=1
2249 ENDIF
2250.AND. IF(ISPMD == 0MCHECK == 0)WRITE(IOUT,2200)M1,M2,I1,I2,I3,IM
2251 LINALE(K-4)=M1
2252 LINALE(K-3)=M2
2253 LINALE(K-2)=N
2254 LINALE(K-1)=IC
2255 LINALE(K)=IM
2256.AND. IF(ISPMD == 0MCHECK == 0)THEN
2257 WRITE(IOUT,'(10i10)')(LINALE(K+I),I=1,N)
2258 WRITE(IOUT,2201)
2259 ENDIF
2260c Verification partagee et tag en - noeuds non present
2261 CALL FR_RLALE(LINALE(K-4),LINALE(K-3),LINALE(K+1),ITABM1,N)
2262 K=K+N+6
2263 !---------------------------------!
2264 ! ALE LINK DEFINED FROM GRNOD !
2265 !---------------------------------!
2266 ELSE !N<=0
2267 !M1 < 0
2268 !GR_ID < 0
2269 READ (IIN,'(i10)', ERR=998,IOSTAT=IERROR)GR_ID
2270
2271 0998 IF(IERROR/=0)THEN
2272 WRITE(ISTDO,*) ' ** error in ale link: invalid grnod_id'
2273 GR_ID = 0
2274 ENDIF
2275 LINALE(K+1)=NGR2USR(GR_ID,IGRNOD,NGRNOD)
2276
2277 IF(LINALE(K+1)==0)CALL ARRET(2) !node group not found
2278
2279.AND. IF(IM==0IGRNOD(LINALE(K+1))%SORTED /= 1)THEN
2280 !option 0 needs to be defined with a /GRNOD/NODENS
2281 WRITE(ISTDO,*)' ** error in ale link:'
2282 WRITE(ISTDO,*) ' unsortable node group required with option 0 (/grnod/nodens)'
2283 WRITE(IOUT ,*)' ** error in ale link:'
2284 WRITE(IOUT,*) ' unsortable node group required with option 0 (/grnod/nodens)'
2285 CALL ARRET(2)
2286 ENDIF
2287
2288 IC=I3+2*I2+4*I1
2289 IF(IC == 0)THEN
2290 IC=7
2291 I1=1
2292 I2=1
2293 I3=1
2294 ENDIF
2295.AND. IF(ISPMD == 0MCHECK == 0)THEN
2296 WRITE(IOUT,2200)M1,M2,I1,I2,I3,IM !N=1 with GRNOD option
2297 WRITE(IOUT,2202)GR_ID
2298 ENDIF
2299 LINALE(K-4)=M1
2300 LINALE(K-3)=M2
2301 LINALE(K-2)=N
2302 LINALE(K-1)=IC
2303 LINALE(K)=IM
2304 !shared verification & untag non present nodes
2305 CALL FR_RLALE(LINALE(K-4),LINALE(K-3),LINALE(K+1),ITABM1,N)
2306 K=K+1+6
2307 ENDIF
2308 ENDDO !next J
2309 SLINALE = SLINALE + LLINAL
2310.AND. ENDIF !IF(NALELK /= 0MCHECK == 0)THEN
2311
2312C-------------------------------------------
2313C ALE - LINK ON GRID VELOCITY
2314C format >= v12 ('/ALE/LINK/*')
2315C-------------------------------------------
2316.AND. IF(NALELINK /= 0MCHECK == 0)THEN
2317 IF(NALELK==0)K=SLINALE+6
2318 DO J=1,NALELINK
2319 READ (IIN,'(3i10,5x,3i1,i10)')M1,M2,N,I1,I2,I3,IM
2320.AND. IF(M1>0M2>0)THEN
2321 !---------------------------------!
2322 ! ALE LINK DEFINED FROM NODES !
2323 !---------------------------------!
2324 IF(N>0)THEN
2325 READ (IIN,'(10i10)')(LINALE(K+I),I=1,N)
2326 IC=I3+2*I2+4*I1
2327 IF(IC == 0)THEN
2328 IC=7
2329 I1=1
2330 I2=1
2331 I3=1
2332 ENDIF
2333.AND. IF(ISPMD == 0MCHECK == 0)WRITE(IOUT,2200)M1,M2,I1,I2,I3,IM
2334 LINALE(K-4)=M1
2335 LINALE(K-3)=M2
2336 LINALE(K-2)=N
2337 LINALE(K-1)=IC
2338 LINALE(K)=IM
2339.AND. IF(ISPMD == 0MCHECK == 0)THEN
2340 WRITE(IOUT,'(10i10)')(LINALE(K+I),I=1,N)
2341 WRITE(IOUT,2201)
2342 ENDIF
2343 ! Verification partagee et tag en - noeuds non present
2344 CALL FR_RLALE(LINALE(K-4),LINALE(K-3),LINALE(K+1),ITABM1,N)
2345 K=K+N+6
2346 !---------------------------------!
2347 ! ALE LINK DEFINED FROM GRNOD !
2348 !---------------------------------!
2349 ELSE !(N<=0)
2350 READ (IIN,'(i10)', ERR=999,IOSTAT=IERROR)GR_ID
2351 0999 IF(IERROR/=0)THEN
2352 WRITE(ISTDO,*) ' ** error in ale link: cannot READ grnod_id VALUE'
2353 GR_ID = 0
2354 CALL ARRET(2) !node group not read
2355 ENDIF
2356
2357 LINALE(K+1)=NGR2USR(GR_ID,IGRNOD,NGRNOD)
2358 IF(LINALE(K+1)==0)THEN
2359 WRITE(ISTDO,*) ' ** error in ale link: invalid grnod_id'
2360 CALL ARRET(2) !node group not found
2361 ENDIF
2362
2363.AND. IF(IM==0IGRNOD(LINALE(K+1))%SORTED /= 1)THEN
2364 !option 0 needs to be defined with a /GRNOD/NODENS
2365 WRITE(ISTDO,*)' ** error in ale link:'
2366 WRITE(ISTDO,*)' unsortable node group required with option 0 (/grnod/nodens)'
2367 WRITE(IOUT ,*)' ** error in ale link:'
2368 WRITE(IOUT,*) ' unsortable node group required with option 0 (/grnod/nodens)'
2369 CALL ARRET(2)
2370 ENDIF
2371
2372 IC=I3+2*I2+4*I1
2373 IF(IC == 0)THEN
2374 IC=7
2375 I1=1
2376 I2=1
2377 I3=1
2378 ENDIF
2379.AND. IF(ISPMD == 0MCHECK == 0)THEN
2380 WRITE(IOUT,2200)M1,M2,I1,I2,I3,IM !N=1 with GRNOD option
2381 WRITE(IOUT,2202)GR_ID
2382 ENDIF
2383 LINALE(K-4)=M1
2384 LINALE(K-3)=M2
2385 LINALE(K-2)=N
2386 LINALE(K-1)=IC
2387 LINALE(K)=IM
2388 !shared verification & untag non present nodes
2389 CALL FR_RLALE(LINALE(K-4),LINALE(K-3),LINALE(K+1),ITABM1,N)
2390 K=K+1+6
2391 ENDIF !(N>0)
2392
2393 !---------------------------------!
2394 ! ALE LINK SET ON !
2395 !---------------------------------!
2396 ELSEIF(M1==-1)THEN ! ON
2397 ALLOCATE(ALELIN_ON_OFF(IABS(N)))
2398 READ (IIN,'(10i10)')(ALELIN_ON_OFF(I),I=1,N)
2399 !L=1 !pos
2400 KK=0 ! number of ale link deactivated
2401 DO I1=1,N
2402 L=1 !pos
2403 M1=ALELIN_ON_OFF(I1)
2404 DO I=1,NALELK_starter
2405 !---------------------------------!
2406 ! CHECK AND DEACTIVATE !
2407 !---------------------------------!
2408 IF(L>=SLINALE)THEN
2409 !warning : uID does not exist
2410 WRITE(ISTDO,*)' ** warning ale link does not exist :',M1
2411 WRITE(IOUT,*) ' ** warning ale link does not exist :',M1
2412 EXIT
2413 ELSE
2414 uID = LINALE(L+0)
2415 N = LINALE(L+3)
2416 IF(uID==-M1)THEN
2417 NALELK_removed = NALELK_removed+1 !counting deactivated links
2418 LINALE(L+0)=-LINALE(L+0) !setting negative uID to skip ALE LINK treatment (alelin.F)
2419 !printout :
2420.AND. IF(ISPMD == 0MCHECK == 0)WRITE(IOUT,2211)M1 !N=1 with GRNOD option
2421 EXIT !next ALELIN_ON_OFF
2422 ELSEIF(uID==M1)THEN
2423 NALELK_removed = NALELK_removed+1 !counting deactivated links
2424 !warning uID already set OFF :
2425 WRITE(ISTDO,*)' ** warning ale link already activated : ',M1
2426 EXIT !next ALELIN_ON_OFF
2427 ENDIF
2428
2429 ENDIF
2430 L = L+6+IABS(N) !next uID position in LINALE()
2431 ENDDO
2432 ENDDO
2433 DEALLOCATE(ALELIN_ON_OFF)
2434 !IF(NALELK_removed>0)NALELK_removed=1 !/ALE/LINK/ON or OFF card is no longer taken into account
2435
2436 !---------------------------------!
2437 ! ALE LINK SET OFF !
2438 !---------------------------------!
2439 ELSEIF(M1==-2)THEN ! OFF
2440 ALLOCATE(ALELIN_ON_OFF(IABS(N)))
2441 READ (IIN,'(10i10)')(ALELIN_ON_OFF(I),I=1,N)
2442 !L=1 !pos
2443 KK=0 ! number of ale link deactivated
2444 DO I1=1,N
2445 L=1 !pos
2446 M1=ALELIN_ON_OFF(I1)
2447 DO I=1,NALELK_starter
2448 !---------------------------------!
2449 ! CHECK AND DEACTIVATE !
2450 !---------------------------------!
2451 IF(L>=SLINALE)THEN
2452 !warning : uID does not exist
2453 WRITE(ISTDO,*) ' ** warning ale link does not exist :',M1
2454 WRITE(IOUT,*) ' ** warning ale link does not exist :',M1
2455 EXIT
2456 ELSE
2457 uID = LINALE(L+0)
2458 N = LINALE(L+3)
2459 IF(uID==M1)THEN
2460 NALELK_removed = NALELK_removed+1 !counting deactivated links
2461 LINALE(L+0)=-LINALE(L+0) !setting negative uID to skip ALE LINK treatment (alelin.F)
2462 !printout :
2463.AND. IF(ISPMD == 0MCHECK == 0)WRITE(IOUT,2210)M1 !N=1 with GRNOD option
2464 EXIT !next ALELIN_ON_OFF
2465 ELSEIF(uID==-M1)THEN
2466 NALELK_removed = NALELK_removed+1 !counting deactivated links
2467 !warning uID already set OFF :
2468 WRITE(ISTDO,*)' ** warning ale link already deactivated :',M1
2469 EXIT !next ALELIN_ON_OFF
2470 ENDIF
2471 ENDIF
2472 L = L+6+IABS(N) !next uID position in LINALE()
2473 ENDDO
2474 ENDDO
2475 DEALLOCATE(ALELIN_ON_OFF)
2476 !IF(NALELK_removed>0)NALELK_removed=1 !/ALE/LINK/ON or OFF card is no longer taken into account
2477 ENDIF
2478
2479 ENDDO
2480 SLINALE = SLINALE + LLINAL
2481 NALELK = NALELK+NALELINK-NALELK_removed
2482.AND. ENDIF !(NALELINK /= 0MCHECK == 0)
2483
2484 IF(MCHECK==0)NALELK=NALELK+NALELK_starter
2485
2486C-------------------------------------------
2487C ALE ON/ OFF
2488C-------------------------------------------
2489 IF(NBPARTALEON > 0) ALLOCATE(ALEON_PARTIDS_TMP(NBPARTALEON))
2490 IF(NBPARTALEOFF > 0) ALLOCATE(ALEOFF_PARTIDS_TMP(NBPARTALEOFF))
2491 ION = 0
2492 IOFF = 0
2493 DO I = 1, NBPARTALEON + NBPARTALEOFF
2494 READ(IIN, '(i10, i10)') PARTID, ISON
2495 IF (ISON == 1) THEN
2496 ION = ION + 1
2497 ALEON_PARTIDS_TMP(ION) = PARTID
2498 ELSE IF(ISON == 0) THEN
2499 IOFF = IOFF + 1
2500 ALEOFF_PARTIDS_TMP(IOFF) = PARTID
2501 ENDIF
2502 ENDDO
2503C Checking for doublon and suppression
2504 DO I = 1, NBPARTALEON
2505 PARTID = ALEON_PARTIDS_TMP(I)
2506 IF (PARTID /= -1) THEN
2507 DO J = 1, NBPARTALEON
2508 IF (J == I) CYCLE
2509 IF (ALEON_PARTIDS_TMP(J) == PARTID) THEN
2510 NBPARTALEON = NBPARTALEON - 1
2511 ALEON_PARTIDS_TMP(J) = -1
2512 ENDIF
2513 ENDDO
2514 ENDIF
2515 ENDDO
2516 DO I = 1, NBPARTALEOFF
2517 PARTID = ALEOFF_PARTIDS_TMP(I)
2518 IF (PARTID /= -1) THEN
2519 DO J = 1, NBPARTALEOFF
2520 IF (J == I) CYCLE
2521 IF (ALEOFF_PARTIDS_TMP(J) == PARTID) THEN
2522 NBPARTALEOFF = NBPARTALEOFF - 1
2523 ALEOFF_PARTIDS_TMP(J) = -1
2524 ENDIF
2525 ENDDO
2526C Check if part is also defined in ON
2527C By default, all parts are ON, if a part is set to OFF
2528C and ON at the same time, we choose to OFF it
2529 DO J = 1, NBPARTALEON
2530 IF (ALEON_PARTIDS_TMP(J) == PARTID) THEN
2531 !!! WARNING TO OUTPUT HERE
2532 ALEON_PARTIDS_TMP(J) = -1
2533 NBPARTALEON = NBPARTALEON - 1
2534 CALL ANCMSG(MSGID = 272, ANMODE = ANINFO, I1 = PARTID)
2535 ENDIF
2536 ENDDO
2537 ENDIF
2538 ENDDO
2539C Checking that part ids exist in IPART(4, *)
2540 NBALEOFF_PART = NBPARTALEOFF
2541 NBALEON_PART = NBPARTALEON
2542 DO I = 1, NBPARTALEON
2543 PARTID = ALEON_PARTIDS_TMP(I)
2544 ISON = 0
2545 IF (PARTID /= -1) THEN
2546 DO J = 1, NPART
2547 IF (IPART(4 + (J - 1) * LIPART1) == PARTID) THEN
2548 ISON = 1
2549 ALEON_PARTIDS_TMP(I) = J
2550 EXIT
2551 ENDIF
2552 ENDDO
2553 ENDIF
2554 IF (ISON == 0) THEN
2555 ALEON_PARTIDS_TMP(I) = -1
2556 NBALEON_PART = NBALEON_PART - 1
2557 CALL ANCMSG(MSGID = 271, ANMODE = ANINFO, I1 = PARTID)
2558 CALL ARRET(2)
2559 ENDIF
2560 ENDDO
2561 DO I = 1, NBPARTALEOFF
2562 PARTID = ALEOFF_PARTIDS_TMP(I)
2563 ISON = 0
2564 IF (PARTID /= -1) THEN
2565 DO J = 1, NPART
2566 IF (IPART(4 + (J - 1) * LIPART1) == PARTID) THEN
2567 ISON = 1
2568 ALEOFF_PARTIDS_TMP(I) = J
2569 EXIT
2570 ENDIF
2571 ENDDO
2572 ENDIF
2573 IF (ISON == 0) THEN
2574 ALEOFF_PARTIDS_TMP(I) = -1
2575 NBALEOFF_PART = NBALEOFF_PART - 1
2576 CALL ANCMSG(MSGID = 271, ANMODE = ANINFO, I1 = PARTID)
2577 CALL ARRET(2)
2578 ENDIF
2579 ENDDO
2580C Filling module values
2581 IF (NBALEOFF_PART > 0) ALLOCATE(ALEOFF_PARTIDS(NBALEOFF_PART))
2582 IF (NBALEON_PART > 0) ALLOCATE(ALEON_PARTIDS(NBALEON_PART))
2583 DO I = 1, NBPARTALEON
2584 PARTID = ALEON_PARTIDS_TMP(I)
2585 ISON = 0
2586 IF (PARTID /= -1) THEN
2587 ISON = ISON + 1
2588 ALEON_PARTIDS(ISON) = PARTID
2589 ENDIF
2590 ENDDO
2591 ISON = 0
2592 DO I = 1, NBPARTALEOFF
2593 PARTID = ALEOFF_PARTIDS_TMP(I)
2594 IF (PARTID /= -1) THEN
2595 ISON = ISON + 1
2596 ALEOFF_PARTIDS(ISON) = PARTID
2597 ENDIF
2598 ENDDO
2599C OUTPUT
2600 DO I = 1, NBALEOFF_PART
2601 WRITE(IOUT, 4800) ALEOFF_PARTIDS(I)
2602 ENDDO
2603C-------------------------------------------
2604C Fill IPARG
2605C-------------------------------------------
2606 K1 = 1 + LIPART1 * (NPART + NTHPART) + 2 * 9 * (NPART + NTHPART)
2607 K2 = K1 + NUMELS
2608 DO NG = 1, NGROUP
2609 ITY = IPARG(5, NG)
2610 NEL = IPARG(2, NG)
2611 NFT = IPARG(3, NG)
2612C Initially, IPARG(76, *) = 0 --> ON
2613C When restarting a computation, IPARG(76, NG) = Whatever was put here during previous run
2614C Find part associated to the current group
2615C by checking the first element of the group
2616C NB : all elements in a same group belong necessarily to the same part
2617
2618 IF (ITY == 1) THEN
2619C Solid groups
2620 PARTID = IPART(K1 + NFT)
2621 ELSEIF (ITY == 2) THEN
2622C Shells and coques
2623 PARTID = IPART(K2 + NFT)
2624 ENDIF
2625C Check if this part is found in ALEOFF_PARTIDS
2626 DO I = 1, NBALEOFF_PART
2627 IF (ALEOFF_PARTIDS(I) == PARTID) THEN
2628 IPARG(76, NG) = 1 ! --> OFF
2629 EXIT
2630 ENDIF
2631 ENDDO
2632C Check if this part is found in ALEON_PARTIDS
2633 DO I = 1, NBALEON_PART
2634 IF (ALEON_PARTIDS(I) == PARTID) THEN
2635 IPARG(76, NG) = 0 ! --> ON
2636 EXIT
2637 ENDIF
2638 ENDDO
2639 ENDDO
2640 IF (ALLOCATED(ALEON_PARTIDS_TMP)) DEALLOCATE(ALEON_PARTIDS_TMP)
2641 IF (ALLOCATED(ALEOFF_PARTIDS_TMP)) DEALLOCATE(ALEOFF_PARTIDS_TMP)
2642 IF (ALLOCATED(ALEON_PARTIDS)) DEALLOCATE(ALEON_PARTIDS)
2643 IF (ALLOCATED(ALEOFF_PARTIDS)) DEALLOCATE(ALEOFF_PARTIDS)
2644C-------------------------------------------
2645C MODIFICATION DES CONDITIONS AUX LIMITES
2646C-------------------------------------------
2647 IF(NUBCSN /= 0)THEN
2648 CALL LCBCSF(ICODE,ISKEW,NUBCSN,ITAB,ITABM1,NPBY ,ISKWN,WEIGHT)
2649 IF(NSPMD > 1) THEN
2650C traitement necessaire pour recuperer les noeuds cond limites
2651 IWIOUT = 0
2652 IF (ISPMD /= 0) CALL SPMD_CHKW(IWIOUT,IOUT)
2653 CALL SPMD_GLOB_ISUM9(IWIOUT,1)
2654 CALL SPMD_IBCAST(IWIOUT,IWIOUT,1,1,0,2)
2655 IF (IWIOUT > 0) THEN
2656 CALL SPMD_WIOUT(IOUT,IWIOUT)
2657 IWIOUT = 0
2658 END IF
2659 END IF
2660 END IF
2661C-------------------------------------------
2662C MODIFICATION DES INTERFACES
2663C-------------------------------------------
2664 IF(NINTCH /= 0)THEN
2665 DO I=1,NINTCH
2666 READ(IIN,'(2i8,2f16.0)')NOINT,NSEARCH,TSTART,TFIN
2667 IF(TFIN == 0.0)TFIN=1.E30
2668 IF(TFIN <= TSTART) THEN
2669 CALL ANCMSG(MSGID=307,ANMODE=ANSTOP)
2670 CALL ARRET(2)
2671 ENDIF
2672
2673 JPRI = -1
2674 DO J=1,NINTER
2675 IF(NOINT == IPARI(15,J)) THEN
2676 IF(NSEARCH /= 0) IPARI(13,J)=NSEARCH
2677 INTBUF_TAB(J)%VARIABLES(3) = TSTART
2678 INTBUF_TAB(J)%VARIABLES(11) = TFIN
2679 JPRI=J
2680 ENDIF
2681 ENDDO
2682 IF(JPRI/=-1) THEN
2683.AND. IF(ISPMD == 0MCHECK == 0) WRITE(IOUT,2300)NOINT,IPARI(13,JPRI),TSTART,TFIN
2684 ELSE
2685.AND. IF(ISPMD == 0MCHECK == 0) WRITE(IOUT,2301)NOINT
2686 ENDIF
2687 ENDDO
2688 ENDIF
2689C
2690 IF(MCHECK /= 0)THEN
2691 DO I = 1,MX_OUTP
2692 NV_OUTP = NV_OUTP + OUTP_V(I)
2693 NSS_OUTP = NSS_OUTP + OUTP_SS(I)
2694 NST_OUTP = NST_OUTP + OUTP_ST(I)
2695 NCS_OUTP = NCS_OUTP + OUTP_CS(I)
2696 NCT_OUTP = NCT_OUTP + OUTP_CT(I)
2697 NTS_OUTP = NTS_OUTP + OUTP_TS(I)
2698 NPS_OUTP = NPS_OUTP + OUTP_PS(I)
2699 NPT_OUTP = NPT_OUTP + OUTP_PT(I)
2700 NRS_OUTP = NRS_OUTP + OUTP_RS(I)
2701 NRT_OUTP = NRT_OUTP + OUTP_RT(I)
2702 ENDDO
2703 IF(OUTP_V(12) == 1)NV_OUTP=NV_OUTP+1
2704 ENDIF
2705C-------------------------------------------
2706C MODIFICATION OF RIGID BODY
2707C-------------------------------------------
2708 IF(NRBYOF /= 0)
2709 1 CALL RBYONF(IPARG,IPARI ,MS ,IN ,
2710 2 IXS ,IXQ ,IXC ,IXT ,IXP ,
2711 3 IXR ,SKEW ,ITAB ,ITABM1 ,ISKWN ,
2712 4 NPBY ,0 ,NRBYOF,WA ,LPBY ,
2713 5 RBY ,X ,V ,VR ,IXTG ,
2714 6 IGRV ,IBGR ,WEIGHT,FR_RBY2,PARTSAV,
2715 7 IPART,ELBUF_STR,ICFIELD,LCFIELD,TAGSLV_RBY)
2716C
2717 IF(NRBYON /= 0)
2718 1 CALL RBYONF(IPARG,IPARI ,MS ,IN ,
2719 2 IXS ,IXQ ,IXC ,IXT ,IXP ,
2720 3 IXR ,SKEW ,ITAB ,ITABM1 ,ISKWN ,
2721 4 NPBY ,1 ,NRBYON,WA ,LPBY ,
2722 5 RBY ,X ,V ,VR ,IXTG ,
2723 6 IGRV ,IBGR ,WEIGHT,FR_RBY2,PARTSAV,
2724 7 IPART,ELBUF_STR,ICFIELD,LCFIELD,TAGSLV_RBY)
2725C---------------------------------------------------------
2726C READING DATA FOR FLUX & ROTATION
2727C---------------------------------------------------------
2728.AND. IF (NSFLSW /= 0MCHECK == 0) THEN
2729 CALL LECFLSW (NSFLSW,NTFLSW,NEFLSW,NNFLSW,CRFLSW,X,IXS,IPARG,WA)
2730 ENDIF
2731C-------------------------------------------------
2732C MODIFICATION OF TIME FUNCTIONS
2733C-------------------------------------------------
2734 IF (NFCT /= 0) THEN
2735 CALL LECFUN (NPC, PLD, NFCT, NPTS, TABLE)
2736 END IF
2737C-------------------------------------------------
2738C RESET VELOCITIES
2739C-------------------------------------------------
2740 IF (NINIV /= 0) THEN
2741 CALL LECINV (NINIV,X,V,VR,ITAB,IFRAME,XFRAME,IGRNOD,FXBIPM,FXBVIT,FXBRPM)
2742 END IF
2743C---------------------------------------------------------
2744C CUTS
2745C---------------------------------------------------------
2746.AND. IF(NCUTS > 0MCHECK == 0)CALL LECCUT(ICUT,XCUT,ITABM1)
2747C---------------------------------------------------------
2748C ANIMATION (DT ,DMAS)
2749C---------------------------------------------------------
2750 DO I=1,SANIN
2751 ANIN(I)=ZERO
2752 ENDDO
2753C---------------------------------------------------------
2754C FILTERED SAMPLED OUTPUT
2755C---------------------------------------------------------
2756 IF(NNOISE > 0)CALL LECNOISE(INOISE,ITABM1,NAMES_AND_TITLES)
2757 NNOISER=NNOISE
2758C---------------------------------------------------------
2759C MADYMO COUPLING GENERAL DATA (CONVERSION FACTORS).
2760C---------------------------------------------------------
2761#ifdef DNC
2762.AND..AND. IF( IMADCPL > 0INVERS>=40MCHECK == 0)CALL LECCPL()
2763#endif
2764C---------------------------------------------------------
2765C OPTIONS SPMD SPECIFIQUES
2766.AND..AND. IF(IPREAD > 0ISPMD == 0MCHECK == 0) WRITE(IOUT,4000)
2767.AND..AND. IF(IDDW > 0ISPMD == 0MCHECK == 0) WRITE(IOUT,4100)
2768C---------------------------------------------------------
2769C RAYLEIGH DAMPING
2770C---------------------------------------------------------
2771 CALL LECDAMP(NDAMPN, DAMPR, IGRNOD)
2772C---------------------------------------------------------
2773 ISTATCND_SAV= ISTATCND
2774 IF(IMPL_S/=0) THEN
2775.AND. IF(ISPRB==0NADMESH/=0)THEN
2776 IF (ISPMD == 0) THEN
2777 CALL ANCMSG(MSGID=131,ANMODE=ANINFO)
2778 ENDIF
2779 CALL ARRET(2)
2780 ENDIF
2781 ISTATCND = 0
2782 END IF
2783C---------------------------------------------------------
2784.OR. IF (IMPL_S == 1NEIG > 0) CALL LECIMPL
2785 IF (NFXINP > 0) CALL LECFXINP(NFXINP)
2786 IF(ALE%SUB%NODSUBDT /= 0)THEN
2787 IF(ISPMD == 0) THEN
2788 CALL ANCMSG(MSGID=129,ANMODE=ANINFO_BLIND)
2789 END IF
2790 CALL ARRET(2)
2791 END IF
2792 IF (NEIGOFF > 0) CALL LECEIG(NEIGOFF, NEOFF)
2793 IF (NFVMESH > 0) CALL LECFVBAG(NFVMESH, MONVOL, VOLMON, X)
2794 IF (NFVMODI > 0) CALL LECFVBAG1(NFVMODI, MONVOL, VOLMON)
2795C-------------------------------------------
2796C .sta files
2797C-------------------------------------------
2798 IF(MCHECK /= 0)THEN
2799 NC_STAT = 0
2800 DO I = 1,MX_STAT
2801 NC_STAT = NC_STAT + STAT_C(I)
2802 ENDDO
2803 ENDIF
2804.OR. IF(NSTATPRT /= 0 NSTATALL /= 0)THEN
2805 K1=1+LIPART1*(NPART+NTHPART)+2*9*(NPART+NTHPART)
2806 K2=K1+NUMELS
2807 K3=K2+NUMELQ
2808 K4=K3+NUMELC
2809 K5=K4+NUMELT
2810 K6=K5+NUMELP
2811 K7=K6+NUMELR
2812 K8=K7
2813 K9=K8+NUMELTG
2814 CALL LECSTAT(IPART,IPART_STATE,ELBUF_STR,IPM,IPARG,IPART(K1),
2815 . IPART(K3),IPART(K8),MAT_PARAM)
2816 END IF
2817C-------------------------------------------
2818C .dynain files
2819C-------------------------------------------
2820.OR. IF(DYNAIN_DATA%NDYNAINPRT /= 0 DYNAIN_DATA%NDYNAINALL /= 0)THEN
2821 K1=1+LIPART1*(NPART+NTHPART)+2*9*(NPART+NTHPART)
2822 K2=K1+NUMELS
2823 K3=K2+NUMELQ
2824 K4=K3+NUMELC
2825 K5=K4+NUMELT
2826 K6=K5+NUMELP
2827 K7=K6+NUMELR
2828 K8=K7
2829 K9=K8+NUMELTG
2830 CALL READ_DYNAIN(IPART,DYNAIN_DATA,IPART(K3),IPART(K8),IXC,IXTG)
2831 END IF
2832c-----------------------------------------
2833c deallocate temporary SENSOR arrays
2834c-----------------------------------------
2835 IF (ALLOCATED(SENSORS%ANIM_TMP)) DEALLOCATE (SENSORS%ANIM_TMP)
2836 IF (ALLOCATED(SENSORS%STAT_TMP)) DEALLOCATE (SENSORS%STAT_TMP)
2837 IF (ALLOCATED(SENSORS%OUTP_TMP)) DEALLOCATE (SENSORS%OUTP_TMP)
2838 IF (ALLOCATED(SENSORS%STOP_TMP)) DEALLOCATE (SENSORS%STOP_TMP)
2839C---------------------------------------------------------
2840 IF(IERR == 0) RETURN
2841 CALL ARRET(0)
2842 1001 FORMAT(/
2843 & 1X,'ale euler solvers'/
2844 & 1X,'-----------------'/)
2845 1002 FORMAT(
2846 & 1X,' +--staggerred scheme'/
2847 & 1X,' | +--momentum : ',A16,' eta=',G14.7/
2848 & 1X,' | +--mass : ',A16,' eta=',G14.7/
2849 & 1X,' | +--energy : ',A16,' eta=',G14.7/
2850 & 1X,' | +--volume fraction : ',A16)
2851 1003 FORMAT(
2852 & 1X,' |'/
2853 & 1X,' +--colocated scheme(law151)'/
2854 & 1X,' | +--momentum : ',A16/
2855 & 1X,' | +--mass : ',A16/
2856 & 1X,' | +--energy : ',A16/
2857 & 1X,' | +--volume fraction : ',A16 )
2858 1004 FORMAT(
2859 & 1X,' | +--low mach option : enabled' )
2860 1005 FORMAT(
2861 & 1X,' | +--muscl option : enabled beta=',G14.7)
2862 1006 FORMAT(
2863 & 1X,' |'/
2864 & 1X,' +--time step'/
2865 & 1X,' | +--courant number : ',G14.7/
2866 & 1X,' | +--minimum time step : ',G14.7)
2867 1007 FORMAT(
2868 & 1X,' |'/
2869 & 1X,' +--grid smoothing'/
2870 & 1X,' +--formulation : ',A17)
2871 1008 FORMAT(
2872 & 1X,' +--parameters :')
2873
2874 1099 FORMAT(
2875 . ' multidomains coupling . . . . . . . . . . . . . .',G14.7//)
2876 1100 FORMAT(
2877 . ' final time . . . . . . . . . . . . . . . . . . . ',G14.7//
2878 . ' time interval for time history plots . . . . . . ',G14.7//
2879 . ' time step scale factor . . . . . . . . . . . . . ',G14.7//
2880 . ' minimum time step . . . . . . . . . . . . . . . ',G14.7//)
2881 1105 FORMAT(
2882 . ' brick time step scale factor . . . . . . . . . . ',G14.7/
2883 . ' brick minimum time step. . . . . . . . . . . . . ',G14.7/
2884 . ' min. time step flag(1:stop run, 2:delete brick) ',I5//
2885 . ' quad time step scale factor. . . . . . . . . . . ',G14.7/
2886 . ' quad minimum time step . . . . . . . . . . . . . ',G14.7/
2887 . ' min. time step flag(1:stop run, 2:delete quad). ',I5//
2888 . ' shell time step scale factor . . . . . . . . . . ',G14.7/
2889 . ' shell minimum time step. . . . . . . . . . . . . ',G14.7/
2890 . ' min. time flag(1:stop, 2:delete, 3:small strain)',I5//
2891 . ' truss time step scale factor . . . . . . . . . . ',G14.7/
2892 . ' truss minimum time step. . . . . . . . . . . . . ',G14.7/
2893 . ' min. time flag(1:stop, 2:delete). . . . . . . . ',I5//
2894 . ' beam time step scale factor. . . . . . . . . . . ',G14.7/
2895 . ' beam minimum time step . . . . . . . . . . . . . ',G14.7/
2896 . ' min. time flag(1:stop, 2:delete). . . . . . . . ',I5//
2897 . ' spring time step scale factor. . . . . . . . . . ',G14.7/
2898 . ' spring minimum time step . . . . . . . . . . . . ',G14.7/
2899 . ' min. time flag(1:stop, 2:delete). . . . . . . . ',I5//
2900 . ' airbag time step scale factor. . . . . . . . . . ',G14.7/
2901 . ' airbag minimum time step . . . . . . . . . . . . ',G14.7/
2902 . ' min. time flag(1:stop). . . . . . . . . . . . . ',I5//
2903 . ' contact time step scale factor . . . . . . . . . ',G14.7/
2904 . ' contact minimum time step. . . . . . . . . . . . ',G14.7/
2905 . ' min. time flag(1:stop, 2:remove node from interf)',I5/ )
2906 1155 FORMAT('/dt/fvmbag/0 option')
2907 1156 FORMAT('/dt/fvmbag/1 option')
2908 1157 FORMAT('fvmbag time step synthesis')
2909 1147 FORMAT(
2910 . ' fvmbag id. . . . . . . . . . . . . . . . . . . . ',I10)
2911 1148 FORMAT(
2912 . ' fvmbag1 id. . . . . . . . . . . . . . . . . . . . ',I10)
2913 1149 FORMAT(
2914 . ' fvmbag2 id. . . . . . . . . . . . . . . . . . . . ',I10)
2915 1151 FORMAT(
2916 . ' smooth particles time step scale factor. . . . . ',G14.7/
2917 . ' smooth particles minimum time step . . . . . . . ',G14.7/
2918 . ' min. time flag(1:stop, 2:delete, 5:kill). . . . ',I5 )
2919 1152 FORMAT(
2920 . ' fvmbag time step scale factor. . . . . . . . . . ',G14.7/
2921 . ' fvmbag minimum time step . . . . . . . . . . . . ',G14.7/
2922 . ' fvmbag time step flag. . . . . . . . . . . . . . ',I5,/)
2923 1153 FORMAT(
2924 . ' . . time step scale factor. . . . . . . . . . . . . . ',G14.7/
2925 . ' . . minimum time step . . . . . . . . . . . . . . . . ',G14.7/
2926 . ' . . time step flag. . . . . . . . . . . . . . . . . . ',I5)
2927 1154 FORMAT(
2928 . ' . . characteristic length option. . . . . . . . . . . ',I5/
2929 . ' . . time step smoothing factor. . . . . . . . . . . . ',G14.7/
2930 . ' . . previous time step. . . . . . . . . . . . . . . . ',G14.7)
2931 1107 FORMAT(
2932 . ' contact nodal time step scale factor . . . . . . ',G14.7/
2933 . ' contact nodal minimum time step. . . . . . . . . ',G14.7/
2934 . ' contact nodal min. time flag . . . . . . . . . . ',I5/
2935 . ' 3:increase mass, original formulation . . . . ',/
2936 . ' 8:increase mass, improved formulation . . . . ',//)
2937 1209 FORMAT(
2938 . ' AMS CONTACT TIME STEP IS ON . . . . . . . . . . . . .',/
2939 . ' . . . . . .(ALL CONTACTS WILL BE CONCERNED).) . . . .',/
2940 . ' AMS CONTACT TIME STEP SCALE FACTOR. . . . . . . . . .',g14.7/
2941 . ' AMS CONTACT MINIMUM TIME STEP . . . . . . . . . . . .',g14.7//)
2942 1106 FORMAT(
2943 . ' NODAL TIME STEP SCALE FACTOR, . . . . . . . . . ',g14.7/
2944 . ' NODAL MINIMUM TIME STEP. . . . . . . . . . . . . ',g14.7/
2945 . ' MIN. TIME FLAG . . . . . . . . . . . . . . . . . ',i5/
2946 . ' 1:STOP. . . . . . . . . . . . . . . . . . . . ',/
2947 . ' 3:INCREASE MASS, ORIGINAL FORMULATION . . . . ',/
2948 . ' 8:INCREASE MASS, IMPROVED FORMULATION . . . . ',//)
2949 1116 FORMAT(
2950 . ' NODAL TIME STEP SCALE FACTOR, . . . . . . . . . ',g14.7/
2951 . ' NODAL MINIMUM TIME STEP. . . . . . . . . . . . . ',g14.7/)
2952 1206 FORMAT(
2953 . ' NODAL TIME STEP SCALE FACTOR, . . . . . . . . . ',g14.7/
2954 . ' NODAL MINIMUM TIME STEP. . . . . . . . . . . . . ',g14.7/
2955 . ' ADDED MASS RATIO (DM/M0) . . . . . . . . . . . . ',g14.7/
2956 . ' MIN. TIME FLAG . . . . . . . . . . . . . . . . . ',i5/
2957 . ' 1:STOP. . . . . . . . . . . . . . . . . . . . ',/
2958 . ' 3:INCREASE MASS, ORIGINAL FORMULATION . . . . ',/
2959 . ' 8:INCREASE MASS, IMPROVED FORMULATION . . . . ',//)
2960 1108 FORMAT(
2961 . ' ADVANCED MASS SCALING IS ON . . . . . . . . . . .',/
2962 . ' AMS NODAL TIME STEP SCALE FACTOR. . . . . . . . .',g14.7/
2963 . ' AMS NODAL MINIMUM TIME STEP . . . . . . . . . . .',g14.7/
2964 . ' AMS TOLERANCE ON CONVERGENCE. . . . . . . . . . .',g14.7/
2965 . ' AMS MAXIMUM NUMBER OF ITERATIONS FOR CONVERGENCE.',i10/
2966 . ' OUTPUT FREQUENCY OF INFORMATION / CONVERGENCE . .',i10/
2967 . ' PART GROUP ID (=0 ALL PARTS) . . . . . . . . . . ',i10//)
2968 1109 FORMAT(
2969 . ' ADVANCED MASS SCALING IS ON . . . . . . . . . . .',/
2970 . ' AMS TIME STEP SCALE FACTOR. . . . . . . . . . . .',g14.7/
2971 . ' AMS MINIMUM TIME STEP . . . . . . . . . . . . . .',g14.7/
2972 . ' AMS TOLERANCE ON CONVERGENCE. . . . . . . . . . .',g14.7/
2973 . ' AMS MAXIMUM NUMBER OF ITERATIONS FOR CONVERGENCE.',i10/
2974 . ' NUMBER OF PRECONDITIONING VECTORS FOR PCG . . . .',i10/
2975 . ' OUTPUT FREQUENCY OF INFORMATION / CONVERGENCE . .',i10/
2976 . ' PART GROUP ID (=0 ALL PARTS) . . . . . . . . . . ',i10//)
2977 2109 FORMAT(
2978 . ' ADVANCED MASS SCALING IS ON . . . . . . . . . . .',/
2979 . ' AMS TIME STEP SCALE FACTOR. . . . . . . . . . . .',g14.7/
2980 . ' ams minimum time step . . . . . . . . . . . . . .',G14.7/
2981 . ' ams tolerance on convergence. . . . . . . . . . .',G14.7/
2982 . ' ams maximum number of iterations for convergence.',I10/
2983 . ' number of preconditioning vectors for pcg . . . .',I10/
2984 . ' output frequency of information / convergence . .',I10/
2985 . ' auto element selection - time step criteria . . .',G14.7/
2986 . ' part group id(=0 all parts) . . . . . . . . . . ',I10//)
2987 1110 FORMAT(
2988 . ' printout cycle frequency . . . . . . . . . . . . ',I5 //
2989 . ' restart cycle frequency. . . . . . . . . . . . . ',I10 //
2990 . ' maximum restart WRITE before overwrite . . . . . ',I5 //
2991 . ' invers: input deck version . . . . . . . . . . . ',I5/
2992 . ' ittyp : flag for TYPE of t-file. . . . . . . . . ' ,I5/)
2993 1120 FORMAT(/
2994 . ' time for first animation-file plot . . . . . . . ',G14.7/
2995 . ' time interval for animation-file plots . . . . . ',G14.7/
2996 . ' time to stop animation-file plots. . . . . . . . ',G14.7/
2997 . ' sensor for animation-file plots. . . . . . . . . ',I10/
2998 . ' time interval for sensor animation-file plots. . ',G14.7//
2999 . ' variable saved on animation files(1: yes) :',/
3000 . ' plastic strain. . . . . . ',I5/
3001 . ' density(solid only). ',I5/
3002 . ' specific energy . . . . . ',I5/
3003 . ' hourglass energy. . . . . ',I5/
3004 . ' temperature(solid only). ',I5/
3005 . ' thickness(shell only). ',I5/
3006 . ' pressure(solid only). ',I5/
3007 . ' von mises . . . . . . . . ',I5/
3008 . ' turbulent energy(fluid). ',I5/
3009 . ' turbulent viscosity(fluid)',I5/
3010 . ' vorticity(fluid) . . . . ',I5)
3011 1129 FORMAT(
3012 . ' nodal values saved on animation files(1: yes) :',/
3013 . ' pressure. . . . . . . . . ',I5/
3014 . ' density . . . . . . . . . ',I5/
3015 . ' temperature . . . . . . . ',I5)
3016 1130 FORMAT(
3017 . ' vector saved on animation files(1: yes) :',/
3018 . ' velocity vector . . . . . ',I5/
3019 . ' displacement vector . . . ',I5/
3020 . ' acceleration vector . . . ',I5/
3021 . ' contact forces. . . . . . ',I5/
3022 . ' internal forces . . . . . ',I5/
3023 . ' EXTERNAL forces . . . . . ',I5/
3024 . ' section rby rwall forces. ',I5/
3025 . ' rotational velocity vector',I5/
3026 . ' contact pressure(vectors)',I5/
3027 . ' shell tensor saved on animation files(1: yes) :',/
3028 . ' membrane stress . . . . . ',I5/
3029 . ' bending stress(moment/t^2)',I5/
3030 . ' upper layer stress. . . . ',I5/
3031 . ' lower layer stress. . . . ',I5)
3032 1140 FORMAT(
3033 . ' membrane strain . . . . . ',I5/
3034 . ' curvature . . . . . . . . ',I5/
3035 . ' upper layer strain. . . . ',I5/
3036 . ' lower layer strain. . . . ',I5/
3037 . ' nodal mass saved on animation files(1: yes) :',I5/
3038 . ' keep deleted element(1: yes) :',I5//)
3039 1150 FORMAT(
3040 . ' initial time step. . . . . . . . . . . . . . . . ',G14.7/
3041 . ' maximum time step. . . . . . . . . . . . . . . . ',G14.7)
3042 1160 FORMAT(/
3043 . ' IMPLICIT : conjugated gradient ' /
3044 . ' global convergence precision . . . . . . . . . . ',G14.7/
3045 . ' incremental convergence precision. . . . . . . . ',G14.7/
3046 . ' maximum number of iterations . . . . . . . . . . ',I5)
3047 1171 FORMAT(/
3048 . ' dynamic relaxation ' /
3049 . ' node group id(=0 all nodes) . . . . . . . . . . ',I10/
3050 . ' beta . . . . . . . . . . . . . . . . . . . . . . ',G14.7/
3051 . ' period . . . . . . . . . . . . . . . . . . . . . ',G14.7)
3052 1172 FORMAT(/
3053 . ' kinematic relaxation ' /
3054 . ' node group id(=0 all nodes) . . . . . . . . . . ',I10)
3055 1180 FORMAT(/
3056 . ' parallel arithmetic off')
3057 1181 FORMAT(/
3058 . ' parallel arithmetic on')
3059 1182 FORMAT(/
3060 . ' parallel arithmetic flag . . . . . . . . . . . . ',I5)
3061 1196 FORMAT(/
3062 . ' quasi-compressible formulation on (/incmp)')
3063 1198 FORMAT(
3064 . ' momentum : mixed integration')
3065 1199 FORMAT(
3066 . ' momentum : volume integration')
3067 1200 FORMAT(
3068 . 28X,' alpha : donea coefficient. . . . . . . . . . . ',G14.7/
3069 . 28X,' gamma : grid velocity limitation factor. . . . ',G14.7/
3070 . 28X,' fscalex : x-grid velocity scale factor . . . . . ',G14.7/
3071 . 28X,' fscaley : y-grid velocity scale factor . . . . . ',G14.7/
3072 . 28X,' fscalez : z-grid velocity scale factor . . . . . ',G14.7/
3073 . 28X,' volmin : minimum volume for element deletion. . ',G14.7//)
3074 1220 FORMAT(
3075 . 28X,' umax : maximum absolute grid velocity . . . . . ',G14.7/
3076 . 28X,' vmin : minimum volume for element deletion. . . ',G14.7//)
3077 1250 FORMAT(
3078 . 28X,' dt0 : typical time step. . . . . . . . . . . . ',G14.7/
3079 . 28X,' dt0* : effective time step. . . . . . . . . . . ',G14.7/
3080 . 28X,' gamma : non linearity factor . . . . . . . . . . ',G14.7/
3081 . 28X,' eta : damping coefficient . . . . . . . . . . ',G14.7/
3082 . 28X,' nu : shear factor . . . . . . . . . . . . . . ',G14.7/
3083 . 28X,' volmin: minimum volume for element deletion. . . ',G14.7//)
3084 1254 FORMAT(
3085 . 28X,' alpha : stability factor . . . . . . . . . . . . ',G14.7/
3086 . 28X,' gamma : non linearity factor . . . . . . . . . . ',G14.7/
3087 . 28X,' beta : damping coefficient. . . . . . . . . . . ',G14.7/
3088 . 28X,' lc : characteristic length. . . . . . . . . . ',G14.7//)
3089 1257 FORMAT(
3090 . 28X,' enabled deformation . . . . . . . . . . . . . . ',A3/
3091 . 28X,' enabled rotation . . . . . . . . . . . . . . . ',A3/
3092 . 28X,' scale factor for deformation . . . . . . . . . . ',G14.7/
3093 . 28X,' scale factor for rotation . . . . . . . . . . . ',G14.7//)
3094 1300 FORMAT(
3095 . ' number of interfaces to be eliminated. . . . . . ',I8//
3096 . ' number of parts to be eliminated . . . . . . . . ',I8//
3097 . ' number of solid element blocks to be eliminated ',I8//
3098 . ' number of quad element blocks to be eliminated ',I8//
3099 . ' number of shell element blocks to be eliminated ',I8//
3100 . ' number of truss element blocks to be eliminated ',I8//
3101 . ' number of beam element blocks to be eliminated ',I8//
3102 . ' number of spring element blocks to be eliminated ',I8//
3103 . ' number of sh_3n element blocks to be eliminated ',I8//
3104 . ' number of sph particles blocks to be eliminated ',I8/)
3105 1400 FORMAT(
3106 . ' number of rigid links. . . . . . . . . . . . . . ',I8/)
3107 1450 FORMAT(
3108 . ' number of ale links. . . . . . . . . . . . . . . ',I8/)
3109 1500 FORMAT(
3110 . ' number of new boundary conditions. . . . . . . . ',I8/)
3111 1550 FORMAT(
3112 . ' remove inter.7 segment after shell failure(1 yes)',I5/)
3113 1810 FORMAT(///' list of eliminated solid elements ')
3114 1820 FORMAT(///' list of eliminated quad elements ')
3115 1830 FORMAT(///' list of eliminated shell elements ')
3116 1840 FORMAT(///' list of eliminated truss elements ')
3117 1850 FORMAT(///' list of eliminated beam elements ')
3118 1860 FORMAT(///' list of eliminated spring elements ')
3119 1870 FORMAT(///' list of eliminated sh_3n elements ')
3120 1880 FORMAT(///' list of eliminated sph particles ')
3121 1890 FORMAT(///' list of eliminated parts ')
3122 2000 FORMAT(/' INTERFACE number',I10,' is eliminated')
3123 2100 FORMAT(/' rigid link:',I5,
3124 . ' translation x,y,z',3(1X,I1),
3125 . ' rotation x,y,z',3(1X,I1),
3126 . ' skew ',I10,/
3127 . ' ---------- ',I10,' nodes :')
3128 2200 FORMAT(/' ALE LINK: ',/,
3129 . ' --------',/,
3130 . ' MAIN NODES : ',2i8,/,
3131 . ' (X,Y,Z) : (',i1,',',i1,',',i1,')',/,
3132 . ' TYPE : ',i2)
3133 2201 FORMAT( ' NODES :')
3134 2202 FORMAT( ' NODE GROUP : ',i2)
3135 2210 FORMAT(' DEACTIVATING ALE LINK ID:',i5)
3136 2211 FORMAT(' ACTIVATING ALE LINK ID:',i5)
3137 2300 FORMAT(/' INTERFACE CHANGES'/
3138 . ' INTERFACE NB . . . . . . . . . . . . . . . . . . ',i10/
3139 . ' SEARCH OF CLOSEST NODES EACH NSEARCH TIME STEPS. ',i5/
3140 . ' START TIME . . . . . . . . . . . . . . . . . . . ',g14.7/
3141 . ' STOP TIME . . . . . . . . . . . . . . . . . . . ',g14.7)
3142
3143 2301 FORMAT(/' ERROR IN INTERFACE CHANGES'/
3144 . ' INTERFACE NB IS NOT EXISTING . . . . . . . . . . ',i10)
3145
3146 4000 FORMAT(/
3147 . ' SPMD PARALLEL RESTART READING (PREAD) ACTIVATED')
3148 4100 FORMAT(/
3149 . ' SPMD ELEMENT WEIGHT ESTIMATION (DDW) ACTIVATED')
3150C
3151 4500 FORMAT(/
3152 & 1x,'EXTERNAL LIBRARY FOR USERS CODE INTERFACE ')
3153 4600 FORMAT(
3154 & 1x,'LIBRARY NAME . . . . . . . . . . . . . . . . . . . . ',a/
3155 & 1x,'RADIOSS USERS CODE INTERFACE VERSION . . . . . . . .',i10//)
3156 4700 FORMAT(
3157 . ' BRICK TIME STEP SCALE FACTOR . . . . . . . . . . ',g14.7/
3158 . ' BRICK MINIMUM TIME STEP. . . . . . . . . . . . . ',g14.7/
3159 . ' MIN. TIME STEP FLAG (1:STOP RUN, 2:DELETE 3:CST )',i5//
3160 . ' BRICK_CST MINIMUM ASPECT RATIO (Tet collapse). . ',g14.7/
3161 . ' BRICK_CST MINIMUM VOLUME CHANGE . . . . . . . . ',g14.7//
3162 . ' QUAD TIME STEP SCALE FACTOR. . . . . . . . . . . ',g14.7/
3163 . ' QUAD MINIMUM TIME STEP . . . . . . . . . . . . . ',g14.7/
3164 . ' MIN. TIME STEP FLAG (1:STOP RUN, 2:DELETE QUAD). ',i5//
3165 . ' SHELL TIME STEP SCALE FACTOR . . . . . . . . . . ',g14.7/
3166 . ' SHELL MINIMUM TIME STEP. . . . . . . . . . . . . ',g14.7/
3167 . ' MIN. TIME FLAG (1:STOP, 2:DELETE, 3:SMALL STRAIN)',i5//
3168 . ' TRUSS TIME STEP SCALE FACTOR . . . . . . . . . . ',g14.7/
3169 . ' TRUSS MINIMUM TIME STEP. . . . . . . . . . . . . ',g14.7/
3170 . ' MIN. TIME FLAG (1:STOP, 2:DELETE). . . . . . . . ',i5//
3171 . ' BEAM TIME STEP SCALE FACTOR. . . . . . . . . . . ',g14.7/
3172 . ' BEAM MINIMUM TIME STEP . . . . . . . . . . . . . ',g14.7/
3173 . ' MIN. TIME FLAG (1:STOP, 2:DELETE). . . . . . . . ',i5//
3174 . ' SPRING TIME STEP SCALE FACTOR. . . . . . . . . . ',g14.7/
3175 . ' SPRING MINIMUM TIME STEP . . . . . . . . . . . . ',g14.7/
3176 . ' MIN. TIME FLAG (1:STOP, 2:DELETE). . . . . . . . ',i5//
3177 . ' AIRBAG TIME STEP SCALE FACTOR. . . . . . . . . . ',g14.7/
3178 . ' AIRBAG MINIMUM TIME STEP . . . . . . . . . . . . ',g14.7/
3179 . ' MIN. TIME FLAG (1:STOP). . . . . . . . . . . . . ',i5//
3180 . ' INTERFACE TYPE 7 TIME STEP SCALE FACTOR. . . . . ',g14.7/
3181 . ' INTERFACE type 7 minimum time step . . . . . . . ',G14.7/
3182 . ' min. time flag(1:stop, 2:remove node from interf)',I5/ )
3183 4720 FORMAT(
3184 . ' accurate time step for shells is used. . . . . . ',/)
3185 4730 FORMAT(
3186 . ' accurate time step for 4-node & 8-node solid is used',/)
3187 4740 FORMAT(
3188 . ' accurate time step for 10-node tetrahedra is used ',/)
3189 4800 FORMAT(
3190 . ' part deactivated for ale / euler computation',2X,I10)
3191 5000 FORMAT(/' h3d files : '/
3192 . ' time for first h3d-file plot . . . . . . . . . . ',G14.7/
3193 . ' time interval for h3d-file plots . . . . . . . . ',G14.7/
3194 . ' variable saved on h3d files : ')
3195 5001 FORMAT(/
3196 . ' kinematic relaxation ' /
3197 . ' node group id(=0 all nodes) . . . . . . . . . . ',I10/
3198 . ' start time. . . . . . . . . . . . . . . . . . . ',G14.7/
3199 . ' stop time. . . . . . . . . . . . . . . . . . . ',G14.7)
3200 5010 FORMAT(/
3201 . ' adaptive dynamic relaxation ' ,/
3202 . ' node group id(=0 all nodes) . . . . . . . . . . ',I10/)
3203 5011 FORMAT(/
3204 . ' adaptive dynamic relaxation ' /
3205 . ' node group id(=0 all nodes) . . . . . . . . . . ',I10/
3206 . ' start time. . . . . . . . . . . . . . . . . . . ',g14.7/
3207 . ' STOP TIME. . . . . . . . . . . . . . . . . . . ',g14.7)
3208 5020 FORMAT(
3209 . ' BRICK_DEL MINIMUM COLLAPSE RATIO. . . . . . . . . ',g14.7/
3210 . ' BRICK_DEL MINIMUM VOLUME CHANGE . . . . . . . . . ',g14.7/
3211 . ' BRICK_DEL MAXIMUM ASPECT RATIO . . . . . . . . . ',g14.7/
3212 . ' BRICK_DEL MAXIMUM VOLUME CHANGE . . . . . . . . . ',g14.7//)
3213
3214 END
3215!||====================================================================
3216!|| prout_buck ../engine/source/input/lectur.F
3217!||--- called by ------------------------------------------------------
3218!|| lecimpl ../engine/source/input/lectur.F
3219!||--- uses -----------------------------------------------------
3220!|| imp_kbcs ../engine/share/modules/impbufdef_mod.F
3221!||====================================================================
3222 SUBROUTINE prout_buck(IP,NBUCK,IBUCK)
3223C-----------------------------------------------
3224C M o d u l e s
3225C-----------------------------------------------
3226 USE imp_kbcs
3227C-----------------------------------------------
3228C I m p l i c i t T y p e s
3229C-----------------------------------------------
3230#include "implicit_f.inc"
3231C-----------------------------------------------
3232C D u m m y A r g u m e n t s
3233C-----------------------------------------------
3234 INTEGER IP,NBUCK,IBUCK
3235C-----------------------------------------------
3236C L o c a l V a r i a b l e s
3237C-----------------------------------------------
3238 CHARACTER*25 MSG_BSOL(2)
3239 DATA
3240 . msg_bsol
3241 . / 'BCS',
3242 . '-' /
3243C-----------------------------------------------
3244 IF (ibuck > 0) THEN
3245 WRITE(ip,1000)
3246 ELSE
3247 WRITE(ip,2000)
3248 END IF
3249 WRITE(ip,3000)nbuck,shift_b,emin_b,emax_b,msgl_b,maxset_b, msg_bsol(1)
3250
3251 RETURN
3252 1000 FORMAT(
3253 . ' EULER BUCKLING ANALYSIS (RESTART):'/)
3254 2000 FORMAT(
3255 . ' EULER BUCKLING ANALYSIS :'/)
3256 3000 FORMAT(
3257 . ' NUMBER OF MODES TO BE COMPUTED: . . . . . ',2x,i5/
3258 . ' SHIFT IN BUCKLING MODES PENCIL: . . . . . ',2x,g14.7/
3259 . ' MINIMUM EIGENVALUE: . . . . . . . . . . . ',2x,g14.7/
3260 . ' MAXIMUM EIGENVALUE: . . . . . . . . . . . ',2x,g14.7/
3261 . ' OUTPUT MESSAGE LEVEL: . . . . . . . . . . ',2x,i5/
3262 . ' NUMBER OF VECTORS IN BLOCK OR SET: . . . ',2x,i5/
3263 . ' LINEAR SOLVER: . . . . . . . . . . . . . ',2x,a/)
3264 END
3265!||====================================================================
3266!|| lecimpl ../engine/source/input/lectur.F
3267!||--- called by ------------------------------------------------------
3268!|| lectur ../engine/source/input/lectur.F
3269!||--- calls -----------------------------------------------------
3270!|| ancmsg ../engine/source/output/message/message.F
3271!|| arret ../engine/source/system/arret.F
3272!|| floatmin ../common_source/tools/math/precision.c
3273!|| prout_buck ../engine/source/input/lectur.F
3274!|| spmd_max_s ../engine/source/mpi/implicit/imp_spmd.F
3275!||--- uses -----------------------------------------------------
3276!|| imp_kbcs ../engine/share/modules/impbufdef_mod.F
3277!|| imp_pcg_proj ../engine/share/modules/impbufdef_mod.F
3278!|| imp_spbrm ../engine/share/modules/impbufdef_mod.F
3279!|| message_mod ../engine/share/message_module/message_mod.F
3280!||====================================================================
3281 SUBROUTINE lecimpl
3282C-----------------------------------------------
3283C M o d u l e s
3284C-----------------------------------------------
3285 USE imp_kbcs
3286 USE imp_pcg_proj
3287 USE imp_spbrm
3288 USE message_mod
3289C-----------------------------------------------
3290C I m p l i c i t T y p e s
3291C-----------------------------------------------
3292#include "implicit_f.inc"
3293C-----------------------------------------------
3294C C o m m o n B l o c k s
3295C-----------------------------------------------
3296#include "com01_c.inc"
3297#include "com04_c.inc"
3298#include "com06_c.inc"
3299#include "units_c.inc"
3300#include "task_c.inc"
3301#include "impl1_c.inc"
3302#include "impl2_c.inc"
3303#include "buckcom.inc"
3304C-----------------------------------------------
3305C L o c a l V a r i a b l e s
3306C-----------------------------------------------
3307 INTEGER J,NTY,IPRINT,IBID,ISOL
3308 my_real CS1(2),S
3309 REAL FLMIN
3310 CHARACTER*25 MSG_TYPE(9),MSG_ISOL(9),MSG_INSOL(4),MSG_PRE(5),MSG_BSOL(3)
3311 DATA
3312 . MSG_TYPE
3313 . / 'STATIC LINEAR',
3314 . 'STATIC NON-LINEAR',
3315 . 'DYNAMIC NON-LINEAR',
3316 . 'MODAL ANALYSIS',
3317 . 'CHECK',
3318 . 'QUASI-STATIC LINEAR',
3319 . 'QUASI-STATIC NON-LINEAR',
3320 . 'BUCKLING',
3321 . 'RADIOSS-AcuSolve DC-FSI'/,
3322 . MSG_ISOL
3323 . / 'PREC. CONJUGATE GRADIENT',
3324 . 'DIRECT(MUMPS) ',
3325c . 'PREC. LANZOS ',
3326 . 'DIRECT',
3327 . 'MULTI-LEVEL CONDENSATION',
3328 . 'MIXE SOLVERS: 1 + 3',
3329 . 'MIXE SOLVERS: 1 + 4',
3330 . 'AUTO SELECT SOLVER ',
3331 . 'PCG(GPU) ',
3332 . 'PCGP(PROJECTION) '/,
3333 . msg_insol
3334 . / 'MODIFIED NEWTON',
3335 . 'QUASI-NEWTON',
3336 . 'SLOAN ELASTOPLAS',
3337 . 'FULL NEWTON'/,
3338 . msg_pre
3339 . / 'NONE',
3340 . 'DIAGONAL JACOBIEN',
3341 . 'IMCOMP. CHOLESKY(0)',
3342 . 'STABLILIZED IC(0)',
3343 . 'FACTORED APPRO. INVERSES'/,
3344 . msg_bsol
3345 . / 'superlu',
3346 . 'mumps',
3347 . 'multi-level condensation'/
3348C-----------------------------------------------
3349 IPRINT=0
3350C IMPMV>0 isolv/=1 --> IMPMV=0
3351 IF (ISPMD == 0) IPRINT=1
3352 IF (IMP_CHK > 0) THEN
3353 NTY = 5
3354 IF (IPREC /= 5) IPREC=5
3355 IF (ILINE /= 1) ILINE=1
3356 IF (ISOLV /= 1) ISOLV=1
3357 IF (D_TOL /= ZERO) D_TOL = ZERO
3358 ENDIF
3359 IF(ISOLV >= 3 ) THEN
3360 CALL ANCMSG(MSGID=296,ANMODE=ANINFO,I1=ISOLV)
3361 ISOLV = 2
3362 END IF
3363
3364#ifndef MUMPS5
3365.AND. IF(ISOLV == 2 NSPMD > 1) THEN
3366 WRITE(6,*) "Fatal error: MUMPS is required, but not available"
3367 CALL ARRET(5)
3368 ENDIF
3369#endif
3370 IF (NEIG > 0) THEN
3371 ILINE=1
3372 ISPRB=0
3373 IQSTAT=0
3374 IF (NSPMD == 1) THEN
3375 IPREC=1
3376 ELSE
3377 IPREC=5
3378 ENDIF
3379 ENDIF
3380 IF (NBUCK > 0) THEN
3381 ILINE=1
3382C----fix mono w/ BCS solver
3383 IF (NSPMD == 1) ISOLV =2
3384 ENDIF
3385C--------solvers----
3386C machine precision minimum -simple
3387 CALL FLOATMIN(CS1(1),CS1(2),FLMIN)
3388 P_MACH = TWO*SQRT(FLMIN)
3389 IF (NSPMD > 1)CALL SPMD_MAX_S(P_MACH)
3390C AUTO SELECT SOLVER
3391 IF (ISOLV == 7 ) THEN
3392
3393 IF (ILINE == 1) THEN
3394
3395 WRITE(IOUT,*) ' ** warning ** : solver auto SELECT is not ','compatible with linear run '
3396 WRITE(IOUT,*) ' ** resetting to ** : default one '
3397
3398 WRITE(ISTDO,*) ' ** warning ** : solver auto SELECT is not ','compatible with linear run '
3399 WRITE(ISTDO,*) ' ** resetting to ** : default one '
3400
3401 ISOLV = 0
3402
3403 END IF
3404
3405 ENDIF
3406C----- default solver-> MUMPS
3407 IF (ISOLV == 0) ISOLV = 2
3408C-------ISOLV=2 --> use MUMPS anyway
3409 IMUMPSV = 0
3410.AND. IF (ISOLV > 1 ISOLV <9 ) IMUMPSV = 1
3411.OR. IF (ISOLV == 2 ISOLV ==3 ) THEN
3412 IMUMPSV = 1
3413 ISOLV = 3
3414 END IF
3415.OR..AND. IF ((ISOLV == 3ISOLV == 4)INTP_C < 0) THEN
3416 IF(IPRINT==1) THEN
3417 WRITE(IOUT,*) ' ** warning ** : direct solver is not ','compatible with impl/inter/knonl option '
3418 WRITE(IOUT,*) ' ** resetting to ** : mixe one '
3419 ENDIF
3420 ISOLV = ISOLV + 2
3421 ENDIF
3422C-------ISOLV=9 -> PCG w/ Projection
3423 IF (ISOLV == 9) THEN
3424 IF (M_VS ==0) M_VS=20
3425 IF (IPRO_S0 ==0) IPRO_S0=4
3426 END IF
3427 IF (M_VS > 0) THEN
3428C------case /IMPL/PROJV/n w/o /SOLV/9
3429 IF (ISOLV /= 9) THEN
3430 WRITE(IOUT,*) ' ** warning ** : /impl/projv is ','only compatible with pcgp solver '
3431 WRITE(IOUT,*) ' ** change to ** : isolv=9 '
3432 ISOLV = 9
3433 END IF
3434 END IF
3435
3436.AND..AND. IF (NBUCK > 0NSPMD == 1ISOLV /= 3) THEN
3437 WRITE(IOUT,*) ' ** warning ** : /impl/buckl is ','only compatible with bcs solver '
3438 WRITE(IOUT,*) ' ** change to ** : isolv=3 '
3439 ISOLV = 3
3440 ENDIF
3441
3442.OR. IF (IPREC == 0IPREC > 6)IPREC=5
3443
3444 IF (ISOLV == 2) THEN
3445.OR. IF (ITOL == 0ITOL > 1) ITOL=2
3446 IF (L_TOL == ZERO) L_TOL=P_MACH
3447.OR. ELSEIF (ISOLV == 1ISOLV>=7) THEN
3448 IF (ITOL == 0) ITOL=3
3449 IF (ITOL > 4) THEN
3450 IF(IPRINT==1) THEN
3451 WRITE(IOUT,*) ' ** warning ** : wrong linear stop ','criterion number, reset to default one ** '
3452 ENDIF
3453 ITOL=3
3454 ENDIF
3455 IF (L_TOL == ZERO) THEN
3456 IF (ITOL == 3) THEN
3457 L_TOL=P_MACH
3458.OR. IF (N_PAT > 1ISOLV == 9) L_TOL=P_MACH*EM01
3459 ELSE
3460 L_TOL=EM5
3461 ENDIF
3462 ENDIF
3463C--------direct-----
3464.OR. ELSEIF (ISOLV == 3ISOLV == 4) THEN
3465 IPREC=1
3466 IF (NSPMD>1) IMUMPSV = 1
3467C--------MIX-----
3468.OR. ELSEIF (ISOLV == 5ISOLV == 6) THEN
3469 IPREC=1
3470 IMUMPSV = 1
3471 IF (ITOL == 0) ITOL=1
3472 IF (ITOL > 4) THEN
3473 IF(IPRINT==1) THEN
3474 WRITE(IOUT,*) ' ** warning ** : wrong linear stop ','criterion number, reset to default one ** '
3475 ENDIF
3476 ITOL=3
3477 ENDIF
3478 IF (L_TOL == ZERO) THEN
3479 IF (ITOL == 3) THEN
3480 L_TOL=P_MACH*EM01
3481 ELSE
3482 L_TOL=EM5
3483 ENDIF
3484 ENDIF
3485 ELSE
3486 IF (ISPMD == 0)THEN
3487 WRITE(IOUT,*) ' ** warning ** : solver non available '
3488 WRITE(IOUT,*) ' ** resetting to ** : default one '
3489 ENDIF
3490 ISOLV = 1
3491 ENDIF
3492
3493.AND. IF (IPREC > 2IPREC /= 5) THEN
3494 IF (ISPMD == 0)THEN
3495 WRITE(IOUT,*) ' ** warning ** : ',
3496 . 'this precondition method is no more supported '
3497 WRITE(IOUT,*) ' ** resetting to ** : default one '
3498 ENDIF
3499 IPREC = 5
3500 ENDIF
3501
3502 IF (N_PAT > 1) THEN
3503 IF (N_PAT > 4) THEN
3504 IF(IPRINT==1) THEN
3505 WRITE(IOUT,*) ' ** warning ** : unavailable precondition',' matrix pattern, reset to 4 ** '
3506 ENDIF
3507 N_PAT = 4
3508 ENDIF
3509 IF (IPREC /= 5) THEN
3510 IF(IPRINT==1) THEN
3511 WRITE(IOUT,*) ' ** warning ** : input precondition matrix',' pattern only available with iprec=5 : ignored **'
3512 ENDIF
3513 N_PAT = 1
3514 ENDIF
3515 ENDIF
3516
3517 P_MACH = TWO*FLMIN
3518.AND..AND. IF (NVOLU>0 IMPMV > 0 ISOLV/=1) THEN
3519 IF(IPRINT==1) THEN
3520 WRITE(IOUT,*) ' ** warning ** : direct solver is not ','compatible with monitored volume type3 '
3521 WRITE(IOUT,*) ' ** stiffness will be ignored ** '
3522 ENDIF
3523 IMPMV = 0
3524 END IF
3525
3526 IF (ILINE == 1) THEN
3527 NTY=1
3528 IF (IQSTAT > 0) NTY=6
3529 INSOLV = 0
3530 IF (ILINTF > 0) IMP_INT7 = 2
3531 IF (INTP_C < 0) ITTOFF = 1
3532 IF (IKT > 0) IKT=0
3533 NDTFIX = 0
3534 IF (NBUCK == 0) IKPRES = 0
3535 IDTC = 0
3536 IF (ISCAU > 0) THEN
3537 IF (ISMDISP > 0) THEN
3538 IF(IPRINT==1) THEN
3539 WRITE(IOUT,*) ' ** warning ** : small displacement is ignored',' incompatible with cauchy stress output option;'
3540 ENDIF
3541 ISMDISP = 0
3542 ENDIF
3543 ELSE
3544 ISMDISP = 1
3545 END IF
3546 ELSE
3547C--------nonlinear parametres-----
3548.AND. IF (ISPRB == 1IDYNA > 0) THEN
3549 IF(IPRINT==1) THEN
3550 WRITE(IOUT,*) ' ** warning ** : dynamic IMPLICIT is not ', 'compatible with impl/sprback option '
3551 WRITE(IOUT,*) ' ** resetting ** : static one '
3552 ENDIF
3553 IDYNA=0
3554 ENDIF
3555.AND. IF (ISPRB == 1ISIGINI > 0) THEN
3556 IF(IPRINT==1) THEN
3557 WRITE(IOUT,*) ' ** warning ** : pre-stresses option is not ', 'compatible with impl/sprback option '
3558 WRITE(IOUT,*) ' ** deactivating it '
3559 ENDIF
3560 ISIGINI=0
3561 ENDIF
3562
3563 IF (IQSTAT > 1) IQSTAT=1
3564
3565 IF (IDYNA > 0) THEN
3566 NTY=3
3567 IF (IQSTAT > 0) THEN
3568 IF(IPRINT==1) THEN
3569 WRITE(IOUT,*) ' ** warning ** : quasi-satic IMPLICIT is not ','compatible with dynamic option '
3570 WRITE(IOUT,*) ' ** resetting ** : dynamic one '
3571 ENDIF
3572 IQSTAT=0
3573 END IF
3574 IF (IDYNA == 2) THEN
3575 IF (NEWM_A < HALF) NEWM_A = HALF
3576 IF (NEWM_B < HALF*NEWM_A) NEWM_B = HALF*NEWM_A
3577 ELSE
3578 IF (HHT_A == ZERO) THEN
3579 HHT_A=-ZEP05
3580 ELSE
3581 HHT_A=MIN(ZERO,HHT_A)
3582 HHT_A=MAX(-THIRD,HHT_A)
3583 ENDIF
3584 ENDIF
3585 NEXP = 1
3586 ELSE
3587 NTY=2
3588 IF (IQSTAT > 0) NTY=7
3589 END IF !(IDYNA > 0)
3590C--------------Non linear solvers
3591 IF (INSOLV > 4)THEN
3592 IF(IPRINT==1) THEN
3593 WRITE(IOUT,*) ' ** warning ** : wrong nonlinear solver '
3594 WRITE(IOUT,*) ' ** resetting to** : default one '
3595 ENDIF
3596 INSOLV = 0
3597 ENDIF
3598 IF (INSOLV==4)THEN
3599 IKT=4
3600 N_LIM=1
3601.OR. IF (ISOLV==5 ISOLV==6) ISOLV=3
3602 ENDIF
3603
3604 IF (INSOLV == 0)INSOLV = 1
3605C--------stop criteria-------
3606 IF (NITOL < 12) THEN
3607 IF (NITOL > 3) THEN
3608 IF(IPRINT==1) THEN
3609 WRITE(IOUT,*) ' ** warning ** : wrong nonlinear stop ',
3610 . 'criterion number, reset to default one ** '
3611 ENDIF
3612 NITOL=0
3613 ENDIF
3614 IF (NITOL == 0) NITOL=2
3615 IF (NITOL == 1) THEN
3616 IF (N_TOL == ZERO) N_TOL=EM3
3617 ELSEIF (NITOL == 2) THEN
3618 IF (N_TOL == ZERO) N_TOL=FIVE*EM3
3619 ELSEIF (NITOL == 3) THEN
3620 IF (N_TOL == ZERO) N_TOL=EM3
3621 ENDIF
3622C IF (N_TOL == ZERO) N_TOL=EM3
3623 ELSEIF (NITOL == 12) THEN
3624 IF (N_TOLE == ZERO) N_TOLE=EM3
3625 IF (N_TOLF == ZERO) N_TOLF=EM02
3626 ELSEIF (NITOL == 23) THEN
3627 IF (N_TOLU == ZERO) N_TOLU=EM02
3628 IF (N_TOLF == ZERO) N_TOLF=EM02
3629 ELSEIF (NITOL == 13) THEN
3630 IF (N_TOLU == ZERO) N_TOLU=EM02
3631 IF (N_TOLE == ZERO) N_TOLE=EM3
3632 ELSEIF (NITOL == 123) THEN
3633 IF (N_TOLU == ZERO) N_TOLU=EM02
3634 IF (N_TOLE == ZERO) N_TOLE=EM3
3635 IF (N_TOLF == ZERO) N_TOLF=EM02
3636 ELSE
3637 CALL ANCMSG(MSGID=132,ANMODE=ANINFO,
3638 . I1=NITOL)
3639 CALL ARRET(2)
3640 END IF !(NITOL < 12) THEN
3641C
3642 IF (IDTC == 1) THEN
3643 IF (NL_DTP == 0) NL_DTP=4
3644 IF (NL_DTN == 0) NL_DTN=15
3645 IF (SCAL_DTN == ZERO) SCAL_DTN=TWO_THIRD
3646 IF (SCAL_DTP == ZERO) SCAL_DTP=ONEP01
3647 ELSEIF (IDTC == 2) THEN
3648 IF (NL_DTP == 0) NL_DTP=6
3649 IF (NL_DTN == 0) NL_DTN=20
3650 IF (IDYNA == 0) THEN
3651 IF (SCAL_DTN == ZERO) SCAL_DTN=TWO_THIRD
3652 IF (SCAL_DTP == ZERO) SCAL_DTP=ONEP1
3653 ELSE
3654 IF (SCAL_DTN == ZERO) SCAL_DTN=TWO_THIRD
3655 IF (SCAL_DTP == ZERO) SCAL_DTP=ONEP1
3656 ENDIF
3657C-------ALEN=ALEN0 IF ALEN0=0 sinon ALEN est calcule auto
3658C-------RIKS ARC LENGTH METHOD ------
3659 ELSEIF (IDTC == 3) THEN
3660 IF (NL_DTP == 0) NL_DTP=12
3661 IF (NL_DTN == 0) NL_DTN=25
3662 IF (SCAL_DTN == ZERO) SCAL_DTN=TWO_THIRD
3663 IF (SCAL_DTP == ZERO) SCAL_DTP=ONEP2
3664 IF (IAL_M == 0) IAL_M = 2
3665 IF (NDTFIX > 0) THEN
3666 IF(IPRINT==1) THEN
3667 WRITE(ISTDO,*)
3668 . ' ** warning :riks method is not ','compatible with fixed time point '
3669 WRITE(ISTDO,*) ' ** fixed time point : deactivated '
3670 WRITE(IOUT,*)' ** warning :riks method is not ','compatible with fixed time point '
3671 WRITE(IOUT,*) ' ** fixed time point : deactivated '
3672 NDTFIX = 0
3673 IDTFIX = 0
3674 ENDIF
3675 ENDIF
3676 ELSE
3677.NOT..AND. IF((ISMDISP > 0ISOLV < 4)) THEN
3678 IF(IPRINT==1) THEN
3679 WRITE(ISTDO,*) ' ** warning: no timestep control method defined **'
3680 WRITE(ISTDO,*)' ** potential infinite loop IF no convergence is achieved **'
3681 WRITE(IOUT,*)' ** warning: no timestep control method defined **'
3682 WRITE(IOUT,*) ' ** potential infinite loop IF no convergence is achieved **'
3683 ENDIF
3684.NOT..AND. END IF !((ISMDISP > 0ISOLV < 4)) THEN
3685 IF (SCAL_DTN == ZERO) SCAL_DTN=HALF
3686 END IF !(IDTC == 1)
3687C
3688 IF (DT_MAX == ZERO) DT_MAX=EP10
3689 IF (DT_MIN == ZERO) DT_MIN=EM10
3690C
3691 IF (DT_IMP == ZERO) THEN
3692 IF(IPRINT==1) THEN
3693 WRITE(ISTDO,*)' ** warning: no initial timestep defined **'
3694 WRITE(IOUT,*)' ** warning: no initial timestep defined **'
3695 ENDIF
3696 ENDIF
3697C
3698 IF (RF_MAX == ZERO) RF_MAX=EP30
3699C
3700 IF (ISMDISP == 1 ) THEN
3701 IKG =0
3702 IKPRES = 0
3703 IF (IKPROJ == 0 ) IKPROJ =-1
3704C
3705.AND..AND..AND. IF (IDYNA > 0 IDTC > 0ISOLV < 4 SCAL_DTP /= ONE) THEN
3706 IF(IPRINT==1) THEN
3707 WRITE(ISTDO,*)' ** warning: const. time-step will be used with small disp. **'
3708 WRITE(IOUT,*)' ** warning: const. time-step will be used with small disp. **'
3709 ENDIF
3710 SCAL_DTP = ONE
3711 ENDIF
3712 END IF
3713C
3714 IF (N_LIM == 0) THEN
3715.OR. IF (ISOLV < 3IDTC == 3) THEN
3716 N_LIM=3
3717.OR. ELSEIF (ISOLV == 5ISOLV == 6) THEN
3718 N_LIM=3
3719 ELSE
3720 N_LIM=6
3721 END IF
3722 END IF
3723C
3724 END IF !IF (ILINE == 1) THEN
3725
3726 IF (IMP_CHK > 0) THEN
3727 NTY = 5
3728 IF (IQSTAT > 0) IQSTAT=1
3729 ENDIF
3730
3731 IF (NBUCK > 0) NTY = 8
3732.AND. IF (ISOLV == 3IMUMPSD == 0) IMUMPSD=1
3733C
3734 IF (ISOLV == 5) IMUMPSD=1
3735C
3736C-----------attention initialization should not be inside below--
3737 IF(IPRINT==1) THEN
3738.AND. IF (NSPMD == 1ISOLV == 3) THEN
3739 MSG_ISOL(ISOLV)='direct(bcs)'
3740 ELSEIF (ISOLV == 3) THEN
3741 MSG_ISOL(ISOLV)='direct(mumps)'
3742 ENDIF
3743 IF (NEIG == 0) THEN
3744.OR. IF(ISOLV == 3ISOLV == 4) THEN
3745 ISOL = ISOLV
3746 IF (IMUMPSV==1) ISOL = 2
3747 WRITE(IOUT,5010)MSG_TYPE(NTY),MSG_ISOL(ISOL),LPRINT
3748 ELSE
3749 ISOL=MIN(9,ISOLV)
3750 WRITE(IOUT,5000)MSG_TYPE(NTY),MSG_ISOL(ISOL),MSG_PRE(IPREC),ITOL,L_LIM,L_TOL,LPRINT
3751 ENDIF
3752 IBID =0
3753 IF (INTP_C < 0) IBID =1
3754 WRITE(IOUT,5020)IKG,IKPRES,IAUTSPC,ISPRB,IBID
3755 ELSE
3756 WRITE(IOUT,5050)MSG_TYPE(4)
3757 ENDIF
3758 IF (M_VS > 0) WRITE(IOUT,8400)M_VS,IPRO_S0
3759 IF (IKPROJ /= 0) WRITE(IOUT,7600)IKPROJ
3760C
3761 IF (ILINE /= 1) THEN
3762 IBID = INSOLV
3763 IF (INSOLV==4) INSOLV=1
3764 IF (IBID == 5) IBID = 3
3765 IF (NITOL < 12) THEN
3766 WRITE(IOUT,5100)MSG_INSOL(IBID),DT_IMP,NITOL,N_TOL
3767 ELSEIF (NITOL < 123) THEN
3768 IF (NITOL == 12) THEN
3769 WRITE(IOUT,5112)MSG_INSOL(IBID),DT_IMP,NITOL,N_TOLE,N_TOLF
3770 ELSEIF (NITOL == 23) THEN
3771 WRITE(IOUT,5123)MSG_INSOL(IBID),DT_IMP,NITOL,N_TOLF,N_TOLU
3772 ELSEIF (NITOL == 13) THEN
3773 WRITE(IOUT,5113)MSG_INSOL(IBID),DT_IMP,NITOL,N_TOLE,N_TOLU
3774 ENDIF
3775 ELSEIF (NITOL == 123) THEN
3776 WRITE(IOUT,5132)MSG_INSOL(IBID),DT_IMP,NITOL,N_TOLE,N_TOLF,
3777 . N_TOLU
3778 ENDIF
3779C
3780.OR. IF(ISOLV == 5ISOLV == 6) THEN
3781 WRITE(IOUT,5150)IPUPD,N_LIM,NPRINT,ISIGINI,IRREF,IDTC,DT_MIN,DT_MAX
3782 ELSE
3783 WRITE(IOUT,5180)N_LIM, NPRINT,ISIGINI,IRREF,IDTC,DT_MIN,DT_MAX
3784 ENDIF
3785C
3786 IF(IRIG_M == 1) THEN
3787 WRITE(IOUT,8600)
3788 ELSEIF(IRIG_M > 1) THEN
3789 WRITE(IOUT,8700) E_REF(1:3)
3790 ENDIF
3791C
3792 WRITE(IOUT,8010) ISMDISP
3793 WRITE(IOUT,8200) RF_MIN,RF_MAX
3794 IF (NCY_MAX > 0) WRITE(IOUT,7900) NCY_MAX
3795 IF (IDTC == 1) THEN
3796 WRITE(IOUT,7700)
3797 WRITE(IOUT,5200)NL_DTP,SCAL_DTP,NL_DTN,SCAL_DTN
3798 ELSEIF (IDTC == 2) THEN
3799 WRITE(IOUT,7700)
3800 WRITE(IOUT,5300)NL_DTP,NL_DTN,SCAL_DTN,SCAL_DTP,ALEN0
3801 ELSEIF (IDTC == 3) THEN
3802 S = SCAL_RIKS
3803 WRITE(IOUT,7800)
3804 WRITE(IOUT,7650)NL_DTP,NL_DTN,SCAL_DTN,SCAL_DTP,ALEN0,IAL_M,S
3805 SCAL_RIKS = S*S
3806 ENDIF
3807 END IF !(ILINE /= 1)
3808
3809
3810C
3811 IF (IDYNA == 2) THEN
3812 WRITE(IOUT,6300)NEWM_A,NEWM_B
3813 ELSEIF (IDYNA > 0) THEN
3814 WRITE(IOUT,5400)HHT_A
3815.AND. ELSEIF (IQSTAT > 0SCAL_DTQ /= ONE) THEN
3816 WRITE(IOUT,6400)SCAL_DTQ
3817 ENDIF
3818 IF (IDY_DAMP > 0) WRITE(IOUT,6200)DAMPA_IMP,DAMPB_IMP
3819 IF (N_PAT > 1) WRITE(IOUT,6100)N_PAT
3820 IF (ITTOFF > 0) WRITE(IOUT,6500)
3821 IF (ILINTF > 0) WRITE(IOUT,6600)
3822 IF (ISCAU > 0) WRITE(IOUT,6700)
3823 IF (IMP_LR > 0) WRITE(IOUT,6800)
3824C
3825 ENDIF ! IF(IPRINT==1) THEN
3826C
3827 IF (ILINE /= 1) THEN
3828 IF (ILINE_S == 0) ILINE_S=3
3829 IF (ILINE_S == 100) THEN
3830 ILINE_S=0
3831 IF(IPRINT==1)WRITE(IOUT,7000)
3832 ENDIF
3833 ELSE
3834 ILINE_S=0
3835 ENDIF
3836
3837.AND. IF (ILINE /= 1ILINE_S > 0) THEN
3838 IF (NLS_LIM == 0) NLS_LIM=20
3839 IF (LS_TOL == ZERO) LS_TOL=EM03
3840 IF(IPRINT==1)WRITE(IOUT,6900)ILINE_S,NLS_LIM,LS_TOL
3841 IF (ILINE_S == 3) THEN
3842.AND. IF (NITOL /= 2NITOL /= 4) THEN
3843 LS_TOL=FIVE*LS_TOL
3844 ELSE
3845 LS_TOL=HALF*LS_TOL
3846 ENDIF
3847 ELSEIF (ILINE_S == 2) THEN
3848 LS_TOL=HALF*LS_TOL
3849 ENDIF
3850 ENDIF
3851
3852.AND. IF (ILINE /= 1IREFI > 0) THEN
3853 IF(IPRINT==1)WRITE(IOUT,7100)IREFI
3854 END IF
3855
3856.AND. IF (ILINE /= 1NDIVER == 0) THEN
3857.AND. IF (IREFI > 2ILINE_S /= 1) THEN
3858 NDIVER=2
3859.AND. ELSEIF(IKT > 0ILINE_S /= 1) THEN
3860 NDIVER=0
3861 ELSE
3862 NDIVER=1
3863 END IF
3864 ELSEIF(NDIVER == -1) THEN
3865 NDIVER=0
3866 END IF
3867
3868.AND. IF (ILINE /= 1NDIVER > 0) THEN
3869 IF(IPRINT==1)WRITE(IOUT,7200)NDIVER
3870 NDIVER = NDIVER + 1
3871 END IF
3872
3873 IF (ILINE /= 1) THEN
3874 IF (TOL_DIV == ZERO ) THEN
3875 TOL_DIV = EP04
3876 IF (ILINE_S == 1) TOL_DIV=EP03
3877 IF (ISMDISP == 1) TOL_DIV=EP10
3878 ELSE
3879 IF(IPRINT==1)WRITE(IOUT,8500)TOL_DIV
3880 END IF
3881 END IF
3882
3883 IF (IKT == 1) THEN
3884 IF(IPRINT==1)WRITE(IOUT,7300)
3885 ELSEIF (IKT == 2) THEN
3886 IF(IPRINT==1)WRITE(IOUT,7400)
3887 ELSEIF (IKT == 3) THEN
3888 IF(IPRINT==1)WRITE(IOUT,8000)
3889 ELSEIF (IKT == 4) THEN
3890 IF(IPRINT==1)WRITE(IOUT,8100)
3891 END IF
3892
3893 IF (NDTFIX > 0) THEN
3894 IF(IPRINT==1) THEN
3895 WRITE(IOUT,7500) NDTFIX
3896 WRITE(IOUT,7510)(DTIMPF(J),J=1,NDTFIX)
3897 END IF
3898 END IF
3899
3900 IF (NBUCK > 0) THEN
3901 IF (IMUMPSV> 0) THEN
3902.AND. IF (BISOLV /= 1BISOLV /= 2) THEN
3903 WRITE(ISTDO,*) ' ** error ** unavailable solver for buckling analysis'
3904 WRITE(IOUT,*) ' ** error ** unavailable solver for buckling analysis'
3905 CALL ARRET(2)
3906 ENDIF
3907 IF (ISPMD == 0) THEN
3908 WRITE(IOUT,6000) NBUCK, SHFTBUCK, BNITER, BINCV, BMAXNCV, MSG_BSOL(2)
3909 ENDIF
3910 ELSE
3911 CALL PROUT_BUCK(IOUT,NBUCK,IBUCKL)
3912 END IF
3913 ENDIF
3914C
3915 RETURN
3916 5000 FORMAT(/
3917 . ' IMPLICIT options used :'//
3918 . ' IMPLICIT TYPE : . . . . . . . . . . . . . ',2X,A/
3919 . ' linear solver : . . . . . . . . . . . . . ',2X,A/
3920 . ' precondition method : . . . . . . . . . . ',2X,A/
3921 . ' stop criterion for linear solver . . . . .',2X,I5/
3922 . ' iteration num. limit for linear solver . .',2X,I5/
3923 . ' tolerance for linear solver . . . . . . . ',2X,G14.7/
3924 . ' printout frequency for linear solver . . .',2X,I5/)
3925 5010 FORMAT(/
3926 . ' IMPLICIT options used :'//
3927 . ' IMPLICIT TYPE : . . . . . . . . . . . . . ',2X,A/
3928 . ' linear solver : . . . . . . . . . . . . . ',2X,A/
3929 . ' printout frequency for linear solver . . .',2X,I5/)
3930 5020 FORMAT(/
3931 . ' geometrical stiffness flag . . .. . . . .',2X,I5/
3932 . ' load(pressure) stiffness flag . . . . . ',2X,I5/
3933 . ' autospc flag(0:off,1:on,2:all) . . .. . .',2X,I5/
3934 . ' spring-back option : . . . . . . . . . . .',2X,I5/
3935 . ' special pcg solver for contact . . . .. . ',2X,I5/)
3936 5050 FORMAT(/
3937 . ' IMPLICIT options used :'//
3938 . ' IMPLICIT TYPE : . . . . . . . . . . . . . ',2X,A//)
3939 5100 FORMAT(
3940 . ' non-linear solver : . . . . . . . . . . . ',2X,A/
3941 . ' initial time step . . . . . . . . . . . . ',2X,G14.7/
3942 . ' stop criterion for non-linear solver . . .',2X,I5/
3943 . ' tolerance for non-linear solver . . . . . ',2X,G14.7)
3944 5112 FORMAT(
3945 . ' non-linear solver : . . . . . . . . . . . ',2X,A/
3946 . ' initial time step . . . . . . . . . . . . ',2X,G14.7/
3947 . ' stop criterion for non-linear solver . . .',2X,I5/
3948 . ' energy tolerance for non-linear solver . .',2X,G14.7/
3949 . ' force tolerance for non-linear solver . .',2X,G14.7)
3950 5113 FORMAT(
3951 . ' non-linear solver : . . . . . . . . . . . ',2X,A/
3952 . ' initial time step . . . . . . . . . . . . ',2X,G14.7/
3953 . ' stop criterion for non-linear solver . . .',2X,I5/
3954 . ' energy tolerance for non-linear solver . .',2X,G14.7/
3955 . ' disp. tolerance for non-linear solver . .',2X,G14.7)
3956 5123 FORMAT(
3957 . ' non-linear solver : . . . . . . . . . . . ',2X,A/
3958 . ' initial time step . . . . . . . . . . . . ',2X,G14.7/
3959 . ' stop criterion for non-linear solver . . .',2X,I5/
3960 . ' force tolerance for non-linear solver . .',2X,G14.7/
3961 . ' disp. tolerance for non-linear solver . .',2X,G14.7)
3962 5132 FORMAT(
3963 . ' non-linear solver : . . . . . . . . . . . ',2X,A/
3964 . ' initial time step . . . . . . . . . . . . ',2X,G14.7/
3965 . ' stop criterion for non-linear solver . . .',2X,I5/
3966 . ' energy tolerance for non-linear solver . .',2X,G14.7/
3967 . ' force tolerance for non-linear solver . .',2X,G14.7/
3968 . ' disp. tolerance for non-linear solver . .',2X,G14.7)
3969 5150 FORMAT(
3970 . ' reforming flag in mix solver(0:auto,>0:iter)',2X,I5/
3971 . ' iteration num.limit for reforming matrix .',2X,I5/
3972 . ' printout frequency for non-linear solver .',2X,I5/
3973 . ' pre-stresses control flag . . . . . . . . ',2X,I5/
3974 . ' reference residual flag . . . . . . .. . .',2X,I5/
3975 . ' time step control method . . . . . . . . .',2X,I5/
3976 . ' minimum time step . . . . . . . . . . . . ',2X,G14.7/
3977 . ' maximum time step . . . . . . . . . . . . ',2X,G14.7//)
3978 5180 FORMAT(
3979 . ' iteration num.limit for reforming matrix .',2X,I5/
3980 . ' printout frequency for non-linear solver .',2X,I5/
3981 . ' pre-stresses control flag . . . . . . . . ',2X,I5/
3982 . ' reference residual flag . . . . . . .. . .',2X,I5/
3983 . ' time step control method . . . . . . . . .',2X,I5/
3984 . ' minimum time step . . . . . . . . . . . . ',2X,G14.7/
3985 . ' maximum time step . . . . . . . . . . . . ',2X,G14.7//)
3986 5200 FORMAT(
3987 . ' converge iteration num. for increasing dt. ',2X,I5/
3988 . ' increasing time step scale factor. . . . .',2X,G14.7/
3989 . ' converge iteration num. for decreasing dt .',2X,I5/
3990 . ' decreasing time step scale factor. . . . .',2X,G14.7/)
3991 5300 FORMAT(
3992 . ' desired converge iteration num. . . . . . .',2X,I5/
3993 . ' maximum converge iteration num. . . . . . .',2X,I5/
3994 . ' decreasing time step scale factor. . . . .',2X,G14.7/
3995 . ' maximum increasing time step scale factor ',2X,G14.7/
3996 . ' constant arc-length. . . . . . .. . . . . ',2X,G14.7//)
3997 5400 FORMAT(
3998 . ' time integration with hht-alpha constant ',2X,G14.7//)
3999 6000 FORMAT(
4000 . ' euler buckling analysis :'/
4001 . ' number of modes to be computed :. . . . . ',2X,I5/
4002 . ' shift in buckling modes pencil :. . . . . ',2X,G14.7/
4003 . ' maximum number of arnoldi iterations :. . ',2X,I5/
4004 . ' initial factor for subspace dimension : . ',2X,I5/
4005 . ' maximum factor for subspace dimension : . ',2X,I5/
4006 . ' linear solver : . . . . . . . . . . . . . ',2X,A/)
4007 6100 FORMAT(
4008 . ' precondition matrix sparse pattern(a^n) . ',2X,I5/)
4009 6200 FORMAT(
4010 . ' IMPLICIT rayleigh damping coefficients : ',2X,2G14.7/)
4011 6300 FORMAT(
4012 . ' time integration with newmark constants ',2X,2G14.7//)
4013 6400 FORMAT(
4014 . ' quasi-static inertia scale factor : ',2X,G14.7//)
4015 6500 FORMAT(
4016 . ' crossing contact node detection deactivated .',/)
4017 6600 FORMAT(
4018 . ' linear analyse taking into account contact . .',/)
4019 6700 FORMAT(
4020 . ' cauchy stress selected for linear analyse . .',/)
4021 6800 FORMAT(
4022 . ' taking into account large rigid rotation . .',/)
4023 6900 FORMAT(
4024 . ' line-search method :. . . . . . . . . . . .',2X,I5/
4025 . ' maximum line-search iteration num. . . . . ',2X,I5/
4026 . ' tolerance for line-search iteration. . . .',2X,G14.7/)
4027 7000 FORMAT(
4028 . ' line-search deactivated . . . . . . . . . . .',/)
4029 7100 FORMAT(
4030 . ' reference residual options for contact . . ',2X,I5/)
4031 7200 FORMAT(
4032 . ' divergence criterion numbers : . . . . . .',2X,I5/)
4033 7300 FORMAT(
4034 . ' simplified tangent stiffness activated . .',/)
4035 7400 FORMAT(
4036 . ' average continuum tangent stiffness activated',/)
4037 7500 FORMAT(
4038 . ' fixed time point number: . . . . . . . .',2X,I5)
4039 7510 FORMAT( /,3X,6G20.13,//)
4040 7600 FORMAT(
4041 . ' full projection for qeph(-1:off,1:on) . . .. . .',2X,I5/)
4042 7650 FORMAT(
4043 . ' desired converge iteration num. . . . . . .',2X,I5/
4044 . ' maximum converge iteration num. . . . . . .',2X,I5/
4045 . ' decreasing time step scale factor. . . . .',2X,G14.7/
4046 . ' maximum increasing time step scale factor ',2X,G14.7/
4047 . ' constant arc-length. . . . . . .. . . . . ',2X,G14.7/
4048 . ' constraint TYPE . . . .. . . . . . . . . . ',2X,I5/
4049 . ' loading contribution scale factor . . . . ',2X,G14.7//)
4050 7700 FORMAT('automatic time step control:'/)
4051 7800 FORMAT('automatic time step with riks method:'/)
4052 7900 FORMAT(
4053 . ' maximum increment(ncycle) num . . .. . .',2X,I5/)
4054 8000 FORMAT(
4055 . ' continuum tangent stiffness activated. .',/)
4056 8100 FORMAT(
4057 . ' consistent tangent stiffness activated. .',/)
4058 8200 FORMAT(
4059 . ' minimum reference force residual . . . .',2X,G14.7/
4060 . ' maximum reference force residual . . . . ',2X,G14.7//)
4061 8010 FORMAT(
4062 . ' small displacement option(0:off,1:on) . . .. . .',2X,I5/)
4063 8400 FORMAT(
4064 . ' number of projection vectors of pcg . . . ',2X,I5/
4065 . ' projection vector initialization method . ',2X,I5/)
4066 8500 FORMAT(
4067 . ' diverging tol. of relative force residual :',2X,G14.7/)
4068 8600 FORMAT(
4069 . ' free rigid motion /mrigm used . . . . . . .'/)
4070 8700 FORMAT(
4071 . ' free rigid motion /mrigm w/ ref_node_id:',2X,3I10/)
4072 END
4073
anim_build_index_all
subroutine anim_build_index_all(ispmd, mcheck, sensors, igeo, geo)
Definition anim_build_index_all.F:36
chkipari
subroutine chkipari(ipari)
Definition chkstfn3.F:211
damping
subroutine damping(nodft, nodlt, v, vr, a, ar, damp, ms, in, igrnod, dim, itask, weight, tagslv_rby, wfext)
Definition damping.F:882
prout_buck
subroutine prout_buck(ip, nbuck, ibuck)
Definition lectur.F:3223
lectur
subroutine lectur(icode, iskew, iskwn, ixtg, ixs, ixq, ixc, ixt, ixp, ixr, itab, itabm1, npc, iparg, igrv, ibgr, ipari, npby, lpby, nnlink, llink, linale, neflsw, nnflsw, icut, inoise, x, v, vr, ms, in, skew, pld, rby, wa, crflsw, xcut, anin, dampr, igrnod, kxsp, weight, fr_rby2, fr_rl, partsav, ipart, pm, monvol, volmon, ipart_state, geo, table, iframe, xframe, elbuf_str, igeo, intbuf_tab, ipm, h3d_data, multi_fvm, igrpart, tag_skins6, icfield, lcfield, tagslv_rby, mds_label, mds_output_table, mds_nmat, max_depvar, mds_ndepsvar, stack, ibcl, iloadp, lloadp, sensors, dynain_data, dt, loads, output, names_and_titles, mat_param, glob_therm, pblast)
Definition lectur.F:105
lecimpl
subroutine lecimpl
Definition lectur.F:3282
alpha
#define alpha
Definition eval.h:35
lech3d
subroutine lech3d(geo, igeo, ipm, ipart, h3d_data, multi_fvm, ipari, iparg, tag_skins6, mds_label, mds_output_table, mds_nmat, max_depvar, mds_ndepsvar, elbuf_str, stack, ibcl, iloadp, lloadp, loads, mat_param, pblast, igrpart)
Definition lech3d.F:96
lecstat
subroutine lecstat(ipart, ipart_state, elbuf_tab, ipm, iparg, iparts, ipartc, ipartg, mat_param)
Definition lecstat.F:37
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
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
ale_mod
Definition ale_mod.F:149
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:249
alemuscl_mod
Definition alemuscl_mod.F:54
alemuscl_mod::alemuscl_param
type(alemuscl_param_) alemuscl_param
Definition alemuscl_mod.F:75
anim_mod
Definition anim_mod.F:96
check_mod
Definition check_mod.F:34
check_mod::restart_file
integer restart_file
Definition check_mod.F:52
check_mod::check_message
character(len=2048), dimension(check_message_size) check_message
Definition check_mod.F:54
dt_mod
Definition dt_mod.F:79
fvbag_mod
Definition fvbag_mod.F:44
fvbag_mod::fvdata_old
type(fvbag_data), dimension(:), allocatable fvdata_old
Definition fvbag_mod.F:193
fvbag_mod::num_opt_dt_fvmbag_1
integer num_opt_dt_fvmbag_1
Definition fvbag_mod.F:199
fvbag_mod::num_opt_dt_fvmbag_0
integer num_opt_dt_fvmbag_0
Definition fvbag_mod.F:198
fxb_mod
Definition fxb_mod.F:32
groupdef_mod
Definition groupdef_mod.F:662
h3d_mod
Definition h3d_mod.F:308
imp_kbcs
Definition impbufdef_mod.F:471
imp_kbcs::maxset_b
integer maxset_b
Definition impbufdef_mod.F:475
imp_kbcs::msgl_b
integer msgl_b
Definition impbufdef_mod.F:475
imp_pcg_proj
Definition impbufdef_mod.F:646
imp_spbrm
Definition impbufdef_mod.F:696
intstamp_glob_mod
Definition intstamp_glob_mod.F:30
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
outputs_mod
Definition outputs_mod.F:59
stack_mod
Definition stack_mod.F:72
state_mod
Definition state_mod.F:54
table_mod
Definition table_mod.F:112
floatmin
void floatmin(int *a, int *b, float *flm)
Definition precision.c:71
section
subroutine section(nnod, n1, n2, n3, nstrf, x, v, vr, fsav, fopta, secfcum, ms, in, ifram, xsec)
Definition section.F:34
spmd_chkw
subroutine spmd_chkw(iwiout, iout)
Definition spmd_chkw.F:38
spmd_glob_isum9
subroutine spmd_glob_isum9(v, len)
Definition spmd_th.F:523
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
arret
subroutine arret(nn)
Definition arret.F:87
static
subroutine static(v, vr, a, ar, ms, in, igrnod, weight_md, wfext)
Definition static.F:33
table_mod::ttable
Definition table_mod.F:125