#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "units_c.inc"
Functions/Subroutines
subroutine	hm_read_inter_type03 (ipari, stfac, frigap, noint, igrsurf, unitab, lsubmodel, npari, nparir)
Function/Subroutine Documentation

◆ hm_read_inter_type03()

subroutine hm_read_inter_type03	(	integer, dimension(npari)	ipari,
			stfac,
			frigap,
		integer	noint,
		type (surf_), dimension(nsurf), target	igrsurf,
		type (unit_type_), intent(in)	unitab,
		type(submodel_data), dimension(*)	lsubmodel,
		integer, intent(in)	npari,
		integer, intent(in)	nparir )
Parameters
[in] nparir array sizes (IPARI and FRIGAP)
Definition at line 35 of file hm_read_inter_type03.F.
C============================================================================
C
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE groupdef_mod
      USE submodel_mod
      USE unitab_mod
      USE names_and_titles_mod , ONLY : nchartitle, ncharkey, ncharfield
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER,INTENT(IN) :: NPARI, NPARIR !< array sizes (IPARI and FRIGAP)
      INTEGER ISU1,ISU2,NOINT
      INTEGER IPARI(NPARI)
      my_real stfac
      my_real frigap(nparir)
C-----------------------------------------------
      TYPE (SURF_)   ,TARGET , DIMENSION(NSURF)   :: IGRSURF
      TYPE(SUBMODEL_DATA) LSUBMODEL(*)
      TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB 
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "units_c.inc"
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER NTYP,IS1, IS2,IDELKEEP,ILEV,
     .    INACTI, IBC1, IBC2, IBC3,IBC1M, IBC2M, IBC3M,
     .    IGSTI,IDEL3,IRS,IRM,INTKG
      my_real
     .   fric,gap,startt,stopt,visc,viscf,gapscale,ptmax
 
!
      INTEGER, DIMENSION(:), POINTER :: INGR2USR
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      INTEGER NGR2USR
      LOGICAL IS_AVAILABLE
C-----------------------------------------------
C=======================================================================
C     READING PENALTY INTERFACE /INTER/TYPE3
C=======================================================================
 
C Initializations
      is1=0
      is2=0
      idelkeep=0
      idel3= 0
      inacti = 0
      igsti = 0
      ilev = 0
      ibc1=0
      ibc2=0
      ibc3=0
      ibc1m=0
      ibc2m=0
      ibc3m=0
      intkg = 0   
C
      fric = zero
      gap = zero
      gapscale = zero
      startt = zero
      stopt=ep30
      visc = zero
      viscf = zero
      ptmax=ep30
C
      ntyp = 3
      ipari(15)=noint
      ipari(7)=ntyp
C
      is_available = .false.
C--------------------------------------------------
C EXTRACT DATAS (INTEGER VALUES)
C--------------------------------------------------
C
      CALL hm_get_intv('mainentityids',isu1,is_available,lsubmodel)
      CALL hm_get_intv('secondaryentityids',isu2,is_available,lsubmodel)
      CALL hm_get_intv('NodDel3',idel3,is_available,lsubmodel)
C
      CALL hm_get_intv('Deactivate_X_BC',ibc1,is_available,lsubmodel)
      CALL hm_get_intv('Deactivate_Y_BC',ibc2,is_available,lsubmodel)
      CALL hm_get_intv('Deactivate_Z_BC',ibc3,is_available,lsubmodel)
      CALL hm_get_intv('Gflag',irs,is_available,lsubmodel)
      CALL hm_get_intv('Vflag',irm,is_available,lsubmodel)
C
C--------------------------------------------------
C EXTRACT DATAS (REAL VALUES)
C--------------------------------------------------
 
      CALL hm_get_floatv('TYPE3_SCALE',stfac,is_available,lsubmodel,unitab)
      CALL hm_get_floatv('FRIC',fric,is_available,lsubmodel,unitab)
      CALL hm_get_floatv('GAP',gap,is_available,lsubmodel,unitab)
      CALL hm_get_floatv('TSTART',startt,is_available,lsubmodel,unitab)
      CALL hm_get_floatv('TSTOP',stopt,is_available,lsubmodel,unitab)
C
      CALL hm_get_floatv('Ptlim',ptmax,is_available,lsubmodel,unitab)
C
C--------------------------------------------------
C CHECKS And  Storage IPARI FRIGAP 
C--------------------------------------------------
C
 
C
C....* Card1 :flags  *.............
C
 
       is1=1
       is2=1
       ingr2usr => igrsurf(1:nsurf)%ID
       isu1=ngr2usr(isu1,ingr2usr,nsurf)
       isu2=ngr2usr(isu2,ingr2usr,nsurf)
       IF (idel3 < 0) THEN
          idelkeep=1
          idel3=abs(idel3)
       END IF
       ipari(61)=idelkeep
       IF (idel3>2.OR.n2d==1) idel3 = 0
       ipari(17)=idel3
 
C.......* Storage IPARI FRIGAP *........
      ipari(45)=isu1
      ipari(46)=isu2
      ipari(13)=is1*10+is2
      ipari(20)=ilev
 
C
C....* Card2  *.............
C
       IF(stfac==zero) stfac=one_fifth
 
       IF (stopt == zero) stopt = ep30
 
C.....* Storage IPARI FRIGAP *.......
       frigap(1)=fric
       frigap(2)=gap
       frigap(3)=startt
       frigap(11)=stopt
 
C
C....* Card3   *.............
C
        ipari(11)=4*ibc1+2*ibc2+ibc3 + 8 *(4*ibc1m+2*ibc2m+ibc3m)
 
 
       ipari(24) = irm
       ipari(25) = irs
 
       ipari(11)=4*ibc1+2*ibc2+ibc3 + 8 *(4*ibc1m+2*ibc2m+ibc3m)
       frigap(14)=visc
 
C
C....* Card4   *.............
C
       IF(ptmax==zero) ptmax=ep30
 
       frigap(16)=ptmax
C
       ipari(65) = intkg
 
C
C------------------------------------------------------------
C     PRINTOUT
C------------------------------------------------------------
C
        WRITE(iout,1503)ibc1,ibc2,ibc3,stfac,fric,gap,startt,stopt,
     .                 irs,irm,ptmax
        IF(idel3/=0) THEN
          WRITE(iout,'(A,A,I5/)')
     . '    DELETION FLAG ON FAILURE OF ELEMENT',
     . ' (1:YES-ALL/2:YES-ANY) SET TO ',idel3
          IF(idelkeep == 1)THEN
            WRITE(iout,'(A/)')
     . '    IDEL: DO NOT REMOVE NON-CONNECTED NODES FROM SECONDARY SURFACE'
          ENDIF         
        ENDIF
 
C--------------------------------------------------------------
      IF(is1==0)THEN
        WRITE(iout,'(6X,A)')'NO SECONDARY SURFACE INPUT'
      ELSEIF(is1==1)THEN
        WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY SEGMENTS'
      ELSEIF(is1==2)THEN
        WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY NODES'
      ELSEIF(is1==3)THEN
        WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY SEGMENTS'
      ELSEIF(is1==4 )THEN
        WRITE(iout,'(6X,A)')'SECONDARY SIDE INPUT BY BRICKS'
      ELSEIF(is1==5 )THEN
        WRITE(iout,'(6X,A)')'SECONDARY SIDE INPUT BY SOLID ELEMENTS'        
      ENDIF
      IF(is2==0)THEN
        WRITE(iout,'(6X,A)')'NO MAIN SURFACE INPUT'
      ELSEIF(is2==1)THEN
        WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY SEGMENTS'
      ELSEIF(is2==2)THEN
        WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY NODES'
      ELSEIF(is2==3)THEN
        WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY SEGMENTS'
      ELSEIF(is2==4)THEN
        WRITE(iout,'(6X,A)')'MAIN SURFACE REFERS ',
     .                      'TO HYPER-ELLIPSOIDAL SURFACE'
      ENDIF
C
C--------------------------------------------------------------
C------------
      RETURN
 
 1503 FORMAT(//
     .    '    TYPE==3   SLIDING AND VOIDS             ' //,
     .    '    BOUND. COND. DELETED AFTER IMPACT IN X DIR  ',i1/,
     .    '       (1:YES 0:NO)                      Y DIR  ',i1/,
     .    '                                         Z DIR  ',i1/,
     .    '    STIFFNESS FACTOR. . . . . . . . . . . . . ',1pg20.13/,
     .    '    FRICTION FACTOR . . . . . . . . . . . . . ',1pg20.13/,
     .    '    INITIAL GAP . . . . . . . . . . . . . . . ',1pg20.13/,
     .    '    START TIME. . . . . . . . . . . . . . . . ',1pg20.13/,
     .    '    STOP TIME . . . . . . . . . . . . . . . . ',1pg20.13/,
     .    '    SECONDARY SURFACE REORDERING FLAG . . . . . . ',i1/,
     .    '    MAIN SURFACE REORDERING FLAG. . . . . . ',i1/,
     .    '    TANGENTIAL PRESSURE LIMIT. . .. . . . . . ',1pg20.13/)
 
OpenRadioss 2025.1.11 OpenRadioss project
Functions/Subroutines

Function/Subroutine Documentation

◆ hm_read_inter_type03()
