Télécharger menag4.eso

Retour à la liste

Numérotation des lignes :

  1. C MENAG4 SOURCE CB215821 17/12/07 21:15:10 9656
  2. C SUPPRIMER LES SEGMENTS INDESIRABLES
  3. C
  4. SUBROUTINE MENAG4(ISLIS)
  5. IMPLICIT INTEGER(I-N)
  6.  
  7. LOGICAL OOOVP1
  8.  
  9. -INC CCPRECO
  10.  
  11. SEGMENT ISLIS(NP)
  12. SEGMENT ISEG(0)
  13.  
  14. IPREC=0
  15. DO 10 I=1,ISLIS(/1)
  16. ISEG=ISLIS(I)
  17. IF (ISEG.EQ.ISLIS) GOTO 10
  18. IF (ISEG.EQ.IPREC) GOTO 10
  19. IPREC=ISEG
  20. SEGSUP,ISEG
  21. 10 CONTINUE
  22. SEGSUP,ISLIS
  23.  
  24. C Vidange des queue de DESACTIVATION et SUPPRESSION (action faite par lots en temps normal)
  25. C ATTENTION : On n'est pas protege par le GLOBAL LOCK, seulement par le LOCK du menage
  26. call ooodeq(0)
  27. call ooosuq(0)
  28. C Verification dans le CCPRECO pour le REDU : On supprime ceux que le menage veut supprimer
  29. DO 144 ITH1 = 1, NBASMA+1
  30. ITAILL = NBPRRE(ith1)
  31. IF (ITAILL .EQ. 0) GOTO 144
  32. ICOUR = 0
  33. DO 145 IPRECO = 1, ITAILL
  34. IMO = PRECMO(IPRECO,ITH1)
  35. IF (IMO .EQ. 0) GOTO 145
  36. ICH1 = PRECM1(IPRECO,ITH1)
  37. ICH2 = PRECM2(IPRECO,ITH1)
  38.  
  39. C Verification VALIDITE POINTEUR
  40. IF(.NOT. (OOOVP1(IMO).AND.OOOVP1(ICH1).AND.OOOVP1(ICH2)))THEN
  41. PRECMO(IPRECO,ith1) = 0
  42. PRECM1(IPRECO,ith1) = 0
  43. PRECM2(IPRECO,ith1) = 0
  44.  
  45. ELSE
  46. C Le CCPRECO pour le REDU est retasse
  47. ICOUR = ICOUR + 1
  48. PRECMO(ICOUR,ith1) = PRECMO(IPRECO,ith1)
  49. PRECM1(ICOUR,ith1) = PRECM1(IPRECO,ith1)
  50. PRECM2(ICOUR,ith1) = PRECM2(IPRECO,ith1)
  51. ENDIF
  52. 145 CONTINUE
  53. NBPRRE(ith1) = ICOUR
  54. 144 CONTINUE
  55.  
  56. RETURN
  57. END
  58.  
  59.  
  60.  

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