C OPTDES SOURCE OF166741 25/02/20 21:17:20 12165 SUBROUTINE OPTDES (IOPTIO,NOL,AXE,TITRE,TXTIT,TXAXE,TYAXE, & TTXX,TTXXX,TTYY,TTYYY,ZAXES,ZSEPAR,ZOPTIO,ZLEGEN,IEV, & DYN,NDIMT,CUR,NDIMT2,NC,INBEVO,ZMIMA,ZDATE,YMINI,YMAXI, & IPOSI,XPOSI,YPOSI,IGRIL) *============================================================= * * TESTS POUR L'EVOLUTION DE DESSIN * *============================================================= * * Modifications : * * 05 sept. 2007 Maugis * Maintien du segment AXE actif en modification * *============================================================= * * Entrée : Cf. dessin.eso * *============================================================= IMPLICIT LOGICAL (Z) IMPLICIT INTEGER (I-N) IMPLICIT REAL*8 (A-H,O-S,U-Y) -INC PPARAM -INC CCOPTIO -INC CCREEL -INC SMEVOLL -INC SMLREEL -INC CCGEOME -INC TMAXE -INC SMTABLE CHARACTER*(*) TITRE,TXTIT,TXAXE,TYAXE CHARACTER*(LOCHAI) BUFFER,CHOPT,TITOPT,TITOP2 C CHARACTER*(LOCHAI) TIME CHARACTER*8 CTYPE,CHVIDE,ETYPE,MTYPI,MTYPR,CHARR c LOGICAL VALEUR LOGICAL ZGRIL1,ZREMP2 REAL RXDIM,RYDIM,HMIN SEGMENT DYN LOGICAL ZTRACE(NDIMT) ENDSEGMENT SEGMENT CUR LOGICAL ZCUR(NDIMT2) ENDSEGMENT NOL = 25 ETYPE ='ENTIER ' CHVIDE =' ' ZREMP2 =.FALSE. *============================================================= * MARGE PROPORTIONNELLE A LA GRADUATION DE LA FENETRE USER *============================================================= * SEGACT AXE*MOD D=ABS(XSUP-XINF) IF (ZCARRE) THEN BG=0.14*REAL(D) BD=0.55*REAL(D) ELSE BG=0.10*REAL(D) BD=0.10*REAL(D) ENDIF D=ABS(YSUP-YINF) BH=0.08*REAL(D) BB=0.13*REAL(D) *============================================================= * DEFINITION FENETRE *============================================================= * c DIOCAD = taille du cadre include CCOPTIO XDIM = DIOCAD * .9D0*29.D0 / 30.D0 *1.134D0 YDIM = DIOCAD * .9D0*21.D0 / 30.D0 *1.08D0 IF (XSUP.LE.XINF) GOTO 950 IF (YSUP.LE.YINF) GOTO 950 RXDIM=XDIM RYDIM=YDIM IF (TXTIT.NE.' ') TITRE=TXTIT NCOUMA=NBCOUL c appel a trinit pour definir les bonnes ENTRY selon IOGRA CALL TRINIT (NOL,RXDIM,RYDIM,TITRE,.15,.false.,NCOUMA) c definition de la fenetre TTX1=REAL(XINF)-BG TTX2=REAL(XSUP)+BD TTX3=REAL(YINF)-BB TTX4=REAL(YSUP)+BH CALL DFENET (TTX1,TTX2,TTX3,TTX4,-1.,+1.,TTXX,TTXXX,TTYY,TTYYY, > .FALSE.) XX =DBLE(TTXX) XXX=DBLE(TTXXX) YY =DBLE(TTYY) YYY=DBLE(TTYYY) IF (TXAXE.NE.' ') TITREX=TXAXE IF (TYAXE.NE.' ') TITREY=TYAXE *============================================================= * CONSTRUCTION DE L'AXE *============================================================= CALL TRBOX(0.7,0.7) CALL DAXES(AXE,ZAXES,IGRIL) CALL TRBOX(1./0.7,1./0.7) *============================================================= * AFFICHAGES DIVERS *============================================================= * * AFFICHAGE DU MINIMUM ET DU MAXIMUM * IF (ZMIMA) THEN CALL TRBOX(0.7,0.7) TYY=REAL(YSUP)+BH/4. TXX=REAL(XINF+(XSUP-XINF)*2.D0/3.D0) BUFFER(1:10)='MINIMUM : ' WRITE (BUFFER(11:21),FMT='(G11.4)') YMINI CALL TRLABL (TXX,TYY,0.,BUFFER,21,HMIN) BUFFER(1:10)='MAXIMUM : ' TYY=YSUP+(BH/1.8) TXX=XINF+(XSUP-XINF)*2/3 WRITE (BUFFER(11:21),FMT='(G11.4)') YMAXI CALL TRLABL (TXX,TYY,0.,BUFFER,21,HMIN) CALL TRBOX(1./0.7,1./0.7) ENDIF * * AFFICHAGE DE LA DATE * IF (ZDATE) THEN CALL GIBDAT(JOUR,MOIS,IANNEE) iannee=mod(iannee,100) **TC TIME=FDATE() BUFFER(1:22)=' / /20 ' WRITE (BUFFER(4:5),FMT='(I2)') JOUR WRITE (BUFFER(7:8),FMT='(I2)') MOIS WRITE (BUFFER(12:13),FMT='(I2)') IANNEE **TC WRITE (BUFFER(15:22),FMT='(A8)') TIME(12:20) cbp : cette position ne me semble pas tres esthetique .... c TXX=TTXXX-0.98*(TTXXX-TTXX) c TYY=TTYY +0.02*(TTYYY-TTYY) IF (ZCARRE) THEN TXX=REAL(XSUP)-(13.5*.017*(XSUP-XINF)) ELSE TXX=REAL(XSUP)-(14.*.011*(XSUP-XINF)) ENDIF TYY=REAL(YSUP)+(.05*(YSUP-YINF)) CALL TRBOX(0.8,0.8) CALL TRLABL(TXX,TYY,0.,BUFFER(1:22),22,HMIN) CALL TRBOX(1./0.8,1./0.8) ENDIF *============================================================= * TRACE DES COURBES *============================================================= MEVOLL=IEV CALL ACTOBJ('EVOLUTION',MEVOLL,1) IF (IERR.NE.0) RETURN CTYPE(1:8)=' ' NCT=0 NLG=0 * * TRACES SEPARES ==================================== * IF (ZSEPAR) THEN IPTR=IEVOLL(NC) KEVOLL=IPTR * * RECHERCHE EVENTUELLE DES PARAMETRES SPECIFIQUES * IF (ZOPTIO) THEN CALL ACCTAB(IOPTIO,ETYPE,NC,X,CHVIDE,Z,II,CTYPE,ILG,XX,CHOPT, # ZZ,III) IF (CTYPE(1:3).NE.'MOT') CHOPT='''' c valeurs par defaut IF(KEVTEX(1:4).EQ.' ') THEN TITOPT='PAS DE LEGENDE' ELSE TITOPT=KEVTEX ENDIF IDEB1=0 IFIN1=IGRAND ISTYL=0 c variables bidons IVALI=0 XVALI=0.D0 IRETI=0 IVALR=0 XVALR=0.D0 IRETR=0 MTYPI='MOT ' MTYPR=' ' ITITOP=0 CHARR=' ' c lecture d'un titre de legende CALL ACCTAB(IOPTIO,MTYPI,IVALI,X,'TITRE',.TRUE.,IRETI, * MTYPR,IVALR,XVALR,CHARR,ZZ,IRETR) IF(MTYPR(1:5).EQ.'TABLE')THEN MTAB1=IRETR CTYPE(1:8)=' ' CALL ACCTAB(MTAB1,ETYPE,NC,X,CHVIDE,Z,II,CTYPE,ILG,XX, # TITOP2, ZZ,III) IF(CTYPE(1:3).EQ.'MOT')TITOPT=TITOP2 ENDIF c lecture des points initial et final --> IDEB1 et IFIN1 MTYPR=' ' CALL ACCTAB(IOPTIO,MTYPI,IVALI,X,'INITIAL',.TRUE.,IRETI, * MTYPR,IVALR,XVALR,CHARR,ZZ,IRETR) IF(MTYPR(1:5).EQ.'TABLE')THEN MTAB1=IRETR CTYPE(1:8)=' ' CALL ACCTAB(MTAB1,ETYPE,KK,X,CHVIDE,Z,II, # CTYPE,IDEB1,XX,CHARR,ZZ,III) IF(CTYPE(1:6).NE.'ENTIER')IDEB1=0 ENDIF MTYPR=' ' CALL ACCTAB(IOPTIO,MTYPI,IVALI,X,'FINAL',.TRUE.,IRETI, * MTYPR,IVALR,XVALR,CHARR,ZZ,IRETR) IF(MTYPR(1:5).EQ.'TABLE')THEN MTAB1=IRETR CTYPE(1:8)=' ' CALL ACCTAB(MTAB1,ETYPE,KK,X,CHVIDE,Z,II, # CTYPE,IFIN1,XX,CHARR,ZZ,III) IF(CTYPE(1:6).NE.'ENTIER')IFIN1=IGRAND ENDIF c lecture d un type de trait variable MTYPR=' ' CALL ACCTAB(IOPTIO,MTYPI,IVALI,X,'LIGNE_VARIABLE',.TRUE. * ,IRETI,MTYPR,IVALR,XVALR,CHARR,ZZ,IRETR) IF(MTYPR(1:5).EQ.'TABLE')THEN MTAB1=IRETR CTYPE(1:8)=' ' CALL ACCTAB(MTAB1,ETYPE,KK,X,CHVIDE,Z,II, # CTYPE,IVALR,XVALR,CHARR,ZZ,ISTYL) IF(CTYPE(1:8).NE.'LISTENTI') ISTYL=0 ENDIF ELSE LSTY1 = LSTYL MMAR1 = MMARQ KTAI1 = KTAIL CALL STYDES(LSTY1,MMAR1,KTAI1,CHOPT) IF(KEVTEX(1:4).EQ.' ') THEN TITOPT='PAS DE LEGENDE' ELSE TITOPT=KEVTEX ENDIF IDEB1=0 IFIN1=IGRAND ISTYL=0 ENDIF *PM SEGDES AXE CALL TRBOX(0.7,0.7) CALL TREVOL (AXE,IPTR,CHOPT,TITOPT,ZLEGEN,NCT,NLG,INBEVO & ,IPOSI,XPOSI,YPOSI,ZREMP2,IDEB1,IFIN1,ISTYL) CALL TRBOX(1./0.7,1./0.7) *PM SEGACT AXE*MOD * * CAS DES CURVILIGNES * IF (ZCUR(NC+1)) THEN * On affiche le long de l'axe des abscisses, avec des marqueurs, * les noms des points nommés rencontrés *PM SEGDES AXE CALL TRBOX(0.7,0.7) IPTR=IEVOLL(NC+1) CALL TRCUR(AXE,IPTR) CALL TRBOX(1./0.7,1./0.7) *PM SEGACT AXE*MOD ENDIF * * * TRACES SIMULTANES ==================================== * ELSE KK=0 DO 49 I=1,INBEVO IF (ZTRACE(I)) THEN KK=KK+1 IPTR=IEVOLL(I) KEVOLL=IPTR * * RECHERCHE EVENTUELLE DES PARAMETRES SPECIFIQUES * IF (ZOPTIO) THEN c lecture des options (lign, marqueures etc...) --> CHOPT CTYPE(1:8)=' ' CALL ACCTAB(IOPTIO,ETYPE,KK,X,CHVIDE,Z,II,CTYPE,ILG,XX, # CHOPT,ZZ,III) IF (CTYPE(1:3).NE.'MOT') CHOPT=' ' c valeurs par defaut IF(KEVTEX(1:4).EQ.' ') THEN TITOPT='PAS DE LEGENDE' ELSE TITOPT=KEVTEX ENDIF IDEB1=0 IFIN1=IGRAND ISTYL=0 c variables bidons IVALI=0 XVALI=0.D0 IRETI=0 IVALR=0 XVALR=0.D0 IRETR=0 MTYPI='MOT ' MTYPR=' ' ITITOP=0 CHARR=' ' c lecture d'un titre de legende --> TITOPT CALL ACCTAB(IOPTIO,MTYPI,IVALI,X,'TITRE',.TRUE.,IRETI, * MTYPR,IVALR,XVALR,CHARR,ZZ,IRETR) IF(MTYPR(1:5).EQ.'TABLE')THEN MTAB1=IRETR c SEGACT MTAB1 CTYPE(1:8)=' ' CALL ACCTAB(MTAB1,ETYPE,KK,X,CHVIDE,Z,II,CTYPE,ILG,XX, # TITOP2,ZZ,III) IF(CTYPE(1:3).EQ.'MOT')TITOPT=TITOP2 ENDIF c lecture des points initial et final --> IDEB1 et IFIN1 MTYPR=' ' CALL ACCTAB(IOPTIO,MTYPI,IVALI,X,'INITIAL',.TRUE.,IRETI, * MTYPR,IVALR,XVALR,CHARR,ZZ,IRETR) IF(MTYPR(1:5).EQ.'TABLE')THEN MTAB1=IRETR CTYPE(1:8)=' ' CALL ACCTAB(MTAB1,ETYPE,KK,X,CHVIDE,Z,II, # CTYPE,IDEB1,XX,CHARR,ZZ,III) IF(CTYPE(1:6).NE.'ENTIER')IDEB1=0 ENDIF MTYPR=' ' CALL ACCTAB(IOPTIO,MTYPI,IVALI,X,'FINAL',.TRUE.,IRETI, * MTYPR,IVALR,XVALR,CHARR,ZZ,IRETR) IF(MTYPR(1:5).EQ.'TABLE')THEN MTAB1=IRETR CTYPE(1:8)=' ' CALL ACCTAB(MTAB1,ETYPE,KK,X,CHVIDE,Z,II, # CTYPE,IFIN1,XX,CHARR,ZZ,III) IF(CTYPE(1:6).NE.'ENTIER')IFIN1=IGRAND ENDIF c lecture d un type de trait variable MTYPR=' ' CALL ACCTAB(IOPTIO,MTYPI,IVALI,X,'LIGNE_VARIABLE',.TRUE. * ,IRETI,MTYPR,IVALR,XVALR,CHARR,ZZ,IRETR) IF(MTYPR(1:5).EQ.'TABLE')THEN MTAB1=IRETR CTYPE(1:8)=' ' CALL ACCTAB(MTAB1,ETYPE,KK,X,CHVIDE,Z,II, # CTYPE,IVALR,XVALR,CHARR,ZZ,ISTYL) IF(CTYPE(1:8).NE.'LISTENTI') ISTYL=0 ENDIF ELSE LSTY1 = LSTYL MMAR1 = MMARQ KTAI1 = KTAIL CALL STYDES(LSTY1,MMAR1,KTAI1,CHOPT) IF(KEVTEX(1:4).EQ.' ') THEN TITOPT='PAS DE LEGENDE' ELSE TITOPT=KEVTEX ENDIF IDEB1=0 IFIN1=IGRAND ISTYL=0 ENDIF *PM SEGDES AXE CALL TRBOX(0.7,0.7) CALL TREVOL (AXE,IPTR,CHOPT,TITOPT,ZLEGEN,NCT,NLG,INBEVO & ,IPOSI,XPOSI,YPOSI,ZREMP2,IDEB1,IFIN1,ISTYL) CALL TRBOX(1./0.7,1./0.7) *PM SEGACT AXE*MOD ENDIF * * CAS DES CURVILIGNES * IF (ZCUR(I)) THEN * On affiche le long de l'axe des abscisses, avec des marqueurs, * les noms des points nommés rencontrés *PM SEGDES AXE CALL TRBOX(0.7,0.7) IPTR=IEVOLL(I) CALL TRCUR(AXE,IPTR) CALL TRBOX(1./0.7,1./0.7) *PM SEGACT AXE*MOD ENDIF 49 CONTINUE * ENDIF C SEGDES MEVOLL *============================================================= * On redessine les axes sans grille pour repasser sur d'éventuelles * ombres *============================================================= IF(ZREMP2) THEN CALL TRBOX(0.7,0.7) ZGRIL1=ZGRILL ZGRILL=.FALSE. CALL DAXES(AXE,ZAXES,IGRIL) ZGRILL=ZGRIL1 CALL TRBOX (1./0.7,1./0.7) ENDIF RETURN * L'intervalle entre les bornes est trop faible. 950 CALL ERREUR (497) END