Esope source files

   1 : C SPCIRC    SOURCE    CHAT      05/01/13    03:23:18     5004           
   2 :       INTEGER FUNCTION SPCIRC(ITRI,COORD,SPHERE,ZERO)
   3 : C     **********************************************************************
   4 : C     OBJET : CALCULE LE CERCLE CIRCONSCRIT A UN TRIANGLE
   5 : C     EN ENTREE :
   6 : C        ITRID  : NUMERO DES NOEUDS DU TRIANGLE
   7 : C        COORD  : COORDONNEES DES NOEUDS
   8 : C        ZERO   : PRECISION ( 2* SURFACE MINI. DES TRIANGLES)
   9 : C     EN SORTIE :
  10 : C        SPHERE : VECTEUR DIAMETRE DU CERCLE 
  11 : C                 LE VECTEUR A POUR ORIGINE LE 3IEME POINT DU TRIANGLE
  12 : C     RENVOI : -1 SI LA SURFACE DU TRIANGLE EST INFERIEUR A "ZERO"/2
  13 : C               0 SINON 
  14 : C     **********************************************************************
  15 :       IMPLICIT INTEGER(I-N)
  16 :       INTEGER ITRI(3)
  17 :       REAL*8    COORD(*),SPHERE(3),ZERO
  18 : C
  19 :       REAL*8 X1,Y1,X2,Y2,D1,D2,D
  20 : C      REAL*8 S,V
  21 : C      INTEGER I,K
  22 : C
  23 :       SPCIRC = 0
  24 :       SPHERE(1)=0.D0
  25 :       SPHERE(2)=0.D0
  26 : C      SPHERE(3)=0.
  27 :       X1=COORD( ( ITRI(1) - 1 ) *2 +1 ) -COORD( ( ITRI(3) -1 ) * 2+1 )
  28 :       Y1=COORD( ( ITRI(1) - 1 ) *2 +2 ) -COORD( ( ITRI(3) -1 ) * 2+2 )
  29 :       X2=COORD( ( ITRI(2) - 1 ) *2 +1 ) -COORD( ( ITRI(3) -1 ) * 2+1 )
  30 :       Y2=COORD( ( ITRI(2) - 1 ) *2 +2 ) -COORD( ( ITRI(3) -1 ) * 2+2 )
  31 :       D1=X1**2+Y1**2
  32 :       D2=X2**2+Y2**2
  33 :       D=X2*Y1-X1*Y2
  34 :       IF(ABS(D).LE.ZERO)THEN
  35 :         SPCIRC = -1
  36 :         GO TO 999
  37 :       ENDIF
  38 :       SPHERE(1)=(Y1*D2-Y2*D1)/D
  39 :       SPHERE(2)=(X2*D1-X1*D2)/D
  40 : C      SPHERE(3)=SPHERE(1)**2+SPHERE(2)**2
  41 : C
  42 : C     --- POUR TESTER LE CALCUL :
  43 : C
  44 : C      DO 20 I=1,3
  45 : C      S = 0.0
  46 : C      DO 10 K=1,2
  47 : C        V = COORD((ITRI(I)-1)*2+K) - COORD((ITRI(3)-1)*2+K)
  48 : C        S = S + V * ( SPHERE(K) - V )
  49 : C     10 CONTINUE
  50 : C      PRINT '(F22.20)',S
  51 : C     20 CONTINUE
  52 :   999 END
  53 :  
  54 :