C SIGMA     SOURCE    CHAT      11/05/24    21:16:12     6978           
      SUBROUTINE SIGMA                                                          
*_______________________________________________________________________        
*                                                                               
*            OPERATEUR CONTRAINTES LINEAIRES                                    
*                                                                               
*   Ancienne syntaxe :                                                          
*   __________________                                                          
*                                                                               
*       SIG1=SIGMA ( II ) MAT1 ( CAR1 )  CHP1 ;                                 
*                                                                               
*            II    mot cle indiquant que l'on veut EPS2                         
*            MAT1  champ par {l{ment de mat{riau ou de HOOKE                    
*            CAR1  champ par {l{ment de caract{ristiques (facultatif)           
*            CHP1  CHPOINT de d{placement                                       
*                                                                               
*            JUILLET 84 EBERSOLT                                                
*            FEVRIER 87 BROCHARD :                                              
*            - LE CALCUL EFFECTIF EST FAIT DANS SIGMAP                          
*                                                                               
*                                                                               
*   Nouvelle syntaxe :                                                          
*   __________________                                                          
*                                                                               
*       SIG1=SIGMA ( II ) MODL1 | CAR1        CHP1 ;                            
*                               | HOO1 (CAR1)                                   
*                                                                               
*            II    mot cle indiquant que l'on veut EPS2                         
*            MODL1 mod}le de calcul, type MMODEL                                
*            CAR1  champ par {l{ment de caract{ristiques, type MCHAML           
*            HOO1  champ par {l{ment de matrice de HOOKE, type MCHAML           
*            CHP1  CHPOINT de d{placement                                       
*                                                                               
*            Passage aux nouveaux CHAMELEMs par I.Monnier le 6 6 1990           
*                                                                               
*_______________________________________________________________________        
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
      PARAMETER(XZER=0.D0,UNDEMI=.5D0,UN=1.D0)                                  
-INC CCOPTIO                                                                    
-INC SMCHAML                                                                    
C                                                                               
      CHARACTER*4 MOEPS2(1)                                                     
C                                                                               
      DATA MOEPS2/'LINE'/                                                       
C                                                                               
C           IPMODL          MODELE MMODEL                                       
C           ICHP1           CHAMPOINT DEPLACEMENTS                              
C           IPCHA1          CHAMELEM  MATERIAU OU DE HOOKE                      
C           IPCHA2          CHAMELEM CARACTERISTIQUE                            
C           IPSTRS          CHAMELEM  CONTRAINTES                               
C                          1 SI SIGAM DIRECTIVE 0 SINON                         
      IPCHE1=0                                                                  
      IPCHE2=0                                                                  
      IPCHA1=0                                                                  
      IPCHA2=0                                                                  
      IPCHB1=0                                                                  
      IPCHB2=0                                                                  
      ICONV =0                                                                  
      IRT9=0                                                                    
C                                                                               
C     VEUT ON CALCULER LES GRANDES DEFORMATIONS ?                               
C                                                                               
      CALL LIRMOT(MOEPS2,1,IREPS2,0)                                            
C                                                                               
C     ON LIT UN CHAMP/POINT                                                     
C                                                                               
      CALL LIROBJ('CHPOINT ',ICHP1,1,IRT1)                                      
      IF(IERR.NE.0) RETURN
C                                                                               
C     LECTURE DU MODELE                                                         
C                                                                               
      CALL LIROBJ('MMODEL',IPMODL,1,IRT1)
      IF(IERR.NE.0) RETURN
C                                                                               
C       LECTURE DU 1ER MCHAML                                                   
C                                                                               
        CALL LIROBJ('MCHAML',IPCHA1,1,IRT1)                                     
        IF(IERR.NE.0) RETURN
*  reduction du mchaml
        call reduaf(ipcha1,ipmodl,ipcha10,0,ier,ker)
        if (ier.ne.1) call erreur(ker)
        ipcha1=ipcha10
C                                                                               
C       LECTURE DU 2EME MCHAML                                                  
C                                                                               
        CALL LIROBJ('MCHAML',IPCHA2,0,IRT1)                                     
        if (irt1.ne.0) then
*  reduction du mchaml
        call reduaf(ipcha2,ipmodl,ipcha20,0,ier,ker)
        if (ier.ne.1) call erreur(ker)
        ipcha2=ipcha20
        endif
        if (ierr.ne.0) return
C                                                                               
        CALL RNGCHA(IPCHA1,IPCHA2,'CARACTERISTIQUES',                           
     1                            'MATRICE DE HOOKE',IPCHE1,IPCHE2)             
        IF(IERR.NE.0) RETURN
        IF (IPCHE2.EQ.0) THEN                                                   
          IMAT=1                                                                
        ELSE                                                                    
          IMAT=2                                                                
        ENDIF                                                                   
C                                                                               
C     CALCUL DES CONTRAINTES                                                    
C                                                                               
      IRT8=0                                                                    
      CALL SIGMAP(IREPS2,IPMODL,ICHP1,IPCHE1,IPCHE2,ICONV,IMAT,IPSTRS,          
     1            IRET)                                                         
C                                                                               
C     ECRITURE DU RESULTAT                                                      
C                                                                               
      IF(IRT9.EQ.0.AND.IRET.EQ.1) THEN                                          
        CALL ECROBJ('MCHAML',IPSTRS)
      ENDIF                                                                     
      RETURN                                                                    
      END