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