Scrambler  1
perturbations.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 !    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 
 All Classes Files Functions Variables