00001 c hifwt3ds_.F
00002 c*********************************************************************
00003 c* (c) Copyright 1994-2002 Brown Deer Technology, LLC.
00004 c* All rights reserved.
00005 c*********************************************************************
00006
00007 subroutine hifwt3ds(Sizef3d,ns,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 INVSQRT2
00017 parameter( INVSQRT2 = STORMDEF_MATHCONST_INVSQRT2 )
00018
00019 c *******************************
00020 c ***** VARIABLES EXCHANGED *****
00021 c *******************************
00022
00023 integer Sizef3d
00024 integer ns
00025 integer size
00026 real wdata(Sizef3d,Sizef3d,Sizef3d)
00027 real sdata(Sizef3d,Sizef3d,Sizef3d)
00028 integer iflag
00029
00030 c ***************************
00031 c ***** LOCAL VARIABLES *****
00032 c ***************************
00033
00034 integer i,j,k,size1,size2
00035 real u(Sizef3d)
00036 real v(Sizef3d)
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 sdata(i,j,k)=wdata(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=ns
00063
00064 10 continue
00065 size2=size1
00066 size1=2*size1
00067
00068 c ##### index 1 #####
00069 do j=1,size1
00070 do k=1,size1
00071
00072 do i=1,size1
00073 u(i)=sdata(i,j,k)
00074 enddo
00075
00076 do i = 1,size2
00077 v(2*i-1) = ( u(i) + u(size2+i) ) * INVSQRT2
00078 v(2*i) = ( u(i) - u(size2+i) ) * INVSQRT2
00079 enddo
00080
00081 do i=1,size1
00082 sdata(i,j,k)=v(i)
00083 enddo
00084
00085 enddo
00086 enddo
00087
00088 c ##### index 2 #####
00089 do i=1,size1
00090 do k=1,size1
00091
00092 do j=1,size1
00093 u(j)=sdata(i,j,k)
00094 enddo
00095
00096 do j = 1,size2
00097 v(2*j-1) = ( u(j) + u(size2+j) ) * INVSQRT2
00098 v(2*j) = ( u(j) - u(size2+j) ) * INVSQRT2
00099 enddo
00100
00101 do j=1,size1
00102 sdata(i,j,k)=v(j)
00103 enddo
00104
00105 enddo
00106 enddo
00107
00108 c ##### index 3 #####
00109 do i=1,size1
00110 do j=1,size1
00111
00112 do k=1,size1
00113 u(k)=sdata(i,j,k)
00114 enddo
00115
00116 do k = 1,size2
00117 v(2*k-1) = ( u(k) + u(size2+k) ) * INVSQRT2
00118 v(2*k) = ( u(k) - u(size2+k) ) * INVSQRT2
00119 enddo
00120
00121 do k=1,size1
00122 sdata(i,j,k)=v(k)
00123 enddo
00124
00125 enddo
00126 enddo
00127
00128
00129 if (size1.lt.size) then
00130 goto 10
00131 endif
00132
00133 #ifdef STORM_FWT_FCHECKUSAGE
00134 if (size1.ne.size) then
00135 iflag=2
00136 return
00137 endif
00138 #endif
00139
00140 iflag=0
00141
00142 return
00143 end
00144
