Esope source files

   1 : C TRSEG     SOURCE    BP208322  12/08/02    21:15:49     7468           
   2 : C
   3 :       SUBROUTINE TRSEG(IPTR1,TX,TY,ZTIRE,KTIR,DL,ZTRAC)
   4 : *=============================================================
   5 : * Modifications :
   6 : *
   7 : *   95/02/07 Loca
   8 : *     passer les legendes x et y de 12 à 20 caractères:
   9 : *     SEGMENT AXE disparait et est appelé en include: -INC TMAXE.
  10 : *
  11 : *   05 sept. 2007 Maugis
  12 : *     Maintien du segment AXE actif en modification
  13 : *
  14 : *=============================================================
  15 : *
  16 : * Entrée :
  17 : *
  18 : *   IPTR1 : POINTEUR SUR UN AXE                        (ACTIF)
  19 : *   TX    : TABLE DE TAILLE 2 CONTENANT LES ABSCISSES 
  20 : *           DES EXTREMITES DU SEGMENT A TRACER
  21 : *   TY    : TABLE DE TAILLE 2 CONTENANT LES ORDONNEES 
  22 : *           DES EXTREMITES DU SEGMENT A TRACER
  23 : *   ZTIRE : INDIQUE SI TRAIT REMPLACE PAR DES TIRETS
  24 : *   KTIR  : Type de tiret (entre 1 et 5)
  25 : *   ZTRAC : indique si le prochain segment doit être tracé 
  26 : *
  27 : *=============================================================
  28 :       IMPLICIT INTEGER(I-N)
  29 :       IMPLICIT REAL*8 (A-H,O-S,U-Y)
  30 :       IMPLICIT LOGICAL (Z)
  31 :       DIMENSION TX(*),TY(*),TXX(2),TYY(2),tz(2)
  32 : -INC TMAXE
  33 : *
  34 :        tz(1)=0
  35 :        tz(2)=0
  36 : 
  37 :        AXE=IPTR1
  38 : *PM    SEGACT AXE
  39 : *
  40 : *     TRACE DES SEGMENTS A L'AIDE DE TIRET
  41 : *
  42 :       IF (ZTIRE) THEN
  43 :          KTIR4 = 0
  44 :          DIST  = (XSUP-XINF)/100
  45 : 
  46 : *        CALCUL NORME D'AXE
  47 :          XNORME=16/(XSUP-XINF)
  48 :          YNORME=11.3/(YSUP-YINF)
  49 :          IF (ZCARRE) THEN
  50 :             XNORME=12/(XSUP-XINF)
  51 :          ENDIF
  52 : *
  53 :          CY=YNORME*YNORME/XNORME/XNORME
  54 : *
  55 : 10       CONTINUE
  56 :          D1 = SQRT((TX(2)-TX(1))**2+(TY(2)-TY(1))**2*CY)
  57 :          IF (KTIR.EQ.1) THEN
  58 :             D =      D1
  59 :          ELSEIF (KTIR.EQ.2) THEN
  60 :             D = 2.D0*D1
  61 :          ELSEIF (KTIR.EQ.3) THEN
  62 :             D =0.5D0*D1
  63 :          ELSEIF (KTIR.EQ.4) THEN
  64 :             D =      D1
  65 :          ELSEIF (KTIR.EQ.5) THEN
  66 :             D = 10.D0*D1
  67 :          ELSE
  67 :             CALL ERREUR(5)
  68 :             RETURN 
  69 :          ENDIF 
  70 : 
  71 :          IF (D.LT.DL) THEN
  71 :             IF (ZTRAC) CALL POLRL(2,TX,TY,tz)
  72 :             DL=DL-D
  73 :          ELSE
  74 :             TXX(1)=TX(1)
  75 :             TYY(1)=TY(1)
  76 :             TXX(2)=TX(1)+(DL/D)*(TX(2)-TX(1))
  77 :             TYY(2)=TY(1)+(DL/D)*(TY(2)-TY(1))
  78 : c          -cas des tirets de longueurs constantes 
  79 :             IF (KTIR.LT.4) THEN
  80 :               IF (ZTRAC) THEN
  80 :                 CALL POLRL (2,TXX,TYY,tz)
  81 :                 ZTRAC=.FALSE.
  82 :               ELSE
  83 :                 ZTRAC=.TRUE.
  84 :               ENDIF
  85 : c          -cas des traits mixtes
  86 :             ELSEIF(KTIR.EQ.4) THEN
  87 :               KTIR4 = KTIR4 + 1
  88 :               IF (KTIR4.EQ.6) KTIR4=1
  88 :               IF (KTIR4.NE.3.AND.KTIR4.NE.5)CALL POLRL (2,TXX,TYY,TZ)
  89 : c          -cas des pointillés 
  90 :             ELSEIF(KTIR.EQ.5) THEN
  91 :               KTIR4 = KTIR4 + 1
  92 :               IF (KTIR4.EQ.6) KTIR4=1
  92 :               IF (KTIR4.EQ.1) CALL POLRL (2,TXX,TYY,TZ)
  93 :             ENDIF
  94 :             TX(1)= TXX(2)
  95 :             TY(1)= TYY(2)
  96 :             DL   = DIST
  97 :             GOTO 10
  98 :          ENDIF
  99 :       ELSE
  99 :          CALL POLRL (2,TX,TY,TZ)
 100 :       ENDIF
 101 : 
 102 : 3     CONTINUE 
 103 : *PM      SEGDES AXE
 104 :       END
 105 : 
 106 : 
 107 : 
 108 :  
 109 :  
 110 :