wiki:u/erica/ProblemAfterStepRoutine

This subroutine in problem.f90 builds a data.curve file for each frame and prints to that file the q array, as well as the exact solution for the sod shock tube.

 SUBROUTINE ProblemAfterStep(Info)
     TYPE(InfoDef) :: Info
     INTEGER :: i
     REAL(KIND=qPREC), ALLOCATABLE, DIMENSION(:,:) :: qExact
     REAL(KIND=qPREC) :: um, s, max_speed
     REAL(KIND=qPREC), ALLOCATABLE, DIMENSION(:) :: wmiddle
     CHARACTER(50) :: S_FILENAME

     IF (MPI_ID == MASTER .OR. lParallelHDF5) THEN
        !write(*,*) 'levels%tnow=', levels(maxlevel)%step                                                                                                         
        WRITE(s_filename, '(A8,I5.5,A6)') 'out/data', current_frame, '.curve'  !write to the character var 's_filename' the concatenated output list              
        !PRINT *, 's_filename=', s_filename                                                                                                                       
        !PRINT *, 'current_time=', levels(maxlevel)%tnow !gives the current time                                                                                  
        !RETURN                                                                                                                                                   
        OPEN(UNIT=11, FILE=s_filename, status='replace') !open the filename defined above for each current frame                                                  
        write(11, *) '# rho'
        DO i=1, Info%mX(1)
           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)
           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)
        END DO
        write(11,*)
        write(11,*)
        write(11,*) '# vx'
        DO i=1, Info%mX(1)
           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)
           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)
        END DO
        write(11,*)
        write(11,*)
        write(11,*) '# P'
        DO i=1, Info%mX(1)
           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,:)))
           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,:)))
        END DO
        write(11,*)
        write(11,*)

        IF (lMHD) THEN
           write(11,*) '# vy'
           DO i=1, Info%mX(1)
              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)
              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)
           END DO
           write(11,*)
           write(11,*)
           write(11,*) '# vz'
           DO i=1, Info%mX(1)
              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)
              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)
           END DO
           write(11,*)
           write(11,*)
           write(11,*) '# Bx'
           DO i=1, Info%mX(1)
              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)
              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)
           END DO
           write(11,*)
           write(11,*)
           write(11,*) '# By'
           DO i=1, Info%mX(1)
              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)
              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)
           END DO
           write(11,*)
           write(11,*)
           write(11,*) '# Bz'
           DO i=1, Info%mX(1)
              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)
              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)
           END DO
           write(11,*)
           write(11,*)
        ELSE
           ALLOCATE(qExact(Info%mX(1), NrHydroVars))
           ALLOCATE(wmiddle(1:NrHydroVars))
           DO i=1, Info%mX(1)
              !       S=(Info%xBounds(1,1)+(REAL(i)-half)*Levels(Info%level)%dx-position(1))/final_time !get the exact solution for the final time                
              S=(Info%xBounds(1,1)+(REAL(i)-half)*Levels(Info%level)%dx-position(1))/levels(maxlevel)%tnow !get the exact solution for the current time           
              IF (Info%mX(1)==Info%mX(2)) S=S*sqrt(2d0)
              CALL vacuum_solve(qabove((/1,3,2/)), qbelow((/1,3,2/)), wmiddle, um, s, max_speed)
              qExact(i,:)=wmiddle
           END DO
           write(11,*) '# rho_Exact'
           DO i=1, Info%mX(1)
              write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx, qExact(i,1)
           END DO
           write(11,*)
           write(11,*)
           write(11,*) '# vx_Exact'
           DO i=1, Info%mX(1)
              write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx, qExact(i,3)
           END DO
           write(11,*)
           write(11,*)
           write(11,*) '# P_Exact'
           DO i=1, Info%mX(1)
              write(11,*) Info%xbounds(1,1)+(REAL(i)-half)*levels(Info%level)%dx, qExact(i,2)
           END DO
           CLOSE(11)
           IF (Info%mX(2) /= Info%mX(1)) write(*,*) 'dx, L2 Norm=', levels(Info%level)%dx, sum(abs(qExact(:,1)-Info%q(1:Info%mX(1),1,1,1)))/Info%mX(1)
           IF (Info%mX(1)==Info%mX(2)) write(*,*) 'dx, L2 Norm=', levels(Info%level)%dx, sum(abs(qExact(:,1)-(/(Info%q(i,i,1,1), i=1,Info%mX(1))/)))/Info%mX(1)
        END IF
     END IF

   END SUBROUTINE ProblemAfterStep
Last modified 7 years ago Last modified on 11/29/17 14:12:56
Note: See TracWiki for help on using the wiki.