00001 c dhifwt3dsws_.F
00002 c*********************************************************************
00003 c* (c) Copyright 1994-2002 Brown Deer Technology, LLC.
00004 c* All rights reserved.
00005 c*********************************************************************
00006
00007 subroutine dhifwt3dsws(Sizef3d,ns,size,wdata,sdata,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 wdata(Sizef3d,Sizef3d,Sizef3d)
00027 double precision sdata(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,size1,size2
00036
00037 c ******************************
00038 c ***** EXTERNAL FUNCTIONS *****
00039 c ******************************
00040
00041 #ifdef STORM_FWT_FCHECKUSAGE
00042 if (size.lt.ns) then
00043 iflag=1
00044 return
00045 endif
00046 #endif
00047
00048 do i=1,size
00049 do j=1,size
00050 do k=1,size
00051 sdata(i,j,k)=wdata(i,j,k)
00052 enddo
00053 enddo
00054 enddo
00055
00056 if (size.eq.ns) then
00057 iflag=0
00058 return
00059 endif
00060
00061 size1=ns
00062
00063 10 continue
00064 size2=size1
00065 size1=2*size1
00066
00067 c ##### index 1 #####
00068 do j=1,size1
00069 do k=1,size1
00070
00071 do i=1,size1
00072 ws(i)=sdata(i,j,k)
00073 enddo
00074
00075 do i = 1,size2
00076 ws(Sizef3d+2*i-1) = ( ws(i) + ws(size2+i) ) * INVSQRT2
00077 ws(Sizef3d+2*i) = ( ws(i) - ws(size2+i) ) * INVSQRT2
00078 enddo
00079
00080 do i=1,size1
00081 sdata(i,j,k)=ws(Sizef3d+i)
00082 enddo
00083
00084 enddo
00085 enddo
00086
00087 c ##### index 2 #####
00088 do i=1,size1
00089 do k=1,size1
00090
00091 do j=1,size1
00092 ws(j)=sdata(i,j,k)
00093 enddo
00094
00095 do j = 1,size2
00096 ws(Sizef3d+2*j-1) = ( ws(j) + ws(size2+j) ) * INVSQRT2
00097 ws(Sizef3d+2*j) = ( ws(j) - ws(size2+j) ) * INVSQRT2
00098 enddo
00099
00100 do j=1,size1
00101 sdata(i,j,k)=ws(Sizef3d+j)
00102 enddo
00103
00104 enddo
00105 enddo
00106
00107 c ##### index 3 #####
00108 do i=1,size1
00109 do j=1,size1
00110
00111 do k=1,size1
00112 ws(k)=sdata(i,j,k)
00113 enddo
00114
00115 do k = 1,size2
00116 ws(Sizef3d+2*k-1) = ( ws(k) + ws(size2+k) ) * INVSQRT2
00117 ws(Sizef3d+2*k) = ( ws(k) - ws(size2+k) ) * INVSQRT2
00118 enddo
00119
00120 do k=1,size1
00121 sdata(i,j,k)=ws(Sizef3d+k)
00122 enddo
00123
00124 enddo
00125 enddo
00126
00127
00128 if (size1.lt.size) then
00129 goto 10
00130 endif
00131
00132 #ifdef STORM_FWT_FCHECKUSAGE
00133 if (size1.ne.size) then
00134 iflag=2
00135 return
00136 endif
00137 #endif
00138
00139 iflag=0
00140
00141 return
00142 end
00143
