Télécharger fin.eso

Retour à la liste

Numérotation des lignes :

  1. C FIN SOURCE PV 19/01/16 21:15:04 10076
  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. MBSOU = mbsouc
  45. mbsouc = 0
  46. MBCOUR=0
  47. MBFONC=0
  48. MBCONT=MBCONT-1
  49. ICONBO=ICONBO+1
  50. ICHC= NCONBO
  51. IIPROU=ICONBO
  52. CALL NOMENT(ICHC,IIPROU )
  53. IF (MBCONT.NE.0.AND.MBERR.EQ.0) RETURN
  54. MBCONT=1
  55. MBER1=MBERR
  56. MBLO1=MBLOC
  57. IF (MBLSUP.EQ.0) CALL ERREUR(5)
  58. IF (IERR.NE.0) RETURN
  59. MTXBLC=MTXBL
  60. SEGDES MTXBLC
  61. MBLOC=MBLSUP
  62. ISSPOT=MBLO1.ISPOTE
  63. SEGDES ISSPOT
  64. SEGDES MBLO1
  65. SEGACT MBLOC*MOD
  66. ISSPOT=ISPOTE
  67. SEGACT ISSPOT*MOD
  68. MTXBLC=MTXBL
  69. CALL NOUTRU
  70. IF (MBLSUP.NE.0) SEGACT MTXBLC
  71. MBERR=MBER1
  72. mbsouc = max(mbsou,mbsouc)
  73. RETURN
  74. END
  75.  
  76.  
  77.  
  78.  
  79.  
  80.  
  81.  
  82.  
  83.  

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