Télécharger quitte.eso

Retour à la liste

Numérotation des lignes :

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

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