C INFALS    SOURCE    GOUNAND   08/08/08    21:15:00     6142           
      SUBROUTINE INFALS(MYFALS,MYLRFS,IMPR,IRET)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : INFALS
C PROJET      : Noyau linéaire NLIN
C DESCRIPTION : Initialise le segment contenant les informations sur
C               l'ensemble des familles d'éléments de référence
C
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C APPELES          : INIFAL, FILFAL, PRFAL (initialisations, impression)
C APPELE PAR       : PRNLI2
C***********************************************************************
C ENTREES            : * MYLRFS  (type ELREFS) : segment de description 
C                        des éléments de références.
C ENTREES/SORTIES    : -
C SORTIES            : * MYFALS (type FALRFS) : segment de description 
C                        des familles d'éléments de références.
C TRAVAIL            : * FACOUR (type FALRFS) : famille courante.
C                      * NBDFA  (type ENTIER) : nombre total de familles
C                        d'éléments 
C                      * INBDFA (type ENTIER) : indice de boucle sur les
C                        familles d'éléments
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 17/08/99, version initiale
C HISTORIQUE : v1, 17/08/99, création
C HISTORIQUE :     26/07/02, ajout du triangle cubique  
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
CBEGININCLUDE SFALRF
      SEGMENT FALRF
      CHARACTER*(LNNFA) NOMFA
      INTEGER NUQUAF(NBLRF)
      POINTEUR ELEMF(NBLRF).ELREF
      ENDSEGMENT
      SEGMENT FALRFS
      POINTEUR LISFA(0).FALRF
      ENDSEGMENT
CENDINCLUDE SFALRF
      POINTEUR MYFALS.FALRFS
      POINTEUR FACOUR.FALRF
*
      INTEGER IMPR,IRET
*
      INTEGER NBDFA,INBDFA
*     
* Executable statements
*
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans infals'
      SEGINI MYFALS
*
* Famille de nom : CSTE
* Elément de Lagrange, fonctions L2, approximation nodale,
* degré de l'approximation : 0
* 7 éléments : segment, triangle, carré, tétraèdre, pyramide, 
*              prisme, cube
*
* In INIFAL : SEGINI FACOUR
      CALL INIFAL('CSTE',
     $     FACOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'SEG3','L2D0SE1',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'TRI7','L2D0TR1',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'QUA9','L2D0QU1',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'TE15','L2D0TE1',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'PY19','L2D0PY1',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'PR21','L2D0PR1',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'CU27','L2D0CU1',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGDES FACOUR
      MYFALS.LISFA(**)=FACOUR
*
* Famille de nom : LINM (linéaire par morceaux)
* Elément de Lagrange, fonctions L2, approximation nodale,
* degré de l'approximation : 1
* 6 éléments : segment, triangle, carré, tétraèdre, prisme, cube
*
* In INIFAL : SEGINI FACOUR
      CALL INIFAL('LINM',
     $     FACOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'SEG3','L2D1SE2',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'TRI7','L2D1TR3',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'QUA9','L2D1QU3',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'TE15','L2D1TE4',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'PR21','L2D1PR4',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'CU27','L2D1CU4',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGDES FACOUR
      MYFALS.LISFA(**)=FACOUR
*
* Famille de nom : LINE
* Elément de Lagrange, fonctions H1, approximation nodale,
* degré de l'approximation : 1
*
*
* In INIFAL : SEGINI FACOUR
      CALL INIFAL('LINE',
     $     FACOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'SEG3','H1D1SE2',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'TRI7','H1D1TR3',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'QUA9','H1D1QU4',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'TE15','H1D1TE4',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'PY19','H1D1PY5',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'PR21','H1D1PR6',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'CU27','H1D1CU8',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGDES FACOUR
      MYFALS.LISFA(**)=FACOUR
*
* Famille de nom : LINC
* Elément de Lagrange, type Crouzeix-Raviart, approximation nodale,
* degré de l'approximation : 1
*
*
* In INIFAL : SEGINI FACOUR
      CALL INIFAL('LINC',
     $     FACOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
*      CALL FILFAL(FACOUR,MYLRFS,'SEG3','H1D1SE2',IMPR,IRET)
      CALL FILFAL(FACOUR,MYLRFS,'SEG3','L2D0SE1',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'TRI7','CRD1TR3',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'QUA9','CRD1QU4',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'TE15','CRD1TE4',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
*
* La pyramide doit être facile à faire, les fonctions de forme
* sont les mêmes que celles de la famille H1.
* Mais cet élément marche-t-il ? Jamais vu dans la littérature
*
*      CALL FILFAL(FACOUR,MYLRFS,'PY19','CRD1PY5',IMPR,IRET)
*      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'PR21','CRD1PR5',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'CU27','CRD1CU6',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGDES FACOUR
      MYFALS.LISFA(**)=FACOUR
*
* Famille de nom : LINB
* Elément de Lagrange simpliciaux + bulle, 
* fonctions H1, approximation nodale,
* degré de l'approximation : 1
*
* In INIFAL : SEGINI FACOUR
      CALL INIFAL('LINB',
     $     FACOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'SEG3','H1D1SE2',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'TRI7','H1D1TR4',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'TE15','H1D1TE5',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGDES FACOUR
      MYFALS.LISFA(**)=FACOUR
*
* Famille de nom : QUAI
* Elément de Lagrange incomplets, fonctions H1, approximation nodale, 
* degré de l'approximation : 2
*
* In INIFAL : SEGINI FACOUR
      CALL INIFAL('QUAI',
     $     FACOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'SEG3','H1D2SE3',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'TRI7','H1D2TR6',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'QUA9','H1D2QU8',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'TE15','H1D2TE10',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'PY19','H1D2PY13',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'PR21','H1D2PR15',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'CU27','H1D2CU20',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGDES FACOUR
      MYFALS.LISFA(**)=FACOUR
*
* Famille de nom : QUAD
* Elément de Lagrange, fonctions H1, approximation nodale, 
* degré de l'approximation : 2
*
* In INIFAL : SEGINI FACOUR
      CALL INIFAL('QUAD',
     $     FACOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'SEG3','H1D2SE3',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'TRI7','H1D2TR6',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'QUA9','H1D2QU9',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'TE15','H1D2TE10',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'PR21','H1D2PR18',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'CU27','H1D2CU27',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGDES FACOUR
      MYFALS.LISFA(**)=FACOUR
*
* Famille de nom : QUAF (Quadratique pour les fluides)
* Elément de Lagrange + bulles éventuelles, fonctions H1, approximation
* nodale, degré de l'approximation : 2
*
* In INIFAL : SEGINI FACOUR
      CALL INIFAL('QUAF',
     $     FACOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'SEG3','H1D2SE3',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'TRI7','H1D2TR7',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'QUA9','H1D2QU9',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'TE15','H1D2TE15',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'PR21','H1D2PR21',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'CU27','H1D2CU27',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGDES FACOUR
      MYFALS.LISFA(**)=FACOUR
*
* Famille de nom : CUBI
* Elément de Lagrange, fonctions H1, approximation nodale,
* degré de l'approximation : 3
*
* In INIFAL : SEGINI FACOUR
      CALL INIFAL('CUBI',
     $     FACOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'TRI7','H1D3TR10',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGDES FACOUR
      MYFALS.LISFA(**)=FACOUR
*
* Famille de nom : BULL
* Elément de Lagrange simpliciaux bulle, 
* fonctions H10, approximation nodale,
* degré de l'approximation : 0
*
* In INIFAL : SEGINI FACOUR
      CALL INIFAL('BULL',
     $     FACOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFAL(FACOUR,MYLRFS,'TRI7','H10D0TR1',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGDES FACOUR
      MYFALS.LISFA(**)=FACOUR
*
* Impression finale
*
      NBDFA=MYFALS.LISFA(/1)
      IF (IMPR.GT.1) THEN
         DO 3 INBDFA=1,NBDFA
            WRITE(IOIMP,*) 'Famille d''éléments de référence ',INBDFA
            FACOUR=MYFALS.LISFA(INBDFA)
            CALL PRFAL(FACOUR,IMPR,IRET)
            IF (IRET.NE.0) GOTO 9999
 3       CONTINUE
      ENDIF
      SEGDES MYFALS
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine infals'
      RETURN
*
* End of subroutine INFALS
*
      END