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