1 : C EVMANU SOURCE PASCAL 09/02/16 21:15:10 6282
2 : SUBROUTINE EVMANU(ICOUL)
3 : C=======================================================================
4 : C OPTION MANU DE L'OPERATEUR EVOL
5 : C
6 : C POUR RENTRER A LA MAIN UN OBJET DE TYPE EVOLUTION
7 : C (IL N Y AURA QU UNE SEULE EVOLUTION)
8 : C SYNTAXE :
9 : C
10 : C EV1= EVOL (COUL) MANU / ('CHAINE CARAC') / PRGX
11 : C ---- ----
12 : C / ('CHAINE CARAC') / PRGY ;
13 : C
14 : C
15 : C COUL : COULEUR DE LA COURBE (FACULTATIVE)
16 : C MOTXI : OBJET DE TYPE MOT
17 : C PRGX : LISTE DE REELS (ABSCISSES)
18 : C MOTYI : OBJET DE TYPE MOT
19 : C PRGY : LISTE DE REELS (ORDONNEES)
20 : C
21 : C CREATION : 01/10/86
22 : C PROGRAMMEUR : GUILBAUD
23 : C======================================================================
24 : IMPLICIT INTEGER(I-N)
25 : -INC CCOPTIO
26 : -INC SMEVOLL
27 : -INC SMLREEL
28 : -INC SMLMOTS
29 : -INC SMLENTI
30 : C
31 : CHARACTER*72 TI
32 : CHARACTER*12 MOTITR
33 : CHARACTER*8 ITBLAN
34 : CHARACTER*4 MTYP,LMOT(1)
35 : DIMENSION MOT(2)
36 : C
37 : LMOT(1)='TYPE'
38 : C
39 : SEGINI KEVOLL
40 : NOMEVX=' '
41 : NOMEVY=' '
42 : TYPX='LISTREEL'
43 : TYPY='LISTREEL'
44 : C
45 : C LECTURE OPTIONNELLE DU TYPE DE LA COURBE (NUMEVY) :
46 : IPLAC=0
47 : IMOT=0
47 : CALL LIRMOT(LMOT,1,IPLAC,0)
48 : IF (IPLAC.EQ.1) THEN
48 : CALL LIRCHA(MTYP,1,IMOT)
49 : IF (IMOT.EQ.0) RETURN
50 : ELSE
51 : MTYP='REEL'
52 : ENDIF
53 : C
54 : DO 20 J=1,2
55 : C *** TITRE SOUS FORME DE MOT
56 : MOTITR=' '
56 : CALL LIRCHA(MOTITR,0,IRETOU)
57 : IF(IRETOU.EQ.0) GOTO 12
58 : IF(J.EQ.1) NOMEVX=MOTITR
59 : IF(J.EQ.2) NOMEVY=MOTITR
60 : C *** LECTURE DE LA LISTREEL
61 : 12 CONTINUE
61 : CALL LIROBJ('LISTREEL',MOT(J),0,IRET)
62 : IF(IRET.EQ.1) GOTO 20
63 : IF( J.EQ.1) TYPX='LISTMOTS'
64 : IF( J.EQ.2) TYPY='LISTMOTS'
64 : CALL LIROBJ('LISTMOTS',MOT(J),0,IRET)
65 : IF(IRET.EQ.1) GOTO 20
66 : IF( J.EQ.1) TYPX='LISTENTI'
67 : IF( J.EQ.2) TYPY='LISTENTI'
67 : CALL LIROBJ('LISTENTI',MOT(J),0,IRET)
68 : IF(IRET.EQ.0) THEN
69 : MOTERR(1:8) = 'LISTREEL'
70 : MOTERR(9:16) = 'LISTMOTS'
71 : MOTERR(17:24) = 'LISTENTI'
71 : CALL ERREUR(471)
72 : GO TO 1000
73 : ENDIF
74 : 20 CONTINUE
75 : C
76 : MLREEL=MOT(1)
77 : IF(TYPX.EQ.'LISTREEL') THEN
78 : SEGACT MLREEL
79 : LX = PROG(/1)
80 : SEGDES MLREEL
81 : ELSEIF(TYPX.EQ.'LISTMOTS') THEN
82 : MLMOTS=MOT(1)
83 : SEGACT MLMOTS
84 : LX= MOTS(/2)
85 : SEGDES MLMOTS
86 : ELSEIF(TYPX.EQ.'LISTENTI') THEN
87 : MLENTI=MOT(1)
88 : SEGACT MLENTI
89 : LY=LECT(/1)
90 : SEGDES MLENTI
91 : ENDIF
92 : IF(TYPY.EQ.'LISTREEL') THEN
93 : MLREEL=MOT(2)
94 : SEGACT MLREEL
95 : LY = PROG(/1)
96 : SEGDES MLREEL
97 : ELSEIF(TYPY.EQ.'LISTMOTS') THEN
98 : MLMOTS=MOT(2)
99 : SEGACT MLMOTS
100 : LY= MOTS(/2)
101 : SEGDES MLMOTS
102 : ELSEIF(TYPY.EQ.'LISTENTI') THEN
103 : MLENTI=MOT(2)
104 : SEGACT MLENTI
105 : LX=LECT(/1)
106 : SEGDES MLENTI
107 : ENDIF
108 :
109 : IF(LX.NE.LY) THEN
109 : CALL ERREUR(263)
110 : C LES 2 PROGRESSIONS DOIVENT ETRE DE MEME LONGUEUR
111 : GOTO 1000
112 : ENDIF
113 : C
114 : N=1
115 : SEGINI MEVOLL
116 : IPVO=MEVOLL
117 : TI(1:72)=TITREE
118 : IEVTEX=TI
119 : ITYEVO='REEL'
120 : KEVTEX=TI
121 : IEVOLL(1)=KEVOLL
122 : IPROGX=MOT(1)
123 : IPROGY=MOT(2)
124 : NUMEVX=ICOUL
125 : NUMEVY=MTYP
126 : SEGDES KEVOLL,MEVOLL
126 : CALL ECROBJ('EVOLUTIO',IPVO)
127 : RETURN
128 : 1000 CONTINUE
129 : SEGSUP KEVOLL
130 : RETURN
131 : END
132 :
133 :
134 :
© Cast3M 2003 - All rights reserved.
Disclaimer