Scrambler
1
|
00001 !######################################################################### 00002 ! 00003 ! Copyright (C) 2003-2012 Department of Physics and Astronomy, 00004 ! University of Rochester, 00005 ! Rochester, NY 00006 ! 00007 ! problem.f90 of module IsotropicTurbulence 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 00028 00032 00035 MODULE Problem 00036 USE DataDeclarations 00037 USE Ambients 00038 USE PFFT 00039 USE Clumps 00040 USE LayoutDeclarations 00041 USE Spectras 00042 USE Histograms 00043 USE PDFs 00044 USE Totals 00045 USE Projections 00046 USE CoolingSrc 00047 00048 IMPLICIT NONE 00049 SAVE 00050 00051 PUBLIC ProblemModuleInit, ProblemGridInit, & 00052 ProblemBeforeStep, ProblemAfterStep, ProblemSetErrFlag, ProblemBeforeGlobalStep 00053 00054 INTEGER iReal1D, iImag1D, iRhoBack 00055 TYPE(PFFTPlanDef), POINTER :: Plan 00056 REAL(KIND=qPREC) :: beta=-1.5d0, Mach_turb=5d0, kmax=2d0, alpha_const=0d0, alpha, alpha_est, KE_Target, KE_avg, relaxation_time, KE=0d0 00057 TYPE(LayoutDef), POINTER :: layout 00058 REAL(8), DIMENSION(:,:,:,:), POINTER :: data 00059 INTEGER, DIMENSION(:), ALLOCATABLE :: FieldID 00060 TYPE(AmbientDef), POINTER :: Ambient 00061 REAL(KIND=qPREC), DIMENSION(:,:,:,:), POINTER :: forcing, tempforcing 00062 TYPE(TotalDef), POINTER :: Total, PxTotal, PyTotal, PzTotal 00063 REAL(KIND=qPREC) :: density, pressure 00064 REAL(KIND=qPREC) :: t_start_avg, t_final_avg, t_cross, dv(3) 00065 TYPE(ProjectionDef), POINTER :: Projection 00066 LOGICAL :: lCooling 00067 TYPE(CoolingDef),POINTER :: coolingobj 00068 CONTAINS 00069 00071 SUBROUTINE ProblemModuleInit() 00072 REAL(KIND=qPREC) :: A(3),kvec(3),k2, v_turb 00073 COMPLEX(8) :: B(3) 00074 REAL :: rand 00075 INTEGER :: i,j,k,l 00076 TYPE(ClumpDef), POINTER :: Clump 00077 INTEGER, DIMENSION(:,:), ALLOCATABLE :: pos 00078 REAL(KIND=qPREC), DIMENSION(:), ALLOCATABLE :: val 00079 TYPE(SpectraDef), POINTER :: Spectra 00080 LOGICAL :: lUseExisting=.false. 00081 CHARACTER(len=5) :: str 00082 COMPLEX(8) :: data(3) 00083 INTEGER :: nwaves 00084 TYPE(HistogramDef), POINTER :: HISTOGRAM 00085 TYPE(PDFDef), POINTER :: PDF 00086 TYPE(ProjectionDef), POINTER :: Projection 00087 NAMELIST /ProblemData/ density, pressure, kmax, Mach_turb, alpha_const, lUseExisting, lCooling, IICoolPar 00088 00089 IF (lRegrid) RETURN 00090 IF (.NOT. lPostProcess) THEN 00091 CALL CreateTotal(Total) 00092 Total%Field%Component=GASCOMP 00093 Total%Field%iD=KE_Field 00094 00095 CALL CreateTotal(PxTotal) 00096 PxTotal%Field%Component=GASCOMP 00097 PxTotal%Field%iD=Px_Field 00098 00099 CALL CreateTotal(PyTotal) 00100 PyTotal%Field%Component=GASCOMP 00101 PyTotal%Field%iD=Py_Field 00102 00103 IF (nDim == 3) THEN 00104 CALL CreateTotal(PzTotal) 00105 PzTotal%Field%Component=GASCOMP 00106 PzTotal%Field%iD=Pz_Field 00107 END IF 00108 00109 CALL CreateSpectra(Spectra) 00110 ALLOCATE(Spectra%Fields(nDim)) 00111 IF (nDim == 3) THEN 00112 Spectra%Fields(:)%id=(/vx_Field, vy_Field, vz_Field/) 00113 ELSE 00114 Spectra%Fields(:)%id=(/vx_Field, vy_Field/) 00115 END IF 00116 Spectra%type=VECTOR_SPECT 00117 CALL CreateSpectra(Spectra) 00118 ALLOCATE(Spectra%Fields(1)) 00119 Spectra%Fields(:)%id=(/Mass_Field/) 00120 Spectra%type=SCALAR_SPECT 00121 00122 CALL CreateProjection(projection) 00123 Projection%Field%iD=Mass_Field 00124 Projection%Field%component=BOTHCOMP 00125 Projection%dim=3 00126 END IF 00127 00128 00129 CALL CreatePDF(PDF) 00130 PDF%Field(1)%iD=Mass_Field 00131 PDF%Field(1)%name='density' 00132 PDF%Field(1)%component=GASCOMP 00133 PDF%Field(2)%iD=VMag_Field 00134 PDF%Field(2)%name='velocity' 00135 PDF%Field(2)%component=GASCOMP 00136 PDF%minvalue=(/1e-4,1/) 00137 PDF%maxvalue=(/1e6,1e3/) 00138 PDF%nbins=(/400,400/) 00139 PDF%Scale=(/LOGSCALE,LOGSCALE/) 00140 PDF%WeightField=VOLUME 00141 00142 00143 CALL CreateHistogram(Histogram) 00144 Histogram%Field%iD=1 00145 ! Histogram%Field%name='' 00146 Histogram%Field%component=GASCOMP 00147 Histogram%minvalue=1e-4 00148 Histogram%maxvalue=1d6 00149 Histogram%nbins=1000 00150 Histogram%scale=LOGSCALE 00151 00152 00153 IF (iEOS /= EOS_ISOTHERMAL) THEN 00154 CALL CreatePDF(PDF) 00155 PDF%Field(1)%iD=Mass_Field 00156 PDF%Field(1)%name='density' 00157 PDF%Field(1)%component=GASCOMP 00158 PDF%Field(2)%iD=P_Field 00159 PDF%Field(2)%name='pressure' 00160 PDF%Field(2)%component=GASCOMP 00161 PDF%minvalue=(/1e-4,100/) 00162 PDF%maxvalue=(/1e6,1e6/) 00163 PDF%nbins=(/400,400/) 00164 PDF%Scale=(/LOGSCALE,LOGSCALE/) 00165 PDF%WeightField=VOLUME 00166 END IF 00167 00168 CALL AddAllTotals(GASCOMP) 00169 00170 IF (lPostProcess) RETURN 00171 00172 OPEN(UNIT=PROBLEM_DATA_HANDLE, FILE='problem.data', STATUS="OLD") 00173 READ(PROBLEM_DATA_HANDLE,NML=ProblemData) 00174 CLOSE(PROBLEM_DATA_HANDLE) 00175 CALL CreateAmbient(Ambient) 00176 Ambient%density=density 00177 Ambient%pressure=pressure 00178 v_turb=Mach_turb*sqrt(gamma*pressure/density) 00179 KE_target=half*product(GxBounds(1:nDim,2)-GxBounds(1:nDim,1))*density*v_turb**2 00180 ! relaxation_time=(GxBounds(1,2)-GxBounds(1,1))/v_turb 00181 t_cross=(GxBounds(1,2)-GxBounds(1,1))/v_turb 00182 IF (alpha_const /= 0d0) THEN 00183 alpha=alpha_const 00184 ELSE 00185 alpha=v_turb/(2d0*t_cross) 00186 END IF 00187 IF (MPI_ID == 0) write(*,*) 'alpha=', alpha, v_turb, t_cross 00188 ! alpha=alpha_est 00189 ! IF (.NOT. lRestart) THEN 00190 t_start_avg=-1d0 00191 t_final_avg=-1d0 00192 KE_avg=0d0 00193 ALLOCATE(pos(3,3)) 00194 ALLOCATE(val(3)) 00195 pos(1,:)=(/1,2,1/) 00196 pos(2,:)=(/3,1,1/) 00197 pos(3,:)=(/1,8,4/) 00198 val(1:3)=(/1.0,.5,.4/) 00199 CALL CreatePlan(plan, 0, GmGlobal, nDim) 00200 00201 IF (lUseExisting) THEN 00202 plan%data=0d0 00203 OPEN(UNIT=PROBLEM_DATA_HANDLE, FILE='waves.data', STATUS="OLD") 00204 READ(PROBLEM_DATA_HANDLE, *) nWaves 00205 IF (MPI_ID == 0) write(*,*) 'found ', nWaves, ' waves' 00206 DO l=1,nWaves 00207 read(PROBLEM_DATA_HANDLE,'(A5,3I4,20E25.16)') str, i,j,k,data 00208 IF (ALL((/i,j,k/) >= plan%lmB(:,1)) .AND. ALL((/i,j,k/) <= plan%lmB(:,2))) THEN 00209 plan%data(i,j,k,1:nDim)=data(1:nDim) 00210 write(*,'(A5,3I4,20E25.16)') 'Wave ', i,j,k,data 00211 END IF 00212 END DO 00213 ELSE 00214 A=0 00215 DO i=plan%lmB(1,1),plan%lmB(1,2) 00216 DO j=plan%lmB(2,1),plan%lmB(2,2) 00217 DO k=plan%lmB(3,1),plan%lmB(3,2) 00218 kvec=SpectraK((/i,j,k/),plan%mB) 00219 k2=sum(kvec**2) 00220 IF (k2 > 0d0 .AND. k2 <= kmax+1e-6) THEN 00221 ! want to choose random complex components for vk(:) 00222 ! 3 real angles - 3 real amplitudes 00223 ! want ampiltudes to be evenly distributed on a unit sphere 00224 IF (nDim == 2) THEN 00225 CALL random_circle(A(1:2)) 00226 ELSE 00227 CALL random_sphere(A) 00228 END IF 00229 DO l=1,nDim 00230 CALL random_number(rand) 00231 B(l)=A(l)*exp(2d0*pi*rand*cmplx(0,1)) 00232 END DO 00233 B=B-DOT_PRODUCT(Kvec,B)*Kvec/k2 !subtract off dilational component 00234 plan%data(i,j,k,1:nDim)=B(1:nDim)*k2**(beta/2d0) 00235 write(*,'(A5,3I4,20E25.16)') 'Wave ', i,j,k,B*k2**(beta/2d0) 00236 ELSE 00237 plan%data(i,j,k,:)=0d0 00238 END IF 00239 END DO 00240 END DO 00241 END DO 00242 END IF 00243 CALL ExecutePlan(plan, BACKWARD) 00244 ! END IF 00245 00246 IF (lCooling) THEN 00247 IF (.NOT. lRestart) THEN 00248 ! see sources/cooling.f90::CreateCoolingObject for 00249 ! default values of a cooling source term 00250 CALL CreateCoolingObject(coolingobj) 00251 ELSE 00252 coolingobj => firstcoolingobj 00253 END IF 00254 coolingobj%iCooling=IICOOL 00255 coolingobj%floortemp=1d0 00256 coolingobj%mintemp=0.001 00257 END IF 00258 00259 END SUBROUTINE ProblemModuleInit 00260 00261 00262 00265 SUBROUTINE ProblemGridInit(Info) 00266 TYPE(InfoDef) :: Info 00267 INTEGER, DIMENSION(3,2) :: ip 00268 INTEGER :: rmbc 00269 END SUBROUTINE ProblemGridInit 00270 00273 SUBROUTINE ProblemBeforeStep(Info) 00274 TYPE(InfoDef) :: Info 00275 INTEGER :: rmbc, ip(3,2), i,j,k 00276 rmbc=levels(Info%level)%gmbc(levels(Info%level)%step) 00277 ip=1 00278 ip(1:nDim,1)=1-rmbc 00279 ip(1:nDim,2)=Info%mX(1:nDim)+rmbc 00280 IF (ASSOCIATED(forcing)) THEN 00281 ! IF (ALL(Info%mGlobal(:,1)==1)) write(*,*) 'forcing(1,1,1)=', .125d0*(/(sum(forcing(1:2,1:2,1:2,i)),i=1,3)/) 00282 ! IF (ALL(Info%mGlobal(:,1)==1)) write(*,*) 'forcing(1,1,1)=', forcing(1,1,1,:) 00283 IF (alpha > 0d0 .OR. ANY(dv > 0d0)) THEN 00284 IF (iE /= 0d0) THEN 00285 FORALL(i=ip(1,1):ip(1,2), j=ip(2,1):ip(2,2), k=ip(3,1):ip(3,2)) 00286 Info%q(i,j,k,iE)=Info%q(i,j,k,iE)-half*sum(Info%q(i,j,k,imom(1:nDim))**2)/Info%q(i,j,k,1) 00287 END FORALL 00288 END IF 00289 DO i=ip(1,1), ip(1,2) 00290 DO j=ip(2,1), ip(2,2) 00291 DO k=ip(3,1), ip(3,2) 00292 Info%q(i,j,k,imom(1:nDim))=Info%q(i,j,k,imom(1:nDim))+(alpha*forcing(i,j,k,1:nDim)*levels(Info%level)%dt+dv(1:nDim))*Info%q(i,j,k,1) 00293 END DO 00294 END DO 00295 END DO 00296 dv=0d0 00297 IF (iE /= 0d0) THEN 00298 FORALL(i=ip(1,1):ip(1,2), j=ip(2,1):ip(2,2), k=ip(3,1):ip(3,2)) 00299 Info%q(i,j,k,iE)=Info%q(i,j,k,iE)+half*sum(Info%q(i,j,k,imom(1:nDim))**2)/Info%q(i,j,k,1) 00300 END FORALL 00301 END IF 00302 00303 END IF 00304 END IF 00305 ! END IF 00306 ! Info%q(:,:,:,5)=gamma7*Ambient%pressure 00307 END SUBROUTINE ProblemBeforeStep 00308 00311 SUBROUTINE ProblemAfterStep(Info) 00312 TYPE(InfoDef) :: Info 00313 END SUBROUTINE ProblemAfterStep 00314 00317 SUBROUTINE ProblemSetErrFlag(Info) 00318 TYPE(InfoDef) :: Info 00319 INTEGER, DIMENSION(3,2) :: mB, mO 00320 ! IF (lRestart) THEN 00321 ! mB(:,1)=33 00322 ! mB(:,2)=96 00323 ! mO(:,1)=max(mB(:,1), Info%mGlobal(:,1)) 00324 ! mO(:,2)=min(mB(:,2), Info%mGlobal(:,2)) 00325 ! mO=mO-spread(Info%mGlobal(:,1)-1,2,2) 00326 ! IF (ALL(mO(:,2) >= mO(:,1))) THEN 00327 ! Info%ErrFlag(mO(1,1):mO(1,2), mO(2,1):mO(2,2), mO(3,1):mO(3,2))=1 00328 ! END IF 00329 ! END IF 00330 END SUBROUTINE ProblemSetErrFlag 00331 00332 SUBROUTINE ProblemBeforeGlobalStep(n) 00333 TYPE(InfoDef), POINTER :: Info 00334 INTEGER :: n 00335 INTEGER :: ip(3,2), i, rmbc 00336 INTEGER, DIMENSION(:,:), ALLOCATABLE :: FieldID2 00337 REAL(KIND=qPREC) :: dalpha 00338 LOGICAL :: lFirstTime=.true. 00339 IF (lRegrid .OR. lPostProcess) RETURN 00340 IF (n == 0 .AND. levels(n)%tnow == start_time .AND. lFirstTime) THEN 00341 rmbc=levels(n)%gmbc(1) 00342 IF (nDim == 3) THEN 00343 CALL UnloadFieldFromPFFT(plan, reshape((/ivx,ivy,ivz,0,0,0/),(/3,2/)), lHydroPeriodic, rmbc) 00344 ELSE 00345 CALL UnloadFieldFromPFFT(plan, reshape((/ivx,ivy,0,0/),(/2,2/)), lHydroPeriodic, rmbc) 00346 END IF 00347 CALL ProcessTotal(Total) 00348 Info=>Nodes(n)%p%self%info 00349 ip=1 00350 ip(1:nDim,1)=1-rmbc 00351 ip(1:nDim,2)=Info%mX(1:nDim)+rmbc 00352 ALLOCATE(forcing(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2),nDim)) 00353 forcing=Info%q(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2),imom(1:nDim))/sqrt(2d0*Total%CurrentValue/Product(GxBounds(1:nDim,2)-GxBounds(1:nDim,1))/density) 00354 Info%q(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2),imom(1:nDim))=0d0 00355 Info%q(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2),1)=density 00356 IF (iE /= 0d0) Info%q(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2),iE)=gamma7*pressure 00357 lFirstTime=.true. 00358 ELSE IF (n == 0 .AND. lRestart .AND. lFirstTime) THEN 00359 Info=>Nodes(n)%p%self%info 00360 rmbc=levels(n)%gmbc(1) 00361 ip=1 00362 ip(1:nDim,1)=1-rmbc 00363 ip(1:nDim,2)=Info%mX(1:nDim)+rmbc 00364 ALLOCATE(tempforcing(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2),1:imom(nDim))) 00365 tempforcing=Info%q(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2),1:imom(nDim)) 00366 Info%q(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2), 1)=density 00367 IF (nDim == 3) THEN 00368 CALL UnloadFieldFromPFFT(plan, reshape((/ivx,ivy,ivz,0,0,0/),(/3,2/)), lHydroPeriodic, rmbc) 00369 ELSE 00370 CALL UnloadFieldFromPFFT(plan, reshape((/ivx,ivy,0,0/),(/2,2/)), lHydroPeriodic, rmbc) 00371 END IF 00372 CALL ProcessTotal(Total) 00373 ALLOCATE(forcing(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2),nDim)) 00374 forcing=Info%q(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2),imom(1:nDim))/sqrt(2d0*Total%CurrentValue/Product(GxBounds(1:nDim,2)-GxBounds(1:nDim,1))/density) 00375 Info%q(ip(1,1):ip(1,2), ip(2,1):ip(2,2), ip(3,1):ip(3,2),1:imom(nDim))=tempforcing 00376 DEALLOCATE(tempforcing) 00377 lFirstTime=.true. 00378 END IF 00379 IF (n == 0) THEN 00380 CALL ProcessTotal(Total) 00381 IF (MPI_ID == 0) WRITE(*,*) 'ABC, Total kinetic energy = ', KE 00382 CALL ProcessTotal(PxTotal) 00383 CALL ProcessTotal(PyTotal) 00384 IF (nDim == 3) THEN 00385 CALL ProcessTotal(PzTotal) 00386 dv=-(/PxTotal%CurrentValue, PyTotal%CurrentValue, PzTotal%CurrentValue/)/Product(GxBounds(1:nDim,2)-GxBounds(1:nDim,1))/density 00387 ELSE 00388 dv(1:nDim)=-(/PxTotal%CurrentValue, PyTotal%CurrentValue/)/Product(GxBounds(1:nDim,2)-GxBounds(1:nDim,1))/density 00389 END IF 00390 IF (MPI_ID == 0) WRITE(*,*) 'ABC, velocity shift = ', dv(1:nDim) 00391 IF (t_final_avg == -1d0) THEN 00392 IF (Total%CurrentValue < KE) THEN !finally reached maximum velocity 00393 IF (MPI_ID == 0) write(*,*) 'ABC, Kinetic energy peaked at', KE 00394 t_start_avg = levels(n)%tnow 00395 t_final_avg=t_start_avg+half*t_cross 00396 KE_avg=0d0 00397 END IF 00398 END IF 00399 KE = Total%CurrentValue 00400 IF (t_final_avg /= -1d0 .AND. levels(n)%tnow > t_start_avg) THEN 00401 IF (levels(n)%tnow < t_final_avg) THEN 00402 ! CALL ProcessTotal(Total) 00403 KE_avg=KE_avg+KE*levels(n)%dt 00404 ELSE 00405 IF (levels(n)%tnow > t_final_avg) THEN 00406 t_final_avg=levels(n)%tnow 00407 KE_avg=KE_avg/(t_final_avg-t_start_avg) 00408 IF (MPI_ID == 0) WRITE(*,*) 'ABC, time averaged kinetic energy = ', KE_avg 00409 IF (alpha_const /= 0d0) THEN 00410 alpha=alpha*KE_target/KE_avg 00411 IF (MPI_ID == 0) WRITE(*,*) 'ABC, adjusting alpha to ', alpha 00412 END IF 00413 KE_avg=0d0 00414 t_start_avg=t_final_avg+t_cross 00415 t_final_avg=t_start_avg+.5*t_cross 00416 END IF 00417 END IF 00418 END IF 00419 END IF 00420 00421 ! IF (lFirstTime .AND. lRestart .AND. n == 0) THEN 00422 ! CALL CreateLayout(GmGlobal, layout) 00423 ! layout%level = 0 00424 ! mB=layout%mB(MPI_ID,:,:) 00425 ! ALLOCATE(data(mB(1,1):mB(1,2), mB(2,1):mB(2,2),mB(3,1):mB(3,2),4)) 00426 ! ALLOCATE(FieldID(4)) 00427 ! FieldID=(/(i,i=1,4)/) 00428 ! CALL LoadFieldIntoLayout(layout, data, FieldID) 00429 ! ELSEIF (lFirstTime .AND. lRestart .AND. n == 1) THEN 00430 ! layout%level = 1 00431 ! layout%mB(:,:,:)=layout%mB(:,:,:)+64 00432 ! CALL UnloadFieldFromLayout(layout, data, FieldID) 00433 ! CALL DestroyLayout(layout) 00434 ! DEALLOCATE(data) 00435 ! lFirstTime=.false. 00436 ! END IF 00437 00438 END SUBROUTINE ProblemBeforeGlobalStep 00439 00440 END MODULE Problem 00441