1 : C NOUINS SOURCE CHAT 11/07/21 21:15:26 7047 2 : C SERT A DONNER LES NOMS INDIQUES AUX OBJETS SE TROUVANT DANS LA PILE 3 : C 4 : SUBROUTINE NOUINS 5 : IMPLICIT INTEGER(I-N) 6 : -INC CCNOYAU 7 : -INC CCOPTIO 8 : -INC SMBLOC 9 : -INC SMLMOTS 10 : -INC SMLENTI 11 : -INC CCASSIS 12 : C 13 : CHARACTER*(8) ITBNO,ITCH 14 : LOGICAL LLLERR , LOPREM , LOERAS 15 : IF (INTEMP.EQ.0)GO TO 10 16 : IF(IERR.GT.1) GO TO 20 17 : C ON AFFECTE UN OBJET TEMPORAIRE EVENTUEL 18 : IRETTP=0 18 : CALL QUETYP(ITCH,0,IRETTP) 19 : IF(IRETTP.EQ.0) THEN 20 : ITBNOM=ITANO1(1) 21 : INOOB2(ITBNOM)=' ' 22 : IOUEP2(ITBNOM)=0 23 : GO TO 20 24 : ENDIF 24 : CALL LIROBJ(ITCH,IRET,1,IRETTP) 25 : IF (IRETTP.EQ.0) THEN 25 : CALL ERREUR(5) 26 : ENDIF 27 : ITBNOM=ITANO1(1) 28 : INOOB2(ITBNOM)=JTYOBJ(IMOTLU) 29 : IOUEP2(ITBNOM)=JPOOB4(IMOTLU) 30 : ISSPOT=ISPOTE 31 : IIPOTE=IIPOTE+1 32 : IF ( IIPOTE.GT. IPOTEM(/1)) THEN 33 : * write (6,*)'**************************************' 34 : * write (6,*) 'necessite dagrandir iipote ' , iipote 35 : * write (6,*)'**************************************' 36 : NVQTEM=IPOTEM(/1)+20 37 : SEGADJ ISSPOT 38 : ENDIF 39 : IPOTEM(IIPOTE) = ITBNOM 40 : GOTO 100 41 : 10 CONTINUE 42 : C ON PREND LES NOMS LES UNS APRES LES AUTRES 43 : INOM=0 44 : 45 : 11 CONTINUE 46 : INOM=INOM+1 47 : IF (INOM.GT.NBNOM) GOTO 100 48 : if(nbesc.ne.0) segact ipiloc 49 : IRET=0 50 : ITBNOM=ITANO1(INOM) 51 : ITCHA=INOOB1(ITBNOM) 52 : IDEBCH=IPCHAR(ITCHA) 53 : IFINCH=IPCHAR(ITCHA+1)-1 54 : MOTERR(1:8)=ICHARA(IDEBCH:IFINCH) 54 : CALL MESLIR(-183) 55 : ITCH=ITANOM(INOM) 56 : if(nbesc.ne.0)segdes ipiloc 56 : call lirabj('PROCEDUR',iret,0,iretou) 57 : if(Iretou.ne.0) then 58 : itch='PROCEDUR' 59 : else 59 : CALL LIRABJ(ITCH,IRET,1,IRETOU) 60 : endif 61 : * write(6,*) ' itch iret ' , itch , iret 62 : IF (INOM.NE.NBNOM) THEN 63 : IF (INOOB2(ITBNOM).EQ.'TABLE '.OR.INOOB2(ITBNOM).EQ. 64 : $ 'METHODOL' ) THEN 65 : ISUCC=0 66 : IF(INOOB2(ITBNOM).EQ.'METHODOL') ISUCC=1 67 : * VEUT-ON REMPLIR UN ELEMENT D'UNE TABLE? 68 : 68 : CALL NTATAB ( INOM,ITCH,IRET,ISUCC) 69 : if(nbesc.ne.0) segact ipiloc 70 : IF(ISUCC.EQ.1)GOTO 11 71 : ENDIF 72 : ENDIF 73 : 12 CONTINUE 74 : if(nbesc.ne.0) segact ipiloc 74 : IF (ITBNOM.LE.0) CALL ERREUR(315) 75 : IDEBCH=IPCHAR(ITCHA) 76 : IFINCH=IPCHAR(ITCHA+1)-1 77 : ITCH=ICHARA(IDEBCH:IFINCH) 78 : if(nbesc.ne.0)segdes ipiloc 79 : IF (IERR.LE.1) THEN 80 : IF( ITCH .EQ.' ') THEN 80 : CALL ERREUR(315) 81 : GO TO 20 82 : ENDIF 83 : IF( ITCH .EQ.'.') THEN 83 : CALL ERREUR(315) 84 : GO TO 20 85 : ENDIF 86 : IF(ITCH(1:1).EQ.'#') THEN 86 : CALL ERREUR(315) 87 : GO TO 20 88 : ENDIF 89 : INOOB2(ITBNOM)=JTYOBJ(IMOTLU) 90 : IOUEP2(ITBNOM)=JPOOB4(IMOTLU) 91 : ELSE 92 : IF(ITCH .NE.'.'.AND.ITCH.NE. 93 : $ ' ') INOOB2(ITBNOM)='ANNULE ' 94 : ENDIF 95 : GOTO 11 96 : 100 CONTINUE 97 : C VERIFIER QU'IL N'Y A PAS D'OBJET DANS LA PILE 98 : IF(IERR.NE.0) GO TO 20 98 : CALL QUETYP(ITCH,0,IRETOU) 99 : IF (IRETOU.EQ.0) GOTO 20 100 : MOTERR(1:8)=ITCH 100 : CALL LIRABJ(ITCH,IRET,1,IRETOU) 100 : CALL QUENOM(ITCH) 101 : MOTERR(9:16)=ITCH 101 : CALL ERREUR(11) 102 : 20 CONTINUE 103 : C IF(IERR.NE.0.AND.MBFONC.EQ.0) THEN 104 : IF( IERR.NE.0.AND.IERPER.LE.2) THEN 105 : IF(MBFONC.EQ.0) THEN 105 : CALL TRBACK 106 : ELSE 106 : CALL ANABAC 107 : ENDIF 108 : ENDIF 109 : NOMLU=0 110 : IF ( IRAZ . LE. -1.OR.IERR.NE.0) THEN 111 : IPTEM=-(IRAZ + 1) 112 : if(ierr.ne.0) iptem=0 112 : CALL RAZPIL 113 : ENDIF 114 : INTEXT=0 115 : LECTAB=0 116 : * RETASSER LA PILE DES REELS (TOUTES LES 30 FOIS) 117 : * ICTAS=ICTAS+1 118 : * IF (ICTAS.GT.10) THEN 118 : CALL TASREE 119 : * ICTAS=0 120 : * ENDIF 121 : * y a t -il une erreur sur les assistants ? 122 : if (LODEFE) then 123 : merres = ierres 124 : segact merres 125 : LLLERR = LOSIER 126 : segdes merres 127 : if ( LLLERR ) THEN 128 : * il faut que les assistants vident les listes d'instructions 129 : JG = nbesc 130 : SEGINI MLENTI 131 : DO i = 1 , nbesc 132 : LECT(i) = 1 133 : END DO 134 : LOPREM = .TRUE. 135 : 9876 continue 136 : NBINSS = 0 137 : DO i = 1 , nbesc 138 : if ( LECT(I) .EQ. 1 ) then 139 : MESINS = MESCL(I) 140 : if ( LOPREM ) then 141 : SEGACT MESINS*MOD 142 : else 143 : SEGACT MESINS*(MOD,ECR=1) 144 : end if 145 : if ( NBINS .EQ. 0 .AND. INSCOU .EQ. 0 ) THEN 146 : LECT(I) = 0 147 : else 148 : NBINSS = NBINSS + 1 149 : end if 150 : SEGDES MESINS*RECORD 151 : end if 152 : END DO 153 : LOPREM = .FALSE. 154 : IF ( NBINSS .NE. 0 ) GOTO 9876 155 : SEGSUP MLENTI 156 : * les assistants ont vide leur pile d'instructions 157 : segact merres*mod 158 : do jerr = 1, NBERR 159 : write(ioimp,*) ' ------------------------------' 160 : write(ioimp,*) ' assistant :',liserr(3,jerr) 161 : write(ioimp,*) ' erreur :',liserr(1,jerr) 162 : MLMOTS = liserr(2,jerr) 163 : segact MLMOTS 164 : write(ioimp,*) MOTS(1) (1:MOTS(/1)) 165 : write(ioimp,*) MOTS(2) (1:MOTS(/1)) 166 : segdes MLMOTS 167 : write(ioimp,*) ' ------------------------------' 168 : end do 169 : NBERR = 0 170 : LOSIER = .FALSE. 171 : segdes merres 172 : IERR = 0 172 : CALL ERREUR (915) 173 : RETURN 174 : end if 175 : if (LOTRMA) then 176 : mesins = mescl(0) 177 : segact mesins*mod 177 : call nouins2 178 : end if 179 : end if 180 : RETURN 181 : END 182 : 183 : 184 : 185 : 186 : 187 : 188 : 189 : 190 : 191 :
© Cast3M 2003 - All rights reserved.
Disclaimer