00001 c dhfwt2dsws_.F
00002 c*********************************************************************
00003 c* (c) Copyright 1994-2002 Brown Deer Technology, LLC.
00004 c* All rights reserved.
00005 c*********************************************************************
00006
00007 subroutine dhfwt2dsws(Sizef2d,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 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 double precision ws(2*Sizef2d)
00029 integer iflag
00030
00031 c ***************************
00032 c ***** LOCAL VARIABLES *****
00033 c ***************************
00034
00035 integer i,j,ii,jj
00036 integer size1,size2
00037
00038 c ******************************
00039 c ***** EXTERNAL FUNCTIONS *****
00040 c ******************************
00041
00042 #ifdef STORM_FWT_FCHECKUSAGE
00043 if (size.lt.ns) then
00044 iflag=1
00045 return
00046 endif
00047 #endif
00048
00049 do i=1,size
00050 do j=1,size
00051 wdata(i,j)=sdata(i,j)
00052 enddo
00053 enddo
00054
00055 if (size.eq.ns) then
00056 iflag=0
00057 return
00058 endif
00059
00060 size1=size
00061
00062 10 continue
00063
00064 size2=size1/2
00065
00066 c ##### index 1 #####
00067 do j=1,size1
00068
00069 do i=1,size1
00070 ws(i)=wdata(i,j)
00071 enddo
00072
00073 do i = 1,size2
00074 ii = 2*i - 1
00075 ws(Sizef2d+i) = ( ws(ii) + ws(ii+1) ) * INVSQRT2
00076 ws(Sizef2d+size2+i) = ( ws(ii) - ws(ii+1) ) * INVSQRT2
00077 enddo
00078
00079 do i=1,size1
00080 wdata(i,j)=ws(Sizef2d+i)
00081 enddo
00082
00083 enddo
00084
00085 c ##### index 2 #####
00086 do i=1,size1
00087
00088 do j=1,size1
00089 ws(j)=wdata(i,j)
00090 enddo
00091
00092 do j = 1, size2
00093 jj = 2*j - 1
00094 ws(Sizef2d+j) = ( ws(jj) + ws(jj+1) ) * INVSQRT2
00095 ws(Sizef2d+size2+j) = ( ws(jj) - ws(jj+1) ) * INVSQRT2
00096 enddo
00097
00098 do j=1,size1
00099 wdata(i,j)=ws(Sizef2d+j)
00100 enddo
00101
00102 enddo
00103
00104 size1=size2
00105
00106 if (size1.gt.ns) then
00107 goto 10
00108 endif
00109
00110 #ifdef STORM_FWT_FCHECKUSAGE
00111 if (size1.ne.ns) then
00112 iflag=2
00113 return
00114 endif
00115 #endif
00116
00117 iflag=0
00118
00119 return
00120 end
00121
