PROGRAM xfourfs C driver for routine fourfs INTEGER NX,NY,NZ,NDAT PARAMETER (NX=8,NY=32,NZ=4,NDAT=2*NX*NY*NZ) INTEGER idum,i,j,k,l,kbf,nnv,idim(3),iunit(4) REAL diff,ran1,smax,sum,sum1,sum2,tot,data1(NDAT),data2(NDAT) COMPLEX cdata1(NX,NY,NZ),cdata2(NX,NY,NZ),ctdat(NZ,NY,NX) EQUIVALENCE (data1,cdata1,ctdat),(data2,cdata2) kbf=128 nnv=3 idim(1)=NX idim(2)=NY idim(3)=NZ tot=float(NX)*float(NY)*float(NZ) open (unit=10,form='unformatted',status='scratch') open (unit=11,form='unformatted',status='scratch') open (unit=12,form='unformatted',status='scratch') open (unit=13,form='unformatted',status='scratch') do 11 i=1,4 iunit(i)=i+9 11 continue idum=-23 do 14 i=1,idim(3) do 13 j=1,idim(2) do 12 k=1,idim(1) l=k+(j-1)*idim(1)+(i-1)*idim(2)*idim(1) l=2*l-1 data1(l)=2.*ran1(idum)-1. data2(l)=data1(l) l=l+1 data1(l)=2.*ran1(idum)-1. data2(l)=data1(l) 12 continue 13 continue 14 continue do 15 j=1,NDAT/2,kbf write(iunit(1)) (data1(j+i),i=0,kbf-1) write(iunit(2)) (data1(NDAT/2+j+i),i=0,kbf-1) 15 continue write(*,*) '**************** now doing fourfs ********' call fourfs(iunit,idim,nnv,1) do 16 j=1,NDAT/2,kbf read(iunit(3)) (data1(j+i),i=0,kbf-1) read(iunit(4)) (data1(NDAT/2+j+i),i=0,kbf-1) 16 continue write(*,*) '**************** now doing fourn *********' call fourn(data2,idim,nnv,1) sum=0. smax=0. sum2=0. do 19 i=1,NZ do 18 j=1,NY do 17 k=1,NX diff=abs(cdata2(k,j,i)-ctdat(i,j,k)) sum2=sum2+real(ctdat(i,j,k))**2+aimag(ctdat(i,j,k))**2 sum=sum+diff if (diff.gt.smax) smax=diff 17 continue 18 continue 19 continue sum2=sqrt(sum2/tot) sum=sum/tot write(*,'(1x,a,3f12.7)') * '(r.m.s.) value, (max,ave) discrepancy=',sum2,smax,sum do 21 i=1,4 rewind(unit=iunit(i)) 21 continue C now check the inverse transforms idim(1)=NZ idim(2)=NY idim(3)=NX idum=iunit(1) iunit(1)=iunit(3) iunit(3)=idum idum=iunit(2) iunit(2)=iunit(4) iunit(4)=idum write(*,*) '**************** now doing fourfs ********' call fourfs(iunit,idim,nnv,-1) do 22 j=1,NDAT/2,kbf read(iunit(3)) (data1(j+i),i=0,kbf-1) read(iunit(4)) (data1(NDAT/2+j+i),i=0,kbf-1) 22 continue idim(1)=NX idim(2)=NY idim(3)=NZ write(*,*) '**************** now doing fourn *********' call fourn(data2,idim,nnv,-1) sum=0. smax=0. sum1=0. do 25 i=1,NZ do 24 j=1,NY do 23 k=1,NX sum1=sum1+real(cdata2(k,j,i))**2+aimag(cdata2(k,j,i))**2 diff=abs(cdata2(k,j,i)-cdata1(k,j,i)) sum=sum+diff if (diff.gt.smax) smax=diff 23 continue 24 continue 25 continue sum=sum/tot sum1=sqrt(sum1/tot) write(*,'(1x,a,3f12.7)') * '(r.m.s.) value, (max,ave) discrepancy=',sum1,smax,sum write(*,*) 'ratio of r.m.s. values, expected ratio=', * sum1/sum2,sqrt(tot) END