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