Esope source files

   1 : C GBAPCO    SOURCE    GOUNAND   05/12/21    21:23:19     5281           
   2 :       SUBROUTINE GBAPCO(NDIM,NDEG,
   3 :      $     BAPOLY,
   4 :      $     IMPR,IRET)
   5 :       IMPLICIT REAL*8 (A-H,O-Z)
   6 :       IMPLICIT INTEGER (I-N)
   7 : C***********************************************************************
   8 : C NOM         : GBAPCO
   9 : C DESCRIPTION : Génère une base polynômiale complète de dimension NDIM
  10 : C               et de degré NDEG.
  11 : C               cf. Dhatt et Touzot p.45
  12 : C
  13 : C
  14 : C LANGAGE     : ESOPE
  15 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  16 : C               mél : gounand@semt2.smts.cea.fr
  17 : C***********************************************************************
  18 : C APPELES          : - 
  19 : C APPELE PAR       : INELSE, INELTR, INELQU, INELTE, INELPR, INELCU
  20 : C***********************************************************************
  21 : C ENTREES            : NDIM, NDEG
  22 : C ENTREES/SORTIES    : -
  23 : C SORTIES            : BAPOLY
  24 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  25 : C***********************************************************************
  26 : C VERSION    : v1, 09/05/2000, version initiale
  27 : C HISTORIQUE : v1, 09/05/2000, création
  28 : C HISTORIQUE :
  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 SPOLYNO
  37 :       SEGMENT POLYNO
  38 :       REAL*8  COEMON(NBMON)
  39 :       INTEGER EXPMON(NDIML,NBMON)
  40 :       ENDSEGMENT 
  41 :       SEGMENT POLYNS
  42 :       POINTEUR LIPOLY(NBPOLY).POLYNO
  43 :       ENDSEGMENT
  44 : CENDINCLUDE SPOLYNO
  45 :       INTEGER NBPOLY
  46 :       POINTEUR BAPOLY.POLYNS
  47 :       INTEGER NBMON,NDIML
  48 :       POINTEUR MYPOLY.POLYNO
  49 : *
  50 :       INTEGER NDIM,NDEG
  51 :       INTEGER IMPR,IRET
  52 : *
  53 :       INTEGER IDEG,IEXP,IEXP2
  54 :       REAL*8 UN
  55 :       PARAMETER(UN=1.D0)
  56 : *     
  57 : * Executable statements
  58 : *
  59 :       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans gbapco.eso' 
  60 :       NBPOLY=0
  61 :       SEGINI BAPOLY
  62 :       IF (NDIM.EQ.1) THEN
  63 :          DO 1 IDEG=0,NDEG
  64 :             NDIML=NDIM
  65 :             NBMON=1
  66 :             SEGINI MYPOLY
  67 :             MYPOLY.COEMON(1)=UN
  68 :             MYPOLY.EXPMON(1,1)=IDEG
  69 :             SEGDES MYPOLY
  70 :             BAPOLY.LIPOLY(**)=MYPOLY
  71 :  1       CONTINUE
  72 :       ELSEIF (NDIM.EQ.2) THEN
  73 :          DO 3 IDEG=0,NDEG
  74 :             DO 32 IEXP=IDEG,0,-1
  75 :                NDIML=NDIM
  76 :                NBMON=1
  77 :                SEGINI MYPOLY
  78 :                MYPOLY.COEMON(1)=UN
  79 :                MYPOLY.EXPMON(1,1)=IEXP
  80 :                MYPOLY.EXPMON(2,1)=IDEG-IEXP
  81 :                SEGDES MYPOLY
  82 :                BAPOLY.LIPOLY(**)=MYPOLY
  83 :  32         CONTINUE
  84 :  3       CONTINUE
  85 :       ELSEIF (NDIM.EQ.3) THEN
  86 :          DO 5 IDEG=0,NDEG
  87 :             DO 52 IEXP=IDEG,0,-1
  88 :                DO 522 IEXP2=IDEG-IEXP,0,-1
  89 :                   NDIML=NDIM
  90 :                   NBMON=1
  91 :                   SEGINI MYPOLY
  92 :                   MYPOLY.COEMON(1)=UN
  93 :                   MYPOLY.EXPMON(1,1)=IEXP
  94 :                   MYPOLY.EXPMON(2,1)=IEXP2
  95 :                   MYPOLY.EXPMON(3,1)=IDEG-(IEXP+IEXP2)
  96 :                   SEGDES MYPOLY
  97 :                   BAPOLY.LIPOLY(**)=MYPOLY
  98 :  522           CONTINUE
  99 :  52         CONTINUE
 100 :  5       CONTINUE
 101 :       ELSE 
 102 :          WRITE(IOIMP,*) 'Je ne sais pas générer une base poly.',
 103 :      $        'complète pour des dimensions sup. à 3.'
 104 :          GOTO 9999
 105 :       ENDIF
 106 :       SEGDES BAPOLY
 107 : *
 108 : * Normal termination
 109 : *
 110 :       IRET=0
 111 :       RETURN
 112 : *
 113 : * Format handling
 114 : *
 115 : *
 116 : * Error handling
 117 : *
 118 :  9999 CONTINUE
 119 :       IRET=1
 120 :       WRITE(IOIMP,*) 'An error was detected in subroutine gbapco'
 121 :       RETURN
 122 : *
 123 : * End of subroutine GBAPCO
 124 : *
 125 :       END
 126 : 
 127 :  
 128 :