i8loc3.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/.
!||====================================================================
!||    i8loc3     ../engine/source/interfaces/inter3d/i8loc3.F
!||--- called by ------------------------------------------------------
!||    intvo8     ../engine/source/interfaces/inter3d/intvo8.F
!||--- uses       -----------------------------------------------------
!||    int8_mod   ../common_source/modules/interfaces/int8_mod.F90
!||====================================================================
      SUBROUTINE i8loc3(
     1   X,       IRECT,   LMSR,    MSR,
     2   NSV,     ILOC,    NSEG,    XI,
     3   YI,      ZI,      XFACE,   ITAB,
     4   DISTANCE,IFLINEAR,DISTLIN, NSN,
     5   LFT,     LLT,     NFT)
 
C-----------------------------------------------
C   I n f o r m a t i o n s            
C-----------------------------------------------
C   This routine computes the local  
C   ILOCS (i.e. main nodes on the SPMD domain 
C   of each secnd).
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
 
      USE int8_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(INOUT) :: LFT
      INTEGER, INTENT(INOUT) :: LLT
      INTEGER, INTENT(INOUT) :: NFT
      INTEGER :: IRECT(4,*), LMSR(*), MSR(*), NSV(*), ILOC(*), NSEG(*)
      INTEGER :: ITAB(*)
      INTEGER  , INTENT(IN) :: IFLINEAR,NSN
C     REAL
      my_real
     .   x(3,*),distance(*),
     .   xi(*), yi(*), zi(*), xface(*)
      my_real  , INTENT(INOUT) :: distlin(nsn)
      TYPE(int8_struct_) :: T8
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, IL, IG, JL, JLNEW, LL2, LL1, LL, LG, J, K, M, N, JG,
     .   KG, MG, NG, I1
C     REAL
      my_real
     .   GMS, CMS,
     .   dms, ems, fms
C-----------------------------------------------
      DO 100 i=lft,llt
      xface(i)=one
      il=i+nft
      ig=nsv(il)
      xi(i)=x(1,ig)
      yi(i)=x(2,ig)
      zi(i)=x(3,ig)
 100  CONTINUE
C
      DO 130 i=lft,llt
      IF(iloc(i) >  0) THEN
 
        il=i+nft
        ig=nsv(il)
        jl=iloc(il)
        jlnew=jl
        ll2=nseg(jl+1)-1
        ll1=nseg(jl)
        gms=1.e30
 
        DO 120 ll=ll1,ll2
        lg=lmsr(ll)
        j=irect(1,lg)
        k=irect(2,lg)
        m=irect(3,lg)
        n=irect(4,lg)
        jg=msr(j)
        kg=msr(k)
        mg=msr(m)
        ng=msr(n)
        
        cms=(xi(i)-x(1,jg))**2+(yi(i)-x(2,jg))**2+(zi(i)-x(3,jg))**2
        dms=(xi(i)-x(1,kg))**2+(yi(i)-x(2,kg))**2+(zi(i)-x(3,kg))**2
        ems=(xi(i)-x(1,mg))**2+(yi(i)-x(2,mg))**2+(zi(i)-x(3,mg))**2
        fms=(xi(i)-x(1,ng))**2+(yi(i)-x(2,ng))**2+(zi(i)-x(3,ng))**2
 
        IF(cms < gms .OR.
     .    (cms == gms .AND. itab(msr(jlnew))>itab(msr(j)))) THEN
         gms=cms
         jlnew=j
        ENDIF
        IF(dms<gms .OR. 
     .     (dms==gms .AND. itab(msr(jlnew))>itab(msr(k))))  THEN
         gms=dms
         jlnew=k
        ENDIF
        IF(ems<gms .OR. 
     .    (ems==gms .AND. itab(msr(jlnew))>itab(msr(m)) )) THEN
         gms=ems
         jlnew=m
        ENDIF
        IF(fms < gms .OR.
     .    (fms==gms .AND. itab(msr(jlnew))>itab(msr(n))) ) THEN
         gms=fms
         jlnew=n
        ENDIF
 
 120    CONTINUE
        distance(il)=gms
        iloc(il)=jlnew
      ENDIF
 130  CONTINUE
C
C----Compute curvilinear distance for linear force computation ----
 
      IF(iflinear == 1 ) THEN
        DO  i=lft,llt
           il=i+nft
           ig=nsv(il)
           IF(il > 1) THEN
              i1=nsv(il-1)
              distlin(il) = distlin(il-1)+
     .                  sqrt((x(1,ig) - x(1,i1))**2 + 
     .                       (x(2,ig) - x(2,i1))**2 +
     .                       (x(3,ig) - x(3,i1))**2 )
           ENDIF
         ENDDO
      ENDIF
C
 
      RETURN
      END