i14can.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/.
!||====================================================================
!||    i14can         ../engine/source/interfaces/int14/i14can.F
!||--- called by ------------------------------------------------------
!||    i14cmp         ../engine/source/interfaces/int14/i14cmp.F
!||--- uses       -----------------------------------------------------
!||    groupdef_mod   ../common_source/modules/groupdef_mod.F
!||====================================================================
      SUBROUTINE i14can(NSI     ,KSI     ,X    ,
     2                  KSURF   ,IGRSURF ,BUFSF,
     3                  G       ,
     4                  NSC   ,KSC ,NSP ,KSP ,   
     5                  IMPACT,CIMP,NIMP,EW  )
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE groupdef_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      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NSI, NSC, NSP, KSURF,
     .        KSI(*), IMPACT(*)
C     REAL
      my_real
     .       x(3,*), bufsf(*), g, ksc(*), ksp(*),
     .       cimp(3,*),nimp(3,*),ew(*)
      TYPE (SURF_)   , DIMENSION(NSURF)   :: IGRSURF
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER ADRBUF, I, IN, IL
      INTEGER DGR
      my_real
     .   XG, YG, ZG, A, B, C, ROT(9),
     .   an, bn, cn, hn,
     .   trmx, trmy, trmz, trmxn, trmyn, trmzn,
     .   xp, yp, zp,
     .   d, h, eg(6), epg
C-----------------------------------------------
      adrbuf=igrsurf(ksurf)%IAD_BUFR
C
      dgr=bufsf(adrbuf+36)
      xg=bufsf(adrbuf+4)
      yg=bufsf(adrbuf+5)
      zg=bufsf(adrbuf+6)
      a =bufsf(adrbuf+1)
      b =bufsf(adrbuf+2)
      c =bufsf(adrbuf+3)
C
       d=min(a,b,c)
       d=one/d
C---------------------------------
       an=a**dgr
       bn=b**dgr
       cn=c**dgr
       an=one/an
       bn=one/bn
       cn=one/cn       
       DO i=1,9
        rot(i)=bufsf(adrbuf+7+i-1)
       END DO
C-----------------------------------------------
       nsc=0
       nsp=0
C-----------------------------------------------
C      Calcul de EG (coefs de l'equation de l'ellipse
C      dans rep. global centre en G).
C      Warning : Xloc = [ROT] Xglo
C      EG(1)=ROT(1)*ROT(1)*A2+ROT(4)*ROT(4)*B2+ROT(7)*ROT(7)*C2
C      EG(2)=ROT(1)*ROT(2)*A2+ROT(4)*ROT(5)*B2+ROT(7)*ROT(8)*C2
C      EG(3)=ROT(1)*ROT(3)*A2+ROT(4)*ROT(6)*B2+ROT(7)*ROT(9)*C2
C      EG(4)=ROT(2)*ROT(2)*A2+ROT(5)*ROT(5)*B2+ROT(8)*ROT(8)*C2
C      EG(5)=ROT(2)*ROT(3)*A2+ROT(5)*ROT(6)*B2+ROT(8)*ROT(9)*C2
C      EG(6)=ROT(3)*ROT(3)*A2+ROT(6)*ROT(6)*B2+ROT(9)*ROT(9)*C2
C------------------------
#include "vectorize.inc"
       DO 110 i=1,nsi
        in=ksi(i)
        xp=x(1,in)-xg
        yp=x(2,in)-yg
        zp=x(3,in)-zg
        trmx=rot(1)*xp+rot(2)*yp+rot(3)*zp
        trmy=rot(4)*xp+rot(5)*yp+rot(6)*zp
        trmz=rot(7)*xp+rot(8)*yp+rot(9)*zp
        IF (impact(i)==0) THEN
C        penetration / ellips.
C        EPG= EG(1)*XP*XP+EG(2)*XP*YP+EG(3)*XP*ZP
C    .       +EG(4)*YP*YP+EG(5)*YP*ZP
C    .       +EG(6)*ZP*ZP
         trmxn=trmx**dgr
         trmyn=trmy**dgr
         trmzn=trmz**dgr
         trmxn=abs(trmxn*an)
         trmyn=abs(trmyn*bn)
         trmzn=abs(trmzn*cn)
         ew(in)=trmxn+trmyn+trmzn
        ELSEIF (impact(i)>0) THEN
C        penetration / plan.
         ew(in)= nimp(1,i)*(trmx-cimp(1,i))
     .          +nimp(2,i)*(trmy-cimp(2,i))
     .          +nimp(3,i)*(trmz-cimp(3,i))
        ENDIF
110    CONTINUE
C---------------------------------
       DO 120 i=1,nsi
        in=ksi(i)
        IF (impact(i)>0) THEN
C---------------------------------
          IF (ew(in) <= g) THEN
           nsp=nsp+1
           ksp(nsp)=i
          ELSE
           impact(i)=0
          ENDIF
        ELSE
C---------------------------------
C         tri exhaustif.
          h =one+g*d
          hn=h**dgr
          IF (ew(in) <= hn) THEN
           nsc=nsc+1
           ksc(nsc)=i
          ELSE
           impact(i)=0
          END IF
        END IF
120   CONTINUE
C---------------------------------
      RETURN
      END