Télécharger fin.eso

Retour à la liste

Numérotation des lignes :

  1. C FIN SOURCE PV 06/04/21 21:15:09 5418
  2. SUBROUTINE FIN
  3. IMPLICIT INTEGER(I-N)
  4. -INC CCOPTIO
  5. -INC CCNOYAU
  6. -INC SMBLOC
  7. CHARACTER*40 MESS
  8. CHARACTER*8 ICHC
  9. DATA MESS/'ARRET DU PROGRAMME GIBI NIVEAU D''ERREUR:'/
  10. IF (IERR.EQ.0) THEN
  11. CALL LIROBJ('BLOC ',IRET,0,IRETOU)
  12. IF (IRETOU.EQ.1) GOTO 10
  13. ENDIF
  14. WRITE (IOIMP,1) MESS,IERMAX
  15. 1 FORMAT (///,1X,10(1H*),5X,A40,I4,5X,10(1H*))
  16. IF (IIMPI.NE.0) CALL OOODMP(0)
  17. CALL OOOSTP
  18. call flush(IOIMP)
  19. *** if (iermax.eq.3) call abort
  20. IF (IERMAX.EQ.1) STOP 4
  21. IF (IERMAX.EQ.2) STOP 8
  22. IF (IERMAX.EQ.3) STOP 12
  23. STOP
  24. 10 CONTINUE
  25. IF (MBLOC.NE.IRET) THEN
  26. CALL ERREUR(154)
  27. RETURN
  28. ENDIF
  29. * MISE A BLANC DU NOM DE LA BOUCLE AFIN DE NE PAS LA REUTILISER
  30. IPLAC = JPOOB2(IMOTLU)
  31. INOOB1(IPLAC)=1
  32. C
  33. C si c'est la premiere fois on ajuste le segment
  34. C
  35. IF(MBFONC.NE.0) THEN
  36. MTXBLC=MTXBL
  37. NINST=NINSTV+1
  38. IPVINN=MTXBA(NINST)
  39. NBNOMM=LMTXBM(NINST)
  40. IF(IIMPI.EQ.1756) WRITE(IOIMP,1788)NINST,IPVINN,NBNOMM
  41. 1788 FORMAT(' apres ajustement NINST IPVINN NBNOMM',3I8)
  42. SEGADJ MTXBLC
  43. ENDIF
  44. MBCOUR=0
  45. MBFONC=0
  46. MBCONT=MBCONT-1
  47. ICONBO=ICONBO+1
  48. ICHC= NCONBO
  49. IIPROU=ICONBO
  50. CALL NOMENT(ICHC,IIPROU )
  51. IF (MBCONT.NE.0.AND.MBERR.EQ.0) RETURN
  52. MBCONT=1
  53. MBER1=MBERR
  54. MBLO1=MBLOC
  55. IF (MBLSUP.EQ.0) CALL ERREUR(5)
  56. IF (IERR.NE.0) RETURN
  57. MTXBLC=MTXBL
  58. SEGDES MTXBLC
  59. MBLOC=MBLSUP
  60. ISSPOT=MBLO1.ISPOTE
  61. SEGDES ISSPOT
  62. SEGDES MBLO1
  63. SEGACT MBLOC*MOD
  64. ISSPOT=ISPOTE
  65. SEGACT ISSPOT*MOD
  66. MTXBLC=MTXBL
  67. CALL NOUTRU
  68. IF (MBLSUP.NE.0) SEGACT MTXBLC
  69. MBERR=MBER1
  70. RETURN
  71. END
  72.  
  73.  
  74.  
  75.  
  76.  

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