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.  
  36. -INC PPARAM
  37. -INC CCOPTIO
  38. -INC SMCHAML
  39. -INC SMLMOTS
  40.  
  41. MCHEL1 = IPCH1
  42. SEGINI,MCHELM=MCHEL1
  43. IPCH2=MCHELM
  44.  
  45. N1=MCHELM.ICHAML(/1)
  46. N3=MCHELM.INFCHE(/2)
  47. L1=MCHELM.TITCHE(/1)
  48. C Cas rapide du MCHELM vide
  49. IF (N1 .EQ. 0) THEN
  50. SEGDES,MCHELM
  51. RETURN
  52. ENDIF
  53.  
  54. SEGACT,MLMOTS
  55. JGM=MLMOTS.MOTS(/2)
  56.  
  57. I1 = 0
  58. DO 100 IMCH=1,N1
  59. MCHAM1=MCHELM.ICHAML(IMCH)
  60. SEGINI,MCHAML=MCHAM1
  61. N2=MCHAML.IELVAL(/1)
  62. IF (N2 .EQ. 0) GOTO 100
  63.  
  64. I2 = 0
  65. DO 200 IMVAL=1,N2
  66. CALL PLACE(MLMOTS.MOTS,JGM,IPLACE,MCHAML.NOMCHE(IMVAL))
  67. IF (IERR .NE. 0) RETURN
  68. IF (IPLACE .NE. 0) GOTO 200
  69. I2 = I2 + 1
  70.  
  71. IF (I2 .NE. IMVAL) THEN
  72. C On decalle tout si necessaire
  73. MCHAML.NOMCHE(I2)=MCHAML.NOMCHE(IMVAL)
  74. MCHAML.TYPCHE(I2)=MCHAML.TYPCHE(IMVAL)
  75. MCHAML.IELVAL(I2)=MCHAML.IELVAL(IMVAL)
  76. ENDIF
  77. 200 CONTINUE
  78.  
  79. IF (I2 .EQ. 0) THEN
  80. C Le MCHAML est supprime et on n'incremente pas I1
  81. SEGSUP,MCHAML
  82.  
  83. ELSEIF(I2 .NE. N2) THEN
  84. C Le MCHAML a change de taille (N2)
  85. N2 = I2
  86. SEGADJ,MCHAML
  87. I1 = I1 + 1
  88. MCHELM.ICHAML(I1)=MCHAML
  89. IF (I1 .NE. IMCH) THEN
  90. MCHELM.CONCHE(I1)=MCHELM.CONCHE(IMCH)
  91. MCHELM.IMACHE(I1)=MCHELM.IMACHE(IMCH)
  92. DO 301 I3=1,N3
  93. MCHELM.INFCHE(I1,I3)=MCHELM.INFCHE(IMCH,I3)
  94. 301 CONTINUE
  95. ENDIF
  96.  
  97. ELSE
  98. C Le MCHAML est inchangé (on garde le MCHAML initial)
  99. I1 = I1 + 1
  100. SEGSUP,MCHAML
  101. IF (I1 .NE. IMCH) THEN
  102. MCHELM.ICHAML(I1)=MCHELM.ICHAML(IMCH)
  103. MCHELM.CONCHE(I1)=MCHELM.CONCHE(IMCH)
  104. MCHELM.IMACHE(I1)=MCHELM.IMACHE(IMCH)
  105. DO 302 I3=1,N3
  106. MCHELM.INFCHE(I1,I3)=MCHELM.INFCHE(IMCH,I3)
  107. 302 CONTINUE
  108. ENDIF
  109. ENDIF
  110.  
  111. 100 CONTINUE
  112.  
  113. C Ajustement si necessaire du MCHELM
  114. IF (I1 .NE. N1) THEN
  115. N1 = I1
  116. SEGADJ,MCHELM
  117. ENDIF
  118.  
  119. RETURN
  120. END
  121.  
  122.  
  123.  

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