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 GaussDiffusion 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 ! USE IFPORT 00030 IMPLICIT NONE 00031 PRIVATE 00032 00033 PUBLIC ProblemModuleInit, ProblemGridInit, & 00034 ProblemBeforeStep, ProblemAfterStep, ProblemSetErrFlag, ProblemBeforeGlobalStep 00035 00036 LOGICAL :: Equi 00037 REAL(KIND=qPrec) :: rho0,rho1,r0,t0,t1,B0x,B0y 00038 INTEGER, PARAMETER :: ResTest_FILEHANDLE = 32 00039 CONTAINS 00040 SUBROUTINE ProblemModuleInit 00041 !! @brief Reads the problem data file and performs a quick sanity check on the parameters. 00042 INTEGER :: iErr 00043 TYPE(RefinementDef), POINTER :: Refinement 00044 REAL(KIND=qPREC) :: d(3) = (/2.56,5.12,0.16/) 00045 00046 !CALL CreateRefinement(Refinement) 00047 !CALL CreateShape(Refinement%Shape) 00048 !CALL SetShapeType(Refinement%Shape,5,d) 00049 !Refinement%Shape%position=(/1.28,0.0,0.0/) 00050 !Refinement%Shape%vel=(/0d0,0d0,0d0/) 00051 !CALL SetShapeBounds(Refinement%Shape) 00052 !Refinement%BufferCells=4 00053 !Refinement%tolerance=-1d0 00054 00055 00056 END SUBROUTINE ProblemModuleInit 00057 00058 SUBROUTINE ProblemGridInit(Info) 00059 !! @brief Initializes the grid data according to the requirements of the problem. 00060 !! @param Info A grid structure. 00061 TYPE (InfoDef) :: Info 00062 INTEGER :: i,j,k,iErr 00063 INTEGER :: rmbc,zrmbc 00064 INTEGER :: mx, my, mz 00065 REAL(KIND=qPrec) :: dx,r,Bx,By,Bz,Bp,Bxp,Byp,rho,l,kw,t,a,pos(3),B0x0,B0y0,B0x1,B0y1 00066 !NAMELIST /ProblemData/ rho0,rho1,r0,t0,t1,B0x,B0y 00067 00068 rmbc = levels(Info%level)%gmbc(1)!CoarsenRatio(Info%level-1) * mbc 00069 00070 IF(nDim==2)THEN 00071 zrmbc=0 00072 ELSE 00073 zrmbc=rmbc 00074 END IF 00075 00076 mx=Info%mX(1); my=Info%mX(2); mz=Info%mX(3); dx=levels(Info%level)%dx 00077 00078 rho0=1.0;rho1=20.0 00079 t0=20.0;t1=1.0 00080 r0=1.28 00081 B0x0=0.7d0;B0y0=0.7d0 00082 !B0x1=0d0;B0y1=0d0 00083 00084 pos=0d0; Info%q=0d0; Info%aux=0d0 00085 DO k=1-zrmbc,mz+zrmbc; DO j=1-rmbc,my+rmbc; DO i=1-rmbc, mx+rmbc 00086 pos=Info%xBounds(1:3,1)+(/REAL(i)-half,REAL(j)-half,REAL(k)-half/)*levels(Info%level)%dx 00087 r=sqrt(pos(1)**2+pos(2)**2) 00088 IF(r.lt.r0)THEN ! inside 00089 !IF(pos(1).gt.0d0)THEN 00090 rho=rho1 00091 t=t1 00092 !Bx=B0x1 00093 !By=0.0!B0y1 00094 !PRINT*, "inside" 00095 ELSE ! outside 00096 rho=rho0 00097 t=t0 00098 !Bx=B0x0 00099 !By=4.0!B0y0 00100 !PRINT*, "outside" 00101 END IF 00102 00103 Info%q(i,j,k,1)=rho 00104 Info%q(i,j,k,iBx)=B0x0 00105 Info%q(i,j,k,iBy)=B0y0 00106 !PRINT*, i,j,Info%aux(i,j,k,2) 00107 Info%q(i,j,k,iE)=rho*t/(gamma-1.)+0.5*By**2 00108 00109 END DO; END DO; END DO 00110 00111 IF (MaintainAuxArrays) THEN 00112 DO i=1-rmbc+1,mx+rmbc; DO j=1-rmbc,my+rmbc; DO k=1-zrmbc,mz+zrmbc 00113 Info%aux(i,j,k,1)=.5*(Info%q(i-1,j,k,iBx)+Info%q(i,j,k,iBx)) 00114 END DO; END DO; END DO 00115 DO i=1-rmbc,mx+rmbc; DO j=1-rmbc,my+rmbc+1; DO k=1-zrmbc,mz+zrmbc 00116 Info%aux(i,j,k,2)=.5*(Info%q(i,j-1,k,iBy)+Info%q(i,j,k,iBy)) 00117 END DO; END DO; END DO 00118 IF(nDim==3)THEN 00119 DO i=1-rmbc,mx+rmbc; DO j=1-rmbc,my+rmbc; DO k=1-zrmbc+1,mz+zrmbc 00120 Info%aux(i,j,k,3)=.5*(Info%q(i,j,k-1,iBz)+Info%q(i,j,k,iBz)) 00121 END DO; END DO; END DO 00122 END IF 00123 END IF 00124 00125 END SUBROUTINE ProblemGridInit 00126 00127 SUBROUTINE ProblemBeforeStep(Info) 00128 !! @brief Performs any tasks required before the advance step. 00129 !! @param Info A grid structure. 00130 TYPE (InfoDef) :: Info 00131 INTEGER :: i,j 00132 INTEGER :: rmbc 00133 INTEGER :: mx,my 00134 INTEGER :: iErr 00135 00136 END SUBROUTINE ProblemBeforeStep 00137 00138 SUBROUTINE ProblemAfterStep(Info) 00139 !! @brief Performs any post-step corrections that are required. 00140 !! @param Info A grid structure. 00141 TYPE (InfoDef) :: Info 00142 END SUBROUTINE ProblemAfterStep 00143 00144 SUBROUTINE ProblemSetErrFlag(Info) 00145 !! @brief Sets error flags according to problem-specific conditions.. 00146 !! @param Info A grid structure. 00147 TYPE (InfoDef) :: Info 00148 END SUBROUTINE ProblemSetErrFlag 00149 00150 SUBROUTINE ProblemBeforeGlobalStep(n) 00151 INTEGER :: n 00152 END SUBROUTINE ProblemBeforeGlobalStep 00153 00154 END MODULE Problem