Google
 

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