00001 c pd4fwtws_.F
00002 c*********************************************************************
00003 c* (c) Copyright 1994-2002 Brown Deer Technology, LLC.
00004 c* All rights reserved.
00005 c*********************************************************************
00006
00007 subroutine pd4fwtws(Sizef,ns,ks,size,sdata,wdata,ws,iflag)
00008
00009 implicit none
00010
00011 c ****************************************
00012 c ***** COMMON BLOCKS AND PARAMETERS *****
00013 c ****************************************
00014
00015 #include "stormdef.h"
00016 real H0,H1,H2,H3
00017 parameter( H0 = STORMDEF_MATHCONST_D4H0 )
00018 parameter( H1 = STORMDEF_MATHCONST_D4H1 )
00019 parameter( H2 = STORMDEF_MATHCONST_D4H2 )
00020 parameter( H3 = STORMDEF_MATHCONST_D4H3 )
00021
00022 c *******************************
00023 c ***** VARIABLES EXCHANGED *****
00024 c *******************************
00025
00026 integer Sizef
00027 integer ns
00028 integer ks
00029 integer size
00030 real sdata(Sizef)
00031 real wdata(Sizef)
00032 real ws(Sizef)
00033 integer iflag
00034
00035 c ***************************
00036 c ***** LOCAL VARIABLES *****
00037 c ***************************
00038
00039 integer i,j
00040 integer j1,j2,j3
00041 integer size1,size2
00042
00043 c ******************************
00044 c ***** EXTERNAL FUNCTIONS *****
00045 c ******************************
00046
00047 #ifdef STORM_FWT_FCHECKUSAGE
00048 if (size.lt.ns) then
00049 iflag=1
00050 return
00051 endif
00052 #endif
00053
00054 do i=1,size
00055 wdata(i)=sdata(i)
00056 enddo
00057
00058 if (size.eq.ns) then
00059 iflag=0
00060 return
00061 endif
00062
00063 size1=size
00064 10 continue
00065 size2=size1/2
00066 do i = 1, size2
00067 j = 2*i - 1
00068 j1 = mod( j+1-1,size1)+1
00069 j2 = mod( j+2-1,size1)+1
00070 j3 = mod( j+3-1,size1)+1
00071 ws(i) = H0*wdata(j) + H1*wdata(j1)
00072 & + H2*wdata(j2) + H3*wdata(j3)
00073 ws(size2+i) = H3*wdata(j) - H2*wdata(j1)
00074 & + H1*wdata(j2) - H0*wdata(j3)
00075 enddo
00076 do i=1,size1
00077 wdata(i)=ws(i)
00078 enddo
00079 size1=size2
00080 if (size1.gt.ns) then
00081 goto 10
00082 endif
00083
00084 #ifdef STORM_FWT_FCHECKUSAGE
00085 if (size1.lt.ns) then
00086 iflag=2
00087 return
00088 endif
00089 #endif
00090
00091 iflag=0
00092
00093 return
00094 end
00095
