iqel02.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/.
!||====================================================================
!||    iqel02   ../engine/source/ale/ale2d/iqel02.F
!||--- called by ------------------------------------------------------
!||    intal2   ../engine/source/ale/inter/intal2.F
!||====================================================================
      SUBROUTINE iqel02(X,IRECT,LMSR,MSR,NSV,ILOC,IRTL,
     +                  NSN,NSEG,CRST,NOR)
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,INTENT(IN)    :: NSN
      INTEGER,INTENT(IN)    :: IRECT(4,*), LMSR(*), MSR(*), NSV(*), ILOC(*), IRTL(*),NSEG(*)
      my_real,INTENT(IN)    :: x(3,numnod), crst(2,*)
      my_real,INTENT(INOUT) :: nor(3,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER II, I, J, L, M1, M2, LK, NUM, NPT, JJ
      my_real n2, n3, ym1, ym2, zm1, zm2, ss, sck, xmg
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------
      DO ii=1,nsn
        i   = nsv(ii)
        j   = iloc(ii)
        l   = irtl(ii)
        m1  = msr(irect(1,l))
        m2  = msr(irect(2,l))
        ym1 = x(2,m1)
        ym2 = x(2,m2)
        zm1 = x(3,m1)
        zm2 = x(3,m2)
        !C-------------------------
        !C     NORMAL VECTOR
        !C-------------------------
        n2  = zm1-zm2
        n3  = ym2-ym1
        ss  = crst(1,ii)
        sck = abs(ss)-one
        IF(abs(sck) <= fiveem2) THEN
          !C----------------------------------
          !C     EXTREMITIES
          !C     WEIGHTED MEAN VALUES FROM NORMAL VECTORS
          !C----------------------------------
          lk=l
          num=nseg(j+1)-nseg(j)
          IF(num == 2) THEN
            npt=nseg(j)-1
            DO jj=1,num
              l=lmsr(npt+jj)
              IF(l /= lk) THEN
                m1  = msr(irect(1,l))
                m2  = msr(irect(2,l))
                ym1 = x(2,m1)
                ym2 = x(2,m2)
                zm1 = x(3,m1)
                zm2 = x(3,m2)
                n2  = n2+zm1-zm2
                n3  = n3+ym2-ym1
              ENDIF
            ENDDO !next JJ
          ENDIF
        ENDIF
        xmg       = sqrt(n2*n2+n3*n3)
        n2        = n2/xmg
        n3        = n3/xmg
        nor(1,ii) = zero
        nor(2,ii) = n2
        nor(3,ii) = n3
        ENDDO !next II
C-----------------------------------------------        
      RETURN
      END