00001 c g1fwt2dsws_.F
00002
00003 c*********************************************************************
00004 c* (c) Copyright 1994-2002 Brown Deer Technology, LLC.
00005 c* All rights reserved.
00006 c*********************************************************************
00007
00008 subroutine g1fwt2dsws(ierr,Sizef2d,ns,size,sdata,wdata,ws)
00009
00010 implicit none
00011
00012 c ****************************************
00013 c ***** COMMON BLOCKS AND PARAMETERS *****
00014 c ****************************************
00015
00016 #include "stormdef.h"
00017 real H00,H10,H11
00018 parameter( H00 = STORMDEF_MATHCONST_GHB1H00 )
00019 parameter( H10 = STORMDEF_MATHCONST_GHB1H10 )
00020 parameter( H11 = STORMDEF_MATHCONST_GHB1H11 )
00021
00022 c *******************************
00023 c ***** VARIABLES EXCHANGED *****
00024 c *******************************
00025
00026 integer ierr
00027 integer Sizef2d
00028 integer ns
00029 integer size
00030 real sdata(0:1,Sizef2d,Sizef2d)
00031 real wdata(0:1,Sizef2d,Sizef2d)
00032 real ws(0:1,2*Sizef2d)
00033
00034 c ***************************
00035 c ***** LOCAL VARIABLES *****
00036 c ***************************
00037
00038 integer i,j,size1,size2,l
00039
00040 c ******************************
00041 c ***** EXTERNAL FUNCTIONS *****
00042 c ******************************
00043
00044 if (size.lt.ns) then
00045 #ifdef STORM_DEBUG
00046 write(*,*) 'ERROR: g1fwt2dsws() size < ns.'
00047 #endif
00048 ierr=1
00049 return
00050 endif
00051
00052 do i=1,size
00053 do j=1,size
00054 wdata(0,i,j)=sdata(0,i,j)
00055 wdata(1,i,j)=sdata(1,i,j)
00056 enddo
00057 enddo
00058
00059 if (size.eq.ns) then
00060 ierr=0
00061 return
00062 endif
00063
00064 size1=size
00065
00066 10 continue
00067
00068 size2=size1/2
00069
00070 c ##### index 1 #####
00071 do j=1,size1
00072
00073 do i=1,size1
00074 ws(0,i)=wdata(0,i,j)
00075 ws(1,i)=wdata(1,i,j)
00076 enddo
00077
00078 do i = 1,size2
00079 l = 2*i - 1
00080 ws(0,Sizef2d+i)=H00*(ws(0,l)+ws(0,l+1))
00081 ws(1,Sizef2d+i)=H10*(ws(0,l)-ws(0,l+1))
00082 & +H11*(ws(1,l)+ws(1,l+1))
00083 ws(0,Sizef2d+size2+i)=H11*(ws(0,l)-ws(0,l+1))
00084 & -H10*(ws(1,l)+ws(1,l+1))
00085 ws(1,Sizef2d+size2+i)=H00*(ws(1,l)-ws(1,l+1))
00086 enddo
00087
00088 do i=1,size1
00089 wdata(0,i,j)=ws(0,Sizef2d+i)
00090 wdata(1,i,j)=ws(1,Sizef2d+i)
00091 enddo
00092
00093 enddo
00094
00095 c ##### index 2 #####
00096 do i=1,size1
00097
00098 do j=1,size1
00099 ws(0,j)=wdata(0,i,j)
00100 ws(1,j)=wdata(1,i,j)
00101 enddo
00102
00103 do j = 1, size2
00104 l = 2*j - 1
00105 ws(0,Sizef2d+j)=H00*(ws(0,l)+ws(0,l+1))
00106 ws(1,Sizef2d+j)=H10*(ws(0,l)-ws(0,l+1))
00107 & +H11*(ws(1,l)+ws(1,l+1))
00108 ws(0,Sizef2d+size2+j)=H11*(ws(0,l)-ws(0,l+1))
00109 & -H10*(ws(1,l)+ws(1,l+1))
00110 ws(1,Sizef2d+size2+j)=H00*(ws(1,l)-ws(1,l+1))
00111 enddo
00112
00113 do j=1,size1
00114 wdata(0,i,j)=ws(0,Sizef2d+j)
00115 wdata(1,i,j)=ws(1,Sizef2d+j)
00116 enddo
00117
00118 enddo
00119
00120 size1=size2
00121
00122 if (size1.gt.ns) then
00123 goto 10
00124 endif
00125
00126 if (size1.lt.ns) then
00127 #ifdef STORM_DEBUG
00128 write(*,*) 'ERROR: g1fwt2dsws() size not power of 2.'
00129 #endif
00130 ierr=2
00131 return
00132 endif
00133
00134 ierr=0
00135
00136 return
00137 end
00138
