C INGAPY    SOURCE    GOUNAND   05/12/21    21:32:01     5281           
      SUBROUTINE INGAPY(MYPGS,IMPR,IRET)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : INGAPY
C PROJET      : Noyau linéaire NLIN
C DESCRIPTION : Remplit le segment des méthodes d'intégration
C               avec des méthodes d'intégration numérique de cubature
C               type Gauss pour la pyramide.
C
C REFERENCES  : Castem donred.eso
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C APPELES          : INIPG, GTSINO, GTRO3I, GT3FS9, GT3F10,
C                    FIPG, CPROPG
C APPELE PAR       : INPGS
C***********************************************************************
C ENTREES            : -
C ENTREES/SORTIES    : MYPGS (actif en *MOD)
C SORTIES            : -
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 22/10/99, version initiale
C HISTORIQUE : v1, 22/10/99, création
C HISTORIQUE : 29/5/00 rajout ordre 6
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 SPOGAU
      SEGMENT POGAU
      CHARACTER*(LNNPG)  NOMPG
      CHARACTER*(LNTPG)  TYPMPG
      CHARACTER*(LNFPG)  FORLPG
      INTEGER NORDPG
      REAL*8 XCOPG(NDLPG,NBPG)
      REAL*8 XPOPG(NBPG)
      ENDSEGMENT
      SEGMENT POGAUS
      POINTEUR LISPG(0).POGAU
      ENDSEGMENT
CENDINCLUDE SPOGAU
      POINTEUR MYPGS.POGAUS
      POINTEUR PGCOUR.POGAU
*
      INTEGER IMPR,IRET
      REAL*8 ZERO,UN,DEUTIE
      PARAMETER (ZERO=0.D0)
      PARAMETER (UN=1.D0)
      PARAMETER (DEUTIE=2.D0/3.D0)
*     
* Executable statements
*
      IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans ingapy'
*
* Méthode de nom : NCPY-1-5
* Sur un tétraèdre : cubature d'ordre 0 à 5 points
*                    espace de référence de dimension 3
*
* In INIPG : SEGINI PGCOUR
      CALL INIPG('NCPY-0-5','NEWTON-COTES','PYRAMIDE',
     $     0,5,3,
     $     PGCOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      PGCOUR.XCOPG(1,1)=UN
      PGCOUR.XCOPG(2,1)=ZERO
      PGCOUR.XCOPG(1,2)=ZERO
      PGCOUR.XCOPG(2,2)=UN  
      PGCOUR.XCOPG(1,3)=-UN
      PGCOUR.XCOPG(2,3)=ZERO
      PGCOUR.XCOPG(1,4)=ZERO
      PGCOUR.XCOPG(2,4)=-UN
      DO I=1,4
         PGCOUR.XCOPG(3,I)=ZERO
      ENDDO
      PGCOUR.XCOPG(1,5)=ZERO
      PGCOUR.XCOPG(2,5)=ZERO
      PGCOUR.XCOPG(3,5)=UN
      DO I=1,5
         PGCOUR.XPOPG(I)=DEUTIE/5.D0
      ENDDO
      SEGDES PGCOUR
      MYPGS.LISPG(**)=PGCOUR
*
* Méthode de nom : GAPY-1-1
* Sur un tétraèdre : cubature d'ordre 1 à 1 point
*                    espace de référence de dimension 3
*
* In INIPG : SEGINI PGCOUR
      CALL INIPG('GAPY-1-1','GAUSS','PYRAMIDE',
     $     1,1,3,
     $     PGCOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      NBG=1
      IELE=25
* In SMI2PG : SEGDES PGCOUR
      CALL SMI2PG(IELE,NBG,PGCOUR,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      MYPGS.LISPG(**)=PGCOUR
*
* Méthode de nom : GAPY-2-5
* Sur un tétraèdre : cubature d'ordre 2 à 5 points
*                    espace de référence de dimension 3
*
* In INIPG : SEGINI PGCOUR
      CALL INIPG('GAPY-2-5','GAUSS','PYRAMIDE',
     $     2,5,3,
     $     PGCOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      NBG=5
      IELE=25
* In SMI2PG : SEGDES PGCOUR
      CALL SMI2PG(IELE,NBG,PGCOUR,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      MYPGS.LISPG(**)=PGCOUR
*
* Méthode de nom : GAPY-5-27
* Sur un tétraèdre : cubature d'ordre 5 à 27 points
*                    espace de référence de dimension 3
*
* In INIPG : SEGINI PGCOUR
      CALL INIPG('GAPY-5-27','GAUSS','PYRAMIDE',
     $     5,27,3,
     $     PGCOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      NBG=27
      IELE=25
* In SMI2PG : SEGDES PGCOUR
      CALL SMI2PG(IELE,NBG,PGCOUR,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      MYPGS.LISPG(**)=PGCOUR
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine ingapy'
      RETURN
*
* End of subroutine INGAPY
*
      END