Sources Esope | Cast3M

inelse
C INELSE    SOURCE    GOUNAND   21/06/02    21:16:30     11022          
      SUBROUTINE INELSE(MYLRFS,IMPR,IRET)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : INELSE
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 1
C               (segments).
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
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 : L2D0SE1
      REAL*8 ZERO
      PARAMETER (ZERO=0.D0)
* Elément de nom : L2D1SE2
      REAL*8 UNS2
      PARAMETER (UNS2=0.5D0)
* Elément de nom : H1D1SE2
      REAL*8 UN
      PARAMETER (UN=1.D0)
*
      INTEGER INDDL
*
* Executable statements
*
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inelse'
*
* Elément de nom : L2D0SE1
* Sur un segment : élément de Lagrange, fonction L2, approximation
*   nodale, espace de référence de dimension 1, 1 noeud, 1 degré de
*   liberté, degré de l'approximation : 0
*
* In INILRF : SEGINI ELCOUR
      CALL INILRF('L2D0SE1','SEGMENT','LAGRANGE','L2',
     $     1,1,1,0,
     $     ELCOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      ELCOUR.XCONOD(1,1)=ZERO
      ELCOUR.NPQUAF(1)=2
      ELCOUR.NUMCMP(1)=1
* 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 1, degré 0)
      CALL GBAPCO(1,0,MYBPOL,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      ELCOUR.MBPOLY=MYBPOL
      SEGDES ELCOUR
      MYLRFS.LISEL(**)=ELCOUR
*
* Elément de nom : L2D1SE2
* Sur un segment : élément de Lagrange, fonction L2, approximation
*   nodale, espace de référence de dimension 1, 2 noeuds, 2 degrés de
*   liberté, degré de l'approximation : 1
*
* In INILRF : SEGINI ELCOUR
      CALL INILRF('L2D1SE2','SEGMENT','LAGRANGE','L2',
     $     1,2,2,1,
     $     ELCOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      ELCOUR.XCONOD(1,1)=-UNS2
      ELCOUR.XCONOD(1,2)= UNS2
      ELCOUR.NPQUAF(1)=2
      ELCOUR.NUMCMP(1)=1
      ELCOUR.NPQUAF(2)=2
      ELCOUR.NUMCMP(2)=2
* 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 1, degré 1)
      CALL GBAPCO(1,1,MYBPOL,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      ELCOUR.MBPOLY=MYBPOL
      SEGDES ELCOUR
      MYLRFS.LISEL(**)=ELCOUR
*
* Elément de nom : H1D1SE2
* Sur un segment : élément de Lagrange, fonction H1, approximation
*   nodale, espace de référence de dimension 1, 2 noeuds, 2 degrés de
*   liberté, degré de l'approximation : 1
*
* In INILRF : SEGINI ELCOUR
      CALL INILRF('H1D1SE2','SEGMENT','LAGRANGE','H1',
     $     1,2,2,1,
     $     ELCOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      ELCOUR.XCONOD(1,1)=-UN
      ELCOUR.XCONOD(1,2)=UN
      ELCOUR.NPQUAF(1)=1
      ELCOUR.NUMCMP(1)=1
      ELCOUR.NPQUAF(2)=3
      ELCOUR.NUMCMP(2)=1
* 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 1, degré 1)
      CALL GBAPCO(1,1,MYBPOL,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      ELCOUR.MBPOLY=MYBPOL
      SEGDES ELCOUR
      MYLRFS.LISEL(**)=ELCOUR
*
* Elément de nom : H1D2SE3
* Sur un segment : élément de Lagrange, fonction H1, approximation
*   nodale, espace de référence de dimension 1, 3 noeuds, 3 degrés de
*   liberté, degré de l'approximation : 2
*
* In INILRF : SEGINI ELCOUR
      CALL INILRF('H1D2SE3','SEGMENT','LAGRANGE','H1',
     $     1,3,3,2,
     $     ELCOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      ELCOUR.XCONOD(1,1)=-UN
      ELCOUR.XCONOD(1,2)=ZERO
      ELCOUR.XCONOD(1,3)=UN
* Les d.d.l. sont aux noeuds 1,2,3
      DO 205 INDDL=1,3
         ELCOUR.NPQUAF(INDDL)=INDDL
         ELCOUR.NUMCMP(INDDL)=1
 205  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 1, degré 2)
      CALL GBAPCO(1,2,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 inelse'
      RETURN
*
* End of subroutine INELSE
*
      END