Sources Esope | Cast3M

enlev8
C ENLEV8    SOURCE    CB215821  20/11/04    21:16:38     10766          
 
C***********************************************************************
C
C                             E N L E V 8
C                             -----------
C
C FONCTION:
C ---------
C
C     ENLEVER DES COMPOSANTES A UN 'MCHAML'.
C
C
C PARAMETRES:   (E)=ENTREE   (S)=SORTIE
C -----------
C
C     MCH2  =  ENLE  MCH1  | MOT1 MOT2 ... MOTi ;
C                          | LISMO1             ;
C
C
C     MCH1   (E)  OBJET DE TYPE MCHAML , POINTEUR IPCH1C
C     MOTi   (E)  OBJETS DE TYPE MOT      DONNANT LES NOMS DE
C                 COMPOSANTES A RETIRER
C     LISMO1 (E)  OBJETS DE TYPE LISTMOTS DONNANT LES NOMS DE
C                 COMPOSANTES A RETIRER, POINTEUR MLMOTS
C
C     MCH2   (S)  OBJET DE TYPE MCHAML , POINTEUR IPCH2
C
C***********************************************************************
      SUBROUTINE ENLEV8(IPCH1,MLMOTS,IPCH2)
C
      IMPLICIT REAL*8(A-H,O-Z)
      IMPLICIT INTEGER (I-N)
 
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHAML
-INC SMLMOTS
 
      MCHEL1 = IPCH1
      SEGINI,MCHELM=MCHEL1
      IPCH2=MCHELM
 
      N1=MCHELM.ICHAML(/1)
      N3=MCHELM.INFCHE(/2)
      L1=MCHELM.TITCHE(/1)
C     Cas rapide du MCHELM vide
      IF (N1 .EQ. 0) THEN
        SEGDES,MCHELM
        RETURN
      ENDIF
 
      SEGACT,MLMOTS
      JGM=MLMOTS.MOTS(/2)
 
      I1 = 0
      DO 100 IMCH=1,N1
        MCHAM1=MCHELM.ICHAML(IMCH)
        SEGINI,MCHAML=MCHAM1
        N2=MCHAML.IELVAL(/1)
        IF (N2 .EQ. 0) GOTO 100
 
        I2 = 0
        DO 200 IMVAL=1,N2
          CALL PLACE(MLMOTS.MOTS,JGM,IPLACE,MCHAML.NOMCHE(IMVAL))
          IF (IERR   .NE. 0) RETURN
          IF (IPLACE .NE. 0) GOTO 200
          I2 = I2 + 1
 
          IF (I2 .NE. IMVAL) THEN
C           On decalle tout si necessaire
            MCHAML.NOMCHE(I2)=MCHAML.NOMCHE(IMVAL)
            MCHAML.TYPCHE(I2)=MCHAML.TYPCHE(IMVAL)
            MCHAML.IELVAL(I2)=MCHAML.IELVAL(IMVAL)
          ENDIF
 200    CONTINUE
 
        IF    (I2 .EQ. 0) THEN
C         Le MCHAML est supprime et on n'incremente pas I1
          SEGSUP,MCHAML
 
        ELSEIF(I2 .NE. N2) THEN
C         Le MCHAML a change de taille (N2)
          N2 = I2
          SEGADJ,MCHAML
          I1 = I1 + 1
          MCHELM.ICHAML(I1)=MCHAML
          IF (I1 .NE. IMCH) THEN
            MCHELM.CONCHE(I1)=MCHELM.CONCHE(IMCH)
            MCHELM.IMACHE(I1)=MCHELM.IMACHE(IMCH)
            DO 301 I3=1,N3
              MCHELM.INFCHE(I1,I3)=MCHELM.INFCHE(IMCH,I3)
 301        CONTINUE
          ENDIF
 
        ELSE
C         Le MCHAML est inchangé (on garde le MCHAML initial)
          I1 = I1 + 1
          SEGSUP,MCHAML
          IF (I1 .NE. IMCH) THEN
            MCHELM.ICHAML(I1)=MCHELM.ICHAML(IMCH)
            MCHELM.CONCHE(I1)=MCHELM.CONCHE(IMCH)
            MCHELM.IMACHE(I1)=MCHELM.IMACHE(IMCH)
            DO 302 I3=1,N3
              MCHELM.INFCHE(I1,I3)=MCHELM.INFCHE(IMCH,I3)
 302        CONTINUE
          ENDIF
        ENDIF
 
 100  CONTINUE
 
C     Ajustement si necessaire du MCHELM
      IF (I1 .NE. N1) THEN
        N1 = I1
        SEGADJ,MCHELM
      ENDIF
 
      RETURN
      END