1 : C DMARQ SOURCE BP208322 12/08/02 21:15:21 7468 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 : -INC CCOPTIO 60 : -INC CCREEL 61 : -INC CCGEOME 62 : * 63 : PARAMETER (NSEG=10) 64 : DIMENSION TRX(40),TRY(40),TRZ(40) 65 : DIMENSION CLTAB(15) 66 : LOGICAL ZPLEIN 67 : DATA CLTAB/11,8,15,12,5,6,14,8*7/ 68 : 69 : * Toutes les coordonnées Z sont nulles 70 : DO I=1,40 71 : TRZ(I) = 0 72 : ENDDO 73 : 74 : AXE=IPTR1 75 : *PM SEGACT AXE 76 : 77 : * DEFINITION DES TAILLES DE SYMBOLE 78 : IF (ZCARRE) THEN 79 : XNORME= 12 / (XSUP-XINF) 80 : ELSE 81 : XNORME= 16 / (XSUP-XINF) 82 : ENDIF 83 : YNORME= 11.3 / (YSUP-YINF) 84 : DX = (XSUP-XINF)/130*XTAIL 85 : DY = DX * XNORME/YNORME 86 : 87 : * Pilotage du tracé des marqueurs 88 : * 'POIN','CROI','PLUS','ETOI','CARR','LOSA', 89 : * 'TRIA','TRIB','TRIL','TRIR','TRID','TRIU', 90 : * 'MOIN','BARR','ROND' 91 : GOTO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15),IMARQ 92 : * 93 : * POINT (en fait un petit triangle) 94 : * on annule la prise en compte de la taille. 95 : 1 DX=DX/10/XTAIL 96 : DY=DY/10/XTAIL 97 : TRX(1)=TX-DX 98 : TRY(1)=TY+DY 99 : TRX(2)=TX+DX 100 : TRY(2)=TY+DY 101 : TRX(3)=TX 102 : TRY(3)=TY-DY 103 : TRX(4)=TRX(1) 104 : TRY(4)=TRY(1) 104 : CALL POLRL (4,TRX,TRY,TRZ) 105 : GOTO 20 106 : * CROIX 107 : 2 TRX(1)=TX-DX 108 : TRY(1)=TY+DY 109 : TRX(2)=TX+DX 110 : TRY(2)=TY-DY 110 : CALL POLRL (2,TRX,TRY,TRZ) 111 : TRX(1)=TX+DX 112 : TRY(1)=TY+DY 113 : TRX(2)=TX-DX 114 : TRY(2)=TY-DY 114 : CALL POLRL (2,TRX,TRY,TRZ) 115 : GOTO 20 116 : * PLUS 117 : 3 TRX(1)=TX 118 : TRY(1)=TY+DY 119 : TRX(2)=TX 120 : TRY(2)=TY-DY 120 : CALL POLRL (2,TRX,TRY,TRZ) 121 : TRX(1)=TX-DX 122 : TRY(1)=TY 123 : TRX(2)=TX+DX 124 : TRY(2)=TY 124 : CALL POLRL (2,TRX,TRY,TRZ) 125 : GOTO 20 126 : * ETOILE 127 : 4 TRX(1)=TX-DX*0.71 128 : TRY(1)=TY+DY*0.71 129 : TRX(2)=TX+DX*0.71 130 : TRY(2)=TY-DY*0.71 130 : CALL POLRL (2,TRX,TRY,TRZ) 131 : TRX(1)=TX+DX*0.71 132 : TRY(1)=TY+DY*0.71 133 : TRX(2)=TX-DX*0.71 134 : TRY(2)=TY-DY*0.71 134 : CALL POLRL (2,TRX,TRY,TRZ) 135 : TRX(1)=TX 136 : TRY(1)=TY+DY 137 : TRX(2)=TX 138 : TRY(2)=TY-DY 138 : CALL POLRL (2,TRX,TRY,TRZ) 139 : TRX(1)=TX-DX 140 : TRY(1)=TY 141 : TRX(2)=TX+DX 142 : TRY(2)=TY 142 : CALL POLRL (2,TRX,TRY,TRZ) 143 : GOTO 20 144 : * CARRE 145 : 5 TRX(1)=TX-DX 146 : TRY(1)=TY+DY 147 : TRX(2)=TX+DX 148 : TRY(2)=TY+DY 149 : TRX(3)=TX+DX 150 : TRY(3)=TY-DY 151 : TRX(4)=TX-DX 152 : TRY(4)=TY-DY 153 : TRX(5)=TRX(1) 154 : TRY(5)=TRY(1) 154 : CALL POLRL (5,TRX,TRY,TRZ) 154 : IF (ZPLEIN) CALL TRFACE(5,TRX,TRY,TRZ,1.,ICOLPL,IEFF) 155 : GOTO 20 156 : * LOSANGE 157 : 6 TRX(1)=TX-DX 158 : TRY(1)=TY 159 : TRX(2)=TX 160 : TRY(2)=TY+DY 161 : TRX(3)=TX+DX 162 : TRY(3)=TY 163 : TRX(4)=TX 164 : TRY(4)=TY-DY 165 : TRX(5)=TRX(1) 166 : TRY(5)=TRY(1) 166 : CALL POLRL (5,TRX,TRY,TRZ) 166 : IF (ZPLEIN) CALL TRFACE(5,TRX,TRY,TRZ,1.,ICOLPL,IEFF) 167 : GOTO 20 168 : * TRIA ou TRID 169 : 11 CONTINUE 170 : 7 TRX(1)=TX-DX 171 : TRY(1)=TY+DY 172 : TRX(2)=TX+DX 173 : TRY(2)=TY+DY 174 : TRX(3)=TX 175 : TRY(3)=TY-DY 176 : TRX(4)=TRX(1) 177 : TRY(4)=TRY(1) 177 : CALL POLRL (4,TRX,TRY,TRZ) 177 : IF (ZPLEIN) CALL TRFACE(3,TRX,TRY,TRZ,1.,ICOLPL,IEFF) 178 : GOTO 20 179 : * TRIB ou TRIU 180 : 12 CONTINUE 181 : 8 TRX(1)=TX-DX 182 : TRY(1)=TY-DY 183 : TRX(2)=TX 184 : TRY(2)=TY+DY 185 : TRX(3)=TX+DX 186 : TRY(3)=TY-DY 187 : TRX(4)=TRX(1) 188 : TRY(4)=TRY(1) 188 : CALL POLRL (4,TRX,TRY,TRZ) 188 : IF (ZPLEIN) CALL TRFACE(3,TRX,TRY,TRZ,1.,ICOLPL,IEFF) 189 : GOTO 20 190 : * TRIL 191 : 9 TRX(1)=TX+DX 192 : TRY(1)=TY+DY 193 : TRX(2)=TX+DX 194 : TRY(2)=TY-DY 195 : TRX(3)=TX-DX 196 : TRY(3)=TY 197 : TRX(4)=TRX(1) 198 : TRY(4)=TRY(1) 198 : CALL POLRL (4,TRX,TRY,TRZ) 198 : IF (ZPLEIN) CALL TRFACE(3,TRX,TRY,TRZ,1.,ICOLPL,IEFF) 199 : GOTO 20 200 : * TRIR 201 : 10 TRX(1)=TX-DX 202 : TRY(1)=TY+DY 203 : TRX(2)=TX-DX 204 : TRY(2)=TY-DY 205 : TRX(3)=TX+DX 206 : TRY(3)=TY 207 : TRX(4)=TRX(1) 208 : TRY(4)=TRY(1) 208 : CALL POLRL (4,TRX,TRY,TRZ) 208 : IF (ZPLEIN) CALL TRFACE(3,TRX,TRY,TRZ,1.,ICOLPL,IEFF) 209 : GOTO 20 210 : * MOINS 211 : 13 TRX(1)=TX-DX 212 : TRY(1)=TY 213 : TRX(2)=TX+DX 214 : TRY(2)=TY 214 : CALL POLRL (2,TRX,TRY,TRZ) 215 : GOTO 20 216 : * BARRE 217 : 14 TRX(1)=TX 218 : TRY(1)=TY+DY 219 : TRX(2)=TX 220 : TRY(2)=TY-DY 220 : CALL POLRL (2,TRX,TRY,TRZ) 221 : GOTO 20 222 : * ROND 223 : * on exploite la symétrie du système 224 : 15 CONTINUE 225 : * on trace un paquet de 4 * NSEG segments et les triangles remplis éventuels 226 : DX1 = DX 227 : DY1 = 0. 228 : TETA = 0. 229 : DTETA = XPI / 2D0 / NSEG 230 : TRX(3)= TX 231 : TRY(3)= TY 232 : DO I=0,NSEG 233 : TETA = TETA + DTETA 234 : CS = COS(TETA) 235 : SN = (1D0 - CS*CS) ** .5D0 236 : DX2 = CS*DX 237 : DY2 = SN*DY 238 : TRX(1)= TX + DX1 239 : TRY(1)= TY + DY1 240 : TRX(2)= TX + DX2 241 : TRY(2)= TY + DY2 241 : CALL POLRL (2,TRX,TRY,TRZ) 241 : IF (ZPLEIN) CALL TRFACE(3,TRX,TRY,TRZ,1.,ICOLPL,IEFF) 242 : TRX(1)= TX - DX1 243 : TRX(2)= TX - DX2 243 : CALL POLRL (2,TRX,TRY,TRZ) 243 : IF (ZPLEIN) CALL TRFACE(3,TRX,TRY,TRZ,1.,ICOLPL,IEFF) 244 : TRY(1)= TY - DY1 245 : TRY(2)= TY - DY2 245 : CALL POLRL (2,TRX,TRY,TRZ) 245 : IF (ZPLEIN) CALL TRFACE(3,TRX,TRY,TRZ,1.,ICOLPL,IEFF) 246 : TRX(1)= TX + DX1 247 : TRX(2)= TX + DX2 247 : CALL POLRL (2,TRX,TRY,TRZ) 247 : IF (ZPLEIN) CALL TRFACE(3,TRX,TRY,TRZ,1.,ICOLPL,IEFF) 248 : DX1 = DX2 249 : DY1 = DY2 250 : ENDDO 251 : 252 : 20 CONTINUE 253 : *PM SEGDES AXE 254 : 255 : END 256 : 257 : 258 : 259 : 260 :
© Cast3M 2003 - All rights reserved.
Disclaimer