write wannier90 parameters to stdout
subroutine param_write
!==================================================================!
! !
!! write wannier90 parameters to stdout
! !
!===================================================================
implicit none
integer :: i, nkp, loop, nat, nsp
if (transport .and. tran_read_ht) goto 401
! System
write (stdout, *)
write (stdout, '(36x,a6)') '------'
write (stdout, '(36x,a6)') 'SYSTEM'
write (stdout, '(36x,a6)') '------'
write (stdout, *)
if (lenconfac .eq. 1.0_dp) then
write (stdout, '(30x,a21)') 'Lattice Vectors (Ang)'
else
write (stdout, '(28x,a22)') 'Lattice Vectors (Bohr)'
endif
write (stdout, 101) 'a_1', (real_lattice(1, I)*lenconfac, i=1, 3)
write (stdout, 101) 'a_2', (real_lattice(2, I)*lenconfac, i=1, 3)
write (stdout, 101) 'a_3', (real_lattice(3, I)*lenconfac, i=1, 3)
write (stdout, *)
write (stdout, '(19x,a17,3x,f11.5)', advance='no') &
'Unit Cell Volume:', cell_volume*lenconfac**3
if (lenconfac .eq. 1.0_dp) then
write (stdout, '(2x,a7)') '(Ang^3)'
else
write (stdout, '(2x,a8)') '(Bohr^3)'
endif
write (stdout, *)
if (lenconfac .eq. 1.0_dp) then
write (stdout, '(24x,a33)') 'Reciprocal-Space Vectors (Ang^-1)'
else
write (stdout, '(22x,a34)') 'Reciprocal-Space Vectors (Bohr^-1)'
endif
write (stdout, 101) 'b_1', (recip_lattice(1, I)/lenconfac, i=1, 3)
write (stdout, 101) 'b_2', (recip_lattice(2, I)/lenconfac, i=1, 3)
write (stdout, 101) 'b_3', (recip_lattice(3, I)/lenconfac, i=1, 3)
write (stdout, *) ' '
! Atoms
if (num_atoms > 0) then
write (stdout, '(1x,a)') '*----------------------------------------------------------------------------*'
if (lenconfac .eq. 1.0_dp) then
write (stdout, '(1x,a)') '| Site Fractional Coordinate Cartesian Coordinate (Ang) |'
else
write (stdout, '(1x,a)') '| Site Fractional Coordinate Cartesian Coordinate (Bohr) |'
endif
write (stdout, '(1x,a)') '+----------------------------------------------------------------------------+'
do nsp = 1, num_species
do nat = 1, atoms_species_num(nsp)
write (stdout, '(1x,a1,1x,a2,1x,i3,3F10.5,3x,a1,1x,3F10.5,4x,a1)') &
& '|', atoms_symbol(nsp), nat, atoms_pos_frac(:, nat, nsp),&
& '|', atoms_pos_cart(:, nat, nsp)*lenconfac, '|'
end do
end do
write (stdout, '(1x,a)') '*----------------------------------------------------------------------------*'
else
write (stdout, '(25x,a)') 'No atom positions specified'
end if
! Constrained centres
if (selective_loc .and. slwf_constrain) then
write (stdout, *) ' '
write (stdout, '(1x,a)') '*----------------------------------------------------------------------------*'
write (stdout, '(1x,a)') '| Wannier# Original Centres Constrained centres |'
write (stdout, '(1x,a)') '+----------------------------------------------------------------------------+'
do i = 1, slwf_num
write (stdout, '(1x,a1,2x,i3,2x,3F10.5,3x,a1,1x,3F10.5,4x,a1)') &
& '|', i, ccentres_frac(i, :), '|', wannier_centres(:, i), '|'
end do
write (stdout, '(1x,a)') '*----------------------------------------------------------------------------*'
end if
! Projections
if (iprint > 1 .and. allocated(input_proj_site)) then
write (stdout, '(32x,a)') '-----------'
write (stdout, '(32x,a)') 'PROJECTIONS'
write (stdout, '(32x,a)') '-----------'
write (stdout, *) ' '
write (stdout, '(1x,a)') '+----------------------------------------------------------------------------+'
write (stdout, '(1x,a)') '| Frac. Coord. l mr r z-axis x-axis Z/a |'
write (stdout, '(1x,a)') '+----------------------------------------------------------------------------+'
do nsp = 1, num_proj
write (stdout, '(1x,a1,3(1x,f5.2),1x,i2,1x,i2,1x,i2,3(1x,f6.3),3(1x,f6.3),2x,f4.1,1x,a1)')&
& '|', input_proj_site(1, nsp), input_proj_site(2, nsp), &
input_proj_site(3, nsp), input_proj_l(nsp), input_proj_m(nsp), input_proj_radial(nsp), &
input_proj_z(1, nsp), input_proj_z(2, nsp), input_proj_z(3, nsp), input_proj_x(1, nsp), &
input_proj_x(2, nsp), input_proj_x(3, nsp), input_proj_zona(nsp), '|'
end do
write (stdout, '(1x,a)') '+----------------------------------------------------------------------------+'
write (stdout, *) ' '
end if
if (iprint > 1 .and. lselproj .and. allocated(proj_site)) then
write (stdout, '(30x,a)') '--------------------'
write (stdout, '(30x,a)') 'SELECTED PROJECTIONS'
write (stdout, '(30x,a)') '--------------------'
write (stdout, *) ' '
write (stdout, '(1x,a)') '+----------------------------------------------------------------------------+'
write (stdout, '(1x,a)') '| Frac. Coord. l mr r z-axis x-axis Z/a |'
write (stdout, '(1x,a)') '+----------------------------------------------------------------------------+'
do nsp = 1, num_wann
if (proj2wann_map(nsp) < 0) cycle
write (stdout, '(1x,a1,3(1x,f5.2),1x,i2,1x,i2,1x,i2,3(1x,f6.3),3(1x,f6.3),2x,f4.1,1x,a1)')&
& '|', proj_site(1, nsp), proj_site(2, nsp), &
proj_site(3, nsp), proj_l(nsp), proj_m(nsp), proj_radial(nsp), &
proj_z(1, nsp), proj_z(2, nsp), proj_z(3, nsp), proj_x(1, nsp), &
proj_x(2, nsp), proj_x(3, nsp), proj_zona(nsp), '|'
end do
write (stdout, '(1x,a)') '+----------------------------------------------------------------------------+'
write (stdout, *) ' '
end if
! K-points
write (stdout, '(32x,a)') '------------'
write (stdout, '(32x,a)') 'K-POINT GRID'
write (stdout, '(32x,a)') '------------'
write (stdout, *) ' '
write (stdout, '(13x,a,i3,1x,a1,i3,1x,a1,i3,6x,a,i5)') 'Grid size =', mp_grid(1), 'x', mp_grid(2), 'x', mp_grid(3), &
'Total points =', num_kpts
write (stdout, *) ' '
if (iprint > 1) then
write (stdout, '(1x,a)') '*----------------------------------------------------------------------------*'
if (lenconfac .eq. 1.0_dp) then
write (stdout, '(1x,a)') '| k-point Fractional Coordinate Cartesian Coordinate (Ang^-1) |'
else
write (stdout, '(1x,a)') '| k-point Fractional Coordinate Cartesian Coordinate (Bohr^-1) |'
endif
write (stdout, '(1x,a)') '+----------------------------------------------------------------------------+'
do nkp = 1, num_kpts
write (stdout, '(1x,a1,i6,1x,3F10.5,3x,a1,1x,3F10.5,4x,a1)') '|', nkp, kpt_latt(:, nkp), '|', &
kpt_cart(:, nkp)/lenconfac, '|'
end do
write (stdout, '(1x,a)') '*----------------------------------------------------------------------------*'
write (stdout, *) ' '
end if
! Main
write (stdout, *) ' '
write (stdout, '(1x,a78)') '*---------------------------------- MAIN ------------------------------------*'
write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Number of Wannier Functions :', num_wann, '|'
write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Number of Objective Wannier Functions :', slwf_num, '|'
write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Number of input Bloch states :', num_bands, '|'
write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Output verbosity (1=low, 5=high) :', iprint, '|'
write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Timing Level (1=low, 5=high) :', timing_level, '|'
write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Optimisation (0=memory, 3=speed) :', optimisation, '|'
write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Length Unit :', trim(length_unit), '|'
write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Post-processing setup (write *.nnkp) :', postproc_setup, '|'
write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Using Gamma-only branch of algorithms :', gamma_only, '|'
!YN: RS:
if (lsitesymmetry) then
write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Using symmetry-adapted WF mode :', lsitesymmetry, '|'
write (stdout, '(1x,a46,8x,E10.3,13x,a1)') '| Tolerance for symmetry condition on U :', symmetrize_eps, '|'
endif
if (cp_pp .or. iprint > 2) &
write (stdout, '(1x,a46,10x,L8,13x,a1)') '| CP code post-processing :', cp_pp, '|'
if (wannier_plot .or. iprint > 2) then
if (wvfn_formatted) then
write (stdout, '(1x,a46,9x,a9,13x,a1)') '| Wavefunction (UNK) file-type :', 'formatted', '|'
else
write (stdout, '(1x,a46,7x,a11,13x,a1)') '| Wavefunction (UNK) file-type :', 'unformatted', '|'
endif
if (spin == 1) then
write (stdout, '(1x,a46,16x,a2,13x,a1)') '| Wavefunction spin channel :', 'up', '|'
else
write (stdout, '(1x,a46,14x,a4,13x,a1)') '| Wavefunction spin channel :', 'down', '|'
endif
endif
write (stdout, '(1x,a78)') '*----------------------------------------------------------------------------*'
! Wannierise
write (stdout, '(1x,a78)') '*------------------------------- WANNIERISE ---------------------------------*'
write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Total number of iterations :', num_iter, '|'
write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Number of CG steps before reset :', num_cg_steps, '|'
if (lfixstep) then
write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Fixed step length for minimisation :', fixed_step, '|'
else
write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Trial step length for line search :', trial_step, '|'
endif
write (stdout, '(1x,a46,8x,E10.3,13x,a1)') '| Convergence tolerence :', conv_tol, '|'
write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Convergence window :', conv_window, '|'
write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Iterations between writing output :', num_print_cycles, '|'
write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Iterations between backing up to disk :', num_dump_cycles, '|'
write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Write r^2_nm to file :', write_r2mn, '|'
write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Write xyz WF centres to file :', write_xyz, '|'
write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Write on-site energies <0n|H|0n> to file :', write_hr_diag, '|'
write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Use guiding centre to control phases :', guiding_centres, '|'
write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Use phases for initial projections :', use_bloch_phases, '|'
if (guiding_centres .or. iprint > 2) then
write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Iterations before starting guiding centres:', num_no_guide_iter, '|'
write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Iterations between using guiding centres :', num_guide_cycles, '|'
end if
if (selective_loc .or. iprint > 2) then
write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Perform selective localization :', selective_loc, '|'
end if
if (slwf_constrain .or. iprint > 2) then
write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Use constrains in selective localization :', slwf_constrain, '|'
write (stdout, '(1x,a46,8x,E10.3,13x,a1)') '| Value of the Lagrange multiplier :',&
&slwf_lambda, '|'
end if
write (stdout, '(1x,a78)') '*----------------------------------------------------------------------------*'
!
! Disentanglement
!
if (disentanglement .or. iprint > 2) then
write (stdout, '(1x,a78)') '*------------------------------- DISENTANGLE --------------------------------*'
write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Using band disentanglement :', disentanglement, '|'
write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Total number of iterations :', dis_num_iter, '|'
write (stdout, '(1x,a46,10x,F8.3,13x,a1)') '| Mixing ratio :', dis_mix_ratio, '|'
write (stdout, '(1x,a46,8x,ES10.3,13x,a1)') '| Convergence tolerence :', dis_conv_tol, '|'
write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Convergence window :', dis_conv_window, '|'
! GS-start
if (dis_spheres_num .gt. 0) then
write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Number of spheres in k-space :', dis_spheres_num, '|'
do nkp = 1, dis_spheres_num
write (stdout, '(1x,a13,I4,a2,2x,3F8.3,a15,F8.3,9x,a1)') &
'| center n.', nkp, ' :', dis_spheres(1:3, nkp), ', radius =', dis_spheres(4, nkp), '|'
enddo
write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Index of first Wannier band :', dis_spheres_first_wann, '|'
endif
! GS-end
write (stdout, '(1x,a78)') '*----------------------------------------------------------------------------*'
end if
!
! Plotting
!
if (wannier_plot .or. bands_plot .or. fermi_surface_plot .or. kslice &
.or. dos_plot .or. write_hr .or. iprint > 2) then
!
write (stdout, '(1x,a78)') '*-------------------------------- PLOTTING ----------------------------------*'
!
if (wannier_plot .or. iprint > 2) then
write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Plotting Wannier functions :', wannier_plot, '|'
write (stdout, '(1x,a46,1x,I5,a1,I5,a1,I5,13x,a1)') &
'| Size of supercell for plotting :', &
wannier_plot_supercell(1), 'x', wannier_plot_supercell(2), 'x', &
wannier_plot_supercell(3), '|'
if (translate_home_cell) then
write (stdout, '(1x,a46,10x,L8,13x,a1)') &
'| Translating WFs to home cell :', translate_home_cell, '|'
end if
write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Plotting mode (molecule or crystal) :', trim(wannier_plot_mode), '|'
if (spinors) then
write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Plotting mode for spinor WFs :', &
trim(wannier_plot_spinor_mode), '|'
write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Include phase for spinor WFs :', &
wannier_plot_spinor_phase, '|'
end if
write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Plotting format :', trim(wannier_plot_format), '|'
if (index(wannier_plot_format, 'cub') > 0 .or. iprint > 2) then
write (stdout, '(1x,a46,10x,F8.3,13x,a1)') '| Plot radius :', wannier_plot_radius, '|'
write (stdout, '(1x,a46,10x,F8.3,13x,a1)') '| Plot scale :', wannier_plot_scale, '|'
endif
write (stdout, '(1x,a78)') '*----------------------------------------------------------------------------*'
end if
!
if (fermi_surface_plot .or. iprint > 2) then
write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Plotting Fermi surface :', fermi_surface_plot, '|'
write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Number of plotting points (along b_1) :', fermi_surface_num_points, '|'
write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Plotting format :' &
, trim(fermi_surface_plot_format), '|'
write (stdout, '(1x,a78)') '*----------------------------------------------------------------------------*'
end if
!
if (bands_plot .or. iprint > 2) then
write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Plotting interpolated bandstructure :', bands_plot, '|'
write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Number of K-path sections :', bands_num_spec_points/2, '|'
write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Divisions along first K-path section :', bands_num_points, '|'
write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Output format :', trim(bands_plot_format), '|'
write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Output mode :', trim(bands_plot_mode), '|'
if (index(bands_plot_mode, 'cut') .ne. 0) then
write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Dimension of the system :', bands_plot_dim, '|'
if (bands_plot_dim .eq. 1) &
write (stdout, '(1x,a46,10x,a8,13x,a1)') '| System extended in :', trim(one_dim_axis), '|'
if (bands_plot_dim .eq. 2) &
write (stdout, '(1x,a46,10x,a8,13x,a1)') '| System confined in :', trim(one_dim_axis), '|'
write (stdout, '(1x,a46,10x,F8.3,13x,a1)') '| Hamiltonian cut-off value :', hr_cutoff, '|'
write (stdout, '(1x,a46,10x,F8.3,13x,a1)') '| Hamiltonian cut-off distance :', dist_cutoff, '|'
write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Hamiltonian cut-off distance mode :', trim(dist_cutoff_mode), '|'
endif
write (stdout, '(1x,a78)') '*----------------------------------------------------------------------------*'
write (stdout, '(1x,a78)') '| K-space path sections: |'
if (bands_num_spec_points == 0) then
write (stdout, '(1x,a78)') '| None defined |'
else
do loop = 1, bands_num_spec_points, 2
write (stdout, '(1x,a10,1x,a5,1x,3F7.3,5x,a3,1x,a5,1x,3F7.3,3x,a1)') '| From:', bands_label(loop), &
(bands_spec_points(i, loop), i=1, 3), 'To:', bands_label(loop + 1), (bands_spec_points(i, loop + 1), i=1, 3), '|'
end do
end if
write (stdout, '(1x,a78)') '*----------------------------------------------------------------------------*'
end if
!
if (write_hr .or. iprint > 2) then
write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Plotting Hamiltonian in WF basis :', write_hr, '|'
write (stdout, '(1x,a78)') '*----------------------------------------------------------------------------*'
endif
if (write_vdw_data .or. iprint > 2) then
write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Writing data for Van der Waals post-proc :', write_vdw_data, '|'
write (stdout, '(1x,a78)') '*----------------------------------------------------------------------------*'
endif
!
endif
401 continue
!
! Transport
!
if (transport .or. iprint > 2) then
!
write (stdout, '(1x,a78)') '*------------------------------- TRANSPORT ----------------------------------*'
!
write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Transport mode :', trim(transport_mode), '|'
!
if (tran_read_ht) then
!
write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Hamiltonian from external files :', 'T', '|'
!
else
!
write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Hamiltonian from external files :', 'F', '|'
write (stdout, '(1x,a46,10x,a8,13x,a1)') '| System extended in :', trim(one_dim_axis), '|'
!
end if
write (stdout, '(1x,a78)') '| Centre of the unit cell to which WF are translated (fract. coords): |'
write (stdout, '(1x,a1,35x,F12.6,a1,F12.6,a1,F12.6,3x,a1)') '|', translation_centre_frac(1), ',', &
translation_centre_frac(2), ',', &
translation_centre_frac(3), '|'
if (size(fermi_energy_list) == 1) then
write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Fermi energy (eV) :', fermi_energy_list(1), '|'
else
write (stdout, '(1x,a21,I8,a12,f8.3,a4,f8.3,a3,13x,a1)') '| Fermi energy :', size(fermi_energy_list), &
' steps from ', fermi_energy_list(1), ' to ', &
fermi_energy_list(size(fermi_energy_list)), ' eV', '|'
end if
!
write (stdout, '(1x,a78)') '*----------------------------------------------------------------------------*'
!
endif
101 format(20x, a3, 2x, 3F11.6)
end subroutine param_write