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