Sources Esope | Cast3M

gbapco
C GBAPCO    SOURCE    GOUNAND   21/06/02    21:16:00     11022          
      SUBROUTINE GBAPCO(NDIM,NDEG,
     $     BAPOLY,
     $     IMPR,IRET)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : GBAPCO
C DESCRIPTION : Génère une base polynômiale complète de dimension NDIM
C               et de degré NDEG.
C               cf. Dhatt et Touzot p.45
C
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          : -
C APPELE PAR       : INELSE, INELTR, INELQU, INELTE, INELPR, INELCU
C***********************************************************************
C ENTREES            : NDIM, NDEG
C ENTREES/SORTIES    : -
C SORTIES            : BAPOLY
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 09/05/2000, version initiale
C HISTORIQUE : v1, 09/05/2000, 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 SPOLYNO
      INTEGER NBPOLY
      POINTEUR BAPOLY.POLYNS
      INTEGER NBMON,NDIML
      POINTEUR MYPOLY.POLYNO
*
      INTEGER NDIM,NDEG
      INTEGER IMPR,IRET
*
      INTEGER IDEG,IEXP,IEXP2
      REAL*8 UN
      PARAMETER(UN=1.D0)
*
* Executable statements
*
      IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans gbapco.eso'
      NBPOLY=0
      SEGINI BAPOLY
      IF (NDIM.EQ.1) THEN
         DO 1 IDEG=0,NDEG
            NDIML=NDIM
            NBMON=1
            SEGINI MYPOLY
            MYPOLY.COEMON(1)=UN
            MYPOLY.EXPMON(1,1)=IDEG
            SEGDES MYPOLY
            BAPOLY.LIPOLY(**)=MYPOLY
 1       CONTINUE
      ELSEIF (NDIM.EQ.2) THEN
         DO 3 IDEG=0,NDEG
            DO 32 IEXP=IDEG,0,-1
               NDIML=NDIM
               NBMON=1
               SEGINI MYPOLY
               MYPOLY.COEMON(1)=UN
               MYPOLY.EXPMON(1,1)=IEXP
               MYPOLY.EXPMON(2,1)=IDEG-IEXP
               SEGDES MYPOLY
               BAPOLY.LIPOLY(**)=MYPOLY
 32         CONTINUE
 3       CONTINUE
      ELSEIF (NDIM.EQ.3) THEN
         DO 5 IDEG=0,NDEG
            DO 52 IEXP=IDEG,0,-1
               DO 522 IEXP2=IDEG-IEXP,0,-1
                  NDIML=NDIM
                  NBMON=1
                  SEGINI MYPOLY
                  MYPOLY.COEMON(1)=UN
                  MYPOLY.EXPMON(1,1)=IEXP
                  MYPOLY.EXPMON(2,1)=IEXP2
                  MYPOLY.EXPMON(3,1)=IDEG-(IEXP+IEXP2)
                  SEGDES MYPOLY
                  BAPOLY.LIPOLY(**)=MYPOLY
 522           CONTINUE
 52         CONTINUE
 5       CONTINUE
      ELSE
         WRITE(IOIMP,*) 'Je ne sais pas générer une base poly.',
     $        'complète pour des dimensions sup. à 3.'
         GOTO 9999
      ENDIF
      SEGDES BAPOLY
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine gbapco'
      RETURN
*
* End of subroutine GBAPCO
*
      END