File DRHARM.FT (FORTRAN source file)

Directory of image this file is from
This file as a plain text file

C
C     ..................................................................
C
C        SUBROUTINE DRHARM
C
C        PURPOSE
C           FINDS THE FOURIER COEFFICIENTS OF ONE DIMENSIONAL DOUBLE
C           PRECISION REAL DATA
C
C        USAGE
C           CALL DRHARM(A,M,INV,S,IFERR)
C
C        DESCRIPTION OF PARAMETERS
C           A     - A DOUBLE PRECISION VECTOR
C                   AS INPUT, CONTAINS ONE DIMENSIONAL REAL DATA. A IS
C                   2*N+4 CORE LOCATIONS, WHERE N = 2**M. 2*N REAL
C                   NUMBERS ARE PUT INTO THE FIRST 2*N CORE LOCATIONS
C                   OF A
C                   AS OUTPUT, A CONTAINS THE FOURIER COEFFICIENTS
C                   A0/2,B0=0,A1,B1,A2,B2,...,AN/2,BN=0 RESPECTIVELY IN
C                   THE FIRST 2N+2 CORE LOCATIONS OF A
C           M     - AN INTEGER WHICH DETERMINES THE SIZE OF THE VECTOR
C                   A. THE SIZE OF A IS 2*(2**M) + 4
C           INV   - A VECTOR WORK AREA FOR BIT AND INDEX MANIPULATION OF
C                   DIMENSION ONE EIGHTH THE NUMBER OF REAL INPUT, VIZ.,
C                   (1/8)*2*(2**M)
C           S     - A DOUBLE PRECISION VECTOR WORK AREA FOR SINE TABLES
C                   WITH DIMENSION THE SAME AS INV
C           IFERR - A RETURNED VALUE OF 1 MEANS THAT M IS LESS THAN 3 OR
C                   GREATER THAN 20. OTHERWISE IFERR IS SET = 0
C
C        REMARKS
C           THIS SUBROUTINE GIVES THE FOURIER COEFFICIENTS OF 2*(2**M)
C           REAL POINTS. SEE SUBROUTINE DHARM FOR THREE DIMENSIONAL,
C           DOUBLE PRECISION, COMPLEX FOURIER TRANSFORMS.
C
C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
C           DHARM
C
C        METHOD
C           THE FOURIER COEFFICIENTS A0,B0=0,A1,B1,...,AN,BN=0 ARE
C           OBTAINED FOR INPUT XJ, J=0,1,2,...,2N-1 FOR THE FOLLOWING
C           EQUATION (PI = 3.14159...)
C
C                 N-1                                               J
C     XJ=(1/2)A0+SUM (AK*COS(PI*J*K/N)+BK*SIN(PI*J*K/N))+(1/2)AN(-1)
C                 K=1
C
C           SEE REFERENCE UNDER SUBROUTINE DHARM
C
C     ..................................................................
C
      SUBROUTINE DRHARM(A,M,INV,S,IFERR)
      DIMENSION A(1),L(3),INV(1),S(1)
      DOUBLE PRECISION A,SI,AP1IM,FN,CO,CIRE,AP2IM,S,SS,DEL,CIIM,AP1RE,
     1 CNIRE,SC,SIS,AP2RE,CNIIM
      IFSET=1
      L(1)=M
      L(2)=0
      L(3)=0
      NTOT=2**M
      NTOT2 = 2*NTOT
      FN = NTOT
      DO   3 I = 2,NTOT2,2
   3  A(I) = -A(I)
      DO   6 I = 1,NTOT2
   6  A(I) = A(I)/FN
      CALL DHARM(A,L,INV,S,IFSET,IFERR)
C
C     MOVE LAST HALF OF A(J)S DOWN ONE SLOT AND ADD A(N) AT BOTTOM TO
C     GIVE ARRAY FOR A1PRIME AND A2PRIME CALCULATION
C
   21 DO  52 I=1,NTOT,2
      J0=NTOT2+2-I
      A(J0)=A(J0-2)
   52 A(J0+1)=A(J0-1)
      A(NTOT2+3)=A(1)
      A(NTOT2+4)=A(2)
C
C     CALCULATE A1PRIMES AND STORE IN FIRST N SLOTS
C     CALCULATE A2PRIMES AND STORE IN SECOND N SLOTS IN REVERSE ORDER
      K0=NTOT+1
      DO 104 I=1,K0,2
      K1=NTOT2-I+4
      AP1RE=.5*(A(I)+A(K1))
      AP2RE=-.5*(A(I+1)+A(K1+1))
      AP1IM=.5*(-A(I+1)+A(K1+1))
      AP2IM=-.5*(A(I)-A(K1))
      A(I)=AP1RE
      A(I+1)=AP1IM
      A(K1)=AP2RE
  104 A(K1+1)=AP2IM
      NTO = NTOT/2
  110 NT=NTO+1
      DEL=3.141592653589793/DFLOAT(NTOT)
      SS=DSIN(DEL)
      SC=DCOS(DEL)
      SI=0.0
      CO=1.0
C
C     COMPUTE C(J)S FOR J=0 THRU J=N
  114 DO 116 I=1,NT
      K6=NTOT2-2*I+5
      AP2RE=A(K6)*CO+A(K6+1)*SI
      AP2IM=-A(K6)*SI+A(K6+1)*CO
      CIRE=.5*(A(2*I-1)+AP2RE)
      CIIM=.5*(A(2*I)+AP2IM)
      CNIRE=.5*(A(2*I-1)-AP2RE)
      CNIIM=.5*(A(2*I)-AP2IM)
      A(2*I-1)=CIRE
      A(2*I)=CIIM
      A(K6)=CNIRE
      A(K6+1)=-CNIIM
      SIS=SI
      SI=SI*SC+CO*SS
  116 CO=CO*SC-SIS*SS
C
C     SHIFT C(J)S FOR J=N/2+1 TO J=N UP ONE SLOT
      DO 117 I=1,NTOT,2
      K8=NTOT+4+I
      A(K8-2)=A(K8)
  117 A(K8-1)=A(K8+1)
      DO 500 I=3,NTOT2,2
      A(I) = 2. * A(I)
  500 A(I + 1) = -2. * A(I + 1)
      RETURN
      END



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search