00001 c dhifwt2ds_.F
00002 c*********************************************************************
00003 c* (c) Copyright 1994-2002 Brown Deer Technology, LLC.
00004 c* All rights reserved.
00005 c*********************************************************************
00006
00007 subroutine dhifwt2ds(Sizef2d,ns,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 double precision INVSQRT2
00017 parameter( INVSQRT2 = STORMDEF_MATHCONST_INVSQRT2d0 )
00018
00019 c *******************************
00020 c ***** VARIABLES EXCHANGED *****
00021 c *******************************
00022
00023 integer iflag
00024 integer Sizef2d
00025 integer ns
00026 integer size
00027 double precision wdata(Sizef2d,Sizef2d)
00028 double precision sdata(Sizef2d,Sizef2d)
00029
00030 c ***************************
00031 c ***** LOCAL VARIABLES *****
00032 c ***************************
00033
00034 integer i,j,size1,size2
00035 double precision u(Sizef2d)
00036 double precision v(Sizef2d)
00037
00038 c ******************************
00039 c ***** EXTERNAL FUNCTIONS *****
00040 c ******************************
00041
00042 if (size.lt.ns) then
00043 #ifdef STORM_DEBUG
00044 write(*,*) 'ERROR: dhifwt2ds_() size < ns.'
00045 #endif
00046 iflag=1
00047 return
00048 endif
00049
00050 do i=1,size
00051 do j=1,size
00052 sdata(i,j)=wdata(i,j)
00053 enddo
00054 enddo
00055
00056 if (size.eq.ns) then
00057 iflag=0
00058 return
00059 endif
00060
00061 size1=ns
00062
00063 10 continue
00064 size2=size1
00065 size1=2*size1
00066
00067 c ##### index 1 #####
00068 do j=1,size1
00069
00070 do i=1,size1
00071 u(i)=sdata(i,j)
00072 enddo
00073
00074 do i = 1,size2
00075 v(2*i-1) = ( u(i) + u(size2+i) ) * INVSQRT2
00076 v(2*i) = ( u(i) - u(size2+i) ) * INVSQRT2
00077 enddo
00078
00079 do i=1,size1
00080 sdata(i,j)=v(i)
00081 enddo
00082
00083 enddo
00084
00085 c ##### index 2 #####
00086 do i=1,size1
00087
00088 do j=1,size1
00089 u(j)=sdata(i,j)
00090 enddo
00091
00092 do j = 1,size2
00093 v(2*j-1) = ( u(j) + u(size2+j) ) * INVSQRT2
00094 v(2*j) = ( u(j) - u(size2+j) ) * INVSQRT2
00095 enddo
00096
00097 do j=1,size1
00098 sdata(i,j)=v(j)
00099 enddo
00100
00101 enddo
00102
00103 if (size1.lt.size) then
00104 goto 10
00105 endif
00106
00107 #ifdef STORM_FWT_FCHECKUSAGE
00108 if (size1.ne.size) then
00109 iflag=2
00110 return
00111 endif
00112 #endif
00113
00114 iflag=0
00115
00116 return
00117 end
00118
