module MW_errors
#ifndef MW_SERIAL
   use mpi
#endif   
   use MW_stdio, only: MW_stdout, MW_stderr

   implicit none
   private

   public :: finalize
   public :: allocate_error
   public :: deallocate_error
   public :: parameter_error
   public :: runtime_error
   public :: runtime_warning
   public :: temperature_warning
   public :: open_error
   public :: close_error
   public :: mpilib_error

   interface parameter_error
      module procedure parameter_error_int
      module procedure parameter_error_char
      module procedure parameter_error_real
      module procedure parameter_error_real1d
      module procedure parameter_error_dp
      module procedure parameter_error_dp1d
      module procedure parameter_error_log
   end interface parameter_error

contains

   !================================================================================
   ! Finalize the program
   !
   subroutine finalize(ierr)
      implicit none
      integer, intent(in) :: ierr
#ifndef MW_SERIAL
      integer :: mpierr
      call MPI_Abort(MPI_COMM_WORLD,ierr,mpierr)
#else
      if (ierr == 0) then
         stop 0
      else
         stop 1
      end if
#endif
   end subroutine finalize

   !================================================================================
   ! Handle allocation errors
   !
   subroutine allocate_error(subroutine_name, file_name, ierr)
      implicit none

      character(len=*), intent(in) :: subroutine_name ! name of the calling subroutine
      character(len=*), intent(in) :: file_name       ! file name of the calling subroutine
      integer,          intent(in) :: ierr            ! allocate returned status

      write(MW_stderr, '("[error]...Allocation failed with return status ", i5)') ierr
      write(MW_stderr, '("          subroutine: ",a)') trim(subroutine_name)
      write(MW_stderr, '("          file: ",a)') trim(file_name)

      call finalize(1)
   end subroutine allocate_error

   !================================================================================
   ! Handle deallocation errors
   !
   subroutine deallocate_error(subroutine_name, file_name, ierr)
      implicit none

      character(len=*), intent(in) :: subroutine_name ! name of the calling subroutine
      character(len=*), intent(in) :: file_name       ! file name of the calling subroutine
      integer,          intent(in) :: ierr            ! deallocate returned status

      write(MW_stderr, '("[error]...Deallocation failed with return status ", i3)') ierr
      write(MW_stderr, '("          subroutine: ",a)') trim(subroutine_name)
      write(MW_stderr, '("          file: ",a)') trim(file_name)

      call finalize(1)
   end subroutine deallocate_error

   !================================================================================
   ! Handle invalid integer parameter errors
   !
   subroutine parameter_error_int(subroutine_name, file_name, &
         parameter_name, parameter_value)

      implicit none

      character(len=*), intent(in) :: subroutine_name ! name of the calling subroutine
      character(len=*), intent(in) :: file_name       ! file name of the calling subroutine
      character(len=*), intent(in) :: parameter_name  ! name of the invalid parameter
      integer,          intent(in) :: parameter_value ! value of the invalid parameter

      write(MW_stderr, '("[error]...Invalid parameter ",a," with value ",i6)') &
            parameter_name, parameter_value
      write(MW_stderr, '("          subroutine: ",a)') trim(subroutine_name)
      write(MW_stderr, '("          file: ",a)') trim(file_name)

      call finalize(1)
   end subroutine parameter_error_int

   !================================================================================
   ! Handle invalid logical parameter errors
   !
   subroutine parameter_error_log(subroutine_name, file_name, &
         parameter_name, parameter_value)

      implicit none

      character(len=*), intent(in) :: subroutine_name ! name of the calling subroutine
      character(len=*), intent(in) :: file_name       ! file name of the calling subroutine
      character(len=*), intent(in) :: parameter_name  ! name of the invalid parameter
      logical,          intent(in) :: parameter_value ! value of the invalid parameter

      write(MW_stderr, '("[error]...Invalid parameter ",a," with value ",i6)') &
            parameter_name, parameter_value
      write(MW_stderr, '("          subroutine: ",a)') trim(subroutine_name)
      write(MW_stderr, '("          file: ",a)') trim(file_name)

      call finalize(1)
   end subroutine parameter_error_log

   !================================================================================
   ! Handle invalid character parameter errors
   !
   subroutine parameter_error_char(subroutine_name, file_name, &
         parameter_name, parameter_value)

      implicit none

      character(len=*), intent(in) :: subroutine_name ! name of the calling subroutine
      character(len=*), intent(in) :: file_name       ! file name of the calling subroutine
      character(len=*), intent(in) :: parameter_name  ! name of the invalid parameter
      character(len=*), intent(in) :: parameter_value ! value of the invalid parameter

      write(MW_stderr, '("[error]...Invalid parameter ",a," with value ",a)') &
            parameter_name, parameter_value
      write(MW_stderr, '("          subroutine: ",a)') trim(subroutine_name)
      write(MW_stderr, '("          file: ",a)') trim(file_name)

      call finalize(1)
   end subroutine parameter_error_char

   !================================================================================
   ! Handle invalid real parameter errors
   !
   subroutine parameter_error_real(subroutine_name, file_name, &
         parameter_name, parameter_value)

      implicit none

      character(len=*), intent(in) :: subroutine_name ! name of the calling subroutine
      character(len=*), intent(in) :: file_name       ! file name of the calling subroutine
      character(len=*), intent(in) :: parameter_name  ! name of the invalid parameter
      real,             intent(in) :: parameter_value ! value of the invalid parameter

      write(MW_stderr, '("[error]...Invalid parameter ",a," with value ",es12.5)') &
            parameter_name, parameter_value
      write(MW_stderr, '("          subroutine: ",a)') trim(subroutine_name)
      write(MW_stderr, '("          file: ",a)') trim(file_name)

      call finalize(1)
   end subroutine parameter_error_real

   !================================================================================
   ! Handle invalid real 1d array parameter errors
   !
   subroutine parameter_error_real1d(subroutine_name, file_name, &
         parameter_name, parameter_value)

      implicit none

      character(len=*), intent(in) :: subroutine_name ! name of the calling subroutine
      character(len=*), intent(in) :: file_name       ! file name of the calling subroutine
      character(len=*), intent(in) :: parameter_name  ! name of the invalid parameter
      real,             intent(in) :: parameter_value(:) ! value of the invalid parameter

      write(MW_stderr, '("[error]...Invalid parameter ",a," with value ",1000es12.5)') &
            parameter_name, parameter_value
      write(MW_stderr, '("          subroutine: ",a)') trim(subroutine_name)
      write(MW_stderr, '("          file: ",a)') trim(file_name)

      call finalize(1)
   end subroutine parameter_error_real1d

   !================================================================================
   ! Handle invalid real parameter errors
   !
   subroutine parameter_error_dp(subroutine_name, file_name, &
         parameter_name, parameter_value)

      implicit none

      character(len=*), intent(in) :: subroutine_name ! name of the calling subroutine
      character(len=*), intent(in) :: file_name       ! file name of the calling subroutine
      character(len=*), intent(in) :: parameter_name  ! name of the invalid parameter
      double precision, intent(in) :: parameter_value ! value of the invalid parameter

      write(MW_stderr, '("[error]...Invalid parameter ",a," with value ",es12.5)') &
            parameter_name, parameter_value
      write(MW_stderr, '("          subroutine: ",a)') trim(subroutine_name)
      write(MW_stderr, '("          file: ",a)') trim(file_name)

      call finalize(1)
   end subroutine parameter_error_dp

   !================================================================================
   ! Handle invalid real 1d array parameter errors
   !
   subroutine parameter_error_dp1d(subroutine_name, file_name, &
         parameter_name, parameter_value)

      implicit none

      character(len=*), intent(in) :: subroutine_name ! name of the calling subroutine
      character(len=*), intent(in) :: file_name       ! file name of the calling subroutine
      character(len=*), intent(in) :: parameter_name  ! name of the invalid parameter
      double precision, intent(in) :: parameter_value(:) ! value of the invalid parameter

      write(MW_stderr, '("[error]...Invalid parameter ",a," with value ",1000es12.5)') &
            parameter_name, parameter_value
      write(MW_stderr, '("          subroutine: ",a)') trim(subroutine_name)
      write(MW_stderr, '("          file: ",a)') trim(file_name)

      call finalize(1)
   end subroutine parameter_error_dp1d


   !================================================================================
   ! Runtime error
   !
   subroutine runtime_error(subroutine_name, file_name, errmsg)

      implicit none

      character(len=*), intent(in) :: subroutine_name ! name of the calling subroutine
      character(len=*), intent(in) :: file_name       ! file name of the calling subroutine
      character(len=*), intent(in) :: errmsg          ! simple error message
      print*, "MW_STDERR = ", MW_stderr,MW_stdout 

      write(MW_stderr, '("[error]...",a)') errmsg
      write(MW_stderr, '("          subroutine: ",a)') trim(subroutine_name)
      write(MW_stderr, '("          file: ",a)') trim(file_name)

      call finalize(1)
   end subroutine runtime_error

   !================================================================================
   ! Runtime warning
   !
   subroutine runtime_warning(subroutine_name, file_name, errmsg)

      implicit none

      character(len=*), intent(in) :: subroutine_name ! name of the calling subroutine
      character(len=*), intent(in) :: file_name       ! file name of the calling subroutine
      character(len=*), intent(in) :: errmsg          ! simple error message
      print*, "MW_WARNING = ", MW_stderr,MW_stdout 

      write(MW_stderr, '("[warning]...",a)') errmsg
      write(MW_stderr, '("          subroutine: ",a)') trim(subroutine_name)
      write(MW_stderr, '("          file: ",a)') trim(file_name)

   end subroutine runtime_warning

   !================================================================================
   ! Temperature warning
   !
   subroutine temperature_warning(errmsg)

      implicit none

      character(len=*), intent(in) :: errmsg          ! simple error message
      print*, "MW_WARNING = ", MW_stderr,MW_stdout 

      write(MW_stderr, '("[warning]...",a)') errmsg

   end subroutine temperature_warning

   

   !================================================================================
   ! I/O open error
   !
   subroutine open_error(subroutine_name, file_name, path, ierr)

      implicit none

      character(len=*), intent(in) :: subroutine_name ! name of the calling subroutine
      character(len=*), intent(in) :: file_name       ! file name of the calling subroutine
      character(len=*), intent(in) :: path            ! path to file failed to open
      integer,          intent(in) :: ierr

      write(MW_stderr, '("[error]...Failed to open file ",a," with return status ",i3)') trim(path), ierr
      write(MW_stderr, '("          subroutine: ",a)') trim(subroutine_name)
      write(MW_stderr, '("          file: ",a)') trim(file_name)

      call finalize(1)
   end subroutine open_error


   !================================================================================
   ! I/O close error
   subroutine close_error(subroutine_name, file_name, funit, ierr)

      implicit none

      character(len=*), intent(in) :: subroutine_name ! name of the calling subroutine
      character(len=*), intent(in) :: file_name       ! file name of the calling subroutine
      integer,          intent(in) :: funit           ! file unit being close
      integer,          intent(in) :: ierr

      write(MW_stderr, '("[error]...Failed to close file unit",i3," with return status ",i3)') funit, ierr
      write(MW_stderr, '("          subroutine: ",a)') trim(subroutine_name)
      write(MW_stderr, '("          file: ",a)') trim(file_name)

      call finalize(1)
   end subroutine close_error

   !================================================================================
   ! Handle mpi call errors
   !
   subroutine mpilib_error(subroutine_name, file_name, &
         mpi_subroutine, ierr)

      implicit none

      character(len=*), intent(in) :: subroutine_name ! name of the calling subroutine
      character(len=*), intent(in) :: file_name       ! file name of the calling subroutine
      character(len=*), intent(in) :: mpi_subroutine  ! name of the mpi subroutine
      integer,          intent(in) :: ierr            ! value returned by the mpi subroutine

      write(MW_stderr, '("[error]...MPI call to ",a," failed with return value ",a)') &
            mpi_subroutine, ierr
      write(MW_stderr, '("          subroutine: ",a)') trim(subroutine_name)
      write(MW_stderr, '("          file: ",a)') trim(file_name)

      call finalize(1)
   end subroutine mpilib_error

end module MW_errors
