00001 c dg1fwt2ds_.F
00002 c*********************************************************************
00003 c* (c) Copyright 1994-2002 Brown Deer Technology, LLC.
00004 c* All rights reserved.
00005 c*********************************************************************
00006
00007 subroutine dg1fwt2ds(Sizef2d,ns,size,sdata,wdata,iflag)
00008
00009 implicit none
00010
00011 c ****************************************
00012 c ***** COMMON BLOCKS AND PARAMETERS *****
00013 c ****************************************
00014
00015 #include "stormdef.h"
00016 double precision H00,H10,H11
00017 parameter( H00 = STORMDEF_MATHCONST_GHB1H00d0 )
00018 parameter( H10 = STORMDEF_MATHCONST_GHB1H10d0 )
00019 parameter( H11 = STORMDEF_MATHCONST_GHB1H11d0 )
00020
00021 c *******************************
00022 c ***** VARIABLES EXCHANGED *****
00023 c *******************************
00024
00025 integer Sizef2d
00026 integer ns
00027 integer size
00028 double precision sdata(0:1,Sizef2d,Sizef2d)
00029 double precision wdata(0:1,Sizef2d,Sizef2d)
00030 integer iflag
00031
00032 c ***************************
00033 c ***** LOCAL VARIABLES *****
00034 c ***************************
00035
00036 integer i,j,size1,size2,l
00037 double precision u(0:1,Sizef2d)
00038 double precision 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 wdata(0,i,j)=sdata(0,i,j)
00054 wdata(1,i,j)=sdata(1,i,j)
00055 enddo
00056 enddo
00057
00058 if (size.eq.ns) then
00059 iflag=0
00060 return
00061 endif
00062
00063 size1=size
00064
00065 10 continue
00066
00067 size2=size1/2
00068
00069 c ##### index 1 #####
00070 do j=1,size1
00071
00072 do i=1,size1
00073 u(0,i)=wdata(0,i,j)
00074 u(1,i)=wdata(1,i,j)
00075 enddo
00076
00077 do i = 1,size2
00078 l = 2*i - 1
00079 v(0,i)=H00*(u(0,l)+u(0,l+1))
00080 v(1,i)=H10*(u(0,l)-u(0,l+1))+H11*(u(1,l)+u(1,l+1))
00081 v(0,size2+i)=H11*(u(0,l)-u(0,l+1))-H10*(u(1,l)+u(1,l+1))
00082 v(1,size2+i)=H00*(u(1,l)-u(1,l+1))
00083 enddo
00084
00085 do i=1,size1
00086 wdata(0,i,j)=v(0,i)
00087 wdata(1,i,j)=v(1,i)
00088 enddo
00089
00090 enddo
00091
00092 c ##### index 2 #####
00093 do i=1,size1
00094
00095 do j=1,size1
00096 u(0,j)=wdata(0,i,j)
00097 u(1,j)=wdata(1,i,j)
00098 enddo
00099
00100 do j = 1, size2
00101 l = 2*j - 1
00102 v(0,j)=H00*(u(0,l)+u(0,l+1))
00103 v(1,j)=H10*(u(0,l)-u(0,l+1))+H11*(u(1,l)+u(1,l+1))
00104 v(0,size2+j)=H11*(u(0,l)-u(0,l+1))-H10*(u(1,l)+u(1,l+1))
00105 v(1,size2+j)=H00*(u(1,l)-u(1,l+1))
00106 enddo
00107
00108 do j=1,size1
00109 wdata(0,i,j)=v(0,j)
00110 wdata(1,i,j)=v(1,j)
00111 enddo
00112
00113 enddo
00114
00115 size1=size2
00116
00117 if (size1.gt.ns) then
00118 goto 10
00119 endif
00120
00121 #ifdef STORM_FWT_FCHECKUSAGE
00122 if (size1.lt.ns) then
00123 iflag=2
00124 return
00125 endif
00126 #endif
00127
00128 iflag=0
00129
00130 return
00131 end
00132
