!=======================================================================
!
!  PROGRAM  PHASE/0 2014.03 ($Rev: 409 $)
!
!  MODULE:  m_Timing
!
!  AUTHOR(S): T. Yamasaki   August/20/2003
!  
!  FURTHER MODIFICATION: T. Yamasaki, January/13/2004
!  FURTHER MODIFICATION: T. Yamasaki, September 2009
!  
!  Contact address :  Phase System Consortium
!                     E-mail: phase_system@nims.go.jp URL https://azuma.nims.go.jp
!  
!
!
!=======================================================================
!
!     The original version of this set of the computer programs "PHASE"
!  was developed by the members of the Theory Group of Joint Research
!  Center for Atom Technology (JRCAT), based in Tsukuba, in the period
!  1993-2001.
!
!     Since 2002, this set has been tuned and new functions have been
!  added to it as a part of the national project "Frontier Simulation 
!  Software for Industrial Science (FSIS)",  which is supported by
!  the IT program of the Ministry of Education, Culture, Sports,
!  Science and Technology (MEXT) of Japan. 
!     Since 2006, this program set has been developed as a part of the
!  national project "Revolutionary Simulation Software (RSS21)", which
!  is supported by the next-generation IT program of MEXT of Japan.
!   Since 2013, this program set has been further developed centering on PHASE System
!  Consortium.
!   The activity of development of this program set has been supervised by Takahisa Ohno.
!
!
!tex--\documentstyle{jarticle}
!tex--\title{module m\_Timing}
!tex--\author{T. Yamasaki}
!tex--\textwidth 480pt
!tex--\oddsidemargin -10pt
!tex--\evensidemargin 0pt
!tex--\begin{document}
!tex--\maketitle
!tex--\newenvironment{mydescription}{%
!tex--	\list{$\bullet$}{%
!tex--		\topsep 0pt \itemsep 0pt }}%
!tex--{\endlist}
!tex--
module m_Timing
!
!
! ***************************************************************
!  $Id: m_Timing.F90 409 2014-10-27 09:24:52Z jkoga $
!
!  The first version of this module was coded by T. Yamasaki 
! (JRCAT-ATP, FUJITSU LABORATORIES Ltd.) in 1999.
!
!tex--\section{��ǽ����}
!tex--  ���֥롼�����衢���뤤�ϣ�-iteraion�λ��֤�¬�ꤷ��ɽ�����롣
!tex--\section{Using modules}
  use m_Control_Parameters, only : ipri, ipritiming, printable,num_subroutines, pcpudf &
       &                         , statistics_in_parallel, sw_flatten, sw_firstlevel_only, sw_details &
       &                         , measure_count_limit
  use m_Const_Parameters,   only : DP, ON, OFF, START,ITERATIVE,FINISH,TAG_FORMAT,TAG_LINE,TABLE
  use m_Parallelization,    only : mpi_comm_group,npes, mype, ierr

  implicit none

!tex--\section{Parameters,variables,arrays}
!tex--\subsection{Public}
!tex--   none
!tex--\subsection{Private}
!tex--\begin{itemize}
!tex--      \item {\tt [MSBRNM]:} ����¬��򤹤�subroutine�κ����
!tex--      \item {\tt [long\_name\_size]:} ����{\tt subroutine\_names}�γ����Ǥ�����ʸ���
!tex--      \item {\tt [subroutine\_names]:} suburoutine̾���ߤ�������
!tex--      \item {\tt [tstart] (0:MSBRNM):} ¬�곫�ϻ�����ߤ�������
!tex--      \item {\tt [ecpu] (0:MSBRNM):} ¬�ꤷ���в���֤��ߤ�������{\tt ecpu(0)}��
!tex--            ��SCF����ʬ�ηв���֤��ߤ����롣
!tex--      \item {\tt [iorder] (MMSBRM):} ¬����֤��礭���ν���Ϳ��������
!tex--      \item {\tt [n\_sub\_names]:} ¬�ꤷ��subroutine�ο�
!tex--      \item {\tt [PCPUDF = 0.03]:} SCF-iteration�ηв���֤�����ηв����
!tex-- ({\tt ecpu\_previous})�Ȥκ���{\tt PCPUDF}$\times${\tt ecpu\_previous}����礭���Ȥ���
!tex-- ¬���̤�񤭽Ф���{\tt subroutine tstatc\_wd}����Ѥ��롣
!tex--      \item {\tt [N\_SUBROUTINES] = 10:} {\tt subroutine tstatc\_wd}�ǽ񤭽Ф�subroutine�ο��ξ��
!tex--\end{itemize}
  integer, private, parameter                            :: MSBRNM         = 100
  integer, private, parameter                            :: MSBRNM_EXT     = 10
  integer, private, parameter                            :: INCRE_MSBRNM   = 10
  integer, private, parameter                            :: long_name_size = 32
  character(len=long_name_size),private,dimension(0:MSBRNM) :: subroutine_names
  integer, private, dimension(0:MSBRNM)                  :: subroutine_name_length
  character(len=long_name_size),private                     :: temp_str
  real(DP),private, dimension(0:MSBRNM)                  :: tstart=0, ecpu=0
  integer, private, dimension(MSBRNM)                    :: iorder, counter=0
  integer, private, dimension(MSBRNM)                    :: ilevel=-1
  integer, private                                       :: levelset = OFF
  integer, private                                       :: n_sub_names = 0
  real(DP),private               :: ecpu_previous = 0.d0
  real(DP),private, parameter    :: UMICRO = 1.d-6
  integer, private :: switch_of_timing = OFF
  real(DP),private :: wct_start = 0.d0
! --> T. Yamasaki, 2th Sep. 2009
  integer, private :: id_ext, id_ext_max = 0, n_allocated_subhir = 0
  integer, private, dimension(MSBRNM_EXT) :: id_ext_stack=0
  integer, private :: id_ext_pointer = 0
  type t_subhir
     integer :: id
     integer :: level
     integer :: id1
     integer :: id2
     integer :: id3
     integer :: flag
  end type t_subhir
  type(t_subhir), allocatable,  dimension(:) :: subhir
  integer,private :: level_previous,level_now=0, id123_now(1:3)=0
  real(kind=DP),private,allocatable,dimension(:) :: ecpu_ext
  integer, private, allocatable, dimension(:) :: counter_ext
  integer, private, allocatable, dimension(:) :: ip_1stlevel_subroutines
  integer :: n_1stlevel_subroutines
  integer, private, parameter :: MODE_EVALUATION = 1, MODE_WRITE = 2, MODE_SINGLE=1, MODE_PARALLEL = 2
! <--
     
!!$  real(DP),private, parameter    :: PCPUDF = 0.03
!!$  integer, private, parameter    :: N_SUBROUTINES = 20

!tex--\section{�ޤޤ��subroutines}
!tex-- {\tt a)tstatc0\_begin, b)tstatc0\_end, c)tstatc\_init, d)tstatc\_wd0, e)tstatc\_wd, f)tstatc\_iter}
!tex--
!tex--\section{�Ȥ���}
!tex--¬�ꤷ����subroutine�Ǥϡ��ǽ�˼�����Τ褦��{\tt tstatc0\_begin}��ƤӽФ�
!tex--\begin{verbatim}
!tex--    integer :: id_sname = -1
!tex--    call tstatc0_begin('FFT_WF ',id_sname)
!tex--\end{verbatim}
!tex--�Ǹ��
!tex--\begin{verbatim}
!tex--    call tstatc0_end(id_sname)
!tex--\end{verbatim}
!tex--��{\tt tstatc0\_end}��ƤӽФ�������ˤ�ꡢ{\tt FFT\_WF}���б�����
!tex--�����{\tt tstatc0\_begin}��{\tt tstatc0\_end}�δ֤ηв���֤��ä����롣
!tex--SCF�Σ���ηв���֤ϡ�{\tt tstatc\_iter}��ƤӽФ����Ȥ�¬���롣
!tex--SCF-iteration�ν����{\tt tstatc\_wd}��ƤӽФ��ȡ������
!tex--SCF����ʬ�ηв���֤Ȥκ���3��({\tt PCPUDF})�ʾ夢��С��в����
!tex--��Ĺ���ä����10��(={\tt N\_SUBROUTINES})��
!tex--subroutine��̾���ȷв���֡��ޤ����β�ηв���֤���Ϥ��롣
!tex--����Ū�ˤϡ�SCF-iteration�ν���˼��Τ褦�ˤ��롣
!tex--\begin{verbatim}
!tex--  call tstatc_iter(iteration, first_iteration_of_this_job)
!tex--  if(iteration == first_iteration_of_this_job) then
!tex--     call tstatc_wd0
!tex--  else
!tex--     call tstatc_wd(iteration)
!tex--  end if
!tex--  call tstatc_init
!tex--\end{verbatim}
!tex--{\tt call tstatc\_wd(iteration)}�ˤ�꼡�Τ褦�ʽ��Ϥ����롣
!tex--\begin{verbatim}
!tex-- << CPU Time Consumption -- TOP  10 Subroutines (    2) >>
!tex--   1  26                           FFT_WF     1.79200(sec.) 52.58(%)
!tex--   2  31      evolve_WFs_in_MSD_direction     1.04297(sec.) 30.60(%)
!tex--   3  17                     xc_potential     0.94531(sec.) 27.74(%)
!tex--   4  19               ggaxcp(in xc_pot.)     0.89258(sec.) 26.19(%)
!tex--   5  28              energy_eigen_values     0.57715(sec.) 16.93(%)
!tex--   6  33                      CD_softpart     0.49121(sec.) 14.41(%)
!tex--   7  36   Total_Energy(including xc_pot)     0.47168(sec.) 13.84(%)
!tex--   8  18                   inverse_FFT_CD     0.23242(sec.)  6.82(%)
!tex--   9  20                    direct_FFT_CD     0.14356(sec.)  4.21(%)
!tex--  10  34                      CD_hardpart     0.13574(sec.)  3.98(%)
!tex--      Total cpu time of (        2 )-th iteration        3.40820(sec.)
!tex--\end{verbatim}
!tex--\end{document}
  include 'mpif.h'
contains
  subroutine tstatc0_begin(a_sub_name,id,level)
    character(len=*), intent(in) :: a_sub_name
    integer, intent(inout) ::       id
    integer, intent(in), optional :: level

    real(kind=DP)             :: t_start
    integer                   :: i, len_str

    if(switch_of_timing == OFF) then
       call gettod(wct_start)
       switch_of_timing = ON
    end if

    if(sw_firstlevel_only == ON .and. sw_details == OFF) then
         if(.not.present(level)) then
           return
         else
           if(level/=1) return
         end if
    end if
!      & (.not.present(level).or.(present(level).and.level/=1))) return

    len_str = len_trim(a_sub_name)
    if(len_str > long_name_size) len_str = long_name_size

! -- finding the pointer in subroutine_names --'
    if(id <= 0) then
       do i = 1, n_sub_names
!!$          if(a_sub_name(1:len_str) == subroutine_names(i)(1:len_str)) then
          if(  len_str == subroutine_name_length(i) .and. &
               & a_sub_name(1:len_str) == subroutine_names(i)(1:len_str)) then
             id = i
              exit
          end if
       end do
    end if
    if(id <= 0) then
       if( n_sub_names < MSBRNM) then
          n_sub_names = n_sub_names + 1
          id          = n_sub_names
          write(subroutine_names(id),'(a32)') a_sub_name
          subroutine_name_length(id) = len_str
       else
          if(printable) write(6,'(" !! Size of an array of subroutine_names should be enlarged (->m_Timing)")')
       end if
    end if


    if(id >= 1 .and. id <= MSBRNM) then
       if(measure_count_limit > 0 .and. counter(id) > measure_count_limit) then
       else
          call gettod(t_start)
          tstart(id) = t_start
       end if
       if(sw_firstlevel_only == ON .or. (sw_firstlevel_only==OFF .and. sw_flatten==OFF)) then
          if(present(level) .and. ilevel(id)==-1) then
             ilevel(id) = level
             if(level/=-1 .and. levelset==OFF) levelset = ON
          end if
       end if
    end if

    if(sw_details == ON) then
       call alloc_subhir()
       call setlevels() ! --> level_now, level_previous, id123_now
       call search_id_ext() ! --> id_ext
       if(id_ext > id_ext_max) then
          subhir(id_ext)%id    = id
          subhir(id_ext)%level = level_now
          if(level_now==1) subhir(id_ext)%id1 = 0
          if(level_now>=2) subhir(id_ext)%id1 = id123_now(1)
          if(level_now>=3) subhir(id_ext)%id2 = id123_now(2)
          if(level_now>=4) subhir(id_ext)%id3 = id123_now(3)
          id_ext_max = id_ext
       end if
!!$       id_ext_pointer = min(id_ext_pointer + 1, MSBRNM_EXT)
!!$       id_ext_pointer = id_ext_pointer + 1
       id_ext_pointer = level_now
       if(id_ext_pointer <= MSBRNM_EXT) id_ext_stack(id_ext_pointer) = id_ext
    end if

    if(ipritiming >= 2 .and. printable) call wd_the_subroutine_name
!!$   if(ipri >= 2) print '(" <<< ",a32," >>>")',subroutine_names(id)
  contains
    subroutine search_id_ext()
      integer :: i
      id_ext = 0
      if(id_ext_max == 0) then
         if(id>=1) then
            id_ext = 1
         end if
      else
         if(level_now <= 1) then
            do i = 1, id_ext_max
               if(subhir(i)%id == id) then
                  id_ext = i
                  exit
               end if
            end do
         else
            do i = 1, id_ext_max
               if(subhir(i)%id == id .and. subhir(i)%level == level_now) then
!!$                  if((subhir(i)%level == level_now).and.(subhir(i)%id1 == id123_now(1))) then
                  if(subhir(i)%id1 == id123_now(1)) then
                     id_ext = i
                     exit
                  end if
               end if
            end do
         end if
         if(id_ext == 0) id_ext = id_ext_max+1
      end if
    end subroutine search_id_ext

    subroutine setlevels()
      if(present(level)) then
         level_previous = level_now
         level_now = level
         if(level_now >= 1 .and. level_now <= 3) id123_now(level_now) = id
      else
         if(level_now >= 0) then
            level_previous = level_now
            level_now = level_now+1
            if(level_now >= 1 .and. level_now <= 3) id123_now(level_now) = id
         end if
      end if
    end subroutine setlevels
      
    subroutine alloc_subhir()
      type(t_subhir), allocatable,  dimension(:) :: subhir2
      real(kind=DP),allocatable, dimension(:) :: ecpu2
      integer, allocatable, dimension(:) :: counter2
      if(.not.allocated(subhir)) then
         allocate(subhir(MSBRNM_EXT))
         do i = 1, MSBRNM_EXT
            subhir(i)%id = 0
            subhir(i)%level = 0
            subhir(i)%id1 = 0
            subhir(i)%id2 = 0
            subhir(i)%id3 = 0
            subhir(i)%flag = 0
         end do
         allocate(ecpu_ext(MSBRNM_EXT)); ecpu_ext = 0.d0
         allocate(counter_ext(MSBRNM_EXT)); counter_ext = 0
         n_allocated_subhir = MSBRNM_EXT
      else if(id_ext_max >= n_allocated_subhir) then
         allocate(subhir2(id_ext_max))
         allocate(ecpu2(id_ext_max))
         allocate(counter2(id_ext_max))
         if(allocated(subhir)) then
            subhir2 = subhir
            deallocate(subhir)
            n_allocated_subhir = n_allocated_subhir+INCRE_MSBRNM
            allocate(subhir(n_allocated_subhir))
            subhir(1:min(id_ext_max,n_allocated_subhir)) = subhir2(1:min(id_ext_max,n_allocated_subhir))
            do i = min(id_ext_max, n_allocated_subhir)+1, n_allocated_subhir
               subhir(i)%id = 0
               subhir(i)%level = 0
               subhir(i)%id1 = 0
               subhir(i)%id2 = 0
               subhir(i)%id3 = 0
               subhir(i)%flag = 0
            end do
         end if
         if(allocated(ecpu_ext)) then
            ecpu2 = ecpu_ext
            deallocate(ecpu_ext)
            allocate(ecpu_ext(n_allocated_subhir)); ecpu_ext = 0.d0
            ecpu_ext(1:min(id_ext_max,n_allocated_subhir)) = ecpu2(1:min(id_ext_max,n_allocated_subhir))
         end if
         if(allocated(counter_ext)) then
            counter2 = counter_ext
            deallocate(counter_ext)
            allocate(counter_ext(n_allocated_subhir)); counter_ext = 0
            counter_ext(1:min(id_ext_max,n_allocated_subhir)) = counter2(1:min(id_ext_max,n_allocated_subhir))
         end if
         deallocate(counter2)
         deallocate(ecpu2)
         deallocate(subhir2)
      end if
    end subroutine alloc_subhir
         
    subroutine wd_the_subroutine_name
      integer :: i, ip
      ip = long_name_size - len_str
      ip = ip / 2
      do i = 1, ip
         temp_str(i:i) = '-'
      end do
      do i = 1, len_str
         temp_str(i+ip:i+ip) = a_sub_name(i:i)
      end do
      do i = ip + len_str + 1, long_name_size
         temp_str(i:i) = '-'
      end do
      write(6,'(" <<<",a32,">>> (",i3,"), level_now = ",i3)') temp_str,ilevel(id), level_now
    end subroutine wd_the_subroutine_name
  end subroutine tstatc0_begin

  subroutine tstatc0_end(id)
    integer, intent(in) :: id
    real(kind=DP) :: t_end, t_used

    if(id==-1)  return

    if(measure_count_limit > 0 .and. counter(id) >measure_count_limit) then
       t_used = 0.d0
    else
       call gettod(t_end)
       t_used = t_end - tstart(id)
       ecpu(id) = ecpu(id) + t_used * UMICRO
    end if
    counter(id) = counter(id) + 1

    if(sw_details == ON) then
       if(level_now >= 1) then
          level_previous = level_now
          level_now = level_now-1
       end if
       if(id_ext_pointer >=1 .and. id_ext_pointer <= MSBRNM_ext) then
          id_ext = id_ext_stack(id_ext_pointer)
          if(id_ext >=1 .and. id_ext <= n_allocated_subhir) then
             ecpu_ext(id_ext) = ecpu_ext(id_ext) + t_used *UMICRO
             counter_ext(id_ext) = counter_ext(id_ext) + 1
          end if
       else
          id_ext = 0
       end if
!!$       id_ext_pointer = id_ext_pointer-1
       id_ext_pointer = level_now
       if(ipritiming >= 2 .and. printable) call wd_the_subroutine_name2
    end if

    if(ipritiming >= 2 .and. printable) call wd_the_subroutine_name
  contains
    subroutine wd_the_subroutine_name
      write(6,'(" >>>",a32,"<<<")') subroutine_names(id)
    end subroutine wd_the_subroutine_name
    subroutine wd_the_subroutine_name2
      write(6,'(" >>>",a32,"<<< id_ext, id_ext_pointer = ",i5,i5)') subroutine_names(id), id_ext, id_ext_pointer
    end subroutine wd_the_subroutine_name2
    
  end subroutine tstatc0_end

  subroutine tstatc_init
    tstart(1:MSBRNM) = 0.d0; ecpu(1:MSBRNM) = 0.d0; counter(1:MSBRNM) = 0
    if(sw_details == ON) then
       if(allocated(ecpu_ext)) ecpu_ext = 0.d0
       if(allocated(counter_ext)) counter_ext = 0
       id_ext_max = 0
    end if
  end subroutine tstatc_init

  subroutine tstatc_wd0
    integer :: i, ip, nsub, in, nsub0, npmax, npmin
    real(kind=DP) :: cpu_used, wct_now &
         & , cputmax, cputmin, cputmean, cputvariance, cputstddevia
    real(kind=DP), allocatable, dimension(:,:) :: ecpu_wk, ecpu_sorted
    integer, allocatable, dimension(:) :: iorder_p
    integer :: ipri0, lev, levmax, inu, j, num_sub_wd, cput_mode

    ipri0 = ipritiming
    call mpi_bcast(ipri0,1,mpi_integer,0,mpi_comm_group,ierr)
    if(ipri0<=0) return

    if(measure_count_limit > 0) call correct_ecpu() ! counter,measure_count_limit,ecpu-> ecpu
    call tsort(ecpu(1),MSBRNM,iorder)

    nsub = n_sub_names

    if(levelset == ON) then
       levmax = 2
       if(sw_firstlevel_only==ON) levmax = 1
    else
       levmax = 1
    end if

    if(statistics_in_parallel == 1 .and. npes >= 2) then
       cput_mode = MODE_PARALLEL
       if(mype == 0) then
          nsub0 = 0 
          do i = 1, nsub
             if(ecpu(iorder(i)) < UMICRO) exit
             nsub0 = i
          end do
       end if
       call mpi_bcast(nsub0,1,mpi_integer,0,mpi_comm_group,ierr)
       allocate(iorder_p(nsub0))
       if(mype == 0) iorder_p(1:nsub0) = iorder(1:nsub0)
       call mpi_bcast(iorder_p,nsub0,mpi_integer,0,mpi_comm_group,ierr)

       allocate(ecpu_wk(0:npes-1,nsub0)); ecpu_wk = 0.d0
       allocate(ecpu_sorted(0:npes-1,nsub0))
       do i = 1, nsub0
          ip = iorder_p(i)
          ecpu_wk(mype,i) = ecpu(ip)
       end do
       call mpi_allreduce(ecpu_wk, ecpu_sorted,nsub0*npes, mpi_double_precision &
            &            ,mpi_sum, mpi_comm_group,ierr)

    else
       cput_mode = MODE_SINGLE
       nsub0 = 0
       do i = 1, nsub
          if(ecpu(iorder(i)) < UMICRO) exit
          nsub0 = i
       end do
    end if

    do j = MODE_EVALUATION, MODE_WRITE
       if(j==MODE_EVALUATION) num_sub_wd = 0
       if(j==MODE_WRITE) call wd_headerlines()

       do lev = 1, levmax
          if(j==MODE_WRITE) call wd_pauseline()
          inu = 0
          do i = 1, nsub0
             if(cput_mode == MODE_PARALLEL) then
                ip = iorder_p(i)
             else if(cput_mode == MODE_SINGLE) then
                ip = iorder(i)
             end if

             if(levelset == ON) then
                if(levmax >= 2) then
                   if(.not.((lev==levmax .and. ilevel(ip)==-1) .or. (lev<levmax .and. ilevel(ip)==lev))) cycle
                else if(levmax == 1) then
                   if(ilevel(ip)/=lev) cycle
                end if
             end if
             inu = inu + 1

             if(j==MODE_WRITE) then
                if(cput_mode == MODE_PARALLEL) then
                   call cpu_statistics_in_parallel(ecpu_sorted(0,i) &
                        & ,cputmin,cputmax,cputmean,cputvariance,cputstddevia,npmax,npmin)
                   if(printable) write(6,'(2i5,2x,a32,f11.5,i8,4f10.4,3i5)') &
                        & i,ip,subroutine_names(ip),ecpu(ip),counter(ip) &
                        & ,cputmax,cputmin,cputmean,cputstddevia,npmax,npmin,inu
                else
                   if(printable) write(6,'(2i5,2x,a32,f11.5,2i8)') &
                        & i,ip,subroutine_names(ip),ecpu(ip),counter(ip), inu
                end if
             end if
          end do
          if(j==MODE_EVALUATION) num_sub_wd = num_sub_wd+inu
       end do
    end do
    if(cput_mode == MODE_PARALLEL) deallocate(iorder_p,ecpu_sorted,ecpu_wk)

!!$    else
!!$       if(printable) then
!!$          nsub0 = 0
!!$          do i = 1, nsub
!!$             if(ecpu(iorder(i)) < UMICRO) exit
!!$             nsub0 = i
!!$          end do
!!$
!!$          do j = MODE_EVALUATION, MODE_WRITE
!!$             if(j==MODE_EVALUATION) num_sub_wd = 0
!!$             if(j==MODE_WRITE) call wd_headerlines()
!!$
!!$             do lev = 1, levmax
!!$                if(j==MODE_WRITE) call wd_pauseline()
!!$                inu = 0
!!$                do i = 1, nsub0
!!$                   ip = iorder(i)
!!$                   if(levelset == ON) then
!!$                      if(levmax >= 2) then
!!$                         if(.not.((lev==levmax .and. ilevel(ip)==-1) &
!!$                              & .or. (lev<levmax .and. ilevel(ip)==lev))) cycle
!!$                      else if(levmax == 1) then
!!$                         if(ilevel(ip)/=lev) cycle
!!$                      end if
!!$                   end if
!!$                   inu = inu+1
!!$                   if(j==MODE_WRITE .and. printable) then
!!$                      write(6,'(2i5,2x,a32,f11.5,2i8)') &
!!$                           & i,ip,subroutine_names(ip),ecpu(ip),counter(ip), inu
!!$                   end if
!!$                end do
!!$                if(j==MODE_EVALUATION) num_sub_wd = num_sub_wd+inu
!!$             end do
!!$          end do
!!$!!$       if(sw_details == ON) then
!!!$          if(printable) then
!!!$             write(6,'(" --- detail flat---")')
!!!$             write(6,'(" id_ext_max = ", i8)') id_ext_max
!!!$             if(printable) write(6,'("   no",2x," id ","        subroutine name         ","  time(sec) "&
!!!$                  &               ,"  count","   level","   id1")')
!!!$             do i = 1, min(id_ext_max,100)
!!!$                inu = subhir(i)%id
!!!$                if(inu >= 1) write(6,'(i5,2x,i4,a32,f11.5,3i8)') i, inu,subroutine_names(inu) &
!!!$                     & , ecpu_ext(i), counter_ext(i), subhir(i)%level, subhir(i)%id1
!!!$             end do
!!!$          end if
!!!$       end if
!!$       end if
!!$    end if
    call gettod(wct_now)
    cpu_used = (wct_now - wct_start) * UMICRO
    if(printable) write(6,'(" <<Total elapsed CPU Time until now =",f12.5," (sec.)>>")') cpu_used
    if(sw_details == ON .and. printable) call wd_ecpu_details(0)

  contains
    subroutine wd_pauseline()
      if(levelset == ON .and. levmax>1 .and. printable) then
         if(lev < levmax) then
            write(6,'("    --- level ",i3," ---")') lev
         else
            write(6,'("    --- ---")')
         end if
      end if
    end subroutine wd_pauseline
!!$    subroutine wd_headerlines_parallel()
!!$      if(printable) then
!!$         write(6,'(" n_sub_names = ",i5," num_subroutines_statistics = ",i5)') n_sub_names, num_sub_wd
!!$         write(6,'(" << cpu time statistics >>")')
!!$      end if
!!$    end subroutine wd_headerlines_parallel
    subroutine wd_headerlines()
      if(printable) then
         write(6,'(" n_sub_names = ",i5," num_subroutines_statistics = ",i5)') n_sub_names, num_sub_wd
         if(num_sub_wd >=1) then
            write(6,'(" << cpu time statistics >>")')
            if(cput_mode==MODE_SINGLE) then
               write(6,'("  no "," id ",2x,"        subroutine name         ","  time(sec) "&
                    &               ,"  count","   no(2)")')
            else if(cput_mode == MODE_PARALLEL) then
               write(6,'("   no","   ip",2x,"        subroutine name         ","  time(sec) "&
                    &               ,"  count  ", " max_time    min       mean     stddevia" &
                    &  ," nmax nmin  no(2)")')
            end if
         end if
      end if
    end subroutine wd_headerlines

  end subroutine tstatc_wd0

  subroutine cpu_statistics_in_parallel(ecpu_sorted &
       & ,cputmin,cputmax,cputmean,cputvariance,cputstddevia,npmax,npmin)
    real(kind=DP),intent(in),dimension(0:npes-1) :: ecpu_sorted
    real(kind=DP),intent(out)     :: cputmin,cputmax,cputmean,cputvariance,cputstddevia
    integer, intent(out) :: npmax,npmin
    integer :: in

    cputmax = ecpu_sorted(0); npmax = 0
    cputmin = ecpu_sorted(0); npmin = 0
    do in = 1, npes-1
       if(cputmax < ecpu_sorted(in)) then
          cputmax = ecpu_sorted(in);   npmax = in
       end if
       if(cputmin > ecpu_sorted(in)) then
          cputmin = ecpu_sorted(in);   npmin = in
       end if
    end do
!!$          cputmax = maxval(ecpu_sorted(0:npes-1,ic))
!!$          cputmin = minval(ecpu_sorted(0:npes-1,ic))
    cputmean = 0.d0
    do in = 0, npes-1
       cputmean = cputmean + ecpu_sorted(in)
    end do
    cputmean = cputmean/npes
    cputvariance = 0.d0
    do in =0, npes-1
       cputvariance = cputvariance + (ecpu_sorted(in)-cputmean)*(ecpu_sorted(in)-cputmean)
    end do
    cputvariance = cputvariance/npes
    cputstddevia = dsqrt(cputvariance)
    
  end subroutine cpu_statistics_in_parallel

  subroutine wd_ecpu_details(iteration)
    integer, intent(in) :: iteration
    integer :: i, ip, ic, inu, ips, id, icflag

    n_1stlevel_subroutines = 0
    do i = 1, n_sub_names
       if(ilevel(i) == 1) n_1stlevel_subroutines = n_1stlevel_subroutines+1
    end do
    if(n_1stlevel_subroutines ==0) return
    allocate(ip_1stlevel_subroutines(n_1stlevel_subroutines))
    n_1stlevel_subroutines = 0
    do i = 1, n_sub_names
       ip = iorder(i)
       if(ilevel(ip) == 1) then
          n_1stlevel_subroutines = n_1stlevel_subroutines+1
          ip_1stlevel_subroutines(n_1stlevel_subroutines) = ip
       end if
    end do

    write(6,'("--- cputiming details BEGIN ( iteration = ",i8," ) ----")') iteration
    write(6,'("   no "," id ",2x,"        subroutine name         ","  time(sec) "&
         &               ,"  count","   level","   id1")')
    subhir(1:id_ext_max)%flag = 0

    icflag = 0
    do i = 1, n_1stlevel_subroutines
       ip = ip_1stlevel_subroutines(i)
       ic = 0
       do inu = 1, id_ext_max
          ips = subhir(inu)%id1
          if(subhir(inu)%level>=2 .and. ips == ip) then
             if(ecpu_ext(inu) > UMICRO) ic = ic+1
             ic = ic+1
          end if
       end do
       if(ic >=1) then
          write(6,'(" ",60("="))')
          write(6,'("  *  ",i5,2x,a32,f11.5,2i8,"    *")') ip,subroutine_names(ip), ecpu(ip),counter(ip),ilevel(ip)
          write(6,'(" ",60("-"))')
!!$          write(6,'("  ----------------------------------------")')
          ic = 0
          do inu = 1, id_ext_max
             ips = subhir(inu)%id1
             if(subhir(inu)%level>=2 .and. ips == ip) then
                if(ecpu_ext(inu) > UMICRO) then
                   ic = ic+1
                   id = subhir(inu)%id
                   if(id >=1) then
                      write(6,'(2i5,2x,a32,f11.5,3i8)') ic,id,subroutine_names(id) &
                           & , ecpu_ext(inu),counter_ext(inu),subhir(inu)%level, subhir(inu)%id1
                   else
                      write(6,'("id = ",i8," <=0")') id
                   end if
                   subhir(inu)%flag = 1
                   icflag = icflag + 1
                end if
             end if
          end do
       end if
    end do
    if(icflag < id_ext_max) then
       ic = 0
       do i = 1, id_ext_max
          if(subhir(i)%flag == 0 .and. subhir(i)%level >= 2) then
             if(ecpu_ext(i) > UMICRO) then
                ic = ic + 1
             end if
          else if(subhir(i)%flag == 0 .and. subhir(i)%level==1) then
             id = subhir(i)%id
             if(1<=id .and. id <=MSBRNM .and. ilevel(id) /= 1) then
                if(ecpu_ext(i) > UMICRO) then
                   ic = ic + 1
                end if
             end if
          end if
       end do
       if(ic>=1) then
          write(6,'(" === other subroutines ",40("="))')
          ic = 0
          do i = 1, id_ext_max
             icflag = 0
             if(subhir(i)%flag == 0 .and. subhir(i)%level >= 2) then
                if(ecpu_ext(i) > UMICRO) then
                   ic = ic + 1
                   id = subhir(i)%id
                   icflag = 1
                end if
             else if(subhir(i)%flag == 0 .and. subhir(i)%level<=1) then
                id = subhir(i)%id
                if(1<=id .and. id <=MSBRNM .and. ilevel(id) /= 1) then
                   if(ecpu_ext(i) > UMICRO) then
                      ic = ic + 1
                      icflag = 1
                   end if
                end if
             end if
             if(icflag == 1)  write(6,'(2i5,2x,a32,f11.5,3i8)') ic, id,subroutine_names(id) &
                  & , ecpu_ext(i), counter_ext(i), subhir(i)%level, subhir(i)%id1
          end do
       end if
    end if
    write(6,'("--- cputiming details END ( iteration = ",i8," ) ----")') iteration

    deallocate(ip_1stlevel_subroutines)
  end subroutine wd_ecpu_details

  subroutine tstatc_wd(iteration)
    integer, intent(in) :: iteration
!!$    integer i, ip, nsub, in, ic, nsub0, npmax, npmin
    integer i, ip, nsub, ic, nsub0, npmax, npmin
    real(kind=DP) :: cpudif, pecpu, wct_now, cputmax, cputmin, cputmean, cputvariance, cputstddevia
    real(kind=DP), allocatable, dimension(:,:) :: ecpu_wk, ecpu_sorted
    integer, allocatable, dimension(:) :: iorder_p
    integer :: ipri0, lev, levmax, inu, j, num_sub_wd,  cput_mode

    ipri0 = ipritiming
    call mpi_bcast(ipri0,1,mpi_integer,0,mpi_comm_group,ierr)
    if(ipri0<=0) return

    ipri0 = 0
    cpudif = dabs(ecpu(0) - ecpu_previous)
    if(cpudif < ecpu_previous * PCPUDF .or. ecpu(0) < UMICRO) ipri0=1
    call mpi_bcast(ipri0,1,mpi_integer,0,mpi_comm_group,ierr)
    if(ipri0>0) then
       goto 1001
    end if

    if(measure_count_limit > 0) call correct_ecpu() ! counter,measure_count_limit,ecpu-> ecpu
    call tsort(ecpu(1),MSBRNM,iorder)

    if(levelset == ON) then
       levmax = 2
       if(sw_firstlevel_only==ON) levmax = 1
    else
       levmax = 1
    end if
    nsub = 0
    if(sw_firstlevel_only == ON .and. levmax == 1) then
      ic = 0
       do i = 1, n_sub_names
          ip = iorder(i)
          if(ecpu(ip) < UMICRO) exit
          if(ilevel(ip) == 1) then
             ic = ic + 1
             if(ic > num_subroutines) exit
             nsub = i
          end if
       end do
    else
       nsub = min(n_sub_names, num_subroutines)
    end if

!!$    if(printable) write(6,'(" nsub = ",i8)') nsub

    if(statistics_in_parallel == 1 .and. npes >= 2) then
       cput_mode = MODE_PARALLEL
       call mpi_barrier(mpi_comm_group,ierr)
       if(mype == 0) then
          nsub0 = 0 
          do i = 1, nsub
             if(ecpu(iorder(i)) < UMICRO) exit
             nsub0 = i
          end do
       end if
       call mpi_bcast(nsub0,1,mpi_integer,0,mpi_comm_group,ierr)
       allocate(iorder_p(nsub0))
       if(mype == 0) iorder_p(1:nsub0) = iorder(1:nsub0)
       call mpi_bcast(iorder_p,nsub0,mpi_integer,0,mpi_comm_group,ierr)

       allocate(ecpu_wk(0:npes-1,0:nsub0)); ecpu_wk = 0.d0
       allocate(ecpu_sorted(0:npes-1,0:nsub0))
       ecpu_wk(mype,0) = ecpu(0)
       do i = 1, nsub0
          ip = iorder_p(i)
          ecpu_wk(mype,i) = ecpu(ip)
       end do
       call mpi_allreduce(ecpu_wk, ecpu_sorted,(nsub0+1)*npes, mpi_double_precision &
            &            ,mpi_sum, mpi_comm_group,ierr)
       subroutine_names(0) = " total cpu of this iteration "
       subroutine_name_length(0) = 30
       nsub0 = nsub0 + 1
    else
       cput_mode = MODE_SINGLE
       nsub0 = 0
       do i = 1, nsub
          if(ecpu(iorder(i)) < UMICRO) exit
          nsub0 = i
       end do
    end if

    do j = MODE_EVALUATION, MODE_WRITE
       if(j==MODE_EVALUATION) num_sub_wd = 0
       if(j==MODE_WRITE) call wd_headerlines()

       do lev = 1, levmax
          if(j==MODE_WRITE) call wd_pauseline()
          inu = 0
          do i = 1, nsub0
             if(cput_mode == MODE_PARALLEL) then
                if(i <= nsub0-1) then
                   ip = iorder_p(i)
                   ic = i
                else if(i == nsub0) then
                   ip = 0
                   ic = 0
                end if
             else if(cput_mode == MODE_SINGLE) then
                ip = iorder(i)
             end if
             
!!$             if(levelset == ON .and. ip/=0) then
             if(levelset == ON .and. ip>0) then
                if(levmax >= 2) then
                   if(.not.((lev==levmax .and. ilevel(ip)==-1) .or. (lev<levmax .and. ilevel(ip)==lev))) cycle
                else if(levmax == 1) then
                   if(ilevel(ip)/=lev) cycle
                end if
!!$             else if(levelset == ON .and. ip == 0) then
             else if(levelset == ON .and. ip <= 0) then
                if(lev < levmax) cycle
             end if
             inu = inu+1

             if(j==MODE_WRITE) then
                if(cput_mode == MODE_PARALLEL) then
                   call cpu_statistics_in_parallel(ecpu_sorted(0,ic) &
                        & ,cputmin,cputmax,cputmean,cputvariance,cputstddevia,npmax,npmin)
                end if
                pecpu = ecpu(ip)/ecpu(0) * 100

                if(printable) then
                   if(cput_mode == MODE_PARALLEL) then
                      if(ip /= 0) then
                         write(6,'(2i4,2x,a32,f10.4,f6.2,i9,4f10.4,3i5)') &
                              & ic,ip, subroutine_names(ip),ecpu(ip),pecpu,counter(ip) &
                              & ,cputmax,cputmin,cputmean,cputstddevia,npmax,npmin,inu
                      else if(ip == 0) then
                         write(6,'(2i4,2x,a32,f10.4,f6.1,i9,4f10.4,3i5)') &
                              & ic,ip, subroutine_names(ip),ecpu(ip),pecpu,1 &
                              & ,cputmax,cputmin,cputmean,cputstddevia,npmax,npmin,inu
                      end if
                   else
                      write(6,'(2i4,2x,a32,f11.5,f6.2,2i8)') &
                           & i,ip, subroutine_names(ip),ecpu(ip),pecpu,counter(ip),inu
                   end if
                end if
             end if
          end do
          if(j==MODE_EVALUATION) num_sub_wd = num_sub_wd+inu
       end do
    end do
    if(cput_mode == MODE_PARALLEL)  deallocate(iorder_p,ecpu_sorted,ecpu_wk)
!!$    else
!!$       nsub0 = 0
!!$       do i = 1, nsub
!!$          if(ecpu(iorder(i)) < UMICRO) exit
!!$          nsub0 = i
!!$       end do
!!$
!!$       do j = MODE_EVALUATION, MODE_WRITE
!!$          if(j==MODE_EVALUATION) num_sub_wd = 0
!!$          if(j==MODE_WRITE) call wd_header()
!!$          do lev = 1, levmax
!!$             if(j==MODE_WRITE) call wd_pauseline()
!!$
!!$             inu = 0
!!$             do i = 1, nsub0
!!$                ip = iorder(i)
!!$                if(levelset == ON) then
!!$                   if(levmax >= 2) then
!!$                      if(.not.((lev==levmax .and. ilevel(ip)==-1) .or. (lev<levmax .and. ilevel(ip)==lev))) cycle
!!$                   else if(levmax == 1) then
!!$                      if(ilevel(ip)/=lev) cycle
!!$                   end if
!!$                end if
!!$                inu = inu+1
!!$                if(j==MODE_WRITE) then
!!$                   pecpu = ecpu(ip)/ecpu(0) * 100
!!$
!!$                   if(printable) write(6,'(2i4,2x,a32,f11.5,f6.2,2i8)') &
!!$                        & i,ip, subroutine_names(ip),ecpu(ip),pecpu,counter(ip),inu
!!$                end if
!!$             end do
!!$             if(j==MODE_EVALUATION) num_sub_wd = num_sub_wd+inu
!!$          end do
!!$       end do
!!$!!!$       if(sw_details == ON .and. printable) then
!!$!!!$          write(6,'(" --- detail ---")')
!!$!!!$          write(6,'(" id_ext_max = ", i8)') id_ext_max
!!$!!!$          if(printable) write(6,'("   no",2x," id ","        subroutine name         ","  time(sec) "&
!!$!!!$               &               ,"  count","   level","   id1")')
!!$!!!$          do i = 1, min(id_ext_max,100)
!!$!!!$             inu = subhir(i)%id
!!$!!!$             if(inu >= 1) write(6,'(i5,2x,i4,a32,f11.5,3i8)') i, inu,subroutine_names(inu) &
!!$!!!$                  & , ecpu_ext(i), counter_ext(i), subhir(i)%level, subhir(i)%id1
!!$!!!$          end do
!!$!!!$       end if
!!$    end if
    call gettod(wct_now)
    cpudif = (wct_now - wct_start)*UMICRO
!!$    write(6,'(6x,"Total cpu time of ( ",i8," )-th iteration",4x,f11.5 &
!!$         & ,"(sec.)")') iteration, ecpu(0)
    if(printable) then
       if(iteration < 10000) then
          if(cpudif < 10**6) then
             write(6,'(1x,"Total cputime of ( ",i4," )-th iteration",3x,f11.5," /",f10.3 &
                  & ," (sec.)")') iteration, ecpu(0), cpudif
          else 
             write(6,'(1x,"Total cputime of ( ",i4," )-th iteration",3x,f11.5," /",f12.3 &
                  & ," (sec.)")') iteration, ecpu(0), cpudif
          end if
       else
          if(cpudif < 10**6) then
             write(6,'(1x,"Total cputime of ( ",i8," )-th iteration",1x,f11.5," /",f10.3 &
                  & ," (sec.)")') iteration, ecpu(0), cpudif
          else 
             write(6,'(1x,"Total cputime of ( ",i8," )-th iteration",1x,f11.5," /",f12.3 &
                  & ," (sec.)")') iteration, ecpu(0), cpudif
          end if
       end if
    end if

    if(sw_details == ON .and. printable) call wd_ecpu_details(iteration)
1001 ecpu_previous = ecpu(0)

  contains
    subroutine wd_pauseline()
      if(levelset == ON .and. levmax>1 .and. printable) then
         if(lev < levmax) then
            write(6,'("    --- level ",i3," ---")') lev
         else
            write(6,'("    --- ---")')
         end if
      end if
    end subroutine wd_pauseline

    subroutine wd_headerlines()
      integer :: num_sub
      if(printable) then
         if(cput_mode == MODE_PARALLEL) then
            num_sub = num_sub_wd-1
         else
            num_sub = num_sub_wd
         end if
         write(6,'(" << CPU Time Consumption -- TOP",i4," Subroutines (",i5,") >>")') &
                 &     num_sub, iteration
         if(cput_mode == MODE_PARALLEL) then
            write(6,'("  no "," id ",2x,"        subroutine name         ","time(sec) "&
                 &               ," r(%) ","   count  ", "max_time    min       mean     stddevia"," nmax nmin  no(2)")')
         else
            write(6,'("  no "," id ",2x,"        subroutine name         "," time(sec) "&
                 &               ," r(%) ","   count","   no(2)")')
         end if
      end if
    end subroutine wd_headerlines

!!$    subroutine wd_headerlines()
!!$      if(printable) then
!!$         write(6,'(" << CPU Time Consumption -- TOP",i4," Subroutines (",i5,") >>")') &
!!$              &     num_sub_wd, iteration
!!$         write(6,'("  no "," id ",2x,"        subroutine name         "," time(sec) "&
!!$              &               ," r(%) ","   count","   no(2)")')
!!$      end if
!!$    end subroutine wd_headerlines
  end subroutine tstatc_wd

  subroutine tstatc_iter(iteration, first_iteration_of_this_job)
    integer, intent(in) :: iteration, first_iteration_of_this_job
    real(kind=DP) :: t_end, t_used
#ifdef NEC_ITER_REG
    character(len=7) :: str_reg
#endif
    call gettod(t_end)
    if(iteration > first_iteration_of_this_job) then
#ifdef NEC_ITER_REG
       write(str_reg, '(A3,I4.4)') 'IT_',iteration
       call FTRACE_REGION_END(str_reg)
#endif
       t_used  = t_end - tstart(0)
       ecpu(0) = t_used * UMICRO
    end if
    tstart(0) = t_end
#ifdef NEC_ITER_REG
       write(str_reg, '(A3,I4.4)') 'IT_',iteration+1
       call FTRACE_REGION_BEGIN(str_reg)
#endif
  end subroutine tstatc_iter

  subroutine m_Timing_wd_timenow(chars)
    character(len=*), intent(in) :: chars

    integer, dimension(8) :: ipresent_time
    integer :: i, j, ilen
    integer, parameter :: max_chars = 80, max_chars0 = 55
    character(len=80) :: aline
    character(len=20) :: dateandtime = ''

    call date_and_time(values=ipresent_time)
    
    ilen = len_trim(chars)
    if(ilen > max_chars0) ilen = max_chars0

!!$    aline = ''
!!$    do i = 1, ilen
!!$       aline(i:i) = chars(i:i)
!!$    end do
!!$    write(aline(ilen+6:max_chars),'(",i2,":",i2,":",i2,"  ",i2,"/",i2,"/",i4)') &
!!$         & ipresent_time(5:7),ipresent_time(3),ipresent_time(2),ipresent_time(1)
    write(dateandtime,'(i2,":",i2,":",i2,"  ",i2,"/",i2,"/",i4)') &
         & ipresent_time(5:7),ipresent_time(3),ipresent_time(2),ipresent_time(1)
    do i = 1,20
       if(i >= 9 .and. i <= 10) cycle
       if(dateandtime(i:i) == ' ' ) dateandtime(i:i) = '0'
    end do

    aline = chars(1:ilen)//'     '//dateandtime

    write(6,'(a80)') aline

  end subroutine m_Timing_wd_timenow

  subroutine m_Timing_init_timer()
#ifdef HIUX
    real(kind=DP) :: time0
#endif
    call gettod(wct_start)
    switch_of_timing = ON
#ifdef HIUX
    call xclock(time0,7)
    call xclock(time0,3)
#endif
  end subroutine m_Timing_init_timer

  subroutine m_Timing_wd_status(nfstatus, jobstatus_format,jobstatus_series,status_wdmode &
       &       , iteration, iteration_ionic, iteration_electronic)
    integer, intent(in) :: nfstatus, jobstatus_format, jobstatus_series, status_wdmode &
         &               , iteration, iteration_ionic, iteration_electronic
    integer :: switch_header
    character(len=9) :: modename
    real(kind=DP) :: elapsed_time

#ifdef HIUX
    real(kind=DP) :: cpu_time
    call xclock(elapsed_time,8)
    call xclock(cpu_time,5)
#else
    real(kind=DP) :: wct_now
    call gettod(wct_now)
    elapsed_time = (wct_now - wct_start) * UMICRO
#endif
    if(status_wdmode == START) then
       modename = 'START'
    else if(status_wdmode == ITERATIVE) then
       modename = 'ITERATIVE'
    else if(status_wdmode == FINISH) then
       modename = 'FINISHED'
    end if
    switch_header = ON
    if(jobstatus_format == TAG_FORMAT .or. jobstatus_format == TAG_LINE) then
       switch_header = OFF
    else if(jobstatus_format == TABLE) then
       if(jobstatus_series == ON .and. status_wdmode /= START) switch_header = OFF
    else
       if(printable) write(6,'(" jobstatus_format (= ",i5,") is illegal")') jobstatus_format
    end if
    if(jobstatus_format == TABLE) then
#ifdef HIUX
       if(switch_header == ON) &
            & write(nfstatus,'("status     iteration  iter_ionic  iter_elec  elapsed_time  cpu_time")')
       write(nfstatus,'(a9,i11,i11,i11,f14.4,f14.4)') modename, iteration &
            & , iteration_ionic, iteration_electronic, elapsed_time, cpu_time
#else
       if(switch_header == ON) &
            & write(nfstatus,'("status     iteration  iter_ionic  iter_elec  elapsed_time")')
       write(nfstatus,'(a9,i11,i11,i11,f14.4)') modename, iteration &
            & , iteration_ionic, iteration_electronic, elapsed_time
#endif
    else if(jobstatus_format == TAG_FORMAT) then
       write(nfstatus,'(" status       = ",a14)') modename
       write(nfstatus,'(" iteration    = ",i14)') iteration
       write(nfstatus,'(" iter_ionic   = ",i14)') iteration_ionic
       write(nfstatus,'(" iter_elec    = ",i14)') iteration_electronic
       write(nfstatus,'(" elapsed_time = ",f14.4)') elapsed_time
#ifdef HIUX
       write(nfstatus,'(" cpu_time     = ",f14.4)') cpu_time
#endif
    else if(jobstatus_format == TAG_LINE) then
#ifdef HIUX
       write(nfstatus,'(" status = ",a9,", iteration = ",i10,", iter_ionic = ",i10 &
            & ,", iter_elec = ",i10,", elapsed_time = ",f14.4,", cpu_time = ",f14.4)') &
            & modename,iteration,iteration_ionic,iteration_electronic &
            &,elapsed_time, cpu_time
#else 
       write(nfstatus,'(" status = ",a9,", iteration = ",i10,", iter_ionic = ",i10 &
            & ,", iter_elec = ",i10,", elapsed_time = ",f14.4)') &
            & modename,iteration,iteration_ionic,iteration_electronic &
            &,elapsed_time
#endif
    end if

  end subroutine m_Timing_wd_status

  subroutine correct_ecpu()
    !   input  : ecpu, counter, measure_count_limit
    !      condition : measure_count_limit > 0
    !   output : ecpu, ecpu_ext
    integer :: i
    real(kind=DP) :: d, ecpu0
    if(measure_count_limit <= 0) return
    d = 1.d0/measure_count_limit
    do i = 1, MSBRNM
       if(counter(i) > measure_count_limit) then
          ecpu0 = ecpu(i) 
          ecpu(i) = ecpu(i)*counter(i)/measure_count_limit
          if(ipritiming >= 2) write(6,'(" id = ",i8, " ecpu new, old = ",2f8.4)') i, ecpu(i),ecpu0
       end if
    end do
    if(sw_details == ON) then
       do i = 1, n_allocated_subhir
          if(counter_ext(i) > measure_count_limit) then
             ecpu0 = ecpu_ext(i)
             ecpu_ext(i) = ecpu_ext(i)*counter_ext(i)/measure_count_limit
             if(ipritiming >= 2) write(6,'(" id = ",i8, " ecpu_ext new, old = ",2f8.4)') i, ecpu_ext(i),ecpu0
          end if
       end do
    end if
  end subroutine correct_ecpu

end module m_Timing
