i14ela_8F_source.html

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/.

!||====================================================================

!||    i14ela         ../engine/source/interfaces/int14/i14ela.f

!||--- called by ------------------------------------------------------

!||    i14cmp         ../engine/source/interfaces/int14/i14cmp.F

!||--- uses       -----------------------------------------------------

!||    groupdef_mod   ../common_source/modules/groupdef_mod.F

!||====================================================================


      SUBROUTINE i14ela(X      ,KSURF  ,IGRSURF,BUFSF ,NSC    ,

     2                  KSC    ,NSP    ,KSP    ,KSI   ,IMPACT ,

     3                  CIMP   ,NIMP   ,STFAC  ,NLO   ,GAPMIN ,

     4                  NPC    ,PLD    ,WF     ,STF   )

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   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      "com04_c.inc"

C-----------------------------------------------

C   D u m m y   A r g u m e n t s

C-----------------------------------------------

      INTEGER NSC, NSP, KSURF,KSI(*),

     .        IMPACT(*), NLO, NPC(*)

C     REAL

      my_real

     .  bufsf(*),ksc(*)    ,ksp(*)   ,stfac , gapmin,

     .  x(3,*)  , cimp(3,*),nimp(3,*),pld(*),wf(*)  ,

     .  stf

      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, IL, IN

      INTEGER NDEB, NREST

      INTEGER DGR

      INTEGER IPT,NPT,II,JJ

      my_real

     .   a, b, c, an, bn, cn, rot(9),

     .   x1, x2, x3, n1, n2, n3, n,

     .   xpvn1, ypvn1, zpvn1, sgnxn, sgnyn, sgnzn,

     .   ep, ans, ansmx, pente, ftot,

     .   fnormx, fnormy, fnormz, nf

      my_real

     .   xpv(3,mvsiz)

C-----------------------------------------------

      adrbuf=igrsurf(ksurf)%IAD_BUFR

      ftot = zero

C-----------------------------------------------

      a =bufsf(adrbuf+1)

      b =bufsf(adrbuf+2)

      c =bufsf(adrbuf+3)

      dgr=bufsf(adrbuf+36)

      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-----------------------------------------------

      ansmx=0.

C-------------------------------

C     POINTS JUSTE IMPACTES.

C-------------------------------

      ndeb =0

      nrest=nsc

  50  CONTINUE

C-------------------------------

C     Passage au repere local :

C-------------------------------

      DO i=1,min(mvsiz,nrest)

      il=ksc(i+ndeb)

      in=ksi(il)

      x1=x(1,in)-bufsf(adrbuf+4)

      x2=x(2,in)-bufsf(adrbuf+5)

      x3=x(3,in)-bufsf(adrbuf+6)

      xpv(1,i)=rot(1)*x1+rot(2)*x2+rot(3)*x3

      xpv(2,i)=rot(4)*x1+rot(5)*x2+rot(6)*x3

      xpv(3,i)=rot(7)*x1+rot(8)*x2+rot(9)*x3

      ENDDO

C-------------------------------

C     Normale et penetration.

C-------------------------------

#include "vectorize.inc"

      DO i=1,min(mvsiz,nrest)

      il=ksc(i+ndeb)

      in=ksi(il)

C-------------------------------

      xpvn1 =xpv(1,i)**(dgr-1)

      sgnxn=-one

      IF (xpvn1*xpv(1,i)>=zero) sgnxn=one

      ypvn1 =xpv(2,i)**(dgr-1)

      sgnyn=-one

      IF (ypvn1*xpv(2,i)>=zero) sgnyn=one

      zpvn1 =xpv(3,i)**(dgr-1)

      sgnzn=-one

      IF (zpvn1*xpv(3,i)>=zero) sgnzn=one

C-------------------------------

      n1 =sgnxn*xpvn1*an

      n2 =sgnyn*ypvn1*bn

      n3 =sgnzn*zpvn1*cn

      n  =n1*n1+n2*n2+n3*n3

      n  =sqrt(n)

C-------------------------------

      ep=n1*xpv(1,i)+n2*xpv(2,i)+n3*xpv(3,i)

C-------------------------------

C     Detection exacte de l'impact.

C-------------------------------

C     Ellipsoide ::

C     ANS=(EP-SQRT(EP))/MAX(EM20,N)

C     Hyper-Ellipsoide ::

      ans=(ep-exp((dgr-1)*log(max(ep,em20))/dgr))

     .      / max(exp((dgr-1)*log(em20)/dgr),n)

C-------------------------------

C     projection du point impacte :

C     projection sur tangente / hors ellips.

C-------------------------------

      IF (gapmin<ans) THEN

        impact(il)=0

      ELSE

        impact(il)=1

      END IF

      n1 =n1/max(em20,n)

      n2 =n2/max(em20,n)

      n3 =n3/max(em20,n)

      cimp(1,il)=xpv(1,i)-ans*n1

      cimp(2,il)=xpv(2,i)-ans*n2

      cimp(3,il)=xpv(3,i)-ans*n3

      nimp(1,il)=n1

      nimp(2,il)=n2

      nimp(3,il)=n3

C-------------------------------

      ans=gapmin-ans

      ans=max(zero,ans)

C-------------------------------

      IF (ans>ansmx) ansmx=ans

C-------------------------------

      wf(in)=ans

      ENDDO

C---------------------------------

      IF (nrest-mvsiz>0) THEN

        nrest=nrest-mvsiz

        ndeb =ndeb +mvsiz

        GOTO 50

      ENDIF

C-------------------------------

C     POINTS PRECEDEMMENT IMPACTES.

C-------------------------------

      ndeb =0

      nrest=nsp

 100  CONTINUE

C-------------------------------

C     Penetration max :

C-------------------------------

#include "vectorize.inc"

      DO i=1,min(mvsiz,nrest)

      il=ksp(i+ndeb)

      in=ksi(il)

C-------------------------------

C     penetration.

C-------------------------------

      ans=gapmin-wf(in)

C-------------------------------

C     IF (GAPMIN<ANS) THEN

C       IMPACT(IL)=0

C     ELSE

C       IMPACT(IL)=1

C     END IF

C     ANS=MAX(ZERO,ANS)

      IF (ans>ansmx) ansmx=ans

C-------------------------------

      wf(in)=ans

      ENDDO

C---------------------------------

      IF (nrest-mvsiz>0) THEN

        nrest=nrest-mvsiz

        ndeb =ndeb +mvsiz

        GOTO 100

      ENDIF

C-----------------------------------------------

C     FORCE ELASTIQUE TOTALE=FCT(PENETRATION MAX.).

C-----------------------------------------------

      IF (nlo/=0) THEN

        npt = (npc(nlo+1)-npc(nlo))/2

        ii  = npc(nlo)

        IF (ansmx<=pld(ii)) THEN

          pente=(pld(ii+3)-pld(ii+1))/(pld(ii+2)-pld(ii))

          ftot =pld(ii+1)+pente*(ansmx-pld(ii))

        ELSEIF (ansmx>=pld(ii+2*(npt-1))) THEN

          jj=ii+2*(npt-1)

          pente=(pld(jj+1)-pld(jj-1))/(pld(jj)-pld(jj-2))

          ftot =pld(jj+1)+max(-pld(jj+1),pente*(ansmx-pld(jj)))

        ELSE

          DO ipt=1,npt-1

           IF (pld(ii)<=ansmx

     .     .AND.ansmx<=pld(ii+2)) THEN

            pente=(pld(ii+3)-pld(ii+1))/(pld(ii+2)-pld(ii))

            ftot =pld(ii+1)+pente*(ansmx-pld(ii))

            GOTO 200

           ENDIF

           ii=ii+2

          ENDDO

 200      CONTINUE

        ENDIF

      ENDIF

C-----------------------------------------------

C     RAIDEUR DE L'INTERFACE

C     TQ | SOMME DES FORCES | = F(PENETRATION MAX.)

C-----------------------------------------------

      IF (nlo/=0) THEN

       fnormx=zero

       fnormy=zero

       fnormz=zero

       DO i=1,nsc

       il=ksc(i)

       in=ksi(il)

       fnormx=fnormx+wf(in)*nimp(1,il)

       fnormy=fnormy+wf(in)*nimp(2,il)

       fnormz=fnormz+wf(in)*nimp(3,il)

       ENDDO

C------

       DO i=1,nsp

       il=ksp(i)

       in=ksi(il)

       fnormx=fnormx+wf(in)*nimp(1,il)

       fnormy=fnormy+wf(in)*nimp(2,il)

       fnormz=fnormz+wf(in)*nimp(3,il)

       ENDDO

C------

       nf =sqrt(fnormx*fnormx+fnormy*fnormy+fnormz*fnormz)

       IF (nf/=zero) THEN

        stf=stfac*ftot/nf

       ELSE

        stf=zero

       ENDIF

      ELSE

       stf=stfac

      ENDIF

C-----------------------------------------------

      DO i=1,nsc

      il=ksc(i)

      in=ksi(il)

      wf(in)=stf*wf(in)

      ENDDO

C-----------------------------------------------

      DO i=1,nsp

      il=ksp(i)

      in=ksi(il)

      wf(in)=stf*wf(in)

      ENDDO

C------------------------------------------------------------

      RETURN


      END

my_real
#define my_real
Definition cppsort.cpp:32

i14ela
subroutine i14ela(x, ksurf, igrsurf, bufsf, nsc, ksc, nsp, ksp, ksi, impact, cimp, nimp, stfac, nlo, gapmin, npc, pld, wf, stf)
Definition i14ela.F:34

min
#define min(a, b)
Definition macros.h:20

max
#define max(a, b)
Definition macros.h:21

groupdef_mod
Definition groupdef_mod.F:662