!===============================================================================
!
! bqcdi.F90 - main program and read/write of parameters
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 1998-2016 Hinnerk Stueben, Yoshifumi Nakamura
!
! This file is part of BQCD -- Berlin Quantum ChromoDynamics program
!
! BQCD is free software: you can redistribute it and/or modify
! it under the terms of the GNU General Public License as published by
! the Free Software Foundation, either version 3 of the License, or
! (at your option) any later version.
!
! BQCD is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
! GNU General Public License for more details.
!
! You should have received a copy of the GNU General Public License
! along with BQCD.  If not, see <http://www.gnu.org/licenses/>.
!
!-------------------------------------------------------------------------------
! Modified for polyBQCD
!
! Editor: Taylor Haar
! Last modified: 23/03/2017
!-------------------------------------------------------------------------------
# include "defs.h"

!-------------------------------------------------------------------------------
program bqcd
  use module_cg
  use typedef_flags
  use typedef_para
  use module_input
  use module_function_decl
  use module_switches
  use module_lattice
  implicit none

  type(type_para)                       :: para
  type(hmc_conf), dimension(MAX_TEMPER) :: conf
  type(type_flags)                      :: flags
  SECONDS                               :: time0, sekunden

#ifdef QPACE
  call init_cellddsolver()
#endif

#ifdef QMP
  call init_qmp(0)
#else
  call comm_init()
#endif
  call c_stack()

  call place_process()
  !!call comm_finalize()
  !!stop

  time0 = sekunden()  ! start/initialize timer

  TIMING_START(timing_bin_total)

  call get_flags(flags)
  call begin(UREC, "Job")
  call input_read(flags); DEBUG2S("done: input_read")
  call init_para(para, flags); DEBUG2S("done: init_para")
  call init_common(para); DEBUG2S("done: init_common")
  call init_modules(); DEBUG2S("done: init_modules")
  call ildg_read_restart_info(flags); DEBUG2S("done: ildg_read_restart_info")
#ifdef IBM
  call bgl_process_mapping()
#endif

#ifdef QMP
  call init_qmp_node(para%NPE(1),para%NPE(2),para%NPE(3),para%NPE(4))
#endif

  call init_counter(para, flags); DEBUG2S("done: init_counter")
  call init_ran(para, flags); DEBUG2S("done: init_ran")
  call init_cooling(input%measure_cooling_list);  DEBUG2S("done: init_cooling")

  call set_fmt_ensemble(para%n_temper);  DEBUG2S("done: set_fmt_ensemble")
  call check_fmt(para%run, para%n_temper, para%maxtraj, para%L(4) - 1); DEBUG2S("done: check_fmt")

  call init_d(); DEBUG2S("done: init_d")
#ifdef BQCD_DDHMC
  call init_dd()
#endif
  call write_header(para, flags); DEBUG2S("done: write_header")

!!call remez()
!!stop
  call init_bc()
  call init_cg_para()
  call init_cg_stat_all()
  call init_xbound()
#ifndef D500
  call init_xbound_r4()
#endif
#ifdef BAGEL
  call init_wfm(NX,NY,NZ,NT,NPE) !!! for bagel
#endif

  call init_confs2(para, conf)

  if (.not. switches%convert_to_ildg) then
     call init_hadspec(input%measure_hadspec)
  endif

  call check_former(para%n_temper, conf)

!!  call ieo2local_test()
!!  call coord_test()
!!  call xbound_test()
!!  call comm_basic_test()  ! MPI only

#ifdef QUDA
  call comm_set_gridsize(para%NPE) ! awaiting the official QUDA interface for this
  call init_quda(-1) ! Must be after init_para, since this is where topology is read in
#endif

  select case (switches%main_task)
  case ("monte-carlo");     call mc(para, conf)
  case ("convert-to-ildg"); call conf_write(.false., para, conf)
  case default; call die(trim(switches%main_task) // ": unknown main_task")
  end select

  if ((.not. switches%measure_only) .and. &
      (.not. switches%smearing_only   ) .and. &
      (.not. switches%convert_to_ildg )  ) then
     call conf_write(.true., para, conf)
     call write_counter(para%maxtraj)
     call write_ran()
  endif

  TIMING_STOP(timing_bin_total)

  call write_footer(time0)
  call end(UREC, "Job")

#ifdef BAGEL
  call end_wfm()  !!! for bagel
#endif
#ifdef _CUDA
#ifdef MAGMA
  call fin_magma()
#else
  call fin_cublas()
#endif
#endif
#ifdef QUDA
  call end_quda()
#endif

  call comm_finalize()
end

!-------------------------------------------------------------------------------
subroutine init_para(para, flags)

  ! initialises module_para, module_switches and module_mre

  use typedef_flags
  use typedef_para
  use module_bqcd
  use module_input
  use module_mre
  use module_mre2
  use module_switches
  use module_switches
  use module_action
  use module_evec
  use module_dd
  implicit none

  type(type_para)  :: para
  type(type_flags) :: flags
  integer          :: i
  logical          :: quenched, dynamical, clover, h_ext, qed, axion

  quenched   = .false.
  dynamical  = .false.
  clover     = .false.
  h_ext      = .false.
  qed        = .false.
  axion      = .false.

  ddlat           = input%ddlattice

  para%run         = input%run
  para%L           = input%lattice
  para%NPE         = input%processes
  para%process_mapping = input%process_mapping
  para%bc_fermions = input%boundary_conditions_fermions
  para%gamma_index = input%gamma_index
  para%n_temper    = input%ensembles
  para%nstd        = input%tempering_steps_without
  para%nforce      = input%hmc_accept_first
  para%ntraj       = input%mc_steps
  para%maxtraj     = input%mc_total_steps
  para%nsave       = input%mc_save_frequency
  para%c_cg_rest   = input%solver_rest
  para%cg_maxiter  = input%solver_maxiter
  para%cg_log      = input%solver_ignore_no_convergence
  para%cg_check    = input%solver_check_solution
  mre_n_vec        = input%solver_mre_vectors
  mre2_n_vec       = input%solver_mre_vectors

  switches%measure_minmax      = (input%measure_minmax /= 0)
  neig = input%measure_minmax

  gauge_action= input%gauge_action
  fermi_action= input%fermi_action

  call check_bc_fermions(para%bc_fermions, para%gamma_index)

  read(para%c_cg_rest   , *) para%cg_rest

 if (para%n_temper <= 0) call die("init_para(): n_temper <= 0")
 if (para%n_temper > MAX_TEMPER) call die("init_para(): n_temper > max_temper")


  if (gauge_action == "WILSON") then
     switches%improved_gauge = .false.
  else
     switches%improved_gauge = .true.
  endif

  do i = 1, para%n_temper
     para%c_hmc(i)%beta        = input%beta(i)
     para%c_hmc(i)%beta_qed    = input%beta_qed(i)
     para%c_hmc(i)%kappa_axion = input%kappa_axion(i)
     para%c_hmc(i)%finv_axion  = input%finv_axion(i)
     para%c_hmc(i)%kappa       = input%kappa(i)
     para%c_hmc(i)%csw         = input%csw(i)
     para%c_hmc(i)%h           = input%h(i)
     para%c_hmc(i)%traj_length = input%hmc_trajectory_length(i)
     para%c_hmc(i)%ntau        = input%hmc_steps(i)
     para%c_hmc(i)%m_scale     = input%hmc_m_scale(i)
     para%c_hmc(i)%m_scale2    = input%hmc_m_scale2(i)
     para%info_file(i)         = input%start_info_file(i)
     read(para%c_hmc(i)%beta,       *) para%hmc(i)%beta
     read(para%c_hmc(i)%beta_qed,   *) para%hmc(i)%beta_qed
     read(para%c_hmc(i)%kappa_axion,*) para%hmc(i)%kappa_axion
     read(para%c_hmc(i)%finv_axion, *) para%hmc(i)%finv_axion
     read(para%c_hmc(i)%kappa,      *) para%hmc(i)%kappa
     read(para%c_hmc(i)%csw,        *) para%hmc(i)%csw
     read(para%c_hmc(i)%h,          *) para%hmc(i)%h
     read(para%c_hmc(i)%traj_length,*) para%hmc(i)%traj_length
     read(para%c_hmc(i)%ntau,       *) para%hmc(i)%ntau
     read(para%c_hmc(i)%m_scale,    *) para%hmc(i)%m_scale
     read(para%c_hmc(i)%m_scale2,   *) para%hmc(i)%m_scale2
     para%c_hmc(i)%kappa_strange   = input%kappa_strange(i)
     para%c_hmc(i)%m_scale3        = input%hmc_m_scale3(i)
     para%c_hmc(i)%m_scale4        = input%hmc_m_scale4(i)
     para%c_hmc(i)%m_scale5        = input%hmc_m_scale5(i)
     para%c_hmc(i)%n_stout         = input%n_stout(i)
     para%c_hmc(i)%alpha           = input%alpha(i)
     para%c_hmc(i)%theta           = input%theta(i)
     para%c_hmc(i)%chemi           = input%chemi(i)
     para%c_hmc(i)%chemi_i         = input%chemi_i(i)
     read(para%c_hmc(i)%kappa_strange,   *) para%hmc(i)%kappa_strange
     read(para%c_hmc(i)%m_scale3,        *) para%hmc(i)%m_scale3
     read(para%c_hmc(i)%m_scale4,        *) para%hmc(i)%m_scale4
     read(para%c_hmc(i)%m_scale5,        *) para%hmc(i)%m_scale5
     read(para%c_hmc(i)%n_stout        ,*) para%hmc(i)%n_stout
     read(para%c_hmc(i)%alpha          ,*) para%hmc(i)%alpha
     read(para%c_hmc(i)%theta          ,*) para%hmc(i)%theta
     read(para%c_hmc(i)%chemi          ,*) para%hmc(i)%chemi
     read(para%c_hmc(i)%chemi_i        ,*) para%hmc(i)%chemi_i
     chemi=para%hmc(1)%chemi
     chemi_i=para%hmc(1)%chemi_i
     kappa_axion=para%hmc(1)%kappa_axion
     finv_axion=para%hmc(1)%finv_axion
     para%hmc(i)%nf1_kappa     = input%nf1_kappa
     para%hmc(i)%nf2_kappa     = input%nf2_kappa
     para%hmc(i)%nf1_lambda    = input%nf1_lambda
     para%hmc(i)%nf2_lambda    = input%nf2_lambda
     para%hmc(i)%nf1_em_charge = input%nf1_em_charge
     para%hmc(i)%nf2_em_charge = input%nf2_em_charge
     para%hmc(i)%nf2_rho       = input%nf2_rho
!!     if (para%hmc(i)%kappa == ZERO .and. para%hmc(i)%csw /= ZERO) then
!!        para%hmc(i)%csw_kappa = para%hmc(i)%csw
!!        para%c_hmc(i)%csw = "-1 (infinity)"
!!        para%hmc(i)%csw = -1
!!        para%hmc(i)%kappa_strange = ZERO
!!        para%hmc(i)%csw_kappa_strange = ZERO
!!     else
!!        para%hmc(i)%csw_kappa         = para%hmc(i)%csw * para%hmc(i)%kappa
!!        para%hmc(i)%csw_kappa_strange = para%hmc(i)%csw * para%hmc(i)%kappa_strange
!!     endif
     para%hmc(i)%tau = para%hmc(i)%traj_length / para%hmc(i)%ntau
     write(para%c_hmc(i)%tau,       "(f20.15)") para%hmc(i)%tau

     if (para%hmc(i)%nf2_kappa(1) == ZERO .and. &
         para%hmc(i)%nf1_kappa(1) == ZERO .and. &
         para%hmc(i)%csw          == ZERO) then
        quenched = .true.
     else
        dynamical = .true.
     endif

     if (para%hmc(i)%csw      /= ZERO) clover = .true.
     if (para%hmc(i)%h        /= ZERO) h_ext  = .true.
     if (para%hmc(i)%beta_qed /= ZERO) qed    = .true.
     if (para%hmc(i)%kappa_axion/= ZERO)axion = .true.
!     if (para%hmc(i)%finv_axion== ZERO .and. axion .and. dynamical) &
!        call die("ERROR: finv_axion should be non zero when kappa_axion is non zero")

     para%hmc(i)%model = input%hmc_model
     para%hmc(i)%integrator(1) = input%hmc_integrator1
     para%hmc(i)%integrator(2) = input%hmc_integrator2
     para%hmc(i)%integrator(3) = input%hmc_integrator3
     para%hmc(i)%integrator(4) = input%hmc_integrator4
     para%hmc(i)%integrator(5) = input%hmc_integrator5
     para%hmc(i)%integrator(6) = input%hmc_integrator6

     call coefficient_sig(para%hmc(i))
  enddo

  switches%mass_kappa = (input%hmc_hkappa /=0)
  switches%stout      = (para%hmc(1)%n_stout /= 0 .and. &
                             para%hmc(1)%alpha /= ZERO)
  switches%theta      = (para%hmc(1)%theta /= ZERO)

  select case (input%start_configuration)
     case ("hot");  para%start = START_HOT
     case ("cold"); para%start = START_COLD
     case ("file"); para%start = START_FILE
     case default
        call die("init_para(): start_configuration must be {hot|cold|file}")
  end select

  select case (input%start_random)
     case ("random");  para%seed = -1
     case ("default"); para%seed = 0
     case default;     read(input%start_random, *) para%seed
  end select

  select case (input%tempering_swap_sequence)
     case ("up");     para%swap_seq = SWAP_UP
     case ("down");   para%swap_seq = SWAP_DOWN
     case ("random"); para%swap_seq = SWAP_RANDOM
     case default
       call die("init_para(): tempering_swap_sequence must be {up|down|random}")
  end select

  switches%stout_ds = .false.
  switches%stout_cl = .false.
  select case (input%fermi_action)
     case ("NON")
        if (dynamical) call die("NON fermi_action but dynamical")
     case ("WILSON")
        if (clover) call die("WILSON fermi_action but csw /= 0")
     case ("CLOVER")
        if (.not. clover) call die("CLOVER fermi_action but csw = 0")
     case ("SLW")
        if (clover) call die("SLW fermi_action but csw /= 0")
        if (.not. switches%stout) &
        call die("SLW  fermi_action but not stout")
        switches%stout_ds = .true.
     case ("SLOC")
        if (.not. switches%stout) &
        call die("SLOC fermi_action but not stout")
        switches%stout_ds = .true.
        switches%stout_cl = .true.
     case ("SLIC")
        if (.not. switches%stout) &
        call die("SLIC fermi_action but not stout")
        switches%stout_cl = .true.
     case ("SLRC")
        if (.not. switches%stout) &
        call die("SLRC fermi_action but not stout")
        switches%stout_ds = .true.
     case default
        call die("init_para(): fermi_action must be {NON|WILSON|CLOVER|SLW|SLOC|SLIC|SLRC}")
  end select

  if (quenched .and. dynamical) call die("init_para(): quenched/dynamical mixed")

  if (para%nforce < 0) call die("init_para(): nforce < 0")

  if (flags%continuation_job) then
      para%start = START_CONT
      switches%start_continue = .true.
  endif

  switches%quenched   = quenched
  switches%dynamical  = dynamical
  switches%clover     = clover
  switches%h_ext      = h_ext
  switches%qed        = qed
  switches%axion      = axion

  ! Using generalized integrators?
  switches%genint = (input%hmc_genint /= 0)

  do i = 1, 6
     switches%hasenbusch = (input%nf2_rho(i,1) /= ZERO)
     if (switches%hasenbusch) exit
  enddo
  do i = 1, 6
     switches%rhmc   = (input%nf1_kappa(i) /= ZERO )
     if (switches%rhmc) exit
  enddo

  switches%poly = (input%nf2_k1p1 /= ZERO)
  switches%zolotarev = (input%hmc_zolo /= ZERO)
  switches%rescale_rhmc = (input%rescale_rhmc /= ZERO)

  if (quenched) then
    switches%hasenbusch = .false.
  endif

  switches%tempering               = .false.
  switches%measure_polyakov_loop   = .false.
  switches%measure_traces          = .false.
  switches%measure_chemical        = .false.
  switches%measure_schrpcac        = .false.
  switches%measure_wilson_flow     = .false.
  switches%measure_wilson_flow_qed = .false.

  if (input%ensembles               >  1) switches%tempering               = .true.
  if (input%measure_polyakov_loop   /= 0) switches%measure_polyakov_loop   = .true.
  if (input%measure_traces          /= 0) switches%measure_traces          = .true.
  if (input%measure_chemical        /= 0) switches%measure_chemical        = .true.
  if (input%measure_schrpcac        /= 0) switches%measure_schrpcac        = .true.
  if (input%measure_wilson_flow     /= 0) switches%measure_wilson_flow     = .true.
  if (input%measure_wilson_flow_qed /= 0) switches%measure_wilson_flow_qed = .true.

  switches%measure_only = .false.
  switches%smearing_only = .false.
  switches%boundary_sf = .false.
  if (input%measure_only   /= 0) switches%measure_only = .true.
  if (input%smearing_only   /= 0) switches%smearing_only = .true.

  if (input%boundary_sf   /= 0) switches%boundary_sf = .true.

  if (input%replay_trick_ntau /=0) then
     if (input%replay_trick_ntau < para%hmc(1)%ntau) call die("replay_trick_ntau < ntau")
     switches%replay = .true.
  endif

  if (input%hmc_test == 0) then
     switches%hmc_test = .false.
  else
     switches%hmc_test = .true.
  endif

  switches%convert_to_ildg = flags%convert_to_ildg

  if (switches%convert_to_ildg) then
     para%start = START_FILE
     para%info_file(1) = flags%input
     input%io_conf_format = "ildg"
  endif

                                switches%main_task = "monte-carlo"
  if (switches%convert_to_ildg) switches%main_task = "convert-to-ildg"

  if (switches%convert_to_ildg) then
    input%processes = (/1, 1, 1, 1/)
    para%NPE        = (/1, 1, 1, 1/)
  endif

  call init_action()

end subroutine init_para

!-------------------------------------------------------------------------------
subroutine init_counter(para, flags)

  use typedef_flags
  use typedef_para
  use module_counter
  use module_function_decl
  use module_ildg_restart_info
  implicit none

  type(type_para)    :: para
  type(type_flags)   :: flags
  FILENAME, external :: count_file, stop_file

  if (flags%convert_to_ildg) then
     return  ! initialisation will be handled in read_conf_info_header()
  endif

  if (f_exist(stop_file())) then
     call die("init_counter(): found stop file " // stop_file())
  endif

  counter%run = para%run
  counter%j_traj = 0

  if (flags%continuation_job) then
     if (ildg_restart_info%counters_is_initialised) then
        counter%run  = ildg_restart_info%run
        counter%job  = ildg_restart_info%job
        counter%traj = ildg_restart_info%traj
     else
        open(UCOUNT, file = trim(count_file()), action = "read", status = "old")
        read(UCOUNT, *) counter%run
        read(UCOUNT, *) counter%job
        read(UCOUNT, *) counter%traj
        close(UCOUNT)
     endif

     if (counter%run /= para%run) call die("init_counter(): RUN inconsistent")
     counter%job = counter%job + 1
  else
     counter%run = para%run
     counter%job = 1
     counter%traj = -para%nforce
  endif

end

!-------------------------------------------------------------------------------
subroutine write_counter(maxtraj)

  use module_counter
  use module_function_decl
  use module_input
  implicit none

  integer            :: maxtraj
  FILENAME, external :: count_file, stop_file

  if (input%io_restart_format == "ildg") return
  if (my_pe() /= 0) return

  open(UCOUNT, file = trim(count_file()), action = "write")
  write(UCOUNT, *) counter%run, " run"
  write(UCOUNT, *) counter%job, " job"
  write(UCOUNT, *) counter%traj, " traj"
  close(UCOUNT)

  if (counter%traj >= maxtraj) then
     open(UCOUNT, file = trim(stop_file()), status = "unknown")
     close(UCOUNT)
  endif

end

!-------------------------------------------------------------------------------
subroutine write_header(para, flags)

  use typedef_flags
  use typedef_para
  use module_bqcd
  use module_counter
  use module_function_decl
  use module_input
  use module_mre
  use module_svn
  use module_thread
  use module_switches
  use module_action
  use module_dd
  implicit none

  type(type_para), intent(in)  :: para
  type(type_flags), intent(in) :: flags
  integer                      :: i, j, nts
  SEED                         :: seed
  character(len = 50)          :: fmt, fmt2, fmt5, tmp_c
  character(len = 4), external :: format_ensemble
  character(len = 50), external::c_info_mdsteps
  integer, external :: num_time_scale

  if (my_pe() == 0) then

     fmt = "(1x,a," // format_ensemble() // ",2a)"
     fmt2= "(1x,a," // format_ensemble() // ",2a,1(1x,a))"
     fmt5= "(1x,a," // format_ensemble() // ",2a,4(1x,a))"

     call begin(UREC, "Header")

    if (input%comment /= "") then
     write(UREC, 405) "Comment", trim(input%comment)
    endif

     write(UREC, 400) "Program", prog_name, prog_version // prog_revision
#ifdef BAGEL
     write(UREC,   *) "Version_of_D ", "BAGEL"
#else
     write(UREC,   *) "Version_of_D ", version_of_d()
#endif
     write(UREC,   *) "Communication ", trim(comm_method())
     write(UREC,   *) "RandomNumbers ", trim(ran_name())
     write(UREC,   *) "Run ", para%run
     write(UREC,   *) "Job ", counter%job
     write(UREC, 405) "Host", rechner()
     write(UREC, 400) "Date", datum(), uhrzeit()
     write(UREC, 410) "L               ", para%L
     write(UREC, 410) "DDL             ", input%ddlattice
     write(UREC, 410) "NPE             ", para%NPE
     write(UREC, 410) "process_mapping ", para%process_mapping
     write(UREC, 410) "bc_fermions     ", para%bc_fermions
     write(UREC, 410) "gamma_index     ", para%gamma_index
     write(UREC, 405) "Gauge Action     ", gauge_action
     write(UREC, 405) "Fermi Action     ", fermi_action
#ifdef OMTDTD
#ifdef DOEDEO
     write(UREC, 405) "M tilde          ", "1 - Too^-1 Doe Tee^-1 Doo"
#else
     write(UREC, 405) "M tilde          ", "1 - Tee^-1 Deo Too^-1 Doe"
#endif
#else
#ifdef DOEDEO
     write(UREC, 405) "M tilde          ", "Too - Doe Tee^-1 Doo"
#else
     write(UREC, 405) "M tilde          ", "Tee - Deo Too^-1 Doe"
#endif
#endif

#ifdef GAMMA_NOTATION_CHROMA
     write(UREC, 405) "Gamma notation   ", "Chroma"
#elif defined GAMMA_NOTATION_CHIRAL
     write(UREC, 405) "Gamma notation   ", "Chiral"
#elif defined GAMMA_NOTATION_DDHMC
     write(UREC, 405) "Gamma notation   ", "DDHMC"
#else
     write(UREC, 405) "Gamma notation   ",  "BQCD"
#endif

#ifdef ZERO_MOMENTUM
     write(UREC, *) "momentum is zero"
#endif
#ifdef NON_REALITY
     write(UREC, *) "pfermion has non reality"
#endif

     if (switches%boundary_sf) then
        write(UREC, *) "BoundaryCondition schr  "
     else
        write(UREC, *) "BoundaryCondition normal"
     endif

     write(UREC,   *) "Threads ", n_thread
     write(UREC,   *) "Start   ", para%start

     if (para%start == START_FILE) then
        do i = 1, para%n_temper
           write(UREC, fmt) "StartConf_", i, " ", trim(para%info_file(i))
        enddo
     endif

     if (flags%continuation_job) then
        seed = ran_get_seed()
     else
        seed = para%seed
     endif

     write(UREC,   *) "Seed    ", seed
     write(UREC,   *) "Swap_seq", para%swap_seq
     write(UREC,   *) "N_force ", para%nforce
     write(UREC,   *) "N_traj  ", para%ntraj
     write(UREC,   *) "N_save  ", para%nsave
     write(UREC,   *) "N_temper", para%n_temper

     do i = 1, para%n_temper
        nts=num_time_scale(para%hmc(i))
        write(UREC, fmt) "beta_", i, "              ", trim(para%c_hmc(i)%beta)
        write(UREC, fmt) "beta_qed_", i, "          ", trim(para%c_hmc(i)%beta_qed)
        write(UREC, fmt) "kappa_axion_", i, "       ", trim(para%c_hmc(i)%kappa_axion)
        write(UREC, fmt) "finv_axion_", i, "        ", trim(para%c_hmc(i)%finv_axion)

        do j = 1, 6
           if(abs(para%hmc(i)%nf1_kappa(j))>1e-10) then
              write(UREC, 420) "nf1_Dop", j, "(kp,Q,lam)", &
                   para%hmc(i)%nf1_kappa(j), para%hmc(i)%nf1_lambda(j), &
                   para%hmc(i)%nf1_em_charge(j)

              if (input%nf1_polyfile(j,1) /= "") then
                 ! PF-RHMC from file
                 write(UREC, '(1x,a,i1,a,a)') "nf1_Dop", j, "(p1)", &
                      input%nf1_polyfile(j,1)
                 if (input%nf1_polyfile(j,2) /= "") then
                    write(UREC, '(1x,a,i1,a,a)') "nf1_Dop", j, "(p2)", &
                         input%nf1_polyfile(j,2)
                 endif
                 if (input%nf1_polyfile(j,3) /= "") then
                    write(UREC, '(1x,a,i1,a,a)') "nf1_Dop", j, "(p3)", &
                         input%nf1_polyfile(j,3)
                 endif
              elseif (input%nf1_porder(j,1) /= ZERO) then
                 ! PF-RHMC as a porder
                 write(UREC, 421) "nf1_Dop", j, "(p1)", &
                      input%nf1_porder(j,1)
              endif
              if (input%nf1_trunc(j,1) /= ZERO) then
                 ! tRHMC
                 write(UREC, 422) "nf1_Dop", j, "(t1, t2, t3)", &
                      input%nf1_trunc(j,1), input%nf1_trunc(j,2), &
                      input%nf1_trunc(j,3)
              endif
           endif

           if(abs(para%hmc(i)%nf2_kappa(j))>1e-10) then
              write(UREC, 420) "nf2_Dop", j, "(kp,Q,lam)", &
                   para%hmc(i)%nf2_kappa(j), para%hmc(i)%nf2_lambda(j), &
                   para%hmc(i)%nf2_em_charge(j)
              
              if(abs(para%hmc(i)%nf2_rho(j,1))>1e-10) then
                 write(UREC, 420) "nf2_Dop", j, "(r1,r2,r3)", &
                      para%hmc(i)%nf2_rho(j,1), para%hmc(i)%nf2_rho(j,2), &
                      para%hmc(i)%nf2_rho(j,3)
              endif

              if (input%nf2_polyfile(j,1) /= "") then
                 ! PF from file
                 write(UREC, '(1x,a,i1,a,a)') "nf2_Dop", j, "(p1)", &
                      input%nf2_polyfile(j,1)
                 if (input%nf2_polyfile(j,2) /= "") then
                    write(UREC, '(1x,a,i1,a,a)') "nf2_Dop", j, "(p2)", &
                         input%nf2_polyfile(j,2)
                 endif
                 if (input%nf2_polyfile(j,3) /= "") then
                    write(UREC, '(1x,a,i1,a,a)') "nf2_Dop", j, "(p3)", &
                         input%nf2_polyfile(j,3)
                 endif

              elseif (input%nf2_porder(j,1) /= ZERO) then
                 ! PF as a pordeer
                 write(UREC, 423) "nf2_Dop", j, "(p1)", &
                      input%nf1_porder(j,1), input%nf2_mu(1), &
                      input%nf2_nu(1)
                 if (input%nf2_porder(j,2) /= ZERO) then
                    write(UREC, 423) "nf2_Dop", j, "(p1)", &
                         input%nf1_porder(j,1), input%nf2_mu(1), &
                         input%nf2_nu(1)
                 endif
                 if (input%nf2_porder(j,3) /= ZERO) then
                    write(UREC, 423) "nf2_Dop", j, "(p1)", &
                         input%nf1_porder(j,1), input%nf2_mu(1), &
                         input%nf2_nu(1)
                 endif
              endif
           endif

        enddo

        write(UREC, fmt) "csw_", i, "               ", trim(para%c_hmc(i)%csw)
        write(UREC, fmt) "n_stout_", i, "           ", trim(para%c_hmc(i)%n_stout)
        write(UREC, fmt) "alpha_", i, "             ", trim(para%c_hmc(i)%alpha)
        write(UREC, fmt) "theta_", i, "             ", trim(para%c_hmc(i)%theta)
        write(UREC,fmt2) "chemi_", i, "             ", trim(para%c_hmc(i)%chemi), trim(para%c_hmc(i)%chemi_i)
        write(UREC, fmt) "h_", i, "                 ", trim(para%c_hmc(i)%h)
        write(UREC, *) "gen_int", input%hmc_genint
        write(UREC, fmt) "traj_length_", i, "       ", trim(para%c_hmc(i)%traj_length)
        write(UREC, fmt) "tau_", i, "               ", trim(para%c_hmc(i)%tau)
        write(UREC, fmt) "N_tau_", i, "             ", trim(c_info_mdsteps(para%c_hmc(i)%ntau,    1,para%hmc(i)))
if(nts>1)write(UREC, fmt) "m_scale_", i, "           ", trim(c_info_mdsteps(para%c_hmc(i)%m_scale ,2,para%hmc(i)))
if(nts>2)write(UREC, fmt) "m_scale2_", i, "          ", trim(c_info_mdsteps(para%c_hmc(i)%m_scale2,3,para%hmc(i)))
if(nts>3)write(UREC, fmt) "m_scale3_", i, "          ", trim(c_info_mdsteps(para%c_hmc(i)%m_scale3,4,para%hmc(i)))
if(nts>4)write(UREC, fmt) "m_scale4_", i, "          ", trim(c_info_mdsteps(para%c_hmc(i)%m_scale4,5,para%hmc(i)))
if(nts>5)write(UREC, fmt) "m_scale5_", i, "          ", trim(c_info_mdsteps(para%c_hmc(i)%m_scale5,6,para%hmc(i)))
     enddo

     ! Using the full solver?
     write(UREC, '(1x, a, i2)') "solver_cg_poly", input%solver_cg_poly

     write(UREC, *) "hkappa",          input%hmc_hkappa

     if (switches%replay) then
     write(UREC,   *) "HMC_replay_ntau ", input%replay_trick_ntau
     write(UREC,   *) "HMC_replay_threshold ", input%replay_trick_threshold
     endif

     write(UREC, '(1x, a,i0)' )     "REAL_kind           ", RKIND
     if (input%solver_outer_steps == 0) then
     write(UREC, '(1x,2a)')         "Solver              ", trim(input%solver_outer_solver)
     else
     write(UREC, '(1x,3a,i2,3a)')   "Solver              ", trim(input%solver_outer_solver), " (", input%solver_outer_steps, " step outer) ", trim(input%solver_inner_solver), " (inner)"
     endif
     if (input%solver_stopping_criterion ==0) then
     write(UREC, '(1x,2a)')         "Solver criterion    ", "|r|^2"
     else
     write(UREC, '(1x,2a)')         "Solver criterion    ", "|r|/|b|"
     endif
     if (input%fullsolver=="dd" .and. ddable) then
     write(UREC, '(1x,2a)')         "Solver for Dop      ", "Domain-Decomposition"
     else
     write(UREC, '(1x,2a)')         "Solver for Dop      ", "Even-Odd"
     endif

     write(UREC, '(1x,2a,2(1x,a))') "Tolerance(mc md ev) ", trim(para%c_cg_rest), trim(input%solver_rest_md), trim(input%solver_rest_cg_ritz)

     if (ddable) then
        write(UREC, 404) "DD_rest(mc md sap):   ",trim(input%solver_rest_domain_mc), &
                                                  trim(input%solver_rest_domain_md), &
                                                  trim(input%solver_rest_domain_sap)
        write(UREC, 410) "DD_num[in(kv df) out(kv sap)]:", &
                                               input%solver_numkrylov_mtdmtdd, &
                                               input%solver_numdefvec_mtdmtdd, &
                                               input%solver_defsapgcr_nkv, &
                                               input%solver_defsapgcr_nsp
        if (ddallactive) then
           write(UREC,   *) "DD: all active"
        else
           write(UREC,   *) "DD: halo is NOT active"
        endif
     endif

     write(UREC,   *) "MRE_vectors ", mre_n_vec
#ifdef DDS
     write(UREC, 410) "DDS tuning:nmr,ncy,nkv,ndfl ", input%tuning_dds_nmr, &
                                                      input%tuning_dds_ncy, &
                                                      input%tuning_dds_nkv, &
                                                      input%tuning_dds_ndfl
#endif

     call end(UREC, "Header")

400  format (3(1x,a))
404  format (4(1x,a))
405  format (2(1x,a))
408  format (2(1x,a),1x,3a)
410  format (1x,a,4i3)
420  format (1x,a,i1,a,3f14.10)
421  format (1x,a,i1,a,i14)
422  format (1x,a,i1,a,3i14)
423  format (1x,a,i1,a,i14,2f14.5)

  endif

end

!-------------------------------------------------------------------------------
subroutine write_footer(time0)

  use module_function_decl
  use module_thread
  implicit none

  SEED    :: seed
  SECONDS :: time0, sekunden

  call begin(UREC, "Footer")

  if (my_pe() == 0) then
     write(UREC, 400) "Date", datum(), uhrzeit()
     write(UREC,   *) "Seed", ran_get_seed()
     write(UREC, 410) "CPU-Time", &
                      sekunden() - time0, "s on", num_pes() * n_thread, "CPUs"
  endif

400  format (3(1x,a))
410  format (1x,a,1x,f8.1,1x,a,1x,i5,1x,a)

#ifdef TIMING
  call tuning_info(UREC)
#endif

  TIMING_WRITE(UREC)

  call end(UREC, "Footer")

end

!-------------------------------------------------------------------------------
subroutine get_flags(flags) ! read command line arguments [and open output file]

  use typedef_cksum
  use typedef_flags
  use module_bqcd
  use module_function_decl
  use module_input
  implicit none

  type(type_flags), intent(out) :: flags

  integer                       :: iarg, length, stat, narg
  integer, external             :: ipxfargc
  character(len = 32)           :: opt

  flags%convert_to_ildg = .false.
  flags%continuation_job = .false.

  narg = ipxfargc()

  iarg = 1
  do while (iarg <= narg)
     call pxfgetarg(iarg, opt, length, stat)

     if (opt(1:1) == "-") then
        select case (opt)
        case ("-c")
           flags%continuation_job = .true.
           iarg = iarg + 1
        case ("-I")
           call input_dump(6)
           call comm_finalize()
           stop
        case ("-V")
           call input_init()  ! some input defaults are needed in version()
           call version()
           call comm_finalize()
           stop
        case ("--convert-to-ildg")
           flags%convert_to_ildg = .true.
           iarg = iarg + 1
        case default
           call usage()
        end select
     else
        exit
     endif
  enddo

  if (flags%convert_to_ildg .and. flags%continuation_job) call usage()

  call take_arg(iarg, flags%input, narg)

  if (iarg <= narg) then
     call take_arg(iarg, flags%output, narg)
     if (my_pe() == 0) then
        close(UREC)

        if (flags%continuation_job .or. flags%convert_to_ildg) then
           open(UREC, file = trim(flags%output), &
                   action = "write", position = "append", status = "unknown")
        else
           open(UREC, file = trim(flags%output),  action = "write", status ="unknown")
        endif
     endif
  endif
  if (narg >= iarg) call usage()

CONTAINS

  subroutine usage()
    implicit none
    call die("Usage: " // prog_name // " [-c|--convert-to-ildg] [-I] [-V] input [output]")
  end subroutine usage

  subroutine version()
    implicit none

    if (my_pe() == 0) then
       write(6,*) "This is ", prog_name, " ", prog_version, prog_revision
       write(6,*) "   input format:    ", input_version
       write(6,*) "   conf info format:", conf_info_version
       write(6,*) "   MAX_TEMPER:      ", MAX_TEMPER
       write(6,*) "   REAL kind:       ", RKIND
       write(6,*) "   Version of D:    ", version_of_d()
       write(6,*) "   Communication:   ", trim(comm_method())
       write(6,*) "   RandomNumbers:   ", trim(ran_name())
    endif
  end subroutine version

  subroutine take_arg(iarg, arg, narg)
    implicit none
    integer, intent(inout)          :: iarg
    character(len = *), intent(out) :: arg
    integer, intent(in)             :: narg
    integer                         :: length, stat

    if (iarg > narg) call usage()
    call pxfgetarg(iarg, arg, length, stat)
    if (length > len(arg)) then
       call die("get_flags(): " // arg // ": argument too long")
    endif
    iarg = iarg + 1
  end subroutine take_arg

end

!-------------------------------------------------------------------------------
character (len=50) function c_info_mdsteps(c_nsteps,nscale,parah)
  use module_input
  use typedef_hmc
  implicit none
  type(hmc_para), intent(in)    :: parah
  integer, intent(in) :: nscale
  character(len=*), intent(in) :: c_nsteps
  character(len=50) :: tmp_c, tmp_c1
  integer :: i, j

  write(tmp_c,"(a3,a7)")trim(c_nsteps), parah%integrator(nscale)       ;tmp_c1=tmp_c

  do i = 1, 6
  do j = 1, 4
     if(input%nf2_dsf(i,j)==nscale)write(tmp_c,"(a,a2,i1,i1)")trim(tmp_c1), "f",i,j;tmp_c1=tmp_c
  enddo
  enddo
  do i = 1, 6
     if(input%nf1_dsf(i)  ==nscale)write(tmp_c,"(a,a3,i1)")trim(tmp_c1), "fr",i;tmp_c1=tmp_c
  enddo

  ! PFHMC
  do i = 1, 6
     do j = 1, 3
        if (input%nf2_dsfp(i,j) == nscale) then
           write(tmp_c, "(a,a3,i1,i1)") trim(tmp_c1), "fp", i, j
           tmp_c1 = tmp_c
        endif
     enddo
  enddo

  ! PF-RHMC
  do i = 1, 6
     do j = 1, 3
        if (input%nf1_dsfp(i,j) == nscale) then
           write(tmp_c, "(a,a4,i1,i1)") trim(tmp_c1), "frp", i, j
           tmp_c1 = tmp_c
        endif
     enddo
  enddo


  ! truncated RHMC
  do i = 1, 6
     do j = 1, 3
        if (input%nf1_dsft(i,j) == nscale) then
           write(tmp_c, "(a,a4,i1,i1)") trim(tmp_c1), "frt", i, j
           tmp_c1 = tmp_c
        endif
     enddo
  enddo

  if(input%hmc_dsd      ==nscale)write(tmp_c,"(a,a4)")trim(tmp_c1), "dat";tmp_c1=tmp_c
  if(input%hmc_dsg      ==nscale)write(tmp_c,"(a,a4)")trim(tmp_c1), "  g";tmp_c1=tmp_c
  if(input%hmc_dsig     ==nscale)write(tmp_c,"(a,a4)")trim(tmp_c1), " ig";tmp_c1=tmp_c

  c_info_mdsteps=tmp_c1

end

!===============================================================================
