Télécharger gpofbu.eso

Retour à la liste

Numérotation des lignes :

  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
  65. CALL ISET(POBUL.EXPMON,1,NDIML)
  66. SEGDES POBUL
  67. MYBPOL.LIPOLY(**)=POBUL
  68. * On génère les polynômes du type :
  69. * ((x_1.x_2...x_n)/x_i) (1-x_1...-x_n)
  70. DO 1 JDIM=1,NDIM
  71. NDIML=NDIM
  72. NBMON=NDIM+1
  73. SEGINI POBUL
  74. * On initialise les monômes à x_1.x_2...x_n
  75. CALL ISET(POBUL.EXPMON,1,NDIML*NBMON)
  76. * On divise par x_i
  77. DO 12 IMON=1,NBMON
  78. POBUL.EXPMON(JDIM,IMON)=
  79. $ POBUL.EXPMON(JDIM,IMON)-1
  80. 12 CONTINUE
  81.  
  82. * On ajuste les coeff. et les monômes
  83. POBUL.COEMON(1)=UN
  84. DO 14 IMON=2,NDIM+1
  85. POBUL.COEMON(IMON)=-UN
  86. POBUL.EXPMON(IMON-1,IMON)=
  87. $ POBUL.EXPMON(IMON-1,IMON)+1
  88. 14 CONTINUE
  89. SEGDES POBUL
  90. MYBPOL.LIPOLY(**)=POBUL
  91. 1 CONTINUE
  92. SEGDES MYBPOL
  93. *
  94. * Normal termination
  95. *
  96. IRET=0
  97. RETURN
  98. *
  99. * Format handling
  100. *
  101. *
  102. * Error handling
  103. *
  104. 9999 CONTINUE
  105. IRET=1
  106. WRITE(IOIMP,*) 'An error was detected in subroutine gpofbu'
  107. RETURN
  108. *
  109. * End of subroutine GPOFBU
  110. *
  111. END
  112.  
  113.  
  114.  
  115.  

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