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