00001 c ihfwt3ds_.F
00002 c*********************************************************************
00003 c* (c) Copyright 1994-2002 Brown Deer Technology, LLC.
00004 c* All rights reserved.
00005 c*********************************************************************
00006
00007 subroutine ihfwt3ds(Sizef3d,ns,size,sdata,wdata,iflag)
00008
00009 implicit none
00010
00011 c ****************************************
00012 c ***** COMMON BLOCKS AND PARAMETERS *****
00013 c ****************************************
00014
00015 c *******************************
00016 c ***** VARIABLES EXCHANGED *****
00017 c *******************************
00018
00019 integer Sizef3d
00020 integer ns
00021 integer size
00022 integer sdata(Sizef3d,Sizef3d,Sizef3d)
00023 integer wdata(Sizef3d,Sizef3d,Sizef3d)
00024 integer iflag
00025
00026 c ***************************
00027 c ***** LOCAL VARIABLES *****
00028 c ***************************
00029
00030 integer i,j,k,ii,jj,kk
00031 integer size1,size2
00032 integer u(Sizef3d)
00033 integer v(Sizef3d)
00034
00035 c ******************************
00036 c ***** EXTERNAL FUNCTIONS *****
00037 c ******************************
00038
00039 #ifdef STORM_FWT_FCHECKUSAGE
00040 if (size.lt.ns) then
00041 iflag=1
00042 return
00043 endif
00044 #endif
00045
00046 do i=1,size
00047 do j=1,size
00048 do k=1,size
00049 wdata(i,j,k)=sdata(i,j,k)
00050 enddo
00051 enddo
00052 enddo
00053
00054 if (size.eq.ns) then
00055 iflag=0
00056 return
00057 endif
00058
00059 size1=size
00060
00061 10 continue
00062
00063 size2=size1/2
00064
00065 c ##### index 1 #####
00066 do j=1,size1
00067 do k=1,size1
00068
00069 do i=1,size1
00070 u(i)=wdata(i,j,k)
00071 enddo
00072
00073 do i = 1,size2
00074 ii = 2*i - 1
00075 v(i) = ( u(ii) + u(ii+1) )/2
00076 v(size2+i) = u(ii) - u(ii+1)
00077 enddo
00078
00079 do i=1,size1
00080 wdata(i,j,k)=v(i)
00081 enddo
00082
00083 enddo
00084 enddo
00085
00086 c ##### index 2 #####
00087 do i=1,size1
00088 do k=1,size1
00089
00090 do j=1,size1
00091 u(j)=wdata(i,j,k)
00092 enddo
00093
00094 do j = 1, size2
00095 jj = 2*j - 1
00096 v(j) = ( u(jj) + u(jj+1) )/2
00097 v(size2+j) = u(jj) - u(jj+1)
00098 enddo
00099
00100 do j=1,size1
00101 wdata(i,j,k)=v(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 u(k)=wdata(i,j,k)
00113 enddo
00114
00115 do k = 1, size2
00116 kk = 2*k - 1
00117 v(k) = ( u(kk) + u(kk+1) )/2
00118 v(size2+k) = u(kk) - u(kk+1)
00119 enddo
00120
00121 do k=1,size1
00122 wdata(i,j,k)=v(k)
00123 enddo
00124
00125 enddo
00126 enddo
00127
00128 size1=size2
00129
00130 if (size1.gt.ns) then
00131 goto 10
00132 endif
00133
00134 #ifdef STORM_FWT_FCHECKUSAGE
00135 if (size1.ne.ns) then
00136 iflag=2
00137 return
00138 endif
00139 #endif
00140
00141 iflag=0
00142
00143 return
00144 end
00145
