Télécharger menage.eso

Retour à la liste

Numérotation des lignes :

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

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