00001 c dpd4ifwt2dsws_.F
00002 c*********************************************************************
00003 c* (c) Copyright 1994-2002 Brown Deer Technology, LLC.
00004 c* All rights reserved.
00005 c*********************************************************************
00006
00007 subroutine dpd4ifwt2dsws(Sizef2d,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 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 wdata(Sizef2d,Sizef2d)
00031 double precision sdata(Sizef2d,Sizef2d)
00032 double precision ws(2*Sizef2d)
00033 integer iflag
00034
00035 c ***************************
00036 c ***** LOCAL VARIABLES *****
00037 c ***************************
00038
00039 integer i,j
00040 integer i1,j1
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 sdata(i,j)=wdata(i,j)
00057 enddo
00058 enddo
00059
00060 if (size.eq.ns) then
00061 iflag=0
00062 return
00063 endif
00064
00065 size1=ns
00066
00067 10 continue
00068 size2=size1
00069 size1=2*size1
00070
00071 c ##### index 1 #####
00072 do j=1,size1
00073
00074 do i=1,size1
00075 ws(i)=sdata(i,j)
00076 enddo
00077
00078 do i = 1,size2
00079 i1 = mod(i-1-1+size2,size2)+1
00080 ws(Sizef2d+2*i-1) = H0*ws(i) + H2*ws(i1)
00081 & + H3*ws(size2+i) + H1*ws(size2+i1)
00082 ws(Sizef2d+2*i) = H1*ws(i) + H3*ws(i1)
00083 & - H2*ws(size2+i) - H0*ws(size2+i1)
00084 enddo
00085
00086 do i=1,size1
00087 sdata(i,j)=ws(Sizef2d+i)
00088 enddo
00089
00090 enddo
00091
00092 c ##### index 2 #####
00093 do i=1,size1
00094
00095 do j=1,size1
00096 ws(j)=sdata(i,j)
00097 enddo
00098
00099 do j = 1,size2
00100 j1 = mod(j-1-1+size2,size2)+1
00101 ws(Sizef2d+2*j-1) = H0*ws(j) + H2*ws(j1)
00102 & + H3*ws(size2+j) + H1*ws(size2+j1)
00103 ws(Sizef2d+2*j) = H1*ws(j) + H3*ws(j1)
00104 & - H2*ws(size2+j) - H0*ws(size2+j1)
00105 enddo
00106
00107 do j=1,size1
00108 sdata(i,j)=ws(Sizef2d+j)
00109 enddo
00110
00111 enddo
00112
00113 if (size1.lt.size) then
00114 goto 10
00115 endif
00116
00117 #ifdef STORM_FWT_FCHECKUSAGE
00118 if (size1.ne.size) then
00119 iflag=2
00120 return
00121 endif
00122 #endif
00123
00124 iflag=0
00125
00126 return
00127 end
00128
