Scrambler  1
CurrentSheet/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 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
 All Classes Files Functions Variables