C PRTENS    SOURCE    GOUNAND   26/01/16    21:15:08     12450          
      SUBROUTINE PRTENS()
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : PRTENS
C DESCRIPTION : Opérations sur des tenseurs (unaires pour l'instant)
C
C
C
C LANGAGE     : ESOPE
C AUTEUR      : Stephane GOUNAND (CEA/DES/ISAS/DM2S/SEMT/LTA)
C               mel : gounand@semt2.smts.cea.fr
C***********************************************************************
C APPELES          :
C APPELES (E/S)    :
C APPELES (BLAS)   :
C APPELES (CALCUL) :
C APPELE PAR       :
C***********************************************************************
C SYNTAXE GIBIANE    :
C ENTREES            :
C ENTREES/SORTIES    :
C SORTIES            :
C***********************************************************************
C VERSION    : v1, 28/08/2024, version initiale
C HISTORIQUE : v1, 28/08/2024, creation
C HISTORIQUE :
C HISTORIQUE :
C***********************************************************************
-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI
-INC SMLMOTS
*
      PARAMETER (NOTENS=14)
      CHARACTER*8 MOTENS(NOTENS),TYCHA
      CHARACTER*(LOCOMP) MOCOMP,CCCOMP
C
      DATA MOTENS/'NORM2','NORMINF','DET','TRACE','INVERSE','IDEN','LOG'
     $     ,'EXP','INVS','ABSOLU','PRINCIPA','RECOMPOS','TRANSPOS'
     $     ,'VALP'/
*
* Executable statements
*
* Mot-clé
      CALL LIRMOT(MOTENS,-NOTENS,IOTENS,1)
      IF(IERR.NE.0) RETURN
*      write(ioimp,*) 'MOTENS,IOTENS=',MOTENS(IOTENS),IOTENS
* Lecture du champ
      TYCHA='CHPOINT '
      CALL LIROBJ(TYCHA,ICHA,0,IRET)
      IF (IRET.EQ.0) THEN
         TYCHA='MCHAML  '
         CALL LIROBJ(TYCHA,ICHA,1,IRET)
         IF(IERR.NE.0) RETURN
      ENDIF
      CALL ACTOBJ(TYCHA,ICHA,1)
*
      DO 1000 ITRY=1,2
* Lecture des noms de composantes
         CALL LIROBJ('LISTMOTS',MLMOTS,ITRY-1,ILMOTS)
         IF (ILMOTS.EQ.0) THEN
            IF (TYCHA.EQ.'CHPOINT') THEN
               CALL EXTR11(ICHA,MLMOTS)
               IF(IERR.NE.0) RETURN
            ELSEIF (TYCHA.EQ.'MCHAML') THEN
               CALL EXTR17(ICHA,MLMOTS)
               IF(IERR.NE.0) RETURN
            ELSE
* On ne veut pas d'objet de type %m1:8
               MOTERR(1:8)=TYCHA
               CALL ERREUR(39)
               RETURN
            ENDIF
* Recomposition
            IF (IOTENS.EQ.12) THEN
               JGM=IDIM*(IDIM+1)
               JGN=LOCOMP
               SEGINI MLMOT1
               ICMP=0
               CCCOMP='SI'
               DO i=1,IDIM
                  WRITE(CCCOMP(3:3),FMT='(I1)') I
                  WRITE(CCCOMP(4:4),FMT='(I1)') I
                  ICMP=ICMP+1
                  MLMOT1.MOTS(ICMP)=CCCOMP
               ENDDO
               CCCOMP='CO'
               DO i=1,IDIM
                  WRITE(CCCOMP(4:4),FMT='(I1)') I
                  DO j=1,IDIM
                     WRITE(CCCOMP(3:3),FMT='(I1)') J
                     ICMP=ICMP+1
                     MLMOT1.MOTS(ICMP)=CCCOMP
                  ENDDO
               ENDDO
* Verifions la présence de toutes les composantes dans la liste devinee
               ICMP=0
               DO I=1,MOTS(/2)
                  CALL PLACE (MLMOT1.MOTS,MLMOT1.MOTS(/2),IPLAC,MOTS(I))
                  IF (IPLAC.NE.0) ICMP=ICMP+1
               ENDDO
*         write(ioimp,*) 'ICMP=',ICMP
               IF (ICMP.NE.MOTS(/2)) THEN
                  SEGSUP MLMOT1
                  MLMOT1=0
               ENDIF
            ELSE
               CALL GUESCO(TYCHA,MLMOTS,MLMOT1)
            ENDIF
            IF(IERR.NE.0) RETURN
            SEGSUP MLMOTS
            MLMOTS=MLMOT1
            IF (MLMOTS.EQ.0) THEN
               GOTO 1000
            ELSE
               if (IIMPI.NE.0) THEN
                  write(ioimp,*) 'On a devine les composantes :'
                  write(ioimp,'(10(1X,A))') 'MLMOTS=',(MOTS(i),i=1
     $                 ,MOTS(/2))
               endif
               GOTO 1001
            ENDIF
         ENDIF
 1000 CONTINUE
 1001 CONTINUE
* Pour le message d'erreur 803 éventuellement appelé dans tens1
      MOTERR(1:8)=MOTENS(IOTENS)
      CALL TENS1(ICHA,TYCHA,MLMOTS,IOTENS,ICHA1)
      IF(IERR.NE.0) RETURN
*
      IF (ILMOTS.EQ.0) SEGSUP MLMOTS
*
      CALL ACTOBJ(TYCHA,ICHA1,1)
      CALL ECROBJ(TYCHA,ICHA1)
*
* Normal termination
*
      RETURN
*
* Format handling
*
*
* Error handling
*
*
* End of subroutine PRTENS
*
      END