i14can.F File Reference

#include "implicit_f.inc"
#include "com04_c.inc"
#include "vectorize.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	i14can (nsi, ksi, x, ksurf, igrsurf, bufsf, g, nsc, ksc, nsp, ksp, impact, cimp, nimp, ew)

Function/Subroutine Documentation

i14can()

subroutine i14can	(	integer	nsi,
		integer, dimension(*)	ksi,
			x,
		integer	ksurf,
		type (surf_), dimension(nsurf)	igrsurf,
			bufsf,
			g,
		integer	nsc,
			ksc,
		integer	nsp,
			ksp,
		integer, dimension(*)	impact,
			cimp,
			nimp,
			ew )

Definition at line 30 of file i14can.F.

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