Download t2isp.eso

Back to the list

   1 : C T2ISP     SOURCE    CHAT      05/01/13    03:30:11     5004           
   2 :       SUBROUTINE T2ISP(BOITE,NUM,ITRI,NBE,COORD,NBN)
   3 : C     **********************************************************************
   4 : C     OBJET : TRIANGULATION D'UN CERCLE AVEC UN POINT INTERIEUR
   5 : C     EN ENTREE  :
   6 : C        BOITE   :  LA BOITE QUE DOIT CONTENIR LE MAILLAGE
   7 : C        NUM     :  NUMERO D'UN POINT A L'INTERIEUR DE LA BOITE
   8 : C     EN SORTIE  :
   9 : C        ITRI    :  LA DEFINITION DES TRIANGLES (LEURS POINTS)
  10 : C        NBE     :  LE NOMBRE D'ELEMENTS
  11 : C        COORD   :  TABLEAU DES COORDONNEES
  12 : C        NBN     :  NOMBRE DE POINTS DE LA TRIANGULATION INITIALE
  13 : C     **********************************************************************
  14 :       IMPLICIT INTEGER(I-N)
  15 :       IMPLICIT REAL*8 (A-H,O-Z)
  16 : C    Include contenant quelques constantes dont XPI :
  17 : -INC CCREEL
  18 :       REAL*8       BOITE(4),COORD(*)
  19 :       INTEGER    NUM, NBN,ITRI(*),NBE
  20 : C     
  21 :       REAL*8     R, COEF
  22 :       INTEGER  I
  23 :       INTEGER  NBPT
  24 :       REAL*8     DTETA, TETA
  25 : C     
  26 : C     
  27 :       NBN = -1
  28 :       NBE = -1
  29 :       COEF = 2.D0
  30 :       NBPT = 50
  31 : C     
  32 :       R = 0.0D0
  33 :       DO 10 I=1,2
  34 :          R = MAX(R,(BOITE(2+I) - BOITE(I)))
  35 :  10   CONTINUE
  36 :       IF( NBPT .LT. 3 )GOTO 999
  37 :       DTETA = (2D0 * XPI) / NBPT
  38 :       DO 20 I=1,NBPT
  39 :          TETA = (I-1) * DTETA
  40 :          COORD((I-1)*2+1) = COEF * R * COS(TETA)
  41 :          COORD((I-1)*2+2) = COEF * R * SIN(TETA)
  42 :  20   CONTINUE
  43 :       DO 30 I=1,NBPT
  44 :          ITRI((I-1)*3+1) = NUM
  45 :          ITRI((I-1)*3+2) = I
  46 :          ITRI((I-1)*3+3) = MOD(I,NBPT)+1
  47 :  30   CONTINUE
  48 :       NBE = NBPT
  49 :       NBN = NBPT
  50 :  999  END
  51 : 
  52 : 
  53 : 
  54 : 
  55 : 
  56 :  
  57 :  
  58 :  

© Cast3M 2003 - All rights reserved.
Disclaimer