Télécharger valpol.eso

Retour à la liste

Numérotation des lignes :

  1. C VALPOL SOURCE GOUNAND 08/11/07 21:15:05 6194
  2. SUBROUTINE VALPOL(NDIML,NBMONO,
  3. $ XCONO1,
  4. $ COEMON,EXPMON,
  5. $ ORDER1,
  6. $ VALEUR,
  7. $ IMPR,IRET)
  8. IMPLICIT INTEGER(I-N)
  9. IMPLICIT REAL*8 (A-H,O-Z)
  10. C***********************************************************************
  11. C NOM : VALPOL
  12. C PROJET : Noyau lineaire NLIN
  13. C DESCRIPTION : Calcule la valeur d'un polynome de R^{ndiml} ou la
  14. C valeur d'une de ses derivees en un point de R^{ndiml}.
  15. C NDIML : dimension de l'espace
  16. C NBMONO : nombre de monomes du polynome
  17. C XCONO1 : coordonnees du point
  18. C COEMON : coefficient d'un monome
  19. C EXPMON : exposants du monome
  20. C ORDER1 : ordre de derivation par rapport a
  21. C chacune des coordonnees
  22. C
  23. C LANGAGE : Fortran 77 (sauf pour les E/S)
  24. C AUTEUR : Stephane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  25. C mel : gounand@semt2.smts.cea.fr
  26. C***********************************************************************
  27. C APPELES : -
  28. C APPELE PAR : CALPN, NI
  29. C***********************************************************************
  30. C ENTREES : NDIML, NBMONO, XCONO1, COEMON, EXPMON, ORDER1
  31. C ENTREES/SORTIES : -
  32. C SORTIES : VALEUR
  33. C CODE RETOUR (IRET) : = 0 si tout s'est bien passe
  34. C***********************************************************************
  35. C VERSION : v1, 16/09/99, version initiale
  36. C HISTORIQUE : v1, 16/09/99, creation
  37. C HISTORIQUE :
  38. C HISTORIQUE :
  39. C***********************************************************************
  40. C Priere de PRENDRE LE TEMPS de completer les commentaires
  41. C en cas de modification de ce sous-programme afin de faciliter
  42. C la maintenance !
  43. C***********************************************************************
  44. -INC CCOPTIO
  45. INTEGER NDIML,NBMONO
  46. REAL*8 XCONO1(NDIML)
  47. REAL*8 COEMON(NBMONO)
  48. INTEGER EXPMON(NDIML,NBMONO)
  49. INTEGER ORDER1(NDIML)
  50. REAL*8 VALEUR
  51. *
  52. INTEGER IMPR,IRET
  53. *
  54. INTEGER IMONO,INDIML,IFACT
  55. INTEGER NEXPKS,NDERKS
  56. REAL*8 VALMON,VAMOEL
  57. *
  58. * Executable statements
  59. *
  60. IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entree dans valpol'
  61. *
  62. * Calcul de la valeur au point de coordonnees XCONO1 de la
  63. * derivee definie par ORDER1 du monome definie par EXPMON
  64. *
  65. VALEUR=0.D0
  66. DO 1 IMONO=1,NBMONO
  67. VALMON=COEMON(IMONO)
  68. DO 12 INDIML=1,NDIML
  69. NEXPKS=EXPMON(INDIML,IMONO)
  70. NDERKS=ORDER1(INDIML)
  71. *
  72. * d/dx^m (x^n) = 0 si m>n
  73. * = n!/(n-m)! x^(n-m) si m<=n
  74. * ou n! = factorielle de n et en choisissant
  75. * 0! = 1
  76. IF (NDERKS.GT.NEXPKS) THEN
  77. VAMOEL=0.D0
  78. ELSEIF (NDERKS.EQ.NEXPKS) THEN
  79. VAMOEL=1.D0
  80. DO 222 IFACT=1,NEXPKS
  81. VAMOEL=VAMOEL*IFACT
  82. 222 CONTINUE
  83. ELSE
  84. VAMOEL=1.D0
  85. DO 122 IFACT=(NEXPKS-NDERKS+1),NEXPKS,1
  86. VAMOEL=VAMOEL*IFACT
  87. 122 CONTINUE
  88. VAMOEL=VAMOEL*(XCONO1(INDIML)**(NEXPKS-NDERKS))
  89. ENDIF
  90. VALMON=VALMON*VAMOEL
  91. 12 CONTINUE
  92. VALEUR=VALEUR+VALMON
  93. 1 CONTINUE
  94. *
  95. * Normal termination
  96. *
  97. IRET=0
  98. RETURN
  99. *
  100. * Format handling
  101. *
  102. *
  103. * Error handling
  104. *
  105. 9999 CONTINUE
  106. IRET=1
  107. WRITE(IOIMP,*) 'An error was detected in subroutine valpol'
  108. RETURN
  109. *
  110. * End of subroutine VALPOL
  111. *
  112. END
  113.  
  114.  

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