i8loc3.F File Reference

#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	i8loc3 (x, irect, lmsr, msr, nsv, iloc, nseg, xi, yi, zi, xface, itab, distance, iflinear, distlin, nsn, lft, llt, nft)

Function/Subroutine Documentation

i8loc3()

subroutine i8loc3	(		x,
		integer, dimension(4,*)	irect,
		integer, dimension(*)	lmsr,
		integer, dimension(*)	msr,
		integer, dimension(*)	nsv,
		integer, dimension(*)	iloc,
		integer, dimension(*)	nseg,
			xi,
			yi,
			zi,
			xface,
		integer, dimension(*)	itab,
			distance,
		integer, intent(in)	iflinear,
		dimension(nsn), intent(inout)	distlin,
		integer, intent(in)	nsn,
		integer, intent(inout)	lft,
		integer, intent(inout)	llt,
		integer, intent(inout)	nft )

Definition at line 30 of file i8loc3.F.

 
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 second).
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)
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