41 1 IPARI ,STFAC ,FRIGAP ,NOINT ,NI ,
42 2 IGRSURF ,XFILTR ,FRIC_P ,NPC1 ,SENSORS ,
43 3 NOM_OPT ,UNITAB ,LSUBMODEL ,TITR ,NPC ,
44 4 TF ,NPARI ,NPARIR ,SNPC ,SNPC1 ,
45 5 LNOPT1 ,ITHERM_FE ,INTHEAT ,NOM_OPTFRIC ,INTBUF_FRIC_TAB )
62#include "implicit_f.inc"
66 INTEGER,
INTENT(IN) :: NPARI,NPARIR,SNPC,SNPC1,LNOPT1
67 INTEGER,
INTENT(IN) :: ITHERM_FE
68 INTEGER,
INTENT(INOUT) :: INTHEAT
69 INTEGER,
INTENT(IN) :: NOM_OPTFRIC(LNOPT1,NINTERFRIC)
70 INTEGER NOM_OPT(LNOPT1,*)
71 INTEGER ISU1,ISU2,ILAGM,NI
72 INTEGER IPARI(NPARI),NPC1(SNPC1),NPC(SNPC)
74 my_real frigap(nparir),fric_p(10),tf(*)
75 CHARACTER(LEN=NCHARTITLE),
INTENT(IN) :: TITR
77 TYPE (SURF_) ,
TARGET ,
DIMENSION(NSURF) :: IGRSURF
79 TYPE (UNIT_TYPE_),
INTENT(IN) :: UNITAB
80 TYPE (SENSORS_) ,
INTENT(IN) :: SENSORS
81 TYPE(INTBUF_FRIC_STRUCT_),
INTENT(INOUT) :: INTBUF_FRIC_TAB(NINTERFRIC)
88#include "intstamp_c.inc"
91#include "remesh_c.inc"
95 CHARACTER(LEN=NCHARTITLE) :: TITR1
96 INTEGER I,J,L,IBC1, IBC2, IBC3, NOINT, NTYP, IBID,INACTI, IBC1M,
97 . IBC2M, IBC3M, IGSTI,IEULT, IVIS2,IS1, IS2,ILEV, IGAP,MULTIMP,
98 . HIERA,MFROT,IFQ,MODFR,IADM,UID,NRADM,INTTH,IFORM,,IKTHE,
99 . IDEL21,IMOD,IFILTR,IFUNS,IFUNN,IFUNT,IFUN1,IFUN2,HFLAG,NUVAR,
100 . ifstf,kk,ii,igap0,flagremnod,idsens,idelkeep,intkg,irsth,invn,
101 . ifricth,iftlim,fcond,intfric
103 . fric,gap,startt,bumult,stopt,fheat,fheats,fheatm,rsth,tint,padm,
104 . angladm, cadm, depth,c1,c2,c3,c4,c5,c6,
alpha,gapscale,gapmax,
105 . stmin,stmax,stiff, pmax,
area, kthe, xthe, frad, drad,
106 . visc,xfricth,ptmax,pskid
107 INTEGER,
DIMENSION(:),
POINTER :: INGR2USR
179 nintstamp=nintstamp+1
186 is_available = .false.
190 CALL hm_get_intv(
'secondaryentityids',isu1,is_available,lsubmodel)
191 CALL hm_get_intv(
'mainentityids',isu2,is_available,lsubmodel)
192 CALL hm_get_intv(
'Istf',igsti,is_available,lsubmodel)
193 CALL hm_get_intv(
'Ithe',intth,is_available,lsubmodel)
194 CALL hm_get_intv(
'Igap',igap,is_available,lsubmodel)
195 CALL hm_get_intv(
'Multimp',multimp,is_available,lsubmodel)
196 CALL hm_get_intv(
'TYPE21_Idel',idel21,is_available,lsubmodel)
197 CALL hm_get_intv(
'TYPE21_Invn',invn,is_available,lsubmodel)
198 CALL hm_get_intv(
'Iadm',iadm,is_available,lsubmodel)
200 IF(igap==1.OR.igap==2)
CALL hm_get_intv(
'TYPE21_ITim',iftlim,is_available,lsubmodel
202 CALL hm_get_intv(
'Deactivate_X_BC',ibc1,is_available,lsubmodel)
203 CALL hm_get_intv(
'Deactivate_Y_BC',ibc2,is_available,lsubmodel)
204 CALL hm_get_intv(
'Deactivate_Z_BC',ibc3,is_available,lsubmodel)
205 CALL hm_get_intv(
'INACTIV',inacti,is_available,lsubmodel
207 CALL hm_get_intv(
'Ifric',mfrot,is_available,lsubmodel)
208 CALL hm_get_intv(
'Ifiltr',ifq,is_available,lsubmodel)
210 CALL hm_get_intv(
'Crx_Fun',ifricth,is_available,lsubmodel)
211 CALL hm_get_intv(
'Ifric',mfrot,is_available,lsubmodel)
212 CALL hm_get_intv(
'Fric_ID',intfric,is_available,lsubmodel)
214 IF(iadm==2)
CALL hm_get_intv(
'NRadm',nradm,is_available,lsubmodel)
217 CALL hm_get_intv(
'Ithe_form',iform,is_available,lsubmodel)
218 CALL hm_get_intv(
'fct_ID_k',ikthe,is_available,lsubmodel)
219 CALL hm_get_intv(
'F_COND',fcond,is_available,lsubmodel)
225 IF(igap==1.OR.igap==2)
THEN
226 CALL hm_get_floatv(
'GAPSCALE',gapscale,is_available,lsubmodel,unitab)
228 CALL hm_get_floatv(
'DIST',depth,is_available,lsubmodel,unitab)
229 CALL hm_get_floatv(
'PMAX',pmax,is_available,lsubmodel,unitab)
232 CALL hm_get_floatv(
'STMIN',stmin,is_available,lsubmodel,unitab)
233 CALL hm_get_floatv(
'STMAX',stmax,is_available,lsubmodel,unitab)
234 CALL hm_get_floatv(
'Pskid',pskid,is_available,lsubmodel,unitab)
236 CALL hm_get_floatv(
'STFAC',stfac,is_available,lsubmodel,unitab)
237 CALL hm_get_floatv(
'FRIC',fric,is_available,lsubmodel,unitab)
239 CALL hm_get_floatv(
'TSTART',startt,is_available,lsubmodel,unitab)
240 CALL hm_get_floatv(
'TSTOP',stopt,is_available,lsubmodel,unitab)
242 CALL hm_get_floatv(
'VISC',visc,is_available,lsubmodel,unitab)
243 CALL hm_get_floatv(
'SORT_FACT',bumult,is_available,lsubmodel,unitab)
246 CALL hm_get_floatv(
'scale1',xfricth,is_available,lsubmodel,unitab)
260 CALL hm_get_floatv(
'Padm',padm,is_available,lsubmodel,unitab)
261 CALL hm_get_floatv(
'Angladm',angladm,is_available,lsubmodel,unitab)
266 CALL hm_get_floatv(
'Kthe',kthe,is_available,lsubmodel,unitab)
267 CALL hm_get_floatv(
'Tint',tint,is_available,lsubmodel,unitab)
268 CALL hm_get_floatv(
'A_scale_k',xthe,is_available,lsubmodel,unitab)
269 CALL hm_get_floatv(
'F_RAD',frad,is_available,lsubmodel,unitab)
270 CALL hm_get_floatv(
'D_RAD',drad,is_available,lsubmodel,unitab
271 CALL hm_get_floatv(
'HEAT_AL',fheat,is_available,lsubmodel,unitab)
272 CALL hm_get_floatv(
'D_COND',dcond,is_available,lsubmodel,unitab)
287 IF (idel21>2.OR.n2d==1) idel21 = 0
297 ingr2usr => igrsurf(1:nsurf)%ID
298 isu1=ngr2usr(isu1,ingr2usr,nsurf)
300 isu2=ngr2usr(isu2,ingr2usr,nsurf)
302 IF (iadm/=0.AND.nadmesh==0)
THEN
304 . msgtype=msgwarning,
305 . anmode=aninfo_blind_2,
331 IF(igap==1.OR.igap==2)
THEN
335 IF(gapscale==zero)gapscale=one
338 IF(igap==2) inter_ithknod=1
341 IF(pmax==zero) pmax=ep30
354 frigap(19) = gapscale
369 IF(stmax==zero)stmax=ep30
377 IF(pskid==zero) pskid=ep30
389 IF(igsti==1)stfac=-stfac
391 IF (stopt == zero) stopt = ep30
403 IF(visc==zero) visc=one
407 ipari(11)=4*ibc1+2*ibc2+ibc3 + 8 *(4*ibc1m+2*ibc2m+ibc3m)
412 IF(bumult==zero)
THEN
414 IF(numnod > 2500000)
THEN
416 ELSEIF(numnod > 1500000)
THEN
417 bumult = bmul0*three/two
434 IF(xfricth == zero) xfricth=one
436 IF (
alpha==zero) ifq = 0
442 IF (ifq==10) xfiltr = one
443 IF (mod(ifq,10)==1) xfiltr =
alpha
444 IF (mod(ifq,10)==2) xfiltr=four*atan2(one,zero) /
alpha
445 IF (mod(ifq,10)==3) xfiltr=four*atan2(one,zero) *
alpha
446 IF (xfiltr<zero)
THEN
449 . anmode=aninfo_blind_1,
453 ELSEIF (xfiltr>1.AND.mod(ifq,10)<=2)
THEN
456 . anmode=aninfo_blind_1,
486 IF(nradm==0) nradm =3
487 IF(padm==zero) padm =one
495 cadm =cos(angladm*pi/hundred80)
496 kcontact =
max(kcontact,iadm)
513 kthe = one * kthe_unit
517 IF (xthe == zero)
THEN
520 xthe = one * xthe_unit
541 IF(itherm_fe == 0 .AND. intth > 0 )
THEN
545 . msgtype=msgwarning,
553 IF(intth == 2 ) ftempvar21 = 1
557 IF(frad==zero ) drad = zero
559 IF(fcond /= 0.AND.dcond/=zero.AND.drad==zero)
THEN
562 . msgtype=msgwarning,
570 IF(dcond > drad)
THEN
573 . msgtype=msgwarning,
610 WRITE(iout,2101)ibc1,ibc2,ibc3,ibc1m,ibc2m,ibc3m,
611 . ilev,igsti,stfac,stmin,stmax,
612 . fric,igap,gap,gapmax,gapscale,idsens,
613 . bumult,inacti,visc,pmax,multimp,invn,iftlim,
616 WRITE(iout,2104)ibc1,ibc2,ibc3,ibc1m,ibc2m,ibc3m,
617 . ilev,igsti,stfac,stmin,stmax,
618 . fric,igap,gap,gapmax,gapscale,startt,stopt,
619 . bumult,inacti,visc,pmax,multimp,invn,iftlim,
623 IF(intfric > 0 )
THEN
624 WRITE(iout,1527) intfric
627 WRITE(iout,1520)mod(ifq,10), xfiltr
630 IF(ifricth ==0 )
THEN
631 WRITE(iout,1524) fric
633 WRITE(iout,1525) ifricth,xfricth,fric
636 WRITE(iout,1515)fric_p(1),fric_p(2),fric_p(3),
637 . fric_p(4),fric_p(5)
639 WRITE(iout,1522)fric,fric_p(1),fric_p(2),fric_p(3),
640 . fric_p(4),fric_p(5),fric_p(6)
642 WRITE(iout,1523)fric_p(1),fric_p(2),fric_p(3),
643 . fric_p(4),fric_p(5),fric_p(6)
645 WRITE(iout,1526) fric,fric_p(1),fric_p(2)
650 WRITE(iout,
'(A,I5/)')
651 .
' DELETION FLAG ON FAILURE (1:YES) : ',idel21
652 IF(idelkeep == 1)
THEN
654 .
' IDEL: DO NOT REMOVE NON-CONNECTED NODES FROM SECONDARY SURFACE'
658 WRITE(iout,*)
' MESH REFINEMENT CASE OF CONTACT',
659 .
' (0:NO/1:DUE TO CURVATURE/2:DUE TO CURVATURE OR PENETRATION)',
662 WRITE(iout,1557) nradm,padm,angladm
668 WRITE(iout,2102) kthe,tint,frad,drad,fheat,iform,fcond,dcond
670 WRITE(iout,2103) ikthe,xthe,kthe,tint,frad,drad,fheat,iform,fcond
675 WRITE(iout,
'(6X,A)')
'NO SECONDARY SURFACE INPUT'
677 WRITE(iout,
'(6X,A)')
'SECONDARY SURFACE INPUT BY SEGMENTS'
679 WRITE(iout,'(6x,a)
')'secondary surface input by nodes
'
681 WRITE(IOUT,'(6x,a)
')'secondary surface input by segments
'
683 WRITE(IOUT,'(6x,a)
')'secondary side input by bricks
'
685 WRITE(IOUT,'(6x,a)
')'secondary side input by solid elements
'
688 WRITE(IOUT,'(6x,a)
')'no
main surface input
'
690 WRITE(IOUT,'(6x,a)
')'main surface input by segments
'
692 WRITE(IOUT,'(6x,a)
')'main surface input by nodes
'
694 WRITE(IOUT,'(6x,a)
')'main surface input by segments
'
696 WRITE(IOUT,'(6x,a)
')'main surface refers
',
697 . 'to hyper-ellipsoidal surface
'
701 1000 FORMAT(/1X,' INTERFACE number :
',I10,1X,A)
705 . ' thermal
INTERFACE . . . . . . . . . . . . .
',//
706 . ' thermal heat exchange coefficient .. . . . .
',1PG20.13/)
707 2502 FORMAT(' rupture parameters
'
708 . /10X,'scal_f . . . . . . . . . . . . . .
',1PG20.13
709 . /10X,'scal_disp . . . . . . . . . . . . .
',1PG20.13
710 . /10X,'scal_sr . . . . . . . . . . . . . .
',1PG20.13
711 . /10X,'filtering coeff . . . . . . . . . .
',1PG20.13
712 . /10X,'default secondary
area. . . . . . . . .
',1PG20.13
713 . /10X,'dn_max . . . . . . . . . . . . . .
',1PG20.13
714 . /10X,'dt_max . . . . . . . . . . . . . .
',1PG20.13
715 . /10X,'ifunn . . . . . . . . . . . . . .
',I10
716 . /10X,'ifunt . . . . . . . . . . . . . .
',I10
717 . /10X,'ifuns . . . . . . . . . . . . . .
',I10
718 . /10X,'imod . . . . . . . . . . . . . .
',I10
719 . /10X,'isym . . . . . . . . . . . . . .
',I10
720 . /10X,'ifiltr . . . . . . . . . . . . . .
',I10//)
722 . ' friction model 1 (viscous polynomial)
'/,
723 . ' mu = muo + c1 p + c2 v + c3 pv + c4 p^2 + c5 v^2
'/,
724 . ' c1 . . . . . . . . . . . . . . . . . . .
',1PG20.13/,
725 . ' c2 . . . . . . . . . . . . . . . . . . .
',1PG20.13/,
726 . ' c3 . . . . . . . . . . . . . . . . . . .
',1PG20.13/,
727 . ' c4 . . . . . . . . . . . . . . . . . . .
',1PG20.13/,
728 . ' c5 . . . . . . . . . . . . . . . . . . .
',1PG20.13/,
729 . ' tangential pressure limit. . .. . . . . .
',1PG20.13/)
731 . ' friction model 2 (darmstad law) :
'/,
732 . ' mu = muo+c1*exp(c2*v)*p^2+c3*exp(c4*v)*p+c5*exp(c6*v)
'/,
733 . ' muo. . . . . . . . . . . . . . . . . . .
',1PG20.13/,
734 . ' c1 . . . . . . . . . . . . . . . . . . .
',1PG20.13/,
735 . ' c2 . . . . . . . . . . . . . . . . . . .
',1PG20.13/,
736 . ' c3 . . . . . . . . . . . . . . . . . . .
',1PG20.13/,
737 . ' c4 . . . . . . . . . . . . . . . . . . .
',1PG20.13/,
738 . ' c5 . . . . . . . . . . . . . . . . . . .
',1PG20.13/,
739 . ' c6 . . . . . . . . . . . . . . . . . . .
',1PG20.13/)
741 . ' friction model 3 (renard law) :
'/,
742 . ' c1 . . . . . . . . . . . . . . . . . . .
',1PG20.13/,
743 . ' c2 . . . . . . . . . . . . . . . . . . .
',1PG20.13/,
744 . ' c3 . . . . . . . . . . . . . . . . . . .
',1PG20.13/,
745 . ' c4 . . . . . . . . . . . . . . . . . . .
',1PG20.13/,
746 . ' c5 . . . . . . . . . . . . . . . . . . .
',1PG20.13/,
747 . ' c6 . . . . . . . . . . . . . . . . . . .
',1PG20.13/)
749 . ' friction model 0 (coulomb law) :
'/,
750 . ' friction coefficient . . . . . . . . .
',1PG20.13/)
752 . ' friction model 0 (coulomb law) :
'/,
753 . ' Function for friction coefficient wrt temperature
',I10/,
754 . ' abscissa scale factor on ifuntcf. . . . .
',1PG20.13/,
755 . ' ordinate scale factor on ifuntcf . . . .
',1PG20.13/)
757 . ' exponential decay friction law
'/
758 . ' mu = c1+(MUo-c1)*exp(-c2*v)
'/
759 . ' static coefficient muo . . . . . . . . .
',1PG20.13/,
760 . ' dynamic coefficient c1 . . . . . . . . .
',1PG20.13/,
761 . ' exponential decay coefficient c2 . . . .
',1PG20.13/)
764 . ' interface friction model. . . . . . . . .
',I10)
766 1518 FORMAT( ' friction formulation: incremental (STIFFNESS)
',
768 1519 FORMAT( ' friction formulation: total (VISCOUS)
',
771 . ' friction filtering flag. . . . . . . . .
',I10/,
772 . ' filtering factor . . . . . . . . . . . .
',1PG20.13)
774 .' number of elements within a 90 degrees fillet
',I5/,
775 .' ---------------------------------------------
'/,
776 .' criteria
for refinement due to penetration :
'/,
777 .' ------------------------------------------
'/,
778 .' minimum percentage of penetration
',
783 . ' type==21 parallel/stamping
' //,
784 . ' bound. cond. deleted after impact in x dir
',I1/,
785 . ' secondary node (1:YES 0:NO) y dir
',I1/,
787 . ' bound. cond. deleted after impact in x dir
',I1/,
788 . ' main node (1:YES 0:NO) y dir
',I1/,
790 . ' formulation level. . . . . . . . . . . . . .
',I1/,
791 . ' (0:OLD, 1:OPTIMIZED). . . . . . . .
',/,
792 . ' stiffness formulation. . . . . . . . . .
',I1/,
793 .' 0 : stiffness is computed from stiffness on secondary side
'/,
794 .' 1 : stfac is a stiffness value
'/,
795 . ' stiffness factor or stiffness value . . . .
',1PG20.13/,
796 . ' minimum stiffness. . . . . . . . . . . . .
',1PG20.13/,
797 . ' maximum stiffness. . . . . . . . . . . . .
',1PG20.13/,
798 . ' friction factor . . . . . . . . . . . . . .
',1PG20.13/,
799 . ' variable gap flag . . . . . . . . . . . . .
',I5/,
800 . ' minimum gap . . . . . . . . . . . . . . . .
',1PG20.13/,
801 . ' maximum gap (= 0. <=> NO MAXIMUM GAP) . . .
',1PG20.13/,
802 . ' gap scale factor. . . . . . . . . . . . . .
',1PG20.13/,
803 . ' start time/stop time activated by sensor
id ',I10/,
804 . ' bucket factor . . . . . . . . . . . . . . .
',1PG20.13/,
805 . ' de-activation of initial penetrations . . .
',I10/,
806 . ' critical
damping factor . . . . . . . . . .
',1PG20.13/,
807 . ' maximum pressure due to
'/,
808 . ' case of igap=2. . . . . . .
',1PG20.13/,
809 . ' mean possible number of impact/node . . . .
',I5/,
810 . ' inverted normals detection flag . . . . . .
',I5/,
811 . ' tangential force limitation flag . . . . . .
',I5/,
812 . ' maximum pressure
for skid line output
',1PG20.13)
814 . ' type==21 parallel/stamping
' //,
815 . ' bound. cond. deleted after impact in x dir
',I1/,
816 . ' secondary node (1:YES 0:NO) y dir
',I1/,
818 . ' bound. cond. deleted after impact in x dir
',I1/,
819 . ' main node (1:YES 0:NO) y dir
',I1/,
821 . ' formulation level. . . . . . . . . . . . . .
',I1/,
822 . ' (0:OLD, 1:OPTIMIZED). . . . . . . .
',/,
823 . ' stiffness formulation. . . . . . . . . .
',I1/,
824 .' 0 : stiffness is computed from stiffness on secondary side
'/,
825 .' 1 : stfac is a stiffness value
'/,
826 . ' stiffness factor or stiffness value . . .
',1PG20.13/,
827 . ' minimum stiffness. . . . . . . . . . . .
',1PG20.13/,
828 . ' maximum stiffness. . . . . . . . . . . .
',1PG20.13/,
829 . ' friction factor . . . . . . . . . . . . .
',1PG20.13/,
830 . ' variable gap flag . . . . . . . . . . . .
',I5/,
831 . ' minimum gap . . . . . . . . . . . . . . .
',1PG20.13/,
832 . ' maximum gap (= 0. <=> NO MAXIMUM GAP) . .
',1PG20.13/,
833 . ' gap scale factor. . . . . . . . . . . . .
',1PG20.13/,
834 . ' start time. . . . . . . . . . . . . . . .
',1PG20.13/,
835 . ' stop time . . . . . . . . . . . . . . . .
',1PG20.13/,
836 . ' bucket factor . . . . . . . . . . . . . .
',1PG20.13/,
837 . ' de-activation of initial penetrations . .
',I10/,
838 . ' critical
damping factor . . . . . . . . .
',1PG20.13/,
839 . ' maximum pressure due to thickness variation
'/,
840 . ' case of igap=2. . . . . .
',1PG20.13/,
841 . ' mean possible number of impact/node . . .
',I5/,
842 . ' inverted normals detection flag . . . . . .
',I5/,
843 . ' tangential force limitation flag . . . . . .
',I5/,
844 . ' maximum pressure
for skid line output
',1PG20.13)
846 . ' thermal interface
' //,
847 . ' thermal heat exchange coefficient . . . . .
',1PG20.13/,
848 . ' interface temperature . . . . . . . . . .
',1PG20.13/,
849 . ' radiation factor . . . . . . . . . . . . .
',1PG20.13/,
850 . ' maximum distance
for radiation computation.
',1PG20.13/,
851 . ' frictional heat transfer. . . . . . . . . .
',1PG20.13/,
852 . ' formulation choice : . . . . . . . . . . .
',I10,/,
854 . ' and constant temperature in interface
',/,
855 . ' 1 : heat exchange between pieces in contact
'/
856 . ' function
for thermal heat exchange coefficient wrt distance
',I10/,
857 . ' maximum distance
for conductive heat exchange
',1PG20.13)
859 . ' thermal interface
' //,
860 . ' function
for thermal heat exchange coefficient wrt contact pressure
',I10/,
861 . ' abscissa scale factor on ifuntck. . . . .
',1PG20.13/,
862 . ' ordinate scale factor on ifuntck . . . .
',1PG20.13/,
863 . ' interface temperature . . . . . . . . . .
',1PG20.13/,
864 . ' radiation factor . . . . . . . . . . . . .
',1PG20.13/,
865 . ' maximum distance
for radiation computation.
',1PG20.13/,
866 . ' frictional heat generation . . . . . . . .
',1PG20.13/,
867 . ' formulation choice : . . . . . . . . . . .
',I10,/,
868 . ' 0 : heat transfer between secondary side
',/,
869 . ' and constant temperature in interface
',/,
870 . ' 1 : heat exchange between pieces in contact'/
871 .
' Function for thermal heat exchange coefficient wrt distance',i10/,
872 .
' Maximum distance for conductive heat exchange',1pg20.13)