subroutine debug_flag_a( dl, cmod, cpro, nx, ny, nz, aval )
! 実数配列変数を返す手続きについて, debug level ごとに処理.
  implicit none
  integer, intent(in) :: dl                    ! debug level
  ! 0 = 何もしない, 1 = NaN 値が入っていると警告
  character(*), intent(in) :: cmod      ! モジュール名
  character(*), intent(in) :: cpro      ! 手続き名
  integer, intent(in) :: nx             ! 第 1 要素の要素数
  integer, intent(in) :: ny             ! 第 2 要素の要素数
  integer, intent(in) :: nz             ! 第 3 要素の要素数
  real, intent(in) :: aval(nx,ny,nz)    ! 手続きが返した値

  select case (dl)
  case (1)
     call nan_check_a( trim(cmod), trim(cpro), nx, ny, nz, aval )
!  case (2)
!     if(present(unity))then
!        call stdio_real( trim(cmod), trim(cpro), rval, trim(unity) )
!     else
!        call stdio_real( trim(cmod), trim(cpro), rval )
!     end if
  end select

end subroutine debug_flag_a

subroutine debug_flag_i( dl, cmod, cpro, ival, unity )
! 整数スカラー変数を返す手続きについて, debug level ごとに処理.
  implicit none
  integer, intent(in) :: dl                    ! debug level
  ! 0 = 何もしない, 1 = NaN 値が入っていると警告, 2 = 値を標準出力
  character(*), intent(in) :: cmod             ! モジュール名
  character(*), intent(in) :: cpro             ! 手続き名
  integer, intent(in) :: ival                  ! 手続きが返した値
  character(*), intent(in), optional :: unity  ! 単位

  select case (dl)
!  case (1)
!     call nan_check_s( trim(cmod), trim(cpro), rval )
  case (2)
     if(present(unity))then
        call stdio_integer( trim(cmod), trim(cpro), ival, trim(unity) )
     else
        call stdio_integer( trim(cmod), trim(cpro), ival )
     end if
  end select

end subroutine debug_flag_i

subroutine debug_flag_r( dl, cmod, cpro, rval, unity )
! 実数スカラー変数を返す手続きについて, debug level ごとに処理.
  implicit none
  integer, intent(in) :: dl                    ! debug level
  ! 0 = 何もしない, 1 = NaN 値が入っていると警告, 2 = 値を標準出力
  character(*), intent(in) :: cmod             ! モジュール名
  character(*), intent(in) :: cpro             ! 手続き名
  real, intent(in) :: rval                     ! 手続きが返した値
  character(*), intent(in), optional :: unity  ! 単位

  select case (dl)
  case (1)
     call nan_check_s( trim(cmod), trim(cpro), rval )
  case (2)
     if(present(unity))then
        call stdio_real( trim(cmod), trim(cpro), rval, trim(unity) )
     else
        call stdio_real( trim(cmod), trim(cpro), rval )
     end if
  end select

end subroutine debug_flag_r

subroutine nan_check_a( cmod, cpro, nx, ny, nz, val )
  ! 実数配列 val の中に nan 値が存在するとエラーを出力する.
  ! 引数の配列は 3 次元であるが, その前の要素数を 1 などに設定することで,
  ! 1, 2 次元の配列に対しても変換可能.
  implicit none
  character(*), intent(in) :: cmod    ! モジュール名
  character(*), intent(in) :: cpro    ! 手続き名
  integer, intent(in) :: nx           ! 第 1 要素の要素数
  integer, intent(in) :: ny           ! 第 2 要素の要素数
  integer, intent(in) :: nz           ! 第 3 要素の要素数
  real, intent(in) :: val(nx,ny,nz)   ! 変換する配列
  integer :: i, j, k, counter  ! 作業用配列

  counter=0

  do k=1,nz
     do j=1,ny
        do i=1,nx
           if(isnan(val(i,j,k)))then
              if(counter==0)then
                 counter=1
                 call stdio_char( 'Detected NaN value.', 'E', cmod=trim(cmod), cpro=trim(cpro) )
                 call stdio_array( 'VAL', (/i, j, k/) )
              else
                 call stdio_array( 'VAL', (/i, j, k/) )
              end if
           end if
        end do
     end do
  end do

end subroutine nan_check_a

subroutine nan_check_s( cmod, cpro, rval )
! 実数を返す手続きについて, 値が nan であればその旨警告する.
  implicit none
  character(*), intent(in) :: cmod   ! モジュール名
  character(*), intent(in) :: cpro   ! 手続き名
  real, intent(in) :: rval           ! 手続きの返した値

  if(isnan(rval))then
     call stdio_char( 'Detected NaN value.', 'E', cmod=trim(cmod), cpro=trim(cpro) )
  end if

end subroutine nan_check_s

subroutine stdio_array( cval, array_num )
! 該当配列の要素番号を出力する.
  implicit none
  character(*), intent(in) :: cval     ! 配列名
  integer, intent(in) :: array_num(:)  ! 各次元の要素番号
  integer :: i, ni, nc
  character(20) :: formal
  character(1000) :: output_char
  character(6) :: i2c, tmpc

  ni=size(array_num)
  nc=len_trim(cval)+ni*7+2

  write(i2c,*) nc
  formal='(a'//trim(adjustl(i2c))//')'

  output_char=trim(cval)//'('

  do i=1,ni
     write(tmpc,'(I6)') array_num(i)
     output_char=trim(adjustl(output_char))//tmpc(1:6)//','
  end do

  output_char(len_trim(output_char):len_trim(output_char))=')'

  write(*,trim(formal)) trim(adjustl(output_char))

end subroutine stdio_array

subroutine stdio_char( cval, cflag, cmod, cpro )
! 手続き名とモジュール名情報を付記しながら, 文字出力を行う.
  implicit none
  character(*), intent(in) :: cval             ! 出力させたいメッセージ
  character(1), intent(in) :: cflag            ! メッセージの種類.
                           ! 'E' = エラー, 'W' = 警告, 'M' = 単なるメッセージ.
  character(*), intent(in), optional :: cmod   ! モジュール名
  character(*), intent(in), optional :: cpro   ! 手続き名
  character(100) :: formal                     ! 出力フォーマット設定用
  character(15) :: tmpc
  integer :: lengc(4)

  if(present(cmod))then
     lengc(1)=len_trim(adjustl(cmod))
     lengc(4)=23
  else
     lengc(1)=0
     lengc(4)=16
  end if

  if(present(cpro))then
     lengc(2)=len_trim(adjustl(cpro))
  else
     lengc(2)=0
  end if

  lengc(3)=len_trim(adjustl(cval))

  select case (cflag(1:1))
  case ('E')
     tmpc='**** ERROR **** '
  case ('W')
     tmpc='*** WARNING *** '
  case ('M')
     tmpc='*** MESSAGE *** '
  end select

  write(formal,*) lengc(1)+lengc(2)+lengc(3)+lengc(4)

  formal='(a'//trim(adjustl(formal))//')'

  if(present(cmod))then
     write(*,formal) trim(adjustl(tmpc))//trim(adjustl(cpro))//' in ' //trim(adjustl(cmod))//' : ', trim(adjustl(cval))
  else
     write(*,formal) trim(adjustl(tmpc))//trim(adjustl(cval))
  end if

end subroutine stdio_char

subroutine stdio_integer( cmod, cpro, ival, unity )
! 整数を返す手続きについて, その値と手続き名を返す.
  implicit none
  character(*), intent(in) :: cmod             ! モジュール名
  character(*), intent(in) :: cpro             ! 手続き名
  integer, intent(in) :: ival                  ! 手続きの返した値
  character(*), intent(in), optional :: unity  ! 単位
  character(100) :: formal                     ! 出力フォーマット設定用
  character(20) :: unitc
  integer :: lengc(3)

  lengc(1)=len_trim(adjustl(cmod))
  lengc(2)=len_trim(adjustl(cpro))

  if(present(unity))then

     lengc(3)=len_trim(adjustl(unity))

     write(formal,*) lengc(1)+lengc(2)+lengc(3)+15
     write(unitc,*) lengc(3)+3

     formal='(a'//trim(adjustl(formal))//',I8.8,a'//trim(adjustl(unitc))//')'

     write(*,trim(formal)) "DEBUG : "//trim(adjustl(cpro))//' in ' //trim(adjustl(cmod))//' : ', ival, ' ['//trim(adjustl(unity))//']'

  else

     write(formal,*) lengc(1)+lengc(2)+15

     formal='(a'//trim(adjustl(formal))//',I8.8)'

     write(*,trim(formal)) "DEBUG : "//trim(adjustl(cpro))//' in ' //trim(adjustl(cmod))//' : ', ival

  end if

end subroutine stdio_integer

subroutine stdio_real( cmod, cpro, rval, unity )
! 実数を返す手続きについて, その値と手続き名を返す.
  implicit none
  character(*), intent(in) :: cmod             ! モジュール名
  character(*), intent(in) :: cpro             ! 手続き名
  real, intent(in) :: rval                     ! 手続きの返した値
  character(*), intent(in), optional :: unity  ! 単位
  character(100) :: formal                     ! 出力フォーマット設定用
  character(20) :: unitc
  integer :: lengc(3)

  lengc(1)=len_trim(adjustl(cmod))
  lengc(2)=len_trim(adjustl(cpro))

  if(present(unity))then

     lengc(3)=len_trim(adjustl(unity))

     write(formal,*) lengc(1)+lengc(2)+15
     write(unitc,*) lengc(3)+3

     formal='(a'//trim(adjustl(formal))//',1P,E14.5,a'//trim(adjustl(unitc))//')'

     write(*,trim(adjustl(formal))) "DEBUG : "//trim(adjustl(cpro))//' in ' //trim(adjustl(cmod))//' : ', rval, ' ['//trim(adjustl(unity))//']'

  else

     write(formal,*) lengc(1)+lengc(2)+15

     formal='(a'//trim(adjustl(formal))//',1P,E14.5)'

     write(*,trim(formal)) "DEBUG : "//trim(adjustl(cpro))//' in ' //trim(adjustl(cmod))//' : ', rval

  end if

end subroutine stdio_real