00001 c pd4ifwt3dsws_.F
00002 c*********************************************************************
00003 c* (c) Copyright 1994-2002 Brown Deer Technology, LLC.
00004 c* All rights reserved.
00005 c*********************************************************************
00006
00007 subroutine pd4ifwt3dsws(Sizef3d,ns,ks,size,wdata,sdata,ws,iflag)
00008
00009 implicit none
00010
00011 c ****************************************
00012 c ***** COMMON BLOCKS AND PARAMETERS *****
00013 c ****************************************
00014
00015 #include "stormdef.h"
00016 real H0,H1,H2,H3
00017 parameter( H0 = STORMDEF_MATHCONST_D4H0 )
00018 parameter( H1 = STORMDEF_MATHCONST_D4H1 )
00019 parameter( H2 = STORMDEF_MATHCONST_D4H2 )
00020 parameter( H3 = STORMDEF_MATHCONST_D4H3 )
00021
00022 c *******************************
00023 c ***** VARIABLES EXCHANGED *****
00024 c *******************************
00025
00026 integer Sizef3d
00027 integer ns
00028 integer ks
00029 integer size
00030 real wdata(Sizef3d,Sizef3d,Sizef3d)
00031 real sdata(Sizef3d,Sizef3d,Sizef3d)
00032 real ws(2*Sizef3d)
00033 integer iflag
00034
00035 c ***************************
00036 c ***** LOCAL VARIABLES *****
00037 c ***************************
00038
00039 integer i,j,k
00040 integer i1,j1,k1
00041 integer size1,size2
00042
00043 c ******************************
00044 c ***** EXTERNAL FUNCTIONS *****
00045 c ******************************
00046
00047 #ifdef STORM_FWT_FCHECKUSAGE
00048 if (size.lt.ns) then
00049 iflag=1
00050 return
00051 endif
00052 #endif
00053
00054 do i=1,size
00055 do j=1,size
00056 do k=1,size
00057 sdata(i,j,k)=wdata(i,j,k)
00058 enddo
00059 enddo
00060 enddo
00061
00062 if (size.eq.ns) then
00063 iflag=0
00064 return
00065 endif
00066
00067 size1=ns
00068
00069 10 continue
00070 size2=size1
00071 size1=2*size1
00072
00073 c ##### index 1 #####
00074 do j=1,size1
00075 do k=1,size1
00076
00077 do i=1,size1
00078 ws(i)=sdata(i,j,k)
00079 enddo
00080
00081 do i = 1,size2
00082 i1 = mod(i-1-1+size2,size2)+1
00083 ws(Sizef3d+2*i-1) = H0*ws(i) + H2*ws(i1)
00084 & + H3*ws(size2+i) + H1*ws(size2+i1)
00085 ws(Sizef3d+2*i) = H1*ws(i) + H3*ws(i1)
00086 & - H2*ws(size2+i) - H0*ws(size2+i1)
00087 enddo
00088
00089 do i=1,size1
00090 sdata(i,j,k)=ws(Sizef3d+i)
00091 enddo
00092
00093 enddo
00094 enddo
00095
00096 c ##### index 2 #####
00097 do i=1,size1
00098 do k=1,size1
00099
00100 do j=1,size1
00101 ws(j)=sdata(i,j,k)
00102 enddo
00103
00104 do j = 1,size2
00105 j1 = mod(j-1-1+size2,size2)+1
00106 ws(Sizef3d+2*j-1) = H0*ws(j) + H2*ws(j1)
00107 & + H3*ws(size2+j) + H1*ws(size2+j1)
00108 ws(Sizef3d+2*j) = H1*ws(j) + H3*ws(j1)
00109 & - H2*ws(size2+j) - H0*ws(size2+j1)
00110 enddo
00111
00112 do j=1,size1
00113 sdata(i,j,k)=ws(Sizef3d+j)
00114 enddo
00115
00116 enddo
00117 enddo
00118
00119 c ##### index 3 #####
00120 do i=1,size1
00121 do j=1,size1
00122
00123 do k=1,size1
00124 ws(k)=sdata(i,j,k)
00125 enddo
00126
00127 do k = 1,size2
00128 k1 = mod(k-1-1+size2,size2)+1
00129 ws(Sizef3d+2*k-1) = H0*ws(k) + H2*ws(k1)
00130 & + H3*ws(size2+k) + H1*ws(size2+k1)
00131 ws(Sizef3d+2*k) = H1*ws(k) + H3*ws(k1)
00132 & - H2*ws(size2+k) - H0*ws(size2+k1)
00133 enddo
00134
00135 do k=1,size1
00136 sdata(i,j,k)=ws(Sizef3d+k)
00137 enddo
00138
00139 enddo
00140 enddo
00141
00142
00143 if (size1.lt.size) then
00144 goto 10
00145 endif
00146
00147 #ifdef STORM_FWT_FCHECKUSAGE
00148 if (size1.ne.size) then
00149 iflag=2
00150 return
00151 endif
00152 #endif
00153
00154 iflag=0
00155
00156 return
00157 end
00158
