00001 c dhfwt2ds_.F
00002 c*********************************************************************
00003 c* (c) Copyright 1994-2002 Brown Deer Technology, LLC.
00004 c* All rights reserved.
00005 c*********************************************************************
00006
00007 subroutine dhfwt2ds(Sizef2d,ns,size,sdata,wdata,iflag)
00008
00009 implicit none
00010
00011 c ****************************************
00012 c ***** COMMON BLOCKS AND PARAMETERS *****
00013 c ****************************************
00014
00015 #include "stormdef.h"
00016 double precision INVSQRT2
00017 parameter( INVSQRT2 = STORMDEF_MATHCONST_INVSQRT2d0 )
00018
00019 c *******************************
00020 c ***** VARIABLES EXCHANGED *****
00021 c *******************************
00022
00023 integer Sizef2d
00024 integer ns
00025 integer size
00026 double precision sdata(Sizef2d,Sizef2d)
00027 double precision wdata(Sizef2d,Sizef2d)
00028 integer iflag
00029
00030 c ***************************
00031 c ***** LOCAL VARIABLES *****
00032 c ***************************
00033
00034 integer i,j,ii,jj
00035 integer size1,size2
00036 double precision u(Sizef2d)
00037 double precision v(Sizef2d)
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 do j=1,size
00052 wdata(i,j)=sdata(i,j)
00053 enddo
00054 enddo
00055
00056 if (size.eq.ns) then
00057 iflag=0
00058 return
00059 endif
00060
00061 size1=size
00062
00063 10 continue
00064
00065 size2=size1/2
00066
00067 c ##### index 1 #####
00068 do j=1,size1
00069
00070 do i=1,size1
00071 u(i)=wdata(i,j)
00072 enddo
00073
00074 do i = 1,size2
00075 ii = 2*i - 1
00076 v(i) = ( u(ii) + u(ii+1) ) * INVSQRT2
00077 v(size2+i) = ( u(ii) - u(ii+1) ) * INVSQRT2
00078 enddo
00079
00080 do i=1,size1
00081 wdata(i,j)=v(i)
00082 enddo
00083
00084 enddo
00085
00086 c ##### index 2 #####
00087 do i=1,size1
00088
00089 do j=1,size1
00090 u(j)=wdata(i,j)
00091 enddo
00092
00093 do j = 1, size2
00094 jj = 2*j - 1
00095 v(j) = ( u(jj) + u(jj+1) ) * INVSQRT2
00096 v(size2+j) = ( u(jj) - u(jj+1) ) * INVSQRT2
00097 enddo
00098
00099 do j=1,size1
00100 wdata(i,j)=v(j)
00101 enddo
00102
00103 enddo
00104
00105 size1=size2
00106
00107 if (size1.gt.ns) then
00108 goto 10
00109 endif
00110
00111 #ifdef STORM_FWT_FCHECKUSAGE
00112 if (size1.ne.ns) then
00113 iflag=2
00114 return
00115 endif
00116 #endif
00117
00118 iflag=0
00119
00120 return
00121 end
00122
