C OBTENI SOURCE CHAT 06/03/16 21:23:22 5336 SUBROUTINE OBTENI IMPLICIT INTEGER(I-N) -INC CCNOYAU -INC CCOPTIO -INC CCREDLE -INC SMLENTI -INC SMLREEL -INC CCASSIS CHARACTER*(8) CHAR,CHARB,CNOMP CHARACTER*(72) CHARC CHARACTER*4 MOAST(1) LOGICAL LOGI CHARACTER*500 CMTEXT REAL*8 XPO CHARACTER*26 MINU,MAJU DATA MINU/'abcdefghijklmnopqrstuvwxyz'/ DATA MAJU/'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ DATA MOAST/'* '/ IPASS=1 1 CONTINUE CALL QUETYP (CHAR,IPASS,IRETOU) IF(IERR.NE.0) RETURN IF(IRETOU.EQ.0) GO TO 200 IF(CHAR.EQ.'ENTIER ') THEN CALL LIRENT(IPO,1,IRETOU) ELSEIF(CHAR.EQ.'FLOTTANT')THEN CALL LIRREE(XPO,1,IRETOU) ELSEIF(CHAR.EQ.'MOT ')THEN CALL LIRCHA(CHAR,1,IRETOU) ELSEIF(CHAR.EQ.'LOGIQUE ')THEN CALL LIRLOG(LOGI,1,IRETOU) ELSE CALL LIROBJ(CHAR,IPO,1,IRETOU) ENDIF CALL QUENOM(CHARB) CALL LIRMOT(MOAST,1,IVAL,0) CHAR=' ' IF(IVAL.NE.0) THEN CALL LIRCHA(CHAR,1,IRETOU) IF(IERR.NE.0) RETURN ENDIF ICREA=0 IF(IPASS.NE.1) GO TO 25 C C *** SAUVETAGE DE LA LECTURE C * CMTEXT(1:500)=TEXT(1:500) * NRAN1=NRAN * ICOUR1=ICOUR * IFINA1=IFINAN * IPREC1=IPREC call inired(sredle) NRAN= 0 IPREC=1 20 CONTINUE NRAN=0 IFINAN=73 ICOUR=72 READ(IOTER,FMT='(A72)',END=21) TEXT(1:72) 25 CALL REDLEC(sredle) IF(IRE.EQ.0.AND.CHAR.EQ.'LISTENTI') THEN MOTERR(1:8) ='LISTENTI' CALL ERREUR(-290) READ(IOTER,FMT='(A72)',END=21) TEXT(1:72) NRAN=0 IFINAN=73 ICOUR=72 CALL REDLEC(sredle) IF(IRE.EQ.0) THEN SEGDES MLENTI CALL NOMOBJ(CHAR,CHARB,MLENTI) GO TO 200 ENDIF ENDIF IF(IRE.EQ.0.AND.CHAR.EQ.'LISTREEL') THEN MOTERR(1:8) ='LISTREEL' CALL ERREUR(-290) READ(IOTER,FMT='(A72)',END=21) TEXT(1:72) NRAN=0 IFINAN=73 ICOUR=72 CALL REDLEC(sredle) IF(IRE.EQ.0) THEN SEGDES MLREEL CALL NOMOBJ(CHAR,CHARB,MLREEL) GO TO 200 ENDIF ENDIF IF(IRE.EQ.0) GO TO 21 IAVA=0 IF(IRE.EQ.3) THEN DO 123 IAUX=1,NCAR * PASSAGE EN MAJUSCULE IRAL=INDEX(MINU,MOT(IAUX:IAUX)) IF (IRAL.NE.0) MOT(IAUX:IAUX)=MAJU(IRAL:IRAL) 123 CONTINUE ENDIF CALL PRENOM(IPLAMO,IAVA,sredle) if(nbesc.ne.0) segact ipiloc IP= INOOB1(IPLAMO) IDEBCH=IPCHAR(IP) IFINCH=IPCHAR(IP+1)-1 CNOMP=ICHARA(IDEBCH:IFINCH) IF(IIMPI.EQ.1754) WRITE(IOIMP,654) CNOMP # ,INOOB2(IPLAMO) 654 FORMAT(' DANS OBTENI OBJET(1.5) ',A8,2X,A8,2X,A4) IF(IIMPI.EQ.1754) WRITE(IOIMP,657)CHAR 657 FORMAT(' DANS OBTENI TYPE ATTENDU ',A8) if(nbesc.ne.0) segdes ipiloc C C **** DECODAGE DE LA LECTURE ET VERIF DU TYPE C IF(CNOMP.NE.'NON ') GO TO 31 210 CONTINUE CALL NOMCHA(CHARB,'NON') GO TO 200 31 CONTINUE IF(CHAR.EQ.' ') CHAR=INOOB2(IPLAMO) IF(CHAR.EQ.'FLOTTANT'.AND.INOOB2(IPLAMO).EQ.'ENTIER ') THEN IOO=IOUEP2(IPLAMO) XPO=IOO CALL NOMREE(CHARB,XPO) GO TO 465 ENDIF IF(CHAR.EQ.'LISTREEL') THEN IF(ICREA.EQ.0) THEN JG=0 SEGINI MLREEL ICREA=1 ENDIF IF(INOOB2(IPLAMO) .NE . 'ENTIER '.AND. $ INOOB2(IPLAMO) .NE . 'FLOTTANT' ) GO TO 210 IOO=IOUEP2(IPLAMO) IF (INOOB2(IPLAMO).EQ.'ENTIER ') THEN XPO=IOO ELSE if(nbesc.ne.0) segact ipiloc XPO= XIFLOT(IOO) if(nbesc.ne.0) segdes ipiloc ENDIF JG=JG+1 SEGADJ MLREEL PROG(JG)=XPO GO TO 25 ENDIF IF(CHAR.EQ.'LISTENTI') THEN IF(ICREA.EQ.0) THEN JG=0 SEGINI MLENTI ICREA=1 ENDIF IF(INOOB2(IPLAMO) .NE . 'ENTIER ') GO TO 210 JG=JG+1 SEGADJ MLENTI LECT(JG)=IOUEP2(IPLAMO) GO TO 25 ENDIF IF(CHAR.NE.INOOB2(IPLAMO)) GO TO 50 IOO=IOUEP2(IPLAMO) if(nbesc.ne.0) segact ipiloc IF(CHAR.EQ.'ENTIER ') THEN IVAL=IOO CALL NOMENT(CHARB,IVAL) ELSEIF(CHAR.EQ.'FLOTTANT') THEN XPO= XIFLOT(IOO) CALL NOMREE(CHARB,XPO) ELSEIF(CHAR.EQ.'MOT ') THEN ID=IPCHAR(IOO) IFI=IPCHAR(IOO+1) IF1=IFI-ID CHARC=' ' IF1=MIN(IF1,72) CHARC(1:IF1)=ICHARA(ID:IFI-1) CALL NOMCHA(CHARB,CHARC(1:IF1)) ELSEIF(CHAR.EQ.'LOGIQUE ') THEN LOGI=IPLOGI(IOO) CALL NOMLOG(CHARB,LOGI) ELSE CALL NOMOBJ(CHAR,CHARB,IOO) ENDIF if(nbesc.ne.0) segdes ipiloc 465 CONTINUE IPASS=0 GO TO 1 50 CONTINUE WRITE(IOIMP,51) CHAR 51 FORMAT(' LA QUANTITE LUE N''EST PAS DU TYPE ',A8, #' RECOMMENCEZ S''IL VOUS PLAIT') GO TO 20 200 CONTINUE C-- ON REMET TEXT EN PLACE * TEXT(1:500)=CMTEXT(1:500) * IFINAN=IFINA1 * IPREC=IPREC1 * ICOUR=ICOUR1 * NRAN=NRAN1 segsup sredle RETURN 21 CONTINUE IF(IOGRA.EQ.3.OR.IOGRA.EQ.2) THEN REWIND IOTER GOTO 210 ELSE CALL ERREUR ( 34 ) RETURN ENDIF END