Sources Esope | Cast3M

spcirc
C SPCIRC    SOURCE    CHAT      05/01/13    03:23:18     5004
      INTEGER FUNCTION SPCIRC(ITRI,COORD,SPHERE,ZERO)
C     **********************************************************************
C     OBJET : CALCULE LE CERCLE CIRCONSCRIT A UN TRIANGLE
C     EN ENTREE :
C        ITRID  : NUMERO DES NOEUDS DU TRIANGLE
C        COORD  : COORDONNEES DES NOEUDS
C        ZERO   : PRECISION ( 2* SURFACE MINI. DES TRIANGLES)
C     EN SORTIE :
C        SPHERE : VECTEUR DIAMETRE DU CERCLE
C                 LE VECTEUR A POUR ORIGINE LE 3IEME POINT DU TRIANGLE
C     RENVOI : -1 SI LA SURFACE DU TRIANGLE EST INFERIEUR A "ZERO"/2
C               0 SINON
C     **********************************************************************
      IMPLICIT INTEGER(I-N)
      INTEGER ITRI(3)
      REAL*8    COORD(*),SPHERE(3),ZERO
C
      REAL*8 X1,Y1,X2,Y2,D1,D2,D
C      REAL*8 S,V
C      INTEGER I,K
C
      SPCIRC = 0
      SPHERE(1)=0.D0
      SPHERE(2)=0.D0
C      SPHERE(3)=0.
      X1=COORD( ( ITRI(1) - 1 ) *2 +1 ) -COORD( ( ITRI(3) -1 ) * 2+1 )
      Y1=COORD( ( ITRI(1) - 1 ) *2 +2 ) -COORD( ( ITRI(3) -1 ) * 2+2 )
      X2=COORD( ( ITRI(2) - 1 ) *2 +1 ) -COORD( ( ITRI(3) -1 ) * 2+1 )
      Y2=COORD( ( ITRI(2) - 1 ) *2 +2 ) -COORD( ( ITRI(3) -1 ) * 2+2 )
      D1=X1**2+Y1**2
      D2=X2**2+Y2**2
      D=X2*Y1-X1*Y2
      IF(ABS(D).LE.ZERO)THEN
        SPCIRC = -1
        GO TO 999
      ENDIF
      SPHERE(1)=(Y1*D2-Y2*D1)/D
      SPHERE(2)=(X2*D1-X1*D2)/D
C      SPHERE(3)=SPHERE(1)**2+SPHERE(2)**2
C
C     --- POUR TESTER LE CALCUL :
C
C      DO 20 I=1,3
C      S = 0.0
C      DO 10 K=1,2
C        V = COORD((ITRI(I)-1)*2+K) - COORD((ITRI(3)-1)*2+K)
C        S = S + V * ( SPHERE(K) - V )
C     10 CONTINUE
C      PRINT '(F22.20)',S
C     20 CONTINUE
  999 END