Télécharger quitte.eso

Retour à la liste

Numérotation des lignes :

  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'/
  13. CALL MESLIR(-237)
  14. CALL LIROBJ('PROCEDUR',IRET,0,IRETOU)
  15. CTYP='PROCEDUR'
  16. IF(IRETOU.EQ.0) THEN
  17. CALL LIROBJ('BLOC ',IRET,0,IRETOU)
  18. IF(IRETOU.EQ.0) GO TO 20
  19. CTYP='BLOC '
  20. ENDIF
  21. IF(IERR.NE.0) RETURN
  22. 1 CONTINUE
  23. CALL NOUTRU
  24. LECTAB=1
  25. CALL LIRMOT(MFIN,4,IRETOU,0)
  26. LECTAB = 0
  27. IF (IRETOU.EQ.0) THEN
  28. GOTO 1
  29. ELSEIF ( IRETOU.EQ.2) THEN
  30. CALL REPETE
  31. MBCONT=1
  32. GO TO 1
  33. ELSEIF ( IRETOU.EQ.3.OR.IRETOU.EQ.4) THEN
  34. IF( CTYP.EQ.'BLOC ' ) THEN
  35. CALL ERREUR (26)
  36. RETURN
  37. ENDIF
  38. CALL FINPRO
  39. RETURN
  40. ELSEIF ( IRETOU.EQ.1) THEN
  41. MBCONT=1
  42. MBLO1=MBLOC
  43. CALL FIN
  44. IF (MBLO1.EQ.IRET) RETURN
  45. ENDIF
  46. GO TO 1
  47. C
  48. C PAS D OPERANDE CORRECTE TROUVE
  49. C
  50. 20 CALL QUETYP(MOTERR(1:8),0,IRETOU)
  51. IF(IRETOU.NE.0) THEN
  52. CALL ERREUR (39)
  53. ELSE
  54. CALL ERREUR(533)
  55. ENDIF
  56. RETURN
  57. END
  58.  
  59.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales