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