C PRINCI    SOURCE    CHAT      06/08/24    21:59:58     5529           
      SUBROUTINE PRINCI                                                         
C=======================================================================        
C                                                                               
C             CALCUL DE CHAMP DE CONTRAINTES PRINCIPALES                        
C                                                                               
C                                                                               
C     CHAM2 = PRINCI CHAM1  (CAR1) MODL (MOTCL);                                
C                                                                               
C     MOTCL =  'SUP ' OU 'INF ' OU 'MOYE'  POUR LES COQUES
C                     OU 'TRID' POUR LES MASSIFS
C     CAR1  =  objet de type  MCHAML    de sous type CARACTERISTIQUES           
C     CHAM1 =  objet de type  MCHAML    de sous type CONTRAINTES                
C                                                 ou DEFORMATIONS               
C     MODL  =  objet de type  MMODEL                                            
C     CHAM2 =  objet de type  MCHAML    de sous type CONTRAINTES                
C                                                    PRINCIPALES                
C                                                                               
C     Passage au nouveau Chamelem par S.RAMAHANDRY le 21/09/90                  
C                                                                               
C=======================================================================        
      IMPLICIT INTEGER(I-N)
-INC CCOPTIO                                                                    
      CHARACTER*4 MMM                                                           
C                                                                               
C                                                                               
C           IPMODL          MODELE MMODEL                                       
C           IPCHA1          CHAMELEM  CONTRAINTES ou DEFORMATIONS               
C           IPCHA2          CHAMELEM  CARACTERISTIQUES                          
C           IPCHE1          MCHAML  CONTRAINTES ou DEFORMATIONS                 
C           IPCHE2          MCHAML  CARACTERISTIQUES                            
C           IPSTRS          MCHAML  CONTRAINTES  PRINCIPALES                    
C                                                                               
      IPCHA1=0                                                                  
      IPCHA2=0                                                                  
      IPCHE1=0                                                                  
      IPCHE2=0                                                                  
      IPMODL=0                                                                  
      IPSTRS=0                                                                  
      IRTM  =0                                                                  
C                                                                               
C     LECTURE D'UN MOT CLEF                                                     
C                                                                               
      CALL LIRCHA(MMM,0,IRT0)                                                   
      IF(IRT0.EQ.0) MMM='MOYE'                                                  
C                                                                               
C     LECTURE D'UN MODEL                                                        
C                                                                               
      CALL LIROBJ('MMODEL',IPMODL,1,IRTM)
      IF(IERR.NE.0) RETURN
C ----------------------------------------------------------------------        
C                   SI ANCIENNE SYNTAXE                                         
C ----------------------------------------------------------------------        
C                                                                               
C        LECTURE D' UN PREMIER MCHAML (CONTRAINTE)                              
C                                                                               
         CALL LIROBJ('MCHAML',IPCHE1,1,IRT1)                                    
         IF(IERR.NE.0) RETURN                                                   
         IF(IRT1.EQ.0) GOTO 666                                                 
C                                                                               
C        LECTURE D' UN DEUXIEME MCHAML (CARACTERISTIQUE)                        
C                                                                               
         CALL LIROBJ('MCHAML',IPCHE2,0,IRT2)                                    
         IF(IERR.NE.0) RETURN                                                   
C                                                                               
C                                                                               
C                    APPEL A PRINPO                                             
C                    ==============                                             
C                                                                               
      CALL PRINPO(IPCHE1,MMM,IPCHE2,IPMODL,IPSTRS,IRET)                         
C ----------------------------------------------------------------------        
C                   ECRITURE DU RESULTAT                                        
C ----------------------------------------------------------------------        
C                                                                               
C                                                                               
      IF(IRET.EQ.0.OR.IERR.NE.0) GOTO 666                                       
C                                                                               
         CALL ECROBJ('MCHAML',IPSTRS)                                           
C                                                                               
  666 CONTINUE                                                                  
      RETURN                                                                    
      END