spctrm.f

      SUBROUTINE SPCTRM(P,M,K,OVRLAP,W1,W2)
      LOGICAL OVRLAP
      DIMENSION P(M),W1(*),W2(M)
      WINDOW(J)=(1.-ABS(((J-1)-FACM)*FACP))
C     WINDOW(J)=1.
C     WINDOW(J)=(1.-(((J-1)-FACM)*FACP)**2)
      MM=M+M
      M4=MM+MM
      M44=M4+4
      M43=M4+3
      DEN=0.
      FACM=M-0.5
      FACP=1./(M+0.5)
      SUMW=0.
      DO 11 J=1,MM
        SUMW=SUMW+WINDOW(J)**2
11    CONTINUE
      DO 12 J=1,M
        P(J)=0.
12    CONTINUE
      IF(OVRLAP)THEN
        READ (9,*) (W2(J),J=1,M)
      ENDIF
      DO 18 KK=1,K
        DO 15 JOFF=-1,0,1
          IF (OVRLAP) THEN
            DO 13 J=1,M
              W1(JOFF+J+J)=W2(J)
13          CONTINUE
            READ (9,*) (W2(J),J=1,M)
            JOFFN=JOFF+MM
            DO 14 J=1,M
              W1(JOFFN+J+J)=W2(J)
14          CONTINUE
          ELSE
            READ (9,*) (W1(J),J=JOFF+2,M4,2)
          ENDIF
15      CONTINUE
        DO 16 J=1,MM
          J2=J+J
          W=WINDOW(J)
          W1(J2)=W1(J2)*W
          W1(J2-1)=W1(J2-1)*W
16      CONTINUE
        CALL FOUR1(W1,MM,1)
        P(1)=P(1)+W1(1)**2+W1(2)**2
        DO 17 J=2,M
          J2=J+J
          P(J)=P(J)+W1(J2)**2+W1(J2-1)**2
     *        +W1(M44-J2)**2+W1(M43-J2)**2
17      CONTINUE
        DEN=DEN+SUMW
18    CONTINUE
      DEN=M4*DEN
      DO 19 J=1,M
        P(J)=P(J)/DEN
19    CONTINUE
      RETURN
      END