Sources Esope | Cast3M

quitte
C QUITTE    SOURCE    PV090527  24/01/10    21:15:04     11818          
C  CE SOUS PROGRAMME FAIT QUITTER UN BLOC ACTIF  (SORTIE DE BOUCLE)
C                                                (SORTIE DE PROCEDURE)
C
      SUBROUTINE QUITTE
      IMPLICIT INTEGER(I-N)
 
-INC PPARAM
-INC CCOPTIO
-INC CCNOYAU
-INC SMBLOC
      CHARACTER*4 MFIN(4)
      CHARACTER*(8) CTYP
      DATA MFIN/'FIN ','REPE','FINP','FINM'/
      CALL MESLIR(-237)
      CALL LIROBJ('PROCEDUR',IRET,0,IRETOU)
      CTYP='PROCEDUR'
      IF(IRETOU.EQ.0) THEN
         CALL LIROBJ('BLOC    ',IRET,0,IRETOU)
            IF(IRETOU.EQ.0) GO TO 20
         CTYP='BLOC    '
      ENDIF
      IF(IERR.NE.0) RETURN
   1  CONTINUE
      CALL NOUTRU
      LECTAB=1
      CALL LIRMOT(MFIN,4,IRETOU,0)
      LECTAB = 0
      IF (IRETOU.EQ.0) THEN
           GOTO 1
      ELSEIF ( IRETOU.EQ.2) THEN
           CALL REPETE(1)
           MBCONT=1
           GO TO 1
      ELSEIF ( IRETOU.EQ.3.OR.IRETOU.EQ.4) THEN
           IF( CTYP.EQ.'BLOC    ' ) THEN
               CALL ERREUR (26)
               RETURN
           ENDIF
           CALL FINPRO
           RETURN
      ELSEIF ( IRETOU.EQ.1) THEN
           MBCONT=1
           MBLO1=MBLOC
          CALL FIN
          IF (MBLO1.EQ.IRET) RETURN
      ENDIF
      GO TO 1
C
C    PAS D OPERANDE CORRECTE TROUVE
C
 20   CALL QUETYP(MOTERR(1:8),0,IRETOU)
      IF(IRETOU.NE.0) THEN
         CALL ERREUR (39)
      ELSE
         CALL ERREUR(533)
      ENDIF
      RETURN
      END