Ford doc gen- minor fixes

This commit is contained in:
fabrizio22 2024-02-14 15:35:43 +01:00
parent 0d87b7f478
commit d4a744d3ec
6 changed files with 15 additions and 16 deletions

View File

@ -404,7 +404,7 @@ MODULE input_parameters
REAL(DP) :: starting_magnetization( nsx ) = 0.0_DP
!! PW ONLY
!!!PARAMETERS FOR TWO-CHEM-CALCULATIONS
! PARAMETERS FOR TWO-CHEM-CALCULATIONS
REAL(DP) :: degauss_cond = 0.0_DP
!broadening for conduction band
INTEGER :: nbnd_cond = 0

View File

@ -433,7 +433,7 @@ END SUBROUTINE qmmm_minimum_image
CALL mpi_send(tmp_buf,3*nat_qm,MPI_DOUBLE_PRECISION, 0,QMMM_TAG_FORCE,qmmm_comm,ierr)
!
!!!! Note, not used if ec_alg is false. Optimize excluding this send as well
! Note, not used if ec_alg is false. Optimize excluding this send as well
force_mm = force_mm * QMMM_FORCE_CONV
CALL mpi_send(force_mm,3*nat_mm,MPI_DOUBLE_PRECISION, 0,QMMM_TAG_FORCE2,qmmm_comm,ierr)
END IF

View File

@ -2620,9 +2620,9 @@ CONTAINS
CALL errore( 'card_hubbard', 'Too many occurrences of V for the same couple of atoms', i)
ENDIF
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Read the data for the first atom !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!**********************************************************************************!
!* Read the data for the first atom *!
!**********************************************************************************!
!
! Column 3: Read the atomic type name and the Hubbard manifold (e.g. Fe-3d)
CALL get_field(2, field_str, input_line)
@ -2756,9 +2756,9 @@ CONTAINS
ENDIF
ENDIF
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Read the data for the second atom !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!**********************************************************************************!
!* Read the data for the second atom *!
!**********************************************************************************!
!
! Column 3: Read the atomic type name and the Hubbard manifold (e.g. O-2p)
CALL get_field(3, field_str, input_line)

View File

@ -19,7 +19,7 @@ subroutine addusddens (drhoscf, dbecsum, mode0, npe, iflag)
!! from solve_* (iflag=0) drhoscf and dbecsum contain the contribution
!! of the solution of the linear system and the terms due to alphasum
!! and becsum are not added. In this case the change of the charge
!! calculated by drho (called \Delta \rho in [1]) is read from file
!! calculated by drho (called \(\Delta \rho\) in [1]) is read from file
!! and added. The contribution of the change of
!! the Fermi energy is not calculated here but added later by ef_shift.
!! [1] PRB 64, 235118 (2001).

View File

@ -939,7 +939,7 @@ SUBROUTINE phq_readin()
!
! end of reading, close unit qestdin, remove temporary input file if existing
! FIXME: closing input file here breaks alpha2F.x that reads what follows
!!! IF (meta_ionode) ios = close_input_file ()
! IF (meta_ionode) ios = close_input_file ()
IF (epsil.AND.(lgauss .OR. ltetra)) &
CALL errore ('phq_readin', 'no elec. field with metals', 1)

View File

@ -8,8 +8,7 @@
!--------------------------------------------------------------------------
MODULE ldaU
!--------------------------------------------------------------------------
!
! The quantities needed in DFT+U and extended DFT+U calculations.
!! The quantities needed in DFT+U and extended DFT+U calculations.
!
USE kinds, ONLY : DP
USE upf_params, ONLY : lqmax
@ -22,11 +21,11 @@ MODULE ldaU
SAVE
!
COMPLEX(DP), ALLOCATABLE :: wfcU(:,:)
!! atomic wfcs with U term
#if defined(__CUDA)
! while waiting for a better implementation
attributes(PINNED) :: wfcU
#endif
!! atomic wfcs with U term
COMPLEX(DP), ALLOCATABLE :: d_spin_ldau(:,:,:)
!! the rotations in spin space for all symmetries
REAL(DP) :: eth
@ -134,9 +133,9 @@ MODULE ldaU
REAL(DP), ALLOCATABLE :: q_ps(:,:,:)
!! (matrix elements on AE and PS atomic wfcs)
!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!! Hubbard V part !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!****************************************************
! Hubbard V part !
!****************************************************
!
! Inter atomic interaction should be cut off at some distance
! that is the reason of having so many unitcell information.