C DMARQ SOURCE BP208322 16/11/18 21:16:28 9177 c SUBROUTINE DMARQ (IPTR1,TX,TY,IMARQ,IEPAI,XTAIL,ZPLEIN,ICOLPL) SUBROUTINE DMARQ (IPTR1,TX,TY,IMARQ,XTAIL,ZPLEIN,ICOLPL) *============================================================= * * Trace un marqueur à l'emplacement spécifié * Appelé par TRCUR et TREVOL * *============================================================= * * Modifications : * * 95/02/07 Loca * passer les legendes x et y de 12 à 20 caractères: * SEGMENT AXE disparait et est appelé en include: -INC TMAXE. * * 05 sept. 2007 Maugis * Maintien du segment AXE actif en modification * Mise du point en premier type de marqueur * Ajout de formes de marqueurs, dont 2 autres triangles TRIL et TRIR * pointant horizontalement, on garde pour compatibilité TRIA et TRIB, * qui peuvent maintenant être invoqués avec TRID et TRIU * respectivement. * Introduction d'une taille, d'une épaisseur et d'un remplissage de marqueur * * JCARDO 15/05/2012 : les triangles ne pouvaient pas etre remplis... * BP 19/06/2012 : on supprime IEPAI des arguments car inutilisé * *============================================================= * * Entrée : * * IPTR1 : POINTEUR SUR UN SEGMENT AXE (ACTIF) * X , Y : COORDONNEES OU PLACER LE CENTRE DE LA MARQUE * IMARQ : NUMERO DE LA MARQUE A PLACER (Cf. trevol.eso) * IEPAI : Facteur multiplicatif d'épaisseur * XTAIL : Facteur multiplicatif de taille * ZPLEIN: Indicateur de remplissage du marqueur * ICOLPL: Couleur du remplissage * *============================================================= * * TOUTES LES VARIABLES COMMENCANT PAR T SONT EN SIMPLE PRECISION ! * pour compatibilité après les routines de tracé * * DX : DIMENSION DE LA BASE DE LA MARQUE SELON X * DY : DIMENSION DE LA MARQUE SELON Y * NSEG : nb de lignes nécessaires pour remplir la moitié supérieure * d'un marqueur de taille standard * KTAB : table de couleurs progressives (tirée de prtrac.eso) * CLTAB : table de correspondance entre les couleurs nommées (sauf DEFA) * et les couleurs de TRAISO, pb avec les BLANC, NOIR, ROSE * *============================================================= IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-S,U-Y) -INC TMAXE -INC PPARAM -INC CCOPTIO -INC CCREEL -INC CCGEOME * PARAMETER (NSEG=10) DIMENSION TRX(40),TRY(40),TRZ(40) DIMENSION CLTAB(15) LOGICAL ZPLEIN DATA CLTAB/11,8,15,12,5,6,14,8*7/ * Toutes les coordonnées Z sont nulles DO I=1,40 TRZ(I) = 0 ENDDO AXE=IPTR1 *PM SEGACT AXE * DEFINITION DES TAILLES DE SYMBOLE IF (ZCARRE) THEN XNORME= 12 / (XSUP-XINF) ELSE XNORME= 16 / (XSUP-XINF) ENDIF YNORME= 11.3 / (YSUP-YINF) DX = (XSUP-XINF)/130*XTAIL DY = DX * XNORME/YNORME * Pilotage du tracé des marqueurs * 'POIN','CROI','PLUS','ETOI','CARR','LOSA', * 'TRIA','TRIB','TRIL','TRIR','TRID','TRIU', * 'MOIN','BARR','ROND' GOTO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15),IMARQ * * POINT (en fait un petit triangle) * on annule la prise en compte de la taille. 1 DX=DX/10/XTAIL DY=DY/10/XTAIL TRX(1)=TX-DX TRY(1)=TY+DY TRX(2)=TX+DX TRY(2)=TY+DY TRX(3)=TX TRY(3)=TY-DY TRX(4)=TRX(1) TRY(4)=TRY(1) CALL POLRL (4,TRX,TRY,TRZ) GOTO 20 * CROIX 2 TRX(1)=TX-DX TRY(1)=TY+DY TRX(2)=TX+DX TRY(2)=TY-DY CALL POLRL (2,TRX,TRY,TRZ) TRX(1)=TX+DX TRY(1)=TY+DY TRX(2)=TX-DX TRY(2)=TY-DY CALL POLRL (2,TRX,TRY,TRZ) GOTO 20 * PLUS 3 TRX(1)=TX TRY(1)=TY+DY TRX(2)=TX TRY(2)=TY-DY CALL POLRL (2,TRX,TRY,TRZ) TRX(1)=TX-DX TRY(1)=TY TRX(2)=TX+DX TRY(2)=TY CALL POLRL (2,TRX,TRY,TRZ) GOTO 20 * ETOILE 4 TRX(1)=TX-DX*0.71 TRY(1)=TY+DY*0.71 TRX(2)=TX+DX*0.71 TRY(2)=TY-DY*0.71 CALL POLRL (2,TRX,TRY,TRZ) TRX(1)=TX+DX*0.71 TRY(1)=TY+DY*0.71 TRX(2)=TX-DX*0.71 TRY(2)=TY-DY*0.71 CALL POLRL (2,TRX,TRY,TRZ) TRX(1)=TX TRY(1)=TY+DY TRX(2)=TX TRY(2)=TY-DY CALL POLRL (2,TRX,TRY,TRZ) TRX(1)=TX-DX TRY(1)=TY TRX(2)=TX+DX TRY(2)=TY CALL POLRL (2,TRX,TRY,TRZ) GOTO 20 * CARRE 5 TRX(1)=TX-DX TRY(1)=TY+DY TRX(2)=TX+DX TRY(2)=TY+DY TRX(3)=TX+DX TRY(3)=TY-DY TRX(4)=TX-DX TRY(4)=TY-DY TRX(5)=TRX(1) TRY(5)=TRY(1) CALL POLRL (5,TRX,TRY,TRZ) IF (ZPLEIN) CALL TRFACE(5,TRX,TRY,TRZ,1.,ICOLPL,IEFF) GOTO 20 * LOSANGE 6 TRX(1)=TX-DX TRY(1)=TY TRX(2)=TX TRY(2)=TY+DY TRX(3)=TX+DX TRY(3)=TY TRX(4)=TX TRY(4)=TY-DY TRX(5)=TRX(1) TRY(5)=TRY(1) CALL POLRL (5,TRX,TRY,TRZ) IF (ZPLEIN) CALL TRFACE(5,TRX,TRY,TRZ,1.,ICOLPL,IEFF) GOTO 20 * TRIA ou TRID 11 CONTINUE 7 TRX(1)=TX-DX TRY(1)=TY+DY TRX(2)=TX+DX TRY(2)=TY+DY TRX(3)=TX TRY(3)=TY-DY TRX(4)=TRX(1) TRY(4)=TRY(1) CALL POLRL (4,TRX,TRY,TRZ) IF (ZPLEIN) CALL TRFACE(3,TRX,TRY,TRZ,1.,ICOLPL,IEFF) GOTO 20 * TRIB ou TRIU 12 CONTINUE 8 TRX(1)=TX-DX TRY(1)=TY-DY TRX(2)=TX TRY(2)=TY+DY TRX(3)=TX+DX TRY(3)=TY-DY TRX(4)=TRX(1) TRY(4)=TRY(1) CALL POLRL (4,TRX,TRY,TRZ) IF (ZPLEIN) CALL TRFACE(3,TRX,TRY,TRZ,1.,ICOLPL,IEFF) GOTO 20 * TRIL 9 TRX(1)=TX+DX TRY(1)=TY+DY TRX(2)=TX+DX TRY(2)=TY-DY TRX(3)=TX-DX TRY(3)=TY TRX(4)=TRX(1) TRY(4)=TRY(1) CALL POLRL (4,TRX,TRY,TRZ) IF (ZPLEIN) CALL TRFACE(3,TRX,TRY,TRZ,1.,ICOLPL,IEFF) GOTO 20 * TRIR 10 TRX(1)=TX-DX TRY(1)=TY+DY TRX(2)=TX-DX TRY(2)=TY-DY TRX(3)=TX+DX TRY(3)=TY TRX(4)=TRX(1) TRY(4)=TRY(1) CALL POLRL (4,TRX,TRY,TRZ) IF (ZPLEIN) CALL TRFACE(3,TRX,TRY,TRZ,1.,ICOLPL,IEFF) GOTO 20 * MOINS 13 TRX(1)=TX-DX TRY(1)=TY TRX(2)=TX+DX TRY(2)=TY CALL POLRL (2,TRX,TRY,TRZ) GOTO 20 * BARRE 14 TRX(1)=TX TRY(1)=TY+DY TRX(2)=TX TRY(2)=TY-DY CALL POLRL (2,TRX,TRY,TRZ) GOTO 20 * ROND * on exploite la symétrie du système 15 CONTINUE * on trace un paquet de 4 * NSEG segments et les triangles remplis éventuels DX1 = DX DY1 = 0. TETA = 0. DTETA = XPI / 2D0 / NSEG TRX(3)= TX TRY(3)= TY DO I=0,NSEG TETA = TETA + DTETA CS = COS(TETA) SN = (1D0 - CS*CS) ** .5D0 DX2 = CS*DX DY2 = SN*DY TRX(1)= TX + DX1 TRY(1)= TY + DY1 TRX(2)= TX + DX2 TRY(2)= TY + DY2 CALL POLRL (2,TRX,TRY,TRZ) IF (ZPLEIN) CALL TRFACE(3,TRX,TRY,TRZ,1.,ICOLPL,IEFF) TRX(1)= TX - DX1 TRX(2)= TX - DX2 CALL POLRL (2,TRX,TRY,TRZ) IF (ZPLEIN) CALL TRFACE(3,TRX,TRY,TRZ,1.,ICOLPL,IEFF) TRY(1)= TY - DY1 TRY(2)= TY - DY2 CALL POLRL (2,TRX,TRY,TRZ) IF (ZPLEIN) CALL TRFACE(3,TRX,TRY,TRZ,1.,ICOLPL,IEFF) TRX(1)= TX + DX1 TRX(2)= TX + DX2 CALL POLRL (2,TRX,TRY,TRZ) IF (ZPLEIN) CALL TRFACE(3,TRX,TRY,TRZ,1.,ICOLPL,IEFF) DX1 = DX2 DY1 = DY2 ENDDO 20 CONTINUE *PM SEGDES AXE END