Scrambler  1
1DWaves/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 1DWaves 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   USE Totals
00043   USE Fields
00044   IMPLICIT NONE
00045   SAVE
00046 
00047   PUBLIC ProblemModuleInit, ProblemGridInit, &
00048        ProblemBeforeStep, ProblemAfterStep, ProblemSetErrFlag, ProblemBeforeGlobalStep
00049   REAL(KIND=qPREC) :: amplitude, wave_number, qout(20)
00050   INTEGER :: dir
00051 CONTAINS
00052 
00054   SUBROUTINE ProblemModuleInit()      
00055     TYPE(AmbientDef), POINTER :: Ambient
00056     REAL(KIND=qPREC) :: rhoOut, pOut, vxOut, vyOut, vzOut, BxOut, ByOut, BzOut
00057     TYPE(TotalDef), POINTER :: Total
00058     NAMELIST /AmbientData/ rhoOut, pOut, vxOut, vyOut, vzOut, BxOut, ByOut, BzOut
00059     NAMELIST /ProblemData/ amplitude, wave_number,dir
00060     OPEN(UNIT=PROBLEM_DATA_HANDLE, FILE='problem.data', STATUS="OLD")
00061     READ(PROBLEM_DATA_HANDLE,NML=ProblemData)
00062     !      IF (MPI_NP /= 1 .OR. MaxLevel /= 0) THEN
00063     !         PRINT*, 'error - this module is only setup to run on a single processor with maxlevel=0'
00064     !         PRINT*, 'stopping'
00065     !         STOP
00066     !      END IF
00067     CALL CreateTotal(Total)
00068     Total%Field%Component=GASCOMP
00069     Total%Field%id=ivx
00070     Total%Field%name=FieldName(ivx)
00071 
00072     IF (ivy /= 0) THEN
00073        CALL CreateTotal(Total)
00074        Total%Field%Component=GASCOMP
00075        Total%Field%id=ivx
00076        Total%Field%name=FieldName(ivx)
00077     END IF
00078     CALL CreateTotal(Total)
00079     Total%Field%Component=GASCOMP
00080     Total%Field%id=1
00081     Total%Field%name=FieldName(1)
00082     IF (iE /= 0) THEN
00083        CALL CreateTotal(Total)
00084        Total%Field%Component=GASCOMP
00085        Total%Field%id=iE
00086        Total%Field%name=FieldName(iE)
00087     END IF
00088 
00089     CALL CreateTotal(Total)
00090     Total%Field%Component=GASCOMP
00091     Total%Field%id=GravEnergy_Field
00092     Total%Field%name=FieldName(GravEnergy_Field)
00093     CALL CreateAmbient(Ambient)
00094     READ(PROBLEM_DATA_HANDLE,NML=AmbientData)
00095     Ambient%density=rhoOut
00096     Ambient%pressure=pOut
00097     Ambient%B(:)=(/BxOut, ByOut, BzOut/)
00098     Ambient%velocity(:)=(/vxOut, vyOut, vzOut/)
00099     qout(1)=rhoOut
00100     IF (ivx /= 0) qout(ivx)=vxOut*rhoout
00101     IF (ivy /= 0) qout(ivy)=vyOut*rhoOut
00102     IF (ivz /= 0) qout(ivz)=vzOut*rhoOut
00103     IF (iBx /= 0) qout(iBx)=BxOut
00104     IF (iBy /= 0) qout(iBy)=ByOut    
00105     IF (iBz /= 0) qout(iBz)=BzOut
00106     IF (iE /= 0) qout(iE) = gamma7*pOut+half*rhoOut*(vxOut**2+vyOut**2+vzOut**2)+half*(BxOut**2+ByOut**2+BzOut**2)
00107     CLOSE(PROBLEM_DATA_HANDLE)
00108     write(*,*) 'Jeans length=', JeansLength(rhoout, pOut/rhoOut)
00109   END SUBROUTINE ProblemModuleInit
00110 
00113    SUBROUTINE ProblemGridInit(Info)
00114       TYPE(InfoDef) :: Info
00115       INTEGER :: i,j,k
00116       REAL(KIND=qPREC) :: x,y,z,dev
00117       CALL ConvertTotalToInternalEnergy(Info%q(:,:,:,:))          
00118       IF (dir==1) THEN
00119          DO i=1, Info%mX(1)
00120             x=Info%xbounds(1,1)+(real(i)-half)*levels(Info%level)%dx
00121             Info%q(i,:,:,1:m_high)=Info%q(i,:,:,1:m_high)*(1d0+amplitude*sin(2d0*Pi*wave_number*x/(GxBounds(1,2)-GxBounds(1,1))))
00122             IF (iE /= 0) Info%q(i,:,:,iE)=Info%q(i,:,:,iE)*(1d0+amplitude*sin(2d0*Pi*wave_number*x/(GxBounds(1,2)-GxBounds(1,1))))
00123          END DO
00124       ELSEIF (dir == 2) THEN
00125 
00126          DO i=1, Info%mX(2)
00127             x=Info%xbounds(2,1)+(real(i)-half)*levels(Info%level)%dx
00128             Info%q(:,i,:,1:m_high)=Info%q(:,i,:,1:m_high)*(1d0+amplitude*sin(2d0*Pi*wave_number*x/(GxBounds(2,2)-GxBounds(2,1))))
00129             IF (iE /= 0) Info%q(:,i,:,iE)=Info%q(:,i,:,iE)*(1d0+amplitude*sin(2d0*Pi*wave_number*x/(GxBounds(2,2)-GxBounds(2,1))))
00130          END DO
00131 
00132       ELSEIF (dir == 3) THEN
00133 
00134          DO i=1, Info%mX(3)
00135             x=Info%xbounds(3,1)+(real(i)-half)*levels(Info%level)%dx
00136             Info%q(:,:,i,1:m_high)=Info%q(:,:,i,1:m_high)*(1d0+amplitude*sin(2d0*Pi*wave_number*x/(GxBounds(3,2)-GxBounds(3,1))))
00137             IF (iE /= 0) Info%q(:,:,i,iE)=Info%q(:,:,i,iE)*(1d0+amplitude*sin(2d0*Pi*wave_number*x/(GxBounds(3,2)-GxBounds(3,1))))
00138          END DO
00139          
00140       ELSEIF (dir == 4) THEN
00141          DO i=1,Info%mX(1)
00142             x=Info%xbounds(1,1)+(real(i)-half)*levels(Info%level)%dx
00143             DO j=1,Info%mX(2)
00144                y=Info%xbounds(2,1)+(real(j)-half)*levels(Info%level)%dx
00145                Info%q(i,j,:,1:m_high)=Info%q(i,j,:,1:m_high)*(1d0+amplitude*sin(4d0*Pi*wave_number*(x+y)/(SUM(GxBounds(1:2,2)-GxBounds(1:2,1)))))
00146                IF (iE /= 0) Info%q(i,j,:,1:iE)=Info%q(i,j,:,1:iE)*(1d0+amplitude*sin(4d0*Pi*wave_number*(x+y)/(SUM(GxBounds(1:2,2)-GxBounds(1:2,1)))))
00147                
00148             END DO
00149          END DO
00150       ELSEIF (dir == 5) THEN
00151          DO i=1,Info%mX(2)
00152             x=Info%xbounds(2,1)+(real(i)-half)*levels(Info%level)%dx
00153             DO j=1,Info%mX(3)
00154                y=Info%xbounds(3,1)+(real(j)-half)*levels(Info%level)%dx
00155                Info%q(:,i,j,1:m_high)=Info%q(:,i,j,1:m_high)*(1d0+amplitude*sin(4d0*Pi*wave_number*(x+y)/(SUM(GxBounds(2:3,2)-GxBounds(2:3,1)))))
00156                IF (iE /= 0) Info%q(:,i,j,1:iE)=Info%q(:,i,j,1:iE)*(1d0+amplitude*sin(4d0*Pi*wave_number*(x+y)/(SUM(GxBounds(2:3,2)-GxBounds(2:3,1)))))
00157                
00158             END DO
00159          END DO
00160 
00161       ELSEIF (dir == 7) THEN
00162          DO i=1,Info%mX(1)
00163             x=Info%xbounds(1,1)+(real(i)-half)*levels(Info%level)%dx
00164             DO j=1,Info%mX(2)
00165                y=Info%xbounds(2,1)+(real(j)-half)*levels(Info%level)%dx
00166                DO k=1,Info%mX(3)
00167                   z=Info%xbounds(3,1)+(real(k)-half)*levels(Info%level)%dx
00168                   dev=(1d0+amplitude*sin(6d0*Pi*wave_number*(x+y+z)/sum((GxBounds(1:3,2)-GxBounds(1:3,1)))))
00169 
00170 !                  dev=(1d0+amplitude*sin(2d0*Pi*wave_number*(x)/(GxBounds(1,2)-GxBounds(1,1))))* &
00171 !                       (1d0+amplitude*sin(2d0*Pi*wave_number*(y)/(GxBounds(2,2)-GxBounds(2,1))))* &
00172 !                       (1d0+amplitude*sin(2d0*Pi*wave_number*(z)/(GxBounds(3,2)-GxBounds(3,1))))
00173                   Info%q(i,j,k,1:m_high)=Info%q(i,j,k,1:m_high)*dev
00174                   IF (iE /= 0) Info%q(i,j,k,1:iE)=Info%q(i,j,k,1:iE)*dev
00175                END DO
00176             END DO
00177          END DO
00178       END IF
00179       CALL ConvertInternalToTotalEnergy(Info%q(:,:,:,:))          
00180    END SUBROUTINE ProblemGridInit
00181 
00184    SUBROUTINE ProblemBeforeStep(Info)
00185       TYPE(InfoDef) :: Info
00186    END SUBROUTINE ProblemBeforeStep
00187 
00190    SUBROUTINE ProblemAfterStep(Info)
00191       TYPE(InfoDef) :: Info
00192       INTEGER :: i
00193       REAL(KIND=qPREC), ALLOCATABLE, DIMENSION(:,:) :: qExact
00194       REAL(KIND=qPREC) :: x
00195       REAL(KIND=qPREC), ALLOCATABLE, DIMENSION(:) :: wmiddle
00196       RETURN
00197       IF (levels(info%level)%tnow+levels(info%level)%dt == final_time) THEN
00198          OPEN(UNIT=11, FILE='data.curve', status='unknown')
00199          write(11,*) ' #rho'
00200          DO i=1, Info%mX(1)
00201             write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx, Info%q(i,1,1,1)
00202          END DO
00203          write(11,*) ' #vx'
00204          DO i=1, Info%mX(1)
00205             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)
00206          END DO
00207          write(11,*) ' #P'
00208          DO i=1, Info%mX(1)
00209             write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx, (Press(Info%q(i,1,1,:)))
00210          END DO                 
00211          ALLOCATE(qExact(Info%mX(1), NrHydroVars))
00212 !         ALLOCATE(wmiddle(1:NrHydroVars))
00213          DO i=1, Info%mX(1)
00214             x=Info%xbounds(1,1)+(real(i)-half)*levels(Info%level)%dx - final_time**3/6d0
00215             qExact(i,1:m_high)=qOut(1:m_high)*(1d0+amplitude*sin(2d0*Pi*wave_number*x/(GxBounds(1,2)-GxBounds(1,1))))
00216             qExact(i,iE)=qOut(iE)
00217          END DO
00218          write(11,*) ' #rho_Exact'
00219          DO i=1, Info%mX(1)
00220             write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx, qExact(i,1)
00221          END DO
00222          write(11,*) ' #vx_Exact'
00223          DO i=1, Info%mX(1)
00224             write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx, qExact(i,ivx)
00225          END DO
00226          write(11,*) ' #P_Exact'
00227          DO i=1, Info%mX(1)
00228             write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx, qExact(i,iE)
00229          END DO                 
00230          CLOSE(11)
00231          write(*,*) 'dx, L2 Norm=', levels(Info%level)%dx, sum(abs(qExact(:,1)-Info%q(1:Info%mX(1),1,1,1)))/Info%mX(1)
00232       END IF
00233       
00234    END SUBROUTINE ProblemAfterStep
00235 
00238    SUBROUTINE ProblemSetErrFlag(Info)
00239       TYPE(InfoDef) :: Info
00240    END SUBROUTINE ProblemSetErrFlag
00241 
00242 
00243    SUBROUTINE ProblemBeforeGlobalStep(n)
00244       INTEGER :: n
00245    END SUBROUTINE ProblemBeforeGlobalStep
00246 END MODULE Problem
00247 
 All Classes Files Functions Variables