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 :
© Cast3M 2003 - All rights reserved.
Disclaimer