! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !
! @@                                                                @@ !
! @@       PROGRAM  ASCOT 2014.440 (ver.4.53)                       @@ !
! @@     "Abinitio Simulation Code for Quantum Transport"           @@ !
! @@                                                                @@ !
! @@                                                                @@ !
! @@  AUTHOR(S): Naoki WATANABE, Nobutaka NISHIKAWA (Mizuho I.R.)   @@ !
! @@             Hisashi KONDO (Univ. Tokyo)                        @@ !
! @@                                                09/May/2014     @@ !
! @@                                                                @@ !
! @@  Contact address: Phase System Consortium                      @@ !
! @@                                                                @@ !
! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !

module ac_parameter
  implicit none

  real(8), parameter :: M_PI       = 3.141592653589793238462d0 
  real(8), parameter :: SQRT_PI    = 1.77245385090551602729d0 
  real(8), parameter :: M_2_SQRTPI = 1.12837916709551257390d0 
  real(8), parameter :: M_1_PI     = 0.31830988618379067154d0 
  real(8), parameter :: M_SQRT1_2  = 0.70710678118654752440d0 
  real(8), parameter :: M_LN2      = 0.69314718055994530942d0 
  real(8), parameter :: M_CBRT2    = 1.259921049894873191d0 
  real(8), parameter :: M_CBRT3    = 1.442249570307408302d0 
  real(8), parameter :: M_CBRTPI   = 1.464591887561523142d0 

  complex(8), parameter :: C1 = (1.0d0, 0.0d0 )
  complex(8), parameter :: C0 = (0.0d0, 0.0d0 )

  real(8), parameter :: RY_TO_AU = 1.d0/2.d0 
  real(8), parameter :: AU_TO_RY = 1.d0/RY_TO_AU 
  real(8), parameter :: AU_TO_AA = 0.529177249d0 
  real(8), parameter :: AA_TO_AU = 1.d0/AU_TO_AA 
  real(8), parameter :: AU_TO_EV = 27.211396212 
  real(8), parameter :: EV_TO_AU = 1.d0/AU_TO_EV 
  real(8), parameter :: KELVIN_TO_AU = 3.166829936860255d-06 
  real(8), parameter :: AU_TO_KELVIN = 1.d0/KELVIN_TO_AU 

  type Atom_type
     character(5)   :: name   
     integer        :: number 
     real(8)  :: Ro(3)  
     real(8)  :: Rc     
     real(8)  :: Q      
     real(8)  :: polarization 
     real(8)  :: force(3)  
     logical  :: optimize     
     real(8) :: opt_position(3)  
     real(8) :: opt_direction(3) 
     real(8), pointer :: force_past(:,:) 
  end type Atom_type

  type Spline_type
     integer :: N 
     real(8), pointer ::  vx(:) 
     real(8), pointer ::  vf(:) 
     real(8), pointer ::  vb(:) 
     real(8), pointer ::  vc(:) 
     real(8), pointer ::  vd(:) 
  end type Spline_type

  type RadialFunc_type
     integer          ::  l    
     real(8)          ::  Rc   
     real(8), pointer :: vR(:) 
     type(Spline_type):: fR    
     real(8), pointer :: vK(:) 
     real(8)          ::  Q    
  end type RadialFunc_type

  type SphericalBessel_type
     integer          :: Nr     
     integer          :: Nk     
     real(8), pointer :: vrx(:) 
     real(8), pointer :: vrw(:) 
     real(8), pointer :: vkx(:) 
     real(8), pointer :: vkw(:) 
  end type SphericalBessel_type

  type Element_type
     character(5)     :: name 
     integer          :: atomic_number 

     type(RadialFunc_type) :: rhoval 
     type(RadialFunc_type) :: Vval   

     integer          :: npao 
     type(RadialFunc_type), pointer :: vpao(:) 

     type(RadialFunc_type) :: Vloc 

     logical          :: dirac 
     integer          :: nVnon 
     type(RadialFunc_type), pointer :: vVnon(:,:) 


     integer          :: npao2 
     type(RadialFunc_type), pointer :: vpao2(:) 
     type(RadialFunc_type), pointer :: vpao2bar(:) 

     integer          :: nVloc 
     type(RadialFunc_type), pointer :: vVloc(:) 

     logical          :: pcc 
     type(RadialFunc_type) :: rhopcc 

     character(10)    :: namexc_pao 
     character(10)    :: namexc_vps 
  end type Element_type

  type Option_type
     logical :: na      = .true.           
     logical :: cluster = .false.          
     logical :: pcc     = .false.          
     logical :: spin_polar = .false.          
     logical :: spin_orbit = .false.          
     integer :: nspin   = 0                
     logical :: nohar   = .false.          
     logical :: noexc   = .false.          
     logical :: indirect_overlap = .false. 
     logical :: mx      = .false.          
     logical :: projection = .false.      
     logical :: ascot_negf = .false.       
     logical :: optimize   = .false.       
     logical :: atom_move   = .false. 
     character(50) :: optimize_method = "cg" 

     character(50) :: fname_accel_c  = ""  
     character(50) :: fname_accel_r  = ""  
     character(50) :: fname_accel_l  = ""  
     character(50) :: fname_ascot_vd = ""  
     character(50) :: fname_ascot_in = ""  

     character(50) :: fname_rhoscf_in   = "" 
     character(50) :: fname_matrices_in = "" 

     character(10) :: saveat = "every" 
     character(50) :: field_format = ".cube" 
     character(50) :: fname_rhoscf   = "" 
     character(50) :: fname_rhopcc = "" 
     character(50) :: fname_rhoval = "" 
     character(50) :: fname_vext = "" 
     character(50) :: fname_vhar = "" 
     character(50) :: fname_vexc = "" 
     character(50) :: fname_vtot = "" 
     character(50) :: fname_matrices = "" 

     character(50) :: file_ac_tempout
  end type Option_type

  type Cell_type
     real(8) :: La(3)    
     real(8) :: Lb(3)    
     real(8) :: Lc(3)    
     real(8) :: Lo(3)    
     integer        :: Na    
     integer        :: Nb    
     integer        :: Nc    
     real(8) :: dLa(3)   
     real(8) :: dLb(3)   
     real(8) :: dLc(3)   
     real(8) :: dKa(3)   
     real(8) :: dKb(3)   
     real(8) :: dKc(3)   
     real(8)        :: dKa1  
     real(8)        :: dKb1  
     real(8)        :: dKc1  
     real(8)        :: V     
     real(8)        :: dV    
     integer        :: nL    

     real(8), pointer :: vL(:,:) 
     integer, pointer :: vLna(:) 
     integer, pointer :: vLnb(:) 
     integer, pointer :: vLnc(:) 
  end type Cell_type

  type SCF_type
     character(10) :: exc_type = 'PZ81'     
     real(8) :: Te = 300.d0 * KELVIN_TO_AU  
     real(8) :: Ecutoff = 150.d0 * RY_TO_AU 
     integer :: Nka = 1 
     integer :: Nkb = 1 
     integer :: Nkc = 1 
     integer :: nK = 1                      
     real(8), pointer :: vK(:,:)       
     integer, pointer :: i_vK(:)
     complex(8), pointer :: vbloch(:,:)     

     character(16) :: mix_type = 'Simple'   
     character(16) :: mix_target = 'density_matrix'   
     real(8) :: mix_weight  =  0.3d0 
     real(8) :: mix_weight_s  =  -0.3d0
     integer :: mix_history = 4      
     integer :: mix_start   = 4      

     character(16) :: cri_type = 'fermi'    
     real(8) :: criterion = 1.e-6           
     integer ::  iter_max =  100 

     real(8) :: force_criterion = 1.0e-3    
     integer :: opt_iter_max =  0 
  end type SCF_type

  type Integral1D_type
     integer       ::  Nr = 900        
     integer       ::  Nk = 900        
     real(8) :: Ecutoff = 2500.d0 * RY_TO_AU 
  end type Integral1D_type

  type Kpath_type
     real(8) :: ks(3)   
     real(8) :: ke(3)   
     integer :: mesh 
  end type Kpath_type

  type Band_type
     character(64)  :: fname = ""                    
     character(64)  :: fname1 = ""                    
     real(8) :: La(3) = (/0,0,0/)          
     real(8) :: Lb(3) = (/0,0,0/)          
     real(8) :: Lc(3) = (/0,0,0/)          
     real(8) :: dKa(3)                           
     real(8) :: dKb(3)                           
     real(8) :: dKc(3)                           

     integer        :: nKpath                        
     type(Kpath_type), pointer :: vKpath(:)               
     integer        :: nK = 1                        
     real(8), pointer :: vK(:,:)                
     integer        :: num_band = 0                  
  end type Band_type

  type DOS_type
     character(50) :: fname = ""           
     real(8) :: Emin = -10.d0 * EV_TO_AU   
     real(8) :: Emax = +10.d0 * EV_TO_AU   
     real(8) :: GB = 0.1 * EV_TO_AU
     real(8) :: dE                         
     integer :: Ne = 101                   
     integer :: Nka = 0                    
     integer :: Nkb = 0                    
     integer :: Nkc = 0                    
     integer :: nK = 0                     
     character(16) :: method = 'gaussian' 
  end type DOS_type

  type MO_type
     character(50)  :: fbase = ""                    
     character(16)  :: method = 'ho_lumo'            
     integer        :: band_min=0                    
     integer        :: band_max=0                    
     real(8) :: La(3) = (/0,0,0/)          
     real(8) :: Lb(3) = (/0,0,0/)          
     real(8) :: Lc(3) = (/0,0,0/)          
     real(8) :: dKa(3)                           
     real(8) :: dKb(3)                           
     real(8) :: dKc(3)                           
     integer        :: nK = 0                        
     real(8), pointer :: vK(:,:)                 
  end type MO_type

  type Data_type
     character(50) :: path_pao = "." 
     character(50) :: path_vps = "." 
     character(50) :: element_type  = "ciao" 

     real(8) :: Ne_extra 
     real(8) :: Ne 
     real(8) :: g 
     integer                :: nelem    
     type(Element_type), pointer :: velem(:) 
     integer                :: natom    
     type(Atom_type), pointer    :: vatom(:) 

     integer       :: natom_left  = 0   
     integer       :: natom_right = 0   
     character(50), pointer, dimension(:,:) :: velem_file 

     integer          :: npao     
     integer, pointer :: vnpao(:) 
     integer, pointer :: vipao(:) 
     integer          :: nvps     
  end type Data_type

  type Param_type
     character(20)         :: name  = "" 
     type(Option_type)     :: Option     
     type(Cell_type)       :: Cell       
     type(SCF_type)        :: SCF        
     type(Integral1D_type) :: Integral1D 
     type(Band_type)       :: Band       
     type(DOS_type)        :: DOS        
     type(MO_type)         :: MO         
     type(Data_type)       :: Data       
  end type Param_type

  type Screening_type
     real(8) :: alpha 
     real(8), pointer :: PhiK(:,:,:) 
  end type Screening_type

  type Ewald_type
     real(8) :: alpha 
  end type Ewald_type

  type PAO_type
     real(8) :: Ro(3) 
     integer          :: m  
     integer          :: l  
     real(8)          :: Rc 
     type(RadialFunc_type), pointer :: RF 
     integer          :: range(6) 
     real(8), pointer :: wave(:,:,:) 
     real(8), pointer :: waveV(:,:,:) 
     real(8), pointer :: gwave(:,:,:,:) 
     real(8), pointer :: gwaveV(:,:,:,:) 
  end type PAO_type

  type Base_type
     integer            :: npao     
     type(PAO_type), pointer :: vpao(:)  
     integer, pointer   :: vnpao(:) 
     integer, pointer   :: vipao(:) 
  end type Base_type

  type PPcharge_type
     real(8) :: Ro(3) 
     real(8) :: Rc 
     type(RadialFunc_type), pointer :: RF 
  end type PPcharge_type

  type DensityPast_type
     real(8), pointer :: rho(:,:,:,:)    
     real(8), pointer :: drho(:,:,:,:)   
     complex(8), pointer :: rhoLS(:,:,:,:)    
     complex(8), pointer :: drhoLS(:,:,:,:)   
  end type DensityPast_type

  type Density_type
     real(8), pointer :: rho(:,:,:,:)    
     complex(8), pointer :: rhoLS(:,:,:,:)    
     real(8), pointer :: rhoval(:,:,:) 
     real(8), pointer :: rhopcc(:,:,:) 
     type(DensityPast_type), pointer :: vpast(:) 
  end type Density_type

  type PPloc_type
     real(8)        :: Ro(3) 
     real(8)        ::  Q 
     real(8)        :: Rc 
     type(RadialFunc_type), pointer ::  RF 
  end type PPloc_type

  type PPnon_type
     real(8) :: Ro(3) 
     integer        :: m  
     real(8)        :: E  
     integer        :: l  
     real(8)        :: Rc 
     type(RadialFunc_type), pointer :: RF 
  end type PPnon_type

  type Potential_type
     integer :: nVpsnon 
     type(PPnon_type), pointer :: vVpsnon(:,:) 
     integer, pointer :: vnVpsnon(:) 
     integer, pointer :: viVpsnon(:) 

     integer :: nVpsloc 
     integer, pointer :: vnVpsloc(:) 
     integer, pointer :: viVpsloc(:) 
     type(PPnon_type), pointer :: vVpsloc(:) 

     real(8), pointer :: Vext(:,:,:) 
     real(8), pointer :: dVhar(:,:,:) 
     real(8), pointer :: Vexc(:,:,:,:) 
     real(8), pointer :: Vtot(:,:,:,:) 
  end type Potential_type

  type Energy_type
     real(8) :: Ef 
     real(8) :: Etot 
  end type Energy_type

  type DensityMatrixPast_type
     real(8), pointer :: CDM(:,:,:)    
     real(8), pointer :: dCDM(:,:,:)   
     complex(8), pointer :: CDMLS(:,:,:)    
     complex(8), pointer :: dCDMLS(:,:,:)   
  end type DensityMatrixPast_type

  type AtomMatrix_type
     real(8), pointer :: S(:,:)     
     real(8), pointer :: H0(:,:,:)  
     real(8), pointer :: H (:,:,:)  
     complex(8), pointer :: H0LS(:,:,:)  
     complex(8), pointer :: HLS (:,:,:)  
     real(8), pointer :: CDM(:,:,:) 
     real(8), pointer :: EDM(:,:)   
     complex(8), pointer :: CDMLS(:,:,:) 
     real(8), pointer :: EDMLS(:,:)   
     type(DensityMatrixPast_type), pointer :: vpast(:) 
  end type AtomMatrix_type

  type AtomMatrix_Ptr_type
     type(AtomMatrix_type), pointer :: Ptr 
  end type AtomMatrix_Ptr_type

  type BandMatrix_type
     complex(8), pointer :: S(:,:)   
     complex(8), pointer :: H(:,:,:) 
     real(8),    pointer :: E(:,:)   
     real(8),    pointer :: F(:,:)   
  end type BandMatrix_type

  type Hamiltonian_type
     type(AtomMatrix_Ptr_type), pointer :: vAtomMatrix(:,:,:) 
     type(BandMatrix_type), pointer     :: vBandMatrix(:)     
  end type Hamiltonian_type

  type(Param_type), save, public     :: Param 
  type(Base_type), public            :: Base 
  type(Hamiltonian_type), public     :: Hamiltonian 
  type(Density_type), public         :: Density 
  type(Potential_type), public       :: Potential 
  type(Energy_type), public          :: Energy 
  type(Ewald_type), public           :: Ewald 
  type(SphericalBessel_type), public :: SphericalBessel 
  type(Screening_type), public       :: Screening 

  type SpinMatrix_type
     complex(8) :: element(2,2)
  end type SpinMatrix_type

contains

  function Position__oprod( r1, r2 ) result(r)
    real(8), intent(in) :: r1(3), r2(3)
    real(8) :: r(3)

    r(1) = r1(2)*r2(3) - r1(3)*r2(2)
    r(2) = r1(3)*r2(1) - r1(1)*r2(3)
    r(3) = r1(1)*r2(2) - r1(2)*r2(1)

    return
  end function Position__oprod

  function modp( n, m ) result(r)
    implicit none
    integer, intent(in) :: n, m
    integer :: r

    if( n>=1 ) then
       r=mod(n-1,m)+1
       return
    end if

    r=mod(n-1,m)
    r=mod(r+m,m)+1

    return
  end function modp

  function polar( theta ) result(c)
    implicit none
    real(8), intent(in) :: theta
    complex(8) :: c

    c = Cmplx( cos(theta), sin(theta) )

    return
  end function polar

  function cbrt(a) result(b)
    implicit none
    real(8), intent(in) :: a
    real(8) :: b

    if( a<0.d0 ) then
       b = (-1.0d0)*((-1.0d0)*a)**(1.d0/3.d0)
    else
       b = a**(1.d0/3.d0)
    end if

    return
  end function cbrt

  function Param__Data__getElement(name) result(elem)

    implicit none
    character(len=*), intent(in) :: name
    type(Element_type), pointer :: elem
    integer :: i

    do i=1, Param%Data%nelem
       if( Param%Data%velem(i)%name == name ) then
          elem => Param%Data%velem(i)
          return
       end if
    end do
    elem => Param%Data%velem(1) ! to suppress a warning

    write(*,*) '# Error!: atom ', trim(name), ' is not available'
    stop
  end function Param__Data__getElement

  function TO_AU( unit ) result(c)
    character(len=*), intent(in) :: unit
    real(8) :: c

    c = 1.d0
    select case(unit)
    case("au", "AU", "a.u.", "A.U.")
       c = 1.d0
    case("hartree", "Hartree", "HARTREE")
       c = 1.d0
    case("hartree/bohr", "Hartree/Bohr", "HARTREE/BOHR")
       c = 1.d0
    case("eV", "ev", "EV")
       c = EV_TO_AU
    case("ry", "Ry", "RY", "rydberg", "Rydberg")
       c = RY_TO_AU
    case("K","kelvin","Kelvin")
       c = KELVIN_TO_AU
    case("ang","Ang","angstrom","Angstrom")
       c = AA_TO_AU
    case default
       open(unit=16,file=Param%Option%file_ac_tempout,position='append')
       write(16,'(a,a)') '      ++++++ Error: unknown unit ', trim(unit)
       close(16)
       stop
    end select

    return
  end function TO_AU

end module ac_parameter
