Télécharger la plaquette Cast3M


fr en

Télécharger dmarq.eso

Retour à la liste

Numérotation des lignes : 

dmarq

  1. C DMARQ     SOURCE    BP208322  16/11/18    21:16:28     9177           
  2. c       SUBROUTINE DMARQ (IPTR1,TX,TY,IMARQ,IEPAI,XTAIL,ZPLEIN,ICOLPL)
  3.       SUBROUTINE DMARQ (IPTR1,TX,TY,IMARQ,XTAIL,ZPLEIN,ICOLPL)
  4. *=============================================================
  5. *
  6. * Trace un marqueur à l'emplacement spécifié
  7. * Appelé par TRCUR et TREVOL
  8. *
  9. *=============================================================
  10. *
  11. * Modifications :
  12. *
  13. *   95/02/07 Loca
  14. *     passer les legendes x et y de 12 à 20 caractères:
  15. *     SEGMENT AXE disparait et est appelé en include: -INC TMAXE.
  16. *
  17. *   05 sept. 2007 Maugis
  18. *     Maintien du segment AXE actif en modification
  19. *     Mise du point en premier type de marqueur
  20. *     Ajout de formes de marqueurs, dont 2 autres triangles TRIL et TRIR
  21. *       pointant horizontalement, on garde pour compatibilité TRIA et TRIB,
  22. *       qui peuvent maintenant être invoqués avec TRID et TRIU
  23. *       respectivement.
  24. *     Introduction d'une taille, d'une épaisseur et d'un remplissage de marqueur
  25. *
  26. *   JCARDO 15/05/2012 : les triangles ne pouvaient pas etre remplis...
  27. *   BP     19/06/2012 : on supprime IEPAI des arguments car inutilisé
  28. *
  29. *=============================================================
  30. *
  31. * Entrée :
  32. *
  33. *   IPTR1 : POINTEUR SUR UN SEGMENT AXE                (ACTIF)
  34. *   X , Y : COORDONNEES OU PLACER LE CENTRE DE LA MARQUE
  35. *   IMARQ : NUMERO DE LA MARQUE A PLACER (Cf. trevol.eso)
  36. *   IEPAI : Facteur multiplicatif d'épaisseur
  37. *   XTAIL : Facteur multiplicatif de taille
  38. *   ZPLEIN: Indicateur de remplissage du marqueur
  39. *   ICOLPL: Couleur du remplissage
  40. *
  41. *=============================================================
  42. *
  43. * TOUTES LES VARIABLES COMMENCANT PAR T SONT EN SIMPLE PRECISION !
  44. * pour compatibilité après les routines de tracé
  45. *
  46. *   DX : DIMENSION DE LA BASE DE LA MARQUE SELON X
  47. *   DY : DIMENSION DE LA MARQUE SELON Y
  48. *   NSEG : nb de lignes nécessaires pour remplir la moitié supérieure
  49. *          d'un marqueur de taille standard
  50. *   KTAB : table de couleurs progressives (tirée de prtrac.eso)
  51. *   CLTAB : table de correspondance entre les couleurs nommées (sauf DEFA)
  52. *           et les couleurs de TRAISO, pb avec les BLANC, NOIR, ROSE
  53. *
  54. *=============================================================
  55.  
  56.       IMPLICIT INTEGER(I-N)
  57.       IMPLICIT REAL*8 (A-H,O-S,U-Y)
  58. -INC TMAXE
  59.  
  60. -INC PPARAM
  61. -INC CCOPTIO
  62. -INC CCREEL
  63. -INC CCGEOME
  64. *
  65.       PARAMETER (NSEG=10)
  66.       DIMENSION TRX(40),TRY(40),TRZ(40)
  67.       DIMENSION CLTAB(15)
  68.       LOGICAL   ZPLEIN
  69.       DATA      CLTAB/11,8,15,12,5,6,14,8*7/
  70.  
  71. *     Toutes les coordonnées Z sont nulles
  72.       DO I=1,40
  73.         TRZ(I) = 0
  74.       ENDDO
  75.  
  76.       AXE=IPTR1
  77. *PM   SEGACT AXE
  78.  
  79. *     DEFINITION DES TAILLES DE SYMBOLE
  80.       IF (ZCARRE) THEN
  81.          XNORME= 12 / (XSUP-XINF)
  82.       ELSE
  83.          XNORME= 16 / (XSUP-XINF)
  84.       ENDIF
  85.       YNORME= 11.3 / (YSUP-YINF)
  86.       DX    = (XSUP-XINF)/130*XTAIL
  87.       DY    = DX * XNORME/YNORME
  88.  
  89. *     Pilotage du tracé des marqueurs
  90. *     'POIN','CROI','PLUS','ETOI','CARR','LOSA',
  91. *     'TRIA','TRIB','TRIL','TRIR','TRID','TRIU',
  92. *     'MOIN','BARR','ROND'
  93.       GOTO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15),IMARQ
  94. *
  95. * POINT (en fait un petit triangle)
  96. * on annule la prise en compte de la taille.
  97.  1    DX=DX/10/XTAIL
  98.       DY=DY/10/XTAIL
  99.       TRX(1)=TX-DX
  100.       TRY(1)=TY+DY
  101.       TRX(2)=TX+DX
  102.       TRY(2)=TY+DY
  103.       TRX(3)=TX
  104.       TRY(3)=TY-DY
  105.       TRX(4)=TRX(1)
  106.       TRY(4)=TRY(1)
  107.       CALL POLRL (4,TRX,TRY,TRZ)
  108.       GOTO 20
  109. * CROIX
  110.  2    TRX(1)=TX-DX
  111.       TRY(1)=TY+DY
  112.       TRX(2)=TX+DX
  113.       TRY(2)=TY-DY
  114.       CALL POLRL (2,TRX,TRY,TRZ)
  115.       TRX(1)=TX+DX
  116.       TRY(1)=TY+DY
  117.       TRX(2)=TX-DX
  118.       TRY(2)=TY-DY
  119.       CALL POLRL (2,TRX,TRY,TRZ)
  120.       GOTO 20
  121. * PLUS
  122.  3    TRX(1)=TX
  123.       TRY(1)=TY+DY
  124.       TRX(2)=TX
  125.       TRY(2)=TY-DY
  126.       CALL POLRL (2,TRX,TRY,TRZ)
  127.       TRX(1)=TX-DX
  128.       TRY(1)=TY
  129.       TRX(2)=TX+DX
  130.       TRY(2)=TY
  131.       CALL POLRL (2,TRX,TRY,TRZ)
  132.       GOTO 20
  133. * ETOILE
  134.  4    TRX(1)=TX-DX*0.71
  135.       TRY(1)=TY+DY*0.71
  136.       TRX(2)=TX+DX*0.71
  137.       TRY(2)=TY-DY*0.71
  138.       CALL POLRL (2,TRX,TRY,TRZ)
  139.       TRX(1)=TX+DX*0.71
  140.       TRY(1)=TY+DY*0.71
  141.       TRX(2)=TX-DX*0.71
  142.       TRY(2)=TY-DY*0.71
  143.       CALL POLRL (2,TRX,TRY,TRZ)
  144.       TRX(1)=TX
  145.       TRY(1)=TY+DY
  146.       TRX(2)=TX
  147.       TRY(2)=TY-DY
  148.       CALL POLRL (2,TRX,TRY,TRZ)
  149.       TRX(1)=TX-DX
  150.       TRY(1)=TY
  151.       TRX(2)=TX+DX
  152.       TRY(2)=TY
  153.       CALL POLRL (2,TRX,TRY,TRZ)
  154.       GOTO 20
  155. * CARRE
  156.  5    TRX(1)=TX-DX
  157.       TRY(1)=TY+DY
  158.       TRX(2)=TX+DX
  159.       TRY(2)=TY+DY
  160.       TRX(3)=TX+DX
  161.       TRY(3)=TY-DY
  162.       TRX(4)=TX-DX
  163.       TRY(4)=TY-DY
  164.       TRX(5)=TRX(1)
  165.       TRY(5)=TRY(1)
  166.       CALL POLRL (5,TRX,TRY,TRZ)
  167.       IF (ZPLEIN) CALL TRFACE(5,TRX,TRY,TRZ,1.,ICOLPL,IEFF)
  168.       GOTO 20
  169. * LOSANGE
  170.  6    TRX(1)=TX-DX
  171.       TRY(1)=TY
  172.       TRX(2)=TX
  173.       TRY(2)=TY+DY
  174.       TRX(3)=TX+DX
  175.       TRY(3)=TY
  176.       TRX(4)=TX
  177.       TRY(4)=TY-DY
  178.       TRX(5)=TRX(1)
  179.       TRY(5)=TRY(1)
  180.       CALL POLRL (5,TRX,TRY,TRZ)
  181.       IF (ZPLEIN) CALL TRFACE(5,TRX,TRY,TRZ,1.,ICOLPL,IEFF)
  182.       GOTO 20
  183. * TRIA ou TRID
  184.  11   CONTINUE
  185.  7    TRX(1)=TX-DX
  186.       TRY(1)=TY+DY
  187.       TRX(2)=TX+DX
  188.       TRY(2)=TY+DY
  189.       TRX(3)=TX
  190.       TRY(3)=TY-DY
  191.       TRX(4)=TRX(1)
  192.       TRY(4)=TRY(1)
  193.       CALL POLRL (4,TRX,TRY,TRZ)
  194.       IF (ZPLEIN) CALL TRFACE(3,TRX,TRY,TRZ,1.,ICOLPL,IEFF)
  195.       GOTO 20
  196. * TRIB ou TRIU
  197.  12   CONTINUE
  198.  8    TRX(1)=TX-DX
  199.       TRY(1)=TY-DY
  200.       TRX(2)=TX
  201.       TRY(2)=TY+DY
  202.       TRX(3)=TX+DX
  203.       TRY(3)=TY-DY
  204.       TRX(4)=TRX(1)
  205.       TRY(4)=TRY(1)
  206.       CALL POLRL (4,TRX,TRY,TRZ)
  207.       IF (ZPLEIN) CALL TRFACE(3,TRX,TRY,TRZ,1.,ICOLPL,IEFF)
  208.       GOTO 20
  209. * TRIL
  210. 9     TRX(1)=TX+DX
  211.       TRY(1)=TY+DY
  212.       TRX(2)=TX+DX
  213.       TRY(2)=TY-DY
  214.       TRX(3)=TX-DX
  215.       TRY(3)=TY
  216.       TRX(4)=TRX(1)
  217.       TRY(4)=TRY(1)
  218.       CALL POLRL (4,TRX,TRY,TRZ)
  219.       IF (ZPLEIN) CALL TRFACE(3,TRX,TRY,TRZ,1.,ICOLPL,IEFF)
  220.       GOTO 20
  221. * TRIR
  222.  10   TRX(1)=TX-DX
  223.       TRY(1)=TY+DY
  224.       TRX(2)=TX-DX
  225.       TRY(2)=TY-DY
  226.       TRX(3)=TX+DX
  227.       TRY(3)=TY
  228.       TRX(4)=TRX(1)
  229.       TRY(4)=TRY(1)
  230.       CALL POLRL (4,TRX,TRY,TRZ)
  231.       IF (ZPLEIN) CALL TRFACE(3,TRX,TRY,TRZ,1.,ICOLPL,IEFF)
  232.       GOTO 20
  233. * MOINS
  234.  13   TRX(1)=TX-DX
  235.       TRY(1)=TY
  236.       TRX(2)=TX+DX
  237.       TRY(2)=TY
  238.       CALL POLRL (2,TRX,TRY,TRZ)
  239.       GOTO 20
  240. * BARRE
  241.  14   TRX(1)=TX
  242.       TRY(1)=TY+DY
  243.       TRX(2)=TX
  244.       TRY(2)=TY-DY
  245.       CALL POLRL (2,TRX,TRY,TRZ)
  246.       GOTO 20
  247. * ROND
  248. *     on exploite la symétrie du système
  249.  15   CONTINUE
  250. *     on trace un paquet de 4 * NSEG  segments et les triangles remplis éventuels
  251.       DX1   = DX
  252.       DY1   = 0.
  253.       TETA  = 0.
  254.       DTETA = XPI / 2D0 / NSEG
  255.       TRX(3)= TX
  256.       TRY(3)= TY
  257.       DO I=0,NSEG
  258.          TETA  = TETA + DTETA
  259.          CS    = COS(TETA)
  260.          SN    = (1D0 - CS*CS) ** .5D0
  261.          DX2   = CS*DX
  262.          DY2   = SN*DY
  263.          TRX(1)= TX + DX1
  264.          TRY(1)= TY + DY1
  265.          TRX(2)= TX + DX2
  266.          TRY(2)= TY + DY2
  267.          CALL POLRL (2,TRX,TRY,TRZ)
  268.          IF (ZPLEIN) CALL TRFACE(3,TRX,TRY,TRZ,1.,ICOLPL,IEFF)
  269.          TRX(1)= TX - DX1
  270.          TRX(2)= TX - DX2
  271.          CALL POLRL (2,TRX,TRY,TRZ)
  272.          IF (ZPLEIN) CALL TRFACE(3,TRX,TRY,TRZ,1.,ICOLPL,IEFF)
  273.          TRY(1)= TY - DY1
  274.          TRY(2)= TY - DY2
  275.          CALL POLRL (2,TRX,TRY,TRZ)
  276.          IF (ZPLEIN) CALL TRFACE(3,TRX,TRY,TRZ,1.,ICOLPL,IEFF)
  277.          TRX(1)= TX + DX1
  278.          TRX(2)= TX + DX2
  279.          CALL POLRL (2,TRX,TRY,TRZ)
  280.          IF (ZPLEIN) CALL TRFACE(3,TRX,TRY,TRZ,1.,ICOLPL,IEFF)
  281.          DX1  = DX2
  282.          DY1  = DY2
  283.       ENDDO
  284.  
  285. 20    CONTINUE
  286. *PM      SEGDES AXE
  287.  
  288.       END
  289.  
  290.  
  291.  
  292.  
  293.  
  294.  
  295.  
  296.  
  297.  

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