!===============================================================================
!
! files.F90
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 1998-2017 Hinnerk Stueben
!
! 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/>.
!
!-------------------------------------------------------------------------------
!
! restart_file:      progname.run.{res|count|ran|stop}
! restart_conf_file: progname.run.s.time.{u|phi}
! info_file:         progname.run.s.info
!
! conf_file:         progname.run.s1.s2.traj.time.u
! conf_info_file:    progname.run.s1.s2.traj.info
!
! restart_file:      progname.run.<ext>
! traj_file:         progname.run.traj.<ext>
!
!-------------------------------------------------------------------------------
# include "defs.h"

!-------------------------------------------------------------------------------
module module_files   ! formats of file name strings

  implicit none

  ! lengths of formats of file name strings

  integer, parameter :: l_name = 2
  integer, parameter :: l_ext = 2
  integer, parameter :: l_sep = 5
  integer, parameter :: l_num = 4

  integer, parameter :: l_base = l_name + l_sep + l_num
  integer, parameter :: l_conf = l_base + 3 * (l_sep + l_num)

  ! formats of file name strings

  character(len = l_name), save :: fmt_name     = "(a"
  character(len = l_name), save :: fmt_ext      = "a)"
  character(len = l_sep), save  :: fmt_sep      = ",'.',"
  character(len = l_num), save  :: fmt_run      = "i3.3"
  character(len = l_num), save  :: fmt_ensemble = "i1.1"
  character(len = l_num), save  :: fmt_traj     = "i5.5"
  character(len = l_num), save  :: fmt_time     = "i2.2"
  
  character(len = *), parameter :: ext_count = "count"
  character(len = *), parameter :: ext_ran   = "ran"
  character(len = *), parameter :: ext_res   = "res"
  character(len = *), parameter :: ext_u     = "u"
  character(len = *), parameter :: ext_u1    = "u1"
  character(len = *), parameter :: ext_su3   = "su3"
  character(len = *), parameter :: ext_phi   = "phi"
  character(len = *), parameter :: ext_axion = "axion"
  character(len = *), parameter :: ext_info  = "info"
  character(len = *), parameter :: ext_stop  = "STOP"

CONTAINS

  character(len=l_base) function fmt_base()
    fmt_base = fmt_name // fmt_sep // fmt_run
  end function fmt_base

  character(len=l_conf) function fmt_conf()
    fmt_conf = fmt_base() // fmt_sep // fmt_ensemble &
                          // fmt_sep // fmt_ensemble &
                          // fmt_sep // fmt_traj
  end function fmt_conf

end

!-------------------------------------------------------------------------------
FILENAME function count_file()

  use module_files
  implicit none
  FILENAME :: restart_file

  count_file = restart_file(ext_count)
end

!-------------------------------------------------------------------------------
FILENAME function ran_file()

  use module_files
  implicit none
  FILENAME :: restart_file

  ran_file = restart_file(ext_ran)
end

!-------------------------------------------------------------------------------
FILENAME function res_file()

  use module_files
  implicit none
  FILENAME :: restart_file

  res_file = restart_file(ext_res)
end

!-------------------------------------------------------------------------------
FILENAME function stop_file()

  use module_files
  implicit none
  FILENAME :: restart_file

  stop_file = restart_file(ext_stop)
end

!-------------------------------------------------------------------------------
FILENAME function u_file(i_ensemble, time)

  use module_files
  use module_input
  implicit none
  integer, intent(in) :: i_ensemble, time
  FILENAME, external :: restart_conf_file
  FILENAME, external :: restart_file

  u_file = restart_conf_file(i_ensemble, time, ext_u)

  if (input%io_restart_format == "bqcd2") then
     CHECK(input%ensembles == 1)
     u_file = restart_file(ext_su3)
  endif
end

!-------------------------------------------------------------------------------
FILENAME function phi_file(i_ensemble, time)

  use module_files
  implicit none
  integer, intent(in) :: i_ensemble, time
  FILENAME :: restart_conf_file

  phi_file = restart_conf_file(i_ensemble, time, ext_phi)
end

!-------------------------------------------------------------------------------
FILENAME function u1_file(i_ensemble, time)

  use module_files
  use module_input
  implicit none
  integer, intent(in) :: i_ensemble, time
  FILENAME, external :: restart_conf_file
  FILENAME, external :: restart_file

  u1_file = restart_conf_file(i_ensemble, time, ext_u1)

  if (input%io_restart_format == "bqcd2") then
     CHECK(input%ensembles == 1)
     u1_file = restart_file(ext_u1)
  endif
end

!-------------------------------------------------------------------------------
FILENAME function axion_file(i_ensemble, time)

  use module_files
  use module_input
  implicit none
  integer, intent(in) :: i_ensemble, time
  FILENAME, external :: restart_conf_file
  FILENAME, external :: restart_file

  axion_file = restart_conf_file(i_ensemble, time, ext_axion)

  if (input%io_restart_format == "bqcd2") then
     CHECK(input%ensembles == 1)
     axion_file = restart_file(ext_axion)
  endif
end

!-------------------------------------------------------------------------------
FILENAME function restart_file(ext)

  use module_bqcd
  use module_counter
  use module_files
  use module_input
  implicit none

  character(len = *), intent(in) :: ext

  call expand_filename(input%io_bqcd_restart_filename, restart_file)

  restart_file = trim(restart_file) // '.' // ext 

end

!-------------------------------------------------------------------------------
FILENAME function restart_conf_file(i_ensemble, time, ext)

  use module_bqcd
  use module_counter
  use module_files
  use module_input
  implicit none

  integer, intent(in)            :: i_ensemble, time
  character(len = *), intent(in) :: ext
  FILENAME_FORMAT                :: fmt

  CHECK(input%ensembles == 1)

  fmt = fmt_name // fmt_sep // fmt_time // fmt_sep // fmt_ext

  call expand_filename(input%io_bqcd_restart_filename, restart_conf_file)

  write(restart_conf_file, fmt) trim(restart_conf_file), time, ext

end

!-------------------------------------------------------------------------------
FILENAME function info_file(i_ensemble)

  use module_bqcd
  use module_counter
  use module_files
  use module_input
  implicit none

  integer, intent(in)            :: i_ensemble
  FILENAME, external             :: restart_file

  CHECK(input%ensembles == 1)

  info_file = restart_file(ext_info)

end

!-------------------------------------------------------------------------------
FILENAME function conf_info_file(i_ensemble1, i_ensemble2)

  use module_bqcd
  use module_counter
  use module_files
  use module_input
  implicit none

  integer, intent(in)            :: i_ensemble1, i_ensemble2
  FILENAME, external             :: traj_file

  CHECK(input%ensembles == 1)

  conf_info_file = traj_file(ext_info)

end

!-------------------------------------------------------------------------------
FILENAME function conf_file(i_ensemble1, i_ensemble2, time)

  use module_bqcd
  use module_counter
  use module_files
  use module_input
  implicit none

  integer, intent(in)            :: i_ensemble1, i_ensemble2, time
  FILENAME, external             :: traj1_file
  FILENAME, external             :: traj_file

  CHECK(input%ensembles == 1)

  conf_file = traj1_file(time, ext_u)

  if (input%io_restart_format == "bqcd2") then
     conf_file = traj_file(ext_su3)
  endif

end

!-------------------------------------------------------------------------------
FILENAME function conf_u1_file(i_ensemble1, i_ensemble2, time)

  use module_bqcd
  use module_counter
  use module_files
  use module_input
  implicit none

  integer, intent(in)            :: i_ensemble1, i_ensemble2, time
  FILENAME, external             :: traj1_file
  FILENAME, external             :: traj_file

  CHECK(input%ensembles == 1)

  conf_u1_file = traj1_file(time, ext_u1)

  if (input%io_restart_format == "bqcd2") then
     conf_u1_file = traj_file(ext_u1)
  endif

end

!-------------------------------------------------------------------------------
FILENAME function conf_axion_file(i_ensemble1, i_ensemble2, time)

  use module_bqcd
  use module_counter
  use module_files
  use module_input
  implicit none

  integer, intent(in)            :: i_ensemble1, i_ensemble2, time
  FILENAME, external             :: traj1_file
  FILENAME, external             :: traj_file

  CHECK(input%ensembles == 1)

  conf_axion_file = traj1_file(time, ext_axion)

  if (input%io_restart_format == "bqcd2") then
     conf_axion_file = traj_file(ext_axion)
  endif

end

!-------------------------------------------------------------------------------
FILENAME function traj1_file(time, ext)

  use module_bqcd
  use module_counter
  use module_files
  use module_input
  implicit none

  integer, intent(in)            :: time
  character(*), intent(in)       :: ext
  
  FILENAME_FORMAT                :: fmt
  FILENAME                       :: extension
  FILENAME, external             :: traj_file

  fmt = '(' // fmt_time // fmt_sep // fmt_ext
  
  write(extension, fmt) time, ext

  traj1_file = traj_file(trim(extension))

end

!-------------------------------------------------------------------------------
FILENAME function traj_file(ext)

  use module_bqcd
  use module_counter
  use module_files
  use module_input
  implicit none

  character(*), intent(in)       :: ext
  
  call expand_filename(input%io_bqcd_conf_filename, traj_file)

  traj_file = trim(traj_file) // '.' // ext 

end

!-------------------------------------------------------------------------------
subroutine check_fmt(run, max_temper, max_traj, max_time)

  use module_files
  use module_lattice
  use module_function_decl
  implicit none
  integer :: run, max_temper, max_traj, max_time

  if (run > 999)        write(fmt_run,     "(a,i0,a,i0)") "i", getdigit(run),       ".", getdigit(run)
  if (max_temper > 9)   write(fmt_ensemble,"(a,i0,a,i0)") "i", getdigit(max_temper),".", getdigit(max_temper)
  if (max_traj > 99999) write(fmt_traj,    "(a,i0,a,i0)") "i", getdigit(max_traj),  ".", getdigit(max_traj)
  if (max_time > 99)  fmt_time = "i3.3"
  if (max_time > 999) fmt_time = "i4.4"

  call check_len(run,        fmt_run,      "RUN")
  call check_len(max_temper, fmt_ensemble, "TEMPER")
  call check_len(max_traj,   fmt_traj,     "TRAJ")
  call check_len(max_time,   fmt_time,     "TIME")

CONTAINS

  subroutine check_len(counter, counter_fmt, counter_name)

    implicit none
    integer :: i, len, counter
    character(len = *) :: counter_fmt, counter_name

    i = index(counter_fmt, "i")

    if (i == 0) then
       call die("check_fmt(): unable to check fmt for " // counter_name)
    endif

    read(counter_fmt(i+1:i+1), *) len

    if (counter < 0 .or. counter >= 10**len) then
       call die("check_fmt(): file name format unsuitable for " // counter_name)
    endif

  end subroutine check_len

end

!-------------------------------------------------------------------------------
subroutine set_fmt_ensemble(N_temper)

  use module_files
  implicit none

  integer, intent(in) :: N_temper

  if (N_temper < 10) then
     fmt_ensemble = "i1.1"
  else if (N_temper < 100) then
     fmt_ensemble = "i2.2"
  else
     call die ("set_fmt_ensemble(): N_temper >= 100 ???")
  endif

end


!-------------------------------------------------------------------------------
function format_ensemble()

  use module_files
  implicit none
  character(len = l_num) :: format_ensemble

  format_ensemble = fmt_ensemble
end

!-------------------------------------------------------------------------------
subroutine filename_test()

  use module_function_decl
  implicit  none
  integer   i

  FILENAME, external :: count_file
  FILENAME, external :: ran_file
  FILENAME, external :: res_file
  FILENAME, external :: stop_file
  FILENAME, external :: u_file
  FILENAME, external :: phi_file
  FILENAME, external :: u1_file
  FILENAME, external :: axion_file
  FILENAME, external :: restart_file
  FILENAME, external :: restart_conf_file
  FILENAME, external :: info_file
  FILENAME, external :: conf_info_file
  FILENAME, external :: conf_file
  FILENAME, external :: conf_u1_file
  FILENAME, external :: conf_axion_file
  FILENAME, external :: traj_file

  !!do i = 1, 11, 10
  !!   call set_fmt_ensemble(i)

     PUTVAL(6, trim(count_file()))
     PUTVAL(6, trim(ran_file()))
     PUTVAL(6, trim(res_file()))
     PUTVAL(6, trim(stop_file()))
     PUTVAL(6, trim(u_file(3, 4)))
     PUTVAL(6, trim(phi_file(5, 6)))
     PUTVAL(6, trim(u1_file(7, 8)))
     PUTVAL(6, trim(axion_file(9, 10)))
     PUTVAL(6, trim(restart_file('restart')))
     PUTVAL(6, trim(restart_conf_file(1, 2, 'restart_conf')))
     PUTVAL(6, trim(info_file(1)))
     PUTVAL(6, trim(conf_info_file(1, 1)))
     PUTVAL(6, trim(conf_file(1, 1, 2)))
     PUTVAL(6, trim(conf_u1_file(1, 1, 3)))
     PUTVAL(6, trim(conf_axion_file(1, 1, 4)))
     PUTVAL(6, trim(traj_file('traj')))
  !!enddo

end

!-------------------------------------------------------------------------------
subroutine expand_filename(orig, expanded)

  use module_input
  use module_counter
  implicit none

  character(*), intent(in)  :: orig
  character(*), intent(out) :: expanded

  character(32) :: tmp, fmt
  character(8)  :: kappa, kappa_strange, lambda_l, lambda_s
  integer       :: i, j, length, ix
  
  length = len(trim(orig))

  i = 1
  j = 0
  expanded = ""

  write(kappa,         "(f8.6)") input%nf2_kappa1
  write(kappa_strange, "(f8.6)") input%nf1_kappa1
  write(lambda_l,      "(f8.6)") input%nf2_lambda1
  write(lambda_s,      "(f8.6)") input%nf1_lambda1

  do while (i <= length)
     if (i <= length - 2 .and. orig(i:i) == "%") then
        select case (orig(i+1:i+2))
        case ("BE"); call add_beta(input%beta(1))
!!      case ("KA"); call add_kappa(input%kappa(1))
!!      case ("KL"); call add_kappa(input%kappa(1))
!!      case ("KS"); call add_kappa(input%kappa_strange(1))
        case ("KL"); call add_kappa(kappa)
        case ("KS"); call add_kappa(kappa_strange)
!!        case ("LL"); call add_lambda_l(input%lambda_l(1)) deprecated
!!        case ("LS"); call add_lambda_s(input%lambda_s(1)) deprecated
        case ("LL"); call add_lambda_l(lambda_l)
        case ("LS"); call add_lambda_s(lambda_s)
        case ("LX"); call add_l(input%lattice(1))
        case ("LY"); call add_l(input%lattice(2))
        case ("LZ"); call add_l(input%lattice(3))
        case ("LT"); call add_l(input%lattice(4))
        case ("R1"); call add_counter(counter%run, 1)
        case ("R2"); call add_counter(counter%run, 2)
        case ("R3"); call add_counter(counter%run, 3)
        case ("R4"); call add_counter(counter%run, 4)
        case ("R5"); call add_counter(counter%run, 5)
        case ("R6"); call add_counter(counter%run, 6)
        case ("R7"); call add_counter(counter%run, 7)
        case ("R8"); call add_counter(counter%run, 8)
        case ("R9"); call add_counter(counter%run, 9)
        case ("T1"); call add_counter(counter%traj, 1)
        case ("T2"); call add_counter(counter%traj, 2)
        case ("T3"); call add_counter(counter%traj, 3)
        case ("T4"); call add_counter(counter%traj, 4)
        case ("T5"); call add_counter(counter%traj, 5)
        case ("T6"); call add_counter(counter%traj, 6)
        case ("T7"); call add_counter(counter%traj, 7)
        case ("T8"); call add_counter(counter%traj, 8)
        case ("T9"); call add_counter(counter%traj, 9)
        end select
        i = i + 3
     else
        call add_to_expanded(orig(i:i))
        i = i + 1
     endif

  enddo

CONTAINS

  !----------------------------------------------------------------------
  subroutine add_to_expanded(s)
    character(*) :: s
    integer      :: len_s

    len_s = len(trim(adjustl(s)))
    CHECK(j + len_s <= len(expanded)) 
    expanded(j+1:j+len_s) = trim(adjustl(s))
    j = j + len_s
  end subroutine add_to_expanded

  !----------------------------------------------------------------------
  subroutine add_beta(b)
    character(*) b

    ix = index(b, ".")
    if (ix > 0) then
       call add_to_expanded("b" // b(1:ix-1) // "p" // b(ix+1:))
    else
       call add_to_expanded("b" // b)
    endif
  end subroutine add_beta

  !----------------------------------------------------------------------
  subroutine add_kappa(k)
    character(*) k

    ix = index(k, ".")
    if (ix > 0) then
       call add_to_expanded("kp" // k(ix+1:))
    else
       call add_to_expanded("k" // k)
    endif
  end subroutine add_kappa

  !----------------------------------------------------------------------
  subroutine add_lambda_l(l)
    character(*) l

    ix = index(l, ".")
    if (ix > 0) then
       call add_to_expanded("ll" // l(ix+1:))
    else
       call add_to_expanded("ll" // l)
    endif
  end subroutine add_lambda_l

  !----------------------------------------------------------------------
  subroutine add_lambda_s(l)
    character(*) l

    ix = index(l, ".")
    if (ix > 0) then
       call add_to_expanded("ls" // l(ix+1:))
    else
       call add_to_expanded("ls" // l)
    endif
  end subroutine add_lambda_s

  !----------------------------------------------------------------------
  subroutine add_l(l)
    integer :: l

    write(tmp,*) l
    call add_to_expanded(tmp)
  end subroutine add_l

  !----------------------------------------------------------------------
  subroutine add_counter(counter, width)
    integer :: counter, width
    
    if (counter >= 10**width) then
        fmt = "(i0)"
    else
        write(fmt,"(a,i0,a,i0,a)") "(i", width, ".", width, ")" 
    endif
    write(tmp,fmt) counter
    call add_to_expanded(tmp)
  end subroutine add_counter

end

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