Esope source files

   1 : C INGAPY    SOURCE    GOUNAND   05/12/21    21:32:01     5281           
   2 :       SUBROUTINE INGAPY(MYPGS,IMPR,IRET)
   3 :       IMPLICIT REAL*8 (A-H,O-Z)
   4 :       IMPLICIT INTEGER (I-N)
   5 : C***********************************************************************
   6 : C NOM         : INGAPY
   7 : C PROJET      : Noyau linéaire NLIN
   8 : C DESCRIPTION : Remplit le segment des méthodes d'intégration
   9 : C               avec des méthodes d'intégration numérique de cubature
  10 : C               type Gauss pour la pyramide.
  11 : C
  12 : C REFERENCES  : Castem donred.eso
  13 : C LANGAGE     : ESOPE
  14 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  15 : C               mél : gounand@semt2.smts.cea.fr
  16 : C***********************************************************************
  17 : C APPELES          : INIPG, GTSINO, GTRO3I, GT3FS9, GT3F10,
  18 : C                    FIPG, CPROPG
  19 : C APPELE PAR       : INPGS
  20 : C***********************************************************************
  21 : C ENTREES            : -
  22 : C ENTREES/SORTIES    : MYPGS (actif en *MOD)
  23 : C SORTIES            : -
  24 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  25 : C***********************************************************************
  26 : C VERSION    : v1, 22/10/99, version initiale
  27 : C HISTORIQUE : v1, 22/10/99, création
  28 : C HISTORIQUE : 29/5/00 rajout ordre 6
  29 : C HISTORIQUE :
  30 : C***********************************************************************
  31 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  32 : C en cas de modification de ce sous-programme afin de faciliter
  33 : C la maintenance !
  34 : C***********************************************************************
  35 : -INC CCOPTIO
  36 : CBEGININCLUDE SPOGAU
  37 :       SEGMENT POGAU
  38 :       CHARACTER*(LNNPG)  NOMPG
  39 :       CHARACTER*(LNTPG)  TYPMPG
  40 :       CHARACTER*(LNFPG)  FORLPG
  41 :       INTEGER NORDPG
  42 :       REAL*8 XCOPG(NDLPG,NBPG)
  43 :       REAL*8 XPOPG(NBPG)
  44 :       ENDSEGMENT
  45 :       SEGMENT POGAUS
  46 :       POINTEUR LISPG(0).POGAU
  47 :       ENDSEGMENT
  48 : CENDINCLUDE SPOGAU
  49 :       POINTEUR MYPGS.POGAUS
  50 :       POINTEUR PGCOUR.POGAU
  51 : *
  52 :       INTEGER IMPR,IRET
  53 :       REAL*8 ZERO,UN,DEUTIE
  54 :       PARAMETER (ZERO=0.D0)
  55 :       PARAMETER (UN=1.D0)
  56 :       PARAMETER (DEUTIE=2.D0/3.D0)
  57 : *     
  58 : * Executable statements
  59 : *
  60 :       IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans ingapy'
  61 : *
  62 : * Méthode de nom : NCPY-1-5
  63 : * Sur un tétraèdre : cubature d'ordre 0 à 5 points
  64 : *                    espace de référence de dimension 3
  65 : *
  66 : * In INIPG : SEGINI PGCOUR
  66 :       CALL INIPG('NCPY-0-5','NEWTON-COTES','PYRAMIDE',
  67 :      $     0,5,3,
  68 :      $     PGCOUR,
  69 :      $     IMPR,IRET)
  70 :       IF (IRET.NE.0) GOTO 9999
  71 :       PGCOUR.XCOPG(1,1)=UN
  72 :       PGCOUR.XCOPG(2,1)=ZERO
  73 :       PGCOUR.XCOPG(1,2)=ZERO
  74 :       PGCOUR.XCOPG(2,2)=UN  
  75 :       PGCOUR.XCOPG(1,3)=-UN
  76 :       PGCOUR.XCOPG(2,3)=ZERO
  77 :       PGCOUR.XCOPG(1,4)=ZERO
  78 :       PGCOUR.XCOPG(2,4)=-UN
  79 :       DO I=1,4
  80 :          PGCOUR.XCOPG(3,I)=ZERO
  81 :       ENDDO
  82 :       PGCOUR.XCOPG(1,5)=ZERO
  83 :       PGCOUR.XCOPG(2,5)=ZERO
  84 :       PGCOUR.XCOPG(3,5)=UN
  85 :       DO I=1,5
  86 :          PGCOUR.XPOPG(I)=DEUTIE/5.D0
  87 :       ENDDO
  88 :       SEGDES PGCOUR
  89 :       MYPGS.LISPG(**)=PGCOUR
  90 : *
  91 : * Méthode de nom : GAPY-1-1
  92 : * Sur un tétraèdre : cubature d'ordre 1 à 1 point
  93 : *                    espace de référence de dimension 3
  94 : *
  95 : * In INIPG : SEGINI PGCOUR
  95 :       CALL INIPG('GAPY-1-1','GAUSS','PYRAMIDE',
  96 :      $     1,1,3,
  97 :      $     PGCOUR,
  98 :      $     IMPR,IRET)
  99 :       IF (IRET.NE.0) GOTO 9999
 100 :       NBG=1
 101 :       IELE=25
 102 : * In SMI2PG : SEGDES PGCOUR
 102 :       CALL SMI2PG(IELE,NBG,PGCOUR,IMPR,IRET)
 103 :       IF (IRET.NE.0) GOTO 9999
 104 :       MYPGS.LISPG(**)=PGCOUR
 105 : *
 106 : * Méthode de nom : GAPY-2-5
 107 : * Sur un tétraèdre : cubature d'ordre 2 à 5 points
 108 : *                    espace de référence de dimension 3
 109 : *
 110 : * In INIPG : SEGINI PGCOUR
 110 :       CALL INIPG('GAPY-2-5','GAUSS','PYRAMIDE',
 111 :      $     2,5,3,
 112 :      $     PGCOUR,
 113 :      $     IMPR,IRET)
 114 :       IF (IRET.NE.0) GOTO 9999
 115 :       NBG=5
 116 :       IELE=25
 117 : * In SMI2PG : SEGDES PGCOUR
 117 :       CALL SMI2PG(IELE,NBG,PGCOUR,IMPR,IRET)
 118 :       IF (IRET.NE.0) GOTO 9999
 119 :       MYPGS.LISPG(**)=PGCOUR
 120 : *
 121 : * Méthode de nom : GAPY-5-27
 122 : * Sur un tétraèdre : cubature d'ordre 5 à 27 points
 123 : *                    espace de référence de dimension 3
 124 : *
 125 : * In INIPG : SEGINI PGCOUR
 125 :       CALL INIPG('GAPY-5-27','GAUSS','PYRAMIDE',
 126 :      $     5,27,3,
 127 :      $     PGCOUR,
 128 :      $     IMPR,IRET)
 129 :       IF (IRET.NE.0) GOTO 9999
 130 :       NBG=27
 131 :       IELE=25
 132 : * In SMI2PG : SEGDES PGCOUR
 132 :       CALL SMI2PG(IELE,NBG,PGCOUR,IMPR,IRET)
 133 :       IF (IRET.NE.0) GOTO 9999
 134 :       MYPGS.LISPG(**)=PGCOUR
 135 : *
 136 : * Normal termination
 137 : *
 138 :       IRET=0
 139 :       RETURN
 140 : *
 141 : * Format handling
 142 : *
 143 : *
 144 : * Error handling
 145 : *
 146 :  9999 CONTINUE
 147 :       IRET=1
 148 :       WRITE(IOIMP,*) 'An error was detected in subroutine ingapy'
 149 :       RETURN
 150 : *
 151 : * End of subroutine INGAPY
 152 : *
 153 :       END
 154 : 
 155 :  
 156 :