C MSCHP1    SOURCE    GOUNAND   12/08/01    22:29:15     7453           
      SUBROUTINE MSCHP1(IPO2,IPO1,ICLE,IRET,ISOM)                               
C=======================================================================        
C  ENTREE                                                                       
C     IPO1 = POINTEUR SUR LE PREMIER CHPO
C     IPO2 = POINTEUR SUR LE SECOND  CHPO
C     ICLE = ENTIER CARACTERISANT LE TYPE DE COMPARAISON
C     ISOM = 1 SI ON VEUT LA SOMME, 0 SINON
C  SORTIE                                                                       
C     IRET = POINTEUR SUR LE CHAMP RESULTAT SI ISOM=0
C     IRET = SOMME DES 1 ET DES 0           SI ISOM=1
C=======================================================================        
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
-INC SMCHPOI                                                                    
-INC CCOPTIO                                                                    
-INC SMELEME                                                                    
-INC SMCOORD                                                                    
-INC TMTRAV                                                                     
      SEGMENT/MTRA/(NOPOIN(XCOOR(/1)/(IDIM+1)))                                 
      SEGMENT MTR1                                                              
       CHARACTER*4 IPCOM(0)                                                     
      ENDSEGMENT                                                                
      SEGMENT/MTR4/(IPHAR(0))                                                   
      CHARACTER*8 MOT                                                           
      KSOM=0                                                                    
C                                                                               
C POUR INFERIEUR, IDEM SUPERIEUR EN INVERSANT IPO1 ET IPO2
C                                                                               
      IF (ICLE.EQ.4.OR.ICLE.EQ.5) THEN                                          
        IKKK=IPO2
        IPO2=IPO1
        IPO1=IKKK
        IF (ICLE.EQ.4) ICLE=2
        IF (ICLE.EQ.5) ICLE=1
      ENDIF                                                                     
C                                                                               
      SEGINI MTRA,MTR1,MTR4                                                     
C                                                                               
C MISE A ZERO DE NOPOIN
C                                                                               
      DO 10 IA=1,XCOOR(/1)/(IDIM+1)
        NOPOIN(IA)=0
   10 CONTINUE
C                                                                               
C CREATION DE NOPOIN ET DE IPCOM
C                                                                               
      MCHPOI=IPO2                                                               
      SEGACT MCHPOI                                                             
      IK=0                                                                      
      NSOUPO=IPCHP(/1)                                                          
C                                                                               
C BOUCLE SUR LES SOUS REFERENCES DU SECOND CHPO
C                                                                               
      DO 20 IA=1,NSOUPO
        MSOUPO=IPCHP(IA)
        SEGACT MSOUPO
        MELEME=IGEOC
        SEGACT MELEME
        NBNN=NUM(/1)
        NBELEM=NUM(/2)
        DO 30 IB=1,NBELEM
          K=NUM(1,IB)
          IF(NOPOIN(K).NE.0) GO TO 30
          IK=IK+1
          NOPOIN(K)=IK
   30   CONTINUE
        SEGDES MELEME
        NCBBB=NOCOMP(/2)
        DO 40 IB=1,NCBBB
          NC=IPCOM(/2)
          DO 50 IC=1,NC
            IF(IPCOM(IC).NE.NOCOMP(IB)) GO TO 50
            IF(IPHAR(IC).EQ.NOHARM(IB)) GO TO 40
   50     CONTINUE
          IPCOM(**)=NOCOMP(IB)
          IPHAR(**)=NOHARM(IB)
   40   CONTINUE
        SEGDES MSOUPO
   20 CONTINUE
      SEGDES MCHPOI                                                             
C                                                                               
      NNIN=IPCOM(/2)                                                                   
      NNNOE=IK                                                                  
      SEGINI MTRAV                                                              
C                                                                               
C INITIALISATION A ZERO DES TABLEAUX
C                                                                               
      DO 60 IB=1,NNNOE
      DO 60 IA=1,NNIN
        BB(IA,IB)=0.D0
        IBIN(IA,IB)=0
   60 CONTINUE
C                                                                               
C CREATION DE INCO
C                                                                               
      DO 70 IA=1,NNIN
        INCO(IA)=IPCOM(IA)
        NHAR(IA)=IPHAR(IA)
   70 CONTINUE
C                                                                               
C CREATION DE BB,IBIN,IGEO A PARTIR DES VALEURS DU PREMIER CHPO
C                                                                               
      MCHPOI=IPO1                                                               
      SEGACT MCHPOI                                                             
      NSOUPO=IPCHP(/1)                                                          
      DO 80 IA=1,NSOUPO
        MSOUPO=IPCHP(IA)
        SEGACT MSOUPO
        MELEME=IGEOC
        SEGACT MELEME
        MPOVAL=IPOVAL
        SEGACT MPOVAL
        NBELEM=NUM(/2)
        N=VPOCHA(/1)
        NC=VPOCHA(/2)
        NC1=NOCOMP(/2)
C                                                                               
        DO 90 IB=1,NC1
          DO 100 IC=1,NNIN
            IF(NOCOMP(IB).NE.IPCOM(IC)) GO TO 100
            IF(NOHARM(IB).EQ.IPHAR(IC)) GO TO 110
  100     CONTINUE
C                                                                               
C ERREUR : PAS DE CORRESPONDANCE DES COMPOSANTES DES 2 CHPO
C                                                                               
          CALL ERREUR(488)
          SEGSUP MTRAV,MTRA,MTR1,MTR4
          SEGDES MCHPOI,MELEME,MSOUPO,MPOVAL
          RETURN
  110     CONTINUE
          DO 120 ID=1,NBELEM
            KI=NOPOIN(NUM(1,ID))
            IGEO(KI)=NUM(1,ID)
            IBIN(IC,KI)=1
            BB(IC,KI)=VPOCHA(ID,IB)
  120     CONTINUE
   90   CONTINUE
        SEGDES MELEME,MSOUPO,MPOVAL
   80 CONTINUE
      SEGDES MCHPOI                                                             
C                                                                               
C COMPARAISON PROPREMENT DITE
C                                                                               
      MCHPOI=IPO2                                                               
      SEGACT MCHPOI                                                             
      NSOUPO=IPCHP(/1)                                                          
      DO 130 IA=1,NSOUPO
        MSOUPO=IPCHP(IA)
        SEGACT MSOUPO
        MELEME=IGEOC
        SEGACT MELEME
        MPOVAL=IPOVAL
        SEGACT MPOVAL
        NBELEM=NUM(/2)
        N=VPOCHA(/1)
        NC=VPOCHA(/2)
        NC1=NOCOMP(/2)
C                                                                               
        DO 140 IB=1,NC1
          DO 150 IC=1,NNIN
            IF(NOCOMP(IB).NE.IPCOM(IC)) GO TO 150
            IF(NOHARM(IB).EQ.IPHAR(IC)) GO TO 160
  150     CONTINUE
  160     CONTINUE
          DO 170 ID=1,NBELEM
            KI=NOPOIN(NUM(1,ID))
            IGEO(KI)=NUM(1,ID)
            IF(IBIN(IC,KI).NE.1) THEN
              CALL ERREUR(214)
              SEGSUP MTRAV,MTRA,MTR1,MTR4
              SEGDES MCHPOI,MELEME,MSOUPO,MPOVAL
              RETURN
            ENDIF
            IF(ISOM.EQ.0) THEN
              IF(ICLE.EQ.1) THEN
                IF(BB(IC,KI).GT.VPOCHA(ID,IB)) THEN
                  BB(IC,KI)=1.D0
                ELSE
                  BB(IC,KI)=0.D0
                ENDIF
              ELSEIF(ICLE.EQ.2) THEN
                IF(BB(IC,KI).GE.VPOCHA(ID,IB)) THEN
                  BB(IC,KI)=1.D0
                ELSE
                  BB(IC,KI)=0.D0
                ENDIF
              ELSEIF(ICLE.EQ.3) THEN
                IF(BB(IC,KI).EQ.VPOCHA(ID,IB)) THEN
                  BB(IC,KI)=1.D0
                ELSE
                  BB(IC,KI)=0.D0
                ENDIF
              ELSEIF(ICLE.EQ.6) THEN
                IF(BB(IC,KI).NE.VPOCHA(ID,IB)) THEN
                  BB(IC,KI)=1.D0
                ELSE
                  BB(IC,KI)=0.D0
                ENDIF
              ENDIF
            ELSEIF(ISOM.EQ.1) THEN
              IF(ICLE.EQ.1) THEN
                IF(BB(IC,KI).GT.VPOCHA(ID,IB)) KSOM=KSOM + 1
              ELSEIF(ICLE.EQ.2) THEN
                IF(BB(IC,KI).GE.VPOCHA(ID,IB)) KSOM=KSOM + 1
              ELSEIF(ICLE.EQ.3) THEN
                IF(BB(IC,KI).EQ.VPOCHA(ID,IB)) KSOM=KSOM + 1
              ELSEIF(ICLE.EQ.6) THEN
                IF(BB(IC,KI).NE.VPOCHA(ID,IB)) KSOM=KSOM + 1
              ENDIF
            ENDIF
C                                                                               
  170     CONTINUE
  140   CONTINUE
        SEGDES MELEME,MSOUPO,MPOVAL
  130 CONTINUE
      SEGDES MCHPOI                                                             
      ITRAV=MTRAV                                                               
      SEGDES MTRAV                                                              
      IF(ISOM.EQ.1) THEN
        SEGSUP MTRAV,MTRA,MTR1,MTR4
        IRET=KSOM
      ELSE
C                                                                               
C     RECONSTUCTION DE LA PARTITION                                             
C                                                                               
        CALL CRECHP(ITRAV,ICHPOI)
C                                                                               
        SEGSUP MTRAV,MTRA,MTR1,MTR4
        IRET=ICHPOI
        MCHPOI=ICHPOI
        MCHPO1=IPO1
        SEGACT MCHPOI*MOD
        SEGACT MCHPO1
        MOT=MCHPO1.MTYPOI
        MTYPOI=MOT
        NAT=MCHPO1.JATTRI(/1)
        NSOUPO=IPCHP(/1)
        SEGADJ MCHPOI
        DO 180 II=1,NAT
          JATTRI(II)=MCHPO1.JATTRI(II)
 180    CONTINUE
C
        SEGDES MCHPOI,MCHPO1
      ENDIF
C                                                                               
      RETURN                                                                    
      END