C COPIER    SOURCE    FANDEUR   10/12/14    21:15:36     6812           
      SUBROUTINE COPIER                                                         
************************************************************************        
*                                                                               
*                             C O P I E R                                       
*                             -----------                                       
*                                                                               
*            SOUS-PROGRAMME ASSOCIE A L'OPERATEUR "COPIER"                      
*                                                                               
* FONCTION:                                                                     
* ---------                                                                     
*                                                                               
*     CREER UN 2-IEME OBJET IDENTIQUE A UN OBJET DONNE.                         
*                                                                               
* PHRASE D'APPEL (EN GIBIANE):                                                  
* ----------------------------                                                  
*                                                                               
*     OBJ2 = COPIER OBJ1 ;                                                      
*                                                                               
* OPERANDE ET RESULTAT:                                                         
* ---------------------                                                         
*                                                                               
*     OBJ1      TYPE-1      OBJET DONT ON VEUT UNE COPIE.                       
*     OBJ2      TYPE-1      COPIE DE "OBJ1".                                    
*                                                                               
*     TYPE-1 VAUT 'LISTCHPO' OU 'CHPOINT' OU 'LISTREEL'  OU 'MCHAML'            
*     (A COMPLETER AU FUR ET A MESURE)                                          
*                                                                               
* LEXIQUE: (ORDRE ALPHABETIQUE)                                                 
* --------                                                                      
*                                                                               
* MODE DE FONCTIONNEMENT:                                                       
* -----------------------                                                       
*                                                                               
*     APPEL D'UN SOUS-PROGRAMME DISTINCT SELON LE TYPE DE L'OBJET QUE           
*     L'ON COPIE.                                                               
*                                                                               
* SOUS-PROGRAMMES APPELES:                                                      
* ------------------------                                                      
*                                                                               
*      ECROBJ,COPIE1,COPIE2,COPIE3,COPIE4                                       
*                                                                               
* AUTEUR, DATE DE CREATION:                                                     
* -------------------------                                                     
*                                                                               
*     PASCAL MANIGOT     11 AVRIL 1985                                          
*                                                                               
* LANGAGE:                                                                      
* --------                                                                      
*                                                                               
*     FORTRAN77 + EXTENSION                                                     
*                                                                               
************************************************************************        
*                                                                               
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
-INC CCOPTIO                                                                    
-INC SMCHPOI                                                                    
-INC SMELEME                                                                    
-INC SMLREEL                                                                    
-INC SMTABLE
      CHARACTER*4 MOLIS(1)                                                      
      CHARACTER*8 MOTYPE                                                        
      DATA MOLIS/'GEOM'/                                                        
      CALL LIRMOT(MOLIS,1,IRET,0)                                               
C PP
      CALL LIROBJ('TABLE',IPOIN1,0,IRETOU)
      IF(IRETOU.EQ.0) GO TO 10
      MOTYPE = 'TABLE'
      MTAB1=IPOIN1
      SEGINI,MTABLE=MTAB1
      SEGDES,MTABLE
      IPOIN2=MTABLE
      GO TO 900
  10  CONTINUE
C PP
      CALL LIROBJ('LISTCHPO',IPOIN1,0,IRETOU)                                   
      IF(IRETOU.EQ.0) GO TO 20                                                  
      MOTYPE = 'LISTCHPO'                                                       
      CALL COPIE1 (IPOIN1,IPOIN2)                                               
      GO TO 900                                                                 
C                                                                               
C  COPIE DE CHPOINT                                                             
C                                                                               
  20  CONTINUE                                                                  
      CALL LIROBJ('CHPOINT',IPOIN1,0,IRETOU)                                    
      IF(IRETOU.EQ.0) GO TO 30                                                  
      MOTYPE = 'CHPOINT'                                                        
         CALL COPIE2 (IPOIN1,IPOIN2)                                            
         IF(IRET.NE.0) THEN                                                     
            MCHPOI=IPOIN2                                                       
            SEGACT MCHPOI                                                       
            DO 1 I=1,IPCHP(/1)                                                  
            MSOUPO=IPCHP(I)                                                     
            SEGACT MSOUPO*MOD
            IPT1=IGEOC                                                          
            SEGINI,MELEME=IPT1                                                  
            SEGDES MELEME                                                       
            IGEOC=MELEME                                                        
            SEGDES MSOUPO                                                       
   1        CONTINUE                                                            
         ENDIF                                                                  
      GO TO 900                                                                 
C                                                                               
C  COPIE DE MCHAML                                                              
C                                                                               
  30  CONTINUE                                                                  
      CALL LIROBJ('MCHAML',IPOIN1,0,IRETOU)                                     
      IF(IRETOU.EQ.0) GO TO 40                                                  
      MOTYPE = 'MCHAML'                                                         
      CALL COPIE8(IPOIN1,IPOIN2)                                                
      GO TO 900                                                                 
C                                                                               
C  COPIE DE LISTREEL                                                            
C                                                                               
  40  CONTINUE                                                                  
      CALL MESLIR(-148)                                                         
      CALL LIROBJ('LISTREEL',IPOIN1,1,IRETOU)                                   
      MOTYPE = 'LISTREEL'                                                       
      IF(IERR.NE.0) RETURN                                                      
      CALL COPIE4(IPOIN1,IPOIN2)                                                
      GO TO 900                                                                 
C                                                                               
 900  CONTINUE                                                                  
      CALL ECROBJ (MOTYPE,IPOIN2)                                               
                                                                                
      RETURN                                                                    
      END