Télécharger somme3.eso

Retour à la liste

Numérotation des lignes :

somme3
  1. C SOMME3 SOURCE CHAT 05/01/13 03:22:09 5004
  2. SUBROUTINE SOMME3 (PROG)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. ************************************************************************
  6. *
  7. * S O M M E 3
  8. * -----------
  9. *
  10. * FONCTION:
  11. * ---------
  12. *
  13. * PROCEDURE INTERNE SPECIFIQUE AU SOUS-PROGRAMME "SOMME1".
  14. *
  15. * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN)
  16. * -----------
  17. *
  18. * +F0 (E)
  19. * +F8 (E)
  20. * +M6 (E)
  21. * +A6 (E)
  22. * +NBFONC (E)
  23. * PROG (E) VOIR "SOMME1"
  24. * +NEAR6P (S)
  25. * +NEAR6S (S)
  26. * +F6 (S)
  27. *
  28. REAL*8 PROG(*)
  29. LOGICAL NEAR6P,NEAR6S
  30. COMMON /CSOMM1/ F0,F8,F6,A6,M6,NBFONC,NEAR6P,NEAR6S
  31. *
  32. * CONSTANTES:
  33. * -----------
  34. *
  35. REAL*8 EPS,EPS9
  36. PARAMETER (EPS = 1.D-3)
  37. PARAMETER (EPS9 = 1.D0-EPS)
  38. *
  39. * AUTEUR, DATE DE CREATION:
  40. * -------------------------
  41. *
  42. * PASCAL MANIGOT 29 MARS 1988
  43. *
  44. * LANGAGE:
  45. * --------
  46. *
  47. * FORTRAN77
  48. *
  49. ************************************************************************
  50. *
  51. IF (M6 .EQ. 0) THEN
  52. NEAR6P = .FALSE.
  53. NEAR6S = A6 .LT. EPS
  54. ELSE IF (M6 .EQ. NBFONC) THEN
  55. NEAR6P = A6 .LT. EPS
  56. NEAR6S = .FALSE.
  57. ELSE
  58. NEAR6P = A6 .LT. EPS
  59. NEAR6S = A6 .GT. EPS9
  60. END IF
  61. *
  62. IF (NEAR6P) THEN
  63. F6 = PROG(M6)
  64. ELSE IF (NEAR6S) THEN
  65. F6 = PROG(M6+1)
  66. ELSE IF (M6.EQ.0) THEN
  67. F6 = F0
  68. ELSE IF (M6.EQ.NBFONC) THEN
  69. F6 = F8
  70. ELSE
  71. F6 = (1.D0-A6)*PROG(M6) + A6*PROG(M6+1)
  72. END IF
  73. *
  74. END
  75.  
  76.  

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