1 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4 ! Copyright (C) 1995-2004, Scientific Computing Division,
5 ! University Corporation for Atmospheric Research
6 ! Licensed under the GNU General Public License (GPL)
8 ! Authors: Paul N. Swarztrauber and Richard A. Valent
10 ! $Id: mcsqb1.f,v 1.2 2004/06/15 21:29:19 rodney Exp $
12 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
14 SUBROUTINE MCSQB1 (LOT,JUMP,N,INC,X,WSAVE,WORK,IER)
15 DIMENSION X(INC,*) ,WSAVE(*) ,WORK(LOT,*)
22 XIM1 = X(M,I-1)+X(M,I)
23 X(M,I) = .5*(X(M,I-1)-X(M,I))
31 IF (MODN .NE. 0) GO TO 302
36 LENX = (LOT-1)*JUMP + INC*(N-1) + 1
37 LNSV = N + INT(LOG(REAL(N))) + 4
40 CALL RFFTMB(LOT,JUMP,N,INC,X,LENX,WSAVE(N+1),LNSV,WORK,LNWK,IER1)
43 CALL XERFFT ('MCSQB1',-5)
52 WORK(M1,K) = WSAVE(K-1)*X(M,KC)+WSAVE(KC-1)*X(M,K)
53 WORK(M1,KC) = WSAVE(K-1)*X(M,K)-WSAVE(KC-1)*X(M,KC)
56 IF (MODN .NE. 0) GO TO 305
58 X(M,NS2+1) = WSAVE(NS2)*(X(M,NS2+1)+X(M,NS2+1))
65 X(M,K) = WORK(M1,K)+WORK(M1,KC)
66 X(M,KC) = WORK(M1,K)-WORK(M1,KC)
70 X(M,1) = X(M,1)+X(M,1)