00001 c pd4ifwt_.F
00002 c*********************************************************************
00003 c* (c) Copyright 1994-2002 Brown Deer Technology, LLC.
00004 c* All rights reserved.
00005 c*********************************************************************
00006
00007 subroutine pd4ifwt(Sizef,ns,ks,size,wdata,sdata,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 wdata(Sizef)
00031 real sdata(Sizef)
00032 integer iflag
00033
00034 c ***************************
00035 c ***** LOCAL VARIABLES *****
00036 c ***************************
00037
00038 integer i
00039 integer i1
00040 integer size1,size2
00041 real xx(Sizef)
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 if (size.eq.ns) then
00055 do i=1,size
00056 sdata(i)=wdata(i)
00057 enddo
00058 iflag=0
00059 return
00060 endif
00061
00062 do i=1,size
00063 xx(i)=wdata(i)
00064 enddo
00065
00066 if (size.eq.ns) then
00067 iflag=0
00068 return
00069 endif
00070
00071 size1=ns
00072
00073 10 continue
00074 size2=size1
00075 size1=2*size1
00076 do i = 1,size2
00077 i1 = mod(i-1-1+size2,size2)+1
00078 sdata(2*i-1) = H0*xx(i) + H2*xx(i1)
00079 & + H3*xx(size2+i) + H1*xx(size2+i1)
00080 sdata(2*i) = H1*xx(i) + H3*xx(i1)
00081 & - H2*xx(size2+i) - H0*xx(size2+i1)
00082 enddo
00083
00084 if (size1.lt.size) then
00085 do i=1,size1
00086 xx(i)=sdata(i)
00087 enddo
00088 goto 10
00089 endif
00090
00091 #ifdef STORM_FWT_FCHECKUSAGE
00092 if (size1.ne.size) then
00093 iflag=2
00094 return
00095 endif
00096 #endif
00097
00098 iflag=0
00099
00100 return
00101 end
00102
