1 : C ARROND SOURCE CHAT 11/05/27 21:15:10 6983 2 : FUNCTION ARROND(B,PAS,K) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Y) 5 : REAL*8 ARROND 6 : * 7 : * ARRONDI UNE BORNE B DONNEE SOUS LA FORME XXXXX.XX POUR QU'ELLE 8 : * SOIT UN MULTIPLE DE PAS AVEC UN ARRONDI SUPERIEUR SI K=1, 9 : * INFERIEUR SI K=0 10 : * 11 : * 12 : * DETERMINE COMMENT FAIRE L'ARRONDI 13 : * 14 : C=0.D0 15 : IF (B.LT.0.D0) THEN 16 : IF (K.EQ.0) THEN 17 : * ARRONDI PAR EN DESSOUS D'UNE BORNE NEGATIVE 18 : C=-1.D0 19 : ELSE 20 : * ARRONDI PAR AU DESSUS D'UNE BORNE NEGATIVE 21 : C=0.D0 22 : ENDIF 23 : ELSE 24 : IF (K.EQ.0) THEN 25 : * ARRONDI PAR EN DESSOUS D'UNE BORNE POSITIVE 26 : C=0.D0 27 : ELSE 28 : * ARRONDI PAR AU DESSUS D'UNE BORNE POSITIVE 29 : C=1.D0 30 : ENDIF 31 : ENDIF 32 : * PASSE EN NOMBRE ENTIER POUR AVOIR UN MODULO ENTIER EVITANT LES 33 : * PROBLEMES DE CODAGE EN MACHINE DES FLOTTANTS 34 : BB=B*100.D0 35 : IF (BB.LT.0.D0) THEN 36 : IB=INT(BB-.5D0) 37 : ELSE 38 : IB=INT(BB+.5D0) 39 : ENDIF 40 : IPAS=INT(PAS*100.D0+.5D0) 41 : I=nint(B/PAS) 42 : J = int(B/PAS) 43 : R=ABS(MOD(IB,IPAS)) 44 : * CALCUL DE L'ARRONDI 45 : IF (R.GE.1.D0) THEN 46 : ARROND=(I+C)*PAS 47 : ELSE 48 : ARROND=B 49 : ENDIF 50 : RETURN 51 : END 52 : 53 : 54 :
© Cast3M 2003 - All rights reserved.
Disclaimer