Scrambler  1
fldgen.f90
Go to the documentation of this file.
00001 !#########################################################################
00002 !               
00003 !    Copyright (C) 2003-2012 Department of Physics and Astronomy,
00004 !                            University of Rochester,
00005 !                            Rochester, NY
00006 !
00007 !    fldgen.f90 is part of AstroBEAR.
00008 !
00009 !    AstroBEAR is free software: you can redistribute it and/or modify    
00010 !    it under the terms of the GNU General Public License as published by 
00011 !    the Free Software Foundation, either version 3 of the License, or    
00012 !    (at your option) any later version.
00013 !
00014 !    AstroBEAR is distributed in the hope that it will be useful, 
00015 !    but WITHOUT ANY WARRANTY; without even the implied warranty of
00016 !    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00017 !    GNU General Public License for more details.
00018 !
00019 !    You should have received a copy of the GNU General Public License
00020 !    along with AstroBEAR.  If not, see <http://www.gnu.org/licenses/>.
00021 !
00022 !#########################################################################
00023 !=======================================================================
00024 !
00025 ! SUBROUTINE: fldgen.f90
00026 !
00027 ! PURPOSE   : generates random field of perturbations, currently
00028 !             with Gaussian distribution. 
00029 !             Generates a cube of (dots)^3 pixels with plane waves in
00030 !             x-, y- and z-direction with power spectrum P(k) ~ k^-en.
00031 !             The amplitudes are Gaussian distributed with variance
00032 !             P(k) and the phases are evenly distributed in [0,2*pi].
00033 !
00034 ! INPUT     : nx,ny,nz: array dimensions
00035 !             power   : exponent for powerlaw
00036 !             kmin    : minimum wavenumber with power 
00037 !             kmax    : maximum wavenumber with power
00038 !             iseed   : for random number generator
00039 !
00040 ! OUTPUT    : matrix  : 3D-array with perturbations
00041 !
00042 !=======================================================================
00043 !
00044 
00045 SUBROUTINE fldgen(nx     , nxtot  , ixbeg  , ixend  ,  &
00046                   ny     , nytot  , iybeg  , iyend  ,  &
00047                   nz     , nztot  , izbeg  , izend  ,  &
00048                   power  , kmin   , kmax   , iseed,    &
00049                   velo) 
00050 
00051 
00052   IMPLICIT NONE
00053 
00054   integer    nx     , ny     , nz    , kx    , ky    , kz   ,     
00055              l      , i      , j, k, iseed , dots  ,                
00056              kmin  , kmax    ,nwork , ntable,        
00057              nxtot , nytot, nztot, ixbeg, iybeg, izbeg,       
00058              ixend, iyend, izend , ndim, isign
00059 
00060    double precision     pk     , abs_k  , akmax , akmin , akdel , aksum, 
00061                         xk     , yk     , zk    , lo    , hi    , off  ,
00062                         p1     , p2     , p3    , kf1   , kf2   , kf3  ,tmp_k, 
00063                         minmat , maxmat , kx2   , ky2   , kz2   , pi   , power
00064 
00065    integer    dimlen(3)
00066 
00067    double precision velo(1:nxtot,1:nytot,1:nztot)
00068    double precision, allocatable :: cvel(:)
00069 
00070 !      complex    x     (0:nx-1,0:ny-1,0:nz-1)! input/output matrix 
00071 !      real       table (1:ntable)
00072 !      real       work  (1:nwork)             ! matrix of fourier - components
00073 
00074 !   external   nr_fourn, genak
00075 
00076 !**************************************************************
00077 !
00078 !
00079 !**************************************************************
00080 
00081 
00082   dots      = nx*ny*nz
00083   dimlen(1) = nx
00084   dimlen(2) = ny
00085   dimlen(3) = nz
00086   kf1       = 1
00087   kf2       = 1
00088   kf3       = 1
00089 
00090   isign     = -1
00091  
00092   pi        = 4d0*atan(1d0)
00093 
00094   if (nz .eq. 1) then 
00095     ndim = 2 
00096   else 
00097     ndim = 3
00098   endif
00099 
00100   allocate(cvel(2*dots))
00101     
00102 !
00103 !       since the frequencies are real there is the symmetry
00104 !       h(x) --> H(K) with H(-K)=H(K)* !
00105 
00106   do kz = 0, nz/2
00107     zk  = real(kz)
00108     kz2 = (zk/kf3)**2
00109 
00110     do ky = 0, ny-1 
00111 
00112       yk = real(ky)
00113       if (ky .gt. ny/2) yk = real(ny) - yk
00114       ky2 = (yk/kf2)**2
00115 
00116       do kx = 0, nx-1 
00117 
00118         xk = real(kx)
00119         if (kx .gt. nx/2) xk = real(nx) - xk
00120         kx2 = (xk/kf1)**2
00121 !       Upper half 
00122 !       The domain is not cubic any more. Thus the wave numbers
00123 !       can be different for each direction. The factors kf1,
00124 !       kf2 and kf3 have to be determined by the calling routine.
00125         tmp_k = sqrt(kx2 + ky2 + kz2)
00126         if ((tmp_k .lt. kmin)  .or. (tmp_k .gt. kmax)) then
00127           pk = 0.0
00128         else
00129           pk = tmp_k**power 
00130         endif
00131 !       correlation <Ak,Ak'> = Pk * delta(k,k')
00132         call genak (nx, ny, nz, kx, ky, kz, pk, iseed, pi, cvel)
00133 !       generates Ak(kx,ky,kx) and Ak(-kx,-ky,-kz),
00134 !       which is just Ak*; it means it computes
00135 !       the upper half as well as the lower one      
00136       end do
00137     end do
00138   end do
00139 
00140 !     Some Ak's need special treatment:
00141 
00142 !  x(0   ,0   ,0   ) = (real(x(0   ,0   ,0   )),0.0)
00143 !  x(0   ,0   ,nz/2) = (real(x(0   ,0   ,nz/2)),0.0)
00144 !  x(0   ,ny/2,0   ) = (real(x(0   ,ny/2,0   )),0.0)
00145 !  x(0   ,ny/2,nz/2) = (real(x(0   ,ny/2,nz/2)),0.0)
00146 !  x(nx/2,0   ,0   ) = (real(x(nx/2,0   ,0   )),0.0)
00147 !  x(nx/2,0   ,nz/2) = (real(x(nx/2,0   ,nz/2)),0.0)
00148 !  x(nx/2,ny/2,0   ) = (real(x(nx/2,ny/2,0   )),0.0)
00149 !  x(nx/2,ny/2,nz/2) = (real(x(nx/2,ny/2,nz/2)),0.0)
00150 
00151   cvel(2*(   0*ny*nz +    0*nz +    0)+2) = 0.0            
00152   cvel(2*(   0*ny*nz +    0*nz + nz/2)+2) = 0.0            
00153   cvel(2*(   0*ny*nz + ny/2*nz +    0)+2) = 0.0      
00154   cvel(2*(   0*ny*nz + ny/2*nz + nz/2)+2) = 0.0
00155   cvel(2*(nx/2*ny*nz +    0*nz +    0)+2) = 0.0            
00156   cvel(2*(nx/2*ny*nz +    0*nz + nz/2)+2) = 0.0            
00157   cvel(2*(nx/2*ny*nz + ny/2*nz +    0)+2) = 0.0      
00158   cvel(2*(nx/2*ny*nz + ny/2*nz + nz/2)+2) = 0.0
00159 
00160   call nr_fourn (dimlen,ndim,isign,cvel)
00161 
00162   do k=1,nz
00163     do j=1,ny
00164       do i=1,nx
00165         velo(ixbeg+i-1,iybeg+j-1,izbeg+k-1) = cvel(2*((i-1)*ny*nz+(j-1)*nz+(k-1))+1)/dble(dots)
00166       end do
00167     end do
00168   end do
00169 
00170   deallocate(cvel)
00171 
00172 !=======================================================================
00173 !  CONTAINS
00174 !    INCLUDE 'genak.f90'
00175 !    INCLUDE 'nr_fourn.f90'
00176 
00177 
00178   return
00179 END SUBROUTINE fldgen
00180 
 All Classes Files Functions Variables