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