! Perrors class for QuickPIC Open Source 1.0
! update: 04/18/2016

      module perrors_class

      use mpi
      use parallel_class
      
      implicit none

      private

      public :: perrors

      type perrors
      
         private
         
         class(parallel), pointer, public :: p => null()
         integer :: eunit = 2
         integer :: monitor = 0
         
         contains
         
         generic :: new => init_perrors
         generic :: del => end_perrors
         procedure, private :: init_perrors
         procedure, private :: end_perrors
         procedure :: equit
         procedure :: werrfl0
         procedure :: werrfl1
         procedure :: werrfl2
         procedure :: setmonitor

      end type perrors

      integer, dimension(4), save :: itime
      double precision, save :: dtime
                  
      contains
!
      subroutine init_perrors(this,prl,eunit,monitor)
         
         implicit none
         
         class(perrors), intent(inout) :: this
         class(parallel), intent(in), pointer :: prl
         integer, intent(in) :: eunit, monitor
! local data
         character(len=20) :: str
         character(len=8) :: cn
         integer :: k, l
         integer :: ierror

         write(str,*) prl%getidproc()
         cn = '00000000'
         str = trim(adjustl(str))
         l = len_trim(str)
         k = 8
         cn(k+1-l:k) = str(1:l)
                                   
         this%p => prl
         this%eunit = eunit
         this%monitor = monitor
         
         if (this%p%getidproc() == 0) then
            
            call system('mkdir ./ELOG')
            
         endif
         
         call MPI_BARRIER(this%p%getlworld(),ierror)
         
         call set_ename(eunit,'./ELOG/elog-'//cn)
         call dtimer(dtime,itime,-1)
               
      end subroutine init_perrors      
!
      subroutine set_ename(eunit,ename)
         
         implicit none
         
! this subroutine sets the name of the error file and opens it
! ename = new error file name
         character(len=*), intent(in) :: ename
         integer, intent(in) :: eunit
         
         open(unit=eunit,file=trim(ename),form='formatted',status='repla&
         &ce')

      end subroutine set_ename
!      
      subroutine end_perrors(this)
      
         implicit none
         
         class(perrors), intent(inout) :: this
         
         close(unit=this%eunit)
      
      end subroutine end_perrors
!
      subroutine equit(this,estr)
! this subroutine handles errors and optionally logs error message
! if estr is present, prepends the node number to the output string
! how = keyword on how to handle error
! estr = optional error message string to be logged in error file
         implicit none

         class(perrors), intent(in) :: this
         character(len=*), intent(in), optional :: estr      
! loccal data
         character(len=20) :: tstr
         integer :: ierror

         call dtimer(dtime,itime,1)
         write (tstr,'(f12.3)') dtime
         if (present(estr)) write (this%eunit,*) trim(tstr)//" : "//trim(adjustl(estr))
         flush(this%eunit)
         call MPI_ABORT(this%p%getlworld(),1,ierror)
!         call MPI_FINALIZE(ierror)
         print *, 'Error!'
         stop

      end subroutine equit
!      
      subroutine werrfl0(this,estr)
! this subroutine handles error message on level 0
         implicit none

         class(perrors), intent(in) :: this
         character(len=*), intent(in) :: estr
! local data
         character(len=20) :: tstr
                  
         call dtimer(dtime,itime,1)
         write (tstr,'(f12.3)') dtime
         write (this%eunit,*) trim(tstr)//" : "//trim(adjustl(estr))
         flush(this%eunit)
         
      end subroutine werrfl0
!      
      subroutine werrfl1(this,estr)
! this subroutine handles error message on level 1
         implicit none

         class(perrors), intent(in) :: this
         character(len=*), intent(in) :: estr
! local data
         character(len=20) :: tstr

         if (this%monitor < 1) then
            
            return
            
         else
            call dtimer(dtime,itime,1)
            write (tstr,'(f12.3)') dtime
            write (this%eunit,*) trim(tstr)//" : "//trim(adjustl(estr))
            flush(this%eunit)
         
         endif
         
      end subroutine werrfl1
!      
      subroutine werrfl2(this,estr)
! this subroutine handles error message on level 2
         implicit none

         class(perrors), intent(in) :: this
         character(len=*), intent(in) :: estr
! local data
         character(len=20) :: tstr

         if (this%monitor < 2) then
            
            return
            
         else
            call dtimer(dtime,itime,1)
            write (tstr,'(f12.3)') dtime
            write (this%eunit,*) trim(tstr)//" : "//trim(adjustl(estr))
            flush(this%eunit)
         
         endif
         
      end subroutine werrfl2
!      
      subroutine setmonitor(this,moniter)
 
         implicit none

         class(perrors), intent(inout) :: this
         integer, intent(in) :: moniter
         
         this%monitor = moniter
      
      end subroutine
!
      end module perrors_class
