Télécharger gbapco.eso

Retour à la liste

Numérotation des lignes :

  1. C GBAPCO SOURCE GOUNAND 05/12/21 21:23:19 5281
  2. SUBROUTINE GBAPCO(NDIM,NDEG,
  3. $ BAPOLY,
  4. $ IMPR,IRET)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. IMPLICIT INTEGER (I-N)
  7. C***********************************************************************
  8. C NOM : GBAPCO
  9. C DESCRIPTION : Génère une base polynômiale complète de dimension NDIM
  10. C et de degré NDEG.
  11. C cf. Dhatt et Touzot p.45
  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 : -
  19. C APPELE PAR : INELSE, INELTR, INELQU, INELTE, INELPR, INELCU
  20. C***********************************************************************
  21. C ENTREES : NDIM, NDEG
  22. C ENTREES/SORTIES : -
  23. C SORTIES : BAPOLY
  24. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  25. C***********************************************************************
  26. C VERSION : v1, 09/05/2000, version initiale
  27. C HISTORIQUE : v1, 09/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 NBPOLY
  46. POINTEUR BAPOLY.POLYNS
  47. INTEGER NBMON,NDIML
  48. POINTEUR MYPOLY.POLYNO
  49. *
  50. INTEGER NDIM,NDEG
  51. INTEGER IMPR,IRET
  52. *
  53. INTEGER IDEG,IEXP,IEXP2
  54. REAL*8 UN
  55. PARAMETER(UN=1.D0)
  56. *
  57. * Executable statements
  58. *
  59. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans gbapco.eso'
  60. NBPOLY=0
  61. SEGINI BAPOLY
  62. IF (NDIM.EQ.1) THEN
  63. DO 1 IDEG=0,NDEG
  64. NDIML=NDIM
  65. NBMON=1
  66. SEGINI MYPOLY
  67. MYPOLY.COEMON(1)=UN
  68. MYPOLY.EXPMON(1,1)=IDEG
  69. SEGDES MYPOLY
  70. BAPOLY.LIPOLY(**)=MYPOLY
  71. 1 CONTINUE
  72. ELSEIF (NDIM.EQ.2) THEN
  73. DO 3 IDEG=0,NDEG
  74. DO 32 IEXP=IDEG,0,-1
  75. NDIML=NDIM
  76. NBMON=1
  77. SEGINI MYPOLY
  78. MYPOLY.COEMON(1)=UN
  79. MYPOLY.EXPMON(1,1)=IEXP
  80. MYPOLY.EXPMON(2,1)=IDEG-IEXP
  81. SEGDES MYPOLY
  82. BAPOLY.LIPOLY(**)=MYPOLY
  83. 32 CONTINUE
  84. 3 CONTINUE
  85. ELSEIF (NDIM.EQ.3) THEN
  86. DO 5 IDEG=0,NDEG
  87. DO 52 IEXP=IDEG,0,-1
  88. DO 522 IEXP2=IDEG-IEXP,0,-1
  89. NDIML=NDIM
  90. NBMON=1
  91. SEGINI MYPOLY
  92. MYPOLY.COEMON(1)=UN
  93. MYPOLY.EXPMON(1,1)=IEXP
  94. MYPOLY.EXPMON(2,1)=IEXP2
  95. MYPOLY.EXPMON(3,1)=IDEG-(IEXP+IEXP2)
  96. SEGDES MYPOLY
  97. BAPOLY.LIPOLY(**)=MYPOLY
  98. 522 CONTINUE
  99. 52 CONTINUE
  100. 5 CONTINUE
  101. ELSE
  102. WRITE(IOIMP,*) 'Je ne sais pas générer une base poly.',
  103. $ 'complète pour des dimensions sup. à 3.'
  104. GOTO 9999
  105. ENDIF
  106. SEGDES BAPOLY
  107. *
  108. * Normal termination
  109. *
  110. IRET=0
  111. RETURN
  112. *
  113. * Format handling
  114. *
  115. *
  116. * Error handling
  117. *
  118. 9999 CONTINUE
  119. IRET=1
  120. WRITE(IOIMP,*) 'An error was detected in subroutine gbapco'
  121. RETURN
  122. *
  123. * End of subroutine GBAPCO
  124. *
  125. END
  126.  
  127.  
  128.  
  129.  

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