C ECMORS    SOURCE    PV        20/09/26    21:16:35     10724          
      SUBROUTINE ECMORS(PMORS,IZA,NIVIMP)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C***********************************************************************
C NOM         : ECMORS
C DESCRIPTION : Impression d'un objet de type matrice stockée
C               en morse.
C               PMORS est son profil et IZA sont ses valeurs.
C               cf. include SMMATRIK
C
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C APPELES : -
C***********************************************************************
C ENTREES            : PMORS, IZA, NIVIMP
C ENTREES/SORTIES    : -
C SORTIES            : -
C CODE RETOUR (IRET) : -
C    PMORS  : segment de type PMORS (include SMMATRIK)
C             profil de la matrice stockée en morse.
C    IZA    : segment de type IZA (include SMMATRIK)
C             valeurs des coefficients de la matrice morse.
C             Normalement, ils sont tous non nulles...
C    NIVIMP : niveau d'impression. Suivant sa valeur, on obtient :
C  Convention (probablement non totalement respectée) :
C  ----------   0 : presque rien (numéro de pointeur)
C               1 : affichage du chapeau MINC
C               2 : affichage des données concernant les objets
C                   pointés par MINC (s'il y en a)
C               3 : affichage du contenu des objets vectoriels
C               4 : affichage du contenu des objets matriciels
C On ne change pas l'état (actif ou inactif) des segments PMORSC et IZA.
C***********************************************************************
C VERSION    : v1, 01/04/98, version initiale
C HISTORIQUE : v1, 01/04/98, création
C HISTORIQUE : 29/10/98, modif. l'état du segment reste inchangé
C                        en sortie
C HISTORIQUE :
C HISTORIQUE :
C***********************************************************************
C Prière de PRENDRE LE TEMPS de compléter les commentaires
C en cas de modification de ce sous-programme afin de faciliter
C la maintenance !
C***********************************************************************

-INC PPARAM
-INC CCOPTIO
-INC SMMATRIK
* Variable d'état des segments PMORS et IZA
      INTEGER PMOETA,IZAETA
*
* Executable statements
*
      IF (PMORS.EQ.0) THEN
         WRITE(IOIMP,*) 'Nil PMORS pointer transmitted to ecmors'
         GOTO 9999
      ENDIF
      CALL OOOETA(PMORS,PMOETA,IMOD)
      IF (PMOETA.NE.1) SEGACT PMORS
*
      NTT=IA(/1)-1
      NJA=JA(/1)
      WRITE(IOIMP,4001) 'NTT =',NTT,'Nb total de DDL'
      WRITE(IOIMP,4001) 'NJA =',NJA,'Nb tot. val. <> 0'
      IF (NIVIMP.GT.2) THEN
         IF (IZA.EQ.0) THEN
            WRITE(IOIMP,*) 'Nil IZA pointer transmitted to ecmors'
*            GOTO 9999
         ENDIF
         IF (IZA.NE.0) THEN
            CALL OOOETA(IZA,IZAETA,IMOD)
            IF (IZAETA.NE.1) SEGACT IZA
         ENDIF
*
         WRITE(IOIMP,2001) 'Segment PMORS de pointeur ',PMORS
         WRITE(IOIMP,2001) 'Segment IZA de pointeur ',IZA
         DO 1 I=1,NTT
            WRITE(IOIMP,4002) I
            NB=IA(I+1)-IA(I)
            LOFSET=IA(I)
            WRITE(IOIMP,4003) (JA(LOFSET+J),J=0,NB-1)
            IF (IZA.NE.0) THEN
               IF (NIVIMP.GT.3) THEN
                  WRITE(IOIMP,4005) ( A(LOFSET+J),J=0,NB-1)
               ELSE
                  WRITE(IOIMP,4004) ( A(LOFSET+J),J=0,NB-1)
               ENDIF
            ENDIF
 1          CONTINUE
            IF (IZA.NE.0) THEN
               IF (IZAETA.NE.1) SEGDES IZA
            ENDIF
      ENDIF
      IF (PMOETA.NE.1) SEGDES PMORS
*
* Normal termination
*
      RETURN
*
* Format handling
*
 2001 FORMAT (A,1X,I6)
 4001 FORMAT (A,I6,2X,A)
 4002 FORMAT ('LIGNE :',1X,I6)
 4003 FORMAT (2X,'Colonne :',6(1X,I6,4X))
 4004 FORMAT (2X,'Valeur  :',6(1X,1PE10.2))
 4005 FORMAT (2X,'Valeur  :',6(1X,1PE24.16))
*
* Error handling
*
 9999 CONTINUE
      WRITE(IOIMP,*) 'An error was detected in subroutine ecmors'
      RETURN
*
* End of subroutine ECMORS
*
      END