gray/src/errcodes.f90

84 lines
2.7 KiB
Fortran

module errcodes
implicit none
integer, parameter :: pnpl = 0, lnpl = 2 ! N// too large (2 thresholds)
integer, parameter :: pconv = pnpl + lnpl, lconv = 2 ! Disp. convergence (disabled/failed)
integer, parameter :: pnprre = pconv + lconv, lnprre = 1 ! Re(Nperp)<0
integer, parameter :: palph = pnprre+ lnprre, lalph = 1 ! alpha<0
integer, parameter :: pcdfp = palph + lalph, lcdfp = 1 ! fpp integration
integer, parameter :: pcdfc = pcdfp + lcdfp, lcdfc = 3 ! fcur integration (no trap/trap 1/trap 2)
contains
subroutine check_err(ierr,istop)
implicit none
! arguments
integer, intent(in) :: ierr
integer, intent(inout) :: istop
! if(ibits(ierr,pnpl, lnpl )>1 .or. & ! N// too large
! ibits(ierr,palph,lalph)==1) then ! alpha < 0
! istop = 1
! else
! istop = 0
! end if
! if(ibits(ierr,pnpl, lnpl )>1) istop = 1 ! N// too large
if(ibits(ierr,palph,lalph)==1) istop = 1 ! alpha < 0
end subroutine check_err
subroutine print_errn(ierr,i,anpl)
use const_and_precisions, only : wp_
implicit none
! arguments
integer, intent(in) :: ierr,i
real(wp_), intent(in) :: anpl
! local variables
integer :: ierrs
ierrs = ibits(ierr,pnpl,lnpl)
if(ierrs/=0) print*,i,' IERR = ', ierrs*2**pnpl,' N// = ',anpl
end subroutine print_errn
subroutine print_errhcd(ierr,i,anprre,anprim,alpha)
use const_and_precisions, only : wp_
implicit none
! arguments
integer, intent(in) :: ierr,i
real(wp_), intent(in) :: anprre,anprim,alpha
! local variables
integer :: ierrs
ierrs=ibits(ierr,pconv,lconv)
if(ierrs==1) then
print*,i,' IERR = ', ierrs*2**pconv,' Nwarm = ',anprre,anprim, &
': convergence disabled.'
else if(ierrs==2) then
print*,i,' IERR = ', ierrs*2**pconv,' Nwarm = ',anprre,anprim, &
': convergence failed.'
end if
ierrs=ibits(ierr,pnprre,lnprre)
if(ierrs/=0) &
print*,i,' IERR = ', ierrs*2**pnprre,' Nwarm = ',anprre,anprim, &
': Re(Nwarm)<0 or Nwarm**2 invalid.'
ierrs=ibits(ierr,palph,lalph)
if(ierrs/=0) &
print*,i,' IERR = ', ierrs*2**palph,' alpha = ',alpha
ierrs=ibits(ierr,pcdfp,lcdfp)
if(ierrs/=0) &
print*,i,' IERR = ', ierrs*2**pcdfp,' fpp integration error'
ierrs=ibits(ierr,pcdfc,lcdfc)
if(ibits(ierrs,0,1)/=0) &
print*,i,' IERR = ', ierrs*2**pcdfc,' fcur integration error (no trapping)'
if(ibits(ierrs,1,1)/=0) &
print*,i,' IERR = ', ierrs*2**pcdfc,' fcur integration error (1st trapping region)'
if(ibits(ierrs,2,1)/=0) &
print*,i,' IERR = ', ierrs*2**pcdfc,' fcur integration error (2nd trapping region)'
end subroutine print_errhcd
end module errcodes