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 2DWaves 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 SplitRegions 00038 USE Shapes 00039 USE EOS 00040 USE RiemannSolvers 00041 USE Ambients 00042 IMPLICIT NONE 00043 SAVE 00044 00045 PUBLIC ProblemModuleInit, ProblemGridInit, & 00046 ProblemBeforeStep, ProblemAfterStep, ProblemSetErrFlag, ProblemBeforeGlobalStep 00047 REAL(KIND=qPREC) :: amplitude, wave_number,qout(10) 00048 CONTAINS 00049 00051 SUBROUTINE ProblemModuleInit() 00052 TYPE(AmbientDef), POINTER :: Ambient 00053 REAL(KIND=qPREC) :: rhoOut, pOut, vxOut, vyOut, vzOut, BxOut, ByOut, BzOut 00054 NAMELIST /AmbientData/ rhoOut, pOut, vxOut, vyOut, vzOut, BxOut, ByOut, BzOut 00055 NAMELIST /ProblemData/ amplitude, wave_number 00056 OPEN(UNIT=PROBLEM_DATA_HANDLE, FILE='problem.data', STATUS="OLD") 00057 READ(PROBLEM_DATA_HANDLE,NML=ProblemData) 00058 IF (MPI_NP /= 1 .OR. MaxLevel > 0) THEN 00059 PRINT*, 'error - this is only designed to run on a single processor with maxlevel=0' 00060 PRINT*, 'Stopping' 00061 STOP 00062 END IF 00063 CALL CreateAmbient(Ambient) 00064 READ(PROBLEM_DATA_HANDLE,NML=AmbientData) 00065 Ambient%density=rhoOut 00066 Ambient%pressure=pOut 00067 Ambient%B(:)=(/BxOut, ByOut, BzOut/) 00068 Ambient%velocity(:)=(/vxOut, vyOut, vzOut/) 00069 qout(1)=rhoOut 00070 IF (ivx /= 0) qOut(ivx)=rhoOut*vxOut 00071 IF (ivy /= 0) qout(ivy)=rhoOut*vyOut 00072 IF (ivz /= 0) qout(ivz)=rhoOut*vzOut 00073 IF (iE /= 0) qout(iE)=gamma7*pOut+half*sum(qout(m_low:m_high)**2)/qout(1) 00074 CLOSE(PROBLEM_DATA_HANDLE) 00075 END SUBROUTINE ProblemModuleInit 00076 00079 SUBROUTINE ProblemGridInit(Info) 00080 TYPE(InfoDef) :: Info 00081 INTEGER :: i,j 00082 REAL(KIND=qPREC) :: x,y 00083 CALL ConvertTotalToInternalEnergy(Info%q(:,:,:,:)) 00084 DO i=1, Info%mX(1) 00085 DO j=1, Info%mX(2) 00086 x=Info%xbounds(1,1)+(real(i)-half)*levels(Info%level)%dx 00087 y=Info%xbounds(2,1)+(real(j)-half)*levels(Info%level)%dx 00088 Info%q(i,j,:,1:m_high)=Info%q(i,j,:,1:m_high)*(1d0+amplitude*sin(4d0*Pi*wave_number*(x+y)/(GxBounds(1,2)-GxBounds(1,1) + Gxbounds(2,2)-GxBounds(2,1)))) 00089 END DO 00090 END DO 00091 CALL ConvertInternalToTotalEnergy(Info%q(:,:,:,:)) 00092 END SUBROUTINE ProblemGridInit 00093 00096 SUBROUTINE ProblemBeforeStep(Info) 00097 TYPE(InfoDef) :: Info 00098 END SUBROUTINE ProblemBeforeStep 00099 00102 SUBROUTINE ProblemAfterStep(Info) 00103 TYPE(InfoDef) :: Info 00104 INTEGER :: i,j 00105 REAL(KIND=qPREC), ALLOCATABLE, DIMENSION(:,:,:) :: qExact 00106 REAL(KIND=qPREC) :: x,y 00107 REAL(KIND=qPREC), ALLOCATABLE, DIMENSION(:) :: wmiddle 00108 IF (levels(info%level)%tnow+levels(info%level)%dt == final_time) THEN 00109 OPEN(UNIT=11, FILE='data.curve', status='unknown') 00110 write(11,*) ' #rho' 00111 DO i=1, Info%mX(1) 00112 write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx, Info%q(i,1,1,1) 00113 END DO 00114 write(11,*) ' #vx' 00115 DO i=1, Info%mX(1) 00116 write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx, Info%q(i,1,1,ivx)/Info%q(i,1,1,1) 00117 END DO 00118 write(11,*) ' #P' 00119 DO i=1, Info%mX(1) 00120 write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx, (Press(Info%q(i,1,1,:))) 00121 END DO 00122 ALLOCATE(qExact(Info%mX(1), Info%mX(2),NrHydroVars)) 00123 ! ALLOCATE(wmiddle(1:NrHydroVars)) 00124 DO i=1, Info%mX(1) 00125 DO j=1, Info%mX(2) 00126 x=Info%xbounds(1,1)+(real(i)-half)*levels(Info%level)%dx 00127 y=Info%xbounds(2,1)+(real(j)-half)*levels(Info%level)%dx 00128 qexact(i,j,1:m_high)=qout(1:m_high)*(1d0+amplitude*sin(4d0*Pi*wave_number*(x+y)/(GxBounds(1,2)-GxBounds(1,1) + Gxbounds(2,2)-GxBounds(2,1)))) 00129 IF (iE /= 0) qExact(i,j,iE)=qout(iE) 00130 END DO 00131 END DO 00132 write(11,*) ' #rho_Exact' 00133 DO i=1, Info%mX(1) 00134 write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx, qExact(i,i,1) 00135 END DO 00136 write(11,*) ' #vx_Exact' 00137 DO i=1, Info%mX(1) 00138 write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx, sqrt(sum(qExact(i,i,ivx:ivy)**2)) 00139 END DO 00140 write(11,*) ' #P_Exact' 00141 DO i=1, Info%mX(1) 00142 write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx, qExact(i,i,iE) 00143 END DO 00144 CLOSE(11) 00145 write(*,*) 'dx, L2 Norm=', levels(Info%level)%dx, sum(abs(qExact(:,:,1)-Info%q(1:Info%mX(1),1:Info%mX(2),1,1)))/product(Info%mX(1:2)) 00146 END IF 00147 00148 END SUBROUTINE ProblemAfterStep 00149 00152 SUBROUTINE ProblemSetErrFlag(Info) 00153 TYPE(InfoDef) :: Info 00154 END SUBROUTINE ProblemSetErrFlag 00155 00156 SUBROUTINE ProblemBeforeGlobalStep(n) 00157 INTEGER :: n 00158 END SUBROUTINE ProblemBeforeGlobalStep 00159 00160 END MODULE Problem 00161