Sources Esope | Cast3M

inelpy
C INELPY    SOURCE    GOUNAND   21/06/02    21:16:28     11022          
      SUBROUTINE INELPY(MYLRFS,IMPR,IRET)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : INELPY
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 pyramidale.
C               C'est la pyramide de Castem
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, GBAPCO, GPOBUL, GPOFBU
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 PPARAM
-INC CCOPTIO
-INC TNLIN      
*-INC SELREF
      POINTEUR MYLRFS.ELREFS
      POINTEUR ELCOUR.ELREF
*-INC SPOLYNO
      POINTEUR MYBPOL.POLYNS
*
      INTEGER IMPR,IRET
* Elément de nom : L2D0PY1
      REAL*8 UNS4
      PARAMETER (UNS4=0.25D0)
* Elément de nom : H1D1PY5
      REAL*8 ZERO,UN
      PARAMETER (ZERO=0.D0,UN=1.D0)
* Elément de nom : H1D2PY13
      REAL*8 UNS2,UNS3
      PARAMETER (UNS2=1.D0/2.D0,UNS3=1.D0/3.D0)
*
      INTEGER INDDL
*
* Executable statements
*
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inelpy'
*
* Elément de nom : L2D0PY1
* Sur une pyramide : élément de Lagrange, fonction L2, approximation
*   nodale, espace de référence de dimension 3, 1 noeud, 1 degré de
*   liberté, degré de l'approximation : 0
*
* In INILRF : SEGINI ELCOUR
      CALL INILRF('L2D0PY1','PYRAMIDE','LAGRANGE','L2',
     $     3,1,1,0,
     $     ELCOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
C Inutile
C      ELCOUR.XCONOD(1,1)=UNS4
C      ELCOUR.XCONOD(2,1)=ZERO
C      ELCOUR.XCONOD(3,1)=ZERO
      ELCOUR.NPQUAF(1)=19
      ELCOUR.NUMCMP(1)=1
* Initialise la correspondance ddl-noeud+ord.der
      CALL INILAG(ELCOUR,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
* Pas de base polynomiale
      ELCOUR.MBPOLY=0
      SEGDES ELCOUR
      MYLRFS.LISEL(**)=ELCOUR
*
* Elément de nom : H1D1PY5
* Sur une pyramide : élément de Lagrange, fonction H1, approximation
*   nodale, espace de référence de dimension 3, 5 noeuds, 5 degrés de
*   liberté, degré de l'approximation : 1 (environ)
*
* In INILRF : SEGINI ELCOUR
      CALL INILRF('H1D1PY5','PYRAMIDE','LAGRANGE','H1',
     $     3,5,5,1,
     $     ELCOUR,
     $     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,3,5,7,13
      ELCOUR.NPQUAF(1)=1
      ELCOUR.NPQUAF(2)=3
      ELCOUR.NPQUAF(3)=5
      ELCOUR.NPQUAF(4)=7
      ELCOUR.NPQUAF(5)=13
      DO 213 INDDL=1,5
         ELCOUR.NUMCMP(INDDL)=1
 213  CONTINUE
* Initialise la correspondance ddl-noeud+ord.der
      CALL INILAG(ELCOUR,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
*Pas de base polynômiale
      ELCOUR.MBPOLY=0
      SEGDES ELCOUR
      MYLRFS.LISEL(**)=ELCOUR
*
* Elément de nom : H1D2PY13
* Sur une pyramide : élément de Lagrange, fonction H1, approximation
*   nodale, espace de référence de dimension 3, 13 noeuds, 13 degrés de
*   liberté, degré de l'approximation : 2 (environ)
*
* In INILRF : SEGINI ELCOUR
      CALL INILRF('H1D2PY13','PYRAMIDE','LAGRANGE','H1',
     $     3,13,13,2,
     $     ELCOUR,
     $     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,...,13
      DO 217 INDDL=1,13
         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
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine inelpy'
      RETURN
*
* End of subroutine INELPY
*
      END