37 1 IPARI ,STFAC ,FRIGAP ,NOINT ,
38 2 IGRNOD ,IGRSURF ,IGRSLIN ,XFILTR ,FRIC_P ,
39 3 UNITAB ,LSUBMODEL ,TITR )
51#include "implicit_f.inc"
62 my_real frigap(*),fric_p(10)
63 CHARACTER(LEN=NCHARTITLE),
INTENT(IN) :: TITR
65 TYPE (GROUP_) ,
TARGET,
DIMENSION(NGRNOD) :: IGRNOD
66 TYPE (SURF_) ,
TARGET ,
DIMENSION(NSURF) ::
67 TYPE (SURF_) ,
TARGET ,
DIMENSION(NSLIN) :: IGRSLIN
69 TYPE (UNIT_TYPE_),
INTENT(IN) ::UNITAB
81 CHARACTER(LEN=NCHARTITLE) :: TITR1
82 INTEGER I,J,L,IBC1, IBC2, IBC3, NOINT, NTYP, IBID,
83 . INACTI, IBC1M, IBC2M, IBC3M, IGSTI,IS1,IS2,
84 . igap,multimp,mfrot,ifq,ibag,modfr,ierr1,ivis2,
85 . isym,nod1,idum,ignore,kk,ii,igap0,idelkeep,
86 . irsth,icurv,na1,na2,iform,iadm,iedge,nradm,isu10,isu20,
87 . nod10,nod20,line10,line20,ibid1,ibid2,idel7n,line1,
90 . fric,gap,startt,bumult,stopt,c1,c2,c3,c4,c5,c6,
alpha,
91 . visc,viscf,egde_angl,fpenmax,edg_angl,gapsol,stmin,stmax,
92 . padm,angladm,cadm,gapmax,gapscale
93 CHARACTER(LEN=40)::MESS
94 CHARACTER(LEN=NCHARTITLE)::MSGTITL
95 CHARACTER(LEN=NCHARKEY)::OPT,KEY,KEY1
96 CHARACTER(LEN=NCHARFIELD)::BCFLAG,BCFLAGM
98 INTEGER,
DIMENSION(:),
POINTER :: INGR2USR
166 is_available = .false.
171 CALL hm_get_intv(
'secondaryentityids',isu1,is_available,lsubmodel)
172 CALL hm_get_intv(
'mainentityids',isu2,is_available,lsubmodel)
173 CALL hm_get_intv(
'I_sym',isym,is_available,lsubmodel)
174 CALL hm_get_intv(
'I_edge',iedge,is_available,lsubmodel)
175 CALL hm_get_intv(
'GRNOD_ID',nod1,is_available,lsubmodel)
176 CALL hm_get_intv(
'Line1_set',line1,is_available,lsubmodel)
177 CALL hm_get_intv(
'Line2_set',line2,is_available,lsubmodel)
179 CALL hm_get_intv(
'Igap',igap,is_available,lsubmodel)
180 CALL hm_get_intv(
'Ibag',ibag,is_available,lsubmodel)
181 CALL hm_get_intv(
'NodDel3',idel7n,is_available,lsubmodel)
183 CALL hm_get_intv(
'Deactivate_X_BC',ibc1,is_available,lsubmodel)
184 CALL hm_get_intv(
'Deactivate_Y_BC',ibc2,is_available,lsubmodel)
185 CALL hm_get_intv(
'Deactivate_Z_BC',ibc3,is_available,lsubmodel)
186 CALL hm_get_intv(
'INACTIV',inacti,is_available,lsubmodel)
188 CALL hm_get_intv(
'Ifric',mfrot,is_available,lsubmodel)
189 CALL hm_get_intv(
'Ifiltr',ifq,is_available,lsubmodel)
190 CALL hm_get_intv(
'IFORM',modfr,is_available,lsubmodel)
195 CALL hm_get_floatv(
'ANGLE2',edg_angl,is_available,lsubmodel,unitab)
197 CALL hm_get_floatv(
'FpenMax',fpenmax,is_available,lsubmodel,unitab)
199 CALL hm_get_floatv(
'STFAC',stfac,is_available,lsubmodel,unitab)
200 CALL hm_get_floatv(
'FRIC',fric,is_available,lsubmodel,unitab)
202 CALL hm_get_floatv(
'TSTART',startt,is_available,lsubmodel,unitab)
203 CALL hm_get_floatv(
'TSTOP',stopt,is_available,lsubmodel,unitab)
205 CALL hm_get_floatv(
'STIFF_DC',visc,is_available,lsubmodel,unitab)
206 CALL hm_get_floatv(
'FRIC_DC',viscf,is_available,lsubmodel,unitab)
231 IF(isym == 0)isym = 1
241 ingr2usr => igrsurf(1:nsurf)%ID
242 IF(isu1 /= 0)isu1=ngr2usr(isu1,ingr2usr,nsurf)
250 isu2 = ngr2usr(isu2,ingr2usr,nsurf)
256 IF (isu1 == 0 .AND. isu2 == 0) iedge = -1
259 IF(iedge==3 .and. edg_angl==zero) edg_angl=ninty+one
260 frigap(26) = cos((hundred80-edg_angl)*pi/hundred80)
262 ingr2usr => igrnod(1:ngrnod)%ID
263 IF(nod1 /= 0) nod1=ngr2usr(nod1,ingr2usr,ngrnod)
266 IF(line2 == 0 .and. isu1 == 0)line2=line1
268 IF(line1 == line2)
THEN
274 IF(line1 == line2 .and. isu1 == isu2)
THEN
281 ingr2usr => igrslin(1:nslin)%ID
282 IF(line1 /= 0)line1=ngr2usr(line1,ingr2usr,nslin)
283 IF(line2 /= 0)line2=ngr2usr(line2,ingr2usr,nslin)
296 IF(igsti==0)igsti = 3
297 IF(isms==1) igsti = 4
304 IF (idel7n>2.OR.n2d==1) idel7n = 0
307 IF (ibag/=0.AND.nvolu==0 .AND. ialelag == 0 )
THEN
309 . msgtype=msgwarning,
310 . anmode=aninfo_blind_2,
316 intbag =
max(intbag,ibag)
318 kcontact =
max(kcontact,ibag,iadm)
327 IF(gapscale==zero)gapscale=one
328 frigap(13) = gapscale
332 IF(frigap(16)==zero)
THEN
337 IF (fpenmax == zero) fpenmax = one
339 frigap(29) = gapsol/four
345 IF(stmax==zero)stmax=ep30
353 IF(stfac==zero.AND.igsti/=1)
THEN
356 IF (stfac == zero )stfac = one_fifth
358 IF (stopt == zero) stopt = ep30
375 IF(fric/=zero.AND.viscf==zero)viscf=one
386 ipari(11)=4*ibc1+2*ibc2+ibc3 + 8 *(4*ibc1m+2*ibc2m+ibc3m)
391 IF (mfrot/=0.AND.viscf==0.0) viscf=one
393 IF (
alpha==0.) ifq = 0
395 IF (modfr==0) modfr = 2
396 IF (modfr==2.AND.ifq<10) ifq = ifq + 10
397 IF(modfr==2)viscf=zero
400 IF (ifq==10) xfiltr = one
402 IF (mod(ifq,10)==2) xfiltr=four*atan2(one,zero) /
alpha
403 IF (mod(ifq,10)==3) xfiltr=four*atan2(one,zero) *
alpha
404 IF (xfiltr<zero)
THEN
407 . anmode=aninfo_blind_1,
411 ELSEIF (xfiltr>1.AND.mod(ifq,10)<=2)
THEN
414 . anmode=aninfo_blind_1,
443 cadm =cos(angladm*pi/hundred80)
449 IF(bumult==zero)
THEN
451 IF(numnod > 2500000)
THEN
453 ELSEIF(numnod > 1500000)
THEN
454 bumult = bmul0*three/two
470 . isu10,isu20,isym,
max(iedge,0),nod10,line10,line20,
472 . ibc1,ibc2,ibc3,ibc1m,ibc2m,ibc3m,
473 . igsti,stfac,stmin,stmax,
474 . fric,igap,gap,gapsol,startt,stopt,
475 . inacti,fpenmax,visc,viscf,ipari(14),
481 WRITE(iout,
'(6X,A)')
'NO SECONDARY SURFACE INPUT'
483 WRITE(iout,
'(6X,A)')
'SECONDARY SURFACE INPUT BY SEGMENTS'
485 WRITE(iout,
'(6X,A)')
'SECONDARY SURFACE INPUT BY NODES'
487 WRITE(iout,
'(6X,A)')
'SECONDARY SURFACE INPUT BY SEGMENTS'
489 WRITE(iout,
'(6X,A)')
'SECONDARY SIDE INPUT BY BRICKS'
491 WRITE(iout,
'(6X,A)')
'SECONDARY SIDE INPUT BY SOLID ELEMENTS'
494 WRITE(iout,
'(6X,A)')
'NO MAIN SURFACE INPUT'
496 WRITE(iout,
'(6X,A)')
'MAIN SURFACE INPUT BY SEGMENTS'
498 WRITE(iout,
'(6X,A)')
'MAIN SURFACE INPUT BY NODES'
500 WRITE(iout,
'(6X,A)')
'MAIN SURFACE INPUT BY SEGMENTS'
502 WRITE(iout,
'(6X,A)')
'MAIN SURFACE REFERS ',
503 .
'TO HYPER-ELLIPSOIDAL SURFACE'
507 1000
FORMAT(/1x,
' INTERFACE NUMBER :',i10,1x,a)
508 1300
FORMAT( /1x,
' INTERFACES ' /
509 . 1x,
' -------------- '// )
513 .
' TYPE==20 PARALLEL/AUTO IMPACTING ' //,
514 .
' FIRST SURFACE ID. . . . . . . . . . . . . ',i10/,
515 .
' SECOND SURFACE ID . . . . . . . . . . . . ',i10/,
516 .
' SYMMETRY FLAG . . . . . . . . . . . . . . ',i10/,
517 .
' EDGE FLAG . . . . . . . . . . . . . . . . ',i10/,
519 .
' =1 Edges from surface border'/,
520 .
' =2 Edges from each segment(element) edge'/,
521 .
' =3 same as 1 + sharp edges between segment'/,
522 .
' NOD GROUP ID (ADDITIONAL) . . . . . . . . ',i10/,
523 .
' FIRST LINE ID (ADDITIONAL). . . . . . . . ',i10/,
524 .
' SECOND LINE ID (ADDITIONAL) . . . . . . . ',i10/,
525 .
' ANGLE FOR EDGE COMPUTATION (Iedge=3). . . ',1pg20.13/,
526 .
' BOUND. COND. DELETED AFTER IMPACT IN X DIR ',i1/,
527 .
' SECONDARY NODE (1:YES 0:NO) Y DIR ',i1/,
529 .
' BOUND. COND. DELETED AFTER IMPACT IN X DIR ',i1/,
530 .
' MAIN NODE (1:YES 0:NO) Y DIR ',i1/,
532 .
' STIFFNESS FORMULATION. . . . . . . . . . ',i1/,
533 .
' STIFFNESS FACTOR OR STIFFNESS VALUE . . . ',1pg20.13/,
534 .
' MINIMUM STIFFNESS. . . . . . . . . . . . ',1pg20.13/,
535 .
' MAXIMUM STIFFNESS. . . . . . . . . . . . ',1pg20.13/,
536 .
' FRICTION FACTOR . . . . . . . . . . . . . ',1pg20.13/,
537 .
' VARIABLE GAP FLAG . . . . . . . . . . . . ',i10/,
538 .
' MINIMUM GAP . . . . . . . . . . . . . . . ',1pg20.13/,
539 .
' MINIMUM SOLID THICKNESS . . . . . . . . . ',1pg20.13/,
540 .
' START TIME. . . . . . . . . . . . . . . . ',1pg20.13/,
541 .
' STOP TIME . . . . . . . . . . . . . . . . ',1pg20.13/,
542 .
' DE-ACTIVATION OF INITIAL PENETRATIONS . . ',i10/,
543 .
' MAXIMAL INITIAL PENETRATION FACTOR. . . . ',1pg20.13/,
544 .
' CRITICAL DAMPING FACTOR . . . . . . . . . ',1pg20.13/,
545 .
' FRICTION CRITICAL DAMPING FACTOR. . . . . ',1pg20.13/,
546 .
' QUADRATIC DAMPING FLAG. . . . . . . . . . ',i10/,
547 .
' FORMULATION LEVEL . . . . . . . . . . . . ',i10/,
548 .
' MEAN POSSIBLE NUMBER OF IMPACT/NODE . . . ',i10/)
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)