1 : C OBTENI SOURCE CHAT 06/03/16 21:23:22 5336 2 : SUBROUTINE OBTENI 3 : IMPLICIT INTEGER(I-N) 4 : -INC CCNOYAU 5 : -INC CCOPTIO 6 : -INC CCREDLE 7 : -INC SMLENTI 8 : -INC SMLREEL 9 : -INC CCASSIS 10 : CHARACTER*(8) CHAR,CHARB,CNOMP 11 : CHARACTER*(72) CHARC 12 : CHARACTER*4 MOAST(1) 13 : LOGICAL LOGI 14 : CHARACTER*500 CMTEXT 15 : REAL*8 XPO 16 : CHARACTER*26 MINU,MAJU 17 : DATA MINU/'abcdefghijklmnopqrstuvwxyz'/ 18 : DATA MAJU/'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ 19 : DATA MOAST/'* '/ 20 : IPASS=1 21 : 1 CONTINUE 21 : CALL QUETYP (CHAR,IPASS,IRETOU) 22 : IF(IERR.NE.0) RETURN 23 : IF(IRETOU.EQ.0) GO TO 200 24 : IF(CHAR.EQ.'ENTIER ') THEN 24 : CALL LIRENT(IPO,1,IRETOU) 25 : ELSEIF(CHAR.EQ.'FLOTTANT')THEN 25 : CALL LIRREE(XPO,1,IRETOU) 26 : ELSEIF(CHAR.EQ.'MOT ')THEN 26 : CALL LIRCHA(CHAR,1,IRETOU) 27 : ELSEIF(CHAR.EQ.'LOGIQUE ')THEN 27 : CALL LIRLOG(LOGI,1,IRETOU) 28 : ELSE 28 : CALL LIROBJ(CHAR,IPO,1,IRETOU) 29 : ENDIF 29 : CALL QUENOM(CHARB) 29 : CALL LIRMOT(MOAST,1,IVAL,0) 30 : CHAR=' ' 31 : IF(IVAL.NE.0) THEN 31 : CALL LIRCHA(CHAR,1,IRETOU) 32 : IF(IERR.NE.0) RETURN 33 : ENDIF 34 : ICREA=0 35 : IF(IPASS.NE.1) GO TO 25 36 : C 37 : C *** SAUVETAGE DE LA LECTURE 38 : C 39 : * CMTEXT(1:500)=TEXT(1:500) 40 : * NRAN1=NRAN 41 : * ICOUR1=ICOUR 42 : * IFINA1=IFINAN 43 : * IPREC1=IPREC 43 : call inired(sredle) 44 : NRAN= 0 45 : IPREC=1 46 : 20 CONTINUE 47 : NRAN=0 48 : IFINAN=73 49 : ICOUR=72 50 : READ(IOTER,FMT='(A72)',END=21) TEXT(1:72) 50 : 25 CALL REDLEC(sredle) 51 : IF(IRE.EQ.0.AND.CHAR.EQ.'LISTENTI') THEN 52 : MOTERR(1:8) ='LISTENTI' 52 : CALL ERREUR(-290) 53 : READ(IOTER,FMT='(A72)',END=21) TEXT(1:72) 54 : NRAN=0 55 : IFINAN=73 56 : ICOUR=72 56 : CALL REDLEC(sredle) 57 : IF(IRE.EQ.0) THEN 58 : SEGDES MLENTI 58 : CALL NOMOBJ(CHAR,CHARB,MLENTI) 59 : GO TO 200 60 : ENDIF 61 : ENDIF 62 : IF(IRE.EQ.0.AND.CHAR.EQ.'LISTREEL') THEN 63 : MOTERR(1:8) ='LISTREEL' 63 : CALL ERREUR(-290) 64 : READ(IOTER,FMT='(A72)',END=21) TEXT(1:72) 65 : NRAN=0 66 : IFINAN=73 67 : ICOUR=72 67 : CALL REDLEC(sredle) 68 : IF(IRE.EQ.0) THEN 69 : SEGDES MLREEL 69 : CALL NOMOBJ(CHAR,CHARB,MLREEL) 70 : GO TO 200 71 : ENDIF 72 : ENDIF 73 : IF(IRE.EQ.0) GO TO 21 74 : IAVA=0 75 : IF(IRE.EQ.3) THEN 76 : DO 123 IAUX=1,NCAR 77 : * PASSAGE EN MAJUSCULE 78 : IRAL=INDEX(MINU,MOT(IAUX:IAUX)) 79 : IF (IRAL.NE.0) MOT(IAUX:IAUX)=MAJU(IRAL:IRAL) 80 : 123 CONTINUE 81 : ENDIF 81 : CALL PRENOM(IPLAMO,IAVA,sredle) 82 : if(nbesc.ne.0) segact ipiloc 83 : IP= INOOB1(IPLAMO) 84 : IDEBCH=IPCHAR(IP) 85 : IFINCH=IPCHAR(IP+1)-1 86 : CNOMP=ICHARA(IDEBCH:IFINCH) 87 : IF(IIMPI.EQ.1754) WRITE(IOIMP,654) CNOMP 88 : # ,INOOB2(IPLAMO) 89 : 654 FORMAT(' DANS OBTENI OBJET(1.5) ',A8,2X,A8,2X,A4) 90 : IF(IIMPI.EQ.1754) WRITE(IOIMP,657)CHAR 91 : 657 FORMAT(' DANS OBTENI TYPE ATTENDU ',A8) 92 : if(nbesc.ne.0) segdes ipiloc 93 : 94 : C 95 : C **** DECODAGE DE LA LECTURE ET VERIF DU TYPE 96 : C 97 : IF(CNOMP.NE.'NON ') GO TO 31 98 : 210 CONTINUE 98 : CALL NOMCHA(CHARB,'NON') 99 : GO TO 200 100 : 31 CONTINUE 101 : IF(CHAR.EQ.' ') CHAR=INOOB2(IPLAMO) 102 : IF(CHAR.EQ.'FLOTTANT'.AND.INOOB2(IPLAMO).EQ.'ENTIER ') THEN 103 : IOO=IOUEP2(IPLAMO) 104 : XPO=IOO 104 : CALL NOMREE(CHARB,XPO) 105 : GO TO 465 106 : ENDIF 107 : IF(CHAR.EQ.'LISTREEL') THEN 108 : IF(ICREA.EQ.0) THEN 109 : JG=0 110 : SEGINI MLREEL 111 : ICREA=1 112 : ENDIF 113 : IF(INOOB2(IPLAMO) .NE . 'ENTIER '.AND. 114 : $ INOOB2(IPLAMO) .NE . 'FLOTTANT' ) GO TO 210 115 : IOO=IOUEP2(IPLAMO) 116 : IF (INOOB2(IPLAMO).EQ.'ENTIER ') THEN 117 : XPO=IOO 118 : ELSE 119 : if(nbesc.ne.0) segact ipiloc 120 : XPO= XIFLOT(IOO) 121 : if(nbesc.ne.0) segdes ipiloc 122 : ENDIF 123 : JG=JG+1 124 : SEGADJ MLREEL 125 : PROG(JG)=XPO 126 : GO TO 25 127 : ENDIF 128 : IF(CHAR.EQ.'LISTENTI') THEN 129 : IF(ICREA.EQ.0) THEN 130 : JG=0 131 : SEGINI MLENTI 132 : ICREA=1 133 : ENDIF 134 : IF(INOOB2(IPLAMO) .NE . 'ENTIER ') GO TO 210 135 : JG=JG+1 136 : SEGADJ MLENTI 137 : LECT(JG)=IOUEP2(IPLAMO) 138 : GO TO 25 139 : ENDIF 140 : IF(CHAR.NE.INOOB2(IPLAMO)) GO TO 50 141 : IOO=IOUEP2(IPLAMO) 142 : if(nbesc.ne.0) segact ipiloc 143 : IF(CHAR.EQ.'ENTIER ') THEN 144 : IVAL=IOO 144 : CALL NOMENT(CHARB,IVAL) 145 : ELSEIF(CHAR.EQ.'FLOTTANT') THEN 146 : XPO= XIFLOT(IOO) 146 : CALL NOMREE(CHARB,XPO) 147 : ELSEIF(CHAR.EQ.'MOT ') THEN 148 : ID=IPCHAR(IOO) 149 : IFI=IPCHAR(IOO+1) 150 : IF1=IFI-ID 151 : CHARC=' ' 152 : IF1=MIN(IF1,72) 153 : CHARC(1:IF1)=ICHARA(ID:IFI-1) 153 : CALL NOMCHA(CHARB,CHARC(1:IF1)) 154 : ELSEIF(CHAR.EQ.'LOGIQUE ') THEN 155 : LOGI=IPLOGI(IOO) 155 : CALL NOMLOG(CHARB,LOGI) 156 : ELSE 156 : CALL NOMOBJ(CHAR,CHARB,IOO) 157 : ENDIF 158 : if(nbesc.ne.0) segdes ipiloc 159 : 465 CONTINUE 160 : IPASS=0 161 : GO TO 1 162 : 50 CONTINUE 163 : WRITE(IOIMP,51) CHAR 164 : 51 FORMAT(' LA QUANTITE LUE N''EST PAS DU TYPE ',A8, 165 : #' RECOMMENCEZ S''IL VOUS PLAIT') 166 : GO TO 20 167 : 200 CONTINUE 168 : C-- ON REMET TEXT EN PLACE 169 : * TEXT(1:500)=CMTEXT(1:500) 170 : * IFINAN=IFINA1 171 : * IPREC=IPREC1 172 : * ICOUR=ICOUR1 173 : * NRAN=NRAN1 174 : segsup sredle 175 : RETURN 176 : 21 CONTINUE 177 : IF(IOGRA.EQ.3.OR.IOGRA.EQ.2) THEN 178 : REWIND IOTER 179 : GOTO 210 180 : ELSE 180 : CALL ERREUR ( 34 ) 181 : RETURN 182 : ENDIF 183 : END 184 :
© Cast3M 2003 - All rights reserved.
Disclaimer