Esope source files

   1 : C GPOFBU    SOURCE    GOUNAND   05/12/21    21:28:38     5281           
   2 :       SUBROUTINE GPOFBU(NDIM,
   3 :      $     MYBPOL,
   4 :      $     IMPR,IRET)
   5 :       IMPLICIT REAL*8 (A-H,O-Z)
   6 :       IMPLICIT INTEGER (I-N)
   7 : C***********************************************************************
   8 : C NOM         : GPOFBU
   9 : C DESCRIPTION : Génère les polynômes bulle pour les faces d'un simplex 
  10 : C               de dimension NDIM (il y en a NDIM+1) et les ajoute à une
  11 : C               liste de polynômes. 
  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          : ISET
  19 : C APPELE PAR       : INELTE
  20 : C***********************************************************************
  21 : C ENTREES            : NDIM
  22 : C ENTREES/SORTIES    : MYBPOL
  23 : C SORTIES            : -
  24 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  25 : C***********************************************************************
  26 : C VERSION    : v1, 10/05/2000, version initiale
  27 : C HISTORIQUE : v1, 10/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 NBMON,NDIML
  46 :       POINTEUR MYBPOL.POLYNS
  47 :       POINTEUR POBUL.POLYNO
  48 : *
  49 :       INTEGER NDIM
  50 :       INTEGER IMPR,IRET
  51 : *
  52 :       REAL*8 UN
  53 :       PARAMETER(UN=1.D0)
  54 :       INTEGER JDIM,IMON
  55 : *     
  56 : * Executable statements
  57 : *
  58 :       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans gpofbu.eso' 
  59 :       SEGACT MYBPOL*MOD
  60 : * On génère le polynôme : x_1.x_2...x_n
  61 :       NDIML=NDIM
  62 :       NBMON=1
  63 :       SEGINI POBUL
  64 :       POBUL.COEMON(1)=1
  64 :       CALL ISET(POBUL.EXPMON,1,NDIML)
  65 :       SEGDES POBUL
  66 :       MYBPOL.LIPOLY(**)=POBUL
  67 : * On génère les polynômes du type :
  68 : * ((x_1.x_2...x_n)/x_i) (1-x_1...-x_n)
  69 :       DO 1 JDIM=1,NDIM
  70 :          NDIML=NDIM
  71 :          NBMON=NDIM+1
  72 :          SEGINI POBUL
  73 : * On initialise les monômes à x_1.x_2...x_n
  73 :          CALL ISET(POBUL.EXPMON,1,NDIML*NBMON)
  74 : * On divise par x_i
  75 :          DO 12 IMON=1,NBMON
  76 :             POBUL.EXPMON(JDIM,IMON)=
  77 :      $        POBUL.EXPMON(JDIM,IMON)-1
  78 :  12      CONTINUE
  79 : 
  80 : * On ajuste les coeff. et les monômes
  81 :          POBUL.COEMON(1)=UN
  82 :          DO 14 IMON=2,NDIM+1
  83 :             POBUL.COEMON(IMON)=-UN
  84 :             POBUL.EXPMON(IMON-1,IMON)=
  85 :      $           POBUL.EXPMON(IMON-1,IMON)+1
  86 :  14      CONTINUE
  87 :          SEGDES POBUL
  88 :          MYBPOL.LIPOLY(**)=POBUL
  89 :  1    CONTINUE
  90 :       SEGDES MYBPOL
  91 : *
  92 : * Normal termination
  93 : *
  94 :       IRET=0
  95 :       RETURN
  96 : *
  97 : * Format handling
  98 : *
  99 : *
 100 : * Error handling
 101 : *
 102 :  9999 CONTINUE
 103 :       IRET=1
 104 :       WRITE(IOIMP,*) 'An error was detected in subroutine gpofbu'
 105 :       RETURN
 106 : *
 107 : * End of subroutine GPOFBU
 108 : *
 109 :       END
 110 : 
 111 :  
 112 :