check_res Subroutine

subroutine check_res(varname, res, error)

Check tracking results

Arguments

Type IntentOptional AttributesName
character(len=labelLen), intent(in) :: varname
real(kind=rk), intent(in) :: res(:)
integer, intent(out) :: error

Called by

proc~~check_res~2~~CalledByGraph proc~check_res~2 check_res program~tem_varsys_stfunvar_test tem_varSys_stfunVar_test program~tem_varsys_stfunvar_test->proc~check_res~2

Contents

Source Code


Source Code

  subroutine check_res( varname, res, error )
    ! ---------------------------------------------------------------------- !
    character(len=labelLen), intent(in) :: varname
    real(kind=rk), intent(in) :: res(:)
    integer, intent(out) :: error
    ! ---------------------------------------------------------------------- !
    integer :: iElem
    real(kind=rk) :: diff_dens(nElems_track)
    real(kind=rk) :: diff_vel(nElems_track,3)
    ! ---------------------------------------------------------------------- !
    error = 0
    select case (trim(varname))
    case ('density')
      diff_dens = res(:) - dens
      if ( any(diff_dens > eps) ) then
        error = -1
        write(*,*) 'Refernece value for density does not match'
      end if
      if (dumpRes) then
        write(*,*) 'reference: ', dens
        write(*,*) '   output: ', res
      end if
    case ('density_shape')
      diff_dens = res(:) - dens_shape
      if ( any(diff_dens > eps) ) then
        error = -1
        write(*,*) 'Refernece value for density_shape does not match'
        write(*,*) 'diff ', diff_dens
      end if
      if (dumpRes) then
        write(*,*) 'reference: ', dens_shape
        write(*,*) '   output: ', res
      end if
    case ('density_multi_stfun')
      diff_dens = res(:) - dens_multi_stfun
      if ( any(diff_dens > eps) ) then
        error = -1
        write(*,*) 'Refernece value for density_multi_stfun does not match'
      end if
      if (dumpRes) then
        write(*,*) 'reference: ', dens_multi_stfun
        write(*,*) '   output: ', res
      end if
    case ('velocity')
      do iElem = 1, nElems_track
        diff_vel(iElem,:) = res((iElem-1)*3 + 1 : (iElem-1)*3 + 3 ) &
          &               - vel(iElem,:)
      end do
      if ( any(diff_vel > eps) ) then
        error = -1
        write(*,*) 'Refernece value for velocity does not match'
      end if
      if (dumpRes) then
        do iElem = 1, nElems_track
          write(*,*) 'reference: ', vel(iElem, :)
          write(*,*) '   output: ', res( (iElem-1)*3 + 1 : (iElem-1)*3 + 3 )
        end do
      end if
    case ('velocity_shape')
      do iElem = 1, nElems_track
        diff_vel(iElem,:) = res((iElem-1)*3 + 1 : (iElem-1)*3 + 3 ) &
          &               - vel_shape(iElem,:)
      end do
      if ( any(diff_vel > eps) ) then
        error = -1
        write(*,*) 'Refernece value for velocity_shape does not match'
      end if
      if (dumpRes) then
        do iElem = 1, nElems_track
          write(*,*) 'reference: ', vel_shape(iElem,:)
          write(*,*) '   output: ', res( (iElem-1)*3 + 1 : (iElem-1)*3 + 3 )
        end do
      end if
    case ('velocity_multi_stfun')
      do iElem = 1, nElems_track
        diff_vel(iElem,:) = res((iElem-1)*3 + 1 : (iElem-1)*3 + 3 ) &
          &               - vel_multi_stfun(iElem,:)
      end do
      if ( any(diff_vel > eps) ) then
        error = -1
        write(*,*) 'Refernece value for velocity_multi_stfun does not match'
      end if
      if (dumpRes) then
        do iElem = 1, nElems_track
          write(*,*) 'reference: ', vel_multi_stfun(iElem,:)
          write(*,*) '   output: ', res( (iElem-1)*3 + 1 : (iElem-1)*3 + 3 )
        end do
      end if
    case default
      write(*,*) 'Unknown variable name', trim(varname)
      error = -1
    end select

   end subroutine check_res