C INFPGS    SOURCE    GOUNAND   21/06/02    21:16:35     11022          
      SUBROUTINE INFPGS(MYFPGS,MYPGS,IMPR,IRET)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : INFPGS
C PROJET      : Noyau linéaire NLIN
C DESCRIPTION : Initialise le segment contenant les informations sur
C               l'ensemble des familles de méthodes d'intégration
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          : INIFPG, FILFPG, PRFPG (initialisations, impression)
C APPELE PAR       : PRNLI2
C***********************************************************************
C ENTREES            : * MYPGS  (type POGAUS) : segment de description
C                        des méthodes d'intégration.
C ENTREES/SORTIES    : -
C SORTIES            : * MYFPGS (type FAPGS) : segment de description
C                        des familles de méthodes d'intégration.
C TRAVAIL            : * FACOUR (type FAPG) : famille courante.
C                      * NBDFA  (type ENTIER) : nombre total de familles
C                        de méthodes d'intégration.
C                      * INBDFA (type ENTIER) : indice de boucle sur les
C                        familles de méthodes d'intégration.
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 16/07/02, version initiale
C HISTORIQUE : v1, 16/07/02, création
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 SPOGAU
      POINTEUR MYPGS.POGAUS
*-INC SFAPG
      POINTEUR MYFPGS.FAPGS
      POINTEUR FACOUR.FAPG
*
      INTEGER IMPR,IRET
*
      INTEGER NBDFA,INBDFA
      LOGICAL LAXI
*
* Executable statements
*
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans infpgs'
      SEGINI MYFPGS
      LAXI=(IFOUR.EQ.0)
*
* Famille de nom : GAM1 Gauss pour la masse (éléments linéaires)
*
* In INIFPG : SEGINI FACOUR
      CALL INIFPG('GAM1',
     $     FACOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-3-2',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      IF (LAXI) THEN
         CALL FILFPG(FACOUR,MYPGS,'TRI7','GAT2-5-7',IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
      ELSE
         CALL FILFPG(FACOUR,MYPGS,'TRI7','GPT2-3-4',IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
      ENDIF
      IF (LAXI) THEN
         CALL FILFPG(FACOUR,MYPGS,'QUA9','GPC2-5-9',IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
      ELSE
         CALL FILFPG(FACOUR,MYPGS,'QUA9','GPC2-3-4',IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
      ENDIF
      CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-2-4B',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'PY19','GAPY-2-5',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-2-6',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'CU27','GPC3-3-8',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGDES FACOUR
      MYFPGS.LISFPG(**)=FACOUR
*
* Famille de nom : GAM2 Gauss pour la masse (éléments quadratiques)
*
* In INIFPG : SEGINI FACOUR
      CALL INIFPG('GAM2',
     $     FACOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      IF (LAXI) THEN
         CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-7-4',IMPR,IRET)
      ELSE
         CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-5-3',IMPR,IRET)
      ENDIF
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'TRI7','GAT2-5-7',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      IF (LAXI) THEN
         CALL FILFPG(FACOUR,MYPGS,'QUA9','GPC2-7-16',IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
      ELSE
         CALL FILFPG(FACOUR,MYPGS,'QUA9','GPC2-5-9',IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
      ENDIF
      CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-3-8B',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'PY19','GAPY-5-27',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-5-21',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'CU27','GPC3-5-27',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGDES FACOUR
      MYFPGS.LISFPG(**)=FACOUR
*
* Famille de nom : GAR1 Gauss pour la rigidité (éléments linéaires)
*
* In INIFPG : SEGINI FACOUR
      CALL INIFPG('GAR1',
     $     FACOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-3-2',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'TRI7','GAT2-1-1',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'QUA9','GPC2-3-4',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-1-1',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'PY19','GAPY-2-5',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-2-6',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'CU27','GPC3-3-8',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGDES FACOUR
      MYFPGS.LISFPG(**)=FACOUR
*
* Famille de nom : GAR2 Gauss pour la rigidité (éléments quadratiques)
*
* In INIFPG : SEGINI FACOUR
      CALL INIFPG('GAR2',
     $     FACOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      IF (LAXI) THEN
         CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-7-4',IMPR,IRET)
      ELSE
         CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-5-3',IMPR,IRET)
      ENDIF
      IF (IRET.NE.0) GOTO 9999
      IF (LAXI) THEN
         CALL FILFPG(FACOUR,MYPGS,'TRI7','GAT2-5-7',IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
      ELSE
         CALL FILFPG(FACOUR,MYPGS,'TRI7','GPT2-3-4',IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
      ENDIF
      CALL FILFPG(FACOUR,MYPGS,'QUA9','GPC2-5-9',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-3-8B',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'PY19','GAPY-5-27',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-5-21',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'CU27','GPC3-5-27',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGDES FACOUR
      MYFPGS.LISFPG(**)=FACOUR
*
* Famille de nom : NC1 Newton-Cotes
* Méthodes d'intégration d'ordre au moins 1
* 6 éléments : segment, triangle, carré, tétraèdre, prisme, cube
*
* In INIFPG : SEGINI FACOUR
      CALL INIFPG('NC1 ',
     $     FACOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'SEG3','NCC1-1-2',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'TRI7','NCT2-1-3',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'QUA9','NCC2-1-4',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'TE15','NCT3-1-4',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'PY19','NCPY-0-5',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'PR21','NCPR-1-6',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'CU27','NCC3-1-8',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGDES FACOUR
      MYFPGS.LISFPG(**)=FACOUR
*
* Famille de nom : NC3 Newton-Cotes
* Méthodes d'intégration d'ordre au moins 3
* 6 éléments : segment, triangle, carré, tétraèdre, prisme, cube
* In INIFPG : SEGINI FACOUR
      CALL INIFPG('NC3 ',
     $     FACOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'SEG3','NCC1-3-3',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'TRI7','NCT2-3-7',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'QUA9','NCC2-3-9',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
* Pas vraiment du Newton-Cotes, mais je ne sais pas quoi mettre
      CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-3-8B',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'PR21','NCPR-3-21',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'CU27','NCC3-3-27',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGDES FACOUR
      MYFPGS.LISFPG(**)=FACOUR
*
* Famille de nom : GAU1
* Méthodes d'intégration d'ordre au moins 1
* 6 éléments : segment, triangle, carré, tétraèdre, prisme, cube
*
* In INIFPG : SEGINI FACOUR
      CALL INIFPG('GAU1',
     $     FACOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-1-1',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'TRI7','GAT2-1-1',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'QUA9','GAC2-1-1',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-1-1',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'PY19','GAPY-1-1',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-1-1',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'CU27','GAC3-1-1',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGDES FACOUR
      MYFPGS.LISFPG(**)=FACOUR
*
* Famille de nom : GAU2
* Méthodes d'intégration d'ordre au moins 2
* 6 éléments : segment, triangle, carré, tétraèdre, prisme, cube
*
* In INIFPG : SEGINI FACOUR
      CALL INIFPG('GAU2',
     $     FACOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-3-2',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'TRI7','GAT2-2-3A',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'QUA9','GAC2-2-3',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-2-4B',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'PY19','GAPY-2-5',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-2-6',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'CU27','GAC3-3-6A',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGDES FACOUR
      MYFPGS.LISFPG(**)=FACOUR
*
* Famille de nom : GAU3
* Méthodes d'intégration d'ordre au moins 3
* 6 éléments : segment, triangle, carré, tétraèdre, prisme, cube
*
* In INIFPG : SEGINI FACOUR
      CALL INIFPG('GAU3',
     $     FACOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-3-2',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'TRI7','GPT2-3-4',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'QUA9','GAC2-3-4A',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-3-8B',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'PY19','GAPY-5-27',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-3-8',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'CU27','GAC3-3-6A',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGDES FACOUR
      MYFPGS.LISFPG(**)=FACOUR
*
* Famille de nom : GAU4
* Méthodes d'intégration d'ordre au moins 4
* 6 éléments : segment, triangle, carré, tétraèdre, prisme, cube
*
* In INIFPG : SEGINI FACOUR
      CALL INIFPG('GAU4',
     $     FACOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-5-3',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'TRI7','GAT2-4-6A',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'QUA9','GAC2-4-6C',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-5-14',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'PY19','GAPY-5-27',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-4-18',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'CU27','GAC3-5-14',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGDES FACOUR
      MYFPGS.LISFPG(**)=FACOUR
*
* Famille de nom : GAU5
* Méthodes d'intégration d'ordre au moins 5
* 6 éléments : segment, triangle, carré, tétraèdre, prisme, cube
*
* In INIFPG : SEGINI FACOUR
      CALL INIFPG('GAU5',
     $     FACOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-5-3',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'TRI7','GAT2-5-7',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'QUA9','GAC2-5-7A',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-5-14',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'PY19','GAPY-5-27',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-5-21',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'CU27','GAC3-5-14',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGDES FACOUR
      MYFPGS.LISFPG(**)=FACOUR
*
* Famille de nom : GAU6
* Méthodes d'intégration d'ordre au moins 6
* 6 éléments : segment, triangle, carré, tétraèdre, prisme, cube
*
* In INIFPG : SEGINI FACOUR
      CALL INIFPG('GAU6',
     $     FACOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-7-4',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'TRI7','GAT2-7-12',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'QUA9','GAC2-6-10C',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-6-24',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-7-48',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'CU27','GPC3-7-64',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGDES FACOUR
      MYFPGS.LISFPG(**)=FACOUR
*
* Famille de nom : GAU7
* Méthodes d'intégration d'ordre au moins 7
* 6 éléments : segment, triangle, carré, tétraèdre, prisme, cube
*
* In INIFPG : SEGINI FACOUR
      CALL INIFPG('GAU7',
     $     FACOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-7-4',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'TRI7','GAT2-7-12',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'QUA9','GAC2-7-12A',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'TE15','GPT3-7-64',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-7-48',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'CU27','GPC3-7-64',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGDES FACOUR
      MYFPGS.LISFPG(**)=FACOUR
*
* Famille de nom : GAP3
* Méthodes d'intégration produit d'ordre au moins 3
* 3 éléments : segment, triangle, carré
*
* In INIFPG : SEGINI FACOUR
      CALL INIFPG('GAP3',
     $     FACOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-3-2',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'TRI7','GPT2-3-4',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'QUA9','GPC2-3-4',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'TE15','GAT3-3-8B',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'PY19','GAPY-5-27',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-3-8',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'CU27','GPC3-3-8',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGDES FACOUR
      MYFPGS.LISFPG(**)=FACOUR
*
* Famille de nom : GAP5
* Méthodes d'intégration produit d'ordre au moins 5
* 3 éléments : segment, triangle, carré
*
* In INIFPG : SEGINI FACOUR
      CALL INIFPG('GAP5',
     $     FACOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-5-3',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'TRI7','GPT2-5-9',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'QUA9','GPC2-5-9',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'TE15','GPT3-5-27',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'PY19','GAPY-5-27',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-5-21',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'CU27','GPC3-5-27',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGDES FACOUR
      MYFPGS.LISFPG(**)=FACOUR
*
* Famille de nom : GAP7
* Méthodes d'intégration produit d'ordre au moins 7
* 4 éléments : segment, triangle, carré, tétraèdre
*
* In INIFPG : SEGINI FACOUR
      CALL INIFPG('GAP7',
     $     FACOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'SEG3','GAC1-7-4',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'TRI7','GPT2-7-16',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'QUA9','GPC2-7-16',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'TE15','GPT3-7-64',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'PR21','GPPR-7-48',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      CALL FILFPG(FACOUR,MYPGS,'CU27','GPC3-7-64',IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGDES FACOUR
      MYFPGS.LISFPG(**)=FACOUR
*
* Impression finale
*
      NBDFA=MYFPGS.LISFPG(/1)
      IF (IMPR.GT.1) THEN
*!      WRITE(IOIMP,*) 'Nom, QUAF, Meth. integ'
         DO 3 INBDFA=1,NBDFA
            WRITE(IOIMP,*) 'Famille de méthodes d''intégration ',INBDFA
            FACOUR=MYFPGS.LISFPG(INBDFA)
            CALL PRFPG(FACOUR,IMPR,IRET)
            IF (IRET.NE.0) GOTO 9999
 3       CONTINUE
      ENDIF
      SEGDES MYFPGS
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine infpgs'
      RETURN
*
* End of subroutine INFPGS
*
      END