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