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 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