Télécharger menag4.eso

Retour à la liste

Numérotation des lignes :

  1. C MENAG4 SOURCE CB215821 16/10/04 11:25:34 9113
  2. C SUPPRIMER LES SEGMENTS INDESIRABLES
  3. C
  4. SUBROUTINE MENAG4(ISLIS)
  5. IMPLICIT INTEGER(I-N)
  6.  
  7. -INC CCPRECO
  8.  
  9. SEGMENT ISLIS(NP)
  10. SEGMENT ISEG(0)
  11.  
  12.  
  13. IPREC=0
  14. DO 10 I=1,ISLIS(/1)
  15. ISEG=ISLIS(I)
  16. IF (ISEG.EQ.ISLIS) GOTO 10
  17. IF (ISEG.EQ.IPREC) GOTO 10
  18. IPREC=ISEG
  19. SEGSUP,ISEG
  20.  
  21. C Verification dans le CCPRECO pour le REDU : On supprime ceux que le menage veut supprimer
  22. DO 144 ITH1 = 1, NBASMA+1
  23. ITAILL = NBPRRE(ith1)
  24. IF (ITAILL .EQ. 0) GOTO 144
  25. DO 145 IPRECO = 1, ITAILL
  26. IMO = PRECMO(IPRECO,ITH1)
  27. IF (IMO .EQ. 0) GOTO 145
  28. ICH1 = PRECM1(IPRECO,ITH1)
  29. ICH2 = PRECM2(IPRECO,ITH1)
  30.  
  31. C On veut supprimer un SEGMENT dans CCPRECO
  32. IF (IMO .EQ. IPREC) THEN
  33. C PRINT *,'MENAG4 : Suppression MMODEL',ith1-1,IPRECO,IMO
  34. PRECMO(IPRECO,ith1) = 0
  35. PRECM1(IPRECO,ith1) = 0
  36. PRECM2(IPRECO,ith1) = 0
  37. ELSEIF(ICH1 .EQ. IPREC) THEN
  38. C PRINT *,'MENAG4 : Suppression MCHEL1',ith1-1,IPRECO,ICH1
  39. PRECMO(IPRECO,ith1) = 0
  40. PRECM1(IPRECO,ith1) = 0
  41. PRECM2(IPRECO,ith1) = 0
  42. ELSEIF(ICH2 .EQ. IPREC) THEN
  43. C PRINT *,'MENAG4 : Suppression MCHEL2',ith1-1,IPRECO,ICH2
  44. PRECMO(IPRECO,ith1) = 0
  45. PRECM1(IPRECO,ith1) = 0
  46. PRECM2(IPRECO,ith1) = 0
  47. ENDIF
  48. 145 CONTINUE
  49. 144 CONTINUE
  50. 10 CONTINUE
  51. SEGSUP,ISLIS
  52.  
  53. C Le CCPRECO pour le REDU est retasse
  54. DO 146 ITH1 = 1, NBASMA+1
  55. ITAILL = NBPRRE(ith1)
  56. IF (ITAILL .EQ. 0) GOTO 146
  57. ICOUR = 0
  58. DO IPRECO = 1,ITAILL
  59. IF (PRECMO(IPRECO,ith1) .NE. 0) THEN
  60. ICOUR = ICOUR + 1
  61. PRECMO(ICOUR,ith1) = PRECMO(IPRECO,ith1)
  62. PRECM1(ICOUR,ith1) = PRECM1(IPRECO,ith1)
  63. PRECM2(ICOUR,ith1) = PRECM2(IPRECO,ith1)
  64. ENDIF
  65. ENDDO
  66. NBPRRE(ith1) = ICOUR
  67.  
  68. C Remise a zero de la fin de la liste (NON OBLIGATOIRE avec NBPRRE)
  69. C DO IPRECO = ICOUR+1,NPREDU
  70. C PRECMO(IPRECO,ith1) = 0
  71. C PRECM1(IPRECO,ith1) = 0
  72. C PRECM2(IPRECO,ith1) = 0
  73. C ENDDO
  74. 146 CONTINUE
  75.  
  76. RETURN
  77. END
  78.  
  79.  
  80.  
  81.  

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