  !+ graph: false
  !+ author: Alberto Garcia

  !+ Data structures to handle the PSML pseudopotential format.

#if defined HAVE_CONFIG_H
#include "config.h"
#endif

module m_psml_core

use m_psml_assoc_list, only: ps_annotation_t => assoc_list_t
use m_psml_assoc_list, only: ps_clean_annotation => assoc_list_reset
use m_psml_class_Grid

use m_psml_external_interfaces, only: die => psml_die

implicit none

private

!
! Update this. Up to 99...
integer, parameter    :: PATCH_LEVEL = 0
!
! Only update 1000 when changing major/minor version
integer, parameter, public  :: PSML_LIBRARY_VERSION = 2000 + PATCH_LEVEL
!
!  Simple sanity checks while the format evolves
!  This version is able to read v1.0 and v1.2 PSML files
!
!  Note that the version is really given by the generators.
!
! The "hi" value is intended to auto-revoke the library, but
! it is neither completely foolproof nor flexible enough.
!
real, parameter, public  :: PSML_TARGET_VERSION_LO = 1.00
real, parameter, public  :: PSML_TARGET_VERSION_HI = 1.20

!----------------------------------------------------------------
! Hardwired parameters (to be made dynamical in a later version)

! Maximum number of valence shells (including semicore) or core shells:
integer, parameter, private    :: MAXN_SHELLS = 20
!----------------------------------------------------------------

integer, parameter, private    :: dp = selected_real_kind(14)
!
!-----------------------------------------------------------

type, public :: input_file_t
        character(len=100)            :: name = "-----"
        character(len=:), allocatable :: buffer
end type input_file_t

!------
type, public :: provenance_t
   type(provenance_t), pointer  :: prev  => null()
        integer                 :: record_number
        character(len=100)      :: creator = "-----"
        character(len=60)       :: date    = "-----"
        integer                 :: n_input_files = 0  ! Max 1 for now !!
        type(input_file_t)      :: input_file
        type(ps_annotation_t)   :: annotation
   type(provenance_t), pointer  :: next => null()
end type provenance_t
!------
type, public :: header_t
   ! This is the 'pseudo-atom-spec' section
   
        character(len=100)      :: atomic_label    !! generalized symbol
        real(kind=dp)           :: z  !! atomic number (might be non-integer)
        real(kind=dp)           :: zpseudo !! Z - ncore-electrons
        character(len=100)      :: flavor  !! pseudization method
        character(len=6)        :: relativity !! "no|scalar|dirac"
        logical                 :: polarized !! is spin-DFT?
        !
        character(len=3)        :: core_corrections !! are there NLCC's?
        character(len=3)        :: meta_gga         !! includes kinetic-energy-densities?
      !
      type(ps_annotation_t)   :: annotation
end type header_t
!------
type, public :: config_val_t
      integer                          :: nshells
      real(kind=dp)                    :: total_charge
      integer, dimension(MAXN_SHELLS)  :: n
      character(len=1), dimension(MAXN_SHELLS) :: l
      real(dp), dimension(MAXN_SHELLS) :: occ
      real(dp), dimension(MAXN_SHELLS) :: occ_up
      real(dp), dimension(MAXN_SHELLS) :: occ_down
      !
      type(ps_annotation_t)   :: annotation
end type config_val_t
!------
type, public :: xc_t
        integer                         :: n_functs_libxc = 0
        character(len=200), allocatable :: libxc_name(:)
        character(len=100), allocatable :: libxc_type(:)
        integer, allocatable            :: libxc_id(:)
        real(dp), allocatable           :: libxc_weight(:)
        type(ps_annotation_t)           :: annotation
end type xc_t
!------
type, public :: radfunc_t
      type(Grid)                              :: grid
      real(kind=dp), dimension(:), pointer    :: data => null()
      logical                                 :: has_coulomb_tail
      real(dp)                                :: tail_factor = 0.0_dp
      integer                                 :: nnz ! # of 'non-zero' values
      real(dp)                                :: rcut_eff ! effective end of range
 
end type radfunc_t      
!
!===============================================
type, public :: slps_t
      integer           :: n
      character(len=1)  :: l
      real(dp)          :: j = -1.0_dp
      integer           :: set
      character(len=100):: flavor
      real(dp)          :: rc
      real(dp)          :: eref  ! Reference energy
      type(radfunc_t)   :: V
      type(semilocal_t), pointer :: parent_group => null()
   type(slps_t), pointer :: next => null()

end type slps_t

type, public :: sl_table_t
   type(slps_t), pointer :: p => null()
end type sl_table_t

type, public :: semilocal_t
   type(slps_t), pointer :: pot => null()
   integer           :: set
   !
   ! Optional private grid
   !
   type(Grid)             :: grid
   type(ps_annotation_t)  :: annotation
   !
   type(semilocal_t), pointer     :: next => null()

end type semilocal_t
!===============================================

type, public :: local_t
   !
      type(ps_annotation_t)                     :: annotation

   ! Optional private grid
   !
      type(Grid)                               :: grid

      type(radfunc_t)                          :: Vlocal
      character(len=100)                       :: vlocal_type

      type(radfunc_t)                          :: Chlocal
end type local_t

!===============================================
type, public :: nlpj_t
      integer           :: seq
      character(len=1)  :: l
      real(dp)          :: j = -1.0_dp
      integer           :: set
      character(len=100):: type
      real(dp)          :: ekb
      real(dp)          :: eref  ! Reference energy
      type(radfunc_t)   :: proj

      type(nonlocal_t), pointer :: parent_group => null()
   type(nlpj_t), pointer :: next => null()

end type nlpj_t

type, public :: nl_table_t
   type(nlpj_t), pointer :: p => null()
end type nl_table_t

type, public :: nonlocal_t
   type(nlpj_t), pointer :: proj => null()
   integer           :: set
   !
   ! Optional private grid
   !
   type(Grid)                               :: grid
   type(ps_annotation_t)  :: annotation
   !
   type(nonlocal_t), pointer     :: next => null()

end type nonlocal_t
!===============================================
! Wavefunctions
!
type, public :: wf_t
      integer           :: n
      character(len=1)  :: l
      integer           :: set
      real(dp)          :: j = -1.0_dp
      real(dp)          :: energy_level
      type(radfunc_t)   :: Phi
      type(wfns_t), pointer :: parent_group => null()
   type(wf_t), pointer :: next => null()

end type wf_t

type, public :: wf_table_t
   type(wf_t), pointer :: p => null()
end type wf_table_t

type, public :: wfns_t
   type(wf_t), pointer :: wf => null()
   integer             :: set
   character(len=100)  :: type = ""
   !
   ! Optional private grid
   !
   type(Grid)             :: grid
   type(ps_annotation_t)  :: annotation
   !
   type(wfns_t), pointer     :: next => null()

end type wfns_t

type, public :: valence_charge_t
      real(dp)        :: total_charge
      character(len=3):: is_unscreening_charge = ""
      character(len=3):: rescaled_to_z_pseudo  = ""

      type(radfunc_t) :: rho_val
      type(ps_annotation_t)   :: annotation
end type valence_charge_t

type, public :: core_charge_t
      integer         :: n_cont_derivs
      real(dp)        :: rcore
      type(radfunc_t) :: rho_core

      type(ps_annotation_t)           :: annotation
end type core_charge_t

! MGGA  ---
type, public :: valence_kinetic_energy_density_t  ! valence-kinetic-energy-density
      character(len=3):: is_unscreening_tau = ""
      type(radfunc_t) :: kin_edens_val
      type(ps_annotation_t)   :: annotation
end type valence_kinetic_energy_density_t

type, public :: core_kinetic_energy_density_t
      integer         :: n_cont_derivs
      real(dp)        :: rcore

      type(radfunc_t) :: kin_edens_core

      type(ps_annotation_t)           :: annotation
end type core_kinetic_energy_density_t
! ----

type, public :: ps_t
!! Main derived type to hold the PSML information
      character(len=10)                  :: version     = ""
      character(len=40)                  :: energy_unit = ""
      character(len=40)                  :: length_unit = ""
      character(len=36)                  :: uuid = ""
      character(len=200)                 :: namespace = ""
      type(ps_annotation_t)              :: annotation   ! V1.0 only
      type(provenance_t), pointer        :: provenance => null()
      type(header_t)                     :: header     ! pseudo-atom-spec
      type(config_val_t)                 :: config_val
      type(config_val_t)                 :: config_core  ! extension
      type(xc_t)                         :: xc_info
      type(Grid)                         :: global_grid
      type(local_t)                      :: local
      type(semilocal_t), pointer         :: semilocal => null()
      type(nonlocal_t), pointer          :: nonlocal => null()
      type(wfns_t), pointer              :: wavefunctions => null()
      !
      type(valence_charge_t)             :: valence_charge
      type(core_charge_t)                :: core_charge
      !
      type(valence_kinetic_energy_density_t)  :: valence_kinetic_energy_density
      type(core_kinetic_energy_density_t)     :: core_kinetic_energy_density
      !
      ! index tables
      !
      type(sl_table_t), allocatable      :: sl_table(:)
      type(nl_table_t), allocatable      :: nl_table(:)
      type(wf_table_t), allocatable      :: wf_table(:)

   end type ps_t

   integer,  parameter, public   &
                          :: SET_NULL     =   0, &
                             SET_SREL     =   1, &
                             SET_NONREL   =   2, &
                             SET_SO       =   4, &
                             SET_LJ       =   8, &
                             SET_UP       =  16, &
                             SET_DOWN     =  32, &
                             SET_SPINAVE  =  64, &
                             SET_SPINDIFF = 128, &         ! 2^7
                             SET_USER1    = 256, &         ! 2^8
                             SET_USER2    = 512            ! 2^9

   integer, parameter, public    :: SET_ALL =  2**10 -1

 public  :: ps_destroy
 public  :: str_of_set

 public  :: setcode_of_string    ! utility function, not for client normal use

 public  :: destroy_local
 public  :: destroy_nonlocal
 public  :: destroy_wavefunctions
 
 CONTAINS

subroutine ps_destroy(ps)
!! Cleans the ps object
type(ps_t), intent(inout)     :: ps

integer :: i

call ps_clean_annotation(ps%annotation)

call destroy_provenance(ps%provenance)

call ps_clean_annotation(ps%header%annotation)
call ps_clean_annotation(ps%config_val%annotation)
call ps_clean_annotation(ps%config_core%annotation)
call destroy_xc(ps%xc_info)
!
! Note that freshly declared objects must have
! npots = 0 and npswfs = 0 !
!
call destroy_semilocal(ps%semilocal)
call destroy_nonlocal(ps%nonlocal)
!
call destroy_local(ps%local)
!
call destroy_wavefunctions(ps%wavefunctions)
!
call destroy_radfunc(ps%valence_charge%rho_val)
call ps_clean_annotation(ps%valence_charge%annotation)
!
call destroy_radfunc(ps%core_charge%rho_core)
call ps_clean_annotation(ps%core_charge%annotation)

call destroy_radfunc(ps%valence_kinetic_energy_density%kin_edens_val)
call ps_clean_annotation(ps%valence_kinetic_energy_density%annotation)
!
call destroy_radfunc(ps%core_kinetic_energy_density%kin_edens_core)
call ps_clean_annotation(ps%core_kinetic_energy_density%annotation)
!
call delete(ps%global_grid)

end subroutine ps_destroy

subroutine destroy_provenance(p)
type(provenance_t), pointer :: p

type(provenance_t), pointer :: q

do while (associated(p))
   call ps_clean_annotation(p%annotation)
   ! clean buffers for input files?
   q => p%next
   deallocate(p)
   p => q
enddo

end subroutine destroy_provenance

!==================================================
subroutine destroy_semilocal(p)
type(semilocal_t), pointer :: p

type(semilocal_t), pointer :: q

do while (associated(p))
   call ps_clean_annotation(p%annotation)
   call destroy_slps(p%pot)
   call delete(p%grid)
   q => p%next
   deallocate(p)
   p => q
enddo

end subroutine destroy_semilocal
!
subroutine destroy_slps(p)
type(slps_t), pointer :: p

type(slps_t), pointer :: q

do while (associated(p))
   call destroy_radfunc(p%V)
   q => p%next
   deallocate(p)
   p => q
enddo

end subroutine destroy_slps
!==================================================
subroutine destroy_local(p)
  type(local_t)  :: p
  
call ps_clean_annotation(p%annotation)
call delete(p%grid)
call destroy_radfunc(p%vlocal)
call destroy_radfunc(p%chlocal)
end subroutine destroy_local
!==================================================
subroutine destroy_nonlocal(p)
type(nonlocal_t), pointer :: p

type(nonlocal_t), pointer :: q

do while (associated(p))
   call ps_clean_annotation(p%annotation)
   call destroy_nlpj(p%proj)
   call delete(p%grid)
   q => p%next
   deallocate(p)
   p => q
enddo

end subroutine destroy_nonlocal
!
subroutine destroy_nlpj(p)
type(nlpj_t), pointer :: p

type(nlpj_t), pointer :: q

do while (associated(p))
   call destroy_radfunc(p%proj)
   q => p%next
   deallocate(p)
   p => q
enddo

end subroutine destroy_nlpj
!
!==================================================
subroutine destroy_wavefunctions(p)
type(wfns_t), pointer :: p

type(wfns_t), pointer :: q

do while (associated(p))
   call ps_clean_annotation(p%annotation)
   call destroy_pswf(p%wf)
   call delete(p%grid)
   q => p%next
   deallocate(p)
   p => q
enddo

end subroutine destroy_wavefunctions
subroutine destroy_pswf(p)
type(wf_t), pointer :: p

type(wf_t), pointer :: q

do while (associated(p))
   call destroy_radfunc(p%Phi)
   q => p%next
   deallocate(p)
   p => q
enddo

end subroutine destroy_pswf

!==================================================
subroutine destroy_radfunc(rp)
type(radfunc_t) :: rp

call delete(rp%grid)
if (associated(rp%data)) then
   deallocate(rp%data)
   rp%data => null()
endif
end subroutine destroy_radfunc

!
subroutine destroy_xc(xp)
type(xc_t), intent(inout) :: xp

if (allocated(xp%libxc_name)) deallocate(xp%libxc_name)
if (allocated(xp%libxc_type)) deallocate(xp%libxc_type)
if (allocated(xp%libxc_id)) deallocate(xp%libxc_id)
if (allocated(xp%libxc_weight)) deallocate(xp%libxc_weight)
call ps_clean_annotation(xp%annotation)

end subroutine destroy_xc

function setcode_of_string(str) result(code)
       character(len=*), intent(in) :: str
       integer                      :: code

       select case (trim(str))
       case ("non_relativistic")
          code = SET_NONREL
       case ("scalar_relativistic")
          code = SET_SREL
       case ("spin_orbit")
          code = SET_SO
       case ("lj")
          code = SET_LJ
       case ("spin_up")
          code = SET_UP
       case ("spin_down")
          code = SET_DOWN
       case ("spin_average")
          code = SET_SPINAVE
       case ("spin_difference")
          code = SET_SPINDIFF
       case ("user_extension1")
          code = SET_USER1
       case ("user_extension2")
          code = SET_USER2
       case ("all","any")
          code = SET_ALL
       case ("invalid","INVALID")
          code = SET_NULL
       case default
          call die("Wrong set string: "//trim(str))
       end select

end function setcode_of_string

function str_of_set(code) result(str)
       integer, intent(in)          :: code
       character(len=40)            :: str

       character(len=100) :: msg

       select case (code)
       case (SET_NONREL)
          str ="non_relativistic"
       case (SET_SREL)
          str ="scalar_relativistic"
       case (SET_SO)
          str ="spin_orbit"
       case (SET_LJ)
          str ="lj"
       case (SET_UP)
          str ="spin_up"
       case (SET_DOWN)
          str ="spin_down"
       case (SET_SPINAVE)
          str ="spin_average"
       case (SET_SPINDIFF)
          str ="spin_difference"
       case (SET_USER1)
          str ="user_extension1"
       case (SET_USER2)
          str ="user_extension2"
       case (SET_ALL)
          str ="all"
       case (SET_NULL)
          str ="invalid"
       case default
          write(msg,"(a,i4)") "Wrong set code: ", code
          call die(msg)
       end select

end function str_of_set

end module m_psml_core






