C KSIGMA    SOURCE    CB215821  23/01/25    21:15:26     11573          
      SUBROUTINE KSIGMA
C_______________________________________________________________________
C
C     OPERATEUR KSIGMA
C
C     Construction de la matrice de raideur geometrique @ partir d'un
C     MCHAML de contraintes
C
C     Nouvelle syntaxe:
C     _________________
C
C       RIG1 =KSIG MOD1 SIG1 ( CAR1 ) 'FLAM';
C
C       MOD1=OBJET DE TYPE MMODEL
C       SIG1=MCHAML de CONTRAINTES
C       CAR1=MCHAML de CARACTERISTIQUES
C
C       RIG1=Matrice KSIGMA de sous type RIGIDITE
C
C       Passage aux nouveaux MCHAMLs par I.Monnier le 14.06.90
C
C_______________________________________________________________________
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C

-INC PPARAM
-INC CCOPTIO
-INC SMCOORD
C
      CHARACTER*4 MOFLAM(1)
      DATA MOFLAM/'FLAM'/
C
      IPCHA1=0
      IPCHA2=0
      IPCHE1=0
      IPCHE2=0
      IFLAM=0
C
      CALL LIRMOT(MOFLAM,1,IFLAM,0)
      IF (IERR.NE.0) RETURN
C
      CALL LIROBJ('MMODEL',IPMODL,1,IRT1)
      IF (IERR.NE.0) RETURN
      CALL ACTOBJ('MMODEL  ',IPMODL,1)
C
        CALL LIROBJ('MCHAML',IPIN,1,IRT1)
        IF (IERR.NE.0) RETURN
          CALL ACTOBJ('MCHAML  ',IPIN,1)
          CALL REDUAF(IPIN,IPMODL,IPCHA1,0,IR,KER)
          IF(IR   .NE. 1) CALL ERREUR(KER)
          IF(IERR .NE. 0) RETURN
C
        CALL LIROBJ('MCHAML',IPIN,0,IRT1)
        IF (IERR.NE.0) RETURN
        IPCHA2=0
        IF (IRT1 .EQ. 1) THEN
          CALL ACTOBJ('MCHAML  ',IPIN,1)
          CALL REDUAF(IPIN,IPMODL,IPCHA2,0,IR,KER)
          IF(IR   .NE. 1) CALL ERREUR(KER)
          IF(IERR .NE. 0) RETURN
        ENDIF
C
        CALL RNGCHA(IPCHA1,IPCHA2,'CONTRAINTES',
     1              'CARACTERISTIQUES',IPCHE1,IPCHE2)
C
        IF(IPCHE1.EQ.0)THEN
          MOTERR(1:16)='CONTRAINTES'
          CALL ERREUR(565)
          RETURN
        ENDIF
C
      segact mcoord
      CALL KSIGMP(IPMODL,IPCHE1,IPCHE2,IFLAM,IPRIGG)
      segdes mcoord
C
      IF (IERR.EQ.0.AND.IPRIGG.NE.0) CALL ECROBJ('RIGIDITE',IPRIGG)
C
      RETURN
      END