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 CurrentSheet 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 !######################################################################### 00023 MODULE Problem 00024 USE DataDeclarations 00025 USE GlobalDeclarations 00026 USE PhysicsDeclarations 00027 USE Refinements 00028 USE Shapes 00029 !! @brief Reads the problem data file and performs a quick sanity check on the parameters. 00030 00031 ! USE IFPORT 00032 IMPLICIT NONE 00033 PRIVATE 00034 00035 PUBLIC ProblemModuleInit, ProblemGridInit, & 00036 ProblemBeforeStep, ProblemAfterStep, ProblemSetErrFlag, ProblemBeforeGlobalStep 00037 00038 LOGICAL :: Equi 00039 REAL(KIND=qPrec) :: rho0,rho1,t0,t1,B0,B1,crad 00040 INTEGER, PARAMETER :: ResTest_FILEHANDLE = 32 00041 CONTAINS 00042 SUBROUTINE ProblemModuleInit 00043 INTEGER :: iErr 00044 TYPE(RefinementDef), POINTER :: Refinement 00045 REAL(KIND=qPREC) :: d(3) = (/0.8,3.2,0.4/) 00046 00047 CALL CreateRefinement(Refinement) 00048 CALL CreateShape(Refinement%Shape) 00049 CALL SetShapeType(Refinement%Shape,5,d) 00050 Refinement%Shape%velocity=(/0d0,0d0,0d0/) 00051 CALL SetShapeBounds(Refinement%Shape) 00052 Refinement%BufferCells=10 00053 Refinement%tolerance=-1d0 00054 00055 END SUBROUTINE ProblemModuleInit 00056 00057 SUBROUTINE ProblemGridInit(Info) 00058 !! @brief Initializes the grid data according to the requirements of the problem. 00059 !! @param Info A grid structure. 00060 TYPE (InfoDef) :: Info 00061 INTEGER :: i,j,k,iErr 00062 INTEGER :: rmbc,zrmbc 00063 INTEGER :: mx, my, mz 00064 REAL(KIND=qPrec) :: dx,Bx,By,Bz,Bp,Bxp,Byp,rho,rho0,rhoc,l,kw,t,a,pos(3) 00065 00066 rmbc = levels(Info%level)%gmbc(1)!CoarsenRatio(Info%level-1) * mbc 00067 00068 IF(nDim==2)THEN 00069 zrmbc=0 00070 ELSE 00071 zrmbc=rmbc 00072 END IF 00073 00074 Info%q=0d0;Info%aux=0d0 00075 mx=Info%mX(1); my=Info%mX(2); mz=Info%mX(3); dx=levels(Info%level)%dx 00076 00077 DO k=1-zrmbc,mz+zrmbc; DO j=1-rmbc,my+rmbc; DO i=1-rmbc, mx+rmbc 00078 pos=Info%xBounds(1:3,1)+(/REAL(i)-half,REAL(j)-half,REAL(k)-half/)*levels(Info%level)%dx 00079 00080 B0=1.0;a=0.5;rho0=1.0;rhoc=0.2 00081 Bx=0.0; By=B0*tanh(pos(1)/a) 00082 rho=rho0*(cosh(pos(1)/a))**(-2)+rhoc 00083 t=0.5; l=25.6; kw=2.0*pi/l; Bp=0.0!1.0*kw 00084 Bxp=Bp*sin(kw*pos(1))*cos(kw*pos(2)); Byp=-Bp*cos(kw*pos(1))*sin(kw*pos(2)) 00085 Bx=Bx+Bxp; By=By+Byp 00086 Info%q(i,j,k,1)=rho 00087 Info%q(i,j,k,iBx)=Bx 00088 Info%q(i,j,k,iBy)=By 00089 Info%q(i,j,k,iE)=rho*t/(gamma-1.)+0.5*(Bx**2+By**2) 00090 00091 00092 END DO; END DO; END DO 00093 IF (MaintainAuxArrays) THEN 00094 DO i=1-rmbc+1,mx+rmbc; DO j=1-rmbc,my+rmbc; DO k=1-zrmbc,mz+zrmbc 00095 Info%aux(i,j,k,1)=.5*(Info%q(i-1,j,k,iBx)+Info%q(i,j,k,iBx)) 00096 END DO; END DO; END DO 00097 DO i=1-rmbc,mx+rmbc; DO j=1-rmbc+1,my+rmbc; DO k=1-zrmbc,mz+zrmbc 00098 Info%aux(i,j,k,2)=.5*(Info%q(i,j-1,k,iBy)+Info%q(i,j,k,iBy)) 00099 END DO; END DO; END DO 00100 DO i=1-rmbc,mx+rmbc; DO j=1-rmbc,my+rmbc; DO k=1-zrmbc+1,mz+zrmbc 00101 Info%aux(i,j,k,3)=.5*(Info%q(i,j,k-1,iBz)+Info%q(i,j,k,iBz)) 00102 END DO; END DO; END DO 00103 END IF 00104 00105 END SUBROUTINE ProblemGridInit 00106 00107 SUBROUTINE ProblemBeforeStep(Info) 00108 !! @brief Performs any tasks required before the advance step. 00109 !! @param Info A grid structure. 00110 TYPE (InfoDef) :: Info 00111 INTEGER :: i,j 00112 INTEGER :: rmbc 00113 INTEGER :: mx,my 00114 INTEGER :: iErr 00115 00116 END SUBROUTINE ProblemBeforeStep 00117 00118 SUBROUTINE ProblemAfterStep(Info) 00119 !! @brief Performs any post-step corrections that are required. 00120 !! @param Info A grid structure. 00121 TYPE (InfoDef) :: Info 00122 END SUBROUTINE ProblemAfterStep 00123 00124 SUBROUTINE ProblemSetErrFlag(Info) 00125 !! @brief Sets error flags according to problem-specific conditions.. 00126 !! @param Info A grid structure. 00127 TYPE (InfoDef) :: Info 00128 END SUBROUTINE ProblemSetErrFlag 00129 00130 SUBROUTINE ProblemBeforeGlobalStep(n) 00131 INTEGER :: n 00132 END SUBROUTINE ProblemBeforeGlobalStep 00133 00134 END MODULE Problem