#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "param_c.inc"

Functions/Subroutines
subroutine	i25pen3_edg (jlt, cand_s, cand_m, drad, igap0, nedge, ledge, marge, gape, gap_e_l, igap, x, irect, pene, admsr, edg_bisector, vtx_bisector, itab, dgapload)

Function/Subroutine Documentation

◆ i25pen3_edg()

subroutine i25pen3_edg	(	integer	jlt,
		integer, dimension(*)	cand_s,
		integer, dimension(*)	cand_m,
			drad,
		integer	igap0,
		integer	nedge,
		integer, dimension(nledge,*)	ledge,
			marge,
			gape,
			gap_e_l,
		integer	igap,
			x,
		integer, dimension(4,*)	irect,
			pene,
		integer, dimension(4,*)	admsr,
		real4, dimension(3,4,)	edg_bisector,
		real4, dimension(3,2,)	vtx_bisector,
		integer, dimension(*)	itab,
		intent(in)	dgapload )

Definition at line 30 of file i25pen3_edg.F.

 
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE tri7box
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "mvsiz_p.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER JLT, IGAP0, NEDGE, IGAP
      INTEGER IRECT(4,*), CAND_S(*), CAND_M(*), LEDGE(NLEDGE,*), ADMSR(4,*), ITAB(*)
      my_real
     .     drad, marge 
      my_real , INTENT(IN) :: dgapload
      my_real
     .     x(3,*), gape(*), gap_e_l(*), pene(mvsiz)
      real*4 edg_bisector(3,4,*), vtx_bisector(3,2,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, IG,N1,N2,M1,M2,NI,L,J, IE, JE, IL, JL
      my_real
     .     xxs1(mvsiz) ,xxs2(mvsiz) ,xys1(mvsiz) ,xys2(mvsiz) ,xzs1(mvsiz) ,xzs2(mvsiz) ,
     .     xxm1(mvsiz) ,xxm2(mvsiz) ,xym1(mvsiz) ,xym2(mvsiz) ,xzm1(mvsiz) ,xzm2(mvsiz) ,
     .     xs12,ys12,zs12,xm12,ym12,zm12,xa,xb,
     .     xs2,xm2,xsm,xs2m2,ys2,ym2,ysm,ys2m2,zs2,zm2,zsm,zs2m2,
     .     xx,yy,zz,als,alm,det,gap2, 
     .     xmax1,ymax1,zmax1,xmax2,ymax2,zmax2,
     .     xmin1,ymin1,zmin1,xmin2,ymin2,zmin2,gapv(mvsiz),
     .     aaa, dx, dy, dz, dd, ex, ey ,ez, nni, ni2, invcos
      my_real 
     .     maxgapv
C-----------------------------------------------
      DO i=1,jlt
        ie = cand_m(i)
 
        IF(cand_s(i) <= nedge) THEN
          je = cand_s(i)
          gapv(i)=gape(ie)+gape(je)
C
          IF(igap0 == 0) THEN
            gapv(i)=two*gape(ie)+gape(je)
          ELSE
            gapv(i)=two*(gape(ie)+gape(je))
          END IF
C
          IF(igap == 3)
     .       gapv(i)=min(gap_e_l(ie)+gap_e_l(je),gapv(i)) ! under-estimated ...
C
          gapv(i)= max(drad,gapv(i)+dgapload )+marge
        ENDIF
      ENDDO
 
c     MAXGAPV = GAPV(1)
c     DO I = 2,JLT
c       MAXGAPV = MAX(MAXGAPV,GAPV(I))
c     ENDDO
c     WRITE(6,*) __FILE__,__LINE__,"MAXGAPV=",MAXGAPV
C-------------------------------------------------------- 
C  
C--------------------------------------------------------
C       F = [A*X1+(1-A)*X2-B*X3-(1-B)*X4]^2 + [..Y..]^2 + [..Z..]^2
C       DF/DA = 0 = (X1-X2)(A(X1-X2)+X2-X4 +B(X4-X3))+...
C       DF/DA = 0 = A(X1-X2)^2 +X2-X4 + B(X1-X2)(X4-X3))+...
C       DF/DA = 0 = A[(X1-X2)^2 + (Y1-Y2)^2 + (Z1-Z2)^2] 
C                 + B[(X1-X2)(X4-X3) + (Y1-Y2)(Y4-Y3) + (Z1-Z2)(Z4-Z3)]
C                 +   (X1-X2)(X2-X4) + (Y1-Y2)(Y2-Y4) + (Z1-Z2)(Z2-Z4) 
C       DF/DB = 0 = (X4-X3)(A(X1-X2)+X2-X4 +B(X4-X3))+...
C       DF/DB = 0 = B[(X4-X3)^2 + (Y4-Y3)^2 + (Z4-Z3)^2] 
C                 + A[(X1-X2)(X4-X3) + (Y1-Y2)(Y4-Y3) + (Z1-Z2)(Z4-Z3)]
C                 +   (X4-X3)(X2-X4) + (Y4-Y3)(Y2-Y4) + (Z4-Z3)(Z2-Z4) 
C       XS2 = [(X1-X2)^2 + (Y1-Y2)^2 + (Z1-Z2)^2]
C       XM2 = [(X4-X3)^2 + (Y4-Y3)^2 + (Z4-Z3)^2]
C       XSM = [(X1-X2)(X4-X3) + (Y1-Y2)(Y4-Y3) + (Z1-Z2)(Z4-Z3)]
C       XA = (X1-X2)(X2-X4) + (Y1-Y2)(Y2-Y4) + (Z1-Z2)(Z2-Z4)
C       XB = (X4-X3)(X2-X4) + (Y4-Y3)(Y2-Y4) + (Z4-Z3)(Z2-Z4)
C       A XS2 + B XSM +   XA = 0
C       A XSM + B XM2 +   XB = 0
C
C       A = -(XA + B XSM)/XS2
C       -(XA + B XSM)*XSM + B XM2*XS2 +   XB*XS2 = 0
C       -B XSM*XSM + B XM2*XS2 +   XB*XS2-XA*XSM  = 0
C       B*(XM2*XS2 - XSM*XSM) = -XB*XS2+XA*XSM  
C       B = (XA*XSM-XB*XS2) / (XM2*XS2 - XSM*XSM)
C       A = (XB*XSM-XA*XM2) / (XM2*XS2 - XSM*XSM)
C--------------------------------------------------------
      DO i=1,jlt
        IF(cand_s(i)<=nedge) THEN
          n1 = ledge(5,cand_s(i))
          n2 = ledge(6,cand_s(i))
 
          xxs1(i) = x(1,n1)
          xys1(i) = x(2,n1)
          xzs1(i) = x(3,n1)
          xxs2(i) = x(1,n2)
          xys2(i) = x(2,n2)
          xzs2(i) = x(3,n2)
 
        END IF
 
        m1 = ledge(5,cand_m(i))
        m2 = ledge(6,cand_m(i))
 
        xxm1(i) = x(1,m1)
        xym1(i) = x(2,m1)
        xzm1(i) = x(3,m1)
        xxm2(i) = x(1,m2)
        xym2(i) = x(2,m2)
        xzm2(i) = x(3,m2)
 
      END DO
C
C--------------------------------------------------------
C     calcul d'un minorant de la distance
C--------------------------------------------------------
        DO i=1,jlt
          xmax1 = max(xxs1(i),xxs2(i))
          ymax1 = max(xys1(i),xys2(i))
          zmax1 = max(xzs1(i),xzs2(i))
          xmax2 = max(xxm1(i),xxm2(i))
          ymax2 = max(xym1(i),xym2(i))
          zmax2 = max(xzm1(i),xzm2(i))
          xmin1 = min(xxs1(i),xxs2(i))
          ymin1 = min(xys1(i),xys2(i))
          zmin1 = min(xzs1(i),xzs2(i))
          xmin2 = min(xxm1(i),xxm2(i))
          ymin2 = min(xym1(i),xym2(i))
          zmin2 = min(xzm1(i),xzm2(i))
          dd = max(xmin1-xmax2,ymin1-ymax2,zmin1-zmax2,
     .             xmin2-xmax1,ymin2-ymax1,zmin2-zmax1)
          IF(dd > gapv(i))THEN
            pene(i) = zero
            cycle
          ENDIF
 
c         calcul de la distance^2
 
          xm12 = xxm2(i)-xxm1(i)
          ym12 = xym2(i)-xym1(i)
          zm12 = xzm2(i)-xzm1(i)
          xm2 = xm12*xm12 + ym12*ym12 + zm12*zm12
 
          xs12 = xxs2(i)-xxs1(i)
          ys12 = xys2(i)-xys1(i)
          zs12 = xzs2(i)-xzs1(i)
          xs2  = xs12*xs12 + ys12*ys12 + zs12*zs12
          xsm = - (xs12*xm12 + ys12*ym12 + zs12*zm12)
          xs2m2 = xxm2(i)-xxs2(i)
          ys2m2 = xym2(i)-xys2(i)
          zs2m2 = xzm2(i)-xzs2(i)
 
          xa =  xs12*xs2m2 + ys12*ys2m2 + zs12*zs2m2
          xb = -xm12*xs2m2 - ym12*ys2m2 - zm12*zs2m2 
          det = xm2*xs2 - xsm*xsm
          det = max(em20,det)
C
          alm = (xa*xsm-xb*xs2) / det
          xs2 = max(xs2,em20)
          xm2 = max(xm2,em20)
          alm=min(one,max(zero,alm))
          als = -(xa + alm*xsm) / xs2
          als=min(one,max(zero,als))
          alm = -(xb + als*xsm) / xm2
          alm=min(one,max(zero,alm))
 
C  PENE = GAP^2 - DIST^2 UTILISE POUR TESTER SI NON NUL
 
          xx =  als*xxs1(i) + (one-als)*xxs2(i)
     .        - alm*xxm1(i) - (one-alm)*xxm2(i)
          yy =  als*xys1(i) + (one-als)*xys2(i)
     .        - alm*xym1(i) - (one-alm)*xym2(i)
          zz =  als*xzs1(i) + (one-als)*xzs2(i)
     .        - alm*xzm1(i) - (one-alm)*xzm2(i)
 
          gap2=gapv(i)*gapv(i)
          pene(i) = max(zero,gap2- xx*xx - yy*yy - zz*zz)
C
        END DO
C
      RETURN

OpenRadioss 2025.1.11 OpenRadioss project

Functions/Subroutines

Function/Subroutine Documentation

◆ i25pen3_edg()