00001 c dg1fwt2dsws_.F
00002 c*********************************************************************
00003 c* (c) Copyright 1994-2002 Brown Deer Technology, LLC.
00004 c* All rights reserved.
00005 c*********************************************************************
00006
00007 subroutine dg1fwt2dsws(Sizef2d,ns,size,sdata,wdata,ws,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 double precision ws(0:1,2*Sizef2d)
00031 integer iflag
00032
00033 c ***************************
00034 c ***** LOCAL VARIABLES *****
00035 c ***************************
00036
00037 integer i,j,size1,size2,l
00038
00039 c ******************************
00040 c ***** EXTERNAL FUNCTIONS *****
00041 c ******************************
00042
00043 #ifdef STORM_FWT_FCHECKUSAGE
00044 if (size.lt.ns) then
00045 iflag=1
00046 return
00047 endif
00048 #endif
00049
00050 do i=1,size
00051 do j=1,size
00052 wdata(0,i,j)=sdata(0,i,j)
00053 wdata(1,i,j)=sdata(1,i,j)
00054 enddo
00055 enddo
00056
00057 if (size.eq.ns) then
00058 iflag=0
00059 return
00060 endif
00061
00062 size1=size
00063
00064 10 continue
00065
00066 size2=size1/2
00067
00068 c ##### index 1 #####
00069 do j=1,size1
00070
00071 do i=1,size1
00072 ws(0,i)=wdata(0,i,j)
00073 ws(1,i)=wdata(1,i,j)
00074 enddo
00075
00076 do i = 1,size2
00077 l = 2*i - 1
00078 ws(0,Sizef2d+i)=H00*(ws(0,l)+ws(0,l+1))
00079 ws(1,Sizef2d+i)=H10*(ws(0,l)-ws(0,l+1))
00080 & +H11*(ws(1,l)+ws(1,l+1))
00081 ws(0,Sizef2d+size2+i)=H11*(ws(0,l)-ws(0,l+1))
00082 & -H10*(ws(1,l)+ws(1,l+1))
00083 ws(1,Sizef2d+size2+i)=H00*(ws(1,l)-ws(1,l+1))
00084 enddo
00085
00086 do i=1,size1
00087 wdata(0,i,j)=ws(0,Sizef2d+i)
00088 wdata(1,i,j)=ws(1,Sizef2d+i)
00089 enddo
00090
00091 enddo
00092
00093 c ##### index 2 #####
00094 do i=1,size1
00095
00096 do j=1,size1
00097 ws(0,j)=wdata(0,i,j)
00098 ws(1,j)=wdata(1,i,j)
00099 enddo
00100
00101 do j = 1, size2
00102 l = 2*j - 1
00103 ws(0,Sizef2d+j)=H00*(ws(0,l)+ws(0,l+1))
00104 ws(1,Sizef2d+j)=H10*(ws(0,l)-ws(0,l+1))
00105 & +H11*(ws(1,l)+ws(1,l+1))
00106 ws(0,Sizef2d+size2+j)=H11*(ws(0,l)-ws(0,l+1))
00107 & -H10*(ws(1,l)+ws(1,l+1))
00108 ws(1,Sizef2d+size2+j)=H00*(ws(1,l)-ws(1,l+1))
00109 enddo
00110
00111 do j=1,size1
00112 wdata(0,i,j)=ws(0,Sizef2d+j)
00113 wdata(1,i,j)=ws(1,Sizef2d+j)
00114 enddo
00115
00116 enddo
00117
00118 size1=size2
00119
00120 if (size1.gt.ns) then
00121 goto 10
00122 endif
00123
00124 #ifdef STORM_FWT_FCHECKUSAGE
00125 if (size1.lt.ns) then
00126 iflag=2
00127 return
00128 endif
00129 #endif
00130
00131 iflag=0
00132
00133 return
00134 end
00135
