Télécharger gpobul.eso

Retour à la liste

Numérotation des lignes :

  1. C GPOBUL SOURCE GOUNAND 05/12/21 21:28:22 5281
  2. SUBROUTINE GPOBUL(NDIM,
  3. $ MYBPOL,
  4. $ IMPR,IRET)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. IMPLICIT INTEGER (I-N)
  7. C***********************************************************************
  8. C NOM : GPOBUL
  9. C DESCRIPTION : Génère le polynôme bulle pour un simplex de dimension
  10. C NDIM et l'ajoute dans une liste de polynômes.
  11. C
  12. C LANGAGE : ESOPE
  13. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  14. C mél : gounand@semt2.smts.cea.fr
  15. C***********************************************************************
  16. C APPELES : ISET
  17. C APPELE PAR : INELTR, INELTE
  18. C***********************************************************************
  19. C ENTREES : NDIM
  20. C ENTREES/SORTIES : MYBPOL
  21. C SORTIES : -
  22. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  23. C***********************************************************************
  24. C VERSION : v1, 10/05/2000, version initiale
  25. C HISTORIQUE : v1, 10/05/2000, création
  26. C HISTORIQUE :
  27. C HISTORIQUE :
  28. C***********************************************************************
  29. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  30. C en cas de modification de ce sous-programme afin de faciliter
  31. C la maintenance !
  32. C***********************************************************************
  33. -INC CCOPTIO
  34. CBEGININCLUDE SPOLYNO
  35. SEGMENT POLYNO
  36. REAL*8 COEMON(NBMON)
  37. INTEGER EXPMON(NDIML,NBMON)
  38. ENDSEGMENT
  39. SEGMENT POLYNS
  40. POINTEUR LIPOLY(NBPOLY).POLYNO
  41. ENDSEGMENT
  42. CENDINCLUDE SPOLYNO
  43. INTEGER NBMON,NDIML
  44. POINTEUR MYBPOL.POLYNS
  45. POINTEUR POBUL.POLYNO
  46. *
  47. INTEGER NDIM
  48. INTEGER IMPR,IRET
  49. *
  50. REAL*8 UN
  51. PARAMETER(UN=1.D0)
  52. INTEGER IMON
  53. *
  54. * Executable statements
  55. *
  56. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans gpobul.eso'
  57. * On génère un polynôme du type :
  58. * x_1.x_2...x_n (1-x_1...-x_n)
  59. NDIML=NDIM
  60. NBMON=NDIM+1
  61. SEGINI POBUL
  62. * On initialise les monômes à x_1.x_2...x_n
  63. CALL ISET(POBUL.EXPMON,1,NDIML*NBMON)
  64. * On ajuste les coeff. et les monômes
  65. POBUL.COEMON(1)=UN
  66. DO 1 IMON=2,NDIM+1
  67. POBUL.COEMON(IMON)=-UN
  68. POBUL.EXPMON(IMON-1,IMON)=
  69. $ POBUL.EXPMON(IMON-1,IMON)+1
  70. 1 CONTINUE
  71. SEGDES POBUL
  72. SEGACT MYBPOL*MOD
  73. MYBPOL.LIPOLY(**)=POBUL
  74. SEGDES MYBPOL
  75. *
  76. * Normal termination
  77. *
  78. IRET=0
  79. RETURN
  80. *
  81. * Format handling
  82. *
  83. *
  84. * Error handling
  85. *
  86. 9999 CONTINUE
  87. IRET=1
  88. WRITE(IOIMP,*) 'An error was detected in subroutine gpobul'
  89. RETURN
  90. *
  91. * End of subroutine GPOBUL
  92. *
  93. END
  94.  
  95.  
  96.  
  97.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales