37 1 IPARI ,STFAC ,FRIGAP ,NOINT ,
38 2 IGRSURF ,XFILTR ,FRIC_P ,NPC1 ,TITR ,
39 3 LSUBMODEL ,UNITAB ,NPARI ,NPARIR ,SNPC1 )
53#include
"implicit_f.inc"
65 INTEGER,
INTENT(IN) :: ,NPARIR,SNPC1
67 INTEGER IPARI(NPARI),NPC1(SNPC1)
69 my_real frigap(nparir),fric_p(10)
70 CHARACTER(LEN=NCHARTITLE) :: TITR
72 TYPE (UNIT_TYPE_),
INTENT(IN) :: UNITAB
74 TYPE (SURF_) ,
TARGET ,
DIMENSION(NSURF) :: IGRSURF
78 INTEGER I,J,IBC1, IBC2, IBC3
83 . fric,gap,startt,bumult,stopt,c1,c2,c3,c4,c5,c6,
alpha,
85 INTEGER,
DIMENSION(:),
POINTER :: INGR2USR
140 is_available = .false.
144 CALL hm_get_intv(
'secondaryentityids',isu1,is_available
145 CALL hm_get_intv(
'mainentityids',isu2,is_available,lsubmodel)
146 CALL hm_get_intv(
'type7_Istf',igsti,is_available,lsubmodel)
147 CALL hm_get_intv(
'Igap',igap,is_available,lsubmodel)
148 CALL hm_get_intv(
'Ibag',ibag,is_available,lsubmodel)
149 CALL hm_get_intv(
'Idel7',idel23,is_available,lsubmodel)
150 CALL hm_get_intv(
'INACTIV',inacti,is_available,lsubmodel)
151 CALL hm_get_intv(
'Ifric',mfrot,is_available,lsubmodel)
152 CALL hm_get_intv(
'Ifiltr',ifq,is_available,lsubmodel)
153 CALL hm_get_intv'Deactivate_X_BC',ibc1,is_available,lsubmodel)
155 CALL hm_get_intv(
'Deactivate_Z_BC',ibc3,is_available,lsubmodel)
159 CALL hm_get_floatv(
'GAPSCALE',gapscale,is_available,lsubmodel,unitab)
160 CALL hm_get_floatv(
'GAPMAX',gapmax,is_available,lsubmodel,unitab)
161 CALL hm_get_floatv(
'FpenMax',fpenmax,is_available,lsubmodel,unitab)
162 CALL hm_get_floatv(
'STMIN',stmin,is_available,lsubmodel,unitab)
163 CALL hm_get_floatv(
'STMAX',stmax,is_available,lsubmodel,unitab)
164 CALL hm_get_floatv(
'TYPE7_SCALE',stfac,is_available,lsubmodel,unitab)
165 CALL hm_get_floatv(
'FRIC',fric,is_available,lsubmodel,unitab)
167 CALL hm_get_floatv(
'TSTART',startt,is_available,lsubmodel,unitab)
168 CALL hm_get_floatv(
'TSTOP',stopt,is_available,lsubmodel,unitab)
169 CALL hm_get_floatv(
'STIFF_DC',visc,is_available,lsubmodel,unitab
170 CALL hm_get_floatv(
'SORT_FACT',bumult,is_available,lsubmodel,unitab)
187 IF (idel23>2.OR.n2d==1) idel23 = 0
191 ingr2usr => igrsurf(1:nsurf)%ID
192 isu1=ngr2usr(isu1,ingr2usr,nsurf)
194 isu2=ngr2usr(isu2,ingr2usr,nsurf)
198 IF (ibag/=0.AND.nvolu==0 .AND.
THEN
200 . msgtype=msgwarning,
201 . anmode=aninfo_blind_2,
211 intbag =
max(intbag,ibag)
212 kcontact =
max(kcontact,ibag,iadm)
221 IF(gapscale==zero.OR.igap==0)gapscale=one
222 frigap(19) = gapscale
223 IF (fpenmax == zero) fpenmax = one
227 IF(stmax==zero)stmax=ep30
230 IF(igsti==0)i7stifs=1
232 scal_t=one ! scal_t is not
read anymore
238 IF(igsti==1)stfac=-stfac
239 IF (stopt == zero) stopt = ep30
246 IF(visc==zero) visc=one
248 ipari(11)=4*ibc1+2*ibc2+ibc3 + 8 *(4*ibc1m+2*ibc2m+ibc3m)
253 IF(bumult==zero) bumult = bmul0
257 IF (
alpha==0.) ifq = 0
263 IF (ifq==10) xfiltr = one
264 IF (mod(ifq,10)==1) xfiltr =
alpha
265 IF (mod(ifq,10)==2) xfiltr=four*atan2(one,zero) /
alpha
266 IF (mod(ifq,10)==3) xfiltr=four*atan2
267 IF (xfiltr<zero)
THEN
270 . anmode=aninfo_blind_1,
274 ELSEIF (xfiltr>1.AND.mod(ifq,10)<=2)
THEN
277 . anmode=aninfo_blind_1,
307 IF (ipari(48) /= 0)
THEN
310 IF (ipari(48) == npc1(j))
THEN
319 . anmode=aninfo_blind_1,
330 WRITE(iout,2301)ibc1,ibc2,ibc3,ibc1m,ibc2m,ibc3m,
331 . igsti,stfac,ifstf,scal_t,stmin,stmax,
332 . fric,igap,gap,gapmax,gapscale,startt,stopt,
333 . bumult,inacti,visc,multimp,ibag
334 WRITE(iout,1520)mod(ifq,10), xfiltr
336 WRITE(iout,1524) fric
338 WRITE(iout,1515)fric_p(1),fric_p(2),fric_p(3),
339 . fric_p(4),fric_p(5)
341 WRITE(iout,1522)fric,fric_p(1),fric_p(2),fric_p(3),
342 . fric_p(4),fric_p(5),fric_p(6)
344 WRITE(iout,1523)fric_p(1),fric_p(2),fric_p(3),
345 . fric_p(4),fric_p(5),fric_p(6)
347 WRITE(iout,1526) fric,fric_p(1),fric_p(2)
350 WRITE(iout,
'(A,I5/)')
351 .
' DELETION FLAG ON FAILURE (1:YES) : ',idel23
352 IF(idelkeep == 1)
THEN
354 .
' IDEL: DO NOT REMOVE NON-CONNECTED NODES FROM SECONDARY SURFACE'
360 WRITE(iout,
'(6X,A)')
'NO SECONDARY SURFACE INPUT'
362 WRITE(iout,
'(6X,A)')
'SECONDARY SURFACE INPUT BY SEGMENTS'
364 WRITE(iout,
'(6X,A)')
'SECONDARY SURFACE INPUT BY NODES'
366 WRITE(iout,
'(6X,A)')
'SECONDARY SURFACE INPUT BY SEGMENTS'
368 WRITE(iout,
'(6X,A)')
'SECONDARY SIDE INPUT BY BRICKS'
370 WRITE(iout,
'(6X,A)')
'SECONDARY SIDE INPUT BY SOLID ELEMENTS'
373 WRITE(iout,
'(6X,A)')
'NO MAIN SURFACE INPUT'
375 WRITE(iout,
'(6X,A)')
'MAIN SURFACE INPUT BY SEGMENTS'
377 WRITE(iout,
'(6X,A)')
'MAIN SURFACE INPUT BY NODES'
379 WRITE(iout,
'(6X,A)')
'MAIN SURFACE INPUT BY SEGMENTS'
381 WRITE(iout,
'(6X,A)')
'MAIN SURFACE REFERS ',
382 .
'TO HYPER-ELLIPSOIDAL SURFACE'
386 1000
FORMAT(/1x,
' INTERFACE NUMBER :',i10,1x,a)
392 .
' FRICTION MODEL 1 (Viscous Polynomial)'/,
393 .
' MU = MUo + C1 p + C2 v + C3 pv + C4 p^2 + C5 v^2'/,
394 .
' C1 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
395 .
' C2 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
396 .
' C3 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
397 .
' C4 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
398 .
' C5 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
399 .
' TANGENTIAL PRESSURE LIMIT. . .. . . . . .',1pg20.13/)
401 .
' FRICTION MODEL 2 (Darmstad Law) :'/,
402 .
' MU = MUo+c1*exp(c2*v)*p^2+c3*exp(c4*v)*p+c5*exp(c6*v)'/,
403 .
' Muo. . . . . . . . . . . . . . . . . . . ',1pg20.13/,
404 .
' C1 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
405 .
' C2 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
406 .
' C3 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
407 .
' C4 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
408 .
' C5 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
409 .
' C6 . . . . . . . . . . . . . . . . . . . ',1pg20.13/)
411 .
' FRICTION MODEL 3 (Renard law) :'/,
412 .
' C1 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
413 .
' C2 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
414 .
' C3 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
415 .
' C4 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
416 .
' C5 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
417 .
' C6 . . . . . . . . . . . . . . . . . . . ',1pg20.13/)
419 .
' FRICTION MODEL 0 (Coulomb Law) :'/,
420 .
' FRICTION COEFFICIENT . . . . . . . . . ',1pg20.13/)
422 .
' FRICTION MODEL 0 (Coulomb Law) :'/,
423 .
' Function for FRICTION COEFFICIENT wrt TEMPERATURE',i10/,
424 .
' Abscissa scale factor on IFUNTCF. . . . . ',1pg20.13/,
425 .
' Ordinate scale factor on IFUNTCF . . . . ',1pg20.13/)
427 .
' EXPONENTIAL DECAY FRICTION LAW '/
428 .
' MU = c1+(MUo-c1)*exp(-c2*v)'/
429 .
' STATIC COEFFICIENT MUo . . . . . . . . . ',1pg20.13/,
430 .
' DYNAMIC COEFFICIENT C1 . . . . . . . . . ',1pg20.13/,
431 .
' EXPONENTIAL DECAY COEFFICIENT C2 . . . . ',1pg20.13/)
432 1518
FORMAT(
' FRICTION FORMULATION: INCREMENTAL (STIFFNESS) ',
434 1519
FORMAT(
' FRICTION FORMULATION: TOTAL (VISCOUS) ',
437 .
' FRICTION FILTERING FLAG. . . . . . . . . ',i10/,
438 .
' FILTERING FACTOR . . . . . . . . . . . . ',1pg20.13)
441 .
' TYPE==23 PARALLEL/AUTO IMPACTING ' //,
442 .
' BOUND. COND. DELETED AFTER IMPACT IN X DIR ',i1
443 .
' SECONDARY NODE (1:YES 0:NO) Y DIR ',i1/,
445 .
' BOUND. COND. DELETED AFTER IMPACT IN X DIR ',i1
446 .
' MAIN NODE (1:YES 0:NO) Y DIR ',i1/
448 .
' STIFFNESS FORMULATION. . . . . . . . . . ',i1/,
449 .
' 0 : STIFFNESS IS COMPUTED FROM STIFFNESS ON SECONDARY SIDE'/,
450 .
' 1 : STFAC IS A STIFFNESS VALUE '/,
451 .
' STIFFNESS FACTOR OR STIFFNESS VALUE . . . ',1pg20.13/,
452 .
' IFSTF:FUNCTION ID FOR STIFFNESS FACTOR VS TIME. ',i10/,
453 .
' SCALE FACTOR ON ABSCISSA FOR FUNCTION IFSTF . . ',1pg20.13/,
454 .
' MINIMUM STIFFNESS. . . . . . . . . . . . ',1pg20.13/,
455 .
' MAXIMUM STIFFNESS. . . . . . . . . . . . ',1pg20.13/,
456 .
' FRICTION FACTOR . . . . . . . . . . . . . ',1pg20.13/,
457 .
' VARIABLE GAP FLAG . . . . . . . . . . . . ',i5/,
458 .
' MINIMUM GAP . . . . . . . . . . . . . . . ',1pg20.13/,
459 .
' MAXIMUM GAP (= 0. <=> NO MAXIMUM GAP) . . ',1pg20.13/,
460 .
' GAP SCALE FACTOR. . . . . . . . . . . . . ',1pg20.13/,
461 .
' START TIME. . . . . . . . . . . . . . . . ',1pg20.13/,
462 .
' STOP TIME . . . . . . . . . . . . . . . . ',1pg20.13/,
463 .
' BUCKET FACTOR . . . . . . . . . . . . . . ',1pg20.13/,
464 .
' DE-ACTIVATION OF INITIAL PENETRATIONS . . ',i10/,
465 .
' CRITICAL DAMPING FACTOR . . . . . . . . . ',1pg20.13/,
466 .
' MEAN POSSIBLE NUMBER OF IMPACT/NODE . . . ',i5/,
467 .
' IBAG . . . . . . . . . . . . . . . . . . ',i5/)
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)