Scrambler
1
|
00001 !######################################################################### 00002 ! 00003 ! Copyright (C) 2003-2012 Department of Physics and Astronomy, 00004 ! University of Rochester, 00005 ! Rochester, NY 00006 ! 00007 ! genak.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: genak.f90 00026 ! 00027 ! PURPOSE : determines amplitude and phase in k-space for fldgen.F 00028 ! assigns gaussians to Ak(kx,ky,kz) and Ak(-kx,-ky,kz) 00029 ! requires 0 <= kx, ky <= dots and 0<= kz <= dots/2 00030 ! note A(-k) = Ak(k)* c 00031 ! 00032 ! INPUT : nx,ny,nz: array dimensions 00033 ! kx,ky,kz: wavenumber 00034 ! iseed : random seed 00035 ! pk : amplitude 00036 ! 00037 ! OUTPUT : ak : amplitude array 00038 ! 00039 !====================================================================== 00040 00041 subroutine genak (nx, ny, nz, kx, ky, kz, pk, iseed, pi, x) 00042 00043 implicit none 00044 00045 integer kx, ky, kz, nkx, nky, nkz, 00046 nx, ny, nz, iseed, dots 00047 00048 double precision pk, pi, phi, rnd1, rnd2, r 00049 00050 double precision x(2*nx*ny*nz) 00051 00052 ! double precision nr_randnum 00053 00054 ! external nr_randnum 00055 00056 !---------------------------------------------------------------------- 00057 00058 rnd1 = nr_randnum(iseed) 00059 phi = 2d0*pi*rnd1 ! for the phase 00060 rnd2 = nr_randnum(iseed) ! for the amplitude 00061 00062 r = dsqrt(-2.0*dlog(rnd2))*pk ! amplitude 00063 00064 ! x(kx,ky,kz) = (r*cos(phi),r*sin(phi)) 00065 00066 x(2*(kx*ny*nz + ky*nz + kz)+1) = r*dcos(phi) ! real. part 00067 x(2*(kx*ny*nz + ky*nz + kz)+2) = r*dsin(phi) ! imag. part 00068 ! ! 00069 ! ! now use Ak(-kx,-ky,-kz)=compl.conj. Ak(kx,ky,kz) 00070 ! ! in the array of fourn (Num. Rec. (1989): p.451) 00071 ! ! 00072 if ((kx .ne. 0) .and. (ky .ne. 0) .and. (kz .ne. 0)) then 00073 nkx = nx - kx 00074 nky = ny - ky 00075 nkz = nz - kz 00076 ! x(nkx,nky,nkz) = (r*cos(phi),-r*sin(phi)) 00077 x(2*(nkx*ny*nz + nky*nz + nkz)+1) = r*dcos(phi) ! real. part 00078 x(2*(nkx*ny*nz + nky*nz + nkz)+2) = -r*dsin(phi) ! imag. part 00079 end if 00080 00081 !======================================================================= 00082 00083 return 00084 end subroutine genak