LCOV - code coverage report
Current view: top level - io - hubbard1_io.f90 (source / functions) Hit Total Coverage
Test: FLEUR test coverage Lines: 0 86 0.0 %
Date: 2024-05-02 04:21:52 Functions: 0 2 0.0 %

          Line data    Source code
       1             : MODULE m_hubbard1_io
       2             : 
       3             :    !------------------------------------------------------------------------------
       4             :    !
       5             :    ! MODULE: m_hubbard1_io
       6             :    !
       7             :    !> @author
       8             :    !> Henning Janßen
       9             :    !
      10             :    ! DESCRIPTION:
      11             :    !>  This module provides an interface with the Hubbard 1 Solver written by
      12             :    !>  J. Kolorenč
      13             :    !
      14             :    ! REVISION HISTORY:
      15             :    ! 20 03 2019 - Initial Version
      16             :    !------------------------------------------------------------------------------
      17             : 
      18             :    USE m_juDFT
      19             :    USE m_types
      20             :    USE m_constants
      21             :    USE m_generic_txtio
      22             : 
      23             :    IMPLICIT NONE
      24             :    PRIVATE
      25             :    !------------------------------------------------------------------
      26             :    !Here the keywords for the hubbard 1 solver input file are defined
      27             :    !------------------------------------------------------------------
      28             : 
      29             :    !Filenames for input
      30             :    CHARACTER(*), PARAMETER :: cfg_file_main ="hubbard1.cfg"
      31             :    CHARACTER(*), PARAMETER :: cfg_file_bath ="bath.cfg"
      32             :    CHARACTER(*), PARAMETER :: cfg_file_hloc ="hloc.cfg"
      33             :    CHARACTER(*), PARAMETER :: cfg_file_ccf = "ccf.dat"
      34             :    CHARACTER(*), PARAMETER :: file_G0_fits  ="G0_fit_monitor.dat"
      35             :    CHARACTER(*), PARAMETER :: file_hybr_fits ="hyb_fit_monitor.dat"
      36             :    INTEGER, PARAMETER      :: input_iounit  = 17
      37             : 
      38             :    !Real freq axis parameters
      39             :    REAL, PARAMETER    :: emin = -13.0
      40             :    REAL, PARAMETER    :: emax =  13.0
      41             :    INTEGER, PARAMETER :: ne   =  2600
      42             :    REAL, PARAMETER    :: sigma = 0.0314
      43             :    INTEGER, PARAMETER :: nmats = 0
      44             : 
      45             :    public:: write_hubbard1_input,read_ccfmat
      46             :    CONTAINS
      47             : 
      48           0 :    SUBROUTINE write_hubbard1_input(path,i_hia,l,f0,f2,f4,f6,hub1inp,hub1data,mu,n,l_bath)
      49             : 
      50             :       CHARACTER(len=*), INTENT(IN)  :: path
      51             :       INTEGER,          INTENT(IN)  :: i_hia
      52             :       INTEGER,          INTENT(IN)  :: l
      53             :       REAL,             INTENT(IN)  :: f0,f2,f4,f6
      54             :       TYPE(t_hub1inp),  INTENT(IN)  :: hub1inp
      55             :       TYPE(t_hub1data), INTENT(IN)  :: hub1data
      56             :       REAL,             INTENT(IN)  :: mu
      57             :       INTEGER,          INTENT(IN)  :: n
      58             :       LOGICAL,          INTENT(IN)  :: l_bath
      59             : 
      60             :       INTEGER :: info, io_error,i,j,k,ind1,ind2,i_exc,i_arg
      61             :       REAL exc
      62           0 :       TYPE(t_mat) :: cfmat
      63             : 
      64             :       !Main input file
      65             :       OPEN(unit=input_iounit, file=TRIM(ADJUSTL(path)) // TRIM(ADJUSTL(cfg_file_main)),&
      66           0 :           status="replace", action="write", iostat=io_error)
      67           0 :       IF(io_error.NE.0) CALL juDFT_error("IO-Error in Hubbard 1 IO", calledby="write_hubbard1_input")
      68             : 
      69           0 :       CALL startSection(input_iounit,"hamiltonian")
      70           0 :       CALL comment(input_iounit,"Slater Integrals",1)
      71           0 :       CALL writeValue(input_iounit,"Fk",(/f0,f2,f4,f6/))
      72           0 :       CALL writeValue(input_iounit, "include", cfg_file_hloc)
      73           0 :       IF(l_bath) CALL writeValue(input_iounit, "include", cfg_file_bath)
      74           0 :       CALL endSection(input_iounit)
      75             : 
      76           0 :       CALL startSection(input_iounit,"fock_space")
      77           0 :       CALL comment(input_iounit,"Min/Max Occupation",1)
      78           0 :       IF(l_bath) THEN
      79           0 :          CALL writeValue(input_iounit,"Np_min",5)
      80           0 :          CALL writeValue(input_iounit,"Np_max",18)
      81             :       ELSE
      82           0 :          CALL writeValue(input_iounit,"Np_min",MAX(0        ,n-hub1inp%n_occpm))
      83           0 :          CALL writeValue(input_iounit,"Np_max",MIN(2*(2*l+1),n+hub1inp%n_occpm))
      84             :       ENDIF
      85           0 :       CALL comment(input_iounit,"Parameters for the case with bath states (only used when bath is present)",1)
      86           0 :       CALL writeValue(input_iounit,"Nbath_exc",2)
      87           0 :       CALL writeValue(input_iounit, "strict_perturb_order")
      88           0 :       CALL endSection(input_iounit)
      89             : 
      90           0 :       CALL startSection(input_iounit,"GC_ensemble")
      91           0 :       CALL comment(input_iounit,"Inverse temperature",1)
      92           0 :       CALL writeValue(input_iounit,"beta",hub1inp%beta)
      93             :       !CALL comment(input_iounit,"States with smaller weight are dropped",1)
      94             :       !CALL writeValue(input_iounit, "weight_limit",1.0e-4)
      95           0 :       CALL endSection(input_iounit)
      96             : 
      97           0 :       CALL startSection(input_iounit,"method")
      98           0 :       CALL writeValue(input_iounit, "lancz")
      99           0 :       CALL comment(input_iounit,"Number of iterations",1)
     100           0 :       CALL writeValue(input_iounit,"N_lancz_iter",100)
     101           0 :       CALL comment(input_iounit,"Number of eigenstates calculated",1)
     102           0 :       CALL writeValue(input_iounit,"N_lancz_states",100)
     103           0 :       CALL endSection(input_iounit)
     104             : 
     105           0 :       CALL comment(input_iounit,"This discretization is only used by the dos utility. The actual energy points are provided in the function call",1)
     106           0 :       CALL startSection(input_iounit,"real_freq_axis")
     107           0 :       CALL writeValue(input_iounit, "omegamin", emin)
     108           0 :       CALL writeValue(input_iounit, "omegamax", emax)
     109           0 :       CALL writeValue(input_iounit, "Nomega", ne)
     110           0 :       CALL writeValue(input_iounit, "eps", sigma)
     111           0 :       CALL endSection(input_iounit)
     112             : 
     113           0 :       CLOSE(unit=input_iounit,iostat=io_error)
     114           0 :       IF(io_error.NE.0) CALL juDFT_error("IO-Error in Hubbard 1 IO", calledby="write_hubbard1_input")
     115             : 
     116             : 
     117             : 
     118             :       !local hamiltonian
     119             :       OPEN(unit=input_iounit, file=TRIM(ADJUSTL(path)) // TRIM(ADJUSTL(cfg_file_hloc)),&
     120           0 :       status="replace", action="write", iostat=io_error)
     121           0 :       IF(io_error.NE.0) CALL juDFT_error("IO-Error in Hubbard 1 IO", calledby="write_hubbard1_input")
     122             : 
     123           0 :       CALL comment(input_iounit,"Orbital quantum number",1)
     124           0 :       CALL writeValue(input_iounit,"Lorb",l)
     125           0 :       CALL comment(input_iounit,"Energy level of the atomic level",1)
     126           0 :       CALL writeValue(input_iounit,"ea",-mu)
     127           0 :       CALL comment(input_iounit,"Spin-orbit-coupling parameter",1)
     128           0 :       CALL writeValue(input_iounit,"xiSOC",hub1data%xi(i_hia))
     129             : 
     130             :       !-----------------------------------------------
     131             :       ! Additional Exchange Splitting
     132             :       !-----------------------------------------------
     133           0 :       exc = 0.0
     134           0 :       DO i_exc = 1, hub1inp%n_exc(i_hia)
     135           0 :          exc = exc + hub1inp%exc(i_hia,i_exc)*hub1data%mag_mom(i_hia,i_exc)
     136             :       ENDDO
     137             :       !Only write the exchange splitting here if its not zero to not conflict with possible additional args
     138           0 :       IF(ABS(exc).GT.1e-12) THEN
     139           0 :          CALL comment(input_iounit,"Exchange splitting",1)
     140             :          !The sign flip is just a convention between the solver and the DFT calculation
     141           0 :          CALL writeValue(input_iounit,"Exc",-exc)
     142             :       ENDIF
     143             : 
     144             :       !---------------------------------------------------------
     145             :       ! Addtional arguments given by addArg are simply passed on
     146             :       !---------------------------------------------------------
     147           0 :       CALL comment(input_iounit,"Additional arguments",1)
     148           0 :       DO i_arg = 1, hub1inp%n_addArgs(i_hia)
     149             :          !----------------------------------------------
     150             :          ! Write out a warning about the sign convention
     151             :          !----------------------------------------------
     152           0 :          IF(TRIM(ADJUSTL(hub1inp%arg_keys(i_hia,i_arg))).EQ.'Exc'.AND.hub1inp%arg_vals(i_hia,i_arg).GT.0.0) THEN
     153           0 :             WRITE(*,*) "----------------------------------------------"
     154           0 :             WRITE(*,*) "You provided a positive exchange splitting.   "
     155           0 :             WRITE(*,*) "Due to different conventions in the solver    "
     156           0 :             WRITE(*,*) "this will result in a negative magnetic moment"
     157           0 :             WRITE(*,*) "----------------------------------------------"
     158             :          ENDIF
     159           0 :          CALL writeValue(input_iounit, TRIM(ADJUSTL(hub1inp%arg_keys(i_hia,i_arg))),hub1inp%arg_vals(i_hia,i_arg))
     160             :       ENDDO
     161             : 
     162             :       !------------------------------------
     163             :       ! Crystal field contribution
     164             :       !------------------------------------
     165           0 :       IF(ABS(hub1inp%ccf(i_hia)).GT.1e-12) THEN
     166           0 :          CALL writeValue(input_iounit, "cf")
     167             : 
     168           0 :          CALL cfmat%init(.true.,2*(2*l+1),2*(2*l+1))
     169           0 :          cfmat%data_r= 0.0
     170           0 :          DO i = 1, 2
     171           0 :             DO j = 1, (2*l+1)
     172           0 :                DO k = 1, (2*l+1)
     173           0 :                   ind1 = (i-1)*(2*l+1) + j
     174           0 :                   ind2 = (i-1)*(2*l+1) + k
     175           0 :                   cfmat%data_r(ind1,ind2) = hub1data%ccfmat(i_hia,j-l-1,k-l-1)*hartree_to_ev_const*hub1inp%ccf(i_hia)
     176             :                ENDDO
     177             :             ENDDO
     178             :          ENDDO
     179           0 :          CALL writeValue(input_iounit, cfmat)
     180             :       ENDIF
     181             : 
     182           0 :       CLOSE(unit=input_iounit,iostat=io_error)
     183           0 :       IF(io_error.NE.0) CALL juDFT_error("IO-Error in Hubbard 1 IO", calledby="write_hubbard1_input")
     184             : 
     185           0 :    END SUBROUTINE write_hubbard1_input
     186             : 
     187           0 :    SUBROUTINE read_ccfmat(ccfmat,l)
     188             :       INTEGER,          INTENT(IN)  :: l
     189             :       REAL,             INTENT(INOUT) :: ccfmat(-l:,-l:)
     190             :    
     191             :       INTEGER :: info, io_error,io_unit
     192             : 
     193           0 :       ccfmat = 0.0
     194           0 :       OPEN(unit=io_unit, file=TRIM(ADJUSTL(cfg_file_ccf)), status="old", action="read", iostat=io_error)
     195           0 :       IF(io_error.NE.0) CALL juDFT_error("IO-error in Hubbard1-IO",calledby="read_ccfmat")
     196             : 
     197           0 :       READ(io_unit,*) ccfmat
     198             : 
     199             :       !convert to htr (in writing the input file its converted back)
     200           0 :       ccfmat = ccfmat/hartree_to_ev_const
     201             : 
     202           0 :       CLOSE(unit=io_unit)
     203             : 
     204           0 :    END SUBROUTINE read_ccfmat
     205             : 
     206             : END MODULE m_hubbard1_io
     207             : 

Generated by: LCOV version 1.14