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 RadiativeInstability05 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 GlobalDeclarations 00037 USE PhysicsDeclarations 00038 USE DataDeclarations 00039 USE CoolingSrc 00040 IMPLICIT NONE 00041 PUBLIC ProblemModuleInit, ProblemGridInit, & 00042 ProblemBeforeStep, ProblemAfterStep, ProblemSetErrFlag, ProblemBeforeGlobalStep 00043 TYPE(CoolingDef),POINTER :: coolingobj 00044 00045 INTEGER :: iCooling 00046 REAL(KIND=qPrec) :: vx, alpha, beta 00047 00048 NAMELIST/problemdata/iCooling,vx,alpha,beta 00049 00050 CONTAINS 00051 00053 SUBROUTINE ProblemModuleInit() 00054 INTEGER :: i,edge 00055 REAL(KIND=qPrec) :: power, cs 00056 00057 OPEN(PROBLEM_DATA_HANDLE,FILE='problem.data',STATUS='old') 00058 READ(PROBLEM_DATA_HANDLE,NML=problemdata) 00059 CLOSE(PROBLEM_DATA_HANDLE) 00060 00061 IF(iCooling>0) THEN 00062 IF (.NOT. lRestart) THEN 00063 CALL CreateCoolingObject(coolingobj) 00064 ELSE 00065 coolingobj => firstcoolingobj 00066 END IF 00067 END IF 00068 00069 coolingobj%iCooling=iCooling 00070 SELECT CASE(iCooling) 00071 CASE(NoCool) 00072 CASE(AnalyticCool) 00073 cs=sqrt(gamma*Boltzmann*TempScale/Xmu/hMass) 00074 power=.5d0*(1d0-2d0*beta) 00075 coolingobj%alpha=alpha*4.76e-20*&! (ergs*cm^3/s/K^.5) 00076 (3d0/16d0*Xmu*hMass/Boltzmann*(cs*vx)**2)**(power) 00077 coolingobj%beta=beta 00078 CASE(DMCool) 00079 CASE(IICool) 00080 CASE DEFAULT 00081 END SELECT 00082 00083 coolingobj%floortemp=1000d0 00084 coolingobj%mintemp=0.01 00085 END SUBROUTINE ProblemModuleInit 00086 00089 SUBROUTINE ProblemGridInit(Info) 00090 TYPE(InfoDef) :: Info 00091 REAL (KIND=qPrec), POINTER, DIMENSION (:,:,:,:) :: q 00092 INTEGER :: i,j,k,rmbc,zrmbc,level,mx, my, mz 00093 REAL(KIND=xprec) :: x,y,z,xl,yl,zl,dx,dy,dz,r 00094 REAL(KIND=qPrec) :: dens 00095 00096 q=>Info%q 00097 q(:,:,:,:) = 0d0 00098 q(:,:,:,1) = 1d0 !dens/rScale 00099 q(:,:,:,2) = vx*sqrt(gamma*Boltzmann*TempScale/Xmu/hMass)/velScale!*q(:,:,:,1) < but q(:,:,:,1)=1 00100 q(:,:,:,iE)= 1d0/(gamma-1d0)+5d-1*q(:,:,:,2)**2!/q(:,:,:,1) < but q(:,:,:,1)=1 00101 END SUBROUTINE ProblemGridInit 00102 00105 SUBROUTINE ProblemBeforeStep(Info) 00106 TYPE(InfoDef) :: Info 00107 INTEGER :: i 00108 END SUBROUTINE ProblemBeforeStep 00109 00112 SUBROUTINE ProblemAfterStep(Info) 00113 TYPE(InfoDef) :: Info 00114 END SUBROUTINE ProblemAfterStep 00115 00118 SUBROUTINE ProblemSetErrFlag(Info) 00119 TYPE(InfoDef) :: Info 00120 INTEGER :: i 00121 i=(GxBounds(1,2)-2*levels(0)%dx-Info%xBounds(1,1))/levels(Info%level)%dx 00122 IF (i <= Info%mX(1)) THEN 00123 Info%ErrFlag(max(i,1):Info%mX(1),:,:)=1 00124 END IF 00125 END SUBROUTINE ProblemSetErrFlag 00126 00127 SUBROUTINE ProblemBeforeGlobalStep(n) 00128 INTEGER :: n 00129 END SUBROUTINE ProblemBeforeGlobalStep 00130 00131 00132 END MODULE Problem 00133