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