00001 c g1fwtws_.F
00002 c*********************************************************************
00003 c* (c) Copyright 1994-2002 Brown Deer Technology, LLC.
00004 c* All rights reserved.
00005 c*********************************************************************
00006
00007 subroutine g1fwtws(Sizef,ns,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 H00,H10,H11
00017 parameter( H00 = STORMDEF_MATHCONST_GHB1H00 )
00018 parameter( H10 = STORMDEF_MATHCONST_GHB1H10 )
00019 parameter( H11 = STORMDEF_MATHCONST_GHB1H11 )
00020
00021 c *******************************
00022 c ***** VARIABLES EXCHANGED *****
00023 c *******************************
00024
00025 integer Sizef
00026 integer ns
00027 integer size
00028 real sdata(0:1,Sizef)
00029 real wdata(0:1,Sizef)
00030 real ws(0:1,Sizef)
00031 integer iflag
00032
00033 c ***************************
00034 c ***** LOCAL VARIABLES *****
00035 c ***************************
00036
00037 integer i,j,size1,size2
00038
00039 c ******************************
00040 c ***** EXTERNAL FUNCTIONS *****
00041 c ******************************
00042
00043 #ifdef STORM_FWT_FCHECKUSAGE
00044 if (size.lt.ns) then
00045 iflag=1
00046 return
00047 endif
00048 #endif
00049
00050 do i=1,size
00051 wdata(0,i)=sdata(0,i)
00052 wdata(1,i)=sdata(1,i)
00053 enddo
00054
00055 if (size.eq.ns) then
00056 iflag=0
00057 return
00058 endif
00059
00060 size1=size
00061 10 continue
00062 size2=size1/2
00063 do i = 1, size2
00064 j = 2*i - 1
00065 ws(0,i)=H00*(wdata(0,j)+wdata(0,j+1))
00066 ws(1,i)=H10*(wdata(0,j)-wdata(0,j+1))
00067 & +H11*(wdata(1,j)+wdata(1,j+1))
00068 ws(0,size2+i)=H11*(wdata(0,j)-wdata(0,j+1))
00069 & -H10*(wdata(1,j)+wdata(1,j+1))
00070 ws(1,size2+i)=H00*(wdata(1,j)-wdata(1,j+1))
00071 enddo
00072 do i=1,size1
00073 wdata(0,i)=ws(0,i)
00074 wdata(1,i)=ws(1,i)
00075 enddo
00076 size1=size2
00077 if (size1.gt.ns) then
00078 goto 10
00079 endif
00080
00081 #ifdef STORM_FWT_FCHECKUSAGE
00082 if (size1.lt.ns) then
00083 iflag=2
00084 return
00085 endif
00086 #endif
00087
00088 iflag=0
00089
00090 return
00091 end
00092
