Scrambler
1
|
00001 !######################################################################### 00002 ! 00003 ! Copyright (C) 2003-2012 Department of Physics and Astronomy, 00004 ! University of Rochester, 00005 ! Rochester, NY 00006 ! 00007 ! perturbations.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 !######################################################################### 00025 00029 00032 MODULE Perturbation 00033 USE GlobalDeclarations 00034 USE DataDeclarations 00035 USE PhysicsDeclarations 00036 USE CommonFunctions 00037 USE EOS 00038 USE ObjectDeclarations 00039 IMPLICIT NONE 00041 TYPE PerturbationDef 00042 INTEGER :: nWaves=0 00043 INTEGER :: iWaves=0 00044 INTEGER :: Type=0 00045 INTEGER :: geometry=0 00046 REAL(KIND=qPREC), ALLOCATABLE, DIMENSION(:,:) :: WaveVector 00047 REAL(KIND=qPREC), ALLOCATABLE, DIMENSION(:) :: amplitude 00048 REAL(KIND=qPREC), ALLOCATABLE, DIMENSION(:) :: phase 00049 INTEGER :: ObjId 00050 END TYPE PerturbationDef 00051 00052 !new declaration 00053 TYPE pPerturbationDef 00054 TYPE(PerturbationDef), POINTER :: p 00055 END type pPerturbationDef 00056 TYPE(pPerturbationDef) :: pPerturbation 00057 ! 00058 00059 INTEGER, PARAMETER :: COSINESERIES=0, SINESERIES=1, EXPONENTIAL=2 00060 INTEGER, PARAMETER :: CARTESIAN=0, CYLINDRICAL=1, SPHERICAL=2 00061 CONTAINS 00062 00063 SUBROUTINE CreatePerturbation(Perturbation) 00064 TYPE(PerturbationDef), POINTER :: Perturbation 00065 ALLOCATE(Perturbation) 00066 END SUBROUTINE CreatePerturbation 00067 00068 SUBROUTINE UpdatePerturbation(Perturbation) 00069 TYPE(PerturbationDef), POINTER :: Perturbation 00070 !update attributes that needs to be updated, if any 00071 END SUBROUTINE UpdatePerturbation 00072 00073 00074 SUBROUTINE CreatePerturbationSpectra(PerturbationObj, kmin, kmax, beta, amplitude,scale) 00075 TYPE(PerturbationDef), POINTER :: PerturbationObj 00076 INTEGER :: kmin, kmax,i,j,k,k2,ikrange(3),nwaves 00077 REAL(KIND=qPREC) :: beta, amplitude, phase, realpart, imagpart,dk 00078 REAL(KIND=qPREC), OPTIONAL :: scale 00079 IF (PRESENT(scale)) THEN 00080 dk=2d0*Pi/scale 00081 ELSE 00082 dk=2d0*Pi/maxval(GxBounds(:,2)-GxBounds(:,1)) 00083 END IF 00084 PerturbationObj%TYPE=EXPONENTIAL 00085 ikrange=0 00086 ikrange(1:nDim)=kmax 00087 nwaves=0 00088 !Get degeneracy of each radial wavenumber 00089 DO i=-ikrange(1),ikrange(1) 00090 DO j=-ikrange(2),ikrange(2) 00091 DO k=-ikrange(3),ikrange(3) 00092 k2 = i**2+j**2+k**2 00093 IF (k2 <= kmax**2 .AND. k2 >= kmin**2) THEN 00094 nwaves=nwaves+1 00095 END IF 00096 END DO 00097 END DO 00098 END DO 00099 CALL InitPerturbationWaves(PerturbationObj, nwaves) 00100 DO i=-ikrange(1),ikrange(1) 00101 DO j=-ikrange(2),ikrange(2) 00102 DO k=-ikrange(3),ikrange(3) 00103 k2 = i**2+j**2+k**2 00104 IF (k2 <= kmax**2 .AND. k2 >= kmin**2) THEN 00105 realpart=amplitude*cos(getrand()*2d0*Pi)*sqrt(REAL(k2))**beta 00106 imagpart=amplitude*sin(getrand()*2d0*Pi)*sqrt(REAL(k2))**beta 00107 CALL AddPerturbationWave(PerturbationObj, REAL((/i,j,k/))*dk, realpart, imagpart) 00108 END IF 00109 END DO 00110 END DO 00111 END DO 00112 END SUBROUTINE CreatePerturbationSpectra 00113 00114 SUBROUTINE InitPerturbationWaves(PerturbationObj, nWaves) 00115 TYPE(PerturbationDef) :: PerturbationObj 00116 INTEGER :: nWaves 00117 IF (nWaves == 0) RETURN 00118 ALLOCATE(PerturbationObj%WaveVector(nWaves,nDim), PerturbationObj%amplitude(nWaves), PerturbationObj%Phase(nWaves)) 00119 PerturbationObj%iWaves=0 00120 PerturbationObj%nWaves=nWaves 00121 END SUBROUTINE InitPerturbationWaves 00122 00123 SUBROUTINE AddPerturbationWave(PerturbationObj, wavevector, phase, amplitude) 00124 TYPE(PerturbationDef) :: PerturbationObj 00125 REAL(KIND=qPREC), DIMENSION(:) :: wavevector 00126 REAL(KIND=qPREC) :: phase, amplitude 00127 INTEGER :: iwaves 00128 iwaves=PerturbationObj%iwaves+1 00129 PerturbationObj%iwaves=iwaves 00130 PerturbationObj%WaveVector(iwaves,1:nDim)=wavevector(1:nDim) 00131 PerturbationObj%phase(iwaves)=phase 00132 PerturbationObj%amplitude(iwaves)=amplitude 00133 END SUBROUTINE AddPerturbationWave 00134 00135 SUBROUTINE DestroyPerturbation(PerturbationObj) 00136 TYPE(PerturbationDef), POINTER :: PerturbationObj 00137 IF (ALLOCATED(PerturbationObj%WaveVector)) DEALLOCATE(PerturbationObj%WaveVector) 00138 IF (ALLOCATED(PerturbationObj%Amplitude)) DEALLOCATE(PerturbationObj%Amplitude) 00139 IF (ALLOCATED(PerturbationObj%Phase)) DEALLOCATE(PerturbationObj%Phase) 00140 DEALLOCATE(PerturbationObj) 00141 NULLIFY(PerturbationObj) 00142 END SUBROUTINE DestroyPerturbation 00143 00144 FUNCTION PerturbationValue(PerturbationObj, pos) 00145 TYPE(PerturbationDef) :: PerturbationObj 00146 REAL(KIND=qPREC), DIMENSION(3) :: pos, geopos 00147 REAL(KIND=qPREC) :: z 00148 REAL(KIND=qPREC) :: PerturbationValue 00149 INTEGER :: l,i 00150 PerturbationValue=0d0 00151 SELECT CASE (PerturbationObj%geometry) 00152 CASE(CARTESIAN) 00153 geopos=pos 00154 CASE(CYLINDRICAL) 00155 geopos=ConvertCylindrical(pos) 00156 CASE(Spherical) 00157 geopos=ConvertSpherical(pos) 00158 END SELECT 00159 00160 SELECT CASE (PerturbationObj%Type) 00161 CASE(COSINESERIES) 00162 DO i=1,PerturbationObj%nWaves 00163 PerturbationValue=PerturbationValue+PerturbationObj%amplitude(i)*cos(SUM(PerturbationObj%WaveVector(i,:)*geopos(:))+PerturbationObj%Phase(i)) 00164 END DO 00165 CASE(SINESERIES) 00166 DO i=1,PerturbationObj%nWaves 00167 PerturbationValue=PerturbationValue+PerturbationObj%amplitude(i)*cos(SUM(PerturbationObj%WaveVector(i,:)*geopos(:))+PerturbationObj%Phase(i)) 00168 END DO 00169 CASE(EXPONENTIAL) 00170 DO i=1,PerturbationObj%nWaves 00171 PerturbationValue=PerturbationValue+REAL(cmplx(PerturbationObj%amplitude(i), PerturbationObj%Phase(i))*exp(cmplx(0d0,SUM(PerturbationObj%WaveVector(i,:)*geopos(:)))), 8) 00172 END DO 00173 END SELECT 00174 END FUNCTION PerturbationValue 00175 00176 00177 FUNCTION getrand() 00178 REAL(KIND=qPREC) :: getrand 00179 REAL :: temp 00180 CALL Random_number(temp) 00181 getrand=REAL(temp, KIND=qPREC) 00182 END FUNCTION getrand 00183 END MODULE Perturbation 00184