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.  
  36. -INC PPARAM
  37. -INC CCOPTIO
  38. CBEGININCLUDE SPOLYNO
  39. SEGMENT POLYNO
  40. REAL*8 COEMON(NBMON)
  41. INTEGER EXPMON(NDIML,NBMON)
  42. ENDSEGMENT
  43. SEGMENT POLYNS
  44. POINTEUR LIPOLY(NBPOLY).POLYNO
  45. ENDSEGMENT
  46. CENDINCLUDE SPOLYNO
  47. INTEGER NBMON,NDIML
  48. POINTEUR MYBPOL.POLYNS
  49. POINTEUR POBUL.POLYNO
  50. *
  51. INTEGER NDIM
  52. INTEGER IMPR,IRET
  53. *
  54. REAL*8 UN
  55. PARAMETER(UN=1.D0)
  56. INTEGER JDIM,IMON
  57. *
  58. * Executable statements
  59. *
  60. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans gpofbu.eso'
  61. SEGACT MYBPOL*MOD
  62. * On génère le polynôme : x_1.x_2...x_n
  63. NDIML=NDIM
  64. NBMON=1
  65. SEGINI POBUL
  66. POBUL.COEMON(1)=1
  67. CALL ISET(POBUL.EXPMON,1,NDIML)
  68. SEGDES POBUL
  69. MYBPOL.LIPOLY(**)=POBUL
  70. * On génère les polynômes du type :
  71. * ((x_1.x_2...x_n)/x_i) (1-x_1...-x_n)
  72. DO 1 JDIM=1,NDIM
  73. NDIML=NDIM
  74. NBMON=NDIM+1
  75. SEGINI POBUL
  76. * On initialise les monômes à x_1.x_2...x_n
  77. CALL ISET(POBUL.EXPMON,1,NDIML*NBMON)
  78. * On divise par x_i
  79. DO 12 IMON=1,NBMON
  80. POBUL.EXPMON(JDIM,IMON)=
  81. $ POBUL.EXPMON(JDIM,IMON)-1
  82. 12 CONTINUE
  83.  
  84. * On ajuste les coeff. et les monômes
  85. POBUL.COEMON(1)=UN
  86. DO 14 IMON=2,NDIM+1
  87. POBUL.COEMON(IMON)=-UN
  88. POBUL.EXPMON(IMON-1,IMON)=
  89. $ POBUL.EXPMON(IMON-1,IMON)+1
  90. 14 CONTINUE
  91. SEGDES POBUL
  92. MYBPOL.LIPOLY(**)=POBUL
  93. 1 CONTINUE
  94. SEGDES MYBPOL
  95. *
  96. * Normal termination
  97. *
  98. IRET=0
  99. RETURN
  100. *
  101. * Format handling
  102. *
  103. *
  104. * Error handling
  105. *
  106. 9999 CONTINUE
  107. IRET=1
  108. WRITE(IOIMP,*) 'An error was detected in subroutine gpofbu'
  109. RETURN
  110. *
  111. * End of subroutine GPOFBU
  112. *
  113. END
  114.  
  115.  
  116.  
  117.  

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