1 : C ICALP SOURCE CHAT 11/05/27 21:15:19 6983 2 : INTEGER FUNCTION ICALP (X,Y) 3 : * 4 : * X (E) : BORNE D'AXE 5 : * 6 : * RETOURNE N TEL QUE X SOUS FORMAT X *10 E N 7 : * EXCEPTION 0 8 : * 9 : IMPLICIT INTEGER(I-N) 10 : IMPLICIT REAL*8 (A-H,O-Y) 11 : if (x.gt.-1d50.and.x.lt.1d50) then 12 : if (y.gt.-1d50.and.y.lt.1d50) then 13 : B=ABS(X) 14 : N=0 15 : IF (B.EQ.0.d0) GOTO 3 16 : 1 IF (B.LT.1.D0) THEN 17 : B=B*10 18 : N=N-1 19 : GOTO 1 20 : ENDIF 21 : 2 IF (B.GE.10.D0) THEN 22 : B=B/10 23 : N=N+1 24 : GOTO 2 25 : ENDIF 26 : 3 N2=N 27 : B=ABS(Y) 28 : N=0 29 : IF (B.EQ.0.D0) GOTO 6 30 : 4 IF (B.LT.1.D0) THEN 31 : B=B*10 32 : N=N-1 33 : GOTO 4 34 : ENDIF 35 : 5 IF (B.GE.10.D0) THEN 36 : B=B/10 37 : N=N+1 38 : GOTO 5 39 : ENDIF 40 : 6 N1=N 41 : IF (N1.GT.N2) THEN 42 : IF (Y.EQ.0.D0) THEN 43 : IP=N2 44 : ELSE 45 : IP=N1 46 : ENDIF 47 : ELSE 48 : IF (X.EQ.0.D0) THEN 49 : IP=N1 50 : ELSE 51 : IP=N2 52 : ENDIF 53 : ENDIF 54 : * UN NOMBRE A DEUX CHIFFRES ON LE LAISSE TEL QUEL 55 : IF (ABS(IP).EQ.1) IP=0 56 : ICALP=IP 57 : return 58 : endif 59 : endif 60 : icalp=0 61 : END 62 : 63 : 64 : 65 :
© Cast3M 2003 - All rights reserved.
Disclaimer