Télécharger enlev8.eso

Retour à la liste

Numérotation des lignes :

  1. C ENLEV8 SOURCE CB215821 17/05/30 21:15:00 9441
  2.  
  3. C***********************************************************************
  4. C
  5. C E N L E V 8
  6. C -----------
  7. C
  8. C FONCTION:
  9. C ---------
  10. C
  11. C ENLEVER DES COMPOSANTES A UN 'MCHAML'.
  12. C
  13. C
  14. C PARAMETRES: (E)=ENTREE (S)=SORTIE
  15. C -----------
  16. C
  17. C MCH2 = ENLE MCH1 | MOT1 MOT2 ... MOTi ;
  18. C | LISMO1 ;
  19. C
  20. C
  21. C MCH1 (E) OBJET DE TYPE MCHAML , POINTEUR IPCH1C
  22. C MOTi (E) OBJETS DE TYPE MOT DONNANT LES NOMS DE
  23. C COMPOSANTES A RETIRER
  24. C LISMO1 (E) OBJETS DE TYPE LISTMOTS DONNANT LES NOMS DE
  25. C COMPOSANTES A RETIRER, POINTEUR MLMOTS
  26. C
  27. C MCH2 (S) OBJET DE TYPE MCHAML , POINTEUR IPCH2
  28. C
  29. C***********************************************************************
  30. SUBROUTINE ENLEV8(IPCH1,MLMOTS,IPCH2)
  31. C
  32. IMPLICIT REAL*8(A-H,O-Z)
  33. IMPLICIT INTEGER (I-N)
  34.  
  35. -INC CCOPTIO
  36. -INC SMCHAML
  37. -INC SMLMOTS
  38.  
  39. MCHEL1 = IPCH1
  40. SEGINI,MCHELM=MCHEL1
  41. IPCH2=MCHELM
  42.  
  43. N1=MCHELM.ICHAML(/1)
  44. N3=MCHELM.INFCHE(/2)
  45. L1=MCHELM.TITCHE(/1)
  46. C Cas rapide du MCHELM vide
  47. IF (N1 .EQ. 0) THEN
  48. SEGDES,MCHELM
  49. RETURN
  50. ENDIF
  51.  
  52. SEGACT,MLMOTS
  53. JGM=MLMOTS.MOTS(/2)
  54.  
  55. I1 = 0
  56. DO 100 IMCH=1,N1
  57. MCHAM1=MCHELM.ICHAML(IMCH)
  58. SEGINI,MCHAML=MCHAM1
  59. N2=MCHAML.IELVAL(/1)
  60. IF (N2 .EQ. 0) GOTO 100
  61.  
  62. I2 = 0
  63. DO 200 IMVAL=1,N2
  64. CALL PLACE(MLMOTS.MOTS,JGM,IPLACE,MCHAML.NOMCHE(IMVAL))
  65. IF (IERR .NE. 0) RETURN
  66. IF (IPLACE .NE. 0) GOTO 200
  67. I2 = I2 + 1
  68.  
  69. IF (I2 .NE. IMVAL) THEN
  70. C On decalle tout si necessaire
  71. MCHAML.NOMCHE(I2)=MCHAML.NOMCHE(IMVAL)
  72. MCHAML.TYPCHE(I2)=MCHAML.TYPCHE(IMVAL)
  73. MCHAML.IELVAL(I2)=MCHAML.IELVAL(IMVAL)
  74. ENDIF
  75. 200 CONTINUE
  76.  
  77. IF (I2 .EQ. 0) THEN
  78. C Le MCHAML est supprime et on n'incremente pas I1
  79. SEGSUP,MCHAML
  80.  
  81. ELSEIF(I2 .NE. N2) THEN
  82. C Le MCHAML a change de taille (N2)
  83. N2 = I2
  84. SEGADJ,MCHAML
  85. I1 = I1 + 1
  86. MCHELM.ICHAML(I1)=MCHAML
  87. IF (I1 .NE. IMCH) THEN
  88. MCHELM.CONCHE(I1)=MCHELM.CONCHE(IMCH)
  89. MCHELM.IMACHE(I1)=MCHELM.IMACHE(IMCH)
  90. DO 301 I3=1,N3
  91. MCHELM.INFCHE(I1,I3)=MCHELM.INFCHE(IMCH,I3)
  92. 301 CONTINUE
  93. ENDIF
  94.  
  95. ELSE
  96. C Le MCHAML est inchangé (on garde le MCHAML initial)
  97. I1 = I1 + 1
  98. SEGSUP,MCHAML
  99. IF (I1 .NE. IMCH) THEN
  100. MCHELM.ICHAML(I1)=MCHELM.ICHAML(IMCH)
  101. MCHELM.CONCHE(I1)=MCHELM.CONCHE(IMCH)
  102. MCHELM.IMACHE(I1)=MCHELM.IMACHE(IMCH)
  103. DO 302 I3=1,N3
  104. MCHELM.INFCHE(I1,I3)=MCHELM.INFCHE(IMCH,I3)
  105. 302 CONTINUE
  106. ENDIF
  107. ENDIF
  108.  
  109. 100 CONTINUE
  110.  
  111. C Ajustement si necessaire du MCHELM
  112. IF (I1 .NE. N1) THEN
  113. N1 = I1
  114. SEGADJ,MCHELM
  115. ENDIF
  116.  
  117. RETURN
  118. END
  119.  
  120.  
  121.  

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