Télécharger menag4.eso

Retour à la liste

Numérotation des lignes :

menag4
  1. C MENAG4 SOURCE PV090527 23/03/23 21:15:09 11642
  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.  
  29. C Verification dans le CCPRECO pour le REDU : On retire les OBJETS que le menage a supprime
  30. DO 144 ITH1 = 1, NBASMA+1
  31. ITAILL = NBPRRE(ith1)
  32. IF (ITAILL .EQ. 0) GOTO 144
  33. ICOUR = 0
  34. DO 145 IPRECO = 1, ITAILL
  35. IMO = PRECMO(IPRECO,ITH1)
  36. IF (IMO .EQ. 0) GOTO 145
  37. ICH1 = PRECM1(IPRECO,ITH1)
  38. ICH2 = PRECM2(IPRECO,ITH1)
  39.  
  40. C Verification VALIDITE POINTEUR
  41. IF(.NOT. (OOOVP1(IMO).AND.OOOVP1(ICH1).AND.OOOVP1(ICH2)))THEN
  42. PRECMO(IPRECO,ith1) = 0
  43. PRECM1(IPRECO,ith1) = 0
  44. PRECM2(IPRECO,ith1) = 0
  45. PRECM3(IPRECO,ith1) = 0
  46. PRECM4(IPRECO,ith1) = 0
  47. PRECM5(IPRECO,ith1) = 0
  48.  
  49. ELSE
  50. C Le CCPRECO pour le REDU est retasse
  51. ICOUR = ICOUR + 1
  52. PRECMO(ICOUR,ith1) = PRECMO(IPRECO,ith1)
  53. PRECM1(ICOUR,ith1) = PRECM1(IPRECO,ith1)
  54. PRECM2(ICOUR,ith1) = PRECM2(IPRECO,ith1)
  55. PRECM3(ICOUR,ith1) = PRECM3(IPRECO,ith1)
  56. PRECM4(ICOUR,ith1) = PRECM4(IPRECO,ith1)
  57. PRECM5(ICOUR,ith1) = PRECM5(IPRECO,ith1)
  58. ENDIF
  59. 145 CONTINUE
  60. NBPRRE(ith1) = ICOUR
  61. 144 CONTINUE
  62.  
  63. C Verification dans le CCPRECO pour les MMODEL etendus (modete) : On supprime ceux que le menage veut supprimer
  64. DO 151 ITH1 = 1, NBASMA+1
  65. ITAILL = NBMOMO(ith1)
  66. IF (ITAILL .EQ. 0) GOTO 151
  67. ICOUR = 0
  68. DO 152 IPRECO = 1, ITAILL
  69. IMO1 = PMOMO1(IPRECO,ITH1)
  70. IMO2 = PMOMO2(IPRECO,ITH1)
  71. IF (IMO1 .EQ. 0) GOTO 152
  72.  
  73. C Verification VALIDITE POINTEUR
  74. IF(.NOT. (OOOVP1(IMO1).AND.OOOVP1(IMO2)))THEN
  75. PMOMO1(IPRECO,ith1) = 0
  76. PMOMO2(IPRECO,ith1) = 0
  77.  
  78. ELSE
  79. C Le CCPRECO pour le REDU est retasse
  80. ICOUR = ICOUR + 1
  81. PMOMO1(ICOUR,ith1) = PMOMO1(IPRECO,ith1)
  82. PMOMO2(ICOUR,ith1) = PMOMO2(IPRECO,ith1)
  83. ENDIF
  84. 152 CONTINUE
  85. NBMOMO(ith1) = ICOUR
  86. 151 CONTINUE
  87.  
  88. C Rebelote pour le preconditionnement de chame1
  89. do 170 ith=0,nbasma
  90. do 171 iprec=nprcha,1,-1
  91. ich=iprchl(iprec,ith)
  92. if (.not.ooovp1(ich)) then
  93. do 172 ipr=iprec,nprcha-1
  94. iprma(ipr,ith) =iprma(ipr+1,ith)
  95. iprhoa(ipr,ith)=iprhoa(ipr+1,ith)
  96. iprmo(ipr,ith) =iprmo(ipr+1,ith)
  97. iprhom(ipr,ith)=iprhom(ipr+1,ith)
  98. iprchp(ipr,ith)=iprchp(ipr+1,ith)
  99. iprhoc(ipr,ith)=iprhoc(ipr+1,ith)
  100. iprsu(ipr,ith) =iprsu(ipr+1,ith)
  101. iprcha(ipr,ith)=iprcha(ipr+1,ith)
  102. iprchl(ipr,ith)=iprchl(ipr+1,ith)
  103. 172 continue
  104. iprchp(nprcha,ith) =0
  105. endif
  106. 171 continue
  107. 170 continue
  108.  
  109.  
  110.  
  111. END
  112.  
  113.  
  114.  
  115.  
  116.  

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