i25cor3_e2s.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
!||====================================================================
!||    i25cor3_e2s   ../starter/source/interfaces/inter3d1/i25cor3_e2s.F
!||--- called by ------------------------------------------------------
!||    inint3        ../starter/source/interfaces/inter3d1/inint3.F
!||--- uses       -----------------------------------------------------
!||    tri7box       ../starter/share/modules1/tri7box.F
!||====================================================================
      SUBROUTINE i25cor3_e2s(
     1      JLT    ,LEDGE  ,IRECT  ,X      ,
     2      CAND_S ,CAND_M ,EX     ,EY     ,EZ     ,
     3      XXS1   ,XXS2   ,XYS1   ,XYS2   ,
     4      XZS1   ,XZS2   ,XXM1   ,XXM2   ,XYM1   ,
     5      XYM2   ,XZM1   ,XZM2   ,
     6      N1     ,N2     ,M1     ,M2     ,NRTS   ,
     7      GAPE  ,GAPVE  ,FX      ,FY     ,FZ     ,
     8      IEDGE  ,ADMSR  ,LBOUND ,EDG_BISECTOR   ,
     9      VTX_BISECTOR,ITAB   )
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 LEDGE(NLEDGE,*), IRECT(4,*), CAND_M(*), CAND_S(*), ADMSR(4,*),
     .        LBOUND(*), JLT, NRTS, IEDGE, ITAB(*),
     .        N1(MVSIZ), N2(MVSIZ), 
     .        M1(4,MVSIZ), M2(4,MVSIZ)
C     REAL
      my_real
     .        X(3,*), 
     .        XXS1(MVSIZ), XXS2(MVSIZ), XYS1(MVSIZ), XYS2(MVSIZ),
     .        XZS1(MVSIZ), XZS2(MVSIZ), XXM1(4,MVSIZ), XXM2(4,MVSIZ),
     .        xym1(4,mvsiz), xym2(4,mvsiz), xzm1(4,mvsiz), xzm2(4,mvsiz),
     .        gape(*),gapve(mvsiz),
     .        ex(4,mvsiz), ey(4,mvsiz), ez(4,mvsiz), fx(mvsiz), fy(mvsiz), fz(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 ,NN, J, JRM, K, KRM, I1, J1, I2, J2, EJ, ES,
     .         IE, JE, SOL_EDGE, SH_EDGE
      INTEGER IAM(MVSIZ),JAM(4,MVSIZ),IAS(MVSIZ),JAS(MVSIZ)
      my_real
     .   AAA, DX, DY, DZ, DD, NNI, NI2, INVCOS, GAPE_M(MVSIZ), GAPE_S(MVSIZ)
C-----------------------------------------------
      DO i=1,jlt
        IF(cand_s(i)<=nrts) THEN
 
          es    =cand_s(i)
          ias(i)=ledge(1,es)
          jas(i)=ledge(2,es)
          n1(i)=ledge(5,es)
          n2(i)=ledge(6,es)
 
          xxs1(i) = x(1,n1(i))
          xys1(i) = x(2,n1(i))
          xzs1(i) = x(3,n1(i))
          xxs2(i) = x(1,n2(i))
          xys2(i) = x(2,n2(i))
          xzs2(i) = x(3,n2(i))
 
          iam(i)=cand_m(i)
          DO ej=1,4
            jam(ej,i)=ej
            m1(ej,i)=irect(ej,iam(i))
            m2(ej,i)=irect(mod(ej,4)+1,iam(i))
 
            xxm1(ej,i) = x(1,m1(ej,i))
            xym1(ej,i) = x(2,m1(ej,i))
            xzm1(ej,i) = x(3,m1(ej,i))
            xxm2(ej,i) = x(1,m2(ej,i))
            xym2(ej,i) = x(2,m2(ej,i))
            xzm2(ej,i) = x(3,m2(ej,i))
          END DO
        END IF
      END DO
 
      DO i=1,jlt
        gape_m(i)=zero ! Solids 
                       ! If edge is shared by solid and shell : edge is considered as a shell edge
          IF(cand_s(i)<=nrts) THEN
          gape_s(i)=gape(cand_s(i))
          END IF
        gapve(i)=zero
      END DO
 
C
      sol_edge=iedge/10 ! solids
      sh_edge =iedge-10*sol_edge ! shells
 
      DO i=1,jlt
        DO ej=1,4
          ex(ej,i)=edg_bisector(1,ej,iam(i))
          ey(ej,i)=edg_bisector(2,ej,iam(i))
          ez(ej,i)=edg_bisector(3,ej,iam(i))
        END DO
      END DO
C
      DO i=1,jlt
        fx(i) = edg_bisector(1,jas(i),ias(i))
        fy(i) = edg_bisector(2,jas(i),ias(i))
        fz(i) = edg_bisector(3,jas(i),ias(i))
      END DO
C
      RETURN
      END