C INELPR    SOURCE    GOUNAND   06/12/19    21:15:20     5612           
      SUBROUTINE INELPR(MYLRFS,IMPR,IRET)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : INELPR
C PROJET      : Noyau linéaire NLIN
C DESCRIPTION : Remplit le segment des éléments de référence
C               avec les éléments de référence de dimension 3,
C               de forme géométrique prismatique à base triangle.
C         
C REFERENCES  :
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C APPELES          : INILRF, INILAG, FILRF, PROLRF, PROBAP, GBAPCO
C APPELE PAR       : INLRFS
C***********************************************************************
C ENTREES            : -
C ENTREES/SORTIES    : MYLRFS
C SORTIES            : -
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 23/03/00, version initiale
C HISTORIQUE : v1, 23/03/00, 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 CCOPTIO
CBEGININCLUDE SELREF
      SEGMENT ELREF
      CHARACTER*(LNNOM)  NOMLRF
      CHARACTER*(LNFORM) FORME 
      CHARACTER*(LNTYPL) TYPEL 
      CHARACTER*(LNESP)  ESPACE
      INTEGER DEGRE
      REAL*8 XCONOD(NDIMEL,NBNOD)
      INTEGER NPQUAF(NBDDL)
      INTEGER NUMCMP(NBDDL)
      INTEGER QUENOD(NBDDL)
      INTEGER ORDDER(NDIMEL,NBDDL)
      POINTEUR MBPOLY.POLYNS
      ENDSEGMENT
      SEGMENT ELREFS
      POINTEUR LISEL(0).ELREF
      ENDSEGMENT
CENDINCLUDE SELREF
      POINTEUR MYLRFS.ELREFS
      POINTEUR ELCOUR.ELREF
      POINTEUR ELPRO1.ELREF
      POINTEUR ELPRO2.ELREF
CBEGININCLUDE SPOLYNO
      SEGMENT POLYNO
      REAL*8  COEMON(NBMON)
      INTEGER EXPMON(NDIML,NBMON)
      ENDSEGMENT 
      SEGMENT POLYNS
      POINTEUR LIPOLY(NBPOLY).POLYNO
      ENDSEGMENT
CENDINCLUDE SPOLYNO
      POINTEUR MYBPOL.POLYNS
      POINTEUR MYBPO1.POLYNS
      POINTEUR MYBPO2.POLYNS
      POINTEUR IZ2.POLYNO
*
      INTEGER IMPR,IRET
* Elément de nom : L2D1PR4
      REAL*8 UNS6,UNS2,DEUXS3,UNS3,UN,ZERO
      PARAMETER (UNS6=1.D0/6.D0)
      PARAMETER (UNS2=1.D0/2.D0)
      PARAMETER (DEUXS3=2.D0/3.D0)
      PARAMETER (UNS3=1.D0/3.D0)
      PARAMETER (UN=1.D0)
      PARAMETER (ZERO=0.D0)
*
      INTEGER INDDL
*     
* Executable statements
*
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inelpr'
*
* Elément de nom : L2D0PR1
* Sur un prisme : élément de Lagrange, fonction L2, approximation
*   nodale, espace de référence de dimension 3, 1 noeuds, 1 degrés de
*   liberté, degré de l'approximation : 0
*       
* In INILRF : SEGINI ELCOUR
      CALL INILRF('L2D0PR1','PRISME','LAGRANGE','L2',
     $     3,1,1,0,
     $     ELCOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILRF('L2D0TR1',MYLRFS,ELPRO1,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILRF('L2D0SE1',MYLRFS,ELPRO2,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL PROLRF(ELPRO1,ELPRO2,ELCOUR,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      ELCOUR.NPQUAF(1)=21
      ELCOUR.NUMCMP(1)=1
* Initialise la correspondance ddl-noeud+ord.der
      CALL INILAG(ELCOUR,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGACT ELPRO1
      MYBPO1=ELPRO1.MBPOLY
      SEGDES ELPRO1
      SEGACT ELPRO2
      MYBPO2=ELPRO2.MBPOLY
      SEGDES ELPRO2
* Calcule la base polynômiale produit
      CALL PROBAP(MYBPO1,MYBPO2,MYBPOL,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      ELCOUR.MBPOLY=MYBPOL
      SEGDES ELCOUR
      MYLRFS.LISEL(**)=ELCOUR
*
* Elément de nom : L2D1PR4
* Sur un prisme : élément de Lagrange, fonction L2, approximation
*   nodale, espace de référence de dimension 3, 4 noeuds, 4 degrés de
*   liberté, degré de l'approximation : 1
*       
* In INILRF : SEGINI ELCOUR
      CALL INILRF('L2D1PR4','PRISME','LAGRANGE','L2',
     $     3,4,4,1,
     $     ELCOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      ELCOUR.XCONOD(1,1)= UNS6
      ELCOUR.XCONOD(2,1)= UNS6
      ELCOUR.XCONOD(3,1)=-UNS2
      ELCOUR.XCONOD(1,2)= DEUXS3
      ELCOUR.XCONOD(2,2)= UNS6
      ELCOUR.XCONOD(3,2)= UNS2
      ELCOUR.XCONOD(1,3)= UNS6
      ELCOUR.XCONOD(2,3)= DEUXS3
      ELCOUR.XCONOD(3,3)=-UNS2
      ELCOUR.XCONOD(1,4)= UNS3
      ELCOUR.XCONOD(2,4)= UNS3
      ELCOUR.XCONOD(3,4)= UNS2
* Les d.d.l. sont au noeud 21
      DO 199 INDDL=1,4
         ELCOUR.NPQUAF(INDDL)=21
         ELCOUR.NUMCMP(INDDL)=INDDL
 199  CONTINUE
* Initialise la correspondance ddl-noeud+ord.der
      CALL INILAG(ELCOUR,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
* Génère une base polynômiale complète (dimension 3, degré 1)
      CALL GBAPCO(3,1,MYBPOL,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      ELCOUR.MBPOLY=MYBPOL
      SEGDES ELCOUR
      MYLRFS.LISEL(**)=ELCOUR
*
* Elément de nom : H1D1PR6
* Sur un prisme : élément de Lagrange, fonction H1, approximation
*   nodale, espace de référence de dimension 3, 6 noeuds, 6 degrés de
*   liberté, degré de l'approximation : 1
*       
* In INILRF : SEGINI ELCOUR
      CALL INILRF('H1D1PR6','PRISME','LAGRANGE','H1',
     $     3,6,6,1,
     $     ELCOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILRF('H1D1TR3',MYLRFS,ELPRO1,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILRF('H1D1SE2',MYLRFS,ELPRO2,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL PROLRF(ELPRO1,ELPRO2,ELCOUR,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
* Les d.d.l. sont aux noeuds 1,3,5...
      DO 201 INDDL=1,3
         ELCOUR.NPQUAF(INDDL)=(2*INDDL)-1
         ELCOUR.NUMCMP(INDDL)=1
 201  CONTINUE
* ... et 10,12,14.
      DO 203 INDDL=4,6
         ELCOUR.NPQUAF(INDDL)=(2*(INDDL-4))+10
         ELCOUR.NUMCMP(INDDL)=1
 203  CONTINUE
* Initialise la correspondance ddl-noeud+ord.der
      CALL INILAG(ELCOUR,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGACT ELPRO1
      MYBPO1=ELPRO1.MBPOLY
      SEGDES ELPRO1
      SEGACT ELPRO2
      MYBPO2=ELPRO2.MBPOLY
      SEGDES ELPRO2
* Calcule la base polynômiale produit
      CALL PROBAP(MYBPO1,MYBPO2,MYBPOL,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      ELCOUR.MBPOLY=MYBPOL
      SEGDES ELCOUR
      MYLRFS.LISEL(**)=ELCOUR
*
* Elément de nom : CRD1PR5
* Sur un prisme : élément de Lagrange, fonction continue au centre des
* faces, approximation nodale, espace de référence de dimension 3, 5
*      noeuds, 5 degrés de 
*   liberté, degré de l'approximation : 1
*       
* In INILRF : SEGINI ELCOUR
      CALL INILRF('CRD1PR5','PRISME','LAGRANGE','HFAC',
     $     3,5,5,1,
     $     ELCOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      ELCOUR.XCONOD(1,1)=UNS2
      ELCOUR.XCONOD(2,1)=ZERO
      ELCOUR.XCONOD(3,1)=ZERO
      ELCOUR.XCONOD(1,2)=UNS2
      ELCOUR.XCONOD(2,2)=UNS2
      ELCOUR.XCONOD(3,2)=ZERO
      ELCOUR.XCONOD(1,3)=ZERO
      ELCOUR.XCONOD(2,3)=UNS2
      ELCOUR.XCONOD(3,3)=ZERO
      ELCOUR.XCONOD(1,4)=UNS3
      ELCOUR.XCONOD(2,4)=UNS3
      ELCOUR.XCONOD(3,4)=-UN
      ELCOUR.XCONOD(1,5)=UNS3
      ELCOUR.XCONOD(2,5)=UNS3
      ELCOUR.XCONOD(3,5)=+UN
* Les d.d.l. sont aux noeuds 16,17,18,19,20
      DO INDDL=1,5
         ELCOUR.NPQUAF(INDDL)=INDDL+15
         ELCOUR.NUMCMP(INDDL)=1
      ENDDO
* Initialise la correspondance ddl-noeud+ord.der
      CALL INILAG(ELCOUR,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
* Génère une base polynômiale complète (dimension 3, degré 1)
      CALL GBAPCO(3,1,MYBPOL,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
* Il faut rajouter le monôme z^2
      SEGACT MYBPOL*MOD
      NDIML=3
      NBMON=1
      SEGINI IZ2
      IZ2.COEMON(1)=UN
      IZ2.EXPMON(3,1)=2
      SEGDES IZ2
      MYBPOL.LIPOLY(**)=IZ2
      SEGDES MYBPOL
      ELCOUR.MBPOLY=MYBPOL
      SEGDES ELCOUR
      MYLRFS.LISEL(**)=ELCOUR
*
* Elément de nom : H1D2PR15
* Sur un prisme : élément de Lagrange incomplet (Serendip), 
*   fonction H1, approximation
*   nodale, espace de référence de dimension 3, 15 noeuds, 15 degrés de
*   liberté, degré de l'approximation : 2
*       
* In INILRF : SEGINI ELCOUR
      CALL INILRF('H1D2PR15','PRISME','LAGRANGE','H1',
     $     3,15,15,2,
     $     ELCOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILRF('H1D2TR6',MYLRFS,ELPRO1,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILRF('H1D1TR3',MYLRFS,ELPRO2,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
C Inutile
C      ELCOUR.XCONOD(1,1)=ZERO
C      ELCOUR.XCONOD(2,1)=ZERO
C      ELCOUR.XCONOD(3,1)=ZERO
* Les d.d.l. sont aux noeuds 1,...,15
      DO 217 INDDL=1,15
         ELCOUR.NPQUAF(INDDL)=INDDL
         ELCOUR.NUMCMP(INDDL)=1
 217  CONTINUE
* Initialise la correspondance ddl-noeud+ord.der
      CALL INILAG(ELCOUR,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
* Pas de base polynômiale (on recopie l'élément de castem)
      ELCOUR.MBPOLY=0
      SEGDES ELCOUR
      MYLRFS.LISEL(**)=ELCOUR
*
* Elément de nom : H1D2PR18
* Sur un prisme : élément de Lagrange, fonction H1, approximation
*   nodale, espace de référence de dimension 3, 18 noeuds, 18 degrés de
*   liberté, degré de l'approximation : 2
*       
* In INILRF : SEGINI ELCOUR
      CALL INILRF('H1D2PR18','PRISME','LAGRANGE','H1',
     $     3,18,18,2,
     $     ELCOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILRF('H1D2TR6',MYLRFS,ELPRO1,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILRF('H1D2SE3',MYLRFS,ELPRO2,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL PROLRF(ELPRO1,ELPRO2,ELCOUR,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
* Les ieme d.d.l sont aux noeuds j
      DO IDDL=1,6
         ELCOUR.NPQUAF(IDDL)=IDDL
      ENDDO
      ELCOUR.NPQUAF( 7)= 7
      ELCOUR.NPQUAF( 8)=16  
      ELCOUR.NPQUAF( 9)= 8  
      ELCOUR.NPQUAF(10)=17  
      ELCOUR.NPQUAF(11)= 9
      ELCOUR.NPQUAF(12)=18
      DO IDDL=13,18
         ELCOUR.NPQUAF(IDDL)=IDDL-3
      ENDDO
      DO IDDL=1,18
         ELCOUR.NUMCMP(IDDL)=1
      ENDDO
* Initialise la correspondance ddl-noeud+ord.der
      CALL INILAG(ELCOUR,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGACT ELPRO1
      MYBPO1=ELPRO1.MBPOLY
      SEGDES ELPRO1
      SEGACT ELPRO2
      MYBPO2=ELPRO2.MBPOLY
      SEGDES ELPRO2
* Calcule la base polynômiale produit
      CALL PROBAP(MYBPO1,MYBPO2,MYBPOL,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      ELCOUR.MBPOLY=MYBPOL
      SEGDES ELCOUR
      MYLRFS.LISEL(**)=ELCOUR
*
* Elément de nom : H1D2PR21
* Sur un prisme : élément de Lagrange, fonction H1, approximation
*   nodale, espace de référence de dimension 3, 21 noeuds, 21 degrés de
*   liberté, degré de l'approximation : 2
*       
* In INILRF : SEGINI ELCOUR
      CALL INILRF('H1D2PR21','PRISME','LAGRANGE','H1',
     $     3,21,21,2,
     $     ELCOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILRF('H1D2TR7',MYLRFS,ELPRO1,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILRF('H1D2SE3',MYLRFS,ELPRO2,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL PROLRF(ELPRO1,ELPRO2,ELCOUR,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
* Les ieme d.d.l sont aux noeuds j
      DO IDDL=1,6
         ELCOUR.NPQUAF(IDDL)=IDDL
      ENDDO
      ELCOUR.NPQUAF( 7)=19
      ELCOUR.NPQUAF( 8)= 7
      ELCOUR.NPQUAF( 9)=16  
      ELCOUR.NPQUAF(10)= 8  
      ELCOUR.NPQUAF(11)=17  
      ELCOUR.NPQUAF(12)= 9
      ELCOUR.NPQUAF(13)=18
      ELCOUR.NPQUAF(14)=21
      DO IDDL=15,20
         ELCOUR.NPQUAF(IDDL)=IDDL-5
      ENDDO
      ELCOUR.NPQUAF(21)=20
      DO IDDL=1,21
         ELCOUR.NUMCMP(IDDL)=1
      ENDDO
* Initialise la correspondance ddl-noeud+ord.der
      CALL INILAG(ELCOUR,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGACT ELPRO1
      MYBPO1=ELPRO1.MBPOLY
      SEGDES ELPRO1
      SEGACT ELPRO2
      MYBPO2=ELPRO2.MBPOLY
      SEGDES ELPRO2
* Calcule la base polynômiale produit
      CALL PROBAP(MYBPO1,MYBPO2,MYBPOL,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      ELCOUR.MBPOLY=MYBPOL
      SEGDES ELCOUR
      MYLRFS.LISEL(**)=ELCOUR
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine inelpr'
      RETURN
*
* End of subroutine INELPR
*
      END