00001 c dhfwt3dsws_.F
00002 c*********************************************************************
00003 c* (c) Copyright 1994-2002 Brown Deer Technology, LLC.
00004 c* All rights reserved.
00005 c*********************************************************************
00006
00007 subroutine dhfwt3dsws(Sizef3d,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 Sizef3d
00024 integer ns
00025 integer size
00026 double precision sdata(Sizef3d,Sizef3d,Sizef3d)
00027 double precision wdata(Sizef3d,Sizef3d,Sizef3d)
00028 double precision ws(2*Sizef3d)
00029 integer iflag
00030
00031 c ***************************
00032 c ***** LOCAL VARIABLES *****
00033 c ***************************
00034
00035 integer i,j,k,ii,jj,kk
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 do k=1,size
00052 wdata(i,j,k)=sdata(i,j,k)
00053 enddo
00054 enddo
00055 enddo
00056
00057 if (size.eq.ns) then
00058 iflag=0
00059 return
00060 endif
00061
00062 size1=size
00063
00064 10 continue
00065
00066 size2=size1/2
00067
00068 c ##### index 1 #####
00069 do j=1,size1
00070 do k=1,size1
00071
00072 do i=1,size1
00073 ws(i)=wdata(i,j,k)
00074 enddo
00075
00076 do i = 1,size2
00077 ii = 2*i - 1
00078 ws(Sizef3d+i) = ( ws(ii) + ws(ii+1) ) * INVSQRT2
00079 ws(Sizef3d+size2+i) = ( ws(ii) - ws(ii+1) ) * INVSQRT2
00080 enddo
00081
00082 do i=1,size1
00083 wdata(i,j,k)=ws(Sizef3d+i)
00084 enddo
00085
00086 enddo
00087 enddo
00088
00089 c ##### index 2 #####
00090 do i=1,size1
00091 do k=1,size1
00092
00093 do j=1,size1
00094 ws(j)=wdata(i,j,k)
00095 enddo
00096
00097 do j = 1, size2
00098 jj = 2*j - 1
00099 ws(Sizef3d+j) = ( ws(jj) + ws(jj+1) ) * INVSQRT2
00100 ws(Sizef3d+size2+j) = ( ws(jj) - ws(jj+1) ) * INVSQRT2
00101 enddo
00102
00103 do j=1,size1
00104 wdata(i,j,k)=ws(Sizef3d+j)
00105 enddo
00106
00107 enddo
00108 enddo
00109
00110 c ##### index 3 #####
00111 do i=1,size1
00112 do j=1,size1
00113
00114 do k=1,size1
00115 ws(k)=wdata(i,j,k)
00116 enddo
00117
00118 do k = 1, size2
00119 kk = 2*k - 1
00120 ws(Sizef3d+k) = ( ws(kk) + ws(kk+1) ) * INVSQRT2
00121 ws(Sizef3d+size2+k) = ( ws(kk) - ws(kk+1) ) * INVSQRT2
00122 enddo
00123
00124 do k=1,size1
00125 wdata(i,j,k)=ws(Sizef3d+k)
00126 enddo
00127
00128 enddo
00129 enddo
00130
00131 size1=size2
00132
00133 if (size1.gt.ns) then
00134 goto 10
00135 endif
00136
00137 #ifdef STORM_FWT_FCHECKUSAGE
00138 if (size1.ne.ns) then
00139 iflag=2
00140 return
00141 endif
00142 #endif
00143
00144 iflag=0
00145
00146 return
00147 end
00148
