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