Télécharger menag5.eso

Retour à la liste

Numérotation des lignes :

  1. C MENAG5 SOURCE PV 16/11/26 21:16:11 9205
  2. C SUPPRIMER LES SEGMENTS INDESIRABLES
  3. C
  4. SUBROUTINE MENAG5(JCOLAC,ITL)
  5. *
  6. IMPLICIT INTEGER(I-N)
  7. integer i,ipile,islis
  8. integer j,lisli2
  9. integer jcolac
  10. -INC CCOPTIO
  11. -INC COCOLL
  12. -INC TMCOLAC
  13. pointeur tcolac.icolac
  14. pointeur ptest.ilisse
  15.  
  16. SEGMENT ISLI2(0)
  17. SEGMENT ITL(0)
  18. *
  19. *
  20. * EXTRAIRE DE JCOLAC LA LISTES DES SEGMENTS
  21. *
  22. pointeur piles.LISPIL
  23.  
  24. CALL MENAG2(ISLI2,JCOLAC)
  25. *
  26. * RAJOUTER EVENTUELLEMENT L'ITLAC DES MELEME
  27. *
  28. IF (ITL.NE.0) THEN
  29. LISLI2=ISLI2(/1)
  30. DO 10 I=1,LISLI2
  31. IF (ISLI2(I).LT.ITL) GOTO 10
  32. ISLI2(**)=ISLI2(LISLI2)
  33. DO 20 J=LISLI2,I+1,-1
  34. ISLI2(J)=ISLI2(J-1)
  35. 20 CONTINUE
  36. ISLI2(I)=ITL
  37. GOTO 30
  38. 10 CONTINUE
  39. ISLI2(**)=ITL
  40. 30 CONTINUE
  41. ENDIF
  42. *
  43. * LISTE DES SEGMENTS CONTENUS DANS L'ENSEMBLE DES OBJETS
  44. *
  45. CALL MENAG1(ISLIS)
  46. *
  47. * mise a jour des piles d'objets deja sauves. Mise a zero de ceux
  48. * qui n'existent plus
  49. *
  50. CALL MENAG7(JCOLAC,IPSAUV)
  51. C mise a jour des piles d'objets communiques
  52. if(piComm.gt.0) then
  53. piles=piComm
  54. segact piles
  55. do ipile=1,piles.proc(/1)
  56. tcolac = piles.proc(ipile)
  57. segact tcolac*mod
  58. ilisse = tcolac.ilissg
  59. segact ilisse*mod
  60. C write(6,*) 'Menage dans pile', ipile,tcolac,ilisse
  61.  
  62. call menag7(jcolac, tcolac)
  63. segdes ilisse
  64. segdes tcolac
  65. enddo
  66. segdes piles
  67. endif
  68.  
  69. *
  70. * OTER DE CETTE LISTE LA LISTE DES SEGMENTS A GARDER
  71. *
  72. CALL MENAG3(ISLIS,ISLI2)
  73. *
  74. * DETRUIRE CES SEGMENTS
  75. *
  76. CALL MENAG4(ISLIS)
  77. *
  78. END
  79.  
  80.  
  81.  
  82.  
  83.  
  84.  

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