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