Sources Esope | Cast3M

somme3
C SOMME3    SOURCE    CHAT      05/01/13    03:22:09     5004
      SUBROUTINE SOMME3 (PROG)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
************************************************************************
*
*                             S O M M E 3
*                             -----------
*
* FONCTION:
* ---------
*
*     PROCEDURE INTERNE SPECIFIQUE AU SOUS-PROGRAMME "SOMME1".
*
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)
* -----------
*
*    +F0      (E)
*    +F8      (E)
*    +M6      (E)
*    +A6      (E)
*    +NBFONC  (E)
*     PROG    (E)                VOIR "SOMME1"
*    +NEAR6P  (S)
*    +NEAR6S  (S)
*    +F6      (S)
*
      REAL*8 PROG(*)
      LOGICAL NEAR6P,NEAR6S
      COMMON /CSOMM1/ F0,F8,F6,A6,M6,NBFONC,NEAR6P,NEAR6S
*
* CONSTANTES:
* -----------
*
      REAL*8 EPS,EPS9
      PARAMETER (EPS = 1.D-3)
      PARAMETER (EPS9 = 1.D0-EPS)
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*
*     PASCAL MANIGOT     29 MARS 1988
*
* LANGAGE:
* --------
*
*     FORTRAN77
*
************************************************************************
*
      IF (M6 .EQ. 0) THEN
         NEAR6P = .FALSE.
         NEAR6S = A6 .LT. EPS
      ELSE IF (M6 .EQ. NBFONC) THEN
         NEAR6P = A6 .LT. EPS
         NEAR6S = .FALSE.
      ELSE
         NEAR6P = A6 .LT. EPS
         NEAR6S = A6 .GT. EPS9
      END IF
*
      IF (NEAR6P) THEN
         F6 = PROG(M6)
      ELSE IF (NEAR6S) THEN
         F6 = PROG(M6+1)
      ELSE IF (M6.EQ.0) THEN
         F6 = F0
      ELSE IF (M6.EQ.NBFONC) THEN
         F6 = F8
      ELSE
         F6 = (1.D0-A6)*PROG(M6) + A6*PROG(M6+1)
      END IF
*
      END