C CHPCOO    SOURCE    PASCAL    12/12/12    21:15:02     7605           
C  CREE UN (DES) CHAMP(S) POINT TYPE SCAL A PARTIR DES COORDONNEES.             
C                                                                               
      SUBROUTINE CHPCOO (IVAL,MELEME)                                           
C                                                                               
C       IVAL VAUT 1  ON VEUT CREER UN SEUL CHPOINT CONTENANT LA                 
C                    1 ERE COORDONNES DES NOEUDS DE L'OBJET IMELE               
C                 2 IDEM POUR LA 2 EME COORDONNEES                              
C                 3 IDEM POUR LA 3 EME COORDONNEES                              
C                 0 ON CREE AUTANT DE CHPOINT QUE IDIM                          
C       IMELE EST LE POINTEUR SUR L'OBJET GEOMETRIQUE                           
C                                                                               
      IMPLICIT INTEGER(I-N)
-INC CCOPTIO                                                                    
-INC SMELEME                                                                    
-INC SMCHPOI                                                                    
-INC SMCOORD                                                                    
      SEGACT MELEME                                                             

C     CAS DU MAILLAGE VIDE
C
      ISOU1=LISOUS(/1)
      IF (ITYPEL.EQ.0.AND.ISOU1.EQ.0) THEN
        SEGDES,MELEME
        NAT=1
        NSOUPO=0
        SEGINI,MCHPOI
        MCHPOI.IFOPOI=IFOUR
        MCHPOI.JATTRI(1)=1
        SEGDES,MCHPOI
        CALL ECROBJ('CHPOINT',MCHPOI)
        IF (IVAL.EQ.0) THEN
          IF (IDIM.EQ.2) THEN
            SEGINI,MCHPO1
            MCHPO1.IFOPOI=IFOUR
            MCHPO1.JATTRI(1)=1
            SEGDES,MCHPO1
            CALL ECROBJ('CHPOINT',MCHPO1)
          ELSEIF (IDIM.EQ.3) THEN
            SEGINI,MCHPO1
            MCHPO1.IFOPOI=IFOUR
            MCHPO1.JATTRI(1)=1
            SEGDES,MCHPO1
            CALL ECROBJ('CHPOINT',MCHPO1)
            SEGINI,MCHPO2
            MCHPO2.IFOPOI=IFOUR
            MCHPO2.JATTRI(1)=1
            SEGDES,MCHPO2
            CALL ECROBJ('CHPOINT',MCHPO2)
          ENDIF
        ENDIF
        RETURN
      ENDIF
C
C
C
C     AUTRES CAS
C
      IF( ITYPEL.NE.1) CALL CHANGE (MELEME,1)                                   
      NBPOIN=NUM(/2)                                                            
      SEGACT MCOORD                                                             
      NDE=1                                                                     
      NFI=IDIM+1                                                                
      IF(IVAL.NE.0) THEN                                                        
         NDE=IVAL                                                               
         NFI=IVAL+1                                                             
      ENDIF                                                                     
      NSOUPO=1                                                                  
      NC=1                                                                      
      N=NBPOIN                                                                  
      IA=NFI-NDE                                                                
      DO 10 IAA=1,IA                                                            
      IRR= NFI-IAA        
      NAT=1                                                      
      SEGINI MCHPOI                                                             
      MOCHDE='                  chpoint de coordonnees '
      MTYPOI='        '
      JATTRI(1) = 1
      IPPOI=MCHPOI                                                              
      SEGINI MSOUPO                                                             
      SEGINI MPOVAL                                                             
      IPCHP(1)=MSOUPO                                                           
      IFOPOI = IFOMOD                                                           
      SEGDES MCHPOI                                                             
      NOCOMP(1)='SCAL'                                                          
      NOHARM(1)=NIFOUR                                                          
      IGEOC=MELEME                                                              
      IPOVAL=MPOVAL                                                             
      SEGDES MSOUPO                                                             
      DO 1 I= 1 ,N                                                              
      I1=NUM(1,I)                                                               
      I2=(I1-1)*(IDIM+1)                                                        
      VPOCHA(I,1)=XCOOR(I2+IRR)                                                 
    1 CONTINUE                                                                  
      SEGDES MPOVAL                                                             
      CALL ECROBJ('CHPOINT ',IPPOI)                                             
  10  CONTINUE                                                                  
      SEGDES MELEME                                                             
      RETURN                                                                    
      END