C PRLRF     SOURCE    GOUNAND   21/06/02    21:17:29     11022          
      SUBROUTINE PRLRF(LRF,
     $     IMPR,IRET)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : PRLRF
C PROJET      : Noyau linéaire NLIN
C DESCRIPTION : Imprime un segment décrivant un élément de référence.
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C APPELES          : PRBPOL
C APPELES (E/S)    : OOOETA
C APPELE PAR       : INLRFS
C***********************************************************************
C ENTREES            : LRF
C ENTREES/SORTIES    : -
C SORTIES            : -
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 20/07/99, version initiale
C HISTORIQUE : v1, 20/07/99, création
C HISTORIQUE : v2, 10/05/00, modif. du segment ELREF
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 TNLIN      
*-INC SELREF
      POINTEUR LRF.ELREF
*-INC SPOLYNO
      POINTEUR MYBPOL.POLYNS
*
      INTEGER IMPR,IRET
*
      INTEGER LRFETA
      INTEGER INDIM,INBNO,IDDL
      INTEGER IINBNO,IND,IIDDL
*
* Executable statements
*
      CALL OOOETA(LRF,LRFETA,IMOD)
      IF (LRFETA.NE.1) SEGACT LRF
      WRITE(IOIMP,*) 'Segment ELREF de pointeur',LRF
      IF (IMPR.GT.1) THEN
         WRITE(IOIMP,*) 'Nom : ',LRF.NOMLRF
         IF (IMPR.GT.2) THEN
            WRITE(IOIMP,*) 'Forme                : ',LRF.FORME
            WRITE(IOIMP,*) 'Type d''élément       : ',LRF.TYPEL
            WRITE(IOIMP,*) 'Esp. discr. inconnue : ',LRF.ESPACE
            INDIM=LRF.XCONOD(/1)
            INBNO=LRF.XCONOD(/2)
            WRITE(IOIMP,*) 'Dim. esp. référence  : ',INDIM
            WRITE(IOIMP,*) 'Nb. noeuds approx.   : ',INBNO
            IF (IMPR.GT.3) THEN
               WRITE(IOIMP,*) 'Coordonnées des noeuds d''approximation:'
               DO 1 IINBNO=1,INBNO
                  WRITE(IOIMP,4005)
     $                 IINBNO,(LRF.XCONOD(IND,IINBNO),IND=1,INDIM)
 1             CONTINUE
            ENDIF
            WRITE(IOIMP,*) 'Degré de l''approx.   : ',LRF.DEGRE
            IDDL=LRF.NPQUAF(/1)
            WRITE(IOIMP,*) 'Nb.degrés de liberté : ',IDDL
            IF (IMPR.GT.3) THEN
               WRITE(IOIMP,*) 'Pour chaque ddl, num. noeud du QUAF<=>',
     $              'forme ET num. comp. dans les champs : '
               WRITE(IOIMP,4006)
     $              (LRF.NPQUAF(IIDDL),IIDDL=1,IDDL)
               WRITE(IOIMP,4007)
     $              (LRF.NUMCMP(IIDDL),IIDDL=1,IDDL)
               WRITE(IOIMP,*) 'On ne liste pas QUENOD et ORDDER'
               MYBPOL=LRF.MBPOLY
               IF (MYBPOL.EQ.0) THEN
                  WRITE(IOIMP,*) 'Pas de base polynomiale'
               ELSE
                  CALL PRBPOL(MYBPOL,IMPR,IRET)
                  IF (IRET.NE.0) GOTO 9999
               ENDIF
            ENDIF
         ENDIF
      ENDIF
*!      WRITE(IOIMP,4004) LRF.NOMLRF,LRF.FORME,LRF.ESPACE,LRF.DEGRE,
*!     $     LRF.NPQUAF(/1)
      IF (LRFETA.NE.1) SEGDES LRF
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
 4004 FORMAT (A10,' ',A20,' ',A5,' ',I5,' ',I5)
 4005 FORMAT (2X,'Point ',I6,' :',6(1X,1PE24.16))
 4006 FORMAT (2X,'Num.noeud :',9(1X,I6))
 4007 FORMAT (2X,'Num.comp  :',9(1X,I6))
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine prlrf'
      RETURN
*
* End of subroutine prlrf
*
      END