00001 c dg1fwt3dsws_.F
00002 c*********************************************************************
00003 c* (c) Copyright 1994-2002 Brown Deer Technology, LLC.
00004 c* All rights reserved.
00005 c*********************************************************************
00006
00007 subroutine dg1fwt3dsws(Sizef3d,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 Sizef3d
00026 integer ns
00027 integer size
00028 double precision sdata(0:1,Sizef3d,Sizef3d,Sizef3d)
00029 double precision wdata(0:1,Sizef3d,Sizef3d,Sizef3d)
00030 double precision ws(0:1,2*Sizef3d)
00031 integer iflag
00032
00033 c ***************************
00034 c ***** LOCAL VARIABLES *****
00035 c ***************************
00036
00037 integer i,j,k,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 do k=1,size
00053 wdata(0,i,j,k)=sdata(0,i,j,k)
00054 wdata(1,i,j,k)=sdata(1,i,j,k)
00055 enddo
00056 enddo
00057 enddo
00058
00059 if (size.eq.ns) then
00060 iflag=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 do k=1,size1
00073
00074 do i=1,size1
00075 ws(0,i)=wdata(0,i,j,k)
00076 ws(1,i)=wdata(1,i,j,k)
00077 enddo
00078
00079 do i = 1,size2
00080 l = 2*i - 1
00081 ws(0,Sizef3d+i)=H00*(ws(0,l)+ws(0,l+1))
00082 ws(1,Sizef3d+i)=H10*(ws(0,l)-ws(0,l+1))
00083 & +H11*(ws(1,l)+ws(1,l+1))
00084 ws(0,Sizef3d+size2+i)=H11*(ws(0,l)-ws(0,l+1))
00085 & -H10*(ws(1,l)+ws(1,l+1))
00086 ws(1,Sizef3d+size2+i)=H00*(ws(1,l)-ws(1,l+1))
00087 enddo
00088
00089 do i=1,size1
00090 wdata(0,i,j,k)=ws(0,Sizef3d+i)
00091 wdata(1,i,j,k)=ws(1,Sizef3d+i)
00092 enddo
00093
00094 enddo
00095 enddo
00096
00097 c ##### index 2 #####
00098 do i=1,size1
00099 do k=1,size1
00100
00101 do j=1,size1
00102 ws(0,j)=wdata(0,i,j,k)
00103 ws(1,j)=wdata(1,i,j,k)
00104 enddo
00105
00106 do j = 1, size2
00107 l = 2*j - 1
00108 ws(0,Sizef3d+j)=H00*(ws(0,l)+ws(0,l+1))
00109 ws(1,Sizef3d+j)=H10*(ws(0,l)-ws(0,l+1))
00110 & +H11*(ws(1,l)+ws(1,l+1))
00111 ws(0,Sizef3d+size2+j)=H11*(ws(0,l)-ws(0,l+1))
00112 & -H10*(ws(1,l)+ws(1,l+1))
00113 ws(1,Sizef3d+size2+j)=H00*(ws(1,l)-ws(1,l+1))
00114 enddo
00115
00116 do j=1,size1
00117 wdata(0,i,j,k)=ws(0,Sizef3d+j)
00118 wdata(1,i,j,k)=ws(1,Sizef3d+j)
00119 enddo
00120
00121 enddo
00122 enddo
00123
00124 c ##### index 3 #####
00125 do i=1,size1
00126 do j=1,size1
00127
00128 do k=1,size1
00129 ws(0,k)=wdata(0,i,j,k)
00130 ws(1,k)=wdata(1,i,j,k)
00131 enddo
00132
00133 do k = 1, size2
00134 l = 2*k - 1
00135 ws(0,Sizef3d+k)=H00*(ws(0,l)+ws(0,l+1))
00136 ws(1,Sizef3d+k)=H10*(ws(0,l)-ws(0,l+1))
00137 & +H11*(ws(1,l)+ws(1,l+1))
00138 ws(0,Sizef3d+size2+k)=H11*(ws(0,l)-ws(0,l+1))
00139 & -H10*(ws(1,l)+ws(1,l+1))
00140 ws(1,Sizef3d+size2+k)=H00*(ws(1,l)-ws(1,l+1))
00141 enddo
00142
00143 do k=1,size1
00144 wdata(0,i,j,k)=ws(0,Sizef3d+k)
00145 wdata(1,i,j,k)=ws(1,Sizef3d+k)
00146 enddo
00147
00148 enddo
00149 enddo
00150
00151 size1=size2
00152
00153 if (size1.gt.ns) then
00154 goto 10
00155 endif
00156
00157 #ifdef STORM_FWT_FCHECKUSAGE
00158 if (size1.lt.ns) then
00159 iflag=2
00160 return
00161 endif
00162 #endif
00163
00164 iflag=0
00165
00166 return
00167 end
00168
