Télécharger fin.eso

Retour à la liste

Numérotation des lignes :

  1. C FIN SOURCE CB215821 19/04/30 21:15:14 10214
  2. SUBROUTINE FIN
  3. IMPLICIT INTEGER(I-N)
  4.  
  5. -INC CCOPTIO
  6. -INC CCNOYAU
  7. -INC SMBLOC
  8. -INC CCPERF
  9.  
  10. INTEGER ITTIME(4)
  11. CHARACTER*42 MESS
  12. CHARACTER*(LONOM) ICHC
  13. DATA MESS/'ARRET DU PROGRAMME CAST3M NIVEAU D''ERREUR:'/
  14.  
  15.  
  16. IF (IERR.EQ.0) THEN
  17. CALL LIROBJ('BLOC ',IRET,0,IRETOU)
  18. IF (IRETOU.EQ.1) GOTO 10
  19. ENDIF
  20. WRITE (IOIMP,1) MESS,IERMAX
  21. 1 FORMAT (///,1X,10(1H*),5X,A42,I4,5X,10(1H*))
  22. IF (IIMPI.NE.0) CALL OOODMP(0)
  23. CALL OOOSTP
  24. call flush(IOIMP)
  25. *** if (iermax.eq.3) call abort
  26. IF (IERMAX.EQ.1) STOP 4
  27. IF (IERMAX.EQ.2) STOP 8
  28. IF (IERMAX.EQ.3) STOP 12
  29. STOP
  30. 10 CONTINUE
  31. IF (MBLOC.NE.IRET) THEN
  32. MBLO1=IRET
  33. SEGACT,MBLO1
  34. MOTERR=MBLO1.NCONBO(2:LONOM)
  35. SEGDES,MBLO1
  36. CALL ERREUR(154)
  37. RETURN
  38. ENDIF
  39. * MISE A BLANC DU NOM DE LA BOUCLE AFIN DE NE PAS LA REUTILISER
  40. IPLAC = JPOOB2(IMOTLU)
  41. INOOB1(IPLAC)=1
  42. C
  43. C si c'est la premiere fois on ajuste le segment
  44. C
  45. IF(MBFONC.NE.0) THEN
  46. MTXBLC=MTXBL
  47. NINST=NINSTV+1
  48. IPVINN=MTXBA(NINST)
  49. NBNOMM=LMTXBM(NINST)
  50. IF(IIMPI.EQ.1756) WRITE(IOIMP,1788)NINST,IPVINN,NBNOMM
  51. 1788 FORMAT(' apres ajustement NINST IPVINN NBNOMM',3I8)
  52. SEGADJ MTXBLC
  53. ENDIF
  54.  
  55. C Gestion du SOUCI dans le BLOC (COMMENTE ACTUELLEMENT)
  56. C MBSOU = mbsouc
  57. C mbsouc= 0
  58.  
  59. MBCOUR= 0
  60. MBFONC= 0
  61. MBCONT= MBCONT-1
  62. ICONBO= ICONBO+1
  63. ICHC = NCONBO
  64. IIPROU= ICONBO
  65. CALL NOMENT(ICHC,IIPROU)
  66. IF (MBCONT.NE.0 .AND. MBERR.EQ.0) RETURN
  67.  
  68. C DEBUT Duree passee dans les boucles (Voir PROCED pour le depart)
  69. IF(ITPSBO .GT. 0) THEN
  70. call timespv(ittime,oothrd)
  71. IELAPS=ITTIME(1) + ITTIME(2)
  72. ICPU =ITTIME(3) + ITTIME(4)
  73.  
  74. ITPSBL=ITPSBO
  75. SEGACT,ITPSBL*MOD
  76.  
  77. C Niveau, position dans le tableau et nom de la boucle courante
  78. NICOU = ITPSBL.NIVCOU
  79. II = ITPSBL.IPRONI(NICOU)
  80.  
  81. C Incremente la duree de la boucle quittee
  82. ITPSBL.DURPRO(1,II)=ITPSBL.DURPRO(1,II) +
  83. & (IELAPS - ITPSBL.TPSPRO(1,II))
  84. ITPSBL.DURPRO(2,II)=ITPSBL.DURPRO(2,II) +
  85. & (ICPU - ITPSBL.TPSPRO(2,II))
  86.  
  87. C Remise a zero du CHRONOMETRE de la boucle parent
  88. NICOU = NICOU - 1
  89. ITPSBL.NIVCOU = NICOU
  90. IF(NICOU .GT. 0)THEN
  91. II=ITPSBL.IPRONI(NICOU)
  92. ITPSBL.TPSPRO(1,II) = IELAPS
  93. ITPSBL.TPSPRO(2,II) = ICPU
  94. ENDIF
  95. ENDIF
  96. C FIN Duree passee dans les boucles
  97.  
  98. MBCONT=1
  99. MBER1 =MBERR
  100. MBLO1 =MBLOC
  101. IF (MBLSUP.EQ.0) CALL ERREUR(5)
  102. IF (IERR .NE.0) RETURN
  103. MTXBLC=MTXBL
  104. SEGDES MTXBLC
  105. MBLOC =MBLSUP
  106. ISSPOT=MBLO1.ISPOTE
  107. SEGDES ISSPOT
  108. SEGDES MBLO1
  109. SEGACT MBLOC*MOD
  110. ISSPOT=ISPOTE
  111. SEGACT ISSPOT*MOD
  112. MTXBLC=MTXBL
  113. CALL NOUTRU
  114. IF (MBLSUP.NE.0) SEGACT MTXBLC
  115. MBERR=MBER1
  116.  
  117. C Gestion du SOUCI dans le BLOC (COMMENTE ACTUELLEMENT)
  118. C mbsouc = max(mbsou,mbsouc)
  119.  
  120. END
  121.  
  122.  
  123.  
  124.  

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