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 HydroWaves 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 Ambients 00041 USE RiemannSolvers 00042 USE Totals 00043 USE Fields 00044 IMPLICIT NONE 00045 SAVE 00046 00047 PUBLIC ProblemModuleInit, ProblemGridInit, & 00048 ProblemBeforeStep, ProblemAfterStep, ProblemSetErrFlag, ProblemBeforeGlobalStep 00049 PRIVATE 00050 INTEGER, DIMENSIOn(:), ALLOCATABLE :: map 00051 REAL(KIND=qPREC), DIMENSION(:), ALLOCATABLE :: dq, q, w, dw 00052 REAL(KIND=qPREC), DIMENSION(:,:), ALLOCATABLE :: lambda, A, Lamb, Am, An, qExact 00053 REAL(KIND=qPREC), DIMENSION(:,:,:), ALLOCATABLE :: l, r 00054 REAL(KIND=qPREC) :: wave_speed 00055 REAL(KIND=qPREC) :: rho, p, vx, vy, vz, Bx, By, Bz, WaveStrength, wavespeed 00056 INTEGER :: WaveFamily 00057 00058 CONTAINS 00059 00061 SUBROUTINE ProblemModuleInit() 00062 NAMELIST /ProblemData/ rho, p, vx, vy, vz, Bx, By, Bz, WaveFamily, WaveStrength 00063 OPEN(UNIT=PROBLEM_DATA_HANDLE, FILE='problem.data', STATUS="OLD") 00064 READ(PROBLEM_DATA_HANDLE,NML=ProblemData) 00065 00066 END SUBROUTINE ProblemModuleInit 00067 00070 SUBROUTINE ProblemGridInit(Info) 00071 TYPE(InfoDef) :: Info 00072 INTEGER :: i,j 00073 LOGICAL :: lFirstTime=.true. 00074 LOGICAL :: request_eigens 00075 INTEGER :: n(3) 00076 REAL(KIND=qPREC) :: left_fact, right_fact, dx,x 00077 SAVE 00078 IF (lFirstTime) THEN 00079 lFirstTime=.false. 00080 IF (MPI_ID == 0) write(*,*) NrWaves, NrHydroVars 00081 ALLOCATE(w(1:NrHydroVars), dw(1:NrHydroVars), q(1:NrHydroVars),dq(1:NrHydroVars)) 00082 ALLOCATE (r(nDim,NrWaves,NrWaves),l(nDim,NrWaves,NrWaves),lambda(nDim,NrWaves)) 00083 ALLOCATE (A(NrHydroVars, NrHydroVars), Lamb(NrWaves, NrWaves), Am(NrWaves, NrWaves),An(NrWaves, NrWaves)) 00084 w(1)=rho 00085 w(ivx)=vx 00086 IF (ivy /= 0) w(ivy)=vy 00087 IF (ivz /= 0) w(ivz)=vz 00088 IF (iE /= 0) w(iE)=P 00089 IF (iBx /= 0) w(iBx)=Bx 00090 IF (iBy /= 0) w(iBy)=By 00091 IF (iBz /= 0) w(iBz)=Bz 00092 write(*,*) 'sounds speed = ', sqrt(gamma*P/rho) 00093 write(*,*) w 00094 CALL calc_eigens(request_eigens, w, (/.true.,.true.,.true./),lambda, n, l, r,1,1,1,0) 00095 00096 ALLOCATE(map(NrWaves)) 00097 DO i=1,NrWaves 00098 map(i)=onedx_i(i) 00099 IF (lMHD .and. onedx_i(i) > iBx) map(i)=map(i)-1 00100 END DO 00101 write(*,*) 'map = ', map 00102 wavespeed=lambda(1,WaveFamily) 00103 write(*,*) 'wavespeeds', lambda(1,:) 00104 write(*,*) 'wave speed=', wavespeed 00105 write(*,*) 'loop should take ', (GxBounds(1,2)-GxBounds(1,1))/wavespeed 00106 ! left_fact=rho/sqrt(2d0*gamma*P/rho) / 0.1118033988749895 00107 ! right_fact=1d0/left_fact 00108 ! l=l*left_fact 00109 ! r=r*right_fact 00110 Lamb=0 00111 DO i=1,n(1) 00112 lamb(i,i)=lambda(1,i) 00113 END DO 00114 00115 IF (MPI_ID == 0) THEN 00116 write(*,*) 'found ', n(1), 'waves' 00117 00118 write(*,*) 'left eigen vectors are rows of' 00119 CALL OutputDoubleArray(transpose(l(1,1:n(1),map(:)))) 00120 00121 00122 write(*,*) 'right eigen vectors are columns of' 00123 CALL OutputDoubleArray(r(1,1:n(1),map(:))) 00124 00125 write(*,*) 'Check that L x R = I' 00126 CALL OutputDoubleArray(matmul(transpose(l(1,1:n(1),:)), r(1,1:n(1),:))) 00127 00128 00129 00130 ! L x A x R = Lam 00131 ! L(-1) x Lam x R(-1) = R x Lam x L 00132 Am=matmul(matmul(transpose(l(1,1:n(1),:)), lamb(1:n(1),1:n(1))),r(1,1:n(1),:)) 00133 write(*,*) 'Reconstruct matrix A' 00134 CALL OutputDoubleArray(Am) 00135 An=Am 00136 DO i=1,size(OneDx_i) 00137 An(:,map(i))=Am(:,i) 00138 END DO 00139 DO i=1,size(OneDx_i) 00140 Am(map(i),:)=An(i,:) 00141 END DO 00142 write(*,*) 'Reconstruct matrix A in normal index' 00143 CALL OutputDoubleArray(Am) 00144 END IF 00145 ! STOP 00146 END IF 00147 dw=0d0 00148 DO j=1,NrWaves 00149 dw(oneDx_i(j))=r(1,WaveFamily, j) 00150 END DO 00151 write(*,*) 'dw=', dw 00152 ! STOP 00153 dq=w+dw*1d-6 00154 CALL prim_to_cons(dq) 00155 q=w 00156 CALL prim_to_cons(q) 00157 write(*,*) 'dq=', (dq-q)/1d-6 00158 ! STOP 00159 DO i=1, Info%mX(1) 00160 ! Info%q(i,1,1,1:size(w)) = w+dw*WaveStrength*sin(2d0*Pi*real(i)/real(Info%mX(1))) 00161 !integral over space of sin(2d0*Pi*real(i)/real(Info%mX(1))) = 00162 dx=levels(Info%level)%dx 00163 x=Info%xBounds(1,1)+(real(i,8)-half)*dx 00164 Info%q(i,1,1,1:size(w)) = w-dw*WaveStrength*1d0/(2d0*Pi)*(cos(2d0*Pi*(x+half*dx))-cos(2d0*Pi*(x-half*dx)))/dx 00165 CALL prim_to_cons(Info%q(i,1,1,:)) 00166 END DO 00167 IF (MaintainAuxArrays) THEN 00168 IF (Info%mx(1) > Info%mX(2)) Info%aux(1:Info%mX(1),1:Info%mx(2)+1,1,2) = SPREAD(Info%q(1:Info%mX(1),1,1,iBy),2,Info%mX(2)+1) 00169 IF (Info%mX(2) > Info%mX(1)) Info%aux(1:Info%mX(1)+1,1:Info%mx(2),1,1) = SPREAD(Info%q(1,1:Info%mX(2),1,iBx),1,Info%mX(1)+1) 00170 END IF 00171 ! STOP 00172 END SUBROUTINE ProblemGridInit 00173 00176 SUBROUTINE ProblemBeforeStep(Info) 00177 TYPE(InfoDef) :: Info 00178 INTEGER :: rmbc,i,j 00179 REAL(KIND=qPREC), DIMENSION(:,:,:), POINTER :: tempaux 00180 rmbc=levels(Info%level)%gmbc(1) 00181 IF (lMHD .AND. nDim == 2 .AND. Info%mX(1) == Info%mX(2)) THEN !Angled aux fields - need to calculate potential 00182 ALLOCATE(tempaux(1:Info%mX(1)+1,1:Info%mX(2)+1,2)) 00183 tempaux=Info%aux(1:Info%mX(1)+1,1:Info%mX(2)+1,1,1:2) 00184 00185 DO j=-rmbc, Info%mX(2)+rmbc 00186 Info%aux(1-rmbc:j,Info%mx(2)+1-j,1,1)=Info%q(1,1,1,iBx) 00187 Info%aux(j+1:Info%mX(1)+1+rmbc,Info%mx(2)+1-j,1,1)=Info%q(Info%mX(1),Info%mX(2),1,iBx) 00188 END DO 00189 DO i=1-rmbc, Info%mX(1)+rmbc 00190 Info%aux(info%mx(1)+1-i,1-rmbc:i,1,2)=Info%q(1,1,1,iBy) 00191 Info%aux(info%mx(1)+1-i,i+1:Info%mX(2)+1+rmbc,1,2)=Info%q(Info%mX(1),Info%mX(2),1,iBy) 00192 END DO 00193 Info%aux(1:Info%mX(1)+1,1:Info%mX(2),1,1)=tempaux(1:Info%mX(1)+1,1:Info%mX(2),1) 00194 Info%aux(1:Info%mX(1),1:Info%mX(2)+1,1,2)=tempaux(1:Info%mX(1),1:Info%mX(2)+1,2) 00195 00196 Info%q(1-rmbc:Info%mX(1)+rmbc,1-rmbc:Info%mX(2)+rmbc,1,iBx)=half*(Info%aux(1-rmbc:Info%mX(1)+rmbc,1-rmbc:Info%mX(2)+rmbc,1,1)+Info%aux(2-rmbc:Info%mX(1)+1+rmbc,1-rmbc:Info%mX(2)+rmbc,1,1)) 00197 Info%q(1-rmbc:Info%mX(1)+rmbc,1-rmbc:Info%mX(2)+rmbc,1,iBy)=half*(Info%aux(1-rmbc:Info%mX(1)+rmbc,1-rmbc:Info%mX(2)+rmbc,1,2)+Info%aux(1-rmbc:Info%mX(1)+rmbc,2-rmbc:Info%mX(2)+1+rmbc,1,2)) 00198 DEALLOCATE(tempaux) 00199 END IF 00200 00201 END SUBROUTINE ProblemBeforeStep 00202 00205 SUBROUTINE ProblemAfterStep(Info) 00206 TYPE(InfoDef) :: Info 00207 INTEGER :: i 00208 REAL(KIND=qPREC), DIMENSION(:), ALLOCATABLE :: err 00209 REAL(KIND=qPREC) :: phase, dx,x 00210 ALLOCATE(err(1:NrHydroVars)) 00211 IF (levels(info%level)%tnow+levels(info%level)%dt == final_time) THEN 00212 dx=levels(Info%level)%dx 00213 phase=-(2d0*Pi*(final_time*wavespeed)/(GxBounds(1,2)-GxBounds(1,1))) 00214 write(*,*) 'phase = ', phase 00215 OPEN(UNIT=11, FILE='out/data.curve', status='unknown') 00216 write(11,*) '# rho' 00217 DO i=1, Info%mX(1) 00218 IF (Info%mX(2) /= Info%mX(1)) write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx, Info%q(i,1,1,1) 00219 IF (Info%mX(1)==Info%mX(2)) write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx*sqrt(2d0), Info%q(i,i,1,1) 00220 END DO 00221 write(11,*) 00222 write(11,*) 00223 00224 write(11,*) '# rho_Exact' 00225 DO i=1, Info%mX(1) 00226 IF (Info%mX(2) /= Info%mX(1)) write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx, w(1)+dw(1)*WaveStrength*sin(phase+2d0*Pi*(real(i)-half)/real(Info%mX(1))) 00227 IF (Info%mX(1)==Info%mX(2)) write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx*sqrt(2d0), w(1)+dw(1)*WaveStrength*sin(phase+2d0*Pi*sqrt(2d0)*(real(i)-half)/real(Info%mX(1))) 00228 END DO 00229 write(11,*) 00230 write(11,*) 00231 00232 00233 write(11,*) '# rho_error' 00234 DO i=1, Info%mX(1) 00235 x=Info%xBounds(1,1)+(real(i,8)-half)*dx 00236 write(11,*) x, abs(w(1)-dw(1)*WaveStrength*1d0/(2d0*Pi)*(cos(phase+2d0*Pi*(x+half*dx))-cos(phase+2d0*Pi*(x-half*dx)))/dx - Info%q(i,1,1,1)) 00237 00238 END DO 00239 write(11,*) 00240 write(11,*) 00241 00242 00243 00244 00245 write(11,*) '# vx' 00246 DO i=1, Info%mX(1) 00247 IF (Info%mX(2) /= Info%mX(1)) 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) 00248 IF (Info%mX(1)==Info%mX(2)) write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx*sqrt(2d0), Info%q(i,i,1,ivx)/Info%q(i,i,1,1) 00249 END DO 00250 write(11,*) 00251 write(11,*) 00252 00253 write(11,*) '# vx_Exact' 00254 DO i=1, Info%mX(1) 00255 IF (Info%mX(2) /= Info%mX(1)) write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx, w(ivx)+dw(ivx)*WaveStrength*sin(phase+2d0*Pi*(real(i)-half)/real(Info%mX(1))) 00256 IF (Info%mX(1)==Info%mX(2)) write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx*sqrt(2d0), w(ivx)+dw(ivx)*WaveStrength*sin(phase+2d0*Pi*sqrt(2d0)*(real(i)-half)/real(Info%mX(1))) 00257 END DO 00258 write(11,*) 00259 write(11,*) 00260 00261 write(11,*) '# P' 00262 DO i=1, Info%mX(1) 00263 IF (Info%mX(2) /= Info%mX(1)) write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx, (Press(Info%q(i,1,1,:))) 00264 IF (Info%mX(1)==Info%mX(2)) write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx*sqrt(2d0), (Press(Info%q(i,i,1,:))) 00265 END DO 00266 write(11,*) 00267 write(11,*) 00268 write(11,*) '# P_Exact' 00269 IF (iE /= 0) THEN 00270 DO i=1, Info%mX(1) 00271 IF (Info%mX(2) /= Info%mX(1)) write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx, w(iE)+dw(iE)*WaveStrength*sin(phase+2d0*Pi*(real(i)-half)/real(Info%mX(1))) 00272 IF (Info%mX(1)==Info%mX(2)) write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx*sqrt(2d0), w(iE)+dw(iE)*WaveStrength*sin(phase+2d0*Pi*sqrt(2d0)*(real(i)-half)/real(Info%mX(1))) 00273 END DO 00274 ELSE 00275 DO i=1, Info%mX(1) 00276 IF (Info%mX(2) /= Info%mX(1)) write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx, Iso_Speed2*(w(1)+dw(1)*WaveStrength*sin(phase+2d0*Pi*(real(i)-half)/real(Info%mX(1)))) 00277 IF (Info%mX(1)==Info%mX(2)) write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx*sqrt(2d0), Iso_Speed2*(w(1)+dw(1)*WaveStrength*sin(phase+2d0*Pi*sqrt(2d0)*(real(i)-half)/real(Info%mX(1)))) 00278 END DO 00279 END IF 00280 write(11,*) 00281 write(11,*) 00282 00283 00284 IF (ivy /= 0) THEN 00285 write(11,*) '# vy' 00286 DO i=1, Info%mX(1) 00287 IF (Info%mX(2) /= Info%mX(1)) write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx, Info%q(i,1,1,ivy)/Info%q(i,1,1,1) 00288 IF (Info%mX(1)==Info%mX(2)) write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx*sqrt(2d0), Info%q(i,i,1,ivy)/Info%q(i,i,1,1) 00289 END DO 00290 write(11,*) 00291 write(11,*) 00292 write(11,*) '# vy_Exact' 00293 DO i=1, Info%mX(1) 00294 IF (Info%mX(2) /= Info%mX(1)) write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx, w(ivy)+dw(ivy)*WaveStrength*sin(phase+2d0*Pi*(real(i)-half)/real(Info%mX(1))) 00295 IF (Info%mX(1)==Info%mX(2)) write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx*sqrt(2d0), w(ivy)+dw(ivy)*WaveStrength*sin(phase+2d0*Pi*sqrt(2d0)*(real(i)-half)/real(Info%mX(1))) 00296 END DO 00297 write(11,*) 00298 write(11,*) 00299 END IF 00300 IF (ivz /= 0) THEN 00301 write(11,*) '# vz' 00302 DO i=1, Info%mX(1) 00303 IF (Info%mX(2) /= Info%mX(1)) write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx, Info%q(i,1,1,ivz)/Info%q(i,1,1,1) 00304 IF (Info%mX(1)==Info%mX(2)) write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx*sqrt(2d0), Info%q(i,i,1,ivz)/Info%q(i,i,1,1) 00305 END DO 00306 write(11,*) 00307 write(11,*) 00308 write(11,*) '# vz_Exact' 00309 DO i=1, Info%mX(1) 00310 IF (Info%mX(2) /= Info%mX(1)) write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx, w(ivz)+dw(ivz)*WaveStrength*sin(phase+2d0*Pi*(real(i)-half)/real(Info%mX(1))) 00311 IF (Info%mX(1)==Info%mX(2)) write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx*sqrt(2d0), w(ivz)+dw(ivz)*WaveStrength*sin(phase+2d0*Pi*sqrt(2d0)*(real(i)-half)/real(Info%mX(1))) 00312 END DO 00313 write(11,*) 00314 write(11,*) 00315 00316 END IF 00317 IF (iBx /= 0) THEN 00318 write(11,*) '# Bx' 00319 DO i=1, Info%mX(1) 00320 IF (Info%mX(2) /= Info%mX(1)) write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx, Info%q(i,1,1,iBx) 00321 IF (Info%mX(1)==Info%mX(2)) write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx*sqrt(2d0), Info%q(i,i,1,iBx) 00322 END DO 00323 write(11,*) 00324 write(11,*) 00325 write(11,*) '# Bx_Exact' 00326 DO i=1, Info%mX(1) 00327 IF (Info%mX(2) /= Info%mX(1)) write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx, w(iBx)+dw(iBx)*WaveStrength*sin(phase+2d0*Pi*(real(i)-half)/real(Info%mX(1))) 00328 IF (Info%mX(1)==Info%mX(2)) write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx*sqrt(2d0), w(iBx)+dw(iBx)*WaveStrength*sin(phase+2d0*Pi*sqrt(2d0)*(real(i)-half)/real(Info%mX(1))) 00329 END DO 00330 write(11,*) 00331 write(11,*) 00332 00333 END IF 00334 IF (iBy /= 0) THEN 00335 write(11,*) '# By' 00336 DO i=1, Info%mX(1) 00337 IF (Info%mX(2) /= Info%mX(1)) write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx, Info%q(i,1,1,iBy) 00338 IF (Info%mX(1)==Info%mX(2)) write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx*sqrt(2d0), Info%q(i,i,1,iBy) 00339 END DO 00340 write(11,*) 00341 write(11,*) 00342 write(11,*) '# iBy_Exact' 00343 DO i=1, Info%mX(1) 00344 IF (Info%mX(2) /= Info%mX(1)) write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx, w(iBy)+dw(iBy)*WaveStrength*sin(phase+2d0*Pi*(real(i)-half)/real(Info%mX(1))) 00345 IF (Info%mX(1)==Info%mX(2)) write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx*sqrt(2d0), w(iBy)+dw(iBy)*WaveStrength*sin(phase+2d0*Pi*sqrt(2d0)*(real(i)-half)/real(Info%mX(1))) 00346 END DO 00347 write(11,*) 00348 write(11,*) 00349 00350 END IF 00351 IF (iBz /= 0) THEN 00352 write(11,*) '# Bz' 00353 DO i=1, Info%mX(1) 00354 IF (Info%mX(2) /= Info%mX(1)) write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx, Info%q(i,1,1,iBz) 00355 IF (Info%mX(1)==Info%mX(2)) write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx*sqrt(2d0), Info%q(i,i,1,iBz) 00356 END DO 00357 write(11,*) 00358 write(11,*) 00359 write(11,*) '# iBz_Exact' 00360 DO i=1, Info%mX(1) 00361 IF (Info%mX(2) /= Info%mX(1)) write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx, w(iBz)+dw(iBz)*WaveStrength*sin(phase+2d0*Pi*(real(i)-half)/real(Info%mX(1))) 00362 IF (Info%mX(1)==Info%mX(2)) write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx*sqrt(2d0), w(iBz)+dw(iBz)*WaveStrength*sin(phase+2d0*Pi*sqrt(2d0)*(real(i)-half)/real(Info%mX(1))) 00363 END DO 00364 write(11,*) 00365 write(11,*) 00366 00367 END IF 00368 err=0d0 00369 DO i=1,Info%mX(1) 00370 CALL cons_to_prim(Info%q(i,1,1,:)) 00371 x=Info%xBounds(1,1)+(real(i,8)-half)*dx 00372 ! Info%q(i,1,1,1:size(w)) = w-dw*WaveStrength*1d0/(2d0*Pi)*(cos(2d0*Pi*(x+half*dx))-cos(2d0*Pi*(x+half*dx)))/dx 00373 err=err+abs(w-dw*WaveStrength*1d0/(2d0*Pi)*(cos(phase+2d0*Pi*(x+half*dx))-cos(phase+2d0*Pi*(x-half*dx)))/dx - Info%q(i,1,1,:)) 00374 ! write(*,*) i,abs(w+dw*WaveStrength*sin(phase+2d0*Pi*real(i)/real(Info%mX(1))) - Info%q(i,1,1,1:NrHydroVars)) 00375 END DO 00376 err=err/real(Info%mX(1), 8) 00377 write(*,*) 'dx, error=', levels(Info%level)%dx, sum(err) 00378 END IF 00379 END SUBROUTINE ProblemAfterStep 00380 00383 SUBROUTINE ProblemSetErrFlag(Info) 00384 TYPE(InfoDef) :: Info 00385 END SUBROUTINE ProblemSetErrFlag 00386 00387 SUBROUTINE ProblemBeforeGlobalStep(n) 00388 INTEGER :: n 00389 END SUBROUTINE ProblemBeforeGlobalStep 00390 00391 END MODULE Problem 00392