C MANUC5    SOURCE    CHAT      11/03/16    21:27:11     6902           
      SUBROUTINE MANUC5                                                         
*--------------------------------------------------------------------*          
*                                                                    *          
*            CREATION D'UN NOUVEAU CHAMELEM PAR MANU                 *          
*                                                                    *          
*--------------------------------------------------------------------*          
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
-INC CCOPTIO                                                                    
-INC SMLMOTS                                                                    
-INC SMLREEL                                                                    
-INC SMLENTI                                                                    
-INC SMELEME                                                                    
-INC SMMODEL    
*                                                                               
      CHARACTER*4 MOCHOI,MOTYPE(3)                                              
      CHARACTER*8 MOCHOY                                                        
      CHARACTER*8 CAR                                                           
      CHARACTER*16 JECONS                                                       
      CHARACTER*72 JEROME                                                       
      CHARACTER*8 LISMOT(5),REPA(1)                                                     
      DATA MOTYPE/'TYPE','CONS','EVOL'/ 
      DATA REPA/'REPA'/                                               
      DATA LISMOT/'NOEUD','GRAVITE','RIGIDITE','MASSE','STRESSES'/              
*                                                                               
*     Initialisation des segments                                               
*                                                                               
      IPLAC=0
      IPMAIL=0                                                                  
      IPMODL=0                                                                  
*                                                                               
*     LECTURE D'UN MODELE                                                       
*                                                                               
      CALL LIROBJ('MMODEL',IPMODL,0,IRET)                                       
      IF(IERR.NE.0)RETURN                                                       
      IF(IRET.EQ.0)THEN                                                         
*                                                                               
*     SINON D'UN MAILLAGE                                                       
*                                                                               
        MOTERR(1:8)='MAILLAGE'                                                  
        CALL MESLIR(-137)                                                       
        CALL LIROBJ('MAILLAGE',IPMAIL,0,IRET) 
*
*     SINON lecture du mot EVOL                                                 
*
        IF( IRET.EQ.0) THEN                                                     
          CALL LIRMOT ( MOTYPE(3),1,IPLAC,0)                                    
          IF (IPLAC.EQ.0) CALL ERREUR(907)
          IF (IERR.NE.0) RETURN                                                 
          IF (IPLAC.EQ.1) THEN
            CALL MANUC8
            RETURN
          ENDIF                                                                 
        ENDIF 
      ENDIF
*                                                                               
      JG=0                                                                      
      JGN=4                                                                     
      JGM=0                                                                     
      SEGINI,MLMOTS                                                             
      SEGINI,MLMOT1                                                             
      SEGINI,MLMOT2                                                             
      SEGINI,MLMOT3                                                             
      SEGINI,MLREE1                                                             
      SEGINI,MLENT2                                                             

      L1 = 0                                                                    
      LL1 = 0                                                                   
      IPLAC=0                                                                   
* 
      itart=0
      call LIRMOT(REPA,1,itart,0)                                                                                    
*
  10  CONTINUE                                                                  
*                                                                               
*        ON DESIRE LIRE UNE COMPOSANTE                                          
*                                                                               
         IRCHOI = 0                                                             
         CALL LIRCHA(MOCHOY,0,IRCHOI)                                           
         IF(IRCHOI.EQ.0) GO TO 20                                               
         MOCHOI=MOCHOY(1:4)                      
*                                                                               
*    SI ON A LU LE MOT TYPE                                                     
*                                                                               
         IF(MOCHOI.EQ.MOTYPE(1)) THEN                                           
         CALL LIRCHA(JEROME,1,L1)                                               
         GO TO 10                                                               
         ENDIF                                                                  
*                                                                               
*    SI ON A LU LE MOT CONS                                                     
*                                                                               
        IF(IPMAIL.NE.0)THEN                                                     
         IF(MOCHOI.EQ.MOTYPE(2)) THEN                                           
         CALL LIRCHA(JECONS,1,LL1)                                              
         GO TO 10                                                               
         ENDIF                                                                  
        ENDIF                                                                   
        IF(IPMODL.NE.0.AND.IPLAC.EQ.0)THEN                                      
         CALL PLACE(LISMOT,5,IPLAC,MOCHOY)                                      
         IF(IPLAC.NE.0)GOTO 10                                                  
        ENDIF                                                                   
*                                                                               
*  SINON ON TESTE LE NOMBRE DE CARACTERES LUS                                   
*                                                                               
         IF(IRCHOI.GT.4) THEN                                                   
            CALL ERREUR(536)                                                    
            GOTO 99                                                             
         ENDIF                                                                  
*                                                                               
         CALL LIRREE(RECOM,0,IRET2)                                             
         IF (IRET2.EQ.1) THEN                                                   
            MLMOT1.MOTS(**) = MOCHOI                                            
            JG=MLREE1.PROG(/1)+1                                                
            SEGADJ MLREE1                                                       
            MLREE1.PROG(JG)=RECOM                                               
         ELSE                                                                   
            CALL QUETYP(CAR,0,IRET1)                                            
            IF (IERR.NE.0) GO TO 99                                             
            CALL LIROBJ(CAR,IPTRUC,0,IRET1)                                     
            IF (IERR.NE.0) GO TO 99                                             
*                                                                               
*       ON A LU UN OBJET DE TYPE AUTRE QU'UN FLOTTANT                           
*                                                                               
               MLMOT2.MOTS(**) = MOCHOI                                         
               MLMOT3.MOTS(**)=CAR(1:4)                                         
               MOTS(**)       =CAR(5:8)                                         
               JG=MLENT2.LECT(/1)+1                                             
               SEGADJ MLENT2                                                    
               MLENT2.LECT(JG)=IPTRUC                                           
         ENDIF                                                                  
         GOTO 10                                                                
*                                                                               
 20   CONTINUE                                                                  
       IF ( L1.EQ.0) THEN                                                       
          JEROME=' '                                                            
          L1 = 1                                                                
       ENDIF                                                                    
*                                                                               
*     RECUPERATION DES ZONES ELEMENTAIRES DU MAILLAGE                           
*                                                                               
      IF(IPMAIL.NE.0)THEN                                                       
        MELEME=IPMAIL                                                           
        SEGACT MELEME                                                           
        JG=LISOUS(/1)                                                           
        IF (JG.EQ.0) THEN                                                       
         JG=1                                                                   
         SEGINI MLENT1                                                          
         MLENT1.LECT(1)=IPMAIL                                                  
        ELSE                                                                    
         SEGINI MLENT1                                                          
         DO 22  IT=1,JG                                                         
         MLENT1.LECT(IT)=LISOUS(IT)                                             
   22    CONTINUE                                                               
        ENDIF                                                                   
*                                                                               
      SEGDES MELEME                                                       
       IF ( LL1.EQ.0) THEN                                                      
         JECONS='                '                                              
       ENDIF                                                                    
*                                                                               
*     ON STOCKE LE  NOM  DU COMPOSANT                                           
*                                                                               
       JGN=16                                                                   
       JGM=JG                                                                   
       SEGINI MLMOT4                                                            
       DO 23  IT=1,JG                                                           
       MLMOT4.MOTS(IT)=JECONS                                                   
   23  CONTINUE                                                                 
*               
       CALL MANUC4(MLENT1,MLMOT1,MLMOT2,MLMOT3,MLMOTS,MLREE1,                   
     &            MLENT2,JEROME,L1,MLMOT4,IPOI1)                                
*                                                                               
*     Suppression des segments                                                  
*                                                                               
       SEGSUP,MLENT1                                                            
       SEGSUP,MLMOT4                                                            
       IF(IERR.EQ.0)CALL ECROBJ('MCHAML  ',IPOI1)                               
      ELSE                                                                      
       IF(IPLAC.EQ.0)IPLAC=1                                                    
       MMODEL=IPMODL                                                            
       SEGACT,MMODEL                                                            
       N1=KMODEL(/1)                                                            
       DO 69 I=1,N1                                                             
         IMODEL=KMODEL(I)                                                       
         SEGACT,IMODEL                                                          
  69   CONTINUE                                                           
       CALL MANUC6(IPMODL,MLMOT1,MLMOT2,MLMOT3,MLMOTS,MLREE1,                   
     &            MLENT2,JEROME,L1,IPLAC,IPOI1,itart)                                 
       DO 68 I=1,N1                                                             
         IMODEL=KMODEL(I)                                                       
         SEGDES,IMODEL                                                    
*      END DO                                                                   
  68   CONTINUE                                                                 
       SEGDES,MMODEL                                                      
       IF(IERR.EQ.0)CALL ECROBJ('MCHAML  ',IPOI1)                               
      ENDIF                                                                     
*                                                                               
*     Suppression des segments                                                  
*                                                                               
  99  CONTINUE                                                                  
      SEGSUP,MLMOTS                                                             
      SEGSUP,MLMOT1                                                             
      SEGSUP,MLMOT2                                                             
      SEGSUP,MLMOT3                                                             
      SEGSUP,MLREE1                                                             
      SEGSUP,MLENT2                                                             
      RETURN                                                                    
      END