C BSIGMA    SOURCE    PV        09/03/12    21:15:56     6325           
      SUBROUTINE BSIGMA                                                         
C_______________________________________________________________________        
C                                                                               
C    OPERATEUR FORCES INTERNES                                                  
C                                                                               
C      FOR1 = BSIGMA  MODL1 SIG1 ( CAR1 ) (HOO1) ;                              
C                                                                               
C      MODL1  objet de type MMODEL                                              
C      SIG1   MCHAML de contraintes                                             
C      CAR1   MCHAML de caract{ristiques (facultatif)                           
C      HOO1   MCHAML  DE MATERIAU OU DE HOOKE (FACULTATIF)                      
C      FOR1   CHPOINT donnant les foces nodales                                 
C___________________________________________________________________            
C                                                                               
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
-INC CCOPTIO                                                                    
-INC SMCHAML 
-INC SMCHPOI                                                                   
C                                                                               
      ICONV=0                                                                   
      IPCHE1=0                                                                  
      IPCHE2=0                                                                  
      IPCHE3=0                                                                  
      IPCHA2=0                                                                  
      IPCHA3=0                                                                  
      CALL LIROBJ('MMODEL',IPMODL,1,IRT1)
      IF (IERR.NE.0) RETURN                                                     
C                                                                               
C      1 ER  CHAMP/ELEMENT
C                                                                               
      CALL LIROBJ('MCHAML',IPCHE1,1,IRT1)
      IF (IERR.NE.0) RETURN
      call reduaf(ipche1,ipmodl,ipch,0,ir,ker)
      if (ir.ne.1) call erreur(ker)
      IF (IERR.NE.0) RETURN
      ipche1=ipch
C                                                                               
C      2 EME CHAMP/ELEMENT (FACULTATIF)                                         
C                                                                               
      CALL LIROBJ('MCHAML',IPCHA2,0,IRT1)
      IF (IERR.NE.0) RETURN
      if (irt1.ne.0) then
       call reduaf(ipcha2,ipmodl,ipch,0,ir,ker)
       if (ir.ne.1) call erreur(ker)
       IF (IERR.NE.0) RETURN
       ipcha2=ipch
      endif
C                                                                               
C      3 EME CHAMP/ELEMENT (FACULTATIF)                                         
C                                                                               
      CALL LIROBJ('MCHAML',IPCHA3,0,IRT1)
      IF (IERR.NE.0) RETURN
      if (irt1.ne.0) then
       call reduaf(ipcha3,ipmodl,ipch,0,ir,ker)
       if (ir.ne.1) call erreur(ker)
       IF (IERR.NE.0) RETURN
       ipcha3=ipch
      endif
C                                                                               
      IF(IPCHA2.NE.0.OR.IPCHA3.NE.0)THEN                                        
        CALL RNGCHA(IPCHA2,IPCHA3,'CARACTERISTIQUES',                           
     1                            'MATRICE DE HOOKE',IPCHE2,IPCHE3)             
        IF(IERR.NE.0) GOTO 666
        IF (IPCHE3.EQ.0)THEN                                                    
           IMAT=1                                                               
         ELSE                                                                   
          IMAT=2                                                                
        ENDIF                                                                   
      ELSE                                                                      
         IMAT=0                                                                 
         IPCHE2=0                                                               
         IPCHE3=0                                                               
      ENDIF                                                                     
C                                                                               
      CALL BSIGMP(IPMODL,IPCHE1,IPCHE2,IPCHE3,IMAT,                             
     1                          ICONV,IPCHE4,IRET)                              
      if (ierr.ne.0) return
C                                                                     
      IF (IRET.EQ.1) THEN                                                       
C 
C             ATTRIBUTION D'UNE NATURE DISCRETE AU CHPO QUI SORT
C
        MCHPOI = IPCHE4
        SEGACT MCHPOI*MOD
        JATTRI(1) = 2
        SEGDES MCHPOI
C
        CALL ECROBJ('CHPOINT',IPCHE4)                                           
      ENDIF                                                                     
C                                                                               
  666 CONTINUE                                                                  
      RETURN                                                                    
      END