00001 c dpd4fwt2ds_.F
00002 c*********************************************************************
00003 c* (c) Copyright 1994-2002 Brown Deer Technology, LLC.
00004 c* All rights reserved.
00005 c*********************************************************************
00006
00007 subroutine dpd4fwt2ds(Sizef2d,ns,ks,size,sdata,wdata,iflag)
00008
00009 implicit none
00010
00011 c ****************************************
00012 c ***** COMMON BLOCKS AND PARAMETERS *****
00013 c ****************************************
00014
00015 #include "stormdef.h"
00016 double precision H0,H1,H2,H3
00017 parameter( H0 = STORMDEF_MATHCONST_D4H0d0 )
00018 parameter( H1 = STORMDEF_MATHCONST_D4H1d0 )
00019 parameter( H2 = STORMDEF_MATHCONST_D4H2d0 )
00020 parameter( H3 = STORMDEF_MATHCONST_D4H3d0 )
00021
00022 c *******************************
00023 c ***** VARIABLES EXCHANGED *****
00024 c *******************************
00025
00026 integer Sizef2d
00027 integer ns
00028 integer ks
00029 integer size
00030 double precision sdata(Sizef2d,Sizef2d)
00031 double precision wdata(Sizef2d,Sizef2d)
00032 integer iflag
00033
00034 c ***************************
00035 c ***** LOCAL VARIABLES *****
00036 c ***************************
00037
00038 integer i,j,ii,jj
00039 integer ii1,ii2,ii3
00040 integer jj1,jj2,jj3
00041 integer size1,size2
00042 double precision u(Sizef2d)
00043 double precision v(Sizef2d)
00044
00045 c ******************************
00046 c ***** EXTERNAL FUNCTIONS *****
00047 c ******************************
00048
00049 #ifdef STORM_FWT_FCHECKUSAGE
00050 if (size.lt.ns) then
00051 iflag=1
00052 return
00053 endif
00054 #endif
00055
00056 do i=1,size
00057 do j=1,size
00058 wdata(i,j)=sdata(i,j)
00059 enddo
00060 enddo
00061
00062 if (size.eq.ns) then
00063 iflag=0
00064 return
00065 endif
00066
00067 size1=size
00068
00069 10 continue
00070
00071 size2=size1/2
00072
00073 c ##### index 1 #####
00074 do j=1,size1
00075
00076 do i=1,size1
00077 u(i)=wdata(i,j)
00078 enddo
00079
00080 do i = 1,size2
00081 ii = 2*i - 1
00082 ii1 = mod( ii+1-1, size1)+1
00083 ii2 = mod( ii+2-1, size1)+1
00084 ii3 = mod( ii+3-1, size1)+1
00085 v(i) = H0*u(ii) + H1*u(ii1) + H2*u(ii2) + H3*u(ii3)
00086 v(size2+i) = H3*u(ii) - H2*u(ii1) + H1*u(ii2) - H0*u(ii3)
00087 enddo
00088
00089 do i=1,size1
00090 wdata(i,j)=v(i)
00091 enddo
00092
00093 enddo
00094
00095 c ##### index 2 #####
00096 do i=1,size1
00097
00098 do j=1,size1
00099 u(j)=wdata(i,j)
00100 enddo
00101
00102 do j = 1, size2
00103 jj = 2*j - 1
00104 jj1 = mod( jj+1-1, size1)+1
00105 jj2 = mod( jj+2-1, size1)+1
00106 jj3 = mod( jj+3-1, size1)+1
00107 v(j) = H0*u(jj) + H1*u(jj1) + H2*u(jj2) + H3*u(jj3)
00108 v(size2+j) = H3*u(jj) - H2*u(jj1) + H1*u(jj2) - H0*u(jj3)
00109 enddo
00110
00111 do j=1,size1
00112 wdata(i,j)=v(j)
00113 enddo
00114
00115 enddo
00116
00117 size1=size2
00118
00119 if (size1.gt.ns) then
00120 goto 10
00121 endif
00122
00123 #ifdef STORM_FWT_FCHECKUSAGE
00124 if (size1.ne.ns) then
00125 iflag=2
00126 return
00127 endif
00128 #endif
00129
00130 iflag=0
00131
00132 return
00133 end
00134
