1 : C STRINI SOURCE BP208322 12/08/02 21:15:42 7468 2 : C INTERFACE POUR GENERATION DE POSTSCRIPT 3 : C LES POINTS D'ENTREE EN C SONT POUR LA COULEUR 4 : C 5 : SUBROUTINE STRINI(NOL,AXAX,AYAY,TITR,HAUTT,VALEU,NCOUMA) 6 : IMPLICIT INTEGER(I-N) 7 : -INC CCOPTIO 8 : -INC CCTRACE 9 : EXTERNAL LONG 10 : DIMENSION XTR(*),YTR(*) 11 : CHARACTER*(*) TITR,CARAC,PROMPT,REPLY 12 : CHARACTER*(*) LEGEND 13 : CHARACTER*80 TITRE 14 : CHARACTER*128 CHAINE 15 : LOGICAL VALEU,FENE,VALEUR,FENET 16 : SAVE XIOCAD,YIOCAD,VALEUR,FENET,TITRE,LTITRE 17 : SAVE XMIN,YMIN,XXAX,YYAX,CLX,XRAP,YRAP,XDEP,YDEP 18 : save icoul,kcoul,initia,ipag,miso 19 : PARAMETER(IUPS=24) 20 : DIMENSION ITB(17) 21 : CHARACTER*17 ctb 22 : CHARACTER*64 ctc 23 : CHARACTER*6 cha 24 : data initia/0/ 25 : data ipag/1/ 26 : data itb/1,5,13,3,9,7,11,15,16,4,12,2,8,6,10,14,1/ 27 : data ctb/'0123456789ABCDEFG'/ 28 : data ctc/'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123 29 : >456789&@'/ 30 : data miso/0/ 31 : 32 : * verification des bornes 33 : bornex(xxx)=min(max(xiocad*0.01,xxx),xiocad*0.99) 34 : borney(yyy)=min(max(yiocad*0.01,yyy),yiocad*0.99) 35 : C JYYY Debut 36 : Iorncx(xxx)=(min(max(xiocad*0.01,xxx),xiocad*0.99))/0.004 37 : Iorncy(yyy)=(min(max(yiocad*0.01,yyy),yiocad*0.99))/0.004 38 : C JYYY Fin 39 : * 40 : ENTRY CTRINI(NOL,AXAX,AYAY,TITR,HAUTT,VALEU,NCOUMA) 41 : 42 : C====================================================================== 43 : C INITIALISATION : STRINI ou CTRINI 44 : C====================================================================== 45 : 46 : * on part pour 64 couleurs 47 : NCOUMA=64 48 : icoul=0 49 : lo=len(titr) 50 : TITRE=TITR(1:72) 51 : LTITRE=long(titre) 52 : VALEUR=VALEU 53 : * INITIALISATION DE POSTSCRIPT 54 : CLX=0.3 55 : if (ZHORIZ) then 56 : xiocad=diocad 57 : yiocad=xiocad*21/29.7 58 : else 59 : yiocad=diocad 60 : xiocad=yiocad*21/27.7 61 : endif 62 : 63 : * ECRITURE DU PROLOGUE DU POSTSCRIPT 64 : if (ZINIPS) then 65 : ZINIPS = .false. 66 : c ... on met IPAG à 1 pour recommencer à numéroter correctement ... 67 : ipag = 1 68 : initia=1 69 : icoul=0 70 : write (IUPS,897) 71 : write (IUPS,898) 72 : write (IUPS,899) 73 : if (ZHORIZ) then 74 : write (IUPS,900) 75 : else 76 : write (IUPS,1900) 77 : endif 78 : write (IUPS,901) 79 : write (IUPS,902) 80 : write (IUPS,903) 81 : write (IUPS,904) 82 : write (IUPS,905) IEPTR 83 : write (IUPS,906) 84 : write (IUPS,907) 85 : write (IUPS,908) 86 : write (IUPS,909) 87 : write (IUPS,910) 88 : write (IUPS,911) 89 : write (IUPS,912) 90 : write (IUPS,913) 91 : C JYYY Debut 92 : write (IUPS,'(A)') '/DL{NP MV {LN}repeat SK } def' 93 : write (IUPS,'(A)') '/DS{NP MV {LN}repeat FI } def' 94 : write (IUPS,'(A)') '/H0{.1 .1 scale}def' 95 : write (IUPS,'(A)') '/H1{10 10 scale}def' 96 : write (IUPS,'(A)') '/CX{0.004 div} def' 97 : write (IUPS,'(A)') '/MX{moveto H1} def' 98 : write (IUPS,'(A)') '/SX {show H0} def' 99 : write (IUPS,'(A)') 100 : + '/center {stringwidth pop 2 div neg 0 rmoveto} def' 101 : c + '/center {dup stringwidth pop 2 div neg 0 rmoveto} def' 102 : C JYYY Fin 103 : write (IUPS,914) 104 : write (IUPS,915) 105 : write (IUPS,916) 106 : write (IUPS,917) 107 : write (IUPS,918) 108 : write (IUPS,919) 109 : write (IUPS,920) 110 : write (IUPS,921) 111 : write (IUPS,922) 112 : write (IUPS,923) 113 : write (IUPS,924) 114 : write (IUPS,925) 115 : write (IUPS,926) 116 : write (IUPS,927) 117 : write (IUPS,928) 118 : write (IUPS,929) 119 : write (IUPS,930) 120 : write (IUPS,931) 121 : write (IUPS,932) 122 : write (IUPS,933) 123 : write (IUPS,934) 124 : write (IUPS,935) 125 : write (IUPS,936) 126 : write (IUPS,937) 127 : write (IUPS,938) 128 : write (IUPS,939) 129 : write (IUPS,940) 130 : write (IUPS,941) 131 : write (IUPS,942) 132 : write (IUPS,943) 133 : write (IUPS,944) 134 : write (IUPS,945) 135 : write (IUPS,946) 136 : write (IUPS,813) 137 : write (IUPS,814) 138 : write (IUPS,815) 139 : write (IUPS,816) 140 : write (IUPS,817) 141 : write (IUPS,818) 142 : write (IUPS,819) 143 : write (IUPS,820) 144 : write (IUPS,821) 145 : write (IUPS,822) 146 : write (IUPS,823) 147 : write (IUPS,824) 148 : write (IUPS,825) 149 : write (IUPS,826) 150 : write (IUPS,827) 151 : write (IUPS,828) 152 : write (IUPS,829) 153 : write (IUPS,830) 154 : write (IUPS,831) 155 : write (IUPS,832) 156 : write (IUPS,833) 157 : write (IUPS,834) 158 : write (IUPS,835) 159 : write (IUPS,836) 160 : write (IUPS,837) 161 : write (IUPS,838) 162 : write (IUPS,839) 163 : write (IUPS,840) 164 : write (IUPS,841) 165 : write (IUPS,842) 166 : write (IUPS,843) 167 : write (IUPS,844) 168 : write (IUPS,845) 169 : write (IUPS,846) 170 : c write (IUPS,947) 171 : *bp : choix de la police tq definie dans option.eso 172 : if(IOPOTR.eq.1) write (IUPS,847) 173 : if(IOPOTR.eq.2) write (IUPS,848) 174 : if(IOPOTR.eq.3) write (IUPS,849) 175 : if(IOPOTR.eq.4) write (IUPS,850) 176 : if(IOPOTR.eq.5) write (IUPS,851) 177 : if(IOPOTR.eq.6) write (IUPS,852) 178 : if(IOPOTR.eq.7) write (IUPS,853) 179 : if(IOPOTR.eq.8) write (IUPS,854) 180 : if(IOPOTR.eq.9) write (IUPS,855) 181 : if(IOPOTR.eq.10) write (IUPS,856) 182 : if(IOPOTR.eq.11) write (IUPS,857) 183 : if(IOPOTR.eq.12) write (IUPS,858) 184 : c IOPOPO = 846+IOPOTR 185 : c write (IUPS,IOPOPO) 186 : if (ZHORIZ) then 187 : write (IUPS,948) 188 : else 189 : write (IUPS,1948) 190 : endif 191 : write (IUPS,949) 192 : 897 format ('%!PS-Adobe-1.0') 193 : 898 format ('%%Creator: Cast3m - CEA/DEN/DM2S/SEMT') 194 : 899 format ('%%BoundingBox: 0 0 593 841') 195 : 900 format ('%%Orientation: Landscape') 196 : 1900 format ('%%Orientation: Portrait') 197 : 901 format('200 dict begin') 198 : 902 format ('/StartPage{/sv save def}def') 199 : 903 format ('/EndPage{showpage sv restore}def') 200 : 904 format ('1 setlinecap 0 setlinejoin') 201 : 905 format (I2,' setlinewidth') 202 : 906 format ('/CM { 0.04 div } def') 203 : 907 format ('/NP { newpath } def') 204 : 908 format ('/MV { moveto } def') 205 : 909 format ('/LN { lineto } def') 206 : 910 format ('/SK { stroke } def') 207 : 911 format ('/FI { fill } def') 208 : 912 format ('/S { show } def') 209 : 913 format ('/CN { 0. setgray } def') 210 : 914 format ('/C0 { 0. setgray } def') 211 : 915 Format ('/C1 { 0.98 setgray } def') 212 : 916 format ('/C3 { 0.95 setgray } def') 213 : 917 format ('/C5 { 0.91 setgray } def') 214 : 918 format ('/C7 { 0.86 setgray } def') 215 : 919 format ('/C9 { 0.80 setgray } def') 216 : 920 format ('/CB { 0.73 setgray } def') 217 : 921 format ('/CD { 0.65 setgray } def') 218 : 922 format ('/CF { 0.56 setgray } def') 219 : 923 format ('/C2 { 0.965 setgray } def') 220 : 924 format ('/C4 { 0.93 setgray } def') 221 : 925 format ('/C6 { 0.885 setgray } def') 222 : 926 format ('/C8 { 0.83 setgray } def') 223 : 927 format ('/CA { 0.765 setgray } def') 224 : 928 format ('/CC { 0.69 setgray } def') 225 : 929 format ('/CE { 0.605 setgray } def') 226 : 930 format ('/CG { 0.52 setgray } def') 227 : 931 Format ('/c1 { 0.98 setgray } def') 228 : 932 format ('/c3 { 0.95 setgray } def') 229 : 933 format ('/c5 { 0.91 setgray } def') 230 : 934 format ('/c7 { 0.86 setgray } def') 231 : 935 format ('/c9 { 0.80 setgray } def') 232 : 936 format ('/cB { 0.73 setgray } def') 233 : 937 format ('/cD { 0.65 setgray } def') 234 : 938 format ('/cF { 0.56 setgray } def') 235 : 939 format ('/c2 { 0.965 setgray } def') 236 : 940 format ('/c4 { 0.93 setgray } def') 237 : 941 format ('/c6 { 0.885 setgray } def') 238 : 942 format ('/c8 { 0.83 setgray } def') 239 : 943 format ('/cA { 0.765 setgray } def') 240 : 944 format ('/cC { 0.69 setgray } def') 241 : 945 format ('/cE { 0.605 setgray } def') 242 : 946 format ('/cG { 0.52 setgray } def') 243 : 813 format ('/DN { 0.0000 0.0000 0.0000 setrgbcolor } def % black') 244 : 814 format ('/D0 { 0.0000 0.0000 0.0000 setrgbcolor } def % black') 245 : 815 format ('/D1 { 0.8157 0.1255 0.5647 setrgbcolor } def % VioletR') 246 : 816 format ('/D3 { 0.2824 0.2392 0.5451 setrgbcolor } def % DarkSla') 247 : 817 format ('/D5 { 0.2824 0.8196 0.8000 setrgbcolor } def % MediumT') 248 : 818 format ('/D7 { 0.2353 0.7020 0.4431 setrgbcolor } def % MediumS') 249 : 819 format ('/D9 { 0.6039 0.8039 0.1961 setrgbcolor } def % YellowG') 250 : 820 format ('/DB { 1.0000 0.6471 0.0000 setrgbcolor } def % orange') 251 : 821 format ('/DD { 0.8275 0.8275 0.8275 setrgbcolor } def % LightGr') 252 : 822 format ('/DF { 0.0000 0.0000 0.0000 setrgbcolor } def % pas uti') 253 : 823 format ('/D2 { 1.0000 0.0000 1.0000 setrgbcolor } def % magenta') 254 : 824 format ('/D4 { 0.0000 0.0000 1.0000 setrgbcolor } def % blue') 255 : 825 format ('/D6 { 0.0000 0.8078 0.8196 setrgbcolor } def % DarkTur') 256 : 826 format ('/D8 { 0.0000 1.0000 0.0000 setrgbcolor } def % green') 257 : 827 format ('/DA { 1.0000 1.0000 0.0000 setrgbcolor } def % yellow') 258 : 828 format ('/DC { 1.0000 0.0000 0.0000 setrgbcolor } def % red') 259 : 829 format ('/DE { 1.0000 1.0000 1.0000 setrgbcolor } def % white') 260 : 830 format ('/DG { 0.0000 0.0000 0.0000 setrgbcolor } def % pas uti') 261 : 831 format ('/d1 { 0.0000 0.0000 1.0000 setrgbcolor } def %') 262 : 832 format ('/d3 { 0.0000 0.6078 1.0000 setrgbcolor } def %') 263 : 833 format ('/d5 { 0.0000 0.9333 1.0000 setrgbcolor } def %') 264 : 834 format ('/d7 { 0.0000 1.0000 0.6078 setrgbcolor } def %') 265 : 835 format ('/d9 { 0.7058 1.0000 0.0000 setrgbcolor } def %') 266 : 836 format ('/dB { 1.0000 0.9333 0.0000 setrgbcolor } def %') 267 : 837 format ('/dD { 1.0000 0.6078 0.0000 setrgbcolor } def %') 268 : 838 format ('/dF { 1.0000 0.0000 0.0000 setrgbcolor } def %') 269 : 839 format ('/d2 { 0.0000 0.3490 1.0000 setrgbcolor } def %') 270 : 840 format ('/d4 { 0.0000 0.7882 1.0000 setrgbcolor } def %') 271 : 841 format ('/d6 { 0.0000 1.0000 0.7882 setrgbcolor } def %') 272 : 842 format ('/d8 { 0.6078 1.0000 0.0000 setrgbcolor } def %') 273 : 843 format ('/dA { 1.0000 1.0000 0.0000 setrgbcolor } def %') 274 : 844 format ('/dC { 1.0000 0.7882 0.0000 setrgbcolor } def %') 275 : 845 format ('/dE { 1.0000 0.3490 0.0000 setrgbcolor } def %') 276 : 846 format ('/dG { 0.0000 0.0000 0.0000 setrgbcolor } def %') 277 : c 947 format ('/Courier findfont 9 scalefont setfont') 278 : c 947 format ('/Courier findfont',/, 279 : c + 'dup length dict begin',/, 280 : c + ' {1 index /FID ne {def} {pop pop} ifelse} forall',/, 281 : c + ' /Encoding ISOLatin1Encoding def',/, 282 : c + ' currentdict',/, 283 : c + 'end',/, 284 : c + '/Courier-ISOLatin1 exch definefont 14 scalefont setfont') 285 : c bp : choix de la police tq definie dans option.eso 286 : c taille 12 287 : 847 format ('/Courier findfont',/, 288 : + 'dup length dict begin',/, 289 : + ' {1 index /FID ne {def} {pop pop} ifelse} forall',/, 290 : + ' /Encoding ISOLatin1Encoding def',/, 291 : + ' currentdict',/, 292 : + 'end',/, 293 : + '/Courier-ISOLatin1 exch definefont 12 scalefont setfont') 294 : 848 format ('/Helvetica findfont',/, 295 : + 'dup length dict begin',/, 296 : + ' {1 index /FID ne {def} {pop pop} ifelse} forall',/, 297 : + ' /Encoding ISOLatin1Encoding def',/, 298 : + ' currentdict',/, 299 : + 'end',/, 300 : + '/Helvetica-ISOLatin1 exch definefont 12 scalefont setfont') 301 : 849 format ('/Times findfont',/, 302 : + 'dup length dict begin',/, 303 : + ' {1 index /FID ne {def} {pop pop} ifelse} forall',/, 304 : + ' /Encoding ISOLatin1Encoding def',/, 305 : + ' currentdict',/, 306 : + 'end',/, 307 : + '/Times-ISOLatin1 exch definefont 12 scalefont setfont') 308 : c taille 14 309 : 850 format ('/Courier findfont',/, 310 : + 'dup length dict begin',/, 311 : + ' {1 index /FID ne {def} {pop pop} ifelse} forall',/, 312 : + ' /Encoding ISOLatin1Encoding def',/, 313 : + ' currentdict',/, 314 : + 'end',/, 315 : + '/Courier-ISOLatin1 exch definefont 14 scalefont setfont') 316 : 851 format ('/Helvetica findfont',/, 317 : + 'dup length dict begin',/, 318 : + ' {1 index /FID ne {def} {pop pop} ifelse} forall',/, 319 : + ' /Encoding ISOLatin1Encoding def',/, 320 : + ' currentdict',/, 321 : + 'end',/, 322 : + '/Helvetica-ISOLatin1 exch definefont 14 scalefont setfont') 323 : 852 format ('/Times findfont',/, 324 : + 'dup length dict begin',/, 325 : + ' {1 index /FID ne {def} {pop pop} ifelse} forall',/, 326 : + ' /Encoding ISOLatin1Encoding def',/, 327 : + ' currentdict',/, 328 : + 'end',/, 329 : + '/Times-ISOLatin1 exch definefont 14 scalefont setfont') 330 : c taille 16 331 : 853 format ('/Courier findfont',/, 332 : + 'dup length dict begin',/, 333 : + ' {1 index /FID ne {def} {pop pop} ifelse} forall',/, 334 : + ' /Encoding ISOLatin1Encoding def',/, 335 : + ' currentdict',/, 336 : + 'end',/, 337 : + '/Courier-ISOLatin1 exch definefont 16 scalefont setfont') 338 : 854 format ('/Helvetica findfont',/, 339 : + 'dup length dict begin',/, 340 : + ' {1 index /FID ne {def} {pop pop} ifelse} forall',/, 341 : + ' /Encoding ISOLatin1Encoding def',/, 342 : + ' currentdict',/, 343 : + 'end',/, 344 : + '/Helvetica-ISOLatin1 exch definefont 16 scalefont setfont') 345 : 855 format ('/Times findfont',/, 346 : + 'dup length dict begin',/, 347 : + ' {1 index /FID ne {def} {pop pop} ifelse} forall',/, 348 : + ' /Encoding ISOLatin1Encoding def',/, 349 : + ' currentdict',/, 350 : + 'end',/, 351 : + '/Times-ISOLatin1 exch definefont 16 scalefont setfont') 352 : c taille 18 353 : 856 format ('/Courier findfont',/, 354 : + 'dup length dict begin',/, 355 : + ' {1 index /FID ne {def} {pop pop} ifelse} forall',/, 356 : + ' /Encoding ISOLatin1Encoding def',/, 357 : + ' currentdict',/, 358 : + 'end',/, 359 : + '/Courier-ISOLatin1 exch definefont 18 scalefont setfont') 360 : 857 format ('/Helvetica findfont',/, 361 : + 'dup length dict begin',/, 362 : + ' {1 index /FID ne {def} {pop pop} ifelse} forall',/, 363 : + ' /Encoding ISOLatin1Encoding def',/, 364 : + ' currentdict',/, 365 : + 'end',/, 366 : + '/Helvetica-ISOLatin1 exch definefont 18 scalefont setfont') 367 : 858 format ('/Times findfont',/, 368 : + 'dup length dict begin',/, 369 : + ' {1 index /FID ne {def} {pop pop} ifelse} forall',/, 370 : + ' /Encoding ISOLatin1Encoding def',/, 371 : + ' currentdict',/, 372 : + 'end',/, 373 : + '/Times-ISOLatin1 exch definefont 18 scalefont setfont') 374 : c bp : fin du choix de la police 375 : 948 format ('23 CM 1 CM translate 90 rotate') 376 : 1948 format ('2 CM 2 CM translate') 377 : 949 format ('%%EndProlog') 378 : else 379 : C backspace IUPS 380 : endif 381 : write (IUPS,957) ipag,ipag 382 : write (IUPS,958) 383 : write (IUPS,959) 384 : 957 format ('%%Page: ',i5,1x,i5) 385 : 958 format ('StartPage') 386 : 959 format ('H0') 387 : RETURN 388 : ** 389 : 390 : C====================================================================== 391 : C DEFINITION FENETRE + TITRE : sDFENE ou cDFENE 392 : C====================================================================== 393 : 394 : ENTRY sDFENE(XMI,XXA,YMI,YYA,XR1,XR2,YR1,YR2,FENE) 395 : ENTRY cDFENE(XMI,XXA,YMI,YYA,XR1,XR2,YR1,YR2,FENE) 396 : * DEFINITION FENETRE 397 : XR1=XMI 398 : XR2=XXA 399 : YR1=YMI 400 : YR2=YYA 401 : FENET=FENE 402 : XMIN=XMI 403 : XXAX=XXA 404 : YMIN=YMI 405 : YYAX=YYA 406 : IF (FENET) THEN 407 : if (.not.valeur) xiocad=xiocad-5*clx 408 : if (valeur) xiocad=xiocad-10*clx 409 : endif 410 : yiocad=yiocad-2*clx 411 : XRAP=xIOCAD/(XXAX-XMIN)*0.95 412 : YRAP=yIOCAD/(YYAX-YMIN)*0.95 413 : rap=min(xrap,yrap) 414 : if (fenet) then 415 : xrap=rap 416 : yrap=rap 417 : endif 418 : IF (FENET) THEN 419 : if (.not.valeur) xiocad=xiocad+5*clx 420 : if (valeur) xiocad=xiocad+10*clx 421 : endif 422 : yiocad=yiocad+2*clx 423 : XDEP=-XMIN + (xxax-xmin)*0.02 424 : YDEP=-YMIN + (YYAX-YMIN)*0.02+CLX/YRAP 425 : 426 : c on commence par se positionner 427 : write (iups,fmt='(''0. CX 0. CX MX'')') 428 : NBC=LTITRE 429 : XCO=NBC*CLX/XRAP 430 : YCO=0 431 : c options de CCTRACE 432 : ANGLE=0.d0 433 : IALIGN=0 434 : 435 : c on traite ensuite le titre (traitement caractere par caractere) 435 : CALL CHAIPS(TITRE,LTITRE) 436 : 437 : RETURN 438 : ** 439 : 440 : C====================================================================== 441 : C ECRITURE TEXTE (ENTETE & VALEURS LEGENDE ...) : sTRLAB ou CTRLAB 442 : C====================================================================== 443 : 444 : ENTRY sTRLAB(XT,YT,CARAC,NCARR,HAUT) 445 : * ECRITURE TEXT 446 : * ECRIT ENTETE & VALEURS LEGENDE ISOVALEURS 447 : if (icoul.ne.0) then 448 : write (IUPS,fmt='(''CN'')') 449 : icoul=0 450 : endif 451 : ENTRY cTRLAB(XT,YT,CARAC,NCARR,HAUT) 452 : NBC=LONG(CARAC(1:NCARR)) 453 : C JYYYY Debut 454 : c on commence par se positionner 455 : write (IUPS,fmt='(F6.3,'' CX '',F6.3,'' CX MX '')') 456 : # BORNEX((XDEP+XT)*XRAP),BORNEY((YDEP+YT)*YRAP) 457 : c c on remplit CHAINE 458 : c CHAINE(1:1)='(' 459 : c CHAINE(2:NBC+1)=CARAC(1:NBC) 460 : c CHAINE(nbc+2:nbc+5)=') SX' 461 : c c on ecrit CHAINE 462 : c write (iups,970) chaine(1:nbc+5) 463 : c 970 format (a) 464 : C JYYYY Fin 465 : c on traite ensuite le texte (traitement caractere par caractere) 465 : CALL CHAIPS(CARAC,NBC) 466 : RETURN 467 : ** 468 : 469 : C====================================================================== 470 : C CHANGEMENT DE COULEUR : sCHCOU ou cCHCOU 471 : C====================================================================== 472 : 473 : ENTRY sCHCOU(JCOLO) 474 : * CHANGEMENT DE COULEUR 475 : 476 : kcoul=itb(mod(jcolo,16)+1) 477 : RETURN 478 : ENTRY cCHCOU(JCOLO) 479 : kcoul=itb(mod(jcolo,16)+1) 480 : if (icoul.ne.-kcoul) then 481 : cha='(''D'//ctb(kcoul:kcoul)//''')' 482 : write (IUPS,fmt=cha) 483 : icoul=kcoul 484 : endif 485 : RETURN 486 : ** 487 : 488 : C====================================================================== 489 : C CHANGEMENT SEGMENT : sINSEG ou cINSEG --> IGNORE 490 : C====================================================================== 491 : 492 : ENTRY sINSEG(JSEG,IRESS) 493 : ENTRY cINSEG(JSEG,IRESS) 494 : * CHANGEMENT SEGMENT IGNORE 495 : RETURN 496 : ** 497 : 498 : C====================================================================== 499 : C tracé de POLYLINE (LIGNES) : sPOLRL ou cPOLRL 500 : C====================================================================== 501 : 502 : ENTRY sPOLRL(NTRSTU,XTR,YTR) 503 : * POLYLINE 504 : if (icoul.ne.0) then 505 : write (IUPS,fmt='(''CN'')') 506 : icoul=0 507 : endif 508 : ENTRY cPOLRL(NTRSTU,XTR,YTR) 509 : C JYYY Debut 510 : IF ( NTRSTU .LE. 1 ) RETURN 511 : write (IUPS,fmt='(40(I4,1X))') 512 : # (IORNCX((XTR(I)+XDEP)*XRAP),IORNCY((YTR(I)+YDEP)*YRAP), 513 : # I=1,NTRSTU-1) 514 : write (IUPS,fmt='(I2,1X,I4,1X,I4,'' DL'')') (NTRSTU-1), 515 : # IORNCX((XTR(NTRSTU)+XDEP)*XRAP),IORNCY((YTR(NTRSTU)+YDEP)*YRAP) 516 : C JYYY Fin 517 : RETURN 518 : ** 519 : 520 : C====================================================================== 521 : C tracé de FACETTE : sTRFAC ou cTRFAC 522 : C====================================================================== 523 : 524 : ENTRY sTRFAC(NTRSTU,XTR,YTR,ZN,ICOLE,IEFF) 525 : * FACETTE 526 : C JYYY Debut 527 : IF ( NTRSTU .LE. 1 ) RETURN 528 : C JYYY Fin 529 : kcoul=itb(icole+1) 530 : if (icoul.ne.kcoul) then 531 : cha='(''C'//ctb(kcoul:kcoul)//''')' 532 : write (IUPS,fmt=cha) 533 : icoul=kcoul 534 : endif 535 : goto 100 536 : ENTRY cTRFAC(NTRSTU,XTR,YTR,ZN,ICOLE,IEFF) 537 : C JYYY Debut 538 : IF ( NTRSTU .LE. 1 ) RETURN 539 : C JYYY Fin 540 : kcoul=itb(icole+1) 541 : if (icoul.ne.kcoul) then 542 : cha='(''D'//ctb(kcoul:kcoul)//''')' 543 : write (IUPS,fmt=cha) 544 : icoul=kcoul 545 : endif 546 : 100 continue 547 : C JYYY Debut 548 : write (IUPS,fmt='(40(I4,1X))') 549 : # (IORNCX((XTR(I)+XDEP)*XRAP),IORNCY((YTR(I)+YDEP)*YRAP), 550 : # I=1,NTRSTU-1) 551 : write (IUPS,fmt='(I2,1X,I4,1X,I4,'' DS'')') (NTRSTU-1), 552 : # IORNCX((XTR(NTRSTU)+XDEP)*XRAP),IORNCY((YTR(NTRSTU)+YDEP)*YRAP) 553 : C JYYY Fin 554 : IEFF=1 555 : RETURN 556 : ** 557 : 558 : C====================================================================== 559 : C tracé de ??? : sTRAIS ou sTRAIS 560 : C====================================================================== 561 : 562 : ENTRY sTRAIS(NP,XTR,YTR,ICOLE) 563 : * FACETTE 564 : C JYYY Debut 565 : IF ( NP .LE. 1 ) RETURN 566 : C JYYY Fin 567 : if (miso.lt.16) then 568 : kcoul=itb(icole+1) 569 : if (icoul.ne.kcoul) then 570 : cha='(''c'//ctb(kcoul:kcoul)//''')' 571 : write (IUPS,fmt=cha) 572 : icoul=-kcoul 573 : endif 574 : else 575 : kcoul=icole 576 : cha='(''e'//ctc(kcoul:kcoul)//''')' 577 : write (IUPS,fmt=cha) 578 : icoul=-kcoul 579 : endif 580 : goto 101 581 : ENTRY cTRAIS(NP,XTR,YTR,ICOLE) 582 : C JYYY Debut 583 : IF ( NP .LE. 1 ) RETURN 584 : C JYYY Fin 585 : if (miso.lt.16) then 586 : kcoul=itb(icole+1) 587 : if (icoul.ne.kcoul) then 588 : cha='(''d'//ctb(kcoul:kcoul)//''')' 589 : write (IUPS,fmt=cha) 590 : icoul=-32000 591 : endif 592 : else 593 : kcoul=icole 594 : cha='(''f'//ctc(kcoul:kcoul)//''')' 595 : write (IUPS,fmt=cha) 596 : icoul=-32000 597 : endif 598 : 101 continue 599 : C JYYY Debut 600 : write (IUPS,fmt='(40(I4,1X))') 601 : # (IORNCX((XTR(I)+XDEP)*XRAP),IORNCY((YTR(I)+YDEP)*YRAP), 602 : # I=1,NP-1) 603 : if (np.gt.2) 604 : # write (IUPS,fmt='(I2,1X,I4,1X,I4,'' DS'')') (NP-1), 605 : # IORNCX((XTR(NP)+XDEP)*XRAP),IORNCY((YTR(NP)+YDEP)*YRAP) 606 : if (np.eq.2) 607 : # write (IUPS,fmt='(I2,1X,I4,1X,I4,'' DL'')') (NP-1), 608 : # IORNCX((XTR(NP)+XDEP)*XRAP),IORNCY((YTR(NP)+YDEP)*YRAP) 609 : C JYYY Fin 610 : RETURN 611 : ** 612 : 613 : C====================================================================== 614 : C DIGITALISATION DE POINT : sTRDIG ou cTRDIG --> IGNORE 615 : C====================================================================== 616 : 617 : ENTRY sTRDIG(XRO,XCOL,ICLE) 618 : ENTRY cTRDIG(XRO,XCOL,ICLE) 619 : * DIGITALISATION DE POINT IGNORE 620 : ICLE=0 621 : RETURN 622 : ** 623 : ENTRY sTRAFF(ICLE) 624 : ENTRY cTRAFF(ICLE) 625 : * FIN DE DESSIN 626 : ipag=ipag+1 627 : write (IUPS,956) 628 : 956 format ('EndPage') 629 : C write (IUPS,960) 630 : C 960 format ('end') 631 : icoul=0 632 : ICLE=0 633 : RETURN 634 : ** 635 : 636 : C====================================================================== 637 : C MENU : sMENU ou cMENU --> IGNORE 638 : C====================================================================== 639 : 640 : ENTRY sMENU(LEGEND,NCASE,LLONG) 641 : ENTRY cMENU(LEGEND,NCASE,LLONG) 642 : * MENU IGNORE 643 : RETURN 644 : ** 645 : ENTRY sTRANI(ITYPI,NBIMAH) 646 : ENTRY cTRANI(ITYPI,NBIMAH) 647 : * ANIMATION IGNOREE 648 : RETURN 649 : ** 650 : ENTRY sTRIMA(IMAGI) 651 : ENTRY cTRIMA(IMAGI) 652 : * IMAGE IGNOREE 653 : RETURN 654 : ** 655 : 656 : C====================================================================== 657 : C CHANGEMENT DE VIEW 658 : C====================================================================== 659 : 660 : ENTRY sFVALI(IFENI,IRESU,NH,NISO) 661 : ENTRY cFVALI(IFENI,IRESU,NH,NISO) 662 : * CHANGEMENT DE VIEW PORT 663 : * TRACE COULEURS LEGENDE ISOVALEURS 664 : * XDEP,YDEP : coin bas gauche de la legende 665 : IF (IFENI.EQ.1) THEN 666 : XRAP=CLX*10/0.95 667 : YRAP=clx*2/0.95 668 : XDEP=(xiocad-10*clx)/xrap 669 : YDEP=-1.323 670 : ENDIF 671 : NH=31 672 : MISO=NISO 673 : if (ifeni.eq.1) return 674 : * definition dynamique des couleurs 675 : if (niso.gt.15) then 676 : do 10 i=1,niso 677 : bw=0.9-i/(2.*niso) 678 : write (iups,700) ctc(i:i),bw 679 : 700 format('/e',A1,' {',f6.3,' setgray } def') 680 : 10 continue 681 : do 20 i=1,niso/3 682 : rouge=0 683 : vert=3.*i/niso 684 : bleu=1 685 : write (iups,710) ctc(i:i),rouge,vert,bleu 686 : 710 format('/f',A1,' {',3f7.4,' setrgbcolor } def') 687 : 20 continue 688 : do 21 i=niso/3+1,niso/2 689 : rouge=0 690 : vert=1 691 : bleu=(3.*niso-6.*i)/niso 692 : write (iups,710) ctc(i:i),rouge,vert,bleu 693 : 21 continue 694 : do 22 i=niso/2+1,(2*niso)/3 695 : rouge=(6.*i-3.*niso)/niso 696 : vert=1 697 : bleu=0 698 : write (iups,710) ctc(i:i),rouge,vert,bleu 699 : 22 continue 700 : do 23 i=(2*niso)/3+1,niso 701 : rouge=1 702 : vert=(3.*niso-3.*i)/niso 703 : bleu=0 704 : write (iups,710) ctc(i:i),rouge,vert,bleu 705 : 23 continue 706 : endif 707 : RETURN 708 : ** 709 : ENTRY sZOOM(IZOOM,XMI,XMA,YMI,YMA) 710 : ENTRY cZOOM(IZOOM,XMI,XMA,YMI,YMA) 711 : * IGNOREE 712 : RETURN 713 : ** 714 : ENTRY sINIt(IRESU,ISORT,IQUALI,INUMNO,INUMEL,XMI,XMA,YMI,YMA) 715 : ENTRY cINIt(IRESU,ISORT,IQUALI,INUMNO,INUMEL,XMI,XMA,YMI,YMA) 716 : * RETOUR AU DESSIN INITIAL IGNORE 717 : RETURN 718 : ** 719 : ENTRY sCHANG(IRESU,ISORT,ICHANG,JSEG) 720 : ENTRY cCHANG(IRESU,ISORT,ICHANG,JSEG) 721 : * AFFICHAGE DESAFFICHAGE NUM NOEUDS ELEMENTS QUAL IGNORE 722 : RETURN 723 : ** 724 : ENTRY sTRBOX(HAUTX,HAUTY) 725 : ENTRY cTRBOX(HAUTX,HAUTY) 726 : * INUTILISE 727 : RETURN 728 : ** 729 : ENTRY sTREFF 730 : ENTRY cTREFF 731 : * INUTILISE 732 : RETURN 733 : ** 734 : ENTRY sVAL(IRESU,ISORT,NISO) 735 : ENTRY cVAL(IRESU,ISORT,NISO) 736 : * INUTILISE 737 : RETURN 738 : ** 739 : ENTRY sMAJSE(IMAJ,IRESU,IQUALI,INUMNO,INUMEL) 740 : ENTRY cMAJSE(IMAJ,IRESU,IQUALI,INUMNO,INUMEL) 741 : * INUTILISE 742 : RETURN 743 : ** 744 : ** 745 : ENTRY sIMPR 746 : ENTRY cIMPR 747 : * INUTILISE 748 : RETURN 749 : ** 750 : ENTRY sTRTIN 751 : ENTRY cTRTIN 752 : * INUTILISE 753 : RETURN 754 : ** 755 : ENTRY sFLGI 756 : ENTRY cFLGI 757 : * INUTILISE 758 : RETURN 759 : ** 760 : ENTRY sTRMES(CARAC) 761 : ENTRY cTRMES(CARAC) 762 : * INUTILISE 763 : RETURN 764 : ** 765 : ENTRY sTRGET(PROMPT,REPLY) 766 : ENTRY cTRGET(PROMPT,REPLY) 767 : * INUTILISE 768 : RETURN 769 : ENTRY sTRMFI 770 : ENTRY cTRMFI 771 : * INUTILISE 772 : RETURN 773 : END 774 : 775 : 776 : 777 : 778 : 779 : 780 : 781 : 782 : 783 : 784 : 785 : 786 : 787 : 788 :
© Cast3M 2003 - All rights reserved.
Disclaimer