多数桁加減算等FORTRANプログラム
2003/01/10 日立製作所 & 早稲田大学 後 保範 ( Ushiro Yasunori )
--------------------------------------------------------------
C==================================================================C
SUBROUTINE ADD(A,B,C,N,ID)
C------------------------------------------------------------------C
C Fixed Add or Subtract (C=A+B or A-B) with Normalize by BASE C
C A(N) R*8, In, First Input for A C
C B(N) R*8, In, Second Input for B C
C C(N) R*8, Out, Ouput for C=A+B or A-B C
C N I*4, In, Number of Input(A,B) Elements C
C ID I*4, In, ID= 1 : C=A+B C
C =-1 : C=A-B C
C------------------------------------------------------------------C
C Written by Y. Ushiro ( Waseda Uni. and Hitachi ) 2003.01.03 C
C==================================================================C
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION A(N), B(N), C(N)
C Check ID
IF(ID.GE.0) THEN
C C=A+B
DO 10 i=1,N
10 C(i) = A(i) + B(i)
ELSE
C C=A-B
DO 20 i=1,N
20 C(i) = A(i) - B(i)
END IF
C Fixed Normalize
CALL NORM(C,N)
C
RETURN
END
C==================================================================C
SUBROUTINE FADD(A,B,C,N,ID)
C------------------------------------------------------------------C
C Floating Add or Subtract (C=A+B or A-B) with Normalize C
C A(0:N) R*8, In, First Input for A C
C B(0:N) R*8, In, Second Input for B C
C C(0:N) R*8, Out, Ouput for C=A+B or A-B C
C N I*4, In, Number of Input(A,B) Elements C
C ID I*4, In, ID= 1 : C=A+B C
C =-1 : C=A-B C
C------------------------------------------------------------------C
C Written by Y. Ushiro ( Waseda Uni. and Hitachi ) 2003.01.03 C
C Fixed a Bug 2003.01.12 C
C==================================================================C
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION A(0:N), B(0:N), C(0:N)
C Check Exponent
IF(A(0).GE.B(0)) THEN
C Exponent A >= B
K = A(0) - B(0)
CALL COPY(A,C,K+1)
C Fixed ADD or SUB
CALL ADD(A(K+1),B(1),C(K+1),N-K,ID)
ELSE
C Exponent A < B
C(0) = B(0) ! Fixed a Bug 2003.01.12
K = B(0) - A(0)
IF(ID.GE.0) THEN
CALL COPY(B(1),C(1),K)
ELSE
DO 10 i=1,K
10 C(i) = -B(i)
END IF
C Fixed ADD or SUB
CALL ADD(A(1),B(K+1),C(K+1),N-K,ID)
END IF
C Floation Normalize
CALL NORM(C(1),N)
CALL FNORM(C,N)
C
RETURN
END
C==================================================================C
SUBROUTINE FCADD(IA,B,C,N,ID)
C------------------------------------------------------------------C
C Floating Constant Add or Subtract (C=IA-B) C
C IA I*4, In, Constant Value C
C B(0:N) R*8, In, Second Input for B C
C C(0:N) R*8, Out, Ouput for C=IA+B or IA-B C
C N I*4, In, Number of B,C Elements C
C ID I*4, In, ID= 1 : C=IA+B C
C =-1 : C=IA-B C
C------------------------------------------------------------------C
C Written by Y. Ushiro ( Waseda Uni. and Hitachi ) 2003.01.03 C
C==================================================================C
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION B(0:N), C(0:N)
C Check Exponent of B
S = 1.0
IF(ID.LT.0) S = -1.0
IF(B(0).GE.1) THEN
C B(0) >= 1
C(0) = B(0)
K = B(0)
DO 10 i=1,N
10 C(i) = S*B(i)
C(K) = IA + C(K)
ELSE
C B(0) <= 0
C(0) = 1
K = 1 - B(0)
C(1) = IA
CALL SETV(0,C(2),K-1)
DO 20 i=K+1,N
20 C(i) = S*B(i-K)
END IF
C Fixed and Floating Normalize
CALL NORM(C(1),N)
CALL FNORM(C,N)
C
RETURN
END
C==================================================================C
SUBROUTINE FCMT(A,IB,C,N)
C------------------------------------------------------------------C
C Floating Constant Multiplication (C=A*IB) C
C A(0:N) R*8, In, First Input for A C
C IB I*4, In, Constant value (IB <= BASE) C
C C(0:N) R*8, Out, Ouput for C=A*B C
C N I*4, In, Number of A,C Elements C
C------------------------------------------------------------------C
C Written by Y. Ushiro ( Waseda Uni. and Hitachi ) 2003.01.03 C
C==================================================================C
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION A(0:N), C(0:N)
COMMON /VBASE/BASE,NORID
C Top Multiplication
B = IB
TOP = ABS(A(1)*B)
IF(TOP.GE.BASE) THEN
C Fixed Multiplication ( TOP >= BASE )
C(0) = A(0) + 1
C(1) = 0
DO 10 i=1,N-1
10 C(i+1) = A(i)*B
C(N) = C(N) + DINT(A(N)*B/BASE)
ELSE
C Fixed Multiplication ( TOP < BASE )
C(0) = A(0)
DO 20 i=1,N
20 C(i) = A(i)*B
END IF
C Fixed and Floating Normalize
CALL NORM(C(1),N)
CALL FNORM(C,N)
C
RETURN
END
C==================================================================C
SUBROUTINE FCDIV(A,IB,C,N)
C------------------------------------------------------------------C
C Floating Constant Division (C=A/IB) C
C A(0:N) R*8, In, First Input for A C
C IB I*4, In, Constant Value (IB <= BASE) C
C C(0:N) R*8, Out, Ouput for C=A/B C
C N I*4, In, Number of A,C Elements C
C------------------------------------------------------------------C
C Written by Y. Ushiro ( Waseda Uni. and Hitachi ) 2003.01.03 C
C==================================================================C
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION A(0:N), C(0:N)
COMMON /VBASE/BASE,NORID
C Top Check
B = IB
IF(ABS(A(1)).GE.ABS(B)) THEN
C Fixed Division ( |A(1)| >= |B| )
C(0) = A(0)
BV = 0
DO i=1,N
DV = BV*BASE + A(i)
C(i) = DINT(DV/B)
BV = DV - C(i)*B
END DO
ELSE
C Fixed Division ( |A(1)| < |B| )
C(0) = A(0) - 1
BV = A(1)
DO i=1,N-1
DV = BV*BASE + A(i+1)
C(i) = DINT(DV/B)
BV = DV - C(i)*B
END DO
C(N) = DINT(BV*BASE/B)
END IF
C Fixed and Floating Normalize
CALL NORM(C(1),N)
CALL FNORM(C,N)
C
RETURN
END
C==================================================================C
SUBROUTINE CMLT(A,X,N)
C==================================================================C
C Fixed Multiplication (A(i)=A(i)*X) with Fixed Normalize C
C ARGUMENTS : C
C A(N) R*8, I/O, Input and Output Data C
C X I*4, In, Constant Value C
C N I*4, In, Number of Elements in A C
C------------------------------------------------------------------C
C Written by Y. Ushiro ( Waseda Uni. and Hitachi ) 2003.01.12 C
C==================================================================C
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION A(N)
C A=A*X
DO 10 i=1,N
10 A(i) = A(i)*X
CALL NORM(A,N)
C
RETURN
END
C==================================================================C
SUBROUTINE FNORM(A,N)
C------------------------------------------------------------------C
C A = Floating Normalize(A) C
C A(0:N) R*8,Both, Input and Output Data C
C N I*4, In, Number of Elements C
C------------------------------------------------------------------C
C Written by Y. Ushiro ( Waseda Uni. and Hitachi ) 2003.01.03 C
C------------------------------------------------------------------C
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION A(0:N)
C Save Exponent
EXP = A(0)
C Find Number of Zero (k) from Top
DO i=1,N
if(A(i).NE.0.0) GO TO 10
END DO
10 CONTINUE
K = i - 1
C Shift K Word Left
DO 20 i=1,N-K
20 A(i) = A(i+K)
CALL SETV(0,A(N-K+1),K)
C Set Exponent
A(0) = EXP - K
C
RETURN
END
C==================================================================C
SUBROUTINE NORM(A,N)
C------------------------------------------------------------------C
C A = Fixed Normalize(A) by Base-Value C
C A(N) R*8,Both, Input and Output Data C
C N I*4, In, Number of Elements C
C------------------------------------------------------------------C
C Written by Y. Ushiro ( Waseda Uni. and Hitachi ) 2003.01.03 C
C------------------------------------------------------------------C
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION A(N)
COMMON /VBASE/BASE,NORID
C Normalize by Base-Value (BASE)
DO i=N,2,-1
AI = DINT(A(i)/BASE)
A(i) = A(i) - AI*BASE
A(i-1) = A(i-1) + AI
END DO
C Check NORID (>=0; Positive Normalize, < 0 : Nearest Normalize )
IF(NORID.GE.0) THEN
C Set to A(i) >= 0 ( Positive Normalize )
DO i=N,2,-1
IF(A(i).LT.0.0) THEN
A(i-1) = A(i-1) - 1.0
A(i) = A(i) + BASE
END IF
END DO
ELSE
C Set to |A(i)| <= BASE/2 ( Nearest Normalize )
B2 = BASE/2.0
DO i=N,2,-1
IF(A(i).GT.B2) THEN
A(i-1) = A(i-1) + 1
A(i) = A(i) - BASE
ELSE IF(A(i).LT.-B2) THEN
A(i-1) = A(i-1) - 1
A(i) = A(i) + BASE
END IF
END DO
END IF
C
RETURN
END
C==================================================================C
SUBROUTINE FLOAT(A,N)
C------------------------------------------------------------------C
C Change A from fixed to Floating C
C A(0:N) R*8,Both, Input and Output Data C
C N I*4, In, Number of Elements C
C------------------------------------------------------------------C
C Written by Y. Ushiro ( Waseda Uni. and Hitachi ) 2003.01.03 C
C------------------------------------------------------------------C
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION A(0:N)
C Set Exponent and Floating Normalize
A(0) = N
CALL FNORM(A,N)
C
RETURN
END
C==================================================================C
SUBROUTINE COPY(A,C,N)
C------------------------------------------------------------------C
C Copy from A to C ( C = A ) C
C A(N) R*8, In, Input A C
C C(N) R*8, Out, Output C C
C N I*4, In, Number of Elements of A,C C
C------------------------------------------------------------------C
C Written by Y. Ushiro ( Waseda Uni. and Hitachi ) 2003.01.03 C
C==================================================================C
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION A(N), C(N)
C Copy from A to C
DO 10 i=1,N
10 C(i) = A(i)
C
RETURN
END
C==================================================================C
SUBROUTINE SETV(IV,C,N)
C------------------------------------------------------------------C
C Set Value V to C ( C(i) = IV ) C
C IV I*4, In, Constant IV C
C C(N) R*8, Out, Output C C
C N I*4, In, Number of Elements of C C
C------------------------------------------------------------------C
C Written by Y. Ushiro ( Waseda Uni. and Hitachi ) 2003.01.03 C
C==================================================================C
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION C(N)
C Set IV to C
DO i=1,N
C(i) = IV
END DO
C
RETURN
END
C==================================================================C
SUBROUTINE FVSET(IV,C,N)
C------------------------------------------------------------------C
C Set Floating Value to C ( C = Floating IV ) C
C IV I*4, In, Constant IV C
C C(0:N) R*8, Out, Output C C
C N I*4, In, Number of Elements of C C
C------------------------------------------------------------------C
C Written by Y. Ushiro ( Waseda Uni. and Hitachi ) 2003.01.03 C
C==================================================================C
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION C(0:N)
C Set Exponent
C(0) = 1
C Set IV Value
C(1) = IV
CALL SETV(0,C(2),N-1)
C
RETURN
END
C==================================================================C
SUBROUTINE LOG2F(N,NB)
C------------------------------------------------------------------C
C Set NB=log2(N), 2**NB=N C
C N I*4, In, Number of FMT Elements C
C NB I*4, Out, 2**NB=N C
C------------------------------------------------------------------C
C Written by Y. Ushiro ( Waseda Uni. and Hitachi ) 2003.01.03 C
C==================================================================C
IMPLICIT REAL*8(A-H,O-Z)
C NB=LOG2(N)
DN = N + 0.5
NB = DLOG(DN)/DLOG(2.0D0)
C
RETURN
END