Scrambler
1
|
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