Télécharger fin.eso

Retour à la liste

Numérotation des lignes :

  1. C FIN SOURCE CB215821 19/01/29 21:15:04 10088
  2. SUBROUTINE FIN
  3. IMPLICIT INTEGER(I-N)
  4. -INC CCOPTIO
  5. -INC CCNOYAU
  6. -INC SMBLOC
  7. CHARACTER*42 MESS
  8. CHARACTER*(LONOM) ICHC
  9. DATA MESS/'ARRET DU PROGRAMME CAST3M 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,A42,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.  
  45. C Gestion du SOUCI dans le BLOC (COMMENTE ACTUELLEMENT)
  46. C MBSOU = mbsouc
  47. C mbsouc=0
  48.  
  49. MBCOUR=0
  50. MBFONC=0
  51. MBCONT=MBCONT-1
  52. ICONBO=ICONBO+1
  53. ICHC= NCONBO
  54. IIPROU=ICONBO
  55. CALL NOMENT(ICHC,IIPROU )
  56. IF (MBCONT.NE.0.AND.MBERR.EQ.0) RETURN
  57. MBCONT=1
  58. MBER1=MBERR
  59. MBLO1=MBLOC
  60. IF (MBLSUP.EQ.0) CALL ERREUR(5)
  61. IF (IERR.NE.0) RETURN
  62. MTXBLC=MTXBL
  63. SEGDES MTXBLC
  64. MBLOC=MBLSUP
  65. ISSPOT=MBLO1.ISPOTE
  66. SEGDES ISSPOT
  67. SEGDES MBLO1
  68. SEGACT MBLOC*MOD
  69. ISSPOT=ISPOTE
  70. SEGACT ISSPOT*MOD
  71. MTXBLC=MTXBL
  72. CALL NOUTRU
  73. IF (MBLSUP.NE.0) SEGACT MTXBLC
  74. MBERR=MBER1
  75.  
  76. C Gestion du SOUCI dans le BLOC (COMMENTE ACTUELLEMENT)
  77. C mbsouc = max(mbsou,mbsouc)
  78.  
  79. END
  80.  
  81.  

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