1 : C OPTDES SOURCE BP208322 12/08/02 21:15:28 7468 2 : SUBROUTINE OPTDES (IOPTIO,NOL,AXE,TITRE,TXTIT,TXAXE,TYAXE, 3 : & TTXX,TTXXX,TTYY,TTYYY,ZAXES,ZSEPAR,ZOPTIO,ZLEGEN,IEV, 4 : & DYN,NDIMT,CUR,NDIMT2,NC,INBEVO,ZMIMA,ZDATE,YMINI,YMAXI, 5 : & IPOSI,XPOSI,YPOSI,IGRIL) 6 : *============================================================= 7 : * 8 : * TESTS POUR L'EVOLUTION DE DESSIN 9 : * 10 : *============================================================= 11 : * 12 : * Modifications : 13 : * 14 : * 05 sept. 2007 Maugis 15 : * Maintien du segment AXE actif en modification 16 : * 17 : *============================================================= 18 : * 19 : * Entrée : Cf. dessin.eso 20 : * 21 : *============================================================= 22 : 23 : IMPLICIT LOGICAL (Z) 24 : IMPLICIT INTEGER(I-N) 25 : IMPLICIT REAL*8 (A-H,O-S,U-Y) 26 : 27 : CHARACTER*72 TITRE,TXTIT,BUFFER,CHOPT,TIME 28 : CHARACTER*20 TXAXE,TYAXE,TITOPT 29 : c LOGICAL VALEUR 30 : REAL RXDIM,RYDIM,HMIN 31 : CHARACTER*8 CTYPE,CHVIDE,ETYPE,MTYPI,MTYPR,CHARR 32 : LOGICAL ZGRIL1 33 : 34 : -INC CCOPTIO 35 : -INC SMEVOLL 36 : -INC SMLREEL 37 : -INC CCGEOME 38 : -INC TMAXE 39 : -INC SMTABLE 40 : 41 : SEGMENT DYN 42 : LOGICAL ZTRACE(NDIMT) 43 : ENDSEGMENT 44 : SEGMENT CUR 45 : LOGICAL ZCUR(NDIMT2) 46 : ENDSEGMENT 47 : NOL=25 48 : ETYPE(1:8)='ENTIER ' 49 : CHVIDE(1:8)=' ' 50 : 51 : 52 : *============================================================= 53 : * MARGE PROPORTIONNELLE A LA GRADUATION DE LA FENETRE USER 54 : *============================================================= 55 : * 56 : SEGACT AXE*MOD 57 : 58 : D=DABS(XSUP-XINF) 59 : IF (ZCARRE) THEN 60 : BG=0.14*REAL(D) 61 : BD=0.55*REAL(D) 62 : ELSE 63 : BG=0.10*REAL(D) 64 : BD=0.10*REAL(D) 65 : ENDIF 66 : 67 : D=DABS(YSUP-YINF) 68 : BH=0.08*REAL(D) 69 : BB=0.13*REAL(D) 70 : 71 : 72 : *============================================================= 73 : * DEFINITION FENETRE 74 : *============================================================= 75 : * 76 : c DIOCAD = taille du cadre include CCOPTIO 77 : XDIM = DIOCAD * .9D0*29.D0 / 30.D0 *1.134D0 78 : YDIM = DIOCAD * .9D0*21.D0 / 30.D0 *1.08D0 79 : IF (XSUP.LE.XINF) GOTO 950 80 : IF (YSUP.LE.YINF) GOTO 950 81 : RXDIM=XDIM 82 : RYDIM=YDIM 83 : IF (TXTIT.NE.' ') TITRE=TXTIT 84 : NCOUMA=NBCOUL 85 : c appel a trinit pour definir les bonnes ENTRY selon IOGRA 85 : CALL TRINIT (NOL,RXDIM,RYDIM,TITRE,.15,.false.,NCOUMA) 86 : 87 : c definition de la fenetre 88 : TTX1=REAL(XINF)-BG 89 : TTX2=REAL(XSUP)+BD 90 : TTX3=REAL(YINF)-BB 91 : TTX4=REAL(YSUP)+BH 91 : CALL DFENET (TTX1,TTX2,TTX3,TTX4,-1.,+1.,TTXX,TTXXX,TTYY,TTYYY, 92 : > .FALSE.) 93 : XX=DBLE(TTXX) 94 : XXX=DBLE(TTXXX) 95 : YY=DBLE(TTYY) 96 : YYY=DBLE(TTYYY) 97 : IF (TXAXE.NE.' ') TITREX=TXAXE 98 : IF (TYAXE.NE.' ') TITREY=TYAXE 99 : 100 : 101 : *============================================================= 102 : * CONSTRUCTION DE L'AXE 103 : *============================================================= 104 : * 105 : *PM SEGDES AXE 105 : CALL TRBOX (0.7,0.7) 105 : CALL DAXES (AXE,ZAXES,IGRIL) 105 : CALL TRBOX (1./0.7,1./0.7) 106 : *PM SEGACT AXE*MOD 107 : 108 : 109 : *============================================================= 110 : * AFFICHAGES DIVERS 111 : *============================================================= 112 : * 113 : * AFFICHAGE DU MINIMUM ET DU MAXIMUM 114 : * 115 : IF (ZMIMA) THEN 115 : CALL TRBOX(0.7,0.7) 116 : TYY=REAL(YSUP)+BH/4. 117 : TXX=REAL(XINF+(XSUP-XINF)*2.D0/3.D0) 118 : BUFFER(1:10)='MINIMUM : ' 119 : WRITE (BUFFER(11:21),FMT='(G11.4)') YMINI 119 : CALL TRLABL (TXX,TYY,0.,BUFFER,21,HMIN) 120 : BUFFER(1:10)='MAXIMUM : ' 121 : TYY=YSUP+(BH/1.8) 122 : TXX=XINF+(XSUP-XINF)*2/3 123 : WRITE (BUFFER(11:21),FMT='(G11.4)') YMAXI 123 : CALL TRLABL (TXX,TYY,0.,BUFFER,21,HMIN) 123 : CALL TRBOX(1./0.7,1./0.7) 124 : ENDIF 125 : * 126 : * AFFICHAGE DE LA DATE 127 : * 128 : IF (ZDATE) THEN 128 : CALL GIBDAT(JOUR,MOIS,IANNEE) 129 : iannee=mod(iannee,100) 130 : **TC TIME=FDATE() 131 : BUFFER(1:22)=' / /20 ' 132 : WRITE (BUFFER(4:5),FMT='(I2)') JOUR 133 : WRITE (BUFFER(7:8),FMT='(I2)') MOIS 134 : WRITE (BUFFER(12:13),FMT='(I2)') IANNEE 135 : **TC WRITE (BUFFER(15:22),FMT='(A8)') TIME(12:20) 136 : cbp : cette position ne me semble pas tres esthetique .... 137 : c TXX=TTXXX-0.98*(TTXXX-TTXX) 138 : c TYY=TTYY +0.02*(TTYYY-TTYY) 139 : IF (ZCARRE) THEN 140 : TXX=REAL(XSUP)-(13.5*.017*(XSUP-XINF)) 141 : ELSE 142 : TXX=REAL(XSUP)-(14.*.011*(XSUP-XINF)) 143 : ENDIF 144 : TYY=REAL(YSUP)+(.05*(YSUP-YINF)) 144 : CALL TRBOX(0.8,0.8) 144 : CALL TRLABL(TXX,TYY,0.,BUFFER(1:22),22,HMIN) 144 : CALL TRBOX(1./0.8,1./0.8) 145 : ENDIF 146 : 147 : 148 : *============================================================= 149 : * TRACE DES COURBES 150 : *============================================================= 151 : * 152 : MEVOLL=IEV 153 : SEGACT MEVOLL 154 : CTYPE(1:8)=' ' 155 : NCT=0 156 : NLG=0 157 : * 158 : * TRACES SEPARES ==================================== 159 : * 160 : IF (ZSEPAR) THEN 161 : 162 : IPTR=IEVOLL(NC) 163 : * 164 : * RECHERCHE EVENTUELLE DES PARAMETRES SPECIFIQUES 165 : * 166 : IF (ZOPTIO) THEN 166 : CALL ACCTAB(IOPTIO,ETYPE,NC,X,CHVIDE,Z,II,CTYPE,ILG,XX,CHOPT, 167 : # ZZ,III) 168 : IF (CTYPE(1:3).NE.'MOT') CHOPT='''' 169 : TITOPT(1:20)=' ' 170 : IVALI=0 171 : XVALI=0.D0 172 : IRETI=0 173 : IVALR=0 174 : XVALR=0.D0 175 : IRETR=0 176 : MTYPI='MOT ' 177 : MTYPR=' ' 178 : ITITOP=0 179 : CHARR=' ' 179 : CALL ACCTAB(IOPTIO,MTYPI,IVALI,X,'TITRE',.TRUE.,IRETI, 180 : * MTYPR,IVALR,XVALR,CHARR,ZZ,IRETR) 181 : IF(MTYPR(1:5).EQ.'TABLE')THEN 182 : MTAB1=IRETR 183 : SEGACT MTAB1 184 : CTYPE(1:8)=' ' 184 : CALL ACCTAB(ITITOP,ETYPE,NC,X,CHVIDE,Z,II,CTYPE,ILG,XX, 185 : # TITOPT, ZZ,III) 186 : IF(CTYPE(1:3).NE.'MOT') TITOPT(1:20)='PAS DE LEGENDE' 187 : ENDIF 188 : ELSE 189 : CHOPT(1:72)=' ' 190 : TITOPT(1:20)=' ' 191 : ENDIF 192 : *PM SEGDES AXE 192 : CALL TRBOX(0.7,0.7) 192 : CALL TREVOL (AXE,IPTR,CHOPT,TITOPT,ZLEGEN,NCT,NLG,INBEVO 193 : & ,IPOSI,XPOSI,YPOSI) 194 : 194 : CALL TRBOX(1./0.7,1./0.7) 195 : *PM SEGACT AXE*MOD 196 : 197 : * 198 : * CAS DES CURVILIGNES 199 : * 200 : IF (ZCUR(NC+1)) THEN 201 : * On affiche le long de l'axe des abscisses, avec des marqueurs, 202 : * les noms des points nommés rencontrés 203 : *PM SEGDES AXE 203 : CALL TRBOX(0.7,0.7) 204 : IPTR=IEVOLL(NC+1) 204 : CALL TRCUR(AXE,IPTR) 204 : CALL TRBOX(1./0.7,1./0.7) 205 : *PM SEGACT AXE*MOD 206 : ENDIF 207 : * 208 : 209 : * 210 : * TRACES SIMULTANES ==================================== 211 : * 212 : ELSE 213 : 214 : KK=0 215 : DO 49 I=1,INBEVO 216 : 217 : IF (ZTRACE(I)) THEN 218 : 219 : KK=KK+1 220 : IPTR=IEVOLL(I) 221 : * 222 : * RECHERCHE EVENTUELLE DES PARAMETRES SPECIFIQUES 223 : * 224 : IF (ZOPTIO) THEN 225 : 226 : CTYPE(1:8)=' ' 226 : CALL ACCTAB(IOPTIO,ETYPE,KK,X,CHVIDE,Z,II,CTYPE,ILG,XX, 227 : # CHOPT,ZZ,III) 228 : 229 : IF (CTYPE(1:3).NE.'MOT') CHOPT=' ' 230 : TITOPT(1:20)=' ' 231 : IVALI=0 232 : XVALI=0.D0 233 : IRETI=0 234 : IVALR=0 235 : XVALR=0.D0 236 : IRETR=0 237 : MTYPI='MOT ' 238 : MTYPR=' ' 239 : ITITOP=0 240 : CHARR=' ' 240 : CALL ACCTAB(IOPTIO,MTYPI,IVALI,X,'TITRE',.TRUE.,IRETI, 241 : * MTYPR,IVALR,XVALR,CHARR,ZZ,IRETR) 242 : IF(MTYPR(1:5).EQ.'TABLE')THEN 243 : MTAB1=IRETR 244 : SEGACT MTAB1 245 : CTYPE(1:8)=' ' 245 : CALL ACCTAB(MTAB1,ETYPE,KK,X,CHVIDE,Z,II,CTYPE,ILG,XX, 246 : # TITOPT,ZZ,III) 247 : IF(CTYPE(1:3).NE.'MOT')TITOPT(1:20)=' ' 248 : ENDIF 249 : ELSE 250 : CHOPT(1:72)=' ' 251 : TITOPT(1:20)=' ' 252 : ENDIF 253 : *PM SEGDES AXE 253 : CALL TRBOX(0.7,0.7) 253 : CALL TREVOL (AXE,IPTR,CHOPT,TITOPT,ZLEGEN,NCT,NLG,INBEVO 254 : & ,IPOSI,XPOSI,YPOSI) 254 : CALL TRBOX(1./0.7,1./0.7) 255 : *PM SEGACT AXE*MOD 256 : ENDIF 257 : * 258 : * CAS DES CURVILIGNES 259 : * 260 : IF (ZCUR(I)) THEN 261 : * On affiche le long de l'axe des abscisses, avec des marqueurs, 262 : * les noms des points nommés rencontrés 263 : *PM SEGDES AXE 263 : CALL TRBOX(0.7,0.7) 264 : IPTR=IEVOLL(I) 264 : CALL TRCUR(AXE,IPTR) 264 : CALL TRBOX(1./0.7,1./0.7) 265 : *PM SEGACT AXE*MOD 266 : ENDIF 267 : 49 CONTINUE 268 : * 269 : ENDIF 270 : SEGDES MEVOLL 271 : 272 : *============================================================= 273 : * On redessine les axes sans grille pour repasser sur d'éventuelles 274 : * ombres 275 : *============================================================= 275 : CALL TRBOX (0.7,0.7) 276 : ZGRIL1=ZGRILL 277 : ZGRILL=.FALSE. 277 : CALL DAXES (AXE,ZAXES,IGRIL) 278 : ZGRILL=ZGRIL1 278 : CALL TRBOX (1./0.7,1./0.7) 279 : 280 : GOTO 1000 281 : 282 : * L'intervalle entre les bornes est trop faible. 282 : 950 CALL ERREUR (497) 283 : GOTO 1000 284 : 285 : 286 : 1000 CONTINUE 287 : *PM SEGDES AXE 288 : 289 : END 290 : 291 : 292 : 293 : 294 : 295 :
© Cast3M 2003 - All rights reserved.
Disclaimer