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