1 : C QUITTE SOURCE CHAT 06/03/16 21:25:15 5336 2 : C CE SOUS PROGRAMME FAIT QUITTER UN BLOC ACTIF (SORTIE DE BOUCLE) 3 : C (SORTIE DE PROCEDURE) 4 : C 5 : SUBROUTINE QUITTE 6 : IMPLICIT INTEGER(I-N) 7 : -INC CCOPTIO 8 : -INC CCNOYAU 9 : -INC SMBLOC 10 : CHARACTER*4 MFIN(4) 11 : CHARACTER*(8) CTYP 12 : DATA MFIN/'FIN ','REPE','FINP','FINM'/ 12 : CALL MESLIR(-237) 12 : CALL LIROBJ('PROCEDUR',IRET,0,IRETOU) 13 : CTYP='PROCEDUR' 14 : IF(IRETOU.EQ.0) THEN 14 : CALL LIROBJ('BLOC ',IRET,0,IRETOU) 15 : IF(IRETOU.EQ.0) GO TO 20 16 : CTYP='BLOC ' 17 : ENDIF 18 : IF(IERR.NE.0) RETURN 19 : 1 CONTINUE 19 : CALL NOUTRU 20 : LECTAB=1 20 : CALL LIRMOT(MFIN,4,IRETOU,0) 21 : LECTAB = 0 22 : IF (IRETOU.EQ.0) THEN 23 : GOTO 1 24 : ELSEIF ( IRETOU.EQ.2) THEN 24 : CALL REPETE 25 : MBCONT=1 26 : GO TO 1 27 : ELSEIF ( IRETOU.EQ.3.OR.IRETOU.EQ.4) THEN 28 : IF( CTYP.EQ.'BLOC ' ) THEN 28 : CALL ERREUR (26) 29 : RETURN 30 : ENDIF 30 : CALL FINPRO 31 : RETURN 32 : ELSEIF ( IRETOU.EQ.1) THEN 33 : MBCONT=1 34 : MBLO1=MBLOC 34 : CALL FIN 35 : IF (MBLO1.EQ.IRET) RETURN 36 : ENDIF 37 : GO TO 1 38 : C 39 : C PAS D OPERANDE CORRECTE TROUVE 40 : C 40 : 20 CALL QUETYP(MOTERR(1:8),0,IRETOU) 41 : IF(IRETOU.NE.0) THEN 41 : CALL ERREUR (39) 42 : ELSE 42 : CALL ERREUR(533) 43 : ENDIF 44 : RETURN 45 : END 46 :
© Cast3M 2003 - All rights reserved.
Disclaimer