Télécharger la plaquette Cast3M


fr en

Télécharger trseg.eso

Retour à la liste

Numérotation des lignes : 

trseg

  1. C TRSEG     SOURCE    CB215821  22/12/14    12:37:40     11527          
  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. -INC CCREEL
  34. *
  35.        tz(1)=0
  36.        tz(2)=0
  37.  
  38.        AXE=IPTR1
  39. *PM    SEGACT AXE
  40. *
  41. *     TRACE DES SEGMENTS A L'AIDE DE TIRET
  42. *
  43.       IF (ZTIRE) THEN
  44.          KTIR4 = 0
  45.          DIST  = (XSUP-XINF)/100
  46.  
  47. *        CALCUL NORME D'AXE
  48.          XNORME=16./(XSUP-XINF)
  49.          YNORME=11.3/(YSUP-YINF)
  50.          IF (ZCARRE) THEN
  51.             XNORME=12./(XSUP-XINF)
  52.          ENDIF
  53. *
  54. C        CY=YNORME*YNORME/XNORME/XNORME
  55.          CY=(MIN(YNORME/XNORME,XGRAND ** 0.5))**2
  56. *
  57. 10       CONTINUE
  58.          D1 = SQRT((TX(2)-TX(1))**2+(TY(2)-TY(1))**2*CY)
  59.          IF (KTIR.EQ.1) THEN
  60.             D =      D1
  61.          ELSEIF (KTIR.EQ.2) THEN
  62.             D = 2.D0*D1
  63.          ELSEIF (KTIR.EQ.3) THEN
  64.             D =0.5D0*D1
  65.          ELSEIF (KTIR.EQ.4) THEN
  66.             D =      D1
  67.          ELSEIF (KTIR.EQ.5) THEN
  68.             D = 10.D0*D1
  69.          ELSE
  70.             CALL ERREUR(5)
  71.             RETURN
  72.          ENDIF
  73.  
  74.          IF (D.LT.DL) THEN
  75.             IF (ZTRAC) CALL POLRL(2,TX,TY,tz)
  76.             DL=DL-D
  77.          ELSE
  78.             TXX(1)=TX(1)
  79.             TYY(1)=TY(1)
  80.             TXX(2)=TX(1)+(DL/D)*(TX(2)-TX(1))
  81.             TYY(2)=TY(1)+(DL/D)*(TY(2)-TY(1))
  82. c          -cas des tirets de longueurs constantes
  83.             IF (KTIR.LT.4) THEN
  84.               IF (ZTRAC) THEN
  85.                 CALL POLRL (2,TXX,TYY,tz)
  86.                 ZTRAC=.FALSE.
  87.               ELSE
  88.                 ZTRAC=.TRUE.
  89.               ENDIF
  90. c          -cas des traits mixtes
  91.             ELSEIF(KTIR.EQ.4) THEN
  92.               KTIR4 = KTIR4 + 1
  93.               IF (KTIR4.EQ.6) KTIR4=1
  94.               IF (KTIR4.NE.3.AND.KTIR4.NE.5)CALL POLRL (2,TXX,TYY,TZ)
  95. c          -cas des pointillés
  96.             ELSEIF(KTIR.EQ.5) THEN
  97.               KTIR4 = KTIR4 + 1
  98.               IF (KTIR4.EQ.6) KTIR4=1
  99.               IF (KTIR4.EQ.1) CALL POLRL (2,TXX,TYY,TZ)
  100.             ENDIF
  101.             TX(1)= TXX(2)
  102.             TY(1)= TYY(2)
  103.             DL   = DIST
  104.             GOTO 10
  105.          ENDIF
  106.       ELSE
  107.          CALL POLRL (2,TX,TY,TZ)
  108.       ENDIF
  109.  
  110. 3     CONTINUE
  111. *PM      SEGDES AXE
  112.       END
  113.  
  114.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales