00001 c dg1ifwt3ds_.F
00002 c*********************************************************************
00003 c* (c) Copyright 1994-2002 Brown Deer Technology, LLC.
00004 c* All rights reserved.
00005 c*********************************************************************
00006
00007 subroutine dg1ifwt3ds(Sizef3d,ns,size,wdata,sdata,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 wdata(0:1,Sizef3d,Sizef3d,Sizef3d)
00029 double precision sdata(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
00037 double precision u(0:1,Sizef3d)
00038 double precision 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 sdata(0,i,j,k)=wdata(0,i,j,k)
00055 sdata(1,i,j,k)=wdata(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=ns
00066
00067 10 continue
00068 size2=size1
00069 size1=2*size1
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)=sdata(0,i,j,k)
00077 u(1,i)=sdata(1,i,j,k)
00078 enddo
00079
00080 do i = 1,size2
00081 v(0,2*i-1)=H00*u(0,i)+H11*u(0,size2+i)+H10*u(1,i)
00082 v(1,2*i-1)=-H10*u(0,size2+i)+H11*u(1,i)+H00*u(1,size2+i)
00083 v(0,2*i)=H00*u(0,i)-H11*u(0,size2+i)-H10*u(1,i)
00084 v(1,2*i)=-H10*u(0,size2+i)+H11*u(1,i)-H00*u(1,size2+i)
00085 enddo
00086
00087 do i=1,size1
00088 sdata(0,i,j,k)=v(0,i)
00089 sdata(1,i,j,k)=v(1,i)
00090 enddo
00091
00092 enddo
00093 enddo
00094
00095 c ##### index 2 #####
00096 do i=1,size1
00097 do k=1,size1
00098
00099 do j=1,size1
00100 u(0,j)=sdata(0,i,j,k)
00101 u(1,j)=sdata(1,i,j,k)
00102 enddo
00103
00104 do j = 1,size2
00105 v(0,2*j-1)=H00*u(0,j)+H11*u(0,size2+j)+H10*u(1,j)
00106 v(1,2*j-1)=-H10*u(0,size2+j)+H11*u(1,j)+H00*u(1,size2+j)
00107 v(0,2*j)=H00*u(0,j)-H11*u(0,size2+j)-H10*u(1,j)
00108 v(1,2*j)=-H10*u(0,size2+j)+H11*u(1,j)-H00*u(1,size2+j)
00109 enddo
00110
00111 do j=1,size1
00112 sdata(0,i,j,k)=v(0,j)
00113 sdata(1,i,j,k)=v(1,j)
00114 enddo
00115
00116 enddo
00117 enddo
00118
00119 c ##### index 3 #####
00120 do i=1,size1
00121 do j=1,size1
00122
00123 do k=1,size1
00124 u(0,k)=sdata(0,i,j,k)
00125 u(1,k)=sdata(1,i,j,k)
00126 enddo
00127
00128 do k = 1,size2
00129 v(0,2*k-1)=H00*u(0,k)+H11*u(0,size2+k)+H10*u(1,k)
00130 v(1,2*k-1)=-H10*u(0,size2+k)+H11*u(1,k)+H00*u(1,size2+k)
00131 v(0,2*k)=H00*u(0,k)-H11*u(0,size2+k)-H10*u(1,k)
00132 v(1,2*k)=-H10*u(0,size2+k)+H11*u(1,k)-H00*u(1,size2+k)
00133 enddo
00134
00135 do k=1,size1
00136 sdata(0,i,j,k)=v(0,k)
00137 sdata(1,i,j,k)=v(1,k)
00138 enddo
00139
00140 enddo
00141 enddo
00142
00143
00144 if (size1.lt.size) then
00145 goto 10
00146 endif
00147
00148 #ifdef STORM_FWT_FCHECKUSAGE
00149 if (size1.gt.size) then
00150 iflag=2
00151 return
00152 endif
00153 #endif
00154
00155 iflag=0
00156
00157 return
00158 end
00159
