Esope source files

   1 : C INPGS     SOURCE    GOUNAND   05/12/21    21:33:15     5281           
   2 :       SUBROUTINE INPGS(MYPGS,IMPR,IRET)
   3 :       IMPLICIT REAL*8 (A-H,O-Z)
   4 :       IMPLICIT INTEGER (I-N)
   5 : C***********************************************************************
   6 : C NOM         : INPGS
   7 : C PROJET      : Noyau linéaire NLIN
   8 : C DESCRIPTION : Initialise le segment contenant les informations sur
   9 : C               l'ensemble des méthodes d'intégration (type Gauss).
  10 : C
  11 : C LANGAGE     : ESOPE
  12 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  13 : C               mél : gounand@semt2.smts.cea.fr
  14 : C***********************************************************************
  15 : C APPELES          : INGASE, INGJ10, INGJ20, INGATR, INGAQU, INGATE,
  16 : C                    INGAPR, INGACU
  17 : C APPELES (E/S)    : PRPG
  18 : C APPELE PAR       : KALPBG
  19 : C***********************************************************************
  20 : C ENTREES            : -
  21 : C ENTREES/SORTIES    : -
  22 : C SORTIES            : MYPGS
  23 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  24 : C***********************************************************************
  25 : C VERSION    : v2, 19/10/99, version initiale
  26 : C HISTORIQUE : v1, 21/07/99, création
  27 : C HISTORIQUE : v2, 19/10/99, remaniement (chgt du segment POGAUS)
  28 : C                    nbses méthodes de cubatures en plus...
  29 : C                    Cf. répertoire gauss_doc
  30 : C HISTORIQUE :
  31 : C***********************************************************************
  32 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  33 : C en cas de modification de ce sous-programme afin de faciliter
  34 : C la maintenance !
  35 : C***********************************************************************
  36 : -INC CCOPTIO
  37 : CBEGININCLUDE SPOGAU
  38 :       SEGMENT POGAU
  39 :       CHARACTER*(LNNPG)  NOMPG
  40 :       CHARACTER*(LNTPG)  TYPMPG
  41 :       CHARACTER*(LNFPG)  FORLPG
  42 :       INTEGER NORDPG
  43 :       REAL*8 XCOPG(NDLPG,NBPG)
  44 :       REAL*8 XPOPG(NBPG)
  45 :       ENDSEGMENT
  46 :       SEGMENT POGAUS
  47 :       POINTEUR LISPG(0).POGAU
  48 :       ENDSEGMENT
  49 : CENDINCLUDE SPOGAU
  50 :       POINTEUR MYPGS.POGAUS
  51 :       POINTEUR PGCOUR.POGAU
  52 : *
  53 :       INTEGER IMPR,IRET
  54 : *
  55 :       INTEGER INBDPG,NBDPG
  56 : *     
  57 : * Executable statements
  58 : *
  59 :       IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans inpgs'
  60 : *
  61 : * Initialisation du segment contenant toutes les méthodes
  62 : * d'intégration type gauss
  63 : * L'ordre d'initialisation à une importance car certaines
  64 : * méthodes d'intégration sont des méthodes produit construites 
  65 : * à partir d'autres méthodes.
  66 : *
  67 :       SEGINI MYPGS
  68 : *
  69 : * On initialise les méthodes d'intégration numérique de 
  70 : * Gauss à une dimension (Ordre 1 à 11).
  71 : *
  71 :       CALL INGASE(MYPGS,IMPR,IRET)
  72 :       IF (IRET.NE.0) GOTO 9999
  73 : *
  74 : * On initialise les méthodes d'intégration numérique de 
  75 : * Gauss-Jacobi pour \alpha=1 \beta=0 à une dimension (Ordre 1 à 11). 
  76 : *
  76 :       CALL INGJ10(MYPGS,IMPR,IRET)
  77 :       IF (IRET.NE.0) GOTO 9999
  78 : *
  79 : * On initialise les méthodes d'intégration numérique de 
  80 : * Gauss-Jacobi pour \alpha=2 \beta=0 à une dimension (Ordre 1 à 11). 
  81 : *
  81 :       CALL INGJ20(MYPGS,IMPR,IRET)
  82 :       IF (IRET.NE.0) GOTO 9999
  83 : *
  84 : * On initialise les méthodes d'intégration numérique de 
  85 : * cubature (type Gauss) pour le triangle (Ordre 1 à 7).
  86 : *
  86 :       CALL INGATR(MYPGS,IMPR,IRET)
  87 :       IF (IRET.NE.0) GOTO 9999
  88 : *
  89 : * On initialise les méthodes d'intégration numérique de 
  90 : * cubature (type Gauss) pour le carré (Ordre 1 à 7).
  91 : *
  91 :       CALL INGAQU(MYPGS,IMPR,IRET)
  92 :       IF (IRET.NE.0) GOTO 9999
  93 : *
  94 : * On initialise les méthodes d'intégration numérique de 
  95 : * cubature (type Gauss) pour le tétraèdre (Ordre 1 à 6).
  96 : *
  96 :       CALL INGATE(MYPGS,IMPR,IRET)
  97 :       IF (IRET.NE.0) GOTO 9999
  98 : *
  99 : * On initialise les méthodes d'intégration numérique de 
 100 : * cubature (type Gauss) pour la pyramide (Ordre 1 à 6).
 101 : *
 101 :       CALL INGAPY(MYPGS,IMPR,IRET)
 102 :       IF (IRET.NE.0) GOTO 9999
 103 : *
 104 : * On initialise les méthodes d'intégration numérique de 
 105 : * cubature (type Gauss) pour le prisme à base triangulaire 
 106 : * (Ordre 1 à 5). 
 107 : *
 107 :       CALL INGAPR(MYPGS,IMPR,IRET)
 108 :       IF (IRET.NE.0) GOTO 9999
 109 : *
 110 : * On initialise les méthodes d'intégration numérique de 
 111 : * cubature (type Gauss) pour le cube (Ordre 1 à 5).
 112 : *
 112 :       CALL INGACU(MYPGS,IMPR,IRET)
 113 :       IF (IRET.NE.0) GOTO 9999
 114 : *
 115 : * Impression finale
 116 : *     
 117 :       NBDPG=MYPGS.LISPG(/1)
 118 :       IF (IMPR.GT.1) THEN
 119 : *!      WRITE(IOIMP,*) 'Nom ','Type ','Dom. int. ','ordre ','nb. points'
 120 :          DO 1 INBDPG=1,NBDPG
 121 :             WRITE(IOIMP,*) 'Méthode d''intégration ',INBDPG
 122 :             PGCOUR=MYPGS.LISPG(INBDPG)
 122 :             CALL PRPG(PGCOUR,IMPR,IRET)
 123 :             IF (IRET.NE.0) GOTO 9999
 124 :  1       CONTINUE
 125 :       ENDIF
 126 :       SEGDES MYPGS
 127 : *
 128 : * Normal termination
 129 : *
 130 :       IRET=0
 131 :       RETURN
 132 : *
 133 : * Format handling
 134 : *
 135 : *
 136 : * Error handling
 137 : *
 138 :  9999 CONTINUE
 139 :       IRET=1
 140 :       WRITE(IOIMP,*) 'An error was detected in subroutine inpgs'
 141 :       RETURN
 142 : *
 143 : * End of subroutine INPGS
 144 : *
 145 :       END
 146 : 
 147 :  
 148 :