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