i25sti_edg.F File Reference

#include "implicit_f.inc"
#include "param_c.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	i25sti_edg (nedge, ledge, stfe, stfm, igap, gape, gap_e_l, gap_m, gap_m_l, gap_s_l, bgapemx, intfric, ipartfric_e, ipartfricm, ipartsm, bgapemx_l, nsn, nsv)

Function/Subroutine Documentation

i25sti_edg()

subroutine i25sti_edg	(	integer	nedge,
		integer, dimension(nledge,*)	ledge,
			stfe,
			stfm,
		integer	igap,
			gape,
			gap_e_l,
			gap_m,
			gap_m_l,
			gap_s_l,
			bgapemx,
		integer	intfric,
		integer, dimension(*)	ipartfric_e,
		integer, dimension(*)	ipartfricm,
		integer, dimension(*)	ipartsm,
			bgapemx_l,
		integer, intent(in)	nsn,
		integer, dimension(nsn), intent(in)	nsv )

Definition at line 29 of file i25sti_edg.F.

C-----------------------------------------------
      USE intbuf_fric_mod  
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-----------------------------------------------
#include      "param_c.inc"
#include      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NEDGE,IGAP,INTFRIC,
     .   LEDGE(NLEDGE,*),IPARTFRIC_E(*) ,IPARTFRICM(*), IPARTSM(*)
      INTEGER , INTENT(IN) ::  NSN
      INTEGER , INTENT(IN) ::  NSV(NSN)
      my_real
     .   stfe(*), gape(*), gap_e_l(*), stfm(*), gap_m(*), gap_m_l(*), gap_s_l(*), bgapemx,
     .   bgapemx_l
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, A, B, N1, N2, IPRTA, IPRTB, IPRTGA, IPRTGB
      my_real
     .   stfa,stfb,gapa,gapb
      INTEGER, DIMENSION(:),ALLOCATABLE :: TAGSLAV
C-----------------------------------------------
      DO i=1,nedge
 
        stfa=zero
        stfb=zero
 
        a=ledge(1,i)
        IF(a/=0) stfa=stfm(a)
        b=ledge(3,i)
        IF(b/=0) stfb=stfm(b)
        IF(stfa/=zero.AND.stfb/=zero)THEN
          IF(stfa + stfb < zero) THEN
            stfe(i)= zero                                 
          ELSE
            stfe(i)=two*stfa*stfb/max(zero,stfa+stfb)
          END IF
        ELSE
          stfe(i)=max(stfa,stfb)
        END IF
      END DO
C
      bgapemx=zero        
      DO i=1,nedge
 
        gapa=zero
        gapb=zero
 
        a=ledge(1,i)
        IF(a/=0) gapa=gap_m(a)
        b=ledge(3,i)
        IF(b/=0) gapb=gap_m(b)
        gape(i)=max(gapa,gapb)
 
        bgapemx   = max(bgapemx,gape(i)) ! BGAPEMX overall the model 
 
      END DO
 
      bgapemx_l=zero        
      IF(igap==3)THEN
        ALLOCATE(tagslav(numnod))
        tagslav(1:numnod)   = 0
        DO i=1,nsn
           tagslav(nsv(i)) = i
        ENDDO
        DO i=1,nedge
          n1=ledge(5,i)
          n2=ledge(6,i)                             !      4-node segment
          gap_e_l(i)=min(gap_s_l(tagslav(n1)),gap_s_l(tagslav(n2)))   !    O-----------------O
                                                    !   Edge1             Edge2
 
          bgapemx_l   = max(bgapemx_l,gap_e_l(i)) ! BGAPEMX_L overall the model 
        END DO
        DEALLOCATE(tagslav)
      END IF
 
      IF(intfric > 0) THEN
        DO i=1,nedge
           iprta=0 
           iprtb=0
 
           iprtga=0
           iprtgb=0
 
           a=ledge(1,i)
           IF(a/=0) iprtga=ipartsm(a)
           IF(a/=0) iprta=ipartfricm(a)
 
           b=ledge(3,i)
           IF(b/=0) iprtgb=ipartsm(b)
           IF(b/=0) iprtb=ipartfricm(b)
 
           IF(iprta == iprtb) THEN
              ipartfric_e(i) = iprta
           ELSE
              IF(iprtga > iprtgb ) THEN ! bigger part id is taken
                 ipartfric_e(i) = iprta
              ELSE
                 ipartfric_e(i) = iprtb
              ENDIF
           ENDIF
        END DO
      ENDIF
C        
      RETURN