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