105
106
107
110 USE mat_elem_mod
111 USE intbufdef_mod
114 USE multi_fvm_mod
119 USE sensor_mod
126 USE loads_mod
127 USE output_mod
129 USE my_alloc_mod
131 USE elbufdef_mod
132 USE glob_therm_mod
133 USE pblast_mod
134 USE prelech3d_mod
135
136
137
138#include "implicit_f.inc"
139
140
141
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"
180
181
182
183 INTEGER IPARG(NPARG,NGROUP), IPARI(NPARI,*), IXS(NIXS,*),
184 . IXQ(NIXQ,*), IXC(NIXC,*), IXT(NIXT,*), IXP(NIXP,*),
185 . IXR(,*), 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(*)
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
215 TYPE(NAMES_AND_TITLES_),INTENT(INOUT) :: NAMES_AND_TITLES
216 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
217 type (glob_therm_) ,intent(inout) :: glob_therm
218 type (pblast_) ,intent(inout) :: pblast
219
220
221
222 INTEGER NLEC(16), I, NSLIOF, NELSOF, NELQOF, NDAMPN,
223 . NELCOF, NELTOF, , NELROF, NINTCH, NUBCSN, ITFOR0, IRFE0,
224 . IRFL0, K, NELOF, NN, NBC, IL, II, J, KLG, , 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, , NALELK_removed, JALE,USERL_COUNT,
233 . IDEL2,IS,
234 . STEXT1,MULTIREST1,NLPRI1,LOWMACH_OPT,IERROR,
235 . NINTERSKID,IVOLU,IFV,IFV_TYPE,ISTATG_P,
236 . ,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
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
256
257
258
259 INTEGER,EXTERNAL :: NGR2USR
260
261
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
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
283
284
285
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
301
302 READ(iin,'(2I8)') neigoff, neoff
303 READ(iin,'(2I8)') nfvmesh, nfvmodi
304
305 IF(ncpri1 == 0) ncpri1=1
306 IF(mcheck == 0)ncpri = ncpri1
307
308 IF(mcheck == 0)nlpri = nlpri1
309
310 IF(ncrst1 == 0.AND.mcheck == 0) ncrst=10000000
311 IF(tfi /= 0.0) tstop=tfi
312
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
319
320
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
327
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
334
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
340
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
345
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
360
361 IF(mcheck == 0)THEN
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
386
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
395
396 IF(idtmins==2.AND.irest_mselt==0)THEN
397 CALL ancmsg(msgid=120,anmode=aninfo_blind)
399 END IF
400
401
402
403
404
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
422
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
442
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
449
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
456
457
458
459
460
461
462
463 IF (nspmd > 1)THEN
464 userl_count = userl_avail
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))
471 ENDIF
472 ENDIF
473 ENDIF
474
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
481
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)
488 ENDIF
489 ELSE
490 IF ((r2r_siu==1).AND.(ispmd==0)) THEN
491 CALL ancmsg(msgid=239,anmode=aninfo_blind)
493 ENDIF
494 ENDIF
495
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
512 IF(idt1sh /=0) WRITE(iout,4720)
513 IF(idt1sol/=0) WRITE(iout,4730)
514 IF(idt1tet10/=0) WRITE(iout,4740)
515 endif
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
527 IF(idt1sh /=0) WRITE(iout,4720)
528 IF(idt1sol/=0) WRITE(iout,4730)
529 IF(idt1tet10/=0) WRITE(iout,4740)
530 endif
531 END IF
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
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
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
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
606
607 IF(idtmins/=0)THEN
608
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
615
616 ELSE
617
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
624
625 END IF
626
627 ENDIF
628
629 ENDIF
630
631
632 IF(nodadt==0.AND.(istatcnd/=0.AND.impl_s==0))THEN
633 CALL ancmsg(msgid=121,anmode=aninfo_blind)
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
656
657 IF(ispmd == 0.AND.mcheck == 0) THEN
659
660
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
688 ENDIF
689 ENDIF
690 k1=k1+nimv
691 ENDDO
692 ENDIF
693
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
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
705
706
707
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)
715
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 ==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
743
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
754
755 STEXT1 = H3D_DATA%OUTPUT_LIST(I)%S_STRING1
756 WRITE(IOUT,*) ' |----'//CHAR1//' '//CHAR2//' : '
757
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
787
788
789
790
791.AND. IF(ISPMD == 0 IMASSI > 0 ) THEN
792 WRITE(IOUT,'(a)
')' reset initial mass
for this run
'
793 ENDIF
794
795
796
797.AND. IF (ISPMD == 0 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', 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
807
808
809
810 IF(TANIM0 /= ZERO) TANIM = TANIM0
811.AND. IF(TANIM_STOP0/=ZERO TANIM_STOP0/=EP20) TANIM_STOP = TANIM_STOP0
812 IF(DTANIM0 > ZERO) DTANIM= DTANIM0
813 IF(DTANIM<=ZERO) TANIM = EP30
814.AND. IF (TANIM < TT-DT2DTANIM > ZERO)TANIM = TANIM
815 . + INT((TT-DT2-TANIM)/DTANIM)*DTANIM
816 IF (TANIM < TT-DT2)TANIM = TANIM+DTANIM
817
818.AND. IF(ANIM_V(14)+H3D_DATA%N_VECT_DROT > 0
819.AND..AND..AND..OR. . ((ISECUT == 0 IISROT == 0 IMPOSE_DR == 0 IDROT == 0) 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
833
834.AND. IF(ISPMD == 0MCHECK == 0) THEN
835
836
837
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
852
853
854
855
856 CALL ANIM_BUILD_INDEX_ALL(ISPMD ,MCHECK ,SENSORS ,IGEO ,GEO )
857
858
859
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.AND. END IF !(ISPMD==0MCHECK==0)
883
884
885
886 IF (MCHECK == 0) THEN
887 ALLOCATE(SENSORS%STAT(SENSORS%NSTAT))
888 SENSORS%STAT(:) = 0
889 END IF
890.AND. IF (ISPMD == 0 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.AND. END IF !(ISPMD==0MCHECK==0)
912
913
914
915 IF (MCHECK == 0) THEN
916 ALLOCATE(SENSORS%OUTP(SENSORS%NOUTP))
917 SENSORS%OUTP(:) = 0
918 END IF
919.AND. IF (ISPMD == 0 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.AND. END IF !(ISPMD==0MCHECK==0)
938
939
940
941.AND. IF (ISPMD == 0MCHECK == 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.AND. ENDIF !(ISPMD==0MCHECK==0)
959
960
961
962.AND. IF(ISPMD == 0MCHECK == 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.OR. IF (TST_START>ZEROTST_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.OR. IF (TST_START>ZEROTST_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
984
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
992
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.OR. IF(IALE /= 0IEULER /= 0)WRITE(IOUT,1450) NALELINK+NALELK !format v12 + format v5
997
998.AND. ELSEIF(ISPMD == 0 MCHECK /= 0) THEN
999.AND. ENDIF !(ISPMD==0MCHECK==0)
1000
1001
1002
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.AND. IF(ISPMD == 0 MCHECK == 0)THEN
1007.OR. IF(IALE /= 0 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.OR. IF(PM(15,K) /= ALE%UPWIND%UPWMG2 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.OR..OR. IF(PM(15,K) /= ALE%UPWIND%UPWMG2 PM(16,K) /= ALE%UPWIND%UPWOG2 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
1044
1045
1046
1047.OR. IF(IALE /= 0 IEULER /= 0)THEN
1048 !-----------------------
1049 ! QUASI-INCOMPRESSIBLE /INCMP
1050 !-----------------------
1051.AND. IF(ALE%GLOBAL%INCOMP == 1MCHECK == 0) WRITE(IOUT,1196)
1052 !-----------------------
1053 ! GRID FORMULATION
1054 !-----------------------
1055 !---ALE GRID FORMULATION CHECK---!
1056.AND. IF(ALE%GRID%NWALE_ENGINE /= ALE%GRID%NWALE_RST 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
1079 ENDIF
1082 IF(ALEMUSCL_Param%IALEMUSCL == 0)THEN
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.AND. IF (LOWMACH_OPT == 1 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.AND. IF(ISPMD == 0 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.OR. ENDIF !(IALE/=0IEULER/=0)
1167 !---CHECK END-------------------!
1168!-----------------------
1169! FEM MOMENTUM INTEGRATION
1170!-----------------------
1171.AND. IF(ISPMD == 0MCHECK == 0)THEN
1172.AND. IF(IALE+IEULER /= 0 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
1184
1185
1186
1187.AND. IF(IALE /= 0NALEOF == 1)THEN
1188.AND. IF(ISPMD == 0MCHECK == 0)THEN
1189 WRITE(IOUT,*)'ale formulation switched off
'
1190 END IF
1191 IALE = 0
1192 END IF
1193.AND. IF(IEULER /= 0NEULEROF == 1)THEN
1194.AND. IF(ISPMD == 0MCHECK == 0)THEN
1195 WRITE(IOUT,*)'euler formulation switched off '
1196 END IF
1197 IEULER = 0
1198 END IF
1199.AND. IF (GLOB_THERM%ITHERM /= 0NTHERMOF == 1)THEN
1200.AND. IF(ISPMD == 0MCHECK == 0)THEN
1201 WRITE(IOUT,*)'thermic formulation switched off '
1202 END IF
1203 GLOB_THERM%ITHERM = 0
1204 END IF
1205
1206.AND..AND. IF(IDEL7 /= 0MCHECK == 0N2D == 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.AND. ELSEIF(N2D /= 0MCHECK == 0)THEN
1214 IF(ISPMD == 0)WRITE(IOUT,1550) IDEL7-1
1215 END IF
1216
1217
1218
1219 IF(NSLIOF /= 0) THEN
1220
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
1232
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
1244
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
1255
1256
1257
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
1299
1300
1301
1302 NELOF=NELSOF+NELQOF+NELCOF+NELTOF+NELPOF+NELROF+NELTGOF+NSPHOF
1303
1304
1305
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)
1357
1358
1359
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
1416
1417
1418
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
1470
1471
1472
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
1524
1525
1526
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
1578
1579
1580
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
1632
1633
1634
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
1685
1686 END IF
1687
1688
1689
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
1704
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
1729 iwiout = 0
1730 IF (ispmd /= 0)
CALL spmd_chkw(iwiout,iout)
1733 IF (iwiout > 0) THEN
1735 iwiout = 0
1736 ENDIF
1737 ENDIF
1738
1739 END IF
1740
1741
1742
1743 IF(npartof > 0)THEN
1744 IF(ispmd == 0.AND.mcheck == 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
1783 iwiout = 0
1784 IF (ispmd /= 0)
CALL spmd_chkw(iwiout,iout)
1787 IF (iwiout > 0) THEN
1789 iwiout = 0
1790 ENDIF
1791 ENDIF
1792
1793 END IF
1794
1795
1796
1797
1798
1799 IF(h3d_data%N_SCAL_SKID > 0.AND.nintskidold==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 ELSEIF(h3d_data%N_SCAL_SKID == 0.AND.nintskidold==0)THEN
1809 ALLOCATE (pskids(0,0))
1810 ENDIF
1811
1812
1813
1814 IF(h3d_data%N_SCAL_CSE_FRIC >0.AND.
s_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
1824 ALLOCATE(efricg(0))
1825 ALLOCATE(efricg_stamp(0))
1826 ENDIF
1827
1828 IF(h3d_data%N_SCAL_CSE_FRICINT > 0.AND.
s_efricint==0)
THEN
1829
1830 ninefricg = h3d_data%N_SCAL_CSE_FRICINT
1833 IF(nintstamp/=0) THEN
1834 DO n=1,ninter
1835 ni = h3d_data%N_CSE_FRIC_INTER (n)
1837 ENDDO
1838 ENDIF
1840 CALL my_alloc(efric_stamp,ninefricg,numnodg)
1841 efric_stamp(1:ninefricg,1:numnodg) = zero
1842 CALL my_alloc(efric,0,0)
1845 CALL my_alloc(efric,
ninefric,numnod)
1846 efric(1:ninefricg,1:numnod) = zero
1847 CALL my_alloc(efric_stamp,0,0)
1848 ELSE
1852 CALL my_alloc(efric,
ninefric,numnod)
1854 ns = 0
1855 nn= 0
1856 DO n=1,ninter
1857 ni = h3d_data%N_CSE_FRIC_INTER (n)
1858 IF(ni/= 0.AND.ipari(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
1868 CALL my_alloc(efric,0,0)
1869 CALL my_alloc(efric_stamp,0,0)
1870 ENDIF
1871
1872
1873
1874
1875
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
1885
1886
1887
1888 IF(ity == 1.AND.nelsof /= 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
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
1903
1904
1905
1906 ELSEIF(ity == 2.AND.nelqof /= 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
1917
1918
1919
1920 ELSEIF(ity == 3.AND.nelcof /= 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
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
1935
1936
1937
1938 ELSEIF(ity == 4.AND.neltof /= 0)THEN
1939
1940
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
1947
1948
1949 ENDIF
1950 ENDDO
1951
1952
1953
1954 ELSEIF(ity == 5.AND.nelpof /= 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
1965
1966
1967
1968 ELSEIF(ity == 6.AND.nelrof /= 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
1977
1978
1979
1980 ELSEIF(ity == 7.AND.neltgof /= 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
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
1995
1996
1997
1998 ELSEIF(ity == 51.AND.nsphof /= 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
2009
2010
2011
2012 iparg(8,ng)=max0(iparg(8,ng),igof)
2013 ENDDO
2014 END IF
2015
2016 IF(npartof > 0)THEN
2017
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
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
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
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
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
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
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
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
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
2131
2132
2133
2134 IF(nrlink > 0 .AND. 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 IF(ispmd == 0.AND.mcheck == 0)WRITE(iout,2100) k,i1,i2,i3,ir1,ir2,ir3,isk,n
2144 IF(ispmd == 0.AND.mcheck == 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)
2157 ENDIF
2158 isk = isk1
2159 ENDIF
2160
2161 CALL fr_rlink1(llink(k2),itabm1,fr_rl(1,k),n)
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)
2172 ENDIF
2173 ENDDO
2174 ENDIF
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221 nalelk_starter = 0
2222 IF(mcheck==0)nalelk_starter = slinale/7
2223 nalelk_removed=0
2224 k=6
2225
2226
2227 DO j=1,nalelk_starter
2228 IF(irun == 1 .AND. 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 IF(nalelk /= 0.AND.mcheck == 0)THEN
2234 k=slinale+6
2235
2236 DO j=1,nalelk
2237 READ (iin,'(3I10,5X,3I1,I10)')m1,m2,n,i1,i2,i3,im
2238
2239
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 IF(ispmd == 0.AND.mcheck == 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 IF(ispmd == 0.AND.mcheck == 0)THEN
2257 WRITE(iout,'(10I10)')(linale(k+i),i=1,n)
2258 WRITE(iout,2201)
2259 ENDIF
2260
2261 CALL fr_rlale(linale(k-4),linale(k-3),linale(k+1),itabm1,n)
2262 k=k+n+6
2263
2264
2265
2266 ELSE
2267
2268
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)
2278
2279 IF(im==0.AND.igrnod(linale(k+1))%SORTED /= 1)THEN
2280
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)'
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 IF(ispmd == 0.AND.mcheck == 0)THEN
2296 WRITE(iout,2200)m1,m2,i1,i2,i3,im
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
2305 CALL fr_rlale(linale(k-4),linale(k-3),linale(k+1),itabm1,n)
2306 k=k+1+6
2307 ENDIF
2308 ENDDO
2309 slinale = slinale + llinal
2310 ENDIF
2311
2312
2313
2314
2315
2316 IF(nalelink /= 0.AND.mcheck == 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 IF(m1>0.AND.m2>0)THEN
2321
2322
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 IF(ispmd == 0.AND.mcheck == 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 IF(ispmd == 0.AND.mcheck == 0)THEN
2340 WRITE(iout,'(10I10)')(linale(k+i),i=1,n)
2341 WRITE(iout,2201)
2342 ENDIF
2343
2344 CALL fr_rlale(linale(k-4),linale(k-3),linale(k+1),itabm1,n)
2345 k=k+n+6
2346
2347
2348
2349 ELSE
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
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'
2361 ENDIF
2362
2363 IF(im==0.AND.igrnod(linale(k+1))%SORTED /= 1)THEN
2364
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)'
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 IF(ispmd == 0.AND.mcheck == 0)THEN
2380 WRITE(iout,2200)m1,m2,i1,i2,i3,im
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
2389 CALL fr_rlale(linale(k-4),linale(k-3),linale(k+1),itabm1,n)
2390 k=k+1+6
2391 ENDIF
2392
2393
2394
2395
2396 ELSEIF(m1==-1)THEN
2397 ALLOCATE(alelin_on_off(iabs(n)))
2398 READ (iin,'(10I10)')(alelin_on_off(i),i=1,n)
2399
2400 kk=0
2401 DO i1=1,n
2402 l=1
2403 m1=alelin_on_off(i1)
2404 DO i=1,nalelk_starter
2405
2406
2407
2408 IF(l>=slinale)THEN
2409
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
2418 linale(l+0)=-linale(l+0)
2419
2420 IF(ispmd == 0.AND.mcheck == 0)WRITE(iout,2211)m1
2421 EXIT
2422 ELSEIF(uid==m1)THEN
2423 nalelk_removed = nalelk_removed+1
2424
2425 WRITE(istdo,*)' ** WARNING ALE LINK ALREADY ACTIVATED : ',m1
2426 EXIT
2427 ENDIF
2428
2429 ENDIF
2430 l = l+6+iabs(n)
2431 ENDDO
2432 ENDDO
2433 DEALLOCATE(alelin_on_off)
2434
2435
2436
2437
2438
2439 ELSEIF(m1==-2)THEN
2440 ALLOCATE(alelin_on_off(iabs(n)))
2441 READ (iin,'(10I10)')(alelin_on_off(i),i=1,n)
2442
2443 kk=0
2444 DO i1=1,n
2445 l=1
2446 m1=alelin_on_off(i1)
2447 DO i=1,nalelk_starter
2448
2449
2450
2451 IF(l>=slinale)THEN
2452
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
2461 linale(l+0)=-linale(l+0)
2462
2463 IF(ispmd == 0.AND.mcheck == 0)WRITE(iout,2210)m1
2464 EXIT
2465 ELSEIF(uid==-m1)THEN
2466 nalelk_removed = nalelk_removed+1
2467
2468 WRITE(istdo,*)' ** WARNING ALE LINK ALREADY DEACTIVATED :',m1
2469 EXIT
2470 ENDIF
2471 ENDIF
2472 l = l+6+iabs(n)
2473 ENDDO
2474 ENDDO
2475 DEALLOCATE(alelin_on_off)
2476
2477 ENDIF
2478
2479 ENDDO
2480 slinale = slinale + llinal
2481 nalelk = nalelk+nalelink-nalelk_removed
2482 ENDIF
2483
2484 IF(mcheck==0)nalelk=nalelk+nalelk_starter
2485
2486
2487
2488
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
2503
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
2526
2527
2528
2529 DO j = 1, nbpartaleon
2530 IF (aleon_partids_tmp(j) == partid) THEN
2531
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
2539
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)
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)
2578 ENDIF
2579 ENDDO
2580
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
2599
2600 DO i = 1, nbaleoff_part
2601 WRITE(iout, 4800) aleoff_partids(i)
2602 ENDDO
2603
2604
2605
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)
2612
2613
2614
2615
2616
2617
2618 IF (ity == 1) THEN
2619
2620 partid = ipart(k1 + nft)
2621 ELSEIF (ity == 2) THEN
2622
2623 partid = ipart(k2 + nft)
2624 ENDIF
2625
2626 DO i = 1, nbaleoff_part
2627 IF (aleoff_partids(i) == partid) THEN
2628 iparg(76, ng) = 1
2629 EXIT
2630 ENDIF
2631 ENDDO
2632
2633 DO i = 1, nbaleon_part
2634 IF (aleon_partids(i) == partid) THEN
2635 iparg(76, ng) = 0
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)
2644
2645
2646
2647 IF(nubcsn /= 0)THEN
2648 CALL lcbcsf(icode,iskew,nubcsn,itab,itabm1,npby ,iskwn,weight)
2649 IF(nspmd > 1) THEN
2650
2651 iwiout = 0
2652 IF (ispmd /= 0)
CALL spmd_chkw(iwiout,iout)
2655 IF (iwiout > 0) THEN
2657 iwiout = 0
2658 END IF
2659 END IF
2660 END IF
2661
2662
2663
2664 IF(nintch /= 0)THEN
2665 DO i=1,nintch
2666 READ(iin,'(2I8,2F16.0)')noint
2667 IF(tfin == 0.0)tfin=1.e30
2668 IF(tfin <= tstart) THEN
2669 CALL ancmsg(msgid=307,anmode=anstop)
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 IF(ispmd == 0.AND.mcheck == 0) WRITE(iout,2300)noint,ipari(13,jpri),tstart,tfin
2684 ELSE
2685 IF(ispmd == 0.AND.mcheck == 0) WRITE(iout,2301)noint
2686 ENDIF
2687 ENDDO
2688 ENDIF
2689
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
2705
2706
2707
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)
2716
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)
2725
2726
2727
2728 IF (nsflsw /= 0.AND.mcheck == 0) THEN
2729 CALL lecflsw (nsflsw,ntflsw,neflsw,nnflsw,crflsw,x,ixs,iparg,wa)
2730 ENDIF
2731
2732
2733
2734 IF (nfct /= 0) THEN
2735 CALL lecfun (npc, pld, nfct, npts, table)
2736 END IF
2737
2738
2739
2740 IF (niniv /= 0) THEN
2741 CALL lecinv (niniv,x,v,vr,itab,iframe,xframe,igrnod,
fxbipm,fxbvit,fxbrpm)
2742 END IF
2743
2744
2745
2746 IF(ncuts > 0.AND.mcheck == 0)
CALL leccut(icut,xcut,itabm1)
2747
2748
2749
2750 DO i=1,sanin
2751 anin(i)=zero
2752 ENDDO
2753
2754
2755
2756 IF(nnoise > 0)
CALL lecnoise(inoise,itabm1,names_and_titles)
2757 nnoiser=nnoise
2758
2759
2760
2761#ifdef DNC
2762 IF( imadcpl > 0.AND.invers>=40.AND.mcheck == 0)CALL leccpl()
2763#endif
2764
2765
2766 IF(ipread > 0.AND.ispmd == 0.AND.mcheck == 0) WRITE(iout,4000)
2767 IF(iddw > 0.AND.ispmd == 0.AND.mcheck == 0) WRITE(iout,4100)
2768
2769
2770
2771 CALL lecdamp(ndampn, dampr, igrnod)
2772
2773 istatcnd_sav= istatcnd
2774 IF(impl_s/=0) THEN
2775 IF(isprb==0.AND.nadmesh/=0)THEN
2776 IF (ispmd == 0) THEN
2777 CALL ancmsg(msgid=131,anmode=aninfo)
2778 ENDIF
2780 ENDIF
2781 istatcnd = 0
2782 END IF
2783
2784 IF (impl_s == 1.OR.neig > 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
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)
2795
2796
2797
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 IF(nstatprt /= 0 .OR. 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
2817
2818
2819
2820 IF(dynain_data%NDYNAINPRT /= 0 .OR. 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
2832
2833
2834
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)
2839
2840 IF(ierr == 0) RETURN
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
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')
3150
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
subroutine chkipari(ipari)
subroutine damping(nodft, nodlt, v, vr, a, ar, damp, ms, in, igrnod, dim, itask, weight, tagslv_rby, wfext)
subroutine fr_rlink1(nod, itabm1, fr_rl, nsn)
subroutine fr_rlale(m1, m2, nod, itabm1, itag)
subroutine drot(n, dx, incx, dy, incy, c, s)
DROT
subroutine lcbcsf(icode, iskew, numbcsn, itab, itabm1, npby, iskwn, weight)
subroutine leccut(icut, xcut, itabm1)
subroutine lecdamp(nd, dampr, igrnod)
subroutine leceig(neigoff, neoff)
subroutine lecflsw(nsflsw, ntflsw, neflsw, nnflsw, crflsw, x, ixs, iparg, itmp)
subroutine lecfvbag1(nfvmodi, monvol, volmon)
subroutine lecfvbag(nfvmesh, monvol, volmon, x)
subroutine lecfxinp(nfxinp)
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)
subroutine lecinv(niniv, x, v, vr, itab, iframe, xframe, igrnod, fxbipm, fxbvit, fxbrpm)
subroutine lecnoise(inoise, itabm1, names_and_titles)
subroutine lecstat(ipart, ipart_state, elbuf_tab, ipm, iparg, iparts, ipartc, ipartg, mat_param)
type(alemuscl_param_) alemuscl_param
character(len=2048), dimension(check_message_size) check_message
type(fvbag_data), dimension(:), allocatable fvdata_old
integer num_opt_dt_fvmbag_1
integer num_opt_dt_fvmbag_0
integer, dimension(:,:), allocatable fxbipm
integer function ngr2usr(iu, igr, ngr)
subroutine rbyonf(iparg, ipari, ms, in, ixs, ixq, ixc, ixt, ixp, ixr, skew, itab, itabm1, iskwn, npby, onof, nrbynf, itag, lpby, rby, x, v, vr, ixtg, igrv, ibgr, weight, fr_rby2, partsav, ipart, elbuf_tab, icfield, lcfield, tagslv_rby)
subroutine read_dynain(ipart, dynain_data, ipartc, iparttg, ixc, ixtg)
subroutine rlink0(v, vr, ms, in, nlik, idir, idrot, nod, nsn, ic, icr, iskw, isk, skew, iskwn, fr_rl, weight)
subroutine spmd_chkw(iwiout, iout)
subroutine spmd_ibcast(tabi, tabr, n1, n2, from, add)
subroutine spmd_glob_isum9(v, len)
subroutine spmd_wiout(iout, iwiout)
int main(int argc, char *argv[])
subroutine upwind(rho, vis, vdx, vdy, vdz, r, s, t, deltax, gam, nel)
1.15.0