!===============================================================================
!
!  init_imp.F90 - init values for action
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 2007-2017 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 to report polynomial filtering and truncated ratapps
!
! Editor: Taylor Haar
! Last modified: 01/05/2017
!-------------------------------------------------------------------------------
# include "defs.h"

!-------------------------------------------------------------------------------
subroutine init_action()
  use module_action
  use module_switches
  implicit none

  if (gauge_action /= "NON") then
     action%plaq%aid = 1
     action%plaq%fid = 1
     action%plaq%sid = 0
  endif

  if (gauge_action /= "WILSON") then
     action%impg%aid = 2
     action%impg%fid = 2
     action%impg%sid = 0
 endif
end

!-------------------------------------------------------------------------------
subroutine init_imp_all(doall)
  use module_stout_field
  use module_field
  use module_action
  use module_input
  use module_function_decl
  use module_switches
  use module_poly
  use module_truncrat
  implicit none
  logical :: doall
  integer :: i, j
  integer, save :: count=0

  DEBUG2S("Start: init_imp_all")

  if (doall) then
     gauge(1:size(gauge))%init = .true.
     if (associated(stout)) stout(1:size(stout))%init = .true.
     if (associated(clover))clover(1:n_clover)%init = .true.
  endif

  if (associated(stout))then
     do i = 1, size(stout)
        call stout_link_smearing(i)
     enddo
  endif
  call init_gauge(2)
  if (associated(clover))then
     do i = 1, n_clover
        call init_clover(i)
     enddo
  endif

  !! This does not work new input scheme
  !!if (n_pfermi>0) call init_rid() !! just to initialize rid for next print

  !
  ! check
  !
  if(my_pe()==0 .and. count==0 ) then

  write(0,*)"================================================================="
  write(0,*)"=======================================================check para"

  if (n_pfermi>0)then
     write(0,*)"%pfermi: aid is defined at other place, and "
     write(0,*)"%pfermi: does not print more than 3 fermionic action"
     write(0,100)"%pfermi","ID", "aid", "fid", "mid1", "mid2", "type", " rid", " nth", "npf", "mts", "pid", "tid"
     do i = 1, n_pfermi
        write(0,101)"%pfermi", i, &
                 action%pfermi(i)%aid, action%pfermi(i)%fid, &
                 action%pfermi(i)%mid1,action%pfermi(i)%mid2,&
                 action%pfermi(i)%type, &
                 action%pfermi(i)%rid, action%pfermi(i)%nth, &
                 action%pfermi(i)%npf, action%pfermi(i)%mts, &
                 action%pfermi(i)%polyid, action%pfermi(i)%truncid
     enddo
  endif

  if (n_mtilde>0)then
     write(0,102)"%mtilde","ID", "cid", "did", "kappa", "cswk","rho","h","lambda","b", "em_charge"
     do i = 1, n_mtilde
        write(0,103)"%mtilde", i, &
        action%mtilde(i)%cid, action%mtilde(i)%did, &
        action%mtilde(i)%kappa, &
        action%mtilde(i)%cswkappa, &
        action%mtilde(i)%rho, &
        action%mtilde(i)%h, &
        action%mtilde(i)%lambda, &
        action%mtilde(i)%b, &
        action%mtilde(i)%em_charge
     enddo
  endif

  if (n_logdet>0)then
     write(0,104)"%logdet","cid", "aid", "fid"
     do i = 1, n_logdet
        write(0,105)"%logdet",action%logdet(i)%cid, &
                              action%logdet(i)%aid, &
                              action%logdet(i)%fid
     enddo
  endif

  if (n_clover>0)then
     write(0,106)"%clover","ID", "nf", "csw","kappa","cswk","lamk"
     do i = 1, n_clover
        write(0,107)"%clover",i,clvpar(i)%nf, clvpar(i)%csw, &
                    clvpar(i)%kappa, clvpar(i)%cswkappa, clvpar(i)%lambdakappa
     enddo
  endif

  ! Report on PFHMC polynomials
  if (associated(poly(1)%z_k)) then
     write(0, 108) "%poly", "ID", "ord", "c"
     do i = 1, n_poly_id
        write(0, 109) "%poly", i, poly(i)%n, poly(i)%c
        do j = 1, poly(i)%n
           write(0, 110) "%poly", "z_", j, poly(i)%z_k(j)
        enddo
     enddo
  endif

  ! Report on truncated ratapps
  if (truncrat(1)%rid > 0) then
     write(0, 111) "%trunc", "ID", "low", "high"
     do i = 1, n_trunc_id
        write(0, 112) "%trunc", i, truncrat(i)%n_low, truncrat(i)%n_high
     enddo
  endif


  do i = 1, 4
     write(0,200) breaking_term(i,1),breaking_term(i,2), &
                  breaking_term(i,3),breaking_term(i,4)
  enddo

  endif !! of if (my_pe()==0)
  count=1


  if (input%test_kernel/=0)then
#ifdef QWS
  call test_qws()
#endif

#ifdef MICVMULT
     call vec_mult_4d_test()
#endif
  endif

  DEBUG2S("End: init_imp_all")
100 format (1x,a7,3a4,3a5, 6a6)
101 format (1x,a7,3i4,3i5, 6i6)
102 format (1x,a7,3a4,a9  ,a18   ,a9  ,a9  ,a9  ,a20   ,a10  )
103 format (1x,a7,3i4,f9.6,f18.10,f9.6,f9.6,f9.6,f20.15,f10.4)
104 format (1x,a7,3a4)
105 format (1x,a7,3i4)
106 format (1x,a7,2a4,a9  ,a9  ,a18   ,a18   )
107 format (1x,a7,2i4,f9.4,f9.6,f18.10,f18.10)
108 format (a5,2a4,a9)
109 format (a5,2i4,f9.6)
110 format (a5,2x,a2,i3,1x,"(",f10.5,",",f10.5,")")
111 format (a6,2a4,a5)
112 format (a6,2i4,i5)
200 format ( 4("(",f10.5,",",f10.5,")") )
end

!-------------------------------------------------------------------------------
subroutine init_quark(mid)
  use module_action
  use module_switches
  use module_field
  implicit none
  integer, intent(in) :: mid

  if (mid == 0) return
  if (action%mtilde(mid)%cid /= 0)call init_clover(action%mtilde(mid)%cid)
  if (switches%qed) then
     if (gauge(2)%em_charge /= action%mtilde(mid)%em_charge) then
         gauge(2)%em_charge = action%mtilde(mid)%em_charge
         gauge(2)%init = .true.
     endif
  endif
  if (action%mtilde(mid)%did /= 0)call init_gauge(2)

end

!-------------------------------------------------------------------------------
subroutine init_gauge(id)
  use module_stout_field
  use module_field
  use module_function_decl
  use module_switches
  implicit none
  integer, intent(in) :: id

  if (id == 2 .and. (.not. switches%dynamical)) return
  if (id == 3 .and. (.not. switches%clover)) return
  if (.not. gauge(id)%init) return

  DEBUG2S("Start: init_gauge")

  if (gauge(id)%sid /= 0) then
     call stout_link_smearing(1)
     if (id == 2) then 
        call flip_bc2(gauge(id)%u,  stout(1)%iter(stout(1)%n)%u)
        if (switches%qed) call qed_qcd_mult(gauge(id)%u, a_qed_ptr, gauge(id)%em_charge)
        call gauge_copy_r8_to_r4(gauge_r4(id)%u, gauge(id)%u)
     endif
     if (id == 3) gauge(id)%u =>  stout(1)%iter(stout(1)%n)%u
  else
     if (id == 2) then
        call flip_bc2(gauge(id)%u,  gauge(1)%u)
        if (switches%qed) call qed_qcd_mult(gauge(id)%u, a_qed_ptr, gauge(id)%em_charge)
        call gauge_copy_r8_to_r4(gauge_r4(id)%u, gauge(id)%u)
     endif
     if (id == 3) gauge(id)%u =>  gauge(1)%u
  endif

  if (id == 2) then
     select case (version_of_d())
        case(4,45,8,85,520,100,101,102,103)
           call d_g_init(gauge(2)%u)
     end select
#ifdef BQCD_DDHMC
     call u2ddu(gauge(2)%u)
#endif
#ifdef BAGEL
     call copy_u_bagel_d()
#endif
  endif

  gauge(id)%init = .false.
  DEBUG2S("End: init_gauge")
end

!-------------------------------------------------------------------------------
subroutine init_clover(id)
  use module_vol
  use module_field
  use module_action
  use module_switches
  use module_function_decl
  use module_p_interface
  use module_p_interface_r4
  implicit none
  integer,intent(in) :: id
  REAL :: m1, m2
  integer :: len

  if (.not. switches%clover) return
  if (.not. clover(id)%init) return

  DEBUG2S("Start: init_clover")
  call init_gauge(3)

  if (clvpar(id)%lambdakappa == ZERO .and. finv_axion == ZERO) then
!!     call theta2m1m2(clover(id)%theta, m1, m2)
     m1=0
     m2=0
     call clover_init(clover(id)%cfield%a, clover(id)%cfield%i, clover(id)%cfield%b, gauge(3)%u, &
                      clvpar(id)%cswkappa, m1, m2)
     len=2*18*2*volh*2
     call copy_r8_to_r4(clover(id)%cfield_r4%a, clover(id)%cfield%a, len)
     call copy_r8_to_r4(clover(id)%cfield_r4%i, clover(id)%cfield%i, len)
     call copy_r8_to_r4(clover(id)%cfield_r4%b, clover(id)%cfield%b, len)
  else
     if (.not. associated(clover(id)%cfield12%a)) then
        if (my_pe()==0) write(0,*)"now allocate clover12x12 form" 
        nullify(clover(id)%cfield12%a)
        nullify(clover(id)%cfield12%i)
        nullify(clover(id)%cfield12%det)
        nullify(clover(id)%cfield12_r4%a)
        nullify(clover(id)%cfield12_r4%i)
        call allocate_clover_field12(clover(id)%cfield12%a)
        call allocate_clover_field12(clover(id)%cfield12%i)
        allocate(clover(id)%cfield12%det(volh,EVEN:ODD))
        call allocate_clover_field12_r4(clover(id)%cfield12_r4%a)
        call allocate_clover_field12_r4(clover(id)%cfield12_r4%i)
     endif
     call clover_init12(clover(id)%cfield12%a, clover(id)%cfield12%i, clover(id)%cfield12%det, gauge(3)%u, &
                      clvpar(id)%cswkappa, clvpar(id)%lambdakappa, finv_axion)
     len=2*144*volh*2
     call copy_r8_to_r4(clover(id)%cfield12_r4%a, clover(id)%cfield12%a, len)
     call copy_r8_to_r4(clover(id)%cfield12_r4%i, clover(id)%cfield12%i, len)
  endif

#ifdef BQCD_DDHMC
  call clover2cloverdd(id)
#endif
  clover(id)%init = .false.
  DEBUG2S("End: init_clover")
end
!-------------------------------------------------------------------------------
subroutine theta2m1m2(theta, m1, m2)
  implicit none
  REAL,intent(out) :: m1, m2
  REAL,intent(in)  :: theta

  m1 = ZERO
  m2 = ZERO
  if (theta == ZERO) return
  m1 =   theta !! / dble(nf)
  m2 = - theta !! / dble(nf)
!!     m1 = m1 * (ONE - para%kappa /0.138984_8)
!!     m2 = m2 * (ONE - para%kappa /0.138984_8)
!!     m1 = cosh(para%theta / TWO) - ONE + sinh(para%theta / TWO)
!!     m2 = cosh(para%theta / TWO) - ONE - sinh(para%theta / TWO)
!!     m1 = m1 * (ONE - para%kappa * EIGHT)
!!     m2 = m2 * (ONE - para%kappa * EIGHT)

end

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