!===============================================================================
!
! ildg_meta.F90 - write ILDG metadata
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 2007-2012 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/>.
!
!-------------------------------------------------------------------------------
# include "defs.h"

!-------------------------------------------------------------------------------
subroutine ildg_meta(which, para, conf, lfn, plaquette, precision, cksum)

  use typedef_para
  use module_counter
  use module_function_decl
  use module_input
  use module_ildg
  use module_vol
  implicit none

  character(*), intent(in)    :: which
  type(type_para), intent(in) :: para
  type(hmc_conf), intent(in)  :: conf(MAX_TEMPER)
  character(*), intent(in)    :: lfn
  REAL, intent(in)            :: plaquette
  integer, intent(in)         :: precision
  INT8, intent(in)            :: cksum

  FILENAME       :: template, xml
  character(256) :: line, line2
  character(25)  :: today
  character(5)   :: zone
  character(9)   :: c_precision(32:64)
  integer        :: i, j
  integer        :: iostat

  logical, save  :: ensemble_written = .false.

  c_precision(:) = "UNDEFINED"
  c_precision(32) = "single"
  c_precision(64) = "double"


  select case (which)

     case ("ensemble")
        if (ensemble_written) then
           return
        else
           ensemble_written = .true.
           call ildg_xml_file_ensemble(xml)
           template = input%ildg_template_ensemble
        endif

     case ("conf")
        call ildg_xml_file_conf(xml)
        template = input%ildg_template_conf

     case default
        call die("ildg_meta(): unknown case")
  end select

  write(UREC,*) "ildg-write ", trim(which), "-meta ", trim(xml)

  call date_and_time(zone=zone)
  today = uhrzeit()
  today = datum() // "T" // today(1:8) // zone(1:3) // ":" // zone(4:5)

  open(UTEMPLATE, file = trim(template), action = "read", status = "old")
  open(UXML, file = trim(xml), action = "write", status = "unknown")

  do
      read(UTEMPLATE, "(a)", iostat = iostat) line
      if (iostat /= 0) exit

      i = index(line, "#")
      if (i == 0) then
         write(UXML, "(a)") trim(line)
         cycle
      endif

      j = i + index(line(i+1:), "#")
      ASSERT(j > i + 1)

      select case (line(i+1:j-1))

# define ILDG_META_INPUT(key, value) \
         case(#key); \
         line2 = line(1:i-1) FORTRAN_STRCAT trim(adjustl(value)) FORTRAN_STRCAT trim(line(j+1:)); \
         write(UXML, "(a)") trim(line2)
# include "ildg_meta.h"

         case default
            call die("ildg_meta(): " // line(i+1:j-1) // ": unknown keyword")
      end select
  enddo

  close(UTEMPLATE)
  close(UXML)
end

!-------------------------------------------------------------------------------
subroutine ildg_xml_file_conf(fname)

  use module_counter
  use module_input
  use module_ildg_conf
  implicit none
  character(*), intent(out) :: fname
  integer :: i

  call ildg_filename(fname, WRITE, .false., "xml")

  i = index(fname, ascii_null)
  ASSERT(i > 0)
  fname(i:) = " "
end

!-------------------------------------------------------------------------------
subroutine ildg_xml_file_ensemble(fname)

  use module_counter
  use module_input
  use module_ildg_conf
  implicit none
  character(*), intent(out) :: fname

  write(fname, "(2a)")  trim(prefix), ".xml"
end

!-------------------------------------------------------------------------------
subroutine ildg_expand_input_lfn_mc()

  use module_input
  implicit none
  character(*), parameter :: qcdsf_clover_nf2 = "qcdsf/clover_nf2"
  character(*), parameter :: qcdsf_prefix = "//ldg/qcdsf/clover_nf2/"

  character(256):: lfn_mc
  character(18) :: qcdsf_ensemble_nf2
  character(4)  :: beta
  character(6)  :: kappa
  character(2)  :: ls, lt
  REAL          :: b, k

  read(input%beta(1), *) b
  read(input%kappa(1), *) k

  write(beta, "(f4.2)") b
  write(kappa, "(f6.5)") k
  write(ls, "(i2.2)") input%lattice(1)
  write(lt, "(i2.2)") input%lattice(4)
  
  beta(2:2) = "p"
  kappa(1:1) = "p"

  qcdsf_ensemble_nf2 = "b" // beta // "k" // kappa // "-" // ls // "x" // lt

  if (input%ildg_data_lfn_path == qcdsf_clover_nf2) then
      input%ildg_data_lfn_path = "lfn:" // qcdsf_prefix // qcdsf_ensemble_nf2
  else
      input%ildg_data_lfn_path = adjustl(input%ildg_data_lfn_path)
      call expand_filename(input%ildg_data_lfn_path, lfn_mc)
      input%ildg_data_lfn_path = lfn_mc
  endif

  if (input%ildg_markov_chain_uri == qcdsf_clover_nf2) then
      input%ildg_markov_chain_uri = "mc:" // qcdsf_prefix // qcdsf_ensemble_nf2
  else
      input%ildg_markov_chain_uri = adjustl(input%ildg_markov_chain_uri)
      call expand_filename(input%ildg_markov_chain_uri, lfn_mc)
      input%ildg_markov_chain_uri = lfn_mc
  endif

end

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