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