Télécharger menage.eso

Retour à la liste

Numérotation des lignes :

  1. C MENAGE SOURCE PV 17/12/06 21:15:01 9652
  2. C SUPPRIMER LES SEGMENTS INDESIRABLES
  3. C
  4. SUBROUTINE MENAGE(IAUTOM)
  5. *
  6. IMPLICIT INTEGER(I-N)
  7. integer iautom
  8. integer icolac
  9. integer iplaob, iplaoc
  10. integer iretou
  11. integer nomlus
  12. -INC CCOPTIO
  13. -INC CCASSIS
  14. -INC CCNOYAU
  15. -INC TMLCHA8
  16. -INC SMELEME
  17. -INC SMTABLE
  18. -INC SMLENTI
  19. -INC SMCOORD
  20.  
  21. INTEGER NACTI
  22. INTEGER NTAACT
  23. INTEGER MACTIP
  24. INTEGER MTOTAP
  25. INTEGER MTOTA
  26. INTEGER MSEGMP
  27. INTEGER MACTI
  28.  
  29. SAVE NACTI
  30. SAVE NTAACT
  31. SAVE MACTIP
  32. SAVE MTOTAP
  33. SAVE MTOTA
  34. SAVE MSEGMP
  35. SAVE MACTI
  36. data nacti/0/
  37.  
  38. SEGMENT ITLAC(0)
  39. INTEGER OOOVAL
  40. *
  41. CHARACTER*4 CMOT
  42. REAL*8 XPLTOT
  43. *
  44. if (nacti.eq.0) then
  45. C place totale disponible
  46. XPLTOT=(1.D0*OOOVAL(1,3) * OOOVAL(1,4))/2.D0+OOOVAL(1,1)
  47. IPLTOT=INT(MIN(XPLTOT,2.D9))
  48. MTOTA=IPLTOT
  49. NACTI = OOOVAL(2,3)
  50. NTAACT = OOOVAL(3,3)
  51. C initialisations pour le non menage
  52. MACTIP = OOOVAL(3,3)
  53. MTOTAP = OOOVAL(3,1)
  54. MSEGMP = OOOVAL(2,1)
  55. MACTI = OOOVAL(1,1)
  56. endif
  57. segdes mcoord
  58. call lircha(cmot, 0,iretou)
  59. if( iretou.ne.0) then
  60. if( cmot .eq.'OBLI')go to 1
  61. call refus
  62. endif
  63. C autres criteres de menage :
  64. IFMEN=0
  65. C + de 10% de la memoire active depuis la derniere fois
  66. MACTIC=OOOVAL(3,3)
  67. IF (MACTIC-MACTIP.gt.MACTI*0.1) IFMEN=1
  68. C + de 20% de la memoire totale depuis la derniere fois
  69. MTOTAC=OOOVAL(3,1)
  70. IF (MTOTAC-MTOTAP.gt.MTOTA*0.20) IFMEN=2
  71. C + de 15% de la memoire active en memoire totale depuis la derniere fois
  72. IF (MTOTAC-MTOTAP.gt.MACTI*0.15) IFMEN=3
  73. C + de 100000 segments depuis la derniere fois
  74. MSEGMC=OOOVAL(2,1)
  75. IF (MSEGMC-MSEGMP.gt.32000*max(1,nbescr)) IFMEN=4
  76. IF (IFMEN.LE.0) RETURN
  77. if (iimpi.ne.0) write (6,*) 'menage ',ifmen
  78.  
  79.  
  80.  
  81. call chleha(1,0,0,0)
  82. 1 CONTINUE
  83. * horodatage
  84. call ooohor(0,0)
  85.  
  86. C * attention aux assistants ....
  87. if (NBESC.NE.0.and.imestr.ne.0) then
  88. if (iimpi .eq. 1234)
  89. & write(ioimp,*) ' il faut bloquer les assistants'
  90. mestra=imestr
  91. SEGACT MESTRA*MOD
  92. if (iimpi .eq. 1234)
  93. & write(ioimp,*) ' assistants en attente'
  94. * on passe en mode force
  95. call ooofrc(1)
  96. * lodesl=.true.
  97. call setass(1)
  98. end if
  99.  
  100. * on passe en mode force
  101. * on met NOMLU a 1 pour bloquer le decodage des instructions
  102. NOMLUS=NOMLU
  103. nomlu=1
  104. segini itlac
  105. call ecrcha('NOOP')
  106. call tasspo(itlac,icolac,meleme,1)
  107. segdes meleme
  108. *
  109. * icolac ,cree dans tasspo pointe sur les piles d'objets accessibles
  110. *
  111. CALL MENAG5(ICOLAC,0)
  112. *
  113. * QUELLE PLACE RESTE T'IL MAINTENANT
  114. IF(IIMPI.NE.0) write(IOIMP,12) mactip,mactic
  115. MACTIP=OOOVAL(3,3)
  116. MTOTAP=OOOVAL(3,1)
  117. MSEGMP=OOOVAL(2,1)
  118. 12 FORMAT( ' place occupée avant apres ',3I14)
  119. * CALL PLAC
  120. * CALL LIRENT(IPLRES,1,IRETOU)
  121. * EST-CE SUFFISANT ??
  122. * INTERR(1)=IPLRES
  123. * IF (IPLADE.NE.0.AND.IPLRES.LT.IPLADE) CALL ERREUR(436)
  124. * restauration de nomlu
  125. NOMLU=NOMLUS
  126. C * attention aux assistants ....
  127. if (NBESC.NE.0.and.imestr.ne.0) then
  128. C * il faut liberer le segment de dialogue
  129. mestra=imestr
  130. * repasser en mode normal
  131. call ooofrc(0)
  132. SEGDES MESTRA
  133. * lodesl=.false.
  134. call setass(0)
  135. end if
  136. C JYY
  137. SEGDES MCOORD
  138. END
  139.  
  140.  
  141.  
  142.  
  143.  
  144.  
  145.  
  146.  
  147.  
  148.  
  149.  
  150.  
  151.  
  152.  
  153.  

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