Scrambler  1
vectorperturbations.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 !    vectorperturbations.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 Vectorperturbation
00033    USE GlobalDeclarations
00034    USE DataDeclarations
00035    USE PhysicsDeclarations
00036    USE CommonFunctions
00037    USE EOS
00038    USE Perturbation
00039    USE ObjectDeclarations
00040   IMPLICIT NONE
00042    TYPE VectorperturbationDef
00043       INTEGER :: nwaves = 0
00044       INTEGER :: iwaves = 0
00045       INTEGER :: Type = 0
00046       INTEGER :: geometry = 0
00047       TYPE(pPerturbationDef), DIMENSION(3) :: comp
00048       INTEGER :: ObjId
00049    END TYPE VectorperturbationDef
00050 
00051   ! new declaration
00052   TYPE pVectorperturbationDef
00053     TYPE(VectorperturbationDef), POINTER :: ptr
00054   END TYPE pVectorperturbationDef
00055     TYPE(pVectorperturbationDef) :: pVectorperturbation
00056   !
00057 
00058 !   INTEGER, PARAMETER :: COSINESERIES=0, SINESERIES=1, EXPONENTIAL=2
00059 !   INTEGER, PARAMETER :: CARTESIAN=0, CYLINDRICAL=1, SPHERICAL=2
00060 CONTAINS
00061 
00062    SUBROUTINE CreateVectorPerturbation(VectorPerturbationObj)
00063       TYPE(VectorPerturbationDef), POINTER :: VectorPerturbationObj
00064       INTEGER :: j
00065       ALLOCATE(VectorPerturbationObj)      
00066       DO j=1,3
00067          CALL CreatePerturbation(VectorPerturbationObj%comp(j)%p)
00068       END DO
00069    END SUBROUTINE CreateVectorPerturbation
00070 
00071   SUBROUTINE UpdateVectorPerturbation(VectorPerturbation)
00072     TYPE(VectorPerturbationDef), POINTER :: VectorPerturbation
00073     !update attributes that needs to be updated, if any
00074   END SUBROUTINE UpdateVectorPerturbation
00075 
00076 
00077    SUBROUTINE CreateSolenoidalSpectra(VectorPerturbationObj, kmin, kmax, beta, amplitude, scale)
00078       TYPE(VectorPerturbationDef), POINTER :: VectorPerturbationObj
00079       INTEGER :: kmin, kmax,i,j,k,k2,ikrange(3),nwaves
00080       REAL(KIND=qPREC) :: beta, amplitude, phase, realpart, imagpart, dk
00081       REAL(KIND=qPREC) :: A(3), E(3), K_real(3)
00082       INTEGER ::  kx, ky, kz,Kvec(3)
00083       REAL(KIND=qPREC), OPTIONAL :: scale
00084       IF (PRESENT(scale)) THEN
00085          dk=2d0*Pi/scale
00086       ELSE
00087          dk=2d0*Pi/maxval(GxBounds(:,2)-GxBounds(:,1))
00088       END IF
00089 
00090       VectorPerturbationObj%TYPE=EXPONENTIAL
00091       nwaves=0
00092       ikrange=0
00093       ikrange(1:nDim)=kmax
00094       nwaves=0
00095       DO kx = -ikrange(1), ikrange(1)
00096          DO ky = -ikrange(2),ikrange(2)
00097             DO kz = -ikrange(3),ikrange(3)
00098                Kvec=(/kx,ky,kz/)
00099                k2 = DOT_PRODUCT(Kvec(1:nDim),Kvec(1:nDim))
00100                IF (k2 >= kmin**2 .AND. k2 <= kmax**2) THEN
00101                   nwaves=nwaves+1
00102                END IF
00103             END DO
00104          END DO
00105       END DO
00106       CALL InitVectorPerturbationWaves(VectorPerturbationObj, nwaves)
00107 
00108       DO kx = -ikrange(1), ikrange(1)
00109          DO ky = -ikrange(2),ikrange(2)
00110             DO kz = -ikrange(3),ikrange(3)
00111                Kvec=(/kx,ky,kz/)
00112                k2 = DOT_PRODUCT(Kvec(1:nDim),Kvec(1:nDim))
00113                IF (k2 >= kmin**2 .AND. k2 <= kmax**2) THEN
00114                   K_real=REAL(Kvec, 8)
00115                   IF (nDim == 2) THEN
00116                      E=(/0d0,0d0,1d0/)
00117                   ELSE
00118                      CALL random_sphere(E)  !get emf
00119                      E=E-DOT_PRODUCT(K_real,E)*K_real/DOT_PRODUCT(K_real,K_real) !subtract off extra dilational component
00120                   END IF
00121 
00122                   E=E/magnitude(E) !Normalize E
00123                   A=cross_product(K_real, E)*amplitude*magnitude(K_real)**(beta-1d0) !
00124                   phase=2d0*getrand()*ACOS(-1d0)
00125                   CALL AddVectorPerturbationWave(VectorPerturbationObj, REAL((/kx,ky,kz/), KIND=qPREC)*dk, A*cos(phase), A*sin(phase))
00126                END IF
00127             END DO
00128          END DO
00129       END DO
00130    END SUBROUTINE CreateSolenoidalSpectra
00131 
00132    SUBROUTINE InitVectorperturbationWaves(VectorperturbationObj, nWaves)
00133       TYPE(VectorperturbationDef) :: VectorperturbationObj
00134       INTEGER :: nWaves,i
00135       IF (nWaves == 0) RETURN
00136       DO i=1,3
00137          CALL InitPerturbationWaves(VectorPerturbationObj%comp(i)%p, nwaves)
00138          VectorPerturbationObj%comp(i)%p%Type=VectorPerturbationObj%Type
00139          VectorPerturbationObj%comp(i)%p%Geometry=VectorPerturbationObj%geometry         
00140       END DO
00141       VectorperturbationObj%iWaves=0
00142       VectorperturbationObj%nWaves=nWaves
00143    END SUBROUTINE InitVectorperturbationWaves
00144 
00145    SUBROUTINE AddVectorperturbationWave(VectorperturbationObj, wavevector, phase, amplitude)      
00146       TYPE(VectorperturbationDef) :: VectorperturbationObj
00147       REAL(KIND=qPREC), DIMENSION(:) :: wavevector
00148       REAL(KIND=qPREC) :: phase(3), amplitude(3)
00149       INTEGER :: iwaves,i
00150       iwaves=VectorperturbationObj%iwaves+1
00151       VectorPerturbationObj%iwaves=iwaves
00152       DO i=1,3
00153          VectorperturbationObj%comp(i)%p%iwaves=iwaves      
00154          VectorperturbationObj%comp(i)%p%WaveVector(iwaves,:)=wavevector(:)
00155          VectorperturbationObj%comp(i)%p%phase(iwaves)=phase(i)
00156          VectorperturbationObj%comp(i)%p%amplitude(iwaves)=amplitude(i)
00157       END DO
00158    END SUBROUTINE AddVectorperturbationWave
00159       
00160    SUBROUTINE DestroyVectorperturbation(VectorperturbationObj)
00161       TYPE(VectorperturbationDef), POINTER :: VectorperturbationObj
00162       INTEGER :: i
00163       DO i=1,3
00164          CALL DestroyPerturbation(VectorPerturbationObj%comp(i)%p)
00165       END DO
00166       NULLIFY(VectorperturbationObj)
00167    END SUBROUTINE DestroyVectorperturbation
00168 
00169    FUNCTION VectorperturbationValue(VectorperturbationObj, pos)
00170       TYPE(VectorperturbationDef) :: VectorperturbationObj
00171       REAL(KIND=qPREC), DIMENSION(3) :: pos, geopos
00172       REAL(KIND=qPREC) :: z
00173       REAL(KIND=qPREC) :: VectorperturbationValue(3)
00174       INTEGER :: l,i,j
00175       VectorperturbationValue=0d0         
00176       SELECT CASE (VectorperturbationObj%geometry)
00177       CASE(CARTESIAN)
00178          geopos=pos
00179       CASE(CYLINDRICAL)
00180          geopos=ConvertCylindrical(pos)
00181       CASE(Spherical)
00182          geopos=ConvertSpherical(pos)
00183       END SELECT
00184 
00185       SELECT CASE (VectorperturbationObj%Type)
00186       CASE(COSINESERIES)
00187          DO j=1,3
00188             DO i=1,VectorperturbationObj%nWaves
00189                VectorperturbationValue(j)=VectorperturbationValue(j)+VectorperturbationObj%comp(j)%p%Amplitude(i)*cos(SUM(VectorperturbationObj%comp(j)%p%WaveVector(i,:)*geopos(:))+VectorperturbationObj%comp(j)%p%Phase(i))
00190             END DO
00191          END DO
00192       CASE(SINESERIES)
00193          DO j=1,3
00194             DO i=1,VectorperturbationObj%nWaves
00195                VectorperturbationValue(j)=VectorperturbationValue(j)+VectorperturbationObj%comp(j)%p%Amplitude(i)*cos(SUM(VectorperturbationObj%comp(j)%p%WaveVector(i,:)*geopos(:))+VectorperturbationObj%comp(j)%p%Phase(i))
00196             END DO
00197          END DO
00198       CASE(EXPONENTIAL)
00199          DO j=1,3
00200             DO i=1,VectorperturbationObj%nWaves
00201                VectorperturbationValue(j)=VectorperturbationValue(j)+REAL(cmplx(VectorperturbationObj%comp(j)%p%Amplitude(i), VectorperturbationObj%comp(j)%p%Phase(i))*exp(cmplx(0d0,SUM(VectorperturbationObj%comp(j)%p%WaveVector(i,:)*geopos(:)))), 8)
00202             END DO
00203          END DO
00204       END SELECT
00205    END FUNCTION VectorperturbationValue
00206 
00207   function unique(k,mymx)
00208     INTEGER :: k(:),mymx(:),i
00209     logical :: unique
00210     unique=.false.
00211     DO i=1,nDim
00212        IF (k(i) > mymx(i)/2 .OR. k(i) <= -mymx(i)/2) RETURN
00213     END DO
00214     IF (k(1) < 0) RETURN
00215     IF (k(1) == 0 .OR. k(1) == mymx(1)/2) THEN
00216        IF (k(2) < 0) RETURN
00217        IF (nDim > 2 .AND. (k(2) == 0 .OR. k(2) == mymx(2)/2)) THEN
00218           IF (k(3) < 0) RETURN
00219        END IF
00220     END IF
00221     unique=.true.
00222     return
00223   end function unique
00224 
00225   FUNCTION cross_product(A,B)
00226     REAL(8), DIMENSION(3) :: cross_product, A, B
00227     cross_product = (/A(2)*B(3)-A(3)*B(2), A(3)*B(1)-A(1)*B(3),A(1)*B(2)-A(2)*B(1)/)
00228   END FUNCTION cross_product
00229 
00230   FUNCTION magnitude(A)
00231     REAL(8), DIMENSION(:) :: A
00232     REAL(8) :: magnitude
00233     magnitude = sqrt(DOT_PRODUCT(A,A))
00234   END FUNCTION magnitude
00235 
00236 
00237   
00238 END MODULE Vectorperturbation
00239 
 All Classes Files Functions Variables