C PRINCI    SOURCE    CB215821  19/07/31    21:16:41     10277          
      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)
      IMPLICIT REAL*8(A-H,O-Z)

-INC PPARAM
-INC CCOPTIO
      CHARACTER*4 MMM
C
C
C           IPMODL          MODELE MMODEL
C           IPCHE1          MCHAML  CONTRAINTES ou DEFORMATIONS
C           IPCHE2          MCHAML  CARACTERISTIQUES
C           IPSTRS          MCHAML  CONTRAINTES  PRINCIPALES
C
      IPMODL=0
      IRETOU=0
      IPCHE1=0
      IPCHE2=0
      IPMODL=0
      IPSTRS=0
      IRETOU=0
      KER   =0
      IR    =0
      MMM   ='    '
C
C     LECTURE D'UN MOT CLEF
C
      CALL LIRCHA(MMM,0,IRETOU)
      IF(IRETOU.EQ.0) MMM='MOYE'
C
C     LECTURE D'UN MODEL
C
      CALL LIROBJ('MMODEL  ',IPMODL,1,IRETOU)
      CALL ACTOBJ('MMODEL  ',IPMODL,1)
      IF(IERR.NE.0) RETURN

C     LECTURE D'UN PREMIER MCHAML (CONTRAINTES ou DEFORMATIONS)
      CALL LIROBJ('MCHAML  ',IPIN,1,IRETOU)
      CALL ACTOBJ('MCHAML  ',IPIN,1)
      IF(IERR.NE.0) RETURN
      CALL REDUAF(IPIN,IPMODL,IPCHE1,0,ir,ker)
      IF (ir.NE.1) CALL erreur(ker)
      IF (IERR.NE.0) RETURN
C
C     LECTURE D'UN DEUXIEME MCHAML (CARACTERISTIQUES)
      CALL LIROBJ('MCHAML  ',IPIN,0,IRETOU)
      IF(IERR.NE.0) RETURN
      IF(IRETOU .EQ. 1)THEN
        CALL ACTOBJ('MCHAML  ',IPIN,1)

        CALL REDUAF(IPIN,IPMODL,IPCHE2,0,ir,ker)
        IF (ir.NE.1) CALL erreur(ker)
        IF (IERR.NE.0) RETURN
      ENDIF
C
C                    APPEL A PRINPO
C                    ==============
       CALL PRINPO(IPCHE1,MMM,IPCHE2,IPMODL,IPSTRS,IRET)
       IF(IRET.NE.0 .AND. IERR.EQ.0) THEN
         CALL ACTOBJ('MCHAML  ',IPSTRS,1)
         CALL ECROBJ('MCHAML  ',IPSTRS)
       ENDIF

      END