Trailing-Edge
-
PDP-10 Archives
-
decuslib10-02
-
43,50251/testfm.f4
There are no other files named testfm.f4 in the archive.
C***********************************************************************
C**** TEST PROGRAM FOR MULTI-DIMENSIONAL TRANSFORM
C**** PROGRAM FOUR2
C**** UNIT 5 IS ASSIGNED TO CARD READER
C**** UNIT 6 IS ASSIGNED TO LINE PRINTER
C**** TEST FOUR2 BY TRANSFORMING AND INVERSE TRANSFORMING A REAL RAMP
C***********************************************************************
DIMENSION DATA(8,512), TRAN(2,5,512), SAVE(2,2,20), N(2)
C DATA IS A REAL ARRAY, TRAN COMPLEX
EQUIVALENCE (DATA,TRAN)
PI=3.1415926535
ALPHA=10000.
BETA=3.
C RAMP INTERCEPT AND SLOPE
EPS=1.E-3
C ERROR CRITERION
DO 160 LOG2N=1,9
N1=8
N2=2**LOG2N
NTOT=N1*N2
N(1)=N1
N(2)=N2
DO 10 J1=1,N1
DO 10 J2=1,N2
10 DATA(J1,J2)=ALPHA+BETA*FLOAT(J1-1+N1*(J2-1))
DO 20 J=1,20
SAVE(1,1,J)=DATA(J,1)
20 SAVE(2,1,J)=0.
CALL FOUR2 (DATA,N,2,-1,0)
C FOURIER TRANSFORM ARRAY DATA
NERR=0
SMSQE=0.
K1MAX=N1/2+1
DO 110 K1=1,K1MAX
DO 110 K2=1,N2
C COMPUTE VAL, THE KNOWN TRANSFORM VALUE
IF (K1-1) 30,30,50
30 KI=K2
NI=N2
CONST=N1
IF (K2-1) 40,40,60
40 VALR=ALPHA*FLOAT(NTOT)+BETA*FLOAT(NTOT)*FLOAT(NTOT-1)/2.
VALI=0.
GO TO 80
50 KI=K1
NI=N1
CONST=1.
IF (K2-1) 60,60,70
60 THETA=PI*FLOAT(KI-1)/FLOAT(NI)
VALR=-BETA*FLOAT(NTOT)*CONST/2.
VALI=-VALR*COS(THETA)/SIN(THETA)
GO TO 80
70 VALR=0.
VALI=0.
ERRSQ=TRAN(1,K1,K2)*TRAN(1,K1,K2)+TRAN(2,K1,K2)*TRAN(2,K1,K2)
GO TO 90
80 DENOM=VALR*VALR+VALI*VALI
DIVR=(TRAN(1,K1,K2)*VALR+TRAN(2,K1,K2)*VALI)/DENOM
DIVI=(TRAN(2,K1,K2)*VALR-TRAN(1,K1,K2)*VALI)/DENOM
C DIV=TRAN(K1,K2)/VAL
ERRSQ=(DIVR-1.)*(DIVR-1.)+DIVI*DIVI
90 ERR=SQRT(ERRSQ)
C ERR=CABS(TRAN(K1,K2)/VAL-1), THE RELATIVE ERROR
SMSQE=SMSQE+ERRSQ
IF (ERR-EPS) 110,110,100
100 NERR=NERR+1
110 CONTINUE
RMS=SQRT(SMSQE/FLOAT(NTOT))
WRITE (6,120) N1,N2,NERR,EPS,RMS
120 FORMAT (32H0FOUR2 TRANSFORMED A REAL ARRAY ,I2,4H BY ,I5,6H WITH ,
$I4,20H ERRORS LARGER THAN ,E8.1,23H--RMS RELATIVE ERROR = ,E11.4)
DO 130 J=1,20
SAVE(1,2,J)=TRAN(1,J,1)
130 SAVE(2,2,J)=TRAN(2,J,1)
C INVERSE TRANSFORM
CALL FOUR2 (DATA,N,2,+1,-1)
NERR=0
SMSQE=0.
DO 150 J1=1,N1
DO 150 J2=1,N2
VAL=ALPHA+BETA*FLOAT(J1-1+N1*(J2-1))
DATA(J1,J2)=DATA(J1,J2)/FLOAT(NTOT)
ERR=ABS(DATA(J1,J2)/VAL-1.)
SMSQE=SMSQE+ERR*ERR
IF (ERR-EPS) 150,150,140
140 NERR=NERR+1
150 CONTINUE
RMS=SQRT(SMSQE/FLOAT(NTOT))
160 WRITE (6,170) NERR,EPS,RMS
170 FORMAT (55H THE CONJUGATE SYMMETRIC ARRAY WAS RE-TRANSFORMED WITH
$I4,20H ERRORS LARGER THAN ,E8.1,23H--RMS RELATIVE ERROR = ,E11.4)
C AS A CHECK BY EYE, COMPARE THE VALUES FOR THE LAST CASE WITH THE
C CORRECT VALUES AS SHOWN BELOW.
ZERO=0.
WRITE (6,180) N1,N2,(SAVE(1,1,K),SAVE(2,1,K),SAVE(1,2,K),SAVE(2,2,
$K),DATA(K,1),ZERO,K=1,20)
180 FORMAT (///32X,6HARRAY ,I2,4H BY ,I4/15X,5HINPUT,15X,9HTRANSFORM,
$15X,11HRETRANSFORM/5X,66H REAL IMAG REAL I
$MAG REAL IMAG/(5X,F14.4,F5.1,3F14.4,F5.1))
C
C ARRAY 8 BY 512
C INPUT TRANSFORM RETRANSFORM
C REAL IMAG REAL IMAG REAL IMAG
C 10000.0000 0 66119680.0000 0 10000.0000 0
C 10003.0000 0 -6144.0000 14832.9281 10003.0000 0
C 10006.0000 0 -6144.0000 6144.0000 10006.0000 0
C 10009.0000 0 -6144.0000 2544.9281 10009.0000 0
C 10012.0000 0 -6144.0000 0 10012.0000 0
C 10015.0000 0 -49151.9998 8010430.0414 10015.0000 0
C 10018.0000 0 0 0 10018.0000 0
C 10021.0000 0 0 0 10021.0000 0
C 10024.0000 0 0 0 10024.0000 0
C 10027.0000 0 0 0 10027.0000 0
C 10030.0000 0 -49152.0000 4005064.2226 10030.0000 0
C 10033.0000 0 0 0 10033.0000 0
C 10036.0000 0 0 0 10036.0000 0
C 10039.0000 0 0 0 10039.0000 0
C 10042.0000 0 0 0 10042.0000 0
C 10045.0000 0 -49151.9999 2669875.2579 10045.0000 0
C 10048.0000 0 0 0 10048.0000 0
C 10051.0000 0 0 0 10051.0000 0
C 10054.0000 0 0 0 10054.0000 0
C 10057.0000 0 0 0 10057.0000 0
C
STOP
END