00001 c ihifwt2ds_.F
00002 c*********************************************************************
00003 c* (c) Copyright 1994-2002 Brown Deer Technology, LLC.
00004 c* All rights reserved.
00005 c*********************************************************************
00006
00007 subroutine ihifwt2ds(Sizef2d,ns,size,wdata,sdata,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 wdata(Sizef2d,Sizef2d)
00023 integer sdata(Sizef2d,Sizef2d)
00024 integer iflag
00025
00026 c ***************************
00027 c ***** LOCAL VARIABLES *****
00028 c ***************************
00029
00030 integer i,j
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 sdata(i,j)=wdata(i,j)
00049 enddo
00050 enddo
00051
00052 if (size.eq.ns) then
00053 iflag=0
00054 return
00055 endif
00056
00057 size1=ns
00058
00059 10 continue
00060 size2=size1
00061 size1=2*size1
00062
00063 c ##### index 1 #####
00064 do j=1,size1
00065
00066 do i=1,size1
00067 u(i)=sdata(i,j)
00068 enddo
00069
00070 do i = 1,size2
00071 v(2*i-1) = u(i) + (u(size2+i)+1)/2
00072 v(2*i) = u(i) - u(size2+i)/2
00073 enddo
00074
00075 do i=1,size1
00076 sdata(i,j)=v(i)
00077 enddo
00078
00079 enddo
00080
00081 c ##### index 2 #####
00082 do i=1,size1
00083
00084 do j=1,size1
00085 u(j)=sdata(i,j)
00086 enddo
00087
00088 do j = 1,size2
00089 v(2*j-1) = u(j) + (u(size2+j)+1)/2
00090 v(2*j) = u(j) - u(size2+j)/2
00091 enddo
00092
00093 do j=1,size1
00094 sdata(i,j)=v(j)
00095 enddo
00096
00097 enddo
00098
00099 if (size1.lt.size) then
00100 goto 10
00101 endif
00102
00103 #ifdef STORM_FWT_FCHECKUSAGE
00104 if (size1.ne.size) then
00105 iflag=2
00106 return
00107 endif
00108 #endif
00109
00110 iflag=0
00111
00112 return
00113 end
00114
