C NOUINS SOURCE CHAT 11/07/21 21:15:26 7047 C SERT A DONNER LES NOMS INDIQUES AUX OBJETS SE TROUVANT DANS LA PILE C SUBROUTINE NOUINS IMPLICIT INTEGER(I-N) -INC CCNOYAU -INC CCOPTIO -INC SMBLOC -INC SMLMOTS -INC SMLENTI -INC CCASSIS C CHARACTER*(8) ITBNO,ITCH LOGICAL LLLERR , LOPREM , LOERAS IF (INTEMP.EQ.0)GO TO 10 IF(IERR.GT.1) GO TO 20 C ON AFFECTE UN OBJET TEMPORAIRE EVENTUEL IRETTP=0 CALL QUETYP(ITCH,0,IRETTP) IF(IRETTP.EQ.0) THEN ITBNOM=ITANO1(1) INOOB2(ITBNOM)=' ' IOUEP2(ITBNOM)=0 GO TO 20 ENDIF CALL LIROBJ(ITCH,IRET,1,IRETTP) IF (IRETTP.EQ.0) THEN CALL ERREUR(5) ENDIF ITBNOM=ITANO1(1) INOOB2(ITBNOM)=JTYOBJ(IMOTLU) IOUEP2(ITBNOM)=JPOOB4(IMOTLU) ISSPOT=ISPOTE IIPOTE=IIPOTE+1 IF ( IIPOTE.GT. IPOTEM(/1)) THEN * write (6,*)'**************************************' * write (6,*) 'necessite dagrandir iipote ' , iipote * write (6,*)'**************************************' NVQTEM=IPOTEM(/1)+20 SEGADJ ISSPOT ENDIF IPOTEM(IIPOTE) = ITBNOM GOTO 100 10 CONTINUE C ON PREND LES NOMS LES UNS APRES LES AUTRES INOM=0 11 CONTINUE INOM=INOM+1 IF (INOM.GT.NBNOM) GOTO 100 if(nbesc.ne.0) segact ipiloc IRET=0 ITBNOM=ITANO1(INOM) ITCHA=INOOB1(ITBNOM) IDEBCH=IPCHAR(ITCHA) IFINCH=IPCHAR(ITCHA+1)-1 MOTERR(1:8)=ICHARA(IDEBCH:IFINCH) CALL MESLIR(-183) ITCH=ITANOM(INOM) if(nbesc.ne.0)segdes ipiloc call lirabj('PROCEDUR',iret,0,iretou) if(Iretou.ne.0) then itch='PROCEDUR' else CALL LIRABJ(ITCH,IRET,1,IRETOU) endif * write(6,*) ' itch iret ' , itch , iret IF (INOM.NE.NBNOM) THEN IF (INOOB2(ITBNOM).EQ.'TABLE '.OR.INOOB2(ITBNOM).EQ. $ 'METHODOL' ) THEN ISUCC=0 IF(INOOB2(ITBNOM).EQ.'METHODOL') ISUCC=1 * VEUT-ON REMPLIR UN ELEMENT D'UNE TABLE? CALL NTATAB ( INOM,ITCH,IRET,ISUCC) if(nbesc.ne.0) segact ipiloc IF(ISUCC.EQ.1)GOTO 11 ENDIF ENDIF 12 CONTINUE if(nbesc.ne.0) segact ipiloc IF (ITBNOM.LE.0) CALL ERREUR(315) IDEBCH=IPCHAR(ITCHA) IFINCH=IPCHAR(ITCHA+1)-1 ITCH=ICHARA(IDEBCH:IFINCH) if(nbesc.ne.0)segdes ipiloc IF (IERR.LE.1) THEN IF( ITCH .EQ.' ') THEN CALL ERREUR(315) GO TO 20 ENDIF IF( ITCH .EQ.'.') THEN CALL ERREUR(315) GO TO 20 ENDIF IF(ITCH(1:1).EQ.'#') THEN CALL ERREUR(315) GO TO 20 ENDIF INOOB2(ITBNOM)=JTYOBJ(IMOTLU) IOUEP2(ITBNOM)=JPOOB4(IMOTLU) ELSE IF(ITCH .NE.'.'.AND.ITCH.NE. $ ' ') INOOB2(ITBNOM)='ANNULE ' ENDIF GOTO 11 100 CONTINUE C VERIFIER QU'IL N'Y A PAS D'OBJET DANS LA PILE IF(IERR.NE.0) GO TO 20 CALL QUETYP(ITCH,0,IRETOU) IF (IRETOU.EQ.0) GOTO 20 MOTERR(1:8)=ITCH CALL LIRABJ(ITCH,IRET,1,IRETOU) CALL QUENOM(ITCH) MOTERR(9:16)=ITCH CALL ERREUR(11) 20 CONTINUE C IF(IERR.NE.0.AND.MBFONC.EQ.0) THEN IF( IERR.NE.0.AND.IERPER.LE.2) THEN IF(MBFONC.EQ.0) THEN CALL TRBACK ELSE CALL ANABAC ENDIF ENDIF NOMLU=0 IF ( IRAZ . LE. -1.OR.IERR.NE.0) THEN IPTEM=-(IRAZ + 1) if(ierr.ne.0) iptem=0 CALL RAZPIL ENDIF INTEXT=0 LECTAB=0 * RETASSER LA PILE DES REELS (TOUTES LES 30 FOIS) * ICTAS=ICTAS+1 * IF (ICTAS.GT.10) THEN CALL TASREE * ICTAS=0 * ENDIF * y a t -il une erreur sur les assistants ? if (LODEFE) then merres = ierres segact merres LLLERR = LOSIER segdes merres if ( LLLERR ) THEN * il faut que les assistants vident les listes d'instructions JG = nbesc SEGINI MLENTI DO i = 1 , nbesc LECT(i) = 1 END DO LOPREM = .TRUE. 9876 continue NBINSS = 0 DO i = 1 , nbesc if ( LECT(I) .EQ. 1 ) then MESINS = MESCL(I) if ( LOPREM ) then SEGACT MESINS*MOD else SEGACT MESINS*(MOD,ECR=1) end if if ( NBINS .EQ. 0 .AND. INSCOU .EQ. 0 ) THEN LECT(I) = 0 else NBINSS = NBINSS + 1 end if SEGDES MESINS*RECORD end if END DO LOPREM = .FALSE. IF ( NBINSS .NE. 0 ) GOTO 9876 SEGSUP MLENTI * les assistants ont vide leur pile d'instructions segact merres*mod do jerr = 1, NBERR write(ioimp,*) ' ------------------------------' write(ioimp,*) ' assistant :',liserr(3,jerr) write(ioimp,*) ' erreur :',liserr(1,jerr) MLMOTS = liserr(2,jerr) segact MLMOTS write(ioimp,*) MOTS(1) (1:MOTS(/1)) write(ioimp,*) MOTS(2) (1:MOTS(/1)) segdes MLMOTS write(ioimp,*) ' ------------------------------' end do NBERR = 0 LOSIER = .FALSE. segdes merres IERR = 0 CALL ERREUR (915) RETURN end if if (LOTRMA) then mesins = mescl(0) segact mesins*mod call nouins2 end if end if RETURN END